summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.adoc18
-rw-r--r--doc/context/sources/general/manuals/lowlevel/lowlevel-style.tex2
-rw-r--r--source/luametatex/CMakeLists.txt258
-rw-r--r--source/luametatex/CMakeSettings.json73
-rw-r--r--source/luametatex/build.cmd89
-rw-r--r--source/luametatex/build.sh72
-rw-r--r--source/luametatex/build.txt43
-rw-r--r--source/luametatex/cmake/debug.cmake13
-rw-r--r--source/luametatex/cmake/lua.cmake87
-rw-r--r--source/luametatex/cmake/luametatex.cmake84
-rw-r--r--source/luametatex/cmake/luaoptional.cmake30
-rw-r--r--source/luametatex/cmake/luarest.cmake32
-rw-r--r--source/luametatex/cmake/luasocket.cmake62
-rw-r--r--source/luametatex/cmake/mimalloc.cmake44
-rw-r--r--source/luametatex/cmake/mingw-32.cmake13
-rw-r--r--source/luametatex/cmake/mingw-64.cmake13
-rw-r--r--source/luametatex/cmake/miniz.cmake21
-rw-r--r--source/luametatex/cmake/mp.cmake50
-rw-r--r--source/luametatex/cmake/pplib.cmake43
-rw-r--r--source/luametatex/cmake/tex.cmake99
-rw-r--r--source/luametatex/source/.gitignore1
-rw-r--r--source/luametatex/source/README39
-rw-r--r--source/luametatex/source/libraries/avl/avl.c2040
-rw-r--r--source/luametatex/source/libraries/avl/avl.h445
-rw-r--r--source/luametatex/source/libraries/avl/readme.txt20
-rw-r--r--source/luametatex/source/libraries/decnumber/decContext.c437
-rw-r--r--source/luametatex/source/libraries/decnumber/decContext.h254
-rw-r--r--source/luametatex/source/libraries/decnumber/decNumber.c8145
-rw-r--r--source/luametatex/source/libraries/decnumber/decNumber.h182
-rw-r--r--source/luametatex/source/libraries/decnumber/decNumberLocal.h757
-rw-r--r--source/luametatex/source/libraries/hnj/hnjhyphen.c627
-rw-r--r--source/luametatex/source/libraries/hnj/hnjhyphen.h123
-rw-r--r--source/luametatex/source/libraries/libcerf/CHANGELOG118
-rw-r--r--source/luametatex/source/libraries/libcerf/LICENSE22
-rw-r--r--source/luametatex/source/libraries/libcerf/README.md109
-rw-r--r--source/luametatex/source/libraries/libcerf/cerf.h93
-rw-r--r--source/luametatex/source/libraries/libcerf/defs.h97
-rw-r--r--source/luametatex/source/libraries/libcerf/erfcx.c528
-rw-r--r--source/luametatex/source/libraries/libcerf/err_fcts.c438
-rw-r--r--source/luametatex/source/libraries/libcerf/experimental.c178
-rw-r--r--source/luametatex/source/libraries/libcerf/im_w_of_x.c519
-rw-r--r--source/luametatex/source/libraries/libcerf/readme-luametatex.txt26
-rw-r--r--source/luametatex/source/libraries/libcerf/w_of_z.c393
-rw-r--r--source/luametatex/source/libraries/libcerf/width.c100
-rw-r--r--source/luametatex/source/libraries/mimalloc/CMakeLists.txt413
-rw-r--r--source/luametatex/source/libraries/mimalloc/LICENSE21
-rw-r--r--source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config-version.cmake19
-rw-r--r--source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config.cmake14
-rw-r--r--source/luametatex/source/libraries/mimalloc/include/mimalloc-atomic.h338
-rw-r--r--source/luametatex/source/libraries/mimalloc/include/mimalloc-internal.h1049
-rw-r--r--source/luametatex/source/libraries/mimalloc/include/mimalloc-new-delete.h57
-rw-r--r--source/luametatex/source/libraries/mimalloc/include/mimalloc-override.h67
-rw-r--r--source/luametatex/source/libraries/mimalloc/include/mimalloc-types.h598
-rw-r--r--source/luametatex/source/libraries/mimalloc/include/mimalloc.h453
-rw-r--r--source/luametatex/source/libraries/mimalloc/readme.md716
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/alloc-aligned.c261
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/alloc-override-osx.c458
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/alloc-override.c281
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/alloc-posix.c181
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/alloc.c934
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/arena.c446
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/bitmap.c395
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/bitmap.h107
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/heap.c580
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/init.c693
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/options.c627
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/os.c1443
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/page-queue.c331
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/page.c869
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/random.c367
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/region.c505
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/segment-cache.c360
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/segment.c1544
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/static.c39
-rw-r--r--source/luametatex/source/libraries/mimalloc/src/stats.c584
-rw-r--r--source/luametatex/source/libraries/miniz/ChangeLog.md196
-rw-r--r--source/luametatex/source/libraries/miniz/LICENSE22
-rw-r--r--source/luametatex/source/libraries/miniz/miniz.c7733
-rw-r--r--source/luametatex/source/libraries/miniz/miniz.h1350
-rw-r--r--source/luametatex/source/libraries/miniz/readme.md34
-rw-r--r--source/luametatex/source/libraries/miniz/readme.txt8
-rw-r--r--source/luametatex/source/libraries/pplib/html.zipbin0 -> 280070 bytes
-rw-r--r--source/luametatex/source/libraries/pplib/ppapi.h404
-rw-r--r--source/luametatex/source/libraries/pplib/pparray.c145
-rw-r--r--source/luametatex/source/libraries/pplib/pparray.h7
-rw-r--r--source/luametatex/source/libraries/pplib/ppconf.h76
-rw-r--r--source/luametatex/source/libraries/pplib/ppcrypt.c748
-rw-r--r--source/luametatex/source/libraries/pplib/ppcrypt.h70
-rw-r--r--source/luametatex/source/libraries/pplib/ppdict.c166
-rw-r--r--source/luametatex/source/libraries/pplib/ppdict.h7
-rw-r--r--source/luametatex/source/libraries/pplib/ppfilter.h10
-rw-r--r--source/luametatex/source/libraries/pplib/ppheap.c40
-rw-r--r--source/luametatex/source/libraries/pplib/ppheap.h46
-rw-r--r--source/luametatex/source/libraries/pplib/pplib.h22
-rw-r--r--source/luametatex/source/libraries/pplib/ppload.c2769
-rw-r--r--source/luametatex/source/libraries/pplib/ppload.h58
-rw-r--r--source/luametatex/source/libraries/pplib/ppstream.c491
-rw-r--r--source/luametatex/source/libraries/pplib/ppstream.h10
-rw-r--r--source/luametatex/source/libraries/pplib/pptest1.c104
-rw-r--r--source/luametatex/source/libraries/pplib/pptest2.c170
-rw-r--r--source/luametatex/source/libraries/pplib/pptest3.c123
-rw-r--r--source/luametatex/source/libraries/pplib/ppxref.c215
-rw-r--r--source/luametatex/source/libraries/pplib/ppxref.h35
-rw-r--r--source/luametatex/source/libraries/pplib/readme.txt3
-rw-r--r--source/luametatex/source/libraries/pplib/util/README.md8
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilbasexx.c1742
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilbasexx.h111
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilcrypt.c1190
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilcrypt.h90
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilcryptdef.h32
-rw-r--r--source/luametatex/source/libraries/pplib/util/utildecl.h28
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilflate.c322
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilflate.h21
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilfpred.c778
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilfpred.h23
-rw-r--r--source/luametatex/source/libraries/pplib/util/utiliof.c2993
-rw-r--r--source/luametatex/source/libraries/pplib/util/utiliof.h673
-rw-r--r--source/luametatex/source/libraries/pplib/util/utillog.c60
-rw-r--r--source/luametatex/source/libraries/pplib/util/utillog.h10
-rw-r--r--source/luametatex/source/libraries/pplib/util/utillzw.c705
-rw-r--r--source/luametatex/source/libraries/pplib/util/utillzw.h30
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmd5.c447
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmd5.h49
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmem.c67
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmem.h16
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmemallc.h569
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmemallh.h36
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmemheap.c1078
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmemheap.h188
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmemheapiof.c142
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmemheapiof.h43
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmeminfo.c38
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilmeminfo.h9
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilnumber.c1177
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilnumber.h428
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilplat.h31
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilsha.c1065
-rw-r--r--source/luametatex/source/libraries/pplib/util/utilsha.h79
-rw-r--r--source/luametatex/source/libraries/readme.txt25
-rw-r--r--source/luametatex/source/license.txt181
-rw-r--r--source/luametatex/source/lua/lmtcallbacklib.c615
-rw-r--r--source/luametatex/source/lua/lmtcallbacklib.h105
-rw-r--r--source/luametatex/source/lua/lmtenginelib.c1146
-rw-r--r--source/luametatex/source/lua/lmtenginelib.h41
-rw-r--r--source/luametatex/source/lua/lmtfontlib.c1020
-rw-r--r--source/luametatex/source/lua/lmtfontlib.h10
-rw-r--r--source/luametatex/source/lua/lmtinterface.c544
-rw-r--r--source/luametatex/source/lua/lmtinterface.h1754
-rw-r--r--source/luametatex/source/lua/lmtlanguagelib.c439
-rw-r--r--source/luametatex/source/lua/lmtlanguagelib.h20
-rw-r--r--source/luametatex/source/lua/lmtlibrary.c106
-rw-r--r--source/luametatex/source/lua/lmtlibrary.h60
-rw-r--r--source/luametatex/source/lua/lmtluaclib.c660
-rw-r--r--source/luametatex/source/lua/lmtluaclib.h10
-rw-r--r--source/luametatex/source/lua/lmtlualib.c627
-rw-r--r--source/luametatex/source/lua/lmtlualib.h25
-rw-r--r--source/luametatex/source/lua/lmtmplib.c3137
-rw-r--r--source/luametatex/source/lua/lmtnodelib.c10324
-rw-r--r--source/luametatex/source/lua/lmtnodelib.h114
-rw-r--r--source/luametatex/source/lua/lmtstatuslib.c526
-rw-r--r--source/luametatex/source/lua/lmttexiolib.c307
-rw-r--r--source/luametatex/source/lua/lmttexiolib.h13
-rw-r--r--source/luametatex/source/lua/lmttexlib.c5580
-rw-r--r--source/luametatex/source/lua/lmttexlib.h29
-rw-r--r--source/luametatex/source/lua/lmttokenlib.c3894
-rw-r--r--source/luametatex/source/lua/lmttokenlib.h52
-rw-r--r--source/luametatex/source/luacore/lua54/originals/lctype.h98
-rw-r--r--source/luametatex/source/luacore/lua54/originals/patches.txt11
-rw-r--r--source/luametatex/source/luacore/lua54/readme.txt8
-rw-r--r--source/luametatex/source/luacore/lua54/src/Makefile206
-rw-r--r--source/luametatex/source/luacore/lua54/src/lapi.c1460
-rw-r--r--source/luametatex/source/luacore/lua54/src/lapi.h49
-rw-r--r--source/luametatex/source/luacore/lua54/src/lauxlib.c1112
-rw-r--r--source/luametatex/source/luacore/lua54/src/lauxlib.h301
-rw-r--r--source/luametatex/source/luacore/lua54/src/lbaselib.c549
-rw-r--r--source/luametatex/source/luacore/lua54/src/lcode.c1844
-rw-r--r--source/luametatex/source/luacore/lua54/src/lcode.h104
-rw-r--r--source/luametatex/source/luacore/lua54/src/lcorolib.c210
-rw-r--r--source/luametatex/source/luacore/lua54/src/lctype.c64
-rw-r--r--source/luametatex/source/luacore/lua54/src/lctype.h101
-rw-r--r--source/luametatex/source/luacore/lua54/src/ldblib.c483
-rw-r--r--source/luametatex/source/luacore/lua54/src/ldebug.c921
-rw-r--r--source/luametatex/source/luacore/lua54/src/ldebug.h63
-rw-r--r--source/luametatex/source/luacore/lua54/src/ldo.c1005
-rw-r--r--source/luametatex/source/luacore/lua54/src/ldo.h87
-rw-r--r--source/luametatex/source/luacore/lua54/src/ldump.c226
-rw-r--r--source/luametatex/source/luacore/lua54/src/lfunc.c295
-rw-r--r--source/luametatex/source/luacore/lua54/src/lfunc.h64
-rw-r--r--source/luametatex/source/luacore/lua54/src/lgc.c1730
-rw-r--r--source/luametatex/source/luacore/lua54/src/lgc.h199
-rw-r--r--source/luametatex/source/luacore/lua54/src/linit.c65
-rw-r--r--source/luametatex/source/luacore/lua54/src/liolib.c828
-rw-r--r--source/luametatex/source/luacore/lua54/src/ljumptab.h112
-rw-r--r--source/luametatex/source/luacore/lua54/src/llex.c581
-rw-r--r--source/luametatex/source/luacore/lua54/src/llex.h91
-rw-r--r--source/luametatex/source/luacore/lua54/src/llimits.h367
-rw-r--r--source/luametatex/source/luacore/lua54/src/lmathlib.c764
-rw-r--r--source/luametatex/source/luacore/lua54/src/lmem.c201
-rw-r--r--source/luametatex/source/luacore/lua54/src/lmem.h93
-rw-r--r--source/luametatex/source/luacore/lua54/src/loadlib.c767
-rw-r--r--source/luametatex/source/luacore/lua54/src/lobject.c602
-rw-r--r--source/luametatex/source/luacore/lua54/src/lobject.h802
-rw-r--r--source/luametatex/source/luacore/lua54/src/lopcodes.c104
-rw-r--r--source/luametatex/source/luacore/lua54/src/lopcodes.h405
-rw-r--r--source/luametatex/source/luacore/lua54/src/lopnames.h103
-rw-r--r--source/luametatex/source/luacore/lua54/src/loslib.c430
-rw-r--r--source/luametatex/source/luacore/lua54/src/lparser.c1967
-rw-r--r--source/luametatex/source/luacore/lua54/src/lparser.h171
-rw-r--r--source/luametatex/source/luacore/lua54/src/lprefix.h45
-rw-r--r--source/luametatex/source/luacore/lua54/src/lstate.c440
-rw-r--r--source/luametatex/source/luacore/lua54/src/lstate.h404
-rw-r--r--source/luametatex/source/luacore/lua54/src/lstring.c273
-rw-r--r--source/luametatex/source/luacore/lua54/src/lstring.h57
-rw-r--r--source/luametatex/source/luacore/lua54/src/lstrlib.c1874
-rw-r--r--source/luametatex/source/luacore/lua54/src/ltable.c980
-rw-r--r--source/luametatex/source/luacore/lua54/src/ltable.h66
-rw-r--r--source/luametatex/source/luacore/lua54/src/ltablib.c430
-rw-r--r--source/luametatex/source/luacore/lua54/src/ltm.c271
-rw-r--r--source/luametatex/source/luacore/lua54/src/ltm.h103
-rw-r--r--source/luametatex/source/luacore/lua54/src/lua.c677
-rw-r--r--source/luametatex/source/luacore/lua54/src/lua.h518
-rw-r--r--source/luametatex/source/luacore/lua54/src/luaconf.h787
-rw-r--r--source/luametatex/source/luacore/lua54/src/lualib.h52
-rw-r--r--source/luametatex/source/luacore/lua54/src/lundump.c333
-rw-r--r--source/luametatex/source/luacore/lua54/src/lundump.h36
-rw-r--r--source/luametatex/source/luacore/lua54/src/lutf8lib.c286
-rw-r--r--source/luametatex/source/luacore/lua54/src/lvm.c1899
-rw-r--r--source/luametatex/source/luacore/lua54/src/lvm.h136
-rw-r--r--source/luametatex/source/luacore/lua54/src/lzio.c68
-rw-r--r--source/luametatex/source/luacore/lua54/src/lzio.h66
-rw-r--r--source/luametatex/source/luacore/luac/luac.c724
-rw-r--r--source/luametatex/source/luacore/luapeg/lpcap.c555
-rw-r--r--source/luametatex/source/luacore/luapeg/lpcap.h57
-rw-r--r--source/luametatex/source/luacore/luapeg/lpcode.c1014
-rw-r--r--source/luametatex/source/luacore/luapeg/lpcode.h40
-rw-r--r--source/luametatex/source/luacore/luapeg/lpprint.c244
-rw-r--r--source/luametatex/source/luacore/luapeg/lpprint.h36
-rw-r--r--source/luametatex/source/luacore/luapeg/lptree.c1305
-rw-r--r--source/luametatex/source/luacore/luapeg/lptree.h82
-rw-r--r--source/luametatex/source/luacore/luapeg/lptypes.h146
-rw-r--r--source/luametatex/source/luacore/luapeg/lpvm.c406
-rw-r--r--source/luametatex/source/luacore/luapeg/lpvm.h58
-rw-r--r--source/luametatex/source/luacore/luapeg/readme.txt9
-rw-r--r--source/luametatex/source/luacore/luasocket/LICENSE20
-rw-r--r--source/luametatex/source/luacore/luasocket/NEW44
-rw-r--r--source/luametatex/source/luacore/luasocket/README11
-rw-r--r--source/luametatex/source/luacore/luasocket/doc.zipbin0 -> 64647 bytes
-rw-r--r--source/luametatex/source/luacore/luasocket/etc.zipbin0 -> 19317 bytes
-rw-r--r--source/luametatex/source/luacore/luasocket/lua.zipbin0 -> 16888 bytes
-rw-r--r--source/luametatex/source/luacore/luasocket/samples.zipbin0 -> 8355 bytes
-rw-r--r--source/luametatex/source/luacore/luasocket/src/auxiliar.c154
-rw-r--r--source/luametatex/source/luacore/luasocket/src/auxiliar.h54
-rw-r--r--source/luametatex/source/luacore/luasocket/src/buffer.c273
-rw-r--r--source/luametatex/source/luacore/luasocket/src/buffer.h52
-rw-r--r--source/luametatex/source/luacore/luasocket/src/compat.c39
-rw-r--r--source/luametatex/source/luacore/luasocket/src/compat.h22
-rw-r--r--source/luametatex/source/luacore/luasocket/src/except.c129
-rw-r--r--source/luametatex/source/luacore/luasocket/src/except.h46
-rw-r--r--source/luametatex/source/luacore/luasocket/src/inet.c537
-rw-r--r--source/luametatex/source/luacore/luasocket/src/inet.h56
-rw-r--r--source/luametatex/source/luacore/luasocket/src/io.c28
-rw-r--r--source/luametatex/source/luacore/luasocket/src/io.h70
-rw-r--r--source/luametatex/source/luacore/luasocket/src/luasocket.c104
-rw-r--r--source/luametatex/source/luacore/luasocket/src/luasocket.h36
-rw-r--r--source/luametatex/source/luacore/luasocket/src/mime.c852
-rw-r--r--source/luametatex/source/luacore/luasocket/src/mime.h22
-rw-r--r--source/luametatex/source/luacore/luasocket/src/options.c455
-rw-r--r--source/luametatex/source/luacore/luasocket/src/options.h102
-rw-r--r--source/luametatex/source/luacore/luasocket/src/pierror.h28
-rw-r--r--source/luametatex/source/luacore/luasocket/src/select.c214
-rw-r--r--source/luametatex/source/luacore/luasocket/src/select.h23
-rw-r--r--source/luametatex/source/luacore/luasocket/src/serial.c171
-rw-r--r--source/luametatex/source/luacore/luasocket/src/socket.c5
-rw-r--r--source/luametatex/source/luacore/luasocket/src/socket.h73
-rw-r--r--source/luametatex/source/luacore/luasocket/src/tcp.c471
-rw-r--r--source/luametatex/source/luacore/luasocket/src/tcp.h43
-rw-r--r--source/luametatex/source/luacore/luasocket/src/timeout.c226
-rw-r--r--source/luametatex/source/luacore/luasocket/src/timeout.h40
-rw-r--r--source/luametatex/source/luacore/luasocket/src/udp.c488
-rw-r--r--source/luametatex/source/luacore/luasocket/src/udp.h39
-rw-r--r--source/luametatex/source/luacore/luasocket/src/unix.c69
-rw-r--r--source/luametatex/source/luacore/luasocket/src/unix.h26
-rw-r--r--source/luametatex/source/luacore/luasocket/src/unixdgram.c405
-rw-r--r--source/luametatex/source/luacore/luasocket/src/unixdgram.h28
-rw-r--r--source/luametatex/source/luacore/luasocket/src/unixstream.c355
-rw-r--r--source/luametatex/source/luacore/luasocket/src/unixstream.h29
-rw-r--r--source/luametatex/source/luacore/luasocket/src/usocket.c454
-rw-r--r--source/luametatex/source/luacore/luasocket/src/usocket.h59
-rw-r--r--source/luametatex/source/luacore/luasocket/src/wsocket.c434
-rw-r--r--source/luametatex/source/luacore/luasocket/src/wsocket.h33
-rw-r--r--source/luametatex/source/luacore/luasocket/test.zipbin0 -> 50491 bytes
-rw-r--r--source/luametatex/source/luacore/readme.txt34
-rw-r--r--source/luametatex/source/luametatex.c61
-rw-r--r--source/luametatex/source/luametatex.h345
-rw-r--r--source/luametatex/source/luaoptional/cmake/mujs/CMakeLists.txt107
-rw-r--r--source/luametatex/source/luaoptional/cmake/mujs/CMakeSettings.json28
-rw-r--r--source/luametatex/source/luaoptional/lmtcerflib.c133
-rw-r--r--source/luametatex/source/luaoptional/lmtcurl.c506
-rw-r--r--source/luametatex/source/luaoptional/lmtforeign.c1191
-rw-r--r--source/luametatex/source/luaoptional/lmtghostscript.c175
-rw-r--r--source/luametatex/source/luaoptional/lmtgraphicsmagick.c199
-rw-r--r--source/luametatex/source/luaoptional/lmthb.c761
-rw-r--r--source/luametatex/source/luaoptional/lmtimagemagick.c144
-rw-r--r--source/luametatex/source/luaoptional/lmtkpse.c311
-rw-r--r--source/luametatex/source/luaoptional/lmtlz4.c193
-rw-r--r--source/luametatex/source/luaoptional/lmtlzma.c228
-rw-r--r--source/luametatex/source/luaoptional/lmtlzo.c108
-rw-r--r--source/luametatex/source/luaoptional/lmtmujs.c609
-rw-r--r--source/luametatex/source/luaoptional/lmtmysql.c325
-rw-r--r--source/luametatex/source/luaoptional/lmtoptional.c50
-rw-r--r--source/luametatex/source/luaoptional/lmtoptional.h34
-rw-r--r--source/luametatex/source/luaoptional/lmtpostgress.c306
-rw-r--r--source/luametatex/source/luaoptional/lmtsqlite.c228
-rw-r--r--source/luametatex/source/luaoptional/lmtzint.c518
-rw-r--r--source/luametatex/source/luaoptional/lmtzstd.c118
-rw-r--r--source/luametatex/source/luaoptional/readme.txt30
-rw-r--r--source/luametatex/source/luarest/lmtaeslib.c115
-rw-r--r--source/luametatex/source/luarest/lmtbasexxlib.c193
-rw-r--r--source/luametatex/source/luarest/lmtdecodelib.c600
-rw-r--r--source/luametatex/source/luarest/lmtfilelib.c877
-rw-r--r--source/luametatex/source/luarest/lmtiolibext.c1608
-rw-r--r--source/luametatex/source/luarest/lmtmd5lib.c88
-rw-r--r--source/luametatex/source/luarest/lmtoslibext.c430
-rw-r--r--source/luametatex/source/luarest/lmtpdfelib.c1850
-rw-r--r--source/luametatex/source/luarest/lmtsha2lib.c57
-rw-r--r--source/luametatex/source/luarest/lmtsparselib.c305
-rw-r--r--source/luametatex/source/luarest/lmtstrlibext.c927
-rw-r--r--source/luametatex/source/luarest/lmtxcomplexlib.c403
-rw-r--r--source/luametatex/source/luarest/lmtxdecimallib.c503
-rw-r--r--source/luametatex/source/luarest/lmtxmathlib.c500
-rw-r--r--source/luametatex/source/luarest/lmtziplib.c206
-rw-r--r--source/luametatex/source/mp/mpc/mp.c22101
-rw-r--r--source/luametatex/source/mp/mpc/mp.h1514
-rw-r--r--source/luametatex/source/mp/mpc/mpconfig.h26
-rw-r--r--source/luametatex/source/mp/mpc/mpmath.c1501
-rw-r--r--source/luametatex/source/mp/mpc/mpmath.h12
-rw-r--r--source/luametatex/source/mp/mpc/mpmathbinary.c16
-rw-r--r--source/luametatex/source/mp/mpc/mpmathbinary.h12
-rw-r--r--source/luametatex/source/mp/mpc/mpmathdecimal.c1603
-rw-r--r--source/luametatex/source/mp/mpc/mpmathdecimal.h12
-rw-r--r--source/luametatex/source/mp/mpc/mpmathdouble.c1160
-rw-r--r--source/luametatex/source/mp/mpc/mpmathdouble.h12
-rw-r--r--source/luametatex/source/mp/mpc/mpstrings.c291
-rw-r--r--source/luametatex/source/mp/mpc/mpstrings.h42
-rw-r--r--source/luametatex/source/mp/mpw/mp.w31138
-rw-r--r--source/luametatex/source/mp/mpw/mpmath.w1949
-rw-r--r--source/luametatex/source/mp/mpw/mpmathbinary.w27
-rw-r--r--source/luametatex/source/mp/mpw/mpmathdecimal.w1971
-rw-r--r--source/luametatex/source/mp/mpw/mpmathdouble.w1523
-rw-r--r--source/luametatex/source/mp/mpw/mpstrings.w452
-rw-r--r--source/luametatex/source/mp/readme.txt14
-rw-r--r--source/luametatex/source/readme.txt563
-rw-r--r--source/luametatex/source/tex/texadjust.c393
-rw-r--r--source/luametatex/source/tex/texadjust.h36
-rw-r--r--source/luametatex/source/tex/texalign.c1854
-rw-r--r--source/luametatex/source/tex/texalign.h24
-rw-r--r--source/luametatex/source/tex/texarithmetic.c433
-rw-r--r--source/luametatex/source/tex/texarithmetic.h42
-rw-r--r--source/luametatex/source/tex/texbuildpage.c1271
-rw-r--r--source/luametatex/source/tex/texbuildpage.h104
-rw-r--r--source/luametatex/source/tex/texcommands.c1318
-rw-r--r--source/luametatex/source/tex/texcommands.h1184
-rw-r--r--source/luametatex/source/tex/texconditional.c1386
-rw-r--r--source/luametatex/source/tex/texconditional.h131
-rw-r--r--source/luametatex/source/tex/texdirections.c172
-rw-r--r--source/luametatex/source/tex/texdirections.h123
-rw-r--r--source/luametatex/source/tex/texdumpdata.c331
-rw-r--r--source/luametatex/source/tex/texdumpdata.h105
-rw-r--r--source/luametatex/source/tex/texequivalents.c1964
-rw-r--r--source/luametatex/source/tex/texequivalents.h1776
-rw-r--r--source/luametatex/source/tex/texerrors.c704
-rw-r--r--source/luametatex/source/tex/texerrors.h117
-rw-r--r--source/luametatex/source/tex/texexpand.c1411
-rw-r--r--source/luametatex/source/tex/texexpand.h35
-rw-r--r--source/luametatex/source/tex/texfileio.c939
-rw-r--r--source/luametatex/source/tex/texfileio.h81
-rw-r--r--source/luametatex/source/tex/texfont.c2062
-rw-r--r--source/luametatex/source/tex/texfont.h667
-rw-r--r--source/luametatex/source/tex/texinputstack.c1159
-rw-r--r--source/luametatex/source/tex/texinputstack.h452
-rw-r--r--source/luametatex/source/tex/texinserts.c517
-rw-r--r--source/luametatex/source/tex/texinserts.h101
-rw-r--r--source/luametatex/source/tex/texlanguage.c1774
-rw-r--r--source/luametatex/source/tex/texlanguage.h94
-rw-r--r--source/luametatex/source/tex/texlegacy.c11
-rw-r--r--source/luametatex/source/tex/texlinebreak.c3531
-rw-r--r--source/luametatex/source/tex/texlinebreak.h206
-rw-r--r--source/luametatex/source/tex/texlocalboxes.c313
-rw-r--r--source/luametatex/source/tex/texlocalboxes.h35
-rw-r--r--source/luametatex/source/tex/texmainbody.c590
-rw-r--r--source/luametatex/source/tex/texmainbody.h43
-rw-r--r--source/luametatex/source/tex/texmaincontrol.c6412
-rw-r--r--source/luametatex/source/tex/texmaincontrol.h76
-rw-r--r--source/luametatex/source/tex/texmarks.c346
-rw-r--r--source/luametatex/source/tex/texmarks.h65
-rw-r--r--source/luametatex/source/tex/texmath.c5593
-rw-r--r--source/luametatex/source/tex/texmath.h758
-rw-r--r--source/luametatex/source/tex/texmathcodes.c347
-rw-r--r--source/luametatex/source/tex/texmathcodes.h77
-rw-r--r--source/luametatex/source/tex/texmlist.c7668
-rw-r--r--source/luametatex/source/tex/texmlist.h30
-rw-r--r--source/luametatex/source/tex/texnesting.c432
-rw-r--r--source/luametatex/source/tex/texnesting.h71
-rw-r--r--source/luametatex/source/tex/texnodes.c4794
-rw-r--r--source/luametatex/source/tex/texnodes.h2728
-rw-r--r--source/luametatex/source/tex/texpackaging.c3409
-rw-r--r--source/luametatex/source/tex/texpackaging.h205
-rw-r--r--source/luametatex/source/tex/texprimitive.c913
-rw-r--r--source/luametatex/source/tex/texprimitive.h95
-rw-r--r--source/luametatex/source/tex/texprinting.c1460
-rw-r--r--source/luametatex/source/tex/texprinting.h133
-rw-r--r--source/luametatex/source/tex/texrules.c248
-rw-r--r--source/luametatex/source/tex/texrules.h27
-rw-r--r--source/luametatex/source/tex/texscanning.c5760
-rw-r--r--source/luametatex/source/tex/texscanning.h210
-rw-r--r--source/luametatex/source/tex/texstringpool.c607
-rw-r--r--source/luametatex/source/tex/texstringpool.h110
-rw-r--r--source/luametatex/source/tex/textextcodes.c607
-rw-r--r--source/luametatex/source/tex/textextcodes.h49
-rw-r--r--source/luametatex/source/tex/textoken.c3511
-rw-r--r--source/luametatex/source/tex/textoken.h399
-rw-r--r--source/luametatex/source/tex/textypes.c46
-rw-r--r--source/luametatex/source/tex/textypes.h699
-rw-r--r--source/luametatex/source/utilities/auxarithmetic.h61
-rw-r--r--source/luametatex/source/utilities/auxfile.c294
-rw-r--r--source/luametatex/source/utilities/auxfile.h166
-rw-r--r--source/luametatex/source/utilities/auxmemory.c25
-rw-r--r--source/luametatex/source/utilities/auxmemory.h54
-rw-r--r--source/luametatex/source/utilities/auxsparsearray.c623
-rw-r--r--source/luametatex/source/utilities/auxsparsearray.h212
-rw-r--r--source/luametatex/source/utilities/auxsystem.c155
-rw-r--r--source/luametatex/source/utilities/auxsystem.h17
-rw-r--r--source/luametatex/source/utilities/auxunistring.c158
-rw-r--r--source/luametatex/source/utilities/auxunistring.h19
-rw-r--r--source/luametatex/source/utilities/auxzlib.c18
-rw-r--r--source/luametatex/source/utilities/auxzlib.h24
-rw-r--r--source/luametatex/tools/mp.patch.lua66
-rw-r--r--source/luametatex/tools/mtx-wtoc.lua667
-rw-r--r--tex/context/base/mkii/cont-new.mkii2
-rw-r--r--tex/context/base/mkii/context.mkii2
-rw-r--r--tex/context/base/mkii/mult-en.mkii5
-rw-r--r--tex/context/base/mkii/mult-ro.mkii1
-rw-r--r--tex/context/base/mkiv/cont-new.mkiv2
-rw-r--r--tex/context/base/mkiv/context.mkiv2
-rw-r--r--tex/context/base/mkiv/status-files.pdfbin24640 -> 24641 bytes
-rw-r--r--tex/context/base/mkiv/status-lua.pdfbin260463 -> 260468 bytes
-rw-r--r--tex/context/base/mkxl/cont-new.mkxl2
-rw-r--r--tex/context/base/mkxl/context.mkxl2
-rw-r--r--tex/context/base/mkxl/math-act.lmt14
-rw-r--r--tex/context/base/mkxl/math-dim.lmt2
-rw-r--r--tex/context/base/mkxl/math-frc.mkxl19
-rw-r--r--tex/context/base/mkxl/math-ini.mkxl22
-rw-r--r--tex/context/base/mkxl/math-noa.lmt16
-rw-r--r--tex/context/fonts/mkiv/minion-math.lfg61
-rw-r--r--tex/context/interface/mkii/keys-en.xml5
-rw-r--r--tex/context/interface/mkii/keys-ro.xml1
-rw-r--r--tex/generic/context/luatex/luatex-fonts-merged.lua2
457 files changed, 292635 insertions, 31 deletions
diff --git a/README.adoc b/README.adoc
new file mode 100644
index 000000000..130aa7170
--- /dev/null
+++ b/README.adoc
@@ -0,0 +1,18 @@
+== ConTeXt source code
+
+This repository hosts ConTeXt, a TeX macro package. There are three versions:
+
+MkII:: the frozen version meant for pdfTeX
+MkIV:: the mostly frozen version meant for LuaTeX
+MkXL:: the latest version running on LuaMetaTeX
+
+Here we collect all the file needed to run ConTeXt, including the sources of
+LuaMetaTeX. More information can be found on the wiki:
+
+* https://wiki.contextgarden.net
+
+For support there is a mailing list available ntg-context@ntg.nl
+
+* https://www.ntg.nl/mailman/listinfo/ntg-context
+
+Hans Hagen
diff --git a/doc/context/sources/general/manuals/lowlevel/lowlevel-style.tex b/doc/context/sources/general/manuals/lowlevel/lowlevel-style.tex
index a8eba991e..9d3bcdbb3 100644
--- a/doc/context/sources/general/manuals/lowlevel/lowlevel-style.tex
+++ b/doc/context/sources/general/manuals/lowlevel/lowlevel-style.tex
@@ -103,7 +103,9 @@
\startsetups document:start
\startMPpage
+ StartPage;
\includeMPgraphic{titlepage} ;
+ StopPage;
\stopMPpage
\page
diff --git a/source/luametatex/CMakeLists.txt b/source/luametatex/CMakeLists.txt
new file mode 100644
index 000000000..d972a0312
--- /dev/null
+++ b/source/luametatex/CMakeLists.txt
@@ -0,0 +1,258 @@
+cmake_minimum_required(VERSION 3.9)
+
+project(luametatex VERSION 2.10 LANGUAGES C)
+
+set(CMAKE_C_STANDARD 11)
+# set(CMAKE_CXX_STANDARD 17)
+
+# https://sourceforge.net/p/predef/wiki/OperatingSystems/
+# https://sourceforge.net/p/predef/wiki/Architectures/
+
+include(GNUInstallDirs)
+
+# Optionals (maybe have a LMT_*_TOO for each of them). We might start out with only a very few
+# optionals at some time, but for now we enable them (there is not not much code involved). The
+# idea behind thes eoptionals is that we have very simple (!) interfaces, delegating as much as
+# possible to Lua. We will *not* add interfaces with many bindings because that will introduce
+# dependencies (and looking at e.g. LuaTeX build updates shows thatc clearly: a no-go).
+
+set(LMT_KPSE_TOO 1) # In case we want to manage MKII scripts (etc) with mtxrun.
+set(LMT_HB_TOO 1) # Maybe handy for Idris' font development (old converted ffi stuff)
+
+# When set, because we're sparse we also strip the binary. Because we only gain some 1-2% on
+# runtime, enabling it makes not much sense:
+
+# set(LMT_OPTIMIZE 1)
+
+if (MSVC)
+
+ if (CMAKE_C_COMPILER_ID STREQUAL "Clang")
+
+ add_compile_options(
+ -Wall
+ -O2
+
+ -Wcast-align
+ -Wcast-qual
+
+ -Wno-unknown-pragmas
+ -fno-strict-aliasing
+
+ -Wno-pedantic
+ -Wno-deprecated-declarations
+ -Wno-missing-noreturn
+ -Wno-shadow
+ )
+
+ add_definitions(-D_CRT_SECURE_NO_WARNINGS)
+
+ add_definitions(-DLMT_COMPILER_USED="clang")
+
+ else()
+
+ add_compile_options(
+ /Wall
+
+ /wd4127 # constant conditional expression
+ /wd4131 # old style declarator
+ /wd4152 # function pointer cast
+ /wd4201 # nonstandard extension used: nameless struct/union
+ /wd4244 # assignment in conditional expression
+ /wd4456 # local vars with same name as outer variable
+ /wd4457 # local vars with same function parameter
+ /wd4464 # relative include path
+ /wd4668 # missing defines
+ /wd4702 # unreachable code
+ /wd4710 # inlining
+ /wd4711 # inlining
+ /wd4774 # sprint argument 2 warning
+ /wd4777 # format argument 2 warning
+ /wd4820 # local vars with same name as outer variable
+ /wd4996 # strdup etc warnings
+ /wd5045 # spectre
+
+ # /GL # whole program link optimization
+ # /Gw # whole program data optimization (a little smaller bin)
+
+ # /Ob3 # more agressive inline, much larger bin, no gain
+
+ /wd4061 # enumerator * in switch * is not explicitly handles (mp)
+ /wd4701 # potentially unitialized local variable (lua)
+ /wd4255 # no function prototype given
+
+ /wd5105 # macro expansion producing 'defined' has undefined behavior
+
+ /wd4548 # expression before comma has no effect; expected expression with side-effect
+
+ # indeed a bit faster but also a much larger binary:
+
+ # /fp:fast
+
+ # okay for amd processors too but no difference in size so probably no gain:
+
+ # /favor:INTEL64
+ # /fsanitize:address
+ # /std:c17
+
+ )
+
+ # We always optimize ... symbols are not in the binary anyway so there is no advantage
+ # (like when accessing Lua api functions). We could have an additional luametatex-lua.dll
+ # but that also creates a dependency (possible conflict).
+
+ # if (DEFINED LMT_OPTIMIZE)
+ add_compile_options(
+ /GL # whole program link optimization
+ /Gw # whole program data optimization (a little smaller bin)
+ )
+ # endif()
+
+ add_definitions(-DLMT_COMPILER_USED="msvc")
+
+ endif()
+
+ else()
+
+ if (CMAKE_C_COMPILER_ID STREQUAL "Clang")
+
+ # why not -03
+
+ add_compile_options(
+ -O2
+ )
+
+ add_definitions(-DLMT_COMPILER_USED="clang")
+
+ else()
+
+ add_compile_options(
+ -O3
+ # -g0
+ # -mtune=nocona # fails on arm so more testing needed
+ )
+
+ add_definitions(-DLMT_COMPILER_USED="gcc")
+
+ # add_compile_options(-pg)
+ # add_link_options(-pg)
+
+ endif()
+
+ add_compile_options(
+ -Wall
+
+ -Wcast-align
+ -Wcast-qual
+
+ -Wno-unknown-pragmas
+ -fno-strict-aliasing
+ )
+
+ # for c17
+ #
+ # add_definitions(-D__STDC_WANT_LIB_EXT2__=1)
+
+ if (DEFINED LMT_OPTIMIZE)
+ if (NOT (${CMAKE_SYSTEM_NAME} MATCHES "Darwin"))
+ set(CMAKE_EXE_LINKER_FLAGS "-s")
+ endif()
+ endif()
+
+endif()
+
+if (CMAKE_C_COMPILER_ID STREQUAL "Clang")
+
+ add_compile_options(
+ -Wno-unknown-warning-option
+ -Wno-nonportable-include-path
+ -Wno-nonportable-system-include-path
+ -Wno-newline-eof
+ -Wno-extra-semi-stmt
+ -Wno-sign-conversion
+ -Wno-unused-macros
+ -Wno-reserved-id-macro
+ -Wno-comma
+ -Wno-switch-enum
+ -Wno-shadow
+ -Wno-missing-noreturn
+ -Wno-implicit-fallthrough
+ # -Wno-format
+ )
+
+endif()
+
+# Not that tested (converted ffi originals):
+
+if ((DEFINED LMT_KPSE_TOO))
+ add_definitions(-DLMT_KPSE_TOO=1)
+endif()
+if ((DEFINED LMT_HB_TOO))
+ add_definitions(-DLMT_HB_TOO=1)
+endif()
+
+# This needs cmake >= 3.9 and produces a 60K smaller mingw binary but it take quite a bit or
+# runtime to get there so it should become an option (apart from testing on all builders).
+
+if (DEFINED LMT_OPTIMIZE)
+
+ include(CheckIPOSupported)
+ check_ipo_supported(RESULT ipo_supported OUTPUT ipo_message)
+
+ if (ipo_supported)
+ #
+ # We only have one program so we do it global (can become an -- option)
+ #
+ # set_property(TARGET luametatex PROPERTY INTERPROCEDURAL_OPTIMIZATION TRUE)
+ #
+ # mingw64: 2865664, nocona: 2819584, lto: 2835968 (around 1% gain on manual)
+
+ set(CMAKE_INTERPROCEDURAL_OPTIMIZATION TRUE)
+ #
+ else()
+ # No message needed, just accept the fact.
+ endif()
+
+endif()
+
+# Mimalloc is still under development, so we only support it on a few platforms. By the time it is
+# stable we can probably remove some of the following tests. A bit of a hack:
+#
+# When the old osx version is dropped and armhf is upgraded we can enable unix except solaris which
+# fails. So, only osx 10.6 and rpi 32 fail. But we will probably drop 32 bit in the future anyway.
+
+# CMAKE_HOST_SYSTEM_PROCESSOR arm64 x86_64
+
+if (CMAKE_HOST_SOLARIS)
+ # fails
+elseif (MSVC)
+ set(luametatex_use_mimalloc 1)
+elseif (CMAKE_HOST_APPLE AND NOT (${CMAKE_C_COMPILER} MATCHES "arm"))
+ # fails on the osx intel
+elseif (${CMAKE_SYSTEM_PROCESSOR} MATCHES "armv7l")
+ # fails on the rpi 32 bit
+else()
+ set(luametatex_use_mimalloc 1)
+endif()
+
+include_directories(${CMAKE_ROOT}/source)
+include_directories(${CMAKE_CURRENT_SOURCE_DIR}/source)
+
+if ((DEFINED luametatex_use_mimalloc))
+ add_definitions(-DLUAMETATEX_USE_MIMALLOC=1)
+ # add_definitions(-DMIMALLOC_RESET_DELAY=250)
+ # set(luametatex_use_mimalloc 1)
+ include(cmake/mimalloc.cmake)
+endif()
+
+include(cmake/tex.cmake)
+include(cmake/lua.cmake)
+include(cmake/mp.cmake)
+
+include(cmake/luarest.cmake)
+include(cmake/luasocket.cmake)
+include(cmake/luaoptional.cmake)
+
+include(cmake/pplib.cmake)
+include(cmake/miniz.cmake)
+
+include(cmake/luametatex.cmake)
diff --git a/source/luametatex/CMakeSettings.json b/source/luametatex/CMakeSettings.json
new file mode 100644
index 000000000..8b2bb1951
--- /dev/null
+++ b/source/luametatex/CMakeSettings.json
@@ -0,0 +1,73 @@
+{
+ "configurations": [
+ {
+ "name": "msvc-x64-debug",
+ "generator": "Ninja",
+ "configurationType": "Debug",
+ "inheritEnvironments": [ "msvc_x64_x64" ],
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\..\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": ""
+ },
+ {
+ "name": "msvc-x64-release",
+ "generator": "Ninja",
+ "configurationType": "Release",
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\..\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": "",
+ "inheritEnvironments": [ "msvc_x64_x64" ]
+ },
+ {
+ "name": "msvc-x64-clang",
+ "generator": "Ninja",
+ "configurationType": "Release",
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\..\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": "",
+ "inheritEnvironments": [ "clang_cl_x64" ]
+ },
+ {
+ "name": "msvc-arm64-release",
+ "generator": "Ninja",
+ "configurationType": "Debug",
+ "inheritEnvironments": [ "msvc_arm64_x64" ],
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\..\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": ""
+ },
+ {
+ "name": "wsl-gcc-release",
+ "generator": "Ninja",
+ "configurationType": "RelWithDebInfo",
+ "buildRoot": "${projectDir}\\out\\build\\${name}",
+ "installRoot": "${projectDir}\\out\\install\\${name}",
+ "cmakeExecutable": "cmake",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "",
+ "ctestCommandArgs": "",
+ "inheritEnvironments": [ "linux_x64" ],
+ "wslPath": "${defaultWSLPath}",
+ "addressSanitizerRuntimeFlags": "detect_leaks=0"
+ },
+ {
+ "name": "msvc-x86-release",
+ "generator": "Ninja",
+ "configurationType": "Release",
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\..\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": "",
+ "inheritEnvironments": [ "msvc_x86_x64" ]
+ }
+ ]
+} \ No newline at end of file
diff --git a/source/luametatex/build.cmd b/source/luametatex/build.cmd
new file mode 100644
index 000000000..17f06e185
--- /dev/null
+++ b/source/luametatex/build.cmd
@@ -0,0 +1,89 @@
+rem When something fails, make sure to remove the cmake cache. When compile from
+rem the Visual Studio environment mixed with compiling from the command line
+rem some confusion can occur.
+
+setlocal
+
+@echo .
+@echo supported flags : --arm64 --x64 --x86 --intel64 --intel86
+@echo .
+
+set luametatexsources=%~dp0
+set luametatexplatform=x64
+set msvcplatform=x64
+
+for %%G in (%*) do (
+ if [%%G] == [--arm64] (
+ set luametatexplatform=arm64
+ set msvcplatform=x86_arm64
+ )
+ if [%%G] == [--intel64] (
+ set luametatexplatform=x64
+ set msvcplatform=amd64
+ )
+ if [%%G] == [--intel86] (
+ set luametatexplatform=x86
+ set msvcplatform=x86_amd64
+ )
+ if [%%G] == [--x64] (
+ set luametatexplatform=x64
+ set msvcplatform=amd64
+ )
+ if [%%G] == [--x86] (
+ set luametatexplatform=x86
+ set msvcplatform=x86_amd64
+ )
+)
+
+set visualstudiopath=c:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build
+set luametatexbuildpath=msvc-cmd-%luametatexplatform%-release
+
+@echo .
+@echo luametatexplatform : %luametatexplatform%
+@echo msvcplatform : %msvcplatform%
+@echo visualstudiopath : %visualstudiopath%
+@echo luametatexbuildpath : %luametatexbuildpath%
+@echo .
+
+mkdir build
+chdir build
+rmdir /S /Q %luametatexbuildpath%
+mkdir %luametatexbuildpath%
+chdir %luametatexbuildpath%
+
+call "%visualstudiopath%\vcvarsall.bat" %msvcplatform%
+
+cmake ../..
+cmake --build . --config Release --parallel 8
+
+cd ..
+cd ..
+
+dir build\%luametatexbuildpath%\Release\luametatex.exe
+
+@echo .
+@echo tex trees:
+@echo .
+@echo resources like public fonts : tex/texmf/....
+@echo the context macro package : tex/texmf-context/....
+@echo the luametatex binary : tex/texmf-win64/bin/...
+@echo optional third party modules : tex/texmf-context/....
+@echo fonts installed by the user : tex/texmf-fonts/fonts/data/....
+@echo styles made by the user : tex/texmf-projects/tex/context/user/....
+@echo .
+@echo binaries:
+@echo .
+@echo tex/texmf-win64/bin/luametatex.exe : the compiled binary (some 2-3MB)
+@echo tex/texmf-win64/bin/mtxrun.exe : copy of or link to luametatex.exe
+@echo tex/texmf-win64/bin/context.exe : copy of or link to luametatex.exe
+@echo tex/texmf-win64/bin/mtxrun.lua : copy of tex/texmf-context/scripts/context/lua/mtxrun.lua
+@echo tex/texmf-win64/bin/context.lua : copy of tex/texmf-context/scripts/context/lua/context.lua
+@echo .
+@echo commands:
+@echo .
+@echo mtxrun --generate : create file database
+@echo mtxrun --script fonts --reload : create font database
+@echo mtxrun --autogenerate context ... : run tex file (e.g. from editor)
+@echo .
+
+endlocal
diff --git a/source/luametatex/build.sh b/source/luametatex/build.sh
new file mode 100644
index 000000000..60e7d13d5
--- /dev/null
+++ b/source/luametatex/build.sh
@@ -0,0 +1,72 @@
+# The official designated locations are:
+#
+# <texroot/tex/texmf-mswin/bin <texroot/tex/texmf-win64/bin
+# <texroot/tex/texmf-linux-32/bin <texroot/tex/texmf-linux-64/bin
+# <texroot/tex/texmf-linux-armhf/bin
+# <texroot/tex/texmf-osx-64/bin
+# <texroot/tex/texmf-freebsd/bin <texroot/tex/texmf-freebsd-amd64/bin
+# <texroot/tex/texmf-openbsdX.Y/bin <texroot/tex/texmf-openbsdX.Y-amd64/bin
+#
+# The above bin directory only needs:
+#
+# luametatex[.exe]
+# context[.exe] -> luametatex[.exe]
+# mtxrun[.exe] -> luametatex[.exe]
+# mtxrun.lua (latest version)
+# context.lua (latest version)
+
+if [ "$1" = "mingw-64" ] || [ "$1" = "mingw64" ] || [ "$1" = "mingw" ] || [ "$1" == "--mingw64" ]
+then
+
+ PLATFORM="win64"
+ SUFFIX=".exe"
+ mkdir -p build/mingw-64
+ cd build/mingw-64
+ cmake -G Ninja -DCMAKE_TOOLCHAIN_FILE=./cmake/mingw-64.cmake ../..
+
+elif [ "$1" = "mingw-32" ] || [ "$1" = "mingw32" ] || [ "$1" == "--mingw32" ]
+then
+
+ PLATFORM="mswin"
+ SUFFIX=".exe"
+ mkdir -p build/mingw-32
+ cd build/mingw-32
+ cmake -G Ninja -DCMAKE_TOOLCHAIN_FILE=./cmake/mingw-32.cmake ../..
+
+else
+
+ PLATFORM="native"
+ SUFFIX=" "
+ mkdir -p build/native
+ cd build/native
+ cmake -G Ninja ../..
+
+fi
+
+#~ make -j8
+cmake --build . --parallel 8
+
+echo ""
+echo "tex trees"
+echo ""
+echo "resources like public fonts : tex/texmf/...."
+echo "the context macro package : tex/texmf-context/...."
+echo "the luametatex binary : tex/texmf-$PLATFORM/bin/..."
+echo "optional third party modules : tex/texmf-context/...."
+echo "fonts installed by the user : tex/texmf-fonts/fonts/data/...."
+echo "styles made by the user : tex/texmf-projects/tex/context/user/...."
+echo ""
+echo "binaries:"
+echo ""
+echo "tex/texmf-<your platform>/bin/luametatex$SUFFIX : the compiled binary (some 2-3MB)"
+echo "tex/texmf-<your platform>/bin/mtxrun$SUFFIX : copy of or link to luametatex"
+echo "tex/texmf-<your platform>/bin/context$SUFFIX : copy of or link to luametatex"
+echo "tex/texmf-<your platform>/bin/mtxrun.lua : copy of tex/texmf-context/scripts/context/lua/mtxrun.lua"
+echo "tex/texmf-<your platform>/bin/context.lua : copy of tex/texmf-context/scripts/context/lua/context.lua"
+echo ""
+echo "commands:"
+echo ""
+echo "mtxrun --generate : create file database"
+echo "mtxrun --script fonts --reload : create font database"
+echo "mtxrun --autogenerate context ... : run tex file (e.g. from editor)"
+echo ""
diff --git a/source/luametatex/build.txt b/source/luametatex/build.txt
new file mode 100644
index 000000000..aa81254e6
--- /dev/null
+++ b/source/luametatex/build.txt
@@ -0,0 +1,43 @@
+Hi,
+
+The build script produce efficient static binaries with only a couple of system libraries as
+dependency. ConTeXt will not depend on anything else than provided here. Lua is the extension
+language to be used and that has worked well for quite a while now.
+
+The build script that is provided will compile under ./build so you might want to make a copy
+of the source tree to a suitable place that you can wipe after the job is done. The script
+accepts only a few command line arguments.
+
+ build.sh :
+
+ --native build/native meant for unix (linux, freebsd, openbsd, osx, arm)
+ --mingw-32 build/mingw-32 meant for 32 bit windows (crosscompiled)
+ --mingw-64 build/mingw-64 meant for 64 bit windows (crosscompiled)
+
+I develop LuaMetaTeX on Windows and use WLS (with OpenSuse) for cross compilation as well as
+native Linux binaries. Editing is done in Visual Studio with the exception of the MetaPost
+CWeb files for which I use SciTE.
+
+Because we use CMake, you can compile using the MSVC compiler as well as CLang. Currently the
+MingW crosscompiled binaries are slightly faster, next come the native ones, but till now
+CLang lags behind. The native compiler produces the smallest binaries and compiles fastest.
+
+ build.cmd :
+
+ --x64 build/msvc-cmd-x64 meant for 64 bit windows using intel/amd chips
+ --x32 build/msvc-cmd-x86 meant for 32 bit windows using intel/amd chips
+ --arm64 build/msvc-cmd-arm64 meant for 64 bit windows using arm chips
+
+Alternatively you can run a build job from Visual Studio. Of course it only works well if you
+have the right compilers installed which is easy to do from the user interface. All settings
+happen in CMakeLists.txt so you have to load that one.
+
+Support for LuaMetaTeX and ConTeXt is provided at the (dev-)context mailing lists and at the
+ConTeXt Wiki. Binaries are available at:
+
+ https://build.contextgarden.net/#/waterfall?tags=c.luametatex
+ https://dl.contextgarden.net/build/luametatex
+
+The first link shows the status, the second link is where the binaries can be downloaded.
+
+Hans Hagen
diff --git a/source/luametatex/cmake/debug.cmake b/source/luametatex/cmake/debug.cmake
new file mode 100644
index 000000000..2aa5dbf4f
--- /dev/null
+++ b/source/luametatex/cmake/debug.cmake
@@ -0,0 +1,13 @@
+# When we run valgrind we need verbose binaries:
+#
+# valgrind -v --track-origins=yes --leak-check=full context ...
+
+# add_compile_options(-pg)
+# set(CMAKE_EXE_LINKER_FLAGS "-pg")
+
+# In addition to the microsoft compiler alignment suggestions we can run on linux:
+#
+# pahole luametatex
+
+# add_compile_options(-p -gdwarf)
+# set(CMAKE_EXE_LINKER_FLAGS "-p -gdwarf")
diff --git a/source/luametatex/cmake/lua.cmake b/source/luametatex/cmake/lua.cmake
new file mode 100644
index 000000000..8e370a05e
--- /dev/null
+++ b/source/luametatex/cmake/lua.cmake
@@ -0,0 +1,87 @@
+set(lua_sources
+
+ source/luacore/lua54/src/lapi.c
+ source/luacore/lua54/src/lauxlib.c
+ source/luacore/lua54/src/lbaselib.c
+ source/luacore/lua54/src/lcode.c
+ source/luacore/lua54/src/lcorolib.c
+ source/luacore/lua54/src/lctype.c
+ source/luacore/lua54/src/ldblib.c
+ source/luacore/lua54/src/ldebug.c
+ source/luacore/lua54/src/ldo.c
+ source/luacore/lua54/src/ldump.c
+ source/luacore/lua54/src/lfunc.c
+ source/luacore/lua54/src/lgc.c
+ source/luacore/lua54/src/linit.c
+ source/luacore/lua54/src/liolib.c
+ source/luacore/lua54/src/llex.c
+ source/luacore/lua54/src/lmathlib.c
+ source/luacore/lua54/src/lmem.c
+ source/luacore/lua54/src/loadlib.c
+ source/luacore/lua54/src/lobject.c
+ source/luacore/lua54/src/lopcodes.c
+ source/luacore/lua54/src/loslib.c
+ source/luacore/lua54/src/lparser.c
+ source/luacore/lua54/src/lstate.c
+ source/luacore/lua54/src/lstring.c
+ source/luacore/lua54/src/lstrlib.c
+ source/luacore/lua54/src/ltable.c
+ source/luacore/lua54/src/ltablib.c
+ source/luacore/lua54/src/ltm.c
+ source/luacore/lua54/src/lua.c
+ source/luacore/lua54/src/lundump.c
+ source/luacore/lua54/src/lutf8lib.c
+ source/luacore/lua54/src/lvm.c
+ source/luacore/lua54/src/lzio.c
+
+ source/luacore/luapeg/lptree.c
+ source/luacore/luapeg/lpvm.c
+ source/luacore/luapeg/lpprint.c
+ source/luacore/luapeg/lpcap.c
+ source/luacore/luapeg/lpcode.c
+
+)
+
+add_library(lua STATIC ${lua_sources})
+
+set_property(TARGET lua PROPERTY C_STANDARD 99)
+
+target_include_directories(lua PRIVATE
+ source/luacore/lua54/src
+ source/luacore/luapeg
+)
+
+# luajit: 8000, lua 5.3: 1000000 or 15000
+
+target_compile_definitions(lua PUBLIC
+ # This one should also be set in the lua namespace!
+ # LUAI_HASHLIMIT=6 # obsolete
+ LUAI_MAXCSTACK=6000
+ LUA_UCID
+ # LUA_USE_JUMPTABLE=0
+ LPEG_DEBUG
+ # LUA_NOCVTS2N
+ # LUA_NOBUILTIN # disable likely usage
+ # LUAI_ASSERT
+ # LUA_STRFTIMEOPTIONS="aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%"
+)
+
+if (UNIX)
+ target_compile_definitions(lua PUBLIC
+ LUA_USE_POSIX
+ LUA_USE_DLOPEN
+ )
+endif (UNIX)
+
+if (NOT MSVC)
+ target_compile_options(lua PRIVATE
+ -Wno-cast-align
+ -Wno-cast-qual
+ )
+endif (NOT MSVC)
+
+# this seems to be ok for mingw default
+#
+# todo: what is the right way to increase the stack (mingw)
+
+# target_compile_options(lua PRIVATE -DLUAI_MAXCSTACK=65536 -Wl,--stack,16777216)
diff --git a/source/luametatex/cmake/luametatex.cmake b/source/luametatex/cmake/luametatex.cmake
new file mode 100644
index 000000000..396b33d5a
--- /dev/null
+++ b/source/luametatex/cmake/luametatex.cmake
@@ -0,0 +1,84 @@
+add_compile_options(-DLUA_CORE)
+
+set(luametatex_sources
+ source/luametatex.c
+)
+
+add_executable(luametatex ${luametatex_sources})
+
+target_include_directories(luametatex PRIVATE
+ .
+ source/.
+ source/luacore/lua54/src
+)
+
+target_link_libraries(luametatex
+ tex
+ lua
+ mp
+
+ luarest
+ luasocket
+ luaoptional
+
+ pplib
+ miniz
+)
+
+target_link_libraries(luametatex
+ ${CMAKE_DL_LIBS}
+)
+
+install(TARGETS luametatex
+ EXPORT luametatex
+ RUNTIME
+ DESTINATION ${CMAKE_INSTALL_BINDIR}
+ COMPONENT luametatex_runtime
+)
+
+if (luametatex_use_mimalloc)
+ target_include_directories(luametatex PRIVATE
+ source/libraries/mimalloc/include
+ )
+ target_link_libraries(luametatex
+ mimalloc
+ )
+ if (LUAMETATEX_MINGW)
+ target_link_libraries(luametatex --static)
+ target_link_libraries(luametatex
+ pthread
+ psapi
+ bcrypt
+ )
+ elseif (NOT MSVC)
+ target_link_libraries(luametatex
+ pthread
+ )
+ endif()
+endif()
+
+if (NOT MSVC)
+ target_link_libraries(luametatex
+ m
+)
+endif()
+
+if (${CMAKE_HOST_SOLARIS})
+ target_link_libraries(luametatex
+ rt
+ socket
+ nsl
+ resolv
+)
+endif()
+
+if (DEFINED LMT_OPTIMIZE)
+ # we strip anyway
+elseif (CMAKE_HOST_SOLARIS)
+ # no strip
+elseif (CMAKE_C_COMPILER_ID MATCHES "GNU")
+ # -g -S -d : remove all debugging symbols & sections
+ # -x : remove all non-global symbols
+ # -X : remove any compiler-generated symbols
+ add_custom_command(TARGET luametatex POST_BUILD COMMAND ${CMAKE_STRIP} -g -S -d -x luametatex${CMAKE_EXECUTABLE_SUFFIX})
+endif()
diff --git a/source/luametatex/cmake/luaoptional.cmake b/source/luametatex/cmake/luaoptional.cmake
new file mode 100644
index 000000000..adcb790cf
--- /dev/null
+++ b/source/luametatex/cmake/luaoptional.cmake
@@ -0,0 +1,30 @@
+set(luaoptional_sources
+
+ source/luaoptional/lmtsqlite.c
+ source/luaoptional/lmtmysql.c
+ source/luaoptional/lmtpostgress.c
+ source/luaoptional/lmtcurl.c
+ source/luaoptional/lmtghostscript.c
+ source/luaoptional/lmtimagemagick.c
+ source/luaoptional/lmtgraphicsmagick.c
+ source/luaoptional/lmtzint.c
+ source/luaoptional/lmtmujs.c
+ source/luaoptional/lmtlzo.c
+ source/luaoptional/lmtlz4.c
+ source/luaoptional/lmtkpse.c
+ source/luaoptional/lmthb.c
+ source/luaoptional/lmtzstd.c
+ source/luaoptional/lmtlzma.c
+ source/luaoptional/lmtforeign.c
+
+)
+
+add_library(luaoptional STATIC ${luaoptional_sources})
+
+target_include_directories(luaoptional PRIVATE
+ .
+ source/.
+ source/luacore/lua54/src
+ source/libraries/mimalloc/include
+)
+
diff --git a/source/luametatex/cmake/luarest.cmake b/source/luametatex/cmake/luarest.cmake
new file mode 100644
index 000000000..e374ec156
--- /dev/null
+++ b/source/luametatex/cmake/luarest.cmake
@@ -0,0 +1,32 @@
+# The cerf library is actually optional but for now we compile it with the
+# rest because the complex interfaces are different per platform. There is
+# not that much code involved. But, anyway, at some point it might become
+# a real optional module in which case the following will change.
+
+set(luarest_sources
+
+ source/luaoptional/lmtcerflib.c
+
+ source/libraries/libcerf/erfcx.c
+ source/libraries/libcerf/err_fcts.c
+ source/libraries/libcerf/im_w_of_x.c
+ source/libraries/libcerf/w_of_z.c
+ source/libraries/libcerf/width.c
+)
+
+add_library(luarest STATIC ${luarest_sources})
+
+target_include_directories(luarest PRIVATE
+ source/libraries/libcerf
+ source/luacore/lua54/src
+)
+
+# only when all ok, to avoid messages
+
+include(CheckCCompilerFlag)
+
+CHECK_C_COMPILER_FLAG("-Wno-discarded-qualifiers" limited_support)
+
+if (limited_support)
+ target_compile_options(luarest PRIVATE -Wno-discarded-qualifiers)
+endif()
diff --git a/source/luametatex/cmake/luasocket.cmake b/source/luametatex/cmake/luasocket.cmake
new file mode 100644
index 000000000..8489b0a80
--- /dev/null
+++ b/source/luametatex/cmake/luasocket.cmake
@@ -0,0 +1,62 @@
+set(luasocket_sources
+
+ source/luacore/luasocket/src/auxiliar.c
+ source/luacore/luasocket/src/buffer.c
+ source/luacore/luasocket/src/compat.c
+ source/luacore/luasocket/src/except.c
+ source/luacore/luasocket/src/inet.c
+ source/luacore/luasocket/src/io.c
+ source/luacore/luasocket/src/luasocket.c
+ source/luacore/luasocket/src/mime.c
+ source/luacore/luasocket/src/options.c
+ source/luacore/luasocket/src/select.c
+ source/luacore/luasocket/src/socket.c
+ source/luacore/luasocket/src/tcp.c
+ source/luacore/luasocket/src/timeout.c
+ source/luacore/luasocket/src/udp.c
+
+ # source/luacore/luasocket/src/serial.c
+ # source/luacore/luasocket/src/usocket.c
+ # source/luacore/luasocket/src/wsocket.c
+
+ # source/luacore/luasec/src/config.c
+ # source/luacore/luasec/src/options.c
+ # source/luacore/luasec/src/ec.c
+ # source/luacore/luasec/src/x509.c
+ # source/luacore/luasec/src/context.c
+ # source/luacore/luasec/src/ssl.c
+
+)
+
+add_library(luasocket STATIC ${luasocket_sources})
+
+target_include_directories(luasocket PRIVATE
+ source/luacore/luasocket
+ # source/luacore/luasec
+ # source/luacore/luasec/src
+ source/luacore/lua54/src
+)
+
+if (NOT MSVC)
+ target_compile_options(luasocket PRIVATE
+ -Wno-cast-qual
+ -Wno-cast-align
+ )
+endif()
+
+if (WIN32)
+ target_link_libraries(luasocket PRIVATE
+ wsock32
+ ws2_32
+ )
+endif()
+
+if (CMAKE_CXX_COMPILER_ID STREQUAL "MSVC")
+ target_compile_definitions(luasocket PRIVATE
+ LUASOCKET_INET_PTON
+ )
+endif()
+
+
+
+
diff --git a/source/luametatex/cmake/mimalloc.cmake b/source/luametatex/cmake/mimalloc.cmake
new file mode 100644
index 000000000..78d3944e2
--- /dev/null
+++ b/source/luametatex/cmake/mimalloc.cmake
@@ -0,0 +1,44 @@
+include("source/libraries/mimalloc/cmake/mimalloc-config-version.cmake")
+
+set(mimalloc_sources
+
+ source/libraries/mimalloc/src/stats.c
+ source/libraries/mimalloc/src/random.c
+ source/libraries/mimalloc/src/os.c
+ source/libraries/mimalloc/src/bitmap.c
+ source/libraries/mimalloc/src/arena.c
+ # source/libraries/mimalloc/src/region.c
+ source/libraries/mimalloc/src/segment-cache.c
+ source/libraries/mimalloc/src/segment.c
+ source/libraries/mimalloc/src/page.c
+ source/libraries/mimalloc/src/alloc.c
+ source/libraries/mimalloc/src/alloc-aligned.c
+ source/libraries/mimalloc/src/alloc-posix.c
+ source/libraries/mimalloc/src/heap.c
+ source/libraries/mimalloc/src/options.c
+ source/libraries/mimalloc/src/init.c
+)
+
+add_library(mimalloc STATIC ${mimalloc_sources})
+
+# set(CMAKE_C_STANDARD 11)
+# set(CMAKE_CXX_STANDARD 17)
+
+target_include_directories(mimalloc PRIVATE
+ source/libraries/mimalloc
+ source/libraries/mimalloc/src
+ source/libraries/mimalloc/include
+)
+
+target_compile_definitions(mimalloc PRIVATE
+ MIMALLOC_LARGE_OS_PAGES=1
+ MI_DEBUG=0
+ MI_SECURE=0
+)
+
+if (NOT MSVC)
+ target_compile_options(mimalloc PRIVATE
+ -Wno-cast-align
+ -Wno-cast-qual
+ )
+endif ()
diff --git a/source/luametatex/cmake/mingw-32.cmake b/source/luametatex/cmake/mingw-32.cmake
new file mode 100644
index 000000000..ef5001226
--- /dev/null
+++ b/source/luametatex/cmake/mingw-32.cmake
@@ -0,0 +1,13 @@
+if (NOT __MINGW64_TOOLCHAIN_)
+ add_compile_options(-DLUASOCKET_INET_PTON)
+endif()
+
+set(CMAKE_SYSTEM_NAME Windows)
+set(TOOLCHAIN_PREFIX i686-w64-mingw32)
+set(CMAKE_C_COMPILER ${TOOLCHAIN_PREFIX}-gcc)
+
+add_compile_options(-mtune=nocona)
+
+set(LUAMETATEX_MINGW 32)
+
+# set(CMAKE_EXE_LINKER_FLAGS "-static-libgcc")
diff --git a/source/luametatex/cmake/mingw-64.cmake b/source/luametatex/cmake/mingw-64.cmake
new file mode 100644
index 000000000..c57bed871
--- /dev/null
+++ b/source/luametatex/cmake/mingw-64.cmake
@@ -0,0 +1,13 @@
+if (NOT __MINGW64_TOOLCHAIN_)
+ add_compile_options(-DLUASOCKET_INET_PTON)
+endif()
+
+set(CMAKE_SYSTEM_NAME Windows)
+set(TOOLCHAIN_PREFIX x86_64-w64-mingw32)
+set(CMAKE_C_COMPILER ${TOOLCHAIN_PREFIX}-gcc)
+
+add_compile_options(-mtune=nocona)
+
+set(LUAMETATEX_MINGW 64)
+
+# set(CMAKE_EXE_LINKER_FLAGS "-static-libgcc")
diff --git a/source/luametatex/cmake/miniz.cmake b/source/luametatex/cmake/miniz.cmake
new file mode 100644
index 000000000..8c1c0e84a
--- /dev/null
+++ b/source/luametatex/cmake/miniz.cmake
@@ -0,0 +1,21 @@
+set(miniz_sources
+
+ source/libraries/miniz/miniz.c
+
+)
+
+add_library(miniz STATIC ${miniz_sources})
+
+target_compile_definitions(miniz PUBLIC
+ MINIZ_NO_ARCHIVE_APIS=1
+ MINIZ_NO_STDIO=1
+ MINIZ_NO_MALLOC=1
+)
+
+if (NOT MSVC)
+ target_compile_options(miniz PRIVATE
+ -Wno-cast-align
+ -Wno-cast-qual
+ )
+endif (NOT MSVC)
+
diff --git a/source/luametatex/cmake/mp.cmake b/source/luametatex/cmake/mp.cmake
new file mode 100644
index 000000000..1d064101d
--- /dev/null
+++ b/source/luametatex/cmake/mp.cmake
@@ -0,0 +1,50 @@
+set(mp_sources
+
+ source/mp/mpc/mp.c
+ source/mp/mpc/mpstrings.c
+ source/mp/mpc/mpmath.c
+ source/mp/mpc/mpmathdouble.c
+ source/mp/mpc/mpmathbinary.c
+ source/mp/mpc/mpmathdecimal.c
+
+ source/libraries/decnumber/decContext.c
+ source/libraries/decnumber/decNumber.c
+
+ source/libraries/avl/avl.c
+
+ source/lua/lmtmplib.c
+
+ source/luarest/lmtxdecimallib.c
+
+)
+
+add_library(mp STATIC ${mp_sources})
+
+target_include_directories(mp PRIVATE
+ .
+ source/.
+ source/mp/mpc
+ source/luacore/lua54/src
+ source/libraries/avl
+ source/libraries/decnumber
+ source/utilities
+ source/libraries/mimalloc/include
+)
+
+target_compile_definitions(mp PUBLIC
+ DECUSE64=1
+ # DECCHECK=1
+ # DECBUFFER=512
+ DECNUMDIGITS=1000
+)
+
+if (NOT MSVC)
+ target_compile_options(mp PRIVATE
+ -Wno-unused-parameter
+ -Wno-sign-compare
+ -Wno-cast-qual
+ -Wno-cast-align
+ # for decnumber with lto
+ -fno-strict-aliasing
+)
+endif()
diff --git a/source/luametatex/cmake/pplib.cmake b/source/luametatex/cmake/pplib.cmake
new file mode 100644
index 000000000..3ca4c81c5
--- /dev/null
+++ b/source/luametatex/cmake/pplib.cmake
@@ -0,0 +1,43 @@
+set(pplib_sources
+
+ source/libraries/pplib/pparray.c
+ source/libraries/pplib/ppcrypt.c
+ source/libraries/pplib/ppdict.c
+ source/libraries/pplib/ppheap.c
+ source/libraries/pplib/ppload.c
+ source/libraries/pplib/ppstream.c
+ source/libraries/pplib/ppxref.c
+ source/libraries/pplib/util/utilbasexx.c
+ source/libraries/pplib/util/utilcrypt.c
+ source/libraries/pplib/util/utilflate.c
+ source/libraries/pplib/util/utilfpred.c
+ source/libraries/pplib/util/utiliof.c
+ source/libraries/pplib/util/utillog.c
+ source/libraries/pplib/util/utillzw.c
+ source/libraries/pplib/util/utilmd5.c
+ source/libraries/pplib/util/utilmem.c
+ source/libraries/pplib/util/utilmemheap.c
+ source/libraries/pplib/util/utilmemheapiof.c
+ source/libraries/pplib/util/utilmeminfo.c
+ source/libraries/pplib/util/utilnumber.c
+ source/libraries/pplib/util/utilsha.c
+
+)
+
+add_library(pplib STATIC ${pplib_sources})
+
+if (NOT MSVC)
+ target_compile_options(pplib PRIVATE
+ -Wno-missing-declarations
+ )
+endif (NOT MSVC)
+
+target_include_directories(pplib PRIVATE
+ source/libraries/pplib
+ source/libraries/pplib/util
+ source/libraries/zlib
+
+ source/libraries/miniz
+ source/utilities/auxmemory
+ source/utilities/auxzlib
+)
diff --git a/source/luametatex/cmake/tex.cmake b/source/luametatex/cmake/tex.cmake
new file mode 100644
index 000000000..83820aa1c
--- /dev/null
+++ b/source/luametatex/cmake/tex.cmake
@@ -0,0 +1,99 @@
+set(tex_sources
+
+ source/utilities/auxmemory.c
+ source/utilities/auxzlib.c
+ source/utilities/auxsparsearray.c
+ source/utilities/auxsystem.c
+ source/utilities/auxunistring.c
+ source/utilities/auxfile.c
+
+ source/libraries/hnj/hnjhyphen.c
+
+ source/lua/lmtinterface.c
+ source/lua/lmtlibrary.c
+ source/lua/lmtcallbacklib.c
+ source/lua/lmtlanguagelib.c
+ source/lua/lmtlualib.c
+ source/lua/lmtluaclib.c
+ source/lua/lmttexiolib.c
+ source/lua/lmttexlib.c
+ source/lua/lmttokenlib.c
+ source/lua/lmtnodelib.c
+ source/lua/lmtenginelib.c
+ source/lua/lmtfontlib.c
+ source/lua/lmtstatuslib.c
+
+ source/luaoptional/lmtoptional.c
+
+ source/luarest/lmtfilelib.c
+ source/luarest/lmtpdfelib.c
+ source/luarest/lmtiolibext.c
+ source/luarest/lmtoslibext.c
+ source/luarest/lmtstrlibext.c
+ source/luarest/lmtdecodelib.c
+ source/luarest/lmtsha2lib.c
+ source/luarest/lmtmd5lib.c
+ source/luarest/lmtaeslib.c
+ source/luarest/lmtbasexxlib.c
+ source/luarest/lmtxmathlib.c
+ source/luarest/lmtxcomplexlib.c
+ source/luarest/lmtziplib.c
+ source/luarest/lmtsparselib.c
+
+ source/tex/texalign.c
+ source/tex/texarithmetic.c
+ source/tex/texbuildpage.c
+ source/tex/texcommands.c
+ source/tex/texconditional.c
+ source/tex/texdirections.c
+ source/tex/texdumpdata.c
+ source/tex/texequivalents.c
+ source/tex/texerrors.c
+ source/tex/texexpand.c
+ source/tex/texmarks.c
+ source/tex/texinputstack.c
+ source/tex/texinserts.c
+ source/tex/texadjust.c
+ source/tex/texlinebreak.c
+ source/tex/texlocalboxes.c
+ source/tex/texmainbody.c
+ source/tex/texmaincontrol.c
+ source/tex/texmathcodes.c
+ source/tex/texmlist.c
+ source/tex/texnesting.c
+ source/tex/texpackaging.c
+ source/tex/texprimitive.c
+ source/tex/texprinting.c
+ source/tex/texscanning.c
+ source/tex/texstringpool.c
+ source/tex/textypes.c
+ source/tex/texfont.c
+ source/tex/texlanguage.c
+ source/tex/texfileio.c
+ source/tex/texmath.c
+ source/tex/texnodes.c
+ source/tex/textextcodes.c
+ source/tex/textoken.c
+ source/tex/texrules.c
+
+)
+
+add_library(tex STATIC ${tex_sources})
+
+target_compile_definitions(tex PUBLIC
+ # LUAI_HASHLIMIT=6 # obsolete
+ ZLIB_CONST=1
+ MINIZ_NO_ARCHIVE_APIS=1
+ MINIZ_NO_STDIO=1
+ MINIZ_NO_MALLOC=1
+)
+
+target_include_directories(tex PRIVATE
+ .
+ source/.
+ source/libraries/miniz
+ source/libraries/pplib
+ source/libraries/pplib/util
+ source/luacore/lua54/src
+ source/libraries/mimalloc/include
+)
diff --git a/source/luametatex/source/.gitignore b/source/luametatex/source/.gitignore
new file mode 100644
index 000000000..3b4e42747
--- /dev/null
+++ b/source/luametatex/source/.gitignore
@@ -0,0 +1 @@
+.vs .log .tuc .tmp
diff --git a/source/luametatex/source/README b/source/luametatex/source/README
new file mode 100644
index 000000000..8d63e4393
--- /dev/null
+++ b/source/luametatex/source/README
@@ -0,0 +1,39 @@
+LuaMetaTeX
+
+This is a follow up on the LuaTeX project. The source is considered part of the ConTeXt distribution
+and managed by the ConTeXt development team and the ConTeXt user group. That way we can guarantee
+that the engine and this TeX macro package work together as expected. The idea is that users can
+easily compile the source themselves and that way have a guaranteed long term (minimal) TeX based
+installation. Because the management scripts are in Lua, only one binary is needed to serve the
+ConTeXt distribution.
+
+In the source code we try to stay close to the ancestors, LuaTeX, pdfTeX, eTeX and TeX, but in the
+meantime due to additions there is quite some diverge. There are new primitives and submechanisms,
+there is more control over the inner workings, font handling is mostly delegated to Lua and there
+is no built-in backend. The code base is all-inclusive and has no (nor will have) dependencies on
+external libraries.
+
+Performance and memory consumption have been optimized and the additions (compared to LuaTeX) don't
+have a negative impact. In spite of the extensions, we consider this a more lightweight version of
+its ancestor and want to keep it that way. There are a few optional interfaces to the outside world
+but ConTeXt will never depend on them for regular usage.
+
+Version numbering starts 2.00 so that there is no confusion with LuaTeX where the stable 1.00+
+version numbers now can bump with the yearly TeXlive updates. Backporting features to LuaTeX is yet
+undecided (also because the codebase is now too different). The internal MetaPost library is an
+enhanced version of the official one that ships with LuaTeX. Here we started with number 3.00 and
+to what extend there will be backports to the 2.00+ library is yet unknown. We use Lua 5.4+ and try
+to keep up to date with the latest greatest, also because the LuaMetaTeX-ConTeXt combination makes
+for nice test enviroment. Starting with LuaMetaTeX version 2.10 the interfaces are considered
+stable. Although we will fix bugs as fast as possible, we might end up with the same slow-paced
+release cycle as traditional TeX.
+
+Bugs can be reported to the ConTeXt mailing lists (support or development) or the team members. Such
+a report should come with a (MEW) ConTeXt .tex file that illustrates the issue. The code repository
+is managed by the ConTeXt user group and its compile farm team (aka contextgarden built bot).
+
+All kind of aspects of the LuaMetaTeX engine, its development, experiment, ideas and implementation
+have been (and are) reported in user group publications aas well as several documents in the ConTeXt
+distribution. The mailing list archives and contextgarden wiki are also a source of information.
+
+Hans Hagen
diff --git a/source/luametatex/source/libraries/avl/avl.c b/source/luametatex/source/libraries/avl/avl.c
new file mode 100644
index 000000000..46e0bcd50
--- /dev/null
+++ b/source/luametatex/source/libraries/avl/avl.c
@@ -0,0 +1,2040 @@
+/*
+ This small C package is made of an independent set of routines dedicated to manipulating AVL
+ trees (files avl.c, avl.h), and of an extension module for Python that builds upon it (file
+ avlmodule.c). Unlike collectionsmodule.c, the latter file contains only Python bindings: it
+ adds nothing to the underlying implementation.
+
+ license: this package, pyavl, is donated to the public domain
+ author : Richard McGraw
+ Email : dasnar@fastmail.fm
+*/
+
+/*
+ This file is reformatted a little. As there has not been any changed in the original we assume
+ this is okay. No changes means that the code is fine and we never ran into issues. Also, we
+ always check for NULL here.
+
+ The avl code is used for hashing strings. It is also used in the backend of luatex but in
+ luametatex we don't have that, so its use is now only in mplib. Actually there are two modules
+ used in luatex: one for metapost an done for tex, and they are somewhat different. So, I took
+ the most extensive one.
+
+ Todo: Rename some variables to avoid a compiler warning.
+ Todo: Maybe abstract the error messages and make them a callback.
+ Todo: Maybe some more if/else/local (likely branch prediction).
+ Todo: Maybe turn some common code into functions (just for fun, will make the source smaller).
+*/
+
+# include "avl.h"
+
+# ifdef AVL_SHOW_ERROR_ON
+ # define AVL_SHOW_ERROR(fmt,arg) fprintf(stderr, "! avl.c: " fmt, arg)
+# else
+ # define AVL_SHOW_ERROR(fmt,arg) (void) (fmt), (void) (arg)
+# endif
+
+const void *avl_default_item_copy(const void *item)
+{
+ return (const void *) item;
+}
+
+void *avl_default_item_dispose(void *item)
+{
+ (void) item;
+ return (void *) NULL;
+}
+
+/* integral type to encode rank and skew bits */
+
+typedef uint32_t rbal_t;
+
+/* avl_node structure */
+
+typedef struct avl_node { /* aligned */
+ struct avl_node *sub[2];
+ struct avl_node *up;
+ void *item;
+ rbal_t rbal;
+ int padding;
+} avl_node;
+
+/*
+ * avl_tree structure
+ */
+
+struct avl_tree_ { /* aligned */
+ avl_node *root;
+ avl_size_t count; /* how many nodes in tree rooted at [root] */
+ int padding; /* alignment */
+ avl_compare_func compare; /* compare items */
+ avl_item_copy_func copy;
+ avl_item_dispose_func dispose;
+ avl_alloc_func alloc; /* to allocate memory (same signature as malloc) */
+ avl_dealloc_func dealloc; /* to deallocate memory (same signature as free) */
+ void *param;
+};
+
+# define item_compare(cmp, tree, item1, item2) (*cmp)(tree->param, item1, item2)
+
+# define sub_left(a) (a)->sub[0]
+# define sub_right(a) (a)->sub[1]
+# define get_item(a) (a)->item
+
+/* RANK(a) = size of left subtree + 1 */
+
+# define rbal(a) (a)->rbal
+# define rzero(a) (rbal(a) & ~3)
+# define get_bal(a) (rbal(a) & 3)
+# define is_lskew(a) (rbal(a) & 1)
+# define is_rskew(a) (rbal(a)>>1 & 1)
+# define set_lskew(a) (rbal(a) |= 1)
+# define set_rskew(a) (rbal(a) |= 2)
+# define set_skew(a,d) (rbal(a) |= (1 << d))
+# define unset_lskew(a) (rbal(a) &= ~1)
+# define unset_rskew(a) (rbal(a) &= ~2)
+# define get_rank(a) (rbal(a) >> 2)
+# define set_rank(a,r) (rbal(a) = (r<<2 | get_bal(a)))
+# define incr_rank(a,r) (rbal(a) += r<<2)
+# define decr_rank(a,r) (rbal(a) -= r<<2)
+
+# define AVL_MIN_DEPTH 0
+
+/* helper structure */
+
+typedef enum {
+ OP_BACKUP,
+ OP_DETACH,
+ OP_FREE
+} whichop_t;
+
+typedef struct ptr_handler { /* swapped and aligned */
+ void *ptr;
+ whichop_t whichop;
+ int padding;
+} ptr_handler;
+
+static void clear_node(avl_node *a)
+{
+ sub_left(a) = NULL;
+ sub_right(a) = NULL;
+ (a)->up = NULL;
+ rbal(a) = 4u;
+}
+
+/* Called by 'avl_ins', 'avl_dup', 'node_slice' */
+
+static avl_node *new_node(void *item, avl_node *up, avl_tree t)
+{
+ avl_node *a = (*t->alloc)(sizeof(avl_node));
+ if (a) {
+ sub_left(a) = NULL;
+ sub_right(a) = NULL;
+ a->up = up;
+ a->rbal = 4u;
+ a->item = (*t->copy)(item);
+ } else {
+ AVL_SHOW_ERROR("%s\n", "couldn't allocate node");
+ }
+ return a;
+}
+
+static void free_node(avl_node *a, avl_tree t)
+{
+ a->item = (*t->dispose)(a->item);
+ (*t->dealloc)(a);
+}
+
+/* function to detach node [a] from tree [t] (compiler will inline if needed) */
+
+static void detach_node(avl_node *a, avl_tree t, struct ptr_handler *h)
+{
+ clear_node(a);
+ do {
+ if (! h) {
+ /* nothing */
+ } else if (h->whichop == OP_DETACH) {
+ h->ptr = a;
+ break;
+ } else if (h->whichop == OP_BACKUP) {
+ h->ptr = (*t->copy)(a->item);
+ }
+ free_node(a, t);
+ } while (0);
+ t->count--;
+}
+
+/* Tree methods */
+
+avl_tree avl_create (
+ avl_compare_func compare,
+ avl_item_copy_func copy,
+ avl_item_dispose_func dispose,
+ avl_alloc_func alloc,
+ avl_dealloc_func dealloc,
+ void *param
+)
+{
+ avl_tree t = (*alloc)(sizeof(struct avl_tree_));
+ if (t) {
+ t->root = NULL;
+ t->count = 0;
+ t->param = param;
+ t->compare = compare;
+ t->copy = copy;
+ t->dispose = dispose;
+ t->alloc = alloc;
+ t->dealloc = dealloc;
+ } else {
+ AVL_SHOW_ERROR("%s\n", "couldn't create new handle in avl_create()");
+ }
+ return t;
+}
+
+/* Empty the tree, using rotations */
+
+static void node_empty(avl_tree t)
+{
+ avl_node *a, *p;
+ for (a = t->root; a != NULL;) {
+ p = a;
+ if (! sub_right(a)) {
+ a = sub_left(a);
+ } else {
+ while (sub_left(a)) {
+ /* rotR(a) */
+ a = sub_left(a);
+ sub_left(p) = sub_right(a);
+ sub_right(a) = p;
+ p = a;
+ }
+ a = sub_right(p);
+ }
+ free_node(p, t);
+ t->count--;
+ }
+ t->root = NULL;
+}
+
+/* [t] is an existing tree handle; this function invokes node_empty() */
+
+void avl_reset (
+ avl_tree t,
+ avl_compare_func compare,
+ avl_item_copy_func copy,
+ avl_item_dispose_func dispose,
+ avl_alloc_func alloc,
+ avl_dealloc_func dealloc
+)
+{
+ if (t) {
+ node_empty(t);
+ t->compare = compare;
+ t->copy = copy;
+ t->dispose = dispose;
+ t->alloc = alloc;
+ t->dealloc = dealloc;
+ }
+}
+
+void avl_empty(avl_tree t)
+{
+ if (t) {
+ node_empty(t);
+ }
+}
+
+/* Destroy nodes, free handle */
+
+void avl_destroy(avl_tree t)
+{
+ if (t) {
+ node_empty(t);
+ (*t->dealloc)(t);
+ }
+}
+
+avl_tree avl_dup(avl_tree t, void *param)
+{
+ if (t) {
+ avl_tree tt = avl_create(t->compare, t->copy, t->dispose, t->alloc, t->dealloc, param);
+ if (tt) {
+ tt->count = t->count;
+ if (t->root == NULL) {
+ return tt;
+ } else {
+ avl_node *a, *c, *s;
+ a = t->root;
+ tt->root = c = new_node(get_item(a), NULL, t);
+ if (c) {
+ sub_right(c) = NULL;
+ rbal(c) = rbal(a);
+ while (1) {
+ while (sub_left(a) != NULL) {
+ a = sub_left(a);
+ sub_left(c) = s = new_node(get_item(a), NULL, t);
+ if (s) {
+ s->up = c;
+ sub_right(s) = c;
+ c = s;
+ rbal(c) = rbal(a);
+ } else {
+ goto recover;
+ }
+ }
+ sub_left(c) = NULL;
+ while (sub_right(a) == NULL) {
+ s = sub_right(c);
+ sub_right(c) = NULL;
+ c = s;
+ /* Find successor of [a] in original tree */
+ do {
+ s = a;
+ a = s->up;
+ if (a == NULL) {
+ return tt;
+ }
+ }
+ while (s != sub_left(a));
+ }
+ a = sub_right(a);
+ s = new_node(get_item(a), NULL, t);
+ if (s) {
+ sub_right(s) = sub_right(c);
+ sub_right(c) = s;
+ s->up = c;
+ c = s;
+ rbal(c) = rbal(a);
+ } else {
+ goto recover;
+ }
+ }
+ /* recovery code */
+ recover:
+ while (1) {
+ s = sub_right(c);
+ sub_right(c) = NULL;
+ if (s) {
+ c = s;
+ } else {
+ break;
+ }
+ }
+ node_empty(tt);
+ abort:
+ (*t->dealloc)(tt);
+ AVL_SHOW_ERROR("%s\n", "couldn't allocate node in avl_dup()");
+ return NULL;
+ } else {
+ goto abort;
+ }
+ }
+ } else {
+ AVL_SHOW_ERROR("%s\n", "couldn't create new handle in avl_dup()");
+ }
+ }
+ return NULL;
+}
+
+avl_bool_t avl_isempty(avl_tree t)
+{
+ return t == NULL || t->root == NULL;
+}
+
+avl_size_t avl_size(avl_tree t)
+{
+ return t == NULL ? 0 : t->count;
+}
+
+static int depth(avl_node *a)
+{
+ int h = AVL_MIN_DEPTH;
+ for (; a != NULL; ++h) {
+ a = a->sub[is_rskew(a)];
+ }
+ return h;
+}
+
+static avl_node *node_first(avl_node *a)
+{
+ while (sub_left(a)) {
+ a = sub_left(a);
+ }
+ return a;
+}
+
+static avl_node *node_last(avl_node *a)
+{
+ while (sub_right(a)) {
+ a = sub_right(a);
+ }
+ return a;
+}
+
+/* [a] : non-null */
+
+static avl_node *node_next(avl_node *a)
+{
+ if (sub_right(a)) {
+ return node_first (sub_right(a));
+ } else {
+ avl_node *p;
+ do {
+ p = a;
+ a = p->up;
+ } while (a && sub_right(a) == p);
+ return a;
+ }
+}
+
+/* [a] : non-null */
+
+static avl_node *node_prev(avl_node *a)
+{
+ if (sub_left(a)) {
+ return node_last (sub_left(a));
+ } else {
+ avl_node *p;
+ do {
+ p = a;
+ a = p->up;
+ } while (a && sub_left(a) == p);
+ return a;
+ }
+}
+
+static avl_node *node_find(const void *item, avl_tree t)
+{
+ avl_node *a = t->root;
+ avl_compare_func cmp = t->compare;
+ while (a) {
+ int c = item_compare(cmp, t, item, get_item(a));
+ if (c < 0) {
+ a = sub_left(a);
+ } else if (c) {
+ a = sub_right(a);
+ } else {
+ break;
+ }
+ }
+ return a;
+}
+
+static avl_size_t get_index(avl_node *a)
+{
+ avl_size_t n = get_rank(a);
+ avl_node *p;
+ while ((p = a->up)) {
+ if (a != sub_left(p)) {
+ n += get_rank(p);
+ }
+ a = p;
+ }
+ return n;
+}
+
+/* Find item by index */
+
+static avl_node *node_find_index(avl_size_t idx, avl_tree t)
+{
+ avl_node *a = t->root;
+ if (idx == 0 || idx > t->count) {
+ return NULL;
+ } else if (idx == 1) {
+ return node_first(a);
+ } else if (idx == t->count) {
+ return node_last(a);
+ } else {
+ int c;
+ while ((c = (int) (idx - get_rank(a))) != 0) {
+ if (c < 0) {
+ a = sub_left(a);
+ } else {
+ idx = (avl_size_t) c;
+ a = sub_right(a);
+ }
+ }
+ return a;
+ }
+}
+
+/* Rebalance starting from node [a] where a->sub[d_] is deeper post-insertion */
+
+static avl_code_t rebalance_ins(avl_node *a, int dir, avl_tree t)
+{
+ if (a) {
+ avl_node *p;
+ while (1) {
+ incr_rank(a, (rbal_t) (!dir));
+ if (get_bal(a)) {
+ break;
+ } else {
+ set_skew(a, dir);
+ p = a->up;
+ if (p) {
+ dir = a != sub_left(p);
+ a = p;
+ } else {
+ return 2;
+ }
+ }
+ }
+ /* Now bal(a) == -1 or +1 */
+ /* Rotate if need be */
+ if (dir == 0) {
+ if (is_rskew(a))
+ unset_rskew(a);
+ else {
+ avl_node *u = a->up;
+ avl_node **r = u ? &u->sub[a != sub_left(u)] : &t->root;
+ p = a;
+ if (is_lskew(sub_left(p))) {
+ /* rotR(p) */
+ a = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ unset_lskew(p);
+ rbal(p) -= rzero(a);
+ } else {
+ /* rotLR(p) */
+ a = sub_right(sub_left(p));
+ sub_right(sub_left(p)) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = sub_left(p);
+ }
+ sub_left(p)->up = a;
+ sub_left(a) = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 1: /* left skew */
+ unset_lskew(p);
+ set_rskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 2: /* right skew */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ set_lskew(sub_left(a));
+ break;
+ }
+ rbal(a) += rzero(sub_left(a));
+ rbal(p) -= rzero(a);
+ }
+ rbal(a) &= ~3;
+ a->up = u;
+ p->up = a;
+ *r = a;
+ }
+ } else if (is_lskew(a)) {
+ unset_lskew(a);
+ } else {
+ avl_node *u = a->up;
+ avl_node **r = u != NULL ? &u->sub[a != sub_left(u)] : &t->root;
+ p = a;
+ if (is_rskew(sub_right(p))) {
+ /* rotL(p) */
+ a = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ unset_rskew(p);
+ rbal(a) += rzero(p);
+ } else {
+ /* rotRL(p) */
+ a = sub_left(sub_right(p));
+ sub_left(sub_right(p)) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = sub_right(p);
+ }
+ sub_right(p)->up = a;
+ sub_right(a) = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ case 1: /* left skew */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ set_rskew(sub_right(a));
+ break;
+ case 2: /* right skew */
+ unset_rskew(p);
+ set_lskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ }
+ rbal(sub_right(a)) -= rzero(a);
+ rbal(a) += rzero(p);
+ }
+ rbal(a) &= ~3;
+ a->up = u;
+ p->up = a;
+ *r = a;
+ }
+ /* The tree rooted at 'a' is now valid */
+ /* Finish adjusting ranks */
+ while ((p = a->up)) {
+ incr_rank(p, (rbal_t)(a == sub_left(p)));
+ a = p;
+ }
+ return 1;
+ }
+ return 2;
+}
+
+/* detach [p] : non-null; only the linkage is tweaked */
+
+static avl_code_t rebalance_del(avl_node *p, avl_tree t, void **backup)
+{
+ rbal_t bal;
+ int dir = 0;
+ avl_node *a = p->up;
+ avl_node **r = a ? &a->sub[dir = p != sub_left(a)] : &t->root;
+ avl_node *c = sub_right(p);
+ if (! c && ! sub_left(p)) {
+ *r = NULL;
+ } else if (! c || ! sub_left(p)) {
+ *r = c ? c : sub_left(p);
+ (*r)->up = a;
+ } else {
+ if (sub_left(c)) {
+ do {
+ c = sub_left(c);
+ } while (sub_left(c));
+ a = c->up;
+ dir = 0;
+ sub_left(a) = sub_right(c);
+ if (sub_right(c)) {
+ sub_right(c)->up = a;
+ }
+ sub_right(c) = sub_right(p);
+ sub_right(c)->up = c;
+ } else {
+ a = c;
+ dir = 1;
+ }
+ sub_left(c) = sub_left(p);
+ sub_left(c)->up = c;
+ c->up = p->up;
+ rbal(c) = rbal(p);
+ *r = c;
+ }
+ if (backup) {
+ *backup = (*t->copy)(p->item);
+ }
+ detach_node(p, t, NULL);
+ /* Start backtracking : subtree of [a] in direction [dir] is less deep */
+ for (;; a = (*r)->up) {
+ if (a == NULL) {
+ return 2;
+ } else {
+ decr_rank(a, (rbal_t)(!dir));
+ bal = get_bal(a);
+ if (dir == 0) {
+ if (bal == 0) {
+ set_rskew(a);
+ break;
+ }
+ if (a->up) {
+ dir = a != sub_left(a->up);
+ r = &a->up->sub[dir];
+ } else {
+ r = &t->root;
+ }
+ if (bal & 1) {
+ unset_lskew(a);
+ }
+ if (get_bal(a)) {
+ p = a;
+ bal = get_bal(sub_right(p));
+ if (! (bal & 1)) {
+ /* bal = 0 or +1 */
+ /* rotL(p) */
+ a = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ if (bal) {
+ unset_rskew(p);
+ unset_rskew(a);
+ } else {
+ set_lskew(a);
+ }
+ rbal(a) += rzero(p);
+ } else {
+ /* rotRL(p) */
+ a = sub_left(sub_right(p));
+ sub_left(sub_right(p)) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = sub_right(p);
+ }
+ sub_right(p)->up = a;
+ sub_right(a) = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ case 1: /* left skew */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ set_rskew(sub_right(a));
+ break;
+ case 2: /* right skew */
+ unset_rskew(p);
+ set_lskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ }
+ rbal(a) &= ~3;
+ rbal(sub_right(a)) -= rzero(a);
+ rbal(a) += rzero(p);
+ }
+ a->up = p->up;
+ p->up = a;
+ /* Done with rotation */
+ *r = a;
+ if (bal == 0) {
+ break;
+ }
+ }
+ } else {
+ /* dir == 1 */
+ if (bal == 0) {
+ set_lskew(a);
+ break;
+ }
+ if (a->up == NULL) {
+ r = &t->root;
+ } else {
+ dir = a != sub_left(a->up);
+ r = &a->up->sub[dir];
+ }
+ if (bal & 2) {
+ unset_rskew(a);
+ }
+ if (get_bal(a)) {
+ p = a;
+ bal = get_bal(sub_left(p));
+ if (! (bal & 2)) {
+ /* bal = 0 or -1 */
+ /* rotR(p) */
+ a = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ if (bal) {
+ unset_lskew(p);
+ unset_lskew(a);
+ } else {
+ set_rskew(a);
+ }
+ rbal(p) -= rzero(a);
+ } else {
+ /* rotLR(p) */
+ a = sub_right(sub_left(p));
+ sub_right(sub_left(p)) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = sub_left(p);
+ }
+ sub_left(p)->up = a;
+ sub_left(a) = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a) != NULL) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 1: /* left skew */
+ unset_lskew(p);
+ set_rskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 2: /* right skew */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ set_lskew(sub_left(a));
+ break;
+ }
+ rbal(a) &= ~3;
+ rbal(a) += rzero(sub_left(a));
+ rbal(p) -= rzero(a);
+ }
+ a->up = p->up;
+ p->up = a;
+ /* Done with rotation */
+ *r = a;
+ if (bal == 0) {
+ break;
+ }
+ }
+ }
+ }
+ }
+ /* Finish adjusting ranks */
+ while ((p = a->up)) {
+ decr_rank(p, (rbal_t)(a == sub_left(p)));
+ a = p;
+ }
+ return 1;
+}
+
+void *avl_first(avl_tree t)
+{
+ if (t && t->root) {
+ return get_item(node_first(t->root));
+ } else {
+ return NULL;
+ }
+}
+
+void *avl_last(avl_tree t)
+{
+ if (t && t->root) {
+ return get_item(node_last(t->root));
+ } else {
+ return NULL;
+ }
+}
+
+void *avl_find(const void *item, avl_tree t)
+{
+ if (t) {
+ avl_node *a = node_find(item, t);
+ return a ? get_item(a) : NULL;
+ } else {
+ return NULL;
+ }
+}
+
+/*
+ Return smallest index i in [1:len] s.t. tree[i] matches [item], or zero if
+ not found
+*/
+
+avl_size_t avl_index(const void *item, avl_tree t)
+{
+ if (item && t && t->root) {
+ avl_compare_func cmp = t->compare;
+ avl_node *a, *p;
+ avl_size_t idx = 0, n = 0;
+ for (a = t->root;;) {
+ int c = item_compare(cmp, t, item, get_item(a));
+ if (! c) {
+ idx = n + get_rank(a);
+ } else if (c > 0) {
+ n += get_rank(a);
+ }
+ p = a->sub[c > 0];
+ if (p) {
+ a = p;
+ } else {
+ return idx;
+ }
+ }
+ } else {
+ return 0;
+ }
+}
+
+/*
+ (lo,hi) where lo smallest index s.t. t[lo] >= lo_item, or t->count+1 and hi
+ greatest index s.t. t[hi] <= hi_item, or 0
+*/
+
+avl_code_t avl_span(const void *lo_item, const void *hi_item, avl_tree t, avl_size_t *lo_idx, avl_size_t *hi_idx)
+{
+ if (t) {
+ *lo_idx = t->count + 1;
+ *hi_idx = 0;
+ if (t->root) {
+ avl_compare_func cmp = t->compare;
+ avl_node *a;
+ avl_size_t n = 0;
+ int c = item_compare(cmp, t, lo_item, hi_item) > 0;
+ if (c > 0) {
+ const void *temp = lo_item;
+ lo_item = hi_item;
+ hi_item = temp;
+ }
+ a = t->root;
+ do {
+ c = item_compare(cmp, t, lo_item, get_item(a));
+ if (c > 0) {
+ n += get_rank(a);
+ a = sub_right(a);
+ } else {
+ *lo_idx = n + get_rank(a);
+ a = sub_left(a);
+ }
+ } while (a);
+ a = t->root;
+ do {
+ c = item_compare(cmp, t, hi_item, get_item(a));
+ if (c < 0) {
+ a = sub_left(a);
+ } else {
+ *hi_idx += get_rank(a);
+ a = sub_right(a);
+ }
+ } while (a);
+ return 0;
+ }
+ }
+ return -1;
+}
+
+/* Find the smallest item in tree [t] that is GEQ the passed item */
+
+void *avl_find_atleast(const void *item, avl_tree t)
+{
+ if (t && t->root) {
+ avl_compare_func cmp = t->compare;
+ avl_node *a = t->root;
+ void *p = NULL;
+ do {
+ int c = item_compare(cmp, t, item, get_item(a));
+ if (c > 0) {
+ a = sub_right(a);
+ } else {
+ p = get_item(a);
+ a = sub_left(a);
+ }
+ } while (a);
+ return p;
+ } else {
+ return NULL;
+ }
+}
+
+/* Find the greatest item in tree [t] that is LEQ the passed item */
+
+void *avl_find_atmost(const void *item, avl_tree t)
+{
+ if (t && t->root) {
+ avl_compare_func cmp = t->compare;
+ avl_node *a = t->root;
+ void *p = NULL;
+ do {
+ int c = item_compare(cmp, t, item, get_item(a));
+ if (c < 0) {
+ a = sub_left(a);
+ } else {
+ p = get_item(a);
+ a = sub_right(a);
+ }
+ } while (a);
+ return p;
+ } else {
+ return NULL;
+ }
+}
+
+/* Retrieve item of index [idx] in tree [t] */
+
+void *avl_find_index(avl_size_t idx, avl_tree t)
+{
+ if (t) {
+ avl_node *a = node_find_index(idx, t);
+ return a ? get_item(a) : NULL;
+ } else {
+ return NULL;
+ }
+}
+
+/* Iterative insertion */
+
+avl_code_t avl_ins (void *item, avl_tree t, avl_bool_t allow_duplicates)
+{
+ if (t) {
+ avl_compare_func cmp = t->compare;
+ avl_node **r, *a;
+ int dir = 0;
+ for (r = &t->root, a = NULL; *r != NULL; r = &a->sub[dir = dir > 0]) {
+ a = *r;
+ dir = item_compare(cmp, t, item, get_item(a));
+ if (!dir && !allow_duplicates)
+ return 0;
+ }
+ *r = new_node(item, a, t);
+ if (*r) {
+ t->count++;
+ return rebalance_ins(a, dir, t);
+ } else {
+ return -1;
+ }
+ } else {
+ return 0;
+ }
+}
+
+avl_code_t avl_del(void *item, avl_tree t, void **backup)
+{
+ if (t && t->root) {
+ avl_node *a = node_find(item, t);
+ if (a) {
+ return rebalance_del(a, t, backup);
+ } else {
+ return 0;
+ }
+ } else {
+ return 0;
+ }
+}
+
+/* helper function */
+
+static avl_code_t node_del_first(avl_tree t, struct ptr_handler *h)
+{
+ avl_node *c;
+ avl_node *p = node_first (t->root);
+ avl_node *a = p->up;
+ if (sub_right(p)) {
+ sub_right(p)->up = a;
+ }
+ if (a == NULL) {
+ t->root = sub_right(p);
+ } else {
+ sub_left(a) = sub_right(p);
+ }
+ detach_node (p, t, h);
+ /* Start backtracking : subtree of [a] in direction [0] is less deep */
+ for (;; a = c) {
+ if (a) {
+ rbal_t bal;
+ decr_rank(a, 1);
+ bal = get_bal(a);
+ if (bal == 0) {
+ set_rskew(a);
+ break;
+ } else {
+ if (bal & 1) {
+ unset_lskew(a);
+ }
+ c = a->up;
+ if (get_bal(a)) {
+ p = a;
+ bal = get_bal(sub_right(p));
+ if (! (bal & 1)) {
+ /* bal = 0 or +1 */
+ /* rotL(p) */
+ a = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ if (bal) {
+ unset_rskew(p);
+ unset_rskew(a);
+ } else {
+ set_lskew(a);
+ }
+ rbal(a) += rzero(p);
+ } else {
+ /* rotRL(p) */
+ a = sub_left(sub_right(p));
+ sub_left(sub_right(p)) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = sub_right(p);
+ }
+ sub_right(p)->up = a;
+ sub_right(a) = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ case 1: /* left skew */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ set_rskew(sub_right(a));
+ break;
+ case 2: /* right skew */
+ unset_rskew(p);
+ set_lskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ }
+ rbal(a) &= ~3;
+ rbal(sub_right(a)) -= rzero(a);
+ rbal(a) += rzero(p);
+ }
+ a->up = p->up;
+ p->up = a;
+ /* Done with rotation */
+ if (c) {
+ sub_left(c) = a;
+ } else {
+ t->root = a;
+ }
+ if (bal == 0) {
+ break;
+ }
+ }
+ }
+ } else {
+ return 2;
+ }
+ }
+ /* Finish adjusting ranks */
+ while ((a = a->up)) {
+ decr_rank(a, 1);
+ }
+ return 1;
+}
+
+/* helper function */
+
+static avl_code_t node_del_last(avl_tree t, struct ptr_handler *h)
+{
+
+ avl_node *c;
+ avl_node *p = node_last (t->root);
+ avl_node *a = p->up;
+ if (sub_left(p)) {
+ sub_left(p)->up = a;
+ }
+ if (a) {
+ sub_right(a) = sub_left(p);
+ } else {
+ t->root = sub_left(p);
+ }
+ detach_node(p, t, h);
+ /* Start backtracking : subtree of [a] in direction [1] is less deep */
+ for (;; a = c) {
+ if (a) {
+ rbal_t bal = get_bal(a);
+ if (bal == 0) {
+ set_lskew(a);
+ break;
+ } else {
+ if (bal & 2) {
+ unset_rskew(a);
+ }
+ c = a->up;
+ if (get_bal(a)) {
+ p = a;
+ bal = get_bal(sub_left(p));
+ if (! (bal & 2)) {
+ /* bal = 0 or -1 */
+ /* rotR(p) */
+ a = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ if (bal) {
+ unset_lskew(p);
+ unset_lskew(a);
+ } else {
+ set_rskew(a);
+ }
+ rbal(p) -= rzero(a);
+ } else {
+ /* rotLR(p) */
+ a = sub_right(sub_left(p));
+ sub_right(sub_left(p)) = sub_left(a);
+ if (sub_left(a) != NULL)
+ sub_left(a)->up = sub_left(p);
+ sub_left(p)->up = a;
+ sub_left(a) = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 1: /* left skew */
+ unset_lskew(p);
+ set_rskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 2: /* right skew */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ set_lskew(sub_left(a));
+ break;
+ }
+ rbal(a) &= ~3;
+ rbal(a) += rzero(sub_left(a));
+ rbal(p) -= rzero(a);
+ }
+ a->up = p->up;
+ p->up = a;
+ /* Done with rotation */
+ if (c) {
+ sub_right(c) = a;
+ } else {
+ t->root = a;
+ }
+ if (bal == 0) {
+ break;
+ }
+ }
+ }
+ } else {
+ return 2;
+ }
+ }
+ return 1;
+}
+
+/*
+ [p] : juncture node(zeroed out)
+ [n] : rank of [p] in resulting tree
+ [delta] = depth_1 - depth_0
+*/
+
+static avl_code_t join_left(avl_node *p, avl_node **r0, avl_node *r1, int delta, int n)
+{
+ avl_node *a = NULL;
+ avl_node **r = r0;
+ if (r1) {
+ while (delta < -1) {
+ a = *r;
+ delta += (int) (is_lskew(a) + 1);
+ n -= (int) get_rank(a);
+ r = &sub_right(a);
+ }
+ r1->up = p;
+ if (*r) {
+ (*r)->up = p;
+ }
+ if (delta) {
+ set_lskew(p);
+ }
+ } else {
+ while (*r != NULL) {
+ a = *r;
+ n -= (int) get_rank(a);
+ r = &sub_right(a);
+ }
+ }
+ /* at this point bal(*r) = -1 or 0 */
+ sub_left(p) = *r;
+ sub_right(p) = r1;
+ p->up = a;
+ set_rank(p, n);
+ *r = p;
+ for (;;) {
+ if (! a) {
+ return 2;
+ } else if (get_bal(a)) {
+ break;
+ } else {
+ set_rskew(a);
+ a = a->up;
+ }
+ }
+ /* Rotate if need be */
+ /* No (+2,0) rotation to do */
+ if (is_lskew(a)) {
+ unset_lskew(a);
+ } else {
+ p = a;
+ if (is_rskew(sub_right(p))) {
+ /* rotL(p) */
+ a = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ unset_rskew(p);
+ rbal(a) += rzero(p);
+ } else {
+ /* rotRL(p) */
+ a = sub_left(sub_right(p));
+ sub_left(sub_right(p)) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = sub_right(p);
+ }
+ sub_right(p)->up = a;
+ sub_right(a) = sub_right(p);
+ sub_right(p) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = p;
+ }
+ sub_left(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ case 1: /* left skew */
+ unset_rskew(p);
+ unset_lskew(sub_right(a));
+ set_rskew(sub_right(a));
+ break;
+ case 2: /* right skew */
+ unset_rskew(p);
+ set_lskew(p);
+ unset_lskew(sub_right(a));
+ break;
+ }
+ rbal(sub_right(a)) -= rzero(a);
+ rbal(a) += rzero(p);
+ }
+ rbal(a) &= ~3;
+ a->up = p->up;
+ p->up = a;
+ if (a->up) {
+ sub_right(a->up) = a;
+ } else {
+ *r0 = a;
+ }
+ }
+ return 1;
+}
+
+/*
+ [p] : juncture node
+ [n] : rank of [p] in resulting tree
+*/
+
+static avl_code_t join_right(avl_node *p, avl_node *r0, avl_node **r1, int delta, int n)
+{
+ avl_node *a = NULL;
+ avl_node **r = r1;
+ if (r0) {
+ while (delta > +1) {
+ a = *r;
+ delta -= (int) (is_rskew(a) + 1);
+ incr_rank(a, (rbal_t)n);
+ r = &sub_left(a);
+ }
+ r0->up = p;
+ if (*r != NULL) {
+ (*r)->up = p;
+ }
+ if (delta) {
+ set_rskew(p);
+ }
+ } else {
+ while (*r) {
+ a = *r;
+ incr_rank(a, (rbal_t) n);
+ r = &sub_left(a);
+ }
+ n = 1;
+ }
+ /* at this point bal(*r) = +1 or 0 */
+ sub_left(p) = r0;
+ sub_right(p) = *r;
+ set_rank(p, n);
+ p->up = a;
+ *r = p;
+ for (;;) {
+ if (! a) {
+ return 2;
+ } else if (get_bal(a)) {
+ break;
+ } else {
+ set_lskew(a);
+ a = a->up;
+ }
+ }
+ /* Rotate if need be */
+ /* No (-2,0) rotation to do */
+ if (is_rskew(a)) {
+ unset_rskew(a);
+ } else {
+ p = a;
+ if (is_lskew(sub_left(p))) {
+ /* rotR(p) */
+ a = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ unset_lskew(p);
+ rbal(p) -= rzero(a);
+ } else {
+ /* rotLR(p) */
+ a = sub_right(sub_left(p));
+ sub_right(sub_left(p)) = sub_left(a);
+ if (sub_left(a)) {
+ sub_left(a)->up = sub_left(p);
+ }
+ sub_left(p)->up = a;
+ sub_left(a) = sub_left(p);
+ sub_left(p) = sub_right(a);
+ if (sub_right(a)) {
+ sub_right(a)->up = p;
+ }
+ sub_right(a) = p;
+ switch (get_bal(a)) {
+ case 0: /* not skewed */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 1: /* left skew */
+ unset_lskew(p);
+ set_rskew(p);
+ unset_rskew(sub_left(a));
+ break;
+ case 2: /* right skew */
+ unset_lskew(p);
+ unset_rskew(sub_left(a));
+ set_lskew(sub_left(a));
+ break;
+ }
+ rbal(a) += rzero(sub_left(a));
+ rbal(p) -= rzero(a);
+ }
+ rbal(a) &= ~3;
+ a->up = p->up;
+ p->up = a;
+ if (a->up != NULL) {
+ sub_left(a->up) = a;
+ } else {
+ *r1 = a;
+ }
+ }
+ return 1;
+}
+
+avl_code_t avl_del_first(avl_tree t, void **backup)
+{
+ if (t && t->root) {
+ avl_code_t rv;
+ if (backup) {
+ ptr_handler h = { NULL, OP_BACKUP };
+ rv = node_del_first(t, &h);
+ *backup = h.ptr;
+ } else {
+ rv = node_del_first(t, NULL);
+ }
+ return rv;
+ } else {
+ return 0;
+ }
+}
+
+avl_code_t avl_del_last(avl_tree t, void **backup)
+{
+ if (t && t->root) {
+ if (backup == NULL) {
+ return node_del_last(t, NULL);
+ } else {
+ ptr_handler h = { NULL, OP_BACKUP };
+ avl_code_t rv = node_del_last(t, &h);
+ *backup = h.ptr;
+ return rv;
+ }
+ } else {
+ return 0;
+ }
+}
+
+avl_code_t avl_ins_index(void *item, avl_size_t idx, avl_tree t)
+{
+ if (idx == 0 || t == NULL || idx > t->count + 1) {
+ return 0;
+ } else {
+ avl_node *p = new_node(item, NULL, t);
+ if (p) {
+ t->count++;
+ /* Note: 'attach_node' macro increments t->count */
+ if (idx == 1) {
+ return join_right(p, (avl_node *) NULL, &t->root, /*delta= */ 0, 1);
+ } else if (idx == t->count) {
+ return join_left(p, &t->root, (avl_node *) NULL, /*delta= */ 0, (int) t->count);
+ } else {
+ avl_node *a = node_find_index(idx - 1, t);
+ int dir;
+ if (sub_right(a)) {
+ a = node_first(sub_right(a));
+ sub_left(a) = p;
+ dir = 0;
+ } else {
+ sub_right(a) = p;
+ dir = 1;
+ }
+ p->up = a;
+ return rebalance_ins(a, dir, t);
+ }
+ } else {
+ return -1;
+ }
+ }
+}
+
+avl_code_t avl_del_index(avl_size_t idx, avl_tree t, void **backup)
+{
+ if (! t) {
+ return 0;
+ } else if (idx == 0 || idx > t->count) {
+ return 0;
+ } else if (idx == 1) {
+ return avl_del_first(t, backup);
+ } else if (idx == t->count) {
+ return avl_del_last(t, backup);
+ } else {
+ avl_node *a = node_find_index(idx, t);
+ return rebalance_del(a, t, backup);
+ }
+}
+
+/* Outcome: [t0] handles the concatenation of [t0] and [t1] */
+
+void avl_cat(avl_tree t0, avl_tree t1)
+{
+ if (! t0 || ! t1 ||! t1->root) {
+ return;
+ } else if (t0->root) {
+ int delta = depth(t1->root) - depth(t0->root);
+ ptr_handler h = { NULL, OP_DETACH };
+ if (delta <= 0) {
+ if (node_del_first (t1, &h) == 2) {
+ --delta;
+ }
+ (void) join_left((avl_node *) h.ptr, &t0->root, t1->root, delta, (int) (t0->count + 1));
+ } else {
+ if (node_del_last(t0, &h) == 2) {
+ ++delta;
+ }
+ (void) join_right((avl_node *) h.ptr, t0->root, &t1->root, delta, (int) (t0->count + 1));
+ t0->root = t1->root;
+ }
+ t1->root = NULL;
+ t0->count += t1->count + 1;
+ t1->count = 0;
+ } else {
+ t0->root = t1->root;
+ t0->count = t1->count;
+ t1->root = NULL;
+ t1->count = 0;
+ }
+}
+
+/*
+ - [t0] and [t1] are existing handles
+ - See Donald Knuth, TAOCP Vol.3 "Sorting and searching"
+*/
+
+avl_code_t avl_split(const void *item, avl_tree t, avl_tree t0, avl_tree t1)
+{
+ if (t && t->root) {
+ t0->root = NULL;
+ t1->root = NULL;
+ t0->count = 0;
+ t1->count = 0;
+ avl_compare_func cmp = t->compare;
+ avl_node *a, *p, *sn; /* sn: split node */
+ int k, na, an[AVL_STACK_CAPACITY];
+ /* invariant: [na]= size of tree rooted at [a] plus one */
+ for (a = t->root, na = (int) (t->count + 1), k = 0;;) {
+ int d_ = item_compare(cmp, t, item, get_item(a));
+ if (d_) {
+ p = a->sub[d_ = d_ > 0];
+ if (p) {
+ an[k++] = na;
+ if (d_) {
+ na -= (int) get_rank(a);
+ } else {
+ na = (int) get_rank(a);
+ }
+ a = p;
+ } else {
+ return 0;
+ }
+ } else {
+ break;
+ }
+ }
+ /* record split node */
+ sn = a;
+ if (k == 0) {
+ t0->root = sub_left(a);
+ t1->root = sub_right(a);
+ if (t0->root) {
+ t0->root->up = NULL;
+ }
+ if (t1->root) {
+ t1->root->up = NULL;
+ }
+ t0->count = get_rank(a) - 1;
+ t1->count = t->count - get_rank(a);
+ } else {
+ avl_node *r[2];
+ int h[2], ha;
+ avl_size_t n[2];
+ int d_;
+ r[0] = sub_left(a);
+ r[1] = sub_right(a);
+ if (r[0]) {
+ r[0]->up = NULL;
+ }
+ if (r[1]) {
+ r[1]->up = NULL;
+ }
+ ha = depth(a);
+ h[0] = ha - (is_rskew(a) ? 2 : 1);
+ h[1] = ha - (is_lskew(a) ? 2 : 1);
+ n[0] = get_rank(a); /* size of r[0] plus one */
+ n[1] = (avl_size_t) na - n[0]; /* size of r[1] plus one */
+ for (p = a->up, d_ = a != sub_left(p);;) {
+ a = p; /* a: juncture node */
+ p = a->up;
+ if (d_ == 0) {
+ int hh = h[1];
+ int nn;
+ ha += (is_rskew(a) ? 2 : 1);
+ h[1] = ha - (is_lskew(a) ? 2 : 1);
+ nn = n[1];
+ n[1] += (avl_size_t) (an[k - 1] - (int) get_rank(a));
+ if (p) {
+ d_ = a != sub_left(p);
+ }
+ rbal(a) = 0;
+ if (h[1] >= hh) {
+ avl_node *rr = r[1];
+ r[1] = sub_right(a);
+ if (r[1]) {
+ r[1]->up = NULL;
+ }
+ h[1] += (2 == join_right(a, rr, r + 1, h[1] - hh, (int) nn));
+ } else {
+ h[1] = hh + (2 == join_left(a, r + 1, sub_right(a), h[1] - hh, (int) nn));
+ }
+ } else {
+ int hh = h[0];
+ int nn;
+ ha += (is_lskew(a) ? 2 : 1);
+ h[0] = ha - (is_rskew(a) ? 2 : 1);
+ nn = get_rank(a);
+ n[0] += nn;
+ if (p) {
+ d_ = a != sub_left(p);
+ }
+ rbal(a) = 0;
+ if (h[0] >= hh) {
+ avl_node *rr = r[0];
+ r[0] = sub_left(a);
+ if (r[0]) {
+ r[0]->up = NULL;
+ }
+ h[0] += (2 == join_left(a, r, rr, hh - h[0], (int) nn));
+ } else {
+ h[0] = hh + (2 == join_right(a, sub_left(a), r, hh - h[0], (int) nn));
+ }
+ }
+ if (--k == 0)
+ break;
+ }
+ t0->root = r[0];
+ t1->root = r[1];
+ t0->count = n[0] - 1;
+ t1->count = n[1] - 1;
+ }
+ /* Detach split node */
+ detach_node(sn, t, NULL);
+ t->root = NULL;
+ t->count = 0;
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* Inorder traversal */
+
+void avl_walk(avl_tree t, avl_item_func proc, void *param)
+{
+ if (t && t->root) {
+ avl_node *a = t->root, *p;
+ while (1) {
+ while (sub_left(a)) {
+ a = sub_left(a);
+ }
+ while (1) {
+ (*proc)(get_item(a), param);
+ if (sub_right(a)) {
+ break;
+ } else {
+ do {
+ p = a;
+ a = p->up;
+ if (! a) {
+ return;
+ }
+ }
+ while (p != sub_left(a));
+ }
+ }
+ a = sub_right(a);
+ }
+ }
+}
+
+/* recursive helper for 'avl_slice' */
+
+static int node_slice(avl_node **root, avl_node **cur, avl_tree tree, avl_size_t len)
+{
+ avl_size_t mid = len / 2;
+ if (mid == 0) {
+ if ((*root = new_node ((*cur)->item, /*parent */ NULL, tree)) == NULL) {
+ return -1;
+ } else {
+ sub_left(*root) = NULL;
+ sub_right(*root) = NULL;
+ rbal(*root) = 4;
+ *cur = node_next(*cur);
+ return 0;
+ }
+ } else if ((*root = new_node(NULL, /*parent */ NULL, tree))) {
+ avl_node *p = *root;
+ int h0, h1 = -1;
+ rbal(p) = (mid + 1) << 2;
+ if ((h0 = node_slice(&sub_left(p), cur, tree, mid)) < 0) {
+ return -1;
+ } else {
+ p->item = (*tree->copy) ((*cur)->item);
+ sub_left(p)->up = p;
+ *cur = node_next(*cur);
+ if (len -= mid + 1) {
+ if ((h1 = node_slice(&sub_right(p), cur, tree, len)) < 0) {
+ return -1;
+ } else {
+ sub_right(p)->up = p;
+ }
+ }
+ if (h0 > h1) {
+ set_lskew(p);
+ } else if (h0 < h1) {
+ set_rskew(p);
+ return 1 + h1;
+ }
+ return 1 + h0;
+ }
+ } else {
+ return -1;
+ }
+}
+
+/* Return a slice t[lo,hi) as a new tree */
+
+avl_tree avl_slice(avl_tree t, avl_size_t lo_idx, avl_size_t hi_idx, void *param)
+{
+ if (! t || (lo_idx > hi_idx) || (lo_idx > t->count)) {
+ return NULL;
+ } else {
+ if (lo_idx < 1) {
+ lo_idx = 1;
+ }
+ if (hi_idx > t->count + 1) {
+ hi_idx = t->count + 1;
+ }
+ {
+ avl_tree tt = avl_create(t->compare, t->copy, t->dispose, t->alloc, t->dealloc, param);
+ if (tt) {
+ if (lo_idx < hi_idx) {
+ avl_node *cur = node_find_index(lo_idx, t);
+ if (node_slice(&tt->root, &cur, t, tt->count = hi_idx - lo_idx) < 0) {
+ AVL_SHOW_ERROR("%s\n", "couldn't allocate node in avl_slice()");
+ node_empty(tt);
+ (*t->dealloc)(tt);
+ return NULL;
+ } else {
+ tt->root->up = NULL;
+ }
+ }
+ return tt;
+ } else {
+ AVL_SHOW_ERROR("%s\n", "couldn't allocate new handle in avl_slice()");
+ return NULL;
+ }
+ }
+ }
+}
+
+/* recursive helper for 'avl_xload' */
+
+static int node_load(avl_node **root, avl_itersource cur, void **pres, avl_tree desc, avl_size_t len)
+{
+ avl_size_t mid = len / 2;
+ if (mid == 0) {
+ if (0 != (*cur->f) (cur, pres) || (*root = new_node (*pres, /*parent */ NULL, desc)) == NULL) {
+ return -1;
+ } else {
+ sub_left(*root) = NULL;
+ sub_right(*root) = NULL;
+ rbal(*root) = 4;
+ return 0;
+ }
+ } else if ((*root = new_node (NULL, /*parent */ NULL, desc))) {
+ avl_node *p = *root;
+ int h0, h1 = -1;
+ rbal(p) = (mid + 1) << 2;
+ if ((h0 = node_load(&sub_left(p), cur, pres, desc, mid)) < 0) {
+ return -1;
+ } else if (0 != (*cur->f)(cur, pres)) {
+ return -1;
+ } else {
+ p->item = (*desc->copy)(*pres);
+ sub_left(p)->up = p;
+ if (len -= mid + 1) {
+ if ((h1 = node_load(&sub_right(p), cur, pres, desc, len)) < 0) {
+ return -1;
+ } else {
+ sub_right(p)->up = p;
+ }
+ }
+ if (h0 > h1) {
+ set_lskew(p);
+ } else if (h0 < h1) {
+ set_rskew(p);
+ return 1 + h1;
+ }
+ return 1 + h0;
+ }
+ } else {
+ return -1;
+ }
+}
+
+/* Load 'len' items from itersource */
+
+avl_tree avl_xload(avl_itersource src, void **pres, avl_size_t len, avl_config conf, void *tree_param)
+{
+ if (src) {
+ avl_tree tt = avl_create(conf->compare, conf->copy, conf->dispose, conf->alloc, conf->dealloc, tree_param);
+ if (! tt) {
+ AVL_SHOW_ERROR("%s\n", "couldn't allocate new handle in avl_load()");
+ return NULL;
+ } if (len) {
+ if (node_load(&tt->root, src, pres, tt, tt->count = len) < 0) {
+ AVL_SHOW_ERROR("%s\n", "couldn't allocate node in avl_load()");
+ node_empty(tt);
+ (*tt->dealloc)(tt);
+ return NULL;
+ } else {
+ tt->root->up = NULL;
+ }
+ }
+ return tt;
+ } else {
+ return NULL;
+ }
+}
+
+/* ITERATORS */
+
+typedef enum {
+ AVL_ITERATOR_PRE,
+ AVL_ITERATOR_POST,
+ AVL_ITERATOR_INTREE
+} avl_status_t;
+
+struct avl_iterator_
+{
+ avl_node *pos;
+ avl_tree tree;
+ avl_status_t status;
+};
+
+# define get_root(i) i->tree->root
+# define is_pre(i) i->status == AVL_ITERATOR_PRE
+# define is_post(i) i->status == AVL_ITERATOR_POST
+# define set_pre_iterator(i) i->status = AVL_ITERATOR_PRE
+# define set_post_iterator(i) i->status = AVL_ITERATOR_POST
+# define set_in_iterator(i) i->status = AVL_ITERATOR_INTREE
+
+/*
+ Position existing iterator [iter] at node matching [item] in its own tree,
+ if it exists ; otherwise do nothing
+*/
+
+void avl_iterator_seek(const void *item, avl_iterator iter)
+{
+ avl_node *p = node_find(item, iter->tree);
+ if (p) {
+ set_in_iterator(iter);
+ iter->pos = p;
+ }
+}
+
+void avl_iterator_seek_index(avl_size_t idx, avl_iterator iter)
+{
+ avl_node *p = node_find_index(idx, iter->tree);
+ if (p) {
+ set_in_iterator(iter);
+ iter->pos = p;
+ }
+}
+
+/* Return item pointer at current position */
+
+void *avl_iterator_cur(avl_iterator iter)
+{
+ return iter->pos ? get_item(iter->pos) : NULL;
+}
+
+avl_size_t avl_iterator_count(avl_iterator iter)
+{
+ return iter->tree->count;
+}
+
+avl_size_t avl_iterator_index(avl_iterator iter)
+{
+ if (iter->pos) {
+ return get_index(iter->pos);
+ } else if (is_pre(iter)) {
+ return 0;
+ } else {
+ return iter->tree->count + 1;
+ }
+}
+
+/* Rustic: */
+
+avl_iterator avl_iterator_new(avl_tree t, avl_ini_t ini, ...)
+{
+ va_list args;
+ avl_iterator iter = NULL;
+ va_start(args, ini);
+ if (! t) {
+ /* okay */
+ } else if ((iter = (*t->alloc) (sizeof(struct avl_iterator_)))) {
+ iter->pos = NULL;
+ iter->tree = t;
+ if (ini != AVL_ITERATOR_INI_INTREE) {
+ iter->status = (ini == AVL_ITERATOR_INI_PRE) ? AVL_ITERATOR_PRE : AVL_ITERATOR_POST;
+ } else {
+ const void *item = NULL;
+ item = va_arg(args, const void *);
+ set_pre_iterator(iter);
+ if (item == NULL) {
+ AVL_SHOW_ERROR("%s\n", "missing argument to avl_iterator_new()");
+ } else {
+ avl_iterator_seek(item, iter);
+ }
+ }
+ } else {
+ AVL_SHOW_ERROR("%s\n", "couldn't create iterator");
+ }
+ va_end(args);
+ return iter;
+}
+
+/*
+ The following used to write to memory after it was freed. Corrected by: David
+ Turner <novalis@openplans.org>
+*/
+
+void avl_iterator_kill(avl_iterator iter)
+{
+ if (iter != NULL) {
+ avl_dealloc_func dealloc = iter->tree->dealloc;
+ iter->pos = NULL;
+ iter->tree = NULL;
+ (*dealloc)(iter);
+ }
+}
+
+void *avl_iterator_next(avl_iterator iter)
+{
+ if (is_post(iter)) {
+ return NULL;
+ } else {
+ avl_node *a = iter->pos;
+ if (is_pre(iter)) {
+ a = get_root(iter);
+ if (a) {
+ a = node_first(a);
+ set_in_iterator(iter);
+ }
+ } else {
+ a = node_next(a);
+ if (! a) {
+ set_post_iterator(iter);
+ }
+ }
+ iter->pos = a;
+ return a != NULL ? get_item(a) : NULL;
+ }
+}
+
+void *avl_iterator_prev(avl_iterator iter)
+{
+ if (is_pre(iter)) {
+ return NULL;
+ } else {
+ avl_node *a = iter->pos;
+ if (is_post(iter)) {
+ a = get_root(iter);
+ if (a) {
+ a = node_last(a);
+ set_in_iterator(iter);
+ }
+ } else {
+ a = node_prev(a);
+ if (! a) {
+ set_pre_iterator(iter);
+ }
+ }
+ iter->pos = a;
+ return a ? get_item(a) : NULL;
+ }
+}
+
+/* Remove node at current position and move cursor to next position */
+
+avl_code_t avl_iterator_del(avl_iterator iter, void **backup)
+{
+ if (iter == NULL || iter->pos == NULL) {
+ return 0;
+ } else {
+ avl_node *a = iter->pos, *p;
+ p = node_next(a);
+ if (! p) {
+ set_post_iterator(iter);
+ }
+ iter->pos = p;
+ return rebalance_del(a, iter->tree, backup);
+ }
+}
diff --git a/source/luametatex/source/libraries/avl/avl.h b/source/luametatex/source/libraries/avl/avl.h
new file mode 100644
index 000000000..03a1384b7
--- /dev/null
+++ b/source/luametatex/source/libraries/avl/avl.h
@@ -0,0 +1,445 @@
+/*
+ This small C package is made of an independent set of routines dedicated to manipulating AVL
+ trees (files avl.c, avl.h), and of an extension module for Python that builds upon it (file
+ avlmodule.c). Unlike collectionsmodule.c, the latter file contains only Python bindings: it
+ adds nothing to the underlying implementation.
+
+ license: this package, pyavl, is donated to the public domain
+ author : Richard McGraw
+ email : dasnar@fastmail.fm
+*/
+
+/*
+ This file is reformatted a little. As there has not been any changed in the original we assume
+ this is okay. No changes means that the code is fine and we never ran into issues.
+
+ The avl code is used for hashing strings. It is also used in the backend of luatex but in
+ luametatex we don't have that.
+*/
+
+# ifndef LIBRARIES_AVL_H
+# define LIBRARIES_AVL_H
+
+# include <stdarg.h>
+# include <stdio.h>
+# include <stdlib.h>
+
+// # define avl_del mp_avl_del
+// # define avl_ins mp_avl_ins
+// # define avl_tree mp_avl_tree
+// # define avl_entry mp_avl_entry
+// # define avl_find mp_avl_find
+// # define avl_create mp_avl_create
+// # define avl_destroy mp_avl_destroy
+
+typedef enum avl_bool_t {
+ avl_false,
+ avl_true
+} avl_bool_t;
+
+# include <inttypes.h>
+
+typedef int8_t avl_code_t;
+typedef int8_t avl_bal_t;
+typedef uint32_t avl_size_t;
+
+typedef int (*avl_compare_func) (void *param, const void *lhs, const void *rhs);
+typedef void *(*avl_item_copy_func) (const void *item);
+typedef void *(*avl_item_dispose_func) (void *item);
+typedef void (*avl_item_func) (const void *item, void *param);
+typedef void *(*avl_alloc_func) (size_t);
+typedef void (*avl_dealloc_func) (void *);
+
+/* At minimum, shallow copy */
+
+const void *avl_default_item_copy (const void *);
+void *avl_default_item_dispose (void *);
+
+# define AVL_STACK_CAPACITY 32 /* for avl_split() function */
+
+typedef enum avl_ini_t {
+ AVL_ITERATOR_INI_PRE,
+ AVL_ITERATOR_INI_POST,
+ AVL_ITERATOR_INI_INTREE
+} avl_ini_t;
+
+typedef struct avl_tree_ *avl_tree;
+typedef struct avl_iterator_ *avl_iterator;
+typedef struct avl_itersource_ avl_itersource_struct;
+typedef struct avl_itersource_ *avl_itersource;
+
+struct avl_itersource_ {
+ void *p;
+ /* return nonzero on error */
+ avl_code_t(*f) (avl_itersource from, void **to);
+};
+
+typedef struct {
+ avl_compare_func compare;
+ avl_item_copy_func copy;
+ avl_item_dispose_func dispose;
+ avl_alloc_func alloc;
+ avl_dealloc_func dealloc;
+} avl_config_struct, *avl_config;
+
+/* Public Functions */
+
+/*
+ --- CREATE ---
+ Return a new tree and set its config.
+ Return NULL on allocation failure.
+ * 'alloc' defaults to malloc from stdlib
+ * 'dealloc' defaults to free from stdlib
+ * 'param' user param/refcon
+*/
+
+avl_tree avl_create(
+ avl_compare_func compare,
+ avl_item_copy_func copy,
+ avl_item_dispose_func dispose,
+ avl_alloc_func alloc,
+ avl_dealloc_func dealloc,
+ void *param
+);
+
+/*
+ --- RESET ---
+ Empty tree 't' as in 'avl_empty()' and modify its config.
+*/
+
+void avl_reset(
+ avl_tree t,
+ avl_compare_func compare,
+ avl_item_copy_func copy,
+ avl_item_dispose_func dispose,
+ avl_alloc_func alloc,
+ avl_dealloc_func dealloc
+);
+
+/*
+ --- EMPTY ---
+ Empty tree 't', calling its dispose_func for each item in 't'. The config is
+ untouched.
+*/
+
+void avl_empty(avl_tree t);
+
+/*
+ --- DESTROY ---
+ Empty tree 't' and free the handle.
+*/
+
+void avl_destroy(avl_tree t);
+
+/*
+ --- DUPLICATE (COPY) ---
+ Return a copy of tree 't', using its copy_func for each item in 't'. Upon
+ failure to allocate room for some item, return NULL.
+*/
+
+avl_tree avl_dup(avl_tree t, void *param);
+
+/*
+ --- EMPTYNESS ---
+ Return 'avl_true' iff tree 't' is empty (i.e. the handle is NULL or 't'
+ contains no item).
+*/
+
+avl_bool_t avl_isempty(avl_tree t);
+
+/*
+ --- SIZE ---
+ Return number of items contained in tree 't'.
+*/
+
+avl_size_t avl_size(avl_tree t);
+
+/*
+ --- FIRST (MINIMUM) ---
+ Return first item in in-order traversal of 't'. Return NULL if 't' is empty.
+*/
+
+void *avl_first(avl_tree t);
+
+/*
+ --- LAST (MAXIMUM) ---
+ Return last item in in-order traversal of 't'. Return NULL if 't' is empty.
+*/
+
+void *avl_last(avl_tree t);
+
+/*
+ --- FIND MATCHING ITEM ---
+ Find item matching 'item' parameter in tree 't'. Return NULL if it's not
+ found. If there are multiple matches, the first one that is encountered
+ during the search is returned; it may not be the one with lowest rank.
+*/
+
+void *avl_find(const void *item, avl_tree t);
+
+/*
+ --- INDEX (RANK) OF ITEM ---
+ Return smallest index 'i' s.t. 't[i]' matches 'item', or zero if 'item' is
+ not found.
+*/
+
+avl_size_t avl_index(const void *item, avl_tree t);
+
+/*
+ --- SPAN ITEMS ---
+ Return integers 'i,j' s.t. 't[i,j]'
+ i smallest index s.t. t[i] >= lo_item, or t->count+1 and
+ j greatest one s.t. t[j] <= hi_item, or 0.
+
+ If 'hi_item' is less than 'lo_item' those are swapped.
+
+ Return codes:
+ 0 success
+ -1 error: tree had no root
+ -2 error: compare failed
+*/
+
+avl_code_t avl_span(
+ const void *lo_item,
+ const void *hi_item,
+ avl_tree t,
+ avl_size_t *lo_idx,
+ avl_size_t *hi_idx
+);
+
+/*
+ --- FIND AT LEAST ---
+ Return smallest item in 't' that is GEQ 'item', or NULL.
+*/
+
+void *avl_find_atleast(const void *item, avl_tree t);
+
+/*
+ --- FIND AT MOST ---
+ Return largest item in 't' that is LEQ 'item', or NULL.
+*/
+
+void *avl_find_atmost(const void *item, avl_tree t);
+
+/*
+ --- FIND BY INDEX (RANK) ---
+ Find item in 't' by index, that is return 't[idx]'. If 'idx' is not in
+ '[1,avl_size(t)]' then return NULL. If a compare failed then return NULL.
+*/
+
+void *avl_find_index(avl_size_t idx, avl_tree t);
+
+/*
+ --- INSERTION ---
+ Insert 'item' in tree 't' with regard to its compare_func. Say
+ 'avl_ins(item,t,avl_true)' to insert 'item' in 't' even if it is there
+ already. If 'item' is a duplicate and 'allow_duplicates' is avl_false,
+ nothing is done.
+
+ Return codes:
+ -1 error: allocation of new node failed
+ -2 error: compare failed, tree unchanged
+ 0 nothing was done, no error
+ +1 operation successful
+ +2 the same and height(t) increased by one.
+*/
+
+avl_code_t avl_ins(void *item, avl_tree t, avl_bool_t allow_duplicates);
+
+/*
+ --- DELETION ---
+ Remove 'item' from tree 't', calling its dispose_func. To make a backup of
+ 'item' involving its copy_func, say 't(item,backup)' where 'backup' is some
+ pointer to pointer to item. Otherwise set it to NULL.
+
+ Return codes:
+ 0 item not found
+ -2 error: compare failed, tree unchanged
+ +1 operation successful
+ +2 the same and height(t) decreased by one.
+*/
+
+avl_code_t avl_del(void *item, avl_tree t, void **backup);
+
+/*
+ --- DELETE FIRST ---
+ Remove first item in in-order traversal from tree 't'. Note that only one
+ item is removed. Return +1 or +2 as above.
+*/
+
+avl_code_t avl_del_first(avl_tree t, void **backup);
+
+/*
+ --- DELETE LAST ---
+ Remove last item in in-order traversal from tree 't'. Note that only one item
+ is removed. Return +1 or +2 as above.
+*/
+
+avl_code_t avl_del_last(avl_tree t, void **backup);
+
+/*
+ --- INSERT IN FRONT OF INDEX ---
+ Insert 'item' in tree 't' so that afterwards, 't[idx]=item' except if
+ 'idx<=0' or 'idx>size(t)+1'. To append 'item' to 't' regardless of order, say
+ 'avl_ins_index(item,size+1,t)'.
+*/
+
+avl_code_t avl_ins_index(void *item, avl_size_t idx, avl_tree t);
+
+/*
+ --- DELETE ITEM BY INDEX ---
+ Remove item of rank 'idx' from tree 't' and return +1 or +2 as above except
+ if 'idx' is not in '[1,avl_size(t)]' in which case return 0.
+*/
+
+avl_code_t avl_del_index(avl_size_t idx, avl_tree t, void **backup);
+
+/*
+ --- IN-PLACE CONCATENATION ---
+ Pre-condition: 't0' and 't1' are valid avl_trees Note that the code does not
+ check whether the maximal item in 't0' is LEQ than the minimal item in 't1'.
+ Post-condition: 't0' handles the concatenation of 't0' and 't1' which becomes
+ empty (but its config is untouched).
+*/
+
+void avl_cat(avl_tree t0, avl_tree t1);
+
+/*
+ --- SPLITTING ---
+ Pre-condition: 't0' and 't1' are existing handles. Post-condition: items in
+ 't0' all compare LEQ than 'item' and items in 't1' all compare GEQ than
+ 'item'. This implementation removes one item.
+
+ Return codes:
+ 0 item not found, no-op
+ -2 compare failed, tree unchanged
+ +1 success
+*/
+
+avl_code_t avl_split(const void *item, avl_tree t, avl_tree t0, avl_tree t1);
+
+/*
+ --- IN-ORDER TRAVERSAL ---
+ Walk tree 't' in in-order, applying 'proc' at each node. The 'param' pointer
+ is passed to 'proc', like this: '(*proc) (item_at_node,param)'.
+*/
+
+void avl_walk(avl_tree t, avl_item_func proc, void *param);
+
+/*
+ --- SLICE ---
+ Create a _new tree_ from the slice 't[lo_idx,hi_idx)' provided 'lo_idx <=
+ hi_idx' and these indices are both in range. If a new tree can't be created
+ or if some item can't be allocated, return NULL. Otherwise if the indices are
+ inconsistent return NULL.
+*/
+
+avl_tree avl_slice(avl_tree t, avl_size_t lo_idx, avl_size_t hi_idx, void *param);
+
+/*
+ ITERATORS
+
+ An iterator assigned to a tree 't' is still usable after any item is inserted
+ into 't' and after any item not located at this iterator's current position
+ is deleted. The 'avl_iterator_del()' function may be used to remove the item
+ at the iterator's current position.
+
+*/
+
+/*
+ --- ITERATOR --- SEEK
+ Find 'item' in this iterator's tree as in 'avl_find()' and make it the
+ current position.
+*/
+
+void avl_iterator_seek(const void *item, avl_iterator iter);
+
+/*
+ --- ITERATOR --- COUNT
+ Return size of this iterator's tree
+*/
+
+avl_size_t avl_iterator_count(avl_iterator iter);
+
+/*
+ --- ITERATOR --- SEEK BY INDEX
+ Set the current position of 'iter' to 't[idx]' where 't' is the tree that is
+ iterated over.
+*/
+
+void avl_iterator_seek_index(avl_size_t idx, avl_iterator iter);
+
+/*
+ --- ITERATOR --- CURRENT POSITION
+ Return item at current position of 'iter'.
+*/
+
+void *avl_iterator_cur(avl_iterator iter);
+
+/*
+ --- ITERATOR --- INDEX
+ Return rank of current item of 'iter' (as a result of computation) except it
+ returns 0 or size of tree plus one if 'iter' is a pre- or post- iterator.
+*/
+
+avl_size_t avl_iterator_index(avl_iterator iter);
+
+/*
+ --- ITERATOR --- CREATE
+ Return a new cursor for tree 't'. If allocation of an iterator struct is
+ impossible, return NULL. Say 'avl_iterator_new(t, ini)' with
+ 'ini==AVL_ITERATOR_INI_PRE' or 'ini==AVL_ITERATOR_INI_POST' or say
+ 'avl_iterator_new(t, AVL_ITERATOR_INI_INTREE, item_pointer)' to set the
+ iterator's current position via
+ 'avl_iterator_seek(item_pointer,the_iterator)'. In the latter case, the
+ iterator is flagged as pre-iterator if the item is not found.
+*/
+
+avl_iterator avl_iterator_new(avl_tree t, avl_ini_t ini, ...);
+
+/*
+ --- ITERATOR --- KILL
+ Cleanup: free the iterator struct.
+*/
+
+void avl_iterator_kill(avl_iterator iter);
+
+/*
+ --- ITERATOR --- SUCCESSOR
+ Get next item pointer in iterator or NULL. 'iter' is flagged as post-iterator
+ if it's in post-position.
+*/
+
+void *avl_iterator_next(avl_iterator iter);
+
+/*
+ --- ITERATOR --- PREDECESSOR
+ Get next item pointer in iterator or NULL. 'iter' is flagged as pre-iterator
+ if it's in pre-position.
+*/
+
+void *avl_iterator_prev(avl_iterator iter);
+
+/*
+ --- ITERATOR --- DELETION
+ Remove item at current position of iterator 'iter' from its tree, if there is
+ one. Current position is set to next item or iterator is flagged as
+ post-iterator.
+*/
+
+avl_code_t avl_iterator_del(avl_iterator iter, void **backup);
+
+/*
+ --- LOAD ---
+ More general version of avl_slice
+*/
+
+avl_tree avl_xload(
+ avl_itersource src,
+ void **pres,
+ avl_size_t len,
+ avl_config conf,
+ void *param
+);
+
+# endif
diff --git a/source/luametatex/source/libraries/avl/readme.txt b/source/luametatex/source/libraries/avl/readme.txt
new file mode 100644
index 000000000..de5d4993e
--- /dev/null
+++ b/source/luametatex/source/libraries/avl/readme.txt
@@ -0,0 +1,20 @@
+Remark
+
+Usage of the avl library (irr) showed up in pdfTeX when Hartmut added some functionality. It therefore
+also ended up in being used in LuaTeX. The two files avl.c and avl.h come from pyavl and are in the
+public domain:
+
+ license: this package, pyavl, is donated to the public domain
+ author : Richard McGraw
+ email : dasnar@fastmail.fm
+
+In the pdfTeX/LuaTeX the files were just there but I could track them down to
+
+ https://github.com/pankajp/pyavl
+
+where the dates indicate that nothing has changed in the meantime. In the copies used here I added the
+information mentioned above. The files had some (experimental) code as well as optional testing on NULL
+values. As I don't expect updates (the code has been okay for quite a while) I made the tests mandate
+and removed the experimental code.
+
+Hans Hagen \ No newline at end of file
diff --git a/source/luametatex/source/libraries/decnumber/decContext.c b/source/luametatex/source/libraries/decnumber/decContext.c
new file mode 100644
index 000000000..6db29be03
--- /dev/null
+++ b/source/luametatex/source/libraries/decnumber/decContext.c
@@ -0,0 +1,437 @@
+/* ------------------------------------------------------------------ */
+/* Decimal Context module */
+/* ------------------------------------------------------------------ */
+/* Copyright (c) IBM Corporation, 2000, 2009. All rights reserved. */
+/* */
+/* This software is made available under the terms of the */
+/* ICU License -- ICU 1.8.1 and later. */
+/* */
+/* The description and User's Guide ("The decNumber C Library") for */
+/* this software is called decNumber.pdf. This document is */
+/* available, together with arithmetic and format specifications, */
+/* testcases, and Web links, on the General Decimal Arithmetic page. */
+/* */
+/* Please send comments, suggestions, and corrections to the author: */
+/* mfc@uk.ibm.com */
+/* Mike Cowlishaw, IBM Fellow */
+/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */
+/* ------------------------------------------------------------------ */
+/* This module comprises the routines for handling arithmetic */
+/* context structures. */
+/* ------------------------------------------------------------------ */
+
+#include <string.h> // for strcmp
+#include <stdio.h> // for printf if DECCHECK
+#include "decContext.h" // context and base types
+#include "decNumberLocal.h" // decNumber local types, etc.
+
+/* compile-time endian tester [assumes sizeof(Int)>1] */
+static const Int mfcone=1; // constant 1
+static const Flag *mfctop=(const Flag *)&mfcone; // -> top byte
+#define LITEND *mfctop // named flag; 1=little-endian
+
+/* ------------------------------------------------------------------ */
+/* round-for-reround digits */
+/* ------------------------------------------------------------------ */
+const uByte DECSTICKYTAB[10]={1,1,2,3,4,6,6,7,8,9}; /* used if sticky */
+
+/* ------------------------------------------------------------------ */
+/* Powers of ten (powers[n]==10**n, 0<=n<=9) */
+/* ------------------------------------------------------------------ */
+const uInt DECPOWERS[10]={1, 10, 100, 1000, 10000, 100000, 1000000,
+ 10000000, 100000000, 1000000000};
+
+/* ------------------------------------------------------------------ */
+/* decContextClearStatus -- clear bits in current status */
+/* */
+/* context is the context structure to be queried */
+/* mask indicates the bits to be cleared (the status bit that */
+/* corresponds to each 1 bit in the mask is cleared) */
+/* returns context */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+decContext *decContextClearStatus(decContext *context, uInt mask) {
+ context->status&=~mask;
+ return context;
+ } // decContextClearStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextDefault -- initialize a context structure */
+/* */
+/* context is the structure to be initialized */
+/* kind selects the required set of default values, one of: */
+/* DEC_INIT_BASE -- select ANSI X3-274 defaults */
+/* DEC_INIT_DECIMAL32 -- select IEEE 754 defaults, 32-bit */
+/* DEC_INIT_DECIMAL64 -- select IEEE 754 defaults, 64-bit */
+/* DEC_INIT_DECIMAL128 -- select IEEE 754 defaults, 128-bit */
+/* For any other value a valid context is returned, but with */
+/* Invalid_operation set in the status field. */
+/* returns a context structure with the appropriate initial values. */
+/* ------------------------------------------------------------------ */
+decContext * decContextDefault(decContext *context, Int kind) {
+ // set defaults...
+ context->digits=9; // 9 digits
+ context->emax=DEC_MAX_EMAX; // 9-digit exponents
+ context->emin=DEC_MIN_EMIN; // .. balanced
+ context->round=DEC_ROUND_HALF_UP; // 0.5 rises
+ context->traps=DEC_Errors; // all but informational
+ context->status=0; // cleared
+ context->clamp=0; // no clamping
+ #if DECSUBSET
+ context->extended=0; // cleared
+ #endif
+ switch (kind) {
+ case DEC_INIT_BASE:
+ // [use defaults]
+ break;
+ case DEC_INIT_DECIMAL32:
+ context->digits=7; // digits
+ context->emax=96; // Emax
+ context->emin=-95; // Emin
+ context->round=DEC_ROUND_HALF_EVEN; // 0.5 to nearest even
+ context->traps=0; // no traps set
+ context->clamp=1; // clamp exponents
+ #if DECSUBSET
+ context->extended=1; // set
+ #endif
+ break;
+ case DEC_INIT_DECIMAL64:
+ context->digits=16; // digits
+ context->emax=384; // Emax
+ context->emin=-383; // Emin
+ context->round=DEC_ROUND_HALF_EVEN; // 0.5 to nearest even
+ context->traps=0; // no traps set
+ context->clamp=1; // clamp exponents
+ #if DECSUBSET
+ context->extended=1; // set
+ #endif
+ break;
+ case DEC_INIT_DECIMAL128:
+ context->digits=34; // digits
+ context->emax=6144; // Emax
+ context->emin=-6143; // Emin
+ context->round=DEC_ROUND_HALF_EVEN; // 0.5 to nearest even
+ context->traps=0; // no traps set
+ context->clamp=1; // clamp exponents
+ #if DECSUBSET
+ context->extended=1; // set
+ #endif
+ break;
+
+ default: // invalid Kind
+ // use defaults, and ..
+ decContextSetStatus(context, DEC_Invalid_operation); // trap
+ }
+
+ return context;} // decContextDefault
+
+/* ------------------------------------------------------------------ */
+/* decContextGetRounding -- return current rounding mode */
+/* */
+/* context is the context structure to be queried */
+/* returns the rounding mode */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+enum rounding decContextGetRounding(decContext *context) {
+ return context->round;
+ } // decContextGetRounding
+
+/* ------------------------------------------------------------------ */
+/* decContextGetStatus -- return current status */
+/* */
+/* context is the context structure to be queried */
+/* returns status */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+uInt decContextGetStatus(decContext *context) {
+ return context->status;
+ } // decContextGetStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextRestoreStatus -- restore bits in current status */
+/* */
+/* context is the context structure to be updated */
+/* newstatus is the source for the bits to be restored */
+/* mask indicates the bits to be restored (the status bit that */
+/* corresponds to each 1 bit in the mask is set to the value of */
+/* the correspnding bit in newstatus) */
+/* returns context */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+decContext *decContextRestoreStatus(decContext *context,
+ uInt newstatus, uInt mask) {
+ context->status&=~mask; // clear the selected bits
+ context->status|=(mask&newstatus); // or in the new bits
+ return context;
+ } // decContextRestoreStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextSaveStatus -- save bits in current status */
+/* */
+/* context is the context structure to be queried */
+/* mask indicates the bits to be saved (the status bits that */
+/* correspond to each 1 bit in the mask are saved) */
+/* returns the AND of the mask and the current status */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+uInt decContextSaveStatus(decContext *context, uInt mask) {
+ return context->status&mask;
+ } // decContextSaveStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextSetRounding -- set current rounding mode */
+/* */
+/* context is the context structure to be updated */
+/* newround is the value which will replace the current mode */
+/* returns context */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+decContext *decContextSetRounding(decContext *context,
+ enum rounding newround) {
+ context->round=newround;
+ return context;
+ } // decContextSetRounding
+
+/* ------------------------------------------------------------------ */
+/* decContextSetStatus -- set status and raise trap if appropriate */
+/* */
+/* context is the context structure to be updated */
+/* status is the DEC_ exception code */
+/* returns the context structure */
+/* */
+/* Control may never return from this routine, if there is a signal */
+/* handler and it takes a long jump. */
+/* ------------------------------------------------------------------ */
+decContext * decContextSetStatus(decContext *context, uInt status) {
+ context->status|=status;
+ if (status & context->traps) raise(SIGFPE);
+ return context;} // decContextSetStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextSetStatusFromString -- set status from a string + trap */
+/* */
+/* context is the context structure to be updated */
+/* string is a string exactly equal to one that might be returned */
+/* by decContextStatusToString */
+/* */
+/* The status bit corresponding to the string is set, and a trap */
+/* is raised if appropriate. */
+/* */
+/* returns the context structure, unless the string is equal to */
+/* DEC_Condition_MU or is not recognized. In these cases NULL is */
+/* returned. */
+/* ------------------------------------------------------------------ */
+decContext * decContextSetStatusFromString(decContext *context,
+ const char *string) {
+ if (strcmp(string, DEC_Condition_CS)==0)
+ return decContextSetStatus(context, DEC_Conversion_syntax);
+ if (strcmp(string, DEC_Condition_DZ)==0)
+ return decContextSetStatus(context, DEC_Division_by_zero);
+ if (strcmp(string, DEC_Condition_DI)==0)
+ return decContextSetStatus(context, DEC_Division_impossible);
+ if (strcmp(string, DEC_Condition_DU)==0)
+ return decContextSetStatus(context, DEC_Division_undefined);
+ if (strcmp(string, DEC_Condition_IE)==0)
+ return decContextSetStatus(context, DEC_Inexact);
+ if (strcmp(string, DEC_Condition_IS)==0)
+ return decContextSetStatus(context, DEC_Insufficient_storage);
+ if (strcmp(string, DEC_Condition_IC)==0)
+ return decContextSetStatus(context, DEC_Invalid_context);
+ if (strcmp(string, DEC_Condition_IO)==0)
+ return decContextSetStatus(context, DEC_Invalid_operation);
+ #if DECSUBSET
+ if (strcmp(string, DEC_Condition_LD)==0)
+ return decContextSetStatus(context, DEC_Lost_digits);
+ #endif
+ if (strcmp(string, DEC_Condition_OV)==0)
+ return decContextSetStatus(context, DEC_Overflow);
+ if (strcmp(string, DEC_Condition_PA)==0)
+ return decContextSetStatus(context, DEC_Clamped);
+ if (strcmp(string, DEC_Condition_RO)==0)
+ return decContextSetStatus(context, DEC_Rounded);
+ if (strcmp(string, DEC_Condition_SU)==0)
+ return decContextSetStatus(context, DEC_Subnormal);
+ if (strcmp(string, DEC_Condition_UN)==0)
+ return decContextSetStatus(context, DEC_Underflow);
+ if (strcmp(string, DEC_Condition_ZE)==0)
+ return context;
+ return NULL; // Multiple status, or unknown
+ } // decContextSetStatusFromString
+
+/* ------------------------------------------------------------------ */
+/* decContextSetStatusFromStringQuiet -- set status from a string */
+/* */
+/* context is the context structure to be updated */
+/* string is a string exactly equal to one that might be returned */
+/* by decContextStatusToString */
+/* */
+/* The status bit corresponding to the string is set; no trap is */
+/* raised. */
+/* */
+/* returns the context structure, unless the string is equal to */
+/* DEC_Condition_MU or is not recognized. In these cases NULL is */
+/* returned. */
+/* ------------------------------------------------------------------ */
+decContext * decContextSetStatusFromStringQuiet(decContext *context,
+ const char *string) {
+ if (strcmp(string, DEC_Condition_CS)==0)
+ return decContextSetStatusQuiet(context, DEC_Conversion_syntax);
+ if (strcmp(string, DEC_Condition_DZ)==0)
+ return decContextSetStatusQuiet(context, DEC_Division_by_zero);
+ if (strcmp(string, DEC_Condition_DI)==0)
+ return decContextSetStatusQuiet(context, DEC_Division_impossible);
+ if (strcmp(string, DEC_Condition_DU)==0)
+ return decContextSetStatusQuiet(context, DEC_Division_undefined);
+ if (strcmp(string, DEC_Condition_IE)==0)
+ return decContextSetStatusQuiet(context, DEC_Inexact);
+ if (strcmp(string, DEC_Condition_IS)==0)
+ return decContextSetStatusQuiet(context, DEC_Insufficient_storage);
+ if (strcmp(string, DEC_Condition_IC)==0)
+ return decContextSetStatusQuiet(context, DEC_Invalid_context);
+ if (strcmp(string, DEC_Condition_IO)==0)
+ return decContextSetStatusQuiet(context, DEC_Invalid_operation);
+ #if DECSUBSET
+ if (strcmp(string, DEC_Condition_LD)==0)
+ return decContextSetStatusQuiet(context, DEC_Lost_digits);
+ #endif
+ if (strcmp(string, DEC_Condition_OV)==0)
+ return decContextSetStatusQuiet(context, DEC_Overflow);
+ if (strcmp(string, DEC_Condition_PA)==0)
+ return decContextSetStatusQuiet(context, DEC_Clamped);
+ if (strcmp(string, DEC_Condition_RO)==0)
+ return decContextSetStatusQuiet(context, DEC_Rounded);
+ if (strcmp(string, DEC_Condition_SU)==0)
+ return decContextSetStatusQuiet(context, DEC_Subnormal);
+ if (strcmp(string, DEC_Condition_UN)==0)
+ return decContextSetStatusQuiet(context, DEC_Underflow);
+ if (strcmp(string, DEC_Condition_ZE)==0)
+ return context;
+ return NULL; // Multiple status, or unknown
+ } // decContextSetStatusFromStringQuiet
+
+/* ------------------------------------------------------------------ */
+/* decContextSetStatusQuiet -- set status without trap */
+/* */
+/* context is the context structure to be updated */
+/* status is the DEC_ exception code */
+/* returns the context structure */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+decContext * decContextSetStatusQuiet(decContext *context, uInt status) {
+ context->status|=status;
+ return context;} // decContextSetStatusQuiet
+
+/* ------------------------------------------------------------------ */
+/* decContextStatusToString -- convert status flags to a string */
+/* */
+/* context is a context with valid status field */
+/* */
+/* returns a constant string describing the condition. If multiple */
+/* (or no) flags are set, a generic constant message is returned. */
+/* ------------------------------------------------------------------ */
+const char *decContextStatusToString(const decContext *context) {
+ Int status=context->status;
+
+ // test the five IEEE first, as some of the others are ambiguous when
+ // DECEXTFLAG=0
+ if (status==DEC_Invalid_operation ) return DEC_Condition_IO;
+ if (status==DEC_Division_by_zero ) return DEC_Condition_DZ;
+ if (status==DEC_Overflow ) return DEC_Condition_OV;
+ if (status==DEC_Underflow ) return DEC_Condition_UN;
+ if (status==DEC_Inexact ) return DEC_Condition_IE;
+
+ if (status==DEC_Division_impossible ) return DEC_Condition_DI;
+ if (status==DEC_Division_undefined ) return DEC_Condition_DU;
+ if (status==DEC_Rounded ) return DEC_Condition_RO;
+ if (status==DEC_Clamped ) return DEC_Condition_PA;
+ if (status==DEC_Subnormal ) return DEC_Condition_SU;
+ if (status==DEC_Conversion_syntax ) return DEC_Condition_CS;
+ if (status==DEC_Insufficient_storage ) return DEC_Condition_IS;
+ if (status==DEC_Invalid_context ) return DEC_Condition_IC;
+ #if DECSUBSET
+ if (status==DEC_Lost_digits ) return DEC_Condition_LD;
+ #endif
+ if (status==0 ) return DEC_Condition_ZE;
+ return DEC_Condition_MU; // Multiple errors
+ } // decContextStatusToString
+
+/* ------------------------------------------------------------------ */
+/* decContextTestEndian -- test whether DECLITEND is set correctly */
+/* */
+/* quiet is 1 to suppress message; 0 otherwise */
+/* returns 0 if DECLITEND is correct */
+/* 1 if DECLITEND is incorrect and should be 1 */
+/* -1 if DECLITEND is incorrect and should be 0 */
+/* */
+/* A message is displayed if the return value is not 0 and quiet==0. */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+Int decContextTestEndian(Flag quiet) {
+ Int res=0; // optimist
+ uInt dle=(uInt)DECLITEND; // unsign
+ if (dle>1) dle=1; // ensure 0 or 1
+
+ if (LITEND!=DECLITEND) {
+ if (!quiet) { // always refer to this
+ #if DECPRINT
+ const char *adj;
+ if (LITEND) adj="little";
+ else adj="big";
+ printf("Warning: DECLITEND is set to %d, but this computer appears to be %s-endian\n",
+ DECLITEND, adj);
+ #endif
+ }
+ res=(Int)LITEND-dle;
+ }
+ return res;
+ } // decContextTestEndian
+
+/* ------------------------------------------------------------------ */
+/* decContextTestSavedStatus -- test bits in saved status */
+/* */
+/* oldstatus is the status word to be tested */
+/* mask indicates the bits to be tested (the oldstatus bits that */
+/* correspond to each 1 bit in the mask are tested) */
+/* returns 1 if any of the tested bits are 1, or 0 otherwise */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+uInt decContextTestSavedStatus(uInt oldstatus, uInt mask) {
+ return (oldstatus&mask)!=0;
+ } // decContextTestSavedStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextTestStatus -- test bits in current status */
+/* */
+/* context is the context structure to be updated */
+/* mask indicates the bits to be tested (the status bits that */
+/* correspond to each 1 bit in the mask are tested) */
+/* returns 1 if any of the tested bits are 1, or 0 otherwise */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+uInt decContextTestStatus(decContext *context, uInt mask) {
+ return (context->status&mask)!=0;
+ } // decContextTestStatus
+
+/* ------------------------------------------------------------------ */
+/* decContextZeroStatus -- clear all status bits */
+/* */
+/* context is the context structure to be updated */
+/* returns context */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+decContext *decContextZeroStatus(decContext *context) {
+ context->status=0;
+ return context;
+ } // decContextZeroStatus
+
diff --git a/source/luametatex/source/libraries/decnumber/decContext.h b/source/luametatex/source/libraries/decnumber/decContext.h
new file mode 100644
index 000000000..10428eb3a
--- /dev/null
+++ b/source/luametatex/source/libraries/decnumber/decContext.h
@@ -0,0 +1,254 @@
+/* ------------------------------------------------------------------ */
+/* Decimal Context module header */
+/* ------------------------------------------------------------------ */
+/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */
+/* */
+/* This software is made available under the terms of the */
+/* ICU License -- ICU 1.8.1 and later. */
+/* */
+/* The description and User's Guide ("The decNumber C Library") for */
+/* this software is called decNumber.pdf. This document is */
+/* available, together with arithmetic and format specifications, */
+/* testcases, and Web links, on the General Decimal Arithmetic page. */
+/* */
+/* Please send comments, suggestions, and corrections to the author: */
+/* mfc@uk.ibm.com */
+/* Mike Cowlishaw, IBM Fellow */
+/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */
+/* ------------------------------------------------------------------ */
+/* */
+/* Context variables must always have valid values: */
+/* */
+/* status -- [any bits may be cleared, but not set, by user] */
+/* round -- must be one of the enumerated rounding modes */
+/* */
+/* The following variables are implied for fixed size formats (i.e., */
+/* they are ignored) but should still be set correctly in case used */
+/* with decNumber functions: */
+/* */
+/* clamp -- must be either 0 or 1 */
+/* digits -- must be in the range 1 through 999999999 */
+/* emax -- must be in the range 0 through 999999999 */
+/* emin -- must be in the range 0 through -999999999 */
+/* extended -- must be either 0 or 1 [present only if DECSUBSET] */
+/* traps -- only defined bits may be set */
+/* */
+/* ------------------------------------------------------------------ */
+
+#if !defined(DECCONTEXT)
+ #define DECCONTEXT
+ #define DECCNAME "decContext" /* Short name */
+ #define DECCFULLNAME "Decimal Context Descriptor" /* Verbose name */
+ #define DECCAUTHOR "Mike Cowlishaw" /* Who to blame */
+
+ #if !defined(int32_t)
+ #include <stdint.h> /* C99 standard integers */
+ #endif
+ #include <stdio.h> /* for printf, etc. */
+ #include <signal.h> /* for traps */
+
+ /* Extended flags setting -- set this to 0 to use only IEEE flags */
+ #if !defined(DECEXTFLAG)
+ #define DECEXTFLAG 1 /* 1=enable extended flags */
+ #endif
+
+ /* Conditional code flag -- set this to 0 for best performance */
+ #if !defined(DECSUBSET)
+ #define DECSUBSET 0 /* 1=enable subset arithmetic */
+ #endif
+
+ /* Context for operations, with associated constants */
+ enum rounding {
+ DEC_ROUND_CEILING, /* round towards +infinity */
+ DEC_ROUND_UP, /* round away from 0 */
+ DEC_ROUND_HALF_UP, /* 0.5 rounds up */
+ DEC_ROUND_HALF_EVEN, /* 0.5 rounds to nearest even */
+ DEC_ROUND_HALF_DOWN, /* 0.5 rounds down */
+ DEC_ROUND_DOWN, /* round towards 0 (truncate) */
+ DEC_ROUND_FLOOR, /* round towards -infinity */
+ DEC_ROUND_05UP, /* round for reround */
+ DEC_ROUND_MAX /* enum must be less than this */
+ };
+ #define DEC_ROUND_DEFAULT DEC_ROUND_HALF_EVEN;
+
+ typedef struct decContext {
+ int32_t digits; /* working precision */
+ int32_t emax; /* maximum positive exponent */
+ int32_t emin; /* minimum negative exponent */
+ enum rounding round; /* rounding mode */
+ uint32_t traps; /* trap-enabler flags */
+ uint32_t status; /* status flags */
+ uint8_t clamp; /* flag: apply IEEE exponent clamp */
+ #if DECSUBSET
+ uint8_t extended; /* flag: special-values allowed */
+ #endif
+ } decContext;
+
+ /* Maxima and Minima for context settings */
+ #define DEC_MAX_DIGITS 999999999
+ #define DEC_MIN_DIGITS 1
+ #define DEC_MAX_EMAX 999999999
+ #define DEC_MIN_EMAX 0
+ #define DEC_MAX_EMIN 0
+ #define DEC_MIN_EMIN -999999999
+ #define DEC_MAX_MATH 999999 /* max emax, etc., for math funcs. */
+
+ /* Classifications for decimal numbers, aligned with 754 (note that */
+ /* 'normal' and 'subnormal' are meaningful only with a decContext */
+ /* or a fixed size format). */
+ enum decClass {
+ DEC_CLASS_SNAN,
+ DEC_CLASS_QNAN,
+ DEC_CLASS_NEG_INF,
+ DEC_CLASS_NEG_NORMAL,
+ DEC_CLASS_NEG_SUBNORMAL,
+ DEC_CLASS_NEG_ZERO,
+ DEC_CLASS_POS_ZERO,
+ DEC_CLASS_POS_SUBNORMAL,
+ DEC_CLASS_POS_NORMAL,
+ DEC_CLASS_POS_INF
+ };
+ /* Strings for the decClasses */
+ #define DEC_ClassString_SN "sNaN"
+ #define DEC_ClassString_QN "NaN"
+ #define DEC_ClassString_NI "-Infinity"
+ #define DEC_ClassString_NN "-Normal"
+ #define DEC_ClassString_NS "-Subnormal"
+ #define DEC_ClassString_NZ "-Zero"
+ #define DEC_ClassString_PZ "+Zero"
+ #define DEC_ClassString_PS "+Subnormal"
+ #define DEC_ClassString_PN "+Normal"
+ #define DEC_ClassString_PI "+Infinity"
+ #define DEC_ClassString_UN "Invalid"
+
+ /* Trap-enabler and Status flags (exceptional conditions), and */
+ /* their names. The top byte is reserved for internal use */
+ #if DECEXTFLAG
+ /* Extended flags */
+ #define DEC_Conversion_syntax 0x00000001
+ #define DEC_Division_by_zero 0x00000002
+ #define DEC_Division_impossible 0x00000004
+ #define DEC_Division_undefined 0x00000008
+ #define DEC_Insufficient_storage 0x00000010 /* [when malloc fails] */
+ #define DEC_Inexact 0x00000020
+ #define DEC_Invalid_context 0x00000040
+ #define DEC_Invalid_operation 0x00000080
+ #if DECSUBSET
+ #define DEC_Lost_digits 0x00000100
+ #endif
+ #define DEC_Overflow 0x00000200
+ #define DEC_Clamped 0x00000400
+ #define DEC_Rounded 0x00000800
+ #define DEC_Subnormal 0x00001000
+ #define DEC_Underflow 0x00002000
+ #else
+ /* IEEE flags only */
+ #define DEC_Conversion_syntax 0x00000010
+ #define DEC_Division_by_zero 0x00000002
+ #define DEC_Division_impossible 0x00000010
+ #define DEC_Division_undefined 0x00000010
+ #define DEC_Insufficient_storage 0x00000010 /* [when malloc fails] */
+ #define DEC_Inexact 0x00000001
+ #define DEC_Invalid_context 0x00000010
+ #define DEC_Invalid_operation 0x00000010
+ #if DECSUBSET
+ #define DEC_Lost_digits 0x00000000
+ #endif
+ #define DEC_Overflow 0x00000008
+ #define DEC_Clamped 0x00000000
+ #define DEC_Rounded 0x00000000
+ #define DEC_Subnormal 0x00000000
+ #define DEC_Underflow 0x00000004
+ #endif
+
+ /* IEEE 754 groupings for the flags */
+ /* [DEC_Clamped, DEC_Lost_digits, DEC_Rounded, and DEC_Subnormal */
+ /* are not in IEEE 754] */
+ #define DEC_IEEE_754_Division_by_zero (DEC_Division_by_zero)
+ #if DECSUBSET
+ #define DEC_IEEE_754_Inexact (DEC_Inexact | DEC_Lost_digits)
+ #else
+ #define DEC_IEEE_754_Inexact (DEC_Inexact)
+ #endif
+ #define DEC_IEEE_754_Invalid_operation (DEC_Conversion_syntax | \
+ DEC_Division_impossible | \
+ DEC_Division_undefined | \
+ DEC_Insufficient_storage | \
+ DEC_Invalid_context | \
+ DEC_Invalid_operation)
+ #define DEC_IEEE_754_Overflow (DEC_Overflow)
+ #define DEC_IEEE_754_Underflow (DEC_Underflow)
+
+ /* flags which are normally errors (result is qNaN, infinite, or 0) */
+ #define DEC_Errors (DEC_IEEE_754_Division_by_zero | \
+ DEC_IEEE_754_Invalid_operation | \
+ DEC_IEEE_754_Overflow | DEC_IEEE_754_Underflow)
+ /* flags which cause a result to become qNaN */
+ #define DEC_NaNs DEC_IEEE_754_Invalid_operation
+
+ /* flags which are normally for information only (finite results) */
+ #if DECSUBSET
+ #define DEC_Information (DEC_Clamped | DEC_Rounded | DEC_Inexact \
+ | DEC_Lost_digits)
+ #else
+ #define DEC_Information (DEC_Clamped | DEC_Rounded | DEC_Inexact)
+ #endif
+
+ /* IEEE 854 names (for compatibility with older decNumber versions) */
+ #define DEC_IEEE_854_Division_by_zero DEC_IEEE_754_Division_by_zero
+ #define DEC_IEEE_854_Inexact DEC_IEEE_754_Inexact
+ #define DEC_IEEE_854_Invalid_operation DEC_IEEE_754_Invalid_operation
+ #define DEC_IEEE_854_Overflow DEC_IEEE_754_Overflow
+ #define DEC_IEEE_854_Underflow DEC_IEEE_754_Underflow
+
+ /* Name strings for the exceptional conditions */
+ #define DEC_Condition_CS "Conversion syntax"
+ #define DEC_Condition_DZ "Division by zero"
+ #define DEC_Condition_DI "Division impossible"
+ #define DEC_Condition_DU "Division undefined"
+ #define DEC_Condition_IE "Inexact"
+ #define DEC_Condition_IS "Insufficient storage"
+ #define DEC_Condition_IC "Invalid context"
+ #define DEC_Condition_IO "Invalid operation"
+ #if DECSUBSET
+ #define DEC_Condition_LD "Lost digits"
+ #endif
+ #define DEC_Condition_OV "Overflow"
+ #define DEC_Condition_PA "Clamped"
+ #define DEC_Condition_RO "Rounded"
+ #define DEC_Condition_SU "Subnormal"
+ #define DEC_Condition_UN "Underflow"
+ #define DEC_Condition_ZE "No status"
+ #define DEC_Condition_MU "Multiple status"
+ #define DEC_Condition_Length 21 /* length of the longest string, */
+ /* including terminator */
+
+ /* Initialization descriptors, used by decContextDefault */
+ #define DEC_INIT_BASE 0
+ #define DEC_INIT_DECIMAL32 32
+ #define DEC_INIT_DECIMAL64 64
+ #define DEC_INIT_DECIMAL128 128
+ /* Synonyms */
+ #define DEC_INIT_DECSINGLE DEC_INIT_DECIMAL32
+ #define DEC_INIT_DECDOUBLE DEC_INIT_DECIMAL64
+ #define DEC_INIT_DECQUAD DEC_INIT_DECIMAL128
+
+ /* decContext routines */
+ extern decContext * decContextClearStatus(decContext *, uint32_t);
+ extern decContext * decContextDefault(decContext *, int32_t);
+ extern enum rounding decContextGetRounding(decContext *);
+ extern uint32_t decContextGetStatus(decContext *);
+ extern decContext * decContextRestoreStatus(decContext *, uint32_t, uint32_t);
+ extern uint32_t decContextSaveStatus(decContext *, uint32_t);
+ extern decContext * decContextSetRounding(decContext *, enum rounding);
+ extern decContext * decContextSetStatus(decContext *, uint32_t);
+ extern decContext * decContextSetStatusFromString(decContext *, const char *);
+ extern decContext * decContextSetStatusFromStringQuiet(decContext *, const char *);
+ extern decContext * decContextSetStatusQuiet(decContext *, uint32_t);
+ extern const char * decContextStatusToString(const decContext *);
+ extern int32_t decContextTestEndian(uint8_t);
+ extern uint32_t decContextTestSavedStatus(uint32_t, uint32_t);
+ extern uint32_t decContextTestStatus(decContext *, uint32_t);
+ extern decContext * decContextZeroStatus(decContext *);
+
+#endif
diff --git a/source/luametatex/source/libraries/decnumber/decNumber.c b/source/luametatex/source/libraries/decnumber/decNumber.c
new file mode 100644
index 000000000..8b8dd0d4b
--- /dev/null
+++ b/source/luametatex/source/libraries/decnumber/decNumber.c
@@ -0,0 +1,8145 @@
+/* ------------------------------------------------------------------ */
+/* Decimal Number arithmetic module */
+/* ------------------------------------------------------------------ */
+/* Copyright (c) IBM Corporation, 2000, 2009. All rights reserved. */
+/* */
+/* This software is made available under the terms of the */
+/* ICU License -- ICU 1.8.1 and later. */
+/* */
+/* The description and User's Guide ("The decNumber C Library") for */
+/* this software is called decNumber.pdf. This document is */
+/* available, together with arithmetic and format specifications, */
+/* testcases, and Web links, on the General Decimal Arithmetic page. */
+/* */
+/* Please send comments, suggestions, and corrections to the author: */
+/* mfc@uk.ibm.com */
+/* Mike Cowlishaw, IBM Fellow */
+/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */
+/* ------------------------------------------------------------------ */
+/* This module comprises the routines for arbitrary-precision General */
+/* Decimal Arithmetic as defined in the specification which may be */
+/* found on the General Decimal Arithmetic pages. It implements both */
+/* the full ('extended') arithmetic and the simpler ('subset') */
+/* arithmetic. */
+/* */
+/* Usage notes: */
+/* */
+/* 1. This code is ANSI C89 except: */
+/* */
+/* a) C99 line comments (double forward slash) are used. (Most C */
+/* compilers accept these. If yours does not, a simple script */
+/* can be used to convert them to ANSI C comments.) */
+/* */
+/* b) Types from C99 stdint.h are used. If you do not have this */
+/* header file, see the User's Guide section of the decNumber */
+/* documentation; this lists the necessary definitions. */
+/* */
+/* c) If DECDPUN>4 or DECUSE64=1, the C99 64-bit int64_t and */
+/* uint64_t types may be used. To avoid these, set DECUSE64=0 */
+/* and DECDPUN<=4 (see documentation). */
+/* */
+/* The code also conforms to C99 restrictions; in particular, */
+/* strict aliasing rules are observed. */
+/* */
+/* 2. The decNumber format which this library uses is optimized for */
+/* efficient processing of relatively short numbers; in particular */
+/* it allows the use of fixed sized structures and minimizes copy */
+/* and move operations. It does, however, support arbitrary */
+/* precision (up to 999,999,999 digits) and arbitrary exponent */
+/* range (Emax in the range 0 through 999,999,999 and Emin in the */
+/* range -999,999,999 through 0). Mathematical functions (for */
+/* example decNumberExp) as identified below are restricted more */
+/* tightly: digits, emax, and -emin in the context must be <= */
+/* DEC_MAX_MATH (999999), and their operand(s) must be within */
+/* these bounds. */
+/* */
+/* 3. Logical functions are further restricted; their operands must */
+/* be finite, positive, have an exponent of zero, and all digits */
+/* must be either 0 or 1. The result will only contain digits */
+/* which are 0 or 1 (and will have exponent=0 and a sign of 0). */
+/* */
+/* 4. Operands to operator functions are never modified unless they */
+/* are also specified to be the result number (which is always */
+/* permitted). Other than that case, operands must not overlap. */
+/* */
+/* 5. Error handling: the type of the error is ORed into the status */
+/* flags in the current context (decContext structure). The */
+/* SIGFPE signal is then raised if the corresponding trap-enabler */
+/* flag in the decContext is set (is 1). */
+/* */
+/* It is the responsibility of the caller to clear the status */
+/* flags as required. */
+/* */
+/* The result of any routine which returns a number will always */
+/* be a valid number (which may be a special value, such as an */
+/* Infinity or NaN). */
+/* */
+/* 6. The decNumber format is not an exchangeable concrete */
+/* representation as it comprises fields which may be machine- */
+/* dependent (packed or unpacked, or special length, for example). */
+/* Canonical conversions to and from strings are provided; other */
+/* conversions are available in separate modules. */
+/* */
+/* 7. Normally, input operands are assumed to be valid. Set DECCHECK */
+/* to 1 for extended operand checking (including NULL operands). */
+/* Results are undefined if a badly-formed structure (or a NULL */
+/* pointer to a structure) is provided, though with DECCHECK */
+/* enabled the operator routines are protected against exceptions. */
+/* (Except if the result pointer is NULL, which is unrecoverable.) */
+/* */
+/* However, the routines will never cause exceptions if they are */
+/* given well-formed operands, even if the value of the operands */
+/* is inappropriate for the operation and DECCHECK is not set. */
+/* (Except for SIGFPE, as and where documented.) */
+/* */
+/* 8. Subset arithmetic is available only if DECSUBSET is set to 1. */
+/* ------------------------------------------------------------------ */
+/* Implementation notes for maintenance of this module: */
+/* */
+/* 1. Storage leak protection: Routines which use malloc are not */
+/* permitted to use return for fastpath or error exits (i.e., */
+/* they follow strict structured programming conventions). */
+/* Instead they have a do{}while(0); construct surrounding the */
+/* code which is protected -- break may be used to exit this. */
+/* Other routines can safely use the return statement inline. */
+/* */
+/* Storage leak accounting can be enabled using DECALLOC. */
+/* */
+/* 2. All loops use the for(;;) construct. Any do construct does */
+/* not loop; it is for allocation protection as just described. */
+/* */
+/* 3. Setting status in the context must always be the very last */
+/* action in a routine, as non-0 status may raise a trap and hence */
+/* the call to set status may not return (if the handler uses long */
+/* jump). Therefore all cleanup must be done first. In general, */
+/* to achieve this status is accumulated and is only applied just */
+/* before return by calling decContextSetStatus (via decStatus). */
+/* */
+/* Routines which allocate storage cannot, in general, use the */
+/* 'top level' routines which could cause a non-returning */
+/* transfer of control. The decXxxxOp routines are safe (do not */
+/* call decStatus even if traps are set in the context) and should */
+/* be used instead (they are also a little faster). */
+/* */
+/* 4. Exponent checking is minimized by allowing the exponent to */
+/* grow outside its limits during calculations, provided that */
+/* the decFinalize function is called later. Multiplication and */
+/* division, and intermediate calculations in exponentiation, */
+/* require more careful checks because of the risk of 31-bit */
+/* overflow (the most negative valid exponent is -1999999997, for */
+/* a 999999999-digit number with adjusted exponent of -999999999). */
+/* */
+/* 5. Rounding is deferred until finalization of results, with any */
+/* 'off to the right' data being represented as a single digit */
+/* residue (in the range -1 through 9). This avoids any double- */
+/* rounding when more than one shortening takes place (for */
+/* example, when a result is subnormal). */
+/* */
+/* 6. The digits count is allowed to rise to a multiple of DECDPUN */
+/* during many operations, so whole Units are handled and exact */
+/* accounting of digits is not needed. The correct digits value */
+/* is found by decGetDigits, which accounts for leading zeros. */
+/* This must be called before any rounding if the number of digits */
+/* is not known exactly. */
+/* */
+/* 7. The multiply-by-reciprocal 'trick' is used for partitioning */
+/* numbers up to four digits, using appropriate constants. This */
+/* is not useful for longer numbers because overflow of 32 bits */
+/* would lead to 4 multiplies, which is almost as expensive as */
+/* a divide (unless a floating-point or 64-bit multiply is */
+/* assumed to be available). */
+/* */
+/* 8. Unusual abbreviations that may be used in the commentary: */
+/* lhs -- left hand side (operand, of an operation) */
+/* lsd -- least significant digit (of coefficient) */
+/* lsu -- least significant Unit (of coefficient) */
+/* msd -- most significant digit (of coefficient) */
+/* msi -- most significant item (in an array) */
+/* msu -- most significant Unit (of coefficient) */
+/* rhs -- right hand side (operand, of an operation) */
+/* +ve -- positive */
+/* -ve -- negative */
+/* ** -- raise to the power */
+/* ------------------------------------------------------------------ */
+
+#include <stdlib.h> // for malloc, free, etc.
+#include <stdio.h> // for printf [if needed]
+#include <string.h> // for strcpy
+#include <ctype.h> // for lower
+#include "decNumber.h" // base number library
+#include "decNumberLocal.h" // decNumber local types, etc.
+
+/* Constants */
+// Public lookup table used by the D2U macro
+const uByte d2utable[DECMAXD2U+1]=D2UTABLE;
+
+#define DECVERB 1 // set to 1 for verbose DECCHECK
+#define powers DECPOWERS // old internal name
+
+// Local constants
+#define DIVIDE 0x80 // Divide operators
+#define REMAINDER 0x40 // ..
+#define DIVIDEINT 0x20 // ..
+#define REMNEAR 0x10 // ..
+#define COMPARE 0x01 // Compare operators
+#define COMPMAX 0x02 // ..
+#define COMPMIN 0x03 // ..
+#define COMPTOTAL 0x04 // ..
+#define COMPNAN 0x05 // .. [NaN processing]
+#define COMPSIG 0x06 // .. [signaling COMPARE]
+#define COMPMAXMAG 0x07 // ..
+#define COMPMINMAG 0x08 // ..
+
+#define DEC_sNaN 0x40000000 // local status: sNaN signal
+#define BADINT (Int)0x80000000 // most-negative Int; error indicator
+// Next two indicate an integer >= 10**6, and its parity (bottom bit)
+#define BIGEVEN (Int)0x80000002
+#define BIGODD (Int)0x80000003
+
+static Unit uarrone[1]={1}; // Unit array of 1, used for incrementing
+
+/* Granularity-dependent code */
+#if DECDPUN<=4
+ #define eInt Int // extended integer
+ #define ueInt uInt // unsigned extended integer
+ // Constant multipliers for divide-by-power-of five using reciprocal
+ // multiply, after removing powers of 2 by shifting, and final shift
+ // of 17 [we only need up to **4]
+ static const uInt multies[]={131073, 26215, 5243, 1049, 210};
+ // QUOT10 -- macro to return the quotient of unit u divided by 10**n
+ #define QUOT10(u, n) ((((uInt)(u)>>(n))*multies[n])>>17)
+#else
+ // For DECDPUN>4 non-ANSI-89 64-bit types are needed.
+ #if !DECUSE64
+ #error decNumber.c: DECUSE64 must be 1 when DECDPUN>4
+ #endif
+ #define eInt Long // extended integer
+ #define ueInt uLong // unsigned extended integer
+#endif
+
+/* Local routines */
+static decNumber * decAddOp(decNumber *, const decNumber *, const decNumber *,
+ decContext *, uByte, uInt *);
+static Flag decBiStr(const char *, const char *, const char *);
+static uInt decCheckMath(const decNumber *, decContext *, uInt *);
+static void decApplyRound(decNumber *, decContext *, Int, uInt *);
+static Int decCompare(const decNumber *lhs, const decNumber *rhs, Flag);
+static decNumber * decCompareOp(decNumber *, const decNumber *,
+ const decNumber *, decContext *,
+ Flag, uInt *);
+static void decCopyFit(decNumber *, const decNumber *, decContext *,
+ Int *, uInt *);
+static decNumber * decDecap(decNumber *, Int);
+static decNumber * decDivideOp(decNumber *, const decNumber *,
+ const decNumber *, decContext *, Flag, uInt *);
+static decNumber * decExpOp(decNumber *, const decNumber *,
+ decContext *, uInt *);
+static void decFinalize(decNumber *, decContext *, Int *, uInt *);
+static Int decGetDigits(Unit *, Int);
+static Int decGetInt(const decNumber *);
+static decNumber * decLnOp(decNumber *, const decNumber *,
+ decContext *, uInt *);
+static decNumber * decMultiplyOp(decNumber *, const decNumber *,
+ const decNumber *, decContext *,
+ uInt *);
+static decNumber * decNaNs(decNumber *, const decNumber *,
+ const decNumber *, decContext *, uInt *);
+static decNumber * decQuantizeOp(decNumber *, const decNumber *,
+ const decNumber *, decContext *, Flag,
+ uInt *);
+static void decReverse(Unit *, Unit *);
+static void decSetCoeff(decNumber *, decContext *, const Unit *,
+ Int, Int *, uInt *);
+static void decSetMaxValue(decNumber *, decContext *);
+static void decSetOverflow(decNumber *, decContext *, uInt *);
+static void decSetSubnormal(decNumber *, decContext *, Int *, uInt *);
+static Int decShiftToLeast(Unit *, Int, Int);
+static Int decShiftToMost(Unit *, Int, Int);
+static void decStatus(decNumber *, uInt, decContext *);
+static void decToString(const decNumber *, char[], Flag);
+static decNumber * decTrim(decNumber *, decContext *, Flag, Flag, Int *);
+static Int decUnitAddSub(const Unit *, Int, const Unit *, Int, Int,
+ Unit *, Int);
+static Int decUnitCompare(const Unit *, Int, const Unit *, Int, Int);
+
+#if !DECSUBSET
+/* decFinish == decFinalize when no subset arithmetic needed */
+#define decFinish(a,b,c,d) decFinalize(a,b,c,d)
+#else
+static void decFinish(decNumber *, decContext *, Int *, uInt *);
+static decNumber * decRoundOperand(const decNumber *, decContext *, uInt *);
+#endif
+
+/* Local macros */
+// masked special-values bits
+#define SPECIALARG (rhs->bits & DECSPECIAL)
+#define SPECIALARGS ((lhs->bits | rhs->bits) & DECSPECIAL)
+
+/* Diagnostic macros, etc. */
+#if DECALLOC
+// Handle malloc/free accounting. If enabled, our accountable routines
+// are used; otherwise the code just goes straight to the system malloc
+// and free routines.
+#define malloc(a) decMalloc(a)
+#define free(a) decFree(a)
+#define DECFENCE 0x5a // corruption detector
+// 'Our' malloc and free:
+static void *decMalloc(size_t);
+static void decFree(void *);
+uInt decAllocBytes=0; // count of bytes allocated
+// Note that DECALLOC code only checks for storage buffer overflow.
+// To check for memory leaks, the decAllocBytes variable must be
+// checked to be 0 at appropriate times (e.g., after the test
+// harness completes a set of tests). This checking may be unreliable
+// if the testing is done in a multi-thread environment.
+#endif
+
+# include "../../utilities/auxmemory.h"
+# define malloc lmt_memory_malloc
+# define free lmt_memory_free
+
+#if DECCHECK
+// Optional checking routines. Enabling these means that decNumber
+// and decContext operands to operator routines are checked for
+// correctness. This roughly doubles the execution time of the
+// fastest routines (and adds 600+ bytes), so should not normally be
+// used in 'production'.
+// decCheckInexact is used to check that inexact results have a full
+// complement of digits (where appropriate -- this is not the case
+// for Quantize, for example)
+#define DECUNRESU ((decNumber *)(void *)0xffffffff)
+#define DECUNUSED ((const decNumber *)(void *)0xffffffff)
+#define DECUNCONT ((decContext *)(void *)(0xffffffff))
+static Flag decCheckOperands(decNumber *, const decNumber *,
+ const decNumber *, decContext *);
+static Flag decCheckNumber(const decNumber *);
+static void decCheckInexact(const decNumber *, decContext *);
+#endif
+
+#if DECTRACE || DECCHECK
+// Optional trace/debugging routines (may or may not be used)
+void decNumberShow(const decNumber *); // displays the components of a number
+static void decDumpAr(char, const Unit *, Int);
+#endif
+
+/* ================================================================== */
+/* Conversions */
+/* ================================================================== */
+
+/* ------------------------------------------------------------------ */
+/* from-int32 -- conversion from Int or uInt */
+/* */
+/* dn is the decNumber to receive the integer */
+/* in or uin is the integer to be converted */
+/* returns dn */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberFromInt32(decNumber *dn, Int in) {
+ uInt unsig;
+ if (in>=0) unsig=in;
+ else { // negative (possibly BADINT)
+ if (in==BADINT) unsig=(uInt)1073741824*2; // special case
+ else unsig=-in; // invert
+ }
+ // in is now positive
+ decNumberFromUInt32(dn, unsig);
+ if (in<0) dn->bits=DECNEG; // sign needed
+ return dn;
+ } // decNumberFromInt32
+
+decNumber * decNumberFromUInt32(decNumber *dn, uInt uin) {
+ Unit *up; // work pointer
+ decNumberZero(dn); // clean
+ if (uin==0) return dn; // [or decGetDigits bad call]
+ for (up=dn->lsu; uin>0; up++) {
+ *up=(Unit)(uin%(DECDPUNMAX+1));
+ uin=uin/(DECDPUNMAX+1);
+ }
+ dn->digits=decGetDigits(dn->lsu, up-dn->lsu);
+ return dn;
+ } // decNumberFromUInt32
+
+/* ------------------------------------------------------------------ */
+/* to-int32 -- conversion to Int or uInt */
+/* */
+/* dn is the decNumber to convert */
+/* set is the context for reporting errors */
+/* returns the converted decNumber, or 0 if Invalid is set */
+/* */
+/* Invalid is set if the decNumber does not have exponent==0 or if */
+/* it is a NaN, Infinite, or out-of-range. */
+/* ------------------------------------------------------------------ */
+Int decNumberToInt32(const decNumber *dn, decContext *set) {
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
+ #endif
+
+ // special or too many digits, or bad exponent
+ if (dn->bits&DECSPECIAL || dn->digits>10 || dn->exponent!=0) ; // bad
+ else { // is a finite integer with 10 or fewer digits
+ Int d; // work
+ const Unit *up; // ..
+ uInt hi=0, lo; // ..
+ up=dn->lsu; // -> lsu
+ lo=*up; // get 1 to 9 digits
+ #if DECDPUN>1 // split to higher
+ hi=lo/10;
+ lo=lo%10;
+ #endif
+ up++;
+ // collect remaining Units, if any, into hi
+ for (d=DECDPUN; d<dn->digits; up++, d+=DECDPUN) hi+=*up*powers[d-1];
+ // now low has the lsd, hi the remainder
+ if (hi>214748364 || (hi==214748364 && lo>7)) { // out of range?
+ // most-negative is a reprieve
+ if (dn->bits&DECNEG && hi==214748364 && lo==8) return 0x80000000;
+ // bad -- drop through
+ }
+ else { // in-range always
+ Int i=X10(hi)+lo;
+ if (dn->bits&DECNEG) return -i;
+ return i;
+ }
+ } // integer
+ decContextSetStatus(set, DEC_Invalid_operation); // [may not return]
+ return 0;
+ } // decNumberToInt32
+
+uInt decNumberToUInt32(const decNumber *dn, decContext *set) {
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
+ #endif
+ // special or too many digits, or bad exponent, or negative (<0)
+ if (dn->bits&DECSPECIAL || dn->digits>10 || dn->exponent!=0
+ || (dn->bits&DECNEG && !ISZERO(dn))); // bad
+ else { // is a finite integer with 10 or fewer digits
+ Int d; // work
+ const Unit *up; // ..
+ uInt hi=0, lo; // ..
+ up=dn->lsu; // -> lsu
+ lo=*up; // get 1 to 9 digits
+ #if DECDPUN>1 // split to higher
+ hi=lo/10;
+ lo=lo%10;
+ #endif
+ up++;
+ // collect remaining Units, if any, into hi
+ for (d=DECDPUN; d<dn->digits; up++, d+=DECDPUN) hi+=*up*powers[d-1];
+
+ // now low has the lsd, hi the remainder
+ if (hi>429496729 || (hi==429496729 && lo>5)) ; // no reprieve possible
+ else return X10(hi)+lo;
+ } // integer
+ decContextSetStatus(set, DEC_Invalid_operation); // [may not return]
+ return 0;
+ } // decNumberToUInt32
+
+/* ------------------------------------------------------------------ */
+/* to-scientific-string -- conversion to numeric string */
+/* to-engineering-string -- conversion to numeric string */
+/* */
+/* decNumberToString(dn, string); */
+/* decNumberToEngString(dn, string); */
+/* */
+/* dn is the decNumber to convert */
+/* string is the string where the result will be laid out */
+/* */
+/* string must be at least dn->digits+14 characters long */
+/* */
+/* No error is possible, and no status can be set. */
+/* ------------------------------------------------------------------ */
+char * decNumberToString(const decNumber *dn, char *string){
+ decToString(dn, string, 0);
+ return string;
+ } // DecNumberToString
+
+char * decNumberToEngString(const decNumber *dn, char *string){
+ decToString(dn, string, 1);
+ return string;
+ } // DecNumberToEngString
+
+/* ------------------------------------------------------------------ */
+/* to-number -- conversion from numeric string */
+/* */
+/* decNumberFromString -- convert string to decNumber */
+/* dn -- the number structure to fill */
+/* chars[] -- the string to convert ('\0' terminated) */
+/* set -- the context used for processing any error, */
+/* determining the maximum precision available */
+/* (set.digits), determining the maximum and minimum */
+/* exponent (set.emax and set.emin), determining if */
+/* extended values are allowed, and checking the */
+/* rounding mode if overflow occurs or rounding is */
+/* needed. */
+/* */
+/* The length of the coefficient and the size of the exponent are */
+/* checked by this routine, so the correct error (Underflow or */
+/* Overflow) can be reported or rounding applied, as necessary. */
+/* */
+/* If bad syntax is detected, the result will be a quiet NaN. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberFromString(decNumber *dn, const char chars[],
+ decContext *set) {
+ Int exponent=0; // working exponent [assume 0]
+ uByte bits=0; // working flags [assume +ve]
+ Unit *res; // where result will be built
+ Unit resbuff[SD2U(DECBUFFER+9)];// local buffer in case need temporary
+ // [+9 allows for ln() constants]
+ Unit *allocres=NULL; // -> allocated result, iff allocated
+ Int d=0; // count of digits found in decimal part
+ const char *dotchar=NULL; // where dot was found
+ const char *cfirst=chars; // -> first character of decimal part
+ const char *last=NULL; // -> last digit of decimal part
+ const char *c; // work
+ Unit *up; // ..
+ #if DECDPUN>1
+ Int cut, out; // ..
+ #endif
+ Int residue; // rounding residue
+ uInt status=0; // error code
+
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, DECUNUSED, DECUNUSED, set))
+ return decNumberZero(dn);
+ #endif
+
+ do { // status & malloc protection
+ for (c=chars;; c++) { // -> input character
+ if (*c>='0' && *c<='9') { // test for Arabic digit
+ last=c;
+ d++; // count of real digits
+ continue; // still in decimal part
+ }
+ if (*c=='.' && dotchar==NULL) { // first '.'
+ dotchar=c; // record offset into decimal part
+ if (c==cfirst) cfirst++; // first digit must follow
+ continue;}
+ if (c==chars) { // first in string...
+ if (*c=='-') { // valid - sign
+ cfirst++;
+ bits=DECNEG;
+ continue;}
+ if (*c=='+') { // valid + sign
+ cfirst++;
+ continue;}
+ }
+ // *c is not a digit, or a valid +, -, or '.'
+ break;
+ } // c
+
+ if (last==NULL) { // no digits yet
+ status=DEC_Conversion_syntax;// assume the worst
+ if (*c=='\0') break; // and no more to come...
+ #if DECSUBSET
+ // if subset then infinities and NaNs are not allowed
+ if (!set->extended) break; // hopeless
+ #endif
+ // Infinities and NaNs are possible, here
+ if (dotchar!=NULL) break; // .. unless had a dot
+ decNumberZero(dn); // be optimistic
+ if (decBiStr(c, "infinity", "INFINITY")
+ || decBiStr(c, "inf", "INF")) {
+ dn->bits=bits | DECINF;
+ status=0; // is OK
+ break; // all done
+ }
+ // a NaN expected
+ // 2003.09.10 NaNs are now permitted to have a sign
+ dn->bits=bits | DECNAN; // assume simple NaN
+ if (*c=='s' || *c=='S') { // looks like an sNaN
+ c++;
+ dn->bits=bits | DECSNAN;
+ }
+ if (*c!='n' && *c!='N') break; // check caseless "NaN"
+ c++;
+ if (*c!='a' && *c!='A') break; // ..
+ c++;
+ if (*c!='n' && *c!='N') break; // ..
+ c++;
+ // now either nothing, or nnnn payload, expected
+ // -> start of integer and skip leading 0s [including plain 0]
+ for (cfirst=c; *cfirst=='0';) cfirst++;
+ if (*cfirst=='\0') { // "NaN" or "sNaN", maybe with all 0s
+ status=0; // it's good
+ break; // ..
+ }
+ // something other than 0s; setup last and d as usual [no dots]
+ for (c=cfirst;; c++, d++) {
+ if (*c<'0' || *c>'9') break; // test for Arabic digit
+ last=c;
+ }
+ if (*c!='\0') break; // not all digits
+ if (d>set->digits-1) {
+ // [NB: payload in a decNumber can be full length unless
+ // clamped, in which case can only be digits-1]
+ if (set->clamp) break;
+ if (d>set->digits) break;
+ } // too many digits?
+ // good; drop through to convert the integer to coefficient
+ status=0; // syntax is OK
+ bits=dn->bits; // for copy-back
+ } // last==NULL
+
+ else if (*c!='\0') { // more to process...
+ // had some digits; exponent is only valid sequence now
+ Flag nege; // 1=negative exponent
+ const char *firstexp; // -> first significant exponent digit
+ status=DEC_Conversion_syntax;// assume the worst
+ if (*c!='e' && *c!='E') break;
+ /* Found 'e' or 'E' -- now process explicit exponent */
+ // 1998.07.11: sign no longer required
+ nege=0;
+ c++; // to (possible) sign
+ if (*c=='-') {nege=1; c++;}
+ else if (*c=='+') c++;
+ if (*c=='\0') break;
+
+ for (; *c=='0' && *(c+1)!='\0';) c++; // strip insignificant zeros
+ firstexp=c; // save exponent digit place
+ for (; ;c++) {
+ if (*c<'0' || *c>'9') break; // not a digit
+ exponent=X10(exponent)+(Int)*c-(Int)'0';
+ } // c
+ // if not now on a '\0', *c must not be a digit
+ if (*c!='\0') break;
+
+ // (this next test must be after the syntax checks)
+ // if it was too long the exponent may have wrapped, so check
+ // carefully and set it to a certain overflow if wrap possible
+ if (c>=firstexp+9+1) {
+ if (c>firstexp+9+1 || *firstexp>'1') exponent=DECNUMMAXE*2;
+ // [up to 1999999999 is OK, for example 1E-1000000998]
+ }
+ if (nege) exponent=-exponent; // was negative
+ status=0; // is OK
+ } // stuff after digits
+
+ // Here when whole string has been inspected; syntax is good
+ // cfirst->first digit (never dot), last->last digit (ditto)
+
+ // strip leading zeros/dot [leave final 0 if all 0's]
+ if (*cfirst=='0') { // [cfirst has stepped over .]
+ for (c=cfirst; c<last; c++, cfirst++) {
+ if (*c=='.') continue; // ignore dots
+ if (*c!='0') break; // non-zero found
+ d--; // 0 stripped
+ } // c
+ #if DECSUBSET
+ // make a rapid exit for easy zeros if !extended
+ if (*cfirst=='0' && !set->extended) {
+ decNumberZero(dn); // clean result
+ break; // [could be return]
+ }
+ #endif
+ } // at least one leading 0
+
+ // Handle decimal point...
+ if (dotchar!=NULL && dotchar<last) // non-trailing '.' found?
+ exponent-=(last-dotchar); // adjust exponent
+ // [we can now ignore the .]
+
+ // OK, the digits string is good. Assemble in the decNumber, or in
+ // a temporary units array if rounding is needed
+ if (d<=set->digits) res=dn->lsu; // fits into supplied decNumber
+ else { // rounding needed
+ Int needbytes=D2U(d)*sizeof(Unit);// bytes needed
+ res=resbuff; // assume use local buffer
+ if (needbytes>(Int)sizeof(resbuff)) { // too big for local
+ allocres=(Unit *)malloc(needbytes);
+ if (allocres==NULL) {status|=DEC_Insufficient_storage; break;}
+ res=allocres;
+ }
+ }
+ // res now -> number lsu, buffer, or allocated storage for Unit array
+
+ // Place the coefficient into the selected Unit array
+ // [this is often 70% of the cost of this function when DECDPUN>1]
+ #if DECDPUN>1
+ out=0; // accumulator
+ up=res+D2U(d)-1; // -> msu
+ cut=d-(up-res)*DECDPUN; // digits in top unit
+ for (c=cfirst;; c++) { // along the digits
+ if (*c=='.') continue; // ignore '.' [don't decrement cut]
+ out=X10(out)+(Int)*c-(Int)'0';
+ if (c==last) break; // done [never get to trailing '.']
+ cut--;
+ if (cut>0) continue; // more for this unit
+ *up=(Unit)out; // write unit
+ up--; // prepare for unit below..
+ cut=DECDPUN; // ..
+ out=0; // ..
+ } // c
+ *up=(Unit)out; // write lsu
+
+ #else
+ // DECDPUN==1
+ up=res; // -> lsu
+ for (c=last; c>=cfirst; c--) { // over each character, from least
+ if (*c=='.') continue; // ignore . [don't step up]
+ *up=(Unit)((Int)*c-(Int)'0');
+ up++;
+ } // c
+ #endif
+
+ dn->bits=bits;
+ dn->exponent=exponent;
+ dn->digits=d;
+
+ // if not in number (too long) shorten into the number
+ if (d>set->digits) {
+ residue=0;
+ decSetCoeff(dn, set, res, d, &residue, &status);
+ // always check for overflow or subnormal and round as needed
+ decFinalize(dn, set, &residue, &status);
+ }
+ else { // no rounding, but may still have overflow or subnormal
+ // [these tests are just for performance; finalize repeats them]
+ if ((dn->exponent-1<set->emin-dn->digits)
+ || (dn->exponent-1>set->emax-set->digits)) {
+ residue=0;
+ decFinalize(dn, set, &residue, &status);
+ }
+ }
+ // decNumberShow(dn);
+ } while(0); // [for break]
+
+ if (allocres!=NULL) free(allocres); // drop any storage used
+ if (status!=0) decStatus(dn, status, set);
+ return dn;
+ } /* decNumberFromString */
+
+/* ================================================================== */
+/* Operators */
+/* ================================================================== */
+
+/* ------------------------------------------------------------------ */
+/* decNumberAbs -- absolute value operator */
+/* */
+/* This computes C = abs(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context */
+/* */
+/* See also decNumberCopyAbs for a quiet bitwise version of this. */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+/* This has the same effect as decNumberPlus unless A is negative, */
+/* in which case it has the same effect as decNumberMinus. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberAbs(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decNumber dzero; // for 0
+ uInt status=0; // accumulator
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ decNumberZero(&dzero); // set 0
+ dzero.exponent=rhs->exponent; // [no coefficient expansion]
+ decAddOp(res, &dzero, rhs, set, (uByte)(rhs->bits & DECNEG), &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberAbs
+
+/* ------------------------------------------------------------------ */
+/* decNumberAdd -- add two Numbers */
+/* */
+/* This computes C = A + B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X+X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+/* This just calls the routine shared with Subtract */
+decNumber * decNumberAdd(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decAddOp(res, lhs, rhs, set, 0, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberAdd
+
+/* ------------------------------------------------------------------ */
+/* decNumberAnd -- AND two Numbers, digitwise */
+/* */
+/* This computes C = A & B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X&X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context (used for result length and error report) */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Logical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberAnd(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ const Unit *ua, *ub; // -> operands
+ const Unit *msua, *msub; // -> operand msus
+ Unit *uc, *msuc; // -> result and its msu
+ Int msudigs; // digits in res msu
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ if (lhs->exponent!=0 || decNumberIsSpecial(lhs) || decNumberIsNegative(lhs)
+ || rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+
+ // operands are valid
+ ua=lhs->lsu; // bottom-up
+ ub=rhs->lsu; // ..
+ uc=res->lsu; // ..
+ msua=ua+D2U(lhs->digits)-1; // -> msu of lhs
+ msub=ub+D2U(rhs->digits)-1; // -> msu of rhs
+ msuc=uc+D2U(set->digits)-1; // -> msu of result
+ msudigs=MSUDIGITS(set->digits); // [faster than remainder]
+ for (; uc<=msuc; ua++, ub++, uc++) { // Unit loop
+ Unit a, b; // extract units
+ if (ua>msua) a=0;
+ else a=*ua;
+ if (ub>msub) b=0;
+ else b=*ub;
+ *uc=0; // can now write back
+ if (a|b) { // maybe 1 bits to examine
+ Int i, j;
+ *uc=0; // can now write back
+ // This loop could be unrolled and/or use BIN2BCD tables
+ for (i=0; i<DECDPUN; i++) {
+ if (a&b&1) *uc=*uc+(Unit)powers[i]; // effect AND
+ j=a%10;
+ a=a/10;
+ j|=b%10;
+ b=b/10;
+ if (j>1) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ if (uc==msuc && i==msudigs-1) break; // just did final digit
+ } // each digit
+ } // both OK
+ } // each unit
+ // [here uc-1 is the msu of the result]
+ res->digits=decGetDigits(res->lsu, uc-res->lsu);
+ res->exponent=0; // integer
+ res->bits=0; // sign=0
+ return res; // [no status to set]
+ } // decNumberAnd
+
+/* ------------------------------------------------------------------ */
+/* decNumberCompare -- compare two Numbers */
+/* */
+/* This computes C = A ? B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for one digit (or NaN). */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCompare(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPARE, &status);
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberCompare
+
+/* ------------------------------------------------------------------ */
+/* decNumberCompareSignal -- compare, signalling on all NaNs */
+/* */
+/* This computes C = A ? B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for one digit (or NaN). */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCompareSignal(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPSIG, &status);
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberCompareSignal
+
+/* ------------------------------------------------------------------ */
+/* decNumberCompareTotal -- compare two Numbers, using total ordering */
+/* */
+/* This computes C = A ? B, under total ordering */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for one digit; the result will always be one of */
+/* -1, 0, or 1. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCompareTotal(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPTOTAL, &status);
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberCompareTotal
+
+/* ------------------------------------------------------------------ */
+/* decNumberCompareTotalMag -- compare, total ordering of magnitudes */
+/* */
+/* This computes C = |A| ? |B|, under total ordering */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for one digit; the result will always be one of */
+/* -1, 0, or 1. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCompareTotalMag(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ uInt needbytes; // for space calculations
+ decNumber bufa[D2N(DECBUFFER+1)];// +1 in case DECBUFFER=0
+ decNumber *allocbufa=NULL; // -> allocated bufa, iff allocated
+ decNumber bufb[D2N(DECBUFFER+1)];
+ decNumber *allocbufb=NULL; // -> allocated bufb, iff allocated
+ decNumber *a, *b; // temporary pointers
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ // if either is negative, take a copy and absolute
+ if (decNumberIsNegative(lhs)) { // lhs<0
+ a=bufa;
+ needbytes=sizeof(decNumber)+(D2U(lhs->digits)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufa)) { // need malloc space
+ allocbufa=(decNumber *)malloc(needbytes);
+ if (allocbufa==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ a=allocbufa; // use the allocated space
+ }
+ decNumberCopy(a, lhs); // copy content
+ a->bits&=~DECNEG; // .. and clear the sign
+ lhs=a; // use copy from here on
+ }
+ if (decNumberIsNegative(rhs)) { // rhs<0
+ b=bufb;
+ needbytes=sizeof(decNumber)+(D2U(rhs->digits)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufb)) { // need malloc space
+ allocbufb=(decNumber *)malloc(needbytes);
+ if (allocbufb==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ b=allocbufb; // use the allocated space
+ }
+ decNumberCopy(b, rhs); // copy content
+ b->bits&=~DECNEG; // .. and clear the sign
+ rhs=b; // use copy from here on
+ }
+ decCompareOp(res, lhs, rhs, set, COMPTOTAL, &status);
+ } while(0); // end protected
+
+ if (allocbufa!=NULL) free(allocbufa); // drop any storage used
+ if (allocbufb!=NULL) free(allocbufb); // ..
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberCompareTotalMag
+
+/* ------------------------------------------------------------------ */
+/* decNumberDivide -- divide one number by another */
+/* */
+/* This computes C = A / B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X/X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberDivide(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decDivideOp(res, lhs, rhs, set, DIVIDE, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberDivide
+
+/* ------------------------------------------------------------------ */
+/* decNumberDivideInteger -- divide and return integer quotient */
+/* */
+/* This computes C = A # B, where # is the integer divide operator */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X#X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberDivideInteger(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decDivideOp(res, lhs, rhs, set, DIVIDEINT, &status);
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberDivideInteger
+
+/* ------------------------------------------------------------------ */
+/* decNumberExp -- exponentiation */
+/* */
+/* This computes C = exp(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context; note that rounding mode has no effect */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Mathematical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* */
+/* Finite results will always be full precision and Inexact, except */
+/* when A is a zero or -Infinity (giving 1 or 0 respectively). */
+/* */
+/* An Inexact result is rounded using DEC_ROUND_HALF_EVEN; it will */
+/* almost always be correctly rounded, but may be up to 1 ulp in */
+/* error in rare cases. */
+/* ------------------------------------------------------------------ */
+/* This is a wrapper for decExpOp which can handle the slightly wider */
+/* (double) range needed by Ln (which has to be able to calculate */
+/* exp(-a) where a can be the tiniest number (Ntiny). */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberExp(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ uInt status=0; // accumulator
+ #if DECSUBSET
+ decNumber *allocrhs=NULL; // non-NULL if rounded rhs allocated
+ #endif
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // Check restrictions; these restrictions ensure that if h=8 (see
+ // decExpOp) then the result will either overflow or underflow to 0.
+ // Other math functions restrict the input range, too, for inverses.
+ // If not violated then carry out the operation.
+ if (!decCheckMath(rhs, set, &status)) do { // protect allocation
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operand and set lostDigits status, as needed
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, &status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ decExpOp(res, rhs, set, &status);
+ } while(0); // end protected
+
+ #if DECSUBSET
+ if (allocrhs !=NULL) free(allocrhs); // drop any storage used
+ #endif
+ // apply significant status
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberExp
+
+/* ------------------------------------------------------------------ */
+/* decNumberFMA -- fused multiply add */
+/* */
+/* This computes D = (A * B) + C with only one rounding */
+/* */
+/* res is D, the result. D may be A or B or C (e.g., X=FMA(X,X,X)) */
+/* lhs is A */
+/* rhs is B */
+/* fhs is C [far hand side] */
+/* set is the context */
+/* */
+/* Mathematical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberFMA(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, const decNumber *fhs,
+ decContext *set) {
+ uInt status=0; // accumulator
+ decContext dcmul; // context for the multiplication
+ uInt needbytes; // for space calculations
+ decNumber bufa[D2N(DECBUFFER*2+1)];
+ decNumber *allocbufa=NULL; // -> allocated bufa, iff allocated
+ decNumber *acc; // accumulator pointer
+ decNumber dzero; // work
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ if (decCheckOperands(res, fhs, DECUNUSED, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) { // [undefined if subset]
+ status|=DEC_Invalid_operation;
+ break;}
+ #endif
+ // Check math restrictions [these ensure no overflow or underflow]
+ if ((!decNumberIsSpecial(lhs) && decCheckMath(lhs, set, &status))
+ || (!decNumberIsSpecial(rhs) && decCheckMath(rhs, set, &status))
+ || (!decNumberIsSpecial(fhs) && decCheckMath(fhs, set, &status))) break;
+ // set up context for multiply
+ dcmul=*set;
+ dcmul.digits=lhs->digits+rhs->digits; // just enough
+ // [The above may be an over-estimate for subset arithmetic, but that's OK]
+ dcmul.emax=DEC_MAX_EMAX; // effectively unbounded ..
+ dcmul.emin=DEC_MIN_EMIN; // [thanks to Math restrictions]
+ // set up decNumber space to receive the result of the multiply
+ acc=bufa; // may fit
+ needbytes=sizeof(decNumber)+(D2U(dcmul.digits)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufa)) { // need malloc space
+ allocbufa=(decNumber *)malloc(needbytes);
+ if (allocbufa==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ acc=allocbufa; // use the allocated space
+ }
+ // multiply with extended range and necessary precision
+ //printf("emin=%ld\n", dcmul.emin);
+ decMultiplyOp(acc, lhs, rhs, &dcmul, &status);
+ // Only Invalid operation (from sNaN or Inf * 0) is possible in
+ // status; if either is seen than ignore fhs (in case it is
+ // another sNaN) and set acc to NaN unless we had an sNaN
+ // [decMultiplyOp leaves that to caller]
+ // Note sNaN has to go through addOp to shorten payload if
+ // necessary
+ if ((status&DEC_Invalid_operation)!=0) {
+ if (!(status&DEC_sNaN)) { // but be true invalid
+ decNumberZero(res); // acc not yet set
+ res->bits=DECNAN;
+ break;
+ }
+ decNumberZero(&dzero); // make 0 (any non-NaN would do)
+ fhs=&dzero; // use that
+ }
+ #if DECCHECK
+ else { // multiply was OK
+ if (status!=0) printf("Status=%08lx after FMA multiply\n", (LI)status);
+ }
+ #endif
+ // add the third operand and result -> res, and all is done
+ decAddOp(res, acc, fhs, set, 0, &status);
+ } while(0); // end protected
+
+ if (allocbufa!=NULL) free(allocbufa); // drop any storage used
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberFMA
+
+/* ------------------------------------------------------------------ */
+/* decNumberInvert -- invert a Number, digitwise */
+/* */
+/* This computes C = ~A */
+/* */
+/* res is C, the result. C may be A (e.g., X=~X) */
+/* rhs is A */
+/* set is the context (used for result length and error report) */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Logical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberInvert(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ const Unit *ua, *msua; // -> operand and its msu
+ Unit *uc, *msuc; // -> result and its msu
+ Int msudigs; // digits in res msu
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ if (rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ // operand is valid
+ ua=rhs->lsu; // bottom-up
+ uc=res->lsu; // ..
+ msua=ua+D2U(rhs->digits)-1; // -> msu of rhs
+ msuc=uc+D2U(set->digits)-1; // -> msu of result
+ msudigs=MSUDIGITS(set->digits); // [faster than remainder]
+ for (; uc<=msuc; ua++, uc++) { // Unit loop
+ Unit a; // extract unit
+ Int i, j; // work
+ if (ua>msua) a=0;
+ else a=*ua;
+ *uc=0; // can now write back
+ // always need to examine all bits in rhs
+ // This loop could be unrolled and/or use BIN2BCD tables
+ for (i=0; i<DECDPUN; i++) {
+ if ((~a)&1) *uc=*uc+(Unit)powers[i]; // effect INVERT
+ j=a%10;
+ a=a/10;
+ if (j>1) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ if (uc==msuc && i==msudigs-1) break; // just did final digit
+ } // each digit
+ } // each unit
+ // [here uc-1 is the msu of the result]
+ res->digits=decGetDigits(res->lsu, uc-res->lsu);
+ res->exponent=0; // integer
+ res->bits=0; // sign=0
+ return res; // [no status to set]
+ } // decNumberInvert
+
+/* ------------------------------------------------------------------ */
+/* decNumberLn -- natural logarithm */
+/* */
+/* This computes C = ln(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context; note that rounding mode has no effect */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Notable cases: */
+/* A<0 -> Invalid */
+/* A=0 -> -Infinity (Exact) */
+/* A=+Infinity -> +Infinity (Exact) */
+/* A=1 exactly -> 0 (Exact) */
+/* */
+/* Mathematical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* */
+/* An Inexact result is rounded using DEC_ROUND_HALF_EVEN; it will */
+/* almost always be correctly rounded, but may be up to 1 ulp in */
+/* error in rare cases. */
+/* ------------------------------------------------------------------ */
+/* This is a wrapper for decLnOp which can handle the slightly wider */
+/* (+11) range needed by Ln, Log10, etc. (which may have to be able */
+/* to calculate at p+e+2). */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberLn(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ uInt status=0; // accumulator
+ #if DECSUBSET
+ decNumber *allocrhs=NULL; // non-NULL if rounded rhs allocated
+ #endif
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // Check restrictions; this is a math function; if not violated
+ // then carry out the operation.
+ if (!decCheckMath(rhs, set, &status)) do { // protect allocation
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operand and set lostDigits status, as needed
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, &status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ // special check in subset for rhs=0
+ if (ISZERO(rhs)) { // +/- zeros -> error
+ status|=DEC_Invalid_operation;
+ break;}
+ } // extended=0
+ #endif
+ decLnOp(res, rhs, set, &status);
+ } while(0); // end protected
+
+ #if DECSUBSET
+ if (allocrhs !=NULL) free(allocrhs); // drop any storage used
+ #endif
+ // apply significant status
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberLn
+
+/* ------------------------------------------------------------------ */
+/* decNumberLogB - get adjusted exponent, by 754 rules */
+/* */
+/* This computes C = adjustedexponent(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context, used only for digits and status */
+/* */
+/* For an unrounded result, digits may need to be 10 (A might have */
+/* 10**9 digits and an exponent of +999999999, or one digit and an */
+/* exponent of -1999999999). */
+/* */
+/* This returns the adjusted exponent of A after (in theory) padding */
+/* with zeros on the right to set->digits digits while keeping the */
+/* same value. The exponent is not limited by emin/emax. */
+/* */
+/* Notable cases: */
+/* A<0 -> Use |A| */
+/* A=0 -> -Infinity (Division by zero) */
+/* A=Infinite -> +Infinity (Exact) */
+/* A=1 exactly -> 0 (Exact) */
+/* NaNs are propagated as usual */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberLogB(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ uInt status=0; // accumulator
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // NaNs as usual; Infinities return +Infinity; 0->oops
+ if (decNumberIsNaN(rhs)) decNaNs(res, rhs, NULL, set, &status);
+ else if (decNumberIsInfinite(rhs)) decNumberCopyAbs(res, rhs);
+ else if (decNumberIsZero(rhs)) {
+ decNumberZero(res); // prepare for Infinity
+ res->bits=DECNEG|DECINF; // -Infinity
+ status|=DEC_Division_by_zero; // as per 754
+ }
+ else { // finite non-zero
+ Int ae=rhs->exponent+rhs->digits-1; // adjusted exponent
+ if (set->digits>=10) decNumberFromInt32(res, ae); // lay it out
+ else {
+ decNumber buft[D2N(10)]; // temporary number
+ decNumber *t=buft; // ..
+ decNumberFromInt32(t, ae); // lay it out
+ decNumberPlus(res, t, set); // round as necessary
+ }
+ }
+
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberLogB
+
+/* ------------------------------------------------------------------ */
+/* decNumberLog10 -- logarithm in base 10 */
+/* */
+/* This computes C = log10(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context; note that rounding mode has no effect */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Notable cases: */
+/* A<0 -> Invalid */
+/* A=0 -> -Infinity (Exact) */
+/* A=+Infinity -> +Infinity (Exact) */
+/* A=10**n (if n is an integer) -> n (Exact) */
+/* */
+/* Mathematical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* */
+/* An Inexact result is rounded using DEC_ROUND_HALF_EVEN; it will */
+/* almost always be correctly rounded, but may be up to 1 ulp in */
+/* error in rare cases. */
+/* ------------------------------------------------------------------ */
+/* This calculates ln(A)/ln(10) using appropriate precision. For */
+/* ln(A) this is the max(p, rhs->digits + t) + 3, where p is the */
+/* requested digits and t is the number of digits in the exponent */
+/* (maximum 6). For ln(10) it is p + 3; this is often handled by the */
+/* fastpath in decLnOp. The final division is done to the requested */
+/* precision. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberLog10(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ uInt status=0, ignore=0; // status accumulators
+ uInt needbytes; // for space calculations
+ Int p; // working precision
+ Int t; // digits in exponent of A
+
+ // buffers for a and b working decimals
+ // (adjustment calculator, same size)
+ decNumber bufa[D2N(DECBUFFER+2)];
+ decNumber *allocbufa=NULL; // -> allocated bufa, iff allocated
+ decNumber *a=bufa; // temporary a
+ decNumber bufb[D2N(DECBUFFER+2)];
+ decNumber *allocbufb=NULL; // -> allocated bufb, iff allocated
+ decNumber *b=bufb; // temporary b
+ decNumber bufw[D2N(10)]; // working 2-10 digit number
+ decNumber *w=bufw; // ..
+ #if DECSUBSET
+ decNumber *allocrhs=NULL; // non-NULL if rounded rhs allocated
+ #endif
+
+ decContext aset; // working context
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // Check restrictions; this is a math function; if not violated
+ // then carry out the operation.
+ if (!decCheckMath(rhs, set, &status)) do { // protect malloc
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operand and set lostDigits status, as needed
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, &status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ // special check in subset for rhs=0
+ if (ISZERO(rhs)) { // +/- zeros -> error
+ status|=DEC_Invalid_operation;
+ break;}
+ } // extended=0
+ #endif
+
+ decContextDefault(&aset, DEC_INIT_DECIMAL64); // clean context
+
+ // handle exact powers of 10; only check if +ve finite
+ if (!(rhs->bits&(DECNEG|DECSPECIAL)) && !ISZERO(rhs)) {
+ Int residue=0; // (no residue)
+ uInt copystat=0; // clean status
+
+ // round to a single digit...
+ aset.digits=1;
+ decCopyFit(w, rhs, &aset, &residue, &copystat); // copy & shorten
+ // if exact and the digit is 1, rhs is a power of 10
+ if (!(copystat&DEC_Inexact) && w->lsu[0]==1) {
+ // the exponent, conveniently, is the power of 10; making
+ // this the result needs a little care as it might not fit,
+ // so first convert it into the working number, and then move
+ // to res
+ decNumberFromInt32(w, w->exponent);
+ residue=0;
+ decCopyFit(res, w, set, &residue, &status); // copy & round
+ decFinish(res, set, &residue, &status); // cleanup/set flags
+ break;
+ } // not a power of 10
+ } // not a candidate for exact
+
+ // simplify the information-content calculation to use 'total
+ // number of digits in a, including exponent' as compared to the
+ // requested digits, as increasing this will only rarely cost an
+ // iteration in ln(a) anyway
+ t=6; // it can never be >6
+
+ // allocate space when needed...
+ p=(rhs->digits+t>set->digits?rhs->digits+t:set->digits)+3;
+ needbytes=sizeof(decNumber)+(D2U(p)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufa)) { // need malloc space
+ allocbufa=(decNumber *)malloc(needbytes);
+ if (allocbufa==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ a=allocbufa; // use the allocated space
+ }
+ aset.digits=p; // as calculated
+ aset.emax=DEC_MAX_MATH; // usual bounds
+ aset.emin=-DEC_MAX_MATH; // ..
+ aset.clamp=0; // and no concrete format
+ decLnOp(a, rhs, &aset, &status); // a=ln(rhs)
+
+ // skip the division if the result so far is infinite, NaN, or
+ // zero, or there was an error; note NaN from sNaN needs copy
+ if (status&DEC_NaNs && !(status&DEC_sNaN)) break;
+ if (a->bits&DECSPECIAL || ISZERO(a)) {
+ decNumberCopy(res, a); // [will fit]
+ break;}
+
+ // for ln(10) an extra 3 digits of precision are needed
+ p=set->digits+3;
+ needbytes=sizeof(decNumber)+(D2U(p)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufb)) { // need malloc space
+ allocbufb=(decNumber *)malloc(needbytes);
+ if (allocbufb==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ b=allocbufb; // use the allocated space
+ }
+ decNumberZero(w); // set up 10...
+ #if DECDPUN==1
+ w->lsu[1]=1; w->lsu[0]=0; // ..
+ #else
+ w->lsu[0]=10; // ..
+ #endif
+ w->digits=2; // ..
+
+ aset.digits=p;
+ decLnOp(b, w, &aset, &ignore); // b=ln(10)
+
+ aset.digits=set->digits; // for final divide
+ decDivideOp(res, a, b, &aset, DIVIDE, &status); // into result
+ } while(0); // [for break]
+
+ if (allocbufa!=NULL) free(allocbufa); // drop any storage used
+ if (allocbufb!=NULL) free(allocbufb); // ..
+ #if DECSUBSET
+ if (allocrhs !=NULL) free(allocrhs); // ..
+ #endif
+ // apply significant status
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberLog10
+
+/* ------------------------------------------------------------------ */
+/* decNumberMax -- compare two Numbers and return the maximum */
+/* */
+/* This computes C = A ? B, returning the maximum by 754 rules */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberMax(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPMAX, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberMax
+
+/* ------------------------------------------------------------------ */
+/* decNumberMaxMag -- compare and return the maximum by magnitude */
+/* */
+/* This computes C = A ? B, returning the maximum by 754 rules */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberMaxMag(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPMAXMAG, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberMaxMag
+
+/* ------------------------------------------------------------------ */
+/* decNumberMin -- compare two Numbers and return the minimum */
+/* */
+/* This computes C = A ? B, returning the minimum by 754 rules */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberMin(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPMIN, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberMin
+
+/* ------------------------------------------------------------------ */
+/* decNumberMinMag -- compare and return the minimum by magnitude */
+/* */
+/* This computes C = A ? B, returning the minimum by 754 rules */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberMinMag(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decCompareOp(res, lhs, rhs, set, COMPMINMAG, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberMinMag
+
+/* ------------------------------------------------------------------ */
+/* decNumberMinus -- prefix minus operator */
+/* */
+/* This computes C = 0 - A */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context */
+/* */
+/* See also decNumberCopyNegate for a quiet bitwise version of this. */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+/* Simply use AddOp for the subtract, which will do the necessary. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberMinus(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decNumber dzero;
+ uInt status=0; // accumulator
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ decNumberZero(&dzero); // make 0
+ dzero.exponent=rhs->exponent; // [no coefficient expansion]
+ decAddOp(res, &dzero, rhs, set, DECNEG, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberMinus
+
+/* ------------------------------------------------------------------ */
+/* decNumberNextMinus -- next towards -Infinity */
+/* */
+/* This computes C = A - infinitesimal, rounded towards -Infinity */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context */
+/* */
+/* This is a generalization of 754 NextDown. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberNextMinus(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decNumber dtiny; // constant
+ decContext workset=*set; // work
+ uInt status=0; // accumulator
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // +Infinity is the special case
+ if ((rhs->bits&(DECINF|DECNEG))==DECINF) {
+ decSetMaxValue(res, set); // is +ve
+ // there is no status to set
+ return res;
+ }
+ decNumberZero(&dtiny); // start with 0
+ dtiny.lsu[0]=1; // make number that is ..
+ dtiny.exponent=DEC_MIN_EMIN-1; // .. smaller than tiniest
+ workset.round=DEC_ROUND_FLOOR;
+ decAddOp(res, rhs, &dtiny, &workset, DECNEG, &status);
+ status&=DEC_Invalid_operation|DEC_sNaN; // only sNaN Invalid please
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberNextMinus
+
+/* ------------------------------------------------------------------ */
+/* decNumberNextPlus -- next towards +Infinity */
+/* */
+/* This computes C = A + infinitesimal, rounded towards +Infinity */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context */
+/* */
+/* This is a generalization of 754 NextUp. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberNextPlus(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decNumber dtiny; // constant
+ decContext workset=*set; // work
+ uInt status=0; // accumulator
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // -Infinity is the special case
+ if ((rhs->bits&(DECINF|DECNEG))==(DECINF|DECNEG)) {
+ decSetMaxValue(res, set);
+ res->bits=DECNEG; // negative
+ // there is no status to set
+ return res;
+ }
+ decNumberZero(&dtiny); // start with 0
+ dtiny.lsu[0]=1; // make number that is ..
+ dtiny.exponent=DEC_MIN_EMIN-1; // .. smaller than tiniest
+ workset.round=DEC_ROUND_CEILING;
+ decAddOp(res, rhs, &dtiny, &workset, 0, &status);
+ status&=DEC_Invalid_operation|DEC_sNaN; // only sNaN Invalid please
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberNextPlus
+
+/* ------------------------------------------------------------------ */
+/* decNumberNextToward -- next towards rhs */
+/* */
+/* This computes C = A +/- infinitesimal, rounded towards */
+/* +/-Infinity in the direction of B, as per 754-1985 nextafter */
+/* modified during revision but dropped from 754-2008. */
+/* */
+/* res is C, the result. C may be A or B. */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* This is a generalization of 754-1985 NextAfter. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberNextToward(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ decNumber dtiny; // constant
+ decContext workset=*set; // work
+ Int result; // ..
+ uInt status=0; // accumulator
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs)) {
+ decNaNs(res, lhs, rhs, set, &status);
+ }
+ else { // Is numeric, so no chance of sNaN Invalid, etc.
+ result=decCompare(lhs, rhs, 0); // sign matters
+ if (result==BADINT) status|=DEC_Insufficient_storage; // rare
+ else { // valid compare
+ if (result==0) decNumberCopySign(res, lhs, rhs); // easy
+ else { // differ: need NextPlus or NextMinus
+ uByte sub; // add or subtract
+ if (result<0) { // lhs<rhs, do nextplus
+ // -Infinity is the special case
+ if ((lhs->bits&(DECINF|DECNEG))==(DECINF|DECNEG)) {
+ decSetMaxValue(res, set);
+ res->bits=DECNEG; // negative
+ return res; // there is no status to set
+ }
+ workset.round=DEC_ROUND_CEILING;
+ sub=0; // add, please
+ } // plus
+ else { // lhs>rhs, do nextminus
+ // +Infinity is the special case
+ if ((lhs->bits&(DECINF|DECNEG))==DECINF) {
+ decSetMaxValue(res, set);
+ return res; // there is no status to set
+ }
+ workset.round=DEC_ROUND_FLOOR;
+ sub=DECNEG; // subtract, please
+ } // minus
+ decNumberZero(&dtiny); // start with 0
+ dtiny.lsu[0]=1; // make number that is ..
+ dtiny.exponent=DEC_MIN_EMIN-1; // .. smaller than tiniest
+ decAddOp(res, lhs, &dtiny, &workset, sub, &status); // + or -
+ // turn off exceptions if the result is a normal number
+ // (including Nmin), otherwise let all status through
+ if (decNumberIsNormal(res, set)) status=0;
+ } // unequal
+ } // compare OK
+ } // numeric
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberNextToward
+
+/* ------------------------------------------------------------------ */
+/* decNumberOr -- OR two Numbers, digitwise */
+/* */
+/* This computes C = A | B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X|X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context (used for result length and error report) */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Logical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberOr(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ const Unit *ua, *ub; // -> operands
+ const Unit *msua, *msub; // -> operand msus
+ Unit *uc, *msuc; // -> result and its msu
+ Int msudigs; // digits in res msu
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ if (lhs->exponent!=0 || decNumberIsSpecial(lhs) || decNumberIsNegative(lhs)
+ || rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ // operands are valid
+ ua=lhs->lsu; // bottom-up
+ ub=rhs->lsu; // ..
+ uc=res->lsu; // ..
+ msua=ua+D2U(lhs->digits)-1; // -> msu of lhs
+ msub=ub+D2U(rhs->digits)-1; // -> msu of rhs
+ msuc=uc+D2U(set->digits)-1; // -> msu of result
+ msudigs=MSUDIGITS(set->digits); // [faster than remainder]
+ for (; uc<=msuc; ua++, ub++, uc++) { // Unit loop
+ Unit a, b; // extract units
+ if (ua>msua) a=0;
+ else a=*ua;
+ if (ub>msub) b=0;
+ else b=*ub;
+ *uc=0; // can now write back
+ if (a|b) { // maybe 1 bits to examine
+ Int i, j;
+ // This loop could be unrolled and/or use BIN2BCD tables
+ for (i=0; i<DECDPUN; i++) {
+ if ((a|b)&1) *uc=*uc+(Unit)powers[i]; // effect OR
+ j=a%10;
+ a=a/10;
+ j|=b%10;
+ b=b/10;
+ if (j>1) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ if (uc==msuc && i==msudigs-1) break; // just did final digit
+ } // each digit
+ } // non-zero
+ } // each unit
+ // [here uc-1 is the msu of the result]
+ res->digits=decGetDigits(res->lsu, uc-res->lsu);
+ res->exponent=0; // integer
+ res->bits=0; // sign=0
+ return res; // [no status to set]
+ } // decNumberOr
+
+/* ------------------------------------------------------------------ */
+/* decNumberPlus -- prefix plus operator */
+/* */
+/* This computes C = 0 + A */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context */
+/* */
+/* See also decNumberCopy for a quiet bitwise version of this. */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+/* This simply uses AddOp; Add will take fast path after preparing A. */
+/* Performance is a concern here, as this routine is often used to */
+/* check operands and apply rounding and overflow/underflow testing. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberPlus(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decNumber dzero;
+ uInt status=0; // accumulator
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ decNumberZero(&dzero); // make 0
+ dzero.exponent=rhs->exponent; // [no coefficient expansion]
+ decAddOp(res, &dzero, rhs, set, 0, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberPlus
+
+/* ------------------------------------------------------------------ */
+/* decNumberMultiply -- multiply two Numbers */
+/* */
+/* This computes C = A x B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X+X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberMultiply(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decMultiplyOp(res, lhs, rhs, set, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberMultiply
+
+/* ------------------------------------------------------------------ */
+/* decNumberPower -- raise a number to a power */
+/* */
+/* This computes C = A ** B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X**X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Mathematical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* */
+/* However, if 1999999997<=B<=999999999 and B is an integer then the */
+/* restrictions on A and the context are relaxed to the usual bounds, */
+/* for compatibility with the earlier (integer power only) version */
+/* of this function. */
+/* */
+/* When B is an integer, the result may be exact, even if rounded. */
+/* */
+/* The final result is rounded according to the context; it will */
+/* almost always be correctly rounded, but may be up to 1 ulp in */
+/* error in rare cases. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberPower(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ #if DECSUBSET
+ decNumber *alloclhs=NULL; // non-NULL if rounded lhs allocated
+ decNumber *allocrhs=NULL; // .., rhs
+ #endif
+ decNumber *allocdac=NULL; // -> allocated acc buffer, iff used
+ decNumber *allocinv=NULL; // -> allocated 1/x buffer, iff used
+ Int reqdigits=set->digits; // requested DIGITS
+ Int n; // rhs in binary
+ Flag rhsint=0; // 1 if rhs is an integer
+ Flag useint=0; // 1 if can use integer calculation
+ Flag isoddint=0; // 1 if rhs is an integer and odd
+ Int i; // work
+ #if DECSUBSET
+ Int dropped; // ..
+ #endif
+ uInt needbytes; // buffer size needed
+ Flag seenbit; // seen a bit while powering
+ Int residue=0; // rounding residue
+ uInt status=0; // accumulators
+ uByte bits=0; // result sign if errors
+ decContext aset; // working context
+ decNumber dnOne; // work value 1...
+ // local accumulator buffer [a decNumber, with digits+elength+1 digits]
+ decNumber dacbuff[D2N(DECBUFFER+9)];
+ decNumber *dac=dacbuff; // -> result accumulator
+ // same again for possible 1/lhs calculation
+ decNumber invbuff[D2N(DECBUFFER+9)];
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) { // reduce operands and set status, as needed
+ if (lhs->digits>reqdigits) {
+ alloclhs=decRoundOperand(lhs, set, &status);
+ if (alloclhs==NULL) break;
+ lhs=alloclhs;
+ }
+ if (rhs->digits>reqdigits) {
+ allocrhs=decRoundOperand(rhs, set, &status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ // handle NaNs and rhs Infinity (lhs infinity is harder)
+ if (SPECIALARGS) {
+ if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs)) { // NaNs
+ decNaNs(res, lhs, rhs, set, &status);
+ break;}
+ if (decNumberIsInfinite(rhs)) { // rhs Infinity
+ Flag rhsneg=rhs->bits&DECNEG; // save rhs sign
+ if (decNumberIsNegative(lhs) // lhs<0
+ && !decNumberIsZero(lhs)) // ..
+ status|=DEC_Invalid_operation;
+ else { // lhs >=0
+ decNumberZero(&dnOne); // set up 1
+ dnOne.lsu[0]=1;
+ decNumberCompare(dac, lhs, &dnOne, set); // lhs ? 1
+ decNumberZero(res); // prepare for 0/1/Infinity
+ if (decNumberIsNegative(dac)) { // lhs<1
+ if (rhsneg) res->bits|=DECINF; // +Infinity [else is +0]
+ }
+ else if (dac->lsu[0]==0) { // lhs=1
+ // 1**Infinity is inexact, so return fully-padded 1.0000
+ Int shift=set->digits-1;
+ *res->lsu=1; // was 0, make int 1
+ res->digits=decShiftToMost(res->lsu, 1, shift);
+ res->exponent=-shift; // make 1.0000...
+ status|=DEC_Inexact|DEC_Rounded; // deemed inexact
+ }
+ else { // lhs>1
+ if (!rhsneg) res->bits|=DECINF; // +Infinity [else is +0]
+ }
+ } // lhs>=0
+ break;}
+ // [lhs infinity drops through]
+ } // specials
+
+ // Original rhs may be an integer that fits and is in range
+ n=decGetInt(rhs);
+ if (n!=BADINT) { // it is an integer
+ rhsint=1; // record the fact for 1**n
+ isoddint=(Flag)n&1; // [works even if big]
+ if (n!=BIGEVEN && n!=BIGODD) // can use integer path?
+ useint=1; // looks good
+ }
+
+ if (decNumberIsNegative(lhs) // -x ..
+ && isoddint) bits=DECNEG; // .. to an odd power
+
+ // handle LHS infinity
+ if (decNumberIsInfinite(lhs)) { // [NaNs already handled]
+ uByte rbits=rhs->bits; // save
+ decNumberZero(res); // prepare
+ if (n==0) *res->lsu=1; // [-]Inf**0 => 1
+ else {
+ // -Inf**nonint -> error
+ if (!rhsint && decNumberIsNegative(lhs)) {
+ status|=DEC_Invalid_operation; // -Inf**nonint is error
+ break;}
+ if (!(rbits & DECNEG)) bits|=DECINF; // was not a **-n
+ // [otherwise will be 0 or -0]
+ res->bits=bits;
+ }
+ break;}
+
+ // similarly handle LHS zero
+ if (decNumberIsZero(lhs)) {
+ if (n==0) { // 0**0 => Error
+ #if DECSUBSET
+ if (!set->extended) { // [unless subset]
+ decNumberZero(res);
+ *res->lsu=1; // return 1
+ break;}
+ #endif
+ status|=DEC_Invalid_operation;
+ }
+ else { // 0**x
+ uByte rbits=rhs->bits; // save
+ if (rbits & DECNEG) { // was a 0**(-n)
+ #if DECSUBSET
+ if (!set->extended) { // [bad if subset]
+ status|=DEC_Invalid_operation;
+ break;}
+ #endif
+ bits|=DECINF;
+ }
+ decNumberZero(res); // prepare
+ // [otherwise will be 0 or -0]
+ res->bits=bits;
+ }
+ break;}
+
+ // here both lhs and rhs are finite; rhs==0 is handled in the
+ // integer path. Next handle the non-integer cases
+ if (!useint) { // non-integral rhs
+ // any -ve lhs is bad, as is either operand or context out of
+ // bounds
+ if (decNumberIsNegative(lhs)) {
+ status|=DEC_Invalid_operation;
+ break;}
+ if (decCheckMath(lhs, set, &status)
+ || decCheckMath(rhs, set, &status)) break; // variable status
+
+ decContextDefault(&aset, DEC_INIT_DECIMAL64); // clean context
+ aset.emax=DEC_MAX_MATH; // usual bounds
+ aset.emin=-DEC_MAX_MATH; // ..
+ aset.clamp=0; // and no concrete format
+
+ // calculate the result using exp(ln(lhs)*rhs), which can
+ // all be done into the accumulator, dac. The precision needed
+ // is enough to contain the full information in the lhs (which
+ // is the total digits, including exponent), or the requested
+ // precision, if larger, + 4; 6 is used for the exponent
+ // maximum length, and this is also used when it is shorter
+ // than the requested digits as it greatly reduces the >0.5 ulp
+ // cases at little cost (because Ln doubles digits each
+ // iteration so a few extra digits rarely causes an extra
+ // iteration)
+ aset.digits=MAXI(lhs->digits, set->digits)+6+4;
+ } // non-integer rhs
+
+ else { // rhs is in-range integer
+ if (n==0) { // x**0 = 1
+ // (0**0 was handled above)
+ decNumberZero(res); // result=1
+ *res->lsu=1; // ..
+ break;}
+ // rhs is a non-zero integer
+ if (n<0) n=-n; // use abs(n)
+
+ aset=*set; // clone the context
+ aset.round=DEC_ROUND_HALF_EVEN; // internally use balanced
+ // calculate the working DIGITS
+ aset.digits=reqdigits+(rhs->digits+rhs->exponent)+2;
+ #if DECSUBSET
+ if (!set->extended) aset.digits--; // use classic precision
+ #endif
+ // it's an error if this is more than can be handled
+ if (aset.digits>DECNUMMAXP) {status|=DEC_Invalid_operation; break;}
+ } // integer path
+
+ // aset.digits is the count of digits for the accumulator needed
+ // if accumulator is too long for local storage, then allocate
+ needbytes=sizeof(decNumber)+(D2U(aset.digits)-1)*sizeof(Unit);
+ // [needbytes also used below if 1/lhs needed]
+ if (needbytes>sizeof(dacbuff)) {
+ allocdac=(decNumber *)malloc(needbytes);
+ if (allocdac==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ dac=allocdac; // use the allocated space
+ }
+ // here, aset is set up and accumulator is ready for use
+
+ if (!useint) { // non-integral rhs
+ // x ** y; special-case x=1 here as it will otherwise always
+ // reduce to integer 1; decLnOp has a fastpath which detects
+ // the case of x=1
+ decLnOp(dac, lhs, &aset, &status); // dac=ln(lhs)
+ // [no error possible, as lhs 0 already handled]
+ if (ISZERO(dac)) { // x==1, 1.0, etc.
+ // need to return fully-padded 1.0000 etc., but rhsint->1
+ *dac->lsu=1; // was 0, make int 1
+ if (!rhsint) { // add padding
+ Int shift=set->digits-1;
+ dac->digits=decShiftToMost(dac->lsu, 1, shift);
+ dac->exponent=-shift; // make 1.0000...
+ status|=DEC_Inexact|DEC_Rounded; // deemed inexact
+ }
+ }
+ else {
+ decMultiplyOp(dac, dac, rhs, &aset, &status); // dac=dac*rhs
+ decExpOp(dac, dac, &aset, &status); // dac=exp(dac)
+ }
+ // and drop through for final rounding
+ } // non-integer rhs
+
+ else { // carry on with integer
+ decNumberZero(dac); // acc=1
+ *dac->lsu=1; // ..
+
+ // if a negative power the constant 1 is needed, and if not subset
+ // invert the lhs now rather than inverting the result later
+ if (decNumberIsNegative(rhs)) { // was a **-n [hence digits>0]
+ decNumber *inv=invbuff; // asssume use fixed buffer
+ decNumberCopy(&dnOne, dac); // dnOne=1; [needed now or later]
+ #if DECSUBSET
+ if (set->extended) { // need to calculate 1/lhs
+ #endif
+ // divide lhs into 1, putting result in dac [dac=1/dac]
+ decDivideOp(dac, &dnOne, lhs, &aset, DIVIDE, &status);
+ // now locate or allocate space for the inverted lhs
+ if (needbytes>sizeof(invbuff)) {
+ allocinv=(decNumber *)malloc(needbytes);
+ if (allocinv==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ inv=allocinv; // use the allocated space
+ }
+ // [inv now points to big-enough buffer or allocated storage]
+ decNumberCopy(inv, dac); // copy the 1/lhs
+ decNumberCopy(dac, &dnOne); // restore acc=1
+ lhs=inv; // .. and go forward with new lhs
+ #if DECSUBSET
+ }
+ #endif
+ }
+
+ // Raise-to-the-power loop...
+ seenbit=0; // set once a 1-bit is encountered
+ for (i=1;;i++){ // for each bit [top bit ignored]
+ // abandon if had overflow or terminal underflow
+ if (status & (DEC_Overflow|DEC_Underflow)) { // interesting?
+ if (status&DEC_Overflow || ISZERO(dac)) break;
+ }
+ // [the following two lines revealed an optimizer bug in a C++
+ // compiler, with symptom: 5**3 -> 25, when n=n+n was used]
+ n=n<<1; // move next bit to testable position
+ if (n<0) { // top bit is set
+ seenbit=1; // OK, significant bit seen
+ decMultiplyOp(dac, dac, lhs, &aset, &status); // dac=dac*x
+ }
+ if (i==31) break; // that was the last bit
+ if (!seenbit) continue; // no need to square 1
+ decMultiplyOp(dac, dac, dac, &aset, &status); // dac=dac*dac [square]
+ } /*i*/ // 32 bits
+
+ // complete internal overflow or underflow processing
+ if (status & (DEC_Overflow|DEC_Underflow)) {
+ #if DECSUBSET
+ // If subset, and power was negative, reverse the kind of -erflow
+ // [1/x not yet done]
+ if (!set->extended && decNumberIsNegative(rhs)) {
+ if (status & DEC_Overflow)
+ status^=DEC_Overflow | DEC_Underflow | DEC_Subnormal;
+ else { // trickier -- Underflow may or may not be set
+ status&=~(DEC_Underflow | DEC_Subnormal); // [one or both]
+ status|=DEC_Overflow;
+ }
+ }
+ #endif
+ dac->bits=(dac->bits & ~DECNEG) | bits; // force correct sign
+ // round subnormals [to set.digits rather than aset.digits]
+ // or set overflow result similarly as required
+ decFinalize(dac, set, &residue, &status);
+ decNumberCopy(res, dac); // copy to result (is now OK length)
+ break;
+ }
+
+ #if DECSUBSET
+ if (!set->extended && // subset math
+ decNumberIsNegative(rhs)) { // was a **-n [hence digits>0]
+ // so divide result into 1 [dac=1/dac]
+ decDivideOp(dac, &dnOne, dac, &aset, DIVIDE, &status);
+ }
+ #endif
+ } // rhs integer path
+
+ // reduce result to the requested length and copy to result
+ decCopyFit(res, dac, set, &residue, &status);
+ decFinish(res, set, &residue, &status); // final cleanup
+ #if DECSUBSET
+ if (!set->extended) decTrim(res, set, 0, 1, &dropped); // trailing zeros
+ #endif
+ } while(0); // end protected
+
+ if (allocdac!=NULL) free(allocdac); // drop any storage used
+ if (allocinv!=NULL) free(allocinv); // ..
+ #if DECSUBSET
+ if (alloclhs!=NULL) free(alloclhs); // ..
+ if (allocrhs!=NULL) free(allocrhs); // ..
+ #endif
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberPower
+
+/* ------------------------------------------------------------------ */
+/* decNumberQuantize -- force exponent to requested value */
+/* */
+/* This computes C = op(A, B), where op adjusts the coefficient */
+/* of C (by rounding or shifting) such that the exponent (-scale) */
+/* of C has exponent of B. The numerical value of C will equal A, */
+/* except for the effects of any rounding that occurred. */
+/* */
+/* res is C, the result. C may be A or B */
+/* lhs is A, the number to adjust */
+/* rhs is B, the number with exponent to match */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Unless there is an error or the result is infinite, the exponent */
+/* after the operation is guaranteed to be equal to that of B. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberQuantize(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decQuantizeOp(res, lhs, rhs, set, 1, &status);
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberQuantize
+
+/* ------------------------------------------------------------------ */
+/* decNumberReduce -- remove trailing zeros */
+/* */
+/* This computes C = 0 + A, and normalizes the result */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+// Previously known as Normalize
+decNumber * decNumberNormalize(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ return decNumberReduce(res, rhs, set);
+ } // decNumberNormalize
+
+decNumber * decNumberReduce(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ #if DECSUBSET
+ decNumber *allocrhs=NULL; // non-NULL if rounded rhs allocated
+ #endif
+ uInt status=0; // as usual
+ Int residue=0; // as usual
+ Int dropped; // work
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operand and set lostDigits status, as needed
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, &status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ // Infinities copy through; NaNs need usual treatment
+ if (decNumberIsNaN(rhs)) {
+ decNaNs(res, rhs, NULL, set, &status);
+ break;
+ }
+
+ // reduce result to the requested length and copy to result
+ decCopyFit(res, rhs, set, &residue, &status); // copy & round
+ decFinish(res, set, &residue, &status); // cleanup/set flags
+ decTrim(res, set, 1, 0, &dropped); // normalize in place
+ // [may clamp]
+ } while(0); // end protected
+
+ #if DECSUBSET
+ if (allocrhs !=NULL) free(allocrhs); // ..
+ #endif
+ if (status!=0) decStatus(res, status, set);// then report status
+ return res;
+ } // decNumberReduce
+
+/* ------------------------------------------------------------------ */
+/* decNumberRescale -- force exponent to requested value */
+/* */
+/* This computes C = op(A, B), where op adjusts the coefficient */
+/* of C (by rounding or shifting) such that the exponent (-scale) */
+/* of C has the value B. The numerical value of C will equal A, */
+/* except for the effects of any rounding that occurred. */
+/* */
+/* res is C, the result. C may be A or B */
+/* lhs is A, the number to adjust */
+/* rhs is B, the requested exponent */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Unless there is an error or the result is infinite, the exponent */
+/* after the operation is guaranteed to be equal to B. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberRescale(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decQuantizeOp(res, lhs, rhs, set, 0, &status);
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberRescale
+
+/* ------------------------------------------------------------------ */
+/* decNumberRemainder -- divide and return remainder */
+/* */
+/* This computes C = A % B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X%X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberRemainder(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decDivideOp(res, lhs, rhs, set, REMAINDER, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberRemainder
+
+/* ------------------------------------------------------------------ */
+/* decNumberRemainderNear -- divide and return remainder from nearest */
+/* */
+/* This computes C = A % B, where % is the IEEE remainder operator */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X%X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberRemainderNear(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ decDivideOp(res, lhs, rhs, set, REMNEAR, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberRemainderNear
+
+/* ------------------------------------------------------------------ */
+/* decNumberRotate -- rotate the coefficient of a Number left/right */
+/* */
+/* This computes C = A rot B (in base ten and rotating set->digits */
+/* digits). */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=XrotX) */
+/* lhs is A */
+/* rhs is B, the number of digits to rotate (-ve to right) */
+/* set is the context */
+/* */
+/* The digits of the coefficient of A are rotated to the left (if B */
+/* is positive) or to the right (if B is negative) without adjusting */
+/* the exponent or the sign of A. If lhs->digits is less than */
+/* set->digits the coefficient is padded with zeros on the left */
+/* before the rotate. Any leading zeros in the result are removed */
+/* as usual. */
+/* */
+/* B must be an integer (q=0) and in the range -set->digits through */
+/* +set->digits. */
+/* C must have space for set->digits digits. */
+/* NaNs are propagated as usual. Infinities are unaffected (but */
+/* B must be valid). No status is set unless B is invalid or an */
+/* operand is an sNaN. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberRotate(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ Int rotate; // rhs as an Int
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ // NaNs propagate as normal
+ if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs))
+ decNaNs(res, lhs, rhs, set, &status);
+ // rhs must be an integer
+ else if (decNumberIsInfinite(rhs) || rhs->exponent!=0)
+ status=DEC_Invalid_operation;
+ else { // both numeric, rhs is an integer
+ rotate=decGetInt(rhs); // [cannot fail]
+ if (rotate==BADINT // something bad ..
+ || rotate==BIGODD || rotate==BIGEVEN // .. very big ..
+ || abs(rotate)>set->digits) // .. or out of range
+ status=DEC_Invalid_operation;
+ else { // rhs is OK
+ decNumberCopy(res, lhs);
+ // convert -ve rotate to equivalent positive rotation
+ if (rotate<0) rotate=set->digits+rotate;
+ if (rotate!=0 && rotate!=set->digits // zero or full rotation
+ && !decNumberIsInfinite(res)) { // lhs was infinite
+ // left-rotate to do; 0 < rotate < set->digits
+ uInt units, shift; // work
+ uInt msudigits; // digits in result msu
+ Unit *msu=res->lsu+D2U(res->digits)-1; // current msu
+ Unit *msumax=res->lsu+D2U(set->digits)-1; // rotation msu
+ for (msu++; msu<=msumax; msu++) *msu=0; // ensure high units=0
+ res->digits=set->digits; // now full-length
+ msudigits=MSUDIGITS(res->digits); // actual digits in msu
+
+ // rotation here is done in-place, in three steps
+ // 1. shift all to least up to one unit to unit-align final
+ // lsd [any digits shifted out are rotated to the left,
+ // abutted to the original msd (which may require split)]
+ //
+ // [if there are no whole units left to rotate, the
+ // rotation is now complete]
+ //
+ // 2. shift to least, from below the split point only, so that
+ // the final msd is in the right place in its Unit [any
+ // digits shifted out will fit exactly in the current msu,
+ // left aligned, no split required]
+ //
+ // 3. rotate all the units by reversing left part, right
+ // part, and then whole
+ //
+ // example: rotate right 8 digits (2 units + 2), DECDPUN=3.
+ //
+ // start: 00a bcd efg hij klm npq
+ //
+ // 1a 000 0ab cde fgh|ijk lmn [pq saved]
+ // 1b 00p qab cde fgh|ijk lmn
+ //
+ // 2a 00p qab cde fgh|00i jkl [mn saved]
+ // 2b mnp qab cde fgh|00i jkl
+ //
+ // 3a fgh cde qab mnp|00i jkl
+ // 3b fgh cde qab mnp|jkl 00i
+ // 3c 00i jkl mnp qab cde fgh
+
+ // Step 1: amount to shift is the partial right-rotate count
+ rotate=set->digits-rotate; // make it right-rotate
+ units=rotate/DECDPUN; // whole units to rotate
+ shift=rotate%DECDPUN; // left-over digits count
+ if (shift>0) { // not an exact number of units
+ uInt save=res->lsu[0]%powers[shift]; // save low digit(s)
+ decShiftToLeast(res->lsu, D2U(res->digits), shift);
+ if (shift>msudigits) { // msumax-1 needs >0 digits
+ uInt rem=save%powers[shift-msudigits];// split save
+ *msumax=(Unit)(save/powers[shift-msudigits]); // and insert
+ *(msumax-1)=*(msumax-1)
+ +(Unit)(rem*powers[DECDPUN-(shift-msudigits)]); // ..
+ }
+ else { // all fits in msumax
+ *msumax=*msumax+(Unit)(save*powers[msudigits-shift]); // [maybe *1]
+ }
+ } // digits shift needed
+
+ // If whole units to rotate...
+ if (units>0) { // some to do
+ // Step 2: the units to touch are the whole ones in rotate,
+ // if any, and the shift is DECDPUN-msudigits (which may be
+ // 0, again)
+ shift=DECDPUN-msudigits;
+ if (shift>0) { // not an exact number of units
+ uInt save=res->lsu[0]%powers[shift]; // save low digit(s)
+ decShiftToLeast(res->lsu, units, shift);
+ *msumax=*msumax+(Unit)(save*powers[msudigits]);
+ } // partial shift needed
+
+ // Step 3: rotate the units array using triple reverse
+ // (reversing is easy and fast)
+ decReverse(res->lsu+units, msumax); // left part
+ decReverse(res->lsu, res->lsu+units-1); // right part
+ decReverse(res->lsu, msumax); // whole
+ } // whole units to rotate
+ // the rotation may have left an undetermined number of zeros
+ // on the left, so true length needs to be calculated
+ res->digits=decGetDigits(res->lsu, msumax-res->lsu+1);
+ } // rotate needed
+ } // rhs OK
+ } // numerics
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberRotate
+
+/* ------------------------------------------------------------------ */
+/* decNumberSameQuantum -- test for equal exponents */
+/* */
+/* res is the result number, which will contain either 0 or 1 */
+/* lhs is a number to test */
+/* rhs is the second (usually a pattern) */
+/* */
+/* No errors are possible and no context is needed. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberSameQuantum(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs) {
+ Unit ret=0; // return value
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, DECUNCONT)) return res;
+ #endif
+
+ if (SPECIALARGS) {
+ if (decNumberIsNaN(lhs) && decNumberIsNaN(rhs)) ret=1;
+ else if (decNumberIsInfinite(lhs) && decNumberIsInfinite(rhs)) ret=1;
+ // [anything else with a special gives 0]
+ }
+ else if (lhs->exponent==rhs->exponent) ret=1;
+
+ decNumberZero(res); // OK to overwrite an operand now
+ *res->lsu=ret;
+ return res;
+ } // decNumberSameQuantum
+
+/* ------------------------------------------------------------------ */
+/* decNumberScaleB -- multiply by a power of 10 */
+/* */
+/* This computes C = A x 10**B where B is an integer (q=0) with */
+/* maximum magnitude 2*(emax+digits) */
+/* */
+/* res is C, the result. C may be A or B */
+/* lhs is A, the number to adjust */
+/* rhs is B, the requested power of ten to use */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* The result may underflow or overflow. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberScaleB(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ Int reqexp; // requested exponent change [B]
+ uInt status=0; // accumulator
+ Int residue; // work
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ // Handle special values except lhs infinite
+ if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs))
+ decNaNs(res, lhs, rhs, set, &status);
+ // rhs must be an integer
+ else if (decNumberIsInfinite(rhs) || rhs->exponent!=0)
+ status=DEC_Invalid_operation;
+ else {
+ // lhs is a number; rhs is a finite with q==0
+ reqexp=decGetInt(rhs); // [cannot fail]
+ // maximum range is larger than getInt can handle, so this is
+ // more restrictive than the specification
+ if (reqexp==BADINT // something bad ..
+ || reqexp==BIGODD || reqexp==BIGEVEN // it was huge
+ || (abs(reqexp)+1)/2>(set->digits+set->emax)) // .. or out of range
+ status=DEC_Invalid_operation;
+ else { // rhs is OK
+ decNumberCopy(res, lhs); // all done if infinite lhs
+ if (!decNumberIsInfinite(res)) { // prepare to scale
+ Int exp=res->exponent; // save for overflow test
+ res->exponent+=reqexp; // adjust the exponent
+ if (((exp^reqexp)>=0) // same sign ...
+ && ((exp^res->exponent)<0)) { // .. but result had different
+ // the calculation overflowed, so force right treatment
+ if (exp<0) res->exponent=DEC_MIN_EMIN-DEC_MAX_DIGITS;
+ else res->exponent=DEC_MAX_EMAX+1;
+ }
+ residue=0;
+ decFinalize(res, set, &residue, &status); // final check
+ } // finite LHS
+ } // rhs OK
+ } // rhs finite
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberScaleB
+
+/* ------------------------------------------------------------------ */
+/* decNumberShift -- shift the coefficient of a Number left or right */
+/* */
+/* This computes C = A << B or C = A >> -B (in base ten). */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X<<X) */
+/* lhs is A */
+/* rhs is B, the number of digits to shift (-ve to right) */
+/* set is the context */
+/* */
+/* The digits of the coefficient of A are shifted to the left (if B */
+/* is positive) or to the right (if B is negative) without adjusting */
+/* the exponent or the sign of A. */
+/* */
+/* B must be an integer (q=0) and in the range -set->digits through */
+/* +set->digits. */
+/* C must have space for set->digits digits. */
+/* NaNs are propagated as usual. Infinities are unaffected (but */
+/* B must be valid). No status is set unless B is invalid or an */
+/* operand is an sNaN. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberShift(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+ Int shift; // rhs as an Int
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ // NaNs propagate as normal
+ if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs))
+ decNaNs(res, lhs, rhs, set, &status);
+ // rhs must be an integer
+ else if (decNumberIsInfinite(rhs) || rhs->exponent!=0)
+ status=DEC_Invalid_operation;
+ else { // both numeric, rhs is an integer
+ shift=decGetInt(rhs); // [cannot fail]
+ if (shift==BADINT // something bad ..
+ || shift==BIGODD || shift==BIGEVEN // .. very big ..
+ || abs(shift)>set->digits) // .. or out of range
+ status=DEC_Invalid_operation;
+ else { // rhs is OK
+ decNumberCopy(res, lhs);
+ if (shift!=0 && !decNumberIsInfinite(res)) { // something to do
+ if (shift>0) { // to left
+ if (shift==set->digits) { // removing all
+ *res->lsu=0; // so place 0
+ res->digits=1; // ..
+ }
+ else { //
+ // first remove leading digits if necessary
+ if (res->digits+shift>set->digits) {
+ decDecap(res, res->digits+shift-set->digits);
+ // that updated res->digits; may have gone to 1 (for a
+ // single digit or for zero
+ }
+ if (res->digits>1 || *res->lsu) // if non-zero..
+ res->digits=decShiftToMost(res->lsu, res->digits, shift);
+ } // partial left
+ } // left
+ else { // to right
+ if (-shift>=res->digits) { // discarding all
+ *res->lsu=0; // so place 0
+ res->digits=1; // ..
+ }
+ else {
+ decShiftToLeast(res->lsu, D2U(res->digits), -shift);
+ res->digits-=(-shift);
+ }
+ } // to right
+ } // non-0 non-Inf shift
+ } // rhs OK
+ } // numerics
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberShift
+
+/* ------------------------------------------------------------------ */
+/* decNumberSquareRoot -- square root operator */
+/* */
+/* This computes C = squareroot(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context; note that rounding mode has no effect */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+/* This uses the following varying-precision algorithm in: */
+/* */
+/* Properly Rounded Variable Precision Square Root, T. E. Hull and */
+/* A. Abrham, ACM Transactions on Mathematical Software, Vol 11 #3, */
+/* pp229-237, ACM, September 1985. */
+/* */
+/* The square-root is calculated using Newton's method, after which */
+/* a check is made to ensure the result is correctly rounded. */
+/* */
+/* % [Reformatted original Numerical Turing source code follows.] */
+/* function sqrt(x : real) : real */
+/* % sqrt(x) returns the properly rounded approximation to the square */
+/* % root of x, in the precision of the calling environment, or it */
+/* % fails if x < 0. */
+/* % t e hull and a abrham, august, 1984 */
+/* if x <= 0 then */
+/* if x < 0 then */
+/* assert false */
+/* else */
+/* result 0 */
+/* end if */
+/* end if */
+/* var f := setexp(x, 0) % fraction part of x [0.1 <= x < 1] */
+/* var e := getexp(x) % exponent part of x */
+/* var approx : real */
+/* if e mod 2 = 0 then */
+/* approx := .259 + .819 * f % approx to root of f */
+/* else */
+/* f := f/l0 % adjustments */
+/* e := e + 1 % for odd */
+/* approx := .0819 + 2.59 * f % exponent */
+/* end if */
+/* */
+/* var p:= 3 */
+/* const maxp := currentprecision + 2 */
+/* loop */
+/* p := min(2*p - 2, maxp) % p = 4,6,10, . . . , maxp */
+/* precision p */
+/* approx := .5 * (approx + f/approx) */
+/* exit when p = maxp */
+/* end loop */
+/* */
+/* % approx is now within 1 ulp of the properly rounded square root */
+/* % of f; to ensure proper rounding, compare squares of (approx - */
+/* % l/2 ulp) and (approx + l/2 ulp) with f. */
+/* p := currentprecision */
+/* begin */
+/* precision p + 2 */
+/* const approxsubhalf := approx - setexp(.5, -p) */
+/* if mulru(approxsubhalf, approxsubhalf) > f then */
+/* approx := approx - setexp(.l, -p + 1) */
+/* else */
+/* const approxaddhalf := approx + setexp(.5, -p) */
+/* if mulrd(approxaddhalf, approxaddhalf) < f then */
+/* approx := approx + setexp(.l, -p + 1) */
+/* end if */
+/* end if */
+/* end */
+/* result setexp(approx, e div 2) % fix exponent */
+/* end sqrt */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberSquareRoot(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decContext workset, approxset; // work contexts
+ decNumber dzero; // used for constant zero
+ Int maxp; // largest working precision
+ Int workp; // working precision
+ Int residue=0; // rounding residue
+ uInt status=0, ignore=0; // status accumulators
+ uInt rstatus; // ..
+ Int exp; // working exponent
+ Int ideal; // ideal (preferred) exponent
+ Int needbytes; // work
+ Int dropped; // ..
+
+ #if DECSUBSET
+ decNumber *allocrhs=NULL; // non-NULL if rounded rhs allocated
+ #endif
+ // buffer for f [needs +1 in case DECBUFFER 0]
+ decNumber buff[D2N(DECBUFFER+1)];
+ // buffer for a [needs +2 to match likely maxp]
+ decNumber bufa[D2N(DECBUFFER+2)];
+ // buffer for temporary, b [must be same size as a]
+ decNumber bufb[D2N(DECBUFFER+2)];
+ decNumber *allocbuff=NULL; // -> allocated buff, iff allocated
+ decNumber *allocbufa=NULL; // -> allocated bufa, iff allocated
+ decNumber *allocbufb=NULL; // -> allocated bufb, iff allocated
+ decNumber *f=buff; // reduced fraction
+ decNumber *a=bufa; // approximation to result
+ decNumber *b=bufb; // intermediate result
+ // buffer for temporary variable, up to 3 digits
+ decNumber buft[D2N(3)];
+ decNumber *t=buft; // up-to-3-digit constant or work
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operand and set lostDigits status, as needed
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, &status);
+ if (allocrhs==NULL) break;
+ // [Note: 'f' allocation below could reuse this buffer if
+ // used, but as this is rare they are kept separate for clarity.]
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ // handle infinities and NaNs
+ if (SPECIALARG) {
+ if (decNumberIsInfinite(rhs)) { // an infinity
+ if (decNumberIsNegative(rhs)) status|=DEC_Invalid_operation;
+ else decNumberCopy(res, rhs); // +Infinity
+ }
+ else decNaNs(res, rhs, NULL, set, &status); // a NaN
+ break;
+ }
+
+ // calculate the ideal (preferred) exponent [floor(exp/2)]
+ // [It would be nicer to write: ideal=rhs->exponent>>1, but this
+ // generates a compiler warning. Generated code is the same.]
+ ideal=(rhs->exponent&~1)/2; // target
+
+ // handle zeros
+ if (ISZERO(rhs)) {
+ decNumberCopy(res, rhs); // could be 0 or -0
+ res->exponent=ideal; // use the ideal [safe]
+ // use decFinish to clamp any out-of-range exponent, etc.
+ decFinish(res, set, &residue, &status);
+ break;
+ }
+
+ // any other -x is an oops
+ if (decNumberIsNegative(rhs)) {
+ status|=DEC_Invalid_operation;
+ break;
+ }
+
+ // space is needed for three working variables
+ // f -- the same precision as the RHS, reduced to 0.01->0.99...
+ // a -- Hull's approximation -- precision, when assigned, is
+ // currentprecision+1 or the input argument precision,
+ // whichever is larger (+2 for use as temporary)
+ // b -- intermediate temporary result (same size as a)
+ // if any is too long for local storage, then allocate
+ workp=MAXI(set->digits+1, rhs->digits); // actual rounding precision
+ workp=MAXI(workp, 7); // at least 7 for low cases
+ maxp=workp+2; // largest working precision
+
+ needbytes=sizeof(decNumber)+(D2U(rhs->digits)-1)*sizeof(Unit);
+ if (needbytes>(Int)sizeof(buff)) {
+ allocbuff=(decNumber *)malloc(needbytes);
+ if (allocbuff==NULL) { // hopeless -- abandon
+ status|=DEC_Insufficient_storage;
+ break;}
+ f=allocbuff; // use the allocated space
+ }
+ // a and b both need to be able to hold a maxp-length number
+ needbytes=sizeof(decNumber)+(D2U(maxp)-1)*sizeof(Unit);
+ if (needbytes>(Int)sizeof(bufa)) { // [same applies to b]
+ allocbufa=(decNumber *)malloc(needbytes);
+ allocbufb=(decNumber *)malloc(needbytes);
+ if (allocbufa==NULL || allocbufb==NULL) { // hopeless
+ status|=DEC_Insufficient_storage;
+ break;}
+ a=allocbufa; // use the allocated spaces
+ b=allocbufb; // ..
+ }
+
+ // copy rhs -> f, save exponent, and reduce so 0.1 <= f < 1
+ decNumberCopy(f, rhs);
+ exp=f->exponent+f->digits; // adjusted to Hull rules
+ f->exponent=-(f->digits); // to range
+
+ // set up working context
+ decContextDefault(&workset, DEC_INIT_DECIMAL64);
+ workset.emax=DEC_MAX_EMAX;
+ workset.emin=DEC_MIN_EMIN;
+
+ // [Until further notice, no error is possible and status bits
+ // (Rounded, etc.) should be ignored, not accumulated.]
+
+ // Calculate initial approximation, and allow for odd exponent
+ workset.digits=workp; // p for initial calculation
+ t->bits=0; t->digits=3;
+ a->bits=0; a->digits=3;
+ if ((exp & 1)==0) { // even exponent
+ // Set t=0.259, a=0.819
+ t->exponent=-3;
+ a->exponent=-3;
+ #if DECDPUN>=3
+ t->lsu[0]=259;
+ a->lsu[0]=819;
+ #elif DECDPUN==2
+ t->lsu[0]=59; t->lsu[1]=2;
+ a->lsu[0]=19; a->lsu[1]=8;
+ #else
+ t->lsu[0]=9; t->lsu[1]=5; t->lsu[2]=2;
+ a->lsu[0]=9; a->lsu[1]=1; a->lsu[2]=8;
+ #endif
+ }
+ else { // odd exponent
+ // Set t=0.0819, a=2.59
+ f->exponent--; // f=f/10
+ exp++; // e=e+1
+ t->exponent=-4;
+ a->exponent=-2;
+ #if DECDPUN>=3
+ t->lsu[0]=819;
+ a->lsu[0]=259;
+ #elif DECDPUN==2
+ t->lsu[0]=19; t->lsu[1]=8;
+ a->lsu[0]=59; a->lsu[1]=2;
+ #else
+ t->lsu[0]=9; t->lsu[1]=1; t->lsu[2]=8;
+ a->lsu[0]=9; a->lsu[1]=5; a->lsu[2]=2;
+ #endif
+ }
+
+ decMultiplyOp(a, a, f, &workset, &ignore); // a=a*f
+ decAddOp(a, a, t, &workset, 0, &ignore); // ..+t
+ // [a is now the initial approximation for sqrt(f), calculated with
+ // currentprecision, which is also a's precision.]
+
+ // the main calculation loop
+ decNumberZero(&dzero); // make 0
+ decNumberZero(t); // set t = 0.5
+ t->lsu[0]=5; // ..
+ t->exponent=-1; // ..
+ workset.digits=3; // initial p
+ for (; workset.digits<maxp;) {
+ // set p to min(2*p - 2, maxp) [hence 3; or: 4, 6, 10, ... , maxp]
+ workset.digits=MINI(workset.digits*2-2, maxp);
+ // a = 0.5 * (a + f/a)
+ // [calculated at p then rounded to currentprecision]
+ decDivideOp(b, f, a, &workset, DIVIDE, &ignore); // b=f/a
+ decAddOp(b, b, a, &workset, 0, &ignore); // b=b+a
+ decMultiplyOp(a, b, t, &workset, &ignore); // a=b*0.5
+ } // loop
+
+ // Here, 0.1 <= a < 1 [Hull], and a has maxp digits
+ // now reduce to length, etc.; this needs to be done with a
+ // having the correct exponent so as to handle subnormals
+ // correctly
+ approxset=*set; // get emin, emax, etc.
+ approxset.round=DEC_ROUND_HALF_EVEN;
+ a->exponent+=exp/2; // set correct exponent
+ rstatus=0; // clear status
+ residue=0; // .. and accumulator
+ decCopyFit(a, a, &approxset, &residue, &rstatus); // reduce (if needed)
+ decFinish(a, &approxset, &residue, &rstatus); // clean and finalize
+
+ // Overflow was possible if the input exponent was out-of-range,
+ // in which case quit
+ if (rstatus&DEC_Overflow) {
+ status=rstatus; // use the status as-is
+ decNumberCopy(res, a); // copy to result
+ break;
+ }
+
+ // Preserve status except Inexact/Rounded
+ status|=(rstatus & ~(DEC_Rounded|DEC_Inexact));
+
+ // Carry out the Hull correction
+ a->exponent-=exp/2; // back to 0.1->1
+
+ // a is now at final precision and within 1 ulp of the properly
+ // rounded square root of f; to ensure proper rounding, compare
+ // squares of (a - l/2 ulp) and (a + l/2 ulp) with f.
+ // Here workset.digits=maxp and t=0.5, and a->digits determines
+ // the ulp
+ workset.digits--; // maxp-1 is OK now
+ t->exponent=-a->digits-1; // make 0.5 ulp
+ decAddOp(b, a, t, &workset, DECNEG, &ignore); // b = a - 0.5 ulp
+ workset.round=DEC_ROUND_UP;
+ decMultiplyOp(b, b, b, &workset, &ignore); // b = mulru(b, b)
+ decCompareOp(b, f, b, &workset, COMPARE, &ignore); // b ? f, reversed
+ if (decNumberIsNegative(b)) { // f < b [i.e., b > f]
+ // this is the more common adjustment, though both are rare
+ t->exponent++; // make 1.0 ulp
+ t->lsu[0]=1; // ..
+ decAddOp(a, a, t, &workset, DECNEG, &ignore); // a = a - 1 ulp
+ // assign to approx [round to length]
+ approxset.emin-=exp/2; // adjust to match a
+ approxset.emax-=exp/2;
+ decAddOp(a, &dzero, a, &approxset, 0, &ignore);
+ }
+ else {
+ decAddOp(b, a, t, &workset, 0, &ignore); // b = a + 0.5 ulp
+ workset.round=DEC_ROUND_DOWN;
+ decMultiplyOp(b, b, b, &workset, &ignore); // b = mulrd(b, b)
+ decCompareOp(b, b, f, &workset, COMPARE, &ignore); // b ? f
+ if (decNumberIsNegative(b)) { // b < f
+ t->exponent++; // make 1.0 ulp
+ t->lsu[0]=1; // ..
+ decAddOp(a, a, t, &workset, 0, &ignore); // a = a + 1 ulp
+ // assign to approx [round to length]
+ approxset.emin-=exp/2; // adjust to match a
+ approxset.emax-=exp/2;
+ decAddOp(a, &dzero, a, &approxset, 0, &ignore);
+ }
+ }
+ // [no errors are possible in the above, and rounding/inexact during
+ // estimation are irrelevant, so status was not accumulated]
+
+ // Here, 0.1 <= a < 1 (still), so adjust back
+ a->exponent+=exp/2; // set correct exponent
+
+ // count droppable zeros [after any subnormal rounding] by
+ // trimming a copy
+ decNumberCopy(b, a);
+ decTrim(b, set, 1, 1, &dropped); // [drops trailing zeros]
+
+ // Set Inexact and Rounded. The answer can only be exact if
+ // it is short enough so that squaring it could fit in workp
+ // digits, so this is the only (relatively rare) condition that
+ // a careful check is needed
+ if (b->digits*2-1 > workp) { // cannot fit
+ status|=DEC_Inexact|DEC_Rounded;
+ }
+ else { // could be exact/unrounded
+ uInt mstatus=0; // local status
+ decMultiplyOp(b, b, b, &workset, &mstatus); // try the multiply
+ if (mstatus&DEC_Overflow) { // result just won't fit
+ status|=DEC_Inexact|DEC_Rounded;
+ }
+ else { // plausible
+ decCompareOp(t, b, rhs, &workset, COMPARE, &mstatus); // b ? rhs
+ if (!ISZERO(t)) status|=DEC_Inexact|DEC_Rounded; // not equal
+ else { // is Exact
+ // here, dropped is the count of trailing zeros in 'a'
+ // use closest exponent to ideal...
+ Int todrop=ideal-a->exponent; // most that can be dropped
+ if (todrop<0) status|=DEC_Rounded; // ideally would add 0s
+ else { // unrounded
+ // there are some to drop, but emax may not allow all
+ Int maxexp=set->emax-set->digits+1;
+ Int maxdrop=maxexp-a->exponent;
+ if (todrop>maxdrop && set->clamp) { // apply clamping
+ todrop=maxdrop;
+ status|=DEC_Clamped;
+ }
+ if (dropped<todrop) { // clamp to those available
+ todrop=dropped;
+ status|=DEC_Clamped;
+ }
+ if (todrop>0) { // have some to drop
+ decShiftToLeast(a->lsu, D2U(a->digits), todrop);
+ a->exponent+=todrop; // maintain numerical value
+ a->digits-=todrop; // new length
+ }
+ }
+ }
+ }
+ }
+
+ // double-check Underflow, as perhaps the result could not have
+ // been subnormal (initial argument too big), or it is now Exact
+ if (status&DEC_Underflow) {
+ Int ae=rhs->exponent+rhs->digits-1; // adjusted exponent
+ // check if truly subnormal
+ #if DECEXTFLAG // DEC_Subnormal too
+ if (ae>=set->emin*2) status&=~(DEC_Subnormal|DEC_Underflow);
+ #else
+ if (ae>=set->emin*2) status&=~DEC_Underflow;
+ #endif
+ // check if truly inexact
+ if (!(status&DEC_Inexact)) status&=~DEC_Underflow;
+ }
+
+ decNumberCopy(res, a); // a is now the result
+ } while(0); // end protected
+
+ if (allocbuff!=NULL) free(allocbuff); // drop any storage used
+ if (allocbufa!=NULL) free(allocbufa); // ..
+ if (allocbufb!=NULL) free(allocbufb); // ..
+ #if DECSUBSET
+ if (allocrhs !=NULL) free(allocrhs); // ..
+ #endif
+ if (status!=0) decStatus(res, status, set);// then report status
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberSquareRoot
+
+/* ------------------------------------------------------------------ */
+/* decNumberSubtract -- subtract two Numbers */
+/* */
+/* This computes C = A - B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X-X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* */
+/* C must have space for set->digits digits. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberSubtract(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ uInt status=0; // accumulator
+
+ decAddOp(res, lhs, rhs, set, DECNEG, &status);
+ if (status!=0) decStatus(res, status, set);
+ #if DECCHECK
+ decCheckInexact(res, set);
+ #endif
+ return res;
+ } // decNumberSubtract
+
+/* ------------------------------------------------------------------ */
+/* decNumberToIntegralExact -- round-to-integral-value with InExact */
+/* decNumberToIntegralValue -- round-to-integral-value */
+/* */
+/* res is the result */
+/* rhs is input number */
+/* set is the context */
+/* */
+/* res must have space for any value of rhs. */
+/* */
+/* This implements the IEEE special operators and therefore treats */
+/* special values as valid. For finite numbers it returns */
+/* rescale(rhs, 0) if rhs->exponent is <0. */
+/* Otherwise the result is rhs (so no error is possible, except for */
+/* sNaN). */
+/* */
+/* The context is used for rounding mode and status after sNaN, but */
+/* the digits setting is ignored. The Exact version will signal */
+/* Inexact if the result differs numerically from rhs; the other */
+/* never signals Inexact. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberToIntegralExact(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decNumber dn;
+ decContext workset; // working context
+ uInt status=0; // accumulator
+
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ // handle infinities and NaNs
+ if (SPECIALARG) {
+ if (decNumberIsInfinite(rhs)) decNumberCopy(res, rhs); // an Infinity
+ else decNaNs(res, rhs, NULL, set, &status); // a NaN
+ }
+ else { // finite
+ // have a finite number; no error possible (res must be big enough)
+ if (rhs->exponent>=0) return decNumberCopy(res, rhs);
+ // that was easy, but if negative exponent there is work to do...
+ workset=*set; // clone rounding, etc.
+ workset.digits=rhs->digits; // no length rounding
+ workset.traps=0; // no traps
+ decNumberZero(&dn); // make a number with exponent 0
+ decNumberQuantize(res, rhs, &dn, &workset);
+ status|=workset.status;
+ }
+ if (status!=0) decStatus(res, status, set);
+ return res;
+ } // decNumberToIntegralExact
+
+decNumber * decNumberToIntegralValue(decNumber *res, const decNumber *rhs,
+ decContext *set) {
+ decContext workset=*set; // working context
+ workset.traps=0; // no traps
+ decNumberToIntegralExact(res, rhs, &workset);
+ // this never affects set, except for sNaNs; NaN will have been set
+ // or propagated already, so no need to call decStatus
+ set->status|=workset.status&DEC_Invalid_operation;
+ return res;
+ } // decNumberToIntegralValue
+
+/* ------------------------------------------------------------------ */
+/* decNumberXor -- XOR two Numbers, digitwise */
+/* */
+/* This computes C = A ^ B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X^X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context (used for result length and error report) */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Logical function restrictions apply (see above); a NaN is */
+/* returned with Invalid_operation if a restriction is violated. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberXor(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ const Unit *ua, *ub; // -> operands
+ const Unit *msua, *msub; // -> operand msus
+ Unit *uc, *msuc; // -> result and its msu
+ Int msudigs; // digits in res msu
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ if (lhs->exponent!=0 || decNumberIsSpecial(lhs) || decNumberIsNegative(lhs)
+ || rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ // operands are valid
+ ua=lhs->lsu; // bottom-up
+ ub=rhs->lsu; // ..
+ uc=res->lsu; // ..
+ msua=ua+D2U(lhs->digits)-1; // -> msu of lhs
+ msub=ub+D2U(rhs->digits)-1; // -> msu of rhs
+ msuc=uc+D2U(set->digits)-1; // -> msu of result
+ msudigs=MSUDIGITS(set->digits); // [faster than remainder]
+ for (; uc<=msuc; ua++, ub++, uc++) { // Unit loop
+ Unit a, b; // extract units
+ if (ua>msua) a=0;
+ else a=*ua;
+ if (ub>msub) b=0;
+ else b=*ub;
+ *uc=0; // can now write back
+ if (a|b) { // maybe 1 bits to examine
+ Int i, j;
+ // This loop could be unrolled and/or use BIN2BCD tables
+ for (i=0; i<DECDPUN; i++) {
+ if ((a^b)&1) *uc=*uc+(Unit)powers[i]; // effect XOR
+ j=a%10;
+ a=a/10;
+ j|=b%10;
+ b=b/10;
+ if (j>1) {
+ decStatus(res, DEC_Invalid_operation, set);
+ return res;
+ }
+ if (uc==msuc && i==msudigs-1) break; // just did final digit
+ } // each digit
+ } // non-zero
+ } // each unit
+ // [here uc-1 is the msu of the result]
+ res->digits=decGetDigits(res->lsu, uc-res->lsu);
+ res->exponent=0; // integer
+ res->bits=0; // sign=0
+ return res; // [no status to set]
+ } // decNumberXor
+
+
+/* ================================================================== */
+/* Utility routines */
+/* ================================================================== */
+
+/* ------------------------------------------------------------------ */
+/* decNumberClass -- return the decClass of a decNumber */
+/* dn -- the decNumber to test */
+/* set -- the context to use for Emin */
+/* returns the decClass enum */
+/* ------------------------------------------------------------------ */
+enum decClass decNumberClass(const decNumber *dn, decContext *set) {
+ if (decNumberIsSpecial(dn)) {
+ if (decNumberIsQNaN(dn)) return DEC_CLASS_QNAN;
+ if (decNumberIsSNaN(dn)) return DEC_CLASS_SNAN;
+ // must be an infinity
+ if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_INF;
+ return DEC_CLASS_POS_INF;
+ }
+ // is finite
+ if (decNumberIsNormal(dn, set)) { // most common
+ if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_NORMAL;
+ return DEC_CLASS_POS_NORMAL;
+ }
+ // is subnormal or zero
+ if (decNumberIsZero(dn)) { // most common
+ if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_ZERO;
+ return DEC_CLASS_POS_ZERO;
+ }
+ if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_SUBNORMAL;
+ return DEC_CLASS_POS_SUBNORMAL;
+ } // decNumberClass
+
+/* ------------------------------------------------------------------ */
+/* decNumberClassToString -- convert decClass to a string */
+/* */
+/* eclass is a valid decClass */
+/* returns a constant string describing the class (max 13+1 chars) */
+/* ------------------------------------------------------------------ */
+const char *decNumberClassToString(enum decClass eclass) {
+ if (eclass==DEC_CLASS_POS_NORMAL) return DEC_ClassString_PN;
+ if (eclass==DEC_CLASS_NEG_NORMAL) return DEC_ClassString_NN;
+ if (eclass==DEC_CLASS_POS_ZERO) return DEC_ClassString_PZ;
+ if (eclass==DEC_CLASS_NEG_ZERO) return DEC_ClassString_NZ;
+ if (eclass==DEC_CLASS_POS_SUBNORMAL) return DEC_ClassString_PS;
+ if (eclass==DEC_CLASS_NEG_SUBNORMAL) return DEC_ClassString_NS;
+ if (eclass==DEC_CLASS_POS_INF) return DEC_ClassString_PI;
+ if (eclass==DEC_CLASS_NEG_INF) return DEC_ClassString_NI;
+ if (eclass==DEC_CLASS_QNAN) return DEC_ClassString_QN;
+ if (eclass==DEC_CLASS_SNAN) return DEC_ClassString_SN;
+ return DEC_ClassString_UN; // Unknown
+ } // decNumberClassToString
+
+/* ------------------------------------------------------------------ */
+/* decNumberCopy -- copy a number */
+/* */
+/* dest is the target decNumber */
+/* src is the source decNumber */
+/* returns dest */
+/* */
+/* (dest==src is allowed and is a no-op) */
+/* All fields are updated as required. This is a utility operation, */
+/* so special values are unchanged and no error is possible. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCopy(decNumber *dest, const decNumber *src) {
+
+ #if DECCHECK
+ if (src==NULL) return decNumberZero(dest);
+ #endif
+
+ if (dest==src) return dest; // no copy required
+
+ // Use explicit assignments here as structure assignment could copy
+ // more than just the lsu (for small DECDPUN). This would not affect
+ // the value of the results, but could disturb test harness spill
+ // checking.
+ dest->bits=src->bits;
+ dest->exponent=src->exponent;
+ dest->digits=src->digits;
+ dest->lsu[0]=src->lsu[0];
+ if (src->digits>DECDPUN) { // more Units to come
+ const Unit *smsup, *s; // work
+ Unit *d; // ..
+ // memcpy for the remaining Units would be safe as they cannot
+ // overlap. However, this explicit loop is faster in short cases.
+ d=dest->lsu+1; // -> first destination
+ smsup=src->lsu+D2U(src->digits); // -> source msu+1
+ for (s=src->lsu+1; s<smsup; s++, d++) *d=*s;
+ }
+ return dest;
+ } // decNumberCopy
+
+/* ------------------------------------------------------------------ */
+/* decNumberCopyAbs -- quiet absolute value operator */
+/* */
+/* This sets C = abs(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* */
+/* C must have space for set->digits digits. */
+/* No exception or error can occur; this is a quiet bitwise operation.*/
+/* See also decNumberAbs for a checking version of this. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCopyAbs(decNumber *res, const decNumber *rhs) {
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, DECUNCONT)) return res;
+ #endif
+ decNumberCopy(res, rhs);
+ res->bits&=~DECNEG; // turn off sign
+ return res;
+ } // decNumberCopyAbs
+
+/* ------------------------------------------------------------------ */
+/* decNumberCopyNegate -- quiet negate value operator */
+/* */
+/* This sets C = negate(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* */
+/* C must have space for set->digits digits. */
+/* No exception or error can occur; this is a quiet bitwise operation.*/
+/* See also decNumberMinus for a checking version of this. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCopyNegate(decNumber *res, const decNumber *rhs) {
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, DECUNCONT)) return res;
+ #endif
+ decNumberCopy(res, rhs);
+ res->bits^=DECNEG; // invert the sign
+ return res;
+ } // decNumberCopyNegate
+
+/* ------------------------------------------------------------------ */
+/* decNumberCopySign -- quiet copy and set sign operator */
+/* */
+/* This sets C = A with the sign of B */
+/* */
+/* res is C, the result. C may be A */
+/* lhs is A */
+/* rhs is B */
+/* */
+/* C must have space for set->digits digits. */
+/* No exception or error can occur; this is a quiet bitwise operation.*/
+/* ------------------------------------------------------------------ */
+decNumber * decNumberCopySign(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs) {
+ uByte sign; // rhs sign
+ #if DECCHECK
+ if (decCheckOperands(res, DECUNUSED, rhs, DECUNCONT)) return res;
+ #endif
+ sign=rhs->bits & DECNEG; // save sign bit
+ decNumberCopy(res, lhs);
+ res->bits&=~DECNEG; // clear the sign
+ res->bits|=sign; // set from rhs
+ return res;
+ } // decNumberCopySign
+
+/* ------------------------------------------------------------------ */
+/* decNumberGetBCD -- get the coefficient in BCD8 */
+/* dn is the source decNumber */
+/* bcd is the uInt array that will receive dn->digits BCD bytes, */
+/* most-significant at offset 0 */
+/* returns bcd */
+/* */
+/* bcd must have at least dn->digits bytes. No error is possible; if */
+/* dn is a NaN or Infinite, digits must be 1 and the coefficient 0. */
+/* ------------------------------------------------------------------ */
+uByte * decNumberGetBCD(const decNumber *dn, uByte *bcd) {
+ uByte *ub=bcd+dn->digits-1; // -> lsd
+ const Unit *up=dn->lsu; // Unit pointer, -> lsu
+
+ #if DECDPUN==1 // trivial simple copy
+ for (; ub>=bcd; ub--, up++) *ub=*up;
+ #else // chopping needed
+ uInt u=*up; // work
+ uInt cut=DECDPUN; // downcounter through unit
+ for (; ub>=bcd; ub--) {
+ *ub=(uByte)(u%10); // [*6554 trick inhibits, here]
+ u=u/10;
+ cut--;
+ if (cut>0) continue; // more in this unit
+ up++;
+ u=*up;
+ cut=DECDPUN;
+ }
+ #endif
+ return bcd;
+ } // decNumberGetBCD
+
+/* ------------------------------------------------------------------ */
+/* decNumberSetBCD -- set (replace) the coefficient from BCD8 */
+/* dn is the target decNumber */
+/* bcd is the uInt array that will source n BCD bytes, most- */
+/* significant at offset 0 */
+/* n is the number of digits in the source BCD array (bcd) */
+/* returns dn */
+/* */
+/* dn must have space for at least n digits. No error is possible; */
+/* if dn is a NaN, or Infinite, or is to become a zero, n must be 1 */
+/* and bcd[0] zero. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberSetBCD(decNumber *dn, const uByte *bcd, uInt n) {
+ Unit *up=dn->lsu+D2U(dn->digits)-1; // -> msu [target pointer]
+ const uByte *ub=bcd; // -> source msd
+
+ #if DECDPUN==1 // trivial simple copy
+ for (; ub<bcd+n; ub++, up--) *up=*ub;
+ #else // some assembly needed
+ // calculate how many digits in msu, and hence first cut
+ Int cut=MSUDIGITS(n); // [faster than remainder]
+ for (;up>=dn->lsu; up--) { // each Unit from msu
+ *up=0; // will take <=DECDPUN digits
+ for (; cut>0; ub++, cut--) *up=X10(*up)+*ub;
+ cut=DECDPUN; // next Unit has all digits
+ }
+ #endif
+ dn->digits=n; // set digit count
+ return dn;
+ } // decNumberSetBCD
+
+/* ------------------------------------------------------------------ */
+/* decNumberIsNormal -- test normality of a decNumber */
+/* dn is the decNumber to test */
+/* set is the context to use for Emin */
+/* returns 1 if |dn| is finite and >=Nmin, 0 otherwise */
+/* ------------------------------------------------------------------ */
+Int decNumberIsNormal(const decNumber *dn, decContext *set) {
+ Int ae; // adjusted exponent
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
+ #endif
+
+ if (decNumberIsSpecial(dn)) return 0; // not finite
+ if (decNumberIsZero(dn)) return 0; // not non-zero
+
+ ae=dn->exponent+dn->digits-1; // adjusted exponent
+ if (ae<set->emin) return 0; // is subnormal
+ return 1;
+ } // decNumberIsNormal
+
+/* ------------------------------------------------------------------ */
+/* decNumberIsSubnormal -- test subnormality of a decNumber */
+/* dn is the decNumber to test */
+/* set is the context to use for Emin */
+/* returns 1 if |dn| is finite, non-zero, and <Nmin, 0 otherwise */
+/* ------------------------------------------------------------------ */
+Int decNumberIsSubnormal(const decNumber *dn, decContext *set) {
+ Int ae; // adjusted exponent
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
+ #endif
+
+ if (decNumberIsSpecial(dn)) return 0; // not finite
+ if (decNumberIsZero(dn)) return 0; // not non-zero
+
+ ae=dn->exponent+dn->digits-1; // adjusted exponent
+ if (ae<set->emin) return 1; // is subnormal
+ return 0;
+ } // decNumberIsSubnormal
+
+/* ------------------------------------------------------------------ */
+/* decNumberTrim -- remove insignificant zeros */
+/* */
+/* dn is the number to trim */
+/* returns dn */
+/* */
+/* All fields are updated as required. This is a utility operation, */
+/* so special values are unchanged and no error is possible. The */
+/* zeros are removed unconditionally. */
+/* ------------------------------------------------------------------ */
+decNumber * decNumberTrim(decNumber *dn) {
+ Int dropped; // work
+ decContext set; // ..
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, DECUNUSED, dn, DECUNCONT)) return dn;
+ #endif
+ decContextDefault(&set, DEC_INIT_BASE); // clamp=0
+ return decTrim(dn, &set, 0, 1, &dropped);
+ } // decNumberTrim
+
+/* ------------------------------------------------------------------ */
+/* decNumberVersion -- return the name and version of this module */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+const char * decNumberVersion(void) {
+ return DECVERSION;
+ } // decNumberVersion
+
+/* ------------------------------------------------------------------ */
+/* decNumberZero -- set a number to 0 */
+/* */
+/* dn is the number to set, with space for one digit */
+/* returns dn */
+/* */
+/* No error is possible. */
+/* ------------------------------------------------------------------ */
+// Memset is not used as it is much slower in some environments.
+decNumber * decNumberZero(decNumber *dn) {
+
+ #if DECCHECK
+ if (decCheckOperands(dn, DECUNUSED, DECUNUSED, DECUNCONT)) return dn;
+ #endif
+
+ dn->bits=0;
+ dn->exponent=0;
+ dn->digits=1;
+ dn->lsu[0]=0;
+ return dn;
+ } // decNumberZero
+
+/* ================================================================== */
+/* Local routines */
+/* ================================================================== */
+
+/* ------------------------------------------------------------------ */
+/* decToString -- lay out a number into a string */
+/* */
+/* dn is the number to lay out */
+/* string is where to lay out the number */
+/* eng is 1 if Engineering, 0 if Scientific */
+/* */
+/* string must be at least dn->digits+14 characters long */
+/* No error is possible. */
+/* */
+/* Note that this routine can generate a -0 or 0.000. These are */
+/* never generated in subset to-number or arithmetic, but can occur */
+/* in non-subset arithmetic (e.g., -1*0 or 1.234-1.234). */
+/* ------------------------------------------------------------------ */
+// If DECCHECK is enabled the string "?" is returned if a number is
+// invalid.
+static void decToString(const decNumber *dn, char *string, Flag eng) {
+ Int exp=dn->exponent; // local copy
+ Int e; // E-part value
+ Int pre; // digits before the '.'
+ Int cut; // for counting digits in a Unit
+ char *c=string; // work [output pointer]
+ const Unit *up=dn->lsu+D2U(dn->digits)-1; // -> msu [input pointer]
+ uInt u, pow; // work
+
+ #if DECCHECK
+ if (decCheckOperands(DECUNRESU, dn, DECUNUSED, DECUNCONT)) {
+ strcpy(string, "?");
+ return;}
+ #endif
+
+ if (decNumberIsNegative(dn)) { // Negatives get a minus
+ *c='-';
+ c++;
+ }
+ if (dn->bits&DECSPECIAL) { // Is a special value
+ if (decNumberIsInfinite(dn)) {
+ strcpy(c, "Inf");
+ strcpy(c+3, "inity");
+ return;}
+ // a NaN
+ if (dn->bits&DECSNAN) { // signalling NaN
+ *c='s';
+ c++;
+ }
+ strcpy(c, "NaN");
+ c+=3; // step past
+ // if not a clean non-zero coefficient, that's all there is in a
+ // NaN string
+ if (exp!=0 || (*dn->lsu==0 && dn->digits==1)) return;
+ // [drop through to add integer]
+ }
+
+ // calculate how many digits in msu, and hence first cut
+ cut=MSUDIGITS(dn->digits); // [faster than remainder]
+ cut--; // power of ten for digit
+
+ if (exp==0) { // simple integer [common fastpath]
+ for (;up>=dn->lsu; up--) { // each Unit from msu
+ u=*up; // contains DECDPUN digits to lay out
+ for (; cut>=0; c++, cut--) TODIGIT(u, cut, c, pow);
+ cut=DECDPUN-1; // next Unit has all digits
+ }
+ *c='\0'; // terminate the string
+ return;}
+
+ /* non-0 exponent -- assume plain form */
+ pre=dn->digits+exp; // digits before '.'
+ e=0; // no E
+ if ((exp>0) || (pre<-5)) { // need exponential form
+ e=exp+dn->digits-1; // calculate E value
+ pre=1; // assume one digit before '.'
+ if (eng && (e!=0)) { // engineering: may need to adjust
+ Int adj; // adjustment
+ // The C remainder operator is undefined for negative numbers, so
+ // a positive remainder calculation must be used here
+ if (e<0) {
+ adj=(-e)%3;
+ if (adj!=0) adj=3-adj;
+ }
+ else { // e>0
+ adj=e%3;
+ }
+ e=e-adj;
+ // if dealing with zero still produce an exponent which is a
+ // multiple of three, as expected, but there will only be the
+ // one zero before the E, still. Otherwise note the padding.
+ if (!ISZERO(dn)) pre+=adj;
+ else { // is zero
+ if (adj!=0) { // 0.00Esnn needed
+ e=e+3;
+ pre=-(2-adj);
+ }
+ } // zero
+ } // eng
+ } // need exponent
+
+ /* lay out the digits of the coefficient, adding 0s and . as needed */
+ u=*up;
+ if (pre>0) { // xxx.xxx or xx00 (engineering) form
+ Int n=pre;
+ for (; pre>0; pre--, c++, cut--) {
+ if (cut<0) { // need new Unit
+ if (up==dn->lsu) break; // out of input digits (pre>digits)
+ up--;
+ cut=DECDPUN-1;
+ u=*up;
+ }
+ TODIGIT(u, cut, c, pow);
+ }
+ if (n<dn->digits) { // more to come, after '.'
+ *c='.'; c++;
+ for (;; c++, cut--) {
+ if (cut<0) { // need new Unit
+ if (up==dn->lsu) break; // out of input digits
+ up--;
+ cut=DECDPUN-1;
+ u=*up;
+ }
+ TODIGIT(u, cut, c, pow);
+ }
+ }
+ else for (; pre>0; pre--, c++) *c='0'; // 0 padding (for engineering) needed
+ }
+ else { // 0.xxx or 0.000xxx form
+ *c='0'; c++;
+ *c='.'; c++;
+ for (; pre<0; pre++, c++) *c='0'; // add any 0's after '.'
+ for (; ; c++, cut--) {
+ if (cut<0) { // need new Unit
+ if (up==dn->lsu) break; // out of input digits
+ up--;
+ cut=DECDPUN-1;
+ u=*up;
+ }
+ TODIGIT(u, cut, c, pow);
+ }
+ }
+
+ /* Finally add the E-part, if needed. It will never be 0, has a
+ base maximum and minimum of +999999999 through -999999999, but
+ could range down to -1999999998 for anormal numbers */
+ if (e!=0) {
+ Flag had=0; // 1=had non-zero
+ *c='E'; c++;
+ *c='+'; c++; // assume positive
+ u=e; // ..
+ if (e<0) {
+ *(c-1)='-'; // oops, need -
+ u=-e; // uInt, please
+ }
+ // lay out the exponent [_itoa or equivalent is not ANSI C]
+ for (cut=9; cut>=0; cut--) {
+ TODIGIT(u, cut, c, pow);
+ if (*c=='0' && !had) continue; // skip leading zeros
+ had=1; // had non-0
+ c++; // step for next
+ } // cut
+ }
+ *c='\0'; // terminate the string (all paths)
+ return;
+ } // decToString
+
+/* ------------------------------------------------------------------ */
+/* decAddOp -- add/subtract operation */
+/* */
+/* This computes C = A + B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X+X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* negate is DECNEG if rhs should be negated, or 0 otherwise */
+/* status accumulates status for the caller */
+/* */
+/* C must have space for set->digits digits. */
+/* Inexact in status must be 0 for correct Exact zero sign in result */
+/* ------------------------------------------------------------------ */
+/* If possible, the coefficient is calculated directly into C. */
+/* However, if: */
+/* -- a digits+1 calculation is needed because the numbers are */
+/* unaligned and span more than set->digits digits */
+/* -- a carry to digits+1 digits looks possible */
+/* -- C is the same as A or B, and the result would destructively */
+/* overlap the A or B coefficient */
+/* then the result must be calculated into a temporary buffer. In */
+/* this case a local (stack) buffer is used if possible, and only if */
+/* too long for that does malloc become the final resort. */
+/* */
+/* Misalignment is handled as follows: */
+/* Apad: (AExp>BExp) Swap operands and proceed as for BExp>AExp. */
+/* BPad: Apply the padding by a combination of shifting (whole */
+/* units) and multiplication (part units). */
+/* */
+/* Addition, especially x=x+1, is speed-critical. */
+/* The static buffer is larger than might be expected to allow for */
+/* calls from higher-level funtions (notable exp). */
+/* ------------------------------------------------------------------ */
+static decNumber * decAddOp(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set,
+ uByte negate, uInt *status) {
+ #if DECSUBSET
+ decNumber *alloclhs=NULL; // non-NULL if rounded lhs allocated
+ decNumber *allocrhs=NULL; // .., rhs
+ #endif
+ Int rhsshift; // working shift (in Units)
+ Int maxdigits; // longest logical length
+ Int mult; // multiplier
+ Int residue; // rounding accumulator
+ uByte bits; // result bits
+ Flag diffsign; // non-0 if arguments have different sign
+ Unit *acc; // accumulator for result
+ Unit accbuff[SD2U(DECBUFFER*2+20)]; // local buffer [*2+20 reduces many
+ // allocations when called from
+ // other operations, notable exp]
+ Unit *allocacc=NULL; // -> allocated acc buffer, iff allocated
+ Int reqdigits=set->digits; // local copy; requested DIGITS
+ Int padding; // work
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operands and set lostDigits status, as needed
+ if (lhs->digits>reqdigits) {
+ alloclhs=decRoundOperand(lhs, set, status);
+ if (alloclhs==NULL) break;
+ lhs=alloclhs;
+ }
+ if (rhs->digits>reqdigits) {
+ allocrhs=decRoundOperand(rhs, set, status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ // note whether signs differ [used all paths]
+ diffsign=(Flag)((lhs->bits^rhs->bits^negate)&DECNEG);
+
+ // handle infinities and NaNs
+ if (SPECIALARGS) { // a special bit set
+ if (SPECIALARGS & (DECSNAN | DECNAN)) // a NaN
+ decNaNs(res, lhs, rhs, set, status);
+ else { // one or two infinities
+ if (decNumberIsInfinite(lhs)) { // LHS is infinity
+ // two infinities with different signs is invalid
+ if (decNumberIsInfinite(rhs) && diffsign) {
+ *status|=DEC_Invalid_operation;
+ break;
+ }
+ bits=lhs->bits & DECNEG; // get sign from LHS
+ }
+ else bits=(rhs->bits^negate) & DECNEG;// RHS must be Infinity
+ bits|=DECINF;
+ decNumberZero(res);
+ res->bits=bits; // set +/- infinity
+ } // an infinity
+ break;
+ }
+
+ // Quick exit for add 0s; return the non-0, modified as need be
+ if (ISZERO(lhs)) {
+ Int adjust; // work
+ Int lexp=lhs->exponent; // save in case LHS==RES
+ bits=lhs->bits; // ..
+ residue=0; // clear accumulator
+ decCopyFit(res, rhs, set, &residue, status); // copy (as needed)
+ res->bits^=negate; // flip if rhs was negated
+ #if DECSUBSET
+ if (set->extended) { // exponents on zeros count
+ #endif
+ // exponent will be the lower of the two
+ adjust=lexp-res->exponent; // adjustment needed [if -ve]
+ if (ISZERO(res)) { // both 0: special IEEE 754 rules
+ if (adjust<0) res->exponent=lexp; // set exponent
+ // 0-0 gives +0 unless rounding to -infinity, and -0-0 gives -0
+ if (diffsign) {
+ if (set->round!=DEC_ROUND_FLOOR) res->bits=0;
+ else res->bits=DECNEG; // preserve 0 sign
+ }
+ }
+ else { // non-0 res
+ if (adjust<0) { // 0-padding needed
+ if ((res->digits-adjust)>set->digits) {
+ adjust=res->digits-set->digits; // to fit exactly
+ *status|=DEC_Rounded; // [but exact]
+ }
+ res->digits=decShiftToMost(res->lsu, res->digits, -adjust);
+ res->exponent+=adjust; // set the exponent.
+ }
+ } // non-0 res
+ #if DECSUBSET
+ } // extended
+ #endif
+ decFinish(res, set, &residue, status); // clean and finalize
+ break;}
+
+ if (ISZERO(rhs)) { // [lhs is non-zero]
+ Int adjust; // work
+ Int rexp=rhs->exponent; // save in case RHS==RES
+ bits=rhs->bits; // be clean
+ residue=0; // clear accumulator
+ decCopyFit(res, lhs, set, &residue, status); // copy (as needed)
+ #if DECSUBSET
+ if (set->extended) { // exponents on zeros count
+ #endif
+ // exponent will be the lower of the two
+ // [0-0 case handled above]
+ adjust=rexp-res->exponent; // adjustment needed [if -ve]
+ if (adjust<0) { // 0-padding needed
+ if ((res->digits-adjust)>set->digits) {
+ adjust=res->digits-set->digits; // to fit exactly
+ *status|=DEC_Rounded; // [but exact]
+ }
+ res->digits=decShiftToMost(res->lsu, res->digits, -adjust);
+ res->exponent+=adjust; // set the exponent.
+ }
+ #if DECSUBSET
+ } // extended
+ #endif
+ decFinish(res, set, &residue, status); // clean and finalize
+ break;}
+
+ // [NB: both fastpath and mainpath code below assume these cases
+ // (notably 0-0) have already been handled]
+
+ // calculate the padding needed to align the operands
+ padding=rhs->exponent-lhs->exponent;
+
+ // Fastpath cases where the numbers are aligned and normal, the RHS
+ // is all in one unit, no operand rounding is needed, and no carry,
+ // lengthening, or borrow is needed
+ if (padding==0
+ && rhs->digits<=DECDPUN
+ && rhs->exponent>=set->emin // [some normals drop through]
+ && rhs->exponent<=set->emax-set->digits+1 // [could clamp]
+ && rhs->digits<=reqdigits
+ && lhs->digits<=reqdigits) {
+ Int partial=*lhs->lsu;
+ if (!diffsign) { // adding
+ partial+=*rhs->lsu;
+ if ((partial<=DECDPUNMAX) // result fits in unit
+ && (lhs->digits>=DECDPUN || // .. and no digits-count change
+ partial<(Int)powers[lhs->digits])) { // ..
+ if (res!=lhs) decNumberCopy(res, lhs); // not in place
+ *res->lsu=(Unit)partial; // [copy could have overwritten RHS]
+ break;
+ }
+ // else drop out for careful add
+ }
+ else { // signs differ
+ partial-=*rhs->lsu;
+ if (partial>0) { // no borrow needed, and non-0 result
+ if (res!=lhs) decNumberCopy(res, lhs); // not in place
+ *res->lsu=(Unit)partial;
+ // this could have reduced digits [but result>0]
+ res->digits=decGetDigits(res->lsu, D2U(res->digits));
+ break;
+ }
+ // else drop out for careful subtract
+ }
+ }
+
+ // Now align (pad) the lhs or rhs so they can be added or
+ // subtracted, as necessary. If one number is much larger than
+ // the other (that is, if in plain form there is a least one
+ // digit between the lowest digit of one and the highest of the
+ // other) padding with up to DIGITS-1 trailing zeros may be
+ // needed; then apply rounding (as exotic rounding modes may be
+ // affected by the residue).
+ rhsshift=0; // rhs shift to left (padding) in Units
+ bits=lhs->bits; // assume sign is that of LHS
+ mult=1; // likely multiplier
+
+ // [if padding==0 the operands are aligned; no padding is needed]
+ if (padding!=0) {
+ // some padding needed; always pad the RHS, as any required
+ // padding can then be effected by a simple combination of
+ // shifts and a multiply
+ Flag swapped=0;
+ if (padding<0) { // LHS needs the padding
+ const decNumber *t;
+ padding=-padding; // will be +ve
+ bits=(uByte)(rhs->bits^negate); // assumed sign is now that of RHS
+ t=lhs; lhs=rhs; rhs=t;
+ swapped=1;
+ }
+
+ // If, after pad, rhs would be longer than lhs by digits+1 or
+ // more then lhs cannot affect the answer, except as a residue,
+ // so only need to pad up to a length of DIGITS+1.
+ if (rhs->digits+padding > lhs->digits+reqdigits+1) {
+ // The RHS is sufficient
+ // for residue use the relative sign indication...
+ Int shift=reqdigits-rhs->digits; // left shift needed
+ residue=1; // residue for rounding
+ if (diffsign) residue=-residue; // signs differ
+ // copy, shortening if necessary
+ decCopyFit(res, rhs, set, &residue, status);
+ // if it was already shorter, then need to pad with zeros
+ if (shift>0) {
+ res->digits=decShiftToMost(res->lsu, res->digits, shift);
+ res->exponent-=shift; // adjust the exponent.
+ }
+ // flip the result sign if unswapped and rhs was negated
+ if (!swapped) res->bits^=negate;
+ decFinish(res, set, &residue, status); // done
+ break;}
+
+ // LHS digits may affect result
+ rhsshift=D2U(padding+1)-1; // this much by Unit shift ..
+ mult=powers[padding-(rhsshift*DECDPUN)]; // .. this by multiplication
+ } // padding needed
+
+ if (diffsign) mult=-mult; // signs differ
+
+ // determine the longer operand
+ maxdigits=rhs->digits+padding; // virtual length of RHS
+ if (lhs->digits>maxdigits) maxdigits=lhs->digits;
+
+ // Decide on the result buffer to use; if possible place directly
+ // into result.
+ acc=res->lsu; // assume add direct to result
+ // If destructive overlap, or the number is too long, or a carry or
+ // borrow to DIGITS+1 might be possible, a buffer must be used.
+ // [Might be worth more sophisticated tests when maxdigits==reqdigits]
+ if ((maxdigits>=reqdigits) // is, or could be, too large
+ || (res==rhs && rhsshift>0)) { // destructive overlap
+ // buffer needed, choose it; units for maxdigits digits will be
+ // needed, +1 Unit for carry or borrow
+ Int need=D2U(maxdigits)+1;
+ acc=accbuff; // assume use local buffer
+ if (need*sizeof(Unit)>sizeof(accbuff)) {
+ // printf("malloc add %ld %ld\n", need, sizeof(accbuff));
+ allocacc=(Unit *)malloc(need*sizeof(Unit));
+ if (allocacc==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ acc=allocacc;
+ }
+ }
+
+ res->bits=(uByte)(bits&DECNEG); // it's now safe to overwrite..
+ res->exponent=lhs->exponent; // .. operands (even if aliased)
+
+ #if DECTRACE
+ decDumpAr('A', lhs->lsu, D2U(lhs->digits));
+ decDumpAr('B', rhs->lsu, D2U(rhs->digits));
+ printf(" :h: %ld %ld\n", rhsshift, mult);
+ #endif
+
+ // add [A+B*m] or subtract [A+B*(-m)]
+ res->digits=decUnitAddSub(lhs->lsu, D2U(lhs->digits),
+ rhs->lsu, D2U(rhs->digits),
+ rhsshift, acc, mult)
+ *DECDPUN; // [units -> digits]
+ if (res->digits<0) { // borrowed...
+ res->digits=-res->digits;
+ res->bits^=DECNEG; // flip the sign
+ }
+ #if DECTRACE
+ decDumpAr('+', acc, D2U(res->digits));
+ #endif
+
+ // If a buffer was used the result must be copied back, possibly
+ // shortening. (If no buffer was used then the result must have
+ // fit, so can't need rounding and residue must be 0.)
+ residue=0; // clear accumulator
+ if (acc!=res->lsu) {
+ #if DECSUBSET
+ if (set->extended) { // round from first significant digit
+ #endif
+ // remove leading zeros that were added due to rounding up to
+ // integral Units -- before the test for rounding.
+ if (res->digits>reqdigits)
+ res->digits=decGetDigits(acc, D2U(res->digits));
+ decSetCoeff(res, set, acc, res->digits, &residue, status);
+ #if DECSUBSET
+ }
+ else { // subset arithmetic rounds from original significant digit
+ // May have an underestimate. This only occurs when both
+ // numbers fit in DECDPUN digits and are padding with a
+ // negative multiple (-10, -100...) and the top digit(s) become
+ // 0. (This only matters when using X3.274 rules where the
+ // leading zero could be included in the rounding.)
+ if (res->digits<maxdigits) {
+ *(acc+D2U(res->digits))=0; // ensure leading 0 is there
+ res->digits=maxdigits;
+ }
+ else {
+ // remove leading zeros that added due to rounding up to
+ // integral Units (but only those in excess of the original
+ // maxdigits length, unless extended) before test for rounding.
+ if (res->digits>reqdigits) {
+ res->digits=decGetDigits(acc, D2U(res->digits));
+ if (res->digits<maxdigits) res->digits=maxdigits;
+ }
+ }
+ decSetCoeff(res, set, acc, res->digits, &residue, status);
+ // Now apply rounding if needed before removing leading zeros.
+ // This is safe because subnormals are not a possibility
+ if (residue!=0) {
+ decApplyRound(res, set, residue, status);
+ residue=0; // did what needed to be done
+ }
+ } // subset
+ #endif
+ } // used buffer
+
+ // strip leading zeros [these were left on in case of subset subtract]
+ res->digits=decGetDigits(res->lsu, D2U(res->digits));
+
+ // apply checks and rounding
+ decFinish(res, set, &residue, status);
+
+ // "When the sum of two operands with opposite signs is exactly
+ // zero, the sign of that sum shall be '+' in all rounding modes
+ // except round toward -Infinity, in which mode that sign shall be
+ // '-'." [Subset zeros also never have '-', set by decFinish.]
+ if (ISZERO(res) && diffsign
+ #if DECSUBSET
+ && set->extended
+ #endif
+ && (*status&DEC_Inexact)==0) {
+ if (set->round==DEC_ROUND_FLOOR) res->bits|=DECNEG; // sign -
+ else res->bits&=~DECNEG; // sign +
+ }
+ } while(0); // end protected
+
+ if (allocacc!=NULL) free(allocacc); // drop any storage used
+ #if DECSUBSET
+ if (allocrhs!=NULL) free(allocrhs); // ..
+ if (alloclhs!=NULL) free(alloclhs); // ..
+ #endif
+ return res;
+ } // decAddOp
+
+/* ------------------------------------------------------------------ */
+/* decDivideOp -- division operation */
+/* */
+/* This routine performs the calculations for all four division */
+/* operators (divide, divideInteger, remainder, remainderNear). */
+/* */
+/* C=A op B */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X/X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* op is DIVIDE, DIVIDEINT, REMAINDER, or REMNEAR respectively. */
+/* status is the usual accumulator */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* ------------------------------------------------------------------ */
+/* The underlying algorithm of this routine is the same as in the */
+/* 1981 S/370 implementation, that is, non-restoring long division */
+/* with bi-unit (rather than bi-digit) estimation for each unit */
+/* multiplier. In this pseudocode overview, complications for the */
+/* Remainder operators and division residues for exact rounding are */
+/* omitted for clarity. */
+/* */
+/* Prepare operands and handle special values */
+/* Test for x/0 and then 0/x */
+/* Exp =Exp1 - Exp2 */
+/* Exp =Exp +len(var1) -len(var2) */
+/* Sign=Sign1 * Sign2 */
+/* Pad accumulator (Var1) to double-length with 0's (pad1) */
+/* Pad Var2 to same length as Var1 */
+/* msu2pair/plus=1st 2 or 1 units of var2, +1 to allow for round */
+/* have=0 */
+/* Do until (have=digits+1 OR residue=0) */
+/* if exp<0 then if integer divide/residue then leave */
+/* this_unit=0 */
+/* Do forever */
+/* compare numbers */
+/* if <0 then leave inner_loop */
+/* if =0 then (* quick exit without subtract *) do */
+/* this_unit=this_unit+1; output this_unit */
+/* leave outer_loop; end */
+/* Compare lengths of numbers (mantissae): */
+/* If same then tops2=msu2pair -- {units 1&2 of var2} */
+/* else tops2=msu2plus -- {0, unit 1 of var2} */
+/* tops1=first_unit_of_Var1*10**DECDPUN +second_unit_of_var1 */
+/* mult=tops1/tops2 -- Good and safe guess at divisor */
+/* if mult=0 then mult=1 */
+/* this_unit=this_unit+mult */
+/* subtract */
+/* end inner_loop */
+/* if have\=0 | this_unit\=0 then do */
+/* output this_unit */
+/* have=have+1; end */
+/* var2=var2/10 */
+/* exp=exp-1 */
+/* end outer_loop */
+/* exp=exp+1 -- set the proper exponent */
+/* if have=0 then generate answer=0 */
+/* Return (Result is defined by Var1) */
+/* */
+/* ------------------------------------------------------------------ */
+/* Two working buffers are needed during the division; one (digits+ */
+/* 1) to accumulate the result, and the other (up to 2*digits+1) for */
+/* long subtractions. These are acc and var1 respectively. */
+/* var1 is a copy of the lhs coefficient, var2 is the rhs coefficient.*/
+/* The static buffers may be larger than might be expected to allow */
+/* for calls from higher-level funtions (notable exp). */
+/* ------------------------------------------------------------------ */
+static decNumber * decDivideOp(decNumber *res,
+ const decNumber *lhs, const decNumber *rhs,
+ decContext *set, Flag op, uInt *status) {
+ #if DECSUBSET
+ decNumber *alloclhs=NULL; // non-NULL if rounded lhs allocated
+ decNumber *allocrhs=NULL; // .., rhs
+ #endif
+ Unit accbuff[SD2U(DECBUFFER+DECDPUN+10)]; // local buffer
+ Unit *acc=accbuff; // -> accumulator array for result
+ Unit *allocacc=NULL; // -> allocated buffer, iff allocated
+ Unit *accnext; // -> where next digit will go
+ Int acclength; // length of acc needed [Units]
+ Int accunits; // count of units accumulated
+ Int accdigits; // count of digits accumulated
+
+ Unit varbuff[SD2U(DECBUFFER*2+DECDPUN)]; // buffer for var1
+ Unit *var1=varbuff; // -> var1 array for long subtraction
+ Unit *varalloc=NULL; // -> allocated buffer, iff used
+ Unit *msu1; // -> msu of var1
+
+ const Unit *var2; // -> var2 array
+ const Unit *msu2; // -> msu of var2
+ Int msu2plus; // msu2 plus one [does not vary]
+ eInt msu2pair; // msu2 pair plus one [does not vary]
+
+ Int var1units, var2units; // actual lengths
+ Int var2ulen; // logical length (units)
+ Int var1initpad=0; // var1 initial padding (digits)
+ Int maxdigits; // longest LHS or required acc length
+ Int mult; // multiplier for subtraction
+ Unit thisunit; // current unit being accumulated
+ Int residue; // for rounding
+ Int reqdigits=set->digits; // requested DIGITS
+ Int exponent; // working exponent
+ Int maxexponent=0; // DIVIDE maximum exponent if unrounded
+ uByte bits; // working sign
+ Unit *target; // work
+ const Unit *source; // ..
+ uInt const *pow; // ..
+ Int shift, cut; // ..
+ #if DECSUBSET
+ Int dropped; // work
+ #endif
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operands and set lostDigits status, as needed
+ if (lhs->digits>reqdigits) {
+ alloclhs=decRoundOperand(lhs, set, status);
+ if (alloclhs==NULL) break;
+ lhs=alloclhs;
+ }
+ if (rhs->digits>reqdigits) {
+ allocrhs=decRoundOperand(rhs, set, status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ bits=(lhs->bits^rhs->bits)&DECNEG; // assumed sign for divisions
+
+ // handle infinities and NaNs
+ if (SPECIALARGS) { // a special bit set
+ if (SPECIALARGS & (DECSNAN | DECNAN)) { // one or two NaNs
+ decNaNs(res, lhs, rhs, set, status);
+ break;
+ }
+ // one or two infinities
+ if (decNumberIsInfinite(lhs)) { // LHS (dividend) is infinite
+ if (decNumberIsInfinite(rhs) || // two infinities are invalid ..
+ op & (REMAINDER | REMNEAR)) { // as is remainder of infinity
+ *status|=DEC_Invalid_operation;
+ break;
+ }
+ // [Note that infinity/0 raises no exceptions]
+ decNumberZero(res);
+ res->bits=bits|DECINF; // set +/- infinity
+ break;
+ }
+ else { // RHS (divisor) is infinite
+ residue=0;
+ if (op&(REMAINDER|REMNEAR)) {
+ // result is [finished clone of] lhs
+ decCopyFit(res, lhs, set, &residue, status);
+ }
+ else { // a division
+ decNumberZero(res);
+ res->bits=bits; // set +/- zero
+ // for DIVIDEINT the exponent is always 0. For DIVIDE, result
+ // is a 0 with infinitely negative exponent, clamped to minimum
+ if (op&DIVIDE) {
+ res->exponent=set->emin-set->digits+1;
+ *status|=DEC_Clamped;
+ }
+ }
+ decFinish(res, set, &residue, status);
+ break;
+ }
+ }
+
+ // handle 0 rhs (x/0)
+ if (ISZERO(rhs)) { // x/0 is always exceptional
+ if (ISZERO(lhs)) {
+ decNumberZero(res); // [after lhs test]
+ *status|=DEC_Division_undefined;// 0/0 will become NaN
+ }
+ else {
+ decNumberZero(res);
+ if (op&(REMAINDER|REMNEAR)) *status|=DEC_Invalid_operation;
+ else {
+ *status|=DEC_Division_by_zero; // x/0
+ res->bits=bits|DECINF; // .. is +/- Infinity
+ }
+ }
+ break;}
+
+ // handle 0 lhs (0/x)
+ if (ISZERO(lhs)) { // 0/x [x!=0]
+ #if DECSUBSET
+ if (!set->extended) decNumberZero(res);
+ else {
+ #endif
+ if (op&DIVIDE) {
+ residue=0;
+ exponent=lhs->exponent-rhs->exponent; // ideal exponent
+ decNumberCopy(res, lhs); // [zeros always fit]
+ res->bits=bits; // sign as computed
+ res->exponent=exponent; // exponent, too
+ decFinalize(res, set, &residue, status); // check exponent
+ }
+ else if (op&DIVIDEINT) {
+ decNumberZero(res); // integer 0
+ res->bits=bits; // sign as computed
+ }
+ else { // a remainder
+ exponent=rhs->exponent; // [save in case overwrite]
+ decNumberCopy(res, lhs); // [zeros always fit]
+ if (exponent<res->exponent) res->exponent=exponent; // use lower
+ }
+ #if DECSUBSET
+ }
+ #endif
+ break;}
+
+ // Precalculate exponent. This starts off adjusted (and hence fits
+ // in 31 bits) and becomes the usual unadjusted exponent as the
+ // division proceeds. The order of evaluation is important, here,
+ // to avoid wrap.
+ exponent=(lhs->exponent+lhs->digits)-(rhs->exponent+rhs->digits);
+
+ // If the working exponent is -ve, then some quick exits are
+ // possible because the quotient is known to be <1
+ // [for REMNEAR, it needs to be < -1, as -0.5 could need work]
+ if (exponent<0 && !(op==DIVIDE)) {
+ if (op&DIVIDEINT) {
+ decNumberZero(res); // integer part is 0
+ #if DECSUBSET
+ if (set->extended)
+ #endif
+ res->bits=bits; // set +/- zero
+ break;}
+ // fastpath remainders so long as the lhs has the smaller
+ // (or equal) exponent
+ if (lhs->exponent<=rhs->exponent) {
+ if (op&REMAINDER || exponent<-1) {
+ // It is REMAINDER or safe REMNEAR; result is [finished
+ // clone of] lhs (r = x - 0*y)
+ residue=0;
+ decCopyFit(res, lhs, set, &residue, status);
+ decFinish(res, set, &residue, status);
+ break;
+ }
+ // [unsafe REMNEAR drops through]
+ }
+ } // fastpaths
+
+ /* Long (slow) division is needed; roll up the sleeves... */
+
+ // The accumulator will hold the quotient of the division.
+ // If it needs to be too long for stack storage, then allocate.
+ acclength=D2U(reqdigits+DECDPUN); // in Units
+ if (acclength*sizeof(Unit)>sizeof(accbuff)) {
+ // printf("malloc dvacc %ld units\n", acclength);
+ allocacc=(Unit *)malloc(acclength*sizeof(Unit));
+ if (allocacc==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ acc=allocacc; // use the allocated space
+ }
+
+ // var1 is the padded LHS ready for subtractions.
+ // If it needs to be too long for stack storage, then allocate.
+ // The maximum units needed for var1 (long subtraction) is:
+ // Enough for
+ // (rhs->digits+reqdigits-1) -- to allow full slide to right
+ // or (lhs->digits) -- to allow for long lhs
+ // whichever is larger
+ // +1 -- for rounding of slide to right
+ // +1 -- for leading 0s
+ // +1 -- for pre-adjust if a remainder or DIVIDEINT
+ // [Note: unused units do not participate in decUnitAddSub data]
+ maxdigits=rhs->digits+reqdigits-1;
+ if (lhs->digits>maxdigits) maxdigits=lhs->digits;
+ var1units=D2U(maxdigits)+2;
+ // allocate a guard unit above msu1 for REMAINDERNEAR
+ if (!(op&DIVIDE)) var1units++;
+ if ((var1units+1)*sizeof(Unit)>sizeof(varbuff)) {
+ // printf("malloc dvvar %ld units\n", var1units+1);
+ varalloc=(Unit *)malloc((var1units+1)*sizeof(Unit));
+ if (varalloc==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ var1=varalloc; // use the allocated space
+ }
+
+ // Extend the lhs and rhs to full long subtraction length. The lhs
+ // is truly extended into the var1 buffer, with 0 padding, so a
+ // subtract in place is always possible. The rhs (var2) has
+ // virtual padding (implemented by decUnitAddSub).
+ // One guard unit was allocated above msu1 for rem=rem+rem in
+ // REMAINDERNEAR.
+ msu1=var1+var1units-1; // msu of var1
+ source=lhs->lsu+D2U(lhs->digits)-1; // msu of input array
+ for (target=msu1; source>=lhs->lsu; source--, target--) *target=*source;
+ for (; target>=var1; target--) *target=0;
+
+ // rhs (var2) is left-aligned with var1 at the start
+ var2ulen=var1units; // rhs logical length (units)
+ var2units=D2U(rhs->digits); // rhs actual length (units)
+ var2=rhs->lsu; // -> rhs array
+ msu2=var2+var2units-1; // -> msu of var2 [never changes]
+ // now set up the variables which will be used for estimating the
+ // multiplication factor. If these variables are not exact, add
+ // 1 to make sure that the multiplier is never overestimated.
+ msu2plus=*msu2; // it's value ..
+ if (var2units>1) msu2plus++; // .. +1 if any more
+ msu2pair=(eInt)*msu2*(DECDPUNMAX+1);// top two pair ..
+ if (var2units>1) { // .. [else treat 2nd as 0]
+ msu2pair+=*(msu2-1); // ..
+ if (var2units>2) msu2pair++; // .. +1 if any more
+ }
+
+ // The calculation is working in units, which may have leading zeros,
+ // but the exponent was calculated on the assumption that they are
+ // both left-aligned. Adjust the exponent to compensate: add the
+ // number of leading zeros in var1 msu and subtract those in var2 msu.
+ // [This is actually done by counting the digits and negating, as
+ // lead1=DECDPUN-digits1, and similarly for lead2.]
+ for (pow=&powers[1]; *msu1>=*pow; pow++) exponent--;
+ for (pow=&powers[1]; *msu2>=*pow; pow++) exponent++;
+
+ // Now, if doing an integer divide or remainder, ensure that
+ // the result will be Unit-aligned. To do this, shift the var1
+ // accumulator towards least if need be. (It's much easier to
+ // do this now than to reassemble the residue afterwards, if
+ // doing a remainder.) Also ensure the exponent is not negative.
+ if (!(op&DIVIDE)) {
+ Unit *u; // work
+ // save the initial 'false' padding of var1, in digits
+ var1initpad=(var1units-D2U(lhs->digits))*DECDPUN;
+ // Determine the shift to do.
+ if (exponent<0) cut=-exponent;
+ else cut=DECDPUN-exponent%DECDPUN;
+ decShiftToLeast(var1, var1units, cut);
+ exponent+=cut; // maintain numerical value
+ var1initpad-=cut; // .. and reduce padding
+ // clean any most-significant units which were just emptied
+ for (u=msu1; cut>=DECDPUN; cut-=DECDPUN, u--) *u=0;
+ } // align
+ else { // is DIVIDE
+ maxexponent=lhs->exponent-rhs->exponent; // save
+ // optimization: if the first iteration will just produce 0,
+ // preadjust to skip it [valid for DIVIDE only]
+ if (*msu1<*msu2) {
+ var2ulen--; // shift down
+ exponent-=DECDPUN; // update the exponent
+ }
+ }
+
+ // ---- start the long-division loops ------------------------------
+ accunits=0; // no units accumulated yet
+ accdigits=0; // .. or digits
+ accnext=acc+acclength-1; // -> msu of acc [NB: allows digits+1]
+ for (;;) { // outer forever loop
+ thisunit=0; // current unit assumed 0
+ // find the next unit
+ for (;;) { // inner forever loop
+ // strip leading zero units [from either pre-adjust or from
+ // subtract last time around]. Leave at least one unit.
+ for (; *msu1==0 && msu1>var1; msu1--) var1units--;
+
+ if (var1units<var2ulen) break; // var1 too low for subtract
+ if (var1units==var2ulen) { // unit-by-unit compare needed
+ // compare the two numbers, from msu
+ const Unit *pv1, *pv2;
+ Unit v2; // units to compare
+ pv2=msu2; // -> msu
+ for (pv1=msu1; ; pv1--, pv2--) {
+ // v1=*pv1 -- always OK
+ v2=0; // assume in padding
+ if (pv2>=var2) v2=*pv2; // in range
+ if (*pv1!=v2) break; // no longer the same
+ if (pv1==var1) break; // done; leave pv1 as is
+ }
+ // here when all inspected or a difference seen
+ if (*pv1<v2) break; // var1 too low to subtract
+ if (*pv1==v2) { // var1 == var2
+ // reach here if var1 and var2 are identical; subtraction
+ // would increase digit by one, and the residue will be 0 so
+ // the calculation is done; leave the loop with residue=0.
+ thisunit++; // as though subtracted
+ *var1=0; // set var1 to 0
+ var1units=1; // ..
+ break; // from inner
+ } // var1 == var2
+ // *pv1>v2. Prepare for real subtraction; the lengths are equal
+ // Estimate the multiplier (there's always a msu1-1)...
+ // Bring in two units of var2 to provide a good estimate.
+ mult=(Int)(((eInt)*msu1*(DECDPUNMAX+1)+*(msu1-1))/msu2pair);
+ } // lengths the same
+ else { // var1units > var2ulen, so subtraction is safe
+ // The var2 msu is one unit towards the lsu of the var1 msu,
+ // so only one unit for var2 can be used.
+ mult=(Int)(((eInt)*msu1*(DECDPUNMAX+1)+*(msu1-1))/msu2plus);
+ }
+ if (mult==0) mult=1; // must always be at least 1
+ // subtraction needed; var1 is > var2
+ thisunit=(Unit)(thisunit+mult); // accumulate
+ // subtract var1-var2, into var1; only the overlap needs
+ // processing, as this is an in-place calculation
+ shift=var2ulen-var2units;
+ #if DECTRACE
+ decDumpAr('1', &var1[shift], var1units-shift);
+ decDumpAr('2', var2, var2units);
+ printf("m=%ld\n", -mult);
+ #endif
+ decUnitAddSub(&var1[shift], var1units-shift,
+ var2, var2units, 0,
+ &var1[shift], -mult);
+ #if DECTRACE
+ decDumpAr('#', &var1[shift], var1units-shift);
+ #endif
+ // var1 now probably has leading zeros; these are removed at the
+ // top of the inner loop.
+ } // inner loop
+
+ // The next unit has been calculated in full; unless it's a
+ // leading zero, add to acc
+ if (accunits!=0 || thisunit!=0) { // is first or non-zero
+ *accnext=thisunit; // store in accumulator
+ // account exactly for the new digits
+ if (accunits==0) {
+ accdigits++; // at least one
+ for (pow=&powers[1]; thisunit>=*pow; pow++) accdigits++;
+ }
+ else accdigits+=DECDPUN;
+ accunits++; // update count
+ accnext--; // ready for next
+ if (accdigits>reqdigits) break; // have enough digits
+ }
+
+ // if the residue is zero, the operation is done (unless divide
+ // or divideInteger and still not enough digits yet)
+ if (*var1==0 && var1units==1) { // residue is 0
+ if (op&(REMAINDER|REMNEAR)) break;
+ if ((op&DIVIDE) && (exponent<=maxexponent)) break;
+ // [drop through if divideInteger]
+ }
+ // also done enough if calculating remainder or integer
+ // divide and just did the last ('units') unit
+ if (exponent==0 && !(op&DIVIDE)) break;
+
+ // to get here, var1 is less than var2, so divide var2 by the per-
+ // Unit power of ten and go for the next digit
+ var2ulen--; // shift down
+ exponent-=DECDPUN; // update the exponent
+ } // outer loop
+
+ // ---- division is complete ---------------------------------------
+ // here: acc has at least reqdigits+1 of good results (or fewer
+ // if early stop), starting at accnext+1 (its lsu)
+ // var1 has any residue at the stopping point
+ // accunits is the number of digits collected in acc
+ if (accunits==0) { // acc is 0
+ accunits=1; // show have a unit ..
+ accdigits=1; // ..
+ *accnext=0; // .. whose value is 0
+ }
+ else accnext++; // back to last placed
+ // accnext now -> lowest unit of result
+
+ residue=0; // assume no residue
+ if (op&DIVIDE) {
+ // record the presence of any residue, for rounding
+ if (*var1!=0 || var1units>1) residue=1;
+ else { // no residue
+ // Had an exact division; clean up spurious trailing 0s.
+ // There will be at most DECDPUN-1, from the final multiply,
+ // and then only if the result is non-0 (and even) and the
+ // exponent is 'loose'.
+ #if DECDPUN>1
+ Unit lsu=*accnext;
+ if (!(lsu&0x01) && (lsu!=0)) {
+ // count the trailing zeros
+ Int drop=0;
+ for (;; drop++) { // [will terminate because lsu!=0]
+ if (exponent>=maxexponent) break; // don't chop real 0s
+ #if DECDPUN<=4
+ if ((lsu-QUOT10(lsu, drop+1)
+ *powers[drop+1])!=0) break; // found non-0 digit
+ #else
+ if (lsu%powers[drop+1]!=0) break; // found non-0 digit
+ #endif
+ exponent++;
+ }
+ if (drop>0) {
+ accunits=decShiftToLeast(accnext, accunits, drop);
+ accdigits=decGetDigits(accnext, accunits);
+ accunits=D2U(accdigits);
+ // [exponent was adjusted in the loop]
+ }
+ } // neither odd nor 0
+ #endif
+ } // exact divide
+ } // divide
+ else /* op!=DIVIDE */ {
+ // check for coefficient overflow
+ if (accdigits+exponent>reqdigits) {
+ *status|=DEC_Division_impossible;
+ break;
+ }
+ if (op & (REMAINDER|REMNEAR)) {
+ // [Here, the exponent will be 0, because var1 was adjusted
+ // appropriately.]
+ Int postshift; // work
+ Flag wasodd=0; // integer was odd
+ Unit *quotlsu; // for save
+ Int quotdigits; // ..
+
+ bits=lhs->bits; // remainder sign is always as lhs
+
+ // Fastpath when residue is truly 0 is worthwhile [and
+ // simplifies the code below]
+ if (*var1==0 && var1units==1) { // residue is 0
+ Int exp=lhs->exponent; // save min(exponents)
+ if (rhs->exponent<exp) exp=rhs->exponent;
+ decNumberZero(res); // 0 coefficient
+ #if DECSUBSET
+ if (set->extended)
+ #endif
+ res->exponent=exp; // .. with proper exponent
+ res->bits=(uByte)(bits&DECNEG); // [cleaned]
+ decFinish(res, set, &residue, status); // might clamp
+ break;
+ }
+ // note if the quotient was odd
+ if (*accnext & 0x01) wasodd=1; // acc is odd
+ quotlsu=accnext; // save in case need to reinspect
+ quotdigits=accdigits; // ..
+
+ // treat the residue, in var1, as the value to return, via acc
+ // calculate the unused zero digits. This is the smaller of:
+ // var1 initial padding (saved above)
+ // var2 residual padding, which happens to be given by:
+ postshift=var1initpad+exponent-lhs->exponent+rhs->exponent;
+ // [the 'exponent' term accounts for the shifts during divide]
+ if (var1initpad<postshift) postshift=var1initpad;
+
+ // shift var1 the requested amount, and adjust its digits
+ var1units=decShiftToLeast(var1, var1units, postshift);
+ accnext=var1;
+ accdigits=decGetDigits(var1, var1units);
+ accunits=D2U(accdigits);
+
+ exponent=lhs->exponent; // exponent is smaller of lhs & rhs
+ if (rhs->exponent<exponent) exponent=rhs->exponent;
+
+ // Now correct the result if doing remainderNear; if it
+ // (looking just at coefficients) is > rhs/2, or == rhs/2 and
+ // the integer was odd then the result should be rem-rhs.
+ if (op&REMNEAR) {
+ Int compare, tarunits; // work
+ Unit *up; // ..
+ // calculate remainder*2 into the var1 buffer (which has
+ // 'headroom' of an extra unit and hence enough space)
+ // [a dedicated 'double' loop would be faster, here]
+ tarunits=decUnitAddSub(accnext, accunits, accnext, accunits,
+ 0, accnext, 1);
+ // decDumpAr('r', accnext, tarunits);
+
+ // Here, accnext (var1) holds tarunits Units with twice the
+ // remainder's coefficient, which must now be compared to the
+ // RHS. The remainder's exponent may be smaller than the RHS's.
+ compare=decUnitCompare(accnext, tarunits, rhs->lsu, D2U(rhs->digits),
+ rhs->exponent-exponent);
+ if (compare==BADINT) { // deep trouble
+ *status|=DEC_Insufficient_storage;
+ break;}
+
+ // now restore the remainder by dividing by two; the lsu
+ // is known to be even.
+ for (up=accnext; up<accnext+tarunits; up++) {
+ Int half; // half to add to lower unit
+ half=*up & 0x01;
+ *up/=2; // [shift]
+ if (!half) continue;
+ *(up-1)+=(DECDPUNMAX+1)/2;
+ }
+ // [accunits still describes the original remainder length]
+
+ if (compare>0 || (compare==0 && wasodd)) { // adjustment needed
+ Int exp, expunits, exprem; // work
+ // This is effectively causing round-up of the quotient,
+ // so if it was the rare case where it was full and all
+ // nines, it would overflow and hence division-impossible
+ // should be raised
+ Flag allnines=0; // 1 if quotient all nines
+ if (quotdigits==reqdigits) { // could be borderline
+ for (up=quotlsu; ; up++) {
+ if (quotdigits>DECDPUN) {
+ if (*up!=DECDPUNMAX) break;// non-nines
+ }
+ else { // this is the last Unit
+ if (*up==powers[quotdigits]-1) allnines=1;
+ break;
+ }
+ quotdigits-=DECDPUN; // checked those digits
+ } // up
+ } // borderline check
+ if (allnines) {
+ *status|=DEC_Division_impossible;
+ break;}
+
+ // rem-rhs is needed; the sign will invert. Again, var1
+ // can safely be used for the working Units array.
+ exp=rhs->exponent-exponent; // RHS padding needed
+ // Calculate units and remainder from exponent.
+ expunits=exp/DECDPUN;
+ exprem=exp%DECDPUN;
+ // subtract [A+B*(-m)]; the result will always be negative
+ accunits=-decUnitAddSub(accnext, accunits,
+ rhs->lsu, D2U(rhs->digits),
+ expunits, accnext, -(Int)powers[exprem]);
+ accdigits=decGetDigits(accnext, accunits); // count digits exactly
+ accunits=D2U(accdigits); // and recalculate the units for copy
+ // [exponent is as for original remainder]
+ bits^=DECNEG; // flip the sign
+ }
+ } // REMNEAR
+ } // REMAINDER or REMNEAR
+ } // not DIVIDE
+
+ // Set exponent and bits
+ res->exponent=exponent;
+ res->bits=(uByte)(bits&DECNEG); // [cleaned]
+
+ // Now the coefficient.
+ decSetCoeff(res, set, accnext, accdigits, &residue, status);
+
+ decFinish(res, set, &residue, status); // final cleanup
+
+ #if DECSUBSET
+ // If a divide then strip trailing zeros if subset [after round]
+ if (!set->extended && (op==DIVIDE)) decTrim(res, set, 0, 1, &dropped);
+ #endif
+ } while(0); // end protected
+
+ if (varalloc!=NULL) free(varalloc); // drop any storage used
+ if (allocacc!=NULL) free(allocacc); // ..
+ #if DECSUBSET
+ if (allocrhs!=NULL) free(allocrhs); // ..
+ if (alloclhs!=NULL) free(alloclhs); // ..
+ #endif
+ return res;
+ } // decDivideOp
+
+/* ------------------------------------------------------------------ */
+/* decMultiplyOp -- multiplication operation */
+/* */
+/* This routine performs the multiplication C=A x B. */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X*X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* status is the usual accumulator */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* ------------------------------------------------------------------ */
+/* 'Classic' multiplication is used rather than Karatsuba, as the */
+/* latter would give only a minor improvement for the short numbers */
+/* expected to be handled most (and uses much more memory). */
+/* */
+/* There are two major paths here: the general-purpose ('old code') */
+/* path which handles all DECDPUN values, and a fastpath version */
+/* which is used if 64-bit ints are available, DECDPUN<=4, and more */
+/* than two calls to decUnitAddSub would be made. */
+/* */
+/* The fastpath version lumps units together into 8-digit or 9-digit */
+/* chunks, and also uses a lazy carry strategy to minimise expensive */
+/* 64-bit divisions. The chunks are then broken apart again into */
+/* units for continuing processing. Despite this overhead, the */
+/* fastpath can speed up some 16-digit operations by 10x (and much */
+/* more for higher-precision calculations). */
+/* */
+/* A buffer always has to be used for the accumulator; in the */
+/* fastpath, buffers are also always needed for the chunked copies of */
+/* of the operand coefficients. */
+/* Static buffers are larger than needed just for multiply, to allow */
+/* for calls from other operations (notably exp). */
+/* ------------------------------------------------------------------ */
+#define FASTMUL (DECUSE64 && DECDPUN<5)
+static decNumber * decMultiplyOp(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set,
+ uInt *status) {
+ Int accunits; // Units of accumulator in use
+ Int exponent; // work
+ Int residue=0; // rounding residue
+ uByte bits; // result sign
+ Unit *acc; // -> accumulator Unit array
+ Int needbytes; // size calculator
+ void *allocacc=NULL; // -> allocated accumulator, iff allocated
+ Unit accbuff[SD2U(DECBUFFER*4+1)]; // buffer (+1 for DECBUFFER==0,
+ // *4 for calls from other operations)
+ const Unit *mer, *mermsup; // work
+ Int madlength; // Units in multiplicand
+ Int shift; // Units to shift multiplicand by
+
+ #if FASTMUL
+ // if DECDPUN is 1 or 3 work in base 10**9, otherwise
+ // (DECDPUN is 2 or 4) then work in base 10**8
+ #if DECDPUN & 1 // odd
+ #define FASTBASE 1000000000 // base
+ #define FASTDIGS 9 // digits in base
+ #define FASTLAZY 18 // carry resolution point [1->18]
+ #else
+ #define FASTBASE 100000000
+ #define FASTDIGS 8
+ #define FASTLAZY 1844 // carry resolution point [1->1844]
+ #endif
+ // three buffers are used, two for chunked copies of the operands
+ // (base 10**8 or base 10**9) and one base 2**64 accumulator with
+ // lazy carry evaluation
+ uInt zlhibuff[(DECBUFFER*2+1)/8+1]; // buffer (+1 for DECBUFFER==0)
+ uInt *zlhi=zlhibuff; // -> lhs array
+ uInt *alloclhi=NULL; // -> allocated buffer, iff allocated
+ uInt zrhibuff[(DECBUFFER*2+1)/8+1]; // buffer (+1 for DECBUFFER==0)
+ uInt *zrhi=zrhibuff; // -> rhs array
+ uInt *allocrhi=NULL; // -> allocated buffer, iff allocated
+ uLong zaccbuff[(DECBUFFER*2+1)/4+2]; // buffer (+1 for DECBUFFER==0)
+ // [allocacc is shared for both paths, as only one will run]
+ uLong *zacc=zaccbuff; // -> accumulator array for exact result
+ #if DECDPUN==1
+ Int zoff; // accumulator offset
+ #endif
+ uInt *lip, *rip; // item pointers
+ uInt *lmsi, *rmsi; // most significant items
+ Int ilhs, irhs, iacc; // item counts in the arrays
+ Int lazy; // lazy carry counter
+ uLong lcarry; // uLong carry
+ uInt carry; // carry (NB not uLong)
+ Int count; // work
+ const Unit *cup; // ..
+ Unit *up; // ..
+ uLong *lp; // ..
+ Int p; // ..
+ #endif
+
+ #if DECSUBSET
+ decNumber *alloclhs=NULL; // -> allocated buffer, iff allocated
+ decNumber *allocrhs=NULL; // -> allocated buffer, iff allocated
+ #endif
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ // precalculate result sign
+ bits=(uByte)((lhs->bits^rhs->bits)&DECNEG);
+
+ // handle infinities and NaNs
+ if (SPECIALARGS) { // a special bit set
+ if (SPECIALARGS & (DECSNAN | DECNAN)) { // one or two NaNs
+ decNaNs(res, lhs, rhs, set, status);
+ return res;}
+ // one or two infinities; Infinity * 0 is invalid
+ if (((lhs->bits & DECINF)==0 && ISZERO(lhs))
+ ||((rhs->bits & DECINF)==0 && ISZERO(rhs))) {
+ *status|=DEC_Invalid_operation;
+ return res;}
+ decNumberZero(res);
+ res->bits=bits|DECINF; // infinity
+ return res;}
+
+ // For best speed, as in DMSRCN [the original Rexx numerics
+ // module], use the shorter number as the multiplier (rhs) and
+ // the longer as the multiplicand (lhs) to minimise the number of
+ // adds (partial products)
+ if (lhs->digits<rhs->digits) { // swap...
+ const decNumber *hold=lhs;
+ lhs=rhs;
+ rhs=hold;
+ }
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operands and set lostDigits status, as needed
+ if (lhs->digits>set->digits) {
+ alloclhs=decRoundOperand(lhs, set, status);
+ if (alloclhs==NULL) break;
+ lhs=alloclhs;
+ }
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ #if FASTMUL // fastpath can be used
+ // use the fast path if there are enough digits in the shorter
+ // operand to make the setup and takedown worthwhile
+ #define NEEDTWO (DECDPUN*2) // within two decUnitAddSub calls
+ if (rhs->digits>NEEDTWO) { // use fastpath...
+ // calculate the number of elements in each array
+ ilhs=(lhs->digits+FASTDIGS-1)/FASTDIGS; // [ceiling]
+ irhs=(rhs->digits+FASTDIGS-1)/FASTDIGS; // ..
+ iacc=ilhs+irhs;
+
+ // allocate buffers if required, as usual
+ needbytes=ilhs*sizeof(uInt);
+ if (needbytes>(Int)sizeof(zlhibuff)) {
+ alloclhi=(uInt *)malloc(needbytes);
+ zlhi=alloclhi;}
+ needbytes=irhs*sizeof(uInt);
+ if (needbytes>(Int)sizeof(zrhibuff)) {
+ allocrhi=(uInt *)malloc(needbytes);
+ zrhi=allocrhi;}
+
+ // Allocating the accumulator space needs a special case when
+ // DECDPUN=1 because when converting the accumulator to Units
+ // after the multiplication each 8-byte item becomes 9 1-byte
+ // units. Therefore iacc extra bytes are needed at the front
+ // (rounded up to a multiple of 8 bytes), and the uLong
+ // accumulator starts offset the appropriate number of units
+ // to the right to avoid overwrite during the unchunking.
+ needbytes=iacc*sizeof(uLong);
+ #if DECDPUN==1
+ zoff=(iacc+7)/8; // items to offset by
+ needbytes+=zoff*8;
+ #endif
+ if (needbytes>(Int)sizeof(zaccbuff)) {
+ allocacc=(uLong *)malloc(needbytes);
+ zacc=(uLong *)allocacc;}
+ if (zlhi==NULL||zrhi==NULL||zacc==NULL) {
+ *status|=DEC_Insufficient_storage;
+ break;}
+
+ acc=(Unit *)zacc; // -> target Unit array
+ #if DECDPUN==1
+ zacc+=zoff; // start uLong accumulator to right
+ #endif
+
+ // assemble the chunked copies of the left and right sides
+ for (count=lhs->digits, cup=lhs->lsu, lip=zlhi; count>0; lip++)
+ for (p=0, *lip=0; p<FASTDIGS && count>0;
+ p+=DECDPUN, cup++, count-=DECDPUN)
+ *lip+=*cup*powers[p];
+ lmsi=lip-1; // save -> msi
+ for (count=rhs->digits, cup=rhs->lsu, rip=zrhi; count>0; rip++)
+ for (p=0, *rip=0; p<FASTDIGS && count>0;
+ p+=DECDPUN, cup++, count-=DECDPUN)
+ *rip+=*cup*powers[p];
+ rmsi=rip-1; // save -> msi
+
+ // zero the accumulator
+ for (lp=zacc; lp<zacc+iacc; lp++) *lp=0;
+
+ /* Start the multiplication */
+ // Resolving carries can dominate the cost of accumulating the
+ // partial products, so this is only done when necessary.
+ // Each uLong item in the accumulator can hold values up to
+ // 2**64-1, and each partial product can be as large as
+ // (10**FASTDIGS-1)**2. When FASTDIGS=9, this can be added to
+ // itself 18.4 times in a uLong without overflowing, so during
+ // the main calculation resolution is carried out every 18th
+ // add -- every 162 digits. Similarly, when FASTDIGS=8, the
+ // partial products can be added to themselves 1844.6 times in
+ // a uLong without overflowing, so intermediate carry
+ // resolution occurs only every 14752 digits. Hence for common
+ // short numbers usually only the one final carry resolution
+ // occurs.
+ // (The count is set via FASTLAZY to simplify experiments to
+ // measure the value of this approach: a 35% improvement on a
+ // [34x34] multiply.)
+ lazy=FASTLAZY; // carry delay count
+ for (rip=zrhi; rip<=rmsi; rip++) { // over each item in rhs
+ lp=zacc+(rip-zrhi); // where to add the lhs
+ for (lip=zlhi; lip<=lmsi; lip++, lp++) { // over each item in lhs
+ *lp+=(uLong)(*lip)*(*rip); // [this should in-line]
+ } // lip loop
+ lazy--;
+ if (lazy>0 && rip!=rmsi) continue;
+ lazy=FASTLAZY; // reset delay count
+ // spin up the accumulator resolving overflows
+ for (lp=zacc; lp<zacc+iacc; lp++) {
+ if (*lp<FASTBASE) continue; // it fits
+ lcarry=*lp/FASTBASE; // top part [slow divide]
+ // lcarry can exceed 2**32-1, so check again; this check
+ // and occasional extra divide (slow) is well worth it, as
+ // it allows FASTLAZY to be increased to 18 rather than 4
+ // in the FASTDIGS=9 case
+ if (lcarry<FASTBASE) carry=(uInt)lcarry; // [usual]
+ else { // two-place carry [fairly rare]
+ uInt carry2=(uInt)(lcarry/FASTBASE); // top top part
+ *(lp+2)+=carry2; // add to item+2
+ *lp-=((uLong)FASTBASE*FASTBASE*carry2); // [slow]
+ carry=(uInt)(lcarry-((uLong)FASTBASE*carry2)); // [inline]
+ }
+ *(lp+1)+=carry; // add to item above [inline]
+ *lp-=((uLong)FASTBASE*carry); // [inline]
+ } // carry resolution
+ } // rip loop
+
+ // The multiplication is complete; time to convert back into
+ // units. This can be done in-place in the accumulator and in
+ // 32-bit operations, because carries were resolved after the
+ // final add. This needs N-1 divides and multiplies for
+ // each item in the accumulator (which will become up to N
+ // units, where 2<=N<=9).
+ for (lp=zacc, up=acc; lp<zacc+iacc; lp++) {
+ uInt item=(uInt)*lp; // decapitate to uInt
+ for (p=0; p<FASTDIGS-DECDPUN; p+=DECDPUN, up++) {
+ uInt part=item/(DECDPUNMAX+1);
+ *up=(Unit)(item-(part*(DECDPUNMAX+1)));
+ item=part;
+ } // p
+ *up=(Unit)item; up++; // [final needs no division]
+ } // lp
+ accunits=up-acc; // count of units
+ }
+ else { // here to use units directly, without chunking ['old code']
+ #endif
+
+ // if accumulator will be too long for local storage, then allocate
+ acc=accbuff; // -> assume buffer for accumulator
+ needbytes=(D2U(lhs->digits)+D2U(rhs->digits))*sizeof(Unit);
+ if (needbytes>(Int)sizeof(accbuff)) {
+ allocacc=(Unit *)malloc(needbytes);
+ if (allocacc==NULL) {*status|=DEC_Insufficient_storage; break;}
+ acc=(Unit *)allocacc; // use the allocated space
+ }
+
+ /* Now the main long multiplication loop */
+ // Unlike the equivalent in the IBM Java implementation, there
+ // is no advantage in calculating from msu to lsu. So, do it
+ // by the book, as it were.
+ // Each iteration calculates ACC=ACC+MULTAND*MULT
+ accunits=1; // accumulator starts at '0'
+ *acc=0; // .. (lsu=0)
+ shift=0; // no multiplicand shift at first
+ madlength=D2U(lhs->digits); // this won't change
+ mermsup=rhs->lsu+D2U(rhs->digits); // -> msu+1 of multiplier
+
+ for (mer=rhs->lsu; mer<mermsup; mer++) {
+ // Here, *mer is the next Unit in the multiplier to use
+ // If non-zero [optimization] add it...
+ if (*mer!=0) accunits=decUnitAddSub(&acc[shift], accunits-shift,
+ lhs->lsu, madlength, 0,
+ &acc[shift], *mer)
+ + shift;
+ else { // extend acc with a 0; it will be used shortly
+ *(acc+accunits)=0; // [this avoids length of <=0 later]
+ accunits++;
+ }
+ // multiply multiplicand by 10**DECDPUN for next Unit to left
+ shift++; // add this for 'logical length'
+ } // n
+ #if FASTMUL
+ } // unchunked units
+ #endif
+ // common end-path
+ #if DECTRACE
+ decDumpAr('*', acc, accunits); // Show exact result
+ #endif
+
+ // acc now contains the exact result of the multiplication,
+ // possibly with a leading zero unit; build the decNumber from
+ // it, noting if any residue
+ res->bits=bits; // set sign
+ res->digits=decGetDigits(acc, accunits); // count digits exactly
+
+ // There can be a 31-bit wrap in calculating the exponent.
+ // This can only happen if both input exponents are negative and
+ // both their magnitudes are large. If there was a wrap, set a
+ // safe very negative exponent, from which decFinalize() will
+ // raise a hard underflow shortly.
+ exponent=lhs->exponent+rhs->exponent; // calculate exponent
+ if (lhs->exponent<0 && rhs->exponent<0 && exponent>0)
+ exponent=-2*DECNUMMAXE; // force underflow
+ res->exponent=exponent; // OK to overwrite now
+
+
+ // Set the coefficient. If any rounding, residue records
+ decSetCoeff(res, set, acc, res->digits, &residue, status);
+ decFinish(res, set, &residue, status); // final cleanup
+ } while(0); // end protected
+
+ if (allocacc!=NULL) free(allocacc); // drop any storage used
+ #if DECSUBSET
+ if (allocrhs!=NULL) free(allocrhs); // ..
+ if (alloclhs!=NULL) free(alloclhs); // ..
+ #endif
+ #if FASTMUL
+ if (allocrhi!=NULL) free(allocrhi); // ..
+ if (alloclhi!=NULL) free(alloclhi); // ..
+ #endif
+ return res;
+ } // decMultiplyOp
+
+/* ------------------------------------------------------------------ */
+/* decExpOp -- effect exponentiation */
+/* */
+/* This computes C = exp(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context; note that rounding mode has no effect */
+/* */
+/* C must have space for set->digits digits. status is updated but */
+/* not set. */
+/* */
+/* Restrictions: */
+/* */
+/* digits, emax, and -emin in the context must be less than */
+/* 2*DEC_MAX_MATH (1999998), and the rhs must be within these */
+/* bounds or a zero. This is an internal routine, so these */
+/* restrictions are contractual and not enforced. */
+/* */
+/* A finite result is rounded using DEC_ROUND_HALF_EVEN; it will */
+/* almost always be correctly rounded, but may be up to 1 ulp in */
+/* error in rare cases. */
+/* */
+/* Finite results will always be full precision and Inexact, except */
+/* when A is a zero or -Infinity (giving 1 or 0 respectively). */
+/* ------------------------------------------------------------------ */
+/* This approach used here is similar to the algorithm described in */
+/* */
+/* Variable Precision Exponential Function, T. E. Hull and */
+/* A. Abrham, ACM Transactions on Mathematical Software, Vol 12 #2, */
+/* pp79-91, ACM, June 1986. */
+/* */
+/* with the main difference being that the iterations in the series */
+/* evaluation are terminated dynamically (which does not require the */
+/* extra variable-precision variables which are expensive in this */
+/* context). */
+/* */
+/* The error analysis in Hull & Abrham's paper applies except for the */
+/* round-off error accumulation during the series evaluation. This */
+/* code does not precalculate the number of iterations and so cannot */
+/* use Horner's scheme. Instead, the accumulation is done at double- */
+/* precision, which ensures that the additions of the terms are exact */
+/* and do not accumulate round-off (and any round-off errors in the */
+/* terms themselves move 'to the right' faster than they can */
+/* accumulate). This code also extends the calculation by allowing, */
+/* in the spirit of other decNumber operators, the input to be more */
+/* precise than the result (the precision used is based on the more */
+/* precise of the input or requested result). */
+/* */
+/* Implementation notes: */
+/* */
+/* 1. This is separated out as decExpOp so it can be called from */
+/* other Mathematical functions (notably Ln) with a wider range */
+/* than normal. In particular, it can handle the slightly wider */
+/* (double) range needed by Ln (which has to be able to calculate */
+/* exp(-x) where x can be the tiniest number (Ntiny). */
+/* */
+/* 2. Normalizing x to be <=0.1 (instead of <=1) reduces loop */
+/* iterations by appoximately a third with additional (although */
+/* diminishing) returns as the range is reduced to even smaller */
+/* fractions. However, h (the power of 10 used to correct the */
+/* result at the end, see below) must be kept <=8 as otherwise */
+/* the final result cannot be computed. Hence the leverage is a */
+/* sliding value (8-h), where potentially the range is reduced */
+/* more for smaller values. */
+/* */
+/* The leverage that can be applied in this way is severely */
+/* limited by the cost of the raise-to-the power at the end, */
+/* which dominates when the number of iterations is small (less */
+/* than ten) or when rhs is short. As an example, the adjustment */
+/* x**10,000,000 needs 31 multiplications, all but one full-width. */
+/* */
+/* 3. The restrictions (especially precision) could be raised with */
+/* care, but the full decNumber range seems very hard within the */
+/* 32-bit limits. */
+/* */
+/* 4. The working precisions for the static buffers are twice the */
+/* obvious size to allow for calls from decNumberPower. */
+/* ------------------------------------------------------------------ */
+decNumber * decExpOp(decNumber *res, const decNumber *rhs,
+ decContext *set, uInt *status) {
+ uInt ignore=0; // working status
+ Int h; // adjusted exponent for 0.xxxx
+ Int p; // working precision
+ Int residue; // rounding residue
+ uInt needbytes; // for space calculations
+ const decNumber *x=rhs; // (may point to safe copy later)
+ decContext aset, tset, dset; // working contexts
+ Int comp; // work
+
+ // the argument is often copied to normalize it, so (unusually) it
+ // is treated like other buffers, using DECBUFFER, +1 in case
+ // DECBUFFER is 0
+ decNumber bufr[D2N(DECBUFFER*2+1)];
+ decNumber *allocrhs=NULL; // non-NULL if rhs buffer allocated
+
+ // the working precision will be no more than set->digits+8+1
+ // so for on-stack buffers DECBUFFER+9 is used, +1 in case DECBUFFER
+ // is 0 (and twice that for the accumulator)
+
+ // buffer for t, term (working precision plus)
+ decNumber buft[D2N(DECBUFFER*2+9+1)];
+ decNumber *allocbuft=NULL; // -> allocated buft, iff allocated
+ decNumber *t=buft; // term
+ // buffer for a, accumulator (working precision * 2), at least 9
+ decNumber bufa[D2N(DECBUFFER*4+18+1)];
+ decNumber *allocbufa=NULL; // -> allocated bufa, iff allocated
+ decNumber *a=bufa; // accumulator
+ // decNumber for the divisor term; this needs at most 9 digits
+ // and so can be fixed size [16 so can use standard context]
+ decNumber bufd[D2N(16)];
+ decNumber *d=bufd; // divisor
+ decNumber numone; // constant 1
+
+ #if DECCHECK
+ Int iterations=0; // for later sanity check
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ if (SPECIALARG) { // handle infinities and NaNs
+ if (decNumberIsInfinite(rhs)) { // an infinity
+ if (decNumberIsNegative(rhs)) // -Infinity -> +0
+ decNumberZero(res);
+ else decNumberCopy(res, rhs); // +Infinity -> self
+ }
+ else decNaNs(res, rhs, NULL, set, status); // a NaN
+ break;}
+
+ if (ISZERO(rhs)) { // zeros -> exact 1
+ decNumberZero(res); // make clean 1
+ *res->lsu=1; // ..
+ break;} // [no status to set]
+
+ // e**x when 0 < x < 0.66 is < 1+3x/2, hence can fast-path
+ // positive and negative tiny cases which will result in inexact
+ // 1. This also allows the later add-accumulate to always be
+ // exact (because its length will never be more than twice the
+ // working precision).
+ // The comparator (tiny) needs just one digit, so use the
+ // decNumber d for it (reused as the divisor, etc., below); its
+ // exponent is such that if x is positive it will have
+ // set->digits-1 zeros between the decimal point and the digit,
+ // which is 4, and if x is negative one more zero there as the
+ // more precise result will be of the form 0.9999999 rather than
+ // 1.0000001. Hence, tiny will be 0.0000004 if digits=7 and x>0
+ // or 0.00000004 if digits=7 and x<0. If RHS not larger than
+ // this then the result will be 1.000000
+ decNumberZero(d); // clean
+ *d->lsu=4; // set 4 ..
+ d->exponent=-set->digits; // * 10**(-d)
+ if (decNumberIsNegative(rhs)) d->exponent--; // negative case
+ comp=decCompare(d, rhs, 1); // signless compare
+ if (comp==BADINT) {
+ *status|=DEC_Insufficient_storage;
+ break;}
+ if (comp>=0) { // rhs < d
+ Int shift=set->digits-1;
+ decNumberZero(res); // set 1
+ *res->lsu=1; // ..
+ res->digits=decShiftToMost(res->lsu, 1, shift);
+ res->exponent=-shift; // make 1.0000...
+ *status|=DEC_Inexact | DEC_Rounded; // .. inexactly
+ break;} // tiny
+
+ // set up the context to be used for calculating a, as this is
+ // used on both paths below
+ decContextDefault(&aset, DEC_INIT_DECIMAL64);
+ // accumulator bounds are as requested (could underflow)
+ aset.emax=set->emax; // usual bounds
+ aset.emin=set->emin; // ..
+ aset.clamp=0; // and no concrete format
+
+ // calculate the adjusted (Hull & Abrham) exponent (where the
+ // decimal point is just to the left of the coefficient msd)
+ h=rhs->exponent+rhs->digits;
+ // if h>8 then 10**h cannot be calculated safely; however, when
+ // h=8 then exp(|rhs|) will be at least exp(1E+7) which is at
+ // least 6.59E+4342944, so (due to the restriction on Emax/Emin)
+ // overflow (or underflow to 0) is guaranteed -- so this case can
+ // be handled by simply forcing the appropriate excess
+ if (h>8) { // overflow/underflow
+ // set up here so Power call below will over or underflow to
+ // zero; set accumulator to either 2 or 0.02
+ // [stack buffer for a is always big enough for this]
+ decNumberZero(a);
+ *a->lsu=2; // not 1 but < exp(1)
+ if (decNumberIsNegative(rhs)) a->exponent=-2; // make 0.02
+ h=8; // clamp so 10**h computable
+ p=9; // set a working precision
+ }
+ else { // h<=8
+ Int maxlever=(rhs->digits>8?1:0);
+ // [could/should increase this for precisions >40 or so, too]
+
+ // if h is 8, cannot normalize to a lower upper limit because
+ // the final result will not be computable (see notes above),
+ // but leverage can be applied whenever h is less than 8.
+ // Apply as much as possible, up to a MAXLEVER digits, which
+ // sets the tradeoff against the cost of the later a**(10**h).
+ // As h is increased, the working precision below also
+ // increases to compensate for the "constant digits at the
+ // front" effect.
+ Int lever=MINI(8-h, maxlever); // leverage attainable
+ Int use=-rhs->digits-lever; // exponent to use for RHS
+ h+=lever; // apply leverage selected
+ if (h<0) { // clamp
+ use+=h; // [may end up subnormal]
+ h=0;
+ }
+ // Take a copy of RHS if it needs normalization (true whenever x>=1)
+ if (rhs->exponent!=use) {
+ decNumber *newrhs=bufr; // assume will fit on stack
+ needbytes=sizeof(decNumber)+(D2U(rhs->digits)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufr)) { // need malloc space
+ allocrhs=(decNumber *)malloc(needbytes);
+ if (allocrhs==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ newrhs=allocrhs; // use the allocated space
+ }
+ decNumberCopy(newrhs, rhs); // copy to safe space
+ newrhs->exponent=use; // normalize; now <1
+ x=newrhs; // ready for use
+ // decNumberShow(x);
+ }
+
+ // Now use the usual power series to evaluate exp(x). The
+ // series starts as 1 + x + x^2/2 ... so prime ready for the
+ // third term by setting the term variable t=x, the accumulator
+ // a=1, and the divisor d=2.
+
+ // First determine the working precision. From Hull & Abrham
+ // this is set->digits+h+2. However, if x is 'over-precise' we
+ // need to allow for all its digits to potentially participate
+ // (consider an x where all the excess digits are 9s) so in
+ // this case use x->digits+h+2
+ p=MAXI(x->digits, set->digits)+h+2; // [h<=8]
+
+ // a and t are variable precision, and depend on p, so space
+ // must be allocated for them if necessary
+
+ // the accumulator needs to be able to hold 2p digits so that
+ // the additions on the second and subsequent iterations are
+ // sufficiently exact.
+ needbytes=sizeof(decNumber)+(D2U(p*2)-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufa)) { // need malloc space
+ allocbufa=(decNumber *)malloc(needbytes);
+ if (allocbufa==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ a=allocbufa; // use the allocated space
+ }
+ // the term needs to be able to hold p digits (which is
+ // guaranteed to be larger than x->digits, so the initial copy
+ // is safe); it may also be used for the raise-to-power
+ // calculation below, which needs an extra two digits
+ needbytes=sizeof(decNumber)+(D2U(p+2)-1)*sizeof(Unit);
+ if (needbytes>sizeof(buft)) { // need malloc space
+ allocbuft=(decNumber *)malloc(needbytes);
+ if (allocbuft==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ t=allocbuft; // use the allocated space
+ }
+
+ decNumberCopy(t, x); // term=x
+ decNumberZero(a); *a->lsu=1; // accumulator=1
+ decNumberZero(d); *d->lsu=2; // divisor=2
+ decNumberZero(&numone); *numone.lsu=1; // constant 1 for increment
+
+ // set up the contexts for calculating a, t, and d
+ decContextDefault(&tset, DEC_INIT_DECIMAL64);
+ dset=tset;
+ // accumulator bounds are set above, set precision now
+ aset.digits=p*2; // double
+ // term bounds avoid any underflow or overflow
+ tset.digits=p;
+ tset.emin=DEC_MIN_EMIN; // [emax is plenty]
+ // [dset.digits=16, etc., are sufficient]
+
+ // finally ready to roll
+ for (;;) {
+ #if DECCHECK
+ iterations++;
+ #endif
+ // only the status from the accumulation is interesting
+ // [but it should remain unchanged after first add]
+ decAddOp(a, a, t, &aset, 0, status); // a=a+t
+ decMultiplyOp(t, t, x, &tset, &ignore); // t=t*x
+ decDivideOp(t, t, d, &tset, DIVIDE, &ignore); // t=t/d
+ // the iteration ends when the term cannot affect the result,
+ // if rounded to p digits, which is when its value is smaller
+ // than the accumulator by p+1 digits. There must also be
+ // full precision in a.
+ if (((a->digits+a->exponent)>=(t->digits+t->exponent+p+1))
+ && (a->digits>=p)) break;
+ decAddOp(d, d, &numone, &dset, 0, &ignore); // d=d+1
+ } // iterate
+
+ #if DECCHECK
+ // just a sanity check; comment out test to show always
+ if (iterations>p+3)
+ printf("Exp iterations=%ld, status=%08lx, p=%ld, d=%ld\n",
+ (LI)iterations, (LI)*status, (LI)p, (LI)x->digits);
+ #endif
+ } // h<=8
+
+ // apply postconditioning: a=a**(10**h) -- this is calculated
+ // at a slightly higher precision than Hull & Abrham suggest
+ if (h>0) {
+ Int seenbit=0; // set once a 1-bit is seen
+ Int i; // counter
+ Int n=powers[h]; // always positive
+ aset.digits=p+2; // sufficient precision
+ // avoid the overhead and many extra digits of decNumberPower
+ // as all that is needed is the short 'multipliers' loop; here
+ // accumulate the answer into t
+ decNumberZero(t); *t->lsu=1; // acc=1
+ for (i=1;;i++){ // for each bit [top bit ignored]
+ // abandon if have had overflow or terminal underflow
+ if (*status & (DEC_Overflow|DEC_Underflow)) { // interesting?
+ if (*status&DEC_Overflow || ISZERO(t)) break;}
+ n=n<<1; // move next bit to testable position
+ if (n<0) { // top bit is set
+ seenbit=1; // OK, have a significant bit
+ decMultiplyOp(t, t, a, &aset, status); // acc=acc*x
+ }
+ if (i==31) break; // that was the last bit
+ if (!seenbit) continue; // no need to square 1
+ decMultiplyOp(t, t, t, &aset, status); // acc=acc*acc [square]
+ } /*i*/ // 32 bits
+ // decNumberShow(t);
+ a=t; // and carry on using t instead of a
+ }
+
+ // Copy and round the result to res
+ residue=1; // indicate dirt to right ..
+ if (ISZERO(a)) residue=0; // .. unless underflowed to 0
+ aset.digits=set->digits; // [use default rounding]
+ decCopyFit(res, a, &aset, &residue, status); // copy & shorten
+ decFinish(res, set, &residue, status); // cleanup/set flags
+ } while(0); // end protected
+
+ if (allocrhs !=NULL) free(allocrhs); // drop any storage used
+ if (allocbufa!=NULL) free(allocbufa); // ..
+ if (allocbuft!=NULL) free(allocbuft); // ..
+ // [status is handled by caller]
+ return res;
+ } // decExpOp
+
+/* ------------------------------------------------------------------ */
+/* Initial-estimate natural logarithm table */
+/* */
+/* LNnn -- 90-entry 16-bit table for values from .10 through .99. */
+/* The result is a 4-digit encode of the coefficient (c=the */
+/* top 14 bits encoding 0-9999) and a 2-digit encode of the */
+/* exponent (e=the bottom 2 bits encoding 0-3) */
+/* */
+/* The resulting value is given by: */
+/* */
+/* v = -c * 10**(-e-3) */
+/* */
+/* where e and c are extracted from entry k = LNnn[x-10] */
+/* where x is truncated (NB) into the range 10 through 99, */
+/* and then c = k>>2 and e = k&3. */
+/* ------------------------------------------------------------------ */
+const uShort LNnn[90]={9016, 8652, 8316, 8008, 7724, 7456, 7208,
+ 6972, 6748, 6540, 6340, 6148, 5968, 5792, 5628, 5464, 5312,
+ 5164, 5020, 4884, 4748, 4620, 4496, 4376, 4256, 4144, 4032,
+ 39233, 38181, 37157, 36157, 35181, 34229, 33297, 32389, 31501, 30629,
+ 29777, 28945, 28129, 27329, 26545, 25777, 25021, 24281, 23553, 22837,
+ 22137, 21445, 20769, 20101, 19445, 18801, 18165, 17541, 16925, 16321,
+ 15721, 15133, 14553, 13985, 13421, 12865, 12317, 11777, 11241, 10717,
+ 10197, 9685, 9177, 8677, 8185, 7697, 7213, 6737, 6269, 5801,
+ 5341, 4889, 4437, 39930, 35534, 31186, 26886, 22630, 18418, 14254,
+ 10130, 6046, 20055};
+
+/* ------------------------------------------------------------------ */
+/* decLnOp -- effect natural logarithm */
+/* */
+/* This computes C = ln(A) */
+/* */
+/* res is C, the result. C may be A */
+/* rhs is A */
+/* set is the context; note that rounding mode has no effect */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Notable cases: */
+/* A<0 -> Invalid */
+/* A=0 -> -Infinity (Exact) */
+/* A=+Infinity -> +Infinity (Exact) */
+/* A=1 exactly -> 0 (Exact) */
+/* */
+/* Restrictions (as for Exp): */
+/* */
+/* digits, emax, and -emin in the context must be less than */
+/* DEC_MAX_MATH+11 (1000010), and the rhs must be within these */
+/* bounds or a zero. This is an internal routine, so these */
+/* restrictions are contractual and not enforced. */
+/* */
+/* A finite result is rounded using DEC_ROUND_HALF_EVEN; it will */
+/* almost always be correctly rounded, but may be up to 1 ulp in */
+/* error in rare cases. */
+/* ------------------------------------------------------------------ */
+/* The result is calculated using Newton's method, with each */
+/* iteration calculating a' = a + x * exp(-a) - 1. See, for example, */
+/* Epperson 1989. */
+/* */
+/* The iteration ends when the adjustment x*exp(-a)-1 is tiny enough. */
+/* This has to be calculated at the sum of the precision of x and the */
+/* working precision. */
+/* */
+/* Implementation notes: */
+/* */
+/* 1. This is separated out as decLnOp so it can be called from */
+/* other Mathematical functions (e.g., Log 10) with a wider range */
+/* than normal. In particular, it can handle the slightly wider */
+/* (+9+2) range needed by a power function. */
+/* */
+/* 2. The speed of this function is about 10x slower than exp, as */
+/* it typically needs 4-6 iterations for short numbers, and the */
+/* extra precision needed adds a squaring effect, twice. */
+/* */
+/* 3. Fastpaths are included for ln(10) and ln(2), up to length 40, */
+/* as these are common requests. ln(10) is used by log10(x). */
+/* */
+/* 4. An iteration might be saved by widening the LNnn table, and */
+/* would certainly save at least one if it were made ten times */
+/* bigger, too (for truncated fractions 0.100 through 0.999). */
+/* However, for most practical evaluations, at least four or five */
+/* iterations will be neede -- so this would only speed up by */
+/* 20-25% and that probably does not justify increasing the table */
+/* size. */
+/* */
+/* 5. The static buffers are larger than might be expected to allow */
+/* for calls from decNumberPower. */
+/* ------------------------------------------------------------------ */
+decNumber * decLnOp(decNumber *res, const decNumber *rhs,
+ decContext *set, uInt *status) {
+ uInt ignore=0; // working status accumulator
+ uInt needbytes; // for space calculations
+ Int residue; // rounding residue
+ Int r; // rhs=f*10**r [see below]
+ Int p; // working precision
+ Int pp; // precision for iteration
+ Int t; // work
+
+ // buffers for a (accumulator, typically precision+2) and b
+ // (adjustment calculator, same size)
+ decNumber bufa[D2N(DECBUFFER+12)];
+ decNumber *allocbufa=NULL; // -> allocated bufa, iff allocated
+ decNumber *a=bufa; // accumulator/work
+ decNumber bufb[D2N(DECBUFFER*2+2)];
+ decNumber *allocbufb=NULL; // -> allocated bufa, iff allocated
+ decNumber *b=bufb; // adjustment/work
+
+ decNumber numone; // constant 1
+ decNumber cmp; // work
+ decContext aset, bset; // working contexts
+
+ #if DECCHECK
+ Int iterations=0; // for later sanity check
+ if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ if (SPECIALARG) { // handle infinities and NaNs
+ if (decNumberIsInfinite(rhs)) { // an infinity
+ if (decNumberIsNegative(rhs)) // -Infinity -> error
+ *status|=DEC_Invalid_operation;
+ else decNumberCopy(res, rhs); // +Infinity -> self
+ }
+ else decNaNs(res, rhs, NULL, set, status); // a NaN
+ break;}
+
+ if (ISZERO(rhs)) { // +/- zeros -> -Infinity
+ decNumberZero(res); // make clean
+ res->bits=DECINF|DECNEG; // set - infinity
+ break;} // [no status to set]
+
+ // Non-zero negatives are bad...
+ if (decNumberIsNegative(rhs)) { // -x -> error
+ *status|=DEC_Invalid_operation;
+ break;}
+
+ // Here, rhs is positive, finite, and in range
+
+ // lookaside fastpath code for ln(2) and ln(10) at common lengths
+ if (rhs->exponent==0 && set->digits<=40) {
+ #if DECDPUN==1
+ if (rhs->lsu[0]==0 && rhs->lsu[1]==1 && rhs->digits==2) { // ln(10)
+ #else
+ if (rhs->lsu[0]==10 && rhs->digits==2) { // ln(10)
+ #endif
+ aset=*set; aset.round=DEC_ROUND_HALF_EVEN;
+ #define LN10 "2.302585092994045684017991454684364207601"
+ decNumberFromString(res, LN10, &aset);
+ *status|=(DEC_Inexact | DEC_Rounded); // is inexact
+ break;}
+ if (rhs->lsu[0]==2 && rhs->digits==1) { // ln(2)
+ aset=*set; aset.round=DEC_ROUND_HALF_EVEN;
+ #define LN2 "0.6931471805599453094172321214581765680755"
+ decNumberFromString(res, LN2, &aset);
+ *status|=(DEC_Inexact | DEC_Rounded);
+ break;}
+ } // integer and short
+
+ // Determine the working precision. This is normally the
+ // requested precision + 2, with a minimum of 9. However, if
+ // the rhs is 'over-precise' then allow for all its digits to
+ // potentially participate (consider an rhs where all the excess
+ // digits are 9s) so in this case use rhs->digits+2.
+ p=MAXI(rhs->digits, MAXI(set->digits, 7))+2;
+
+ // Allocate space for the accumulator and the high-precision
+ // adjustment calculator, if necessary. The accumulator must
+ // be able to hold p digits, and the adjustment up to
+ // rhs->digits+p digits. They are also made big enough for 16
+ // digits so that they can be used for calculating the initial
+ // estimate.
+ needbytes=sizeof(decNumber)+(D2U(MAXI(p,16))-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufa)) { // need malloc space
+ allocbufa=(decNumber *)malloc(needbytes);
+ if (allocbufa==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ a=allocbufa; // use the allocated space
+ }
+ pp=p+rhs->digits;
+ needbytes=sizeof(decNumber)+(D2U(MAXI(pp,16))-1)*sizeof(Unit);
+ if (needbytes>sizeof(bufb)) { // need malloc space
+ allocbufb=(decNumber *)malloc(needbytes);
+ if (allocbufb==NULL) { // hopeless -- abandon
+ *status|=DEC_Insufficient_storage;
+ break;}
+ b=allocbufb; // use the allocated space
+ }
+
+ // Prepare an initial estimate in acc. Calculate this by
+ // considering the coefficient of x to be a normalized fraction,
+ // f, with the decimal point at far left and multiplied by
+ // 10**r. Then, rhs=f*10**r and 0.1<=f<1, and
+ // ln(x) = ln(f) + ln(10)*r
+ // Get the initial estimate for ln(f) from a small lookup
+ // table (see above) indexed by the first two digits of f,
+ // truncated.
+
+ decContextDefault(&aset, DEC_INIT_DECIMAL64); // 16-digit extended
+ r=rhs->exponent+rhs->digits; // 'normalised' exponent
+ decNumberFromInt32(a, r); // a=r
+ decNumberFromInt32(b, 2302585); // b=ln(10) (2.302585)
+ b->exponent=-6; // ..
+ decMultiplyOp(a, a, b, &aset, &ignore); // a=a*b
+ // now get top two digits of rhs into b by simple truncate and
+ // force to integer
+ residue=0; // (no residue)
+ aset.digits=2; aset.round=DEC_ROUND_DOWN;
+ decCopyFit(b, rhs, &aset, &residue, &ignore); // copy & shorten
+ b->exponent=0; // make integer
+ t=decGetInt(b); // [cannot fail]
+ if (t<10) t=X10(t); // adjust single-digit b
+ t=LNnn[t-10]; // look up ln(b)
+ decNumberFromInt32(b, t>>2); // b=ln(b) coefficient
+ b->exponent=-(t&3)-3; // set exponent
+ b->bits=DECNEG; // ln(0.10)->ln(0.99) always -ve
+ aset.digits=16; aset.round=DEC_ROUND_HALF_EVEN; // restore
+ decAddOp(a, a, b, &aset, 0, &ignore); // acc=a+b
+ // the initial estimate is now in a, with up to 4 digits correct.
+ // When rhs is at or near Nmax the estimate will be low, so we
+ // will approach it from below, avoiding overflow when calling exp.
+
+ decNumberZero(&numone); *numone.lsu=1; // constant 1 for adjustment
+
+ // accumulator bounds are as requested (could underflow, but
+ // cannot overflow)
+ aset.emax=set->emax;
+ aset.emin=set->emin;
+ aset.clamp=0; // no concrete format
+ // set up a context to be used for the multiply and subtract
+ bset=aset;
+ bset.emax=DEC_MAX_MATH*2; // use double bounds for the
+ bset.emin=-DEC_MAX_MATH*2; // adjustment calculation
+ // [see decExpOp call below]
+ // for each iteration double the number of digits to calculate,
+ // up to a maximum of p
+ pp=9; // initial precision
+ // [initially 9 as then the sequence starts 7+2, 16+2, and
+ // 34+2, which is ideal for standard-sized numbers]
+ aset.digits=pp; // working context
+ bset.digits=pp+rhs->digits; // wider context
+ for (;;) { // iterate
+ #if DECCHECK
+ iterations++;
+ if (iterations>24) break; // consider 9 * 2**24
+ #endif
+ // calculate the adjustment (exp(-a)*x-1) into b. This is a
+ // catastrophic subtraction but it really is the difference
+ // from 1 that is of interest.
+ // Use the internal entry point to Exp as it allows the double
+ // range for calculating exp(-a) when a is the tiniest subnormal.
+ a->bits^=DECNEG; // make -a
+ decExpOp(b, a, &bset, &ignore); // b=exp(-a)
+ a->bits^=DECNEG; // restore sign of a
+ // now multiply by rhs and subtract 1, at the wider precision
+ decMultiplyOp(b, b, rhs, &bset, &ignore); // b=b*rhs
+ decAddOp(b, b, &numone, &bset, DECNEG, &ignore); // b=b-1
+
+ // the iteration ends when the adjustment cannot affect the
+ // result by >=0.5 ulp (at the requested digits), which
+ // is when its value is smaller than the accumulator by
+ // set->digits+1 digits (or it is zero) -- this is a looser
+ // requirement than for Exp because all that happens to the
+ // accumulator after this is the final rounding (but note that
+ // there must also be full precision in a, or a=0).
+
+ if (decNumberIsZero(b) ||
+ (a->digits+a->exponent)>=(b->digits+b->exponent+set->digits+1)) {
+ if (a->digits==p) break;
+ if (decNumberIsZero(a)) {
+ decCompareOp(&cmp, rhs, &numone, &aset, COMPARE, &ignore); // rhs=1 ?
+ if (cmp.lsu[0]==0) a->exponent=0; // yes, exact 0
+ else *status|=(DEC_Inexact | DEC_Rounded); // no, inexact
+ break;
+ }
+ // force padding if adjustment has gone to 0 before full length
+ if (decNumberIsZero(b)) b->exponent=a->exponent-p;
+ }
+
+ // not done yet ...
+ decAddOp(a, a, b, &aset, 0, &ignore); // a=a+b for next estimate
+ if (pp==p) continue; // precision is at maximum
+ // lengthen the next calculation
+ pp=pp*2; // double precision
+ if (pp>p) pp=p; // clamp to maximum
+ aset.digits=pp; // working context
+ bset.digits=pp+rhs->digits; // wider context
+ } // Newton's iteration
+
+ #if DECCHECK
+ // just a sanity check; remove the test to show always
+ if (iterations>24)
+ printf("Ln iterations=%ld, status=%08lx, p=%ld, d=%ld\n",
+ (LI)iterations, (LI)*status, (LI)p, (LI)rhs->digits);
+ #endif
+
+ // Copy and round the result to res
+ residue=1; // indicate dirt to right
+ if (ISZERO(a)) residue=0; // .. unless underflowed to 0
+ aset.digits=set->digits; // [use default rounding]
+ decCopyFit(res, a, &aset, &residue, status); // copy & shorten
+ decFinish(res, set, &residue, status); // cleanup/set flags
+ } while(0); // end protected
+
+ if (allocbufa!=NULL) free(allocbufa); // drop any storage used
+ if (allocbufb!=NULL) free(allocbufb); // ..
+ // [status is handled by caller]
+ return res;
+ } // decLnOp
+
+/* ------------------------------------------------------------------ */
+/* decQuantizeOp -- force exponent to requested value */
+/* */
+/* This computes C = op(A, B), where op adjusts the coefficient */
+/* of C (by rounding or shifting) such that the exponent (-scale) */
+/* of C has the value B or matches the exponent of B. */
+/* The numerical value of C will equal A, except for the effects of */
+/* any rounding that occurred. */
+/* */
+/* res is C, the result. C may be A or B */
+/* lhs is A, the number to adjust */
+/* rhs is B, the requested exponent */
+/* set is the context */
+/* quant is 1 for quantize or 0 for rescale */
+/* status is the status accumulator (this can be called without */
+/* risk of control loss) */
+/* */
+/* C must have space for set->digits digits. */
+/* */
+/* Unless there is an error or the result is infinite, the exponent */
+/* after the operation is guaranteed to be that requested. */
+/* ------------------------------------------------------------------ */
+static decNumber * decQuantizeOp(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set,
+ Flag quant, uInt *status) {
+ #if DECSUBSET
+ decNumber *alloclhs=NULL; // non-NULL if rounded lhs allocated
+ decNumber *allocrhs=NULL; // .., rhs
+ #endif
+ const decNumber *inrhs=rhs; // save original rhs
+ Int reqdigits=set->digits; // requested DIGITS
+ Int reqexp; // requested exponent [-scale]
+ Int residue=0; // rounding residue
+ Int etiny=set->emin-(reqdigits-1);
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operands and set lostDigits status, as needed
+ if (lhs->digits>reqdigits) {
+ alloclhs=decRoundOperand(lhs, set, status);
+ if (alloclhs==NULL) break;
+ lhs=alloclhs;
+ }
+ if (rhs->digits>reqdigits) { // [this only checks lostDigits]
+ allocrhs=decRoundOperand(rhs, set, status);
+ if (allocrhs==NULL) break;
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ // Handle special values
+ if (SPECIALARGS) {
+ // NaNs get usual processing
+ if (SPECIALARGS & (DECSNAN | DECNAN))
+ decNaNs(res, lhs, rhs, set, status);
+ // one infinity but not both is bad
+ else if ((lhs->bits ^ rhs->bits) & DECINF)
+ *status|=DEC_Invalid_operation;
+ // both infinity: return lhs
+ else decNumberCopy(res, lhs); // [nop if in place]
+ break;
+ }
+
+ // set requested exponent
+ if (quant) reqexp=inrhs->exponent; // quantize -- match exponents
+ else { // rescale -- use value of rhs
+ // Original rhs must be an integer that fits and is in range,
+ // which could be from -1999999997 to +999999999, thanks to
+ // subnormals
+ reqexp=decGetInt(inrhs); // [cannot fail]
+ }
+
+ #if DECSUBSET
+ if (!set->extended) etiny=set->emin; // no subnormals
+ #endif
+
+ if (reqexp==BADINT // bad (rescale only) or ..
+ || reqexp==BIGODD || reqexp==BIGEVEN // very big (ditto) or ..
+ || (reqexp<etiny) // < lowest
+ || (reqexp>set->emax)) { // > emax
+ *status|=DEC_Invalid_operation;
+ break;}
+
+ // the RHS has been processed, so it can be overwritten now if necessary
+ if (ISZERO(lhs)) { // zero coefficient unchanged
+ decNumberCopy(res, lhs); // [nop if in place]
+ res->exponent=reqexp; // .. just set exponent
+ #if DECSUBSET
+ if (!set->extended) res->bits=0; // subset specification; no -0
+ #endif
+ }
+ else { // non-zero lhs
+ Int adjust=reqexp-lhs->exponent; // digit adjustment needed
+ // if adjusted coefficient will definitely not fit, give up now
+ if ((lhs->digits-adjust)>reqdigits) {
+ *status|=DEC_Invalid_operation;
+ break;
+ }
+
+ if (adjust>0) { // increasing exponent
+ // this will decrease the length of the coefficient by adjust
+ // digits, and must round as it does so
+ decContext workset; // work
+ workset=*set; // clone rounding, etc.
+ workset.digits=lhs->digits-adjust; // set requested length
+ // [note that the latter can be <1, here]
+ decCopyFit(res, lhs, &workset, &residue, status); // fit to result
+ decApplyRound(res, &workset, residue, status); // .. and round
+ residue=0; // [used]
+ // If just rounded a 999s case, exponent will be off by one;
+ // adjust back (after checking space), if so.
+ if (res->exponent>reqexp) {
+ // re-check needed, e.g., for quantize(0.9999, 0.001) under
+ // set->digits==3
+ if (res->digits==reqdigits) { // cannot shift by 1
+ *status&=~(DEC_Inexact | DEC_Rounded); // [clean these]
+ *status|=DEC_Invalid_operation;
+ break;
+ }
+ res->digits=decShiftToMost(res->lsu, res->digits, 1); // shift
+ res->exponent--; // (re)adjust the exponent.
+ }
+ #if DECSUBSET
+ if (ISZERO(res) && !set->extended) res->bits=0; // subset; no -0
+ #endif
+ } // increase
+ else /* adjust<=0 */ { // decreasing or = exponent
+ // this will increase the length of the coefficient by -adjust
+ // digits, by adding zero or more trailing zeros; this is
+ // already checked for fit, above
+ decNumberCopy(res, lhs); // [it will fit]
+ // if padding needed (adjust<0), add it now...
+ if (adjust<0) {
+ res->digits=decShiftToMost(res->lsu, res->digits, -adjust);
+ res->exponent+=adjust; // adjust the exponent
+ }
+ } // decrease
+ } // non-zero
+
+ // Check for overflow [do not use Finalize in this case, as an
+ // overflow here is a "don't fit" situation]
+ if (res->exponent>set->emax-res->digits+1) { // too big
+ *status|=DEC_Invalid_operation;
+ break;
+ }
+ else {
+ decFinalize(res, set, &residue, status); // set subnormal flags
+ *status&=~DEC_Underflow; // suppress Underflow [as per 754]
+ }
+ } while(0); // end protected
+
+ #if DECSUBSET
+ if (allocrhs!=NULL) free(allocrhs); // drop any storage used
+ if (alloclhs!=NULL) free(alloclhs); // ..
+ #endif
+ return res;
+ } // decQuantizeOp
+
+/* ------------------------------------------------------------------ */
+/* decCompareOp -- compare, min, or max two Numbers */
+/* */
+/* This computes C = A ? B and carries out one of four operations: */
+/* COMPARE -- returns the signum (as a number) giving the */
+/* result of a comparison unless one or both */
+/* operands is a NaN (in which case a NaN results) */
+/* COMPSIG -- as COMPARE except that a quiet NaN raises */
+/* Invalid operation. */
+/* COMPMAX -- returns the larger of the operands, using the */
+/* 754 maxnum operation */
+/* COMPMAXMAG -- ditto, comparing absolute values */
+/* COMPMIN -- the 754 minnum operation */
+/* COMPMINMAG -- ditto, comparing absolute values */
+/* COMTOTAL -- returns the signum (as a number) giving the */
+/* result of a comparison using 754 total ordering */
+/* */
+/* res is C, the result. C may be A and/or B (e.g., X=X?X) */
+/* lhs is A */
+/* rhs is B */
+/* set is the context */
+/* op is the operation flag */
+/* status is the usual accumulator */
+/* */
+/* C must have space for one digit for COMPARE or set->digits for */
+/* COMPMAX, COMPMIN, COMPMAXMAG, or COMPMINMAG. */
+/* ------------------------------------------------------------------ */
+/* The emphasis here is on speed for common cases, and avoiding */
+/* coefficient comparison if possible. */
+/* ------------------------------------------------------------------ */
+decNumber * decCompareOp(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set,
+ Flag op, uInt *status) {
+ #if DECSUBSET
+ decNumber *alloclhs=NULL; // non-NULL if rounded lhs allocated
+ decNumber *allocrhs=NULL; // .., rhs
+ #endif
+ Int result=0; // default result value
+ uByte merged; // work
+
+ #if DECCHECK
+ if (decCheckOperands(res, lhs, rhs, set)) return res;
+ #endif
+
+ do { // protect allocated storage
+ #if DECSUBSET
+ if (!set->extended) {
+ // reduce operands and set lostDigits status, as needed
+ if (lhs->digits>set->digits) {
+ alloclhs=decRoundOperand(lhs, set, status);
+ if (alloclhs==NULL) {result=BADINT; break;}
+ lhs=alloclhs;
+ }
+ if (rhs->digits>set->digits) {
+ allocrhs=decRoundOperand(rhs, set, status);
+ if (allocrhs==NULL) {result=BADINT; break;}
+ rhs=allocrhs;
+ }
+ }
+ #endif
+ // [following code does not require input rounding]
+
+ // If total ordering then handle differing signs 'up front'
+ if (op==COMPTOTAL) { // total ordering
+ if (decNumberIsNegative(lhs) & !decNumberIsNegative(rhs)) {
+ result=-1;
+ break;
+ }
+ if (!decNumberIsNegative(lhs) & decNumberIsNegative(rhs)) {
+ result=+1;
+ break;
+ }
+ }
+
+ // handle NaNs specially; let infinities drop through
+ // This assumes sNaN (even just one) leads to NaN.
+ merged=(lhs->bits | rhs->bits) & (DECSNAN | DECNAN);
+ if (merged) { // a NaN bit set
+ if (op==COMPARE); // result will be NaN
+ else if (op==COMPSIG) // treat qNaN as sNaN
+ *status|=DEC_Invalid_operation | DEC_sNaN;
+ else if (op==COMPTOTAL) { // total ordering, always finite
+ // signs are known to be the same; compute the ordering here
+ // as if the signs are both positive, then invert for negatives
+ if (!decNumberIsNaN(lhs)) result=-1;
+ else if (!decNumberIsNaN(rhs)) result=+1;
+ // here if both NaNs
+ else if (decNumberIsSNaN(lhs) && decNumberIsQNaN(rhs)) result=-1;
+ else if (decNumberIsQNaN(lhs) && decNumberIsSNaN(rhs)) result=+1;
+ else { // both NaN or both sNaN
+ // now it just depends on the payload
+ result=decUnitCompare(lhs->lsu, D2U(lhs->digits),
+ rhs->lsu, D2U(rhs->digits), 0);
+ // [Error not possible, as these are 'aligned']
+ } // both same NaNs
+ if (decNumberIsNegative(lhs)) result=-result;
+ break;
+ } // total order
+
+ else if (merged & DECSNAN); // sNaN -> qNaN
+ else { // here if MIN or MAX and one or two quiet NaNs
+ // min or max -- 754 rules ignore single NaN
+ if (!decNumberIsNaN(lhs) || !decNumberIsNaN(rhs)) {
+ // just one NaN; force choice to be the non-NaN operand
+ op=COMPMAX;
+ if (lhs->bits & DECNAN) result=-1; // pick rhs
+ else result=+1; // pick lhs
+ break;
+ }
+ } // max or min
+ op=COMPNAN; // use special path
+ decNaNs(res, lhs, rhs, set, status); // propagate NaN
+ break;
+ }
+ // have numbers
+ if (op==COMPMAXMAG || op==COMPMINMAG) result=decCompare(lhs, rhs, 1);
+ else result=decCompare(lhs, rhs, 0); // sign matters
+ } while(0); // end protected
+
+ if (result==BADINT) *status|=DEC_Insufficient_storage; // rare
+ else {
+ if (op==COMPARE || op==COMPSIG ||op==COMPTOTAL) { // returning signum
+ if (op==COMPTOTAL && result==0) {
+ // operands are numerically equal or same NaN (and same sign,
+ // tested first); if identical, leave result 0
+ if (lhs->exponent!=rhs->exponent) {
+ if (lhs->exponent<rhs->exponent) result=-1;
+ else result=+1;
+ if (decNumberIsNegative(lhs)) result=-result;
+ } // lexp!=rexp
+ } // total-order by exponent
+ decNumberZero(res); // [always a valid result]
+ if (result!=0) { // must be -1 or +1
+ *res->lsu=1;
+ if (result<0) res->bits=DECNEG;
+ }
+ }
+ else if (op==COMPNAN); // special, drop through
+ else { // MAX or MIN, non-NaN result
+ Int residue=0; // rounding accumulator
+ // choose the operand for the result
+ const decNumber *choice;
+ if (result==0) { // operands are numerically equal
+ // choose according to sign then exponent (see 754)
+ uByte slhs=(lhs->bits & DECNEG);
+ uByte srhs=(rhs->bits & DECNEG);
+ #if DECSUBSET
+ if (!set->extended) { // subset: force left-hand
+ op=COMPMAX;
+ result=+1;
+ }
+ else
+ #endif
+ if (slhs!=srhs) { // signs differ
+ if (slhs) result=-1; // rhs is max
+ else result=+1; // lhs is max
+ }
+ else if (slhs && srhs) { // both negative
+ if (lhs->exponent<rhs->exponent) result=+1;
+ else result=-1;
+ // [if equal, use lhs, technically identical]
+ }
+ else { // both positive
+ if (lhs->exponent>rhs->exponent) result=+1;
+ else result=-1;
+ // [ditto]
+ }
+ } // numerically equal
+ // here result will be non-0; reverse if looking for MIN
+ if (op==COMPMIN || op==COMPMINMAG) result=-result;
+ choice=(result>0 ? lhs : rhs); // choose
+ // copy chosen to result, rounding if need be
+ decCopyFit(res, choice, set, &residue, status);
+ decFinish(res, set, &residue, status);
+ }
+ }
+ #if DECSUBSET
+ if (allocrhs!=NULL) free(allocrhs); // free any storage used
+ if (alloclhs!=NULL) free(alloclhs); // ..
+ #endif
+ return res;
+ } // decCompareOp
+
+/* ------------------------------------------------------------------ */
+/* decCompare -- compare two decNumbers by numerical value */
+/* */
+/* This routine compares A ? B without altering them. */
+/* */
+/* Arg1 is A, a decNumber which is not a NaN */
+/* Arg2 is B, a decNumber which is not a NaN */
+/* Arg3 is 1 for a sign-independent compare, 0 otherwise */
+/* */
+/* returns -1, 0, or 1 for A<B, A==B, or A>B, or BADINT if failure */
+/* (the only possible failure is an allocation error) */
+/* ------------------------------------------------------------------ */
+static Int decCompare(const decNumber *lhs, const decNumber *rhs,
+ Flag abs) {
+ Int result; // result value
+ Int sigr; // rhs signum
+ Int compare; // work
+
+ result=1; // assume signum(lhs)
+ if (ISZERO(lhs)) result=0;
+ if (abs) {
+ if (ISZERO(rhs)) return result; // LHS wins or both 0
+ // RHS is non-zero
+ if (result==0) return -1; // LHS is 0; RHS wins
+ // [here, both non-zero, result=1]
+ }
+ else { // signs matter
+ if (result && decNumberIsNegative(lhs)) result=-1;
+ sigr=1; // compute signum(rhs)
+ if (ISZERO(rhs)) sigr=0;
+ else if (decNumberIsNegative(rhs)) sigr=-1;
+ if (result > sigr) return +1; // L > R, return 1
+ if (result < sigr) return -1; // L < R, return -1
+ if (result==0) return 0; // both 0
+ }
+
+ // signums are the same; both are non-zero
+ if ((lhs->bits | rhs->bits) & DECINF) { // one or more infinities
+ if (decNumberIsInfinite(rhs)) {
+ if (decNumberIsInfinite(lhs)) result=0;// both infinite
+ else result=-result; // only rhs infinite
+ }
+ return result;
+ }
+ // must compare the coefficients, allowing for exponents
+ if (lhs->exponent>rhs->exponent) { // LHS exponent larger
+ // swap sides, and sign
+ const decNumber *temp=lhs;
+ lhs=rhs;
+ rhs=temp;
+ result=-result;
+ }
+ compare=decUnitCompare(lhs->lsu, D2U(lhs->digits),
+ rhs->lsu, D2U(rhs->digits),
+ rhs->exponent-lhs->exponent);
+ if (compare!=BADINT) compare*=result; // comparison succeeded
+ return compare;
+ } // decCompare
+
+/* ------------------------------------------------------------------ */
+/* decUnitCompare -- compare two >=0 integers in Unit arrays */
+/* */
+/* This routine compares A ? B*10**E where A and B are unit arrays */
+/* A is a plain integer */
+/* B has an exponent of E (which must be non-negative) */
+/* */
+/* Arg1 is A first Unit (lsu) */
+/* Arg2 is A length in Units */
+/* Arg3 is B first Unit (lsu) */
+/* Arg4 is B length in Units */
+/* Arg5 is E (0 if the units are aligned) */
+/* */
+/* returns -1, 0, or 1 for A<B, A==B, or A>B, or BADINT if failure */
+/* (the only possible failure is an allocation error, which can */
+/* only occur if E!=0) */
+/* ------------------------------------------------------------------ */
+static Int decUnitCompare(const Unit *a, Int alength,
+ const Unit *b, Int blength, Int exp) {
+ Unit *acc; // accumulator for result
+ Unit accbuff[SD2U(DECBUFFER*2+1)]; // local buffer
+ Unit *allocacc=NULL; // -> allocated acc buffer, iff allocated
+ Int accunits, need; // units in use or needed for acc
+ const Unit *l, *r, *u; // work
+ Int expunits, exprem, result; // ..
+
+ if (exp==0) { // aligned; fastpath
+ if (alength>blength) return 1;
+ if (alength<blength) return -1;
+ // same number of units in both -- need unit-by-unit compare
+ l=a+alength-1;
+ r=b+alength-1;
+ for (;l>=a; l--, r--) {
+ if (*l>*r) return 1;
+ if (*l<*r) return -1;
+ }
+ return 0; // all units match
+ } // aligned
+
+ // Unaligned. If one is >1 unit longer than the other, padded
+ // approximately, then can return easily
+ if (alength>blength+(Int)D2U(exp)) return 1;
+ if (alength+1<blength+(Int)D2U(exp)) return -1;
+
+ // Need to do a real subtract. For this, a result buffer is needed
+ // even though only the sign is of interest. Its length needs
+ // to be the larger of alength and padded blength, +2
+ need=blength+D2U(exp); // maximum real length of B
+ if (need<alength) need=alength;
+ need+=2;
+ acc=accbuff; // assume use local buffer
+ if (need*sizeof(Unit)>sizeof(accbuff)) {
+ allocacc=(Unit *)malloc(need*sizeof(Unit));
+ if (allocacc==NULL) return BADINT; // hopeless -- abandon
+ acc=allocacc;
+ }
+ // Calculate units and remainder from exponent.
+ expunits=exp/DECDPUN;
+ exprem=exp%DECDPUN;
+ // subtract [A+B*(-m)]
+ accunits=decUnitAddSub(a, alength, b, blength, expunits, acc,
+ -(Int)powers[exprem]);
+ // [UnitAddSub result may have leading zeros, even on zero]
+ if (accunits<0) result=-1; // negative result
+ else { // non-negative result
+ // check units of the result before freeing any storage
+ for (u=acc; u<acc+accunits-1 && *u==0;) u++;
+ result=(*u==0 ? 0 : +1);
+ }
+ // clean up and return the result
+ if (allocacc!=NULL) free(allocacc); // drop any storage used
+ return result;
+ } // decUnitCompare
+
+/* ------------------------------------------------------------------ */
+/* decUnitAddSub -- add or subtract two >=0 integers in Unit arrays */
+/* */
+/* This routine performs the calculation: */
+/* */
+/* C=A+(B*M) */
+/* */
+/* Where M is in the range -DECDPUNMAX through +DECDPUNMAX. */
+/* */
+/* A may be shorter or longer than B. */
+/* */
+/* Leading zeros are not removed after a calculation. The result is */
+/* either the same length as the longer of A and B (adding any */
+/* shift), or one Unit longer than that (if a Unit carry occurred). */
+/* */
+/* A and B content are not altered unless C is also A or B. */
+/* C may be the same array as A or B, but only if no zero padding is */
+/* requested (that is, C may be B only if bshift==0). */
+/* C is filled from the lsu; only those units necessary to complete */
+/* the calculation are referenced. */
+/* */
+/* Arg1 is A first Unit (lsu) */
+/* Arg2 is A length in Units */
+/* Arg3 is B first Unit (lsu) */
+/* Arg4 is B length in Units */
+/* Arg5 is B shift in Units (>=0; pads with 0 units if positive) */
+/* Arg6 is C first Unit (lsu) */
+/* Arg7 is M, the multiplier */
+/* */
+/* returns the count of Units written to C, which will be non-zero */
+/* and negated if the result is negative. That is, the sign of the */
+/* returned Int is the sign of the result (positive for zero) and */
+/* the absolute value of the Int is the count of Units. */
+/* */
+/* It is the caller's responsibility to make sure that C size is */
+/* safe, allowing space if necessary for a one-Unit carry. */
+/* */
+/* This routine is severely performance-critical; *any* change here */
+/* must be measured (timed) to assure no performance degradation. */
+/* In particular, trickery here tends to be counter-productive, as */
+/* increased complexity of code hurts register optimizations on */
+/* register-poor architectures. Avoiding divisions is nearly */
+/* always a Good Idea, however. */
+/* */
+/* Special thanks to Rick McGuire (IBM Cambridge, MA) and Dave Clark */
+/* (IBM Warwick, UK) for some of the ideas used in this routine. */
+/* ------------------------------------------------------------------ */
+static Int decUnitAddSub(const Unit *a, Int alength,
+ const Unit *b, Int blength, Int bshift,
+ Unit *c, Int m) {
+ const Unit *alsu=a; // A lsu [need to remember it]
+ Unit *clsu=c; // C ditto
+ Unit *minC; // low water mark for C
+ Unit *maxC; // high water mark for C
+ eInt carry=0; // carry integer (could be Long)
+ Int add; // work
+ #if DECDPUN<=4 // myriadal, millenary, etc.
+ Int est; // estimated quotient
+ #endif
+
+ #if DECTRACE
+ if (alength<1 || blength<1)
+ printf("decUnitAddSub: alen blen m %ld %ld [%ld]\n", alength, blength, m);
+ #endif
+
+ maxC=c+alength; // A is usually the longer
+ minC=c+blength; // .. and B the shorter
+ if (bshift!=0) { // B is shifted; low As copy across
+ minC+=bshift;
+ // if in place [common], skip copy unless there's a gap [rare]
+ if (a==c && bshift<=alength) {
+ c+=bshift;
+ a+=bshift;
+ }
+ else for (; c<clsu+bshift; a++, c++) { // copy needed
+ if (a<alsu+alength) *c=*a;
+ else *c=0;
+ }
+ }
+ if (minC>maxC) { // swap
+ Unit *hold=minC;
+ minC=maxC;
+ maxC=hold;
+ }
+
+ // For speed, do the addition as two loops; the first where both A
+ // and B contribute, and the second (if necessary) where only one or
+ // other of the numbers contribute.
+ // Carry handling is the same (i.e., duplicated) in each case.
+ for (; c<minC; c++) {
+ carry+=*a;
+ a++;
+ carry+=((eInt)*b)*m; // [special-casing m=1/-1
+ b++; // here is not a win]
+ // here carry is new Unit of digits; it could be +ve or -ve
+ if ((ueInt)carry<=DECDPUNMAX) { // fastpath 0-DECDPUNMAX
+ *c=(Unit)carry;
+ carry=0;
+ continue;
+ }
+ #if DECDPUN==4 // use divide-by-multiply
+ if (carry>=0) {
+ est=(((ueInt)carry>>11)*53687)>>18;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder
+ carry=est; // likely quotient [89%]
+ if (*c<DECDPUNMAX+1) continue; // estimate was correct
+ carry++;
+ *c-=DECDPUNMAX+1;
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ est=(((ueInt)carry>>11)*53687)>>18;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1));
+ carry=est-(DECDPUNMAX+1); // correctly negative
+ if (*c<DECDPUNMAX+1) continue; // was OK
+ carry++;
+ *c-=DECDPUNMAX+1;
+ #elif DECDPUN==3
+ if (carry>=0) {
+ est=(((ueInt)carry>>3)*16777)>>21;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder
+ carry=est; // likely quotient [99%]
+ if (*c<DECDPUNMAX+1) continue; // estimate was correct
+ carry++;
+ *c-=DECDPUNMAX+1;
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ est=(((ueInt)carry>>3)*16777)>>21;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1));
+ carry=est-(DECDPUNMAX+1); // correctly negative
+ if (*c<DECDPUNMAX+1) continue; // was OK
+ carry++;
+ *c-=DECDPUNMAX+1;
+ #elif DECDPUN<=2
+ // Can use QUOT10 as carry <= 4 digits
+ if (carry>=0) {
+ est=QUOT10(carry, DECDPUN);
+ *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder
+ carry=est; // quotient
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ est=QUOT10(carry, DECDPUN);
+ *c=(Unit)(carry-est*(DECDPUNMAX+1));
+ carry=est-(DECDPUNMAX+1); // correctly negative
+ #else
+ // remainder operator is undefined if negative, so must test
+ if ((ueInt)carry<(DECDPUNMAX+1)*2) { // fastpath carry +1
+ *c=(Unit)(carry-(DECDPUNMAX+1)); // [helps additions]
+ carry=1;
+ continue;
+ }
+ if (carry>=0) {
+ *c=(Unit)(carry%(DECDPUNMAX+1));
+ carry=carry/(DECDPUNMAX+1);
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ *c=(Unit)(carry%(DECDPUNMAX+1));
+ carry=carry/(DECDPUNMAX+1)-(DECDPUNMAX+1);
+ #endif
+ } // c
+
+ // now may have one or other to complete
+ // [pretest to avoid loop setup/shutdown]
+ if (c<maxC) for (; c<maxC; c++) {
+ if (a<alsu+alength) { // still in A
+ carry+=*a;
+ a++;
+ }
+ else { // inside B
+ carry+=((eInt)*b)*m;
+ b++;
+ }
+ // here carry is new Unit of digits; it could be +ve or -ve and
+ // magnitude up to DECDPUNMAX squared
+ if ((ueInt)carry<=DECDPUNMAX) { // fastpath 0-DECDPUNMAX
+ *c=(Unit)carry;
+ carry=0;
+ continue;
+ }
+ // result for this unit is negative or >DECDPUNMAX
+ #if DECDPUN==4 // use divide-by-multiply
+ if (carry>=0) {
+ est=(((ueInt)carry>>11)*53687)>>18;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder
+ carry=est; // likely quotient [79.7%]
+ if (*c<DECDPUNMAX+1) continue; // estimate was correct
+ carry++;
+ *c-=DECDPUNMAX+1;
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ est=(((ueInt)carry>>11)*53687)>>18;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1));
+ carry=est-(DECDPUNMAX+1); // correctly negative
+ if (*c<DECDPUNMAX+1) continue; // was OK
+ carry++;
+ *c-=DECDPUNMAX+1;
+ #elif DECDPUN==3
+ if (carry>=0) {
+ est=(((ueInt)carry>>3)*16777)>>21;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder
+ carry=est; // likely quotient [99%]
+ if (*c<DECDPUNMAX+1) continue; // estimate was correct
+ carry++;
+ *c-=DECDPUNMAX+1;
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ est=(((ueInt)carry>>3)*16777)>>21;
+ *c=(Unit)(carry-est*(DECDPUNMAX+1));
+ carry=est-(DECDPUNMAX+1); // correctly negative
+ if (*c<DECDPUNMAX+1) continue; // was OK
+ carry++;
+ *c-=DECDPUNMAX+1;
+ #elif DECDPUN<=2
+ if (carry>=0) {
+ est=QUOT10(carry, DECDPUN);
+ *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder
+ carry=est; // quotient
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ est=QUOT10(carry, DECDPUN);
+ *c=(Unit)(carry-est*(DECDPUNMAX+1));
+ carry=est-(DECDPUNMAX+1); // correctly negative
+ #else
+ if ((ueInt)carry<(DECDPUNMAX+1)*2){ // fastpath carry 1
+ *c=(Unit)(carry-(DECDPUNMAX+1));
+ carry=1;
+ continue;
+ }
+ // remainder operator is undefined if negative, so must test
+ if (carry>=0) {
+ *c=(Unit)(carry%(DECDPUNMAX+1));
+ carry=carry/(DECDPUNMAX+1);
+ continue;
+ }
+ // negative case
+ carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); // make positive
+ *c=(Unit)(carry%(DECDPUNMAX+1));
+ carry=carry/(DECDPUNMAX+1)-(DECDPUNMAX+1);
+ #endif
+ } // c
+
+ // OK, all A and B processed; might still have carry or borrow
+ // return number of Units in the result, negated if a borrow
+ if (carry==0) return c-clsu; // no carry, so no more to do
+ if (carry>0) { // positive carry
+ *c=(Unit)carry; // place as new unit
+ c++; // ..
+ return c-clsu;
+ }
+ // -ve carry: it's a borrow; complement needed
+ add=1; // temporary carry...
+ for (c=clsu; c<maxC; c++) {
+ add=DECDPUNMAX+add-*c;
+ if (add<=DECDPUNMAX) {
+ *c=(Unit)add;
+ add=0;
+ }
+ else {
+ *c=0;
+ add=1;
+ }
+ }
+ // add an extra unit iff it would be non-zero
+ #if DECTRACE
+ printf("UAS borrow: add %ld, carry %ld\n", add, carry);
+ #endif
+ if ((add-carry-1)!=0) {
+ *c=(Unit)(add-carry-1);
+ c++; // interesting, include it
+ }
+ return clsu-c; // -ve result indicates borrowed
+ } // decUnitAddSub
+
+/* ------------------------------------------------------------------ */
+/* decTrim -- trim trailing zeros or normalize */
+/* */
+/* dn is the number to trim or normalize */
+/* set is the context to use to check for clamp */
+/* all is 1 to remove all trailing zeros, 0 for just fraction ones */
+/* noclamp is 1 to unconditional (unclamped) trim */
+/* dropped returns the number of discarded trailing zeros */
+/* returns dn */
+/* */
+/* If clamp is set in the context then the number of zeros trimmed */
+/* may be limited if the exponent is high. */
+/* All fields are updated as required. This is a utility operation, */
+/* so special values are unchanged and no error is possible. */
+/* ------------------------------------------------------------------ */
+static decNumber * decTrim(decNumber *dn, decContext *set, Flag all,
+ Flag noclamp, Int *dropped) {
+ Int d, exp; // work
+ uInt cut; // ..
+ Unit *up; // -> current Unit
+
+ #if DECCHECK
+ if (decCheckOperands(dn, DECUNUSED, DECUNUSED, DECUNCONT)) return dn;
+ #endif
+
+ *dropped=0; // assume no zeros dropped
+ if ((dn->bits & DECSPECIAL) // fast exit if special ..
+ || (*dn->lsu & 0x01)) return dn; // .. or odd
+ if (ISZERO(dn)) { // .. or 0
+ dn->exponent=0; // (sign is preserved)
+ return dn;
+ }
+
+ // have a finite number which is even
+ exp=dn->exponent;
+ cut=1; // digit (1-DECDPUN) in Unit
+ up=dn->lsu; // -> current Unit
+ for (d=0; d<dn->digits-1; d++) { // [don't strip the final digit]
+ // slice by powers
+ #if DECDPUN<=4
+ uInt quot=QUOT10(*up, cut);
+ if ((*up-quot*powers[cut])!=0) break; // found non-0 digit
+ #else
+ if (*up%powers[cut]!=0) break; // found non-0 digit
+ #endif
+ // have a trailing 0
+ if (!all) { // trimming
+ // [if exp>0 then all trailing 0s are significant for trim]
+ if (exp<=0) { // if digit might be significant
+ if (exp==0) break; // then quit
+ exp++; // next digit might be significant
+ }
+ }
+ cut++; // next power
+ if (cut>DECDPUN) { // need new Unit
+ up++;
+ cut=1;
+ }
+ } // d
+ if (d==0) return dn; // none to drop
+
+ // may need to limit drop if clamping
+ if (set->clamp && !noclamp) {
+ Int maxd=set->emax-set->digits+1-dn->exponent;
+ if (maxd<=0) return dn; // nothing possible
+ if (d>maxd) d=maxd;
+ }
+
+ // effect the drop
+ decShiftToLeast(dn->lsu, D2U(dn->digits), d);
+ dn->exponent+=d; // maintain numerical value
+ dn->digits-=d; // new length
+ *dropped=d; // report the count
+ return dn;
+ } // decTrim
+
+/* ------------------------------------------------------------------ */
+/* decReverse -- reverse a Unit array in place */
+/* */
+/* ulo is the start of the array */
+/* uhi is the end of the array (highest Unit to include) */
+/* */
+/* The units ulo through uhi are reversed in place (if the number */
+/* of units is odd, the middle one is untouched). Note that the */
+/* digit(s) in each unit are unaffected. */
+/* ------------------------------------------------------------------ */
+static void decReverse(Unit *ulo, Unit *uhi) {
+ Unit temp;
+ for (; ulo<uhi; ulo++, uhi--) {
+ temp=*ulo;
+ *ulo=*uhi;
+ *uhi=temp;
+ }
+ return;
+ } // decReverse
+
+/* ------------------------------------------------------------------ */
+/* decShiftToMost -- shift digits in array towards most significant */
+/* */
+/* uar is the array */
+/* digits is the count of digits in use in the array */
+/* shift is the number of zeros to pad with (least significant); */
+/* it must be zero or positive */
+/* */
+/* returns the new length of the integer in the array, in digits */
+/* */
+/* No overflow is permitted (that is, the uar array must be known to */
+/* be large enough to hold the result, after shifting). */
+/* ------------------------------------------------------------------ */
+static Int decShiftToMost(Unit *uar, Int digits, Int shift) {
+ Unit *target, *source, *first; // work
+ Int cut; // odd 0's to add
+ uInt next; // work
+
+ if (shift==0) return digits; // [fastpath] nothing to do
+ if ((digits+shift)<=DECDPUN) { // [fastpath] single-unit case
+ *uar=(Unit)(*uar*powers[shift]);
+ return digits+shift;
+ }
+
+ next=0; // all paths
+ source=uar+D2U(digits)-1; // where msu comes from
+ target=source+D2U(shift); // where upper part of first cut goes
+ cut=DECDPUN-MSUDIGITS(shift); // where to slice
+ if (cut==0) { // unit-boundary case
+ for (; source>=uar; source--, target--) *target=*source;
+ }
+ else {
+ first=uar+D2U(digits+shift)-1; // where msu of source will end up
+ for (; source>=uar; source--, target--) {
+ // split the source Unit and accumulate remainder for next
+ #if DECDPUN<=4
+ uInt quot=QUOT10(*source, cut);
+ uInt rem=*source-quot*powers[cut];
+ next+=quot;
+ #else
+ uInt rem=*source%powers[cut];
+ next+=*source/powers[cut];
+ #endif
+ if (target<=first) *target=(Unit)next; // write to target iff valid
+ next=rem*powers[DECDPUN-cut]; // save remainder for next Unit
+ }
+ } // shift-move
+
+ // propagate any partial unit to one below and clear the rest
+ for (; target>=uar; target--) {
+ *target=(Unit)next;
+ next=0;
+ }
+ return digits+shift;
+ } // decShiftToMost
+
+/* ------------------------------------------------------------------ */
+/* decShiftToLeast -- shift digits in array towards least significant */
+/* */
+/* uar is the array */
+/* units is length of the array, in units */
+/* shift is the number of digits to remove from the lsu end; it */
+/* must be zero or positive and <= than units*DECDPUN. */
+/* */
+/* returns the new length of the integer in the array, in units */
+/* */
+/* Removed digits are discarded (lost). Units not required to hold */
+/* the final result are unchanged. */
+/* ------------------------------------------------------------------ */
+static Int decShiftToLeast(Unit *uar, Int units, Int shift) {
+ Unit *target, *up; // work
+ Int cut, count; // work
+ Int quot, rem; // for division
+
+ if (shift==0) return units; // [fastpath] nothing to do
+ if (shift==units*DECDPUN) { // [fastpath] little to do
+ *uar=0; // all digits cleared gives zero
+ return 1; // leaves just the one
+ }
+
+ target=uar; // both paths
+ cut=MSUDIGITS(shift);
+ if (cut==DECDPUN) { // unit-boundary case; easy
+ up=uar+D2U(shift);
+ for (; up<uar+units; target++, up++) *target=*up;
+ return target-uar;
+ }
+
+ // messier
+ up=uar+D2U(shift-cut); // source; correct to whole Units
+ count=units*DECDPUN-shift; // the maximum new length
+ #if DECDPUN<=4
+ quot=QUOT10(*up, cut);
+ #else
+ quot=*up/powers[cut];
+ #endif
+ for (; ; target++) {
+ *target=(Unit)quot;
+ count-=(DECDPUN-cut);
+ if (count<=0) break;
+ up++;
+ quot=*up;
+ #if DECDPUN<=4
+ quot=QUOT10(quot, cut);
+ rem=*up-quot*powers[cut];
+ #else
+ rem=quot%powers[cut];
+ quot=quot/powers[cut];
+ #endif
+ *target=(Unit)(*target+rem*powers[DECDPUN-cut]);
+ count-=cut;
+ if (count<=0) break;
+ }
+ return target-uar+1;
+ } // decShiftToLeast
+
+#if DECSUBSET
+/* ------------------------------------------------------------------ */
+/* decRoundOperand -- round an operand [used for subset only] */
+/* */
+/* dn is the number to round (dn->digits is > set->digits) */
+/* set is the relevant context */
+/* status is the status accumulator */
+/* */
+/* returns an allocated decNumber with the rounded result. */
+/* */
+/* lostDigits and other status may be set by this. */
+/* */
+/* Since the input is an operand, it must not be modified. */
+/* Instead, return an allocated decNumber, rounded as required. */
+/* It is the caller's responsibility to free the allocated storage. */
+/* */
+/* If no storage is available then the result cannot be used, so NULL */
+/* is returned. */
+/* ------------------------------------------------------------------ */
+static decNumber *decRoundOperand(const decNumber *dn, decContext *set,
+ uInt *status) {
+ decNumber *res; // result structure
+ uInt newstatus=0; // status from round
+ Int residue=0; // rounding accumulator
+
+ // Allocate storage for the returned decNumber, big enough for the
+ // length specified by the context
+ res=(decNumber *)malloc(sizeof(decNumber)
+ +(D2U(set->digits)-1)*sizeof(Unit));
+ if (res==NULL) {
+ *status|=DEC_Insufficient_storage;
+ return NULL;
+ }
+ decCopyFit(res, dn, set, &residue, &newstatus);
+ decApplyRound(res, set, residue, &newstatus);
+
+ // If that set Inexact then "lost digits" is raised...
+ if (newstatus & DEC_Inexact) newstatus|=DEC_Lost_digits;
+ *status|=newstatus;
+ return res;
+ } // decRoundOperand
+#endif
+
+/* ------------------------------------------------------------------ */
+/* decCopyFit -- copy a number, truncating the coefficient if needed */
+/* */
+/* dest is the target decNumber */
+/* src is the source decNumber */
+/* set is the context [used for length (digits) and rounding mode] */
+/* residue is the residue accumulator */
+/* status contains the current status to be updated */
+/* */
+/* (dest==src is allowed and will be a no-op if fits) */
+/* All fields are updated as required. */
+/* ------------------------------------------------------------------ */
+static void decCopyFit(decNumber *dest, const decNumber *src,
+ decContext *set, Int *residue, uInt *status) {
+ dest->bits=src->bits;
+ dest->exponent=src->exponent;
+ decSetCoeff(dest, set, src->lsu, src->digits, residue, status);
+ } // decCopyFit
+
+/* ------------------------------------------------------------------ */
+/* decSetCoeff -- set the coefficient of a number */
+/* */
+/* dn is the number whose coefficient array is to be set. */
+/* It must have space for set->digits digits */
+/* set is the context [for size] */
+/* lsu -> lsu of the source coefficient [may be dn->lsu] */
+/* len is digits in the source coefficient [may be dn->digits] */
+/* residue is the residue accumulator. This has values as in */
+/* decApplyRound, and will be unchanged unless the */
+/* target size is less than len. In this case, the */
+/* coefficient is truncated and the residue is updated to */
+/* reflect the previous residue and the dropped digits. */
+/* status is the status accumulator, as usual */
+/* */
+/* The coefficient may already be in the number, or it can be an */
+/* external intermediate array. If it is in the number, lsu must == */
+/* dn->lsu and len must == dn->digits. */
+/* */
+/* Note that the coefficient length (len) may be < set->digits, and */
+/* in this case this merely copies the coefficient (or is a no-op */
+/* if dn->lsu==lsu). */
+/* */
+/* Note also that (only internally, from decQuantizeOp and */
+/* decSetSubnormal) the value of set->digits may be less than one, */
+/* indicating a round to left. This routine handles that case */
+/* correctly; caller ensures space. */
+/* */
+/* dn->digits, dn->lsu (and as required), and dn->exponent are */
+/* updated as necessary. dn->bits (sign) is unchanged. */
+/* */
+/* DEC_Rounded status is set if any digits are discarded. */
+/* DEC_Inexact status is set if any non-zero digits are discarded, or */
+/* incoming residue was non-0 (implies rounded) */
+/* ------------------------------------------------------------------ */
+// mapping array: maps 0-9 to canonical residues, so that a residue
+// can be adjusted in the range [-1, +1] and achieve correct rounding
+// 0 1 2 3 4 5 6 7 8 9
+static const uByte resmap[10]={0, 3, 3, 3, 3, 5, 7, 7, 7, 7};
+static void decSetCoeff(decNumber *dn, decContext *set, const Unit *lsu,
+ Int len, Int *residue, uInt *status) {
+ Int discard; // number of digits to discard
+ uInt cut; // cut point in Unit
+ const Unit *up; // work
+ Unit *target; // ..
+ Int count; // ..
+ #if DECDPUN<=4
+ uInt temp; // ..
+ #endif
+
+ discard=len-set->digits; // digits to discard
+ if (discard<=0) { // no digits are being discarded
+ if (dn->lsu!=lsu) { // copy needed
+ // copy the coefficient array to the result number; no shift needed
+ count=len; // avoids D2U
+ up=lsu;
+ for (target=dn->lsu; count>0; target++, up++, count-=DECDPUN)
+ *target=*up;
+ dn->digits=len; // set the new length
+ }
+ // dn->exponent and residue are unchanged, record any inexactitude
+ if (*residue!=0) *status|=(DEC_Inexact | DEC_Rounded);
+ return;
+ }
+
+ // some digits must be discarded ...
+ dn->exponent+=discard; // maintain numerical value
+ *status|=DEC_Rounded; // accumulate Rounded status
+ if (*residue>1) *residue=1; // previous residue now to right, so reduce
+
+ if (discard>len) { // everything, +1, is being discarded
+ // guard digit is 0
+ // residue is all the number [NB could be all 0s]
+ if (*residue<=0) { // not already positive
+ count=len; // avoids D2U
+ for (up=lsu; count>0; up++, count-=DECDPUN) if (*up!=0) { // found non-0
+ *residue=1;
+ break; // no need to check any others
+ }
+ }
+ if (*residue!=0) *status|=DEC_Inexact; // record inexactitude
+ *dn->lsu=0; // coefficient will now be 0
+ dn->digits=1; // ..
+ return;
+ } // total discard
+
+ // partial discard [most common case]
+ // here, at least the first (most significant) discarded digit exists
+
+ // spin up the number, noting residue during the spin, until get to
+ // the Unit with the first discarded digit. When reach it, extract
+ // it and remember its position
+ count=0;
+ for (up=lsu;; up++) {
+ count+=DECDPUN;
+ if (count>=discard) break; // full ones all checked
+ if (*up!=0) *residue=1;
+ } // up
+
+ // here up -> Unit with first discarded digit
+ cut=discard-(count-DECDPUN)-1;
+ if (cut==DECDPUN-1) { // unit-boundary case (fast)
+ Unit half=(Unit)powers[DECDPUN]>>1;
+ // set residue directly
+ if (*up>=half) {
+ if (*up>half) *residue=7;
+ else *residue+=5; // add sticky bit
+ }
+ else { // <half
+ if (*up!=0) *residue=3; // [else is 0, leave as sticky bit]
+ }
+ if (set->digits<=0) { // special for Quantize/Subnormal :-(
+ *dn->lsu=0; // .. result is 0
+ dn->digits=1; // ..
+ }
+ else { // shift to least
+ count=set->digits; // now digits to end up with
+ dn->digits=count; // set the new length
+ up++; // move to next
+ // on unit boundary, so shift-down copy loop is simple
+ for (target=dn->lsu; count>0; target++, up++, count-=DECDPUN)
+ *target=*up;
+ }
+ } // unit-boundary case
+
+ else { // discard digit is in low digit(s), and not top digit
+ uInt discard1; // first discarded digit
+ uInt quot, rem; // for divisions
+ if (cut==0) quot=*up; // is at bottom of unit
+ else /* cut>0 */ { // it's not at bottom of unit
+ #if DECDPUN<=4
+ quot=QUOT10(*up, cut);
+ rem=*up-quot*powers[cut];
+ #else
+ rem=*up%powers[cut];
+ quot=*up/powers[cut];
+ #endif
+ if (rem!=0) *residue=1;
+ }
+ // discard digit is now at bottom of quot
+ #if DECDPUN<=4
+ temp=(quot*6554)>>16; // fast /10
+ // Vowels algorithm here not a win (9 instructions)
+ discard1=quot-X10(temp);
+ quot=temp;
+ #else
+ discard1=quot%10;
+ quot=quot/10;
+ #endif
+ // here, discard1 is the guard digit, and residue is everything
+ // else [use mapping array to accumulate residue safely]
+ *residue+=resmap[discard1];
+ cut++; // update cut
+ // here: up -> Unit of the array with bottom digit
+ // cut is the division point for each Unit
+ // quot holds the uncut high-order digits for the current unit
+ if (set->digits<=0) { // special for Quantize/Subnormal :-(
+ *dn->lsu=0; // .. result is 0
+ dn->digits=1; // ..
+ }
+ else { // shift to least needed
+ count=set->digits; // now digits to end up with
+ dn->digits=count; // set the new length
+ // shift-copy the coefficient array to the result number
+ for (target=dn->lsu; ; target++) {
+ *target=(Unit)quot;
+ count-=(DECDPUN-cut);
+ if (count<=0) break;
+ up++;
+ quot=*up;
+ #if DECDPUN<=4
+ quot=QUOT10(quot, cut);
+ rem=*up-quot*powers[cut];
+ #else
+ rem=quot%powers[cut];
+ quot=quot/powers[cut];
+ #endif
+ *target=(Unit)(*target+rem*powers[DECDPUN-cut]);
+ count-=cut;
+ if (count<=0) break;
+ } // shift-copy loop
+ } // shift to least
+ } // not unit boundary
+
+ if (*residue!=0) *status|=DEC_Inexact; // record inexactitude
+ return;
+ } // decSetCoeff
+
+/* ------------------------------------------------------------------ */
+/* decApplyRound -- apply pending rounding to a number */
+/* */
+/* dn is the number, with space for set->digits digits */
+/* set is the context [for size and rounding mode] */
+/* residue indicates pending rounding, being any accumulated */
+/* guard and sticky information. It may be: */
+/* 6-9: rounding digit is >5 */
+/* 5: rounding digit is exactly half-way */
+/* 1-4: rounding digit is <5 and >0 */
+/* 0: the coefficient is exact */
+/* -1: as 1, but the hidden digits are subtractive, that */
+/* is, of the opposite sign to dn. In this case the */
+/* coefficient must be non-0. This case occurs when */
+/* subtracting a small number (which can be reduced to */
+/* a sticky bit); see decAddOp. */
+/* status is the status accumulator, as usual */
+/* */
+/* This routine applies rounding while keeping the length of the */
+/* coefficient constant. The exponent and status are unchanged */
+/* except if: */
+/* */
+/* -- the coefficient was increased and is all nines (in which */
+/* case Overflow could occur, and is handled directly here so */
+/* the caller does not need to re-test for overflow) */
+/* */
+/* -- the coefficient was decreased and becomes all nines (in which */
+/* case Underflow could occur, and is also handled directly). */
+/* */
+/* All fields in dn are updated as required. */
+/* */
+/* ------------------------------------------------------------------ */
+static void decApplyRound(decNumber *dn, decContext *set, Int residue,
+ uInt *status) {
+ Int bump; // 1 if coefficient needs to be incremented
+ // -1 if coefficient needs to be decremented
+
+ if (residue==0) return; // nothing to apply
+
+ bump=0; // assume a smooth ride
+
+ // now decide whether, and how, to round, depending on mode
+ switch (set->round) {
+ case DEC_ROUND_05UP: { // round zero or five up (for reround)
+ // This is the same as DEC_ROUND_DOWN unless there is a
+ // positive residue and the lsd of dn is 0 or 5, in which case
+ // it is bumped; when residue is <0, the number is therefore
+ // bumped down unless the final digit was 1 or 6 (in which
+ // case it is bumped down and then up -- a no-op)
+ Int lsd5=*dn->lsu%5; // get lsd and quintate
+ if (residue<0 && lsd5!=1) bump=-1;
+ else if (residue>0 && lsd5==0) bump=1;
+ // [bump==1 could be applied directly; use common path for clarity]
+ break;} // r-05
+
+ case DEC_ROUND_DOWN: {
+ // no change, except if negative residue
+ if (residue<0) bump=-1;
+ break;} // r-d
+
+ case DEC_ROUND_HALF_DOWN: {
+ if (residue>5) bump=1;
+ break;} // r-h-d
+
+ case DEC_ROUND_HALF_EVEN: {
+ if (residue>5) bump=1; // >0.5 goes up
+ else if (residue==5) { // exactly 0.5000...
+ // 0.5 goes up iff [new] lsd is odd
+ if (*dn->lsu & 0x01) bump=1;
+ }
+ break;} // r-h-e
+
+ case DEC_ROUND_HALF_UP: {
+ if (residue>=5) bump=1;
+ break;} // r-h-u
+
+ case DEC_ROUND_UP: {
+ if (residue>0) bump=1;
+ break;} // r-u
+
+ case DEC_ROUND_CEILING: {
+ // same as _UP for positive numbers, and as _DOWN for negatives
+ // [negative residue cannot occur on 0]
+ if (decNumberIsNegative(dn)) {
+ if (residue<0) bump=-1;
+ }
+ else {
+ if (residue>0) bump=1;
+ }
+ break;} // r-c
+
+ case DEC_ROUND_FLOOR: {
+ // same as _UP for negative numbers, and as _DOWN for positive
+ // [negative residue cannot occur on 0]
+ if (!decNumberIsNegative(dn)) {
+ if (residue<0) bump=-1;
+ }
+ else {
+ if (residue>0) bump=1;
+ }
+ break;} // r-f
+
+ default: { // e.g., DEC_ROUND_MAX
+ *status|=DEC_Invalid_context;
+ #if DECTRACE || (DECCHECK && DECVERB)
+ printf("Unknown rounding mode: %d\n", set->round);
+ #endif
+ break;}
+ } // switch
+
+ // now bump the number, up or down, if need be
+ if (bump==0) return; // no action required
+
+ // Simply use decUnitAddSub unless bumping up and the number is
+ // all nines. In this special case set to 100... explicitly
+ // and adjust the exponent by one (as otherwise could overflow
+ // the array)
+ // Similarly handle all-nines result if bumping down.
+ if (bump>0) {
+ Unit *up; // work
+ uInt count=dn->digits; // digits to be checked
+ for (up=dn->lsu; ; up++) {
+ if (count<=DECDPUN) {
+ // this is the last Unit (the msu)
+ if (*up!=powers[count]-1) break; // not still 9s
+ // here if it, too, is all nines
+ *up=(Unit)powers[count-1]; // here 999 -> 100 etc.
+ for (up=up-1; up>=dn->lsu; up--) *up=0; // others all to 0
+ dn->exponent++; // and bump exponent
+ // [which, very rarely, could cause Overflow...]
+ if ((dn->exponent+dn->digits)>set->emax+1) {
+ decSetOverflow(dn, set, status);
+ }
+ return; // done
+ }
+ // a full unit to check, with more to come
+ if (*up!=DECDPUNMAX) break; // not still 9s
+ count-=DECDPUN;
+ } // up
+ } // bump>0
+ else { // -1
+ // here checking for a pre-bump of 1000... (leading 1, all
+ // other digits zero)
+ Unit *up, *sup; // work
+ uInt count=dn->digits; // digits to be checked
+ for (up=dn->lsu; ; up++) {
+ if (count<=DECDPUN) {
+ // this is the last Unit (the msu)
+ if (*up!=powers[count-1]) break; // not 100..
+ // here if have the 1000... case
+ sup=up; // save msu pointer
+ *up=(Unit)powers[count]-1; // here 100 in msu -> 999
+ // others all to all-nines, too
+ for (up=up-1; up>=dn->lsu; up--) *up=(Unit)powers[DECDPUN]-1;
+ dn->exponent--; // and bump exponent
+
+ // iff the number was at the subnormal boundary (exponent=etiny)
+ // then the exponent is now out of range, so it will in fact get
+ // clamped to etiny and the final 9 dropped.
+ // printf(">> emin=%d exp=%d sdig=%d\n", set->emin,
+ // dn->exponent, set->digits);
+ if (dn->exponent+1==set->emin-set->digits+1) {
+ if (count==1 && dn->digits==1) *sup=0; // here 9 -> 0[.9]
+ else {
+ *sup=(Unit)powers[count-1]-1; // here 999.. in msu -> 99..
+ dn->digits--;
+ }
+ dn->exponent++;
+ *status|=DEC_Underflow | DEC_Subnormal | DEC_Inexact | DEC_Rounded;
+ }
+ return; // done
+ }
+
+ // a full unit to check, with more to come
+ if (*up!=0) break; // not still 0s
+ count-=DECDPUN;
+ } // up
+
+ } // bump<0
+
+ // Actual bump needed. Do it.
+ decUnitAddSub(dn->lsu, D2U(dn->digits), uarrone, 1, 0, dn->lsu, bump);
+ } // decApplyRound
+
+#if DECSUBSET
+/* ------------------------------------------------------------------ */
+/* decFinish -- finish processing a number */
+/* */
+/* dn is the number */
+/* set is the context */
+/* residue is the rounding accumulator (as in decApplyRound) */
+/* status is the accumulator */
+/* */
+/* This finishes off the current number by: */
+/* 1. If not extended: */
+/* a. Converting a zero result to clean '0' */
+/* b. Reducing positive exponents to 0, if would fit in digits */
+/* 2. Checking for overflow and subnormals (always) */
+/* Note this is just Finalize when no subset arithmetic. */
+/* All fields are updated as required. */
+/* ------------------------------------------------------------------ */
+static void decFinish(decNumber *dn, decContext *set, Int *residue,
+ uInt *status) {
+ if (!set->extended) {
+ if ISZERO(dn) { // value is zero
+ dn->exponent=0; // clean exponent ..
+ dn->bits=0; // .. and sign
+ return; // no error possible
+ }
+ if (dn->exponent>=0) { // non-negative exponent
+ // >0; reduce to integer if possible
+ if (set->digits >= (dn->exponent+dn->digits)) {
+ dn->digits=decShiftToMost(dn->lsu, dn->digits, dn->exponent);
+ dn->exponent=0;
+ }
+ }
+ } // !extended
+
+ decFinalize(dn, set, residue, status);
+ } // decFinish
+#endif
+
+/* ------------------------------------------------------------------ */
+/* decFinalize -- final check, clamp, and round of a number */
+/* */
+/* dn is the number */
+/* set is the context */
+/* residue is the rounding accumulator (as in decApplyRound) */
+/* status is the status accumulator */
+/* */
+/* This finishes off the current number by checking for subnormal */
+/* results, applying any pending rounding, checking for overflow, */
+/* and applying any clamping. */
+/* Underflow and overflow conditions are raised as appropriate. */
+/* All fields are updated as required. */
+/* ------------------------------------------------------------------ */
+static void decFinalize(decNumber *dn, decContext *set, Int *residue,
+ uInt *status) {
+ Int shift; // shift needed if clamping
+ Int tinyexp=set->emin-dn->digits+1; // precalculate subnormal boundary
+
+ // Must be careful, here, when checking the exponent as the
+ // adjusted exponent could overflow 31 bits [because it may already
+ // be up to twice the expected].
+
+ // First test for subnormal. This must be done before any final
+ // round as the result could be rounded to Nmin or 0.
+ if (dn->exponent<=tinyexp) { // prefilter
+ Int comp;
+ decNumber nmin;
+ // A very nasty case here is dn == Nmin and residue<0
+ if (dn->exponent<tinyexp) {
+ // Go handle subnormals; this will apply round if needed.
+ decSetSubnormal(dn, set, residue, status);
+ return;
+ }
+ // Equals case: only subnormal if dn=Nmin and negative residue
+ decNumberZero(&nmin);
+ nmin.lsu[0]=1;
+ nmin.exponent=set->emin;
+ comp=decCompare(dn, &nmin, 1); // (signless compare)
+ if (comp==BADINT) { // oops
+ *status|=DEC_Insufficient_storage; // abandon...
+ return;
+ }
+ if (*residue<0 && comp==0) { // neg residue and dn==Nmin
+ decApplyRound(dn, set, *residue, status); // might force down
+ decSetSubnormal(dn, set, residue, status);
+ return;
+ }
+ }
+
+ // now apply any pending round (this could raise overflow).
+ if (*residue!=0) decApplyRound(dn, set, *residue, status);
+
+ // Check for overflow [redundant in the 'rare' case] or clamp
+ if (dn->exponent<=set->emax-set->digits+1) return; // neither needed
+
+
+ // here when might have an overflow or clamp to do
+ if (dn->exponent>set->emax-dn->digits+1) { // too big
+ decSetOverflow(dn, set, status);
+ return;
+ }
+ // here when the result is normal but in clamp range
+ if (!set->clamp) return;
+
+ // here when need to apply the IEEE exponent clamp (fold-down)
+ shift=dn->exponent-(set->emax-set->digits+1);
+
+ // shift coefficient (if non-zero)
+ if (!ISZERO(dn)) {
+ dn->digits=decShiftToMost(dn->lsu, dn->digits, shift);
+ }
+ dn->exponent-=shift; // adjust the exponent to match
+ *status|=DEC_Clamped; // and record the dirty deed
+ return;
+ } // decFinalize
+
+/* ------------------------------------------------------------------ */
+/* decSetOverflow -- set number to proper overflow value */
+/* */
+/* dn is the number (used for sign [only] and result) */
+/* set is the context [used for the rounding mode, etc.] */
+/* status contains the current status to be updated */
+/* */
+/* This sets the sign of a number and sets its value to either */
+/* Infinity or the maximum finite value, depending on the sign of */
+/* dn and the rounding mode, following IEEE 754 rules. */
+/* ------------------------------------------------------------------ */
+static void decSetOverflow(decNumber *dn, decContext *set, uInt *status) {
+ Flag needmax=0; // result is maximum finite value
+ uByte sign=dn->bits&DECNEG; // clean and save sign bit
+
+ if (ISZERO(dn)) { // zero does not overflow magnitude
+ Int emax=set->emax; // limit value
+ if (set->clamp) emax-=set->digits-1; // lower if clamping
+ if (dn->exponent>emax) { // clamp required
+ dn->exponent=emax;
+ *status|=DEC_Clamped;
+ }
+ return;
+ }
+
+ decNumberZero(dn);
+ switch (set->round) {
+ case DEC_ROUND_DOWN: {
+ needmax=1; // never Infinity
+ break;} // r-d
+ case DEC_ROUND_05UP: {
+ needmax=1; // never Infinity
+ break;} // r-05
+ case DEC_ROUND_CEILING: {
+ if (sign) needmax=1; // Infinity if non-negative
+ break;} // r-c
+ case DEC_ROUND_FLOOR: {
+ if (!sign) needmax=1; // Infinity if negative
+ break;} // r-f
+ default: break; // Infinity in all other cases
+ }
+ if (needmax) {
+ decSetMaxValue(dn, set);
+ dn->bits=sign; // set sign
+ }
+ else dn->bits=sign|DECINF; // Value is +/-Infinity
+ *status|=DEC_Overflow | DEC_Inexact | DEC_Rounded;
+ } // decSetOverflow
+
+/* ------------------------------------------------------------------ */
+/* decSetMaxValue -- set number to +Nmax (maximum normal value) */
+/* */
+/* dn is the number to set */
+/* set is the context [used for digits and emax] */
+/* */
+/* This sets the number to the maximum positive value. */
+/* ------------------------------------------------------------------ */
+static void decSetMaxValue(decNumber *dn, decContext *set) {
+ Unit *up; // work
+ Int count=set->digits; // nines to add
+ dn->digits=count;
+ // fill in all nines to set maximum value
+ for (up=dn->lsu; ; up++) {
+ if (count>DECDPUN) *up=DECDPUNMAX; // unit full o'nines
+ else { // this is the msu
+ *up=(Unit)(powers[count]-1);
+ break;
+ }
+ count-=DECDPUN; // filled those digits
+ } // up
+ dn->bits=0; // + sign
+ dn->exponent=set->emax-set->digits+1;
+ } // decSetMaxValue
+
+/* ------------------------------------------------------------------ */
+/* decSetSubnormal -- process value whose exponent is <Emin */
+/* */
+/* dn is the number (used as input as well as output; it may have */
+/* an allowed subnormal value, which may need to be rounded) */
+/* set is the context [used for the rounding mode] */
+/* residue is any pending residue */
+/* status contains the current status to be updated */
+/* */
+/* If subset mode, set result to zero and set Underflow flags. */
+/* */
+/* Value may be zero with a low exponent; this does not set Subnormal */
+/* but the exponent will be clamped to Etiny. */
+/* */
+/* Otherwise ensure exponent is not out of range, and round as */
+/* necessary. Underflow is set if the result is Inexact. */
+/* ------------------------------------------------------------------ */
+static void decSetSubnormal(decNumber *dn, decContext *set, Int *residue,
+ uInt *status) {
+ decContext workset; // work
+ Int etiny, adjust; // ..
+
+ #if DECSUBSET
+ // simple set to zero and 'hard underflow' for subset
+ if (!set->extended) {
+ decNumberZero(dn);
+ // always full overflow
+ *status|=DEC_Underflow | DEC_Subnormal | DEC_Inexact | DEC_Rounded;
+ return;
+ }
+ #endif
+
+ // Full arithmetic -- allow subnormals, rounded to minimum exponent
+ // (Etiny) if needed
+ etiny=set->emin-(set->digits-1); // smallest allowed exponent
+
+ if ISZERO(dn) { // value is zero
+ // residue can never be non-zero here
+ #if DECCHECK
+ if (*residue!=0) {
+ printf("++ Subnormal 0 residue %ld\n", (LI)*residue);
+ *status|=DEC_Invalid_operation;
+ }
+ #endif
+ if (dn->exponent<etiny) { // clamp required
+ dn->exponent=etiny;
+ *status|=DEC_Clamped;
+ }
+ return;
+ }
+
+ *status|=DEC_Subnormal; // have a non-zero subnormal
+ adjust=etiny-dn->exponent; // calculate digits to remove
+ if (adjust<=0) { // not out of range; unrounded
+ // residue can never be non-zero here, except in the Nmin-residue
+ // case (which is a subnormal result), so can take fast-path here
+ // it may already be inexact (from setting the coefficient)
+ if (*status&DEC_Inexact) *status|=DEC_Underflow;
+ return;
+ }
+
+ // adjust>0, so need to rescale the result so exponent becomes Etiny
+ // [this code is similar to that in rescale]
+ workset=*set; // clone rounding, etc.
+ workset.digits=dn->digits-adjust; // set requested length
+ workset.emin-=adjust; // and adjust emin to match
+ // [note that the latter can be <1, here, similar to Rescale case]
+ decSetCoeff(dn, &workset, dn->lsu, dn->digits, residue, status);
+ decApplyRound(dn, &workset, *residue, status);
+
+ // Use 754 default rule: Underflow is set iff Inexact
+ // [independent of whether trapped]
+ if (*status&DEC_Inexact) *status|=DEC_Underflow;
+
+ // if rounded up a 999s case, exponent will be off by one; adjust
+ // back if so [it will fit, because it was shortened earlier]
+ if (dn->exponent>etiny) {
+ dn->digits=decShiftToMost(dn->lsu, dn->digits, 1);
+ dn->exponent--; // (re)adjust the exponent.
+ }
+
+ // if rounded to zero, it is by definition clamped...
+ if (ISZERO(dn)) *status|=DEC_Clamped;
+ } // decSetSubnormal
+
+/* ------------------------------------------------------------------ */
+/* decCheckMath - check entry conditions for a math function */
+/* */
+/* This checks the context and the operand */
+/* */
+/* rhs is the operand to check */
+/* set is the context to check */
+/* status is unchanged if both are good */
+/* */
+/* returns non-zero if status is changed, 0 otherwise */
+/* */
+/* Restrictions enforced: */
+/* */
+/* digits, emax, and -emin in the context must be less than */
+/* DEC_MAX_MATH (999999), and A must be within these bounds if */
+/* non-zero. Invalid_operation is set in the status if a */
+/* restriction is violated. */
+/* ------------------------------------------------------------------ */
+static uInt decCheckMath(const decNumber *rhs, decContext *set,
+ uInt *status) {
+ uInt save=*status; // record
+ if (set->digits>DEC_MAX_MATH
+ || set->emax>DEC_MAX_MATH
+ || -set->emin>DEC_MAX_MATH) *status|=DEC_Invalid_context;
+ else if ((rhs->digits>DEC_MAX_MATH
+ || rhs->exponent+rhs->digits>DEC_MAX_MATH+1
+ || rhs->exponent+rhs->digits<2*(1-DEC_MAX_MATH))
+ && !ISZERO(rhs)) *status|=DEC_Invalid_operation;
+ return (*status!=save);
+ } // decCheckMath
+
+/* ------------------------------------------------------------------ */
+/* decGetInt -- get integer from a number */
+/* */
+/* dn is the number [which will not be altered] */
+/* */
+/* returns one of: */
+/* BADINT if there is a non-zero fraction */
+/* the converted integer */
+/* BIGEVEN if the integer is even and magnitude > 2*10**9 */
+/* BIGODD if the integer is odd and magnitude > 2*10**9 */
+/* */
+/* This checks and gets a whole number from the input decNumber. */
+/* The sign can be determined from dn by the caller when BIGEVEN or */
+/* BIGODD is returned. */
+/* ------------------------------------------------------------------ */
+static Int decGetInt(const decNumber *dn) {
+ Int theInt; // result accumulator
+ const Unit *up; // work
+ Int got; // digits (real or not) processed
+ Int ilength=dn->digits+dn->exponent; // integral length
+ Flag neg=decNumberIsNegative(dn); // 1 if -ve
+
+ // The number must be an integer that fits in 10 digits
+ // Assert, here, that 10 is enough for any rescale Etiny
+ #if DEC_MAX_EMAX > 999999999
+ #error GetInt may need updating [for Emax]
+ #endif
+ #if DEC_MIN_EMIN < -999999999
+ #error GetInt may need updating [for Emin]
+ #endif
+ if (ISZERO(dn)) return 0; // zeros are OK, with any exponent
+
+ up=dn->lsu; // ready for lsu
+ theInt=0; // ready to accumulate
+ if (dn->exponent>=0) { // relatively easy
+ // no fractional part [usual]; allow for positive exponent
+ got=dn->exponent;
+ }
+ else { // -ve exponent; some fractional part to check and discard
+ Int count=-dn->exponent; // digits to discard
+ // spin up whole units until reach the Unit with the unit digit
+ for (; count>=DECDPUN; up++) {
+ if (*up!=0) return BADINT; // non-zero Unit to discard
+ count-=DECDPUN;
+ }
+ if (count==0) got=0; // [a multiple of DECDPUN]
+ else { // [not multiple of DECDPUN]
+ Int rem; // work
+ // slice off fraction digits and check for non-zero
+ #if DECDPUN<=4
+ theInt=QUOT10(*up, count);
+ rem=*up-theInt*powers[count];
+ #else
+ rem=*up%powers[count]; // slice off discards
+ theInt=*up/powers[count];
+ #endif
+ if (rem!=0) return BADINT; // non-zero fraction
+ // it looks good
+ got=DECDPUN-count; // number of digits so far
+ up++; // ready for next
+ }
+ }
+ // now it's known there's no fractional part
+
+ // tricky code now, to accumulate up to 9.3 digits
+ if (got==0) {theInt=*up; got+=DECDPUN; up++;} // ensure lsu is there
+
+ if (ilength<11) {
+ Int save=theInt;
+ // collect any remaining unit(s)
+ for (; got<ilength; up++) {
+ theInt+=*up*powers[got];
+ got+=DECDPUN;
+ }
+ if (ilength==10) { // need to check for wrap
+ if (theInt/(Int)powers[got-DECDPUN]!=(Int)*(up-1)) ilength=11;
+ // [that test also disallows the BADINT result case]
+ else if (neg && theInt>1999999997) ilength=11;
+ else if (!neg && theInt>999999999) ilength=11;
+ if (ilength==11) theInt=save; // restore correct low bit
+ }
+ }
+
+ if (ilength>10) { // too big
+ if (theInt&1) return BIGODD; // bottom bit 1
+ return BIGEVEN; // bottom bit 0
+ }
+
+ if (neg) theInt=-theInt; // apply sign
+ return theInt;
+ } // decGetInt
+
+/* ------------------------------------------------------------------ */
+/* decDecap -- decapitate the coefficient of a number */
+/* */
+/* dn is the number to be decapitated */
+/* drop is the number of digits to be removed from the left of dn; */
+/* this must be <= dn->digits (if equal, the coefficient is */
+/* set to 0) */
+/* */
+/* Returns dn; dn->digits will be <= the initial digits less drop */
+/* (after removing drop digits there may be leading zero digits */
+/* which will also be removed). Only dn->lsu and dn->digits change. */
+/* ------------------------------------------------------------------ */
+static decNumber *decDecap(decNumber *dn, Int drop) {
+ Unit *msu; // -> target cut point
+ Int cut; // work
+ if (drop>=dn->digits) { // losing the whole thing
+ #if DECCHECK
+ if (drop>dn->digits)
+ printf("decDecap called with drop>digits [%ld>%ld]\n",
+ (LI)drop, (LI)dn->digits);
+ #endif
+ dn->lsu[0]=0;
+ dn->digits=1;
+ return dn;
+ }
+ msu=dn->lsu+D2U(dn->digits-drop)-1; // -> likely msu
+ cut=MSUDIGITS(dn->digits-drop); // digits to be in use in msu
+ if (cut!=DECDPUN) *msu%=powers[cut]; // clear left digits
+ // that may have left leading zero digits, so do a proper count...
+ dn->digits=decGetDigits(dn->lsu, msu-dn->lsu+1);
+ return dn;
+ } // decDecap
+
+/* ------------------------------------------------------------------ */
+/* decBiStr -- compare string with pairwise options */
+/* */
+/* targ is the string to compare */
+/* str1 is one of the strings to compare against (length may be 0) */
+/* str2 is the other; it must be the same length as str1 */
+/* */
+/* returns 1 if strings compare equal, (that is, it is the same */
+/* length as str1 and str2, and each character of targ is in either */
+/* str1 or str2 in the corresponding position), or 0 otherwise */
+/* */
+/* This is used for generic caseless compare, including the awkward */
+/* case of the Turkish dotted and dotless Is. Use as (for example): */
+/* if (decBiStr(test, "mike", "MIKE")) ... */
+/* ------------------------------------------------------------------ */
+static Flag decBiStr(const char *targ, const char *str1, const char *str2) {
+ for (;;targ++, str1++, str2++) {
+ if (*targ!=*str1 && *targ!=*str2) return 0;
+ // *targ has a match in one (or both, if terminator)
+ if (*targ=='\0') break;
+ } // forever
+ return 1;
+ } // decBiStr
+
+/* ------------------------------------------------------------------ */
+/* decNaNs -- handle NaN operand or operands */
+/* */
+/* res is the result number */
+/* lhs is the first operand */
+/* rhs is the second operand, or NULL if none */
+/* context is used to limit payload length */
+/* status contains the current status */
+/* returns res in case convenient */
+/* */
+/* Called when one or both operands is a NaN, and propagates the */
+/* appropriate result to res. When an sNaN is found, it is changed */
+/* to a qNaN and Invalid operation is set. */
+/* ------------------------------------------------------------------ */
+static decNumber * decNaNs(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set,
+ uInt *status) {
+ // This decision tree ends up with LHS being the source pointer,
+ // and status updated if need be
+ if (lhs->bits & DECSNAN)
+ *status|=DEC_Invalid_operation | DEC_sNaN;
+ else if (rhs==NULL);
+ else if (rhs->bits & DECSNAN) {
+ lhs=rhs;
+ *status|=DEC_Invalid_operation | DEC_sNaN;
+ }
+ else if (lhs->bits & DECNAN);
+ else lhs=rhs;
+
+ // propagate the payload
+ if (lhs->digits<=set->digits) decNumberCopy(res, lhs); // easy
+ else { // too long
+ const Unit *ul;
+ Unit *ur, *uresp1;
+ // copy safe number of units, then decapitate
+ res->bits=lhs->bits; // need sign etc.
+ uresp1=res->lsu+D2U(set->digits);
+ for (ur=res->lsu, ul=lhs->lsu; ur<uresp1; ur++, ul++) *ur=*ul;
+ res->digits=D2U(set->digits)*DECDPUN;
+ // maybe still too long
+ if (res->digits>set->digits) decDecap(res, res->digits-set->digits);
+ }
+
+ res->bits&=~DECSNAN; // convert any sNaN to NaN, while
+ res->bits|=DECNAN; // .. preserving sign
+ res->exponent=0; // clean exponent
+ // [coefficient was copied/decapitated]
+ return res;
+ } // decNaNs
+
+/* ------------------------------------------------------------------ */
+/* decStatus -- apply non-zero status */
+/* */
+/* dn is the number to set if error */
+/* status contains the current status (not yet in context) */
+/* set is the context */
+/* */
+/* If the status is an error status, the number is set to a NaN, */
+/* unless the error was an overflow, divide-by-zero, or underflow, */
+/* in which case the number will have already been set. */
+/* */
+/* The context status is then updated with the new status. Note that */
+/* this may raise a signal, so control may never return from this */
+/* routine (hence resources must be recovered before it is called). */
+/* ------------------------------------------------------------------ */
+static void decStatus(decNumber *dn, uInt status, decContext *set) {
+ if (status & DEC_NaNs) { // error status -> NaN
+ // if cause was an sNaN, clear and propagate [NaN is already set up]
+ if (status & DEC_sNaN) status&=~DEC_sNaN;
+ else {
+ decNumberZero(dn); // other error: clean throughout
+ dn->bits=DECNAN; // and make a quiet NaN
+ }
+ }
+ decContextSetStatus(set, status); // [may not return]
+ return;
+ } // decStatus
+
+/* ------------------------------------------------------------------ */
+/* decGetDigits -- count digits in a Units array */
+/* */
+/* uar is the Unit array holding the number (this is often an */
+/* accumulator of some sort) */
+/* len is the length of the array in units [>=1] */
+/* */
+/* returns the number of (significant) digits in the array */
+/* */
+/* All leading zeros are excluded, except the last if the array has */
+/* only zero Units. */
+/* ------------------------------------------------------------------ */
+// This may be called twice during some operations.
+static Int decGetDigits(Unit *uar, Int len) {
+ Unit *up=uar+(len-1); // -> msu
+ Int digits=(len-1)*DECDPUN+1; // possible digits excluding msu
+ #if DECDPUN>4
+ uInt const *pow; // work
+ #endif
+ // (at least 1 in final msu)
+ #if DECCHECK
+ if (len<1) printf("decGetDigits called with len<1 [%ld]\n", (LI)len);
+ #endif
+
+ for (; up>=uar; up--) {
+ if (*up==0) { // unit is all 0s
+ if (digits==1) break; // a zero has one digit
+ digits-=DECDPUN; // adjust for 0 unit
+ continue;}
+ // found the first (most significant) non-zero Unit
+ #if DECDPUN>1 // not done yet
+ if (*up<10) break; // is 1-9
+ digits++;
+ #if DECDPUN>2 // not done yet
+ if (*up<100) break; // is 10-99
+ digits++;
+ #if DECDPUN>3 // not done yet
+ if (*up<1000) break; // is 100-999
+ digits++;
+ #if DECDPUN>4 // count the rest ...
+ for (pow=&powers[4]; *up>=*pow; pow++) digits++;
+ #endif
+ #endif
+ #endif
+ #endif
+ break;
+ } // up
+ return digits;
+ } // decGetDigits
+
+#if DECTRACE | DECCHECK
+/* ------------------------------------------------------------------ */
+/* decNumberShow -- display a number [debug aid] */
+/* dn is the number to show */
+/* */
+/* Shows: sign, exponent, coefficient (msu first), digits */
+/* or: sign, special-value */
+/* ------------------------------------------------------------------ */
+// this is public so other modules can use it
+void decNumberShow(const decNumber *dn) {
+ const Unit *up; // work
+ uInt u, d; // ..
+ Int cut; // ..
+ char isign='+'; // main sign
+ if (dn==NULL) {
+ printf("NULL\n");
+ return;}
+ if (decNumberIsNegative(dn)) isign='-';
+ printf(" >> %c ", isign);
+ if (dn->bits&DECSPECIAL) { // Is a special value
+ if (decNumberIsInfinite(dn)) printf("Infinity");
+ else { // a NaN
+ if (dn->bits&DECSNAN) printf("sNaN"); // signalling NaN
+ else printf("NaN");
+ }
+ // if coefficient and exponent are 0, no more to do
+ if (dn->exponent==0 && dn->digits==1 && *dn->lsu==0) {
+ printf("\n");
+ return;}
+ // drop through to report other information
+ printf(" ");
+ }
+
+ // now carefully display the coefficient
+ up=dn->lsu+D2U(dn->digits)-1; // msu
+ printf("%ld", (LI)*up);
+ for (up=up-1; up>=dn->lsu; up--) {
+ u=*up;
+ printf(":");
+ for (cut=DECDPUN-1; cut>=0; cut--) {
+ d=u/powers[cut];
+ u-=d*powers[cut];
+ printf("%ld", (LI)d);
+ } // cut
+ } // up
+ if (dn->exponent!=0) {
+ char esign='+';
+ if (dn->exponent<0) esign='-';
+ printf(" E%c%ld", esign, (LI)abs(dn->exponent));
+ }
+ printf(" [%ld]\n", (LI)dn->digits);
+ } // decNumberShow
+#endif
+
+#if DECTRACE || DECCHECK
+/* ------------------------------------------------------------------ */
+/* decDumpAr -- display a unit array [debug/check aid] */
+/* name is a single-character tag name */
+/* ar is the array to display */
+/* len is the length of the array in Units */
+/* ------------------------------------------------------------------ */
+static void decDumpAr(char name, const Unit *ar, Int len) {
+ Int i;
+ const char *spec;
+ #if DECDPUN==9
+ spec="%09d ";
+ #elif DECDPUN==8
+ spec="%08d ";
+ #elif DECDPUN==7
+ spec="%07d ";
+ #elif DECDPUN==6
+ spec="%06d ";
+ #elif DECDPUN==5
+ spec="%05d ";
+ #elif DECDPUN==4
+ spec="%04d ";
+ #elif DECDPUN==3
+ spec="%03d ";
+ #elif DECDPUN==2
+ spec="%02d ";
+ #else
+ spec="%d ";
+ #endif
+ printf(" :%c: ", name);
+ for (i=len-1; i>=0; i--) {
+ if (i==len-1) printf("%ld ", (LI)ar[i]);
+ else printf(spec, ar[i]);
+ }
+ printf("\n");
+ return;}
+#endif
+
+#if DECCHECK
+/* ------------------------------------------------------------------ */
+/* decCheckOperands -- check operand(s) to a routine */
+/* res is the result structure (not checked; it will be set to */
+/* quiet NaN if error found (and it is not NULL)) */
+/* lhs is the first operand (may be DECUNRESU) */
+/* rhs is the second (may be DECUNUSED) */
+/* set is the context (may be DECUNCONT) */
+/* returns 0 if both operands, and the context are clean, or 1 */
+/* otherwise (in which case the context will show an error, */
+/* unless NULL). Note that res is not cleaned; caller should */
+/* handle this so res=NULL case is safe. */
+/* The caller is expected to abandon immediately if 1 is returned. */
+/* ------------------------------------------------------------------ */
+static Flag decCheckOperands(decNumber *res, const decNumber *lhs,
+ const decNumber *rhs, decContext *set) {
+ Flag bad=0;
+ if (set==NULL) { // oops; hopeless
+ #if DECTRACE || DECVERB
+ printf("Reference to context is NULL.\n");
+ #endif
+ bad=1;
+ return 1;}
+ else if (set!=DECUNCONT
+ && (set->digits<1 || set->round>=DEC_ROUND_MAX)) {
+ bad=1;
+ #if DECTRACE || DECVERB
+ printf("Bad context [digits=%ld round=%ld].\n",
+ (LI)set->digits, (LI)set->round);
+ #endif
+ }
+ else {
+ if (res==NULL) {
+ bad=1;
+ #if DECTRACE
+ // this one not DECVERB as standard tests include NULL
+ printf("Reference to result is NULL.\n");
+ #endif
+ }
+ if (!bad && lhs!=DECUNUSED) bad=(decCheckNumber(lhs));
+ if (!bad && rhs!=DECUNUSED) bad=(decCheckNumber(rhs));
+ }
+ if (bad) {
+ if (set!=DECUNCONT) decContextSetStatus(set, DEC_Invalid_operation);
+ if (res!=DECUNRESU && res!=NULL) {
+ decNumberZero(res);
+ res->bits=DECNAN; // qNaN
+ }
+ }
+ return bad;
+ } // decCheckOperands
+
+/* ------------------------------------------------------------------ */
+/* decCheckNumber -- check a number */
+/* dn is the number to check */
+/* returns 0 if the number is clean, or 1 otherwise */
+/* */
+/* The number is considered valid if it could be a result from some */
+/* operation in some valid context. */
+/* ------------------------------------------------------------------ */
+static Flag decCheckNumber(const decNumber *dn) {
+ const Unit *up; // work
+ uInt maxuint; // ..
+ Int ae, d, digits; // ..
+ Int emin, emax; // ..
+
+ if (dn==NULL) { // hopeless
+ #if DECTRACE
+ // this one not DECVERB as standard tests include NULL
+ printf("Reference to decNumber is NULL.\n");
+ #endif
+ return 1;}
+
+ // check special values
+ if (dn->bits & DECSPECIAL) {
+ if (dn->exponent!=0) {
+ #if DECTRACE || DECVERB
+ printf("Exponent %ld (not 0) for a special value [%02x].\n",
+ (LI)dn->exponent, dn->bits);
+ #endif
+ return 1;}
+
+ // 2003.09.08: NaNs may now have coefficients, so next tests Inf only
+ if (decNumberIsInfinite(dn)) {
+ if (dn->digits!=1) {
+ #if DECTRACE || DECVERB
+ printf("Digits %ld (not 1) for an infinity.\n", (LI)dn->digits);
+ #endif
+ return 1;}
+ if (*dn->lsu!=0) {
+ #if DECTRACE || DECVERB
+ printf("LSU %ld (not 0) for an infinity.\n", (LI)*dn->lsu);
+ #endif
+ decDumpAr('I', dn->lsu, D2U(dn->digits));
+ return 1;}
+ } // Inf
+ // 2002.12.26: negative NaNs can now appear through proposed IEEE
+ // concrete formats (decimal64, etc.).
+ return 0;
+ }
+
+ // check the coefficient
+ if (dn->digits<1 || dn->digits>DECNUMMAXP) {
+ #if DECTRACE || DECVERB
+ printf("Digits %ld in number.\n", (LI)dn->digits);
+ #endif
+ return 1;}
+
+ d=dn->digits;
+
+ for (up=dn->lsu; d>0; up++) {
+ if (d>DECDPUN) maxuint=DECDPUNMAX;
+ else { // reached the msu
+ maxuint=powers[d]-1;
+ if (dn->digits>1 && *up<powers[d-1]) {
+ #if DECTRACE || DECVERB
+ printf("Leading 0 in number.\n");
+ decNumberShow(dn);
+ #endif
+ return 1;}
+ }
+ if (*up>maxuint) {
+ #if DECTRACE || DECVERB
+ printf("Bad Unit [%08lx] in %ld-digit number at offset %ld [maxuint %ld].\n",
+ (LI)*up, (LI)dn->digits, (LI)(up-dn->lsu), (LI)maxuint);
+ #endif
+ return 1;}
+ d-=DECDPUN;
+ }
+
+ // check the exponent. Note that input operands can have exponents
+ // which are out of the set->emin/set->emax and set->digits range
+ // (just as they can have more digits than set->digits).
+ ae=dn->exponent+dn->digits-1; // adjusted exponent
+ emax=DECNUMMAXE;
+ emin=DECNUMMINE;
+ digits=DECNUMMAXP;
+ if (ae<emin-(digits-1)) {
+ #if DECTRACE || DECVERB
+ printf("Adjusted exponent underflow [%ld].\n", (LI)ae);
+ decNumberShow(dn);
+ #endif
+ return 1;}
+ if (ae>+emax) {
+ #if DECTRACE || DECVERB
+ printf("Adjusted exponent overflow [%ld].\n", (LI)ae);
+ decNumberShow(dn);
+ #endif
+ return 1;}
+
+ return 0; // it's OK
+ } // decCheckNumber
+
+/* ------------------------------------------------------------------ */
+/* decCheckInexact -- check a normal finite inexact result has digits */
+/* dn is the number to check */
+/* set is the context (for status and precision) */
+/* sets Invalid operation, etc., if some digits are missing */
+/* [this check is not made for DECSUBSET compilation or when */
+/* subnormal is not set] */
+/* ------------------------------------------------------------------ */
+static void decCheckInexact(const decNumber *dn, decContext *set) {
+ #if !DECSUBSET && DECEXTFLAG
+ if ((set->status & (DEC_Inexact|DEC_Subnormal))==DEC_Inexact
+ && (set->digits!=dn->digits) && !(dn->bits & DECSPECIAL)) {
+ #if DECTRACE || DECVERB
+ printf("Insufficient digits [%ld] on normal Inexact result.\n",
+ (LI)dn->digits);
+ decNumberShow(dn);
+ #endif
+ decContextSetStatus(set, DEC_Invalid_operation);
+ }
+ #else
+ // next is a noop for quiet compiler
+ if (dn!=NULL && dn->digits==0) set->status|=DEC_Invalid_operation;
+ #endif
+ return;
+ } // decCheckInexact
+#endif
+
+#if DECALLOC
+#undef malloc
+#undef free
+/* ------------------------------------------------------------------ */
+/* decMalloc -- accountable allocation routine */
+/* n is the number of bytes to allocate */
+/* */
+/* Semantics is the same as the stdlib malloc routine, but bytes */
+/* allocated are accounted for globally, and corruption fences are */
+/* added before and after the 'actual' storage. */
+/* ------------------------------------------------------------------ */
+/* This routine allocates storage with an extra twelve bytes; 8 are */
+/* at the start and hold: */
+/* 0-3 the original length requested */
+/* 4-7 buffer corruption detection fence (DECFENCE, x4) */
+/* The 4 bytes at the end also hold a corruption fence (DECFENCE, x4) */
+/* ------------------------------------------------------------------ */
+static void *decMalloc(size_t n) {
+ uInt size=n+12; // true size
+ void *alloc; // -> allocated storage
+ uByte *b, *b0; // work
+ uInt uiwork; // for macros
+
+ alloc=malloc(size); // -> allocated storage
+ if (alloc==NULL) return NULL; // out of strorage
+ b0=(uByte *)alloc; // as bytes
+ decAllocBytes+=n; // account for storage
+ UBFROMUI(alloc, n); // save n
+ // printf(" alloc ++ dAB: %ld (%ld)\n", (LI)decAllocBytes, (LI)n);
+ for (b=b0+4; b<b0+8; b++) *b=DECFENCE;
+ for (b=b0+n+8; b<b0+n+12; b++) *b=DECFENCE;
+ return b0+8; // -> play area
+ } // decMalloc
+
+/* ------------------------------------------------------------------ */
+/* decFree -- accountable free routine */
+/* alloc is the storage to free */
+/* */
+/* Semantics is the same as the stdlib malloc routine, except that */
+/* the global storage accounting is updated and the fences are */
+/* checked to ensure that no routine has written 'out of bounds'. */
+/* ------------------------------------------------------------------ */
+/* This routine first checks that the fences have not been corrupted. */
+/* It then frees the storage using the 'truw' storage address (that */
+/* is, offset by 8). */
+/* ------------------------------------------------------------------ */
+static void decFree(void *alloc) {
+ uInt n; // original length
+ uByte *b, *b0; // work
+ uInt uiwork; // for macros
+
+ if (alloc==NULL) return; // allowed; it's a nop
+ b0=(uByte *)alloc; // as bytes
+ b0-=8; // -> true start of storage
+ n=UBTOUI(b0); // lift length
+ for (b=b0+4; b<b0+8; b++) if (*b!=DECFENCE)
+ printf("=== Corrupt byte [%02x] at offset %d from %ld ===\n", *b,
+ b-b0-8, (LI)b0);
+ for (b=b0+n+8; b<b0+n+12; b++) if (*b!=DECFENCE)
+ printf("=== Corrupt byte [%02x] at offset +%d from %ld, n=%ld ===\n", *b,
+ b-b0-8, (LI)b0, (LI)n);
+ free(b0); // drop the storage
+ decAllocBytes-=n; // account for storage
+ // printf(" free -- dAB: %d (%d)\n", decAllocBytes, -n);
+ } // decFree
+#define malloc(a) decMalloc(a)
+#define free(a) decFree(a)
+#endif
diff --git a/source/luametatex/source/libraries/decnumber/decNumber.h b/source/luametatex/source/libraries/decnumber/decNumber.h
new file mode 100644
index 000000000..2981c73e0
--- /dev/null
+++ b/source/luametatex/source/libraries/decnumber/decNumber.h
@@ -0,0 +1,182 @@
+/* ------------------------------------------------------------------ */
+/* Decimal Number arithmetic module header */
+/* ------------------------------------------------------------------ */
+/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */
+/* */
+/* This software is made available under the terms of the */
+/* ICU License -- ICU 1.8.1 and later. */
+/* */
+/* The description and User's Guide ("The decNumber C Library") for */
+/* this software is called decNumber.pdf. This document is */
+/* available, together with arithmetic and format specifications, */
+/* testcases, and Web links, on the General Decimal Arithmetic page. */
+/* */
+/* Please send comments, suggestions, and corrections to the author: */
+/* mfc@uk.ibm.com */
+/* Mike Cowlishaw, IBM Fellow */
+/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */
+/* ------------------------------------------------------------------ */
+
+#if !defined(DECNUMBER)
+ #define DECNUMBER
+ #define DECNAME "decNumber" /* Short name */
+ #define DECFULLNAME "Decimal Number Module" /* Verbose name */
+ #define DECAUTHOR "Mike Cowlishaw" /* Who to blame */
+
+ #if !defined(DECCONTEXT)
+ #include "decContext.h"
+ #endif
+
+ /* Bit settings for decNumber.bits */
+ #define DECNEG 0x80 /* Sign; 1=negative, 0=positive or zero */
+ #define DECINF 0x40 /* 1=Infinity */
+ #define DECNAN 0x20 /* 1=NaN */
+ #define DECSNAN 0x10 /* 1=sNaN */
+ /* The remaining bits are reserved; they must be 0 */
+ #define DECSPECIAL (DECINF|DECNAN|DECSNAN) /* any special value */
+
+ /* Define the decNumber data structure. The size and shape of the */
+ /* units array in the structure is determined by the following */
+ /* constant. This must not be changed without recompiling the */
+ /* decNumber library modules. */
+
+ #define DECDPUN 3 /* DECimal Digits Per UNit [must be >0 */
+ /* and <10; 3 or powers of 2 are best]. */
+
+ /* DECNUMDIGITS is the default number of digits that can be held in */
+ /* the structure. If undefined, 1 is assumed and it is assumed */
+ /* that the structure will be immediately followed by extra space, */
+ /* as required. DECNUMDIGITS is always >0. */
+ #if !defined(DECNUMDIGITS)
+ #define DECNUMDIGITS 1
+ #endif
+
+ /* The size (integer data type) of each unit is determined by the */
+ /* number of digits it will hold. */
+ #if DECDPUN<=2
+ #define decNumberUnit uint8_t
+ #elif DECDPUN<=4
+ #define decNumberUnit uint16_t
+ #else
+ #define decNumberUnit uint32_t
+ #endif
+ /* The number of units needed is ceil(DECNUMDIGITS/DECDPUN) */
+ #define DECNUMUNITS ((DECNUMDIGITS+DECDPUN-1)/DECDPUN)
+
+ /* The data structure... */
+ typedef struct decNumber {
+ int32_t digits; /* Count of digits in the coefficient; >0 */
+ int32_t exponent; /* Unadjusted exponent, unbiased, in */
+ /* range: -1999999997 through 999999999 */
+ uint8_t bits; /* Indicator bits (see above) */
+ /* Coefficient, from least significant unit */
+ decNumberUnit lsu[DECNUMUNITS];
+ } decNumber;
+
+ /* Notes: */
+ /* 1. If digits is > DECDPUN then there will one or more */
+ /* decNumberUnits immediately following the first element of lsu.*/
+ /* These contain the remaining (more significant) digits of the */
+ /* number, and may be in the lsu array, or may be guaranteed by */
+ /* some other mechanism (such as being contained in another */
+ /* structure, or being overlaid on dynamically allocated */
+ /* storage). */
+ /* */
+ /* Each integer of the coefficient (except potentially the last) */
+ /* contains DECDPUN digits (e.g., a value in the range 0 through */
+ /* 99999999 if DECDPUN is 8, or 0 through 999 if DECDPUN is 3). */
+ /* */
+ /* 2. A decNumber converted to a string may need up to digits+14 */
+ /* characters. The worst cases (non-exponential and exponential */
+ /* formats) are -0.00000{9...}# and -9.{9...}E+999999999# */
+ /* (where # is '\0') */
+
+
+ /* ---------------------------------------------------------------- */
+ /* decNumber public functions and macros */
+ /* ---------------------------------------------------------------- */
+ /* Conversions */
+ decNumber * decNumberFromInt32(decNumber *, int32_t);
+ decNumber * decNumberFromUInt32(decNumber *, uint32_t);
+ decNumber * decNumberFromString(decNumber *, const char *, decContext *);
+ char * decNumberToString(const decNumber *, char *);
+ char * decNumberToEngString(const decNumber *, char *);
+ uint32_t decNumberToUInt32(const decNumber *, decContext *);
+ int32_t decNumberToInt32(const decNumber *, decContext *);
+ uint8_t * decNumberGetBCD(const decNumber *, uint8_t *);
+ decNumber * decNumberSetBCD(decNumber *, const uint8_t *, uint32_t);
+
+ /* Operators and elementary functions */
+ decNumber * decNumberAbs(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberAdd(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberAnd(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberCompare(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberCompareSignal(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberCompareTotal(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberCompareTotalMag(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberDivide(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberDivideInteger(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberExp(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberFMA(decNumber *, const decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberInvert(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberLn(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberLogB(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberLog10(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberMax(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberMaxMag(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberMin(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberMinMag(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberMinus(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberMultiply(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberNormalize(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberOr(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberPlus(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberPower(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberQuantize(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberReduce(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberRemainder(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberRemainderNear(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberRescale(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberRotate(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberSameQuantum(decNumber *, const decNumber *, const decNumber *);
+ decNumber * decNumberScaleB(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberShift(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberSquareRoot(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberSubtract(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberToIntegralExact(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberToIntegralValue(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberXor(decNumber *, const decNumber *, const decNumber *, decContext *);
+
+ /* Utilities */
+ enum decClass decNumberClass(const decNumber *, decContext *);
+ const char * decNumberClassToString(enum decClass);
+ decNumber * decNumberCopy(decNumber *, const decNumber *);
+ decNumber * decNumberCopyAbs(decNumber *, const decNumber *);
+ decNumber * decNumberCopyNegate(decNumber *, const decNumber *);
+ decNumber * decNumberCopySign(decNumber *, const decNumber *, const decNumber *);
+ decNumber * decNumberNextMinus(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberNextPlus(decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberNextToward(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumber * decNumberTrim(decNumber *);
+ const char * decNumberVersion(void);
+ decNumber * decNumberZero(decNumber *);
+
+ /* Functions for testing decNumbers (normality depends on context) */
+ int32_t decNumberIsNormal(const decNumber *, decContext *);
+ int32_t decNumberIsSubnormal(const decNumber *, decContext *);
+
+ /* Macros for testing decNumber *dn */
+ #define decNumberIsCanonical(dn) (1) /* All decNumbers are saintly */
+ #define decNumberIsFinite(dn) (((dn)->bits&DECSPECIAL)==0)
+ #define decNumberIsInfinite(dn) (((dn)->bits&DECINF)!=0)
+ #define decNumberIsNaN(dn) (((dn)->bits&(DECNAN|DECSNAN))!=0)
+ #define decNumberIsNegative(dn) (((dn)->bits&DECNEG)!=0)
+ #define decNumberIsQNaN(dn) (((dn)->bits&(DECNAN))!=0)
+ #define decNumberIsSNaN(dn) (((dn)->bits&(DECSNAN))!=0)
+ #define decNumberIsSpecial(dn) (((dn)->bits&DECSPECIAL)!=0)
+ #define decNumberIsZero(dn) (*(dn)->lsu==0 \
+ && (dn)->digits==1 \
+ && (((dn)->bits&DECSPECIAL)==0))
+ #define decNumberRadix(dn) (10)
+
+#endif
diff --git a/source/luametatex/source/libraries/decnumber/decNumberLocal.h b/source/luametatex/source/libraries/decnumber/decNumberLocal.h
new file mode 100644
index 000000000..bf874ae44
--- /dev/null
+++ b/source/luametatex/source/libraries/decnumber/decNumberLocal.h
@@ -0,0 +1,757 @@
+/* ------------------------------------------------------------------ */
+/* decNumber package local type, tuning, and macro definitions */
+/* ------------------------------------------------------------------ */
+/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */
+/* */
+/* This software is made available under the terms of the */
+/* ICU License -- ICU 1.8.1 and later. */
+/* */
+/* The description and User's Guide ("The decNumber C Library") for */
+/* this software is called decNumber.pdf. This document is */
+/* available, together with arithmetic and format specifications, */
+/* testcases, and Web links, on the General Decimal Arithmetic page. */
+/* */
+/* Please send comments, suggestions, and corrections to the author: */
+/* mfc@uk.ibm.com */
+/* Mike Cowlishaw, IBM Fellow */
+/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */
+/* ------------------------------------------------------------------ */
+/* This header file is included by all modules in the decNumber */
+/* library, and contains local type definitions, tuning parameters, */
+/* etc. It should not need to be used by application programs. */
+/* decNumber.h or one of decDouble (etc.) must be included first. */
+/* ------------------------------------------------------------------ */
+
+#if !defined(DECNUMBERLOC)
+ #define DECNUMBERLOC
+ #define DECVERSION "decNumber 3.68" /* Package Version [16 max.] */
+ #define DECNLAUTHOR "Mike Cowlishaw" /* Who to blame */
+
+ #include <stdlib.h> /* for abs */
+ #include <string.h> /* for memset, strcpy */
+
+ /* Conditional code flag -- set this to match hardware platform */
+ #if !defined(DECLITEND)
+ #define DECLITEND 1 /* 1=little-endian, 0=big-endian */
+ #endif
+
+ /* Conditional code flag -- set this to 1 for best performance */
+ #if !defined(DECUSE64)
+ #define DECUSE64 1 /* 1=use int64s, 0=int32 & smaller only */
+ #endif
+
+ /* Conditional code flag -- set this to 0 to exclude printf calls */
+ #if !defined(DECPRINT)
+ #define DECPRINT 1 /* 1=allow printf calls; 0=no printf */
+ #endif
+
+ /* Conditional check flags -- set these to 0 for best performance */
+ #if !defined(DECCHECK)
+ #define DECCHECK 0 /* 1 to enable robust checking */
+ #endif
+ #if !defined(DECALLOC)
+ #define DECALLOC 0 /* 1 to enable memory accounting */
+ #endif
+ #if !defined(DECTRACE)
+ #define DECTRACE 0 /* 1 to trace certain internals, etc. */
+ #endif
+
+ /* Tuning parameter for decNumber (arbitrary precision) module */
+ #if !defined(DECBUFFER)
+ #define DECBUFFER 36 /* Size basis for local buffers. This */
+ /* should be a common maximum precision */
+ /* rounded up to a multiple of 4; must */
+ /* be zero or positive. */
+ #endif
+
+
+ /* ---------------------------------------------------------------- */
+ /* Check parameter dependencies */
+ /* ---------------------------------------------------------------- */
+ #if DECCHECK & !DECPRINT
+ #error DECCHECK needs DECPRINT to be useful
+ #endif
+ #if DECALLOC & !DECPRINT
+ #error DECALLOC needs DECPRINT to be useful
+ #endif
+ #if DECTRACE & !DECPRINT
+ #error DECTRACE needs DECPRINT to be useful
+ #endif
+
+ /* ---------------------------------------------------------------- */
+ /* Definitions for all modules (general-purpose) */
+ /* ---------------------------------------------------------------- */
+
+ /* Local names for common types -- for safety, decNumber modules do */
+ /* not use int or long directly. */
+ #define Flag uint8_t
+ #define Byte int8_t
+ #define uByte uint8_t
+ #define Short int16_t
+ #define uShort uint16_t
+ #define Int int32_t
+ #define uInt uint32_t
+ #define Unit decNumberUnit
+ #if DECUSE64
+ #define Long int64_t
+ #define uLong uint64_t
+ #endif
+
+ /* Development-use definitions */
+ typedef long int LI; /* for printf arguments only */
+ #define DECNOINT 0 /* 1 to check no internal use of 'int' */
+ /* or stdint types */
+ #if DECNOINT
+ /* if these interfere with your C includes, do not set DECNOINT */
+ #define int ? /* enable to ensure that plain C 'int' */
+ #define long ?? /* .. or 'long' types are not used */
+ #endif
+
+ /* Shared lookup tables */
+ extern const uByte DECSTICKYTAB[10]; /* re-round digits if sticky */
+ extern const uInt DECPOWERS[10]; /* powers of ten table */
+ /* The following are included from decDPD.h */
+ extern const uShort DPD2BIN[1024]; /* DPD -> 0-999 */
+ extern const uShort BIN2DPD[1000]; /* 0-999 -> DPD */
+ extern const uInt DPD2BINK[1024]; /* DPD -> 0-999000 */
+ extern const uInt DPD2BINM[1024]; /* DPD -> 0-999000000 */
+ extern const uByte DPD2BCD8[4096]; /* DPD -> ddd + len */
+ extern const uByte BIN2BCD8[4000]; /* 0-999 -> ddd + len */
+ extern const uShort BCD2DPD[2458]; /* 0-0x999 -> DPD (0x999=2457)*/
+
+ /* LONGMUL32HI -- set w=(u*v)>>32, where w, u, and v are uInts */
+ /* (that is, sets w to be the high-order word of the 64-bit result; */
+ /* the low-order word is simply u*v.) */
+ /* This version is derived from Knuth via Hacker's Delight; */
+ /* it seems to optimize better than some others tried */
+ #define LONGMUL32HI(w, u, v) { \
+ uInt u0, u1, v0, v1, w0, w1, w2, t; \
+ u0=u & 0xffff; u1=u>>16; \
+ v0=v & 0xffff; v1=v>>16; \
+ w0=u0*v0; \
+ t=u1*v0 + (w0>>16); \
+ w1=t & 0xffff; w2=t>>16; \
+ w1=u0*v1 + w1; \
+ (w)=u1*v1 + w2 + (w1>>16);}
+
+ /* ROUNDUP -- round an integer up to a multiple of n */
+ #define ROUNDUP(i, n) ((((i)+(n)-1)/n)*n)
+ #define ROUNDUP4(i) (((i)+3)&~3) /* special for n=4 */
+
+ /* ROUNDDOWN -- round an integer down to a multiple of n */
+ #define ROUNDDOWN(i, n) (((i)/n)*n)
+ #define ROUNDDOWN4(i) ((i)&~3) /* special for n=4 */
+
+ /* References to multi-byte sequences under different sizes; these */
+ /* require locally declared variables, but do not violate strict */
+ /* aliasing or alignment (as did the UINTAT simple cast to uInt). */
+ /* Variables needed are uswork, uiwork, etc. [so do not use at same */
+ /* level in an expression, e.g., UBTOUI(x)==UBTOUI(y) may fail]. */
+
+ /* Return a uInt, etc., from bytes starting at a char* or uByte* */
+ #define UBTOUS(b) (memcpy((void *)&uswork, b, 2), uswork)
+ #define UBTOUI(b) (memcpy((void *)&uiwork, b, 4), uiwork)
+
+ /* Store a uInt, etc., into bytes starting at a char* or uByte*. */
+ /* Returns i, evaluated, for convenience; has to use uiwork because */
+ /* i may be an expression. */
+ #define UBFROMUS(b, i) (uswork=(i), memcpy(b, (void *)&uswork, 2), uswork)
+ #define UBFROMUI(b, i) (uiwork=(i), memcpy(b, (void *)&uiwork, 4), uiwork)
+
+ /* X10 and X100 -- multiply integer i by 10 or 100 */
+ /* [shifts are usually faster than multiply; could be conditional] */
+ #define X10(i) (((i)<<1)+((i)<<3))
+ #define X100(i) (((i)<<2)+((i)<<5)+((i)<<6))
+
+ /* MAXI and MINI -- general max & min (not in ANSI) for integers */
+ #define MAXI(x,y) ((x)<(y)?(y):(x))
+ #define MINI(x,y) ((x)>(y)?(y):(x))
+
+ /* Useful constants */
+ #define BILLION 1000000000 /* 10**9 */
+ /* CHARMASK: 0x30303030 for ASCII/UTF8; 0xF0F0F0F0 for EBCDIC */
+ #define CHARMASK ((((((((uInt)'0')<<8)+'0')<<8)+'0')<<8)+'0')
+
+
+ /* ---------------------------------------------------------------- */
+ /* Definitions for arbitary-precision modules (only valid after */
+ /* decNumber.h has been included) */
+ /* ---------------------------------------------------------------- */
+
+ /* Limits and constants */
+ #define DECNUMMAXP 999999999 /* maximum precision code can handle */
+ #define DECNUMMAXE 999999999 /* maximum adjusted exponent ditto */
+ #define DECNUMMINE -999999999 /* minimum adjusted exponent ditto */
+ #if (DECNUMMAXP != DEC_MAX_DIGITS)
+ #error Maximum digits mismatch
+ #endif
+ #if (DECNUMMAXE != DEC_MAX_EMAX)
+ #error Maximum exponent mismatch
+ #endif
+ #if (DECNUMMINE != DEC_MIN_EMIN)
+ #error Minimum exponent mismatch
+ #endif
+
+ /* Set DECDPUNMAX -- the maximum integer that fits in DECDPUN */
+ /* digits, and D2UTABLE -- the initializer for the D2U table */
+ #if DECDPUN==1
+ #define DECDPUNMAX 9
+ #define D2UTABLE {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, \
+ 18,19,20,21,22,23,24,25,26,27,28,29,30,31,32, \
+ 33,34,35,36,37,38,39,40,41,42,43,44,45,46,47, \
+ 48,49}
+ #elif DECDPUN==2
+ #define DECDPUNMAX 99
+ #define D2UTABLE {0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10, \
+ 11,11,12,12,13,13,14,14,15,15,16,16,17,17,18, \
+ 18,19,19,20,20,21,21,22,22,23,23,24,24,25}
+ #elif DECDPUN==3
+ #define DECDPUNMAX 999
+ #define D2UTABLE {0,1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6,7,7,7, \
+ 8,8,8,9,9,9,10,10,10,11,11,11,12,12,12,13,13, \
+ 13,14,14,14,15,15,15,16,16,16,17}
+ #elif DECDPUN==4
+ #define DECDPUNMAX 9999
+ #define D2UTABLE {0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6, \
+ 6,6,6,7,7,7,7,8,8,8,8,9,9,9,9,10,10,10,10,11, \
+ 11,11,11,12,12,12,12,13}
+ #elif DECDPUN==5
+ #define DECDPUNMAX 99999
+ #define D2UTABLE {0,1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5, \
+ 5,5,5,5,6,6,6,6,6,7,7,7,7,7,8,8,8,8,8,9,9,9, \
+ 9,9,10,10,10,10}
+ #elif DECDPUN==6
+ #define DECDPUNMAX 999999
+ #define D2UTABLE {0,1,1,1,1,1,1,2,2,2,2,2,2,3,3,3,3,3,3,4,4,4, \
+ 4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,7,7,7,7,7,7,8, \
+ 8,8,8,8,8,9}
+ #elif DECDPUN==7
+ #define DECDPUNMAX 9999999
+ #define D2UTABLE {0,1,1,1,1,1,1,1,2,2,2,2,2,2,2,3,3,3,3,3,3,3, \
+ 4,4,4,4,4,4,4,5,5,5,5,5,5,5,6,6,6,6,6,6,6,7, \
+ 7,7,7,7,7,7}
+ #elif DECDPUN==8
+ #define DECDPUNMAX 99999999
+ #define D2UTABLE {0,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3, \
+ 3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6, \
+ 6,6,6,6,6,7}
+ #elif DECDPUN==9
+ #define DECDPUNMAX 999999999
+ #define D2UTABLE {0,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,3,3,3, \
+ 3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5, \
+ 5,5,6,6,6,6}
+ #elif defined(DECDPUN)
+ #error DECDPUN must be in the range 1-9
+ #endif
+
+ /* ----- Shared data (in decNumber.c) ----- */
+ /* Public lookup table used by the D2U macro (see below) */
+ #define DECMAXD2U 49
+ extern const uByte d2utable[DECMAXD2U+1];
+
+ /* ----- Macros ----- */
+ /* ISZERO -- return true if decNumber dn is a zero */
+ /* [performance-critical in some situations] */
+ #define ISZERO(dn) decNumberIsZero(dn) /* now just a local name */
+
+ /* D2U -- return the number of Units needed to hold d digits */
+ /* (runtime version, with table lookaside for small d) */
+ #if DECDPUN==8
+ #define D2U(d) ((unsigned)((d)<=DECMAXD2U?d2utable[d]:((d)+7)>>3))
+ #elif DECDPUN==4
+ #define D2U(d) ((unsigned)((d)<=DECMAXD2U?d2utable[d]:((d)+3)>>2))
+ #else
+ #define D2U(d) ((d)<=DECMAXD2U?d2utable[d]:((d)+DECDPUN-1)/DECDPUN)
+ #endif
+ /* SD2U -- static D2U macro (for compile-time calculation) */
+ #define SD2U(d) (((d)+DECDPUN-1)/DECDPUN)
+
+ /* MSUDIGITS -- returns digits in msu, from digits, calculated */
+ /* using D2U */
+ #define MSUDIGITS(d) ((d)-(D2U(d)-1)*DECDPUN)
+
+ /* D2N -- return the number of decNumber structs that would be */
+ /* needed to contain that number of digits (and the initial */
+ /* decNumber struct) safely. Note that one Unit is included in the */
+ /* initial structure. Used for allocating space that is aligned on */
+ /* a decNumber struct boundary. */
+ #define D2N(d) \
+ ((((SD2U(d)-1)*sizeof(Unit))+sizeof(decNumber)*2-1)/sizeof(decNumber))
+
+ /* TODIGIT -- macro to remove the leading digit from the unsigned */
+ /* integer u at column cut (counting from the right, LSD=0) and */
+ /* place it as an ASCII character into the character pointed to by */
+ /* c. Note that cut must be <= 9, and the maximum value for u is */
+ /* 2,000,000,000 (as is needed for negative exponents of */
+ /* subnormals). The unsigned integer pow is used as a temporary */
+ /* variable. */
+ #define TODIGIT(u, cut, c, pow) { \
+ *(c)='0'; \
+ pow=DECPOWERS[cut]*2; \
+ if ((u)>pow) { \
+ pow*=4; \
+ if ((u)>=pow) {(u)-=pow; *(c)+=8;} \
+ pow/=2; \
+ if ((u)>=pow) {(u)-=pow; *(c)+=4;} \
+ pow/=2; \
+ } \
+ if ((u)>=pow) {(u)-=pow; *(c)+=2;} \
+ pow/=2; \
+ if ((u)>=pow) {(u)-=pow; *(c)+=1;} \
+ }
+
+ /* ---------------------------------------------------------------- */
+ /* Definitions for fixed-precision modules (only valid after */
+ /* decSingle.h, decDouble.h, or decQuad.h has been included) */
+ /* ---------------------------------------------------------------- */
+
+ /* bcdnum -- a structure describing a format-independent finite */
+ /* number, whose coefficient is a string of bcd8 uBytes */
+ typedef struct bcdnum {
+ uByte *msd; /* -> most significant digit */
+ uByte *lsd; /* -> least ditto */
+ uInt sign; /* 0=positive, DECFLOAT_Sign=negative */
+ Int exponent; /* Unadjusted signed exponent (q), or */
+ /* DECFLOAT_NaN etc. for a special */
+ } bcdnum;
+
+ /* Test if exponent or bcdnum exponent must be a special, etc. */
+ #define EXPISSPECIAL(exp) ((exp)>=DECFLOAT_MinSp)
+ #define EXPISINF(exp) (exp==DECFLOAT_Inf)
+ #define EXPISNAN(exp) (exp==DECFLOAT_qNaN || exp==DECFLOAT_sNaN)
+ #define NUMISSPECIAL(num) (EXPISSPECIAL((num)->exponent))
+
+ /* Refer to a 32-bit word or byte in a decFloat (df) by big-endian */
+ /* (array) notation (the 0 word or byte contains the sign bit), */
+ /* automatically adjusting for endianness; similarly address a word */
+ /* in the next-wider format (decFloatWider, or dfw) */
+ #define DECWORDS (DECBYTES/4)
+ #define DECWWORDS (DECWBYTES/4)
+ #if DECLITEND
+ #define DFBYTE(df, off) ((df)->bytes[DECBYTES-1-(off)])
+ #define DFWORD(df, off) ((df)->words[DECWORDS-1-(off)])
+ #define DFWWORD(dfw, off) ((dfw)->words[DECWWORDS-1-(off)])
+ #else
+ #define DFBYTE(df, off) ((df)->bytes[off])
+ #define DFWORD(df, off) ((df)->words[off])
+ #define DFWWORD(dfw, off) ((dfw)->words[off])
+ #endif
+
+ /* Tests for sign or specials, directly on DECFLOATs */
+ #define DFISSIGNED(df) ((DFWORD(df, 0)&0x80000000)!=0)
+ #define DFISSPECIAL(df) ((DFWORD(df, 0)&0x78000000)==0x78000000)
+ #define DFISINF(df) ((DFWORD(df, 0)&0x7c000000)==0x78000000)
+ #define DFISNAN(df) ((DFWORD(df, 0)&0x7c000000)==0x7c000000)
+ #define DFISQNAN(df) ((DFWORD(df, 0)&0x7e000000)==0x7c000000)
+ #define DFISSNAN(df) ((DFWORD(df, 0)&0x7e000000)==0x7e000000)
+
+ /* Shared lookup tables */
+ extern const uInt DECCOMBMSD[64]; /* Combination field -> MSD */
+ extern const uInt DECCOMBFROM[48]; /* exp+msd -> Combination */
+
+ /* Private generic (utility) routine */
+ #if DECCHECK || DECTRACE
+ extern void decShowNum(const bcdnum *, const char *);
+ #endif
+
+ /* Format-dependent macros and constants */
+ #if defined(DECPMAX)
+
+ /* Useful constants */
+ #define DECPMAX9 (ROUNDUP(DECPMAX, 9)/9) /* 'Pmax' in 10**9s */
+ /* Top words for a zero */
+ #define SINGLEZERO 0x22500000
+ #define DOUBLEZERO 0x22380000
+ #define QUADZERO 0x22080000
+ /* [ZEROWORD is defined to be one of these in the DFISZERO macro] */
+
+ /* Format-dependent common tests: */
+ /* DFISZERO -- test for (any) zero */
+ /* DFISCCZERO -- test for coefficient continuation being zero */
+ /* DFISCC01 -- test for coefficient contains only 0s and 1s */
+ /* DFISINT -- test for finite and exponent q=0 */
+ /* DFISUINT01 -- test for sign=0, finite, exponent q=0, and */
+ /* MSD=0 or 1 */
+ /* ZEROWORD is also defined here. */
+ /* */
+ /* In DFISZERO the first test checks the least-significant word */
+ /* (most likely to be non-zero); the penultimate tests MSD and */
+ /* DPDs in the signword, and the final test excludes specials and */
+ /* MSD>7. DFISINT similarly has to allow for the two forms of */
+ /* MSD codes. DFISUINT01 only has to allow for one form of MSD */
+ /* code. */
+ #if DECPMAX==7
+ #define ZEROWORD SINGLEZERO
+ /* [test macros not needed except for Zero] */
+ #define DFISZERO(df) ((DFWORD(df, 0)&0x1c0fffff)==0 \
+ && (DFWORD(df, 0)&0x60000000)!=0x60000000)
+ #elif DECPMAX==16
+ #define ZEROWORD DOUBLEZERO
+ #define DFISZERO(df) ((DFWORD(df, 1)==0 \
+ && (DFWORD(df, 0)&0x1c03ffff)==0 \
+ && (DFWORD(df, 0)&0x60000000)!=0x60000000))
+ #define DFISINT(df) ((DFWORD(df, 0)&0x63fc0000)==0x22380000 \
+ ||(DFWORD(df, 0)&0x7bfc0000)==0x6a380000)
+ #define DFISUINT01(df) ((DFWORD(df, 0)&0xfbfc0000)==0x22380000)
+ #define DFISCCZERO(df) (DFWORD(df, 1)==0 \
+ && (DFWORD(df, 0)&0x0003ffff)==0)
+ #define DFISCC01(df) ((DFWORD(df, 0)&~0xfffc9124)==0 \
+ && (DFWORD(df, 1)&~0x49124491)==0)
+ #elif DECPMAX==34
+ #define ZEROWORD QUADZERO
+ #define DFISZERO(df) ((DFWORD(df, 3)==0 \
+ && DFWORD(df, 2)==0 \
+ && DFWORD(df, 1)==0 \
+ && (DFWORD(df, 0)&0x1c003fff)==0 \
+ && (DFWORD(df, 0)&0x60000000)!=0x60000000))
+ #define DFISINT(df) ((DFWORD(df, 0)&0x63ffc000)==0x22080000 \
+ ||(DFWORD(df, 0)&0x7bffc000)==0x6a080000)
+ #define DFISUINT01(df) ((DFWORD(df, 0)&0xfbffc000)==0x22080000)
+ #define DFISCCZERO(df) (DFWORD(df, 3)==0 \
+ && DFWORD(df, 2)==0 \
+ && DFWORD(df, 1)==0 \
+ && (DFWORD(df, 0)&0x00003fff)==0)
+
+ #define DFISCC01(df) ((DFWORD(df, 0)&~0xffffc912)==0 \
+ && (DFWORD(df, 1)&~0x44912449)==0 \
+ && (DFWORD(df, 2)&~0x12449124)==0 \
+ && (DFWORD(df, 3)&~0x49124491)==0)
+ #endif
+
+ /* Macros to test if a certain 10 bits of a uInt or pair of uInts */
+ /* are a canonical declet [higher or lower bits are ignored]. */
+ /* declet is at offset 0 (from the right) in a uInt: */
+ #define CANONDPD(dpd) (((dpd)&0x300)==0 || ((dpd)&0x6e)!=0x6e)
+ /* declet is at offset k (a multiple of 2) in a uInt: */
+ #define CANONDPDOFF(dpd, k) (((dpd)&(0x300<<(k)))==0 \
+ || ((dpd)&(((uInt)0x6e)<<(k)))!=(((uInt)0x6e)<<(k)))
+ /* declet is at offset k (a multiple of 2) in a pair of uInts: */
+ /* [the top 2 bits will always be in the more-significant uInt] */
+ #define CANONDPDTWO(hi, lo, k) (((hi)&(0x300>>(32-(k))))==0 \
+ || ((hi)&(0x6e>>(32-(k))))!=(0x6e>>(32-(k))) \
+ || ((lo)&(((uInt)0x6e)<<(k)))!=(((uInt)0x6e)<<(k)))
+
+ /* Macro to test whether a full-length (length DECPMAX) BCD8 */
+ /* coefficient, starting at uByte u, is all zeros */
+ /* Test just the LSWord first, then the remainder as a sequence */
+ /* of tests in order to avoid same-level use of UBTOUI */
+ #if DECPMAX==7
+ #define ISCOEFFZERO(u) ( \
+ UBTOUI((u)+DECPMAX-4)==0 \
+ && UBTOUS((u)+DECPMAX-6)==0 \
+ && *(u)==0)
+ #elif DECPMAX==16
+ #define ISCOEFFZERO(u) ( \
+ UBTOUI((u)+DECPMAX-4)==0 \
+ && UBTOUI((u)+DECPMAX-8)==0 \
+ && UBTOUI((u)+DECPMAX-12)==0 \
+ && UBTOUI(u)==0)
+ #elif DECPMAX==34
+ #define ISCOEFFZERO(u) ( \
+ UBTOUI((u)+DECPMAX-4)==0 \
+ && UBTOUI((u)+DECPMAX-8)==0 \
+ && UBTOUI((u)+DECPMAX-12)==0 \
+ && UBTOUI((u)+DECPMAX-16)==0 \
+ && UBTOUI((u)+DECPMAX-20)==0 \
+ && UBTOUI((u)+DECPMAX-24)==0 \
+ && UBTOUI((u)+DECPMAX-28)==0 \
+ && UBTOUI((u)+DECPMAX-32)==0 \
+ && UBTOUS(u)==0)
+ #endif
+
+ /* Macros and masks for the sign, exponent continuation, and MSD */
+ /* Get the sign as DECFLOAT_Sign or 0 */
+ #define GETSIGN(df) (DFWORD(df, 0)&0x80000000)
+ /* Get the exponent continuation from a decFloat *df as an Int */
+ #define GETECON(df) ((Int)((DFWORD((df), 0)&0x03ffffff)>>(32-6-DECECONL)))
+ /* Ditto, from the next-wider format */
+ #define GETWECON(df) ((Int)((DFWWORD((df), 0)&0x03ffffff)>>(32-6-DECWECONL)))
+ /* Get the biased exponent similarly */
+ #define GETEXP(df) ((Int)(DECCOMBEXP[DFWORD((df), 0)>>26]+GETECON(df)))
+ /* Get the unbiased exponent similarly */
+ #define GETEXPUN(df) ((Int)GETEXP(df)-DECBIAS)
+ /* Get the MSD similarly (as uInt) */
+ #define GETMSD(df) (DECCOMBMSD[DFWORD((df), 0)>>26])
+
+ /* Compile-time computes of the exponent continuation field masks */
+ /* full exponent continuation field: */
+ #define ECONMASK ((0x03ffffff>>(32-6-DECECONL))<<(32-6-DECECONL))
+ /* same, not including its first digit (the qNaN/sNaN selector): */
+ #define ECONNANMASK ((0x01ffffff>>(32-6-DECECONL))<<(32-6-DECECONL))
+
+ /* Macros to decode the coefficient in a finite decFloat *df into */
+ /* a BCD string (uByte *bcdin) of length DECPMAX uBytes. */
+
+ /* In-line sequence to convert least significant 10 bits of uInt */
+ /* dpd to three BCD8 digits starting at uByte u. Note that an */
+ /* extra byte is written to the right of the three digits because */
+ /* four bytes are moved at a time for speed; the alternative */
+ /* macro moves exactly three bytes (usually slower). */
+ #define dpd2bcd8(u, dpd) memcpy(u, &DPD2BCD8[((dpd)&0x3ff)*4], 4)
+ #define dpd2bcd83(u, dpd) memcpy(u, &DPD2BCD8[((dpd)&0x3ff)*4], 3)
+
+ /* Decode the declets. After extracting each one, it is decoded */
+ /* to BCD8 using a table lookup (also used for variable-length */
+ /* decode). Each DPD decode is 3 bytes BCD8 plus a one-byte */
+ /* length which is not used, here). Fixed-length 4-byte moves */
+ /* are fast, however, almost everywhere, and so are used except */
+ /* for the final three bytes (to avoid overrun). The code below */
+ /* is 36 instructions for Doubles and about 70 for Quads, even */
+ /* on IA32. */
+
+ /* Two macros are defined for each format: */
+ /* GETCOEFF extracts the coefficient of the current format */
+ /* GETWCOEFF extracts the coefficient of the next-wider format. */
+ /* The latter is a copy of the next-wider GETCOEFF using DFWWORD. */
+
+ #if DECPMAX==7
+ #define GETCOEFF(df, bcd) { \
+ uInt sourhi=DFWORD(df, 0); \
+ *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \
+ dpd2bcd8(bcd+1, sourhi>>10); \
+ dpd2bcd83(bcd+4, sourhi);}
+ #define GETWCOEFF(df, bcd) { \
+ uInt sourhi=DFWWORD(df, 0); \
+ uInt sourlo=DFWWORD(df, 1); \
+ *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \
+ dpd2bcd8(bcd+1, sourhi>>8); \
+ dpd2bcd8(bcd+4, (sourhi<<2) | (sourlo>>30)); \
+ dpd2bcd8(bcd+7, sourlo>>20); \
+ dpd2bcd8(bcd+10, sourlo>>10); \
+ dpd2bcd83(bcd+13, sourlo);}
+
+ #elif DECPMAX==16
+ #define GETCOEFF(df, bcd) { \
+ uInt sourhi=DFWORD(df, 0); \
+ uInt sourlo=DFWORD(df, 1); \
+ *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \
+ dpd2bcd8(bcd+1, sourhi>>8); \
+ dpd2bcd8(bcd+4, (sourhi<<2) | (sourlo>>30)); \
+ dpd2bcd8(bcd+7, sourlo>>20); \
+ dpd2bcd8(bcd+10, sourlo>>10); \
+ dpd2bcd83(bcd+13, sourlo);}
+ #define GETWCOEFF(df, bcd) { \
+ uInt sourhi=DFWWORD(df, 0); \
+ uInt sourmh=DFWWORD(df, 1); \
+ uInt sourml=DFWWORD(df, 2); \
+ uInt sourlo=DFWWORD(df, 3); \
+ *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \
+ dpd2bcd8(bcd+1, sourhi>>4); \
+ dpd2bcd8(bcd+4, ((sourhi)<<6) | (sourmh>>26)); \
+ dpd2bcd8(bcd+7, sourmh>>16); \
+ dpd2bcd8(bcd+10, sourmh>>6); \
+ dpd2bcd8(bcd+13, ((sourmh)<<4) | (sourml>>28)); \
+ dpd2bcd8(bcd+16, sourml>>18); \
+ dpd2bcd8(bcd+19, sourml>>8); \
+ dpd2bcd8(bcd+22, ((sourml)<<2) | (sourlo>>30)); \
+ dpd2bcd8(bcd+25, sourlo>>20); \
+ dpd2bcd8(bcd+28, sourlo>>10); \
+ dpd2bcd83(bcd+31, sourlo);}
+
+ #elif DECPMAX==34
+ #define GETCOEFF(df, bcd) { \
+ uInt sourhi=DFWORD(df, 0); \
+ uInt sourmh=DFWORD(df, 1); \
+ uInt sourml=DFWORD(df, 2); \
+ uInt sourlo=DFWORD(df, 3); \
+ *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \
+ dpd2bcd8(bcd+1, sourhi>>4); \
+ dpd2bcd8(bcd+4, ((sourhi)<<6) | (sourmh>>26)); \
+ dpd2bcd8(bcd+7, sourmh>>16); \
+ dpd2bcd8(bcd+10, sourmh>>6); \
+ dpd2bcd8(bcd+13, ((sourmh)<<4) | (sourml>>28)); \
+ dpd2bcd8(bcd+16, sourml>>18); \
+ dpd2bcd8(bcd+19, sourml>>8); \
+ dpd2bcd8(bcd+22, ((sourml)<<2) | (sourlo>>30)); \
+ dpd2bcd8(bcd+25, sourlo>>20); \
+ dpd2bcd8(bcd+28, sourlo>>10); \
+ dpd2bcd83(bcd+31, sourlo);}
+
+ #define GETWCOEFF(df, bcd) {??} /* [should never be used] */
+ #endif
+
+ /* Macros to decode the coefficient in a finite decFloat *df into */
+ /* a base-billion uInt array, with the least-significant */
+ /* 0-999999999 'digit' at offset 0. */
+
+ /* Decode the declets. After extracting each one, it is decoded */
+ /* to binary using a table lookup. Three tables are used; one */
+ /* the usual DPD to binary, the other two pre-multiplied by 1000 */
+ /* and 1000000 to avoid multiplication during decode. These */
+ /* tables can also be used for multiplying up the MSD as the DPD */
+ /* code for 0 through 9 is the identity. */
+ #define DPD2BIN0 DPD2BIN /* for prettier code */
+
+ #if DECPMAX==7
+ #define GETCOEFFBILL(df, buf) { \
+ uInt sourhi=DFWORD(df, 0); \
+ (buf)[0]=DPD2BIN0[sourhi&0x3ff] \
+ +DPD2BINK[(sourhi>>10)&0x3ff] \
+ +DPD2BINM[DECCOMBMSD[sourhi>>26]];}
+
+ #elif DECPMAX==16
+ #define GETCOEFFBILL(df, buf) { \
+ uInt sourhi, sourlo; \
+ sourlo=DFWORD(df, 1); \
+ (buf)[0]=DPD2BIN0[sourlo&0x3ff] \
+ +DPD2BINK[(sourlo>>10)&0x3ff] \
+ +DPD2BINM[(sourlo>>20)&0x3ff]; \
+ sourhi=DFWORD(df, 0); \
+ (buf)[1]=DPD2BIN0[((sourhi<<2) | (sourlo>>30))&0x3ff] \
+ +DPD2BINK[(sourhi>>8)&0x3ff] \
+ +DPD2BINM[DECCOMBMSD[sourhi>>26]];}
+
+ #elif DECPMAX==34
+ #define GETCOEFFBILL(df, buf) { \
+ uInt sourhi, sourmh, sourml, sourlo; \
+ sourlo=DFWORD(df, 3); \
+ (buf)[0]=DPD2BIN0[sourlo&0x3ff] \
+ +DPD2BINK[(sourlo>>10)&0x3ff] \
+ +DPD2BINM[(sourlo>>20)&0x3ff]; \
+ sourml=DFWORD(df, 2); \
+ (buf)[1]=DPD2BIN0[((sourml<<2) | (sourlo>>30))&0x3ff] \
+ +DPD2BINK[(sourml>>8)&0x3ff] \
+ +DPD2BINM[(sourml>>18)&0x3ff]; \
+ sourmh=DFWORD(df, 1); \
+ (buf)[2]=DPD2BIN0[((sourmh<<4) | (sourml>>28))&0x3ff] \
+ +DPD2BINK[(sourmh>>6)&0x3ff] \
+ +DPD2BINM[(sourmh>>16)&0x3ff]; \
+ sourhi=DFWORD(df, 0); \
+ (buf)[3]=DPD2BIN0[((sourhi<<6) | (sourmh>>26))&0x3ff] \
+ +DPD2BINK[(sourhi>>4)&0x3ff] \
+ +DPD2BINM[DECCOMBMSD[sourhi>>26]];}
+
+ #endif
+
+ /* Macros to decode the coefficient in a finite decFloat *df into */
+ /* a base-thousand uInt array (of size DECLETS+1, to allow for */
+ /* the MSD), with the least-significant 0-999 'digit' at offset 0.*/
+
+ /* Decode the declets. After extracting each one, it is decoded */
+ /* to binary using a table lookup. */
+ #if DECPMAX==7
+ #define GETCOEFFTHOU(df, buf) { \
+ uInt sourhi=DFWORD(df, 0); \
+ (buf)[0]=DPD2BIN[sourhi&0x3ff]; \
+ (buf)[1]=DPD2BIN[(sourhi>>10)&0x3ff]; \
+ (buf)[2]=DECCOMBMSD[sourhi>>26];}
+
+ #elif DECPMAX==16
+ #define GETCOEFFTHOU(df, buf) { \
+ uInt sourhi, sourlo; \
+ sourlo=DFWORD(df, 1); \
+ (buf)[0]=DPD2BIN[sourlo&0x3ff]; \
+ (buf)[1]=DPD2BIN[(sourlo>>10)&0x3ff]; \
+ (buf)[2]=DPD2BIN[(sourlo>>20)&0x3ff]; \
+ sourhi=DFWORD(df, 0); \
+ (buf)[3]=DPD2BIN[((sourhi<<2) | (sourlo>>30))&0x3ff]; \
+ (buf)[4]=DPD2BIN[(sourhi>>8)&0x3ff]; \
+ (buf)[5]=DECCOMBMSD[sourhi>>26];}
+
+ #elif DECPMAX==34
+ #define GETCOEFFTHOU(df, buf) { \
+ uInt sourhi, sourmh, sourml, sourlo; \
+ sourlo=DFWORD(df, 3); \
+ (buf)[0]=DPD2BIN[sourlo&0x3ff]; \
+ (buf)[1]=DPD2BIN[(sourlo>>10)&0x3ff]; \
+ (buf)[2]=DPD2BIN[(sourlo>>20)&0x3ff]; \
+ sourml=DFWORD(df, 2); \
+ (buf)[3]=DPD2BIN[((sourml<<2) | (sourlo>>30))&0x3ff]; \
+ (buf)[4]=DPD2BIN[(sourml>>8)&0x3ff]; \
+ (buf)[5]=DPD2BIN[(sourml>>18)&0x3ff]; \
+ sourmh=DFWORD(df, 1); \
+ (buf)[6]=DPD2BIN[((sourmh<<4) | (sourml>>28))&0x3ff]; \
+ (buf)[7]=DPD2BIN[(sourmh>>6)&0x3ff]; \
+ (buf)[8]=DPD2BIN[(sourmh>>16)&0x3ff]; \
+ sourhi=DFWORD(df, 0); \
+ (buf)[9]=DPD2BIN[((sourhi<<6) | (sourmh>>26))&0x3ff]; \
+ (buf)[10]=DPD2BIN[(sourhi>>4)&0x3ff]; \
+ (buf)[11]=DECCOMBMSD[sourhi>>26];}
+ #endif
+
+
+ /* Macros to decode the coefficient in a finite decFloat *df and */
+ /* add to a base-thousand uInt array (as for GETCOEFFTHOU). */
+ /* After the addition then most significant 'digit' in the array */
+ /* might have a value larger then 10 (with a maximum of 19). */
+ #if DECPMAX==7
+ #define ADDCOEFFTHOU(df, buf) { \
+ uInt sourhi=DFWORD(df, 0); \
+ (buf)[0]+=DPD2BIN[sourhi&0x3ff]; \
+ if (buf[0]>999) {buf[0]-=1000; buf[1]++;} \
+ (buf)[1]+=DPD2BIN[(sourhi>>10)&0x3ff]; \
+ if (buf[1]>999) {buf[1]-=1000; buf[2]++;} \
+ (buf)[2]+=DECCOMBMSD[sourhi>>26];}
+
+ #elif DECPMAX==16
+ #define ADDCOEFFTHOU(df, buf) { \
+ uInt sourhi, sourlo; \
+ sourlo=DFWORD(df, 1); \
+ (buf)[0]+=DPD2BIN[sourlo&0x3ff]; \
+ if (buf[0]>999) {buf[0]-=1000; buf[1]++;} \
+ (buf)[1]+=DPD2BIN[(sourlo>>10)&0x3ff]; \
+ if (buf[1]>999) {buf[1]-=1000; buf[2]++;} \
+ (buf)[2]+=DPD2BIN[(sourlo>>20)&0x3ff]; \
+ if (buf[2]>999) {buf[2]-=1000; buf[3]++;} \
+ sourhi=DFWORD(df, 0); \
+ (buf)[3]+=DPD2BIN[((sourhi<<2) | (sourlo>>30))&0x3ff]; \
+ if (buf[3]>999) {buf[3]-=1000; buf[4]++;} \
+ (buf)[4]+=DPD2BIN[(sourhi>>8)&0x3ff]; \
+ if (buf[4]>999) {buf[4]-=1000; buf[5]++;} \
+ (buf)[5]+=DECCOMBMSD[sourhi>>26];}
+
+ #elif DECPMAX==34
+ #define ADDCOEFFTHOU(df, buf) { \
+ uInt sourhi, sourmh, sourml, sourlo; \
+ sourlo=DFWORD(df, 3); \
+ (buf)[0]+=DPD2BIN[sourlo&0x3ff]; \
+ if (buf[0]>999) {buf[0]-=1000; buf[1]++;} \
+ (buf)[1]+=DPD2BIN[(sourlo>>10)&0x3ff]; \
+ if (buf[1]>999) {buf[1]-=1000; buf[2]++;} \
+ (buf)[2]+=DPD2BIN[(sourlo>>20)&0x3ff]; \
+ if (buf[2]>999) {buf[2]-=1000; buf[3]++;} \
+ sourml=DFWORD(df, 2); \
+ (buf)[3]+=DPD2BIN[((sourml<<2) | (sourlo>>30))&0x3ff]; \
+ if (buf[3]>999) {buf[3]-=1000; buf[4]++;} \
+ (buf)[4]+=DPD2BIN[(sourml>>8)&0x3ff]; \
+ if (buf[4]>999) {buf[4]-=1000; buf[5]++;} \
+ (buf)[5]+=DPD2BIN[(sourml>>18)&0x3ff]; \
+ if (buf[5]>999) {buf[5]-=1000; buf[6]++;} \
+ sourmh=DFWORD(df, 1); \
+ (buf)[6]+=DPD2BIN[((sourmh<<4) | (sourml>>28))&0x3ff]; \
+ if (buf[6]>999) {buf[6]-=1000; buf[7]++;} \
+ (buf)[7]+=DPD2BIN[(sourmh>>6)&0x3ff]; \
+ if (buf[7]>999) {buf[7]-=1000; buf[8]++;} \
+ (buf)[8]+=DPD2BIN[(sourmh>>16)&0x3ff]; \
+ if (buf[8]>999) {buf[8]-=1000; buf[9]++;} \
+ sourhi=DFWORD(df, 0); \
+ (buf)[9]+=DPD2BIN[((sourhi<<6) | (sourmh>>26))&0x3ff]; \
+ if (buf[9]>999) {buf[9]-=1000; buf[10]++;} \
+ (buf)[10]+=DPD2BIN[(sourhi>>4)&0x3ff]; \
+ if (buf[10]>999) {buf[10]-=1000; buf[11]++;} \
+ (buf)[11]+=DECCOMBMSD[sourhi>>26];}
+ #endif
+
+
+ /* Set a decFloat to the maximum positive finite number (Nmax) */
+ #if DECPMAX==7
+ #define DFSETNMAX(df) \
+ {DFWORD(df, 0)=0x77f3fcff;}
+ #elif DECPMAX==16
+ #define DFSETNMAX(df) \
+ {DFWORD(df, 0)=0x77fcff3f; \
+ DFWORD(df, 1)=0xcff3fcff;}
+ #elif DECPMAX==34
+ #define DFSETNMAX(df) \
+ {DFWORD(df, 0)=0x77ffcff3; \
+ DFWORD(df, 1)=0xfcff3fcf; \
+ DFWORD(df, 2)=0xf3fcff3f; \
+ DFWORD(df, 3)=0xcff3fcff;}
+ #endif
+
+ /* [end of format-dependent macros and constants] */
+ #endif
+
+#else
+ #error decNumberLocal included more than once
+#endif
diff --git a/source/luametatex/source/libraries/hnj/hnjhyphen.c b/source/luametatex/source/libraries/hnj/hnjhyphen.c
new file mode 100644
index 000000000..ad9d87683
--- /dev/null
+++ b/source/luametatex/source/libraries/hnj/hnjhyphen.c
@@ -0,0 +1,627 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*
+
+ This file is derived from libhnj which is is dual licensed under LGPL and MPL. Boilerplate
+ for both licenses follows.
+
+ LibHnj - a library for high quality hyphenation and justification
+
+ (C) 1998 Raph Levien,
+ (C) 2001 ALTLinux, Moscow (http://www.alt-linux.org),
+ (C) 2001 Peter Novodvorsky (nidd@cs.msu.su)
+
+ This library is free software; you can redistribute it and/or modify it under the terms of the
+ GNU Library General Public License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
+
+ This library 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 Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public License along with this
+ library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307 USA.
+
+ The contents of this file are subject to the Mozilla Public License Version 1.0 (the "MPL");
+ you may not use this file except in compliance with the MPL. You may obtain a copy of the MPL
+ at http://www.mozilla.org/MPL/
+
+ Software distributed under the MPL is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
+ KIND, either express or implied. See the MPL for the specific language governing rights and
+ limitations under the MPL.
+
+ Remark: I'm not sure if something fundamental was adapted in the perspective of using this
+ library in LuaTeX. However, for instance error reporting has been hooked into the Lua(Meta)TeX
+ error reporting mechanisms. Also a bit of reformatting was done. This module won't change.
+ Also, the code has been adapted a little in order to fit in the rest (function names etc)
+ because it is more exposed. We use the alternative memory allocator.
+
+*/
+
+/*tex We need the warning subsystem, so: */
+
+# include "luametatex.h"
+
+/*tex A few helpers (from |hnjalloc|): */
+
+static void *hnj_malloc(int size)
+{
+ void *p = lmt_memory_malloc((size_t) size);
+ if (! p) {
+ tex_formatted_error("hyphenation", "allocating %d bytes failed\n", size);
+ }
+ return p;
+}
+
+static void *hnj_realloc(void *p, int size)
+{
+ void *n = lmt_memory_realloc(p, (size_t) size);
+ if (! n) {
+ tex_formatted_error("hyphenation", "reallocating %d bytes failed\n", size);
+ }
+ return n;
+}
+
+static void hnj_free(void *p)
+{
+ lmt_memory_free(p);
+}
+
+static unsigned char *hnj_strdup(const unsigned char *s)
+{
+ size_t l = strlen((const char *) s);
+ unsigned char *n = hnj_malloc((int) l + 1);
+ memcpy(n, s, l);
+ n[l] = 0;
+ return n;
+}
+
+/*tex
+
+ Combine two right-aligned number patterns, 04000 + 020 becomes 04020. This works also for utf8
+ sequences because the substring is identical to the last |substring - length| bytes of expr
+ except for the (single byte) hyphenation encoders
+
+*/
+
+static char *combine_patterns(char *expr, const char *subexpr)
+{
+ size_t l1 = strlen(expr);
+ size_t l2 = strlen(subexpr);
+ size_t off = l1 - l2;
+ for (unsigned j = 0; j < l2; j++) {
+ if (expr[off + j] < subexpr[j]) {
+ expr[off + j] = subexpr[j];
+ }
+ }
+ return expr;
+}
+
+/*tex Some original code: */
+
+static hjn_hashiterator *new_hashiterator(hjn_hashtable *h)
+{
+ hjn_hashiterator *i = hnj_malloc(sizeof(hjn_hashiterator));
+ i->e = h->entries;
+ i->cur = NULL;
+ i->ndx = -1;
+ return i;
+}
+
+static int nexthashstealpattern(hjn_hashiterator *i, unsigned char **word, char **pattern)
+{
+ while (i->cur == NULL) {
+ if (i->ndx >= HNJ_HASH_SIZE - 1) {
+ return 0;
+ } else {
+ i->cur = i->e[++i->ndx];
+ }
+ }
+ *word = i->cur->key;
+ *pattern = i->cur->u.hyppat;
+ i->cur->u.hyppat = NULL;
+ i->cur = i->cur->next;
+ return 1;
+}
+
+static int nexthash(hjn_hashiterator *i, unsigned char **word)
+{
+ while (! i->cur) {
+ if (i->ndx >= HNJ_HASH_SIZE - 1) {
+ return 0;
+ } else {
+ i->cur = i->e[++i->ndx];
+ }
+ }
+ *word = i->cur->key;
+ i->cur = i->cur->next;
+ return 1;
+}
+
+static int eachhash(hjn_hashiterator *i, unsigned char **word, char **pattern)
+{
+ while (! i->cur) {
+ if (i->ndx >= HNJ_HASH_SIZE - 1) {
+ return 0;
+ } else {
+ i->cur = i->e[++i->ndx];
+ }
+ }
+ *word = i->cur->key;
+ *pattern = i->cur->u.hyppat;
+ i->cur = i->cur->next;
+ return 1;
+}
+
+static void delete_hashiterator(hjn_hashiterator *i)
+{
+ hnj_free(i);
+}
+
+/*tex A |char*| hash function from ASU, adapted from |Gtk+|: */
+
+static unsigned int string_hash(const unsigned char *s)
+{
+ const unsigned char *p = s;
+ unsigned int h = 0, g;
+ for (; *p != '\0'; p += 1) {
+ h = (h << 4) + *p;
+ g = h & 0xf0000000;
+ if (g) {
+ h = h ^ (g >> 24);
+ h = h ^ g;
+ }
+ }
+ return h;
+}
+
+/*tex This assumes that key is not already present! */
+
+static void state_insert(hjn_hashtable *hashtab, unsigned char *key, int state)
+{
+ int i = (int) (string_hash(key) % HNJ_HASH_SIZE);
+ hjn_hashentry* e = hnj_malloc(sizeof(hjn_hashentry));
+ e->next = hashtab->entries[i];
+ e->key = key;
+ e->u.state = state;
+ hashtab->entries[i] = e;
+}
+
+/*tex This also assumes that key is not already present! */
+
+static void insert_pattern(hjn_hashtable *hashtab, unsigned char *key, char *hyppat, int trace)
+{
+ hjn_hashentry *e;
+ int i = (int) (string_hash(key) % HNJ_HASH_SIZE);
+ for (e = hashtab->entries[i]; e; e = e->next) {
+ if (strcmp((char *) e->key, (char *) key) == 0) {
+ if (e->u.hyppat) {
+ if (trace && hyppat && strcmp((char *) e->u.hyppat, (char *) hyppat) != 0) {
+ tex_formatted_warning("hyphenation", "a conflicting pattern '%s' has been ignored", hyppat);
+ }
+ hnj_free(e->u.hyppat);
+ }
+ e->u.hyppat = hyppat;
+ hnj_free(key);
+ return;
+ }
+ }
+ e = hnj_malloc(sizeof(hjn_hashentry));
+ e->next = hashtab->entries[i];
+ e->key = key;
+ e->u.hyppat = hyppat;
+ hashtab->entries[i] = e;
+}
+
+/*tex We return |state| if found, otherwise |-1|. */
+
+static int state_lookup(hjn_hashtable *hashtab, const unsigned char *key)
+{
+ int i = (int) (string_hash(key) % HNJ_HASH_SIZE);
+ for (hjn_hashentry *e = hashtab->entries[i]; e; e = e->next) {
+ if (! strcmp((const char *) key, (const char *) e->key)) {
+ return e->u.state;
+ }
+ }
+ return -1;
+}
+
+/*tex We return |state| if found, otherwise |-1|. The 256 should be enough. */
+
+static char *lookup_pattern(hjn_hashtable * hashtab, const unsigned char *chars, int l)
+{
+ int i;
+ unsigned char key[256];
+ strncpy((char *) key, (const char *) chars, (size_t) l);
+ key[l] = 0;
+ i = (int) (string_hash(key) % HNJ_HASH_SIZE);
+ for (hjn_hashentry *e = hashtab->entries[i]; e; e = e->next) {
+ if (! strcmp((char *) key, (char *) e->key)) {
+ return e->u.hyppat;
+ }
+ }
+ return NULL;
+}
+
+/*tex Get the state number, allocating a new state if necessary. */
+
+static int hnj_get_state(hjn_dictionary *dict, const unsigned char *str, int *state_num)
+{
+ *state_num = state_lookup(dict->state_num, str);
+ if (*state_num >= 0) {
+ return *state_num;
+ } else {
+ state_insert(dict->state_num, hnj_strdup(str), dict->num_states);
+ /*tex The predicate is true if |dict->num_states| is a power of two: */
+ if (! (dict->num_states & (dict->num_states - 1))) {
+ dict->states = hnj_realloc(dict->states, (int) ((dict->num_states << 1) * (int) sizeof(hjn_state)));
+ }
+ dict->states[dict->num_states] = (hjn_state) { .match = NULL, .fallback_state = -1, .num_trans = 0, .trans = NULL };
+ return dict->num_states++;
+ }
+}
+
+/*tex
+
+ Add a transition from state1 to state2 through ch - assumes that the transition does not
+ already exist.
+
+*/
+
+static void hnj_add_trans(hjn_dictionary *dict, int state1, int state2, int chr)
+{
+ /*tex
+
+ This test was a bit too strict, it is quite normal for old patterns to have chars in the
+ range 0-31 or 127-159 (inclusive). To ease the transition, let's only disallow |nul| for
+ now, which probably is a requirement of the code anyway.
+
+ */
+ if (chr) {
+ int num_trans = dict->states[state1].num_trans;
+ if (num_trans == 0) {
+ dict->states[state1].trans = hnj_malloc(sizeof(hjn_transition));
+ } else {
+ /*tex
+
+ The old version did:
+
+ \starttyping
+ } else if (!(num_trans & (num_trans - 1))) {
+ ... = hnj_realloc(dict->states[state1].trans,
+ (int) ((num_trans << 1) * sizeof(HyphenTrans)));
+ \stoptyping
+
+ but that is incredibly nasty when adding patters one-at-a-time. Controlled growth
+ would be nicer than the current +1, but if no one complains, and no one did in a
+ decade, this is good enough.
+
+ */
+ dict->states[state1].trans = hnj_realloc(dict->states[state1].trans, (int) ((num_trans + 1) * sizeof(hjn_transition)));
+ }
+ dict->states[state1].trans[num_trans].uni_ch = chr;
+ dict->states[state1].trans[num_trans].new_state = state2;
+ dict->states[state1].num_trans++;
+ } else {
+ tex_normal_error("hyphenation","a nul character is not permited");
+ }
+}
+
+/*tex
+
+ We did change the semantics a bit here: |hnj_hyphen_load| used to operate on a file, but now
+ the argument is a string buffer.
+
+*/
+
+/* define tex_isspace(c) (c == ' ' || c == '\t') */
+# define tex_isspace(c) (c == ' ')
+
+static const unsigned char *next_pattern(size_t* length, const unsigned char** buf)
+{
+ const unsigned char *here, *rover = *buf;
+ while (*rover && tex_isspace(*rover)) {
+ rover++;
+ }
+ here = rover;
+ while (*rover) {
+ if (tex_isspace(*rover)) {
+ *length = (size_t) (rover - here);
+ *buf = rover;
+ return here;
+ } else {
+ rover++;
+ }
+ }
+ *length = (size_t) (rover - here);
+ *buf = rover;
+ return *length ? here : NULL;
+}
+
+static void init_hash(hjn_hashtable **h)
+{
+ if (! *h) {
+ *h = hnj_malloc(sizeof(hjn_hashtable));
+ for (int i = 0; i < HNJ_HASH_SIZE; i++) {
+ (*h)->entries[i] = NULL;
+ }
+ }
+}
+
+static void clear_state_hash(hjn_hashtable **h)
+{
+ if (*h) {
+ for (int i = 0; i < HNJ_HASH_SIZE; i++) {
+ hjn_hashentry *e, *next;
+ for (e = (*h)->entries[i]; e; e = next) {
+ next = e->next;
+ hnj_free(e->key);
+ hnj_free(e);
+ }
+ }
+ hnj_free(*h);
+ *h = NULL;
+ }
+}
+
+static void clear_pattern_hash(hjn_hashtable **h)
+{
+ if (*h) {
+ for (int i = 0; i < HNJ_HASH_SIZE; i++) {
+ hjn_hashentry *e, *next;
+ for (e = (*h)->entries[i]; e; e = next) {
+ next = e->next;
+ hnj_free(e->key);
+ if (e->u.hyppat) {
+ hnj_free(e->u.hyppat);
+ }
+ hnj_free(e);
+ }
+ }
+ hnj_free(*h);
+ *h = NULL;
+ }
+}
+
+static void init_dictionary(hjn_dictionary *dict)
+{
+ dict->num_states = 1;
+ dict->pat_length = 0;
+ dict->states = hnj_malloc(sizeof(hjn_state));
+ dict->states[0] = (hjn_state) { .match = NULL, .fallback_state = -1, .num_trans = 0, .trans = NULL };
+ dict->patterns = NULL;
+ dict->merged = NULL;
+ dict->state_num = NULL;
+ init_hash(&dict->patterns);
+}
+
+static void clear_dictionary(hjn_dictionary *dict)
+{
+ for (int state_num = 0; state_num < dict->num_states; state_num++) {
+ hjn_state *hstate = &dict->states[state_num];
+ if (hstate->match) {
+ hnj_free(hstate->match);
+ }
+ if (hstate->trans) {
+ hnj_free(hstate->trans);
+ }
+ }
+ hnj_free(dict->states);
+ clear_pattern_hash(&dict->patterns);
+ clear_pattern_hash(&dict->merged);
+ clear_state_hash(&dict->state_num);
+}
+
+hjn_dictionary *hnj_dictionary_new(void)
+{
+ hjn_dictionary *dict = hnj_malloc(sizeof(hjn_dictionary));
+ init_dictionary(dict);
+ return dict;
+}
+
+void hnj_dictionary_clear(hjn_dictionary *dict)
+{
+ clear_dictionary(dict);
+ init_dictionary(dict);
+}
+
+void hnj_dictionary_free(hjn_dictionary *dict)
+{
+ clear_dictionary(dict);
+ hnj_free(dict);
+}
+
+unsigned char *hnj_dictionary_tostring(hjn_dictionary *dict)
+{
+ unsigned char *word;
+ char *pattern;
+ unsigned char *buf = hnj_malloc(dict->pat_length);
+ unsigned char *cur = buf;
+ hjn_hashiterator *v = new_hashiterator(dict->patterns);
+ while (eachhash(v, &word, &pattern)) {
+ int i = 0;
+ int e = 0;
+ while (word[e + i]) {
+ if (pattern[i] != '0') {
+ *cur++ = (unsigned char) pattern[i];
+ }
+ *cur++ = word[e + i++];
+ while (is_utf8_follow(word[e + i])) {
+ *cur++ = word[i + e++];
+ }
+ }
+ if (pattern[i] != '0') {
+ *cur++ = (unsigned char) pattern[i];
+ }
+ *cur++ = ' ';
+ }
+ delete_hashiterator(v);
+ *cur = 0;
+ return buf;
+}
+
+/*tex
+
+ In hyphenation patterns we use signed bytes where |0|, or actually any negative number,
+ indicates end:
+
+ \starttyping
+ prio(1+),startpos,length,len1,[replace],len2,[replace]
+ \starttyping
+
+ A basic example is:
+
+ \starttyping
+ p n 0 0 0
+ \starttyping
+
+ for a hyphenation point between characters.
+
+*/
+
+void hnj_dictionary_load(hjn_dictionary *dict, const unsigned char *f, int trace)
+{
+ int state_num, last_state;
+ int ch;
+ int found;
+ hjn_hashiterator *v;
+ unsigned char *word;
+ char *pattern;
+ size_t l = 0;
+ const unsigned char *format;
+ const unsigned char *begin = f;
+ while ((format = next_pattern(&l, &f)) != NULL) {
+ if (l > 0 && l < 255) {
+ int i, j, e1;
+ for (i = 0, j = 0, e1 = 0; (unsigned) i < l; i++) {
+ if (format[i] >= '0' && format[i] <= '9') {
+ j++;
+ }
+ if (is_utf8_follow(format[i])) {
+ e1++;
+ }
+ }
+ /*tex
+ Here |l-e1| is the number of {\em characters} not {\em bytes}, |l-j| the number of
+ pattern bytes and |l-e1-j| the number of pattern characters.
+ */
+ {
+ unsigned char *pat = (unsigned char *) hnj_malloc((1 + (int) l - j));
+ char *org = (char *) hnj_malloc(2 + (int) l - e1 - j);
+ /*tex Remove hyphenation encoders (digits) from pat. */
+ org[0] = '0';
+ for (i = 0, j = 0, e1 = 0; (unsigned) i < l; i++) {
+ unsigned char c = format[i];
+ if (is_utf8_follow(c)) {
+ pat[j + e1++] = c;
+ } else if (c < '0' || c > '9') {
+ pat[e1 + j++] = c;
+ org[j] = '0';
+ } else {
+ org[j] = (char) c;
+ }
+ }
+ pat[e1 + j] = 0;
+ org[j + 1] = 0;
+ insert_pattern(dict->patterns, pat, org, trace);
+ }
+ } else {
+ tex_normal_warning("hyphenation", "a pattern of more than 254 bytes is ignored");
+ }
+ }
+ /*tex We add 2 bytes for spurious spaces. */
+ dict->pat_length += (int) ((f - begin) + 2);
+ init_hash(&dict->merged);
+ v = new_hashiterator(dict->patterns);
+ while (nexthash(v, &word)) {
+ int wordsize = (int) strlen((char *) word);
+ for (int l1 = 1; l1 <= wordsize; l1++) {
+ if (is_utf8_follow(word[l1])) {
+ /*tex Do not clip an utf8 sequence. */
+ } else {
+ for (int j1 = 1; j1 <= l1; j1++) {
+ int i1 = l1 - j1;
+ if (is_utf8_follow(word[i1])) {
+ /*tex Do not start halfway an utf8 sequence. */
+ } else {
+ char *subpat_pat = lookup_pattern(dict->patterns, word + i1, j1);
+ if (subpat_pat) {
+ char *newpat_pat = lookup_pattern(dict->merged, word, l1);
+ if (! newpat_pat) {
+ char *neworg;
+ unsigned char *newword = (unsigned char *) hnj_malloc((size_t) (l1 + 1));
+ int e1 = 0;
+ strncpy((char *) newword, (char *) word, (size_t) l1);
+ newword[l1] = 0;
+ for (i1 = 0; i1 < l1; i1++) {
+ if (is_utf8_follow(newword[i1])) {
+ e1++;
+ }
+ }
+ neworg = hnj_malloc((size_t) (l1 + 2 - e1));
+ /*tex Fill with right amount of zeros: */
+ sprintf(neworg, "%0*d", l1 + 1 - e1, 0);
+ insert_pattern(dict->merged, newword, combine_patterns(neworg, subpat_pat), trace);
+ } else {
+ combine_patterns(newpat_pat, subpat_pat);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ delete_hashiterator(v);
+ init_hash(&dict->state_num);
+ state_insert(dict->state_num, hnj_strdup((const unsigned char *) ""), 0);
+ v = new_hashiterator(dict->merged);
+ while (nexthashstealpattern(v, &word, &pattern)) {
+ static unsigned char mask[] = { 0x3F, 0x1F, 0xF, 0x7 };
+ int j1 = (int) strlen((char *) word);
+ state_num = hnj_get_state(dict, word, &found);
+ dict->states[state_num].match = pattern;
+ /*tex Now, put in the prefix transitions. */
+ while (found < 0) {
+ j1--;
+ last_state = state_num;
+ ch = word[j1];
+ if (ch >= 0x80) { /* why not is_utf8_follow(ch) here */
+ int m;
+ int i1 = 1;
+ while (is_utf8_follow(word[j1 - i1])) {
+ i1++;
+ }
+ ch = word[j1 - i1] & mask[i1];
+ m = j1 - i1;
+ while (i1--) {
+ ch = (ch << 6) + (0x3F & word[j1 - i1]);
+ }
+ j1 = m;
+ }
+ word[j1] = '\0';
+ state_num = hnj_get_state(dict, word, &found);
+ hnj_add_trans(dict, state_num, last_state, ch);
+ }
+ }
+ delete_hashiterator(v);
+ clear_pattern_hash(&dict->merged);
+ /*tex Put in the fallback states. */
+ for (int i = 0; i < HNJ_HASH_SIZE; i++) {
+ for (hjn_hashentry *e = dict->state_num->entries[i]; e; e = e->next) {
+ /*tex Do not do |state == 0| otherwise things get confused. */
+ if (e->u.state) {
+ for (int j = 1; 1; j++) {
+ state_num = state_lookup(dict->state_num, e->key + j);
+ if (state_num >= 0) {
+ break;
+ }
+ }
+ dict->states[e->u.state].fallback_state = state_num;
+ }
+ }
+ }
+ clear_state_hash(&dict->state_num);
+}
diff --git a/source/luametatex/source/libraries/hnj/hnjhyphen.h b/source/luametatex/source/libraries/hnj/hnjhyphen.h
new file mode 100644
index 000000000..1f176f3e9
--- /dev/null
+++ b/source/luametatex/source/libraries/hnj/hnjhyphen.h
@@ -0,0 +1,123 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*
+
+ The code is derived from LibHnj which is is dual licensed under LGPL and MPL. Boilerplate for
+ both licenses follows.
+
+*/
+
+/*
+
+ LibHnj - a library for high quality hyphenation and justification
+
+ Copyright (C) 1998 Raph Levien, (C) 2001 ALTLinux, Moscow
+
+ This library is free software; you can redistribute it and/or modify it under the terms of the
+ GNU Library General Public License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
+
+ This library 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 Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public License along with this
+ library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307 USA.
+
+*/
+
+/*
+ The contents of this file are subject to the Mozilla Public License Version 1.0 (the "MPL");
+ you may not use this file except in compliance with the MPL. You may obtain a copy of the MPL
+ at http://www.mozilla.org/MPL/
+
+ Software distributed under the MPL is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
+ KIND, either express or implied. See the MPL for the specific language governing rights and
+ limitations under the MPL.
+
+ */
+
+# ifndef LMT_HNJHYPHEN_H
+# define LMT_HNJHYPHEN_H
+
+/*tex
+
+ First some type definitions and a little bit of a hash table implementation. This simply maps
+ strings to state numbers. In \LUATEX\ we have node related code in |hnjhyphen.c| but in
+ \LUAMETATEX\ we moved that to |texlanguage.c| so we need to make some type definitions public.
+
+*/
+
+# define HNJ_MAXPATHS 40960
+# define HNJ_HASH_SIZE 31627
+# define HNJ_MAX_CHARS 256
+# define HNJ_MAX_NAME 24
+
+typedef struct _hjn_hashtable hjn_hashtable;
+typedef struct _hjn_hashentry hjn_hashentry;
+typedef struct _hjn_hashiterator hjn_hashiterator;
+typedef union _hjn_hashvalue hjn_hashvalue;
+
+/*tex A cheap, but effective, hack. */
+
+struct _hjn_hashtable {
+ hjn_hashentry *entries[HNJ_HASH_SIZE];
+};
+
+union _hjn_hashvalue {
+ char *hyppat;
+ int state;
+ int padding;
+};
+
+struct _hjn_hashentry {
+ hjn_hashentry *next;
+ unsigned char *key;
+ hjn_hashvalue u;
+};
+
+struct _hjn_hashiterator {
+ hjn_hashentry **e;
+ hjn_hashentry *cur;
+ int ndx;
+ int padding;
+};
+
+/*tex The state state machine. */
+
+typedef struct _hjn_transition hjn_transition;
+typedef struct _hjn_state hjn_state;
+typedef struct _hjn_dictionary hjn_dictionary;
+
+struct _hjn_transition {
+ int uni_ch;
+ int new_state;
+};
+
+struct _hjn_state {
+ char *match;
+ int fallback_state;
+ int num_trans;
+ hjn_transition *trans;
+};
+
+struct _hjn_dictionary {
+ int num_states;
+ int pat_length;
+ char cset[HNJ_MAX_NAME];
+ hjn_state *states;
+ hjn_hashtable *patterns;
+ hjn_hashtable *merged;
+ hjn_hashtable *state_num;
+};
+
+extern hjn_dictionary *hnj_dictionary_new (void);
+extern void hnj_dictionary_load (hjn_dictionary *dict, const unsigned char *fn, int trace);
+extern void hnj_dictionary_free (hjn_dictionary *dict);
+extern void hnj_dictionary_clear (hjn_dictionary *dict);
+extern unsigned char *hnj_dictionary_tostring (hjn_dictionary *dict);
+
+# endif
diff --git a/source/luametatex/source/libraries/libcerf/CHANGELOG b/source/luametatex/source/libraries/libcerf/CHANGELOG
new file mode 100644
index 000000000..9ac940088
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/CHANGELOG
@@ -0,0 +1,118 @@
+== Revision history of libcerf, maintained by Joachim Wuttke ==
+
+Homepage moved to https://jugit.fz-juelich.de/mlz/libcerf, 17mar19
+
+libcerf-1.13, released 28feb19:
+ - Further adjustments for compilation under Windows
+
+libcerf-1.12, released 7feb19:
+ - Require CMake 3.6, outcomment code that requires 3.13.
+ - Relative paths in CMake sources, for use as subproject.
+ - When compiling as CPP, then #include<complex>, not <complex.h>;
+ revise the entire C-vs-CPP machinery.
+ - Remove tests with different inf or nan results on different systems or under
+ different compilers.
+
+libcerf-1.11, released 28dec18:
+ - Cover voigt by test_voigt.
+ - Implement new function voigt_hwhm.
+ - Restore libcerf.pc.
+ - Add INSTALL instructions, and other minor adjustments for use of libcerf in C++ projects.
+ - Support 'ctest', which runs the numeric accuracy tests from test1.c.
+ - Rename type cmplx into _cerf_cmplx to avoid name clash with Gnuplot pre 5.3.
+
+libcerf-1.8 [2oct18], libcerf-1.9 [16oct18] and libcerf-1.10 [20dec18]
+ MUST NOT BE USED
+ - A bug introduced in v1.8 had broken the normalization of the Voigt function.
+ - The git history leading to v1.10 has been rewritten, starting anew from v1.7
+
+libcerf-1.7, released 26sep18:
+ - Option -DCERF_CPP allows to choose C++ compilation, which is useful
+ because MS VisualStudio supports C++14, but not yet C99, and in
+ particular does not support complex.h under C.
+
+libcerf-1.6, released 20sep18:
+ - Migrated from automake to CMake.
+ - Corrected typos in man pages.
+
+libcerf-1.5, released 12oct16:
+ - Removed unused inline function (detected by clang-1.3., reported by Luke Benes)
+
+libcerf-1.4, released 27aug14:
+ - HTML version of man pages no longer installs to man/html.
+ - More concise man pages.
+ - Delete a few unused include's.
+ - Autotools script corrected (suggestions by Christoph Junghans).
+
+libcerf-1.3, released 17jul13:
+ - Now supporting pkg-config (suggested by Mojca Miklavec).
+
+libcerf-1.2, released 16jul13:
+ - Test programs no longer install to $bindir (reported by Mojca Miklavec).
+
+libcerf-1.1, released 12may13:
+ - Added Fortran binding by Antonio Cervellino.
+
+libcerf-1.0, released 31jan13 by Joachim Wuttke:
+ - Based on http://ab-initio.mit.edu/Faddeeva as of 28jan13.
+ - Verified accuracy using double-exponential transform.
+ - Simplified function names;
+ use leading 'c' for complex functions (except in w_of_z).
+ - Added function voigt(x,sigma,gamma).
+ - Added configure.ac, Makefile.am &c to allow for autotools standard
+ installation (commands ./configure, make, sudo make install).
+ - Splitted source code into directories lib/ and test/.
+ - Eliminated unused alternate code (!USE_CONTINUED_FRACTION).
+ - Eliminated relerr arguments.
+ - Replaced "complex" by "_Complex" for C++ compatibility.
+ - Wrote man pages w_of_z(3), dawson(3), voigt(3), cerf(3), erfcx(3), erfi(3).
+ - Created project home page http://apps.jcns.fz-juelich.de/libcerf.
+ - Registered project "libcerf" at sourceforge.net.
+
+== Revision history of Faddeeva.cc by Steven G. Johnson ==
+
+Project at http://ab-initio.mit.edu/Faddeeva
+
+ 4 October 2012: Initial public release (SGJ)
+ 5 October 2012: Revised (SGJ) to fix spelling error,
+ start summation for large x at round(x/a) (> 1)
+ rather than ceil(x/a) as in the original
+ paper, which should slightly improve performance
+ (and, apparently, slightly improves accuracy)
+ 19 October 2012: Revised (SGJ) to fix bugs for large x, large -y,
+ and 15<x<26. Performance improvements. Prototype
+ now supplies default value for relerr.
+ 24 October 2012: Switch to continued-fraction expansion for
+ sufficiently large z, for performance reasons.
+ Also, avoid spurious overflow for |z| > 1e154.
+ Set relerr argument to min(relerr,0.1).
+ 27 October 2012: Enhance accuracy in Re[w(z)] taken by itself,
+ by switching to Alg. 916 in a region near
+ the real-z axis where continued fractions
+ have poor relative accuracy in Re[w(z)]. Thanks
+ to M. Zaghloul for the tip.
+ 29 October 2012: Replace SLATEC-derived erfcx routine with
+ completely rewritten code by me, using a very
+ different algorithm which is much faster.
+ 30 October 2012: Implemented special-case code for real z
+ (where real part is exp(-x^2) and imag part is
+ Dawson integral), using algorithm similar to erfx.
+ Export ImFaddeeva_w function to make Dawson's
+ integral directly accessible.
+ 3 November 2012: Provide implementations of erf, erfc, erfcx,
+ and Dawson functions in Faddeeva:: namespace,
+ in addition to Faddeeva::w. Provide header
+ file Faddeeva.hh.
+ 4 November 2012: Slightly faster erf for real arguments.
+ Updated MATLAB and Octave plugins.
+27 November 2012: Support compilation with either C++ or
+ plain C (using C99 complex numbers).
+ For real x, use standard-library erf(x)
+ and erfc(x) if available (for C99 or C++11).
+ #include "config.h" if HAVE_CONFIG_H is #defined.
+15 December 2012: Portability fixes (copysign, Inf/NaN creation),
+ use CMPLX/__builtin_complex if available in C,
+ slight accuracy improvements to erf and dawson
+ functions near the origin. Use gnulib functions
+ if GNULIB_NAMESPACE is defined.
+18 December 2012: Slight tweaks (remove recomputation of x*x in Dawson)
diff --git a/source/luametatex/source/libraries/libcerf/LICENSE b/source/luametatex/source/libraries/libcerf/LICENSE
new file mode 100644
index 000000000..30979bbd8
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/LICENSE
@@ -0,0 +1,22 @@
+/* Copyright (c) 2012 Massachusetts Institute of Technology
+ * Copyright (c) 2013 Forschungszentrum Jülich GmbH
+ *
+ * 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.
+ */
diff --git a/source/luametatex/source/libraries/libcerf/README.md b/source/luametatex/source/libraries/libcerf/README.md
new file mode 100644
index 000000000..e825f8f99
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/README.md
@@ -0,0 +1,109 @@
+# libcerf
+
+This is the home page of **libcerf**, a self-contained numeric library that provides an efficient and accurate implementation of complex error functions, along with Dawson, Faddeeva, and Voigt functions.
+
+# User Documentation
+
+## Synopsis
+
+In the following, "complex" stands for the C99 data type "double _Complex":
+
+ * complex [cerf](http://apps.jcns.fz-juelich.de/man/cerf.html) (complex): The complex error function erf(z).
+ * complex [cerfc](http://apps.jcns.fz-juelich.de/man/cerf.html) (complex): The complex complementary error function erfc(z) = 1 - erf(z).
+ * complex [cerfcx](http://apps.jcns.fz-juelich.de/man/erfcx.html) (complex z): The underflow-compensating function erfcx(z) = exp(z^2) erfc(z).
+ * double [erfcx](http://apps.jcns.fz-juelich.de/man/erfcx.html) (double x): The same for real x.
+ * complex [cerfi](http://apps.jcns.fz-juelich.de/man/erfi.html) (complex z): The imaginary error function erfi(z) = -i erf(iz).
+ * double [erfi](http://apps.jcns.fz-juelich.de/man/erfi.html) (double x): The same for real x.
+ * complex [w_of_z](http://apps.jcns.fz-juelich.de/man/w_of_z.html) (complex z): Faddeeva's scaled complex error function w(z) = exp(-z^2) erfc(-iz).
+ * double [im_w_of_x](http://apps.jcns.fz-juelich.de/man/w_of_z.html) (double x): The same for real x, returning the purely imaginary result as a real number.
+ * complex [cdawson](http://apps.jcns.fz-juelich.de/man/dawson.html) (complex z): Dawson's integral D(z) = sqrt(pi)/2 * exp(-z^2) * erfi(z).
+ * double [dawson](http://apps.jcns.fz-juelich.de/man/dawson.html) (double x): The same for real x.
+ * double [voigt](http://apps.jcns.fz-juelich.de/man/voigt.html) (double x, double sigma, double gamma): The convolution of a Gaussian and a Lorentzian.
+ * double [voigt_hwhm](http://apps.jcns.fz-juelich.de/man/voigt_hwhm.html) (double sigma, double gamma): The half width at half maximum of the Voigt profile.
+
+## Accuracy
+
+By construction, it is expected that the relative accuracy is generally better than 1E-13. This has been confirmed by comparison with high-precision Maple computations and with a *long double* computation using Fourier transform representation and double-exponential transform.
+
+## Copyright and Citation
+
+Copyright (C) [Steven G. Johnson](http:*math.mit.edu/~stevenj), Massachusetts Institute of Technology, 2012; [Joachim Wuttke](http:*www.fz-juelich.de/SharedDocs/Personen/JCNS/EN/Wuttke_J.html), Forschungszentrum Jülich, 2013.
+
+License: [MIT License](http://opensource.org/licenses/MIT)
+
+When using libcerf in scientific work, please cite as follows:
+ * S. G. Johnson, A. Cervellino, J. Wuttke: libcerf, numeric library for complex error functions, version [...], http://apps.jcns.fz-juelich.de/libcerf
+
+Please send bug reports to the authors, or submit them through the Gitlab issue tracker.
+
+## Further references
+
+Most function evaluations in this library rely on Faddeeva's function w(z).
+
+This function has been reimplemented from scratch by [Steven G. Johnson](http://math.mit.edu/~stevenj);
+project web site http://ab-initio.mit.edu/Faddeeva. The implementation partly relies on algorithms from the following publications:
+ * Walter Gautschi, *Efficient computation of the complex error function,* SIAM J. Numer. Anal. 7, 187 (1970).
+ * G. P. M. Poppe and C. M. J. Wijers, *More efficient computation of the complex error function,* ACM Trans. Math. Soft. 16, 38 (1990).
+ * Mofreh R. Zaghloul and Ahmed N. Ali, *Algorithm 916: Computing the Faddeyeva and Voigt Functions,* ACM Trans. Math. Soft. 38, 15 (2011).
+
+# Installation
+
+## From source
+
+Download location: http://apps.jcns.fz-juelich.de/src/libcerf/
+
+Build&install are based on CMake. Out-of-source build is enforced.
+After unpacking the source, go to the source directory and do:
+
+ mkdir build
+ cd build
+ cmake ..
+ make
+ make install
+
+To test, run the programs in directory test/.
+
+The library has been developed using gcc-4.7. Reports about successful compilation with older versions of gcc would be welcome. For correct support of complex numbers it seems that at least gcc-4.3 is required. Compilation with gcc-4.2 works after removing of the "-Werror" flag from *configure*.
+
+## Binary packages
+
+ * Linux:
+ * [rpm package](https://build.opensuse.org/package/show/science/libcerf) by Christoph Junghans
+ * [Gentoo package](http://packages.gentoo.org/package/sci-libs/libcerf) by Christoph Junghans
+ * [Debian package](https://packages.debian.org/jessie/libs/libcerf1) by Eugen Wintersberger
+ * OS X:
+ * [MacPorts::libcerf](http://www.macports.org/ports.php?by=name&substr=libcerf), by Mojca Miklavec
+ * [Homebrew/homebrew-science/libcerf.rb](https://formulae.brew.sh/formula/libcerf), by Roman Garnett
+
+# Code structure
+
+The code consists of
+- the library's C source (directory lib/),
+- test code (directory test/),
+- manual pages (directory man/),
+- build utilities (aclocal.m4, build-aux/, config*, m4/, Makefile*).
+
+## Compilation
+
+The library libcerf is written in C. It can be compiled as C code (default) or as C++ code (with option -DCERF_CPP=ON). Compilation as C++ is useful especially under MS Windows because as per 2018 the C compiler of Visual Studio does not support C90, nor any newer language standard, and is unable to cope with complex numbers.
+
+Otherwise, the library is self-contained, and installation should be
+straightforward, using the usual command sequence
+
+ ./configure
+ make
+ sudo make install
+
+The command ./configure takes various options that are explained in the
+file INSTALL.
+
+## Language bindings
+
+For use with other programming languages, libcerf should be either linked directly, or provided with a trivial wrapper. Such language bindings are added to the libcerf package as contributed by their authors.
+
+The following bindings are available:
+ * **fortran**, by Antonio Cervellino (Paul Scherrer Institut)
+
+Further contributions will be highly welcome.
+
+Please report bugs to the package maintainer.
diff --git a/source/luametatex/source/libraries/libcerf/cerf.h b/source/luametatex/source/libraries/libcerf/cerf.h
new file mode 100644
index 000000000..3c280b597
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/cerf.h
@@ -0,0 +1,93 @@
+/* Library libcerf:
+ * Compute complex error functions, based on a new implementation of
+ * Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
+ *
+ * File cerf.h:
+ * Declare exported functions.
+ *
+ * Copyright:
+ * (C) 2012 Massachusetts Institute of Technology
+ * (C) 2013 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * 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.
+ *
+ * Authors:
+ * Steven G. Johnson, Massachusetts Institute of Technology, 2012, core author
+ * Joachim Wuttke, Forschungszentrum Jülich, 2013, package maintainer
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ *
+ * Revision history:
+ * ../CHANGELOG
+ *
+ * Man pages:
+ * w_of_z(3), dawson(3), voigt(3), cerf(3), erfcx(3), erfi(3)
+ */
+
+ /*
+
+ This file is patched by Mojca Miklavec and Hans Hagen for usage in LuaMetaTeX where we use
+ only C and also want to compile with the Microsoft compiler. So, when updating this library
+ one has to check for changes. Not that we expect many as this is a rather stable library.
+
+ In the other files there are a few macros used that deal with the multiplication and addition
+ of complex and real numbers. Of course the original code is kept as-is.
+
+ */
+
+# ifndef __CERF_H
+# define __CERF_H
+
+# include <complex.h>
+
+# if (_MSC_VER)
+ # define _cerf_cmplx _Dcomplex
+# else
+ typedef double _Complex _cerf_cmplx;
+# endif
+
+# define EXPORT
+
+extern _cerf_cmplx w_of_z (_cerf_cmplx z); /* compute w(z) = exp(-z^2) erfc(-iz), Faddeeva's scaled complex error function */
+extern double im_w_of_x (double x); /* special case Im[w(x)] of real x */
+extern double re_w_of_z (double x, double y);
+extern double im_w_of_z (double x, double y);
+
+extern _cerf_cmplx cerf (_cerf_cmplx z); /* compute erf(z), the error function of complex arguments */
+extern _cerf_cmplx cerfc (_cerf_cmplx z); /* compute erfc(z) = 1 - erf(z), the complementary error function */
+
+extern _cerf_cmplx cerfcx (_cerf_cmplx z); /* compute erfcx(z) = exp(z^2) erfc(z), an underflow-compensated version of erfc */
+extern double erfcx (double x); /* special case for real x */
+
+extern _cerf_cmplx cerfi (_cerf_cmplx z); /* compute erfi(z) = -i erf(iz), the imaginary error function */
+extern double erfi (double x); /* special case for real x */
+
+extern _cerf_cmplx cdawson (_cerf_cmplx z); /* compute dawson(z) = sqrt(pi)/2 * exp(-z^2) * erfi(z), Dawson's integral */
+extern double dawson (double x); /* special case for real x */
+
+extern double voigt (double x, double sigma, double gamma); /* compute voigt(x,...), the convolution of a Gaussian and a Lorentzian */
+extern double voigt_hwhm (double sigma, double gamma, int *error); /* compute the full width at half maximum of the Voigt function */
+
+extern double cerf_experimental_imw (double x, double y);
+extern double cerf_experimental_rew (double x, double y);
+
+#endif
diff --git a/source/luametatex/source/libraries/libcerf/defs.h b/source/luametatex/source/libraries/libcerf/defs.h
new file mode 100644
index 000000000..8bc6e3af6
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/defs.h
@@ -0,0 +1,97 @@
+/* Library libcerf:
+ * compute complex error functions,
+ * along with Dawson, Faddeeva and Voigt functions
+ *
+ * File defs.h:
+ * Language-dependent includes.
+ *
+ * Copyright:
+ * (C) 2012 Massachusetts Institute of Technology
+ * (C) 2013 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * MIT Licence.
+ * See ../COPYING
+ *
+ * Authors:
+ * Steven G. Johnson, Massachusetts Institute of Technology, 2012, core author
+ * Joachim Wuttke, Forschungszentrum Jülich, 2013, package maintainer
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ */
+
+/*
+
+ This file is patched by Mojca Miklavec and Hans Hagen for usage in LuaMetaTeX where we use
+ only C and also want to compile with the Microsoft compiler. So, when updating this library
+ one has to check for changes. Not that we expect many as this is a rather stable library.
+
+ In the other files there are a few macros used that deal with the multiplication and addition
+ of complex and real nmbers. Of course the original code is kept as-is.
+
+*/
+
+# ifndef __CERF_C_H
+# define __CERF_C_H
+
+# define _GNU_SOURCE // enable GNU libc NAN extension if possible
+
+/*
+ Constructing complex numbers like 0+i*NaN is problematic in C99
+ without the C11 CMPLX macro, because 0.+I*NAN may give NaN+i*NAN if
+ I is a complex (rather than imaginary) constant. For some reason,
+ however, it works fine in (pre-4.7) gcc if I define Inf and NaN as
+ 1/0 and 0/0 (and only if I compile with optimization -O1 or more),
+ but not if I use the INFINITY or NAN macros.
+*/
+
+/*
+ __builtin_complex was introduced in gcc 4.7, but the C11 CMPLX
+ macro may not be defined unless we are using a recent (2012) version
+ of glibc and compile with -std=c11... note that icc lies about being
+ gcc and probably doesn't have this builtin(?), so exclude icc
+ explicitly.
+*/
+
+# if (_MSC_VER)
+ # define C(a,b) _Cbuild((double)(a), (double)(b))
+ # define Inf INFINITY
+ # define NaN NAN
+# else
+ # define C(a,b) ((a) + I*(b))
+ # define Inf (1./0.)
+ # define NaN (0./0.)
+# endif
+
+# include <complex.h>
+
+# if (_MSC_VER)
+
+ # define _cerf_cmplx _Dcomplex
+
+ static _Dcomplex complex_neg (_Dcomplex x) { return _Cmulcr(x, -1.0); }
+ static _Dcomplex complex_add_cc(_Dcomplex x, _Dcomplex y) { return _Cbuild(creal(x) + creal(y), cimag(x) + cimag(y)); }
+ static _Dcomplex complex_add_rc(double x, _Dcomplex y) { return _Cbuild(x + creal(y), x + cimag(y)); }
+ static _Dcomplex complex_sub_cc(_Dcomplex x, _Dcomplex y) { return _Cbuild(creal(x) - creal(y), cimag(x) - cimag(y)); }
+ static _Dcomplex complex_sub_rc(double x, _Dcomplex y) { return _Cbuild(x - creal(y), x - cimag(y)); }
+ static _Dcomplex complex_mul_cc(_Dcomplex x, _Dcomplex y) { return _Cmulcc((y), (x)); }
+ static _Dcomplex complex_mul_rc(double x, _Dcomplex y) { return _Cmulcr((y), (x)); }
+ static _Dcomplex complex_mul_cr(_Dcomplex x, double y) { return _Cmulcr((x), (y)); }
+
+# else
+
+ typedef double _Complex _cerf_cmplx;
+
+ # define complex_neg(x) (-x)
+ # define complex_add_cc(x,y) (x+y)
+ # define complex_add_rc(x,y) (x+y)
+ # define complex_sub_cc(x,y) (x-y)
+ # define complex_sub_rc(x,y) (x-y)
+ # define complex_mul_cc(x,y) (x*y)
+ # define complex_mul_rc(x,y) (x*y)
+ # define complex_mul_cr(x,y) (x*y)
+
+# endif
+
+# endif
diff --git a/source/luametatex/source/libraries/libcerf/erfcx.c b/source/luametatex/source/libraries/libcerf/erfcx.c
new file mode 100644
index 000000000..259ef911a
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/erfcx.c
@@ -0,0 +1,528 @@
+/* Library libcerf:
+ * Compute complex error functions, based on a new implementation of
+ * Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
+ *
+ * File erfcx.c:
+ * Compute erfcx(x) = exp(x^2) erfc(x) function, for real x,
+ * using a novel algorithm that is much faster than DERFC of SLATEC.
+ * This function is used in the computation of Faddeeva, Dawson, and
+ * other complex error functions.
+ *
+ * Copyright:
+ * (C) 2012 Massachusetts Institute of Technology
+ * (C) 2013 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * 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.
+ *
+ * Authors:
+ * Steven G. Johnson, Massachusetts Institute of Technology, 2012, core author
+ * Joachim Wuttke, Forschungszentrum Jülich, 2013, package maintainer
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ *
+ * Revision history:
+ * ../CHANGELOG
+ *
+ * Manual page:
+ * man 3 erfcx
+ */
+
+#include "cerf.h"
+#include <math.h>
+#include "defs.h" // defines _cerf_cmplx, NaN, C, cexp, ...
+
+/******************************************************************************/
+/* Lookup-table for Chebyshev polynomials for smaller |x| */
+/******************************************************************************/
+
+static double erfcx_y100(double y100)
+{
+ // Steven G. Johnson, October 2012.
+
+ // Given y100=100*y, where y = 4/(4+x) for x >= 0, compute erfc(x).
+
+ // Uses a look-up table of 100 different Chebyshev polynomials
+ // for y intervals [0,0.01], [0.01,0.02], ...., [0.99,1], generated
+ // with the help of Maple and a little shell script. This allows
+ // the Chebyshev polynomials to be of significantly lower degree (about 1/4)
+ // compared to fitting the whole [0,1] interval with a single polynomial.
+
+ switch ((int) y100) {
+ case 0: {
+ double t = 2*y100 - 1;
+ return 0.70878032454106438663e-3 + (0.71234091047026302958e-3 + (0.35779077297597742384e-5 + (0.17403143962587937815e-7 + (0.81710660047307788845e-10 + (0.36885022360434957634e-12 + 0.15917038551111111111e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 1: {
+ double t = 2*y100 - 3;
+ return 0.21479143208285144230e-2 + (0.72686402367379996033e-3 + (0.36843175430938995552e-5 + (0.18071841272149201685e-7 + (0.85496449296040325555e-10 + (0.38852037518534291510e-12 + 0.16868473576888888889e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 2: {
+ double t = 2*y100 - 5;
+ return 0.36165255935630175090e-2 + (0.74182092323555510862e-3 + (0.37948319957528242260e-5 + (0.18771627021793087350e-7 + (0.89484715122415089123e-10 + (0.40935858517772440862e-12 + 0.17872061464888888889e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 3: {
+ double t = 2*y100 - 7;
+ return 0.51154983860031979264e-2 + (0.75722840734791660540e-3 + (0.39096425726735703941e-5 + (0.19504168704300468210e-7 + (0.93687503063178993915e-10 + (0.43143925959079664747e-12 + 0.18939926435555555556e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 4: {
+ double t = 2*y100 - 9;
+ return 0.66457513172673049824e-2 + (0.77310406054447454920e-3 + (0.40289510589399439385e-5 + (0.20271233238288381092e-7 + (0.98117631321709100264e-10 + (0.45484207406017752971e-12 + 0.20076352213333333333e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 5: {
+ double t = 2*y100 - 11;
+ return 0.82082389970241207883e-2 + (0.78946629611881710721e-3 + (0.41529701552622656574e-5 + (0.21074693344544655714e-7 + (0.10278874108587317989e-9 + (0.47965201390613339638e-12 + 0.21285907413333333333e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 6: {
+ double t = 2*y100 - 13;
+ return 0.98039537275352193165e-2 + (0.80633440108342840956e-3 + (0.42819241329736982942e-5 + (0.21916534346907168612e-7 + (0.10771535136565470914e-9 + (0.50595972623692822410e-12 + 0.22573462684444444444e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 7: {
+ double t = 2*y100 - 15;
+ return 0.11433927298290302370e-1 + (0.82372858383196561209e-3 + (0.44160495311765438816e-5 + (0.22798861426211986056e-7 + (0.11291291745879239736e-9 + (0.53386189365816880454e-12 + 0.23944209546666666667e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 8: {
+ double t = 2*y100 - 17;
+ return 0.13099232878814653979e-1 + (0.84167002467906968214e-3 + (0.45555958988457506002e-5 + (0.23723907357214175198e-7 + (0.11839789326602695603e-9 + (0.56346163067550237877e-12 + 0.25403679644444444444e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 9: {
+ double t = 2*y100 - 19;
+ return 0.14800987015587535621e-1 + (0.86018092946345943214e-3 + (0.47008265848816866105e-5 + (0.24694040760197315333e-7 + (0.12418779768752299093e-9 + (0.59486890370320261949e-12 + 0.26957764568888888889e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 10: {
+ double t = 2*y100 - 21;
+ return 0.16540351739394069380e-1 + (0.87928458641241463952e-3 + (0.48520195793001753903e-5 + (0.25711774900881709176e-7 + (0.13030128534230822419e-9 + (0.62820097586874779402e-12 + 0.28612737351111111111e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 11: {
+ double t = 2*y100 - 23;
+ return 0.18318536789842392647e-1 + (0.89900542647891721692e-3 + (0.50094684089553365810e-5 + (0.26779777074218070482e-7 + (0.13675822186304615566e-9 + (0.66358287745352705725e-12 + 0.30375273884444444444e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 12: {
+ double t = 2*y100 - 25;
+ return 0.20136801964214276775e-1 + (0.91936908737673676012e-3 + (0.51734830914104276820e-5 + (0.27900878609710432673e-7 + (0.14357976402809042257e-9 + (0.70114790311043728387e-12 + 0.32252476000000000000e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 13: {
+ double t = 2*y100 - 27;
+ return 0.21996459598282740954e-1 + (0.94040248155366777784e-3 + (0.53443911508041164739e-5 + (0.29078085538049374673e-7 + (0.15078844500329731137e-9 + (0.74103813647499204269e-12 + 0.34251892320000000000e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 14: {
+ double t = 2*y100 - 29;
+ return 0.23898877187226319502e-1 + (0.96213386835900177540e-3 + (0.55225386998049012752e-5 + (0.30314589961047687059e-7 + (0.15840826497296335264e-9 + (0.78340500472414454395e-12 + 0.36381553564444444445e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 15: {
+ double t = 2*y100 - 31;
+ return 0.25845480155298518485e-1 + (0.98459293067820123389e-3 + (0.57082915920051843672e-5 + (0.31613782169164830118e-7 + (0.16646478745529630813e-9 + (0.82840985928785407942e-12 + 0.38649975768888888890e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 16: {
+ double t = 2*y100 - 33;
+ return 0.27837754783474696598e-1 + (0.10078108563256892757e-2 + (0.59020366493792212221e-5 + (0.32979263553246520417e-7 + (0.17498524159268458073e-9 + (0.87622459124842525110e-12 + 0.41066206488888888890e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 17: {
+ double t = 2*y100 - 35;
+ return 0.29877251304899307550e-1 + (0.10318204245057349310e-2 + (0.61041829697162055093e-5 + (0.34414860359542720579e-7 + (0.18399863072934089607e-9 + (0.92703227366365046533e-12 + 0.43639844053333333334e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 18: {
+ double t = 2*y100 - 37;
+ return 0.31965587178596443475e-1 + (0.10566560976716574401e-2 + (0.63151633192414586770e-5 + (0.35924638339521924242e-7 + (0.19353584758781174038e-9 + (0.98102783859889264382e-12 + 0.46381060817777777779e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 19: {
+ double t = 2*y100 - 39;
+ return 0.34104450552588334840e-1 + (0.10823541191350532574e-2 + (0.65354356159553934436e-5 + (0.37512918348533521149e-7 + (0.20362979635817883229e-9 + (0.10384187833037282363e-11 + 0.49300625262222222221e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 20: {
+ double t = 2*y100 - 41;
+ return 0.36295603928292425716e-1 + (0.11089526167995268200e-2 + (0.67654845095518363577e-5 + (0.39184292949913591646e-7 + (0.21431552202133775150e-9 + (0.10994259106646731797e-11 + 0.52409949102222222221e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 21: {
+ double t = 2*y100 - 43;
+ return 0.38540888038840509795e-1 + (0.11364917134175420009e-2 + (0.70058230641246312003e-5 + (0.40943644083718586939e-7 + (0.22563034723692881631e-9 + (0.11642841011361992885e-11 + 0.55721092871111111110e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 22: {
+ double t = 2*y100 - 45;
+ return 0.40842225954785960651e-1 + (0.11650136437945673891e-2 + (0.72569945502343006619e-5 + (0.42796161861855042273e-7 + (0.23761401711005024162e-9 + (0.12332431172381557035e-11 + 0.59246802364444444445e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 23: {
+ double t = 2*y100 - 47;
+ return 0.43201627431540222422e-1 + (0.11945628793917272199e-2 + (0.75195743532849206263e-5 + (0.44747364553960993492e-7 + (0.25030885216472953674e-9 + (0.13065684400300476484e-11 + 0.63000532853333333334e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 24: {
+ double t = 2*y100 - 49;
+ return 0.45621193513810471438e-1 + (0.12251862608067529503e-2 + (0.77941720055551920319e-5 + (0.46803119830954460212e-7 + (0.26375990983978426273e-9 + (0.13845421370977119765e-11 + 0.66996477404444444445e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 25: {
+ double t = 2*y100 - 51;
+ return 0.48103121413299865517e-1 + (0.12569331386432195113e-2 + (0.80814333496367673980e-5 + (0.48969667335682018324e-7 + (0.27801515481905748484e-9 + (0.14674637611609884208e-11 + 0.71249589351111111110e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 26: {
+ double t = 2*y100 - 53;
+ return 0.50649709676983338501e-1 + (0.12898555233099055810e-2 + (0.83820428414568799654e-5 + (0.51253642652551838659e-7 + (0.29312563849675507232e-9 + (0.15556512782814827846e-11 + 0.75775607822222222221e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 27: {
+ double t = 2*y100 - 55;
+ return 0.53263363664388864181e-1 + (0.13240082443256975769e-2 + (0.86967260015007658418e-5 + (0.53662102750396795566e-7 + (0.30914568786634796807e-9 + (0.16494420240828493176e-11 + 0.80591079644444444445e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 28: {
+ double t = 2*y100 - 57;
+ return 0.55946601353500013794e-1 + (0.13594491197408190706e-2 + (0.90262520233016380987e-5 + (0.56202552975056695376e-7 + (0.32613310410503135996e-9 + (0.17491936862246367398e-11 + 0.85713381688888888890e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 29: {
+ double t = 2*y100 - 59;
+ return 0.58702059496154081813e-1 + (0.13962391363223647892e-2 + (0.93714365487312784270e-5 + (0.58882975670265286526e-7 + (0.34414937110591753387e-9 + (0.18552853109751857859e-11 + 0.91160736711111111110e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 30: {
+ double t = 2*y100 - 61;
+ return 0.61532500145144778048e-1 + (0.14344426411912015247e-2 + (0.97331446201016809696e-5 + (0.61711860507347175097e-7 + (0.36325987418295300221e-9 + (0.19681183310134518232e-11 + 0.96952238400000000000e-14 * t) * t) * t) * t) * t) * t;
+ }
+ case 31: {
+ double t = 2*y100 - 63;
+ return 0.64440817576653297993e-1 + (0.14741275456383131151e-2 + (0.10112293819576437838e-4 + (0.64698236605933246196e-7 + (0.38353412915303665586e-9 + (0.20881176114385120186e-11 + 0.10310784480000000000e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 32: {
+ double t = 2*y100 - 65;
+ return 0.67430045633130393282e-1 + (0.15153655418916540370e-2 + (0.10509857606888328667e-4 + (0.67851706529363332855e-7 + (0.40504602194811140006e-9 + (0.22157325110542534469e-11 + 0.10964842115555555556e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 33: {
+ double t = 2*y100 - 67;
+ return 0.70503365513338850709e-1 + (0.15582323336495709827e-2 + (0.10926868866865231089e-4 + (0.71182482239613507542e-7 + (0.42787405890153386710e-9 + (0.23514379522274416437e-11 + 0.11659571751111111111e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 34: {
+ double t = 2*y100 - 69;
+ return 0.73664114037944596353e-1 + (0.16028078812438820413e-2 + (0.11364423678778207991e-4 + (0.74701423097423182009e-7 + (0.45210162777476488324e-9 + (0.24957355004088569134e-11 + 0.12397238257777777778e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 35: {
+ double t = 2*y100 - 71;
+ return 0.76915792420819562379e-1 + (0.16491766623447889354e-2 + (0.11823685320041302169e-4 + (0.78420075993781544386e-7 + (0.47781726956916478925e-9 + (0.26491544403815724749e-11 + 0.13180196462222222222e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 36: {
+ double t = 2*y100 - 73;
+ return 0.80262075578094612819e-1 + (0.16974279491709504117e-2 + (0.12305888517309891674e-4 + (0.82350717698979042290e-7 + (0.50511496109857113929e-9 + (0.28122528497626897696e-11 + 0.14010889635555555556e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 37: {
+ double t = 2*y100 - 75;
+ return 0.83706822008980357446e-1 + (0.17476561032212656962e-2 + (0.12812343958540763368e-4 + (0.86506399515036435592e-7 + (0.53409440823869467453e-9 + (0.29856186620887555043e-11 + 0.14891851591111111111e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 38: {
+ double t = 2*y100 - 77;
+ return 0.87254084284461718231e-1 + (0.17999608886001962327e-2 + (0.13344443080089492218e-4 + (0.90900994316429008631e-7 + (0.56486134972616465316e-9 + (0.31698707080033956934e-11 + 0.15825697795555555556e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 39: {
+ double t = 2*y100 - 79;
+ return 0.90908120182172748487e-1 + (0.18544478050657699758e-2 + (0.13903663143426120077e-4 + (0.95549246062549906177e-7 + (0.59752787125242054315e-9 + (0.33656597366099099413e-11 + 0.16815130613333333333e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 40: {
+ double t = 2*y100 - 81;
+ return 0.94673404508075481121e-1 + (0.19112284419887303347e-2 + (0.14491572616545004930e-4 + (0.10046682186333613697e-6 + (0.63221272959791000515e-9 + (0.35736693975589130818e-11 + 0.17862931591111111111e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 41: {
+ double t = 2*y100 - 83;
+ return 0.98554641648004456555e-1 + (0.19704208544725622126e-2 + (0.15109836875625443935e-4 + (0.10567036667675984067e-6 + (0.66904168640019354565e-9 + (0.37946171850824333014e-11 + 0.18971959040000000000e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 42: {
+ double t = 2*y100 - 85;
+ return 0.10255677889470089531e0 + (0.20321499629472857418e-2 + (0.15760224242962179564e-4 + (0.11117756071353507391e-6 + (0.70814785110097658502e-9 + (0.40292553276632563925e-11 + 0.20145143075555555556e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 43: {
+ double t = 2*y100 - 87;
+ return 0.10668502059865093318e0 + (0.20965479776148731610e-2 + (0.16444612377624983565e-4 + (0.11700717962026152749e-6 + (0.74967203250938418991e-9 + (0.42783716186085922176e-11 + 0.21385479360000000000e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 44: {
+ double t = 2*y100 - 89;
+ return 0.11094484319386444474e0 + (0.21637548491908170841e-2 + (0.17164995035719657111e-4 + (0.12317915750735938089e-6 + (0.79376309831499633734e-9 + (0.45427901763106353914e-11 + 0.22696025653333333333e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 45: {
+ double t = 2*y100 - 91;
+ return 0.11534201115268804714e0 + (0.22339187474546420375e-2 + (0.17923489217504226813e-4 + (0.12971465288245997681e-6 + (0.84057834180389073587e-9 + (0.48233721206418027227e-11 + 0.24079890062222222222e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 46: {
+ double t = 2*y100 - 93;
+ return 0.11988259392684094740e0 + (0.23071965691918689601e-2 + (0.18722342718958935446e-4 + (0.13663611754337957520e-6 + (0.89028385488493287005e-9 + (0.51210161569225846701e-11 + 0.25540227111111111111e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 47: {
+ double t = 2*y100 - 95;
+ return 0.12457298393509812907e0 + (0.23837544771809575380e-2 + (0.19563942105711612475e-4 + (0.14396736847739470782e-6 + (0.94305490646459247016e-9 + (0.54366590583134218096e-11 + 0.27080225920000000000e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 48: {
+ double t = 2*y100 - 97;
+ return 0.12941991566142438816e0 + (0.24637684719508859484e-2 + (0.20450821127475879816e-4 + (0.15173366280523906622e-6 + (0.99907632506389027739e-9 + (0.57712760311351625221e-11 + 0.28703099555555555556e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 49: {
+ double t = 2*y100 - 99;
+ return 0.13443048593088696613e0 + (0.25474249981080823877e-2 + (0.21385669591362915223e-4 + (0.15996177579900443030e-6 + (0.10585428844575134013e-8 + (0.61258809536787882989e-11 + 0.30412080142222222222e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 50: {
+ double t = 2*y100 - 101;
+ return 0.13961217543434561353e0 + (0.26349215871051761416e-2 + (0.22371342712572567744e-4 + (0.16868008199296822247e-6 + (0.11216596910444996246e-8 + (0.65015264753090890662e-11 + 0.32210394506666666666e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 51: {
+ double t = 2*y100 - 103;
+ return 0.14497287157673800690e0 + (0.27264675383982439814e-2 + (0.23410870961050950197e-4 + (0.17791863939526376477e-6 + (0.11886425714330958106e-8 + (0.68993039665054288034e-11 + 0.34101266222222222221e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 52: {
+ double t = 2*y100 - 105;
+ return 0.15052089272774618151e0 + (0.28222846410136238008e-2 + (0.24507470422713397006e-4 + (0.18770927679626136909e-6 + (0.12597184587583370712e-8 + (0.73203433049229821618e-11 + 0.36087889048888888890e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 53: {
+ double t = 2*y100 - 107;
+ return 0.15626501395774612325e0 + (0.29226079376196624949e-2 + (0.25664553693768450545e-4 + (0.19808568415654461964e-6 + (0.13351257759815557897e-8 + (0.77658124891046760667e-11 + 0.38173420035555555555e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 54: {
+ double t = 2*y100 - 109;
+ return 0.16221449434620737567e0 + (0.30276865332726475672e-2 + (0.26885741326534564336e-4 + (0.20908350604346384143e-6 + (0.14151148144240728728e-8 + (0.82369170665974313027e-11 + 0.40360957457777777779e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 55: {
+ double t = 2*y100 - 111;
+ return 0.16837910595412130659e0 + (0.31377844510793082301e-2 + (0.28174873844911175026e-4 + (0.22074043807045782387e-6 + (0.14999481055996090039e-8 + (0.87348993661930809254e-11 + 0.42653528977777777779e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 56: {
+ double t = 2*y100 - 113;
+ return 0.17476916455659369953e0 + (0.32531815370903068316e-2 + (0.29536024347344364074e-4 + (0.23309632627767074202e-6 + (0.15899007843582444846e-8 + (0.92610375235427359475e-11 + 0.45054073102222222221e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 57: {
+ double t = 2*y100 - 115;
+ return 0.18139556223643701364e0 + (0.33741744168096996041e-2 + (0.30973511714709500836e-4 + (0.24619326937592290996e-6 + (0.16852609412267750744e-8 + (0.98166442942854895573e-11 + 0.47565418097777777779e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 58: {
+ double t = 2*y100 - 117;
+ return 0.18826980194443664549e0 + (0.35010775057740317997e-2 + (0.32491914440014267480e-4 + (0.26007572375886319028e-6 + (0.17863299617388376116e-8 + (0.10403065638343878679e-10 + 0.50190265831111111110e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 59: {
+ double t = 2*y100 - 119;
+ return 0.19540403413693967350e0 + (0.36342240767211326315e-2 + (0.34096085096200907289e-4 + (0.27479061117017637474e-6 + (0.18934228504790032826e-8 + (0.11021679075323598664e-10 + 0.52931171733333333334e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 60: {
+ double t = 2*y100 - 121;
+ return 0.20281109560651886959e0 + (0.37739673859323597060e-2 + (0.35791165457592409054e-4 + (0.29038742889416172404e-6 + (0.20068685374849001770e-8 + (0.11673891799578381999e-10 + 0.55790523093333333334e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 61: {
+ double t = 2*y100 - 123;
+ return 0.21050455062669334978e0 + (0.39206818613925652425e-2 + (0.37582602289680101704e-4 + (0.30691836231886877385e-6 + (0.21270101645763677824e-8 + (0.12361138551062899455e-10 + 0.58770520160000000000e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 62: {
+ double t = 2*y100 - 125;
+ return 0.21849873453703332479e0 + (0.40747643554689586041e-2 + (0.39476163820986711501e-4 + (0.32443839970139918836e-6 + (0.22542053491518680200e-8 + (0.13084879235290858490e-10 + 0.61873153262222222221e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 63: {
+ double t = 2*y100 - 127;
+ return 0.22680879990043229327e0 + (0.42366354648628516935e-2 + (0.41477956909656896779e-4 + (0.34300544894502810002e-6 + (0.23888264229264067658e-8 + (0.13846596292818514601e-10 + 0.65100183751111111110e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 64: {
+ double t = 2*y100 - 129;
+ return 0.23545076536988703937e0 + (0.44067409206365170888e-2 + (0.43594444916224700881e-4 + (0.36268045617760415178e-6 + (0.25312606430853202748e-8 + (0.14647791812837903061e-10 + 0.68453122631111111110e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 65: {
+ double t = 2*y100 - 131;
+ return 0.24444156740777432838e0 + (0.45855530511605787178e-2 + (0.45832466292683085475e-4 + (0.38352752590033030472e-6 + (0.26819103733055603460e-8 + (0.15489984390884756993e-10 + 0.71933206364444444445e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 66: {
+ double t = 2*y100 - 133;
+ return 0.25379911500634264643e0 + (0.47735723208650032167e-2 + (0.48199253896534185372e-4 + (0.40561404245564732314e-6 + (0.28411932320871165585e-8 + (0.16374705736458320149e-10 + 0.75541379822222222221e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 67: {
+ double t = 2*y100 - 135;
+ return 0.26354234756393613032e0 + (0.49713289477083781266e-2 + (0.50702455036930367504e-4 + (0.42901079254268185722e-6 + (0.30095422058900481753e-8 + (0.17303497025347342498e-10 + 0.79278273368888888890e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 68: {
+ double t = 2*y100 - 137;
+ return 0.27369129607732343398e0 + (0.51793846023052643767e-2 + (0.53350152258326602629e-4 + (0.45379208848865015485e-6 + (0.31874057245814381257e-8 + (0.18277905010245111046e-10 + 0.83144182364444444445e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 69: {
+ double t = 2*y100 - 139;
+ return 0.28426714781640316172e0 + (0.53983341916695141966e-2 + (0.56150884865255810638e-4 + (0.48003589196494734238e-6 + (0.33752476967570796349e-8 + (0.19299477888083469086e-10 + 0.87139049137777777779e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 70: {
+ double t = 2*y100 - 141;
+ return 0.29529231465348519920e0 + (0.56288077305420795663e-2 + (0.59113671189913307427e-4 + (0.50782393781744840482e-6 + (0.35735475025851713168e-8 + (0.20369760937017070382e-10 + 0.91262442613333333334e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 71: {
+ double t = 2*y100 - 143;
+ return 0.30679050522528838613e0 + (0.58714723032745403331e-2 + (0.62248031602197686791e-4 + (0.53724185766200945789e-6 + (0.37827999418960232678e-8 + (0.21490291930444538307e-10 + 0.95513539182222222221e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 72: {
+ double t = 2*y100 - 145;
+ return 0.31878680111173319425e0 + (0.61270341192339103514e-2 + (0.65564012259707640976e-4 + (0.56837930287837738996e-6 + (0.40035151353392378882e-8 + (0.22662596341239294792e-10 + 0.99891109760000000000e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 73: {
+ double t = 2*y100 - 147;
+ return 0.33130773722152622027e0 + (0.63962406646798080903e-2 + (0.69072209592942396666e-4 + (0.60133006661885941812e-6 + (0.42362183765883466691e-8 + (0.23888182347073698382e-10 + 0.10439349811555555556e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 74: {
+ double t = 2*y100 - 149;
+ return 0.34438138658041336523e0 + (0.66798829540414007258e-2 + (0.72783795518603561144e-4 + (0.63619220443228800680e-6 + (0.44814499336514453364e-8 + (0.25168535651285475274e-10 + 0.10901861383111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 75: {
+ double t = 2*y100 - 151;
+ return 0.35803744972380175583e0 + (0.69787978834882685031e-2 + (0.76710543371454822497e-4 + (0.67306815308917386747e-6 + (0.47397647975845228205e-8 + (0.26505114141143050509e-10 + 0.11376390933333333333e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 76: {
+ double t = 2*y100 - 153;
+ return 0.37230734890119724188e0 + (0.72938706896461381003e-2 + (0.80864854542670714092e-4 + (0.71206484718062688779e-6 + (0.50117323769745883805e-8 + (0.27899342394100074165e-10 + 0.11862637614222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 77: {
+ double t = 2*y100 - 155;
+ return 0.38722432730555448223e0 + (0.76260375162549802745e-2 + (0.85259785810004603848e-4 + (0.75329383305171327677e-6 + (0.52979361368388119355e-8 + (0.29352606054164086709e-10 + 0.12360253370666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 78: {
+ double t = 2*y100 - 157;
+ return 0.40282355354616940667e0 + (0.79762880915029728079e-2 + (0.89909077342438246452e-4 + (0.79687137961956194579e-6 + (0.55989731807360403195e-8 + (0.30866246101464869050e-10 + 0.12868841946666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 79: {
+ double t = 2*y100 - 159;
+ return 0.41914223158913787649e0 + (0.83456685186950463538e-2 + (0.94827181359250161335e-4 + (0.84291858561783141014e-6 + (0.59154537751083485684e-8 + (0.32441553034347469291e-10 + 0.13387957943111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 80: {
+ double t = 2*y100 - 161;
+ return 0.43621971639463786896e0 + (0.87352841828289495773e-2 + (0.10002929142066799966e-3 + (0.89156148280219880024e-6 + (0.62480008150788597147e-8 + (0.34079760983458878910e-10 + 0.13917107176888888889e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 81: {
+ double t = 2*y100 - 163;
+ return 0.45409763548534330981e0 + (0.91463027755548240654e-2 + (0.10553137232446167258e-3 + (0.94293113464638623798e-6 + (0.65972492312219959885e-8 + (0.35782041795476563662e-10 + 0.14455745872000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 82: {
+ double t = 2*y100 - 165;
+ return 0.47282001668512331468e0 + (0.95799574408860463394e-2 + (0.11135019058000067469e-3 + (0.99716373005509038080e-6 + (0.69638453369956970347e-8 + (0.37549499088161345850e-10 + 0.15003280712888888889e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 83: {
+ double t = 2*y100 - 167;
+ return 0.49243342227179841649e0 + (0.10037550043909497071e-1 + (0.11750334542845234952e-3 + (0.10544006716188967172e-5 + (0.73484461168242224872e-8 + (0.39383162326435752965e-10 + 0.15559069118222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 84: {
+ double t = 2*y100 - 169;
+ return 0.51298708979209258326e0 + (0.10520454564612427224e-1 + (0.12400930037494996655e-3 + (0.11147886579371265246e-5 + (0.77517184550568711454e-8 + (0.41283980931872622611e-10 + 0.16122419680000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 85: {
+ double t = 2*y100 - 171;
+ return 0.53453307979101369843e0 + (0.11030120618800726938e-1 + (0.13088741519572269581e-3 + (0.11784797595374515432e-5 + (0.81743383063044825400e-8 + (0.43252818449517081051e-10 + 0.16692592640000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 86: {
+ double t = 2*y100 - 173;
+ return 0.55712643071169299478e0 + (0.11568077107929735233e-1 + (0.13815797838036651289e-3 + (0.12456314879260904558e-5 + (0.86169898078969313597e-8 + (0.45290446811539652525e-10 + 0.17268801084444444444e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 87: {
+ double t = 2*y100 - 175;
+ return 0.58082532122519320968e0 + (0.12135935999503877077e-1 + (0.14584223996665838559e-3 + (0.13164068573095710742e-5 + (0.90803643355106020163e-8 + (0.47397540713124619155e-10 + 0.17850211608888888889e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 88: {
+ double t = 2*y100 - 177;
+ return 0.60569124025293375554e0 + (0.12735396239525550361e-1 + (0.15396244472258863344e-3 + (0.13909744385382818253e-5 + (0.95651595032306228245e-8 + (0.49574672127669041550e-10 + 0.18435945564444444444e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 89: {
+ double t = 2*y100 - 179;
+ return 0.63178916494715716894e0 + (0.13368247798287030927e-1 + (0.16254186562762076141e-3 + (0.14695084048334056083e-5 + (0.10072078109604152350e-7 + (0.51822304995680707483e-10 + 0.19025081422222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 90: {
+ double t = 2*y100 - 181;
+ return 0.65918774689725319200e0 + (0.14036375850601992063e-1 + (0.17160483760259706354e-3 + (0.15521885688723188371e-5 + (0.10601827031535280590e-7 + (0.54140790105837520499e-10 + 0.19616655146666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 91: {
+ double t = 2*y100 - 183;
+ return 0.68795950683174433822e0 + (0.14741765091365869084e-1 + (0.18117679143520433835e-3 + (0.16392004108230585213e-5 + (0.11155116068018043001e-7 + (0.56530360194925690374e-10 + 0.20209663662222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 92: {
+ double t = 2*y100 - 185;
+ return 0.71818103808729967036e0 + (0.15486504187117112279e-1 + (0.19128428784550923217e-3 + (0.17307350969359975848e-5 + (0.11732656736113607751e-7 + (0.58991125287563833603e-10 + 0.20803065333333333333e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 93: {
+ double t = 2*y100 - 187;
+ return 0.74993321911726254661e0 + (0.16272790364044783382e-1 + (0.20195505163377912645e-3 + (0.18269894883203346953e-5 + (0.12335161021630225535e-7 + (0.61523068312169087227e-10 + 0.21395783431111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 94: {
+ double t = 2*y100 - 189;
+ return 0.78330143531283492729e0 + (0.17102934132652429240e-1 + (0.21321800585063327041e-3 + (0.19281661395543913713e-5 + (0.12963340087354341574e-7 + (0.64126040998066348872e-10 + 0.21986708942222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 95: {
+ double t = 2*y100 - 191;
+ return 0.81837581041023811832e0 + (0.17979364149044223802e-1 + (0.22510330592753129006e-3 + (0.20344732868018175389e-5 + (0.13617902941839949718e-7 + (0.66799760083972474642e-10 + 0.22574701262222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 96: {
+ double t = 2*y100 - 193;
+ return 0.85525144775685126237e0 + (0.18904632212547561026e-1 + (0.23764237370371255638e-3 + (0.21461248251306387979e-5 + (0.14299555071870523786e-7 + (0.69543803864694171934e-10 + 0.23158593688888888889e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 97: {
+ double t = 2*y100 - 195;
+ return 0.89402868170849933734e0 + (0.19881418399127202569e-1 + (0.25086793128395995798e-3 + (0.22633402747585233180e-5 + (0.15008997042116532283e-7 + (0.72357609075043941261e-10 + 0.23737194737777777778e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 98: {
+ double t = 2*y100 - 197;
+ return 0.93481333942870796363e0 + (0.20912536329780368893e-1 + (0.26481403465998477969e-3 + (0.23863447359754921676e-5 + (0.15746923065472184451e-7 + (0.75240468141720143653e-10 + 0.24309291271111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 99: {
+ double t = 2*y100 - 199;
+ return 0.97771701335885035464e0 + (0.22000938572830479551e-1 + (0.27951610702682383001e-3 + (0.25153688325245314530e-5 + (0.16514019547822821453e-7 + (0.78191526829368231251e-10 + 0.24873652355555555556e-12 * t) * t) * t) * t) * t) * t;
+ }
+ }
+ // we only get here if y = 1, i.e. |x| < 4*eps, in which case
+ // erfcx is within 1e-15 of 1..
+ return 1.0;
+} // erfcx_y100
+
+/******************************************************************************/
+/* Library function erfcx */
+/******************************************************************************/
+
+double erfcx(double x)
+{
+ // Steven G. Johnson, October 2012.
+
+ // This function combines a few different ideas.
+
+ // First, for x > 50, it uses a continued-fraction expansion (same as
+ // for the Faddeeva function, but with algebraic simplifications for z=i*x).
+
+ // Second, for 0 <= x <= 50, it uses Chebyshev polynomial approximations,
+ // but with two twists:
+ //
+ // a) It maps x to y = 4 / (4+x) in [0,1]. This simple transformation,
+ // inspired by a similar transformation in the octave-forge/specfun
+ // erfcx by Soren Hauberg, results in much faster Chebyshev convergence
+ // than other simple transformations I have examined.
+ //
+ // b) Instead of using a single Chebyshev polynomial for the entire
+ // [0,1] y interval, we break the interval up into 100 equal
+ // subintervals, with a switch/lookup table, and use much lower
+ // degree Chebyshev polynomials in each subinterval. This greatly
+ // improves performance in my tests.
+ //
+ // For x < 0, we use the relationship erfcx(-x) = 2 exp(x^2) - erfc(x),
+ // with the usual checks for overflow etcetera.
+
+ // Performance-wise, it seems to be substantially faster than either
+ // the SLATEC DERFC function [or an erfcx function derived therefrom]
+ // or Cody's CALERF function (from netlib.org/specfun), while
+ // retaining near machine precision in accuracy.
+
+ if (x >= 0) {
+ if (x > 50) {
+ // continued-fraction expansion is faster
+ const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
+ if (x > 5e7) {
+ // 1-term expansion, important to avoid overflow */
+ return ispi / x;
+ } else {
+ // 5-term expansion (rely on compiler for CSE), simplified from: ispi / (x+0.5/(x+1/(x+1.5/(x+2/x))))
+ return ispi * ((x*x) * (x*x+4.5) + 2) / (x * ((x*x) * (x*x+5) + 3.75));
+ }
+ }
+ return erfcx_y100(400/(4+x));
+ } else {
+ return x < -26.7 ? HUGE_VAL : (x < -6.1 ? 2*exp(x*x) : 2*exp(x*x) - erfcx_y100(400/(4-x)));
+ }
+
+} // erfcx
diff --git a/source/luametatex/source/libraries/libcerf/err_fcts.c b/source/luametatex/source/libraries/libcerf/err_fcts.c
new file mode 100644
index 000000000..9c0c7aed9
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/err_fcts.c
@@ -0,0 +1,438 @@
+/* Library libcerf:
+ * Compute complex error functions, based on a new implementation of
+ * Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
+ *
+ * File err_fcts.c:
+ * Computate Dawson, Voigt, and several error functions,
+ * based on erfcx, im_w_of_x, w_of_z as implemented in separate files.
+ *
+ * Given w(z), the error functions are mostly straightforward
+ * to compute, except for certain regions where we have to
+ * switch to Taylor expansions to avoid cancellation errors
+ * [e.g. near the origin for erf(z)].
+ *
+ * Copyright:
+ * (C) 2012 Massachusetts Institute of Technology
+ * (C) 2013 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * 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.
+ *
+ * Authors:
+ * Steven G. Johnson, Massachusetts Institute of Technology, 2012, core author
+ * Joachim Wuttke, Forschungszentrum Jülich, 2013, package maintainer
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ *
+ * Revision history:
+ * ../CHANGELOG
+ *
+ * Man pages:
+ * cerf(3), dawson(3), voigt(3)
+ */
+
+#include "cerf.h"
+#include <math.h>
+#include "defs.h" // defines _cerf_cmplx, NaN, C, cexp, ...
+
+const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2
+const double s2pi = 2.5066282746310005024157652848110; // sqrt(2*pi)
+const double pi = 3.141592653589793238462643383279503;
+
+/******************************************************************************/
+/* Simple wrappers: cerfcx, cerfi, erfi, dawson */
+/******************************************************************************/
+
+_cerf_cmplx cerfcx(_cerf_cmplx z)
+{
+ // Compute erfcx(z) = exp(z^2) erfc(z),
+ // the complex underflow-compensated complementary error function,
+ // trivially related to Faddeeva's w_of_z.
+
+ return w_of_z(C(-cimag(z), creal(z)));
+}
+
+_cerf_cmplx cerfi(_cerf_cmplx z)
+{
+ // Compute erfi(z) = -i erf(iz),
+ // the rotated complex error function.
+
+ _cerf_cmplx e = cerf(C(-cimag(z),creal(z)));
+ return C(cimag(e), -creal(e));
+}
+
+double erfi(double x)
+{
+ // Compute erfi(x) = -i erf(ix),
+ // the imaginary error function.
+
+ return x*x > 720 ? (x > 0 ? Inf : -Inf) : exp(x*x) * im_w_of_x(x);
+}
+
+double dawson(double x)
+{
+
+ // Compute dawson(x) = sqrt(pi)/2 * exp(-x^2) * erfi(x),
+ // Dawson's integral for a real argument.
+
+ return spi2 * im_w_of_x(x);
+}
+
+double re_w_of_z( double x, double y )
+{
+ return creal( w_of_z( C(x,y) ) );
+}
+
+double im_w_of_z( double x, double y )
+{
+ return cimag( w_of_z( C(x,y) ) );
+}
+
+/******************************************************************************/
+/* voigt */
+/******************************************************************************/
+
+double voigt( double x, double sigma, double gamma )
+{
+ // Joachim Wuttke, January 2013.
+
+ // Compute Voigt's convolution of a Gaussian
+ // G(x,sigma) = 1/sqrt(2*pi)/|sigma| * exp(-x^2/2/sigma^2)
+ // and a Lorentzian
+ // L(x,gamma) = |gamma| / pi / ( x^2 + gamma^2 ),
+ // namely
+ // voigt(x,sigma,gamma) =
+ // \int_{-infty}^{infty} dx' G(x',sigma) L(x-x',gamma)
+ // using the relation
+ // voigt(x,sigma,gamma) = Re{ w(z) } / sqrt(2*pi) / |sigma|
+ // with
+ // z = (x+i*|gamma|) / sqrt(2) / |sigma|.
+
+ // Reference: Abramowitz&Stegun (1964), formula (7.4.13).
+
+ double gam = gamma < 0 ? -gamma : gamma;
+ double sig = sigma < 0 ? -sigma : sigma;
+
+ if ( gam==0 ) {
+ if ( sig==0 ) {
+ // It's kind of a delta function
+ return x ? 0 : Inf;
+ } else {
+ // It's a pure Gaussian
+ return exp( -x*x/2/(sig*sig) ) / s2pi / sig;
+ }
+ } else {
+ if ( sig==0 ) {
+ // It's a pure Lorentzian
+ return gam / pi / (x*x + gam*gam);
+ } else {
+ // Regular case, both parameters are nonzero
+ _cerf_cmplx z = complex_mul_cr(C(x, gam), 1. / sqrt(2) / sig);
+ return creal( w_of_z(z) ) / s2pi / sig;
+ // TODO: correct and activate the following:
+// double w = sqrt(gam*gam+sig*sig); // to work in reduced units
+// _cerf_cmplx z = C(x/w,gam/w) / sqrt(2) / (sig/w);
+// return creal( w_of_z(z) ) / s2pi / (sig/w);
+ }
+ }
+}
+
+/******************************************************************************/
+/* cerf */
+/******************************************************************************/
+
+_cerf_cmplx cerf(_cerf_cmplx z)
+{
+
+ // Steven G. Johnson, October 2012.
+
+ // Compute erf(z), the complex error function,
+ // using w_of_z except for certain regions.
+
+ double x = creal(z), y = cimag(z);
+
+ if (y == 0)
+ return C(erf(x), y); // preserve sign of 0
+ if (x == 0) // handle separately for speed & handling of y = Inf or NaN
+ return C(x, // preserve sign of 0
+ /* handle y -> Inf limit manually, since
+ exp(y^2) -> Inf but Im[w(y)] -> 0, so
+ IEEE will give us a NaN when it should be Inf */
+ y*y > 720 ? (y > 0 ? Inf : -Inf)
+ : exp(y*y) * im_w_of_x(y));
+
+ double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow
+ double mIm_z2 = -2*x*y; // Im(-z^2)
+ if (mRe_z2 < -750) // underflow
+ return (x >= 0 ? C(1.0, 0.0) : C(-1.0, 0.0));;
+
+ /* Handle positive and negative x via different formulas,
+ using the mirror symmetries of w, to avoid overflow/underflow
+ problems from multiplying exponentially large and small quantities. */
+ if (x >= 0) {
+ if (x < 8e-2) {
+ if (fabs(y) < 1e-2)
+ goto taylor;
+ else if (fabs(mIm_z2) < 5e-3 && x < 5e-3)
+ goto taylor_erfi;
+ }
+ /* don't use complex exp function, since that will produce spurious NaN
+ values when multiplying w in an overflow situation. */
+ return complex_sub_rc(1.0, complex_mul_rc(exp(mRe_z2), complex_mul_cc(C(cos(mIm_z2), sin(mIm_z2)), w_of_z(C(-y, x)))));
+ }
+ else { // x < 0
+ if (x > -8e-2) { // duplicate from above to avoid fabs(x) call
+ if (fabs(y) < 1e-2)
+ goto taylor;
+ else if (fabs(mIm_z2) < 5e-3 && x > -5e-3)
+ goto taylor_erfi;
+ }
+ else if (isnan(x))
+ return C(NaN, y == 0 ? 0 : NaN);
+ /* don't use complex exp function, since that will produce spurious NaN
+ values when multiplying w in an overflow situation. */
+ return complex_add_rc(-1.0, complex_mul_rc(exp(mRe_z2), complex_mul_cc(C(cos(mIm_z2), sin(mIm_z2)), w_of_z(C(y, -x)))));
+
+ }
+
+ // Use Taylor series for small |z|, to avoid cancellation inaccuracy
+ // erf(z) = 2/sqrt(pi) * z * (1 - z^2/3 + z^4/10 - z^6/42 + z^8/216 + ...)
+taylor:
+ {
+ _cerf_cmplx mz2 = C(mRe_z2, mIm_z2); // -z^2
+ return
+ complex_mul_cc(z, complex_add_rc(1.1283791670955125739,
+ complex_mul_cc(mz2, complex_add_rc(0.37612638903183752464,
+ complex_mul_cc(mz2, complex_add_rc(0.11283791670955125739,
+ complex_mul_cc(mz2, complex_add_rc(0.026866170645131251760,
+ complex_mul_cr(mz2, 0.0052239776254421878422)))))))));
+
+
+ }
+
+ /* for small |x| and small |xy|,
+ use Taylor series to avoid cancellation inaccuracy:
+ erf(x+iy) = erf(iy)
+ + 2*exp(y^2)/sqrt(pi) *
+ [ x * (1 - x^2 * (1+2y^2)/3 + x^4 * (3+12y^2+4y^4)/30 + ...
+ - i * x^2 * y * (1 - x^2 * (3+2y^2)/6 + ...) ]
+ where:
+ erf(iy) = exp(y^2) * Im[w(y)]
+ */
+taylor_erfi:
+ {
+ double x2 = x*x, y2 = y*y;
+ double expy2 = exp(y2);
+ return C
+ (expy2 * x * (1.1283791670955125739
+ - x2 * (0.37612638903183752464
+ + 0.75225277806367504925*y2)
+ + x2*x2 * (0.11283791670955125739
+ + y2 * (0.45135166683820502956
+ + 0.15045055561273500986*y2))),
+ expy2 * (im_w_of_x(y)
+ - x2*y * (1.1283791670955125739
+ - x2 * (0.56418958354775628695
+ + 0.37612638903183752464*y2))));
+ }
+} // cerf
+
+/******************************************************************************/
+/* cerfc */
+/******************************************************************************/
+
+_cerf_cmplx cerfc(_cerf_cmplx z)
+{
+ // Steven G. Johnson, October 2012.
+
+ // Compute erfc(z) = 1 - erf(z), the complex complementary error function,
+ // using w_of_z except for certain regions.
+
+ double x = creal(z), y = cimag(z);
+
+ if (x == 0.)
+ return C(1,
+ /* handle y -> Inf limit manually, since
+ exp(y^2) -> Inf but Im[w(y)] -> 0, so
+ IEEE will give us a NaN when it should be Inf */
+ y*y > 720 ? (y > 0 ? -Inf : Inf)
+ : -exp(y*y) * im_w_of_x(y));
+ if (y == 0.) {
+ if (x*x > 750) // underflow
+ return C(x >= 0 ? 0.0 : 2.0,
+ -y); // preserve sign of 0
+ return C(x >= 0 ? exp(-x*x) * erfcx(x)
+ : 2. - exp(-x*x) * erfcx(-x),
+ -y); // preserve sign of zero
+ }
+
+ double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow
+ double mIm_z2 = -2*x*y; // Im(-z^2)
+ if (mRe_z2 < -750) // underflow
+ return C((x >= 0 ? 0.0 : 2.0), 0.0);
+
+ if (x >= 0)
+ return cexp(complex_mul_cc(C(mRe_z2, mIm_z2), w_of_z(C(-y,x))));
+ else
+ return complex_sub_rc(2.0, complex_mul_cc(cexp(C(mRe_z2, mIm_z2)), w_of_z(C(y, -x))));
+} // cerfc
+
+/******************************************************************************/
+/* cdawson */
+/******************************************************************************/
+
+_cerf_cmplx cdawson(_cerf_cmplx z)
+{
+
+ // Steven G. Johnson, October 2012.
+
+ // Compute Dawson(z) = sqrt(pi)/2 * exp(-z^2) * erfi(z),
+ // Dawson's integral for a complex argument,
+ // using w_of_z except for certain regions.
+
+ double x = creal(z), y = cimag(z);
+
+ // handle axes separately for speed & proper handling of x or y = Inf or NaN
+ if (y == 0)
+ return C(spi2 * im_w_of_x(x),
+ -y); // preserve sign of 0
+ if (x == 0) {
+ double y2 = y*y;
+ if (y2 < 2.5e-5) { // Taylor expansion
+ return C(x, // preserve sign of 0
+ y * (1.
+ + y2 * (0.6666666666666666666666666666666666666667
+ + y2 * 0.26666666666666666666666666666666666667)));
+ }
+ return C(x, // preserve sign of 0
+ spi2 * (y >= 0
+ ? exp(y2) - erfcx(y)
+ : erfcx(-y) - exp(y2)));
+ }
+
+ double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow
+ double mIm_z2 = -2*x*y; // Im(-z^2)
+ _cerf_cmplx mz2 = C(mRe_z2, mIm_z2); // -z^2
+
+ /* Handle positive and negative x via different formulas,
+ using the mirror symmetries of w, to avoid overflow/underflow
+ problems from multiplying exponentially large and small quantities. */
+ if (y >= 0) {
+ if (y < 5e-3) {
+ if (fabs(x) < 5e-3)
+ goto taylor;
+ else if (fabs(mIm_z2) < 5e-3)
+ goto taylor_realaxis;
+ }
+ _cerf_cmplx res = complex_sub_cc(cexp(mz2), w_of_z(z));
+ return complex_mul_rc(spi2, C(-cimag(res), creal(res)));
+ }
+ else { // y < 0
+ if (y > -5e-3) { // duplicate from above to avoid fabs(x) call
+ if (fabs(x) < 5e-3)
+ goto taylor;
+ else if (fabs(mIm_z2) < 5e-3)
+ goto taylor_realaxis;
+ }
+ else if (isnan(y))
+ return C(x == 0 ? 0 : NaN, NaN);
+ {
+ _cerf_cmplx res = complex_sub_cc(w_of_z(complex_neg(z)), cexp(mz2));
+ return complex_mul_rc(spi2, C(-cimag(res), creal(res)));
+ }
+ }
+
+ // Use Taylor series for small |z|, to avoid cancellation inaccuracy
+ // dawson(z) = z - 2/3 z^3 + 4/15 z^5 + ...
+taylor:
+ return complex_mul_cc(z, complex_add_rc(1.,
+ complex_mul_cc(mz2, complex_add_rc(0.6666666666666666666666666666666666666667,
+ complex_mul_cr(mz2, 0.2666666666666666666666666666666666666667)))));
+ /* for small |y| and small |xy|,
+ use Taylor series to avoid cancellation inaccuracy:
+ dawson(x + iy)
+ = D + y^2 (D + x - 2Dx^2)
+ + y^4 (D/2 + 5x/6 - 2Dx^2 - x^3/3 + 2Dx^4/3)
+ + iy [ (1-2Dx) + 2/3 y^2 (1 - 3Dx - x^2 + 2Dx^3)
+ + y^4/15 (4 - 15Dx - 9x^2 + 20Dx^3 + 2x^4 - 4Dx^5) ] + ...
+ where D = dawson(x)
+
+ However, for large |x|, 2Dx -> 1 which gives cancellation problems in
+ this series (many of the leading terms cancel). So, for large |x|,
+ we need to substitute a continued-fraction expansion for D.
+
+ dawson(x) = 0.5 / (x-0.5/(x-1/(x-1.5/(x-2/(x-2.5/(x...))))))
+
+ The 6 terms shown here seems to be the minimum needed to be
+ accurate as soon as the simpler Taylor expansion above starts
+ breaking down. Using this 6-term expansion, factoring out the
+ denominator, and simplifying with Maple, we obtain:
+
+ Re dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / x
+ = 33 - 28x^2 + 4x^4 + y^2 (18 - 4x^2) + 4 y^4
+ Im dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / y
+ = -15 + 24x^2 - 4x^4 + 2/3 y^2 (6x^2 - 15) - 4 y^4
+
+ Finally, for |x| > 5e7, we can use a simpler 1-term continued-fraction
+ expansion for the real part, and a 2-term expansion for the imaginary
+ part. (This avoids overflow problems for huge |x|.) This yields:
+
+ Re dawson(x + iy) = [1 + y^2 (1 + y^2/2 - (xy)^2/3)] / (2x)
+ Im dawson(x + iy) = y [ -1 - 2/3 y^2 + y^4/15 (2x^2 - 4) ] / (2x^2 - 1)
+
+ */
+taylor_realaxis:
+ {
+ double x2 = x*x;
+ if (x2 > 1600) { // |x| > 40
+ double y2 = y*y;
+ if (x2 > 25e14) {// |x| > 5e7
+ double xy2 = (x*y)*(x*y);
+ return C((0.5 + y2 * (0.5 + 0.25*y2
+ - 0.16666666666666666667*xy2)) / x,
+ y * (-1 + y2 * (-0.66666666666666666667
+ + 0.13333333333333333333*xy2
+ - 0.26666666666666666667*y2))
+ / (2*x2 - 1));
+ }
+ return complex_mul_rc((1. / (-15 + x2 * (90 + x2 * (-60 + 8 * x2)))),
+ C(x * (33 + x2 * (-28 + 4 * x2)
+ + +y2 * (18 - 4 * x2 + 4 * y2)),
+ +y * (-15 + x2 * (24 - 4 * x2)
+ + +y2 * (4 * x2 - 10 - 4 * y2))));
+ }
+ else {
+ double D = spi2 * im_w_of_x(x);
+ double y2 = y*y;
+ return C
+ (D + y2 * (D + x - 2*D*x2)
+ + y2*y2 * (D * (0.5 - x2 * (2 - 0.66666666666666666667*x2))
+ + x * (0.83333333333333333333
+ - 0.33333333333333333333 * x2)),
+ y * (1 - 2*D*x
+ + y2 * 0.66666666666666666667 * (1 - x2 - D*x * (3 - 2*x2))
+ + y2*y2 * (0.26666666666666666667 -
+ x2 * (0.6 - 0.13333333333333333333 * x2)
+ - D*x * (1 - x2 * (1.3333333333333333333
+ - 0.26666666666666666667 * x2)))));
+ }
+ }
+} // cdawson
diff --git a/source/luametatex/source/libraries/libcerf/experimental.c b/source/luametatex/source/libraries/libcerf/experimental.c
new file mode 100644
index 000000000..f5ba9477e
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/experimental.c
@@ -0,0 +1,178 @@
+/******************************************************************************/
+/* Experimental code */
+/******************************************************************************/
+
+/*
+ Compute w_of_z via Fourier integration using Ooura-Mori transform.
+ Agreement with Johnson's code usually < 1E-15, so far always < 1E-13.
+ Todo:
+ - sign for negative x or y
+ - determine application limits
+ - more systematical comparison with Johnson's code
+ - comparison with Abrarov&Quine
+ */
+
+#define max_iter_int 10
+#define num_range 5
+#define PI 3.14159265358979323846L /* pi */
+#define SQR(x) ((x)*(x))
+#include <errno.h>
+
+double cerf_experimental_integration( int kind, double x, double y )
+// kind: 0 cos, 1 sin transform (precomputing arrays[2] depend on this)
+{
+ // unused parameters
+ static int mu = 0;
+ int intgr_debug = 0;
+ static double intgr_delta=2.2e-16, intgr_eps=5.5e-20;
+
+ if( x<0 || y<0 ) {
+ fprintf( stderr, "negative arguments not yet implemented\n" );
+ exit( EDOM );
+ }
+
+ double w = sqrt(2)*x;
+ double gamma = sqrt(2)*y;
+
+ int iter;
+ int kaux;
+ int isig;
+ int N;
+ int j; // range
+ long double S=0; // trapezoid sum
+ long double S_last; // - in last iteration
+ long double s; // term contributing to S
+ long double T; // sum of abs(s)
+ // precomputed coefficients
+ static int firstCall=1;
+ static int iterDone[2][num_range]; // Nm,Np,ak,bk are precomputed up to this
+ static int Nm[num_range][max_iter_int];
+ static int Np[num_range][max_iter_int];
+ static long double *ak[2][num_range][max_iter_int];
+ static long double *bk[2][num_range][max_iter_int];
+ // auxiliary for computing ak and bk
+ long double u;
+ long double e;
+ long double tk;
+ long double chi;
+ long double dchi;
+ long double h;
+ long double k;
+ long double f;
+ long double ahk;
+ long double chk;
+ long double dhk;
+ double p;
+ double q;
+ const double Smin=2e-20; // to assess worst truncation error
+
+ // dynamic initialization upon first call
+ if ( firstCall ) {
+ for ( j=0; j<num_range; ++ j ) {
+ iterDone[0][j] = -1;
+ iterDone[1][j] = -1;
+ }
+ firstCall = 0;
+ }
+
+ // determine range, set p,q
+ j=1; p=1.4; q=0.6;
+
+ // iterative integration
+ if( intgr_debug & 4 )
+ N = 100;
+ else
+ N = 40;
+ for ( iter=0; iter<max_iter_int; ++iter ) {
+ // static initialisation of Nm, Np, ak, bk for given 'iter'
+ if ( iter>iterDone[kind][j] ) {
+ if ( N>1e6 )
+ return -3; // integral limits overflow
+ Nm[j][iter] = N;
+ Np[j][iter] = N;
+ if ( !( ak[kind][j][iter]=malloc((sizeof(long double))*
+ (Nm[j][iter]+1+Np[j][iter])) ) ||
+ !( bk[kind][j][iter]=malloc((sizeof(long double))*
+ (Nm[j][iter]+1+Np[j][iter])) ) ) {
+ fprintf( stderr, "Workspace allocation failed\n" );
+ exit( ENOMEM );
+ }
+ h = logl( logl( 42*N/intgr_delta/Smin ) / p ) / N; // 42=(pi+1)*10
+ isig=1-2*(Nm[j][iter]&1);
+ for ( kaux=-Nm[j][iter]; kaux<=Np[j][iter]; ++kaux ) {
+ k = kaux;
+ if( !kind )
+ k -= 0.5;
+ u = k*h;
+ chi = 2*p*sinhl(u) + 2*q*u;
+ dchi = 2*p*coshl(u) + 2*q;
+ if ( u==0 ) {
+ if ( k!=0 )
+ return -4; // integration variable underflow
+ // special treatment to bridge singularity at u=0
+ ahk = PI/h/dchi;
+ dhk = 0.5;
+ chk = sin( ahk );
+ } else {
+ if ( -chi>DBL_MAX_EXP/2 )
+ return -5; // integral transformation overflow
+ e = expl( -chi );
+ ahk = PI/h * u/(1-e);
+ dhk = 1/(1-e) - u*e*dchi/SQR(1-e);
+ chk = e>1 ?
+ ( kind ? sinl( PI*k/(1-e) ) : cosl( PI*k/(1-e) ) ) :
+ isig * sinl( PI*k*e/(1-e) );
+ }
+ ak[kind][j][iter][kaux+Nm[j][iter]] = ahk;
+ bk[kind][j][iter][kaux+Nm[j][iter]] = dhk * chk;
+ isig = -isig;
+ }
+ iterDone[kind][j] = iter;
+ }
+ // integrate according to trapezoidal rule
+ S_last = S;
+ S = 0;
+ T = 0;
+ for ( kaux=-Nm[j][iter]; kaux<=Np[j][iter]; ++kaux ) {
+ tk = ak[kind][j][iter][kaux+Nm[j][iter]] / w;
+ f = expl(-tk*gamma-SQR(tk)/2); // Fourier kernel
+ if ( mu )
+ f /= tk; // TODO
+ s = bk[kind][j][iter][kaux+Nm[j][iter]] * f;
+ S += s;
+ T += fabsl(s);
+ if( intgr_debug & 2 )
+ printf( "%2i %6i %12.4Lg %12.4Lg"
+ " %12.4Lg %12.4Lg %12.4Lg %12.4Lg\n",
+ iter, kaux, ak[kind][j][iter][kaux+Nm[j][iter]],
+ bk[kind][j][iter][kaux+Nm[j][iter]], f, s, S, T );
+ }
+ if( intgr_debug & 1 )
+ printf( "%23.17Le %23.17Le\n", S, T );
+ // intgr_num_of_terms += Np[j][iter]-(-Nm[j][iter])+1;
+ // termination criteria
+ if ( intgr_debug & 4 )
+ return -1; // we want to inspect just one sum
+ else if ( S < 0 )
+ return -6; // cancelling terms lead to negative S
+ else if ( intgr_eps*T > intgr_delta*fabs(S) )
+ return -2; // cancellation
+ else if ( iter && fabs(S-S_last) + intgr_eps*T < intgr_delta*fabs(S) )
+ return S*sqrt(2*PI)/w; // success
+ // factor 2 from int_-infty^+infty = 2 * int_0^+infty
+ // factor pi/w from formula 48 in kww paper
+ // factor 1/sqrt(2*pi) from Gaussian
+ N *= 2; // retry with more points
+ }
+ return -9; // not converged
+}
+
+double cerf_experimental_imw( double x, double y )
+{
+ return cerf_experimental_integration( 1, x, y );
+}
+
+double cerf_experimental_rew( double x, double y )
+{
+ return cerf_experimental_integration( 0, x, y );
+}
diff --git a/source/luametatex/source/libraries/libcerf/im_w_of_x.c b/source/luametatex/source/libraries/libcerf/im_w_of_x.c
new file mode 100644
index 000000000..505c8c3fe
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/im_w_of_x.c
@@ -0,0 +1,519 @@
+/* Library libcerf:
+ * Compute complex error functions, based on a new implementation of
+ * Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
+ *
+ * File im_w_of_x.c:
+ * Compute scaled Dawson integral im_w_of_x(x) = 2*dawson(x)/sqrt(pi),
+ * equivalent to the imaginary part of the Faddeeva function w(x) for real x.
+ *
+ * Copyright:
+ * (C) 2012 Massachusetts Institute of Technology
+ * (C) 2013 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * 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.
+ *
+ * Authors:
+ * Steven G. Johnson, Massachusetts Institute of Technology, 2012, core author
+ * Joachim Wuttke, Forschungszentrum Jülich, 2013, package maintainer
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ *
+ * Revision history:
+ * ../CHANGELOG
+ *
+ * Manual page:
+ * man 3 im_w_of_x
+ */
+
+#include "cerf.h"
+#include <math.h>
+#include "defs.h" // defines _cerf_cmplx, NaN, C, cexp, ...
+
+/******************************************************************************/
+/* Lookup-table for Chebyshev polynomials for smaller |x| */
+/******************************************************************************/
+
+static double w_im_y100(double y100, double x)
+{
+ // Steven G. Johnson, October 2012.
+
+ // Given y100=100*y, where y = 1/(1+x) for x >= 0, compute w_im(x).
+
+ // Uses a look-up table of 100 different Chebyshev polynomials
+ // for y intervals [0,0.01], [0.01,0.02], ...., [0.99,1], generated
+ // with the help of Maple and a little shell script.
+ // This allows the Chebyshev polynomials to be of significantly lower
+ // degree (about 1/30) compared to fitting the whole [0,1] interval
+ // with a single polynomial.
+
+ switch ((int) y100) {
+ case 0: {
+ double t = 2*y100 - 1;
+ return 0.28351593328822191546e-2 + (0.28494783221378400759e-2 + (0.14427470563276734183e-4 + (0.10939723080231588129e-6 + (0.92474307943275042045e-9 + (0.89128907666450075245e-11 + 0.92974121935111111110e-13 * t) * t) * t) * t) * t) * t;
+ }
+ case 1: {
+ double t = 2*y100 - 3;
+ return 0.85927161243940350562e-2 + (0.29085312941641339862e-2 + (0.15106783707725582090e-4 + (0.11716709978531327367e-6 + (0.10197387816021040024e-8 + (0.10122678863073360769e-10 + 0.10917479678400000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 2: {
+ double t = 2*y100 - 5;
+ return 0.14471159831187703054e-1 + (0.29703978970263836210e-2 + (0.15835096760173030976e-4 + (0.12574803383199211596e-6 + (0.11278672159518415848e-8 + (0.11547462300333495797e-10 + 0.12894535335111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 3: {
+ double t = 2*y100 - 7;
+ return 0.20476320420324610618e-1 + (0.30352843012898665856e-2 + (0.16617609387003727409e-4 + (0.13525429711163116103e-6 + (0.12515095552507169013e-8 + (0.13235687543603382345e-10 + 0.15326595042666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 4: {
+ double t = 2*y100 - 9;
+ return 0.26614461952489004566e-1 + (0.31034189276234947088e-2 + (0.17460268109986214274e-4 + (0.14582130824485709573e-6 + (0.13935959083809746345e-8 + (0.15249438072998932900e-10 + 0.18344741882133333333e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 5: {
+ double t = 2*y100 - 11;
+ return 0.32892330248093586215e-1 + (0.31750557067975068584e-2 + (0.18369907582308672632e-4 + (0.15761063702089457882e-6 + (0.15577638230480894382e-8 + (0.17663868462699097951e-10 + (0.22126732680711111111e-12 + 0.30273474177737853668e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 6: {
+ double t = 2*y100 - 13;
+ return 0.39317207681134336024e-1 + (0.32504779701937539333e-2 + (0.19354426046513400534e-4 + (0.17081646971321290539e-6 + (0.17485733959327106250e-8 + (0.20593687304921961410e-10 + (0.26917401949155555556e-12 + 0.38562123837725712270e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 7: {
+ double t = 2*y100 - 15;
+ return 0.45896976511367738235e-1 + (0.33300031273110976165e-2 + (0.20423005398039037313e-4 + (0.18567412470376467303e-6 + (0.19718038363586588213e-8 + (0.24175006536781219807e-10 + (0.33059982791466666666e-12 + 0.49756574284439426165e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 8: {
+ double t = 2*y100 - 17;
+ return 0.52640192524848962855e-1 + (0.34139883358846720806e-2 + (0.21586390240603337337e-4 + (0.20247136501568904646e-6 + (0.22348696948197102935e-8 + (0.28597516301950162548e-10 + (0.41045502119111111110e-12 + 0.65151614515238361946e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 9: {
+ double t = 2*y100 - 19;
+ return 0.59556171228656770456e-1 + (0.35028374386648914444e-2 + (0.22857246150998562824e-4 + (0.22156372146525190679e-6 + (0.25474171590893813583e-8 + (0.34122390890697400584e-10 + (0.51593189879111111110e-12 + 0.86775076853908006938e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 10: {
+ double t = 2*y100 - 21;
+ return 0.66655089485108212551e-1 + (0.35970095381271285568e-2 + (0.24250626164318672928e-4 + (0.24339561521785040536e-6 + (0.29221990406518411415e-8 + (0.41117013527967776467e-10 + (0.65786450716444444445e-12 + 0.11791885745450623331e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 11: {
+ double t = 2*y100 - 23;
+ return 0.73948106345519174661e-1 + (0.36970297216569341748e-2 + (0.25784588137312868792e-4 + (0.26853012002366752770e-6 + (0.33763958861206729592e-8 + (0.50111549981376976397e-10 + (0.85313857496888888890e-12 + 0.16417079927706899860e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 12: {
+ double t = 2*y100 - 25;
+ return 0.81447508065002963203e-1 + (0.38035026606492705117e-2 + (0.27481027572231851896e-4 + (0.29769200731832331364e-6 + (0.39336816287457655076e-8 + (0.61895471132038157624e-10 + (0.11292303213511111111e-11 + 0.23558532213703884304e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 13: {
+ double t = 2*y100 - 27;
+ return 0.89166884027582716628e-1 + (0.39171301322438946014e-2 + (0.29366827260422311668e-4 + (0.33183204390350724895e-6 + (0.46276006281647330524e-8 + (0.77692631378169813324e-10 + (0.15335153258844444444e-11 + 0.35183103415916026911e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 14: {
+ double t = 2*y100 - 29;
+ return 0.97121342888032322019e-1 + (0.40387340353207909514e-2 + (0.31475490395950776930e-4 + (0.37222714227125135042e-6 + (0.55074373178613809996e-8 + (0.99509175283990337944e-10 + (0.21552645758222222222e-11 + 0.55728651431872687605e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 15: {
+ double t = 2*y100 - 31;
+ return 0.10532778218603311137e0 + (0.41692873614065380607e-2 + (0.33849549774889456984e-4 + (0.42064596193692630143e-6 + (0.66494579697622432987e-8 + (0.13094103581931802337e-9 + (0.31896187409777777778e-11 + 0.97271974184476560742e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 16: {
+ double t = 2*y100 - 33;
+ return 0.11380523107427108222e0 + (0.43099572287871821013e-2 + (0.36544324341565929930e-4 + (0.47965044028581857764e-6 + (0.81819034238463698796e-8 + (0.17934133239549647357e-9 + (0.50956666166186293627e-11 + (0.18850487318190638010e-12 + 0.79697813173519853340e-14 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 17: {
+ double t = 2*y100 - 35;
+ return 0.12257529703447467345e0 + (0.44621675710026986366e-2 + (0.39634304721292440285e-4 + (0.55321553769873381819e-6 + (0.10343619428848520870e-7 + (0.26033830170470368088e-9 + (0.87743837749108025357e-11 + (0.34427092430230063401e-12 + 0.10205506615709843189e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 18: {
+ double t = 2*y100 - 37;
+ return 0.13166276955656699478e0 + (0.46276970481783001803e-2 + (0.43225026380496399310e-4 + (0.64799164020016902656e-6 + (0.13580082794704641782e-7 + (0.39839800853954313927e-9 + (0.14431142411840000000e-10 + 0.42193457308830027541e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 19: {
+ double t = 2*y100 - 39;
+ return 0.14109647869803356475e0 + (0.48088424418545347758e-2 + (0.47474504753352150205e-4 + (0.77509866468724360352e-6 + (0.18536851570794291724e-7 + (0.60146623257887570439e-9 + (0.18533978397305276318e-10 + (0.41033845938901048380e-13 - 0.46160680279304825485e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 20: {
+ double t = 2*y100 - 41;
+ return 0.15091057940548936603e0 + (0.50086864672004685703e-2 + (0.52622482832192230762e-4 + (0.95034664722040355212e-6 + (0.25614261331144718769e-7 + (0.80183196716888606252e-9 + (0.12282524750534352272e-10 + (-0.10531774117332273617e-11 - 0.86157181395039646412e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 21: {
+ double t = 2*y100 - 43;
+ return 0.16114648116017010770e0 + (0.52314661581655369795e-2 + (0.59005534545908331315e-4 + (0.11885518333915387760e-5 + (0.33975801443239949256e-7 + (0.82111547144080388610e-9 + (-0.12357674017312854138e-10 + (-0.24355112256914479176e-11 - 0.75155506863572930844e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 22: {
+ double t = 2*y100 - 45;
+ return 0.17185551279680451144e0 + (0.54829002967599420860e-2 + (0.67013226658738082118e-4 + (0.14897400671425088807e-5 + (0.40690283917126153701e-7 + (0.44060872913473778318e-9 + (-0.52641873433280000000e-10 - 0.30940587864543343124e-11 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 23: {
+ double t = 2*y100 - 47;
+ return 0.18310194559815257381e0 + (0.57701559375966953174e-2 + (0.76948789401735193483e-4 + (0.18227569842290822512e-5 + (0.41092208344387212276e-7 + (-0.44009499965694442143e-9 + (-0.92195414685628803451e-10 + (-0.22657389705721753299e-11 + 0.10004784908106839254e-12 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 24: {
+ double t = 2*y100 - 49;
+ return 0.19496527191546630345e0 + (0.61010853144364724856e-2 + (0.88812881056342004864e-4 + (0.21180686746360261031e-5 + (0.30652145555130049203e-7 + (-0.16841328574105890409e-8 + (-0.11008129460612823934e-9 + (-0.12180794204544515779e-12 + 0.15703325634590334097e-12 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 25: {
+ double t = 2*y100 - 51;
+ return 0.20754006813966575720e0 + (0.64825787724922073908e-2 + (0.10209599627522311893e-3 + (0.22785233392557600468e-5 + (0.73495224449907568402e-8 + (-0.29442705974150112783e-8 + (-0.94082603434315016546e-10 + (0.23609990400179321267e-11 + 0.14141908654269023788e-12 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 26: {
+ double t = 2*y100 - 53;
+ return 0.22093185554845172146e0 + (0.69182878150187964499e-2 + (0.11568723331156335712e-3 + (0.22060577946323627739e-5 + (-0.26929730679360840096e-7 + (-0.38176506152362058013e-8 + (-0.47399503861054459243e-10 + (0.40953700187172127264e-11 + 0.69157730376118511127e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 27: {
+ double t = 2*y100 - 55;
+ return 0.23524827304057813918e0 + (0.74063350762008734520e-2 + (0.12796333874615790348e-3 + (0.18327267316171054273e-5 + (-0.66742910737957100098e-7 + (-0.40204740975496797870e-8 + (0.14515984139495745330e-10 + (0.44921608954536047975e-11 - 0.18583341338983776219e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 28: {
+ double t = 2*y100 - 57;
+ return 0.25058626331812744775e0 + (0.79377285151602061328e-2 + (0.13704268650417478346e-3 + (0.11427511739544695861e-5 + (-0.10485442447768377485e-6 + (-0.34850364756499369763e-8 + (0.72656453829502179208e-10 + (0.36195460197779299406e-11 - 0.84882136022200714710e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 29: {
+ double t = 2*y100 - 59;
+ return 0.26701724900280689785e0 + (0.84959936119625864274e-2 + (0.14112359443938883232e-3 + (0.17800427288596909634e-6 + (-0.13443492107643109071e-6 + (-0.23512456315677680293e-8 + (0.11245846264695936769e-9 + (0.19850501334649565404e-11 - 0.11284666134635050832e-12 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 30: {
+ double t = 2*y100 - 61;
+ return 0.28457293586253654144e0 + (0.90581563892650431899e-2 + (0.13880520331140646738e-3 + (-0.97262302362522896157e-6 + (-0.15077100040254187366e-6 + (-0.88574317464577116689e-9 + (0.12760311125637474581e-9 + (0.20155151018282695055e-12 - 0.10514169375181734921e-12 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 31: {
+ double t = 2*y100 - 63;
+ return 0.30323425595617385705e0 + (0.95968346790597422934e-2 + (0.12931067776725883939e-3 + (-0.21938741702795543986e-5 + (-0.15202888584907373963e-6 + (0.61788350541116331411e-9 + (0.11957835742791248256e-9 + (-0.12598179834007710908e-11 - 0.75151817129574614194e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 32: {
+ double t = 2*y100 - 65;
+ return 0.32292521181517384379e0 + (0.10082957727001199408e-1 + (0.11257589426154962226e-3 + (-0.33670890319327881129e-5 + (-0.13910529040004008158e-6 + (0.19170714373047512945e-8 + (0.94840222377720494290e-10 + (-0.21650018351795353201e-11 - 0.37875211678024922689e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 33: {
+ double t = 2*y100 - 67;
+ return 0.34351233557911753862e0 + (0.10488575435572745309e-1 + (0.89209444197248726614e-4 + (-0.43893459576483345364e-5 + (-0.11488595830450424419e-6 + (0.28599494117122464806e-8 + (0.61537542799857777779e-10 - 0.24935749227658002212e-11 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 34: {
+ double t = 2*y100 - 69;
+ return 0.36480946642143669093e0 + (0.10789304203431861366e-1 + (0.60357993745283076834e-4 + (-0.51855862174130669389e-5 + (-0.83291664087289801313e-7 + (0.33898011178582671546e-8 + (0.27082948188277716482e-10 + (-0.23603379397408694974e-11 + 0.19328087692252869842e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 35: {
+ double t = 2*y100 - 71;
+ return 0.38658679935694939199e0 + (0.10966119158288804999e-1 + (0.27521612041849561426e-4 + (-0.57132774537670953638e-5 + (-0.48404772799207914899e-7 + (0.35268354132474570493e-8 + (-0.32383477652514618094e-11 + (-0.19334202915190442501e-11 + 0.32333189861286460270e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 36: {
+ double t = 2*y100 - 73;
+ return 0.40858275583808707870e0 + (0.11006378016848466550e-1 + (-0.76396376685213286033e-5 + (-0.59609835484245791439e-5 + (-0.13834610033859313213e-7 + (0.33406952974861448790e-8 + (-0.26474915974296612559e-10 + (-0.13750229270354351983e-11 + 0.36169366979417390637e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 37: {
+ double t = 2*y100 - 75;
+ return 0.43051714914006682977e0 + (0.10904106549500816155e-1 + (-0.43477527256787216909e-4 + (-0.59429739547798343948e-5 + (0.17639200194091885949e-7 + (0.29235991689639918688e-8 + (-0.41718791216277812879e-10 + (-0.81023337739508049606e-12 + 0.33618915934461994428e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 38: {
+ double t = 2*y100 - 77;
+ return 0.45210428135559607406e0 + (0.10659670756384400554e-1 + (-0.78488639913256978087e-4 + (-0.56919860886214735936e-5 + (0.44181850467477733407e-7 + (0.23694306174312688151e-8 + (-0.49492621596685443247e-10 + (-0.31827275712126287222e-12 + 0.27494438742721623654e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 39: {
+ double t = 2*y100 - 79;
+ return 0.47306491195005224077e0 + (0.10279006119745977570e-1 + (-0.11140268171830478306e-3 + (-0.52518035247451432069e-5 + (0.64846898158889479518e-7 + (0.17603624837787337662e-8 + (-0.51129481592926104316e-10 + (0.62674584974141049511e-13 + 0.20055478560829935356e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 40: {
+ double t = 2*y100 - 81;
+ return 0.49313638965719857647e0 + (0.97725799114772017662e-2 + (-0.14122854267291533334e-3 + (-0.46707252568834951907e-5 + (0.79421347979319449524e-7 + (0.11603027184324708643e-8 + (-0.48269605844397175946e-10 + (0.32477251431748571219e-12 + 0.12831052634143527985e-13 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 41: {
+ double t = 2*y100 - 83;
+ return 0.51208057433416004042e0 + (0.91542422354009224951e-2 + (-0.16726530230228647275e-3 + (-0.39964621752527649409e-5 + (0.88232252903213171454e-7 + (0.61343113364949928501e-9 + (-0.42516755603130443051e-10 + (0.47910437172240209262e-12 + 0.66784341874437478953e-14 * t) * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 42: {
+ double t = 2*y100 - 85;
+ return 0.52968945458607484524e0 + (0.84400880445116786088e-2 + (-0.18908729783854258774e-3 + (-0.32725905467782951931e-5 + (0.91956190588652090659e-7 + (0.14593989152420122909e-9 + (-0.35239490687644444445e-10 + 0.54613829888448694898e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 43: {
+ double t = 2*y100 - 87;
+ return 0.54578857454330070965e0 + (0.76474155195880295311e-2 + (-0.20651230590808213884e-3 + (-0.25364339140543131706e-5 + (0.91455367999510681979e-7 + (-0.23061359005297528898e-9 + (-0.27512928625244444444e-10 + 0.54895806008493285579e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 44: {
+ double t = 2*y100 - 89;
+ return 0.56023851910298493910e0 + (0.67938321739997196804e-2 + (-0.21956066613331411760e-3 + (-0.18181127670443266395e-5 + (0.87650335075416845987e-7 + (-0.51548062050366615977e-9 + (-0.20068462174044444444e-10 + 0.50912654909758187264e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 45: {
+ double t = 2*y100 - 91;
+ return 0.57293478057455721150e0 + (0.58965321010394044087e-2 + (-0.22841145229276575597e-3 + (-0.11404605562013443659e-5 + (0.81430290992322326296e-7 + (-0.71512447242755357629e-9 + (-0.13372664928000000000e-10 + 0.44461498336689298148e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 46: {
+ double t = 2*y100 - 93;
+ return 0.58380635448407827360e0 + (0.49717469530842831182e-2 + (-0.23336001540009645365e-3 + (-0.51952064448608850822e-6 + (0.73596577815411080511e-7 + (-0.84020916763091566035e-9 + (-0.76700972702222222221e-11 + 0.36914462807972467044e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 47: {
+ double t = 2*y100 - 95;
+ return 0.59281340237769489597e0 + (0.40343592069379730568e-2 + (-0.23477963738658326185e-3 + (0.34615944987790224234e-7 + (0.64832803248395814574e-7 + (-0.90329163587627007971e-9 + (-0.30421940400000000000e-11 + 0.29237386653743536669e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 48: {
+ double t = 2*y100 - 97;
+ return 0.59994428743114271918e0 + (0.30976579788271744329e-2 + (-0.23308875765700082835e-3 + (0.51681681023846925160e-6 + (0.55694594264948268169e-7 + (-0.91719117313243464652e-9 + (0.53982743680000000000e-12 + 0.22050829296187771142e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 49: {
+ double t = 2*y100 - 99;
+ return 0.60521224471819875444e0 + (0.21732138012345456060e-2 + (-0.22872428969625997456e-3 + (0.92588959922653404233e-6 + (0.46612665806531930684e-7 + (-0.89393722514414153351e-9 + (0.31718550353777777778e-11 + 0.15705458816080549117e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 50: {
+ double t = 2*y100 - 101;
+ return 0.60865189969791123620e0 + (0.12708480848877451719e-2 + (-0.22212090111534847166e-3 + (0.12636236031532793467e-5 + (0.37904037100232937574e-7 + (-0.84417089968101223519e-9 + (0.49843180828444444445e-11 + 0.10355439441049048273e-12 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 51: {
+ double t = 2*y100 - 103;
+ return 0.61031580103499200191e0 + (0.39867436055861038223e-3 + (-0.21369573439579869291e-3 + (0.15339402129026183670e-5 + (0.29787479206646594442e-7 + (-0.77687792914228632974e-9 + (0.61192452741333333334e-11 + 0.60216691829459295780e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 52: {
+ double t = 2*y100 - 105;
+ return 0.61027109047879835868e0 + (-0.43680904508059878254e-3 + (-0.20383783788303894442e-3 + (0.17421743090883439959e-5 + (0.22400425572175715576e-7 + (-0.69934719320045128997e-9 + (0.67152759655111111110e-11 + 0.26419960042578359995e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 53: {
+ double t = 2*y100 - 107;
+ return 0.60859639489217430521e0 + (-0.12305921390962936873e-2 + (-0.19290150253894682629e-3 + (0.18944904654478310128e-5 + (0.15815530398618149110e-7 + (-0.61726850580964876070e-9 + 0.68987888999111111110e-11 * t) * t) * t) * t) * t) * t;
+ }
+ case 54: {
+ double t = 2*y100 - 109;
+ return 0.60537899426486075181e0 + (-0.19790062241395705751e-2 + (-0.18120271393047062253e-3 + (0.19974264162313241405e-5 + (0.10055795094298172492e-7 + (-0.53491997919318263593e-9 + (0.67794550295111111110e-11 - 0.17059208095741511603e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 55: {
+ double t = 2*y100 - 111;
+ return 0.60071229457904110537e0 + (-0.26795676776166354354e-2 + (-0.16901799553627508781e-3 + (0.20575498324332621581e-5 + (0.51077165074461745053e-8 + (-0.45536079828057221858e-9 + (0.64488005516444444445e-11 - 0.29311677573152766338e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 56: {
+ double t = 2*y100 - 113;
+ return 0.59469361520112714738e0 + (-0.33308208190600993470e-2 + (-0.15658501295912405679e-3 + (0.20812116912895417272e-5 + (0.93227468760614182021e-9 + (-0.38066673740116080415e-9 + (0.59806790359111111110e-11 - 0.36887077278950440597e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 57: {
+ double t = 2*y100 - 115;
+ return 0.58742228631775388268e0 + (-0.39321858196059227251e-2 + (-0.14410441141450122535e-3 + (0.20743790018404020716e-5 + (-0.25261903811221913762e-8 + (-0.31212416519526924318e-9 + (0.54328422462222222221e-11 - 0.40864152484979815972e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 58: {
+ double t = 2*y100 - 117;
+ return 0.57899804200033018447e0 + (-0.44838157005618913447e-2 + (-0.13174245966501437965e-3 + (0.20425306888294362674e-5 + (-0.53330296023875447782e-8 + (-0.25041289435539821014e-9 + (0.48490437205333333334e-11 - 0.42162206939169045177e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 59: {
+ double t = 2*y100 - 119;
+ return 0.56951968796931245974e0 + (-0.49864649488074868952e-2 + (-0.11963416583477567125e-3 + (0.19906021780991036425e-5 + (-0.75580140299436494248e-8 + (-0.19576060961919820491e-9 + (0.42613011928888888890e-11 - 0.41539443304115604377e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 60: {
+ double t = 2*y100 - 121;
+ return 0.55908401930063918964e0 + (-0.54413711036826877753e-2 + (-0.10788661102511914628e-3 + (0.19229663322982839331e-5 + (-0.92714731195118129616e-8 + (-0.14807038677197394186e-9 + (0.36920870298666666666e-11 - 0.39603726688419162617e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 61: {
+ double t = 2*y100 - 123;
+ return 0.54778496152925675315e0 + (-0.58501497933213396670e-2 + (-0.96582314317855227421e-4 + (0.18434405235069270228e-5 + (-0.10541580254317078711e-7 + (-0.10702303407788943498e-9 + (0.31563175582222222222e-11 - 0.36829748079110481422e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 62: {
+ double t = 2*y100 - 125;
+ return 0.53571290831682823999e0 + (-0.62147030670760791791e-2 + (-0.85782497917111760790e-4 + (0.17553116363443470478e-5 + (-0.11432547349815541084e-7 + (-0.72157091369041330520e-10 + (0.26630811607111111111e-11 - 0.33578660425893164084e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 63: {
+ double t = 2*y100 - 127;
+ return 0.52295422962048434978e0 + (-0.65371404367776320720e-2 + (-0.75530164941473343780e-4 + (0.16613725797181276790e-5 + (-0.12003521296598910761e-7 + (-0.42929753689181106171e-10 + (0.22170894940444444444e-11 - 0.30117697501065110505e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 64: {
+ double t = 2*y100 - 129;
+ return 0.50959092577577886140e0 + (-0.68197117603118591766e-2 + (-0.65852936198953623307e-4 + (0.15639654113906716939e-5 + (-0.12308007991056524902e-7 + (-0.18761997536910939570e-10 + (0.18198628922666666667e-11 - 0.26638355362285200932e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 65: {
+ double t = 2*y100 - 131;
+ return 0.49570040481823167970e0 + (-0.70647509397614398066e-2 + (-0.56765617728962588218e-4 + (0.14650274449141448497e-5 + (-0.12393681471984051132e-7 + (0.92904351801168955424e-12 + (0.14706755960177777778e-11 - 0.23272455351266325318e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 66: {
+ double t = 2*y100 - 133;
+ return 0.48135536250935238066e0 + (-0.72746293327402359783e-2 + (-0.48272489495730030780e-4 + (0.13661377309113939689e-5 + (-0.12302464447599382189e-7 + (0.16707760028737074907e-10 + (0.11672928324444444444e-11 - 0.20105801424709924499e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 67: {
+ double t = 2*y100 - 135;
+ return 0.46662374675511439448e0 + (-0.74517177649528487002e-2 + (-0.40369318744279128718e-4 + (0.12685621118898535407e-5 + (-0.12070791463315156250e-7 + (0.29105507892605823871e-10 + (0.90653314645333333334e-12 - 0.17189503312102982646e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 68: {
+ double t = 2*y100 - 137;
+ return 0.45156879030168268778e0 + (-0.75983560650033817497e-2 + (-0.33045110380705139759e-4 + (0.11732956732035040896e-5 + (-0.11729986947158201869e-7 + (0.38611905704166441308e-10 + (0.68468768305777777779e-12 - 0.14549134330396754575e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 69: {
+ double t = 2*y100 - 139;
+ return 0.43624909769330896904e0 + (-0.77168291040309554679e-2 + (-0.26283612321339907756e-4 + (0.10811018836893550820e-5 + (-0.11306707563739851552e-7 + (0.45670446788529607380e-10 + (0.49782492549333333334e-12 - 0.12191983967561779442e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 70: {
+ double t = 2*y100 - 141;
+ return 0.42071877443548481181e0 + (-0.78093484015052730097e-2 + (-0.20064596897224934705e-4 + (0.99254806680671890766e-6 + (-0.10823412088884741451e-7 + (0.50677203326904716247e-10 + (0.34200547594666666666e-12 - 0.10112698698356194618e-13 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 71: {
+ double t = 2*y100 - 143;
+ return 0.40502758809710844280e0 + (-0.78780384460872937555e-2 + (-0.14364940764532853112e-4 + (0.90803709228265217384e-6 + (-0.10298832847014466907e-7 + (0.53981671221969478551e-10 + (0.21342751381333333333e-12 - 0.82975901848387729274e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 72: {
+ double t = 2*y100 - 145;
+ return 0.38922115269731446690e0 + (-0.79249269708242064120e-2 + (-0.91595258799106970453e-5 + (0.82783535102217576495e-6 + (-0.97484311059617744437e-8 + (0.55889029041660225629e-10 + (0.10851981336888888889e-12 - 0.67278553237853459757e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 73: {
+ double t = 2*y100 - 147;
+ return 0.37334112915460307335e0 + (-0.79519385109223148791e-2 + (-0.44219833548840469752e-5 + (0.75209719038240314732e-6 + (-0.91848251458553190451e-8 + (0.56663266668051433844e-10 + (0.23995894257777777778e-13 - 0.53819475285389344313e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 74: {
+ double t = 2*y100 - 149;
+ return 0.35742543583374223085e0 + (-0.79608906571527956177e-2 + (-0.12530071050975781198e-6 + (0.68088605744900552505e-6 + (-0.86181844090844164075e-8 + (0.56530784203816176153e-10 + (-0.43120012248888888890e-13 - 0.42372603392496813810e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 75: {
+ double t = 2*y100 - 151;
+ return 0.34150846431979618536e0 + (-0.79534924968773806029e-2 + (0.37576885610891515813e-5 + (0.61419263633090524326e-6 + (-0.80565865409945960125e-8 + (0.55684175248749269411e-10 + (-0.95486860764444444445e-13 - 0.32712946432984510595e-14 * t) * t) * t) * t) * t) * t) * t;
+ }
+ case 76: {
+ double t = 2*y100 - 153;
+ return 0.32562129649136346824e0 + (-0.79313448067948884309e-2 + (0.72539159933545300034e-5 + (0.55195028297415503083e-6 + (-0.75063365335570475258e-8 + (0.54281686749699595941e-10 - 0.13545424295111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 77: {
+ double t = 2*y100 - 155;
+ return 0.30979191977078391864e0 + (-0.78959416264207333695e-2 + (0.10389774377677210794e-4 + (0.49404804463196316464e-6 + (-0.69722488229411164685e-8 + (0.52469254655951393842e-10 - 0.16507860650666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 78: {
+ double t = 2*y100 - 157;
+ return 0.29404543811214459904e0 + (-0.78486728990364155356e-2 + (0.13190885683106990459e-4 + (0.44034158861387909694e-6 + (-0.64578942561562616481e-8 + (0.50354306498006928984e-10 - 0.18614473550222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 79: {
+ double t = 2*y100 - 159;
+ return 0.27840427686253660515e0 + (-0.77908279176252742013e-2 + (0.15681928798708548349e-4 + (0.39066226205099807573e-6 + (-0.59658144820660420814e-8 + (0.48030086420373141763e-10 - 0.20018995173333333333e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 80: {
+ double t = 2*y100 - 161;
+ return 0.26288838011163800908e0 + (-0.77235993576119469018e-2 + (0.17886516796198660969e-4 + (0.34482457073472497720e-6 + (-0.54977066551955420066e-8 + (0.45572749379147269213e-10 - 0.20852924954666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 81: {
+ double t = 2*y100 - 163;
+ return 0.24751539954181029717e0 + (-0.76480877165290370975e-2 + (0.19827114835033977049e-4 + (0.30263228619976332110e-6 + (-0.50545814570120129947e-8 + (0.43043879374212005966e-10 - 0.21228012028444444444e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 82: {
+ double t = 2*y100 - 165;
+ return 0.23230087411688914593e0 + (-0.75653060136384041587e-2 + (0.21524991113020016415e-4 + (0.26388338542539382413e-6 + (-0.46368974069671446622e-8 + (0.40492715758206515307e-10 - 0.21238627815111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 83: {
+ double t = 2*y100 - 167;
+ return 0.21725840021297341931e0 + (-0.74761846305979730439e-2 + (0.23000194404129495243e-4 + (0.22837400135642906796e-6 + (-0.42446743058417541277e-8 + (0.37958104071765923728e-10 - 0.20963978568888888889e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 84: {
+ double t = 2*y100 - 169;
+ return 0.20239979200788191491e0 + (-0.73815761980493466516e-2 + (0.24271552727631854013e-4 + (0.19590154043390012843e-6 + (-0.38775884642456551753e-8 + (0.35470192372162901168e-10 - 0.20470131678222222222e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 85: {
+ double t = 2*y100 - 171;
+ return 0.18773523211558098962e0 + (-0.72822604530339834448e-2 + (0.25356688567841293697e-4 + (0.16626710297744290016e-6 + (-0.35350521468015310830e-8 + (0.33051896213898864306e-10 - 0.19811844544000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 86: {
+ double t = 2*y100 - 173;
+ return 0.17327341258479649442e0 + (-0.71789490089142761950e-2 + (0.26272046822383820476e-4 + (0.13927732375657362345e-6 + (-0.32162794266956859603e-8 + (0.30720156036105652035e-10 - 0.19034196304000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 87: {
+ double t = 2*y100 - 175;
+ return 0.15902166648328672043e0 + (-0.70722899934245504034e-2 + (0.27032932310132226025e-4 + (0.11474573347816568279e-6 + (-0.29203404091754665063e-8 + (0.28487010262547971859e-10 - 0.18174029063111111111e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 88: {
+ double t = 2*y100 - 177;
+ return 0.14498609036610283865e0 + (-0.69628725220045029273e-2 + (0.27653554229160596221e-4 + (0.92493727167393036470e-7 + (-0.26462055548683583849e-8 + (0.26360506250989943739e-10 - 0.17261211260444444444e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 89: {
+ double t = 2*y100 - 179;
+ return 0.13117165798208050667e0 + (-0.68512309830281084723e-2 + (0.28147075431133863774e-4 + (0.72351212437979583441e-7 + (-0.23927816200314358570e-8 + (0.24345469651209833155e-10 - 0.16319736960000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 90: {
+ double t = 2*y100 - 181;
+ return 0.11758232561160626306e0 + (-0.67378491192463392927e-2 + (0.28525664781722907847e-4 + (0.54156999310046790024e-7 + (-0.21589405340123827823e-8 + (0.22444150951727334619e-10 - 0.15368675584000000000e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 91: {
+ double t = 2*y100 - 183;
+ return 0.10422112945361673560e0 + (-0.66231638959845581564e-2 + (0.28800551216363918088e-4 + (0.37758983397952149613e-7 + (-0.19435423557038933431e-8 + (0.20656766125421362458e-10 - 0.14422990012444444444e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 92: {
+ double t = 2*y100 - 185;
+ return 0.91090275493541084785e-1 + (-0.65075691516115160062e-2 + (0.28982078385527224867e-4 + (0.23014165807643012781e-7 + (-0.17454532910249875958e-8 + (0.18981946442680092373e-10 - 0.13494234691555555556e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 93: {
+ double t = 2*y100 - 187;
+ return 0.78191222288771379358e-1 + (-0.63914190297303976434e-2 + (0.29079759021299682675e-4 + (0.97885458059415717014e-8 + (-0.15635596116134296819e-8 + (0.17417110744051331974e-10 - 0.12591151763555555556e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 94: {
+ double t = 2*y100 - 189;
+ return 0.65524757106147402224e-1 + (-0.62750311956082444159e-2 + (0.29102328354323449795e-4 + (-0.20430838882727954582e-8 + (-0.13967781903855367270e-8 + (0.15958771833747057569e-10 - 0.11720175765333333333e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 95: {
+ double t = 2*y100 - 191;
+ return 0.53091065838453612773e-1 + (-0.61586898417077043662e-2 + (0.29057796072960100710e-4 + (-0.12597414620517987536e-7 + (-0.12440642607426861943e-8 + (0.14602787128447932137e-10 - 0.10885859114666666667e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 96: {
+ double t = 2*y100 - 193;
+ return 0.40889797115352738582e-1 + (-0.60426484889413678200e-2 + (0.28953496450191694606e-4 + (-0.21982952021823718400e-7 + (-0.11044169117553026211e-8 + (0.13344562332430552171e-10 - 0.10091231402844444444e-12 * t) * t) * t) * t) * t) * t;
+ }
+ case 97: case 98:
+ case 99: case 100: { // use Taylor expansion for small x (|x| <= 0.0309...)
+ // (2/sqrt(pi)) * (x - 2/3 x^3 + 4/15 x^5 - 8/105 x^7 + 16/945 x^9)
+ double x2 = x*x;
+ return x * (1.1283791670955125739
+ - x2 * (0.75225277806367504925
+ - x2 * (0.30090111122547001970
+ - x2 * (0.085971746064420005629
+ - x2 * 0.016931216931216931217))));
+ }
+ }
+ /* Since 0 <= y100 < 101, this is only reached if x is NaN,
+ in which case we should return NaN. */
+ return NaN;
+} // w_im_y100
+
+/******************************************************************************/
+/* Library function im_w_of_z */
+/******************************************************************************/
+
+double im_w_of_x(double x)
+{
+
+ // Steven G. Johnson, October 2012.
+
+ // Uses methods similar to the erfcx calculation:
+ // continued fractions for large |x|,
+ // a lookup table of Chebyshev polynomials for smaller |x|,
+ // and finally a Taylor expansion for |x|<0.01.
+
+ const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
+
+ if (x >= 0) {
+ if (x > 45) {
+ // continued-fraction expansion is faster
+ if (x > 5e7) {
+ // 1-term expansion, important to avoid overflow
+ return ispi / x;
+ } else {
+ // 5-term expansion (rely on compiler for CSE), simplified from: ispi / (x-0.5/(x-1/(x-1.5/(x-2/x))))
+ return ispi*((x*x) * (x*x-4.5) + 2) / (x * ((x*x) * (x*x-5) + 3.75));
+ }
+ } else {
+ return w_im_y100(100/(1+x), x);
+ }
+ } else {
+ // = -im_w_of_x(-x)
+ if (x < -45) {
+ // continued-fraction expansion is faster
+ if (x < -5e7) {
+ // 1-term expansion, important to avoid overflow
+ return ispi / x;
+ } else {
+ // 5-term expansion (rely on compiler for CSE), simplified from: ispi / (x-0.5/(x-1/(x-1.5/(x-2/x))))
+ return ispi*((x*x) * (x*x-4.5) + 2) / (x * ((x*x) * (x*x-5) + 3.75));
+ }
+ } else {
+ return -w_im_y100(100/(1-x), -x);
+ }
+ }
+}
+
+// im_w_of_z
diff --git a/source/luametatex/source/libraries/libcerf/readme-luametatex.txt b/source/luametatex/source/libraries/libcerf/readme-luametatex.txt
new file mode 100644
index 000000000..bb552f263
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/readme-luametatex.txt
@@ -0,0 +1,26 @@
+LS,
+
+In the following files you can find the comment below. We don't want to bother or burden the
+original authors with our problems. The cerf code is mostly used in MetaFun macros (by Alan
+Braslau). The c.h and cpp.h files are gone.
+
+ defs.h
+ cerf.h
+
+---------------------------------------------------------------------------------------------
+This file is patched by Mojca Miklavec and Hans Hagen for usage in LuaMetaTeX where we use
+only C and also want to compile with the Microsoft compiler. So, when updating this library
+one has to check for changes. Not that we expect many as this is a rather stable library.
+
+In the other files there are a few macros used that deal with the multiplication and addition
+of complex and real nmbers. Of course the original code is kept as-is.
+---------------------------------------------------------------------------------------------
+
+So, when updating the library you need to diff for the changes that are needed in order to
+compile the files with the Microsoft compiler.
+
+At some point I might patch the files so that we can intercept error messages in a way that
+permits recovery and also plugs them into our normal message handlers. Maybe I should also
+merge the code into just one file because it doesn't change.
+
+Hans
diff --git a/source/luametatex/source/libraries/libcerf/w_of_z.c b/source/luametatex/source/libraries/libcerf/w_of_z.c
new file mode 100644
index 000000000..33778979c
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/w_of_z.c
@@ -0,0 +1,393 @@
+/* Library libcerf:
+ * Compute complex error functions, based on a new implementation of
+ * Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
+ *
+ * File w_of_z.c:
+ * Computation of Faddeeva's complex scaled error function,
+ * w(z) = exp(-z^2) * erfc(-i*z),
+ * nameless function (7.1.3) of Abramowitz&Stegun (1964),
+ * also known as the plasma dispersion function.
+ *
+ * This implementation uses a combination of different algorithms.
+ * See man 3 w_of_z for references.
+ *
+ * Copyright:
+ * (C) 2012 Massachusetts Institute of Technology
+ * (C) 2013 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * 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.
+ *
+ * Authors:
+ * Steven G. Johnson, Massachusetts Institute of Technology, 2012, core author
+ * Joachim Wuttke, Forschungszentrum Jülich, 2013, package maintainer
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ *
+ * Revision history:
+ * ../CHANGELOG
+ *
+ * Man page:
+ * w_of_z(3)
+ */
+
+/*
+
+ Todo: use local declarations (older compilers) (HH).
+
+*/
+
+/*
+ Computes various error functions (erf, erfc, erfi, erfcx),
+ including the Dawson integral, in the complex plane, based
+ on algorithms for the computation of the Faddeeva function
+ w(z) = exp(-z^2) * erfc(-i*z).
+ Given w(z), the error functions are mostly straightforward
+ to compute, except for certain regions where we have to
+ switch to Taylor expansions to avoid cancellation errors
+ [e.g. near the origin for erf(z)].
+
+*/
+
+#include "cerf.h"
+#include <float.h>
+#include <math.h>
+#include "defs.h" // defines _cerf_cmplx, NaN, C, cexp, ...
+
+// for analysing the algorithm:
+EXPORT int faddeeva_algorithm;
+EXPORT int faddeeva_nofterms;
+
+/******************************************************************************/
+/* auxiliary functions */
+/******************************************************************************/
+
+static inline double sinc(double x, double sinx)
+{
+ // return sinc(x) = sin(x)/x, given both x and sin(x)
+ // [since we only use this in cases where sin(x) has already been computed]
+ return fabs(x) < 1e-4 ? 1 - (0.1666666666666666666667)*x*x : sinx / x;
+}
+
+static inline double sinh_taylor(double x)
+{
+ // sinh(x) via Taylor series, accurate to machine precision for |x| < 1e-2
+ return x * (1 + (x*x) * (0.1666666666666666666667 + 0.00833333333333333333333 * (x*x)));
+}
+
+static inline double sqr(double x) { return x*x; }
+
+/******************************************************************************/
+/* precomputed table of expa2n2[n-1] = exp(-a2*n*n) */
+/* for double-precision a2 = 0.26865... in w_of_z, below. */
+/******************************************************************************/
+
+static const double expa2n2[] = {
+ 7.64405281671221563e-01,
+ 3.41424527166548425e-01,
+ 8.91072646929412548e-02,
+ 1.35887299055460086e-02,
+ 1.21085455253437481e-03,
+ 6.30452613933449404e-05,
+ 1.91805156577114683e-06,
+ 3.40969447714832381e-08,
+ 3.54175089099469393e-10,
+ 2.14965079583260682e-12,
+ 7.62368911833724354e-15,
+ 1.57982797110681093e-17,
+ 1.91294189103582677e-20,
+ 1.35344656764205340e-23,
+ 5.59535712428588720e-27,
+ 1.35164257972401769e-30,
+ 1.90784582843501167e-34,
+ 1.57351920291442930e-38,
+ 7.58312432328032845e-43,
+ 2.13536275438697082e-47,
+ 3.51352063787195769e-52,
+ 3.37800830266396920e-57,
+ 1.89769439468301000e-62,
+ 6.22929926072668851e-68,
+ 1.19481172006938722e-73,
+ 1.33908181133005953e-79,
+ 8.76924303483223939e-86,
+ 3.35555576166254986e-92,
+ 7.50264110688173024e-99,
+ 9.80192200745410268e-106,
+ 7.48265412822268959e-113,
+ 3.33770122566809425e-120,
+ 8.69934598159861140e-128,
+ 1.32486951484088852e-135,
+ 1.17898144201315253e-143,
+ 6.13039120236180012e-152,
+ 1.86258785950822098e-160,
+ 3.30668408201432783e-169,
+ 3.43017280887946235e-178,
+ 2.07915397775808219e-187,
+ 7.36384545323984966e-197,
+ 1.52394760394085741e-206,
+ 1.84281935046532100e-216,
+ 1.30209553802992923e-226,
+ 5.37588903521080531e-237,
+ 1.29689584599763145e-247,
+ 1.82813078022866562e-258,
+ 1.50576355348684241e-269,
+ 7.24692320799294194e-281,
+ 2.03797051314726829e-292,
+ 3.34880215927873807e-304,
+ 0.0 // underflow (also prevents reads past array end, below)
+}; // expa2n2
+
+/******************************************************************************/
+/* w_of_z, Faddeeva's scaled complex error function */
+/******************************************************************************/
+
+_cerf_cmplx w_of_z(_cerf_cmplx z)
+{
+ faddeeva_nofterms = 0;
+
+ // Steven G. Johnson, October 2012.
+
+ if (creal(z) == 0.0) {
+ // Purely imaginary input, purely real output.
+ // However, use creal(z) to give correct sign of 0 in cimag(w).
+ return C(erfcx(cimag(z)), creal(z));
+ }
+ if (cimag(z) == 0) {
+ // Purely real input, complex output.
+ return C(exp(-sqr(creal(z))), im_w_of_x(creal(z)));
+ }
+
+ const double relerr = DBL_EPSILON;
+ const double a = 0.518321480430085929872; // pi / sqrt(-log(eps*0.5))
+ const double c = 0.329973702884629072537; // (2/pi) * a;
+ const double a2 = 0.268657157075235951582; // a^2
+
+ const double x = fabs(creal(z));
+ const double y = cimag(z);
+ const double ya = fabs(y);
+
+ _cerf_cmplx ret = C(0., 0.); // return value
+
+ double sum1 = 0, sum2 = 0, sum3 = 0, sum4 = 0, sum5 = 0;
+
+ if (ya > 7 || (x > 6 // continued fraction is faster
+ /* As pointed out by M. Zaghloul, the continued
+ fraction seems to give a large relative error in
+ Re w(z) for |x| ~ 6 and small |y|, so use
+ algorithm 816 in this region: */
+ && (ya > 0.1 || (x > 8 && ya > 1e-10) || x > 28))) {
+
+ faddeeva_algorithm = 100;
+
+ /* Poppe & Wijers suggest using a number of terms
+ nu = 3 + 1442 / (26*rho + 77)
+ where rho = sqrt((x/x0)^2 + (y/y0)^2) where x0=6.3, y0=4.4.
+ (They only use this expansion for rho >= 1, but rho a little less
+ than 1 seems okay too.)
+ Instead, I did my own fit to a slightly different function
+ that avoids the hypotenuse calculation, using NLopt to minimize
+ the sum of the squares of the errors in nu with the constraint
+ that the estimated nu be >= minimum nu to attain machine precision.
+ I also separate the regions where nu == 2 and nu == 1. */
+ const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
+ double xs = y < 0 ? -creal(z) : creal(z); // compute for -z if y < 0
+ if (x + ya > 4000) { // nu <= 2
+ if (x + ya > 1e7) { // nu == 1, w(z) = i/sqrt(pi) / z
+ // scale to avoid overflow
+ if (x > ya) {
+ faddeeva_algorithm += 1;
+ double yax = ya / xs;
+ faddeeva_algorithm = 100;
+ double denom = ispi / (xs + yax*ya);
+ ret = C(denom*yax, denom);
+ }
+ else if (isinf(ya)) {
+ faddeeva_algorithm += 2;
+ return ((isnan(x) || y < 0)
+ ? C(NaN,NaN) : C(0,0));
+ }
+ else {
+ faddeeva_algorithm += 3;
+ double xya = xs / ya;
+ double denom = ispi / (xya*xs + ya);
+ ret = C(denom, denom*xya);
+ }
+ }
+ else { // nu == 2, w(z) = i/sqrt(pi) * z / (z*z - 0.5)
+ faddeeva_algorithm += 4;
+ double dr = xs*xs - ya*ya - 0.5, di = 2*xs*ya;
+ double denom = ispi / (dr*dr + di*di);
+ ret = C(denom * (xs*di-ya*dr), denom * (xs*dr+ya*di));
+ }
+ }
+ else { // compute nu(z) estimate and do general continued fraction
+ faddeeva_algorithm += 5;
+ const double c0=3.9, c1=11.398, c2=0.08254, c3=0.1421, c4=0.2023; // fit
+ double nu = floor(c0 + c1 / (c2*x + c3*ya + c4));
+ double wr = xs, wi = ya;
+ for (nu = 0.5 * (nu - 1); nu > 0.4; nu -= 0.5) {
+ // w <- z - nu/w:
+ double denom = nu / (wr*wr + wi*wi);
+ wr = xs - wr * denom;
+ wi = ya + wi * denom;
+ }
+ { // w(z) = i/sqrt(pi) / w:
+ double denom = ispi / (wr*wr + wi*wi);
+ ret = C(denom*wi, denom*wr);
+ }
+ }
+ if (y < 0) {
+ faddeeva_algorithm += 10;
+ // use w(z) = 2.0*exp(-z*z) - w(-z),
+ // but be careful of overflow in exp(-z*z)
+ // = exp(-(xs*xs-ya*ya) -2*i*xs*ya)
+ return complex_sub_cc(complex_mul_rc(2.0,cexp(C((ya-xs)*(xs+ya), 2*xs*y))), ret);
+ }
+ else
+ return ret;
+ }
+
+ /* Note: The test that seems to be suggested in the paper is x <
+ sqrt(-log(DBL_MIN)), about 26.6, since otherwise exp(-x^2)
+ underflows to zero and sum1,sum2,sum4 are zero. However, long
+ before this occurs, the sum1,sum2,sum4 contributions are
+ negligible in double precision; I find that this happens for x >
+ about 6, for all y. On the other hand, I find that the case
+ where we compute all of the sums is faster (at least with the
+ precomputed expa2n2 table) until about x=10. Furthermore, if we
+ try to compute all of the sums for x > 20, I find that we
+ sometimes run into numerical problems because underflow/overflow
+ problems start to appear in the various coefficients of the sums,
+ below. Therefore, we use x < 10 here. */
+ else if (x < 10) {
+
+ faddeeva_algorithm = 200;
+
+ double prod2ax = 1, prodm2ax = 1;
+ double expx2;
+
+ if (isnan(y)) {
+ faddeeva_algorithm += 99;
+ return C(y,y);
+ }
+
+ if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4
+ // This special case is needed for accuracy.
+ faddeeva_algorithm += 1;
+ const double x2 = x*x;
+ expx2 = 1 - x2 * (1 - 0.5*x2); // exp(-x*x) via Taylor
+ // compute exp(2*a*x) and exp(-2*a*x) via Taylor, to double precision
+ const double ax2 = 1.036642960860171859744*x; // 2*a*x
+ const double exp2ax =
+ 1 + ax2 * (1 + ax2 * (0.5 + 0.166666666666666666667*ax2));
+ const double expm2ax =
+ 1 - ax2 * (1 - ax2 * (0.5 - 0.166666666666666666667*ax2));
+ for (int n = 1; ; ++n) {
+ ++faddeeva_nofterms;
+ const double coef = expa2n2[n-1] * expx2 / (a2*(n*n) + y*y);
+ prod2ax *= exp2ax;
+ prodm2ax *= expm2ax;
+ sum1 += coef;
+ sum2 += coef * prodm2ax;
+ sum3 += coef * prod2ax;
+
+ // really = sum5 - sum4
+ sum5 += coef * (2*a) * n * sinh_taylor((2*a)*n*x);
+
+ // test convergence via sum3
+ if (coef * prod2ax < relerr * sum3) break;
+ }
+ }
+ else { // x > 5e-4, compute sum4 and sum5 separately
+ faddeeva_algorithm += 2;
+ expx2 = exp(-x*x);
+ const double exp2ax = exp((2*a)*x), expm2ax = 1 / exp2ax;
+ for (int n = 1; ; ++n) {
+ ++faddeeva_nofterms;
+ const double coef = expa2n2[n-1] * expx2 / (a2*(n*n) + y*y);
+ prod2ax *= exp2ax;
+ prodm2ax *= expm2ax;
+ sum1 += coef;
+ sum2 += coef * prodm2ax;
+ sum4 += (coef * prodm2ax) * (a*n);
+ sum3 += coef * prod2ax;
+ sum5 += (coef * prod2ax) * (a*n);
+ // test convergence via sum5, since this sum has the slowest decay
+ if ((coef * prod2ax) * (a*n) < relerr * sum5) break;
+ }
+ }
+ const double expx2erfcxy = // avoid spurious overflow for large negative y
+ y > -6 // for y < -6, erfcx(y) = 2*exp(y*y) to double precision
+ ? expx2*erfcx(y) : 2*exp(y*y-x*x);
+ if (y > 5) { // imaginary terms cancel
+ faddeeva_algorithm += 10;
+ const double sinxy = sin(x*y);
+ ret = C((expx2erfcxy - c*y*sum1) * cos(2*x*y) + (c*x*expx2) * sinxy * sinc(x*y, sinxy), 0.0);
+ }
+ else {
+ faddeeva_algorithm += 20;
+ double xs = creal(z);
+ const double sinxy = sin(xs*y);
+ const double sin2xy = sin(2*xs*y), cos2xy = cos(2*xs*y);
+ const double coef1 = expx2erfcxy - c*y*sum1;
+ const double coef2 = c*xs*expx2;
+ ret = C(coef1 * cos2xy + coef2 * sinxy * sinc(xs*y, sinxy),
+ coef2 * sinc(2*xs*y, sin2xy) - coef1 * sin2xy);
+ }
+ }
+ else { // x large: only sum3 & sum5 contribute (see above note)
+
+ faddeeva_algorithm = 300;
+
+ if (isnan(x))
+ return C(x,x);
+ if (isnan(y))
+ return C(y,y);
+
+ ret = C(exp(-x*x),0.0); // |y| < 1e-10, so we only need exp(-x*x) term
+ // (round instead of ceil as in original paper; note that x/a > 1 here)
+ double n0 = floor(x/a + 0.5); // sum in both directions, starting at n0
+ double dx = a*n0 - x;
+ sum3 = exp(-dx*dx) / (a2*(n0*n0) + y*y);
+ sum5 = a*n0 * sum3;
+ double exp1 = exp(4*a*dx), exp1dn = 1;
+ int dn;
+ for (dn = 1; n0 - dn > 0; ++dn) { // loop over n0-dn and n0+dn terms
+ double np = n0 + dn, nm = n0 - dn;
+ double tp = exp(-sqr(a*dn+dx));
+ double tm = tp * (exp1dn *= exp1); // trick to get tm from tp
+ tp /= (a2*(np*np) + y*y);
+ tm /= (a2*(nm*nm) + y*y);
+ sum3 += tp + tm;
+ sum5 += a * (np * tp + nm * tm);
+ if (a * (np * tp + nm * tm) < relerr * sum5) goto finish;
+ }
+ while (1) { // loop over n0+dn terms only (since n0-dn <= 0)
+ double np = n0 + dn++;
+ double tp = exp(-sqr(a*dn+dx)) / (a2*(np*np) + y*y);
+ sum3 += tp;
+ sum5 += a * np * tp;
+ if (a * np * tp < relerr * sum5) goto finish;
+ }
+ }
+finish:
+ return complex_add_cc(ret, C((0.5*c)*y*(sum2+sum3),(0.5*c)*copysign(sum5-sum4, creal(z))));
+} // w_of_z
diff --git a/source/luametatex/source/libraries/libcerf/width.c b/source/luametatex/source/libraries/libcerf/width.c
new file mode 100644
index 000000000..a844377ff
--- /dev/null
+++ b/source/luametatex/source/libraries/libcerf/width.c
@@ -0,0 +1,100 @@
+/* Library libcerf:
+ * Compute complex error functions, based on a new implementation of
+ * Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
+ *
+ * File width.c:
+ * Computate voigt_hwhm, using Newton's iteration.
+ *
+ * Copyright:
+ * (C) 2018 Forschungszentrum Jülich GmbH
+ *
+ * Licence:
+ * 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.
+ *
+ * Authors:
+ * Joachim Wuttke, Forschungszentrum Jülich, 2018
+ *
+ * Website:
+ * http://apps.jcns.fz-juelich.de/libcerf
+ *
+ * Revision history:
+ * ../CHANGELOG
+ *
+ * Man pages:
+ * voigt_fwhm(3)
+ */
+
+/*
+
+ This file is patched by Hans Hagen for usage in LuaMetaTeX where we don't want to exit on an
+ error so we intercept it.
+
+*/
+
+#include "cerf.h"
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+double dvoigt(double x, double sigma, double gamma, double v0)
+{
+ return voigt(x, sigma, gamma)/v0 - .5;
+}
+
+double voigt_hwhm(double sigma, double gamma, int *error)
+{
+ *error = 0;
+ if (sigma == 0 && gamma == 0) {
+ return 0;
+ } else if (isnan(sigma) || isnan(gamma)) {
+ *error = 1;
+ return 0; // return NAN;
+ } else {
+ // start from an excellent approximation [Olivero & Longbothum, J Quant Spec Rad Transf 1977]:
+ const double eps = 1e-14;
+ const double hwhm0 = .5*(1.06868*gamma+sqrt(0.86743*gamma*gamma+4*2*log(2)*sigma*sigma));
+ const double del = eps*hwhm0;
+ double ret = hwhm0;
+ const double v0 = voigt(0, sigma, gamma);
+ for (int i=0; i<300; ++i) {
+ double val = dvoigt(ret, sigma, gamma, v0);
+ if (fabs(val) < 1e-15) {
+ return ret;
+ } else {
+ double step = -del/(dvoigt(ret+del, sigma, gamma, v0)/val-1);
+ double nxt = ret + step;
+ if (nxt < ret/3) {
+ *error = 2; // fprintf(stderr, "voigt_fwhm terminated because of huge deviation from 1st approx\n");
+ nxt = ret/3;
+ } else if (nxt > 2*ret) {
+ *error = 2; // fprintf(stderr, "voigt_fwhm terminated because of huge deviation from 1st approx\n");
+ nxt = 2*ret;
+ }
+ if (fabs(ret-nxt) < del) {
+ return nxt;
+ } else {
+ ret = nxt;
+ }
+ }
+ }
+ *error = 3; // fprintf(stderr, "voigt_fwhm failed: Newton's iteration did not converge with sigma = %f and gamma = %f\n", sigma, gamma); exit(-1);
+ return 0;
+ }
+}
diff --git a/source/luametatex/source/libraries/mimalloc/CMakeLists.txt b/source/luametatex/source/libraries/mimalloc/CMakeLists.txt
new file mode 100644
index 000000000..8127e0965
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/CMakeLists.txt
@@ -0,0 +1,413 @@
+cmake_minimum_required(VERSION 3.0)
+project(libmimalloc C CXX)
+
+set(CMAKE_C_STANDARD 11)
+set(CMAKE_CXX_STANDARD 17)
+
+option(MI_SECURE "Use full security mitigations (like guard pages, allocation randomization, double-free mitigation, and free-list corruption detection)" OFF)
+option(MI_DEBUG_FULL "Use full internal heap invariant checking in DEBUG mode (expensive)" OFF)
+option(MI_PADDING "Enable padding to detect heap block overflow (used only in DEBUG mode)" ON)
+option(MI_OVERRIDE "Override the standard malloc interface (e.g. define entry points for malloc() etc)" ON)
+option(MI_XMALLOC "Enable abort() call on memory allocation failure by default" OFF)
+option(MI_SHOW_ERRORS "Show error and warning messages by default (only enabled by default in DEBUG mode)" OFF)
+option(MI_USE_CXX "Use the C++ compiler to compile the library (instead of the C compiler)" OFF)
+option(MI_SEE_ASM "Generate assembly files" OFF)
+option(MI_OSX_INTERPOSE "Use interpose to override standard malloc on macOS" ON)
+option(MI_OSX_ZONE "Use malloc zone to override standard malloc on macOS" ON)
+option(MI_LOCAL_DYNAMIC_TLS "Use slightly slower, dlopen-compatible TLS mechanism (Unix)" OFF)
+option(MI_BUILD_SHARED "Build shared library" ON)
+option(MI_BUILD_STATIC "Build static library" ON)
+option(MI_BUILD_OBJECT "Build object library" ON)
+option(MI_BUILD_TESTS "Build test executables" ON)
+option(MI_DEBUG_TSAN "Build with thread sanitizer (needs clang)" OFF)
+option(MI_DEBUG_UBSAN "Build with undefined-behavior sanitizer (needs clang++)" OFF)
+option(MI_SKIP_COLLECT_ON_EXIT, "Skip collecting memory on program exit" OFF)
+
+# deprecated options
+option(MI_CHECK_FULL "Use full internal invariant checking in DEBUG mode (deprecated, use MI_DEBUG_FULL instead)" OFF)
+option(MI_INSTALL_TOPLEVEL "Install directly into $CMAKE_INSTALL_PREFIX instead of PREFIX/lib/mimalloc-version (deprecated)" OFF)
+option(MI_USE_LIBATOMIC "Explicitly link with -latomic (on older systems) (deprecated and detected automatically)" OFF)
+
+include(GNUInstallDirs)
+include("cmake/mimalloc-config-version.cmake")
+
+set(mi_sources
+ src/stats.c
+ src/random.c
+ src/os.c
+ src/bitmap.c
+ src/arena.c
+ src/segment-cache.c
+ src/segment.c
+ src/page.c
+ src/alloc.c
+ src/alloc-aligned.c
+ src/alloc-posix.c
+ src/heap.c
+ src/options.c
+ src/init.c)
+
+
+# -----------------------------------------------------------------------------
+# Convenience: set default build type depending on the build directory
+# -----------------------------------------------------------------------------
+
+message(STATUS "")
+if (NOT CMAKE_BUILD_TYPE)
+ if ("${CMAKE_BINARY_DIR}" MATCHES ".*(D|d)ebug$" OR MI_DEBUG_FULL)
+ message(STATUS "No build type selected, default to: Debug")
+ set(CMAKE_BUILD_TYPE "Debug")
+ else()
+ message(STATUS "No build type selected, default to: Release")
+ set(CMAKE_BUILD_TYPE "Release")
+ endif()
+endif()
+
+if("${CMAKE_BINARY_DIR}" MATCHES ".*(S|s)ecure$")
+ message(STATUS "Default to secure build")
+ set(MI_SECURE "ON")
+endif()
+
+
+# -----------------------------------------------------------------------------
+# Process options
+# -----------------------------------------------------------------------------
+
+if(CMAKE_C_COMPILER_ID MATCHES "MSVC|Intel")
+ set(MI_USE_CXX "ON")
+endif()
+
+if(MI_OVERRIDE)
+ message(STATUS "Override standard malloc (MI_OVERRIDE=ON)")
+ if(APPLE)
+ if(MI_OSX_ZONE)
+ # use zone's on macOS
+ message(STATUS " Use malloc zone to override malloc (MI_OSX_ZONE=ON)")
+ list(APPEND mi_sources src/alloc-override-osx.c)
+ list(APPEND mi_defines MI_OSX_ZONE=1)
+ if (NOT MI_OSX_INTERPOSE)
+ message(STATUS " WARNING: zone overriding usually also needs interpose (use -DMI_OSX_INTERPOSE=ON)")
+ endif()
+ endif()
+ if(MI_OSX_INTERPOSE)
+ # use interpose on macOS
+ message(STATUS " Use interpose to override malloc (MI_OSX_INTERPOSE=ON)")
+ list(APPEND mi_defines MI_OSX_INTERPOSE=1)
+ if (NOT MI_OSX_ZONE)
+ message(STATUS " WARNING: interpose usually also needs zone overriding (use -DMI_OSX_INTERPOSE=ON)")
+ endif()
+ endif()
+ if(MI_USE_CXX AND MI_OSX_INTERPOSE)
+ message(STATUS " WARNING: if dynamically overriding malloc/free, it is more reliable to build mimalloc as C code (use -DMI_USE_CXX=OFF)")
+ endif()
+ endif()
+endif()
+
+if(MI_SECURE)
+ message(STATUS "Set full secure build (MI_SECURE=ON)")
+ list(APPEND mi_defines MI_SECURE=4)
+endif()
+
+if(MI_SEE_ASM)
+ message(STATUS "Generate assembly listings (MI_SEE_ASM=ON)")
+ list(APPEND mi_cflags -save-temps)
+endif()
+
+if(MI_CHECK_FULL)
+ message(STATUS "The MI_CHECK_FULL option is deprecated, use MI_DEBUG_FULL instead")
+ set(MI_DEBUG_FULL "ON")
+endif()
+
+if (MI_SKIP_COLLECT_ON_EXIT)
+ message(STATUS "Skip collecting memory on program exit (MI_SKIP_COLLECT_ON_EXIT=ON)")
+ list(APPEND mi_defines MI_SKIP_COLLECT_ON_EXIT=1)
+endif()
+
+if(MI_DEBUG_FULL)
+ message(STATUS "Set debug level to full internal invariant checking (MI_DEBUG_FULL=ON)")
+ list(APPEND mi_defines MI_DEBUG=3) # full invariant checking
+endif()
+
+if(NOT MI_PADDING)
+ message(STATUS "Disable padding of heap blocks in debug mode (MI_PADDING=OFF)")
+ list(APPEND mi_defines MI_PADDING=0)
+endif()
+
+if(MI_XMALLOC)
+ message(STATUS "Enable abort() calls on memory allocation failure (MI_XMALLOC=ON)")
+ list(APPEND mi_defines MI_XMALLOC=1)
+endif()
+
+if(MI_SHOW_ERRORS)
+ message(STATUS "Enable printing of error and warning messages by default (MI_SHOW_ERRORS=ON)")
+ list(APPEND mi_defines MI_SHOW_ERRORS=1)
+endif()
+
+if(MI_DEBUG_TSAN)
+ if(CMAKE_C_COMPILER_ID MATCHES "Clang")
+ message(STATUS "Build with thread sanitizer (MI_DEBUG_TSAN=ON)")
+ list(APPEND mi_defines MI_TSAN=1)
+ list(APPEND mi_cflags -fsanitize=thread -g -O1)
+ list(APPEND CMAKE_EXE_LINKER_FLAGS -fsanitize=thread)
+ else()
+ message(WARNING "Can only use thread sanitizer with clang (MI_DEBUG_TSAN=ON but ignored)")
+ endif()
+endif()
+
+if(MI_DEBUG_UBSAN)
+ if(CMAKE_BUILD_TYPE MATCHES "Debug")
+ if(CMAKE_CXX_COMPILER_ID MATCHES "Clang")
+ message(STATUS "Build with undefined-behavior sanitizer (MI_DEBUG_UBSAN=ON)")
+ list(APPEND mi_cflags -fsanitize=undefined -g -fno-sanitize-recover=undefined)
+ list(APPEND CMAKE_EXE_LINKER_FLAGS -fsanitize=undefined)
+ if (NOT MI_USE_CXX)
+ message(STATUS "(switch to use C++ due to MI_DEBUG_UBSAN)")
+ set(MI_USE_CXX "ON")
+ endif()
+ else()
+ message(WARNING "Can only use undefined-behavior sanitizer with clang++ (MI_DEBUG_UBSAN=ON but ignored)")
+ endif()
+ else()
+ message(WARNING "Can only use thread sanitizer with a debug build (CMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE})")
+ endif()
+endif()
+
+if(MI_USE_CXX)
+ message(STATUS "Use the C++ compiler to compile (MI_USE_CXX=ON)")
+ set_source_files_properties(${mi_sources} PROPERTIES LANGUAGE CXX )
+ set_source_files_properties(src/static.c test/test-api.c test/test-api-fill test/test-stress PROPERTIES LANGUAGE CXX )
+ if(CMAKE_CXX_COMPILER_ID MATCHES "AppleClang|Clang")
+ list(APPEND mi_cflags -Wno-deprecated)
+ endif()
+ if(CMAKE_CXX_COMPILER_ID MATCHES "Intel")
+ list(APPEND mi_cflags -Kc++)
+ endif()
+endif()
+
+# Compiler flags
+if(CMAKE_C_COMPILER_ID MATCHES "AppleClang|Clang|GNU")
+ list(APPEND mi_cflags -Wall -Wextra -Wno-unknown-pragmas -fvisibility=hidden)
+ if(NOT MI_USE_CXX)
+ list(APPEND mi_cflags -Wstrict-prototypes)
+ endif()
+ if(CMAKE_C_COMPILER_ID MATCHES "AppleClang|Clang")
+ list(APPEND mi_cflags -Wpedantic -Wno-static-in-inline)
+ endif()
+endif()
+
+if(CMAKE_C_COMPILER_ID MATCHES "Intel")
+ list(APPEND mi_cflags -Wall -fvisibility=hidden)
+endif()
+
+if(CMAKE_C_COMPILER_ID MATCHES "AppleClang|Clang|GNU|Intel" AND NOT CMAKE_SYSTEM_NAME MATCHES "Haiku")
+ if(MI_LOCAL_DYNAMIC_TLS)
+ list(APPEND mi_cflags -ftls-model=local-dynamic)
+ else()
+ list(APPEND mi_cflags -ftls-model=initial-exec)
+ endif()
+ if(MI_OVERRIDE)
+ list(APPEND mi_cflags -fno-builtin-malloc)
+ endif()
+endif()
+
+if (MSVC AND MSVC_VERSION GREATER_EQUAL 1914)
+ list(APPEND mi_cflags /Zc:__cplusplus)
+endif()
+
+# extra needed libraries
+if(WIN32)
+ list(APPEND mi_libraries psapi shell32 user32 advapi32 bcrypt)
+else()
+ find_library(MI_LIBPTHREAD pthread)
+ if (MI_LIBPTHREAD)
+ list(APPEND mi_libraries ${MI_LIBPTHREAD})
+ endif()
+ find_library(MI_LIBRT rt)
+ if(MI_LIBRT)
+ list(APPEND mi_libraries ${MI_LIBRT})
+ endif()
+ find_library(MI_LIBATOMIC atomic)
+ if (MI_LIBATOMIC OR MI_USE_LIBATOMIC)
+ list(APPEND mi_libraries atomic)
+ endif()
+endif()
+
+# -----------------------------------------------------------------------------
+# Install and output names
+# -----------------------------------------------------------------------------
+
+# dynamic/shared library and symlinks always go to /usr/local/lib equivalent
+set(mi_install_libdir "${CMAKE_INSTALL_LIBDIR}")
+
+# static libraries and object files, includes, and cmake config files
+# are either installed at top level, or use versioned directories for side-by-side installation (default)
+if (MI_INSTALL_TOPLEVEL)
+ set(mi_install_objdir "${CMAKE_INSTALL_LIBDIR}")
+ set(mi_install_incdir "${CMAKE_INSTALL_INCLUDEDIR}")
+ set(mi_install_cmakedir "${CMAKE_INSTALL_LIBDIR}/cmake/mimalloc")
+else()
+ set(mi_install_objdir "${CMAKE_INSTALL_LIBDIR}/mimalloc-${mi_version}") # for static library and object files
+ set(mi_install_incdir "${CMAKE_INSTALL_INCLUDEDIR}/mimalloc-${mi_version}") # for includes
+ set(mi_install_cmakedir "${CMAKE_INSTALL_LIBDIR}/cmake/mimalloc-${mi_version}") # for cmake package info
+endif()
+
+if(MI_SECURE)
+ set(mi_basename "mimalloc-secure")
+else()
+ set(mi_basename "mimalloc")
+endif()
+
+string(TOLOWER "${CMAKE_BUILD_TYPE}" CMAKE_BUILD_TYPE_LC)
+if(NOT(CMAKE_BUILD_TYPE_LC MATCHES "^(release|relwithdebinfo|minsizerel|none)$"))
+ set(mi_basename "${mi_basename}-${CMAKE_BUILD_TYPE_LC}") #append build type (e.g. -debug) if not a release version
+endif()
+if(MI_BUILD_SHARED)
+ list(APPEND mi_build_targets "shared")
+endif()
+if(MI_BUILD_STATIC)
+ list(APPEND mi_build_targets "static")
+endif()
+if(MI_BUILD_OBJECT)
+ list(APPEND mi_build_targets "object")
+endif()
+if(MI_BUILD_TESTS)
+ list(APPEND mi_build_targets "tests")
+endif()
+
+message(STATUS "")
+message(STATUS "Library base name: ${mi_basename}")
+message(STATUS "Version : ${mi_version}")
+message(STATUS "Build type : ${CMAKE_BUILD_TYPE_LC}")
+if(MI_USE_CXX)
+ message(STATUS "C++ Compiler : ${CMAKE_CXX_COMPILER}")
+else()
+ message(STATUS "C Compiler : ${CMAKE_C_COMPILER}")
+endif()
+message(STATUS "Compiler flags : ${mi_cflags}")
+message(STATUS "Compiler defines : ${mi_defines}")
+message(STATUS "Link libraries : ${mi_libraries}")
+message(STATUS "Build targets : ${mi_build_targets}")
+message(STATUS "")
+
+# -----------------------------------------------------------------------------
+# Main targets
+# -----------------------------------------------------------------------------
+
+# shared library
+if(MI_BUILD_SHARED)
+ add_library(mimalloc SHARED ${mi_sources})
+ set_target_properties(mimalloc PROPERTIES VERSION ${mi_version} SOVERSION ${mi_version_major} OUTPUT_NAME ${mi_basename} )
+ target_compile_definitions(mimalloc PRIVATE ${mi_defines} MI_SHARED_LIB MI_SHARED_LIB_EXPORT)
+ target_compile_options(mimalloc PRIVATE ${mi_cflags})
+ target_link_libraries(mimalloc PUBLIC ${mi_libraries})
+ target_include_directories(mimalloc PUBLIC
+ $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
+ $<INSTALL_INTERFACE:${mi_install_incdir}>
+ )
+ if(WIN32)
+ # On windows copy the mimalloc redirection dll too.
+ if(CMAKE_SIZEOF_VOID_P EQUAL 4)
+ set(MIMALLOC_REDIRECT_SUFFIX "32")
+ else()
+ set(MIMALLOC_REDIRECT_SUFFIX "")
+ endif()
+
+ target_link_libraries(mimalloc PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/bin/mimalloc-redirect${MIMALLOC_REDIRECT_SUFFIX}.lib)
+ add_custom_command(TARGET mimalloc POST_BUILD
+ COMMAND "${CMAKE_COMMAND}" -E copy "${CMAKE_CURRENT_SOURCE_DIR}/bin/mimalloc-redirect${MIMALLOC_REDIRECT_SUFFIX}.dll" $<TARGET_FILE_DIR:mimalloc>
+ COMMENT "Copy mimalloc-redirect${MIMALLOC_REDIRECT_SUFFIX}.dll to output directory")
+ install(FILES "$<TARGET_FILE_DIR:mimalloc>/mimalloc-redirect${MIMALLOC_REDIRECT_SUFFIX}.dll" DESTINATION ${mi_install_libdir})
+ endif()
+
+ install(TARGETS mimalloc EXPORT mimalloc DESTINATION ${mi_install_libdir} LIBRARY)
+ install(EXPORT mimalloc DESTINATION ${mi_install_cmakedir})
+endif()
+
+# static library
+if (MI_BUILD_STATIC)
+ add_library(mimalloc-static STATIC ${mi_sources})
+ set_property(TARGET mimalloc-static PROPERTY POSITION_INDEPENDENT_CODE ON)
+ target_compile_definitions(mimalloc-static PRIVATE ${mi_defines} MI_STATIC_LIB)
+ target_compile_options(mimalloc-static PRIVATE ${mi_cflags})
+ target_link_libraries(mimalloc-static PUBLIC ${mi_libraries})
+ target_include_directories(mimalloc-static PUBLIC
+ $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
+ $<INSTALL_INTERFACE:${mi_install_incdir}>
+ )
+ if(WIN32)
+ # When building both static and shared libraries on Windows, a static library should use a
+ # different output name to avoid the conflict with the import library of a shared one.
+ string(REPLACE "mimalloc" "mimalloc-static" mi_output_name ${mi_basename})
+ set_target_properties(mimalloc-static PROPERTIES OUTPUT_NAME ${mi_output_name})
+ else()
+ set_target_properties(mimalloc-static PROPERTIES OUTPUT_NAME ${mi_basename})
+ endif()
+
+ install(TARGETS mimalloc-static EXPORT mimalloc DESTINATION ${mi_install_objdir} LIBRARY)
+ install(EXPORT mimalloc DESTINATION ${mi_install_cmakedir})
+endif()
+
+# install include files
+install(FILES include/mimalloc.h DESTINATION ${mi_install_incdir})
+install(FILES include/mimalloc-override.h DESTINATION ${mi_install_incdir})
+install(FILES include/mimalloc-new-delete.h DESTINATION ${mi_install_incdir})
+install(FILES cmake/mimalloc-config.cmake DESTINATION ${mi_install_cmakedir})
+install(FILES cmake/mimalloc-config-version.cmake DESTINATION ${mi_install_cmakedir})
+
+
+# single object file for more predictable static overriding
+if (MI_BUILD_OBJECT)
+ add_library(mimalloc-obj OBJECT src/static.c)
+ set_property(TARGET mimalloc-obj PROPERTY POSITION_INDEPENDENT_CODE ON)
+ target_compile_definitions(mimalloc-obj PRIVATE ${mi_defines})
+ target_compile_options(mimalloc-obj PRIVATE ${mi_cflags})
+ target_include_directories(mimalloc-obj PUBLIC
+ $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
+ $<INSTALL_INTERFACE:${mi_install_incdir}>
+ )
+
+ # the following seems to lead to cmake warnings/errors on some systems, disable for now :-(
+ # install(TARGETS mimalloc-obj EXPORT mimalloc DESTINATION ${mi_install_objdir})
+
+ # the FILES expression can also be: $<TARGET_OBJECTS:mimalloc-obj>
+ # but that fails cmake versions less than 3.10 so we leave it as is for now
+ install(FILES ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/mimalloc-obj.dir/src/static.c${CMAKE_C_OUTPUT_EXTENSION}
+ DESTINATION ${mi_install_objdir}
+ RENAME ${mi_basename}${CMAKE_C_OUTPUT_EXTENSION} )
+endif()
+
+# -----------------------------------------------------------------------------
+# API surface testing
+# -----------------------------------------------------------------------------
+
+if (MI_BUILD_TESTS)
+ enable_testing()
+
+ foreach(TEST_NAME api api-fill stress)
+ add_executable(mimalloc-test-${TEST_NAME} test/test-${TEST_NAME}.c)
+ target_compile_definitions(mimalloc-test-${TEST_NAME} PRIVATE ${mi_defines})
+ target_compile_options(mimalloc-test-${TEST_NAME} PRIVATE ${mi_cflags})
+ target_include_directories(mimalloc-test-${TEST_NAME} PRIVATE include)
+ target_link_libraries(mimalloc-test-${TEST_NAME} PRIVATE mimalloc ${mi_libraries})
+
+ add_test(NAME test-${TEST_NAME} COMMAND mimalloc-test-${TEST_NAME})
+ endforeach()
+endif()
+
+# -----------------------------------------------------------------------------
+# Set override properties
+# -----------------------------------------------------------------------------
+if (MI_OVERRIDE)
+ if (MI_BUILD_SHARED)
+ target_compile_definitions(mimalloc PRIVATE MI_MALLOC_OVERRIDE)
+ endif()
+ if(NOT WIN32)
+ # It is only possible to override malloc on Windows when building as a DLL.
+ if (MI_BUILD_STATIC)
+ target_compile_definitions(mimalloc-static PRIVATE MI_MALLOC_OVERRIDE)
+ endif()
+ if (MI_BUILD_OBJECT)
+ target_compile_definitions(mimalloc-obj PRIVATE MI_MALLOC_OVERRIDE)
+ endif()
+ endif()
+endif()
diff --git a/source/luametatex/source/libraries/mimalloc/LICENSE b/source/luametatex/source/libraries/mimalloc/LICENSE
new file mode 100644
index 000000000..670b668a0
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2018-2021 Microsoft Corporation, Daan Leijen
+
+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.
diff --git a/source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config-version.cmake b/source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config-version.cmake
new file mode 100644
index 000000000..8063afe6b
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config-version.cmake
@@ -0,0 +1,19 @@
+set(mi_version_major 2)
+set(mi_version_minor 0)
+set(mi_version_patch 6)
+set(mi_version ${mi_version_major}.${mi_version_minor})
+
+set(PACKAGE_VERSION ${mi_version})
+if(PACKAGE_FIND_VERSION_MAJOR)
+ if("${PACKAGE_FIND_VERSION_MAJOR}" EQUAL "${mi_version_major}")
+ if ("${PACKAGE_FIND_VERSION_MINOR}" EQUAL "${mi_version_minor}")
+ set(PACKAGE_VERSION_EXACT TRUE)
+ elseif("${PACKAGE_FIND_VERSION_MINOR}" LESS "${mi_version_minor}")
+ set(PACKAGE_VERSION_COMPATIBLE TRUE)
+ else()
+ set(PACKAGE_VERSION_UNSUITABLE TRUE)
+ endif()
+ else()
+ set(PACKAGE_VERSION_UNSUITABLE TRUE)
+ endif()
+endif()
diff --git a/source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config.cmake b/source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config.cmake
new file mode 100644
index 000000000..8a28e37e7
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config.cmake
@@ -0,0 +1,14 @@
+include(${CMAKE_CURRENT_LIST_DIR}/mimalloc.cmake)
+get_filename_component(MIMALLOC_CMAKE_DIR "${CMAKE_CURRENT_LIST_DIR}" PATH) # one up from the cmake dir, e.g. /usr/local/lib/cmake/mimalloc-2.0
+get_filename_component(MIMALLOC_VERSION_DIR "${CMAKE_CURRENT_LIST_DIR}" NAME)
+string(REPLACE "/lib/cmake" "/lib" MIMALLOC_LIBRARY_DIR "${MIMALLOC_CMAKE_DIR}")
+if("${MIMALLOC_VERSION_DIR}" EQUAL "mimalloc")
+ # top level install
+ string(REPLACE "/lib/cmake" "/include" MIMALLOC_INCLUDE_DIR "${MIMALLOC_CMAKE_DIR}")
+ set(MIMALLOC_OBJECT_DIR "${MIMALLOC_LIBRARY_DIR}")
+else()
+ # versioned
+ string(REPLACE "/lib/cmake/" "/include/" MIMALLOC_INCLUDE_DIR "${CMAKE_CURRENT_LIST_DIR}")
+ string(REPLACE "/lib/cmake/" "/lib/" MIMALLOC_OBJECT_DIR "${CMAKE_CURRENT_LIST_DIR}")
+endif()
+set(MIMALLOC_TARGET_DIR "${MIMALLOC_LIBRARY_DIR}") # legacy
diff --git a/source/luametatex/source/libraries/mimalloc/include/mimalloc-atomic.h b/source/luametatex/source/libraries/mimalloc/include/mimalloc-atomic.h
new file mode 100644
index 000000000..7ad5da585
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/include/mimalloc-atomic.h
@@ -0,0 +1,338 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021 Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#pragma once
+#ifndef MIMALLOC_ATOMIC_H
+#define MIMALLOC_ATOMIC_H
+
+// --------------------------------------------------------------------------------------------
+// Atomics
+// We need to be portable between C, C++, and MSVC.
+// We base the primitives on the C/C++ atomics and create a mimimal wrapper for MSVC in C compilation mode.
+// This is why we try to use only `uintptr_t` and `<type>*` as atomic types.
+// To gain better insight in the range of used atomics, we use explicitly named memory order operations
+// instead of passing the memory order as a parameter.
+// -----------------------------------------------------------------------------------------------
+
+#if defined(__cplusplus)
+// Use C++ atomics
+#include <atomic>
+#define _Atomic(tp) std::atomic<tp>
+#define mi_atomic(name) std::atomic_##name
+#define mi_memory_order(name) std::memory_order_##name
+#if !defined(ATOMIC_VAR_INIT) || (__cplusplus >= 202002L) // c++20, see issue #571
+ #define MI_ATOMIC_VAR_INIT(x) x
+#else
+ #define MI_ATOMIC_VAR_INIT(x) ATOMIC_VAR_INIT(x)
+#endif
+#elif defined(_MSC_VER)
+// Use MSVC C wrapper for C11 atomics
+#define _Atomic(tp) tp
+#define MI_ATOMIC_VAR_INIT(x) x
+#define mi_atomic(name) mi_atomic_##name
+#define mi_memory_order(name) mi_memory_order_##name
+#else
+// Use C11 atomics
+#include <stdatomic.h>
+#define mi_atomic(name) atomic_##name
+#define mi_memory_order(name) memory_order_##name
+#define MI_ATOMIC_VAR_INIT(x) ATOMIC_VAR_INIT(x)
+#endif
+
+// Various defines for all used memory orders in mimalloc
+#define mi_atomic_cas_weak(p,expected,desired,mem_success,mem_fail) \
+ mi_atomic(compare_exchange_weak_explicit)(p,expected,desired,mem_success,mem_fail)
+
+#define mi_atomic_cas_strong(p,expected,desired,mem_success,mem_fail) \
+ mi_atomic(compare_exchange_strong_explicit)(p,expected,desired,mem_success,mem_fail)
+
+#define mi_atomic_load_acquire(p) mi_atomic(load_explicit)(p,mi_memory_order(acquire))
+#define mi_atomic_load_relaxed(p) mi_atomic(load_explicit)(p,mi_memory_order(relaxed))
+#define mi_atomic_store_release(p,x) mi_atomic(store_explicit)(p,x,mi_memory_order(release))
+#define mi_atomic_store_relaxed(p,x) mi_atomic(store_explicit)(p,x,mi_memory_order(relaxed))
+#define mi_atomic_exchange_release(p,x) mi_atomic(exchange_explicit)(p,x,mi_memory_order(release))
+#define mi_atomic_exchange_acq_rel(p,x) mi_atomic(exchange_explicit)(p,x,mi_memory_order(acq_rel))
+#define mi_atomic_cas_weak_release(p,exp,des) mi_atomic_cas_weak(p,exp,des,mi_memory_order(release),mi_memory_order(relaxed))
+#define mi_atomic_cas_weak_acq_rel(p,exp,des) mi_atomic_cas_weak(p,exp,des,mi_memory_order(acq_rel),mi_memory_order(acquire))
+#define mi_atomic_cas_strong_release(p,exp,des) mi_atomic_cas_strong(p,exp,des,mi_memory_order(release),mi_memory_order(relaxed))
+#define mi_atomic_cas_strong_acq_rel(p,exp,des) mi_atomic_cas_strong(p,exp,des,mi_memory_order(acq_rel),mi_memory_order(acquire))
+
+#define mi_atomic_add_relaxed(p,x) mi_atomic(fetch_add_explicit)(p,x,mi_memory_order(relaxed))
+#define mi_atomic_sub_relaxed(p,x) mi_atomic(fetch_sub_explicit)(p,x,mi_memory_order(relaxed))
+#define mi_atomic_add_acq_rel(p,x) mi_atomic(fetch_add_explicit)(p,x,mi_memory_order(acq_rel))
+#define mi_atomic_sub_acq_rel(p,x) mi_atomic(fetch_sub_explicit)(p,x,mi_memory_order(acq_rel))
+#define mi_atomic_and_acq_rel(p,x) mi_atomic(fetch_and_explicit)(p,x,mi_memory_order(acq_rel))
+#define mi_atomic_or_acq_rel(p,x) mi_atomic(fetch_or_explicit)(p,x,mi_memory_order(acq_rel))
+
+#define mi_atomic_increment_relaxed(p) mi_atomic_add_relaxed(p,(uintptr_t)1)
+#define mi_atomic_decrement_relaxed(p) mi_atomic_sub_relaxed(p,(uintptr_t)1)
+#define mi_atomic_increment_acq_rel(p) mi_atomic_add_acq_rel(p,(uintptr_t)1)
+#define mi_atomic_decrement_acq_rel(p) mi_atomic_sub_acq_rel(p,(uintptr_t)1)
+
+static inline void mi_atomic_yield(void);
+static inline intptr_t mi_atomic_addi(_Atomic(intptr_t)*p, intptr_t add);
+static inline intptr_t mi_atomic_subi(_Atomic(intptr_t)*p, intptr_t sub);
+
+
+#if defined(__cplusplus) || !defined(_MSC_VER)
+
+// In C++/C11 atomics we have polymorphic atomics so can use the typed `ptr` variants (where `tp` is the type of atomic value)
+// We use these macros so we can provide a typed wrapper in MSVC in C compilation mode as well
+#define mi_atomic_load_ptr_acquire(tp,p) mi_atomic_load_acquire(p)
+#define mi_atomic_load_ptr_relaxed(tp,p) mi_atomic_load_relaxed(p)
+
+// In C++ we need to add casts to help resolve templates if NULL is passed
+#if defined(__cplusplus)
+#define mi_atomic_store_ptr_release(tp,p,x) mi_atomic_store_release(p,(tp*)x)
+#define mi_atomic_store_ptr_relaxed(tp,p,x) mi_atomic_store_relaxed(p,(tp*)x)
+#define mi_atomic_cas_ptr_weak_release(tp,p,exp,des) mi_atomic_cas_weak_release(p,exp,(tp*)des)
+#define mi_atomic_cas_ptr_weak_acq_rel(tp,p,exp,des) mi_atomic_cas_weak_acq_rel(p,exp,(tp*)des)
+#define mi_atomic_cas_ptr_strong_release(tp,p,exp,des) mi_atomic_cas_strong_release(p,exp,(tp*)des)
+#define mi_atomic_exchange_ptr_release(tp,p,x) mi_atomic_exchange_release(p,(tp*)x)
+#define mi_atomic_exchange_ptr_acq_rel(tp,p,x) mi_atomic_exchange_acq_rel(p,(tp*)x)
+#else
+#define mi_atomic_store_ptr_release(tp,p,x) mi_atomic_store_release(p,x)
+#define mi_atomic_store_ptr_relaxed(tp,p,x) mi_atomic_store_relaxed(p,x)
+#define mi_atomic_cas_ptr_weak_release(tp,p,exp,des) mi_atomic_cas_weak_release(p,exp,des)
+#define mi_atomic_cas_ptr_weak_acq_rel(tp,p,exp,des) mi_atomic_cas_weak_acq_rel(p,exp,des)
+#define mi_atomic_cas_ptr_strong_release(tp,p,exp,des) mi_atomic_cas_strong_release(p,exp,des)
+#define mi_atomic_exchange_ptr_release(tp,p,x) mi_atomic_exchange_release(p,x)
+#define mi_atomic_exchange_ptr_acq_rel(tp,p,x) mi_atomic_exchange_acq_rel(p,x)
+#endif
+
+// These are used by the statistics
+static inline int64_t mi_atomic_addi64_relaxed(volatile int64_t* p, int64_t add) {
+ return mi_atomic(fetch_add_explicit)((_Atomic(int64_t)*)p, add, mi_memory_order(relaxed));
+}
+static inline void mi_atomic_maxi64_relaxed(volatile int64_t* p, int64_t x) {
+ int64_t current = mi_atomic_load_relaxed((_Atomic(int64_t)*)p);
+ while (current < x && !mi_atomic_cas_weak_release((_Atomic(int64_t)*)p, &current, x)) { /* nothing */ };
+}
+
+// Used by timers
+#define mi_atomic_loadi64_acquire(p) mi_atomic(load_explicit)(p,mi_memory_order(acquire))
+#define mi_atomic_loadi64_relaxed(p) mi_atomic(load_explicit)(p,mi_memory_order(relaxed))
+#define mi_atomic_storei64_release(p,x) mi_atomic(store_explicit)(p,x,mi_memory_order(release))
+#define mi_atomic_storei64_relaxed(p,x) mi_atomic(store_explicit)(p,x,mi_memory_order(relaxed))
+
+
+
+#elif defined(_MSC_VER)
+
+// MSVC C compilation wrapper that uses Interlocked operations to model C11 atomics.
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#include <intrin.h>
+#ifdef _WIN64
+typedef LONG64 msc_intptr_t;
+#define MI_64(f) f##64
+#else
+typedef LONG msc_intptr_t;
+#define MI_64(f) f
+#endif
+
+typedef enum mi_memory_order_e {
+ mi_memory_order_relaxed,
+ mi_memory_order_consume,
+ mi_memory_order_acquire,
+ mi_memory_order_release,
+ mi_memory_order_acq_rel,
+ mi_memory_order_seq_cst
+} mi_memory_order;
+
+static inline uintptr_t mi_atomic_fetch_add_explicit(_Atomic(uintptr_t)*p, uintptr_t add, mi_memory_order mo) {
+ (void)(mo);
+ return (uintptr_t)MI_64(_InterlockedExchangeAdd)((volatile msc_intptr_t*)p, (msc_intptr_t)add);
+}
+static inline uintptr_t mi_atomic_fetch_sub_explicit(_Atomic(uintptr_t)*p, uintptr_t sub, mi_memory_order mo) {
+ (void)(mo);
+ return (uintptr_t)MI_64(_InterlockedExchangeAdd)((volatile msc_intptr_t*)p, -((msc_intptr_t)sub));
+}
+static inline uintptr_t mi_atomic_fetch_and_explicit(_Atomic(uintptr_t)*p, uintptr_t x, mi_memory_order mo) {
+ (void)(mo);
+ return (uintptr_t)MI_64(_InterlockedAnd)((volatile msc_intptr_t*)p, (msc_intptr_t)x);
+}
+static inline uintptr_t mi_atomic_fetch_or_explicit(_Atomic(uintptr_t)*p, uintptr_t x, mi_memory_order mo) {
+ (void)(mo);
+ return (uintptr_t)MI_64(_InterlockedOr)((volatile msc_intptr_t*)p, (msc_intptr_t)x);
+}
+static inline bool mi_atomic_compare_exchange_strong_explicit(_Atomic(uintptr_t)*p, uintptr_t* expected, uintptr_t desired, mi_memory_order mo1, mi_memory_order mo2) {
+ (void)(mo1); (void)(mo2);
+ uintptr_t read = (uintptr_t)MI_64(_InterlockedCompareExchange)((volatile msc_intptr_t*)p, (msc_intptr_t)desired, (msc_intptr_t)(*expected));
+ if (read == *expected) {
+ return true;
+ }
+ else {
+ *expected = read;
+ return false;
+ }
+}
+static inline bool mi_atomic_compare_exchange_weak_explicit(_Atomic(uintptr_t)*p, uintptr_t* expected, uintptr_t desired, mi_memory_order mo1, mi_memory_order mo2) {
+ return mi_atomic_compare_exchange_strong_explicit(p, expected, desired, mo1, mo2);
+}
+static inline uintptr_t mi_atomic_exchange_explicit(_Atomic(uintptr_t)*p, uintptr_t exchange, mi_memory_order mo) {
+ (void)(mo);
+ return (uintptr_t)MI_64(_InterlockedExchange)((volatile msc_intptr_t*)p, (msc_intptr_t)exchange);
+}
+static inline void mi_atomic_thread_fence(mi_memory_order mo) {
+ (void)(mo);
+ _Atomic(uintptr_t) x = 0;
+ mi_atomic_exchange_explicit(&x, 1, mo);
+}
+static inline uintptr_t mi_atomic_load_explicit(_Atomic(uintptr_t) const* p, mi_memory_order mo) {
+ (void)(mo);
+#if defined(_M_IX86) || defined(_M_X64)
+ return *p;
+#else
+ uintptr_t x = *p;
+ if (mo > mi_memory_order_relaxed) {
+ while (!mi_atomic_compare_exchange_weak_explicit(p, &x, x, mo, mi_memory_order_relaxed)) { /* nothing */ };
+ }
+ return x;
+#endif
+}
+static inline void mi_atomic_store_explicit(_Atomic(uintptr_t)*p, uintptr_t x, mi_memory_order mo) {
+ (void)(mo);
+#if defined(_M_IX86) || defined(_M_X64)
+ *p = x;
+#else
+ mi_atomic_exchange_explicit(p, x, mo);
+#endif
+}
+static inline int64_t mi_atomic_loadi64_explicit(_Atomic(int64_t)*p, mi_memory_order mo) {
+ (void)(mo);
+#if defined(_M_X64)
+ return *p;
+#else
+ int64_t old = *p;
+ int64_t x = old;
+ while ((old = InterlockedCompareExchange64(p, x, old)) != x) {
+ x = old;
+ }
+ return x;
+#endif
+}
+static inline void mi_atomic_storei64_explicit(_Atomic(int64_t)*p, int64_t x, mi_memory_order mo) {
+ (void)(mo);
+#if defined(x_M_IX86) || defined(_M_X64)
+ *p = x;
+#else
+ InterlockedExchange64(p, x);
+#endif
+}
+
+// These are used by the statistics
+static inline int64_t mi_atomic_addi64_relaxed(volatile _Atomic(int64_t)*p, int64_t add) {
+#ifdef _WIN64
+ return (int64_t)mi_atomic_addi((int64_t*)p, add);
+#else
+ int64_t current;
+ int64_t sum;
+ do {
+ current = *p;
+ sum = current + add;
+ } while (_InterlockedCompareExchange64(p, sum, current) != current);
+ return current;
+#endif
+}
+static inline void mi_atomic_maxi64_relaxed(volatile _Atomic(int64_t)*p, int64_t x) {
+ int64_t current;
+ do {
+ current = *p;
+ } while (current < x && _InterlockedCompareExchange64(p, x, current) != current);
+}
+
+// The pointer macros cast to `uintptr_t`.
+#define mi_atomic_load_ptr_acquire(tp,p) (tp*)mi_atomic_load_acquire((_Atomic(uintptr_t)*)(p))
+#define mi_atomic_load_ptr_relaxed(tp,p) (tp*)mi_atomic_load_relaxed((_Atomic(uintptr_t)*)(p))
+#define mi_atomic_store_ptr_release(tp,p,x) mi_atomic_store_release((_Atomic(uintptr_t)*)(p),(uintptr_t)(x))
+#define mi_atomic_store_ptr_relaxed(tp,p,x) mi_atomic_store_relaxed((_Atomic(uintptr_t)*)(p),(uintptr_t)(x))
+#define mi_atomic_cas_ptr_weak_release(tp,p,exp,des) mi_atomic_cas_weak_release((_Atomic(uintptr_t)*)(p),(uintptr_t*)exp,(uintptr_t)des)
+#define mi_atomic_cas_ptr_weak_acq_rel(tp,p,exp,des) mi_atomic_cas_weak_acq_rel((_Atomic(uintptr_t)*)(p),(uintptr_t*)exp,(uintptr_t)des)
+#define mi_atomic_cas_ptr_strong_release(tp,p,exp,des) mi_atomic_cas_strong_release((_Atomic(uintptr_t)*)(p),(uintptr_t*)exp,(uintptr_t)des)
+#define mi_atomic_exchange_ptr_release(tp,p,x) (tp*)mi_atomic_exchange_release((_Atomic(uintptr_t)*)(p),(uintptr_t)x)
+#define mi_atomic_exchange_ptr_acq_rel(tp,p,x) (tp*)mi_atomic_exchange_acq_rel((_Atomic(uintptr_t)*)(p),(uintptr_t)x)
+
+#define mi_atomic_loadi64_acquire(p) mi_atomic(loadi64_explicit)(p,mi_memory_order(acquire))
+#define mi_atomic_loadi64_relaxed(p) mi_atomic(loadi64_explicit)(p,mi_memory_order(relaxed))
+#define mi_atomic_storei64_release(p,x) mi_atomic(storei64_explicit)(p,x,mi_memory_order(release))
+#define mi_atomic_storei64_relaxed(p,x) mi_atomic(storei64_explicit)(p,x,mi_memory_order(relaxed))
+
+
+#endif
+
+
+// Atomically add a signed value; returns the previous value.
+static inline intptr_t mi_atomic_addi(_Atomic(intptr_t)*p, intptr_t add) {
+ return (intptr_t)mi_atomic_add_acq_rel((_Atomic(uintptr_t)*)p, (uintptr_t)add);
+}
+
+// Atomically subtract a signed value; returns the previous value.
+static inline intptr_t mi_atomic_subi(_Atomic(intptr_t)*p, intptr_t sub) {
+ return (intptr_t)mi_atomic_addi(p, -sub);
+}
+
+// Yield
+#if defined(__cplusplus)
+#include <thread>
+static inline void mi_atomic_yield(void) {
+ std::this_thread::yield();
+}
+#elif defined(_WIN32)
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+static inline void mi_atomic_yield(void) {
+ YieldProcessor();
+}
+#elif defined(__SSE2__)
+#include <emmintrin.h>
+static inline void mi_atomic_yield(void) {
+ _mm_pause();
+}
+#elif (defined(__GNUC__) || defined(__clang__)) && \
+ (defined(__x86_64__) || defined(__i386__) || defined(__arm__) || defined(__armel__) || defined(__ARMEL__) || \
+ defined(__aarch64__) || defined(__powerpc__) || defined(__ppc__) || defined(__PPC__))
+#if defined(__x86_64__) || defined(__i386__)
+static inline void mi_atomic_yield(void) {
+ __asm__ volatile ("pause" ::: "memory");
+}
+#elif defined(__aarch64__)
+static inline void mi_atomic_yield(void) {
+ __asm__ volatile("wfe");
+}
+#elif (defined(__arm__) && __ARM_ARCH__ >= 7)
+static inline void mi_atomic_yield(void) {
+ __asm__ volatile("yield" ::: "memory");
+}
+#elif defined(__powerpc__) || defined(__ppc__) || defined(__PPC__)
+static inline void mi_atomic_yield(void) {
+ __asm__ __volatile__ ("or 27,27,27" ::: "memory");
+}
+#elif defined(__armel__) || defined(__ARMEL__)
+static inline void mi_atomic_yield(void) {
+ __asm__ volatile ("nop" ::: "memory");
+}
+#endif
+#elif defined(__sun)
+// Fallback for other archs
+#include <synch.h>
+static inline void mi_atomic_yield(void) {
+ smt_pause();
+}
+#elif defined(__wasi__)
+#include <sched.h>
+static inline void mi_atomic_yield(void) {
+ sched_yield();
+}
+#else
+#include <unistd.h>
+static inline void mi_atomic_yield(void) {
+ sleep(0);
+}
+#endif
+
+
+#endif // __MIMALLOC_ATOMIC_H
diff --git a/source/luametatex/source/libraries/mimalloc/include/mimalloc-internal.h b/source/luametatex/source/libraries/mimalloc/include/mimalloc-internal.h
new file mode 100644
index 000000000..d691eca58
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/include/mimalloc-internal.h
@@ -0,0 +1,1049 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2022, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#pragma once
+#ifndef MIMALLOC_INTERNAL_H
+#define MIMALLOC_INTERNAL_H
+
+#include "mimalloc-types.h"
+
+#if (MI_DEBUG>0)
+#define mi_trace_message(...) _mi_trace_message(__VA_ARGS__)
+#else
+#define mi_trace_message(...)
+#endif
+
+#define MI_CACHE_LINE 64
+#if defined(_MSC_VER)
+#pragma warning(disable:4127) // suppress constant conditional warning (due to MI_SECURE paths)
+#pragma warning(disable:26812) // unscoped enum warning
+#define mi_decl_noinline __declspec(noinline)
+#define mi_decl_thread __declspec(thread)
+#define mi_decl_cache_align __declspec(align(MI_CACHE_LINE))
+#elif (defined(__GNUC__) && (__GNUC__ >= 3)) || defined(__clang__) // includes clang and icc
+#define mi_decl_noinline __attribute__((noinline))
+#define mi_decl_thread __thread
+#define mi_decl_cache_align __attribute__((aligned(MI_CACHE_LINE)))
+#else
+#define mi_decl_noinline
+#define mi_decl_thread __thread // hope for the best :-)
+#define mi_decl_cache_align
+#endif
+
+#if defined(__EMSCRIPTEN__) && !defined(__wasi__)
+#define __wasi__
+#endif
+
+#if defined(__cplusplus)
+#define mi_decl_externc extern "C"
+#else
+#define mi_decl_externc
+#endif
+
+#if !defined(_WIN32) && !defined(__wasi__)
+#define MI_USE_PTHREADS
+#include <pthread.h>
+#endif
+
+// "options.c"
+void _mi_fputs(mi_output_fun* out, void* arg, const char* prefix, const char* message);
+void _mi_fprintf(mi_output_fun* out, void* arg, const char* fmt, ...);
+void _mi_warning_message(const char* fmt, ...);
+void _mi_verbose_message(const char* fmt, ...);
+void _mi_trace_message(const char* fmt, ...);
+void _mi_options_init(void);
+void _mi_error_message(int err, const char* fmt, ...);
+
+// random.c
+void _mi_random_init(mi_random_ctx_t* ctx);
+void _mi_random_split(mi_random_ctx_t* ctx, mi_random_ctx_t* new_ctx);
+uintptr_t _mi_random_next(mi_random_ctx_t* ctx);
+uintptr_t _mi_heap_random_next(mi_heap_t* heap);
+uintptr_t _mi_os_random_weak(uintptr_t extra_seed);
+static inline uintptr_t _mi_random_shuffle(uintptr_t x);
+
+// init.c
+extern mi_decl_cache_align mi_stats_t _mi_stats_main;
+extern mi_decl_cache_align const mi_page_t _mi_page_empty;
+bool _mi_is_main_thread(void);
+size_t _mi_current_thread_count(void);
+bool _mi_preloading(void); // true while the C runtime is not ready
+
+// os.c
+size_t _mi_os_page_size(void);
+void _mi_os_init(void); // called from process init
+void* _mi_os_alloc(size_t size, mi_stats_t* stats); // to allocate thread local data
+void _mi_os_free(void* p, size_t size, mi_stats_t* stats); // to free thread local data
+
+bool _mi_os_protect(void* addr, size_t size);
+bool _mi_os_unprotect(void* addr, size_t size);
+bool _mi_os_commit(void* addr, size_t size, bool* is_zero, mi_stats_t* stats);
+bool _mi_os_decommit(void* p, size_t size, mi_stats_t* stats);
+bool _mi_os_reset(void* p, size_t size, mi_stats_t* stats);
+// bool _mi_os_unreset(void* p, size_t size, bool* is_zero, mi_stats_t* stats);
+size_t _mi_os_good_alloc_size(size_t size);
+bool _mi_os_has_overcommit(void);
+
+// arena.c
+void* _mi_arena_alloc_aligned(size_t size, size_t alignment, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld);
+void* _mi_arena_alloc(size_t size, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld);
+void _mi_arena_free(void* p, size_t size, size_t memid, bool is_committed, mi_os_tld_t* tld);
+
+// "segment-cache.c"
+void* _mi_segment_cache_pop(size_t size, mi_commit_mask_t* commit_mask, mi_commit_mask_t* decommit_mask, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld);
+bool _mi_segment_cache_push(void* start, size_t size, size_t memid, const mi_commit_mask_t* commit_mask, const mi_commit_mask_t* decommit_mask, bool is_large, bool is_pinned, mi_os_tld_t* tld);
+void _mi_segment_cache_collect(bool force, mi_os_tld_t* tld);
+void _mi_segment_map_allocated_at(const mi_segment_t* segment);
+void _mi_segment_map_freed_at(const mi_segment_t* segment);
+
+// "segment.c"
+mi_page_t* _mi_segment_page_alloc(mi_heap_t* heap, size_t block_wsize, mi_segments_tld_t* tld, mi_os_tld_t* os_tld);
+void _mi_segment_page_free(mi_page_t* page, bool force, mi_segments_tld_t* tld);
+void _mi_segment_page_abandon(mi_page_t* page, mi_segments_tld_t* tld);
+bool _mi_segment_try_reclaim_abandoned( mi_heap_t* heap, bool try_all, mi_segments_tld_t* tld);
+void _mi_segment_thread_collect(mi_segments_tld_t* tld);
+void _mi_segment_huge_page_free(mi_segment_t* segment, mi_page_t* page, mi_block_t* block);
+
+uint8_t* _mi_segment_page_start(const mi_segment_t* segment, const mi_page_t* page, size_t* page_size); // page start for any page
+void _mi_abandoned_reclaim_all(mi_heap_t* heap, mi_segments_tld_t* tld);
+void _mi_abandoned_await_readers(void);
+void _mi_abandoned_collect(mi_heap_t* heap, bool force, mi_segments_tld_t* tld);
+
+
+
+// "page.c"
+void* _mi_malloc_generic(mi_heap_t* heap, size_t size) mi_attr_noexcept mi_attr_malloc;
+
+void _mi_page_retire(mi_page_t* page) mi_attr_noexcept; // free the page if there are no other pages with many free blocks
+void _mi_page_unfull(mi_page_t* page);
+void _mi_page_free(mi_page_t* page, mi_page_queue_t* pq, bool force); // free the page
+void _mi_page_abandon(mi_page_t* page, mi_page_queue_t* pq); // abandon the page, to be picked up by another thread...
+void _mi_heap_delayed_free(mi_heap_t* heap);
+void _mi_heap_collect_retired(mi_heap_t* heap, bool force);
+
+void _mi_page_use_delayed_free(mi_page_t* page, mi_delayed_t delay, bool override_never);
+size_t _mi_page_queue_append(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_queue_t* append);
+void _mi_deferred_free(mi_heap_t* heap, bool force);
+
+void _mi_page_free_collect(mi_page_t* page,bool force);
+void _mi_page_reclaim(mi_heap_t* heap, mi_page_t* page); // callback from segments
+
+size_t _mi_bin_size(uint8_t bin); // for stats
+uint8_t _mi_bin(size_t size); // for stats
+
+// "heap.c"
+void _mi_heap_destroy_pages(mi_heap_t* heap);
+void _mi_heap_collect_abandon(mi_heap_t* heap);
+void _mi_heap_set_default_direct(mi_heap_t* heap);
+
+// "stats.c"
+void _mi_stats_done(mi_stats_t* stats);
+
+mi_msecs_t _mi_clock_now(void);
+mi_msecs_t _mi_clock_end(mi_msecs_t start);
+mi_msecs_t _mi_clock_start(void);
+
+// "alloc.c"
+void* _mi_page_malloc(mi_heap_t* heap, mi_page_t* page, size_t size) mi_attr_noexcept; // called from `_mi_malloc_generic`
+void* _mi_heap_malloc_zero(mi_heap_t* heap, size_t size, bool zero) mi_attr_noexcept;
+void* _mi_heap_realloc_zero(mi_heap_t* heap, void* p, size_t newsize, bool zero) mi_attr_noexcept;
+mi_block_t* _mi_page_ptr_unalign(const mi_segment_t* segment, const mi_page_t* page, const void* p);
+bool _mi_free_delayed_block(mi_block_t* block);
+void _mi_block_zero_init(const mi_page_t* page, void* p, size_t size);
+
+#if MI_DEBUG>1
+bool _mi_page_is_valid(mi_page_t* page);
+#endif
+
+
+// ------------------------------------------------------
+// Branches
+// ------------------------------------------------------
+
+#if defined(__GNUC__) || defined(__clang__)
+#define mi_unlikely(x) __builtin_expect(!!(x),false)
+#define mi_likely(x) __builtin_expect(!!(x),true)
+#else
+#define mi_unlikely(x) (x)
+#define mi_likely(x) (x)
+#endif
+
+#ifndef __has_builtin
+#define __has_builtin(x) 0
+#endif
+
+
+/* -----------------------------------------------------------
+ Error codes passed to `_mi_fatal_error`
+ All are recoverable but EFAULT is a serious error and aborts by default in secure mode.
+ For portability define undefined error codes using common Unix codes:
+ <https://www-numi.fnal.gov/offline_software/srt_public_context/WebDocs/Errors/unix_system_errors.html>
+----------------------------------------------------------- */
+#include <errno.h>
+#ifndef EAGAIN // double free
+#define EAGAIN (11)
+#endif
+#ifndef ENOMEM // out of memory
+#define ENOMEM (12)
+#endif
+#ifndef EFAULT // corrupted free-list or meta-data
+#define EFAULT (14)
+#endif
+#ifndef EINVAL // trying to free an invalid pointer
+#define EINVAL (22)
+#endif
+#ifndef EOVERFLOW // count*size overflow
+#define EOVERFLOW (75)
+#endif
+
+
+/* -----------------------------------------------------------
+ Inlined definitions
+----------------------------------------------------------- */
+#define MI_UNUSED(x) (void)(x)
+#if (MI_DEBUG>0)
+#define MI_UNUSED_RELEASE(x)
+#else
+#define MI_UNUSED_RELEASE(x) MI_UNUSED(x)
+#endif
+
+#define MI_INIT4(x) x(),x(),x(),x()
+#define MI_INIT8(x) MI_INIT4(x),MI_INIT4(x)
+#define MI_INIT16(x) MI_INIT8(x),MI_INIT8(x)
+#define MI_INIT32(x) MI_INIT16(x),MI_INIT16(x)
+#define MI_INIT64(x) MI_INIT32(x),MI_INIT32(x)
+#define MI_INIT128(x) MI_INIT64(x),MI_INIT64(x)
+#define MI_INIT256(x) MI_INIT128(x),MI_INIT128(x)
+
+
+// Is `x` a power of two? (0 is considered a power of two)
+static inline bool _mi_is_power_of_two(uintptr_t x) {
+ return ((x & (x - 1)) == 0);
+}
+
+// Align upwards
+static inline uintptr_t _mi_align_up(uintptr_t sz, size_t alignment) {
+ mi_assert_internal(alignment != 0);
+ uintptr_t mask = alignment - 1;
+ if ((alignment & mask) == 0) { // power of two?
+ return ((sz + mask) & ~mask);
+ }
+ else {
+ return (((sz + mask)/alignment)*alignment);
+ }
+}
+
+// Align downwards
+static inline uintptr_t _mi_align_down(uintptr_t sz, size_t alignment) {
+ mi_assert_internal(alignment != 0);
+ uintptr_t mask = alignment - 1;
+ if ((alignment & mask) == 0) { // power of two?
+ return (sz & ~mask);
+ }
+ else {
+ return ((sz / alignment) * alignment);
+ }
+}
+
+// Divide upwards: `s <= _mi_divide_up(s,d)*d < s+d`.
+static inline uintptr_t _mi_divide_up(uintptr_t size, size_t divider) {
+ mi_assert_internal(divider != 0);
+ return (divider == 0 ? size : ((size + divider - 1) / divider));
+}
+
+// Is memory zero initialized?
+static inline bool mi_mem_is_zero(void* p, size_t size) {
+ for (size_t i = 0; i < size; i++) {
+ if (((uint8_t*)p)[i] != 0) return false;
+ }
+ return true;
+}
+
+
+// Align a byte size to a size in _machine words_,
+// i.e. byte size == `wsize*sizeof(void*)`.
+static inline size_t _mi_wsize_from_size(size_t size) {
+ mi_assert_internal(size <= SIZE_MAX - sizeof(uintptr_t));
+ return (size + sizeof(uintptr_t) - 1) / sizeof(uintptr_t);
+}
+
+// Overflow detecting multiply
+#if __has_builtin(__builtin_umul_overflow) || (defined(__GNUC__) && (__GNUC__ >= 5))
+#include <limits.h> // UINT_MAX, ULONG_MAX
+#if defined(_CLOCK_T) // for Illumos
+#undef _CLOCK_T
+#endif
+static inline bool mi_mul_overflow(size_t count, size_t size, size_t* total) {
+ #if (SIZE_MAX == ULONG_MAX)
+ return __builtin_umull_overflow(count, size, (unsigned long *)total);
+ #elif (SIZE_MAX == UINT_MAX)
+ return __builtin_umul_overflow(count, size, (unsigned int *)total);
+ #else
+ return __builtin_umulll_overflow(count, size, (unsigned long long *)total);
+ #endif
+}
+#else /* __builtin_umul_overflow is unavailable */
+static inline bool mi_mul_overflow(size_t count, size_t size, size_t* total) {
+ #define MI_MUL_NO_OVERFLOW ((size_t)1 << (4*sizeof(size_t))) // sqrt(SIZE_MAX)
+ *total = count * size;
+ return ((size >= MI_MUL_NO_OVERFLOW || count >= MI_MUL_NO_OVERFLOW)
+ && size > 0 && (SIZE_MAX / size) < count);
+}
+#endif
+
+// Safe multiply `count*size` into `total`; return `true` on overflow.
+static inline bool mi_count_size_overflow(size_t count, size_t size, size_t* total) {
+ if (count==1) { // quick check for the case where count is one (common for C++ allocators)
+ *total = size;
+ return false;
+ }
+ else if (mi_unlikely(mi_mul_overflow(count, size, total))) {
+ _mi_error_message(EOVERFLOW, "allocation request is too large (%zu * %zu bytes)\n", count, size);
+ *total = SIZE_MAX;
+ return true;
+ }
+ else return false;
+}
+
+
+/* ----------------------------------------------------------------------------------------
+The thread local default heap: `_mi_get_default_heap` returns the thread local heap.
+On most platforms (Windows, Linux, FreeBSD, NetBSD, etc), this just returns a
+__thread local variable (`_mi_heap_default`). With the initial-exec TLS model this ensures
+that the storage will always be available (allocated on the thread stacks).
+On some platforms though we cannot use that when overriding `malloc` since the underlying
+TLS implementation (or the loader) will call itself `malloc` on a first access and recurse.
+We try to circumvent this in an efficient way:
+- macOSX : we use an unused TLS slot from the OS allocated slots (MI_TLS_SLOT). On OSX, the
+ loader itself calls `malloc` even before the modules are initialized.
+- OpenBSD: we use an unused slot from the pthread block (MI_TLS_PTHREAD_SLOT_OFS).
+- DragonFly: defaults are working but seem slow compared to freeBSD (see PR #323)
+------------------------------------------------------------------------------------------- */
+
+extern const mi_heap_t _mi_heap_empty; // read-only empty heap, initial value of the thread local default heap
+extern bool _mi_process_is_initialized;
+mi_heap_t* _mi_heap_main_get(void); // statically allocated main backing heap
+
+#if defined(MI_MALLOC_OVERRIDE)
+#if defined(__APPLE__) // macOS
+#define MI_TLS_SLOT 89 // seems unused?
+// #define MI_TLS_RECURSE_GUARD 1
+// other possible unused ones are 9, 29, __PTK_FRAMEWORK_JAVASCRIPTCORE_KEY4 (94), __PTK_FRAMEWORK_GC_KEY9 (112) and __PTK_FRAMEWORK_OLDGC_KEY9 (89)
+// see <https://github.com/rweichler/substrate/blob/master/include/pthread_machdep.h>
+#elif defined(__OpenBSD__)
+// use end bytes of a name; goes wrong if anyone uses names > 23 characters (ptrhread specifies 16)
+// see <https://github.com/openbsd/src/blob/master/lib/libc/include/thread_private.h#L371>
+#define MI_TLS_PTHREAD_SLOT_OFS (6*sizeof(int) + 4*sizeof(void*) + 24)
+// #elif defined(__DragonFly__)
+// #warning "mimalloc is not working correctly on DragonFly yet."
+// #define MI_TLS_PTHREAD_SLOT_OFS (4 + 1*sizeof(void*)) // offset `uniqueid` (also used by gdb?) <https://github.com/DragonFlyBSD/DragonFlyBSD/blob/master/lib/libthread_xu/thread/thr_private.h#L458>
+#elif defined(__ANDROID__)
+// See issue #381
+#define MI_TLS_PTHREAD
+#endif
+#endif
+
+#if defined(MI_TLS_SLOT)
+static inline void* mi_tls_slot(size_t slot) mi_attr_noexcept; // forward declaration
+#elif defined(MI_TLS_PTHREAD_SLOT_OFS)
+static inline mi_heap_t** mi_tls_pthread_heap_slot(void) {
+ pthread_t self = pthread_self();
+ #if defined(__DragonFly__)
+ if (self==NULL) {
+ mi_heap_t* pheap_main = _mi_heap_main_get();
+ return &pheap_main;
+ }
+ #endif
+ return (mi_heap_t**)((uint8_t*)self + MI_TLS_PTHREAD_SLOT_OFS);
+}
+#elif defined(MI_TLS_PTHREAD)
+extern pthread_key_t _mi_heap_default_key;
+#endif
+
+// Default heap to allocate from (if not using TLS- or pthread slots).
+// Do not use this directly but use through `mi_heap_get_default()` (or the unchecked `mi_get_default_heap`).
+// This thread local variable is only used when neither MI_TLS_SLOT, MI_TLS_PTHREAD, or MI_TLS_PTHREAD_SLOT_OFS are defined.
+// However, on the Apple M1 we do use the address of this variable as the unique thread-id (issue #356).
+extern mi_decl_thread mi_heap_t* _mi_heap_default; // default heap to allocate from
+
+static inline mi_heap_t* mi_get_default_heap(void) {
+#if defined(MI_TLS_SLOT)
+ mi_heap_t* heap = (mi_heap_t*)mi_tls_slot(MI_TLS_SLOT);
+ if (mi_unlikely(heap == NULL)) {
+ #ifdef __GNUC__
+ __asm(""); // prevent conditional load of the address of _mi_heap_empty
+ #endif
+ heap = (mi_heap_t*)&_mi_heap_empty;
+ }
+ return heap;
+#elif defined(MI_TLS_PTHREAD_SLOT_OFS)
+ mi_heap_t* heap = *mi_tls_pthread_heap_slot();
+ return (mi_unlikely(heap == NULL) ? (mi_heap_t*)&_mi_heap_empty : heap);
+#elif defined(MI_TLS_PTHREAD)
+ mi_heap_t* heap = (mi_unlikely(_mi_heap_default_key == (pthread_key_t)(-1)) ? _mi_heap_main_get() : (mi_heap_t*)pthread_getspecific(_mi_heap_default_key));
+ return (mi_unlikely(heap == NULL) ? (mi_heap_t*)&_mi_heap_empty : heap);
+#else
+ #if defined(MI_TLS_RECURSE_GUARD)
+ if (mi_unlikely(!_mi_process_is_initialized)) return _mi_heap_main_get();
+ #endif
+ return _mi_heap_default;
+#endif
+}
+
+static inline bool mi_heap_is_default(const mi_heap_t* heap) {
+ return (heap == mi_get_default_heap());
+}
+
+static inline bool mi_heap_is_backing(const mi_heap_t* heap) {
+ return (heap->tld->heap_backing == heap);
+}
+
+static inline bool mi_heap_is_initialized(mi_heap_t* heap) {
+ mi_assert_internal(heap != NULL);
+ return (heap != &_mi_heap_empty);
+}
+
+static inline uintptr_t _mi_ptr_cookie(const void* p) {
+ extern mi_heap_t _mi_heap_main;
+ mi_assert_internal(_mi_heap_main.cookie != 0);
+ return ((uintptr_t)p ^ _mi_heap_main.cookie);
+}
+
+/* -----------------------------------------------------------
+ Pages
+----------------------------------------------------------- */
+
+static inline mi_page_t* _mi_heap_get_free_small_page(mi_heap_t* heap, size_t size) {
+ mi_assert_internal(size <= (MI_SMALL_SIZE_MAX + MI_PADDING_SIZE));
+ const size_t idx = _mi_wsize_from_size(size);
+ mi_assert_internal(idx < MI_PAGES_DIRECT);
+ return heap->pages_free_direct[idx];
+}
+
+// Get the page belonging to a certain size class
+static inline mi_page_t* _mi_get_free_small_page(size_t size) {
+ return _mi_heap_get_free_small_page(mi_get_default_heap(), size);
+}
+
+// Segment that contains the pointer
+static inline mi_segment_t* _mi_ptr_segment(const void* p) {
+ // mi_assert_internal(p != NULL);
+ return (mi_segment_t*)((uintptr_t)p & ~MI_SEGMENT_MASK);
+}
+
+static inline mi_page_t* mi_slice_to_page(mi_slice_t* s) {
+ mi_assert_internal(s->slice_offset== 0 && s->slice_count > 0);
+ return (mi_page_t*)(s);
+}
+
+static inline mi_slice_t* mi_page_to_slice(mi_page_t* p) {
+ mi_assert_internal(p->slice_offset== 0 && p->slice_count > 0);
+ return (mi_slice_t*)(p);
+}
+
+// Segment belonging to a page
+static inline mi_segment_t* _mi_page_segment(const mi_page_t* page) {
+ mi_segment_t* segment = _mi_ptr_segment(page);
+ mi_assert_internal(segment == NULL || ((mi_slice_t*)page >= segment->slices && (mi_slice_t*)page < segment->slices + segment->slice_entries));
+ return segment;
+}
+
+static inline mi_slice_t* mi_slice_first(const mi_slice_t* slice) {
+ mi_slice_t* start = (mi_slice_t*)((uint8_t*)slice - slice->slice_offset);
+ mi_assert_internal(start >= _mi_ptr_segment(slice)->slices);
+ mi_assert_internal(start->slice_offset == 0);
+ mi_assert_internal(start + start->slice_count > slice);
+ return start;
+}
+
+// Get the page containing the pointer
+static inline mi_page_t* _mi_segment_page_of(const mi_segment_t* segment, const void* p) {
+ ptrdiff_t diff = (uint8_t*)p - (uint8_t*)segment;
+ mi_assert_internal(diff >= 0 && diff < (ptrdiff_t)MI_SEGMENT_SIZE);
+ size_t idx = (size_t)diff >> MI_SEGMENT_SLICE_SHIFT;
+ mi_assert_internal(idx < segment->slice_entries);
+ mi_slice_t* slice0 = (mi_slice_t*)&segment->slices[idx];
+ mi_slice_t* slice = mi_slice_first(slice0); // adjust to the block that holds the page data
+ mi_assert_internal(slice->slice_offset == 0);
+ mi_assert_internal(slice >= segment->slices && slice < segment->slices + segment->slice_entries);
+ return mi_slice_to_page(slice);
+}
+
+// Quick page start for initialized pages
+static inline uint8_t* _mi_page_start(const mi_segment_t* segment, const mi_page_t* page, size_t* page_size) {
+ return _mi_segment_page_start(segment, page, page_size);
+}
+
+// Get the page containing the pointer
+static inline mi_page_t* _mi_ptr_page(void* p) {
+ return _mi_segment_page_of(_mi_ptr_segment(p), p);
+}
+
+// Get the block size of a page (special case for huge objects)
+static inline size_t mi_page_block_size(const mi_page_t* page) {
+ const size_t bsize = page->xblock_size;
+ mi_assert_internal(bsize > 0);
+ if (mi_likely(bsize < MI_HUGE_BLOCK_SIZE)) {
+ return bsize;
+ }
+ else {
+ size_t psize;
+ _mi_segment_page_start(_mi_page_segment(page), page, &psize);
+ return psize;
+ }
+}
+
+// Get the usable block size of a page without fixed padding.
+// This may still include internal padding due to alignment and rounding up size classes.
+static inline size_t mi_page_usable_block_size(const mi_page_t* page) {
+ return mi_page_block_size(page) - MI_PADDING_SIZE;
+}
+
+// size of a segment
+static inline size_t mi_segment_size(mi_segment_t* segment) {
+ return segment->segment_slices * MI_SEGMENT_SLICE_SIZE;
+}
+
+static inline uint8_t* mi_segment_end(mi_segment_t* segment) {
+ return (uint8_t*)segment + mi_segment_size(segment);
+}
+
+// Thread free access
+static inline mi_block_t* mi_page_thread_free(const mi_page_t* page) {
+ return (mi_block_t*)(mi_atomic_load_relaxed(&((mi_page_t*)page)->xthread_free) & ~3);
+}
+
+static inline mi_delayed_t mi_page_thread_free_flag(const mi_page_t* page) {
+ return (mi_delayed_t)(mi_atomic_load_relaxed(&((mi_page_t*)page)->xthread_free) & 3);
+}
+
+// Heap access
+static inline mi_heap_t* mi_page_heap(const mi_page_t* page) {
+ return (mi_heap_t*)(mi_atomic_load_relaxed(&((mi_page_t*)page)->xheap));
+}
+
+static inline void mi_page_set_heap(mi_page_t* page, mi_heap_t* heap) {
+ mi_assert_internal(mi_page_thread_free_flag(page) != MI_DELAYED_FREEING);
+ mi_atomic_store_release(&page->xheap,(uintptr_t)heap);
+}
+
+// Thread free flag helpers
+static inline mi_block_t* mi_tf_block(mi_thread_free_t tf) {
+ return (mi_block_t*)(tf & ~0x03);
+}
+static inline mi_delayed_t mi_tf_delayed(mi_thread_free_t tf) {
+ return (mi_delayed_t)(tf & 0x03);
+}
+static inline mi_thread_free_t mi_tf_make(mi_block_t* block, mi_delayed_t delayed) {
+ return (mi_thread_free_t)((uintptr_t)block | (uintptr_t)delayed);
+}
+static inline mi_thread_free_t mi_tf_set_delayed(mi_thread_free_t tf, mi_delayed_t delayed) {
+ return mi_tf_make(mi_tf_block(tf),delayed);
+}
+static inline mi_thread_free_t mi_tf_set_block(mi_thread_free_t tf, mi_block_t* block) {
+ return mi_tf_make(block, mi_tf_delayed(tf));
+}
+
+// are all blocks in a page freed?
+// note: needs up-to-date used count, (as the `xthread_free` list may not be empty). see `_mi_page_collect_free`.
+static inline bool mi_page_all_free(const mi_page_t* page) {
+ mi_assert_internal(page != NULL);
+ return (page->used == 0);
+}
+
+// are there any available blocks?
+static inline bool mi_page_has_any_available(const mi_page_t* page) {
+ mi_assert_internal(page != NULL && page->reserved > 0);
+ return (page->used < page->reserved || (mi_page_thread_free(page) != NULL));
+}
+
+// are there immediately available blocks, i.e. blocks available on the free list.
+static inline bool mi_page_immediate_available(const mi_page_t* page) {
+ mi_assert_internal(page != NULL);
+ return (page->free != NULL);
+}
+
+// is more than 7/8th of a page in use?
+static inline bool mi_page_mostly_used(const mi_page_t* page) {
+ if (page==NULL) return true;
+ uint16_t frac = page->reserved / 8U;
+ return (page->reserved - page->used <= frac);
+}
+
+static inline mi_page_queue_t* mi_page_queue(const mi_heap_t* heap, size_t size) {
+ return &((mi_heap_t*)heap)->pages[_mi_bin(size)];
+}
+
+
+
+//-----------------------------------------------------------
+// Page flags
+//-----------------------------------------------------------
+static inline bool mi_page_is_in_full(const mi_page_t* page) {
+ return page->flags.x.in_full;
+}
+
+static inline void mi_page_set_in_full(mi_page_t* page, bool in_full) {
+ page->flags.x.in_full = in_full;
+}
+
+static inline bool mi_page_has_aligned(const mi_page_t* page) {
+ return page->flags.x.has_aligned;
+}
+
+static inline void mi_page_set_has_aligned(mi_page_t* page, bool has_aligned) {
+ page->flags.x.has_aligned = has_aligned;
+}
+
+
+/* -------------------------------------------------------------------
+Encoding/Decoding the free list next pointers
+
+This is to protect against buffer overflow exploits where the
+free list is mutated. Many hardened allocators xor the next pointer `p`
+with a secret key `k1`, as `p^k1`. This prevents overwriting with known
+values but might be still too weak: if the attacker can guess
+the pointer `p` this can reveal `k1` (since `p^k1^p == k1`).
+Moreover, if multiple blocks can be read as well, the attacker can
+xor both as `(p1^k1) ^ (p2^k1) == p1^p2` which may reveal a lot
+about the pointers (and subsequently `k1`).
+
+Instead mimalloc uses an extra key `k2` and encodes as `((p^k2)<<<k1)+k1`.
+Since these operations are not associative, the above approaches do not
+work so well any more even if the `p` can be guesstimated. For example,
+for the read case we can subtract two entries to discard the `+k1` term,
+but that leads to `((p1^k2)<<<k1) - ((p2^k2)<<<k1)` at best.
+We include the left-rotation since xor and addition are otherwise linear
+in the lowest bit. Finally, both keys are unique per page which reduces
+the re-use of keys by a large factor.
+
+We also pass a separate `null` value to be used as `NULL` or otherwise
+`(k2<<<k1)+k1` would appear (too) often as a sentinel value.
+------------------------------------------------------------------- */
+
+static inline bool mi_is_in_same_segment(const void* p, const void* q) {
+ return (_mi_ptr_segment(p) == _mi_ptr_segment(q));
+}
+
+static inline bool mi_is_in_same_page(const void* p, const void* q) {
+ mi_segment_t* segment = _mi_ptr_segment(p);
+ if (_mi_ptr_segment(q) != segment) return false;
+ // assume q may be invalid // return (_mi_segment_page_of(segment, p) == _mi_segment_page_of(segment, q));
+ mi_page_t* page = _mi_segment_page_of(segment, p);
+ size_t psize;
+ uint8_t* start = _mi_segment_page_start(segment, page, &psize);
+ return (start <= (uint8_t*)q && (uint8_t*)q < start + psize);
+}
+
+static inline uintptr_t mi_rotl(uintptr_t x, uintptr_t shift) {
+ shift %= MI_INTPTR_BITS;
+ return (shift==0 ? x : ((x << shift) | (x >> (MI_INTPTR_BITS - shift))));
+}
+static inline uintptr_t mi_rotr(uintptr_t x, uintptr_t shift) {
+ shift %= MI_INTPTR_BITS;
+ return (shift==0 ? x : ((x >> shift) | (x << (MI_INTPTR_BITS - shift))));
+}
+
+static inline void* mi_ptr_decode(const void* null, const mi_encoded_t x, const uintptr_t* keys) {
+ void* p = (void*)(mi_rotr(x - keys[0], keys[0]) ^ keys[1]);
+ return (mi_unlikely(p==null) ? NULL : p);
+}
+
+static inline mi_encoded_t mi_ptr_encode(const void* null, const void* p, const uintptr_t* keys) {
+ uintptr_t x = (uintptr_t)(mi_unlikely(p==NULL) ? null : p);
+ return mi_rotl(x ^ keys[1], keys[0]) + keys[0];
+}
+
+static inline mi_block_t* mi_block_nextx( const void* null, const mi_block_t* block, const uintptr_t* keys ) {
+ #ifdef MI_ENCODE_FREELIST
+ return (mi_block_t*)mi_ptr_decode(null, block->next, keys);
+ #else
+ MI_UNUSED(keys); MI_UNUSED(null);
+ return (mi_block_t*)block->next;
+ #endif
+}
+
+static inline void mi_block_set_nextx(const void* null, mi_block_t* block, const mi_block_t* next, const uintptr_t* keys) {
+ #ifdef MI_ENCODE_FREELIST
+ block->next = mi_ptr_encode(null, next, keys);
+ #else
+ MI_UNUSED(keys); MI_UNUSED(null);
+ block->next = (mi_encoded_t)next;
+ #endif
+}
+
+static inline mi_block_t* mi_block_next(const mi_page_t* page, const mi_block_t* block) {
+ #ifdef MI_ENCODE_FREELIST
+ mi_block_t* next = mi_block_nextx(page,block,page->keys);
+ // check for free list corruption: is `next` at least in the same page?
+ // TODO: check if `next` is `page->block_size` aligned?
+ if (mi_unlikely(next!=NULL && !mi_is_in_same_page(block, next))) {
+ _mi_error_message(EFAULT, "corrupted free list entry of size %zub at %p: value 0x%zx\n", mi_page_block_size(page), block, (uintptr_t)next);
+ next = NULL;
+ }
+ return next;
+ #else
+ MI_UNUSED(page);
+ return mi_block_nextx(page,block,NULL);
+ #endif
+}
+
+static inline void mi_block_set_next(const mi_page_t* page, mi_block_t* block, const mi_block_t* next) {
+ #ifdef MI_ENCODE_FREELIST
+ mi_block_set_nextx(page,block,next, page->keys);
+ #else
+ MI_UNUSED(page);
+ mi_block_set_nextx(page,block,next,NULL);
+ #endif
+}
+
+
+// -------------------------------------------------------------------
+// commit mask
+// -------------------------------------------------------------------
+
+static inline void mi_commit_mask_create_empty(mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ cm->mask[i] = 0;
+ }
+}
+
+static inline void mi_commit_mask_create_full(mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ cm->mask[i] = ~((size_t)0);
+ }
+}
+
+static inline bool mi_commit_mask_is_empty(const mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ if (cm->mask[i] != 0) return false;
+ }
+ return true;
+}
+
+static inline bool mi_commit_mask_is_full(const mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ if (cm->mask[i] != ~((size_t)0)) return false;
+ }
+ return true;
+}
+
+// defined in `segment.c`:
+size_t _mi_commit_mask_committed_size(const mi_commit_mask_t* cm, size_t total);
+size_t _mi_commit_mask_next_run(const mi_commit_mask_t* cm, size_t* idx);
+
+#define mi_commit_mask_foreach(cm,idx,count) \
+ idx = 0; \
+ while ((count = _mi_commit_mask_next_run(cm,&idx)) > 0) {
+
+#define mi_commit_mask_foreach_end() \
+ idx += count; \
+ }
+
+
+
+
+// -------------------------------------------------------------------
+// Fast "random" shuffle
+// -------------------------------------------------------------------
+
+static inline uintptr_t _mi_random_shuffle(uintptr_t x) {
+ if (x==0) { x = 17; } // ensure we don't get stuck in generating zeros
+#if (MI_INTPTR_SIZE==8)
+ // by Sebastiano Vigna, see: <http://xoshiro.di.unimi.it/splitmix64.c>
+ x ^= x >> 30;
+ x *= 0xbf58476d1ce4e5b9UL;
+ x ^= x >> 27;
+ x *= 0x94d049bb133111ebUL;
+ x ^= x >> 31;
+#elif (MI_INTPTR_SIZE==4)
+ // by Chris Wellons, see: <https://nullprogram.com/blog/2018/07/31/>
+ x ^= x >> 16;
+ x *= 0x7feb352dUL;
+ x ^= x >> 15;
+ x *= 0x846ca68bUL;
+ x ^= x >> 16;
+#endif
+ return x;
+}
+
+// -------------------------------------------------------------------
+// Optimize numa node access for the common case (= one node)
+// -------------------------------------------------------------------
+
+int _mi_os_numa_node_get(mi_os_tld_t* tld);
+size_t _mi_os_numa_node_count_get(void);
+
+extern _Atomic(size_t) _mi_numa_node_count;
+static inline int _mi_os_numa_node(mi_os_tld_t* tld) {
+ if (mi_likely(mi_atomic_load_relaxed(&_mi_numa_node_count) == 1)) return 0;
+ else return _mi_os_numa_node_get(tld);
+}
+static inline size_t _mi_os_numa_node_count(void) {
+ const size_t count = mi_atomic_load_relaxed(&_mi_numa_node_count);
+ if (mi_likely(count>0)) return count;
+ else return _mi_os_numa_node_count_get();
+}
+
+
+// -------------------------------------------------------------------
+// Getting the thread id should be performant as it is called in the
+// fast path of `_mi_free` and we specialize for various platforms.
+// We only require _mi_threadid() to return a unique id for each thread.
+// -------------------------------------------------------------------
+#if defined(_WIN32)
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+static inline mi_threadid_t _mi_thread_id(void) mi_attr_noexcept {
+ // Windows: works on Intel and ARM in both 32- and 64-bit
+ return (uintptr_t)NtCurrentTeb();
+}
+
+// We use assembly for a fast thread id on the main platforms. The TLS layout depends on
+// both the OS and libc implementation so we use specific tests for each main platform.
+// If you test on another platform and it works please send a PR :-)
+// see also https://akkadia.org/drepper/tls.pdf for more info on the TLS register.
+#elif defined(__GNUC__) && ( \
+ (defined(__GLIBC__) && (defined(__x86_64__) || defined(__i386__) || defined(__arm__) || defined(__aarch64__))) \
+ || (defined(__APPLE__) && (defined(__x86_64__) || defined(__aarch64__))) \
+ || (defined(__BIONIC__) && (defined(__x86_64__) || defined(__i386__) || defined(__arm__) || defined(__aarch64__))) \
+ || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__) || defined(__aarch64__))) \
+ || (defined(__OpenBSD__) && (defined(__x86_64__) || defined(__i386__) || defined(__aarch64__))) \
+ )
+
+static inline void* mi_tls_slot(size_t slot) mi_attr_noexcept {
+ void* res;
+ const size_t ofs = (slot*sizeof(void*));
+ #if defined(__i386__)
+ __asm__("movl %%gs:%1, %0" : "=r" (res) : "m" (*((void**)ofs)) : ); // x86 32-bit always uses GS
+ #elif defined(__APPLE__) && defined(__x86_64__)
+ __asm__("movq %%gs:%1, %0" : "=r" (res) : "m" (*((void**)ofs)) : ); // x86_64 macOSX uses GS
+ #elif defined(__x86_64__) && (MI_INTPTR_SIZE==4)
+ __asm__("movl %%fs:%1, %0" : "=r" (res) : "m" (*((void**)ofs)) : ); // x32 ABI
+ #elif defined(__x86_64__)
+ __asm__("movq %%fs:%1, %0" : "=r" (res) : "m" (*((void**)ofs)) : ); // x86_64 Linux, BSD uses FS
+ #elif defined(__arm__)
+ void** tcb; MI_UNUSED(ofs);
+ __asm__ volatile ("mrc p15, 0, %0, c13, c0, 3\nbic %0, %0, #3" : "=r" (tcb));
+ res = tcb[slot];
+ #elif defined(__aarch64__)
+ void** tcb; MI_UNUSED(ofs);
+ #if defined(__APPLE__) // M1, issue #343
+ __asm__ volatile ("mrs %0, tpidrro_el0\nbic %0, %0, #7" : "=r" (tcb));
+ #else
+ __asm__ volatile ("mrs %0, tpidr_el0" : "=r" (tcb));
+ #endif
+ res = tcb[slot];
+ #endif
+ return res;
+}
+
+// setting a tls slot is only used on macOS for now
+static inline void mi_tls_slot_set(size_t slot, void* value) mi_attr_noexcept {
+ const size_t ofs = (slot*sizeof(void*));
+ #if defined(__i386__)
+ __asm__("movl %1,%%gs:%0" : "=m" (*((void**)ofs)) : "rn" (value) : ); // 32-bit always uses GS
+ #elif defined(__APPLE__) && defined(__x86_64__)
+ __asm__("movq %1,%%gs:%0" : "=m" (*((void**)ofs)) : "rn" (value) : ); // x86_64 macOS uses GS
+ #elif defined(__x86_64__) && (MI_INTPTR_SIZE==4)
+ __asm__("movl %1,%%fs:%0" : "=m" (*((void**)ofs)) : "rn" (value) : ); // x32 ABI
+ #elif defined(__x86_64__)
+ __asm__("movq %1,%%fs:%0" : "=m" (*((void**)ofs)) : "rn" (value) : ); // x86_64 Linux, BSD uses FS
+ #elif defined(__arm__)
+ void** tcb; MI_UNUSED(ofs);
+ __asm__ volatile ("mrc p15, 0, %0, c13, c0, 3\nbic %0, %0, #3" : "=r" (tcb));
+ tcb[slot] = value;
+ #elif defined(__aarch64__)
+ void** tcb; MI_UNUSED(ofs);
+ #if defined(__APPLE__) // M1, issue #343
+ __asm__ volatile ("mrs %0, tpidrro_el0\nbic %0, %0, #7" : "=r" (tcb));
+ #else
+ __asm__ volatile ("mrs %0, tpidr_el0" : "=r" (tcb));
+ #endif
+ tcb[slot] = value;
+ #endif
+}
+
+static inline mi_threadid_t _mi_thread_id(void) mi_attr_noexcept {
+ #if defined(__BIONIC__)
+ // issue #384, #495: on the Bionic libc (Android), slot 1 is the thread id
+ // see: https://github.com/aosp-mirror/platform_bionic/blob/c44b1d0676ded732df4b3b21c5f798eacae93228/libc/platform/bionic/tls_defines.h#L86
+ return (uintptr_t)mi_tls_slot(1);
+ #else
+ // in all our other targets, slot 0 is the thread id
+ // glibc: https://sourceware.org/git/?p=glibc.git;a=blob_plain;f=sysdeps/x86_64/nptl/tls.h
+ // apple: https://github.com/apple/darwin-xnu/blob/main/libsyscall/os/tsd.h#L36
+ return (uintptr_t)mi_tls_slot(0);
+ #endif
+}
+
+#else
+
+// otherwise use portable C, taking the address of a thread local variable (this is still very fast on most platforms).
+static inline mi_threadid_t _mi_thread_id(void) mi_attr_noexcept {
+ return (uintptr_t)&_mi_heap_default;
+}
+
+#endif
+
+
+// -----------------------------------------------------------------------
+// Count bits: trailing or leading zeros (with MI_INTPTR_BITS on all zero)
+// -----------------------------------------------------------------------
+
+#if defined(__GNUC__)
+
+#include <limits.h> // LONG_MAX
+#define MI_HAVE_FAST_BITSCAN
+static inline size_t mi_clz(uintptr_t x) {
+ if (x==0) return MI_INTPTR_BITS;
+#if (INTPTR_MAX == LONG_MAX)
+ return __builtin_clzl(x);
+#else
+ return __builtin_clzll(x);
+#endif
+}
+static inline size_t mi_ctz(uintptr_t x) {
+ if (x==0) return MI_INTPTR_BITS;
+#if (INTPTR_MAX == LONG_MAX)
+ return __builtin_ctzl(x);
+#else
+ return __builtin_ctzll(x);
+#endif
+}
+
+#elif defined(_MSC_VER)
+
+#include <limits.h> // LONG_MAX
+#define MI_HAVE_FAST_BITSCAN
+static inline size_t mi_clz(uintptr_t x) {
+ if (x==0) return MI_INTPTR_BITS;
+ unsigned long idx;
+#if (INTPTR_MAX == LONG_MAX)
+ _BitScanReverse(&idx, x);
+#else
+ _BitScanReverse64(&idx, x);
+#endif
+ return ((MI_INTPTR_BITS - 1) - idx);
+}
+static inline size_t mi_ctz(uintptr_t x) {
+ if (x==0) return MI_INTPTR_BITS;
+ unsigned long idx;
+#if (INTPTR_MAX == LONG_MAX)
+ _BitScanForward(&idx, x);
+#else
+ _BitScanForward64(&idx, x);
+#endif
+ return idx;
+}
+
+#else
+static inline size_t mi_ctz32(uint32_t x) {
+ // de Bruijn multiplication, see <http://supertech.csail.mit.edu/papers/debruijn.pdf>
+ static const unsigned char debruijn[32] = {
+ 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,
+ 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
+ };
+ if (x==0) return 32;
+ return debruijn[((x & -(int32_t)x) * 0x077CB531UL) >> 27];
+}
+static inline size_t mi_clz32(uint32_t x) {
+ // de Bruijn multiplication, see <http://supertech.csail.mit.edu/papers/debruijn.pdf>
+ static const uint8_t debruijn[32] = {
+ 31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1,
+ 23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0
+ };
+ if (x==0) return 32;
+ x |= x >> 1;
+ x |= x >> 2;
+ x |= x >> 4;
+ x |= x >> 8;
+ x |= x >> 16;
+ return debruijn[(uint32_t)(x * 0x07C4ACDDUL) >> 27];
+}
+
+static inline size_t mi_clz(uintptr_t x) {
+ if (x==0) return MI_INTPTR_BITS;
+#if (MI_INTPTR_BITS <= 32)
+ return mi_clz32((uint32_t)x);
+#else
+ size_t count = mi_clz32((uint32_t)(x >> 32));
+ if (count < 32) return count;
+ return (32 + mi_clz32((uint32_t)x));
+#endif
+}
+static inline size_t mi_ctz(uintptr_t x) {
+ if (x==0) return MI_INTPTR_BITS;
+#if (MI_INTPTR_BITS <= 32)
+ return mi_ctz32((uint32_t)x);
+#else
+ size_t count = mi_ctz32((uint32_t)x);
+ if (count < 32) return count;
+ return (32 + mi_ctz32((uint32_t)(x>>32)));
+#endif
+}
+
+#endif
+
+// "bit scan reverse": Return index of the highest bit (or MI_INTPTR_BITS if `x` is zero)
+static inline size_t mi_bsr(uintptr_t x) {
+ return (x==0 ? MI_INTPTR_BITS : MI_INTPTR_BITS - 1 - mi_clz(x));
+}
+
+
+// ---------------------------------------------------------------------------------
+// Provide our own `_mi_memcpy` for potential performance optimizations.
+//
+// For now, only on Windows with msvc/clang-cl we optimize to `rep movsb` if
+// we happen to run on x86/x64 cpu's that have "fast short rep movsb" (FSRM) support
+// (AMD Zen3+ (~2020) or Intel Ice Lake+ (~2017). See also issue #201 and pr #253.
+// ---------------------------------------------------------------------------------
+
+#if defined(_WIN32) && (defined(_M_IX86) || defined(_M_X64))
+#include <intrin.h>
+#include <string.h>
+extern bool _mi_cpu_has_fsrm;
+static inline void _mi_memcpy(void* dst, const void* src, size_t n) {
+ if (_mi_cpu_has_fsrm) {
+ __movsb((unsigned char*)dst, (const unsigned char*)src, n);
+ }
+ else {
+ memcpy(dst, src, n); // todo: use noinline?
+ }
+}
+#else
+#include <string.h>
+static inline void _mi_memcpy(void* dst, const void* src, size_t n) {
+ memcpy(dst, src, n);
+}
+#endif
+
+
+// -------------------------------------------------------------------------------
+// The `_mi_memcpy_aligned` can be used if the pointers are machine-word aligned
+// This is used for example in `mi_realloc`.
+// -------------------------------------------------------------------------------
+
+#if (defined(__GNUC__) && (__GNUC__ >= 4)) || defined(__clang__)
+// On GCC/CLang we provide a hint that the pointers are word aligned.
+#include <string.h>
+static inline void _mi_memcpy_aligned(void* dst, const void* src, size_t n) {
+ mi_assert_internal(((uintptr_t)dst % MI_INTPTR_SIZE == 0) && ((uintptr_t)src % MI_INTPTR_SIZE == 0));
+ void* adst = __builtin_assume_aligned(dst, MI_INTPTR_SIZE);
+ const void* asrc = __builtin_assume_aligned(src, MI_INTPTR_SIZE);
+ _mi_memcpy(adst, asrc, n);
+}
+#else
+// Default fallback on `_mi_memcpy`
+static inline void _mi_memcpy_aligned(void* dst, const void* src, size_t n) {
+ mi_assert_internal(((uintptr_t)dst % MI_INTPTR_SIZE == 0) && ((uintptr_t)src % MI_INTPTR_SIZE == 0));
+ _mi_memcpy(dst, src, n);
+}
+#endif
+
+
+#endif
diff --git a/source/luametatex/source/libraries/mimalloc/include/mimalloc-new-delete.h b/source/luametatex/source/libraries/mimalloc/include/mimalloc-new-delete.h
new file mode 100644
index 000000000..2749a0be9
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/include/mimalloc-new-delete.h
@@ -0,0 +1,57 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2020 Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#pragma once
+#ifndef MIMALLOC_NEW_DELETE_H
+#define MIMALLOC_NEW_DELETE_H
+
+// ----------------------------------------------------------------------------
+// This header provides convenient overrides for the new and
+// delete operations in C++.
+//
+// This header should be included in only one source file!
+//
+// On Windows, or when linking dynamically with mimalloc, these
+// can be more performant than the standard new-delete operations.
+// See <https://en.cppreference.com/w/cpp/memory/new/operator_new>
+// ---------------------------------------------------------------------------
+#if defined(__cplusplus)
+ #include <new>
+ #include <mimalloc.h>
+
+ void operator delete(void* p) noexcept { mi_free(p); };
+ void operator delete[](void* p) noexcept { mi_free(p); };
+
+ void operator delete (void* p, const std::nothrow_t&) noexcept { mi_free(p); }
+ void operator delete[](void* p, const std::nothrow_t&) noexcept { mi_free(p); }
+
+ void* operator new(std::size_t n) noexcept(false) { return mi_new(n); }
+ void* operator new[](std::size_t n) noexcept(false) { return mi_new(n); }
+
+ void* operator new (std::size_t n, const std::nothrow_t& tag) noexcept { (void)(tag); return mi_new_nothrow(n); }
+ void* operator new[](std::size_t n, const std::nothrow_t& tag) noexcept { (void)(tag); return mi_new_nothrow(n); }
+
+ #if (__cplusplus >= 201402L || _MSC_VER >= 1916)
+ void operator delete (void* p, std::size_t n) noexcept { mi_free_size(p,n); };
+ void operator delete[](void* p, std::size_t n) noexcept { mi_free_size(p,n); };
+ #endif
+
+ #if (__cplusplus > 201402L || defined(__cpp_aligned_new))
+ void operator delete (void* p, std::align_val_t al) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+ void operator delete[](void* p, std::align_val_t al) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+ void operator delete (void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast<size_t>(al)); };
+ void operator delete[](void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast<size_t>(al)); };
+ void operator delete (void* p, std::align_val_t al, const std::nothrow_t& tag) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+ void operator delete[](void* p, std::align_val_t al, const std::nothrow_t& tag) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+
+ void* operator new (std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast<size_t>(al)); }
+ void* operator new[](std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast<size_t>(al)); }
+ void* operator new (std::size_t n, std::align_val_t al, const std::nothrow_t&) noexcept { return mi_new_aligned_nothrow(n, static_cast<size_t>(al)); }
+ void* operator new[](std::size_t n, std::align_val_t al, const std::nothrow_t&) noexcept { return mi_new_aligned_nothrow(n, static_cast<size_t>(al)); }
+ #endif
+#endif
+
+#endif // MIMALLOC_NEW_DELETE_H
diff --git a/source/luametatex/source/libraries/mimalloc/include/mimalloc-override.h b/source/luametatex/source/libraries/mimalloc/include/mimalloc-override.h
new file mode 100644
index 000000000..c63b0b91a
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/include/mimalloc-override.h
@@ -0,0 +1,67 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2020 Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#pragma once
+#ifndef MIMALLOC_OVERRIDE_H
+#define MIMALLOC_OVERRIDE_H
+
+/* ----------------------------------------------------------------------------
+This header can be used to statically redirect malloc/free and new/delete
+to the mimalloc variants. This can be useful if one can include this file on
+each source file in a project (but be careful when using external code to
+not accidentally mix pointers from different allocators).
+-----------------------------------------------------------------------------*/
+
+#include <mimalloc.h>
+
+// Standard C allocation
+#define malloc(n) mi_malloc(n)
+#define calloc(n,c) mi_calloc(n,c)
+#define realloc(p,n) mi_realloc(p,n)
+#define free(p) mi_free(p)
+
+#define strdup(s) mi_strdup(s)
+#define strndup(s,n) mi_strndup(s,n)
+#define realpath(f,n) mi_realpath(f,n)
+
+// Microsoft extensions
+#define _expand(p,n) mi_expand(p,n)
+#define _msize(p) mi_usable_size(p)
+#define _recalloc(p,n,c) mi_recalloc(p,n,c)
+
+#define _strdup(s) mi_strdup(s)
+#define _strndup(s,n) mi_strndup(s,n)
+#define _wcsdup(s) (wchar_t*)mi_wcsdup((const unsigned short*)(s))
+#define _mbsdup(s) mi_mbsdup(s)
+#define _dupenv_s(b,n,v) mi_dupenv_s(b,n,v)
+#define _wdupenv_s(b,n,v) mi_wdupenv_s((unsigned short*)(b),n,(const unsigned short*)(v))
+
+// Various Posix and Unix variants
+#define reallocf(p,n) mi_reallocf(p,n)
+#define malloc_size(p) mi_usable_size(p)
+#define malloc_usable_size(p) mi_usable_size(p)
+#define cfree(p) mi_free(p)
+
+#define valloc(n) mi_valloc(n)
+#define pvalloc(n) mi_pvalloc(n)
+#define reallocarray(p,s,n) mi_reallocarray(p,s,n)
+#define reallocarr(p,s,n) mi_reallocarr(p,s,n)
+#define memalign(a,n) mi_memalign(a,n)
+#define aligned_alloc(a,n) mi_aligned_alloc(a,n)
+#define posix_memalign(p,a,n) mi_posix_memalign(p,a,n)
+#define _posix_memalign(p,a,n) mi_posix_memalign(p,a,n)
+
+// Microsoft aligned variants
+#define _aligned_malloc(n,a) mi_malloc_aligned(n,a)
+#define _aligned_realloc(p,n,a) mi_realloc_aligned(p,n,a)
+#define _aligned_recalloc(p,s,n,a) mi_aligned_recalloc(p,s,n,a)
+#define _aligned_msize(p,a,o) mi_usable_size(p)
+#define _aligned_free(p) mi_free(p)
+#define _aligned_offset_malloc(n,a,o) mi_malloc_aligned_at(n,a,o)
+#define _aligned_offset_realloc(p,n,a,o) mi_realloc_aligned_at(p,n,a,o)
+#define _aligned_offset_recalloc(p,s,n,a,o) mi_recalloc_aligned_at(p,s,n,a,o)
+
+#endif // MIMALLOC_OVERRIDE_H
diff --git a/source/luametatex/source/libraries/mimalloc/include/mimalloc-types.h b/source/luametatex/source/libraries/mimalloc/include/mimalloc-types.h
new file mode 100644
index 000000000..fb75ea464
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/include/mimalloc-types.h
@@ -0,0 +1,598 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#pragma once
+#ifndef MIMALLOC_TYPES_H
+#define MIMALLOC_TYPES_H
+
+#include <stddef.h> // ptrdiff_t
+#include <stdint.h> // uintptr_t, uint16_t, etc
+#include "mimalloc-atomic.h" // _Atomic
+
+#ifdef _MSC_VER
+#pragma warning(disable:4214) // bitfield is not int
+#endif
+
+// Minimal alignment necessary. On most platforms 16 bytes are needed
+// due to SSE registers for example. This must be at least `sizeof(void*)`
+#ifndef MI_MAX_ALIGN_SIZE
+#define MI_MAX_ALIGN_SIZE 16 // sizeof(max_align_t)
+#endif
+
+// ------------------------------------------------------
+// Variants
+// ------------------------------------------------------
+
+// Define NDEBUG in the release version to disable assertions.
+// #define NDEBUG
+
+// Define MI_STAT as 1 to maintain statistics; set it to 2 to have detailed statistics (but costs some performance).
+// #define MI_STAT 1
+
+// Define MI_SECURE to enable security mitigations
+// #define MI_SECURE 1 // guard page around metadata
+// #define MI_SECURE 2 // guard page around each mimalloc page
+// #define MI_SECURE 3 // encode free lists (detect corrupted free list (buffer overflow), and invalid pointer free)
+// #define MI_SECURE 4 // checks for double free. (may be more expensive)
+
+#if !defined(MI_SECURE)
+#define MI_SECURE 0
+#endif
+
+// Define MI_DEBUG for debug mode
+// #define MI_DEBUG 1 // basic assertion checks and statistics, check double free, corrupted free list, and invalid pointer free.
+// #define MI_DEBUG 2 // + internal assertion checks
+// #define MI_DEBUG 3 // + extensive internal invariant checking (cmake -DMI_DEBUG_FULL=ON)
+#if !defined(MI_DEBUG)
+#if !defined(NDEBUG) || defined(_DEBUG)
+#define MI_DEBUG 2
+#else
+#define MI_DEBUG 0
+#endif
+#endif
+
+// Reserve extra padding at the end of each block to be more resilient against heap block overflows.
+// The padding can detect byte-precise buffer overflow on free.
+#if !defined(MI_PADDING) && (MI_DEBUG>=1)
+#define MI_PADDING 1
+#endif
+
+
+// Encoded free lists allow detection of corrupted free lists
+// and can detect buffer overflows, modify after free, and double `free`s.
+#if (MI_SECURE>=3 || MI_DEBUG>=1 || MI_PADDING > 0)
+#define MI_ENCODE_FREELIST 1
+#endif
+
+
+// ------------------------------------------------------
+// Platform specific values
+// ------------------------------------------------------
+
+// ------------------------------------------------------
+// Size of a pointer.
+// We assume that `sizeof(void*)==sizeof(intptr_t)`
+// and it holds for all platforms we know of.
+//
+// However, the C standard only requires that:
+// p == (void*)((intptr_t)p))
+// but we also need:
+// i == (intptr_t)((void*)i)
+// or otherwise one might define an intptr_t type that is larger than a pointer...
+// ------------------------------------------------------
+
+#if INTPTR_MAX > INT64_MAX
+# define MI_INTPTR_SHIFT (4) // assume 128-bit (as on arm CHERI for example)
+#elif INTPTR_MAX == INT64_MAX
+# define MI_INTPTR_SHIFT (3)
+#elif INTPTR_MAX == INT32_MAX
+# define MI_INTPTR_SHIFT (2)
+#else
+#error platform pointers must be 32, 64, or 128 bits
+#endif
+
+#if SIZE_MAX == UINT64_MAX
+# define MI_SIZE_SHIFT (3)
+typedef int64_t mi_ssize_t;
+#elif SIZE_MAX == UINT32_MAX
+# define MI_SIZE_SHIFT (2)
+typedef int32_t mi_ssize_t;
+#else
+#error platform objects must be 32 or 64 bits
+#endif
+
+#if (SIZE_MAX/2) > LONG_MAX
+# define MI_ZU(x) x##ULL
+# define MI_ZI(x) x##LL
+#else
+# define MI_ZU(x) x##UL
+# define MI_ZI(x) x##L
+#endif
+
+#define MI_INTPTR_SIZE (1<<MI_INTPTR_SHIFT)
+#define MI_INTPTR_BITS (MI_INTPTR_SIZE*8)
+
+#define MI_SIZE_SIZE (1<<MI_SIZE_SHIFT)
+#define MI_SIZE_BITS (MI_SIZE_SIZE*8)
+
+#define MI_KiB (MI_ZU(1024))
+#define MI_MiB (MI_KiB*MI_KiB)
+#define MI_GiB (MI_MiB*MI_KiB)
+
+
+// ------------------------------------------------------
+// Main internal data-structures
+// ------------------------------------------------------
+
+// Main tuning parameters for segment and page sizes
+// Sizes for 64-bit (usually divide by two for 32-bit)
+#define MI_SEGMENT_SLICE_SHIFT (13 + MI_INTPTR_SHIFT) // 64KiB (32KiB on 32-bit)
+
+#if MI_INTPTR_SIZE > 4
+#define MI_SEGMENT_SHIFT (10 + MI_SEGMENT_SLICE_SHIFT) // 64MiB
+#else
+#define MI_SEGMENT_SHIFT ( 7 + MI_SEGMENT_SLICE_SHIFT) // 4MiB on 32-bit
+#endif
+
+#define MI_SMALL_PAGE_SHIFT (MI_SEGMENT_SLICE_SHIFT) // 64KiB
+#define MI_MEDIUM_PAGE_SHIFT ( 3 + MI_SMALL_PAGE_SHIFT) // 512KiB
+
+
+// Derived constants
+#define MI_SEGMENT_SIZE (MI_ZU(1)<<MI_SEGMENT_SHIFT)
+#define MI_SEGMENT_ALIGN MI_SEGMENT_SIZE
+#define MI_SEGMENT_MASK (MI_SEGMENT_SIZE - 1)
+#define MI_SEGMENT_SLICE_SIZE (MI_ZU(1)<< MI_SEGMENT_SLICE_SHIFT)
+#define MI_SLICES_PER_SEGMENT (MI_SEGMENT_SIZE / MI_SEGMENT_SLICE_SIZE) // 1024
+
+#define MI_SMALL_PAGE_SIZE (MI_ZU(1)<<MI_SMALL_PAGE_SHIFT)
+#define MI_MEDIUM_PAGE_SIZE (MI_ZU(1)<<MI_MEDIUM_PAGE_SHIFT)
+
+#define MI_SMALL_OBJ_SIZE_MAX (MI_SMALL_PAGE_SIZE/4) // 8KiB on 64-bit
+#define MI_MEDIUM_OBJ_SIZE_MAX (MI_MEDIUM_PAGE_SIZE/4) // 128KiB on 64-bit
+#define MI_MEDIUM_OBJ_WSIZE_MAX (MI_MEDIUM_OBJ_SIZE_MAX/MI_INTPTR_SIZE)
+#define MI_LARGE_OBJ_SIZE_MAX (MI_SEGMENT_SIZE/2) // 32MiB on 64-bit
+#define MI_LARGE_OBJ_WSIZE_MAX (MI_LARGE_OBJ_SIZE_MAX/MI_INTPTR_SIZE)
+
+// Maximum number of size classes. (spaced exponentially in 12.5% increments)
+#define MI_BIN_HUGE (73U)
+
+#if (MI_MEDIUM_OBJ_WSIZE_MAX >= 655360)
+#error "mimalloc internal: define more bins"
+#endif
+#if (MI_ALIGNMENT_MAX > MI_SEGMENT_SIZE/2)
+#error "mimalloc internal: the max aligned boundary is too large for the segment size"
+#endif
+#if (MI_ALIGNED_MAX % MI_SEGMENT_SLICE_SIZE != 0)
+#error "mimalloc internal: the max aligned boundary must be an integral multiple of the segment slice size"
+#endif
+
+// Maximum slice offset (15)
+#define MI_MAX_SLICE_OFFSET ((MI_ALIGNMENT_MAX / MI_SEGMENT_SLICE_SIZE) - 1)
+
+// Used as a special value to encode block sizes in 32 bits.
+#define MI_HUGE_BLOCK_SIZE ((uint32_t)(2*MI_GiB))
+
+// blocks up to this size are always allocated aligned
+#define MI_MAX_ALIGN_GUARANTEE (8*MI_MAX_ALIGN_SIZE)
+
+
+
+
+// ------------------------------------------------------
+// Mimalloc pages contain allocated blocks
+// ------------------------------------------------------
+
+// The free lists use encoded next fields
+// (Only actually encodes when MI_ENCODED_FREELIST is defined.)
+typedef uintptr_t mi_encoded_t;
+
+// thread id's
+typedef size_t mi_threadid_t;
+
+// free lists contain blocks
+typedef struct mi_block_s {
+ mi_encoded_t next;
+} mi_block_t;
+
+
+// The delayed flags are used for efficient multi-threaded free-ing
+typedef enum mi_delayed_e {
+ MI_USE_DELAYED_FREE = 0, // push on the owning heap thread delayed list
+ MI_DELAYED_FREEING = 1, // temporary: another thread is accessing the owning heap
+ MI_NO_DELAYED_FREE = 2, // optimize: push on page local thread free queue if another block is already in the heap thread delayed free list
+ MI_NEVER_DELAYED_FREE = 3 // sticky, only resets on page reclaim
+} mi_delayed_t;
+
+
+// The `in_full` and `has_aligned` page flags are put in a union to efficiently
+// test if both are false (`full_aligned == 0`) in the `mi_free` routine.
+#if !MI_TSAN
+typedef union mi_page_flags_s {
+ uint8_t full_aligned;
+ struct {
+ uint8_t in_full : 1;
+ uint8_t has_aligned : 1;
+ } x;
+} mi_page_flags_t;
+#else
+// under thread sanitizer, use a byte for each flag to suppress warning, issue #130
+typedef union mi_page_flags_s {
+ uint16_t full_aligned;
+ struct {
+ uint8_t in_full;
+ uint8_t has_aligned;
+ } x;
+} mi_page_flags_t;
+#endif
+
+// Thread free list.
+// We use the bottom 2 bits of the pointer for mi_delayed_t flags
+typedef uintptr_t mi_thread_free_t;
+
+// A page contains blocks of one specific size (`block_size`).
+// Each page has three list of free blocks:
+// `free` for blocks that can be allocated,
+// `local_free` for freed blocks that are not yet available to `mi_malloc`
+// `thread_free` for freed blocks by other threads
+// The `local_free` and `thread_free` lists are migrated to the `free` list
+// when it is exhausted. The separate `local_free` list is necessary to
+// implement a monotonic heartbeat. The `thread_free` list is needed for
+// avoiding atomic operations in the common case.
+//
+//
+// `used - |thread_free|` == actual blocks that are in use (alive)
+// `used - |thread_free| + |free| + |local_free| == capacity`
+//
+// We don't count `freed` (as |free|) but use `used` to reduce
+// the number of memory accesses in the `mi_page_all_free` function(s).
+//
+// Notes:
+// - Access is optimized for `mi_free` and `mi_page_alloc` (in `alloc.c`)
+// - Using `uint16_t` does not seem to slow things down
+// - The size is 8 words on 64-bit which helps the page index calculations
+// (and 10 words on 32-bit, and encoded free lists add 2 words. Sizes 10
+// and 12 are still good for address calculation)
+// - To limit the structure size, the `xblock_size` is 32-bits only; for
+// blocks > MI_HUGE_BLOCK_SIZE the size is determined from the segment page size
+// - `thread_free` uses the bottom bits as a delayed-free flags to optimize
+// concurrent frees where only the first concurrent free adds to the owning
+// heap `thread_delayed_free` list (see `alloc.c:mi_free_block_mt`).
+// The invariant is that no-delayed-free is only set if there is
+// at least one block that will be added, or as already been added, to
+// the owning heap `thread_delayed_free` list. This guarantees that pages
+// will be freed correctly even if only other threads free blocks.
+typedef struct mi_page_s {
+ // "owned" by the segment
+ uint32_t slice_count; // slices in this page (0 if not a page)
+ uint32_t slice_offset; // distance from the actual page data slice (0 if a page)
+ uint8_t is_reset : 1; // `true` if the page memory was reset
+ uint8_t is_committed : 1; // `true` if the page virtual memory is committed
+ uint8_t is_zero_init : 1; // `true` if the page was zero initialized
+
+ // layout like this to optimize access in `mi_malloc` and `mi_free`
+ uint16_t capacity; // number of blocks committed, must be the first field, see `segment.c:page_clear`
+ uint16_t reserved; // number of blocks reserved in memory
+ mi_page_flags_t flags; // `in_full` and `has_aligned` flags (8 bits)
+ uint8_t is_zero : 1; // `true` if the blocks in the free list are zero initialized
+ uint8_t retire_expire : 7; // expiration count for retired blocks
+
+ mi_block_t* free; // list of available free blocks (`malloc` allocates from this list)
+ #ifdef MI_ENCODE_FREELIST
+ uintptr_t keys[2]; // two random keys to encode the free lists (see `_mi_block_next`)
+ #endif
+ uint32_t used; // number of blocks in use (including blocks in `local_free` and `thread_free`)
+ uint32_t xblock_size; // size available in each block (always `>0`)
+
+ mi_block_t* local_free; // list of deferred free blocks by this thread (migrates to `free`)
+ _Atomic(mi_thread_free_t) xthread_free; // list of deferred free blocks freed by other threads
+ _Atomic(uintptr_t) xheap;
+
+ struct mi_page_s* next; // next page owned by this thread with the same `block_size`
+ struct mi_page_s* prev; // previous page owned by this thread with the same `block_size`
+
+ // 64-bit 9 words, 32-bit 12 words, (+2 for secure)
+ #if MI_INTPTR_SIZE==8
+ uintptr_t padding[1];
+ #endif
+} mi_page_t;
+
+
+
+typedef enum mi_page_kind_e {
+ MI_PAGE_SMALL, // small blocks go into 64KiB pages inside a segment
+ MI_PAGE_MEDIUM, // medium blocks go into medium pages inside a segment
+ MI_PAGE_LARGE, // larger blocks go into a page of just one block
+ MI_PAGE_HUGE, // huge blocks (> 16 MiB) are put into a single page in a single segment.
+} mi_page_kind_t;
+
+typedef enum mi_segment_kind_e {
+ MI_SEGMENT_NORMAL, // MI_SEGMENT_SIZE size with pages inside.
+ MI_SEGMENT_HUGE, // > MI_LARGE_SIZE_MAX segment with just one huge page inside.
+} mi_segment_kind_t;
+
+// ------------------------------------------------------
+// A segment holds a commit mask where a bit is set if
+// the corresponding MI_COMMIT_SIZE area is committed.
+// The MI_COMMIT_SIZE must be a multiple of the slice
+// size. If it is equal we have the most fine grained
+// decommit (but setting it higher can be more efficient).
+// The MI_MINIMAL_COMMIT_SIZE is the minimal amount that will
+// be committed in one go which can be set higher than
+// MI_COMMIT_SIZE for efficiency (while the decommit mask
+// is still tracked in fine-grained MI_COMMIT_SIZE chunks)
+// ------------------------------------------------------
+
+#define MI_MINIMAL_COMMIT_SIZE (2*MI_MiB)
+#define MI_COMMIT_SIZE (MI_SEGMENT_SLICE_SIZE) // 64KiB
+#define MI_COMMIT_MASK_BITS (MI_SEGMENT_SIZE / MI_COMMIT_SIZE)
+#define MI_COMMIT_MASK_FIELD_BITS MI_SIZE_BITS
+#define MI_COMMIT_MASK_FIELD_COUNT (MI_COMMIT_MASK_BITS / MI_COMMIT_MASK_FIELD_BITS)
+
+#if (MI_COMMIT_MASK_BITS != (MI_COMMIT_MASK_FIELD_COUNT * MI_COMMIT_MASK_FIELD_BITS))
+#error "the segment size must be exactly divisible by the (commit size * size_t bits)"
+#endif
+
+typedef struct mi_commit_mask_s {
+ size_t mask[MI_COMMIT_MASK_FIELD_COUNT];
+} mi_commit_mask_t;
+
+typedef mi_page_t mi_slice_t;
+typedef int64_t mi_msecs_t;
+
+
+// Segments are large allocated memory blocks (8mb on 64 bit) from
+// the OS. Inside segments we allocated fixed size _pages_ that
+// contain blocks.
+typedef struct mi_segment_s {
+ size_t memid; // memory id for arena allocation
+ bool mem_is_pinned; // `true` if we cannot decommit/reset/protect in this memory (i.e. when allocated using large OS pages)
+ bool mem_is_large; // in large/huge os pages?
+ bool mem_is_committed; // `true` if the whole segment is eagerly committed
+
+ bool allow_decommit;
+ mi_msecs_t decommit_expire;
+ mi_commit_mask_t decommit_mask;
+ mi_commit_mask_t commit_mask;
+
+ _Atomic(struct mi_segment_s*) abandoned_next;
+
+ // from here is zero initialized
+ struct mi_segment_s* next; // the list of freed segments in the cache (must be first field, see `segment.c:mi_segment_init`)
+
+ size_t abandoned; // abandoned pages (i.e. the original owning thread stopped) (`abandoned <= used`)
+ size_t abandoned_visits; // count how often this segment is visited in the abandoned list (to force reclaim it it is too long)
+ size_t used; // count of pages in use
+ uintptr_t cookie; // verify addresses in debug mode: `mi_ptr_cookie(segment) == segment->cookie`
+
+ size_t segment_slices; // for huge segments this may be different from `MI_SLICES_PER_SEGMENT`
+ size_t segment_info_slices; // initial slices we are using segment info and possible guard pages.
+
+ // layout like this to optimize access in `mi_free`
+ mi_segment_kind_t kind;
+ _Atomic(mi_threadid_t) thread_id; // unique id of the thread owning this segment
+ size_t slice_entries; // entries in the `slices` array, at most `MI_SLICES_PER_SEGMENT`
+ mi_slice_t slices[MI_SLICES_PER_SEGMENT];
+} mi_segment_t;
+
+
+// ------------------------------------------------------
+// Heaps
+// Provide first-class heaps to allocate from.
+// A heap just owns a set of pages for allocation and
+// can only be allocate/reallocate from the thread that created it.
+// Freeing blocks can be done from any thread though.
+// Per thread, the segments are shared among its heaps.
+// Per thread, there is always a default heap that is
+// used for allocation; it is initialized to statically
+// point to an empty heap to avoid initialization checks
+// in the fast path.
+// ------------------------------------------------------
+
+// Thread local data
+typedef struct mi_tld_s mi_tld_t;
+
+// Pages of a certain block size are held in a queue.
+typedef struct mi_page_queue_s {
+ mi_page_t* first;
+ mi_page_t* last;
+ size_t block_size;
+} mi_page_queue_t;
+
+#define MI_BIN_FULL (MI_BIN_HUGE+1)
+
+// Random context
+typedef struct mi_random_cxt_s {
+ uint32_t input[16];
+ uint32_t output[16];
+ int output_available;
+} mi_random_ctx_t;
+
+
+// In debug mode there is a padding structure at the end of the blocks to check for buffer overflows
+#if (MI_PADDING)
+typedef struct mi_padding_s {
+ uint32_t canary; // encoded block value to check validity of the padding (in case of overflow)
+ uint32_t delta; // padding bytes before the block. (mi_usable_size(p) - delta == exact allocated bytes)
+} mi_padding_t;
+#define MI_PADDING_SIZE (sizeof(mi_padding_t))
+#define MI_PADDING_WSIZE ((MI_PADDING_SIZE + MI_INTPTR_SIZE - 1) / MI_INTPTR_SIZE)
+#else
+#define MI_PADDING_SIZE 0
+#define MI_PADDING_WSIZE 0
+#endif
+
+#define MI_PAGES_DIRECT (MI_SMALL_WSIZE_MAX + MI_PADDING_WSIZE + 1)
+
+
+// A heap owns a set of pages.
+struct mi_heap_s {
+ mi_tld_t* tld;
+ mi_page_t* pages_free_direct[MI_PAGES_DIRECT]; // optimize: array where every entry points a page with possibly free blocks in the corresponding queue for that size.
+ mi_page_queue_t pages[MI_BIN_FULL + 1]; // queue of pages for each size class (or "bin")
+ _Atomic(mi_block_t*) thread_delayed_free;
+ mi_threadid_t thread_id; // thread this heap belongs too
+ uintptr_t cookie; // random cookie to verify pointers (see `_mi_ptr_cookie`)
+ uintptr_t keys[2]; // two random keys used to encode the `thread_delayed_free` list
+ mi_random_ctx_t random; // random number context used for secure allocation
+ size_t page_count; // total number of pages in the `pages` queues.
+ size_t page_retired_min; // smallest retired index (retired pages are fully free, but still in the page queues)
+ size_t page_retired_max; // largest retired index into the `pages` array.
+ mi_heap_t* next; // list of heaps per thread
+ bool no_reclaim; // `true` if this heap should not reclaim abandoned pages
+};
+
+
+
+// ------------------------------------------------------
+// Debug
+// ------------------------------------------------------
+
+#if !defined(MI_DEBUG_UNINIT)
+#define MI_DEBUG_UNINIT (0xD0)
+#endif
+#if !defined(MI_DEBUG_FREED)
+#define MI_DEBUG_FREED (0xDF)
+#endif
+#if !defined(MI_DEBUG_PADDING)
+#define MI_DEBUG_PADDING (0xDE)
+#endif
+
+#if (MI_DEBUG)
+// use our own assertion to print without memory allocation
+void _mi_assert_fail(const char* assertion, const char* fname, unsigned int line, const char* func );
+#define mi_assert(expr) ((expr) ? (void)0 : _mi_assert_fail(#expr,__FILE__,__LINE__,__func__))
+#else
+#define mi_assert(x)
+#endif
+
+#if (MI_DEBUG>1)
+#define mi_assert_internal mi_assert
+#else
+#define mi_assert_internal(x)
+#endif
+
+#if (MI_DEBUG>2)
+#define mi_assert_expensive mi_assert
+#else
+#define mi_assert_expensive(x)
+#endif
+
+// ------------------------------------------------------
+// Statistics
+// ------------------------------------------------------
+
+#ifndef MI_STAT
+#if (MI_DEBUG>0)
+#define MI_STAT 2
+#else
+#define MI_STAT 0
+#endif
+#endif
+
+typedef struct mi_stat_count_s {
+ int64_t allocated;
+ int64_t freed;
+ int64_t peak;
+ int64_t current;
+} mi_stat_count_t;
+
+typedef struct mi_stat_counter_s {
+ int64_t total;
+ int64_t count;
+} mi_stat_counter_t;
+
+typedef struct mi_stats_s {
+ mi_stat_count_t segments;
+ mi_stat_count_t pages;
+ mi_stat_count_t reserved;
+ mi_stat_count_t committed;
+ mi_stat_count_t reset;
+ mi_stat_count_t page_committed;
+ mi_stat_count_t segments_abandoned;
+ mi_stat_count_t pages_abandoned;
+ mi_stat_count_t threads;
+ mi_stat_count_t normal;
+ mi_stat_count_t huge;
+ mi_stat_count_t large;
+ mi_stat_count_t malloc;
+ mi_stat_count_t segments_cache;
+ mi_stat_counter_t pages_extended;
+ mi_stat_counter_t mmap_calls;
+ mi_stat_counter_t commit_calls;
+ mi_stat_counter_t page_no_retire;
+ mi_stat_counter_t searches;
+ mi_stat_counter_t normal_count;
+ mi_stat_counter_t huge_count;
+ mi_stat_counter_t large_count;
+#if MI_STAT>1
+ mi_stat_count_t normal_bins[MI_BIN_HUGE+1];
+#endif
+} mi_stats_t;
+
+
+void _mi_stat_increase(mi_stat_count_t* stat, size_t amount);
+void _mi_stat_decrease(mi_stat_count_t* stat, size_t amount);
+void _mi_stat_counter_increase(mi_stat_counter_t* stat, size_t amount);
+
+#if (MI_STAT)
+#define mi_stat_increase(stat,amount) _mi_stat_increase( &(stat), amount)
+#define mi_stat_decrease(stat,amount) _mi_stat_decrease( &(stat), amount)
+#define mi_stat_counter_increase(stat,amount) _mi_stat_counter_increase( &(stat), amount)
+#else
+#define mi_stat_increase(stat,amount) (void)0
+#define mi_stat_decrease(stat,amount) (void)0
+#define mi_stat_counter_increase(stat,amount) (void)0
+#endif
+
+#define mi_heap_stat_counter_increase(heap,stat,amount) mi_stat_counter_increase( (heap)->tld->stats.stat, amount)
+#define mi_heap_stat_increase(heap,stat,amount) mi_stat_increase( (heap)->tld->stats.stat, amount)
+#define mi_heap_stat_decrease(heap,stat,amount) mi_stat_decrease( (heap)->tld->stats.stat, amount)
+
+// ------------------------------------------------------
+// Thread Local data
+// ------------------------------------------------------
+
+// A "span" is is an available range of slices. The span queues keep
+// track of slice spans of at most the given `slice_count` (but more than the previous size class).
+typedef struct mi_span_queue_s {
+ mi_slice_t* first;
+ mi_slice_t* last;
+ size_t slice_count;
+} mi_span_queue_t;
+
+#define MI_SEGMENT_BIN_MAX (35) // 35 == mi_segment_bin(MI_SLICES_PER_SEGMENT)
+
+// OS thread local data
+typedef struct mi_os_tld_s {
+ size_t region_idx; // start point for next allocation
+ mi_stats_t* stats; // points to tld stats
+} mi_os_tld_t;
+
+
+// Segments thread local data
+typedef struct mi_segments_tld_s {
+ mi_span_queue_t spans[MI_SEGMENT_BIN_MAX+1]; // free slice spans inside segments
+ size_t count; // current number of segments;
+ size_t peak_count; // peak number of segments
+ size_t current_size; // current size of all segments
+ size_t peak_size; // peak size of all segments
+ mi_stats_t* stats; // points to tld stats
+ mi_os_tld_t* os; // points to os stats
+} mi_segments_tld_t;
+
+// Thread local data
+struct mi_tld_s {
+ unsigned long long heartbeat; // monotonic heartbeat count
+ bool recurse; // true if deferred was called; used to prevent infinite recursion.
+ mi_heap_t* heap_backing; // backing heap of this thread (cannot be deleted)
+ mi_heap_t* heaps; // list of heaps in this thread (so we can abandon all when the thread terminates)
+ mi_segments_tld_t segments; // segment tld
+ mi_os_tld_t os; // os tld
+ mi_stats_t stats; // statistics
+};
+
+#endif
diff --git a/source/luametatex/source/libraries/mimalloc/include/mimalloc.h b/source/luametatex/source/libraries/mimalloc/include/mimalloc.h
new file mode 100644
index 000000000..c752ac247
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/include/mimalloc.h
@@ -0,0 +1,453 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2022, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#pragma once
+#ifndef MIMALLOC_H
+#define MIMALLOC_H
+
+#define MI_MALLOC_VERSION 206 // major + 2 digits minor
+
+// ------------------------------------------------------
+// Compiler specific attributes
+// ------------------------------------------------------
+
+#ifdef __cplusplus
+ #if (__cplusplus >= 201103L) || (_MSC_VER > 1900) // C++11
+ #define mi_attr_noexcept noexcept
+ #else
+ #define mi_attr_noexcept throw()
+ #endif
+#else
+ #define mi_attr_noexcept
+#endif
+
+#if defined(__cplusplus) && (__cplusplus >= 201703)
+ #define mi_decl_nodiscard [[nodiscard]]
+#elif (defined(__GNUC__) && (__GNUC__ >= 4)) || defined(__clang__) // includes clang, icc, and clang-cl
+ #define mi_decl_nodiscard __attribute__((warn_unused_result))
+#elif (_MSC_VER >= 1700)
+ #define mi_decl_nodiscard _Check_return_
+#else
+ #define mi_decl_nodiscard
+#endif
+
+#if defined(_MSC_VER) || defined(__MINGW32__)
+ #if !defined(MI_SHARED_LIB)
+ #define mi_decl_export
+ #elif defined(MI_SHARED_LIB_EXPORT)
+ #define mi_decl_export __declspec(dllexport)
+ #else
+ #define mi_decl_export __declspec(dllimport)
+ #endif
+ #if defined(__MINGW32__)
+ #define mi_decl_restrict
+ #define mi_attr_malloc __attribute__((malloc))
+ #else
+ #if (_MSC_VER >= 1900) && !defined(__EDG__)
+ #define mi_decl_restrict __declspec(allocator) __declspec(restrict)
+ #else
+ #define mi_decl_restrict __declspec(restrict)
+ #endif
+ #define mi_attr_malloc
+ #endif
+ #define mi_cdecl __cdecl
+ #define mi_attr_alloc_size(s)
+ #define mi_attr_alloc_size2(s1,s2)
+ #define mi_attr_alloc_align(p)
+#elif defined(__GNUC__) // includes clang and icc
+ #if defined(MI_SHARED_LIB) && defined(MI_SHARED_LIB_EXPORT)
+ #define mi_decl_export __attribute__((visibility("default")))
+ #else
+ #define mi_decl_export
+ #endif
+ #define mi_cdecl // leads to warnings... __attribute__((cdecl))
+ #define mi_decl_restrict
+ #define mi_attr_malloc __attribute__((malloc))
+ #if (defined(__clang_major__) && (__clang_major__ < 4)) || (__GNUC__ < 5)
+ #define mi_attr_alloc_size(s)
+ #define mi_attr_alloc_size2(s1,s2)
+ #define mi_attr_alloc_align(p)
+ #elif defined(__INTEL_COMPILER)
+ #define mi_attr_alloc_size(s) __attribute__((alloc_size(s)))
+ #define mi_attr_alloc_size2(s1,s2) __attribute__((alloc_size(s1,s2)))
+ #define mi_attr_alloc_align(p)
+ #else
+ #define mi_attr_alloc_size(s) __attribute__((alloc_size(s)))
+ #define mi_attr_alloc_size2(s1,s2) __attribute__((alloc_size(s1,s2)))
+ #define mi_attr_alloc_align(p) __attribute__((alloc_align(p)))
+ #endif
+#else
+ #define mi_cdecl
+ #define mi_decl_export
+ #define mi_decl_restrict
+ #define mi_attr_malloc
+ #define mi_attr_alloc_size(s)
+ #define mi_attr_alloc_size2(s1,s2)
+ #define mi_attr_alloc_align(p)
+#endif
+
+// ------------------------------------------------------
+// Includes
+// ------------------------------------------------------
+
+#include <stddef.h> // size_t
+#include <stdbool.h> // bool
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+// ------------------------------------------------------
+// Standard malloc interface
+// ------------------------------------------------------
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_malloc(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_calloc(size_t count, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(1,2);
+mi_decl_nodiscard mi_decl_export void* mi_realloc(void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(2);
+mi_decl_export void* mi_expand(void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(2);
+
+mi_decl_export void mi_free(void* p) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict char* mi_strdup(const char* s) mi_attr_noexcept mi_attr_malloc;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict char* mi_strndup(const char* s, size_t n) mi_attr_noexcept mi_attr_malloc;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict char* mi_realpath(const char* fname, char* resolved_name) mi_attr_noexcept mi_attr_malloc;
+
+// ------------------------------------------------------
+// Extended functionality
+// ------------------------------------------------------
+#define MI_SMALL_WSIZE_MAX (128)
+#define MI_SMALL_SIZE_MAX (MI_SMALL_WSIZE_MAX*sizeof(void*))
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_malloc_small(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_zalloc_small(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_zalloc(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_mallocn(size_t count, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(1,2);
+mi_decl_nodiscard mi_decl_export void* mi_reallocn(void* p, size_t count, size_t size) mi_attr_noexcept mi_attr_alloc_size2(2,3);
+mi_decl_nodiscard mi_decl_export void* mi_reallocf(void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(2);
+
+mi_decl_nodiscard mi_decl_export size_t mi_usable_size(const void* p) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export size_t mi_good_size(size_t size) mi_attr_noexcept;
+
+
+// ------------------------------------------------------
+// Internals
+// ------------------------------------------------------
+
+typedef void (mi_cdecl mi_deferred_free_fun)(bool force, unsigned long long heartbeat, void* arg);
+mi_decl_export void mi_register_deferred_free(mi_deferred_free_fun* deferred_free, void* arg) mi_attr_noexcept;
+
+typedef void (mi_cdecl mi_output_fun)(const char* msg, void* arg);
+mi_decl_export void mi_register_output(mi_output_fun* out, void* arg) mi_attr_noexcept;
+
+typedef void (mi_cdecl mi_error_fun)(int err, void* arg);
+mi_decl_export void mi_register_error(mi_error_fun* fun, void* arg);
+
+mi_decl_export void mi_collect(bool force) mi_attr_noexcept;
+mi_decl_export int mi_version(void) mi_attr_noexcept;
+mi_decl_export void mi_stats_reset(void) mi_attr_noexcept;
+mi_decl_export void mi_stats_merge(void) mi_attr_noexcept;
+mi_decl_export void mi_stats_print(void* out) mi_attr_noexcept; // backward compatibility: `out` is ignored and should be NULL
+mi_decl_export void mi_stats_print_out(mi_output_fun* out, void* arg) mi_attr_noexcept;
+
+mi_decl_export void mi_process_init(void) mi_attr_noexcept;
+mi_decl_export void mi_thread_init(void) mi_attr_noexcept;
+mi_decl_export void mi_thread_done(void) mi_attr_noexcept;
+mi_decl_export void mi_thread_stats_print_out(mi_output_fun* out, void* arg) mi_attr_noexcept;
+
+mi_decl_export void mi_process_info(size_t* elapsed_msecs, size_t* user_msecs, size_t* system_msecs,
+ size_t* current_rss, size_t* peak_rss,
+ size_t* current_commit, size_t* peak_commit, size_t* page_faults) mi_attr_noexcept;
+
+// -------------------------------------------------------------------------------------
+// Aligned allocation
+// Note that `alignment` always follows `size` for consistency with unaligned
+// allocation, but unfortunately this differs from `posix_memalign` and `aligned_alloc`.
+// -------------------------------------------------------------------------------------
+#define MI_ALIGNMENT_MAX (1024*1024UL) // maximum supported alignment is 1MiB
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_malloc_aligned(size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1) mi_attr_alloc_align(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_malloc_aligned_at(size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_zalloc_aligned(size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1) mi_attr_alloc_align(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_zalloc_aligned_at(size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_calloc_aligned(size_t count, size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(1,2) mi_attr_alloc_align(3);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_calloc_aligned_at(size_t count, size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(1,2);
+mi_decl_nodiscard mi_decl_export void* mi_realloc_aligned(void* p, size_t newsize, size_t alignment) mi_attr_noexcept mi_attr_alloc_size(2) mi_attr_alloc_align(3);
+mi_decl_nodiscard mi_decl_export void* mi_realloc_aligned_at(void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_alloc_size(2);
+
+
+// -------------------------------------------------------------------------------------
+// Heaps: first-class, but can only allocate from the same thread that created it.
+// -------------------------------------------------------------------------------------
+
+struct mi_heap_s;
+typedef struct mi_heap_s mi_heap_t;
+
+mi_decl_nodiscard mi_decl_export mi_heap_t* mi_heap_new(void);
+mi_decl_export void mi_heap_delete(mi_heap_t* heap);
+mi_decl_export void mi_heap_destroy(mi_heap_t* heap);
+mi_decl_export mi_heap_t* mi_heap_set_default(mi_heap_t* heap);
+mi_decl_export mi_heap_t* mi_heap_get_default(void);
+mi_decl_export mi_heap_t* mi_heap_get_backing(void);
+mi_decl_export void mi_heap_collect(mi_heap_t* heap, bool force) mi_attr_noexcept;
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_malloc(mi_heap_t* heap, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_zalloc(mi_heap_t* heap, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_calloc(mi_heap_t* heap, size_t count, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(2, 3);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_mallocn(mi_heap_t* heap, size_t count, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(2, 3);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_malloc_small(mi_heap_t* heap, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2);
+
+mi_decl_nodiscard mi_decl_export void* mi_heap_realloc(mi_heap_t* heap, void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(3);
+mi_decl_nodiscard mi_decl_export void* mi_heap_reallocn(mi_heap_t* heap, void* p, size_t count, size_t size) mi_attr_noexcept mi_attr_alloc_size2(3,4);
+mi_decl_nodiscard mi_decl_export void* mi_heap_reallocf(mi_heap_t* heap, void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(3);
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict char* mi_heap_strdup(mi_heap_t* heap, const char* s) mi_attr_noexcept mi_attr_malloc;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict char* mi_heap_strndup(mi_heap_t* heap, const char* s, size_t n) mi_attr_noexcept mi_attr_malloc;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict char* mi_heap_realpath(mi_heap_t* heap, const char* fname, char* resolved_name) mi_attr_noexcept mi_attr_malloc;
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_malloc_aligned(mi_heap_t* heap, size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2) mi_attr_alloc_align(3);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_malloc_aligned_at(mi_heap_t* heap, size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_zalloc_aligned(mi_heap_t* heap, size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2) mi_attr_alloc_align(3);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_zalloc_aligned_at(mi_heap_t* heap, size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_calloc_aligned(mi_heap_t* heap, size_t count, size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(2, 3) mi_attr_alloc_align(4);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_heap_calloc_aligned_at(mi_heap_t* heap, size_t count, size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size2(2, 3);
+mi_decl_nodiscard mi_decl_export void* mi_heap_realloc_aligned(mi_heap_t* heap, void* p, size_t newsize, size_t alignment) mi_attr_noexcept mi_attr_alloc_size(3) mi_attr_alloc_align(4);
+mi_decl_nodiscard mi_decl_export void* mi_heap_realloc_aligned_at(mi_heap_t* heap, void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_alloc_size(3);
+
+
+// --------------------------------------------------------------------------------
+// Zero initialized re-allocation.
+// Only valid on memory that was originally allocated with zero initialization too.
+// e.g. `mi_calloc`, `mi_zalloc`, `mi_zalloc_aligned` etc.
+// see <https://github.com/microsoft/mimalloc/issues/63#issuecomment-508272992>
+// --------------------------------------------------------------------------------
+
+mi_decl_nodiscard mi_decl_export void* mi_rezalloc(void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export void* mi_recalloc(void* p, size_t newcount, size_t size) mi_attr_noexcept mi_attr_alloc_size2(2,3);
+
+mi_decl_nodiscard mi_decl_export void* mi_rezalloc_aligned(void* p, size_t newsize, size_t alignment) mi_attr_noexcept mi_attr_alloc_size(2) mi_attr_alloc_align(3);
+mi_decl_nodiscard mi_decl_export void* mi_rezalloc_aligned_at(void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export void* mi_recalloc_aligned(void* p, size_t newcount, size_t size, size_t alignment) mi_attr_noexcept mi_attr_alloc_size2(2,3) mi_attr_alloc_align(4);
+mi_decl_nodiscard mi_decl_export void* mi_recalloc_aligned_at(void* p, size_t newcount, size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_alloc_size2(2,3);
+
+mi_decl_nodiscard mi_decl_export void* mi_heap_rezalloc(mi_heap_t* heap, void* p, size_t newsize) mi_attr_noexcept mi_attr_alloc_size(3);
+mi_decl_nodiscard mi_decl_export void* mi_heap_recalloc(mi_heap_t* heap, void* p, size_t newcount, size_t size) mi_attr_noexcept mi_attr_alloc_size2(3,4);
+
+mi_decl_nodiscard mi_decl_export void* mi_heap_rezalloc_aligned(mi_heap_t* heap, void* p, size_t newsize, size_t alignment) mi_attr_noexcept mi_attr_alloc_size(3) mi_attr_alloc_align(4);
+mi_decl_nodiscard mi_decl_export void* mi_heap_rezalloc_aligned_at(mi_heap_t* heap, void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_alloc_size(3);
+mi_decl_nodiscard mi_decl_export void* mi_heap_recalloc_aligned(mi_heap_t* heap, void* p, size_t newcount, size_t size, size_t alignment) mi_attr_noexcept mi_attr_alloc_size2(3,4) mi_attr_alloc_align(5);
+mi_decl_nodiscard mi_decl_export void* mi_heap_recalloc_aligned_at(mi_heap_t* heap, void* p, size_t newcount, size_t size, size_t alignment, size_t offset) mi_attr_noexcept mi_attr_alloc_size2(3,4);
+
+
+// ------------------------------------------------------
+// Analysis
+// ------------------------------------------------------
+
+mi_decl_export bool mi_heap_contains_block(mi_heap_t* heap, const void* p);
+mi_decl_export bool mi_heap_check_owned(mi_heap_t* heap, const void* p);
+mi_decl_export bool mi_check_owned(const void* p);
+
+// An area of heap space contains blocks of a single size.
+typedef struct mi_heap_area_s {
+ void* blocks; // start of the area containing heap blocks
+ size_t reserved; // bytes reserved for this area (virtual)
+ size_t committed; // current available bytes for this area
+ size_t used; // number of allocated blocks
+ size_t block_size; // size in bytes of each block
+ size_t full_block_size; // size in bytes of a full block including padding and metadata.
+} mi_heap_area_t;
+
+typedef bool (mi_cdecl mi_block_visit_fun)(const mi_heap_t* heap, const mi_heap_area_t* area, void* block, size_t block_size, void* arg);
+
+mi_decl_export bool mi_heap_visit_blocks(const mi_heap_t* heap, bool visit_all_blocks, mi_block_visit_fun* visitor, void* arg);
+
+// Experimental
+mi_decl_nodiscard mi_decl_export bool mi_is_in_heap_region(const void* p) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export bool mi_is_redirected(void) mi_attr_noexcept;
+
+mi_decl_export int mi_reserve_huge_os_pages_interleave(size_t pages, size_t numa_nodes, size_t timeout_msecs) mi_attr_noexcept;
+mi_decl_export int mi_reserve_huge_os_pages_at(size_t pages, int numa_node, size_t timeout_msecs) mi_attr_noexcept;
+
+mi_decl_export int mi_reserve_os_memory(size_t size, bool commit, bool allow_large) mi_attr_noexcept;
+mi_decl_export bool mi_manage_os_memory(void* start, size_t size, bool is_committed, bool is_large, bool is_zero, int numa_node) mi_attr_noexcept;
+
+mi_decl_export void mi_debug_show_arenas(void) mi_attr_noexcept;
+
+// deprecated
+mi_decl_export int mi_reserve_huge_os_pages(size_t pages, double max_secs, size_t* pages_reserved) mi_attr_noexcept;
+
+
+// ------------------------------------------------------
+// Convenience
+// ------------------------------------------------------
+
+#define mi_malloc_tp(tp) ((tp*)mi_malloc(sizeof(tp)))
+#define mi_zalloc_tp(tp) ((tp*)mi_zalloc(sizeof(tp)))
+#define mi_calloc_tp(tp,n) ((tp*)mi_calloc(n,sizeof(tp)))
+#define mi_mallocn_tp(tp,n) ((tp*)mi_mallocn(n,sizeof(tp)))
+#define mi_reallocn_tp(p,tp,n) ((tp*)mi_reallocn(p,n,sizeof(tp)))
+#define mi_recalloc_tp(p,tp,n) ((tp*)mi_recalloc(p,n,sizeof(tp)))
+
+#define mi_heap_malloc_tp(hp,tp) ((tp*)mi_heap_malloc(hp,sizeof(tp)))
+#define mi_heap_zalloc_tp(hp,tp) ((tp*)mi_heap_zalloc(hp,sizeof(tp)))
+#define mi_heap_calloc_tp(hp,tp,n) ((tp*)mi_heap_calloc(hp,n,sizeof(tp)))
+#define mi_heap_mallocn_tp(hp,tp,n) ((tp*)mi_heap_mallocn(hp,n,sizeof(tp)))
+#define mi_heap_reallocn_tp(hp,p,tp,n) ((tp*)mi_heap_reallocn(hp,p,n,sizeof(tp)))
+#define mi_heap_recalloc_tp(hp,p,tp,n) ((tp*)mi_heap_recalloc(hp,p,n,sizeof(tp)))
+
+
+// ------------------------------------------------------
+// Options
+// ------------------------------------------------------
+
+typedef enum mi_option_e {
+ // stable options
+ mi_option_show_errors,
+ mi_option_show_stats,
+ mi_option_verbose,
+ // some of the following options are experimental
+ // (deprecated options are kept for binary backward compatibility with v1.x versions)
+ mi_option_eager_commit,
+ mi_option_deprecated_eager_region_commit,
+ mi_option_deprecated_reset_decommits,
+ mi_option_large_os_pages, // use large (2MiB) OS pages, implies eager commit
+ mi_option_reserve_huge_os_pages, // reserve N huge OS pages (1GiB) at startup
+ mi_option_reserve_huge_os_pages_at, // reserve huge OS pages at a specific NUMA node
+ mi_option_reserve_os_memory, // reserve specified amount of OS memory at startup
+ mi_option_deprecated_segment_cache,
+ mi_option_page_reset,
+ mi_option_abandoned_page_decommit,
+ mi_option_deprecated_segment_reset,
+ mi_option_eager_commit_delay,
+ mi_option_decommit_delay,
+ mi_option_use_numa_nodes, // 0 = use available numa nodes, otherwise use at most N nodes.
+ mi_option_limit_os_alloc, // 1 = do not use OS memory for allocation (but only reserved arenas)
+ mi_option_os_tag,
+ mi_option_max_errors,
+ mi_option_max_warnings,
+ mi_option_max_segment_reclaim,
+ mi_option_allow_decommit,
+ mi_option_segment_decommit_delay,
+ mi_option_decommit_extend_delay,
+ _mi_option_last
+} mi_option_t;
+
+
+mi_decl_nodiscard mi_decl_export bool mi_option_is_enabled(mi_option_t option);
+mi_decl_export void mi_option_enable(mi_option_t option);
+mi_decl_export void mi_option_disable(mi_option_t option);
+mi_decl_export void mi_option_set_enabled(mi_option_t option, bool enable);
+mi_decl_export void mi_option_set_enabled_default(mi_option_t option, bool enable);
+
+mi_decl_nodiscard mi_decl_export long mi_option_get(mi_option_t option);
+mi_decl_nodiscard mi_decl_export long mi_option_get_clamp(mi_option_t option, long min, long max);
+mi_decl_export void mi_option_set(mi_option_t option, long value);
+mi_decl_export void mi_option_set_default(mi_option_t option, long value);
+
+
+// -------------------------------------------------------------------------------------------------------
+// "mi" prefixed implementations of various posix, Unix, Windows, and C++ allocation functions.
+// (This can be convenient when providing overrides of these functions as done in `mimalloc-override.h`.)
+// note: we use `mi_cfree` as "checked free" and it checks if the pointer is in our heap before free-ing.
+// -------------------------------------------------------------------------------------------------------
+
+mi_decl_export void mi_cfree(void* p) mi_attr_noexcept;
+mi_decl_export void* mi__expand(void* p, size_t newsize) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export size_t mi_malloc_size(const void* p) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export size_t mi_malloc_good_size(size_t size) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export size_t mi_malloc_usable_size(const void *p) mi_attr_noexcept;
+
+mi_decl_export int mi_posix_memalign(void** p, size_t alignment, size_t size) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_memalign(size_t alignment, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2) mi_attr_alloc_align(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_valloc(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_pvalloc(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_aligned_alloc(size_t alignment, size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(2) mi_attr_alloc_align(1);
+
+mi_decl_nodiscard mi_decl_export void* mi_reallocarray(void* p, size_t count, size_t size) mi_attr_noexcept mi_attr_alloc_size2(2,3);
+mi_decl_nodiscard mi_decl_export int mi_reallocarr(void* p, size_t count, size_t size) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export void* mi_aligned_recalloc(void* p, size_t newcount, size_t size, size_t alignment) mi_attr_noexcept;
+mi_decl_nodiscard mi_decl_export void* mi_aligned_offset_recalloc(void* p, size_t newcount, size_t size, size_t alignment, size_t offset) mi_attr_noexcept;
+
+mi_decl_nodiscard mi_decl_export mi_decl_restrict unsigned short* mi_wcsdup(const unsigned short* s) mi_attr_noexcept mi_attr_malloc;
+mi_decl_nodiscard mi_decl_export mi_decl_restrict unsigned char* mi_mbsdup(const unsigned char* s) mi_attr_noexcept mi_attr_malloc;
+mi_decl_export int mi_dupenv_s(char** buf, size_t* size, const char* name) mi_attr_noexcept;
+mi_decl_export int mi_wdupenv_s(unsigned short** buf, size_t* size, const unsigned short* name) mi_attr_noexcept;
+
+mi_decl_export void mi_free_size(void* p, size_t size) mi_attr_noexcept;
+mi_decl_export void mi_free_size_aligned(void* p, size_t size, size_t alignment) mi_attr_noexcept;
+mi_decl_export void mi_free_aligned(void* p, size_t alignment) mi_attr_noexcept;
+
+// The `mi_new` wrappers implement C++ semantics on out-of-memory instead of directly returning `NULL`.
+// (and call `std::get_new_handler` and potentially raise a `std::bad_alloc` exception).
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_new(size_t size) mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_new_aligned(size_t size, size_t alignment) mi_attr_malloc mi_attr_alloc_size(1) mi_attr_alloc_align(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_new_nothrow(size_t size) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_new_aligned_nothrow(size_t size, size_t alignment) mi_attr_noexcept mi_attr_malloc mi_attr_alloc_size(1) mi_attr_alloc_align(2);
+mi_decl_nodiscard mi_decl_export mi_decl_restrict void* mi_new_n(size_t count, size_t size) mi_attr_malloc mi_attr_alloc_size2(1, 2);
+mi_decl_nodiscard mi_decl_export void* mi_new_realloc(void* p, size_t newsize) mi_attr_alloc_size(2);
+mi_decl_nodiscard mi_decl_export void* mi_new_reallocn(void* p, size_t newcount, size_t size) mi_attr_alloc_size2(2, 3);
+
+#ifdef __cplusplus
+}
+#endif
+
+// ---------------------------------------------------------------------------------------------
+// Implement the C++ std::allocator interface for use in STL containers.
+// (note: see `mimalloc-new-delete.h` for overriding the new/delete operators globally)
+// ---------------------------------------------------------------------------------------------
+#ifdef __cplusplus
+
+#include <cstddef> // std::size_t
+#include <cstdint> // PTRDIFF_MAX
+#if (__cplusplus >= 201103L) || (_MSC_VER > 1900) // C++11
+#include <type_traits> // std::true_type
+#include <utility> // std::forward
+#endif
+
+template<class T> struct mi_stl_allocator {
+ typedef T value_type;
+ typedef std::size_t size_type;
+ typedef std::ptrdiff_t difference_type;
+ typedef value_type& reference;
+ typedef value_type const& const_reference;
+ typedef value_type* pointer;
+ typedef value_type const* const_pointer;
+ template <class U> struct rebind { typedef mi_stl_allocator<U> other; };
+
+ mi_stl_allocator() mi_attr_noexcept = default;
+ mi_stl_allocator(const mi_stl_allocator&) mi_attr_noexcept = default;
+ template<class U> mi_stl_allocator(const mi_stl_allocator<U>&) mi_attr_noexcept { }
+ mi_stl_allocator select_on_container_copy_construction() const { return *this; }
+ void deallocate(T* p, size_type) { mi_free(p); }
+
+ #if (__cplusplus >= 201703L) // C++17
+ mi_decl_nodiscard T* allocate(size_type count) { return static_cast<T*>(mi_new_n(count, sizeof(T))); }
+ mi_decl_nodiscard T* allocate(size_type count, const void*) { return allocate(count); }
+ #else
+ mi_decl_nodiscard pointer allocate(size_type count, const void* = 0) { return static_cast<pointer>(mi_new_n(count, sizeof(value_type))); }
+ #endif
+
+ #if ((__cplusplus >= 201103L) || (_MSC_VER > 1900)) // C++11
+ using propagate_on_container_copy_assignment = std::true_type;
+ using propagate_on_container_move_assignment = std::true_type;
+ using propagate_on_container_swap = std::true_type;
+ using is_always_equal = std::true_type;
+ template <class U, class ...Args> void construct(U* p, Args&& ...args) { ::new(p) U(std::forward<Args>(args)...); }
+ template <class U> void destroy(U* p) mi_attr_noexcept { p->~U(); }
+ #else
+ void construct(pointer p, value_type const& val) { ::new(p) value_type(val); }
+ void destroy(pointer p) { p->~value_type(); }
+ #endif
+
+ size_type max_size() const mi_attr_noexcept { return (PTRDIFF_MAX/sizeof(value_type)); }
+ pointer address(reference x) const { return &x; }
+ const_pointer address(const_reference x) const { return &x; }
+};
+
+template<class T1,class T2> bool operator==(const mi_stl_allocator<T1>& , const mi_stl_allocator<T2>& ) mi_attr_noexcept { return true; }
+template<class T1,class T2> bool operator!=(const mi_stl_allocator<T1>& , const mi_stl_allocator<T2>& ) mi_attr_noexcept { return false; }
+#endif // __cplusplus
+
+#endif
diff --git a/source/luametatex/source/libraries/mimalloc/readme.md b/source/luametatex/source/libraries/mimalloc/readme.md
new file mode 100644
index 000000000..6142dbc5e
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/readme.md
@@ -0,0 +1,716 @@
+
+<img align="left" width="100" height="100" src="doc/mimalloc-logo.png"/>
+
+[<img align="right" src="https://dev.azure.com/Daan0324/mimalloc/_apis/build/status/microsoft.mimalloc?branchName=dev"/>](https://dev.azure.com/Daan0324/mimalloc/_build?definitionId=1&_a=summary)
+
+# mimalloc
+
+&nbsp;
+
+mimalloc (pronounced "me-malloc")
+is a general purpose allocator with excellent [performance](#performance) characteristics.
+Initially developed by Daan Leijen for the run-time systems of the
+[Koka](https://koka-lang.github.io) and [Lean](https://github.com/leanprover/lean) languages.
+
+Latest release tag: `v2.0.6` (2022-04-14).
+Latest stable tag: `v1.7.6` (2022-02-14).
+
+mimalloc is a drop-in replacement for `malloc` and can be used in other programs
+without code changes, for example, on dynamically linked ELF-based systems (Linux, BSD, etc.) you can use it as:
+```
+> LD_PRELOAD=/usr/lib/libmimalloc.so myprogram
+```
+It also has an easy way to override the default allocator in [Windows](#override_on_windows). Notable aspects of the design include:
+
+- __small and consistent__: the library is about 8k LOC using simple and
+ consistent data structures. This makes it very suitable
+ to integrate and adapt in other projects. For runtime systems it
+ provides hooks for a monotonic _heartbeat_ and deferred freeing (for
+ bounded worst-case times with reference counting).
+- __free list sharding__: instead of one big free list (per size class) we have
+ many smaller lists per "mimalloc page" which reduces fragmentation and
+ increases locality --
+ things that are allocated close in time get allocated close in memory.
+ (A mimalloc page contains blocks of one size class and is usually 64KiB on a 64-bit system).
+- __free list multi-sharding__: the big idea! Not only do we shard the free list
+ per mimalloc page, but for each page we have multiple free lists. In particular, there
+ is one list for thread-local `free` operations, and another one for concurrent `free`
+ operations. Free-ing from another thread can now be a single CAS without needing
+ sophisticated coordination between threads. Since there will be
+ thousands of separate free lists, contention is naturally distributed over the heap,
+ and the chance of contending on a single location will be low -- this is quite
+ similar to randomized algorithms like skip lists where adding
+ a random oracle removes the need for a more complex algorithm.
+- __eager page reset__: when a "page" becomes empty (with increased chance
+ due to free list sharding) the memory is marked to the OS as unused ("reset" or "purged")
+ reducing (real) memory pressure and fragmentation, especially in long running
+ programs.
+- __secure__: _mimalloc_ can be built in secure mode, adding guard pages,
+ randomized allocation, encrypted free lists, etc. to protect against various
+ heap vulnerabilities. The performance penalty is usually around 10% on average
+ over our benchmarks.
+- __first-class heaps__: efficiently create and use multiple heaps to allocate across different regions.
+ A heap can be destroyed at once instead of deallocating each object separately.
+- __bounded__: it does not suffer from _blowup_ \[1\], has bounded worst-case allocation
+ times (_wcat_), bounded space overhead (~0.2% meta-data, with low internal fragmentation),
+ and has no internal points of contention using only atomic operations.
+- __fast__: In our benchmarks (see [below](#performance)),
+ _mimalloc_ outperforms other leading allocators (_jemalloc_, _tcmalloc_, _Hoard_, etc),
+ and often uses less memory. A nice property
+ is that it does consistently well over a wide range of benchmarks. There is also good huge OS page
+ support for larger server programs.
+
+The [documentation](https://microsoft.github.io/mimalloc) gives a full overview of the API.
+You can read more on the design of _mimalloc_ in the [technical report](https://www.microsoft.com/en-us/research/publication/mimalloc-free-list-sharding-in-action) which also has detailed benchmark results.
+
+Enjoy!
+
+### Branches
+
+* `master`: latest stable release (based on `dev-slice`).
+* `dev`: development branch for mimalloc v1. Use this branch for submitting PR's.
+* `dev-slice`: development branch for mimalloc v2. This branch is downstream of `dev`.
+
+### Releases
+
+Note: the `v2.x` version has a new algorithm for managing internal mimalloc pages that tends to use reduce memory usage
+ and fragmentation compared to mimalloc `v1.x` (especially for large workloads). Should otherwise have similar performance
+ (see [below](#performance)); please report if you observe any significant performance regression.
+
+* 2022-04-14, `v1.7.6`, `v2.0.6`: fix fallback path for aligned OS allocation on Windows, improve Windows aligned allocation
+ even when compiling with older SDK's, fix dynamic overriding on macOS Monterey, fix MSVC C++ dynamic overriding, fix
+ warnings under Clang 14, improve performance if many OS threads are created and destroyed, fix statistics for large object
+ allocations, using MIMALLOC_VERBOSE=1 has no maximum on the number of error messages, various small fixes.
+
+* 2022-02-14, `v1.7.5`, `v2.0.5` (alpha): fix malloc override on
+ Windows 11, fix compilation with musl, potentially reduced
+ committed memory, add `bin/minject` for Windows,
+ improved wasm support, faster aligned allocation,
+ various small fixes.
+
+* 2021-11-14, `v1.7.3`, `v2.0.3` (beta): improved WASM support, improved macOS support and performance (including
+ M1), improved performance for v2 for large objects, Python integration improvements, more standard
+ installation directories, various small fixes.
+
+* 2021-06-17, `v1.7.2`, `v2.0.2` (beta): support M1, better installation layout on Linux, fix
+ thread_id on Android, prefer 2-6TiB area for aligned allocation to work better on pre-windows 8, various small fixes.
+
+* 2021-04-06, `v1.7.1`, `v2.0.1` (beta): fix bug in arena allocation for huge pages, improved aslr on large allocations, initial M1 support (still experimental).
+
+* 2021-01-31, `v2.0.0`: beta release 2.0: new slice algorithm for managing internal mimalloc pages.
+
+* 2021-01-31, `v1.7.0`: stable release 1.7: support explicit user provided memory regions, more precise statistics,
+ improve macOS overriding, initial support for Apple M1, improved DragonFly support, faster memcpy on Windows, various small fixes.
+
+* [Older release notes](#older-release-notes)
+
+Special thanks to:
+
+* [David Carlier](https://devnexen.blogspot.com/) (@devnexen) for his many contributions, and making
+ mimalloc work better on many less common operating systems, like Haiku, Dragonfly, etc.
+* Mary Feofanova (@mary3000), Evgeniy Moiseenko, and Manuel Pöter (@mpoeter) for making mimalloc TSAN checkable, and finding
+ memory model bugs using the [genMC] model checker.
+* Weipeng Liu (@pongba), Zhuowei Li, Junhua Wang, and Jakub Szymanski, for their early support of mimalloc and deployment
+ at large scale services, leading to many improvements in the mimalloc algorithms for large workloads.
+* Jason Gibson (@jasongibson) for exhaustive testing on large scale workloads and server environments, and finding complex bugs
+ in (early versions of) `mimalloc`.
+* Manuel Pöter (@mpoeter) and Sam Gross(@colesbury) for finding an ABA concurrency issue in abandoned segment reclamation. Sam also created the [no GIL](https://github.com/colesbury/nogil) Python fork which
+ uses mimalloc internally.
+
+
+[genMC]: https://plv.mpi-sws.org/genmc/
+
+### Usage
+
+mimalloc is used in various large scale low-latency services and programs, for example:
+
+<a href="https://www.bing.com"><img height="50" align="left" src="https://upload.wikimedia.org/wikipedia/commons/e/e9/Bing_logo.svg"></a>
+<a href="https://azure.microsoft.com/"><img height="50" align="left" src="https://upload.wikimedia.org/wikipedia/commons/a/a8/Microsoft_Azure_Logo.svg"></a>
+<a href="https://deathstrandingpc.505games.com"><img height="100" src="doc/ds-logo.png"></a>
+<a href="https://docs.unrealengine.com/4.26/en-US/WhatsNew/Builds/ReleaseNotes/4_25/"><img height="100" src="doc/unreal-logo.svg"></a>
+<a href="https://cab.spbu.ru/software/spades/"><img height="100" src="doc/spades-logo.png"></a>
+
+
+# Building
+
+## Windows
+
+Open `ide/vs2019/mimalloc.sln` in Visual Studio 2019 and build.
+The `mimalloc` project builds a static library (in `out/msvc-x64`), while the
+`mimalloc-override` project builds a DLL for overriding malloc
+in the entire program.
+
+## macOS, Linux, BSD, etc.
+
+We use [`cmake`](https://cmake.org)<sup>1</sup> as the build system:
+
+```
+> mkdir -p out/release
+> cd out/release
+> cmake ../..
+> make
+```
+This builds the library as a shared (dynamic)
+library (`.so` or `.dylib`), a static library (`.a`), and
+as a single object file (`.o`).
+
+`> sudo make install` (install the library and header files in `/usr/local/lib` and `/usr/local/include`)
+
+You can build the debug version which does many internal checks and
+maintains detailed statistics as:
+
+```
+> mkdir -p out/debug
+> cd out/debug
+> cmake -DCMAKE_BUILD_TYPE=Debug ../..
+> make
+```
+This will name the shared library as `libmimalloc-debug.so`.
+
+Finally, you can build a _secure_ version that uses guard pages, encrypted
+free lists, etc., as:
+```
+> mkdir -p out/secure
+> cd out/secure
+> cmake -DMI_SECURE=ON ../..
+> make
+```
+This will name the shared library as `libmimalloc-secure.so`.
+Use `ccmake`<sup>2</sup> instead of `cmake`
+to see and customize all the available build options.
+
+Notes:
+1. Install CMake: `sudo apt-get install cmake`
+2. Install CCMake: `sudo apt-get install cmake-curses-gui`
+
+
+## Single source
+
+You can also directly build the single `src/static.c` file as part of your project without
+needing `cmake` at all. Make sure to also add the mimalloc `include` directory to the include path.
+
+
+# Using the library
+
+The preferred usage is including `<mimalloc.h>`, linking with
+the shared- or static library, and using the `mi_malloc` API exclusively for allocation. For example,
+```
+> gcc -o myprogram -lmimalloc myfile.c
+```
+
+mimalloc uses only safe OS calls (`mmap` and `VirtualAlloc`) and can co-exist
+with other allocators linked to the same program.
+If you use `cmake`, you can simply use:
+```
+find_package(mimalloc 1.4 REQUIRED)
+```
+in your `CMakeLists.txt` to find a locally installed mimalloc. Then use either:
+```
+target_link_libraries(myapp PUBLIC mimalloc)
+```
+to link with the shared (dynamic) library, or:
+```
+target_link_libraries(myapp PUBLIC mimalloc-static)
+```
+to link with the static library. See `test\CMakeLists.txt` for an example.
+
+For best performance in C++ programs, it is also recommended to override the
+global `new` and `delete` operators. For convience, mimalloc provides
+[`mimalloc-new-delete.h`](https://github.com/microsoft/mimalloc/blob/master/include/mimalloc-new-delete.h) which does this for you -- just include it in a single(!) source file in your project.
+In C++, mimalloc also provides the `mi_stl_allocator` struct which implements the `std::allocator`
+interface.
+
+You can pass environment variables to print verbose messages (`MIMALLOC_VERBOSE=1`)
+and statistics (`MIMALLOC_SHOW_STATS=1`) (in the debug version):
+```
+> env MIMALLOC_SHOW_STATS=1 ./cfrac 175451865205073170563711388363
+
+175451865205073170563711388363 = 374456281610909315237213 * 468551
+
+heap stats: peak total freed unit
+normal 2: 16.4 kb 17.5 mb 17.5 mb 16 b ok
+normal 3: 16.3 kb 15.2 mb 15.2 mb 24 b ok
+normal 4: 64 b 4.6 kb 4.6 kb 32 b ok
+normal 5: 80 b 118.4 kb 118.4 kb 40 b ok
+normal 6: 48 b 48 b 48 b 48 b ok
+normal 17: 960 b 960 b 960 b 320 b ok
+
+heap stats: peak total freed unit
+ normal: 33.9 kb 32.8 mb 32.8 mb 1 b ok
+ huge: 0 b 0 b 0 b 1 b ok
+ total: 33.9 kb 32.8 mb 32.8 mb 1 b ok
+malloc requested: 32.8 mb
+
+ committed: 58.2 kb 58.2 kb 58.2 kb 1 b ok
+ reserved: 2.0 mb 2.0 mb 2.0 mb 1 b ok
+ reset: 0 b 0 b 0 b 1 b ok
+ segments: 1 1 1
+-abandoned: 0
+ pages: 6 6 6
+-abandoned: 0
+ mmaps: 3
+ mmap fast: 0
+ mmap slow: 1
+ threads: 0
+ elapsed: 2.022s
+ process: user: 1.781s, system: 0.016s, faults: 756, reclaims: 0, rss: 2.7 mb
+```
+
+The above model of using the `mi_` prefixed API is not always possible
+though in existing programs that already use the standard malloc interface,
+and another option is to override the standard malloc interface
+completely and redirect all calls to the _mimalloc_ library instead .
+
+## Environment Options
+
+You can set further options either programmatically (using [`mi_option_set`](https://microsoft.github.io/mimalloc/group__options.html)),
+or via environment variables:
+
+- `MIMALLOC_SHOW_STATS=1`: show statistics when the program terminates.
+- `MIMALLOC_VERBOSE=1`: show verbose messages.
+- `MIMALLOC_SHOW_ERRORS=1`: show error and warning messages.
+- `MIMALLOC_PAGE_RESET=0`: by default, mimalloc will reset (or purge) OS pages that are not in use, to signal to the OS
+ that the underlying physical memory can be reused. This can reduce memory fragmentation in long running (server)
+ programs. By setting it to `0` this will no longer be done which can improve performance for batch-like programs.
+ As an alternative, the `MIMALLOC_RESET_DELAY=`<msecs> can be set higher (100ms by default) to make the page
+ reset occur less frequently instead of turning it off completely.
+- `MIMALLOC_USE_NUMA_NODES=N`: pretend there are at most `N` NUMA nodes. If not set, the actual NUMA nodes are detected
+ at runtime. Setting `N` to 1 may avoid problems in some virtual environments. Also, setting it to a lower number than
+ the actual NUMA nodes is fine and will only cause threads to potentially allocate more memory across actual NUMA
+ nodes (but this can happen in any case as NUMA local allocation is always a best effort but not guaranteed).
+- `MIMALLOC_LARGE_OS_PAGES=1`: use large OS pages (2MiB) when available; for some workloads this can significantly
+ improve performance. Use `MIMALLOC_VERBOSE` to check if the large OS pages are enabled -- usually one needs
+ to explicitly allow large OS pages (as on [Windows][windows-huge] and [Linux][linux-huge]). However, sometimes
+ the OS is very slow to reserve contiguous physical memory for large OS pages so use with care on systems that
+ can have fragmented memory (for that reason, we generally recommend to use `MIMALLOC_RESERVE_HUGE_OS_PAGES` instead whenever possible).
+ <!--
+ - `MIMALLOC_EAGER_REGION_COMMIT=1`: on Windows, commit large (256MiB) regions eagerly. On Windows, these regions
+ show in the working set even though usually just a small part is committed to physical memory. This is why it
+ turned off by default on Windows as it looks not good in the task manager. However, turning it on has no
+ real drawbacks and may improve performance by a little.
+ -->
+- `MIMALLOC_RESERVE_HUGE_OS_PAGES=N`: where N is the number of 1GiB _huge_ OS pages. This reserves the huge pages at
+ startup and sometimes this can give a large (latency) performance improvement on big workloads.
+ Usually it is better to not use
+ `MIMALLOC_LARGE_OS_PAGES` in combination with this setting. Just like large OS pages, use with care as reserving
+ contiguous physical memory can take a long time when memory is fragmented (but reserving the huge pages is done at
+ startup only once).
+ Note that we usually need to explicitly enable huge OS pages (as on [Windows][windows-huge] and [Linux][linux-huge])).
+ With huge OS pages, it may be beneficial to set the setting
+ `MIMALLOC_EAGER_COMMIT_DELAY=N` (`N` is 1 by default) to delay the initial `N` segments (of 4MiB)
+ of a thread to not allocate in the huge OS pages; this prevents threads that are short lived
+ and allocate just a little to take up space in the huge OS page area (which cannot be reset).
+ The huge pages are usually allocated evenly among NUMA nodes.
+ We can use `MIMALLOC_RESERVE_HUGE_OS_PAGES_AT=N` where `N` is the numa node (starting at 0) to allocate all
+ the huge pages at a specific numa node instead.
+
+Use caution when using `fork` in combination with either large or huge OS pages: on a fork, the OS uses copy-on-write
+for all pages in the original process including the huge OS pages. When any memory is now written in that area, the
+OS will copy the entire 1GiB huge page (or 2MiB large page) which can cause the memory usage to grow in large increments.
+
+[linux-huge]: https://access.redhat.com/documentation/en-us/red_hat_enterprise_linux/5/html/tuning_and_optimizing_red_hat_enterprise_linux_for_oracle_9i_and_10g_databases/sect-oracle_9i_and_10g_tuning_guide-large_memory_optimization_big_pages_and_huge_pages-configuring_huge_pages_in_red_hat_enterprise_linux_4_or_5
+[windows-huge]: https://docs.microsoft.com/en-us/sql/database-engine/configure-windows/enable-the-lock-pages-in-memory-option-windows?view=sql-server-2017
+
+## Secure Mode
+
+_mimalloc_ can be build in secure mode by using the `-DMI_SECURE=ON` flags in `cmake`. This build enables various mitigations
+to make mimalloc more robust against exploits. In particular:
+
+- All internal mimalloc pages are surrounded by guard pages and the heap metadata is behind a guard page as well (so a buffer overflow
+ exploit cannot reach into the metadata).
+- All free list pointers are
+ [encoded](https://github.com/microsoft/mimalloc/blob/783e3377f79ee82af43a0793910a9f2d01ac7863/include/mimalloc-internal.h#L396)
+ with per-page keys which is used both to prevent overwrites with a known pointer, as well as to detect heap corruption.
+- Double free's are detected (and ignored).
+- The free lists are initialized in a random order and allocation randomly chooses between extension and reuse within a page to
+ mitigate against attacks that rely on a predicable allocation order. Similarly, the larger heap blocks allocated by mimalloc
+ from the OS are also address randomized.
+
+As always, evaluate with care as part of an overall security strategy as all of the above are mitigations but not guarantees.
+
+## Debug Mode
+
+When _mimalloc_ is built using debug mode, various checks are done at runtime to catch development errors.
+
+- Statistics are maintained in detail for each object size. They can be shown using `MIMALLOC_SHOW_STATS=1` at runtime.
+- All objects have padding at the end to detect (byte precise) heap block overflows.
+- Double free's, and freeing invalid heap pointers are detected.
+- Corrupted free-lists and some forms of use-after-free are detected.
+
+
+# Overriding Standard Malloc
+
+Overriding the standard `malloc` (and `new`) can be done either _dynamically_ or _statically_.
+
+## Dynamic override
+
+This is the recommended way to override the standard malloc interface.
+
+### Override on Linux, BSD
+
+On these ELF-based systems we preload the mimalloc shared
+library so all calls to the standard `malloc` interface are
+resolved to the _mimalloc_ library.
+```
+> env LD_PRELOAD=/usr/lib/libmimalloc.so myprogram
+```
+
+You can set extra environment variables to check that mimalloc is running,
+like:
+```
+> env MIMALLOC_VERBOSE=1 LD_PRELOAD=/usr/lib/libmimalloc.so myprogram
+```
+or run with the debug version to get detailed statistics:
+```
+> env MIMALLOC_SHOW_STATS=1 LD_PRELOAD=/usr/lib/libmimalloc-debug.so myprogram
+```
+
+### Override on MacOS
+
+On macOS we can also preload the mimalloc shared
+library so all calls to the standard `malloc` interface are
+resolved to the _mimalloc_ library.
+```
+> env DYLD_INSERT_LIBRARIES=/usr/lib/libmimalloc.dylib myprogram
+```
+
+Note that certain security restrictions may apply when doing this from
+the [shell](https://stackoverflow.com/questions/43941322/dyld-insert-libraries-ignored-when-calling-application-through-bash).
+
+
+### Override on Windows
+
+<span id="override_on_windows">Overriding on Windows</span> is robust and has the
+particular advantage to be able to redirect all malloc/free calls that go through
+the (dynamic) C runtime allocator, including those from other DLL's or libraries.
+
+The overriding on Windows requires that you link your program explicitly with
+the mimalloc DLL and use the C-runtime library as a DLL (using the `/MD` or `/MDd` switch).
+Also, the `mimalloc-redirect.dll` (or `mimalloc-redirect32.dll`) must be put
+in the same folder as the main `mimalloc-override.dll` at runtime (as it is a dependency).
+The redirection DLL ensures that all calls to the C runtime malloc API get redirected to
+mimalloc (in `mimalloc-override.dll`).
+
+To ensure the mimalloc DLL is loaded at run-time it is easiest to insert some
+call to the mimalloc API in the `main` function, like `mi_version()`
+(or use the `/INCLUDE:mi_version` switch on the linker). See the `mimalloc-override-test` project
+for an example on how to use this. For best performance on Windows with C++, it
+is also recommended to also override the `new`/`delete` operations (by including
+[`mimalloc-new-delete.h`](https://github.com/microsoft/mimalloc/blob/master/include/mimalloc-new-delete.h) a single(!) source file in your project).
+
+The environment variable `MIMALLOC_DISABLE_REDIRECT=1` can be used to disable dynamic
+overriding at run-time. Use `MIMALLOC_VERBOSE=1` to check if mimalloc was successfully redirected.
+
+(Note: in principle, it is possible to even patch existing executables without any recompilation
+if they are linked with the dynamic C runtime (`ucrtbase.dll`) -- just put the `mimalloc-override.dll`
+into the import table (and put `mimalloc-redirect.dll` in the same folder)
+Such patching can be done for example with [CFF Explorer](https://ntcore.com/?page_id=388)).
+
+
+## Static override
+
+On Unix-like systems, you can also statically link with _mimalloc_ to override the standard
+malloc interface. The recommended way is to link the final program with the
+_mimalloc_ single object file (`mimalloc-override.o`). We use
+an object file instead of a library file as linkers give preference to
+that over archives to resolve symbols. To ensure that the standard
+malloc interface resolves to the _mimalloc_ library, link it as the first
+object file. For example:
+```
+> gcc -o myprogram mimalloc-override.o myfile1.c ...
+```
+
+Another way to override statically that works on all platforms, is to
+link statically to mimalloc (as shown in the introduction) and include a
+header file in each source file that re-defines `malloc` etc. to `mi_malloc`.
+This is provided by [`mimalloc-override.h`](https://github.com/microsoft/mimalloc/blob/master/include/mimalloc-override.h). This only works reliably though if all sources are
+under your control or otherwise mixing of pointers from different heaps may occur!
+
+
+# Performance
+
+Last update: 2021-01-30
+
+We tested _mimalloc_ against many other top allocators over a wide
+range of benchmarks, ranging from various real world programs to
+synthetic benchmarks that see how the allocator behaves under more
+extreme circumstances. In our benchmark suite, _mimalloc_ outperforms other leading
+allocators (_jemalloc_, _tcmalloc_, _Hoard_, etc), and has a similar memory footprint. A nice property is that it
+does consistently well over the wide range of benchmarks.
+
+General memory allocators are interesting as there exists no algorithm that is
+optimal -- for a given allocator one can usually construct a workload
+where it does not do so well. The goal is thus to find an allocation
+strategy that performs well over a wide range of benchmarks without
+suffering from (too much) underperformance in less common situations.
+
+As always, interpret these results with care since some benchmarks test synthetic
+or uncommon situations that may never apply to your workloads. For example, most
+allocators do not do well on `xmalloc-testN` but that includes even the best
+industrial allocators like _jemalloc_ and _tcmalloc_ that are used in some of
+the world's largest systems (like Chrome or FreeBSD).
+
+Also, the benchmarks here do not measure the behaviour on very large and long-running server workloads,
+or worst-case latencies of allocation. Much work has gone into `mimalloc` to work well on such
+workloads (for example, to reduce virtual memory fragmentation on long-running services)
+but such optimizations are not always reflected in the current benchmark suite.
+
+We show here only an overview -- for
+more specific details and further benchmarks we refer to the
+[technical report](https://www.microsoft.com/en-us/research/publication/mimalloc-free-list-sharding-in-action).
+The benchmark suite is automated and available separately
+as [mimalloc-bench](https://github.com/daanx/mimalloc-bench).
+
+
+## Benchmark Results on a 16-core AMD 5950x (Zen3)
+
+Testing on the 16-core AMD 5950x processor at 3.4Ghz (4.9Ghz boost), with
+with 32GiB memory at 3600Mhz, running Ubuntu 20.04 with glibc 2.31 and GCC 9.3.0.
+
+We measure three versions of _mimalloc_: the main version `mi` (tag:v1.7.0),
+the new v2.0 beta version as `xmi` (tag:v2.0.0), and the main version in secure mode as `smi` (tag:v1.7.0).
+
+The other allocators are
+Google's [_tcmalloc_](https://github.com/gperftools/gperftools) (`tc`, tag:gperftools-2.8.1) used in Chrome,
+Facebook's [_jemalloc_](https://github.com/jemalloc/jemalloc) (`je`, tag:5.2.1) by Jason Evans used in Firefox and FreeBSD,
+the Intel thread building blocks [allocator](https://github.com/intel/tbb) (`tbb`, tag:v2020.3),
+[rpmalloc](https://github.com/mjansson/rpmalloc) (`rp`,tag:1.4.1) by Mattias Jansson,
+the original scalable [_Hoard_](https://github.com/emeryberger/Hoard) (git:d880f72) allocator by Emery Berger \[1],
+the memory compacting [_Mesh_](https://github.com/plasma-umass/Mesh) (git:67ff31a) allocator by
+Bobby Powers _et al_ \[8],
+and finally the default system allocator (`glibc`, 2.31) (based on _PtMalloc2_).
+
+<img width="90%" src="doc/bench-2021/bench-amd5950x-2021-01-30-a.svg"/>
+<img width="90%" src="doc/bench-2021/bench-amd5950x-2021-01-30-b.svg"/>
+
+Any benchmarks ending in `N` run on all 32 logical cores in parallel.
+Results are averaged over 10 runs and reported relative
+to mimalloc (where 1.2 means it took 1.2&times; longer to run).
+The legend also contains the _overall relative score_ between the
+allocators where 100 points is the maximum if an allocator is fastest on
+all benchmarks.
+
+The single threaded _cfrac_ benchmark by Dave Barrett is an implementation of
+continued fraction factorization which uses many small short-lived allocations.
+All allocators do well on such common usage, where _mimalloc_ is just a tad
+faster than _tcmalloc_ and
+_jemalloc_.
+
+The _leanN_ program is interesting as a large realistic and
+concurrent workload of the [Lean](https://github.com/leanprover/lean)
+theorem prover compiling its own standard library, and there is a 13%
+speedup over _tcmalloc_. This is
+quite significant: if Lean spends 20% of its time in the
+allocator that means that _mimalloc_ is 1.6&times; faster than _tcmalloc_
+here. (This is surprising as that is not measured in a pure
+allocation benchmark like _alloc-test_. We conjecture that we see this
+outsized improvement here because _mimalloc_ has better locality in
+the allocation which improves performance for the *other* computations
+in a program as well).
+
+The single threaded _redis_ benchmark again show that most allocators do well on such workloads.
+
+The _larsonN_ server benchmark by Larson and Krishnan \[2] allocates and frees between threads. They observed this
+behavior (which they call _bleeding_) in actual server applications, and the benchmark simulates this.
+Here, _mimalloc_ is quite a bit faster than _tcmalloc_ and _jemalloc_ probably due to the object migration between different threads.
+
+The _mstressN_ workload performs many allocations and re-allocations,
+and migrates objects between threads (as in _larsonN_). However, it also
+creates and destroys the _N_ worker threads a few times keeping some objects
+alive beyond the life time of the allocating thread. We observed this
+behavior in many larger server applications.
+
+The [_rptestN_](https://github.com/mjansson/rpmalloc-benchmark) benchmark
+by Mattias Jansson is a allocator test originally designed
+for _rpmalloc_, and tries to simulate realistic allocation patterns over
+multiple threads. Here the differences between allocators become more apparent.
+
+The second benchmark set tests specific aspects of the allocators and
+shows even more extreme differences between them.
+
+The _alloc-test_, by
+[OLogN Technologies AG](http://ithare.com/testing-memory-allocators-ptmalloc2-tcmalloc-hoard-jemalloc-while-trying-to-simulate-real-world-loads/), is a very allocation intensive benchmark doing millions of
+allocations in various size classes. The test is scaled such that when an
+allocator performs almost identically on _alloc-test1_ as _alloc-testN_ it
+means that it scales linearly.
+
+The _sh6bench_ and _sh8bench_ benchmarks are
+developed by [MicroQuill](http://www.microquill.com/) as part of SmartHeap.
+In _sh6bench_ _mimalloc_ does much
+better than the others (more than 2.5&times; faster than _jemalloc_).
+We cannot explain this well but believe it is
+caused in part by the "reverse" free-ing pattern in _sh6bench_.
+The _sh8bench_ is a variation with object migration
+between threads; whereas _tcmalloc_ did well on _sh6bench_, the addition of object migration causes it to be 10&times; slower than before.
+
+The _xmalloc-testN_ benchmark by Lever and Boreham \[5] and Christian Eder, simulates an asymmetric workload where
+some threads only allocate, and others only free -- they observed this pattern in
+larger server applications. Here we see that
+the _mimalloc_ technique of having non-contended sharded thread free
+lists pays off as it outperforms others by a very large margin. Only _rpmalloc_, _tbb_, and _glibc_ also scale well on this benchmark.
+
+The _cache-scratch_ benchmark by Emery Berger \[1], and introduced with
+the Hoard allocator to test for _passive-false_ sharing of cache lines.
+With a single thread they all
+perform the same, but when running with multiple threads the potential allocator
+induced false sharing of the cache lines can cause large run-time differences.
+Crundal \[6] describes in detail why the false cache line sharing occurs in the _tcmalloc_ design, and also discusses how this
+can be avoided with some small implementation changes.
+Only the _tbb_, _rpmalloc_ and _mesh_ allocators also avoid the
+cache line sharing completely, while _Hoard_ and _glibc_ seem to mitigate
+the effects. Kukanov and Voss \[7] describe in detail
+how the design of _tbb_ avoids the false cache line sharing.
+
+
+## On a 36-core Intel Xeon
+
+For completeness, here are the results on a big Amazon
+[c5.18xlarge](https://aws.amazon.com/ec2/instance-types/#Compute_Optimized) instance
+consisting of a 2&times;18-core Intel Xeon (Cascade Lake) at 3.4GHz (boost 3.5GHz)
+with 144GiB ECC memory, running Ubuntu 20.04 with glibc 2.31, GCC 9.3.0, and
+Clang 10.0.0. This time, the mimalloc allocators (mi, xmi, and smi) were
+compiled with the Clang compiler instead of GCC.
+The results are similar to the AMD results but it is interesting to
+see the differences in the _larsonN_, _mstressN_, and _xmalloc-testN_ benchmarks.
+
+<img width="90%" src="doc/bench-2021/bench-c5-18xlarge-2021-01-30-a.svg"/>
+<img width="90%" src="doc/bench-2021/bench-c5-18xlarge-2021-01-30-b.svg"/>
+
+
+## Peak Working Set
+
+The following figure shows the peak working set (rss) of the allocators
+on the benchmarks (on the c5.18xlarge instance).
+
+<img width="90%" src="doc/bench-2021/bench-c5-18xlarge-2021-01-30-rss-a.svg"/>
+<img width="90%" src="doc/bench-2021/bench-c5-18xlarge-2021-01-30-rss-b.svg"/>
+
+Note that the _xmalloc-testN_ memory usage should be disregarded as it
+allocates more the faster the program runs. Similarly, memory usage of
+_larsonN_, _mstressN_, _rptestN_ and _sh8bench_ can vary depending on scheduling and
+speed. Nevertheless, we hope to improve the memory usage on _mstressN_
+and _rptestN_ (just as _cfrac_, _larsonN_ and _sh8bench_ have a small working set which skews the results).
+
+<!--
+# Previous Benchmarks
+
+Todo: should we create a separate page for this?
+
+## Benchmark Results on 36-core Intel: 2020-01-20
+
+Testing on a big Amazon EC2 compute instance
+([c5.18xlarge](https://aws.amazon.com/ec2/instance-types/#Compute_Optimized))
+consisting of a 72 processor Intel Xeon at 3GHz
+with 144GiB ECC memory, running Ubuntu 18.04.1 with glibc 2.27 and GCC 7.4.0.
+The measured allocators are _mimalloc_ (xmi, tag:v1.4.0, page reset enabled)
+and its secure build as _smi_,
+Google's [_tcmalloc_](https://github.com/gperftools/gperftools) (tc, tag:gperftools-2.7) used in Chrome,
+Facebook's [_jemalloc_](https://github.com/jemalloc/jemalloc) (je, tag:5.2.1) by Jason Evans used in Firefox and FreeBSD,
+the Intel thread building blocks [allocator](https://github.com/intel/tbb) (tbb, tag:2020),
+[rpmalloc](https://github.com/mjansson/rpmalloc) (rp,tag:1.4.0) by Mattias Jansson,
+the original scalable [_Hoard_](https://github.com/emeryberger/Hoard) (tag:3.13) allocator by Emery Berger \[1],
+the memory compacting [_Mesh_](https://github.com/plasma-umass/Mesh) (git:51222e7) allocator by
+Bobby Powers _et al_ \[8],
+and finally the default system allocator (glibc, 2.27) (based on _PtMalloc2_).
+
+<img width="90%" src="doc/bench-2020/bench-c5-18xlarge-2020-01-20-a.svg"/>
+<img width="90%" src="doc/bench-2020/bench-c5-18xlarge-2020-01-20-b.svg"/>
+
+The following figure shows the peak working set (rss) of the allocators
+on the benchmarks (on the c5.18xlarge instance).
+
+<img width="90%" src="doc/bench-2020/bench-c5-18xlarge-2020-01-20-rss-a.svg"/>
+<img width="90%" src="doc/bench-2020/bench-c5-18xlarge-2020-01-20-rss-b.svg"/>
+
+
+## On 24-core AMD Epyc, 2020-01-16
+
+For completeness, here are the results on a
+[r5a.12xlarge](https://aws.amazon.com/ec2/instance-types/#Memory_Optimized) instance
+having a 48 processor AMD Epyc 7000 at 2.5GHz with 384GiB of memory.
+The results are similar to the Intel results but it is interesting to
+see the differences in the _larsonN_, _mstressN_, and _xmalloc-testN_ benchmarks.
+
+<img width="90%" src="doc/bench-2020/bench-r5a-12xlarge-2020-01-16-a.svg"/>
+<img width="90%" src="doc/bench-2020/bench-r5a-12xlarge-2020-01-16-b.svg"/>
+
+-->
+
+
+# References
+
+- \[1] Emery D. Berger, Kathryn S. McKinley, Robert D. Blumofe, and Paul R. Wilson.
+ _Hoard: A Scalable Memory Allocator for Multithreaded Applications_
+ the Ninth International Conference on Architectural Support for Programming Languages and Operating Systems (ASPLOS-IX). Cambridge, MA, November 2000.
+ [pdf](http://www.cs.utexas.edu/users/mckinley/papers/asplos-2000.pdf)
+
+- \[2] P. Larson and M. Krishnan. _Memory allocation for long-running server applications_.
+ In ISMM, Vancouver, B.C., Canada, 1998. [pdf](http://citeseer.ist.psu.edu/viewdoc/download?doi=10.1.1.45.1947&rep=rep1&type=pdf)
+
+- \[3] D. Grunwald, B. Zorn, and R. Henderson.
+ _Improving the cache locality of memory allocation_. In R. Cartwright, editor,
+ Proceedings of the Conference on Programming Language Design and Implementation, pages 177–186, New York, NY, USA, June 1993. [pdf](http://citeseer.ist.psu.edu/viewdoc/download?doi=10.1.1.43.6621&rep=rep1&type=pdf)
+
+- \[4] J. Barnes and P. Hut. _A hierarchical O(n*log(n)) force-calculation algorithm_. Nature, 324:446-449, 1986.
+
+- \[5] C. Lever, and D. Boreham. _Malloc() Performance in a Multithreaded Linux Environment._
+ In USENIX Annual Technical Conference, Freenix Session. San Diego, CA. Jun. 2000.
+ Available at <https://github.com/kuszmaul/SuperMalloc/tree/master/tests>
+
+- \[6] Timothy Crundal. _Reducing Active-False Sharing in TCMalloc_. 2016. CS16S1 project at the Australian National University. [pdf](http://courses.cecs.anu.edu.au/courses/CSPROJECTS/16S1/Reports/Timothy_Crundal_Report.pdf)
+
+- \[7] Alexey Kukanov, and Michael J Voss.
+ _The Foundations for Scalable Multi-Core Software in Intel Threading Building Blocks._
+ Intel Technology Journal 11 (4). 2007
+
+- \[8] Bobby Powers, David Tench, Emery D. Berger, and Andrew McGregor.
+ _Mesh: Compacting Memory Management for C/C++_
+ In Proceedings of the 40th ACM SIGPLAN Conference on Programming Language Design and Implementation (PLDI'19), June 2019, pages 333-–346.
+
+<!--
+- \[9] Paul Liétar, Theodore Butler, Sylvan Clebsch, Sophia Drossopoulou, Juliana Franco, Matthew J Parkinson,
+ Alex Shamis, Christoph M Wintersteiger, and David Chisnall.
+ _Snmalloc: A Message Passing Allocator._
+ In Proceedings of the 2019 ACM SIGPLAN International Symposium on Memory Management, 122–135. ACM. 2019.
+-->
+
+# Contributing
+
+This project welcomes contributions and suggestions. Most contributions require you to agree to a
+Contributor License Agreement (CLA) declaring that you have the right to, and actually do, grant us
+the rights to use your contribution. For details, visit https://cla.microsoft.com.
+
+When you submit a pull request, a CLA-bot will automatically determine whether you need to provide
+a CLA and decorate the PR appropriately (e.g., label, comment). Simply follow the instructions
+provided by the bot. You will only need to do this once across all repos using our CLA.
+
+
+# Older Release Notes
+
+* 2020-09-24, `v1.6.7`: stable release 1.6: using standard C atomics, passing tsan testing, improved
+ handling of failing to commit on Windows, add [`mi_process_info`](https://github.com/microsoft/mimalloc/blob/master/include/mimalloc.h#L156) api call.
+* 2020-08-06, `v1.6.4`: stable release 1.6: improved error recovery in low-memory situations,
+ support for IllumOS and Haiku, NUMA support for Vista/XP, improved NUMA detection for AMD Ryzen, ubsan support.
+* 2020-05-05, `v1.6.3`: stable release 1.6: improved behavior in out-of-memory situations, improved malloc zones on macOS,
+ build PIC static libraries by default, add option to abort on out-of-memory, line buffered statistics.
+* 2020-04-20, `v1.6.2`: stable release 1.6: fix compilation on Android, MingW, Raspberry, and Conda,
+ stability fix for Windows 7, fix multiple mimalloc instances in one executable, fix `strnlen` overload,
+ fix aligned debug padding.
+* 2020-02-17, `v1.6.1`: stable release 1.6: minor updates (build with clang-cl, fix alignment issue for small objects).
+* 2020-02-09, `v1.6.0`: stable release 1.6: fixed potential memory leak, improved overriding
+ and thread local support on FreeBSD, NetBSD, DragonFly, and macOSX. New byte-precise
+ heap block overflow detection in debug mode (besides the double-free detection and free-list
+ corruption detection). Add `nodiscard` attribute to most allocation functions.
+ Enable `MIMALLOC_PAGE_RESET` by default. New reclamation strategy for abandoned heap pages
+ for better memory footprint.
+* 2020-02-09, `v1.5.0`: stable release 1.5: improved free performance, small bug fixes.
+* 2020-01-22, `v1.4.0`: stable release 1.4: improved performance for delayed OS page reset,
+more eager concurrent free, addition of STL allocator, fixed potential memory leak.
+* 2020-01-15, `v1.3.0`: stable release 1.3: bug fixes, improved randomness and [stronger
+free list encoding](https://github.com/microsoft/mimalloc/blob/783e3377f79ee82af43a0793910a9f2d01ac7863/include/mimalloc-internal.h#L396) in secure mode.
+* 2019-12-22, `v1.2.2`: stable release 1.2: minor updates.
+* 2019-11-22, `v1.2.0`: stable release 1.2: bug fixes, improved secure mode (free list corruption checks, double free mitigation). Improved dynamic overriding on Windows.
+* 2019-10-07, `v1.1.0`: stable release 1.1.
+* 2019-09-01, `v1.0.8`: pre-release 8: more robust windows dynamic overriding, initial huge page support.
+* 2019-08-10, `v1.0.6`: pre-release 6: various performance improvements.
+
diff --git a/source/luametatex/source/libraries/mimalloc/src/alloc-aligned.c b/source/luametatex/source/libraries/mimalloc/src/alloc-aligned.c
new file mode 100644
index 000000000..fce0fd749
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/alloc-aligned.c
@@ -0,0 +1,261 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+
+#include <string.h> // memset
+
+// ------------------------------------------------------
+// Aligned Allocation
+// ------------------------------------------------------
+
+// Fallback primitive aligned allocation -- split out for better codegen
+static mi_decl_noinline void* mi_heap_malloc_zero_aligned_at_fallback(mi_heap_t* const heap, const size_t size, const size_t alignment, const size_t offset, const bool zero) mi_attr_noexcept
+{
+ mi_assert_internal(size <= PTRDIFF_MAX);
+ mi_assert_internal(alignment!=0 && _mi_is_power_of_two(alignment) && alignment <= MI_ALIGNMENT_MAX);
+
+ const uintptr_t align_mask = alignment-1; // for any x, `(x & align_mask) == (x % alignment)`
+ const size_t padsize = size + MI_PADDING_SIZE;
+
+ // use regular allocation if it is guaranteed to fit the alignment constraints
+ if (offset==0 && alignment<=padsize && padsize<=MI_MAX_ALIGN_GUARANTEE && (padsize&align_mask)==0) {
+ void* p = _mi_heap_malloc_zero(heap, size, zero);
+ mi_assert_internal(p == NULL || ((uintptr_t)p % alignment) == 0);
+ return p;
+ }
+
+ // otherwise over-allocate
+ void* p = _mi_heap_malloc_zero(heap, size + alignment - 1, zero);
+ if (p == NULL) return NULL;
+
+ // .. and align within the allocation
+ uintptr_t adjust = alignment - (((uintptr_t)p + offset) & align_mask);
+ mi_assert_internal(adjust <= alignment);
+ void* aligned_p = (adjust == alignment ? p : (void*)((uintptr_t)p + adjust));
+ if (aligned_p != p) mi_page_set_has_aligned(_mi_ptr_page(p), true);
+ mi_assert_internal(((uintptr_t)aligned_p + offset) % alignment == 0);
+ mi_assert_internal(p == _mi_page_ptr_unalign(_mi_ptr_segment(aligned_p), _mi_ptr_page(aligned_p), aligned_p));
+ return aligned_p;
+}
+
+// Primitive aligned allocation
+static void* mi_heap_malloc_zero_aligned_at(mi_heap_t* const heap, const size_t size, const size_t alignment, const size_t offset, const bool zero) mi_attr_noexcept
+{
+ // note: we don't require `size > offset`, we just guarantee that the address at offset is aligned regardless of the allocated size.
+ mi_assert(alignment > 0);
+ if (mi_unlikely(alignment==0 || !_mi_is_power_of_two(alignment))) { // require power-of-two (see <https://en.cppreference.com/w/c/memory/aligned_alloc>)
+ #if MI_DEBUG > 0
+ _mi_error_message(EOVERFLOW, "aligned allocation requires the alignment to be a power-of-two (size %zu, alignment %zu)\n", size, alignment);
+ #endif
+ return NULL;
+ }
+ if (mi_unlikely(alignment > MI_ALIGNMENT_MAX)) { // we cannot align at a boundary larger than this (or otherwise we cannot find segment headers)
+ #if MI_DEBUG > 0
+ _mi_error_message(EOVERFLOW, "aligned allocation has a maximum alignment of %zu (size %zu, alignment %zu)\n", MI_ALIGNMENT_MAX, size, alignment);
+ #endif
+ return NULL;
+ }
+ if (mi_unlikely(size > PTRDIFF_MAX)) { // we don't allocate more than PTRDIFF_MAX (see <https://sourceware.org/ml/libc-announce/2019/msg00001.html>)
+ #if MI_DEBUG > 0
+ _mi_error_message(EOVERFLOW, "aligned allocation request is too large (size %zu, alignment %zu)\n", size, alignment);
+ #endif
+ return NULL;
+ }
+ const uintptr_t align_mask = alignment-1; // for any x, `(x & align_mask) == (x % alignment)`
+ const size_t padsize = size + MI_PADDING_SIZE; // note: cannot overflow due to earlier size > PTRDIFF_MAX check
+
+ // try first if there happens to be a small block available with just the right alignment
+ if (mi_likely(padsize <= MI_SMALL_SIZE_MAX)) {
+ mi_page_t* page = _mi_heap_get_free_small_page(heap, padsize);
+ const bool is_aligned = (((uintptr_t)page->free+offset) & align_mask)==0;
+ if (mi_likely(page->free != NULL && is_aligned))
+ {
+ #if MI_STAT>1
+ mi_heap_stat_increase(heap, malloc, size);
+ #endif
+ void* p = _mi_page_malloc(heap, page, padsize); // TODO: inline _mi_page_malloc
+ mi_assert_internal(p != NULL);
+ mi_assert_internal(((uintptr_t)p + offset) % alignment == 0);
+ if (zero) { _mi_block_zero_init(page, p, size); }
+ return p;
+ }
+ }
+ // fallback
+ return mi_heap_malloc_zero_aligned_at_fallback(heap, size, alignment, offset, zero);
+}
+
+
+// ------------------------------------------------------
+// Optimized mi_heap_malloc_aligned / mi_malloc_aligned
+// ------------------------------------------------------
+
+mi_decl_restrict void* mi_heap_malloc_aligned_at(mi_heap_t* heap, size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_malloc_zero_aligned_at(heap, size, alignment, offset, false);
+}
+
+mi_decl_restrict void* mi_heap_malloc_aligned(mi_heap_t* heap, size_t size, size_t alignment) mi_attr_noexcept {
+ #if !MI_PADDING
+ // without padding, any small sized allocation is naturally aligned (see also `_mi_segment_page_start`)
+ if (!_mi_is_power_of_two(alignment)) return NULL;
+ if (mi_likely(_mi_is_power_of_two(size) && size >= alignment && size <= MI_SMALL_SIZE_MAX))
+ #else
+ // with padding, we can only guarantee this for fixed alignments
+ if (mi_likely((alignment == sizeof(void*) || (alignment == MI_MAX_ALIGN_SIZE && size > (MI_MAX_ALIGN_SIZE/2)))
+ && size <= MI_SMALL_SIZE_MAX))
+ #endif
+ {
+ // fast path for common alignment and size
+ return mi_heap_malloc_small(heap, size);
+ }
+ else {
+ return mi_heap_malloc_aligned_at(heap, size, alignment, 0);
+ }
+}
+
+// ------------------------------------------------------
+// Aligned Allocation
+// ------------------------------------------------------
+
+mi_decl_restrict void* mi_heap_zalloc_aligned_at(mi_heap_t* heap, size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_malloc_zero_aligned_at(heap, size, alignment, offset, true);
+}
+
+mi_decl_restrict void* mi_heap_zalloc_aligned(mi_heap_t* heap, size_t size, size_t alignment) mi_attr_noexcept {
+ return mi_heap_zalloc_aligned_at(heap, size, alignment, 0);
+}
+
+mi_decl_restrict void* mi_heap_calloc_aligned_at(mi_heap_t* heap, size_t count, size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(count, size, &total)) return NULL;
+ return mi_heap_zalloc_aligned_at(heap, total, alignment, offset);
+}
+
+mi_decl_restrict void* mi_heap_calloc_aligned(mi_heap_t* heap, size_t count, size_t size, size_t alignment) mi_attr_noexcept {
+ return mi_heap_calloc_aligned_at(heap,count,size,alignment,0);
+}
+
+mi_decl_restrict void* mi_malloc_aligned_at(size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_malloc_aligned_at(mi_get_default_heap(), size, alignment, offset);
+}
+
+mi_decl_restrict void* mi_malloc_aligned(size_t size, size_t alignment) mi_attr_noexcept {
+ return mi_heap_malloc_aligned(mi_get_default_heap(), size, alignment);
+}
+
+mi_decl_restrict void* mi_zalloc_aligned_at(size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_zalloc_aligned_at(mi_get_default_heap(), size, alignment, offset);
+}
+
+mi_decl_restrict void* mi_zalloc_aligned(size_t size, size_t alignment) mi_attr_noexcept {
+ return mi_heap_zalloc_aligned(mi_get_default_heap(), size, alignment);
+}
+
+mi_decl_restrict void* mi_calloc_aligned_at(size_t count, size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_calloc_aligned_at(mi_get_default_heap(), count, size, alignment, offset);
+}
+
+mi_decl_restrict void* mi_calloc_aligned(size_t count, size_t size, size_t alignment) mi_attr_noexcept {
+ return mi_heap_calloc_aligned(mi_get_default_heap(), count, size, alignment);
+}
+
+
+// ------------------------------------------------------
+// Aligned re-allocation
+// ------------------------------------------------------
+
+static void* mi_heap_realloc_zero_aligned_at(mi_heap_t* heap, void* p, size_t newsize, size_t alignment, size_t offset, bool zero) mi_attr_noexcept {
+ mi_assert(alignment > 0);
+ if (alignment <= sizeof(uintptr_t)) return _mi_heap_realloc_zero(heap,p,newsize,zero);
+ if (p == NULL) return mi_heap_malloc_zero_aligned_at(heap,newsize,alignment,offset,zero);
+ size_t size = mi_usable_size(p);
+ if (newsize <= size && newsize >= (size - (size / 2))
+ && (((uintptr_t)p + offset) % alignment) == 0) {
+ return p; // reallocation still fits, is aligned and not more than 50% waste
+ }
+ else {
+ void* newp = mi_heap_malloc_aligned_at(heap,newsize,alignment,offset);
+ if (newp != NULL) {
+ if (zero && newsize > size) {
+ const mi_page_t* page = _mi_ptr_page(newp);
+ if (page->is_zero) {
+ // already zero initialized
+ mi_assert_expensive(mi_mem_is_zero(newp,newsize));
+ }
+ else {
+ // also set last word in the previous allocation to zero to ensure any padding is zero-initialized
+ size_t start = (size >= sizeof(intptr_t) ? size - sizeof(intptr_t) : 0);
+ memset((uint8_t*)newp + start, 0, newsize - start);
+ }
+ }
+ _mi_memcpy_aligned(newp, p, (newsize > size ? size : newsize));
+ mi_free(p); // only free if successful
+ }
+ return newp;
+ }
+}
+
+static void* mi_heap_realloc_zero_aligned(mi_heap_t* heap, void* p, size_t newsize, size_t alignment, bool zero) mi_attr_noexcept {
+ mi_assert(alignment > 0);
+ if (alignment <= sizeof(uintptr_t)) return _mi_heap_realloc_zero(heap,p,newsize,zero);
+ size_t offset = ((uintptr_t)p % alignment); // use offset of previous allocation (p can be NULL)
+ return mi_heap_realloc_zero_aligned_at(heap,p,newsize,alignment,offset,zero);
+}
+
+void* mi_heap_realloc_aligned_at(mi_heap_t* heap, void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_realloc_zero_aligned_at(heap,p,newsize,alignment,offset,false);
+}
+
+void* mi_heap_realloc_aligned(mi_heap_t* heap, void* p, size_t newsize, size_t alignment) mi_attr_noexcept {
+ return mi_heap_realloc_zero_aligned(heap,p,newsize,alignment,false);
+}
+
+void* mi_heap_rezalloc_aligned_at(mi_heap_t* heap, void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_realloc_zero_aligned_at(heap, p, newsize, alignment, offset, true);
+}
+
+void* mi_heap_rezalloc_aligned(mi_heap_t* heap, void* p, size_t newsize, size_t alignment) mi_attr_noexcept {
+ return mi_heap_realloc_zero_aligned(heap, p, newsize, alignment, true);
+}
+
+void* mi_heap_recalloc_aligned_at(mi_heap_t* heap, void* p, size_t newcount, size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(newcount, size, &total)) return NULL;
+ return mi_heap_rezalloc_aligned_at(heap, p, total, alignment, offset);
+}
+
+void* mi_heap_recalloc_aligned(mi_heap_t* heap, void* p, size_t newcount, size_t size, size_t alignment) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(newcount, size, &total)) return NULL;
+ return mi_heap_rezalloc_aligned(heap, p, total, alignment);
+}
+
+void* mi_realloc_aligned_at(void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_realloc_aligned_at(mi_get_default_heap(), p, newsize, alignment, offset);
+}
+
+void* mi_realloc_aligned(void* p, size_t newsize, size_t alignment) mi_attr_noexcept {
+ return mi_heap_realloc_aligned(mi_get_default_heap(), p, newsize, alignment);
+}
+
+void* mi_rezalloc_aligned_at(void* p, size_t newsize, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_rezalloc_aligned_at(mi_get_default_heap(), p, newsize, alignment, offset);
+}
+
+void* mi_rezalloc_aligned(void* p, size_t newsize, size_t alignment) mi_attr_noexcept {
+ return mi_heap_rezalloc_aligned(mi_get_default_heap(), p, newsize, alignment);
+}
+
+void* mi_recalloc_aligned_at(void* p, size_t newcount, size_t size, size_t alignment, size_t offset) mi_attr_noexcept {
+ return mi_heap_recalloc_aligned_at(mi_get_default_heap(), p, newcount, size, alignment, offset);
+}
+
+void* mi_recalloc_aligned(void* p, size_t newcount, size_t size, size_t alignment) mi_attr_noexcept {
+ return mi_heap_recalloc_aligned(mi_get_default_heap(), p, newcount, size, alignment);
+}
+
diff --git a/source/luametatex/source/libraries/mimalloc/src/alloc-override-osx.c b/source/luametatex/source/libraries/mimalloc/src/alloc-override-osx.c
new file mode 100644
index 000000000..41d0a386e
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/alloc-override-osx.c
@@ -0,0 +1,458 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2022, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+
+#if defined(MI_MALLOC_OVERRIDE)
+
+#if !defined(__APPLE__)
+#error "this file should only be included on macOS"
+#endif
+
+/* ------------------------------------------------------
+ Override system malloc on macOS
+ This is done through the malloc zone interface.
+ It seems to be most robust in combination with interposing
+ though or otherwise we may get zone errors as there are could
+ be allocations done by the time we take over the
+ zone.
+------------------------------------------------------ */
+
+#include <AvailabilityMacros.h>
+#include <malloc/malloc.h>
+#include <string.h> // memset
+#include <stdlib.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if defined(MAC_OS_X_VERSION_10_6) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6)
+// only available from OSX 10.6
+extern malloc_zone_t* malloc_default_purgeable_zone(void) __attribute__((weak_import));
+#endif
+
+/* ------------------------------------------------------
+ malloc zone members
+------------------------------------------------------ */
+
+static size_t zone_size(malloc_zone_t* zone, const void* p) {
+ MI_UNUSED(zone);
+ if (!mi_is_in_heap_region(p)){ return 0; } // not our pointer, bail out
+ return mi_usable_size(p);
+}
+
+static void* zone_malloc(malloc_zone_t* zone, size_t size) {
+ MI_UNUSED(zone);
+ return mi_malloc(size);
+}
+
+static void* zone_calloc(malloc_zone_t* zone, size_t count, size_t size) {
+ MI_UNUSED(zone);
+ return mi_calloc(count, size);
+}
+
+static void* zone_valloc(malloc_zone_t* zone, size_t size) {
+ MI_UNUSED(zone);
+ return mi_malloc_aligned(size, _mi_os_page_size());
+}
+
+static void zone_free(malloc_zone_t* zone, void* p) {
+ MI_UNUSED(zone);
+ mi_cfree(p);
+}
+
+static void* zone_realloc(malloc_zone_t* zone, void* p, size_t newsize) {
+ MI_UNUSED(zone);
+ return mi_realloc(p, newsize);
+}
+
+static void* zone_memalign(malloc_zone_t* zone, size_t alignment, size_t size) {
+ MI_UNUSED(zone);
+ return mi_malloc_aligned(size,alignment);
+}
+
+static void zone_destroy(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ // todo: ignore for now?
+}
+
+static unsigned zone_batch_malloc(malloc_zone_t* zone, size_t size, void** ps, unsigned count) {
+ size_t i;
+ for (i = 0; i < count; i++) {
+ ps[i] = zone_malloc(zone, size);
+ if (ps[i] == NULL) break;
+ }
+ return i;
+}
+
+static void zone_batch_free(malloc_zone_t* zone, void** ps, unsigned count) {
+ for(size_t i = 0; i < count; i++) {
+ zone_free(zone, ps[i]);
+ ps[i] = NULL;
+ }
+}
+
+static size_t zone_pressure_relief(malloc_zone_t* zone, size_t size) {
+ MI_UNUSED(zone); MI_UNUSED(size);
+ mi_collect(false);
+ return 0;
+}
+
+static void zone_free_definite_size(malloc_zone_t* zone, void* p, size_t size) {
+ MI_UNUSED(size);
+ zone_free(zone,p);
+}
+
+static boolean_t zone_claimed_address(malloc_zone_t* zone, void* p) {
+ MI_UNUSED(zone);
+ return mi_is_in_heap_region(p);
+}
+
+
+/* ------------------------------------------------------
+ Introspection members
+------------------------------------------------------ */
+
+static kern_return_t intro_enumerator(task_t task, void* p,
+ unsigned type_mask, vm_address_t zone_address,
+ memory_reader_t reader,
+ vm_range_recorder_t recorder)
+{
+ // todo: enumerate all memory
+ MI_UNUSED(task); MI_UNUSED(p); MI_UNUSED(type_mask); MI_UNUSED(zone_address);
+ MI_UNUSED(reader); MI_UNUSED(recorder);
+ return KERN_SUCCESS;
+}
+
+static size_t intro_good_size(malloc_zone_t* zone, size_t size) {
+ MI_UNUSED(zone);
+ return mi_good_size(size);
+}
+
+static boolean_t intro_check(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ return true;
+}
+
+static void intro_print(malloc_zone_t* zone, boolean_t verbose) {
+ MI_UNUSED(zone); MI_UNUSED(verbose);
+ mi_stats_print(NULL);
+}
+
+static void intro_log(malloc_zone_t* zone, void* p) {
+ MI_UNUSED(zone); MI_UNUSED(p);
+ // todo?
+}
+
+static void intro_force_lock(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ // todo?
+}
+
+static void intro_force_unlock(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ // todo?
+}
+
+static void intro_statistics(malloc_zone_t* zone, malloc_statistics_t* stats) {
+ MI_UNUSED(zone);
+ // todo...
+ stats->blocks_in_use = 0;
+ stats->size_in_use = 0;
+ stats->max_size_in_use = 0;
+ stats->size_allocated = 0;
+}
+
+static boolean_t intro_zone_locked(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ return false;
+}
+
+
+/* ------------------------------------------------------
+ At process start, override the default allocator
+------------------------------------------------------ */
+
+#if defined(__GNUC__) && !defined(__clang__)
+#pragma GCC diagnostic ignored "-Wmissing-field-initializers"
+#endif
+
+#if defined(__clang__)
+#pragma clang diagnostic ignored "-Wc99-extensions"
+#endif
+
+static malloc_introspection_t mi_introspect = {
+ .enumerator = &intro_enumerator,
+ .good_size = &intro_good_size,
+ .check = &intro_check,
+ .print = &intro_print,
+ .log = &intro_log,
+ .force_lock = &intro_force_lock,
+ .force_unlock = &intro_force_unlock,
+#if defined(MAC_OS_X_VERSION_10_6) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6)
+ .statistics = &intro_statistics,
+ .zone_locked = &intro_zone_locked,
+#endif
+};
+
+static malloc_zone_t mi_malloc_zone = {
+ // note: even with designators, the order is important for C++ compilation
+ //.reserved1 = NULL,
+ //.reserved2 = NULL,
+ .size = &zone_size,
+ .malloc = &zone_malloc,
+ .calloc = &zone_calloc,
+ .valloc = &zone_valloc,
+ .free = &zone_free,
+ .realloc = &zone_realloc,
+ .destroy = &zone_destroy,
+ .zone_name = "mimalloc",
+ .batch_malloc = &zone_batch_malloc,
+ .batch_free = &zone_batch_free,
+ .introspect = &mi_introspect,
+#if defined(MAC_OS_X_VERSION_10_6) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6)
+ #if defined(MAC_OS_X_VERSION_10_14) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_14)
+ .version = 10,
+ #else
+ .version = 9,
+ #endif
+ // switch to version 9+ on OSX 10.6 to support memalign.
+ .memalign = &zone_memalign,
+ .free_definite_size = &zone_free_definite_size,
+ .pressure_relief = &zone_pressure_relief,
+ #if defined(MAC_OS_X_VERSION_10_14) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_14)
+ .claimed_address = &zone_claimed_address,
+ #endif
+#else
+ .version = 4,
+#endif
+};
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#if defined(MI_OSX_INTERPOSE) && defined(MI_SHARED_LIB_EXPORT)
+
+// ------------------------------------------------------
+// Override malloc_xxx and malloc_zone_xxx api's to use only
+// our mimalloc zone. Since even the loader uses malloc
+// on macOS, this ensures that all allocations go through
+// mimalloc (as all calls are interposed).
+// The main `malloc`, `free`, etc calls are interposed in `alloc-override.c`,
+// Here, we also override macOS specific API's like
+// `malloc_zone_calloc` etc. see <https://github.com/aosm/libmalloc/blob/master/man/malloc_zone_malloc.3>
+// ------------------------------------------------------
+
+static inline malloc_zone_t* mi_get_default_zone(void)
+{
+ static bool init;
+ if (mi_unlikely(!init)) {
+ init = true;
+ malloc_zone_register(&mi_malloc_zone); // by calling register we avoid a zone error on free (see <http://eatmyrandom.blogspot.com/2010/03/mallocfree-interception-on-mac-os-x.html>)
+ }
+ return &mi_malloc_zone;
+}
+
+mi_decl_externc int malloc_jumpstart(uintptr_t cookie);
+mi_decl_externc void _malloc_fork_prepare(void);
+mi_decl_externc void _malloc_fork_parent(void);
+mi_decl_externc void _malloc_fork_child(void);
+
+
+static malloc_zone_t* mi_malloc_create_zone(vm_size_t size, unsigned flags) {
+ MI_UNUSED(size); MI_UNUSED(flags);
+ return mi_get_default_zone();
+}
+
+static malloc_zone_t* mi_malloc_default_zone (void) {
+ return mi_get_default_zone();
+}
+
+static malloc_zone_t* mi_malloc_default_purgeable_zone(void) {
+ return mi_get_default_zone();
+}
+
+static void mi_malloc_destroy_zone(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ // nothing.
+}
+
+static kern_return_t mi_malloc_get_all_zones (task_t task, memory_reader_t mr, vm_address_t** addresses, unsigned* count) {
+ MI_UNUSED(task); MI_UNUSED(mr);
+ if (addresses != NULL) *addresses = NULL;
+ if (count != NULL) *count = 0;
+ return KERN_SUCCESS;
+}
+
+static const char* mi_malloc_get_zone_name(malloc_zone_t* zone) {
+ return (zone == NULL ? mi_malloc_zone.zone_name : zone->zone_name);
+}
+
+static void mi_malloc_set_zone_name(malloc_zone_t* zone, const char* name) {
+ MI_UNUSED(zone); MI_UNUSED(name);
+}
+
+static int mi_malloc_jumpstart(uintptr_t cookie) {
+ MI_UNUSED(cookie);
+ return 1; // or 0 for no error?
+}
+
+static void mi__malloc_fork_prepare(void) {
+ // nothing
+}
+static void mi__malloc_fork_parent(void) {
+ // nothing
+}
+static void mi__malloc_fork_child(void) {
+ // nothing
+}
+
+static void mi_malloc_printf(const char* fmt, ...) {
+ MI_UNUSED(fmt);
+}
+
+static bool zone_check(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+ return true;
+}
+
+static malloc_zone_t* zone_from_ptr(const void* p) {
+ MI_UNUSED(p);
+ return mi_get_default_zone();
+}
+
+static void zone_log(malloc_zone_t* zone, void* p) {
+ MI_UNUSED(zone); MI_UNUSED(p);
+}
+
+static void zone_print(malloc_zone_t* zone, bool b) {
+ MI_UNUSED(zone); MI_UNUSED(b);
+}
+
+static void zone_print_ptr_info(void* p) {
+ MI_UNUSED(p);
+}
+
+static void zone_register(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+}
+
+static void zone_unregister(malloc_zone_t* zone) {
+ MI_UNUSED(zone);
+}
+
+// use interposing so `DYLD_INSERT_LIBRARIES` works without `DYLD_FORCE_FLAT_NAMESPACE=1`
+// See: <https://books.google.com/books?id=K8vUkpOXhN4C&pg=PA73>
+struct mi_interpose_s {
+ const void* replacement;
+ const void* target;
+};
+#define MI_INTERPOSE_FUN(oldfun,newfun) { (const void*)&newfun, (const void*)&oldfun }
+#define MI_INTERPOSE_MI(fun) MI_INTERPOSE_FUN(fun,mi_##fun)
+#define MI_INTERPOSE_ZONE(fun) MI_INTERPOSE_FUN(malloc_##fun,fun)
+__attribute__((used)) static const struct mi_interpose_s _mi_zone_interposes[] __attribute__((section("__DATA, __interpose"))) =
+{
+
+ MI_INTERPOSE_MI(malloc_create_zone),
+ MI_INTERPOSE_MI(malloc_default_purgeable_zone),
+ MI_INTERPOSE_MI(malloc_default_zone),
+ MI_INTERPOSE_MI(malloc_destroy_zone),
+ MI_INTERPOSE_MI(malloc_get_all_zones),
+ MI_INTERPOSE_MI(malloc_get_zone_name),
+ MI_INTERPOSE_MI(malloc_jumpstart),
+ MI_INTERPOSE_MI(malloc_printf),
+ MI_INTERPOSE_MI(malloc_set_zone_name),
+ MI_INTERPOSE_MI(_malloc_fork_child),
+ MI_INTERPOSE_MI(_malloc_fork_parent),
+ MI_INTERPOSE_MI(_malloc_fork_prepare),
+
+ MI_INTERPOSE_ZONE(zone_batch_free),
+ MI_INTERPOSE_ZONE(zone_batch_malloc),
+ MI_INTERPOSE_ZONE(zone_calloc),
+ MI_INTERPOSE_ZONE(zone_check),
+ MI_INTERPOSE_ZONE(zone_free),
+ MI_INTERPOSE_ZONE(zone_from_ptr),
+ MI_INTERPOSE_ZONE(zone_log),
+ MI_INTERPOSE_ZONE(zone_malloc),
+ MI_INTERPOSE_ZONE(zone_memalign),
+ MI_INTERPOSE_ZONE(zone_print),
+ MI_INTERPOSE_ZONE(zone_print_ptr_info),
+ MI_INTERPOSE_ZONE(zone_realloc),
+ MI_INTERPOSE_ZONE(zone_register),
+ MI_INTERPOSE_ZONE(zone_unregister),
+ MI_INTERPOSE_ZONE(zone_valloc)
+};
+
+
+#else
+
+// ------------------------------------------------------
+// hook into the zone api's without interposing
+// This is the official way of adding an allocator but
+// it seems less robust than using interpose.
+// ------------------------------------------------------
+
+static inline malloc_zone_t* mi_get_default_zone(void)
+{
+ // The first returned zone is the real default
+ malloc_zone_t** zones = NULL;
+ unsigned count = 0;
+ kern_return_t ret = malloc_get_all_zones(0, NULL, (vm_address_t**)&zones, &count);
+ if (ret == KERN_SUCCESS && count > 0) {
+ return zones[0];
+ }
+ else {
+ // fallback
+ return malloc_default_zone();
+ }
+}
+
+#if defined(__clang__)
+__attribute__((constructor(0)))
+#else
+__attribute__((constructor)) // seems not supported by g++-11 on the M1
+#endif
+static void _mi_macos_override_malloc() {
+ malloc_zone_t* purgeable_zone = NULL;
+
+ #if defined(MAC_OS_X_VERSION_10_6) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6)
+ // force the purgeable zone to exist to avoid strange bugs
+ if (malloc_default_purgeable_zone) {
+ purgeable_zone = malloc_default_purgeable_zone();
+ }
+ #endif
+
+ // Register our zone.
+ // thomcc: I think this is still needed to put us in the zone list.
+ malloc_zone_register(&mi_malloc_zone);
+ // Unregister the default zone, this makes our zone the new default
+ // as that was the last registered.
+ malloc_zone_t *default_zone = mi_get_default_zone();
+ // thomcc: Unsure if the next test is *always* false or just false in the
+ // cases I've tried. I'm also unsure if the code inside is needed. at all
+ if (default_zone != &mi_malloc_zone) {
+ malloc_zone_unregister(default_zone);
+
+ // Reregister the default zone so free and realloc in that zone keep working.
+ malloc_zone_register(default_zone);
+ }
+
+ // Unregister, and re-register the purgeable_zone to avoid bugs if it occurs
+ // earlier than the default zone.
+ if (purgeable_zone != NULL) {
+ malloc_zone_unregister(purgeable_zone);
+ malloc_zone_register(purgeable_zone);
+ }
+
+}
+#endif // MI_OSX_INTERPOSE
+
+#endif // MI_MALLOC_OVERRIDE
diff --git a/source/luametatex/source/libraries/mimalloc/src/alloc-override.c b/source/luametatex/source/libraries/mimalloc/src/alloc-override.c
new file mode 100644
index 000000000..e29cb4b23
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/alloc-override.c
@@ -0,0 +1,281 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+#if !defined(MI_IN_ALLOC_C)
+#error "this file should be included from 'alloc.c' (so aliases can work)"
+#endif
+
+#if defined(MI_MALLOC_OVERRIDE) && defined(_WIN32) && !(defined(MI_SHARED_LIB) && defined(_DLL))
+#error "It is only possible to override "malloc" on Windows when building as a DLL (and linking the C runtime as a DLL)"
+#endif
+
+#if defined(MI_MALLOC_OVERRIDE) && !(defined(_WIN32))
+
+#if defined(__APPLE__)
+#include <AvailabilityMacros.h>
+mi_decl_externc void vfree(void* p);
+mi_decl_externc size_t malloc_size(const void* p);
+mi_decl_externc size_t malloc_good_size(size_t size);
+#endif
+
+// helper definition for C override of C++ new
+typedef struct mi_nothrow_s { int _tag; } mi_nothrow_t;
+
+// ------------------------------------------------------
+// Override system malloc
+// ------------------------------------------------------
+
+#if (defined(__GNUC__) || defined(__clang__)) && !defined(__APPLE__) && !defined(MI_VALGRIND)
+ // gcc, clang: use aliasing to alias the exported function to one of our `mi_` functions
+ #if (defined(__GNUC__) && __GNUC__ >= 9)
+ #pragma GCC diagnostic ignored "-Wattributes" // or we get warnings that nodiscard is ignored on a forward
+ #define MI_FORWARD(fun) __attribute__((alias(#fun), used, visibility("default"), copy(fun)));
+ #else
+ #define MI_FORWARD(fun) __attribute__((alias(#fun), used, visibility("default")));
+ #endif
+ #define MI_FORWARD1(fun,x) MI_FORWARD(fun)
+ #define MI_FORWARD2(fun,x,y) MI_FORWARD(fun)
+ #define MI_FORWARD3(fun,x,y,z) MI_FORWARD(fun)
+ #define MI_FORWARD0(fun,x) MI_FORWARD(fun)
+ #define MI_FORWARD02(fun,x,y) MI_FORWARD(fun)
+#else
+ // otherwise use forwarding by calling our `mi_` function
+ #define MI_FORWARD1(fun,x) { return fun(x); }
+ #define MI_FORWARD2(fun,x,y) { return fun(x,y); }
+ #define MI_FORWARD3(fun,x,y,z) { return fun(x,y,z); }
+ #define MI_FORWARD0(fun,x) { fun(x); }
+ #define MI_FORWARD02(fun,x,y) { fun(x,y); }
+#endif
+
+#if defined(__APPLE__) && defined(MI_SHARED_LIB_EXPORT) && defined(MI_OSX_INTERPOSE)
+ // define MI_OSX_IS_INTERPOSED as we should not provide forwarding definitions for
+ // functions that are interposed (or the interposing does not work)
+ #define MI_OSX_IS_INTERPOSED
+
+ // use interposing so `DYLD_INSERT_LIBRARIES` works without `DYLD_FORCE_FLAT_NAMESPACE=1`
+ // See: <https://books.google.com/books?id=K8vUkpOXhN4C&pg=PA73>
+ struct mi_interpose_s {
+ const void* replacement;
+ const void* target;
+ };
+ #define MI_INTERPOSE_FUN(oldfun,newfun) { (const void*)&newfun, (const void*)&oldfun }
+ #define MI_INTERPOSE_MI(fun) MI_INTERPOSE_FUN(fun,mi_##fun)
+
+ __attribute__((used)) static struct mi_interpose_s _mi_interposes[] __attribute__((section("__DATA, __interpose"))) =
+ {
+ MI_INTERPOSE_MI(malloc),
+ MI_INTERPOSE_MI(calloc),
+ MI_INTERPOSE_MI(realloc),
+ MI_INTERPOSE_MI(strdup),
+ MI_INTERPOSE_MI(strndup),
+ MI_INTERPOSE_MI(realpath),
+ MI_INTERPOSE_MI(posix_memalign),
+ MI_INTERPOSE_MI(reallocf),
+ MI_INTERPOSE_MI(valloc),
+ MI_INTERPOSE_MI(malloc_size),
+ MI_INTERPOSE_MI(malloc_good_size),
+ #if defined(MAC_OS_X_VERSION_10_15) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_15
+ MI_INTERPOSE_MI(aligned_alloc),
+ #endif
+ #ifdef MI_OSX_ZONE
+ // we interpose malloc_default_zone in alloc-override-osx.c so we can use mi_free safely
+ MI_INTERPOSE_MI(free),
+ MI_INTERPOSE_FUN(vfree,mi_free),
+ #else
+ // sometimes code allocates from default zone but deallocates using plain free :-( (like NxHashResizeToCapacity <https://github.com/nneonneo/osx-10.9-opensource/blob/master/objc4-551.1/runtime/hashtable2.mm>)
+ MI_INTERPOSE_FUN(free,mi_cfree), // use safe free that checks if pointers are from us
+ MI_INTERPOSE_FUN(vfree,mi_cfree),
+ #endif
+ };
+
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+ void _ZdlPv(void* p); // delete
+ void _ZdaPv(void* p); // delete[]
+ void _ZdlPvm(void* p, size_t n); // delete
+ void _ZdaPvm(void* p, size_t n); // delete[]
+ void* _Znwm(size_t n); // new
+ void* _Znam(size_t n); // new[]
+ void* _ZnwmRKSt9nothrow_t(size_t n, mi_nothrow_t tag); // new nothrow
+ void* _ZnamRKSt9nothrow_t(size_t n, mi_nothrow_t tag); // new[] nothrow
+ #ifdef __cplusplus
+ }
+ #endif
+ __attribute__((used)) static struct mi_interpose_s _mi_cxx_interposes[] __attribute__((section("__DATA, __interpose"))) =
+ {
+ MI_INTERPOSE_FUN(_ZdlPv,mi_free),
+ MI_INTERPOSE_FUN(_ZdaPv,mi_free),
+ MI_INTERPOSE_FUN(_ZdlPvm,mi_free_size),
+ MI_INTERPOSE_FUN(_ZdaPvm,mi_free_size),
+ MI_INTERPOSE_FUN(_Znwm,mi_new),
+ MI_INTERPOSE_FUN(_Znam,mi_new),
+ MI_INTERPOSE_FUN(_ZnwmRKSt9nothrow_t,mi_new_nothrow),
+ MI_INTERPOSE_FUN(_ZnamRKSt9nothrow_t,mi_new_nothrow),
+ };
+
+#elif defined(_MSC_VER)
+ // cannot override malloc unless using a dll.
+ // we just override new/delete which does work in a static library.
+#else
+ // On all other systems forward to our API
+ void* malloc(size_t size) MI_FORWARD1(mi_malloc, size)
+ void* calloc(size_t size, size_t n) MI_FORWARD2(mi_calloc, size, n)
+ void* realloc(void* p, size_t newsize) MI_FORWARD2(mi_realloc, p, newsize)
+ void free(void* p) MI_FORWARD0(mi_free, p)
+#endif
+
+#if (defined(__GNUC__) || defined(__clang__)) && !defined(__APPLE__)
+#pragma GCC visibility push(default)
+#endif
+
+// ------------------------------------------------------
+// Override new/delete
+// This is not really necessary as they usually call
+// malloc/free anyway, but it improves performance.
+// ------------------------------------------------------
+#ifdef __cplusplus
+ // ------------------------------------------------------
+ // With a C++ compiler we override the new/delete operators.
+ // see <https://en.cppreference.com/w/cpp/memory/new/operator_new>
+ // ------------------------------------------------------
+ #include <new>
+
+ #ifndef MI_OSX_IS_INTERPOSED
+ void operator delete(void* p) noexcept MI_FORWARD0(mi_free,p)
+ void operator delete[](void* p) noexcept MI_FORWARD0(mi_free,p)
+
+ void* operator new(std::size_t n) noexcept(false) MI_FORWARD1(mi_new,n)
+ void* operator new[](std::size_t n) noexcept(false) MI_FORWARD1(mi_new,n)
+
+ void* operator new (std::size_t n, const std::nothrow_t& tag) noexcept { MI_UNUSED(tag); return mi_new_nothrow(n); }
+ void* operator new[](std::size_t n, const std::nothrow_t& tag) noexcept { MI_UNUSED(tag); return mi_new_nothrow(n); }
+
+ #if (__cplusplus >= 201402L || _MSC_VER >= 1916)
+ void operator delete (void* p, std::size_t n) noexcept MI_FORWARD02(mi_free_size,p,n)
+ void operator delete[](void* p, std::size_t n) noexcept MI_FORWARD02(mi_free_size,p,n)
+ #endif
+ #endif
+
+ #if (__cplusplus > 201402L && defined(__cpp_aligned_new)) && (!defined(__GNUC__) || (__GNUC__ > 5))
+ void operator delete (void* p, std::align_val_t al) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+ void operator delete[](void* p, std::align_val_t al) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+ void operator delete (void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast<size_t>(al)); };
+ void operator delete[](void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast<size_t>(al)); };
+ void operator delete (void* p, std::align_val_t al, const std::nothrow_t&) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+ void operator delete[](void* p, std::align_val_t al, const std::nothrow_t&) noexcept { mi_free_aligned(p, static_cast<size_t>(al)); }
+
+ void* operator new( std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast<size_t>(al)); }
+ void* operator new[]( std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast<size_t>(al)); }
+ void* operator new (std::size_t n, std::align_val_t al, const std::nothrow_t&) noexcept { return mi_new_aligned_nothrow(n, static_cast<size_t>(al)); }
+ void* operator new[](std::size_t n, std::align_val_t al, const std::nothrow_t&) noexcept { return mi_new_aligned_nothrow(n, static_cast<size_t>(al)); }
+ #endif
+
+#elif (defined(__GNUC__) || defined(__clang__))
+ // ------------------------------------------------------
+ // Override by defining the mangled C++ names of the operators (as
+ // used by GCC and CLang).
+ // See <https://itanium-cxx-abi.github.io/cxx-abi/abi.html#mangling>
+ // ------------------------------------------------------
+
+ void _ZdlPv(void* p) MI_FORWARD0(mi_free,p) // delete
+ void _ZdaPv(void* p) MI_FORWARD0(mi_free,p) // delete[]
+ void _ZdlPvm(void* p, size_t n) MI_FORWARD02(mi_free_size,p,n)
+ void _ZdaPvm(void* p, size_t n) MI_FORWARD02(mi_free_size,p,n)
+ void _ZdlPvSt11align_val_t(void* p, size_t al) { mi_free_aligned(p,al); }
+ void _ZdaPvSt11align_val_t(void* p, size_t al) { mi_free_aligned(p,al); }
+ void _ZdlPvmSt11align_val_t(void* p, size_t n, size_t al) { mi_free_size_aligned(p,n,al); }
+ void _ZdaPvmSt11align_val_t(void* p, size_t n, size_t al) { mi_free_size_aligned(p,n,al); }
+
+ #if (MI_INTPTR_SIZE==8)
+ void* _Znwm(size_t n) MI_FORWARD1(mi_new,n) // new 64-bit
+ void* _Znam(size_t n) MI_FORWARD1(mi_new,n) // new[] 64-bit
+ void* _ZnwmRKSt9nothrow_t(size_t n, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_nothrow(n); }
+ void* _ZnamRKSt9nothrow_t(size_t n, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_nothrow(n); }
+ void* _ZnwmSt11align_val_t(size_t n, size_t al) MI_FORWARD2(mi_new_aligned, n, al)
+ void* _ZnamSt11align_val_t(size_t n, size_t al) MI_FORWARD2(mi_new_aligned, n, al)
+ void* _ZnwmSt11align_val_tRKSt9nothrow_t(size_t n, size_t al, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_aligned_nothrow(n,al); }
+ void* _ZnamSt11align_val_tRKSt9nothrow_t(size_t n, size_t al, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_aligned_nothrow(n,al); }
+ #elif (MI_INTPTR_SIZE==4)
+ void* _Znwj(size_t n) MI_FORWARD1(mi_new,n) // new 64-bit
+ void* _Znaj(size_t n) MI_FORWARD1(mi_new,n) // new[] 64-bit
+ void* _ZnwjRKSt9nothrow_t(size_t n, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_nothrow(n); }
+ void* _ZnajRKSt9nothrow_t(size_t n, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_nothrow(n); }
+ void* _ZnwjSt11align_val_t(size_t n, size_t al) MI_FORWARD2(mi_new_aligned, n, al)
+ void* _ZnajSt11align_val_t(size_t n, size_t al) MI_FORWARD2(mi_new_aligned, n, al)
+ void* _ZnwjSt11align_val_tRKSt9nothrow_t(size_t n, size_t al, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_aligned_nothrow(n,al); }
+ void* _ZnajSt11align_val_tRKSt9nothrow_t(size_t n, size_t al, mi_nothrow_t tag) { MI_UNUSED(tag); return mi_new_aligned_nothrow(n,al); }
+ #else
+ #error "define overloads for new/delete for this platform (just for performance, can be skipped)"
+ #endif
+#endif // __cplusplus
+
+// ------------------------------------------------------
+// Further Posix & Unix functions definitions
+// ------------------------------------------------------
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef MI_OSX_IS_INTERPOSED
+ // Forward Posix/Unix calls as well
+ void* reallocf(void* p, size_t newsize) MI_FORWARD2(mi_reallocf,p,newsize)
+ size_t malloc_size(const void* p) MI_FORWARD1(mi_usable_size,p)
+ #if !defined(__ANDROID__) && !defined(__FreeBSD__)
+ size_t malloc_usable_size(void *p) MI_FORWARD1(mi_usable_size,p)
+ #else
+ size_t malloc_usable_size(const void *p) MI_FORWARD1(mi_usable_size,p)
+ #endif
+
+ // No forwarding here due to aliasing/name mangling issues
+ void* valloc(size_t size) { return mi_valloc(size); }
+ void vfree(void* p) { mi_free(p); }
+ size_t malloc_good_size(size_t size) { return mi_malloc_good_size(size); }
+ int posix_memalign(void** p, size_t alignment, size_t size) { return mi_posix_memalign(p, alignment, size); }
+
+ // `aligned_alloc` is only available when __USE_ISOC11 is defined.
+ // Note: Conda has a custom glibc where `aligned_alloc` is declared `static inline` and we cannot
+ // override it, but both _ISOC11_SOURCE and __USE_ISOC11 are undefined in Conda GCC7 or GCC9.
+ // Fortunately, in the case where `aligned_alloc` is declared as `static inline` it
+ // uses internally `memalign`, `posix_memalign`, or `_aligned_malloc` so we can avoid overriding it ourselves.
+ #if __USE_ISOC11
+ void* aligned_alloc(size_t alignment, size_t size) { return mi_aligned_alloc(alignment, size); }
+ #endif
+#endif
+
+// no forwarding here due to aliasing/name mangling issues
+void cfree(void* p) { mi_free(p); }
+void* pvalloc(size_t size) { return mi_pvalloc(size); }
+void* reallocarray(void* p, size_t count, size_t size) { return mi_reallocarray(p, count, size); }
+int reallocarr(void* p, size_t count, size_t size) { return mi_reallocarr(p, count, size); }
+void* memalign(size_t alignment, size_t size) { return mi_memalign(alignment, size); }
+void* _aligned_malloc(size_t alignment, size_t size) { return mi_aligned_alloc(alignment, size); }
+
+#if defined(__GLIBC__) && defined(__linux__)
+ // forward __libc interface (needed for glibc-based Linux distributions)
+ void* __libc_malloc(size_t size) MI_FORWARD1(mi_malloc,size)
+ void* __libc_calloc(size_t count, size_t size) MI_FORWARD2(mi_calloc,count,size)
+ void* __libc_realloc(void* p, size_t size) MI_FORWARD2(mi_realloc,p,size)
+ void __libc_free(void* p) MI_FORWARD0(mi_free,p)
+ void __libc_cfree(void* p) MI_FORWARD0(mi_free,p)
+
+ void* __libc_valloc(size_t size) { return mi_valloc(size); }
+ void* __libc_pvalloc(size_t size) { return mi_pvalloc(size); }
+ void* __libc_memalign(size_t alignment, size_t size) { return mi_memalign(alignment,size); }
+ int __posix_memalign(void** p, size_t alignment, size_t size) { return mi_posix_memalign(p,alignment,size); }
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#if (defined(__GNUC__) || defined(__clang__)) && !defined(__APPLE__)
+#pragma GCC visibility pop
+#endif
+
+#endif // MI_MALLOC_OVERRIDE && !_WIN32
diff --git a/source/luametatex/source/libraries/mimalloc/src/alloc-posix.c b/source/luametatex/source/libraries/mimalloc/src/alloc-posix.c
new file mode 100644
index 000000000..176e7ec30
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/alloc-posix.c
@@ -0,0 +1,181 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+// ------------------------------------------------------------------------
+// mi prefixed publi definitions of various Posix, Unix, and C++ functions
+// for convenience and used when overriding these functions.
+// ------------------------------------------------------------------------
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+
+// ------------------------------------------------------
+// Posix & Unix functions definitions
+// ------------------------------------------------------
+
+#include <errno.h>
+#include <string.h> // memset
+#include <stdlib.h> // getenv
+
+#ifdef _MSC_VER
+#pragma warning(disable:4996) // getenv _wgetenv
+#endif
+
+#ifndef EINVAL
+#define EINVAL 22
+#endif
+#ifndef ENOMEM
+#define ENOMEM 12
+#endif
+
+
+mi_decl_nodiscard size_t mi_malloc_size(const void* p) mi_attr_noexcept {
+ //if (!mi_is_in_heap_region(p)) return 0;
+ return mi_usable_size(p);
+}
+
+mi_decl_nodiscard size_t mi_malloc_usable_size(const void *p) mi_attr_noexcept {
+ //if (!mi_is_in_heap_region(p)) return 0;
+ return mi_usable_size(p);
+}
+
+mi_decl_nodiscard size_t mi_malloc_good_size(size_t size) mi_attr_noexcept {
+ return mi_good_size(size);
+}
+
+void mi_cfree(void* p) mi_attr_noexcept {
+ if (mi_is_in_heap_region(p)) {
+ mi_free(p);
+ }
+}
+
+int mi_posix_memalign(void** p, size_t alignment, size_t size) mi_attr_noexcept {
+ // Note: The spec dictates we should not modify `*p` on an error. (issue#27)
+ // <http://man7.org/linux/man-pages/man3/posix_memalign.3.html>
+ if (p == NULL) return EINVAL;
+ if (alignment % sizeof(void*) != 0) return EINVAL; // natural alignment
+ if (alignment==0 || !_mi_is_power_of_two(alignment)) return EINVAL; // not a power of 2
+ void* q = mi_malloc_aligned(size, alignment);
+ if (q==NULL && size != 0) return ENOMEM;
+ mi_assert_internal(((uintptr_t)q % alignment) == 0);
+ *p = q;
+ return 0;
+}
+
+mi_decl_nodiscard mi_decl_restrict void* mi_memalign(size_t alignment, size_t size) mi_attr_noexcept {
+ void* p = mi_malloc_aligned(size, alignment);
+ mi_assert_internal(((uintptr_t)p % alignment) == 0);
+ return p;
+}
+
+mi_decl_nodiscard mi_decl_restrict void* mi_valloc(size_t size) mi_attr_noexcept {
+ return mi_memalign( _mi_os_page_size(), size );
+}
+
+mi_decl_nodiscard mi_decl_restrict void* mi_pvalloc(size_t size) mi_attr_noexcept {
+ size_t psize = _mi_os_page_size();
+ if (size >= SIZE_MAX - psize) return NULL; // overflow
+ size_t asize = _mi_align_up(size, psize);
+ return mi_malloc_aligned(asize, psize);
+}
+
+mi_decl_nodiscard mi_decl_restrict void* mi_aligned_alloc(size_t alignment, size_t size) mi_attr_noexcept {
+ if (mi_unlikely((size&(alignment-1)) != 0)) { // C11 requires alignment>0 && integral multiple, see <https://en.cppreference.com/w/c/memory/aligned_alloc>
+ #if MI_DEBUG > 0
+ _mi_error_message(EOVERFLOW, "(mi_)aligned_alloc requires the size to be an integral multiple of the alignment (size %zu, alignment %zu)\n", size, alignment);
+ #endif
+ return NULL;
+ }
+ // C11 also requires alignment to be a power-of-two which is checked in mi_malloc_aligned
+ void* p = mi_malloc_aligned(size, alignment);
+ mi_assert_internal(((uintptr_t)p % alignment) == 0);
+ return p;
+}
+
+mi_decl_nodiscard void* mi_reallocarray( void* p, size_t count, size_t size ) mi_attr_noexcept { // BSD
+ void* newp = mi_reallocn(p,count,size);
+ if (newp==NULL) { errno = ENOMEM; }
+ return newp;
+}
+
+mi_decl_nodiscard int mi_reallocarr( void* p, size_t count, size_t size ) mi_attr_noexcept { // NetBSD
+ mi_assert(p != NULL);
+ if (p == NULL) {
+ errno = EINVAL;
+ return EINVAL;
+ }
+ void** op = (void**)p;
+ void* newp = mi_reallocarray(*op, count, size);
+ if (mi_unlikely(newp == NULL)) return errno;
+ *op = newp;
+ return 0;
+}
+
+void* mi__expand(void* p, size_t newsize) mi_attr_noexcept { // Microsoft
+ void* res = mi_expand(p, newsize);
+ if (res == NULL) { errno = ENOMEM; }
+ return res;
+}
+
+mi_decl_nodiscard mi_decl_restrict unsigned short* mi_wcsdup(const unsigned short* s) mi_attr_noexcept {
+ if (s==NULL) return NULL;
+ size_t len;
+ for(len = 0; s[len] != 0; len++) { }
+ size_t size = (len+1)*sizeof(unsigned short);
+ unsigned short* p = (unsigned short*)mi_malloc(size);
+ if (p != NULL) {
+ _mi_memcpy(p,s,size);
+ }
+ return p;
+}
+
+mi_decl_nodiscard mi_decl_restrict unsigned char* mi_mbsdup(const unsigned char* s) mi_attr_noexcept {
+ return (unsigned char*)mi_strdup((const char*)s);
+}
+
+int mi_dupenv_s(char** buf, size_t* size, const char* name) mi_attr_noexcept {
+ if (buf==NULL || name==NULL) return EINVAL;
+ if (size != NULL) *size = 0;
+ char* p = getenv(name); // mscver warning 4996
+ if (p==NULL) {
+ *buf = NULL;
+ }
+ else {
+ *buf = mi_strdup(p);
+ if (*buf==NULL) return ENOMEM;
+ if (size != NULL) *size = strlen(p);
+ }
+ return 0;
+}
+
+int mi_wdupenv_s(unsigned short** buf, size_t* size, const unsigned short* name) mi_attr_noexcept {
+ if (buf==NULL || name==NULL) return EINVAL;
+ if (size != NULL) *size = 0;
+#if !defined(_WIN32) || (defined(WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP))
+ // not supported
+ *buf = NULL;
+ return EINVAL;
+#else
+ unsigned short* p = (unsigned short*)_wgetenv((const wchar_t*)name); // msvc warning 4996
+ if (p==NULL) {
+ *buf = NULL;
+ }
+ else {
+ *buf = mi_wcsdup(p);
+ if (*buf==NULL) return ENOMEM;
+ if (size != NULL) *size = wcslen((const wchar_t*)p);
+ }
+ return 0;
+#endif
+}
+
+mi_decl_nodiscard void* mi_aligned_offset_recalloc(void* p, size_t newcount, size_t size, size_t alignment, size_t offset) mi_attr_noexcept { // Microsoft
+ return mi_recalloc_aligned_at(p, newcount, size, alignment, offset);
+}
+
+mi_decl_nodiscard void* mi_aligned_recalloc(void* p, size_t newcount, size_t size, size_t alignment) mi_attr_noexcept { // Microsoft
+ return mi_recalloc_aligned(p, newcount, size, alignment);
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/alloc.c b/source/luametatex/source/libraries/mimalloc/src/alloc.c
new file mode 100644
index 000000000..1a36b5da8
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/alloc.c
@@ -0,0 +1,934 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2022, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#ifndef _DEFAULT_SOURCE
+#define _DEFAULT_SOURCE // for realpath() on Linux
+#endif
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <string.h> // memset, strlen
+#include <stdlib.h> // malloc, exit
+
+#define MI_IN_ALLOC_C
+#include "alloc-override.c"
+#undef MI_IN_ALLOC_C
+
+// ------------------------------------------------------
+// Allocation
+// ------------------------------------------------------
+
+// Fast allocation in a page: just pop from the free list.
+// Fall back to generic allocation only if the list is empty.
+extern inline void* _mi_page_malloc(mi_heap_t* heap, mi_page_t* page, size_t size) mi_attr_noexcept {
+ mi_assert_internal(page->xblock_size==0||mi_page_block_size(page) >= size);
+ mi_block_t* const block = page->free;
+ if (mi_unlikely(block == NULL)) {
+ return _mi_malloc_generic(heap, size);
+ }
+ mi_assert_internal(block != NULL && _mi_ptr_page(block) == page);
+ // pop from the free list
+ page->used++;
+ page->free = mi_block_next(page, block);
+ mi_assert_internal(page->free == NULL || _mi_ptr_page(page->free) == page);
+
+#if (MI_DEBUG>0)
+ if (!page->is_zero) { memset(block, MI_DEBUG_UNINIT, size); }
+#elif (MI_SECURE!=0)
+ block->next = 0; // don't leak internal data
+#endif
+
+#if (MI_STAT>0)
+ const size_t bsize = mi_page_usable_block_size(page);
+ if (bsize <= MI_MEDIUM_OBJ_SIZE_MAX) {
+ mi_heap_stat_increase(heap, normal, bsize);
+ mi_heap_stat_counter_increase(heap, normal_count, 1);
+#if (MI_STAT>1)
+ const size_t bin = _mi_bin(bsize);
+ mi_heap_stat_increase(heap, normal_bins[bin], 1);
+#endif
+ }
+#endif
+
+#if (MI_PADDING > 0) && defined(MI_ENCODE_FREELIST)
+ mi_padding_t* const padding = (mi_padding_t*)((uint8_t*)block + mi_page_usable_block_size(page));
+ ptrdiff_t delta = ((uint8_t*)padding - (uint8_t*)block - (size - MI_PADDING_SIZE));
+ mi_assert_internal(delta >= 0 && mi_page_usable_block_size(page) >= (size - MI_PADDING_SIZE + delta));
+ padding->canary = (uint32_t)(mi_ptr_encode(page,block,page->keys));
+ padding->delta = (uint32_t)(delta);
+ uint8_t* fill = (uint8_t*)padding - delta;
+ const size_t maxpad = (delta > MI_MAX_ALIGN_SIZE ? MI_MAX_ALIGN_SIZE : delta); // set at most N initial padding bytes
+ for (size_t i = 0; i < maxpad; i++) { fill[i] = MI_DEBUG_PADDING; }
+#endif
+
+ return block;
+}
+
+// allocate a small block
+extern inline mi_decl_restrict void* mi_heap_malloc_small(mi_heap_t* heap, size_t size) mi_attr_noexcept {
+ mi_assert(heap!=NULL);
+ mi_assert(heap->thread_id == 0 || heap->thread_id == _mi_thread_id()); // heaps are thread local
+ mi_assert(size <= MI_SMALL_SIZE_MAX);
+ #if (MI_PADDING)
+ if (size == 0) {
+ size = sizeof(void*);
+ }
+ #endif
+ mi_page_t* page = _mi_heap_get_free_small_page(heap,size + MI_PADDING_SIZE);
+ void* p = _mi_page_malloc(heap, page, size + MI_PADDING_SIZE);
+ mi_assert_internal(p==NULL || mi_usable_size(p) >= size);
+ #if MI_STAT>1
+ if (p != NULL) {
+ if (!mi_heap_is_initialized(heap)) { heap = mi_get_default_heap(); }
+ mi_heap_stat_increase(heap, malloc, mi_usable_size(p));
+ }
+ #endif
+ return p;
+}
+
+extern inline mi_decl_restrict void* mi_malloc_small(size_t size) mi_attr_noexcept {
+ return mi_heap_malloc_small(mi_get_default_heap(), size);
+}
+
+// The main allocation function
+extern inline mi_decl_restrict void* mi_heap_malloc(mi_heap_t* heap, size_t size) mi_attr_noexcept {
+ if (mi_likely(size <= MI_SMALL_SIZE_MAX)) {
+ return mi_heap_malloc_small(heap, size);
+ }
+ else {
+ mi_assert(heap!=NULL);
+ mi_assert(heap->thread_id == 0 || heap->thread_id == _mi_thread_id()); // heaps are thread local
+ void* const p = _mi_malloc_generic(heap, size + MI_PADDING_SIZE); // note: size can overflow but it is detected in malloc_generic
+ mi_assert_internal(p == NULL || mi_usable_size(p) >= size);
+ #if MI_STAT>1
+ if (p != NULL) {
+ if (!mi_heap_is_initialized(heap)) { heap = mi_get_default_heap(); }
+ mi_heap_stat_increase(heap, malloc, mi_usable_size(p));
+ }
+ #endif
+ return p;
+ }
+}
+
+extern inline mi_decl_restrict void* mi_malloc(size_t size) mi_attr_noexcept {
+ return mi_heap_malloc(mi_get_default_heap(), size);
+}
+
+
+void _mi_block_zero_init(const mi_page_t* page, void* p, size_t size) {
+ // note: we need to initialize the whole usable block size to zero, not just the requested size,
+ // or the recalloc/rezalloc functions cannot safely expand in place (see issue #63)
+ MI_UNUSED(size);
+ mi_assert_internal(p != NULL);
+ mi_assert_internal(mi_usable_size(p) >= size); // size can be zero
+ mi_assert_internal(_mi_ptr_page(p)==page);
+ if (page->is_zero && size > sizeof(mi_block_t)) {
+ // already zero initialized memory
+ ((mi_block_t*)p)->next = 0; // clear the free list pointer
+ mi_assert_expensive(mi_mem_is_zero(p, mi_usable_size(p)));
+ }
+ else {
+ // otherwise memset
+ memset(p, 0, mi_usable_size(p));
+ }
+}
+
+// zero initialized small block
+mi_decl_restrict void* mi_zalloc_small(size_t size) mi_attr_noexcept {
+ void* p = mi_malloc_small(size);
+ if (p != NULL) {
+ _mi_block_zero_init(_mi_ptr_page(p), p, size); // todo: can we avoid getting the page again?
+ }
+ return p;
+}
+
+void* _mi_heap_malloc_zero(mi_heap_t* heap, size_t size, bool zero) mi_attr_noexcept {
+ void* p = mi_heap_malloc(heap,size);
+ if (zero && p != NULL) {
+ _mi_block_zero_init(_mi_ptr_page(p),p,size); // todo: can we avoid getting the page again?
+ }
+ return p;
+}
+
+extern inline mi_decl_restrict void* mi_heap_zalloc(mi_heap_t* heap, size_t size) mi_attr_noexcept {
+ return _mi_heap_malloc_zero(heap, size, true);
+}
+
+mi_decl_restrict void* mi_zalloc(size_t size) mi_attr_noexcept {
+ return mi_heap_zalloc(mi_get_default_heap(),size);
+}
+
+
+// ------------------------------------------------------
+// Check for double free in secure and debug mode
+// This is somewhat expensive so only enabled for secure mode 4
+// ------------------------------------------------------
+
+#if (MI_ENCODE_FREELIST && (MI_SECURE>=4 || MI_DEBUG!=0))
+// linear check if the free list contains a specific element
+static bool mi_list_contains(const mi_page_t* page, const mi_block_t* list, const mi_block_t* elem) {
+ while (list != NULL) {
+ if (elem==list) return true;
+ list = mi_block_next(page, list);
+ }
+ return false;
+}
+
+static mi_decl_noinline bool mi_check_is_double_freex(const mi_page_t* page, const mi_block_t* block) {
+ // The decoded value is in the same page (or NULL).
+ // Walk the free lists to verify positively if it is already freed
+ if (mi_list_contains(page, page->free, block) ||
+ mi_list_contains(page, page->local_free, block) ||
+ mi_list_contains(page, mi_page_thread_free(page), block))
+ {
+ _mi_error_message(EAGAIN, "double free detected of block %p with size %zu\n", block, mi_page_block_size(page));
+ return true;
+ }
+ return false;
+}
+
+static inline bool mi_check_is_double_free(const mi_page_t* page, const mi_block_t* block) {
+ mi_block_t* n = mi_block_nextx(page, block, page->keys); // pretend it is freed, and get the decoded first field
+ if (((uintptr_t)n & (MI_INTPTR_SIZE-1))==0 && // quick check: aligned pointer?
+ (n==NULL || mi_is_in_same_page(block, n))) // quick check: in same page or NULL?
+ {
+ // Suspicous: decoded value a in block is in the same page (or NULL) -- maybe a double free?
+ // (continue in separate function to improve code generation)
+ return mi_check_is_double_freex(page, block);
+ }
+ return false;
+}
+#else
+static inline bool mi_check_is_double_free(const mi_page_t* page, const mi_block_t* block) {
+ MI_UNUSED(page);
+ MI_UNUSED(block);
+ return false;
+}
+#endif
+
+// ---------------------------------------------------------------------------
+// Check for heap block overflow by setting up padding at the end of the block
+// ---------------------------------------------------------------------------
+
+#if (MI_PADDING>0) && defined(MI_ENCODE_FREELIST)
+static bool mi_page_decode_padding(const mi_page_t* page, const mi_block_t* block, size_t* delta, size_t* bsize) {
+ *bsize = mi_page_usable_block_size(page);
+ const mi_padding_t* const padding = (mi_padding_t*)((uint8_t*)block + *bsize);
+ *delta = padding->delta;
+ return ((uint32_t)mi_ptr_encode(page,block,page->keys) == padding->canary && *delta <= *bsize);
+}
+
+// Return the exact usable size of a block.
+static size_t mi_page_usable_size_of(const mi_page_t* page, const mi_block_t* block) {
+ size_t bsize;
+ size_t delta;
+ bool ok = mi_page_decode_padding(page, block, &delta, &bsize);
+ mi_assert_internal(ok); mi_assert_internal(delta <= bsize);
+ return (ok ? bsize - delta : 0);
+}
+
+static bool mi_verify_padding(const mi_page_t* page, const mi_block_t* block, size_t* size, size_t* wrong) {
+ size_t bsize;
+ size_t delta;
+ bool ok = mi_page_decode_padding(page, block, &delta, &bsize);
+ *size = *wrong = bsize;
+ if (!ok) return false;
+ mi_assert_internal(bsize >= delta);
+ *size = bsize - delta;
+ uint8_t* fill = (uint8_t*)block + bsize - delta;
+ const size_t maxpad = (delta > MI_MAX_ALIGN_SIZE ? MI_MAX_ALIGN_SIZE : delta); // check at most the first N padding bytes
+ for (size_t i = 0; i < maxpad; i++) {
+ if (fill[i] != MI_DEBUG_PADDING) {
+ *wrong = bsize - delta + i;
+ return false;
+ }
+ }
+ return true;
+}
+
+static void mi_check_padding(const mi_page_t* page, const mi_block_t* block) {
+ size_t size;
+ size_t wrong;
+ if (!mi_verify_padding(page,block,&size,&wrong)) {
+ _mi_error_message(EFAULT, "buffer overflow in heap block %p of size %zu: write after %zu bytes\n", block, size, wrong );
+ }
+}
+
+// When a non-thread-local block is freed, it becomes part of the thread delayed free
+// list that is freed later by the owning heap. If the exact usable size is too small to
+// contain the pointer for the delayed list, then shrink the padding (by decreasing delta)
+// so it will later not trigger an overflow error in `mi_free_block`.
+static void mi_padding_shrink(const mi_page_t* page, const mi_block_t* block, const size_t min_size) {
+ size_t bsize;
+ size_t delta;
+ bool ok = mi_page_decode_padding(page, block, &delta, &bsize);
+ mi_assert_internal(ok);
+ if (!ok || (bsize - delta) >= min_size) return; // usually already enough space
+ mi_assert_internal(bsize >= min_size);
+ if (bsize < min_size) return; // should never happen
+ size_t new_delta = (bsize - min_size);
+ mi_assert_internal(new_delta < bsize);
+ mi_padding_t* padding = (mi_padding_t*)((uint8_t*)block + bsize);
+ padding->delta = (uint32_t)new_delta;
+}
+#else
+static void mi_check_padding(const mi_page_t* page, const mi_block_t* block) {
+ MI_UNUSED(page);
+ MI_UNUSED(block);
+}
+
+static size_t mi_page_usable_size_of(const mi_page_t* page, const mi_block_t* block) {
+ MI_UNUSED(block);
+ return mi_page_usable_block_size(page);
+}
+
+static void mi_padding_shrink(const mi_page_t* page, const mi_block_t* block, const size_t min_size) {
+ MI_UNUSED(page);
+ MI_UNUSED(block);
+ MI_UNUSED(min_size);
+}
+#endif
+
+// only maintain stats for smaller objects if requested
+#if (MI_STAT>0)
+static void mi_stat_free(const mi_page_t* page, const mi_block_t* block) {
+ #if (MI_STAT < 2)
+ MI_UNUSED(block);
+ #endif
+ mi_heap_t* const heap = mi_heap_get_default();
+ const size_t bsize = mi_page_usable_block_size(page);
+ #if (MI_STAT>1)
+ const size_t usize = mi_page_usable_size_of(page, block);
+ mi_heap_stat_decrease(heap, malloc, usize);
+ #endif
+ if (bsize <= MI_MEDIUM_OBJ_SIZE_MAX) {
+ mi_heap_stat_decrease(heap, normal, bsize);
+ #if (MI_STAT > 1)
+ mi_heap_stat_decrease(heap, normal_bins[_mi_bin(bsize)], 1);
+ #endif
+ }
+ else if (bsize <= MI_LARGE_OBJ_SIZE_MAX) {
+ mi_heap_stat_decrease(heap, large, bsize);
+ }
+ else {
+ mi_heap_stat_decrease(heap, huge, bsize);
+ }
+}
+#else
+static void mi_stat_free(const mi_page_t* page, const mi_block_t* block) {
+ MI_UNUSED(page); MI_UNUSED(block);
+}
+#endif
+
+#if (MI_STAT>0)
+// maintain stats for huge objects
+static void mi_stat_huge_free(const mi_page_t* page) {
+ mi_heap_t* const heap = mi_heap_get_default();
+ const size_t bsize = mi_page_block_size(page); // to match stats in `page.c:mi_page_huge_alloc`
+ if (bsize <= MI_LARGE_OBJ_SIZE_MAX) {
+ mi_heap_stat_decrease(heap, large, bsize);
+ }
+ else {
+ mi_heap_stat_decrease(heap, huge, bsize);
+ }
+}
+#else
+static void mi_stat_huge_free(const mi_page_t* page) {
+ MI_UNUSED(page);
+}
+#endif
+
+// ------------------------------------------------------
+// Free
+// ------------------------------------------------------
+
+// multi-threaded free
+static mi_decl_noinline void _mi_free_block_mt(mi_page_t* page, mi_block_t* block)
+{
+ // The padding check may access the non-thread-owned page for the key values.
+ // that is safe as these are constant and the page won't be freed (as the block is not freed yet).
+ mi_check_padding(page, block);
+ mi_padding_shrink(page, block, sizeof(mi_block_t)); // for small size, ensure we can fit the delayed thread pointers without triggering overflow detection
+ #if (MI_DEBUG!=0)
+ memset(block, MI_DEBUG_FREED, mi_usable_size(block));
+ #endif
+
+ // huge page segments are always abandoned and can be freed immediately
+ mi_segment_t* segment = _mi_page_segment(page);
+ if (segment->kind==MI_SEGMENT_HUGE) {
+ mi_stat_huge_free(page);
+ _mi_segment_huge_page_free(segment, page, block);
+ return;
+ }
+
+ // Try to put the block on either the page-local thread free list, or the heap delayed free list.
+ mi_thread_free_t tfreex;
+ bool use_delayed;
+ mi_thread_free_t tfree = mi_atomic_load_relaxed(&page->xthread_free);
+ do {
+ use_delayed = (mi_tf_delayed(tfree) == MI_USE_DELAYED_FREE);
+ if (mi_unlikely(use_delayed)) {
+ // unlikely: this only happens on the first concurrent free in a page that is in the full list
+ tfreex = mi_tf_set_delayed(tfree,MI_DELAYED_FREEING);
+ }
+ else {
+ // usual: directly add to page thread_free list
+ mi_block_set_next(page, block, mi_tf_block(tfree));
+ tfreex = mi_tf_set_block(tfree,block);
+ }
+ } while (!mi_atomic_cas_weak_release(&page->xthread_free, &tfree, tfreex));
+
+ if (mi_unlikely(use_delayed)) {
+ // racy read on `heap`, but ok because MI_DELAYED_FREEING is set (see `mi_heap_delete` and `mi_heap_collect_abandon`)
+ mi_heap_t* const heap = (mi_heap_t*)(mi_atomic_load_acquire(&page->xheap)); //mi_page_heap(page);
+ mi_assert_internal(heap != NULL);
+ if (heap != NULL) {
+ // add to the delayed free list of this heap. (do this atomically as the lock only protects heap memory validity)
+ mi_block_t* dfree = mi_atomic_load_ptr_relaxed(mi_block_t, &heap->thread_delayed_free);
+ do {
+ mi_block_set_nextx(heap,block,dfree, heap->keys);
+ } while (!mi_atomic_cas_ptr_weak_release(mi_block_t,&heap->thread_delayed_free, &dfree, block));
+ }
+
+ // and reset the MI_DELAYED_FREEING flag
+ tfree = mi_atomic_load_relaxed(&page->xthread_free);
+ do {
+ tfreex = tfree;
+ mi_assert_internal(mi_tf_delayed(tfree) == MI_DELAYED_FREEING);
+ tfreex = mi_tf_set_delayed(tfree,MI_NO_DELAYED_FREE);
+ } while (!mi_atomic_cas_weak_release(&page->xthread_free, &tfree, tfreex));
+ }
+}
+
+// regular free
+static inline void _mi_free_block(mi_page_t* page, bool local, mi_block_t* block)
+{
+ // and push it on the free list
+ if (mi_likely(local)) {
+ // owning thread can free a block directly
+ if (mi_unlikely(mi_check_is_double_free(page, block))) return;
+ mi_check_padding(page, block);
+ #if (MI_DEBUG!=0)
+ memset(block, MI_DEBUG_FREED, mi_page_block_size(page));
+ #endif
+ mi_block_set_next(page, block, page->local_free);
+ page->local_free = block;
+ page->used--;
+ if (mi_unlikely(mi_page_all_free(page))) {
+ _mi_page_retire(page);
+ }
+ else if (mi_unlikely(mi_page_is_in_full(page))) {
+ _mi_page_unfull(page);
+ }
+ }
+ else {
+ _mi_free_block_mt(page,block);
+ }
+}
+
+
+// Adjust a block that was allocated aligned, to the actual start of the block in the page.
+mi_block_t* _mi_page_ptr_unalign(const mi_segment_t* segment, const mi_page_t* page, const void* p) {
+ mi_assert_internal(page!=NULL && p!=NULL);
+ const size_t diff = (uint8_t*)p - _mi_page_start(segment, page, NULL);
+ const size_t adjust = (diff % mi_page_block_size(page));
+ return (mi_block_t*)((uintptr_t)p - adjust);
+}
+
+
+static void mi_decl_noinline mi_free_generic(const mi_segment_t* segment, bool local, void* p) mi_attr_noexcept {
+ mi_page_t* const page = _mi_segment_page_of(segment, p);
+ mi_block_t* const block = (mi_page_has_aligned(page) ? _mi_page_ptr_unalign(segment, page, p) : (mi_block_t*)p);
+ mi_stat_free(page, block);
+ _mi_free_block(page, local, block);
+}
+
+// Get the segment data belonging to a pointer
+// This is just a single `and` in assembly but does further checks in debug mode
+// (and secure mode) if this was a valid pointer.
+static inline mi_segment_t* mi_checked_ptr_segment(const void* p, const char* msg)
+{
+ MI_UNUSED(msg);
+#if (MI_DEBUG>0)
+ if (mi_unlikely(((uintptr_t)p & (MI_INTPTR_SIZE - 1)) != 0)) {
+ _mi_error_message(EINVAL, "%s: invalid (unaligned) pointer: %p\n", msg, p);
+ return NULL;
+ }
+#endif
+
+ mi_segment_t* const segment = _mi_ptr_segment(p);
+ if (mi_unlikely(segment == NULL)) return NULL; // checks also for (p==NULL)
+
+#if (MI_DEBUG>0)
+ if (mi_unlikely(!mi_is_in_heap_region(p))) {
+ _mi_warning_message("%s: pointer might not point to a valid heap region: %p\n"
+ "(this may still be a valid very large allocation (over 64MiB))\n", msg, p);
+ if (mi_likely(_mi_ptr_cookie(segment) == segment->cookie)) {
+ _mi_warning_message("(yes, the previous pointer %p was valid after all)\n", p);
+ }
+ }
+#endif
+#if (MI_DEBUG>0 || MI_SECURE>=4)
+ if (mi_unlikely(_mi_ptr_cookie(segment) != segment->cookie)) {
+ _mi_error_message(EINVAL, "%s: pointer does not point to a valid heap space: %p\n", msg, p);
+ return NULL;
+ }
+#endif
+ return segment;
+}
+
+// Free a block
+void mi_free(void* p) mi_attr_noexcept
+{
+ mi_segment_t* const segment = mi_checked_ptr_segment(p,"mi_free");
+ if (mi_unlikely(segment == NULL)) return;
+
+ mi_threadid_t tid = _mi_thread_id();
+ mi_page_t* const page = _mi_segment_page_of(segment, p);
+
+ if (mi_likely(tid == mi_atomic_load_relaxed(&segment->thread_id) && page->flags.full_aligned == 0)) { // the thread id matches and it is not a full page, nor has aligned blocks
+ // local, and not full or aligned
+ mi_block_t* block = (mi_block_t*)(p);
+ if (mi_unlikely(mi_check_is_double_free(page,block))) return;
+ mi_check_padding(page, block);
+ mi_stat_free(page, block);
+ #if (MI_DEBUG!=0)
+ memset(block, MI_DEBUG_FREED, mi_page_block_size(page));
+ #endif
+ mi_block_set_next(page, block, page->local_free);
+ page->local_free = block;
+ if (mi_unlikely(--page->used == 0)) { // using this expression generates better code than: page->used--; if (mi_page_all_free(page))
+ _mi_page_retire(page);
+ }
+ }
+ else {
+ // non-local, aligned blocks, or a full page; use the more generic path
+ // note: recalc page in generic to improve code generation
+ mi_free_generic(segment, tid == segment->thread_id, p);
+ }
+}
+
+bool _mi_free_delayed_block(mi_block_t* block) {
+ // get segment and page
+ const mi_segment_t* const segment = _mi_ptr_segment(block);
+ mi_assert_internal(_mi_ptr_cookie(segment) == segment->cookie);
+ mi_assert_internal(_mi_thread_id() == segment->thread_id);
+ mi_page_t* const page = _mi_segment_page_of(segment, block);
+
+ // Clear the no-delayed flag so delayed freeing is used again for this page.
+ // This must be done before collecting the free lists on this page -- otherwise
+ // some blocks may end up in the page `thread_free` list with no blocks in the
+ // heap `thread_delayed_free` list which may cause the page to be never freed!
+ // (it would only be freed if we happen to scan it in `mi_page_queue_find_free_ex`)
+ _mi_page_use_delayed_free(page, MI_USE_DELAYED_FREE, false /* dont overwrite never delayed */);
+
+ // collect all other non-local frees to ensure up-to-date `used` count
+ _mi_page_free_collect(page, false);
+
+ // and free the block (possibly freeing the page as well since used is updated)
+ _mi_free_block(page, true, block);
+ return true;
+}
+
+// Bytes available in a block
+mi_decl_noinline static size_t mi_page_usable_aligned_size_of(const mi_segment_t* segment, const mi_page_t* page, const void* p) mi_attr_noexcept {
+ const mi_block_t* block = _mi_page_ptr_unalign(segment, page, p);
+ const size_t size = mi_page_usable_size_of(page, block);
+ const ptrdiff_t adjust = (uint8_t*)p - (uint8_t*)block;
+ mi_assert_internal(adjust >= 0 && (size_t)adjust <= size);
+ return (size - adjust);
+}
+
+static inline size_t _mi_usable_size(const void* p, const char* msg) mi_attr_noexcept {
+ const mi_segment_t* const segment = mi_checked_ptr_segment(p, msg);
+ if (segment==NULL) return 0; // also returns 0 if `p == NULL`
+ const mi_page_t* const page = _mi_segment_page_of(segment, p);
+ if (mi_likely(!mi_page_has_aligned(page))) {
+ const mi_block_t* block = (const mi_block_t*)p;
+ return mi_page_usable_size_of(page, block);
+ }
+ else {
+ // split out to separate routine for improved code generation
+ return mi_page_usable_aligned_size_of(segment, page, p);
+ }
+}
+
+size_t mi_usable_size(const void* p) mi_attr_noexcept {
+ return _mi_usable_size(p, "mi_usable_size");
+}
+
+
+// ------------------------------------------------------
+// ensure explicit external inline definitions are emitted!
+// ------------------------------------------------------
+
+#ifdef __cplusplus
+void* _mi_externs[] = {
+ (void*)&_mi_page_malloc,
+ (void*)&mi_malloc,
+ (void*)&mi_malloc_small,
+ (void*)&mi_zalloc_small,
+ (void*)&mi_heap_malloc,
+ (void*)&mi_heap_zalloc,
+ (void*)&mi_heap_malloc_small
+};
+#endif
+
+
+// ------------------------------------------------------
+// Allocation extensions
+// ------------------------------------------------------
+
+void mi_free_size(void* p, size_t size) mi_attr_noexcept {
+ MI_UNUSED_RELEASE(size);
+ mi_assert(p == NULL || size <= _mi_usable_size(p,"mi_free_size"));
+ mi_free(p);
+}
+
+void mi_free_size_aligned(void* p, size_t size, size_t alignment) mi_attr_noexcept {
+ MI_UNUSED_RELEASE(alignment);
+ mi_assert(((uintptr_t)p % alignment) == 0);
+ mi_free_size(p,size);
+}
+
+void mi_free_aligned(void* p, size_t alignment) mi_attr_noexcept {
+ MI_UNUSED_RELEASE(alignment);
+ mi_assert(((uintptr_t)p % alignment) == 0);
+ mi_free(p);
+}
+
+extern inline mi_decl_restrict void* mi_heap_calloc(mi_heap_t* heap, size_t count, size_t size) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(count,size,&total)) return NULL;
+ return mi_heap_zalloc(heap,total);
+}
+
+mi_decl_restrict void* mi_calloc(size_t count, size_t size) mi_attr_noexcept {
+ return mi_heap_calloc(mi_get_default_heap(),count,size);
+}
+
+// Uninitialized `calloc`
+extern mi_decl_restrict void* mi_heap_mallocn(mi_heap_t* heap, size_t count, size_t size) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(count, size, &total)) return NULL;
+ return mi_heap_malloc(heap, total);
+}
+
+mi_decl_restrict void* mi_mallocn(size_t count, size_t size) mi_attr_noexcept {
+ return mi_heap_mallocn(mi_get_default_heap(),count,size);
+}
+
+// Expand (or shrink) in place (or fail)
+void* mi_expand(void* p, size_t newsize) mi_attr_noexcept {
+ #if MI_PADDING
+ // we do not shrink/expand with padding enabled
+ MI_UNUSED(p); MI_UNUSED(newsize);
+ return NULL;
+ #else
+ if (p == NULL) return NULL;
+ const size_t size = _mi_usable_size(p,"mi_expand");
+ if (newsize > size) return NULL;
+ return p; // it fits
+ #endif
+}
+
+void* _mi_heap_realloc_zero(mi_heap_t* heap, void* p, size_t newsize, bool zero) mi_attr_noexcept {
+ const size_t size = _mi_usable_size(p,"mi_realloc"); // also works if p == NULL
+ if (mi_unlikely(newsize <= size && newsize >= (size / 2))) {
+ // todo: adjust potential padding to reflect the new size?
+ return p; // reallocation still fits and not more than 50% waste
+ }
+ void* newp = mi_heap_malloc(heap,newsize);
+ if (mi_likely(newp != NULL)) {
+ if (zero && newsize > size) {
+ // also set last word in the previous allocation to zero to ensure any padding is zero-initialized
+ const size_t start = (size >= sizeof(intptr_t) ? size - sizeof(intptr_t) : 0);
+ memset((uint8_t*)newp + start, 0, newsize - start);
+ }
+ if (mi_likely(p != NULL)) {
+ _mi_memcpy_aligned(newp, p, (newsize > size ? size : newsize));
+ mi_free(p); // only free the original pointer if successful
+ }
+ }
+ return newp;
+}
+
+void* mi_heap_realloc(mi_heap_t* heap, void* p, size_t newsize) mi_attr_noexcept {
+ return _mi_heap_realloc_zero(heap, p, newsize, false);
+}
+
+void* mi_heap_reallocn(mi_heap_t* heap, void* p, size_t count, size_t size) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(count, size, &total)) return NULL;
+ return mi_heap_realloc(heap, p, total);
+}
+
+
+// Reallocate but free `p` on errors
+void* mi_heap_reallocf(mi_heap_t* heap, void* p, size_t newsize) mi_attr_noexcept {
+ void* newp = mi_heap_realloc(heap, p, newsize);
+ if (newp==NULL && p!=NULL) mi_free(p);
+ return newp;
+}
+
+void* mi_heap_rezalloc(mi_heap_t* heap, void* p, size_t newsize) mi_attr_noexcept {
+ return _mi_heap_realloc_zero(heap, p, newsize, true);
+}
+
+void* mi_heap_recalloc(mi_heap_t* heap, void* p, size_t count, size_t size) mi_attr_noexcept {
+ size_t total;
+ if (mi_count_size_overflow(count, size, &total)) return NULL;
+ return mi_heap_rezalloc(heap, p, total);
+}
+
+
+void* mi_realloc(void* p, size_t newsize) mi_attr_noexcept {
+ return mi_heap_realloc(mi_get_default_heap(),p,newsize);
+}
+
+void* mi_reallocn(void* p, size_t count, size_t size) mi_attr_noexcept {
+ return mi_heap_reallocn(mi_get_default_heap(),p,count,size);
+}
+
+// Reallocate but free `p` on errors
+void* mi_reallocf(void* p, size_t newsize) mi_attr_noexcept {
+ return mi_heap_reallocf(mi_get_default_heap(),p,newsize);
+}
+
+void* mi_rezalloc(void* p, size_t newsize) mi_attr_noexcept {
+ return mi_heap_rezalloc(mi_get_default_heap(), p, newsize);
+}
+
+void* mi_recalloc(void* p, size_t count, size_t size) mi_attr_noexcept {
+ return mi_heap_recalloc(mi_get_default_heap(), p, count, size);
+}
+
+
+
+// ------------------------------------------------------
+// strdup, strndup, and realpath
+// ------------------------------------------------------
+
+// `strdup` using mi_malloc
+mi_decl_restrict char* mi_heap_strdup(mi_heap_t* heap, const char* s) mi_attr_noexcept {
+ if (s == NULL) return NULL;
+ size_t n = strlen(s);
+ char* t = (char*)mi_heap_malloc(heap,n+1);
+ if (t != NULL) _mi_memcpy(t, s, n + 1);
+ return t;
+}
+
+mi_decl_restrict char* mi_strdup(const char* s) mi_attr_noexcept {
+ return mi_heap_strdup(mi_get_default_heap(), s);
+}
+
+// `strndup` using mi_malloc
+mi_decl_restrict char* mi_heap_strndup(mi_heap_t* heap, const char* s, size_t n) mi_attr_noexcept {
+ if (s == NULL) return NULL;
+ const char* end = (const char*)memchr(s, 0, n); // find end of string in the first `n` characters (returns NULL if not found)
+ const size_t m = (end != NULL ? (size_t)(end - s) : n); // `m` is the minimum of `n` or the end-of-string
+ mi_assert_internal(m <= n);
+ char* t = (char*)mi_heap_malloc(heap, m+1);
+ if (t == NULL) return NULL;
+ _mi_memcpy(t, s, m);
+ t[m] = 0;
+ return t;
+}
+
+mi_decl_restrict char* mi_strndup(const char* s, size_t n) mi_attr_noexcept {
+ return mi_heap_strndup(mi_get_default_heap(),s,n);
+}
+
+#ifndef __wasi__
+// `realpath` using mi_malloc
+#ifdef _WIN32
+#ifndef PATH_MAX
+#define PATH_MAX MAX_PATH
+#endif
+#include <windows.h>
+mi_decl_restrict char* mi_heap_realpath(mi_heap_t* heap, const char* fname, char* resolved_name) mi_attr_noexcept {
+ // todo: use GetFullPathNameW to allow longer file names
+ char buf[PATH_MAX];
+ DWORD res = GetFullPathNameA(fname, PATH_MAX, (resolved_name == NULL ? buf : resolved_name), NULL);
+ if (res == 0) {
+ errno = GetLastError(); return NULL;
+ }
+ else if (res > PATH_MAX) {
+ errno = EINVAL; return NULL;
+ }
+ else if (resolved_name != NULL) {
+ return resolved_name;
+ }
+ else {
+ return mi_heap_strndup(heap, buf, PATH_MAX);
+ }
+}
+#else
+#include <unistd.h> // pathconf
+static size_t mi_path_max(void) {
+ static size_t path_max = 0;
+ if (path_max <= 0) {
+ long m = pathconf("/",_PC_PATH_MAX);
+ if (m <= 0) path_max = 4096; // guess
+ else if (m < 256) path_max = 256; // at least 256
+ else path_max = m;
+ }
+ return path_max;
+}
+
+char* mi_heap_realpath(mi_heap_t* heap, const char* fname, char* resolved_name) mi_attr_noexcept {
+ if (resolved_name != NULL) {
+ return realpath(fname,resolved_name);
+ }
+ else {
+ size_t n = mi_path_max();
+ char* buf = (char*)mi_malloc(n+1);
+ if (buf==NULL) return NULL;
+ char* rname = realpath(fname,buf);
+ char* result = mi_heap_strndup(heap,rname,n); // ok if `rname==NULL`
+ mi_free(buf);
+ return result;
+ }
+}
+#endif
+
+mi_decl_restrict char* mi_realpath(const char* fname, char* resolved_name) mi_attr_noexcept {
+ return mi_heap_realpath(mi_get_default_heap(),fname,resolved_name);
+}
+#endif
+
+/*-------------------------------------------------------
+C++ new and new_aligned
+The standard requires calling into `get_new_handler` and
+throwing the bad_alloc exception on failure. If we compile
+with a C++ compiler we can implement this precisely. If we
+use a C compiler we cannot throw a `bad_alloc` exception
+but we call `exit` instead (i.e. not returning).
+-------------------------------------------------------*/
+
+#ifdef __cplusplus
+#include <new>
+static bool mi_try_new_handler(bool nothrow) {
+ #if defined(_MSC_VER) || (__cplusplus >= 201103L)
+ std::new_handler h = std::get_new_handler();
+ #else
+ std::new_handler h = std::set_new_handler();
+ std::set_new_handler(h);
+ #endif
+ if (h==NULL) {
+ _mi_error_message(ENOMEM, "out of memory in 'new'");
+ if (!nothrow) {
+ throw std::bad_alloc();
+ }
+ return false;
+ }
+ else {
+ h();
+ return true;
+ }
+}
+#else
+typedef void (*std_new_handler_t)(void);
+
+#if (defined(__GNUC__) || defined(__clang__))
+std_new_handler_t __attribute((weak)) _ZSt15get_new_handlerv(void) {
+ return NULL;
+}
+static std_new_handler_t mi_get_new_handler(void) {
+ return _ZSt15get_new_handlerv();
+}
+#else
+// note: on windows we could dynamically link to `?get_new_handler@std@@YAP6AXXZXZ`.
+static std_new_handler_t mi_get_new_handler() {
+ return NULL;
+}
+#endif
+
+static bool mi_try_new_handler(bool nothrow) {
+ std_new_handler_t h = mi_get_new_handler();
+ if (h==NULL) {
+ _mi_error_message(ENOMEM, "out of memory in 'new'");
+ if (!nothrow) {
+ abort(); // cannot throw in plain C, use abort
+ }
+ return false;
+ }
+ else {
+ h();
+ return true;
+ }
+}
+#endif
+
+static mi_decl_noinline void* mi_try_new(size_t size, bool nothrow ) {
+ void* p = NULL;
+ while(p == NULL && mi_try_new_handler(nothrow)) {
+ p = mi_malloc(size);
+ }
+ return p;
+}
+
+mi_decl_restrict void* mi_new(size_t size) {
+ void* p = mi_malloc(size);
+ if (mi_unlikely(p == NULL)) return mi_try_new(size,false);
+ return p;
+}
+
+mi_decl_restrict void* mi_new_nothrow(size_t size) mi_attr_noexcept {
+ void* p = mi_malloc(size);
+ if (mi_unlikely(p == NULL)) return mi_try_new(size, true);
+ return p;
+}
+
+mi_decl_restrict void* mi_new_aligned(size_t size, size_t alignment) {
+ void* p;
+ do {
+ p = mi_malloc_aligned(size, alignment);
+ }
+ while(p == NULL && mi_try_new_handler(false));
+ return p;
+}
+
+mi_decl_restrict void* mi_new_aligned_nothrow(size_t size, size_t alignment) mi_attr_noexcept {
+ void* p;
+ do {
+ p = mi_malloc_aligned(size, alignment);
+ }
+ while(p == NULL && mi_try_new_handler(true));
+ return p;
+}
+
+mi_decl_restrict void* mi_new_n(size_t count, size_t size) {
+ size_t total;
+ if (mi_unlikely(mi_count_size_overflow(count, size, &total))) {
+ mi_try_new_handler(false); // on overflow we invoke the try_new_handler once to potentially throw std::bad_alloc
+ return NULL;
+ }
+ else {
+ return mi_new(total);
+ }
+}
+
+void* mi_new_realloc(void* p, size_t newsize) {
+ void* q;
+ do {
+ q = mi_realloc(p, newsize);
+ } while (q == NULL && mi_try_new_handler(false));
+ return q;
+}
+
+void* mi_new_reallocn(void* p, size_t newcount, size_t size) {
+ size_t total;
+ if (mi_unlikely(mi_count_size_overflow(newcount, size, &total))) {
+ mi_try_new_handler(false); // on overflow we invoke the try_new_handler once to potentially throw std::bad_alloc
+ return NULL;
+ }
+ else {
+ return mi_new_realloc(p, total);
+ }
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/arena.c b/source/luametatex/source/libraries/mimalloc/src/arena.c
new file mode 100644
index 000000000..6b1e951f3
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/arena.c
@@ -0,0 +1,446 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2019-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* ----------------------------------------------------------------------------
+"Arenas" are fixed area's of OS memory from which we can allocate
+large blocks (>= MI_ARENA_MIN_BLOCK_SIZE, 4MiB).
+In contrast to the rest of mimalloc, the arenas are shared between
+threads and need to be accessed using atomic operations.
+
+Currently arenas are only used to for huge OS page (1GiB) reservations,
+or direct OS memory reservations -- otherwise it delegates to direct allocation from the OS.
+In the future, we can expose an API to manually add more kinds of arenas
+which is sometimes needed for embedded devices or shared memory for example.
+(We can also employ this with WASI or `sbrk` systems to reserve large arenas
+ on demand and be able to reuse them efficiently).
+
+The arena allocation needs to be thread safe and we use an atomic bitmap to allocate.
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <string.h> // memset
+#include <errno.h> // ENOMEM
+
+#include "bitmap.h" // atomic bitmap
+
+
+// os.c
+void* _mi_os_alloc_aligned(size_t size, size_t alignment, bool commit, bool* large, mi_stats_t* stats);
+void _mi_os_free_ex(void* p, size_t size, bool was_committed, mi_stats_t* stats);
+
+void* _mi_os_alloc_huge_os_pages(size_t pages, int numa_node, mi_msecs_t max_secs, size_t* pages_reserved, size_t* psize);
+void _mi_os_free_huge_pages(void* p, size_t size, mi_stats_t* stats);
+
+bool _mi_os_commit(void* p, size_t size, bool* is_zero, mi_stats_t* stats);
+bool _mi_os_decommit(void* addr, size_t size, mi_stats_t* stats);
+
+
+/* -----------------------------------------------------------
+ Arena allocation
+----------------------------------------------------------- */
+
+
+// Block info: bit 0 contains the `in_use` bit, the upper bits the
+// size in count of arena blocks.
+typedef uintptr_t mi_block_info_t;
+#define MI_ARENA_BLOCK_SIZE (MI_SEGMENT_SIZE) // 8MiB (must be at least MI_SEGMENT_ALIGN)
+#define MI_ARENA_MIN_OBJ_SIZE (MI_ARENA_BLOCK_SIZE/2) // 4MiB
+#define MI_MAX_ARENAS (64) // not more than 256 (since we use 8 bits in the memid)
+
+// A memory arena descriptor
+typedef struct mi_arena_s {
+ _Atomic(uint8_t*) start; // the start of the memory area
+ size_t block_count; // size of the area in arena blocks (of `MI_ARENA_BLOCK_SIZE`)
+ size_t field_count; // number of bitmap fields (where `field_count * MI_BITMAP_FIELD_BITS >= block_count`)
+ int numa_node; // associated NUMA node
+ bool is_zero_init; // is the arena zero initialized?
+ bool allow_decommit; // is decommit allowed? if true, is_large should be false and blocks_committed != NULL
+ bool is_large; // large- or huge OS pages (always committed)
+ _Atomic(size_t) search_idx; // optimization to start the search for free blocks
+ mi_bitmap_field_t* blocks_dirty; // are the blocks potentially non-zero?
+ mi_bitmap_field_t* blocks_committed; // are the blocks committed? (can be NULL for memory that cannot be decommitted)
+ mi_bitmap_field_t blocks_inuse[1]; // in-place bitmap of in-use blocks (of size `field_count`)
+} mi_arena_t;
+
+
+// The available arenas
+static mi_decl_cache_align _Atomic(mi_arena_t*) mi_arenas[MI_MAX_ARENAS];
+static mi_decl_cache_align _Atomic(size_t) mi_arena_count; // = 0
+
+
+/* -----------------------------------------------------------
+ Arena allocations get a memory id where the lower 8 bits are
+ the arena index +1, and the upper bits the block index.
+----------------------------------------------------------- */
+
+// Use `0` as a special id for direct OS allocated memory.
+#define MI_MEMID_OS 0
+
+static size_t mi_arena_id_create(size_t arena_index, mi_bitmap_index_t bitmap_index) {
+ mi_assert_internal(arena_index < 0xFE);
+ mi_assert_internal(((bitmap_index << 8) >> 8) == bitmap_index); // no overflow?
+ return ((bitmap_index << 8) | ((arena_index+1) & 0xFF));
+}
+
+static void mi_arena_id_indices(size_t memid, size_t* arena_index, mi_bitmap_index_t* bitmap_index) {
+ mi_assert_internal(memid != MI_MEMID_OS);
+ *arena_index = (memid & 0xFF) - 1;
+ *bitmap_index = (memid >> 8);
+}
+
+static size_t mi_block_count_of_size(size_t size) {
+ return _mi_divide_up(size, MI_ARENA_BLOCK_SIZE);
+}
+
+/* -----------------------------------------------------------
+ Thread safe allocation in an arena
+----------------------------------------------------------- */
+static bool mi_arena_alloc(mi_arena_t* arena, size_t blocks, mi_bitmap_index_t* bitmap_idx)
+{
+ size_t idx = 0; // mi_atomic_load_relaxed(&arena->search_idx); // start from last search; ok to be relaxed as the exact start does not matter
+ if (_mi_bitmap_try_find_from_claim_across(arena->blocks_inuse, arena->field_count, idx, blocks, bitmap_idx)) {
+ mi_atomic_store_relaxed(&arena->search_idx, mi_bitmap_index_field(*bitmap_idx)); // start search from found location next time around
+ return true;
+ };
+ return false;
+}
+
+
+/* -----------------------------------------------------------
+ Arena Allocation
+----------------------------------------------------------- */
+
+static mi_decl_noinline void* mi_arena_alloc_from(mi_arena_t* arena, size_t arena_index, size_t needed_bcount,
+ bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld)
+{
+ mi_bitmap_index_t bitmap_index;
+ if (!mi_arena_alloc(arena, needed_bcount, &bitmap_index)) return NULL;
+
+ // claimed it! set the dirty bits (todo: no need for an atomic op here?)
+ void* p = arena->start + (mi_bitmap_index_bit(bitmap_index)*MI_ARENA_BLOCK_SIZE);
+ *memid = mi_arena_id_create(arena_index, bitmap_index);
+ *is_zero = _mi_bitmap_claim_across(arena->blocks_dirty, arena->field_count, needed_bcount, bitmap_index, NULL);
+ *large = arena->is_large;
+ *is_pinned = (arena->is_large || !arena->allow_decommit);
+ if (arena->blocks_committed == NULL) {
+ // always committed
+ *commit = true;
+ }
+ else if (*commit) {
+ // arena not committed as a whole, but commit requested: ensure commit now
+ bool any_uncommitted;
+ _mi_bitmap_claim_across(arena->blocks_committed, arena->field_count, needed_bcount, bitmap_index, &any_uncommitted);
+ if (any_uncommitted) {
+ bool commit_zero;
+ _mi_os_commit(p, needed_bcount * MI_ARENA_BLOCK_SIZE, &commit_zero, tld->stats);
+ if (commit_zero) *is_zero = true;
+ }
+ }
+ else {
+ // no need to commit, but check if already fully committed
+ *commit = _mi_bitmap_is_claimed_across(arena->blocks_committed, arena->field_count, needed_bcount, bitmap_index);
+ }
+ return p;
+}
+
+static mi_decl_noinline void* mi_arena_allocate(int numa_node, size_t size, size_t alignment, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld)
+{
+ MI_UNUSED_RELEASE(alignment);
+ mi_assert_internal(alignment <= MI_SEGMENT_ALIGN);
+ const size_t max_arena = mi_atomic_load_relaxed(&mi_arena_count);
+ const size_t bcount = mi_block_count_of_size(size);
+ if (mi_likely(max_arena == 0)) return NULL;
+ mi_assert_internal(size <= bcount*MI_ARENA_BLOCK_SIZE);
+
+ // try numa affine allocation
+ for (size_t i = 0; i < max_arena; i++) {
+ mi_arena_t* arena = mi_atomic_load_ptr_relaxed(mi_arena_t, &mi_arenas[i]);
+ if (arena==NULL) break; // end reached
+ if ((arena->numa_node<0 || arena->numa_node==numa_node) && // numa local?
+ (*large || !arena->is_large)) // large OS pages allowed, or arena is not large OS pages
+ {
+ void* p = mi_arena_alloc_from(arena, i, bcount, commit, large, is_pinned, is_zero, memid, tld);
+ mi_assert_internal((uintptr_t)p % alignment == 0);
+ if (p != NULL) {
+ return p;
+ }
+ }
+ }
+
+ // try from another numa node instead..
+ for (size_t i = 0; i < max_arena; i++) {
+ mi_arena_t* arena = mi_atomic_load_ptr_relaxed(mi_arena_t, &mi_arenas[i]);
+ if (arena==NULL) break; // end reached
+ if ((arena->numa_node>=0 && arena->numa_node!=numa_node) && // not numa local!
+ (*large || !arena->is_large)) // large OS pages allowed, or arena is not large OS pages
+ {
+ void* p = mi_arena_alloc_from(arena, i, bcount, commit, large, is_pinned, is_zero, memid, tld);
+ mi_assert_internal((uintptr_t)p % alignment == 0);
+ if (p != NULL) {
+ return p;
+ }
+ }
+ }
+ return NULL;
+}
+
+
+void* _mi_arena_alloc_aligned(size_t size, size_t alignment, bool* commit, bool* large, bool* is_pinned, bool* is_zero,
+ size_t* memid, mi_os_tld_t* tld)
+{
+ mi_assert_internal(commit != NULL && is_pinned != NULL && is_zero != NULL && memid != NULL && tld != NULL);
+ mi_assert_internal(size > 0);
+ *memid = MI_MEMID_OS;
+ *is_zero = false;
+ *is_pinned = false;
+
+ bool default_large = false;
+ if (large==NULL) large = &default_large; // ensure `large != NULL`
+ const int numa_node = _mi_os_numa_node(tld); // current numa node
+
+ // try to allocate in an arena if the alignment is small enough and the object is not too small (as for heap meta data)
+ if (size >= MI_ARENA_MIN_OBJ_SIZE && alignment <= MI_SEGMENT_ALIGN) {
+ void* p = mi_arena_allocate(numa_node, size, alignment, commit, large, is_pinned, is_zero, memid, tld);
+ if (p != NULL) return p;
+ }
+
+ // finally, fall back to the OS
+ if (mi_option_is_enabled(mi_option_limit_os_alloc)) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ *is_zero = true;
+ *memid = MI_MEMID_OS;
+ void* p = _mi_os_alloc_aligned(size, alignment, *commit, large, tld->stats);
+ if (p != NULL) *is_pinned = *large;
+ return p;
+}
+
+void* _mi_arena_alloc(size_t size, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld)
+{
+ return _mi_arena_alloc_aligned(size, MI_ARENA_BLOCK_SIZE, commit, large, is_pinned, is_zero, memid, tld);
+}
+
+/* -----------------------------------------------------------
+ Arena free
+----------------------------------------------------------- */
+
+void _mi_arena_free(void* p, size_t size, size_t memid, bool all_committed, mi_os_tld_t* tld) {
+ mi_assert_internal(size > 0 && tld->stats != NULL);
+ if (p==NULL) return;
+ if (size==0) return;
+
+ if (memid == MI_MEMID_OS) {
+ // was a direct OS allocation, pass through
+ _mi_os_free_ex(p, size, all_committed, tld->stats);
+ }
+ else {
+ // allocated in an arena
+ size_t arena_idx;
+ size_t bitmap_idx;
+ mi_arena_id_indices(memid, &arena_idx, &bitmap_idx);
+ mi_assert_internal(arena_idx < MI_MAX_ARENAS);
+ mi_arena_t* arena = mi_atomic_load_ptr_relaxed(mi_arena_t,&mi_arenas[arena_idx]);
+ mi_assert_internal(arena != NULL);
+ const size_t blocks = mi_block_count_of_size(size);
+ // checks
+ if (arena == NULL) {
+ _mi_error_message(EINVAL, "trying to free from non-existent arena: %p, size %zu, memid: 0x%zx\n", p, size, memid);
+ return;
+ }
+ mi_assert_internal(arena->field_count > mi_bitmap_index_field(bitmap_idx));
+ if (arena->field_count <= mi_bitmap_index_field(bitmap_idx)) {
+ _mi_error_message(EINVAL, "trying to free from non-existent arena block: %p, size %zu, memid: 0x%zx\n", p, size, memid);
+ return;
+ }
+ // potentially decommit
+ if (!arena->allow_decommit || arena->blocks_committed == NULL) {
+ mi_assert_internal(all_committed); // note: may be not true as we may "pretend" to be not committed (in segment.c)
+ }
+ else {
+ mi_assert_internal(arena->blocks_committed != NULL);
+ _mi_os_decommit(p, blocks * MI_ARENA_BLOCK_SIZE, tld->stats); // ok if this fails
+ _mi_bitmap_unclaim_across(arena->blocks_committed, arena->field_count, blocks, bitmap_idx);
+ }
+ // and make it available to others again
+ bool all_inuse = _mi_bitmap_unclaim_across(arena->blocks_inuse, arena->field_count, blocks, bitmap_idx);
+ if (!all_inuse) {
+ _mi_error_message(EAGAIN, "trying to free an already freed block: %p, size %zu\n", p, size);
+ return;
+ };
+ }
+}
+
+/* -----------------------------------------------------------
+ Add an arena.
+----------------------------------------------------------- */
+
+static bool mi_arena_add(mi_arena_t* arena) {
+ mi_assert_internal(arena != NULL);
+ mi_assert_internal((uintptr_t)mi_atomic_load_ptr_relaxed(uint8_t,&arena->start) % MI_SEGMENT_ALIGN == 0);
+ mi_assert_internal(arena->block_count > 0);
+
+ size_t i = mi_atomic_increment_acq_rel(&mi_arena_count);
+ if (i >= MI_MAX_ARENAS) {
+ mi_atomic_decrement_acq_rel(&mi_arena_count);
+ return false;
+ }
+ mi_atomic_store_ptr_release(mi_arena_t,&mi_arenas[i], arena);
+ return true;
+}
+
+bool mi_manage_os_memory(void* start, size_t size, bool is_committed, bool is_large, bool is_zero, int numa_node) mi_attr_noexcept
+{
+ if (size < MI_ARENA_BLOCK_SIZE) return false;
+
+ if (is_large) {
+ mi_assert_internal(is_committed);
+ is_committed = true;
+ }
+
+ const size_t bcount = size / MI_ARENA_BLOCK_SIZE;
+ const size_t fields = _mi_divide_up(bcount, MI_BITMAP_FIELD_BITS);
+ const size_t bitmaps = (is_committed ? 2 : 3);
+ const size_t asize = sizeof(mi_arena_t) + (bitmaps*fields*sizeof(mi_bitmap_field_t));
+ mi_arena_t* arena = (mi_arena_t*)_mi_os_alloc(asize, &_mi_stats_main); // TODO: can we avoid allocating from the OS?
+ if (arena == NULL) return false;
+
+ arena->block_count = bcount;
+ arena->field_count = fields;
+ arena->start = (uint8_t*)start;
+ arena->numa_node = numa_node; // TODO: or get the current numa node if -1? (now it allows anyone to allocate on -1)
+ arena->is_large = is_large;
+ arena->is_zero_init = is_zero;
+ arena->allow_decommit = !is_large && !is_committed; // only allow decommit for initially uncommitted memory
+ arena->search_idx = 0;
+ arena->blocks_dirty = &arena->blocks_inuse[fields]; // just after inuse bitmap
+ arena->blocks_committed = (!arena->allow_decommit ? NULL : &arena->blocks_inuse[2*fields]); // just after dirty bitmap
+ // the bitmaps are already zero initialized due to os_alloc
+ // initialize committed bitmap?
+ if (arena->blocks_committed != NULL && is_committed) {
+ memset((void*)arena->blocks_committed, 0xFF, fields*sizeof(mi_bitmap_field_t)); // cast to void* to avoid atomic warning
+ }
+ // and claim leftover blocks if needed (so we never allocate there)
+ ptrdiff_t post = (fields * MI_BITMAP_FIELD_BITS) - bcount;
+ mi_assert_internal(post >= 0);
+ if (post > 0) {
+ // don't use leftover bits at the end
+ mi_bitmap_index_t postidx = mi_bitmap_index_create(fields - 1, MI_BITMAP_FIELD_BITS - post);
+ _mi_bitmap_claim(arena->blocks_inuse, fields, post, postidx, NULL);
+ }
+
+ mi_arena_add(arena);
+ return true;
+}
+
+// Reserve a range of regular OS memory
+int mi_reserve_os_memory(size_t size, bool commit, bool allow_large) mi_attr_noexcept
+{
+ size = _mi_align_up(size, MI_ARENA_BLOCK_SIZE); // at least one block
+ bool large = allow_large;
+ void* start = _mi_os_alloc_aligned(size, MI_SEGMENT_ALIGN, commit, &large, &_mi_stats_main);
+ if (start==NULL) return ENOMEM;
+ if (!mi_manage_os_memory(start, size, (large || commit), large, true, -1)) {
+ _mi_os_free_ex(start, size, commit, &_mi_stats_main);
+ _mi_verbose_message("failed to reserve %zu k memory\n", _mi_divide_up(size,1024));
+ return ENOMEM;
+ }
+ _mi_verbose_message("reserved %zu KiB memory%s\n", _mi_divide_up(size,1024), large ? " (in large os pages)" : "");
+ return 0;
+}
+
+static size_t mi_debug_show_bitmap(const char* prefix, mi_bitmap_field_t* fields, size_t field_count ) {
+ size_t inuse_count = 0;
+ for (size_t i = 0; i < field_count; i++) {
+ char buf[MI_BITMAP_FIELD_BITS + 1];
+ uintptr_t field = mi_atomic_load_relaxed(&fields[i]);
+ for (size_t bit = 0; bit < MI_BITMAP_FIELD_BITS; bit++) {
+ bool inuse = ((((uintptr_t)1 << bit) & field) != 0);
+ if (inuse) inuse_count++;
+ buf[MI_BITMAP_FIELD_BITS - 1 - bit] = (inuse ? 'x' : '.');
+ }
+ buf[MI_BITMAP_FIELD_BITS] = 0;
+ _mi_verbose_message("%s%s\n", prefix, buf);
+ }
+ return inuse_count;
+}
+
+void mi_debug_show_arenas(void) mi_attr_noexcept {
+ size_t max_arenas = mi_atomic_load_relaxed(&mi_arena_count);
+ for (size_t i = 0; i < max_arenas; i++) {
+ mi_arena_t* arena = mi_atomic_load_ptr_relaxed(mi_arena_t, &mi_arenas[i]);
+ if (arena == NULL) break;
+ size_t inuse_count = 0;
+ _mi_verbose_message("arena %zu: %zu blocks with %zu fields\n", i, arena->block_count, arena->field_count);
+ inuse_count += mi_debug_show_bitmap(" ", arena->blocks_inuse, arena->field_count);
+ _mi_verbose_message(" blocks in use ('x'): %zu\n", inuse_count);
+ }
+}
+
+/* -----------------------------------------------------------
+ Reserve a huge page arena.
+----------------------------------------------------------- */
+// reserve at a specific numa node
+int mi_reserve_huge_os_pages_at(size_t pages, int numa_node, size_t timeout_msecs) mi_attr_noexcept {
+ if (pages==0) return 0;
+ if (numa_node < -1) numa_node = -1;
+ if (numa_node >= 0) numa_node = numa_node % _mi_os_numa_node_count();
+ size_t hsize = 0;
+ size_t pages_reserved = 0;
+ void* p = _mi_os_alloc_huge_os_pages(pages, numa_node, timeout_msecs, &pages_reserved, &hsize);
+ if (p==NULL || pages_reserved==0) {
+ _mi_warning_message("failed to reserve %zu GiB huge pages\n", pages);
+ return ENOMEM;
+ }
+ _mi_verbose_message("numa node %i: reserved %zu GiB huge pages (of the %zu GiB requested)\n", numa_node, pages_reserved, pages);
+
+ if (!mi_manage_os_memory(p, hsize, true, true, true, numa_node)) {
+ _mi_os_free_huge_pages(p, hsize, &_mi_stats_main);
+ return ENOMEM;
+ }
+ return 0;
+}
+
+
+// reserve huge pages evenly among the given number of numa nodes (or use the available ones as detected)
+int mi_reserve_huge_os_pages_interleave(size_t pages, size_t numa_nodes, size_t timeout_msecs) mi_attr_noexcept {
+ if (pages == 0) return 0;
+
+ // pages per numa node
+ size_t numa_count = (numa_nodes > 0 ? numa_nodes : _mi_os_numa_node_count());
+ if (numa_count <= 0) numa_count = 1;
+ const size_t pages_per = pages / numa_count;
+ const size_t pages_mod = pages % numa_count;
+ const size_t timeout_per = (timeout_msecs==0 ? 0 : (timeout_msecs / numa_count) + 50);
+
+ // reserve evenly among numa nodes
+ for (size_t numa_node = 0; numa_node < numa_count && pages > 0; numa_node++) {
+ size_t node_pages = pages_per; // can be 0
+ if (numa_node < pages_mod) node_pages++;
+ int err = mi_reserve_huge_os_pages_at(node_pages, (int)numa_node, timeout_per);
+ if (err) return err;
+ if (pages < node_pages) {
+ pages = 0;
+ }
+ else {
+ pages -= node_pages;
+ }
+ }
+
+ return 0;
+}
+
+int mi_reserve_huge_os_pages(size_t pages, double max_secs, size_t* pages_reserved) mi_attr_noexcept {
+ MI_UNUSED(max_secs);
+ _mi_warning_message("mi_reserve_huge_os_pages is deprecated: use mi_reserve_huge_os_pages_interleave/at instead\n");
+ if (pages_reserved != NULL) *pages_reserved = 0;
+ int err = mi_reserve_huge_os_pages_interleave(pages, 0, (size_t)(max_secs * 1000.0));
+ if (err==0 && pages_reserved!=NULL) *pages_reserved = pages;
+ return err;
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/bitmap.c b/source/luametatex/source/libraries/mimalloc/src/bitmap.c
new file mode 100644
index 000000000..af6de0a12
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/bitmap.c
@@ -0,0 +1,395 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2019-2021 Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* ----------------------------------------------------------------------------
+Concurrent bitmap that can set/reset sequences of bits atomically,
+represeted as an array of fields where each field is a machine word (`size_t`)
+
+There are two api's; the standard one cannot have sequences that cross
+between the bitmap fields (and a sequence must be <= MI_BITMAP_FIELD_BITS).
+(this is used in region allocation)
+
+The `_across` postfixed functions do allow sequences that can cross over
+between the fields. (This is used in arena allocation)
+---------------------------------------------------------------------------- */
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "bitmap.h"
+
+/* -----------------------------------------------------------
+ Bitmap definition
+----------------------------------------------------------- */
+
+// The bit mask for a given number of blocks at a specified bit index.
+static inline size_t mi_bitmap_mask_(size_t count, size_t bitidx) {
+ mi_assert_internal(count + bitidx <= MI_BITMAP_FIELD_BITS);
+ mi_assert_internal(count > 0);
+ if (count >= MI_BITMAP_FIELD_BITS) return MI_BITMAP_FIELD_FULL;
+ if (count == 0) return 0;
+ return ((((size_t)1 << count) - 1) << bitidx);
+}
+
+
+/* -----------------------------------------------------------
+ Claim a bit sequence atomically
+----------------------------------------------------------- */
+
+// Try to atomically claim a sequence of `count` bits in a single
+// field at `idx` in `bitmap`. Returns `true` on success.
+inline bool _mi_bitmap_try_find_claim_field(mi_bitmap_t bitmap, size_t idx, const size_t count, mi_bitmap_index_t* bitmap_idx)
+{
+ mi_assert_internal(bitmap_idx != NULL);
+ mi_assert_internal(count <= MI_BITMAP_FIELD_BITS);
+ mi_assert_internal(count > 0);
+ mi_bitmap_field_t* field = &bitmap[idx];
+ size_t map = mi_atomic_load_relaxed(field);
+ if (map==MI_BITMAP_FIELD_FULL) return false; // short cut
+
+ // search for 0-bit sequence of length count
+ const size_t mask = mi_bitmap_mask_(count, 0);
+ const size_t bitidx_max = MI_BITMAP_FIELD_BITS - count;
+
+#ifdef MI_HAVE_FAST_BITSCAN
+ size_t bitidx = mi_ctz(~map); // quickly find the first zero bit if possible
+#else
+ size_t bitidx = 0; // otherwise start at 0
+#endif
+ size_t m = (mask << bitidx); // invariant: m == mask shifted by bitidx
+
+ // scan linearly for a free range of zero bits
+ while (bitidx <= bitidx_max) {
+ const size_t mapm = map & m;
+ if (mapm == 0) { // are the mask bits free at bitidx?
+ mi_assert_internal((m >> bitidx) == mask); // no overflow?
+ const size_t newmap = map | m;
+ mi_assert_internal((newmap^map) >> bitidx == mask);
+ if (!mi_atomic_cas_weak_acq_rel(field, &map, newmap)) { // TODO: use strong cas here?
+ // no success, another thread claimed concurrently.. keep going (with updated `map`)
+ continue;
+ }
+ else {
+ // success, we claimed the bits!
+ *bitmap_idx = mi_bitmap_index_create(idx, bitidx);
+ return true;
+ }
+ }
+ else {
+ // on to the next bit range
+#ifdef MI_HAVE_FAST_BITSCAN
+ const size_t shift = (count == 1 ? 1 : mi_bsr(mapm) - bitidx + 1);
+ mi_assert_internal(shift > 0 && shift <= count);
+#else
+ const size_t shift = 1;
+#endif
+ bitidx += shift;
+ m <<= shift;
+ }
+ }
+ // no bits found
+ return false;
+}
+
+// Find `count` bits of 0 and set them to 1 atomically; returns `true` on success.
+// Starts at idx, and wraps around to search in all `bitmap_fields` fields.
+// `count` can be at most MI_BITMAP_FIELD_BITS and will never cross fields.
+bool _mi_bitmap_try_find_from_claim(mi_bitmap_t bitmap, const size_t bitmap_fields, const size_t start_field_idx, const size_t count, mi_bitmap_index_t* bitmap_idx) {
+ size_t idx = start_field_idx;
+ for (size_t visited = 0; visited < bitmap_fields; visited++, idx++) {
+ if (idx >= bitmap_fields) idx = 0; // wrap
+ if (_mi_bitmap_try_find_claim_field(bitmap, idx, count, bitmap_idx)) {
+ return true;
+ }
+ }
+ return false;
+}
+
+/*
+// Find `count` bits of 0 and set them to 1 atomically; returns `true` on success.
+// For now, `count` can be at most MI_BITMAP_FIELD_BITS and will never span fields.
+bool _mi_bitmap_try_find_claim(mi_bitmap_t bitmap, const size_t bitmap_fields, const size_t count, mi_bitmap_index_t* bitmap_idx) {
+ return _mi_bitmap_try_find_from_claim(bitmap, bitmap_fields, 0, count, bitmap_idx);
+}
+*/
+
+// Set `count` bits at `bitmap_idx` to 0 atomically
+// Returns `true` if all `count` bits were 1 previously.
+bool _mi_bitmap_unclaim(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx) {
+ const size_t idx = mi_bitmap_index_field(bitmap_idx);
+ const size_t bitidx = mi_bitmap_index_bit_in_field(bitmap_idx);
+ const size_t mask = mi_bitmap_mask_(count, bitidx);
+ mi_assert_internal(bitmap_fields > idx); MI_UNUSED(bitmap_fields);
+ // mi_assert_internal((bitmap[idx] & mask) == mask);
+ size_t prev = mi_atomic_and_acq_rel(&bitmap[idx], ~mask);
+ return ((prev & mask) == mask);
+}
+
+
+// Set `count` bits at `bitmap_idx` to 1 atomically
+// Returns `true` if all `count` bits were 0 previously. `any_zero` is `true` if there was at least one zero bit.
+bool _mi_bitmap_claim(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx, bool* any_zero) {
+ const size_t idx = mi_bitmap_index_field(bitmap_idx);
+ const size_t bitidx = mi_bitmap_index_bit_in_field(bitmap_idx);
+ const size_t mask = mi_bitmap_mask_(count, bitidx);
+ mi_assert_internal(bitmap_fields > idx); MI_UNUSED(bitmap_fields);
+ //mi_assert_internal(any_zero != NULL || (bitmap[idx] & mask) == 0);
+ size_t prev = mi_atomic_or_acq_rel(&bitmap[idx], mask);
+ if (any_zero != NULL) *any_zero = ((prev & mask) != mask);
+ return ((prev & mask) == 0);
+}
+
+// Returns `true` if all `count` bits were 1. `any_ones` is `true` if there was at least one bit set to one.
+static bool mi_bitmap_is_claimedx(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx, bool* any_ones) {
+ const size_t idx = mi_bitmap_index_field(bitmap_idx);
+ const size_t bitidx = mi_bitmap_index_bit_in_field(bitmap_idx);
+ const size_t mask = mi_bitmap_mask_(count, bitidx);
+ mi_assert_internal(bitmap_fields > idx); MI_UNUSED(bitmap_fields);
+ size_t field = mi_atomic_load_relaxed(&bitmap[idx]);
+ if (any_ones != NULL) *any_ones = ((field & mask) != 0);
+ return ((field & mask) == mask);
+}
+
+bool _mi_bitmap_is_claimed(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx) {
+ return mi_bitmap_is_claimedx(bitmap, bitmap_fields, count, bitmap_idx, NULL);
+}
+
+bool _mi_bitmap_is_any_claimed(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx) {
+ bool any_ones;
+ mi_bitmap_is_claimedx(bitmap, bitmap_fields, count, bitmap_idx, &any_ones);
+ return any_ones;
+}
+
+
+//--------------------------------------------------------------------------
+// the `_across` functions work on bitmaps where sequences can cross over
+// between the fields. This is used in arena allocation
+//--------------------------------------------------------------------------
+
+// Try to atomically claim a sequence of `count` bits starting from the field
+// at `idx` in `bitmap` and crossing into subsequent fields. Returns `true` on success.
+static bool mi_bitmap_try_find_claim_field_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t idx, const size_t count, const size_t retries, mi_bitmap_index_t* bitmap_idx)
+{
+ mi_assert_internal(bitmap_idx != NULL);
+
+ // check initial trailing zeros
+ mi_bitmap_field_t* field = &bitmap[idx];
+ size_t map = mi_atomic_load_relaxed(field);
+ const size_t initial = mi_clz(map); // count of initial zeros starting at idx
+ mi_assert_internal(initial <= MI_BITMAP_FIELD_BITS);
+ if (initial == 0) return false;
+ if (initial >= count) return _mi_bitmap_try_find_claim_field(bitmap, idx, count, bitmap_idx); // no need to cross fields
+ if (_mi_divide_up(count - initial, MI_BITMAP_FIELD_BITS) >= (bitmap_fields - idx)) return false; // not enough entries
+
+ // scan ahead
+ size_t found = initial;
+ size_t mask = 0; // mask bits for the final field
+ while(found < count) {
+ field++;
+ map = mi_atomic_load_relaxed(field);
+ const size_t mask_bits = (found + MI_BITMAP_FIELD_BITS <= count ? MI_BITMAP_FIELD_BITS : (count - found));
+ mask = mi_bitmap_mask_(mask_bits, 0);
+ if ((map & mask) != 0) return false;
+ found += mask_bits;
+ }
+ mi_assert_internal(field < &bitmap[bitmap_fields]);
+
+ // found range of zeros up to the final field; mask contains mask in the final field
+ // now claim it atomically
+ mi_bitmap_field_t* const final_field = field;
+ const size_t final_mask = mask;
+ mi_bitmap_field_t* const initial_field = &bitmap[idx];
+ const size_t initial_mask = mi_bitmap_mask_(initial, MI_BITMAP_FIELD_BITS - initial);
+
+ // initial field
+ size_t newmap;
+ field = initial_field;
+ map = mi_atomic_load_relaxed(field);
+ do {
+ newmap = map | initial_mask;
+ if ((map & initial_mask) != 0) { goto rollback; };
+ } while (!mi_atomic_cas_strong_acq_rel(field, &map, newmap));
+
+ // intermediate fields
+ while (++field < final_field) {
+ newmap = MI_BITMAP_FIELD_FULL;
+ map = 0;
+ if (!mi_atomic_cas_strong_acq_rel(field, &map, newmap)) { goto rollback; }
+ }
+
+ // final field
+ mi_assert_internal(field == final_field);
+ map = mi_atomic_load_relaxed(field);
+ do {
+ newmap = map | final_mask;
+ if ((map & final_mask) != 0) { goto rollback; }
+ } while (!mi_atomic_cas_strong_acq_rel(field, &map, newmap));
+
+ // claimed!
+ *bitmap_idx = mi_bitmap_index_create(idx, MI_BITMAP_FIELD_BITS - initial);
+ return true;
+
+rollback:
+ // roll back intermediate fields
+ while (--field > initial_field) {
+ newmap = 0;
+ map = MI_BITMAP_FIELD_FULL;
+ mi_assert_internal(mi_atomic_load_relaxed(field) == map);
+ mi_atomic_store_release(field, newmap);
+ }
+ if (field == initial_field) {
+ map = mi_atomic_load_relaxed(field);
+ do {
+ mi_assert_internal((map & initial_mask) == initial_mask);
+ newmap = map & ~initial_mask;
+ } while (!mi_atomic_cas_strong_acq_rel(field, &map, newmap));
+ }
+ // retry? (we make a recursive call instead of goto to be able to use const declarations)
+ if (retries < 4) {
+ return mi_bitmap_try_find_claim_field_across(bitmap, bitmap_fields, idx, count, retries+1, bitmap_idx);
+ }
+ else {
+ return false;
+ }
+}
+
+
+// Find `count` bits of zeros and set them to 1 atomically; returns `true` on success.
+// Starts at idx, and wraps around to search in all `bitmap_fields` fields.
+bool _mi_bitmap_try_find_from_claim_across(mi_bitmap_t bitmap, const size_t bitmap_fields, const size_t start_field_idx, const size_t count, mi_bitmap_index_t* bitmap_idx) {
+ mi_assert_internal(count > 0);
+ if (count==1) return _mi_bitmap_try_find_from_claim(bitmap, bitmap_fields, start_field_idx, count, bitmap_idx);
+ size_t idx = start_field_idx;
+ for (size_t visited = 0; visited < bitmap_fields; visited++, idx++) {
+ if (idx >= bitmap_fields) idx = 0; // wrap
+ // try to claim inside the field
+ if (count <= MI_BITMAP_FIELD_BITS) {
+ if (_mi_bitmap_try_find_claim_field(bitmap, idx, count, bitmap_idx)) {
+ return true;
+ }
+ }
+ // try to claim across fields
+ if (mi_bitmap_try_find_claim_field_across(bitmap, bitmap_fields, idx, count, 0, bitmap_idx)) {
+ return true;
+ }
+ }
+ return false;
+}
+
+// Helper for masks across fields; returns the mid count, post_mask may be 0
+static size_t mi_bitmap_mask_across(mi_bitmap_index_t bitmap_idx, size_t bitmap_fields, size_t count, size_t* pre_mask, size_t* mid_mask, size_t* post_mask) {
+ MI_UNUSED_RELEASE(bitmap_fields);
+ const size_t bitidx = mi_bitmap_index_bit_in_field(bitmap_idx);
+ if (mi_likely(bitidx + count <= MI_BITMAP_FIELD_BITS)) {
+ *pre_mask = mi_bitmap_mask_(count, bitidx);
+ *mid_mask = 0;
+ *post_mask = 0;
+ mi_assert_internal(mi_bitmap_index_field(bitmap_idx) < bitmap_fields);
+ return 0;
+ }
+ else {
+ const size_t pre_bits = MI_BITMAP_FIELD_BITS - bitidx;
+ mi_assert_internal(pre_bits < count);
+ *pre_mask = mi_bitmap_mask_(pre_bits, bitidx);
+ count -= pre_bits;
+ const size_t mid_count = (count / MI_BITMAP_FIELD_BITS);
+ *mid_mask = MI_BITMAP_FIELD_FULL;
+ count %= MI_BITMAP_FIELD_BITS;
+ *post_mask = (count==0 ? 0 : mi_bitmap_mask_(count, 0));
+ mi_assert_internal(mi_bitmap_index_field(bitmap_idx) + mid_count + (count==0 ? 0 : 1) < bitmap_fields);
+ return mid_count;
+ }
+}
+
+// Set `count` bits at `bitmap_idx` to 0 atomically
+// Returns `true` if all `count` bits were 1 previously.
+bool _mi_bitmap_unclaim_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx) {
+ size_t idx = mi_bitmap_index_field(bitmap_idx);
+ size_t pre_mask;
+ size_t mid_mask;
+ size_t post_mask;
+ size_t mid_count = mi_bitmap_mask_across(bitmap_idx, bitmap_fields, count, &pre_mask, &mid_mask, &post_mask);
+ bool all_one = true;
+ mi_bitmap_field_t* field = &bitmap[idx];
+ size_t prev = mi_atomic_and_acq_rel(field++, ~pre_mask);
+ if ((prev & pre_mask) != pre_mask) all_one = false;
+ while(mid_count-- > 0) {
+ prev = mi_atomic_and_acq_rel(field++, ~mid_mask);
+ if ((prev & mid_mask) != mid_mask) all_one = false;
+ }
+ if (post_mask!=0) {
+ prev = mi_atomic_and_acq_rel(field, ~post_mask);
+ if ((prev & post_mask) != post_mask) all_one = false;
+ }
+ return all_one;
+}
+
+// Set `count` bits at `bitmap_idx` to 1 atomically
+// Returns `true` if all `count` bits were 0 previously. `any_zero` is `true` if there was at least one zero bit.
+bool _mi_bitmap_claim_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx, bool* pany_zero) {
+ size_t idx = mi_bitmap_index_field(bitmap_idx);
+ size_t pre_mask;
+ size_t mid_mask;
+ size_t post_mask;
+ size_t mid_count = mi_bitmap_mask_across(bitmap_idx, bitmap_fields, count, &pre_mask, &mid_mask, &post_mask);
+ bool all_zero = true;
+ bool any_zero = false;
+ _Atomic(size_t)*field = &bitmap[idx];
+ size_t prev = mi_atomic_or_acq_rel(field++, pre_mask);
+ if ((prev & pre_mask) != 0) all_zero = false;
+ if ((prev & pre_mask) != pre_mask) any_zero = true;
+ while (mid_count-- > 0) {
+ prev = mi_atomic_or_acq_rel(field++, mid_mask);
+ if ((prev & mid_mask) != 0) all_zero = false;
+ if ((prev & mid_mask) != mid_mask) any_zero = true;
+ }
+ if (post_mask!=0) {
+ prev = mi_atomic_or_acq_rel(field, post_mask);
+ if ((prev & post_mask) != 0) all_zero = false;
+ if ((prev & post_mask) != post_mask) any_zero = true;
+ }
+ if (pany_zero != NULL) *pany_zero = any_zero;
+ return all_zero;
+}
+
+
+// Returns `true` if all `count` bits were 1.
+// `any_ones` is `true` if there was at least one bit set to one.
+static bool mi_bitmap_is_claimedx_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx, bool* pany_ones) {
+ size_t idx = mi_bitmap_index_field(bitmap_idx);
+ size_t pre_mask;
+ size_t mid_mask;
+ size_t post_mask;
+ size_t mid_count = mi_bitmap_mask_across(bitmap_idx, bitmap_fields, count, &pre_mask, &mid_mask, &post_mask);
+ bool all_ones = true;
+ bool any_ones = false;
+ mi_bitmap_field_t* field = &bitmap[idx];
+ size_t prev = mi_atomic_load_relaxed(field++);
+ if ((prev & pre_mask) != pre_mask) all_ones = false;
+ if ((prev & pre_mask) != 0) any_ones = true;
+ while (mid_count-- > 0) {
+ prev = mi_atomic_load_relaxed(field++);
+ if ((prev & mid_mask) != mid_mask) all_ones = false;
+ if ((prev & mid_mask) != 0) any_ones = true;
+ }
+ if (post_mask!=0) {
+ prev = mi_atomic_load_relaxed(field);
+ if ((prev & post_mask) != post_mask) all_ones = false;
+ if ((prev & post_mask) != 0) any_ones = true;
+ }
+ if (pany_ones != NULL) *pany_ones = any_ones;
+ return all_ones;
+}
+
+bool _mi_bitmap_is_claimed_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx) {
+ return mi_bitmap_is_claimedx_across(bitmap, bitmap_fields, count, bitmap_idx, NULL);
+}
+
+bool _mi_bitmap_is_any_claimed_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx) {
+ bool any_ones;
+ mi_bitmap_is_claimedx_across(bitmap, bitmap_fields, count, bitmap_idx, &any_ones);
+ return any_ones;
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/bitmap.h b/source/luametatex/source/libraries/mimalloc/src/bitmap.h
new file mode 100644
index 000000000..7bd3106c9
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/bitmap.h
@@ -0,0 +1,107 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2019-2020 Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* ----------------------------------------------------------------------------
+Concurrent bitmap that can set/reset sequences of bits atomically,
+represeted as an array of fields where each field is a machine word (`size_t`)
+
+There are two api's; the standard one cannot have sequences that cross
+between the bitmap fields (and a sequence must be <= MI_BITMAP_FIELD_BITS).
+(this is used in region allocation)
+
+The `_across` postfixed functions do allow sequences that can cross over
+between the fields. (This is used in arena allocation)
+---------------------------------------------------------------------------- */
+#pragma once
+#ifndef MI_BITMAP_H
+#define MI_BITMAP_H
+
+/* -----------------------------------------------------------
+ Bitmap definition
+----------------------------------------------------------- */
+
+#define MI_BITMAP_FIELD_BITS (8*MI_SIZE_SIZE)
+#define MI_BITMAP_FIELD_FULL (~((size_t)0)) // all bits set
+
+// An atomic bitmap of `size_t` fields
+typedef _Atomic(size_t) mi_bitmap_field_t;
+typedef mi_bitmap_field_t* mi_bitmap_t;
+
+// A bitmap index is the index of the bit in a bitmap.
+typedef size_t mi_bitmap_index_t;
+
+// Create a bit index.
+static inline mi_bitmap_index_t mi_bitmap_index_create(size_t idx, size_t bitidx) {
+ mi_assert_internal(bitidx < MI_BITMAP_FIELD_BITS);
+ return (idx*MI_BITMAP_FIELD_BITS) + bitidx;
+}
+
+// Create a bit index.
+static inline mi_bitmap_index_t mi_bitmap_index_create_from_bit(size_t full_bitidx) {
+ return mi_bitmap_index_create(full_bitidx / MI_BITMAP_FIELD_BITS, full_bitidx % MI_BITMAP_FIELD_BITS);
+}
+
+// Get the field index from a bit index.
+static inline size_t mi_bitmap_index_field(mi_bitmap_index_t bitmap_idx) {
+ return (bitmap_idx / MI_BITMAP_FIELD_BITS);
+}
+
+// Get the bit index in a bitmap field
+static inline size_t mi_bitmap_index_bit_in_field(mi_bitmap_index_t bitmap_idx) {
+ return (bitmap_idx % MI_BITMAP_FIELD_BITS);
+}
+
+// Get the full bit index
+static inline size_t mi_bitmap_index_bit(mi_bitmap_index_t bitmap_idx) {
+ return bitmap_idx;
+}
+
+/* -----------------------------------------------------------
+ Claim a bit sequence atomically
+----------------------------------------------------------- */
+
+// Try to atomically claim a sequence of `count` bits in a single
+// field at `idx` in `bitmap`. Returns `true` on success.
+bool _mi_bitmap_try_find_claim_field(mi_bitmap_t bitmap, size_t idx, const size_t count, mi_bitmap_index_t* bitmap_idx);
+
+// Starts at idx, and wraps around to search in all `bitmap_fields` fields.
+// For now, `count` can be at most MI_BITMAP_FIELD_BITS and will never cross fields.
+bool _mi_bitmap_try_find_from_claim(mi_bitmap_t bitmap, const size_t bitmap_fields, const size_t start_field_idx, const size_t count, mi_bitmap_index_t* bitmap_idx);
+
+// Set `count` bits at `bitmap_idx` to 0 atomically
+// Returns `true` if all `count` bits were 1 previously.
+bool _mi_bitmap_unclaim(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx);
+
+// Set `count` bits at `bitmap_idx` to 1 atomically
+// Returns `true` if all `count` bits were 0 previously. `any_zero` is `true` if there was at least one zero bit.
+bool _mi_bitmap_claim(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx, bool* any_zero);
+
+bool _mi_bitmap_is_claimed(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx);
+bool _mi_bitmap_is_any_claimed(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx);
+
+
+//--------------------------------------------------------------------------
+// the `_across` functions work on bitmaps where sequences can cross over
+// between the fields. This is used in arena allocation
+//--------------------------------------------------------------------------
+
+// Find `count` bits of zeros and set them to 1 atomically; returns `true` on success.
+// Starts at idx, and wraps around to search in all `bitmap_fields` fields.
+bool _mi_bitmap_try_find_from_claim_across(mi_bitmap_t bitmap, const size_t bitmap_fields, const size_t start_field_idx, const size_t count, mi_bitmap_index_t* bitmap_idx);
+
+// Set `count` bits at `bitmap_idx` to 0 atomically
+// Returns `true` if all `count` bits were 1 previously.
+bool _mi_bitmap_unclaim_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx);
+
+// Set `count` bits at `bitmap_idx` to 1 atomically
+// Returns `true` if all `count` bits were 0 previously. `any_zero` is `true` if there was at least one zero bit.
+bool _mi_bitmap_claim_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx, bool* pany_zero);
+
+bool _mi_bitmap_is_claimed_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx);
+bool _mi_bitmap_is_any_claimed_across(mi_bitmap_t bitmap, size_t bitmap_fields, size_t count, mi_bitmap_index_t bitmap_idx);
+
+#endif
diff --git a/source/luametatex/source/libraries/mimalloc/src/heap.c b/source/luametatex/source/libraries/mimalloc/src/heap.c
new file mode 100644
index 000000000..816d961ae
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/heap.c
@@ -0,0 +1,580 @@
+/*----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <string.h> // memset, memcpy
+
+#if defined(_MSC_VER) && (_MSC_VER < 1920)
+#pragma warning(disable:4204) // non-constant aggregate initializer
+#endif
+
+/* -----------------------------------------------------------
+ Helpers
+----------------------------------------------------------- */
+
+// return `true` if ok, `false` to break
+typedef bool (heap_page_visitor_fun)(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* arg1, void* arg2);
+
+// Visit all pages in a heap; returns `false` if break was called.
+static bool mi_heap_visit_pages(mi_heap_t* heap, heap_page_visitor_fun* fn, void* arg1, void* arg2)
+{
+ if (heap==NULL || heap->page_count==0) return 0;
+
+ // visit all pages
+ #if MI_DEBUG>1
+ size_t total = heap->page_count;
+ #endif
+ size_t count = 0;
+ for (size_t i = 0; i <= MI_BIN_FULL; i++) {
+ mi_page_queue_t* pq = &heap->pages[i];
+ mi_page_t* page = pq->first;
+ while(page != NULL) {
+ mi_page_t* next = page->next; // save next in case the page gets removed from the queue
+ mi_assert_internal(mi_page_heap(page) == heap);
+ count++;
+ if (!fn(heap, pq, page, arg1, arg2)) return false;
+ page = next; // and continue
+ }
+ }
+ mi_assert_internal(count == total);
+ return true;
+}
+
+
+#if MI_DEBUG>=2
+static bool mi_heap_page_is_valid(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* arg1, void* arg2) {
+ MI_UNUSED(arg1);
+ MI_UNUSED(arg2);
+ MI_UNUSED(pq);
+ mi_assert_internal(mi_page_heap(page) == heap);
+ mi_segment_t* segment = _mi_page_segment(page);
+ mi_assert_internal(segment->thread_id == heap->thread_id);
+ mi_assert_expensive(_mi_page_is_valid(page));
+ return true;
+}
+#endif
+#if MI_DEBUG>=3
+static bool mi_heap_is_valid(mi_heap_t* heap) {
+ mi_assert_internal(heap!=NULL);
+ mi_heap_visit_pages(heap, &mi_heap_page_is_valid, NULL, NULL);
+ return true;
+}
+#endif
+
+
+
+
+/* -----------------------------------------------------------
+ "Collect" pages by migrating `local_free` and `thread_free`
+ lists and freeing empty pages. This is done when a thread
+ stops (and in that case abandons pages if there are still
+ blocks alive)
+----------------------------------------------------------- */
+
+typedef enum mi_collect_e {
+ MI_NORMAL,
+ MI_FORCE,
+ MI_ABANDON
+} mi_collect_t;
+
+
+static bool mi_heap_page_collect(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* arg_collect, void* arg2 ) {
+ MI_UNUSED(arg2);
+ MI_UNUSED(heap);
+ mi_assert_internal(mi_heap_page_is_valid(heap, pq, page, NULL, NULL));
+ mi_collect_t collect = *((mi_collect_t*)arg_collect);
+ _mi_page_free_collect(page, collect >= MI_FORCE);
+ if (mi_page_all_free(page)) {
+ // no more used blocks, free the page.
+ // note: this will free retired pages as well.
+ _mi_page_free(page, pq, collect >= MI_FORCE);
+ }
+ else if (collect == MI_ABANDON) {
+ // still used blocks but the thread is done; abandon the page
+ _mi_page_abandon(page, pq);
+ }
+ return true; // don't break
+}
+
+static bool mi_heap_page_never_delayed_free(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* arg1, void* arg2) {
+ MI_UNUSED(arg1);
+ MI_UNUSED(arg2);
+ MI_UNUSED(heap);
+ MI_UNUSED(pq);
+ _mi_page_use_delayed_free(page, MI_NEVER_DELAYED_FREE, false);
+ return true; // don't break
+}
+
+static void mi_heap_collect_ex(mi_heap_t* heap, mi_collect_t collect)
+{
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return;
+
+ const bool force = collect >= MI_FORCE;
+ _mi_deferred_free(heap, force);
+
+ // note: never reclaim on collect but leave it to threads that need storage to reclaim
+ const bool force_main =
+ #ifdef NDEBUG
+ collect == MI_FORCE
+ #else
+ collect >= MI_FORCE
+ #endif
+ && _mi_is_main_thread() && mi_heap_is_backing(heap) && !heap->no_reclaim;
+
+ if (force_main) {
+ // the main thread is abandoned (end-of-program), try to reclaim all abandoned segments.
+ // if all memory is freed by now, all segments should be freed.
+ _mi_abandoned_reclaim_all(heap, &heap->tld->segments);
+ }
+
+ // if abandoning, mark all pages to no longer add to delayed_free
+ if (collect == MI_ABANDON) {
+ mi_heap_visit_pages(heap, &mi_heap_page_never_delayed_free, NULL, NULL);
+ }
+
+ // free thread delayed blocks.
+ // (if abandoning, after this there are no more thread-delayed references into the pages.)
+ _mi_heap_delayed_free(heap);
+
+ // collect retired pages
+ _mi_heap_collect_retired(heap, force);
+
+ // collect all pages owned by this thread
+ mi_heap_visit_pages(heap, &mi_heap_page_collect, &collect, NULL);
+ mi_assert_internal( collect != MI_ABANDON || mi_atomic_load_ptr_acquire(mi_block_t,&heap->thread_delayed_free) == NULL );
+
+ // collect abandoned segments (in particular, decommit expired parts of segments in the abandoned segment list)
+ // note: forced decommit can be quite expensive if many threads are created/destroyed so we do not force on abandonment
+ _mi_abandoned_collect(heap, collect == MI_FORCE /* force? */, &heap->tld->segments);
+
+ // collect segment local caches
+ if (force) {
+ _mi_segment_thread_collect(&heap->tld->segments);
+ }
+
+ // decommit in global segment caches
+ // note: forced decommit can be quite expensive if many threads are created/destroyed so we do not force on abandonment
+ _mi_segment_cache_collect( collect == MI_FORCE, &heap->tld->os);
+
+ // collect regions on program-exit (or shared library unload)
+ if (force && _mi_is_main_thread() && mi_heap_is_backing(heap)) {
+ //_mi_mem_collect(&heap->tld->os);
+ }
+}
+
+void _mi_heap_collect_abandon(mi_heap_t* heap) {
+ mi_heap_collect_ex(heap, MI_ABANDON);
+}
+
+void mi_heap_collect(mi_heap_t* heap, bool force) mi_attr_noexcept {
+ mi_heap_collect_ex(heap, (force ? MI_FORCE : MI_NORMAL));
+}
+
+void mi_collect(bool force) mi_attr_noexcept {
+ mi_heap_collect(mi_get_default_heap(), force);
+}
+
+
+/* -----------------------------------------------------------
+ Heap new
+----------------------------------------------------------- */
+
+mi_heap_t* mi_heap_get_default(void) {
+ mi_thread_init();
+ return mi_get_default_heap();
+}
+
+mi_heap_t* mi_heap_get_backing(void) {
+ mi_heap_t* heap = mi_heap_get_default();
+ mi_assert_internal(heap!=NULL);
+ mi_heap_t* bheap = heap->tld->heap_backing;
+ mi_assert_internal(bheap!=NULL);
+ mi_assert_internal(bheap->thread_id == _mi_thread_id());
+ return bheap;
+}
+
+mi_heap_t* mi_heap_new(void) {
+ mi_heap_t* bheap = mi_heap_get_backing();
+ mi_heap_t* heap = mi_heap_malloc_tp(bheap, mi_heap_t); // todo: OS allocate in secure mode?
+ if (heap==NULL) return NULL;
+ _mi_memcpy_aligned(heap, &_mi_heap_empty, sizeof(mi_heap_t));
+ heap->tld = bheap->tld;
+ heap->thread_id = _mi_thread_id();
+ _mi_random_split(&bheap->random, &heap->random);
+ heap->cookie = _mi_heap_random_next(heap) | 1;
+ heap->keys[0] = _mi_heap_random_next(heap);
+ heap->keys[1] = _mi_heap_random_next(heap);
+ heap->no_reclaim = true; // don't reclaim abandoned pages or otherwise destroy is unsafe
+ // push on the thread local heaps list
+ heap->next = heap->tld->heaps;
+ heap->tld->heaps = heap;
+ return heap;
+}
+
+uintptr_t _mi_heap_random_next(mi_heap_t* heap) {
+ return _mi_random_next(&heap->random);
+}
+
+// zero out the page queues
+static void mi_heap_reset_pages(mi_heap_t* heap) {
+ mi_assert_internal(heap != NULL);
+ mi_assert_internal(mi_heap_is_initialized(heap));
+ // TODO: copy full empty heap instead?
+ memset(&heap->pages_free_direct, 0, sizeof(heap->pages_free_direct));
+#ifdef MI_MEDIUM_DIRECT
+ memset(&heap->pages_free_medium, 0, sizeof(heap->pages_free_medium));
+#endif
+ _mi_memcpy_aligned(&heap->pages, &_mi_heap_empty.pages, sizeof(heap->pages));
+ heap->thread_delayed_free = NULL;
+ heap->page_count = 0;
+}
+
+// called from `mi_heap_destroy` and `mi_heap_delete` to free the internal heap resources.
+static void mi_heap_free(mi_heap_t* heap) {
+ mi_assert(heap != NULL);
+ mi_assert_internal(mi_heap_is_initialized(heap));
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return;
+ if (mi_heap_is_backing(heap)) return; // dont free the backing heap
+
+ // reset default
+ if (mi_heap_is_default(heap)) {
+ _mi_heap_set_default_direct(heap->tld->heap_backing);
+ }
+
+ // remove ourselves from the thread local heaps list
+ // linear search but we expect the number of heaps to be relatively small
+ mi_heap_t* prev = NULL;
+ mi_heap_t* curr = heap->tld->heaps;
+ while (curr != heap && curr != NULL) {
+ prev = curr;
+ curr = curr->next;
+ }
+ mi_assert_internal(curr == heap);
+ if (curr == heap) {
+ if (prev != NULL) { prev->next = heap->next; }
+ else { heap->tld->heaps = heap->next; }
+ }
+ mi_assert_internal(heap->tld->heaps != NULL);
+
+ // and free the used memory
+ mi_free(heap);
+}
+
+
+/* -----------------------------------------------------------
+ Heap destroy
+----------------------------------------------------------- */
+
+static bool _mi_heap_page_destroy(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* arg1, void* arg2) {
+ MI_UNUSED(arg1);
+ MI_UNUSED(arg2);
+ MI_UNUSED(heap);
+ MI_UNUSED(pq);
+
+ // ensure no more thread_delayed_free will be added
+ _mi_page_use_delayed_free(page, MI_NEVER_DELAYED_FREE, false);
+
+ // stats
+ const size_t bsize = mi_page_block_size(page);
+ if (bsize > MI_MEDIUM_OBJ_SIZE_MAX) {
+ if (bsize <= MI_LARGE_OBJ_SIZE_MAX) {
+ mi_heap_stat_decrease(heap, large, bsize);
+ }
+ else {
+ mi_heap_stat_decrease(heap, huge, bsize);
+ }
+ }
+#if (MI_STAT)
+ _mi_page_free_collect(page, false); // update used count
+ const size_t inuse = page->used;
+ if (bsize <= MI_LARGE_OBJ_SIZE_MAX) {
+ mi_heap_stat_decrease(heap, normal, bsize * inuse);
+#if (MI_STAT>1)
+ mi_heap_stat_decrease(heap, normal_bins[_mi_bin(bsize)], inuse);
+#endif
+ }
+ mi_heap_stat_decrease(heap, malloc, bsize * inuse); // todo: off for aligned blocks...
+#endif
+
+ /// pretend it is all free now
+ mi_assert_internal(mi_page_thread_free(page) == NULL);
+ page->used = 0;
+
+ // and free the page
+ // mi_page_free(page,false);
+ page->next = NULL;
+ page->prev = NULL;
+ _mi_segment_page_free(page,false /* no force? */, &heap->tld->segments);
+
+ return true; // keep going
+}
+
+void _mi_heap_destroy_pages(mi_heap_t* heap) {
+ mi_heap_visit_pages(heap, &_mi_heap_page_destroy, NULL, NULL);
+ mi_heap_reset_pages(heap);
+}
+
+void mi_heap_destroy(mi_heap_t* heap) {
+ mi_assert(heap != NULL);
+ mi_assert(mi_heap_is_initialized(heap));
+ mi_assert(heap->no_reclaim);
+ mi_assert_expensive(mi_heap_is_valid(heap));
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return;
+ if (!heap->no_reclaim) {
+ // don't free in case it may contain reclaimed pages
+ mi_heap_delete(heap);
+ }
+ else {
+ // free all pages
+ _mi_heap_destroy_pages(heap);
+ mi_heap_free(heap);
+ }
+}
+
+
+
+/* -----------------------------------------------------------
+ Safe Heap delete
+----------------------------------------------------------- */
+
+// Transfer the pages from one heap to the other
+static void mi_heap_absorb(mi_heap_t* heap, mi_heap_t* from) {
+ mi_assert_internal(heap!=NULL);
+ if (from==NULL || from->page_count == 0) return;
+
+ // reduce the size of the delayed frees
+ _mi_heap_delayed_free(from);
+
+ // transfer all pages by appending the queues; this will set a new heap field
+ // so threads may do delayed frees in either heap for a while.
+ // note: appending waits for each page to not be in the `MI_DELAYED_FREEING` state
+ // so after this only the new heap will get delayed frees
+ for (size_t i = 0; i <= MI_BIN_FULL; i++) {
+ mi_page_queue_t* pq = &heap->pages[i];
+ mi_page_queue_t* append = &from->pages[i];
+ size_t pcount = _mi_page_queue_append(heap, pq, append);
+ heap->page_count += pcount;
+ from->page_count -= pcount;
+ }
+ mi_assert_internal(from->page_count == 0);
+
+ // and do outstanding delayed frees in the `from` heap
+ // note: be careful here as the `heap` field in all those pages no longer point to `from`,
+ // turns out to be ok as `_mi_heap_delayed_free` only visits the list and calls a
+ // the regular `_mi_free_delayed_block` which is safe.
+ _mi_heap_delayed_free(from);
+ #if !defined(_MSC_VER) || (_MSC_VER > 1900) // somehow the following line gives an error in VS2015, issue #353
+ mi_assert_internal(mi_atomic_load_ptr_relaxed(mi_block_t,&from->thread_delayed_free) == NULL);
+ #endif
+
+ // and reset the `from` heap
+ mi_heap_reset_pages(from);
+}
+
+// Safe delete a heap without freeing any still allocated blocks in that heap.
+void mi_heap_delete(mi_heap_t* heap)
+{
+ mi_assert(heap != NULL);
+ mi_assert(mi_heap_is_initialized(heap));
+ mi_assert_expensive(mi_heap_is_valid(heap));
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return;
+
+ if (!mi_heap_is_backing(heap)) {
+ // tranfer still used pages to the backing heap
+ mi_heap_absorb(heap->tld->heap_backing, heap);
+ }
+ else {
+ // the backing heap abandons its pages
+ _mi_heap_collect_abandon(heap);
+ }
+ mi_assert_internal(heap->page_count==0);
+ mi_heap_free(heap);
+}
+
+mi_heap_t* mi_heap_set_default(mi_heap_t* heap) {
+ mi_assert(heap != NULL);
+ mi_assert(mi_heap_is_initialized(heap));
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return NULL;
+ mi_assert_expensive(mi_heap_is_valid(heap));
+ mi_heap_t* old = mi_get_default_heap();
+ _mi_heap_set_default_direct(heap);
+ return old;
+}
+
+
+
+
+/* -----------------------------------------------------------
+ Analysis
+----------------------------------------------------------- */
+
+// static since it is not thread safe to access heaps from other threads.
+static mi_heap_t* mi_heap_of_block(const void* p) {
+ if (p == NULL) return NULL;
+ mi_segment_t* segment = _mi_ptr_segment(p);
+ bool valid = (_mi_ptr_cookie(segment) == segment->cookie);
+ mi_assert_internal(valid);
+ if (mi_unlikely(!valid)) return NULL;
+ return mi_page_heap(_mi_segment_page_of(segment,p));
+}
+
+bool mi_heap_contains_block(mi_heap_t* heap, const void* p) {
+ mi_assert(heap != NULL);
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return false;
+ return (heap == mi_heap_of_block(p));
+}
+
+
+static bool mi_heap_page_check_owned(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* p, void* vfound) {
+ MI_UNUSED(heap);
+ MI_UNUSED(pq);
+ bool* found = (bool*)vfound;
+ mi_segment_t* segment = _mi_page_segment(page);
+ void* start = _mi_page_start(segment, page, NULL);
+ void* end = (uint8_t*)start + (page->capacity * mi_page_block_size(page));
+ *found = (p >= start && p < end);
+ return (!*found); // continue if not found
+}
+
+bool mi_heap_check_owned(mi_heap_t* heap, const void* p) {
+ mi_assert(heap != NULL);
+ if (heap==NULL || !mi_heap_is_initialized(heap)) return false;
+ if (((uintptr_t)p & (MI_INTPTR_SIZE - 1)) != 0) return false; // only aligned pointers
+ bool found = false;
+ mi_heap_visit_pages(heap, &mi_heap_page_check_owned, (void*)p, &found);
+ return found;
+}
+
+bool mi_check_owned(const void* p) {
+ return mi_heap_check_owned(mi_get_default_heap(), p);
+}
+
+/* -----------------------------------------------------------
+ Visit all heap blocks and areas
+ Todo: enable visiting abandoned pages, and
+ enable visiting all blocks of all heaps across threads
+----------------------------------------------------------- */
+
+// Separate struct to keep `mi_page_t` out of the public interface
+typedef struct mi_heap_area_ex_s {
+ mi_heap_area_t area;
+ mi_page_t* page;
+} mi_heap_area_ex_t;
+
+static bool mi_heap_area_visit_blocks(const mi_heap_area_ex_t* xarea, mi_block_visit_fun* visitor, void* arg) {
+ mi_assert(xarea != NULL);
+ if (xarea==NULL) return true;
+ const mi_heap_area_t* area = &xarea->area;
+ mi_page_t* page = xarea->page;
+ mi_assert(page != NULL);
+ if (page == NULL) return true;
+
+ _mi_page_free_collect(page,true);
+ mi_assert_internal(page->local_free == NULL);
+ if (page->used == 0) return true;
+
+ const size_t bsize = mi_page_block_size(page);
+ const size_t ubsize = mi_page_usable_block_size(page); // without padding
+ size_t psize;
+ uint8_t* pstart = _mi_page_start(_mi_page_segment(page), page, &psize);
+
+ if (page->capacity == 1) {
+ // optimize page with one block
+ mi_assert_internal(page->used == 1 && page->free == NULL);
+ return visitor(mi_page_heap(page), area, pstart, ubsize, arg);
+ }
+
+ // create a bitmap of free blocks.
+ #define MI_MAX_BLOCKS (MI_SMALL_PAGE_SIZE / sizeof(void*))
+ uintptr_t free_map[MI_MAX_BLOCKS / sizeof(uintptr_t)];
+ memset(free_map, 0, sizeof(free_map));
+
+ size_t free_count = 0;
+ for (mi_block_t* block = page->free; block != NULL; block = mi_block_next(page,block)) {
+ free_count++;
+ mi_assert_internal((uint8_t*)block >= pstart && (uint8_t*)block < (pstart + psize));
+ size_t offset = (uint8_t*)block - pstart;
+ mi_assert_internal(offset % bsize == 0);
+ size_t blockidx = offset / bsize; // Todo: avoid division?
+ mi_assert_internal( blockidx < MI_MAX_BLOCKS);
+ size_t bitidx = (blockidx / sizeof(uintptr_t));
+ size_t bit = blockidx - (bitidx * sizeof(uintptr_t));
+ free_map[bitidx] |= ((uintptr_t)1 << bit);
+ }
+ mi_assert_internal(page->capacity == (free_count + page->used));
+
+ // walk through all blocks skipping the free ones
+ size_t used_count = 0;
+ for (size_t i = 0; i < page->capacity; i++) {
+ size_t bitidx = (i / sizeof(uintptr_t));
+ size_t bit = i - (bitidx * sizeof(uintptr_t));
+ uintptr_t m = free_map[bitidx];
+ if (bit == 0 && m == UINTPTR_MAX) {
+ i += (sizeof(uintptr_t) - 1); // skip a run of free blocks
+ }
+ else if ((m & ((uintptr_t)1 << bit)) == 0) {
+ used_count++;
+ uint8_t* block = pstart + (i * bsize);
+ if (!visitor(mi_page_heap(page), area, block, ubsize, arg)) return false;
+ }
+ }
+ mi_assert_internal(page->used == used_count);
+ return true;
+}
+
+typedef bool (mi_heap_area_visit_fun)(const mi_heap_t* heap, const mi_heap_area_ex_t* area, void* arg);
+
+
+static bool mi_heap_visit_areas_page(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_t* page, void* vfun, void* arg) {
+ MI_UNUSED(heap);
+ MI_UNUSED(pq);
+ mi_heap_area_visit_fun* fun = (mi_heap_area_visit_fun*)vfun;
+ mi_heap_area_ex_t xarea;
+ const size_t bsize = mi_page_block_size(page);
+ const size_t ubsize = mi_page_usable_block_size(page);
+ xarea.page = page;
+ xarea.area.reserved = page->reserved * bsize;
+ xarea.area.committed = page->capacity * bsize;
+ xarea.area.blocks = _mi_page_start(_mi_page_segment(page), page, NULL);
+ xarea.area.used = page->used * bsize;
+ xarea.area.block_size = ubsize;
+ xarea.area.full_block_size = bsize;
+ return fun(heap, &xarea, arg);
+}
+
+// Visit all heap pages as areas
+static bool mi_heap_visit_areas(const mi_heap_t* heap, mi_heap_area_visit_fun* visitor, void* arg) {
+ if (visitor == NULL) return false;
+ return mi_heap_visit_pages((mi_heap_t*)heap, &mi_heap_visit_areas_page, (void*)(visitor), arg); // note: function pointer to void* :-{
+}
+
+// Just to pass arguments
+typedef struct mi_visit_blocks_args_s {
+ bool visit_blocks;
+ mi_block_visit_fun* visitor;
+ void* arg;
+} mi_visit_blocks_args_t;
+
+static bool mi_heap_area_visitor(const mi_heap_t* heap, const mi_heap_area_ex_t* xarea, void* arg) {
+ mi_visit_blocks_args_t* args = (mi_visit_blocks_args_t*)arg;
+ if (!args->visitor(heap, &xarea->area, NULL, xarea->area.block_size, args->arg)) return false;
+ if (args->visit_blocks) {
+ return mi_heap_area_visit_blocks(xarea, args->visitor, args->arg);
+ }
+ else {
+ return true;
+ }
+}
+
+// Visit all blocks in a heap
+bool mi_heap_visit_blocks(const mi_heap_t* heap, bool visit_blocks, mi_block_visit_fun* visitor, void* arg) {
+ mi_visit_blocks_args_t args = { visit_blocks, visitor, arg };
+ return mi_heap_visit_areas(heap, &mi_heap_area_visitor, &args);
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/init.c b/source/luametatex/source/libraries/mimalloc/src/init.c
new file mode 100644
index 000000000..19124afef
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/init.c
@@ -0,0 +1,693 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2022, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+
+#include <string.h> // memcpy, memset
+#include <stdlib.h> // atexit
+
+// Empty page used to initialize the small free pages array
+const mi_page_t _mi_page_empty = {
+ 0, false, false, false, false,
+ 0, // capacity
+ 0, // reserved capacity
+ { 0 }, // flags
+ false, // is_zero
+ 0, // retire_expire
+ NULL, // free
+ #if MI_ENCODE_FREELIST
+ { 0, 0 },
+ #endif
+ 0, // used
+ 0, // xblock_size
+ NULL, // local_free
+ MI_ATOMIC_VAR_INIT(0), // xthread_free
+ MI_ATOMIC_VAR_INIT(0), // xheap
+ NULL, NULL
+ #if MI_INTPTR_SIZE==8
+ , { 0 } // padding
+ #endif
+};
+
+#define MI_PAGE_EMPTY() ((mi_page_t*)&_mi_page_empty)
+
+#if (MI_PADDING>0) && (MI_INTPTR_SIZE >= 8)
+#define MI_SMALL_PAGES_EMPTY { MI_INIT128(MI_PAGE_EMPTY), MI_PAGE_EMPTY(), MI_PAGE_EMPTY() }
+#elif (MI_PADDING>0)
+#define MI_SMALL_PAGES_EMPTY { MI_INIT128(MI_PAGE_EMPTY), MI_PAGE_EMPTY(), MI_PAGE_EMPTY(), MI_PAGE_EMPTY() }
+#else
+#define MI_SMALL_PAGES_EMPTY { MI_INIT128(MI_PAGE_EMPTY), MI_PAGE_EMPTY() }
+#endif
+
+
+// Empty page queues for every bin
+#define QNULL(sz) { NULL, NULL, (sz)*sizeof(uintptr_t) }
+#define MI_PAGE_QUEUES_EMPTY \
+ { QNULL(1), \
+ QNULL( 1), QNULL( 2), QNULL( 3), QNULL( 4), QNULL( 5), QNULL( 6), QNULL( 7), QNULL( 8), /* 8 */ \
+ QNULL( 10), QNULL( 12), QNULL( 14), QNULL( 16), QNULL( 20), QNULL( 24), QNULL( 28), QNULL( 32), /* 16 */ \
+ QNULL( 40), QNULL( 48), QNULL( 56), QNULL( 64), QNULL( 80), QNULL( 96), QNULL( 112), QNULL( 128), /* 24 */ \
+ QNULL( 160), QNULL( 192), QNULL( 224), QNULL( 256), QNULL( 320), QNULL( 384), QNULL( 448), QNULL( 512), /* 32 */ \
+ QNULL( 640), QNULL( 768), QNULL( 896), QNULL( 1024), QNULL( 1280), QNULL( 1536), QNULL( 1792), QNULL( 2048), /* 40 */ \
+ QNULL( 2560), QNULL( 3072), QNULL( 3584), QNULL( 4096), QNULL( 5120), QNULL( 6144), QNULL( 7168), QNULL( 8192), /* 48 */ \
+ QNULL( 10240), QNULL( 12288), QNULL( 14336), QNULL( 16384), QNULL( 20480), QNULL( 24576), QNULL( 28672), QNULL( 32768), /* 56 */ \
+ QNULL( 40960), QNULL( 49152), QNULL( 57344), QNULL( 65536), QNULL( 81920), QNULL( 98304), QNULL(114688), QNULL(131072), /* 64 */ \
+ QNULL(163840), QNULL(196608), QNULL(229376), QNULL(262144), QNULL(327680), QNULL(393216), QNULL(458752), QNULL(524288), /* 72 */ \
+ QNULL(MI_MEDIUM_OBJ_WSIZE_MAX + 1 /* 655360, Huge queue */), \
+ QNULL(MI_MEDIUM_OBJ_WSIZE_MAX + 2) /* Full queue */ }
+
+#define MI_STAT_COUNT_NULL() {0,0,0,0}
+
+// Empty statistics
+#if MI_STAT>1
+#define MI_STAT_COUNT_END_NULL() , { MI_STAT_COUNT_NULL(), MI_INIT32(MI_STAT_COUNT_NULL) }
+#else
+#define MI_STAT_COUNT_END_NULL()
+#endif
+
+#define MI_STATS_NULL \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ MI_STAT_COUNT_NULL(), MI_STAT_COUNT_NULL(), \
+ { 0, 0 }, { 0, 0 }, { 0, 0 }, { 0, 0 }, \
+ { 0, 0 }, { 0, 0 }, { 0, 0 }, { 0, 0 } \
+ MI_STAT_COUNT_END_NULL()
+
+
+// Empty slice span queues for every bin
+#define SQNULL(sz) { NULL, NULL, sz }
+#define MI_SEGMENT_SPAN_QUEUES_EMPTY \
+ { SQNULL(1), \
+ SQNULL( 1), SQNULL( 2), SQNULL( 3), SQNULL( 4), SQNULL( 5), SQNULL( 6), SQNULL( 7), SQNULL( 10), /* 8 */ \
+ SQNULL( 12), SQNULL( 14), SQNULL( 16), SQNULL( 20), SQNULL( 24), SQNULL( 28), SQNULL( 32), SQNULL( 40), /* 16 */ \
+ SQNULL( 48), SQNULL( 56), SQNULL( 64), SQNULL( 80), SQNULL( 96), SQNULL( 112), SQNULL( 128), SQNULL( 160), /* 24 */ \
+ SQNULL( 192), SQNULL( 224), SQNULL( 256), SQNULL( 320), SQNULL( 384), SQNULL( 448), SQNULL( 512), SQNULL( 640), /* 32 */ \
+ SQNULL( 768), SQNULL( 896), SQNULL( 1024) /* 35 */ }
+
+
+// --------------------------------------------------------
+// Statically allocate an empty heap as the initial
+// thread local value for the default heap,
+// and statically allocate the backing heap for the main
+// thread so it can function without doing any allocation
+// itself (as accessing a thread local for the first time
+// may lead to allocation itself on some platforms)
+// --------------------------------------------------------
+
+mi_decl_cache_align const mi_heap_t _mi_heap_empty = {
+ NULL,
+ MI_SMALL_PAGES_EMPTY,
+ MI_PAGE_QUEUES_EMPTY,
+ MI_ATOMIC_VAR_INIT(NULL),
+ 0, // tid
+ 0, // cookie
+ { 0, 0 }, // keys
+ { {0}, {0}, 0 },
+ 0, // page count
+ MI_BIN_FULL, 0, // page retired min/max
+ NULL, // next
+ false
+};
+
+#define tld_empty_stats ((mi_stats_t*)((uint8_t*)&tld_empty + offsetof(mi_tld_t,stats)))
+#define tld_empty_os ((mi_os_tld_t*)((uint8_t*)&tld_empty + offsetof(mi_tld_t,os)))
+
+mi_decl_cache_align static const mi_tld_t tld_empty = {
+ 0,
+ false,
+ NULL, NULL,
+ { MI_SEGMENT_SPAN_QUEUES_EMPTY, 0, 0, 0, 0, tld_empty_stats, tld_empty_os }, // segments
+ { 0, tld_empty_stats }, // os
+ { MI_STATS_NULL } // stats
+};
+
+// the thread-local default heap for allocation
+mi_decl_thread mi_heap_t* _mi_heap_default = (mi_heap_t*)&_mi_heap_empty;
+
+extern mi_heap_t _mi_heap_main;
+
+static mi_tld_t tld_main = {
+ 0, false,
+ &_mi_heap_main, & _mi_heap_main,
+ { MI_SEGMENT_SPAN_QUEUES_EMPTY, 0, 0, 0, 0, &tld_main.stats, &tld_main.os }, // segments
+ { 0, &tld_main.stats }, // os
+ { MI_STATS_NULL } // stats
+};
+
+mi_heap_t _mi_heap_main = {
+ &tld_main,
+ MI_SMALL_PAGES_EMPTY,
+ MI_PAGE_QUEUES_EMPTY,
+ MI_ATOMIC_VAR_INIT(NULL),
+ 0, // thread id
+ 0, // initial cookie
+ { 0, 0 }, // the key of the main heap can be fixed (unlike page keys that need to be secure!)
+ { {0x846ca68b}, {0}, 0 }, // random
+ 0, // page count
+ MI_BIN_FULL, 0, // page retired min/max
+ NULL, // next heap
+ false // can reclaim
+};
+
+bool _mi_process_is_initialized = false; // set to `true` in `mi_process_init`.
+
+mi_stats_t _mi_stats_main = { MI_STATS_NULL };
+
+
+static void mi_heap_main_init(void) {
+ if (_mi_heap_main.cookie == 0) {
+ _mi_heap_main.thread_id = _mi_thread_id();
+ _mi_heap_main.cookie = _mi_os_random_weak((uintptr_t)&mi_heap_main_init);
+ _mi_random_init(&_mi_heap_main.random);
+ _mi_heap_main.keys[0] = _mi_heap_random_next(&_mi_heap_main);
+ _mi_heap_main.keys[1] = _mi_heap_random_next(&_mi_heap_main);
+ }
+}
+
+mi_heap_t* _mi_heap_main_get(void) {
+ mi_heap_main_init();
+ return &_mi_heap_main;
+}
+
+
+/* -----------------------------------------------------------
+ Initialization and freeing of the thread local heaps
+----------------------------------------------------------- */
+
+// note: in x64 in release build `sizeof(mi_thread_data_t)` is under 4KiB (= OS page size).
+typedef struct mi_thread_data_s {
+ mi_heap_t heap; // must come first due to cast in `_mi_heap_done`
+ mi_tld_t tld;
+} mi_thread_data_t;
+
+
+// Thread meta-data is allocated directly from the OS. For
+// some programs that do not use thread pools and allocate and
+// destroy many OS threads, this may causes too much overhead
+// per thread so we maintain a small cache of recently freed metadata.
+
+#define TD_CACHE_SIZE (8)
+static _Atomic(mi_thread_data_t*) td_cache[TD_CACHE_SIZE];
+
+static mi_thread_data_t* mi_thread_data_alloc(void) {
+ // try to find thread metadata in the cache
+ mi_thread_data_t* td;
+ for (int i = 0; i < TD_CACHE_SIZE; i++) {
+ td = mi_atomic_load_ptr_relaxed(mi_thread_data_t, &td_cache[i]);
+ if (td != NULL) {
+ td = mi_atomic_exchange_ptr_acq_rel(mi_thread_data_t, &td_cache[i], NULL);
+ if (td != NULL) {
+ return td;
+ }
+ }
+ }
+ // if that fails, allocate directly from the OS
+ td = (mi_thread_data_t*)_mi_os_alloc(sizeof(mi_thread_data_t), &_mi_stats_main);
+ if (td == NULL) {
+ // if this fails, try once more. (issue #257)
+ td = (mi_thread_data_t*)_mi_os_alloc(sizeof(mi_thread_data_t), &_mi_stats_main);
+ if (td == NULL) {
+ // really out of memory
+ _mi_error_message(ENOMEM, "unable to allocate thread local heap metadata (%zu bytes)\n", sizeof(mi_thread_data_t));
+ }
+ }
+ return td;
+}
+
+static void mi_thread_data_free( mi_thread_data_t* tdfree ) {
+ // try to add the thread metadata to the cache
+ for (int i = 0; i < TD_CACHE_SIZE; i++) {
+ mi_thread_data_t* td = mi_atomic_load_ptr_relaxed(mi_thread_data_t, &td_cache[i]);
+ if (td == NULL) {
+ mi_thread_data_t* expected = NULL;
+ if (mi_atomic_cas_ptr_weak_acq_rel(mi_thread_data_t, &td_cache[i], &expected, tdfree)) {
+ return;
+ }
+ }
+ }
+ // if that fails, just free it directly
+ _mi_os_free(tdfree, sizeof(mi_thread_data_t), &_mi_stats_main);
+}
+
+static void mi_thread_data_collect(void) {
+ // free all thread metadata from the cache
+ for (int i = 0; i < TD_CACHE_SIZE; i++) {
+ mi_thread_data_t* td = mi_atomic_load_ptr_relaxed(mi_thread_data_t, &td_cache[i]);
+ if (td != NULL) {
+ td = mi_atomic_exchange_ptr_acq_rel(mi_thread_data_t, &td_cache[i], NULL);
+ if (td != NULL) {
+ _mi_os_free( td, sizeof(mi_thread_data_t), &_mi_stats_main );
+ }
+ }
+ }
+}
+
+// Initialize the thread local default heap, called from `mi_thread_init`
+static bool _mi_heap_init(void) {
+ if (mi_heap_is_initialized(mi_get_default_heap())) return true;
+ if (_mi_is_main_thread()) {
+ // mi_assert_internal(_mi_heap_main.thread_id != 0); // can happen on freeBSD where alloc is called before any initialization
+ // the main heap is statically allocated
+ mi_heap_main_init();
+ _mi_heap_set_default_direct(&_mi_heap_main);
+ //mi_assert_internal(_mi_heap_default->tld->heap_backing == mi_get_default_heap());
+ }
+ else {
+ // use `_mi_os_alloc` to allocate directly from the OS
+ mi_thread_data_t* td = mi_thread_data_alloc();
+ if (td == NULL) return false;
+
+ // OS allocated so already zero initialized
+ mi_tld_t* tld = &td->tld;
+ mi_heap_t* heap = &td->heap;
+ _mi_memcpy_aligned(tld, &tld_empty, sizeof(*tld));
+ _mi_memcpy_aligned(heap, &_mi_heap_empty, sizeof(*heap));
+ heap->thread_id = _mi_thread_id();
+ _mi_random_init(&heap->random);
+ heap->cookie = _mi_heap_random_next(heap) | 1;
+ heap->keys[0] = _mi_heap_random_next(heap);
+ heap->keys[1] = _mi_heap_random_next(heap);
+ heap->tld = tld;
+ tld->heap_backing = heap;
+ tld->heaps = heap;
+ tld->segments.stats = &tld->stats;
+ tld->segments.os = &tld->os;
+ tld->os.stats = &tld->stats;
+ _mi_heap_set_default_direct(heap);
+ }
+ return false;
+}
+
+// Free the thread local default heap (called from `mi_thread_done`)
+static bool _mi_heap_done(mi_heap_t* heap) {
+ if (!mi_heap_is_initialized(heap)) return true;
+
+ // reset default heap
+ _mi_heap_set_default_direct(_mi_is_main_thread() ? &_mi_heap_main : (mi_heap_t*)&_mi_heap_empty);
+
+ // switch to backing heap
+ heap = heap->tld->heap_backing;
+ if (!mi_heap_is_initialized(heap)) return false;
+
+ // delete all non-backing heaps in this thread
+ mi_heap_t* curr = heap->tld->heaps;
+ while (curr != NULL) {
+ mi_heap_t* next = curr->next; // save `next` as `curr` will be freed
+ if (curr != heap) {
+ mi_assert_internal(!mi_heap_is_backing(curr));
+ mi_heap_delete(curr);
+ }
+ curr = next;
+ }
+ mi_assert_internal(heap->tld->heaps == heap && heap->next == NULL);
+ mi_assert_internal(mi_heap_is_backing(heap));
+
+ // collect if not the main thread
+ if (heap != &_mi_heap_main) {
+ _mi_heap_collect_abandon(heap);
+ }
+
+ // merge stats
+ _mi_stats_done(&heap->tld->stats);
+
+ // free if not the main thread
+ if (heap != &_mi_heap_main) {
+ // the following assertion does not always hold for huge segments as those are always treated
+ // as abondened: one may allocate it in one thread, but deallocate in another in which case
+ // the count can be too large or negative. todo: perhaps not count huge segments? see issue #363
+ // mi_assert_internal(heap->tld->segments.count == 0 || heap->thread_id != _mi_thread_id());
+ mi_thread_data_free((mi_thread_data_t*)heap);
+ }
+ else {
+ mi_thread_data_collect(); // free cached thread metadata
+ #if 0
+ // never free the main thread even in debug mode; if a dll is linked statically with mimalloc,
+ // there may still be delete/free calls after the mi_fls_done is called. Issue #207
+ _mi_heap_destroy_pages(heap);
+ mi_assert_internal(heap->tld->heap_backing == &_mi_heap_main);
+ #endif
+ }
+ return false;
+}
+
+
+
+// --------------------------------------------------------
+// Try to run `mi_thread_done()` automatically so any memory
+// owned by the thread but not yet released can be abandoned
+// and re-owned by another thread.
+//
+// 1. windows dynamic library:
+// call from DllMain on DLL_THREAD_DETACH
+// 2. windows static library:
+// use `FlsAlloc` to call a destructor when the thread is done
+// 3. unix, pthreads:
+// use a pthread key to call a destructor when a pthread is done
+//
+// In the last two cases we also need to call `mi_process_init`
+// to set up the thread local keys.
+// --------------------------------------------------------
+
+static void _mi_thread_done(mi_heap_t* default_heap);
+
+#if defined(_WIN32) && defined(MI_SHARED_LIB)
+ // nothing to do as it is done in DllMain
+#elif defined(_WIN32) && !defined(MI_SHARED_LIB)
+ // use thread local storage keys to detect thread ending
+ #include <windows.h>
+ #include <fibersapi.h>
+ #if (_WIN32_WINNT < 0x600) // before Windows Vista
+ WINBASEAPI DWORD WINAPI FlsAlloc( _In_opt_ PFLS_CALLBACK_FUNCTION lpCallback );
+ WINBASEAPI PVOID WINAPI FlsGetValue( _In_ DWORD dwFlsIndex );
+ WINBASEAPI BOOL WINAPI FlsSetValue( _In_ DWORD dwFlsIndex, _In_opt_ PVOID lpFlsData );
+ WINBASEAPI BOOL WINAPI FlsFree(_In_ DWORD dwFlsIndex);
+ #endif
+ static DWORD mi_fls_key = (DWORD)(-1);
+ static void NTAPI mi_fls_done(PVOID value) {
+ if (value!=NULL) _mi_thread_done((mi_heap_t*)value);
+ }
+#elif defined(MI_USE_PTHREADS)
+ // use pthread local storage keys to detect thread ending
+ // (and used with MI_TLS_PTHREADS for the default heap)
+ pthread_key_t _mi_heap_default_key = (pthread_key_t)(-1);
+ static void mi_pthread_done(void* value) {
+ if (value!=NULL) _mi_thread_done((mi_heap_t*)value);
+ }
+#elif defined(__wasi__)
+// no pthreads in the WebAssembly Standard Interface
+#else
+ #pragma message("define a way to call mi_thread_done when a thread is done")
+#endif
+
+// Set up handlers so `mi_thread_done` is called automatically
+static void mi_process_setup_auto_thread_done(void) {
+ static bool tls_initialized = false; // fine if it races
+ if (tls_initialized) return;
+ tls_initialized = true;
+ #if defined(_WIN32) && defined(MI_SHARED_LIB)
+ // nothing to do as it is done in DllMain
+ #elif defined(_WIN32) && !defined(MI_SHARED_LIB)
+ mi_fls_key = FlsAlloc(&mi_fls_done);
+ #elif defined(MI_USE_PTHREADS)
+ mi_assert_internal(_mi_heap_default_key == (pthread_key_t)(-1));
+ pthread_key_create(&_mi_heap_default_key, &mi_pthread_done);
+ #endif
+ _mi_heap_set_default_direct(&_mi_heap_main);
+}
+
+
+bool _mi_is_main_thread(void) {
+ return (_mi_heap_main.thread_id==0 || _mi_heap_main.thread_id == _mi_thread_id());
+}
+
+static _Atomic(size_t) thread_count = MI_ATOMIC_VAR_INIT(1);
+
+size_t _mi_current_thread_count(void) {
+ return mi_atomic_load_relaxed(&thread_count);
+}
+
+// This is called from the `mi_malloc_generic`
+void mi_thread_init(void) mi_attr_noexcept
+{
+ // ensure our process has started already
+ mi_process_init();
+
+ // initialize the thread local default heap
+ // (this will call `_mi_heap_set_default_direct` and thus set the
+ // fiber/pthread key to a non-zero value, ensuring `_mi_thread_done` is called)
+ if (_mi_heap_init()) return; // returns true if already initialized
+
+ _mi_stat_increase(&_mi_stats_main.threads, 1);
+ mi_atomic_increment_relaxed(&thread_count);
+ //_mi_verbose_message("thread init: 0x%zx\n", _mi_thread_id());
+}
+
+void mi_thread_done(void) mi_attr_noexcept {
+ _mi_thread_done(mi_get_default_heap());
+}
+
+static void _mi_thread_done(mi_heap_t* heap) {
+ mi_atomic_decrement_relaxed(&thread_count);
+ _mi_stat_decrease(&_mi_stats_main.threads, 1);
+
+ // check thread-id as on Windows shutdown with FLS the main (exit) thread may call this on thread-local heaps...
+ if (heap->thread_id != _mi_thread_id()) return;
+
+ // abandon the thread local heap
+ if (_mi_heap_done(heap)) return; // returns true if already ran
+}
+
+void _mi_heap_set_default_direct(mi_heap_t* heap) {
+ mi_assert_internal(heap != NULL);
+ #if defined(MI_TLS_SLOT)
+ mi_tls_slot_set(MI_TLS_SLOT,heap);
+ #elif defined(MI_TLS_PTHREAD_SLOT_OFS)
+ *mi_tls_pthread_heap_slot() = heap;
+ #elif defined(MI_TLS_PTHREAD)
+ // we use _mi_heap_default_key
+ #else
+ _mi_heap_default = heap;
+ #endif
+
+ // ensure the default heap is passed to `_mi_thread_done`
+ // setting to a non-NULL value also ensures `mi_thread_done` is called.
+ #if defined(_WIN32) && defined(MI_SHARED_LIB)
+ // nothing to do as it is done in DllMain
+ #elif defined(_WIN32) && !defined(MI_SHARED_LIB)
+ mi_assert_internal(mi_fls_key != 0);
+ FlsSetValue(mi_fls_key, heap);
+ #elif defined(MI_USE_PTHREADS)
+ if (_mi_heap_default_key != (pthread_key_t)(-1)) { // can happen during recursive invocation on freeBSD
+ pthread_setspecific(_mi_heap_default_key, heap);
+ }
+ #endif
+}
+
+
+// --------------------------------------------------------
+// Run functions on process init/done, and thread init/done
+// --------------------------------------------------------
+static void mi_process_done(void);
+
+static bool os_preloading = true; // true until this module is initialized
+static bool mi_redirected = false; // true if malloc redirects to mi_malloc
+
+// Returns true if this module has not been initialized; Don't use C runtime routines until it returns false.
+bool _mi_preloading(void) {
+ return os_preloading;
+}
+
+mi_decl_nodiscard bool mi_is_redirected(void) mi_attr_noexcept {
+ return mi_redirected;
+}
+
+// Communicate with the redirection module on Windows
+#if defined(_WIN32) && defined(MI_SHARED_LIB)
+#ifdef __cplusplus
+extern "C" {
+#endif
+mi_decl_export void _mi_redirect_entry(DWORD reason) {
+ // called on redirection; careful as this may be called before DllMain
+ if (reason == DLL_PROCESS_ATTACH) {
+ mi_redirected = true;
+ }
+ else if (reason == DLL_PROCESS_DETACH) {
+ mi_redirected = false;
+ }
+ else if (reason == DLL_THREAD_DETACH) {
+ mi_thread_done();
+ }
+}
+__declspec(dllimport) bool mi_allocator_init(const char** message);
+__declspec(dllimport) void mi_allocator_done(void);
+#ifdef __cplusplus
+}
+#endif
+#else
+static bool mi_allocator_init(const char** message) {
+ if (message != NULL) *message = NULL;
+ return true;
+}
+static void mi_allocator_done(void) {
+ // nothing to do
+}
+#endif
+
+// Called once by the process loader
+static void mi_process_load(void) {
+ mi_heap_main_init();
+ #if defined(MI_TLS_RECURSE_GUARD)
+ volatile mi_heap_t* dummy = _mi_heap_default; // access TLS to allocate it before setting tls_initialized to true;
+ MI_UNUSED(dummy);
+ #endif
+ os_preloading = false;
+ #if !(defined(_WIN32) && defined(MI_SHARED_LIB)) // use Dll process detach (see below) instead of atexit (issue #521)
+ atexit(&mi_process_done);
+ #endif
+ _mi_options_init();
+ mi_process_init();
+ //mi_stats_reset();-
+ if (mi_redirected) _mi_verbose_message("malloc is redirected.\n");
+
+ // show message from the redirector (if present)
+ const char* msg = NULL;
+ mi_allocator_init(&msg);
+ if (msg != NULL && (mi_option_is_enabled(mi_option_verbose) || mi_option_is_enabled(mi_option_show_errors))) {
+ _mi_fputs(NULL,NULL,NULL,msg);
+ }
+}
+
+#if defined(_WIN32) && (defined(_M_IX86) || defined(_M_X64))
+#include <intrin.h>
+mi_decl_cache_align bool _mi_cpu_has_fsrm = false;
+
+static void mi_detect_cpu_features(void) {
+ // FSRM for fast rep movsb support (AMD Zen3+ (~2020) or Intel Ice Lake+ (~2017))
+ int32_t cpu_info[4];
+ __cpuid(cpu_info, 7);
+ _mi_cpu_has_fsrm = ((cpu_info[3] & (1 << 4)) != 0); // bit 4 of EDX : see <https ://en.wikipedia.org/wiki/CPUID#EAX=7,_ECX=0:_Extended_Features>
+}
+#else
+static void mi_detect_cpu_features(void) {
+ // nothing
+}
+#endif
+
+// Initialize the process; called by thread_init or the process loader
+void mi_process_init(void) mi_attr_noexcept {
+ // ensure we are called once
+ if (_mi_process_is_initialized) return;
+ _mi_verbose_message("process init: 0x%zx\n", _mi_thread_id());
+ _mi_process_is_initialized = true;
+ mi_process_setup_auto_thread_done();
+
+
+ mi_detect_cpu_features();
+ _mi_os_init();
+ mi_heap_main_init();
+ #if (MI_DEBUG)
+ _mi_verbose_message("debug level : %d\n", MI_DEBUG);
+ #endif
+ _mi_verbose_message("secure level: %d\n", MI_SECURE);
+ mi_thread_init();
+
+ #if defined(_WIN32) && !defined(MI_SHARED_LIB)
+ // When building as a static lib the FLS cleanup happens to early for the main thread.
+ // To avoid this, set the FLS value for the main thread to NULL so the fls cleanup
+ // will not call _mi_thread_done on the (still executing) main thread. See issue #508.
+ FlsSetValue(mi_fls_key, NULL);
+ #endif
+
+ mi_stats_reset(); // only call stat reset *after* thread init (or the heap tld == NULL)
+
+ if (mi_option_is_enabled(mi_option_reserve_huge_os_pages)) {
+ size_t pages = mi_option_get_clamp(mi_option_reserve_huge_os_pages, 0, 128*1024);
+ long reserve_at = mi_option_get(mi_option_reserve_huge_os_pages_at);
+ if (reserve_at != -1) {
+ mi_reserve_huge_os_pages_at(pages, reserve_at, pages*500);
+ } else {
+ mi_reserve_huge_os_pages_interleave(pages, 0, pages*500);
+ }
+ }
+ if (mi_option_is_enabled(mi_option_reserve_os_memory)) {
+ long ksize = mi_option_get(mi_option_reserve_os_memory);
+ if (ksize > 0) {
+ mi_reserve_os_memory((size_t)ksize*MI_KiB, true /* commit? */, true /* allow large pages? */);
+ }
+ }
+}
+
+// Called when the process is done (through `at_exit`)
+static void mi_process_done(void) {
+ // only shutdown if we were initialized
+ if (!_mi_process_is_initialized) return;
+ // ensure we are called once
+ static bool process_done = false;
+ if (process_done) return;
+ process_done = true;
+
+ #if defined(_WIN32) && !defined(MI_SHARED_LIB)
+ FlsFree(mi_fls_key); // call thread-done on all threads (except the main thread) to prevent dangling callback pointer if statically linked with a DLL; Issue #208
+ #endif
+
+ #ifndef MI_SKIP_COLLECT_ON_EXIT
+ #if (MI_DEBUG != 0) || !defined(MI_SHARED_LIB)
+ // free all memory if possible on process exit. This is not needed for a stand-alone process
+ // but should be done if mimalloc is statically linked into another shared library which
+ // is repeatedly loaded/unloaded, see issue #281.
+ mi_collect(true /* force */ );
+ #endif
+ #endif
+
+ if (mi_option_is_enabled(mi_option_show_stats) || mi_option_is_enabled(mi_option_verbose)) {
+ mi_stats_print(NULL);
+ }
+ mi_allocator_done();
+ _mi_verbose_message("process done: 0x%zx\n", _mi_heap_main.thread_id);
+ os_preloading = true; // don't call the C runtime anymore
+}
+
+
+
+#if defined(_WIN32) && defined(MI_SHARED_LIB)
+ // Windows DLL: easy to hook into process_init and thread_done
+ __declspec(dllexport) BOOL WINAPI DllMain(HINSTANCE inst, DWORD reason, LPVOID reserved) {
+ MI_UNUSED(reserved);
+ MI_UNUSED(inst);
+ if (reason==DLL_PROCESS_ATTACH) {
+ mi_process_load();
+ }
+ else if (reason==DLL_PROCESS_DETACH) {
+ mi_process_done();
+ }
+ else if (reason==DLL_THREAD_DETACH) {
+ if (!mi_is_redirected()) {
+ mi_thread_done();
+ }
+ }
+ return TRUE;
+ }
+
+#elif defined(_MSC_VER)
+ // MSVC: use data section magic for static libraries
+ // See <https://www.codeguru.com/cpp/misc/misc/applicationcontrol/article.php/c6945/Running-Code-Before-and-After-Main.htm>
+ static int _mi_process_init(void) {
+ mi_process_load();
+ return 0;
+ }
+ typedef int(*_mi_crt_callback_t)(void);
+ #if defined(_M_X64) || defined(_M_ARM64)
+ __pragma(comment(linker, "/include:" "_mi_msvc_initu"))
+ #pragma section(".CRT$XIU", long, read)
+ #else
+ __pragma(comment(linker, "/include:" "__mi_msvc_initu"))
+ #endif
+ #pragma data_seg(".CRT$XIU")
+ mi_decl_externc _mi_crt_callback_t _mi_msvc_initu[] = { &_mi_process_init };
+ #pragma data_seg()
+
+#elif defined(__cplusplus)
+ // C++: use static initialization to detect process start
+ static bool _mi_process_init(void) {
+ mi_process_load();
+ return (_mi_heap_main.thread_id != 0);
+ }
+ static bool mi_initialized = _mi_process_init();
+
+#elif defined(__GNUC__) || defined(__clang__)
+ // GCC,Clang: use the constructor attribute
+ static void __attribute__((constructor)) _mi_process_init(void) {
+ mi_process_load();
+ }
+
+#else
+#pragma message("define a way to call mi_process_load on your platform")
+#endif
diff --git a/source/luametatex/source/libraries/mimalloc/src/options.c b/source/luametatex/source/libraries/mimalloc/src/options.c
new file mode 100644
index 000000000..6b2379322
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/options.c
@@ -0,0 +1,627 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <stdio.h>
+#include <stdlib.h> // strtol
+#include <string.h> // strncpy, strncat, strlen, strstr
+#include <ctype.h> // toupper
+#include <stdarg.h>
+
+#ifdef _MSC_VER
+#pragma warning(disable:4996) // strncpy, strncat
+#endif
+
+
+static long mi_max_error_count = 16; // stop outputting errors after this (use < 0 for no limit)
+static long mi_max_warning_count = 16; // stop outputting warnings after this (use < 0 for no limit)
+
+static void mi_add_stderr_output(void);
+
+int mi_version(void) mi_attr_noexcept {
+ return MI_MALLOC_VERSION;
+}
+
+#ifdef _WIN32
+#include <conio.h>
+#endif
+
+// --------------------------------------------------------
+// Options
+// These can be accessed by multiple threads and may be
+// concurrently initialized, but an initializing data race
+// is ok since they resolve to the same value.
+// --------------------------------------------------------
+typedef enum mi_init_e {
+ UNINIT, // not yet initialized
+ DEFAULTED, // not found in the environment, use default value
+ INITIALIZED // found in environment or set explicitly
+} mi_init_t;
+
+typedef struct mi_option_desc_s {
+ long value; // the value
+ mi_init_t init; // is it initialized yet? (from the environment)
+ mi_option_t option; // for debugging: the option index should match the option
+ const char* name; // option name without `mimalloc_` prefix
+ const char* legacy_name; // potential legacy v1.x option name
+} mi_option_desc_t;
+
+#define MI_OPTION(opt) mi_option_##opt, #opt, NULL
+#define MI_OPTION_LEGACY(opt,legacy) mi_option_##opt, #opt, #legacy
+
+static mi_option_desc_t options[_mi_option_last] =
+{
+ // stable options
+ #if MI_DEBUG || defined(MI_SHOW_ERRORS)
+ { 1, UNINIT, MI_OPTION(show_errors) },
+ #else
+ { 0, UNINIT, MI_OPTION(show_errors) },
+ #endif
+ { 0, UNINIT, MI_OPTION(show_stats) },
+ { 0, UNINIT, MI_OPTION(verbose) },
+
+ // Some of the following options are experimental and not all combinations are valid. Use with care.
+ { 1, UNINIT, MI_OPTION(eager_commit) }, // commit per segment directly (8MiB) (but see also `eager_commit_delay`)
+ { 0, UNINIT, MI_OPTION(deprecated_eager_region_commit) },
+ { 0, UNINIT, MI_OPTION(deprecated_reset_decommits) },
+ { 0, UNINIT, MI_OPTION(large_os_pages) }, // use large OS pages, use only with eager commit to prevent fragmentation of VMA's
+ { 0, UNINIT, MI_OPTION(reserve_huge_os_pages) }, // per 1GiB huge pages
+ { -1, UNINIT, MI_OPTION(reserve_huge_os_pages_at) }, // reserve huge pages at node N
+ { 0, UNINIT, MI_OPTION(reserve_os_memory) },
+ { 0, UNINIT, MI_OPTION(deprecated_segment_cache) }, // cache N segments per thread
+ { 0, UNINIT, MI_OPTION(page_reset) }, // reset page memory on free
+ { 0, UNINIT, MI_OPTION_LEGACY(abandoned_page_decommit, abandoned_page_reset) },// decommit free page memory when a thread terminates
+ { 0, UNINIT, MI_OPTION(deprecated_segment_reset) },
+ #if defined(__NetBSD__)
+ { 0, UNINIT, MI_OPTION(eager_commit_delay) }, // the first N segments per thread are not eagerly committed
+ #elif defined(_WIN32)
+ { 4, UNINIT, MI_OPTION(eager_commit_delay) }, // the first N segments per thread are not eagerly committed (but per page in the segment on demand)
+ #else
+ { 1, UNINIT, MI_OPTION(eager_commit_delay) }, // the first N segments per thread are not eagerly committed (but per page in the segment on demand)
+ #endif
+ { 25, UNINIT, MI_OPTION_LEGACY(decommit_delay, reset_delay) }, // page decommit delay in milli-seconds
+ { 0, UNINIT, MI_OPTION(use_numa_nodes) }, // 0 = use available numa nodes, otherwise use at most N nodes.
+ { 0, UNINIT, MI_OPTION(limit_os_alloc) }, // 1 = do not use OS memory for allocation (but only reserved arenas)
+ { 100, UNINIT, MI_OPTION(os_tag) }, // only apple specific for now but might serve more or less related purpose
+ { 16, UNINIT, MI_OPTION(max_errors) }, // maximum errors that are output
+ { 16, UNINIT, MI_OPTION(max_warnings) }, // maximum warnings that are output
+ { 8, UNINIT, MI_OPTION(max_segment_reclaim)},// max. number of segment reclaims from the abandoned segments per try.
+ { 1, UNINIT, MI_OPTION(allow_decommit) }, // decommit slices when no longer used (after decommit_delay milli-seconds)
+ { 500, UNINIT, MI_OPTION(segment_decommit_delay) }, // decommit delay in milli-seconds for freed segments
+ { 2, UNINIT, MI_OPTION(decommit_extend_delay) }
+};
+
+static void mi_option_init(mi_option_desc_t* desc);
+
+void _mi_options_init(void) {
+ // called on process load; should not be called before the CRT is initialized!
+ // (e.g. do not call this from process_init as that may run before CRT initialization)
+ mi_add_stderr_output(); // now it safe to use stderr for output
+ for(int i = 0; i < _mi_option_last; i++ ) {
+ mi_option_t option = (mi_option_t)i;
+ long l = mi_option_get(option); MI_UNUSED(l); // initialize
+ if (option != mi_option_verbose) {
+ mi_option_desc_t* desc = &options[option];
+ _mi_verbose_message("option '%s': %ld\n", desc->name, desc->value);
+ }
+ }
+ mi_max_error_count = mi_option_get(mi_option_max_errors);
+ mi_max_warning_count = mi_option_get(mi_option_max_warnings);
+}
+
+mi_decl_nodiscard long mi_option_get(mi_option_t option) {
+ mi_assert(option >= 0 && option < _mi_option_last);
+ if (option < 0 || option >= _mi_option_last) return 0;
+ mi_option_desc_t* desc = &options[option];
+ mi_assert(desc->option == option); // index should match the option
+ if (mi_unlikely(desc->init == UNINIT)) {
+ mi_option_init(desc);
+ }
+ return desc->value;
+}
+
+mi_decl_nodiscard long mi_option_get_clamp(mi_option_t option, long min, long max) {
+ long x = mi_option_get(option);
+ return (x < min ? min : (x > max ? max : x));
+}
+
+void mi_option_set(mi_option_t option, long value) {
+ mi_assert(option >= 0 && option < _mi_option_last);
+ if (option < 0 || option >= _mi_option_last) return;
+ mi_option_desc_t* desc = &options[option];
+ mi_assert(desc->option == option); // index should match the option
+ desc->value = value;
+ desc->init = INITIALIZED;
+}
+
+void mi_option_set_default(mi_option_t option, long value) {
+ mi_assert(option >= 0 && option < _mi_option_last);
+ if (option < 0 || option >= _mi_option_last) return;
+ mi_option_desc_t* desc = &options[option];
+ if (desc->init != INITIALIZED) {
+ desc->value = value;
+ }
+}
+
+mi_decl_nodiscard bool mi_option_is_enabled(mi_option_t option) {
+ return (mi_option_get(option) != 0);
+}
+
+void mi_option_set_enabled(mi_option_t option, bool enable) {
+ mi_option_set(option, (enable ? 1 : 0));
+}
+
+void mi_option_set_enabled_default(mi_option_t option, bool enable) {
+ mi_option_set_default(option, (enable ? 1 : 0));
+}
+
+void mi_option_enable(mi_option_t option) {
+ mi_option_set_enabled(option,true);
+}
+
+void mi_option_disable(mi_option_t option) {
+ mi_option_set_enabled(option,false);
+}
+
+
+static void mi_out_stderr(const char* msg, void* arg) {
+ MI_UNUSED(arg);
+ if (msg == NULL) return;
+ #ifdef _WIN32
+ // on windows with redirection, the C runtime cannot handle locale dependent output
+ // after the main thread closes so we use direct console output.
+ if (!_mi_preloading()) {
+ // _cputs(msg); // _cputs cannot be used at is aborts if it fails to lock the console
+ static HANDLE hcon = INVALID_HANDLE_VALUE;
+ if (hcon == INVALID_HANDLE_VALUE) {
+ hcon = GetStdHandle(STD_ERROR_HANDLE);
+ }
+ const size_t len = strlen(msg);
+ if (hcon != INVALID_HANDLE_VALUE && len > 0 && len < UINT32_MAX) {
+ DWORD written = 0;
+ WriteConsoleA(hcon, msg, (DWORD)len, &written, NULL);
+ }
+ }
+ #else
+ fputs(msg, stderr);
+ #endif
+}
+
+// Since an output function can be registered earliest in the `main`
+// function we also buffer output that happens earlier. When
+// an output function is registered it is called immediately with
+// the output up to that point.
+#ifndef MI_MAX_DELAY_OUTPUT
+#define MI_MAX_DELAY_OUTPUT ((size_t)(32*1024))
+#endif
+static char out_buf[MI_MAX_DELAY_OUTPUT+1];
+static _Atomic(size_t) out_len;
+
+static void mi_out_buf(const char* msg, void* arg) {
+ MI_UNUSED(arg);
+ if (msg==NULL) return;
+ if (mi_atomic_load_relaxed(&out_len)>=MI_MAX_DELAY_OUTPUT) return;
+ size_t n = strlen(msg);
+ if (n==0) return;
+ // claim space
+ size_t start = mi_atomic_add_acq_rel(&out_len, n);
+ if (start >= MI_MAX_DELAY_OUTPUT) return;
+ // check bound
+ if (start+n >= MI_MAX_DELAY_OUTPUT) {
+ n = MI_MAX_DELAY_OUTPUT-start-1;
+ }
+ _mi_memcpy(&out_buf[start], msg, n);
+}
+
+static void mi_out_buf_flush(mi_output_fun* out, bool no_more_buf, void* arg) {
+ if (out==NULL) return;
+ // claim (if `no_more_buf == true`, no more output will be added after this point)
+ size_t count = mi_atomic_add_acq_rel(&out_len, (no_more_buf ? MI_MAX_DELAY_OUTPUT : 1));
+ // and output the current contents
+ if (count>MI_MAX_DELAY_OUTPUT) count = MI_MAX_DELAY_OUTPUT;
+ out_buf[count] = 0;
+ out(out_buf,arg);
+ if (!no_more_buf) {
+ out_buf[count] = '\n'; // if continue with the buffer, insert a newline
+ }
+}
+
+
+// Once this module is loaded, switch to this routine
+// which outputs to stderr and the delayed output buffer.
+static void mi_out_buf_stderr(const char* msg, void* arg) {
+ mi_out_stderr(msg,arg);
+ mi_out_buf(msg,arg);
+}
+
+
+
+// --------------------------------------------------------
+// Default output handler
+// --------------------------------------------------------
+
+// Should be atomic but gives errors on many platforms as generally we cannot cast a function pointer to a uintptr_t.
+// For now, don't register output from multiple threads.
+static mi_output_fun* volatile mi_out_default; // = NULL
+static _Atomic(void*) mi_out_arg; // = NULL
+
+static mi_output_fun* mi_out_get_default(void** parg) {
+ if (parg != NULL) { *parg = mi_atomic_load_ptr_acquire(void,&mi_out_arg); }
+ mi_output_fun* out = mi_out_default;
+ return (out == NULL ? &mi_out_buf : out);
+}
+
+void mi_register_output(mi_output_fun* out, void* arg) mi_attr_noexcept {
+ mi_out_default = (out == NULL ? &mi_out_stderr : out); // stop using the delayed output buffer
+ mi_atomic_store_ptr_release(void,&mi_out_arg, arg);
+ if (out!=NULL) mi_out_buf_flush(out,true,arg); // output all the delayed output now
+}
+
+// add stderr to the delayed output after the module is loaded
+static void mi_add_stderr_output() {
+ mi_assert_internal(mi_out_default == NULL);
+ mi_out_buf_flush(&mi_out_stderr, false, NULL); // flush current contents to stderr
+ mi_out_default = &mi_out_buf_stderr; // and add stderr to the delayed output
+}
+
+// --------------------------------------------------------
+// Messages, all end up calling `_mi_fputs`.
+// --------------------------------------------------------
+static _Atomic(size_t) error_count; // = 0; // when >= max_error_count stop emitting errors
+static _Atomic(size_t) warning_count; // = 0; // when >= max_warning_count stop emitting warnings
+
+// When overriding malloc, we may recurse into mi_vfprintf if an allocation
+// inside the C runtime causes another message.
+// In some cases (like on macOS) the loader already allocates which
+// calls into mimalloc; if we then access thread locals (like `recurse`)
+// this may crash as the access may call _tlv_bootstrap that tries to
+// (recursively) invoke malloc again to allocate space for the thread local
+// variables on demand. This is why we use a _mi_preloading test on such
+// platforms. However, C code generator may move the initial thread local address
+// load before the `if` and we therefore split it out in a separate funcion.
+static mi_decl_thread bool recurse = false;
+
+static mi_decl_noinline bool mi_recurse_enter_prim(void) {
+ if (recurse) return false;
+ recurse = true;
+ return true;
+}
+
+static mi_decl_noinline void mi_recurse_exit_prim(void) {
+ recurse = false;
+}
+
+static bool mi_recurse_enter(void) {
+ #if defined(__APPLE__) || defined(MI_TLS_RECURSE_GUARD)
+ if (_mi_preloading()) return true;
+ #endif
+ return mi_recurse_enter_prim();
+}
+
+static void mi_recurse_exit(void) {
+ #if defined(__APPLE__) || defined(MI_TLS_RECURSE_GUARD)
+ if (_mi_preloading()) return;
+ #endif
+ mi_recurse_exit_prim();
+}
+
+void _mi_fputs(mi_output_fun* out, void* arg, const char* prefix, const char* message) {
+ if (out==NULL || (FILE*)out==stdout || (FILE*)out==stderr) { // TODO: use mi_out_stderr for stderr?
+ if (!mi_recurse_enter()) return;
+ out = mi_out_get_default(&arg);
+ if (prefix != NULL) out(prefix, arg);
+ out(message, arg);
+ mi_recurse_exit();
+ }
+ else {
+ if (prefix != NULL) out(prefix, arg);
+ out(message, arg);
+ }
+}
+
+// Define our own limited `fprintf` that avoids memory allocation.
+// We do this using `snprintf` with a limited buffer.
+static void mi_vfprintf( mi_output_fun* out, void* arg, const char* prefix, const char* fmt, va_list args ) {
+ char buf[512];
+ if (fmt==NULL) return;
+ if (!mi_recurse_enter()) return;
+ vsnprintf(buf,sizeof(buf)-1,fmt,args);
+ mi_recurse_exit();
+ _mi_fputs(out,arg,prefix,buf);
+}
+
+void _mi_fprintf( mi_output_fun* out, void* arg, const char* fmt, ... ) {
+ va_list args;
+ va_start(args,fmt);
+ mi_vfprintf(out,arg,NULL,fmt,args);
+ va_end(args);
+}
+
+static void mi_vfprintf_thread(mi_output_fun* out, void* arg, const char* prefix, const char* fmt, va_list args) {
+ if (prefix != NULL && strlen(prefix) <= 32 && !_mi_is_main_thread()) {
+ char tprefix[64];
+ snprintf(tprefix, sizeof(tprefix), "%sthread 0x%x: ", prefix, (unsigned) _mi_thread_id()); /* HH: %z is unknown */
+ mi_vfprintf(out, arg, tprefix, fmt, args);
+ }
+ else {
+ mi_vfprintf(out, arg, prefix, fmt, args);
+ }
+}
+
+void _mi_trace_message(const char* fmt, ...) {
+ if (mi_option_get(mi_option_verbose) <= 1) return; // only with verbose level 2 or higher
+ va_list args;
+ va_start(args, fmt);
+ mi_vfprintf_thread(NULL, NULL, "mimalloc: ", fmt, args);
+ va_end(args);
+}
+
+void _mi_verbose_message(const char* fmt, ...) {
+ if (!mi_option_is_enabled(mi_option_verbose)) return;
+ va_list args;
+ va_start(args,fmt);
+ mi_vfprintf(NULL, NULL, "mimalloc: ", fmt, args);
+ va_end(args);
+}
+
+static void mi_show_error_message(const char* fmt, va_list args) {
+ if (!mi_option_is_enabled(mi_option_verbose)) {
+ if (!mi_option_is_enabled(mi_option_show_errors)) return;
+ if (mi_max_error_count >= 0 && (long)mi_atomic_increment_acq_rel(&error_count) > mi_max_error_count) return;
+ }
+ mi_vfprintf_thread(NULL, NULL, "mimalloc: error: ", fmt, args);
+}
+
+void _mi_warning_message(const char* fmt, ...) {
+ if (!mi_option_is_enabled(mi_option_verbose)) {
+ if (!mi_option_is_enabled(mi_option_show_errors)) return;
+ if (mi_max_warning_count >= 0 && (long)mi_atomic_increment_acq_rel(&warning_count) > mi_max_warning_count) return;
+ }
+ va_list args;
+ va_start(args,fmt);
+ mi_vfprintf_thread(NULL, NULL, "mimalloc: warning: ", fmt, args);
+ va_end(args);
+}
+
+
+#if MI_DEBUG
+void _mi_assert_fail(const char* assertion, const char* fname, unsigned line, const char* func ) {
+ _mi_fprintf(NULL, NULL, "mimalloc: assertion failed: at \"%s\":%u, %s\n assertion: \"%s\"\n", fname, line, (func==NULL?"":func), assertion);
+ abort();
+}
+#endif
+
+// --------------------------------------------------------
+// Errors
+// --------------------------------------------------------
+
+static mi_error_fun* volatile mi_error_handler; // = NULL
+static _Atomic(void*) mi_error_arg; // = NULL
+
+static void mi_error_default(int err) {
+ MI_UNUSED(err);
+#if (MI_DEBUG>0)
+ if (err==EFAULT) {
+ #ifdef _MSC_VER
+ __debugbreak();
+ #endif
+ abort();
+ }
+#endif
+#if (MI_SECURE>0)
+ if (err==EFAULT) { // abort on serious errors in secure mode (corrupted meta-data)
+ abort();
+ }
+#endif
+#if defined(MI_XMALLOC)
+ if (err==ENOMEM || err==EOVERFLOW) { // abort on memory allocation fails in xmalloc mode
+ abort();
+ }
+#endif
+}
+
+void mi_register_error(mi_error_fun* fun, void* arg) {
+ mi_error_handler = fun; // can be NULL
+ mi_atomic_store_ptr_release(void,&mi_error_arg, arg);
+}
+
+void _mi_error_message(int err, const char* fmt, ...) {
+ // show detailed error message
+ va_list args;
+ va_start(args, fmt);
+ mi_show_error_message(fmt, args);
+ va_end(args);
+ // and call the error handler which may abort (or return normally)
+ if (mi_error_handler != NULL) {
+ mi_error_handler(err, mi_atomic_load_ptr_acquire(void,&mi_error_arg));
+ }
+ else {
+ mi_error_default(err);
+ }
+}
+
+// --------------------------------------------------------
+// Initialize options by checking the environment
+// --------------------------------------------------------
+
+static void mi_strlcpy(char* dest, const char* src, size_t dest_size) {
+ if (dest==NULL || src==NULL || dest_size == 0) return;
+ // copy until end of src, or when dest is (almost) full
+ while (*src != 0 && dest_size > 1) {
+ *dest++ = *src++;
+ dest_size--;
+ }
+ // always zero terminate
+ *dest = 0;
+}
+
+static void mi_strlcat(char* dest, const char* src, size_t dest_size) {
+ if (dest==NULL || src==NULL || dest_size == 0) return;
+ // find end of string in the dest buffer
+ while (*dest != 0 && dest_size > 1) {
+ dest++;
+ dest_size--;
+ }
+ // and catenate
+ mi_strlcpy(dest, src, dest_size);
+}
+
+#ifdef MI_NO_GETENV
+static bool mi_getenv(const char* name, char* result, size_t result_size) {
+ MI_UNUSED(name);
+ MI_UNUSED(result);
+ MI_UNUSED(result_size);
+ return false;
+}
+#else
+static inline int mi_strnicmp(const char* s, const char* t, size_t n) {
+ if (n==0) return 0;
+ for (; *s != 0 && *t != 0 && n > 0; s++, t++, n--) {
+ if (toupper(*s) != toupper(*t)) break;
+ }
+ return (n==0 ? 0 : *s - *t);
+}
+#if defined _WIN32
+// On Windows use GetEnvironmentVariable instead of getenv to work
+// reliably even when this is invoked before the C runtime is initialized.
+// i.e. when `_mi_preloading() == true`.
+// Note: on windows, environment names are not case sensitive.
+#include <windows.h>
+static bool mi_getenv(const char* name, char* result, size_t result_size) {
+ result[0] = 0;
+ size_t len = GetEnvironmentVariableA(name, result, (DWORD)result_size);
+ return (len > 0 && len < result_size);
+}
+#elif !defined(MI_USE_ENVIRON) || (MI_USE_ENVIRON!=0)
+// On Posix systemsr use `environ` to acces environment variables
+// even before the C runtime is initialized.
+#if defined(__APPLE__) && defined(__has_include) && __has_include(<crt_externs.h>)
+#include <crt_externs.h>
+static char** mi_get_environ(void) {
+ return (*_NSGetEnviron());
+}
+#else
+extern char** environ;
+static char** mi_get_environ(void) {
+ return environ;
+}
+#endif
+static bool mi_getenv(const char* name, char* result, size_t result_size) {
+ if (name==NULL) return false;
+ const size_t len = strlen(name);
+ if (len == 0) return false;
+ char** env = mi_get_environ();
+ if (env == NULL) return false;
+ // compare up to 256 entries
+ for (int i = 0; i < 256 && env[i] != NULL; i++) {
+ const char* s = env[i];
+ if (mi_strnicmp(name, s, len) == 0 && s[len] == '=') { // case insensitive
+ // found it
+ mi_strlcpy(result, s + len + 1, result_size);
+ return true;
+ }
+ }
+ return false;
+}
+#else
+// fallback: use standard C `getenv` but this cannot be used while initializing the C runtime
+static bool mi_getenv(const char* name, char* result, size_t result_size) {
+ // cannot call getenv() when still initializing the C runtime.
+ if (_mi_preloading()) return false;
+ const char* s = getenv(name);
+ if (s == NULL) {
+ // we check the upper case name too.
+ char buf[64+1];
+ size_t len = strlen(name);
+ if (len >= sizeof(buf)) len = sizeof(buf) - 1;
+ for (size_t i = 0; i < len; i++) {
+ buf[i] = toupper(name[i]);
+ }
+ buf[len] = 0;
+ s = getenv(buf);
+ }
+ if (s != NULL && strlen(s) < result_size) {
+ mi_strlcpy(result, s, result_size);
+ return true;
+ }
+ else {
+ return false;
+ }
+}
+#endif // !MI_USE_ENVIRON
+#endif // !MI_NO_GETENV
+
+static void mi_option_init(mi_option_desc_t* desc) {
+ // Read option value from the environment
+ char s[64+1];
+ char buf[64+1];
+ mi_strlcpy(buf, "mimalloc_", sizeof(buf));
+ mi_strlcat(buf, desc->name, sizeof(buf));
+ bool found = mi_getenv(buf,s,sizeof(s));
+ if (!found && desc->legacy_name != NULL) {
+ mi_strlcpy(buf, "mimalloc_", sizeof(buf));
+ mi_strlcat(buf, desc->legacy_name, sizeof(buf));
+ found = mi_getenv(buf,s,sizeof(s));
+ if (found) {
+ _mi_warning_message("environment option \"mimalloc_%s\" is deprecated -- use \"mimalloc_%s\" instead.\n", desc->legacy_name, desc->name );
+ }
+ }
+
+ if (found) {
+ size_t len = strlen(s);
+ if (len >= sizeof(buf)) len = sizeof(buf) - 1;
+ for (size_t i = 0; i < len; i++) {
+ buf[i] = (char)toupper(s[i]);
+ }
+ buf[len] = 0;
+ if (buf[0]==0 || strstr("1;TRUE;YES;ON", buf) != NULL) {
+ desc->value = 1;
+ desc->init = INITIALIZED;
+ }
+ else if (strstr("0;FALSE;NO;OFF", buf) != NULL) {
+ desc->value = 0;
+ desc->init = INITIALIZED;
+ }
+ else {
+ char* end = buf;
+ long value = strtol(buf, &end, 10);
+ if (desc->option == mi_option_reserve_os_memory) {
+ // this option is interpreted in KiB to prevent overflow of `long`
+ if (*end == 'K') { end++; }
+ else if (*end == 'M') { value *= MI_KiB; end++; }
+ else if (*end == 'G') { value *= MI_MiB; end++; }
+ else { value = (value + MI_KiB - 1) / MI_KiB; }
+ if (end[0] == 'I' && end[1] == 'B') { end += 2; }
+ else if (*end == 'B') { end++; }
+ }
+ if (*end == 0) {
+ desc->value = value;
+ desc->init = INITIALIZED;
+ }
+ else {
+ // set `init` first to avoid recursion through _mi_warning_message on mimalloc_verbose.
+ desc->init = DEFAULTED;
+ if (desc->option == mi_option_verbose && desc->value == 0) {
+ // if the 'mimalloc_verbose' env var has a bogus value we'd never know
+ // (since the value defaults to 'off') so in that case briefly enable verbose
+ desc->value = 1;
+ _mi_warning_message("environment option mimalloc_%s has an invalid value.\n", desc->name );
+ desc->value = 0;
+ }
+ else {
+ _mi_warning_message("environment option mimalloc_%s has an invalid value.\n", desc->name );
+ }
+ }
+ }
+ mi_assert_internal(desc->init != UNINIT);
+ }
+ else if (!_mi_preloading()) {
+ desc->init = DEFAULTED;
+ }
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/os.c b/source/luametatex/source/libraries/mimalloc/src/os.c
new file mode 100644
index 000000000..72959d818
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/os.c
@@ -0,0 +1,1443 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#ifndef _DEFAULT_SOURCE
+#define _DEFAULT_SOURCE // ensure mmap flags are defined
+#endif
+
+#if defined(__sun)
+// illumos provides new mman.h api when any of these are defined
+// otherwise the old api based on caddr_t which predates the void pointers one.
+// stock solaris provides only the former, chose to atomically to discard those
+// flags only here rather than project wide tough.
+#undef _XOPEN_SOURCE
+#undef _POSIX_C_SOURCE
+#endif
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <string.h> // strerror
+
+#ifdef _MSC_VER
+#pragma warning(disable:4996) // strerror
+#endif
+
+#if defined(__wasi__)
+#define MI_USE_SBRK
+#endif
+
+#if defined(_WIN32)
+#include <windows.h>
+#elif defined(__wasi__)
+#include <unistd.h> // sbrk
+#else
+#include <sys/mman.h> // mmap
+#include <unistd.h> // sysconf
+#if defined(__linux__)
+#include <features.h>
+#include <fcntl.h>
+#if defined(__GLIBC__)
+#include <linux/mman.h> // linux mmap flags
+#else
+#include <sys/mman.h>
+#endif
+#endif
+#if defined(__APPLE__)
+#include <TargetConditionals.h>
+#if !TARGET_IOS_IPHONE && !TARGET_IOS_SIMULATOR
+#include <mach/vm_statistics.h>
+#endif
+#endif
+#if defined(__FreeBSD__) || defined(__DragonFly__)
+#include <sys/param.h>
+#if __FreeBSD_version >= 1200000
+#include <sys/cpuset.h>
+#include <sys/domainset.h>
+#endif
+#include <sys/sysctl.h>
+#endif
+#endif
+
+/* -----------------------------------------------------------
+ Initialization.
+ On windows initializes support for aligned allocation and
+ large OS pages (if MIMALLOC_LARGE_OS_PAGES is true).
+----------------------------------------------------------- */
+bool _mi_os_decommit(void* addr, size_t size, mi_stats_t* stats);
+bool _mi_os_commit(void* addr, size_t size, bool* is_zero, mi_stats_t* tld_stats);
+
+static void* mi_align_up_ptr(void* p, size_t alignment) {
+ return (void*)_mi_align_up((uintptr_t)p, alignment);
+}
+
+static void* mi_align_down_ptr(void* p, size_t alignment) {
+ return (void*)_mi_align_down((uintptr_t)p, alignment);
+}
+
+
+// page size (initialized properly in `os_init`)
+static size_t os_page_size = 4096;
+
+// minimal allocation granularity
+static size_t os_alloc_granularity = 4096;
+
+// if non-zero, use large page allocation
+static size_t large_os_page_size = 0;
+
+// is memory overcommit allowed?
+// set dynamically in _mi_os_init (and if true we use MAP_NORESERVE)
+static bool os_overcommit = true;
+
+bool _mi_os_has_overcommit(void) {
+ return os_overcommit;
+}
+
+// OS (small) page size
+size_t _mi_os_page_size(void) {
+ return os_page_size;
+}
+
+// if large OS pages are supported (2 or 4MiB), then return the size, otherwise return the small page size (4KiB)
+size_t _mi_os_large_page_size(void) {
+ return (large_os_page_size != 0 ? large_os_page_size : _mi_os_page_size());
+}
+
+#if !defined(MI_USE_SBRK) && !defined(__wasi__)
+static bool use_large_os_page(size_t size, size_t alignment) {
+ // if we have access, check the size and alignment requirements
+ if (large_os_page_size == 0 || !mi_option_is_enabled(mi_option_large_os_pages)) return false;
+ return ((size % large_os_page_size) == 0 && (alignment % large_os_page_size) == 0);
+}
+#endif
+
+// round to a good OS allocation size (bounded by max 12.5% waste)
+size_t _mi_os_good_alloc_size(size_t size) {
+ size_t align_size;
+ if (size < 512*MI_KiB) align_size = _mi_os_page_size();
+ else if (size < 2*MI_MiB) align_size = 64*MI_KiB;
+ else if (size < 8*MI_MiB) align_size = 256*MI_KiB;
+ else if (size < 32*MI_MiB) align_size = 1*MI_MiB;
+ else align_size = 4*MI_MiB;
+ if (mi_unlikely(size >= (SIZE_MAX - align_size))) return size; // possible overflow?
+ return _mi_align_up(size, align_size);
+}
+
+#if defined(_WIN32)
+// We use VirtualAlloc2 for aligned allocation, but it is only supported on Windows 10 and Windows Server 2016.
+// So, we need to look it up dynamically to run on older systems. (use __stdcall for 32-bit compatibility)
+// NtAllocateVirtualAllocEx is used for huge OS page allocation (1GiB)
+// We define a minimal MEM_EXTENDED_PARAMETER ourselves in order to be able to compile with older SDK's.
+typedef enum MI_MEM_EXTENDED_PARAMETER_TYPE_E {
+ MiMemExtendedParameterInvalidType = 0,
+ MiMemExtendedParameterAddressRequirements,
+ MiMemExtendedParameterNumaNode,
+ MiMemExtendedParameterPartitionHandle,
+ MiMemExtendedParameterUserPhysicalHandle,
+ MiMemExtendedParameterAttributeFlags,
+ MiMemExtendedParameterMax
+} MI_MEM_EXTENDED_PARAMETER_TYPE;
+
+typedef struct DECLSPEC_ALIGN(8) MI_MEM_EXTENDED_PARAMETER_S {
+ struct { DWORD64 Type : 8; DWORD64 Reserved : 56; } Type;
+ union { DWORD64 ULong64; PVOID Pointer; SIZE_T Size; HANDLE Handle; DWORD ULong; } Arg;
+} MI_MEM_EXTENDED_PARAMETER;
+
+typedef struct MI_MEM_ADDRESS_REQUIREMENTS_S {
+ PVOID LowestStartingAddress;
+ PVOID HighestEndingAddress;
+ SIZE_T Alignment;
+} MI_MEM_ADDRESS_REQUIREMENTS;
+
+#define MI_MEM_EXTENDED_PARAMETER_NONPAGED_HUGE 0x00000010
+
+#include <winternl.h>
+typedef PVOID (__stdcall *PVirtualAlloc2)(HANDLE, PVOID, SIZE_T, ULONG, ULONG, MI_MEM_EXTENDED_PARAMETER*, ULONG);
+typedef NTSTATUS (__stdcall *PNtAllocateVirtualMemoryEx)(HANDLE, PVOID*, SIZE_T*, ULONG, ULONG, MI_MEM_EXTENDED_PARAMETER*, ULONG);
+static PVirtualAlloc2 pVirtualAlloc2 = NULL;
+static PNtAllocateVirtualMemoryEx pNtAllocateVirtualMemoryEx = NULL;
+
+// Similarly, GetNumaProcesorNodeEx is only supported since Windows 7
+typedef struct MI_PROCESSOR_NUMBER_S { WORD Group; BYTE Number; BYTE Reserved; } MI_PROCESSOR_NUMBER;
+
+typedef VOID (__stdcall *PGetCurrentProcessorNumberEx)(MI_PROCESSOR_NUMBER* ProcNumber);
+typedef BOOL (__stdcall *PGetNumaProcessorNodeEx)(MI_PROCESSOR_NUMBER* Processor, PUSHORT NodeNumber);
+typedef BOOL (__stdcall* PGetNumaNodeProcessorMaskEx)(USHORT Node, PGROUP_AFFINITY ProcessorMask);
+static PGetCurrentProcessorNumberEx pGetCurrentProcessorNumberEx = NULL;
+static PGetNumaProcessorNodeEx pGetNumaProcessorNodeEx = NULL;
+static PGetNumaNodeProcessorMaskEx pGetNumaNodeProcessorMaskEx = NULL;
+
+static bool mi_win_enable_large_os_pages(void)
+{
+ if (large_os_page_size > 0) return true;
+
+ // Try to see if large OS pages are supported
+ // To use large pages on Windows, we first need access permission
+ // Set "Lock pages in memory" permission in the group policy editor
+ // <https://devblogs.microsoft.com/oldnewthing/20110128-00/?p=11643>
+ unsigned long err = 0;
+ HANDLE token = NULL;
+ BOOL ok = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY, &token);
+ if (ok) {
+ TOKEN_PRIVILEGES tp;
+ ok = LookupPrivilegeValue(NULL, TEXT("SeLockMemoryPrivilege"), &tp.Privileges[0].Luid);
+ if (ok) {
+ tp.PrivilegeCount = 1;
+ tp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
+ ok = AdjustTokenPrivileges(token, FALSE, &tp, 0, (PTOKEN_PRIVILEGES)NULL, 0);
+ if (ok) {
+ err = GetLastError();
+ ok = (err == ERROR_SUCCESS);
+ if (ok) {
+ large_os_page_size = GetLargePageMinimum();
+ }
+ }
+ }
+ CloseHandle(token);
+ }
+ if (!ok) {
+ if (err == 0) err = GetLastError();
+ _mi_warning_message("cannot enable large OS page support, error %lu\n", err);
+ }
+ return (ok!=0);
+}
+
+void _mi_os_init(void)
+{
+ os_overcommit = false;
+ // get the page size
+ SYSTEM_INFO si;
+ GetSystemInfo(&si);
+ if (si.dwPageSize > 0) os_page_size = si.dwPageSize;
+ if (si.dwAllocationGranularity > 0) os_alloc_granularity = si.dwAllocationGranularity;
+ // get the VirtualAlloc2 function
+ HINSTANCE hDll;
+ hDll = LoadLibrary(TEXT("kernelbase.dll"));
+ if (hDll != NULL) {
+ // use VirtualAlloc2FromApp if possible as it is available to Windows store apps
+ pVirtualAlloc2 = (PVirtualAlloc2)(void (*)(void))GetProcAddress(hDll, "VirtualAlloc2FromApp");
+ if (pVirtualAlloc2==NULL) pVirtualAlloc2 = (PVirtualAlloc2)(void (*)(void))GetProcAddress(hDll, "VirtualAlloc2");
+ FreeLibrary(hDll);
+ }
+ // NtAllocateVirtualMemoryEx is used for huge page allocation
+ hDll = LoadLibrary(TEXT("ntdll.dll"));
+ if (hDll != NULL) {
+ pNtAllocateVirtualMemoryEx = (PNtAllocateVirtualMemoryEx)(void (*)(void))GetProcAddress(hDll, "NtAllocateVirtualMemoryEx");
+ FreeLibrary(hDll);
+ }
+ // Try to use Win7+ numa API
+ hDll = LoadLibrary(TEXT("kernel32.dll"));
+ if (hDll != NULL) {
+ pGetCurrentProcessorNumberEx = (PGetCurrentProcessorNumberEx)(void (*)(void))GetProcAddress(hDll, "GetCurrentProcessorNumberEx");
+ pGetNumaProcessorNodeEx = (PGetNumaProcessorNodeEx)(void (*)(void))GetProcAddress(hDll, "GetNumaProcessorNodeEx");
+ pGetNumaNodeProcessorMaskEx = (PGetNumaNodeProcessorMaskEx)(void (*)(void))GetProcAddress(hDll, "GetNumaNodeProcessorMaskEx");
+ FreeLibrary(hDll);
+ }
+ if (mi_option_is_enabled(mi_option_large_os_pages) || mi_option_is_enabled(mi_option_reserve_huge_os_pages)) {
+ mi_win_enable_large_os_pages();
+ }
+}
+#elif defined(__wasi__)
+void _mi_os_init(void) {
+ os_overcommit = false;
+ os_page_size = 64*MI_KiB; // WebAssembly has a fixed page size: 64KiB
+ os_alloc_granularity = 16;
+}
+
+#else // generic unix
+
+static void os_detect_overcommit(void) {
+#if defined(__linux__)
+ int fd = open("/proc/sys/vm/overcommit_memory", O_RDONLY);
+ if (fd < 0) return;
+ char buf[32];
+ ssize_t nread = read(fd, &buf, sizeof(buf));
+ close(fd);
+ // <https://www.kernel.org/doc/Documentation/vm/overcommit-accounting>
+ // 0: heuristic overcommit, 1: always overcommit, 2: never overcommit (ignore NORESERVE)
+ if (nread >= 1) {
+ os_overcommit = (buf[0] == '0' || buf[0] == '1');
+ }
+#elif defined(__FreeBSD__)
+ int val = 0;
+ size_t olen = sizeof(val);
+ if (sysctlbyname("vm.overcommit", &val, &olen, NULL, 0) == 0) {
+ os_overcommit = (val != 0);
+ }
+#else
+ // default: overcommit is true
+#endif
+}
+
+void _mi_os_init(void) {
+ // get the page size
+ long result = sysconf(_SC_PAGESIZE);
+ if (result > 0) {
+ os_page_size = (size_t)result;
+ os_alloc_granularity = os_page_size;
+ }
+ large_os_page_size = 2*MI_MiB; // TODO: can we query the OS for this?
+ os_detect_overcommit();
+}
+#endif
+
+
+#if defined(MADV_NORMAL)
+static int mi_madvise(void* addr, size_t length, int advice) {
+ #if defined(__sun)
+ return madvise((caddr_t)addr, length, advice); // Solaris needs cast (issue #520)
+ #else
+ return madvise(addr, length, advice);
+ #endif
+}
+#endif
+
+
+/* -----------------------------------------------------------
+ aligned hinting
+-------------------------------------------------------------- */
+
+// On 64-bit systems, we can do efficient aligned allocation by using
+// the 2TiB to 30TiB area to allocate those.
+#if (MI_INTPTR_SIZE >= 8)
+static mi_decl_cache_align _Atomic(uintptr_t)aligned_base;
+
+// Return a MI_SEGMENT_SIZE aligned address that is probably available.
+// If this returns NULL, the OS will determine the address but on some OS's that may not be
+// properly aligned which can be more costly as it needs to be adjusted afterwards.
+// For a size > 1GiB this always returns NULL in order to guarantee good ASLR randomization;
+// (otherwise an initial large allocation of say 2TiB has a 50% chance to include (known) addresses
+// in the middle of the 2TiB - 6TiB address range (see issue #372))
+
+#define MI_HINT_BASE ((uintptr_t)2 << 40) // 2TiB start
+#define MI_HINT_AREA ((uintptr_t)4 << 40) // upto 6TiB (since before win8 there is "only" 8TiB available to processes)
+#define MI_HINT_MAX ((uintptr_t)30 << 40) // wrap after 30TiB (area after 32TiB is used for huge OS pages)
+
+static void* mi_os_get_aligned_hint(size_t try_alignment, size_t size)
+{
+ if (try_alignment <= 1 || try_alignment > MI_SEGMENT_SIZE) return NULL;
+ size = _mi_align_up(size, MI_SEGMENT_SIZE);
+ if (size > 1*MI_GiB) return NULL; // guarantee the chance of fixed valid address is at most 1/(MI_HINT_AREA / 1<<30) = 1/4096.
+ #if (MI_SECURE>0)
+ size += MI_SEGMENT_SIZE; // put in `MI_SEGMENT_SIZE` virtual gaps between hinted blocks; this splits VLA's but increases guarded areas.
+ #endif
+
+ uintptr_t hint = mi_atomic_add_acq_rel(&aligned_base, size);
+ if (hint == 0 || hint > MI_HINT_MAX) { // wrap or initialize
+ uintptr_t init = MI_HINT_BASE;
+ #if (MI_SECURE>0 || MI_DEBUG==0) // security: randomize start of aligned allocations unless in debug mode
+ uintptr_t r = _mi_heap_random_next(mi_get_default_heap());
+ init = init + ((MI_SEGMENT_SIZE * ((r>>17) & 0xFFFFF)) % MI_HINT_AREA); // (randomly 20 bits)*4MiB == 0 to 4TiB
+ #endif
+ uintptr_t expected = hint + size;
+ mi_atomic_cas_strong_acq_rel(&aligned_base, &expected, init);
+ hint = mi_atomic_add_acq_rel(&aligned_base, size); // this may still give 0 or > MI_HINT_MAX but that is ok, it is a hint after all
+ }
+ if (hint%try_alignment != 0) return NULL;
+ return (void*)hint;
+}
+#else
+static void* mi_os_get_aligned_hint(size_t try_alignment, size_t size) {
+ MI_UNUSED(try_alignment); MI_UNUSED(size);
+ return NULL;
+}
+#endif
+
+/* -----------------------------------------------------------
+ Free memory
+-------------------------------------------------------------- */
+
+static bool mi_os_mem_free(void* addr, size_t size, bool was_committed, mi_stats_t* stats)
+{
+ if (addr == NULL || size == 0) return true; // || _mi_os_is_huge_reserved(addr)
+ bool err = false;
+#if defined(_WIN32)
+ DWORD errcode = 0;
+ err = (VirtualFree(addr, 0, MEM_RELEASE) == 0);
+ if (err) { errcode = GetLastError(); }
+ if (errcode == ERROR_INVALID_ADDRESS) {
+ // In mi_os_mem_alloc_aligned the fallback path may have returned a pointer inside
+ // the memory region returned by VirtualAlloc; in that case we need to free using
+ // the start of the region.
+ MEMORY_BASIC_INFORMATION info = { 0, 0 };
+ VirtualQuery(addr, &info, sizeof(info));
+ if (info.AllocationBase < addr && ((uint8_t*)addr - (uint8_t*)info.AllocationBase) < MI_SEGMENT_SIZE) {
+ errcode = 0;
+ err = (VirtualFree(info.AllocationBase, 0, MEM_RELEASE) == 0);
+ if (err) { errcode = GetLastError(); }
+ }
+ }
+ if (errcode != 0) {
+ _mi_warning_message("unable to release OS memory: error code 0x%x, addr: %p, size: %zu\n", errcode, addr, size);
+ }
+#elif defined(MI_USE_SBRK) || defined(__wasi__)
+ err = false; // sbrk heap cannot be shrunk
+#else
+ err = (munmap(addr, size) == -1);
+ if (err) {
+ _mi_warning_message("unable to release OS memory: %s, addr: %p, size: %zu\n", strerror(errno), addr, size);
+ }
+#endif
+ if (was_committed) { _mi_stat_decrease(&stats->committed, size); }
+ _mi_stat_decrease(&stats->reserved, size);
+ return !err;
+}
+
+
+/* -----------------------------------------------------------
+ Raw allocation on Windows (VirtualAlloc)
+-------------------------------------------------------------- */
+
+#ifdef _WIN32
+
+#define MEM_COMMIT_RESERVE (MEM_COMMIT|MEM_RESERVE)
+
+static void* mi_win_virtual_allocx(void* addr, size_t size, size_t try_alignment, DWORD flags) {
+#if (MI_INTPTR_SIZE >= 8)
+ // on 64-bit systems, try to use the virtual address area after 2TiB for 4MiB aligned allocations
+ if (addr == NULL) {
+ void* hint = mi_os_get_aligned_hint(try_alignment,size);
+ if (hint != NULL) {
+ void* p = VirtualAlloc(hint, size, flags, PAGE_READWRITE);
+ if (p != NULL) return p;
+ _mi_verbose_message("warning: unable to allocate hinted aligned OS memory (%zu bytes, error code: 0x%x, address: %p, alignment: %zu, flags: 0x%x)\n", size, GetLastError(), hint, try_alignment, flags);
+ // fall through on error
+ }
+ }
+#endif
+ // on modern Windows try use VirtualAlloc2 for aligned allocation
+ if (try_alignment > 1 && (try_alignment % _mi_os_page_size()) == 0 && pVirtualAlloc2 != NULL) {
+ MI_MEM_ADDRESS_REQUIREMENTS reqs = { 0, 0, 0 };
+ reqs.Alignment = try_alignment;
+ MI_MEM_EXTENDED_PARAMETER param = { {0, 0}, {0} };
+ param.Type.Type = MiMemExtendedParameterAddressRequirements;
+ param.Arg.Pointer = &reqs;
+ void* p = (*pVirtualAlloc2)(GetCurrentProcess(), addr, size, flags, PAGE_READWRITE, &param, 1);
+ if (p != NULL) return p;
+ _mi_warning_message("unable to allocate aligned OS memory (%zu bytes, error code: 0x%x, address: %p, alignment: %zu, flags: 0x%x)\n", size, GetLastError(), addr, try_alignment, flags);
+ // fall through on error
+ }
+ // last resort
+ return VirtualAlloc(addr, size, flags, PAGE_READWRITE);
+}
+
+static void* mi_win_virtual_alloc(void* addr, size_t size, size_t try_alignment, DWORD flags, bool large_only, bool allow_large, bool* is_large) {
+ mi_assert_internal(!(large_only && !allow_large));
+ static _Atomic(size_t) large_page_try_ok; // = 0;
+ void* p = NULL;
+ // Try to allocate large OS pages (2MiB) if allowed or required.
+ if ((large_only || use_large_os_page(size, try_alignment))
+ && allow_large && (flags&MEM_COMMIT)!=0 && (flags&MEM_RESERVE)!=0) {
+ size_t try_ok = mi_atomic_load_acquire(&large_page_try_ok);
+ if (!large_only && try_ok > 0) {
+ // if a large page allocation fails, it seems the calls to VirtualAlloc get very expensive.
+ // therefore, once a large page allocation failed, we don't try again for `large_page_try_ok` times.
+ mi_atomic_cas_strong_acq_rel(&large_page_try_ok, &try_ok, try_ok - 1);
+ }
+ else {
+ // large OS pages must always reserve and commit.
+ *is_large = true;
+ p = mi_win_virtual_allocx(addr, size, try_alignment, flags | MEM_LARGE_PAGES);
+ if (large_only) return p;
+ // fall back to non-large page allocation on error (`p == NULL`).
+ if (p == NULL) {
+ mi_atomic_store_release(&large_page_try_ok,10UL); // on error, don't try again for the next N allocations
+ }
+ }
+ }
+ // Fall back to regular page allocation
+ if (p == NULL) {
+ *is_large = ((flags&MEM_LARGE_PAGES) != 0);
+ p = mi_win_virtual_allocx(addr, size, try_alignment, flags);
+ }
+ if (p == NULL) {
+ _mi_warning_message("unable to allocate OS memory (%zu bytes, error code: 0x%x, address: %p, alignment: %zu, flags: 0x%x, large only: %d, allow large: %d)\n", size, GetLastError(), addr, try_alignment, flags, large_only, allow_large);
+ }
+ return p;
+}
+
+/* -----------------------------------------------------------
+ Raw allocation using `sbrk` or `wasm_memory_grow`
+-------------------------------------------------------------- */
+
+#elif defined(MI_USE_SBRK) || defined(__wasi__)
+#if defined(MI_USE_SBRK)
+ static void* mi_memory_grow( size_t size ) {
+ void* p = sbrk(size);
+ if (p == (void*)(-1)) return NULL;
+ #if !defined(__wasi__) // on wasi this is always zero initialized already (?)
+ memset(p,0,size);
+ #endif
+ return p;
+ }
+#elif defined(__wasi__)
+ static void* mi_memory_grow( size_t size ) {
+ size_t base = (size > 0 ? __builtin_wasm_memory_grow(0,_mi_divide_up(size, _mi_os_page_size()))
+ : __builtin_wasm_memory_size(0));
+ if (base == SIZE_MAX) return NULL;
+ return (void*)(base * _mi_os_page_size());
+ }
+#endif
+
+#if defined(MI_USE_PTHREADS)
+static pthread_mutex_t mi_heap_grow_mutex = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+static void* mi_heap_grow(size_t size, size_t try_alignment) {
+ void* p = NULL;
+ if (try_alignment <= 1) {
+ // `sbrk` is not thread safe in general so try to protect it (we could skip this on WASM but leave it in for now)
+ #if defined(MI_USE_PTHREADS)
+ pthread_mutex_lock(&mi_heap_grow_mutex);
+ #endif
+ p = mi_memory_grow(size);
+ #if defined(MI_USE_PTHREADS)
+ pthread_mutex_unlock(&mi_heap_grow_mutex);
+ #endif
+ }
+ else {
+ void* base = NULL;
+ size_t alloc_size = 0;
+ // to allocate aligned use a lock to try to avoid thread interaction
+ // between getting the current size and actual allocation
+ // (also, `sbrk` is not thread safe in general)
+ #if defined(MI_USE_PTHREADS)
+ pthread_mutex_lock(&mi_heap_grow_mutex);
+ #endif
+ {
+ void* current = mi_memory_grow(0); // get current size
+ if (current != NULL) {
+ void* aligned_current = mi_align_up_ptr(current, try_alignment); // and align from there to minimize wasted space
+ alloc_size = _mi_align_up( ((uint8_t*)aligned_current - (uint8_t*)current) + size, _mi_os_page_size());
+ base = mi_memory_grow(alloc_size);
+ }
+ }
+ #if defined(MI_USE_PTHREADS)
+ pthread_mutex_unlock(&mi_heap_grow_mutex);
+ #endif
+ if (base != NULL) {
+ p = mi_align_up_ptr(base, try_alignment);
+ if ((uint8_t*)p + size > (uint8_t*)base + alloc_size) {
+ // another thread used wasm_memory_grow/sbrk in-between and we do not have enough
+ // space after alignment. Give up (and waste the space as we cannot shrink :-( )
+ // (in `mi_os_mem_alloc_aligned` this will fall back to overallocation to align)
+ p = NULL;
+ }
+ }
+ }
+ if (p == NULL) {
+ _mi_warning_message("unable to allocate sbrk/wasm_memory_grow OS memory (%zu bytes, %zu alignment)\n", size, try_alignment);
+ errno = ENOMEM;
+ return NULL;
+ }
+ mi_assert_internal( try_alignment == 0 || (uintptr_t)p % try_alignment == 0 );
+ return p;
+}
+
+/* -----------------------------------------------------------
+ Raw allocation on Unix's (mmap)
+-------------------------------------------------------------- */
+#else
+#define MI_OS_USE_MMAP
+static void* mi_unix_mmapx(void* addr, size_t size, size_t try_alignment, int protect_flags, int flags, int fd) {
+ MI_UNUSED(try_alignment);
+ #if defined(MAP_ALIGNED) // BSD
+ if (addr == NULL && try_alignment > 1 && (try_alignment % _mi_os_page_size()) == 0) {
+ size_t n = mi_bsr(try_alignment);
+ if (((size_t)1 << n) == try_alignment && n >= 12 && n <= 30) { // alignment is a power of 2 and 4096 <= alignment <= 1GiB
+ flags |= MAP_ALIGNED(n);
+ void* p = mmap(addr, size, protect_flags, flags | MAP_ALIGNED(n), fd, 0);
+ if (p!=MAP_FAILED) return p;
+ // fall back to regular mmap
+ }
+ }
+ #elif defined(MAP_ALIGN) // Solaris
+ if (addr == NULL && try_alignment > 1 && (try_alignment % _mi_os_page_size()) == 0) {
+ void* p = mmap((void*)try_alignment, size, protect_flags, flags | MAP_ALIGN, fd, 0); // addr parameter is the required alignment
+ if (p!=MAP_FAILED) return p;
+ // fall back to regular mmap
+ }
+ #endif
+ #if (MI_INTPTR_SIZE >= 8) && !defined(MAP_ALIGNED)
+ // on 64-bit systems, use the virtual address area after 2TiB for 4MiB aligned allocations
+ if (addr == NULL) {
+ void* hint = mi_os_get_aligned_hint(try_alignment, size);
+ if (hint != NULL) {
+ void* p = mmap(hint, size, protect_flags, flags, fd, 0);
+ if (p!=MAP_FAILED) return p;
+ // fall back to regular mmap
+ }
+ }
+ #endif
+ // regular mmap
+ void* p = mmap(addr, size, protect_flags, flags, fd, 0);
+ if (p!=MAP_FAILED) return p;
+ // failed to allocate
+ return NULL;
+}
+
+static int mi_unix_mmap_fd(void) {
+#if defined(VM_MAKE_TAG)
+ // macOS: tracking anonymous page with a specific ID. (All up to 98 are taken officially but LLVM sanitizers had taken 99)
+ int os_tag = (int)mi_option_get(mi_option_os_tag);
+ if (os_tag < 100 || os_tag > 255) os_tag = 100;
+ return VM_MAKE_TAG(os_tag);
+#else
+ return -1;
+#endif
+}
+
+static void* mi_unix_mmap(void* addr, size_t size, size_t try_alignment, int protect_flags, bool large_only, bool allow_large, bool* is_large) {
+ void* p = NULL;
+ #if !defined(MAP_ANONYMOUS)
+ #define MAP_ANONYMOUS MAP_ANON
+ #endif
+ #if !defined(MAP_NORESERVE)
+ #define MAP_NORESERVE 0
+ #endif
+ const int fd = mi_unix_mmap_fd();
+ int flags = MAP_PRIVATE | MAP_ANONYMOUS;
+ if (_mi_os_has_overcommit()) {
+ flags |= MAP_NORESERVE;
+ }
+ #if defined(PROT_MAX)
+ protect_flags |= PROT_MAX(PROT_READ | PROT_WRITE); // BSD
+ #endif
+ // huge page allocation
+ if ((large_only || use_large_os_page(size, try_alignment)) && allow_large) {
+ static _Atomic(size_t) large_page_try_ok; // = 0;
+ size_t try_ok = mi_atomic_load_acquire(&large_page_try_ok);
+ if (!large_only && try_ok > 0) {
+ // If the OS is not configured for large OS pages, or the user does not have
+ // enough permission, the `mmap` will always fail (but it might also fail for other reasons).
+ // Therefore, once a large page allocation failed, we don't try again for `large_page_try_ok` times
+ // to avoid too many failing calls to mmap.
+ mi_atomic_cas_strong_acq_rel(&large_page_try_ok, &try_ok, try_ok - 1);
+ }
+ else {
+ int lflags = flags & ~MAP_NORESERVE; // using NORESERVE on huge pages seems to fail on Linux
+ int lfd = fd;
+ #ifdef MAP_ALIGNED_SUPER
+ lflags |= MAP_ALIGNED_SUPER;
+ #endif
+ #ifdef MAP_HUGETLB
+ lflags |= MAP_HUGETLB;
+ #endif
+ #ifdef MAP_HUGE_1GB
+ static bool mi_huge_pages_available = true;
+ if ((size % MI_GiB) == 0 && mi_huge_pages_available) {
+ lflags |= MAP_HUGE_1GB;
+ }
+ else
+ #endif
+ {
+ #ifdef MAP_HUGE_2MB
+ lflags |= MAP_HUGE_2MB;
+ #endif
+ }
+ #ifdef VM_FLAGS_SUPERPAGE_SIZE_2MB
+ lfd |= VM_FLAGS_SUPERPAGE_SIZE_2MB;
+ #endif
+ if (large_only || lflags != flags) {
+ // try large OS page allocation
+ *is_large = true;
+ p = mi_unix_mmapx(addr, size, try_alignment, protect_flags, lflags, lfd);
+ #ifdef MAP_HUGE_1GB
+ if (p == NULL && (lflags & MAP_HUGE_1GB) != 0) {
+ mi_huge_pages_available = false; // don't try huge 1GiB pages again
+ _mi_warning_message("unable to allocate huge (1GiB) page, trying large (2MiB) pages instead (error %i)\n", errno);
+ lflags = ((lflags & ~MAP_HUGE_1GB) | MAP_HUGE_2MB);
+ p = mi_unix_mmapx(addr, size, try_alignment, protect_flags, lflags, lfd);
+ }
+ #endif
+ if (large_only) return p;
+ if (p == NULL) {
+ mi_atomic_store_release(&large_page_try_ok, (size_t)8); // on error, don't try again for the next N allocations
+ }
+ }
+ }
+ }
+ // regular allocation
+ if (p == NULL) {
+ *is_large = false;
+ p = mi_unix_mmapx(addr, size, try_alignment, protect_flags, flags, fd);
+ if (p != NULL) {
+ #if defined(MADV_HUGEPAGE)
+ // Many Linux systems don't allow MAP_HUGETLB but they support instead
+ // transparent huge pages (THP). Generally, it is not required to call `madvise` with MADV_HUGE
+ // though since properly aligned allocations will already use large pages if available
+ // in that case -- in particular for our large regions (in `memory.c`).
+ // However, some systems only allow THP if called with explicit `madvise`, so
+ // when large OS pages are enabled for mimalloc, we call `madvise` anyways.
+ if (allow_large && use_large_os_page(size, try_alignment)) {
+ if (mi_madvise(p, size, MADV_HUGEPAGE) == 0) {
+ *is_large = true; // possibly
+ };
+ }
+ #elif defined(__sun)
+ if (allow_large && use_large_os_page(size, try_alignment)) {
+ struct memcntl_mha cmd = {0};
+ cmd.mha_pagesize = large_os_page_size;
+ cmd.mha_cmd = MHA_MAPSIZE_VA;
+ if (memcntl((caddr_t)p, size, MC_HAT_ADVISE, (caddr_t)&cmd, 0, 0) == 0) {
+ *is_large = true;
+ }
+ }
+ #endif
+ }
+ }
+ if (p == NULL) {
+ _mi_warning_message("unable to allocate OS memory (%zu bytes, error code: %i, address: %p, large only: %d, allow large: %d)\n", size, errno, addr, large_only, allow_large);
+ }
+ return p;
+}
+#endif
+
+
+/* -----------------------------------------------------------
+ Primitive allocation from the OS.
+-------------------------------------------------------------- */
+
+// Note: the `try_alignment` is just a hint and the returned pointer is not guaranteed to be aligned.
+static void* mi_os_mem_alloc(size_t size, size_t try_alignment, bool commit, bool allow_large, bool* is_large, mi_stats_t* stats) {
+ mi_assert_internal(size > 0 && (size % _mi_os_page_size()) == 0);
+ if (size == 0) return NULL;
+ if (!commit) allow_large = false;
+ if (try_alignment == 0) try_alignment = 1; // avoid 0 to ensure there will be no divide by zero when aligning
+
+ void* p = NULL;
+ /*
+ if (commit && allow_large) {
+ p = _mi_os_try_alloc_from_huge_reserved(size, try_alignment);
+ if (p != NULL) {
+ *is_large = true;
+ return p;
+ }
+ }
+ */
+
+ #if defined(_WIN32)
+ int flags = MEM_RESERVE;
+ if (commit) { flags |= MEM_COMMIT; }
+ p = mi_win_virtual_alloc(NULL, size, try_alignment, flags, false, allow_large, is_large);
+ #elif defined(MI_USE_SBRK) || defined(__wasi__)
+ MI_UNUSED(allow_large);
+ *is_large = false;
+ p = mi_heap_grow(size, try_alignment);
+ #else
+ int protect_flags = (commit ? (PROT_WRITE | PROT_READ) : PROT_NONE);
+ p = mi_unix_mmap(NULL, size, try_alignment, protect_flags, false, allow_large, is_large);
+ #endif
+ mi_stat_counter_increase(stats->mmap_calls, 1);
+ if (p != NULL) {
+ _mi_stat_increase(&stats->reserved, size);
+ if (commit) { _mi_stat_increase(&stats->committed, size); }
+ }
+ return p;
+}
+
+
+// Primitive aligned allocation from the OS.
+// This function guarantees the allocated memory is aligned.
+static void* mi_os_mem_alloc_aligned(size_t size, size_t alignment, bool commit, bool allow_large, bool* is_large, mi_stats_t* stats) {
+ mi_assert_internal(alignment >= _mi_os_page_size() && ((alignment & (alignment - 1)) == 0));
+ mi_assert_internal(size > 0 && (size % _mi_os_page_size()) == 0);
+ mi_assert_internal(is_large != NULL);
+ if (!commit) allow_large = false;
+ if (!(alignment >= _mi_os_page_size() && ((alignment & (alignment - 1)) == 0))) return NULL;
+ size = _mi_align_up(size, _mi_os_page_size());
+
+ // try first with a hint (this will be aligned directly on Win 10+ or BSD)
+ void* p = mi_os_mem_alloc(size, alignment, commit, allow_large, is_large, stats);
+ if (p == NULL) return NULL;
+
+ // if not aligned, free it, overallocate, and unmap around it
+ if (((uintptr_t)p % alignment != 0)) {
+ mi_os_mem_free(p, size, commit, stats);
+ _mi_warning_message("unable to allocate aligned OS memory directly, fall back to over-allocation (%zu bytes, address: %p, alignment: %zu, commit: %d)\n", size, p, alignment, commit);
+ if (size >= (SIZE_MAX - alignment)) return NULL; // overflow
+ const size_t over_size = size + alignment;
+
+#if _WIN32
+ // over-allocate uncommitted (virtual) memory
+ p = mi_os_mem_alloc(over_size, 0 /*alignment*/, false /* commit? */, false /* allow_large */, is_large, stats);
+ if (p == NULL) return NULL;
+
+ // set p to the aligned part in the full region
+ // note: this is dangerous on Windows as VirtualFree needs the actual region pointer
+ // but in mi_os_mem_free we handle this (hopefully exceptional) situation.
+ p = mi_align_up_ptr(p, alignment);
+
+ // explicitly commit only the aligned part
+ if (commit) {
+ _mi_os_commit(p, size, NULL, stats);
+ }
+#else
+ // overallocate...
+ p = mi_os_mem_alloc(over_size, 1, commit, false, is_large, stats);
+ if (p == NULL) return NULL;
+ // and selectively unmap parts around the over-allocated area. (noop on sbrk)
+ void* aligned_p = mi_align_up_ptr(p, alignment);
+ size_t pre_size = (uint8_t*)aligned_p - (uint8_t*)p;
+ size_t mid_size = _mi_align_up(size, _mi_os_page_size());
+ size_t post_size = over_size - pre_size - mid_size;
+ mi_assert_internal(pre_size < over_size && post_size < over_size && mid_size >= size);
+ if (pre_size > 0) mi_os_mem_free(p, pre_size, commit, stats);
+ if (post_size > 0) mi_os_mem_free((uint8_t*)aligned_p + mid_size, post_size, commit, stats);
+ // we can return the aligned pointer on `mmap` (and sbrk) systems
+ p = aligned_p;
+#endif
+ }
+
+ mi_assert_internal(p == NULL || (p != NULL && ((uintptr_t)p % alignment) == 0));
+ return p;
+}
+
+
+/* -----------------------------------------------------------
+ OS API: alloc, free, alloc_aligned
+----------------------------------------------------------- */
+
+void* _mi_os_alloc(size_t size, mi_stats_t* tld_stats) {
+ MI_UNUSED(tld_stats);
+ mi_stats_t* stats = &_mi_stats_main;
+ if (size == 0) return NULL;
+ size = _mi_os_good_alloc_size(size);
+ bool is_large = false;
+ return mi_os_mem_alloc(size, 0, true, false, &is_large, stats);
+}
+
+void _mi_os_free_ex(void* p, size_t size, bool was_committed, mi_stats_t* tld_stats) {
+ MI_UNUSED(tld_stats);
+ mi_stats_t* stats = &_mi_stats_main;
+ if (size == 0 || p == NULL) return;
+ size = _mi_os_good_alloc_size(size);
+ mi_os_mem_free(p, size, was_committed, stats);
+}
+
+void _mi_os_free(void* p, size_t size, mi_stats_t* stats) {
+ _mi_os_free_ex(p, size, true, stats);
+}
+
+void* _mi_os_alloc_aligned(size_t size, size_t alignment, bool commit, bool* large, mi_stats_t* tld_stats)
+{
+ MI_UNUSED(&mi_os_get_aligned_hint); // suppress unused warnings
+ MI_UNUSED(tld_stats);
+ if (size == 0) return NULL;
+ size = _mi_os_good_alloc_size(size);
+ alignment = _mi_align_up(alignment, _mi_os_page_size());
+ bool allow_large = false;
+ if (large != NULL) {
+ allow_large = *large;
+ *large = false;
+ }
+ return mi_os_mem_alloc_aligned(size, alignment, commit, allow_large, (large!=NULL?large:&allow_large), &_mi_stats_main /*tld->stats*/ );
+}
+
+
+
+/* -----------------------------------------------------------
+ OS memory API: reset, commit, decommit, protect, unprotect.
+----------------------------------------------------------- */
+
+
+// OS page align within a given area, either conservative (pages inside the area only),
+// or not (straddling pages outside the area is possible)
+static void* mi_os_page_align_areax(bool conservative, void* addr, size_t size, size_t* newsize) {
+ mi_assert(addr != NULL && size > 0);
+ if (newsize != NULL) *newsize = 0;
+ if (size == 0 || addr == NULL) return NULL;
+
+ // page align conservatively within the range
+ void* start = (conservative ? mi_align_up_ptr(addr, _mi_os_page_size())
+ : mi_align_down_ptr(addr, _mi_os_page_size()));
+ void* end = (conservative ? mi_align_down_ptr((uint8_t*)addr + size, _mi_os_page_size())
+ : mi_align_up_ptr((uint8_t*)addr + size, _mi_os_page_size()));
+ ptrdiff_t diff = (uint8_t*)end - (uint8_t*)start;
+ if (diff <= 0) return NULL;
+
+ mi_assert_internal((conservative && (size_t)diff <= size) || (!conservative && (size_t)diff >= size));
+ if (newsize != NULL) *newsize = (size_t)diff;
+ return start;
+}
+
+static void* mi_os_page_align_area_conservative(void* addr, size_t size, size_t* newsize) {
+ return mi_os_page_align_areax(true, addr, size, newsize);
+}
+
+static void mi_mprotect_hint(int err) {
+#if defined(MI_OS_USE_MMAP) && (MI_SECURE>=2) // guard page around every mimalloc page
+ if (err == ENOMEM) {
+ _mi_warning_message("the previous warning may have been caused by a low memory map limit.\n"
+ " On Linux this is controlled by the vm.max_map_count. For example:\n"
+ " > sudo sysctl -w vm.max_map_count=262144\n");
+ }
+#else
+ MI_UNUSED(err);
+#endif
+}
+
+// Commit/Decommit memory.
+// Usually commit is aligned liberal, while decommit is aligned conservative.
+// (but not for the reset version where we want commit to be conservative as well)
+static bool mi_os_commitx(void* addr, size_t size, bool commit, bool conservative, bool* is_zero, mi_stats_t* stats) {
+ // page align in the range, commit liberally, decommit conservative
+ if (is_zero != NULL) { *is_zero = false; }
+ size_t csize;
+ void* start = mi_os_page_align_areax(conservative, addr, size, &csize);
+ if (csize == 0) return true; // || _mi_os_is_huge_reserved(addr))
+ int err = 0;
+ if (commit) {
+ _mi_stat_increase(&stats->committed, size); // use size for precise commit vs. decommit
+ _mi_stat_counter_increase(&stats->commit_calls, 1);
+ }
+ else {
+ _mi_stat_decrease(&stats->committed, size);
+ }
+
+ #if defined(_WIN32)
+ if (commit) {
+ // *is_zero = true; // note: if the memory was already committed, the call succeeds but the memory is not zero'd
+ void* p = VirtualAlloc(start, csize, MEM_COMMIT, PAGE_READWRITE);
+ err = (p == start ? 0 : GetLastError());
+ }
+ else {
+ BOOL ok = VirtualFree(start, csize, MEM_DECOMMIT);
+ err = (ok ? 0 : GetLastError());
+ }
+ #elif defined(__wasi__)
+ // WebAssembly guests can't control memory protection
+ #elif 0 && defined(MAP_FIXED) && !defined(__APPLE__)
+ // Linux: disabled for now as mmap fixed seems much more expensive than MADV_DONTNEED (and splits VMA's?)
+ if (commit) {
+ // commit: just change the protection
+ err = mprotect(start, csize, (PROT_READ | PROT_WRITE));
+ if (err != 0) { err = errno; }
+ }
+ else {
+ // decommit: use mmap with MAP_FIXED to discard the existing memory (and reduce rss)
+ const int fd = mi_unix_mmap_fd();
+ void* p = mmap(start, csize, PROT_NONE, (MAP_FIXED | MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE), fd, 0);
+ if (p != start) { err = errno; }
+ }
+ #else
+ // Linux, macOSX and others.
+ if (commit) {
+ // commit: ensure we can access the area
+ err = mprotect(start, csize, (PROT_READ | PROT_WRITE));
+ if (err != 0) { err = errno; }
+ }
+ else {
+ #if defined(MADV_DONTNEED) && MI_DEBUG == 0 && MI_SECURE == 0
+ // decommit: use MADV_DONTNEED as it decreases rss immediately (unlike MADV_FREE)
+ // (on the other hand, MADV_FREE would be good enough.. it is just not reflected in the stats :-( )
+ err = madvise(start, csize, MADV_DONTNEED);
+ #else
+ // decommit: just disable access (also used in debug and secure mode to trap on illegal access)
+ err = mprotect(start, csize, PROT_NONE);
+ if (err != 0) { err = errno; }
+ #endif
+ //#if defined(MADV_FREE_REUSE)
+ // while ((err = mi_madvise(start, csize, MADV_FREE_REUSE)) != 0 && errno == EAGAIN) { errno = 0; }
+ //#endif
+ }
+ #endif
+ if (err != 0) {
+ _mi_warning_message("%s error: start: %p, csize: 0x%zx, err: %i\n", commit ? "commit" : "decommit", start, csize, err);
+ mi_mprotect_hint(err);
+ }
+ mi_assert_internal(err == 0);
+ return (err == 0);
+}
+
+bool _mi_os_commit(void* addr, size_t size, bool* is_zero, mi_stats_t* tld_stats) {
+ MI_UNUSED(tld_stats);
+ mi_stats_t* stats = &_mi_stats_main;
+ return mi_os_commitx(addr, size, true, false /* liberal */, is_zero, stats);
+}
+
+bool _mi_os_decommit(void* addr, size_t size, mi_stats_t* tld_stats) {
+ MI_UNUSED(tld_stats);
+ mi_stats_t* stats = &_mi_stats_main;
+ bool is_zero;
+ return mi_os_commitx(addr, size, false, true /* conservative */, &is_zero, stats);
+}
+
+/*
+static bool mi_os_commit_unreset(void* addr, size_t size, bool* is_zero, mi_stats_t* stats) {
+ return mi_os_commitx(addr, size, true, true // conservative
+ , is_zero, stats);
+}
+*/
+
+// Signal to the OS that the address range is no longer in use
+// but may be used later again. This will release physical memory
+// pages and reduce swapping while keeping the memory committed.
+// We page align to a conservative area inside the range to reset.
+static bool mi_os_resetx(void* addr, size_t size, bool reset, mi_stats_t* stats) {
+ // page align conservatively within the range
+ size_t csize;
+ void* start = mi_os_page_align_area_conservative(addr, size, &csize);
+ if (csize == 0) return true; // || _mi_os_is_huge_reserved(addr)
+ if (reset) _mi_stat_increase(&stats->reset, csize);
+ else _mi_stat_decrease(&stats->reset, csize);
+ if (!reset) return true; // nothing to do on unreset!
+
+ #if (MI_DEBUG>1)
+ if (MI_SECURE==0) {
+ memset(start, 0, csize); // pretend it is eagerly reset
+ }
+ #endif
+
+#if defined(_WIN32)
+ // Testing shows that for us (on `malloc-large`) MEM_RESET is 2x faster than DiscardVirtualMemory
+ void* p = VirtualAlloc(start, csize, MEM_RESET, PAGE_READWRITE);
+ mi_assert_internal(p == start);
+ #if 1
+ if (p == start && start != NULL) {
+ VirtualUnlock(start,csize); // VirtualUnlock after MEM_RESET removes the memory from the working set
+ }
+ #endif
+ if (p != start) return false;
+#else
+#if defined(MADV_FREE)
+ static _Atomic(size_t) advice = MI_ATOMIC_VAR_INIT(MADV_FREE);
+ int oadvice = (int)mi_atomic_load_relaxed(&advice);
+ int err;
+ while ((err = mi_madvise(start, csize, oadvice)) != 0 && errno == EAGAIN) { errno = 0; };
+ if (err != 0 && errno == EINVAL && oadvice == MADV_FREE) {
+ // if MADV_FREE is not supported, fall back to MADV_DONTNEED from now on
+ mi_atomic_store_release(&advice, (size_t)MADV_DONTNEED);
+ err = mi_madvise(start, csize, MADV_DONTNEED);
+ }
+#elif defined(__wasi__)
+ int err = 0;
+#else
+ int err = mi_madvise(start, csize, MADV_DONTNEED);
+#endif
+ if (err != 0) {
+ _mi_warning_message("madvise reset error: start: %p, csize: 0x%zx, errno: %i\n", start, csize, errno);
+ }
+ //mi_assert(err == 0);
+ if (err != 0) return false;
+#endif
+ return true;
+}
+
+// Signal to the OS that the address range is no longer in use
+// but may be used later again. This will release physical memory
+// pages and reduce swapping while keeping the memory committed.
+// We page align to a conservative area inside the range to reset.
+bool _mi_os_reset(void* addr, size_t size, mi_stats_t* tld_stats) {
+ MI_UNUSED(tld_stats);
+ mi_stats_t* stats = &_mi_stats_main;
+ return mi_os_resetx(addr, size, true, stats);
+}
+
+/*
+bool _mi_os_unreset(void* addr, size_t size, bool* is_zero, mi_stats_t* tld_stats) {
+ MI_UNUSED(tld_stats);
+ mi_stats_t* stats = &_mi_stats_main;
+ if (mi_option_is_enabled(mi_option_reset_decommits)) {
+ return mi_os_commit_unreset(addr, size, is_zero, stats); // re-commit it (conservatively!)
+ }
+ else {
+ *is_zero = false;
+ return mi_os_resetx(addr, size, false, stats);
+ }
+}
+*/
+
+// Protect a region in memory to be not accessible.
+static bool mi_os_protectx(void* addr, size_t size, bool protect) {
+ // page align conservatively within the range
+ size_t csize = 0;
+ void* start = mi_os_page_align_area_conservative(addr, size, &csize);
+ if (csize == 0) return false;
+ /*
+ if (_mi_os_is_huge_reserved(addr)) {
+ _mi_warning_message("cannot mprotect memory allocated in huge OS pages\n");
+ }
+ */
+ int err = 0;
+#ifdef _WIN32
+ DWORD oldprotect = 0;
+ BOOL ok = VirtualProtect(start, csize, protect ? PAGE_NOACCESS : PAGE_READWRITE, &oldprotect);
+ err = (ok ? 0 : GetLastError());
+#elif defined(__wasi__)
+ err = 0;
+#else
+ err = mprotect(start, csize, protect ? PROT_NONE : (PROT_READ | PROT_WRITE));
+ if (err != 0) { err = errno; }
+#endif
+ if (err != 0) {
+ _mi_warning_message("mprotect error: start: %p, csize: 0x%zx, err: %i\n", start, csize, err);
+ mi_mprotect_hint(err);
+ }
+ return (err == 0);
+}
+
+bool _mi_os_protect(void* addr, size_t size) {
+ return mi_os_protectx(addr, size, true);
+}
+
+bool _mi_os_unprotect(void* addr, size_t size) {
+ return mi_os_protectx(addr, size, false);
+}
+
+
+
+bool _mi_os_shrink(void* p, size_t oldsize, size_t newsize, mi_stats_t* stats) {
+ // page align conservatively within the range
+ mi_assert_internal(oldsize > newsize && p != NULL);
+ if (oldsize < newsize || p == NULL) return false;
+ if (oldsize == newsize) return true;
+
+ // oldsize and newsize should be page aligned or we cannot shrink precisely
+ void* addr = (uint8_t*)p + newsize;
+ size_t size = 0;
+ void* start = mi_os_page_align_area_conservative(addr, oldsize - newsize, &size);
+ if (size == 0 || start != addr) return false;
+
+#ifdef _WIN32
+ // we cannot shrink on windows, but we can decommit
+ return _mi_os_decommit(start, size, stats);
+#else
+ return mi_os_mem_free(start, size, true, stats);
+#endif
+}
+
+
+/* ----------------------------------------------------------------------------
+Support for allocating huge OS pages (1Gib) that are reserved up-front
+and possibly associated with a specific NUMA node. (use `numa_node>=0`)
+-----------------------------------------------------------------------------*/
+#define MI_HUGE_OS_PAGE_SIZE (MI_GiB)
+
+#if defined(_WIN32) && (MI_INTPTR_SIZE >= 8)
+static void* mi_os_alloc_huge_os_pagesx(void* addr, size_t size, int numa_node)
+{
+ mi_assert_internal(size%MI_GiB == 0);
+ mi_assert_internal(addr != NULL);
+ const DWORD flags = MEM_LARGE_PAGES | MEM_COMMIT | MEM_RESERVE;
+
+ mi_win_enable_large_os_pages();
+
+ MI_MEM_EXTENDED_PARAMETER params[3] = { {{0,0},{0}},{{0,0},{0}},{{0,0},{0}} };
+ // on modern Windows try use NtAllocateVirtualMemoryEx for 1GiB huge pages
+ static bool mi_huge_pages_available = true;
+ if (pNtAllocateVirtualMemoryEx != NULL && mi_huge_pages_available) {
+ params[0].Type.Type = MiMemExtendedParameterAttributeFlags;
+ params[0].Arg.ULong64 = MI_MEM_EXTENDED_PARAMETER_NONPAGED_HUGE;
+ ULONG param_count = 1;
+ if (numa_node >= 0) {
+ param_count++;
+ params[1].Type.Type = MiMemExtendedParameterNumaNode;
+ params[1].Arg.ULong = (unsigned)numa_node;
+ }
+ SIZE_T psize = size;
+ void* base = addr;
+ NTSTATUS err = (*pNtAllocateVirtualMemoryEx)(GetCurrentProcess(), &base, &psize, flags, PAGE_READWRITE, params, param_count);
+ if (err == 0 && base != NULL) {
+ return base;
+ }
+ else {
+ // fall back to regular large pages
+ mi_huge_pages_available = false; // don't try further huge pages
+ _mi_warning_message("unable to allocate using huge (1GiB) pages, trying large (2MiB) pages instead (status 0x%lx)\n", err);
+ }
+ }
+ // on modern Windows try use VirtualAlloc2 for numa aware large OS page allocation
+ if (pVirtualAlloc2 != NULL && numa_node >= 0) {
+ params[0].Type.Type = MiMemExtendedParameterNumaNode;
+ params[0].Arg.ULong = (unsigned)numa_node;
+ return (*pVirtualAlloc2)(GetCurrentProcess(), addr, size, flags, PAGE_READWRITE, params, 1);
+ }
+
+ // otherwise use regular virtual alloc on older windows
+ return VirtualAlloc(addr, size, flags, PAGE_READWRITE);
+}
+
+#elif defined(MI_OS_USE_MMAP) && (MI_INTPTR_SIZE >= 8) && !defined(__HAIKU__)
+#include <sys/syscall.h>
+#ifndef MPOL_PREFERRED
+#define MPOL_PREFERRED 1
+#endif
+#if defined(SYS_mbind)
+static long mi_os_mbind(void* start, unsigned long len, unsigned long mode, const unsigned long* nmask, unsigned long maxnode, unsigned flags) {
+ return syscall(SYS_mbind, start, len, mode, nmask, maxnode, flags);
+}
+#else
+static long mi_os_mbind(void* start, unsigned long len, unsigned long mode, const unsigned long* nmask, unsigned long maxnode, unsigned flags) {
+ MI_UNUSED(start); MI_UNUSED(len); MI_UNUSED(mode); MI_UNUSED(nmask); MI_UNUSED(maxnode); MI_UNUSED(flags);
+ return 0;
+}
+#endif
+static void* mi_os_alloc_huge_os_pagesx(void* addr, size_t size, int numa_node) {
+ mi_assert_internal(size%MI_GiB == 0);
+ bool is_large = true;
+ void* p = mi_unix_mmap(addr, size, MI_SEGMENT_SIZE, PROT_READ | PROT_WRITE, true, true, &is_large);
+ if (p == NULL) return NULL;
+ if (numa_node >= 0 && numa_node < 8*MI_INTPTR_SIZE) { // at most 64 nodes
+ unsigned long numa_mask = (1UL << numa_node);
+ // TODO: does `mbind` work correctly for huge OS pages? should we
+ // use `set_mempolicy` before calling mmap instead?
+ // see: <https://lkml.org/lkml/2017/2/9/875>
+ long err = mi_os_mbind(p, size, MPOL_PREFERRED, &numa_mask, 8*MI_INTPTR_SIZE, 0);
+ if (err != 0) {
+ _mi_warning_message("failed to bind huge (1GiB) pages to numa node %d: %s\n", numa_node, strerror(errno));
+ }
+ }
+ return p;
+}
+#else
+static void* mi_os_alloc_huge_os_pagesx(void* addr, size_t size, int numa_node) {
+ MI_UNUSED(addr); MI_UNUSED(size); MI_UNUSED(numa_node);
+ return NULL;
+}
+#endif
+
+#if (MI_INTPTR_SIZE >= 8)
+// To ensure proper alignment, use our own area for huge OS pages
+static mi_decl_cache_align _Atomic(uintptr_t) mi_huge_start; // = 0
+
+// Claim an aligned address range for huge pages
+static uint8_t* mi_os_claim_huge_pages(size_t pages, size_t* total_size) {
+ if (total_size != NULL) *total_size = 0;
+ const size_t size = pages * MI_HUGE_OS_PAGE_SIZE;
+
+ uintptr_t start = 0;
+ uintptr_t end = 0;
+ uintptr_t huge_start = mi_atomic_load_relaxed(&mi_huge_start);
+ do {
+ start = huge_start;
+ if (start == 0) {
+ // Initialize the start address after the 32TiB area
+ start = ((uintptr_t)32 << 40); // 32TiB virtual start address
+#if (MI_SECURE>0 || MI_DEBUG==0) // security: randomize start of huge pages unless in debug mode
+ uintptr_t r = _mi_heap_random_next(mi_get_default_heap());
+ start = start + ((uintptr_t)MI_HUGE_OS_PAGE_SIZE * ((r>>17) & 0x0FFF)); // (randomly 12bits)*1GiB == between 0 to 4TiB
+#endif
+ }
+ end = start + size;
+ mi_assert_internal(end % MI_SEGMENT_SIZE == 0);
+ } while (!mi_atomic_cas_strong_acq_rel(&mi_huge_start, &huge_start, end));
+
+ if (total_size != NULL) *total_size = size;
+ return (uint8_t*)start;
+}
+#else
+static uint8_t* mi_os_claim_huge_pages(size_t pages, size_t* total_size) {
+ MI_UNUSED(pages);
+ if (total_size != NULL) *total_size = 0;
+ return NULL;
+}
+#endif
+
+// Allocate MI_SEGMENT_SIZE aligned huge pages
+void* _mi_os_alloc_huge_os_pages(size_t pages, int numa_node, mi_msecs_t max_msecs, size_t* pages_reserved, size_t* psize) {
+ if (psize != NULL) *psize = 0;
+ if (pages_reserved != NULL) *pages_reserved = 0;
+ size_t size = 0;
+ uint8_t* start = mi_os_claim_huge_pages(pages, &size);
+ if (start == NULL) return NULL; // or 32-bit systems
+
+ // Allocate one page at the time but try to place them contiguously
+ // We allocate one page at the time to be able to abort if it takes too long
+ // or to at least allocate as many as available on the system.
+ mi_msecs_t start_t = _mi_clock_start();
+ size_t page;
+ for (page = 0; page < pages; page++) {
+ // allocate a page
+ void* addr = start + (page * MI_HUGE_OS_PAGE_SIZE);
+ void* p = mi_os_alloc_huge_os_pagesx(addr, MI_HUGE_OS_PAGE_SIZE, numa_node);
+
+ // Did we succeed at a contiguous address?
+ if (p != addr) {
+ // no success, issue a warning and break
+ if (p != NULL) {
+ _mi_warning_message("could not allocate contiguous huge page %zu at %p\n", page, addr);
+ _mi_os_free(p, MI_HUGE_OS_PAGE_SIZE, &_mi_stats_main);
+ }
+ break;
+ }
+
+ // success, record it
+ _mi_stat_increase(&_mi_stats_main.committed, MI_HUGE_OS_PAGE_SIZE);
+ _mi_stat_increase(&_mi_stats_main.reserved, MI_HUGE_OS_PAGE_SIZE);
+
+ // check for timeout
+ if (max_msecs > 0) {
+ mi_msecs_t elapsed = _mi_clock_end(start_t);
+ if (page >= 1) {
+ mi_msecs_t estimate = ((elapsed / (page+1)) * pages);
+ if (estimate > 2*max_msecs) { // seems like we are going to timeout, break
+ elapsed = max_msecs + 1;
+ }
+ }
+ if (elapsed > max_msecs) {
+ _mi_warning_message("huge page allocation timed out\n");
+ break;
+ }
+ }
+ }
+ mi_assert_internal(page*MI_HUGE_OS_PAGE_SIZE <= size);
+ if (pages_reserved != NULL) { *pages_reserved = page; }
+ if (psize != NULL) { *psize = page * MI_HUGE_OS_PAGE_SIZE; }
+ return (page == 0 ? NULL : start);
+}
+
+// free every huge page in a range individually (as we allocated per page)
+// note: needed with VirtualAlloc but could potentially be done in one go on mmap'd systems.
+void _mi_os_free_huge_pages(void* p, size_t size, mi_stats_t* stats) {
+ if (p==NULL || size==0) return;
+ uint8_t* base = (uint8_t*)p;
+ while (size >= MI_HUGE_OS_PAGE_SIZE) {
+ _mi_os_free(base, MI_HUGE_OS_PAGE_SIZE, stats);
+ size -= MI_HUGE_OS_PAGE_SIZE;
+ base += MI_HUGE_OS_PAGE_SIZE;
+ }
+}
+
+/* ----------------------------------------------------------------------------
+Support NUMA aware allocation
+-----------------------------------------------------------------------------*/
+#ifdef _WIN32
+static size_t mi_os_numa_nodex(void) {
+ USHORT numa_node = 0;
+ if (pGetCurrentProcessorNumberEx != NULL && pGetNumaProcessorNodeEx != NULL) {
+ // Extended API is supported
+ MI_PROCESSOR_NUMBER pnum;
+ (*pGetCurrentProcessorNumberEx)(&pnum);
+ USHORT nnode = 0;
+ BOOL ok = (*pGetNumaProcessorNodeEx)(&pnum, &nnode);
+ if (ok) numa_node = nnode;
+ }
+ else {
+ // Vista or earlier, use older API that is limited to 64 processors. Issue #277
+ DWORD pnum = GetCurrentProcessorNumber();
+ UCHAR nnode = 0;
+ BOOL ok = GetNumaProcessorNode((UCHAR)pnum, &nnode);
+ if (ok) numa_node = nnode;
+ }
+ return numa_node;
+}
+
+static size_t mi_os_numa_node_countx(void) {
+ ULONG numa_max = 0;
+ GetNumaHighestNodeNumber(&numa_max);
+ // find the highest node number that has actual processors assigned to it. Issue #282
+ while(numa_max > 0) {
+ if (pGetNumaNodeProcessorMaskEx != NULL) {
+ // Extended API is supported
+ GROUP_AFFINITY affinity;
+ if ((*pGetNumaNodeProcessorMaskEx)((USHORT)numa_max, &affinity)) {
+ if (affinity.Mask != 0) break; // found the maximum non-empty node
+ }
+ }
+ else {
+ // Vista or earlier, use older API that is limited to 64 processors.
+ ULONGLONG mask;
+ if (GetNumaNodeProcessorMask((UCHAR)numa_max, &mask)) {
+ if (mask != 0) break; // found the maximum non-empty node
+ };
+ }
+ // max node was invalid or had no processor assigned, try again
+ numa_max--;
+ }
+ return ((size_t)numa_max + 1);
+}
+#elif defined(__linux__)
+#include <sys/syscall.h> // getcpu
+#include <stdio.h> // access
+
+static size_t mi_os_numa_nodex(void) {
+#ifdef SYS_getcpu
+ unsigned long node = 0;
+ unsigned long ncpu = 0;
+ long err = syscall(SYS_getcpu, &ncpu, &node, NULL);
+ if (err != 0) return 0;
+ return node;
+#else
+ return 0;
+#endif
+}
+static size_t mi_os_numa_node_countx(void) {
+ char buf[128];
+ unsigned node = 0;
+ for(node = 0; node < 256; node++) {
+ // enumerate node entries -- todo: it there a more efficient way to do this? (but ensure there is no allocation)
+ snprintf(buf, 127, "/sys/devices/system/node/node%u", node + 1);
+ if (access(buf,R_OK) != 0) break;
+ }
+ return (node+1);
+}
+#elif defined(__FreeBSD__) && __FreeBSD_version >= 1200000
+static size_t mi_os_numa_nodex(void) {
+ domainset_t dom;
+ size_t node;
+ int policy;
+ if (cpuset_getdomain(CPU_LEVEL_CPUSET, CPU_WHICH_PID, -1, sizeof(dom), &dom, &policy) == -1) return 0ul;
+ for (node = 0; node < MAXMEMDOM; node++) {
+ if (DOMAINSET_ISSET(node, &dom)) return node;
+ }
+ return 0ul;
+}
+static size_t mi_os_numa_node_countx(void) {
+ size_t ndomains = 0;
+ size_t len = sizeof(ndomains);
+ if (sysctlbyname("vm.ndomains", &ndomains, &len, NULL, 0) == -1) return 0ul;
+ return ndomains;
+}
+#elif defined(__DragonFly__)
+static size_t mi_os_numa_nodex(void) {
+ // TODO: DragonFly does not seem to provide any userland means to get this information.
+ return 0ul;
+}
+static size_t mi_os_numa_node_countx(void) {
+ size_t ncpus = 0, nvirtcoresperphys = 0;
+ size_t len = sizeof(size_t);
+ if (sysctlbyname("hw.ncpu", &ncpus, &len, NULL, 0) == -1) return 0ul;
+ if (sysctlbyname("hw.cpu_topology_ht_ids", &nvirtcoresperphys, &len, NULL, 0) == -1) return 0ul;
+ return nvirtcoresperphys * ncpus;
+}
+#else
+static size_t mi_os_numa_nodex(void) {
+ return 0;
+}
+static size_t mi_os_numa_node_countx(void) {
+ return 1;
+}
+#endif
+
+_Atomic(size_t) _mi_numa_node_count; // = 0 // cache the node count
+
+size_t _mi_os_numa_node_count_get(void) {
+ size_t count = mi_atomic_load_acquire(&_mi_numa_node_count);
+ if (count <= 0) {
+ long ncount = mi_option_get(mi_option_use_numa_nodes); // given explicitly?
+ if (ncount > 0) {
+ count = (size_t)ncount;
+ }
+ else {
+ count = mi_os_numa_node_countx(); // or detect dynamically
+ if (count == 0) count = 1;
+ }
+ mi_atomic_store_release(&_mi_numa_node_count, count); // save it
+ _mi_verbose_message("using %zd numa regions\n", count);
+ }
+ return count;
+}
+
+int _mi_os_numa_node_get(mi_os_tld_t* tld) {
+ MI_UNUSED(tld);
+ size_t numa_count = _mi_os_numa_node_count();
+ if (numa_count<=1) return 0; // optimize on single numa node systems: always node 0
+ // never more than the node count and >= 0
+ size_t numa_node = mi_os_numa_nodex();
+ if (numa_node >= numa_count) { numa_node = numa_node % numa_count; }
+ return (int)numa_node;
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/page-queue.c b/source/luametatex/source/libraries/mimalloc/src/page-queue.c
new file mode 100644
index 000000000..92f933c2a
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/page-queue.c
@@ -0,0 +1,331 @@
+/*----------------------------------------------------------------------------
+Copyright (c) 2018-2020, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* -----------------------------------------------------------
+ Definition of page queues for each block size
+----------------------------------------------------------- */
+
+#ifndef MI_IN_PAGE_C
+#error "this file should be included from 'page.c'"
+#endif
+
+/* -----------------------------------------------------------
+ Minimal alignment in machine words (i.e. `sizeof(void*)`)
+----------------------------------------------------------- */
+
+#if (MI_MAX_ALIGN_SIZE > 4*MI_INTPTR_SIZE)
+ #error "define alignment for more than 4x word size for this platform"
+#elif (MI_MAX_ALIGN_SIZE > 2*MI_INTPTR_SIZE)
+ #define MI_ALIGN4W // 4 machine words minimal alignment
+#elif (MI_MAX_ALIGN_SIZE > MI_INTPTR_SIZE)
+ #define MI_ALIGN2W // 2 machine words minimal alignment
+#else
+ // ok, default alignment is 1 word
+#endif
+
+
+/* -----------------------------------------------------------
+ Queue query
+----------------------------------------------------------- */
+
+
+static inline bool mi_page_queue_is_huge(const mi_page_queue_t* pq) {
+ return (pq->block_size == (MI_MEDIUM_OBJ_SIZE_MAX+sizeof(uintptr_t)));
+}
+
+static inline bool mi_page_queue_is_full(const mi_page_queue_t* pq) {
+ return (pq->block_size == (MI_MEDIUM_OBJ_SIZE_MAX+(2*sizeof(uintptr_t))));
+}
+
+static inline bool mi_page_queue_is_special(const mi_page_queue_t* pq) {
+ return (pq->block_size > MI_MEDIUM_OBJ_SIZE_MAX);
+}
+
+/* -----------------------------------------------------------
+ Bins
+----------------------------------------------------------- */
+
+// Return the bin for a given field size.
+// Returns MI_BIN_HUGE if the size is too large.
+// We use `wsize` for the size in "machine word sizes",
+// i.e. byte size == `wsize*sizeof(void*)`.
+static inline uint8_t mi_bin(size_t size) {
+ size_t wsize = _mi_wsize_from_size(size);
+ uint8_t bin;
+ if (wsize <= 1) {
+ bin = 1;
+ }
+ #if defined(MI_ALIGN4W)
+ else if (wsize <= 4) {
+ bin = (uint8_t)((wsize+1)&~1); // round to double word sizes
+ }
+ #elif defined(MI_ALIGN2W)
+ else if (wsize <= 8) {
+ bin = (uint8_t)((wsize+1)&~1); // round to double word sizes
+ }
+ #else
+ else if (wsize <= 8) {
+ bin = (uint8_t)wsize;
+ }
+ #endif
+ else if (wsize > MI_MEDIUM_OBJ_WSIZE_MAX) {
+ bin = MI_BIN_HUGE;
+ }
+ else {
+ #if defined(MI_ALIGN4W)
+ if (wsize <= 16) { wsize = (wsize+3)&~3; } // round to 4x word sizes
+ #endif
+ wsize--;
+ // find the highest bit
+ uint8_t b = (uint8_t)mi_bsr(wsize); // note: wsize != 0
+ // and use the top 3 bits to determine the bin (~12.5% worst internal fragmentation).
+ // - adjust with 3 because we use do not round the first 8 sizes
+ // which each get an exact bin
+ bin = ((b << 2) + (uint8_t)((wsize >> (b - 2)) & 0x03)) - 3;
+ mi_assert_internal(bin < MI_BIN_HUGE);
+ }
+ mi_assert_internal(bin > 0 && bin <= MI_BIN_HUGE);
+ return bin;
+}
+
+
+
+/* -----------------------------------------------------------
+ Queue of pages with free blocks
+----------------------------------------------------------- */
+
+uint8_t _mi_bin(size_t size) {
+ return mi_bin(size);
+}
+
+size_t _mi_bin_size(uint8_t bin) {
+ return _mi_heap_empty.pages[bin].block_size;
+}
+
+// Good size for allocation
+size_t mi_good_size(size_t size) mi_attr_noexcept {
+ if (size <= MI_MEDIUM_OBJ_SIZE_MAX) {
+ return _mi_bin_size(mi_bin(size));
+ }
+ else {
+ return _mi_align_up(size,_mi_os_page_size());
+ }
+}
+
+#if (MI_DEBUG>1)
+static bool mi_page_queue_contains(mi_page_queue_t* queue, const mi_page_t* page) {
+ mi_assert_internal(page != NULL);
+ mi_page_t* list = queue->first;
+ while (list != NULL) {
+ mi_assert_internal(list->next == NULL || list->next->prev == list);
+ mi_assert_internal(list->prev == NULL || list->prev->next == list);
+ if (list == page) break;
+ list = list->next;
+ }
+ return (list == page);
+}
+
+#endif
+
+#if (MI_DEBUG>1)
+static bool mi_heap_contains_queue(const mi_heap_t* heap, const mi_page_queue_t* pq) {
+ return (pq >= &heap->pages[0] && pq <= &heap->pages[MI_BIN_FULL]);
+}
+#endif
+
+static mi_page_queue_t* mi_page_queue_of(const mi_page_t* page) {
+ uint8_t bin = (mi_page_is_in_full(page) ? MI_BIN_FULL : mi_bin(page->xblock_size));
+ mi_heap_t* heap = mi_page_heap(page);
+ mi_assert_internal(heap != NULL && bin <= MI_BIN_FULL);
+ mi_page_queue_t* pq = &heap->pages[bin];
+ mi_assert_internal(bin >= MI_BIN_HUGE || page->xblock_size == pq->block_size);
+ mi_assert_expensive(mi_page_queue_contains(pq, page));
+ return pq;
+}
+
+static mi_page_queue_t* mi_heap_page_queue_of(mi_heap_t* heap, const mi_page_t* page) {
+ uint8_t bin = (mi_page_is_in_full(page) ? MI_BIN_FULL : mi_bin(page->xblock_size));
+ mi_assert_internal(bin <= MI_BIN_FULL);
+ mi_page_queue_t* pq = &heap->pages[bin];
+ mi_assert_internal(mi_page_is_in_full(page) || page->xblock_size == pq->block_size);
+ return pq;
+}
+
+// The current small page array is for efficiency and for each
+// small size (up to 256) it points directly to the page for that
+// size without having to compute the bin. This means when the
+// current free page queue is updated for a small bin, we need to update a
+// range of entries in `_mi_page_small_free`.
+static inline void mi_heap_queue_first_update(mi_heap_t* heap, const mi_page_queue_t* pq) {
+ mi_assert_internal(mi_heap_contains_queue(heap,pq));
+ size_t size = pq->block_size;
+ if (size > MI_SMALL_SIZE_MAX) return;
+
+ mi_page_t* page = pq->first;
+ if (pq->first == NULL) page = (mi_page_t*)&_mi_page_empty;
+
+ // find index in the right direct page array
+ size_t start;
+ size_t idx = _mi_wsize_from_size(size);
+ mi_page_t** pages_free = heap->pages_free_direct;
+
+ if (pages_free[idx] == page) return; // already set
+
+ // find start slot
+ if (idx<=1) {
+ start = 0;
+ }
+ else {
+ // find previous size; due to minimal alignment upto 3 previous bins may need to be skipped
+ uint8_t bin = mi_bin(size);
+ const mi_page_queue_t* prev = pq - 1;
+ while( bin == mi_bin(prev->block_size) && prev > &heap->pages[0]) {
+ prev--;
+ }
+ start = 1 + _mi_wsize_from_size(prev->block_size);
+ if (start > idx) start = idx;
+ }
+
+ // set size range to the right page
+ mi_assert(start <= idx);
+ for (size_t sz = start; sz <= idx; sz++) {
+ pages_free[sz] = page;
+ }
+}
+
+/*
+static bool mi_page_queue_is_empty(mi_page_queue_t* queue) {
+ return (queue->first == NULL);
+}
+*/
+
+static void mi_page_queue_remove(mi_page_queue_t* queue, mi_page_t* page) {
+ mi_assert_internal(page != NULL);
+ mi_assert_expensive(mi_page_queue_contains(queue, page));
+ mi_assert_internal(page->xblock_size == queue->block_size || (page->xblock_size > MI_MEDIUM_OBJ_SIZE_MAX && mi_page_queue_is_huge(queue)) || (mi_page_is_in_full(page) && mi_page_queue_is_full(queue)));
+ mi_heap_t* heap = mi_page_heap(page);
+
+ if (page->prev != NULL) page->prev->next = page->next;
+ if (page->next != NULL) page->next->prev = page->prev;
+ if (page == queue->last) queue->last = page->prev;
+ if (page == queue->first) {
+ queue->first = page->next;
+ // update first
+ mi_assert_internal(mi_heap_contains_queue(heap, queue));
+ mi_heap_queue_first_update(heap,queue);
+ }
+ heap->page_count--;
+ page->next = NULL;
+ page->prev = NULL;
+ // mi_atomic_store_ptr_release(mi_atomic_cast(void*, &page->heap), NULL);
+ mi_page_set_in_full(page,false);
+}
+
+
+static void mi_page_queue_push(mi_heap_t* heap, mi_page_queue_t* queue, mi_page_t* page) {
+ mi_assert_internal(mi_page_heap(page) == heap);
+ mi_assert_internal(!mi_page_queue_contains(queue, page));
+
+ mi_assert_internal(_mi_page_segment(page)->kind != MI_SEGMENT_HUGE);
+ mi_assert_internal(page->xblock_size == queue->block_size ||
+ (page->xblock_size > MI_MEDIUM_OBJ_SIZE_MAX) ||
+ (mi_page_is_in_full(page) && mi_page_queue_is_full(queue)));
+
+ mi_page_set_in_full(page, mi_page_queue_is_full(queue));
+ // mi_atomic_store_ptr_release(mi_atomic_cast(void*, &page->heap), heap);
+ page->next = queue->first;
+ page->prev = NULL;
+ if (queue->first != NULL) {
+ mi_assert_internal(queue->first->prev == NULL);
+ queue->first->prev = page;
+ queue->first = page;
+ }
+ else {
+ queue->first = queue->last = page;
+ }
+
+ // update direct
+ mi_heap_queue_first_update(heap, queue);
+ heap->page_count++;
+}
+
+
+static void mi_page_queue_enqueue_from(mi_page_queue_t* to, mi_page_queue_t* from, mi_page_t* page) {
+ mi_assert_internal(page != NULL);
+ mi_assert_expensive(mi_page_queue_contains(from, page));
+ mi_assert_expensive(!mi_page_queue_contains(to, page));
+
+ mi_assert_internal((page->xblock_size == to->block_size && page->xblock_size == from->block_size) ||
+ (page->xblock_size == to->block_size && mi_page_queue_is_full(from)) ||
+ (page->xblock_size == from->block_size && mi_page_queue_is_full(to)) ||
+ (page->xblock_size > MI_LARGE_OBJ_SIZE_MAX && mi_page_queue_is_huge(to)) ||
+ (page->xblock_size > MI_LARGE_OBJ_SIZE_MAX && mi_page_queue_is_full(to)));
+
+ mi_heap_t* heap = mi_page_heap(page);
+ if (page->prev != NULL) page->prev->next = page->next;
+ if (page->next != NULL) page->next->prev = page->prev;
+ if (page == from->last) from->last = page->prev;
+ if (page == from->first) {
+ from->first = page->next;
+ // update first
+ mi_assert_internal(mi_heap_contains_queue(heap, from));
+ mi_heap_queue_first_update(heap, from);
+ }
+
+ page->prev = to->last;
+ page->next = NULL;
+ if (to->last != NULL) {
+ mi_assert_internal(heap == mi_page_heap(to->last));
+ to->last->next = page;
+ to->last = page;
+ }
+ else {
+ to->first = page;
+ to->last = page;
+ mi_heap_queue_first_update(heap, to);
+ }
+
+ mi_page_set_in_full(page, mi_page_queue_is_full(to));
+}
+
+// Only called from `mi_heap_absorb`.
+size_t _mi_page_queue_append(mi_heap_t* heap, mi_page_queue_t* pq, mi_page_queue_t* append) {
+ mi_assert_internal(mi_heap_contains_queue(heap,pq));
+ mi_assert_internal(pq->block_size == append->block_size);
+
+ if (append->first==NULL) return 0;
+
+ // set append pages to new heap and count
+ size_t count = 0;
+ for (mi_page_t* page = append->first; page != NULL; page = page->next) {
+ // inline `mi_page_set_heap` to avoid wrong assertion during absorption;
+ // in this case it is ok to be delayed freeing since both "to" and "from" heap are still alive.
+ mi_atomic_store_release(&page->xheap, (uintptr_t)heap);
+ // set the flag to delayed free (not overriding NEVER_DELAYED_FREE) which has as a
+ // side effect that it spins until any DELAYED_FREEING is finished. This ensures
+ // that after appending only the new heap will be used for delayed free operations.
+ _mi_page_use_delayed_free(page, MI_USE_DELAYED_FREE, false);
+ count++;
+ }
+
+ if (pq->last==NULL) {
+ // take over afresh
+ mi_assert_internal(pq->first==NULL);
+ pq->first = append->first;
+ pq->last = append->last;
+ mi_heap_queue_first_update(heap, pq);
+ }
+ else {
+ // append to end
+ mi_assert_internal(pq->last!=NULL);
+ mi_assert_internal(append->first!=NULL);
+ pq->last->next = append->first;
+ append->first->prev = pq->last;
+ pq->last = append->last;
+ }
+ return count;
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/page.c b/source/luametatex/source/libraries/mimalloc/src/page.c
new file mode 100644
index 000000000..fd6c5397d
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/page.c
@@ -0,0 +1,869 @@
+/*----------------------------------------------------------------------------
+Copyright (c) 2018-2020, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* -----------------------------------------------------------
+ The core of the allocator. Every segment contains
+ pages of a certain block size. The main function
+ exported is `mi_malloc_generic`.
+----------------------------------------------------------- */
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+/* -----------------------------------------------------------
+ Definition of page queues for each block size
+----------------------------------------------------------- */
+
+#define MI_IN_PAGE_C
+#include "page-queue.c"
+#undef MI_IN_PAGE_C
+
+
+/* -----------------------------------------------------------
+ Page helpers
+----------------------------------------------------------- */
+
+// Index a block in a page
+static inline mi_block_t* mi_page_block_at(const mi_page_t* page, void* page_start, size_t block_size, size_t i) {
+ MI_UNUSED(page);
+ mi_assert_internal(page != NULL);
+ mi_assert_internal(i <= page->reserved);
+ return (mi_block_t*)((uint8_t*)page_start + (i * block_size));
+}
+
+static void mi_page_init(mi_heap_t* heap, mi_page_t* page, size_t size, mi_tld_t* tld);
+static void mi_page_extend_free(mi_heap_t* heap, mi_page_t* page, mi_tld_t* tld);
+
+#if (MI_DEBUG>=3)
+static size_t mi_page_list_count(mi_page_t* page, mi_block_t* head) {
+ size_t count = 0;
+ while (head != NULL) {
+ mi_assert_internal(page == _mi_ptr_page(head));
+ count++;
+ head = mi_block_next(page, head);
+ }
+ return count;
+}
+
+/*
+// Start of the page available memory
+static inline uint8_t* mi_page_area(const mi_page_t* page) {
+ return _mi_page_start(_mi_page_segment(page), page, NULL);
+}
+*/
+
+static bool mi_page_list_is_valid(mi_page_t* page, mi_block_t* p) {
+ size_t psize;
+ uint8_t* page_area = _mi_page_start(_mi_page_segment(page), page, &psize);
+ mi_block_t* start = (mi_block_t*)page_area;
+ mi_block_t* end = (mi_block_t*)(page_area + psize);
+ while(p != NULL) {
+ if (p < start || p >= end) return false;
+ p = mi_block_next(page, p);
+ }
+ return true;
+}
+
+static bool mi_page_is_valid_init(mi_page_t* page) {
+ mi_assert_internal(page->xblock_size > 0);
+ mi_assert_internal(page->used <= page->capacity);
+ mi_assert_internal(page->capacity <= page->reserved);
+
+ mi_segment_t* segment = _mi_page_segment(page);
+ uint8_t* start = _mi_page_start(segment,page,NULL);
+ mi_assert_internal(start == _mi_segment_page_start(segment,page,NULL));
+ //const size_t bsize = mi_page_block_size(page);
+ //mi_assert_internal(start + page->capacity*page->block_size == page->top);
+
+ mi_assert_internal(mi_page_list_is_valid(page,page->free));
+ mi_assert_internal(mi_page_list_is_valid(page,page->local_free));
+
+ #if MI_DEBUG>3 // generally too expensive to check this
+ if (page->is_zero) {
+ const size_t ubsize = mi_page_usable_block_size(page);
+ for(mi_block_t* block = page->free; block != NULL; block = mi_block_next(page,block)) {
+ mi_assert_expensive(mi_mem_is_zero(block + 1, ubsize - sizeof(mi_block_t)));
+ }
+ }
+ #endif
+
+ mi_block_t* tfree = mi_page_thread_free(page);
+ mi_assert_internal(mi_page_list_is_valid(page, tfree));
+ //size_t tfree_count = mi_page_list_count(page, tfree);
+ //mi_assert_internal(tfree_count <= page->thread_freed + 1);
+
+ size_t free_count = mi_page_list_count(page, page->free) + mi_page_list_count(page, page->local_free);
+ mi_assert_internal(page->used + free_count == page->capacity);
+
+ return true;
+}
+
+bool _mi_page_is_valid(mi_page_t* page) {
+ mi_assert_internal(mi_page_is_valid_init(page));
+ #if MI_SECURE
+ mi_assert_internal(page->keys[0] != 0);
+ #endif
+ if (mi_page_heap(page)!=NULL) {
+ mi_segment_t* segment = _mi_page_segment(page);
+
+ mi_assert_internal(!_mi_process_is_initialized || segment->thread_id==0 || segment->thread_id == mi_page_heap(page)->thread_id);
+ if (segment->kind != MI_SEGMENT_HUGE) {
+ mi_page_queue_t* pq = mi_page_queue_of(page);
+ mi_assert_internal(mi_page_queue_contains(pq, page));
+ mi_assert_internal(pq->block_size==mi_page_block_size(page) || mi_page_block_size(page) > MI_MEDIUM_OBJ_SIZE_MAX || mi_page_is_in_full(page));
+ mi_assert_internal(mi_heap_contains_queue(mi_page_heap(page),pq));
+ }
+ }
+ return true;
+}
+#endif
+
+void _mi_page_use_delayed_free(mi_page_t* page, mi_delayed_t delay, bool override_never) {
+ mi_thread_free_t tfreex;
+ mi_delayed_t old_delay;
+ mi_thread_free_t tfree;
+ do {
+ tfree = mi_atomic_load_acquire(&page->xthread_free); // note: must acquire as we can break/repeat this loop and not do a CAS;
+ tfreex = mi_tf_set_delayed(tfree, delay);
+ old_delay = mi_tf_delayed(tfree);
+ if (mi_unlikely(old_delay == MI_DELAYED_FREEING)) {
+ mi_atomic_yield(); // delay until outstanding MI_DELAYED_FREEING are done.
+ // tfree = mi_tf_set_delayed(tfree, MI_NO_DELAYED_FREE); // will cause CAS to busy fail
+ }
+ else if (delay == old_delay) {
+ break; // avoid atomic operation if already equal
+ }
+ else if (!override_never && old_delay == MI_NEVER_DELAYED_FREE) {
+ break; // leave never-delayed flag set
+ }
+ } while ((old_delay == MI_DELAYED_FREEING) ||
+ !mi_atomic_cas_weak_release(&page->xthread_free, &tfree, tfreex));
+}
+
+/* -----------------------------------------------------------
+ Page collect the `local_free` and `thread_free` lists
+----------------------------------------------------------- */
+
+// Collect the local `thread_free` list using an atomic exchange.
+// Note: The exchange must be done atomically as this is used right after
+// moving to the full list in `mi_page_collect_ex` and we need to
+// ensure that there was no race where the page became unfull just before the move.
+static void _mi_page_thread_free_collect(mi_page_t* page)
+{
+ mi_block_t* head;
+ mi_thread_free_t tfreex;
+ mi_thread_free_t tfree = mi_atomic_load_relaxed(&page->xthread_free);
+ do {
+ head = mi_tf_block(tfree);
+ tfreex = mi_tf_set_block(tfree,NULL);
+ } while (!mi_atomic_cas_weak_acq_rel(&page->xthread_free, &tfree, tfreex));
+
+ // return if the list is empty
+ if (head == NULL) return;
+
+ // find the tail -- also to get a proper count (without data races)
+ uint32_t max_count = page->capacity; // cannot collect more than capacity
+ uint32_t count = 1;
+ mi_block_t* tail = head;
+ mi_block_t* next;
+ while ((next = mi_block_next(page,tail)) != NULL && count <= max_count) {
+ count++;
+ tail = next;
+ }
+ // if `count > max_count` there was a memory corruption (possibly infinite list due to double multi-threaded free)
+ if (count > max_count) {
+ _mi_error_message(EFAULT, "corrupted thread-free list\n");
+ return; // the thread-free items cannot be freed
+ }
+
+ // and append the current local free list
+ mi_block_set_next(page,tail, page->local_free);
+ page->local_free = head;
+
+ // update counts now
+ page->used -= count;
+}
+
+void _mi_page_free_collect(mi_page_t* page, bool force) {
+ mi_assert_internal(page!=NULL);
+
+ // collect the thread free list
+ if (force || mi_page_thread_free(page) != NULL) { // quick test to avoid an atomic operation
+ _mi_page_thread_free_collect(page);
+ }
+
+ // and the local free list
+ if (page->local_free != NULL) {
+ if (mi_likely(page->free == NULL)) {
+ // usual case
+ page->free = page->local_free;
+ page->local_free = NULL;
+ page->is_zero = false;
+ }
+ else if (force) {
+ // append -- only on shutdown (force) as this is a linear operation
+ mi_block_t* tail = page->local_free;
+ mi_block_t* next;
+ while ((next = mi_block_next(page, tail)) != NULL) {
+ tail = next;
+ }
+ mi_block_set_next(page, tail, page->free);
+ page->free = page->local_free;
+ page->local_free = NULL;
+ page->is_zero = false;
+ }
+ }
+
+ mi_assert_internal(!force || page->local_free == NULL);
+}
+
+
+
+/* -----------------------------------------------------------
+ Page fresh and retire
+----------------------------------------------------------- */
+
+// called from segments when reclaiming abandoned pages
+void _mi_page_reclaim(mi_heap_t* heap, mi_page_t* page) {
+ mi_assert_expensive(mi_page_is_valid_init(page));
+
+ mi_assert_internal(mi_page_heap(page) == heap);
+ mi_assert_internal(mi_page_thread_free_flag(page) != MI_NEVER_DELAYED_FREE);
+ mi_assert_internal(_mi_page_segment(page)->kind != MI_SEGMENT_HUGE);
+ mi_assert_internal(!page->is_reset);
+ // TODO: push on full queue immediately if it is full?
+ mi_page_queue_t* pq = mi_page_queue(heap, mi_page_block_size(page));
+ mi_page_queue_push(heap, pq, page);
+ mi_assert_expensive(_mi_page_is_valid(page));
+}
+
+// allocate a fresh page from a segment
+static mi_page_t* mi_page_fresh_alloc(mi_heap_t* heap, mi_page_queue_t* pq, size_t block_size) {
+ mi_assert_internal(pq==NULL||mi_heap_contains_queue(heap, pq));
+ mi_page_t* page = _mi_segment_page_alloc(heap, block_size, &heap->tld->segments, &heap->tld->os);
+ if (page == NULL) {
+ // this may be out-of-memory, or an abandoned page was reclaimed (and in our queue)
+ return NULL;
+ }
+ mi_assert_internal(pq==NULL || _mi_page_segment(page)->kind != MI_SEGMENT_HUGE);
+ mi_page_init(heap, page, block_size, heap->tld);
+ mi_heap_stat_increase(heap, pages, 1);
+ if (pq!=NULL) mi_page_queue_push(heap, pq, page); // huge pages use pq==NULL
+ mi_assert_expensive(_mi_page_is_valid(page));
+ return page;
+}
+
+// Get a fresh page to use
+static mi_page_t* mi_page_fresh(mi_heap_t* heap, mi_page_queue_t* pq) {
+ mi_assert_internal(mi_heap_contains_queue(heap, pq));
+ mi_page_t* page = mi_page_fresh_alloc(heap, pq, pq->block_size);
+ if (page==NULL) return NULL;
+ mi_assert_internal(pq->block_size==mi_page_block_size(page));
+ mi_assert_internal(pq==mi_page_queue(heap, mi_page_block_size(page)));
+ return page;
+}
+
+/* -----------------------------------------------------------
+ Do any delayed frees
+ (put there by other threads if they deallocated in a full page)
+----------------------------------------------------------- */
+void _mi_heap_delayed_free(mi_heap_t* heap) {
+ // take over the list (note: no atomic exchange since it is often NULL)
+ mi_block_t* block = mi_atomic_load_ptr_relaxed(mi_block_t, &heap->thread_delayed_free);
+ while (block != NULL && !mi_atomic_cas_ptr_weak_acq_rel(mi_block_t, &heap->thread_delayed_free, &block, NULL)) { /* nothing */ };
+
+ // and free them all
+ while(block != NULL) {
+ mi_block_t* next = mi_block_nextx(heap,block, heap->keys);
+ // use internal free instead of regular one to keep stats etc correct
+ if (!_mi_free_delayed_block(block)) {
+ // we might already start delayed freeing while another thread has not yet
+ // reset the delayed_freeing flag; in that case delay it further by reinserting.
+ mi_block_t* dfree = mi_atomic_load_ptr_relaxed(mi_block_t, &heap->thread_delayed_free);
+ do {
+ mi_block_set_nextx(heap, block, dfree, heap->keys);
+ } while (!mi_atomic_cas_ptr_weak_release(mi_block_t,&heap->thread_delayed_free, &dfree, block));
+ }
+ block = next;
+ }
+}
+
+/* -----------------------------------------------------------
+ Unfull, abandon, free and retire
+----------------------------------------------------------- */
+
+// Move a page from the full list back to a regular list
+void _mi_page_unfull(mi_page_t* page) {
+ mi_assert_internal(page != NULL);
+ mi_assert_expensive(_mi_page_is_valid(page));
+ mi_assert_internal(mi_page_is_in_full(page));
+ if (!mi_page_is_in_full(page)) return;
+
+ mi_heap_t* heap = mi_page_heap(page);
+ mi_page_queue_t* pqfull = &heap->pages[MI_BIN_FULL];
+ mi_page_set_in_full(page, false); // to get the right queue
+ mi_page_queue_t* pq = mi_heap_page_queue_of(heap, page);
+ mi_page_set_in_full(page, true);
+ mi_page_queue_enqueue_from(pq, pqfull, page);
+}
+
+static void mi_page_to_full(mi_page_t* page, mi_page_queue_t* pq) {
+ mi_assert_internal(pq == mi_page_queue_of(page));
+ mi_assert_internal(!mi_page_immediate_available(page));
+ mi_assert_internal(!mi_page_is_in_full(page));
+
+ if (mi_page_is_in_full(page)) return;
+ mi_page_queue_enqueue_from(&mi_page_heap(page)->pages[MI_BIN_FULL], pq, page);
+ _mi_page_free_collect(page,false); // try to collect right away in case another thread freed just before MI_USE_DELAYED_FREE was set
+}
+
+
+// Abandon a page with used blocks at the end of a thread.
+// Note: only call if it is ensured that no references exist from
+// the `page->heap->thread_delayed_free` into this page.
+// Currently only called through `mi_heap_collect_ex` which ensures this.
+void _mi_page_abandon(mi_page_t* page, mi_page_queue_t* pq) {
+ mi_assert_internal(page != NULL);
+ mi_assert_expensive(_mi_page_is_valid(page));
+ mi_assert_internal(pq == mi_page_queue_of(page));
+ mi_assert_internal(mi_page_heap(page) != NULL);
+
+ mi_heap_t* pheap = mi_page_heap(page);
+
+ // remove from our page list
+ mi_segments_tld_t* segments_tld = &pheap->tld->segments;
+ mi_page_queue_remove(pq, page);
+
+ // page is no longer associated with our heap
+ mi_assert_internal(mi_page_thread_free_flag(page)==MI_NEVER_DELAYED_FREE);
+ mi_page_set_heap(page, NULL);
+
+#if MI_DEBUG>1
+ // check there are no references left..
+ for (mi_block_t* block = (mi_block_t*)pheap->thread_delayed_free; block != NULL; block = mi_block_nextx(pheap, block, pheap->keys)) {
+ mi_assert_internal(_mi_ptr_page(block) != page);
+ }
+#endif
+
+ // and abandon it
+ mi_assert_internal(mi_page_heap(page) == NULL);
+ _mi_segment_page_abandon(page,segments_tld);
+}
+
+
+// Free a page with no more free blocks
+void _mi_page_free(mi_page_t* page, mi_page_queue_t* pq, bool force) {
+ mi_assert_internal(page != NULL);
+ mi_assert_expensive(_mi_page_is_valid(page));
+ mi_assert_internal(pq == mi_page_queue_of(page));
+ mi_assert_internal(mi_page_all_free(page));
+ mi_assert_internal(mi_page_thread_free_flag(page)!=MI_DELAYED_FREEING);
+
+ // no more aligned blocks in here
+ mi_page_set_has_aligned(page, false);
+
+ mi_heap_t* heap = mi_page_heap(page);
+
+ // remove from the page list
+ // (no need to do _mi_heap_delayed_free first as all blocks are already free)
+ mi_segments_tld_t* segments_tld = &heap->tld->segments;
+ mi_page_queue_remove(pq, page);
+
+ // and free it
+ mi_page_set_heap(page,NULL);
+ _mi_segment_page_free(page, force, segments_tld);
+}
+
+// Retire parameters
+#define MI_MAX_RETIRE_SIZE MI_MEDIUM_OBJ_SIZE_MAX
+#define MI_RETIRE_CYCLES (8)
+
+// Retire a page with no more used blocks
+// Important to not retire too quickly though as new
+// allocations might coming.
+// Note: called from `mi_free` and benchmarks often
+// trigger this due to freeing everything and then
+// allocating again so careful when changing this.
+void _mi_page_retire(mi_page_t* page) mi_attr_noexcept {
+ mi_assert_internal(page != NULL);
+ mi_assert_expensive(_mi_page_is_valid(page));
+ mi_assert_internal(mi_page_all_free(page));
+
+ mi_page_set_has_aligned(page, false);
+
+ // don't retire too often..
+ // (or we end up retiring and re-allocating most of the time)
+ // NOTE: refine this more: we should not retire if this
+ // is the only page left with free blocks. It is not clear
+ // how to check this efficiently though...
+ // for now, we don't retire if it is the only page left of this size class.
+ mi_page_queue_t* pq = mi_page_queue_of(page);
+ if (mi_likely(page->xblock_size <= MI_MAX_RETIRE_SIZE && !mi_page_is_in_full(page))) {
+ if (pq->last==page && pq->first==page) { // the only page in the queue?
+ mi_stat_counter_increase(_mi_stats_main.page_no_retire,1);
+ page->retire_expire = 1 + (page->xblock_size <= MI_SMALL_OBJ_SIZE_MAX ? MI_RETIRE_CYCLES : MI_RETIRE_CYCLES/4);
+ mi_heap_t* heap = mi_page_heap(page);
+ mi_assert_internal(pq >= heap->pages);
+ const size_t index = pq - heap->pages;
+ mi_assert_internal(index < MI_BIN_FULL && index < MI_BIN_HUGE);
+ if (index < heap->page_retired_min) heap->page_retired_min = index;
+ if (index > heap->page_retired_max) heap->page_retired_max = index;
+ mi_assert_internal(mi_page_all_free(page));
+ return; // dont't free after all
+ }
+ }
+ _mi_page_free(page, pq, false);
+}
+
+// free retired pages: we don't need to look at the entire queues
+// since we only retire pages that are at the head position in a queue.
+void _mi_heap_collect_retired(mi_heap_t* heap, bool force) {
+ size_t min = MI_BIN_FULL;
+ size_t max = 0;
+ for(size_t bin = heap->page_retired_min; bin <= heap->page_retired_max; bin++) {
+ mi_page_queue_t* pq = &heap->pages[bin];
+ mi_page_t* page = pq->first;
+ if (page != NULL && page->retire_expire != 0) {
+ if (mi_page_all_free(page)) {
+ page->retire_expire--;
+ if (force || page->retire_expire == 0) {
+ _mi_page_free(pq->first, pq, force);
+ }
+ else {
+ // keep retired, update min/max
+ if (bin < min) min = bin;
+ if (bin > max) max = bin;
+ }
+ }
+ else {
+ page->retire_expire = 0;
+ }
+ }
+ }
+ heap->page_retired_min = min;
+ heap->page_retired_max = max;
+}
+
+
+/* -----------------------------------------------------------
+ Initialize the initial free list in a page.
+ In secure mode we initialize a randomized list by
+ alternating between slices.
+----------------------------------------------------------- */
+
+#define MI_MAX_SLICE_SHIFT (6) // at most 64 slices
+#define MI_MAX_SLICES (1UL << MI_MAX_SLICE_SHIFT)
+#define MI_MIN_SLICES (2)
+
+static void mi_page_free_list_extend_secure(mi_heap_t* const heap, mi_page_t* const page, const size_t bsize, const size_t extend, mi_stats_t* const stats) {
+ MI_UNUSED(stats);
+ #if (MI_SECURE<=2)
+ mi_assert_internal(page->free == NULL);
+ mi_assert_internal(page->local_free == NULL);
+ #endif
+ mi_assert_internal(page->capacity + extend <= page->reserved);
+ mi_assert_internal(bsize == mi_page_block_size(page));
+ void* const page_area = _mi_page_start(_mi_page_segment(page), page, NULL);
+
+ // initialize a randomized free list
+ // set up `slice_count` slices to alternate between
+ size_t shift = MI_MAX_SLICE_SHIFT;
+ while ((extend >> shift) == 0) {
+ shift--;
+ }
+ const size_t slice_count = (size_t)1U << shift;
+ const size_t slice_extend = extend / slice_count;
+ mi_assert_internal(slice_extend >= 1);
+ mi_block_t* blocks[MI_MAX_SLICES]; // current start of the slice
+ size_t counts[MI_MAX_SLICES]; // available objects in the slice
+ for (size_t i = 0; i < slice_count; i++) {
+ blocks[i] = mi_page_block_at(page, page_area, bsize, page->capacity + i*slice_extend);
+ counts[i] = slice_extend;
+ }
+ counts[slice_count-1] += (extend % slice_count); // final slice holds the modulus too (todo: distribute evenly?)
+
+ // and initialize the free list by randomly threading through them
+ // set up first element
+ const uintptr_t r = _mi_heap_random_next(heap);
+ size_t current = r % slice_count;
+ counts[current]--;
+ mi_block_t* const free_start = blocks[current];
+ // and iterate through the rest; use `random_shuffle` for performance
+ uintptr_t rnd = _mi_random_shuffle(r|1); // ensure not 0
+ for (size_t i = 1; i < extend; i++) {
+ // call random_shuffle only every INTPTR_SIZE rounds
+ const size_t round = i%MI_INTPTR_SIZE;
+ if (round == 0) rnd = _mi_random_shuffle(rnd);
+ // select a random next slice index
+ size_t next = ((rnd >> 8*round) & (slice_count-1));
+ while (counts[next]==0) { // ensure it still has space
+ next++;
+ if (next==slice_count) next = 0;
+ }
+ // and link the current block to it
+ counts[next]--;
+ mi_block_t* const block = blocks[current];
+ blocks[current] = (mi_block_t*)((uint8_t*)block + bsize); // bump to the following block
+ mi_block_set_next(page, block, blocks[next]); // and set next; note: we may have `current == next`
+ current = next;
+ }
+ // prepend to the free list (usually NULL)
+ mi_block_set_next(page, blocks[current], page->free); // end of the list
+ page->free = free_start;
+}
+
+static mi_decl_noinline void mi_page_free_list_extend( mi_page_t* const page, const size_t bsize, const size_t extend, mi_stats_t* const stats)
+{
+ MI_UNUSED(stats);
+ #if (MI_SECURE <= 2)
+ mi_assert_internal(page->free == NULL);
+ mi_assert_internal(page->local_free == NULL);
+ #endif
+ mi_assert_internal(page->capacity + extend <= page->reserved);
+ mi_assert_internal(bsize == mi_page_block_size(page));
+ void* const page_area = _mi_page_start(_mi_page_segment(page), page, NULL );
+
+ mi_block_t* const start = mi_page_block_at(page, page_area, bsize, page->capacity);
+
+ // initialize a sequential free list
+ mi_block_t* const last = mi_page_block_at(page, page_area, bsize, page->capacity + extend - 1);
+ mi_block_t* block = start;
+ while(block <= last) {
+ mi_block_t* next = (mi_block_t*)((uint8_t*)block + bsize);
+ mi_block_set_next(page,block,next);
+ block = next;
+ }
+ // prepend to free list (usually `NULL`)
+ mi_block_set_next(page, last, page->free);
+ page->free = start;
+}
+
+/* -----------------------------------------------------------
+ Page initialize and extend the capacity
+----------------------------------------------------------- */
+
+#define MI_MAX_EXTEND_SIZE (4*1024) // heuristic, one OS page seems to work well.
+#if (MI_SECURE>0)
+#define MI_MIN_EXTEND (8*MI_SECURE) // extend at least by this many
+#else
+#define MI_MIN_EXTEND (1)
+#endif
+
+// Extend the capacity (up to reserved) by initializing a free list
+// We do at most `MI_MAX_EXTEND` to avoid touching too much memory
+// Note: we also experimented with "bump" allocation on the first
+// allocations but this did not speed up any benchmark (due to an
+// extra test in malloc? or cache effects?)
+static void mi_page_extend_free(mi_heap_t* heap, mi_page_t* page, mi_tld_t* tld) {
+ MI_UNUSED(tld);
+ mi_assert_expensive(mi_page_is_valid_init(page));
+ #if (MI_SECURE<=2)
+ mi_assert(page->free == NULL);
+ mi_assert(page->local_free == NULL);
+ if (page->free != NULL) return;
+ #endif
+ if (page->capacity >= page->reserved) return;
+
+ size_t page_size;
+ _mi_page_start(_mi_page_segment(page), page, &page_size);
+ mi_stat_counter_increase(tld->stats.pages_extended, 1);
+
+ // calculate the extend count
+ const size_t bsize = (page->xblock_size < MI_HUGE_BLOCK_SIZE ? page->xblock_size : page_size);
+ size_t extend = page->reserved - page->capacity;
+ mi_assert_internal(extend > 0);
+
+ size_t max_extend = (bsize >= MI_MAX_EXTEND_SIZE ? MI_MIN_EXTEND : MI_MAX_EXTEND_SIZE/(uint32_t)bsize);
+ if (max_extend < MI_MIN_EXTEND) { max_extend = MI_MIN_EXTEND; }
+ mi_assert_internal(max_extend > 0);
+
+ if (extend > max_extend) {
+ // ensure we don't touch memory beyond the page to reduce page commit.
+ // the `lean` benchmark tests this. Going from 1 to 8 increases rss by 50%.
+ extend = max_extend;
+ }
+
+ mi_assert_internal(extend > 0 && extend + page->capacity <= page->reserved);
+ mi_assert_internal(extend < (1UL<<16));
+
+ // and append the extend the free list
+ if (extend < MI_MIN_SLICES || MI_SECURE==0) { //!mi_option_is_enabled(mi_option_secure)) {
+ mi_page_free_list_extend(page, bsize, extend, &tld->stats );
+ }
+ else {
+ mi_page_free_list_extend_secure(heap, page, bsize, extend, &tld->stats);
+ }
+ // enable the new free list
+ page->capacity += (uint16_t)extend;
+ mi_stat_increase(tld->stats.page_committed, extend * bsize);
+
+ // extension into zero initialized memory preserves the zero'd free list
+ if (!page->is_zero_init) {
+ page->is_zero = false;
+ }
+ mi_assert_expensive(mi_page_is_valid_init(page));
+}
+
+// Initialize a fresh page
+static void mi_page_init(mi_heap_t* heap, mi_page_t* page, size_t block_size, mi_tld_t* tld) {
+ mi_assert(page != NULL);
+ mi_segment_t* segment = _mi_page_segment(page);
+ mi_assert(segment != NULL);
+ mi_assert_internal(block_size > 0);
+ // set fields
+ mi_page_set_heap(page, heap);
+ page->xblock_size = (block_size < MI_HUGE_BLOCK_SIZE ? (uint32_t)block_size : MI_HUGE_BLOCK_SIZE); // initialize before _mi_segment_page_start
+ size_t page_size;
+ _mi_segment_page_start(segment, page, &page_size);
+ mi_assert_internal(mi_page_block_size(page) <= page_size);
+ mi_assert_internal(page_size <= page->slice_count*MI_SEGMENT_SLICE_SIZE);
+ mi_assert_internal(page_size / block_size < (1L<<16));
+ page->reserved = (uint16_t)(page_size / block_size);
+ #ifdef MI_ENCODE_FREELIST
+ page->keys[0] = _mi_heap_random_next(heap);
+ page->keys[1] = _mi_heap_random_next(heap);
+ #endif
+ #if MI_DEBUG > 0
+ page->is_zero = false; // ensure in debug mode we initialize with MI_DEBUG_UNINIT, see issue #501
+ #else
+ page->is_zero = page->is_zero_init;
+ #endif
+
+ mi_assert_internal(page->is_committed);
+ mi_assert_internal(!page->is_reset);
+ mi_assert_internal(page->capacity == 0);
+ mi_assert_internal(page->free == NULL);
+ mi_assert_internal(page->used == 0);
+ mi_assert_internal(page->xthread_free == 0);
+ mi_assert_internal(page->next == NULL);
+ mi_assert_internal(page->prev == NULL);
+ mi_assert_internal(page->retire_expire == 0);
+ mi_assert_internal(!mi_page_has_aligned(page));
+ #if (MI_ENCODE_FREELIST)
+ mi_assert_internal(page->keys[0] != 0);
+ mi_assert_internal(page->keys[1] != 0);
+ #endif
+ mi_assert_expensive(mi_page_is_valid_init(page));
+
+ // initialize an initial free list
+ mi_page_extend_free(heap,page,tld);
+ mi_assert(mi_page_immediate_available(page));
+}
+
+
+/* -----------------------------------------------------------
+ Find pages with free blocks
+-------------------------------------------------------------*/
+
+// Find a page with free blocks of `page->block_size`.
+static mi_page_t* mi_page_queue_find_free_ex(mi_heap_t* heap, mi_page_queue_t* pq, bool first_try)
+{
+ // search through the pages in "next fit" order
+ size_t count = 0;
+ mi_page_t* page = pq->first;
+ while (page != NULL)
+ {
+ mi_page_t* next = page->next; // remember next
+ count++;
+
+ // 0. collect freed blocks by us and other threads
+ _mi_page_free_collect(page, false);
+
+ // 1. if the page contains free blocks, we are done
+ if (mi_page_immediate_available(page)) {
+ break; // pick this one
+ }
+
+ // 2. Try to extend
+ if (page->capacity < page->reserved) {
+ mi_page_extend_free(heap, page, heap->tld);
+ mi_assert_internal(mi_page_immediate_available(page));
+ break;
+ }
+
+ // 3. If the page is completely full, move it to the `mi_pages_full`
+ // queue so we don't visit long-lived pages too often.
+ mi_assert_internal(!mi_page_is_in_full(page) && !mi_page_immediate_available(page));
+ mi_page_to_full(page, pq);
+
+ page = next;
+ } // for each page
+
+ mi_heap_stat_counter_increase(heap, searches, count);
+
+ if (page == NULL) {
+ _mi_heap_collect_retired(heap, false); // perhaps make a page available?
+ page = mi_page_fresh(heap, pq);
+ if (page == NULL && first_try) {
+ // out-of-memory _or_ an abandoned page with free blocks was reclaimed, try once again
+ page = mi_page_queue_find_free_ex(heap, pq, false);
+ }
+ }
+ else {
+ mi_assert(pq->first == page);
+ page->retire_expire = 0;
+ }
+ mi_assert_internal(page == NULL || mi_page_immediate_available(page));
+ return page;
+}
+
+
+
+// Find a page with free blocks of `size`.
+static inline mi_page_t* mi_find_free_page(mi_heap_t* heap, size_t size) {
+ mi_page_queue_t* pq = mi_page_queue(heap,size);
+ mi_page_t* page = pq->first;
+ if (page != NULL) {
+ #if (MI_SECURE>=3) // in secure mode, we extend half the time to increase randomness
+ if (page->capacity < page->reserved && ((_mi_heap_random_next(heap) & 1) == 1)) {
+ mi_page_extend_free(heap, page, heap->tld);
+ mi_assert_internal(mi_page_immediate_available(page));
+ }
+ else
+ #endif
+ {
+ _mi_page_free_collect(page,false);
+ }
+
+ if (mi_page_immediate_available(page)) {
+ page->retire_expire = 0;
+ return page; // fast path
+ }
+ }
+ return mi_page_queue_find_free_ex(heap, pq, true);
+}
+
+
+/* -----------------------------------------------------------
+ Users can register a deferred free function called
+ when the `free` list is empty. Since the `local_free`
+ is separate this is deterministically called after
+ a certain number of allocations.
+----------------------------------------------------------- */
+
+static mi_deferred_free_fun* volatile deferred_free = NULL;
+static _Atomic(void*) deferred_arg; // = NULL
+
+void _mi_deferred_free(mi_heap_t* heap, bool force) {
+ heap->tld->heartbeat++;
+ if (deferred_free != NULL && !heap->tld->recurse) {
+ heap->tld->recurse = true;
+ deferred_free(force, heap->tld->heartbeat, mi_atomic_load_ptr_relaxed(void,&deferred_arg));
+ heap->tld->recurse = false;
+ }
+}
+
+void mi_register_deferred_free(mi_deferred_free_fun* fn, void* arg) mi_attr_noexcept {
+ deferred_free = fn;
+ mi_atomic_store_ptr_release(void,&deferred_arg, arg);
+}
+
+
+/* -----------------------------------------------------------
+ General allocation
+----------------------------------------------------------- */
+
+// Large and huge page allocation.
+// Huge pages are allocated directly without being in a queue.
+// Because huge pages contain just one block, and the segment contains
+// just that page, we always treat them as abandoned and any thread
+// that frees the block can free the whole page and segment directly.
+static mi_page_t* mi_large_huge_page_alloc(mi_heap_t* heap, size_t size) {
+ size_t block_size = _mi_os_good_alloc_size(size);
+ mi_assert_internal(mi_bin(block_size) == MI_BIN_HUGE);
+ bool is_huge = (block_size > MI_LARGE_OBJ_SIZE_MAX);
+ mi_page_queue_t* pq = (is_huge ? NULL : mi_page_queue(heap, block_size));
+ mi_page_t* page = mi_page_fresh_alloc(heap, pq, block_size);
+ if (page != NULL) {
+ mi_assert_internal(mi_page_immediate_available(page));
+
+ if (pq == NULL) {
+ // huge pages are directly abandoned
+ mi_assert_internal(_mi_page_segment(page)->kind == MI_SEGMENT_HUGE);
+ mi_assert_internal(_mi_page_segment(page)->used==1);
+ mi_assert_internal(_mi_page_segment(page)->thread_id==0); // abandoned, not in the huge queue
+ mi_page_set_heap(page, NULL);
+ }
+ else {
+ mi_assert_internal(_mi_page_segment(page)->kind != MI_SEGMENT_HUGE);
+ }
+
+ const size_t bsize = mi_page_usable_block_size(page); // note: not `mi_page_block_size` to account for padding
+ if (bsize <= MI_LARGE_OBJ_SIZE_MAX) {
+ mi_heap_stat_increase(heap, large, bsize);
+ mi_heap_stat_counter_increase(heap, large_count, 1);
+ }
+ else {
+ mi_heap_stat_increase(heap, huge, bsize);
+ mi_heap_stat_counter_increase(heap, huge_count, 1);
+ }
+ }
+ return page;
+}
+
+
+// Allocate a page
+// Note: in debug mode the size includes MI_PADDING_SIZE and might have overflowed.
+static mi_page_t* mi_find_page(mi_heap_t* heap, size_t size) mi_attr_noexcept {
+ // huge allocation?
+ const size_t req_size = size - MI_PADDING_SIZE; // correct for padding_size in case of an overflow on `size`
+ if (mi_unlikely(req_size > (MI_MEDIUM_OBJ_SIZE_MAX - MI_PADDING_SIZE) )) {
+ if (mi_unlikely(req_size > PTRDIFF_MAX)) { // we don't allocate more than PTRDIFF_MAX (see <https://sourceware.org/ml/libc-announce/2019/msg00001.html>)
+ _mi_error_message(EOVERFLOW, "allocation request is too large (%zu bytes)\n", req_size);
+ return NULL;
+ }
+ else {
+ return mi_large_huge_page_alloc(heap,size);
+ }
+ }
+ else {
+ // otherwise find a page with free blocks in our size segregated queues
+ mi_assert_internal(size >= MI_PADDING_SIZE);
+ return mi_find_free_page(heap, size);
+ }
+}
+
+// Generic allocation routine if the fast path (`alloc.c:mi_page_malloc`) does not succeed.
+// Note: in debug mode the size includes MI_PADDING_SIZE and might have overflowed.
+void* _mi_malloc_generic(mi_heap_t* heap, size_t size) mi_attr_noexcept
+{
+ mi_assert_internal(heap != NULL);
+
+ // initialize if necessary
+ if (mi_unlikely(!mi_heap_is_initialized(heap))) {
+ mi_thread_init(); // calls `_mi_heap_init` in turn
+ heap = mi_get_default_heap();
+ if (mi_unlikely(!mi_heap_is_initialized(heap))) { return NULL; }
+ }
+ mi_assert_internal(mi_heap_is_initialized(heap));
+
+ // call potential deferred free routines
+ _mi_deferred_free(heap, false);
+
+ // free delayed frees from other threads
+ _mi_heap_delayed_free(heap);
+
+ // find (or allocate) a page of the right size
+ mi_page_t* page = mi_find_page(heap, size);
+ if (mi_unlikely(page == NULL)) { // first time out of memory, try to collect and retry the allocation once more
+ mi_heap_collect(heap, true /* force */);
+ page = mi_find_page(heap, size);
+ }
+
+ if (mi_unlikely(page == NULL)) { // out of memory
+ const size_t req_size = size - MI_PADDING_SIZE; // correct for padding_size in case of an overflow on `size`
+ _mi_error_message(ENOMEM, "unable to allocate memory (%zu bytes)\n", req_size);
+ return NULL;
+ }
+
+ mi_assert_internal(mi_page_immediate_available(page));
+ mi_assert_internal(mi_page_block_size(page) >= size);
+
+ // and try again, this time succeeding! (i.e. this should never recurse)
+ return _mi_page_malloc(heap, page, size);
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/random.c b/source/luametatex/source/libraries/mimalloc/src/random.c
new file mode 100644
index 000000000..d474a53a0
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/random.c
@@ -0,0 +1,367 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2019-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#ifndef _DEFAULT_SOURCE
+#define _DEFAULT_SOURCE // for syscall() on Linux
+#endif
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+
+#include <string.h> // memset
+
+/* ----------------------------------------------------------------------------
+We use our own PRNG to keep predictable performance of random number generation
+and to avoid implementations that use a lock. We only use the OS provided
+random source to initialize the initial seeds. Since we do not need ultimate
+performance but we do rely on the security (for secret cookies in secure mode)
+we use a cryptographically secure generator (chacha20).
+-----------------------------------------------------------------------------*/
+
+#define MI_CHACHA_ROUNDS (20) // perhaps use 12 for better performance?
+
+
+/* ----------------------------------------------------------------------------
+Chacha20 implementation as the original algorithm with a 64-bit nonce
+and counter: https://en.wikipedia.org/wiki/Salsa20
+The input matrix has sixteen 32-bit values:
+Position 0 to 3: constant key
+Position 4 to 11: the key
+Position 12 to 13: the counter.
+Position 14 to 15: the nonce.
+
+The implementation uses regular C code which compiles very well on modern compilers.
+(gcc x64 has no register spills, and clang 6+ uses SSE instructions)
+-----------------------------------------------------------------------------*/
+
+static inline uint32_t rotl(uint32_t x, uint32_t shift) {
+ return (x << shift) | (x >> (32 - shift));
+}
+
+static inline void qround(uint32_t x[16], size_t a, size_t b, size_t c, size_t d) {
+ x[a] += x[b]; x[d] = rotl(x[d] ^ x[a], 16);
+ x[c] += x[d]; x[b] = rotl(x[b] ^ x[c], 12);
+ x[a] += x[b]; x[d] = rotl(x[d] ^ x[a], 8);
+ x[c] += x[d]; x[b] = rotl(x[b] ^ x[c], 7);
+}
+
+static void chacha_block(mi_random_ctx_t* ctx)
+{
+ // scramble into `x`
+ uint32_t x[16];
+ for (size_t i = 0; i < 16; i++) {
+ x[i] = ctx->input[i];
+ }
+ for (size_t i = 0; i < MI_CHACHA_ROUNDS; i += 2) {
+ qround(x, 0, 4, 8, 12);
+ qround(x, 1, 5, 9, 13);
+ qround(x, 2, 6, 10, 14);
+ qround(x, 3, 7, 11, 15);
+ qround(x, 0, 5, 10, 15);
+ qround(x, 1, 6, 11, 12);
+ qround(x, 2, 7, 8, 13);
+ qround(x, 3, 4, 9, 14);
+ }
+
+ // add scrambled data to the initial state
+ for (size_t i = 0; i < 16; i++) {
+ ctx->output[i] = x[i] + ctx->input[i];
+ }
+ ctx->output_available = 16;
+
+ // increment the counter for the next round
+ ctx->input[12] += 1;
+ if (ctx->input[12] == 0) {
+ ctx->input[13] += 1;
+ if (ctx->input[13] == 0) { // and keep increasing into the nonce
+ ctx->input[14] += 1;
+ }
+ }
+}
+
+static uint32_t chacha_next32(mi_random_ctx_t* ctx) {
+ if (ctx->output_available <= 0) {
+ chacha_block(ctx);
+ ctx->output_available = 16; // (assign again to suppress static analysis warning)
+ }
+ const uint32_t x = ctx->output[16 - ctx->output_available];
+ ctx->output[16 - ctx->output_available] = 0; // reset once the data is handed out
+ ctx->output_available--;
+ return x;
+}
+
+static inline uint32_t read32(const uint8_t* p, size_t idx32) {
+ const size_t i = 4*idx32;
+ return ((uint32_t)p[i+0] | (uint32_t)p[i+1] << 8 | (uint32_t)p[i+2] << 16 | (uint32_t)p[i+3] << 24);
+}
+
+static void chacha_init(mi_random_ctx_t* ctx, const uint8_t key[32], uint64_t nonce)
+{
+ // since we only use chacha for randomness (and not encryption) we
+ // do not _need_ to read 32-bit values as little endian but we do anyways
+ // just for being compatible :-)
+ memset(ctx, 0, sizeof(*ctx));
+ for (size_t i = 0; i < 4; i++) {
+ const uint8_t* sigma = (uint8_t*)"expand 32-byte k";
+ ctx->input[i] = read32(sigma,i);
+ }
+ for (size_t i = 0; i < 8; i++) {
+ ctx->input[i + 4] = read32(key,i);
+ }
+ ctx->input[12] = 0;
+ ctx->input[13] = 0;
+ ctx->input[14] = (uint32_t)nonce;
+ ctx->input[15] = (uint32_t)(nonce >> 32);
+}
+
+static void chacha_split(mi_random_ctx_t* ctx, uint64_t nonce, mi_random_ctx_t* ctx_new) {
+ memset(ctx_new, 0, sizeof(*ctx_new));
+ _mi_memcpy(ctx_new->input, ctx->input, sizeof(ctx_new->input));
+ ctx_new->input[12] = 0;
+ ctx_new->input[13] = 0;
+ ctx_new->input[14] = (uint32_t)nonce;
+ ctx_new->input[15] = (uint32_t)(nonce >> 32);
+ mi_assert_internal(ctx->input[14] != ctx_new->input[14] || ctx->input[15] != ctx_new->input[15]); // do not reuse nonces!
+ chacha_block(ctx_new);
+}
+
+
+/* ----------------------------------------------------------------------------
+Random interface
+-----------------------------------------------------------------------------*/
+
+#if MI_DEBUG>1
+static bool mi_random_is_initialized(mi_random_ctx_t* ctx) {
+ return (ctx != NULL && ctx->input[0] != 0);
+}
+#endif
+
+void _mi_random_split(mi_random_ctx_t* ctx, mi_random_ctx_t* ctx_new) {
+ mi_assert_internal(mi_random_is_initialized(ctx));
+ mi_assert_internal(ctx != ctx_new);
+ chacha_split(ctx, (uintptr_t)ctx_new /*nonce*/, ctx_new);
+}
+
+uintptr_t _mi_random_next(mi_random_ctx_t* ctx) {
+ mi_assert_internal(mi_random_is_initialized(ctx));
+ #if MI_INTPTR_SIZE <= 4
+ return chacha_next32(ctx);
+ #elif MI_INTPTR_SIZE == 8
+ return (((uintptr_t)chacha_next32(ctx) << 32) | chacha_next32(ctx));
+ #else
+ # error "define mi_random_next for this platform"
+ #endif
+}
+
+
+/* ----------------------------------------------------------------------------
+To initialize a fresh random context we rely on the OS:
+- Windows : BCryptGenRandom (or RtlGenRandom)
+- macOS : CCRandomGenerateBytes, arc4random_buf
+- bsd,wasi : arc4random_buf
+- Linux : getrandom,/dev/urandom
+If we cannot get good randomness, we fall back to weak randomness based on a timer and ASLR.
+-----------------------------------------------------------------------------*/
+
+#if defined(_WIN32)
+
+#if defined(MI_USE_RTLGENRANDOM) || defined(__cplusplus)
+// We prefer to use BCryptGenRandom instead of (the unofficial) RtlGenRandom but when using
+// dynamic overriding, we observed it can raise an exception when compiled with C++, and
+// sometimes deadlocks when also running under the VS debugger.
+#pragma comment (lib,"advapi32.lib")
+#define RtlGenRandom SystemFunction036
+#ifdef __cplusplus
+extern "C" {
+#endif
+BOOLEAN NTAPI RtlGenRandom(PVOID RandomBuffer, ULONG RandomBufferLength);
+#ifdef __cplusplus
+}
+#endif
+static bool os_random_buf(void* buf, size_t buf_len) {
+ return (RtlGenRandom(buf, (ULONG)buf_len) != 0);
+}
+#else
+#pragma comment (lib,"bcrypt.lib")
+#include <bcrypt.h>
+static bool os_random_buf(void* buf, size_t buf_len) {
+ return (BCryptGenRandom(NULL, (PUCHAR)buf, (ULONG)buf_len, BCRYPT_USE_SYSTEM_PREFERRED_RNG) >= 0);
+}
+#endif
+
+#elif defined(__APPLE__)
+#include <AvailabilityMacros.h>
+#if defined(MAC_OS_X_VERSION_10_10) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_10
+#include <CommonCrypto/CommonCryptoError.h>
+#include <CommonCrypto/CommonRandom.h>
+#endif
+static bool os_random_buf(void* buf, size_t buf_len) {
+ #if defined(MAC_OS_X_VERSION_10_15) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_15
+ // We prefere CCRandomGenerateBytes as it returns an error code while arc4random_buf
+ // may fail silently on macOS. See PR #390, and <https://opensource.apple.com/source/Libc/Libc-1439.40.11/gen/FreeBSD/arc4random.c.auto.html>
+ return (CCRandomGenerateBytes(buf, buf_len) == kCCSuccess);
+ #else
+ // fall back on older macOS
+ arc4random_buf(buf, buf_len);
+ return true;
+ #endif
+}
+
+#elif defined(__ANDROID__) || defined(__DragonFly__) || \
+ defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || \
+ defined(__sun) // todo: what to use with __wasi__?
+#include <stdlib.h>
+static bool os_random_buf(void* buf, size_t buf_len) {
+ arc4random_buf(buf, buf_len);
+ return true;
+}
+#elif defined(__linux__) || defined(__HAIKU__)
+#if defined(__linux__)
+#include <sys/syscall.h>
+#endif
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <errno.h>
+static bool os_random_buf(void* buf, size_t buf_len) {
+ // Modern Linux provides `getrandom` but different distributions either use `sys/random.h` or `linux/random.h`
+ // and for the latter the actual `getrandom` call is not always defined.
+ // (see <https://stackoverflow.com/questions/45237324/why-doesnt-getrandom-compile>)
+ // We therefore use a syscall directly and fall back dynamically to /dev/urandom when needed.
+#ifdef SYS_getrandom
+ #ifndef GRND_NONBLOCK
+ #define GRND_NONBLOCK (1)
+ #endif
+ static _Atomic(uintptr_t) no_getrandom; // = 0
+ if (mi_atomic_load_acquire(&no_getrandom)==0) {
+ ssize_t ret = syscall(SYS_getrandom, buf, buf_len, GRND_NONBLOCK);
+ if (ret >= 0) return (buf_len == (size_t)ret);
+ if (errno != ENOSYS) return false;
+ mi_atomic_store_release(&no_getrandom, 1UL); // don't call again, and fall back to /dev/urandom
+ }
+#endif
+ int flags = O_RDONLY;
+ #if defined(O_CLOEXEC)
+ flags |= O_CLOEXEC;
+ #endif
+ int fd = open("/dev/urandom", flags, 0);
+ if (fd < 0) return false;
+ size_t count = 0;
+ while(count < buf_len) {
+ ssize_t ret = read(fd, (char*)buf + count, buf_len - count);
+ if (ret<=0) {
+ if (errno!=EAGAIN && errno!=EINTR) break;
+ }
+ else {
+ count += ret;
+ }
+ }
+ close(fd);
+ return (count==buf_len);
+}
+#else
+static bool os_random_buf(void* buf, size_t buf_len) {
+ return false;
+}
+#endif
+
+#if defined(_WIN32)
+#include <windows.h>
+#elif defined(__APPLE__)
+#include <mach/mach_time.h>
+#else
+#include <time.h>
+#endif
+
+uintptr_t _mi_os_random_weak(uintptr_t extra_seed) {
+ uintptr_t x = (uintptr_t)&_mi_os_random_weak ^ extra_seed; // ASLR makes the address random
+
+ #if defined(_WIN32)
+ LARGE_INTEGER pcount;
+ QueryPerformanceCounter(&pcount);
+ x ^= (uintptr_t)(pcount.QuadPart);
+ #elif defined(__APPLE__)
+ x ^= (uintptr_t)mach_absolute_time();
+ #else
+ struct timespec time;
+ clock_gettime(CLOCK_MONOTONIC, &time);
+ x ^= (uintptr_t)time.tv_sec;
+ x ^= (uintptr_t)time.tv_nsec;
+ #endif
+ // and do a few randomization steps
+ uintptr_t max = ((x ^ (x >> 17)) & 0x0F) + 1;
+ for (uintptr_t i = 0; i < max; i++) {
+ x = _mi_random_shuffle(x);
+ }
+ mi_assert_internal(x != 0);
+ return x;
+}
+
+void _mi_random_init(mi_random_ctx_t* ctx) {
+ uint8_t key[32];
+ if (!os_random_buf(key, sizeof(key))) {
+ // if we fail to get random data from the OS, we fall back to a
+ // weak random source based on the current time
+ #if !defined(__wasi__)
+ _mi_warning_message("unable to use secure randomness\n");
+ #endif
+ uintptr_t x = _mi_os_random_weak(0);
+ for (size_t i = 0; i < 8; i++) { // key is eight 32-bit words.
+ x = _mi_random_shuffle(x);
+ ((uint32_t*)key)[i] = (uint32_t)x;
+ }
+ }
+ chacha_init(ctx, key, (uintptr_t)ctx /*nonce*/ );
+}
+
+/* --------------------------------------------------------
+test vectors from <https://tools.ietf.org/html/rfc8439>
+----------------------------------------------------------- */
+/*
+static bool array_equals(uint32_t* x, uint32_t* y, size_t n) {
+ for (size_t i = 0; i < n; i++) {
+ if (x[i] != y[i]) return false;
+ }
+ return true;
+}
+static void chacha_test(void)
+{
+ uint32_t x[4] = { 0x11111111, 0x01020304, 0x9b8d6f43, 0x01234567 };
+ uint32_t x_out[4] = { 0xea2a92f4, 0xcb1cf8ce, 0x4581472e, 0x5881c4bb };
+ qround(x, 0, 1, 2, 3);
+ mi_assert_internal(array_equals(x, x_out, 4));
+
+ uint32_t y[16] = {
+ 0x879531e0, 0xc5ecf37d, 0x516461b1, 0xc9a62f8a,
+ 0x44c20ef3, 0x3390af7f, 0xd9fc690b, 0x2a5f714c,
+ 0x53372767, 0xb00a5631, 0x974c541a, 0x359e9963,
+ 0x5c971061, 0x3d631689, 0x2098d9d6, 0x91dbd320 };
+ uint32_t y_out[16] = {
+ 0x879531e0, 0xc5ecf37d, 0xbdb886dc, 0xc9a62f8a,
+ 0x44c20ef3, 0x3390af7f, 0xd9fc690b, 0xcfacafd2,
+ 0xe46bea80, 0xb00a5631, 0x974c541a, 0x359e9963,
+ 0x5c971061, 0xccc07c79, 0x2098d9d6, 0x91dbd320 };
+ qround(y, 2, 7, 8, 13);
+ mi_assert_internal(array_equals(y, y_out, 16));
+
+ mi_random_ctx_t r = {
+ { 0x61707865, 0x3320646e, 0x79622d32, 0x6b206574,
+ 0x03020100, 0x07060504, 0x0b0a0908, 0x0f0e0d0c,
+ 0x13121110, 0x17161514, 0x1b1a1918, 0x1f1e1d1c,
+ 0x00000001, 0x09000000, 0x4a000000, 0x00000000 },
+ {0},
+ 0
+ };
+ uint32_t r_out[16] = {
+ 0xe4e7f110, 0x15593bd1, 0x1fdd0f50, 0xc47120a3,
+ 0xc7f4d1c7, 0x0368c033, 0x9aaa2204, 0x4e6cd4c3,
+ 0x466482d2, 0x09aa9f07, 0x05d7c214, 0xa2028bd9,
+ 0xd19c12b5, 0xb94e16de, 0xe883d0cb, 0x4e3c50a2 };
+ chacha_block(&r);
+ mi_assert_internal(array_equals(r.output, r_out, 16));
+}
+*/
diff --git a/source/luametatex/source/libraries/mimalloc/src/region.c b/source/luametatex/source/libraries/mimalloc/src/region.c
new file mode 100644
index 000000000..72ce84947
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/region.c
@@ -0,0 +1,505 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2019-2020, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* ----------------------------------------------------------------------------
+This implements a layer between the raw OS memory (VirtualAlloc/mmap/sbrk/..)
+and the segment and huge object allocation by mimalloc. There may be multiple
+implementations of this (one could be the identity going directly to the OS,
+another could be a simple cache etc), but the current one uses large "regions".
+In contrast to the rest of mimalloc, the "regions" are shared between threads and
+need to be accessed using atomic operations.
+We need this memory layer between the raw OS calls because of:
+1. on `sbrk` like systems (like WebAssembly) we need our own memory maps in order
+ to reuse memory effectively.
+2. It turns out that for large objects, between 1MiB and 32MiB (?), the cost of
+ an OS allocation/free is still (much) too expensive relative to the accesses
+ in that object :-( (`malloc-large` tests this). This means we need a cheaper
+ way to reuse memory.
+3. This layer allows for NUMA aware allocation.
+
+Possible issues:
+- (2) can potentially be addressed too with a small cache per thread which is much
+ simpler. Generally though that requires shrinking of huge pages, and may overuse
+ memory per thread. (and is not compatible with `sbrk`).
+- Since the current regions are per-process, we need atomic operations to
+ claim blocks which may be contended
+- In the worst case, we need to search the whole region map (16KiB for 256GiB)
+ linearly. At what point will direct OS calls be faster? Is there a way to
+ do this better without adding too much complexity?
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <string.h> // memset
+
+#include "bitmap.h"
+
+// Internal raw OS interface
+size_t _mi_os_large_page_size(void);
+bool _mi_os_protect(void* addr, size_t size);
+bool _mi_os_unprotect(void* addr, size_t size);
+bool _mi_os_commit(void* p, size_t size, bool* is_zero, mi_stats_t* stats);
+bool _mi_os_decommit(void* p, size_t size, mi_stats_t* stats);
+bool _mi_os_reset(void* p, size_t size, mi_stats_t* stats);
+bool _mi_os_unreset(void* p, size_t size, bool* is_zero, mi_stats_t* stats);
+
+// arena.c
+void _mi_arena_free(void* p, size_t size, size_t memid, bool all_committed, mi_stats_t* stats);
+void* _mi_arena_alloc(size_t size, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld);
+void* _mi_arena_alloc_aligned(size_t size, size_t alignment, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld);
+
+
+
+// Constants
+#if (MI_INTPTR_SIZE==8)
+#define MI_HEAP_REGION_MAX_SIZE (256 * MI_GiB) // 64KiB for the region map
+#elif (MI_INTPTR_SIZE==4)
+#define MI_HEAP_REGION_MAX_SIZE (3 * MI_GiB) // ~ KiB for the region map
+#else
+#error "define the maximum heap space allowed for regions on this platform"
+#endif
+
+#define MI_SEGMENT_ALIGN MI_SEGMENT_SIZE
+
+#define MI_REGION_MAX_BLOCKS MI_BITMAP_FIELD_BITS
+#define MI_REGION_SIZE (MI_SEGMENT_SIZE * MI_BITMAP_FIELD_BITS) // 256MiB (64MiB on 32 bits)
+#define MI_REGION_MAX (MI_HEAP_REGION_MAX_SIZE / MI_REGION_SIZE) // 1024 (48 on 32 bits)
+#define MI_REGION_MAX_OBJ_BLOCKS (MI_REGION_MAX_BLOCKS/4) // 64MiB
+#define MI_REGION_MAX_OBJ_SIZE (MI_REGION_MAX_OBJ_BLOCKS*MI_SEGMENT_SIZE)
+
+// Region info
+typedef union mi_region_info_u {
+ size_t value;
+ struct {
+ bool valid; // initialized?
+ bool is_large:1; // allocated in fixed large/huge OS pages
+ bool is_pinned:1; // pinned memory cannot be decommitted
+ short numa_node; // the associated NUMA node (where -1 means no associated node)
+ } x;
+} mi_region_info_t;
+
+
+// A region owns a chunk of REGION_SIZE (256MiB) (virtual) memory with
+// a bit map with one bit per MI_SEGMENT_SIZE (4MiB) block.
+typedef struct mem_region_s {
+ _Atomic(size_t) info; // mi_region_info_t.value
+ _Atomic(void*) start; // start of the memory area
+ mi_bitmap_field_t in_use; // bit per in-use block
+ mi_bitmap_field_t dirty; // track if non-zero per block
+ mi_bitmap_field_t commit; // track if committed per block
+ mi_bitmap_field_t reset; // track if reset per block
+ _Atomic(size_t) arena_memid; // if allocated from a (huge page) arena
+ _Atomic(size_t) padding; // round to 8 fields (needs to be atomic for msvc, see issue #508)
+} mem_region_t;
+
+// The region map
+static mem_region_t regions[MI_REGION_MAX];
+
+// Allocated regions
+static _Atomic(size_t) regions_count; // = 0;
+
+
+/* ----------------------------------------------------------------------------
+Utility functions
+-----------------------------------------------------------------------------*/
+
+// Blocks (of 4MiB) needed for the given size.
+static size_t mi_region_block_count(size_t size) {
+ return _mi_divide_up(size, MI_SEGMENT_SIZE);
+}
+
+/*
+// Return a rounded commit/reset size such that we don't fragment large OS pages into small ones.
+static size_t mi_good_commit_size(size_t size) {
+ if (size > (SIZE_MAX - _mi_os_large_page_size())) return size;
+ return _mi_align_up(size, _mi_os_large_page_size());
+}
+*/
+
+// Return if a pointer points into a region reserved by us.
+mi_decl_nodiscard bool mi_is_in_heap_region(const void* p) mi_attr_noexcept {
+ if (p==NULL) return false;
+ size_t count = mi_atomic_load_relaxed(&regions_count);
+ for (size_t i = 0; i < count; i++) {
+ uint8_t* start = (uint8_t*)mi_atomic_load_ptr_relaxed(uint8_t, &regions[i].start);
+ if (start != NULL && (uint8_t*)p >= start && (uint8_t*)p < start + MI_REGION_SIZE) return true;
+ }
+ return false;
+}
+
+
+static void* mi_region_blocks_start(const mem_region_t* region, mi_bitmap_index_t bit_idx) {
+ uint8_t* start = (uint8_t*)mi_atomic_load_ptr_acquire(uint8_t, &((mem_region_t*)region)->start);
+ mi_assert_internal(start != NULL);
+ return (start + (bit_idx * MI_SEGMENT_SIZE));
+}
+
+static size_t mi_memid_create(mem_region_t* region, mi_bitmap_index_t bit_idx) {
+ mi_assert_internal(bit_idx < MI_BITMAP_FIELD_BITS);
+ size_t idx = region - regions;
+ mi_assert_internal(&regions[idx] == region);
+ return (idx*MI_BITMAP_FIELD_BITS + bit_idx)<<1;
+}
+
+static size_t mi_memid_create_from_arena(size_t arena_memid) {
+ return (arena_memid << 1) | 1;
+}
+
+
+static bool mi_memid_is_arena(size_t id, mem_region_t** region, mi_bitmap_index_t* bit_idx, size_t* arena_memid) {
+ if ((id&1)==1) {
+ if (arena_memid != NULL) *arena_memid = (id>>1);
+ return true;
+ }
+ else {
+ size_t idx = (id >> 1) / MI_BITMAP_FIELD_BITS;
+ *bit_idx = (mi_bitmap_index_t)(id>>1) % MI_BITMAP_FIELD_BITS;
+ *region = &regions[idx];
+ return false;
+ }
+}
+
+
+/* ----------------------------------------------------------------------------
+ Allocate a region is allocated from the OS (or an arena)
+-----------------------------------------------------------------------------*/
+
+static bool mi_region_try_alloc_os(size_t blocks, bool commit, bool allow_large, mem_region_t** region, mi_bitmap_index_t* bit_idx, mi_os_tld_t* tld)
+{
+ // not out of regions yet?
+ if (mi_atomic_load_relaxed(&regions_count) >= MI_REGION_MAX - 1) return false;
+
+ // try to allocate a fresh region from the OS
+ bool region_commit = (commit && mi_option_is_enabled(mi_option_eager_region_commit));
+ bool region_large = (commit && allow_large);
+ bool is_zero = false;
+ bool is_pinned = false;
+ size_t arena_memid = 0;
+ void* const start = _mi_arena_alloc_aligned(MI_REGION_SIZE, MI_SEGMENT_ALIGN, &region_commit, &region_large, &is_pinned, &is_zero, &arena_memid, tld);
+ if (start == NULL) return false;
+ mi_assert_internal(!(region_large && !allow_large));
+ mi_assert_internal(!region_large || region_commit);
+
+ // claim a fresh slot
+ const size_t idx = mi_atomic_increment_acq_rel(&regions_count);
+ if (idx >= MI_REGION_MAX) {
+ mi_atomic_decrement_acq_rel(&regions_count);
+ _mi_arena_free(start, MI_REGION_SIZE, arena_memid, region_commit, tld->stats);
+ _mi_warning_message("maximum regions used: %zu GiB (perhaps recompile with a larger setting for MI_HEAP_REGION_MAX_SIZE)", _mi_divide_up(MI_HEAP_REGION_MAX_SIZE, MI_GiB));
+ return false;
+ }
+
+ // allocated, initialize and claim the initial blocks
+ mem_region_t* r = &regions[idx];
+ r->arena_memid = arena_memid;
+ mi_atomic_store_release(&r->in_use, (size_t)0);
+ mi_atomic_store_release(&r->dirty, (is_zero ? 0 : MI_BITMAP_FIELD_FULL));
+ mi_atomic_store_release(&r->commit, (region_commit ? MI_BITMAP_FIELD_FULL : 0));
+ mi_atomic_store_release(&r->reset, (size_t)0);
+ *bit_idx = 0;
+ _mi_bitmap_claim(&r->in_use, 1, blocks, *bit_idx, NULL);
+ mi_atomic_store_ptr_release(void,&r->start, start);
+
+ // and share it
+ mi_region_info_t info;
+ info.value = 0; // initialize the full union to zero
+ info.x.valid = true;
+ info.x.is_large = region_large;
+ info.x.is_pinned = is_pinned;
+ info.x.numa_node = (short)_mi_os_numa_node(tld);
+ mi_atomic_store_release(&r->info, info.value); // now make it available to others
+ *region = r;
+ return true;
+}
+
+/* ----------------------------------------------------------------------------
+ Try to claim blocks in suitable regions
+-----------------------------------------------------------------------------*/
+
+static bool mi_region_is_suitable(const mem_region_t* region, int numa_node, bool allow_large ) {
+ // initialized at all?
+ mi_region_info_t info;
+ info.value = mi_atomic_load_relaxed(&((mem_region_t*)region)->info);
+ if (info.value==0) return false;
+
+ // numa correct
+ if (numa_node >= 0) { // use negative numa node to always succeed
+ int rnode = info.x.numa_node;
+ if (rnode >= 0 && rnode != numa_node) return false;
+ }
+
+ // check allow-large
+ if (!allow_large && info.x.is_large) return false;
+
+ return true;
+}
+
+
+static bool mi_region_try_claim(int numa_node, size_t blocks, bool allow_large, mem_region_t** region, mi_bitmap_index_t* bit_idx, mi_os_tld_t* tld)
+{
+ // try all regions for a free slot
+ const size_t count = mi_atomic_load_relaxed(&regions_count); // monotonic, so ok to be relaxed
+ size_t idx = tld->region_idx; // Or start at 0 to reuse low addresses? Starting at 0 seems to increase latency though
+ for (size_t visited = 0; visited < count; visited++, idx++) {
+ if (idx >= count) idx = 0; // wrap around
+ mem_region_t* r = &regions[idx];
+ // if this region suits our demand (numa node matches, large OS page matches)
+ if (mi_region_is_suitable(r, numa_node, allow_large)) {
+ // then try to atomically claim a segment(s) in this region
+ if (_mi_bitmap_try_find_claim_field(&r->in_use, 0, blocks, bit_idx)) {
+ tld->region_idx = idx; // remember the last found position
+ *region = r;
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+
+static void* mi_region_try_alloc(size_t blocks, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld)
+{
+ mi_assert_internal(blocks <= MI_BITMAP_FIELD_BITS);
+ mem_region_t* region;
+ mi_bitmap_index_t bit_idx;
+ const int numa_node = (_mi_os_numa_node_count() <= 1 ? -1 : _mi_os_numa_node(tld));
+ // try to claim in existing regions
+ if (!mi_region_try_claim(numa_node, blocks, *large, &region, &bit_idx, tld)) {
+ // otherwise try to allocate a fresh region and claim in there
+ if (!mi_region_try_alloc_os(blocks, *commit, *large, &region, &bit_idx, tld)) {
+ // out of regions or memory
+ return NULL;
+ }
+ }
+
+ // ------------------------------------------------
+ // found a region and claimed `blocks` at `bit_idx`, initialize them now
+ mi_assert_internal(region != NULL);
+ mi_assert_internal(_mi_bitmap_is_claimed(&region->in_use, 1, blocks, bit_idx));
+
+ mi_region_info_t info;
+ info.value = mi_atomic_load_acquire(&region->info);
+ uint8_t* start = (uint8_t*)mi_atomic_load_ptr_acquire(uint8_t,&region->start);
+ mi_assert_internal(!(info.x.is_large && !*large));
+ mi_assert_internal(start != NULL);
+
+ *is_zero = _mi_bitmap_claim(&region->dirty, 1, blocks, bit_idx, NULL);
+ *large = info.x.is_large;
+ *is_pinned = info.x.is_pinned;
+ *memid = mi_memid_create(region, bit_idx);
+ void* p = start + (mi_bitmap_index_bit_in_field(bit_idx) * MI_SEGMENT_SIZE);
+
+ // commit
+ if (*commit) {
+ // ensure commit
+ bool any_uncommitted;
+ _mi_bitmap_claim(&region->commit, 1, blocks, bit_idx, &any_uncommitted);
+ if (any_uncommitted) {
+ mi_assert_internal(!info.x.is_large && !info.x.is_pinned);
+ bool commit_zero = false;
+ if (!_mi_mem_commit(p, blocks * MI_SEGMENT_SIZE, &commit_zero, tld)) {
+ // failed to commit! unclaim and return
+ mi_bitmap_unclaim(&region->in_use, 1, blocks, bit_idx);
+ return NULL;
+ }
+ if (commit_zero) *is_zero = true;
+ }
+ }
+ else {
+ // no need to commit, but check if already fully committed
+ *commit = _mi_bitmap_is_claimed(&region->commit, 1, blocks, bit_idx);
+ }
+ mi_assert_internal(!*commit || _mi_bitmap_is_claimed(&region->commit, 1, blocks, bit_idx));
+
+ // unreset reset blocks
+ if (_mi_bitmap_is_any_claimed(&region->reset, 1, blocks, bit_idx)) {
+ // some blocks are still reset
+ mi_assert_internal(!info.x.is_large && !info.x.is_pinned);
+ mi_assert_internal(!mi_option_is_enabled(mi_option_eager_commit) || *commit || mi_option_get(mi_option_eager_commit_delay) > 0);
+ mi_bitmap_unclaim(&region->reset, 1, blocks, bit_idx);
+ if (*commit || !mi_option_is_enabled(mi_option_reset_decommits)) { // only if needed
+ bool reset_zero = false;
+ _mi_mem_unreset(p, blocks * MI_SEGMENT_SIZE, &reset_zero, tld);
+ if (reset_zero) *is_zero = true;
+ }
+ }
+ mi_assert_internal(!_mi_bitmap_is_any_claimed(&region->reset, 1, blocks, bit_idx));
+
+ #if (MI_DEBUG>=2)
+ if (*commit) { ((uint8_t*)p)[0] = 0; }
+ #endif
+
+ // and return the allocation
+ mi_assert_internal(p != NULL);
+ return p;
+}
+
+
+/* ----------------------------------------------------------------------------
+ Allocation
+-----------------------------------------------------------------------------*/
+
+// Allocate `size` memory aligned at `alignment`. Return non NULL on success, with a given memory `id`.
+// (`id` is abstract, but `id = idx*MI_REGION_MAP_BITS + bitidx`)
+void* _mi_mem_alloc_aligned(size_t size, size_t alignment, bool* commit, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld)
+{
+ mi_assert_internal(memid != NULL && tld != NULL);
+ mi_assert_internal(size > 0);
+ *memid = 0;
+ *is_zero = false;
+ *is_pinned = false;
+ bool default_large = false;
+ if (large==NULL) large = &default_large; // ensure `large != NULL`
+ if (size == 0) return NULL;
+ size = _mi_align_up(size, _mi_os_page_size());
+
+ // allocate from regions if possible
+ void* p = NULL;
+ size_t arena_memid;
+ const size_t blocks = mi_region_block_count(size);
+ if (blocks <= MI_REGION_MAX_OBJ_BLOCKS && alignment <= MI_SEGMENT_ALIGN) {
+ p = mi_region_try_alloc(blocks, commit, large, is_pinned, is_zero, memid, tld);
+ if (p == NULL) {
+ _mi_warning_message("unable to allocate from region: size %zu\n", size);
+ }
+ }
+ if (p == NULL) {
+ // and otherwise fall back to the OS
+ p = _mi_arena_alloc_aligned(size, alignment, commit, large, is_pinned, is_zero, &arena_memid, tld);
+ *memid = mi_memid_create_from_arena(arena_memid);
+ }
+
+ if (p != NULL) {
+ mi_assert_internal((uintptr_t)p % alignment == 0);
+#if (MI_DEBUG>=2)
+ if (*commit) { ((uint8_t*)p)[0] = 0; } // ensure the memory is committed
+#endif
+ }
+ return p;
+}
+
+
+
+/* ----------------------------------------------------------------------------
+Free
+-----------------------------------------------------------------------------*/
+
+// Free previously allocated memory with a given id.
+void _mi_mem_free(void* p, size_t size, size_t id, bool full_commit, bool any_reset, mi_os_tld_t* tld) {
+ mi_assert_internal(size > 0 && tld != NULL);
+ if (p==NULL) return;
+ if (size==0) return;
+ size = _mi_align_up(size, _mi_os_page_size());
+
+ size_t arena_memid = 0;
+ mi_bitmap_index_t bit_idx;
+ mem_region_t* region;
+ if (mi_memid_is_arena(id,&region,&bit_idx,&arena_memid)) {
+ // was a direct arena allocation, pass through
+ _mi_arena_free(p, size, arena_memid, full_commit, tld->stats);
+ }
+ else {
+ // allocated in a region
+ mi_assert_internal(size <= MI_REGION_MAX_OBJ_SIZE); if (size > MI_REGION_MAX_OBJ_SIZE) return;
+ const size_t blocks = mi_region_block_count(size);
+ mi_assert_internal(blocks + bit_idx <= MI_BITMAP_FIELD_BITS);
+ mi_region_info_t info;
+ info.value = mi_atomic_load_acquire(&region->info);
+ mi_assert_internal(info.value != 0);
+ void* blocks_start = mi_region_blocks_start(region, bit_idx);
+ mi_assert_internal(blocks_start == p); // not a pointer in our area?
+ mi_assert_internal(bit_idx + blocks <= MI_BITMAP_FIELD_BITS);
+ if (blocks_start != p || bit_idx + blocks > MI_BITMAP_FIELD_BITS) return; // or `abort`?
+
+ // committed?
+ if (full_commit && (size % MI_SEGMENT_SIZE) == 0) {
+ _mi_bitmap_claim(&region->commit, 1, blocks, bit_idx, NULL);
+ }
+
+ if (any_reset) {
+ // set the is_reset bits if any pages were reset
+ _mi_bitmap_claim(&region->reset, 1, blocks, bit_idx, NULL);
+ }
+
+ // reset the blocks to reduce the working set.
+ if (!info.x.is_large && !info.x.is_pinned && mi_option_is_enabled(mi_option_segment_reset)
+ && (mi_option_is_enabled(mi_option_eager_commit) ||
+ mi_option_is_enabled(mi_option_reset_decommits))) // cannot reset halfway committed segments, use only `option_page_reset` instead
+ {
+ bool any_unreset;
+ _mi_bitmap_claim(&region->reset, 1, blocks, bit_idx, &any_unreset);
+ if (any_unreset) {
+ _mi_abandoned_await_readers(); // ensure no more pending write (in case reset = decommit)
+ _mi_mem_reset(p, blocks * MI_SEGMENT_SIZE, tld);
+ }
+ }
+
+ // and unclaim
+ bool all_unclaimed = mi_bitmap_unclaim(&region->in_use, 1, blocks, bit_idx);
+ mi_assert_internal(all_unclaimed); MI_UNUSED(all_unclaimed);
+ }
+}
+
+
+/* ----------------------------------------------------------------------------
+ collection
+-----------------------------------------------------------------------------*/
+void _mi_mem_collect(mi_os_tld_t* tld) {
+ // free every region that has no segments in use.
+ size_t rcount = mi_atomic_load_relaxed(&regions_count);
+ for (size_t i = 0; i < rcount; i++) {
+ mem_region_t* region = &regions[i];
+ if (mi_atomic_load_relaxed(&region->info) != 0) {
+ // if no segments used, try to claim the whole region
+ size_t m = mi_atomic_load_relaxed(&region->in_use);
+ while (m == 0 && !mi_atomic_cas_weak_release(&region->in_use, &m, MI_BITMAP_FIELD_FULL)) { /* nothing */ };
+ if (m == 0) {
+ // on success, free the whole region
+ uint8_t* start = (uint8_t*)mi_atomic_load_ptr_acquire(uint8_t,&regions[i].start);
+ size_t arena_memid = mi_atomic_load_relaxed(&regions[i].arena_memid);
+ size_t commit = mi_atomic_load_relaxed(&regions[i].commit);
+ memset((void*)&regions[i], 0, sizeof(mem_region_t)); // cast to void* to avoid atomic warning
+ // and release the whole region
+ mi_atomic_store_release(&region->info, (size_t)0);
+ if (start != NULL) { // && !_mi_os_is_huge_reserved(start)) {
+ _mi_abandoned_await_readers(); // ensure no pending reads
+ _mi_arena_free(start, MI_REGION_SIZE, arena_memid, (~commit == 0), tld->stats);
+ }
+ }
+ }
+ }
+}
+
+
+/* ----------------------------------------------------------------------------
+ Other
+-----------------------------------------------------------------------------*/
+
+bool _mi_mem_reset(void* p, size_t size, mi_os_tld_t* tld) {
+ return _mi_os_reset(p, size, tld->stats);
+}
+
+bool _mi_mem_unreset(void* p, size_t size, bool* is_zero, mi_os_tld_t* tld) {
+ return _mi_os_unreset(p, size, is_zero, tld->stats);
+}
+
+bool _mi_mem_commit(void* p, size_t size, bool* is_zero, mi_os_tld_t* tld) {
+ return _mi_os_commit(p, size, is_zero, tld->stats);
+}
+
+bool _mi_mem_decommit(void* p, size_t size, mi_os_tld_t* tld) {
+ return _mi_os_decommit(p, size, tld->stats);
+}
+
+bool _mi_mem_protect(void* p, size_t size) {
+ return _mi_os_protect(p, size);
+}
+
+bool _mi_mem_unprotect(void* p, size_t size) {
+ return _mi_os_unprotect(p, size);
+}
diff --git a/source/luametatex/source/libraries/mimalloc/src/segment-cache.c b/source/luametatex/source/libraries/mimalloc/src/segment-cache.c
new file mode 100644
index 000000000..aacdbc11d
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/segment-cache.c
@@ -0,0 +1,360 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2020, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+
+/* ----------------------------------------------------------------------------
+ Implements a cache of segments to avoid expensive OS calls and to reuse
+ the commit_mask to optimize the commit/decommit calls.
+ The full memory map of all segments is also implemented here.
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include "bitmap.h" // atomic bitmap
+
+//#define MI_CACHE_DISABLE 1 // define to completely disable the segment cache
+
+#define MI_CACHE_FIELDS (16)
+#define MI_CACHE_MAX (MI_BITMAP_FIELD_BITS*MI_CACHE_FIELDS) // 1024 on 64-bit
+
+#define BITS_SET() MI_ATOMIC_VAR_INIT(UINTPTR_MAX)
+#define MI_CACHE_BITS_SET MI_INIT16(BITS_SET) // note: update if MI_CACHE_FIELDS changes
+
+typedef struct mi_cache_slot_s {
+ void* p;
+ size_t memid;
+ bool is_pinned;
+ mi_commit_mask_t commit_mask;
+ mi_commit_mask_t decommit_mask;
+ _Atomic(mi_msecs_t) expire;
+} mi_cache_slot_t;
+
+static mi_decl_cache_align mi_cache_slot_t cache[MI_CACHE_MAX]; // = 0
+
+static mi_decl_cache_align mi_bitmap_field_t cache_available[MI_CACHE_FIELDS] = { MI_CACHE_BITS_SET }; // zero bit = available!
+static mi_decl_cache_align mi_bitmap_field_t cache_available_large[MI_CACHE_FIELDS] = { MI_CACHE_BITS_SET };
+static mi_decl_cache_align mi_bitmap_field_t cache_inuse[MI_CACHE_FIELDS]; // zero bit = free
+
+
+mi_decl_noinline void* _mi_segment_cache_pop(size_t size, mi_commit_mask_t* commit_mask, mi_commit_mask_t* decommit_mask, bool* large, bool* is_pinned, bool* is_zero, size_t* memid, mi_os_tld_t* tld)
+{
+#ifdef MI_CACHE_DISABLE
+ return NULL;
+#else
+
+ // only segment blocks
+ if (size != MI_SEGMENT_SIZE) return NULL;
+
+ // numa node determines start field
+ const int numa_node = _mi_os_numa_node(tld);
+ size_t start_field = 0;
+ if (numa_node > 0) {
+ start_field = (MI_CACHE_FIELDS / _mi_os_numa_node_count())*numa_node;
+ if (start_field >= MI_CACHE_FIELDS) start_field = 0;
+ }
+
+ // find an available slot
+ mi_bitmap_index_t bitidx = 0;
+ bool claimed = false;
+ if (*large) { // large allowed?
+ claimed = _mi_bitmap_try_find_from_claim(cache_available_large, MI_CACHE_FIELDS, start_field, 1, &bitidx);
+ if (claimed) *large = true;
+ }
+ if (!claimed) {
+ claimed = _mi_bitmap_try_find_from_claim(cache_available, MI_CACHE_FIELDS, start_field, 1, &bitidx);
+ if (claimed) *large = false;
+ }
+
+ if (!claimed) return NULL;
+
+ // found a slot
+ mi_cache_slot_t* slot = &cache[mi_bitmap_index_bit(bitidx)];
+ void* p = slot->p;
+ *memid = slot->memid;
+ *is_pinned = slot->is_pinned;
+ *is_zero = false;
+ *commit_mask = slot->commit_mask;
+ *decommit_mask = slot->decommit_mask;
+ slot->p = NULL;
+ mi_atomic_storei64_release(&slot->expire,(mi_msecs_t)0);
+
+ // mark the slot as free again
+ mi_assert_internal(_mi_bitmap_is_claimed(cache_inuse, MI_CACHE_FIELDS, 1, bitidx));
+ _mi_bitmap_unclaim(cache_inuse, MI_CACHE_FIELDS, 1, bitidx);
+ return p;
+#endif
+}
+
+static mi_decl_noinline void mi_commit_mask_decommit(mi_commit_mask_t* cmask, void* p, size_t total, mi_stats_t* stats)
+{
+ if (mi_commit_mask_is_empty(cmask)) {
+ // nothing
+ }
+ else if (mi_commit_mask_is_full(cmask)) {
+ _mi_os_decommit(p, total, stats);
+ }
+ else {
+ // todo: one call to decommit the whole at once?
+ mi_assert_internal((total%MI_COMMIT_MASK_BITS)==0);
+ size_t part = total/MI_COMMIT_MASK_BITS;
+ size_t idx;
+ size_t count;
+ mi_commit_mask_foreach(cmask, idx, count) {
+ void* start = (uint8_t*)p + (idx*part);
+ size_t size = count*part;
+ _mi_os_decommit(start, size, stats);
+ }
+ mi_commit_mask_foreach_end()
+ }
+ mi_commit_mask_create_empty(cmask);
+}
+
+#define MI_MAX_PURGE_PER_PUSH (4)
+
+static mi_decl_noinline void mi_segment_cache_purge(bool force, mi_os_tld_t* tld)
+{
+ MI_UNUSED(tld);
+ if (!mi_option_is_enabled(mi_option_allow_decommit)) return;
+ mi_msecs_t now = _mi_clock_now();
+ size_t purged = 0;
+ const size_t max_visits = (force ? MI_CACHE_MAX /* visit all */ : MI_CACHE_FIELDS /* probe at most N (=16) slots */);
+ size_t idx = (force ? 0 : _mi_random_shuffle((uintptr_t)now) % MI_CACHE_MAX /* random start */ );
+ for (size_t visited = 0; visited < max_visits; visited++,idx++) { // visit N slots
+ if (idx >= MI_CACHE_MAX) idx = 0; // wrap
+ mi_cache_slot_t* slot = &cache[idx];
+ mi_msecs_t expire = mi_atomic_loadi64_relaxed(&slot->expire);
+ if (expire != 0 && (force || now >= expire)) { // racy read
+ // seems expired, first claim it from available
+ purged++;
+ mi_bitmap_index_t bitidx = mi_bitmap_index_create_from_bit(idx);
+ if (_mi_bitmap_claim(cache_available, MI_CACHE_FIELDS, 1, bitidx, NULL)) {
+ // was available, we claimed it
+ expire = mi_atomic_loadi64_acquire(&slot->expire);
+ if (expire != 0 && (force || now >= expire)) { // safe read
+ // still expired, decommit it
+ mi_atomic_storei64_relaxed(&slot->expire,(mi_msecs_t)0);
+ mi_assert_internal(!mi_commit_mask_is_empty(&slot->commit_mask) && _mi_bitmap_is_claimed(cache_available_large, MI_CACHE_FIELDS, 1, bitidx));
+ _mi_abandoned_await_readers(); // wait until safe to decommit
+ // decommit committed parts
+ // TODO: instead of decommit, we could also free to the OS?
+ mi_commit_mask_decommit(&slot->commit_mask, slot->p, MI_SEGMENT_SIZE, tld->stats);
+ mi_commit_mask_create_empty(&slot->decommit_mask);
+ }
+ _mi_bitmap_unclaim(cache_available, MI_CACHE_FIELDS, 1, bitidx); // make it available again for a pop
+ }
+ if (!force && purged > MI_MAX_PURGE_PER_PUSH) break; // bound to no more than N purge tries per push
+ }
+ }
+}
+
+void _mi_segment_cache_collect(bool force, mi_os_tld_t* tld) {
+ mi_segment_cache_purge(force, tld );
+}
+
+mi_decl_noinline bool _mi_segment_cache_push(void* start, size_t size, size_t memid, const mi_commit_mask_t* commit_mask, const mi_commit_mask_t* decommit_mask, bool is_large, bool is_pinned, mi_os_tld_t* tld)
+{
+#ifdef MI_CACHE_DISABLE
+ return false;
+#else
+
+ // only for normal segment blocks
+ if (size != MI_SEGMENT_SIZE || ((uintptr_t)start % MI_SEGMENT_ALIGN) != 0) return false;
+
+ // numa node determines start field
+ int numa_node = _mi_os_numa_node(NULL);
+ size_t start_field = 0;
+ if (numa_node > 0) {
+ start_field = (MI_CACHE_FIELDS / _mi_os_numa_node_count())*numa_node;
+ if (start_field >= MI_CACHE_FIELDS) start_field = 0;
+ }
+
+ // purge expired entries
+ mi_segment_cache_purge(false /* force? */, tld);
+
+ // find an available slot
+ mi_bitmap_index_t bitidx;
+ bool claimed = _mi_bitmap_try_find_from_claim(cache_inuse, MI_CACHE_FIELDS, start_field, 1, &bitidx);
+ if (!claimed) return false;
+
+ mi_assert_internal(_mi_bitmap_is_claimed(cache_available, MI_CACHE_FIELDS, 1, bitidx));
+ mi_assert_internal(_mi_bitmap_is_claimed(cache_available_large, MI_CACHE_FIELDS, 1, bitidx));
+#if MI_DEBUG>1
+ if (is_pinned || is_large) {
+ mi_assert_internal(mi_commit_mask_is_full(commit_mask));
+ }
+#endif
+
+ // set the slot
+ mi_cache_slot_t* slot = &cache[mi_bitmap_index_bit(bitidx)];
+ slot->p = start;
+ slot->memid = memid;
+ slot->is_pinned = is_pinned;
+ mi_atomic_storei64_relaxed(&slot->expire,(mi_msecs_t)0);
+ slot->commit_mask = *commit_mask;
+ slot->decommit_mask = *decommit_mask;
+ if (!mi_commit_mask_is_empty(commit_mask) && !is_large && !is_pinned && mi_option_is_enabled(mi_option_allow_decommit)) {
+ long delay = mi_option_get(mi_option_segment_decommit_delay);
+ if (delay == 0) {
+ _mi_abandoned_await_readers(); // wait until safe to decommit
+ mi_commit_mask_decommit(&slot->commit_mask, start, MI_SEGMENT_SIZE, tld->stats);
+ mi_commit_mask_create_empty(&slot->decommit_mask);
+ }
+ else {
+ mi_atomic_storei64_release(&slot->expire, _mi_clock_now() + delay);
+ }
+ }
+
+ // make it available
+ _mi_bitmap_unclaim((is_large ? cache_available_large : cache_available), MI_CACHE_FIELDS, 1, bitidx);
+ return true;
+#endif
+}
+
+
+/* -----------------------------------------------------------
+ The following functions are to reliably find the segment or
+ block that encompasses any pointer p (or NULL if it is not
+ in any of our segments).
+ We maintain a bitmap of all memory with 1 bit per MI_SEGMENT_SIZE (64MiB)
+ set to 1 if it contains the segment meta data.
+----------------------------------------------------------- */
+
+
+#if (MI_INTPTR_SIZE==8)
+#define MI_MAX_ADDRESS ((size_t)20 << 40) // 20TB
+#else
+#define MI_MAX_ADDRESS ((size_t)2 << 30) // 2Gb
+#endif
+
+#define MI_SEGMENT_MAP_BITS (MI_MAX_ADDRESS / MI_SEGMENT_SIZE)
+#define MI_SEGMENT_MAP_SIZE (MI_SEGMENT_MAP_BITS / 8)
+#define MI_SEGMENT_MAP_WSIZE (MI_SEGMENT_MAP_SIZE / MI_INTPTR_SIZE)
+
+static _Atomic(uintptr_t) mi_segment_map[MI_SEGMENT_MAP_WSIZE + 1]; // 2KiB per TB with 64MiB segments
+
+static size_t mi_segment_map_index_of(const mi_segment_t* segment, size_t* bitidx) {
+ mi_assert_internal(_mi_ptr_segment(segment) == segment); // is it aligned on MI_SEGMENT_SIZE?
+ if ((uintptr_t)segment >= MI_MAX_ADDRESS) {
+ *bitidx = 0;
+ return MI_SEGMENT_MAP_WSIZE;
+ }
+ else {
+ const uintptr_t segindex = ((uintptr_t)segment) / MI_SEGMENT_SIZE;
+ *bitidx = segindex % MI_INTPTR_BITS;
+ const size_t mapindex = segindex / MI_INTPTR_BITS;
+ mi_assert_internal(mapindex < MI_SEGMENT_MAP_WSIZE);
+ return mapindex;
+ }
+}
+
+void _mi_segment_map_allocated_at(const mi_segment_t* segment) {
+ size_t bitidx;
+ size_t index = mi_segment_map_index_of(segment, &bitidx);
+ mi_assert_internal(index <= MI_SEGMENT_MAP_WSIZE);
+ if (index==MI_SEGMENT_MAP_WSIZE) return;
+ uintptr_t mask = mi_atomic_load_relaxed(&mi_segment_map[index]);
+ uintptr_t newmask;
+ do {
+ newmask = (mask | ((uintptr_t)1 << bitidx));
+ } while (!mi_atomic_cas_weak_release(&mi_segment_map[index], &mask, newmask));
+}
+
+void _mi_segment_map_freed_at(const mi_segment_t* segment) {
+ size_t bitidx;
+ size_t index = mi_segment_map_index_of(segment, &bitidx);
+ mi_assert_internal(index <= MI_SEGMENT_MAP_WSIZE);
+ if (index == MI_SEGMENT_MAP_WSIZE) return;
+ uintptr_t mask = mi_atomic_load_relaxed(&mi_segment_map[index]);
+ uintptr_t newmask;
+ do {
+ newmask = (mask & ~((uintptr_t)1 << bitidx));
+ } while (!mi_atomic_cas_weak_release(&mi_segment_map[index], &mask, newmask));
+}
+
+// Determine the segment belonging to a pointer or NULL if it is not in a valid segment.
+static mi_segment_t* _mi_segment_of(const void* p) {
+ mi_segment_t* segment = _mi_ptr_segment(p);
+ if (segment == NULL) return NULL;
+ size_t bitidx;
+ size_t index = mi_segment_map_index_of(segment, &bitidx);
+ // fast path: for any pointer to valid small/medium/large object or first MI_SEGMENT_SIZE in huge
+ const uintptr_t mask = mi_atomic_load_relaxed(&mi_segment_map[index]);
+ if (mi_likely((mask & ((uintptr_t)1 << bitidx)) != 0)) {
+ return segment; // yes, allocated by us
+ }
+ if (index==MI_SEGMENT_MAP_WSIZE) return NULL;
+
+ // TODO: maintain max/min allocated range for efficiency for more efficient rejection of invalid pointers?
+
+ // search downwards for the first segment in case it is an interior pointer
+ // could be slow but searches in MI_INTPTR_SIZE * MI_SEGMENT_SIZE (512MiB) steps trough
+ // valid huge objects
+ // note: we could maintain a lowest index to speed up the path for invalid pointers?
+ size_t lobitidx;
+ size_t loindex;
+ uintptr_t lobits = mask & (((uintptr_t)1 << bitidx) - 1);
+ if (lobits != 0) {
+ loindex = index;
+ lobitidx = mi_bsr(lobits); // lobits != 0
+ }
+ else if (index == 0) {
+ return NULL;
+ }
+ else {
+ mi_assert_internal(index > 0);
+ uintptr_t lomask = mask;
+ loindex = index;
+ do {
+ loindex--;
+ lomask = mi_atomic_load_relaxed(&mi_segment_map[loindex]);
+ } while (lomask != 0 && loindex > 0);
+ if (lomask == 0) return NULL;
+ lobitidx = mi_bsr(lomask); // lomask != 0
+ }
+ mi_assert_internal(loindex < MI_SEGMENT_MAP_WSIZE);
+ // take difference as the addresses could be larger than the MAX_ADDRESS space.
+ size_t diff = (((index - loindex) * (8*MI_INTPTR_SIZE)) + bitidx - lobitidx) * MI_SEGMENT_SIZE;
+ segment = (mi_segment_t*)((uint8_t*)segment - diff);
+
+ if (segment == NULL) return NULL;
+ mi_assert_internal((void*)segment < p);
+ bool cookie_ok = (_mi_ptr_cookie(segment) == segment->cookie);
+ mi_assert_internal(cookie_ok);
+ if (mi_unlikely(!cookie_ok)) return NULL;
+ if (((uint8_t*)segment + mi_segment_size(segment)) <= (uint8_t*)p) return NULL; // outside the range
+ mi_assert_internal(p >= (void*)segment && (uint8_t*)p < (uint8_t*)segment + mi_segment_size(segment));
+ return segment;
+}
+
+// Is this a valid pointer in our heap?
+static bool mi_is_valid_pointer(const void* p) {
+ return (_mi_segment_of(p) != NULL);
+}
+
+mi_decl_nodiscard mi_decl_export bool mi_is_in_heap_region(const void* p) mi_attr_noexcept {
+ return mi_is_valid_pointer(p);
+}
+
+/*
+// Return the full segment range belonging to a pointer
+static void* mi_segment_range_of(const void* p, size_t* size) {
+ mi_segment_t* segment = _mi_segment_of(p);
+ if (segment == NULL) {
+ if (size != NULL) *size = 0;
+ return NULL;
+ }
+ else {
+ if (size != NULL) *size = segment->segment_size;
+ return segment;
+ }
+ mi_assert_expensive(page == NULL || mi_segment_is_valid(_mi_page_segment(page),tld));
+ mi_assert_internal(page == NULL || (mi_segment_page_size(_mi_page_segment(page)) - (MI_SECURE == 0 ? 0 : _mi_os_page_size())) >= block_size);
+ mi_reset_delayed(tld);
+ mi_assert_internal(page == NULL || mi_page_not_in_queue(page, tld));
+ return page;
+}
+*/
diff --git a/source/luametatex/source/libraries/mimalloc/src/segment.c b/source/luametatex/source/libraries/mimalloc/src/segment.c
new file mode 100644
index 000000000..800d4fc31
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/segment.c
@@ -0,0 +1,1544 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2020, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <string.h> // memset
+#include <stdio.h>
+
+#define MI_PAGE_HUGE_ALIGN (256*1024)
+
+static void mi_segment_delayed_decommit(mi_segment_t* segment, bool force, mi_stats_t* stats);
+
+
+// -------------------------------------------------------------------
+// commit mask
+// -------------------------------------------------------------------
+
+static bool mi_commit_mask_all_set(const mi_commit_mask_t* commit, const mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ if ((commit->mask[i] & cm->mask[i]) != cm->mask[i]) return false;
+ }
+ return true;
+}
+
+static bool mi_commit_mask_any_set(const mi_commit_mask_t* commit, const mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ if ((commit->mask[i] & cm->mask[i]) != 0) return true;
+ }
+ return false;
+}
+
+static void mi_commit_mask_create_intersect(const mi_commit_mask_t* commit, const mi_commit_mask_t* cm, mi_commit_mask_t* res) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ res->mask[i] = (commit->mask[i] & cm->mask[i]);
+ }
+}
+
+static void mi_commit_mask_clear(mi_commit_mask_t* res, const mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ res->mask[i] &= ~(cm->mask[i]);
+ }
+}
+
+static void mi_commit_mask_set(mi_commit_mask_t* res, const mi_commit_mask_t* cm) {
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ res->mask[i] |= cm->mask[i];
+ }
+}
+
+static void mi_commit_mask_create(size_t bitidx, size_t bitcount, mi_commit_mask_t* cm) {
+ mi_assert_internal(bitidx < MI_COMMIT_MASK_BITS);
+ mi_assert_internal((bitidx + bitcount) <= MI_COMMIT_MASK_BITS);
+ if (bitcount == MI_COMMIT_MASK_BITS) {
+ mi_assert_internal(bitidx==0);
+ mi_commit_mask_create_full(cm);
+ }
+ else if (bitcount == 0) {
+ mi_commit_mask_create_empty(cm);
+ }
+ else {
+ mi_commit_mask_create_empty(cm);
+ size_t i = bitidx / MI_COMMIT_MASK_FIELD_BITS;
+ size_t ofs = bitidx % MI_COMMIT_MASK_FIELD_BITS;
+ while (bitcount > 0) {
+ mi_assert_internal(i < MI_COMMIT_MASK_FIELD_COUNT);
+ size_t avail = MI_COMMIT_MASK_FIELD_BITS - ofs;
+ size_t count = (bitcount > avail ? avail : bitcount);
+ size_t mask = (count >= MI_COMMIT_MASK_FIELD_BITS ? ~((size_t)0) : (((size_t)1 << count) - 1) << ofs);
+ cm->mask[i] = mask;
+ bitcount -= count;
+ ofs = 0;
+ i++;
+ }
+ }
+}
+
+size_t _mi_commit_mask_committed_size(const mi_commit_mask_t* cm, size_t total) {
+ mi_assert_internal((total%MI_COMMIT_MASK_BITS)==0);
+ size_t count = 0;
+ for (size_t i = 0; i < MI_COMMIT_MASK_FIELD_COUNT; i++) {
+ size_t mask = cm->mask[i];
+ if (~mask == 0) {
+ count += MI_COMMIT_MASK_FIELD_BITS;
+ }
+ else {
+ for (; mask != 0; mask >>= 1) { // todo: use popcount
+ if ((mask&1)!=0) count++;
+ }
+ }
+ }
+ // we use total since for huge segments each commit bit may represent a larger size
+ return ((total / MI_COMMIT_MASK_BITS) * count);
+}
+
+
+size_t _mi_commit_mask_next_run(const mi_commit_mask_t* cm, size_t* idx) {
+ size_t i = (*idx) / MI_COMMIT_MASK_FIELD_BITS;
+ size_t ofs = (*idx) % MI_COMMIT_MASK_FIELD_BITS;
+ size_t mask = 0;
+ // find first ones
+ while (i < MI_COMMIT_MASK_FIELD_COUNT) {
+ mask = cm->mask[i];
+ mask >>= ofs;
+ if (mask != 0) {
+ while ((mask&1) == 0) {
+ mask >>= 1;
+ ofs++;
+ }
+ break;
+ }
+ i++;
+ ofs = 0;
+ }
+ if (i >= MI_COMMIT_MASK_FIELD_COUNT) {
+ // not found
+ *idx = MI_COMMIT_MASK_BITS;
+ return 0;
+ }
+ else {
+ // found, count ones
+ size_t count = 0;
+ *idx = (i*MI_COMMIT_MASK_FIELD_BITS) + ofs;
+ do {
+ mi_assert_internal(ofs < MI_COMMIT_MASK_FIELD_BITS && (mask&1) == 1);
+ do {
+ count++;
+ mask >>= 1;
+ } while ((mask&1) == 1);
+ if ((((*idx + count) % MI_COMMIT_MASK_FIELD_BITS) == 0)) {
+ i++;
+ if (i >= MI_COMMIT_MASK_FIELD_COUNT) break;
+ mask = cm->mask[i];
+ ofs = 0;
+ }
+ } while ((mask&1) == 1);
+ mi_assert_internal(count > 0);
+ return count;
+ }
+}
+
+
+/* --------------------------------------------------------------------------------
+ Segment allocation
+
+ If a thread ends, it "abandons" pages with used blocks
+ and there is an abandoned segment list whose segments can
+ be reclaimed by still running threads, much like work-stealing.
+-------------------------------------------------------------------------------- */
+
+
+/* -----------------------------------------------------------
+ Slices
+----------------------------------------------------------- */
+
+
+static const mi_slice_t* mi_segment_slices_end(const mi_segment_t* segment) {
+ return &segment->slices[segment->slice_entries];
+}
+
+static uint8_t* mi_slice_start(const mi_slice_t* slice) {
+ mi_segment_t* segment = _mi_ptr_segment(slice);
+ mi_assert_internal(slice >= segment->slices && slice < mi_segment_slices_end(segment));
+ return ((uint8_t*)segment + ((slice - segment->slices)*MI_SEGMENT_SLICE_SIZE));
+}
+
+
+/* -----------------------------------------------------------
+ Bins
+----------------------------------------------------------- */
+// Use bit scan forward to quickly find the first zero bit if it is available
+
+static inline size_t mi_slice_bin8(size_t slice_count) {
+ if (slice_count<=1) return slice_count;
+ mi_assert_internal(slice_count <= MI_SLICES_PER_SEGMENT);
+ slice_count--;
+ size_t s = mi_bsr(slice_count); // slice_count > 1
+ if (s <= 2) return slice_count + 1;
+ size_t bin = ((s << 2) | ((slice_count >> (s - 2))&0x03)) - 4;
+ return bin;
+}
+
+static inline size_t mi_slice_bin(size_t slice_count) {
+ mi_assert_internal(slice_count*MI_SEGMENT_SLICE_SIZE <= MI_SEGMENT_SIZE);
+ mi_assert_internal(mi_slice_bin8(MI_SLICES_PER_SEGMENT) <= MI_SEGMENT_BIN_MAX);
+ size_t bin = mi_slice_bin8(slice_count);
+ mi_assert_internal(bin <= MI_SEGMENT_BIN_MAX);
+ return bin;
+}
+
+static inline size_t mi_slice_index(const mi_slice_t* slice) {
+ mi_segment_t* segment = _mi_ptr_segment(slice);
+ ptrdiff_t index = slice - segment->slices;
+ mi_assert_internal(index >= 0 && index < (ptrdiff_t)segment->slice_entries);
+ return index;
+}
+
+
+/* -----------------------------------------------------------
+ Slice span queues
+----------------------------------------------------------- */
+
+static void mi_span_queue_push(mi_span_queue_t* sq, mi_slice_t* slice) {
+ // todo: or push to the end?
+ mi_assert_internal(slice->prev == NULL && slice->next==NULL);
+ slice->prev = NULL; // paranoia
+ slice->next = sq->first;
+ sq->first = slice;
+ if (slice->next != NULL) slice->next->prev = slice;
+ else sq->last = slice;
+ slice->xblock_size = 0; // free
+}
+
+static mi_span_queue_t* mi_span_queue_for(size_t slice_count, mi_segments_tld_t* tld) {
+ size_t bin = mi_slice_bin(slice_count);
+ mi_span_queue_t* sq = &tld->spans[bin];
+ mi_assert_internal(sq->slice_count >= slice_count);
+ return sq;
+}
+
+static void mi_span_queue_delete(mi_span_queue_t* sq, mi_slice_t* slice) {
+ mi_assert_internal(slice->xblock_size==0 && slice->slice_count>0 && slice->slice_offset==0);
+ // should work too if the queue does not contain slice (which can happen during reclaim)
+ if (slice->prev != NULL) slice->prev->next = slice->next;
+ if (slice == sq->first) sq->first = slice->next;
+ if (slice->next != NULL) slice->next->prev = slice->prev;
+ if (slice == sq->last) sq->last = slice->prev;
+ slice->prev = NULL;
+ slice->next = NULL;
+ slice->xblock_size = 1; // no more free
+}
+
+
+/* -----------------------------------------------------------
+ Invariant checking
+----------------------------------------------------------- */
+
+static bool mi_slice_is_used(const mi_slice_t* slice) {
+ return (slice->xblock_size > 0);
+}
+
+
+#if (MI_DEBUG>=3)
+static bool mi_span_queue_contains(mi_span_queue_t* sq, mi_slice_t* slice) {
+ for (mi_slice_t* s = sq->first; s != NULL; s = s->next) {
+ if (s==slice) return true;
+ }
+ return false;
+}
+
+static bool mi_segment_is_valid(mi_segment_t* segment, mi_segments_tld_t* tld) {
+ mi_assert_internal(segment != NULL);
+ mi_assert_internal(_mi_ptr_cookie(segment) == segment->cookie);
+ mi_assert_internal(segment->abandoned <= segment->used);
+ mi_assert_internal(segment->thread_id == 0 || segment->thread_id == _mi_thread_id());
+ mi_assert_internal(mi_commit_mask_all_set(&segment->commit_mask, &segment->decommit_mask)); // can only decommit committed blocks
+ //mi_assert_internal(segment->segment_info_size % MI_SEGMENT_SLICE_SIZE == 0);
+ mi_slice_t* slice = &segment->slices[0];
+ const mi_slice_t* end = mi_segment_slices_end(segment);
+ size_t used_count = 0;
+ mi_span_queue_t* sq;
+ while(slice < end) {
+ mi_assert_internal(slice->slice_count > 0);
+ mi_assert_internal(slice->slice_offset == 0);
+ size_t index = mi_slice_index(slice);
+ size_t maxindex = (index + slice->slice_count >= segment->slice_entries ? segment->slice_entries : index + slice->slice_count) - 1;
+ if (mi_slice_is_used(slice)) { // a page in use, we need at least MAX_SLICE_OFFSET valid back offsets
+ used_count++;
+ for (size_t i = 0; i <= MI_MAX_SLICE_OFFSET && index + i <= maxindex; i++) {
+ mi_assert_internal(segment->slices[index + i].slice_offset == i*sizeof(mi_slice_t));
+ mi_assert_internal(i==0 || segment->slices[index + i].slice_count == 0);
+ mi_assert_internal(i==0 || segment->slices[index + i].xblock_size == 1);
+ }
+ // and the last entry as well (for coalescing)
+ const mi_slice_t* last = slice + slice->slice_count - 1;
+ if (last > slice && last < mi_segment_slices_end(segment)) {
+ mi_assert_internal(last->slice_offset == (slice->slice_count-1)*sizeof(mi_slice_t));
+ mi_assert_internal(last->slice_count == 0);
+ mi_assert_internal(last->xblock_size == 1);
+ }
+ }
+ else { // free range of slices; only last slice needs a valid back offset
+ mi_slice_t* last = &segment->slices[maxindex];
+ if (segment->kind != MI_SEGMENT_HUGE || slice->slice_count <= (segment->slice_entries - segment->segment_info_slices)) {
+ mi_assert_internal((uint8_t*)slice == (uint8_t*)last - last->slice_offset);
+ }
+ mi_assert_internal(slice == last || last->slice_count == 0 );
+ mi_assert_internal(last->xblock_size == 0 || (segment->kind==MI_SEGMENT_HUGE && last->xblock_size==1));
+ if (segment->kind != MI_SEGMENT_HUGE && segment->thread_id != 0) { // segment is not huge or abandoned
+ sq = mi_span_queue_for(slice->slice_count,tld);
+ mi_assert_internal(mi_span_queue_contains(sq,slice));
+ }
+ }
+ slice = &segment->slices[maxindex+1];
+ }
+ mi_assert_internal(slice == end);
+ mi_assert_internal(used_count == segment->used + 1);
+ return true;
+}
+#endif
+
+/* -----------------------------------------------------------
+ Segment size calculations
+----------------------------------------------------------- */
+
+static size_t mi_segment_info_size(mi_segment_t* segment) {
+ return segment->segment_info_slices * MI_SEGMENT_SLICE_SIZE;
+}
+
+static uint8_t* _mi_segment_page_start_from_slice(const mi_segment_t* segment, const mi_slice_t* slice, size_t xblock_size, size_t* page_size)
+{
+ ptrdiff_t idx = slice - segment->slices;
+ size_t psize = (size_t)slice->slice_count * MI_SEGMENT_SLICE_SIZE;
+ // make the start not OS page aligned for smaller blocks to avoid page/cache effects
+ size_t start_offset = (xblock_size >= MI_INTPTR_SIZE && xblock_size <= 1024 ? MI_MAX_ALIGN_GUARANTEE : 0);
+ if (page_size != NULL) { *page_size = psize - start_offset; }
+ return (uint8_t*)segment + ((idx*MI_SEGMENT_SLICE_SIZE) + start_offset);
+}
+
+// Start of the page available memory; can be used on uninitialized pages
+uint8_t* _mi_segment_page_start(const mi_segment_t* segment, const mi_page_t* page, size_t* page_size)
+{
+ const mi_slice_t* slice = mi_page_to_slice((mi_page_t*)page);
+ uint8_t* p = _mi_segment_page_start_from_slice(segment, slice, page->xblock_size, page_size);
+ mi_assert_internal(page->xblock_size > 0 || _mi_ptr_page(p) == page);
+ mi_assert_internal(_mi_ptr_segment(p) == segment);
+ return p;
+}
+
+
+static size_t mi_segment_calculate_slices(size_t required, size_t* pre_size, size_t* info_slices) {
+ size_t page_size = _mi_os_page_size();
+ size_t isize = _mi_align_up(sizeof(mi_segment_t), page_size);
+ size_t guardsize = 0;
+
+ if (MI_SECURE>0) {
+ // in secure mode, we set up a protected page in between the segment info
+ // and the page data (and one at the end of the segment)
+ guardsize = page_size;
+ required = _mi_align_up(required, page_size);
+ }
+
+ if (pre_size != NULL) *pre_size = isize;
+ isize = _mi_align_up(isize + guardsize, MI_SEGMENT_SLICE_SIZE);
+ if (info_slices != NULL) *info_slices = isize / MI_SEGMENT_SLICE_SIZE;
+ size_t segment_size = (required==0 ? MI_SEGMENT_SIZE : _mi_align_up( required + isize + guardsize, MI_SEGMENT_SLICE_SIZE) );
+ mi_assert_internal(segment_size % MI_SEGMENT_SLICE_SIZE == 0);
+ return (segment_size / MI_SEGMENT_SLICE_SIZE);
+}
+
+
+/* ----------------------------------------------------------------------------
+Segment caches
+We keep a small segment cache per thread to increase local
+reuse and avoid setting/clearing guard pages in secure mode.
+------------------------------------------------------------------------------- */
+
+static void mi_segments_track_size(long segment_size, mi_segments_tld_t* tld) {
+ if (segment_size>=0) _mi_stat_increase(&tld->stats->segments,1);
+ else _mi_stat_decrease(&tld->stats->segments,1);
+ tld->count += (segment_size >= 0 ? 1 : -1);
+ if (tld->count > tld->peak_count) tld->peak_count = tld->count;
+ tld->current_size += segment_size;
+ if (tld->current_size > tld->peak_size) tld->peak_size = tld->current_size;
+}
+
+static void mi_segment_os_free(mi_segment_t* segment, mi_segments_tld_t* tld) {
+ segment->thread_id = 0;
+ _mi_segment_map_freed_at(segment);
+ mi_segments_track_size(-((long)mi_segment_size(segment)),tld);
+ if (MI_SECURE>0) {
+ // _mi_os_unprotect(segment, mi_segment_size(segment)); // ensure no more guard pages are set
+ // unprotect the guard pages; we cannot just unprotect the whole segment size as part may be decommitted
+ size_t os_pagesize = _mi_os_page_size();
+ _mi_os_unprotect((uint8_t*)segment + mi_segment_info_size(segment) - os_pagesize, os_pagesize);
+ uint8_t* end = (uint8_t*)segment + mi_segment_size(segment) - os_pagesize;
+ _mi_os_unprotect(end, os_pagesize);
+ }
+
+ // purge delayed decommits now? (no, leave it to the cache)
+ // mi_segment_delayed_decommit(segment,true,tld->stats);
+
+ // _mi_os_free(segment, mi_segment_size(segment), /*segment->memid,*/ tld->stats);
+ const size_t size = mi_segment_size(segment);
+ if (size != MI_SEGMENT_SIZE || !_mi_segment_cache_push(segment, size, segment->memid, &segment->commit_mask, &segment->decommit_mask, segment->mem_is_large, segment->mem_is_pinned, tld->os)) {
+ const size_t csize = _mi_commit_mask_committed_size(&segment->commit_mask, size);
+ if (csize > 0 && !segment->mem_is_pinned) _mi_stat_decrease(&_mi_stats_main.committed, csize);
+ _mi_abandoned_await_readers(); // wait until safe to free
+ _mi_arena_free(segment, mi_segment_size(segment), segment->memid, segment->mem_is_pinned /* pretend not committed to not double count decommits */, tld->os);
+ }
+}
+
+// called by threads that are terminating
+void _mi_segment_thread_collect(mi_segments_tld_t* tld) {
+ MI_UNUSED(tld);
+ // nothing to do
+}
+
+
+/* -----------------------------------------------------------
+ Span management
+----------------------------------------------------------- */
+
+static void mi_segment_commit_mask(mi_segment_t* segment, bool conservative, uint8_t* p, size_t size, uint8_t** start_p, size_t* full_size, mi_commit_mask_t* cm) {
+ mi_assert_internal(_mi_ptr_segment(p) == segment);
+ mi_assert_internal(segment->kind != MI_SEGMENT_HUGE);
+ mi_commit_mask_create_empty(cm);
+ if (size == 0 || size > MI_SEGMENT_SIZE || segment->kind == MI_SEGMENT_HUGE) return;
+ const size_t segstart = mi_segment_info_size(segment);
+ const size_t segsize = mi_segment_size(segment);
+ if (p >= (uint8_t*)segment + segsize) return;
+
+ size_t pstart = (p - (uint8_t*)segment);
+ mi_assert_internal(pstart + size <= segsize);
+
+ size_t start;
+ size_t end;
+ if (conservative) {
+ // decommit conservative
+ start = _mi_align_up(pstart, MI_COMMIT_SIZE);
+ end = _mi_align_down(pstart + size, MI_COMMIT_SIZE);
+ mi_assert_internal(start >= segstart);
+ mi_assert_internal(end <= segsize);
+ }
+ else {
+ // commit liberal
+ start = _mi_align_down(pstart, MI_MINIMAL_COMMIT_SIZE);
+ end = _mi_align_up(pstart + size, MI_MINIMAL_COMMIT_SIZE);
+ }
+ if (pstart >= segstart && start < segstart) { // note: the mask is also calculated for an initial commit of the info area
+ start = segstart;
+ }
+ if (end > segsize) {
+ end = segsize;
+ }
+
+ mi_assert_internal(start <= pstart && (pstart + size) <= end);
+ mi_assert_internal(start % MI_COMMIT_SIZE==0 && end % MI_COMMIT_SIZE == 0);
+ *start_p = (uint8_t*)segment + start;
+ *full_size = (end > start ? end - start : 0);
+ if (*full_size == 0) return;
+
+ size_t bitidx = start / MI_COMMIT_SIZE;
+ mi_assert_internal(bitidx < MI_COMMIT_MASK_BITS);
+
+ size_t bitcount = *full_size / MI_COMMIT_SIZE; // can be 0
+ if (bitidx + bitcount > MI_COMMIT_MASK_BITS) {
+ _mi_warning_message("commit mask overflow: idx=%zu count=%zu start=%zx end=%zx p=0x%p size=%zu fullsize=%zu\n", bitidx, bitcount, start, end, p, size, *full_size);
+ }
+ mi_assert_internal((bitidx + bitcount) <= MI_COMMIT_MASK_BITS);
+ mi_commit_mask_create(bitidx, bitcount, cm);
+}
+
+
+static bool mi_segment_commitx(mi_segment_t* segment, bool commit, uint8_t* p, size_t size, mi_stats_t* stats) {
+ mi_assert_internal(mi_commit_mask_all_set(&segment->commit_mask, &segment->decommit_mask));
+
+ // try to commit in at least MI_MINIMAL_COMMIT_SIZE sizes.
+ /*
+ if (commit && size > 0) {
+ const size_t csize = _mi_align_up(size, MI_MINIMAL_COMMIT_SIZE);
+ if (p + csize <= mi_segment_end(segment)) {
+ size = csize;
+ }
+ }
+ */
+ // commit liberal, but decommit conservative
+ uint8_t* start = NULL;
+ size_t full_size = 0;
+ mi_commit_mask_t mask;
+ mi_segment_commit_mask(segment, !commit/*conservative*/, p, size, &start, &full_size, &mask);
+ if (mi_commit_mask_is_empty(&mask) || full_size==0) return true;
+
+ if (commit && !mi_commit_mask_all_set(&segment->commit_mask, &mask)) {
+ bool is_zero = false;
+ mi_commit_mask_t cmask;
+ mi_commit_mask_create_intersect(&segment->commit_mask, &mask, &cmask);
+ _mi_stat_decrease(&_mi_stats_main.committed, _mi_commit_mask_committed_size(&cmask, MI_SEGMENT_SIZE)); // adjust for overlap
+ if (!_mi_os_commit(start,full_size,&is_zero,stats)) return false;
+ mi_commit_mask_set(&segment->commit_mask, &mask);
+ }
+ else if (!commit && mi_commit_mask_any_set(&segment->commit_mask, &mask)) {
+ mi_assert_internal((void*)start != (void*)segment);
+ //mi_assert_internal(mi_commit_mask_all_set(&segment->commit_mask, &mask));
+
+ mi_commit_mask_t cmask;
+ mi_commit_mask_create_intersect(&segment->commit_mask, &mask, &cmask);
+ _mi_stat_increase(&_mi_stats_main.committed, full_size - _mi_commit_mask_committed_size(&cmask, MI_SEGMENT_SIZE)); // adjust for overlap
+ if (segment->allow_decommit) {
+ _mi_os_decommit(start, full_size, stats); // ok if this fails
+ }
+ mi_commit_mask_clear(&segment->commit_mask, &mask);
+ }
+ // increase expiration of reusing part of the delayed decommit
+ if (commit && mi_commit_mask_any_set(&segment->decommit_mask, &mask)) {
+ segment->decommit_expire = _mi_clock_now() + mi_option_get(mi_option_decommit_delay);
+ }
+ // always undo delayed decommits
+ mi_commit_mask_clear(&segment->decommit_mask, &mask);
+ return true;
+}
+
+static bool mi_segment_ensure_committed(mi_segment_t* segment, uint8_t* p, size_t size, mi_stats_t* stats) {
+ mi_assert_internal(mi_commit_mask_all_set(&segment->commit_mask, &segment->decommit_mask));
+ // note: assumes commit_mask is always full for huge segments as otherwise the commit mask bits can overflow
+ if (mi_commit_mask_is_full(&segment->commit_mask) && mi_commit_mask_is_empty(&segment->decommit_mask)) return true; // fully committed
+ return mi_segment_commitx(segment,true,p,size,stats);
+}
+
+static void mi_segment_perhaps_decommit(mi_segment_t* segment, uint8_t* p, size_t size, mi_stats_t* stats) {
+ if (!segment->allow_decommit) return;
+ if (mi_option_get(mi_option_decommit_delay) == 0) {
+ mi_segment_commitx(segment, false, p, size, stats);
+ }
+ else {
+ // register for future decommit in the decommit mask
+ uint8_t* start = NULL;
+ size_t full_size = 0;
+ mi_commit_mask_t mask;
+ mi_segment_commit_mask(segment, true /*conservative*/, p, size, &start, &full_size, &mask);
+ if (mi_commit_mask_is_empty(&mask) || full_size==0) return;
+
+ // update delayed commit
+ mi_assert_internal(segment->decommit_expire > 0 || mi_commit_mask_is_empty(&segment->decommit_mask));
+ mi_commit_mask_t cmask;
+ mi_commit_mask_create_intersect(&segment->commit_mask, &mask, &cmask); // only decommit what is committed; span_free may try to decommit more
+ mi_commit_mask_set(&segment->decommit_mask, &cmask);
+ mi_msecs_t now = _mi_clock_now();
+ if (segment->decommit_expire == 0) {
+ // no previous decommits, initialize now
+ segment->decommit_expire = now + mi_option_get(mi_option_decommit_delay);
+ }
+ else if (segment->decommit_expire <= now) {
+ // previous decommit mask already expired
+ // mi_segment_delayed_decommit(segment, true, stats);
+ segment->decommit_expire = now + mi_option_get(mi_option_decommit_extend_delay); // (mi_option_get(mi_option_decommit_delay) / 8); // wait a tiny bit longer in case there is a series of free's
+ }
+ else {
+ // previous decommit mask is not yet expired, increase the expiration by a bit.
+ segment->decommit_expire += mi_option_get(mi_option_decommit_extend_delay);
+ }
+ }
+}
+
+static void mi_segment_delayed_decommit(mi_segment_t* segment, bool force, mi_stats_t* stats) {
+ if (!segment->allow_decommit || mi_commit_mask_is_empty(&segment->decommit_mask)) return;
+ mi_msecs_t now = _mi_clock_now();
+ if (!force && now < segment->decommit_expire) return;
+
+ mi_commit_mask_t mask = segment->decommit_mask;
+ segment->decommit_expire = 0;
+ mi_commit_mask_create_empty(&segment->decommit_mask);
+
+ size_t idx;
+ size_t count;
+ mi_commit_mask_foreach(&mask, idx, count) {
+ // if found, decommit that sequence
+ if (count > 0) {
+ uint8_t* p = (uint8_t*)segment + (idx*MI_COMMIT_SIZE);
+ size_t size = count * MI_COMMIT_SIZE;
+ mi_segment_commitx(segment, false, p, size, stats);
+ }
+ }
+ mi_commit_mask_foreach_end()
+ mi_assert_internal(mi_commit_mask_is_empty(&segment->decommit_mask));
+}
+
+
+static bool mi_segment_is_abandoned(mi_segment_t* segment) {
+ return (segment->thread_id == 0);
+}
+
+// note: can be called on abandoned segments
+static void mi_segment_span_free(mi_segment_t* segment, size_t slice_index, size_t slice_count, mi_segments_tld_t* tld) {
+ mi_assert_internal(slice_index < segment->slice_entries);
+ mi_span_queue_t* sq = (segment->kind == MI_SEGMENT_HUGE || mi_segment_is_abandoned(segment)
+ ? NULL : mi_span_queue_for(slice_count,tld));
+ if (slice_count==0) slice_count = 1;
+ mi_assert_internal(slice_index + slice_count - 1 < segment->slice_entries);
+
+ // set first and last slice (the intermediates can be undetermined)
+ mi_slice_t* slice = &segment->slices[slice_index];
+ slice->slice_count = (uint32_t)slice_count;
+ mi_assert_internal(slice->slice_count == slice_count); // no overflow?
+ slice->slice_offset = 0;
+ if (slice_count > 1) {
+ mi_slice_t* last = &segment->slices[slice_index + slice_count - 1];
+ last->slice_count = 0;
+ last->slice_offset = (uint32_t)(sizeof(mi_page_t)*(slice_count - 1));
+ last->xblock_size = 0;
+ }
+
+ // perhaps decommit
+ mi_segment_perhaps_decommit(segment,mi_slice_start(slice),slice_count*MI_SEGMENT_SLICE_SIZE,tld->stats);
+
+ // and push it on the free page queue (if it was not a huge page)
+ if (sq != NULL) mi_span_queue_push( sq, slice );
+ else slice->xblock_size = 0; // mark huge page as free anyways
+}
+
+/*
+// called from reclaim to add existing free spans
+static void mi_segment_span_add_free(mi_slice_t* slice, mi_segments_tld_t* tld) {
+ mi_segment_t* segment = _mi_ptr_segment(slice);
+ mi_assert_internal(slice->xblock_size==0 && slice->slice_count>0 && slice->slice_offset==0);
+ size_t slice_index = mi_slice_index(slice);
+ mi_segment_span_free(segment,slice_index,slice->slice_count,tld);
+}
+*/
+
+static void mi_segment_span_remove_from_queue(mi_slice_t* slice, mi_segments_tld_t* tld) {
+ mi_assert_internal(slice->slice_count > 0 && slice->slice_offset==0 && slice->xblock_size==0);
+ mi_assert_internal(_mi_ptr_segment(slice)->kind != MI_SEGMENT_HUGE);
+ mi_span_queue_t* sq = mi_span_queue_for(slice->slice_count, tld);
+ mi_span_queue_delete(sq, slice);
+}
+
+// note: can be called on abandoned segments
+static mi_slice_t* mi_segment_span_free_coalesce(mi_slice_t* slice, mi_segments_tld_t* tld) {
+ mi_assert_internal(slice != NULL && slice->slice_count > 0 && slice->slice_offset == 0);
+ mi_segment_t* segment = _mi_ptr_segment(slice);
+ bool is_abandoned = mi_segment_is_abandoned(segment);
+
+ // for huge pages, just mark as free but don't add to the queues
+ if (segment->kind == MI_SEGMENT_HUGE) {
+ mi_assert_internal(segment->used == 1); // decreased right after this call in `mi_segment_page_clear`
+ slice->xblock_size = 0; // mark as free anyways
+ // we should mark the last slice `xblock_size=0` now to maintain invariants but we skip it to
+ // avoid a possible cache miss (and the segment is about to be freed)
+ return slice;
+ }
+
+ // otherwise coalesce the span and add to the free span queues
+ size_t slice_count = slice->slice_count;
+ mi_slice_t* next = slice + slice->slice_count;
+ mi_assert_internal(next <= mi_segment_slices_end(segment));
+ if (next < mi_segment_slices_end(segment) && next->xblock_size==0) {
+ // free next block -- remove it from free and merge
+ mi_assert_internal(next->slice_count > 0 && next->slice_offset==0);
+ slice_count += next->slice_count; // extend
+ if (!is_abandoned) { mi_segment_span_remove_from_queue(next, tld); }
+ }
+ if (slice > segment->slices) {
+ mi_slice_t* prev = mi_slice_first(slice - 1);
+ mi_assert_internal(prev >= segment->slices);
+ if (prev->xblock_size==0) {
+ // free previous slice -- remove it from free and merge
+ mi_assert_internal(prev->slice_count > 0 && prev->slice_offset==0);
+ slice_count += prev->slice_count;
+ if (!is_abandoned) { mi_segment_span_remove_from_queue(prev, tld); }
+ slice = prev;
+ }
+ }
+
+ // and add the new free page
+ mi_segment_span_free(segment, mi_slice_index(slice), slice_count, tld);
+ return slice;
+}
+
+
+static void mi_segment_slice_split(mi_segment_t* segment, mi_slice_t* slice, size_t slice_count, mi_segments_tld_t* tld) {
+ mi_assert_internal(_mi_ptr_segment(slice)==segment);
+ mi_assert_internal(slice->slice_count >= slice_count);
+ mi_assert_internal(slice->xblock_size > 0); // no more in free queue
+ if (slice->slice_count <= slice_count) return;
+ mi_assert_internal(segment->kind != MI_SEGMENT_HUGE);
+ size_t next_index = mi_slice_index(slice) + slice_count;
+ size_t next_count = slice->slice_count - slice_count;
+ mi_segment_span_free(segment, next_index, next_count, tld);
+ slice->slice_count = (uint32_t)slice_count;
+}
+
+// Note: may still return NULL if committing the memory failed
+static mi_page_t* mi_segment_span_allocate(mi_segment_t* segment, size_t slice_index, size_t slice_count, mi_segments_tld_t* tld) {
+ mi_assert_internal(slice_index < segment->slice_entries);
+ mi_slice_t* slice = &segment->slices[slice_index];
+ mi_assert_internal(slice->xblock_size==0 || slice->xblock_size==1);
+
+ // commit before changing the slice data
+ if (!mi_segment_ensure_committed(segment, _mi_segment_page_start_from_slice(segment, slice, 0, NULL), slice_count * MI_SEGMENT_SLICE_SIZE, tld->stats)) {
+ return NULL; // commit failed!
+ }
+
+ // convert the slices to a page
+ slice->slice_offset = 0;
+ slice->slice_count = (uint32_t)slice_count;
+ mi_assert_internal(slice->slice_count == slice_count);
+ const size_t bsize = slice_count * MI_SEGMENT_SLICE_SIZE;
+ slice->xblock_size = (uint32_t)(bsize >= MI_HUGE_BLOCK_SIZE ? MI_HUGE_BLOCK_SIZE : bsize);
+ mi_page_t* page = mi_slice_to_page(slice);
+ mi_assert_internal(mi_page_block_size(page) == bsize);
+
+ // set slice back pointers for the first MI_MAX_SLICE_OFFSET entries
+ size_t extra = slice_count-1;
+ if (extra > MI_MAX_SLICE_OFFSET) extra = MI_MAX_SLICE_OFFSET;
+ if (slice_index + extra >= segment->slice_entries) extra = segment->slice_entries - slice_index - 1; // huge objects may have more slices than avaiable entries in the segment->slices
+ slice++;
+ for (size_t i = 1; i <= extra; i++, slice++) {
+ slice->slice_offset = (uint32_t)(sizeof(mi_slice_t)*i);
+ slice->slice_count = 0;
+ slice->xblock_size = 1;
+ }
+
+ // and also for the last one (if not set already) (the last one is needed for coalescing)
+ // note: the cast is needed for ubsan since the index can be larger than MI_SLICES_PER_SEGMENT for huge allocations (see #543)
+ mi_slice_t* last = &((mi_slice_t*)segment->slices)[slice_index + slice_count - 1];
+ if (last < mi_segment_slices_end(segment) && last >= slice) {
+ last->slice_offset = (uint32_t)(sizeof(mi_slice_t)*(slice_count-1));
+ last->slice_count = 0;
+ last->xblock_size = 1;
+ }
+
+ // and initialize the page
+ page->is_reset = false;
+ page->is_committed = true;
+ segment->used++;
+ return page;
+}
+
+static mi_page_t* mi_segments_page_find_and_allocate(size_t slice_count, mi_segments_tld_t* tld) {
+ mi_assert_internal(slice_count*MI_SEGMENT_SLICE_SIZE <= MI_LARGE_OBJ_SIZE_MAX);
+ // search from best fit up
+ mi_span_queue_t* sq = mi_span_queue_for(slice_count, tld);
+ if (slice_count == 0) slice_count = 1;
+ while (sq <= &tld->spans[MI_SEGMENT_BIN_MAX]) {
+ for (mi_slice_t* slice = sq->first; slice != NULL; slice = slice->next) {
+ if (slice->slice_count >= slice_count) {
+ // found one
+ mi_span_queue_delete(sq, slice);
+ mi_segment_t* segment = _mi_ptr_segment(slice);
+ if (slice->slice_count > slice_count) {
+ mi_segment_slice_split(segment, slice, slice_count, tld);
+ }
+ mi_assert_internal(slice != NULL && slice->slice_count == slice_count && slice->xblock_size > 0);
+ mi_page_t* page = mi_segment_span_allocate(segment, mi_slice_index(slice), slice->slice_count, tld);
+ if (page == NULL) {
+ // commit failed; return NULL but first restore the slice
+ mi_segment_span_free_coalesce(slice, tld);
+ return NULL;
+ }
+ return page;
+ }
+ }
+ sq++;
+ }
+ // could not find a page..
+ return NULL;
+}
+
+
+/* -----------------------------------------------------------
+ Segment allocation
+----------------------------------------------------------- */
+
+// Allocate a segment from the OS aligned to `MI_SEGMENT_SIZE` .
+static mi_segment_t* mi_segment_init(mi_segment_t* segment, size_t required, mi_segments_tld_t* tld, mi_os_tld_t* os_tld, mi_page_t** huge_page)
+{
+ mi_assert_internal((required==0 && huge_page==NULL) || (required>0 && huge_page != NULL));
+ mi_assert_internal((segment==NULL) || (segment!=NULL && required==0));
+ // calculate needed sizes first
+ size_t info_slices;
+ size_t pre_size;
+ const size_t segment_slices = mi_segment_calculate_slices(required, &pre_size, &info_slices);
+ const size_t slice_entries = (segment_slices > MI_SLICES_PER_SEGMENT ? MI_SLICES_PER_SEGMENT : segment_slices);
+ const size_t segment_size = segment_slices * MI_SEGMENT_SLICE_SIZE;
+
+ // Commit eagerly only if not the first N lazy segments (to reduce impact of many threads that allocate just a little)
+ const bool eager_delay = (// !_mi_os_has_overcommit() && // never delay on overcommit systems
+ _mi_current_thread_count() > 1 && // do not delay for the first N threads
+ tld->count < (size_t)mi_option_get(mi_option_eager_commit_delay));
+ const bool eager = !eager_delay && mi_option_is_enabled(mi_option_eager_commit);
+ bool commit = eager || (required > 0);
+
+ // Try to get from our cache first
+ bool is_zero = false;
+ const bool commit_info_still_good = (segment != NULL);
+ mi_commit_mask_t commit_mask;
+ mi_commit_mask_t decommit_mask;
+ if (segment != NULL) {
+ commit_mask = segment->commit_mask;
+ decommit_mask = segment->decommit_mask;
+ }
+ else {
+ mi_commit_mask_create_empty(&commit_mask);
+ mi_commit_mask_create_empty(&decommit_mask);
+ }
+ if (segment==NULL) {
+ // Allocate the segment from the OS
+ bool mem_large = (!eager_delay && (MI_SECURE==0)); // only allow large OS pages once we are no longer lazy
+ bool is_pinned = false;
+ size_t memid = 0;
+ segment = (mi_segment_t*)_mi_segment_cache_pop(segment_size, &commit_mask, &decommit_mask, &mem_large, &is_pinned, &is_zero, &memid, os_tld);
+ if (segment==NULL) {
+ segment = (mi_segment_t*)_mi_arena_alloc_aligned(segment_size, MI_SEGMENT_SIZE, &commit, &mem_large, &is_pinned, &is_zero, &memid, os_tld);
+ if (segment == NULL) return NULL; // failed to allocate
+ if (commit) {
+ mi_commit_mask_create_full(&commit_mask);
+ }
+ else {
+ mi_commit_mask_create_empty(&commit_mask);
+ }
+ }
+ mi_assert_internal(segment != NULL && (uintptr_t)segment % MI_SEGMENT_SIZE == 0);
+
+ const size_t commit_needed = _mi_divide_up(info_slices*MI_SEGMENT_SLICE_SIZE, MI_COMMIT_SIZE);
+ mi_assert_internal(commit_needed>0);
+ mi_commit_mask_t commit_needed_mask;
+ mi_commit_mask_create(0, commit_needed, &commit_needed_mask);
+ if (!mi_commit_mask_all_set(&commit_mask, &commit_needed_mask)) {
+ // at least commit the info slices
+ mi_assert_internal(commit_needed*MI_COMMIT_SIZE >= info_slices*MI_SEGMENT_SLICE_SIZE);
+ bool ok = _mi_os_commit(segment, commit_needed*MI_COMMIT_SIZE, &is_zero, tld->stats);
+ if (!ok) return NULL; // failed to commit
+ mi_commit_mask_set(&commit_mask, &commit_needed_mask);
+ }
+ segment->memid = memid;
+ segment->mem_is_pinned = is_pinned;
+ segment->mem_is_large = mem_large;
+ segment->mem_is_committed = mi_commit_mask_is_full(&commit_mask);
+ mi_segments_track_size((long)(segment_size), tld);
+ _mi_segment_map_allocated_at(segment);
+ }
+
+ // zero the segment info? -- not always needed as it is zero initialized from the OS
+ mi_atomic_store_ptr_release(mi_segment_t, &segment->abandoned_next, NULL); // tsan
+ if (!is_zero) {
+ ptrdiff_t ofs = offsetof(mi_segment_t, next);
+ size_t prefix = offsetof(mi_segment_t, slices) - ofs;
+ memset((uint8_t*)segment+ofs, 0, prefix + sizeof(mi_slice_t)*segment_slices);
+ }
+
+ if (!commit_info_still_good) {
+ segment->commit_mask = commit_mask; // on lazy commit, the initial part is always committed
+ segment->allow_decommit = (mi_option_is_enabled(mi_option_allow_decommit) && !segment->mem_is_pinned && !segment->mem_is_large);
+ if (segment->allow_decommit) {
+ segment->decommit_expire = _mi_clock_now() + mi_option_get(mi_option_decommit_delay);
+ segment->decommit_mask = decommit_mask;
+ mi_assert_internal(mi_commit_mask_all_set(&segment->commit_mask, &segment->decommit_mask));
+ #if MI_DEBUG>2
+ const size_t commit_needed = _mi_divide_up(info_slices*MI_SEGMENT_SLICE_SIZE, MI_COMMIT_SIZE);
+ mi_commit_mask_t commit_needed_mask;
+ mi_commit_mask_create(0, commit_needed, &commit_needed_mask);
+ mi_assert_internal(!mi_commit_mask_any_set(&segment->decommit_mask, &commit_needed_mask));
+ #endif
+ }
+ else {
+ mi_assert_internal(mi_commit_mask_is_empty(&decommit_mask));
+ segment->decommit_expire = 0;
+ mi_commit_mask_create_empty( &segment->decommit_mask );
+ mi_assert_internal(mi_commit_mask_is_empty(&segment->decommit_mask));
+ }
+ }
+
+
+ // initialize segment info
+ segment->segment_slices = segment_slices;
+ segment->segment_info_slices = info_slices;
+ segment->thread_id = _mi_thread_id();
+ segment->cookie = _mi_ptr_cookie(segment);
+ segment->slice_entries = slice_entries;
+ segment->kind = (required == 0 ? MI_SEGMENT_NORMAL : MI_SEGMENT_HUGE);
+
+ // memset(segment->slices, 0, sizeof(mi_slice_t)*(info_slices+1));
+ _mi_stat_increase(&tld->stats->page_committed, mi_segment_info_size(segment));
+
+ // set up guard pages
+ size_t guard_slices = 0;
+ if (MI_SECURE>0) {
+ // in secure mode, we set up a protected page in between the segment info
+ // and the page data, and at the end of the segment.
+ size_t os_pagesize = _mi_os_page_size();
+ mi_assert_internal(mi_segment_info_size(segment) - os_pagesize >= pre_size);
+ _mi_os_protect((uint8_t*)segment + mi_segment_info_size(segment) - os_pagesize, os_pagesize);
+ uint8_t* end = (uint8_t*)segment + mi_segment_size(segment) - os_pagesize;
+ mi_segment_ensure_committed(segment, end, os_pagesize, tld->stats);
+ _mi_os_protect(end, os_pagesize);
+ if (slice_entries == segment_slices) segment->slice_entries--; // don't use the last slice :-(
+ guard_slices = 1;
+ }
+
+ // reserve first slices for segment info
+ mi_page_t* page0 = mi_segment_span_allocate(segment, 0, info_slices, tld);
+ mi_assert_internal(page0!=NULL); if (page0==NULL) return NULL; // cannot fail as we always commit in advance
+ mi_assert_internal(segment->used == 1);
+ segment->used = 0; // don't count our internal slices towards usage
+
+ // initialize initial free pages
+ if (segment->kind == MI_SEGMENT_NORMAL) { // not a huge page
+ mi_assert_internal(huge_page==NULL);
+ mi_segment_span_free(segment, info_slices, segment->slice_entries - info_slices, tld);
+ }
+ else {
+ mi_assert_internal(huge_page!=NULL);
+ mi_assert_internal(mi_commit_mask_is_empty(&segment->decommit_mask));
+ mi_assert_internal(mi_commit_mask_is_full(&segment->commit_mask));
+ *huge_page = mi_segment_span_allocate(segment, info_slices, segment_slices - info_slices - guard_slices, tld);
+ mi_assert_internal(*huge_page != NULL); // cannot fail as we commit in advance
+ }
+
+ mi_assert_expensive(mi_segment_is_valid(segment,tld));
+ return segment;
+}
+
+
+// Allocate a segment from the OS aligned to `MI_SEGMENT_SIZE` .
+static mi_segment_t* mi_segment_alloc(size_t required, mi_segments_tld_t* tld, mi_os_tld_t* os_tld, mi_page_t** huge_page) {
+ return mi_segment_init(NULL, required, tld, os_tld, huge_page);
+}
+
+
+static void mi_segment_free(mi_segment_t* segment, bool force, mi_segments_tld_t* tld) {
+ MI_UNUSED(force);
+ mi_assert_internal(segment != NULL);
+ mi_assert_internal(segment->next == NULL);
+ mi_assert_internal(segment->used == 0);
+
+ // Remove the free pages
+ mi_slice_t* slice = &segment->slices[0];
+ const mi_slice_t* end = mi_segment_slices_end(segment);
+ size_t page_count = 0;
+ while (slice < end) {
+ mi_assert_internal(slice->slice_count > 0);
+ mi_assert_internal(slice->slice_offset == 0);
+ mi_assert_internal(mi_slice_index(slice)==0 || slice->xblock_size == 0); // no more used pages ..
+ if (slice->xblock_size == 0 && segment->kind != MI_SEGMENT_HUGE) {
+ mi_segment_span_remove_from_queue(slice, tld);
+ }
+ page_count++;
+ slice = slice + slice->slice_count;
+ }
+ mi_assert_internal(page_count == 2); // first page is allocated by the segment itself
+
+ // stats
+ _mi_stat_decrease(&tld->stats->page_committed, mi_segment_info_size(segment));
+
+ // return it to the OS
+ mi_segment_os_free(segment, tld);
+}
+
+
+/* -----------------------------------------------------------
+ Page Free
+----------------------------------------------------------- */
+
+static void mi_segment_abandon(mi_segment_t* segment, mi_segments_tld_t* tld);
+
+// note: can be called on abandoned pages
+static mi_slice_t* mi_segment_page_clear(mi_page_t* page, mi_segments_tld_t* tld) {
+ mi_assert_internal(page->xblock_size > 0);
+ mi_assert_internal(mi_page_all_free(page));
+ mi_segment_t* segment = _mi_ptr_segment(page);
+ mi_assert_internal(segment->used > 0);
+
+ size_t inuse = page->capacity * mi_page_block_size(page);
+ _mi_stat_decrease(&tld->stats->page_committed, inuse);
+ _mi_stat_decrease(&tld->stats->pages, 1);
+
+ // reset the page memory to reduce memory pressure?
+ if (!segment->mem_is_pinned && !page->is_reset && mi_option_is_enabled(mi_option_page_reset)) {
+ size_t psize;
+ uint8_t* start = _mi_page_start(segment, page, &psize);
+ page->is_reset = true;
+ _mi_os_reset(start, psize, tld->stats);
+ }
+
+ // zero the page data, but not the segment fields
+ page->is_zero_init = false;
+ ptrdiff_t ofs = offsetof(mi_page_t, capacity);
+ memset((uint8_t*)page + ofs, 0, sizeof(*page) - ofs);
+ page->xblock_size = 1;
+
+ // and free it
+ mi_slice_t* slice = mi_segment_span_free_coalesce(mi_page_to_slice(page), tld);
+ segment->used--;
+ // cannot assert segment valid as it is called during reclaim
+ // mi_assert_expensive(mi_segment_is_valid(segment, tld));
+ return slice;
+}
+
+void _mi_segment_page_free(mi_page_t* page, bool force, mi_segments_tld_t* tld)
+{
+ mi_assert(page != NULL);
+
+ mi_segment_t* segment = _mi_page_segment(page);
+ mi_assert_expensive(mi_segment_is_valid(segment,tld));
+
+ // mark it as free now
+ mi_segment_page_clear(page, tld);
+ mi_assert_expensive(mi_segment_is_valid(segment, tld));
+
+ if (segment->used == 0) {
+ // no more used pages; remove from the free list and free the segment
+ mi_segment_free(segment, force, tld);
+ }
+ else if (segment->used == segment->abandoned) {
+ // only abandoned pages; remove from free list and abandon
+ mi_segment_abandon(segment,tld);
+ }
+}
+
+
+/* -----------------------------------------------------------
+Abandonment
+
+When threads terminate, they can leave segments with
+live blocks (reachable through other threads). Such segments
+are "abandoned" and will be reclaimed by other threads to
+reuse their pages and/or free them eventually
+
+We maintain a global list of abandoned segments that are
+reclaimed on demand. Since this is shared among threads
+the implementation needs to avoid the A-B-A problem on
+popping abandoned segments: <https://en.wikipedia.org/wiki/ABA_problem>
+We use tagged pointers to avoid accidentially identifying
+reused segments, much like stamped references in Java.
+Secondly, we maintain a reader counter to avoid resetting
+or decommitting segments that have a pending read operation.
+
+Note: the current implementation is one possible design;
+another way might be to keep track of abandoned segments
+in the arenas/segment_cache's. This would have the advantage of keeping
+all concurrent code in one place and not needing to deal
+with ABA issues. The drawback is that it is unclear how to
+scan abandoned segments efficiently in that case as they
+would be spread among all other segments in the arenas.
+----------------------------------------------------------- */
+
+// Use the bottom 20-bits (on 64-bit) of the aligned segment pointers
+// to put in a tag that increments on update to avoid the A-B-A problem.
+#define MI_TAGGED_MASK MI_SEGMENT_MASK
+typedef uintptr_t mi_tagged_segment_t;
+
+static mi_segment_t* mi_tagged_segment_ptr(mi_tagged_segment_t ts) {
+ return (mi_segment_t*)(ts & ~MI_TAGGED_MASK);
+}
+
+static mi_tagged_segment_t mi_tagged_segment(mi_segment_t* segment, mi_tagged_segment_t ts) {
+ mi_assert_internal(((uintptr_t)segment & MI_TAGGED_MASK) == 0);
+ uintptr_t tag = ((ts & MI_TAGGED_MASK) + 1) & MI_TAGGED_MASK;
+ return ((uintptr_t)segment | tag);
+}
+
+// This is a list of visited abandoned pages that were full at the time.
+// this list migrates to `abandoned` when that becomes NULL. The use of
+// this list reduces contention and the rate at which segments are visited.
+static mi_decl_cache_align _Atomic(mi_segment_t*) abandoned_visited; // = NULL
+
+// The abandoned page list (tagged as it supports pop)
+static mi_decl_cache_align _Atomic(mi_tagged_segment_t) abandoned; // = NULL
+
+// Maintain these for debug purposes (these counts may be a bit off)
+static mi_decl_cache_align _Atomic(size_t) abandoned_count;
+static mi_decl_cache_align _Atomic(size_t) abandoned_visited_count;
+
+// We also maintain a count of current readers of the abandoned list
+// in order to prevent resetting/decommitting segment memory if it might
+// still be read.
+static mi_decl_cache_align _Atomic(size_t) abandoned_readers; // = 0
+
+// Push on the visited list
+static void mi_abandoned_visited_push(mi_segment_t* segment) {
+ mi_assert_internal(segment->thread_id == 0);
+ mi_assert_internal(mi_atomic_load_ptr_relaxed(mi_segment_t,&segment->abandoned_next) == NULL);
+ mi_assert_internal(segment->next == NULL);
+ mi_assert_internal(segment->used > 0);
+ mi_segment_t* anext = mi_atomic_load_ptr_relaxed(mi_segment_t, &abandoned_visited);
+ do {
+ mi_atomic_store_ptr_release(mi_segment_t, &segment->abandoned_next, anext);
+ } while (!mi_atomic_cas_ptr_weak_release(mi_segment_t, &abandoned_visited, &anext, segment));
+ mi_atomic_increment_relaxed(&abandoned_visited_count);
+}
+
+// Move the visited list to the abandoned list.
+static bool mi_abandoned_visited_revisit(void)
+{
+ // quick check if the visited list is empty
+ if (mi_atomic_load_ptr_relaxed(mi_segment_t, &abandoned_visited) == NULL) return false;
+
+ // grab the whole visited list
+ mi_segment_t* first = mi_atomic_exchange_ptr_acq_rel(mi_segment_t, &abandoned_visited, NULL);
+ if (first == NULL) return false;
+
+ // first try to swap directly if the abandoned list happens to be NULL
+ mi_tagged_segment_t afirst;
+ mi_tagged_segment_t ts = mi_atomic_load_relaxed(&abandoned);
+ if (mi_tagged_segment_ptr(ts)==NULL) {
+ size_t count = mi_atomic_load_relaxed(&abandoned_visited_count);
+ afirst = mi_tagged_segment(first, ts);
+ if (mi_atomic_cas_strong_acq_rel(&abandoned, &ts, afirst)) {
+ mi_atomic_add_relaxed(&abandoned_count, count);
+ mi_atomic_sub_relaxed(&abandoned_visited_count, count);
+ return true;
+ }
+ }
+
+ // find the last element of the visited list: O(n)
+ mi_segment_t* last = first;
+ mi_segment_t* next;
+ while ((next = mi_atomic_load_ptr_relaxed(mi_segment_t, &last->abandoned_next)) != NULL) {
+ last = next;
+ }
+
+ // and atomically prepend to the abandoned list
+ // (no need to increase the readers as we don't access the abandoned segments)
+ mi_tagged_segment_t anext = mi_atomic_load_relaxed(&abandoned);
+ size_t count;
+ do {
+ count = mi_atomic_load_relaxed(&abandoned_visited_count);
+ mi_atomic_store_ptr_release(mi_segment_t, &last->abandoned_next, mi_tagged_segment_ptr(anext));
+ afirst = mi_tagged_segment(first, anext);
+ } while (!mi_atomic_cas_weak_release(&abandoned, &anext, afirst));
+ mi_atomic_add_relaxed(&abandoned_count, count);
+ mi_atomic_sub_relaxed(&abandoned_visited_count, count);
+ return true;
+}
+
+// Push on the abandoned list.
+static void mi_abandoned_push(mi_segment_t* segment) {
+ mi_assert_internal(segment->thread_id == 0);
+ mi_assert_internal(mi_atomic_load_ptr_relaxed(mi_segment_t, &segment->abandoned_next) == NULL);
+ mi_assert_internal(segment->next == NULL);
+ mi_assert_internal(segment->used > 0);
+ mi_tagged_segment_t next;
+ mi_tagged_segment_t ts = mi_atomic_load_relaxed(&abandoned);
+ do {
+ mi_atomic_store_ptr_release(mi_segment_t, &segment->abandoned_next, mi_tagged_segment_ptr(ts));
+ next = mi_tagged_segment(segment, ts);
+ } while (!mi_atomic_cas_weak_release(&abandoned, &ts, next));
+ mi_atomic_increment_relaxed(&abandoned_count);
+}
+
+// Wait until there are no more pending reads on segments that used to be in the abandoned list
+// called for example from `arena.c` before decommitting
+void _mi_abandoned_await_readers(void) {
+ size_t n;
+ do {
+ n = mi_atomic_load_acquire(&abandoned_readers);
+ if (n != 0) mi_atomic_yield();
+ } while (n != 0);
+}
+
+// Pop from the abandoned list
+static mi_segment_t* mi_abandoned_pop(void) {
+ mi_segment_t* segment;
+ // Check efficiently if it is empty (or if the visited list needs to be moved)
+ mi_tagged_segment_t ts = mi_atomic_load_relaxed(&abandoned);
+ segment = mi_tagged_segment_ptr(ts);
+ if (mi_likely(segment == NULL)) {
+ if (mi_likely(!mi_abandoned_visited_revisit())) { // try to swap in the visited list on NULL
+ return NULL;
+ }
+ }
+
+ // Do a pop. We use a reader count to prevent
+ // a segment to be decommitted while a read is still pending,
+ // and a tagged pointer to prevent A-B-A link corruption.
+ // (this is called from `region.c:_mi_mem_free` for example)
+ mi_atomic_increment_relaxed(&abandoned_readers); // ensure no segment gets decommitted
+ mi_tagged_segment_t next = 0;
+ ts = mi_atomic_load_acquire(&abandoned);
+ do {
+ segment = mi_tagged_segment_ptr(ts);
+ if (segment != NULL) {
+ mi_segment_t* anext = mi_atomic_load_ptr_relaxed(mi_segment_t, &segment->abandoned_next);
+ next = mi_tagged_segment(anext, ts); // note: reads the segment's `abandoned_next` field so should not be decommitted
+ }
+ } while (segment != NULL && !mi_atomic_cas_weak_acq_rel(&abandoned, &ts, next));
+ mi_atomic_decrement_relaxed(&abandoned_readers); // release reader lock
+ if (segment != NULL) {
+ mi_atomic_store_ptr_release(mi_segment_t, &segment->abandoned_next, NULL);
+ mi_atomic_decrement_relaxed(&abandoned_count);
+ }
+ return segment;
+}
+
+/* -----------------------------------------------------------
+ Abandon segment/page
+----------------------------------------------------------- */
+
+static void mi_segment_abandon(mi_segment_t* segment, mi_segments_tld_t* tld) {
+ mi_assert_internal(segment->used == segment->abandoned);
+ mi_assert_internal(segment->used > 0);
+ mi_assert_internal(mi_atomic_load_ptr_relaxed(mi_segment_t, &segment->abandoned_next) == NULL);
+ mi_assert_internal(segment->abandoned_visits == 0);
+ mi_assert_expensive(mi_segment_is_valid(segment,tld));
+
+ // remove the free pages from the free page queues
+ mi_slice_t* slice = &segment->slices[0];
+ const mi_slice_t* end = mi_segment_slices_end(segment);
+ while (slice < end) {
+ mi_assert_internal(slice->slice_count > 0);
+ mi_assert_internal(slice->slice_offset == 0);
+ if (slice->xblock_size == 0) { // a free page
+ mi_segment_span_remove_from_queue(slice,tld);
+ slice->xblock_size = 0; // but keep it free
+ }
+ slice = slice + slice->slice_count;
+ }
+
+ // perform delayed decommits
+ mi_segment_delayed_decommit(segment, mi_option_is_enabled(mi_option_abandoned_page_decommit) /* force? */, tld->stats);
+
+ // all pages in the segment are abandoned; add it to the abandoned list
+ _mi_stat_increase(&tld->stats->segments_abandoned, 1);
+ mi_segments_track_size(-((long)mi_segment_size(segment)), tld);
+ segment->thread_id = 0;
+ mi_atomic_store_ptr_release(mi_segment_t, &segment->abandoned_next, NULL);
+ segment->abandoned_visits = 1; // from 0 to 1 to signify it is abandoned
+ mi_abandoned_push(segment);
+}
+
+void _mi_segment_page_abandon(mi_page_t* page, mi_segments_tld_t* tld) {
+ mi_assert(page != NULL);
+ mi_assert_internal(mi_page_thread_free_flag(page)==MI_NEVER_DELAYED_FREE);
+ mi_assert_internal(mi_page_heap(page) == NULL);
+ mi_segment_t* segment = _mi_page_segment(page);
+
+ mi_assert_expensive(mi_segment_is_valid(segment,tld));
+ segment->abandoned++;
+
+ _mi_stat_increase(&tld->stats->pages_abandoned, 1);
+ mi_assert_internal(segment->abandoned <= segment->used);
+ if (segment->used == segment->abandoned) {
+ // all pages are abandoned, abandon the entire segment
+ mi_segment_abandon(segment, tld);
+ }
+}
+
+/* -----------------------------------------------------------
+ Reclaim abandoned pages
+----------------------------------------------------------- */
+
+static mi_slice_t* mi_slices_start_iterate(mi_segment_t* segment, const mi_slice_t** end) {
+ mi_slice_t* slice = &segment->slices[0];
+ *end = mi_segment_slices_end(segment);
+ mi_assert_internal(slice->slice_count>0 && slice->xblock_size>0); // segment allocated page
+ slice = slice + slice->slice_count; // skip the first segment allocated page
+ return slice;
+}
+
+// Possibly free pages and check if free space is available
+static bool mi_segment_check_free(mi_segment_t* segment, size_t slices_needed, size_t block_size, mi_segments_tld_t* tld)
+{
+ mi_assert_internal(block_size < MI_HUGE_BLOCK_SIZE);
+ mi_assert_internal(mi_segment_is_abandoned(segment));
+ bool has_page = false;
+
+ // for all slices
+ const mi_slice_t* end;
+ mi_slice_t* slice = mi_slices_start_iterate(segment, &end);
+ while (slice < end) {
+ mi_assert_internal(slice->slice_count > 0);
+ mi_assert_internal(slice->slice_offset == 0);
+ if (mi_slice_is_used(slice)) { // used page
+ // ensure used count is up to date and collect potential concurrent frees
+ mi_page_t* const page = mi_slice_to_page(slice);
+ _mi_page_free_collect(page, false);
+ if (mi_page_all_free(page)) {
+ // if this page is all free now, free it without adding to any queues (yet)
+ mi_assert_internal(page->next == NULL && page->prev==NULL);
+ _mi_stat_decrease(&tld->stats->pages_abandoned, 1);
+ segment->abandoned--;
+ slice = mi_segment_page_clear(page, tld); // re-assign slice due to coalesce!
+ mi_assert_internal(!mi_slice_is_used(slice));
+ if (slice->slice_count >= slices_needed) {
+ has_page = true;
+ }
+ }
+ else {
+ if (page->xblock_size == block_size && mi_page_has_any_available(page)) {
+ // a page has available free blocks of the right size
+ has_page = true;
+ }
+ }
+ }
+ else {
+ // empty span
+ if (slice->slice_count >= slices_needed) {
+ has_page = true;
+ }
+ }
+ slice = slice + slice->slice_count;
+ }
+ return has_page;
+}
+
+// Reclaim an abandoned segment; returns NULL if the segment was freed
+// set `right_page_reclaimed` to `true` if it reclaimed a page of the right `block_size` that was not full.
+static mi_segment_t* mi_segment_reclaim(mi_segment_t* segment, mi_heap_t* heap, size_t requested_block_size, bool* right_page_reclaimed, mi_segments_tld_t* tld) {
+ mi_assert_internal(mi_atomic_load_ptr_relaxed(mi_segment_t, &segment->abandoned_next) == NULL);
+ mi_assert_expensive(mi_segment_is_valid(segment, tld));
+ if (right_page_reclaimed != NULL) { *right_page_reclaimed = false; }
+
+ segment->thread_id = _mi_thread_id();
+ segment->abandoned_visits = 0;
+ mi_segments_track_size((long)mi_segment_size(segment), tld);
+ mi_assert_internal(segment->next == NULL);
+ _mi_stat_decrease(&tld->stats->segments_abandoned, 1);
+
+ // for all slices
+ const mi_slice_t* end;
+ mi_slice_t* slice = mi_slices_start_iterate(segment, &end);
+ while (slice < end) {
+ mi_assert_internal(slice->slice_count > 0);
+ mi_assert_internal(slice->slice_offset == 0);
+ if (mi_slice_is_used(slice)) {
+ // in use: reclaim the page in our heap
+ mi_page_t* page = mi_slice_to_page(slice);
+ mi_assert_internal(!page->is_reset);
+ mi_assert_internal(page->is_committed);
+ mi_assert_internal(mi_page_thread_free_flag(page)==MI_NEVER_DELAYED_FREE);
+ mi_assert_internal(mi_page_heap(page) == NULL);
+ mi_assert_internal(page->next == NULL && page->prev==NULL);
+ _mi_stat_decrease(&tld->stats->pages_abandoned, 1);
+ segment->abandoned--;
+ // set the heap again and allow delayed free again
+ mi_page_set_heap(page, heap);
+ _mi_page_use_delayed_free(page, MI_USE_DELAYED_FREE, true); // override never (after heap is set)
+ _mi_page_free_collect(page, false); // ensure used count is up to date
+ if (mi_page_all_free(page)) {
+ // if everything free by now, free the page
+ slice = mi_segment_page_clear(page, tld); // set slice again due to coalesceing
+ }
+ else {
+ // otherwise reclaim it into the heap
+ _mi_page_reclaim(heap, page);
+ if (requested_block_size == page->xblock_size && mi_page_has_any_available(page)) {
+ if (right_page_reclaimed != NULL) { *right_page_reclaimed = true; }
+ }
+ }
+ }
+ else {
+ // the span is free, add it to our page queues
+ slice = mi_segment_span_free_coalesce(slice, tld); // set slice again due to coalesceing
+ }
+ mi_assert_internal(slice->slice_count>0 && slice->slice_offset==0);
+ slice = slice + slice->slice_count;
+ }
+
+ mi_assert(segment->abandoned == 0);
+ if (segment->used == 0) { // due to page_clear
+ mi_assert_internal(right_page_reclaimed == NULL || !(*right_page_reclaimed));
+ mi_segment_free(segment, false, tld);
+ return NULL;
+ }
+ else {
+ return segment;
+ }
+}
+
+
+void _mi_abandoned_reclaim_all(mi_heap_t* heap, mi_segments_tld_t* tld) {
+ mi_segment_t* segment;
+ while ((segment = mi_abandoned_pop()) != NULL) {
+ mi_segment_reclaim(segment, heap, 0, NULL, tld);
+ }
+}
+
+static mi_segment_t* mi_segment_try_reclaim(mi_heap_t* heap, size_t needed_slices, size_t block_size, bool* reclaimed, mi_segments_tld_t* tld)
+{
+ *reclaimed = false;
+ mi_segment_t* segment;
+ long max_tries = mi_option_get_clamp(mi_option_max_segment_reclaim, 8, 1024); // limit the work to bound allocation times
+ while ((max_tries-- > 0) && ((segment = mi_abandoned_pop()) != NULL)) {
+ segment->abandoned_visits++;
+ bool has_page = mi_segment_check_free(segment,needed_slices,block_size,tld); // try to free up pages (due to concurrent frees)
+ if (segment->used == 0) {
+ // free the segment (by forced reclaim) to make it available to other threads.
+ // note1: we prefer to free a segment as that might lead to reclaiming another
+ // segment that is still partially used.
+ // note2: we could in principle optimize this by skipping reclaim and directly
+ // freeing but that would violate some invariants temporarily)
+ mi_segment_reclaim(segment, heap, 0, NULL, tld);
+ }
+ else if (has_page) {
+ // found a large enough free span, or a page of the right block_size with free space
+ // we return the result of reclaim (which is usually `segment`) as it might free
+ // the segment due to concurrent frees (in which case `NULL` is returned).
+ return mi_segment_reclaim(segment, heap, block_size, reclaimed, tld);
+ }
+ else if (segment->abandoned_visits > 3) {
+ // always reclaim on 3rd visit to limit the abandoned queue length.
+ mi_segment_reclaim(segment, heap, 0, NULL, tld);
+ }
+ else {
+ // otherwise, push on the visited list so it gets not looked at too quickly again
+ mi_segment_delayed_decommit(segment, true /* force? */, tld->stats); // forced decommit if needed as we may not visit soon again
+ mi_abandoned_visited_push(segment);
+ }
+ }
+ return NULL;
+}
+
+
+void _mi_abandoned_collect(mi_heap_t* heap, bool force, mi_segments_tld_t* tld)
+{
+ mi_segment_t* segment;
+ int max_tries = (force ? 16*1024 : 1024); // limit latency
+ if (force) {
+ mi_abandoned_visited_revisit();
+ }
+ while ((max_tries-- > 0) && ((segment = mi_abandoned_pop()) != NULL)) {
+ mi_segment_check_free(segment,0,0,tld); // try to free up pages (due to concurrent frees)
+ if (segment->used == 0) {
+ // free the segment (by forced reclaim) to make it available to other threads.
+ // note: we could in principle optimize this by skipping reclaim and directly
+ // freeing but that would violate some invariants temporarily)
+ mi_segment_reclaim(segment, heap, 0, NULL, tld);
+ }
+ else {
+ // otherwise, decommit if needed and push on the visited list
+ // note: forced decommit can be expensive if many threads are destroyed/created as in mstress.
+ mi_segment_delayed_decommit(segment, force, tld->stats);
+ mi_abandoned_visited_push(segment);
+ }
+ }
+}
+
+/* -----------------------------------------------------------
+ Reclaim or allocate
+----------------------------------------------------------- */
+
+static mi_segment_t* mi_segment_reclaim_or_alloc(mi_heap_t* heap, size_t needed_slices, size_t block_size, mi_segments_tld_t* tld, mi_os_tld_t* os_tld)
+{
+ mi_assert_internal(block_size < MI_HUGE_BLOCK_SIZE);
+ mi_assert_internal(block_size <= MI_LARGE_OBJ_SIZE_MAX);
+
+ // 1. try to reclaim an abandoned segment
+ bool reclaimed;
+ mi_segment_t* segment = mi_segment_try_reclaim(heap, needed_slices, block_size, &reclaimed, tld);
+ if (reclaimed) {
+ // reclaimed the right page right into the heap
+ mi_assert_internal(segment != NULL);
+ return NULL; // pretend out-of-memory as the page will be in the page queue of the heap with available blocks
+ }
+ else if (segment != NULL) {
+ // reclaimed a segment with a large enough empty span in it
+ return segment;
+ }
+ // 2. otherwise allocate a fresh segment
+ return mi_segment_alloc(0, tld, os_tld, NULL);
+}
+
+
+/* -----------------------------------------------------------
+ Page allocation
+----------------------------------------------------------- */
+
+static mi_page_t* mi_segments_page_alloc(mi_heap_t* heap, mi_page_kind_t page_kind, size_t required, size_t block_size, mi_segments_tld_t* tld, mi_os_tld_t* os_tld)
+{
+ mi_assert_internal(required <= MI_LARGE_OBJ_SIZE_MAX && page_kind <= MI_PAGE_LARGE);
+
+ // find a free page
+ size_t page_size = _mi_align_up(required, (required > MI_MEDIUM_PAGE_SIZE ? MI_MEDIUM_PAGE_SIZE : MI_SEGMENT_SLICE_SIZE));
+ size_t slices_needed = page_size / MI_SEGMENT_SLICE_SIZE;
+ mi_assert_internal(slices_needed * MI_SEGMENT_SLICE_SIZE == page_size);
+ mi_page_t* page = mi_segments_page_find_and_allocate(slices_needed, tld); //(required <= MI_SMALL_SIZE_MAX ? 0 : slices_needed), tld);
+ if (page==NULL) {
+ // no free page, allocate a new segment and try again
+ if (mi_segment_reclaim_or_alloc(heap, slices_needed, block_size, tld, os_tld) == NULL) {
+ // OOM or reclaimed a good page in the heap
+ return NULL;
+ }
+ else {
+ // otherwise try again
+ return mi_segments_page_alloc(heap, page_kind, required, block_size, tld, os_tld);
+ }
+ }
+ mi_assert_internal(page != NULL && page->slice_count*MI_SEGMENT_SLICE_SIZE == page_size);
+ mi_assert_internal(_mi_ptr_segment(page)->thread_id == _mi_thread_id());
+ mi_segment_delayed_decommit(_mi_ptr_segment(page), false, tld->stats);
+ return page;
+}
+
+
+
+/* -----------------------------------------------------------
+ Huge page allocation
+----------------------------------------------------------- */
+
+static mi_page_t* mi_segment_huge_page_alloc(size_t size, mi_segments_tld_t* tld, mi_os_tld_t* os_tld)
+{
+ mi_page_t* page = NULL;
+ mi_segment_t* segment = mi_segment_alloc(size,tld,os_tld,&page);
+ if (segment == NULL || page==NULL) return NULL;
+ mi_assert_internal(segment->used==1);
+ mi_assert_internal(mi_page_block_size(page) >= size);
+ segment->thread_id = 0; // huge segments are immediately abandoned
+ return page;
+}
+
+// free huge block from another thread
+void _mi_segment_huge_page_free(mi_segment_t* segment, mi_page_t* page, mi_block_t* block) {
+ // huge page segments are always abandoned and can be freed immediately by any thread
+ mi_assert_internal(segment->kind==MI_SEGMENT_HUGE);
+ mi_assert_internal(segment == _mi_page_segment(page));
+ mi_assert_internal(mi_atomic_load_relaxed(&segment->thread_id)==0);
+
+ // claim it and free
+ mi_heap_t* heap = mi_heap_get_default(); // issue #221; don't use the internal get_default_heap as we need to ensure the thread is initialized.
+ // paranoia: if this it the last reference, the cas should always succeed
+ size_t expected_tid = 0;
+ if (mi_atomic_cas_strong_acq_rel(&segment->thread_id, &expected_tid, heap->thread_id)) {
+ mi_block_set_next(page, block, page->free);
+ page->free = block;
+ page->used--;
+ page->is_zero = false;
+ mi_assert(page->used == 0);
+ mi_tld_t* tld = heap->tld;
+ _mi_segment_page_free(page, true, &tld->segments);
+ }
+#if (MI_DEBUG!=0)
+ else {
+ mi_assert_internal(false);
+ }
+#endif
+}
+
+/* -----------------------------------------------------------
+ Page allocation and free
+----------------------------------------------------------- */
+mi_page_t* _mi_segment_page_alloc(mi_heap_t* heap, size_t block_size, mi_segments_tld_t* tld, mi_os_tld_t* os_tld) {
+ mi_page_t* page;
+ if (block_size <= MI_SMALL_OBJ_SIZE_MAX) {
+ page = mi_segments_page_alloc(heap,MI_PAGE_SMALL,block_size,block_size,tld,os_tld);
+ }
+ else if (block_size <= MI_MEDIUM_OBJ_SIZE_MAX) {
+ page = mi_segments_page_alloc(heap,MI_PAGE_MEDIUM,MI_MEDIUM_PAGE_SIZE,block_size,tld, os_tld);
+ }
+ else if (block_size <= MI_LARGE_OBJ_SIZE_MAX) {
+ page = mi_segments_page_alloc(heap,MI_PAGE_LARGE,block_size,block_size,tld, os_tld);
+ }
+ else {
+ page = mi_segment_huge_page_alloc(block_size,tld,os_tld);
+ }
+ mi_assert_expensive(page == NULL || mi_segment_is_valid(_mi_page_segment(page),tld));
+ return page;
+}
+
+
diff --git a/source/luametatex/source/libraries/mimalloc/src/static.c b/source/luametatex/source/libraries/mimalloc/src/static.c
new file mode 100644
index 000000000..5b34ddbb6
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/static.c
@@ -0,0 +1,39 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2020, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#ifndef _DEFAULT_SOURCE
+#define _DEFAULT_SOURCE
+#endif
+#if defined(__sun)
+// same remarks as os.c for the static's context.
+#undef _XOPEN_SOURCE
+#undef _POSIX_C_SOURCE
+#endif
+
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+
+// For a static override we create a single object file
+// containing the whole library. If it is linked first
+// it will override all the standard library allocation
+// functions (on Unix's).
+#include "stats.c"
+#include "random.c"
+#include "os.c"
+#include "bitmap.c"
+#include "arena.c"
+#include "segment-cache.c"
+#include "segment.c"
+#include "page.c"
+#include "heap.c"
+#include "alloc.c"
+#include "alloc-aligned.c"
+#include "alloc-posix.c"
+#if MI_OSX_ZONE
+#include "alloc-override-osx.c"
+#endif
+#include "init.c"
+#include "options.c"
diff --git a/source/luametatex/source/libraries/mimalloc/src/stats.c b/source/luametatex/source/libraries/mimalloc/src/stats.c
new file mode 100644
index 000000000..134a7bcb6
--- /dev/null
+++ b/source/luametatex/source/libraries/mimalloc/src/stats.c
@@ -0,0 +1,584 @@
+/* ----------------------------------------------------------------------------
+Copyright (c) 2018-2021, Microsoft Research, Daan Leijen
+This is free software; you can redistribute it and/or modify it under the
+terms of the MIT license. A copy of the license can be found in the file
+"LICENSE" at the root of this distribution.
+-----------------------------------------------------------------------------*/
+#include "mimalloc.h"
+#include "mimalloc-internal.h"
+#include "mimalloc-atomic.h"
+
+#include <stdio.h> // fputs, stderr
+#include <string.h> // memset
+
+#if defined(_MSC_VER) && (_MSC_VER < 1920)
+#pragma warning(disable:4204) // non-constant aggregate initializer
+#endif
+
+/* -----------------------------------------------------------
+ Statistics operations
+----------------------------------------------------------- */
+
+static bool mi_is_in_main(void* stat) {
+ return ((uint8_t*)stat >= (uint8_t*)&_mi_stats_main
+ && (uint8_t*)stat < ((uint8_t*)&_mi_stats_main + sizeof(mi_stats_t)));
+}
+
+static void mi_stat_update(mi_stat_count_t* stat, int64_t amount) {
+ if (amount == 0) return;
+ if (mi_is_in_main(stat))
+ {
+ // add atomically (for abandoned pages)
+ int64_t current = mi_atomic_addi64_relaxed(&stat->current, amount);
+ mi_atomic_maxi64_relaxed(&stat->peak, current + amount);
+ if (amount > 0) {
+ mi_atomic_addi64_relaxed(&stat->allocated,amount);
+ }
+ else {
+ mi_atomic_addi64_relaxed(&stat->freed, -amount);
+ }
+ }
+ else {
+ // add thread local
+ stat->current += amount;
+ if (stat->current > stat->peak) stat->peak = stat->current;
+ if (amount > 0) {
+ stat->allocated += amount;
+ }
+ else {
+ stat->freed += -amount;
+ }
+ }
+}
+
+void _mi_stat_counter_increase(mi_stat_counter_t* stat, size_t amount) {
+ if (mi_is_in_main(stat)) {
+ mi_atomic_addi64_relaxed( &stat->count, 1 );
+ mi_atomic_addi64_relaxed( &stat->total, (int64_t)amount );
+ }
+ else {
+ stat->count++;
+ stat->total += amount;
+ }
+}
+
+void _mi_stat_increase(mi_stat_count_t* stat, size_t amount) {
+ mi_stat_update(stat, (int64_t)amount);
+}
+
+void _mi_stat_decrease(mi_stat_count_t* stat, size_t amount) {
+ mi_stat_update(stat, -((int64_t)amount));
+}
+
+// must be thread safe as it is called from stats_merge
+static void mi_stat_add(mi_stat_count_t* stat, const mi_stat_count_t* src, int64_t unit) {
+ if (stat==src) return;
+ if (src->allocated==0 && src->freed==0) return;
+ mi_atomic_addi64_relaxed( &stat->allocated, src->allocated * unit);
+ mi_atomic_addi64_relaxed( &stat->current, src->current * unit);
+ mi_atomic_addi64_relaxed( &stat->freed, src->freed * unit);
+ // peak scores do not work across threads..
+ mi_atomic_addi64_relaxed( &stat->peak, src->peak * unit);
+}
+
+static void mi_stat_counter_add(mi_stat_counter_t* stat, const mi_stat_counter_t* src, int64_t unit) {
+ if (stat==src) return;
+ mi_atomic_addi64_relaxed( &stat->total, src->total * unit);
+ mi_atomic_addi64_relaxed( &stat->count, src->count * unit);
+}
+
+// must be thread safe as it is called from stats_merge
+static void mi_stats_add(mi_stats_t* stats, const mi_stats_t* src) {
+ if (stats==src) return;
+ mi_stat_add(&stats->segments, &src->segments,1);
+ mi_stat_add(&stats->pages, &src->pages,1);
+ mi_stat_add(&stats->reserved, &src->reserved, 1);
+ mi_stat_add(&stats->committed, &src->committed, 1);
+ mi_stat_add(&stats->reset, &src->reset, 1);
+ mi_stat_add(&stats->page_committed, &src->page_committed, 1);
+
+ mi_stat_add(&stats->pages_abandoned, &src->pages_abandoned, 1);
+ mi_stat_add(&stats->segments_abandoned, &src->segments_abandoned, 1);
+ mi_stat_add(&stats->threads, &src->threads, 1);
+
+ mi_stat_add(&stats->malloc, &src->malloc, 1);
+ mi_stat_add(&stats->segments_cache, &src->segments_cache, 1);
+ mi_stat_add(&stats->normal, &src->normal, 1);
+ mi_stat_add(&stats->huge, &src->huge, 1);
+ mi_stat_add(&stats->large, &src->large, 1);
+
+ mi_stat_counter_add(&stats->pages_extended, &src->pages_extended, 1);
+ mi_stat_counter_add(&stats->mmap_calls, &src->mmap_calls, 1);
+ mi_stat_counter_add(&stats->commit_calls, &src->commit_calls, 1);
+
+ mi_stat_counter_add(&stats->page_no_retire, &src->page_no_retire, 1);
+ mi_stat_counter_add(&stats->searches, &src->searches, 1);
+ mi_stat_counter_add(&stats->normal_count, &src->normal_count, 1);
+ mi_stat_counter_add(&stats->huge_count, &src->huge_count, 1);
+ mi_stat_counter_add(&stats->large_count, &src->large_count, 1);
+#if MI_STAT>1
+ for (size_t i = 0; i <= MI_BIN_HUGE; i++) {
+ if (src->normal_bins[i].allocated > 0 || src->normal_bins[i].freed > 0) {
+ mi_stat_add(&stats->normal_bins[i], &src->normal_bins[i], 1);
+ }
+ }
+#endif
+}
+
+/* -----------------------------------------------------------
+ Display statistics
+----------------------------------------------------------- */
+
+// unit > 0 : size in binary bytes
+// unit == 0: count as decimal
+// unit < 0 : count in binary
+static void mi_printf_amount(int64_t n, int64_t unit, mi_output_fun* out, void* arg, const char* fmt) {
+ char buf[32]; buf[0] = 0;
+ int len = 32;
+ const char* suffix = (unit <= 0 ? " " : "B");
+ const int64_t base = (unit == 0 ? 1000 : 1024);
+ if (unit>0) n *= unit;
+
+ const int64_t pos = (n < 0 ? -n : n);
+ if (pos < base) {
+ if (n!=1 || suffix[0] != 'B') { // skip printing 1 B for the unit column
+ snprintf(buf, len, "%d %-3s", (int)n, (n==0 ? "" : suffix));
+ }
+ }
+ else {
+ int64_t divider = base;
+ const char* magnitude = "K";
+ if (pos >= divider*base) { divider *= base; magnitude = "M"; }
+ if (pos >= divider*base) { divider *= base; magnitude = "G"; }
+ const int64_t tens = (n / (divider/10));
+ const long whole = (long)(tens/10);
+ const long frac1 = (long)(tens%10);
+ char unitdesc[8];
+ snprintf(unitdesc, 8, "%s%s%s", magnitude, (base==1024 ? "i" : ""), suffix);
+ snprintf(buf, len, "%ld.%ld %-3s", whole, (frac1 < 0 ? -frac1 : frac1), unitdesc);
+ }
+ _mi_fprintf(out, arg, (fmt==NULL ? "%11s" : fmt), buf);
+}
+
+
+static void mi_print_amount(int64_t n, int64_t unit, mi_output_fun* out, void* arg) {
+ mi_printf_amount(n,unit,out,arg,NULL);
+}
+
+static void mi_print_count(int64_t n, int64_t unit, mi_output_fun* out, void* arg) {
+ if (unit==1) _mi_fprintf(out, arg, "%11s"," ");
+ else mi_print_amount(n,0,out,arg);
+}
+
+static void mi_stat_print(const mi_stat_count_t* stat, const char* msg, int64_t unit, mi_output_fun* out, void* arg ) {
+ _mi_fprintf(out, arg,"%10s:", msg);
+ if (unit>0) {
+ mi_print_amount(stat->peak, unit, out, arg);
+ mi_print_amount(stat->allocated, unit, out, arg);
+ mi_print_amount(stat->freed, unit, out, arg);
+ mi_print_amount(stat->current, unit, out, arg);
+ mi_print_amount(unit, 1, out, arg);
+ mi_print_count(stat->allocated, unit, out, arg);
+ if (stat->allocated > stat->freed)
+ _mi_fprintf(out, arg, " not all freed!\n");
+ else
+ _mi_fprintf(out, arg, " ok\n");
+ }
+ else if (unit<0) {
+ mi_print_amount(stat->peak, -1, out, arg);
+ mi_print_amount(stat->allocated, -1, out, arg);
+ mi_print_amount(stat->freed, -1, out, arg);
+ mi_print_amount(stat->current, -1, out, arg);
+ if (unit==-1) {
+ _mi_fprintf(out, arg, "%22s", "");
+ }
+ else {
+ mi_print_amount(-unit, 1, out, arg);
+ mi_print_count((stat->allocated / -unit), 0, out, arg);
+ }
+ if (stat->allocated > stat->freed)
+ _mi_fprintf(out, arg, " not all freed!\n");
+ else
+ _mi_fprintf(out, arg, " ok\n");
+ }
+ else {
+ mi_print_amount(stat->peak, 1, out, arg);
+ mi_print_amount(stat->allocated, 1, out, arg);
+ _mi_fprintf(out, arg, "%11s", " "); // no freed
+ mi_print_amount(stat->current, 1, out, arg);
+ _mi_fprintf(out, arg, "\n");
+ }
+}
+
+static void mi_stat_counter_print(const mi_stat_counter_t* stat, const char* msg, mi_output_fun* out, void* arg ) {
+ _mi_fprintf(out, arg, "%10s:", msg);
+ mi_print_amount(stat->total, -1, out, arg);
+ _mi_fprintf(out, arg, "\n");
+}
+
+static void mi_stat_counter_print_avg(const mi_stat_counter_t* stat, const char* msg, mi_output_fun* out, void* arg) {
+ const int64_t avg_tens = (stat->count == 0 ? 0 : (stat->total*10 / stat->count));
+ const long avg_whole = (long)(avg_tens/10);
+ const long avg_frac1 = (long)(avg_tens%10);
+ _mi_fprintf(out, arg, "%10s: %5ld.%ld avg\n", msg, avg_whole, avg_frac1);
+}
+
+
+static void mi_print_header(mi_output_fun* out, void* arg ) {
+ _mi_fprintf(out, arg, "%10s: %10s %10s %10s %10s %10s %10s\n", "heap stats", "peak ", "total ", "freed ", "current ", "unit ", "count ");
+}
+
+#if MI_STAT>1
+static void mi_stats_print_bins(const mi_stat_count_t* bins, size_t max, const char* fmt, mi_output_fun* out, void* arg) {
+ bool found = false;
+ char buf[64];
+ for (size_t i = 0; i <= max; i++) {
+ if (bins[i].allocated > 0) {
+ found = true;
+ int64_t unit = _mi_bin_size((uint8_t)i);
+ snprintf(buf, 64, "%s %3lu", fmt, (long)i);
+ mi_stat_print(&bins[i], buf, unit, out, arg);
+ }
+ }
+ if (found) {
+ _mi_fprintf(out, arg, "\n");
+ mi_print_header(out, arg);
+ }
+}
+#endif
+
+
+
+//------------------------------------------------------------
+// Use an output wrapper for line-buffered output
+// (which is nice when using loggers etc.)
+//------------------------------------------------------------
+typedef struct buffered_s {
+ mi_output_fun* out; // original output function
+ void* arg; // and state
+ char* buf; // local buffer of at least size `count+1`
+ size_t used; // currently used chars `used <= count`
+ size_t count; // total chars available for output
+} buffered_t;
+
+static void mi_buffered_flush(buffered_t* buf) {
+ buf->buf[buf->used] = 0;
+ _mi_fputs(buf->out, buf->arg, NULL, buf->buf);
+ buf->used = 0;
+}
+
+static void mi_buffered_out(const char* msg, void* arg) {
+ buffered_t* buf = (buffered_t*)arg;
+ if (msg==NULL || buf==NULL) return;
+ for (const char* src = msg; *src != 0; src++) {
+ char c = *src;
+ if (buf->used >= buf->count) mi_buffered_flush(buf);
+ mi_assert_internal(buf->used < buf->count);
+ buf->buf[buf->used++] = c;
+ if (c == '\n') mi_buffered_flush(buf);
+ }
+}
+
+//------------------------------------------------------------
+// Print statistics
+//------------------------------------------------------------
+
+static void mi_stat_process_info(mi_msecs_t* elapsed, mi_msecs_t* utime, mi_msecs_t* stime, size_t* current_rss, size_t* peak_rss, size_t* current_commit, size_t* peak_commit, size_t* page_faults);
+
+static void _mi_stats_print(mi_stats_t* stats, mi_output_fun* out0, void* arg0) mi_attr_noexcept {
+ // wrap the output function to be line buffered
+ char buf[256];
+ buffered_t buffer = { out0, arg0, NULL, 0, 255 };
+ buffer.buf = buf;
+ mi_output_fun* out = &mi_buffered_out;
+ void* arg = &buffer;
+
+ // and print using that
+ mi_print_header(out,arg);
+ #if MI_STAT>1
+ mi_stats_print_bins(stats->normal_bins, MI_BIN_HUGE, "normal",out,arg);
+ #endif
+ #if MI_STAT
+ mi_stat_print(&stats->normal, "normal", (stats->normal_count.count == 0 ? 1 : -(stats->normal.allocated / stats->normal_count.count)), out, arg);
+ mi_stat_print(&stats->large, "large", (stats->large_count.count == 0 ? 1 : -(stats->large.allocated / stats->large_count.count)), out, arg);
+ mi_stat_print(&stats->huge, "huge", (stats->huge_count.count == 0 ? 1 : -(stats->huge.allocated / stats->huge_count.count)), out, arg);
+ mi_stat_count_t total = { 0,0,0,0 };
+ mi_stat_add(&total, &stats->normal, 1);
+ mi_stat_add(&total, &stats->large, 1);
+ mi_stat_add(&total, &stats->huge, 1);
+ mi_stat_print(&total, "total", 1, out, arg);
+ #endif
+ #if MI_STAT>1
+ mi_stat_print(&stats->malloc, "malloc req", 1, out, arg);
+ _mi_fprintf(out, arg, "\n");
+ #endif
+ mi_stat_print(&stats->reserved, "reserved", 1, out, arg);
+ mi_stat_print(&stats->committed, "committed", 1, out, arg);
+ mi_stat_print(&stats->reset, "reset", 1, out, arg);
+ mi_stat_print(&stats->page_committed, "touched", 1, out, arg);
+ mi_stat_print(&stats->segments, "segments", -1, out, arg);
+ mi_stat_print(&stats->segments_abandoned, "-abandoned", -1, out, arg);
+ mi_stat_print(&stats->segments_cache, "-cached", -1, out, arg);
+ mi_stat_print(&stats->pages, "pages", -1, out, arg);
+ mi_stat_print(&stats->pages_abandoned, "-abandoned", -1, out, arg);
+ mi_stat_counter_print(&stats->pages_extended, "-extended", out, arg);
+ mi_stat_counter_print(&stats->page_no_retire, "-noretire", out, arg);
+ mi_stat_counter_print(&stats->mmap_calls, "mmaps", out, arg);
+ mi_stat_counter_print(&stats->commit_calls, "commits", out, arg);
+ mi_stat_print(&stats->threads, "threads", -1, out, arg);
+ mi_stat_counter_print_avg(&stats->searches, "searches", out, arg);
+ _mi_fprintf(out, arg, "%10s: %7zu\n", "numa nodes", _mi_os_numa_node_count());
+
+ mi_msecs_t elapsed;
+ mi_msecs_t user_time;
+ mi_msecs_t sys_time;
+ size_t current_rss;
+ size_t peak_rss;
+ size_t current_commit;
+ size_t peak_commit;
+ size_t page_faults;
+ mi_stat_process_info(&elapsed, &user_time, &sys_time, &current_rss, &peak_rss, &current_commit, &peak_commit, &page_faults);
+ _mi_fprintf(out, arg, "%10s: %7ld.%03ld s\n", "elapsed", elapsed/1000, elapsed%1000);
+ _mi_fprintf(out, arg, "%10s: user: %ld.%03ld s, system: %ld.%03ld s, faults: %lu, rss: ", "process",
+ user_time/1000, user_time%1000, sys_time/1000, sys_time%1000, (unsigned long)page_faults );
+ mi_printf_amount((int64_t)peak_rss, 1, out, arg, "%s");
+ if (peak_commit > 0) {
+ _mi_fprintf(out, arg, ", commit: ");
+ mi_printf_amount((int64_t)peak_commit, 1, out, arg, "%s");
+ }
+ _mi_fprintf(out, arg, "\n");
+}
+
+static mi_msecs_t mi_process_start; // = 0
+
+static mi_stats_t* mi_stats_get_default(void) {
+ mi_heap_t* heap = mi_heap_get_default();
+ return &heap->tld->stats;
+}
+
+static void mi_stats_merge_from(mi_stats_t* stats) {
+ if (stats != &_mi_stats_main) {
+ mi_stats_add(&_mi_stats_main, stats);
+ memset(stats, 0, sizeof(mi_stats_t));
+ }
+}
+
+void mi_stats_reset(void) mi_attr_noexcept {
+ mi_stats_t* stats = mi_stats_get_default();
+ if (stats != &_mi_stats_main) { memset(stats, 0, sizeof(mi_stats_t)); }
+ memset(&_mi_stats_main, 0, sizeof(mi_stats_t));
+ if (mi_process_start == 0) { mi_process_start = _mi_clock_start(); };
+}
+
+void mi_stats_merge(void) mi_attr_noexcept {
+ mi_stats_merge_from( mi_stats_get_default() );
+}
+
+void _mi_stats_done(mi_stats_t* stats) { // called from `mi_thread_done`
+ mi_stats_merge_from(stats);
+}
+
+void mi_stats_print_out(mi_output_fun* out, void* arg) mi_attr_noexcept {
+ mi_stats_merge_from(mi_stats_get_default());
+ _mi_stats_print(&_mi_stats_main, out, arg);
+}
+
+void mi_stats_print(void* out) mi_attr_noexcept {
+ // for compatibility there is an `out` parameter (which can be `stdout` or `stderr`)
+ mi_stats_print_out((mi_output_fun*)out, NULL);
+}
+
+void mi_thread_stats_print_out(mi_output_fun* out, void* arg) mi_attr_noexcept {
+ _mi_stats_print(mi_stats_get_default(), out, arg);
+}
+
+
+// ----------------------------------------------------------------
+// Basic timer for convenience; use milli-seconds to avoid doubles
+// ----------------------------------------------------------------
+#ifdef _WIN32
+#include <windows.h>
+static mi_msecs_t mi_to_msecs(LARGE_INTEGER t) {
+ static LARGE_INTEGER mfreq; // = 0
+ if (mfreq.QuadPart == 0LL) {
+ LARGE_INTEGER f;
+ QueryPerformanceFrequency(&f);
+ mfreq.QuadPart = f.QuadPart/1000LL;
+ if (mfreq.QuadPart == 0) mfreq.QuadPart = 1;
+ }
+ return (mi_msecs_t)(t.QuadPart / mfreq.QuadPart);
+}
+
+mi_msecs_t _mi_clock_now(void) {
+ LARGE_INTEGER t;
+ QueryPerformanceCounter(&t);
+ return mi_to_msecs(t);
+}
+#else
+#include <time.h>
+#if defined(CLOCK_REALTIME) || defined(CLOCK_MONOTONIC)
+mi_msecs_t _mi_clock_now(void) {
+ struct timespec t;
+ #ifdef CLOCK_MONOTONIC
+ clock_gettime(CLOCK_MONOTONIC, &t);
+ #else
+ clock_gettime(CLOCK_REALTIME, &t);
+ #endif
+ return ((mi_msecs_t)t.tv_sec * 1000) + ((mi_msecs_t)t.tv_nsec / 1000000);
+}
+#else
+// low resolution timer
+mi_msecs_t _mi_clock_now(void) {
+ return ((mi_msecs_t)clock() / ((mi_msecs_t)CLOCKS_PER_SEC / 1000));
+}
+#endif
+#endif
+
+
+static mi_msecs_t mi_clock_diff;
+
+mi_msecs_t _mi_clock_start(void) {
+ if (mi_clock_diff == 0.0) {
+ mi_msecs_t t0 = _mi_clock_now();
+ mi_clock_diff = _mi_clock_now() - t0;
+ }
+ return _mi_clock_now();
+}
+
+mi_msecs_t _mi_clock_end(mi_msecs_t start) {
+ mi_msecs_t end = _mi_clock_now();
+ return (end - start - mi_clock_diff);
+}
+
+
+// --------------------------------------------------------
+// Basic process statistics
+// --------------------------------------------------------
+
+#if defined(_WIN32)
+#include <windows.h>
+#include <psapi.h>
+#pragma comment(lib,"psapi.lib")
+
+static mi_msecs_t filetime_msecs(const FILETIME* ftime) {
+ ULARGE_INTEGER i;
+ i.LowPart = ftime->dwLowDateTime;
+ i.HighPart = ftime->dwHighDateTime;
+ mi_msecs_t msecs = (i.QuadPart / 10000); // FILETIME is in 100 nano seconds
+ return msecs;
+}
+
+static void mi_stat_process_info(mi_msecs_t* elapsed, mi_msecs_t* utime, mi_msecs_t* stime, size_t* current_rss, size_t* peak_rss, size_t* current_commit, size_t* peak_commit, size_t* page_faults)
+{
+ *elapsed = _mi_clock_end(mi_process_start);
+ FILETIME ct;
+ FILETIME ut;
+ FILETIME st;
+ FILETIME et;
+ GetProcessTimes(GetCurrentProcess(), &ct, &et, &st, &ut);
+ *utime = filetime_msecs(&ut);
+ *stime = filetime_msecs(&st);
+ PROCESS_MEMORY_COUNTERS info;
+ GetProcessMemoryInfo(GetCurrentProcess(), &info, sizeof(info));
+ *current_rss = (size_t)info.WorkingSetSize;
+ *peak_rss = (size_t)info.PeakWorkingSetSize;
+ *current_commit = (size_t)info.PagefileUsage;
+ *peak_commit = (size_t)info.PeakPagefileUsage;
+ *page_faults = (size_t)info.PageFaultCount;
+}
+
+#elif !defined(__wasi__) && (defined(__unix__) || defined(__unix) || defined(unix) || defined(__APPLE__) || defined(__HAIKU__))
+#include <stdio.h>
+#include <unistd.h>
+#include <sys/resource.h>
+
+#if defined(__APPLE__)
+#include <mach/mach.h>
+#endif
+
+#if defined(__HAIKU__)
+#include <kernel/OS.h>
+#endif
+
+static mi_msecs_t timeval_secs(const struct timeval* tv) {
+ return ((mi_msecs_t)tv->tv_sec * 1000L) + ((mi_msecs_t)tv->tv_usec / 1000L);
+}
+
+static void mi_stat_process_info(mi_msecs_t* elapsed, mi_msecs_t* utime, mi_msecs_t* stime, size_t* current_rss, size_t* peak_rss, size_t* current_commit, size_t* peak_commit, size_t* page_faults)
+{
+ *elapsed = _mi_clock_end(mi_process_start);
+ struct rusage rusage;
+ getrusage(RUSAGE_SELF, &rusage);
+ *utime = timeval_secs(&rusage.ru_utime);
+ *stime = timeval_secs(&rusage.ru_stime);
+#if !defined(__HAIKU__)
+ *page_faults = rusage.ru_majflt;
+#endif
+ // estimate commit using our stats
+ *peak_commit = (size_t)(mi_atomic_loadi64_relaxed((_Atomic(int64_t)*)&_mi_stats_main.committed.peak));
+ *current_commit = (size_t)(mi_atomic_loadi64_relaxed((_Atomic(int64_t)*)&_mi_stats_main.committed.current));
+ *current_rss = *current_commit; // estimate
+#if defined(__HAIKU__)
+ // Haiku does not have (yet?) a way to
+ // get these stats per process
+ thread_info tid;
+ area_info mem;
+ ssize_t c;
+ get_thread_info(find_thread(0), &tid);
+ while (get_next_area_info(tid.team, &c, &mem) == B_OK) {
+ *peak_rss += mem.ram_size;
+ }
+ *page_faults = 0;
+#elif defined(__APPLE__)
+ *peak_rss = rusage.ru_maxrss; // BSD reports in bytes
+ struct mach_task_basic_info info;
+ mach_msg_type_number_t infoCount = MACH_TASK_BASIC_INFO_COUNT;
+ if (task_info(mach_task_self(), MACH_TASK_BASIC_INFO, (task_info_t)&info, &infoCount) == KERN_SUCCESS) {
+ *current_rss = (size_t)info.resident_size;
+ }
+#else
+ *peak_rss = rusage.ru_maxrss * 1024; // Linux reports in KiB
+#endif
+}
+
+#else
+#ifndef __wasi__
+// WebAssembly instances are not processes
+#pragma message("define a way to get process info")
+#endif
+
+static void mi_stat_process_info(mi_msecs_t* elapsed, mi_msecs_t* utime, mi_msecs_t* stime, size_t* current_rss, size_t* peak_rss, size_t* current_commit, size_t* peak_commit, size_t* page_faults)
+{
+ *elapsed = _mi_clock_end(mi_process_start);
+ *peak_commit = (size_t)(mi_atomic_loadi64_relaxed((_Atomic(int64_t)*)&_mi_stats_main.committed.peak));
+ *current_commit = (size_t)(mi_atomic_loadi64_relaxed((_Atomic(int64_t)*)&_mi_stats_main.committed.current));
+ *peak_rss = *peak_commit;
+ *current_rss = *current_commit;
+ *page_faults = 0;
+ *utime = 0;
+ *stime = 0;
+}
+#endif
+
+
+mi_decl_export void mi_process_info(size_t* elapsed_msecs, size_t* user_msecs, size_t* system_msecs, size_t* current_rss, size_t* peak_rss, size_t* current_commit, size_t* peak_commit, size_t* page_faults) mi_attr_noexcept
+{
+ mi_msecs_t elapsed = 0;
+ mi_msecs_t utime = 0;
+ mi_msecs_t stime = 0;
+ size_t current_rss0 = 0;
+ size_t peak_rss0 = 0;
+ size_t current_commit0 = 0;
+ size_t peak_commit0 = 0;
+ size_t page_faults0 = 0;
+ mi_stat_process_info(&elapsed,&utime, &stime, &current_rss0, &peak_rss0, &current_commit0, &peak_commit0, &page_faults0);
+ if (elapsed_msecs!=NULL) *elapsed_msecs = (elapsed < 0 ? 0 : (elapsed < (mi_msecs_t)PTRDIFF_MAX ? (size_t)elapsed : PTRDIFF_MAX));
+ if (user_msecs!=NULL) *user_msecs = (utime < 0 ? 0 : (utime < (mi_msecs_t)PTRDIFF_MAX ? (size_t)utime : PTRDIFF_MAX));
+ if (system_msecs!=NULL) *system_msecs = (stime < 0 ? 0 : (stime < (mi_msecs_t)PTRDIFF_MAX ? (size_t)stime : PTRDIFF_MAX));
+ if (current_rss!=NULL) *current_rss = current_rss0;
+ if (peak_rss!=NULL) *peak_rss = peak_rss0;
+ if (current_commit!=NULL) *current_commit = current_commit0;
+ if (peak_commit!=NULL) *peak_commit = peak_commit0;
+ if (page_faults!=NULL) *page_faults = page_faults0;
+}
+
diff --git a/source/luametatex/source/libraries/miniz/ChangeLog.md b/source/luametatex/source/libraries/miniz/ChangeLog.md
new file mode 100644
index 000000000..4ae15a8cd
--- /dev/null
+++ b/source/luametatex/source/libraries/miniz/ChangeLog.md
@@ -0,0 +1,196 @@
+## Changelog
+
+### 2.2.0
+
+ - Fix examples with amalgamation
+ - Modified cmake script to support shared library mode and find_package
+ - Fix for misleading doc comment on `mz_zip_reader_init_cfile` function
+ - Add include location tolerance and stop forcing `_GNU_SOURCE`
+ - Fix: mz_zip_reader_locate_file_v2 returns an mz_bool
+ - Fix large file system checks
+ - Add #elif to enable an external mz_crc32() to be linked in
+ - Write with dynamic size (size of file/data to be added not known before adding)
+ - Added uncompress2 for zlib compatibility
+ - Add support for building as a Meson subproject
+ - Added OSSFuzz support; Integrate with CIFuzz
+ - Add pkg-config file
+ - Fixed use-of-uninitialized value msan error when copying dist bytes with no output bytes written.
+ - mz_zip_validate_file(): fix memory leak on errors
+ - Fixed MSAN use-of-uninitialized in tinfl_decompress when invalid dist is decoded. In this instance dist was 31 which s_dist_base translates as 0
+ - Add flag to set (compressed) size in local file header
+ - avoid use of uninitialized value in tdefl_record_literal
+
+### 2.1.0
+
+ - More instances of memcpy instead of cast and use memcpy per default
+ - Remove inline for c90 support
+ - New function to read files via callback functions when adding them
+ - Fix out of bounds read while reading Zip64 extended information
+ - guard memcpy when n == 0 because buffer may be NULL
+ - Implement inflateReset() function
+ - Move comp/decomp alloc/free prototypes under guarding #ifndef MZ_NO_MALLOC
+ - Fix large file support under Windows
+ - Don't warn if _LARGEFILE64_SOURCE is not defined to 1
+ - Fixes for MSVC warnings
+ - Remove check that path of file added to archive contains ':' or '\'
+ - Add !defined check on MINIZ_USE_ALIGNED_LOADS_AND_STORES
+
+### 2.0.8
+
+ - Remove unimplemented functions (mz_zip_locate_file and mz_zip_locate_file_v2)
+ - Add license, changelog, readme and example files to release zip
+ - Fix heap overflow to user buffer in tinfl_status tinfl_decompress
+ - Fix corrupt archive if uncompressed file smaller than 4 byte and the file is added by mz_zip_writer_add_mem*
+
+### 2.0.7
+
+ - Removed need in C++ compiler in cmake build
+ - Fixed a lot of uninitialized value errors found with Valgrind by memsetting m_dict to 0 in tdefl_init
+ - Fix resource leak in mz_zip_reader_init_file_v2
+ - Fix assert with mz_zip_writer_add_mem* w/MZ_DEFAULT_COMPRESSION
+ - cmake build: install library and headers
+ - Remove _LARGEFILE64_SOURCE requirement from apple defines for large files
+
+### 2.0.6
+
+ - Improve MZ_ZIP_FLAG_WRITE_ZIP64 documentation
+ - Remove check for cur_archive_file_ofs > UINT_MAX because cur_archive_file_ofs is not used after this point
+ - Add cmake debug configuration
+ - Fix PNG height when creating png files
+ - Add "iterative" file extraction method based on mz_zip_reader_extract_to_callback.
+ - Option to use memcpy for unaligned data access
+ - Define processor/arch macros as zero if not set to one
+
+### 2.0.4/2.0.5
+
+ - Fix compilation with the various omission compile definitions
+
+### 2.0.3
+
+- Fix GCC/clang compile warnings
+- Added callback for periodic flushes (for ZIP file streaming)
+- Use UTF-8 for file names in ZIP files per default
+
+### 2.0.2
+
+- Fix source backwards compatibility with 1.x
+- Fix a ZIP bit not being set correctly
+
+### 2.0.1
+
+- Added some tests
+- Added CI
+- Make source code ANSI C compatible
+
+### 2.0.0 beta
+
+- Matthew Sitton merged miniz 1.x to Rich Geldreich's vogl ZIP64 changes. Miniz is now licensed as MIT since the vogl code base is MIT licensed
+- Miniz is now split into several files
+- Miniz does now not seek backwards when creating ZIP files. That is the ZIP files can be streamed
+- Miniz automatically switches to the ZIP64 format when the created ZIP files goes over ZIP file limits
+- Similar to [SQLite](https://www.sqlite.org/amalgamation.html) the Miniz source code is amalgamated into one miniz.c/miniz.h pair in a build step (amalgamate.sh). Please use miniz.c/miniz.h in your projects
+- Miniz 2 is only source back-compatible with miniz 1.x. It breaks binary compatibility because structures changed
+
+### v1.16 BETA Oct 19, 2013
+
+Still testing, this release is downloadable from [here](http://www.tenacioussoftware.com/miniz_v116_beta_r1.7z). Two key inflator-only robustness and streaming related changes. Also merged in tdefl_compressor_alloc(), tdefl_compressor_free() helpers to make script bindings easier for rustyzip. I would greatly appreciate any help with testing or any feedback.
+
+The inflator in raw (non-zlib) mode is now usable on gzip or similar streams that have a bunch of bytes following the raw deflate data (problem discovered by rustyzip author williamw520). This version should never read beyond the last byte of the raw deflate data independent of how many bytes you pass into the input buffer.
+
+The inflator now has a new failure status TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS (-4). Previously, if the inflator was starved of bytes and could not make progress (because the input buffer was empty and the caller did not set the TINFL_FLAG_HAS_MORE_INPUT flag - say on truncated or corrupted compressed data stream) it would append all 0's to the input and try to soldier on. This is scary behavior if the caller didn't know when to stop accepting output (because it didn't know how much uncompressed data was expected, or didn't enforce a sane maximum). v1.16 will instead return TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS immediately if it needs 1 or more bytes to make progress, the input buf is empty, and the caller has indicated that no more input is available. This is a "soft" failure, so you can call the inflator again with more input and it will try to continue, or you can give up and fail. This could be very useful in network streaming scenarios.
+
+- The inflator coroutine func. is subtle and complex so I'm being cautious about this release. I would greatly appreciate any help with testing or any feedback.
+ I feel good about these changes, and they've been through several hours of automated testing, but they will probably not fix anything for the majority of prev. users so I'm
+ going to mark this release as beta for a few weeks and continue testing it at work/home on various things.
+- The inflator in raw (non-zlib) mode is now usable on gzip or similar data streams that have a bunch of bytes following the raw deflate data (problem discovered by rustyzip author williamw520).
+ This version should *never* read beyond the last byte of the raw deflate data independent of how many bytes you pass into the input buffer. This issue was caused by the various Huffman bitbuffer lookahead optimizations, and
+ would not be an issue if the caller knew and enforced the precise size of the raw compressed data *or* if the compressed data was in zlib format (i.e. always followed by the byte aligned zlib adler32).
+ So in other words, you can now call the inflator on deflate streams that are followed by arbitrary amounts of data and it's guaranteed that decompression will stop exactly on the last byte.
+- The inflator now has a new failure status: TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS (-4). Previously, if the inflator was starved of bytes and could not make progress (because the input buffer was empty and the
+ caller did not set the TINFL_FLAG_HAS_MORE_INPUT flag - say on truncated or corrupted compressed data stream) it would append all 0's to the input and try to soldier on.
+ This is scary, because in the worst case, I believe it was possible for the prev. inflator to start outputting large amounts of literal data. If the caller didn't know when to stop accepting output
+ (because it didn't know how much uncompressed data was expected, or didn't enforce a sane maximum) it could continue forever. v1.16 cannot fall into this failure mode, instead it'll return
+ TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS immediately if it needs 1 or more bytes to make progress, the input buf is empty, and the caller has indicated that no more input is available. This is a "soft"
+ failure, so you can call the inflator again with more input and it will try to continue, or you can give up and fail. This could be very useful in network streaming scenarios.
+- Added documentation to all the tinfl return status codes, fixed miniz_tester so it accepts double minus params for Linux, tweaked example1.c, added a simple "follower bytes" test to miniz_tester.cpp.
+### v1.15 r4 STABLE - Oct 13, 2013
+
+Merged over a few very minor bug fixes that I fixed in the zip64 branch. This is downloadable from [here](http://code.google.com/p/miniz/downloads/list) and also in SVN head (as of 10/19/13).
+
+
+### v1.15 - Oct. 13, 2013
+
+Interim bugfix release while I work on the next major release with zip64 and streaming compression/decompression support. Fixed the MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY bug (thanks kahmyong.moon@hp.com), which could cause the locate files func to not find files when this flag was specified. Also fixed a bug in mz_zip_reader_extract_to_mem_no_alloc() with user provided read buffers (thanks kymoon). I also merged lots of compiler fixes from various github repo branches and Google Code issue reports. I finally added cmake support (only tested under for Linux so far), compiled and tested with clang v3.3 and gcc 4.6 (under Linux), added defl_write_image_to_png_file_in_memory_ex() (supports Y flipping for OpenGL use, real-time compression), added a new PNG example (example6.c - Mandelbrot), and I added 64-bit file I/O support (stat64(), etc.) for glibc.
+
+- Critical fix for the MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY bug (thanks kahmyong.moon@hp.com) which could cause locate files to not find files. This bug
+ would only have occured in earlier versions if you explicitly used this flag, OR if you used mz_zip_extract_archive_file_to_heap() or mz_zip_add_mem_to_archive_file_in_place()
+ (which used this flag). If you can't switch to v1.15 but want to fix this bug, just remove the uses of this flag from both helper funcs (and of course don't use the flag).
+- Bugfix in mz_zip_reader_extract_to_mem_no_alloc() from kymoon when pUser_read_buf is not NULL and compressed size is > uncompressed size
+- Fixing mz_zip_reader_extract_*() funcs so they don't try to extract compressed data from directory entries, to account for weird zipfiles which contain zero-size compressed data on dir entries.
+ Hopefully this fix won't cause any issues on weird zip archives, because it assumes the low 16-bits of zip external attributes are DOS attributes (which I believe they always are in practice).
+- Fixing mz_zip_reader_is_file_a_directory() so it doesn't check the internal attributes, just the filename and external attributes
+- mz_zip_reader_init_file() - missing MZ_FCLOSE() call if the seek failed
+- Added cmake support for Linux builds which builds all the examples, tested with clang v3.3 and gcc v4.6.
+- Clang fix for tdefl_write_image_to_png_file_in_memory() from toffaletti
+- Merged MZ_FORCEINLINE fix from hdeanclark
+- Fix <time.h> include before config #ifdef, thanks emil.brink
+- Added tdefl_write_image_to_png_file_in_memory_ex(): supports Y flipping (super useful for OpenGL apps), and explicit control over the compression level (so you can
+ set it to 1 for real-time compression).
+- Merged in some compiler fixes from paulharris's github repro.
+- Retested this build under Windows (VS 2010, including static analysis), tcc 0.9.26, gcc v4.6 and clang v3.3.
+- Added example6.c, which dumps an image of the mandelbrot set to a PNG file.
+- Modified example2 to help test the MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY flag more.
+- In r3: Bugfix to mz_zip_writer_add_file() found during merge: Fix possible src file fclose() leak if alignment bytes+local header file write faiiled
+- In r4: Minor bugfix to mz_zip_writer_add_from_zip_reader(): Was pushing the wrong central dir header offset, appears harmless in this release, but it became a problem in the zip64 branch
+
+### v1.14 - May 20, 2012
+
+(SVN Only) Minor tweaks to get miniz.c compiling with the Tiny C Compiler, added #ifndef MINIZ_NO_TIME guards around utime.h includes. Adding mz_free() function, so the caller can free heap blocks returned by miniz using whatever heap functions it has been configured to use, MSVC specific fixes to use "safe" variants of several functions (localtime_s, fopen_s, freopen_s).
+
+MinGW32/64 GCC 4.6.1 compiler fixes: added MZ_FORCEINLINE, #include <time.h> (thanks fermtect).
+
+Compiler specific fixes, some from fermtect. I upgraded to TDM GCC 4.6.1 and now static __forceinline is giving it fits, so I'm changing all usage of __forceinline to MZ_FORCEINLINE and forcing gcc to use __attribute__((__always_inline__)) (and MSVC to use __forceinline). Also various fixes from fermtect for MinGW32: added #include , 64-bit ftell/fseek fixes.
+
+### v1.13 - May 19, 2012
+
+From jason@cornsyrup.org and kelwert@mtu.edu - Most importantly, fixed mz_crc32() so it doesn't compute the wrong CRC-32's when mz_ulong is 64-bits. Temporarily/locally slammed in "typedef unsigned long mz_ulong" and re-ran a randomized regression test on ~500k files. Other stuff:
+
+Eliminated a bunch of warnings when compiling with GCC 32-bit/64. Ran all examples, miniz.c, and tinfl.c through MSVC 2008's /analyze (static analysis) option and fixed all warnings (except for the silly "Use of the comma-operator in a tested expression.." analysis warning, which I purposely use to work around a MSVC compiler warning).
+
+Created 32-bit and 64-bit Codeblocks projects/workspace. Built and tested Linux executables. The codeblocks workspace is compatible with Linux+Win32/x64. Added miniz_tester solution/project, which is a useful little app derived from LZHAM's tester app that I use as part of the regression test. Ran miniz.c and tinfl.c through another series of regression testing on ~500,000 files and archives. Modified example5.c so it purposely disables a bunch of high-level functionality (MINIZ_NO_STDIO, etc.). (Thanks to corysama for the MINIZ_NO_STDIO bug report.)
+
+Fix ftell() usage in a few of the examples so they exit with an error on files which are too large (a limitation of the examples, not miniz itself). Fix fail logic handling in mz_zip_add_mem_to_archive_file_in_place() so it always calls mz_zip_writer_finalize_archive() and mz_zip_writer_end(), even if the file add fails.
+
+- From jason@cornsyrup.org and kelwert@mtu.edu - Fix mz_crc32() so it doesn't compute the wrong CRC-32's when mz_ulong is 64-bit.
+- Temporarily/locally slammed in "typedef unsigned long mz_ulong" and re-ran a randomized regression test on ~500k files.
+- Eliminated a bunch of warnings when compiling with GCC 32-bit/64.
+- Ran all examples, miniz.c, and tinfl.c through MSVC 2008's /analyze (static analysis) option and fixed all warnings (except for the silly
+"Use of the comma-operator in a tested expression.." analysis warning, which I purposely use to work around a MSVC compiler warning).
+- Created 32-bit and 64-bit Codeblocks projects/workspace. Built and tested Linux executables. The codeblocks workspace is compatible with Linux+Win32/x64.
+- Added miniz_tester solution/project, which is a useful little app derived from LZHAM's tester app that I use as part of the regression test.
+- Ran miniz.c and tinfl.c through another series of regression testing on ~500,000 files and archives.
+- Modified example5.c so it purposely disables a bunch of high-level functionality (MINIZ_NO_STDIO, etc.). (Thanks to corysama for the MINIZ_NO_STDIO bug report.)
+- Fix ftell() usage in examples so they exit with an error on files which are too large (a limitation of the examples, not miniz itself).
+
+### v1.12 - 4/12/12
+
+More comments, added low-level example5.c, fixed a couple minor level_and_flags issues in the archive API's.
+level_and_flags can now be set to MZ_DEFAULT_COMPRESSION. Thanks to Bruce Dawson <bruced@valvesoftware.com> for the feedback/bug report.
+
+### v1.11 - 5/28/11
+
+Added statement from unlicense.org
+
+### v1.10 - 5/27/11
+
+- Substantial compressor optimizations:
+- Level 1 is now ~4x faster than before. The L1 compressor's throughput now varies between 70-110MB/sec. on a Core i7 (actual throughput varies depending on the type of data, and x64 vs. x86).
+- Improved baseline L2-L9 compression perf. Also, greatly improved compression perf. issues on some file types.
+- Refactored the compression code for better readability and maintainability.
+- Added level 10 compression level (L10 has slightly better ratio than level 9, but could have a potentially large drop in throughput on some files).
+
+### v1.09 - 5/15/11
+
+Initial stable release.
+
+
diff --git a/source/luametatex/source/libraries/miniz/LICENSE b/source/luametatex/source/libraries/miniz/LICENSE
new file mode 100644
index 000000000..b6ff45a30
--- /dev/null
+++ b/source/luametatex/source/libraries/miniz/LICENSE
@@ -0,0 +1,22 @@
+Copyright 2013-2014 RAD Game Tools and Valve Software
+Copyright 2010-2014 Rich Geldreich and Tenacious Software LLC
+
+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.
diff --git a/source/luametatex/source/libraries/miniz/miniz.c b/source/luametatex/source/libraries/miniz/miniz.c
new file mode 100644
index 000000000..87bdedb18
--- /dev/null
+++ b/source/luametatex/source/libraries/miniz/miniz.c
@@ -0,0 +1,7733 @@
+#include "miniz.h"
+/**************************************************************************
+ *
+ * Copyright 2013-2014 RAD Game Tools and Valve Software
+ * Copyright 2010-2014 Rich Geldreich and Tenacious Software LLC
+ * 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.
+ *
+ **************************************************************************/
+
+
+
+typedef unsigned char mz_validate_uint16[sizeof(mz_uint16) == 2 ? 1 : -1];
+typedef unsigned char mz_validate_uint32[sizeof(mz_uint32) == 4 ? 1 : -1];
+typedef unsigned char mz_validate_uint64[sizeof(mz_uint64) == 8 ? 1 : -1];
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* ------------------- zlib-style API's */
+
+mz_ulong mz_adler32(mz_ulong adler, const unsigned char *ptr, size_t buf_len)
+{
+ mz_uint32 i, s1 = (mz_uint32)(adler & 0xffff), s2 = (mz_uint32)(adler >> 16);
+ size_t block_len = buf_len % 5552;
+ if (!ptr)
+ return MZ_ADLER32_INIT;
+ while (buf_len)
+ {
+ for (i = 0; i + 7 < block_len; i += 8, ptr += 8)
+ {
+ s1 += ptr[0], s2 += s1;
+ s1 += ptr[1], s2 += s1;
+ s1 += ptr[2], s2 += s1;
+ s1 += ptr[3], s2 += s1;
+ s1 += ptr[4], s2 += s1;
+ s1 += ptr[5], s2 += s1;
+ s1 += ptr[6], s2 += s1;
+ s1 += ptr[7], s2 += s1;
+ }
+ for (; i < block_len; ++i)
+ s1 += *ptr++, s2 += s1;
+ s1 %= 65521U, s2 %= 65521U;
+ buf_len -= block_len;
+ block_len = 5552;
+ }
+ return (s2 << 16) + s1;
+}
+
+/* Karl Malbrain's compact CRC-32. See "A compact CCITT crc16 and crc32 C implementation that balances processor cache usage against speed": http://www.geocities.com/malbrain/ */
+#if 0
+ mz_ulong mz_crc32(mz_ulong crc, const mz_uint8 *ptr, size_t buf_len)
+ {
+ static const mz_uint32 s_crc32[16] = { 0, 0x1db71064, 0x3b6e20c8, 0x26d930ac, 0x76dc4190, 0x6b6b51f4, 0x4db26158, 0x5005713c,
+ 0xedb88320, 0xf00f9344, 0xd6d6a3e8, 0xcb61b38c, 0x9b64c2b0, 0x86d3d2d4, 0xa00ae278, 0xbdbdf21c };
+ mz_uint32 crcu32 = (mz_uint32)crc;
+ if (!ptr)
+ return MZ_CRC32_INIT;
+ crcu32 = ~crcu32;
+ while (buf_len--)
+ {
+ mz_uint8 b = *ptr++;
+ crcu32 = (crcu32 >> 4) ^ s_crc32[(crcu32 & 0xF) ^ (b & 0xF)];
+ crcu32 = (crcu32 >> 4) ^ s_crc32[(crcu32 & 0xF) ^ (b >> 4)];
+ }
+ return ~crcu32;
+ }
+#elif defined(USE_EXTERNAL_MZCRC)
+/* If USE_EXTERNAL_CRC is defined, an external module will export the
+ * mz_crc32() symbol for us to use, e.g. an SSE-accelerated version.
+ * Depending on the impl, it may be necessary to ~ the input/output crc values.
+ */
+mz_ulong mz_crc32(mz_ulong crc, const mz_uint8 *ptr, size_t buf_len);
+#else
+/* Faster, but larger CPU cache footprint.
+ */
+mz_ulong mz_crc32(mz_ulong crc, const mz_uint8 *ptr, size_t buf_len)
+{
+ static const mz_uint32 s_crc_table[256] =
+ {
+ 0x00000000, 0x77073096, 0xEE0E612C, 0x990951BA, 0x076DC419, 0x706AF48F, 0xE963A535,
+ 0x9E6495A3, 0x0EDB8832, 0x79DCB8A4, 0xE0D5E91E, 0x97D2D988, 0x09B64C2B, 0x7EB17CBD,
+ 0xE7B82D07, 0x90BF1D91, 0x1DB71064, 0x6AB020F2, 0xF3B97148, 0x84BE41DE, 0x1ADAD47D,
+ 0x6DDDE4EB, 0xF4D4B551, 0x83D385C7, 0x136C9856, 0x646BA8C0, 0xFD62F97A, 0x8A65C9EC,
+ 0x14015C4F, 0x63066CD9, 0xFA0F3D63, 0x8D080DF5, 0x3B6E20C8, 0x4C69105E, 0xD56041E4,
+ 0xA2677172, 0x3C03E4D1, 0x4B04D447, 0xD20D85FD, 0xA50AB56B, 0x35B5A8FA, 0x42B2986C,
+ 0xDBBBC9D6, 0xACBCF940, 0x32D86CE3, 0x45DF5C75, 0xDCD60DCF, 0xABD13D59, 0x26D930AC,
+ 0x51DE003A, 0xC8D75180, 0xBFD06116, 0x21B4F4B5, 0x56B3C423, 0xCFBA9599, 0xB8BDA50F,
+ 0x2802B89E, 0x5F058808, 0xC60CD9B2, 0xB10BE924, 0x2F6F7C87, 0x58684C11, 0xC1611DAB,
+ 0xB6662D3D, 0x76DC4190, 0x01DB7106, 0x98D220BC, 0xEFD5102A, 0x71B18589, 0x06B6B51F,
+ 0x9FBFE4A5, 0xE8B8D433, 0x7807C9A2, 0x0F00F934, 0x9609A88E, 0xE10E9818, 0x7F6A0DBB,
+ 0x086D3D2D, 0x91646C97, 0xE6635C01, 0x6B6B51F4, 0x1C6C6162, 0x856530D8, 0xF262004E,
+ 0x6C0695ED, 0x1B01A57B, 0x8208F4C1, 0xF50FC457, 0x65B0D9C6, 0x12B7E950, 0x8BBEB8EA,
+ 0xFCB9887C, 0x62DD1DDF, 0x15DA2D49, 0x8CD37CF3, 0xFBD44C65, 0x4DB26158, 0x3AB551CE,
+ 0xA3BC0074, 0xD4BB30E2, 0x4ADFA541, 0x3DD895D7, 0xA4D1C46D, 0xD3D6F4FB, 0x4369E96A,
+ 0x346ED9FC, 0xAD678846, 0xDA60B8D0, 0x44042D73, 0x33031DE5, 0xAA0A4C5F, 0xDD0D7CC9,
+ 0x5005713C, 0x270241AA, 0xBE0B1010, 0xC90C2086, 0x5768B525, 0x206F85B3, 0xB966D409,
+ 0xCE61E49F, 0x5EDEF90E, 0x29D9C998, 0xB0D09822, 0xC7D7A8B4, 0x59B33D17, 0x2EB40D81,
+ 0xB7BD5C3B, 0xC0BA6CAD, 0xEDB88320, 0x9ABFB3B6, 0x03B6E20C, 0x74B1D29A, 0xEAD54739,
+ 0x9DD277AF, 0x04DB2615, 0x73DC1683, 0xE3630B12, 0x94643B84, 0x0D6D6A3E, 0x7A6A5AA8,
+ 0xE40ECF0B, 0x9309FF9D, 0x0A00AE27, 0x7D079EB1, 0xF00F9344, 0x8708A3D2, 0x1E01F268,
+ 0x6906C2FE, 0xF762575D, 0x806567CB, 0x196C3671, 0x6E6B06E7, 0xFED41B76, 0x89D32BE0,
+ 0x10DA7A5A, 0x67DD4ACC, 0xF9B9DF6F, 0x8EBEEFF9, 0x17B7BE43, 0x60B08ED5, 0xD6D6A3E8,
+ 0xA1D1937E, 0x38D8C2C4, 0x4FDFF252, 0xD1BB67F1, 0xA6BC5767, 0x3FB506DD, 0x48B2364B,
+ 0xD80D2BDA, 0xAF0A1B4C, 0x36034AF6, 0x41047A60, 0xDF60EFC3, 0xA867DF55, 0x316E8EEF,
+ 0x4669BE79, 0xCB61B38C, 0xBC66831A, 0x256FD2A0, 0x5268E236, 0xCC0C7795, 0xBB0B4703,
+ 0x220216B9, 0x5505262F, 0xC5BA3BBE, 0xB2BD0B28, 0x2BB45A92, 0x5CB36A04, 0xC2D7FFA7,
+ 0xB5D0CF31, 0x2CD99E8B, 0x5BDEAE1D, 0x9B64C2B0, 0xEC63F226, 0x756AA39C, 0x026D930A,
+ 0x9C0906A9, 0xEB0E363F, 0x72076785, 0x05005713, 0x95BF4A82, 0xE2B87A14, 0x7BB12BAE,
+ 0x0CB61B38, 0x92D28E9B, 0xE5D5BE0D, 0x7CDCEFB7, 0x0BDBDF21, 0x86D3D2D4, 0xF1D4E242,
+ 0x68DDB3F8, 0x1FDA836E, 0x81BE16CD, 0xF6B9265B, 0x6FB077E1, 0x18B74777, 0x88085AE6,
+ 0xFF0F6A70, 0x66063BCA, 0x11010B5C, 0x8F659EFF, 0xF862AE69, 0x616BFFD3, 0x166CCF45,
+ 0xA00AE278, 0xD70DD2EE, 0x4E048354, 0x3903B3C2, 0xA7672661, 0xD06016F7, 0x4969474D,
+ 0x3E6E77DB, 0xAED16A4A, 0xD9D65ADC, 0x40DF0B66, 0x37D83BF0, 0xA9BCAE53, 0xDEBB9EC5,
+ 0x47B2CF7F, 0x30B5FFE9, 0xBDBDF21C, 0xCABAC28A, 0x53B39330, 0x24B4A3A6, 0xBAD03605,
+ 0xCDD70693, 0x54DE5729, 0x23D967BF, 0xB3667A2E, 0xC4614AB8, 0x5D681B02, 0x2A6F2B94,
+ 0xB40BBE37, 0xC30C8EA1, 0x5A05DF1B, 0x2D02EF8D
+ };
+
+ mz_uint32 crc32 = (mz_uint32)crc ^ 0xFFFFFFFF;
+ const mz_uint8 *pByte_buf = (const mz_uint8 *)ptr;
+
+ while (buf_len >= 4)
+ {
+ crc32 = (crc32 >> 8) ^ s_crc_table[(crc32 ^ pByte_buf[0]) & 0xFF];
+ crc32 = (crc32 >> 8) ^ s_crc_table[(crc32 ^ pByte_buf[1]) & 0xFF];
+ crc32 = (crc32 >> 8) ^ s_crc_table[(crc32 ^ pByte_buf[2]) & 0xFF];
+ crc32 = (crc32 >> 8) ^ s_crc_table[(crc32 ^ pByte_buf[3]) & 0xFF];
+ pByte_buf += 4;
+ buf_len -= 4;
+ }
+
+ while (buf_len)
+ {
+ crc32 = (crc32 >> 8) ^ s_crc_table[(crc32 ^ pByte_buf[0]) & 0xFF];
+ ++pByte_buf;
+ --buf_len;
+ }
+
+ return ~crc32;
+}
+#endif
+
+void mz_free(void *p)
+{
+ MZ_FREE(p);
+}
+
+MINIZ_EXPORT void *miniz_def_alloc_func(void *opaque, size_t items, size_t size)
+{
+ (void)opaque, (void)items, (void)size;
+ return MZ_MALLOC(items * size);
+}
+MINIZ_EXPORT void miniz_def_free_func(void *opaque, void *address)
+{
+ (void)opaque, (void)address;
+ MZ_FREE(address);
+}
+MINIZ_EXPORT void *miniz_def_realloc_func(void *opaque, void *address, size_t items, size_t size)
+{
+ (void)opaque, (void)address, (void)items, (void)size;
+ return MZ_REALLOC(address, items * size);
+}
+
+const char *mz_version(void)
+{
+ return MZ_VERSION;
+}
+
+#ifndef MINIZ_NO_ZLIB_APIS
+
+int mz_deflateInit(mz_streamp pStream, int level)
+{
+ return mz_deflateInit2(pStream, level, MZ_DEFLATED, MZ_DEFAULT_WINDOW_BITS, 9, MZ_DEFAULT_STRATEGY);
+}
+
+int mz_deflateInit2(mz_streamp pStream, int level, int method, int window_bits, int mem_level, int strategy)
+{
+ tdefl_compressor *pComp;
+ mz_uint comp_flags = TDEFL_COMPUTE_ADLER32 | tdefl_create_comp_flags_from_zip_params(level, window_bits, strategy);
+
+ if (!pStream)
+ return MZ_STREAM_ERROR;
+ if ((method != MZ_DEFLATED) || ((mem_level < 1) || (mem_level > 9)) || ((window_bits != MZ_DEFAULT_WINDOW_BITS) && (-window_bits != MZ_DEFAULT_WINDOW_BITS)))
+ return MZ_PARAM_ERROR;
+
+ pStream->data_type = 0;
+ pStream->adler = MZ_ADLER32_INIT;
+ pStream->msg = NULL;
+ pStream->reserved = 0;
+ pStream->total_in = 0;
+ pStream->total_out = 0;
+ if (!pStream->zalloc)
+ pStream->zalloc = miniz_def_alloc_func;
+ if (!pStream->zfree)
+ pStream->zfree = miniz_def_free_func;
+
+ pComp = (tdefl_compressor *)pStream->zalloc(pStream->opaque, 1, sizeof(tdefl_compressor));
+ if (!pComp)
+ return MZ_MEM_ERROR;
+
+ pStream->state = (struct mz_internal_state *)pComp;
+
+ if (tdefl_init(pComp, NULL, NULL, comp_flags) != TDEFL_STATUS_OKAY)
+ {
+ mz_deflateEnd(pStream);
+ return MZ_PARAM_ERROR;
+ }
+
+ return MZ_OK;
+}
+
+int mz_deflateReset(mz_streamp pStream)
+{
+ if ((!pStream) || (!pStream->state) || (!pStream->zalloc) || (!pStream->zfree))
+ return MZ_STREAM_ERROR;
+ pStream->total_in = pStream->total_out = 0;
+ tdefl_init((tdefl_compressor *)pStream->state, NULL, NULL, ((tdefl_compressor *)pStream->state)->m_flags);
+ return MZ_OK;
+}
+
+int mz_deflate(mz_streamp pStream, int flush)
+{
+ size_t in_bytes, out_bytes;
+ mz_ulong orig_total_in, orig_total_out;
+ int mz_status = MZ_OK;
+
+ if ((!pStream) || (!pStream->state) || (flush < 0) || (flush > MZ_FINISH) || (!pStream->next_out))
+ return MZ_STREAM_ERROR;
+ if (!pStream->avail_out)
+ return MZ_BUF_ERROR;
+
+ if (flush == MZ_PARTIAL_FLUSH)
+ flush = MZ_SYNC_FLUSH;
+
+ if (((tdefl_compressor *)pStream->state)->m_prev_return_status == TDEFL_STATUS_DONE)
+ return (flush == MZ_FINISH) ? MZ_STREAM_END : MZ_BUF_ERROR;
+
+ orig_total_in = pStream->total_in;
+ orig_total_out = pStream->total_out;
+ for (;;)
+ {
+ tdefl_status defl_status;
+ in_bytes = pStream->avail_in;
+ out_bytes = pStream->avail_out;
+
+ defl_status = tdefl_compress((tdefl_compressor *)pStream->state, pStream->next_in, &in_bytes, pStream->next_out, &out_bytes, (tdefl_flush)flush);
+ pStream->next_in += (mz_uint)in_bytes;
+ pStream->avail_in -= (mz_uint)in_bytes;
+ pStream->total_in += (mz_uint)in_bytes;
+ pStream->adler = tdefl_get_adler32((tdefl_compressor *)pStream->state);
+
+ pStream->next_out += (mz_uint)out_bytes;
+ pStream->avail_out -= (mz_uint)out_bytes;
+ pStream->total_out += (mz_uint)out_bytes;
+
+ if (defl_status < 0)
+ {
+ mz_status = MZ_STREAM_ERROR;
+ break;
+ }
+ else if (defl_status == TDEFL_STATUS_DONE)
+ {
+ mz_status = MZ_STREAM_END;
+ break;
+ }
+ else if (!pStream->avail_out)
+ break;
+ else if ((!pStream->avail_in) && (flush != MZ_FINISH))
+ {
+ if ((flush) || (pStream->total_in != orig_total_in) || (pStream->total_out != orig_total_out))
+ break;
+ return MZ_BUF_ERROR; /* Can't make forward progress without some input.
+ */
+ }
+ }
+ return mz_status;
+}
+
+int mz_deflateEnd(mz_streamp pStream)
+{
+ if (!pStream)
+ return MZ_STREAM_ERROR;
+ if (pStream->state)
+ {
+ pStream->zfree(pStream->opaque, pStream->state);
+ pStream->state = NULL;
+ }
+ return MZ_OK;
+}
+
+mz_ulong mz_deflateBound(mz_streamp pStream, mz_ulong source_len)
+{
+ (void)pStream;
+ /* This is really over conservative. (And lame, but it's actually pretty tricky to compute a true upper bound given the way tdefl's blocking works.) */
+ return MZ_MAX(128 + (source_len * 110) / 100, 128 + source_len + ((source_len / (31 * 1024)) + 1) * 5);
+}
+
+int mz_compress2(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len, int level)
+{
+ int status;
+ mz_stream stream;
+ memset(&stream, 0, sizeof(stream));
+
+ /* In case mz_ulong is 64-bits (argh I hate longs). */
+ if ((source_len | *pDest_len) > 0xFFFFFFFFU)
+ return MZ_PARAM_ERROR;
+
+ stream.next_in = pSource;
+ stream.avail_in = (mz_uint32)source_len;
+ stream.next_out = pDest;
+ stream.avail_out = (mz_uint32)*pDest_len;
+
+ status = mz_deflateInit(&stream, level);
+ if (status != MZ_OK)
+ return status;
+
+ status = mz_deflate(&stream, MZ_FINISH);
+ if (status != MZ_STREAM_END)
+ {
+ mz_deflateEnd(&stream);
+ return (status == MZ_OK) ? MZ_BUF_ERROR : status;
+ }
+
+ *pDest_len = stream.total_out;
+ return mz_deflateEnd(&stream);
+}
+
+int mz_compress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len)
+{
+ return mz_compress2(pDest, pDest_len, pSource, source_len, MZ_DEFAULT_COMPRESSION);
+}
+
+mz_ulong mz_compressBound(mz_ulong source_len)
+{
+ return mz_deflateBound(NULL, source_len);
+}
+
+typedef struct
+{
+ tinfl_decompressor m_decomp;
+ mz_uint m_dict_ofs, m_dict_avail, m_first_call, m_has_flushed;
+ int m_window_bits;
+ mz_uint8 m_dict[TINFL_LZ_DICT_SIZE];
+ tinfl_status m_last_status;
+} inflate_state;
+
+int mz_inflateInit2(mz_streamp pStream, int window_bits)
+{
+ inflate_state *pDecomp;
+ if (!pStream)
+ return MZ_STREAM_ERROR;
+ if ((window_bits != MZ_DEFAULT_WINDOW_BITS) && (-window_bits != MZ_DEFAULT_WINDOW_BITS))
+ return MZ_PARAM_ERROR;
+
+ pStream->data_type = 0;
+ pStream->adler = 0;
+ pStream->msg = NULL;
+ pStream->total_in = 0;
+ pStream->total_out = 0;
+ pStream->reserved = 0;
+ if (!pStream->zalloc)
+ pStream->zalloc = miniz_def_alloc_func;
+ if (!pStream->zfree)
+ pStream->zfree = miniz_def_free_func;
+
+ pDecomp = (inflate_state *)pStream->zalloc(pStream->opaque, 1, sizeof(inflate_state));
+ if (!pDecomp)
+ return MZ_MEM_ERROR;
+
+ pStream->state = (struct mz_internal_state *)pDecomp;
+
+ tinfl_init(&pDecomp->m_decomp);
+ pDecomp->m_dict_ofs = 0;
+ pDecomp->m_dict_avail = 0;
+ pDecomp->m_last_status = TINFL_STATUS_NEEDS_MORE_INPUT;
+ pDecomp->m_first_call = 1;
+ pDecomp->m_has_flushed = 0;
+ pDecomp->m_window_bits = window_bits;
+
+ return MZ_OK;
+}
+
+int mz_inflateInit(mz_streamp pStream)
+{
+ return mz_inflateInit2(pStream, MZ_DEFAULT_WINDOW_BITS);
+}
+
+int mz_inflateReset(mz_streamp pStream)
+{
+ inflate_state *pDecomp;
+ if (!pStream)
+ return MZ_STREAM_ERROR;
+
+ pStream->data_type = 0;
+ pStream->adler = 0;
+ pStream->msg = NULL;
+ pStream->total_in = 0;
+ pStream->total_out = 0;
+ pStream->reserved = 0;
+
+ pDecomp = (inflate_state *)pStream->state;
+
+ tinfl_init(&pDecomp->m_decomp);
+ pDecomp->m_dict_ofs = 0;
+ pDecomp->m_dict_avail = 0;
+ pDecomp->m_last_status = TINFL_STATUS_NEEDS_MORE_INPUT;
+ pDecomp->m_first_call = 1;
+ pDecomp->m_has_flushed = 0;
+ /* pDecomp->m_window_bits = window_bits */;
+
+ return MZ_OK;
+}
+
+int mz_inflate(mz_streamp pStream, int flush)
+{
+ inflate_state *pState;
+ mz_uint n, first_call, decomp_flags = TINFL_FLAG_COMPUTE_ADLER32;
+ size_t in_bytes, out_bytes, orig_avail_in;
+ tinfl_status status;
+
+ if ((!pStream) || (!pStream->state))
+ return MZ_STREAM_ERROR;
+ if (flush == MZ_PARTIAL_FLUSH)
+ flush = MZ_SYNC_FLUSH;
+ if ((flush) && (flush != MZ_SYNC_FLUSH) && (flush != MZ_FINISH))
+ return MZ_STREAM_ERROR;
+
+ pState = (inflate_state *)pStream->state;
+ if (pState->m_window_bits > 0)
+ decomp_flags |= TINFL_FLAG_PARSE_ZLIB_HEADER;
+ orig_avail_in = pStream->avail_in;
+
+ first_call = pState->m_first_call;
+ pState->m_first_call = 0;
+ if (pState->m_last_status < 0)
+ return MZ_DATA_ERROR;
+
+ if (pState->m_has_flushed && (flush != MZ_FINISH))
+ return MZ_STREAM_ERROR;
+ pState->m_has_flushed |= (flush == MZ_FINISH);
+
+ if ((flush == MZ_FINISH) && (first_call))
+ {
+ /* MZ_FINISH on the first call implies that the input and output buffers are large enough to hold the entire compressed/decompressed file. */
+ decomp_flags |= TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF;
+ in_bytes = pStream->avail_in;
+ out_bytes = pStream->avail_out;
+ status = tinfl_decompress(&pState->m_decomp, pStream->next_in, &in_bytes, pStream->next_out, pStream->next_out, &out_bytes, decomp_flags);
+ pState->m_last_status = status;
+ pStream->next_in += (mz_uint)in_bytes;
+ pStream->avail_in -= (mz_uint)in_bytes;
+ pStream->total_in += (mz_uint)in_bytes;
+ pStream->adler = tinfl_get_adler32(&pState->m_decomp);
+ pStream->next_out += (mz_uint)out_bytes;
+ pStream->avail_out -= (mz_uint)out_bytes;
+ pStream->total_out += (mz_uint)out_bytes;
+
+ if (status < 0)
+ return MZ_DATA_ERROR;
+ else if (status != TINFL_STATUS_DONE)
+ {
+ pState->m_last_status = TINFL_STATUS_FAILED;
+ return MZ_BUF_ERROR;
+ }
+ return MZ_STREAM_END;
+ }
+ /* flush != MZ_FINISH then we must assume there's more input. */
+ if (flush != MZ_FINISH)
+ decomp_flags |= TINFL_FLAG_HAS_MORE_INPUT;
+
+ if (pState->m_dict_avail)
+ {
+ n = MZ_MIN(pState->m_dict_avail, pStream->avail_out);
+ memcpy(pStream->next_out, pState->m_dict + pState->m_dict_ofs, n);
+ pStream->next_out += n;
+ pStream->avail_out -= n;
+ pStream->total_out += n;
+ pState->m_dict_avail -= n;
+ pState->m_dict_ofs = (pState->m_dict_ofs + n) & (TINFL_LZ_DICT_SIZE - 1);
+ return ((pState->m_last_status == TINFL_STATUS_DONE) && (!pState->m_dict_avail)) ? MZ_STREAM_END : MZ_OK;
+ }
+
+ for (;;)
+ {
+ in_bytes = pStream->avail_in;
+ out_bytes = TINFL_LZ_DICT_SIZE - pState->m_dict_ofs;
+
+ status = tinfl_decompress(&pState->m_decomp, pStream->next_in, &in_bytes, pState->m_dict, pState->m_dict + pState->m_dict_ofs, &out_bytes, decomp_flags);
+ pState->m_last_status = status;
+
+ pStream->next_in += (mz_uint)in_bytes;
+ pStream->avail_in -= (mz_uint)in_bytes;
+ pStream->total_in += (mz_uint)in_bytes;
+ pStream->adler = tinfl_get_adler32(&pState->m_decomp);
+
+ pState->m_dict_avail = (mz_uint)out_bytes;
+
+ n = MZ_MIN(pState->m_dict_avail, pStream->avail_out);
+ memcpy(pStream->next_out, pState->m_dict + pState->m_dict_ofs, n);
+ pStream->next_out += n;
+ pStream->avail_out -= n;
+ pStream->total_out += n;
+ pState->m_dict_avail -= n;
+ pState->m_dict_ofs = (pState->m_dict_ofs + n) & (TINFL_LZ_DICT_SIZE - 1);
+
+ if (status < 0)
+ return MZ_DATA_ERROR; /* Stream is corrupted (there could be some uncompressed data left in the output dictionary - oh well). */
+ else if ((status == TINFL_STATUS_NEEDS_MORE_INPUT) && (!orig_avail_in))
+ return MZ_BUF_ERROR; /* Signal caller that we can't make forward progress without supplying more input or by setting flush to MZ_FINISH. */
+ else if (flush == MZ_FINISH)
+ {
+ /* The output buffer MUST be large to hold the remaining uncompressed data when flush==MZ_FINISH. */
+ if (status == TINFL_STATUS_DONE)
+ return pState->m_dict_avail ? MZ_BUF_ERROR : MZ_STREAM_END;
+ /* status here must be TINFL_STATUS_HAS_MORE_OUTPUT, which means there's at least 1 more byte on the way. If there's no more room left in the output buffer then something is wrong. */
+ else if (!pStream->avail_out)
+ return MZ_BUF_ERROR;
+ }
+ else if ((status == TINFL_STATUS_DONE) || (!pStream->avail_in) || (!pStream->avail_out) || (pState->m_dict_avail))
+ break;
+ }
+
+ return ((status == TINFL_STATUS_DONE) && (!pState->m_dict_avail)) ? MZ_STREAM_END : MZ_OK;
+}
+
+int mz_inflateEnd(mz_streamp pStream)
+{
+ if (!pStream)
+ return MZ_STREAM_ERROR;
+ if (pStream->state)
+ {
+ pStream->zfree(pStream->opaque, pStream->state);
+ pStream->state = NULL;
+ }
+ return MZ_OK;
+}
+int mz_uncompress2(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong *pSource_len)
+{
+ mz_stream stream;
+ int status;
+ memset(&stream, 0, sizeof(stream));
+
+ /* In case mz_ulong is 64-bits (argh I hate longs). */
+ if ((*pSource_len | *pDest_len) > 0xFFFFFFFFU)
+ return MZ_PARAM_ERROR;
+
+ stream.next_in = pSource;
+ stream.avail_in = (mz_uint32)*pSource_len;
+ stream.next_out = pDest;
+ stream.avail_out = (mz_uint32)*pDest_len;
+
+ status = mz_inflateInit(&stream);
+ if (status != MZ_OK)
+ return status;
+
+ status = mz_inflate(&stream, MZ_FINISH);
+ *pSource_len = *pSource_len - stream.avail_in;
+ if (status != MZ_STREAM_END)
+ {
+ mz_inflateEnd(&stream);
+ return ((status == MZ_BUF_ERROR) && (!stream.avail_in)) ? MZ_DATA_ERROR : status;
+ }
+ *pDest_len = stream.total_out;
+
+ return mz_inflateEnd(&stream);
+}
+
+int mz_uncompress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len)
+{
+ return mz_uncompress2(pDest, pDest_len, pSource, &source_len);
+}
+
+const char *mz_error(int err)
+{
+ static struct
+ {
+ int m_err;
+ const char *m_pDesc;
+ } s_error_descs[] =
+ {
+ { MZ_OK, "" }, { MZ_STREAM_END, "stream end" }, { MZ_NEED_DICT, "need dictionary" }, { MZ_ERRNO, "file error" }, { MZ_STREAM_ERROR, "stream error" }, { MZ_DATA_ERROR, "data error" }, { MZ_MEM_ERROR, "out of memory" }, { MZ_BUF_ERROR, "buf error" }, { MZ_VERSION_ERROR, "version error" }, { MZ_PARAM_ERROR, "parameter error" }
+ };
+ mz_uint i;
+ for (i = 0; i < sizeof(s_error_descs) / sizeof(s_error_descs[0]); ++i)
+ if (s_error_descs[i].m_err == err)
+ return s_error_descs[i].m_pDesc;
+ return NULL;
+}
+
+#endif /*MINIZ_NO_ZLIB_APIS */
+
+#ifdef __cplusplus
+}
+#endif
+
+/*
+ This is free and unencumbered software released into the public domain.
+
+ Anyone is free to copy, modify, publish, use, compile, sell, or
+ distribute this software, either in source code form or as a compiled
+ binary, for any purpose, commercial or non-commercial, and by any
+ means.
+
+ In jurisdictions that recognize copyright laws, the author or authors
+ of this software dedicate any and all copyright interest in the
+ software to the public domain. We make this dedication for the benefit
+ of the public at large and to the detriment of our heirs and
+ successors. We intend this dedication to be an overt act of
+ relinquishment in perpetuity of all present and future rights to this
+ software under copyright law.
+
+ 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 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.
+
+ For more information, please refer to <http://unlicense.org/>
+*/
+/**************************************************************************
+ *
+ * Copyright 2013-2014 RAD Game Tools and Valve Software
+ * Copyright 2010-2014 Rich Geldreich and Tenacious Software LLC
+ * 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.
+ *
+ **************************************************************************/
+
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* ------------------- Low-level Compression (independent from all decompression API's) */
+
+/* Purposely making these tables static for faster init and thread safety. */
+static const mz_uint16 s_tdefl_len_sym[256] =
+ {
+ 257, 258, 259, 260, 261, 262, 263, 264, 265, 265, 266, 266, 267, 267, 268, 268, 269, 269, 269, 269, 270, 270, 270, 270, 271, 271, 271, 271, 272, 272, 272, 272,
+ 273, 273, 273, 273, 273, 273, 273, 273, 274, 274, 274, 274, 274, 274, 274, 274, 275, 275, 275, 275, 275, 275, 275, 275, 276, 276, 276, 276, 276, 276, 276, 276,
+ 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 277, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278,
+ 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 279, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, 280,
+ 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281,
+ 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282, 282,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 284, 285
+ };
+
+static const mz_uint8 s_tdefl_len_extra[256] =
+ {
+ 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 0
+ };
+
+static const mz_uint8 s_tdefl_small_dist_sym[512] =
+ {
+ 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17
+ };
+
+static const mz_uint8 s_tdefl_small_dist_extra[512] =
+ {
+ 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+ 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+ 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7
+ };
+
+static const mz_uint8 s_tdefl_large_dist_sym[128] =
+ {
+ 0, 0, 18, 19, 20, 20, 21, 21, 22, 22, 22, 22, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+ 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
+ };
+
+static const mz_uint8 s_tdefl_large_dist_extra[128] =
+ {
+ 0, 0, 8, 8, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
+ 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13
+ };
+
+/* Radix sorts tdefl_sym_freq[] array by 16-bit key m_key. Returns ptr to sorted values. */
+typedef struct
+{
+ mz_uint16 m_key, m_sym_index;
+} tdefl_sym_freq;
+static tdefl_sym_freq *tdefl_radix_sort_syms(mz_uint num_syms, tdefl_sym_freq *pSyms0, tdefl_sym_freq *pSyms1)
+{
+ mz_uint32 total_passes = 2, pass_shift, pass, i, hist[256 * 2];
+ tdefl_sym_freq *pCur_syms = pSyms0, *pNew_syms = pSyms1;
+ MZ_CLEAR_OBJ(hist);
+ for (i = 0; i < num_syms; i++)
+ {
+ mz_uint freq = pSyms0[i].m_key;
+ hist[freq & 0xFF]++;
+ hist[256 + ((freq >> 8) & 0xFF)]++;
+ }
+ while ((total_passes > 1) && (num_syms == hist[(total_passes - 1) * 256]))
+ total_passes--;
+ for (pass_shift = 0, pass = 0; pass < total_passes; pass++, pass_shift += 8)
+ {
+ const mz_uint32 *pHist = &hist[pass << 8];
+ mz_uint offsets[256], cur_ofs = 0;
+ for (i = 0; i < 256; i++)
+ {
+ offsets[i] = cur_ofs;
+ cur_ofs += pHist[i];
+ }
+ for (i = 0; i < num_syms; i++)
+ pNew_syms[offsets[(pCur_syms[i].m_key >> pass_shift) & 0xFF]++] = pCur_syms[i];
+ {
+ tdefl_sym_freq *t = pCur_syms;
+ pCur_syms = pNew_syms;
+ pNew_syms = t;
+ }
+ }
+ return pCur_syms;
+}
+
+/* tdefl_calculate_minimum_redundancy() originally written by: Alistair Moffat, alistair@cs.mu.oz.au, Jyrki Katajainen, jyrki@diku.dk, November 1996. */
+static void tdefl_calculate_minimum_redundancy(tdefl_sym_freq *A, int n)
+{
+ int root, leaf, next, avbl, used, dpth;
+ if (n == 0)
+ return;
+ else if (n == 1)
+ {
+ A[0].m_key = 1;
+ return;
+ }
+ A[0].m_key += A[1].m_key;
+ root = 0;
+ leaf = 2;
+ for (next = 1; next < n - 1; next++)
+ {
+ if (leaf >= n || A[root].m_key < A[leaf].m_key)
+ {
+ A[next].m_key = A[root].m_key;
+ A[root++].m_key = (mz_uint16)next;
+ }
+ else
+ A[next].m_key = A[leaf++].m_key;
+ if (leaf >= n || (root < next && A[root].m_key < A[leaf].m_key))
+ {
+ A[next].m_key = (mz_uint16)(A[next].m_key + A[root].m_key);
+ A[root++].m_key = (mz_uint16)next;
+ }
+ else
+ A[next].m_key = (mz_uint16)(A[next].m_key + A[leaf++].m_key);
+ }
+ A[n - 2].m_key = 0;
+ for (next = n - 3; next >= 0; next--)
+ A[next].m_key = A[A[next].m_key].m_key + 1;
+ avbl = 1;
+ used = dpth = 0;
+ root = n - 2;
+ next = n - 1;
+ while (avbl > 0)
+ {
+ while (root >= 0 && (int)A[root].m_key == dpth)
+ {
+ used++;
+ root--;
+ }
+ while (avbl > used)
+ {
+ A[next--].m_key = (mz_uint16)(dpth);
+ avbl--;
+ }
+ avbl = 2 * used;
+ dpth++;
+ used = 0;
+ }
+}
+
+/* Limits canonical Huffman code table's max code size. */
+enum
+{
+ TDEFL_MAX_SUPPORTED_HUFF_CODESIZE = 32
+};
+static void tdefl_huffman_enforce_max_code_size(int *pNum_codes, int code_list_len, int max_code_size)
+{
+ int i;
+ mz_uint32 total = 0;
+ if (code_list_len <= 1)
+ return;
+ for (i = max_code_size + 1; i <= TDEFL_MAX_SUPPORTED_HUFF_CODESIZE; i++)
+ pNum_codes[max_code_size] += pNum_codes[i];
+ for (i = max_code_size; i > 0; i--)
+ total += (((mz_uint32)pNum_codes[i]) << (max_code_size - i));
+ while (total != (1UL << max_code_size))
+ {
+ pNum_codes[max_code_size]--;
+ for (i = max_code_size - 1; i > 0; i--)
+ if (pNum_codes[i])
+ {
+ pNum_codes[i]--;
+ pNum_codes[i + 1] += 2;
+ break;
+ }
+ total--;
+ }
+}
+
+static void tdefl_optimize_huffman_table(tdefl_compressor *d, int table_num, int table_len, int code_size_limit, int static_table)
+{
+ int i, j, l, num_codes[1 + TDEFL_MAX_SUPPORTED_HUFF_CODESIZE];
+ mz_uint next_code[TDEFL_MAX_SUPPORTED_HUFF_CODESIZE + 1];
+ MZ_CLEAR_OBJ(num_codes);
+ if (static_table)
+ {
+ for (i = 0; i < table_len; i++)
+ num_codes[d->m_huff_code_sizes[table_num][i]]++;
+ }
+ else
+ {
+ tdefl_sym_freq syms0[TDEFL_MAX_HUFF_SYMBOLS], syms1[TDEFL_MAX_HUFF_SYMBOLS], *pSyms;
+ int num_used_syms = 0;
+ const mz_uint16 *pSym_count = &d->m_huff_count[table_num][0];
+ for (i = 0; i < table_len; i++)
+ if (pSym_count[i])
+ {
+ syms0[num_used_syms].m_key = (mz_uint16)pSym_count[i];
+ syms0[num_used_syms++].m_sym_index = (mz_uint16)i;
+ }
+
+ pSyms = tdefl_radix_sort_syms(num_used_syms, syms0, syms1);
+ tdefl_calculate_minimum_redundancy(pSyms, num_used_syms);
+
+ for (i = 0; i < num_used_syms; i++)
+ num_codes[pSyms[i].m_key]++;
+
+ tdefl_huffman_enforce_max_code_size(num_codes, num_used_syms, code_size_limit);
+
+ MZ_CLEAR_OBJ(d->m_huff_code_sizes[table_num]);
+ MZ_CLEAR_OBJ(d->m_huff_codes[table_num]);
+ for (i = 1, j = num_used_syms; i <= code_size_limit; i++)
+ for (l = num_codes[i]; l > 0; l--)
+ d->m_huff_code_sizes[table_num][pSyms[--j].m_sym_index] = (mz_uint8)(i);
+ }
+
+ next_code[1] = 0;
+ for (j = 0, i = 2; i <= code_size_limit; i++)
+ next_code[i] = j = ((j + num_codes[i - 1]) << 1);
+
+ for (i = 0; i < table_len; i++)
+ {
+ mz_uint rev_code = 0, code, code_size;
+ if ((code_size = d->m_huff_code_sizes[table_num][i]) == 0)
+ continue;
+ code = next_code[code_size]++;
+ for (l = code_size; l > 0; l--, code >>= 1)
+ rev_code = (rev_code << 1) | (code & 1);
+ d->m_huff_codes[table_num][i] = (mz_uint16)rev_code;
+ }
+}
+
+#define TDEFL_PUT_BITS(b, l) \
+ do \
+ { \
+ mz_uint bits = b; \
+ mz_uint len = l; \
+ MZ_ASSERT(bits <= ((1U << len) - 1U)); \
+ d->m_bit_buffer |= (bits << d->m_bits_in); \
+ d->m_bits_in += len; \
+ while (d->m_bits_in >= 8) \
+ { \
+ if (d->m_pOutput_buf < d->m_pOutput_buf_end) \
+ *d->m_pOutput_buf++ = (mz_uint8)(d->m_bit_buffer); \
+ d->m_bit_buffer >>= 8; \
+ d->m_bits_in -= 8; \
+ } \
+ } \
+ MZ_MACRO_END
+
+#define TDEFL_RLE_PREV_CODE_SIZE() \
+ { \
+ if (rle_repeat_count) \
+ { \
+ if (rle_repeat_count < 3) \
+ { \
+ d->m_huff_count[2][prev_code_size] = (mz_uint16)(d->m_huff_count[2][prev_code_size] + rle_repeat_count); \
+ while (rle_repeat_count--) \
+ packed_code_sizes[num_packed_code_sizes++] = prev_code_size; \
+ } \
+ else \
+ { \
+ d->m_huff_count[2][16] = (mz_uint16)(d->m_huff_count[2][16] + 1); \
+ packed_code_sizes[num_packed_code_sizes++] = 16; \
+ packed_code_sizes[num_packed_code_sizes++] = (mz_uint8)(rle_repeat_count - 3); \
+ } \
+ rle_repeat_count = 0; \
+ } \
+ }
+
+#define TDEFL_RLE_ZERO_CODE_SIZE() \
+ { \
+ if (rle_z_count) \
+ { \
+ if (rle_z_count < 3) \
+ { \
+ d->m_huff_count[2][0] = (mz_uint16)(d->m_huff_count[2][0] + rle_z_count); \
+ while (rle_z_count--) \
+ packed_code_sizes[num_packed_code_sizes++] = 0; \
+ } \
+ else if (rle_z_count <= 10) \
+ { \
+ d->m_huff_count[2][17] = (mz_uint16)(d->m_huff_count[2][17] + 1); \
+ packed_code_sizes[num_packed_code_sizes++] = 17; \
+ packed_code_sizes[num_packed_code_sizes++] = (mz_uint8)(rle_z_count - 3); \
+ } \
+ else \
+ { \
+ d->m_huff_count[2][18] = (mz_uint16)(d->m_huff_count[2][18] + 1); \
+ packed_code_sizes[num_packed_code_sizes++] = 18; \
+ packed_code_sizes[num_packed_code_sizes++] = (mz_uint8)(rle_z_count - 11); \
+ } \
+ rle_z_count = 0; \
+ } \
+ }
+
+static mz_uint8 s_tdefl_packed_code_size_syms_swizzle[] = { 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 };
+
+static void tdefl_start_dynamic_block(tdefl_compressor *d)
+{
+ int num_lit_codes, num_dist_codes, num_bit_lengths;
+ mz_uint i, total_code_sizes_to_pack, num_packed_code_sizes, rle_z_count, rle_repeat_count, packed_code_sizes_index;
+ mz_uint8 code_sizes_to_pack[TDEFL_MAX_HUFF_SYMBOLS_0 + TDEFL_MAX_HUFF_SYMBOLS_1], packed_code_sizes[TDEFL_MAX_HUFF_SYMBOLS_0 + TDEFL_MAX_HUFF_SYMBOLS_1], prev_code_size = 0xFF;
+
+ d->m_huff_count[0][256] = 1;
+
+ tdefl_optimize_huffman_table(d, 0, TDEFL_MAX_HUFF_SYMBOLS_0, 15, MZ_FALSE);
+ tdefl_optimize_huffman_table(d, 1, TDEFL_MAX_HUFF_SYMBOLS_1, 15, MZ_FALSE);
+
+ for (num_lit_codes = 286; num_lit_codes > 257; num_lit_codes--)
+ if (d->m_huff_code_sizes[0][num_lit_codes - 1])
+ break;
+ for (num_dist_codes = 30; num_dist_codes > 1; num_dist_codes--)
+ if (d->m_huff_code_sizes[1][num_dist_codes - 1])
+ break;
+
+ memcpy(code_sizes_to_pack, &d->m_huff_code_sizes[0][0], num_lit_codes);
+ memcpy(code_sizes_to_pack + num_lit_codes, &d->m_huff_code_sizes[1][0], num_dist_codes);
+ total_code_sizes_to_pack = num_lit_codes + num_dist_codes;
+ num_packed_code_sizes = 0;
+ rle_z_count = 0;
+ rle_repeat_count = 0;
+
+ memset(&d->m_huff_count[2][0], 0, sizeof(d->m_huff_count[2][0]) * TDEFL_MAX_HUFF_SYMBOLS_2);
+ for (i = 0; i < total_code_sizes_to_pack; i++)
+ {
+ mz_uint8 code_size = code_sizes_to_pack[i];
+ if (!code_size)
+ {
+ TDEFL_RLE_PREV_CODE_SIZE();
+ if (++rle_z_count == 138)
+ {
+ TDEFL_RLE_ZERO_CODE_SIZE();
+ }
+ }
+ else
+ {
+ TDEFL_RLE_ZERO_CODE_SIZE();
+ if (code_size != prev_code_size)
+ {
+ TDEFL_RLE_PREV_CODE_SIZE();
+ d->m_huff_count[2][code_size] = (mz_uint16)(d->m_huff_count[2][code_size] + 1);
+ packed_code_sizes[num_packed_code_sizes++] = code_size;
+ }
+ else if (++rle_repeat_count == 6)
+ {
+ TDEFL_RLE_PREV_CODE_SIZE();
+ }
+ }
+ prev_code_size = code_size;
+ }
+ if (rle_repeat_count)
+ {
+ TDEFL_RLE_PREV_CODE_SIZE();
+ }
+ else
+ {
+ TDEFL_RLE_ZERO_CODE_SIZE();
+ }
+
+ tdefl_optimize_huffman_table(d, 2, TDEFL_MAX_HUFF_SYMBOLS_2, 7, MZ_FALSE);
+
+ TDEFL_PUT_BITS(2, 2);
+
+ TDEFL_PUT_BITS(num_lit_codes - 257, 5);
+ TDEFL_PUT_BITS(num_dist_codes - 1, 5);
+
+ for (num_bit_lengths = 18; num_bit_lengths >= 0; num_bit_lengths--)
+ if (d->m_huff_code_sizes[2][s_tdefl_packed_code_size_syms_swizzle[num_bit_lengths]])
+ break;
+ num_bit_lengths = MZ_MAX(4, (num_bit_lengths + 1));
+ TDEFL_PUT_BITS(num_bit_lengths - 4, 4);
+ for (i = 0; (int)i < num_bit_lengths; i++)
+ TDEFL_PUT_BITS(d->m_huff_code_sizes[2][s_tdefl_packed_code_size_syms_swizzle[i]], 3);
+
+ for (packed_code_sizes_index = 0; packed_code_sizes_index < num_packed_code_sizes;)
+ {
+ mz_uint code = packed_code_sizes[packed_code_sizes_index++];
+ MZ_ASSERT(code < TDEFL_MAX_HUFF_SYMBOLS_2);
+ TDEFL_PUT_BITS(d->m_huff_codes[2][code], d->m_huff_code_sizes[2][code]);
+ if (code >= 16)
+ TDEFL_PUT_BITS(packed_code_sizes[packed_code_sizes_index++], "\02\03\07"[code - 16]);
+ }
+}
+
+static void tdefl_start_static_block(tdefl_compressor *d)
+{
+ mz_uint i;
+ mz_uint8 *p = &d->m_huff_code_sizes[0][0];
+
+ for (i = 0; i <= 143; ++i)
+ *p++ = 8;
+ for (; i <= 255; ++i)
+ *p++ = 9;
+ for (; i <= 279; ++i)
+ *p++ = 7;
+ for (; i <= 287; ++i)
+ *p++ = 8;
+
+ memset(d->m_huff_code_sizes[1], 5, 32);
+
+ tdefl_optimize_huffman_table(d, 0, 288, 15, MZ_TRUE);
+ tdefl_optimize_huffman_table(d, 1, 32, 15, MZ_TRUE);
+
+ TDEFL_PUT_BITS(1, 2);
+}
+
+static const mz_uint mz_bitmasks[17] = { 0x0000, 0x0001, 0x0003, 0x0007, 0x000F, 0x001F, 0x003F, 0x007F, 0x00FF, 0x01FF, 0x03FF, 0x07FF, 0x0FFF, 0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF };
+
+#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN && MINIZ_HAS_64BIT_REGISTERS
+static mz_bool tdefl_compress_lz_codes(tdefl_compressor *d)
+{
+ mz_uint flags;
+ mz_uint8 *pLZ_codes;
+ mz_uint8 *pOutput_buf = d->m_pOutput_buf;
+ mz_uint8 *pLZ_code_buf_end = d->m_pLZ_code_buf;
+ mz_uint64 bit_buffer = d->m_bit_buffer;
+ mz_uint bits_in = d->m_bits_in;
+
+#define TDEFL_PUT_BITS_FAST(b, l) \
+ { \
+ bit_buffer |= (((mz_uint64)(b)) << bits_in); \
+ bits_in += (l); \
+ }
+
+ flags = 1;
+ for (pLZ_codes = d->m_lz_code_buf; pLZ_codes < pLZ_code_buf_end; flags >>= 1)
+ {
+ if (flags == 1)
+ flags = *pLZ_codes++ | 0x100;
+
+ if (flags & 1)
+ {
+ mz_uint s0, s1, n0, n1, sym, num_extra_bits;
+ mz_uint match_len = pLZ_codes[0], match_dist = *(const mz_uint16 *)(pLZ_codes + 1);
+ pLZ_codes += 3;
+
+ MZ_ASSERT(d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]);
+ TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][s_tdefl_len_sym[match_len]], d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]);
+ TDEFL_PUT_BITS_FAST(match_len & mz_bitmasks[s_tdefl_len_extra[match_len]], s_tdefl_len_extra[match_len]);
+
+ /* This sequence coaxes MSVC into using cmov's vs. jmp's. */
+ s0 = s_tdefl_small_dist_sym[match_dist & 511];
+ n0 = s_tdefl_small_dist_extra[match_dist & 511];
+ s1 = s_tdefl_large_dist_sym[match_dist >> 8];
+ n1 = s_tdefl_large_dist_extra[match_dist >> 8];
+ sym = (match_dist < 512) ? s0 : s1;
+ num_extra_bits = (match_dist < 512) ? n0 : n1;
+
+ MZ_ASSERT(d->m_huff_code_sizes[1][sym]);
+ TDEFL_PUT_BITS_FAST(d->m_huff_codes[1][sym], d->m_huff_code_sizes[1][sym]);
+ TDEFL_PUT_BITS_FAST(match_dist & mz_bitmasks[num_extra_bits], num_extra_bits);
+ }
+ else
+ {
+ mz_uint lit = *pLZ_codes++;
+ MZ_ASSERT(d->m_huff_code_sizes[0][lit]);
+ TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]);
+
+ if (((flags & 2) == 0) && (pLZ_codes < pLZ_code_buf_end))
+ {
+ flags >>= 1;
+ lit = *pLZ_codes++;
+ MZ_ASSERT(d->m_huff_code_sizes[0][lit]);
+ TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]);
+
+ if (((flags & 2) == 0) && (pLZ_codes < pLZ_code_buf_end))
+ {
+ flags >>= 1;
+ lit = *pLZ_codes++;
+ MZ_ASSERT(d->m_huff_code_sizes[0][lit]);
+ TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]);
+ }
+ }
+ }
+
+ if (pOutput_buf >= d->m_pOutput_buf_end)
+ return MZ_FALSE;
+
+ *(mz_uint64 *)pOutput_buf = bit_buffer;
+ pOutput_buf += (bits_in >> 3);
+ bit_buffer >>= (bits_in & ~7);
+ bits_in &= 7;
+ }
+
+#undef TDEFL_PUT_BITS_FAST
+
+ d->m_pOutput_buf = pOutput_buf;
+ d->m_bits_in = 0;
+ d->m_bit_buffer = 0;
+
+ while (bits_in)
+ {
+ mz_uint32 n = MZ_MIN(bits_in, 16);
+ TDEFL_PUT_BITS((mz_uint)bit_buffer & mz_bitmasks[n], n);
+ bit_buffer >>= n;
+ bits_in -= n;
+ }
+
+ TDEFL_PUT_BITS(d->m_huff_codes[0][256], d->m_huff_code_sizes[0][256]);
+
+ return (d->m_pOutput_buf < d->m_pOutput_buf_end);
+}
+#else
+static mz_bool tdefl_compress_lz_codes(tdefl_compressor *d)
+{
+ mz_uint flags;
+ mz_uint8 *pLZ_codes;
+
+ flags = 1;
+ for (pLZ_codes = d->m_lz_code_buf; pLZ_codes < d->m_pLZ_code_buf; flags >>= 1)
+ {
+ if (flags == 1)
+ flags = *pLZ_codes++ | 0x100;
+ if (flags & 1)
+ {
+ mz_uint sym, num_extra_bits;
+ mz_uint match_len = pLZ_codes[0], match_dist = (pLZ_codes[1] | (pLZ_codes[2] << 8));
+ pLZ_codes += 3;
+
+ MZ_ASSERT(d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]);
+ TDEFL_PUT_BITS(d->m_huff_codes[0][s_tdefl_len_sym[match_len]], d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]);
+ TDEFL_PUT_BITS(match_len & mz_bitmasks[s_tdefl_len_extra[match_len]], s_tdefl_len_extra[match_len]);
+
+ if (match_dist < 512)
+ {
+ sym = s_tdefl_small_dist_sym[match_dist];
+ num_extra_bits = s_tdefl_small_dist_extra[match_dist];
+ }
+ else
+ {
+ sym = s_tdefl_large_dist_sym[match_dist >> 8];
+ num_extra_bits = s_tdefl_large_dist_extra[match_dist >> 8];
+ }
+ MZ_ASSERT(d->m_huff_code_sizes[1][sym]);
+ TDEFL_PUT_BITS(d->m_huff_codes[1][sym], d->m_huff_code_sizes[1][sym]);
+ TDEFL_PUT_BITS(match_dist & mz_bitmasks[num_extra_bits], num_extra_bits);
+ }
+ else
+ {
+ mz_uint lit = *pLZ_codes++;
+ MZ_ASSERT(d->m_huff_code_sizes[0][lit]);
+ TDEFL_PUT_BITS(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]);
+ }
+ }
+
+ TDEFL_PUT_BITS(d->m_huff_codes[0][256], d->m_huff_code_sizes[0][256]);
+
+ return (d->m_pOutput_buf < d->m_pOutput_buf_end);
+}
+#endif /* MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN && MINIZ_HAS_64BIT_REGISTERS */
+
+static mz_bool tdefl_compress_block(tdefl_compressor *d, mz_bool static_block)
+{
+ if (static_block)
+ tdefl_start_static_block(d);
+ else
+ tdefl_start_dynamic_block(d);
+ return tdefl_compress_lz_codes(d);
+}
+
+static int tdefl_flush_block(tdefl_compressor *d, int flush)
+{
+ mz_uint saved_bit_buf, saved_bits_in;
+ mz_uint8 *pSaved_output_buf;
+ mz_bool comp_block_succeeded = MZ_FALSE;
+ int n, use_raw_block = ((d->m_flags & TDEFL_FORCE_ALL_RAW_BLOCKS) != 0) && (d->m_lookahead_pos - d->m_lz_code_buf_dict_pos) <= d->m_dict_size;
+ mz_uint8 *pOutput_buf_start = ((d->m_pPut_buf_func == NULL) && ((*d->m_pOut_buf_size - d->m_out_buf_ofs) >= TDEFL_OUT_BUF_SIZE)) ? ((mz_uint8 *)d->m_pOut_buf + d->m_out_buf_ofs) : d->m_output_buf;
+
+ d->m_pOutput_buf = pOutput_buf_start;
+ d->m_pOutput_buf_end = d->m_pOutput_buf + TDEFL_OUT_BUF_SIZE - 16;
+
+ MZ_ASSERT(!d->m_output_flush_remaining);
+ d->m_output_flush_ofs = 0;
+ d->m_output_flush_remaining = 0;
+
+ *d->m_pLZ_flags = (mz_uint8)(*d->m_pLZ_flags >> d->m_num_flags_left);
+ d->m_pLZ_code_buf -= (d->m_num_flags_left == 8);
+
+ if ((d->m_flags & TDEFL_WRITE_ZLIB_HEADER) && (!d->m_block_index))
+ {
+ TDEFL_PUT_BITS(0x78, 8);
+ TDEFL_PUT_BITS(0x01, 8);
+ }
+
+ TDEFL_PUT_BITS(flush == TDEFL_FINISH, 1);
+
+ pSaved_output_buf = d->m_pOutput_buf;
+ saved_bit_buf = d->m_bit_buffer;
+ saved_bits_in = d->m_bits_in;
+
+ if (!use_raw_block)
+ comp_block_succeeded = tdefl_compress_block(d, (d->m_flags & TDEFL_FORCE_ALL_STATIC_BLOCKS) || (d->m_total_lz_bytes < 48));
+
+ /* If the block gets expanded, forget the current contents of the output buffer and send a raw block instead. */
+ if (((use_raw_block) || ((d->m_total_lz_bytes) && ((d->m_pOutput_buf - pSaved_output_buf + 1U) >= d->m_total_lz_bytes))) &&
+ ((d->m_lookahead_pos - d->m_lz_code_buf_dict_pos) <= d->m_dict_size))
+ {
+ mz_uint i;
+ d->m_pOutput_buf = pSaved_output_buf;
+ d->m_bit_buffer = saved_bit_buf, d->m_bits_in = saved_bits_in;
+ TDEFL_PUT_BITS(0, 2);
+ if (d->m_bits_in)
+ {
+ TDEFL_PUT_BITS(0, 8 - d->m_bits_in);
+ }
+ for (i = 2; i; --i, d->m_total_lz_bytes ^= 0xFFFF)
+ {
+ TDEFL_PUT_BITS(d->m_total_lz_bytes & 0xFFFF, 16);
+ }
+ for (i = 0; i < d->m_total_lz_bytes; ++i)
+ {
+ TDEFL_PUT_BITS(d->m_dict[(d->m_lz_code_buf_dict_pos + i) & TDEFL_LZ_DICT_SIZE_MASK], 8);
+ }
+ }
+ /* Check for the extremely unlikely (if not impossible) case of the compressed block not fitting into the output buffer when using dynamic codes. */
+ else if (!comp_block_succeeded)
+ {
+ d->m_pOutput_buf = pSaved_output_buf;
+ d->m_bit_buffer = saved_bit_buf, d->m_bits_in = saved_bits_in;
+ tdefl_compress_block(d, MZ_TRUE);
+ }
+
+ if (flush)
+ {
+ if (flush == TDEFL_FINISH)
+ {
+ if (d->m_bits_in)
+ {
+ TDEFL_PUT_BITS(0, 8 - d->m_bits_in);
+ }
+ if (d->m_flags & TDEFL_WRITE_ZLIB_HEADER)
+ {
+ mz_uint i, a = d->m_adler32;
+ for (i = 0; i < 4; i++)
+ {
+ TDEFL_PUT_BITS((a >> 24) & 0xFF, 8);
+ a <<= 8;
+ }
+ }
+ }
+ else
+ {
+ mz_uint i, z = 0;
+ TDEFL_PUT_BITS(0, 3);
+ if (d->m_bits_in)
+ {
+ TDEFL_PUT_BITS(0, 8 - d->m_bits_in);
+ }
+ for (i = 2; i; --i, z ^= 0xFFFF)
+ {
+ TDEFL_PUT_BITS(z & 0xFFFF, 16);
+ }
+ }
+ }
+
+ MZ_ASSERT(d->m_pOutput_buf < d->m_pOutput_buf_end);
+
+ memset(&d->m_huff_count[0][0], 0, sizeof(d->m_huff_count[0][0]) * TDEFL_MAX_HUFF_SYMBOLS_0);
+ memset(&d->m_huff_count[1][0], 0, sizeof(d->m_huff_count[1][0]) * TDEFL_MAX_HUFF_SYMBOLS_1);
+
+ d->m_pLZ_code_buf = d->m_lz_code_buf + 1;
+ d->m_pLZ_flags = d->m_lz_code_buf;
+ d->m_num_flags_left = 8;
+ d->m_lz_code_buf_dict_pos += d->m_total_lz_bytes;
+ d->m_total_lz_bytes = 0;
+ d->m_block_index++;
+
+ if ((n = (int)(d->m_pOutput_buf - pOutput_buf_start)) != 0)
+ {
+ if (d->m_pPut_buf_func)
+ {
+ *d->m_pIn_buf_size = d->m_pSrc - (const mz_uint8 *)d->m_pIn_buf;
+ if (!(*d->m_pPut_buf_func)(d->m_output_buf, n, d->m_pPut_buf_user))
+ return (d->m_prev_return_status = TDEFL_STATUS_PUT_BUF_FAILED);
+ }
+ else if (pOutput_buf_start == d->m_output_buf)
+ {
+ int bytes_to_copy = (int)MZ_MIN((size_t)n, (size_t)(*d->m_pOut_buf_size - d->m_out_buf_ofs));
+ memcpy((mz_uint8 *)d->m_pOut_buf + d->m_out_buf_ofs, d->m_output_buf, bytes_to_copy);
+ d->m_out_buf_ofs += bytes_to_copy;
+ if ((n -= bytes_to_copy) != 0)
+ {
+ d->m_output_flush_ofs = bytes_to_copy;
+ d->m_output_flush_remaining = n;
+ }
+ }
+ else
+ {
+ d->m_out_buf_ofs += n;
+ }
+ }
+
+ return d->m_output_flush_remaining;
+}
+
+#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES
+#ifdef MINIZ_UNALIGNED_USE_MEMCPY
+static mz_uint16 TDEFL_READ_UNALIGNED_WORD(const mz_uint8* p)
+{
+ mz_uint16 ret;
+ memcpy(&ret, p, sizeof(mz_uint16));
+ return ret;
+}
+static mz_uint16 TDEFL_READ_UNALIGNED_WORD2(const mz_uint16* p)
+{
+ mz_uint16 ret;
+ memcpy(&ret, p, sizeof(mz_uint16));
+ return ret;
+}
+#else
+#define TDEFL_READ_UNALIGNED_WORD(p) *(const mz_uint16 *)(p)
+#define TDEFL_READ_UNALIGNED_WORD2(p) *(const mz_uint16 *)(p)
+#endif
+static MZ_FORCEINLINE void tdefl_find_match(tdefl_compressor *d, mz_uint lookahead_pos, mz_uint max_dist, mz_uint max_match_len, mz_uint *pMatch_dist, mz_uint *pMatch_len)
+{
+ mz_uint dist, pos = lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK, match_len = *pMatch_len, probe_pos = pos, next_probe_pos, probe_len;
+ mz_uint num_probes_left = d->m_max_probes[match_len >= 32];
+ const mz_uint16 *s = (const mz_uint16 *)(d->m_dict + pos), *p, *q;
+ mz_uint16 c01 = TDEFL_READ_UNALIGNED_WORD(&d->m_dict[pos + match_len - 1]), s01 = TDEFL_READ_UNALIGNED_WORD2(s);
+ MZ_ASSERT(max_match_len <= TDEFL_MAX_MATCH_LEN);
+ if (max_match_len <= match_len)
+ return;
+ for (;;)
+ {
+ for (;;)
+ {
+ if (--num_probes_left == 0)
+ return;
+#define TDEFL_PROBE \
+ next_probe_pos = d->m_next[probe_pos]; \
+ if ((!next_probe_pos) || ((dist = (mz_uint16)(lookahead_pos - next_probe_pos)) > max_dist)) \
+ return; \
+ probe_pos = next_probe_pos & TDEFL_LZ_DICT_SIZE_MASK; \
+ if (TDEFL_READ_UNALIGNED_WORD(&d->m_dict[probe_pos + match_len - 1]) == c01) \
+ break;
+ TDEFL_PROBE;
+ TDEFL_PROBE;
+ TDEFL_PROBE;
+ }
+ if (!dist)
+ break;
+ q = (const mz_uint16 *)(d->m_dict + probe_pos);
+ if (TDEFL_READ_UNALIGNED_WORD2(q) != s01)
+ continue;
+ p = s;
+ probe_len = 32;
+ do
+ {
+ } while ((TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) && (TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) &&
+ (TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) && (TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) && (--probe_len > 0));
+ if (!probe_len)
+ {
+ *pMatch_dist = dist;
+ *pMatch_len = MZ_MIN(max_match_len, (mz_uint)TDEFL_MAX_MATCH_LEN);
+ break;
+ }
+ else if ((probe_len = ((mz_uint)(p - s) * 2) + (mz_uint)(*(const mz_uint8 *)p == *(const mz_uint8 *)q)) > match_len)
+ {
+ *pMatch_dist = dist;
+ if ((*pMatch_len = match_len = MZ_MIN(max_match_len, probe_len)) == max_match_len)
+ break;
+ c01 = TDEFL_READ_UNALIGNED_WORD(&d->m_dict[pos + match_len - 1]);
+ }
+ }
+}
+#else
+static MZ_FORCEINLINE void tdefl_find_match(tdefl_compressor *d, mz_uint lookahead_pos, mz_uint max_dist, mz_uint max_match_len, mz_uint *pMatch_dist, mz_uint *pMatch_len)
+{
+ mz_uint dist, pos = lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK, match_len = *pMatch_len, probe_pos = pos, next_probe_pos, probe_len;
+ mz_uint num_probes_left = d->m_max_probes[match_len >= 32];
+ const mz_uint8 *s = d->m_dict + pos, *p, *q;
+ mz_uint8 c0 = d->m_dict[pos + match_len], c1 = d->m_dict[pos + match_len - 1];
+ MZ_ASSERT(max_match_len <= TDEFL_MAX_MATCH_LEN);
+ if (max_match_len <= match_len)
+ return;
+ for (;;)
+ {
+ for (;;)
+ {
+ if (--num_probes_left == 0)
+ return;
+#define TDEFL_PROBE \
+ next_probe_pos = d->m_next[probe_pos]; \
+ if ((!next_probe_pos) || ((dist = (mz_uint16)(lookahead_pos - next_probe_pos)) > max_dist)) \
+ return; \
+ probe_pos = next_probe_pos & TDEFL_LZ_DICT_SIZE_MASK; \
+ if ((d->m_dict[probe_pos + match_len] == c0) && (d->m_dict[probe_pos + match_len - 1] == c1)) \
+ break;
+ TDEFL_PROBE;
+ TDEFL_PROBE;
+ TDEFL_PROBE;
+ }
+ if (!dist)
+ break;
+ p = s;
+ q = d->m_dict + probe_pos;
+ for (probe_len = 0; probe_len < max_match_len; probe_len++)
+ if (*p++ != *q++)
+ break;
+ if (probe_len > match_len)
+ {
+ *pMatch_dist = dist;
+ if ((*pMatch_len = match_len = probe_len) == max_match_len)
+ return;
+ c0 = d->m_dict[pos + match_len];
+ c1 = d->m_dict[pos + match_len - 1];
+ }
+ }
+}
+#endif /* #if MINIZ_USE_UNALIGNED_LOADS_AND_STORES */
+
+#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN
+#ifdef MINIZ_UNALIGNED_USE_MEMCPY
+static mz_uint32 TDEFL_READ_UNALIGNED_WORD32(const mz_uint8* p)
+{
+ mz_uint32 ret;
+ memcpy(&ret, p, sizeof(mz_uint32));
+ return ret;
+}
+#else
+#define TDEFL_READ_UNALIGNED_WORD32(p) *(const mz_uint32 *)(p)
+#endif
+static mz_bool tdefl_compress_fast(tdefl_compressor *d)
+{
+ /* Faster, minimally featured LZRW1-style match+parse loop with better register utilization. Intended for applications where raw throughput is valued more highly than ratio. */
+ mz_uint lookahead_pos = d->m_lookahead_pos, lookahead_size = d->m_lookahead_size, dict_size = d->m_dict_size, total_lz_bytes = d->m_total_lz_bytes, num_flags_left = d->m_num_flags_left;
+ mz_uint8 *pLZ_code_buf = d->m_pLZ_code_buf, *pLZ_flags = d->m_pLZ_flags;
+ mz_uint cur_pos = lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK;
+
+ while ((d->m_src_buf_left) || ((d->m_flush) && (lookahead_size)))
+ {
+ const mz_uint TDEFL_COMP_FAST_LOOKAHEAD_SIZE = 4096;
+ mz_uint dst_pos = (lookahead_pos + lookahead_size) & TDEFL_LZ_DICT_SIZE_MASK;
+ mz_uint num_bytes_to_process = (mz_uint)MZ_MIN(d->m_src_buf_left, TDEFL_COMP_FAST_LOOKAHEAD_SIZE - lookahead_size);
+ d->m_src_buf_left -= num_bytes_to_process;
+ lookahead_size += num_bytes_to_process;
+
+ while (num_bytes_to_process)
+ {
+ mz_uint32 n = MZ_MIN(TDEFL_LZ_DICT_SIZE - dst_pos, num_bytes_to_process);
+ memcpy(d->m_dict + dst_pos, d->m_pSrc, n);
+ if (dst_pos < (TDEFL_MAX_MATCH_LEN - 1))
+ memcpy(d->m_dict + TDEFL_LZ_DICT_SIZE + dst_pos, d->m_pSrc, MZ_MIN(n, (TDEFL_MAX_MATCH_LEN - 1) - dst_pos));
+ d->m_pSrc += n;
+ dst_pos = (dst_pos + n) & TDEFL_LZ_DICT_SIZE_MASK;
+ num_bytes_to_process -= n;
+ }
+
+ dict_size = MZ_MIN(TDEFL_LZ_DICT_SIZE - lookahead_size, dict_size);
+ if ((!d->m_flush) && (lookahead_size < TDEFL_COMP_FAST_LOOKAHEAD_SIZE))
+ break;
+
+ while (lookahead_size >= 4)
+ {
+ mz_uint cur_match_dist, cur_match_len = 1;
+ mz_uint8 *pCur_dict = d->m_dict + cur_pos;
+ mz_uint first_trigram = TDEFL_READ_UNALIGNED_WORD32(pCur_dict) & 0xFFFFFF;
+ mz_uint hash = (first_trigram ^ (first_trigram >> (24 - (TDEFL_LZ_HASH_BITS - 8)))) & TDEFL_LEVEL1_HASH_SIZE_MASK;
+ mz_uint probe_pos = d->m_hash[hash];
+ d->m_hash[hash] = (mz_uint16)lookahead_pos;
+
+ if (((cur_match_dist = (mz_uint16)(lookahead_pos - probe_pos)) <= dict_size) && ((TDEFL_READ_UNALIGNED_WORD32(d->m_dict + (probe_pos &= TDEFL_LZ_DICT_SIZE_MASK)) & 0xFFFFFF) == first_trigram))
+ {
+ const mz_uint16 *p = (const mz_uint16 *)pCur_dict;
+ const mz_uint16 *q = (const mz_uint16 *)(d->m_dict + probe_pos);
+ mz_uint32 probe_len = 32;
+ do
+ {
+ } while ((TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) && (TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) &&
+ (TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) && (TDEFL_READ_UNALIGNED_WORD2(++p) == TDEFL_READ_UNALIGNED_WORD2(++q)) && (--probe_len > 0));
+ cur_match_len = ((mz_uint)(p - (const mz_uint16 *)pCur_dict) * 2) + (mz_uint)(*(const mz_uint8 *)p == *(const mz_uint8 *)q);
+ if (!probe_len)
+ cur_match_len = cur_match_dist ? TDEFL_MAX_MATCH_LEN : 0;
+
+ if ((cur_match_len < TDEFL_MIN_MATCH_LEN) || ((cur_match_len == TDEFL_MIN_MATCH_LEN) && (cur_match_dist >= 8U * 1024U)))
+ {
+ cur_match_len = 1;
+ *pLZ_code_buf++ = (mz_uint8)first_trigram;
+ *pLZ_flags = (mz_uint8)(*pLZ_flags >> 1);
+ d->m_huff_count[0][(mz_uint8)first_trigram]++;
+ }
+ else
+ {
+ mz_uint32 s0, s1;
+ cur_match_len = MZ_MIN(cur_match_len, lookahead_size);
+
+ MZ_ASSERT((cur_match_len >= TDEFL_MIN_MATCH_LEN) && (cur_match_dist >= 1) && (cur_match_dist <= TDEFL_LZ_DICT_SIZE));
+
+ cur_match_dist--;
+
+ pLZ_code_buf[0] = (mz_uint8)(cur_match_len - TDEFL_MIN_MATCH_LEN);
+#ifdef MINIZ_UNALIGNED_USE_MEMCPY
+ memcpy(&pLZ_code_buf[1], &cur_match_dist, sizeof(cur_match_dist));
+#else
+ *(mz_uint16 *)(&pLZ_code_buf[1]) = (mz_uint16)cur_match_dist;
+#endif
+ pLZ_code_buf += 3;
+ *pLZ_flags = (mz_uint8)((*pLZ_flags >> 1) | 0x80);
+
+ s0 = s_tdefl_small_dist_sym[cur_match_dist & 511];
+ s1 = s_tdefl_large_dist_sym[cur_match_dist >> 8];
+ d->m_huff_count[1][(cur_match_dist < 512) ? s0 : s1]++;
+
+ d->m_huff_count[0][s_tdefl_len_sym[cur_match_len - TDEFL_MIN_MATCH_LEN]]++;
+ }
+ }
+ else
+ {
+ *pLZ_code_buf++ = (mz_uint8)first_trigram;
+ *pLZ_flags = (mz_uint8)(*pLZ_flags >> 1);
+ d->m_huff_count[0][(mz_uint8)first_trigram]++;
+ }
+
+ if (--num_flags_left == 0)
+ {
+ num_flags_left = 8;
+ pLZ_flags = pLZ_code_buf++;
+ }
+
+ total_lz_bytes += cur_match_len;
+ lookahead_pos += cur_match_len;
+ dict_size = MZ_MIN(dict_size + cur_match_len, (mz_uint)TDEFL_LZ_DICT_SIZE);
+ cur_pos = (cur_pos + cur_match_len) & TDEFL_LZ_DICT_SIZE_MASK;
+ MZ_ASSERT(lookahead_size >= cur_match_len);
+ lookahead_size -= cur_match_len;
+
+ if (pLZ_code_buf > &d->m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE - 8])
+ {
+ int n;
+ d->m_lookahead_pos = lookahead_pos;
+ d->m_lookahead_size = lookahead_size;
+ d->m_dict_size = dict_size;
+ d->m_total_lz_bytes = total_lz_bytes;
+ d->m_pLZ_code_buf = pLZ_code_buf;
+ d->m_pLZ_flags = pLZ_flags;
+ d->m_num_flags_left = num_flags_left;
+ if ((n = tdefl_flush_block(d, 0)) != 0)
+ return (n < 0) ? MZ_FALSE : MZ_TRUE;
+ total_lz_bytes = d->m_total_lz_bytes;
+ pLZ_code_buf = d->m_pLZ_code_buf;
+ pLZ_flags = d->m_pLZ_flags;
+ num_flags_left = d->m_num_flags_left;
+ }
+ }
+
+ while (lookahead_size)
+ {
+ mz_uint8 lit = d->m_dict[cur_pos];
+
+ total_lz_bytes++;
+ *pLZ_code_buf++ = lit;
+ *pLZ_flags = (mz_uint8)(*pLZ_flags >> 1);
+ if (--num_flags_left == 0)
+ {
+ num_flags_left = 8;
+ pLZ_flags = pLZ_code_buf++;
+ }
+
+ d->m_huff_count[0][lit]++;
+
+ lookahead_pos++;
+ dict_size = MZ_MIN(dict_size + 1, (mz_uint)TDEFL_LZ_DICT_SIZE);
+ cur_pos = (cur_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK;
+ lookahead_size--;
+
+ if (pLZ_code_buf > &d->m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE - 8])
+ {
+ int n;
+ d->m_lookahead_pos = lookahead_pos;
+ d->m_lookahead_size = lookahead_size;
+ d->m_dict_size = dict_size;
+ d->m_total_lz_bytes = total_lz_bytes;
+ d->m_pLZ_code_buf = pLZ_code_buf;
+ d->m_pLZ_flags = pLZ_flags;
+ d->m_num_flags_left = num_flags_left;
+ if ((n = tdefl_flush_block(d, 0)) != 0)
+ return (n < 0) ? MZ_FALSE : MZ_TRUE;
+ total_lz_bytes = d->m_total_lz_bytes;
+ pLZ_code_buf = d->m_pLZ_code_buf;
+ pLZ_flags = d->m_pLZ_flags;
+ num_flags_left = d->m_num_flags_left;
+ }
+ }
+ }
+
+ d->m_lookahead_pos = lookahead_pos;
+ d->m_lookahead_size = lookahead_size;
+ d->m_dict_size = dict_size;
+ d->m_total_lz_bytes = total_lz_bytes;
+ d->m_pLZ_code_buf = pLZ_code_buf;
+ d->m_pLZ_flags = pLZ_flags;
+ d->m_num_flags_left = num_flags_left;
+ return MZ_TRUE;
+}
+#endif /* MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN */
+
+static MZ_FORCEINLINE void tdefl_record_literal(tdefl_compressor *d, mz_uint8 lit)
+{
+ d->m_total_lz_bytes++;
+ *d->m_pLZ_code_buf++ = lit;
+ *d->m_pLZ_flags = (mz_uint8)(*d->m_pLZ_flags >> 1);
+ if (--d->m_num_flags_left == 0)
+ {
+ d->m_num_flags_left = 8;
+ d->m_pLZ_flags = d->m_pLZ_code_buf++;
+ }
+ d->m_huff_count[0][lit]++;
+}
+
+static MZ_FORCEINLINE void tdefl_record_match(tdefl_compressor *d, mz_uint match_len, mz_uint match_dist)
+{
+ mz_uint32 s0, s1;
+
+ MZ_ASSERT((match_len >= TDEFL_MIN_MATCH_LEN) && (match_dist >= 1) && (match_dist <= TDEFL_LZ_DICT_SIZE));
+
+ d->m_total_lz_bytes += match_len;
+
+ d->m_pLZ_code_buf[0] = (mz_uint8)(match_len - TDEFL_MIN_MATCH_LEN);
+
+ match_dist -= 1;
+ d->m_pLZ_code_buf[1] = (mz_uint8)(match_dist & 0xFF);
+ d->m_pLZ_code_buf[2] = (mz_uint8)(match_dist >> 8);
+ d->m_pLZ_code_buf += 3;
+
+ *d->m_pLZ_flags = (mz_uint8)((*d->m_pLZ_flags >> 1) | 0x80);
+ if (--d->m_num_flags_left == 0)
+ {
+ d->m_num_flags_left = 8;
+ d->m_pLZ_flags = d->m_pLZ_code_buf++;
+ }
+
+ s0 = s_tdefl_small_dist_sym[match_dist & 511];
+ s1 = s_tdefl_large_dist_sym[(match_dist >> 8) & 127];
+ d->m_huff_count[1][(match_dist < 512) ? s0 : s1]++;
+ d->m_huff_count[0][s_tdefl_len_sym[match_len - TDEFL_MIN_MATCH_LEN]]++;
+}
+
+static mz_bool tdefl_compress_normal(tdefl_compressor *d)
+{
+ const mz_uint8 *pSrc = d->m_pSrc;
+ size_t src_buf_left = d->m_src_buf_left;
+ tdefl_flush flush = d->m_flush;
+
+ while ((src_buf_left) || ((flush) && (d->m_lookahead_size)))
+ {
+ mz_uint len_to_move, cur_match_dist, cur_match_len, cur_pos;
+ /* Update dictionary and hash chains. Keeps the lookahead size equal to TDEFL_MAX_MATCH_LEN. */
+ if ((d->m_lookahead_size + d->m_dict_size) >= (TDEFL_MIN_MATCH_LEN - 1))
+ {
+ mz_uint dst_pos = (d->m_lookahead_pos + d->m_lookahead_size) & TDEFL_LZ_DICT_SIZE_MASK, ins_pos = d->m_lookahead_pos + d->m_lookahead_size - 2;
+ mz_uint hash = (d->m_dict[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] << TDEFL_LZ_HASH_SHIFT) ^ d->m_dict[(ins_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK];
+ mz_uint num_bytes_to_process = (mz_uint)MZ_MIN(src_buf_left, TDEFL_MAX_MATCH_LEN - d->m_lookahead_size);
+ const mz_uint8 *pSrc_end = pSrc + num_bytes_to_process;
+ src_buf_left -= num_bytes_to_process;
+ d->m_lookahead_size += num_bytes_to_process;
+ while (pSrc != pSrc_end)
+ {
+ mz_uint8 c = *pSrc++;
+ d->m_dict[dst_pos] = c;
+ if (dst_pos < (TDEFL_MAX_MATCH_LEN - 1))
+ d->m_dict[TDEFL_LZ_DICT_SIZE + dst_pos] = c;
+ hash = ((hash << TDEFL_LZ_HASH_SHIFT) ^ c) & (TDEFL_LZ_HASH_SIZE - 1);
+ d->m_next[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] = d->m_hash[hash];
+ d->m_hash[hash] = (mz_uint16)(ins_pos);
+ dst_pos = (dst_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK;
+ ins_pos++;
+ }
+ }
+ else
+ {
+ while ((src_buf_left) && (d->m_lookahead_size < TDEFL_MAX_MATCH_LEN))
+ {
+ mz_uint8 c = *pSrc++;
+ mz_uint dst_pos = (d->m_lookahead_pos + d->m_lookahead_size) & TDEFL_LZ_DICT_SIZE_MASK;
+ src_buf_left--;
+ d->m_dict[dst_pos] = c;
+ if (dst_pos < (TDEFL_MAX_MATCH_LEN - 1))
+ d->m_dict[TDEFL_LZ_DICT_SIZE + dst_pos] = c;
+ if ((++d->m_lookahead_size + d->m_dict_size) >= TDEFL_MIN_MATCH_LEN)
+ {
+ mz_uint ins_pos = d->m_lookahead_pos + (d->m_lookahead_size - 1) - 2;
+ mz_uint hash = ((d->m_dict[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] << (TDEFL_LZ_HASH_SHIFT * 2)) ^ (d->m_dict[(ins_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK] << TDEFL_LZ_HASH_SHIFT) ^ c) & (TDEFL_LZ_HASH_SIZE - 1);
+ d->m_next[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] = d->m_hash[hash];
+ d->m_hash[hash] = (mz_uint16)(ins_pos);
+ }
+ }
+ }
+ d->m_dict_size = MZ_MIN(TDEFL_LZ_DICT_SIZE - d->m_lookahead_size, d->m_dict_size);
+ if ((!flush) && (d->m_lookahead_size < TDEFL_MAX_MATCH_LEN))
+ break;
+
+ /* Simple lazy/greedy parsing state machine. */
+ len_to_move = 1;
+ cur_match_dist = 0;
+ cur_match_len = d->m_saved_match_len ? d->m_saved_match_len : (TDEFL_MIN_MATCH_LEN - 1);
+ cur_pos = d->m_lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK;
+ if (d->m_flags & (TDEFL_RLE_MATCHES | TDEFL_FORCE_ALL_RAW_BLOCKS))
+ {
+ if ((d->m_dict_size) && (!(d->m_flags & TDEFL_FORCE_ALL_RAW_BLOCKS)))
+ {
+ mz_uint8 c = d->m_dict[(cur_pos - 1) & TDEFL_LZ_DICT_SIZE_MASK];
+ cur_match_len = 0;
+ while (cur_match_len < d->m_lookahead_size)
+ {
+ if (d->m_dict[cur_pos + cur_match_len] != c)
+ break;
+ cur_match_len++;
+ }
+ if (cur_match_len < TDEFL_MIN_MATCH_LEN)
+ cur_match_len = 0;
+ else
+ cur_match_dist = 1;
+ }
+ }
+ else
+ {
+ tdefl_find_match(d, d->m_lookahead_pos, d->m_dict_size, d->m_lookahead_size, &cur_match_dist, &cur_match_len);
+ }
+ if (((cur_match_len == TDEFL_MIN_MATCH_LEN) && (cur_match_dist >= 8U * 1024U)) || (cur_pos == cur_match_dist) || ((d->m_flags & TDEFL_FILTER_MATCHES) && (cur_match_len <= 5)))
+ {
+ cur_match_dist = cur_match_len = 0;
+ }
+ if (d->m_saved_match_len)
+ {
+ if (cur_match_len > d->m_saved_match_len)
+ {
+ tdefl_record_literal(d, (mz_uint8)d->m_saved_lit);
+ if (cur_match_len >= 128)
+ {
+ tdefl_record_match(d, cur_match_len, cur_match_dist);
+ d->m_saved_match_len = 0;
+ len_to_move = cur_match_len;
+ }
+ else
+ {
+ d->m_saved_lit = d->m_dict[cur_pos];
+ d->m_saved_match_dist = cur_match_dist;
+ d->m_saved_match_len = cur_match_len;
+ }
+ }
+ else
+ {
+ tdefl_record_match(d, d->m_saved_match_len, d->m_saved_match_dist);
+ len_to_move = d->m_saved_match_len - 1;
+ d->m_saved_match_len = 0;
+ }
+ }
+ else if (!cur_match_dist)
+ tdefl_record_literal(d, d->m_dict[MZ_MIN(cur_pos, sizeof(d->m_dict) - 1)]);
+ else if ((d->m_greedy_parsing) || (d->m_flags & TDEFL_RLE_MATCHES) || (cur_match_len >= 128))
+ {
+ tdefl_record_match(d, cur_match_len, cur_match_dist);
+ len_to_move = cur_match_len;
+ }
+ else
+ {
+ d->m_saved_lit = d->m_dict[MZ_MIN(cur_pos, sizeof(d->m_dict) - 1)];
+ d->m_saved_match_dist = cur_match_dist;
+ d->m_saved_match_len = cur_match_len;
+ }
+ /* Move the lookahead forward by len_to_move bytes. */
+ d->m_lookahead_pos += len_to_move;
+ MZ_ASSERT(d->m_lookahead_size >= len_to_move);
+ d->m_lookahead_size -= len_to_move;
+ d->m_dict_size = MZ_MIN(d->m_dict_size + len_to_move, (mz_uint)TDEFL_LZ_DICT_SIZE);
+ /* Check if it's time to flush the current LZ codes to the internal output buffer. */
+ if ((d->m_pLZ_code_buf > &d->m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE - 8]) ||
+ ((d->m_total_lz_bytes > 31 * 1024) && (((((mz_uint)(d->m_pLZ_code_buf - d->m_lz_code_buf) * 115) >> 7) >= d->m_total_lz_bytes) || (d->m_flags & TDEFL_FORCE_ALL_RAW_BLOCKS))))
+ {
+ int n;
+ d->m_pSrc = pSrc;
+ d->m_src_buf_left = src_buf_left;
+ if ((n = tdefl_flush_block(d, 0)) != 0)
+ return (n < 0) ? MZ_FALSE : MZ_TRUE;
+ }
+ }
+
+ d->m_pSrc = pSrc;
+ d->m_src_buf_left = src_buf_left;
+ return MZ_TRUE;
+}
+
+static tdefl_status tdefl_flush_output_buffer(tdefl_compressor *d)
+{
+ if (d->m_pIn_buf_size)
+ {
+ *d->m_pIn_buf_size = d->m_pSrc - (const mz_uint8 *)d->m_pIn_buf;
+ }
+
+ if (d->m_pOut_buf_size)
+ {
+ size_t n = MZ_MIN(*d->m_pOut_buf_size - d->m_out_buf_ofs, d->m_output_flush_remaining);
+ memcpy((mz_uint8 *)d->m_pOut_buf + d->m_out_buf_ofs, d->m_output_buf + d->m_output_flush_ofs, n);
+ d->m_output_flush_ofs += (mz_uint)n;
+ d->m_output_flush_remaining -= (mz_uint)n;
+ d->m_out_buf_ofs += n;
+
+ *d->m_pOut_buf_size = d->m_out_buf_ofs;
+ }
+
+ return (d->m_finished && !d->m_output_flush_remaining) ? TDEFL_STATUS_DONE : TDEFL_STATUS_OKAY;
+}
+
+tdefl_status tdefl_compress(tdefl_compressor *d, const void *pIn_buf, size_t *pIn_buf_size, void *pOut_buf, size_t *pOut_buf_size, tdefl_flush flush)
+{
+ if (!d)
+ {
+ if (pIn_buf_size)
+ *pIn_buf_size = 0;
+ if (pOut_buf_size)
+ *pOut_buf_size = 0;
+ return TDEFL_STATUS_BAD_PARAM;
+ }
+
+ d->m_pIn_buf = pIn_buf;
+ d->m_pIn_buf_size = pIn_buf_size;
+ d->m_pOut_buf = pOut_buf;
+ d->m_pOut_buf_size = pOut_buf_size;
+ d->m_pSrc = (const mz_uint8 *)(pIn_buf);
+ d->m_src_buf_left = pIn_buf_size ? *pIn_buf_size : 0;
+ d->m_out_buf_ofs = 0;
+ d->m_flush = flush;
+
+ if (((d->m_pPut_buf_func != NULL) == ((pOut_buf != NULL) || (pOut_buf_size != NULL))) || (d->m_prev_return_status != TDEFL_STATUS_OKAY) ||
+ (d->m_wants_to_finish && (flush != TDEFL_FINISH)) || (pIn_buf_size && *pIn_buf_size && !pIn_buf) || (pOut_buf_size && *pOut_buf_size && !pOut_buf))
+ {
+ if (pIn_buf_size)
+ *pIn_buf_size = 0;
+ if (pOut_buf_size)
+ *pOut_buf_size = 0;
+ return (d->m_prev_return_status = TDEFL_STATUS_BAD_PARAM);
+ }
+ d->m_wants_to_finish |= (flush == TDEFL_FINISH);
+
+ if ((d->m_output_flush_remaining) || (d->m_finished))
+ return (d->m_prev_return_status = tdefl_flush_output_buffer(d));
+
+#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN
+ if (((d->m_flags & TDEFL_MAX_PROBES_MASK) == 1) &&
+ ((d->m_flags & TDEFL_GREEDY_PARSING_FLAG) != 0) &&
+ ((d->m_flags & (TDEFL_FILTER_MATCHES | TDEFL_FORCE_ALL_RAW_BLOCKS | TDEFL_RLE_MATCHES)) == 0))
+ {
+ if (!tdefl_compress_fast(d))
+ return d->m_prev_return_status;
+ }
+ else
+#endif /* #if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN */
+ {
+ if (!tdefl_compress_normal(d))
+ return d->m_prev_return_status;
+ }
+
+ if ((d->m_flags & (TDEFL_WRITE_ZLIB_HEADER | TDEFL_COMPUTE_ADLER32)) && (pIn_buf))
+ d->m_adler32 = (mz_uint32)mz_adler32(d->m_adler32, (const mz_uint8 *)pIn_buf, d->m_pSrc - (const mz_uint8 *)pIn_buf);
+
+ if ((flush) && (!d->m_lookahead_size) && (!d->m_src_buf_left) && (!d->m_output_flush_remaining))
+ {
+ if (tdefl_flush_block(d, flush) < 0)
+ return d->m_prev_return_status;
+ d->m_finished = (flush == TDEFL_FINISH);
+ if (flush == TDEFL_FULL_FLUSH)
+ {
+ MZ_CLEAR_OBJ(d->m_hash);
+ MZ_CLEAR_OBJ(d->m_next);
+ d->m_dict_size = 0;
+ }
+ }
+
+ return (d->m_prev_return_status = tdefl_flush_output_buffer(d));
+}
+
+tdefl_status tdefl_compress_buffer(tdefl_compressor *d, const void *pIn_buf, size_t in_buf_size, tdefl_flush flush)
+{
+ MZ_ASSERT(d->m_pPut_buf_func);
+ return tdefl_compress(d, pIn_buf, &in_buf_size, NULL, NULL, flush);
+}
+
+tdefl_status tdefl_init(tdefl_compressor *d, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags)
+{
+ d->m_pPut_buf_func = pPut_buf_func;
+ d->m_pPut_buf_user = pPut_buf_user;
+ d->m_flags = (mz_uint)(flags);
+ d->m_max_probes[0] = 1 + ((flags & 0xFFF) + 2) / 3;
+ d->m_greedy_parsing = (flags & TDEFL_GREEDY_PARSING_FLAG) != 0;
+ d->m_max_probes[1] = 1 + (((flags & 0xFFF) >> 2) + 2) / 3;
+ if (!(flags & TDEFL_NONDETERMINISTIC_PARSING_FLAG))
+ MZ_CLEAR_OBJ(d->m_hash);
+ d->m_lookahead_pos = d->m_lookahead_size = d->m_dict_size = d->m_total_lz_bytes = d->m_lz_code_buf_dict_pos = d->m_bits_in = 0;
+ d->m_output_flush_ofs = d->m_output_flush_remaining = d->m_finished = d->m_block_index = d->m_bit_buffer = d->m_wants_to_finish = 0;
+ d->m_pLZ_code_buf = d->m_lz_code_buf + 1;
+ d->m_pLZ_flags = d->m_lz_code_buf;
+ *d->m_pLZ_flags = 0;
+ d->m_num_flags_left = 8;
+ d->m_pOutput_buf = d->m_output_buf;
+ d->m_pOutput_buf_end = d->m_output_buf;
+ d->m_prev_return_status = TDEFL_STATUS_OKAY;
+ d->m_saved_match_dist = d->m_saved_match_len = d->m_saved_lit = 0;
+ d->m_adler32 = 1;
+ d->m_pIn_buf = NULL;
+ d->m_pOut_buf = NULL;
+ d->m_pIn_buf_size = NULL;
+ d->m_pOut_buf_size = NULL;
+ d->m_flush = TDEFL_NO_FLUSH;
+ d->m_pSrc = NULL;
+ d->m_src_buf_left = 0;
+ d->m_out_buf_ofs = 0;
+ if (!(flags & TDEFL_NONDETERMINISTIC_PARSING_FLAG))
+ MZ_CLEAR_OBJ(d->m_dict);
+ memset(&d->m_huff_count[0][0], 0, sizeof(d->m_huff_count[0][0]) * TDEFL_MAX_HUFF_SYMBOLS_0);
+ memset(&d->m_huff_count[1][0], 0, sizeof(d->m_huff_count[1][0]) * TDEFL_MAX_HUFF_SYMBOLS_1);
+ return TDEFL_STATUS_OKAY;
+}
+
+tdefl_status tdefl_get_prev_return_status(tdefl_compressor *d)
+{
+ return d->m_prev_return_status;
+}
+
+mz_uint32 tdefl_get_adler32(tdefl_compressor *d)
+{
+ return d->m_adler32;
+}
+
+mz_bool tdefl_compress_mem_to_output(const void *pBuf, size_t buf_len, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags)
+{
+ tdefl_compressor *pComp;
+ mz_bool succeeded;
+ if (((buf_len) && (!pBuf)) || (!pPut_buf_func))
+ return MZ_FALSE;
+ pComp = (tdefl_compressor *)MZ_MALLOC(sizeof(tdefl_compressor));
+ if (!pComp)
+ return MZ_FALSE;
+ succeeded = (tdefl_init(pComp, pPut_buf_func, pPut_buf_user, flags) == TDEFL_STATUS_OKAY);
+ succeeded = succeeded && (tdefl_compress_buffer(pComp, pBuf, buf_len, TDEFL_FINISH) == TDEFL_STATUS_DONE);
+ MZ_FREE(pComp);
+ return succeeded;
+}
+
+typedef struct
+{
+ size_t m_size, m_capacity;
+ mz_uint8 *m_pBuf;
+ mz_bool m_expandable;
+} tdefl_output_buffer;
+
+static mz_bool tdefl_output_buffer_putter(const void *pBuf, int len, void *pUser)
+{
+ tdefl_output_buffer *p = (tdefl_output_buffer *)pUser;
+ size_t new_size = p->m_size + len;
+ if (new_size > p->m_capacity)
+ {
+ size_t new_capacity = p->m_capacity;
+ mz_uint8 *pNew_buf;
+ if (!p->m_expandable)
+ return MZ_FALSE;
+ do
+ {
+ new_capacity = MZ_MAX(128U, new_capacity << 1U);
+ } while (new_size > new_capacity);
+ pNew_buf = (mz_uint8 *)MZ_REALLOC(p->m_pBuf, new_capacity);
+ if (!pNew_buf)
+ return MZ_FALSE;
+ p->m_pBuf = pNew_buf;
+ p->m_capacity = new_capacity;
+ }
+ memcpy((mz_uint8 *)p->m_pBuf + p->m_size, pBuf, len);
+ p->m_size = new_size;
+ return MZ_TRUE;
+}
+
+void *tdefl_compress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags)
+{
+ tdefl_output_buffer out_buf;
+ MZ_CLEAR_OBJ(out_buf);
+ if (!pOut_len)
+ return MZ_FALSE;
+ else
+ *pOut_len = 0;
+ out_buf.m_expandable = MZ_TRUE;
+ if (!tdefl_compress_mem_to_output(pSrc_buf, src_buf_len, tdefl_output_buffer_putter, &out_buf, flags))
+ return NULL;
+ *pOut_len = out_buf.m_size;
+ return out_buf.m_pBuf;
+}
+
+size_t tdefl_compress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags)
+{
+ tdefl_output_buffer out_buf;
+ MZ_CLEAR_OBJ(out_buf);
+ if (!pOut_buf)
+ return 0;
+ out_buf.m_pBuf = (mz_uint8 *)pOut_buf;
+ out_buf.m_capacity = out_buf_len;
+ if (!tdefl_compress_mem_to_output(pSrc_buf, src_buf_len, tdefl_output_buffer_putter, &out_buf, flags))
+ return 0;
+ return out_buf.m_size;
+}
+
+static const mz_uint s_tdefl_num_probes[11] = { 0, 1, 6, 32, 16, 32, 128, 256, 512, 768, 1500 };
+
+/* level may actually range from [0,10] (10 is a "hidden" max level, where we want a bit more compression and it's fine if throughput to fall off a cliff on some files). */
+mz_uint tdefl_create_comp_flags_from_zip_params(int level, int window_bits, int strategy)
+{
+ mz_uint comp_flags = s_tdefl_num_probes[(level >= 0) ? MZ_MIN(10, level) : MZ_DEFAULT_LEVEL] | ((level <= 3) ? TDEFL_GREEDY_PARSING_FLAG : 0);
+ if (window_bits > 0)
+ comp_flags |= TDEFL_WRITE_ZLIB_HEADER;
+
+ if (!level)
+ comp_flags |= TDEFL_FORCE_ALL_RAW_BLOCKS;
+ else if (strategy == MZ_FILTERED)
+ comp_flags |= TDEFL_FILTER_MATCHES;
+ else if (strategy == MZ_HUFFMAN_ONLY)
+ comp_flags &= ~TDEFL_MAX_PROBES_MASK;
+ else if (strategy == MZ_FIXED)
+ comp_flags |= TDEFL_FORCE_ALL_STATIC_BLOCKS;
+ else if (strategy == MZ_RLE)
+ comp_flags |= TDEFL_RLE_MATCHES;
+
+ return comp_flags;
+}
+
+#ifdef _MSC_VER
+#pragma warning(push)
+#pragma warning(disable : 4204) /* nonstandard extension used : non-constant aggregate initializer (also supported by GNU C and C99, so no big deal) */
+#endif
+
+/* Simple PNG writer function by Alex Evans, 2011. Released into the public domain: https://gist.github.com/908299, more context at
+ http://altdevblogaday.org/2011/04/06/a-smaller-jpg-encoder/.
+ This is actually a modification of Alex's original code so PNG files generated by this function pass pngcheck. */
+void *tdefl_write_image_to_png_file_in_memory_ex(const void *pImage, int w, int h, int num_chans, size_t *pLen_out, mz_uint level, mz_bool flip)
+{
+ /* Using a local copy of this array here in case MINIZ_NO_ZLIB_APIS was defined. */
+ static const mz_uint s_tdefl_png_num_probes[11] = { 0, 1, 6, 32, 16, 32, 128, 256, 512, 768, 1500 };
+ tdefl_compressor *pComp = (tdefl_compressor *)MZ_MALLOC(sizeof(tdefl_compressor));
+ tdefl_output_buffer out_buf;
+ int i, bpl = w * num_chans, y, z;
+ mz_uint32 c;
+ *pLen_out = 0;
+ if (!pComp)
+ return NULL;
+ MZ_CLEAR_OBJ(out_buf);
+ out_buf.m_expandable = MZ_TRUE;
+ out_buf.m_capacity = 57 + MZ_MAX(64, (1 + bpl) * h);
+ if (NULL == (out_buf.m_pBuf = (mz_uint8 *)MZ_MALLOC(out_buf.m_capacity)))
+ {
+ MZ_FREE(pComp);
+ return NULL;
+ }
+ /* write dummy header */
+ for (z = 41; z; --z)
+ tdefl_output_buffer_putter(&z, 1, &out_buf);
+ /* compress image data */
+ tdefl_init(pComp, tdefl_output_buffer_putter, &out_buf, s_tdefl_png_num_probes[MZ_MIN(10, level)] | TDEFL_WRITE_ZLIB_HEADER);
+ for (y = 0; y < h; ++y)
+ {
+ tdefl_compress_buffer(pComp, &z, 1, TDEFL_NO_FLUSH);
+ tdefl_compress_buffer(pComp, (mz_uint8 *)pImage + (flip ? (h - 1 - y) : y) * bpl, bpl, TDEFL_NO_FLUSH);
+ }
+ if (tdefl_compress_buffer(pComp, NULL, 0, TDEFL_FINISH) != TDEFL_STATUS_DONE)
+ {
+ MZ_FREE(pComp);
+ MZ_FREE(out_buf.m_pBuf);
+ return NULL;
+ }
+ /* write real header */
+ *pLen_out = out_buf.m_size - 41;
+ {
+ static const mz_uint8 chans[] = { 0x00, 0x00, 0x04, 0x02, 0x06 };
+ mz_uint8 pnghdr[41] = { 0x89, 0x50, 0x4e, 0x47, 0x0d,
+ 0x0a, 0x1a, 0x0a, 0x00, 0x00,
+ 0x00, 0x0d, 0x49, 0x48, 0x44,
+ 0x52, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x08,
+ 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x49, 0x44, 0x41,
+ 0x54 };
+ pnghdr[18] = (mz_uint8)(w >> 8);
+ pnghdr[19] = (mz_uint8)w;
+ pnghdr[22] = (mz_uint8)(h >> 8);
+ pnghdr[23] = (mz_uint8)h;
+ pnghdr[25] = chans[num_chans];
+ pnghdr[33] = (mz_uint8)(*pLen_out >> 24);
+ pnghdr[34] = (mz_uint8)(*pLen_out >> 16);
+ pnghdr[35] = (mz_uint8)(*pLen_out >> 8);
+ pnghdr[36] = (mz_uint8)*pLen_out;
+ c = (mz_uint32)mz_crc32(MZ_CRC32_INIT, pnghdr + 12, 17);
+ for (i = 0; i < 4; ++i, c <<= 8)
+ ((mz_uint8 *)(pnghdr + 29))[i] = (mz_uint8)(c >> 24);
+ memcpy(out_buf.m_pBuf, pnghdr, 41);
+ }
+ /* write footer (IDAT CRC-32, followed by IEND chunk) */
+ if (!tdefl_output_buffer_putter("\0\0\0\0\0\0\0\0\x49\x45\x4e\x44\xae\x42\x60\x82", 16, &out_buf))
+ {
+ *pLen_out = 0;
+ MZ_FREE(pComp);
+ MZ_FREE(out_buf.m_pBuf);
+ return NULL;
+ }
+ c = (mz_uint32)mz_crc32(MZ_CRC32_INIT, out_buf.m_pBuf + 41 - 4, *pLen_out + 4);
+ for (i = 0; i < 4; ++i, c <<= 8)
+ (out_buf.m_pBuf + out_buf.m_size - 16)[i] = (mz_uint8)(c >> 24);
+ /* compute final size of file, grab compressed data buffer and return */
+ *pLen_out += 57;
+ MZ_FREE(pComp);
+ return out_buf.m_pBuf;
+}
+void *tdefl_write_image_to_png_file_in_memory(const void *pImage, int w, int h, int num_chans, size_t *pLen_out)
+{
+ /* Level 6 corresponds to TDEFL_DEFAULT_MAX_PROBES or MZ_DEFAULT_LEVEL (but we can't depend on MZ_DEFAULT_LEVEL being available in case the zlib API's where #defined out) */
+ return tdefl_write_image_to_png_file_in_memory_ex(pImage, w, h, num_chans, pLen_out, 6, MZ_FALSE);
+}
+
+#ifndef MINIZ_NO_MALLOC
+/* Allocate the tdefl_compressor and tinfl_decompressor structures in C so that */
+/* non-C language bindings to tdefL_ and tinfl_ API don't need to worry about */
+/* structure size and allocation mechanism. */
+tdefl_compressor *tdefl_compressor_alloc()
+{
+ return (tdefl_compressor *)MZ_MALLOC(sizeof(tdefl_compressor));
+}
+
+void tdefl_compressor_free(tdefl_compressor *pComp)
+{
+ MZ_FREE(pComp);
+}
+#endif
+
+#ifdef _MSC_VER
+#pragma warning(pop)
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+ /**************************************************************************
+ *
+ * Copyright 2013-2014 RAD Game Tools and Valve Software
+ * Copyright 2010-2014 Rich Geldreich and Tenacious Software LLC
+ * 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.
+ *
+ **************************************************************************/
+
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* ------------------- Low-level Decompression (completely independent from all compression API's) */
+
+#define TINFL_MEMCPY(d, s, l) memcpy(d, s, l)
+#define TINFL_MEMSET(p, c, l) memset(p, c, l)
+
+#define TINFL_CR_BEGIN \
+ switch (r->m_state) \
+ { \
+ case 0:
+#define TINFL_CR_RETURN(state_index, result) \
+ do \
+ { \
+ status = result; \
+ r->m_state = state_index; \
+ goto common_exit; \
+ case state_index:; \
+ } \
+ MZ_MACRO_END
+#define TINFL_CR_RETURN_FOREVER(state_index, result) \
+ do \
+ { \
+ for (;;) \
+ { \
+ TINFL_CR_RETURN(state_index, result); \
+ } \
+ } \
+ MZ_MACRO_END
+#define TINFL_CR_FINISH }
+
+#define TINFL_GET_BYTE(state_index, c) \
+ do \
+ { \
+ while (pIn_buf_cur >= pIn_buf_end) \
+ { \
+ TINFL_CR_RETURN(state_index, (decomp_flags & TINFL_FLAG_HAS_MORE_INPUT) ? TINFL_STATUS_NEEDS_MORE_INPUT : TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS); \
+ } \
+ c = *pIn_buf_cur++; \
+ } \
+ MZ_MACRO_END
+
+#define TINFL_NEED_BITS(state_index, n) \
+ do \
+ { \
+ mz_uint c; \
+ TINFL_GET_BYTE(state_index, c); \
+ bit_buf |= (((tinfl_bit_buf_t)c) << num_bits); \
+ num_bits += 8; \
+ } while (num_bits < (mz_uint)(n))
+#define TINFL_SKIP_BITS(state_index, n) \
+ do \
+ { \
+ if (num_bits < (mz_uint)(n)) \
+ { \
+ TINFL_NEED_BITS(state_index, n); \
+ } \
+ bit_buf >>= (n); \
+ num_bits -= (n); \
+ } \
+ MZ_MACRO_END
+#define TINFL_GET_BITS(state_index, b, n) \
+ do \
+ { \
+ if (num_bits < (mz_uint)(n)) \
+ { \
+ TINFL_NEED_BITS(state_index, n); \
+ } \
+ b = bit_buf & ((1 << (n)) - 1); \
+ bit_buf >>= (n); \
+ num_bits -= (n); \
+ } \
+ MZ_MACRO_END
+
+/* TINFL_HUFF_BITBUF_FILL() is only used rarely, when the number of bytes remaining in the input buffer falls below 2. */
+/* It reads just enough bytes from the input stream that are needed to decode the next Huffman code (and absolutely no more). It works by trying to fully decode a */
+/* Huffman code by using whatever bits are currently present in the bit buffer. If this fails, it reads another byte, and tries again until it succeeds or until the */
+/* bit buffer contains >=15 bits (deflate's max. Huffman code size). */
+#define TINFL_HUFF_BITBUF_FILL(state_index, pHuff) \
+ do \
+ { \
+ temp = (pHuff)->m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]; \
+ if (temp >= 0) \
+ { \
+ code_len = temp >> 9; \
+ if ((code_len) && (num_bits >= code_len)) \
+ break; \
+ } \
+ else if (num_bits > TINFL_FAST_LOOKUP_BITS) \
+ { \
+ code_len = TINFL_FAST_LOOKUP_BITS; \
+ do \
+ { \
+ temp = (pHuff)->m_tree[~temp + ((bit_buf >> code_len++) & 1)]; \
+ } while ((temp < 0) && (num_bits >= (code_len + 1))); \
+ if (temp >= 0) \
+ break; \
+ } \
+ TINFL_GET_BYTE(state_index, c); \
+ bit_buf |= (((tinfl_bit_buf_t)c) << num_bits); \
+ num_bits += 8; \
+ } while (num_bits < 15);
+
+/* TINFL_HUFF_DECODE() decodes the next Huffman coded symbol. It's more complex than you would initially expect because the zlib API expects the decompressor to never read */
+/* beyond the final byte of the deflate stream. (In other words, when this macro wants to read another byte from the input, it REALLY needs another byte in order to fully */
+/* decode the next Huffman code.) Handling this properly is particularly important on raw deflate (non-zlib) streams, which aren't followed by a byte aligned adler-32. */
+/* The slow path is only executed at the very end of the input buffer. */
+/* v1.16: The original macro handled the case at the very end of the passed-in input buffer, but we also need to handle the case where the user passes in 1+zillion bytes */
+/* following the deflate data and our non-conservative read-ahead path won't kick in here on this code. This is much trickier. */
+#define TINFL_HUFF_DECODE(state_index, sym, pHuff) \
+ do \
+ { \
+ int temp; \
+ mz_uint code_len, c; \
+ if (num_bits < 15) \
+ { \
+ if ((pIn_buf_end - pIn_buf_cur) < 2) \
+ { \
+ TINFL_HUFF_BITBUF_FILL(state_index, pHuff); \
+ } \
+ else \
+ { \
+ bit_buf |= (((tinfl_bit_buf_t)pIn_buf_cur[0]) << num_bits) | (((tinfl_bit_buf_t)pIn_buf_cur[1]) << (num_bits + 8)); \
+ pIn_buf_cur += 2; \
+ num_bits += 16; \
+ } \
+ } \
+ if ((temp = (pHuff)->m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]) >= 0) \
+ code_len = temp >> 9, temp &= 511; \
+ else \
+ { \
+ code_len = TINFL_FAST_LOOKUP_BITS; \
+ do \
+ { \
+ temp = (pHuff)->m_tree[~temp + ((bit_buf >> code_len++) & 1)]; \
+ } while (temp < 0); \
+ } \
+ sym = temp; \
+ bit_buf >>= code_len; \
+ num_bits -= code_len; \
+ } \
+ MZ_MACRO_END
+
+tinfl_status tinfl_decompress(tinfl_decompressor *r, const mz_uint8 *pIn_buf_next, size_t *pIn_buf_size, mz_uint8 *pOut_buf_start, mz_uint8 *pOut_buf_next, size_t *pOut_buf_size, const mz_uint32 decomp_flags)
+{
+ static const int s_length_base[31] = { 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0 };
+ static const int s_length_extra[31] = { 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, 0, 0 };
+ static const int s_dist_base[32] = { 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289, 16385, 24577, 0, 0 };
+ static const int s_dist_extra[32] = { 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13 };
+ static const mz_uint8 s_length_dezigzag[19] = { 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 };
+ static const int s_min_table_sizes[3] = { 257, 1, 4 };
+
+ tinfl_status status = TINFL_STATUS_FAILED;
+ mz_uint32 num_bits, dist, counter, num_extra;
+ tinfl_bit_buf_t bit_buf;
+ const mz_uint8 *pIn_buf_cur = pIn_buf_next, *const pIn_buf_end = pIn_buf_next + *pIn_buf_size;
+ mz_uint8 *pOut_buf_cur = pOut_buf_next, *const pOut_buf_end = pOut_buf_next + *pOut_buf_size;
+ size_t out_buf_size_mask = (decomp_flags & TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF) ? (size_t)-1 : ((pOut_buf_next - pOut_buf_start) + *pOut_buf_size) - 1, dist_from_out_buf_start;
+
+ /* Ensure the output buffer's size is a power of 2, unless the output buffer is large enough to hold the entire output file (in which case it doesn't matter). */
+ if (((out_buf_size_mask + 1) & out_buf_size_mask) || (pOut_buf_next < pOut_buf_start))
+ {
+ *pIn_buf_size = *pOut_buf_size = 0;
+ return TINFL_STATUS_BAD_PARAM;
+ }
+
+ num_bits = r->m_num_bits;
+ bit_buf = r->m_bit_buf;
+ dist = r->m_dist;
+ counter = r->m_counter;
+ num_extra = r->m_num_extra;
+ dist_from_out_buf_start = r->m_dist_from_out_buf_start;
+ TINFL_CR_BEGIN
+
+ bit_buf = num_bits = dist = counter = num_extra = r->m_zhdr0 = r->m_zhdr1 = 0;
+ r->m_z_adler32 = r->m_check_adler32 = 1;
+ if (decomp_flags & TINFL_FLAG_PARSE_ZLIB_HEADER)
+ {
+ TINFL_GET_BYTE(1, r->m_zhdr0);
+ TINFL_GET_BYTE(2, r->m_zhdr1);
+ counter = (((r->m_zhdr0 * 256 + r->m_zhdr1) % 31 != 0) || (r->m_zhdr1 & 32) || ((r->m_zhdr0 & 15) != 8));
+ if (!(decomp_flags & TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF))
+ counter |= (((1U << (8U + (r->m_zhdr0 >> 4))) > 32768U) || ((out_buf_size_mask + 1) < (size_t)(1U << (8U + (r->m_zhdr0 >> 4)))));
+ if (counter)
+ {
+ TINFL_CR_RETURN_FOREVER(36, TINFL_STATUS_FAILED);
+ }
+ }
+
+ do
+ {
+ TINFL_GET_BITS(3, r->m_final, 3);
+ r->m_type = r->m_final >> 1;
+ if (r->m_type == 0)
+ {
+ TINFL_SKIP_BITS(5, num_bits & 7);
+ for (counter = 0; counter < 4; ++counter)
+ {
+ if (num_bits)
+ TINFL_GET_BITS(6, r->m_raw_header[counter], 8);
+ else
+ TINFL_GET_BYTE(7, r->m_raw_header[counter]);
+ }
+ if ((counter = (r->m_raw_header[0] | (r->m_raw_header[1] << 8))) != (mz_uint)(0xFFFF ^ (r->m_raw_header[2] | (r->m_raw_header[3] << 8))))
+ {
+ TINFL_CR_RETURN_FOREVER(39, TINFL_STATUS_FAILED);
+ }
+ while ((counter) && (num_bits))
+ {
+ TINFL_GET_BITS(51, dist, 8);
+ while (pOut_buf_cur >= pOut_buf_end)
+ {
+ TINFL_CR_RETURN(52, TINFL_STATUS_HAS_MORE_OUTPUT);
+ }
+ *pOut_buf_cur++ = (mz_uint8)dist;
+ counter--;
+ }
+ while (counter)
+ {
+ size_t n;
+ while (pOut_buf_cur >= pOut_buf_end)
+ {
+ TINFL_CR_RETURN(9, TINFL_STATUS_HAS_MORE_OUTPUT);
+ }
+ while (pIn_buf_cur >= pIn_buf_end)
+ {
+ TINFL_CR_RETURN(38, (decomp_flags & TINFL_FLAG_HAS_MORE_INPUT) ? TINFL_STATUS_NEEDS_MORE_INPUT : TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS);
+ }
+ n = MZ_MIN(MZ_MIN((size_t)(pOut_buf_end - pOut_buf_cur), (size_t)(pIn_buf_end - pIn_buf_cur)), counter);
+ TINFL_MEMCPY(pOut_buf_cur, pIn_buf_cur, n);
+ pIn_buf_cur += n;
+ pOut_buf_cur += n;
+ counter -= (mz_uint)n;
+ }
+ }
+ else if (r->m_type == 3)
+ {
+ TINFL_CR_RETURN_FOREVER(10, TINFL_STATUS_FAILED);
+ }
+ else
+ {
+ if (r->m_type == 1)
+ {
+ mz_uint8 *p = r->m_tables[0].m_code_size;
+ mz_uint i;
+ r->m_table_sizes[0] = 288;
+ r->m_table_sizes[1] = 32;
+ TINFL_MEMSET(r->m_tables[1].m_code_size, 5, 32);
+ for (i = 0; i <= 143; ++i)
+ *p++ = 8;
+ for (; i <= 255; ++i)
+ *p++ = 9;
+ for (; i <= 279; ++i)
+ *p++ = 7;
+ for (; i <= 287; ++i)
+ *p++ = 8;
+ }
+ else
+ {
+ for (counter = 0; counter < 3; counter++)
+ {
+ TINFL_GET_BITS(11, r->m_table_sizes[counter], "\05\05\04"[counter]);
+ r->m_table_sizes[counter] += s_min_table_sizes[counter];
+ }
+ MZ_CLEAR_OBJ(r->m_tables[2].m_code_size);
+ for (counter = 0; counter < r->m_table_sizes[2]; counter++)
+ {
+ mz_uint s;
+ TINFL_GET_BITS(14, s, 3);
+ r->m_tables[2].m_code_size[s_length_dezigzag[counter]] = (mz_uint8)s;
+ }
+ r->m_table_sizes[2] = 19;
+ }
+ for (; (int)r->m_type >= 0; r->m_type--)
+ {
+ int tree_next, tree_cur;
+ tinfl_huff_table *pTable;
+ mz_uint i, j, used_syms, total, sym_index, next_code[17], total_syms[16];
+ pTable = &r->m_tables[r->m_type];
+ MZ_CLEAR_OBJ(total_syms);
+ MZ_CLEAR_OBJ(pTable->m_look_up);
+ MZ_CLEAR_OBJ(pTable->m_tree);
+ for (i = 0; i < r->m_table_sizes[r->m_type]; ++i)
+ total_syms[pTable->m_code_size[i]]++;
+ used_syms = 0, total = 0;
+ next_code[0] = next_code[1] = 0;
+ for (i = 1; i <= 15; ++i)
+ {
+ used_syms += total_syms[i];
+ next_code[i + 1] = (total = ((total + total_syms[i]) << 1));
+ }
+ if ((65536 != total) && (used_syms > 1))
+ {
+ TINFL_CR_RETURN_FOREVER(35, TINFL_STATUS_FAILED);
+ }
+ for (tree_next = -1, sym_index = 0; sym_index < r->m_table_sizes[r->m_type]; ++sym_index)
+ {
+ mz_uint rev_code = 0, l, cur_code, code_size = pTable->m_code_size[sym_index];
+ if (!code_size)
+ continue;
+ cur_code = next_code[code_size]++;
+ for (l = code_size; l > 0; l--, cur_code >>= 1)
+ rev_code = (rev_code << 1) | (cur_code & 1);
+ if (code_size <= TINFL_FAST_LOOKUP_BITS)
+ {
+ mz_int16 k = (mz_int16)((code_size << 9) | sym_index);
+ while (rev_code < TINFL_FAST_LOOKUP_SIZE)
+ {
+ pTable->m_look_up[rev_code] = k;
+ rev_code += (1 << code_size);
+ }
+ continue;
+ }
+ if (0 == (tree_cur = pTable->m_look_up[rev_code & (TINFL_FAST_LOOKUP_SIZE - 1)]))
+ {
+ pTable->m_look_up[rev_code & (TINFL_FAST_LOOKUP_SIZE - 1)] = (mz_int16)tree_next;
+ tree_cur = tree_next;
+ tree_next -= 2;
+ }
+ rev_code >>= (TINFL_FAST_LOOKUP_BITS - 1);
+ for (j = code_size; j > (TINFL_FAST_LOOKUP_BITS + 1); j--)
+ {
+ tree_cur -= ((rev_code >>= 1) & 1);
+ if (!pTable->m_tree[-tree_cur - 1])
+ {
+ pTable->m_tree[-tree_cur - 1] = (mz_int16)tree_next;
+ tree_cur = tree_next;
+ tree_next -= 2;
+ }
+ else
+ tree_cur = pTable->m_tree[-tree_cur - 1];
+ }
+ tree_cur -= ((rev_code >>= 1) & 1);
+ pTable->m_tree[-tree_cur - 1] = (mz_int16)sym_index;
+ }
+ if (r->m_type == 2)
+ {
+ for (counter = 0; counter < (r->m_table_sizes[0] + r->m_table_sizes[1]);)
+ {
+ mz_uint s;
+ TINFL_HUFF_DECODE(16, dist, &r->m_tables[2]);
+ if (dist < 16)
+ {
+ r->m_len_codes[counter++] = (mz_uint8)dist;
+ continue;
+ }
+ if ((dist == 16) && (!counter))
+ {
+ TINFL_CR_RETURN_FOREVER(17, TINFL_STATUS_FAILED);
+ }
+ num_extra = "\02\03\07"[dist - 16];
+ TINFL_GET_BITS(18, s, num_extra);
+ s += "\03\03\013"[dist - 16];
+ TINFL_MEMSET(r->m_len_codes + counter, (dist == 16) ? r->m_len_codes[counter - 1] : 0, s);
+ counter += s;
+ }
+ if ((r->m_table_sizes[0] + r->m_table_sizes[1]) != counter)
+ {
+ TINFL_CR_RETURN_FOREVER(21, TINFL_STATUS_FAILED);
+ }
+ TINFL_MEMCPY(r->m_tables[0].m_code_size, r->m_len_codes, r->m_table_sizes[0]);
+ TINFL_MEMCPY(r->m_tables[1].m_code_size, r->m_len_codes + r->m_table_sizes[0], r->m_table_sizes[1]);
+ }
+ }
+ for (;;)
+ {
+ mz_uint8 *pSrc;
+ for (;;)
+ {
+ if (((pIn_buf_end - pIn_buf_cur) < 4) || ((pOut_buf_end - pOut_buf_cur) < 2))
+ {
+ TINFL_HUFF_DECODE(23, counter, &r->m_tables[0]);
+ if (counter >= 256)
+ break;
+ while (pOut_buf_cur >= pOut_buf_end)
+ {
+ TINFL_CR_RETURN(24, TINFL_STATUS_HAS_MORE_OUTPUT);
+ }
+ *pOut_buf_cur++ = (mz_uint8)counter;
+ }
+ else
+ {
+ int sym2;
+ mz_uint code_len;
+#if TINFL_USE_64BIT_BITBUF
+ if (num_bits < 30)
+ {
+ bit_buf |= (((tinfl_bit_buf_t)MZ_READ_LE32(pIn_buf_cur)) << num_bits);
+ pIn_buf_cur += 4;
+ num_bits += 32;
+ }
+#else
+ if (num_bits < 15)
+ {
+ bit_buf |= (((tinfl_bit_buf_t)MZ_READ_LE16(pIn_buf_cur)) << num_bits);
+ pIn_buf_cur += 2;
+ num_bits += 16;
+ }
+#endif
+ if ((sym2 = r->m_tables[0].m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]) >= 0)
+ code_len = sym2 >> 9;
+ else
+ {
+ code_len = TINFL_FAST_LOOKUP_BITS;
+ do
+ {
+ sym2 = r->m_tables[0].m_tree[~sym2 + ((bit_buf >> code_len++) & 1)];
+ } while (sym2 < 0);
+ }
+ counter = sym2;
+ bit_buf >>= code_len;
+ num_bits -= code_len;
+ if (counter & 256)
+ break;
+
+#if !TINFL_USE_64BIT_BITBUF
+ if (num_bits < 15)
+ {
+ bit_buf |= (((tinfl_bit_buf_t)MZ_READ_LE16(pIn_buf_cur)) << num_bits);
+ pIn_buf_cur += 2;
+ num_bits += 16;
+ }
+#endif
+ if ((sym2 = r->m_tables[0].m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]) >= 0)
+ code_len = sym2 >> 9;
+ else
+ {
+ code_len = TINFL_FAST_LOOKUP_BITS;
+ do
+ {
+ sym2 = r->m_tables[0].m_tree[~sym2 + ((bit_buf >> code_len++) & 1)];
+ } while (sym2 < 0);
+ }
+ bit_buf >>= code_len;
+ num_bits -= code_len;
+
+ pOut_buf_cur[0] = (mz_uint8)counter;
+ if (sym2 & 256)
+ {
+ pOut_buf_cur++;
+ counter = sym2;
+ break;
+ }
+ pOut_buf_cur[1] = (mz_uint8)sym2;
+ pOut_buf_cur += 2;
+ }
+ }
+ if ((counter &= 511) == 256)
+ break;
+
+ num_extra = s_length_extra[counter - 257];
+ counter = s_length_base[counter - 257];
+ if (num_extra)
+ {
+ mz_uint extra_bits;
+ TINFL_GET_BITS(25, extra_bits, num_extra);
+ counter += extra_bits;
+ }
+
+ TINFL_HUFF_DECODE(26, dist, &r->m_tables[1]);
+ num_extra = s_dist_extra[dist];
+ dist = s_dist_base[dist];
+ if (num_extra)
+ {
+ mz_uint extra_bits;
+ TINFL_GET_BITS(27, extra_bits, num_extra);
+ dist += extra_bits;
+ }
+
+ dist_from_out_buf_start = pOut_buf_cur - pOut_buf_start;
+ if ((dist == 0 || dist > dist_from_out_buf_start || dist_from_out_buf_start == 0) && (decomp_flags & TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF))
+ {
+ TINFL_CR_RETURN_FOREVER(37, TINFL_STATUS_FAILED);
+ }
+
+ pSrc = pOut_buf_start + ((dist_from_out_buf_start - dist) & out_buf_size_mask);
+
+ if ((MZ_MAX(pOut_buf_cur, pSrc) + counter) > pOut_buf_end)
+ {
+ while (counter--)
+ {
+ while (pOut_buf_cur >= pOut_buf_end)
+ {
+ TINFL_CR_RETURN(53, TINFL_STATUS_HAS_MORE_OUTPUT);
+ }
+ *pOut_buf_cur++ = pOut_buf_start[(dist_from_out_buf_start++ - dist) & out_buf_size_mask];
+ }
+ continue;
+ }
+#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES
+ else if ((counter >= 9) && (counter <= dist))
+ {
+ const mz_uint8 *pSrc_end = pSrc + (counter & ~7);
+ do
+ {
+#ifdef MINIZ_UNALIGNED_USE_MEMCPY
+ memcpy(pOut_buf_cur, pSrc, sizeof(mz_uint32)*2);
+#else
+ ((mz_uint32 *)pOut_buf_cur)[0] = ((const mz_uint32 *)pSrc)[0];
+ ((mz_uint32 *)pOut_buf_cur)[1] = ((const mz_uint32 *)pSrc)[1];
+#endif
+ pOut_buf_cur += 8;
+ } while ((pSrc += 8) < pSrc_end);
+ if ((counter &= 7) < 3)
+ {
+ if (counter)
+ {
+ pOut_buf_cur[0] = pSrc[0];
+ if (counter > 1)
+ pOut_buf_cur[1] = pSrc[1];
+ pOut_buf_cur += counter;
+ }
+ continue;
+ }
+ }
+#endif
+ while(counter>2)
+ {
+ pOut_buf_cur[0] = pSrc[0];
+ pOut_buf_cur[1] = pSrc[1];
+ pOut_buf_cur[2] = pSrc[2];
+ pOut_buf_cur += 3;
+ pSrc += 3;
+ counter -= 3;
+ }
+ if (counter > 0)
+ {
+ pOut_buf_cur[0] = pSrc[0];
+ if (counter > 1)
+ pOut_buf_cur[1] = pSrc[1];
+ pOut_buf_cur += counter;
+ }
+ }
+ }
+ } while (!(r->m_final & 1));
+
+ /* Ensure byte alignment and put back any bytes from the bitbuf if we've looked ahead too far on gzip, or other Deflate streams followed by arbitrary data. */
+ /* I'm being super conservative here. A number of simplifications can be made to the byte alignment part, and the Adler32 check shouldn't ever need to worry about reading from the bitbuf now. */
+ TINFL_SKIP_BITS(32, num_bits & 7);
+ while ((pIn_buf_cur > pIn_buf_next) && (num_bits >= 8))
+ {
+ --pIn_buf_cur;
+ num_bits -= 8;
+ }
+ bit_buf &= (tinfl_bit_buf_t)((((mz_uint64)1) << num_bits) - (mz_uint64)1);
+ MZ_ASSERT(!num_bits); /* if this assert fires then we've read beyond the end of non-deflate/zlib streams with following data (such as gzip streams). */
+
+ if (decomp_flags & TINFL_FLAG_PARSE_ZLIB_HEADER)
+ {
+ for (counter = 0; counter < 4; ++counter)
+ {
+ mz_uint s;
+ if (num_bits)
+ TINFL_GET_BITS(41, s, 8);
+ else
+ TINFL_GET_BYTE(42, s);
+ r->m_z_adler32 = (r->m_z_adler32 << 8) | s;
+ }
+ }
+ TINFL_CR_RETURN_FOREVER(34, TINFL_STATUS_DONE);
+
+ TINFL_CR_FINISH
+
+common_exit:
+ /* As long as we aren't telling the caller that we NEED more input to make forward progress: */
+ /* Put back any bytes from the bitbuf in case we've looked ahead too far on gzip, or other Deflate streams followed by arbitrary data. */
+ /* We need to be very careful here to NOT push back any bytes we definitely know we need to make forward progress, though, or we'll lock the caller up into an inf loop. */
+ if ((status != TINFL_STATUS_NEEDS_MORE_INPUT) && (status != TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS))
+ {
+ while ((pIn_buf_cur > pIn_buf_next) && (num_bits >= 8))
+ {
+ --pIn_buf_cur;
+ num_bits -= 8;
+ }
+ }
+ r->m_num_bits = num_bits;
+ r->m_bit_buf = bit_buf & (tinfl_bit_buf_t)((((mz_uint64)1) << num_bits) - (mz_uint64)1);
+ r->m_dist = dist;
+ r->m_counter = counter;
+ r->m_num_extra = num_extra;
+ r->m_dist_from_out_buf_start = dist_from_out_buf_start;
+ *pIn_buf_size = pIn_buf_cur - pIn_buf_next;
+ *pOut_buf_size = pOut_buf_cur - pOut_buf_next;
+ if ((decomp_flags & (TINFL_FLAG_PARSE_ZLIB_HEADER | TINFL_FLAG_COMPUTE_ADLER32)) && (status >= 0))
+ {
+ const mz_uint8 *ptr = pOut_buf_next;
+ size_t buf_len = *pOut_buf_size;
+ mz_uint32 i, s1 = r->m_check_adler32 & 0xffff, s2 = r->m_check_adler32 >> 16;
+ size_t block_len = buf_len % 5552;
+ while (buf_len)
+ {
+ for (i = 0; i + 7 < block_len; i += 8, ptr += 8)
+ {
+ s1 += ptr[0], s2 += s1;
+ s1 += ptr[1], s2 += s1;
+ s1 += ptr[2], s2 += s1;
+ s1 += ptr[3], s2 += s1;
+ s1 += ptr[4], s2 += s1;
+ s1 += ptr[5], s2 += s1;
+ s1 += ptr[6], s2 += s1;
+ s1 += ptr[7], s2 += s1;
+ }
+ for (; i < block_len; ++i)
+ s1 += *ptr++, s2 += s1;
+ s1 %= 65521U, s2 %= 65521U;
+ buf_len -= block_len;
+ block_len = 5552;
+ }
+ r->m_check_adler32 = (s2 << 16) + s1;
+ if ((status == TINFL_STATUS_DONE) && (decomp_flags & TINFL_FLAG_PARSE_ZLIB_HEADER) && (r->m_check_adler32 != r->m_z_adler32))
+ status = TINFL_STATUS_ADLER32_MISMATCH;
+ }
+ return status;
+}
+
+/* Higher level helper functions. */
+void *tinfl_decompress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags)
+{
+ tinfl_decompressor decomp;
+ void *pBuf = NULL, *pNew_buf;
+ size_t src_buf_ofs = 0, out_buf_capacity = 0;
+ *pOut_len = 0;
+ tinfl_init(&decomp);
+ for (;;)
+ {
+ size_t src_buf_size = src_buf_len - src_buf_ofs, dst_buf_size = out_buf_capacity - *pOut_len, new_out_buf_capacity;
+ tinfl_status status = tinfl_decompress(&decomp, (const mz_uint8 *)pSrc_buf + src_buf_ofs, &src_buf_size, (mz_uint8 *)pBuf, pBuf ? (mz_uint8 *)pBuf + *pOut_len : NULL, &dst_buf_size,
+ (flags & ~TINFL_FLAG_HAS_MORE_INPUT) | TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF);
+ if ((status < 0) || (status == TINFL_STATUS_NEEDS_MORE_INPUT))
+ {
+ MZ_FREE(pBuf);
+ *pOut_len = 0;
+ return NULL;
+ }
+ src_buf_ofs += src_buf_size;
+ *pOut_len += dst_buf_size;
+ if (status == TINFL_STATUS_DONE)
+ break;
+ new_out_buf_capacity = out_buf_capacity * 2;
+ if (new_out_buf_capacity < 128)
+ new_out_buf_capacity = 128;
+ pNew_buf = MZ_REALLOC(pBuf, new_out_buf_capacity);
+ if (!pNew_buf)
+ {
+ MZ_FREE(pBuf);
+ *pOut_len = 0;
+ return NULL;
+ }
+ pBuf = pNew_buf;
+ out_buf_capacity = new_out_buf_capacity;
+ }
+ return pBuf;
+}
+
+size_t tinfl_decompress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags)
+{
+ tinfl_decompressor decomp;
+ tinfl_status status;
+ tinfl_init(&decomp);
+ status = tinfl_decompress(&decomp, (const mz_uint8 *)pSrc_buf, &src_buf_len, (mz_uint8 *)pOut_buf, (mz_uint8 *)pOut_buf, &out_buf_len, (flags & ~TINFL_FLAG_HAS_MORE_INPUT) | TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF);
+ return (status != TINFL_STATUS_DONE) ? TINFL_DECOMPRESS_MEM_TO_MEM_FAILED : out_buf_len;
+}
+
+int tinfl_decompress_mem_to_callback(const void *pIn_buf, size_t *pIn_buf_size, tinfl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags)
+{
+ int result = 0;
+ tinfl_decompressor decomp;
+ mz_uint8 *pDict = (mz_uint8 *)MZ_MALLOC(TINFL_LZ_DICT_SIZE);
+ size_t in_buf_ofs = 0, dict_ofs = 0;
+ if (!pDict)
+ return TINFL_STATUS_FAILED;
+ tinfl_init(&decomp);
+ for (;;)
+ {
+ size_t in_buf_size = *pIn_buf_size - in_buf_ofs, dst_buf_size = TINFL_LZ_DICT_SIZE - dict_ofs;
+ tinfl_status status = tinfl_decompress(&decomp, (const mz_uint8 *)pIn_buf + in_buf_ofs, &in_buf_size, pDict, pDict + dict_ofs, &dst_buf_size,
+ (flags & ~(TINFL_FLAG_HAS_MORE_INPUT | TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF)));
+ in_buf_ofs += in_buf_size;
+ if ((dst_buf_size) && (!(*pPut_buf_func)(pDict + dict_ofs, (int)dst_buf_size, pPut_buf_user)))
+ break;
+ if (status != TINFL_STATUS_HAS_MORE_OUTPUT)
+ {
+ result = (status == TINFL_STATUS_DONE);
+ break;
+ }
+ dict_ofs = (dict_ofs + dst_buf_size) & (TINFL_LZ_DICT_SIZE - 1);
+ }
+ MZ_FREE(pDict);
+ *pIn_buf_size = in_buf_ofs;
+ return result;
+}
+
+#ifndef MINIZ_NO_MALLOC
+tinfl_decompressor *tinfl_decompressor_alloc()
+{
+ tinfl_decompressor *pDecomp = (tinfl_decompressor *)MZ_MALLOC(sizeof(tinfl_decompressor));
+ if (pDecomp)
+ tinfl_init(pDecomp);
+ return pDecomp;
+}
+
+void tinfl_decompressor_free(tinfl_decompressor *pDecomp)
+{
+ MZ_FREE(pDecomp);
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+ /**************************************************************************
+ *
+ * Copyright 2013-2014 RAD Game Tools and Valve Software
+ * Copyright 2010-2014 Rich Geldreich and Tenacious Software LLC
+ * Copyright 2016 Martin Raiber
+ * 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.
+ *
+ **************************************************************************/
+
+
+#ifndef MINIZ_NO_ARCHIVE_APIS
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* ------------------- .ZIP archive reading */
+
+#ifdef MINIZ_NO_STDIO
+#define MZ_FILE void *
+#else
+#include <sys/stat.h>
+
+#if defined(_MSC_VER) || defined(__MINGW64__)
+static FILE *mz_fopen(const char *pFilename, const char *pMode)
+{
+ FILE *pFile = NULL;
+ fopen_s(&pFile, pFilename, pMode);
+ return pFile;
+}
+static FILE *mz_freopen(const char *pPath, const char *pMode, FILE *pStream)
+{
+ FILE *pFile = NULL;
+ if (freopen_s(&pFile, pPath, pMode, pStream))
+ return NULL;
+ return pFile;
+}
+#ifndef MINIZ_NO_TIME
+#include <sys/utime.h>
+#endif
+#define MZ_FOPEN mz_fopen
+#define MZ_FCLOSE fclose
+#define MZ_FREAD fread
+#define MZ_FWRITE fwrite
+#define MZ_FTELL64 _ftelli64
+#define MZ_FSEEK64 _fseeki64
+#define MZ_FILE_STAT_STRUCT _stat64
+#define MZ_FILE_STAT _stat64
+#define MZ_FFLUSH fflush
+#define MZ_FREOPEN mz_freopen
+#define MZ_DELETE_FILE remove
+#elif defined(__MINGW32__)
+#ifndef MINIZ_NO_TIME
+#include <sys/utime.h>
+#endif
+#define MZ_FOPEN(f, m) fopen(f, m)
+#define MZ_FCLOSE fclose
+#define MZ_FREAD fread
+#define MZ_FWRITE fwrite
+#define MZ_FTELL64 ftello64
+#define MZ_FSEEK64 fseeko64
+#define MZ_FILE_STAT_STRUCT _stat
+#define MZ_FILE_STAT _stat
+#define MZ_FFLUSH fflush
+#define MZ_FREOPEN(f, m, s) freopen(f, m, s)
+#define MZ_DELETE_FILE remove
+#elif defined(__TINYC__)
+#ifndef MINIZ_NO_TIME
+#include <sys/utime.h>
+#endif
+#define MZ_FOPEN(f, m) fopen(f, m)
+#define MZ_FCLOSE fclose
+#define MZ_FREAD fread
+#define MZ_FWRITE fwrite
+#define MZ_FTELL64 ftell
+#define MZ_FSEEK64 fseek
+#define MZ_FILE_STAT_STRUCT stat
+#define MZ_FILE_STAT stat
+#define MZ_FFLUSH fflush
+#define MZ_FREOPEN(f, m, s) freopen(f, m, s)
+#define MZ_DELETE_FILE remove
+#elif defined(__USE_LARGEFILE64) /* gcc, clang */
+#ifndef MINIZ_NO_TIME
+#include <utime.h>
+#endif
+#define MZ_FOPEN(f, m) fopen64(f, m)
+#define MZ_FCLOSE fclose
+#define MZ_FREAD fread
+#define MZ_FWRITE fwrite
+#define MZ_FTELL64 ftello64
+#define MZ_FSEEK64 fseeko64
+#define MZ_FILE_STAT_STRUCT stat64
+#define MZ_FILE_STAT stat64
+#define MZ_FFLUSH fflush
+#define MZ_FREOPEN(p, m, s) freopen64(p, m, s)
+#define MZ_DELETE_FILE remove
+#elif defined(__APPLE__)
+#ifndef MINIZ_NO_TIME
+#include <utime.h>
+#endif
+#define MZ_FOPEN(f, m) fopen(f, m)
+#define MZ_FCLOSE fclose
+#define MZ_FREAD fread
+#define MZ_FWRITE fwrite
+#define MZ_FTELL64 ftello
+#define MZ_FSEEK64 fseeko
+#define MZ_FILE_STAT_STRUCT stat
+#define MZ_FILE_STAT stat
+#define MZ_FFLUSH fflush
+#define MZ_FREOPEN(p, m, s) freopen(p, m, s)
+#define MZ_DELETE_FILE remove
+
+#else
+#pragma message("Using fopen, ftello, fseeko, stat() etc. path for file I/O - this path may not support large files.")
+#ifndef MINIZ_NO_TIME
+#include <utime.h>
+#endif
+#define MZ_FOPEN(f, m) fopen(f, m)
+#define MZ_FCLOSE fclose
+#define MZ_FREAD fread
+#define MZ_FWRITE fwrite
+#ifdef __STRICT_ANSI__
+#define MZ_FTELL64 ftell
+#define MZ_FSEEK64 fseek
+#else
+#define MZ_FTELL64 ftello
+#define MZ_FSEEK64 fseeko
+#endif
+#define MZ_FILE_STAT_STRUCT stat
+#define MZ_FILE_STAT stat
+#define MZ_FFLUSH fflush
+#define MZ_FREOPEN(f, m, s) freopen(f, m, s)
+#define MZ_DELETE_FILE remove
+#endif /* #ifdef _MSC_VER */
+#endif /* #ifdef MINIZ_NO_STDIO */
+
+#define MZ_TOLOWER(c) ((((c) >= 'A') && ((c) <= 'Z')) ? ((c) - 'A' + 'a') : (c))
+
+/* Various ZIP archive enums. To completely avoid cross platform compiler alignment and platform endian issues, miniz.c doesn't use structs for any of this stuff. */
+enum
+{
+ /* ZIP archive identifiers and record sizes */
+ MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG = 0x06054b50,
+ MZ_ZIP_CENTRAL_DIR_HEADER_SIG = 0x02014b50,
+ MZ_ZIP_LOCAL_DIR_HEADER_SIG = 0x04034b50,
+ MZ_ZIP_LOCAL_DIR_HEADER_SIZE = 30,
+ MZ_ZIP_CENTRAL_DIR_HEADER_SIZE = 46,
+ MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE = 22,
+
+ /* ZIP64 archive identifier and record sizes */
+ MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIG = 0x06064b50,
+ MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIG = 0x07064b50,
+ MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE = 56,
+ MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE = 20,
+ MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID = 0x0001,
+ MZ_ZIP_DATA_DESCRIPTOR_ID = 0x08074b50,
+ MZ_ZIP_DATA_DESCRIPTER_SIZE64 = 24,
+ MZ_ZIP_DATA_DESCRIPTER_SIZE32 = 16,
+
+ /* Central directory header record offsets */
+ MZ_ZIP_CDH_SIG_OFS = 0,
+ MZ_ZIP_CDH_VERSION_MADE_BY_OFS = 4,
+ MZ_ZIP_CDH_VERSION_NEEDED_OFS = 6,
+ MZ_ZIP_CDH_BIT_FLAG_OFS = 8,
+ MZ_ZIP_CDH_METHOD_OFS = 10,
+ MZ_ZIP_CDH_FILE_TIME_OFS = 12,
+ MZ_ZIP_CDH_FILE_DATE_OFS = 14,
+ MZ_ZIP_CDH_CRC32_OFS = 16,
+ MZ_ZIP_CDH_COMPRESSED_SIZE_OFS = 20,
+ MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS = 24,
+ MZ_ZIP_CDH_FILENAME_LEN_OFS = 28,
+ MZ_ZIP_CDH_EXTRA_LEN_OFS = 30,
+ MZ_ZIP_CDH_COMMENT_LEN_OFS = 32,
+ MZ_ZIP_CDH_DISK_START_OFS = 34,
+ MZ_ZIP_CDH_INTERNAL_ATTR_OFS = 36,
+ MZ_ZIP_CDH_EXTERNAL_ATTR_OFS = 38,
+ MZ_ZIP_CDH_LOCAL_HEADER_OFS = 42,
+
+ /* Local directory header offsets */
+ MZ_ZIP_LDH_SIG_OFS = 0,
+ MZ_ZIP_LDH_VERSION_NEEDED_OFS = 4,
+ MZ_ZIP_LDH_BIT_FLAG_OFS = 6,
+ MZ_ZIP_LDH_METHOD_OFS = 8,
+ MZ_ZIP_LDH_FILE_TIME_OFS = 10,
+ MZ_ZIP_LDH_FILE_DATE_OFS = 12,
+ MZ_ZIP_LDH_CRC32_OFS = 14,
+ MZ_ZIP_LDH_COMPRESSED_SIZE_OFS = 18,
+ MZ_ZIP_LDH_DECOMPRESSED_SIZE_OFS = 22,
+ MZ_ZIP_LDH_FILENAME_LEN_OFS = 26,
+ MZ_ZIP_LDH_EXTRA_LEN_OFS = 28,
+ MZ_ZIP_LDH_BIT_FLAG_HAS_LOCATOR = 1 << 3,
+
+ /* End of central directory offsets */
+ MZ_ZIP_ECDH_SIG_OFS = 0,
+ MZ_ZIP_ECDH_NUM_THIS_DISK_OFS = 4,
+ MZ_ZIP_ECDH_NUM_DISK_CDIR_OFS = 6,
+ MZ_ZIP_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS = 8,
+ MZ_ZIP_ECDH_CDIR_TOTAL_ENTRIES_OFS = 10,
+ MZ_ZIP_ECDH_CDIR_SIZE_OFS = 12,
+ MZ_ZIP_ECDH_CDIR_OFS_OFS = 16,
+ MZ_ZIP_ECDH_COMMENT_SIZE_OFS = 20,
+
+ /* ZIP64 End of central directory locator offsets */
+ MZ_ZIP64_ECDL_SIG_OFS = 0, /* 4 bytes */
+ MZ_ZIP64_ECDL_NUM_DISK_CDIR_OFS = 4, /* 4 bytes */
+ MZ_ZIP64_ECDL_REL_OFS_TO_ZIP64_ECDR_OFS = 8, /* 8 bytes */
+ MZ_ZIP64_ECDL_TOTAL_NUMBER_OF_DISKS_OFS = 16, /* 4 bytes */
+
+ /* ZIP64 End of central directory header offsets */
+ MZ_ZIP64_ECDH_SIG_OFS = 0, /* 4 bytes */
+ MZ_ZIP64_ECDH_SIZE_OF_RECORD_OFS = 4, /* 8 bytes */
+ MZ_ZIP64_ECDH_VERSION_MADE_BY_OFS = 12, /* 2 bytes */
+ MZ_ZIP64_ECDH_VERSION_NEEDED_OFS = 14, /* 2 bytes */
+ MZ_ZIP64_ECDH_NUM_THIS_DISK_OFS = 16, /* 4 bytes */
+ MZ_ZIP64_ECDH_NUM_DISK_CDIR_OFS = 20, /* 4 bytes */
+ MZ_ZIP64_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS = 24, /* 8 bytes */
+ MZ_ZIP64_ECDH_CDIR_TOTAL_ENTRIES_OFS = 32, /* 8 bytes */
+ MZ_ZIP64_ECDH_CDIR_SIZE_OFS = 40, /* 8 bytes */
+ MZ_ZIP64_ECDH_CDIR_OFS_OFS = 48, /* 8 bytes */
+ MZ_ZIP_VERSION_MADE_BY_DOS_FILESYSTEM_ID = 0,
+ MZ_ZIP_DOS_DIR_ATTRIBUTE_BITFLAG = 0x10,
+ MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_IS_ENCRYPTED = 1,
+ MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_COMPRESSED_PATCH_FLAG = 32,
+ MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_USES_STRONG_ENCRYPTION = 64,
+ MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_LOCAL_DIR_IS_MASKED = 8192,
+ MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_UTF8 = 1 << 11
+};
+
+typedef struct
+{
+ void *m_p;
+ size_t m_size, m_capacity;
+ mz_uint m_element_size;
+} mz_zip_array;
+
+struct mz_zip_internal_state_tag
+{
+ mz_zip_array m_central_dir;
+ mz_zip_array m_central_dir_offsets;
+ mz_zip_array m_sorted_central_dir_offsets;
+
+ /* The flags passed in when the archive is initially opened. */
+ uint32_t m_init_flags;
+
+ /* MZ_TRUE if the archive has a zip64 end of central directory headers, etc. */
+ mz_bool m_zip64;
+
+ /* MZ_TRUE if we found zip64 extended info in the central directory (m_zip64 will also be slammed to true too, even if we didn't find a zip64 end of central dir header, etc.) */
+ mz_bool m_zip64_has_extended_info_fields;
+
+ /* These fields are used by the file, FILE, memory, and memory/heap read/write helpers. */
+ MZ_FILE *m_pFile;
+ mz_uint64 m_file_archive_start_ofs;
+
+ void *m_pMem;
+ size_t m_mem_size;
+ size_t m_mem_capacity;
+};
+
+#define MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(array_ptr, element_size) (array_ptr)->m_element_size = element_size
+
+#if defined(DEBUG) || defined(_DEBUG)
+static MZ_FORCEINLINE mz_uint mz_zip_array_range_check(const mz_zip_array *pArray, mz_uint index)
+{
+ MZ_ASSERT(index < pArray->m_size);
+ return index;
+}
+#define MZ_ZIP_ARRAY_ELEMENT(array_ptr, element_type, index) ((element_type *)((array_ptr)->m_p))[mz_zip_array_range_check(array_ptr, index)]
+#else
+#define MZ_ZIP_ARRAY_ELEMENT(array_ptr, element_type, index) ((element_type *)((array_ptr)->m_p))[index]
+#endif
+
+static MZ_FORCEINLINE void mz_zip_array_init(mz_zip_array *pArray, mz_uint32 element_size)
+{
+ memset(pArray, 0, sizeof(mz_zip_array));
+ pArray->m_element_size = element_size;
+}
+
+static MZ_FORCEINLINE void mz_zip_array_clear(mz_zip_archive *pZip, mz_zip_array *pArray)
+{
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pArray->m_p);
+ memset(pArray, 0, sizeof(mz_zip_array));
+}
+
+static mz_bool mz_zip_array_ensure_capacity(mz_zip_archive *pZip, mz_zip_array *pArray, size_t min_new_capacity, mz_uint growing)
+{
+ void *pNew_p;
+ size_t new_capacity = min_new_capacity;
+ MZ_ASSERT(pArray->m_element_size);
+ if (pArray->m_capacity >= min_new_capacity)
+ return MZ_TRUE;
+ if (growing)
+ {
+ new_capacity = MZ_MAX(1, pArray->m_capacity);
+ while (new_capacity < min_new_capacity)
+ new_capacity *= 2;
+ }
+ if (NULL == (pNew_p = pZip->m_pRealloc(pZip->m_pAlloc_opaque, pArray->m_p, pArray->m_element_size, new_capacity)))
+ return MZ_FALSE;
+ pArray->m_p = pNew_p;
+ pArray->m_capacity = new_capacity;
+ return MZ_TRUE;
+}
+
+static MZ_FORCEINLINE mz_bool mz_zip_array_reserve(mz_zip_archive *pZip, mz_zip_array *pArray, size_t new_capacity, mz_uint growing)
+{
+ if (new_capacity > pArray->m_capacity)
+ {
+ if (!mz_zip_array_ensure_capacity(pZip, pArray, new_capacity, growing))
+ return MZ_FALSE;
+ }
+ return MZ_TRUE;
+}
+
+static MZ_FORCEINLINE mz_bool mz_zip_array_resize(mz_zip_archive *pZip, mz_zip_array *pArray, size_t new_size, mz_uint growing)
+{
+ if (new_size > pArray->m_capacity)
+ {
+ if (!mz_zip_array_ensure_capacity(pZip, pArray, new_size, growing))
+ return MZ_FALSE;
+ }
+ pArray->m_size = new_size;
+ return MZ_TRUE;
+}
+
+static MZ_FORCEINLINE mz_bool mz_zip_array_ensure_room(mz_zip_archive *pZip, mz_zip_array *pArray, size_t n)
+{
+ return mz_zip_array_reserve(pZip, pArray, pArray->m_size + n, MZ_TRUE);
+}
+
+static MZ_FORCEINLINE mz_bool mz_zip_array_push_back(mz_zip_archive *pZip, mz_zip_array *pArray, const void *pElements, size_t n)
+{
+ size_t orig_size = pArray->m_size;
+ if (!mz_zip_array_resize(pZip, pArray, orig_size + n, MZ_TRUE))
+ return MZ_FALSE;
+ if (n > 0)
+ memcpy((mz_uint8 *)pArray->m_p + orig_size * pArray->m_element_size, pElements, n * pArray->m_element_size);
+ return MZ_TRUE;
+}
+
+#ifndef MINIZ_NO_TIME
+static MZ_TIME_T mz_zip_dos_to_time_t(int dos_time, int dos_date)
+{
+ struct tm tm;
+ memset(&tm, 0, sizeof(tm));
+ tm.tm_isdst = -1;
+ tm.tm_year = ((dos_date >> 9) & 127) + 1980 - 1900;
+ tm.tm_mon = ((dos_date >> 5) & 15) - 1;
+ tm.tm_mday = dos_date & 31;
+ tm.tm_hour = (dos_time >> 11) & 31;
+ tm.tm_min = (dos_time >> 5) & 63;
+ tm.tm_sec = (dos_time << 1) & 62;
+ return mktime(&tm);
+}
+
+#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS
+static void mz_zip_time_t_to_dos_time(MZ_TIME_T time, mz_uint16 *pDOS_time, mz_uint16 *pDOS_date)
+{
+#ifdef _MSC_VER
+ struct tm tm_struct;
+ struct tm *tm = &tm_struct;
+ errno_t err = localtime_s(tm, &time);
+ if (err)
+ {
+ *pDOS_date = 0;
+ *pDOS_time = 0;
+ return;
+ }
+#else
+ struct tm *tm = localtime(&time);
+#endif /* #ifdef _MSC_VER */
+
+ *pDOS_time = (mz_uint16)(((tm->tm_hour) << 11) + ((tm->tm_min) << 5) + ((tm->tm_sec) >> 1));
+ *pDOS_date = (mz_uint16)(((tm->tm_year + 1900 - 1980) << 9) + ((tm->tm_mon + 1) << 5) + tm->tm_mday);
+}
+#endif /* MINIZ_NO_ARCHIVE_WRITING_APIS */
+
+#ifndef MINIZ_NO_STDIO
+#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS
+static mz_bool mz_zip_get_file_modified_time(const char *pFilename, MZ_TIME_T *pTime)
+{
+ struct MZ_FILE_STAT_STRUCT file_stat;
+
+ /* On Linux with x86 glibc, this call will fail on large files (I think >= 0x80000000 bytes) unless you compiled with _LARGEFILE64_SOURCE. Argh. */
+ if (MZ_FILE_STAT(pFilename, &file_stat) != 0)
+ return MZ_FALSE;
+
+ *pTime = file_stat.st_mtime;
+
+ return MZ_TRUE;
+}
+#endif /* #ifndef MINIZ_NO_ARCHIVE_WRITING_APIS*/
+
+static mz_bool mz_zip_set_file_times(const char *pFilename, MZ_TIME_T access_time, MZ_TIME_T modified_time)
+{
+ struct utimbuf t;
+
+ memset(&t, 0, sizeof(t));
+ t.actime = access_time;
+ t.modtime = modified_time;
+
+ return !utime(pFilename, &t);
+}
+#endif /* #ifndef MINIZ_NO_STDIO */
+#endif /* #ifndef MINIZ_NO_TIME */
+
+static MZ_FORCEINLINE mz_bool mz_zip_set_error(mz_zip_archive *pZip, mz_zip_error err_num)
+{
+ if (pZip)
+ pZip->m_last_error = err_num;
+ return MZ_FALSE;
+}
+
+static mz_bool mz_zip_reader_init_internal(mz_zip_archive *pZip, mz_uint flags)
+{
+ (void)flags;
+ if ((!pZip) || (pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_INVALID))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!pZip->m_pAlloc)
+ pZip->m_pAlloc = miniz_def_alloc_func;
+ if (!pZip->m_pFree)
+ pZip->m_pFree = miniz_def_free_func;
+ if (!pZip->m_pRealloc)
+ pZip->m_pRealloc = miniz_def_realloc_func;
+
+ pZip->m_archive_size = 0;
+ pZip->m_central_directory_file_ofs = 0;
+ pZip->m_total_files = 0;
+ pZip->m_last_error = MZ_ZIP_NO_ERROR;
+
+ if (NULL == (pZip->m_pState = (mz_zip_internal_state *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(mz_zip_internal_state))))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ memset(pZip->m_pState, 0, sizeof(mz_zip_internal_state));
+ MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir, sizeof(mz_uint8));
+ MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir_offsets, sizeof(mz_uint32));
+ MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_sorted_central_dir_offsets, sizeof(mz_uint32));
+ pZip->m_pState->m_init_flags = flags;
+ pZip->m_pState->m_zip64 = MZ_FALSE;
+ pZip->m_pState->m_zip64_has_extended_info_fields = MZ_FALSE;
+
+ pZip->m_zip_mode = MZ_ZIP_MODE_READING;
+
+ return MZ_TRUE;
+}
+
+static MZ_FORCEINLINE mz_bool mz_zip_reader_filename_less(const mz_zip_array *pCentral_dir_array, const mz_zip_array *pCentral_dir_offsets, mz_uint l_index, mz_uint r_index)
+{
+ const mz_uint8 *pL = &MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_array, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_offsets, mz_uint32, l_index)), *pE;
+ const mz_uint8 *pR = &MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_array, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_offsets, mz_uint32, r_index));
+ mz_uint l_len = MZ_READ_LE16(pL + MZ_ZIP_CDH_FILENAME_LEN_OFS), r_len = MZ_READ_LE16(pR + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ mz_uint8 l = 0, r = 0;
+ pL += MZ_ZIP_CENTRAL_DIR_HEADER_SIZE;
+ pR += MZ_ZIP_CENTRAL_DIR_HEADER_SIZE;
+ pE = pL + MZ_MIN(l_len, r_len);
+ while (pL < pE)
+ {
+ if ((l = MZ_TOLOWER(*pL)) != (r = MZ_TOLOWER(*pR)))
+ break;
+ pL++;
+ pR++;
+ }
+ return (pL == pE) ? (l_len < r_len) : (l < r);
+}
+
+#define MZ_SWAP_UINT32(a, b) \
+ do \
+ { \
+ mz_uint32 t = a; \
+ a = b; \
+ b = t; \
+ } \
+ MZ_MACRO_END
+
+/* Heap sort of lowercased filenames, used to help accelerate plain central directory searches by mz_zip_reader_locate_file(). (Could also use qsort(), but it could allocate memory.) */
+static void mz_zip_reader_sort_central_dir_offsets_by_filename(mz_zip_archive *pZip)
+{
+ mz_zip_internal_state *pState = pZip->m_pState;
+ const mz_zip_array *pCentral_dir_offsets = &pState->m_central_dir_offsets;
+ const mz_zip_array *pCentral_dir = &pState->m_central_dir;
+ mz_uint32 *pIndices;
+ mz_uint32 start, end;
+ const mz_uint32 size = pZip->m_total_files;
+
+ if (size <= 1U)
+ return;
+
+ pIndices = &MZ_ZIP_ARRAY_ELEMENT(&pState->m_sorted_central_dir_offsets, mz_uint32, 0);
+
+ start = (size - 2U) >> 1U;
+ for (;;)
+ {
+ mz_uint64 child, root = start;
+ for (;;)
+ {
+ if ((child = (root << 1U) + 1U) >= size)
+ break;
+ child += (((child + 1U) < size) && (mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[child], pIndices[child + 1U])));
+ if (!mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[root], pIndices[child]))
+ break;
+ MZ_SWAP_UINT32(pIndices[root], pIndices[child]);
+ root = child;
+ }
+ if (!start)
+ break;
+ start--;
+ }
+
+ end = size - 1;
+ while (end > 0)
+ {
+ mz_uint64 child, root = 0;
+ MZ_SWAP_UINT32(pIndices[end], pIndices[0]);
+ for (;;)
+ {
+ if ((child = (root << 1U) + 1U) >= end)
+ break;
+ child += (((child + 1U) < end) && mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[child], pIndices[child + 1U]));
+ if (!mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[root], pIndices[child]))
+ break;
+ MZ_SWAP_UINT32(pIndices[root], pIndices[child]);
+ root = child;
+ }
+ end--;
+ }
+}
+
+static mz_bool mz_zip_reader_locate_header_sig(mz_zip_archive *pZip, mz_uint32 record_sig, mz_uint32 record_size, mz_int64 *pOfs)
+{
+ mz_int64 cur_file_ofs;
+ mz_uint32 buf_u32[4096 / sizeof(mz_uint32)];
+ mz_uint8 *pBuf = (mz_uint8 *)buf_u32;
+
+ /* Basic sanity checks - reject files which are too small */
+ if (pZip->m_archive_size < record_size)
+ return MZ_FALSE;
+
+ /* Find the record by scanning the file from the end towards the beginning. */
+ cur_file_ofs = MZ_MAX((mz_int64)pZip->m_archive_size - (mz_int64)sizeof(buf_u32), 0);
+ for (;;)
+ {
+ int i, n = (int)MZ_MIN(sizeof(buf_u32), pZip->m_archive_size - cur_file_ofs);
+
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pBuf, n) != (mz_uint)n)
+ return MZ_FALSE;
+
+ for (i = n - 4; i >= 0; --i)
+ {
+ mz_uint s = MZ_READ_LE32(pBuf + i);
+ if (s == record_sig)
+ {
+ if ((pZip->m_archive_size - (cur_file_ofs + i)) >= record_size)
+ break;
+ }
+ }
+
+ if (i >= 0)
+ {
+ cur_file_ofs += i;
+ break;
+ }
+
+ /* Give up if we've searched the entire file, or we've gone back "too far" (~64kb) */
+ if ((!cur_file_ofs) || ((pZip->m_archive_size - cur_file_ofs) >= (MZ_UINT16_MAX + record_size)))
+ return MZ_FALSE;
+
+ cur_file_ofs = MZ_MAX(cur_file_ofs - (sizeof(buf_u32) - 3), 0);
+ }
+
+ *pOfs = cur_file_ofs;
+ return MZ_TRUE;
+}
+
+static mz_bool mz_zip_reader_read_central_dir(mz_zip_archive *pZip, mz_uint flags)
+{
+ mz_uint cdir_size = 0, cdir_entries_on_this_disk = 0, num_this_disk = 0, cdir_disk_index = 0;
+ mz_uint64 cdir_ofs = 0;
+ mz_int64 cur_file_ofs = 0;
+ const mz_uint8 *p;
+
+ mz_uint32 buf_u32[4096 / sizeof(mz_uint32)];
+ mz_uint8 *pBuf = (mz_uint8 *)buf_u32;
+ mz_bool sort_central_dir = ((flags & MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY) == 0);
+ mz_uint32 zip64_end_of_central_dir_locator_u32[(MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pZip64_locator = (mz_uint8 *)zip64_end_of_central_dir_locator_u32;
+
+ mz_uint32 zip64_end_of_central_dir_header_u32[(MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pZip64_end_of_central_dir = (mz_uint8 *)zip64_end_of_central_dir_header_u32;
+
+ mz_uint64 zip64_end_of_central_dir_ofs = 0;
+
+ /* Basic sanity checks - reject files which are too small, and check the first 4 bytes of the file to make sure a local header is there. */
+ if (pZip->m_archive_size < MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_NOT_AN_ARCHIVE);
+
+ if (!mz_zip_reader_locate_header_sig(pZip, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE, &cur_file_ofs))
+ return mz_zip_set_error(pZip, MZ_ZIP_FAILED_FINDING_CENTRAL_DIR);
+
+ /* Read and verify the end of central directory record. */
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pBuf, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) != MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+ if (MZ_READ_LE32(pBuf + MZ_ZIP_ECDH_SIG_OFS) != MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG)
+ return mz_zip_set_error(pZip, MZ_ZIP_NOT_AN_ARCHIVE);
+
+ if (cur_file_ofs >= (MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE + MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE))
+ {
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs - MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE, pZip64_locator, MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE) == MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE)
+ {
+ if (MZ_READ_LE32(pZip64_locator + MZ_ZIP64_ECDL_SIG_OFS) == MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIG)
+ {
+ zip64_end_of_central_dir_ofs = MZ_READ_LE64(pZip64_locator + MZ_ZIP64_ECDL_REL_OFS_TO_ZIP64_ECDR_OFS);
+ if (zip64_end_of_central_dir_ofs > (pZip->m_archive_size - MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE))
+ return mz_zip_set_error(pZip, MZ_ZIP_NOT_AN_ARCHIVE);
+
+ if (pZip->m_pRead(pZip->m_pIO_opaque, zip64_end_of_central_dir_ofs, pZip64_end_of_central_dir, MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE) == MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ {
+ if (MZ_READ_LE32(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_SIG_OFS) == MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIG)
+ {
+ pZip->m_pState->m_zip64 = MZ_TRUE;
+ }
+ }
+ }
+ }
+ }
+
+ pZip->m_total_files = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_CDIR_TOTAL_ENTRIES_OFS);
+ cdir_entries_on_this_disk = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS);
+ num_this_disk = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_NUM_THIS_DISK_OFS);
+ cdir_disk_index = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_NUM_DISK_CDIR_OFS);
+ cdir_size = MZ_READ_LE32(pBuf + MZ_ZIP_ECDH_CDIR_SIZE_OFS);
+ cdir_ofs = MZ_READ_LE32(pBuf + MZ_ZIP_ECDH_CDIR_OFS_OFS);
+
+ if (pZip->m_pState->m_zip64)
+ {
+ mz_uint32 zip64_total_num_of_disks = MZ_READ_LE32(pZip64_locator + MZ_ZIP64_ECDL_TOTAL_NUMBER_OF_DISKS_OFS);
+ mz_uint64 zip64_cdir_total_entries = MZ_READ_LE64(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_CDIR_TOTAL_ENTRIES_OFS);
+ mz_uint64 zip64_cdir_total_entries_on_this_disk = MZ_READ_LE64(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS);
+ mz_uint64 zip64_size_of_end_of_central_dir_record = MZ_READ_LE64(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_SIZE_OF_RECORD_OFS);
+ mz_uint64 zip64_size_of_central_directory = MZ_READ_LE64(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_CDIR_SIZE_OFS);
+
+ if (zip64_size_of_end_of_central_dir_record < (MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE - 12))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if (zip64_total_num_of_disks != 1U)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_MULTIDISK);
+
+ /* Check for miniz's practical limits */
+ if (zip64_cdir_total_entries > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+
+ pZip->m_total_files = (mz_uint32)zip64_cdir_total_entries;
+
+ if (zip64_cdir_total_entries_on_this_disk > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+
+ cdir_entries_on_this_disk = (mz_uint32)zip64_cdir_total_entries_on_this_disk;
+
+ /* Check for miniz's current practical limits (sorry, this should be enough for millions of files) */
+ if (zip64_size_of_central_directory > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_CDIR_SIZE);
+
+ cdir_size = (mz_uint32)zip64_size_of_central_directory;
+
+ num_this_disk = MZ_READ_LE32(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_NUM_THIS_DISK_OFS);
+
+ cdir_disk_index = MZ_READ_LE32(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_NUM_DISK_CDIR_OFS);
+
+ cdir_ofs = MZ_READ_LE64(pZip64_end_of_central_dir + MZ_ZIP64_ECDH_CDIR_OFS_OFS);
+ }
+
+ if (pZip->m_total_files != cdir_entries_on_this_disk)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_MULTIDISK);
+
+ if (((num_this_disk | cdir_disk_index) != 0) && ((num_this_disk != 1) || (cdir_disk_index != 1)))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_MULTIDISK);
+
+ if (cdir_size < pZip->m_total_files * MZ_ZIP_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if ((cdir_ofs + (mz_uint64)cdir_size) > pZip->m_archive_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ pZip->m_central_directory_file_ofs = cdir_ofs;
+
+ if (pZip->m_total_files)
+ {
+ mz_uint i, n;
+ /* Read the entire central directory into a heap block, and allocate another heap block to hold the unsorted central dir file record offsets, and possibly another to hold the sorted indices. */
+ if ((!mz_zip_array_resize(pZip, &pZip->m_pState->m_central_dir, cdir_size, MZ_FALSE)) ||
+ (!mz_zip_array_resize(pZip, &pZip->m_pState->m_central_dir_offsets, pZip->m_total_files, MZ_FALSE)))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ if (sort_central_dir)
+ {
+ if (!mz_zip_array_resize(pZip, &pZip->m_pState->m_sorted_central_dir_offsets, pZip->m_total_files, MZ_FALSE))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cdir_ofs, pZip->m_pState->m_central_dir.m_p, cdir_size) != cdir_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+ /* Now create an index into the central directory file records, do some basic sanity checking on each record */
+ p = (const mz_uint8 *)pZip->m_pState->m_central_dir.m_p;
+ for (n = cdir_size, i = 0; i < pZip->m_total_files; ++i)
+ {
+ mz_uint total_header_size, disk_index, bit_flags, filename_size, ext_data_size;
+ mz_uint64 comp_size, decomp_size, local_header_ofs;
+
+ if ((n < MZ_ZIP_CENTRAL_DIR_HEADER_SIZE) || (MZ_READ_LE32(p) != MZ_ZIP_CENTRAL_DIR_HEADER_SIG))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, i) = (mz_uint32)(p - (const mz_uint8 *)pZip->m_pState->m_central_dir.m_p);
+
+ if (sort_central_dir)
+ MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_sorted_central_dir_offsets, mz_uint32, i) = i;
+
+ comp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS);
+ decomp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS);
+ local_header_ofs = MZ_READ_LE32(p + MZ_ZIP_CDH_LOCAL_HEADER_OFS);
+ filename_size = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ ext_data_size = MZ_READ_LE16(p + MZ_ZIP_CDH_EXTRA_LEN_OFS);
+
+ if ((!pZip->m_pState->m_zip64_has_extended_info_fields) &&
+ (ext_data_size) &&
+ (MZ_MAX(MZ_MAX(comp_size, decomp_size), local_header_ofs) == MZ_UINT32_MAX))
+ {
+ /* Attempt to find zip64 extended information field in the entry's extra data */
+ mz_uint32 extra_size_remaining = ext_data_size;
+
+ if (extra_size_remaining)
+ {
+ const mz_uint8 *pExtra_data;
+ void* buf = NULL;
+
+ if (MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_size + ext_data_size > n)
+ {
+ buf = MZ_MALLOC(ext_data_size);
+ if(buf==NULL)
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cdir_ofs + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_size, buf, ext_data_size) != ext_data_size)
+ {
+ MZ_FREE(buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ }
+
+ pExtra_data = (mz_uint8*)buf;
+ }
+ else
+ {
+ pExtra_data = p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_size;
+ }
+
+ do
+ {
+ mz_uint32 field_id;
+ mz_uint32 field_data_size;
+
+ if (extra_size_remaining < (sizeof(mz_uint16) * 2))
+ {
+ MZ_FREE(buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ field_id = MZ_READ_LE16(pExtra_data);
+ field_data_size = MZ_READ_LE16(pExtra_data + sizeof(mz_uint16));
+
+ if ((field_data_size + sizeof(mz_uint16) * 2) > extra_size_remaining)
+ {
+ MZ_FREE(buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ if (field_id == MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID)
+ {
+ /* Ok, the archive didn't have any zip64 headers but it uses a zip64 extended information field so mark it as zip64 anyway (this can occur with infozip's zip util when it reads compresses files from stdin). */
+ pZip->m_pState->m_zip64 = MZ_TRUE;
+ pZip->m_pState->m_zip64_has_extended_info_fields = MZ_TRUE;
+ break;
+ }
+
+ pExtra_data += sizeof(mz_uint16) * 2 + field_data_size;
+ extra_size_remaining = extra_size_remaining - sizeof(mz_uint16) * 2 - field_data_size;
+ } while (extra_size_remaining);
+
+ MZ_FREE(buf);
+ }
+ }
+
+ /* I've seen archives that aren't marked as zip64 that uses zip64 ext data, argh */
+ if ((comp_size != MZ_UINT32_MAX) && (decomp_size != MZ_UINT32_MAX))
+ {
+ if (((!MZ_READ_LE32(p + MZ_ZIP_CDH_METHOD_OFS)) && (decomp_size != comp_size)) || (decomp_size && !comp_size))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ disk_index = MZ_READ_LE16(p + MZ_ZIP_CDH_DISK_START_OFS);
+ if ((disk_index == MZ_UINT16_MAX) || ((disk_index != num_this_disk) && (disk_index != 1)))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_MULTIDISK);
+
+ if (comp_size != MZ_UINT32_MAX)
+ {
+ if (((mz_uint64)MZ_READ_LE32(p + MZ_ZIP_CDH_LOCAL_HEADER_OFS) + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + comp_size) > pZip->m_archive_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ bit_flags = MZ_READ_LE16(p + MZ_ZIP_CDH_BIT_FLAG_OFS);
+ if (bit_flags & MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_LOCAL_DIR_IS_MASKED)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_ENCRYPTION);
+
+ if ((total_header_size = MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS) + MZ_READ_LE16(p + MZ_ZIP_CDH_EXTRA_LEN_OFS) + MZ_READ_LE16(p + MZ_ZIP_CDH_COMMENT_LEN_OFS)) > n)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ n -= total_header_size;
+ p += total_header_size;
+ }
+ }
+
+ if (sort_central_dir)
+ mz_zip_reader_sort_central_dir_offsets_by_filename(pZip);
+
+ return MZ_TRUE;
+}
+
+void mz_zip_zero_struct(mz_zip_archive *pZip)
+{
+ if (pZip)
+ MZ_CLEAR_OBJ(*pZip);
+}
+
+static mz_bool mz_zip_reader_end_internal(mz_zip_archive *pZip, mz_bool set_last_error)
+{
+ mz_bool status = MZ_TRUE;
+
+ if (!pZip)
+ return MZ_FALSE;
+
+ if ((!pZip->m_pState) || (!pZip->m_pAlloc) || (!pZip->m_pFree) || (pZip->m_zip_mode != MZ_ZIP_MODE_READING))
+ {
+ if (set_last_error)
+ pZip->m_last_error = MZ_ZIP_INVALID_PARAMETER;
+
+ return MZ_FALSE;
+ }
+
+ if (pZip->m_pState)
+ {
+ mz_zip_internal_state *pState = pZip->m_pState;
+ pZip->m_pState = NULL;
+
+ mz_zip_array_clear(pZip, &pState->m_central_dir);
+ mz_zip_array_clear(pZip, &pState->m_central_dir_offsets);
+ mz_zip_array_clear(pZip, &pState->m_sorted_central_dir_offsets);
+
+#ifndef MINIZ_NO_STDIO
+ if (pState->m_pFile)
+ {
+ if (pZip->m_zip_type == MZ_ZIP_TYPE_FILE)
+ {
+ if (MZ_FCLOSE(pState->m_pFile) == EOF)
+ {
+ if (set_last_error)
+ pZip->m_last_error = MZ_ZIP_FILE_CLOSE_FAILED;
+ status = MZ_FALSE;
+ }
+ }
+ pState->m_pFile = NULL;
+ }
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ }
+ pZip->m_zip_mode = MZ_ZIP_MODE_INVALID;
+
+ return status;
+}
+
+mz_bool mz_zip_reader_end(mz_zip_archive *pZip)
+{
+ return mz_zip_reader_end_internal(pZip, MZ_TRUE);
+}
+mz_bool mz_zip_reader_init(mz_zip_archive *pZip, mz_uint64 size, mz_uint flags)
+{
+ if ((!pZip) || (!pZip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!mz_zip_reader_init_internal(pZip, flags))
+ return MZ_FALSE;
+
+ pZip->m_zip_type = MZ_ZIP_TYPE_USER;
+ pZip->m_archive_size = size;
+
+ if (!mz_zip_reader_read_central_dir(pZip, flags))
+ {
+ mz_zip_reader_end_internal(pZip, MZ_FALSE);
+ return MZ_FALSE;
+ }
+
+ return MZ_TRUE;
+}
+
+static size_t mz_zip_mem_read_func(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n)
+{
+ mz_zip_archive *pZip = (mz_zip_archive *)pOpaque;
+ size_t s = (file_ofs >= pZip->m_archive_size) ? 0 : (size_t)MZ_MIN(pZip->m_archive_size - file_ofs, n);
+ memcpy(pBuf, (const mz_uint8 *)pZip->m_pState->m_pMem + file_ofs, s);
+ return s;
+}
+
+mz_bool mz_zip_reader_init_mem(mz_zip_archive *pZip, const void *pMem, size_t size, mz_uint flags)
+{
+ if (!pMem)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (size < MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_NOT_AN_ARCHIVE);
+
+ if (!mz_zip_reader_init_internal(pZip, flags))
+ return MZ_FALSE;
+
+ pZip->m_zip_type = MZ_ZIP_TYPE_MEMORY;
+ pZip->m_archive_size = size;
+ pZip->m_pRead = mz_zip_mem_read_func;
+ pZip->m_pIO_opaque = pZip;
+ pZip->m_pNeeds_keepalive = NULL;
+
+#ifdef __cplusplus
+ pZip->m_pState->m_pMem = const_cast<void *>(pMem);
+#else
+ pZip->m_pState->m_pMem = (void *)pMem;
+#endif
+
+ pZip->m_pState->m_mem_size = size;
+
+ if (!mz_zip_reader_read_central_dir(pZip, flags))
+ {
+ mz_zip_reader_end_internal(pZip, MZ_FALSE);
+ return MZ_FALSE;
+ }
+
+ return MZ_TRUE;
+}
+
+#ifndef MINIZ_NO_STDIO
+static size_t mz_zip_file_read_func(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n)
+{
+ mz_zip_archive *pZip = (mz_zip_archive *)pOpaque;
+ mz_int64 cur_ofs = MZ_FTELL64(pZip->m_pState->m_pFile);
+
+ file_ofs += pZip->m_pState->m_file_archive_start_ofs;
+
+ if (((mz_int64)file_ofs < 0) || (((cur_ofs != (mz_int64)file_ofs)) && (MZ_FSEEK64(pZip->m_pState->m_pFile, (mz_int64)file_ofs, SEEK_SET))))
+ return 0;
+
+ return MZ_FREAD(pBuf, 1, n, pZip->m_pState->m_pFile);
+}
+
+mz_bool mz_zip_reader_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint32 flags)
+{
+ return mz_zip_reader_init_file_v2(pZip, pFilename, flags, 0, 0);
+}
+
+mz_bool mz_zip_reader_init_file_v2(mz_zip_archive *pZip, const char *pFilename, mz_uint flags, mz_uint64 file_start_ofs, mz_uint64 archive_size)
+{
+ mz_uint64 file_size;
+ MZ_FILE *pFile;
+
+ if ((!pZip) || (!pFilename) || ((archive_size) && (archive_size < MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pFile = MZ_FOPEN(pFilename, "rb");
+ if (!pFile)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_OPEN_FAILED);
+
+ file_size = archive_size;
+ if (!file_size)
+ {
+ if (MZ_FSEEK64(pFile, 0, SEEK_END))
+ {
+ MZ_FCLOSE(pFile);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_SEEK_FAILED);
+ }
+
+ file_size = MZ_FTELL64(pFile);
+ }
+
+ /* TODO: Better sanity check archive_size and the # of actual remaining bytes */
+
+ if (file_size < MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ {
+ MZ_FCLOSE(pFile);
+ return mz_zip_set_error(pZip, MZ_ZIP_NOT_AN_ARCHIVE);
+ }
+
+ if (!mz_zip_reader_init_internal(pZip, flags))
+ {
+ MZ_FCLOSE(pFile);
+ return MZ_FALSE;
+ }
+
+ pZip->m_zip_type = MZ_ZIP_TYPE_FILE;
+ pZip->m_pRead = mz_zip_file_read_func;
+ pZip->m_pIO_opaque = pZip;
+ pZip->m_pState->m_pFile = pFile;
+ pZip->m_archive_size = file_size;
+ pZip->m_pState->m_file_archive_start_ofs = file_start_ofs;
+
+ if (!mz_zip_reader_read_central_dir(pZip, flags))
+ {
+ mz_zip_reader_end_internal(pZip, MZ_FALSE);
+ return MZ_FALSE;
+ }
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_reader_init_cfile(mz_zip_archive *pZip, MZ_FILE *pFile, mz_uint64 archive_size, mz_uint flags)
+{
+ mz_uint64 cur_file_ofs;
+
+ if ((!pZip) || (!pFile))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_OPEN_FAILED);
+
+ cur_file_ofs = MZ_FTELL64(pFile);
+
+ if (!archive_size)
+ {
+ if (MZ_FSEEK64(pFile, 0, SEEK_END))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_SEEK_FAILED);
+
+ archive_size = MZ_FTELL64(pFile) - cur_file_ofs;
+
+ if (archive_size < MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_NOT_AN_ARCHIVE);
+ }
+
+ if (!mz_zip_reader_init_internal(pZip, flags))
+ return MZ_FALSE;
+
+ pZip->m_zip_type = MZ_ZIP_TYPE_CFILE;
+ pZip->m_pRead = mz_zip_file_read_func;
+
+ pZip->m_pIO_opaque = pZip;
+ pZip->m_pState->m_pFile = pFile;
+ pZip->m_archive_size = archive_size;
+ pZip->m_pState->m_file_archive_start_ofs = cur_file_ofs;
+
+ if (!mz_zip_reader_read_central_dir(pZip, flags))
+ {
+ mz_zip_reader_end_internal(pZip, MZ_FALSE);
+ return MZ_FALSE;
+ }
+
+ return MZ_TRUE;
+}
+
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+static MZ_FORCEINLINE const mz_uint8 *mz_zip_get_cdh(mz_zip_archive *pZip, mz_uint file_index)
+{
+ if ((!pZip) || (!pZip->m_pState) || (file_index >= pZip->m_total_files))
+ return NULL;
+ return &MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, file_index));
+}
+
+mz_bool mz_zip_reader_is_file_encrypted(mz_zip_archive *pZip, mz_uint file_index)
+{
+ mz_uint m_bit_flag;
+ const mz_uint8 *p = mz_zip_get_cdh(pZip, file_index);
+ if (!p)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ return MZ_FALSE;
+ }
+
+ m_bit_flag = MZ_READ_LE16(p + MZ_ZIP_CDH_BIT_FLAG_OFS);
+ return (m_bit_flag & (MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_IS_ENCRYPTED | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_USES_STRONG_ENCRYPTION)) != 0;
+}
+
+mz_bool mz_zip_reader_is_file_supported(mz_zip_archive *pZip, mz_uint file_index)
+{
+ mz_uint bit_flag;
+ mz_uint method;
+
+ const mz_uint8 *p = mz_zip_get_cdh(pZip, file_index);
+ if (!p)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ return MZ_FALSE;
+ }
+
+ method = MZ_READ_LE16(p + MZ_ZIP_CDH_METHOD_OFS);
+ bit_flag = MZ_READ_LE16(p + MZ_ZIP_CDH_BIT_FLAG_OFS);
+
+ if ((method != 0) && (method != MZ_DEFLATED))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_METHOD);
+ return MZ_FALSE;
+ }
+
+ if (bit_flag & (MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_IS_ENCRYPTED | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_USES_STRONG_ENCRYPTION))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_ENCRYPTION);
+ return MZ_FALSE;
+ }
+
+ if (bit_flag & MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_COMPRESSED_PATCH_FLAG)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_FEATURE);
+ return MZ_FALSE;
+ }
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_reader_is_file_a_directory(mz_zip_archive *pZip, mz_uint file_index)
+{
+ mz_uint filename_len, attribute_mapping_id, external_attr;
+ const mz_uint8 *p = mz_zip_get_cdh(pZip, file_index);
+ if (!p)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ return MZ_FALSE;
+ }
+
+ filename_len = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ if (filename_len)
+ {
+ if (*(p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_len - 1) == '/')
+ return MZ_TRUE;
+ }
+
+ /* Bugfix: This code was also checking if the internal attribute was non-zero, which wasn't correct. */
+ /* Most/all zip writers (hopefully) set DOS file/directory attributes in the low 16-bits, so check for the DOS directory flag and ignore the source OS ID in the created by field. */
+ /* FIXME: Remove this check? Is it necessary - we already check the filename. */
+ attribute_mapping_id = MZ_READ_LE16(p + MZ_ZIP_CDH_VERSION_MADE_BY_OFS) >> 8;
+ (void)attribute_mapping_id;
+
+ external_attr = MZ_READ_LE32(p + MZ_ZIP_CDH_EXTERNAL_ATTR_OFS);
+ if ((external_attr & MZ_ZIP_DOS_DIR_ATTRIBUTE_BITFLAG) != 0)
+ {
+ return MZ_TRUE;
+ }
+
+ return MZ_FALSE;
+}
+
+static mz_bool mz_zip_file_stat_internal(mz_zip_archive *pZip, mz_uint file_index, const mz_uint8 *pCentral_dir_header, mz_zip_archive_file_stat *pStat, mz_bool *pFound_zip64_extra_data)
+{
+ mz_uint n;
+ const mz_uint8 *p = pCentral_dir_header;
+
+ if (pFound_zip64_extra_data)
+ *pFound_zip64_extra_data = MZ_FALSE;
+
+ if ((!p) || (!pStat))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ /* Extract fields from the central directory record. */
+ pStat->m_file_index = file_index;
+ pStat->m_central_dir_ofs = MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, file_index);
+ pStat->m_version_made_by = MZ_READ_LE16(p + MZ_ZIP_CDH_VERSION_MADE_BY_OFS);
+ pStat->m_version_needed = MZ_READ_LE16(p + MZ_ZIP_CDH_VERSION_NEEDED_OFS);
+ pStat->m_bit_flag = MZ_READ_LE16(p + MZ_ZIP_CDH_BIT_FLAG_OFS);
+ pStat->m_method = MZ_READ_LE16(p + MZ_ZIP_CDH_METHOD_OFS);
+#ifndef MINIZ_NO_TIME
+ pStat->m_time = mz_zip_dos_to_time_t(MZ_READ_LE16(p + MZ_ZIP_CDH_FILE_TIME_OFS), MZ_READ_LE16(p + MZ_ZIP_CDH_FILE_DATE_OFS));
+#endif
+ pStat->m_crc32 = MZ_READ_LE32(p + MZ_ZIP_CDH_CRC32_OFS);
+ pStat->m_comp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS);
+ pStat->m_uncomp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS);
+ pStat->m_internal_attr = MZ_READ_LE16(p + MZ_ZIP_CDH_INTERNAL_ATTR_OFS);
+ pStat->m_external_attr = MZ_READ_LE32(p + MZ_ZIP_CDH_EXTERNAL_ATTR_OFS);
+ pStat->m_local_header_ofs = MZ_READ_LE32(p + MZ_ZIP_CDH_LOCAL_HEADER_OFS);
+
+ /* Copy as much of the filename and comment as possible. */
+ n = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ n = MZ_MIN(n, MZ_ZIP_MAX_ARCHIVE_FILENAME_SIZE - 1);
+ memcpy(pStat->m_filename, p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, n);
+ pStat->m_filename[n] = '\0';
+
+ n = MZ_READ_LE16(p + MZ_ZIP_CDH_COMMENT_LEN_OFS);
+ n = MZ_MIN(n, MZ_ZIP_MAX_ARCHIVE_FILE_COMMENT_SIZE - 1);
+ pStat->m_comment_size = n;
+ memcpy(pStat->m_comment, p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS) + MZ_READ_LE16(p + MZ_ZIP_CDH_EXTRA_LEN_OFS), n);
+ pStat->m_comment[n] = '\0';
+
+ /* Set some flags for convienance */
+ pStat->m_is_directory = mz_zip_reader_is_file_a_directory(pZip, file_index);
+ pStat->m_is_encrypted = mz_zip_reader_is_file_encrypted(pZip, file_index);
+ pStat->m_is_supported = mz_zip_reader_is_file_supported(pZip, file_index);
+
+ /* See if we need to read any zip64 extended information fields. */
+ /* Confusingly, these zip64 fields can be present even on non-zip64 archives (Debian zip on a huge files from stdin piped to stdout creates them). */
+ if (MZ_MAX(MZ_MAX(pStat->m_comp_size, pStat->m_uncomp_size), pStat->m_local_header_ofs) == MZ_UINT32_MAX)
+ {
+ /* Attempt to find zip64 extended information field in the entry's extra data */
+ mz_uint32 extra_size_remaining = MZ_READ_LE16(p + MZ_ZIP_CDH_EXTRA_LEN_OFS);
+
+ if (extra_size_remaining)
+ {
+ const mz_uint8 *pExtra_data = p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+
+ do
+ {
+ mz_uint32 field_id;
+ mz_uint32 field_data_size;
+
+ if (extra_size_remaining < (sizeof(mz_uint16) * 2))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ field_id = MZ_READ_LE16(pExtra_data);
+ field_data_size = MZ_READ_LE16(pExtra_data + sizeof(mz_uint16));
+
+ if ((field_data_size + sizeof(mz_uint16) * 2) > extra_size_remaining)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if (field_id == MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID)
+ {
+ const mz_uint8 *pField_data = pExtra_data + sizeof(mz_uint16) * 2;
+ mz_uint32 field_data_remaining = field_data_size;
+
+ if (pFound_zip64_extra_data)
+ *pFound_zip64_extra_data = MZ_TRUE;
+
+ if (pStat->m_uncomp_size == MZ_UINT32_MAX)
+ {
+ if (field_data_remaining < sizeof(mz_uint64))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ pStat->m_uncomp_size = MZ_READ_LE64(pField_data);
+ pField_data += sizeof(mz_uint64);
+ field_data_remaining -= sizeof(mz_uint64);
+ }
+
+ if (pStat->m_comp_size == MZ_UINT32_MAX)
+ {
+ if (field_data_remaining < sizeof(mz_uint64))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ pStat->m_comp_size = MZ_READ_LE64(pField_data);
+ pField_data += sizeof(mz_uint64);
+ field_data_remaining -= sizeof(mz_uint64);
+ }
+
+ if (pStat->m_local_header_ofs == MZ_UINT32_MAX)
+ {
+ if (field_data_remaining < sizeof(mz_uint64))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ pStat->m_local_header_ofs = MZ_READ_LE64(pField_data);
+ pField_data += sizeof(mz_uint64);
+ field_data_remaining -= sizeof(mz_uint64);
+ }
+
+ break;
+ }
+
+ pExtra_data += sizeof(mz_uint16) * 2 + field_data_size;
+ extra_size_remaining = extra_size_remaining - sizeof(mz_uint16) * 2 - field_data_size;
+ } while (extra_size_remaining);
+ }
+ }
+
+ return MZ_TRUE;
+}
+
+static MZ_FORCEINLINE mz_bool mz_zip_string_equal(const char *pA, const char *pB, mz_uint len, mz_uint flags)
+{
+ mz_uint i;
+ if (flags & MZ_ZIP_FLAG_CASE_SENSITIVE)
+ return 0 == memcmp(pA, pB, len);
+ for (i = 0; i < len; ++i)
+ if (MZ_TOLOWER(pA[i]) != MZ_TOLOWER(pB[i]))
+ return MZ_FALSE;
+ return MZ_TRUE;
+}
+
+static MZ_FORCEINLINE int mz_zip_filename_compare(const mz_zip_array *pCentral_dir_array, const mz_zip_array *pCentral_dir_offsets, mz_uint l_index, const char *pR, mz_uint r_len)
+{
+ const mz_uint8 *pL = &MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_array, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_offsets, mz_uint32, l_index)), *pE;
+ mz_uint l_len = MZ_READ_LE16(pL + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ mz_uint8 l = 0, r = 0;
+ pL += MZ_ZIP_CENTRAL_DIR_HEADER_SIZE;
+ pE = pL + MZ_MIN(l_len, r_len);
+ while (pL < pE)
+ {
+ if ((l = MZ_TOLOWER(*pL)) != (r = MZ_TOLOWER(*pR)))
+ break;
+ pL++;
+ pR++;
+ }
+ return (pL == pE) ? (int)(l_len - r_len) : (l - r);
+}
+
+static mz_bool mz_zip_locate_file_binary_search(mz_zip_archive *pZip, const char *pFilename, mz_uint32 *pIndex)
+{
+ mz_zip_internal_state *pState = pZip->m_pState;
+ const mz_zip_array *pCentral_dir_offsets = &pState->m_central_dir_offsets;
+ const mz_zip_array *pCentral_dir = &pState->m_central_dir;
+ mz_uint32 *pIndices = &MZ_ZIP_ARRAY_ELEMENT(&pState->m_sorted_central_dir_offsets, mz_uint32, 0);
+ const uint32_t size = pZip->m_total_files;
+ const mz_uint filename_len = (mz_uint)strlen(pFilename);
+
+ if (pIndex)
+ *pIndex = 0;
+
+ if (size)
+ {
+ /* yes I could use uint32_t's, but then we would have to add some special case checks in the loop, argh, and */
+ /* honestly the major expense here on 32-bit CPU's will still be the filename compare */
+ mz_int64 l = 0, h = (mz_int64)size - 1;
+
+ while (l <= h)
+ {
+ mz_int64 m = l + ((h - l) >> 1);
+ uint32_t file_index = pIndices[(uint32_t)m];
+
+ int comp = mz_zip_filename_compare(pCentral_dir, pCentral_dir_offsets, file_index, pFilename, filename_len);
+ if (!comp)
+ {
+ if (pIndex)
+ *pIndex = file_index;
+ return MZ_TRUE;
+ }
+ else if (comp < 0)
+ l = m + 1;
+ else
+ h = m - 1;
+ }
+ }
+
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_NOT_FOUND);
+}
+
+int mz_zip_reader_locate_file(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags)
+{
+ mz_uint32 index;
+ if (!mz_zip_reader_locate_file_v2(pZip, pName, pComment, flags, &index))
+ return -1;
+ else
+ return (int)index;
+}
+
+mz_bool mz_zip_reader_locate_file_v2(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags, mz_uint32 *pIndex)
+{
+ mz_uint file_index;
+ size_t name_len, comment_len;
+
+ if (pIndex)
+ *pIndex = 0;
+
+ if ((!pZip) || (!pZip->m_pState) || (!pName))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ /* See if we can use a binary search */
+ if (((pZip->m_pState->m_init_flags & MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY) == 0) &&
+ (pZip->m_zip_mode == MZ_ZIP_MODE_READING) &&
+ ((flags & (MZ_ZIP_FLAG_IGNORE_PATH | MZ_ZIP_FLAG_CASE_SENSITIVE)) == 0) && (!pComment) && (pZip->m_pState->m_sorted_central_dir_offsets.m_size))
+ {
+ return mz_zip_locate_file_binary_search(pZip, pName, pIndex);
+ }
+
+ /* Locate the entry by scanning the entire central directory */
+ name_len = strlen(pName);
+ if (name_len > MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ comment_len = pComment ? strlen(pComment) : 0;
+ if (comment_len > MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ for (file_index = 0; file_index < pZip->m_total_files; file_index++)
+ {
+ const mz_uint8 *pHeader = &MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, file_index));
+ mz_uint filename_len = MZ_READ_LE16(pHeader + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ const char *pFilename = (const char *)pHeader + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE;
+ if (filename_len < name_len)
+ continue;
+ if (comment_len)
+ {
+ mz_uint file_extra_len = MZ_READ_LE16(pHeader + MZ_ZIP_CDH_EXTRA_LEN_OFS), file_comment_len = MZ_READ_LE16(pHeader + MZ_ZIP_CDH_COMMENT_LEN_OFS);
+ const char *pFile_comment = pFilename + filename_len + file_extra_len;
+ if ((file_comment_len != comment_len) || (!mz_zip_string_equal(pComment, pFile_comment, file_comment_len, flags)))
+ continue;
+ }
+ if ((flags & MZ_ZIP_FLAG_IGNORE_PATH) && (filename_len))
+ {
+ int ofs = filename_len - 1;
+ do
+ {
+ if ((pFilename[ofs] == '/') || (pFilename[ofs] == '\\') || (pFilename[ofs] == ':'))
+ break;
+ } while (--ofs >= 0);
+ ofs++;
+ pFilename += ofs;
+ filename_len -= ofs;
+ }
+ if ((filename_len == name_len) && (mz_zip_string_equal(pName, pFilename, filename_len, flags)))
+ {
+ if (pIndex)
+ *pIndex = file_index;
+ return MZ_TRUE;
+ }
+ }
+
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_NOT_FOUND);
+}
+
+mz_bool mz_zip_reader_extract_to_mem_no_alloc(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size)
+{
+ int status = TINFL_STATUS_DONE;
+ mz_uint64 needed_size, cur_file_ofs, comp_remaining, out_buf_ofs = 0, read_buf_size, read_buf_ofs = 0, read_buf_avail;
+ mz_zip_archive_file_stat file_stat;
+ void *pRead_buf;
+ mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32;
+ tinfl_decompressor inflator;
+
+ if ((!pZip) || (!pZip->m_pState) || ((buf_size) && (!pBuf)) || ((user_read_buf_size) && (!pUser_read_buf)) || (!pZip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat))
+ return MZ_FALSE;
+
+ /* A directory or zero length file */
+ if ((file_stat.m_is_directory) || (!file_stat.m_comp_size))
+ return MZ_TRUE;
+
+ /* Encryption and patch files are not supported. */
+ if (file_stat.m_bit_flag & (MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_IS_ENCRYPTED | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_USES_STRONG_ENCRYPTION | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_COMPRESSED_PATCH_FLAG))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_ENCRYPTION);
+
+ /* This function only supports decompressing stored and deflate. */
+ if ((!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (file_stat.m_method != 0) && (file_stat.m_method != MZ_DEFLATED))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_METHOD);
+
+ /* Ensure supplied output buffer is large enough. */
+ needed_size = (flags & MZ_ZIP_FLAG_COMPRESSED_DATA) ? file_stat.m_comp_size : file_stat.m_uncomp_size;
+ if (buf_size < needed_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_BUF_TOO_SMALL);
+
+ /* Read and parse the local directory entry. */
+ cur_file_ofs = file_stat.m_local_header_ofs;
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+ if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ cur_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS);
+ if ((cur_file_ofs + file_stat.m_comp_size) > pZip->m_archive_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if ((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!file_stat.m_method))
+ {
+ /* The file is stored or the caller has requested the compressed data. */
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pBuf, (size_t)needed_size) != needed_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ if ((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) == 0)
+ {
+ if (mz_crc32(MZ_CRC32_INIT, (const mz_uint8 *)pBuf, (size_t)file_stat.m_uncomp_size) != file_stat.m_crc32)
+ return mz_zip_set_error(pZip, MZ_ZIP_CRC_CHECK_FAILED);
+ }
+#endif
+
+ return MZ_TRUE;
+ }
+
+ /* Decompress the file either directly from memory or from a file input buffer. */
+ tinfl_init(&inflator);
+
+ if (pZip->m_pState->m_pMem)
+ {
+ /* Read directly from the archive in memory. */
+ pRead_buf = (mz_uint8 *)pZip->m_pState->m_pMem + cur_file_ofs;
+ read_buf_size = read_buf_avail = file_stat.m_comp_size;
+ comp_remaining = 0;
+ }
+ else if (pUser_read_buf)
+ {
+ /* Use a user provided read buffer. */
+ if (!user_read_buf_size)
+ return MZ_FALSE;
+ pRead_buf = (mz_uint8 *)pUser_read_buf;
+ read_buf_size = user_read_buf_size;
+ read_buf_avail = 0;
+ comp_remaining = file_stat.m_comp_size;
+ }
+ else
+ {
+ /* Temporarily allocate a read buffer. */
+ read_buf_size = MZ_MIN(file_stat.m_comp_size, (mz_uint64)MZ_ZIP_MAX_IO_BUF_SIZE);
+ if (((sizeof(size_t) == sizeof(mz_uint32))) && (read_buf_size > 0x7FFFFFFF))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if (NULL == (pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)read_buf_size)))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ read_buf_avail = 0;
+ comp_remaining = file_stat.m_comp_size;
+ }
+
+ do
+ {
+ /* The size_t cast here should be OK because we've verified that the output buffer is >= file_stat.m_uncomp_size above */
+ size_t in_buf_size, out_buf_size = (size_t)(file_stat.m_uncomp_size - out_buf_ofs);
+ if ((!read_buf_avail) && (!pZip->m_pState->m_pMem))
+ {
+ read_buf_avail = MZ_MIN(read_buf_size, comp_remaining);
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail)
+ {
+ status = TINFL_STATUS_FAILED;
+ mz_zip_set_error(pZip, MZ_ZIP_DECOMPRESSION_FAILED);
+ break;
+ }
+ cur_file_ofs += read_buf_avail;
+ comp_remaining -= read_buf_avail;
+ read_buf_ofs = 0;
+ }
+ in_buf_size = (size_t)read_buf_avail;
+ status = tinfl_decompress(&inflator, (mz_uint8 *)pRead_buf + read_buf_ofs, &in_buf_size, (mz_uint8 *)pBuf, (mz_uint8 *)pBuf + out_buf_ofs, &out_buf_size, TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF | (comp_remaining ? TINFL_FLAG_HAS_MORE_INPUT : 0));
+ read_buf_avail -= in_buf_size;
+ read_buf_ofs += in_buf_size;
+ out_buf_ofs += out_buf_size;
+ } while (status == TINFL_STATUS_NEEDS_MORE_INPUT);
+
+ if (status == TINFL_STATUS_DONE)
+ {
+ /* Make sure the entire file was decompressed, and check its CRC. */
+ if (out_buf_ofs != file_stat.m_uncomp_size)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNEXPECTED_DECOMPRESSED_SIZE);
+ status = TINFL_STATUS_FAILED;
+ }
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ else if (mz_crc32(MZ_CRC32_INIT, (const mz_uint8 *)pBuf, (size_t)file_stat.m_uncomp_size) != file_stat.m_crc32)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_CRC_CHECK_FAILED);
+ status = TINFL_STATUS_FAILED;
+ }
+#endif
+ }
+
+ if ((!pZip->m_pState->m_pMem) && (!pUser_read_buf))
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+
+ return status == TINFL_STATUS_DONE;
+}
+
+mz_bool mz_zip_reader_extract_file_to_mem_no_alloc(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size)
+{
+ mz_uint32 file_index;
+ if (!mz_zip_reader_locate_file_v2(pZip, pFilename, NULL, flags, &file_index))
+ return MZ_FALSE;
+ return mz_zip_reader_extract_to_mem_no_alloc(pZip, file_index, pBuf, buf_size, flags, pUser_read_buf, user_read_buf_size);
+}
+
+mz_bool mz_zip_reader_extract_to_mem(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags)
+{
+ return mz_zip_reader_extract_to_mem_no_alloc(pZip, file_index, pBuf, buf_size, flags, NULL, 0);
+}
+
+mz_bool mz_zip_reader_extract_file_to_mem(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags)
+{
+ return mz_zip_reader_extract_file_to_mem_no_alloc(pZip, pFilename, pBuf, buf_size, flags, NULL, 0);
+}
+
+void *mz_zip_reader_extract_to_heap(mz_zip_archive *pZip, mz_uint file_index, size_t *pSize, mz_uint flags)
+{
+ mz_uint64 comp_size, uncomp_size, alloc_size;
+ const mz_uint8 *p = mz_zip_get_cdh(pZip, file_index);
+ void *pBuf;
+
+ if (pSize)
+ *pSize = 0;
+
+ if (!p)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ return NULL;
+ }
+
+ comp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS);
+ uncomp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS);
+
+ alloc_size = (flags & MZ_ZIP_FLAG_COMPRESSED_DATA) ? comp_size : uncomp_size;
+ if (((sizeof(size_t) == sizeof(mz_uint32))) && (alloc_size > 0x7FFFFFFF))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+ return NULL;
+ }
+
+ if (NULL == (pBuf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)alloc_size)))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ return NULL;
+ }
+
+ if (!mz_zip_reader_extract_to_mem(pZip, file_index, pBuf, (size_t)alloc_size, flags))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+ return NULL;
+ }
+
+ if (pSize)
+ *pSize = (size_t)alloc_size;
+ return pBuf;
+}
+
+void *mz_zip_reader_extract_file_to_heap(mz_zip_archive *pZip, const char *pFilename, size_t *pSize, mz_uint flags)
+{
+ mz_uint32 file_index;
+ if (!mz_zip_reader_locate_file_v2(pZip, pFilename, NULL, flags, &file_index))
+ {
+ if (pSize)
+ *pSize = 0;
+ return MZ_FALSE;
+ }
+ return mz_zip_reader_extract_to_heap(pZip, file_index, pSize, flags);
+}
+
+mz_bool mz_zip_reader_extract_to_callback(mz_zip_archive *pZip, mz_uint file_index, mz_file_write_func pCallback, void *pOpaque, mz_uint flags)
+{
+ int status = TINFL_STATUS_DONE;
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ mz_uint file_crc32 = MZ_CRC32_INIT;
+#endif
+ mz_uint64 read_buf_size, read_buf_ofs = 0, read_buf_avail, comp_remaining, out_buf_ofs = 0, cur_file_ofs;
+ mz_zip_archive_file_stat file_stat;
+ void *pRead_buf = NULL;
+ void *pWrite_buf = NULL;
+ mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32;
+
+ if ((!pZip) || (!pZip->m_pState) || (!pCallback) || (!pZip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat))
+ return MZ_FALSE;
+
+ /* A directory or zero length file */
+ if ((file_stat.m_is_directory) || (!file_stat.m_comp_size))
+ return MZ_TRUE;
+
+ /* Encryption and patch files are not supported. */
+ if (file_stat.m_bit_flag & (MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_IS_ENCRYPTED | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_USES_STRONG_ENCRYPTION | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_COMPRESSED_PATCH_FLAG))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_ENCRYPTION);
+
+ /* This function only supports decompressing stored and deflate. */
+ if ((!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (file_stat.m_method != 0) && (file_stat.m_method != MZ_DEFLATED))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_METHOD);
+
+ /* Read and do some minimal validation of the local directory entry (this doesn't crack the zip64 stuff, which we already have from the central dir) */
+ cur_file_ofs = file_stat.m_local_header_ofs;
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+ if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ cur_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS);
+ if ((cur_file_ofs + file_stat.m_comp_size) > pZip->m_archive_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ /* Decompress the file either directly from memory or from a file input buffer. */
+ if (pZip->m_pState->m_pMem)
+ {
+ pRead_buf = (mz_uint8 *)pZip->m_pState->m_pMem + cur_file_ofs;
+ read_buf_size = read_buf_avail = file_stat.m_comp_size;
+ comp_remaining = 0;
+ }
+ else
+ {
+ read_buf_size = MZ_MIN(file_stat.m_comp_size, (mz_uint64)MZ_ZIP_MAX_IO_BUF_SIZE);
+ if (NULL == (pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)read_buf_size)))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ read_buf_avail = 0;
+ comp_remaining = file_stat.m_comp_size;
+ }
+
+ if ((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!file_stat.m_method))
+ {
+ /* The file is stored or the caller has requested the compressed data. */
+ if (pZip->m_pState->m_pMem)
+ {
+ if (((sizeof(size_t) == sizeof(mz_uint32))) && (file_stat.m_comp_size > MZ_UINT32_MAX))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if (pCallback(pOpaque, out_buf_ofs, pRead_buf, (size_t)file_stat.m_comp_size) != file_stat.m_comp_size)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_WRITE_CALLBACK_FAILED);
+ status = TINFL_STATUS_FAILED;
+ }
+ else if (!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA))
+ {
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ file_crc32 = (mz_uint32)mz_crc32(file_crc32, (const mz_uint8 *)pRead_buf, (size_t)file_stat.m_comp_size);
+#endif
+ }
+
+ cur_file_ofs += file_stat.m_comp_size;
+ out_buf_ofs += file_stat.m_comp_size;
+ comp_remaining = 0;
+ }
+ else
+ {
+ while (comp_remaining)
+ {
+ read_buf_avail = MZ_MIN(read_buf_size, comp_remaining);
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ status = TINFL_STATUS_FAILED;
+ break;
+ }
+
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ if (!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA))
+ {
+ file_crc32 = (mz_uint32)mz_crc32(file_crc32, (const mz_uint8 *)pRead_buf, (size_t)read_buf_avail);
+ }
+#endif
+
+ if (pCallback(pOpaque, out_buf_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_WRITE_CALLBACK_FAILED);
+ status = TINFL_STATUS_FAILED;
+ break;
+ }
+
+ cur_file_ofs += read_buf_avail;
+ out_buf_ofs += read_buf_avail;
+ comp_remaining -= read_buf_avail;
+ }
+ }
+ }
+ else
+ {
+ tinfl_decompressor inflator;
+ tinfl_init(&inflator);
+
+ if (NULL == (pWrite_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, TINFL_LZ_DICT_SIZE)))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ status = TINFL_STATUS_FAILED;
+ }
+ else
+ {
+ do
+ {
+ mz_uint8 *pWrite_buf_cur = (mz_uint8 *)pWrite_buf + (out_buf_ofs & (TINFL_LZ_DICT_SIZE - 1));
+ size_t in_buf_size, out_buf_size = TINFL_LZ_DICT_SIZE - (out_buf_ofs & (TINFL_LZ_DICT_SIZE - 1));
+ if ((!read_buf_avail) && (!pZip->m_pState->m_pMem))
+ {
+ read_buf_avail = MZ_MIN(read_buf_size, comp_remaining);
+ if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ status = TINFL_STATUS_FAILED;
+ break;
+ }
+ cur_file_ofs += read_buf_avail;
+ comp_remaining -= read_buf_avail;
+ read_buf_ofs = 0;
+ }
+
+ in_buf_size = (size_t)read_buf_avail;
+ status = tinfl_decompress(&inflator, (const mz_uint8 *)pRead_buf + read_buf_ofs, &in_buf_size, (mz_uint8 *)pWrite_buf, pWrite_buf_cur, &out_buf_size, comp_remaining ? TINFL_FLAG_HAS_MORE_INPUT : 0);
+ read_buf_avail -= in_buf_size;
+ read_buf_ofs += in_buf_size;
+
+ if (out_buf_size)
+ {
+ if (pCallback(pOpaque, out_buf_ofs, pWrite_buf_cur, out_buf_size) != out_buf_size)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_WRITE_CALLBACK_FAILED);
+ status = TINFL_STATUS_FAILED;
+ break;
+ }
+
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ file_crc32 = (mz_uint32)mz_crc32(file_crc32, pWrite_buf_cur, out_buf_size);
+#endif
+ if ((out_buf_ofs += out_buf_size) > file_stat.m_uncomp_size)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_DECOMPRESSION_FAILED);
+ status = TINFL_STATUS_FAILED;
+ break;
+ }
+ }
+ } while ((status == TINFL_STATUS_NEEDS_MORE_INPUT) || (status == TINFL_STATUS_HAS_MORE_OUTPUT));
+ }
+ }
+
+ if ((status == TINFL_STATUS_DONE) && (!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)))
+ {
+ /* Make sure the entire file was decompressed, and check its CRC. */
+ if (out_buf_ofs != file_stat.m_uncomp_size)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNEXPECTED_DECOMPRESSED_SIZE);
+ status = TINFL_STATUS_FAILED;
+ }
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ else if (file_crc32 != file_stat.m_crc32)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_DECOMPRESSION_FAILED);
+ status = TINFL_STATUS_FAILED;
+ }
+#endif
+ }
+
+ if (!pZip->m_pState->m_pMem)
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+
+ if (pWrite_buf)
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pWrite_buf);
+
+ return status == TINFL_STATUS_DONE;
+}
+
+mz_bool mz_zip_reader_extract_file_to_callback(mz_zip_archive *pZip, const char *pFilename, mz_file_write_func pCallback, void *pOpaque, mz_uint flags)
+{
+ mz_uint32 file_index;
+ if (!mz_zip_reader_locate_file_v2(pZip, pFilename, NULL, flags, &file_index))
+ return MZ_FALSE;
+
+ return mz_zip_reader_extract_to_callback(pZip, file_index, pCallback, pOpaque, flags);
+}
+
+mz_zip_reader_extract_iter_state* mz_zip_reader_extract_iter_new(mz_zip_archive *pZip, mz_uint file_index, mz_uint flags)
+{
+ mz_zip_reader_extract_iter_state *pState;
+ mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32;
+
+ /* Argument sanity check */
+ if ((!pZip) || (!pZip->m_pState))
+ return NULL;
+
+ /* Allocate an iterator status structure */
+ pState = (mz_zip_reader_extract_iter_state*)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(mz_zip_reader_extract_iter_state));
+ if (!pState)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ return NULL;
+ }
+
+ /* Fetch file details */
+ if (!mz_zip_reader_file_stat(pZip, file_index, &pState->file_stat))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+
+ /* Encryption and patch files are not supported. */
+ if (pState->file_stat.m_bit_flag & (MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_IS_ENCRYPTED | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_USES_STRONG_ENCRYPTION | MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_COMPRESSED_PATCH_FLAG))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_ENCRYPTION);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+
+ /* This function only supports decompressing stored and deflate. */
+ if ((!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (pState->file_stat.m_method != 0) && (pState->file_stat.m_method != MZ_DEFLATED))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_METHOD);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+
+ /* Init state - save args */
+ pState->pZip = pZip;
+ pState->flags = flags;
+
+ /* Init state - reset variables to defaults */
+ pState->status = TINFL_STATUS_DONE;
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ pState->file_crc32 = MZ_CRC32_INIT;
+#endif
+ pState->read_buf_ofs = 0;
+ pState->out_buf_ofs = 0;
+ pState->pRead_buf = NULL;
+ pState->pWrite_buf = NULL;
+ pState->out_blk_remain = 0;
+
+ /* Read and parse the local directory entry. */
+ pState->cur_file_ofs = pState->file_stat.m_local_header_ofs;
+ if (pZip->m_pRead(pZip->m_pIO_opaque, pState->cur_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+
+ if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+
+ pState->cur_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS);
+ if ((pState->cur_file_ofs + pState->file_stat.m_comp_size) > pZip->m_archive_size)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+
+ /* Decompress the file either directly from memory or from a file input buffer. */
+ if (pZip->m_pState->m_pMem)
+ {
+ pState->pRead_buf = (mz_uint8 *)pZip->m_pState->m_pMem + pState->cur_file_ofs;
+ pState->read_buf_size = pState->read_buf_avail = pState->file_stat.m_comp_size;
+ pState->comp_remaining = pState->file_stat.m_comp_size;
+ }
+ else
+ {
+ if (!((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!pState->file_stat.m_method)))
+ {
+ /* Decompression required, therefore intermediate read buffer required */
+ pState->read_buf_size = MZ_MIN(pState->file_stat.m_comp_size, (mz_uint64)MZ_ZIP_MAX_IO_BUF_SIZE);
+ if (NULL == (pState->pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)pState->read_buf_size)))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+ }
+ else
+ {
+ /* Decompression not required - we will be reading directly into user buffer, no temp buf required */
+ pState->read_buf_size = 0;
+ }
+ pState->read_buf_avail = 0;
+ pState->comp_remaining = pState->file_stat.m_comp_size;
+ }
+
+ if (!((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!pState->file_stat.m_method)))
+ {
+ /* Decompression required, init decompressor */
+ tinfl_init( &pState->inflator );
+
+ /* Allocate write buffer */
+ if (NULL == (pState->pWrite_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, TINFL_LZ_DICT_SIZE)))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ if (pState->pRead_buf)
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState->pRead_buf);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ return NULL;
+ }
+ }
+
+ return pState;
+}
+
+mz_zip_reader_extract_iter_state* mz_zip_reader_extract_file_iter_new(mz_zip_archive *pZip, const char *pFilename, mz_uint flags)
+{
+ mz_uint32 file_index;
+
+ /* Locate file index by name */
+ if (!mz_zip_reader_locate_file_v2(pZip, pFilename, NULL, flags, &file_index))
+ return NULL;
+
+ /* Construct iterator */
+ return mz_zip_reader_extract_iter_new(pZip, file_index, flags);
+}
+
+size_t mz_zip_reader_extract_iter_read(mz_zip_reader_extract_iter_state* pState, void* pvBuf, size_t buf_size)
+{
+ size_t copied_to_caller = 0;
+
+ /* Argument sanity check */
+ if ((!pState) || (!pState->pZip) || (!pState->pZip->m_pState) || (!pvBuf))
+ return 0;
+
+ if ((pState->flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!pState->file_stat.m_method))
+ {
+ /* The file is stored or the caller has requested the compressed data, calc amount to return. */
+ copied_to_caller = (size_t)MZ_MIN( buf_size, pState->comp_remaining );
+
+ /* Zip is in memory....or requires reading from a file? */
+ if (pState->pZip->m_pState->m_pMem)
+ {
+ /* Copy data to caller's buffer */
+ memcpy( pvBuf, pState->pRead_buf, copied_to_caller );
+ pState->pRead_buf = ((mz_uint8*)pState->pRead_buf) + copied_to_caller;
+ }
+ else
+ {
+ /* Read directly into caller's buffer */
+ if (pState->pZip->m_pRead(pState->pZip->m_pIO_opaque, pState->cur_file_ofs, pvBuf, copied_to_caller) != copied_to_caller)
+ {
+ /* Failed to read all that was asked for, flag failure and alert user */
+ mz_zip_set_error(pState->pZip, MZ_ZIP_FILE_READ_FAILED);
+ pState->status = TINFL_STATUS_FAILED;
+ copied_to_caller = 0;
+ }
+ }
+
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ /* Compute CRC if not returning compressed data only */
+ if (!(pState->flags & MZ_ZIP_FLAG_COMPRESSED_DATA))
+ pState->file_crc32 = (mz_uint32)mz_crc32(pState->file_crc32, (const mz_uint8 *)pvBuf, copied_to_caller);
+#endif
+
+ /* Advance offsets, dec counters */
+ pState->cur_file_ofs += copied_to_caller;
+ pState->out_buf_ofs += copied_to_caller;
+ pState->comp_remaining -= copied_to_caller;
+ }
+ else
+ {
+ do
+ {
+ /* Calc ptr to write buffer - given current output pos and block size */
+ mz_uint8 *pWrite_buf_cur = (mz_uint8 *)pState->pWrite_buf + (pState->out_buf_ofs & (TINFL_LZ_DICT_SIZE - 1));
+
+ /* Calc max output size - given current output pos and block size */
+ size_t in_buf_size, out_buf_size = TINFL_LZ_DICT_SIZE - (pState->out_buf_ofs & (TINFL_LZ_DICT_SIZE - 1));
+
+ if (!pState->out_blk_remain)
+ {
+ /* Read more data from file if none available (and reading from file) */
+ if ((!pState->read_buf_avail) && (!pState->pZip->m_pState->m_pMem))
+ {
+ /* Calc read size */
+ pState->read_buf_avail = MZ_MIN(pState->read_buf_size, pState->comp_remaining);
+ if (pState->pZip->m_pRead(pState->pZip->m_pIO_opaque, pState->cur_file_ofs, pState->pRead_buf, (size_t)pState->read_buf_avail) != pState->read_buf_avail)
+ {
+ mz_zip_set_error(pState->pZip, MZ_ZIP_FILE_READ_FAILED);
+ pState->status = TINFL_STATUS_FAILED;
+ break;
+ }
+
+ /* Advance offsets, dec counters */
+ pState->cur_file_ofs += pState->read_buf_avail;
+ pState->comp_remaining -= pState->read_buf_avail;
+ pState->read_buf_ofs = 0;
+ }
+
+ /* Perform decompression */
+ in_buf_size = (size_t)pState->read_buf_avail;
+ pState->status = tinfl_decompress(&pState->inflator, (const mz_uint8 *)pState->pRead_buf + pState->read_buf_ofs, &in_buf_size, (mz_uint8 *)pState->pWrite_buf, pWrite_buf_cur, &out_buf_size, pState->comp_remaining ? TINFL_FLAG_HAS_MORE_INPUT : 0);
+ pState->read_buf_avail -= in_buf_size;
+ pState->read_buf_ofs += in_buf_size;
+
+ /* Update current output block size remaining */
+ pState->out_blk_remain = out_buf_size;
+ }
+
+ if (pState->out_blk_remain)
+ {
+ /* Calc amount to return. */
+ size_t to_copy = MZ_MIN( (buf_size - copied_to_caller), pState->out_blk_remain );
+
+ /* Copy data to caller's buffer */
+ memcpy( (uint8_t*)pvBuf + copied_to_caller, pWrite_buf_cur, to_copy );
+
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ /* Perform CRC */
+ pState->file_crc32 = (mz_uint32)mz_crc32(pState->file_crc32, pWrite_buf_cur, to_copy);
+#endif
+
+ /* Decrement data consumed from block */
+ pState->out_blk_remain -= to_copy;
+
+ /* Inc output offset, while performing sanity check */
+ if ((pState->out_buf_ofs += to_copy) > pState->file_stat.m_uncomp_size)
+ {
+ mz_zip_set_error(pState->pZip, MZ_ZIP_DECOMPRESSION_FAILED);
+ pState->status = TINFL_STATUS_FAILED;
+ break;
+ }
+
+ /* Increment counter of data copied to caller */
+ copied_to_caller += to_copy;
+ }
+ } while ( (copied_to_caller < buf_size) && ((pState->status == TINFL_STATUS_NEEDS_MORE_INPUT) || (pState->status == TINFL_STATUS_HAS_MORE_OUTPUT)) );
+ }
+
+ /* Return how many bytes were copied into user buffer */
+ return copied_to_caller;
+}
+
+mz_bool mz_zip_reader_extract_iter_free(mz_zip_reader_extract_iter_state* pState)
+{
+ int status;
+
+ /* Argument sanity check */
+ if ((!pState) || (!pState->pZip) || (!pState->pZip->m_pState))
+ return MZ_FALSE;
+
+ /* Was decompression completed and requested? */
+ if ((pState->status == TINFL_STATUS_DONE) && (!(pState->flags & MZ_ZIP_FLAG_COMPRESSED_DATA)))
+ {
+ /* Make sure the entire file was decompressed, and check its CRC. */
+ if (pState->out_buf_ofs != pState->file_stat.m_uncomp_size)
+ {
+ mz_zip_set_error(pState->pZip, MZ_ZIP_UNEXPECTED_DECOMPRESSED_SIZE);
+ pState->status = TINFL_STATUS_FAILED;
+ }
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ else if (pState->file_crc32 != pState->file_stat.m_crc32)
+ {
+ mz_zip_set_error(pState->pZip, MZ_ZIP_DECOMPRESSION_FAILED);
+ pState->status = TINFL_STATUS_FAILED;
+ }
+#endif
+ }
+
+ /* Free buffers */
+ if (!pState->pZip->m_pState->m_pMem)
+ pState->pZip->m_pFree(pState->pZip->m_pAlloc_opaque, pState->pRead_buf);
+ if (pState->pWrite_buf)
+ pState->pZip->m_pFree(pState->pZip->m_pAlloc_opaque, pState->pWrite_buf);
+
+ /* Save status */
+ status = pState->status;
+
+ /* Free context */
+ pState->pZip->m_pFree(pState->pZip->m_pAlloc_opaque, pState);
+
+ return status == TINFL_STATUS_DONE;
+}
+
+#ifndef MINIZ_NO_STDIO
+static size_t mz_zip_file_write_callback(void *pOpaque, mz_uint64 ofs, const void *pBuf, size_t n)
+{
+ (void)ofs;
+
+ return MZ_FWRITE(pBuf, 1, n, (MZ_FILE *)pOpaque);
+}
+
+mz_bool mz_zip_reader_extract_to_file(mz_zip_archive *pZip, mz_uint file_index, const char *pDst_filename, mz_uint flags)
+{
+ mz_bool status;
+ mz_zip_archive_file_stat file_stat;
+ MZ_FILE *pFile;
+
+ if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat))
+ return MZ_FALSE;
+
+ if ((file_stat.m_is_directory) || (!file_stat.m_is_supported))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_FEATURE);
+
+ pFile = MZ_FOPEN(pDst_filename, "wb");
+ if (!pFile)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_OPEN_FAILED);
+
+ status = mz_zip_reader_extract_to_callback(pZip, file_index, mz_zip_file_write_callback, pFile, flags);
+
+ if (MZ_FCLOSE(pFile) == EOF)
+ {
+ if (status)
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_CLOSE_FAILED);
+
+ status = MZ_FALSE;
+ }
+
+#if !defined(MINIZ_NO_TIME) && !defined(MINIZ_NO_STDIO)
+ if (status)
+ mz_zip_set_file_times(pDst_filename, file_stat.m_time, file_stat.m_time);
+#endif
+
+ return status;
+}
+
+mz_bool mz_zip_reader_extract_file_to_file(mz_zip_archive *pZip, const char *pArchive_filename, const char *pDst_filename, mz_uint flags)
+{
+ mz_uint32 file_index;
+ if (!mz_zip_reader_locate_file_v2(pZip, pArchive_filename, NULL, flags, &file_index))
+ return MZ_FALSE;
+
+ return mz_zip_reader_extract_to_file(pZip, file_index, pDst_filename, flags);
+}
+
+mz_bool mz_zip_reader_extract_to_cfile(mz_zip_archive *pZip, mz_uint file_index, MZ_FILE *pFile, mz_uint flags)
+{
+ mz_zip_archive_file_stat file_stat;
+
+ if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat))
+ return MZ_FALSE;
+
+ if ((file_stat.m_is_directory) || (!file_stat.m_is_supported))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_FEATURE);
+
+ return mz_zip_reader_extract_to_callback(pZip, file_index, mz_zip_file_write_callback, pFile, flags);
+}
+
+mz_bool mz_zip_reader_extract_file_to_cfile(mz_zip_archive *pZip, const char *pArchive_filename, MZ_FILE *pFile, mz_uint flags)
+{
+ mz_uint32 file_index;
+ if (!mz_zip_reader_locate_file_v2(pZip, pArchive_filename, NULL, flags, &file_index))
+ return MZ_FALSE;
+
+ return mz_zip_reader_extract_to_cfile(pZip, file_index, pFile, flags);
+}
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+static size_t mz_zip_compute_crc32_callback(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n)
+{
+ mz_uint32 *p = (mz_uint32 *)pOpaque;
+ (void)file_ofs;
+ *p = (mz_uint32)mz_crc32(*p, (const mz_uint8 *)pBuf, n);
+ return n;
+}
+
+mz_bool mz_zip_validate_file(mz_zip_archive *pZip, mz_uint file_index, mz_uint flags)
+{
+ mz_zip_archive_file_stat file_stat;
+ mz_zip_internal_state *pState;
+ const mz_uint8 *pCentral_dir_header;
+ mz_bool found_zip64_ext_data_in_cdir = MZ_FALSE;
+ mz_bool found_zip64_ext_data_in_ldir = MZ_FALSE;
+ mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32;
+ mz_uint64 local_header_ofs = 0;
+ mz_uint32 local_header_filename_len, local_header_extra_len, local_header_crc32;
+ mz_uint64 local_header_comp_size, local_header_uncomp_size;
+ mz_uint32 uncomp_crc32 = MZ_CRC32_INIT;
+ mz_bool has_data_descriptor;
+ mz_uint32 local_header_bit_flags;
+
+ mz_zip_array file_data_array;
+ mz_zip_array_init(&file_data_array, 1);
+
+ if ((!pZip) || (!pZip->m_pState) || (!pZip->m_pAlloc) || (!pZip->m_pFree) || (!pZip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (file_index > pZip->m_total_files)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState = pZip->m_pState;
+
+ pCentral_dir_header = mz_zip_get_cdh(pZip, file_index);
+
+ if (!mz_zip_file_stat_internal(pZip, file_index, pCentral_dir_header, &file_stat, &found_zip64_ext_data_in_cdir))
+ return MZ_FALSE;
+
+ /* A directory or zero length file */
+ if ((file_stat.m_is_directory) || (!file_stat.m_uncomp_size))
+ return MZ_TRUE;
+
+ /* Encryption and patch files are not supported. */
+ if (file_stat.m_is_encrypted)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_ENCRYPTION);
+
+ /* This function only supports stored and deflate. */
+ if ((file_stat.m_method != 0) && (file_stat.m_method != MZ_DEFLATED))
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_METHOD);
+
+ if (!file_stat.m_is_supported)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_FEATURE);
+
+ /* Read and parse the local directory entry. */
+ local_header_ofs = file_stat.m_local_header_ofs;
+ if (pZip->m_pRead(pZip->m_pIO_opaque, local_header_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+ if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ local_header_filename_len = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS);
+ local_header_extra_len = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS);
+ local_header_comp_size = MZ_READ_LE32(pLocal_header + MZ_ZIP_LDH_COMPRESSED_SIZE_OFS);
+ local_header_uncomp_size = MZ_READ_LE32(pLocal_header + MZ_ZIP_LDH_DECOMPRESSED_SIZE_OFS);
+ local_header_crc32 = MZ_READ_LE32(pLocal_header + MZ_ZIP_LDH_CRC32_OFS);
+ local_header_bit_flags = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_BIT_FLAG_OFS);
+ has_data_descriptor = (local_header_bit_flags & 8) != 0;
+
+ if (local_header_filename_len != strlen(file_stat.m_filename))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if ((local_header_ofs + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + local_header_filename_len + local_header_extra_len + file_stat.m_comp_size) > pZip->m_archive_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if (!mz_zip_array_resize(pZip, &file_data_array, MZ_MAX(local_header_filename_len, local_header_extra_len), MZ_FALSE))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ goto handle_failure;
+ }
+
+ if (local_header_filename_len)
+ {
+ if (pZip->m_pRead(pZip->m_pIO_opaque, local_header_ofs + MZ_ZIP_LOCAL_DIR_HEADER_SIZE, file_data_array.m_p, local_header_filename_len) != local_header_filename_len)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ goto handle_failure;
+ }
+
+ /* I've seen 1 archive that had the same pathname, but used backslashes in the local dir and forward slashes in the central dir. Do we care about this? For now, this case will fail validation. */
+ if (memcmp(file_stat.m_filename, file_data_array.m_p, local_header_filename_len) != 0)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_VALIDATION_FAILED);
+ goto handle_failure;
+ }
+ }
+
+ if ((local_header_extra_len) && ((local_header_comp_size == MZ_UINT32_MAX) || (local_header_uncomp_size == MZ_UINT32_MAX)))
+ {
+ mz_uint32 extra_size_remaining = local_header_extra_len;
+ const mz_uint8 *pExtra_data = (const mz_uint8 *)file_data_array.m_p;
+
+ if (pZip->m_pRead(pZip->m_pIO_opaque, local_header_ofs + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + local_header_filename_len, file_data_array.m_p, local_header_extra_len) != local_header_extra_len)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ goto handle_failure;
+ }
+
+ do
+ {
+ mz_uint32 field_id, field_data_size, field_total_size;
+
+ if (extra_size_remaining < (sizeof(mz_uint16) * 2))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ goto handle_failure;
+ }
+
+ field_id = MZ_READ_LE16(pExtra_data);
+ field_data_size = MZ_READ_LE16(pExtra_data + sizeof(mz_uint16));
+ field_total_size = field_data_size + sizeof(mz_uint16) * 2;
+
+ if (field_total_size > extra_size_remaining)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ goto handle_failure;
+ }
+
+ if (field_id == MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID)
+ {
+ const mz_uint8 *pSrc_field_data = pExtra_data + sizeof(mz_uint32);
+
+ if (field_data_size < sizeof(mz_uint64) * 2)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ goto handle_failure;
+ }
+
+ local_header_uncomp_size = MZ_READ_LE64(pSrc_field_data);
+ local_header_comp_size = MZ_READ_LE64(pSrc_field_data + sizeof(mz_uint64));
+
+ found_zip64_ext_data_in_ldir = MZ_TRUE;
+ break;
+ }
+
+ pExtra_data += field_total_size;
+ extra_size_remaining -= field_total_size;
+ } while (extra_size_remaining);
+ }
+
+ /* TODO: parse local header extra data when local_header_comp_size is 0xFFFFFFFF! (big_descriptor.zip) */
+ /* I've seen zips in the wild with the data descriptor bit set, but proper local header values and bogus data descriptors */
+ if ((has_data_descriptor) && (!local_header_comp_size) && (!local_header_crc32))
+ {
+ mz_uint8 descriptor_buf[32];
+ mz_bool has_id;
+ const mz_uint8 *pSrc;
+ mz_uint32 file_crc32;
+ mz_uint64 comp_size = 0, uncomp_size = 0;
+
+ mz_uint32 num_descriptor_uint32s = ((pState->m_zip64) || (found_zip64_ext_data_in_ldir)) ? 6 : 4;
+
+ if (pZip->m_pRead(pZip->m_pIO_opaque, local_header_ofs + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + local_header_filename_len + local_header_extra_len + file_stat.m_comp_size, descriptor_buf, sizeof(mz_uint32) * num_descriptor_uint32s) != (sizeof(mz_uint32) * num_descriptor_uint32s))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ goto handle_failure;
+ }
+
+ has_id = (MZ_READ_LE32(descriptor_buf) == MZ_ZIP_DATA_DESCRIPTOR_ID);
+ pSrc = has_id ? (descriptor_buf + sizeof(mz_uint32)) : descriptor_buf;
+
+ file_crc32 = MZ_READ_LE32(pSrc);
+
+ if ((pState->m_zip64) || (found_zip64_ext_data_in_ldir))
+ {
+ comp_size = MZ_READ_LE64(pSrc + sizeof(mz_uint32));
+ uncomp_size = MZ_READ_LE64(pSrc + sizeof(mz_uint32) + sizeof(mz_uint64));
+ }
+ else
+ {
+ comp_size = MZ_READ_LE32(pSrc + sizeof(mz_uint32));
+ uncomp_size = MZ_READ_LE32(pSrc + sizeof(mz_uint32) + sizeof(mz_uint32));
+ }
+
+ if ((file_crc32 != file_stat.m_crc32) || (comp_size != file_stat.m_comp_size) || (uncomp_size != file_stat.m_uncomp_size))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_VALIDATION_FAILED);
+ goto handle_failure;
+ }
+ }
+ else
+ {
+ if ((local_header_crc32 != file_stat.m_crc32) || (local_header_comp_size != file_stat.m_comp_size) || (local_header_uncomp_size != file_stat.m_uncomp_size))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_VALIDATION_FAILED);
+ goto handle_failure;
+ }
+ }
+
+ mz_zip_array_clear(pZip, &file_data_array);
+
+ if ((flags & MZ_ZIP_FLAG_VALIDATE_HEADERS_ONLY) == 0)
+ {
+ if (!mz_zip_reader_extract_to_callback(pZip, file_index, mz_zip_compute_crc32_callback, &uncomp_crc32, 0))
+ return MZ_FALSE;
+
+ /* 1 more check to be sure, although the extract checks too. */
+ if (uncomp_crc32 != file_stat.m_crc32)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_VALIDATION_FAILED);
+ return MZ_FALSE;
+ }
+ }
+
+ return MZ_TRUE;
+
+handle_failure:
+ mz_zip_array_clear(pZip, &file_data_array);
+ return MZ_FALSE;
+}
+
+mz_bool mz_zip_validate_archive(mz_zip_archive *pZip, mz_uint flags)
+{
+ mz_zip_internal_state *pState;
+ uint32_t i;
+
+ if ((!pZip) || (!pZip->m_pState) || (!pZip->m_pAlloc) || (!pZip->m_pFree) || (!pZip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState = pZip->m_pState;
+
+ /* Basic sanity checks */
+ if (!pState->m_zip64)
+ {
+ if (pZip->m_total_files > MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+
+ if (pZip->m_archive_size > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+ }
+ else
+ {
+ if (pZip->m_total_files >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+
+ if (pState->m_central_dir.m_size >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+ }
+
+ for (i = 0; i < pZip->m_total_files; i++)
+ {
+ if (MZ_ZIP_FLAG_VALIDATE_LOCATE_FILE_FLAG & flags)
+ {
+ mz_uint32 found_index;
+ mz_zip_archive_file_stat stat;
+
+ if (!mz_zip_reader_file_stat(pZip, i, &stat))
+ return MZ_FALSE;
+
+ if (!mz_zip_reader_locate_file_v2(pZip, stat.m_filename, NULL, 0, &found_index))
+ return MZ_FALSE;
+
+ /* This check can fail if there are duplicate filenames in the archive (which we don't check for when writing - that's up to the user) */
+ if (found_index != i)
+ return mz_zip_set_error(pZip, MZ_ZIP_VALIDATION_FAILED);
+ }
+
+ if (!mz_zip_validate_file(pZip, i, flags))
+ return MZ_FALSE;
+ }
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_validate_mem_archive(const void *pMem, size_t size, mz_uint flags, mz_zip_error *pErr)
+{
+ mz_bool success = MZ_TRUE;
+ mz_zip_archive zip;
+ mz_zip_error actual_err = MZ_ZIP_NO_ERROR;
+
+ if ((!pMem) || (!size))
+ {
+ if (pErr)
+ *pErr = MZ_ZIP_INVALID_PARAMETER;
+ return MZ_FALSE;
+ }
+
+ mz_zip_zero_struct(&zip);
+
+ if (!mz_zip_reader_init_mem(&zip, pMem, size, flags))
+ {
+ if (pErr)
+ *pErr = zip.m_last_error;
+ return MZ_FALSE;
+ }
+
+ if (!mz_zip_validate_archive(&zip, flags))
+ {
+ actual_err = zip.m_last_error;
+ success = MZ_FALSE;
+ }
+
+ if (!mz_zip_reader_end_internal(&zip, success))
+ {
+ if (!actual_err)
+ actual_err = zip.m_last_error;
+ success = MZ_FALSE;
+ }
+
+ if (pErr)
+ *pErr = actual_err;
+
+ return success;
+}
+
+#ifndef MINIZ_NO_STDIO
+mz_bool mz_zip_validate_file_archive(const char *pFilename, mz_uint flags, mz_zip_error *pErr)
+{
+ mz_bool success = MZ_TRUE;
+ mz_zip_archive zip;
+ mz_zip_error actual_err = MZ_ZIP_NO_ERROR;
+
+ if (!pFilename)
+ {
+ if (pErr)
+ *pErr = MZ_ZIP_INVALID_PARAMETER;
+ return MZ_FALSE;
+ }
+
+ mz_zip_zero_struct(&zip);
+
+ if (!mz_zip_reader_init_file_v2(&zip, pFilename, flags, 0, 0))
+ {
+ if (pErr)
+ *pErr = zip.m_last_error;
+ return MZ_FALSE;
+ }
+
+ if (!mz_zip_validate_archive(&zip, flags))
+ {
+ actual_err = zip.m_last_error;
+ success = MZ_FALSE;
+ }
+
+ if (!mz_zip_reader_end_internal(&zip, success))
+ {
+ if (!actual_err)
+ actual_err = zip.m_last_error;
+ success = MZ_FALSE;
+ }
+
+ if (pErr)
+ *pErr = actual_err;
+
+ return success;
+}
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+/* ------------------- .ZIP archive writing */
+
+#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS
+
+static MZ_FORCEINLINE void mz_write_le16(mz_uint8 *p, mz_uint16 v)
+{
+ p[0] = (mz_uint8)v;
+ p[1] = (mz_uint8)(v >> 8);
+}
+static MZ_FORCEINLINE void mz_write_le32(mz_uint8 *p, mz_uint32 v)
+{
+ p[0] = (mz_uint8)v;
+ p[1] = (mz_uint8)(v >> 8);
+ p[2] = (mz_uint8)(v >> 16);
+ p[3] = (mz_uint8)(v >> 24);
+}
+static MZ_FORCEINLINE void mz_write_le64(mz_uint8 *p, mz_uint64 v)
+{
+ mz_write_le32(p, (mz_uint32)v);
+ mz_write_le32(p + sizeof(mz_uint32), (mz_uint32)(v >> 32));
+}
+
+#define MZ_WRITE_LE16(p, v) mz_write_le16((mz_uint8 *)(p), (mz_uint16)(v))
+#define MZ_WRITE_LE32(p, v) mz_write_le32((mz_uint8 *)(p), (mz_uint32)(v))
+#define MZ_WRITE_LE64(p, v) mz_write_le64((mz_uint8 *)(p), (mz_uint64)(v))
+
+static size_t mz_zip_heap_write_func(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n)
+{
+ mz_zip_archive *pZip = (mz_zip_archive *)pOpaque;
+ mz_zip_internal_state *pState = pZip->m_pState;
+ mz_uint64 new_size = MZ_MAX(file_ofs + n, pState->m_mem_size);
+
+ if (!n)
+ return 0;
+
+ /* An allocation this big is likely to just fail on 32-bit systems, so don't even go there. */
+ if ((sizeof(size_t) == sizeof(mz_uint32)) && (new_size > 0x7FFFFFFF))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_TOO_LARGE);
+ return 0;
+ }
+
+ if (new_size > pState->m_mem_capacity)
+ {
+ void *pNew_block;
+ size_t new_capacity = MZ_MAX(64, pState->m_mem_capacity);
+
+ while (new_capacity < new_size)
+ new_capacity *= 2;
+
+ if (NULL == (pNew_block = pZip->m_pRealloc(pZip->m_pAlloc_opaque, pState->m_pMem, 1, new_capacity)))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ return 0;
+ }
+
+ pState->m_pMem = pNew_block;
+ pState->m_mem_capacity = new_capacity;
+ }
+ memcpy((mz_uint8 *)pState->m_pMem + file_ofs, pBuf, n);
+ pState->m_mem_size = (size_t)new_size;
+ return n;
+}
+
+static mz_bool mz_zip_writer_end_internal(mz_zip_archive *pZip, mz_bool set_last_error)
+{
+ mz_zip_internal_state *pState;
+ mz_bool status = MZ_TRUE;
+
+ if ((!pZip) || (!pZip->m_pState) || (!pZip->m_pAlloc) || (!pZip->m_pFree) || ((pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) && (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED)))
+ {
+ if (set_last_error)
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ return MZ_FALSE;
+ }
+
+ pState = pZip->m_pState;
+ pZip->m_pState = NULL;
+ mz_zip_array_clear(pZip, &pState->m_central_dir);
+ mz_zip_array_clear(pZip, &pState->m_central_dir_offsets);
+ mz_zip_array_clear(pZip, &pState->m_sorted_central_dir_offsets);
+
+#ifndef MINIZ_NO_STDIO
+ if (pState->m_pFile)
+ {
+ if (pZip->m_zip_type == MZ_ZIP_TYPE_FILE)
+ {
+ if (MZ_FCLOSE(pState->m_pFile) == EOF)
+ {
+ if (set_last_error)
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_CLOSE_FAILED);
+ status = MZ_FALSE;
+ }
+ }
+
+ pState->m_pFile = NULL;
+ }
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+ if ((pZip->m_pWrite == mz_zip_heap_write_func) && (pState->m_pMem))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState->m_pMem);
+ pState->m_pMem = NULL;
+ }
+
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pState);
+ pZip->m_zip_mode = MZ_ZIP_MODE_INVALID;
+ return status;
+}
+
+mz_bool mz_zip_writer_init_v2(mz_zip_archive *pZip, mz_uint64 existing_size, mz_uint flags)
+{
+ mz_bool zip64 = (flags & MZ_ZIP_FLAG_WRITE_ZIP64) != 0;
+
+ if ((!pZip) || (pZip->m_pState) || (!pZip->m_pWrite) || (pZip->m_zip_mode != MZ_ZIP_MODE_INVALID))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (flags & MZ_ZIP_FLAG_WRITE_ALLOW_READING)
+ {
+ if (!pZip->m_pRead)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ }
+
+ if (pZip->m_file_offset_alignment)
+ {
+ /* Ensure user specified file offset alignment is a power of 2. */
+ if (pZip->m_file_offset_alignment & (pZip->m_file_offset_alignment - 1))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ }
+
+ if (!pZip->m_pAlloc)
+ pZip->m_pAlloc = miniz_def_alloc_func;
+ if (!pZip->m_pFree)
+ pZip->m_pFree = miniz_def_free_func;
+ if (!pZip->m_pRealloc)
+ pZip->m_pRealloc = miniz_def_realloc_func;
+
+ pZip->m_archive_size = existing_size;
+ pZip->m_central_directory_file_ofs = 0;
+ pZip->m_total_files = 0;
+
+ if (NULL == (pZip->m_pState = (mz_zip_internal_state *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(mz_zip_internal_state))))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ memset(pZip->m_pState, 0, sizeof(mz_zip_internal_state));
+
+ MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir, sizeof(mz_uint8));
+ MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir_offsets, sizeof(mz_uint32));
+ MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_sorted_central_dir_offsets, sizeof(mz_uint32));
+
+ pZip->m_pState->m_zip64 = zip64;
+ pZip->m_pState->m_zip64_has_extended_info_fields = zip64;
+
+ pZip->m_zip_type = MZ_ZIP_TYPE_USER;
+ pZip->m_zip_mode = MZ_ZIP_MODE_WRITING;
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_init(mz_zip_archive *pZip, mz_uint64 existing_size)
+{
+ return mz_zip_writer_init_v2(pZip, existing_size, 0);
+}
+
+mz_bool mz_zip_writer_init_heap_v2(mz_zip_archive *pZip, size_t size_to_reserve_at_beginning, size_t initial_allocation_size, mz_uint flags)
+{
+ pZip->m_pWrite = mz_zip_heap_write_func;
+ pZip->m_pNeeds_keepalive = NULL;
+
+ if (flags & MZ_ZIP_FLAG_WRITE_ALLOW_READING)
+ pZip->m_pRead = mz_zip_mem_read_func;
+
+ pZip->m_pIO_opaque = pZip;
+
+ if (!mz_zip_writer_init_v2(pZip, size_to_reserve_at_beginning, flags))
+ return MZ_FALSE;
+
+ pZip->m_zip_type = MZ_ZIP_TYPE_HEAP;
+
+ if (0 != (initial_allocation_size = MZ_MAX(initial_allocation_size, size_to_reserve_at_beginning)))
+ {
+ if (NULL == (pZip->m_pState->m_pMem = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, initial_allocation_size)))
+ {
+ mz_zip_writer_end_internal(pZip, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+ pZip->m_pState->m_mem_capacity = initial_allocation_size;
+ }
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_init_heap(mz_zip_archive *pZip, size_t size_to_reserve_at_beginning, size_t initial_allocation_size)
+{
+ return mz_zip_writer_init_heap_v2(pZip, size_to_reserve_at_beginning, initial_allocation_size, 0);
+}
+
+#ifndef MINIZ_NO_STDIO
+static size_t mz_zip_file_write_func(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n)
+{
+ mz_zip_archive *pZip = (mz_zip_archive *)pOpaque;
+ mz_int64 cur_ofs = MZ_FTELL64(pZip->m_pState->m_pFile);
+
+ file_ofs += pZip->m_pState->m_file_archive_start_ofs;
+
+ if (((mz_int64)file_ofs < 0) || (((cur_ofs != (mz_int64)file_ofs)) && (MZ_FSEEK64(pZip->m_pState->m_pFile, (mz_int64)file_ofs, SEEK_SET))))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_SEEK_FAILED);
+ return 0;
+ }
+
+ return MZ_FWRITE(pBuf, 1, n, pZip->m_pState->m_pFile);
+}
+
+mz_bool mz_zip_writer_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint64 size_to_reserve_at_beginning)
+{
+ return mz_zip_writer_init_file_v2(pZip, pFilename, size_to_reserve_at_beginning, 0);
+}
+
+mz_bool mz_zip_writer_init_file_v2(mz_zip_archive *pZip, const char *pFilename, mz_uint64 size_to_reserve_at_beginning, mz_uint flags)
+{
+ MZ_FILE *pFile;
+
+ pZip->m_pWrite = mz_zip_file_write_func;
+ pZip->m_pNeeds_keepalive = NULL;
+
+ if (flags & MZ_ZIP_FLAG_WRITE_ALLOW_READING)
+ pZip->m_pRead = mz_zip_file_read_func;
+
+ pZip->m_pIO_opaque = pZip;
+
+ if (!mz_zip_writer_init_v2(pZip, size_to_reserve_at_beginning, flags))
+ return MZ_FALSE;
+
+ if (NULL == (pFile = MZ_FOPEN(pFilename, (flags & MZ_ZIP_FLAG_WRITE_ALLOW_READING) ? "w+b" : "wb")))
+ {
+ mz_zip_writer_end(pZip);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_OPEN_FAILED);
+ }
+
+ pZip->m_pState->m_pFile = pFile;
+ pZip->m_zip_type = MZ_ZIP_TYPE_FILE;
+
+ if (size_to_reserve_at_beginning)
+ {
+ mz_uint64 cur_ofs = 0;
+ char buf[4096];
+
+ MZ_CLEAR_OBJ(buf);
+
+ do
+ {
+ size_t n = (size_t)MZ_MIN(sizeof(buf), size_to_reserve_at_beginning);
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_ofs, buf, n) != n)
+ {
+ mz_zip_writer_end(pZip);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+ cur_ofs += n;
+ size_to_reserve_at_beginning -= n;
+ } while (size_to_reserve_at_beginning);
+ }
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_init_cfile(mz_zip_archive *pZip, MZ_FILE *pFile, mz_uint flags)
+{
+ pZip->m_pWrite = mz_zip_file_write_func;
+ pZip->m_pNeeds_keepalive = NULL;
+
+ if (flags & MZ_ZIP_FLAG_WRITE_ALLOW_READING)
+ pZip->m_pRead = mz_zip_file_read_func;
+
+ pZip->m_pIO_opaque = pZip;
+
+ if (!mz_zip_writer_init_v2(pZip, 0, flags))
+ return MZ_FALSE;
+
+ pZip->m_pState->m_pFile = pFile;
+ pZip->m_pState->m_file_archive_start_ofs = MZ_FTELL64(pZip->m_pState->m_pFile);
+ pZip->m_zip_type = MZ_ZIP_TYPE_CFILE;
+
+ return MZ_TRUE;
+}
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+mz_bool mz_zip_writer_init_from_reader_v2(mz_zip_archive *pZip, const char *pFilename, mz_uint flags)
+{
+ mz_zip_internal_state *pState;
+
+ if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_READING))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (flags & MZ_ZIP_FLAG_WRITE_ZIP64)
+ {
+ /* We don't support converting a non-zip64 file to zip64 - this seems like more trouble than it's worth. (What about the existing 32-bit data descriptors that could follow the compressed data?) */
+ if (!pZip->m_pState->m_zip64)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ }
+
+ /* No sense in trying to write to an archive that's already at the support max size */
+ if (pZip->m_pState->m_zip64)
+ {
+ if (pZip->m_total_files == MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+ else
+ {
+ if (pZip->m_total_files == MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+
+ if ((pZip->m_archive_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_ZIP_LOCAL_DIR_HEADER_SIZE) > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_TOO_LARGE);
+ }
+
+ pState = pZip->m_pState;
+
+ if (pState->m_pFile)
+ {
+#ifdef MINIZ_NO_STDIO
+ (void)pFilename;
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+#else
+ if (pZip->m_pIO_opaque != pZip)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (pZip->m_zip_type == MZ_ZIP_TYPE_FILE)
+ {
+ if (!pFilename)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ /* Archive is being read from stdio and was originally opened only for reading. Try to reopen as writable. */
+ if (NULL == (pState->m_pFile = MZ_FREOPEN(pFilename, "r+b", pState->m_pFile)))
+ {
+ /* The mz_zip_archive is now in a bogus state because pState->m_pFile is NULL, so just close it. */
+ mz_zip_reader_end_internal(pZip, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_OPEN_FAILED);
+ }
+ }
+
+ pZip->m_pWrite = mz_zip_file_write_func;
+ pZip->m_pNeeds_keepalive = NULL;
+#endif /* #ifdef MINIZ_NO_STDIO */
+ }
+ else if (pState->m_pMem)
+ {
+ /* Archive lives in a memory block. Assume it's from the heap that we can resize using the realloc callback. */
+ if (pZip->m_pIO_opaque != pZip)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState->m_mem_capacity = pState->m_mem_size;
+ pZip->m_pWrite = mz_zip_heap_write_func;
+ pZip->m_pNeeds_keepalive = NULL;
+ }
+ /* Archive is being read via a user provided read function - make sure the user has specified a write function too. */
+ else if (!pZip->m_pWrite)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ /* Start writing new files at the archive's current central directory location. */
+ /* TODO: We could add a flag that lets the user start writing immediately AFTER the existing central dir - this would be safer. */
+ pZip->m_archive_size = pZip->m_central_directory_file_ofs;
+ pZip->m_central_directory_file_ofs = 0;
+
+ /* Clear the sorted central dir offsets, they aren't useful or maintained now. */
+ /* Even though we're now in write mode, files can still be extracted and verified, but file locates will be slow. */
+ /* TODO: We could easily maintain the sorted central directory offsets. */
+ mz_zip_array_clear(pZip, &pZip->m_pState->m_sorted_central_dir_offsets);
+
+ pZip->m_zip_mode = MZ_ZIP_MODE_WRITING;
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_init_from_reader(mz_zip_archive *pZip, const char *pFilename)
+{
+ return mz_zip_writer_init_from_reader_v2(pZip, pFilename, 0);
+}
+
+/* TODO: pArchive_name is a terrible name here! */
+mz_bool mz_zip_writer_add_mem(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, mz_uint level_and_flags)
+{
+ return mz_zip_writer_add_mem_ex(pZip, pArchive_name, pBuf, buf_size, NULL, 0, level_and_flags, 0, 0);
+}
+
+typedef struct
+{
+ mz_zip_archive *m_pZip;
+ mz_uint64 m_cur_archive_file_ofs;
+ mz_uint64 m_comp_size;
+} mz_zip_writer_add_state;
+
+static mz_bool mz_zip_writer_add_put_buf_callback(const void *pBuf, int len, void *pUser)
+{
+ mz_zip_writer_add_state *pState = (mz_zip_writer_add_state *)pUser;
+ if ((int)pState->m_pZip->m_pWrite(pState->m_pZip->m_pIO_opaque, pState->m_cur_archive_file_ofs, pBuf, len) != len)
+ return MZ_FALSE;
+
+ pState->m_cur_archive_file_ofs += len;
+ pState->m_comp_size += len;
+ return MZ_TRUE;
+}
+
+#define MZ_ZIP64_MAX_LOCAL_EXTRA_FIELD_SIZE (sizeof(mz_uint16) * 2 + sizeof(mz_uint64) * 2)
+#define MZ_ZIP64_MAX_CENTRAL_EXTRA_FIELD_SIZE (sizeof(mz_uint16) * 2 + sizeof(mz_uint64) * 3)
+static mz_uint32 mz_zip_writer_create_zip64_extra_data(mz_uint8 *pBuf, mz_uint64 *pUncomp_size, mz_uint64 *pComp_size, mz_uint64 *pLocal_header_ofs)
+{
+ mz_uint8 *pDst = pBuf;
+ mz_uint32 field_size = 0;
+
+ MZ_WRITE_LE16(pDst + 0, MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID);
+ MZ_WRITE_LE16(pDst + 2, 0);
+ pDst += sizeof(mz_uint16) * 2;
+
+ if (pUncomp_size)
+ {
+ MZ_WRITE_LE64(pDst, *pUncomp_size);
+ pDst += sizeof(mz_uint64);
+ field_size += sizeof(mz_uint64);
+ }
+
+ if (pComp_size)
+ {
+ MZ_WRITE_LE64(pDst, *pComp_size);
+ pDst += sizeof(mz_uint64);
+ field_size += sizeof(mz_uint64);
+ }
+
+ if (pLocal_header_ofs)
+ {
+ MZ_WRITE_LE64(pDst, *pLocal_header_ofs);
+ pDst += sizeof(mz_uint64);
+ field_size += sizeof(mz_uint64);
+ }
+
+ MZ_WRITE_LE16(pBuf + 2, field_size);
+
+ return (mz_uint32)(pDst - pBuf);
+}
+
+static mz_bool mz_zip_writer_create_local_dir_header(mz_zip_archive *pZip, mz_uint8 *pDst, mz_uint16 filename_size, mz_uint16 extra_size, mz_uint64 uncomp_size, mz_uint64 comp_size, mz_uint32 uncomp_crc32, mz_uint16 method, mz_uint16 bit_flags, mz_uint16 dos_time, mz_uint16 dos_date)
+{
+ (void)pZip;
+ memset(pDst, 0, MZ_ZIP_LOCAL_DIR_HEADER_SIZE);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_SIG_OFS, MZ_ZIP_LOCAL_DIR_HEADER_SIG);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_VERSION_NEEDED_OFS, method ? 20 : 0);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_BIT_FLAG_OFS, bit_flags);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_METHOD_OFS, method);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_FILE_TIME_OFS, dos_time);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_FILE_DATE_OFS, dos_date);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_CRC32_OFS, uncomp_crc32);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_COMPRESSED_SIZE_OFS, MZ_MIN(comp_size, MZ_UINT32_MAX));
+ MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_DECOMPRESSED_SIZE_OFS, MZ_MIN(uncomp_size, MZ_UINT32_MAX));
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_FILENAME_LEN_OFS, filename_size);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_EXTRA_LEN_OFS, extra_size);
+ return MZ_TRUE;
+}
+
+static mz_bool mz_zip_writer_create_central_dir_header(mz_zip_archive *pZip, mz_uint8 *pDst,
+ mz_uint16 filename_size, mz_uint16 extra_size, mz_uint16 comment_size,
+ mz_uint64 uncomp_size, mz_uint64 comp_size, mz_uint32 uncomp_crc32,
+ mz_uint16 method, mz_uint16 bit_flags, mz_uint16 dos_time, mz_uint16 dos_date,
+ mz_uint64 local_header_ofs, mz_uint32 ext_attributes)
+{
+ (void)pZip;
+ memset(pDst, 0, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_SIG_OFS, MZ_ZIP_CENTRAL_DIR_HEADER_SIG);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_VERSION_NEEDED_OFS, method ? 20 : 0);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_BIT_FLAG_OFS, bit_flags);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_METHOD_OFS, method);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_FILE_TIME_OFS, dos_time);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_FILE_DATE_OFS, dos_date);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_CRC32_OFS, uncomp_crc32);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS, MZ_MIN(comp_size, MZ_UINT32_MAX));
+ MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS, MZ_MIN(uncomp_size, MZ_UINT32_MAX));
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_FILENAME_LEN_OFS, filename_size);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_EXTRA_LEN_OFS, extra_size);
+ MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_COMMENT_LEN_OFS, comment_size);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_EXTERNAL_ATTR_OFS, ext_attributes);
+ MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_LOCAL_HEADER_OFS, MZ_MIN(local_header_ofs, MZ_UINT32_MAX));
+ return MZ_TRUE;
+}
+
+static mz_bool mz_zip_writer_add_to_central_dir(mz_zip_archive *pZip, const char *pFilename, mz_uint16 filename_size,
+ const void *pExtra, mz_uint16 extra_size, const void *pComment, mz_uint16 comment_size,
+ mz_uint64 uncomp_size, mz_uint64 comp_size, mz_uint32 uncomp_crc32,
+ mz_uint16 method, mz_uint16 bit_flags, mz_uint16 dos_time, mz_uint16 dos_date,
+ mz_uint64 local_header_ofs, mz_uint32 ext_attributes,
+ const char *user_extra_data, mz_uint user_extra_data_len)
+{
+ mz_zip_internal_state *pState = pZip->m_pState;
+ mz_uint32 central_dir_ofs = (mz_uint32)pState->m_central_dir.m_size;
+ size_t orig_central_dir_size = pState->m_central_dir.m_size;
+ mz_uint8 central_dir_header[MZ_ZIP_CENTRAL_DIR_HEADER_SIZE];
+
+ if (!pZip->m_pState->m_zip64)
+ {
+ if (local_header_ofs > 0xFFFFFFFF)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_TOO_LARGE);
+ }
+
+ /* miniz doesn't support central dirs >= MZ_UINT32_MAX bytes yet */
+ if (((mz_uint64)pState->m_central_dir.m_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_size + extra_size + user_extra_data_len + comment_size) >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_CDIR_SIZE);
+
+ if (!mz_zip_writer_create_central_dir_header(pZip, central_dir_header, filename_size, (mz_uint16)(extra_size + user_extra_data_len), comment_size, uncomp_size, comp_size, uncomp_crc32, method, bit_flags, dos_time, dos_date, local_header_ofs, ext_attributes))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if ((!mz_zip_array_push_back(pZip, &pState->m_central_dir, central_dir_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE)) ||
+ (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pFilename, filename_size)) ||
+ (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pExtra, extra_size)) ||
+ (!mz_zip_array_push_back(pZip, &pState->m_central_dir, user_extra_data, user_extra_data_len)) ||
+ (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pComment, comment_size)) ||
+ (!mz_zip_array_push_back(pZip, &pState->m_central_dir_offsets, &central_dir_ofs, 1)))
+ {
+ /* Try to resize the central directory array back into its original state. */
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ return MZ_TRUE;
+}
+
+static mz_bool mz_zip_writer_validate_archive_name(const char *pArchive_name)
+{
+ /* Basic ZIP archive filename validity checks: Valid filenames cannot start with a forward slash, cannot contain a drive letter, and cannot use DOS-style backward slashes. */
+ if (*pArchive_name == '/')
+ return MZ_FALSE;
+
+ /* Making sure the name does not contain drive letters or DOS style backward slashes is the responsibility of the program using miniz*/
+
+ return MZ_TRUE;
+}
+
+static mz_uint mz_zip_writer_compute_padding_needed_for_file_alignment(mz_zip_archive *pZip)
+{
+ mz_uint32 n;
+ if (!pZip->m_file_offset_alignment)
+ return 0;
+ n = (mz_uint32)(pZip->m_archive_size & (pZip->m_file_offset_alignment - 1));
+ return (mz_uint)((pZip->m_file_offset_alignment - n) & (pZip->m_file_offset_alignment - 1));
+}
+
+static mz_bool mz_zip_writer_write_zeros(mz_zip_archive *pZip, mz_uint64 cur_file_ofs, mz_uint32 n)
+{
+ char buf[4096];
+ memset(buf, 0, MZ_MIN(sizeof(buf), n));
+ while (n)
+ {
+ mz_uint32 s = MZ_MIN(sizeof(buf), n);
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_file_ofs, buf, s) != s)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_file_ofs += s;
+ n -= s;
+ }
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_add_mem_ex(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags,
+ mz_uint64 uncomp_size, mz_uint32 uncomp_crc32)
+{
+ return mz_zip_writer_add_mem_ex_v2(pZip, pArchive_name, pBuf, buf_size, pComment, comment_size, level_and_flags, uncomp_size, uncomp_crc32, NULL, NULL, 0, NULL, 0);
+}
+
+mz_bool mz_zip_writer_add_mem_ex_v2(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size,
+ mz_uint level_and_flags, mz_uint64 uncomp_size, mz_uint32 uncomp_crc32, MZ_TIME_T *last_modified,
+ const char *user_extra_data, mz_uint user_extra_data_len, const char *user_extra_data_central, mz_uint user_extra_data_central_len)
+{
+ mz_uint16 method = 0, dos_time = 0, dos_date = 0;
+ mz_uint level, ext_attributes = 0, num_alignment_padding_bytes;
+ mz_uint64 local_dir_header_ofs = pZip->m_archive_size, cur_archive_file_ofs = pZip->m_archive_size, comp_size = 0;
+ size_t archive_name_size;
+ mz_uint8 local_dir_header[MZ_ZIP_LOCAL_DIR_HEADER_SIZE];
+ tdefl_compressor *pComp = NULL;
+ mz_bool store_data_uncompressed;
+ mz_zip_internal_state *pState;
+ mz_uint8 *pExtra_data = NULL;
+ mz_uint32 extra_size = 0;
+ mz_uint8 extra_data[MZ_ZIP64_MAX_CENTRAL_EXTRA_FIELD_SIZE];
+ mz_uint16 bit_flags = 0;
+
+ if ((int)level_and_flags < 0)
+ level_and_flags = MZ_DEFAULT_LEVEL;
+
+ if (uncomp_size || (buf_size && !(level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA)))
+ bit_flags |= MZ_ZIP_LDH_BIT_FLAG_HAS_LOCATOR;
+
+ if (!(level_and_flags & MZ_ZIP_FLAG_ASCII_FILENAME))
+ bit_flags |= MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_UTF8;
+
+ level = level_and_flags & 0xF;
+ store_data_uncompressed = ((!level) || (level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA));
+
+ if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) || ((buf_size) && (!pBuf)) || (!pArchive_name) || ((comment_size) && (!pComment)) || (level > MZ_UBER_COMPRESSION))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState = pZip->m_pState;
+
+ if (pState->m_zip64)
+ {
+ if (pZip->m_total_files == MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+ else
+ {
+ if (pZip->m_total_files == MZ_UINT16_MAX)
+ {
+ pState->m_zip64 = MZ_TRUE;
+ /*return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES); */
+ }
+ if ((buf_size > 0xFFFFFFFF) || (uncomp_size > 0xFFFFFFFF))
+ {
+ pState->m_zip64 = MZ_TRUE;
+ /*return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE); */
+ }
+ }
+
+ if ((!(level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (uncomp_size))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!mz_zip_writer_validate_archive_name(pArchive_name))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_FILENAME);
+
+#ifndef MINIZ_NO_TIME
+ if (last_modified != NULL)
+ {
+ mz_zip_time_t_to_dos_time(*last_modified, &dos_time, &dos_date);
+ }
+ else
+ {
+ MZ_TIME_T cur_time;
+ time(&cur_time);
+ mz_zip_time_t_to_dos_time(cur_time, &dos_time, &dos_date);
+ }
+#endif /* #ifndef MINIZ_NO_TIME */
+
+ if (!(level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA))
+ {
+ uncomp_crc32 = (mz_uint32)mz_crc32(MZ_CRC32_INIT, (const mz_uint8 *)pBuf, buf_size);
+ uncomp_size = buf_size;
+ if (uncomp_size <= 3)
+ {
+ level = 0;
+ store_data_uncompressed = MZ_TRUE;
+ }
+ }
+
+ archive_name_size = strlen(pArchive_name);
+ if (archive_name_size > MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_FILENAME);
+
+ num_alignment_padding_bytes = mz_zip_writer_compute_padding_needed_for_file_alignment(pZip);
+
+ /* miniz doesn't support central dirs >= MZ_UINT32_MAX bytes yet */
+ if (((mz_uint64)pState->m_central_dir.m_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + archive_name_size + MZ_ZIP64_MAX_CENTRAL_EXTRA_FIELD_SIZE + comment_size) >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_CDIR_SIZE);
+
+ if (!pState->m_zip64)
+ {
+ /* Bail early if the archive would obviously become too large */
+ if ((pZip->m_archive_size + num_alignment_padding_bytes + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + archive_name_size
+ + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + archive_name_size + comment_size + user_extra_data_len +
+ pState->m_central_dir.m_size + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE + user_extra_data_central_len
+ + MZ_ZIP_DATA_DESCRIPTER_SIZE32) > 0xFFFFFFFF)
+ {
+ pState->m_zip64 = MZ_TRUE;
+ /*return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE); */
+ }
+ }
+
+ if ((archive_name_size) && (pArchive_name[archive_name_size - 1] == '/'))
+ {
+ /* Set DOS Subdirectory attribute bit. */
+ ext_attributes |= MZ_ZIP_DOS_DIR_ATTRIBUTE_BITFLAG;
+
+ /* Subdirectories cannot contain data. */
+ if ((buf_size) || (uncomp_size))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ }
+
+ /* Try to do any allocations before writing to the archive, so if an allocation fails the file remains unmodified. (A good idea if we're doing an in-place modification.) */
+ if ((!mz_zip_array_ensure_room(pZip, &pState->m_central_dir, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + archive_name_size + comment_size + (pState->m_zip64 ? MZ_ZIP64_MAX_CENTRAL_EXTRA_FIELD_SIZE : 0))) || (!mz_zip_array_ensure_room(pZip, &pState->m_central_dir_offsets, 1)))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ if ((!store_data_uncompressed) && (buf_size))
+ {
+ if (NULL == (pComp = (tdefl_compressor *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(tdefl_compressor))))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (!mz_zip_writer_write_zeros(pZip, cur_archive_file_ofs, num_alignment_padding_bytes))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ return MZ_FALSE;
+ }
+
+ local_dir_header_ofs += num_alignment_padding_bytes;
+ if (pZip->m_file_offset_alignment)
+ {
+ MZ_ASSERT((local_dir_header_ofs & (pZip->m_file_offset_alignment - 1)) == 0);
+ }
+ cur_archive_file_ofs += num_alignment_padding_bytes;
+
+ MZ_CLEAR_OBJ(local_dir_header);
+
+ if (!store_data_uncompressed || (level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA))
+ {
+ method = MZ_DEFLATED;
+ }
+
+ if (pState->m_zip64)
+ {
+ if (uncomp_size >= MZ_UINT32_MAX || local_dir_header_ofs >= MZ_UINT32_MAX)
+ {
+ pExtra_data = extra_data;
+ extra_size = mz_zip_writer_create_zip64_extra_data(extra_data, (uncomp_size >= MZ_UINT32_MAX) ? &uncomp_size : NULL,
+ (uncomp_size >= MZ_UINT32_MAX) ? &comp_size : NULL, (local_dir_header_ofs >= MZ_UINT32_MAX) ? &local_dir_header_ofs : NULL);
+ }
+
+ if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header, (mz_uint16)archive_name_size, (mz_uint16)(extra_size + user_extra_data_len), 0, 0, 0, method, bit_flags, dos_time, dos_date))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, local_dir_header_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += sizeof(local_dir_header);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pArchive_name, archive_name_size) != archive_name_size)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+ cur_archive_file_ofs += archive_name_size;
+
+ if (pExtra_data != NULL)
+ {
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, extra_data, extra_size) != extra_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += extra_size;
+ }
+ }
+ else
+ {
+ if ((comp_size > MZ_UINT32_MAX) || (cur_archive_file_ofs > MZ_UINT32_MAX))
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+ if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header, (mz_uint16)archive_name_size, (mz_uint16)user_extra_data_len, 0, 0, 0, method, bit_flags, dos_time, dos_date))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, local_dir_header_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += sizeof(local_dir_header);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pArchive_name, archive_name_size) != archive_name_size)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+ cur_archive_file_ofs += archive_name_size;
+ }
+
+ if (user_extra_data_len > 0)
+ {
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, user_extra_data, user_extra_data_len) != user_extra_data_len)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += user_extra_data_len;
+ }
+
+ if (store_data_uncompressed)
+ {
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pBuf, buf_size) != buf_size)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+
+ cur_archive_file_ofs += buf_size;
+ comp_size = buf_size;
+ }
+ else if (buf_size)
+ {
+ mz_zip_writer_add_state state;
+
+ state.m_pZip = pZip;
+ state.m_cur_archive_file_ofs = cur_archive_file_ofs;
+ state.m_comp_size = 0;
+
+ if ((tdefl_init(pComp, mz_zip_writer_add_put_buf_callback, &state, tdefl_create_comp_flags_from_zip_params(level, -15, MZ_DEFAULT_STRATEGY)) != TDEFL_STATUS_OKAY) ||
+ (tdefl_compress_buffer(pComp, pBuf, buf_size, TDEFL_FINISH) != TDEFL_STATUS_DONE))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ return mz_zip_set_error(pZip, MZ_ZIP_COMPRESSION_FAILED);
+ }
+
+ comp_size = state.m_comp_size;
+ cur_archive_file_ofs = state.m_cur_archive_file_ofs;
+ }
+
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ pComp = NULL;
+
+ if (uncomp_size)
+ {
+ mz_uint8 local_dir_footer[MZ_ZIP_DATA_DESCRIPTER_SIZE64];
+ mz_uint32 local_dir_footer_size = MZ_ZIP_DATA_DESCRIPTER_SIZE32;
+
+ MZ_ASSERT(bit_flags & MZ_ZIP_LDH_BIT_FLAG_HAS_LOCATOR);
+
+ MZ_WRITE_LE32(local_dir_footer + 0, MZ_ZIP_DATA_DESCRIPTOR_ID);
+ MZ_WRITE_LE32(local_dir_footer + 4, uncomp_crc32);
+ if (pExtra_data == NULL)
+ {
+ if (comp_size > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+
+ MZ_WRITE_LE32(local_dir_footer + 8, comp_size);
+ MZ_WRITE_LE32(local_dir_footer + 12, uncomp_size);
+ }
+ else
+ {
+ MZ_WRITE_LE64(local_dir_footer + 8, comp_size);
+ MZ_WRITE_LE64(local_dir_footer + 16, uncomp_size);
+ local_dir_footer_size = MZ_ZIP_DATA_DESCRIPTER_SIZE64;
+ }
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, local_dir_footer, local_dir_footer_size) != local_dir_footer_size)
+ return MZ_FALSE;
+
+ cur_archive_file_ofs += local_dir_footer_size;
+ }
+
+ if (pExtra_data != NULL)
+ {
+ extra_size = mz_zip_writer_create_zip64_extra_data(extra_data, (uncomp_size >= MZ_UINT32_MAX) ? &uncomp_size : NULL,
+ (uncomp_size >= MZ_UINT32_MAX) ? &comp_size : NULL, (local_dir_header_ofs >= MZ_UINT32_MAX) ? &local_dir_header_ofs : NULL);
+ }
+
+ if (!mz_zip_writer_add_to_central_dir(pZip, pArchive_name, (mz_uint16)archive_name_size, pExtra_data, (mz_uint16)extra_size, pComment,
+ comment_size, uncomp_size, comp_size, uncomp_crc32, method, bit_flags, dos_time, dos_date, local_dir_header_ofs, ext_attributes,
+ user_extra_data_central, user_extra_data_central_len))
+ return MZ_FALSE;
+
+ pZip->m_total_files++;
+ pZip->m_archive_size = cur_archive_file_ofs;
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_add_read_buf_callback(mz_zip_archive *pZip, const char *pArchive_name, mz_file_read_func read_callback, void* callback_opaque, mz_uint64 max_size, const MZ_TIME_T *pFile_time, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags,
+ const char *user_extra_data, mz_uint user_extra_data_len, const char *user_extra_data_central, mz_uint user_extra_data_central_len)
+{
+ mz_uint16 gen_flags = (level_and_flags & MZ_ZIP_FLAG_WRITE_HEADER_SET_SIZE) ? 0 : MZ_ZIP_LDH_BIT_FLAG_HAS_LOCATOR;
+ mz_uint uncomp_crc32 = MZ_CRC32_INIT, level, num_alignment_padding_bytes;
+ mz_uint16 method = 0, dos_time = 0, dos_date = 0, ext_attributes = 0;
+ mz_uint64 local_dir_header_ofs, cur_archive_file_ofs = pZip->m_archive_size, uncomp_size = 0, comp_size = 0;
+ size_t archive_name_size;
+ mz_uint8 local_dir_header[MZ_ZIP_LOCAL_DIR_HEADER_SIZE];
+ mz_uint8 *pExtra_data = NULL;
+ mz_uint32 extra_size = 0;
+ mz_uint8 extra_data[MZ_ZIP64_MAX_CENTRAL_EXTRA_FIELD_SIZE];
+ mz_zip_internal_state *pState;
+ mz_uint64 file_ofs = 0, cur_archive_header_file_ofs;
+
+ if (!(level_and_flags & MZ_ZIP_FLAG_ASCII_FILENAME))
+ gen_flags |= MZ_ZIP_GENERAL_PURPOSE_BIT_FLAG_UTF8;
+
+ if ((int)level_and_flags < 0)
+ level_and_flags = MZ_DEFAULT_LEVEL;
+ level = level_and_flags & 0xF;
+
+ /* Sanity checks */
+ if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) || (!pArchive_name) || ((comment_size) && (!pComment)) || (level > MZ_UBER_COMPRESSION))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState = pZip->m_pState;
+
+ if ((!pState->m_zip64) && (max_size > MZ_UINT32_MAX))
+ {
+ /* Source file is too large for non-zip64 */
+ /*return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE); */
+ pState->m_zip64 = MZ_TRUE;
+ }
+
+ /* We could support this, but why? */
+ if (level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!mz_zip_writer_validate_archive_name(pArchive_name))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_FILENAME);
+
+ if (pState->m_zip64)
+ {
+ if (pZip->m_total_files == MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+ else
+ {
+ if (pZip->m_total_files == MZ_UINT16_MAX)
+ {
+ pState->m_zip64 = MZ_TRUE;
+ /*return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES); */
+ }
+ }
+
+ archive_name_size = strlen(pArchive_name);
+ if (archive_name_size > MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_FILENAME);
+
+ num_alignment_padding_bytes = mz_zip_writer_compute_padding_needed_for_file_alignment(pZip);
+
+ /* miniz doesn't support central dirs >= MZ_UINT32_MAX bytes yet */
+ if (((mz_uint64)pState->m_central_dir.m_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + archive_name_size + MZ_ZIP64_MAX_CENTRAL_EXTRA_FIELD_SIZE + comment_size) >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_CDIR_SIZE);
+
+ if (!pState->m_zip64)
+ {
+ /* Bail early if the archive would obviously become too large */
+ if ((pZip->m_archive_size + num_alignment_padding_bytes + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + archive_name_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE
+ + archive_name_size + comment_size + user_extra_data_len + pState->m_central_dir.m_size + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE + 1024
+ + MZ_ZIP_DATA_DESCRIPTER_SIZE32 + user_extra_data_central_len) > 0xFFFFFFFF)
+ {
+ pState->m_zip64 = MZ_TRUE;
+ /*return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE); */
+ }
+ }
+
+#ifndef MINIZ_NO_TIME
+ if (pFile_time)
+ {
+ mz_zip_time_t_to_dos_time(*pFile_time, &dos_time, &dos_date);
+ }
+#endif
+
+ if (max_size <= 3)
+ level = 0;
+
+ if (!mz_zip_writer_write_zeros(pZip, cur_archive_file_ofs, num_alignment_padding_bytes))
+ {
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+
+ cur_archive_file_ofs += num_alignment_padding_bytes;
+ local_dir_header_ofs = cur_archive_file_ofs;
+
+ if (pZip->m_file_offset_alignment)
+ {
+ MZ_ASSERT((cur_archive_file_ofs & (pZip->m_file_offset_alignment - 1)) == 0);
+ }
+
+ if (max_size && level)
+ {
+ method = MZ_DEFLATED;
+ }
+
+ MZ_CLEAR_OBJ(local_dir_header);
+ if (pState->m_zip64)
+ {
+ if (max_size >= MZ_UINT32_MAX || local_dir_header_ofs >= MZ_UINT32_MAX)
+ {
+ pExtra_data = extra_data;
+ if (level_and_flags & MZ_ZIP_FLAG_WRITE_HEADER_SET_SIZE)
+ extra_size = mz_zip_writer_create_zip64_extra_data(extra_data, (max_size >= MZ_UINT32_MAX) ? &uncomp_size : NULL,
+ (max_size >= MZ_UINT32_MAX) ? &comp_size : NULL,
+ (local_dir_header_ofs >= MZ_UINT32_MAX) ? &local_dir_header_ofs : NULL);
+ else
+ extra_size = mz_zip_writer_create_zip64_extra_data(extra_data, NULL,
+ NULL,
+ (local_dir_header_ofs >= MZ_UINT32_MAX) ? &local_dir_header_ofs : NULL);
+ }
+
+ if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header, (mz_uint16)archive_name_size, (mz_uint16)(extra_size + user_extra_data_len), 0, 0, 0, method, gen_flags, dos_time, dos_date))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += sizeof(local_dir_header);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pArchive_name, archive_name_size) != archive_name_size)
+ {
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+
+ cur_archive_file_ofs += archive_name_size;
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, extra_data, extra_size) != extra_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += extra_size;
+ }
+ else
+ {
+ if ((comp_size > MZ_UINT32_MAX) || (cur_archive_file_ofs > MZ_UINT32_MAX))
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+ if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header, (mz_uint16)archive_name_size, (mz_uint16)user_extra_data_len, 0, 0, 0, method, gen_flags, dos_time, dos_date))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += sizeof(local_dir_header);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pArchive_name, archive_name_size) != archive_name_size)
+ {
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+
+ cur_archive_file_ofs += archive_name_size;
+ }
+
+ if (user_extra_data_len > 0)
+ {
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, user_extra_data, user_extra_data_len) != user_extra_data_len)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_file_ofs += user_extra_data_len;
+ }
+
+ if (max_size)
+ {
+ void *pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, MZ_ZIP_MAX_IO_BUF_SIZE);
+ if (!pRead_buf)
+ {
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (!level)
+ {
+ while (1)
+ {
+ size_t n = read_callback(callback_opaque, file_ofs, pRead_buf, MZ_ZIP_MAX_IO_BUF_SIZE);
+ if (n == 0)
+ break;
+
+ if ((n > MZ_ZIP_MAX_IO_BUF_SIZE) || (file_ofs + n > max_size))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ }
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pRead_buf, n) != n)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+ file_ofs += n;
+ uncomp_crc32 = (mz_uint32)mz_crc32(uncomp_crc32, (const mz_uint8 *)pRead_buf, n);
+ cur_archive_file_ofs += n;
+ }
+ uncomp_size = file_ofs;
+ comp_size = uncomp_size;
+ }
+ else
+ {
+ mz_bool result = MZ_FALSE;
+ mz_zip_writer_add_state state;
+ tdefl_compressor *pComp = (tdefl_compressor *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(tdefl_compressor));
+ if (!pComp)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ state.m_pZip = pZip;
+ state.m_cur_archive_file_ofs = cur_archive_file_ofs;
+ state.m_comp_size = 0;
+
+ if (tdefl_init(pComp, mz_zip_writer_add_put_buf_callback, &state, tdefl_create_comp_flags_from_zip_params(level, -15, MZ_DEFAULT_STRATEGY)) != TDEFL_STATUS_OKAY)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+ }
+
+ for (;;)
+ {
+ tdefl_status status;
+ tdefl_flush flush = TDEFL_NO_FLUSH;
+
+ size_t n = read_callback(callback_opaque, file_ofs, pRead_buf, MZ_ZIP_MAX_IO_BUF_SIZE);
+ if ((n > MZ_ZIP_MAX_IO_BUF_SIZE) || (file_ofs + n > max_size))
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ break;
+ }
+
+ file_ofs += n;
+ uncomp_crc32 = (mz_uint32)mz_crc32(uncomp_crc32, (const mz_uint8 *)pRead_buf, n);
+
+ if (pZip->m_pNeeds_keepalive != NULL && pZip->m_pNeeds_keepalive(pZip->m_pIO_opaque))
+ flush = TDEFL_FULL_FLUSH;
+
+ if (n == 0)
+ flush = TDEFL_FINISH;
+
+ status = tdefl_compress_buffer(pComp, pRead_buf, n, flush);
+ if (status == TDEFL_STATUS_DONE)
+ {
+ result = MZ_TRUE;
+ break;
+ }
+ else if (status != TDEFL_STATUS_OKAY)
+ {
+ mz_zip_set_error(pZip, MZ_ZIP_COMPRESSION_FAILED);
+ break;
+ }
+ }
+
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pComp);
+
+ if (!result)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+ return MZ_FALSE;
+ }
+
+ uncomp_size = file_ofs;
+ comp_size = state.m_comp_size;
+ cur_archive_file_ofs = state.m_cur_archive_file_ofs;
+ }
+
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf);
+ }
+
+ if (!(level_and_flags & MZ_ZIP_FLAG_WRITE_HEADER_SET_SIZE))
+ {
+ mz_uint8 local_dir_footer[MZ_ZIP_DATA_DESCRIPTER_SIZE64];
+ mz_uint32 local_dir_footer_size = MZ_ZIP_DATA_DESCRIPTER_SIZE32;
+
+ MZ_WRITE_LE32(local_dir_footer + 0, MZ_ZIP_DATA_DESCRIPTOR_ID);
+ MZ_WRITE_LE32(local_dir_footer + 4, uncomp_crc32);
+ if (pExtra_data == NULL)
+ {
+ if (comp_size > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+
+ MZ_WRITE_LE32(local_dir_footer + 8, comp_size);
+ MZ_WRITE_LE32(local_dir_footer + 12, uncomp_size);
+ }
+ else
+ {
+ MZ_WRITE_LE64(local_dir_footer + 8, comp_size);
+ MZ_WRITE_LE64(local_dir_footer + 16, uncomp_size);
+ local_dir_footer_size = MZ_ZIP_DATA_DESCRIPTER_SIZE64;
+ }
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, local_dir_footer, local_dir_footer_size) != local_dir_footer_size)
+ return MZ_FALSE;
+
+ cur_archive_file_ofs += local_dir_footer_size;
+ }
+
+ if (level_and_flags & MZ_ZIP_FLAG_WRITE_HEADER_SET_SIZE)
+ {
+ if (pExtra_data != NULL)
+ {
+ extra_size = mz_zip_writer_create_zip64_extra_data(extra_data, (max_size >= MZ_UINT32_MAX) ? &uncomp_size : NULL,
+ (max_size >= MZ_UINT32_MAX) ? &comp_size : NULL, (local_dir_header_ofs >= MZ_UINT32_MAX) ? &local_dir_header_ofs : NULL);
+ }
+
+ if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header,
+ (mz_uint16)archive_name_size, (mz_uint16)(extra_size + user_extra_data_len),
+ (max_size >= MZ_UINT32_MAX) ? MZ_UINT32_MAX : uncomp_size,
+ (max_size >= MZ_UINT32_MAX) ? MZ_UINT32_MAX : comp_size,
+ uncomp_crc32, method, gen_flags, dos_time, dos_date))
+ return mz_zip_set_error(pZip, MZ_ZIP_INTERNAL_ERROR);
+
+ cur_archive_header_file_ofs = local_dir_header_ofs;
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_header_file_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ if (pExtra_data != NULL)
+ {
+ cur_archive_header_file_ofs += sizeof(local_dir_header);
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_header_file_ofs, pArchive_name, archive_name_size) != archive_name_size)
+ {
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+
+ cur_archive_header_file_ofs += archive_name_size;
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_header_file_ofs, extra_data, extra_size) != extra_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_archive_header_file_ofs += extra_size;
+ }
+ }
+
+ if (pExtra_data != NULL)
+ {
+ extra_size = mz_zip_writer_create_zip64_extra_data(extra_data, (uncomp_size >= MZ_UINT32_MAX) ? &uncomp_size : NULL,
+ (uncomp_size >= MZ_UINT32_MAX) ? &comp_size : NULL, (local_dir_header_ofs >= MZ_UINT32_MAX) ? &local_dir_header_ofs : NULL);
+ }
+
+ if (!mz_zip_writer_add_to_central_dir(pZip, pArchive_name, (mz_uint16)archive_name_size, pExtra_data, (mz_uint16)extra_size, pComment, comment_size,
+ uncomp_size, comp_size, uncomp_crc32, method, gen_flags, dos_time, dos_date, local_dir_header_ofs, ext_attributes,
+ user_extra_data_central, user_extra_data_central_len))
+ return MZ_FALSE;
+
+ pZip->m_total_files++;
+ pZip->m_archive_size = cur_archive_file_ofs;
+
+ return MZ_TRUE;
+}
+
+#ifndef MINIZ_NO_STDIO
+
+static size_t mz_file_read_func_stdio(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n)
+{
+ MZ_FILE *pSrc_file = (MZ_FILE *)pOpaque;
+ mz_int64 cur_ofs = MZ_FTELL64(pSrc_file);
+
+ if (((mz_int64)file_ofs < 0) || (((cur_ofs != (mz_int64)file_ofs)) && (MZ_FSEEK64(pSrc_file, (mz_int64)file_ofs, SEEK_SET))))
+ return 0;
+
+ return MZ_FREAD(pBuf, 1, n, pSrc_file);
+}
+
+mz_bool mz_zip_writer_add_cfile(mz_zip_archive *pZip, const char *pArchive_name, MZ_FILE *pSrc_file, mz_uint64 max_size, const MZ_TIME_T *pFile_time, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags,
+ const char *user_extra_data, mz_uint user_extra_data_len, const char *user_extra_data_central, mz_uint user_extra_data_central_len)
+{
+ return mz_zip_writer_add_read_buf_callback(pZip, pArchive_name, mz_file_read_func_stdio, pSrc_file, max_size, pFile_time, pComment, comment_size, level_and_flags,
+ user_extra_data, user_extra_data_len, user_extra_data_central, user_extra_data_central_len);
+}
+
+mz_bool mz_zip_writer_add_file(mz_zip_archive *pZip, const char *pArchive_name, const char *pSrc_filename, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags)
+{
+ MZ_FILE *pSrc_file = NULL;
+ mz_uint64 uncomp_size = 0;
+ MZ_TIME_T file_modified_time;
+ MZ_TIME_T *pFile_time = NULL;
+ mz_bool status;
+
+ memset(&file_modified_time, 0, sizeof(file_modified_time));
+
+#if !defined(MINIZ_NO_TIME) && !defined(MINIZ_NO_STDIO)
+ pFile_time = &file_modified_time;
+ if (!mz_zip_get_file_modified_time(pSrc_filename, &file_modified_time))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_STAT_FAILED);
+#endif
+
+ pSrc_file = MZ_FOPEN(pSrc_filename, "rb");
+ if (!pSrc_file)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_OPEN_FAILED);
+
+ MZ_FSEEK64(pSrc_file, 0, SEEK_END);
+ uncomp_size = MZ_FTELL64(pSrc_file);
+ MZ_FSEEK64(pSrc_file, 0, SEEK_SET);
+
+ status = mz_zip_writer_add_cfile(pZip, pArchive_name, pSrc_file, uncomp_size, pFile_time, pComment, comment_size, level_and_flags, NULL, 0, NULL, 0);
+
+ MZ_FCLOSE(pSrc_file);
+
+ return status;
+}
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+static mz_bool mz_zip_writer_update_zip64_extension_block(mz_zip_array *pNew_ext, mz_zip_archive *pZip, const mz_uint8 *pExt, uint32_t ext_len, mz_uint64 *pComp_size, mz_uint64 *pUncomp_size, mz_uint64 *pLocal_header_ofs, mz_uint32 *pDisk_start)
+{
+ /* + 64 should be enough for any new zip64 data */
+ if (!mz_zip_array_reserve(pZip, pNew_ext, ext_len + 64, MZ_FALSE))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ mz_zip_array_resize(pZip, pNew_ext, 0, MZ_FALSE);
+
+ if ((pUncomp_size) || (pComp_size) || (pLocal_header_ofs) || (pDisk_start))
+ {
+ mz_uint8 new_ext_block[64];
+ mz_uint8 *pDst = new_ext_block;
+ mz_write_le16(pDst, MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID);
+ mz_write_le16(pDst + sizeof(mz_uint16), 0);
+ pDst += sizeof(mz_uint16) * 2;
+
+ if (pUncomp_size)
+ {
+ mz_write_le64(pDst, *pUncomp_size);
+ pDst += sizeof(mz_uint64);
+ }
+
+ if (pComp_size)
+ {
+ mz_write_le64(pDst, *pComp_size);
+ pDst += sizeof(mz_uint64);
+ }
+
+ if (pLocal_header_ofs)
+ {
+ mz_write_le64(pDst, *pLocal_header_ofs);
+ pDst += sizeof(mz_uint64);
+ }
+
+ if (pDisk_start)
+ {
+ mz_write_le32(pDst, *pDisk_start);
+ pDst += sizeof(mz_uint32);
+ }
+
+ mz_write_le16(new_ext_block + sizeof(mz_uint16), (mz_uint16)((pDst - new_ext_block) - sizeof(mz_uint16) * 2));
+
+ if (!mz_zip_array_push_back(pZip, pNew_ext, new_ext_block, pDst - new_ext_block))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if ((pExt) && (ext_len))
+ {
+ mz_uint32 extra_size_remaining = ext_len;
+ const mz_uint8 *pExtra_data = pExt;
+
+ do
+ {
+ mz_uint32 field_id, field_data_size, field_total_size;
+
+ if (extra_size_remaining < (sizeof(mz_uint16) * 2))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ field_id = MZ_READ_LE16(pExtra_data);
+ field_data_size = MZ_READ_LE16(pExtra_data + sizeof(mz_uint16));
+ field_total_size = field_data_size + sizeof(mz_uint16) * 2;
+
+ if (field_total_size > extra_size_remaining)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ if (field_id != MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID)
+ {
+ if (!mz_zip_array_push_back(pZip, pNew_ext, pExtra_data, field_total_size))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ pExtra_data += field_total_size;
+ extra_size_remaining -= field_total_size;
+ } while (extra_size_remaining);
+ }
+
+ return MZ_TRUE;
+}
+
+/* TODO: This func is now pretty freakin complex due to zip64, split it up? */
+mz_bool mz_zip_writer_add_from_zip_reader(mz_zip_archive *pZip, mz_zip_archive *pSource_zip, mz_uint src_file_index)
+{
+ mz_uint n, bit_flags, num_alignment_padding_bytes, src_central_dir_following_data_size;
+ mz_uint64 src_archive_bytes_remaining, local_dir_header_ofs;
+ mz_uint64 cur_src_file_ofs, cur_dst_file_ofs;
+ mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)];
+ mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32;
+ mz_uint8 new_central_header[MZ_ZIP_CENTRAL_DIR_HEADER_SIZE];
+ size_t orig_central_dir_size;
+ mz_zip_internal_state *pState;
+ void *pBuf;
+ const mz_uint8 *pSrc_central_header;
+ mz_zip_archive_file_stat src_file_stat;
+ mz_uint32 src_filename_len, src_comment_len, src_ext_len;
+ mz_uint32 local_header_filename_size, local_header_extra_len;
+ mz_uint64 local_header_comp_size, local_header_uncomp_size;
+ mz_bool found_zip64_ext_data_in_ldir = MZ_FALSE;
+
+ /* Sanity checks */
+ if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) || (!pSource_zip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState = pZip->m_pState;
+
+ /* Don't support copying files from zip64 archives to non-zip64, even though in some cases this is possible */
+ if ((pSource_zip->m_pState->m_zip64) && (!pZip->m_pState->m_zip64))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ /* Get pointer to the source central dir header and crack it */
+ if (NULL == (pSrc_central_header = mz_zip_get_cdh(pSource_zip, src_file_index)))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (MZ_READ_LE32(pSrc_central_header + MZ_ZIP_CDH_SIG_OFS) != MZ_ZIP_CENTRAL_DIR_HEADER_SIG)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ src_filename_len = MZ_READ_LE16(pSrc_central_header + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ src_comment_len = MZ_READ_LE16(pSrc_central_header + MZ_ZIP_CDH_COMMENT_LEN_OFS);
+ src_ext_len = MZ_READ_LE16(pSrc_central_header + MZ_ZIP_CDH_EXTRA_LEN_OFS);
+ src_central_dir_following_data_size = src_filename_len + src_ext_len + src_comment_len;
+
+ /* TODO: We don't support central dir's >= MZ_UINT32_MAX bytes right now (+32 fudge factor in case we need to add more extra data) */
+ if ((pState->m_central_dir.m_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + src_central_dir_following_data_size + 32) >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_CDIR_SIZE);
+
+ num_alignment_padding_bytes = mz_zip_writer_compute_padding_needed_for_file_alignment(pZip);
+
+ if (!pState->m_zip64)
+ {
+ if (pZip->m_total_files == MZ_UINT16_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+ else
+ {
+ /* TODO: Our zip64 support still has some 32-bit limits that may not be worth fixing. */
+ if (pZip->m_total_files == MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+
+ if (!mz_zip_file_stat_internal(pSource_zip, src_file_index, pSrc_central_header, &src_file_stat, NULL))
+ return MZ_FALSE;
+
+ cur_src_file_ofs = src_file_stat.m_local_header_ofs;
+ cur_dst_file_ofs = pZip->m_archive_size;
+
+ /* Read the source archive's local dir header */
+ if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+
+ if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+
+ cur_src_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE;
+
+ /* Compute the total size we need to copy (filename+extra data+compressed data) */
+ local_header_filename_size = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS);
+ local_header_extra_len = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS);
+ local_header_comp_size = MZ_READ_LE32(pLocal_header + MZ_ZIP_LDH_COMPRESSED_SIZE_OFS);
+ local_header_uncomp_size = MZ_READ_LE32(pLocal_header + MZ_ZIP_LDH_DECOMPRESSED_SIZE_OFS);
+ src_archive_bytes_remaining = local_header_filename_size + local_header_extra_len + src_file_stat.m_comp_size;
+
+ /* Try to find a zip64 extended information field */
+ if ((local_header_extra_len) && ((local_header_comp_size == MZ_UINT32_MAX) || (local_header_uncomp_size == MZ_UINT32_MAX)))
+ {
+ mz_zip_array file_data_array;
+ const mz_uint8 *pExtra_data;
+ mz_uint32 extra_size_remaining = local_header_extra_len;
+
+ mz_zip_array_init(&file_data_array, 1);
+ if (!mz_zip_array_resize(pZip, &file_data_array, local_header_extra_len, MZ_FALSE))
+ {
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, src_file_stat.m_local_header_ofs + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + local_header_filename_size, file_data_array.m_p, local_header_extra_len) != local_header_extra_len)
+ {
+ mz_zip_array_clear(pZip, &file_data_array);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ }
+
+ pExtra_data = (const mz_uint8 *)file_data_array.m_p;
+
+ do
+ {
+ mz_uint32 field_id, field_data_size, field_total_size;
+
+ if (extra_size_remaining < (sizeof(mz_uint16) * 2))
+ {
+ mz_zip_array_clear(pZip, &file_data_array);
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ field_id = MZ_READ_LE16(pExtra_data);
+ field_data_size = MZ_READ_LE16(pExtra_data + sizeof(mz_uint16));
+ field_total_size = field_data_size + sizeof(mz_uint16) * 2;
+
+ if (field_total_size > extra_size_remaining)
+ {
+ mz_zip_array_clear(pZip, &file_data_array);
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ if (field_id == MZ_ZIP64_EXTENDED_INFORMATION_FIELD_HEADER_ID)
+ {
+ const mz_uint8 *pSrc_field_data = pExtra_data + sizeof(mz_uint32);
+
+ if (field_data_size < sizeof(mz_uint64) * 2)
+ {
+ mz_zip_array_clear(pZip, &file_data_array);
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_HEADER_OR_CORRUPTED);
+ }
+
+ local_header_uncomp_size = MZ_READ_LE64(pSrc_field_data);
+ local_header_comp_size = MZ_READ_LE64(pSrc_field_data + sizeof(mz_uint64)); /* may be 0 if there's a descriptor */
+
+ found_zip64_ext_data_in_ldir = MZ_TRUE;
+ break;
+ }
+
+ pExtra_data += field_total_size;
+ extra_size_remaining -= field_total_size;
+ } while (extra_size_remaining);
+
+ mz_zip_array_clear(pZip, &file_data_array);
+ }
+
+ if (!pState->m_zip64)
+ {
+ /* Try to detect if the new archive will most likely wind up too big and bail early (+(sizeof(mz_uint32) * 4) is for the optional descriptor which could be present, +64 is a fudge factor). */
+ /* We also check when the archive is finalized so this doesn't need to be perfect. */
+ mz_uint64 approx_new_archive_size = cur_dst_file_ofs + num_alignment_padding_bytes + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + src_archive_bytes_remaining + (sizeof(mz_uint32) * 4) +
+ pState->m_central_dir.m_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + src_central_dir_following_data_size + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE + 64;
+
+ if (approx_new_archive_size >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+ }
+
+ /* Write dest archive padding */
+ if (!mz_zip_writer_write_zeros(pZip, cur_dst_file_ofs, num_alignment_padding_bytes))
+ return MZ_FALSE;
+
+ cur_dst_file_ofs += num_alignment_padding_bytes;
+
+ local_dir_header_ofs = cur_dst_file_ofs;
+ if (pZip->m_file_offset_alignment)
+ {
+ MZ_ASSERT((local_dir_header_ofs & (pZip->m_file_offset_alignment - 1)) == 0);
+ }
+
+ /* The original zip's local header+ext block doesn't change, even with zip64, so we can just copy it over to the dest zip */
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_dst_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ cur_dst_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE;
+
+ /* Copy over the source archive bytes to the dest archive, also ensure we have enough buf space to handle optional data descriptor */
+ if (NULL == (pBuf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)MZ_MAX(32U, MZ_MIN((mz_uint64)MZ_ZIP_MAX_IO_BUF_SIZE, src_archive_bytes_remaining)))))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ while (src_archive_bytes_remaining)
+ {
+ n = (mz_uint)MZ_MIN((mz_uint64)MZ_ZIP_MAX_IO_BUF_SIZE, src_archive_bytes_remaining);
+ if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pBuf, n) != n)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ }
+ cur_src_file_ofs += n;
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_dst_file_ofs, pBuf, n) != n)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+ cur_dst_file_ofs += n;
+
+ src_archive_bytes_remaining -= n;
+ }
+
+ /* Now deal with the optional data descriptor */
+ bit_flags = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_BIT_FLAG_OFS);
+ if (bit_flags & 8)
+ {
+ /* Copy data descriptor */
+ if ((pSource_zip->m_pState->m_zip64) || (found_zip64_ext_data_in_ldir))
+ {
+ /* src is zip64, dest must be zip64 */
+
+ /* name uint32_t's */
+ /* id 1 (optional in zip64?) */
+ /* crc 1 */
+ /* comp_size 2 */
+ /* uncomp_size 2 */
+ if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pBuf, (sizeof(mz_uint32) * 6)) != (sizeof(mz_uint32) * 6))
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ }
+
+ n = sizeof(mz_uint32) * ((MZ_READ_LE32(pBuf) == MZ_ZIP_DATA_DESCRIPTOR_ID) ? 6 : 5);
+ }
+ else
+ {
+ /* src is NOT zip64 */
+ mz_bool has_id;
+
+ if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pBuf, sizeof(mz_uint32) * 4) != sizeof(mz_uint32) * 4)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_READ_FAILED);
+ }
+
+ has_id = (MZ_READ_LE32(pBuf) == MZ_ZIP_DATA_DESCRIPTOR_ID);
+
+ if (pZip->m_pState->m_zip64)
+ {
+ /* dest is zip64, so upgrade the data descriptor */
+ const mz_uint32 *pSrc_descriptor = (const mz_uint32 *)((const mz_uint8 *)pBuf + (has_id ? sizeof(mz_uint32) : 0));
+ const mz_uint32 src_crc32 = pSrc_descriptor[0];
+ const mz_uint64 src_comp_size = pSrc_descriptor[1];
+ const mz_uint64 src_uncomp_size = pSrc_descriptor[2];
+
+ mz_write_le32((mz_uint8 *)pBuf, MZ_ZIP_DATA_DESCRIPTOR_ID);
+ mz_write_le32((mz_uint8 *)pBuf + sizeof(mz_uint32) * 1, src_crc32);
+ mz_write_le64((mz_uint8 *)pBuf + sizeof(mz_uint32) * 2, src_comp_size);
+ mz_write_le64((mz_uint8 *)pBuf + sizeof(mz_uint32) * 4, src_uncomp_size);
+
+ n = sizeof(mz_uint32) * 6;
+ }
+ else
+ {
+ /* dest is NOT zip64, just copy it as-is */
+ n = sizeof(mz_uint32) * (has_id ? 4 : 3);
+ }
+ }
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_dst_file_ofs, pBuf, n) != n)
+ {
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+ }
+
+ cur_src_file_ofs += n;
+ cur_dst_file_ofs += n;
+ }
+ pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf);
+
+ /* Finally, add the new central dir header */
+ orig_central_dir_size = pState->m_central_dir.m_size;
+
+ memcpy(new_central_header, pSrc_central_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE);
+
+ if (pState->m_zip64)
+ {
+ /* This is the painful part: We need to write a new central dir header + ext block with updated zip64 fields, and ensure the old fields (if any) are not included. */
+ const mz_uint8 *pSrc_ext = pSrc_central_header + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + src_filename_len;
+ mz_zip_array new_ext_block;
+
+ mz_zip_array_init(&new_ext_block, sizeof(mz_uint8));
+
+ MZ_WRITE_LE32(new_central_header + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS, MZ_UINT32_MAX);
+ MZ_WRITE_LE32(new_central_header + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS, MZ_UINT32_MAX);
+ MZ_WRITE_LE32(new_central_header + MZ_ZIP_CDH_LOCAL_HEADER_OFS, MZ_UINT32_MAX);
+
+ if (!mz_zip_writer_update_zip64_extension_block(&new_ext_block, pZip, pSrc_ext, src_ext_len, &src_file_stat.m_comp_size, &src_file_stat.m_uncomp_size, &local_dir_header_ofs, NULL))
+ {
+ mz_zip_array_clear(pZip, &new_ext_block);
+ return MZ_FALSE;
+ }
+
+ MZ_WRITE_LE16(new_central_header + MZ_ZIP_CDH_EXTRA_LEN_OFS, new_ext_block.m_size);
+
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, new_central_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE))
+ {
+ mz_zip_array_clear(pZip, &new_ext_block);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pSrc_central_header + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, src_filename_len))
+ {
+ mz_zip_array_clear(pZip, &new_ext_block);
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, new_ext_block.m_p, new_ext_block.m_size))
+ {
+ mz_zip_array_clear(pZip, &new_ext_block);
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pSrc_central_header + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + src_filename_len + src_ext_len, src_comment_len))
+ {
+ mz_zip_array_clear(pZip, &new_ext_block);
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ mz_zip_array_clear(pZip, &new_ext_block);
+ }
+ else
+ {
+ /* sanity checks */
+ if (cur_dst_file_ofs > MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+
+ if (local_dir_header_ofs >= MZ_UINT32_MAX)
+ return mz_zip_set_error(pZip, MZ_ZIP_ARCHIVE_TOO_LARGE);
+
+ MZ_WRITE_LE32(new_central_header + MZ_ZIP_CDH_LOCAL_HEADER_OFS, local_dir_header_ofs);
+
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, new_central_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE))
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pSrc_central_header + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, src_central_dir_following_data_size))
+ {
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+ }
+
+ /* This shouldn't trigger unless we screwed up during the initial sanity checks */
+ if (pState->m_central_dir.m_size >= MZ_UINT32_MAX)
+ {
+ /* TODO: Support central dirs >= 32-bits in size */
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_UNSUPPORTED_CDIR_SIZE);
+ }
+
+ n = (mz_uint32)orig_central_dir_size;
+ if (!mz_zip_array_push_back(pZip, &pState->m_central_dir_offsets, &n, 1))
+ {
+ mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE);
+ return mz_zip_set_error(pZip, MZ_ZIP_ALLOC_FAILED);
+ }
+
+ pZip->m_total_files++;
+ pZip->m_archive_size = cur_dst_file_ofs;
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_finalize_archive(mz_zip_archive *pZip)
+{
+ mz_zip_internal_state *pState;
+ mz_uint64 central_dir_ofs, central_dir_size;
+ mz_uint8 hdr[256];
+
+ if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ pState = pZip->m_pState;
+
+ if (pState->m_zip64)
+ {
+ if ((pZip->m_total_files > MZ_UINT32_MAX) || (pState->m_central_dir.m_size >= MZ_UINT32_MAX))
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+ else
+ {
+ if ((pZip->m_total_files > MZ_UINT16_MAX) || ((pZip->m_archive_size + pState->m_central_dir.m_size + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) > MZ_UINT32_MAX))
+ return mz_zip_set_error(pZip, MZ_ZIP_TOO_MANY_FILES);
+ }
+
+ central_dir_ofs = 0;
+ central_dir_size = 0;
+ if (pZip->m_total_files)
+ {
+ /* Write central directory */
+ central_dir_ofs = pZip->m_archive_size;
+ central_dir_size = pState->m_central_dir.m_size;
+ pZip->m_central_directory_file_ofs = central_dir_ofs;
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, central_dir_ofs, pState->m_central_dir.m_p, (size_t)central_dir_size) != central_dir_size)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ pZip->m_archive_size += central_dir_size;
+ }
+
+ if (pState->m_zip64)
+ {
+ /* Write zip64 end of central directory header */
+ mz_uint64 rel_ofs_to_zip64_ecdr = pZip->m_archive_size;
+
+ MZ_CLEAR_OBJ(hdr);
+ MZ_WRITE_LE32(hdr + MZ_ZIP64_ECDH_SIG_OFS, MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIG);
+ MZ_WRITE_LE64(hdr + MZ_ZIP64_ECDH_SIZE_OF_RECORD_OFS, MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE - sizeof(mz_uint32) - sizeof(mz_uint64));
+ MZ_WRITE_LE16(hdr + MZ_ZIP64_ECDH_VERSION_MADE_BY_OFS, 0x031E); /* TODO: always Unix */
+ MZ_WRITE_LE16(hdr + MZ_ZIP64_ECDH_VERSION_NEEDED_OFS, 0x002D);
+ MZ_WRITE_LE64(hdr + MZ_ZIP64_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS, pZip->m_total_files);
+ MZ_WRITE_LE64(hdr + MZ_ZIP64_ECDH_CDIR_TOTAL_ENTRIES_OFS, pZip->m_total_files);
+ MZ_WRITE_LE64(hdr + MZ_ZIP64_ECDH_CDIR_SIZE_OFS, central_dir_size);
+ MZ_WRITE_LE64(hdr + MZ_ZIP64_ECDH_CDIR_OFS_OFS, central_dir_ofs);
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, pZip->m_archive_size, hdr, MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE) != MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ pZip->m_archive_size += MZ_ZIP64_END_OF_CENTRAL_DIR_HEADER_SIZE;
+
+ /* Write zip64 end of central directory locator */
+ MZ_CLEAR_OBJ(hdr);
+ MZ_WRITE_LE32(hdr + MZ_ZIP64_ECDL_SIG_OFS, MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIG);
+ MZ_WRITE_LE64(hdr + MZ_ZIP64_ECDL_REL_OFS_TO_ZIP64_ECDR_OFS, rel_ofs_to_zip64_ecdr);
+ MZ_WRITE_LE32(hdr + MZ_ZIP64_ECDL_TOTAL_NUMBER_OF_DISKS_OFS, 1);
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, pZip->m_archive_size, hdr, MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE) != MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+ pZip->m_archive_size += MZ_ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIZE;
+ }
+
+ /* Write end of central directory record */
+ MZ_CLEAR_OBJ(hdr);
+ MZ_WRITE_LE32(hdr + MZ_ZIP_ECDH_SIG_OFS, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG);
+ MZ_WRITE_LE16(hdr + MZ_ZIP_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS, MZ_MIN(MZ_UINT16_MAX, pZip->m_total_files));
+ MZ_WRITE_LE16(hdr + MZ_ZIP_ECDH_CDIR_TOTAL_ENTRIES_OFS, MZ_MIN(MZ_UINT16_MAX, pZip->m_total_files));
+ MZ_WRITE_LE32(hdr + MZ_ZIP_ECDH_CDIR_SIZE_OFS, MZ_MIN(MZ_UINT32_MAX, central_dir_size));
+ MZ_WRITE_LE32(hdr + MZ_ZIP_ECDH_CDIR_OFS_OFS, MZ_MIN(MZ_UINT32_MAX, central_dir_ofs));
+
+ if (pZip->m_pWrite(pZip->m_pIO_opaque, pZip->m_archive_size, hdr, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) != MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE)
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_WRITE_FAILED);
+
+#ifndef MINIZ_NO_STDIO
+ if ((pState->m_pFile) && (MZ_FFLUSH(pState->m_pFile) == EOF))
+ return mz_zip_set_error(pZip, MZ_ZIP_FILE_CLOSE_FAILED);
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+ pZip->m_archive_size += MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE;
+
+ pZip->m_zip_mode = MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED;
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_finalize_heap_archive(mz_zip_archive *pZip, void **ppBuf, size_t *pSize)
+{
+ if ((!ppBuf) || (!pSize))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ *ppBuf = NULL;
+ *pSize = 0;
+
+ if ((!pZip) || (!pZip->m_pState))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (pZip->m_pWrite != mz_zip_heap_write_func)
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ if (!mz_zip_writer_finalize_archive(pZip))
+ return MZ_FALSE;
+
+ *ppBuf = pZip->m_pState->m_pMem;
+ *pSize = pZip->m_pState->m_mem_size;
+ pZip->m_pState->m_pMem = NULL;
+ pZip->m_pState->m_mem_size = pZip->m_pState->m_mem_capacity = 0;
+
+ return MZ_TRUE;
+}
+
+mz_bool mz_zip_writer_end(mz_zip_archive *pZip)
+{
+ return mz_zip_writer_end_internal(pZip, MZ_TRUE);
+}
+
+#ifndef MINIZ_NO_STDIO
+mz_bool mz_zip_add_mem_to_archive_file_in_place(const char *pZip_filename, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags)
+{
+ return mz_zip_add_mem_to_archive_file_in_place_v2(pZip_filename, pArchive_name, pBuf, buf_size, pComment, comment_size, level_and_flags, NULL);
+}
+
+mz_bool mz_zip_add_mem_to_archive_file_in_place_v2(const char *pZip_filename, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags, mz_zip_error *pErr)
+{
+ mz_bool status, created_new_archive = MZ_FALSE;
+ mz_zip_archive zip_archive;
+ struct MZ_FILE_STAT_STRUCT file_stat;
+ mz_zip_error actual_err = MZ_ZIP_NO_ERROR;
+
+ mz_zip_zero_struct(&zip_archive);
+ if ((int)level_and_flags < 0)
+ level_and_flags = MZ_DEFAULT_LEVEL;
+
+ if ((!pZip_filename) || (!pArchive_name) || ((buf_size) && (!pBuf)) || ((comment_size) && (!pComment)) || ((level_and_flags & 0xF) > MZ_UBER_COMPRESSION))
+ {
+ if (pErr)
+ *pErr = MZ_ZIP_INVALID_PARAMETER;
+ return MZ_FALSE;
+ }
+
+ if (!mz_zip_writer_validate_archive_name(pArchive_name))
+ {
+ if (pErr)
+ *pErr = MZ_ZIP_INVALID_FILENAME;
+ return MZ_FALSE;
+ }
+
+ /* Important: The regular non-64 bit version of stat() can fail here if the file is very large, which could cause the archive to be overwritten. */
+ /* So be sure to compile with _LARGEFILE64_SOURCE 1 */
+ if (MZ_FILE_STAT(pZip_filename, &file_stat) != 0)
+ {
+ /* Create a new archive. */
+ if (!mz_zip_writer_init_file_v2(&zip_archive, pZip_filename, 0, level_and_flags))
+ {
+ if (pErr)
+ *pErr = zip_archive.m_last_error;
+ return MZ_FALSE;
+ }
+
+ created_new_archive = MZ_TRUE;
+ }
+ else
+ {
+ /* Append to an existing archive. */
+ if (!mz_zip_reader_init_file_v2(&zip_archive, pZip_filename, level_and_flags | MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY, 0, 0))
+ {
+ if (pErr)
+ *pErr = zip_archive.m_last_error;
+ return MZ_FALSE;
+ }
+
+ if (!mz_zip_writer_init_from_reader_v2(&zip_archive, pZip_filename, level_and_flags))
+ {
+ if (pErr)
+ *pErr = zip_archive.m_last_error;
+
+ mz_zip_reader_end_internal(&zip_archive, MZ_FALSE);
+
+ return MZ_FALSE;
+ }
+ }
+
+ status = mz_zip_writer_add_mem_ex(&zip_archive, pArchive_name, pBuf, buf_size, pComment, comment_size, level_and_flags, 0, 0);
+ actual_err = zip_archive.m_last_error;
+
+ /* Always finalize, even if adding failed for some reason, so we have a valid central directory. (This may not always succeed, but we can try.) */
+ if (!mz_zip_writer_finalize_archive(&zip_archive))
+ {
+ if (!actual_err)
+ actual_err = zip_archive.m_last_error;
+
+ status = MZ_FALSE;
+ }
+
+ if (!mz_zip_writer_end_internal(&zip_archive, status))
+ {
+ if (!actual_err)
+ actual_err = zip_archive.m_last_error;
+
+ status = MZ_FALSE;
+ }
+
+ if ((!status) && (created_new_archive))
+ {
+ /* It's a new archive and something went wrong, so just delete it. */
+ int ignoredStatus = MZ_DELETE_FILE(pZip_filename);
+ (void)ignoredStatus;
+ }
+
+ if (pErr)
+ *pErr = actual_err;
+
+ return status;
+}
+
+void *mz_zip_extract_archive_file_to_heap_v2(const char *pZip_filename, const char *pArchive_name, const char *pComment, size_t *pSize, mz_uint flags, mz_zip_error *pErr)
+{
+ mz_uint32 file_index;
+ mz_zip_archive zip_archive;
+ void *p = NULL;
+
+ if (pSize)
+ *pSize = 0;
+
+ if ((!pZip_filename) || (!pArchive_name))
+ {
+ if (pErr)
+ *pErr = MZ_ZIP_INVALID_PARAMETER;
+
+ return NULL;
+ }
+
+ mz_zip_zero_struct(&zip_archive);
+ if (!mz_zip_reader_init_file_v2(&zip_archive, pZip_filename, flags | MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY, 0, 0))
+ {
+ if (pErr)
+ *pErr = zip_archive.m_last_error;
+
+ return NULL;
+ }
+
+ if (mz_zip_reader_locate_file_v2(&zip_archive, pArchive_name, pComment, flags, &file_index))
+ {
+ p = mz_zip_reader_extract_to_heap(&zip_archive, file_index, pSize, flags);
+ }
+
+ mz_zip_reader_end_internal(&zip_archive, p != NULL);
+
+ if (pErr)
+ *pErr = zip_archive.m_last_error;
+
+ return p;
+}
+
+void *mz_zip_extract_archive_file_to_heap(const char *pZip_filename, const char *pArchive_name, size_t *pSize, mz_uint flags)
+{
+ return mz_zip_extract_archive_file_to_heap_v2(pZip_filename, pArchive_name, NULL, pSize, flags, NULL);
+}
+
+#endif /* #ifndef MINIZ_NO_STDIO */
+
+#endif /* #ifndef MINIZ_NO_ARCHIVE_WRITING_APIS */
+
+/* ------------------- Misc utils */
+
+mz_zip_mode mz_zip_get_mode(mz_zip_archive *pZip)
+{
+ return pZip ? pZip->m_zip_mode : MZ_ZIP_MODE_INVALID;
+}
+
+mz_zip_type mz_zip_get_type(mz_zip_archive *pZip)
+{
+ return pZip ? pZip->m_zip_type : MZ_ZIP_TYPE_INVALID;
+}
+
+mz_zip_error mz_zip_set_last_error(mz_zip_archive *pZip, mz_zip_error err_num)
+{
+ mz_zip_error prev_err;
+
+ if (!pZip)
+ return MZ_ZIP_INVALID_PARAMETER;
+
+ prev_err = pZip->m_last_error;
+
+ pZip->m_last_error = err_num;
+ return prev_err;
+}
+
+mz_zip_error mz_zip_peek_last_error(mz_zip_archive *pZip)
+{
+ if (!pZip)
+ return MZ_ZIP_INVALID_PARAMETER;
+
+ return pZip->m_last_error;
+}
+
+mz_zip_error mz_zip_clear_last_error(mz_zip_archive *pZip)
+{
+ return mz_zip_set_last_error(pZip, MZ_ZIP_NO_ERROR);
+}
+
+mz_zip_error mz_zip_get_last_error(mz_zip_archive *pZip)
+{
+ mz_zip_error prev_err;
+
+ if (!pZip)
+ return MZ_ZIP_INVALID_PARAMETER;
+
+ prev_err = pZip->m_last_error;
+
+ pZip->m_last_error = MZ_ZIP_NO_ERROR;
+ return prev_err;
+}
+
+const char *mz_zip_get_error_string(mz_zip_error mz_err)
+{
+ switch (mz_err)
+ {
+ case MZ_ZIP_NO_ERROR:
+ return "no error";
+ case MZ_ZIP_UNDEFINED_ERROR:
+ return "undefined error";
+ case MZ_ZIP_TOO_MANY_FILES:
+ return "too many files";
+ case MZ_ZIP_FILE_TOO_LARGE:
+ return "file too large";
+ case MZ_ZIP_UNSUPPORTED_METHOD:
+ return "unsupported method";
+ case MZ_ZIP_UNSUPPORTED_ENCRYPTION:
+ return "unsupported encryption";
+ case MZ_ZIP_UNSUPPORTED_FEATURE:
+ return "unsupported feature";
+ case MZ_ZIP_FAILED_FINDING_CENTRAL_DIR:
+ return "failed finding central directory";
+ case MZ_ZIP_NOT_AN_ARCHIVE:
+ return "not a ZIP archive";
+ case MZ_ZIP_INVALID_HEADER_OR_CORRUPTED:
+ return "invalid header or archive is corrupted";
+ case MZ_ZIP_UNSUPPORTED_MULTIDISK:
+ return "unsupported multidisk archive";
+ case MZ_ZIP_DECOMPRESSION_FAILED:
+ return "decompression failed or archive is corrupted";
+ case MZ_ZIP_COMPRESSION_FAILED:
+ return "compression failed";
+ case MZ_ZIP_UNEXPECTED_DECOMPRESSED_SIZE:
+ return "unexpected decompressed size";
+ case MZ_ZIP_CRC_CHECK_FAILED:
+ return "CRC-32 check failed";
+ case MZ_ZIP_UNSUPPORTED_CDIR_SIZE:
+ return "unsupported central directory size";
+ case MZ_ZIP_ALLOC_FAILED:
+ return "allocation failed";
+ case MZ_ZIP_FILE_OPEN_FAILED:
+ return "file open failed";
+ case MZ_ZIP_FILE_CREATE_FAILED:
+ return "file create failed";
+ case MZ_ZIP_FILE_WRITE_FAILED:
+ return "file write failed";
+ case MZ_ZIP_FILE_READ_FAILED:
+ return "file read failed";
+ case MZ_ZIP_FILE_CLOSE_FAILED:
+ return "file close failed";
+ case MZ_ZIP_FILE_SEEK_FAILED:
+ return "file seek failed";
+ case MZ_ZIP_FILE_STAT_FAILED:
+ return "file stat failed";
+ case MZ_ZIP_INVALID_PARAMETER:
+ return "invalid parameter";
+ case MZ_ZIP_INVALID_FILENAME:
+ return "invalid filename";
+ case MZ_ZIP_BUF_TOO_SMALL:
+ return "buffer too small";
+ case MZ_ZIP_INTERNAL_ERROR:
+ return "internal error";
+ case MZ_ZIP_FILE_NOT_FOUND:
+ return "file not found";
+ case MZ_ZIP_ARCHIVE_TOO_LARGE:
+ return "archive is too large";
+ case MZ_ZIP_VALIDATION_FAILED:
+ return "validation failed";
+ case MZ_ZIP_WRITE_CALLBACK_FAILED:
+ return "write calledback failed";
+ default:
+ break;
+ }
+
+ return "unknown error";
+}
+
+/* Note: Just because the archive is not zip64 doesn't necessarily mean it doesn't have Zip64 extended information extra field, argh. */
+mz_bool mz_zip_is_zip64(mz_zip_archive *pZip)
+{
+ if ((!pZip) || (!pZip->m_pState))
+ return MZ_FALSE;
+
+ return pZip->m_pState->m_zip64;
+}
+
+size_t mz_zip_get_central_dir_size(mz_zip_archive *pZip)
+{
+ if ((!pZip) || (!pZip->m_pState))
+ return 0;
+
+ return pZip->m_pState->m_central_dir.m_size;
+}
+
+mz_uint mz_zip_reader_get_num_files(mz_zip_archive *pZip)
+{
+ return pZip ? pZip->m_total_files : 0;
+}
+
+mz_uint64 mz_zip_get_archive_size(mz_zip_archive *pZip)
+{
+ if (!pZip)
+ return 0;
+ return pZip->m_archive_size;
+}
+
+mz_uint64 mz_zip_get_archive_file_start_offset(mz_zip_archive *pZip)
+{
+ if ((!pZip) || (!pZip->m_pState))
+ return 0;
+ return pZip->m_pState->m_file_archive_start_ofs;
+}
+
+MZ_FILE *mz_zip_get_cfile(mz_zip_archive *pZip)
+{
+ if ((!pZip) || (!pZip->m_pState))
+ return 0;
+ return pZip->m_pState->m_pFile;
+}
+
+size_t mz_zip_read_archive_data(mz_zip_archive *pZip, mz_uint64 file_ofs, void *pBuf, size_t n)
+{
+ if ((!pZip) || (!pZip->m_pState) || (!pBuf) || (!pZip->m_pRead))
+ return mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+
+ return pZip->m_pRead(pZip->m_pIO_opaque, file_ofs, pBuf, n);
+}
+
+mz_uint mz_zip_reader_get_filename(mz_zip_archive *pZip, mz_uint file_index, char *pFilename, mz_uint filename_buf_size)
+{
+ mz_uint n;
+ const mz_uint8 *p = mz_zip_get_cdh(pZip, file_index);
+ if (!p)
+ {
+ if (filename_buf_size)
+ pFilename[0] = '\0';
+ mz_zip_set_error(pZip, MZ_ZIP_INVALID_PARAMETER);
+ return 0;
+ }
+ n = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS);
+ if (filename_buf_size)
+ {
+ n = MZ_MIN(n, filename_buf_size - 1);
+ memcpy(pFilename, p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, n);
+ pFilename[n] = '\0';
+ }
+ return n + 1;
+}
+
+mz_bool mz_zip_reader_file_stat(mz_zip_archive *pZip, mz_uint file_index, mz_zip_archive_file_stat *pStat)
+{
+ return mz_zip_file_stat_internal(pZip, file_index, mz_zip_get_cdh(pZip, file_index), pStat, NULL);
+}
+
+mz_bool mz_zip_end(mz_zip_archive *pZip)
+{
+ if (!pZip)
+ return MZ_FALSE;
+
+ if (pZip->m_zip_mode == MZ_ZIP_MODE_READING)
+ return mz_zip_reader_end(pZip);
+#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS
+ else if ((pZip->m_zip_mode == MZ_ZIP_MODE_WRITING) || (pZip->m_zip_mode == MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED))
+ return mz_zip_writer_end(pZip);
+#endif
+
+ return MZ_FALSE;
+}
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /*#ifndef MINIZ_NO_ARCHIVE_APIS*/
diff --git a/source/luametatex/source/libraries/miniz/miniz.h b/source/luametatex/source/libraries/miniz/miniz.h
new file mode 100644
index 000000000..0e65e38b1
--- /dev/null
+++ b/source/luametatex/source/libraries/miniz/miniz.h
@@ -0,0 +1,1350 @@
+#define MINIZ_EXPORT
+/* miniz.c 2.2.0 - public domain deflate/inflate, zlib-subset, ZIP reading/writing/appending, PNG writing
+ See "unlicense" statement at the end of this file.
+ Rich Geldreich <richgel99@gmail.com>, last updated Oct. 13, 2013
+ Implements RFC 1950: http://www.ietf.org/rfc/rfc1950.txt and RFC 1951: http://www.ietf.org/rfc/rfc1951.txt
+
+ Most API's defined in miniz.c are optional. For example, to disable the archive related functions just define
+ MINIZ_NO_ARCHIVE_APIS, or to get rid of all stdio usage define MINIZ_NO_STDIO (see the list below for more macros).
+
+ * Low-level Deflate/Inflate implementation notes:
+
+ Compression: Use the "tdefl" API's. The compressor supports raw, static, and dynamic blocks, lazy or
+ greedy parsing, match length filtering, RLE-only, and Huffman-only streams. It performs and compresses
+ approximately as well as zlib.
+
+ Decompression: Use the "tinfl" API's. The entire decompressor is implemented as a single function
+ coroutine: see tinfl_decompress(). It supports decompression into a 32KB (or larger power of 2) wrapping buffer, or into a memory
+ block large enough to hold the entire file.
+
+ The low-level tdefl/tinfl API's do not make any use of dynamic memory allocation.
+
+ * zlib-style API notes:
+
+ miniz.c implements a fairly large subset of zlib. There's enough functionality present for it to be a drop-in
+ zlib replacement in many apps:
+ The z_stream struct, optional memory allocation callbacks
+ deflateInit/deflateInit2/deflate/deflateReset/deflateEnd/deflateBound
+ inflateInit/inflateInit2/inflate/inflateReset/inflateEnd
+ compress, compress2, compressBound, uncompress
+ CRC-32, Adler-32 - Using modern, minimal code size, CPU cache friendly routines.
+ Supports raw deflate streams or standard zlib streams with adler-32 checking.
+
+ Limitations:
+ The callback API's are not implemented yet. No support for gzip headers or zlib static dictionaries.
+ I've tried to closely emulate zlib's various flavors of stream flushing and return status codes, but
+ there are no guarantees that miniz.c pulls this off perfectly.
+
+ * PNG writing: See the tdefl_write_image_to_png_file_in_memory() function, originally written by
+ Alex Evans. Supports 1-4 bytes/pixel images.
+
+ * ZIP archive API notes:
+
+ The ZIP archive API's where designed with simplicity and efficiency in mind, with just enough abstraction to
+ get the job done with minimal fuss. There are simple API's to retrieve file information, read files from
+ existing archives, create new archives, append new files to existing archives, or clone archive data from
+ one archive to another. It supports archives located in memory or the heap, on disk (using stdio.h),
+ or you can specify custom file read/write callbacks.
+
+ - Archive reading: Just call this function to read a single file from a disk archive:
+
+ void *mz_zip_extract_archive_file_to_heap(const char *pZip_filename, const char *pArchive_name,
+ size_t *pSize, mz_uint zip_flags);
+
+ For more complex cases, use the "mz_zip_reader" functions. Upon opening an archive, the entire central
+ directory is located and read as-is into memory, and subsequent file access only occurs when reading individual files.
+
+ - Archives file scanning: The simple way is to use this function to scan a loaded archive for a specific file:
+
+ int mz_zip_reader_locate_file(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags);
+
+ The locate operation can optionally check file comments too, which (as one example) can be used to identify
+ multiple versions of the same file in an archive. This function uses a simple linear search through the central
+ directory, so it's not very fast.
+
+ Alternately, you can iterate through all the files in an archive (using mz_zip_reader_get_num_files()) and
+ retrieve detailed info on each file by calling mz_zip_reader_file_stat().
+
+ - Archive creation: Use the "mz_zip_writer" functions. The ZIP writer immediately writes compressed file data
+ to disk and builds an exact image of the central directory in memory. The central directory image is written
+ all at once at the end of the archive file when the archive is finalized.
+
+ The archive writer can optionally align each file's local header and file data to any power of 2 alignment,
+ which can be useful when the archive will be read from optical media. Also, the writer supports placing
+ arbitrary data blobs at the very beginning of ZIP archives. Archives written using either feature are still
+ readable by any ZIP tool.
+
+ - Archive appending: The simple way to add a single file to an archive is to call this function:
+
+ mz_bool mz_zip_add_mem_to_archive_file_in_place(const char *pZip_filename, const char *pArchive_name,
+ const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags);
+
+ The archive will be created if it doesn't already exist, otherwise it'll be appended to.
+ Note the appending is done in-place and is not an atomic operation, so if something goes wrong
+ during the operation it's possible the archive could be left without a central directory (although the local
+ file headers and file data will be fine, so the archive will be recoverable).
+
+ For more complex archive modification scenarios:
+ 1. The safest way is to use a mz_zip_reader to read the existing archive, cloning only those bits you want to
+ preserve into a new archive using using the mz_zip_writer_add_from_zip_reader() function (which compiles the
+ compressed file data as-is). When you're done, delete the old archive and rename the newly written archive, and
+ you're done. This is safe but requires a bunch of temporary disk space or heap memory.
+
+ 2. Or, you can convert an mz_zip_reader in-place to an mz_zip_writer using mz_zip_writer_init_from_reader(),
+ append new files as needed, then finalize the archive which will write an updated central directory to the
+ original archive. (This is basically what mz_zip_add_mem_to_archive_file_in_place() does.) There's a
+ possibility that the archive's central directory could be lost with this method if anything goes wrong, though.
+
+ - ZIP archive support limitations:
+ No spanning support. Extraction functions can only handle unencrypted, stored or deflated files.
+ Requires streams capable of seeking.
+
+ * This is a header file library, like stb_image.c. To get only a header file, either cut and paste the
+ below header, or create miniz.h, #define MINIZ_HEADER_FILE_ONLY, and then include miniz.c from it.
+
+ * Important: For best perf. be sure to customize the below macros for your target platform:
+ #define MINIZ_USE_UNALIGNED_LOADS_AND_STORES 1
+ #define MINIZ_LITTLE_ENDIAN 1
+ #define MINIZ_HAS_64BIT_REGISTERS 1
+
+ * On platforms using glibc, Be sure to "#define _LARGEFILE64_SOURCE 1" before including miniz.c to ensure miniz
+ uses the 64-bit variants: fopen64(), stat64(), etc. Otherwise you won't be able to process large files
+ (i.e. 32-bit stat() fails for me on files > 0x7FFFFFFF bytes).
+*/
+#pragma once
+
+
+
+/* Defines to completely disable specific portions of miniz.c:
+ If all macros here are defined the only functionality remaining will be CRC-32, adler-32, tinfl, and tdefl. */
+
+/* Define MINIZ_NO_STDIO to disable all usage and any functions which rely on stdio for file I/O. */
+/*#define MINIZ_NO_STDIO */
+
+/* If MINIZ_NO_TIME is specified then the ZIP archive functions will not be able to get the current time, or */
+/* get/set file times, and the C run-time funcs that get/set times won't be called. */
+/* The current downside is the times written to your archives will be from 1979. */
+/*#define MINIZ_NO_TIME */
+
+/* Define MINIZ_NO_ARCHIVE_APIS to disable all ZIP archive API's. */
+/*#define MINIZ_NO_ARCHIVE_APIS */
+
+/* Define MINIZ_NO_ARCHIVE_WRITING_APIS to disable all writing related ZIP archive API's. */
+/*#define MINIZ_NO_ARCHIVE_WRITING_APIS */
+
+/* Define MINIZ_NO_ZLIB_APIS to remove all ZLIB-style compression/decompression API's. */
+/*#define MINIZ_NO_ZLIB_APIS */
+
+/* Define MINIZ_NO_ZLIB_COMPATIBLE_NAME to disable zlib names, to prevent conflicts against stock zlib. */
+/*#define MINIZ_NO_ZLIB_COMPATIBLE_NAMES */
+
+/* Define MINIZ_NO_MALLOC to disable all calls to malloc, free, and realloc.
+ Note if MINIZ_NO_MALLOC is defined then the user must always provide custom user alloc/free/realloc
+ callbacks to the zlib and archive API's, and a few stand-alone helper API's which don't provide custom user
+ functions (such as tdefl_compress_mem_to_heap() and tinfl_decompress_mem_to_heap()) won't work. */
+/*#define MINIZ_NO_MALLOC */
+
+#if defined(__TINYC__) && (defined(__linux) || defined(__linux__))
+/* TODO: Work around "error: include file 'sys\utime.h' when compiling with tcc on Linux */
+#define MINIZ_NO_TIME
+#endif
+
+#include <stddef.h>
+
+#if !defined(MINIZ_NO_TIME) && !defined(MINIZ_NO_ARCHIVE_APIS)
+#include <time.h>
+#endif
+
+#if defined(_M_IX86) || defined(_M_X64) || defined(__i386__) || defined(__i386) || defined(__i486__) || defined(__i486) || defined(i386) || defined(__ia64__) || defined(__x86_64__)
+/* MINIZ_X86_OR_X64_CPU is only used to help set the below macros. */
+#define MINIZ_X86_OR_X64_CPU 1
+#else
+#define MINIZ_X86_OR_X64_CPU 0
+#endif
+
+#if (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__) || MINIZ_X86_OR_X64_CPU
+/* Set MINIZ_LITTLE_ENDIAN to 1 if the processor is little endian. */
+#define MINIZ_LITTLE_ENDIAN 1
+#else
+#define MINIZ_LITTLE_ENDIAN 0
+#endif
+
+/* Set MINIZ_USE_UNALIGNED_LOADS_AND_STORES only if not set */
+#if !defined(MINIZ_USE_UNALIGNED_LOADS_AND_STORES)
+#if MINIZ_X86_OR_X64_CPU
+/* Set MINIZ_USE_UNALIGNED_LOADS_AND_STORES to 1 on CPU's that permit efficient integer loads and stores from unaligned addresses. */
+#define MINIZ_USE_UNALIGNED_LOADS_AND_STORES 1
+#define MINIZ_UNALIGNED_USE_MEMCPY
+#else
+#define MINIZ_USE_UNALIGNED_LOADS_AND_STORES 0
+#endif
+#endif
+
+#if defined(_M_X64) || defined(_WIN64) || defined(__MINGW64__) || defined(_LP64) || defined(__LP64__) || defined(__ia64__) || defined(__x86_64__)
+/* Set MINIZ_HAS_64BIT_REGISTERS to 1 if operations on 64-bit integers are reasonably fast (and don't involve compiler generated calls to helper functions). */
+#define MINIZ_HAS_64BIT_REGISTERS 1
+#else
+#define MINIZ_HAS_64BIT_REGISTERS 0
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* ------------------- zlib-style API Definitions. */
+
+/* For more compatibility with zlib, miniz.c uses unsigned long for some parameters/struct members. Beware: mz_ulong can be either 32 or 64-bits! */
+typedef unsigned long mz_ulong;
+
+/* mz_free() internally uses the MZ_FREE() macro (which by default calls free() unless you've modified the MZ_MALLOC macro) to release a block allocated from the heap. */
+MINIZ_EXPORT void mz_free(void *p);
+
+#define MZ_ADLER32_INIT (1)
+/* mz_adler32() returns the initial adler-32 value to use when called with ptr==NULL. */
+MINIZ_EXPORT mz_ulong mz_adler32(mz_ulong adler, const unsigned char *ptr, size_t buf_len);
+
+#define MZ_CRC32_INIT (0)
+/* mz_crc32() returns the initial CRC-32 value to use when called with ptr==NULL. */
+MINIZ_EXPORT mz_ulong mz_crc32(mz_ulong crc, const unsigned char *ptr, size_t buf_len);
+
+/* Compression strategies. */
+enum
+{
+ MZ_DEFAULT_STRATEGY = 0,
+ MZ_FILTERED = 1,
+ MZ_HUFFMAN_ONLY = 2,
+ MZ_RLE = 3,
+ MZ_FIXED = 4
+};
+
+/* Method */
+#define MZ_DEFLATED 8
+
+/* Heap allocation callbacks.
+Note that mz_alloc_func parameter types purposely differ from zlib's: items/size is size_t, not unsigned long. */
+typedef void *(*mz_alloc_func)(void *opaque, size_t items, size_t size);
+typedef void (*mz_free_func)(void *opaque, void *address);
+typedef void *(*mz_realloc_func)(void *opaque, void *address, size_t items, size_t size);
+
+/* Compression levels: 0-9 are the standard zlib-style levels, 10 is best possible compression (not zlib compatible, and may be very slow), MZ_DEFAULT_COMPRESSION=MZ_DEFAULT_LEVEL. */
+enum
+{
+ MZ_NO_COMPRESSION = 0,
+ MZ_BEST_SPEED = 1,
+ MZ_BEST_COMPRESSION = 9,
+ MZ_UBER_COMPRESSION = 10,
+ MZ_DEFAULT_LEVEL = 6,
+ MZ_DEFAULT_COMPRESSION = -1
+};
+
+#define MZ_VERSION "10.2.0"
+#define MZ_VERNUM 0xA100
+#define MZ_VER_MAJOR 10
+#define MZ_VER_MINOR 2
+#define MZ_VER_REVISION 0
+#define MZ_VER_SUBREVISION 0
+
+#ifndef MINIZ_NO_ZLIB_APIS
+
+/* Flush values. For typical usage you only need MZ_NO_FLUSH and MZ_FINISH. The other values are for advanced use (refer to the zlib docs). */
+enum
+{
+ MZ_NO_FLUSH = 0,
+ MZ_PARTIAL_FLUSH = 1,
+ MZ_SYNC_FLUSH = 2,
+ MZ_FULL_FLUSH = 3,
+ MZ_FINISH = 4,
+ MZ_BLOCK = 5
+};
+
+/* Return status codes. MZ_PARAM_ERROR is non-standard. */
+enum
+{
+ MZ_OK = 0,
+ MZ_STREAM_END = 1,
+ MZ_NEED_DICT = 2,
+ MZ_ERRNO = -1,
+ MZ_STREAM_ERROR = -2,
+ MZ_DATA_ERROR = -3,
+ MZ_MEM_ERROR = -4,
+ MZ_BUF_ERROR = -5,
+ MZ_VERSION_ERROR = -6,
+ MZ_PARAM_ERROR = -10000
+};
+
+/* Window bits */
+#define MZ_DEFAULT_WINDOW_BITS 15
+
+struct mz_internal_state;
+
+/* Compression/decompression stream struct. */
+typedef struct mz_stream_s
+{
+ const unsigned char *next_in; /* pointer to next byte to read */
+ unsigned int avail_in; /* number of bytes available at next_in */
+ mz_ulong total_in; /* total number of bytes consumed so far */
+
+ unsigned char *next_out; /* pointer to next byte to write */
+ unsigned int avail_out; /* number of bytes that can be written to next_out */
+ mz_ulong total_out; /* total number of bytes produced so far */
+
+ char *msg; /* error msg (unused) */
+ struct mz_internal_state *state; /* internal state, allocated by zalloc/zfree */
+
+ mz_alloc_func zalloc; /* optional heap allocation function (defaults to malloc) */
+ mz_free_func zfree; /* optional heap free function (defaults to free) */
+ void *opaque; /* heap alloc function user pointer */
+
+ int data_type; /* data_type (unused) */
+ mz_ulong adler; /* adler32 of the source or uncompressed data */
+ mz_ulong reserved; /* not used */
+} mz_stream;
+
+typedef mz_stream *mz_streamp;
+
+/* Returns the version string of miniz.c. */
+MINIZ_EXPORT const char *mz_version(void);
+
+/* mz_deflateInit() initializes a compressor with default options: */
+/* Parameters: */
+/* pStream must point to an initialized mz_stream struct. */
+/* level must be between [MZ_NO_COMPRESSION, MZ_BEST_COMPRESSION]. */
+/* level 1 enables a specially optimized compression function that's been optimized purely for performance, not ratio. */
+/* (This special func. is currently only enabled when MINIZ_USE_UNALIGNED_LOADS_AND_STORES and MINIZ_LITTLE_ENDIAN are defined.) */
+/* Return values: */
+/* MZ_OK on success. */
+/* MZ_STREAM_ERROR if the stream is bogus. */
+/* MZ_PARAM_ERROR if the input parameters are bogus. */
+/* MZ_MEM_ERROR on out of memory. */
+MINIZ_EXPORT int mz_deflateInit(mz_streamp pStream, int level);
+
+/* mz_deflateInit2() is like mz_deflate(), except with more control: */
+/* Additional parameters: */
+/* method must be MZ_DEFLATED */
+/* window_bits must be MZ_DEFAULT_WINDOW_BITS (to wrap the deflate stream with zlib header/adler-32 footer) or -MZ_DEFAULT_WINDOW_BITS (raw deflate/no header or footer) */
+/* mem_level must be between [1, 9] (it's checked but ignored by miniz.c) */
+MINIZ_EXPORT int mz_deflateInit2(mz_streamp pStream, int level, int method, int window_bits, int mem_level, int strategy);
+
+/* Quickly resets a compressor without having to reallocate anything. Same as calling mz_deflateEnd() followed by mz_deflateInit()/mz_deflateInit2(). */
+MINIZ_EXPORT int mz_deflateReset(mz_streamp pStream);
+
+/* mz_deflate() compresses the input to output, consuming as much of the input and producing as much output as possible. */
+/* Parameters: */
+/* pStream is the stream to read from and write to. You must initialize/update the next_in, avail_in, next_out, and avail_out members. */
+/* flush may be MZ_NO_FLUSH, MZ_PARTIAL_FLUSH/MZ_SYNC_FLUSH, MZ_FULL_FLUSH, or MZ_FINISH. */
+/* Return values: */
+/* MZ_OK on success (when flushing, or if more input is needed but not available, and/or there's more output to be written but the output buffer is full). */
+/* MZ_STREAM_END if all input has been consumed and all output bytes have been written. Don't call mz_deflate() on the stream anymore. */
+/* MZ_STREAM_ERROR if the stream is bogus. */
+/* MZ_PARAM_ERROR if one of the parameters is invalid. */
+/* MZ_BUF_ERROR if no forward progress is possible because the input and/or output buffers are empty. (Fill up the input buffer or free up some output space and try again.) */
+MINIZ_EXPORT int mz_deflate(mz_streamp pStream, int flush);
+
+/* mz_deflateEnd() deinitializes a compressor: */
+/* Return values: */
+/* MZ_OK on success. */
+/* MZ_STREAM_ERROR if the stream is bogus. */
+MINIZ_EXPORT int mz_deflateEnd(mz_streamp pStream);
+
+/* mz_deflateBound() returns a (very) conservative upper bound on the amount of data that could be generated by deflate(), assuming flush is set to only MZ_NO_FLUSH or MZ_FINISH. */
+MINIZ_EXPORT mz_ulong mz_deflateBound(mz_streamp pStream, mz_ulong source_len);
+
+/* Single-call compression functions mz_compress() and mz_compress2(): */
+/* Returns MZ_OK on success, or one of the error codes from mz_deflate() on failure. */
+MINIZ_EXPORT int mz_compress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len);
+MINIZ_EXPORT int mz_compress2(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len, int level);
+
+/* mz_compressBound() returns a (very) conservative upper bound on the amount of data that could be generated by calling mz_compress(). */
+MINIZ_EXPORT mz_ulong mz_compressBound(mz_ulong source_len);
+
+/* Initializes a decompressor. */
+MINIZ_EXPORT int mz_inflateInit(mz_streamp pStream);
+
+/* mz_inflateInit2() is like mz_inflateInit() with an additional option that controls the window size and whether or not the stream has been wrapped with a zlib header/footer: */
+/* window_bits must be MZ_DEFAULT_WINDOW_BITS (to parse zlib header/footer) or -MZ_DEFAULT_WINDOW_BITS (raw deflate). */
+MINIZ_EXPORT int mz_inflateInit2(mz_streamp pStream, int window_bits);
+
+/* Quickly resets a compressor without having to reallocate anything. Same as calling mz_inflateEnd() followed by mz_inflateInit()/mz_inflateInit2(). */
+MINIZ_EXPORT int mz_inflateReset(mz_streamp pStream);
+
+/* Decompresses the input stream to the output, consuming only as much of the input as needed, and writing as much to the output as possible. */
+/* Parameters: */
+/* pStream is the stream to read from and write to. You must initialize/update the next_in, avail_in, next_out, and avail_out members. */
+/* flush may be MZ_NO_FLUSH, MZ_SYNC_FLUSH, or MZ_FINISH. */
+/* On the first call, if flush is MZ_FINISH it's assumed the input and output buffers are both sized large enough to decompress the entire stream in a single call (this is slightly faster). */
+/* MZ_FINISH implies that there are no more source bytes available beside what's already in the input buffer, and that the output buffer is large enough to hold the rest of the decompressed data. */
+/* Return values: */
+/* MZ_OK on success. Either more input is needed but not available, and/or there's more output to be written but the output buffer is full. */
+/* MZ_STREAM_END if all needed input has been consumed and all output bytes have been written. For zlib streams, the adler-32 of the decompressed data has also been verified. */
+/* MZ_STREAM_ERROR if the stream is bogus. */
+/* MZ_DATA_ERROR if the deflate stream is invalid. */
+/* MZ_PARAM_ERROR if one of the parameters is invalid. */
+/* MZ_BUF_ERROR if no forward progress is possible because the input buffer is empty but the inflater needs more input to continue, or if the output buffer is not large enough. Call mz_inflate() again */
+/* with more input data, or with more room in the output buffer (except when using single call decompression, described above). */
+MINIZ_EXPORT int mz_inflate(mz_streamp pStream, int flush);
+
+/* Deinitializes a decompressor. */
+MINIZ_EXPORT int mz_inflateEnd(mz_streamp pStream);
+
+/* Single-call decompression. */
+/* Returns MZ_OK on success, or one of the error codes from mz_inflate() on failure. */
+MINIZ_EXPORT int mz_uncompress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len);
+MINIZ_EXPORT int mz_uncompress2(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong *pSource_len);
+
+/* Returns a string description of the specified error code, or NULL if the error code is invalid. */
+MINIZ_EXPORT const char *mz_error(int err);
+
+/* Redefine zlib-compatible names to miniz equivalents, so miniz.c can be used as a drop-in replacement for the subset of zlib that miniz.c supports. */
+/* Define MINIZ_NO_ZLIB_COMPATIBLE_NAMES to disable zlib-compatibility if you use zlib in the same project. */
+#ifndef MINIZ_NO_ZLIB_COMPATIBLE_NAMES
+typedef unsigned char Byte;
+typedef unsigned int uInt;
+typedef mz_ulong uLong;
+typedef Byte Bytef;
+typedef uInt uIntf;
+typedef char charf;
+typedef int intf;
+typedef void *voidpf;
+typedef uLong uLongf;
+typedef void *voidp;
+typedef void *const voidpc;
+#define Z_NULL 0
+#define Z_NO_FLUSH MZ_NO_FLUSH
+#define Z_PARTIAL_FLUSH MZ_PARTIAL_FLUSH
+#define Z_SYNC_FLUSH MZ_SYNC_FLUSH
+#define Z_FULL_FLUSH MZ_FULL_FLUSH
+#define Z_FINISH MZ_FINISH
+#define Z_BLOCK MZ_BLOCK
+#define Z_OK MZ_OK
+#define Z_STREAM_END MZ_STREAM_END
+#define Z_NEED_DICT MZ_NEED_DICT
+#define Z_ERRNO MZ_ERRNO
+#define Z_STREAM_ERROR MZ_STREAM_ERROR
+#define Z_DATA_ERROR MZ_DATA_ERROR
+#define Z_MEM_ERROR MZ_MEM_ERROR
+#define Z_BUF_ERROR MZ_BUF_ERROR
+#define Z_VERSION_ERROR MZ_VERSION_ERROR
+#define Z_PARAM_ERROR MZ_PARAM_ERROR
+#define Z_NO_COMPRESSION MZ_NO_COMPRESSION
+#define Z_BEST_SPEED MZ_BEST_SPEED
+#define Z_BEST_COMPRESSION MZ_BEST_COMPRESSION
+#define Z_DEFAULT_COMPRESSION MZ_DEFAULT_COMPRESSION
+#define Z_DEFAULT_STRATEGY MZ_DEFAULT_STRATEGY
+#define Z_FILTERED MZ_FILTERED
+#define Z_HUFFMAN_ONLY MZ_HUFFMAN_ONLY
+#define Z_RLE MZ_RLE
+#define Z_FIXED MZ_FIXED
+#define Z_DEFLATED MZ_DEFLATED
+#define Z_DEFAULT_WINDOW_BITS MZ_DEFAULT_WINDOW_BITS
+#define alloc_func mz_alloc_func
+#define free_func mz_free_func
+#define internal_state mz_internal_state
+#define z_stream mz_stream
+#define deflateInit mz_deflateInit
+#define deflateInit2 mz_deflateInit2
+#define deflateReset mz_deflateReset
+#define deflate mz_deflate
+#define deflateEnd mz_deflateEnd
+#define deflateBound mz_deflateBound
+#define compress mz_compress
+#define compress2 mz_compress2
+#define compressBound mz_compressBound
+#define inflateInit mz_inflateInit
+#define inflateInit2 mz_inflateInit2
+#define inflateReset mz_inflateReset
+#define inflate mz_inflate
+#define inflateEnd mz_inflateEnd
+#define uncompress mz_uncompress
+#define uncompress2 mz_uncompress2
+#define crc32 mz_crc32
+#define adler32 mz_adler32
+#define MAX_WBITS 15
+#define MAX_MEM_LEVEL 9
+#define zError mz_error
+#define ZLIB_VERSION MZ_VERSION
+#define ZLIB_VERNUM MZ_VERNUM
+#define ZLIB_VER_MAJOR MZ_VER_MAJOR
+#define ZLIB_VER_MINOR MZ_VER_MINOR
+#define ZLIB_VER_REVISION MZ_VER_REVISION
+#define ZLIB_VER_SUBREVISION MZ_VER_SUBREVISION
+#define zlibVersion mz_version
+#define zlib_version mz_version()
+#endif /* #ifndef MINIZ_NO_ZLIB_COMPATIBLE_NAMES */
+
+#endif /* MINIZ_NO_ZLIB_APIS */
+
+#ifdef __cplusplus
+}
+#endif
+
+
+
+
+
+#pragma once
+#include <assert.h>
+#include <stdint.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+
+/* ------------------- Types and macros */
+typedef unsigned char mz_uint8;
+typedef signed short mz_int16;
+typedef unsigned short mz_uint16;
+typedef unsigned int mz_uint32;
+typedef unsigned int mz_uint;
+typedef int64_t mz_int64;
+typedef uint64_t mz_uint64;
+typedef int mz_bool;
+
+#define MZ_FALSE (0)
+#define MZ_TRUE (1)
+
+/* Works around MSVC's spammy "warning C4127: conditional expression is constant" message. */
+#ifdef _MSC_VER
+#define MZ_MACRO_END while (0, 0)
+#else
+#define MZ_MACRO_END while (0)
+#endif
+
+#ifdef MINIZ_NO_STDIO
+#define MZ_FILE void *
+#else
+#include <stdio.h>
+#define MZ_FILE FILE
+#endif /* #ifdef MINIZ_NO_STDIO */
+
+#ifdef MINIZ_NO_TIME
+typedef struct mz_dummy_time_t_tag
+{
+ int m_dummy;
+} mz_dummy_time_t;
+#define MZ_TIME_T mz_dummy_time_t
+#else
+#define MZ_TIME_T time_t
+#endif
+
+#define MZ_ASSERT(x) assert(x)
+
+#ifdef MINIZ_NO_MALLOC
+#define MZ_MALLOC(x) NULL
+#define MZ_FREE(x) (void)x, ((void)0)
+#define MZ_REALLOC(p, x) NULL
+#else
+#define MZ_MALLOC(x) malloc(x)
+#define MZ_FREE(x) free(x)
+#define MZ_REALLOC(p, x) realloc(p, x)
+#endif
+
+#define MZ_MAX(a, b) (((a) > (b)) ? (a) : (b))
+#define MZ_MIN(a, b) (((a) < (b)) ? (a) : (b))
+#define MZ_CLEAR_OBJ(obj) memset(&(obj), 0, sizeof(obj))
+
+#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN
+#define MZ_READ_LE16(p) *((const mz_uint16 *)(p))
+#define MZ_READ_LE32(p) *((const mz_uint32 *)(p))
+#else
+#define MZ_READ_LE16(p) ((mz_uint32)(((const mz_uint8 *)(p))[0]) | ((mz_uint32)(((const mz_uint8 *)(p))[1]) << 8U))
+#define MZ_READ_LE32(p) ((mz_uint32)(((const mz_uint8 *)(p))[0]) | ((mz_uint32)(((const mz_uint8 *)(p))[1]) << 8U) | ((mz_uint32)(((const mz_uint8 *)(p))[2]) << 16U) | ((mz_uint32)(((const mz_uint8 *)(p))[3]) << 24U))
+#endif
+
+#define MZ_READ_LE64(p) (((mz_uint64)MZ_READ_LE32(p)) | (((mz_uint64)MZ_READ_LE32((const mz_uint8 *)(p) + sizeof(mz_uint32))) << 32U))
+
+#ifdef _MSC_VER
+#define MZ_FORCEINLINE __forceinline
+#elif defined(__GNUC__)
+#define MZ_FORCEINLINE __inline__ __attribute__((__always_inline__))
+#else
+#define MZ_FORCEINLINE inline
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern MINIZ_EXPORT void *miniz_def_alloc_func(void *opaque, size_t items, size_t size);
+extern MINIZ_EXPORT void miniz_def_free_func(void *opaque, void *address);
+extern MINIZ_EXPORT void *miniz_def_realloc_func(void *opaque, void *address, size_t items, size_t size);
+
+#define MZ_UINT16_MAX (0xFFFFU)
+#define MZ_UINT32_MAX (0xFFFFFFFFU)
+
+#ifdef __cplusplus
+}
+#endif
+ #pragma once
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+/* ------------------- Low-level Compression API Definitions */
+
+/* Set TDEFL_LESS_MEMORY to 1 to use less memory (compression will be slightly slower, and raw/dynamic blocks will be output more frequently). */
+#define TDEFL_LESS_MEMORY 0
+
+/* tdefl_init() compression flags logically OR'd together (low 12 bits contain the max. number of probes per dictionary search): */
+/* TDEFL_DEFAULT_MAX_PROBES: The compressor defaults to 128 dictionary probes per dictionary search. 0=Huffman only, 1=Huffman+LZ (fastest/crap compression), 4095=Huffman+LZ (slowest/best compression). */
+enum
+{
+ TDEFL_HUFFMAN_ONLY = 0,
+ TDEFL_DEFAULT_MAX_PROBES = 128,
+ TDEFL_MAX_PROBES_MASK = 0xFFF
+};
+
+/* TDEFL_WRITE_ZLIB_HEADER: If set, the compressor outputs a zlib header before the deflate data, and the Adler-32 of the source data at the end. Otherwise, you'll get raw deflate data. */
+/* TDEFL_COMPUTE_ADLER32: Always compute the adler-32 of the input data (even when not writing zlib headers). */
+/* TDEFL_GREEDY_PARSING_FLAG: Set to use faster greedy parsing, instead of more efficient lazy parsing. */
+/* TDEFL_NONDETERMINISTIC_PARSING_FLAG: Enable to decrease the compressor's initialization time to the minimum, but the output may vary from run to run given the same input (depending on the contents of memory). */
+/* TDEFL_RLE_MATCHES: Only look for RLE matches (matches with a distance of 1) */
+/* TDEFL_FILTER_MATCHES: Discards matches <= 5 chars if enabled. */
+/* TDEFL_FORCE_ALL_STATIC_BLOCKS: Disable usage of optimized Huffman tables. */
+/* TDEFL_FORCE_ALL_RAW_BLOCKS: Only use raw (uncompressed) deflate blocks. */
+/* The low 12 bits are reserved to control the max # of hash probes per dictionary lookup (see TDEFL_MAX_PROBES_MASK). */
+enum
+{
+ TDEFL_WRITE_ZLIB_HEADER = 0x01000,
+ TDEFL_COMPUTE_ADLER32 = 0x02000,
+ TDEFL_GREEDY_PARSING_FLAG = 0x04000,
+ TDEFL_NONDETERMINISTIC_PARSING_FLAG = 0x08000,
+ TDEFL_RLE_MATCHES = 0x10000,
+ TDEFL_FILTER_MATCHES = 0x20000,
+ TDEFL_FORCE_ALL_STATIC_BLOCKS = 0x40000,
+ TDEFL_FORCE_ALL_RAW_BLOCKS = 0x80000
+};
+
+/* High level compression functions: */
+/* tdefl_compress_mem_to_heap() compresses a block in memory to a heap block allocated via malloc(). */
+/* On entry: */
+/* pSrc_buf, src_buf_len: Pointer and size of source block to compress. */
+/* flags: The max match finder probes (default is 128) logically OR'd against the above flags. Higher probes are slower but improve compression. */
+/* On return: */
+/* Function returns a pointer to the compressed data, or NULL on failure. */
+/* *pOut_len will be set to the compressed data's size, which could be larger than src_buf_len on uncompressible data. */
+/* The caller must free() the returned block when it's no longer needed. */
+MINIZ_EXPORT void *tdefl_compress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags);
+
+/* tdefl_compress_mem_to_mem() compresses a block in memory to another block in memory. */
+/* Returns 0 on failure. */
+MINIZ_EXPORT size_t tdefl_compress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags);
+
+/* Compresses an image to a compressed PNG file in memory. */
+/* On entry: */
+/* pImage, w, h, and num_chans describe the image to compress. num_chans may be 1, 2, 3, or 4. */
+/* The image pitch in bytes per scanline will be w*num_chans. The leftmost pixel on the top scanline is stored first in memory. */
+/* level may range from [0,10], use MZ_NO_COMPRESSION, MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc. or a decent default is MZ_DEFAULT_LEVEL */
+/* If flip is true, the image will be flipped on the Y axis (useful for OpenGL apps). */
+/* On return: */
+/* Function returns a pointer to the compressed data, or NULL on failure. */
+/* *pLen_out will be set to the size of the PNG image file. */
+/* The caller must mz_free() the returned heap block (which will typically be larger than *pLen_out) when it's no longer needed. */
+MINIZ_EXPORT void *tdefl_write_image_to_png_file_in_memory_ex(const void *pImage, int w, int h, int num_chans, size_t *pLen_out, mz_uint level, mz_bool flip);
+MINIZ_EXPORT void *tdefl_write_image_to_png_file_in_memory(const void *pImage, int w, int h, int num_chans, size_t *pLen_out);
+
+/* Output stream interface. The compressor uses this interface to write compressed data. It'll typically be called TDEFL_OUT_BUF_SIZE at a time. */
+typedef mz_bool (*tdefl_put_buf_func_ptr)(const void *pBuf, int len, void *pUser);
+
+/* tdefl_compress_mem_to_output() compresses a block to an output stream. The above helpers use this function internally. */
+MINIZ_EXPORT mz_bool tdefl_compress_mem_to_output(const void *pBuf, size_t buf_len, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags);
+
+enum
+{
+ TDEFL_MAX_HUFF_TABLES = 3,
+ TDEFL_MAX_HUFF_SYMBOLS_0 = 288,
+ TDEFL_MAX_HUFF_SYMBOLS_1 = 32,
+ TDEFL_MAX_HUFF_SYMBOLS_2 = 19,
+ TDEFL_LZ_DICT_SIZE = 32768,
+ TDEFL_LZ_DICT_SIZE_MASK = TDEFL_LZ_DICT_SIZE - 1,
+ TDEFL_MIN_MATCH_LEN = 3,
+ TDEFL_MAX_MATCH_LEN = 258
+};
+
+/* TDEFL_OUT_BUF_SIZE MUST be large enough to hold a single entire compressed output block (using static/fixed Huffman codes). */
+#if TDEFL_LESS_MEMORY
+enum
+{
+ TDEFL_LZ_CODE_BUF_SIZE = 24 * 1024,
+ TDEFL_OUT_BUF_SIZE = (TDEFL_LZ_CODE_BUF_SIZE * 13) / 10,
+ TDEFL_MAX_HUFF_SYMBOLS = 288,
+ TDEFL_LZ_HASH_BITS = 12,
+ TDEFL_LEVEL1_HASH_SIZE_MASK = 4095,
+ TDEFL_LZ_HASH_SHIFT = (TDEFL_LZ_HASH_BITS + 2) / 3,
+ TDEFL_LZ_HASH_SIZE = 1 << TDEFL_LZ_HASH_BITS
+};
+#else
+enum
+{
+ TDEFL_LZ_CODE_BUF_SIZE = 64 * 1024,
+ TDEFL_OUT_BUF_SIZE = (TDEFL_LZ_CODE_BUF_SIZE * 13) / 10,
+ TDEFL_MAX_HUFF_SYMBOLS = 288,
+ TDEFL_LZ_HASH_BITS = 15,
+ TDEFL_LEVEL1_HASH_SIZE_MASK = 4095,
+ TDEFL_LZ_HASH_SHIFT = (TDEFL_LZ_HASH_BITS + 2) / 3,
+ TDEFL_LZ_HASH_SIZE = 1 << TDEFL_LZ_HASH_BITS
+};
+#endif
+
+/* The low-level tdefl functions below may be used directly if the above helper functions aren't flexible enough. The low-level functions don't make any heap allocations, unlike the above helper functions. */
+typedef enum {
+ TDEFL_STATUS_BAD_PARAM = -2,
+ TDEFL_STATUS_PUT_BUF_FAILED = -1,
+ TDEFL_STATUS_OKAY = 0,
+ TDEFL_STATUS_DONE = 1
+} tdefl_status;
+
+/* Must map to MZ_NO_FLUSH, MZ_SYNC_FLUSH, etc. enums */
+typedef enum {
+ TDEFL_NO_FLUSH = 0,
+ TDEFL_SYNC_FLUSH = 2,
+ TDEFL_FULL_FLUSH = 3,
+ TDEFL_FINISH = 4
+} tdefl_flush;
+
+/* tdefl's compression state structure. */
+typedef struct
+{
+ tdefl_put_buf_func_ptr m_pPut_buf_func;
+ void *m_pPut_buf_user;
+ mz_uint m_flags, m_max_probes[2];
+ int m_greedy_parsing;
+ mz_uint m_adler32, m_lookahead_pos, m_lookahead_size, m_dict_size;
+ mz_uint8 *m_pLZ_code_buf, *m_pLZ_flags, *m_pOutput_buf, *m_pOutput_buf_end;
+ mz_uint m_num_flags_left, m_total_lz_bytes, m_lz_code_buf_dict_pos, m_bits_in, m_bit_buffer;
+ mz_uint m_saved_match_dist, m_saved_match_len, m_saved_lit, m_output_flush_ofs, m_output_flush_remaining, m_finished, m_block_index, m_wants_to_finish;
+ tdefl_status m_prev_return_status;
+ const void *m_pIn_buf;
+ void *m_pOut_buf;
+ size_t *m_pIn_buf_size, *m_pOut_buf_size;
+ tdefl_flush m_flush;
+ const mz_uint8 *m_pSrc;
+ size_t m_src_buf_left, m_out_buf_ofs;
+ mz_uint8 m_dict[TDEFL_LZ_DICT_SIZE + TDEFL_MAX_MATCH_LEN - 1];
+ mz_uint16 m_huff_count[TDEFL_MAX_HUFF_TABLES][TDEFL_MAX_HUFF_SYMBOLS];
+ mz_uint16 m_huff_codes[TDEFL_MAX_HUFF_TABLES][TDEFL_MAX_HUFF_SYMBOLS];
+ mz_uint8 m_huff_code_sizes[TDEFL_MAX_HUFF_TABLES][TDEFL_MAX_HUFF_SYMBOLS];
+ mz_uint8 m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE];
+ mz_uint16 m_next[TDEFL_LZ_DICT_SIZE];
+ mz_uint16 m_hash[TDEFL_LZ_HASH_SIZE];
+ mz_uint8 m_output_buf[TDEFL_OUT_BUF_SIZE];
+} tdefl_compressor;
+
+/* Initializes the compressor. */
+/* There is no corresponding deinit() function because the tdefl API's do not dynamically allocate memory. */
+/* pBut_buf_func: If NULL, output data will be supplied to the specified callback. In this case, the user should call the tdefl_compress_buffer() API for compression. */
+/* If pBut_buf_func is NULL the user should always call the tdefl_compress() API. */
+/* flags: See the above enums (TDEFL_HUFFMAN_ONLY, TDEFL_WRITE_ZLIB_HEADER, etc.) */
+MINIZ_EXPORT tdefl_status tdefl_init(tdefl_compressor *d, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags);
+
+/* Compresses a block of data, consuming as much of the specified input buffer as possible, and writing as much compressed data to the specified output buffer as possible. */
+MINIZ_EXPORT tdefl_status tdefl_compress(tdefl_compressor *d, const void *pIn_buf, size_t *pIn_buf_size, void *pOut_buf, size_t *pOut_buf_size, tdefl_flush flush);
+
+/* tdefl_compress_buffer() is only usable when the tdefl_init() is called with a non-NULL tdefl_put_buf_func_ptr. */
+/* tdefl_compress_buffer() always consumes the entire input buffer. */
+MINIZ_EXPORT tdefl_status tdefl_compress_buffer(tdefl_compressor *d, const void *pIn_buf, size_t in_buf_size, tdefl_flush flush);
+
+MINIZ_EXPORT tdefl_status tdefl_get_prev_return_status(tdefl_compressor *d);
+MINIZ_EXPORT mz_uint32 tdefl_get_adler32(tdefl_compressor *d);
+
+/* Create tdefl_compress() flags given zlib-style compression parameters. */
+/* level may range from [0,10] (where 10 is absolute max compression, but may be much slower on some files) */
+/* window_bits may be -15 (raw deflate) or 15 (zlib) */
+/* strategy may be either MZ_DEFAULT_STRATEGY, MZ_FILTERED, MZ_HUFFMAN_ONLY, MZ_RLE, or MZ_FIXED */
+MINIZ_EXPORT mz_uint tdefl_create_comp_flags_from_zip_params(int level, int window_bits, int strategy);
+
+#ifndef MINIZ_NO_MALLOC
+/* Allocate the tdefl_compressor structure in C so that */
+/* non-C language bindings to tdefl_ API don't need to worry about */
+/* structure size and allocation mechanism. */
+MINIZ_EXPORT tdefl_compressor *tdefl_compressor_alloc(void);
+MINIZ_EXPORT void tdefl_compressor_free(tdefl_compressor *pComp);
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+ #pragma once
+
+/* ------------------- Low-level Decompression API Definitions */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+/* Decompression flags used by tinfl_decompress(). */
+/* TINFL_FLAG_PARSE_ZLIB_HEADER: If set, the input has a valid zlib header and ends with an adler32 checksum (it's a valid zlib stream). Otherwise, the input is a raw deflate stream. */
+/* TINFL_FLAG_HAS_MORE_INPUT: If set, there are more input bytes available beyond the end of the supplied input buffer. If clear, the input buffer contains all remaining input. */
+/* TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF: If set, the output buffer is large enough to hold the entire decompressed stream. If clear, the output buffer is at least the size of the dictionary (typically 32KB). */
+/* TINFL_FLAG_COMPUTE_ADLER32: Force adler-32 checksum computation of the decompressed bytes. */
+enum
+{
+ TINFL_FLAG_PARSE_ZLIB_HEADER = 1,
+ TINFL_FLAG_HAS_MORE_INPUT = 2,
+ TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF = 4,
+ TINFL_FLAG_COMPUTE_ADLER32 = 8
+};
+
+/* High level decompression functions: */
+/* tinfl_decompress_mem_to_heap() decompresses a block in memory to a heap block allocated via malloc(). */
+/* On entry: */
+/* pSrc_buf, src_buf_len: Pointer and size of the Deflate or zlib source data to decompress. */
+/* On return: */
+/* Function returns a pointer to the decompressed data, or NULL on failure. */
+/* *pOut_len will be set to the decompressed data's size, which could be larger than src_buf_len on uncompressible data. */
+/* The caller must call mz_free() on the returned block when it's no longer needed. */
+MINIZ_EXPORT void *tinfl_decompress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags);
+
+/* tinfl_decompress_mem_to_mem() decompresses a block in memory to another block in memory. */
+/* Returns TINFL_DECOMPRESS_MEM_TO_MEM_FAILED on failure, or the number of bytes written on success. */
+#define TINFL_DECOMPRESS_MEM_TO_MEM_FAILED ((size_t)(-1))
+MINIZ_EXPORT size_t tinfl_decompress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags);
+
+/* tinfl_decompress_mem_to_callback() decompresses a block in memory to an internal 32KB buffer, and a user provided callback function will be called to flush the buffer. */
+/* Returns 1 on success or 0 on failure. */
+typedef int (*tinfl_put_buf_func_ptr)(const void *pBuf, int len, void *pUser);
+MINIZ_EXPORT int tinfl_decompress_mem_to_callback(const void *pIn_buf, size_t *pIn_buf_size, tinfl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags);
+
+struct tinfl_decompressor_tag;
+typedef struct tinfl_decompressor_tag tinfl_decompressor;
+
+#ifndef MINIZ_NO_MALLOC
+/* Allocate the tinfl_decompressor structure in C so that */
+/* non-C language bindings to tinfl_ API don't need to worry about */
+/* structure size and allocation mechanism. */
+MINIZ_EXPORT tinfl_decompressor *tinfl_decompressor_alloc(void);
+MINIZ_EXPORT void tinfl_decompressor_free(tinfl_decompressor *pDecomp);
+#endif
+
+/* Max size of LZ dictionary. */
+#define TINFL_LZ_DICT_SIZE 32768
+
+/* Return status. */
+typedef enum {
+ /* This flags indicates the inflator needs 1 or more input bytes to make forward progress, but the caller is indicating that no more are available. The compressed data */
+ /* is probably corrupted. If you call the inflator again with more bytes it'll try to continue processing the input but this is a BAD sign (either the data is corrupted or you called it incorrectly). */
+ /* If you call it again with no input you'll just get TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS again. */
+ TINFL_STATUS_FAILED_CANNOT_MAKE_PROGRESS = -4,
+
+ /* This flag indicates that one or more of the input parameters was obviously bogus. (You can try calling it again, but if you get this error the calling code is wrong.) */
+ TINFL_STATUS_BAD_PARAM = -3,
+
+ /* This flags indicate the inflator is finished but the adler32 check of the uncompressed data didn't match. If you call it again it'll return TINFL_STATUS_DONE. */
+ TINFL_STATUS_ADLER32_MISMATCH = -2,
+
+ /* This flags indicate the inflator has somehow failed (bad code, corrupted input, etc.). If you call it again without resetting via tinfl_init() it it'll just keep on returning the same status failure code. */
+ TINFL_STATUS_FAILED = -1,
+
+ /* Any status code less than TINFL_STATUS_DONE must indicate a failure. */
+
+ /* This flag indicates the inflator has returned every byte of uncompressed data that it can, has consumed every byte that it needed, has successfully reached the end of the deflate stream, and */
+ /* if zlib headers and adler32 checking enabled that it has successfully checked the uncompressed data's adler32. If you call it again you'll just get TINFL_STATUS_DONE over and over again. */
+ TINFL_STATUS_DONE = 0,
+
+ /* This flag indicates the inflator MUST have more input data (even 1 byte) before it can make any more forward progress, or you need to clear the TINFL_FLAG_HAS_MORE_INPUT */
+ /* flag on the next call if you don't have any more source data. If the source data was somehow corrupted it's also possible (but unlikely) for the inflator to keep on demanding input to */
+ /* proceed, so be sure to properly set the TINFL_FLAG_HAS_MORE_INPUT flag. */
+ TINFL_STATUS_NEEDS_MORE_INPUT = 1,
+
+ /* This flag indicates the inflator definitely has 1 or more bytes of uncompressed data available, but it cannot write this data into the output buffer. */
+ /* Note if the source compressed data was corrupted it's possible for the inflator to return a lot of uncompressed data to the caller. I've been assuming you know how much uncompressed data to expect */
+ /* (either exact or worst case) and will stop calling the inflator and fail after receiving too much. In pure streaming scenarios where you have no idea how many bytes to expect this may not be possible */
+ /* so I may need to add some code to address this. */
+ TINFL_STATUS_HAS_MORE_OUTPUT = 2
+} tinfl_status;
+
+/* Initializes the decompressor to its initial state. */
+#define tinfl_init(r) \
+ do \
+ { \
+ (r)->m_state = 0; \
+ } \
+ MZ_MACRO_END
+#define tinfl_get_adler32(r) (r)->m_check_adler32
+
+/* Main low-level decompressor coroutine function. This is the only function actually needed for decompression. All the other functions are just high-level helpers for improved usability. */
+/* This is a universal API, i.e. it can be used as a building block to build any desired higher level decompression API. In the limit case, it can be called once per every byte input or output. */
+MINIZ_EXPORT tinfl_status tinfl_decompress(tinfl_decompressor *r, const mz_uint8 *pIn_buf_next, size_t *pIn_buf_size, mz_uint8 *pOut_buf_start, mz_uint8 *pOut_buf_next, size_t *pOut_buf_size, const mz_uint32 decomp_flags);
+
+/* Internal/private bits follow. */
+enum
+{
+ TINFL_MAX_HUFF_TABLES = 3,
+ TINFL_MAX_HUFF_SYMBOLS_0 = 288,
+ TINFL_MAX_HUFF_SYMBOLS_1 = 32,
+ TINFL_MAX_HUFF_SYMBOLS_2 = 19,
+ TINFL_FAST_LOOKUP_BITS = 10,
+ TINFL_FAST_LOOKUP_SIZE = 1 << TINFL_FAST_LOOKUP_BITS
+};
+
+typedef struct
+{
+ mz_uint8 m_code_size[TINFL_MAX_HUFF_SYMBOLS_0];
+ mz_int16 m_look_up[TINFL_FAST_LOOKUP_SIZE], m_tree[TINFL_MAX_HUFF_SYMBOLS_0 * 2];
+} tinfl_huff_table;
+
+#if MINIZ_HAS_64BIT_REGISTERS
+#define TINFL_USE_64BIT_BITBUF 1
+#else
+#define TINFL_USE_64BIT_BITBUF 0
+#endif
+
+#if TINFL_USE_64BIT_BITBUF
+typedef mz_uint64 tinfl_bit_buf_t;
+#define TINFL_BITBUF_SIZE (64)
+#else
+typedef mz_uint32 tinfl_bit_buf_t;
+#define TINFL_BITBUF_SIZE (32)
+#endif
+
+struct tinfl_decompressor_tag
+{
+ mz_uint32 m_state, m_num_bits, m_zhdr0, m_zhdr1, m_z_adler32, m_final, m_type, m_check_adler32, m_dist, m_counter, m_num_extra, m_table_sizes[TINFL_MAX_HUFF_TABLES];
+ tinfl_bit_buf_t m_bit_buf;
+ size_t m_dist_from_out_buf_start;
+ tinfl_huff_table m_tables[TINFL_MAX_HUFF_TABLES];
+ mz_uint8 m_raw_header[4], m_len_codes[TINFL_MAX_HUFF_SYMBOLS_0 + TINFL_MAX_HUFF_SYMBOLS_1 + 137];
+};
+
+#ifdef __cplusplus
+}
+#endif
+
+#pragma once
+
+
+/* ------------------- ZIP archive reading/writing */
+
+#ifndef MINIZ_NO_ARCHIVE_APIS
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+enum
+{
+ /* Note: These enums can be reduced as needed to save memory or stack space - they are pretty conservative. */
+ MZ_ZIP_MAX_IO_BUF_SIZE = 64 * 1024,
+ MZ_ZIP_MAX_ARCHIVE_FILENAME_SIZE = 512,
+ MZ_ZIP_MAX_ARCHIVE_FILE_COMMENT_SIZE = 512
+};
+
+typedef struct
+{
+ /* Central directory file index. */
+ mz_uint32 m_file_index;
+
+ /* Byte offset of this entry in the archive's central directory. Note we currently only support up to UINT_MAX or less bytes in the central dir. */
+ mz_uint64 m_central_dir_ofs;
+
+ /* These fields are copied directly from the zip's central dir. */
+ mz_uint16 m_version_made_by;
+ mz_uint16 m_version_needed;
+ mz_uint16 m_bit_flag;
+ mz_uint16 m_method;
+
+#ifndef MINIZ_NO_TIME
+ MZ_TIME_T m_time;
+#endif
+
+ /* CRC-32 of uncompressed data. */
+ mz_uint32 m_crc32;
+
+ /* File's compressed size. */
+ mz_uint64 m_comp_size;
+
+ /* File's uncompressed size. Note, I've seen some old archives where directory entries had 512 bytes for their uncompressed sizes, but when you try to unpack them you actually get 0 bytes. */
+ mz_uint64 m_uncomp_size;
+
+ /* Zip internal and external file attributes. */
+ mz_uint16 m_internal_attr;
+ mz_uint32 m_external_attr;
+
+ /* Entry's local header file offset in bytes. */
+ mz_uint64 m_local_header_ofs;
+
+ /* Size of comment in bytes. */
+ mz_uint32 m_comment_size;
+
+ /* MZ_TRUE if the entry appears to be a directory. */
+ mz_bool m_is_directory;
+
+ /* MZ_TRUE if the entry uses encryption/strong encryption (which miniz_zip doesn't support) */
+ mz_bool m_is_encrypted;
+
+ /* MZ_TRUE if the file is not encrypted, a patch file, and if it uses a compression method we support. */
+ mz_bool m_is_supported;
+
+ /* Filename. If string ends in '/' it's a subdirectory entry. */
+ /* Guaranteed to be zero terminated, may be truncated to fit. */
+ char m_filename[MZ_ZIP_MAX_ARCHIVE_FILENAME_SIZE];
+
+ /* Comment field. */
+ /* Guaranteed to be zero terminated, may be truncated to fit. */
+ char m_comment[MZ_ZIP_MAX_ARCHIVE_FILE_COMMENT_SIZE];
+
+} mz_zip_archive_file_stat;
+
+typedef size_t (*mz_file_read_func)(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n);
+typedef size_t (*mz_file_write_func)(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n);
+typedef mz_bool (*mz_file_needs_keepalive)(void *pOpaque);
+
+struct mz_zip_internal_state_tag;
+typedef struct mz_zip_internal_state_tag mz_zip_internal_state;
+
+typedef enum {
+ MZ_ZIP_MODE_INVALID = 0,
+ MZ_ZIP_MODE_READING = 1,
+ MZ_ZIP_MODE_WRITING = 2,
+ MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED = 3
+} mz_zip_mode;
+
+typedef enum {
+ MZ_ZIP_FLAG_CASE_SENSITIVE = 0x0100,
+ MZ_ZIP_FLAG_IGNORE_PATH = 0x0200,
+ MZ_ZIP_FLAG_COMPRESSED_DATA = 0x0400,
+ MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY = 0x0800,
+ MZ_ZIP_FLAG_VALIDATE_LOCATE_FILE_FLAG = 0x1000, /* if enabled, mz_zip_reader_locate_file() will be called on each file as its validated to ensure the func finds the file in the central dir (intended for testing) */
+ MZ_ZIP_FLAG_VALIDATE_HEADERS_ONLY = 0x2000, /* validate the local headers, but don't decompress the entire file and check the crc32 */
+ MZ_ZIP_FLAG_WRITE_ZIP64 = 0x4000, /* always use the zip64 file format, instead of the original zip file format with automatic switch to zip64. Use as flags parameter with mz_zip_writer_init*_v2 */
+ MZ_ZIP_FLAG_WRITE_ALLOW_READING = 0x8000,
+ MZ_ZIP_FLAG_ASCII_FILENAME = 0x10000,
+ /*After adding a compressed file, seek back
+ to local file header and set the correct sizes*/
+ MZ_ZIP_FLAG_WRITE_HEADER_SET_SIZE = 0x20000
+} mz_zip_flags;
+
+typedef enum {
+ MZ_ZIP_TYPE_INVALID = 0,
+ MZ_ZIP_TYPE_USER,
+ MZ_ZIP_TYPE_MEMORY,
+ MZ_ZIP_TYPE_HEAP,
+ MZ_ZIP_TYPE_FILE,
+ MZ_ZIP_TYPE_CFILE,
+ MZ_ZIP_TOTAL_TYPES
+} mz_zip_type;
+
+/* miniz error codes. Be sure to update mz_zip_get_error_string() if you add or modify this enum. */
+typedef enum {
+ MZ_ZIP_NO_ERROR = 0,
+ MZ_ZIP_UNDEFINED_ERROR,
+ MZ_ZIP_TOO_MANY_FILES,
+ MZ_ZIP_FILE_TOO_LARGE,
+ MZ_ZIP_UNSUPPORTED_METHOD,
+ MZ_ZIP_UNSUPPORTED_ENCRYPTION,
+ MZ_ZIP_UNSUPPORTED_FEATURE,
+ MZ_ZIP_FAILED_FINDING_CENTRAL_DIR,
+ MZ_ZIP_NOT_AN_ARCHIVE,
+ MZ_ZIP_INVALID_HEADER_OR_CORRUPTED,
+ MZ_ZIP_UNSUPPORTED_MULTIDISK,
+ MZ_ZIP_DECOMPRESSION_FAILED,
+ MZ_ZIP_COMPRESSION_FAILED,
+ MZ_ZIP_UNEXPECTED_DECOMPRESSED_SIZE,
+ MZ_ZIP_CRC_CHECK_FAILED,
+ MZ_ZIP_UNSUPPORTED_CDIR_SIZE,
+ MZ_ZIP_ALLOC_FAILED,
+ MZ_ZIP_FILE_OPEN_FAILED,
+ MZ_ZIP_FILE_CREATE_FAILED,
+ MZ_ZIP_FILE_WRITE_FAILED,
+ MZ_ZIP_FILE_READ_FAILED,
+ MZ_ZIP_FILE_CLOSE_FAILED,
+ MZ_ZIP_FILE_SEEK_FAILED,
+ MZ_ZIP_FILE_STAT_FAILED,
+ MZ_ZIP_INVALID_PARAMETER,
+ MZ_ZIP_INVALID_FILENAME,
+ MZ_ZIP_BUF_TOO_SMALL,
+ MZ_ZIP_INTERNAL_ERROR,
+ MZ_ZIP_FILE_NOT_FOUND,
+ MZ_ZIP_ARCHIVE_TOO_LARGE,
+ MZ_ZIP_VALIDATION_FAILED,
+ MZ_ZIP_WRITE_CALLBACK_FAILED,
+ MZ_ZIP_TOTAL_ERRORS
+} mz_zip_error;
+
+typedef struct
+{
+ mz_uint64 m_archive_size;
+ mz_uint64 m_central_directory_file_ofs;
+
+ /* We only support up to UINT32_MAX files in zip64 mode. */
+ mz_uint32 m_total_files;
+ mz_zip_mode m_zip_mode;
+ mz_zip_type m_zip_type;
+ mz_zip_error m_last_error;
+
+ mz_uint64 m_file_offset_alignment;
+
+ mz_alloc_func m_pAlloc;
+ mz_free_func m_pFree;
+ mz_realloc_func m_pRealloc;
+ void *m_pAlloc_opaque;
+
+ mz_file_read_func m_pRead;
+ mz_file_write_func m_pWrite;
+ mz_file_needs_keepalive m_pNeeds_keepalive;
+ void *m_pIO_opaque;
+
+ mz_zip_internal_state *m_pState;
+
+} mz_zip_archive;
+
+typedef struct
+{
+ mz_zip_archive *pZip;
+ mz_uint flags;
+
+ int status;
+#ifndef MINIZ_DISABLE_ZIP_READER_CRC32_CHECKS
+ mz_uint file_crc32;
+#endif
+ mz_uint64 read_buf_size, read_buf_ofs, read_buf_avail, comp_remaining, out_buf_ofs, cur_file_ofs;
+ mz_zip_archive_file_stat file_stat;
+ void *pRead_buf;
+ void *pWrite_buf;
+
+ size_t out_blk_remain;
+
+ tinfl_decompressor inflator;
+
+} mz_zip_reader_extract_iter_state;
+
+/* -------- ZIP reading */
+
+/* Inits a ZIP archive reader. */
+/* These functions read and validate the archive's central directory. */
+MINIZ_EXPORT mz_bool mz_zip_reader_init(mz_zip_archive *pZip, mz_uint64 size, mz_uint flags);
+
+MINIZ_EXPORT mz_bool mz_zip_reader_init_mem(mz_zip_archive *pZip, const void *pMem, size_t size, mz_uint flags);
+
+#ifndef MINIZ_NO_STDIO
+/* Read a archive from a disk file. */
+/* file_start_ofs is the file offset where the archive actually begins, or 0. */
+/* actual_archive_size is the true total size of the archive, which may be smaller than the file's actual size on disk. If zero the entire file is treated as the archive. */
+MINIZ_EXPORT mz_bool mz_zip_reader_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint32 flags);
+MINIZ_EXPORT mz_bool mz_zip_reader_init_file_v2(mz_zip_archive *pZip, const char *pFilename, mz_uint flags, mz_uint64 file_start_ofs, mz_uint64 archive_size);
+
+/* Read an archive from an already opened FILE, beginning at the current file position. */
+/* The archive is assumed to be archive_size bytes long. If archive_size is 0, then the entire rest of the file is assumed to contain the archive. */
+/* The FILE will NOT be closed when mz_zip_reader_end() is called. */
+MINIZ_EXPORT mz_bool mz_zip_reader_init_cfile(mz_zip_archive *pZip, MZ_FILE *pFile, mz_uint64 archive_size, mz_uint flags);
+#endif
+
+/* Ends archive reading, freeing all allocations, and closing the input archive file if mz_zip_reader_init_file() was used. */
+MINIZ_EXPORT mz_bool mz_zip_reader_end(mz_zip_archive *pZip);
+
+/* -------- ZIP reading or writing */
+
+/* Clears a mz_zip_archive struct to all zeros. */
+/* Important: This must be done before passing the struct to any mz_zip functions. */
+MINIZ_EXPORT void mz_zip_zero_struct(mz_zip_archive *pZip);
+
+MINIZ_EXPORT mz_zip_mode mz_zip_get_mode(mz_zip_archive *pZip);
+MINIZ_EXPORT mz_zip_type mz_zip_get_type(mz_zip_archive *pZip);
+
+/* Returns the total number of files in the archive. */
+MINIZ_EXPORT mz_uint mz_zip_reader_get_num_files(mz_zip_archive *pZip);
+
+MINIZ_EXPORT mz_uint64 mz_zip_get_archive_size(mz_zip_archive *pZip);
+MINIZ_EXPORT mz_uint64 mz_zip_get_archive_file_start_offset(mz_zip_archive *pZip);
+MINIZ_EXPORT MZ_FILE *mz_zip_get_cfile(mz_zip_archive *pZip);
+
+/* Reads n bytes of raw archive data, starting at file offset file_ofs, to pBuf. */
+MINIZ_EXPORT size_t mz_zip_read_archive_data(mz_zip_archive *pZip, mz_uint64 file_ofs, void *pBuf, size_t n);
+
+/* All mz_zip funcs set the m_last_error field in the mz_zip_archive struct. These functions retrieve/manipulate this field. */
+/* Note that the m_last_error functionality is not thread safe. */
+MINIZ_EXPORT mz_zip_error mz_zip_set_last_error(mz_zip_archive *pZip, mz_zip_error err_num);
+MINIZ_EXPORT mz_zip_error mz_zip_peek_last_error(mz_zip_archive *pZip);
+MINIZ_EXPORT mz_zip_error mz_zip_clear_last_error(mz_zip_archive *pZip);
+MINIZ_EXPORT mz_zip_error mz_zip_get_last_error(mz_zip_archive *pZip);
+MINIZ_EXPORT const char *mz_zip_get_error_string(mz_zip_error mz_err);
+
+/* MZ_TRUE if the archive file entry is a directory entry. */
+MINIZ_EXPORT mz_bool mz_zip_reader_is_file_a_directory(mz_zip_archive *pZip, mz_uint file_index);
+
+/* MZ_TRUE if the file is encrypted/strong encrypted. */
+MINIZ_EXPORT mz_bool mz_zip_reader_is_file_encrypted(mz_zip_archive *pZip, mz_uint file_index);
+
+/* MZ_TRUE if the compression method is supported, and the file is not encrypted, and the file is not a compressed patch file. */
+MINIZ_EXPORT mz_bool mz_zip_reader_is_file_supported(mz_zip_archive *pZip, mz_uint file_index);
+
+/* Retrieves the filename of an archive file entry. */
+/* Returns the number of bytes written to pFilename, or if filename_buf_size is 0 this function returns the number of bytes needed to fully store the filename. */
+MINIZ_EXPORT mz_uint mz_zip_reader_get_filename(mz_zip_archive *pZip, mz_uint file_index, char *pFilename, mz_uint filename_buf_size);
+
+/* Attempts to locates a file in the archive's central directory. */
+/* Valid flags: MZ_ZIP_FLAG_CASE_SENSITIVE, MZ_ZIP_FLAG_IGNORE_PATH */
+/* Returns -1 if the file cannot be found. */
+MINIZ_EXPORT int mz_zip_reader_locate_file(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags);
+MINIZ_EXPORT mz_bool mz_zip_reader_locate_file_v2(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags, mz_uint32 *file_index);
+
+/* Returns detailed information about an archive file entry. */
+MINIZ_EXPORT mz_bool mz_zip_reader_file_stat(mz_zip_archive *pZip, mz_uint file_index, mz_zip_archive_file_stat *pStat);
+
+/* MZ_TRUE if the file is in zip64 format. */
+/* A file is considered zip64 if it contained a zip64 end of central directory marker, or if it contained any zip64 extended file information fields in the central directory. */
+MINIZ_EXPORT mz_bool mz_zip_is_zip64(mz_zip_archive *pZip);
+
+/* Returns the total central directory size in bytes. */
+/* The current max supported size is <= MZ_UINT32_MAX. */
+MINIZ_EXPORT size_t mz_zip_get_central_dir_size(mz_zip_archive *pZip);
+
+/* Extracts a archive file to a memory buffer using no memory allocation. */
+/* There must be at least enough room on the stack to store the inflator's state (~34KB or so). */
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_to_mem_no_alloc(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size);
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_file_to_mem_no_alloc(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size);
+
+/* Extracts a archive file to a memory buffer. */
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_to_mem(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags);
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_file_to_mem(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags);
+
+/* Extracts a archive file to a dynamically allocated heap buffer. */
+/* The memory will be allocated via the mz_zip_archive's alloc/realloc functions. */
+/* Returns NULL and sets the last error on failure. */
+MINIZ_EXPORT void *mz_zip_reader_extract_to_heap(mz_zip_archive *pZip, mz_uint file_index, size_t *pSize, mz_uint flags);
+MINIZ_EXPORT void *mz_zip_reader_extract_file_to_heap(mz_zip_archive *pZip, const char *pFilename, size_t *pSize, mz_uint flags);
+
+/* Extracts a archive file using a callback function to output the file's data. */
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_to_callback(mz_zip_archive *pZip, mz_uint file_index, mz_file_write_func pCallback, void *pOpaque, mz_uint flags);
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_file_to_callback(mz_zip_archive *pZip, const char *pFilename, mz_file_write_func pCallback, void *pOpaque, mz_uint flags);
+
+/* Extract a file iteratively */
+MINIZ_EXPORT mz_zip_reader_extract_iter_state* mz_zip_reader_extract_iter_new(mz_zip_archive *pZip, mz_uint file_index, mz_uint flags);
+MINIZ_EXPORT mz_zip_reader_extract_iter_state* mz_zip_reader_extract_file_iter_new(mz_zip_archive *pZip, const char *pFilename, mz_uint flags);
+MINIZ_EXPORT size_t mz_zip_reader_extract_iter_read(mz_zip_reader_extract_iter_state* pState, void* pvBuf, size_t buf_size);
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_iter_free(mz_zip_reader_extract_iter_state* pState);
+
+#ifndef MINIZ_NO_STDIO
+/* Extracts a archive file to a disk file and sets its last accessed and modified times. */
+/* This function only extracts files, not archive directory records. */
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_to_file(mz_zip_archive *pZip, mz_uint file_index, const char *pDst_filename, mz_uint flags);
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_file_to_file(mz_zip_archive *pZip, const char *pArchive_filename, const char *pDst_filename, mz_uint flags);
+
+/* Extracts a archive file starting at the current position in the destination FILE stream. */
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_to_cfile(mz_zip_archive *pZip, mz_uint file_index, MZ_FILE *File, mz_uint flags);
+MINIZ_EXPORT mz_bool mz_zip_reader_extract_file_to_cfile(mz_zip_archive *pZip, const char *pArchive_filename, MZ_FILE *pFile, mz_uint flags);
+#endif
+
+#if 0
+/* TODO */
+ typedef void *mz_zip_streaming_extract_state_ptr;
+ mz_zip_streaming_extract_state_ptr mz_zip_streaming_extract_begin(mz_zip_archive *pZip, mz_uint file_index, mz_uint flags);
+ uint64_t mz_zip_streaming_extract_get_size(mz_zip_archive *pZip, mz_zip_streaming_extract_state_ptr pState);
+ uint64_t mz_zip_streaming_extract_get_cur_ofs(mz_zip_archive *pZip, mz_zip_streaming_extract_state_ptr pState);
+ mz_bool mz_zip_streaming_extract_seek(mz_zip_archive *pZip, mz_zip_streaming_extract_state_ptr pState, uint64_t new_ofs);
+ size_t mz_zip_streaming_extract_read(mz_zip_archive *pZip, mz_zip_streaming_extract_state_ptr pState, void *pBuf, size_t buf_size);
+ mz_bool mz_zip_streaming_extract_end(mz_zip_archive *pZip, mz_zip_streaming_extract_state_ptr pState);
+#endif
+
+/* This function compares the archive's local headers, the optional local zip64 extended information block, and the optional descriptor following the compressed data vs. the data in the central directory. */
+/* It also validates that each file can be successfully uncompressed unless the MZ_ZIP_FLAG_VALIDATE_HEADERS_ONLY is specified. */
+MINIZ_EXPORT mz_bool mz_zip_validate_file(mz_zip_archive *pZip, mz_uint file_index, mz_uint flags);
+
+/* Validates an entire archive by calling mz_zip_validate_file() on each file. */
+MINIZ_EXPORT mz_bool mz_zip_validate_archive(mz_zip_archive *pZip, mz_uint flags);
+
+/* Misc utils/helpers, valid for ZIP reading or writing */
+MINIZ_EXPORT mz_bool mz_zip_validate_mem_archive(const void *pMem, size_t size, mz_uint flags, mz_zip_error *pErr);
+MINIZ_EXPORT mz_bool mz_zip_validate_file_archive(const char *pFilename, mz_uint flags, mz_zip_error *pErr);
+
+/* Universal end function - calls either mz_zip_reader_end() or mz_zip_writer_end(). */
+MINIZ_EXPORT mz_bool mz_zip_end(mz_zip_archive *pZip);
+
+/* -------- ZIP writing */
+
+#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS
+
+/* Inits a ZIP archive writer. */
+/*Set pZip->m_pWrite (and pZip->m_pIO_opaque) before calling mz_zip_writer_init or mz_zip_writer_init_v2*/
+/*The output is streamable, i.e. file_ofs in mz_file_write_func always increases only by n*/
+MINIZ_EXPORT mz_bool mz_zip_writer_init(mz_zip_archive *pZip, mz_uint64 existing_size);
+MINIZ_EXPORT mz_bool mz_zip_writer_init_v2(mz_zip_archive *pZip, mz_uint64 existing_size, mz_uint flags);
+
+MINIZ_EXPORT mz_bool mz_zip_writer_init_heap(mz_zip_archive *pZip, size_t size_to_reserve_at_beginning, size_t initial_allocation_size);
+MINIZ_EXPORT mz_bool mz_zip_writer_init_heap_v2(mz_zip_archive *pZip, size_t size_to_reserve_at_beginning, size_t initial_allocation_size, mz_uint flags);
+
+#ifndef MINIZ_NO_STDIO
+MINIZ_EXPORT mz_bool mz_zip_writer_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint64 size_to_reserve_at_beginning);
+MINIZ_EXPORT mz_bool mz_zip_writer_init_file_v2(mz_zip_archive *pZip, const char *pFilename, mz_uint64 size_to_reserve_at_beginning, mz_uint flags);
+MINIZ_EXPORT mz_bool mz_zip_writer_init_cfile(mz_zip_archive *pZip, MZ_FILE *pFile, mz_uint flags);
+#endif
+
+/* Converts a ZIP archive reader object into a writer object, to allow efficient in-place file appends to occur on an existing archive. */
+/* For archives opened using mz_zip_reader_init_file, pFilename must be the archive's filename so it can be reopened for writing. If the file can't be reopened, mz_zip_reader_end() will be called. */
+/* For archives opened using mz_zip_reader_init_mem, the memory block must be growable using the realloc callback (which defaults to realloc unless you've overridden it). */
+/* Finally, for archives opened using mz_zip_reader_init, the mz_zip_archive's user provided m_pWrite function cannot be NULL. */
+/* Note: In-place archive modification is not recommended unless you know what you're doing, because if execution stops or something goes wrong before */
+/* the archive is finalized the file's central directory will be hosed. */
+MINIZ_EXPORT mz_bool mz_zip_writer_init_from_reader(mz_zip_archive *pZip, const char *pFilename);
+MINIZ_EXPORT mz_bool mz_zip_writer_init_from_reader_v2(mz_zip_archive *pZip, const char *pFilename, mz_uint flags);
+
+/* Adds the contents of a memory buffer to an archive. These functions record the current local time into the archive. */
+/* To add a directory entry, call this method with an archive name ending in a forwardslash with an empty buffer. */
+/* level_and_flags - compression level (0-10, see MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc.) logically OR'd with zero or more mz_zip_flags, or just set to MZ_DEFAULT_COMPRESSION. */
+MINIZ_EXPORT mz_bool mz_zip_writer_add_mem(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, mz_uint level_and_flags);
+
+/* Like mz_zip_writer_add_mem(), except you can specify a file comment field, and optionally supply the function with already compressed data. */
+/* uncomp_size/uncomp_crc32 are only used if the MZ_ZIP_FLAG_COMPRESSED_DATA flag is specified. */
+MINIZ_EXPORT mz_bool mz_zip_writer_add_mem_ex(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags,
+ mz_uint64 uncomp_size, mz_uint32 uncomp_crc32);
+
+MINIZ_EXPORT mz_bool mz_zip_writer_add_mem_ex_v2(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags,
+ mz_uint64 uncomp_size, mz_uint32 uncomp_crc32, MZ_TIME_T *last_modified, const char *user_extra_data_local, mz_uint user_extra_data_local_len,
+ const char *user_extra_data_central, mz_uint user_extra_data_central_len);
+
+/* Adds the contents of a file to an archive. This function also records the disk file's modified time into the archive. */
+/* File data is supplied via a read callback function. User mz_zip_writer_add_(c)file to add a file directly.*/
+MINIZ_EXPORT mz_bool mz_zip_writer_add_read_buf_callback(mz_zip_archive *pZip, const char *pArchive_name, mz_file_read_func read_callback, void* callback_opaque, mz_uint64 max_size,
+ const MZ_TIME_T *pFile_time, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags, const char *user_extra_data_local, mz_uint user_extra_data_local_len,
+ const char *user_extra_data_central, mz_uint user_extra_data_central_len);
+
+
+#ifndef MINIZ_NO_STDIO
+/* Adds the contents of a disk file to an archive. This function also records the disk file's modified time into the archive. */
+/* level_and_flags - compression level (0-10, see MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc.) logically OR'd with zero or more mz_zip_flags, or just set to MZ_DEFAULT_COMPRESSION. */
+MINIZ_EXPORT mz_bool mz_zip_writer_add_file(mz_zip_archive *pZip, const char *pArchive_name, const char *pSrc_filename, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags);
+
+/* Like mz_zip_writer_add_file(), except the file data is read from the specified FILE stream. */
+MINIZ_EXPORT mz_bool mz_zip_writer_add_cfile(mz_zip_archive *pZip, const char *pArchive_name, MZ_FILE *pSrc_file, mz_uint64 max_size,
+ const MZ_TIME_T *pFile_time, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags, const char *user_extra_data_local, mz_uint user_extra_data_local_len,
+ const char *user_extra_data_central, mz_uint user_extra_data_central_len);
+#endif
+
+/* Adds a file to an archive by fully cloning the data from another archive. */
+/* This function fully clones the source file's compressed data (no recompression), along with its full filename, extra data (it may add or modify the zip64 local header extra data field), and the optional descriptor following the compressed data. */
+MINIZ_EXPORT mz_bool mz_zip_writer_add_from_zip_reader(mz_zip_archive *pZip, mz_zip_archive *pSource_zip, mz_uint src_file_index);
+
+/* Finalizes the archive by writing the central directory records followed by the end of central directory record. */
+/* After an archive is finalized, the only valid call on the mz_zip_archive struct is mz_zip_writer_end(). */
+/* An archive must be manually finalized by calling this function for it to be valid. */
+MINIZ_EXPORT mz_bool mz_zip_writer_finalize_archive(mz_zip_archive *pZip);
+
+/* Finalizes a heap archive, returning a poiner to the heap block and its size. */
+/* The heap block will be allocated using the mz_zip_archive's alloc/realloc callbacks. */
+MINIZ_EXPORT mz_bool mz_zip_writer_finalize_heap_archive(mz_zip_archive *pZip, void **ppBuf, size_t *pSize);
+
+/* Ends archive writing, freeing all allocations, and closing the output file if mz_zip_writer_init_file() was used. */
+/* Note for the archive to be valid, it *must* have been finalized before ending (this function will not do it for you). */
+MINIZ_EXPORT mz_bool mz_zip_writer_end(mz_zip_archive *pZip);
+
+/* -------- Misc. high-level helper functions: */
+
+/* mz_zip_add_mem_to_archive_file_in_place() efficiently (but not atomically) appends a memory blob to a ZIP archive. */
+/* Note this is NOT a fully safe operation. If it crashes or dies in some way your archive can be left in a screwed up state (without a central directory). */
+/* level_and_flags - compression level (0-10, see MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc.) logically OR'd with zero or more mz_zip_flags, or just set to MZ_DEFAULT_COMPRESSION. */
+/* TODO: Perhaps add an option to leave the existing central dir in place in case the add dies? We could then truncate the file (so the old central dir would be at the end) if something goes wrong. */
+MINIZ_EXPORT mz_bool mz_zip_add_mem_to_archive_file_in_place(const char *pZip_filename, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags);
+MINIZ_EXPORT mz_bool mz_zip_add_mem_to_archive_file_in_place_v2(const char *pZip_filename, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags, mz_zip_error *pErr);
+
+/* Reads a single file from an archive into a heap block. */
+/* If pComment is not NULL, only the file with the specified comment will be extracted. */
+/* Returns NULL on failure. */
+MINIZ_EXPORT void *mz_zip_extract_archive_file_to_heap(const char *pZip_filename, const char *pArchive_name, size_t *pSize, mz_uint flags);
+MINIZ_EXPORT void *mz_zip_extract_archive_file_to_heap_v2(const char *pZip_filename, const char *pArchive_name, const char *pComment, size_t *pSize, mz_uint flags, mz_zip_error *pErr);
+
+#endif /* #ifndef MINIZ_NO_ARCHIVE_WRITING_APIS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* MINIZ_NO_ARCHIVE_APIS */
diff --git a/source/luametatex/source/libraries/miniz/readme.md b/source/luametatex/source/libraries/miniz/readme.md
new file mode 100644
index 000000000..3f8fd7324
--- /dev/null
+++ b/source/luametatex/source/libraries/miniz/readme.md
@@ -0,0 +1,34 @@
+## Miniz
+
+Miniz is a lossless, high performance data compression library in a single source file that implements the zlib (RFC 1950) and Deflate (RFC 1951) compressed data format specification standards. It supports the most commonly used functions exported by the zlib library, but is a completely independent implementation so zlib's licensing requirements do not apply. Miniz also contains simple to use functions for writing .PNG format image files and reading/writing/appending .ZIP format archives. Miniz's compression speed has been tuned to be comparable to zlib's, and it also has a specialized real-time compressor function designed to compare well against fastlz/minilzo.
+
+## Usage
+
+Please use the files from the [releases page](https://github.com/richgel999/miniz/releases) in your projects. Do not use the git checkout directly! The different source and header files are [amalgamated](https://www.sqlite.org/amalgamation.html) into one `miniz.c`/`miniz.h` pair in a build step (`amalgamate.sh`). Include `miniz.c` and `miniz.h` in your project to use Miniz.
+
+## Features
+
+* MIT licensed
+* A portable, single source and header file library written in plain C. Tested with GCC, clang and Visual Studio.
+* Easily tuned and trimmed down by defines
+* A drop-in replacement for zlib's most used API's (tested in several open source projects that use zlib, such as libpng and libzip).
+* Fills a single threaded performance vs. compression ratio gap between several popular real-time compressors and zlib. For example, at level 1, miniz.c compresses around 5-9% better than minilzo, but is approx. 35% slower. At levels 2-9, miniz.c is designed to compare favorably against zlib's ratio and speed. See the miniz performance comparison page for example timings.
+* Not a block based compressor: miniz.c fully supports stream based processing using a coroutine-style implementation. The zlib-style API functions can be called a single byte at a time if that's all you've got.
+* Easy to use. The low-level compressor (tdefl) and decompressor (tinfl) have simple state structs which can be saved/restored as needed with simple memcpy's. The low-level codec API's don't use the heap in any way.
+* Entire inflater (including optional zlib header parsing and Adler-32 checking) is implemented in a single function as a coroutine, which is separately available in a small (~550 line) source file: miniz_tinfl.c
+* A fairly complete (but totally optional) set of .ZIP archive manipulation and extraction API's. The archive functionality is intended to solve common problems encountered in embedded, mobile, or game development situations. (The archive API's are purposely just powerful enough to write an entire archiver given a bit of additional higher-level logic.)
+
+## Known Problems
+
+* No support for encrypted archives. Not sure how useful this stuff is in practice.
+* Minimal documentation. The assumption is that the user is already familiar with the basic zlib API. I need to write an API wiki - for now I've tried to place key comments before each enum/API, and I've included 6 examples that demonstrate how to use the module's major features.
+
+## Special Thanks
+
+Thanks to Alex Evans for the PNG writer function. Also, thanks to Paul Holden and Thorsten Scheuermann for feedback and testing, Matt Pritchard for all his encouragement, and Sean Barrett's various public domain libraries for inspiration (and encouraging me to write miniz.c in C, which was much more enjoyable and less painful than I thought it would be considering I've been programming in C++ for so long).
+
+Thanks to Bruce Dawson for reporting a problem with the level_and_flags archive API parameter (which is fixed in v1.12) and general feedback, and Janez Zemva for indirectly encouraging me into writing more examples.
+
+## Patents
+
+I was recently asked if miniz avoids patent issues. miniz purposely uses the same core algorithms as the ones used by zlib. The compressor uses vanilla hash chaining as described [here](https://datatracker.ietf.org/doc/html/rfc1951#section-4). Also see the [gzip FAQ](https://web.archive.org/web/20160308045258/http://www.gzip.org/#faq11). In my opinion, if miniz falls prey to a patent attack then zlib/gzip are likely to be at serious risk too.
diff --git a/source/luametatex/source/libraries/miniz/readme.txt b/source/luametatex/source/libraries/miniz/readme.txt
new file mode 100644
index 000000000..8a5e6979e
--- /dev/null
+++ b/source/luametatex/source/libraries/miniz/readme.txt
@@ -0,0 +1,8 @@
+Remark
+
+Conform the recommendation we use the official merged files (release) not the github files. Also, we
+only use part of that single file because we do all file handling ourselves because we operate within
+the file name regime of LuaMetaTeX that is aware of operating system specifics like wide filenames on
+MSWindows). We don't drop in updates without careful checking them first for potential clashes.\\
+
+release url: https://github.com/richgel999/miniz/releases \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/html.zip b/source/luametatex/source/libraries/pplib/html.zip
new file mode 100644
index 000000000..3139244dd
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/html.zip
Binary files differ
diff --git a/source/luametatex/source/libraries/pplib/ppapi.h b/source/luametatex/source/libraries/pplib/ppapi.h
new file mode 100644
index 000000000..e9ced5718
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppapi.h
@@ -0,0 +1,404 @@
+
+#ifndef PP_API_H
+#define PP_API_H
+
+#include <stdint.h>
+#include <stddef.h>
+#include <string.h>
+
+#include "ppconf.h"
+
+#define pplib_version "v2.1"
+#define pplib_author "p.jackowski@gust.org.pl"
+
+/* types */
+
+typedef int64_t ppint;
+typedef size_t ppuint; // machine word
+
+typedef char ppbyte;
+
+typedef double ppnum;
+
+typedef struct ppname ppname;
+typedef struct ppstring ppstring;
+
+struct ppname {
+ ppbyte *data;
+ size_t size;
+ ppname *alterego;
+ int flags;
+};
+
+struct ppstring {
+ ppbyte *data;
+ size_t size;
+ ppstring *alterego;
+ int flags;
+};
+
+typedef struct ppobj ppobj;
+typedef struct ppref ppref;
+
+typedef struct {
+ ppobj *data;
+ size_t size;
+} pparray;
+
+typedef struct {
+ ppobj *data;
+ ppname **keys;
+ size_t size;
+} ppdict;
+
+typedef enum {
+ PPSTREAM_BASE16 = 0,
+ PPSTREAM_BASE85,
+ PPSTREAM_RUNLENGTH,
+ PPSTREAM_FLATE,
+ PPSTREAM_LZW,
+ PPSTREAM_CCITT,
+ PPSTREAM_DCT,
+ PPSTREAM_JBIG2,
+ PPSTREAM_JPX,
+ PPSTREAM_CRYPT
+} ppstreamtp;
+
+typedef struct {
+ ppstreamtp *filters;
+ ppdict **params;
+ size_t count;
+} ppstream_filter;
+
+typedef struct {
+ ppdict *dict;
+ void *input, *I;
+ size_t offset;
+ size_t length;
+ ppstream_filter filter;
+ ppobj *filespec;
+ ppstring *cryptkey;
+ int flags;
+} ppstream;
+
+PPDEF extern const char * ppstream_filter_name[];
+PPAPI int ppstream_filter_type (ppname *filtername, ppstreamtp *filtertype);
+PPAPI void ppstream_filter_info (ppstream *stream, ppstream_filter *info, int decode);
+
+#define PPSTREAM_FILTER (1<<0)
+#define PPSTREAM_IMAGE (1<<1)
+#define PPSTREAM_ENCRYPTED_AES (1<<2)
+#define PPSTREAM_ENCRYPTED_RC4 (1<<3)
+#define PPSTREAM_ENCRYPTED (PPSTREAM_ENCRYPTED_AES|PPSTREAM_ENCRYPTED_RC4)
+#define PPSTREAM_ENCRYPTED_OWN (1<<4)
+#define PPSTREAM_NOT_SUPPORTED (1<<6)
+
+#define ppstream_compressed(stream) ((stream)->flags & (PPSTREAM_FILTER|PPSTREAM_IMAGE))
+#define ppstream_filtered(stream) ((stream)->flags & PPSTREAM_FILTER)
+#define ppstream_image(stream) ((stream)->flags & PPSTREAM_IMAGE)
+#define ppstream_encrypted(stream) ((stream)->flags & PPSTREAM_ENCRYPTED)
+
+typedef enum {
+ PPNONE = 0,
+ PPNULL,
+ PPBOOL,
+ PPINT,
+ PPNUM,
+ PPNAME,
+ PPSTRING,
+ PPARRAY,
+ PPDICT,
+ PPSTREAM,
+ PPREF
+} ppobjtp;
+
+PPDEF extern const char * ppobj_kind[];
+
+struct ppobj {
+ union {
+ ppint integer;
+ ppnum number;
+ ppname *name;
+ ppstring *string;
+ pparray *array;
+ ppdict *dict;
+ ppstream *stream;
+ ppref *ref;
+ void *any;
+ };
+ ppobjtp type;
+};
+
+typedef struct ppxref ppxref;
+
+struct ppref {
+ ppobj object;
+ ppuint number, version;
+ size_t offset;
+ size_t length;
+ ppxref *xref;
+};
+
+typedef struct ppdoc ppdoc;
+
+/* object */
+
+#define ppobj_get_null(o) ((o)->type == PPNULL ? 1 : 0)
+#define ppobj_get_bool(o, v) ((o)->type == PPBOOL ? ((v = ((o)->integer != 0)), 1) : 0)
+#define ppobj_get_int(o, v) ((o)->type == PPINT ? ((v = (o)->integer), 1) : 0)
+#define ppobj_get_uint(o, v) ((o)->type == PPINT && (o)->integer >= 0 ? ((v = (ppuint)((o)->integer)), 1) : 0)
+#define ppobj_get_num(o, v) ((o)->type == PPNUM ? ((v = (o)->number), 1) : (((o)->type == PPINT ? ((v = (ppnum)((o)->integer)), 1) : 0)))
+#define ppobj_get_name(o) ((o)->type == PPNAME ? (o)->name : NULL)
+#define ppobj_get_string(o) ((o)->type == PPSTRING ? (o)->string : NULL)
+#define ppobj_get_array(o) ((o)->type == PPARRAY ? (o)->array : NULL)
+#define ppobj_get_dict(o) ((o)->type == PPDICT ? (o)->dict : NULL)
+#define ppobj_get_stream(o) ((o)->type == PPSTREAM ? (o)->stream : NULL)
+#define ppobj_get_ref(o) ((o)->type == PPREF ? (o)->ref : NULL)
+
+#define ppobj_rget_obj(o) ((o)->type == PPREF ? ppref_obj((o)->ref) : o)
+#define ppobj_rget_null(o) ((o)->type == PPNULL ? 1 : ((o)->type == PPREF ? ppobj_get_null(ppref_obj((o)->ref)) : 0))
+#define ppobj_rget_bool(o, v) ((o)->type == PPBOOL ? ((v = ((o)->integer != 0)), 1) : ((o)->type == PPREF ? ppobj_get_bool(ppref_obj((o)->ref), v) : 0))
+#define ppobj_rget_int(o, v) ((o)->type == PPINT ? ((v = (o)->integer), 1) : ((o)->type == PPREF ? ppobj_get_int(ppref_obj((o)->ref), v) : 0))
+#define ppobj_rget_uint(o, v) ((o)->type == PPINT && (o)->integer >= 0 ? ((v = (ppuint)((o)->integer)), 1) : ((o)->type == PPREF ? ppobj_get_uint(ppref_obj((o)->ref), v) : 0))
+#define ppobj_rget_num(o, v) ((o)->type == PPNUM ? ((v = (o)->number), 1) : (((o)->type == PPINT ? ((v = (ppnum)((o)->integer)), 1) : ((o)->type == PPREF ? ppobj_get_num(ppref_obj((o)->ref), v) : 0))))
+#define ppobj_rget_name(o) ((o)->type == PPNAME ? (o)->name : ((o)->type == PPREF ? ppobj_get_name(ppref_obj((o)->ref)) : NULL))
+#define ppobj_rget_string(o) ((o)->type == PPSTRING ? (o)->string : ((o)->type == PPREF ? ppobj_get_string(ppref_obj((o)->ref)) : NULL))
+#define ppobj_rget_array(o) ((o)->type == PPARRAY ? (o)->array : ((o)->type == PPREF ? ppobj_get_array(ppref_obj((o)->ref)) : NULL))
+#define ppobj_rget_dict(o) ((o)->type == PPDICT ? (o)->dict : ((o)->type == PPREF ? ppobj_get_dict(ppref_obj((o)->ref)) : NULL))
+#define ppobj_rget_stream(o) ((o)->type == PPSTREAM ? (o)->stream : ((o)->type == PPREF ? ppobj_get_stream(ppref_obj((o)->ref)) : NULL))
+#define ppobj_rget_ref(o) ((o)->type == PPREF ? (o)->ref : ((o)->type == PPREF ? ppobj_get_ref(ppref_obj((o)->ref)) : NULL))
+
+#define ppobj_get_bool_value(o) ((o)->type == PPBOOL ? ((o)->integer != 0) : 0)
+#define ppobj_get_int_value(o) ((o)->type == PPINT ? (o)->integer : 0)
+#define ppobj_get_num_value(o) ((o)->type == PPNUM ? (o)->number : ((o)->type == PPINT ? (ppnum)((o)->integer) : 0.0))
+
+/* name */
+
+#define ppname_is(name, s) (memcmp((name)->data, s, sizeof("" s) - 1) == 0)
+#define ppname_eq(name, n) (memcmp((name)->data, s, (name)->size) == 0)
+
+#define ppname_size(name) ((name)->size)
+#define ppname_exec(name) ((name)->flags & PPNAME_EXEC)
+#define ppname_data(name) ((name)->data)
+
+#define PPNAME_ENCODED (1 << 0)
+#define PPNAME_DECODED (1 << 1)
+#define PPNAME_EXEC (1 << 1)
+
+PPAPI ppname * ppname_decoded (ppname *name);
+PPAPI ppname * ppname_encoded (ppname *name);
+
+PPAPI ppbyte * ppname_decoded_data (ppname *name);
+PPAPI ppbyte * ppname_encoded_data (ppname *name);
+
+/* string */
+
+#define ppstring_size(string) ((string)->size)
+#define ppstring_data(string) ((string)->data)
+
+#define PPSTRING_ENCODED (1 << 0)
+#define PPSTRING_DECODED (1 << 1)
+//#define PPSTRING_EXEC (1 << 2) // postscript only
+#define PPSTRING_PLAIN 0
+#define PPSTRING_BASE16 (1 << 3)
+#define PPSTRING_BASE85 (1 << 4)
+#define PPSTRING_UTF16BE (1 << 5)
+#define PPSTRING_UTF16LE (1 << 6)
+
+#define ppstring_type(string) ((string)->flags & (PPSTRING_BASE16|PPSTRING_BASE85))
+#define ppstring_hex(string) ((string)->flags & PPSTRING_BASE16)
+#define ppstring_utf(string) ((string)->flags & (PPSTRING_UTF16BE|PPSTRING_UTF16LE))
+
+PPAPI ppstring * ppstring_decoded (ppstring *string);
+PPAPI ppstring * ppstring_encoded (ppstring *string);
+
+PPAPI ppbyte * ppstring_decoded_data (ppstring *string);
+PPAPI ppbyte * ppstring_encoded_data (ppstring *string);
+
+/* array */
+
+#define pparray_size(array) ((array)->size)
+#define pparray_at(array, index) ((array)->data + index)
+
+#define pparray_first(array, index, obj) ((index) = 0, (obj) = pparray_at(array, 0))
+#define pparray_next(index, obj) (++(index), ++(obj))
+
+#define pparray_get(array, index) (index < (array)->size ? pparray_at(array, index) : NULL)
+
+PPAPI ppobj * pparray_get_obj (pparray *array, size_t index);
+PPAPI int pparray_get_bool (pparray *array, size_t index, int *v);
+PPAPI int pparray_get_int (pparray *array, size_t index, ppint *v);
+PPAPI int pparray_get_uint (pparray *array, size_t index, ppuint *v);
+PPAPI int pparray_get_num (pparray *array, size_t index, ppnum *v);
+PPAPI ppname * pparray_get_name (pparray *array, size_t index);
+PPAPI ppstring * pparray_get_string (pparray *array, size_t index);
+PPAPI pparray * pparray_get_array (pparray *array, size_t index);
+PPAPI ppdict * pparray_get_dict (pparray *array, size_t index);
+//PPAPI ppstream * pparray_get_stream (pparray *array, size_t index);
+PPAPI ppref * pparray_get_ref (pparray *array, size_t index);
+
+PPAPI ppobj * pparray_rget_obj (pparray *array, size_t index);
+PPAPI int pparray_rget_bool (pparray *array, size_t index, int *v);
+PPAPI int pparray_rget_int (pparray *array, size_t index, ppint *v);
+PPAPI int pparray_rget_uint (pparray *array, size_t index, ppuint *v);
+PPAPI int pparray_rget_num (pparray *array, size_t index, ppnum *v);
+PPAPI ppname * pparray_rget_name (pparray *array, size_t index);
+PPAPI ppstring * pparray_rget_string (pparray *array, size_t index);
+PPAPI pparray * pparray_rget_array (pparray *array, size_t index);
+PPAPI ppdict * pparray_rget_dict (pparray *array, size_t index);
+PPAPI ppstream * pparray_rget_stream (pparray *array, size_t index);
+PPAPI ppref * pparray_rget_ref (pparray *array, size_t index);
+
+/* dict */
+
+#define ppdict_size(dict) ((dict)->size)
+#define ppdict_at(dict, index) ((dict)->data + index)
+#define ppdict_key(dict, index) ((dict)->keys[index])
+
+PPAPI ppobj * ppdict_get_obj (ppdict *dict, const char *name);
+PPAPI int ppdict_get_bool (ppdict *dict, const char *name, int *v);
+PPAPI int ppdict_get_int (ppdict *dict, const char *name, ppint *v);
+PPAPI int ppdict_get_uint (ppdict *dict, const char *name, ppuint *v);
+PPAPI int ppdict_get_num (ppdict *dict, const char *name, ppnum *v);
+PPAPI ppname * ppdict_get_name (ppdict *dict, const char *name);
+PPAPI ppstring * ppdict_get_string (ppdict *dict, const char *name);
+PPAPI pparray * ppdict_get_array (ppdict *dict, const char *name);
+PPAPI ppdict * ppdict_get_dict (ppdict *dict, const char *name);
+//PPAPI ppstream * ppdict_get_stream (ppdict *dict, const char *name);
+PPAPI ppref * ppdict_get_ref (ppdict *dict, const char *name);
+
+PPAPI ppobj * ppdict_rget_obj (ppdict *dict, const char *name);
+PPAPI int ppdict_rget_bool (ppdict *dict, const char *name, int *v);
+PPAPI int ppdict_rget_int (ppdict *dict, const char *name, ppint *v);
+PPAPI int ppdict_rget_uint (ppdict *dict, const char *name, ppuint *v);
+PPAPI int ppdict_rget_num (ppdict *dict, const char *name, ppnum *v);
+PPAPI ppname * ppdict_rget_name (ppdict *dict, const char *name);
+PPAPI ppstring * ppdict_rget_string (ppdict *dict, const char *name);
+PPAPI pparray * ppdict_rget_array (ppdict *dict, const char *name);
+PPAPI ppdict * ppdict_rget_dict (ppdict *dict, const char *name);
+PPAPI ppstream * ppdict_rget_stream (ppdict *dict, const char *name);
+PPAPI ppref * ppdict_rget_ref (ppdict *dict, const char *name);
+
+#define ppdict_first(dict, pkey, obj) (pkey = (dict)->keys, obj = (dict)->data)
+#define ppdict_next(pkey, obj) (++(pkey), ++(obj))
+
+/* stream */
+
+#define ppstream_dict(stream) ((stream)->dict)
+
+PPAPI uint8_t * ppstream_first (ppstream *stream, size_t *size, int decode);
+PPAPI uint8_t * ppstream_next (ppstream *stream, size_t *size);
+PPAPI uint8_t * ppstream_all (ppstream *stream, size_t *size, int decode);
+PPAPI void ppstream_done (ppstream *stream);
+
+PPAPI void ppstream_init_buffers (void);
+PPAPI void ppstream_free_buffers (void);
+
+/* ref */
+
+#define ppref_obj(ref) (&(ref)->object)
+
+/* xref */
+
+PPAPI ppxref * ppdoc_xref (ppdoc *pdf);
+PPAPI ppxref * ppxref_prev (ppxref *xref);
+PPAPI ppdict * ppxref_trailer (ppxref *xref);
+PPAPI ppdict * ppxref_catalog (ppxref *xref);
+PPAPI ppdict * ppxref_info (ppxref *xref);
+PPAPI ppref * ppxref_pages (ppxref *xref);
+PPAPI ppref * ppxref_find (ppxref *xref, ppuint refnumber);
+
+/* doc */
+
+PPAPI ppdoc * ppdoc_load (const char *filename);
+PPAPI ppdoc * ppdoc_filehandle (FILE *file, int closefile);
+#define ppdoc_file(file) ppdoc_filehandle(file, 1)
+PPAPI ppdoc * ppdoc_mem (const void *data, size_t size);
+PPAPI void ppdoc_free (ppdoc *pdf);
+
+#define ppdoc_trailer(pdf) ppxref_trailer(ppdoc_xref(pdf))
+#define ppdoc_catalog(pdf) ppxref_catalog(ppdoc_xref(pdf))
+#define ppdoc_info(pdf) ppxref_info(ppdoc_xref(pdf))
+#define ppdoc_pages(pdf) ppxref_pages(ppdoc_xref(pdf))
+
+PPAPI ppuint ppdoc_page_count (ppdoc *pdf);
+PPAPI ppref * ppdoc_page (ppdoc *pdf, ppuint index);
+PPAPI ppref * ppdoc_first_page (ppdoc *pdf);
+PPAPI ppref * ppdoc_next_page (ppdoc *pdf);
+
+PPAPI ppstream * ppcontents_first (ppdict *dict);
+PPAPI ppstream * ppcontents_next (ppdict *dict, ppstream *stream);
+
+/* crypt */
+
+typedef enum {
+ PPCRYPT_NONE = 0,
+ PPCRYPT_DONE = 1,
+ PPCRYPT_FAIL = -1,
+ PPCRYPT_PASS = -2
+} ppcrypt_status;
+
+PPAPI ppcrypt_status ppdoc_crypt_status (ppdoc *pdf);
+PPAPI ppcrypt_status ppdoc_crypt_pass (ppdoc *pdf, const void *userpass, size_t userpasslength, const void *ownerpass, size_t ownerpasslength);
+
+/* permission flags, effect in Acrobat File -> Properties -> Security tab */
+
+PPAPI ppint ppdoc_permissions (ppdoc *pdf);
+
+#define PPDOC_ALLOW_PRINT (1<<2) // printing
+#define PPDOC_ALLOW_MODIFY (1<<3) // filling form fields, signing, creating template pages
+#define PPDOC_ALLOW_COPY (1<<4) // copying, copying for accessibility
+#define PPDOC_ALLOW_ANNOTS (1<<5) // filling form fields, copying, signing
+#define PPDOC_ALLOW_EXTRACT (1<<9) // contents copying for accessibility
+#define PPDOC_ALLOW_ASSEMBLY (1<<10) // (no effect)
+#define PPDOC_ALLOW_PRINT_HIRES (1<<11) // (no effect)
+
+/* context */
+
+typedef struct ppcontext ppcontext;
+
+PPAPI ppcontext * ppcontext_new (void);
+PPAPI void ppcontext_done (ppcontext *context);
+PPAPI void ppcontext_free (ppcontext *context);
+
+/* contents parser */
+
+PPAPI ppobj * ppcontents_first_op (ppcontext *context, ppstream *stream, size_t *psize, ppname **pname);
+PPAPI ppobj * ppcontents_next_op (ppcontext *context, ppstream *stream, size_t *psize, ppname **pname);
+PPAPI ppobj * ppcontents_parse (ppcontext *context, ppstream *stream, size_t *psize);
+
+/* boxes and transforms */
+
+typedef struct {
+ ppnum lx, ly, rx, ry;
+} pprect;
+
+PPAPI pprect * pparray_to_rect (pparray *array, pprect *rect);
+PPAPI pprect * ppdict_get_rect (ppdict *dict, const char *name, pprect *rect);
+PPAPI pprect * ppdict_get_box (ppdict *dict, const char *name, pprect *rect);
+
+typedef struct {
+ ppnum xx, xy, yx, yy, x, y;
+} ppmatrix;
+
+PPAPI ppmatrix * pparray_to_matrix (pparray *array, ppmatrix *matrix);
+PPAPI ppmatrix * ppdict_get_matrix (ppdict *dict, const char *name, ppmatrix *matrix);
+
+/* logger */
+
+typedef void (*pplogger_callback) (const char *message, void *alien);
+PPAPI void pplog_callback (pplogger_callback logger, void *alien);
+PPAPI int pplog_prefix (const char *prefix);
+
+/* version */
+
+PPAPI const char * ppdoc_version_string (ppdoc *pdf);
+PPAPI int ppdoc_version_number (ppdoc *pdf, int *minor);
+
+/* doc info */
+
+PPAPI size_t ppdoc_file_size (ppdoc *pdf);
+PPAPI ppuint ppdoc_objects (ppdoc *pdf);
+PPAPI size_t ppdoc_memory (ppdoc *pdf, size_t *waste);
+
+#endif
diff --git a/source/luametatex/source/libraries/pplib/pparray.c b/source/luametatex/source/libraries/pplib/pparray.c
new file mode 100644
index 000000000..944596bdc
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/pparray.c
@@ -0,0 +1,145 @@
+
+#include "pplib.h"
+
+pparray * pparray_create (const ppobj *stackpos, size_t size, ppheap *heap)
+{
+ pparray *array;
+ array = (pparray *)ppstruct_take(heap, sizeof(pparray));
+ array->data = (ppobj *)ppstruct_take(heap, size * sizeof(ppobj)); // separate chunk, alignment requirements warning otherwise
+ array->size = size;
+ memcpy(array->data, stackpos, size * sizeof(ppobj));
+ return array;
+}
+
+ppobj * pparray_get_obj (pparray *array, size_t index)
+{
+ return pparray_get(array, index);
+}
+
+ppobj * pparray_rget_obj (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_obj(obj) : NULL;
+}
+
+int pparray_get_bool (pparray *array, size_t index, int *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_bool(obj, *v) : 0;
+}
+
+int pparray_rget_bool (pparray *array, size_t index, int *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_bool(obj, *v) : 0;
+}
+
+int pparray_get_int (pparray *array, size_t index, ppint *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_int(obj, *v) : 0;
+}
+
+int pparray_rget_int (pparray *array, size_t index, ppint *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_int(obj, *v) : 0;
+}
+
+int pparray_get_uint (pparray *array, size_t index, ppuint *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_uint(obj, *v) : 0;
+}
+
+int pparray_rget_uint (pparray *array, size_t index, ppuint *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_uint(obj, *v) : 0;
+}
+
+int pparray_get_num (pparray *array, size_t index, ppnum *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_num(obj, *v) : 0;
+}
+
+int pparray_rget_num (pparray *array, size_t index, ppnum *v)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_num(obj, *v) : 0;
+}
+
+ppname * pparray_get_name (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_name(obj) : NULL;
+}
+
+ppname * pparray_rget_name (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_name(obj) : NULL;
+}
+
+ppstring * pparray_get_string (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_string(obj) : NULL;
+}
+
+ppstring * pparray_rget_string (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_string(obj) : NULL;
+}
+
+pparray * pparray_get_array (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_array(obj) : NULL;
+}
+
+pparray * pparray_rget_array (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_array(obj) : NULL;
+}
+
+ppdict * pparray_get_dict (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_dict(obj) : NULL;
+}
+
+ppdict * pparray_rget_dict (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_dict(obj) : NULL;
+}
+
+/*
+ppstream * pparray_get_stream (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_stream(obj) : NULL;
+}
+*/
+
+ppstream * pparray_rget_stream (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_stream(obj) : NULL;
+}
+
+ppref * pparray_get_ref (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_get_ref(obj) : NULL;
+}
+
+ppref * pparray_rget_ref (pparray *array, size_t index)
+{
+ ppobj *obj;
+ return (obj = pparray_get(array, index)) != NULL ? ppobj_rget_ref(obj) : NULL;
+}
diff --git a/source/luametatex/source/libraries/pplib/pparray.h b/source/luametatex/source/libraries/pplib/pparray.h
new file mode 100644
index 000000000..df0d8e8b2
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/pparray.h
@@ -0,0 +1,7 @@
+
+#ifndef PP_ARRAY_H
+#define PP_ARRAY_H
+
+pparray * pparray_create (const ppobj *stack, size_t size, ppheap *heap);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/ppconf.h b/source/luametatex/source/libraries/pplib/ppconf.h
new file mode 100644
index 000000000..0211eb51e
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppconf.h
@@ -0,0 +1,76 @@
+
+#ifndef PP_CONF_H
+#define PP_CONF_H
+
+/*
+Aux flags:
+ PPDLL -- indicates a part of a shared library
+ PPEXE -- indicates a host program using shared library functions
+*/
+
+#if defined(_WIN32) || defined(_WIN64)
+# ifdef PPDLL
+# define PPAPI __declspec(dllexport)
+# define PPDEF __declspec(dllexport)
+# else
+# ifdef PPEXE
+# define PPAPI __declspec(dllimport)
+# define PPDEF
+# else
+# define PPAPI
+# define PPDEF
+# endif
+# endif
+#else
+# define PPAPI
+# define PPDEF
+#endif
+
+/* platform vs integers */
+
+#if defined(_WIN32) || defined(WIN32)
+# ifdef _MSC_VER
+# if defined(_M_64) || defined(_WIN64)
+# define MSVC64
+# else
+# define MSVC32
+# endif
+# else
+# if defined(__MINGW64__)
+# define MINGW64
+# else
+# if defined(__MINGW32__)
+# define MINGW32
+# endif
+# endif
+# endif
+#endif
+
+#if defined(_WIN64) || defined(__MINGW32__)
+# define PPINT64F "%I64d"
+# define PPUINT64F "%I64u"
+#else
+# define PPINT64F "%lld"
+# define PPUINT64F "%llu"
+#endif
+
+#if defined(MSVC64)
+# define PPINT(N) N##I64
+# define PPUINT(N) N##UI64
+# define PPINTF PPINT64F
+# define PPUINTF PPUINT64F
+#elif defined(MINGW64)
+# define PPINT(N) N##LL
+# define PPUINT(N) N##ULL
+# define PPINTF PPINT64F
+# define PPUINTF PPUINT64F
+#else // 32bit or sane 64bit (LP64, where long is long indeed)
+# define PPINT(N) N##L
+# define PPUINT(N) N##UL
+# define PPINTF "%ld"
+# define PPUINTF "%lu"
+#endif
+
+#define PPSIZEF PPUINTF
+
+#endif
diff --git a/source/luametatex/source/libraries/pplib/ppcrypt.c b/source/luametatex/source/libraries/pplib/ppcrypt.c
new file mode 100644
index 000000000..ce63e7cab
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppcrypt.c
@@ -0,0 +1,748 @@
+
+#include "utilmd5.h"
+#include "utilsha.h"
+
+#include "pplib.h"
+
+/* crypt struct */
+
+static ppcrypt * ppcrypt_create (ppheap *heap)
+{
+ ppcrypt *crypt;
+ crypt = (ppcrypt *)ppstruct_take(heap, sizeof(ppcrypt));
+ memset(crypt, 0, sizeof(ppcrypt));
+ return crypt;
+}
+
+int ppcrypt_type (ppcrypt *crypt, ppname *cryptname, ppuint *length, int *cryptflags)
+{
+ ppdict *filterdict;
+ ppname *filtertype;
+ int cryptmd = 0, default256 = 0;
+
+ if (crypt->map == NULL || (filterdict = ppdict_rget_dict(crypt->map, cryptname->data)) == NULL)
+ return 0;
+ if ((filtertype = ppdict_get_name(filterdict, "CFM")) == NULL)
+ return 0;
+ *cryptflags = 0;
+ if (ppname_is(filtertype, "V2"))
+ *cryptflags |= PPCRYPT_INFO_RC4;
+ else if (ppname_is(filtertype, "AESV2"))
+ *cryptflags |= PPCRYPT_INFO_AES;
+ else if (ppname_is(filtertype, "AESV3"))
+ *cryptflags |= PPCRYPT_INFO_AES, default256 = 1;
+ else
+ return 0;
+ /* pdf spec page. 134: /Length is said to be optional bit-length of the key, but it seems to be a mistake, as Acrobat
+ produces /Length key with bytes lengths, opposite to /Length key of the main encrypt dict. */
+ if (length != NULL)
+ if (!ppdict_get_uint(filterdict, "Length", length))
+ *length = (*cryptflags & PPCRYPT_INFO_RC4) ? 5 : (default256 ? 32 : 16);
+ /* one of metadata flags is set iff there is an explicit EncryptMetadata key */
+ if (ppdict_get_bool(filterdict, "EncryptMetadata", &cryptmd))
+ *cryptflags |= (cryptmd ? PPCRYPT_INFO_MD : PPCRYPT_INFO_NOMD);
+ return 1;
+}
+
+/* V1..4 algorithms */
+
+/* V1..4 unicode do PdfDocEncoding */
+
+typedef struct {
+ uint32_t unicode;
+ uint32_t code;
+ uint32_t count;
+} map_range_t;
+
+static const map_range_t unicode_to_pdf_doc_encoding_map[] = {
+ { 32, 32, 95 },
+ { 161, 161, 12 },
+ { 174, 174, 82 },
+ { 305, 154, 1 },
+ { 321, 149, 1 },
+ { 322, 155, 1 },
+ { 338, 150, 1 },
+ { 339, 156, 1 },
+ { 352, 151, 1 },
+ { 353, 157, 1 },
+ { 376, 152, 1 },
+ { 381, 153, 1 },
+ { 382, 158, 1 },
+ { 402, 134, 1 },
+ { 710, 26, 1 },
+ { 711, 25, 1 },
+ { 728, 24, 1 },
+ { 729, 27, 1 },
+ { 730, 30, 1 },
+ { 731, 29, 1 },
+ { 732, 31, 1 },
+ { 733, 28, 1 },
+ { 8211, 133, 1 },
+ { 8212, 132, 1 },
+ { 8216, 143, 3 },
+ { 8220, 141, 2 },
+ { 8222, 140, 1 },
+ { 8224, 129, 2 },
+ { 8226, 128, 1 },
+ { 8230, 131, 1 },
+ { 8240, 139, 1 },
+ { 8249, 136, 2 },
+ { 8260, 135, 1 },
+ { 8364, 160, 1 },
+ { 8482, 146, 1 },
+ { 8722, 138, 1 },
+ { 64257, 147, 2 }
+};
+
+#define unicode_to_pdf_doc_encoding_entries (sizeof(unicode_to_pdf_doc_encoding_map) / sizeof(map_range_t))
+
+static int unicode_to_pdf_doc_encoding (uint32_t unicode, uint8_t *pcode)
+{
+ const map_range_t *left, *right, *mid;
+
+ left = &unicode_to_pdf_doc_encoding_map[0];
+ right = &unicode_to_pdf_doc_encoding_map[unicode_to_pdf_doc_encoding_entries - 1];
+ for ( ; left <= right; )
+ {
+ mid = left + ((right - left) / 2);
+ if (unicode > mid->unicode + mid->count - 1)
+ left = mid + 1;
+ else if (unicode < mid->unicode)
+ right = mid - 1;
+ else
+ {
+ *pcode = (uint8_t)(mid->code + (unicode - mid->unicode));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+#define utf8_unicode2(p) (((p[0]&31)<<6)|(p[1]&63))
+#define utf8_unicode3(p) (((p[0]&15)<<12)|((p[1]&63)<<6)|(p[2]&63))
+#define utf8_unicode4(p) (((p[0]&7)<<18)|((p[1]&63)<<12)|((p[2]&63)<<6)|(p[3]&63))
+
+#define utf8_get1(p, e, unicode) ((unicode = p[0]), p + 1)
+#define utf8_get2(p, e, unicode) (p + 1 < e ? ((unicode = utf8_unicode2(p)), p + 2) : NULL)
+#define utf8_get3(p, e, unicode) (p + 2 < e ? ((unicode = utf8_unicode3(p)), p + 3) : NULL)
+#define utf8_get4(p, e, unicode) (p + 4 < e ? ((unicode = utf8_unicode3(p)), p + 4) : NULL)
+
+#define utf8_get(p, e, unicode) \
+ (p[0] < 0x80 ? utf8_get1(p, e, unicode) : \
+ p[0] < 0xC0 ? NULL : \
+ p[0] < 0xE0 ? utf8_get2(p, e, unicode) : \
+ p[0] < 0xF0 ? utf8_get3(p, e, unicode) : utf8_get4(p, e, unicode))
+
+static int ppcrypt_password_encoding (uint8_t *password, size_t *passwordlength)
+{
+ uint8_t *p, newpassword[PPCRYPT_MAX_PASSWORD], *n;
+ const uint8_t *e;
+ uint32_t unicode;
+
+ for (n = &newpassword[0], p = &password[0], e = p + *passwordlength; p < e; ++n)
+ {
+ p = utf8_get(p, e, unicode);
+ if (p == NULL)
+ return 0;
+ if (unicode_to_pdf_doc_encoding(unicode, n) == 0)
+ return 0;
+ }
+ *passwordlength = n - &newpassword[0];
+ memcpy(password, newpassword, *passwordlength);
+ return 1;
+}
+
+/* setup passwords */
+
+static const uint8_t password_padding[] = {
+ 0x28, 0xBF, 0x4E, 0x5E, 0x4E, 0x75, 0x8A, 0x41, 0x64, 0x00, 0x4E, 0x56, 0xFF, 0xFA, 0x01, 0x08,
+ 0x2E, 0x2E, 0x00, 0xB6, 0xD0, 0x68, 0x3E, 0x80, 0x2F, 0x0C, 0xA9, 0xFE, 0x64, 0x53, 0x69, 0x7A
+};
+
+static void ppcrypt_set_user_password (ppcrypt *crypt, const void *userpass, size_t userpasslength)
+{
+ crypt->userpasslength = userpasslength > PPCRYPT_MAX_PASSWORD ? PPCRYPT_MAX_PASSWORD : userpasslength;
+ memcpy(crypt->userpass, userpass, crypt->userpasslength);
+ if (crypt->algorithm_variant < 5)
+ {
+ if (ppcrypt_password_encoding(crypt->userpass, &crypt->userpasslength) == 0)
+ return;
+ if (crypt->userpasslength > 32)
+ crypt->userpasslength = 32;
+ else if (crypt->userpasslength < 32)
+ memcpy(&crypt->userpass[crypt->userpasslength], password_padding, 32 - crypt->userpasslength);
+ }
+ crypt->flags |= PPCRYPT_USER_PASSWORD;
+}
+
+static void ppcrypt_set_owner_password (ppcrypt *crypt, const void *ownerpass, size_t ownerpasslength)
+{
+ crypt->ownerpasslength = ownerpasslength > PPCRYPT_MAX_PASSWORD ? PPCRYPT_MAX_PASSWORD : ownerpasslength;
+ memcpy(crypt->ownerpass, ownerpass, crypt->ownerpasslength);
+ if (crypt->algorithm_variant < 5)
+ {
+ if (ppcrypt_password_encoding(crypt->ownerpass, &crypt->ownerpasslength) == 0)
+ return;
+ if (crypt->ownerpasslength > 32)
+ crypt->ownerpasslength = 32;
+ else if (crypt->ownerpasslength < 32)
+ memcpy(&crypt->ownerpass[crypt->ownerpasslength], password_padding, 32 - crypt->ownerpasslength);
+ }
+ crypt->flags |= PPCRYPT_OWNER_PASSWORD;
+}
+
+/* V1..4 retrieving user password from owner password and owner key (variant < 5) */
+
+static void ppcrypt_user_password_from_owner_key (ppcrypt *crypt, const void *ownerkey, size_t ownerkeysize)
+{
+ uint8_t temp[16], rc4key[32], rc4key2[32];
+ uint8_t i;
+ ppuint k;
+ md5_state md5;
+
+ md5_digest_init(&md5);
+ md5_digest_add(&md5, crypt->ownerpass, 32);
+ md5_digest_get(&md5, rc4key, MD5_BYTES);
+ if (crypt->algorithm_revision >= 3)
+ {
+ for (i = 0; i < 50; ++i)
+ {
+ md5_digest(rc4key, 16, temp, MD5_BYTES);
+ memcpy(rc4key, temp, 16);
+ }
+ }
+ rc4_decode_data(ownerkey, ownerkeysize, crypt->userpass, rc4key, crypt->filekeylength);
+ if (crypt->algorithm_revision >= 3)
+ {
+ for (i = 1; i <= 19; ++i)
+ {
+ for (k = 0; k < crypt->filekeylength; ++k)
+ rc4key2[k] = rc4key[k] ^ i;
+ rc4_decode_data(crypt->userpass, 32, crypt->userpass, rc4key2, crypt->filekeylength);
+ }
+ }
+ //crypt->userpasslength = 32;
+ for (crypt->userpasslength = 0; crypt->userpasslength < 32; ++crypt->userpasslength)
+ if (memcmp(&crypt->userpass[crypt->userpasslength], password_padding, 32 - crypt->userpasslength) == 0)
+ break;
+ crypt->flags |= PPCRYPT_USER_PASSWORD;
+}
+
+/* V1..4 generating file key; pdf spec p. 125 */
+
+static void ppcrypt_compute_file_key (ppcrypt *crypt, const void *ownerkey, size_t ownerkeysize, const void *id, size_t idsize)
+{
+ uint32_t p;
+ uint8_t permissions[4], temp[16];
+ int i;
+ md5_state md5;
+
+ md5_digest_init(&md5);
+ md5_digest_add(&md5, crypt->userpass, 32);
+ md5_digest_add(&md5, ownerkey, ownerkeysize);
+ p = (uint32_t)crypt->permissions;
+ permissions[0] = get_number_byte1(p);
+ permissions[1] = get_number_byte2(p);
+ permissions[2] = get_number_byte3(p);
+ permissions[3] = get_number_byte4(p);
+ md5_digest_add(&md5, permissions, 4);
+ md5_digest_add(&md5, id, idsize);
+ if (crypt->algorithm_revision >= 4 && (crypt->flags & PPCRYPT_NO_METADATA))
+ md5_digest_add(&md5, "\xFF\xFF\xFF\xFF", 4);
+ md5_digest_get(&md5, crypt->filekey, MD5_BYTES);
+ if (crypt->algorithm_revision >= 3)
+ {
+ for (i = 0; i < 50; ++i)
+ {
+ md5_digest(crypt->filekey, (size_t)crypt->filekeylength, temp, MD5_BYTES);
+ memcpy(crypt->filekey, temp, 16);
+ }
+ }
+}
+
+/* V1..4 generating userkey for comparison with /U; requires a general file key and id; pdf spec page 126-127 */
+
+static void ppcrypt_compute_user_key (ppcrypt *crypt, const void *id, size_t idsize, uint8_t password_hash[32])
+{
+ uint8_t rc4key2[32];
+ uint8_t i;
+ ppuint k;
+
+ if (crypt->algorithm_revision <= 2)
+ {
+ rc4_encode_data(password_padding, 32, password_hash, crypt->filekey, crypt->filekeylength);
+ }
+ else
+ {
+ md5_state md5;
+ md5_digest_init(&md5);
+ md5_digest_add(&md5, password_padding, 32);
+ md5_digest_add(&md5, id, idsize);
+ md5_digest_get(&md5, password_hash, MD5_BYTES);
+ rc4_encode_data(password_hash, 16, password_hash, crypt->filekey, crypt->filekeylength);
+ for (i = 1; i <= 19; ++i)
+ {
+ for (k = 0; k < crypt->filekeylength; ++k)
+ rc4key2[k] = crypt->filekey[k] ^ i;
+ rc4_encode_data(password_hash, 16, password_hash, rc4key2, crypt->filekeylength);
+ }
+ for (i = 16; i < 32; ++i)
+ password_hash[i] = password_hash[i - 16] ^ i; /* arbitrary 16-bytes padding */
+ }
+}
+
+static ppcrypt_status ppcrypt_authenticate_legacy (ppcrypt *crypt, ppstring *userkey, ppstring *ownerkey, ppstring *id)
+{
+ uint8_t password_hash[32];
+
+ if ((crypt->flags & PPCRYPT_USER_PASSWORD) == 0 && (crypt->flags & PPCRYPT_OWNER_PASSWORD) != 0)
+ ppcrypt_user_password_from_owner_key(crypt, ownerkey, ownerkey->size);
+ ppcrypt_compute_file_key(crypt, ownerkey->data, ownerkey->size, id->data, id->size);
+ ppcrypt_compute_user_key(crypt, id->data, id->size, password_hash); /* needs file key */
+ return memcmp(userkey->data, password_hash, (crypt->algorithm_revision >= 3 ? 16 : 32)) == 0 ? PPCRYPT_DONE : PPCRYPT_PASS;
+}
+
+/* V5 */
+
+static const uint8_t nulliv[16] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; /* AES-256 initialization vector */
+
+/* V5 R5..6 password hash */
+
+#define PPCRYPT_MAX_MANGLED ((127+64+48)*64) // 127 password, 64 hash, 48 /U key
+
+static void ppcrypt_password_hash_indeed (const uint8_t *password, size_t passwordlength, const uint8_t *userkey, uint8_t hash[64])
+{
+ size_t hashlength, datalength;
+ uint8_t data[PPCRYPT_MAX_MANGLED], *pdata;
+ uint8_t *key, *iv;
+ uint8_t round, i;
+ uint32_t div3;
+
+ hashlength = 32; /* initial hash is sha256 */
+ round = 0;
+ do
+ {
+ /* concat password, hash, and /U value 64 times */
+ pdata = &data[0];
+ memcpy(pdata, password, passwordlength);
+ pdata += passwordlength;
+ memcpy(pdata, hash, hashlength);
+ pdata += hashlength;
+ if (userkey != NULL)
+ {
+ memcpy(pdata, userkey, 48);
+ pdata += 48;
+ }
+ datalength = pdata - &data[0];
+ for (i = 1; i < 64; ++i, pdata += datalength)
+ memcpy(pdata, &data[0], datalength);
+ datalength *= 64;
+
+ /* encrypt the data with aes128 using hash bytes 1..16 as key and bytes 17..32 as initialization vector
+ encryption inplace, CBC, no-padding, no change to datalength */
+ key = &hash[0]; iv = &hash[16];
+ aes_encode_data(data, datalength, data, key, 16, iv, AES_NULL_PADDING);
+
+ /* get modulo 3 of first 16 bytes number of encrypted data (sum of digits modulo 3) */
+ for (i = 0, div3 = 0; i < 16; ++i)
+ div3 += data[i];
+
+ /* compute new hash using sha256/384/512 */
+ switch (div3 % 3)
+ {
+ case 0:
+ sha256_digest(data, datalength, hash, SHA_BYTES);
+ hashlength = 32;
+ break;
+ case 1:
+ sha384_digest(data, datalength, hash, SHA_BYTES);
+ hashlength = 48;
+ break;
+ case 2:
+ sha512_digest(data, datalength, hash, SHA_BYTES);
+ hashlength = 64;
+ break;
+ }
+
+ /* do 64 times, then keep going until the last byte of data <= round - 32 */
+ } while (++round < 64 || round < data[datalength - 1] + 32);
+
+}
+
+static void ppcrypt_password_hash (ppcrypt *crypt, const uint8_t *password, size_t passwordlength, const uint8_t *salt, const uint8_t *userkey, uint8_t password_hash[32])
+{
+ sha256_state sha;
+ uint8_t hash[64]; /* result password_hash is 32 bytes, but we need 64 for R6 procedure */
+
+ /* take sha256 of password, salt and /U */
+ sha256_digest_init(&sha);
+ sha256_digest_add(&sha, password, passwordlength);
+ sha256_digest_add(&sha, salt, 8);
+ if (userkey != NULL)
+ sha256_digest_add(&sha, userkey, 48);
+ sha256_digest_get(&sha, hash, SHA_BYTES);
+
+ /* V5 R5 - password_hash is the digest, V5 R6 - password_hash is mangled */
+ if (crypt->algorithm_revision >= 6)
+ ppcrypt_password_hash_indeed(password, passwordlength, userkey, hash);
+
+ memcpy(password_hash, hash, 32);
+}
+
+/* V5 permissions */
+
+static ppcrypt_status ppcrypt_authenticate_permissions (ppcrypt *crypt, ppstring *perms)
+{
+ uint8_t permsdata[16];
+
+ aes_decode_data(perms->data, perms->size, permsdata, crypt->filekey, crypt->filekeylength, nulliv, AES_NULL_PADDING);
+
+ if (permsdata[9] != 'a' || permsdata[10] != 'd' || permsdata[11] != 'b')
+ return PPCRYPT_FAIL;
+
+ /* do not check/update permissions flags here; they might be different inside crypt string */
+ if (0)
+ {
+ int64_t p;
+ int i;
+ for (p = 0, i = 0; i < 8; ++i)
+ p = p + (permsdata[i] << (i << 3)); /* low order bytes first */
+ crypt->permissions = (ppint)((int32_t)(p & 0x00000000FFFFFFFFLL)); /* unset bits 33..64, treat as 32-bit signed int */
+ }
+
+ if (permsdata[8] == 'T')
+ crypt->flags &= ~PPCRYPT_NO_METADATA;
+ else if (permsdata[8] == 'F')
+ crypt->flags |= PPCRYPT_NO_METADATA;
+
+ return PPCRYPT_DONE;
+}
+
+/* V5 authentication */
+
+static ppcrypt_status ppcrypt_authenticate_user (ppcrypt *crypt, ppstring *u, ppstring *ue, ppstring *perms)
+{
+ uint8_t password_hash[32], *salt;
+
+ salt = (uint8_t *)&u->data[32]; /* validation salt */
+ ppcrypt_password_hash(crypt, crypt->userpass, crypt->userpasslength, salt, NULL, password_hash);
+ if (memcmp(u->data, password_hash, 32) != 0)
+ return PPCRYPT_PASS;
+
+ salt = (uint8_t *)&u->data[40]; /* key salt */
+ ppcrypt_password_hash(crypt, crypt->userpass, crypt->userpasslength, salt, NULL, password_hash);
+ aes_decode_data(ue->data, 32, crypt->filekey, password_hash, 32, nulliv, AES_NULL_PADDING);
+
+ return ppcrypt_authenticate_permissions(crypt, perms);
+}
+
+static ppcrypt_status ppcrypt_authenticate_owner (ppcrypt *crypt, ppstring *u, ppstring *o, ppstring *oe, ppstring *perms)
+{
+ uint8_t password_hash[32], *salt;
+
+ salt = (uint8_t *)&o->data[32]; /* validation salt */
+ ppcrypt_password_hash(crypt, crypt->ownerpass, crypt->ownerpasslength, salt, (uint8_t *)u->data, password_hash);
+ if (memcmp(o->data, password_hash, 32) != 0)
+ return PPCRYPT_PASS;
+
+ salt = (uint8_t *)&o->data[40]; /* key salt */
+ ppcrypt_password_hash(crypt, crypt->ownerpass, crypt->ownerpasslength, salt, (uint8_t *)u->data, password_hash);
+ aes_decode_data(oe->data, 32, crypt->filekey, password_hash, 32, nulliv, AES_NULL_PADDING);
+
+ return ppcrypt_authenticate_permissions(crypt, perms);
+}
+
+
+/* authentication */
+
+static ppcrypt_status ppcrypt_authenticate (ppcrypt *crypt, ppstring *u, ppstring *ue, ppstring *o, ppstring *oe, ppstring *id, ppstring *perms)
+{
+ /* V1..V4 */
+ if (crypt->algorithm_variant < 5)
+ return ppcrypt_authenticate_legacy(crypt, u, o, id);
+
+ /* V5 */
+ if (crypt->flags & PPCRYPT_USER_PASSWORD)
+ if (ppcrypt_authenticate_user(crypt, u, ue, perms) == PPCRYPT_DONE)
+ return PPCRYPT_DONE;
+ if (crypt->flags & PPCRYPT_OWNER_PASSWORD)
+ return ppcrypt_authenticate_owner(crypt, u, o, oe, perms);
+
+ return PPCRYPT_PASS;
+}
+
+/**/
+
+ppcrypt_status ppdoc_crypt_init (ppdoc *pdf, const void *userpass, size_t userpasslength, const void *ownerpass, size_t ownerpasslength)
+{
+ ppcrypt *crypt;
+ ppdict *trailer, *encrypt;
+ ppobj *obj;
+ ppname *name, **pkey;
+ ppstring *userkey, *ownerkey, *userkey_e = NULL, *ownerkey_e = NULL;
+ size_t hashlength;
+ pparray *idarray;
+ ppstring *id = NULL, *perms = NULL;
+ int cryptflags, encryptmd;
+ size_t strkeylength, stmkeylength;
+
+ trailer = ppxref_trailer(pdf->xref);
+ if ((obj = ppdict_get_obj(trailer, "Encrypt")) == NULL)
+ return PPCRYPT_NONE;
+
+ /* this happens early, before loading body, so if /Encrypt is indirect reference, it points nothing */
+ obj = ppobj_preloaded(pdf, obj);
+ if (obj->type != PPDICT)
+ return PPCRYPT_FAIL;
+ encrypt = obj->dict;
+ for (ppdict_first(encrypt, pkey, obj); *pkey != NULL; ppdict_next(pkey, obj))
+ (void)ppobj_preloaded(pdf, obj);
+
+ if ((name = ppdict_get_name(encrypt, "Filter")) != NULL && !ppname_is(name, "Standard"))
+ return PPCRYPT_FAIL;
+
+ if ((crypt = pdf->crypt) == NULL)
+ crypt = pdf->crypt = ppcrypt_create(&pdf->heap);
+
+ /* get /V /R /P */
+ if (!ppdict_get_uint(encrypt, "V", &crypt->algorithm_variant))
+ crypt->algorithm_variant = 0;
+ if (crypt->algorithm_variant < 1 || crypt->algorithm_variant > 5)
+ return PPCRYPT_FAIL;
+ if (!ppdict_get_uint(encrypt, "R", &crypt->algorithm_revision))
+ return PPCRYPT_FAIL;
+ if (!ppdict_get_int(encrypt, "P", &crypt->permissions))
+ return PPCRYPT_FAIL;
+
+ /* get /O /U /ID /OE /UE */
+ if ((userkey = ppdict_get_string(encrypt, "U")) == NULL || (ownerkey = ppdict_get_string(encrypt, "O")) == NULL)
+ return PPCRYPT_FAIL;
+ userkey = ppstring_decoded(userkey);
+ ownerkey = ppstring_decoded(ownerkey);
+
+ /* for some reason acrobat pads /O and /U to 127 bytes with NULL, so we don't check the exact length but ensure the minimal */
+ hashlength = crypt->algorithm_variant < 5 ? 32 : 48;
+ if (userkey->size < hashlength || ownerkey->size < hashlength)
+ return PPCRYPT_FAIL;
+ if (crypt->algorithm_variant < 5)
+ { // get first string from /ID (must not be ref)
+ if ((idarray = ppdict_get_array(trailer, "ID")) == NULL || (id = pparray_get_string(idarray, 0)) == NULL)
+ return PPCRYPT_FAIL;
+ id = ppstring_decoded(id);
+ }
+ else
+ {
+ if ((userkey_e = ppdict_get_string(encrypt, "UE")) == NULL || (ownerkey_e = ppdict_get_string(encrypt, "OE")) == NULL)
+ return PPCRYPT_FAIL;
+ userkey_e = ppstring_decoded(userkey_e);
+ ownerkey_e = ppstring_decoded(ownerkey_e);
+ if (userkey_e->size < 32 || ownerkey_e->size < 32)
+ return PPCRYPT_FAIL;
+ if ((perms = ppdict_get_string(encrypt, "Perms")) == NULL)
+ return PPCRYPT_FAIL;
+ perms = ppstring_decoded(perms);
+ if (perms->size != 16)
+ return PPCRYPT_FAIL;
+ }
+
+ /* collect flags and keylength */
+ switch (crypt->algorithm_revision)
+ {
+ case 1:
+ crypt->filekeylength = 5;
+ crypt->flags |= PPCRYPT_RC4;
+ break;
+ case 2: case 3:
+ if (ppdict_get_uint(encrypt, "Length", &crypt->filekeylength))
+ crypt->filekeylength >>= 3; /* 40..256 bits, 5..32 bytes*/
+ else
+ crypt->filekeylength = 5; /* 40 bits, 5 bytes */
+ crypt->flags |= PPCRYPT_RC4;
+ break;
+ case 4: case 5: case 6:
+ if ((crypt->map = ppdict_rget_dict(encrypt, "CF")) == NULL)
+ return PPCRYPT_FAIL;
+ for (ppdict_first(crypt->map, pkey, obj); *pkey != NULL; ppdict_next(pkey, obj))
+ (void)ppobj_preloaded(pdf, obj);
+ /* /EncryptMetadata relevant only for version >=4, may be also provided in crypt filter dictionary; which takes a precedence then?
+ we assume that if there is an explicit EncryptMetadata key, it overrides main encrypt dict flag or default flag (the default is true,
+ meaning that Metadata stream is encrypted as others) */
+ if (ppdict_get_bool(encrypt, "EncryptMetadata", &encryptmd) && !encryptmd)
+ crypt->flags |= PPCRYPT_NO_METADATA;
+
+ strkeylength = stmkeylength = 0;
+ /* streams filter */
+ if ((name = ppdict_get_name(encrypt, "StmF")) != NULL && ppcrypt_type(crypt, name, &stmkeylength, &cryptflags))
+ {
+ if (cryptflags & PPCRYPT_INFO_AES)
+ crypt->flags |= PPCRYPT_STREAM_AES;
+ else if (cryptflags & PPCRYPT_INFO_RC4)
+ crypt->flags |= PPCRYPT_STREAM_RC4;
+ if (cryptflags & PPCRYPT_INFO_NOMD)
+ crypt->flags |= PPCRYPT_NO_METADATA;
+ else if (cryptflags & PPCRYPT_INFO_MD)
+ crypt->flags &= ~PPCRYPT_NO_METADATA;
+ } /* else identity */
+ /* strings filter */
+ if ((name = ppdict_get_name(encrypt, "StrF")) != NULL && ppcrypt_type(crypt, name, &strkeylength, &cryptflags))
+ {
+ if (cryptflags & PPCRYPT_INFO_AES)
+ crypt->flags |= PPCRYPT_STRING_AES;
+ else if (cryptflags & PPCRYPT_INFO_RC4)
+ crypt->flags |= PPCRYPT_STRING_RC4;
+ } /* else identity */
+
+ /* /Length of encrypt dict is irrelevant here, theoretically every crypt filter may have own length... It means that we should
+ actually keep a different file key for streams and strings. But it leads to nonsense, as /U and /O entries refers to a single
+ keylength, without a distinction for strings/streams. So we have to assume /Length is consistent. To expose the limitation: */
+ if ((crypt->flags & PPCRYPT_STREAM) && (crypt->flags & PPCRYPT_STRING))
+ if (strkeylength != stmkeylength)
+ return PPCRYPT_FAIL;
+ crypt->filekeylength = stmkeylength ? stmkeylength : strkeylength;
+ if ((crypt->flags & PPCRYPT_STREAM) || (crypt->flags & PPCRYPT_STRING))
+ if (crypt->filekeylength == 0)
+ return PPCRYPT_FAIL;
+ break;
+ default:
+ return PPCRYPT_FAIL;
+ }
+
+ /* setup passwords */
+ if (userpass != NULL)
+ ppcrypt_set_user_password(crypt, userpass, userpasslength);
+ if (ownerpass != NULL)
+ ppcrypt_set_owner_password(crypt, ownerpass, ownerpasslength);
+ if ((crypt->flags & (PPCRYPT_USER_PASSWORD|PPCRYPT_OWNER_PASSWORD)) == 0)
+ return PPCRYPT_PASS;
+
+ return ppcrypt_authenticate(crypt, userkey, userkey_e, ownerkey, ownerkey_e, id, perms);
+}
+
+/* decrypting strings */
+
+/*
+Since strings are generally rare, but might occur in mass (name trees). We generate decryption key when needed.
+All strings within the same reference are crypted with the same key. Both RC4 and AES algorithms expands
+the crypt key in some way and the result of expansion is the same for the same crypt key. Instead of recreating
+the ky for every string, we backup the initial decryption state.
+*/
+
+static void ppcrypt_strkey (ppcrypt *crypt, ppref *ref, int aes)
+{
+ if (crypt->cryptkeylength > 0)
+ { /* crypt key already generated, just reinitialize crypt states */
+ if (aes)
+ { /* aes codecs that works on c-strings do not modify aes_state flags at all, so we actually don't need to revitalize the state,
+ we only rewrite an initialization vector, which is modified during crypt procedure */
+ }
+ else
+ { /* rc4 crypt map is modified during crypt procedure, so here we reinitialize rc4 bytes map */
+ rc4_map_restore(&crypt->rc4state, &crypt->rc4copy);
+ }
+ return;
+ }
+
+ if (crypt->algorithm_variant < 5)
+ {
+ crypt->filekey[crypt->filekeylength + 0] = get_number_byte1(ref->number);
+ crypt->filekey[crypt->filekeylength + 1] = get_number_byte2(ref->number);
+ crypt->filekey[crypt->filekeylength + 2] = get_number_byte3(ref->number);
+ crypt->filekey[crypt->filekeylength + 3] = get_number_byte1(ref->version);
+ crypt->filekey[crypt->filekeylength + 4] = get_number_byte2(ref->version);
+
+ if (aes)
+ {
+ crypt->filekey[crypt->filekeylength + 5] = 0x73; // s
+ crypt->filekey[crypt->filekeylength + 6] = 0x41; // A
+ crypt->filekey[crypt->filekeylength + 7] = 0x6C; // l
+ crypt->filekey[crypt->filekeylength + 8] = 0x54; // T
+ }
+
+ md5_digest(crypt->filekey, crypt->filekeylength + (aes ? 9 : 5), crypt->cryptkey, MD5_BYTES);
+ crypt->cryptkeylength = crypt->filekeylength + 5 >= 16 ? 16 : crypt->filekeylength + 5;
+ }
+ else
+ {
+ memcpy(crypt->cryptkey, crypt->filekey, 32);
+ crypt->cryptkeylength = 32;
+ }
+
+ if (aes)
+ {
+ aes_decode_initialize(&crypt->aesstate, &crypt->aeskeyblock, crypt->cryptkey, crypt->cryptkeylength, NULL);
+ aes_pdf_mode(&crypt->aesstate);
+ }
+ else
+ {
+ rc4_state_initialize(&crypt->rc4state, &crypt->rc4map, crypt->cryptkey, crypt->cryptkeylength);
+ rc4_map_save(&crypt->rc4state, &crypt->rc4copy);
+ }
+}
+
+int ppstring_decrypt (ppcrypt *crypt, const void *input, size_t size, void *output, size_t *newsize)
+{
+ int aes, rc4;
+ aes = crypt->flags & PPCRYPT_STRING_AES;
+ rc4 = crypt->flags & PPCRYPT_STRING_RC4;
+ if (aes || rc4)
+ {
+ ppcrypt_strkey(crypt, crypt->ref, aes);
+ if (aes)
+ *newsize = aes_decode_state_data(&crypt->aesstate, input, size, output);
+ else // if (rc4)
+ *newsize = rc4_decode_state_data(&crypt->rc4state, input, size, output);
+ return 1;
+ }
+ return 0; // identity crypt
+}
+
+/* decrypting streams */
+
+/*
+Streams are decrypted everytime when accessing the stream data. We need to be able to get or make
+the key for decryption as long as the stream is alive. And to get the key we need the reference
+number and version, plus document crypt info. First thought was to keep the reference to which
+the stream belongs; stream->ref and accessing the crypt info stream->ref->xref->pdf->crypt.
+It would be ok as long as absolutelly nothing happens with ref and crypt. At some point pplib
+may drift into rewriting support, which would imply ref/xref/crypt/pdf structures modifications.
+So I feel better with generating a crypt key for every stream in encrypted document, paying a cost
+of md5 for all streams, not necessarily those actually read.
+
+Key generation is the same as for strings, but different for distinct encryption methods (rc4 vs aes).
+Since streams and strings might theoretically be encrypted with different filters. No reason to cacche
+decryption state here.
+*/
+
+ppstring * ppcrypt_stmkey (ppcrypt *crypt, ppref *ref, int aes, ppheap *heap)
+{
+ ppstring *cryptkeystring;
+ //if (crypt->cryptkeylength > 0)
+ // return;
+
+ if (crypt->algorithm_variant < 5)
+ {
+ crypt->filekey[crypt->filekeylength + 0] = get_number_byte1(ref->number);
+ crypt->filekey[crypt->filekeylength + 1] = get_number_byte2(ref->number);
+ crypt->filekey[crypt->filekeylength + 2] = get_number_byte3(ref->number);
+ crypt->filekey[crypt->filekeylength + 3] = get_number_byte1(ref->version);
+ crypt->filekey[crypt->filekeylength + 4] = get_number_byte2(ref->version);
+
+ if (aes)
+ {
+ crypt->filekey[crypt->filekeylength + 5] = 0x73;
+ crypt->filekey[crypt->filekeylength + 6] = 0x41;
+ crypt->filekey[crypt->filekeylength + 7] = 0x6C;
+ crypt->filekey[crypt->filekeylength + 8] = 0x54;
+ }
+
+ md5_digest(crypt->filekey, crypt->filekeylength + (aes ? 9 : 5), crypt->cryptkey, MD5_BYTES);
+ crypt->cryptkeylength = crypt->filekeylength + 5 >= 16 ? 16 : crypt->filekeylength + 5; // how about 256bits AES??
+ }
+ else
+ { // we could actually generate this string once, but.. aes itself is way more expensive that we can earn here
+ memcpy(crypt->cryptkey, crypt->filekey, 32); // just for the record
+ crypt->cryptkeylength = 32;
+ }
+ cryptkeystring = ppstring_internal(crypt->cryptkey, crypt->cryptkeylength, heap);
+ return ppstring_decoded(cryptkeystring);
+}
diff --git a/source/luametatex/source/libraries/pplib/ppcrypt.h b/source/luametatex/source/libraries/pplib/ppcrypt.h
new file mode 100644
index 000000000..9fa52d878
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppcrypt.h
@@ -0,0 +1,70 @@
+
+#ifndef PP_CRYPT_H
+#define PP_CRYPT_H
+
+#include "ppfilter.h"
+#include "utilcrypt.h"
+#include "utilcryptdef.h"
+
+#define PPCRYPT_MAX_PASSWORD 127
+#define PPCRYPT_MAX_KEY 32
+
+typedef struct {
+ ppuint algorithm_variant; /* /V entry of encrypt dict */
+ ppuint algorithm_revision; /* /R entry of encrypt dict */
+ ppint permissions; /* /P entry of encrypt dict */
+ ppdict *map; /* /CF filters map of encrypt dict */
+ uint8_t userpass[PPCRYPT_MAX_PASSWORD]; /* user password */
+ size_t userpasslength; /* user password length */
+ uint8_t ownerpass[PPCRYPT_MAX_PASSWORD]; /* owner password */
+ size_t ownerpasslength; /* owner password length */
+ uint8_t filekey[PPCRYPT_MAX_KEY+5+4]; /* file key with an extra space for salt */
+ size_t filekeylength; /* key length; usually 5, 16 or 32 bytes */
+ uint8_t cryptkey[PPCRYPT_MAX_KEY]; /* crypt key for a recent reference */
+ size_t cryptkeylength; /* crypt key length; usually keylength + 5 */
+ //ppstring *cryptkeystring; /* todo: cached cryptkey string for V5, where all refs has the same */
+ ppref *ref; /* recent reference */
+ union { /* cached crypt states for strings encrypted/decrypted with the same key */
+ struct {
+ rc4_state rc4state;
+ rc4_map rc4map;
+ rc4_map rc4copy;
+ };
+ struct {
+ aes_state aesstate;
+ aes_keyblock aeskeyblock;
+ uint8_t ivcopy[16];
+ };
+ };
+ int flags;
+} ppcrypt;
+
+#define PPCRYPT_NO_METADATA (1<<0)
+#define PPCRYPT_USER_PASSWORD (1<<1)
+#define PPCRYPT_OWNER_PASSWORD (1<<2)
+#define PPCRYPT_STREAM_RC4 (1<<3)
+#define PPCRYPT_STRING_RC4 (1<<4)
+#define PPCRYPT_STREAM_AES (1<<5)
+#define PPCRYPT_STRING_AES (1<<6)
+
+#define PPCRYPT_STREAM (PPCRYPT_STREAM_AES|PPCRYPT_STREAM_RC4)
+#define PPCRYPT_STRING (PPCRYPT_STRING_AES|PPCRYPT_STRING_RC4)
+#define PPCRYPT_RC4 (PPCRYPT_STREAM_RC4|PPCRYPT_STRING_RC4)
+#define PPCRYPT_AES (PPCRYPT_STREAM_AES|PPCRYPT_STRING_AES)
+
+#define PPCRYPT_INFO_AES (1<<0)
+#define PPCRYPT_INFO_RC4 (1<<1)
+#define PPCRYPT_INFO_MD (1<<2)
+#define PPCRYPT_INFO_NOMD (1<<3)
+
+ppcrypt_status ppdoc_crypt_init (ppdoc *pdf, const void *userpass, size_t userpasslength, const void *ownerpass, size_t ownerpasslength);
+int ppstring_decrypt (ppcrypt *crypt, const void *input, size_t size, void *output, size_t *newsize);
+
+#define ppcrypt_start_ref(crypt, r) ((crypt)->ref = r, (crypt)->cryptkeylength = 0)
+#define ppcrypt_end_ref(crypt) ((crypt)->ref = NULL, (crypt)->cryptkeylength = 0)
+#define ppcrypt_ref(pdf, crypt) ((crypt = (pdf)->crypt) != NULL && crypt->ref != NULL)
+
+int ppcrypt_type (ppcrypt *crypt, ppname *cryptname, ppuint *length, int *cryptflags);
+ppstring * ppcrypt_stmkey (ppcrypt *crypt, ppref *ref, int aes, ppheap *heap);
+
+#endif
diff --git a/source/luametatex/source/libraries/pplib/ppdict.c b/source/luametatex/source/libraries/pplib/ppdict.c
new file mode 100644
index 000000000..95ea96b9f
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppdict.c
@@ -0,0 +1,166 @@
+
+#include "pplib.h"
+
+ppdict * ppdict_create (const ppobj *stackpos, size_t size, ppheap *heap)
+{
+ ppdict *dict;
+ ppobj *data;
+ ppname **pkey;
+ size_t i;
+
+ size >>= 1; // num of key-value pairs
+ dict = (ppdict *)ppstruct_take(heap, sizeof(ppdict));
+ dict->data = data = (ppobj *)ppstruct_take(heap, size * sizeof(ppobj));
+ dict->keys = pkey = (ppname **)ppstruct_take(heap, (size + 1) * sizeof(ppname **));
+ dict->size = 0;
+
+ for (i = 0; i < size; ++i, stackpos += 2)
+ {
+ if (stackpos->type != PPNAME) // we need this check at lest for trailer hack
+ continue;
+ *pkey = stackpos->name;
+ *data = *(stackpos + 1);
+ ++pkey, ++data, ++dict->size;
+ }
+ *pkey = NULL; // sentinel for convinient iteration
+ return dict;
+}
+
+ppobj * ppdict_get_obj (ppdict *dict, const char *name)
+{
+ ppname **pkey;
+ ppobj *obj;
+
+ for (ppdict_first(dict, pkey, obj); *pkey != NULL; ppdict_next(pkey, obj))
+ if (strcmp((*pkey)->data, name) == 0) // not ppname_eq() or ppname_is()!!
+ return obj;
+ return NULL;
+}
+
+ppobj * ppdict_rget_obj (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_obj(obj) : NULL;
+}
+
+int ppdict_get_bool (ppdict *dict, const char *name, int *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_bool(obj, *v) : 0;
+}
+
+int ppdict_rget_bool (ppdict *dict, const char *name, int *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_bool(obj, *v) : 0;
+}
+
+int ppdict_get_int (ppdict *dict, const char *name, ppint *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_int(obj, *v) : 0;
+}
+
+int ppdict_rget_int (ppdict *dict, const char *name, ppint *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_int(obj, *v) : 0;
+}
+
+int ppdict_get_uint (ppdict *dict, const char *name, ppuint *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_uint(obj, *v) : 0;
+}
+
+int ppdict_rget_uint (ppdict *dict, const char *name, ppuint *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_uint(obj, *v) : 0;
+}
+
+int ppdict_get_num (ppdict *dict, const char *name, ppnum *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_num(obj, *v) : 0;
+}
+
+int ppdict_rget_num (ppdict *dict, const char *name, ppnum *v)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_num(obj, *v) : 0;
+}
+
+ppname * ppdict_get_name (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_name(obj) : NULL;
+}
+
+ppname * ppdict_rget_name (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_name(obj) : NULL;
+}
+
+ppstring * ppdict_get_string (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_string(obj) : NULL;
+}
+
+ppstring * ppdict_rget_string (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_string(obj) : NULL;
+}
+
+pparray * ppdict_get_array (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_array(obj) : NULL;
+}
+
+pparray * ppdict_rget_array (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_array(obj) : NULL;
+}
+
+ppdict * ppdict_get_dict (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_dict(obj) : NULL;
+}
+
+ppdict * ppdict_rget_dict (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_dict(obj) : NULL;
+}
+
+/*
+ppstream * ppdict_get_stream (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_stream(obj) : NULL;
+}
+*/
+
+ppstream * ppdict_rget_stream (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_stream(obj) : NULL;
+}
+
+ppref * ppdict_get_ref (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_get_ref(obj) : NULL;
+}
+
+ppref * ppdict_rget_ref (ppdict *dict, const char *name)
+{
+ ppobj *obj;
+ return (obj = ppdict_get_obj(dict, name)) != NULL ? ppobj_rget_ref(obj) : NULL;
+}
diff --git a/source/luametatex/source/libraries/pplib/ppdict.h b/source/luametatex/source/libraries/pplib/ppdict.h
new file mode 100644
index 000000000..b13ff8eb2
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppdict.h
@@ -0,0 +1,7 @@
+
+#ifndef PP_DICT_H
+#define PP_DICT_H
+
+ppdict * ppdict_create (const ppobj *stack, size_t size, ppheap *heap);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/ppfilter.h b/source/luametatex/source/libraries/pplib/ppfilter.h
new file mode 100644
index 000000000..583aa8cf4
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppfilter.h
@@ -0,0 +1,10 @@
+
+#ifndef PP_FILTER_H
+#define PP_FILTER_H
+
+#include "utilbasexx.h"
+#include "utilflate.h"
+#include "utillzw.h"
+#include "utilfpred.h"
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/ppheap.c b/source/luametatex/source/libraries/pplib/ppheap.c
new file mode 100644
index 000000000..f2fbc2b7e
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppheap.c
@@ -0,0 +1,40 @@
+
+#include "pplib.h"
+
+#define PPBYTES_HEAP_BLOCK 0xFFF
+#define PPBYTES_HEAP_LARGE (PPBYTES_HEAP_BLOCK >> 2)
+#define PPSTRUCT_HEAP_BLOCK 0xFFF
+#define PPSTRUCT_HEAP_LARGE (PPSTRUCT_HEAP_BLOCK >> 2)
+
+void ppheap_init (ppheap *heap)
+{
+ ppstruct_heap_init(heap, PPSTRUCT_HEAP_BLOCK, PPSTRUCT_HEAP_LARGE, 0);
+ ppbytes_heap_init(heap, PPBYTES_HEAP_BLOCK, PPBYTES_HEAP_LARGE, 0);
+}
+
+void ppheap_free (ppheap *heap)
+{
+ ppstruct_heap_free(heap);
+ ppbytes_heap_free(heap);
+}
+
+void ppheap_renew (ppheap *heap)
+{
+ ppstruct_heap_clear(heap);
+ ppbytes_heap_clear(heap);
+ ppbytes_buffer_init(heap);
+}
+
+ppbyte * ppbytes_flush (ppheap *heap, iof *O, size_t *psize)
+{
+ ppbyte *data;
+ size_t size;
+
+ //ASSERT(&heap->bytesheap == O->link);
+ iof_put(O, '\0');
+ data = (ppbyte *)O->buf;
+ size = (size_t)iof_size(O);
+ ppbytes_heap_done(heap, data, size);
+ *psize = size - 1;
+ return data;
+} \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/ppheap.h b/source/luametatex/source/libraries/pplib/ppheap.h
new file mode 100644
index 000000000..85a59ee0a
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppheap.h
@@ -0,0 +1,46 @@
+
+#ifndef PP_HEAP_H
+#define PP_HEAP_H
+
+#include "utilmem.h"
+
+#define pp_malloc util_malloc
+//#define pp_callic util_calloc
+//#define pp_realloc util_realloc
+#define pp_free util_free
+
+#include "utilmemheapiof.h"
+//#include "utilmeminfo.h"
+
+#define ppbytes_heap heap16
+#define ppbytes_heap_init(heap, space, large, flags) (heap16_init(&(heap)->bytesheap, space, large, flags), heap16_head(&(heap)->bytesheap))
+//#define ppbytes_heap_some(heap, size, pspace) _heap16_some(&(heap)->bytesheap, size, pspace)
+#define ppbytes_heap_done(heap, data, written) heap16_done(&(heap)->bytesheap, data, written)
+#define ppbytes_heap_clear(heap) heap16_clear(&(heap)->bytesheap)
+#define ppbytes_heap_free(heap) heap16_free(&(heap)->bytesheap)
+#define ppbytes_heap_info(heap, info, append) heap16_stats(&(heap)->bytesheap, info, append)
+
+#define ppbytes_take(heap, size) _heap16_take(&(heap)->bytesheap, size)
+#define ppbytes_buffer_init(heap) heap16_buffer_init(&(heap)->bytesheap, &(heap)->bytesbuffer)
+#define ppbytes_buffer(heap, atleast) _heap16_buffer_some(&(heap)->bytesheap, &(heap)->bytesbuffer, atleast)
+
+#define ppstruct_heap heap64
+#define ppstruct_heap_init(heap, space, large, flags) (heap64_init(&(heap)->structheap, space, large, flags), heap64_head(&(heap)->structheap))
+#define ppstruct_heap_clear(heap) heap64_clear(&(heap)->structheap)
+#define ppstruct_heap_free(heap) heap64_free(&(heap)->structheap)
+#define ppstruct_heap_info(heap, info, append) heap64_stats(&(heap)->structheap, info, append)
+#define ppstruct_take(heap, size) _heap64_take(&(heap)->structheap, size)
+
+typedef struct {
+ ppbytes_heap bytesheap;
+ ppstruct_heap structheap;
+ iof bytesbuffer;
+} ppheap;
+
+ppbyte * ppbytes_flush (ppheap *heap, iof *O, size_t *psize);
+
+void ppheap_init (ppheap *heap);
+void ppheap_free (ppheap *heap);
+void ppheap_renew (ppheap *heap);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/pplib.h b/source/luametatex/source/libraries/pplib/pplib.h
new file mode 100644
index 000000000..e753cfa05
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/pplib.h
@@ -0,0 +1,22 @@
+
+#ifndef PP_LIB_H
+#define PP_LIB_H
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+#include "utiliof.h"
+#include "utillog.h"
+
+#include "ppapi.h"
+#include "ppheap.h"
+#include "ppdict.h"
+#include "ppstream.h"
+#include "pparray.h"
+#include "ppcrypt.h"
+#include "ppxref.h"
+#include "ppload.h"
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/ppload.c b/source/luametatex/source/libraries/pplib/ppload.c
new file mode 100644
index 000000000..0e72039d8
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppload.c
@@ -0,0 +1,2769 @@
+
+#include "pplib.h"
+
+const char * ppobj_kind[] = { "none", "null", "bool", "integer", "number", "name", "string", "array", "dict", "stream", "ref" };
+
+#define ignored_char(c) (c == 0x20 || c == 0x0A || c == 0x0D || c == 0x09 || c == 0x00)
+#define newline_char(c) (c == 0x0A || c == 0x0D)
+#define IGNORED_CHAR_CASE 0x20: case 0x0A: case 0x0D: case 0x09: case 0x00
+#define NEWLINE_CHAR_CASE 0x0A: case 0x0D
+#define DIGIT_CHAR_CASE '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9'
+#define OCTAL_CHAR_CASE '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7'
+
+#define MAX_INT_DIGITS 32
+
+#define PP_LENGTH_UNKNOWN ((size_t)-1)
+
+static const char * ppref_str (ppuint refnumber, ppuint refversion)
+{
+ static char buffer[MAX_INT_DIGITS + 1 + MAX_INT_DIGITS + 1 + 1 + 1];
+ sprintf(buffer, "%lu %lu R", (unsigned long)(refnumber), (unsigned long)(refversion));
+ return buffer;
+}
+
+/* name */
+
+/*
+pdf spec page 57:
+"The name may include any regular characters, but not delimiter or white-space characters (see Section 3.1, “Lexical Conventions”)."
+"The token / (a slash followed by no regular characters) is a valid name"
+"Beginning with PDF 1.2, any character except null (character code 0) may be included in a name by writing its 2-digit hexadecimal code,
+preceded by the number sign character (#); see implementation notes 3 and 4 in Appendix H. This syntax is required to represent any of the
+delimiter or white-space characters or the number sign character itself; it is recommended but not required for characters whose codes
+are outside the range 33 (!) to 126 (~)."
+
+This suggests we should accept bytes 128..255 as a part of the name.
+*/
+
+// pdf name delimiters: 0..32, ()<>[]{}/%
+// # treated specially
+// .+- are valid part of name; keep in mind names such as -| | |- .notdef ABCDEF+Font etc.
+static const int8_t ppname_byte_lookup[] = {
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 1, 1, '#', 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
+};
+
+/*
+20190827: The end of the name is any byte with 0 lookup value. When reading a ref object or objstm stream containing
+a single name, we may get input byte IOFEOF (-1), which must not be treated as 255. So a check for (c >= 0) is needed,
+otherwise we keep writing byte 255 to the output buffer until not enough memory.
+*/
+
+#define ppnamebyte(c) (c >= 0 && ppname_byte_lookup[(uint8_t)(c)])
+
+static const int8_t pphex_byte_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
+ -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+/* no need for (c >= 0) check here */
+
+#define pphex(c) pphex_byte_lookup[(uint8_t)(c)]
+
+#define PPNAME_INIT (7 + 1)
+
+static ppname * ppscan_name (iof *I, ppheap *heap)
+{
+ ppname *encoded, *decoded;
+ iof *O;
+ int decode, c;
+ uint8_t *p, *e;
+ int8_t h1, h2;
+
+ O = ppbytes_buffer(heap, PPNAME_INIT);
+ for (decode = 0, c = iof_char(I); ppnamebyte(c); c = iof_next(I))
+ {
+ if (c == '#') decode = 1;
+ iof_put(O, c);
+ }
+ encoded = (ppname *)ppstruct_take(heap, sizeof(ppname));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+ if (decode)
+ {
+ O = ppbytes_buffer(heap, encoded->size); // decoded always a bit smaller
+ for (p = (uint8_t *)encoded->data, e = p + encoded->size; p < e; ++p)
+ {
+ if (*p == '#' && p + 2 < e && (h1 = pphex(p[1])) >= 0 && (h2 = pphex(p[2])) >= 0)
+ {
+ iof_set(O, ((h1 << 4)|h2));
+ p += 2;
+ }
+ else
+ iof_set(O, *p);
+ }
+ decoded = (ppname *)ppstruct_take(heap, sizeof(ppname));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+ encoded->flags = PPNAME_ENCODED;
+ decoded->flags = PPNAME_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+ }
+ else
+ {
+ encoded->flags = 0;
+ encoded->alterego = encoded;
+ }
+ return encoded;
+}
+
+static ppname * ppscan_exec (iof *I, ppheap *heap, uint8_t firstbyte)
+{
+ ppname *encoded, *decoded;
+ iof *O;
+ int decode, c;
+ uint8_t *p, *e;
+ int8_t h1, h2;
+
+ O = ppbytes_buffer(heap, PPNAME_INIT);
+ iof_put(O, firstbyte);
+ for (decode = 0, c = iof_char(I); ppnamebyte(c); c = iof_next(I))
+ {
+ if (c == '#') decode = 1;
+ iof_put(O, c);
+ }
+ encoded = (ppname *)ppstruct_take(heap, sizeof(ppname));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+ if (decode)
+ {
+ O = ppbytes_buffer(heap, encoded->size);
+ for (p = (uint8_t *)encoded->data, e = p + encoded->size; p < e; ++p)
+ {
+ if (*p == '#' && p + 2 < e && (h1 = pphex(p[1])) >= 0 && (h2 = pphex(p[2])) >= 0)
+ {
+ iof_set(O, ((h1 << 4)|h2));
+ p += 2;
+ }
+ else
+ iof_set(O, *p);
+ }
+ decoded = (ppname *)ppstruct_take(heap, sizeof(ppname));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+ encoded->flags = PPNAME_EXEC|PPNAME_ENCODED;
+ decoded->flags = PPNAME_EXEC|PPNAME_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+ }
+ else
+ {
+ encoded->flags = PPNAME_EXEC;
+ encoded->alterego = encoded;
+ }
+ return encoded;
+}
+
+static ppname * ppname_internal (const void *data, size_t size, int flags, ppheap *heap)
+{ // so far needed only for 'EI' operator
+ ppname *encoded;
+ encoded = (ppname *)ppstruct_take(heap, sizeof(ppname));
+ encoded->data = (ppbyte *)ppbytes_take(heap, size + 1);
+ memcpy(encoded->data, data, size);
+ encoded->data[size] = '\0';
+ encoded->size = size;
+ encoded->alterego = encoded;
+ encoded->flags = flags;
+ return encoded;
+}
+
+#define ppexec_internal(data, size, heap) ppname_internal(data, size, PPNAME_EXEC, heap)
+
+ppname * ppname_decoded (ppname *name)
+{
+ return (name->flags & PPNAME_ENCODED) ? name->alterego : name;
+}
+
+ppname * ppname_encoded (ppname *name)
+{
+ return (name->flags & PPNAME_DECODED) ? name->alterego : name;
+}
+
+ppbyte * ppname_decoded_data (ppname *name)
+{
+ return (name->flags & PPNAME_ENCODED) ? name->alterego->data : name->data;
+}
+
+ppbyte * ppname_encoded_data (ppname *name)
+{
+ return (name->flags & PPNAME_DECODED) ? name->alterego->data : name->data;
+}
+
+/* string */
+
+static const int8_t ppstring_byte_escape[] = { /* -1 escaped with octal, >0 escaped with \\, 0 left intact*/
+ -1,-1,-1,-1,-1,-1,-1,-1,'b','t','n',-1,'f','r',-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ 0, 0, 0, 0, 0, 0, 0, 0,'(',')', 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,'\\', 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+//// pp string
+
+#define PPSTRING_INIT (7 + 1)
+
+#define ppstring_check_bom(decoded) ((void)\
+ (decoded->size >= 2 ? (ppstring_utf16be_bom(decoded->data) ? (decoded->flags |= PPSTRING_UTF16BE) : \
+ (ppstring_utf16le_bom(decoded->data) ? (decoded->flags |= PPSTRING_UTF16LE) : 0)) : 0))
+
+#define ppstring_check_bom2(decoded, encoded) ((void)\
+ (decoded->size >= 2 ? (ppstring_utf16be_bom(decoded->data) ? ((decoded->flags |= PPSTRING_UTF16BE), (encoded->flags |= PPSTRING_UTF16BE)) : \
+ (ppstring_utf16le_bom(decoded->data) ? ((decoded->flags |= PPSTRING_UTF16LE), (encoded->flags |= PPSTRING_UTF16LE)) : 0)) : 0))
+
+#define ppstring_utf16be_bom(data) (data[0] == '\xFE' && data[1] == '\xFF')
+#define ppstring_utf16le_bom(data) (data[0] == '\xFF' && data[1] == '\xFE')
+
+#define ppstringesc(c) ppstring_byte_escape[(uint8_t)(c)]
+
+static ppstring * ppscan_string (iof *I, ppheap *heap)
+{
+ ppstring *encoded, *decoded;
+ iof *O;
+ int c, decode, balance;
+ uint8_t *p, *e;
+
+ O = ppbytes_buffer(heap, PPSTRING_INIT);
+ for (decode = 0, balance = 0, c = iof_char(I); c >= 0; )
+ {
+ switch (c)
+ {
+ case '\\':
+ decode = 1;
+ iof_put(O, '\\');
+ if ((c = iof_next(I)) >= 0)
+ {
+ iof_put(O, c);
+ c = iof_next(I);
+ }
+ break;
+ case '(': // may be unescaped if balanced
+ ++balance;
+ iof_put(O, '(');
+ c = iof_next(I);
+ break;
+ case ')':
+ if (balance == 0)
+ {
+ c = IOFEOF;
+ ++I->pos;
+ break;
+ }
+ --balance;
+ iof_put(O, ')');
+ c = iof_next(I);
+ break;
+ default:
+ iof_put(O, c);
+ c = iof_next(I);
+ }
+ }
+ encoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+ if (decode)
+ {
+ O = ppbytes_buffer(heap, encoded->size); // decoded can only be smaller
+ for (p = (uint8_t *)encoded->data, e = p + encoded->size; p < e; ++p)
+ {
+ if (*p == '\\')
+ {
+ if (++p >= e)
+ break;
+ switch (*p)
+ {
+ case OCTAL_CHAR_CASE:
+ c = *p - '0';
+ if (++p < e && *p >= '0' && *p <= '7')
+ {
+ c = (c << 3) + *p - '0';
+ if (++p < e && *p >= '0' && *p <= '7')
+ c = (c << 3) + *p - '0';
+ }
+ iof_set(O, c);
+ break;
+ case 'n':
+ iof_set(O, '\n');
+ break;
+ case 'r':
+ iof_set(O, '\r');
+ break;
+ case 't':
+ iof_set(O, '\t');
+ break;
+ case 'b':
+ iof_set(O, '\b');
+ break;
+ case 'f':
+ iof_set(O, '\f');
+ break;
+ case NEWLINE_CHAR_CASE: // not a part of the string, ignore (pdf spec page 55)
+ break;
+ case '(': case ')': case '\\':
+ default: // for anything else backslash is ignored (pdf spec page 54)
+ iof_set(O, *p);
+ break;
+ }
+ }
+ else
+ iof_set(O, *p);
+ }
+ decoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+ encoded->flags = PPSTRING_ENCODED;
+ decoded->flags = PPSTRING_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+ ppstring_check_bom2(decoded, encoded);
+ }
+ else
+ {
+ encoded->flags = 0;
+ encoded->alterego = encoded;
+ ppstring_check_bom(encoded);
+ }
+ return encoded;
+}
+
+static ppstring * ppscan_base16 (iof *I, ppheap *heap)
+{
+ ppstring *encoded, *decoded;
+ iof *O;
+ int c;
+ uint8_t *p, *e;
+ int8_t h1, h2;
+
+ O = ppbytes_buffer(heap, PPSTRING_INIT);
+ for (c = iof_char(I); (pphex(c) >= 0 || ignored_char(c)); c = iof_next(I))
+ iof_put(O, c);
+ if (c == '>')
+ ++I->pos;
+ encoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+
+ O = ppbytes_buffer(heap, ((encoded->size + 1) >> 1) + 1); // decoded can only be smaller
+ for (p = (uint8_t *)encoded->data, e = p + encoded->size; p < e; ++p)
+ {
+ if ((h1 = pphex(*p)) < 0) // ignored
+ continue;
+ for (h2 = 0, ++p; p < e && (h2 = pphex(*p)) < 0; ++p);
+ iof_set(O, (h1 << 4)|h2);
+ }
+ decoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+
+ encoded->flags = PPSTRING_BASE16|PPSTRING_ENCODED;
+ decoded->flags = PPSTRING_BASE16|PPSTRING_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+
+ ppstring_check_bom2(decoded, encoded);
+ return encoded;
+}
+
+static ppstring * ppstring_buffer (iof *O, ppheap *heap)
+{
+ ppstring *encoded, *decoded;
+ uint8_t *p, *e;
+
+ decoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+
+ O = ppbytes_buffer(heap, (decoded->size << 1) + 1); // the exact size known
+ for (p = (uint8_t *)decoded->data, e = p + decoded->size; p < e; ++p)
+ iof_set2(O, base16_uc_alphabet[(*p) >> 4], base16_uc_alphabet[(*p) & 0xF]);
+ encoded = ppstruct_take(heap, sizeof(ppstring));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+ encoded->flags = PPSTRING_BASE16|PPSTRING_ENCODED;
+ decoded->flags = PPSTRING_BASE16|PPSTRING_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+ // ppstring_check_bom2(decoded, encoded); // ?
+ return encoded;
+}
+
+ppstring * ppstring_internal (const void *data, size_t size, ppheap *heap)
+{ // so far used only for crypt key
+ iof *O;
+ O = ppbytes_buffer(heap, size);
+ memcpy(O->buf, data, size);
+ O->pos = O->buf + size;
+ return ppstring_buffer(O, heap);
+}
+
+/* base85; local function for that to make that part independent from utilbasexx */
+
+static const int8_t ppstring_base85_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,
+ 15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,
+ 31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,
+ 47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,
+ 63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,
+ 79,80,81,82,83,84,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+#define base85_value(c) ppstring_base85_lookup[(uint8_t)(c)]
+
+#define base85_code(c1, c2, c3, c4, c5) ((((c1 * 85 + c2) * 85 + c3) * 85 + c4) * 85 + c5)
+#define base85_eof(c) (c == '~' || c < 0)
+
+static iof_status ppscan_base85_decode (iof *I, iof *O)
+{
+ int c1, c2, c3, c4, c5;
+ uint32_t code;
+ while (iof_ensure(O, 4))
+ {
+ do { c1 = iof_get(I); } while (ignored_char(c1));
+ if (base85_eof(c1))
+ return IOFEOF;
+ switch (c1)
+ {
+ case 'z':
+ iof_set4(O, '\0', '\0', '\0', '\0');
+ continue;
+ case 'y':
+ iof_set4(O, ' ', ' ', ' ', ' ');
+ continue;
+ }
+ do { c2 = iof_get(I); } while (ignored_char(c2));
+ if (base85_eof(c2))
+ return IOFERR;
+ do { c3 = iof_get(I); } while (ignored_char(c3));
+ if (base85_eof(c3))
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, 84, 84, 84); /* padding with 'u' (117); 117-33 = 84 */
+ iof_set(O, (code >> 24));
+ return IOFEOF;
+ }
+ do { c4 = iof_get(I); } while (ignored_char(c4));
+ if (base85_eof(c4))
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 || (c3 = base85_value(c3)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, 84, 84);
+ iof_set2(O, code>>24, ((code>>16) & 0xff));
+ return IOFEOF;
+ }
+ do { c5 = iof_get(I); } while (ignored_char(c5));
+ if (base85_eof(c5))
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 ||
+ (c3 = base85_value(c3)) < 0 || (c4 = base85_value(c4)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, c4, 84);
+ iof_set3(O, (code >> 24), ((code >> 16) & 0xff), ((code >> 8) & 0xff));
+ return IOFEOF;
+ }
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 || (c3 = base85_value(c3)) < 0 ||
+ (c4 = base85_value(c4)) < 0 || (c5 = base85_value(c5)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, c4, c5);
+ iof_set4(O, (code >> 24), ((code >> 16) & 0xff), ((code >> 8) & 0xff), (code & 0xff));
+ }
+ return IOFFULL;
+}
+
+static ppstring * ppscan_base85 (iof *I, ppheap *heap)
+{ // base85 alphabet is 33..117, adobe also hires 'z' and 'y' for compression
+ ppstring *encoded, *decoded;
+ iof *O, B;
+ int c;
+
+ O = ppbytes_buffer(heap, PPSTRING_INIT);
+ for (c = iof_char(I); (c >= '!' && c <= 'u') || c == 'z' || c == 'y'; c = iof_next(I))
+ iof_put(O, c);
+ if (c == '~')
+ if ((c = iof_next(I)) == '>')
+ ++I->pos;
+ encoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+
+ iof_string_reader(&B, encoded->data, encoded->size);
+ O = ppbytes_buffer(heap, (encoded->size * 5 / 4) + 1); // may be larger that that because of 'z' and 'y'
+ ppscan_base85_decode(&B, O);
+ decoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+
+ encoded->flags = PPSTRING_BASE85|PPSTRING_ENCODED;
+ decoded->flags = PPSTRING_BASE85|PPSTRING_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+
+ ppstring_check_bom2(decoded, encoded);
+ return encoded;
+}
+
+ppstring * ppstring_decoded (ppstring *string)
+{
+ return (string->flags & PPSTRING_ENCODED) ? string->alterego : string;
+}
+
+ppstring * ppstring_encoded (ppstring *string)
+{
+ return (string->flags & PPSTRING_DECODED) ? string->alterego : string;
+}
+
+ppbyte * ppstring_decoded_data (ppstring *string)
+{
+ return (string->flags & PPSTRING_ENCODED) ? string->alterego->data : string->data;
+}
+
+ppbyte * ppstring_encoded_data (ppstring *string)
+{
+ return (string->flags & PPSTRING_DECODED) ? string->alterego->data : string->data;
+}
+
+
+/* encrypted string */
+
+static ppstring * ppscan_crypt_string (iof *I, ppcrypt *crypt, ppheap *heap)
+{
+ ppstring *encoded, *decoded;
+ iof *O;
+ int c, b, balance, encode;
+ uint8_t *p, *e;
+ size_t size;
+
+ O = ppbytes_buffer(heap, PPSTRING_INIT);
+ for (balance = 0, encode = 0, c = iof_char(I); c >= 0; )
+ {
+ switch (c)
+ {
+ case '\\':
+ if ((c = iof_next(I)) < 0)
+ break;
+ encode = 1;
+ switch (c)
+ {
+ case OCTAL_CHAR_CASE:
+ b = c - '0';
+ if ((c = iof_next(I)) >= 0 && c >= '0' && c <= '7')
+ {
+ b = (b << 3) + c - '0';
+ if ((c = iof_next(I)) >= 0 && c >= '0' && c <= '7')
+ {
+ b = (b << 3) + c - '0';
+ c = iof_next(I);
+ }
+ }
+ iof_put(O, b);
+ // c is set to the next char
+ break;
+ case 'n':
+ iof_put(O, '\n');
+ c = iof_next(I);
+ break;
+ case 'r':
+ iof_put(O, '\r');
+ c = iof_next(I);
+ break;
+ case 't':
+ iof_put(O, '\t');
+ c = iof_next(I);
+ break;
+ case 'b':
+ iof_put(O, '\b');
+ c = iof_next(I);
+ break;
+ case 'f':
+ iof_put(O, '\f');
+ c = iof_next(I);
+ break;
+ case NEWLINE_CHAR_CASE: // not a part of the string, ignore (pdf spec page 55)
+ c = iof_next(I);
+ break;
+ case '(': case ')': case '\\':
+ default: // for enything else backslash is ignored (pdf spec page 54)
+ iof_put(O, c);
+ c = iof_next(I);
+ break;
+ }
+ break;
+ case '(':
+ ++balance;
+ encode = 1;
+ iof_put(O, '(');
+ c = iof_next(I);
+ break;
+ case ')':
+ if (balance == 0)
+ {
+ c = IOFEOF;
+ ++I->pos;
+ }
+ else
+ {
+ --balance;
+ //encode = 1;
+ iof_put(O, ')');
+ c = iof_next(I);
+ }
+ break;
+ default:
+ if (ppstringesc(c) != 0)
+ encode = 1;
+ iof_put(O, c);
+ c = iof_next(I);
+ }
+ }
+ /* decrypt the buffer in place, update size */
+ if (ppstring_decrypt(crypt, O->buf, iof_size(O), O->buf, &size))
+ O->pos = O->buf + size;
+ decoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+ /* make encoded counterpart */
+ if (encode)
+ {
+ O = ppbytes_buffer(heap, decoded->size + 1); // we don't know
+ for (p = (uint8_t *)decoded->data, e = p + decoded->size; p < e; ++p)
+ {
+ b = ppstringesc(*p);
+ switch (b)
+ {
+ case 0:
+ iof_put(O, *p);
+ break;
+ case -1:
+ iof_put4(O, '\\', ((*p) >> 6) + '0', (((*p) >> 3) & 7) + '0', ((*p) & 7) + '0');
+ break;
+ default:
+ iof_put2(O, '\\', b);
+ break;
+ }
+ }
+ encoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+ encoded->flags = PPSTRING_ENCODED;
+ decoded->flags = PPSTRING_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+ ppstring_check_bom2(decoded, encoded);
+ }
+ else
+ {
+ decoded->flags = 0;
+ decoded->alterego = decoded;
+ ppstring_check_bom(decoded);
+ encoded = decoded;
+ }
+ return encoded;
+}
+
+static ppstring * ppscan_crypt_base16 (iof *I, ppcrypt *crypt, ppheap *heap)
+{
+ ppstring *encoded, *decoded;
+ iof *O;
+ int c;
+ uint8_t *p, *e;
+ int8_t h1, h2;
+ size_t size;
+
+ O = ppbytes_buffer(heap, PPSTRING_INIT);
+ for (c = iof_char(I); c != '>'; )
+ {
+ if ((h1 = pphex(c)) < 0)
+ {
+ if (ignored_char(c))
+ {
+ c = iof_next(I);
+ continue;
+ }
+ break;
+ }
+ do {
+ c = iof_next(I);
+ if ((h2 = pphex(c)) >= 0)
+ {
+ c = iof_next(I);
+ break;
+ }
+ if (!ignored_char(c)) // c == '>' || c < 0 or some crap
+ {
+ h2 = 0;
+ break;
+ }
+ } while (1);
+ iof_put(O, (h1 << 4)|h2);
+ }
+ if (c == '>')
+ ++I->pos;
+ /* decrypt the buffer in place, update size */
+ if (ppstring_decrypt(crypt, O->buf, iof_size(O), O->buf, &size))
+ O->pos = O->buf + size;
+ decoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ decoded->data = ppbytes_flush(heap, O, &decoded->size);
+
+ O = ppbytes_buffer(heap, (decoded->size << 1) + 1);
+ for (p = (uint8_t *)decoded->data, e = p + decoded->size; p < e; ++p)
+ iof_set2(O, base16_uc_alphabet[(*p) >> 4], base16_uc_alphabet[(*p) & 0xF]);
+ encoded = (ppstring *)ppstruct_take(heap, sizeof(ppstring));
+ encoded->data = ppbytes_flush(heap, O, &encoded->size);
+
+ encoded->flags = PPSTRING_BASE16|PPSTRING_ENCODED;
+ decoded->flags = PPSTRING_BASE16|PPSTRING_DECODED;
+ encoded->alterego = decoded, decoded->alterego = encoded;
+
+ ppstring_check_bom2(decoded, encoded);
+ return encoded;
+}
+
+/* scanner stack */
+
+#define PPSTACK_BUFFER 512
+
+static void ppstack_init (ppstack *stack, ppheap *heap)
+{
+ stack->buf = stack->pos = (ppobj *)pp_malloc(PPSTACK_BUFFER * sizeof(ppobj));
+ stack->size = 0;
+ stack->space = PPSTACK_BUFFER;
+ stack->heap = heap;
+}
+
+#define ppstack_free_buffer(stack) (pp_free((stack)->buf))
+
+static void ppstack_resize (ppstack *stack)
+{
+ ppobj *newbuffer;
+ stack->space <<= 1;
+ newbuffer = (ppobj *)pp_malloc(stack->space * sizeof(ppobj));
+ memcpy(newbuffer, stack->buf, stack->size * sizeof(ppobj));
+ ppstack_free_buffer(stack);
+ stack->buf = newbuffer;
+ stack->pos = newbuffer + stack->size;
+}
+
+#define ppstack_push(stack) ((void)((stack)->size < (stack)->space || (ppstack_resize(stack), 0)), ++(stack)->size, (stack)->pos++)
+#define ppstack_pop(stack, n) ((stack)->size -= (n), (stack)->pos -= (n))
+#define ppstack_at(stack, i) ((stack)->buf + i)
+#define ppstack_clear(stack) ((stack)->pos = (stack)->buf, (stack)->size = 0)
+
+/* scanner commons */
+
+#define ppscan_uint(I, u) iof_get_usize(I, u)
+#define ppread_uint(s, u) string_to_usize((const char *)(s), u)
+
+static ppobj * ppscan_numobj (iof *I, ppobj *obj, int negative)
+{
+ ppint integer;
+ ppnum number;
+ int exponent;
+ int c;
+ c = iof_char(I);
+ iof_scan_integer(I, c, integer);
+ switch(c)
+ {
+ case '.':
+ {
+ number = (ppnum)integer;
+ c = iof_next(I);
+ iof_scan_fraction(I, c, number, exponent);
+ double_negative_exp10(number, exponent);
+ obj->type = PPNUM, obj->number = negative ? -number : number;
+ break;
+ }
+ default:
+ obj->type = PPINT, obj->integer = negative ? -integer : integer;
+ break;
+ }
+ return obj;
+}
+
+static ppobj * ppscan_numobj_frac (iof *I, ppobj *obj, int negative)
+{
+ ppnum number;
+ int c, exponent;
+
+ number = 0.0;
+ c = iof_next(I);
+ iof_scan_fraction(I, c, number, exponent);
+ double_negative_exp10(number, exponent);
+ obj->type = PPNUM, obj->number = negative ? -number : number;
+ return obj;
+}
+
+static int ppscan_find (iof *I)
+{ // skips whitechars and comments
+ int c;
+ for (c = iof_char(I); ; c = iof_next(I))
+ {
+ switch (c)
+ {
+ case IGNORED_CHAR_CASE:
+ break;
+ case '%': {
+ do {
+ if ((c = iof_next(I)) < 0)
+ return c;
+ } while (!newline_char(c));
+ break;
+ }
+ default:
+ return c;
+ }
+ }
+ return c; // never reached
+}
+
+static int ppscan_keyword (iof *I, const char *keyword, size_t size)
+{
+ size_t i;
+ int c;
+ if ((size_t)iof_left(I) >= size)
+ {
+ if (memcmp(I->pos, keyword, size) != 0)
+ return 0;
+ I->pos += size;
+ return 1;
+ }
+ // sticky case, we can't go back
+ for (i = 0, c = iof_char(I); i < size; ++i, ++keyword, c = iof_next(I))
+ if (c < 0 || *keyword != c) /* PJ20190503 bugfix: there was (i!=c), we actually never get here anyway */
+ return 0;
+ return 1;
+}
+
+#define ppscan_key(I, literal) ppscan_keyword(I, "" literal, sizeof(literal) - 1)
+
+/* objects parser */
+
+static ppref * ppref_unresolved (ppheap *heap, ppuint refnumber, ppuint refversion)
+{
+ ppref *ref = (ppref *)ppstruct_take(heap, sizeof(ppref));
+ memset(ref, 0, sizeof(ppref));
+ ref->object.type = PPNONE;
+ ref->number = refnumber;
+ ref->version = refversion;
+ return ref;
+}
+
+#define PPMARK PPNONE
+
+static ppobj * ppscan_obj (iof *I, ppdoc *pdf, ppxref *xref)
+{
+ int c;
+ ppobj *obj;
+ size_t mark, size;
+ ppuint refnumber, refversion;
+ ppref *ref;
+ ppstack *stack;
+ ppcrypt *crypt;
+
+ stack = &pdf->stack;
+ c = iof_char(I);
+ switch (c)
+ {
+ case DIGIT_CHAR_CASE:
+ return ppscan_numobj(I, ppstack_push(stack), 0);
+ case '.':
+ return ppscan_numobj_frac(I, ppstack_push(stack), 0);
+ case '+':
+ ++I->pos;
+ return ppscan_numobj(I, ppstack_push(stack), 0);
+ case '-':
+ ++I->pos;
+ return ppscan_numobj(I, ppstack_push(stack), 1);
+ case '/':
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPNAME;
+ obj->name = ppscan_name(I, &pdf->heap);
+ return obj;
+ case '(':
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPSTRING;
+ if (ppcrypt_ref(pdf, crypt))
+ obj->string = ppscan_crypt_string(I, crypt, &pdf->heap);
+ else
+ obj->string = ppscan_string(I, &pdf->heap);
+ return obj;
+ case '[':
+ mark = stack->size;
+ obj = ppstack_push(stack);
+ obj->type = PPMARK; // ppscan_obj() checks types backward for 'R', so set the type immediatelly (reserved for PPARRAY)
+ obj->any = NULL;
+ ++I->pos;
+ for (c = ppscan_find(I); c != ']'; c = ppscan_find(I))
+ {
+ if (ppscan_obj(I, pdf, xref) == NULL)
+ { // callers assume that NULL returns means nothing pushed
+ size = stack->size - mark; // pop items AND the obj reserved for array
+ ppstack_pop(stack, size);
+ return NULL;
+ }
+ }
+ ++I->pos;
+ size = stack->size - mark - 1;
+ obj = ppstack_at(stack, mark); // stack might have been realocated
+ obj->type = PPARRAY;
+ obj->array = pparray_create(ppstack_at(stack, mark + 1), size, &pdf->heap);
+ ppstack_pop(stack, size); // pop array items, leave the array on top
+ return obj;
+ case '<':
+ if ((c = iof_next(I)) == '<')
+ {
+ mark = stack->size;
+ obj = ppstack_push(stack);
+ obj->type = PPMARK;
+ obj->any = NULL;
+ ++I->pos;
+ for (c = ppscan_find(I); c != '>'; c = ppscan_find(I))
+ {
+ if (ppscan_obj(I, pdf, xref) == NULL)
+ {
+ size = stack->size - mark;
+ ppstack_pop(stack, size);
+ return NULL;
+ }
+ }
+ if (iof_next(I) == '>')
+ ++I->pos;
+ size = stack->size - mark - 1;
+ obj = ppstack_at(stack, mark);
+ obj->type = PPDICT;
+ obj->dict = ppdict_create(ppstack_at(stack, mark + 1), size, &pdf->heap);
+ ppstack_pop(stack, size);
+ return obj;
+ }
+ obj = ppstack_push(stack);
+ obj->type = PPSTRING;
+ if (ppcrypt_ref(pdf, crypt))
+ obj->string = ppscan_crypt_base16(I, crypt, &pdf->heap);
+ else
+ obj->string = ppscan_base16(I, &pdf->heap);
+ return obj;
+ case 'R':
+ if (stack->size >= 2 && stack->pos[-1].type == PPINT && stack->pos[-2].type == PPINT)
+ {
+ ++I->pos;
+ obj = &stack->pos[-2];
+ refnumber = (ppuint)obj->integer;
+ ppstack_pop(stack, 1); // pop version number, retype obj to a reference
+ if (xref == NULL || (ref = ppxref_find(xref, refnumber)) == NULL)
+ { /* pdf spec page 64: unresolvable reference is not an error, should just be treated as a reference to null.
+ we also need this to read trailer, where refs can't be resolved yet */
+ refversion = (obj + 1)->integer;
+ //if (xref != NULL)
+ // loggerf("unresolved reference %s", ppref_str(refnumber, refversion));
+ ref = ppref_unresolved(stack->heap, refnumber, refversion);
+ }
+ obj->type = PPREF;
+ obj->ref = ref;
+ return obj;
+ }
+ break;
+ case 't':
+ if (iof_next(I) == 'r' && iof_next(I) == 'u' && iof_next(I) == 'e')
+ {
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPBOOL;
+ obj->integer = 1;
+ return obj;
+ }
+ break;
+ case 'f':
+ if (iof_next(I) == 'a' && iof_next(I) == 'l' && iof_next(I) == 's' && iof_next(I) == 'e')
+ {
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPBOOL;
+ obj->integer = 0;
+ return obj;
+ }
+ break;
+ case 'n':
+ if (iof_next(I) == 'u' && iof_next(I) == 'l' && iof_next(I) == 'l')
+ {
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPNULL;
+ obj->any = NULL;
+ return obj;
+ }
+ break;
+ }
+ return NULL;
+}
+
+/*
+A variant for contents streams (aka postscript); wise of operators, blind to references.
+We are still PDF, so we don't care about postscript specific stuff such as radix numbers
+and scientific numbers notation. It takes ppstack * as context (no ppdoc *) to be able
+to run contents parser beyond the scope of ppdoc heap.
+*/
+
+static ppstring * ppstring_inline (iof *I, ppdict *imagedict, ppheap *heap);
+
+static ppobj * ppscan_psobj (iof *I, ppstack *stack)
+{
+ int c;
+ ppobj *obj, *op;
+ size_t size, mark;
+ ppname *exec;
+ ppbyte *data;
+
+ c = iof_char(I);
+ switch (c)
+ {
+ case DIGIT_CHAR_CASE:
+ return ppscan_numobj(I, ppstack_push(stack), 0);
+ case '.':
+ return ppscan_numobj_frac(I, ppstack_push(stack), 0);
+ case '+':
+ c = iof_next(I);
+ if (base10_digit(c)) // '+.abc' is probably an executable name, but we are not in postscript
+ return ppscan_numobj(I, ppstack_push(stack), 0);
+ else if (c == '.')
+ return ppscan_numobj_frac(I, ppstack_push(stack), 0);
+ obj = ppstack_push(stack);
+ obj->type = PPNAME;
+ obj->name = ppscan_exec(I, stack->heap, '+');
+ return obj;
+ case '-':
+ c = iof_next(I);
+ if (base10_digit(c)) // ditto, we would handle type1 '-|' '|-' operators though
+ return ppscan_numobj(I, ppstack_push(stack), 1);
+ else if (c == '.')
+ return ppscan_numobj_frac(I, ppstack_push(stack), 1);
+ obj = ppstack_push(stack);
+ obj->type = PPNAME;
+ obj->name = ppscan_exec(I, stack->heap, '-');
+ return obj;
+ case '/':
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPNAME;
+ obj->name = ppscan_name(I, stack->heap);
+ return obj;
+ case '(':
+ ++I->pos;
+ obj = ppstack_push(stack);
+ obj->type = PPSTRING;
+ obj->string = ppscan_string(I, stack->heap);
+ return obj;
+ case '[':
+ mark = stack->size;
+ obj = ppstack_push(stack);
+ obj->type = PPMARK;
+ obj->any = NULL;
+ ++I->pos;
+ for (c = ppscan_find(I); c != ']'; c = ppscan_find(I))
+ {
+ if (ppscan_psobj(I, stack) == NULL)
+ {
+ size = stack->size - mark;
+ ppstack_pop(stack, size);
+ return NULL;
+ }
+ }
+ ++I->pos;
+ size = stack->size - mark - 1;
+ obj = ppstack_at(stack, mark);
+ obj->type = PPARRAY;
+ obj->array = pparray_create(ppstack_at(stack, mark + 1), size, stack->heap);
+ ppstack_pop(stack, size);
+ return obj;
+ case '<':
+ if ((c = iof_next(I)) == '<')
+ {
+ mark = stack->size;
+ obj = ppstack_push(stack);
+ obj->type = PPMARK;
+ obj->any = NULL;
+ ++I->pos;
+ for (c = ppscan_find(I); c != '>'; c = ppscan_find(I))
+ {
+ if (ppscan_psobj(I, stack) == NULL)
+ {
+ size = stack->size - mark;
+ ppstack_pop(stack, size);
+ return NULL;
+ }
+ }
+ if (iof_next(I) == '>')
+ ++I->pos;
+ size = stack->size - mark - 1;
+ obj = ppstack_at(stack, mark);
+ obj->type = PPDICT;
+ obj->dict = ppdict_create(ppstack_at(stack, mark + 1), size, stack->heap);
+ ppstack_pop(stack, size);
+ return obj;
+ }
+ obj = ppstack_push(stack);
+ obj->type = PPSTRING;
+ if (c == '~')
+ ++I->pos, obj->string = ppscan_base85(I, stack->heap);
+ else
+ obj->string = ppscan_base16(I, stack->heap);
+ return obj;
+ default:
+ if (!ppnamebyte(c))
+ break; // forbid empty names; dead loop otherwise
+ ++I->pos;
+ /* true false null practically don't occur in streams so it makes sense to assume that we get an operator name here.
+ If it happen to be a keyword we could give back those several bytes to the heap but.. heap buffer is tricky enough. */
+ exec = ppscan_exec(I, stack->heap, (uint8_t)c);
+ data = exec->data;
+ obj = ppstack_push(stack);
+ switch (data[0])
+ {
+ case 't':
+ if (data[1] == 'r' && data[2] == 'u' && data[3] == 'e' && data[4] == '\0')
+ {
+ obj->type = PPBOOL;
+ obj->integer = 1;
+ return obj;
+ }
+ break;
+ case 'f':
+ if (data[1] == 'a' && data[2] == 'l' && data[3] == 's' && data[4] == 'e' && data[5] == '\0')
+ {
+ obj->type = PPBOOL;
+ obj->integer = 0;
+ return obj;
+ }
+ break;
+ case 'n':
+ if (data[1] == 'u' && data[2] == 'l' && data[3] == 'l' && data[4] == '\0')
+ {
+ obj->type = PPNULL;
+ obj->any = NULL;
+ return obj;
+ }
+ break;
+ case 'B':
+ /*
+ Inline images break rules of operand/operator syntax, so 'BI/ID' operators need to be treated as special syntactic keywords.
+
+ BI <keyval pairs> ID<whitechar?><imagedata><whitechar?>EI
+
+ We treat the image as a single syntactic token; BI starts collecting a dict, ID is the beginning of the data. Effectively EI
+ operator obtains two operands - dict and string. It is ok to put three items onto the stack, callers dont't assume there is just one.
+ */
+ if (data[1] == 'I' && data[2] == '\0')
+ {
+ ppdict *imagedict;
+ ppname *name;
+ /* key val pairs -> dict */
+ mark = stack->size - 1;
+ obj->type = PPMARK;
+ obj->any = NULL;
+ for (c = ppscan_find(I); ; c = ppscan_find(I))
+ {
+ if ((op = ppscan_psobj(I, stack)) == NULL)
+ {
+ size = stack->size - mark;
+ ppstack_pop(stack, size);
+ return NULL;
+ }
+ if (op->type == PPNAME)
+ {
+ name = op->name;
+ if (name->flags & PPNAME_EXEC)
+ {
+ if (name->size != 2 || name->data[0] != 'I' || name->data[1] != 'D')
+ { // weird
+ size = stack->size - mark;
+ ppstack_pop(stack, size);
+ return NULL;
+ }
+ break;
+ }
+ }
+ }
+ size = stack->size - mark - 1;
+ obj = ppstack_at(stack, mark);
+ obj->type = PPDICT;
+ obj->dict = imagedict = ppdict_create(ppstack_at(stack, mark + 1), size, stack->heap);
+ ppstack_pop(stack, size);
+ /* put image data string */
+ obj = ppstack_push(stack);
+ obj->type = PPSTRING;
+ obj->string = ppstring_inline(I, imagedict, stack->heap);;
+ /* put EI operator name */
+ obj = ppstack_push(stack);
+ obj->type = PPNAME;
+ obj->name = ppexec_internal("EI", 2, stack->heap);
+ return obj;
+ }
+ break;
+ }
+ obj->type = PPNAME;
+ obj->name = exec;
+ return obj;
+ }
+ return NULL;
+}
+
+/*
+We try to get the exact inline image length from its dict params. If cannot predict the length, we have to scan the input until 'EI'.
+I've checked on may examples that it gives the same results but one can never be sure, as 'EI' might happen to be a part of the data.
+Stripping white char is also very heuristic; \0 is a white char in PDF and very likely to be a data byte.. weak method (pdf spec page 352).
+
+Revision 20190327: inline images may be compressed, in which case we can't predict the length.
+*/
+
+static size_t inline_image_length (ppdict *dict)
+{
+ ppuint w, h, bpc, colors;
+ ppname *cs;
+
+ if (ppdict_get_name(dict, "F") == NULL)
+ {
+ if (ppdict_get_uint(dict, "W", &w) && ppdict_get_uint(dict, "H", &h) && ppdict_get_uint(dict, "BPC", &bpc) && (cs = ppdict_get_name(dict, "CS")) != NULL)
+ {
+ if (ppname_is(cs, "DeviceGray"))
+ colors = 1;
+ else if (ppname_is(cs, "DeviceRGB"))
+ colors = 3;
+ else if (ppname_is(cs, "DeviceCMYK"))
+ colors = 4;
+ else
+ return PP_LENGTH_UNKNOWN;
+ return (w * h * bpc * colors + 7) >> 3;
+ }
+ }
+ return PP_LENGTH_UNKNOWN;
+}
+
+static ppstring * ppstring_inline (iof *I, ppdict *imagedict, ppheap *heap)
+{
+ iof *O;
+ int c, d, e;
+ size_t length, leftin, leftout, bytes;
+
+ c = iof_char(I);
+ if (ignored_char(c))
+ c = iof_next(I);
+
+ length = inline_image_length(imagedict);
+ if (length != PP_LENGTH_UNKNOWN)
+ {
+ O = ppbytes_buffer(heap, length);
+ while (length > 0 && iof_readable(I) && iof_writable(O))
+ {
+ leftin = iof_left(I);
+ leftout = iof_left(O);
+ bytes = length;
+ if (bytes > leftin) bytes = leftin;
+ if (bytes > leftout) bytes = leftout;
+ memcpy(O->pos, I->pos, bytes);
+ I->pos += bytes;
+ O->pos += bytes;
+ length -= bytes;
+ }
+ // gobble EI
+ if (ppscan_find(I) == 'E')
+ if (iof_next(I) == 'I')
+ ++I->pos;
+ }
+ else
+ {
+ O = ppbytes_buffer(heap, PPSTRING_INIT); // ?
+ while (c >= 0)
+ {
+ if (c == 'E')
+ {
+ d = iof_next(I);
+ if (d == 'I')
+ {
+ e = iof_next(I);
+ if (!ppnamebyte(e))
+ { /* strip one newline from the end and stop */
+ if (O->pos - 2 >= O->buf) // sanity
+ {
+ c = *(O->pos - 1);
+ if (ignored_char(c))
+ {
+ if (c == 0x0A && *(O->pos - 2) == 0x0D)
+ O->pos -= 2;
+ else
+ O->pos -= 1;
+ }
+ }
+ break;
+ }
+ iof_put2(O, c, d);
+ c = e;
+ }
+ else
+ {
+ iof_put(O, c);
+ c = d;
+ }
+ }
+ else
+ {
+ iof_put(O, c);
+ c = iof_next(I);
+ }
+ }
+ }
+ return ppstring_buffer(O, heap);
+}
+
+/* input reader */
+
+/*
+PDF input is a pseudo file that either keeps FILE * or data. Reader iof * is a proxy to input
+that provides byte-by-byte interface. Our iof structure is capable to link iof_file *input,
+but t avoid redundant checks on IOF_DATA flag, here we link iof *I directly to FILE * or mem buffer.
+When reading from file we need an internal buffer, which should be kept rather small, as it is
+only used to parse xrefs and objects (no streams). We allocate the buffer from a private heap
+(not static) to avoid conflicts when processing >1 pdfs at once. Besides, the input buffer may be
+needed after loading the document, eg. to access references raw data.
+*/
+
+#define PPDOC_BUFFER 0xFFF // keep that small, it is only used to parse body objects
+
+static void ppdoc_reader_init (ppdoc *pdf, iof_file *input)
+{
+ iof *I;
+ pdf->input = *input;
+ input = &pdf->input;
+ input->refcount = 1;
+ I = &pdf->reader;
+ if (input->flags & IOF_DATA)
+ {
+ pdf->buffer = NULL; // input iof_file is the buffer
+ iof_string_reader(I, NULL, 0);
+ }
+ else
+ {
+ pdf->buffer = (uint8_t *)ppbytes_take(&pdf->heap, PPDOC_BUFFER);
+ iof_setup_file_handle_reader(I, NULL, 0, iof_file_get_fh(input)); // gets IOF_FILE_HANDLE flag and FILE *
+ I->space = PPDOC_BUFFER; // used on refill
+ }
+}
+
+/*
+Whenever we need to read the input file, we fseek the to the given offset and fread to the private buffer.
+The length we need is not always predictable, in which case PPDOC_BUFFER bytes are read (keep it small).
+I->buf = I->pos is set to the beginning, I->end set to the end (end is the first byte one shouldn't read).
+*/
+
+static iof * ppdoc_reader (ppdoc *pdf, size_t offset, size_t length)
+{
+ iof_file *input;
+ iof *I;
+ input = &pdf->input;
+ I = &pdf->reader;
+ if (iof_file_seek(input, (long)offset, SEEK_SET) != 0)
+ return NULL;
+ I->flags &= ~IOF_STOPPED;
+ if (input->flags & IOF_DATA)
+ {
+ I->buf = I->pos = input->pos;
+ I->end = (length == PP_LENGTH_UNKNOWN || I->pos + length >= input->end) ? input->end : (I->pos + length);
+ }
+ else
+ {
+ I->buf = I->pos = pdf->buffer; // ->buf is actually permanently equal pdf->buffer but we might need some tricks
+ if (length == PP_LENGTH_UNKNOWN || length > PPDOC_BUFFER)
+ length = PPDOC_BUFFER;
+ length = fread(I->buf, 1, length, I->file);
+ I->end = I->buf + length;
+ }
+ return I;
+}
+
+/* The position from the beginning of input
+- for data buffer: (pdf->input.pos - pdf->input.buf) + (I->pos - I->buf)
+ I->buf == pdf->input.pos, so this resolves to (I->pos - pdf->input.buf), independent from I->buf
+- for file buffer: ftell(pdf->input.file) - (I->end - I->pos)
+*/
+
+#define ppdoc_reader_tell(pdf, I) ((size_t)(((pdf)->input.flags & IOF_DATA) ? ((I)->pos - (pdf)->input.buf) : (ftell(iof_file_get_fh(&(pdf)->input)) - ((I)->end - (I)->pos))))
+
+/* pdf */
+
+#define PPDOC_HEADER 10 // "%PDF-?.??\n"
+
+static int ppdoc_header (ppdoc *pdf, uint8_t header[PPDOC_HEADER])
+{
+ size_t i;
+ if (memcmp(header, "%PDF-", 5) != 0)
+ return 0;
+ for (i = 5; i < PPDOC_HEADER - 1 && !ignored_char(header[i]); ++i)
+ pdf->version[i - 5] = header[i];
+ pdf->version[i - 5] = '\0';
+ return 1;
+}
+
+static int ppdoc_tail (ppdoc *pdf, iof_file *input, size_t *pxrefoffset)
+{
+ int c;
+ uint8_t tail[4*10], *p, back, tailbytes;
+
+ if (iof_file_seek(input, 0, SEEK_END) != 0)
+ return 0;
+ pdf->filesize = (size_t)iof_file_tell(input);
+ // simple heuristic to avoid fgetc() / fseek(-2) hiccup: keep seeking back by len(startxref) + 1 == 10
+ // until a letter found (assuming liberal white characters and tail length)
+ for (back = 1, tailbytes = 0; ; ++back)
+ {
+ if (iof_file_seek(input, -10, SEEK_CUR) != 0)
+ return 0;
+ tailbytes += 10;
+ c = iof_file_getc(input);
+ tailbytes -= 1;
+ switch (c)
+ {
+ case IGNORED_CHAR_CASE:
+ case DIGIT_CHAR_CASE:
+ case '%': case 'E': case 'O': case 'F':
+ if (back > 4) // 2 should be enough
+ return 0;
+ continue;
+ case 's': case 't': case 'a': case 'r': case 'x': case 'e': case 'f':
+ if (iof_file_read(tail, 1, tailbytes, input) != tailbytes)
+ return 0;
+ tail[tailbytes] = '\0';
+ for (p = &tail[0]; ; ++p)
+ {
+ if (*p == '\0')
+ return 0;
+ if ((c = base10_value(*p)) >= 0)
+ break;
+ }
+ ppread_uint(p, pxrefoffset);
+ return 1;
+ default:
+ return 0;
+ }
+ }
+ return 0; // never reached
+}
+
+/* xref/body */
+
+static int ppscan_start_entry (iof *I, ppref *ref)
+{
+ ppuint u;
+ ppscan_find(I); if (!ppscan_uint(I, &u) || u != ref->number) return 0;
+ ppscan_find(I); if (!ppscan_uint(I, &u) || u != ref->version) return 0;
+ ppscan_find(I); if (!ppscan_key(I, "obj")) return 0;
+ ppscan_find(I);
+ return 1;
+}
+
+static int ppscan_skip_entry (iof *I)
+{
+ ppuint u;
+ ppscan_find(I); if (!ppscan_uint(I, &u)) return 0;
+ ppscan_find(I); if (!ppscan_uint(I, &u)) return 0;
+ ppscan_find(I); if (!ppscan_key(I, "obj")) return 0;
+ ppscan_find(I);
+ return 1;
+}
+
+static int ppscan_start_stream (iof *I, ppdoc *pdf, size_t *streamoffset)
+{
+ int c;
+ ppscan_find(I);
+ if (ppscan_key(I, "stream"))
+ { // PJ20180912 bugfix: we were gobbling white characters (also null byte), while "stream" may be followed by EOL
+ // pdf spec page 60: "CARRIAGE RETURN and a LINE FEED or just a LINE FEED, and not by a CARRIAGE RETURN alone"
+ c = iof_char(I);
+ if (c == 0x0D)
+ {
+ if (iof_next(I) == 0x0A) // should be
+ ++I->pos;
+ }
+ else if (c == 0x0A)
+ {
+ ++I->pos;
+ }
+ *streamoffset = ppdoc_reader_tell(pdf, I);
+ return 1;
+ }
+ return 0;
+}
+
+static ppxref * ppxref_load (ppdoc *pdf, size_t xrefoffset);
+static ppxref * ppxref_load_chain (ppdoc *pdf, ppxref *xref);
+
+/* Parsing xref table
+
+ 1 10 // first ref number and refs count
+ 0000000000 00000 n // 10-digits offset, 5 digits version, type identifier
+ 0000000000 00000 n // n states for normal I guess
+ 0000000000 00000 f // f states for free (not used)
+ ...
+
+Free entries seem to be a relic of ancient times, completelly useless for us. To avoid parsing xref table twice,
+we waste some space on free entries by allocating one plane of refs for each section. Later on we slice sections,
+so that effectively free entries are not involved in map.
+
+Subsequent refs gets number, version and offset. Other fields initialized when parsing PDF body.
+
+Having xref table loaded, we sort sections for future binary search (xref with objects count == 0 is considered invalid).
+
+Then we have to deal with the trailer dict. In general, to load objects and resolve references we need a complete chain
+of xrefs (not only the top). To load the previous xref, we need its offset, which is given in trailer. So we have to
+parse the trailer ignoring references, which might be unresolvable at this point (objects parser makes a dummy check
+for xref != NULL on refs resolving ppscan_obj(), which irritates me but I don't want a separate parser for trailer..).
+The same applies to xref streams, in which we have parse the trailer not having xref map at all. So the procedure is:
+
+ - load xref map, initialize references, make it ready to search
+ - parse trailer ignoring references
+ - get /Prev xref offset and load older xref (linked list via ->prev)
+ - sort all refs in all xrefs by offset
+ - parse refs in order resolving references in contained objects
+ - fix trailer references
+
+First created xref becomes a pdf->xref (top xref). We link that early to control offsets already read (insane loops?).
+*/
+
+// Every xref table item "0000000000 00000 n" is said to be terminated with 2-byte EOL but we don't like relying on whites.
+#define xref_item_length (10 + 1 + 5 + 1 + 1)
+
+static ppxref * ppxref_load_table (iof *I, ppdoc *pdf, size_t xrefoffset)
+{
+ ppxref *xref;
+ ppxsec *xrefsection;
+ ppref *ref;
+ ppuint first, count, refindex;
+ uint8_t buffer[xref_item_length + 1];
+ const char *p;
+ const ppobj *obj;
+
+ buffer[xref_item_length] = '\0';
+ xref = ppxref_create(pdf, 0, xrefoffset);
+ if (pdf->xref == NULL) pdf->xref = xref;
+
+ for (ppscan_find(I); ppscan_uint(I, &first); ppscan_find(I))
+ {
+ ppscan_find(I);
+ if (!ppscan_uint(I, &count))
+ return NULL;
+ if (count == 0) // weird
+ continue;
+ xref->count += count;
+ xrefsection = NULL;
+ ref = (ppref *)ppstruct_take(&pdf->heap, count * sizeof(ppref));
+ for (refindex = 0; refindex < count; ++refindex, ++ref)
+ {
+ ref->xref = xref;
+ ref->number = first + refindex;
+ ppscan_find(I);
+ iof_read(I, buffer, xref_item_length);
+ switch (buffer[xref_item_length - 1])
+ {
+ case 'n':
+ if (xrefsection == NULL)
+ {
+ xrefsection = ppxref_push_section(xref, &pdf->heap);
+ xrefsection->first = ref->number;
+ xrefsection->refs = ref;
+ }
+ xrefsection->last = ref->number;
+ for (p = (const char *)buffer; *p == '0'; ++p);
+ p = ppread_uint(p, &ref->offset);
+ for ( ; *p == ' ' || *p == '0'; ++p);
+ p = ppread_uint(p, &ref->version);
+ ref->object.type = PPNONE; // init for sanity
+ ref->object.any = NULL;
+ ref->length = 0;
+ break;
+ case 'f':
+ default:
+ --ref;
+ xrefsection = NULL;
+ --xref->count;
+ }
+ }
+ }
+ /* sort section */
+ ppxref_sort(xref); // case of xref->size == 0 handled by ppxref_load_chain()
+ /* get trailer ignoring refs */
+ if (!ppscan_key(I, "trailer"))
+ return NULL;
+ ppscan_find(I);
+ if ((obj = ppscan_obj(I, pdf, NULL)) == NULL)
+ return NULL;
+ ppstack_pop(&pdf->stack, 1);
+ if (obj->type != PPDICT)
+ return NULL;
+ xref->trailer = *obj;
+ return ppxref_load_chain(pdf, xref);
+}
+
+/* Parsing xref stream
+First we load the trailer, ignoring references. Dict defines sections and fields lengths:
+
+ /Size % max ref number plus 1
+ /Index [ first count first count ... ] % a pair of numbers for every section, defaults to [0 Size]
+ /W [w1 w2 w3] % fields lengths, 0 states for omitted field
+
+xref stream data is a continuous stream of binary number triplets. First number is a type:
+
+ 0 - free entry (as 'f' in xref table)
+ 1 - normal entry, followed by offset an version (as 'n' in xref table)
+ 2 - compressed entry, followed by parent object stream number and entry index
+
+0 and 1 are handled as 'n' and 'f' entries in xref table. For type 2 we normally initialize
+ref->number and ref->version (the later is implicitly 0). ref->offset is set to 0 (invalid offset),
+which is recognized by objects loader.
+*/
+
+#define XREF_STREAM_MAX_FIELD 4
+
+static ppxref * ppxref_load_stream (iof *I, ppdoc *pdf, size_t xrefoffset)
+{
+ ppxref *xref;
+ ppxsec *xrefsection;
+ ppref *ref;
+ ppobj *obj;
+ ppstream *xrefstream;
+ size_t streamoffset;
+ ppuint w1, w2, w3, w, bufferbytes;
+ uint8_t buffer[3 * XREF_STREAM_MAX_FIELD], *b;
+ ppuint first, count, f1, f2, f3;
+ pparray *fieldwidths, *sectionindices;
+ ppobj sectionmock[2], *sectionfirst, *sectioncount;
+ size_t sections, sectionindex, refindex;
+
+ if (!ppscan_skip_entry(I))
+ return NULL;
+ if ((obj = ppscan_obj(I, pdf, NULL)) == NULL)
+ return NULL;
+ ppstack_pop(&pdf->stack, 1);
+ if (obj->type != PPDICT || !ppscan_start_stream(I, pdf, &streamoffset))
+ return NULL;
+ xrefstream = ppstream_create(pdf, obj->dict, streamoffset);
+ ppstream_info(xrefstream, pdf);
+ if ((fieldwidths = ppdict_get_array(xrefstream->dict, "W")) != NULL)
+ {
+ if (!pparray_get_uint(fieldwidths, 0, &w1)) w1 = 0;
+ if (!pparray_get_uint(fieldwidths, 1, &w2)) w2 = 0;
+ if (!pparray_get_uint(fieldwidths, 2, &w3)) w3 = 0;
+ }
+ else
+ w1 = w2 = w3 = 0;
+ if (w1 > XREF_STREAM_MAX_FIELD || w2 > XREF_STREAM_MAX_FIELD || w3 > XREF_STREAM_MAX_FIELD)
+ return NULL;
+ bufferbytes = w1 + w2 + w3;
+ if ((sectionindices = ppdict_get_array(xrefstream->dict, "Index")) != NULL)
+ {
+ sections = sectionindices->size >> 1;
+ sectionfirst = sectionindices->data;
+ }
+ else
+ {
+ sections = 1;
+ sectionmock[0].type = PPINT;
+ sectionmock[0].integer = 0;
+ sectionmock[1].type = PPINT;
+ if (!ppdict_get_int(xrefstream->dict, "Size", &sectionmock[1].integer))
+ sectionmock[1].integer = 0;
+ sectionfirst = &sectionmock[0];
+ }
+ if ((I = ppstream_read(xrefstream, 1, 0)) == NULL)
+ return NULL; // we fseek() so original I is useless anyway
+ xref = ppxref_create(pdf, sections, xrefoffset);
+ if (pdf->xref == NULL) pdf->xref = xref;
+ xref->trailer.type = PPSTREAM;
+ xref->trailer.stream = xrefstream;
+ for (sectionindex = 0; sectionindex < sections; ++sectionindex, sectionfirst += 2)
+ {
+ sectioncount = sectionfirst + 1;
+ first = 0, count = 0; // warnings
+ if (!ppobj_get_uint(sectionfirst, first) || !ppobj_get_uint(sectioncount, count))
+ goto xref_stream_error;
+ if (count == 0)
+ continue;
+ xref->count += count;
+ xrefsection = NULL;
+ ref = (ppref *)ppstruct_take(&pdf->heap, count * sizeof(ppref));
+ for (refindex = 0; refindex < count; ++refindex, ++ref)
+ {
+ ref->xref = xref;
+ ref->number = first + refindex;
+ if (iof_read(I, buffer, bufferbytes) != bufferbytes)
+ goto xref_stream_error;
+ b = buffer;
+ if (w1 == 0)
+ f1 = 1; // default type is 1
+ else
+ for (f1 = 0, w = 0; w < w1; f1 = (f1 << 8)|(*b), ++w, ++b);
+ for (f2 = 0, w = 0; w < w2; f2 = (f2 << 8)|(*b), ++w, ++b);
+ for (f3 = 0, w = 0; w < w3; f3 = (f3 << 8)|(*b), ++w, ++b);
+ switch (f1)
+ {
+ case 0:
+ //--ref;
+ xrefsection = NULL;
+ --xref->count;
+ break;
+ case 1:
+ if (xrefsection == NULL)
+ {
+ xrefsection = ppxref_push_section(xref, &pdf->heap);
+ xrefsection->first = ref->number;
+ xrefsection->refs = ref;
+ }
+ xrefsection->last = ref->number;
+ ref->offset = f2;
+ ref->version = f3;
+ ref->object.type = PPNONE;
+ ref->object.any = NULL;
+ ref->length = 0;
+ break;
+ case 2:
+ if (xrefsection == NULL)
+ {
+ xrefsection = ppxref_push_section(xref, &pdf->heap);
+ xrefsection->first = ref->number;
+ xrefsection->refs = ref;
+ }
+ xrefsection->last = ref->number;
+ ref->offset = 0; // f2 is parent objstm, f3 is index in parent, both useless
+ ref->version = 0; // compressed objects has implicit version == 0
+ ref->object.type = PPNONE;
+ ref->object.any = NULL;
+ ref->length = 0;
+ break;
+ default:
+ goto xref_stream_error;
+ }
+ }
+ }
+ /* sort sections */
+ ppxref_sort(xref); // case of xref->size == 0 handled by ppxref_load_chain()
+ /* close the stream _before_ loading prev xref */
+ ppstream_done(xrefstream);
+ /* load prev and return */
+ return ppxref_load_chain(pdf, xref);
+xref_stream_error:
+ ppstream_done(xrefstream);
+ return NULL;
+}
+
+/*
+The following procedure loads xref /Prev, links xref->prev and typically returns xref.
+Some docs contain empty xref (one section with zero objects) that is actually a proxy
+to xref stream referred as /XRefStm (genuine concept of xrefs old/new style xrefs in
+the same doc). In case of 0-length xref we ignore the proxy and return the target xref
+(otherwise we would need annoying sanity check for xref->size > 0 on every ref search).
+*/
+
+static ppxref * ppxref_load_chain (ppdoc *pdf, ppxref *xref)
+{
+ ppdict *trailer;
+ ppuint xrefoffset;
+ ppxref *prevxref, *nextxref;
+
+ trailer = ppxref_trailer(xref);
+ if (!ppdict_get_uint(trailer, "Prev", &xrefoffset)) // XRefStm is useless
+ return xref;
+ for (nextxref = pdf->xref; nextxref != NULL; nextxref = nextxref->prev)
+ if (nextxref->offset == xrefoffset) // insane
+ return NULL;
+ if ((prevxref = ppxref_load(pdf, (size_t)xrefoffset)) == NULL)
+ return NULL;
+ if (xref->size > 0)
+ {
+ xref->prev = prevxref;
+ return xref;
+ }
+ if (pdf->xref == xref)
+ pdf->xref = prevxref;
+ return prevxref;
+}
+
+static ppxref * ppxref_load (ppdoc *pdf, size_t xrefoffset)
+{
+ iof *I;
+
+ if ((I = ppdoc_reader(pdf, xrefoffset, PP_LENGTH_UNKNOWN)) == NULL)
+ return NULL;
+ ppscan_find(I);
+ if (ppscan_key(I, "xref"))
+ return ppxref_load_table(I, pdf, xrefoffset);
+ return ppxref_load_stream(I, pdf, xrefoffset);
+ // iof_close(I) does nothing here
+}
+
+static void ppoffmap_sort (ppref **left, ppref **right)
+{
+ ppref **l, **r, *t;
+ ppuint pivot;
+ l = left, r = right;
+ pivot = (*(l + ((r - l) / 2)))->offset;
+ do
+ { // don't read from pointer!
+ while ((*l)->offset < pivot) ++l;
+ while ((*r)->offset > pivot) --r;
+ if (l <= r)
+ {
+ t = *l;
+ *l = *r;
+ *r = t;
+ ++l, --r;
+ }
+ } while (l <= r);
+ if (left < r)
+ ppoffmap_sort(left, r);
+ if (l < right)
+ ppoffmap_sort(l, right);
+}
+
+
+static void fix_trailer_references (ppdoc *pdf)
+{
+ ppxref *xref;
+ ppdict *trailer;
+ ppname **pkey;
+ ppobj *obj;
+ ppref *ref;
+ for (xref = pdf->xref; xref != NULL; xref = xref->prev)
+ {
+ if ((trailer = ppxref_trailer(xref)) == NULL)
+ continue;
+ for (ppdict_first(trailer, pkey, obj); *pkey != NULL; ppdict_next(pkey, obj))
+ { // no need to go deeper in structs, all items in trailer except info and root must be direct refs
+ if (obj->type != PPREF)
+ continue;
+ ref = obj->ref;
+ if (ref->offset == 0) // unresolved?
+ if ((ref = ppxref_find(xref, ref->number)) != NULL)
+ obj->ref = ref; // at this moment the reference still points nothing, but should be the one with the proper offset
+ }
+ }
+}
+
+/*
+Here comes a procedure that loads all entries from all document bodies. We resolve references while
+parsing objects and to make resolving correct, we need a complete chain of xref maps, and a knowledge
+about possible linearized dict (first offset). So loading refs sorted by offsets makes sense (not sure
+if it matters nowadays but we also avoid fseek() by large offsets).
+
+Here is the proc:
+
+ - create a list of all refs in all bodies
+ - sort the list by offsets
+ - for every ref from the sorted list:
+ - estimate object length to avoid fread-ing more than necessary (not perfect but enough)
+ - fseek() to the proper offset, fread() entry data or its part
+ - parse the object with ppscan_obj(I, pdf, xref), where xref is not necessarily top pdf->xref
+ (since v0.98 xref actually no longer matters, see xref_find() notes)
+ - save the actual ref->length (not used so far, but we keep that so..)
+ - make a stream if a dict is followed by "stream" keyword, also save the stream offset
+ - free the list
+
+PJ2080916: Luigi and Hans fixeed a bug (rev 6491); a document having a stream with /Length being
+a reference, that was stored in /ObjStm, and therefore not yet resolved when caching /Length key
+value as stream->offset (ppstream_info()). At the end, references were resolved propertly, but
+the stream was no readable; stream->offset == 0. In rev6491 ObjStm streams are loaded before
+others streams.
+*/
+
+static int ppdoc_load_objstm (ppstream *stream, ppdoc *pdf, ppxref *xref);
+
+#define ppref_is_objstm(ref, stream, type) \
+ ((ref)->xref->trailer.type == PPSTREAM && (type = ppdict_get_name((stream)->dict, "Type")) != NULL && ppname_is(type, "ObjStm"))
+
+
+static void ppdoc_load_entries (ppdoc *pdf)
+{
+ size_t objects, sectionindex, refnumber, offindex;
+ size_t streams = 0, object_streams = 0, redundant_indirections = 0;
+ ppnum linearized;
+ ppref **offmap, **pref, *ref;
+ ppxref *xref;
+ ppxsec *xsec;
+ ppobj *obj;
+ ppname *type;
+ ppcrypt *crypt;
+ ppstream *stream;
+
+ if ((objects = (size_t)ppdoc_objects(pdf)) == 0) // can't happen
+ return;
+ pref = offmap = (ppref **)pp_malloc(objects * sizeof(ppref *));
+ objects = 0; // recount refs with offset > 0
+ for (xref = pdf->xref; xref != NULL; xref = xref->prev)
+ for (sectionindex = 0, xsec = xref->sects; sectionindex < xref->size; ++sectionindex, ++xsec)
+ for (refnumber = xsec->first, ref = xsec->refs; refnumber <= xsec->last; ++refnumber, ++ref)
+ if (ref->offset > 0) // 0 means compressed or insane
+ *pref++ = ref, ++objects;
+ ppoffmap_sort(offmap, offmap + objects - 1);
+
+ crypt = pdf->crypt;
+ for (offindex = 0, pref = offmap; offindex < objects; )
+ {
+ ref = *pref;
+ ++pref;
+ ++offindex;
+ if (ref->object.type != PPNONE) // might be preloaded already (/Encrypt dict, stream filter dicts, stream /Length..)
+ continue;
+ if (offindex < objects)
+ ref->length = (*pref)->offset - ref->offset;
+ else
+ ref->length = pdf->filesize > ref->offset ? pdf->filesize - ref->offset : 0;
+ if (crypt != NULL)
+ {
+ ppcrypt_start_ref(crypt, ref);
+ obj = ppdoc_load_entry(pdf, ref);
+ ppcrypt_end_ref(crypt);
+ }
+ else
+ {
+ obj = ppdoc_load_entry(pdf, ref);
+ }
+ switch (obj->type)
+ {
+ case PPDICT: /* Check if the object at first offset is linearized dict. We need that to resolve all references properly. */
+ if (offindex == 1 && ppdict_get_num(obj->dict, "Linearized", &linearized)) // /Linearized value is a version number, default 1.0
+ pdf->flags |= PPDOC_LINEARIZED;
+ break;
+ case PPSTREAM:
+ ++streams;
+ if (ppref_is_objstm(ref, obj->stream, type))
+ ++object_streams;
+ break;
+ case PPREF:
+ ++redundant_indirections;
+ break;
+ default:
+ break;
+ }
+ }
+
+ /* cut references pointing to references (rare). doing for all effectively cuts all insane chains */
+ for (pref = offmap; redundant_indirections > 0; )
+ {
+ ref = *pref++;
+ if (ref->object.type == PPREF)
+ {
+ --redundant_indirections;
+ ref->object = ref->object.ref->object;
+ }
+ }
+
+ /* load pdf 1.5 object streams _before_ other streams */
+ for (pref = offmap; object_streams > 0; )
+ {
+ ref = *pref++;
+ obj = &ref->object;
+ if (obj->type != PPSTREAM)
+ continue;
+ stream = obj->stream;
+ if (ppref_is_objstm(ref, stream, type))
+ {
+ --object_streams;
+ if (crypt != NULL)
+ {
+ ppcrypt_start_ref(crypt, ref);
+ ppstream_info(stream, pdf);
+ ppcrypt_end_ref(crypt);
+ }
+ else
+ {
+ ppstream_info(stream, pdf);
+ }
+ if (!ppdoc_load_objstm(stream, pdf, ref->xref))
+ loggerf("invalid objects stream %s at offset " PPSIZEF, ppref_str(ref->number, ref->version), ref->offset);
+
+ }
+ }
+
+ /* now handle other streams */
+ for (pref = offmap; streams > 0; )
+ {
+ ref = *pref++;
+ obj = &ref->object;
+ if (obj->type != PPSTREAM)
+ continue;
+ --streams;
+ stream = obj->stream;
+ if (crypt != NULL)
+ {
+ ppcrypt_start_ref(crypt, ref);
+ ppstream_info(stream, pdf);
+ ppcrypt_end_ref(crypt);
+ }
+ else
+ {
+ ppstream_info(stream, pdf);
+ }
+ }
+ pp_free(offmap);
+}
+
+ppobj * ppdoc_load_entry (ppdoc *pdf, ppref *ref)
+{
+ iof *I;
+ size_t length;
+ ppxref *xref;
+ ppobj *obj;
+ ppstack *stack;
+ size_t streamoffset;
+ ppref *refref;
+ ppuint refnumber, refversion;
+
+ length = ref->length > 0 ? ref->length : PP_LENGTH_UNKNOWN; // estimated or unknown
+ if ((I = ppdoc_reader(pdf, ref->offset, length)) == NULL || !ppscan_start_entry(I, ref))
+ {
+ loggerf("invalid %s offset " PPSIZEF, ppref_str(ref->number, ref->version), ref->offset);
+ return &ref->object; // PPNONE
+ }
+ stack = &pdf->stack;
+ xref = ref->xref;
+ if ((obj = ppscan_obj(I, pdf, xref)) == NULL)
+ {
+ loggerf("invalid %s object at offset " PPSIZEF, ppref_str(ref->number, ref->version), ref->offset);
+ return &ref->object; // PPNONE
+ }
+ ref->object = *obj;
+ ppstack_pop(stack, 1);
+ obj = &ref->object;
+ ref->length = ppdoc_reader_tell(pdf, I) - ref->offset;
+ if (obj->type == PPDICT)
+ {
+ if (ppscan_start_stream(I, pdf, &streamoffset))
+ {
+ obj->type = PPSTREAM;
+ obj->stream = ppstream_create(pdf, obj->dict, streamoffset);
+ }
+ }
+ else if (obj->type == PPINT)
+ {
+ ppscan_find(I);
+ if (ppscan_uint(I, &refversion) && ppscan_find(I) == 'R')
+ {
+ refnumber = (ppuint)obj->integer;
+ if ((refref = ppxref_find(xref, refnumber)) != NULL)
+ {
+ obj->type = PPREF;
+ obj->ref = refref;
+ }
+ else
+ {
+ obj->type = PPNONE; // as ppref_unresolved()
+ obj->any = NULL;
+ }
+ }
+ }
+ return obj;
+}
+
+/* Loading entries from object stream
+
+ /N is the number of contained entries
+ /First is the offset of the first item
+
+The stream consists of N pairs of numbers <objnum> <offset> <objnum> <offset> ...
+Offsets are ascending (relative to the first), but ref numbers order is arbitrary.
+PDF spec says there might be some additional data between objects, so we should obey offsets.
+Which means we should basically load the stream at once (may be needed anyway to grab the stream [...]).
+*/
+
+static int ppdoc_load_objstm (ppstream *stream, ppdoc *pdf, ppxref *xref)
+{
+ ppdict *dict; // stream dict, actually still on stack
+ ppref *ref;
+ ppobj *obj;
+ ppuint items, firstoffset, offset, objnum, i, invalid = 0;
+ iof *I;
+ uint8_t *firstdata, *indexdata;
+ ppstack *stack;
+
+ dict = stream->dict;
+ if (!ppdict_rget_uint(dict, "N", &items) || !ppdict_rget_uint(dict, "First", &firstoffset))
+ return 0;
+ if ((I = ppstream_read(stream, 1, 1)) == NULL)
+ return 0;
+ firstdata = I->pos + firstoffset;
+ if (firstdata >= I->end)
+ goto invalid_objstm;
+ stack = &pdf->stack;
+ //if (pdf->crypt != NULL)
+ // ppcrypt_end_ref(pdf->crypt); // objects are not encrypted, pdf->crypt->ref ensured NULL
+ for (i = 0; i < items; ++i)
+ {
+ ppscan_find(I);
+ if (!ppscan_uint(I, &objnum))
+ goto invalid_objstm;
+ ppscan_find(I);
+ if (!ppscan_uint(I, &offset))
+ goto invalid_objstm;
+ if ((ref = ppxref_find_local(xref, objnum)) == NULL || ref->object.type != PPNONE)
+ {
+ loggerf("invalid compressed object number " PPUINTF " at position " PPUINTF, objnum, i);
+ ++invalid;
+ continue;
+ }
+ if (firstdata + offset >= I->end)
+ {
+ loggerf("invalid compressed object offset " PPUINTF " at position " PPUINTF, offset, i);
+ ++invalid;
+ continue;
+ }
+ indexdata = I->pos; // save position
+ I->pos = firstdata + offset; // go to the object
+ ppscan_find(I);
+ if ((obj = ppscan_obj(I, pdf, xref)) != NULL)
+ {
+ ref->object = *obj;
+ ppstack_pop(stack, 1);
+ // nothing more needed, as obj can never be indirect ref or stream
+ }
+ else
+ {
+ ++invalid;
+ loggerf("invalid compressed object %s at stream offset " PPUINTF, ppref_str(objnum, 0), offset);
+ }
+ I->pos = indexdata; // restore position and read next from index
+ }
+ ppstream_done(stream);
+ return invalid == 0;
+invalid_objstm:
+ ppstream_done(stream);
+ return 0;
+}
+
+/* main PDF loader proc */
+
+ppcrypt_status ppdoc_crypt_pass (ppdoc *pdf, const void *userpass, size_t userpasslength, const void *ownerpass, size_t ownerpasslength)
+{
+ switch (pdf->cryptstatus)
+ {
+ case PPCRYPT_NONE:
+ case PPCRYPT_DONE:
+ case PPCRYPT_FAIL:
+ break;
+ case PPCRYPT_PASS: // initial status or really needs password
+ pdf->cryptstatus = ppdoc_crypt_init(pdf, userpass, userpasslength, ownerpass, ownerpasslength);
+ switch (pdf->cryptstatus)
+ {
+ case PPCRYPT_NONE:
+ case PPCRYPT_DONE:
+ ppdoc_load_entries(pdf);
+ break;
+ case PPCRYPT_PASS: // user needs to check ppdoc_crypt_status() and recall ppdoc_crypt_pass() with the proper password
+ case PPCRYPT_FAIL: // hopeless..
+ break;
+ }
+ break;
+ }
+ return pdf->cryptstatus;
+}
+
+static ppdoc * ppdoc_read (ppdoc *pdf, iof_file *input)
+{
+ uint8_t header[PPDOC_HEADER];
+ size_t xrefoffset;
+
+ input = &pdf->input;
+ if (iof_file_read(header, 1, PPDOC_HEADER, input) != PPDOC_HEADER || !ppdoc_header(pdf, header))
+ return NULL;
+ if (!ppdoc_tail(pdf, input, &xrefoffset))
+ return NULL;
+ if (ppxref_load(pdf, xrefoffset) == NULL)
+ return NULL;
+ fix_trailer_references(pdf); // after loading xrefs but before accessing trailer refs (/Encrypt might be a reference)
+ // check encryption, if any, try empty password
+ switch (ppdoc_crypt_pass(pdf, "", 0, NULL, 0))
+ {
+ case PPCRYPT_NONE: // no encryption
+ case PPCRYPT_DONE: // encryption with an empty password
+ case PPCRYPT_PASS: // the user needs to check ppdoc_crypt_status() and call ppdoc_crypt_pass()
+ break;
+ case PPCRYPT_FAIL: // hopeless
+ //loggerf("decryption failed");
+ //return NULL;
+ break;
+ }
+ return pdf;
+}
+
+static void ppdoc_pages_init (ppdoc *pdf);
+
+/*
+20191214: We used to allocate ppdoc, as all other structs, from the internal heap:
+
+ ppheap heap;
+ ppheap_init(&heap);
+ pdf = (ppdoc *)ppstruct_take(&heap, sizeof(ppdoc));
+ pdf->heap = heap;
+ ppbytes_buffer_init(&pdf->heap);
+ ...
+
+So ppdoc pdf was allocated from the heap owned by the pdf itself. Somewhat tricky, but should work fine,
+as from that point nothing refered to a local heap variable addres. For some reason that causes a crash
+on openbsd.
+*/
+
+static ppdoc * ppdoc_create (iof_file *input)
+{
+ ppdoc *pdf;
+
+ pdf = (ppdoc *)pp_malloc(sizeof(ppdoc));
+ ppheap_init(&pdf->heap);
+ ppbytes_buffer_init(&pdf->heap);
+ ppstack_init(&pdf->stack, &pdf->heap);
+ ppdoc_reader_init(pdf, input);
+ ppdoc_pages_init(pdf);
+ pdf->xref = NULL;
+ pdf->crypt = NULL;
+ pdf->cryptstatus = PPCRYPT_PASS; // check on ppdoc_read() -> ppdoc_crypt_pass()
+ pdf->flags = 0;
+ pdf->version[0] = '\0';
+ if (ppdoc_read(pdf, &pdf->input) != NULL)
+ return pdf;
+ ppdoc_free(pdf);
+ return NULL;
+}
+
+ppdoc * ppdoc_load (const char *filename)
+{
+ FILE *file;
+ iof_file input;
+ if ((file = fopen(filename, "rb")) == NULL)
+ return NULL;
+ iof_file_init(&input, file);
+ input.flags |= IOF_CLOSE_FILE;
+ return ppdoc_create(&input);
+}
+
+ppdoc * ppdoc_filehandle (FILE *file, int closefile)
+{
+ iof_file input;
+ if (file == NULL)
+ return NULL;
+ iof_file_init(&input, file);
+ if (closefile)
+ input.flags |= IOF_CLOSE_FILE;
+ return ppdoc_create(&input);
+}
+
+ppdoc * ppdoc_mem (const void *data, size_t size)
+{
+ iof_file input;
+ iof_file_rdata_init(&input, data, size);
+ input.flags |= IOF_BUFFER_ALLOC;
+ return ppdoc_create(&input);
+}
+
+void ppdoc_free (ppdoc *pdf)
+{
+ iof_file_decref(&pdf->input);
+ ppstack_free_buffer(&pdf->stack);
+ ppheap_free(&pdf->heap);
+ pp_free(pdf);
+}
+
+ppcrypt_status ppdoc_crypt_status (ppdoc *pdf)
+{
+ return pdf->cryptstatus;
+}
+
+ppint ppdoc_permissions (ppdoc *pdf)
+{
+ return pdf->crypt != NULL ? pdf->crypt->permissions : (ppint)0xFFFFFFFFFFFFFFFF;
+}
+
+/* pages access */
+
+static pparray * pppage_node (ppdict *dict, ppuint *count, ppname **type)
+{
+ ppname **pkey, *key;
+ ppobj *obj;
+ pparray *kids = NULL;
+ *count = 0;
+ *type = NULL;
+ for (ppdict_first(dict, pkey, obj); (key = *pkey) != NULL; ppdict_next(pkey, obj))
+ {
+ switch (key->data[0])
+ {
+ case 'T':
+ if (ppname_is(key, "Type"))
+ *type = ppobj_get_name(obj);
+ break;
+ case 'C':
+ if (ppname_is(key, "Count"))
+ ppobj_rget_uint(obj, *count);
+ break;
+ case 'K':
+ if (ppname_is(key, "Kids"))
+ kids = ppobj_rget_array(obj);
+ break;
+ }
+ }
+ return kids;
+}
+
+#define ppname_is_page(type) (type != NULL && ppname_is(type, "Page"))
+
+ppuint ppdoc_page_count (ppdoc *pdf)
+{
+ ppref *ref;
+ ppname *type;
+ ppuint count;
+ if ((ref = ppxref_pages(pdf->xref)) == NULL)
+ return 0;
+ if (pppage_node(ref->object.dict, &count, &type) == NULL)
+ return ppname_is_page(type) ? 1 : 0; // acrobat and ghostscript accept documents with root /Pages entry being a reference to a sole /Page object
+ return count;
+}
+
+ppref * ppdoc_page (ppdoc *pdf, ppuint index)
+{
+ ppdict *dict;
+ ppuint count;
+ pparray *kids;
+ size_t size, i;
+ ppobj *r, *o;
+ ppref *ref;
+ ppname *type;
+
+ if ((ref = ppxref_pages(pdf->xref)) == NULL)
+ return NULL;
+ dict = ref->object.dict;
+ if ((kids = pppage_node(dict, &count, &type)) != NULL)
+ {
+ if (index < 1 || index > count)
+ return NULL;
+ }
+ else
+ {
+ return index == 1 && ppname_is_page(type) ? ref : NULL;
+ }
+scan_array:
+ if (index <= count / 2)
+ { // probably shorter way from the beginning
+ for (i = 0, size = kids->size, r = pparray_at(kids, 0); i < size; ++i, ++r)
+ {
+ if (r->type != PPREF)
+ return NULL;
+ o = &r->ref->object;
+ if (o->type != PPDICT)
+ return NULL;
+ dict = o->dict;
+ if ((kids = pppage_node(dict, &count, &type)) != NULL)
+ {
+ if (index <= count)
+ goto scan_array;
+ index -= count;
+ continue;
+ }
+ if (index == 1 && ppname_is_page(type))
+ return r->ref;
+ --index;
+ }
+ }
+ else if ((size = kids->size) > 0) // for safe (size-1)
+ { // probably shorter way from the end
+ index = count - index + 1;
+ for (i = 0, r = pparray_at(kids, size - 1); i < size; ++i, --r)
+ {
+ if (r->type != PPREF)
+ return NULL;
+ o = &r->ref->object;
+ if (o->type != PPDICT)
+ return NULL;
+ dict = o->dict;
+ if ((kids = pppage_node(dict, &count, &type)) != NULL)
+ {
+ if (index <= count) {
+ index = count - index + 1;
+ goto scan_array;
+ }
+ index -= count;
+ continue;
+ }
+ if (index == 1 && ppname_is_page(type))
+ return r->ref;
+ --index;
+ }
+ }
+ return NULL;
+}
+
+/*
+Through pages iterator. Iterating over pages tree just on the base of /Kids and /Parent keys
+is ineffective, as to get next pageref we need to take parent, find the pageref in /Kids,
+take next (or go upper).. Annoying. We use a dedicated stack for pages iterator. This could
+actually be done with pdf->stack, but some operations may clear it, so safer to keep it independent
+Besides, its depth is constant (set on first use), so no need for allocs.
+*/
+
+static void ppdoc_pages_init (ppdoc *pdf)
+{
+ pppages *pages;
+ pages = &pdf->pages;
+ pages->root = pages->parent = &pages->buffer[0];
+ pages->depth = 0;
+ pages->space = PPPAGES_STACK_DEPTH;
+}
+
+static ppkids * pppages_push (ppdoc *pdf, pparray *kids)
+{
+ ppkids *newroot, *bounds;
+ pppages *pages;
+ pages = &pdf->pages;
+ if (pages->depth == pages->space)
+ {
+ pages->space <<= 1;
+ newroot = (ppkids *)ppstruct_take(&pdf->heap, pages->space * sizeof(ppkids));
+ memcpy(newroot, pages->root, pages->depth * sizeof(ppkids));
+ pages->root = newroot;
+ }
+ bounds = pages->parent = &pages->root[pages->depth++];
+ bounds->current = pparray_at(kids, 0);
+ bounds->sentinel = pparray_at(kids, kids->size);
+ return bounds;
+}
+
+#define pppages_pop(pages) (--((pages)->parent), --((pages)->depth))
+
+static ppref * ppdoc_pages_group_first (ppdoc *pdf, ppref *ref)
+{
+ ppdict *dict;
+ pparray *kids;
+ ppuint count;
+ ppname *type;
+ ppobj *o;
+
+ dict = ref->object.dict; // typecheck made by callers
+ while ((kids = pppage_node(dict, &count, &type)) != NULL)
+ {
+ if ((o = pparray_get_obj(kids, 0)) == NULL) // empty /Kids
+ return ppdoc_next_page(pdf);
+ if ((ref = ppobj_get_ref(o)) == NULL || ref->object.type != PPDICT)
+ return NULL;
+ pppages_push(pdf, kids);
+ dict = ref->object.dict;
+ }
+ return ppname_is_page(type) ? ref : NULL;
+}
+
+ppref * ppdoc_first_page (ppdoc *pdf)
+{
+ ppref *ref;
+ pppages *pages;
+ if ((ref = ppdoc_pages(pdf)) == NULL)
+ return NULL;
+ pages = &pdf->pages;
+ pages->parent = pages->root;
+ pages->depth = 0;
+ return ppdoc_pages_group_first(pdf, ref);
+}
+
+ppref * ppdoc_next_page (ppdoc *pdf)
+{
+ pppages *pages;
+ ppkids *bounds;
+ ppref *ref;
+ ppobj *obj;
+ pages = &pdf->pages;
+ while (pages->depth > 0)
+ {
+ bounds = pages->parent;
+ obj = ++bounds->current;
+ if (obj < bounds->sentinel)
+ {
+ if (obj->type != PPREF)
+ return NULL;
+ ref = obj->ref;
+ if (ref->object.type != PPDICT)
+ return NULL;
+ return ppdoc_pages_group_first(pdf, ref);
+ }
+ else
+ { // no next node, go upper
+ pppages_pop(pages);
+ }
+ }
+ return NULL;
+}
+
+/* context */
+
+ppcontext * ppcontext_new (void)
+{
+ ppcontext *context;
+ context = (ppcontext *)pp_malloc(sizeof(ppcontext));
+ ppheap_init(&context->heap);
+ ppbytes_buffer_init(&context->heap);
+ ppstack_init(&context->stack, &context->heap);
+ return context;
+}
+
+void ppcontext_done (ppcontext *context)
+{
+ ppheap_renew(&context->heap);
+ ppstack_clear(&context->stack);
+}
+
+void ppcontext_free (ppcontext *context)
+{
+ ppstack_free_buffer(&context->stack);
+ ppheap_free(&context->heap);
+ pp_free(context);
+}
+
+/* page contents streams */
+
+//#define ppcontents_first_stream(array) pparray_rget_stream(array, 0)
+
+static ppstream * ppcontents_first_stream (pparray *array)
+{
+ size_t i;
+ ppobj *obj;
+ ppref *ref;
+ for (pparray_first(array, i, obj); i < array->size; pparray_next(i, obj))
+ if ((ref = ppobj_get_ref(obj)) != NULL && ref->object.type == PPSTREAM)
+ return ref->object.stream;
+ return NULL;
+}
+
+static ppstream * ppcontents_next_stream (pparray *array, ppstream *stream)
+{
+ size_t i;
+ ppobj *obj;
+ ppref *ref;
+ for (pparray_first(array, i, obj); i < array->size; pparray_next(i, obj))
+ if ((ref = ppobj_get_ref(obj)) != NULL && ref->object.type == PPSTREAM && ref->object.stream == stream)
+ if (++i < array->size && (ref = ppobj_get_ref(obj + 1)) != NULL && ref->object.type == PPSTREAM)
+ return ref->object.stream;
+ return NULL;
+}
+
+ppstream * ppcontents_first (ppdict *dict)
+{
+ ppobj *contentsobj;
+ if ((contentsobj = ppdict_rget_obj(dict, "Contents")) == NULL)
+ return NULL;
+ switch (contentsobj->type)
+ {
+ case PPARRAY:
+ return ppcontents_first_stream(contentsobj->array);
+ case PPSTREAM:
+ return contentsobj->stream;
+ default:
+ break;
+ }
+ return NULL;
+}
+
+ppstream * ppcontents_next (ppdict *dict, ppstream *stream)
+{
+ ppobj *contentsobj;
+ if ((contentsobj = ppdict_rget_obj(dict, "Contents")) == NULL)
+ return NULL;
+ switch (contentsobj->type)
+ {
+ case PPARRAY:
+ return ppcontents_next_stream(contentsobj->array, stream);
+ case PPSTREAM:
+ break;
+ default:
+ break;
+ }
+ return NULL;
+}
+
+static ppobj * ppcontents_op (iof *I, ppstack *stack, size_t *psize, ppname **pname)
+{
+ ppobj *obj;
+ ppstack_clear(stack);
+ do {
+ if (ppscan_find(I) < 0)
+ return NULL;
+ if ((obj = ppscan_psobj(I, stack)) == NULL)
+ return NULL;
+ } while (obj->type != PPNAME || !ppname_exec(obj->name));
+ *pname = obj->name;
+ *psize = stack->size - 1;
+ return stack->buf;
+}
+
+ppobj * ppcontents_first_op (ppcontext *context, ppstream *stream, size_t *psize, ppname **pname)
+{
+ iof *I;
+ if ((I = ppstream_read(stream, 1, 0)) == NULL)
+ return NULL;
+ return ppcontents_op(I, &context->stack, psize, pname);
+}
+
+ppobj * ppcontents_next_op (ppcontext *context, ppstream *stream, size_t *psize, ppname **pname)
+{
+ return ppcontents_op(ppstream_iof(stream), &context->stack, psize, pname);
+}
+
+ppobj * ppcontents_parse (ppcontext *context, ppstream *stream, size_t *psize)
+{
+ iof *I;
+ ppstack *stack;
+ ppobj *obj;
+ stack = &context->stack;
+ ppstack_clear(stack);
+ if ((I = ppstream_read(stream, 1, 0)) == NULL)
+ return NULL;
+ while (ppscan_find(I) >= 0)
+ if ((obj = ppscan_psobj(I, stack)) == NULL)
+ goto error;
+ *psize = stack->size;
+ ppstream_done(stream);
+ return stack->buf;
+error:
+ ppstream_done(stream);
+ return NULL;
+}
+
+/* boxes */
+
+pprect * pparray_to_rect (pparray *array, pprect *rect)
+{
+ ppobj *obj;
+ if (array->size != 4)
+ return NULL;
+ obj = pparray_at(array, 0);
+ if (!ppobj_get_num(obj, rect->lx)) return NULL;
+ obj = pparray_at(array, 1);
+ if (!ppobj_get_num(obj, rect->ly)) return NULL;
+ obj = pparray_at(array, 2);
+ if (!ppobj_get_num(obj, rect->rx)) return NULL;
+ obj = pparray_at(array, 3);
+ if (!ppobj_get_num(obj, rect->ry)) return NULL;
+ return rect;
+}
+
+pprect * ppdict_get_rect (ppdict *dict, const char *name, pprect *rect)
+{
+ pparray *array;
+ return (array = ppdict_rget_array(dict, name)) != NULL ? pparray_to_rect(array, rect) : NULL;
+}
+
+pprect * ppdict_get_box (ppdict *dict, const char *name, pprect *rect)
+{
+ do {
+ if (ppdict_get_rect(dict, name, rect) != NULL)
+ return rect;
+ dict = ppdict_rget_dict(dict, "Parent");
+ } while (dict != NULL);
+ return NULL;
+}
+
+ppmatrix * pparray_to_matrix (pparray *array, ppmatrix *matrix)
+{
+ ppobj *obj;
+ if (array->size != 6)
+ return NULL;
+ obj = pparray_at(array, 0);
+ if (!ppobj_get_num(obj, matrix->xx)) return NULL;
+ obj = pparray_at(array, 1);
+ if (!ppobj_get_num(obj, matrix->xy)) return NULL;
+ obj = pparray_at(array, 2);
+ if (!ppobj_get_num(obj, matrix->yx)) return NULL;
+ obj = pparray_at(array, 3);
+ if (!ppobj_get_num(obj, matrix->yy)) return NULL;
+ obj = pparray_at(array, 4);
+ if (!ppobj_get_num(obj, matrix->x)) return NULL;
+ obj = pparray_at(array, 5);
+ if (!ppobj_get_num(obj, matrix->y)) return NULL;
+ return matrix;
+}
+
+ppmatrix * ppdict_get_matrix (ppdict *dict, const char *name, ppmatrix *matrix)
+{
+ pparray *array;
+ return (array = ppdict_rget_array(dict, name)) != NULL ? pparray_to_matrix(array, matrix) : NULL;
+}
+
+/* logger */
+
+void pplog_callback (pplogger_callback logger, void *alien)
+{
+ logger_callback((logger_function)logger, alien);
+}
+
+int pplog_prefix (const char *prefix)
+{
+ return logger_prefix(prefix);
+}
+
+/* version */
+
+const char * ppdoc_version_string (ppdoc *pdf)
+{
+ return pdf->version;
+}
+
+int ppdoc_version_number (ppdoc *pdf, int *minor)
+{
+ *minor = pdf->version[2] - '0';
+ return pdf->version[0] - '0';
+}
+
+/* doc info */
+
+size_t ppdoc_file_size (ppdoc *pdf)
+{
+ return pdf->filesize;
+}
+
+ppuint ppdoc_objects (ppdoc *pdf)
+{
+ ppuint count;
+ ppxref *xref;
+ for (count = 0, xref = pdf->xref; xref != NULL; xref = xref->prev)
+ count += xref->count;
+ return count;
+}
+
+size_t ppdoc_memory (ppdoc *pdf, size_t *waste)
+{
+ mem_info info;
+ size_t used;
+ ppbytes_heap_info(&pdf->heap, &info, 0);
+ ppstruct_heap_info(&pdf->heap, &info, 1);
+
+ *waste = info.ghosts + info.blockghosts + info.left; // info.ghosts == 0
+ used = info.used + *waste;
+ used += pdf->stack.space * sizeof(ppobj);
+ return used;
+}
diff --git a/source/luametatex/source/libraries/pplib/ppload.h b/source/luametatex/source/libraries/pplib/ppload.h
new file mode 100644
index 000000000..f9ecca3b9
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppload.h
@@ -0,0 +1,58 @@
+
+#ifndef PP_LOAD_H
+#define PP_LOAD_H
+
+typedef struct {
+ ppobj *buf; // ppobjects buffer (allocated, not from our heap)
+ ppobj *pos; // current ppobj *
+ size_t size; // stack size
+ size_t space; // available space
+ ppheap *heap; // allocator (parent pdf->stack->heap or parent context)
+} ppstack;
+
+typedef struct {
+ ppobj *current;
+ ppobj *sentinel;
+} ppkids;
+
+#define PPPAGES_STACK_DEPTH 4
+
+typedef struct {
+ ppkids buffer[PPPAGES_STACK_DEPTH];
+ ppkids *root;
+ ppkids *parent;
+ ppuint depth;
+ ppuint space;
+} pppages;
+
+struct ppdoc {
+ /* input */
+ iof_file input;
+ iof reader;
+ uint8_t *buffer;
+ size_t filesize;
+ /* heap */
+ ppheap heap;
+ ppstack stack;
+ /* output struct */
+ ppxref *xref;
+ pppages pages;
+ ppcrypt *crypt;
+ ppcrypt_status cryptstatus;
+ int flags;
+ char version[5];
+};
+
+#define PPDOC_LINEARIZED (1 << 0)
+
+ppobj * ppdoc_load_entry (ppdoc *pdf, ppref *ref);
+#define ppobj_preloaded(pdf, obj) ((obj)->type != PPREF ? (obj) : ((obj)->ref->object.type == PPNONE ? ppdoc_load_entry(pdf, (obj)->ref) : &(obj)->ref->object))
+
+ppstring * ppstring_internal (const void *data, size_t size, ppheap *heap);
+
+struct ppcontext {
+ ppheap heap;
+ ppstack stack;
+};
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/ppstream.c b/source/luametatex/source/libraries/pplib/ppstream.c
new file mode 100644
index 000000000..c88d7e7fc
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppstream.c
@@ -0,0 +1,491 @@
+
+#include "ppfilter.h"
+#include "pplib.h"
+
+ppstream * ppstream_create (ppdoc *pdf, ppdict *dict, size_t offset)
+{
+ ppstream *stream;
+ stream = (ppstream *)ppstruct_take(&pdf->heap, sizeof(ppstream));
+ stream->dict = dict;
+ stream->offset = offset;
+ //if (!ppdict_rget_uint(dict, "Length", &stream->length)) // may be indirect pointing PPNONE at this moment
+ // stream->length = 0;
+ stream->length = 0;
+ stream->filespec = NULL;
+ stream->filter.filters = NULL;
+ stream->filter.params = NULL;
+ stream->filter.count = 0;
+ stream->input = &pdf->input;
+ stream->I = NULL;
+ stream->cryptkey = NULL;
+ stream->flags = 0;
+ return stream;
+}
+
+static iof * ppstream_predictor (ppdict *params, iof *N)
+{
+ ppint predictor, rowsamples, components, samplebits;
+
+ if (!ppdict_get_int(params, "Predictor", &predictor) || predictor <= 1)
+ return N;
+ if (!ppdict_get_int(params, "Columns", &rowsamples) || rowsamples == 0) // sanity, filter probably expects >0
+ rowsamples = 1;;
+ if (!ppdict_get_int(params, "Colors", &components) || components == 0) // ditto
+ components = 1;
+ if (!ppdict_get_int(params, "BitsPerComponent", &samplebits) || samplebits == 0)
+ samplebits = 8;
+ return iof_filter_predictor_decoder(N, (int)predictor, (int)rowsamples, (int)components, (int)samplebits);
+}
+
+static iof * ppstream_decoder (ppstream *stream, ppstreamtp filtertype, ppdict *params, iof *N)
+{
+ int flags;
+ iof *F, *P;
+ ppint earlychange;
+ ppstring *cryptkey;
+
+ switch (filtertype)
+ {
+ case PPSTREAM_BASE16:
+ return iof_filter_base16_decoder(N);
+ case PPSTREAM_BASE85:
+ return iof_filter_base85_decoder(N);
+ case PPSTREAM_RUNLENGTH:
+ return iof_filter_runlength_decoder(N);
+ case PPSTREAM_FLATE:
+ if ((F = iof_filter_flate_decoder(N)) != NULL)
+ {
+ if (params != NULL)
+ {
+ if ((P = ppstream_predictor(params, F)) != NULL)
+ return P;
+ iof_close(F);
+ break;
+ }
+ return F;
+ }
+ break;
+ case PPSTREAM_LZW:
+ flags = LZW_DECODER_DEFAULTS;
+ if (params != NULL && ppdict_get_int(params, "EarlyChange", &earlychange) && earlychange == 0) // integer, not boolean
+ flags &= ~LZW_EARLY_INDEX;
+ if ((F = iof_filter_lzw_decoder(N, flags)) != NULL)
+ {
+ if (params != NULL)
+ {
+ if ((P = ppstream_predictor(params, F)) != NULL)
+ return P;
+ iof_close(F);
+ break;
+ }
+ return F;
+ }
+ break;
+ case PPSTREAM_CRYPT:
+ if ((cryptkey = stream->cryptkey) == NULL)
+ return N; // /Identity crypt
+ if (stream->flags & PPSTREAM_ENCRYPTED_AES)
+ return iof_filter_aes_decoder(N, cryptkey->data, cryptkey->size);
+ if (stream->flags & PPSTREAM_ENCRYPTED_RC4)
+ return iof_filter_rc4_decoder(N, cryptkey->data, cryptkey->size);
+ return NULL; // if neither AES or RC4 but cryptkey present, something went wrong; see ppstream_info()
+ case PPSTREAM_CCITT:
+ case PPSTREAM_DCT:
+ case PPSTREAM_JBIG2:
+ case PPSTREAM_JPX:
+ break;
+ }
+ return NULL;
+}
+
+#define ppstream_source(stream) iof_filter_stream_coreader((iof_file *)((stream)->input), (size_t)((stream)->offset), (size_t)((stream)->length))
+#define ppstream_auxsource(filename) iof_filter_file_reader(filename)
+
+static ppname * ppstream_get_filter_name (ppobj *filterobj, size_t index)
+{
+ if (filterobj->type == PPNAME)
+ return index == 0 ? filterobj->name : NULL;
+ if (filterobj->type == PPARRAY)
+ return pparray_get_name(filterobj->array, index);
+ return NULL;
+}
+
+static ppdict * ppstream_get_filter_params (ppobj *paramsobj, size_t index)
+{
+ if (paramsobj->type == PPDICT)
+ return index == 0 ? paramsobj->dict : NULL;
+ if (paramsobj->type == PPARRAY)
+ return pparray_rget_dict(paramsobj->array, index);
+ return NULL;
+}
+
+static const char * ppstream_aux_filename (ppobj *filespec)
+{ // mockup, here we should decode the string
+ if (filespec->type == PPSTRING)
+ {
+ return (const char *)(filespec->string);
+ }
+ // else might be a dict - todo
+ return NULL;
+}
+
+#define ppstream_image_filter(fcode) (fcode == PPSTREAM_DCT || fcode == PPSTREAM_CCITT || fcode == PPSTREAM_JBIG2 || fcode == PPSTREAM_JPX)
+
+iof * ppstream_read (ppstream *stream, int decode, int all)
+{
+ iof *I, *F;
+ ppstreamtp *filtertypes, filtertype;
+ int owncrypt;
+ ppdict **filterparams, *fparams;
+ size_t index, filtercount;
+ const char *filename;
+
+ if (ppstream_iof(stream) != NULL)
+ return NULL; // usage error
+
+ if (stream->filespec != NULL)
+ {
+ filename = ppstream_aux_filename(stream->filespec); // mockup, basic support
+ I = filename != NULL ? ppstream_auxsource(filename) : NULL;
+ }
+ else
+ {
+ I = ppstream_source(stream);
+ }
+ if (I == NULL)
+ return NULL;
+
+ /* If the stream is encrypted, decipher is the first to be applied */
+ owncrypt = (stream->flags & PPSTREAM_ENCRYPTED_OWN) != 0;
+ if (!owncrypt)
+ {
+ if (stream->cryptkey != NULL && stream->filespec == NULL)
+ { /* implied global crypt; does not apply to external files (pdf psec page 115), except for embedded file streams (not supported so far) */
+ if ((F = ppstream_decoder(stream, PPSTREAM_CRYPT, NULL, I)) == NULL)
+ goto stream_error;
+ I = F;
+ } /* otherwise no crypt at all or /Identity */
+ }
+
+ if (decode || owncrypt)
+ {
+ if ((filtercount = stream->filter.count) > 0)
+ {
+ filtertypes = stream->filter.filters;
+ filterparams = stream->filter.params;
+ for (index = 0; index < filtercount; ++index)
+ {
+ fparams = filterparams != NULL ? filterparams[index] : NULL;
+ filtertype = filtertypes[index];
+ if ((F = ppstream_decoder(stream, filtertype, fparams, I)) != NULL)
+ {
+ I = F;
+ if (owncrypt && !decode && filtertype == PPSTREAM_CRYPT)
+ break; // /Crypt filter should always be first, so in practise we return decrypted but compressed
+ continue;
+ }
+ if (!ppstream_image_filter(filtertype))
+ goto stream_error; // failed to create non-image filter, something unexpected
+ break;
+ }
+ }
+ }
+ if (all)
+ iof_load(I);
+ else
+ iof_input(I);
+ stream->I = I;
+ return I;
+stream_error:
+ iof_close(I);
+ return NULL;
+}
+
+uint8_t * ppstream_first (ppstream *stream, size_t *size, int decode)
+{
+ iof *I;
+ if ((I = ppstream_read(stream, decode, 0)) != NULL)
+ {
+ *size = (size_t)iof_left(I);
+ return I->pos;
+ }
+ *size = 0;
+ return NULL;
+}
+
+uint8_t * ppstream_next (ppstream *stream, size_t *size)
+{
+ iof *I;
+ if ((I = ppstream_iof(stream)) != NULL)
+ {
+ I->pos = I->end;
+ if ((*size = iof_input(I)) > 0)
+ return I->pos;
+ }
+ *size = 0;
+ return NULL;
+}
+
+uint8_t * ppstream_all (ppstream *stream, size_t *size, int decode)
+{
+ iof *I;
+ if ((I = ppstream_read(stream, decode, 1)) != NULL)
+ {
+ *size = (size_t)iof_left(I);
+ return I->pos;
+ }
+ *size = 0;
+ return NULL;
+}
+
+void ppstream_done (ppstream *stream)
+{
+ iof *I;
+ if ((I = ppstream_iof(stream)) != NULL)
+ {
+ iof_close(I);
+ stream->I = NULL;
+ }
+}
+
+/* fetching stream info
+PJ20180916: revealed it makes sense to do a lilbit more just after parsing stream entry to simplify stream operations
+and extend ppstream api
+*/
+
+/* stream filters */
+
+const char * ppstream_filter_name[] = {
+ "ASCIIHexDecode",
+ "ASCII85Decode",
+ "RunLengthDecode",
+ "FlateDecode",
+ "LZWDecode",
+ "CCITTFaxDecode",
+ "DCTDecode",
+ "JBIG2Decode",
+ "JPXDecode",
+ "Crypt"
+};
+
+int ppstream_filter_type (ppname *name, ppstreamtp *filtertype)
+{
+ switch (name->data[0])
+ {
+ case 'A':
+ if (ppname_is(name, "ASCIIHexDecode")) { *filtertype = PPSTREAM_BASE16; return 1; }
+ if (ppname_is(name, "ASCII85Decode")) { *filtertype = PPSTREAM_BASE85; return 1; }
+ break;
+ case 'R':
+ if (ppname_is(name, "RunLengthDecode")) { *filtertype = PPSTREAM_RUNLENGTH; return 1; }
+ break;
+ case 'F':
+ if (ppname_is(name, "FlateDecode")) { *filtertype = PPSTREAM_FLATE; return 1; }
+ break;
+ case 'L':
+ if (ppname_is(name, "LZWDecode")) { *filtertype = PPSTREAM_LZW; return 1; }
+ break;
+ case 'D':
+ if (ppname_is(name, "DCTDecode")) { *filtertype = PPSTREAM_DCT; return 1; }
+ break;
+ case 'C':
+ if (ppname_is(name, "CCITTFaxDecode")) { *filtertype = PPSTREAM_CCITT; return 1; }
+ if (ppname_is(name, "Crypt")) { *filtertype = PPSTREAM_CRYPT; return 1; }
+ break;
+ case 'J':
+ if (ppname_is(name, "JPXDecode")) { *filtertype = PPSTREAM_JPX; return 1; }
+ if (ppname_is(name, "JBIG2Decode")) { *filtertype = PPSTREAM_JBIG2; return 1; }
+ break;
+ }
+ return 0;
+}
+
+void ppstream_info (ppstream *stream, ppdoc *pdf)
+{ // called in ppdoc_load_entries() for every stream, but after loading non-stream objects (eg. /Length..)
+ ppdict *dict, *fparams;
+ ppobj *fobj, *pobj;
+ ppname *fname, *tname, *owncryptfilter = NULL;
+ ppcrypt *crypt;
+ ppref *ref;
+ size_t i;
+ int cflags;
+
+ ppstreamtp *filtertypes = NULL, filtertype;
+ ppdict **filterparams = NULL;
+ size_t filtercount = 0, farraysize = 0;
+
+ const char *filterkey, *paramskey;
+
+ dict = stream->dict;
+ ppdict_rget_uint(dict, "Length", &stream->length);
+
+ if ((stream->filespec = ppdict_get_obj(dict, "F")) != NULL)
+ {
+ stream->flags |= PPSTREAM_NOT_SUPPORTED;
+ filterkey = "FFilter", paramskey = "FDecodeParms";
+ }
+ else
+ filterkey = "Filter", paramskey = "DecodeParms";
+
+ if ((fobj = ppdict_rget_obj(dict, filterkey)) != NULL)
+ {
+ switch (fobj->type)
+ {
+ case PPNAME:
+ farraysize = 1;
+ break;
+ case PPARRAY:
+ farraysize = fobj->array->size;
+ break;
+ default:
+ break;
+ }
+ if (farraysize > 0)
+ {
+ filtertypes = (ppstreamtp *)ppstruct_take(&pdf->heap, farraysize * sizeof(ppstreamtp));
+ if ((pobj = ppdict_rget_obj(dict, paramskey)) != NULL)
+ {
+ filterparams = (ppdict **)ppstruct_take(&pdf->heap, farraysize * sizeof(ppdict *));
+ }
+ for (i = 0; i < farraysize; ++i)
+ {
+ if ((fname = ppstream_get_filter_name(fobj, i)) != NULL && ppstream_filter_type(fname, &filtertype))
+ {
+ filtertypes[filtercount] = filtertype;
+ if (pobj != NULL)
+ {
+ fparams = ppstream_get_filter_params(pobj, i);
+ filterparams[filtercount] = fparams;
+ }
+ else
+ fparams = NULL;
+ switch (filtertype)
+ {
+ case PPSTREAM_BASE16:
+ case PPSTREAM_BASE85:
+ case PPSTREAM_RUNLENGTH:
+ case PPSTREAM_FLATE:
+ case PPSTREAM_LZW:
+ stream->flags |= PPSTREAM_FILTER;
+ break;
+ case PPSTREAM_CCITT:
+ case PPSTREAM_DCT:
+ case PPSTREAM_JBIG2:
+ case PPSTREAM_JPX:
+ stream->flags |= PPSTREAM_IMAGE;
+ break;
+ case PPSTREAM_CRYPT:
+ stream->flags |= PPSTREAM_ENCRYPTED_OWN;
+ owncryptfilter = fparams != NULL ? ppdict_get_name(fparams, "Name") : NULL; // /Type /CryptFilterDecodeParms /Name ...
+ if (i != 0) // we assume it is first
+ stream->flags |= PPSTREAM_NOT_SUPPORTED;
+ break;
+ }
+ ++filtercount;
+ }
+ else
+ {
+ stream->flags |= PPSTREAM_NOT_SUPPORTED;
+ }
+ }
+ }
+ }
+ stream->filter.filters = filtertypes;
+ stream->filter.params = filterparams;
+ stream->filter.count = filtercount;
+
+ if ((crypt = pdf->crypt) == NULL || (ref = crypt->ref) == NULL)
+ return;
+ if (stream->flags & PPSTREAM_ENCRYPTED_OWN)
+ {
+ /* Seems a common habit to use just /Crypt filter name with no params, which defaults to /Identity.
+ A real example with uncompressed metadata: <</Filter[/Crypt]/Length 4217/Subtype/XML/Type/Metadata>> */
+ if (owncryptfilter != NULL && !ppname_is(owncryptfilter, "Identity") && stream->filespec == NULL) // ?
+ {
+ if (crypt->map != NULL && ppcrypt_type(crypt, owncryptfilter, NULL, &cflags))
+ {
+ if (cflags & PPCRYPT_INFO_AES)
+ stream->flags |= PPSTREAM_ENCRYPTED_AES;
+ else if (cflags & PPCRYPT_INFO_RC4)
+ stream->flags |= PPSTREAM_ENCRYPTED_RC4;
+ }
+ }
+ }
+ else
+ {
+ if ((crypt->flags & PPCRYPT_NO_METADATA) && (tname = ppdict_get_name(dict, "Type")) != NULL && ppname_is(tname, "Metadata"))
+ ; /* special treatment of metadata stream; we assume that explicit /Filter /Crypt setup overrides document level setup of EncryptMetadata. */
+ else if (stream->filespec == NULL) /* external files are not encrypted, expect embedded files (not supported yet) */
+ {
+ if (crypt->flags & PPCRYPT_STREAM_RC4)
+ stream->flags |= PPSTREAM_ENCRYPTED_RC4;
+ else if (crypt->flags & PPCRYPT_STREAM_AES)
+ stream->flags |= PPSTREAM_ENCRYPTED_AES;
+ }
+ }
+
+ /* finally, if the stream is encrypted with non-identity crypt (implicit or explicit), make and save the crypt key */
+ if (stream->flags & PPSTREAM_ENCRYPTED)
+ stream->cryptkey = ppcrypt_stmkey(crypt, ref, ((stream->flags & PPSTREAM_ENCRYPTED_AES) != 0), &pdf->heap);
+}
+
+void ppstream_filter_info (ppstream *stream, ppstream_filter *info, int decode)
+{
+ size_t from, index;
+ ppstreamtp filtertype;
+ ppdict *params;
+
+ *info = stream->filter;
+ if (info->count > 0)
+ {
+ from = (stream->flags & PPSTREAM_ENCRYPTED_OWN) && info->filters[0] == PPSTREAM_CRYPT ? 1 : 0;
+ if (decode)
+ {
+ for (index = from; index < info->count; ++index)
+ {
+ filtertype = info->filters[index];
+ if (ppstream_image_filter(filtertype))
+ {
+ break;
+ }
+ }
+ }
+ else
+ {
+ index = from;
+ }
+ if (index > 0) {
+ info->count -= index;
+ if (info->count > 0)
+ {
+ info->filters += index;
+ if (info->params != NULL)
+ {
+ info->params += index;
+ for (index = 0, params = NULL; index < info->count; ++index)
+ if ((params = info->params[index]) != NULL)
+ break;
+ if (params == NULL)
+ info->params = NULL;
+ }
+ }
+ else
+ {
+ info->filters = NULL;
+ info->params = NULL;
+ }
+ }
+ }
+}
+
+/* */
+
+void ppstream_init_buffers (void)
+{
+ iof_filters_init();
+}
+
+void ppstream_free_buffers (void)
+{
+ iof_filters_free();
+}
diff --git a/source/luametatex/source/libraries/pplib/ppstream.h b/source/luametatex/source/libraries/pplib/ppstream.h
new file mode 100644
index 000000000..37e34c56a
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppstream.h
@@ -0,0 +1,10 @@
+
+#ifndef PP_STREAM_H
+#define PP_STREAM_H
+
+ppstream * ppstream_create (ppdoc *pdf, ppdict *dict, size_t offset);
+iof * ppstream_read (ppstream *stream, int decode, int all);
+#define ppstream_iof(stream) ((iof *)((stream)->I))
+void ppstream_info (ppstream *stream, ppdoc *pdf);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/pptest1.c b/source/luametatex/source/libraries/pplib/pptest1.c
new file mode 100644
index 000000000..eabb0eae9
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/pptest1.c
@@ -0,0 +1,104 @@
+
+#include <stdio.h>
+#include "ppapi.h"
+#include "util/utiliof.h"
+
+static const char * sizenum (size_t s)
+{
+ static char buffer[32];
+ if (s < 1000)
+ sprintf(buffer, "%uB", (unsigned)s);
+ else if (s < 1000000)
+ sprintf(buffer, "%.2fkB", (double)(s) / 1000);
+ else
+ sprintf(buffer, "%.2fMB", (double)(s) / 1000000);
+ return buffer;
+}
+
+static const char * crypt_info (ppdoc *pdf)
+{
+ switch (ppdoc_crypt_status(pdf))
+ {
+ case PPCRYPT_NONE:
+ return "none";
+ case PPCRYPT_DONE:
+ return "empty password";
+ case PPCRYPT_PASS:
+ return "nonempty password";
+ default:
+ break;
+ }
+ return "this shouldn't happen";
+}
+
+static void print_info (ppdoc *pdf)
+{
+ ppdict *info;
+ ppstring *creator, *producer;
+ size_t memused, memwaste;
+
+ if ((info = ppdoc_info(pdf)) != NULL)
+ {
+ if ((creator = ppdict_rget_string(info, "Creator")) != NULL)
+ printf(" creator: %s\n", ppstring_decoded_data(creator));
+ if ((producer = ppdict_rget_string(info, "Producer")) != NULL)
+ printf(" producer: %s\n", ppstring_decoded_data(producer));
+ }
+ printf(" version: %s\n", ppdoc_version_string(pdf));
+ printf(" protection: %s\n", crypt_info(pdf));
+ printf(" filesize: %s\n", sizenum(ppdoc_file_size(pdf)));
+ printf(" objects: %lu\n", (unsigned long)ppdoc_objects(pdf));
+ printf(" pagecount: %lu\n", (unsigned long)ppdoc_page_count(pdf));
+ memused = ppdoc_memory(pdf, &memwaste);
+ printf(" memused: %s\n", sizenum(memused));
+ printf(" memwaste: %s\n", sizenum(memwaste));
+}
+
+static int usage (const char *argv0)
+{
+ printf("pplib " pplib_version ", " pplib_author "\n");
+ printf("usage: %s file1.pdf file2.pdf ...\n", argv0);
+ return 0;
+}
+
+int main (int argc, const char **argv)
+{
+ const char *filepath;
+ int a;
+ ppdoc *pdf;
+ const void *data;
+ size_t size;
+
+ if (argc < 2)
+ return usage(argv[0]);
+ for (a = 1; a < argc; ++a)
+ {
+ filepath = argv[a];
+ printf("loading %s... ", filepath);
+ pdf = ppdoc_load(filepath);
+ if (pdf == NULL)
+ {
+ printf("failed\n");
+ continue;
+ }
+ printf("done.\n");
+ print_info(pdf);
+ ppdoc_free(pdf);
+ /* now loading from memory buffer */
+ printf("loading %s from mem buffer... ", filepath);
+ data = iof_copy_file_data(filepath, &size);
+ if (data != NULL)
+ {
+ pdf = ppdoc_mem(data, size);
+ if (pdf == NULL)
+ {
+ printf("failed\n");
+ continue;
+ }
+ printf("done.\n");
+ //print_info(pdf);
+ ppdoc_free(pdf);
+ }
+ }
+ return 0;
+}
diff --git a/source/luametatex/source/libraries/pplib/pptest2.c b/source/luametatex/source/libraries/pplib/pptest2.c
new file mode 100644
index 000000000..5dff63afd
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/pptest2.c
@@ -0,0 +1,170 @@
+
+#include <stdio.h>
+#include <assert.h>
+#include "ppapi.h"
+
+/*
+static const char * get_file_name (const char *path)
+{
+ const char *fn, *p;
+ for (fn = p = path; *p != '\0'; ++p)
+ if (*p == '\\' || *p == '/')
+ fn = p + 1;
+ return fn;
+}
+*/
+
+static void box_info (ppdict *pagedict, FILE *fh)
+{
+ const char *boxes[] = {"MediaBox", "CropBox", "BleedBox", "TrimBox", "ArtBox"};
+ pprect rect;
+ size_t i;
+ for (i = 0; i < sizeof(boxes) / sizeof(const char *); ++i)
+ if (ppdict_get_box(pagedict, boxes[i], &rect))
+ fprintf(fh, "%%%% %s [%f %f %f %f]\n", boxes[i], rect.lx, rect.ly, rect.rx, rect.ry);
+}
+
+static int usage (const char *argv0)
+{
+ printf("pplib " pplib_version ", " pplib_author "\n");
+ printf("usage: %s file1.pdf file2.pdf ...\n", argv0);
+ printf(" %s file.pdf -u userpassword\n", argv0);
+ printf(" %s file.pdf -o ownerpassword\n", argv0);
+ printf(" %s file.pdf -p bothpasswords\n", argv0);
+ return 0;
+}
+
+static void log_callback (const char *message, void *alien)
+{
+ fprintf((FILE *)alien, "\nooops: %s\n", message);
+}
+
+static const char * get_next_argument (const char *opt, int *a, int argc, const char **argv)
+{
+ const char *next;
+ if ((*a) + 2 < argc)
+ {
+ next = argv[*a + 1];
+ if (strcmp(next, opt) == 0)
+ {
+ *a += 2;
+ return argv[*a];
+ }
+ }
+ return NULL;
+}
+
+int main (int argc, const char **argv)
+{
+ const char *filepath, *password;
+ int a;
+ ppdoc *pdf;
+ ppcrypt_status cryptstatus;
+ ppref *pageref;
+ ppdict *pagedict;
+ int pageno;
+ char outname[1024];
+ FILE *fh;
+ ppstream *stream;
+ uint8_t *data;
+ size_t size;
+ ppcontext *context;
+ ppobj *obj;
+ ppname *op;
+ size_t operators;
+
+ if (argc < 2)
+ return usage(argv[0]);
+ ppstream_init_buffers();
+ pplog_callback(log_callback, stderr);
+ context = ppcontext_new();
+ for (a = 1; a < argc; ++a)
+ {
+ /* load */
+ filepath = argv[a];
+ printf("loading %s... ", filepath);
+ pdf = ppdoc_load(filepath);
+ if (pdf == NULL)
+ {
+ printf("failed\n");
+ continue;
+ }
+ printf("done\n");
+
+ /* decrypt */
+ if ((password = get_next_argument("-u", &a, argc, argv)) != NULL)
+ cryptstatus = ppdoc_crypt_pass(pdf, password, strlen(password), NULL, 0);
+ else if ((password = get_next_argument("-o", &a, argc, argv)) != NULL)
+ cryptstatus = ppdoc_crypt_pass(pdf, NULL, 0, password, strlen(password));
+ else if ((password = get_next_argument("-p", &a, argc, argv)) != NULL)
+ cryptstatus = ppdoc_crypt_pass(pdf, password, strlen(password), password, strlen(password));
+ else
+ cryptstatus = ppdoc_crypt_status(pdf);
+ switch (cryptstatus)
+ {
+ case PPCRYPT_NONE:
+ break;
+ case PPCRYPT_DONE:
+ printf("opened with password '%s'\n", password != NULL ? password : "");
+ break;
+ case PPCRYPT_PASS:
+ printf("invalid password\n");
+ ppdoc_free(pdf);
+ continue;
+ case PPCRYPT_FAIL:
+ printf("invalid encryption\n");
+ ppdoc_free(pdf);
+ continue;
+ }
+
+ /* process */
+ sprintf(outname, "%s.out", filepath);
+ fh = fopen(outname, "wb");
+ if (fh == NULL)
+ {
+ printf("can't open %s for writing\n", outname);
+ continue;
+ }
+ for (pageref = ppdoc_first_page(pdf), pageno = 1;
+ pageref != NULL;
+ pageref = ppdoc_next_page(pdf), ++pageno)
+ {
+ pagedict = pageref->object.dict;
+ /* decompress contents data */
+ fprintf(fh, "%%%% PAGE %d\n", pageno);
+ box_info(pagedict, fh);
+ for (stream = ppcontents_first(pagedict);
+ stream != NULL;
+ stream = ppcontents_next(pagedict, stream))
+ {
+ for (data = ppstream_first(stream, &size, 1);
+ data != NULL;
+ data = ppstream_next(stream, &size))
+ fwrite(data, size, 1, fh);
+ ppstream_done(stream);
+ }
+ /* now parse contents */
+ for (stream = ppcontents_first(pagedict);
+ stream != NULL;
+ stream = ppcontents_next(pagedict, stream))
+ {
+ operators = 0;
+ for (obj = ppcontents_first_op(context, stream, &size, &op);
+ obj != NULL;
+ obj = ppcontents_next_op(context, stream, &size, &op))
+ ++operators;
+ fprintf(fh, "%%%% OPERATORS count %lu\n", (unsigned long)operators);
+ ppstream_done(stream);
+ //obj = ppcontents_parse(context, stream, &size);
+ //fprintf(fh, "%%%% items count %lu\n", (unsigned long)size);
+ fprintf(fh, "\n");
+ }
+ ppcontext_done(context);
+ }
+ fclose(fh);
+ ppdoc_free(pdf);
+ }
+ ppcontext_free(context);
+ ppstream_free_buffers();
+ return 0;
+}
diff --git a/source/luametatex/source/libraries/pplib/pptest3.c b/source/luametatex/source/libraries/pplib/pptest3.c
new file mode 100644
index 000000000..815ed51b6
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/pptest3.c
@@ -0,0 +1,123 @@
+
+#include <stdio.h>
+//#include "ppapi.h"
+#include "pplib.h"
+#include "assert.h"
+
+static int usage (const char *argv0)
+{
+ printf("pplib " pplib_version ", " pplib_author "\n");
+ printf("usage: %s file1.pdf file2.pdf ...\n", argv0);
+ return 0;
+}
+
+static void print_result_filter (ppstream *stream, int decode)
+{
+ ppstream_filter info;
+ size_t i;
+
+ ppstream_filter_info(stream, &info, decode);
+ printf(" when %s: /Filter [", decode ? "uncompressed" : "compressed");
+ for (i = 0; i < info.count; ++i)
+ printf(" /%s", ppstream_filter_name[info.filters[i]]);
+ printf(" ]");
+ if (info.params != NULL)
+ {
+ printf(" /DecodeParms [");
+ for (i = 0; i < info.count; ++i)
+ printf(" %s", info.params[i] != NULL ? "<<...>>" : "null");
+ printf(" ]");
+ }
+ printf("\n");
+}
+
+static void print_stream_info (ppref *ref, ppstream *stream)
+{
+ size_t length;
+ printf("object %lu %lu R\n", (unsigned long)ref->number, (unsigned long)ref->version);
+ if (stream->flags & PPSTREAM_FILTER)
+ printf(" filtered ");
+ else
+ printf(" plain ");
+ if (stream->flags & PPSTREAM_IMAGE)
+ printf("image ");
+ else
+ printf("stream ");
+ if (stream->flags & PPSTREAM_ENCRYPTED)
+ printf("encrypted ");
+ if (stream->flags & PPSTREAM_NOT_SUPPORTED)
+ printf("invalid ");
+ if (!ppdict_rget_uint(stream->dict, "Length", &length))
+ length = 0;
+ assert(stream->length == length);
+ printf("length %lu (/Length %lu)\n", (unsigned long)stream->length, (unsigned long)length);
+ print_result_filter(stream, 0);
+ print_result_filter(stream, 1);
+}
+
+static void check_stream_chunks (ppstream *stream)
+{
+ size_t sum, size;
+ uint8_t *data;
+ const int decode[2] = {0, 1};
+ int d;
+
+ for (d = 0; d < 2; ++d)
+ {
+ for (sum = 0, data = ppstream_first(stream, &size, decode[d]); data != NULL; data = ppstream_next(stream, &size))
+ sum += size;
+ ppstream_done(stream);
+ ppstream_all(stream, &size, decode[d]);
+ ppstream_done(stream);
+ assert(sum == size);
+ printf(" %s chunks size [%lu]\n", (decode[d] ? "decoded" : "raw"), (unsigned long)size);
+ }
+}
+
+#define USE_BUFFERS_POOL 1
+
+int main (int argc, const char **argv)
+{
+ const char *filepath;
+ int a;
+ ppdoc *pdf;
+ ppxref *xref;
+ ppxsec *xsec;
+ size_t xi;
+ ppuint refnum;
+ ppref *ref;
+
+ if (argc < 2)
+ return usage(argv[0]);
+ if (USE_BUFFERS_POOL)
+ ppstream_init_buffers();
+ for (a = 1; a < argc; ++a)
+ {
+ filepath = argv[a];
+ printf("loading %s... ", filepath);
+ pdf = ppdoc_load(filepath);
+ if (pdf == NULL)
+ {
+ printf("failed\n");
+ continue;
+ }
+ printf("done.\n");
+ for (xref = ppdoc_xref(pdf); xref != NULL; xref = ppxref_prev(xref))
+ {
+ for (xi = 0, xsec = xref->sects; xi < xref->size; ++xi, ++xsec)
+ {
+ for (refnum = xsec->first, ref = xsec->refs; refnum <= xsec->last; ++refnum, ++ref)
+ {
+ if (ref->object.type != PPSTREAM)
+ continue;
+ print_stream_info(ref, ref->object.stream);
+ check_stream_chunks(ref->object.stream);
+ }
+ }
+ }
+ ppdoc_free(pdf);
+ }
+ if (USE_BUFFERS_POOL)
+ ppstream_free_buffers();
+ return 0;
+}
diff --git a/source/luametatex/source/libraries/pplib/ppxref.c b/source/luametatex/source/libraries/pplib/ppxref.c
new file mode 100644
index 000000000..fa03fd6c9
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppxref.c
@@ -0,0 +1,215 @@
+
+#include "pplib.h"
+
+#define PPXREF_MAP_INIT 16 // number of xref sections
+
+ppxref * ppxref_create (ppdoc *pdf, size_t initsize, size_t xrefoffset)
+{
+ ppxref *xref;
+
+ if (initsize == 0) // unknown
+ initsize = PPXREF_MAP_INIT;
+ xref = (ppxref *)ppstruct_take(&pdf->heap, sizeof(ppxref));
+ xref->sects = (ppxsec *)ppstruct_take(&pdf->heap, initsize * sizeof(ppxsec));
+ xref->size = 0;
+ xref->space = initsize;
+ xref->count = 0;
+ xref->trailer.type = PPNONE;
+ xref->trailer.dict = NULL;
+ xref->prev = NULL;
+ xref->pdf = pdf;
+ xref->offset = xrefoffset;
+ return xref;
+}
+
+ppxsec * ppxref_push_section (ppxref *xref, ppheap *heap)
+{
+ ppxsec *sects;
+ if (xref->size < xref->space)
+ return &xref->sects[xref->size++];
+ xref->space <<= 1;
+ sects = xref->sects;
+ xref->sects = (ppxsec *)ppstruct_take(heap, xref->space * sizeof(ppxsec)); // waste but rare
+ memcpy(xref->sects, sects, xref->size * sizeof(ppxsec));
+ return &xref->sects[xref->size++];
+}
+
+/* When loading xref table, we don't know how many sections is there. We assume 16, which is
+ more than usual (waste). But if there is more, we double the size, wasting again. This
+ could be made better with a dedicated allocator for xref sections (heap or generic malloc).
+ Or an ephemeric malloced c-array stored in heap once ready (analogical to stack used for dicts/arrays).
+ For xref streams we have explicit num of sections. */
+
+/*
+void ppxref_done_sections (ppxref *xref, ppheap *heap)
+{ // if xref->sects was initialized with mallocted array we could do
+ ppxsec *sects;
+ size_t size;
+ sects = xref->sects;
+ size = xref->size * sizeof(ppxsec);
+ xref->sects = (ppxsec *)ppstruct_take(heap, size);
+ memcpy(xref->sects, sects, size);
+ pp_free(sects);
+ xref->space = xref->size;
+}
+*/
+
+static void ppxref_sort_sects (ppxsec *left, ppxsec *right)
+{
+ ppxsec *l, *r, *m, t;
+ ppuint first, last;
+ l = left, r = right, m = l + ((r - l) / 2);
+ first = m->first, last = m->last;
+ do
+ { // don't take first/last from pointer
+ while (l->first < first) ++l;
+ while (r->first > last) --r;
+ if (l <= r)
+ {
+ t = *l;
+ *l = *r;
+ *r = t;
+ ++l, --r;
+ }
+ } while (l <= r);
+ if (l < right)
+ ppxref_sort_sects(l, right);
+ if (r > left)
+ ppxref_sort_sects(left, r);
+}
+
+int ppxref_sort (ppxref *xref)
+{
+ if (xref->size == 0)
+ return 0;
+ ppxref_sort_sects(xref->sects, xref->sects + xref->size - 1);
+ return 1;
+}
+
+ppref * ppxref_find_local (ppxref *xref, ppuint refnumber)
+{
+ ppxsec *left, *right, *mid;
+ //if (xref->size == 0) // we don't allow that
+ // return NULL;
+ left = xref->sects;
+ right = xref->sects + xref->size - 1;
+ do
+ {
+ mid = left + ((right - left) / 2);
+ if (refnumber > mid->last)
+ left = mid + 1;
+ else if (refnumber < mid->first)
+ right = mid - 1;
+ else
+ return &mid->refs[refnumber - mid->first];
+ } while (left <= right);
+ return NULL;
+}
+
+/*
+PJ 20180910
+
+So far we were resolving references in the context of the current xref:
+
+- if a given object is found in this xref, than this is the object
+- otherwise older xrefs are queried in order
+- only in linearized documents older body may refer to object from newer xref
+
+Hans sent a document where an incremental update (newer body) has only an updated page object
+(plus /Metadata and /Info), but /Root (catalog) and /Pages dict refs are defined only in the older body.
+If we resolve references using the approach so far, we actually drop the update; newer objects are parsed
+and linked to the newest xref, but never linked to objects tree. Assuming we will never need to interpret
+older versions, makes sense to assume, that the newest object version is always the correct version.
+
+*/
+
+#if 0
+
+ppref * ppxref_find (ppxref *xref, ppuint refnumber)
+{
+ ppref *ref;
+ ppxref *other;
+
+ if ((ref = ppxref_find_local(xref, refnumber)) != NULL)
+ return ref;
+ if (xref->pdf->flags & PPDOC_LINEARIZED)
+ {
+ for (other = xref->pdf->xref; other != NULL; other = other->prev)
+ if (other != xref && (ref = ppxref_find_local(other, refnumber)) != NULL)
+ return ref;
+ }
+ else
+ {
+ for (other = xref->prev; other != NULL; other = other->prev)
+ if ((ref = ppxref_find_local(other, refnumber)) != NULL)
+ return ref;
+ /* This shouldn't happen, but I've met documents that have no linearized dict,
+ but their xrefs are prepared as for linearized; with "older" xrefs referring
+ to "newer". */
+ for (other = xref->pdf->xref; other != NULL && other != xref; other = other->prev)
+ if ((ref = ppxref_find_local(other, refnumber)) != NULL)
+ return ref;
+ }
+ return NULL;
+}
+
+#else
+
+ppref * ppxref_find (ppxref *xref, ppuint refnumber)
+{
+ ppref *ref;
+ ppxref *other;
+
+ for (other = xref->pdf->xref; other != NULL; other = other->prev)
+ if ((ref = ppxref_find_local(other, refnumber)) != NULL)
+ return ref;
+ return NULL;
+}
+
+#endif
+
+ppdict * ppxref_trailer (ppxref *xref)
+{
+ switch (xref->trailer.type)
+ {
+ case PPDICT:
+ return xref->trailer.dict;
+ case PPSTREAM:
+ return xref->trailer.stream->dict;
+ default:
+ break;
+ }
+ return NULL;
+}
+
+ppxref * ppdoc_xref (ppdoc *pdf)
+{
+ return pdf->xref;
+}
+
+ppxref * ppxref_prev (ppxref *xref)
+{
+ return xref->prev;
+}
+
+ppdict * ppxref_catalog (ppxref *xref)
+{
+ ppdict *trailer;
+ return (trailer = ppxref_trailer(xref)) != NULL ? ppdict_rget_dict(trailer, "Root") : NULL;
+}
+
+ppdict * ppxref_info (ppxref *xref)
+{
+ ppdict *trailer;
+ return (trailer = ppxref_trailer(xref)) != NULL ? ppdict_rget_dict(trailer, "Info") : NULL;
+}
+
+ppref * ppxref_pages (ppxref *xref)
+{
+ ppdict *dict;
+ ppref *ref;
+
+ if ((dict = ppxref_catalog(xref)) == NULL || (ref = ppdict_get_ref(dict, "Pages")) == NULL)
+ return NULL;
+ return ref->object.type == PPDICT ? ref : NULL;
+}
diff --git a/source/luametatex/source/libraries/pplib/ppxref.h b/source/luametatex/source/libraries/pplib/ppxref.h
new file mode 100644
index 000000000..fbb83bece
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/ppxref.h
@@ -0,0 +1,35 @@
+
+#ifndef PP_XREF_H
+#define PP_XREF_H
+
+/*
+What we call xref is actually "xref section" in PDF spec and what we call section is "xref subsection".
+Our ppxref is a list of sections, sorted by xrefsection->first and xrefsection->last bounds. Every section
+keeps a list of ppref *refs, enumerated from xrefsection->first to xrefsection->last. To find a reference
+by number we make a binary search over sections bounds, then jump to the proper ppref *ref.
+*/
+
+typedef struct {
+ ppuint first; // first reference number in section
+ ppuint last; // last reference number in section
+ ppref *refs; // references list
+} ppxsec;
+
+struct ppxref {
+ ppxsec *sects; // subsections list
+ size_t size; // actual sections size
+ size_t space; // available sections space
+ ppobj trailer; // trailer dict or stream
+ ppuint count; // count of references in all sections
+ ppxref *prev; // previous xref
+ ppdoc *pdf; // parent pdf to access entries in linearized docs
+ size_t offset; // file offset of xref
+ //ppcrypt *crypt; // per xref encryption state?
+};
+
+ppxref * ppxref_create (ppdoc *pdf, size_t initsize, size_t xrefoffset);
+ppxsec * ppxref_push_section (ppxref *xref, ppheap *heap);
+int ppxref_sort (ppxref *xref);
+ppref * ppxref_find_local (ppxref *xref, ppuint refnumber);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/readme.txt b/source/luametatex/source/libraries/pplib/readme.txt
new file mode 100644
index 000000000..ee5d141dc
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/readme.txt
@@ -0,0 +1,3 @@
+This is (to be) added to util/utilflate.c:
+
+# include "../../utilities/auxzlib.h"
diff --git a/source/luametatex/source/libraries/pplib/util/README.md b/source/luametatex/source/libraries/pplib/util/README.md
new file mode 100644
index 000000000..28f18ca65
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/README.md
@@ -0,0 +1,8 @@
+# pplib util
+
+This part is a toolbox. Contains utilities that are used by `pplib`
+but aren't tightly related to `PDF`. I use the toolbox in different
+projects and repos. It is important to me to keep this part in a perfect
+sync, at the cost of some redundant code (not used in `pplib`).
+`pplib` is hopefully not a subject for eternal development, so once
+it become final, we will make some cleanups here.
diff --git a/source/luametatex/source/libraries/pplib/util/utilbasexx.c b/source/luametatex/source/libraries/pplib/util/utilbasexx.c
new file mode 100644
index 000000000..cfe148840
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilbasexx.c
@@ -0,0 +1,1742 @@
+
+#include "utilnumber.h"
+#include "utilmem.h"
+#include "utilbasexx.h"
+
+/* filters state structs */
+
+struct basexx_state {
+ size_t line, maxline;
+ size_t left;
+ int tail[5];
+ int flush;
+};
+
+struct runlength_state {
+ int run;
+ int flush;
+ int c1, c2;
+ uint8_t *pos;
+};
+
+typedef union { basexx_state *basexxstate; runlength_state *runlengthstate; void *voidstate; } basexx_state_pointer; // to avoid 'dereferencing type-puned ...' warnings
+
+/* config */
+
+#if defined(BASEXX_PDF)
+# define ignored(c) (c == 0x20 || c == 0x0A || c == 0x0C || c == 0x0D || c == 0x09 || c == 0x00)
+# define base16_eof(c) (c == '>' || c < 0)
+# define base85_eof(c) (c == '~' || c < 0)
+#else
+# define ignored(c) (c == 0x20 || c == 0x0A || c == 0x0D || c == 0x09)
+# define base16_eof(c) (c < 0)
+# define base85_eof(c) (c < 0)
+#endif
+
+#define base64_eof(c) (c == '=' || c < 0)
+
+#define basexx_nl '\x0A'
+//#define put_nl(O, line, maxline, n) ((void)((line += n) > maxline && ((line = n), iof_set(O, basexx_nl)))) // assignment in conditional warning
+#define put_nl(O, line, maxline, n) do { line += n; if (line > maxline) { line = n; iof_set(O, basexx_nl); }} while (0)
+
+/* tail macros */
+
+#define set_tail1(state, c1) (state->left = 1, state->tail[0] = c1)
+#define set_tail2(state, c1, c2) (state->left = 2, state->tail[0] = c1, state->tail[1] = c2)
+#define set_tail3(state, c1, c2, c3) (state->left = 3, state->tail[0] = c1, state->tail[1] = c2, state->tail[2] = c3)
+#define set_tail4(state, c1, c2, c3, c4) (state->left = 4, state->tail[0] = c1, state->tail[1] = c2, state->tail[2] = c3, state->tail[3] = c4)
+#define set_tail5(state, c1, c2, c3, c4, c5) \
+ (state->left = 5, state->tail[0] = c1, state->tail[1] = c2, state->tail[2] = c3, state->tail[3] = c4, state->tail[4] = c5)
+
+#define get_tail1(state, c1) (state->left = 0, c1 = state->tail[0])
+#define get_tail2(state, c1, c2) (state->left = 0, c1 = state->tail[0], c2 = state->tail[1])
+#define get_tail3(state, c1, c2, c3) (state->left = 0, c1 = state->tail[0], c2 = state->tail[1], c3 = state->tail[2])
+#define get_tail4(state, c1, c2, c3, c4) (state->left = 0, c1 = state->tail[0], c2 = state->tail[1], c3 = state->tail[2], c4 = state->tail[3])
+
+/* basexx state initialization */
+
+void basexx_state_init_ln (basexx_state *state, size_t line, size_t maxline)
+{
+ state->line = line;
+ state->maxline = maxline;
+ state->left = 0;
+ state->flush = 0;
+}
+
+/* base 16; xxxx|xxxx */
+
+iof_status base16_encoded_uc (const void *data, size_t size, iof *O)
+{
+ const uint8_t *s, *e;
+ for (s = (const uint8_t *)data, e = s + size; s < e; ++s)
+ {
+ if (!iof_ensure(O, 2))
+ return IOFFULL;
+ iof_set_uc_hex(O, *s);
+ }
+ return IOFEOF;
+}
+
+iof_status base16_encoded_lc (const void *data, size_t size, iof *O)
+{
+ const uint8_t *s, *e;
+ for (s = (const uint8_t *)data, e = s + size; s < e; ++s)
+ {
+ if (!iof_ensure(O, 2))
+ return IOFFULL;
+ iof_set_lc_hex(O, *s);
+ }
+ return IOFEOF;
+}
+
+iof_status base16_encoded_uc_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline)
+{
+ const uint8_t *s, *e;
+ for (s = (const uint8_t *)data, e = s + size; s < e; ++s)
+ {
+ if (!iof_ensure(O, 3))
+ return IOFFULL;
+ put_nl(O, line, maxline, 2);
+ iof_set_uc_hex(O, *s);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encoded_lc_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline)
+{
+ const uint8_t *s, *e;
+ for (s = (const uint8_t *)data, e = s + size; s < e; ++s)
+ {
+ if (!iof_ensure(O, 3))
+ return IOFFULL;
+ put_nl(O, line, maxline, 2);
+ iof_set_lc_hex(O, *s);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_uc (iof *I, iof *O)
+{
+ register int c;
+ while (iof_ensure(O, 2))
+ {
+ if ((c = iof_get(I)) < 0)
+ return IOFEOF;
+ iof_set_uc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_state_uc (iof *I, iof *O, basexx_state *state)
+{
+ register int c;
+ while (iof_ensure(O, 2))
+ {
+ if ((c = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ iof_set_uc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_lc (iof *I, iof *O)
+{
+ register int c;
+ while (iof_ensure(O, 2))
+ {
+ if ((c = iof_get(I)) < 0)
+ return IOFEOF;
+ iof_set_lc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_state_lc (iof *I, iof *O, basexx_state *state)
+{
+ register int c;
+ while (iof_ensure(O, 2))
+ {
+ if ((c = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ iof_set_lc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_uc_ln (iof *I, iof *O, size_t line, size_t maxline)
+{
+ register int c;
+ while (iof_ensure(O, 3))
+ {
+ if ((c = iof_get(I)) < 0)
+ return IOFEOF;
+ put_nl(O, line, maxline, 2);
+ iof_set_uc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_state_uc_ln (iof *I, iof *O, basexx_state *state)
+{
+ register int c;
+ while (iof_ensure(O, 3))
+ {
+ if ((c = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ put_nl(O, state->line, state->maxline, 2);
+ iof_set_uc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_lc_ln (iof *I, iof *O, size_t line, size_t maxline)
+{
+ register int c;
+ while (iof_ensure(O, 3))
+ {
+ if ((c = iof_get(I)) < 0)
+ return IOFEOF;
+ put_nl(O, line, maxline, 2);
+ iof_set_lc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_encode_state_lc_ln (iof *I, iof *O, basexx_state *state)
+{
+ register int c;
+ while (iof_ensure(O, 3))
+ {
+ if ((c = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ put_nl(O, state->line, state->maxline, 2);
+ iof_set_lc_hex(O, c);
+ }
+ return IOFFULL;
+}
+
+int base16_getc (iof *I)
+{
+ register int c1, c2;
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base16_eof(c1))
+ return IOFEOF;
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base16_eof(c2))
+ {
+ if ((c1 = base16_value(c1)) < 0)
+ return IOFERR;
+ return c1<<4;
+ }
+ if ((c1 = base16_value(c1)) < 0 || (c2 = base16_value(c2)) < 0)
+ return IOFERR;
+ return (c1<<4)|c2;
+}
+
+int base16_lc_putc (iof *O, int c)
+{
+ if (iof_ensure(O, 2))
+ iof_set_lc_hex(O, c);
+ return IOFFULL;
+}
+
+int base16_uc_putc (iof *O, int c)
+{
+ if (iof_ensure(O, 2))
+ iof_set_uc_hex(O, c);
+ return IOFFULL;
+}
+
+
+iof_status base16_decode (iof *I, iof *O)
+{
+ register int c1, c2;
+ while (iof_ensure(O, 1))
+ {
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base16_eof(c1))
+ return IOFEOF;
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base16_eof(c2))
+ {
+ if ((c1 = base16_value(c1)) < 0)
+ return IOFERR;
+ iof_set(O, c1<<4); // c2 := '0'
+ return IOFEOF;
+ }
+ if ((c1 = base16_value(c1)) < 0 || (c2 = base16_value(c2)) < 0)
+ return IOFERR;
+ iof_set(O, (c1<<4)|c2);
+ }
+ return IOFFULL;
+}
+
+iof_status base16_decode_state (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, d1, d2;
+ if (!(iof_ensure(O, 1)))
+ return IOFFULL;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ }
+ while (iof_ensure(O, 1))
+ {
+ byte0:
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base16_eof(c1))
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ byte1:
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base16_eof(c2))
+ {
+ set_tail1(state, c1); /* set tail to let the caller display invalid chars */
+ if (state->flush)
+ {
+ if ((c1 = base16_value(c1)) < 0)
+ return IOFERR;
+ iof_set(O, c1<<4); // c2 := '0'
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ if ((d1 = base16_value(c1)) < 0 || (d2 = base16_value(c2)) < 0)
+ {
+ set_tail2(state, c1, c2);
+ return IOFERR;
+ }
+ iof_set(O, (d1<<4)|d2);
+ }
+ return IOFFULL;
+}
+
+/* base 64; xxxxxx|xx xxxx|xxxx xx|xxxxxx */
+
+const char base64_alphabet[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+const int base64_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,62,-1,-1,-1,63,
+ 52,53,54,55,56,57,58,59,60,61,-1,-1,-1,-1,-1,-1,
+ -1, 0, 1, 2, 3, 4, 5, 6, 7, 8,9 ,10,11,12,13,14,
+ 15,16,17,18,19,20,21,22,23,24,25,-1,-1,-1,-1,-1,
+ -1,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
+ 41,42,43,44,45,46,47,48,49,50,51,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+#define base64_value(c) base64_lookup[(uint8_t)(c)]
+
+#define base64_digit1(c1) base64_alphabet[c1>>2]
+#define base64_digit2(c1, c2) base64_alphabet[((c1&3)<<4)|(c2>>4)]
+#define base64_digit3(c2, c3) base64_alphabet[((c2&15)<<2)|(c3>>6)]
+#define base64_digit4(c3) base64_alphabet[c3&63]
+
+#define base64_encode_word(O, c1, c2, c3) \
+ iof_set4(O, base64_digit1(c1), base64_digit2(c1, c2), base64_digit3(c2, c3), base64_digit4(c3))
+
+#define base64_encode_tail2(O, c1, c2) \
+ iof_set3(O, base64_digit1(c1), base64_digit2(c1, c2), base64_digit3(c2, 0))
+
+#define base64_encode_tail1(O, c1) \
+ iof_set2(O, base64_digit1(c1), base64_digit2(c1, 0))
+
+iof_status base64_encoded (const void *data, size_t size, iof *O)
+{
+ const uint8_t *s, *e;
+ uint8_t c1, c2, c3;
+ for (s = (const uint8_t *)data, e = s + size; s + 2 < e; )
+ {
+ if (!iof_ensure(O, 4))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s++;
+ c3 = *s++;
+ base64_encode_word(O, c1, c2, c3);
+ }
+ switch (e - s)
+ {
+ case 0:
+ break;
+ case 1:
+ if (!iof_ensure(O, 2))
+ return IOFFULL;
+ c1 = *s;
+ base64_encode_tail1(O, c1);
+ break;
+ case 2:
+ if (!iof_ensure(O, 3))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s;
+ base64_encode_tail2(O, c1, c2);
+ break;
+ }
+ return IOFEOF;
+}
+
+iof_status base64_encoded_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline)
+{
+ const uint8_t *s, *e;
+ uint8_t c1, c2, c3;
+ for (s = (const uint8_t *)data, e = s + size; s + 2 < e; )
+ {
+ if (!iof_ensure(O, 5))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s++;
+ c3 = *s++;
+ put_nl(O, line, maxline, 4);
+ base64_encode_word(O, c1, c2, c3);
+ }
+ switch (e - s)
+ {
+ case 0:
+ break;
+ case 1:
+ if (!iof_ensure(O, 3))
+ return IOFFULL;
+ c1 = *s;
+ put_nl(O, line, maxline, 2);
+ base64_encode_tail1(O, c1);
+ break;
+ case 2:
+ if (!iof_ensure(O, 4))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s;
+ put_nl(O, line, maxline, 3);
+ base64_encode_tail2(O, c1, c2);
+ break;
+ }
+ return IOFEOF;
+}
+
+iof_status base64_encode (iof *I, iof *O)
+{
+ register int c1, c2, c3;
+ while(iof_ensure(O, 4))
+ {
+ if ((c1 = iof_get(I)) < 0)
+ return IOFEOF;
+ if ((c2 = iof_get(I)) < 0)
+ {
+ base64_encode_tail1(O, c1);
+ return IOFEOF;
+ }
+ if ((c3 = iof_get(I)) < 0)
+ {
+ base64_encode_tail2(O, c1, c2);
+ return IOFEOF;
+ }
+ base64_encode_word(O, c1, c2, c3);
+ }
+ return IOFFULL;
+}
+
+iof_status base64_encode_state (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, c3;
+ if (!(iof_ensure(O, 4)))
+ return IOFFULL;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ case 2: get_tail2(state, c1, c2); goto byte2;
+ }
+ while(iof_ensure(O, 4))
+ {
+ byte0:
+ if ((c1 = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ byte1:
+ if ((c2 = iof_get(I)) < 0)
+ return (state->flush ? (base64_encode_tail1(O, c1), IOFEOF) : (set_tail1(state, c1), IOFEMPTY));
+ byte2:
+ if ((c3 = iof_get(I)) < 0)
+ return (state->flush ? (base64_encode_tail2(O, c1, c2), IOFEOF) : (set_tail2(state, c1, c2), IOFEMPTY));
+ base64_encode_word(O, c1, c2, c3);
+ }
+ return IOFFULL;
+}
+
+iof_status base64_encode_ln (iof *I, iof *O, size_t line, size_t maxline)
+{
+ register int c1, c2, c3;
+ while(iof_ensure(O, 5))
+ {
+ if ((c1 = iof_get(I)) < 0)
+ return IOFEOF;
+ if ((c2 = iof_get(I)) < 0)
+ {
+ put_nl(O, line, maxline, 2);
+ base64_encode_tail1(O, c1);
+ return IOFEOF;
+ }
+ if ((c3 = iof_get(I)) < 0)
+ {
+ put_nl(O, line, maxline, 3);
+ base64_encode_tail2(O, c1, c2);
+ return IOFEOF;
+ }
+ put_nl(O, line, maxline, 4);
+ base64_encode_word(O, c1, c2, c3);
+ }
+ return IOFFULL;
+}
+
+iof_status base64_encode_state_ln (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, c3;
+ if (!(iof_ensure(O, 5)))
+ return IOFFULL;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ case 2: get_tail2(state, c1, c2); goto byte2;
+ }
+ while(iof_ensure(O, 5))
+ {
+ byte0:
+ if ((c1 = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ byte1:
+ if ((c2 = iof_get(I)) < 0)
+ {
+ if (state->flush)
+ {
+ put_nl(O, state->line, state->maxline, 2);
+ base64_encode_tail1(O, c1);
+ return IOFEOF;
+ }
+ set_tail1(state, c1);
+ return IOFEMPTY;
+ }
+ byte2:
+ if ((c3 = iof_get(I)) < 0)
+ {
+ if (state->flush)
+ {
+ put_nl(O, state->line, state->maxline, 3);
+ base64_encode_tail2(O, c1, c2);
+ return IOFEOF;
+ }
+ set_tail2(state, c1, c2);
+ return IOFEMPTY;
+ }
+ put_nl(O, state->line, state->maxline, 4);
+ base64_encode_word(O, c1, c2, c3);
+ }
+ return IOFFULL;
+}
+
+// #define base64_code(c1, c2, c3, c4) ((c1<<18)|(c2<<12)|(c3<<6)|c4)
+
+#define base64_decode_word(O, c1, c2, c3, c4) \
+ iof_set3(O, (c1<<2)|(c2>>4), ((c2&15)<<4)|(c3>>2), ((c3&3)<<6)|c4)
+
+#define base64_decode_tail3(O, c1, c2, c3) \
+ iof_set2(O, (c1<<2)|(c2>>4), ((c2&15)<<4)|(c3>>2))
+
+#define base64_decode_tail2(O, c1, c2) \
+ iof_set(O, (c1<<2)|(c2>>4))
+
+iof_status base64_decode (iof *I, iof *O)
+{
+ register int c1, c2, c3, c4;
+ while(iof_ensure(O, 3))
+ {
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base64_eof(c1))
+ return IOFEOF;
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base64_eof(c2))
+ return IOFERR;
+ do { c3 = iof_get(I); } while (ignored(c3));
+ if (base64_eof(c3))
+ {
+ if ((c1 = base64_value(c1)) < 0 || (c2 = base64_value(c2)) < 0)
+ return IOFERR;
+ base64_decode_tail2(O, c1, c2);
+ return IOFEOF;
+ }
+ do { c4 = iof_get(I); } while (ignored(c4));
+ if (base64_eof(c4))
+ {
+ if ((c1 = base64_value(c1)) < 0 || (c2 = base64_value(c2)) < 0 || (c3 = base64_value(c3)) < 0)
+ return IOFERR;
+ base64_decode_tail3(O, c1, c2, c3);
+ return IOFEOF;
+ }
+ if ((c1 = base64_value(c1)) < 0 || (c2 = base64_value(c2)) < 0 ||
+ (c3 = base64_value(c3)) < 0 || (c4 = base64_value(c4)) < 0)
+ return IOFERR;
+ base64_decode_word(O, c1, c2, c3, c4);
+ }
+ return IOFFULL;
+}
+
+iof_status base64_decode_state (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, c3, c4;
+ register int d1, d2, d3, d4;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ case 2: get_tail2(state, c1, c2); goto byte2;
+ case 3: get_tail3(state, c1, c2, c3); goto byte3;
+ }
+ while(iof_ensure(O, 3))
+ {
+ byte0:
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base64_eof(c1))
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ byte1:
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base64_eof(c2))
+ {
+ set_tail1(state, c1); /* set tail to let the caller make padding or display invalid char in case of error */
+ return (state->flush ? IOFERR : IOFEMPTY); /* if state->flush then error; tail must have at least two bytes */
+ }
+ byte2:
+ do { c3 = iof_get(I); } while (ignored(c3));
+ if (base64_eof(c3))
+ {
+ set_tail2(state, c1, c2);
+ if (state->flush)
+ {
+ if ((c1 = base64_value(c1)) < 0 || (c2 = base64_value(c2)) < 0)
+ return IOFERR;
+ base64_decode_tail2(O, c1, c2);
+ return IOFEOF;
+ }
+ else
+ return IOFEMPTY;
+ }
+ byte3:
+ do { c4 = iof_get(I); } while (ignored(c4));
+ if (base64_eof(c4))
+ {
+ set_tail3(state, c1, c2, c3);
+ if (state->flush)
+ {
+ if ((c1 = base64_value(c1)) < 0 || (c2 = base64_value(c2)) < 0 || (c3 = base64_value(c3)) < 0)
+ return IOFERR;
+ base64_decode_tail3(O, c1, c2, c3);
+ return IOFEOF;
+ }
+ else
+ return IOFEMPTY;
+ }
+ if ((d1 = base64_value(c1)) < 0 || (d2 = base64_value(c2)) < 0 ||
+ (d3 = base64_value(c3)) < 0 || (d4 = base64_value(c4)) < 0)
+ {
+ set_tail4(state, c1, c2, c3, c4);
+ return IOFERR;
+ }
+ base64_decode_word(O, d1, d2, d3, d4);
+ }
+ return IOFFULL;
+}
+
+/* base85 */
+
+const char base85_alphabet[] = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstu"; /* for completness, not used below */
+
+const int base85_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,
+ 15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,
+ 31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,
+ 47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,
+ 63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,
+ 79,80,81,82,83,84,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+#define base85_value(c) base85_lookup[(uint8_t)(c)]
+
+#define base85_encode_word(O, code) \
+ (*(O->pos+4) = '!' + code%85, code /= 85, *(O->pos+3) = '!' + code%85, code /= 85, \
+ *(O->pos+2) = '!' + code%85, code /= 85, *(O->pos+1) = '!' + code%85, code /= 85, \
+ *(O->pos) = '!' + code, \
+ O->pos += 5)
+
+#define base85_encode_tail3(O, code) \
+ (*(O->pos+3) = '!' + code%85, code /= 85, *(O->pos+2) = '!' + code%85, code /= 85, \
+ *(O->pos+1) = '!' + code%85, code /= 85, *(O->pos) = '!' + code, \
+ O->pos += 4)
+
+#define base85_encode_tail2(O, code) \
+ (*(O->pos+2) = '!' + code%85, code /= 85, *(O->pos+1) = '!' + code%85, code /= 85, \
+ *(O->pos) = '!' + code, \
+ O->pos += 3)
+
+#define base85_encode_tail1(O, code) \
+ (*(O->pos+1) = '!' + code%85, code /= 85, *(O->pos) = '!' + code, \
+ O->pos += 2)
+
+iof_status base85_encoded (const void *data, size_t size, iof *O)
+{
+ unsigned int code;
+ const uint8_t *s, *e;
+ uint8_t c1, c2, c3, c4;
+ for (s = (const uint8_t *)data, e = s + size; s + 3 < e; )
+ {
+ if (!iof_ensure(O, 5))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s++;
+ c3 = *s++;
+ c4 = *s++;
+ code = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ if (code == 0)
+ {
+ iof_set(O, 'z');
+ continue;
+ }
+ base85_encode_word(O, code);
+ }
+ switch (e - s)
+ {
+ case 0:
+ break;
+ case 1:
+ if (!iof_ensure(O, 2))
+ return IOFFULL;
+ c1 = *s;
+ code = (c1<<24)/85/85/85;
+ base85_encode_tail1(O, code);
+ break;
+ case 2:
+ if (!iof_ensure(O, 3))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s;
+ code = ((c1<<24)|(c2<<16))/85/85;
+ base85_encode_tail2(O, code);
+ break;
+ case 3:
+ if (!iof_ensure(O, 4))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s++;
+ c3 = *s;
+ code = ((c1<<24)|(c2<<16)|(c3<<8))/85;
+ base85_encode_tail3(O, code);
+ break;
+ }
+ return IOFEOF;
+}
+
+iof_status base85_encoded_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline)
+{
+ unsigned int code;
+ const uint8_t *s, *e;
+ uint8_t c1, c2, c3, c4;
+ for (s = (const uint8_t *)data, e = s + size; s + 3 < e; )
+ {
+ if (!iof_ensure(O, 6))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s++;
+ c3 = *s++;
+ c4 = *s++;
+ code = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ if (code == 0)
+ {
+ put_nl(O, line, maxline, 1);
+ iof_set(O, 'z');
+ continue;
+ }
+ put_nl(O, line, maxline, 5);
+ base85_encode_word(O, code);
+ }
+ switch (e - s)
+ {
+ case 0:
+ break;
+ case 1:
+ if (!iof_ensure(O, 3))
+ return IOFFULL;
+ c1 = *s;
+ code = (c1<<24)/85/85/85;
+ put_nl(O, line, maxline, 2);
+ base85_encode_tail1(O, code);
+ break;
+ case 2:
+ if (!iof_ensure(O, 4))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s;
+ code = ((c1<<24)|(c2<<16))/85/85;
+ put_nl(O, line, maxline, 3);
+ base85_encode_tail2(O, code);
+ break;
+ case 3:
+ if (!iof_ensure(O, 5))
+ return IOFFULL;
+ c1 = *s++;
+ c2 = *s++;
+ c3 = *s;
+ code = ((c1<<24)|(c2<<16)|(c3<<8))/85;
+ put_nl(O, line, maxline, 4);
+ base85_encode_tail3(O, code);
+ break;
+ }
+ return IOFEOF;
+}
+
+iof_status base85_encode (iof *I, iof *O)
+{
+ register int c1, c2, c3, c4;
+ register unsigned int code;
+ while(iof_ensure(O, 5))
+ {
+ if ((c1 = iof_get(I)) < 0)
+ return IOFEOF;
+ if ((c2 = iof_get(I)) < 0)
+ {
+ code = (c1<<24)/85/85/85;
+ base85_encode_tail1(O, code);
+ return IOFEOF;
+ }
+ if ((c3 = iof_get(I)) < 0)
+ {
+ code = ((c1<<24)|(c2<<16))/85/85;
+ base85_encode_tail2(O, code);
+ return IOFEOF;
+ }
+ if ((c4 = iof_get(I)) < 0)
+ {
+ code = ((c1<<24)|(c2<<16)|(c3<<8))/85;
+ base85_encode_tail3(O, code);
+ return IOFEOF;
+ }
+ code = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ if (code == 0)
+ {
+ iof_set(O, 'z');
+ continue;
+ }
+ /* in btoa 'y' character stays for 0x20202020, but pdf does not support this */
+ /* if (code == 0x20202020)
+ {
+ iof_set(O, 'y');
+ continue;
+ } */
+ base85_encode_word(O, code);
+ }
+ return IOFFULL;
+}
+
+iof_status base85_encode_state (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, c3, c4;
+ register unsigned int code;
+ if (!(iof_ensure(O, 5)))
+ return IOFFULL;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ case 2: get_tail2(state, c1, c2); goto byte2;
+ case 3: get_tail3(state, c1, c2, c3); goto byte3;
+ }
+ while(iof_ensure(O, 5))
+ {
+ byte0:
+ if ((c1 = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ byte1:
+ if ((c2 = iof_get(I)) < 0)
+ {
+ set_tail1(state, c1);
+ if (state->flush)
+ {
+ code = (c1<<24)/85/85/85;
+ base85_encode_tail1(O, code);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ byte2:
+ if ((c3 = iof_get(I)) < 0)
+ {
+ set_tail2(state, c1, c2);
+ if (state->flush)
+ {
+ code = ((c1<<24)|(c2<<16))/85/85;
+ base85_encode_tail2(O, code);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ byte3:
+ if ((c4 = iof_get(I)) < 0)
+ {
+ set_tail3(state, c1, c2, c3);
+ if (state->flush)
+ {
+ code = ((c1<<24)|(c2<<16)|(c3<<8))/85;
+ base85_encode_tail3(O, code);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ code = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ if (code == 0)
+ {
+ iof_set(O, 'z');
+ continue;
+ }
+ base85_encode_word(O, code);
+ }
+ return IOFFULL;
+}
+
+iof_status base85_encode_ln (iof *I, iof *O, size_t line, size_t maxline)
+{
+ register int c1, c2, c3, c4;
+ register unsigned int code;
+ while(iof_ensure(O, 6))
+ {
+ if ((c1 = iof_get(I)) < 0)
+ return IOFEOF;
+ if ((c2 = iof_get(I)) < 0)
+ {
+ code = (c1<<24)/85/85/85;
+ put_nl(O, line, maxline, 2);
+ base85_encode_tail1(O, code);
+ return IOFEOF;
+ }
+ if ((c3 = iof_get(I)) < 0)
+ {
+ code = ((c1<<24)|(c2<<16))/85/85;
+ put_nl(O, line, maxline, 3);
+ base85_encode_tail2(O, code);
+ return IOFEOF;
+ }
+ if ((c4 = iof_get(I)) < 0)
+ {
+ code = ((c1<<24)|(c2<<16)|(c3<<8))/85;
+ put_nl(O, line, maxline, 4);
+ base85_encode_tail3(O, code);
+ return IOFEOF;
+ }
+ code = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ if (code == 0)
+ {
+ put_nl(O, line, maxline, 1);
+ iof_set(O, 'z');
+ continue;
+ }
+ put_nl(O, line, maxline, 5);
+ base85_encode_word(O, code);
+ }
+ return IOFFULL;
+}
+
+iof_status base85_encode_state_ln (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, c3, c4;
+ register unsigned int code;
+ if (!(iof_ensure(O, 6)))
+ return IOFFULL;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ case 2: get_tail2(state, c1, c2); goto byte2;
+ case 3: get_tail3(state, c1, c2, c3); goto byte3;
+ }
+ while(iof_ensure(O, 6))
+ {
+ byte0:
+ if ((c1 = iof_get(I)) < 0)
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ byte1:
+ if ((c2 = iof_get(I)) < 0)
+ {
+ set_tail1(state, c1);
+ if (state->flush)
+ {
+ code = (c1<<24)/85/85/85;
+ put_nl(O, state->line, state->maxline, 2);
+ base85_encode_tail1(O, code);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ byte2:
+ if ((c3 = iof_get(I)) < 0)
+ {
+ set_tail2(state, c1, c2);
+ if (state->flush)
+ {
+ code = ((c1<<24)|(c2<<16))/85/85;
+ put_nl(O, state->line, state->maxline, 3);
+ base85_encode_tail2(O, code);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ byte3:
+ if ((c4 = iof_get(I)) < 0)
+ {
+ set_tail3(state, c1, c2, c3);
+ if (state->flush)
+ {
+ code = ((c1<<24)|(c2<<16)|(c3<<8))/85;
+ put_nl(O, state->line, state->maxline, 4);
+ base85_encode_tail3(O, code);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ code = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ if (code == 0)
+ {
+ put_nl(O, state->line, state->maxline, 1);
+ iof_set(O, 'z');
+ continue;
+ }
+ put_nl(O, state->line, state->maxline, 5);
+ base85_encode_word(O, code);
+ }
+ return IOFFULL;
+}
+
+#define base85_code(c1, c2, c3, c4, c5) ((((c1*85+c2)*85+c3)*85+c4)*85+c5)
+
+iof_status base85_decode (iof *I, iof *O)
+{
+ register int c1, c2, c3, c4, c5;
+ register unsigned int code;
+ while (iof_ensure(O, 4))
+ {
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base85_eof(c1))
+ return IOFEOF;
+ switch (c1)
+ {
+ case 'z':
+ iof_set4(O, '\0', '\0', '\0', '\0');
+ continue;
+ case 'y':
+ iof_set4(O, ' ', ' ', ' ', ' ');
+ continue;
+ }
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base85_eof(c2))
+ return IOFERR;
+ do { c3 = iof_get(I); } while (ignored(c3));
+ if (base85_eof(c3))
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, 84, 84, 84); /* padding with 'u' (117); 117-33 = 84 */
+ iof_set(O, code>>24);
+ return IOFEOF;
+ }
+ do { c4 = iof_get(I); } while (ignored(c4));
+ if (base85_eof(c4))
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 || (c3 = base85_value(c3)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, 84, 84);
+ iof_set2(O, code>>24, (code>>16)&255);
+ return IOFEOF;
+ }
+ do { c5 = iof_get(I); } while (ignored(c5));
+ if (base85_eof(c5))
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 ||
+ (c3 = base85_value(c3)) < 0 || (c4 = base85_value(c4)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, c4, 84);
+ iof_set3(O, code>>24, (code>>16)&255, (code>>8)&255);
+ return IOFEOF;
+ }
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 || (c3 = base85_value(c3)) < 0 ||
+ (c4 = base85_value(c4)) < 0 || (c5 = base85_value(c5)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, c4, c5);
+ iof_set4(O, code>>24, (code>>16)&255, (code>>8)&255, code&255);
+ }
+ return IOFFULL;
+}
+
+iof_status base85_decode_state (iof *I, iof *O, basexx_state *state)
+{
+ register int c1, c2, c3, c4, c5;
+ register int d1, d2, d3, d4, d5;
+ register unsigned int code;
+ if (!(iof_ensure(O, 4)))
+ return IOFFULL;
+ switch(state->left)
+ {
+ case 0: goto byte0;
+ case 1: get_tail1(state, c1); goto byte1;
+ case 2: get_tail2(state, c1, c2); goto byte2;
+ case 3: get_tail3(state, c1, c2, c3); goto byte3;
+ case 4: get_tail4(state, c1, c2, c3, c4); goto byte4;
+ }
+ while (iof_ensure(O, 4))
+ {
+ byte0:
+ do { c1 = iof_get(I); } while (ignored(c1));
+ if (base85_eof(c1))
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ switch (c1)
+ {
+ case 'z':
+ iof_set4(O, '\0', '\0', '\0', '\0');
+ continue;
+ case 'y':
+ iof_set4(O, ' ', ' ', ' ', ' ');
+ continue;
+ }
+ byte1:
+ do { c2 = iof_get(I); } while (ignored(c2));
+ if (base85_eof(c2))
+ {
+ set_tail1(state, c1);
+ return (state->flush ? IOFERR : IOFEMPTY); /* if state->flush then error; tail must have at least two bytes */
+ }
+ byte2:
+ do { c3 = iof_get(I); } while (ignored(c3));
+ if (base85_eof(c3))
+ {
+ set_tail2(state, c1, c2);
+ if (state->flush)
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, 84, 84, 84);
+ iof_set(O, code>>24);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ byte3:
+ do { c4 = iof_get(I); } while (ignored(c4));
+ if (base85_eof(c4))
+ {
+ set_tail3(state, c1, c2, c3);
+ if (state->flush)
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 || (c3 = base85_value(c3)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, 84, 84);
+ iof_set2(O, code>>24, (code>>16)&255);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ byte4:
+ do { c5 = iof_get(I); } while (ignored(c5));
+ if (base85_eof(c5))
+ {
+ set_tail4(state, c1, c2, c3, c4);
+ if (state->flush)
+ {
+ if ((c1 = base85_value(c1)) < 0 || (c2 = base85_value(c2)) < 0 ||
+ (c3 = base85_value(c3)) < 0 || (c4 = base85_value(c4)) < 0)
+ return IOFERR;
+ code = base85_code(c1, c2, c3, c4, 84);
+ iof_set3(O, code>>24, (code>>16)&255, (code>>8)&255);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+ }
+ if ((d1 = base85_value(c1)) < 0 || (d2 = base85_value(c2)) < 0 || (d3 = base85_value(c3)) < 0 ||
+ (d4 = base85_value(c4)) < 0 || (d5 = base85_value(c5)) < 0)
+ {
+ set_tail5(state, c1, c2, c3, c4, c5);
+ return IOFERR;
+ }
+ code = base85_code(d1, d2, d3, d4, d5);
+ iof_set4(O, code>>24, (code>>16)&255, (code>>8)&255, code&255);
+ }
+ return IOFFULL;
+}
+
+/* postscript run length */
+
+void runlength_state_init (runlength_state *state)
+{
+ state->run = -1;
+ state->flush = 0;
+ state->c1 = 0;
+ state->c2 = 0;
+ state->pos = NULL;
+}
+
+iof_status runlength_encode (iof *I, iof *O)
+{
+ register int c1, c2, run = -1;
+ uint8_t *pos;
+ c1 = 0, c2 = 0; /* avoid warning */
+ while (iof_ensure(O, 1+128+1))
+ { /* ensured space for single length byte, up to 128 bytes to be copied, possible eod marker */
+ pos = O->pos++;
+ switch (run)
+ {
+ case -1: /* initial state; get first byte */
+ if ((c1 = iof_get(I)) < 0)
+ return (*pos = 128, IOFEOF);
+ run = 0;
+ FALLTHRU // fall through
+ case 0: /* `repeat' state; get another byte and compare */
+ if ((c2 = iof_get(I)) < 0)
+ return (*pos = 0, iof_set2(O, c1, 128), IOFEOF);
+ run = (c1 == c2 ? 257-2 : 0);
+ break;
+ }
+ if (run < 128)
+ { /* single length byte, up to 128 bytes to be copied, possible eod marker */
+ iof_set(O, c1);
+ for (c1 = c2, c2 = iof_char(I); c1 != c2 && run < 127; c1 = c2, c2 = iof_next(I))
+ {
+ if (c2 < 0) /* O->pos must not change until next call to calling encoder!!! */
+ return (*pos = (uint8_t)run+1, iof_set2(O, c1, 128), IOFEOF);
+ iof_set(O, c1);
+ ++run;
+ }
+ }
+ else // if run > 128
+ {
+ for (c2 = iof_get(I); c1 == c2 && run > 129; c2 = iof_get(I))
+ --run;
+ if (c2 < 0)
+ return (*pos = (uint8_t)run, iof_set2(O, c1, 128), IOFEOF);
+ iof_set(O, c1);
+ }
+ *pos = (uint8_t)run;
+ c1 = c2;
+ run = 0;
+ }
+ return IOFFULL;
+}
+
+iof_status runlength_encode_state (iof *I, iof *O, runlength_state *state)
+{
+ while (iof_ensure(O, 3)) /* single length byte, the byte to be repeated and eod */
+ {
+ state->pos = O->pos++;
+ switch (state->run)
+ {
+ case -1: /* initial state; get first byte */
+ if ((state->c1 = iof_get(I)) < 0)
+ return (state->flush ? (*state->pos = 128, IOFEOF) : IOFEMPTY);
+ state->run = 0;
+ FALLTHRU // fall through
+ case 0: /* `repeat' state; get another byte and compare */
+ if ((state->c2 = iof_get(I)) < 0)
+ return (state->flush ? (*state->pos = 0, iof_set2(O, state->c1, 128), IOFEOF) : IOFEMPTY);
+ state->run = (state->c1 == state->c2 ? 257-2 : 0);
+ break;
+ }
+ if (state->run < 128)
+ { /* ensure space for single length byte, up to 128 bytes to be copied, plus possible eod marker, minus those already copied */
+ if (!iof_ensure(O, 1+128+1-state->run))
+ return IOFFULL;
+ iof_set(O, state->c1);
+ for (state->c1 = state->c2, state->c2 = iof_char(I);
+ state->c1 != state->c2 && state->run < 127;
+ state->c1 = state->c2, state->c2 = iof_next(I))
+ {
+ if (state->c2 < 0) /* O->pos must not change until next call to calling encoder!!! */
+ return (state->flush ? (*state->pos = (uint8_t)state->run+1, iof_set2(O, state->c1, 128), IOFEOF) : IOFEMPTY);
+ iof_set(O, state->c1);
+ ++state->run;
+ }
+ }
+ else // if run > 128
+ {
+ for (state->c2 = iof_get(I); state->c1 == state->c2 && state->run > 129; state->c2 = iof_get(I))
+ --state->run;
+ if (state->c2 < 0)
+ return (state->flush ? (*state->pos = (uint8_t)state->run, iof_set2(O, state->c1, 128), IOFEOF) : IOFEMPTY);
+ iof_set(O, state->c1);
+ }
+ *state->pos = (uint8_t)state->run;
+ state->c1 = state->c2;
+ state->run = 0;
+ }
+ return IOFFULL;
+}
+
+iof_status runlength_decode (iof *I, iof *O)
+{
+ register int c, run = -1;
+ while (1)
+ {
+ if (run == -1) /* initial state */
+ {
+ if ((run = iof_get(I)) < 0)
+ {
+ run = -1; /* don't assume IOFEOF == -1 */
+ return IOFEOF;
+ }
+ }
+ if (run < 128)
+ { /* copy (run + 1) following bytes */
+ while (run > -1)
+ {
+ if (iof_ensure(O, 1))
+ {
+ if ((c = iof_get(I)) < 0)
+ return IOFERR;
+ iof_set(O, c);
+ --run;
+ continue;
+ }
+ return IOFFULL;
+ }
+ }
+ else if (run > 128)
+ { /* replicate the following byte (257 - run) times */
+ if ((c = iof_get(I)) < 0) /* cf. state-wise version; don't change input position until we got this byte */
+ return IOFERR;
+ while (run < 257)
+ {
+ if (iof_ensure(O, 1))
+ {
+ iof_set(O, c);
+ ++run;
+ continue;
+ }
+ return IOFFULL;
+ }
+ run = -1;
+ }
+ else // c == 128
+ return IOFEOF;
+ }
+ // return IOFFULL;
+}
+
+iof_status runlength_decode_state (iof *I, iof *O, runlength_state *state)
+{
+ register int c;
+ while (1)
+ {
+ if (state->run == -1) /* initial state */
+ {
+ if ((state->run = iof_char(I)) < 0)
+ {
+ state->run = -1; /* don't assume IOFEOF == -1 */
+ return (state->flush ? IOFEOF : IOFEMPTY);
+ }
+ ++I->pos;
+ }
+ if (state->run < 128)
+ { /* copy (state->run + 1) following bytes */
+ while (state->run > -1)
+ {
+ if (iof_ensure(O, 1))
+ {
+ if ((c = iof_char(I)) < 0)
+ return (state->flush ? IOFERR : IOFEMPTY);
+ ++I->pos;
+ iof_set(O, c);
+ --state->run;
+ continue;
+ }
+ return IOFFULL;
+ }
+ }
+ else if (state->run > 128)
+ { /* replicate the following byte (257 - state->run) times */
+ if ((c = iof_char(I)) < 0)
+ return (state->flush ? IOFERR : IOFEMPTY);
+ ++I->pos;
+ while (state->run < 257)
+ {
+ if (iof_ensure(O, 1))
+ {
+ iof_set(O, c);
+ ++state->run;
+ continue;
+ }
+ return IOFFULL;
+ }
+ state->run = -1;
+ }
+ else // c == 128
+ return IOFEOF;
+ }
+ // return IOFFULL;
+}
+
+/* filters */
+
+// base16 decoder function
+
+static size_t base16_decoder (iof *F, iof_mode mode)
+{
+ basexx_state *state;
+ iof_status status;
+ size_t tail;
+
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ state = iof_filter_state(basexx_state *, F);
+ do {
+ status = base16_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "base16", status);
+ case IOFCLOSE:
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// base16 encoder function
+
+static size_t base16_encoder (iof *F, iof_mode mode)
+{
+ basexx_state *state;
+ iof_status status;
+
+ state = iof_filter_state(basexx_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = base16_encode_state_ln(F, F->next, state);
+ return iof_encoder_retval(F, "base16", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ base16_encoder(F, IOFFLUSH);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// base64 decoder function
+
+static size_t base64_decoder (iof *F, iof_mode mode)
+{
+ basexx_state *state;
+ iof_status status;
+ size_t tail;
+
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ state = iof_filter_state(basexx_state *, F);
+ do {
+ status = base64_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "base64", status);
+ case IOFCLOSE:
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// base64 encoder function
+
+static size_t base64_encoder (iof *F, iof_mode mode)
+{
+ basexx_state *state;
+ iof_status status;
+
+ state = iof_filter_state(basexx_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = base64_encode_state_ln(F, F->next, state);
+ return iof_encoder_retval(F, "base64", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ base64_encoder(F, IOFFLUSH);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// base85 decoder function
+
+static size_t base85_decoder (iof *F, iof_mode mode)
+{
+ basexx_state *state;
+ iof_status status;
+ size_t tail;
+
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ state = iof_filter_state(basexx_state *, F);
+ do {
+ status = base85_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "base85", status);
+ case IOFCLOSE:
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// base85 encoder function
+
+static size_t base85_encoder (iof *F, iof_mode mode)
+{
+ basexx_state *state;
+ iof_status status;
+
+ state = iof_filter_state(basexx_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = base85_encode_state_ln(F, F->next, state);
+ return iof_encoder_retval(F, "base85", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ base85_encoder(F, IOFFLUSH);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// runlength decoder function
+
+static size_t runlength_decoder (iof *F, iof_mode mode)
+{
+ runlength_state *state;
+ iof_status status;
+ size_t tail;
+
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ state = iof_filter_state(runlength_state *, F);
+ do {
+ status = runlength_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "runlength", status);
+ case IOFCLOSE:
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// runlength encoder function
+
+static size_t runlength_encoder (iof *F, iof_mode mode)
+{
+ runlength_state *state;
+ iof_status status;
+
+ state = iof_filter_state(runlength_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = runlength_encode_state(F, F->next, state);
+ return iof_encoder_retval(F, "runlength", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ runlength_encoder(F, IOFFLUSH);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+//
+
+int iof_filter_basexx_encoder_ln (iof *F, size_t line, size_t maxline)
+{
+ basexx_state *state;
+ if (maxline > 8 && line < maxline)
+ {
+ state = iof_filter_state(basexx_state *, F);
+ state->line = line;
+ state->maxline = maxline;
+ return 1;
+ }
+ return 0;
+}
+
+/* base 16 */
+
+iof * iof_filter_base16_decoder (iof *N)
+{
+ iof *I;
+ basexx_state_pointer P;
+ I = iof_filter_reader(base16_decoder, sizeof(basexx_state), &P.voidstate);
+ iof_setup_next(I, N);
+ basexx_state_init(P.basexxstate);
+ P.basexxstate->flush = 1; // means N is supposed to be continuous input
+ return I;
+}
+
+iof * iof_filter_base16_encoder (iof *N)
+{
+ iof *O;
+ basexx_state_pointer P;
+ O = iof_filter_writer(base16_encoder, sizeof(basexx_state), &P.voidstate);
+ iof_setup_next(O, N);
+ basexx_state_init(P.basexxstate);
+ return O;
+}
+
+/* base 64 */
+
+iof * iof_filter_base64_decoder (iof *N)
+{
+ iof *I;
+ basexx_state_pointer P;
+ I = iof_filter_reader(base64_decoder, sizeof(basexx_state), &P.voidstate);
+ iof_setup_next(I, N);
+ basexx_state_init(P.basexxstate);
+ P.basexxstate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_base64_encoder (iof *N)
+{
+ iof *O;
+ basexx_state_pointer P;
+ O = iof_filter_writer(base64_encoder, sizeof(basexx_state), &P.voidstate);
+ iof_setup_next(O, N);
+ basexx_state_init(P.basexxstate);
+ return O;
+}
+
+/* base 85 */
+
+iof * iof_filter_base85_decoder (iof *N)
+{
+ iof *I;
+ basexx_state_pointer P;
+ I = iof_filter_reader(base85_decoder, sizeof(basexx_state), &P.voidstate);
+ iof_setup_next(I, N);
+ basexx_state_init(P.basexxstate);
+ P.basexxstate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_base85_encoder (iof *N)
+{
+ iof *O;
+ basexx_state_pointer P;
+ O = iof_filter_writer(base85_encoder, sizeof(basexx_state), &P.voidstate);
+ iof_setup_next(O, N);
+ basexx_state_init(P.basexxstate);
+ return O;
+}
+
+/* runlength stream filter */
+
+iof * iof_filter_runlength_decoder (iof *N)
+{
+ iof *I;
+ basexx_state_pointer P;
+ I = iof_filter_reader(runlength_decoder, sizeof(runlength_state), &P.voidstate);
+ iof_setup_next(I, N);
+ runlength_state_init(P.runlengthstate);
+ P.runlengthstate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_runlength_encoder (iof *N)
+{
+ iof *O;
+ basexx_state_pointer P;
+ O = iof_filter_writer(runlength_encoder, sizeof(runlength_state), &P.voidstate);
+ iof_setup_next(O, N);
+ runlength_state_init(P.runlengthstate);
+ return O;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilbasexx.h b/source/luametatex/source/libraries/pplib/util/utilbasexx.h
new file mode 100644
index 000000000..81891b549
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilbasexx.h
@@ -0,0 +1,111 @@
+
+/* base encodings */
+
+#ifndef UTIL_BASEXX_H
+#define UTIL_BASEXX_H
+
+#include "utiliof.h"
+
+/* base codecs state */
+
+typedef struct basexx_state basexx_state;
+
+#define BASEXX_MAXLINE 80
+#define BASEXX_PDF
+
+void basexx_state_init_ln (basexx_state *state, size_t line, size_t maxline);
+#define basexx_state_init(state) basexx_state_init_ln(state, 0, BASEXX_MAXLINE)
+
+/* base16 */
+
+int base16_getc (iof *I);
+int base16_uc_putc (iof *I, int c);
+int base16_lc_putc (iof *I, int c);
+#define base16_putc base16_uc_putc
+
+iof_status base16_encoded_uc (const void *data, size_t size, iof *O);
+iof_status base16_encoded_lc (const void *data, size_t size, iof *O);
+iof_status base16_encoded_uc_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline);
+iof_status base16_encoded_lc_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline);
+
+iof_status base16_encode_uc (iof *I, iof *O);
+iof_status base16_encode_lc (iof *I, iof *O);
+iof_status base16_encode_uc_ln (iof *I, iof *O, size_t line, size_t maxline);
+iof_status base16_encode_lc_ln (iof *I, iof *O, size_t line, size_t maxline);
+iof_status base16_decode (iof *I, iof *O);
+
+#define base16_encoded base16_encoded_uc
+#define base16_encoded_ln base16_encoded_uc_ln
+#define base16_encode base16_encode_uc
+#define base16_encode_ln base16_encode_uc_ln
+
+iof_status base16_encode_state_uc (iof *I, iof *O, basexx_state *state);
+iof_status base16_encode_state_lc (iof *I, iof *O, basexx_state *state);
+iof_status base16_encode_state_uc_ln (iof *I, iof *O, basexx_state *state);
+iof_status base16_encode_state_lc_ln (iof *I, iof *O, basexx_state *state);
+iof_status base16_decode_state (iof *I, iof *O, basexx_state *state);
+
+#define base16_encode_state base16_encode_state_uc
+#define base16_encode_state_ln base16_encode_state_uc_ln
+
+/* base64 */
+
+extern const char base64_alphabet[];
+extern const int base64_lookup[];
+
+iof_status base64_encoded (const void *data, size_t size, iof *O);
+iof_status base64_encoded_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline);
+
+iof_status base64_encode (iof *I, iof *O);
+iof_status base64_encode_ln (iof *I, iof *O, size_t line, size_t maxline);
+iof_status base64_decode (iof *I, iof *O);
+
+iof_status base64_encode_state (iof *I, iof *O, basexx_state *state);
+iof_status base64_encode_state_ln (iof *I, iof *O, basexx_state *state);
+iof_status base64_decode_state (iof *I, iof *O, basexx_state *state);
+
+/* base85 */
+
+extern const char base85_alphabet[];
+extern const int base85_lookup[];
+
+iof_status base85_encoded (const void *data, size_t size, iof *O);
+iof_status base85_encoded_ln (const void *data, size_t size, iof *O, size_t line, size_t maxline);
+
+iof_status base85_encode (iof *I, iof *O);
+iof_status base85_encode_ln (iof *I, iof *O, size_t line, size_t maxline);
+iof_status base85_decode (iof *I, iof *O);
+
+iof_status base85_encode_state (iof *I, iof *O, basexx_state *state);
+iof_status base85_encode_state_ln (iof *I, iof *O, basexx_state *state);
+iof_status base85_decode_state (iof *I, iof *O, basexx_state *state);
+
+/* run length */
+
+typedef struct runlength_state runlength_state;
+
+void runlength_state_init (runlength_state *state);
+
+iof_status runlength_encode (iof *I, iof *O);
+iof_status runlength_encode_state (iof *I, iof *O, runlength_state *state);
+
+iof_status runlength_decode (iof *I, iof *O);
+iof_status runlength_decode_state (iof *I, iof *O, runlength_state *state);
+
+/* filters */
+
+int iof_filter_basexx_encoder_ln (iof *N, size_t line, size_t maxline);
+
+iof * iof_filter_base16_decoder (iof *N);
+iof * iof_filter_base16_encoder (iof *N);
+
+iof * iof_filter_base64_decoder (iof *N);
+iof * iof_filter_base64_encoder (iof *N);
+
+iof * iof_filter_base85_decoder (iof *N);
+iof * iof_filter_base85_encoder (iof *N);
+
+iof * iof_filter_runlength_decoder (iof *N);
+iof * iof_filter_runlength_encoder (iof *N);
+
+#endif
diff --git a/source/luametatex/source/libraries/pplib/util/utilcrypt.c b/source/luametatex/source/libraries/pplib/util/utilcrypt.c
new file mode 100644
index 000000000..2c77e42a4
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilcrypt.c
@@ -0,0 +1,1190 @@
+
+#include "utilmem.h"
+#include "utilcrypt.h"
+#include "utilcryptdef.h"
+#include "utilmd5.h"
+
+/* rc4 */
+
+/*
+Initializer arguments:
+- state - crypt state
+- map - a space for rc4 bytes map; may be left NULL in which case will be allocated
+- vkey - crypt key; may be left NULL iff map is provided and properly initialized
+- keylength - the length of crypt key (from 5 to 16 bytes)
+*/
+
+rc4_state * rc4_state_initialize (rc4_state *state, rc4_map *map, const void *vkey, size_t keylength)
+{
+ int i, j;
+ uint8_t tmp;
+ const uint8_t *key;
+ key = (const uint8_t *)vkey;
+ if (keylength == 0 || keylength > 256)
+ return NULL;
+ state->flags = 0;
+ if (map != NULL)
+ {
+ state->map = map;
+ }
+ else
+ {
+ state->map = (rc4_map *)util_malloc(sizeof(rc4_map));
+ state->flags |= RC4_STATE_ALLOC;
+ }
+
+ if (key != NULL)
+ {
+ for (i = 0; i < 256; ++i)
+ state->smap[i] = (uint8_t)i;
+ for (i = 0, j = 0; i < 256; ++i)
+ {
+ j = (j + state->smap[i] + key[i % keylength]) & 255;
+ tmp = state->smap[i];
+ state->smap[i] = state->smap[j];
+ state->smap[j] = tmp;
+ }
+ }
+ state->i = 0;
+ state->j = 0;
+ state->flush = 0; /* caller is responsible to override if necessary */
+ return state;
+}
+
+void rc4_map_save (rc4_state *state, rc4_map *map)
+{
+ memcpy(map, state->map, sizeof(rc4_map));
+}
+
+void rc4_map_restore (rc4_state *state, rc4_map *map)
+{
+ memcpy(state->map, map, sizeof(rc4_map));
+ //state->flags = 0;
+ //state->flush = 0;
+ state->i = 0;
+ state->j = 0;
+}
+
+static uint8_t rc4_next_random_byte (rc4_state *state)
+{
+ uint8_t tmp;
+ state->i = (state->i + 1) & 255;
+ state->j = (state->j + state->smap[state->i]) & 255;
+ tmp = state->smap[state->i];
+ state->smap[state->i] = state->smap[state->j];
+ state->smap[state->j] = tmp;
+ return state->smap[(state->smap[state->i] + state->smap[state->j]) & 255];
+}
+
+iof_status rc4_crypt_state (iof *I, iof *O, rc4_state *state)
+{
+ uint8_t r;
+ int c;
+ while (iof_ensure(O, 1))
+ {
+ if ((c = iof_get(I)) < 0)
+ return c == IOFERR ? IOFERR : (state->flush ? IOFEOF : IOFEMPTY);
+ r = rc4_next_random_byte(state);
+ //r = r ^ ((uint8_t)c);
+ //iof_set(O, r);
+ iof_set(O, r ^ ((uint8_t)c));
+ }
+ return IOFFULL;
+}
+
+iof_status rc4_crypt (iof *I, iof *O, const void *key, size_t keylength)
+{
+ int ret;
+ rc4_state state;
+ rc4_map map;
+ if (rc4_state_initialize(&state, &map, key, keylength) == NULL)
+ return IOFERR;
+ state.flush = 1;
+ ret = rc4_crypt_state(I, O, &state);
+ rc4_state_close(&state);
+ return ret;
+}
+
+/*
+Variants that operates on c-strings can worn inplace, so output and input can be the same address.
+Variant that takes rc4_state pointer expects the state properly initialized. Keep in mind
+the crypt procedure modifies rc4 bytes map. All returns the size of encrypted/decrypted
+data, which is the same as input data length for rc4.
+*/
+
+size_t rc4_crypt_data (const void *input, size_t length, void *output, const void *key, size_t keylength)
+{
+ rc4_state state;
+ rc4_map map;
+ if (rc4_state_initialize(&state, &map, key, keylength) == NULL)
+ return 0;
+ return rc4_crypt_state_data(&state, input, length, output);
+ // no need to call rc4_state_close()
+}
+
+size_t rc4_crypt_state_data (rc4_state *state, const void *input, size_t length, void *output)
+{ /* state assumed to be initialized and with the proper state of smap */
+ const uint8_t *inp;
+ uint8_t r, *out;
+ size_t size;
+ inp = (const uint8_t *)input;
+ out = (uint8_t *)output;
+ for (size = 0; size < length; ++size, ++inp, ++out)
+ {
+ r = rc4_next_random_byte(state);
+ *out = r ^ *inp;
+ }
+ return length;
+}
+
+void rc4_state_close (rc4_state *state)
+{
+ if (state->smap != NULL && (state->flags & RC4_STATE_ALLOC))
+ {
+ util_free(state->smap);
+ state->smap = NULL;
+ }
+}
+
+/* aes; parts of code excerpted from https://github.com/kokke/tiny-AES128-C */
+
+static const uint8_t sbox[256] = {
+ 0x63, 0x7c, 0x77, 0x7b, 0xf2, 0x6b, 0x6f, 0xc5, 0x30, 0x01, 0x67, 0x2b, 0xfe, 0xd7, 0xab, 0x76,
+ 0xca, 0x82, 0xc9, 0x7d, 0xfa, 0x59, 0x47, 0xf0, 0xad, 0xd4, 0xa2, 0xaf, 0x9c, 0xa4, 0x72, 0xc0,
+ 0xb7, 0xfd, 0x93, 0x26, 0x36, 0x3f, 0xf7, 0xcc, 0x34, 0xa5, 0xe5, 0xf1, 0x71, 0xd8, 0x31, 0x15,
+ 0x04, 0xc7, 0x23, 0xc3, 0x18, 0x96, 0x05, 0x9a, 0x07, 0x12, 0x80, 0xe2, 0xeb, 0x27, 0xb2, 0x75,
+ 0x09, 0x83, 0x2c, 0x1a, 0x1b, 0x6e, 0x5a, 0xa0, 0x52, 0x3b, 0xd6, 0xb3, 0x29, 0xe3, 0x2f, 0x84,
+ 0x53, 0xd1, 0x00, 0xed, 0x20, 0xfc, 0xb1, 0x5b, 0x6a, 0xcb, 0xbe, 0x39, 0x4a, 0x4c, 0x58, 0xcf,
+ 0xd0, 0xef, 0xaa, 0xfb, 0x43, 0x4d, 0x33, 0x85, 0x45, 0xf9, 0x02, 0x7f, 0x50, 0x3c, 0x9f, 0xa8,
+ 0x51, 0xa3, 0x40, 0x8f, 0x92, 0x9d, 0x38, 0xf5, 0xbc, 0xb6, 0xda, 0x21, 0x10, 0xff, 0xf3, 0xd2,
+ 0xcd, 0x0c, 0x13, 0xec, 0x5f, 0x97, 0x44, 0x17, 0xc4, 0xa7, 0x7e, 0x3d, 0x64, 0x5d, 0x19, 0x73,
+ 0x60, 0x81, 0x4f, 0xdc, 0x22, 0x2a, 0x90, 0x88, 0x46, 0xee, 0xb8, 0x14, 0xde, 0x5e, 0x0b, 0xdb,
+ 0xe0, 0x32, 0x3a, 0x0a, 0x49, 0x06, 0x24, 0x5c, 0xc2, 0xd3, 0xac, 0x62, 0x91, 0x95, 0xe4, 0x79,
+ 0xe7, 0xc8, 0x37, 0x6d, 0x8d, 0xd5, 0x4e, 0xa9, 0x6c, 0x56, 0xf4, 0xea, 0x65, 0x7a, 0xae, 0x08,
+ 0xba, 0x78, 0x25, 0x2e, 0x1c, 0xa6, 0xb4, 0xc6, 0xe8, 0xdd, 0x74, 0x1f, 0x4b, 0xbd, 0x8b, 0x8a,
+ 0x70, 0x3e, 0xb5, 0x66, 0x48, 0x03, 0xf6, 0x0e, 0x61, 0x35, 0x57, 0xb9, 0x86, 0xc1, 0x1d, 0x9e,
+ 0xe1, 0xf8, 0x98, 0x11, 0x69, 0xd9, 0x8e, 0x94, 0x9b, 0x1e, 0x87, 0xe9, 0xce, 0x55, 0x28, 0xdf,
+ 0x8c, 0xa1, 0x89, 0x0d, 0xbf, 0xe6, 0x42, 0x68, 0x41, 0x99, 0x2d, 0x0f, 0xb0, 0x54, 0xbb, 0x16 };
+
+static const uint8_t rsbox[256] =
+{ 0x52, 0x09, 0x6a, 0xd5, 0x30, 0x36, 0xa5, 0x38, 0xbf, 0x40, 0xa3, 0x9e, 0x81, 0xf3, 0xd7, 0xfb,
+ 0x7c, 0xe3, 0x39, 0x82, 0x9b, 0x2f, 0xff, 0x87, 0x34, 0x8e, 0x43, 0x44, 0xc4, 0xde, 0xe9, 0xcb,
+ 0x54, 0x7b, 0x94, 0x32, 0xa6, 0xc2, 0x23, 0x3d, 0xee, 0x4c, 0x95, 0x0b, 0x42, 0xfa, 0xc3, 0x4e,
+ 0x08, 0x2e, 0xa1, 0x66, 0x28, 0xd9, 0x24, 0xb2, 0x76, 0x5b, 0xa2, 0x49, 0x6d, 0x8b, 0xd1, 0x25,
+ 0x72, 0xf8, 0xf6, 0x64, 0x86, 0x68, 0x98, 0x16, 0xd4, 0xa4, 0x5c, 0xcc, 0x5d, 0x65, 0xb6, 0x92,
+ 0x6c, 0x70, 0x48, 0x50, 0xfd, 0xed, 0xb9, 0xda, 0x5e, 0x15, 0x46, 0x57, 0xa7, 0x8d, 0x9d, 0x84,
+ 0x90, 0xd8, 0xab, 0x00, 0x8c, 0xbc, 0xd3, 0x0a, 0xf7, 0xe4, 0x58, 0x05, 0xb8, 0xb3, 0x45, 0x06,
+ 0xd0, 0x2c, 0x1e, 0x8f, 0xca, 0x3f, 0x0f, 0x02, 0xc1, 0xaf, 0xbd, 0x03, 0x01, 0x13, 0x8a, 0x6b,
+ 0x3a, 0x91, 0x11, 0x41, 0x4f, 0x67, 0xdc, 0xea, 0x97, 0xf2, 0xcf, 0xce, 0xf0, 0xb4, 0xe6, 0x73,
+ 0x96, 0xac, 0x74, 0x22, 0xe7, 0xad, 0x35, 0x85, 0xe2, 0xf9, 0x37, 0xe8, 0x1c, 0x75, 0xdf, 0x6e,
+ 0x47, 0xf1, 0x1a, 0x71, 0x1d, 0x29, 0xc5, 0x89, 0x6f, 0xb7, 0x62, 0x0e, 0xaa, 0x18, 0xbe, 0x1b,
+ 0xfc, 0x56, 0x3e, 0x4b, 0xc6, 0xd2, 0x79, 0x20, 0x9a, 0xdb, 0xc0, 0xfe, 0x78, 0xcd, 0x5a, 0xf4,
+ 0x1f, 0xdd, 0xa8, 0x33, 0x88, 0x07, 0xc7, 0x31, 0xb1, 0x12, 0x10, 0x59, 0x27, 0x80, 0xec, 0x5f,
+ 0x60, 0x51, 0x7f, 0xa9, 0x19, 0xb5, 0x4a, 0x0d, 0x2d, 0xe5, 0x7a, 0x9f, 0x93, 0xc9, 0x9c, 0xef,
+ 0xa0, 0xe0, 0x3b, 0x4d, 0xae, 0x2a, 0xf5, 0xb0, 0xc8, 0xeb, 0xbb, 0x3c, 0x83, 0x53, 0x99, 0x61,
+ 0x17, 0x2b, 0x04, 0x7e, 0xba, 0x77, 0xd6, 0x26, 0xe1, 0x69, 0x14, 0x63, 0x55, 0x21, 0x0c, 0x7d };
+
+/*
+The round constant word array, rcon[i], contains the values given by
+x to th e power (i-1) being powers of x (x is denoted as {02}) in the field GF(2^8)
+Note that i starts at 1, not 0).
+*/
+
+static const uint8_t rcon[255] = {
+ 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a,
+ 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39,
+ 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a,
+ 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8,
+ 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef,
+ 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc,
+ 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b,
+ 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3,
+ 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94,
+ 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20,
+ 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35,
+ 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f,
+ 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04,
+ 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63,
+ 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd,
+ 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb };
+
+/* block copying */
+
+#define aes_copy_block(output, input) memcpy(output, input, 16)
+
+static void aes_copy_cbc (uint8_t *data, const uint8_t *input)
+{
+ uint8_t i;
+ for (i = 0; i < 16; ++i)
+ data[i] ^= input[i];
+}
+
+static void aes_copy_xor (uint8_t *data, const uint8_t *input, const uint8_t *iv)
+{
+ uint8_t i;
+ for (i = 0; i < 16; ++i)
+ data[i] = input[i] ^ iv[i];
+}
+
+/* key expansion */
+
+#define AES_COLUMNS 4 // constant in aes
+
+static void key_expansion (aes_state *state, const uint8_t *key)
+{
+ uint32_t i, j;
+ uint8_t t[4], temp;
+ uint8_t *keydata, keywords, columns;
+
+ keywords = (uint8_t)(state->keylength >> 2);
+ keydata = (uint8_t *)state->keyblock;
+
+ /* the first round key is the key itself */
+ for(i = 0; i < keywords; ++i)
+ {
+ keydata[(i * 4) + 0] = key[(i * 4) + 0];
+ keydata[(i * 4) + 1] = key[(i * 4) + 1];
+ keydata[(i * 4) + 2] = key[(i * 4) + 2];
+ keydata[(i * 4) + 3] = key[(i * 4) + 3];
+ }
+
+ /* others derived from the first */
+ for(columns = AES_COLUMNS * (state->rounds + 1); i < columns; ++i)
+ {
+ for(j = 0; j < 4; ++j)
+ t[j] = keydata[(i - 1) * 4 + j];
+ if (i % keywords == 0)
+ {
+ /* rotate the 4 bytes in a word to the left once; [a0,a1,a2,a3] becomes [a1,a2,a3,a0] */
+ temp = t[0];
+ t[0] = t[1];
+ t[1] = t[2];
+ t[2] = t[3];
+ t[3] = temp;
+
+ /* take a four-byte input word and apply the S-box to each of the four bytes to produce an output word */
+ t[0] = sbox[t[0]];
+ t[1] = sbox[t[1]];
+ t[2] = sbox[t[2]];
+ t[3] = sbox[t[3]];
+
+ t[0] = t[0] ^ rcon[i / keywords];
+ }
+ else if (keywords > 6 && i % keywords == 4)
+ {
+ t[0] = sbox[t[0]];
+ t[1] = sbox[t[1]];
+ t[2] = sbox[t[2]];
+ t[3] = sbox[t[3]];
+ }
+ keydata[i * 4 + 0] = keydata[(i - keywords) * 4 + 0] ^ t[0];
+ keydata[i * 4 + 1] = keydata[(i - keywords) * 4 + 1] ^ t[1];
+ keydata[i * 4 + 2] = keydata[(i - keywords) * 4 + 2] ^ t[2];
+ keydata[i * 4 + 3] = keydata[(i - keywords) * 4 + 3] ^ t[3];
+ }
+
+}
+
+/*
+An original implementation uses no private buffers except a keyblock. We need private buffers to
+keep a CBC vector between calls and to be able to read input data not necessarily in 16-bytes blocks.
+Encrypter would actually require only one such buffer, as CBC vector is applied on input data before
+the actual cipher procedure. And CBC for the next chunk is simply the output from the previous.
+Decrypter, however, applies the cipher first, then applies CBC to the output with a buffered init
+vector, and the vector for the next call is the row input before cipher. Hence we need two 16-bytes
+buffers for decrypter.
+*/
+
+/*
+aes_state * aes_state_initialize_ecb (aes_state *State, uint8_t *keyblock, const uint8_t *key)
+{
+ state->flags = 0;
+
+ state->flags |= AES_ECB_MODE;
+
+ if (keyblock == NULL)
+ {
+ keyblock = util_malloc(sizeof(aes_keyblock));
+ state->flags |= AES_STATE_ALLOC;
+ }
+ state->keyblock = keyblock;
+ key_expansion(state, key);
+ state->flush = 0;
+ return state;
+}
+*/
+
+void aes_pdf_mode (aes_state *state)
+{
+ state->flags |= AES_INLINE_IV;
+ state->flags &= ~AES_NULL_PADDING;
+}
+
+/*
+Initialize arguments:
+- state - crypt state
+- keyblock - a space for aes key expansion; can be left NULL in which case will be allocated
+- key - crypt key; can be left NULL iff keyblock is given and properly initialized
+- keylength - the length of the key (16 or 32 bytes)
+- iv - 16-bytes CBC initialization vector;
+ - if left NULL for encoder, one is generated and stored as state->iv
+ - can also be left NULL for decorer, but then AES_INLINE_IV must be set, as this informs decoder to take
+ an initialization vector from the beginning of the encrypted stream
+
+At the first approach, an initialization vector was copied to state block during initialization and encoders
+assumed that the state block is the current initialization vector. This simplifies encrypting procedure,
+as the output from every 16-bytes chunk encryption is an initialization vector for the next chunk. However,
+it makes api usage cumbersome, as the user has to know that iv may need to be copied to state block
+before each call.
+*/
+
+static int aes_key_length (aes_state *state, size_t keylength)
+{
+ state->keylength = keylength;
+ switch (keylength)
+ {
+ case 16:
+ state->rounds = 10;
+ break;
+ case 24:
+ state->rounds = 12;
+ break;
+ case 32:
+ state->rounds = 14;
+ break;
+ default:
+ return 0;
+ }
+ return 1;
+}
+
+aes_state * aes_encode_initialize (aes_state *state, aes_keyblock *keyblock, const void *key, size_t keylength, const void *iv)
+{
+ state->flags = 0;
+ if (!aes_key_length(state, keylength))
+ return NULL;
+ if (iv != NULL)
+ aes_copy_block(state->iv, iv);
+ else
+ aes_generate_iv(state->iv);
+ state->flags |= AES_HAS_IV;
+
+ if (keyblock == NULL)
+ {
+ keyblock = (aes_keyblock *)util_malloc(sizeof(aes_keyblock));
+ state->flags |= AES_STATE_ALLOC;
+ }
+ state->keyblock = keyblock;
+ if (key != NULL) /* if NULL we assume keyblock is given and already expanded */
+ key_expansion(state, (const uint8_t *)key);
+ state->flush = 0;
+ return state;
+}
+
+aes_state * aes_decode_initialize (aes_state *state, aes_keyblock *keyblock, const void *key, size_t keylength, const void *iv)
+{
+ state->flags = 0;
+ if (!aes_key_length(state, keylength))
+ return NULL;
+ if (iv != NULL)
+ {
+ aes_copy_block(state->iv, iv);
+ state->flags |= AES_HAS_IV;
+ }
+ /* else if AES_INLINE_IV flag is set will be read from input */
+
+ if (keyblock == NULL)
+ {
+ keyblock = (aes_keyblock *)util_malloc(sizeof(aes_keyblock));
+ state->flags |= AES_STATE_ALLOC;
+ }
+ state->keyblock = keyblock;
+ if (key != NULL) /* otherwise keyblock is assumed present and properly initialized */
+ key_expansion(state, (const uint8_t *)key);
+ state->flush = 0;
+ return state;
+}
+
+void aes_state_close (aes_state *state)
+{
+ if (state->keyblock != NULL && (state->flags & AES_STATE_ALLOC))
+ util_free(state->keyblock);
+}
+
+/* add round key */
+
+static void aes_round_key (aes_block block, aes_block keyblock)
+{
+ uint8_t i, j;
+ for(i = 0; i < 4; ++i)
+ for(j = 0; j < 4; ++j)
+ block[i][j] ^= keyblock[i][j];
+}
+
+#define aes_add_key(block, keyblock, round) aes_round_key(block, (*keyblock)[round])
+
+/* substitution */
+
+static void aes_encode_sub (aes_block block)
+{
+ uint8_t i, j, v;
+ for(i = 0; i < 4; ++i)
+ for(j = 0; j < 4; ++j)
+ v = block[i][j], block[i][j] = sbox[v];
+}
+
+/* rows shift; the row index is the shift offset, the first order is not shifted */
+
+static void aes_encode_shift (aes_block block)
+{
+ uint8_t tmp;
+
+ /* 1st row rotated once */
+ tmp = block[0][1];
+ block[0][1] = block[1][1];
+ block[1][1] = block[2][1];
+ block[2][1] = block[3][1];
+ block[3][1] = tmp;
+
+ /* 2nd row rotated twice */
+ tmp = block[0][2];
+ block[0][2] = block[2][2];
+ block[2][2] = tmp;
+ tmp = block[1][2];
+ block[1][2] = block[3][2];
+ block[3][2] = tmp;
+
+ /* 3rd row rotated 3 times */
+ tmp = block[0][3];
+ block[0][3] = block[3][3];
+ block[3][3] = block[2][3];
+ block[2][3] = block[1][3];
+ block[1][3] = tmp;
+}
+
+static uint8_t xtime (uint8_t x)
+{
+ return ((x << 1) ^ (((x >> 7) & 1) * 0x1b));
+}
+
+/* mix columns */
+
+static void aes_encode_mix (aes_block block)
+{
+ uint8_t i, tmp, tm, t;
+
+ for(i = 0; i < 4; ++i)
+ {
+ t = block[i][0];
+ tmp = block[i][0] ^ block[i][1] ^ block[i][2] ^ block[i][3] ;
+ tm = block[i][0] ^ block[i][1]; tm = xtime(tm); block[i][0] ^= tm ^ tmp;
+ tm = block[i][1] ^ block[i][2]; tm = xtime(tm); block[i][1] ^= tm ^ tmp;
+ tm = block[i][2] ^ block[i][3]; tm = xtime(tm); block[i][2] ^= tm ^ tmp;
+ tm = block[i][3] ^ t ; tm = xtime(tm); block[i][3] ^= tm ^ tmp;
+ }
+}
+
+/* multiply is used to multiply numbers in the field GF(2^8) */
+
+#define multiply(x, y) \
+ ( ((y & 1) * x) ^ \
+ ((y>>1 & 1) * xtime(x)) ^ \
+ ((y>>2 & 1) * xtime(xtime(x))) ^ \
+ ((y>>3 & 1) * xtime(xtime(xtime(x)))) ^ \
+ ((y>>4 & 1) * xtime(xtime(xtime(xtime(x)))))) \
+
+/* mix columns */
+
+static void aes_decode_mix (aes_block block)
+{
+ int i;
+ uint8_t a, b, c, d;
+
+ for(i = 0; i < 4; ++i)
+ {
+ a = block[i][0];
+ b = block[i][1];
+ c = block[i][2];
+ d = block[i][3];
+ block[i][0] = multiply(a, 0x0e) ^ multiply(b, 0x0b) ^ multiply(c, 0x0d) ^ multiply(d, 0x09);
+ block[i][1] = multiply(a, 0x09) ^ multiply(b, 0x0e) ^ multiply(c, 0x0b) ^ multiply(d, 0x0d);
+ block[i][2] = multiply(a, 0x0d) ^ multiply(b, 0x09) ^ multiply(c, 0x0e) ^ multiply(d, 0x0b);
+ block[i][3] = multiply(a, 0x0b) ^ multiply(b, 0x0d) ^ multiply(c, 0x09) ^ multiply(d, 0x0e);
+ }
+}
+
+/* inverse substitution */
+
+static void aes_decode_sub (aes_block block)
+{
+ uint8_t i, j, v;
+ for(i = 0; i < 4; ++i)
+ for(j = 0; j < 4; ++j)
+ v = block[i][j], block[i][j] = rsbox[v];
+}
+
+/* inverse shift rows */
+
+static void aes_decode_shift (aes_block block)
+{
+ uint8_t tmp;
+
+ /* 1st row rotated once right */
+ tmp = block[3][1];
+ block[3][1] = block[2][1];
+ block[2][1] = block[1][1];
+ block[1][1] = block[0][1];
+ block[0][1] = tmp;
+
+ /* 2st row rotated twice right */
+ tmp = block[0][2];
+ block[0][2] = block[2][2];
+ block[2][2] = tmp;
+ tmp = block[1][2];
+ block[1][2] = block[3][2];
+ block[3][2] = tmp;
+
+ /* 3rd row rotated 3 times right */
+ tmp = block[0][3];
+ block[0][3] = block[1][3];
+ block[1][3] = block[2][3];
+ block[2][3] = block[3][3];
+ block[3][3] = tmp;
+}
+
+/* aes block encoder */
+
+static void aes_encode_cipher (aes_state *state)
+{
+ uint8_t round;
+ aes_add_key(state->block, state->keyblock, 0);
+ for (round = 1; round < state->rounds; ++round)
+ {
+ aes_encode_sub(state->block);
+ aes_encode_shift(state->block);
+ aes_encode_mix(state->block);
+ aes_add_key(state->block, state->keyblock, round);
+ }
+ aes_encode_sub(state->block);
+ aes_encode_shift(state->block);
+ aes_add_key(state->block, state->keyblock, state->rounds);
+}
+
+/* aes block decoder */
+
+static void aes_decode_cipher (aes_state *state)
+{
+ uint8_t round;
+ aes_add_key(state->block, state->keyblock, state->rounds);
+ for(round = state->rounds - 1; round > 0; --round)
+ {
+ aes_decode_shift(state->block);
+ aes_decode_sub(state->block);
+ aes_add_key(state->block, state->keyblock, round);
+ aes_decode_mix(state->block);
+ }
+ aes_decode_shift(state->block);
+ aes_decode_sub(state->block);
+ aes_add_key(state->block, state->keyblock, 0);
+}
+
+/* tail block padding; RFC 2898, PKCS #5: Password-Based Cryptography Specification Version 2.0; pdf spec p. 119 */
+
+#define aes_padding(state) ((state->flags & AES_NULL_PADDING) == 0)
+
+static void aes_put_padding (aes_state *state, uint8_t length)
+{
+ uint8_t pad;
+ pad = (aes_padding(state)) ? 16 - length : 0;
+ for (; length < 16; ++length)
+ state->data[length] = state->iv[length] ^ pad;
+}
+
+static int aes_remove_padding (aes_state *state, uint8_t *data, uint8_t *length)
+{
+ uint8_t pad;
+ *length = 16; /* block length 16 means leave intact */
+ if (aes_padding(state))
+ {
+ pad = data[16 - 1];
+ if (pad > 16)
+ return IOFERR;
+ for ( ; *length > 16 - pad; --(*length))
+ if (data[*length - 1] != pad)
+ return IOFERR;
+ }
+ else
+ {
+ for ( ; *length > 0; --(*length))
+ if (data[*length - 1] != '\0')
+ break;
+ }
+ return IOFEOF;
+}
+
+/* aes codec */
+
+/* make the cipher on input xor-ed with iv, save the output as a new iv, write the output */
+#define aes_encode_output(state, output) \
+ (aes_encode_cipher(state), aes_copy_block(state->iv, state->data), aes_copy_block(output, state->data), output += 16)
+
+iof_status aes_encode_state (iof *I, iof *O, aes_state *state)
+{
+ int c;
+
+ if (!(state->flags & AES_HAS_IV)) // weird
+ return IOFERR;
+ if ((state->flags & AES_INLINE_IV) && !(state->flags & AES_CONTINUE))
+ { /* write iv at the beginning of encrypted data */
+ if (!iof_ensure(O, 16))
+ return IOFFULL;
+ aes_copy_block(O->pos, state->iv);
+ O->pos += 16;
+ state->flags |= AES_CONTINUE;
+ }
+ while (iof_ensure(O, 16))
+ {
+ while (state->buffered < 16)
+ {
+ if ((c = iof_get(I)) != IOFEOF)
+ { /* get input byte XORed with iv */
+ state->data[state->buffered] = state->iv[state->buffered] ^ ((uint8_t)c);
+ ++state->buffered;
+ }
+ else
+ {
+ if (state->flush)
+ {
+ if (state->buffered > 0 || aes_padding(state))
+ { /* pad the last input chunk; for input divisable by 16, add 16 bytes 0x0f */
+ aes_put_padding(state, state->buffered);
+ state->buffered = 16;
+ aes_encode_output(state, O->pos);
+ }
+ return IOFEOF;
+ }
+ else
+ return IOFEMPTY;
+ }
+ }
+ aes_encode_output(state, O->pos);
+ state->buffered = 0;
+ }
+ return IOFFULL;
+}
+
+/* write iv to the output, save the raw input just buffered as iv for the next chunk, make the cipher, write out xoring with iv */
+#define aes_decode_output(state, output) \
+ (aes_copy_block(output, state->iv), aes_copy_block(state->iv, state->data), aes_decode_cipher(state), aes_copy_cbc(output, state->data), output += 16)
+
+iof_status aes_decode_state (iof *I, iof *O, aes_state *state)
+{
+ int c, ret;
+ uint8_t lastlength;
+
+ if ((state->flags & AES_INLINE_IV) && !(state->flags & AES_CONTINUE))
+ {
+ while (state->buffered < 16)
+ {
+ if ((c = iof_get(I)) != IOFEOF)
+ state->iv[state->buffered++] = (uint8_t)c;
+ else
+ return state->flush ? IOFERR : IOFEMPTY;
+ }
+ state->flags |= AES_CONTINUE|AES_HAS_IV;
+ state->buffered = 0;
+ }
+ while (iof_ensure(O, 16))
+ {
+ while (state->buffered < 16)
+ {
+ if ((c = iof_get(I)) != IOFEOF)
+ state->data[state->buffered++] = (uint8_t)c;
+ else
+ return state->flush ? IOFERR : IOFEMPTY;
+ }
+ aes_decode_output(state, O->pos);
+ if (state->flush)
+ { /* we have to check for EOF here, to remove eventual padding */
+ if ((c = iof_get(I)) < 0)
+ { /* end of input at 16-bytes boundary; remove padding and quit */
+ ret = aes_remove_padding(state, O->pos - 16, &lastlength);
+ O->pos -= 16 - lastlength;
+ return ret;
+ }
+ else
+ { /* beginning of the next block */
+ state->buffered = 1;
+ state->data[0] = (uint8_t)c;
+ }
+ }
+ else
+ state->buffered = 0;
+ }
+ return IOFFULL;
+}
+
+/* variants that works on c-strings; can work inplace (output==input) except encoder in pdf flavour */
+
+/*
+Codecs operating on c-string can generally work inplace (output==input), except encoder with AES_INLINE_IV flag set,
+which outputs 16 bytes of initialization vector at the beginning of encrypted data. All return the size of encrypted/decrypted
+data. Encoders output is the original length padded to a complete 16 bytes (plus eventual 16 bytes of initialization
+vector, if AES_INLINE_IV is used). Default padding is unambiguously removed during decryption. AES_NULL_PADDING flag
+forces using (ambiguous) NULL-byte padding, only if input length module 16 is greater then zero.
+
+An input data is supposed to be a complete data to be encrypted or decrypted. It is possible, however, to use those
+codecs for scaterred data chunks by manipulating AES_INLINE_IV, AES_NULL_PADDING, AES_CONTINUE flags and data length.
+Caller may assume that c-string codecs do not modify state flags.
+
+Encoder could actually be optimized by writing an initialization vector to a state block once. After every chunk encryption,
+the output is the initialization vector for the next chunk. Since we use c-string codec variants on short strings,
+the gain is neglectable in comparison with the weight of the aes crypt procedure.
+*/
+
+size_t aes_encode_data (const void *input, size_t length, void *output, const void *key, size_t keylength, const void *iv, int flags)
+{
+ aes_state state;
+ aes_keyblock keyblock;
+
+ if (aes_encode_initialize(&state, &keyblock, key, keylength, iv) == NULL)
+ return 0;
+ state.flags |= flags;
+ return aes_encode_state_data(&state, input, length, output);
+ // aes_state_close(&state);
+}
+
+size_t aes_encode_state_data (aes_state *state, const void *input, size_t length, void *output)
+{
+ const uint8_t *inp;
+ uint8_t *out, tail, t;
+ size_t size;
+
+ inp = (const uint8_t *)input;
+ out = (uint8_t *)output;
+
+ if (!(state->flags & AES_HAS_IV))
+ return 0;
+ if ((state->flags & AES_INLINE_IV) && !(state->flags & AES_CONTINUE))
+ {
+ aes_copy_block(out, state->iv);
+ out += 16;
+ }
+ // state->flags |= AES_CONTINUE; // do not modify state flags
+
+ for (size = 0; size + 16 <= length; size += 16)
+ {
+ aes_copy_xor(state->data, inp, state->iv);
+ aes_encode_output(state, out);
+ inp += 16;
+ }
+
+ if ((tail = (length % 16)) > 0 || aes_padding(state))
+ {
+ for (t = 0; t < tail; ++t)
+ state->data[t] = inp[t] ^ state->iv[t];
+ aes_put_padding(state, tail);
+ aes_encode_output(state, out);
+ size += 16;
+ }
+ if (state->flags & AES_INLINE_IV)
+ size += 16; /* iv written at the beginning of encoded data */
+
+ return size;
+}
+
+size_t aes_decode_data (const void *input, size_t length, void *output, const void *key, size_t keylength, const void *iv, int flags)
+{
+ aes_state state;
+ aes_keyblock keyblock;
+
+ if (aes_decode_initialize(&state, &keyblock, key, keylength, iv) == NULL)
+ return 0;
+ state.flags |= flags;
+ return aes_decode_state_data(&state, input, length, output);
+ // aes_state_close(&state);
+}
+
+size_t aes_decode_state_data (aes_state *state, const void *input, size_t length, void *output)
+{
+ const uint8_t *inp;
+ uint8_t *out, lastlength;
+ size_t size;
+
+ inp = (const uint8_t *)input;
+ out = (uint8_t *)output;
+
+ if ((state->flags & AES_INLINE_IV) && !(state->flags & AES_CONTINUE))
+ {
+ aes_copy_block(state->iv, inp);
+ // state->flags |= AES_HAS_IV; // do not modify state flags
+ inp += 16;
+ length = length >= 16 ? length - 16 : 0;
+ }
+ else if (!(state->flags & AES_HAS_IV))
+ return 0;
+ // state->flags |= AES_CONTINUE; // do not modify state flags
+ for (size = 0; size + 16 <= length; size += 16)
+ {
+ aes_copy_block(state->data, inp);
+ aes_decode_output(state, out);
+ inp += 16;
+ }
+
+ if (size >= 16)
+ {
+ aes_remove_padding(state, out - 16, &lastlength);
+ size = size - 16 + lastlength;
+ }
+
+ return size;
+}
+
+/*
+pseudo-random bytes chain exceprted from eexec; not expected to have strong cryptographic properties
+we only expect that it is (reasonably) unique and different for each call (not only function call, but also
+a program call). A current trick with mangling pointer value gives satisfactory results, generally different
+for every function call and a programm call. Note that the pseudo-input bytes starts from some inner address
+bits, as they vary better; without that, the first byte tends to be "lazy".
+*/
+
+void random_bytes (uint8_t *output, size_t size)
+{
+ size_t i;
+ uint8_t p;
+ static uint16_t k = 55665;
+ for (i = 0; i < size; ++i)
+ {
+ p = ((uint8_t *)(&output))[(i + 2) % sizeof(uint8_t *)] ^ (uint8_t)size; // pseudo input byte ;)
+ k = (((p + k) * 52845 + 22719) & 65535); // xor-ed with pseudo-random sequence (kept between calls)
+ output[i] = p ^ (k >> 8);
+ }
+}
+
+void aes_generate_iv (uint8_t output[16])
+{
+ random_bytes(output, 16);
+}
+
+/* filters */
+
+// rc4 decoder function
+
+static size_t rc4_decoder (iof *F, iof_mode mode)
+{
+ rc4_state *state;
+ iof_status status;
+ size_t tail;
+
+ state = iof_filter_state(rc4_state *, F);
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ do {
+ status = rc4_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "rc4", status);
+ case IOFCLOSE:
+ rc4_state_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// rc4 encoder function
+
+static size_t rc4_encoder (iof *F, iof_mode mode)
+{
+ rc4_state *state;
+ iof_status status;
+
+ state = iof_filter_state(rc4_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = rc4_encode_state(F, F->next, state);
+ return iof_encoder_retval(F, "rc4", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ rc4_encoder(F, IOFFLUSH);
+ rc4_state_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// aes decoder function
+
+static size_t aes_decoder (iof *F, iof_mode mode)
+{
+ aes_state *state;
+ iof_status status;
+ size_t tail;
+
+ state = iof_filter_state(aes_state *, F);
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ do {
+ status = aes_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "aes", status);
+ case IOFCLOSE:
+ aes_state_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// aes encoder function
+
+static size_t aes_encoder (iof *F, iof_mode mode)
+{
+ aes_state *state;
+ iof_status status;
+
+ state = iof_filter_state(aes_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = aes_encode_state(F, F->next, state);
+ return iof_encoder_retval(F, "aes", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ aes_encoder(F, IOFFLUSH);
+ aes_state_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+iof * iof_filter_rc4_decoder (iof *N, const void *key, size_t keylength)
+{
+ iof *I;
+ crypt_state_pointer P;
+
+ I = iof_filter_reader(rc4_decoder, sizeof(rc4_state), &P.voidstate);
+ iof_setup_next(I, N);
+ if (rc4_state_init(P.rc4state, key, keylength) == NULL)
+ {
+ iof_discard(I);
+ return NULL;
+ }
+ P.rc4state->flush = 1;
+ return I;
+}
+
+iof * iof_filter_rc4_encoder (iof *N, const void *key, size_t keylength)
+{
+ iof *O;
+ crypt_state_pointer P;
+
+ O = iof_filter_writer(rc4_encoder, sizeof(rc4_state), &P.voidstate);
+ iof_setup_next(O, N);
+ if (rc4_state_init(P.rc4state, key, keylength) == NULL)
+ {
+ iof_discard(O);
+ return NULL;
+ }
+ // P.rc4state->flush = 1;
+ return O;
+}
+
+/* aes crypt filters */
+
+iof * iof_filter_aes_decoder (iof *N, const void *key, size_t keylength)
+{
+ iof *I;
+ crypt_state_pointer P;
+
+ I = iof_filter_reader(aes_decoder, sizeof(aes_state), &P.voidstate);
+ iof_setup_next(I, N);
+ if (aes_decode_init(P.aesstate, key, keylength) == NULL)
+ {
+ iof_discard(I);
+ return NULL;
+ }
+ aes_pdf_mode(P.aesstate);
+ P.aesstate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_aes_encoder (iof *N, const void *key, size_t keylength)
+{
+ iof *O;
+ crypt_state_pointer P;
+
+ O = iof_filter_writer(aes_encoder, sizeof(aes_state), &P.voidstate);
+ iof_setup_next(O, N);
+ if (aes_encode_init(P.aesstate, key, keylength) == NULL)
+ {
+ iof_discard(O);
+ return NULL;
+ }
+ aes_pdf_mode(P.aesstate);
+ // P.aesstate->flush = 1;
+ return O;
+}
+
+/* test */
+
+/*
+static void show (void *p, size_t size, uint8_t round, uint8_t sym)
+{
+ uint8_t i;
+ printf("%c%c:", round, sym);
+ for (i = 0; i < size; ++i)
+ printf("%02x", ((uint8_t *)p)[i]);
+ printf("\n");
+}
+
+void aes_test (void)
+{
+ const uint8_t key[] = { 0x2b, 0x7e, 0x15, 0x16, 0x28, 0xae, 0xd2, 0xa6, 0xab, 0xf7, 0x15, 0x88, 0x09, 0xcf, 0x4f, 0x3c };
+ const uint8_t iv[] = { 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f };
+ const uint8_t inp[] = {
+ 0x6b, 0xc1, 0xbe, 0xe2, 0x2e, 0x40, 0x9f, 0x96, 0xe9, 0x3d, 0x7e, 0x11, 0x73, 0x93, 0x17, 0x2a,
+ 0xae, 0x2d, 0x8a, 0x57, 0x1e, 0x03, 0xac, 0x9c, 0x9e, 0xb7, 0x6f, 0xac, 0x45, 0xaf, 0x8e, 0x51,
+ 0x30, 0xc8, 0x1c, 0x46, 0xa3, 0x5c, 0xe4, 0x11, 0xe5, 0xfb, 0xc1, 0x19, 0x1a, 0x0a, 0x52, 0xef,
+ 0xf6, 0x9f, 0x24, 0x45, 0xdf, 0x4f, 0x9b, 0x17, 0xad, 0x2b, 0x41, 0x7b, 0xe6, 0x6c, 0x37, 0x10 };
+ const uint8_t out[] = {
+ 0x76, 0x49, 0xab, 0xac, 0x81, 0x19, 0xb2, 0x46, 0xce, 0xe9, 0x8e, 0x9b, 0x12, 0xe9, 0x19, 0x7d,
+ 0x50, 0x86, 0xcb, 0x9b, 0x50, 0x72, 0x19, 0xee, 0x95, 0xdb, 0x11, 0x3a, 0x91, 0x76, 0x78, 0xb2,
+ 0x73, 0xbe, 0xd6, 0xb8, 0xe3, 0xc1, 0x74, 0x3b, 0x71, 0x16, 0xe6, 0x9e, 0x22, 0x22, 0x95, 0x16,
+ 0x3f, 0xf1, 0xca, 0xa1, 0x68, 0x1f, 0xac, 0x09, 0x12, 0x0e, 0xca, 0x30, 0x75, 0x86, 0xe1, 0xa7 };
+
+ uint8_t input[64], output[64];
+ size_t inpsize, outsize;
+ int flags = AES_NULL_PADDING;
+
+ ////////////////////////////////////////////////////////////////////////////
+
+//#define ENCODETO output
+#define ENCODETO input // inplace
+
+ inpsize = 64;
+ memcpy(input, inp, inpsize);
+ show(input, inpsize, '>', '>');
+ outsize = aes_encode_data(input, inpsize, ENCODETO, key, 16, iv, flags);
+ show(ENCODETO, outsize, '<', '<');
+ if (outsize == inpsize && memcmp(ENCODETO, out, outsize) == 0)
+ printf("ENCODER SUCCESS\n");
+ else
+ printf("ENCODER FAILURE\n");
+
+ ////////////////////////////////////////////////////////////////////////////
+
+//#define DECODETO input
+#define DECODETO output // in place
+
+ outsize = 64;
+ memcpy(output, out, outsize);
+ show(output, outsize, '<', '<');
+ inpsize = aes_decode_data(output, outsize, DECODETO, key, 16, iv, flags);
+ show(DECODETO, inpsize, '>', '>');
+ if (inpsize == outsize && memcmp(DECODETO, inp, inpsize) == 0)
+ printf("DECODER SUCCESS\n");
+ else
+ printf("DECODER FAILURE\n");
+}
+*/
+
+/*
+Some example vectors
+
+================================ AES ECB 128-bit encryption mode ================================
+
+Encryption key: 2b7e151628aed2a6abf7158809cf4f3c
+
+Test vector Cipher text
+6bc1bee22e409f96e93d7e117393172a 3ad77bb40d7a3660a89ecaf32466ef97
+ae2d8a571e03ac9c9eb76fac45af8e51 f5d3d58503b9699de785895a96fdbaaf
+30c81c46a35ce411e5fbc1191a0a52ef 43b1cd7f598ece23881b00e3ed030688
+f69f2445df4f9b17ad2b417be66c3710 7b0c785e27e8ad3f8223207104725dd4
+
+
+================================ AES ECB 192-bit encryption mode ================================
+
+Encryption key: 8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b
+
+Test vector Cipher text
+6bc1bee22e409f96e93d7e117393172a bd334f1d6e45f25ff712a214571fa5cc
+ae2d8a571e03ac9c9eb76fac45af8e51 974104846d0ad3ad7734ecb3ecee4eef
+30c81c46a35ce411e5fbc1191a0a52ef ef7afd2270e2e60adce0ba2face6444e
+f69f2445df4f9b17ad2b417be66c3710 9a4b41ba738d6c72fb16691603c18e0e
+
+
+================================ AES ECB 256-bit encryption mode ================================
+
+Encryption key: 603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4
+
+Test vector Cipher text
+6bc1bee22e409f96e93d7e117393172a f3eed1bdb5d2a03c064b5a7e3db181f8
+ae2d8a571e03ac9c9eb76fac45af8e51 591ccb10d410ed26dc5ba74a31362870
+30c81c46a35ce411e5fbc1191a0a52ef b6ed21b99ca6f4f9f153e7b1beafed1d
+f69f2445df4f9b17ad2b417be66c3710 23304b7a39f9f3ff067d8d8f9e24ecc7
+
+================================ AES CBC 128-bit encryption mode ================================
+
+Encryption key: 2b7e151628aed2a6abf7158809cf4f3c
+
+Initialization vector Test vector Cipher text
+000102030405060708090A0B0C0D0E0F 6bc1bee22e409f96e93d7e117393172a 7649abac8119b246cee98e9b12e9197d
+7649ABAC8119B246CEE98E9B12E9197D ae2d8a571e03ac9c9eb76fac45af8e51 5086cb9b507219ee95db113a917678b2
+5086CB9B507219EE95DB113A917678B2 30c81c46a35ce411e5fbc1191a0a52ef 73bed6b8e3c1743b7116e69e22229516
+73BED6B8E3C1743B7116E69E22229516 f69f2445df4f9b17ad2b417be66c3710 3ff1caa1681fac09120eca307586e1a7
+
+================================ AES CBC 192-bit encryption mode ================================
+
+Encryption key: 8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b
+
+Initialization vector Test vector Cipher text
+000102030405060708090A0B0C0D0E0F 6bc1bee22e409f96e93d7e117393172a 4f021db243bc633d7178183a9fa071e8
+4F021DB243BC633D7178183A9FA071E8 ae2d8a571e03ac9c9eb76fac45af8e51 b4d9ada9ad7dedf4e5e738763f69145a
+B4D9ADA9AD7DEDF4E5E738763F69145A 30c81c46a35ce411e5fbc1191a0a52ef 571b242012fb7ae07fa9baac3df102e0
+571B242012FB7AE07FA9BAAC3DF102E0 f69f2445df4f9b17ad2b417be66c3710 08b0e27988598881d920a9e64f5615cd
+
+================================ AES CBC 256-bit encryption mode ================================
+
+Encryption key: 603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4
+
+Initialization vector Test vector Cipher text
+000102030405060708090A0B0C0D0E0F 6bc1bee22e409f96e93d7e117393172a f58c4c04d6e5f1ba779eabfb5f7bfbd6
+F58C4C04D6E5F1BA779EABFB5F7BFBD6 ae2d8a571e03ac9c9eb76fac45af8e51 9cfc4e967edb808d679f777bc6702c7d
+9CFC4E967EDB808D679F777BC6702C7D 30c81c46a35ce411e5fbc1191a0a52ef 39f23369a9d9bacfa530e26304231461
+39F23369A9D9BACFA530E26304231461 f69f2445df4f9b17ad2b417be66c3710 b2eb05e2c39be9fcda6c19078c6a9d1b
+*/ \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilcrypt.h b/source/luametatex/source/libraries/pplib/util/utilcrypt.h
new file mode 100644
index 000000000..e5bf53cc5
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilcrypt.h
@@ -0,0 +1,90 @@
+#ifndef UTIL_CRYPT_H
+#define UTIL_CRYPT_H
+
+#include <stdint.h>
+#include <stddef.h>
+#include "utiliof.h"
+
+#ifndef UTIL_CRYPT_TIME
+# define UTIL_CRYPT_TIME 0
+#endif
+
+/* RC4 */
+
+typedef uint8_t rc4_map[256];
+
+typedef struct rc4_state rc4_state;
+
+#define RC4_STATE_ALLOC (1<<0)
+
+UTILAPI rc4_state * rc4_state_initialize (rc4_state *state, rc4_map *map, const void *vkey, size_t keylength);
+#define rc4_state_init(state, vkey, keylength) rc4_state_initialize(state, NULL, vkey, keylength)
+UTILAPI void rc4_map_save (rc4_state *state, rc4_map *map);
+UTILAPI void rc4_map_restore (rc4_state *state, rc4_map *map);
+
+/* Codecs operating on iof */
+
+UTILAPI iof_status rc4_crypt_state (iof *I, iof *O, rc4_state *state);
+#define rc4_encode_state(I, O, state) rc4_crypt_state(I, O, state)
+#define rc4_decode_state(I, O, state) rc4_crypt_state(I, O, state)
+
+UTILAPI iof_status rc4_crypt (iof *I, iof *O, const void *key, size_t length);
+#define rc4_encode(I, O) rc4_crypt(I, O, key, length)
+#define rc4_decode(I, O) rc4_crypt(I, O, key, length)
+
+UTILAPI size_t rc4_crypt_data (const void *input, size_t length, void *output, const void *key, size_t keylength);
+UTILAPI size_t rc4_crypt_state_data (rc4_state *state, const void *input, size_t length, void *output);
+#define rc4_encode_data(input, length, output, key, keylength) rc4_crypt_data(input, length, output, key, keylength)
+#define rc4_decode_data(input, length, output, key, keylength) rc4_crypt_data(input, length, output, key, keylength)
+#define rc4_encode_state_data(state, input, length, output) rc4_crypt_state_data(state, input, length, output)
+#define rc4_decode_state_data(state, input, length, output) rc4_crypt_state_data(state, input, length, output)
+
+UTILAPI void rc4_state_close (rc4_state *state);
+
+/* AES */
+
+typedef uint8_t aes_block[4][4];
+typedef aes_block aes_keyblock[15]; // aes128 - 10+1, aes192 - 12+1, aes256 - 14+1
+
+typedef struct aes_state aes_state;
+
+#define AES_STATE_ALLOC (1<<0)
+//#define AES_ECB_MODE (1<<2)
+#define AES_HAS_IV (1<<3)
+#define AES_INLINE_IV (1<<4)
+#define AES_CONTINUE (1<<5)
+#define AES_NULL_PADDING (1<<6)
+
+UTILAPI void aes_pdf_mode (aes_state *state);
+//UTILAPI aes_state * aes_state_initialize_ecb (aes_state *State, uint8_t *roundkey, const uint8_t *key);
+UTILAPI aes_state * aes_encode_initialize (aes_state *state, aes_keyblock *keyblock, const void *key, size_t keylength, const void *iv);
+UTILAPI aes_state * aes_decode_initialize (aes_state *state, aes_keyblock *keyblock, const void *key, size_t keylength, const void *iv);
+#define aes_encode_init(state, key, keylength) aes_encode_initialize(state, NULL, key, keylength, NULL)
+#define aes_decode_init(state, key, keylength) aes_decode_initialize(state, NULL, key, keylength, NULL)
+
+UTILAPI void aes_state_close (aes_state *state);
+
+/* Codecs operating on iof */
+
+UTILAPI iof_status aes_encode_state (iof *I, iof *O, aes_state *state);
+UTILAPI iof_status aes_decode_state (iof *I, iof *O, aes_state *state);
+
+UTILAPI size_t aes_encode_data (const void *input, size_t length, void *output, const void *key, size_t keylength, const void *iv, int flags);
+UTILAPI size_t aes_encode_state_data (aes_state *state, const void *input, size_t length, void *output);
+UTILAPI size_t aes_decode_data (const void *input, size_t length, void *output, const void *key, size_t keylength, const void *iv, int flags);
+UTILAPI size_t aes_decode_state_data (aes_state *state, const void *input, size_t length, void *output);
+
+/* random bytes generator */
+
+UTILAPI void random_bytes (uint8_t *output, size_t size);
+UTILAPI void aes_generate_iv (uint8_t output[16]);
+
+/* filters */
+
+iof * iof_filter_rc4_decoder (iof *N, const void *key, size_t keylength);
+iof * iof_filter_rc4_encoder (iof *N, const void *key, size_t keylength);
+
+iof * iof_filter_aes_decoder (iof *N, const void *key, size_t keylength);
+iof * iof_filter_aes_encoder (iof *N, const void *key, size_t keylength);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilcryptdef.h b/source/luametatex/source/libraries/pplib/util/utilcryptdef.h
new file mode 100644
index 000000000..d43ea2e5b
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilcryptdef.h
@@ -0,0 +1,32 @@
+
+#ifndef UTIL_CRYPTDEF_H
+#define UTIL_CRYPTDEF_H
+
+struct rc4_state {
+ union {
+ rc4_map *map;
+ uint8_t *smap;
+ };
+ int i, j;
+ int flush;
+ int flags;
+};
+
+struct aes_state {
+ size_t keylength;
+ int rounds;
+ //int keywords;
+ union {
+ aes_block block;
+ uint8_t data[16];
+ };
+ aes_keyblock *keyblock;
+ uint8_t iv[16];
+ uint8_t buffered;
+ int flush;
+ int flags;
+};
+
+typedef union { rc4_state *rc4state; aes_state *aesstate; void *voidstate; } crypt_state_pointer; // to avoid 'dereferencing type-puned ...' warnings
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utildecl.h b/source/luametatex/source/libraries/pplib/util/utildecl.h
new file mode 100644
index 000000000..b11e5b884
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utildecl.h
@@ -0,0 +1,28 @@
+
+#ifndef UTIL_DECL_H
+#define UTIL_DECL_H
+
+/*
+UTILDLL - when building .dll
+UTILEXE - when building .exe to import symbols from .dll
+*/
+
+#if defined (_WIN32) || defined(_WIN64)
+# ifdef UTILDLL
+# define UTILAPI __declspec(dllexport)
+# define UTILDEF __declspec(dllexport)
+# else
+# ifdef UTILEXE
+# define UTILAPI __declspec(dllimport)
+# define UTILDEF
+# else
+# define UTILAPI
+# define UTILDEF
+# endif
+# endif
+#else
+# define UTILAPI
+# define UTILDEF
+#endif
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilflate.c b/source/luametatex/source/libraries/pplib/util/utilflate.c
new file mode 100644
index 000000000..eaff44cce
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilflate.c
@@ -0,0 +1,322 @@
+
+#include "../../utilities/auxzlib.h"
+
+#include "utilmem.h"
+#include "utillog.h"
+#include "utilflate.h"
+
+/* flate codec */
+
+/*
+Flate codec example provided at http://www.zlib.net/zpipe.c (http://www.zlib.net/zlib_how.html) uses the following scheme:
+- provide input data buffer
+- keep providing output until codec function uses it
+
+For encoder:
+
+ z->zalloc = z->zfree = z->zopaque = NULL;
+ deflateInit(z, compression_level);
+ do {
+ z->next_in = <input buffer>
+ z->avail_in = <input buffer bytes>
+ do {
+ z->next_out = <output buffer>
+ z->avail_out = <output buffer bytes>
+ deflate(z, flush);
+ // write obtained output from deflate
+ } while (z->avail_out == 0);
+ assert(z->avail_in == 0);
+ } while (flush != Z_FINISH);
+ deflateEnd(z);
+
+'z' is an internal codec state of type z_stream, 'flush' is either Z_NO_FLUSH or Z_FINISH at the end of data.
+deflate() ensures to consume the entire input if there are no obstackles to write an output. The inner loop
+provides an output space as long as it is used by deflate(). When deflate() wrote everything it could,
+it leaves z->avail_out > 0, which breaks the inner loop. At this point z->avail_in should also be zero.
+The example documentation claims that the return codes from deflate() doesn't really need to be checked,
+as checking z->avail_out for zero is enough.
+
+The scheme for decoder is pretty similar, but with substantial differences:
+- the end of stream is automatically found by decoder, so using Z_FINISH flag to indicate an end of stream
+ is not necessary, but if provided, it MUST be given only if the EOF marker actually occurs in the input chunk,
+ and subsequent calls to inflate() must consequently use Z_FINISH
+- calling inflate() as long as it uses the output buffer provided still works for decoder, but inflate()
+ does not ensure to consume the entire input, as it will read until end of stream marker
+- the return code from inflate() must be checked to ensure the proper reaction on invalid data stream and
+ end of stream signals
+- initialization must set an input buffer to NULL or to some existing chunk (the later helps zlib to perform
+ better on inflate(), but inflate() does the research on the first call anyway)
+
+ z->zalloc = z->zfree = z->zopaque = NULL;
+ z->next_in = NULL, z->avail_in = 0;
+ inflateInit(z);
+ do {
+ z->next_in = <input buffer>
+ z->avail_in = <input buffer bytes>
+ do {
+ z->next_out = <output buffer>
+ z->avail_out = <output buffer bytes>
+ status = inflate(z, flush);
+ // check return status
+ // write obtained output from inflate
+ } while (z->avail_out == 0);
+ } while (status != Z_STREAM_END);
+ inflateEnd(z);
+
+Our wrapper generally follows "prepare input, keep pomping output" scheme, but we need to support handler function
+breaks on IOFEMPTY and IOFFULL. For a consistent come back from those on subsequent calls to the handler function,
+we use 3 states:
+- FLATE_IN - get input, when got something then goto FALTE_OUT
+- FLATE_OUT - set z_stream buffers and keep writing output until enything to write, then goto FLATE_IN or FLATE_DONE
+- FLATE_DONE - we are done, no return from that state
+Distinction of FLATE_IN and FLATE_OUT states guarantees that we will not get more input until zlib consumes the stuff
+from the previous feed, possibly interrupted by IOFFULL return on filling the output buffer. This distinction is not
+critical, but makes the filter running according to the scheme described above. Note that we set zlib input buffer
+(z->next_in, z->avail_in) at the beginning of FLATE_OUT state. Also note that we always update our buffers according
+to updated avail_in / avail_out values, just after a call to inflate() / deflate(). So no matter what have happens
+between handler calls, zlib input buffer is in sync with ours.
+*/
+
+struct flate_state {
+ z_stream z;
+ int flush;
+ int status;
+ int level; /* encoder compression level -1..9 */
+};
+
+typedef union { flate_state *flatestate; void *voidstate; } flate_state_pointer; // to avoid 'dereferencing type-puned ...' warnings
+
+enum {
+ FLATE_IN,
+ FLATE_OUT,
+ FLATE_DONE
+};
+
+flate_state * flate_decoder_init (flate_state *state)
+{ /* initialize zlib */
+ z_stream *z = &state->z;
+ z->zalloc = &lmt_zlib_alloc; /* Z_NULL */
+ z->zfree = &lmt_zlib_free; /* Z_NULL */
+ z->opaque = Z_NULL;
+ z->avail_in = 0; /* must be initialized before inflateInit() */
+ z->next_in = Z_NULL; /* ditto */
+ if (inflateInit(z) != Z_OK)
+ return NULL;
+ state->status = FLATE_IN;
+ return state;
+}
+
+flate_state * flate_encoder_init (flate_state *state)
+{
+ z_stream *z = &state->z;
+ z->zalloc = &lmt_zlib_alloc; /* Z_NULL */
+ z->zfree = &lmt_zlib_free; /* Z_NULL */
+ z->opaque = Z_NULL;
+ z->avail_in = 0;
+ z->next_in = Z_NULL;
+ state->level = Z_DEFAULT_COMPRESSION; // will probably be moved upward
+ if (deflateInit(z, state->level) != Z_OK)
+ return NULL;
+ state->status = FLATE_IN;
+ return state;
+}
+
+static const char * zmess (int zstatus)
+{
+ switch (zstatus)
+ {
+ case Z_OK: return "ok";
+ case Z_STREAM_END: return "end of stream";
+ case Z_BUF_ERROR: return "buffer error";
+ case Z_STREAM_ERROR: return "stream error";
+ case Z_NEED_DICT: return "need dict";
+ case Z_DATA_ERROR: return "data error";
+ case Z_MEM_ERROR: return "memory error";
+ case Z_VERSION_ERROR: return "version error";
+ case Z_ERRNO: return "io error";
+ default:
+ break;
+ }
+ return "unknown error";
+}
+
+iof_status flate_decode_state (iof *I, iof *O, flate_state *state)
+{
+ z_stream *z;
+ int zstatus = Z_OK;
+ z = &state->z;
+ while (state->status != FLATE_DONE)
+ {
+ if (state->status == FLATE_IN)
+ {
+ if (!iof_readable(I))
+ return state->flush ? IOFERR : IOFEMPTY;
+ state->status = FLATE_OUT;
+ }
+ z->next_in = (Bytef *)I->pos;
+ z->avail_in = (uInt)iof_left(I);
+ do {
+ if (!iof_writable(O))
+ return IOFFULL;
+ z->next_out = (Bytef *)O->pos;
+ z->avail_out = (uInt)iof_left(O);
+ zstatus = inflate(z, Z_NO_FLUSH);
+ I->pos += iof_left(I) - z->avail_in;
+ O->pos += iof_left(O) - z->avail_out;
+ switch (zstatus)
+ {
+ case Z_OK:
+ case Z_STREAM_END:
+ break;
+ default:
+ loggerf("flate decoder %s (%d)", zmess(zstatus), zstatus);
+ return IOFERR;
+ }
+ } while (z->avail_out == 0);
+ state->status = zstatus == Z_STREAM_END ? FLATE_DONE : FLATE_IN;
+ }
+ return IOFEOF;
+}
+
+iof_status flate_encode_state (iof *I, iof *O, flate_state *state)
+{
+ z_stream *z;
+ int zstatus;
+ z = &state->z;
+ while (state->status != FLATE_DONE)
+ {
+ if (state->status == FLATE_IN)
+ {
+ if (!iof_readable(I))
+ if (!state->flush)
+ return IOFEMPTY;
+ state->status = FLATE_OUT;
+ }
+ z->next_in = (Bytef *)I->pos;
+ z->avail_in = (uInt)iof_left(I);
+ do {
+ if (!iof_writable(O))
+ return IOFFULL;
+ z->next_out = (Bytef *)O->pos;
+ z->avail_out = (uInt)iof_left(O);
+ zstatus = deflate(z, state->flush ? Z_FINISH : Z_NO_FLUSH);
+ I->pos += iof_left(I) - z->avail_in;
+ O->pos += iof_left(O) - z->avail_out;
+ switch (zstatus)
+ {
+ case Z_OK:
+ case Z_STREAM_END:
+ break;
+ default:
+ loggerf("flate encoder %s (%d)", zmess(zstatus), zstatus);
+ return IOFERR;
+ }
+ } while (z->avail_out == 0);
+ state->status = state->flush ? FLATE_DONE : FLATE_IN;
+ }
+ return IOFEOF;
+}
+
+
+void flate_decoder_close (flate_state *state)
+{
+ inflateEnd(&state->z);
+}
+
+void flate_encoder_close (flate_state *state)
+{
+ deflateEnd(&state->z);
+}
+
+/* filter */
+
+// flate decoder function
+
+static size_t flate_decoder (iof *F, iof_mode mode)
+{
+ flate_state *state;
+ iof_status status;
+ size_t tail;
+
+ state = iof_filter_state(flate_state *, F);
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ do {
+ status = flate_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "flate", status);
+ case IOFCLOSE:
+ flate_decoder_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// flate encoder function
+
+static size_t flate_encoder (iof *F, iof_mode mode)
+{
+ flate_state *state;
+ iof_status status;
+
+ state = iof_filter_state(flate_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = flate_encode_state(F, F->next, state);
+ return iof_encoder_retval(F, "flate", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ flate_encoder(F, IOFFLUSH);
+ flate_encoder_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+iof * iof_filter_flate_decoder (iof *N)
+{
+ iof *I;
+ flate_state_pointer P;
+ I = iof_filter_reader(flate_decoder, sizeof(flate_state), &P.voidstate);
+ iof_setup_next(I, N);
+ if (flate_decoder_init(P.flatestate) == NULL)
+ {
+ iof_discard(I);
+ return NULL;
+ }
+ P.flatestate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_flate_encoder (iof *N)
+{
+ iof *O;
+ flate_state_pointer P;
+ O = iof_filter_writer(flate_encoder, sizeof(flate_state), &P.voidstate);
+ iof_setup_next(O, N);
+ if (flate_encoder_init(P.flatestate) == NULL)
+ {
+ iof_discard(O);
+ return NULL;
+ }
+ return O;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilflate.h b/source/luametatex/source/libraries/pplib/util/utilflate.h
new file mode 100644
index 000000000..09bdd6661
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilflate.h
@@ -0,0 +1,21 @@
+#ifndef UTIL_FLATE_H
+#define UTIL_FLATE_H
+
+#include "utiliof.h"
+
+typedef struct flate_state flate_state;
+
+flate_state * flate_decoder_init (flate_state *state);
+flate_state * flate_encoder_init (flate_state *state);
+
+iof_status flate_decode_state (iof *I, iof *O, flate_state *state);
+iof_status flate_encode_state (iof *I, iof *O, flate_state *state);
+
+void flate_decoder_close (flate_state *state);
+void flate_encoder_close (flate_state *state);
+
+iof * iof_filter_flate_decoder (iof *N);
+iof * iof_filter_flate_encoder (iof *N);
+
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilfpred.c b/source/luametatex/source/libraries/pplib/util/utilfpred.c
new file mode 100644
index 000000000..9203c5e07
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilfpred.c
@@ -0,0 +1,778 @@
+/* predictor filters; common for flate and lzw */
+
+#include "utilmem.h"
+#include "utillog.h"
+#include "utilfpred.h"
+
+/*
+Here we implement predictor filters used with flate and lzw compressions in PDF streams. The main idea of data prediction
+is to compute and output the differences between data records instead of those records. Adjacent pixels in images are usually
+similar, so differences between pixel values tends to be zero. And both Flate and LZW performs better when the input
+is rather smooth. Although a preliminary use of predictors is related to bitmap data, The actual need for predictor filter
+came from the fact that xref streams may also be predicted (usually with PNG up-predictor).
+
+PDF specification allows to use several predictor algorithms, specified by /Predictor key in /DecodeParms dictionary:
+
+ 1 - no predictor (default)
+ 2 - TIFF horizontal predictor
+ 10 - PNG none predictor
+ 11 - PNG sub predictor
+ 12 - PNG up predictor
+ 13 - PNG average predictor
+ 14 - PNG paeth predictor
+
+All PNG predictors works on bytes, regardless the image color-depth. While encoding, every input data byte is decreased
+by the appropriate byte of the previous pixel. Even if the pixel does not fit a full byte, PNG predictors use an artificial
+pixel size rounded up to a full byte. PNG predictors utilizes previous (left) pixel, pixel above and previous to above
+pixel. In case of PNG, the type of the predictor is written on a dedicated byte at the beginning of every scanline. It
+means all predictor functions must maintain and information about left, above and left-above pixels.
+
+Despite the same differencing idea, TIFF predictors are different. The prediction process bases on pixel components,
+which are not necessarily bytes (component of a pixel is added/substracted from a relevant component of a previous
+pixel). In TIFF predictor 2, only the previous (the left) pixel is taken into account, there is no need to keep
+an information about other surrounding pixels. Also there is no expicit algorithm marker in data; the same prediction
+method is applied to all input rows.
+
+Not surprisingly, predictor encoders and decoders are pretty similar. Encoders take some input value and the previous
+input value (or 0 at the beginning of the scanline) and output a difference between them. Decoders takes an input value,
+previously decoded value (or zero) and outputs their sum. When encoding, the result is cast to the proper unsigned integer,
+when decoding, modulo 256 (or appropriate) is used, which makes encoding and decoding looseless.
+
+Some extra bits trickery is involved in TIFF predictor function, when components don't fit bytes boundary. In that case,
+an input is treated as a bits stream. Every input byte is "buffered" in a larger integer, as its lower bits (from right).
+Every output value is taken from its higher (left) bits. In a special case of bits-per-component equal 1, we buffer all
+pixel bits and use XOR to compute bits difference between pixels. I've excerpted that trick from poppler, but I'm not
+really sure if it works any better, especially when the number of components per pixel is 1. In that case we do a hard
+bit-by-bit work anyway.
+
+In PNG prediction, we record every pixel byte (in decoded form) in state->rowsave. At the end of a scanline
+we copy state->rowsave to state->rowup, so that in the next scanline we can access up-pixel byte.
+Left pixel byte is accessed as state->rowsave (the byte recently stored or virtual left edge byte \0).
+Up-left pixel byte is accessed via state->rowup, but with state->pixelsize offset (same as left byte, possibly \0
+at the left edge of the row). Both state->rowup and state->rowsave has a safe span of pixelsize bytes on the left,
+that are permanently \0.
+*/
+
+#define predictor_component_t uint16_t
+#define predictor_pixel1b_t uint32_t
+
+#define MAX_COMPONENTS 8
+
+struct predictor_state {
+ int default_predictor; /* default predictor indicator */
+ int current_predictor; /* current predictor, possibly taken from algorithm marker in PNG data */
+ int rowsamples; /* number of pixels in a scanline (/DecodeParms << /Columns ... >>) */
+ int compbits; /* number of bits per component (/DecodeParms << /BitsPerComponent ... >>) */
+ int components; /* number of components (/DecodeParms << /Colors ... >>) */
+ uint8_t *buffer; /* temporary private buffer area */
+ uint8_t *rowin; /* an input row buffer position */
+ int rowsize; /* size of a current scanline in bytes (rounded up) */
+ int rowend; /* an input buffer end position */
+ int rowindex; /* an output buffer position */
+ union {
+ struct { /* used by PNG predictor codecs */
+ uint8_t *rowup, *rowsave; /* previous scanline buffers */
+ int predictorbyte; /* flag indicating that algorithm byte is read/written */
+ int pixelsize; /* number of bytes per pixel (rounded up) */
+ };
+ struct { /* used by TIFF predictor codecs */
+ predictor_component_t compbuffer[MAX_COMPONENTS];
+ union {
+ predictor_component_t *prevcomp; /* an array of left pixel components, typically eq ->compbuffer */
+ predictor_pixel1b_t *prevpixel; /* left pixel value stored on a single integer (for 1bit color-depth) */
+ };
+ int compin, compout; /* bit stream buffers */
+ int bitsin, bitsout; /* bit stream counters */
+ int sampleindex; /* pixel counter */
+ int compindex; /* component counter */
+ int pixbufsize; /* size of pixel buffer in bytes */
+ };
+ };
+ int flush;
+ int status;
+};
+
+typedef union { predictor_state *predictorstate; void *voidstate; } predictor_state_pointer; // to avoid 'dereferencing type-puned ...' warnings
+
+enum {
+ STATUS_LAST = 0,
+ STATUS_CONTINUE = 1 // any value different then IOFEOF, IOFERR, ... which are < 0
+};
+
+/*
+Predictor type identifiers (pdf spec 76). lpdf doesn't hire the codec if predictor is 1. Predictor 15 indicates
+that the type of PNG prediction algorithm may change in subsequent lines. We always check algorithm marker anyway.
+*/
+
+enum predictor_code {
+ NONE_PREDICTOR = 1,
+ TIFF_PREDICTOR = 2,
+ PNG_NONE_PREDICTOR = 10,
+ PNG_SUB_PREDICTOR = 11,
+ PNG_UP_PREDICTOR = 12,
+ PNG_AVERAGE_PREDICTOR = 13,
+ PNG_PAETH_PREDICTOR = 14,
+ PNG_OPTIMUM_PREDICTOR = 15
+};
+
+predictor_state * predictor_decoder_init (predictor_state *state, int predictor, int rowsamples, int components, int compbits)
+{
+ int rowsize, pixelsize;
+#define storage_pos(b, p, size) ((b = p), (p += size))
+ uint8_t *buffer, *p;
+ size_t buffersize;
+
+ pixelsize = (components * compbits + 7) >> 3; // to bytes, rounded up
+ rowsize = (rowsamples * components * compbits + 7) >> 3;
+
+ state->default_predictor = state->current_predictor = predictor;
+ state->rowsamples = rowsamples;
+ state->components = components;
+ state->compbits = compbits;
+
+ if (predictor == TIFF_PREDICTOR)
+ { /* tiff predictor */
+ size_t compbuf, pixbuf;
+ compbuf = components * sizeof(predictor_component_t);
+ pixbuf = 1 * sizeof(predictor_pixel1b_t);
+ state->pixbufsize = (int)(compbuf > pixbuf ? compbuf : pixbuf);
+ buffersize = rowsize * sizeof(uint8_t);
+ buffer = (uint8_t *)util_calloc(buffersize, 1);
+ if ((size_t)state->pixbufsize > sizeof(state->compbuffer)) // components > MAX_COMPONENTS
+ state->prevcomp = (predictor_component_t *)util_calloc(state->pixbufsize, 1);
+ else
+ state->prevcomp = state->compbuffer;
+ // &state->prevcomp == &state->prevpixel
+ state->sampleindex = state->compindex = 0;
+ state->bitsin = state->bitsout = 0;
+ state->compin = state->compout = 0;
+ }
+ else
+ { /* png predictors */
+ buffersize = (3 * rowsize + 2 * pixelsize + 1) * sizeof(uint8_t);
+ p = buffer = (uint8_t *)util_calloc(buffersize, 1);
+ storage_pos(state->rowin, p, 1 + rowsize); // one extra byte for prediction algorithm tag
+ p += pixelsize; // pixelsize extra bytes for virtual left pixel at the edge, eg. rowup[-1] (permanently \0)
+ storage_pos(state->rowup, p, rowsize); // actual row byte
+ p += pixelsize; // ditto
+ storage_pos(state->rowsave, p, rowsize);
+ state->pixelsize = pixelsize;
+ state->predictorbyte = 0;
+ }
+ state->buffer = buffer;
+ state->rowsize = rowsize;
+ state->rowindex = 0;
+ state->rowend = 0;
+ state->status = STATUS_CONTINUE;
+ return state;
+}
+
+predictor_state * predictor_encoder_init (predictor_state *state, int predictor, int rowsamples, int components, int compbits)
+{
+ return predictor_decoder_init(state, predictor, rowsamples, components, compbits);
+}
+
+void predictor_decoder_close (predictor_state *state)
+{
+ util_free(state->buffer);
+ if (state->default_predictor == TIFF_PREDICTOR && state->prevcomp != NULL && state->prevcomp != state->compbuffer)
+ util_free(state->prevcomp);
+}
+
+void predictor_encoder_close (predictor_state *state)
+{
+ predictor_decoder_close(state);
+}
+
+/*
+All predoctor codecs first read the entire data row into a buffer. This is not crucial for the process,
+but allows to separate read/write states. In particular, there is one place in which codec functions
+may return on EOD.
+*/
+
+#define start_row(state) (state->rowindex = 0, state->rowin = state->buffer)
+
+static int read_scanline (predictor_state *state, iof *I, int size)
+{
+ int rowtail, left;
+ while ((rowtail = size - state->rowend) > 0)
+ {
+ left = (int)iof_left(I);
+ if (left >= rowtail)
+ {
+ memcpy(state->buffer + state->rowend, I->pos, (size_t)rowtail);
+ state->rowend += rowtail;
+ I->pos += rowtail;
+ start_row(state);
+ break;
+ }
+ else
+ {
+ if ((rowtail = left) > 0)
+ {
+ memcpy(state->buffer + state->rowend, I->pos, (size_t)rowtail);
+ state->rowend += rowtail;
+ I->pos += rowtail;
+ }
+ if (iof_input(I) == 0)
+ {
+ if (state->rowend == 0) // no scanline to process, no more input
+ return state->flush ? IOFEOF : IOFEMPTY;
+ /* If we are here, there is an incomplete scanline in buffer:
+ - if there is a chance for more (state->flush == 0), than wait for more
+ - otherwise encode/decode the last incomplete line?
+ pdf spec p. 76 says that "A row occupies a whole number of bytes",
+ so this situation should be considered abnormal (not found so far).
+ */
+ if (!state->flush)
+ return IOFEMPTY;
+ loggerf("incomplete scanline in predictor filter");
+ //return IOFERR;
+ state->status = STATUS_LAST;
+ state->rowsize -= size - state->rowend;
+ start_row(state);
+ break;
+ }
+ }
+ }
+ return STATUS_CONTINUE;
+}
+
+#define read_row(state, I, size, status) if ((status = read_scanline(state, I, size)) != STATUS_CONTINUE) return status
+
+#define ensure_output_bytes(O, n) if (!iof_ensure(O, n)) return IOFFULL
+
+#define tobyte(c) ((uint8_t)(c))
+#define tocomp(c) ((uint16_t)(c))
+
+#define row_byte(state) (state->rowin[state->rowindex])
+
+/* png predictor macros; on bytes */
+
+#define up_pixel_byte(state) (state->rowup[state->rowindex])
+#define upleft_pixel_byte(state) (state->rowup[state->rowindex - state->pixelsize])
+#define left_pixel_byte(state) (state->rowsave[state->rowindex - state->pixelsize])
+#define save_pixel_byte(state, c) (state->rowsave[state->rowindex] = (uint8_t)(c))
+
+/* tiff predictor macros; on components */
+
+#define left_pixel_component(state) (state->prevcomp[state->compindex]) // tiff predictor with 2, 4, 8, 16 components
+#define left_pixel_value(state) (state->prevpixel[0]) // tiff predictor with 1bit components
+
+/* assignment in conditional
+#define save_pixel_component(state, c) ((void)\
+ ((state->prevcomp[state->compindex] = (predictor_component_t)(c)), \
+ ++state->compindex, (state->compindex < state->components || (state->compindex = 0))))
+*/
+#define save_pixel_component(state, c) \
+ do { state->prevcomp[state->compindex] = (predictor_component_t)(c); if (++state->compindex >= state->components) state->compindex = 0; } while (0)
+
+#define save_pixel_value(state, c) (state->prevpixel[0] = (predictor_pixel1b_t)(c))
+
+/* Once the codec function is done with the scanline, we set imaginary left pixel data to zero, and reset row counters to
+zero in order to allow buffering another input scanline. */
+
+#define reset_row(state) state->rowend = 0
+
+#define reset_png_row(state) (memcpy(state->rowup, state->rowsave, state->rowsize), state->predictorbyte = 0, reset_row(state))
+
+#define reset_tiff_row(state) \
+ memset(state->prevcomp, 0, state->pixbufsize), \
+ state->bitsin = state->bitsout = 0, \
+ state->compin = state->compout = 0, \
+ reset_row(state), \
+ state->sampleindex = state->compindex = 0
+
+/* PNG paeth predictor function; http://www.libpng.org/pub/png/book/chapter09.html
+Compute the base value p := left + up - upleft, then choose that byte the closest
+(of the smallest absolute difference) to the base value. Left byte has a precedence. */
+
+
+static int paeth (predictor_state *state)
+{
+ int p, p1, p2, p3;
+ p = left_pixel_byte(state) + up_pixel_byte(state) - upleft_pixel_byte(state);
+ p1 = p >= left_pixel_byte(state) ? (p - left_pixel_byte(state)) : (left_pixel_byte(state) - p);
+ p2 = p >= up_pixel_byte(state) ? (p - up_pixel_byte(state)) : (up_pixel_byte(state) - p);
+ p3 = p >= upleft_pixel_byte(state) ? (p - upleft_pixel_byte(state)) : (upleft_pixel_byte(state) - p);
+ return (p1 <= p2 && p1 <= p3) ? left_pixel_byte(state) : (p2 <= p3 ? up_pixel_byte(state) : upleft_pixel_byte(state));
+}
+
+/* predictor decoder */
+
+iof_status predictor_decode_state (iof *I, iof *O, predictor_state *state)
+{
+ int status, c, d, outbytes;
+ while (state->status == STATUS_CONTINUE)
+ {
+ if (state->default_predictor >= 10) // PNG predictor?
+ {
+ read_row(state, I, state->rowsize + 1, status);
+ if (state->predictorbyte == 0)
+ { // we could actually check state->rowin <> state->buffer, but we need this flag for encoder anyway
+ state->current_predictor = row_byte(state) + 10;
+ state->predictorbyte = 1;
+ ++state->rowin;
+ }
+ }
+ else
+ {
+ read_row(state, I, state->rowsize, status);
+ }
+ switch (state->current_predictor)
+ {
+ case NONE_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ iof_set(O, c);
+ }
+ reset_row(state);
+ break;
+ case TIFF_PREDICTOR:
+ switch (state->compbits)
+ {
+ case 1:
+ outbytes = (state->components + 7) >> 3;
+ for ( ; state->sampleindex < state->rowsamples; ++state->sampleindex)
+ {
+ ensure_output_bytes(O, outbytes);
+ while (state->bitsin < state->components)
+ {
+ state->compin = (state->compin << 8) | row_byte(state);
+ state->bitsin += 8;
+ ++state->rowindex;
+ }
+ state->bitsin -= state->components;
+ d = state->compin >> state->bitsin;
+ state->compin &= (1 << state->bitsin) - 1;
+ c = d ^ left_pixel_value(state);
+ save_pixel_value(state, c);
+ state->compout = (state->compout << state->components) | c;
+ state->bitsout += state->components;
+ while (state->bitsout >= 8)
+ {
+ state->bitsout -= 8;
+ iof_set(O, state->compout >> state->bitsout);
+ state->compout &= (1 << state->bitsout) - 1;
+ }
+ }
+ if (state->bitsout > 0)
+ {
+ ensure_output_bytes(O, 1);
+ iof_set(O, state->compin << (8 - state->bitsout));
+ }
+ break;
+ case 2: case 4:
+ for ( ; state->sampleindex < state->rowsamples; ++state->sampleindex)
+ {
+ for ( ; state->compindex < state->components; ) // state->compindex is ++ed by save_pixel_component()
+ {
+ ensure_output_bytes(O, 1);
+ if (state->bitsin < state->compbits)
+ {
+ state->compin = (state->compin << 8) | row_byte(state);
+ state->bitsin += 8;
+ ++state->rowindex;
+ }
+ state->bitsin -= state->compbits;
+ d = state->compin >> state->bitsin;
+ state->compin &= (1 << state->bitsin) - 1;
+ c = (d + left_pixel_component(state)) & 0xff;
+ save_pixel_component(state, c);
+ state->compout = (state->compout << state->compbits) | c;
+ state->bitsout += state->compbits;
+ if (state->bitsout >= 8)
+ {
+ state->bitsout -= 8;
+ iof_set(O, state->compout >> state->bitsout);
+ state->compout &= (1 << state->bitsout) - 1;
+ }
+ }
+ }
+ if (state->bitsout > 0)
+ {
+ ensure_output_bytes(O, 1);
+ iof_set(O, state->compin << (8 - state->bitsout));
+ }
+ break;
+ case 8:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = (row_byte(state) + left_pixel_component(state)) & 0xff;
+ save_pixel_component(state, c);
+ iof_set(O, c);
+ }
+ break;
+ case 16:
+ for ( ; state->rowindex < state->rowsize - 1; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 2);
+ d = row_byte(state) << 8;
+ ++state->rowindex;
+ d |= row_byte(state);
+ c = (d + left_pixel_component(state)) & 0xffff;
+ save_pixel_component(state, c);
+ iof_set2(O, c >> 8, c & 0xff);
+ }
+ break;
+ default:
+ return IOFERR;
+ }
+ reset_tiff_row(state);
+ break;
+ case PNG_NONE_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ save_pixel_byte(state, c); // next row may need it
+ iof_set(O, c);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_SUB_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = (row_byte(state) + left_pixel_byte(state)) & 0xff;
+ save_pixel_byte(state, c);
+ iof_set(O, c);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_UP_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = (row_byte(state) + up_pixel_byte(state)) & 0xff;
+ save_pixel_byte(state, c);
+ iof_set(O, c);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_AVERAGE_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = (row_byte(state) + ((up_pixel_byte(state) + left_pixel_byte(state)) / 2)) & 0xff;
+ save_pixel_byte(state, c);
+ iof_set(O, c);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_PAETH_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = (row_byte(state) + paeth(state)) & 0xff;
+ save_pixel_byte(state, c);
+ iof_set(O, c);
+ }
+ reset_png_row(state);
+ break;
+ //case PNG_OPTIMUM_PREDICTOR: // valid as default_redictor, but not as algorithm identifier byte
+ default:
+ return IOFERR;
+ }
+ }
+ return state->status == STATUS_LAST ? IOFERR : IOFEOF;
+}
+
+/* predictor encoder */
+
+iof_status predictor_encode_state (iof *I, iof *O, predictor_state *state)
+{
+ int status, c, d, outbytes;
+ while (state->status == STATUS_CONTINUE)
+ {
+ read_row(state, I, state->rowsize, status);
+ if (state->current_predictor >= 10 && state->predictorbyte == 0)
+ {
+ ensure_output_bytes(O, 1);
+ iof_set(O, state->current_predictor - 10);
+ state->predictorbyte = 1;
+ }
+ switch (state->current_predictor)
+ {
+ case NONE_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ iof_set(O, c);
+ }
+ reset_row(state);
+ break;
+ case TIFF_PREDICTOR:
+ switch (state->compbits)
+ {
+ case 1:
+ outbytes = (state->components + 7) >> 3;
+ for ( ; state->sampleindex < state->rowsamples; ++state->sampleindex)
+ {
+ ensure_output_bytes(O, outbytes);
+ while (state->bitsin < state->components)
+ {
+ state->compin = (state->compin << 8) | row_byte(state);
+ state->bitsin += 8;
+ ++state->rowindex;
+ }
+ state->bitsin -= state->components;
+ c = state->compin >> state->bitsin;
+ state->compin &= (1 << state->bitsin) - 1;
+ d = c ^ left_pixel_value(state);
+ save_pixel_value(state, c);
+ state->compout = (state->compout << state->components) | d;
+ state->bitsout += state->components;
+ while (state->bitsout >= 8)
+ {
+ state->bitsout -= 8;
+ iof_set(O, state->compout >> state->bitsout);
+ state->compout &= (1 << state->bitsout) - 1;
+ }
+ }
+ if (state->bitsout > 0)
+ {
+ ensure_output_bytes(O, 1);
+ iof_set(O, state->compin << (8 - state->bitsout));
+ }
+ break;
+ case 2: case 4:
+ for ( ; state->sampleindex < state->rowsamples; ++state->sampleindex)
+ {
+ for ( ; state->compindex < state->components; )
+ {
+ ensure_output_bytes(O, 1);
+ if (state->bitsin < state->compbits)
+ {
+ state->compin = (state->compin << 8) | row_byte(state);
+ state->bitsin += 8;
+ ++state->rowindex;
+ }
+ state->bitsin -= state->compbits;
+ c = state->compin >> state->bitsin;
+ state->compin &= (1 << state->bitsin) - 1;
+ d = tocomp(c - left_pixel_component(state));
+ save_pixel_component(state, c);
+ state->compout = (state->compout << state->compbits) | d;
+ state->bitsout += state->compbits;
+ if (state->bitsout >= 8)
+ {
+ state->bitsout -= 8;
+ iof_set(O, state->compout >> state->bitsout);
+ state->compout &= (1 << state->bitsout) - 1;
+ }
+ }
+ }
+ if (state->bitsout > 0)
+ {
+ ensure_output_bytes(O, 1);
+ iof_set(O, state->compin << (8 - state->bitsout));
+ }
+ break;
+ case 8:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ d = tobyte(c - left_pixel_component(state));
+ save_pixel_component(state, c);
+ iof_set(O, d);
+ }
+ break;
+ case 16:
+ for ( ; state->rowindex < state->rowsize - 1; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 2);
+ c = row_byte(state) << 8;
+ ++state->rowindex;
+ c |= row_byte(state);
+ d = tocomp(c - left_pixel_component(state));
+ save_pixel_component(state, c);
+ iof_set2(O, d >> 8, d & 0xff);
+ }
+ break;
+ default:
+ return IOFERR;
+ }
+ reset_tiff_row(state);
+ break;
+ case PNG_NONE_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ save_pixel_byte(state, c); // next row may need it
+ iof_set(O, c);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_SUB_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ d = tobyte(c - left_pixel_byte(state));
+ save_pixel_byte(state, c);
+ iof_set(O, d);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_OPTIMUM_PREDICTOR: // not worthy to perform optimization
+ case PNG_UP_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ d = tobyte(c - up_pixel_byte(state));
+ save_pixel_byte(state, c);
+ iof_set(O, d);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_AVERAGE_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ d = tobyte(c - ((up_pixel_byte(state) + left_pixel_byte(state)) >> 1));
+ save_pixel_byte(state, c);
+ iof_set(O, d);
+ }
+ reset_png_row(state);
+ break;
+ case PNG_PAETH_PREDICTOR:
+ for ( ; state->rowindex < state->rowsize; ++state->rowindex)
+ {
+ ensure_output_bytes(O, 1);
+ c = row_byte(state);
+ d = tobyte(c - paeth(state));
+ save_pixel_byte(state, c);
+ iof_set(O, d);
+ }
+ reset_png_row(state);
+ break;
+ default:
+ return IOFERR;
+ }
+ }
+ return state->status == STATUS_LAST ? IOFERR : IOFEOF;
+}
+
+iof_status predictor_decode (iof *I, iof *O, int predictor, int rowsamples, int components, int compbits)
+{
+ predictor_state state;
+ int ret;
+ predictor_decoder_init(&state, predictor, rowsamples, components, compbits);
+ state.flush = 1;
+ ret = predictor_decode_state(I, O, &state);
+ predictor_decoder_close(&state);
+ return ret;
+}
+
+iof_status predictor_encode (iof *I, iof *O, int predictor, int rowsamples, int components, int compbits)
+{
+ predictor_state state;
+ int ret;
+ predictor_encoder_init(&state, predictor, rowsamples, components, compbits);
+ state.flush = 1;
+ ret = predictor_encode_state(I, O, &state);
+ predictor_encoder_close(&state);
+ return ret;
+}
+
+/* filters */
+
+// predictor decoder function
+
+static size_t predictor_decoder (iof *F, iof_mode mode)
+{
+ predictor_state *state;
+ iof_status status;
+ size_t tail;
+
+ state = iof_filter_state(predictor_state *, F);
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ do {
+ status = predictor_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "predictor", status);
+ case IOFCLOSE:
+ predictor_decoder_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// predictor encoder function
+
+static size_t predictor_encoder (iof *F, iof_mode mode)
+{
+ predictor_state *state;
+ iof_status status;
+
+ state = iof_filter_state(predictor_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = predictor_encode_state(F, F->next, state);
+ return iof_encoder_retval(F, "predictor", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ predictor_encoder(F, IOFFLUSH);
+ predictor_encoder_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+iof * iof_filter_predictor_decoder (iof *N, int predictor, int rowsamples, int components, int compbits)
+{
+ iof *I;
+ predictor_state_pointer P;
+ I = iof_filter_reader(predictor_decoder, sizeof(predictor_state), &P.voidstate);
+ iof_setup_next(I, N);
+ if (predictor_decoder_init(P.predictorstate, predictor, rowsamples, components, compbits) == NULL)
+ {
+ iof_discard(I);
+ return NULL;
+ }
+ P.predictorstate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_predictor_encoder (iof *N, int predictor, int rowsamples, int components, int compbits)
+{
+ iof *O;
+ predictor_state_pointer P;
+ O = iof_filter_writer(predictor_encoder, sizeof(predictor_state), &P.voidstate);
+ iof_setup_next(O, N);
+ if (predictor_encoder_init(P.predictorstate, predictor, rowsamples, components, compbits) == NULL)
+ {
+ iof_discard(O);
+ return NULL;
+ }
+ return O;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilfpred.h b/source/luametatex/source/libraries/pplib/util/utilfpred.h
new file mode 100644
index 000000000..6ae2f8935
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilfpred.h
@@ -0,0 +1,23 @@
+#ifndef UTIL_FILTER_PREDICTOR_H
+#define UTIL_FILTER_PREDICTOR_H
+
+#include "utiliof.h"
+
+typedef struct predictor_state predictor_state;
+
+predictor_state * predictor_decoder_init (predictor_state *state, int predictor, int rowsamples, int components, int compbits);
+predictor_state * predictor_encoder_init (predictor_state *state, int predictor, int rowsamples, int components, int compbits);
+
+void predictor_decoder_close (predictor_state *state);
+void predictor_encoder_close (predictor_state *state);
+
+iof_status predictor_decode_state (iof *I, iof *O, predictor_state *state);
+iof_status predictor_encode_state (iof *I, iof *O, predictor_state *state);
+
+iof_status predictor_decode (iof *I, iof *O, int predictor, int rowsamples, int components, int compbits);
+iof_status predictor_encode (iof *I, iof *O, int predictor, int rowsamples, int components, int compbits);
+
+iof * iof_filter_predictor_decoder (iof *N, int predictor, int rowsamples, int components, int compbits);
+iof * iof_filter_predictor_encoder (iof *N, int predictor, int rowsamples, int components, int compbits);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utiliof.c b/source/luametatex/source/libraries/pplib/util/utiliof.c
new file mode 100644
index 000000000..41d6fba38
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utiliof.c
@@ -0,0 +1,2993 @@
+/* input/output stream */
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+
+#include "utilmem.h"
+#include "utillog.h"
+#include "utiliof.h"
+
+/* commons */
+
+void * iof_copy_data (const void *data, size_t size)
+{
+ return memcpy(util_malloc(size), data, size);
+}
+
+uint8_t * iof_copy_file_data (const char *filename, size_t *psize)
+{
+ FILE *file;
+ size_t size;
+ uint8_t *data;
+ if ((file = fopen(filename, "rb")) == NULL)
+ return NULL;
+ fseek(file, 0, SEEK_END);
+ size = (size_t)ftell(file);
+ data = (uint8_t *)util_malloc(size);
+ fseek(file, 0, SEEK_SET);
+ if ((*psize = fread(data, 1, size, file)) != size)
+ {
+ util_free(data);
+ data = NULL;
+ }
+ fclose(file);
+ return data;
+}
+
+uint8_t * iof_copy_file_handle_data (FILE *file, size_t *psize)
+{
+ size_t size;
+ uint8_t *data;
+ //long offset = ftell(file); // keep offset intact?
+ fseek(file, 0, SEEK_END);
+ size = (size_t)ftell(file);
+ data = (uint8_t *)util_malloc(size);
+ fseek(file, 0, SEEK_SET);
+ if ((*psize = fread(data, 1, size, file)) != size)
+ {
+ util_free(data);
+ data = NULL;
+ }
+ //fseek(file, offset, SEEK_SET)
+ return data;
+}
+
+FILE * iof_get_file (iof *F)
+{
+ if (F->flags & IOF_FILE)
+ return iof_file_get_file(F->iofile);
+ if (F->flags & IOF_FILE_HANDLE)
+ return F->file;
+ return NULL;
+}
+
+const char * iof_status_kind (iof_status status)
+{
+ switch (status)
+ {
+ case IOFEOF:
+ return "IOFEOF";
+ case IOFERR:
+ return "IOFERR";
+ case IOFEMPTY:
+ return "IOFEMPTY";
+ case IOFFULL:
+ return "IOFFULL";
+ default:
+ break;
+ }
+ return "(unknown)";
+}
+
+/* shared pseudofile */
+
+#define IOF_FILE_DEFAULTS 0
+
+iof_file * iof_file_new (FILE *file)
+{
+ iof_file *iofile = (iof_file *)util_malloc(sizeof(iof_file));
+ iof_file_set_fh(iofile, file);
+ iofile->offset = NULL;
+ iofile->size = 0;
+ iofile->name = NULL;
+ iofile->refcount = 0;
+ iofile->flags = IOF_FILE_DEFAULTS|IOF_ALLOC;
+ return iofile;
+}
+
+iof_file * iof_file_init (iof_file *iofile, FILE *file)
+{
+ iof_file_set_fh(iofile, file);
+ iofile->offset = NULL;
+ iofile->size = 0;
+ iofile->name = NULL;
+ iofile->refcount = 0;
+ iofile->flags = IOF_FILE_DEFAULTS;
+ return iofile;
+}
+
+iof_file * iof_file_rdata (const void *data, size_t size)
+{
+ iof_file *iofile = (iof_file *)util_malloc(sizeof(iof_file));
+ iofile->rbuf = iofile->rpos = (const uint8_t *)data;
+ iofile->rend = iofile->rbuf + size;
+ iofile->offset = NULL;
+ iofile->size = 0;
+ iofile->name = NULL;
+ iofile->refcount = 0;
+ iofile->flags = IOF_FILE_DEFAULTS|IOF_ALLOC|IOF_DATA;
+ return iofile;
+}
+
+iof_file * iof_file_rdata_init (iof_file *iofile, const void *data, size_t size)
+{
+ iofile->rbuf = iofile->rpos = (const uint8_t *)data;
+ iofile->rend = iofile->rbuf + size;
+ iofile->offset = NULL;
+ iofile->size = 0; // lets keep it consequently set to zero (only for user disposition)
+ iofile->name = NULL;
+ iofile->refcount = 0;
+ iofile->flags = IOF_FILE_DEFAULTS|IOF_DATA;
+ return iofile;
+}
+
+iof_file * iof_file_wdata (void *data, size_t size)
+{
+ return iof_file_rdata((const void *)data, size);
+}
+
+iof_file * iof_file_wdata_init (iof_file *iofile, void *data, size_t size)
+{
+ return iof_file_rdata_init(iofile, (const void *)data, size);
+}
+
+/* typical uses so far */
+
+iof_file * iof_file_reader_from_file_handle (iof_file *iofile, const char *filename, FILE *file, int preload, int closefile)
+{
+ uint8_t *data;
+ size_t size;
+
+ if (preload)
+ {
+ if ((data = iof_copy_file_handle_data(file, &size)) == NULL)
+ {
+ if (closefile) // callers expect close also on failure
+ fclose(file);
+ return NULL;
+ }
+ if (iofile == NULL)
+ iofile = iof_file_rdata(data, size);
+ else
+ iof_file_rdata_init(iofile, data, size);
+ iofile->flags |= IOF_BUFFER_ALLOC;
+ if (closefile)
+ fclose(file);
+ }
+ else
+ {
+ if (iofile == NULL)
+ iofile = iof_file_new(file);
+ else
+ iof_file_init(iofile, file);
+ if (closefile)
+ iofile->flags |= IOF_CLOSE_FILE;
+ }
+ if (filename != NULL)
+ iof_file_set_name(iofile, filename);
+ return iofile;
+}
+
+iof_file * iof_file_reader_from_file (iof_file *iofile, const char *filename, int preload)
+{
+ FILE *file;
+ if ((file = fopen(filename, "rb")) == NULL)
+ return NULL;
+ return iof_file_reader_from_file_handle(iofile, filename, file, preload, 1); // takes care to fclose() on failure
+}
+
+iof_file * iof_file_reader_from_data (iof_file *iofile, const void *data, size_t size, int preload, int freedata)
+{
+ void *newdata;
+ if (data == NULL)
+ return NULL;
+ if (preload)
+ {
+ newdata = iof_copy_data(data, size);
+ if (iofile == NULL)
+ iofile = iof_file_rdata(newdata, size);
+ else
+ iof_file_rdata_init(iofile, newdata, size);
+ iofile->flags |= IOF_BUFFER_ALLOC;
+ //if (freedata) // hardly makes sense... we can't free const void *
+ // util_free((void *)data);
+ }
+ else
+ {
+ if (iofile == NULL)
+ iofile = iof_file_rdata(data, size);
+ else
+ iof_file_rdata_init(iofile, data, size);
+ if (freedata)
+ iofile->flags |= IOF_BUFFER_ALLOC;
+ }
+ return iofile;
+}
+
+/*
+iof_file * iof_file_writer_from_file (iof_file *iofile, const char *filename)
+{
+ FILE *file;
+ if ((file = fopen(filename, "wb")) == NULL)
+ return NULL;
+ if (iofile == NULL)
+ iofile = iof_file_new(file);
+ else
+ iof_file_init(iofile, file);
+ iofile->flags |= IOF_CLOSE_FILE;
+ iof_file_set_name(iofile, filename);
+ return iofile;
+}
+*/
+
+/*
+Because of limited number of FILE* handles available, we may need to close/reopen a file handle
+when accessing it. In applications so far (fonts, images) we typically need the entire source
+to parse the file on object creation and to rewrite or reload the data on dump. All iof_file API
+functions assume that iofile has FILE* opened. Reopening it on every access (ftell, fseek, read/write)
+makes no sense. So if the caller invalidates iofile by closing and NULLing its file handle,
+it is also responsible to reopen when necessary.
+*/
+
+int iof_file_reclose_input (iof_file *iofile)
+{
+ FILE *file;
+ if (iofile->flags & IOF_DATA)
+ return 0;
+ if ((file = iof_file_get_fh(iofile)) == NULL)
+ return 0;
+ fclose(file);
+ iof_file_set_fh(iofile, NULL);
+ iofile->flags &= ~IOF_RECLOSE_FILE;
+ iofile->flags |= IOF_REOPEN_FILE;
+ return 1;
+}
+
+int iof_file_reopen_input (iof_file *iofile)
+{ // returns true if iofile readable
+ FILE *file;
+ const char *filename;
+ if (iofile->flags & IOF_DATA)
+ return 1;
+ if ((file = iof_file_get_fh(iofile)) != NULL)
+ return 1; // if present, assumed readable
+ if ((filename = iofile->name) == NULL || (file = fopen(filename, "rb")) == NULL)
+ return 0;
+ iof_file_set_fh(iofile, file);
+ iofile->flags &= ~IOF_REOPEN_FILE;
+ iofile->flags |= IOF_RECLOSE_FILE;
+ return 1;
+}
+
+/* freeing iof_file */
+
+void iof_file_free (iof_file *iofile)
+{
+ FILE *file;
+ if (iofile->flags & IOF_DATA)
+ {
+ if (iofile->flags & IOF_BUFFER_ALLOC)
+ {
+ iofile->flags &= ~IOF_BUFFER_ALLOC;
+ if (iofile->buf != NULL)
+ {
+ util_free(iofile->buf);
+ iofile->buf = iofile->pos = iofile->end = NULL;
+ }
+ }
+ }
+ else if ((file = iof_file_get_fh(iofile)) != NULL)
+ {
+ if (iofile->flags & IOF_CLOSE_FILE)
+ fclose(file);
+ iof_file_set_fh(iofile, NULL);
+ }
+ iof_file_set_name(iofile, NULL);
+ if (iofile->flags & IOF_ALLOC)
+ util_free(iofile);
+}
+
+/*
+An attempt to close iofile input keeping things safe. In bindings we sometimes we need to force
+closing the file handle, otherwise it is closed when garbage collector graciously calls destroyer.
+Eg. we are done with an object representing pdf/image/font, but we can't move/replace it, as the
+host language keeps the garbage that keeps a file handle. When we call fclose(), we also have to
+set the handle to NULL. In many places we assume, that if the iofile wraps FILE *, than the handle
+is operable (no NULL checks). To close the handle keeping iofile alive safe, we can silently convert
+it dummy IOF_DATA buffer.
+*/
+
+void iof_file_close_input (iof_file *iofile)
+{
+ FILE *file;
+ if (iofile->flags & IOF_DATA)
+ {
+ if (iofile->flags & IOF_BUFFER_ALLOC)
+ {
+ iofile->flags &= ~IOF_BUFFER_ALLOC;
+ if (iofile->buf != NULL)
+ {
+ util_free(iofile->buf);
+ //iofile->buf = iofile->pos = iofile->end = NULL;
+ }
+ }
+ }
+ else if ((file = iof_file_get_fh(iofile)) != NULL)
+ {
+ iof_file_set_fh(iofile, NULL);
+ fclose(file);
+ }
+ iof_file_set_name(iofile, NULL);
+ /* now make it a dummy string iofile */
+ iofile->buf = iofile->pos = iofile->end = NULL;
+ iofile->flags |= IOF_DATA;
+}
+
+/* set filename for reopen */
+
+void iof_file_set_name (iof_file *iofile, const char *name)
+{
+ if (iofile->name != NULL)
+ util_free(iofile->name);
+ if (name != NULL)
+ iofile->name = iof_copy_data(name, strlen(name) + 1);
+ else
+ iofile->name = NULL;
+}
+
+/* seek */
+
+int iof_file_seek (iof_file *iofile, long offset, int whence)
+{
+ if (iofile->flags & IOF_DATA)
+ {
+ switch (whence)
+ {
+ case SEEK_SET:
+ if (offset >= 0 && iofile->buf + offset <= iofile->end)
+ {
+ iofile->pos = iofile->buf + offset;
+ return 0;
+ }
+ return -1;
+ case SEEK_CUR:
+ if ((offset >= 0 && iofile->pos + offset <= iofile->end) || (offset < 0 && iofile->pos + offset >= iofile->buf))
+ {
+ iofile->pos += offset;
+ return 0;
+ }
+ return -1;
+ case SEEK_END:
+ if (offset <= 0 && iofile->end + offset >= iofile->buf)
+ {
+ iofile->pos = iofile->end + offset;
+ return 0;
+ }
+ return -1;
+ }
+ return -1;
+ }
+ return fseek(iof_file_get_fh(iofile), offset, whence);
+}
+
+/* */
+
+long iof_file_tell (iof_file *iofile)
+{
+ return (iofile->flags & IOF_DATA) ? (long)(iofile->pos - iofile->buf) : ftell(iof_file_get_fh(iofile));
+}
+
+size_t iof_file_size (iof_file *iofile)
+{
+ long pos, size;
+ FILE *file;
+ if (iofile->flags & IOF_DATA)
+ return (size_t)iof_space(iofile);
+ file = iof_file_get_fh(iofile);
+ pos = ftell(file);
+ fseek(file, 0, SEEK_END);
+ size = ftell(file);
+ fseek(file, pos, SEEK_SET);
+ return size;
+}
+
+int iof_file_eof (iof_file *iofile)
+{
+ if (iofile->flags & IOF_DATA)
+ return iofile->pos == iofile->end ? -1 : 0;
+ return feof(iof_file_get_fh(iofile));
+}
+
+int iof_file_flush (iof_file *iofile)
+{
+ if (iofile->flags & IOF_DATA)
+ return 0;
+ return fflush(iof_file_get_fh(iofile));
+}
+
+size_t iof_file_read (void *ptr, size_t size, size_t items, iof_file *iofile)
+{
+ if (iofile->flags & IOF_DATA)
+ {
+ size_t bytes = size * items;
+ if (bytes > (size_t)iof_left(iofile))
+ bytes = (size_t)iof_left(iofile);
+ memcpy(ptr, iofile->pos, bytes);
+ iofile->pos += bytes;
+ return bytes / size; // number of elements read
+ }
+ return fread(ptr, size, items, iof_file_get_fh(iofile));
+}
+
+static size_t iof_file_data_resizeto (iof_file *iofile, size_t space)
+{
+ uint8_t *newbuf;
+ size_t size;
+ size = iof_size(iofile);
+ if (iofile->flags & IOF_BUFFER_ALLOC)
+ {
+ newbuf = (uint8_t *)util_realloc(iofile->buf, space);
+ }
+ else
+ {
+ newbuf = (uint8_t *)util_malloc(space);
+ if (size > 0)
+ memcpy(newbuf, iofile->buf, size);
+ iofile->flags |= IOF_BUFFER_ALLOC;
+ }
+ iofile->buf = newbuf;
+ iofile->pos = newbuf + size;
+ iofile->end = newbuf + space;
+ return space - size;
+}
+
+#define iof_file_data_resize(iofile) iof_file_data_resizeto(iofile, iof_space(iofile) << 1)
+
+size_t iof_file_write (const void *ptr, size_t size, size_t items, iof_file *iofile)
+{
+ if (iofile->flags & IOF_DATA)
+ {
+ size_t space, sizesofar, bytes;
+ bytes = size * items;
+ if (bytes > (size_t)iof_left(iofile))
+ {
+ if ((space = iof_space(iofile)) == 0) // allow iofile->buf/end initially NULL
+ space = BUFSIZ;
+ for (sizesofar = iof_size(iofile), space <<= 1; sizesofar + bytes > space; space <<= 1)
+ ;
+ if (iof_file_data_resizeto(iofile, space) == 0)
+ return 0;
+ }
+ memcpy(iofile->pos, ptr, bytes);
+ iofile->pos += bytes;
+ return bytes / size;
+ }
+ return fwrite(ptr, size, items, iof_file_get_fh(iofile));
+}
+
+size_t iof_file_ensure (iof_file *iofile, size_t bytes)
+{
+ if (iofile->flags & IOF_DATA)
+ {
+ size_t space, sizesofar, left;
+ left = (size_t)iof_left(iofile);
+ if (bytes > left)
+ {
+ if ((space = iof_space(iofile)) == 0) // allow iofile->buf/end initially NULL
+ space = BUFSIZ;
+ for (sizesofar = iof_size(iofile), space <<= 1; sizesofar + bytes > space; space <<= 1);
+ return iof_file_data_resizeto(iofile, space);
+ }
+ return left;
+ }
+ return 0;
+}
+
+int iof_file_getc (iof_file *iofile)
+{
+ if (iofile->flags & IOF_DATA)
+ return iofile->pos < iofile->end ? *iofile->pos++ : IOFEOF;
+ return fgetc(iof_file_get_fh(iofile));
+}
+
+int iof_file_putc (iof_file *iofile, int c)
+{
+ if (iofile->flags & IOF_DATA)
+ {
+ if (iofile->pos >= iofile->end)
+ if (iof_file_data_resize(iofile) == 0)
+ return IOFEOF;
+ *iofile->pos++ = (uint8_t)c;
+ return c;
+ }
+ return fputc(c, iof_file_get_fh(iofile));
+}
+
+static int iof_file_sync (iof_file *iofile, size_t *offset)
+{
+ if (iofile->offset != offset)
+ {
+ if (iofile->offset != NULL)
+ *iofile->offset = iof_file_tell(iofile);
+ iofile->offset = offset;
+ if (offset) // let offset be NULL
+ return iof_file_seek(iofile, (long)*offset, SEEK_SET);
+ }
+ return 0;
+}
+
+//#define iof_file_unsync(iofile, poffset) (void)((iofile)->offset == poffset && (((iofile)->offset = NULL), 0))
+#define iof_file_unsync(iofile, poffset) ((void)poffset, (iofile)->offset = NULL)
+
+/* iof seek */
+
+#define iof_reader_reset(I) ((I)->pos = (I)->end = (I)->buf)
+#define iof_reader_reseek_file(I, offset, whence) (fseek((I)->file, offset, whence) == 0 ? (iof_reader_reset(I), 0) : -1)
+#define iof_reader_reseek_iofile(I, offset, whence) (iof_file_seek((I)->iofile, offset, whence) == 0 ? (iof_reader_reset(I), 0) : -1)
+
+#define iof_writer_reset(O) ((O)->pos = (O)->buf)
+#define iof_writer_reseek_file(O, offset, whence) (iof_flush(O), (fseek((O)->file, offset, whence) == 0 ? (iof_writer_reset(O), 0) : -1))
+#define iof_writer_reseek_iofile(O, offset, whence) (iof_flush(O), (iof_file_seek((O)->iofile, offset, whence) == 0 ? (iof_writer_reset(O), 0) : -1))
+
+static int iof_reader_seek_data (iof *I, long offset, int whence)
+{
+ switch (whence)
+ {
+ case SEEK_SET:
+ if (offset >= 0 && I->buf + offset <= I->end)
+ {
+ I->pos = I->buf + offset;
+ return 0;
+ }
+ return -1;
+ case SEEK_CUR:
+ if ((offset >= 0 && I->pos + offset <= I->end) || (offset < 0 && I->pos + offset >= I->buf))
+ {
+ I->pos += offset;
+ return 0;
+ }
+ return -1;
+ case SEEK_END:
+ if (offset <= 0 && I->end + offset >= I->buf)
+ {
+ I->pos = I->end + offset;
+ return 0;
+ }
+ return -1;
+ }
+ return -1;
+}
+
+static int iof_reader_seek_iofile (iof *I, long offset, int whence)
+{
+ long fileoffset;
+ switch (whence)
+ {
+ case SEEK_SET:
+ fileoffset = iof_file_tell(I->iofile);
+ if (offset <= fileoffset && offset >= fileoffset - iof_space(I))
+ {
+ I->pos = I->end - (fileoffset - offset);
+ return 0;
+ }
+ return iof_reader_reseek_iofile(I, offset, SEEK_SET);
+ case SEEK_CUR:
+ if ((offset >= 0 && I->pos + offset <= I->end) || (offset < 0 && I->pos + offset >= I->buf))
+ {
+ I->pos += offset;
+ return 0;
+ }
+ return iof_reader_reseek_iofile(I, offset, SEEK_CUR);
+ case SEEK_END:
+ return iof_reader_reseek_iofile(I, offset, SEEK_END); // can we do better?
+ }
+ return -1;
+}
+
+static int iof_reader_seek_file (iof *I, long offset, int whence)
+{
+ long fileoffset;
+ switch (whence)
+ {
+ case SEEK_SET:
+ fileoffset = ftell(I->file);
+ if (offset <= fileoffset && offset >= fileoffset - iof_space(I))
+ {
+ I->pos = I->end - (fileoffset - offset);
+ return 0;
+ }
+ return iof_reader_reseek_file(I, offset, SEEK_SET);
+ case SEEK_CUR:
+ if ((offset >= 0 && I->pos + offset <= I->end) || (offset < 0 && I->pos + offset >= I->buf))
+ {
+ I->pos += offset;
+ return 0;
+ }
+ return iof_reader_reseek_file(I, offset, SEEK_CUR);
+ case SEEK_END:
+ return iof_reader_reseek_file(I, offset, SEEK_END); // can we do better?
+ }
+ return -1;
+}
+
+int iof_reader_seek (iof *I, long offset, int whence)
+{
+ I->flags &= ~IOF_STOPPED;
+ if (I->flags & IOF_FILE)
+ return iof_reader_seek_iofile(I, offset, whence);
+ if (I->flags & IOF_FILE_HANDLE)
+ return iof_reader_seek_file(I, offset, whence);
+ if (I->flags & IOF_DATA)
+ return iof_reader_seek_data(I, offset, whence);
+ return -1;
+}
+
+int iof_reader_reseek (iof *I, long offset, int whence)
+{
+ I->flags &= ~IOF_STOPPED;
+ if (I->flags & IOF_FILE)
+ return iof_reader_reseek_iofile(I, offset, whence);
+ if (I->flags & IOF_FILE_HANDLE)
+ return iof_reader_reseek_file(I, offset, whence);
+ if (I->flags & IOF_DATA)
+ return iof_reader_seek_data(I, offset, whence);
+ return -1;
+}
+
+static int iof_writer_seek_data (iof *O, long offset, int whence)
+{
+ /*
+ fseek() allows to seek after the end of file. Seeking does not increase the output file.
+ No byte is written before fwirte(). It seems to fill the gap with zeros. Until we really need that,
+ no seeking out of bounds for writers.
+ */
+ O->flags &= ~IOF_STOPPED;
+ return iof_reader_seek_data(O, offset, whence);
+}
+
+static int iof_writer_seek_iofile (iof *O, long offset, int whence)
+{
+ long fileoffset;
+ switch (whence)
+ {
+ case SEEK_SET:
+ fileoffset = iof_file_tell(O->iofile);
+ if (offset >= fileoffset && offset <= fileoffset + iof_space(O))
+ {
+ O->pos = O->buf + (offset - fileoffset);
+ return 0;
+ }
+ return iof_writer_reseek_iofile(O, offset, SEEK_SET);
+ case SEEK_CUR:
+ if ((offset >=0 && O->pos + offset <= O->end) || (offset < 0 && O->pos + offset >= O->buf))
+ {
+ O->pos += offset;
+ return 0;
+ }
+ return iof_writer_reseek_iofile(O, offset, SEEK_CUR);
+ case SEEK_END:
+ return iof_writer_reseek_iofile(O, offset, SEEK_END);
+ }
+ return -1;
+}
+
+static int iof_writer_seek_file (iof *O, long offset, int whence)
+{
+ long fileoffset;
+ switch (whence)
+ {
+ case SEEK_SET:
+ fileoffset = ftell(O->file);
+ if (offset >= fileoffset && offset <= fileoffset + iof_space(O))
+ {
+ O->pos = O->buf + (offset - fileoffset);
+ return 0;
+ }
+ return iof_writer_reseek_file(O, offset, SEEK_SET);
+ case SEEK_CUR:
+ if ((offset >=0 && O->pos + offset <= O->end) || (offset < 0 && O->pos + offset >= O->buf))
+ {
+ O->pos += offset;
+ return 0;
+ }
+ return iof_writer_reseek_file(O, offset, SEEK_CUR);
+ case SEEK_END:
+ return iof_writer_reseek_file(O, offset, SEEK_END);
+ }
+ return -1;
+}
+
+int iof_writer_seek (iof *I, long offset, int whence)
+{
+ I->flags &= ~IOF_STOPPED;
+ if (I->flags & IOF_FILE)
+ return iof_writer_seek_iofile(I, offset, whence);
+ if (I->flags & IOF_FILE_HANDLE)
+ return iof_writer_seek_file(I, offset, whence);
+ if (I->flags & IOF_DATA)
+ return iof_writer_seek_data(I, offset, whence);
+ return -1;
+}
+
+int iof_writer_reseek (iof *I, long offset, int whence)
+{
+ I->flags &= ~IOF_STOPPED;
+ if (I->flags & IOF_FILE)
+ return iof_writer_reseek_iofile(I, offset, whence);
+ if (I->flags & IOF_FILE_HANDLE)
+ return iof_writer_reseek_file(I, offset, whence);
+ if (I->flags & IOF_DATA)
+ return iof_writer_seek_data(I, offset, whence);
+ return -1;
+}
+
+int iof_seek (iof *F, long offset, int whence)
+{
+ return (F->flags & IOF_WRITER) ? iof_writer_seek(F, offset, whence) : iof_reader_seek(F, offset, whence);
+}
+
+int iof_reseek (iof *F, long offset, int whence)
+{
+ return (F->flags & IOF_WRITER) ? iof_writer_reseek(F, offset, whence) : iof_reader_reseek(F, offset, whence);
+}
+
+/* tell */
+
+long iof_reader_tell (iof *I)
+{
+ if (I->flags & IOF_FILE)
+ return iof_file_tell(I->iofile) - (long)iof_left(I);
+ if (I->flags & IOF_FILE_HANDLE)
+ return ftell(I->file) - (long)iof_left(I);
+ //if (I->flags & IOF_DATA)
+ return (long)iof_size(I);
+}
+
+long iof_writer_tell (iof *O)
+{
+ if (O->flags & IOF_FILE)
+ return iof_file_tell(O->iofile) + (long)iof_size(O);
+ if (O->flags & IOF_FILE_HANDLE)
+ return ftell(O->file) + (long)iof_size(O);
+ //if (I->flags & IOF_DATA)
+ return (long)iof_size(O);
+}
+
+long iof_tell (iof *I)
+{
+ return (I->flags & IOF_WRITER) ? iof_writer_tell(I) : iof_reader_tell(I);
+}
+
+size_t iof_fsize (iof *I)
+{
+ size_t pos, size;
+ if (I->flags & IOF_FILE)
+ return iof_file_size(I->iofile);
+ if (I->flags & IOF_FILE_HANDLE)
+ {
+ pos = (size_t)ftell(I->file);
+ fseek(I->file, 0, SEEK_END);
+ size = (size_t)ftell(I->file);
+ fseek(I->file, (long)pos, SEEK_SET);
+ return size;
+ }
+ //if (I->flags & IOF_DATA)
+ return (size_t)iof_space(I);
+}
+
+/* save reader tail */
+
+size_t iof_save_tail (iof *I)
+{
+ size_t size, left;
+ size = iof_size(I);
+ left = iof_left(I);
+ if (size >= left)
+ memcpy(I->buf, I->pos, left);
+ else
+ memmove(I->buf, I->pos, left);
+ return left;
+}
+
+size_t iof_input_save_tail (iof *I, size_t back)
+{
+ size_t size;
+ I->flags |= IOF_TAIL;
+ I->pos -= back;
+ size = iof_input(I);
+ I->pos += back;
+ I->flags &= ~IOF_TAIL;
+ return size; // + back - back
+}
+
+/* read from file */
+
+/* iof free*/
+
+static size_t file_read (iof *I);
+static size_t file_load (iof *I);
+
+static size_t file_reader (iof *I, iof_mode mode)
+{
+ switch (mode)
+ {
+ case IOFREAD:
+ return file_read(I);
+ case IOFLOAD:
+ return file_load(I);
+ case IOFCLOSE:
+ iof_free(I);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+iof * iof_setup_file_handle_reader (iof *I, void *buffer, size_t space, FILE *f)
+{
+ iof_setup_reader(I, buffer, space);
+ iof_setup_file(I, f);
+ I->more = file_reader;
+ return I;
+}
+
+iof * iof_setup_file_reader (iof *I, void *buffer, size_t space, const char *filename)
+{
+ FILE *f;
+ if ((f = fopen(filename, "rb")) == NULL)
+ return NULL;
+ iof_setup_reader(I, buffer, space);
+ iof_setup_file(I, f);
+ I->flags |= IOF_CLOSE_FILE;
+ I->more = file_reader;
+ return I;
+}
+
+/* write to file */
+
+static size_t file_write (iof *O, int flush);
+
+static size_t file_writer (iof *O, iof_mode mode)
+{
+ switch (mode)
+ {
+ case IOFWRITE:
+ return file_write(O, 0);
+ case IOFFLUSH:
+ return file_write(O, 1);
+ case IOFCLOSE:
+ file_write(O, 1);
+ iof_free(O);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+iof * iof_setup_file_handle_writer (iof *O, void *buffer, size_t space, FILE *f)
+{
+ iof_setup_writer(O, buffer, space);
+ iof_setup_file(O, f);
+ O->more = file_writer;
+ return O;
+}
+
+iof * iof_setup_file_writer (iof *O, void *buffer, size_t space, const char *filename)
+{
+ FILE *f;
+ if ((f = fopen(filename, "wb")) == NULL)
+ return NULL;
+ iof_setup_writer(O, buffer, space);
+ iof_setup_file(O, f);
+ O->flags |= IOF_CLOSE_FILE;
+ O->more = file_writer;
+ return O;
+}
+
+/* a dedicated handler for stdout/stderr */
+
+static size_t stdout_writer (iof *O, iof_mode mode)
+{
+ switch(mode)
+ {
+ case IOFWRITE:
+ {
+ fwrite(O->buf, sizeof(uint8_t), iof_size(O), stdout);
+ O->pos = O->buf;
+ return O->space;
+ }
+ case IOFCLOSE:
+ case IOFFLUSH:
+ {
+ fwrite(O->buf, sizeof(uint8_t), iof_size(O), stdout);
+ fflush(stdout);
+ O->pos = O->buf;
+ return 0;
+ }
+ default:
+ break;
+ }
+ return 0;
+}
+
+static size_t stderr_writer (iof *O, iof_mode mode)
+{
+ switch(mode)
+ {
+ case IOFWRITE:
+ {
+ fwrite(O->buf, sizeof(uint8_t), iof_size(O), stderr);
+ O->pos = O->buf;
+ return O->space;
+ }
+ case IOFCLOSE:
+ case IOFFLUSH:
+ {
+ fwrite(O->buf, sizeof(uint8_t), iof_size(O), stderr);
+ fflush(stderr);
+ O->pos = O->buf;
+ return 0;
+ }
+ default:
+ break;
+ }
+ return 0;
+}
+
+static uint8_t iof_stdout_buffer[BUFSIZ];
+iof iof_stdout = IOF_WRITER_INIT(stdout_writer, NULL, iof_stdout_buffer, BUFSIZ, 0);
+
+static uint8_t iof_stderr_buffer[BUFSIZ];
+iof iof_stderr = IOF_WRITER_INIT(stderr_writer, NULL, iof_stderr_buffer, BUFSIZ, 0);
+
+/* read from somewhere */
+
+iof * iof_reader (iof *I, void *link, iof_handler reader, const void *m, size_t bytes)
+{
+ I->space = 0;
+ I->link = link;
+ I->more = reader;
+ I->flags = 0;
+ I->refcount = 0;
+ if (m != NULL)
+ {
+ I->rbuf = I->rpos = (const uint8_t *)m;
+ I->rend = (const uint8_t *)m + bytes;
+ return I;
+ }
+ return NULL;
+}
+
+iof * iof_string_reader (iof *I, const void *s, size_t bytes)
+{
+ I->space = 0;
+ I->link = NULL;
+ I->more = NULL;
+ I->flags = 0; // iof_string() sets IOF_DATA
+ I->refcount = 0;
+ if (s != NULL)
+ return iof_string(I, s, bytes);
+ return NULL;
+}
+
+/* write somewhere */
+
+iof * iof_writer (iof *O, void *link, iof_handler writer, void *m, size_t bytes)
+{
+ O->space = 0;
+ O->link = link;
+ O->more = writer;
+ O->flags = 0;
+ O->refcount = 0;
+ if (m != NULL && bytes > 0)
+ {
+ O->buf = O->pos = (uint8_t *)m;
+ O->end = (uint8_t *)m + bytes;
+ return O;
+ }
+ // return iof_null(O);
+ return NULL;
+}
+
+/* write to growing bytes buffer */
+
+static size_t iof_mem_handler (iof *O, iof_mode mode)
+{
+ switch(mode)
+ {
+ case IOFWRITE:
+ return iof_resize_buffer(O);
+ case IOFCLOSE:
+ iof_free(O);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+iof * iof_setup_buffer (iof *O, void *buffer, size_t space)
+{
+ iof_setup_writer(O, buffer, space);
+ O->link = NULL;
+ O->flags |= IOF_DATA;
+ O->more = iof_mem_handler;
+ return O;
+}
+
+iof * iof_setup_buffermin (iof *O, void *buffer, size_t space, size_t min)
+{
+ iof_setup_buffer(O, buffer, space);
+ if (space < min) // allocate min to avoid further rewriting
+ {
+ O->buf = O->pos = (uint8_t *)util_malloc(min);
+ O->flags |= IOF_BUFFER_ALLOC;
+ O->end = O->buf + min;
+ }
+ return O;
+}
+
+iof * iof_buffer_create (size_t space)
+{
+ uint8_t *buffer;
+ iof *O;
+ O = (iof *)util_malloc(space);
+ buffer = (uint8_t *)(O + 1);
+ iof_setup_buffer(O, buffer, space);
+ O->flags |= IOF_ALLOC;
+ return O;
+}
+
+/* set/get */
+
+int iof_getc (iof *I)
+{
+ if (iof_readable(I))
+ return *I->pos++;
+ return IOFEOF;
+}
+
+int iof_putc (iof *O, int u)
+{
+ if (iof_writable(O))
+ {
+ iof_set(O, u);
+ return (uint8_t)u;
+ }
+ return IOFFULL;
+}
+
+size_t iof_skip (iof *I, size_t bytes)
+{
+ while (bytes)
+ {
+ if (iof_readable(I))
+ ++I->pos;
+ else
+ break;
+ --bytes;
+ }
+ return bytes;
+}
+
+/* from iof to iof */
+
+iof_status iof_pass (iof *I, iof *O)
+{
+ size_t leftin, leftout;
+ if ((leftin = iof_left(I)) == 0)
+ leftin = iof_input(I);
+ while (leftin)
+ {
+ if ((leftout = iof_left(O)) == 0)
+ if ((leftout = iof_output(O)) == 0)
+ return IOFFULL;
+ while (leftin > leftout)
+ {
+ memcpy(O->pos, I->pos, leftout);
+ I->pos += leftout;
+ O->pos = O->end; /* eq. += leftout */
+ leftin -= leftout;
+ if ((leftout = iof_output(O)) == 0)
+ return IOFFULL;
+ }
+ if (leftin)
+ {
+ memcpy(O->pos, I->pos, leftin);
+ I->pos = I->end; /* eq. += leftin */
+ O->pos += leftin;
+ }
+ leftin = iof_input(I);
+ }
+ return IOFEOF;
+}
+
+/* read n-bytes */
+
+size_t iof_read (iof *I, void *to, size_t size)
+{
+ size_t leftin, done = 0;
+ char *s = (char *)to;
+
+ if ((leftin = iof_left(I)) == 0)
+ if ((leftin = iof_input(I)) == 0)
+ return done;
+ while (size > leftin)
+ {
+ memcpy(s, I->pos, leftin * sizeof(uint8_t));
+ size -= leftin;
+ done += leftin;
+ s += leftin;
+ I->pos = I->end;
+ if ((leftin = iof_input(I)) == 0)
+ return done;
+ }
+ if (size)
+ {
+ memcpy(s, I->pos, size * sizeof(uint8_t));
+ I->pos += size;
+ done += size;
+ }
+ return done;
+}
+
+/* rewrite FILE content (use fseek if needed) */
+
+size_t iof_write_file_handle (iof *O, FILE *file)
+{
+ size_t leftout, size, readout;
+ if ((leftout = iof_left(O)) == 0)
+ if ((leftout = iof_output(O)) == 0)
+ return 0;
+ size = 0;
+ do {
+ readout = fread(O->pos, 1, leftout, file);
+ O->pos += readout;
+ size += readout;
+ } while(readout == leftout && (leftout = iof_output(O)) > 0);
+ return size;
+}
+
+size_t iof_write_file (iof *O, const char *filename)
+{
+ FILE *file;
+ size_t size;
+ if ((file = fopen(filename, "rb")) == NULL)
+ return 0;
+ size = iof_write_file_handle(O, file);
+ fclose(file);
+ return size;
+}
+
+size_t iof_write_iofile (iof *O, iof_file *iofile, int savepos)
+{
+ long offset;
+ size_t size;
+ FILE *file;
+ if (iofile->flags & IOF_DATA)
+ return iof_write(O, iofile->pos, (size_t)(iofile->end - iofile->pos));
+ file = iof_file_get_fh(iofile);
+ if (savepos)
+ {
+ offset = ftell(file);
+ size = iof_write_file_handle(O, file);
+ fseek(file, offset, SEEK_SET);
+ return size;
+ }
+ return iof_write_file_handle(O, file);
+}
+
+/* write n-bytes */
+
+size_t iof_write (iof *O, const void *data, size_t size)
+{
+ size_t leftout, done = 0;
+ const char *s = (const char *)data;
+ if ((leftout = iof_left(O)) == 0)
+ if ((leftout = iof_output(O)) == 0)
+ return done;
+ while (size > leftout)
+ {
+ memcpy(O->pos, s, leftout * sizeof(uint8_t));
+ size -= leftout;
+ done += leftout;
+ s += leftout;
+ O->pos = O->end;
+ if ((leftout = iof_output(O)) == 0)
+ return done;
+ }
+ if (size)
+ {
+ memcpy(O->pos, s, size * sizeof(uint8_t));
+ O->pos += size;
+ done += size;
+ }
+ return done;
+}
+
+/* write '\0'-terminated string */
+
+iof_status iof_puts (iof *O, const void *data)
+{
+ const char *s = (const char *)data;
+ while (*s)
+ {
+ if (iof_writable(O))
+ iof_set(O, *s++);
+ else
+ return IOFFULL;
+ }
+ return IOFEOF; // ?
+}
+
+size_t iof_put_string (iof *O, const void *data)
+{
+ const char *p, *s = (const char *)data;
+ for (p = s; *p != '\0' && iof_writable(O); iof_set(O, *p++));
+ return p - s;
+}
+
+/* write byte n-times */
+
+/*
+iof_status iof_repc (iof *O, char c, size_t bytes)
+{
+ while (bytes)
+ {
+ if (iof_writable(O))
+ iof_set(O, c);
+ else
+ return IOFFULL;
+ --bytes;
+ }
+ return IOFEOF; // ?
+}
+*/
+
+size_t iof_repc (iof *O, char c, size_t bytes)
+{
+ size_t leftout, todo = bytes;
+ if ((leftout = iof_left(O)) == 0)
+ if ((leftout = iof_output(O)) == 0)
+ return 0;
+ while (bytes > leftout)
+ {
+ memset(O->pos, c, leftout);
+ bytes -= leftout;
+ O->pos = O->end;
+ if ((leftout = iof_output(O)) == 0)
+ return todo - bytes;
+ }
+ if (bytes)
+ {
+ memset(O->pos, c, bytes);
+ O->pos += bytes;
+ }
+ return todo;
+}
+
+/* putfs */
+
+#define IOF_FMT_SIZE 1024
+
+size_t iof_putfs (iof *O, const char *format, ...)
+{
+ static char buffer[IOF_FMT_SIZE];
+ va_list args;
+ va_start(args, format);
+ if (vsnprintf(buffer, IOF_FMT_SIZE, format, args) > 0)
+ {
+ va_end(args);
+ return iof_put_string(O, buffer);
+ }
+ else
+ {
+ va_end(args);
+ return iof_write(O, buffer, IOF_FMT_SIZE);
+ }
+}
+
+/* integer from iof; return 1 on success, 0 otherwise */
+
+int iof_get_int32 (iof *I, int32_t *number)
+{
+ int sign, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_get_slong (iof *I, long *number)
+{
+ int sign, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_get_int64 (iof *I, int64_t *number)
+{
+ int sign, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_get_uint32 (iof *I, uint32_t *number)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ return 1;
+}
+
+int iof_get_ulong (iof *I, unsigned long *number)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ return 1;
+}
+
+int iof_get_usize (iof *I, size_t *number)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ return 1;
+}
+
+int iof_get_uint64 (iof *I, uint64_t *number)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_integer(I, c, *number);
+ return 1;
+}
+
+int iof_get_int32_radix (iof *I, int32_t *number, int radix)
+{
+ int sign, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ if (sign) *number = -*number;
+ return 1;
+
+}
+
+int iof_get_slong_radix (iof *I, long *number, int radix)
+{
+ int sign, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_get_int64_radix (iof *I, int64_t *number, int radix)
+{
+ int sign, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_get_uint32_radix (iof *I, uint32_t *number, int radix)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ return 1;
+}
+
+int iof_get_ulong_radix (iof *I, unsigned long *number, int radix)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ return 1;
+}
+
+int iof_get_usize_radix (iof *I, size_t *number, int radix)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ return 1;
+}
+
+int iof_get_uint64_radix (iof *I, uint64_t *number, int radix)
+{
+ int c = iof_char(I);
+ if (!base10_digit(c)) return 0;
+ iof_read_radix(I, c, *number, radix);
+ return 1;
+}
+
+/* get roman to uint16_t, cf. roman_to_uint16() from utilnumber.c*/
+
+/* todo: some trick in place of this macro horror? */
+
+#define roman1000(c) (c == 'M' || c == 'm')
+#define roman500(c) (c == 'D' || c == 'd')
+#define roman100(c) (c == 'C' || c == 'c')
+#define roman50(c) (c == 'L' || c == 'l')
+#define roman10(c) (c == 'X' || c == 'x')
+#define roman5(c) (c == 'V' || c == 'v')
+#define roman1(c) (c == 'I' || c == 'i')
+
+#define roman100s(I, c) \
+ (roman100(c) ? (100 + ((c = iof_next(I), roman100(c)) ? (100 + ((c = iof_next(I), roman100(c)) ? (c = iof_next(I), 100) : 0)) : 0)) : 0)
+#define roman10s(I, c) \
+ (roman10(c) ? (10 + ((c = iof_next(I), roman10(c)) ? (10 + ((c = iof_next(I), roman10(c)) ? (c = iof_next(I), 10) : 0)) : 0)) : 0)
+#define roman1s(I, c) \
+ (roman1(c) ? (1 + ((c = iof_next(I), roman1(c)) ? (1 + ((c = iof_next(I), roman1(c)) ? (c = iof_next(I), 1) : 0)) : 0)) : 0)
+
+int iof_get_roman (iof *I, uint16_t *number)
+{
+ int c;
+ /* M */
+ for (*number = 0, c = iof_char(I); roman1000(c); *number += 1000, c = iof_next(I));
+ /* D C */
+ if (roman500(c))
+ {
+ c = iof_next(I);
+ *number += 500 + roman100s(I, c);
+ }
+ else if (roman100(c))
+ {
+ c = iof_next(I);
+ if (roman1000(c))
+ {
+ c = iof_next(I);
+ *number += 900;
+ }
+ else if (roman500(c))
+ {
+ c = iof_next(I);
+ *number += 400;
+ }
+ else
+ *number += 100 + roman100s(I, c);
+ }
+ /* L X */
+ if (roman50(c))
+ {
+ c = iof_next(I);
+ *number += 50 + roman10s(I, c);
+ }
+ else if (roman10(c))
+ {
+ c = iof_next(I);
+ if (roman100(c))
+ {
+ c = iof_next(I);
+ *number += 90;
+ }
+ else if (roman50(c))
+ {
+ c = iof_next(I);
+ *number += 40;
+ }
+ else
+ *number += 10 + roman10s(I, c);
+ }
+ /* V I */
+ if (roman5(c))
+ {
+ c = iof_next(I);
+ *number += 5 + roman1s(I, c);
+ }
+ else if (roman1(c))
+ {
+ c = iof_next(I);
+ if (roman10(c))
+ {
+ c = iof_next(I);
+ *number += 9;
+ }
+ else if (roman5(c))
+ {
+ c = iof_next(I);
+ *number += 4;
+ }
+ else
+ *number += 1 + roman1s(I, c);
+ }
+ return 1;
+}
+
+/* double from iof; return 1 on success */
+
+int iof_get_double (iof *I, double *number) // cf. string_to_double()
+{
+ int sign, exponent10, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ iof_scan_decimal(I, c, *number);
+ if (c == '.')
+ {
+ c = iof_next(I);
+ iof_scan_fraction(I, c, *number, exponent10);
+ }
+ else
+ exponent10 = 0;
+ if (c == 'e' || c == 'E')
+ {
+ c = iof_next(I);
+ iof_scan_exponent10(I, c, exponent10);
+ }
+ double_exp10(*number, exponent10);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_get_float (iof *I, float *number) // cf. string_to_float()
+{
+ int sign, exponent10, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ iof_scan_decimal(I, c, *number);
+ if (c == '.')
+ {
+ c = iof_next(I);
+ iof_scan_fraction(I, c, *number, exponent10);
+ }
+ else
+ exponent10 = 0;
+ if (c == 'e' || c == 'E')
+ {
+ c = iof_next(I);
+ iof_scan_exponent10(I, c, exponent10);
+ }
+ float_exp10(*number, exponent10);
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_conv_double (iof *I, double *number) // cf. convert_to_double()
+{
+ int sign, exponent10, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ iof_scan_decimal(I, c, *number);
+ if (c == '.' || c == ',')
+ {
+ c = iof_next(I);
+ iof_scan_fraction(I, c, *number, exponent10);
+ if (exponent10 < 0)
+ double_negative_exp10(*number, exponent10);
+ }
+ if (sign) *number = -*number;
+ return 1;
+}
+
+int iof_conv_float (iof *I, float *number) // cf. convert_to_float()
+{
+ int sign, exponent10, c = iof_char(I);
+ iof_scan_sign(I, c, sign);
+ iof_scan_decimal(I, c, *number);
+ if (c == '.' || c == ',')
+ {
+ c = iof_next(I);
+ iof_scan_fraction(I, c, *number, exponent10);
+ if (exponent10 < 0)
+ float_negative_exp10(*number, exponent10);
+ }
+ if (sign) *number = -*number;
+ return 1;
+}
+
+/* integer to iof; return a number of written bytes */
+
+size_t iof_put_int32 (iof *O, int32_t number)
+{
+ const char *s;
+ size_t size;
+ s = int32_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_slong (iof *O, long number)
+{
+ const char *s;
+ size_t size;
+ s = slong_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_int64 (iof *O, int64_t number)
+{
+ const char *s;
+ size_t size;
+ s = int64_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_uint32 (iof *O, uint32_t number)
+{
+ const char *s;
+ size_t size;
+ s = uint32_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_ulong (iof *O, unsigned long number)
+{
+ const char *s;
+ size_t size;
+ s = ulong_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_usize (iof *O, size_t number)
+{
+ const char *s;
+ size_t size;
+ s = usize_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_uint64 (iof *O, uint64_t number)
+{
+ const char *s;
+ size_t size;
+ s = uint64_to_string(number, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_int32_radix (iof *O, int32_t number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = int32_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_slong_radix (iof *O, long number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = slong_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_int64_radix (iof *O, int64_t number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = int64_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_uint32_radix (iof *O, uint32_t number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = uint32_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_ulong_radix (iof *O, unsigned long number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = ulong_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_usize_radix (iof *O, size_t number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = usize_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_uint64_radix (iof *O, uint64_t number, int radix, int uc)
+{
+ const char *s;
+ size_t size;
+ s = uint64_to_radix(number, radix, uc, &size);
+ return iof_write(O, s, size);
+}
+
+/* roman numerals */
+
+size_t iof_put_roman (iof *O, uint16_t number, int uc)
+{
+ const char *s;
+ size_t size;
+ s = uint16_to_roman(number, uc, &size);
+ return iof_write(O, s, size);
+}
+
+/* double/float to iof; return the number of written bytes */
+
+size_t iof_put_double (iof *O, double number, int digits)
+{
+ const char *s;
+ size_t size;
+ s = double_to_string(number, digits, &size);
+ return iof_write(O, s, size);
+}
+
+size_t iof_put_float (iof *O, float number, int digits)
+{
+ const char *s;
+ size_t size;
+ s = float_to_string(number, digits, &size);
+ return iof_write(O, s, size);
+}
+
+/* iof to binary integer; pretty common */
+
+int iof_get_be_uint2 (iof *I, uint32_t *pnumber)
+{
+ int c1, c2;
+ if ((c1 = iof_get(I)) < 0 || (c2 = iof_get(I)) < 0)
+ return 0;
+ *pnumber = (c1<<8)|c2;
+ return 1;
+}
+
+int iof_get_be_uint3 (iof *I, uint32_t *pnumber)
+{
+ int c1, c2, c3;
+ if ((c1 = iof_get(I)) < 0 || (c2 = iof_get(I)) < 0 || (c3 = iof_get(I)) < 0)
+ return 0;
+ *pnumber = (c1<<16)|(c2<<8)|c3;
+ return 1;
+}
+
+int iof_get_be_uint4 (iof *I, uint32_t *pnumber)
+{
+ int c1, c2, c3, c4;
+ if ((c1 = iof_get(I)) < 0 || (c2 = iof_get(I)) < 0 || (c3 = iof_get(I)) < 0 || (c4 = iof_get(I)) < 0)
+ return 0;
+ *pnumber = (c1<<24)|(c2<<16)|(c3<<8)|c4;
+ return 1;
+}
+
+int iof_get_le_uint2 (iof *I, uint32_t *pnumber)
+{
+ int c1, c2;
+ if ((c1 = iof_get(I)) < 0 || (c2 = iof_get(I)) < 0)
+ return 0;
+ *pnumber = (c2<<8)|c1;
+ return 1;
+}
+
+int iof_get_le_uint3 (iof *I, uint32_t *pnumber)
+{
+ int c1, c2, c3;
+ if ((c1 = iof_get(I)) < 0 || (c2 = iof_get(I)) < 0 || (c3 = iof_get(I)) < 0)
+ return 0;
+ *pnumber = (c3<<16)|(c2<<8)|c1;
+ return 1;
+}
+
+int iof_get_le_uint4 (iof *I, uint32_t *pnumber)
+{
+ int c1, c2, c3, c4;
+ if ((c1 = iof_get(I)) < 0 || (c2 = iof_get(I)) < 0 || (c3 = iof_get(I)) < 0 || (c4 = iof_get(I)) < 0)
+ return 0;
+ *pnumber = (c4<<24)|(c3<<16)|(c2<<8)|c1;
+ return 1;
+}
+
+/* iof input data */
+
+uint8_t * iof_file_input_data (iof_file *iofile, size_t *psize, int *isnew)
+{
+ uint8_t *data;
+ if (iofile->flags & IOF_DATA)
+ {
+ data = iofile->buf;
+ *psize = iofile->end - iofile->buf;
+ *isnew = 0;
+ return data;
+ }
+ if (iof_file_reopen(iofile))
+ {
+ data = iof_copy_file_handle_data(iof_file_get_fh(iofile), psize);
+ *isnew = 1;
+ iof_file_reclose(iofile);
+ return data;
+ }
+ return NULL;
+}
+
+/*
+uint8_t * iof_file_reader_data (iof_file *iofile, size_t *size)
+{
+ uint8_t *data;
+ if (!(iofile->flags & IOF_DATA) || iofile->pos == NULL || (*size = (size_t)iof_left(iofile)) == 0)
+ return NULL;
+ if (iofile->flags & IOF_BUFFER_ALLOC)
+ {
+ data = iofile->buf; // iofile->pos; // returned must be freeable, makes sense when ->buf == ->pos
+ iofile->flags &= ~IOF_BUFFER_ALLOC;
+ iofile->buf = iofile->pos = iofile->end = NULL;
+ return data;
+ }
+ data = (uint8_t *)util_malloc(*size);
+ memcpy(data, iofile->buf, *size);
+ return data;
+}
+
+uint8_t * iof_file_writer_data (iof_file *iofile, size_t *size)
+{
+ uint8_t *data;
+ if (!(iofile->flags & IOF_DATA) || iofile->buf == NULL || (*size = (size_t)iof_size(iofile)) == 0)
+ return NULL;
+ if (iofile->flags & IOF_BUFFER_ALLOC)
+ {
+ iofile->flags &= ~IOF_BUFFER_ALLOC;
+ data = iofile->buf;
+ iofile->buf = iofile->pos = iofile->end = NULL;
+ return data;
+ }
+ data = (uint8_t *)util_malloc(*size);
+ memcpy(data, iofile->buf, *size);
+ return data;
+}
+*/
+
+uint8_t * iof_reader_data (iof *I, size_t *psize)
+{
+ uint8_t *data;
+ *psize = (size_t)iof_left(I);
+ if (I->flags & IOF_BUFFER_ALLOC)
+ {
+ data = I->buf; // actually I->pos, but we have to return something freeable
+ I->flags &= ~IOF_BUFFER_ALLOC;
+ I->buf = NULL;
+ }
+ else
+ {
+ data = util_malloc(*psize);
+ memcpy(data, I->pos, *psize);
+ }
+ iof_close(I);
+ return data;
+}
+
+
+uint8_t * iof_writer_data (iof *O, size_t *psize)
+{
+ uint8_t *data;
+ *psize = (size_t)iof_size(O);
+ if (O->flags & IOF_BUFFER_ALLOC)
+ {
+ data = O->buf;
+ O->flags &= ~IOF_BUFFER_ALLOC;
+ O->buf = NULL;
+ }
+ else
+ {
+ data = util_malloc(*psize);
+ memcpy(data, O->buf, *psize);
+ }
+ iof_close(O);
+ return data;
+}
+
+size_t iof_reader_to_file_handle (iof *I, FILE *file)
+{
+ size_t size;
+ for (size = 0; iof_readable(I); I->pos = I->end)
+ size += fwrite(I->buf, sizeof(uint8_t), iof_left(I), file);
+ return size;
+}
+
+size_t iof_reader_to_file (iof *I, const char *filename)
+{
+ FILE *file;
+ size_t size;
+ if ((file = fopen(filename, "wb")) == NULL)
+ return 0;
+ for (size = 0; iof_readable(I); I->pos = I->end)
+ size += fwrite(I->buf, sizeof(uint8_t), iof_left(I), file);
+ fclose(file);
+ return size;
+}
+
+/* debug */
+
+size_t iof_data_to_file (const void *data, size_t size, const char *filename)
+{
+ FILE *fh;
+ if ((fh = fopen(filename, "wb")) == NULL)
+ return 0;
+ // size = fwrite(data, size, sizeof(uint8_t), fh); // WRONG, this always returns 1, as fwrite returns the number of elements successfully written out
+ size = fwrite(data, sizeof(uint8_t), size, fh);
+ fclose(fh);
+ return size;
+}
+
+size_t iof_result_to_file_handle (iof *F, FILE *file)
+{
+ const void *data;
+ size_t size;
+ data = iof_result(F, size);
+ return iof_data_to_file_handle(data, size, file);
+}
+
+size_t iof_result_to_file (iof *F, const char *filename)
+{
+ const void *data;
+ size_t size;
+ data = iof_result(F, size);
+ return iof_data_to_file(data, size, filename);
+}
+
+void iof_debug (iof *I, const char *filename)
+{
+ FILE *file = fopen(filename, "wb");
+ if (file != NULL)
+ {
+ fprintf(file, ">>> buf %p <<<\n", I->buf);
+ fwrite(I->buf, sizeof(uint8_t), iof_size(I), file);
+ fprintf(file, "\n>>> pos %p (%ld) <<<\n", I->pos, (long)iof_size(I));
+ fwrite(I->pos, sizeof(uint8_t), iof_left(I), file);
+ fprintf(file, "\n>>> end %p (%ld) <<<\n", I->end, (long)iof_left(I));
+ fwrite(I->end, sizeof(uint8_t), I->space - iof_space(I), file);
+ fprintf(file, "\n>>> end of buffer %p (%ld) <<<\n", I->buf + I->space, (long)(I->buf + I->space - I->end));
+ fclose(file);
+ }
+}
+
+/* common filters api */
+
+/* sizes of filter states on x64
+size of iof_filter: 640 (no longer used; sizeof(iof) + sizeof larger state)
+size of file_state: 16
+size of stream_state: 16
+size of flate_state: 104
+size of lzw_state: 56
+size of predictor_state: 104
+size of basexx_state: 48
+size of basexx_state: 48
+size of basexx_state: 48
+size of eexec_state: 40
+size of runlength_state: 24
+size of rc4_state: 24
+size of aes_state: 72
+size of img_state: 576
+size of img: 496
+*/
+
+typedef struct iof_heap iof_heap;
+
+typedef struct {
+ iof_heap *heap;
+} iof_heap_ghost;
+
+
+struct iof_heap {
+ union { uint8_t *data; iof_heap_ghost *gdata; }; // union instead of casts (ARM)
+ union { uint8_t *pos; iof_heap_ghost *gpos; };
+ size_t size, space;
+ iof_heap *next, *prev;
+ int refcount;
+ uint8_t dummy[4]; // pad to 8N bytes
+};
+
+/*
+We use hidden heap pointer for every allocated buffer, so heap->data should be kept properly aligned.
+Dummy 4-bytes pad doesn't really matter (the pad is there anyway), but iof_heap_take() must pad the
+requested size.
+*/
+
+static iof_heap * iof_buffers_heap = NULL;
+static iof_heap * iof_filters_heap = NULL;
+
+#define IOF_HEAP_FILTERS_COUNT 4
+#define IOF_BUFFER_SIZE 262144 // (1<<18)
+#define IOF_FILTER_SIZE 1024
+// sizeof(iof_filter) on x64 is now 640, img_state 576, img 496, others 16-104
+#define IOF_BUFFER_HEAP_SIZE (IOF_HEAP_FILTERS_COUNT * (IOF_BUFFER_SIZE + sizeof(iof_heap_ghost)))
+#define IOF_FILTER_HEAP_SIZE (IOF_HEAP_FILTERS_COUNT * (IOF_FILTER_SIZE + sizeof(iof_heap_ghost)))
+
+static iof_heap * iof_heap_new (size_t space)
+{
+ iof_heap *iofheap;
+ iofheap = (iof_heap *)util_malloc(sizeof(iof_heap) + space);
+ iofheap->gdata = iofheap->gpos = (iof_heap_ghost *)(iofheap + 1);
+ iofheap->size = iofheap->space = space;
+ iofheap->next = NULL;
+ iofheap->prev = NULL;
+ iofheap->refcount = 0;
+ return iofheap;
+}
+
+#define iof_heap_free(iofheap) util_free(iofheap)
+
+void iof_filters_init (void)
+{
+ if (iof_buffers_heap == NULL)
+ iof_buffers_heap = iof_heap_new(IOF_BUFFER_HEAP_SIZE);
+ if (iof_filters_heap == NULL)
+ iof_filters_heap = iof_heap_new(IOF_FILTER_HEAP_SIZE);
+}
+
+void iof_filters_free (void)
+{
+ iof_heap *heap, *next;
+ for (heap = iof_buffers_heap; heap != NULL; heap = next)
+ {
+ next = heap->next;
+ if (heap->refcount != 0)
+ loggerf("not closed iof filters left (%d)", heap->refcount);
+ if (next != NULL)
+ loggerf("iof filters heap left");
+ iof_heap_free(heap);
+ }
+ iof_buffers_heap = NULL;
+ for (heap = iof_filters_heap; heap != NULL; heap = next)
+ {
+ next = heap->next;
+ if (heap->refcount != 0)
+ loggerf("not closed iof buffers left (%d)", heap->refcount);
+ if (next != NULL)
+ loggerf("iof buffers heap left");
+ iof_heap_free(heap);
+ }
+ iof_filters_heap = NULL;
+}
+
+#define iof_heap_get(hp, ghost, data, siz) \
+ (ghost = (hp)->gpos, ghost->heap = (hp), data = (uint8_t *)(ghost + 1), (hp)->pos += siz, (hp)->size -= siz, ++(hp)->refcount)
+
+static void * iof_heap_take (iof_heap **pheap, size_t size)
+{
+ uint8_t *data;
+ iof_heap_ghost *ghost;
+ iof_heap *heap, *newheap, *next;
+
+ heap = *pheap;
+ if (size & 7)
+ size += 8 - (size & 7); // pad to 8N bytes so that (heap->pos + size) remains properly aligned
+ size += sizeof(iof_heap_ghost);
+ if (heap->size >= size)
+ { /* take cheap mem from main heap */
+ iof_heap_get(heap, ghost, data, size);
+ return data;
+ }
+ if (size <= (heap->space >> 1))
+ { /* make new cheap heap, make it front */
+ *pheap = newheap = iof_heap_new(heap->space);
+ newheap->next = heap;
+ heap->prev = newheap;
+ iof_heap_get(newheap, ghost, data, size);
+ return data;
+ }
+ /* size much larger than expected? should not happen.
+ make a single-item heap, keep the front heap intact. */
+ newheap = iof_heap_new(size);
+ if ((next = heap->next) != NULL)
+ {
+ newheap->next = next;
+ next->prev = newheap;
+ }
+ heap->next = newheap;
+ newheap->prev = heap;
+ iof_heap_get(newheap, ghost, data, size);
+ return data;
+}
+
+static void iof_heap_back (void *data)
+{
+ iof_heap_ghost *ghost;
+ iof_heap *heap, *next, *prev;
+
+ ghost = ((iof_heap_ghost *)data) - 1;
+ heap = ghost->heap;
+ if (heap->refcount == 0)
+ loggerf("invalid use of iof heap, refcount < 0");
+ if (--heap->refcount <= 0)
+ {
+ if ((prev = heap->prev) != NULL)
+ { /* free the heap */
+ if ((next = heap->next) != NULL)
+ prev->next = next, next->prev = prev;
+ else
+ prev->next = NULL;
+ iof_heap_free(heap);
+ }
+ else
+ { /* this is the front heap, just reset */
+ heap->pos = heap->data;
+ heap->size = heap->space;
+ }
+ }
+}
+
+/**/
+
+/*
+void * iof_filter_new (size_t size)
+{
+ void *data;
+ iof_filters_init();
+ data = iof_heap_take(&iof_filters_heap, size);
+ return memset(data, 0, size);
+}
+*/
+
+iof * iof_filter_reader_new (iof_handler handler, size_t statesize, void **pstate)
+{
+ iof *F;
+ void *filter;
+ uint8_t *buffer;
+ size_t buffersize;
+
+ iof_filters_init();
+ filter = iof_heap_take(&iof_filters_heap, sizeof(iof) + statesize);
+ F = (iof *)memset(filter, 0, sizeof(iof) + statesize);
+ buffer = iof_heap_take(&iof_buffers_heap, IOF_BUFFER_SIZE);
+ buffersize = IOF_BUFFER_SIZE;
+ iof_setup_reader(F, buffer, buffersize);
+ F->flags |= IOF_HEAP|IOF_BUFFER_HEAP;
+ F->more = handler;
+ *pstate = (F + 1);
+ return F;
+}
+
+iof * iof_filter_reader_with_buffer_new (iof_handler handler, size_t statesize, void **pstate, void *buffer, size_t buffersize)
+{ // for filters that has own buffer (string, some image filters)
+ iof *F;
+ void *filter;
+
+ iof_filters_init();
+ filter = iof_heap_take(&iof_filters_heap, sizeof(iof) + statesize);
+ F = (iof *)memset(filter, 0, sizeof(iof) + statesize);
+ iof_setup_reader(F, buffer, buffersize);
+ F->flags |= IOF_HEAP;
+ F->more = handler;
+ *pstate = (F + 1);
+ return F;
+}
+
+iof * iof_filter_writer_new (iof_handler handler, size_t statesize, void **pstate)
+{
+ iof *F;
+ void *filter;
+ uint8_t *buffer;
+ size_t buffersize;
+
+ iof_filters_init();
+ filter = iof_heap_take(&iof_filters_heap, sizeof(iof) + statesize);
+ F = (iof *)memset(filter, 0, sizeof(iof) + statesize);
+ buffer = iof_heap_take(&iof_buffers_heap, IOF_BUFFER_SIZE);
+ buffersize = IOF_BUFFER_SIZE;
+ iof_setup_writer(F, buffer, buffersize);
+ F->flags |= IOF_HEAP|IOF_BUFFER_HEAP;
+ F->more = handler;
+ *pstate = (F + 1);
+ return F;
+}
+
+iof * iof_filter_writer_with_buffer_new (iof_handler handler, size_t statesize, void **pstate, void *buffer, size_t buffersize)
+{
+ iof *F;
+ void *filter;
+
+ iof_filters_init();
+ filter = iof_heap_take(&iof_filters_heap, sizeof(iof) + statesize);
+ F = (iof *)memset(filter, 0, sizeof(iof) + statesize);
+ iof_setup_writer(F, buffer, buffersize);
+ F->flags |= IOF_HEAP;
+ F->more = handler;
+ *pstate = (F + 1);
+ return F;
+}
+
+/**/
+
+#define iof_filter_free(F) iof_heap_back(F)
+#define iof_filter_buffer_free(data) iof_heap_back(data)
+
+/* close */
+
+#define iof_close_next(F) ((void)(iof_decref((F)->next), (F)->next = NULL, 0))
+/* when filter creation fails, we should take care to destroy the filter but leave ->next intact */
+#define iof_clear_next(F) ((void)(iof_unref((F)->next), (F)->next = NULL, 0))
+
+#define iof_close_buffer(F) ((void)\
+ ((F)->buf != NULL ? \
+ ((F->flags & IOF_BUFFER_ALLOC) ? (util_free((F)->buf), (F)->buf = NULL, 0) : \
+ ((F->flags & IOF_BUFFER_HEAP) ? (iof_filter_buffer_free((F)->buf), (F)->buf = NULL, 0) : ((F)->buf = NULL, 0))) : 0))
+
+/* closing underlying file handle */
+
+static void iof_close_file (iof *F)
+{
+ FILE *file;
+ //if (F->flags & IOF_FILE_HANDLE)
+ //{
+ if ((file = F->file) != NULL)
+ {
+ if (F->flags & IOF_CLOSE_FILE)
+ fclose(F->file);
+ F->file = NULL;
+ }
+ //}
+}
+
+/* a very special variant for reader filters initiated with iof_file_reopen(). It also calls
+ iof_file_reclose(), which takes an effect only if previously reopened, but better to keep
+ all this thin ice separated. Used in filters: iofile_reader, iofile_stream_reader, image
+ decoders. */
+
+static void iof_close_iofile (iof *F)
+{
+ iof_file *iofile;
+ //if (F->flags & IOF_FILE)
+ //{
+ if ((iofile = F->iofile) != NULL)
+ {
+ iof_file_unsync(iofile, NULL);
+ iof_file_reclose(iofile); // takes an effect iff prevoiusly reopened
+ iof_file_decref(iofile);
+ F->iofile = NULL;
+ }
+ //}
+}
+
+void iof_free (iof *F)
+{
+ if (F->flags & IOF_FILE_HANDLE)
+ iof_close_file(F);
+ else if (F->flags & IOF_FILE)
+ iof_close_iofile(F);
+ else if (F->flags & IOF_NEXT)
+ iof_close_next(F);
+ iof_close_buffer(F);
+ if (F->flags & IOF_HEAP)
+ iof_filter_free(F);
+ else if (F->flags & IOF_ALLOC)
+ util_free(F);
+}
+
+void iof_discard (iof *F)
+{ // so far used only on failed filters creation; as iof_free() but don't dare to release ->next
+ if (F->flags & IOF_FILE_HANDLE)
+ iof_close_file(F);
+ else if (F->flags & IOF_FILE)
+ iof_close_iofile(F);
+ //else if (F->flags & IOF_NEXT)
+ // iof_close_next(F);
+ iof_close_buffer(F);
+ if (F->flags & IOF_HEAP)
+ iof_filter_free(F);
+ else if (F->flags & IOF_ALLOC)
+ util_free(F);
+}
+
+/* resizing buffer */
+
+size_t iof_resize_buffer_to (iof *O, size_t space)
+{
+ uint8_t *buf;
+
+ if (O->flags & IOF_BUFFER_ALLOC)
+ {
+ buf = (uint8_t *)util_realloc(O->buf, space);
+ }
+ else
+ {
+ buf = (uint8_t *)util_malloc(space);
+ memcpy(buf, O->buf, iof_size(O));
+ if (O->flags & IOF_BUFFER_HEAP)
+ {
+ iof_filter_buffer_free(O->buf);
+ O->flags &= ~IOF_BUFFER_HEAP;
+ }
+ O->flags |= IOF_BUFFER_ALLOC;
+
+ }
+ O->pos = buf + iof_size(O);
+ O->end = buf + space;
+ O->buf = buf;
+ O->space = space;
+ return iof_left(O);
+}
+
+/* */
+
+size_t iof_decoder_retval (iof *I, const char *type, iof_status status)
+{
+ switch (status)
+ {
+ case IOFERR:
+ case IOFEMPTY: // should never happen as we set state.flush = 1 on decoders init
+ loggerf("%s decoder error (%d, %s)", type, status, iof_status_kind(status));
+ I->flags |= IOF_STOPPED;
+ return 0;
+ case IOFEOF: // this is the last chunk,
+ I->flags |= IOF_STOPPED; // so stop it and fall
+ FALLTHRU // fall through
+ case IOFFULL: // prepare pointers to read from I->buf
+ I->end = I->pos;
+ I->pos = I->buf;
+ return I->end - I->buf;
+ }
+ loggerf("%s decoder bug, invalid retval %d", type, status);
+ return 0;
+}
+
+size_t iof_encoder_retval (iof *O, const char *type, iof_status status)
+{
+ switch (status)
+ {
+ case IOFERR:
+ case IOFFULL:
+ loggerf("%s encoder error (%d, %s)", type, status, iof_status_kind(status));
+ return 0;
+ case IOFEMPTY:
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ return O->space;
+ case IOFEOF:
+ return 0;
+ }
+ loggerf("%s encoder bug, invalid retval %d", type, status);
+ return 0;
+}
+
+/* file/stream state */
+
+typedef struct {
+ size_t length;
+ size_t offset;
+} file_state;
+
+#define file_state_init(state, off, len) ((state)->offset = off, (state)->length = len)
+
+typedef struct {
+ size_t length;
+ size_t offset;
+} stream_state;
+
+#define stream_state_init(state, off, len) ((state)->offset = off, (state)->length = len)
+
+/* union type to avoid 'dereferencing type-punned .. ' warnings on (void **) case */
+
+typedef union { file_state *filestate; stream_state *streamstate; void *voidstate; } fs_state_pointer;
+
+/**/
+
+static size_t file_read (iof *I)
+{
+ size_t bytes, tail;
+ if (I->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(I);
+ if ((bytes = tail + fread(I->buf + tail, sizeof(uint8_t), I->space - tail, I->file)) < I->space)
+ I->flags |= IOF_STOPPED;
+ I->pos = I->buf;
+ I->end = I->buf + bytes;
+ return bytes;
+}
+
+static size_t iofile_read (iof *I, size_t *poffset)
+{
+ size_t bytes, tail;
+ if (I->flags & IOF_STOPPED)
+ return 0;
+ iof_file_sync(I->iofile, poffset);
+ tail = iof_tail(I);
+ if ((bytes = tail + iof_file_read(I->buf + tail, sizeof(uint8_t), I->space - tail, I->iofile)) < I->space)
+ {
+ I->flags |= IOF_STOPPED;
+ iof_file_unsync(I->iofile, poffset);
+ }
+ I->pos = I->buf;
+ I->end = I->buf + bytes;
+ return bytes;
+}
+
+static size_t file_load (iof *I)
+{
+ size_t bytes, left, tail;
+ if (I->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(I);
+ I->pos = I->buf + tail;
+ I->end = I->buf + I->space; /* don't assume its done when initializing the filter */
+ left = I->space - tail;
+ do {
+ bytes = fread(I->pos, sizeof(uint8_t), left, I->file);
+ I->pos += bytes;
+ } while (bytes == left && (left = iof_resize_buffer(I)) > 0);
+ I->flags |= IOF_STOPPED;
+ return iof_loaded(I);
+}
+
+static size_t iofile_load (iof *I, size_t *poffset)
+{
+ size_t bytes, left, tail;
+ if (I->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(I);
+ I->pos = I->buf + tail;
+ I->end = I->buf + I->space; /* don't assume its done when initializing the filter */
+ left = I->space - tail;
+ iof_file_sync(I->iofile, poffset);
+ do {
+ bytes = iof_file_read(I->pos, sizeof(uint8_t), left, I->iofile);
+ I->pos += bytes;
+ } while (bytes == left && (left = iof_resize_buffer(I)) > 0);
+ I->flags |= IOF_STOPPED;
+ iof_file_unsync(I->iofile, poffset);
+ return iof_loaded(I);
+}
+
+static size_t filter_file_reader (iof *I, iof_mode mode)
+{
+ switch (mode)
+ {
+ case IOFREAD:
+ return file_read(I);
+ case IOFLOAD:
+ return file_load(I);
+ case IOFCLOSE:
+ iof_free(I);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+static size_t filter_iofile_reader (iof *I, iof_mode mode)
+{
+ file_state *state;
+ state = iof_filter_state(file_state *, I);
+ switch (mode)
+ {
+ case IOFREAD:
+ return iofile_read(I, &state->offset);
+ case IOFLOAD:
+ return iofile_load(I, &state->offset);
+ case IOFCLOSE:
+ iof_free(I);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+static size_t file_write (iof *O, int flush)
+{
+ size_t bytes;
+ if ((bytes = iof_size(O)) > 0)
+ if (bytes != fwrite(O->buf, sizeof(uint8_t), bytes, O->file))
+ return 0;
+ if (flush)
+ fflush(O->file);
+ O->end = O->buf + O->space; // remains intact actually
+ O->pos = O->buf;
+ return O->space;
+}
+
+static size_t iofile_write (iof *O, size_t *poffset, int flush)
+{
+ size_t bytes;
+ iof_file_sync(O->iofile, poffset);
+ if ((bytes = iof_size(O)) > 0)
+ {
+ if (bytes != iof_file_write(O->buf, sizeof(uint8_t), bytes, O->iofile))
+ {
+ iof_file_unsync(O->iofile, poffset);
+ return 0;
+ }
+ }
+ if (flush)
+ iof_file_flush(O->iofile);
+ O->end = O->buf + O->space; // remains intact actually
+ O->pos = O->buf;
+ return O->space;
+}
+
+static size_t filter_file_writer (iof *O, iof_mode mode)
+{
+ switch (mode)
+ {
+ case IOFWRITE:
+ return file_write(O, 0);
+ case IOFFLUSH:
+ return file_write(O, 1);
+ case IOFCLOSE:
+ file_write(O, 1);
+ iof_free(O);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+static size_t filter_iofile_writer (iof *O, iof_mode mode)
+{
+ file_state *state;
+ state = iof_filter_state(file_state *, O);
+ switch (mode)
+ {
+ case IOFWRITE:
+ return iofile_write(O, &state->offset, 0);
+ case IOFFLUSH:
+ return iofile_write(O, &state->offset, 1);
+ case IOFCLOSE:
+ iofile_write(O, &state->offset, 1);
+ iof_free(O);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+/* filter from FILE* */
+
+iof * iof_filter_file_handle_reader (FILE *file)
+{
+ iof *I;
+ fs_state_pointer P;
+ if (file == NULL)
+ return NULL;
+ I = iof_filter_reader(filter_file_reader, sizeof(file_state), &P.voidstate);
+ iof_setup_file(I, file);
+ file_state_init(P.filestate, 0, 0);
+ return I;
+}
+
+iof * iof_filter_file_handle_writer (FILE *file)
+{
+ iof *O;
+ fs_state_pointer P;
+ if (file == NULL)
+ return NULL;
+ O = iof_filter_writer(filter_file_writer, sizeof(file_state), &P.voidstate);
+ iof_setup_file(O, file);
+ file_state_init(P.filestate, 0, 0);
+ return O;
+}
+
+/* filter from iof_file * */
+
+iof * iof_filter_iofile_reader (iof_file *iofile, size_t offset)
+{
+ iof *I;
+ fs_state_pointer P;
+ if (!iof_file_reopen(iofile))
+ return NULL;
+ I = iof_filter_reader(filter_iofile_reader, sizeof(file_state), &P.voidstate);
+ iof_setup_iofile(I, iofile);
+ file_state_init(P.filestate, offset, 0);
+ return I;
+}
+
+iof * iof_filter_iofile_writer (iof_file *iofile, size_t offset)
+{
+ iof *O;
+ fs_state_pointer P;
+ O = iof_filter_writer(filter_iofile_writer, sizeof(file_state), &P.voidstate);
+ iof_setup_iofile(O, iofile);
+ file_state_init(P.filestate, offset, 0);
+ return O;
+}
+
+/* filter from filename */
+
+iof * iof_filter_file_reader (const char *filename)
+{
+ iof *I;
+ fs_state_pointer P;
+ FILE *file;
+ if ((file = fopen(filename, "rb")) == NULL)
+ return NULL;
+ I = iof_filter_reader(filter_file_reader, sizeof(file_state), &P.voidstate);
+ iof_setup_file(I, file);
+ file_state_init(P.filestate, 0, 0);
+ I->flags |= IOF_CLOSE_FILE;
+ return I;
+}
+
+iof * iof_filter_file_writer (const char *filename)
+{
+ iof *O;
+ fs_state_pointer P;
+ FILE *file;
+ if ((file = fopen(filename, "wb")) == NULL)
+ return NULL;
+ O = iof_filter_writer(filter_file_writer, sizeof(file_state), &P.voidstate);
+ iof_setup_file(O, file);
+ file_state_init(P.filestate, 0, 0);
+ O->flags |= IOF_CLOSE_FILE;
+ return O;
+}
+
+/* from string */
+
+static size_t dummy_handler (iof *I, iof_mode mode)
+{
+ switch (mode)
+ {
+ case IOFCLOSE:
+ iof_free(I);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+iof * iof_filter_string_reader (const void *s, size_t length)
+{
+ iof *I;
+ void *dummy;
+ I = iof_filter_reader_with_buffer(dummy_handler, 0, &dummy, NULL, 0);
+ I->rbuf = I->rpos = (const uint8_t *)s;
+ I->rend = (const uint8_t *)s + length;
+ // I->space = length;
+ return I;
+}
+
+iof * iof_filter_string_writer (const void *s, size_t length)
+{
+ iof *O;
+ void *dummy;
+ O = iof_filter_reader_with_buffer(dummy_handler, 0, &dummy, NULL, 0);
+ O->rbuf = O->rpos = (const uint8_t *)s;
+ O->rend = (const uint8_t *)s + length;
+ // O->space = length;
+ return O;
+}
+
+iof * iof_filter_buffer_writer (size_t size)
+{ // cmp iof_buffer_create()
+ iof *O;
+ fs_state_pointer dummy;
+ uint8_t *buffer;
+ if (size > IOF_BUFFER_SIZE)
+ {
+ buffer = (uint8_t *)util_malloc(size);
+ O = iof_filter_writer_with_buffer(iof_mem_handler, 0, &dummy.voidstate, buffer, size);
+ O->flags |= IOF_BUFFER_ALLOC;
+ return O;
+ }
+ return iof_filter_writer(iof_mem_handler, 0, &dummy.voidstate);
+}
+
+/* stream */
+
+static size_t file_stream_read (iof *I, size_t *plength)
+{
+ size_t bytes, tail;
+ if (I->flags & IOF_STOPPED || *plength == 0)
+ return 0;
+ tail = iof_tail(I);
+ if (I->space - tail >= *plength)
+ {
+ bytes = tail + fread(I->buf + tail, sizeof(uint8_t), *plength, I->file);
+ I->flags |= IOF_STOPPED;
+ *plength = 0;
+ }
+ else
+ {
+ bytes = tail + fread(I->buf + tail, sizeof(uint8_t), I->space - tail, I->file);
+ *plength -= bytes - tail;
+ }
+ I->pos = I->buf;
+ I->end = I->buf + bytes;
+ return bytes;
+}
+
+static size_t iofile_stream_read (iof *I, size_t *plength, size_t *poffset)
+{
+ size_t bytes, tail;
+ if (I->flags & IOF_STOPPED || *plength == 0)
+ return 0;
+ tail = iof_tail(I);
+ iof_file_sync(I->iofile, poffset);
+ if (I->space - tail >= *plength)
+ {
+ bytes = tail + iof_file_read(I->buf + tail, sizeof(uint8_t), *plength, I->iofile);
+ iof_file_unsync(I->iofile, poffset);
+ I->flags |= IOF_STOPPED;
+ *plength = 0;
+ }
+ else
+ {
+ bytes = tail + iof_file_read(I->buf + tail, sizeof(uint8_t), I->space - tail, I->iofile);
+ *plength -= bytes - tail;
+ }
+ I->pos = I->buf;
+ I->end = I->buf + bytes;
+ return bytes;
+}
+
+static size_t file_stream_load (iof *I, size_t *plength)
+{
+ size_t bytes, tail;
+ if (I->flags & IOF_STOPPED || *plength == 0)
+ return 0;
+ tail = iof_tail(I);
+ if (I->space - tail < *plength)
+ if (iof_resize_buffer_to(I, tail + *plength) == 0)
+ return 0;
+ bytes = tail + fread(I->buf + tail, sizeof(uint8_t), *plength, I->file);
+ I->flags |= IOF_STOPPED;
+ *plength = 0;
+ I->pos = I->buf;
+ I->end = I->buf + bytes;
+ return bytes;
+}
+
+static size_t iofile_stream_load (iof *I, size_t *plength, size_t *poffset)
+{
+ size_t bytes, tail;
+ if (I->flags & IOF_STOPPED || *plength == 0)
+ return 0;
+ iof_file_sync(I->iofile, poffset);
+ tail = iof_tail(I);
+ if (I->space - tail < *plength)
+ if (iof_resize_buffer_to(I, tail + *plength) == 0)
+ return 0;
+ bytes = tail + iof_file_read(I->buf + tail, sizeof(uint8_t), *plength, I->iofile);
+ iof_file_unsync(I->iofile, poffset);
+ I->flags |= IOF_STOPPED;
+ *plength = 0;
+ I->pos = I->buf;
+ I->end = I->buf + bytes;
+ return bytes;
+}
+
+static size_t filter_file_stream_reader (iof *I, iof_mode mode)
+{
+ stream_state *state;
+ state = iof_filter_state(stream_state *, I);
+ switch(mode)
+ {
+ case IOFREAD:
+ return file_stream_read(I, &state->length);
+ case IOFLOAD:
+ return file_stream_load(I, &state->length);
+ case IOFCLOSE:
+ iof_free(I);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+static size_t filter_iofile_stream_reader (iof *I, iof_mode mode)
+{
+ stream_state *state;
+ state = iof_filter_state(stream_state *, I);
+ switch(mode)
+ {
+ case IOFREAD:
+ return iofile_stream_read(I, &state->length, &state->offset);
+ case IOFLOAD:
+ return iofile_stream_load(I, &state->length, &state->offset);
+ case IOFCLOSE:
+ iof_free(I);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+iof * iof_filter_stream_reader (FILE *file, size_t offset, size_t length)
+{
+ iof *I;
+ fs_state_pointer P;
+ I = iof_filter_reader(filter_file_stream_reader, sizeof(stream_state), &P.voidstate);
+ iof_setup_file(I, file);
+ stream_state_init(P.streamstate, offset, length);
+ fseek(file, (long)offset, SEEK_SET); // or perhaps it should be call in file_stream_read(), like iof_file_sync()?
+ return I;
+}
+
+iof * iof_filter_stream_coreader (iof_file *iofile, size_t offset, size_t length)
+{
+ iof *I;
+ fs_state_pointer P;
+ if (!iof_file_reopen(iofile))
+ return NULL;
+ I = iof_filter_reader(filter_iofile_stream_reader, sizeof(stream_state), &P.voidstate);
+ iof_setup_iofile(I, iofile);
+ stream_state_init(P.streamstate, offset, length);
+ return I;
+}
+
+static size_t file_stream_write (iof *O, size_t *plength, int flush)
+{
+ size_t bytes;
+ if ((bytes = iof_size(O)) > 0)
+ {
+ if (bytes != fwrite(O->buf, sizeof(uint8_t), bytes, O->file))
+ {
+ *plength += bytes;
+ return 0;
+ }
+ }
+ if (flush)
+ fflush(O->file);
+ *plength += bytes;
+ O->end = O->buf + O->space; // remains intact
+ O->pos = O->buf;
+ return O->space;
+}
+
+static size_t iofile_stream_write (iof *O, size_t *plength, size_t *poffset, int flush)
+{
+ size_t bytes;
+ if ((bytes = iof_size(O)) > 0)
+ {
+ iof_file_sync(O->iofile, poffset);
+ if (bytes != iof_file_write(O->buf, sizeof(uint8_t), bytes, O->iofile))
+ {
+ *plength += bytes;
+ iof_file_unsync(O->iofile, poffset);
+ return 0;
+ }
+ }
+ if (flush)
+ iof_file_flush(O->iofile);
+ *plength += bytes;
+ O->end = O->buf + O->space; // remains intact
+ O->pos = O->buf;
+ return O->space;
+}
+
+static size_t filter_file_stream_writer (iof *O, iof_mode mode)
+{
+ stream_state *state;
+ state = iof_filter_state(stream_state *, O);
+ switch (mode)
+ {
+ case IOFWRITE:
+ return file_stream_write(O, &state->length, 0);
+ case IOFFLUSH:
+ return file_stream_write(O, &state->length, 1);
+ case IOFCLOSE:
+ file_stream_write(O, &state->length, 1);
+ iof_free(O);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+static size_t filter_iofile_stream_writer (iof *O, iof_mode mode)
+{
+ stream_state *state;
+ state = iof_filter_state(stream_state *, O);
+ switch (mode)
+ {
+ case IOFWRITE:
+ return iofile_stream_write(O, &state->length, &state->offset, 0);
+ case IOFFLUSH:
+ return iofile_stream_write(O, &state->length, &state->offset, 1);
+ case IOFCLOSE:
+ iofile_stream_write(O, &state->length, &state->offset, 1);
+ iof_free(O);
+ return 0;
+ default:
+ return 0;
+ }
+}
+
+iof * iof_filter_stream_writer (FILE *file)
+{
+ iof *O;
+ fs_state_pointer P;
+ O = iof_filter_writer(filter_file_stream_writer, sizeof(stream_state), &P.voidstate);
+ iof_setup_file(O, file);
+ stream_state_init(P.streamstate, 0, 0);
+ return O;
+}
+
+iof * iof_filter_stream_cowriter (iof_file *iofile, size_t offset)
+{
+ iof *O;
+ fs_state_pointer P;
+ O = iof_filter_writer(filter_iofile_stream_writer, sizeof(stream_state), &P.voidstate);
+ iof_setup_iofile(O, iofile);
+ stream_state_init(P.streamstate, offset, 0);
+ return O;
+}
+
+/* very specific for images; get input from already created strem filter, exchange the filter but keep the buffer */
+
+FILE * iof_filter_file_reader_source (iof *I, size_t *poffset, size_t *plength)
+{
+ fs_state_pointer P;
+ if (I->more == filter_file_stream_reader) // I is the result of iof_filter_stream_reader()
+ {
+ P.streamstate = iof_filter_state(stream_state *, I);
+ *poffset = P.streamstate->offset;
+ *plength = P.streamstate->length; // might be 0 but it is ok for file readers
+ return I->file;
+ }
+ if (I->more == filter_file_reader)
+ {
+ P.filestate = iof_filter_state(file_state *, I);
+ *poffset = P.filestate->offset;
+ *plength = P.filestate->length; // might be 0 but it is ok for file readers
+ return I->file;
+ }
+ return NULL;
+}
+
+iof_file * iof_filter_file_coreader_source (iof *I, size_t *poffset, size_t *plength)
+{
+ fs_state_pointer P;
+ if (I->more == filter_iofile_stream_reader) // I is the result of iof_filter_stream_coreader()
+ {
+ P.streamstate = iof_filter_state(stream_state *, I);
+ *poffset = P.streamstate->offset;
+ *plength = P.streamstate->length;
+ return I->iofile;
+ }
+ if (I->more == filter_iofile_reader)
+ {
+ P.filestate = iof_filter_state(file_state *, I);
+ *poffset = P.filestate->offset;
+ *plength = P.filestate->length;
+ return I->iofile;
+ }
+ return NULL;
+}
+
+iof * iof_filter_reader_replacement (iof *P, iof_handler handler, size_t statesize, void **pstate)
+{ // called after iof_filter_file_reader_source(), no need to check if F is filter from iof heap and if has buffer from iof heap
+ iof *F;
+ F = iof_filter_reader_with_buffer(handler, statesize, pstate, P->buf, P->space);
+ F->flags |= IOF_BUFFER_HEAP;
+ //iof_setup_reader(P, NULL, 0);
+ //P->flags &= ~IOF_BUFFER_HEAP;
+ iof_filter_free(P);
+ return F;
+}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/source/luametatex/source/libraries/pplib/util/utiliof.h b/source/luametatex/source/libraries/pplib/util/utiliof.h
new file mode 100644
index 000000000..bad43a773
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utiliof.h
@@ -0,0 +1,673 @@
+
+#ifndef UTIL_IOF_H
+#define UTIL_IOF_H
+
+#include <stdio.h> // for FILE *
+#include <errno.h> // for errno
+#include <string.h> // for strerror()
+#include <stdint.h> // for uintN_t
+
+#include "utildecl.h"
+#include "utilnumber.h"
+
+/* handler call modes */
+
+typedef enum {
+ IOFREAD = 0, /* read to buffer */
+ IOFLOAD = 1, /* read all to buffer */
+ IOFWRITE = 2, /* write buffer to the output */
+ IOFFLUSH = 3, /* flush buffer to the output */
+ IOFCLOSE = 4 /* (flush and) close */
+} iof_mode;
+
+/* return statuses */
+
+typedef enum {
+ IOFEOF = -1, /* end of input */
+ IOFEMPTY = -2, /* end of input buffer*/
+ IOFFULL = -3, /* end of output buffer */
+ IOFERR = -4 /* error */
+} iof_status;
+
+const char * iof_status_kind (iof_status status);
+
+/* iof_file */
+
+typedef struct iof_file {
+ union {
+ FILE *iofh; // access via iof_file_get_fh / iof_file_set_fh (below)
+ union {
+ struct { uint8_t *buf, *pos, *end; };
+ struct { const uint8_t *rbuf, *rpos, *rend; }; // to trick compiler warnings about cast discarding const
+ };
+ };
+ size_t *offset;
+ char *name;
+ size_t size;
+ int refcount;
+ int flags;
+} iof_file;
+
+/* iof handler function */
+
+typedef struct iof iof;
+typedef size_t (*iof_handler) (iof *I, iof_mode mode);
+
+/* iof structure; keep 8N bytes */
+
+#define IOF_MEMBERS \
+ union { \
+ struct { uint8_t *buf, *pos, *end; }; \
+ struct { uint16_t *hbuf, *hpos, *hend; }; \
+ struct { uint32_t *ibuf, *ipos, *iend; }; \
+ struct { const uint8_t *rbuf, *rpos, *rend; }; \
+ }; \
+ size_t space; \
+ iof_handler more; \
+ union { void *link; iof *next; FILE *file; iof_file *iofile; }; \
+ int flags; \
+ int refcount
+
+/*
+ buf -- the beginning of buffer
+ pos -- the current position
+ end -- the end of buffer
+ space -- private space size, not always eq. (end - buf)
+ more -- handler function
+ next/file/iofile/link -- reader source or writer target
+ source -- source filter
+ flags -- private filter info
+ refcount -- refcount
+*/
+
+struct iof {
+ IOF_MEMBERS;
+};
+
+typedef void (*iof_dump_function) (const void *value, iof *O);
+
+/* flags */
+
+#define IOF_ALLOC (1<<0) // iof is allocated
+#define IOF_HEAP (1<<1) // iof taken from iof heap
+#define IOF_BUFFER_ALLOC (1<<2) // buffer allocated
+#define IOF_BUFFER_HEAP (1<<3) // buffer taken from iof heap
+
+#define IOF_SHORT (1<<4) // buffer uses 16bit integers
+#define IOF_LONG (1<<5) // buffer uses 32bit integers
+
+#define IOF_TAIL (1<<6) // preserve reader tail
+#define IOF_READER (1<<7) // is reader
+#define IOF_WRITER (1<<8) // is writer
+
+#define IOF_DATA (1<<9) // binds some memory
+#define IOF_FILE_HANDLE (1<<10) // links FILE *
+#define IOF_FILE (1<<11) // links iof_file *
+#define IOF_NEXT (1<<12) // links next iof *
+#define IOF_CLOSE_FILE (1<<13) // close FILE * on free
+#define IOF_REOPEN_FILE (1<<14) // close/reopen mode for iof_file
+#define IOF_RECLOSE_FILE (1<<15) // ditto
+
+#define IOF_STOPPED (1<<16) // stopped
+
+// #define IOF_CUSTOM (1<<17) // first custom flag
+
+#define IOF_BUFSIZ (sizeof(iof) + BUFSIZ*sizeof(uint8_t))
+
+/*
+reading buffer -- all of buf, pos, end pointers are initialized to the beginning of the private buffer,
+ next call to a handler function moves the end pointer to bufer+space
+writer -- buf and pos pointers initialized to the beginning of the buffer, end initialized to bufer+space
+
+Every call to handler returns size_t number of bytes
+available (to write/read) or 0 if there is no more space.
+
+We usually align the data buffer just after the iof structure.
+This is convenient, especially when a memory for the structure
+and its buffer is to be allocated. In the case of growing output
+buffers we used to check if the memory of the buffer is allocated
+by the handler function using test (O->buf != (O+1)). We don't use
+it any longer not to rely on little secrets. Now there is an explicit
+IOF_BUFFER_ALLOC flag for that. IOF_ALLOC tells if the structure
+itself is taken from malloc (not used so far). Assuming the buffer size
+is way larger the sizeof(iof)
+*/
+
+/* initializers */
+
+#define IOF_READER_INIT(handler, file, buffer, size, flags) \
+ { {{ (uint8_t *)(buffer), (uint8_t *)(buffer), (uint8_t *)(buffer) }}, size, handler, { file }, (flags)|IOF_READER, 0 }
+
+#define IOF_WRITER_INIT(handler, file, buffer, size, flags) \
+ { {{ (uint8_t *)(buffer), (uint8_t *)(buffer), (uint8_t *)(buffer) + size }}, size, handler, { file }, (flags)|IOF_WRITER, 0 }
+
+#define IOF_STRING_INIT(buffer, size) \
+ { {{ (uint8_t *)(buffer), (uint8_t *)(buffer), (uint8_t *)(buffer) + size }}, size, NULL, { NULL }, 0|IOF_READER|IOF_DATA, 0 }
+
+#define IOF_STRING() IOF_STRING_INIT(0, 0)
+
+/* refcount */
+
+#define iof_incref(I) (++(I)->refcount)
+#define iof_decref(I) ((void)(--(I)->refcount <= 0 && iof_close(I)))
+#define iof_unref(I) (--(I)->refcount)
+
+/* binding buffer of a given size */
+
+#define iof_setup_reader(I, buffer, size) \
+ ((I)->buf = (I)->pos = (I)->end = (uint8_t *)(buffer), \
+ (I)->space = size, (I)->flags = 0|IOF_READER, (I)->refcount = 0)
+
+#define iof_setup_writer(O, buffer, size) \
+ ((O)->buf = (O)->pos = (uint8_t *)(buffer), \
+ (O)->end = (uint8_t *)(buffer) + size, \
+ (O)->space = size, (O)->flags = 0|IOF_WRITER, (O)->refcount = 0)
+
+/* basics */
+
+#define iof_space(I) ((I)->end - (I)->buf)
+#define iof_left(I) ((I)->end - (I)->pos)
+#define iof_size(I) ((I)->pos - (I)->buf)
+
+#define iof_input(I) ((I)->more ? (I)->more((I), IOFREAD) : 0lu)
+#define iof_load(I) ((I)->more ? (I)->more((I), IOFLOAD) : 0lu)
+
+#define iof_output(O) ((O)->more ? (O)->more((O), IOFWRITE) : 0lu)
+//#define iof_flush(O) ((O)->pos > (O)->buf && (O)->more ? (O)->more(O, IOFFLUSH) : 0lu)
+// flush should be unconditional, because encoders emits EOD markers only on flush
+#define iof_flush(O) ((O)->more ? (O)->more(O, IOFFLUSH) : 0lu)
+#define iof_close(O) ((O)->more ? (O)->more(O, IOFCLOSE) : 0lu)
+
+#define iof_stop(F) ((void)(F->pos = F->end = F->buf, F->flags |= IOF_STOPPED))
+
+/*
+Rewriting reader tail to the beginning of new data portion; readers reacting on IOFREAD
+mode must be aware of some not yet read data, but treat it necessary only if IOF_TAIL flag is set.
+Parsers using iof input may protect not yet read data when there may be a need to put bytes
+back to the stream. This is trivial when I->pos > I->buf, as we can make a move by --I->pos.
+But when there is a need to put back more then one byte, we can protect the data tail, so that
+realoder will rewrite it to the beginning of new data chunk.
+
+ iof_tail(I) - internal, used by iof handlers at IOFREAD mode
+ iof_protect_tail(I) - used by parsers to ensure some bytes chunk in one piece
+
+*/
+
+size_t iof_save_tail (iof *I);
+#define iof_tail(I) (((I)->flags & IOF_TAIL) && (I)->pos < (I)->end ? iof_save_tail(I) : 0)
+
+size_t iof_input_save_tail (iof *I, size_t back);
+#define iof_protect_tail(I, back, length) ((iof_left(I) >= (length) - (back)) ? 1 : (iof_input_save_tail(I, back) >= length - back))
+
+//uint8_t * iof_tail_data (iof *I, size_t *ptail);
+//#define iof_tail_free(data) util_free(data)
+
+/* panic */
+
+// #define iof_panic(mess) return 0
+#ifndef iof_panic
+ #define iof_panic(mess) (fputs(mess, stderr), abort())
+#endif
+//#define iof_memory_error() iof_panic(strerror(errno))
+#define iof_fwrite_error() iof_panic(strerror(errno))
+
+/* generic helpers */
+
+UTILAPI uint8_t * iof_copy_file_data (const char *filename, size_t *psize);
+UTILAPI uint8_t * iof_copy_file_handle_data (FILE *file, size_t *psize);
+
+/* In the future we may need releasing file handle and restoring it from iofile->name, so access file handle via macros */
+
+#define iof_file_get_fh(iofile) ((iofile)->iofh)
+#define iof_file_set_fh(iofile, fh) ((iofile)->iofh = fh)
+#define iof_file_get_file(iofile) (((iofile)->flags & IOF_DATA) ? NULL : iof_file_get_fh(iofile))
+FILE * iof_get_file (iof *F);
+
+/* basic iof_file interface */
+
+iof_file * iof_file_new (FILE *file);
+iof_file * iof_file_init (iof_file *iofile, FILE *file);
+
+iof_file * iof_file_rdata (const void *data, size_t size);
+iof_file * iof_file_wdata (void *data, size_t size);
+
+iof_file * iof_file_rdata_init (iof_file *iofile, const void *data, size_t size);
+iof_file * iof_file_wdata_init (iof_file *iofile, void *data, size_t size);
+
+iof_file * iof_file_reader_from_file_handle (iof_file *iofile, const char *filename, FILE *file, int preload, int closefile);
+iof_file * iof_file_reader_from_file (iof_file *iofile, const char *filename, int preload);
+iof_file * iof_file_reader_from_data (iof_file *iofile, const void *data, size_t size, int preload, int freedata);
+//iof_file * iof_file_writer_from_file (iof_file *iofile, const char *filename);
+
+void * iof_copy_data (const void *data, size_t size);
+#define iof_data_free(data) util_free(data)
+#define iof_file_wdata_copy(data, size) iof_file_wdata(iof_copy_data(data, size), size)
+#define iof_file_rdata_copy(data, size) iof_file_rdata(iof_copy_data(data, size), size)
+
+void iof_file_free (iof_file *iofile);
+
+#define iof_file_get_name(iofile) ((iofile)->name)
+void iof_file_set_name (iof_file *iofile, const char *name);
+
+#define iof_file_incref(iofile) (++(iofile)->refcount)
+#define iof_file_decref(iofile) ((void)(--(iofile)->refcount <= 0 && (iof_file_free(iofile), 0)))
+
+int iof_file_seek (iof_file *iofile, long offset, int whence);
+long iof_file_tell (iof_file *iofile);
+size_t iof_file_size (iof_file *iofile);
+int iof_file_eof (iof_file *iofile);
+
+size_t iof_file_read (void *ptr, size_t size, size_t items, iof_file *iofile);
+size_t iof_file_write (const void *ptr, size_t size, size_t items, iof_file *iofile);
+size_t iof_file_ensure (iof_file *iofile, size_t bytes);
+int iof_file_flush (iof_file *iofile);
+
+int iof_file_getc (iof_file *iofile);
+int iof_file_putc (iof_file *iofile, int c);
+
+int iof_file_reclose_input (iof_file *iofile);
+int iof_file_reopen_input (iof_file *iofile);
+
+#define iof_file_reopen(iofile) (((iofile)->flags & IOF_REOPEN_FILE) ? iof_file_reopen_input(iofile) : 1)
+#define iof_file_reclose(iofile) (void)(((iofile)->flags & IOF_RECLOSE_FILE) ? iof_file_reclose_input(iofile) : 0)
+
+void iof_file_close_input (iof_file *iofile);
+
+/* wrappers of basic operations for iof */
+
+int iof_reader_seek (iof *I, long offset, int whence);
+int iof_reader_reseek (iof *I, long offset, int whence);
+int iof_writer_seek (iof *I, long offset, int whence);
+int iof_writer_reseek (iof *I, long offset, int whence);
+
+int iof_seek (iof *I, long offset, int whence);
+int iof_reseek (iof *I, long offset, int whence);
+
+long iof_reader_tell (iof *I);
+long iof_writer_tell (iof *I);
+long iof_tell (iof *I);
+size_t iof_fsize (iof *I);
+
+#define iof_setup_iofile(I, f) (iof_file_incref(f), (I)->iofile = f, (I)->flags |= IOF_FILE)
+#define iof_setup_file(I, fh) ((I)->file = fh, (I)->flags |= IOF_FILE_HANDLE)
+#define iof_setup_next(I, N) ((I)->next = N, iof_incref(N), (I)->flags |= IOF_NEXT)
+
+/* file handler reader and writer */
+
+UTILAPI iof * iof_setup_file_handle_reader (iof *I, void *buffer, size_t space, FILE *f);
+UTILAPI iof * iof_setup_file_handle_writer (iof *O, void *buffer, size_t space, FILE *f);
+
+/* file reader and writer */
+
+UTILAPI iof * iof_setup_file_reader (iof *I, void *buffer, size_t space, const char *filename);
+UTILAPI iof * iof_setup_file_writer (iof *O, void *buffer, size_t space, const char *filename);
+
+/* mem writer */
+
+UTILAPI iof * iof_setup_buffer (iof *O, void *buffer, size_t space);
+UTILAPI iof * iof_setup_buffermin (iof *O, void *buffer, size_t space, size_t min);
+
+UTILAPI iof * iof_buffer_create (size_t space);
+#define iof_buffer_new() iof_buffer_create(BUFSIZ)
+
+/* custom handler */
+
+UTILAPI iof * iof_reader (iof *I, void *link, iof_handler reader, const void *s, size_t bytes);
+UTILAPI iof * iof_writer (iof *O, void *link, iof_handler writer, void *s, size_t bytes);
+
+/* stdout wrapper */
+
+extern UTILAPI iof iof_stdout;
+extern UTILAPI iof iof_stderr;
+
+/* simple string reader */
+
+UTILAPI iof * iof_string_reader (iof *I, const void *s, size_t bytes);
+
+#define iof_string(I, s, bytes) \
+ (((I)->rbuf = (I)->rpos = (const uint8_t *)s), ((I)->rend = (I)->rbuf + (bytes)), ((I)->flags |= IOF_DATA), (I))
+
+/* dummies */
+
+UTILAPI iof * iof_dummy (void *buffer, size_t space);
+UTILAPI iof * iof_null (void *buffer, size_t space);
+
+/* checking available space */
+
+#define iof_loadable(I) ((I)->pos < (I)->end || iof_load(I))
+#define iof_readable(I) ((I)->pos < (I)->end || iof_input(I))
+#define iof_writable(O) ((O)->pos < (O)->end || iof_output(O))
+
+#define iof_hloadable iof_loadable
+#define iof_iloadable iof_loadable
+
+#define iof_hreadable iof_readable
+#define iof_ireadable iof_readable
+
+#define iof_hwritable iof_writable
+#define iof_iwritable iof_writable
+
+/* ensure space to write several bytes (several means less then I->space) */
+
+#define iof_ensure(O, n) ((O)->pos+(n)-1 < (O)->end || iof_output(O)) // iof_ensure(O, 1) eq iof_writable(O)
+#define iof_hensure(O, n) ((O)->hpos+(n)-1 < (O)->hend || iof_output(O))
+#define iof_iensure(O, n) ((O)->ipos+(n)-1 < (O)->iend || iof_output(O))
+
+/* reading */
+
+UTILAPI int iof_getc (iof *I);
+UTILAPI int iof_hgetc (iof *I);
+UTILAPI int iof_igetc (iof *I);
+
+// UTILAPI int iof_cmp (iof *I, const char *s);
+// UTILAPI int iof_cmpn (iof *I, const char *s, size_t bytes);
+
+UTILAPI iof_status iof_pass (iof *I, iof *O);
+#define iof_hpass iof_pass
+#define iof_ipass iof_pass
+
+/* readers helpers */
+
+UTILAPI size_t iof_read (iof *I, void *s, size_t bytes);
+UTILAPI size_t iof_hread (iof *I, void *s, size_t bytes);
+UTILAPI size_t iof_iread (iof *I, void *s, size_t bytes);
+
+UTILAPI size_t iof_skip (iof *I, size_t bytes);
+UTILAPI size_t iof_hskip (iof *I, size_t bytes);
+UTILAPI size_t iof_iskip (iof *I, size_t bytes);
+
+/* get */
+
+#define iof_pos(I) (*(I)->pos++)
+#define iof_hpos(I) (*(I)->hpos++)
+#define iof_ipos(I) (*(I)->ipos++)
+
+#define iof_get(I) (iof_readable(I) ? (int)(*(I)->pos++) : IOFEOF)
+#define iof_hget(I) (iof_hreadable(I) ? (int)(*(I)->hpos++) : IOFEOF)
+#define iof_iget(I) (iof_ireadable(I) ? (int)(*(I)->ipos++) : IOFEOF)
+
+#define iof_char(I) (iof_readable(I) ? (int)(*(I)->pos) : IOFEOF)
+#define iof_hcurr(I) (iof_hreadable(I) ? (int)(*(I)->hpos) : IOFEOF)
+#define iof_icurr(I) (iof_ireadable(I) ? (int)(*(I)->ipos) : IOFEOF)
+
+#define iof_next(I) (++(I)->pos, iof_char(I))
+#define iof_hnext(I) (++(I)->hpos, iof_hcurr(I))
+#define iof_inext(I) (++(I)->ipos, iof_icurr(I))
+
+/* unget */
+
+/*
+If possible, we just move the position backward. If it is not possible to
+move backward, we call iof_backup(I, c) that sets all pointers to the end of
+a private backup space, then moves buf AND pos pointers backward and set c at
+pos (==buf). We can backup characters as long as there is a private space. If
+several calls to iof_backup() are followed by iof_get(), pos pointer
+increases in normal way and so the use of another iof_unget() works just fine
+by moving the position. Once we swallow all backup characters (when
+pos==end), backup handler restores the previous pointers.
+
+Obviously we assume that the character provided to iof_unget() is always the
+character just obtained from iof_get(). We CAN'T just overwrite the character
+at a given position as the space we read may not be writable.
+
+When backup is in use, we can only get bytes until automatically restored.
+*/
+
+/* backup */
+
+/*
+#define iof_uses_backup(I) ((I)->more == iof_unget_handler)
+
+#define iof_save(I, B) \
+ ((B)->buf = (I)->buf, (B)->pos = (I)->pos, (B)->end = (I)->end, (B)->space = (I)->space, \
+ (B)->link = I->link, (B)->more = (I)->more, (B)->flags = (I)->flags)
+#define iof_restore(B, I) iof_save(I, B)
+
+#define iof_unget(I, c) \
+ ((void)(c == (uint8_t)c ? ((I)->pos > (I)->buf ? --(I)->pos : iof_backup(I, c)) : 0)
+int iof_backup (iof *I, int c);
+*/
+
+/* writing */
+
+UTILAPI size_t iof_write_file_handle (iof *O, FILE *file);
+UTILAPI size_t iof_write_file (iof *O, const char *filename);
+UTILAPI size_t iof_write_iofile (iof *O, iof_file *iofile, int savepos);
+
+UTILAPI int iof_putc (iof *O, int u);
+UTILAPI int iof_hputc (iof *O, int u);
+UTILAPI int iof_iputc (iof *O, int u);
+
+UTILAPI size_t iof_write (iof *O, const void *data, size_t size);
+UTILAPI size_t iof_hwrite (iof *O, const void *data, size_t size);
+UTILAPI size_t iof_iwrite (iof *O, const void *data, size_t size);
+
+UTILAPI iof_status iof_puts (iof *O, const void *data);
+UTILAPI size_t iof_put_string (iof *O, const void *data);
+UTILAPI size_t iof_putfs (iof *O, const char *format, ...);
+UTILAPI size_t iof_repc (iof *O, char c, size_t bytes);
+
+#define iof_putl(O, s) iof_write(O, "" s, sizeof(s)-1)
+//#define iof_putl iof_puts
+
+#define iof_set(O, c) (*(O)->pos++ = (uint8_t)(c))
+#define iof_set2(O, c1, c2) (iof_set(O, c1), iof_set(O, c2))
+#define iof_set3(O, c1, c2, c3) (iof_set(O, c1), iof_set(O, c2), iof_set(O, c3))
+#define iof_set4(O, c1, c2, c3, c4) (iof_set(O, c1), iof_set(O, c2), iof_set(O, c3), iof_set(O, c4))
+#define iof_set5(O, c1, c2, c3, c4, c5) (iof_set(O, c1), iof_set(O, c2), iof_set(O, c3), iof_set(O, c4), iof_set(O, c5))
+
+#define iof_hset(O, c) (*(O)->hpos++ = (uint16_t)(c))
+#define iof_iset(O, c) (*(O)->ipos++ = (uint32_t)(c))
+
+#define iof_put(O, c) ((void)iof_ensure(O, 1), iof_set(O, c))
+#define iof_put2(O, c1, c2) ((void)iof_ensure(O, 2), iof_set2(O, c1, c2))
+#define iof_put3(O, c1, c2, c3) ((void)iof_ensure(O, 3), iof_set3(O, c1, c2, c3))
+#define iof_put4(O, c1, c2, c3, c4) ((void)iof_ensure(O, 4), iof_set4(O, c1, c2, c3, c4))
+#define iof_put5(O, c1, c2, c3, c4, c5) ((void)iof_ensure(O, 5), iof_set5(O, c1, c2, c3, c4, c5))
+
+#define iof_hput(O, c) ((void)iof_hensure(O, 1), iof_hset(O, c))
+#define iof_iput(O, c) ((void)iof_iensure(O, 1), iof_iset(O, c))
+
+#define iof_put_uc_hex(O, c) iof_put2(O, base16_uc_digit1(c), base16_uc_digit2(c))
+#define iof_put_lc_hex(O, c) iof_put2(O, base16_lc_digit1(c), base16_lc_digit2(c))
+#define iof_set_uc_hex(O, c) iof_set2(O, base16_uc_digit1(c), base16_uc_digit2(c))
+#define iof_set_lc_hex(O, c) iof_set2(O, base16_lc_digit1(c), base16_lc_digit2(c))
+#define iof_put_hex iof_put_uc_hex
+#define iof_set_hex iof_set_uc_hex
+
+/* number from iof; return 1 on success, 0 otherwise */
+
+#define iof_scan_sign(I, c, sign) _scan_sign(c, sign, iof_next(I))
+#define iof_scan_integer(I, c, number) _scan_integer(c, number, iof_next(I))
+#define iof_scan_radix(I, c, number, radix) _scan_radix(c, number, radix, iof_next(I))
+#define iof_read_integer(I, c, number) _read_integer(c, number, iof_next(I))
+#define iof_read_radix(I, c, number, radix) _read_radix(c, number, radix, iof_next(I))
+
+#define iof_scan_decimal(I, c, number) _scan_decimal(c, number, iof_next(I))
+#define iof_scan_fraction(I, c, number, exponent10) _scan_fraction(c, number, exponent10, iof_next(I))
+#define iof_scan_exponent10(I, c, exponent10) _scan_exponent10(c, exponent10, iof_next(I))
+
+UTILAPI int iof_get_int32 (iof *I, int32_t *number);
+UTILAPI int iof_get_slong (iof *I, long *number);
+UTILAPI int iof_get_int64 (iof *I, int64_t *number);
+
+UTILAPI int iof_get_uint32 (iof *I, uint32_t *number);
+UTILAPI int iof_get_ulong (iof *I, unsigned long *number);
+UTILAPI int iof_get_usize (iof *I, size_t *number);
+UTILAPI int iof_get_uint64 (iof *I, uint64_t *number);
+
+UTILAPI int iof_get_int32_radix (iof *I, int32_t *number, int radix);
+UTILAPI int iof_get_slong_radix (iof *I, long *number, int radix);
+UTILAPI int iof_get_int64_radix (iof *I, int64_t *number, int radix);
+
+UTILAPI int iof_get_uint32_radix (iof *I, uint32_t *number, int radix);
+UTILAPI int iof_get_ulong_radix (iof *I, unsigned long *number, int radix);
+UTILAPI int iof_get_usize_radix (iof *I, size_t *number, int radix);
+UTILAPI int iof_get_uint64_radix (iof *I, uint64_t *number, int radix);
+
+#if defined(INTLW_IS_INT64)
+# define iof_get_intlw(I, number) iof_get_int64(I, number)
+# define iof_get_uintlw(I, number) iof_get_uint64(I, number)
+# define iof_get_intlw_radix(I, number, radix) iof_get_int64_radix(I, number, radix)
+# define iof_get_uintlw_radix(I, number, radix) iof_get_uint64_radix(I, number, radix)
+#elif defined(INTLW_IS_LONG)
+# define iof_get_intlw(I, number) iof_get_slong(I, number)
+# define iof_get_uintlw(I, number) iof_get_ulong(I, number)
+# define iof_get_intlw_radix(I, number, radix) iof_get_slong_radix(I, number, radix)
+# define iof_get_uintlw_radix(I, number, radix) iof_get_ulong_radix(I, number, radix)
+#endif
+
+UTILAPI int iof_get_roman (iof *I, uint16_t *number);
+
+UTILAPI int iof_get_double (iof *I, double *number);
+UTILAPI int iof_get_float (iof *I, float *number);
+
+UTILAPI int iof_conv_double (iof *I, double *number);
+UTILAPI int iof_conv_float (iof *I, float *number);
+
+/* number to iof; return a number of written bytes */
+
+UTILAPI size_t iof_put_int32 (iof *O, int32_t number);
+UTILAPI size_t iof_put_slong (iof *O, long number);
+UTILAPI size_t iof_put_int64 (iof *O, int64_t number);
+
+UTILAPI size_t iof_put_uint32 (iof *O, uint32_t number);
+UTILAPI size_t iof_put_ulong (iof *O, unsigned long number);
+UTILAPI size_t iof_put_usize (iof *O, size_t number);
+UTILAPI size_t iof_put_uint64 (iof *O, uint64_t number);
+
+UTILAPI size_t iof_put_int32_radix (iof *O, int32_t number, int radix, int uc);
+UTILAPI size_t iof_put_slong_radix (iof *O, long number, int radix, int uc);
+UTILAPI size_t iof_put_int64_radix (iof *O, int64_t number, int radix, int uc);
+
+UTILAPI size_t iof_put_uint32_radix (iof *O, uint32_t number, int radix, int uc);
+UTILAPI size_t iof_put_ulong_radix (iof *O, unsigned long number, int radix, int uc);
+UTILAPI size_t iof_put_usize_radix (iof *O, size_t number, int radix, int uc);
+UTILAPI size_t iof_put_uint64_radix (iof *O, uint64_t number, int radix, int uc);
+
+#if defined(INTLW_IS_INT64)
+# define iof_put_intlw(O, number) iof_put_int64(O, number)
+# define iof_put_uintlw(O, number) iof_put_uint64(O, number)
+# define iof_put_intlw_radix(O, number, radix, uc) iof_put_int64_radix(O, number, radix, uc)
+# define iof_put_uintlw_radix(O, number, radix, uc) iof_put_uint64_radix(O, number, radix, uc)
+#elif defined(INTLW_IS_LONG)
+# define iof_put_intlw(O, number) iof_put_slong(O, number)
+# define iof_put_uintlw(O, number) iof_put_ulong(O, number)
+# define iof_put_intlw_radix(O, number, radix, uc) iof_put_slong_radix(O, number, radix, uc)
+# define iof_put_uintlw_radix(O, number, radix, uc) iof_put_ulong_radix(O, number, radix, uc)
+#endif
+
+UTILAPI size_t iof_put_roman (iof *O, uint16_t number, int uc);
+
+UTILAPI size_t iof_put_double(iof *O, double number, int digits);
+UTILAPI size_t iof_put_float(iof *O, float number, int digits);
+
+/* common helpers for binary parsers */
+
+UTILAPI int iof_get_be_uint2 (iof *I, uint32_t *pnumber);
+UTILAPI int iof_get_be_uint3 (iof *I, uint32_t *pnumber);
+UTILAPI int iof_get_be_uint4 (iof *I, uint32_t *pnumber);
+
+UTILAPI int iof_get_le_uint2 (iof *I, uint32_t *pnumber);
+UTILAPI int iof_get_le_uint3 (iof *I, uint32_t *pnumber);
+UTILAPI int iof_get_le_uint4 (iof *I, uint32_t *pnumber);
+
+// iof_set() and iof_put() suite casts arguments to uint8_t, so we don't need &0xff mask
+
+#define iof_set_be_uint1(O, u) iof_set(O, u)
+#define iof_set_be_uint2(O, u) iof_set2(O, (u)>>8, u)
+#define iof_set_be_uint3(O, u) iof_set3(O, (u)>>16, (u)>>8, u)
+#define iof_set_be_uint4(O, u) iof_set4(O, (u)>>24, (u)>>16, (u)>>8, u)
+
+#define iof_set_le_uint1(O, u) iof_set(O, u)
+#define iof_set_le_uint2(O, u) iof_set2(O, u, (u)>>8)
+#define iof_set_le_uint3(O, u) iof_set3(O, u, (u)>>8, (u)>>16)
+#define iof_set_le_uint4(O, u) iof_set4(O, u, (u)>>8, (u)>>16, (u)>>24)
+
+#define iof_put_be_uint1(O, u) iof_put(O, u)
+#define iof_put_be_uint2(O, u) iof_put2(O, (u)>>8, u)
+#define iof_put_be_uint3(O, u) iof_put3(O, (u)>>16, (u)>>8, u)
+#define iof_put_be_uint4(O, u) iof_put4(O, (u)>>24, (u)>>16, (u)>>8, u)
+
+#define iof_put_le_uint1(O, u) iof_put(O, u)
+#define iof_put_le_uint2(O, u) iof_put2(O, u, (u)>>8)
+#define iof_put_le_uint3(O, u) iof_put3(O, u, (u)>>8, (u)>>16)
+#define iof_put_le_uint4(O, u) iof_put4(O, u, (u)>>8, (u)>>16, (u)>>24)
+
+/* buffer results */
+
+#define iof_reader_result(I, size) ((size = (size_t)iof_left(I)), (I)->pos)
+#define iof_writer_result(I, size) ((size = (size_t)iof_size(I)), (I)->buf)
+#define iof_result(I, size) (((I)->flags & IOF_READER) ? iof_reader_result(I, size) : iof_writer_result(I, size))
+
+uint8_t * iof_file_input_data (iof_file *iofile, size_t *psize, int *isnew);
+//uint8_t * iof_file_reader_data (iof_file *iofile, size_t *size);
+//uint8_t * iof_file_writer_data (iof_file *iofile, size_t *size);
+
+uint8_t * iof_reader_data (iof *I, size_t *psize);
+uint8_t * iof_writer_data (iof *O, size_t *psize);
+size_t iof_reader_to_file_handle (iof *I, FILE *file);
+size_t iof_reader_to_file (iof *I, const char *filename);
+
+#define iof_loaded(I) ((I)->end = (I)->pos, (I)->pos = (I)->buf, iof_left(I))
+
+#define iof_data_to_file_handle(data, size, file) fwrite(data, sizeof(uint8_t), size, file)
+UTILAPI size_t iof_data_to_file (const void *data, size_t size, const char *filename);
+
+UTILAPI size_t iof_result_to_file_handle (iof *F, FILE *file);
+UTILAPI size_t iof_result_to_file (iof *F, const char *filename);
+UTILAPI void iof_debug (iof *I, const char *filename);
+
+/* common filters allocator */
+
+void iof_filters_init (void);
+void iof_filters_free (void);
+
+iof * iof_filter_reader_new (iof_handler handler, size_t statesize, void **pstate);
+#define iof_filter_reader(handler, statesize, pstate) iof_filter_reader_new(handler, statesize, (void **)(pstate))
+iof * iof_filter_reader_with_buffer_new (iof_handler handler, size_t statesize, void **pstate, void *buffer, size_t buffersize);
+#define iof_filter_reader_with_buffer(handler, statesize, pstate, buffer, buffersize) iof_filter_reader_with_buffer_new(handler, statesize, (void **)(pstate), buffer, buffersize)
+iof * iof_filter_writer_new (iof_handler handler, size_t statesize, void **pstate);
+#define iof_filter_writer(handler, statesize, pstate) iof_filter_writer_new(handler, statesize, (void **)(pstate))
+iof * iof_filter_writer_with_buffer_new (iof_handler handler, size_t statesize, void **pstate, void *buffer, size_t buffersize);
+#define iof_filter_writer_with_buffer(handler, statesize, pstate, buffer, buffersize) iof_filter_writer_with_buffer_new(handler, statesize, (void **)(pstate), buffer, buffersize)
+
+#define iof_filter_state(statetype, F) (statetype)((void *)((F) + 1))
+
+void iof_free (iof *F);
+void iof_discard (iof *F);
+
+size_t iof_resize_buffer_to (iof *O, size_t space);
+#define iof_resize_buffer(O) iof_resize_buffer_to(O, (O)->space << 1)
+
+size_t iof_decoder_retval (iof *I, const char *type, iof_status status);
+size_t iof_encoder_retval (iof *O, const char *type, iof_status status);
+
+/* filters */
+
+iof * iof_filter_file_handle_reader (FILE *file);
+iof * iof_filter_file_handle_writer (FILE *file);
+
+iof * iof_filter_iofile_reader (iof_file *iofile, size_t offset);
+iof * iof_filter_iofile_writer (iof_file *iofile, size_t offset);
+
+iof * iof_filter_file_reader (const char *filename);
+iof * iof_filter_file_writer (const char *filename);
+
+iof * iof_filter_string_reader (const void *s, size_t length);
+iof * iof_filter_string_writer (const void *s, size_t length);
+
+iof * iof_filter_buffer_writer (size_t size);
+
+iof * iof_filter_stream_reader (FILE *file, size_t offset, size_t length);
+iof * iof_filter_stream_coreader (iof_file *iofile, size_t offset, size_t length);
+
+iof * iof_filter_stream_writer (FILE *file);
+iof * iof_filter_stream_cowriter (iof_file *iofile, size_t offset);
+
+FILE * iof_filter_file_reader_source (iof *I, size_t *poffset, size_t *plength);
+iof_file * iof_filter_file_coreader_source (iof *I, size_t *poffset, size_t *plength);
+iof * iof_filter_reader_replacement (iof *P, iof_handler handler, size_t statesize, void **pstate);
+#define iof_filter_reader_replace(P, handler, statesize, pstate) iof_filter_reader_replacement(P, handler, statesize, (void **)(pstate))
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utillog.c b/source/luametatex/source/libraries/pplib/util/utillog.c
new file mode 100644
index 000000000..6d32514a7
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utillog.c
@@ -0,0 +1,60 @@
+
+#include <stdio.h>
+#include <string.h> // strlen
+#include <stdarg.h>
+#include "utillog.h"
+
+#define LOGGER_BUFFER_SIZE 256
+#define LOGGER_PREFIX_SIZE 32
+
+typedef struct {
+ logger_function callback;
+ void *context;
+ size_t pfxlen;
+} logger_struct;
+
+static logger_struct logger = { 0, NULL, 0 };
+
+static char logger_buffer[LOGGER_BUFFER_SIZE+LOGGER_PREFIX_SIZE];
+
+void loggerf (const char *format, ...)
+{
+ va_list args;
+ int length;
+
+ va_start(args, format);
+ length = vsnprintf(logger_buffer + logger.pfxlen, LOGGER_BUFFER_SIZE, format, args);
+ if (length > 0)
+ {
+ if (length > LOGGER_BUFFER_SIZE)
+ length = LOGGER_BUFFER_SIZE;
+ }
+ else
+ {
+ loggerf("logger encoding error '%s'", format);
+ length = (int)strlen(logger_buffer);
+ }
+ length += (int)logger.pfxlen;
+ if (logger.callback)
+ logger.callback(logger_buffer, logger.context);
+ else
+ printf("\n%s\n", logger_buffer);
+ va_end(args);
+}
+
+void logger_callback (logger_function callback, void *context)
+{
+ logger.callback = callback;
+ logger.context = context;
+}
+
+int logger_prefix (const char *prefix)
+{
+ size_t pfxlen;
+ pfxlen = strlen(prefix);
+ if (pfxlen > LOGGER_PREFIX_SIZE)
+ return 0;
+ memcpy(logger_buffer, prefix, pfxlen);
+ logger.pfxlen = pfxlen;
+ return 1;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utillog.h b/source/luametatex/source/libraries/pplib/util/utillog.h
new file mode 100644
index 000000000..c30e0ff0f
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utillog.h
@@ -0,0 +1,10 @@
+
+#ifndef UTIL_LOG_H
+#define UTIL_LOG_H
+
+typedef void (*logger_function) (const char *message, void *alien);
+void loggerf (const char *format, ...);
+void logger_callback (logger_function callback, void *context);
+int logger_prefix (const char *prefix);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utillzw.c b/source/luametatex/source/libraries/pplib/util/utillzw.c
new file mode 100644
index 000000000..e5134e794
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utillzw.c
@@ -0,0 +1,705 @@
+/* lzw implementation for postscript/pdf filters
+# Notes on LZW
+
+# Encoder
+
+Initially the table contains 256 entires for single bytes. Encoder consumes
+input bytes trying to find the longest sequence stored so far in the table.
+Once it finds a sequence that is not present in the table, it outputs the table
+index of the longest sequence found (accumulated bytes except the last
+consumed) and pushes the new sequence (accumulated bytes including the last
+one) on the top of the table. The last taken byte is not yet written to the
+output, it becomes the beginning of the new sequence to accumulate. Initially,
+encoder outputs 9-bit codes. While the table grows, the number of bits for each
+code increases up to 12. In example, after adding a table entry of index 511 it
+is high time to switch to 10-bit bytes. /EarlyChange=true parameter in stream
+dictionary (both postscript and pdf) informs to increase the number of bits one
+code earlier then necessary. Looks pretty much like an early days bug that
+became a specification :) I have never found a PDF having /EarlyChange key
+specified anyway.
+
+Once the table becomes full (or when encoder decides it is worthy),
+a clear-table marker (code 256) purges the table and restores codes length to
+9. End-of-data marker (code 257) ends the stream. Conventionally, the beginning
+of the stream starts with clear-table marker.
+
+Postscript allows to provide a /UnitLength which determines the bit length of
+codes. The above description assumes UnitLength=8 (default). Allowed values are
+from 3 to 8. Different UnitLength also affects markers; clear-table is then
+2^UnitLength and end-of-data marker is 2^UnitLenth+1.
+
+Encoder outputs 9-12bit codes that are packed into bytes using high-bits-first
+scheme (default) or low-bits-scheme.
+
+PDF spec p. 73 (PS spec p. 135 gives an mistaken output sequence and so
+mistaken output bytes)
+
+Input character sequence (decimal)
+45 45 45 45 45 65 45 45 45 66
+
+Output 9bit codes (decimal)
+256 45 258 258 65 259 66 257
+
+Output 9bit codes (binary)
+100000000 000101101 100000010 100000010 001000001 100000011 001000010 100000001
+
+Output bytes (LowBitsFirst=false); eight high-order bits of code becomes
+the first byte, remaining low-order bit of code becomes the high-order bit of the
+next byte;
+10000000 00001011 01100000 01010000 00100010 00001100 00001100 10000101 00000001
+-> 80 0B 60 50 22 0C 0C 85 01
+
+Output bytes (binary, LowBitsFirst=true); eight low-order bits of code becomes
+the first byte, remaining high-order bit of code becomes low-order bit of the
+next byte;
+00000000 01011011 00001000 00010100 00011000 01100100 10100000 10000000 10010000
+-> 00 5B 08 14 18 64 A0 80 90
+
+# Decoder
+
+Decoder consumes input bytes transforming them to 9 to 12 bit codes. Initially
+it starts with 9bit codes and the table of 258 fixed codes (same as encoder).
+Basically, it interprets incoming codes as table indices (except 256 and 257
+markers) and it outputs byte sequences stored at given indices. It also
+upbuilds the table and changes the number of bits of codes when necessary. The
+key point on lzw is that both encoder and decoder builds the table
+synchronously.
+
+However, decoder needs some "knowledge" about how encoder works to be able to
+interpret a table index that it doesn't have so far. Look that the output from
+encoder in the example above. The first output code is conventional clear-table
+(256). Then comes a code 45. So far so good, decoder interprets code 45 as
+a (fixed) entry of the table, emitting byte 45. The next code is 258, which is
+should be interpreted as an index in the table. Oops, encoder doesn't have one
+yet. If that occurs, it means that encoder was able to output the new entry
+code just after adding it to a table. It means that
+
+ sequence_before + next_byte == next_byte + sequence_after
+
+This may happen not only for sequences like 45 45 45, but also symmetric series
+such as abcbabcba; abcb + a == a + bcba. Decoder must be aware of that and if
+it gets a code one larger than the top table index, it should create one on-fly
+by appending last entry sequence by the first by of the last entry.
+
+# UnitLength
+
+Postscript specification mentions about UnitLength parameter that can be used
+in LZW decoder (not allowed in encoder), with possible values from 3 to 8. This
+parameter determines the number of bits per code; form UnitLength + 1 to 12. It
+also determines which codes are used for clear-table marker (2^UnitLength) and
+end-of-data marker ((2^UnitLength)+1). Postscript specification says (page 134):
+
+"Initially, the code length is (UnitLength + 1) bits and the table contains only
+entries for the (2^UnitLength + 2) fixed codes. As encoding proceeds, entries are
+appended to the table, associating new codes with longer and longer input character
+sequences. The encoding and decoding filters maintain identical copies of
+this table."
+
+Later on page 136 Postscript specification says:
+
+"Data that has been LZW-encoded with a UnitLength less than 8 consists only of
+codes in the range 0 to 2^UnitLength - 1; consequently, the LZWDecode filter produces
+only codes in that range when read. UnitLength also affects the encoded
+representation, as described above."
+
+UnitLength (Postscript only) and LowBitsFirst are used only by decoder.
+EarlyChange should obviously be respected by both encoder and decoder. When
+table index reaches current bit length boundary (511, 1023, ...) it must react
+by increasing the number of bits of input code. But if the index reaches it
+maximum value (when the table is full), decoder is NOT supposed to clear the
+table. When the table is full, encoder must emit clear-table marker and it
+emits this code using 12 bits and reinitialize code bits after that. It means
+that, when the table is full, decoder should get one more 12-bit code (which
+should be clear-table marker) and actually clear the table and reinitialize
+code bits after that.
+
+# Clear-table vs last entry track (after tries and checks)
+
+It is also not quite clear what should actually happen when encoder gets a full
+table and it is supposed to emit clear-table marker. When it gets full, it
+means that it has just appended another entry to the table. And that happens
+only the input sequence collected so far plus the last byte is not present in
+the table. Encoder is supposed to output the table index of the present
+sequence and set the recent byte as a starting index of the new sequence to be
+collected. Even if it is time to clear the table, encoder is still supposed to
+keep the track of the last table entry. Decoder, however, must drop the track of the
+last code on clear-table.
+
+# Decoder table vs encoder table
+
+While decoding we need query lzw table by (subsequent) numeric codes and output
+character sequences stored in the table. While encoding we need to query the
+table on every input byte and fetch indices pointing to character sequences.
+Note that we never need to query the entire table for the longest sequence
+found so far. The encoder table do not need to access the longest character
+sequence at one piece. It is enough to keep the track of the current table
+index and the very next byte. We organize an encoder table into a search tree,
+where every node contains its table index (value) and last byte (key). Except
+initial tree content, every node is created on the base of the previous node
+and it conceptually point the sequence represented by that nodo consists of the
+previous node sequence plus the next byte.
+
+Every new node is a descendant of the node it has been derived from. Every node
+has a map (a search subtree) indexed by suffix byte value, pointing to
+descendants nodes. Every node also has binary tentackles (left/right fields)
+necessary to search the map (except initials, every node lives in a map of some
+ancestor node). The key point is that on every input byte we don't search the
+entire tree, but only the map of the current node children. The map tree is
+a simple binary tree with no balancing mechanism (not worthy to optimize an
+ephemeric structure that may be upbuilt more often then queried).
+
+In our implementation, decoder table requires 4069 entries (topmost index 4095).
+Encoder table, however, needs 4097 entries to handle the case when EarlyIndex
+parameter is 0 (I have never a chance to test that in practise). The node of index
+4096 might be added to a search tree, but its code is never emitted; the lookup
+is purged just after adding that node.
+
+todo:
+- support for LowBitsFirst encoding
+*/
+
+#include "utilmem.h"
+#include "utillzw.h"
+
+/* filter state struct */
+
+typedef struct lzw_entry {
+ union {
+ const char *rdata; // to be able to init with string literal
+ char *data;
+ };
+ int size;
+} lzw_entry;
+
+#define lzw_index short
+
+typedef struct lzw_node lzw_node;
+
+struct lzw_node {
+ lzw_index index;
+ unsigned char suffix;
+ lzw_node *left;
+ lzw_node *right;
+ lzw_node *map;
+};
+
+struct lzw_state {
+ union {
+ lzw_node *lookup; /* encoder table */
+ lzw_entry *table; /* decoder table */
+ };
+ lzw_index index; /* table index */
+ union {
+ lzw_node *lastnode; /* previous encoder table node */
+ struct {
+ lzw_entry *lastentry; /* previous decoder table entry */
+ int tailbytes; /* num of bytes of lastentry not yet written out */
+ };
+ };
+ int basebits; /* /UnitLength parameter (8) */
+ int codebits; /* current code bits */
+ int lastbyte; /* previosly read byte */
+ int tailbits; /* lastbyte bits not yet consumed */
+ int flush; /* encoder */
+ int flags; /* options */
+};
+
+typedef union { lzw_state *lzwstate; void *voidstate; } lzw_state_pointer; // to avoid 'dereferencing type-puned ...' warnings
+
+#define LZW_INIT_STATE { { 0 }, 0, { 0 }, 0, 0, 0, 0, 0, 0 }
+
+/* macros */
+
+#define LZW_MIN_BITS 3
+#define LZW_MAX_BITS 12
+#define LZW_TABLE_SIZE (1 << LZW_MAX_BITS)
+#define LZW_LOOKUP_SIZE (LZW_TABLE_SIZE + 1)
+
+#define lzw_bit_range(bits) (bits >= LZW_MIN_BITS && bits <= LZW_BASE_BITS)
+#define lzw_base_bits(flags) (flags & ((1 << 4) - 1)) // 4 low bits of flags is basebits (UnitLength)
+
+#define lzw_initial_codes(state) (1 << state->basebits)
+#define lzw_clear_code(state) lzw_initial_codes(state)
+#define lzw_eod_code(state) (lzw_initial_codes(state) + 1)
+#define lzw_initial_index(state) (lzw_initial_codes(state) + 2)
+
+#define lzw_max_index(state) ((1 << state->codebits) - ((state->flags & LZW_EARLY_INDEX) ? 1 : 0))
+#define lzw_check_bits(state) ((void)(state->index == lzw_max_index(state) && state->codebits < LZW_MAX_BITS && ++state->codebits))
+
+#define lzw_malloc util_malloc
+#define lzw_free util_free
+
+/* decoder */
+
+static struct lzw_entry lzw_initial_table[] = {
+ {{"\x00"}, 1}, {{"\x01"}, 1}, {{"\x02"}, 1}, {{"\x03"}, 1}, {{"\x04"}, 1}, {{"\x05"}, 1}, {{"\x06"}, 1}, {{"\x07"}, 1}, {{"\x08"}, 1}, {{"\x09"}, 1}, {{"\x0A"}, 1}, {{"\x0B"}, 1}, {{"\x0C"}, 1}, {{"\x0D"}, 1}, {{"\x0E"}, 1}, {{"\x0F"}, 1},
+ {{"\x10"}, 1}, {{"\x11"}, 1}, {{"\x12"}, 1}, {{"\x13"}, 1}, {{"\x14"}, 1}, {{"\x15"}, 1}, {{"\x16"}, 1}, {{"\x17"}, 1}, {{"\x18"}, 1}, {{"\x19"}, 1}, {{"\x1A"}, 1}, {{"\x1B"}, 1}, {{"\x1C"}, 1}, {{"\x1D"}, 1}, {{"\x1E"}, 1}, {{"\x1F"}, 1},
+ {{"\x20"}, 1}, {{"\x21"}, 1}, {{"\x22"}, 1}, {{"\x23"}, 1}, {{"\x24"}, 1}, {{"\x25"}, 1}, {{"\x26"}, 1}, {{"\x27"}, 1}, {{"\x28"}, 1}, {{"\x29"}, 1}, {{"\x2A"}, 1}, {{"\x2B"}, 1}, {{"\x2C"}, 1}, {{"\x2D"}, 1}, {{"\x2E"}, 1}, {{"\x2F"}, 1},
+ {{"\x30"}, 1}, {{"\x31"}, 1}, {{"\x32"}, 1}, {{"\x33"}, 1}, {{"\x34"}, 1}, {{"\x35"}, 1}, {{"\x36"}, 1}, {{"\x37"}, 1}, {{"\x38"}, 1}, {{"\x39"}, 1}, {{"\x3A"}, 1}, {{"\x3B"}, 1}, {{"\x3C"}, 1}, {{"\x3D"}, 1}, {{"\x3E"}, 1}, {{"\x3F"}, 1},
+ {{"\x40"}, 1}, {{"\x41"}, 1}, {{"\x42"}, 1}, {{"\x43"}, 1}, {{"\x44"}, 1}, {{"\x45"}, 1}, {{"\x46"}, 1}, {{"\x47"}, 1}, {{"\x48"}, 1}, {{"\x49"}, 1}, {{"\x4A"}, 1}, {{"\x4B"}, 1}, {{"\x4C"}, 1}, {{"\x4D"}, 1}, {{"\x4E"}, 1}, {{"\x4F"}, 1},
+ {{"\x50"}, 1}, {{"\x51"}, 1}, {{"\x52"}, 1}, {{"\x53"}, 1}, {{"\x54"}, 1}, {{"\x55"}, 1}, {{"\x56"}, 1}, {{"\x57"}, 1}, {{"\x58"}, 1}, {{"\x59"}, 1}, {{"\x5A"}, 1}, {{"\x5B"}, 1}, {{"\x5C"}, 1}, {{"\x5D"}, 1}, {{"\x5E"}, 1}, {{"\x5F"}, 1},
+ {{"\x60"}, 1}, {{"\x61"}, 1}, {{"\x62"}, 1}, {{"\x63"}, 1}, {{"\x64"}, 1}, {{"\x65"}, 1}, {{"\x66"}, 1}, {{"\x67"}, 1}, {{"\x68"}, 1}, {{"\x69"}, 1}, {{"\x6A"}, 1}, {{"\x6B"}, 1}, {{"\x6C"}, 1}, {{"\x6D"}, 1}, {{"\x6E"}, 1}, {{"\x6F"}, 1},
+ {{"\x70"}, 1}, {{"\x71"}, 1}, {{"\x72"}, 1}, {{"\x73"}, 1}, {{"\x74"}, 1}, {{"\x75"}, 1}, {{"\x76"}, 1}, {{"\x77"}, 1}, {{"\x78"}, 1}, {{"\x79"}, 1}, {{"\x7A"}, 1}, {{"\x7B"}, 1}, {{"\x7C"}, 1}, {{"\x7D"}, 1}, {{"\x7E"}, 1}, {{"\x7F"}, 1},
+ {{"\x80"}, 1}, {{"\x81"}, 1}, {{"\x82"}, 1}, {{"\x83"}, 1}, {{"\x84"}, 1}, {{"\x85"}, 1}, {{"\x86"}, 1}, {{"\x87"}, 1}, {{"\x88"}, 1}, {{"\x89"}, 1}, {{"\x8A"}, 1}, {{"\x8B"}, 1}, {{"\x8C"}, 1}, {{"\x8D"}, 1}, {{"\x8E"}, 1}, {{"\x8F"}, 1},
+ {{"\x90"}, 1}, {{"\x91"}, 1}, {{"\x92"}, 1}, {{"\x93"}, 1}, {{"\x94"}, 1}, {{"\x95"}, 1}, {{"\x96"}, 1}, {{"\x97"}, 1}, {{"\x98"}, 1}, {{"\x99"}, 1}, {{"\x9A"}, 1}, {{"\x9B"}, 1}, {{"\x9C"}, 1}, {{"\x9D"}, 1}, {{"\x9E"}, 1}, {{"\x9F"}, 1},
+ {{"\xA0"}, 1}, {{"\xA1"}, 1}, {{"\xA2"}, 1}, {{"\xA3"}, 1}, {{"\xA4"}, 1}, {{"\xA5"}, 1}, {{"\xA6"}, 1}, {{"\xA7"}, 1}, {{"\xA8"}, 1}, {{"\xA9"}, 1}, {{"\xAA"}, 1}, {{"\xAB"}, 1}, {{"\xAC"}, 1}, {{"\xAD"}, 1}, {{"\xAE"}, 1}, {{"\xAF"}, 1},
+ {{"\xB0"}, 1}, {{"\xB1"}, 1}, {{"\xB2"}, 1}, {{"\xB3"}, 1}, {{"\xB4"}, 1}, {{"\xB5"}, 1}, {{"\xB6"}, 1}, {{"\xB7"}, 1}, {{"\xB8"}, 1}, {{"\xB9"}, 1}, {{"\xBA"}, 1}, {{"\xBB"}, 1}, {{"\xBC"}, 1}, {{"\xBD"}, 1}, {{"\xBE"}, 1}, {{"\xBF"}, 1},
+ {{"\xC0"}, 1}, {{"\xC1"}, 1}, {{"\xC2"}, 1}, {{"\xC3"}, 1}, {{"\xC4"}, 1}, {{"\xC5"}, 1}, {{"\xC6"}, 1}, {{"\xC7"}, 1}, {{"\xC8"}, 1}, {{"\xC9"}, 1}, {{"\xCA"}, 1}, {{"\xCB"}, 1}, {{"\xCC"}, 1}, {{"\xCD"}, 1}, {{"\xCE"}, 1}, {{"\xCF"}, 1},
+ {{"\xD0"}, 1}, {{"\xD1"}, 1}, {{"\xD2"}, 1}, {{"\xD3"}, 1}, {{"\xD4"}, 1}, {{"\xD5"}, 1}, {{"\xD6"}, 1}, {{"\xD7"}, 1}, {{"\xD8"}, 1}, {{"\xD9"}, 1}, {{"\xDA"}, 1}, {{"\xDB"}, 1}, {{"\xDC"}, 1}, {{"\xDD"}, 1}, {{"\xDE"}, 1}, {{"\xDF"}, 1},
+ {{"\xE0"}, 1}, {{"\xE1"}, 1}, {{"\xE2"}, 1}, {{"\xE3"}, 1}, {{"\xE4"}, 1}, {{"\xE5"}, 1}, {{"\xE6"}, 1}, {{"\xE7"}, 1}, {{"\xE8"}, 1}, {{"\xE9"}, 1}, {{"\xEA"}, 1}, {{"\xEB"}, 1}, {{"\xEC"}, 1}, {{"\xED"}, 1}, {{"\xEE"}, 1}, {{"\xEF"}, 1},
+ {{"\xF0"}, 1}, {{"\xF1"}, 1}, {{"\xF2"}, 1}, {{"\xF3"}, 1}, {{"\xF4"}, 1}, {{"\xF5"}, 1}, {{"\xF6"}, 1}, {{"\xF7"}, 1}, {{"\xF8"}, 1}, {{"\xF9"}, 1}, {{"\xFA"}, 1}, {{"\xFB"}, 1}, {{"\xFC"}, 1}, {{"\xFD"}, 1}, {{"\xFE"}, 1}, {{"\xFF"}, 1}
+};
+
+#define lzw_entry_at(state, index) (&state->table[index])
+
+static lzw_state * lzw_decoder_init_table (lzw_state *state, lzw_entry *table, int flags)
+{
+ state->basebits = lzw_base_bits(flags); // first four bits or flags
+ if (!lzw_bit_range(state->basebits))
+ return NULL;
+ state->flags = flags;
+ if ((state->table = table) == NULL)
+ {
+ state->table = (lzw_entry *)lzw_malloc(LZW_TABLE_SIZE * sizeof(lzw_entry));
+ state->flags |= LZW_TABLE_ALLOC;
+ }
+ memcpy(state->table, lzw_initial_table, (size_t)lzw_initial_codes(state)*sizeof(lzw_entry));
+ // memset(&state->table[lzw_initial_codes(state)], 0, 2*sizeof(lzw_entry)); // eod and clear entries never accessed
+ state->codebits = state->basebits + 1;
+ state->index = lzw_initial_index(state);
+ state->lastentry = NULL;
+ state->tailbytes = 0;
+ state->lastbyte = 0;
+ state->tailbits = 0;
+ return state;
+}
+
+lzw_state * lzw_decoder_init (lzw_state *state, int flags)
+{
+ return lzw_decoder_init_table(state, NULL, flags);
+}
+
+static void lzw_decoder_clear (lzw_state *state)
+{
+ lzw_entry *entry;
+ lzw_index initindex = lzw_initial_index(state);
+ while (state->index > initindex)
+ {
+ entry = lzw_entry_at(state, --state->index);
+ lzw_free(entry->data);
+ // entry->data = NULL;
+ // entry->size = 0;
+ }
+ state->lastentry = NULL;
+ state->tailbytes = 0;
+ state->codebits = state->basebits + 1;
+}
+
+void lzw_decoder_close (lzw_state *state)
+{
+ lzw_decoder_clear(state);
+ if (state->flags & LZW_TABLE_ALLOC)
+ lzw_free(state->table);
+}
+
+static int lzw_next_entry (lzw_state *state, lzw_entry *nextentry)
+{
+ lzw_entry *lastentry, *newentry;
+ if ((lastentry = state->lastentry) == NULL)
+ return 1; /* its ok */
+ if (state->index == LZW_TABLE_SIZE)
+ return 0; /* invalid input; eod marker expected earlier */
+ /* put the new entry on the top of the table */
+ newentry = lzw_entry_at(state, state->index++);
+ /* its size is the last entrtyy size plus 1 */
+ newentry->size = lastentry->size + 1;
+ /* its content is the content of the last entry, */
+ newentry->data = (char *)lzw_malloc((size_t)newentry->size);
+ memcpy(newentry->data, lastentry->data, lastentry->size);
+ /* plus the first byte of the new entry (usually fixed code entry) */
+ newentry->data[newentry->size - 1] = nextentry->data[0];
+ return 1;
+}
+
+#define lzw_write_bytes(O, state) ((state->tailbytes -= (int)iof_write(O, state->lastentry->data, (size_t)state->tailbytes)) == 0)
+
+iof_status lzw_decode_state (iof *I, iof *O, lzw_state *state)
+{
+ const lzw_index clear = lzw_clear_code(state), eod = lzw_eod_code(state);
+ lzw_index code;
+ lzw_entry *entry;
+ if (state->lastentry != NULL)
+ { /* write out the tail from the last call */
+ if (state->tailbytes > 0 && !lzw_write_bytes(O, state))
+ return IOFFULL;
+ /* do what we normally do at the end of the loop body below */
+ lzw_check_bits(state);
+ }
+ // if (state->flags & LZW_LOW_BITS_FIRST)
+ // return IOFERR;
+ while (1)
+ {
+ /* get input code of length state->codebits */
+ code = (state->lastbyte & ((1 << state->tailbits) - 1)) << (state->codebits - state->tailbits);
+ for (state->tailbits -= state->codebits; state->tailbits < 0; )
+ {
+ get_code:
+ if ((state->lastbyte = iof_get(I)) < 0)
+ return state->flush ? IOFEOF : state->lastbyte;
+ state->tailbits += 8;
+ if (state->tailbits < 0)
+ {
+ code |= (state->lastbyte << (-state->tailbits));
+ goto get_code;
+ }
+ else
+ {
+ code |= (state->lastbyte >> state->tailbits);
+ break;
+ }
+ }
+ /* interpret the code */
+ if (code < state->index)
+ { /* single byte code or special marker */
+ if (code == clear)
+ {
+ lzw_decoder_clear(state);
+ continue;
+ }
+ if (code == eod)
+ return IOFEOF;
+ entry = lzw_entry_at(state, code);
+ if (!lzw_next_entry(state, entry))
+ return IOFERR;
+ }
+ else if (code == state->index)
+ { /* apparently encoder has emitted the code of the key just created (see notes) */
+ if (!lzw_next_entry(state, state->lastentry))
+ return IOFERR;
+ entry = lzw_entry_at(state, state->index - 1);
+ }
+ else
+ { /* invalid input code */
+ return IOFERR;
+ }
+ /* record the entry found */
+ state->lastentry = entry;
+ /* emit the sequence pointed by that entry */
+ state->tailbytes = entry->size;
+ if (!lzw_write_bytes(O, state))
+ return IOFFULL;
+ /* check and update code bits */
+ lzw_check_bits(state);
+ }
+ return state->lastbyte; // never reached
+}
+
+/* encoder */
+
+#define lzw_node_at(state, index) (&state->lookup[index])
+
+#define lzw_node_init(node, i, c) (node->index = i, node->suffix = c, node->left = NULL, node->right = NULL, node->map = NULL)
+
+static lzw_state * lzw_encoder_init_table (lzw_state *state, lzw_node *lookup, int flags)
+{
+ lzw_index index;
+ lzw_node *node;
+ state->basebits = lzw_base_bits(flags); // first four bits of flags is base bits of code (default 8)
+ if (!lzw_bit_range(state->basebits))
+ return NULL;
+ state->flags = flags;
+ if ((state->lookup = lookup) == NULL)
+ {
+ state->lookup = lzw_malloc(LZW_LOOKUP_SIZE*sizeof(lzw_node));
+ state->flags |= LZW_TABLE_ALLOC;
+ }
+ state->index = lzw_initial_index(state);
+ for (index = 0; index < lzw_initial_codes(state); ++index)
+ {
+ node = lzw_node_at(state, index);
+ lzw_node_init(node, index, (unsigned char)index);
+ }
+ state->codebits = state->basebits + 1;
+ state->lastnode = NULL;
+ state->lastbyte = 0;
+ state->tailbits = 0;
+ return state;
+}
+
+lzw_state * lzw_encoder_init (lzw_state *state, int flags)
+{
+ return lzw_encoder_init_table(state, NULL, flags);
+}
+
+void lzw_encoder_close (lzw_state *state)
+{
+ if (state->flags & LZW_TABLE_ALLOC)
+ lzw_free(state->lookup);
+}
+
+static void lzw_encoder_clear (lzw_state *state)
+{
+ lzw_node *node;
+ lzw_index index;
+ /* clear fixed nodes */
+ for (index = 0; index < lzw_initial_codes(state); ++index)
+ {
+ node = lzw_node_at(state, index);
+ lzw_node_init(node, index, (unsigned char)index);
+ }
+ /* reset table index */
+ state->index = lzw_initial_index(state);
+ /* reset code bits */
+ state->codebits = state->basebits + 1;
+}
+
+static void lzw_put_code (iof *O, lzw_state *state, lzw_index code, int todobits)
+{
+ int leftbits, rightbits;
+ do
+ {
+ leftbits = 8 - state->tailbits;
+ rightbits = todobits - leftbits;
+ if (rightbits >= 0)
+ {
+ state->lastbyte |= (code >> rightbits);
+ iof_put(O, state->lastbyte);
+ code = code & ((1 << rightbits) - 1);
+ todobits -= leftbits;
+ state->lastbyte = 0;
+ state->tailbits = 0;
+ }
+ else
+ {
+ state->lastbyte |= (code << (-rightbits));
+ state->tailbits += todobits;
+ return;
+ }
+ } while (1);
+}
+
+static iof_status lzw_encode_last (iof *O, lzw_state *state)
+{
+ if (state->flush)
+ {
+ /* put the last code if any */
+ if (state->lastnode != NULL)
+ lzw_put_code(O, state, state->lastnode->index, state->codebits);
+ /* put eod marker, */
+ lzw_put_code(O, state, lzw_eod_code(state), state->codebits);
+ /* with tail bits set to 0 */
+ if (state->tailbits > 0)
+ lzw_put_code(O, state, 0, 8 - state->tailbits);
+ return IOFEOF;
+ }
+ return IOFEMPTY;
+}
+
+static lzw_node * lzw_node_push (lzw_state *state, unsigned char suffix)
+{
+ lzw_node *node;
+ node = lzw_node_at(state, state->index);
+ lzw_node_init(node, state->index, suffix);
+ ++state->index;
+ return node;
+}
+
+static int lzw_next_node (lzw_state *state, unsigned char suffix)
+{
+ lzw_node *node;
+ if ((node = state->lastnode->map) == NULL)
+ {
+ state->lastnode->map = lzw_node_push(state, suffix);
+ return 0;
+ }
+ while (1)
+ {
+ if (suffix < node->suffix)
+ {
+ if (node->left == NULL)
+ {
+ node->left = lzw_node_push(state, suffix);
+ return 0;
+ }
+ node = node->left;
+ }
+ else if (suffix > node->suffix)
+ {
+ if (node->right == NULL)
+ {
+ node->right = lzw_node_push(state, suffix);
+ return 0;
+ }
+ node = node->right;
+ }
+ else
+ {
+ state->lastnode = node;
+ return 1;
+ }
+ }
+ return 0; // never reached
+}
+
+iof_status lzw_encode_state (iof *I, iof *O, lzw_state *state)
+{
+ int byte;
+ if (state->lastnode == NULL)
+ { /* first call only; following convention, put clear-table marker */
+ if (!iof_ensure(O, 2))
+ return IOFFULL;
+ lzw_put_code(O, state, lzw_clear_code(state), state->codebits);
+ /* get the first input byte and initialize the current table entry */
+ if ((byte = iof_get(I)) < 0)
+ return lzw_encode_last(O, state);
+ state->lastnode = lzw_node_at(state, byte);
+ }
+ while (iof_ensure(O, 2))
+ { /* we need to write at most 2 bytes on each iteration */
+ if ((byte = iof_get(I)) < 0)
+ return lzw_encode_last(O, state);
+ if (lzw_next_node(state, (unsigned char)byte) == 0)
+ { /* means that the key hasn't been found and the new entry has just been created */
+ /* output the code pointing the longest sequence so far */
+ lzw_put_code(O, state, state->lastnode->index, state->codebits);
+ /* update code bits */
+ if (state->index == lzw_max_index(state) + 1)
+ {
+ if (state->codebits < LZW_MAX_BITS)
+ ++state->codebits;
+ else
+ {
+ /* put clear-table marker */
+ lzw_put_code(O, state, lzw_clear_code(state), state->codebits);
+ /* reset the table */
+ lzw_encoder_clear(state);
+ }
+ }
+ /* in any case, recent byte becomes the current table code */
+ state->lastnode = lzw_node_at(state, byte);
+ }
+ /* otherwise no new entry is appended and state->lastnode points the longer sequence just found */
+ }
+ return IOFFULL;
+}
+
+/* single call codecs */
+
+iof_status lzw_decode (iof *I, iof *O, int flags)
+{
+ lzw_state state = LZW_INIT_STATE;
+ lzw_entry table[LZW_TABLE_SIZE];
+ int ret;
+ lzw_decoder_init_table(&state, table, flags);
+ state.flush = 1;
+ ret = lzw_decode_state(I, O, &state);
+ // iof_flush(O); // ?
+ lzw_decoder_close(&state);
+ return ret;
+}
+
+iof_status lzw_encode (iof *I, iof *O, int flags)
+{
+ lzw_state state = LZW_INIT_STATE;
+ lzw_node lookup[LZW_LOOKUP_SIZE];
+ int ret;
+ lzw_encoder_init_table(&state, lookup, flags);
+ state.flush = 1;
+ ret = lzw_encode_state(I, O, &state);
+ // iof_flush(O); // ?
+ lzw_encoder_close(&state);
+ return ret;
+}
+
+/* filters */
+
+// lzw decoder function
+
+static size_t lzw_decoder (iof *F, iof_mode mode)
+{
+ lzw_state *state;
+ iof_status status;
+ size_t tail;
+
+ state = iof_filter_state(lzw_state *, F);
+ switch(mode)
+ {
+ case IOFLOAD:
+ case IOFREAD:
+ if (F->flags & IOF_STOPPED)
+ return 0;
+ tail = iof_tail(F);
+ F->pos = F->buf + tail;
+ F->end = F->buf + F->space;
+ do {
+ status = lzw_decode_state(F->next, F, state);
+ } while (mode == IOFLOAD && status == IOFFULL && iof_resize_buffer(F));
+ return iof_decoder_retval(F, "lzw", status);
+ case IOFCLOSE:
+ lzw_decoder_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+// lzw encoder function
+
+static size_t lzw_encoder (iof *F, iof_mode mode)
+{
+ lzw_state *state;
+ iof_status status;
+
+ state = iof_filter_state(lzw_state *, F);
+ switch (mode)
+ {
+ case IOFFLUSH:
+ state->flush = 1;
+ FALLTHRU // fall through
+ case IOFWRITE:
+ F->end = F->pos;
+ F->pos = F->buf;
+ status = lzw_encode_state(F, F->next, state);
+ return iof_encoder_retval(F, "lzw", status);
+ case IOFCLOSE:
+ if (!state->flush)
+ lzw_encoder(F, IOFFLUSH);
+ lzw_encoder_close(state);
+ iof_free(F);
+ return 0;
+ default:
+ break;
+ }
+ return 0;
+}
+
+iof * iof_filter_lzw_decoder (iof *N, int flags)
+{
+ iof *I;
+ lzw_state_pointer P;
+ I = iof_filter_reader(lzw_decoder, sizeof(lzw_state), &P.voidstate);
+ iof_setup_next(I, N);
+ if (lzw_decoder_init(P.lzwstate, flags) == NULL)
+ {
+ iof_discard(I);
+ return NULL;
+ }
+ P.lzwstate->flush = 1;
+ return I;
+}
+
+iof * iof_filter_lzw_encoder (iof *N, int flags)
+{
+ iof *O;
+ lzw_state_pointer P;
+ O = iof_filter_writer(lzw_encoder, sizeof(lzw_state), &P.voidstate);
+ iof_setup_next(O, N);
+ if (lzw_encoder_init(P.lzwstate, flags) == NULL)
+ {
+ iof_discard(O);
+ return NULL;
+ }
+ return O;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utillzw.h b/source/luametatex/source/libraries/pplib/util/utillzw.h
new file mode 100644
index 000000000..9e3a085d4
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utillzw.h
@@ -0,0 +1,30 @@
+#ifndef UTIL_LZW_H
+#define UTIL_LZW_H
+
+#include "utiliof.h"
+
+typedef struct lzw_state lzw_state;
+
+#define LZW_BASE_BITS 8
+#define LZW_TABLE_ALLOC (1<<4)
+#define LZW_EARLY_INDEX (1<<5)
+//#define LZW_LOW_BITS_FIRST (1<<6)
+#define LZW_DECODER_DEFAULTS (LZW_BASE_BITS|LZW_EARLY_INDEX|0)
+#define LZW_ENCODER_DEFAULTS (LZW_BASE_BITS|LZW_EARLY_INDEX|0)
+
+lzw_state * lzw_decoder_init (lzw_state *state, int flags);
+lzw_state * lzw_encoder_init (lzw_state *state, int flags);
+
+void lzw_decoder_close (lzw_state *state);
+void lzw_encoder_close (lzw_state *state);
+
+iof_status lzw_encode_state (iof *I, iof *O, lzw_state *state);
+iof_status lzw_decode_state (iof *I, iof *O, lzw_state *state);
+
+iof_status lzw_encode (iof *I, iof *O, int flags);
+iof_status lzw_decode (iof *I, iof *O, int flags);
+
+iof * iof_filter_lzw_decoder (iof *N, int flags);
+iof * iof_filter_lzw_encoder (iof *N, int flags);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmd5.c b/source/luametatex/source/libraries/pplib/util/utilmd5.c
new file mode 100644
index 000000000..871984229
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmd5.c
@@ -0,0 +1,447 @@
+
+/* md5 implementation excerpted from code by Peter Deutsch */
+
+/* begin of md5.c */
+
+/*
+ Copyright (C) 1999, 2000, 2002 Aladdin Enterprises. All rights reserved.
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ L. Peter Deutsch
+ ghost@aladdin.com
+
+ */
+/* $Id: md5.c,v 1.6 2002/04/13 19:20:28 lpd Exp $ */
+/*
+ Independent implementation of MD5 (RFC 1321).
+
+ This code implements the MD5 Algorithm defined in RFC 1321, whose
+ text is available at
+ http://www.ietf.org/rfc/rfc1321.txt
+ The code is derived from the text of the RFC, including the test suite
+ (section A.5) but excluding the rest of Appendix A. It does not include
+ any code or documentation that is identified in the RFC as being
+ copyrighted.
+
+ The original and principal author of md5.c is L. Peter Deutsch
+ <ghost@aladdin.com>. Other authors are noted in the change history
+ that follows (in reverse chronological order):
+
+ 2002-04-13 lpd Clarified derivation from RFC 1321; now handles byte order
+ either statically or dynamically; added missing #include <string.h>
+ in library.
+ 2002-03-11 lpd Corrected argument list for main(), and added int return
+ type, in test program and T value program.
+ 2002-02-21 lpd Added missing #include <stdio.h> in test program.
+ 2000-07-03 lpd Patched to eliminate warnings about "constant is
+ unsigned in ANSI C, signed in traditional"; made test program
+ self-checking.
+ 1999-11-04 lpd Edited comments slightly for automatic TOC extraction.
+ 1999-10-18 lpd Fixed typo in header comment (ansi2knr rather than md5).
+ 1999-05-03 lpd Original version.
+ */
+
+#include <string.h> // memcpy
+#include <stdio.h> // FILE
+
+#include "utilmd5.h"
+
+#undef BYTE_ORDER /* 1 = big-endian, -1 = little-endian, 0 = unknown */
+#ifdef ARCH_IS_BIG_ENDIAN
+# define BYTE_ORDER (ARCH_IS_BIG_ENDIAN ? 1 : -1)
+#else
+# define BYTE_ORDER 0
+#endif
+
+#define T_MASK ((uint32_t)~0)
+#define T1 /* 0xd76aa478 */ (T_MASK ^ 0x28955b87)
+#define T2 /* 0xe8c7b756 */ (T_MASK ^ 0x173848a9)
+#define T3 0x242070db
+#define T4 /* 0xc1bdceee */ (T_MASK ^ 0x3e423111)
+#define T5 /* 0xf57c0faf */ (T_MASK ^ 0x0a83f050)
+#define T6 0x4787c62a
+#define T7 /* 0xa8304613 */ (T_MASK ^ 0x57cfb9ec)
+#define T8 /* 0xfd469501 */ (T_MASK ^ 0x02b96afe)
+#define T9 0x698098d8
+#define T10 /* 0x8b44f7af */ (T_MASK ^ 0x74bb0850)
+#define T11 /* 0xffff5bb1 */ (T_MASK ^ 0x0000a44e)
+#define T12 /* 0x895cd7be */ (T_MASK ^ 0x76a32841)
+#define T13 0x6b901122
+#define T14 /* 0xfd987193 */ (T_MASK ^ 0x02678e6c)
+#define T15 /* 0xa679438e */ (T_MASK ^ 0x5986bc71)
+#define T16 0x49b40821
+#define T17 /* 0xf61e2562 */ (T_MASK ^ 0x09e1da9d)
+#define T18 /* 0xc040b340 */ (T_MASK ^ 0x3fbf4cbf)
+#define T19 0x265e5a51
+#define T20 /* 0xe9b6c7aa */ (T_MASK ^ 0x16493855)
+#define T21 /* 0xd62f105d */ (T_MASK ^ 0x29d0efa2)
+#define T22 0x02441453
+#define T23 /* 0xd8a1e681 */ (T_MASK ^ 0x275e197e)
+#define T24 /* 0xe7d3fbc8 */ (T_MASK ^ 0x182c0437)
+#define T25 0x21e1cde6
+#define T26 /* 0xc33707d6 */ (T_MASK ^ 0x3cc8f829)
+#define T27 /* 0xf4d50d87 */ (T_MASK ^ 0x0b2af278)
+#define T28 0x455a14ed
+#define T29 /* 0xa9e3e905 */ (T_MASK ^ 0x561c16fa)
+#define T30 /* 0xfcefa3f8 */ (T_MASK ^ 0x03105c07)
+#define T31 0x676f02d9
+#define T32 /* 0x8d2a4c8a */ (T_MASK ^ 0x72d5b375)
+#define T33 /* 0xfffa3942 */ (T_MASK ^ 0x0005c6bd)
+#define T34 /* 0x8771f681 */ (T_MASK ^ 0x788e097e)
+#define T35 0x6d9d6122
+#define T36 /* 0xfde5380c */ (T_MASK ^ 0x021ac7f3)
+#define T37 /* 0xa4beea44 */ (T_MASK ^ 0x5b4115bb)
+#define T38 0x4bdecfa9
+#define T39 /* 0xf6bb4b60 */ (T_MASK ^ 0x0944b49f)
+#define T40 /* 0xbebfbc70 */ (T_MASK ^ 0x4140438f)
+#define T41 0x289b7ec6
+#define T42 /* 0xeaa127fa */ (T_MASK ^ 0x155ed805)
+#define T43 /* 0xd4ef3085 */ (T_MASK ^ 0x2b10cf7a)
+#define T44 0x04881d05
+#define T45 /* 0xd9d4d039 */ (T_MASK ^ 0x262b2fc6)
+#define T46 /* 0xe6db99e5 */ (T_MASK ^ 0x1924661a)
+#define T47 0x1fa27cf8
+#define T48 /* 0xc4ac5665 */ (T_MASK ^ 0x3b53a99a)
+#define T49 /* 0xf4292244 */ (T_MASK ^ 0x0bd6ddbb)
+#define T50 0x432aff97
+#define T51 /* 0xab9423a7 */ (T_MASK ^ 0x546bdc58)
+#define T52 /* 0xfc93a039 */ (T_MASK ^ 0x036c5fc6)
+#define T53 0x655b59c3
+#define T54 /* 0x8f0ccc92 */ (T_MASK ^ 0x70f3336d)
+#define T55 /* 0xffeff47d */ (T_MASK ^ 0x00100b82)
+#define T56 /* 0x85845dd1 */ (T_MASK ^ 0x7a7ba22e)
+#define T57 0x6fa87e4f
+#define T58 /* 0xfe2ce6e0 */ (T_MASK ^ 0x01d3191f)
+#define T59 /* 0xa3014314 */ (T_MASK ^ 0x5cfebceb)
+#define T60 0x4e0811a1
+#define T61 /* 0xf7537e82 */ (T_MASK ^ 0x08ac817d)
+#define T62 /* 0xbd3af235 */ (T_MASK ^ 0x42c50dca)
+#define T63 0x2ad7d2bb
+#define T64 /* 0xeb86d391 */ (T_MASK ^ 0x14792c6e)
+
+static void md5_process (md5_state *state, const uint8_t *data /*[64]*/)
+{
+ uint32_t
+ a = state->words[0], b = state->words[1],
+ c = state->words[2], d = state->words[3];
+ uint32_t t;
+#if BYTE_ORDER > 0
+ /* Define storage only for big-endian CPUs. */
+ uint32_t X[16];
+#else
+ /* Define storage for little-endian or both types of CPUs. */
+ uint32_t xbuf[16];
+ const uint32_t *X;
+#endif
+
+ {
+#if BYTE_ORDER == 0
+ /*
+ * Determine dynamically whether this is a big-endian or
+ * little-endian machine, since we can use a more efficient
+ * algorithm on the latter.
+ */
+ static const int w = 1;
+
+ if (*((const uint8_t *)&w)) /* dynamic little-endian */
+#endif
+#if BYTE_ORDER <= 0 /* little-endian */
+ {
+ /*
+ * On little-endian machines, we can process properly aligned
+ * data without copying it.
+ */
+ if (!((data - (const uint8_t *)0) & 3)) {
+ /* data are properly aligned */
+ X = (const uint32_t *)((const void *)data); // avoid compiler warning
+ } else {
+ /* not aligned */
+ memcpy(xbuf, data, 64);
+ X = xbuf;
+ }
+ }
+#endif
+#if BYTE_ORDER == 0
+ else /* dynamic big-endian */
+#endif
+#if BYTE_ORDER >= 0 /* big-endian */
+ {
+ /*
+ * On big-endian machines, we must arrange the bytes in the
+ * right order.
+ */
+ const uint8_t *xp = data;
+ int i;
+# if BYTE_ORDER == 0
+ X = xbuf; /* (dynamic only) */
+# else
+# define xbuf X /* (static only) */
+# endif
+ for (i = 0; i < 16; ++i, xp += 4)
+ xbuf[i] = xp[0] + (xp[1] << 8) + (xp[2] << 16) + (xp[3] << 24);
+ }
+#endif
+ }
+
+#define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32 - (n))))
+
+ /* Round 1. */
+ /* Let [abcd k s i] denote the operation
+ a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s). */
+#define F(x, y, z) (((x) & (y)) | (~(x) & (z)))
+#define SET(a, b, c, d, k, s, Ti)\
+ t = a + F(b,c,d) + X[k] + Ti;\
+ a = ROTATE_LEFT(t, s) + b
+ /* Do the following 16 operations. */
+ SET(a, b, c, d, 0, 7, T1);
+ SET(d, a, b, c, 1, 12, T2);
+ SET(c, d, a, b, 2, 17, T3);
+ SET(b, c, d, a, 3, 22, T4);
+ SET(a, b, c, d, 4, 7, T5);
+ SET(d, a, b, c, 5, 12, T6);
+ SET(c, d, a, b, 6, 17, T7);
+ SET(b, c, d, a, 7, 22, T8);
+ SET(a, b, c, d, 8, 7, T9);
+ SET(d, a, b, c, 9, 12, T10);
+ SET(c, d, a, b, 10, 17, T11);
+ SET(b, c, d, a, 11, 22, T12);
+ SET(a, b, c, d, 12, 7, T13);
+ SET(d, a, b, c, 13, 12, T14);
+ SET(c, d, a, b, 14, 17, T15);
+ SET(b, c, d, a, 15, 22, T16);
+#undef SET
+
+ /* Round 2. */
+ /* Let [abcd k s i] denote the operation
+ a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s). */
+#define G(x, y, z) (((x) & (z)) | ((y) & ~(z)))
+#define SET(a, b, c, d, k, s, Ti)\
+ t = a + G(b,c,d) + X[k] + Ti;\
+ a = ROTATE_LEFT(t, s) + b
+ /* Do the following 16 operations. */
+ SET(a, b, c, d, 1, 5, T17);
+ SET(d, a, b, c, 6, 9, T18);
+ SET(c, d, a, b, 11, 14, T19);
+ SET(b, c, d, a, 0, 20, T20);
+ SET(a, b, c, d, 5, 5, T21);
+ SET(d, a, b, c, 10, 9, T22);
+ SET(c, d, a, b, 15, 14, T23);
+ SET(b, c, d, a, 4, 20, T24);
+ SET(a, b, c, d, 9, 5, T25);
+ SET(d, a, b, c, 14, 9, T26);
+ SET(c, d, a, b, 3, 14, T27);
+ SET(b, c, d, a, 8, 20, T28);
+ SET(a, b, c, d, 13, 5, T29);
+ SET(d, a, b, c, 2, 9, T30);
+ SET(c, d, a, b, 7, 14, T31);
+ SET(b, c, d, a, 12, 20, T32);
+#undef SET
+
+ /* Round 3. */
+ /* Let [abcd k s t] denote the operation
+ a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s). */
+#define H(x, y, z) ((x) ^ (y) ^ (z))
+#define SET(a, b, c, d, k, s, Ti)\
+ t = a + H(b,c,d) + X[k] + Ti;\
+ a = ROTATE_LEFT(t, s) + b
+ /* Do the following 16 operations. */
+ SET(a, b, c, d, 5, 4, T33);
+ SET(d, a, b, c, 8, 11, T34);
+ SET(c, d, a, b, 11, 16, T35);
+ SET(b, c, d, a, 14, 23, T36);
+ SET(a, b, c, d, 1, 4, T37);
+ SET(d, a, b, c, 4, 11, T38);
+ SET(c, d, a, b, 7, 16, T39);
+ SET(b, c, d, a, 10, 23, T40);
+ SET(a, b, c, d, 13, 4, T41);
+ SET(d, a, b, c, 0, 11, T42);
+ SET(c, d, a, b, 3, 16, T43);
+ SET(b, c, d, a, 6, 23, T44);
+ SET(a, b, c, d, 9, 4, T45);
+ SET(d, a, b, c, 12, 11, T46);
+ SET(c, d, a, b, 15, 16, T47);
+ SET(b, c, d, a, 2, 23, T48);
+#undef SET
+
+ /* Round 4. */
+ /* Let [abcd k s t] denote the operation
+ a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s). */
+#define I(x, y, z) ((y) ^ ((x) | ~(z)))
+#define SET(a, b, c, d, k, s, Ti)\
+ t = a + I(b,c,d) + X[k] + Ti;\
+ a = ROTATE_LEFT(t, s) + b
+ /* Do the following 16 operations. */
+ SET(a, b, c, d, 0, 6, T49);
+ SET(d, a, b, c, 7, 10, T50);
+ SET(c, d, a, b, 14, 15, T51);
+ SET(b, c, d, a, 5, 21, T52);
+ SET(a, b, c, d, 12, 6, T53);
+ SET(d, a, b, c, 3, 10, T54);
+ SET(c, d, a, b, 10, 15, T55);
+ SET(b, c, d, a, 1, 21, T56);
+ SET(a, b, c, d, 8, 6, T57);
+ SET(d, a, b, c, 15, 10, T58);
+ SET(c, d, a, b, 6, 15, T59);
+ SET(b, c, d, a, 13, 21, T60);
+ SET(a, b, c, d, 4, 6, T61);
+ SET(d, a, b, c, 11, 10, T62);
+ SET(c, d, a, b, 2, 15, T63);
+ SET(b, c, d, a, 9, 21, T64);
+#undef SET
+
+ /* Then perform the following additions. (That is increment each
+ of the four registers by the value it had before this block
+ was started.) */
+ state->words[0] += a;
+ state->words[1] += b;
+ state->words[2] += c;
+ state->words[3] += d;
+}
+
+/* api */
+
+md5_state * md5_digest_init (md5_state *state)
+{
+ state->bitcount[0] = state->bitcount[1] = 0;
+ state->words[0] = 0x67452301;
+ state->words[1] = /*0xefcdab89*/ T_MASK ^ 0x10325476;
+ state->words[2] = /*0x98badcfe*/ T_MASK ^ 0x67452301;
+ state->words[3] = 0x10325476;
+ return state;
+}
+
+void md5_digest_add (md5_state *state, const void *input, size_t size)
+{
+ const uint8_t *p = (const uint8_t *)input;
+ int nbytes = (int)size; // PJ
+ int left = nbytes;
+ int offset = (state->bitcount[0] >> 3) & 63;
+ uint32_t nbits = (uint32_t)(nbytes << 3);
+
+ if (nbytes <= 0)
+ return;
+
+ /* Update the message length. */
+ state->bitcount[1] += nbytes >> 29;
+ state->bitcount[0] += nbits;
+ if (state->bitcount[0] < nbits)
+ state->bitcount[1]++;
+
+ /* Process an initial partial block. */
+ if (offset) {
+ int copy = (offset + nbytes > 64 ? 64 - offset : nbytes);
+
+ memcpy(state->buffer + offset, p, copy);
+ if (offset + copy < 64)
+ return;
+ p += copy;
+ left -= copy;
+ md5_process(state, state->buffer);
+ }
+
+ /* Process full blocks. */
+ for (; left >= 64; p += 64, left -= 64)
+ md5_process(state, p);
+
+ /* Process a final partial block. */
+ if (left)
+ memcpy(state->buffer, p, left);
+}
+
+#define md5_digest_byte(state, i) (uint8_t)(state->words[i >> 2] >> ((i & 3) << 3))
+
+void md5_digest_get (md5_state *state, uint8_t digest[], int flags)
+{
+ static const uint8_t pad[64] = {
+ 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+ };
+ uint8_t data[8];
+ int i;
+
+ /* Save the length before padding. */
+ for (i = 0; i < 8; ++i)
+ data[i] = (uint8_t)(state->bitcount[i >> 2] >> ((i & 3) << 3));
+ /* Pad to 56 bytes mod 64. */
+ md5_digest_add(state, pad, ((55 - (state->bitcount[0] >> 3)) & 63) + 1);
+ /* Append the length. */
+ md5_digest_add(state, data, 8);
+
+ /* Output */
+ if (flags & MD5_HEX)
+ { // expected digest buffer size MD5_STRING_LENGTH
+ uint8_t byte;
+ const char *alphabet;
+ alphabet = (flags & MD5_LCHEX) ? "0123456789abcdef" : "0123456789ABCDEF";
+ for (i = 0; i < MD5_DIGEST_LENGTH; ++i)
+ {
+ byte = md5_digest_byte(state, i);
+ *digest++ = (uint8_t)alphabet[byte >> 4];
+ *digest++ = (uint8_t)alphabet[byte & 15];
+ }
+ *digest = 0;
+ }
+ else
+ { // expected digest buffer size MD5_DIGEST_LENGTH
+ for (i = 0; i < MD5_DIGEST_LENGTH; ++i)
+ *digest++ = md5_digest_byte(state, i);
+ }
+}
+
+void md5_digest (const void *input, size_t length, uint8_t digest[], int flags)
+{
+ md5_state md5;
+ md5_digest_init(&md5);
+ md5_digest_add(&md5, input, length);
+ md5_digest_get(&md5, digest, flags);
+}
+
+/* file checksum */
+
+#define DIGEST_BUFFER_SIZE 4096
+
+int md5_digest_add_file (md5_state *state, const char *filename)
+{
+ FILE *fh;
+ uint8_t buffer[DIGEST_BUFFER_SIZE];
+ size_t read;
+
+ if ((fh = fopen(filename, "rb")) == NULL)
+ return 0;
+ do {
+ read = fread(buffer, 1, DIGEST_BUFFER_SIZE, fh);
+ md5_digest_add(state, buffer, read);
+ } while (read == DIGEST_BUFFER_SIZE);
+ fclose(fh);
+ return 1;
+}
+
+int md5_digest_file (const char *filename, uint8_t digest[], int flags)
+{
+ md5_state state;
+
+ md5_digest_init(&state);
+ if (md5_digest_add_file(&state, filename))
+ {
+ md5_digest_get(&state, digest, flags);
+ return 1;
+ }
+ return 0;
+} \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmd5.h b/source/luametatex/source/libraries/pplib/util/utilmd5.h
new file mode 100644
index 000000000..3964d59df
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmd5.h
@@ -0,0 +1,49 @@
+
+/* sha2 implementation excerpted from code by Aaron D. Gifford */
+
+#ifndef UTIL_MD5_H
+#define UTIL_MD5_H
+
+#include <stdint.h>
+#include <stddef.h> // for size_t
+#include "utildecl.h"
+
+//#define md5_state md5_state_t
+
+typedef struct {
+ uint32_t bitcount[2];
+ uint32_t words[4];
+ uint8_t buffer[64];
+} md5_state;
+
+#define MD5_DIGEST_LENGTH 16
+#define MD5_STRING_LENGTH (MD5_DIGEST_LENGTH * 2 + 1)
+
+enum {
+ MD5_BYTES = 0,
+ MD5_UCHEX = (1<<0),
+ MD5_LCHEX = (1<<1)
+};
+
+#define MD5_DEFAULT MD5_BYTES
+#define MD5_HEX (MD5_UCHEX|MD5_LCHEX)
+
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+
+UTILAPI md5_state * md5_digest_init (md5_state *state);
+UTILAPI void md5_digest_add (md5_state *state, const void *input, size_t size);
+UTILAPI void md5_digest_get (md5_state *state, uint8_t digest[], int flags);
+
+UTILAPI void md5_digest (const void *input, size_t length, uint8_t digest[], int flags);
+
+UTILAPI int md5_digest_add_file (md5_state *state, const char *filename);
+UTILAPI int md5_digest_file (const char *filename, uint8_t digest[], int flags);
+
+#ifdef __cplusplus
+} /* end extern "C" */
+#endif
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmem.c b/source/luametatex/source/libraries/pplib/util/utilmem.c
new file mode 100644
index 000000000..9a32247ab
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmem.c
@@ -0,0 +1,67 @@
+
+#include <string.h> // for memcpy
+
+#include "utilmem.h"
+#include "utillog.h"
+
+#ifndef util_memerr
+# if defined(_WIN64) || defined(__MINGW32__)
+# define util_memerr(size) { loggerf("ooops, not enough memory (%I64u)", ((unsigned long long)(size))); abort(); }
+# else
+# define util_memerr(size) { loggerf("ooops, not enough memory (%llu)", ((unsigned long long)(size))); abort(); }
+# endif
+#endif
+
+void * util_malloc (size_t size)
+{
+ void *m;
+ if ((m = malloc(size)) == NULL)
+ util_memerr(size);
+ return m;
+}
+
+void * util_calloc (size_t num, size_t size)
+{
+ void *m;
+ if ((m = calloc(num, size)) == NULL)
+ util_memerr(size);
+ return m;
+}
+
+void * util_realloc (void *m, size_t size)
+{
+ if ((m = realloc(m, size)) == NULL)
+ util_memerr(size);
+ return m;
+}
+
+/* common array resizer
+
+data -- the beginning of array
+unit -- sizeof array element
+size -- current array size
+extra -- requested extra size
+space -- pointer to available space
+allocated -- flag indicating if *data has been allocated (with malloc)
+
+*/
+
+void util_resize (void **data, size_t unit, size_t size, size_t extra, size_t *space, int allocated)
+{
+ if (*space == 0)
+ *space = 4; // better keep *space non-zero to avoid it
+ do { *space <<= 1; } while (size + extra > *space);
+
+ if (allocated)
+ {
+ *data = util_realloc(*data, *space * unit);
+ }
+ else
+ {
+ void *newdata = util_malloc(*space * unit);
+ if (*data != NULL)
+ memcpy(newdata, *data, size * unit);
+ *data = newdata;
+ }
+}
+
diff --git a/source/luametatex/source/libraries/pplib/util/utilmem.h b/source/luametatex/source/libraries/pplib/util/utilmem.h
new file mode 100644
index 000000000..4cfcfaba2
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmem.h
@@ -0,0 +1,16 @@
+
+#ifndef UTIL_MEM_H
+#define UTIL_MEM_H
+
+#include <stdlib.h> // for size_t and alloc functions
+#include "utildecl.h"
+
+UTILAPI void * util_malloc (size_t size);
+UTILAPI void * util_calloc (size_t num, size_t size);
+UTILAPI void * util_realloc (void *m, size_t size);
+
+void util_resize (void **data, size_t unit, size_t size, size_t extra, size_t *space, int allocated);
+
+#define util_free free // not a call, might be used as identifier
+
+#endif
diff --git a/source/luametatex/source/libraries/pplib/util/utilmemallc.h b/source/luametatex/source/libraries/pplib/util/utilmemallc.h
new file mode 100644
index 000000000..6d0ed2a06
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmemallc.h
@@ -0,0 +1,569 @@
+/*
+Allocators
+==========
+
+Using allocators defined here makes sense if there is a need to take a space for rather large amount of rather small objects.
+The basic idea is to take memory in reasonably large blocks and to distribute small chunks from those blocks. Once chunks are
+no longer needed, one can free them all at once, or free taken chunks individually.
+
+We define 3 types of allocators:
+
+1. HEAP - the simplest one, provides variable length memory chunks from larger blocks and frees them all on explicit
+ request. There is no way to free individual objects, only the entire heap. The heap only grows, until freed.
+
+2. STOCK - provides variable length memory chunks from larger blocks, but allows to free individual objects as well as the
+ entire stock. The stock grows and shrinks, by leaps and bounds, depending on parameters given during initialization.
+
+3. POOL - provides fixed size memory chunks from larger blocks. It allows to free individual chunks as well as the entire pool.
+ In opposite to a stock, a pool also reuses a space reclaimed by freeing individual objects; before allocating a new block it
+ firsts recycles freed chunks, if any.
+
+In general, memory chunks provided by allocators are never reallocated. Allocators do nothing with provided chunks until freed.
+
+Allocators are represented as small structures (several pointers and integers). We assume that such structures are either static
+variables, or members of larger structures. We don't bother to allocate a memory for them. Usage scheme is pretty similar for
+all:
+
+ init() - just inititalize, don't allocate anything yet
+ take() - take chunks
+ take()
+ take()
+ ...
+ free() - free the all at once
+
+For stocks and pools there is a possibility to give back individual chunks:
+
+ init() - like above
+ take() - take chunks
+ take()
+ take()
+ back() - give chunks back when no longer needed
+ take()
+ back()
+ ...
+ free() - needed only if not all chunks have been given back
+
+All calls take a shell structure pointer as an argument. take() returns a void pointer, aligned according to used variant
+(8, 16, 32, 64). back() takes a void pointer as the second argument. It must be the pointer previously returned by take().
+
+back() can be called in any order and can obviously be plotted with take(). By default, after back()-ing all taken chunks, the
+stock returns to its initial state (zero memory used). A special KEEP flag can be used during initialization to prevent
+freeing the last (sole) allocated block. If KEEP option is used, the allocator always keeps a single segment for further
+allocations. This is necessary only when there is a risk that just several take() calls will be immediatelly followed by the
+same number of back() calls. KEEP flag prevents allocating and freeing rather large blocks just to serve several chunks. And
+this is actually important only if there are no other blocks taken, that is, if there is only one, nearly empty block in use.
+In other cases KEEP flag doesn't matter, but allocators takes care to always have a block for fast allocs.
+
+There is also clear() operation that frees all but the recent block. One can use it to free all chunks taken so far, but to
+make the allocator ready for further allocs. If either KEEP flag is used or clear() is called, soner or later the user have to
+call free() explicitly, to remove all the remaining memory kept by the allocator. There is no KEEP flag for heaps, as heaps
+don't allow to free individual chunks. And so, the heap never needs to make a decision if the last sole block should be removed
+or not. The user makes the decision by calling clear() vs free() respectively.
+
+Pop
+===
+
+A very last chunk taken can be quickly given back with
+
+ pop(heap, taken, size) // for heap or stock
+ pop(pool, taken) // for pool
+
+taken must be the chunk returned by the very last take(), size must be the size requested. If the chunk has been taken from
+the head block (more about blocks below), the block pointer returns to its previous position, as it was before the last take().
+If the chunk has been taken from the sole block beneatch the head, the entire sole block (containing just that single chunk)
+is freed. The pop() operation is different than back(); the popped chunk doesn't cause freeing the head block when its refcount
+gets zero. So pop() operation breaks the concept of stock that frees all the memory once all taken chunks are given back.
+on the other hand, if for some reason the very last taken chunk is to be ignored, pop() is better, as it doesn't cause blocks
+scattering. The popped chunk pointer will probably be returned by the very next call to take(). In case of heap, pop() is
+the only way to discard the chunk, as there is no back() operation.
+
+Buffer interface
+================
+
+When heap or stock is used by parsers, the caller oftenly doesn't know how many space will be needed for a data (this doesn't
+apply to pools, which returns constant size memory chunks). Here is an interface for the allocator-as-bufer case (same for
+heap and stock):
+
+ some(heap, atleast, &space);
+ ...
+ atleast <<= 1;
+ more(heap, taken, written, atleast, &space);
+ ...
+ done(heap, taken, written);
+
+some() operation provides a data pointer to at least a given bytes. The actual space provided for writing is set to the third
+argument. The caller may write space-bytes. If more space is needed, more() operation takes care to provide a chunk for a given
+amount of bytes and rewrites already written amount of bytes from a previous chunk to a new location. Same as with() some, the
+requests for atleast bytes, and the actual provided chunk size is given as space (space >= atleast).
+
+The function takes the pointer to the chunk previously taken; the one returned by some() or more(). This argument must not be NULL.
+If you don't want to copy a data, set written argument to zero. No matter if more() operation was used zero, one or multiple times,
+all the cycle must end with done(). Calls triple - some(), more() and done() - must not be interrupted by any other api calls.
+In particular, using take() or back() smells like a segfault. However, if there is a need discard the buffer being written
+(eg. input data error), instead of done() one may use
+
+ giveup(heap, taken)
+
+If done() has already been called, pop() is the only option to discard the chunk
+
+ pop(heap, taken, written)
+
+some() operation usually doesn't change the state of the heap, unless the heap head block is NULL, or atleast parameter is too
+large to fit the remaining block. more() usually changes the state, either by allocating a new head block, or by allocating
+a sole block just beneath the head (blocks and blocks tiling mechanism are described below). If a sole block has been taken for
+some large chunk subsequent calls to more() reallocate this sole block in place. It is assumed, that the size you request in subsequent
+calls generally grows. It is ok to request space-bytes, then call done() with written value less then requested. But the drawback
+is that if the chunk has already been allocated from a sole chunk, the space requested but not used is a waste.
+
+iof interface
+=============
+
+iof is an independent interface for buffers written/read byte-by-byte. When used together with allocators, it provides
+a convenient way to write byte data to the heap or stock, without a need for intermediate buffers. The buffer is setup with
+
+ iof output, *O
+ O = buffer_init(heap, &output); // doesn't allocate anything
+
+or
+
+ output = BUFFER_INIT(heap); // doesn't allocate anything
+ O = &output;
+
+iof keeps pointers to the beginning of the buffer, end of buffer, and current position. Once the position reaches the end,
+the iof internal handler updates the buffer providing more space to write. When used in conjunction with heap or stock,
+the space to write is the space provided by the heap or stock. To start the buffer session:
+
+ O = buffer_some(heap, O, atleast) // ensure iof *O to have atleast bytes to be written
+
+Once you are done with writing some chunk
+
+ buffer_done(heap, O)
+
+instead of buffer_done(), one may also use
+
+ iof_flush(O) // calls buffer_done() and buffer_some() again
+
+which updates the underlying heap or stock, and makes the iof ready for a new chunk. iof itself does not allocate a memory,
+so it doesn't need finalizer. iof_close(output) does nothing. To drop the buffer use:
+
+ buffer_giveup(heap, O) // restore the from before buffer_some()
+
+More often then not, we need to specify a minimal space for buffer each time, eg. for memcpy() or so. The actual space left
+can be checked with iof_left(O). The entire space of recent chunk is O->space (eq. O->end - O->buf).
+
+Identical interface for heap and stock.
+
+Blocks
+======
+
+Each alloctor structure keeps a pointer to a head block, initially NULL. Most of new chunks are taken from the head. Once the
+space left in the head block is to small to provide a chunk of requested size, a new head is created and the previous one is
+linked to the head (blocks form a linked list). A stock block is named a ream, a heap block is named a pyre, a pool block is
+named pile (we need to distinguish structure names in code but in the description below they are all called blocks). Every
+block knows a number of chunks taken from that block (refcont). A stock also keeps a number of freed chunks [actually only
+for statistics; in most cases it doesn't need an extra space in struct ream, as thies structure member lays in the place
+f padding bytes.]
+
+We change the head block only if the new block is allocated, but we never change the head backward. Once some block became
+->prev, it will never became a head again. This ensures that the allocator have the head block that usually has a lot of space
+for new allocs. This needs a special care when removing a block that is not a head block. We check if the next block to the one
+being removed is the head. If it is, and if its refcount is zero (and no KEEP flag is used) the head is removed as well.
+
+The basis of pools is similar to stocks and heaps, but there are some significant differences. A pool servers memory chunks of
+equal size, specified during initialization. This also means that the pool knows the boundaries of individual chunks (stock and
+heap doesn't). A pool provides iterators over chunks in use (taken but not given back yet). A pool shell structure keeps
+a pointer to a head block and a tail block (both may point a different block, the same block or NULL). This is necessary only
+for iterators to let the user follow the chunks from the first or from the last taken. The extra cost of maintaining both
+->head and ->tail is neglectable.
+
+Refcounting
+===========
+
+Heap refcounting: whenever a new chunk is taken, the block refcount is incremented. It is never decremented, but plays an
+important role in block tiling algorithm (below). No KEEP flag is used here. All the blocks are removed on free(), all but
+recent are removed on clear().
+
+Stock refcounting: whenever a new chunk in taken from the block, the block refcount is incremented. Whenever the chunk is given
+back, the refcount is decremented. When the refcount gets zero, the block is removed and freed. To remove the block from the
+list (any block, not necessarily a head block), a stock needs 2-directional list; every block has ->next and ->prev links. The
+head block of the stock is freed only if this is the last (sole) block and no KEEP flag was used during initialization.
+Otherwise the block is just reset, becoming ready for further allocations - refcount gets zero, data space reset to an initial
+state.
+
+Pool refcounting: pretty much like with stocks, except that any chunk given back can be recycled on further take().
+
+Ghosts
+======
+
+Every allocated block starts with a private structure for next/prev links, data pointer, refcount. We call it a block ghost.
+Except from heap, individual chunks also need a ghost (chunk ghost) so that we are able to know from which block the chunk
+comes from once the chunk is given back by the user (heaps don't have back() operation so data chunks have no ghosts). We keep
+ghosts possibly small. Chunk ghosts are of size natural for alignment variant (1, 2, 4 or 8 bytes). Block ghosts are somewhat
+larger. Statistics show clearly that it is worthy to keep them as small as possible:
+- chunk ghosts keep offset to the block ghost, not a pointer to it (we use the pointer only if it makes no difference
+ to the chunk size; 64-bit aligned variant on 64-bit machine, 32 and 64 variants on 32-bit machine)
+- block ghosts uses a data pointer (not an offset) so that we are able to record any requested chunk size (size_t) and to avoid
+ long array indexing on every chunk request
+
+At some point we considered storing a sheel structure pointer in the block ghost, then back() operation wouldn't need an extra
+argument. But stats showed that the size of the block ghost is the most significant factor in memory usage efficiency, so eliminating
+this extra pointer pays off. Besides, this would make impossible to relocate the shell structure. We don't allocate a memory
+for the shell, so we shouldn't make assumptions of shell structure address.
+
+Tiling algorithm
+================
+
+Tiling the block size refers to stocks and heaps that serves memory chunks of variable size. Both stock and heap performs best
+when the average size of requested chunks is a way smaller that the configured block size. But both also put no limitations on
+chunk sizes, so they need to cope with situation, where the requested size is quite large, eg. half of the block size or even
+more than the block size. Here is the algorithm used for blocks tiling:
+
+1. When the requested chunk size fills in the recent block, just serve it from that block. This is the best and hopefully the
+ most common case.
+
+2. When the requested chunk size is larger that the space left in the recent block, the new block must be allocated. But there
+are two ways:
+
+ a) either replace the head block with the new block so that the list of blocks is
+
+ ... <- prev <- head so far <- new head
+
+ b) or insert the block just "below the head", keeping the head intact,
+
+ ... <- prev <- new single head <- head
+
+The first is the regular case. It is used when the space left in the head so far is small (can be neglected), and the requested
+size is relatively small (will fit the new block). If the space left in the head block is worthy to bother, or the requested
+chunk size is rather large, the new chunk is served from a single block, allocated just for that chunk. The block is of the
+size needed for that chunk. The block never becomes the head, no other chunks will be served from it (its refcount is
+permanently 1, until freed).
+
+Much depends on what is considered 'small, neglectable block space' and 'rather large chunk size'. The later is easier to
+imagine. When the requested size is larger than the block size used for a given allocator, then the size is definitelly
+considered large. When it is smaller than the block size, but still large enough to occupy most of the block size (grabbing
+quite some space for tiny chunks), it is also considered large. As the block size, what is considered 'large' can be spcified
+during initialization. A setup that works fine for me is (large = block_size / 2).
+
+Making a decision what is the left block space we can neglect is quite not obvious. At first approach we used a constant value,
+requested from the user during allocator initialization. But it is hard to select a good default. Now we compute this value
+from block params, by dividing a complete space occupied so far in the block by the number of chunks served from that block
+(the average size of chunks allocated from this block). We assume that the average chunk size (or smaller) is the space we can
+neglect. The logic behind is the following: if the space left in the block is larger than the average, it makes sense not to
+waste this space and keep it for further allocs. If the space left in the block is less than the average, there is only a little
+chance we will get a request for suitable size, so we sacrifice that space and we start allocating from a new block.
+
+Statistics showed a caveat in average == treshold approach. Suppose we have a block that has the average chunk size 16, there
+is 18 bytes left in the block (not neglectable), and the user request is 20 bytes. Allocating a single block for 20 bytes is
+bad, because the block ghost is 24 bytes (more internal than allocated memory). Allocating many of such blocks gives bad results;
+much more allocs than necessary, large waste. To avoid that, we help to neglect the remaining block space by checking if the
+space left is smaller than the block ghost size, which is an inevitable cost anyway.
+
+Stats below shows clearly that we should rather focus on "how to avoid producing sole-chunk blocks" instead of "how to feel the
+remaining space".
+
+Recycling
+=========
+
+Recycling applies only to pools. When a chunk is given back, it is inserted into a list of items for recycling. Every pool
+block keeps a head of that list. Once a chunk is given back, it is inserted as recycling head and the previous head is attached
+to a new head. Since every chunk is associated with a ghost, we use ghosts to store a link (pointer or offset) to another item
+for recycling. Note that the ghost always keeps either a link to the block it belongs to, or a link to another recyclable ghost
+of the same block. This is used by iteratos to distinguish the chunk currently in use from the chunk that has already been
+given back; if the link points the block, the chunk is in use.
+
+A pool block that has at least one recyclable chunk is called a squot. A pool shell structure keeps 2-directional list of
+squots. Once a pool block becomes a squot, it is inserted to that list. Once its all recyclable items has been used, it is
+removed from the squots list. In every moment, the pool has an access to a list of all squots, and therefore, to a list of all
+recyclable items.
+
+Whenever there is a request for a new chunk, at first it is served from the head block, as this is the easiest and the cheapest way.
+Once the recent block has no more place for new items, recycling list is used, starting from the head recyclable chunk of the head squot.
+In practise this is always the most recently reclaimed chunk ghost. During further allocs, a pool will first utilize all recyclables
+from all squots before allocating a new block.
+
+Stats
+=====
+
+Some numbers. The test made on a stock8, block size 255 bytes, 10000 allocations, random chunk sizes from 1 to 32 bytes
+(average 16). These are rather tight constraints because of 255 buffer limit. First approach:
+
+ blocks: 903 - this is the actual number of malloc() calls
+ singles: 214, 23.70% of all blocks
+ waste: 20.16% - total memory that was allocated but not requested by the user
+ block ghosts 10.04%, plus single block ghosts 3.12%
+ chunk ghosts 4.55%
+ neglected block tails 2.45%
+
+After adding a test for left space that helps in 'neglect remainig space or make sole chunk block' decision:
+
+ blocks: 723 - a way better
+ singles 0
+ waste: 19.04% - slightly better
+ block ghosts 10.67%
+ chunk ghosts 4.61%
+ neglected block tails 3.76%
+
+The actual numbers vary depending on the buffer size, the average elements size and, of course, taken alignment variant. After
+some parameters tuning, on various tests we get 5-19% total waste for stocks, 3-14% total waste for heaps. But the basic scheme
+of statistics remains similar: we take relatively lots of space for blocks ghost (5-10% of total memory taken), some inevitable
+space for chunk ghosts (varies, 4-13% on various tests), and a little waste of neglected block tails (2-4%). Quite
+surprisingly, block ghosts are, in sum, oftenly more significant than individual chunk ghosts (for the test above over half of
+all the waste!). The number of block ghosts (equals the number of blocks) mostly depends on block size vs chunk size relation.
+But seemingly it is worthy to bother about the size of the block ghost and the number of blocks taken - the less the better.
+The waste of ghosts of individual objects (stock and pool) is inevitable, and depends only on the number/size of objects taken.
+We can't use smaller ghosts, we can't do better. Anyways, the least significant is the waste of neglected block tails.
+
+Pools stats are pretty similar, but more predictable because of known chunks size. A pool block ghost is somewhat larger
+structure because it keeps ->nextsquot / ->prevsquot pointers among ->next / ->prev. On the other hand, it doesn't need
+->unused counter, as for fixed-length chunks it can always be computed from the refcount and used data. Also somewhat larger
+block ghost structure is compensated by the fact that the are no tail block waste and there is no 'neglect or not' problem.
+
+Alignment
+=========
+
+Each allocator has 4 variants for 1, 2, 4, 8 bytes alignment respectively. Eg. stock32_take() always returns a pointer aligned
+to 4 bytes, heap64_take() returns a pointer aligned to 8 bytes. You can ask for any data length, but in practise you'll always
+obtain 1N, 2N, 4N or 8N. Alignment implies data padding unless the user requests for "aligned" sizes. In statistics the padding
+is not considered a waste.
+
+Zeroing
+=======
+
+All heap, stock and pool may return zeroed memory chunks, depending on initial flags:
+
+ HEAP_ZERO
+ STOCK_ZERO
+ POOL_ZERO
+
+There are also take0() variants that simply return memset(take(), 0, size), regardless the flag.
+*/
+
+#ifndef UTIL_MEM_ALLC_C
+#define UTIL_MEM_ALLC_C
+
+/*
+Common internals for allocators suite. A selection or all of the following defines (from api headers) should already be there:
+
+ UTIL_MEM_HEAP_H // utilmemheap.h
+ UTIL_MEM_STOCK_H // utilmemstock.h
+ UTIL_MEM_POOL_H // utilmempool.h
+
+*/
+
+#include <string.h> // memset()
+#include <stdio.h> // printf()
+
+#include "utilmem.h"
+
+//#if defined(DEBUG) && debug != 0
+#if 1
+# define ASSERT8(cond) ((void)((cond) || (printf("8bit allocator assertion, %s:%d: %s\n", __FILE__, __LINE__, #cond), 0)))
+# define ASSERT16(cond) ((void)((cond) || (printf("16bit allocator assertion, %s:%d: %s\n", __FILE__, __LINE__, #cond), 0)))
+# define ASSERT32(cond) ((void)((cond) || (printf("32bit allocator assertion, %s:%d: %s\n", __FILE__, __LINE__, #cond), 0)))
+# define ASSERT64(cond) ((void)((cond) || (printf("64bit allocator assertion, %s:%d: %s\n", __FILE__, __LINE__, #cond), 0)))
+#else
+# define ASSERT8(cond) (void)0
+# define ASSERT16(cond) (void)0
+# define ASSERT32(cond) (void)0
+# define ASSERT64(cond) (void)0
+#endif
+
+#if defined(UTIL_MEM_STOCK_H) || defined(UTIL_MEM_POOL_H)
+struct ghost8{
+ uint8_t offset;
+};
+
+struct ghost16 {
+ uint16_t offset;
+};
+
+#ifdef BIT32
+struct ghost32 {
+ union {
+#ifdef UTIL_MEM_STOCK_H
+ ream32 *ream;
+#endif
+#ifdef UTIL_MEM_POOL_H
+ pile32 *pile;
+ ghost32 *nextfree;
+#endif
+ void *block;
+ };
+};
+#else
+struct ghost32 {
+ uint32_t offset;
+};
+#endif
+
+struct ghost64 {
+ union {
+#ifdef UTIL_MEM_STOCK_H
+ ream64 *ream;
+#endif
+#ifdef UTIL_MEM_POOL_H
+ pile64 *pile;
+ ghost64 *nextfree;
+#endif
+ void *block;
+ };
+#ifdef BIT32
+ uint8_t dummy[4]; // force 8
+#endif
+};
+#endif
+
+/*
+All offsets related macro horror is here. Block is 4/8-bytes aligned (32/64 pointer size), ream->data is adjusted to 1/2/4/8-bytes accordingly.
+Therefore all offsets we store and pointers we cast, should be properly aligned. In all cases, sizes and offsets refers to bytes.
+We need data ghosts only to access the block. For 8 and 16 we use 8/16 bit offsets to keep the ghost smaller. For 32 and 64 we either use offset,
+or a pointer to the ream.
+
+malloc() is obviously expected to return a pointer properly allowed for all standard c-types. For 64-bit we can safely expect at least 8-bytes aligned.
+(at least, because long double may need 16 bytes on gcc64, or 8 bytes on msvc64, or weird on some exotics). On 32 bit machines pointers are 4 bytes
+aligned, even long long is 4-bytes aligned. But double on 32bit machine is 8-bytes aligned on windows, 4 bytes aligned in linux (compiler option
+-malign-double makes it 8-bytes aligned). Anyways, we cannot expect that on 32bit machine the result of malloc is always 8-bytes aligned.
+This requires a very special treatment of 64-variant on 32bit machine: the first data ghost may need to be 4-bytes off. Should we ensure 4 bytes
+more from malloc just in case? Hmm padding will be there anyway, as we adjust ream->data size to bytes boundaries.
+
+In both 32/64bit environments, the ghost keeps a pointer to the block. On 32bit machine, the first chunk ghost address may need to be +4,
+as this is not ensured by malloc(). See struct ream64 {}. We have an extra test; the final ghost pointer will be properly aligned iff
+
+ ((block & 7 == 0) && (sizeof(block64) & 7 == 0)) || ((block & 7 == 4) && (sizeof(block64) & 7 == 4)
+
+or in short
+
+ ((block + 1) & 7) == 0
+
+otherwise it needs 4 bytes offset.
+*/
+
+#define pointer_tointeger(p) ((size_t)(p)) // & not allowed on pointer
+
+#define pointer_aligned32(p) ((pointer_tointeger(p) & 3) == 0)
+#define pointer_aligned64(p) ((pointer_tointeger(p) & 7) == 0)
+
+#define void_data(data) ((void *)(data))
+#define byte_data(data) ((uint8_t *)(data))
+
+/* top of the block ghost */
+
+#define block_top(block) (byte_data(block + 1))
+
+/* where the data begins */
+
+#define block_edge8(block) block_top(block)
+#define block_edge16(block) block_top(block)
+#define block_edge32(block) block_top(block)
+
+#ifdef BIT32
+# define ALIGN64ON32(block) (pointer_aligned64(block + 1) ? 0 : 4)
+# define block_edge64(block) (block_top(block) + ALIGN64ON32(block))
+#else
+# define block_edge64(block) block_top(block)
+#endif
+
+#define block_left8(block, size) (size)
+#define block_left16(block, size) (size)
+#define block_left32(block, size) (size)
+#ifdef BIT32
+# define block_left64(block, size) (size - ALIGN64ON32(block))
+#else
+# define block_left64(block, size) (size)
+#endif
+
+/* consumed block space; it is important to use edge() macros that involves ALIGN64ON32() */
+
+#define block_used8(block) (block->data - block_edge8(block))
+#define block_used16(block) (block->data - block_edge16(block))
+#define block_used32(block) (block->data - block_edge32(block))
+#define block_used64(block) (block->data - block_edge64(block))
+
+/* align requested size to keep ream->data / pyre->data always aligned. size is always size_t, no insane overflow checks */
+
+#define align_size8(size) ((void)size)
+#define align_size16(size) (size = aligned_size16(size))
+#define align_size32(size) (size = aligned_size32(size))
+#define align_size64(size) (size = aligned_size64(size))
+
+/*
+done() and pop() operations decrements block->left space by an aligned size; block->left -= alignedwritten. Lets have 8-bytes aligned
+variant block. If we tell the user there is 15 bytes left (block->left == 15) and the user taked 12. Aligned is 16, we cannot substract.
+We could eventually set block->left to 0, but then pop() operation would no be allowed. Hance, block->left must be aligned. The procedure
+is different than for size (size_t), we cannot cross 0xff/0xffff,... bondaries.
+*/
+
+#define align_space8(space) ((void)space)
+#define align_space16(space) (space = aligned_space16(space))
+#define align_space32(space) (space = aligned_space32(space))
+#define align_space64(space) (space = aligned_space64(space))
+
+/* handling ghost structure (stock and pool) */
+
+#if defined(UTIL_MEM_STOCK_H) || defined(UTIL_MEM_POOL_H)
+
+/* ghost offset from block top; not from bottom because we must not exceed offset limit */
+
+#define ghost_offset(block, ghost) (byte_data(ghost) - block_top(block))
+
+/* ghost <-> data */
+
+#define ghost_data(ghost) ((void *)(ghost + 1))
+
+/* cast from data to ghost structure goes via (void *) to shut up warnigns, alignment ok */
+
+#define data_ghost8(data) (((ghost8 *)void_data(data)) - 1)
+#define data_ghost16(data) (((ghost16 *)void_data(data)) - 1)
+#define data_ghost32(data) (((ghost32 *)void_data(data)) - 1)
+#define data_ghost64(data) (((ghost64 *)void_data(data)) - 1)
+
+/* ghost <-> block */
+
+#define ghost_block8(ghost, block8) ((block8 *)void_data(byte_data(ghost) - ghost->offset - sizeof(block8)))
+#define ghost_block16(ghost, block16) ((block16 *)void_data(byte_data(ghost) - ghost->offset - sizeof(block16)))
+#ifdef BIT32
+# define ghost_block32(ghost, block32) (ghost->block)
+#else
+# define ghost_block32(ghost, block32) ((block32 *)void_data(byte_data(ghost) - ghost->offset - sizeof(block32)))
+#endif
+#define ghost_block64(ghost, block64) (ghost->block)
+
+/* ghost init */
+
+#define ghost_next8(block, ghost) ((ghost = block->dataghost), (ghost->offset = (uint8_t)ghost_offset(block, ghost)))
+#define ghost_next16(block, ghost) ((ghost = block->dataghost), (ghost->offset = (uint16_t)ghost_offset(block, ghost)))
+#ifdef BIT32
+# define ghost_next32(bl0ck, ghost) ((ghost = bl0ck->dataghost), (ghost->block = bl0ck))
+#else
+# define ghost_next32(block, ghost) ((ghost = block->dataghost), (ghost->offset = (uint32_t)ghost_offset(block, ghost)))
+#endif
+#define ghost_next64(bl0ck, ghost) ((ghost = bl0ck->dataghost), (ghost->block = bl0ck))
+
+#endif
+
+/* average block chunk size */
+
+#define average_block_chunk8(ream) (block_used8(ream) / ream->chunks)
+#define average_block_chunk16(ream) (block_used16(ream) / ream->chunks)
+#define average_block_chunk32(ream) (block_used32(ream) / ream->chunks)
+#define average_block_chunk64(ream) (block_used64(ream) / ream->chunks)
+
+/*
+neglect remaining block tail and start a new block or create a single block; a test for (block->chunks > 0) is a sanity;
+if block->chunks is zero (block has a full space left), we shouldn't get there, except when alloc->large is larger then alloc->space
+*/
+
+#define take_new_block8(alloc, ghoststruct, block, size) \
+ ((size < alloc->large) && (block->left <= sizeof(ghoststruct) || (block->chunks > 0 && block->left <= average_block_chunk8(block))))
+#define take_new_block16(alloc, ghoststruct, block, size) \
+ ((size < alloc->large) && (block->left <= sizeof(ghoststruct) || (block->chunks > 0 && block->left <= average_block_chunk16(block))))
+#define take_new_block32(alloc, ghoststruct, block, size) \
+ ((size < alloc->large) && (block->left <= sizeof(ghoststruct) || (block->chunks > 0 && block->left <= average_block_chunk32(block))))
+#define take_new_block64(alloc, ghoststruct, block, size) \
+ ((size < alloc->large) && (block->left <= sizeof(ghoststruct) || (block->chunks > 0 && block->left <= average_block_chunk64(block))))
+
+/* empty */
+
+#define head_block_empty(alloc, block) (((block = alloc->head) == NULL) || (block->chunks == 0 && block->prev == NULL))
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmemallh.h b/source/luametatex/source/libraries/pplib/util/utilmemallh.h
new file mode 100644
index 000000000..a543d1acb
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmemallh.h
@@ -0,0 +1,36 @@
+
+#ifndef UTIL_MEM_ALLH_H
+#define UTIL_MEM_ALLH_H
+
+#include <stddef.h> // size_t
+#include <stdint.h>
+
+#include "utildecl.h"
+
+typedef struct ghost8 ghost8;
+typedef struct ghost16 ghost16;
+typedef struct ghost32 ghost32;
+typedef struct ghost64 ghost64;
+
+#define aligned_size8(size) (size)
+#define aligned_size16(size) ((((size) + 1) >> 1) << 1)
+#define aligned_size32(size) ((((size) + 3) >> 2) << 2)
+#define aligned_size64(size) ((((size) + 7) >> 3) << 3)
+
+#define aligned_space8(size) (size)
+#define aligned_space16(size) (((size) & 1) ? ((size) < 0xFFFF ? ((size) + 1) : ((size) - 1)) : (size))
+#define aligned_space32(size) (((size) & 3) ? ((size) < 0xFFFFFFFD ? ((size) - ((size) & 3) + 4) : (size) - ((size) & 3)) : (size))
+#define aligned_space64(size) (((size) & 7) ? ((size) < 0xFFFFFFFFFFFFFFF8ULL ? ((size) - ((size) & 7) + 8) : (size) - ((size) & 7)) : (size))
+
+/* info stub */
+
+typedef struct {
+ size_t blocks, singles;
+ size_t chunks, unused;
+ size_t used, singleused, left;
+ size_t ghosts, blockghosts, singleghosts;
+} mem_info;
+
+#define MEM_INFO_INIT() = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmemheap.c b/source/luametatex/source/libraries/pplib/util/utilmemheap.c
new file mode 100644
index 000000000..f4a6b8814
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmemheap.c
@@ -0,0 +1,1078 @@
+
+#include "utilmemheap.h"
+#include "utilmemallc.h"
+
+#define pyre_alloc8(heap, space) ((pyre8 *)((heap->flags & HEAP_ZERO) ? util_calloc(1, sizeof(pyre8) + space * sizeof(uint8_t)) : util_malloc(sizeof(pyre8) + space * sizeof(uint8_t))))
+#define pyre_alloc16(heap, space) ((pyre16 *)((heap->flags & HEAP_ZERO) ? util_calloc(1, sizeof(pyre16) + space * sizeof(uint8_t)) : util_malloc(sizeof(pyre16) + space * sizeof(uint8_t))))
+#define pyre_alloc32(heap, space) ((pyre32 *)((heap->flags & HEAP_ZERO) ? util_calloc(1, sizeof(pyre32) + space * sizeof(uint8_t)) : util_malloc(sizeof(pyre32) + space * sizeof(uint8_t))))
+#define pyre_alloc64(heap, space) ((pyre64 *)((heap->flags & HEAP_ZERO) ? util_calloc(1, sizeof(pyre64) + space * sizeof(uint8_t)) : util_malloc(sizeof(pyre64) + space * sizeof(uint8_t))))
+
+#define pyre_free(pyre) util_free(pyre)
+
+/* block reset */
+
+#define reset_heap_head8(heap, pyre, used) \
+ ((used = block_used8(pyre)), (pyre->data -= used), ((heap->flags & HEAP_ZERO) ? (memset(pyre->data, 0, used), 0) : 0), (pyre->left += (uint8_t)used))
+#define reset_heap_head16(heap, pyre, used) \
+ ((used = block_used16(pyre)), (pyre->data -= used), ((heap->flags & HEAP_ZERO) ? (memset(pyre->data, 0, used), 0) : 0), (pyre->left += (uint16_t)used))
+#define reset_heap_head32(heap, pyre, used) \
+ ((used = block_used32(pyre)), (pyre->data -= used), ((heap->flags & HEAP_ZERO) ? (memset(pyre->data, 0, used), 0) : 0), (pyre->left += (uint32_t)used))
+#define reset_heap_head64(heap, pyre, used) \
+ ((used = block_used64(pyre)), (pyre->data -= used), ((heap->flags & HEAP_ZERO) ? (memset(pyre->data, 0, used), 0) : 0), (pyre->left += (uint64_t)used))
+
+/* init heap */
+
+heap8 * heap8_init (heap8 *heap, uint8_t space, uint8_t large, uint8_t flags)
+{
+ align_space8(space);
+ if (large > space) large = space;
+ heap->head = NULL;
+ heap->space = space;
+ heap->large = large;
+ heap->flags = flags;
+ return heap;
+}
+
+heap16 * heap16_init (heap16 *heap, uint16_t space, uint16_t large, uint8_t flags)
+{
+ align_space16(space);
+ if (large > space) large = space;
+ heap->head = NULL;
+ heap->space = space;
+ heap->large = large;
+ heap->flags = flags;
+ return heap;
+}
+
+heap32 * heap32_init (heap32 *heap, uint32_t space, uint32_t large, uint8_t flags)
+{
+ align_space32(space);
+ if (large > space) large = space;
+ heap->head = NULL;
+ heap->space = space;
+ heap->large = large;
+ heap->flags = flags;
+ return heap;
+}
+
+heap64 * heap64_init (heap64 *heap, uint64_t space, uint64_t large, uint8_t flags)
+{
+ align_space64(space);
+ if (large > space) large = space;
+ heap->head = NULL;
+ heap->space = space;
+ heap->large = large;
+ heap->flags = flags;
+ return heap;
+}
+
+/* free heap */
+
+void heap8_free (heap8 *heap)
+{
+ pyre8 *pyre, *prev;
+ pyre = heap->head;
+ heap->head = NULL;
+ while (pyre != NULL)
+ {
+ prev = pyre->prev;
+ pyre_free(pyre);
+ pyre = prev;
+ }
+}
+
+void heap16_free (heap16 *heap)
+{
+ pyre16 *pyre, *prev;
+ pyre = heap->head;
+ heap->head = NULL;
+ while (pyre != NULL)
+ {
+ prev = pyre->prev;
+ pyre_free(pyre);
+ pyre = prev;
+ }
+}
+
+void heap32_free (heap32 *heap)
+{
+ pyre32 *pyre, *prev;
+ pyre = heap->head;
+ heap->head = NULL;
+ while (pyre != NULL)
+ {
+ prev = pyre->prev;
+ pyre_free(pyre);
+ pyre = prev;
+ }
+}
+
+void heap64_free (heap64 *heap)
+{
+ pyre64 *pyre, *prev;
+ pyre = heap->head;
+ heap->head = NULL;
+ while (pyre != NULL)
+ {
+ prev = pyre->prev;
+ pyre_free(pyre);
+ pyre = prev;
+ }
+}
+
+/* clear heap */
+
+void heap8_clear (heap8 *heap)
+{
+ pyre8 *pyre, *prev;
+ size_t used;
+ if ((pyre = heap->head) == NULL)
+ return;
+ prev = pyre->prev;
+ pyre->prev = NULL;
+ reset_heap_head8(heap, pyre, used);
+ for (; prev != NULL; prev = pyre)
+ {
+ pyre = prev->prev;
+ pyre_free(prev);
+ }
+}
+
+void heap16_clear (heap16 *heap)
+{
+ pyre16 *pyre, *prev;
+ size_t used;
+ if ((pyre = heap->head) == NULL)
+ return;
+ prev = pyre->prev;
+ pyre->prev = NULL;
+ reset_heap_head16(heap, pyre, used);
+ for (; prev != NULL; prev = pyre)
+ {
+ pyre = prev->prev;
+ pyre_free(prev);
+ }
+}
+
+void heap32_clear (heap32 *heap)
+{
+ pyre32 *pyre, *prev;
+ size_t used;
+ if ((pyre = heap->head) == NULL)
+ return;
+ prev = pyre->prev;
+ pyre->prev = NULL;
+ reset_heap_head32(heap, pyre, used);
+ for (; prev != NULL; prev = pyre)
+ {
+ pyre = prev->prev;
+ pyre_free(prev);
+ }
+}
+
+void heap64_clear (heap64 *heap)
+{
+ pyre64 *pyre, *prev;
+ size_t used;
+ if ((pyre = heap->head) == NULL)
+ return;
+ prev = pyre->prev;
+ pyre->prev = NULL;
+ reset_heap_head64(heap, pyre, used);
+ for (; prev != NULL; prev = pyre)
+ {
+ pyre = prev->prev;
+ pyre_free(prev);
+ }
+}
+
+/* heap head */
+
+void heap8_head (heap8 *heap)
+{
+ pyre8 *pyre;
+ heap->head = pyre = pyre_alloc8(heap, heap->space);
+ pyre->prev = NULL;
+ pyre->data = block_edge8(pyre);
+ pyre->left = block_left8(pyre, heap->space);
+ pyre->chunks = 0;
+}
+
+void heap16_head (heap16 *heap)
+{
+ pyre16 *pyre;
+ heap->head = pyre = pyre_alloc16(heap, heap->space);
+ pyre->prev = NULL;
+ pyre->data = block_edge16(pyre);
+ pyre->left = block_left16(pyre, heap->space);
+ pyre->chunks = 0;
+}
+
+void heap32_head (heap32 *heap)
+{
+ pyre32 *pyre;
+ heap->head = pyre = pyre_alloc32(heap, heap->space);
+ pyre->prev = NULL;
+ pyre->data = block_edge32(pyre);
+ pyre->left = block_left32(pyre, heap->space);
+ pyre->chunks = 0;
+}
+
+void heap64_head (heap64 *heap)
+{
+ pyre64 *pyre;
+ heap->head = pyre = pyre_alloc64(heap, heap->space);
+ pyre->prev = NULL;
+ pyre->data = block_edge64(pyre);
+ pyre->left = block_left64(pyre, heap->space);
+ pyre->chunks = 0;
+}
+
+/* next heap head */
+
+static pyre8 * heap8_new (heap8 *heap)
+{
+ pyre8 *pyre;
+ pyre = pyre_alloc8(heap, heap->space);
+ pyre->prev = heap->head;
+ heap->head = pyre;
+ pyre->data = block_edge8(pyre);
+ pyre->left = block_left8(pyre, heap->space);
+ pyre->chunks = 0;
+ return pyre;
+}
+
+static pyre16 * heap16_new (heap16 *heap)
+{
+ pyre16 *pyre;
+ pyre = pyre_alloc16(heap, heap->space);
+ pyre->prev = heap->head;
+ heap->head = pyre;
+ pyre->data = block_edge16(pyre);
+ pyre->left = block_left16(pyre, heap->space);
+ pyre->chunks = 0;
+ return pyre;
+}
+
+static pyre32 * heap32_new (heap32 *heap)
+{
+ pyre32 *pyre;
+ pyre = pyre_alloc32(heap, heap->space);
+ pyre->prev = heap->head;
+ heap->head = pyre;
+ pyre->data = block_edge32(pyre);
+ pyre->left = block_left32(pyre, heap->space);
+ pyre->chunks = 0;
+ return pyre;
+}
+
+static pyre64 * heap64_new (heap64 *heap)
+{
+ pyre64 *pyre;
+ pyre = pyre_alloc64(heap, heap->space);
+ pyre->prev = heap->head;
+ heap->head = pyre;
+ pyre->data = block_edge64(pyre);
+ pyre->left = block_left64(pyre, heap->space);
+ pyre->chunks = 0;
+ return pyre;
+}
+
+/* next heap sole */
+
+static pyre8 * heap8_sole (heap8 *heap, size_t size)
+{
+ pyre8 *pyre, *head, *prev;
+ pyre = pyre_alloc8(heap, size);
+ head = heap->head;
+ prev = head->prev;
+ pyre->prev = prev;
+ head->prev = pyre;
+ pyre->data = block_edge8(pyre);
+ pyre->left = 0; // (uint8_t)size makes no sense, even with buffer api it will finally become 0
+ return pyre;
+}
+
+static pyre16 * heap16_sole (heap16 *heap, size_t size)
+{
+ pyre16 *pyre, *head, *prev;
+ pyre = pyre_alloc16(heap, size);
+ head = heap->head;
+ prev = head->prev;
+ pyre->prev = prev;
+ head->prev = pyre;
+ pyre->data = block_edge16(pyre);
+ pyre->left = 0;
+ return pyre;
+}
+
+static pyre32 * heap32_sole (heap32 *heap, size_t size)
+{
+ pyre32 *pyre, *head, *prev;
+ pyre = pyre_alloc32(heap, size);
+ head = heap->head;
+ prev = head->prev;
+ pyre->prev = prev;
+ head->prev = pyre;
+ pyre->data = block_edge32(pyre);
+ pyre->left = 0;
+ return pyre;
+}
+
+static pyre64 * heap64_sole (heap64 *heap, size_t size)
+{
+ pyre64 *pyre, *head, *prev;
+ pyre = pyre_alloc64(heap, size);
+ head = heap->head;
+ prev = head->prev;
+ pyre->prev = prev;
+ head->prev = pyre;
+ pyre->data = block_edge64(pyre);
+ pyre->left = 0;
+ return pyre;
+}
+
+/* take from heap */
+
+#define pyre_next8(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->left -= (uint8_t)size, ++pyre->chunks)
+#define pyre_next16(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->left -= (uint16_t)size, ++pyre->chunks)
+#define pyre_next32(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->left -= (uint32_t)size, ++pyre->chunks)
+#define pyre_next64(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->left -= (uint64_t)size, ++pyre->chunks)
+
+// for sole blocks, block->left is permanently 0, we can't store size_t there
+#define pyre_last8(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->chunks = 1)
+#define pyre_last16(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->chunks = 1)
+#define pyre_last32(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->chunks = 1)
+#define pyre_last64(d, pyre, size) (d = pyre->data, pyre->data += size, pyre->chunks = 1)
+
+void * _heap8_take (heap8 *heap, size_t size)
+{
+ pyre8 *pyre;
+ void *data;
+ pyre = heap->head;
+ align_size8(size);
+ if (size <= pyre->left)
+ {
+ pyre_next8(data, pyre, size);
+ }
+ else if (take_new_block8(heap, pyre8, pyre, size))
+ {
+ pyre = heap8_new(heap);
+ pyre_next8(data, pyre, size);
+ }
+ else
+ {
+ pyre = heap8_sole(heap, size);
+ pyre_last8(data, pyre, size);
+ }
+ return data;
+}
+
+void * _heap16_take (heap16 *heap, size_t size)
+{
+ pyre16 *pyre;
+ void *data;
+ pyre = heap->head;
+ align_size16(size);
+ if (size <= pyre->left)
+ {
+ pyre_next16(data, pyre, size);
+ }
+ else if (take_new_block16(heap, pyre16, pyre, size))
+ {
+ pyre = heap16_new(heap);
+ pyre_next16(data, pyre, size);
+ }
+ else
+ {
+ pyre = heap16_sole(heap, size);
+ pyre_last16(data, pyre, size);
+ }
+ return data;
+}
+
+void * _heap32_take (heap32 *heap, size_t size)
+{
+ pyre32 *pyre;
+ void *data;
+ pyre = heap->head;
+ align_size32(size);
+ if (size <= pyre->left)
+ {
+ pyre_next32(data, pyre, size);
+ }
+ else if (take_new_block32(heap, pyre32, pyre, size))
+ {
+ pyre = heap32_new(heap);
+ pyre_next32(data, pyre, size);
+ }
+ else
+ {
+ pyre = heap32_sole(heap, size);
+ pyre_last32(data, pyre, size);
+ }
+ return data;
+}
+
+void * _heap64_take (heap64 *heap, size_t size)
+{
+ pyre64 *pyre;
+ void *data;
+ pyre = heap->head;
+ align_size64(size);
+ if (size <= pyre->left)
+ {
+ pyre_next64(data, pyre, size);
+ }
+ else if (take_new_block64(heap, pyre64, pyre, size))
+ {
+ pyre = heap64_new(heap);
+ pyre_next64(data, pyre, size);
+ }
+ else
+ {
+ pyre = heap64_sole(heap, size);
+ pyre_last64(data, pyre, size);
+ }
+ return data;
+}
+
+void * _heap8_take0 (heap8 *heap, size_t size)
+{
+ return memset(_heap8_take(heap, size), 0, size);
+}
+
+void * _heap16_take0 (heap16 *heap, size_t size)
+{
+ return memset(_heap16_take(heap, size), 0, size);
+}
+
+void * _heap32_take0 (heap32 *heap, size_t size)
+{
+ return memset(_heap32_take(heap, size), 0, size);
+}
+
+void * _heap64_take0 (heap64 *heap, size_t size)
+{
+ return memset(_heap64_take(heap, size), 0, size);
+}
+
+/* pop last heap chunk */
+
+#define taken_from_head(taken, head) (byte_data(taken) == head->data)
+#define taken_from_sole(taken, head, sole) ((sole = head->prev) != NULL && byte_data(taken) == sole->data)
+
+#define taken_prev_head(taken, head, size) (byte_data(taken) == head->data - size)
+#define taken_prev_sole(taken, head, sole, size) ((sole = head->prev) != NULL && byte_data(taken) == sole->data - size)
+
+void heap8_pop (heap8 *heap, void *taken, size_t size)
+{
+ pyre8 *pyre, *head;
+ head = heap->head;
+ align_size8(size);
+ if (taken_prev_head(taken, head, size))
+ {
+
+ head->data -= size;
+ head->left += (uint8_t)size;
+ --head->chunks;
+ }
+ else if (taken_prev_sole(taken, head, pyre, size))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+ else
+ {
+ ASSERT8(0);
+ }
+}
+
+void heap16_pop (heap16 *heap, void *taken, size_t size)
+{
+ pyre16 *pyre, *head;
+ head = heap->head;
+ align_size16(size);
+ if (taken_prev_head(taken, head, size))
+ {
+
+ head->data -= size;
+ head->left += (uint16_t)size;
+ --head->chunks;
+ }
+ else if (taken_prev_sole(taken, head, pyre, size))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+ else
+ {
+ ASSERT16(0);
+ }
+}
+
+void heap32_pop (heap32 *heap, void *taken, size_t size)
+{
+ pyre32 *pyre, *head;
+ head = heap->head;
+ align_size32(size);
+ if (taken_prev_head(taken, head, size))
+ {
+
+ head->data -= size;
+ head->left += (uint32_t)size;
+ --head->chunks;
+ }
+ else if (taken_prev_sole(taken, head, pyre, size))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+ else
+ {
+ ASSERT32(0);
+ }
+}
+
+void heap64_pop (heap64 *heap, void *taken, size_t size)
+{
+ pyre64 *pyre, *head;
+ head = heap->head;
+ align_size64(size);
+ if (taken_prev_head(taken, head, size))
+ {
+
+ head->data -= size;
+ head->left += (uint64_t)size;
+ --head->chunks;
+ }
+ else if (taken_prev_sole(taken, head, pyre, size))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+ else
+ {
+ ASSERT64(0);
+ }
+}
+
+/* heap buffer */
+
+void * _heap8_some (heap8 *heap, size_t size, size_t *pspace)
+{
+ pyre8 *pyre;
+ pyre = heap->head;
+ align_size8(size);
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block8(heap, pyre8, pyre, size))
+ {
+ pyre = heap8_new(heap);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap8_sole(heap, size);
+ *pspace = size;
+ }
+ return void_data(pyre->data);
+}
+
+void * _heap16_some (heap16 *heap, size_t size, size_t *pspace)
+{
+ pyre16 *pyre;
+ pyre = heap->head;
+ align_size16(size);
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block16(heap, pyre16, pyre, size))
+ {
+ pyre = heap16_new(heap);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap16_sole(heap, size);
+ *pspace = size;
+ }
+ return void_data(pyre->data);
+}
+
+void * _heap32_some (heap32 *heap, size_t size, size_t *pspace)
+{
+ pyre32 *pyre;
+ pyre = heap->head;
+ align_size32(size);
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block32(heap, pyre32, pyre, size))
+ {
+ pyre = heap32_new(heap);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap32_sole(heap, size);
+ *pspace = size;
+ }
+ return void_data(pyre->data);
+}
+
+void * _heap64_some (heap64 *heap, size_t size, size_t *pspace)
+{
+ pyre64 *pyre;
+ pyre = heap->head;
+ align_size64(size);
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block64(heap, pyre64, pyre, size))
+ {
+ pyre = heap64_new(heap);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap64_sole(heap, size);
+ *pspace = size;
+ }
+ return void_data(pyre->data);
+}
+
+void * heap8_more (heap8 *heap, void *taken, size_t written, size_t size, size_t *pspace)
+{
+ pyre8 *pyre, *prev;
+ pyre = heap->head;
+ align_size8(size);
+ if (taken_from_head(taken, pyre))
+ {
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block8(heap, pyre8, pyre, size))
+ {
+ pyre = heap8_new(heap);
+ memcpy(pyre->data, taken, written);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap8_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ }
+ }
+ else if (taken_from_sole(taken, pyre, prev))
+ {
+ pyre = heap8_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ pyre->prev = prev->prev;
+ pyre_free(prev);
+ }
+ else
+ {
+ ASSERT8(0);
+ *pspace = 0;
+ return NULL;
+ }
+ return void_data(pyre->data);
+}
+
+void * heap16_more (heap16 *heap, void *taken, size_t written, size_t size, size_t *pspace)
+{
+ pyre16 *pyre, *prev;
+ pyre = heap->head;
+ align_size16(size);
+ if (taken_from_head(taken, pyre))
+ {
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block16(heap, pyre16, pyre, size))
+ {
+ pyre = heap16_new(heap);
+ memcpy(pyre->data, taken, written);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap16_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ }
+ }
+ else if (taken_from_sole(taken, pyre, prev))
+ {
+ pyre = heap16_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ pyre->prev = prev->prev;
+ pyre_free(prev);
+ }
+ else
+ {
+ ASSERT16(0);
+ *pspace = 0;
+ return NULL;
+ }
+ return void_data(pyre->data);
+}
+
+void * heap32_more (heap32 *heap, void *taken, size_t written, size_t size, size_t *pspace)
+{
+ pyre32 *pyre, *prev;
+ pyre = heap->head;
+ align_size32(size);
+ if (taken_from_head(taken, pyre))
+ {
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block32(heap, pyre32, pyre, size))
+ {
+ pyre = heap32_new(heap);
+ memcpy(pyre->data, taken, written);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap32_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ }
+ }
+ else if (taken_from_sole(taken, pyre, prev))
+ {
+ pyre = heap32_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ pyre->prev = prev->prev;
+ pyre_free(prev);
+ }
+ else
+ {
+ ASSERT32(0);
+ *pspace = 0;
+ return NULL;
+ }
+ return void_data(pyre->data);
+}
+
+void * heap64_more (heap64 *heap, void *taken, size_t written, size_t size, size_t *pspace)
+{
+ pyre64 *pyre, *prev;
+ pyre = heap->head;
+ align_size64(size);
+ if (taken_from_head(taken, pyre))
+ {
+ if (size <= pyre->left)
+ {
+ *pspace = pyre->left;
+ }
+ else if (take_new_block64(heap, pyre64, pyre, size))
+ {
+ pyre = heap64_new(heap);
+ memcpy(pyre->data, taken, written);
+ *pspace = pyre->left;
+ }
+ else
+ {
+ pyre = heap64_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ }
+ }
+ else if (taken_from_sole(taken, pyre, prev))
+ {
+ pyre = heap64_sole(heap, size);
+ memcpy(pyre->data, taken, written);
+ *pspace = size;
+ pyre->prev = prev->prev;
+ pyre_free(prev);
+ }
+ else
+ {
+ ASSERT64(0);
+ *pspace = 0;
+ return NULL;
+ }
+ return void_data(pyre->data);
+}
+
+void heap8_done (heap8 *heap, void *taken, size_t written)
+{
+ pyre8 *pyre;
+ pyre = heap->head;
+ align_size8(written);
+ if (taken_from_head(taken, pyre))
+ {
+ pyre->data += written;
+ pyre->left -= (uint8_t)written;
+ ++pyre->chunks;
+ }
+ else if (taken_from_sole(taken, pyre, pyre))
+ {
+ pyre->data += written;
+ pyre->chunks = 1;
+ }
+ else
+ {
+ ASSERT8(0);
+ }
+}
+
+void heap16_done (heap16 *heap, void *taken, size_t written)
+{
+ pyre16 *pyre;
+ pyre = heap->head;
+ align_size16(written);
+ if (taken_from_head(taken, pyre))
+ {
+ pyre->data += written;
+ pyre->left -= (uint16_t)written;
+ ++pyre->chunks;
+ }
+ else if (taken_from_sole(taken, pyre, pyre))
+ {
+ pyre->data += written;
+ pyre->chunks = 1;
+ }
+ else
+ {
+ ASSERT16(0);
+ }
+}
+
+void heap32_done (heap32 *heap, void *taken, size_t written)
+{
+ pyre32 *pyre;
+ pyre = heap->head;
+ align_size32(written);
+ if (taken_from_head(taken, pyre))
+ {
+ pyre->data += written;
+ pyre->left -= (uint32_t)written;
+ ++pyre->chunks;
+ }
+ else if (taken_from_sole(taken, pyre, pyre))
+ {
+ pyre->data += written;
+ pyre->chunks = 1;
+ }
+ else
+ {
+ ASSERT32(0);
+ }
+}
+
+void heap64_done (heap64 *heap, void *taken, size_t written)
+{
+ pyre64 *pyre;
+ pyre = heap->head;
+ align_size64(written);
+ if (taken_from_head(taken, pyre))
+ {
+ pyre->data += written;
+ pyre->left -= (uint64_t)written;
+ ++pyre->chunks;
+ }
+ else if (taken_from_sole(taken, pyre, pyre))
+ {
+ pyre->data += written;
+ pyre->chunks = 1;
+ }
+ else
+ {
+ ASSERT64(0);
+ }
+}
+
+/* giveup */
+
+void heap8_giveup (heap8 *heap, void *taken)
+{
+ pyre8 *head, *pyre;
+ head = heap->head;
+ if (taken_from_sole(taken, head, pyre))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+}
+
+void heap16_giveup (heap16 *heap, void *taken)
+{
+ pyre16 *head, *pyre;
+ head = heap->head;
+ if (taken_from_sole(taken, head, pyre))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+}
+
+void heap32_giveup (heap32 *heap, void *taken)
+{
+ pyre32 *head, *pyre;
+ head = heap->head;
+ if (taken_from_sole(taken, head, pyre))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+}
+
+void heap64_giveup (heap64 *heap, void *taken)
+{
+ pyre64 *head, *pyre;
+ head = heap->head;
+ if (taken_from_sole(taken, head, pyre))
+ {
+ head->prev = pyre->prev;
+ pyre_free(pyre);
+ }
+}
+
+/* heap empty */
+
+int heap8_empty (heap8 *heap)
+{
+ pyre8 *pyre;
+ return head_block_empty(heap, pyre);
+}
+
+int heap16_empty (heap16 *heap)
+{
+ pyre16 *pyre;
+ return head_block_empty(heap, pyre);
+}
+
+int heap32_empty (heap32 *heap)
+{
+ pyre32 *pyre;
+ return head_block_empty(heap, pyre);
+}
+
+int heap64_empty (heap64 *heap)
+{
+ pyre64 *pyre;
+ return head_block_empty(heap, pyre);
+}
+
+/* heap stats */
+
+void heap8_stats (heap8 *heap, mem_info *info, int append)
+{
+ pyre8 *pyre;
+ size_t used, chunks = 0, blocks = 0, singles = 0;
+ if (!append)
+ memset(info, 0, sizeof(mem_info));
+ for (pyre = heap->head; pyre != NULL; pyre = pyre->prev)
+ {
+ ++blocks;
+ chunks += pyre->chunks;
+ used = block_used8(pyre);
+ info->used += used;
+ info->left += pyre->left;
+ if (pyre->chunks == 1 && pyre->left == 0)
+ {
+ ++singles;
+ info->singleused += used;
+ }
+ }
+ info->chunks += chunks;
+ info->blocks += blocks;
+ info->blockghosts += blocks * sizeof(pyre8);
+ info->singles += singles;
+ info->singleghosts += singles * sizeof(pyre8);
+}
+
+void heap16_stats (heap16 *heap, mem_info *info, int append)
+{
+ pyre16 *pyre;
+ size_t used, chunks = 0, blocks = 0, singles = 0;
+ if (!append)
+ memset(info, 0, sizeof(mem_info));
+ for (pyre = heap->head; pyre != NULL; pyre = pyre->prev)
+ {
+ ++blocks;
+ chunks += pyre->chunks;
+ used = block_used16(pyre);
+ info->used += used;
+ info->left += pyre->left;
+ if (pyre->chunks == 1 && pyre->left == 0)
+ {
+ ++singles;
+ info->singleused += used;
+ }
+ }
+ info->chunks += chunks;
+ info->blocks += blocks;
+ info->blockghosts += blocks * sizeof(pyre16);
+ info->singles += singles;
+ info->singleghosts += singles * sizeof(pyre16);
+}
+
+void heap32_stats (heap32 *heap, mem_info *info, int append)
+{
+ pyre32 *pyre;
+ size_t used, chunks = 0, blocks = 0, singles = 0;
+ if (!append)
+ memset(info, 0, sizeof(mem_info));
+ for (pyre = heap->head; pyre != NULL; pyre = pyre->prev)
+ {
+ ++blocks;
+ chunks += pyre->chunks;
+ used = block_used32(pyre);
+ info->used += used;
+ info->left += pyre->left;
+ if (pyre->chunks == 1 && pyre->left == 0)
+ {
+ ++singles;
+ info->singleused += used;
+ }
+ }
+ info->chunks += chunks;
+ info->blocks += blocks;
+ info->blockghosts += blocks * sizeof(pyre32);
+ info->singles += singles;
+ info->singleghosts += singles * sizeof(pyre32);
+}
+
+void heap64_stats (heap64 *heap, mem_info *info, int append)
+{
+ pyre64 *pyre;
+ size_t used, chunks = 0, blocks = 0, singles = 0;
+ if (!append)
+ memset(info, 0, sizeof(mem_info));
+ for (pyre = heap->head; pyre != NULL; pyre = pyre->prev)
+ {
+ ++blocks;
+ chunks += pyre->chunks;
+ used = block_used64(pyre);
+ info->used += used;
+ info->left += pyre->left;
+ if (pyre->chunks == 1 && pyre->left == 0)
+ {
+ ++singles;
+ info->singleused += used;
+ }
+ }
+ info->chunks += chunks;
+ info->blocks += blocks;
+ info->blockghosts += blocks * sizeof(pyre64);
+ info->singles += singles;
+ info->singleghosts += singles * sizeof(pyre64);
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilmemheap.h b/source/luametatex/source/libraries/pplib/util/utilmemheap.h
new file mode 100644
index 000000000..8776419c2
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmemheap.h
@@ -0,0 +1,188 @@
+
+#ifndef UTIL_MEM_HEAP_H
+#define UTIL_MEM_HEAP_H
+
+#include "utilmemallh.h"
+
+typedef struct pyre8 pyre8;
+typedef struct pyre16 pyre16;
+typedef struct pyre32 pyre32;
+typedef struct pyre64 pyre64;
+
+struct pyre8 {
+ pyre8 *prev;
+ uint8_t *data;
+ uint8_t left;
+ uint8_t chunks;
+#ifdef BIT32
+ uint8_t dummy[2]; // 10->12
+#else
+ uint8_t dummy[6]; // 18->24
+#endif
+};
+
+struct pyre16 {
+ pyre16 *prev;
+ uint8_t *data;
+ uint16_t left;
+ uint16_t chunks;
+#ifdef BIT32
+ //uint8_t dummy[0]; // 12->12
+#else
+ uint8_t dummy[4]; // 20->24
+#endif
+};
+
+struct pyre32 {
+ pyre32 *prev;
+ uint8_t *data;
+ uint32_t left;
+ uint32_t chunks;
+#ifdef BIT32
+ //uint8_t dummy[0]; // 16->16
+#else
+ //uint8_t dummy[0]; // 24->24
+#endif
+};
+
+struct pyre64 {
+ pyre64 *prev;
+ uint8_t *data;
+ uint64_t left;
+ uint64_t chunks;
+#ifdef BIT32
+ //uint8_t dummy[0]; // 24->24
+#else
+ //uint8_t dummy[0]; // 32->32
+#endif
+};
+
+/* heaps */
+
+typedef struct heap8 heap8;
+typedef struct heap16 heap16;
+typedef struct heap32 heap32;
+typedef struct heap64 heap64;
+
+struct heap8 {
+ pyre8 *head;
+ uint8_t space;
+ uint8_t large;
+ uint8_t flags;
+};
+
+struct heap16 {
+ pyre16 *head;
+ uint16_t space;
+ uint16_t large;
+ uint8_t flags;
+};
+
+struct heap32 {
+ pyre32 *head;
+ uint32_t space;
+ uint32_t large;
+ uint8_t flags;
+};
+
+struct heap64 {
+ pyre64 *head;
+ uint64_t space;
+ uint64_t large;
+ uint8_t flags;
+};
+
+#define HEAP_ZERO (1 << 0)
+#define HEAP_DEFAULTS 0
+
+#define HEAP8_INIT(space, large, flags) { NULL, aligned_space8(space), large, flags }
+#define HEAP16_INIT(space, large, flags) { NULL, aligned_space16(space), large, flags }
+#define HEAP32_INIT(space, large, flags) { NULL, aligned_space32(space), large, flags }
+#define HEAP64_INIT(space, large, flags) { NULL, aligned_space64(space), large, flags }
+
+UTILAPI heap8 * heap8_init (heap8 *heap, uint8_t space, uint8_t large, uint8_t flags);
+UTILAPI heap16 * heap16_init (heap16 *heap, uint16_t space, uint16_t large, uint8_t flags);
+UTILAPI heap32 * heap32_init (heap32 *heap, uint32_t space, uint32_t large, uint8_t flags);
+UTILAPI heap64 * heap64_init (heap64 *heap, uint64_t space, uint64_t large, uint8_t flags);
+
+UTILAPI void heap8_head (heap8 *heap);
+UTILAPI void heap16_head (heap16 *heap);
+UTILAPI void heap32_head (heap32 *heap);
+UTILAPI void heap64_head (heap64 *heap);
+
+#define heap8_ensure_head(heap) ((void)((heap)->head != NULL || (heap8_head(heap), 0)))
+#define heap16_ensure_head(heap) ((void)((heap)->head != NULL || (heap16_head(heap), 0)))
+#define heap32_ensure_head(heap) ((void)((heap)->head != NULL || (heap32_head(heap), 0)))
+#define heap64_ensure_head(heap) ((void)((heap)->head != NULL || (heap64_head(heap), 0)))
+
+UTILAPI void heap8_free (heap8 *heap);
+UTILAPI void heap16_free (heap16 *heap);
+UTILAPI void heap32_free (heap32 *heap);
+UTILAPI void heap64_free (heap64 *heap);
+
+UTILAPI void heap8_clear (heap8 *heap);
+UTILAPI void heap16_clear (heap16 *heap);
+UTILAPI void heap32_clear (heap32 *heap);
+UTILAPI void heap64_clear (heap64 *heap);
+
+UTILAPI void * _heap8_take (heap8 *heap, size_t size);
+UTILAPI void * _heap16_take (heap16 *heap, size_t size);
+UTILAPI void * _heap32_take (heap32 *heap, size_t size);
+UTILAPI void * _heap64_take (heap64 *heap, size_t size);
+
+UTILAPI void * _heap8_take0 (heap8 *heap, size_t size);
+UTILAPI void * _heap16_take0 (heap16 *heap, size_t size);
+UTILAPI void * _heap32_take0 (heap32 *heap, size_t size);
+UTILAPI void * _heap64_take0 (heap64 *heap, size_t size);
+
+#define heap8_take(heap, size) (heap8_ensure_head(heap), _heap8_take(heap, size))
+#define heap16_take(heap, size) (heap16_ensure_head(heap), _heap16_take(heap, size))
+#define heap32_take(heap, size) (heap32_ensure_head(heap), _heap32_take(heap, size))
+#define heap64_take(heap, size) (heap64_ensure_head(heap), _heap64_take(heap, size))
+
+#define heap8_take0(heap, size) (heap8_ensure_head(heap), _heap8_take0(heap, size))
+#define heap16_take0(heap, size) (heap16_ensure_head(heap), _heap16_take0(heap, size))
+#define heap32_take0(heap, size) (heap32_ensure_head(heap), _heap32_take0(heap, size))
+#define heap64_take0(heap, size) (heap64_ensure_head(heap), _heap64_take0(heap, size))
+
+UTILAPI void heap8_pop (heap8 *heap, void *taken, size_t size);
+UTILAPI void heap16_pop (heap16 *heap, void *taken, size_t size);
+UTILAPI void heap32_pop (heap32 *heap, void *taken, size_t size);
+UTILAPI void heap64_pop (heap64 *heap, void *taken, size_t size);
+
+UTILAPI void * _heap8_some (heap8 *heap, size_t size, size_t *pspace);
+UTILAPI void * _heap16_some (heap16 *heap, size_t size, size_t *pspace);
+UTILAPI void * _heap32_some (heap32 *heap, size_t size, size_t *pspace);
+UTILAPI void * _heap64_some (heap64 *heap, size_t size, size_t *pspace);
+
+#define heap8_some(heap, size, pspace) (heap8_ensure_head(heap), _heap8_some(heap, size, pspace))
+#define heap16_some(heap, size, pspace) (heap16_ensure_head(heap), _heap16_some(heap, size, pspace))
+#define heap32_some(heap, size, pspace) (heap32_ensure_head(heap), _heap32_some(heap, size, pspace))
+#define heap64_some(heap, size, pspace) (heap64_ensure_head(heap), _heap64_some(heap, size, pspace))
+
+UTILAPI void * heap8_more (heap8 *heap, void *taken, size_t written, size_t size, size_t *pspace);
+UTILAPI void * heap16_more (heap16 *heap, void *taken, size_t written, size_t size, size_t *pspace);
+UTILAPI void * heap32_more (heap32 *heap, void *taken, size_t written, size_t size, size_t *pspace);
+UTILAPI void * heap64_more (heap64 *heap, void *taken, size_t written, size_t size, size_t *pspace);
+
+UTILAPI void heap8_done (heap8 *heap, void *taken, size_t written);
+UTILAPI void heap16_done (heap16 *heap, void *taken, size_t written);
+UTILAPI void heap32_done (heap32 *heap, void *taken, size_t written);
+UTILAPI void heap64_done (heap64 *heap, void *taken, size_t written);
+
+UTILAPI void heap8_giveup (heap8 *heap, void *taken);
+UTILAPI void heap16_giveup (heap16 *heap, void *taken);
+UTILAPI void heap32_giveup (heap32 *heap, void *taken);
+UTILAPI void heap64_giveup (heap64 *heap, void *taken);
+
+UTILAPI int heap8_empty (heap8 *heap);
+UTILAPI int heap16_empty (heap16 *heap);
+UTILAPI int heap32_empty (heap32 *heap);
+UTILAPI int heap64_empty (heap64 *heap);
+
+UTILAPI void heap8_stats (heap8 *heap, mem_info *info, int append);
+UTILAPI void heap16_stats (heap16 *heap, mem_info *info, int append);
+UTILAPI void heap32_stats (heap32 *heap, mem_info *info, int append);
+UTILAPI void heap64_stats (heap64 *heap, mem_info *info, int append);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmemheapiof.c b/source/luametatex/source/libraries/pplib/util/utilmemheapiof.c
new file mode 100644
index 000000000..cd9609da8
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmemheapiof.c
@@ -0,0 +1,142 @@
+
+#include "utilmemheapiof.h"
+
+// this is identical to stock iof suite, keep in sync
+
+size_t heap8_writer (iof *O, iof_mode mode)
+{
+ heap8 *heap;
+ size_t written;
+ heap = (heap8 *)O->link;
+ switch (mode)
+ {
+ case IOFFLUSH:
+ heap8_buffer_done(heap, O);
+ O->buf = _heap8_some(heap, 0, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ break;
+ case IOFWRITE:
+ written = (size_t)iof_size(O);
+ O->buf = heap8_more(heap, O->buf, written, written << 1, &O->space);
+ O->pos = O->buf + written;
+ O->end = O->buf + O->space;
+ return O->space - written;
+ case IOFCLOSE:
+ default:
+ break;
+ }
+ return 0;
+}
+
+size_t heap16_writer (iof *O, iof_mode mode)
+{
+ heap16 *heap;
+ size_t written;
+ heap = (heap16 *)O->link;
+ switch (mode)
+ {
+ case IOFFLUSH:
+ heap16_buffer_done(heap, O);
+ O->buf = _heap16_some(heap, 0, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ break;
+ case IOFWRITE:
+ written = (size_t)iof_size(O);
+ O->buf = heap16_more(heap, O->buf, written, written << 1, &O->space);
+ O->pos = O->buf + written;
+ O->end = O->buf + O->space;
+ return O->space - written;
+ case IOFCLOSE:
+ default:
+ break;
+ }
+ return 0;
+}
+
+size_t heap32_writer (iof *O, iof_mode mode)
+{
+ heap32 *heap;
+ size_t written;
+ heap = (heap32 *)O->link;
+ switch (mode)
+ {
+ case IOFFLUSH:
+ heap32_buffer_done(heap, O);
+ O->buf = _heap32_some(heap, 0, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ break;
+ case IOFWRITE:
+ written = (size_t)iof_size(O);
+ O->buf = heap32_more(heap, O->buf, written, written << 1, &O->space);
+ O->pos = O->buf + written;
+ O->end = O->buf + O->space;
+ return O->space - written;
+ case IOFCLOSE:
+ default:
+ break;
+ }
+ return 0;
+}
+
+size_t heap64_writer (iof *O, iof_mode mode)
+{
+ heap64 *heap;
+ size_t written;
+ heap = (heap64 *)O->link;
+ switch (mode)
+ {
+ case IOFFLUSH:
+ heap64_buffer_done(heap, O);
+ O->buf = _heap64_some(heap, 0, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ break;
+ case IOFWRITE:
+ written = (size_t)iof_size(O);
+ O->buf = heap64_more(heap, O->buf, written, written << 1, &O->space);
+ O->pos = O->buf + written;
+ O->end = O->buf + O->space;
+ return O->space - written;
+ case IOFCLOSE:
+ default:
+ break;
+ }
+ return 0;
+}
+
+/* buffer for some */
+
+iof * _heap8_buffer_some (heap8 *heap, iof *O, size_t atleast)
+{
+ O->buf = _heap8_some(heap, atleast, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ return O;
+}
+
+iof * _heap16_buffer_some (heap16 *heap, iof *O, size_t atleast)
+{
+ O->buf = _heap16_some(heap, atleast, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ return O;
+}
+
+iof * _heap32_buffer_some (heap32 *heap, iof *O, size_t atleast)
+{
+ O->buf = _heap32_some(heap, atleast, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ return O;
+}
+
+iof * _heap64_buffer_some (heap64 *heap, iof *O, size_t atleast)
+{
+ O->buf = _heap64_some(heap, atleast, &O->space);
+ O->pos = O->buf;
+ O->end = O->buf + O->space;
+ return O;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilmemheapiof.h b/source/luametatex/source/libraries/pplib/util/utilmemheapiof.h
new file mode 100644
index 000000000..1f3da7efb
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmemheapiof.h
@@ -0,0 +1,43 @@
+
+#ifndef UTIL_MEM_HEAP_IOF_H
+#define UTIL_MEM_HEAP_IOF_H
+
+#include "utilmemheap.h"
+#include "utiliof.h"
+
+UTILAPI size_t heap8_writer (iof *O, iof_mode mode);
+UTILAPI size_t heap16_writer (iof *O, iof_mode mode);
+UTILAPI size_t heap32_writer (iof *O, iof_mode mode);
+UTILAPI size_t heap64_writer (iof *O, iof_mode mode);
+
+#define HEAP8_BUFFER_INIT(heap) IOF_WRITER_INIT(heap8_writer, (void *)(heap), NULL, 0, 0)
+#define HEAP16_BUFFER_INIT(heap) IOF_WRITER_INIT(heap16_writer, (void *)(heap), NULL, 0, 0)
+#define HEAP32_BUFFER_INIT(heap) IOF_WRITER_INIT(heap32_writer, (void *)(heap), NULL, 0, 0)
+#define HEAP64_BUFFER_INIT(heap) IOF_WRITER_INIT(heap64_writer, (void *)(heap), NULL, 0, 0)
+
+#define heap8_buffer_init(heap, O) iof_writer(O, (void *)(heap), heap8_writer, NULL, 0)
+#define heap16_buffer_init(heap, O) iof_writer(O, (void *)(heap), heap16_writer, NULL, 0)
+#define heap32_buffer_init(heap, O) iof_writer(O, (void *)(heap), heap32_writer, NULL, 0)
+#define heap64_buffer_init(heap, O) iof_writer(O, (void *)(heap), heap64_writer, NULL, 0)
+
+UTILAPI iof * _heap8_buffer_some (heap8 *heap, iof *O, size_t atleast);
+UTILAPI iof * _heap16_buffer_some (heap16 *heap, iof *O, size_t atleast);
+UTILAPI iof * _heap32_buffer_some (heap32 *heap, iof *O, size_t atleast);
+UTILAPI iof * _heap64_buffer_some (heap64 *heap, iof *O, size_t atleast);
+
+#define heap8_buffer_some(heap, O, atleast) (heap8_ensure_head(heap), _heap8_buffer_some(heap, O, atleast))
+#define heap16_buffer_some(heap, O, atleast) (heap16_ensure_head(heap), _heap16_buffer_some(heap, O, atleast))
+#define heap32_buffer_some(heap, O, atleast) (heap32_ensure_head(heap), _heap32_buffer_some(heap, O, atleast))
+#define heap64_buffer_some(heap, O, atleast) (heap64_ensure_head(heap), _heap64_buffer_some(heap, O, atleast))
+
+#define heap8_buffer_done(heap, O) heap8_done(heap, (O)->buf, (size_t)iof_size(O))
+#define heap16_buffer_done(heap, O) heap16_done(heap, (O)->buf, (size_t)iof_size(O))
+#define heap32_buffer_done(heap, O) heap32_done(heap, (O)->buf, (size_t)iof_size(O))
+#define heap64_buffer_done(heap, O) heap64_done(heap, (O)->buf, (size_t)iof_size(O))
+
+#define heap8_buffer_giveup(heap, O) heap8_giveup(heap, (O)->buf)
+#define heap16_buffer_giveup(heap, O) heap16_giveup(heap, (O)->buf)
+#define heap32_buffer_giveup(heap, O) heap32_giveup(heap, (O)->buf)
+#define heap64_buffer_giveup(heap, O) heap64_giveup(heap, (O)->buf)
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilmeminfo.c b/source/luametatex/source/libraries/pplib/util/utilmeminfo.c
new file mode 100644
index 000000000..d3f61d5ca
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmeminfo.c
@@ -0,0 +1,38 @@
+/* print stats; common for heap, stock and pool */
+
+#include <stdio.h>
+
+#include "utilmeminfo.h"
+
+#define UINT(i) ((unsigned long)(i))
+
+void show_mem_info (mem_info *info)
+{
+ size_t totalwaste, totalmem, averagechunk, singlemem;
+ double ftotalwaste, fblockwaste, fghostwaste, ftailwaste, fsinglewaste;
+ double funused, fsingles, fsinglemem, fsingleeff;
+
+ totalwaste = info->ghosts + info->blockghosts + info->left;
+ totalmem = info->used + totalwaste;
+
+ ftotalwaste = totalmem > 0 ? totalwaste * 100.0 / totalmem : 0;
+ fblockwaste = totalmem > 0 ? (info->blockghosts - info->singleghosts) * 100.0 / totalmem : 0;
+ fsinglewaste = totalmem > 0 ? info->singleghosts * 100.0 / totalmem : 0;
+ fghostwaste = totalmem > 0 ? info->ghosts * 100.0 / totalmem : 0;
+ ftailwaste = totalmem > 0 ? info->left * 100.0 / totalmem : 0;
+
+ averagechunk = info->chunks > 0 ? info->used / info->chunks : 0;
+ funused = info->chunks > 0 ? info->unused * 100.0 / info->chunks : 0.0;
+
+ fsingles = info->blocks > 0 ? info->singles * 100.0 / info->blocks : 0;
+ fsinglemem = info->used > 0 ? info->singleused * 100.0 / info->used : 0;
+ singlemem = info->singleused + info->singleghosts;
+ fsingleeff = singlemem > 0 ? info->singleused * 100.0 / singlemem : 0;
+
+ printf("total: %lu + %lu = %lu\n", UINT(info->used), UINT(totalwaste), UINT(totalmem));
+ printf("chunks: %lu of average size %lu, unused %lu[%.2f%%]\n", UINT(info->chunks), UINT(averagechunk), UINT(info->unused), funused);
+ printf("blocks: %lu, singles %lu[%.2f%%], %.2f%% of allocs, efficiency %.2f%%\n",
+ UINT(info->blocks), UINT(info->singles), fsingles, fsinglemem, fsingleeff);
+ printf("waste: %lu[%0.2f%%], block ghosts %0.2f%%, single ghosts %.2f%%, chunk ghosts %0.2f%%, tails %0.2f%%\n\n",
+ UINT(totalwaste), ftotalwaste, fblockwaste, fsinglewaste, fghostwaste, ftailwaste);
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilmeminfo.h b/source/luametatex/source/libraries/pplib/util/utilmeminfo.h
new file mode 100644
index 000000000..cfa0fd670
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilmeminfo.h
@@ -0,0 +1,9 @@
+
+#ifndef UTIL_MEM_INFO_H
+#define UTIL_MEM_INFO_H
+
+#include "utilmemallh.h"
+
+UTILAPI void show_mem_info (mem_info *info);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilnumber.c b/source/luametatex/source/libraries/pplib/util/utilnumber.c
new file mode 100644
index 000000000..4352c26fb
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilnumber.c
@@ -0,0 +1,1177 @@
+
+#include <math.h> /* for log10() and floor() */
+#include <stdio.h> /* for printf() */
+
+#include "utilnumber.h"
+
+// todo: lookups can be chars
+// change lookup arrays to some __name to discourage accessing them directly; they always should be accessed via macros; base16_value() base16_digit()
+//
+
+const int base10_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+const int base16_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
+ -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+const int base26_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
+ 16,17,18,19,20,21,22,23,24,25,26,-1,-1,-1,-1,-1,
+ -1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
+ 16,17,18,19,20,21,22,23,24,25,26,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+const int base36_lookup[] = {
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
+ -1,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
+ 25,26,27,28,29,30,31,32,33,34,35,-1,-1,-1,-1,-1,
+ -1,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
+ 25,26,27,28,29,30,31,32,33,34,35,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
+};
+
+/* common buffer for quick conversions (unsafe) */
+
+char util_number_buffer[NUMBER_BUFFER_SIZE] = { 0 };
+
+/* integer from string; return a pointer to character next to the last digit */
+
+#define string_scan_sign(s, c, sign) _scan_sign(c, sign, *++s)
+#define string_scan_integer(s, c, number) _scan_integer(c, number, *++s)
+#define string_scan_radix(s, c, number, radix) _scan_radix(c, number, radix, *++s)
+#define string_read_integer(s, c, number) _read_integer(c, number, *++s)
+#define string_read_radix(s, c, number, radix) _read_radix(c, number, radix, *++s)
+
+const char * string_to_int32 (const char *s, int32_t *number)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_integer(s, c, *number);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * string_to_slong (const char *s, long *number)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_integer(s, c, *number);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * string_to_int64 (const char *s, int64_t *number)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_integer(s, c, *number);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * string_to_uint32 (const char *s, uint32_t *number)
+{
+ int c = *s;
+ string_scan_integer(s, c, *number);
+ return s;
+}
+
+const char * string_to_ulong (const char *s, unsigned long *number)
+{
+ int c = *s;
+ string_scan_integer(s, c, *number);
+ return s;
+}
+
+const char * string_to_usize (const char *s, size_t *number)
+{
+ int c = *s;
+ string_scan_integer(s, c, *number);
+ return s;
+}
+
+const char * string_to_uint64 (const char *s, uint64_t *number)
+{
+ int c = *s;
+ string_scan_integer(s, c, *number);
+ return s;
+}
+
+const char * radix_to_int32 (const char *s, int32_t *number, int radix)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_radix(s, c, *number, radix);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * radix_to_slong (const char *s, long *number, int radix)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_radix(s, c, *number, radix);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * radix_to_int64 (const char *s, int64_t *number, int radix)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_radix(s, c, *number, radix);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * radix_to_uint32 (const char *s, uint32_t *number, int radix)
+{
+ int c = *s;
+ string_scan_radix(s, c, *number, radix);
+ return s;
+}
+
+const char * radix_to_ulong (const char *s, unsigned long *number, int radix)
+{
+ int c = *s;
+ string_scan_radix(s, c, *number, radix);
+ return s;
+}
+
+const char * radix_to_usize (const char *s, size_t *number, int radix)
+{
+ int c = *s;
+ string_scan_radix(s, c, *number, radix);
+ return s;
+}
+
+const char * radix_to_uint64 (const char *s, uint64_t *number, int radix)
+{
+ int c = *s;
+ string_scan_radix(s, c, *number, radix);
+ return s;
+}
+
+/* roman to uint16_t */
+
+#define roman1000(c) (c == 'M' || c == 'm')
+#define roman500(c) (c == 'D' || c == 'd')
+#define roman100(c) (c == 'C' || c == 'c')
+#define roman50(c) (c == 'L' || c == 'l')
+#define roman10(c) (c == 'X' || c == 'x')
+#define roman5(c) (c == 'V' || c == 'v')
+#define roman1(c) (c == 'I' || c == 'i')
+
+#define roman100s(p) (roman100(*p) ? (100 + ((++p, roman100(*p)) ? (100 + ((++p, roman100(*p)) ? (++p, 100) : 0)) : 0)) : 0)
+#define roman10s(p) (roman10(*p) ? (10 + ((++p, roman10(*p)) ? (10 + ((++p, roman10(*p)) ? (++p, 10) : 0)) : 0)) : 0)
+#define roman1s(p) (roman1(*p) ? (1 + ((++p, roman1(*p)) ? (1 + ((++p, roman1(*p)) ? (++p, 1) : 0)) : 0)) : 0)
+
+const char * roman_to_uint16 (const char *s, uint16_t *number)
+{
+ const char *p;
+ /* M */
+ for (*number = 0, p = s; roman1000(*p); *number += 1000, ++p);
+ /* D C */
+ if (roman500(*p))
+ {
+ ++p;
+ *number += 500 + roman100s(p);
+ }
+ else if (roman100(*p))
+ {
+ ++p;
+ if (roman1000(*p))
+ {
+ ++p;
+ *number += 900;
+ }
+ else if (roman500(*p))
+ {
+ ++p;
+ *number += 400;
+ }
+ else
+ *number += 100 + roman100s(p);
+ }
+ /* L X */
+ if (roman50(*p))
+ {
+ ++p;
+ *number += 50 + roman10s(p);
+ }
+ else if (roman10(*p))
+ {
+ ++p;
+ if (roman100(*p))
+ {
+ ++p;
+ *number += 90;
+ }
+ else if (roman50(*p))
+ {
+ ++p;
+ *number += 40;
+ }
+ else
+ *number += 10 + roman10s(p);
+ }
+ /* V I */
+ if (roman5(*p))
+ {
+ ++p;
+ *number += 5 + roman1s(p);
+ }
+ else if (roman1(*p))
+ {
+ ++p;
+ if (roman10(*p))
+ {
+ ++p;
+ *number += 9;
+ }
+ else if (roman5(*p))
+ {
+ ++p;
+ *number += 4;
+ }
+ else
+ *number += 1 + roman1s(p);
+ }
+ return p;
+}
+
+/* integer to string; return a pointer to null-terminated static const string */
+
+#define end_of_integer_buffer(integer_buffer) (integer_buffer + MAX_INTEGER_DIGITS - 1)
+
+#define number_printrev_signed(p, number, quotient) \
+ do { \
+ quotient = number; number /= 10; \
+ *--p = base10_palindrome[9 + (quotient - number*10)]; \
+ } while (number); \
+ if (quotient < 0) *--p = '-'
+
+#define number_printrev_unsigned(p, number, quotient) \
+ do { \
+ quotient = number; number /= 10; \
+ *--p = (char)(quotient - integer_multiplied10(number)) + '0'; \
+ } while (number)
+
+#define SINTTYPE_AS_STRING(inttype, number, ibuf, psize) \
+ char *p, *e; \
+ inttype quotient; \
+ e = p = end_of_integer_buffer(ibuf); *p = '\0'; \
+ number_printrev_signed(p, number, quotient); \
+ *psize = (size_t)(e - p)
+
+#define UINTTYPE_AS_STRING(inttype, number, ibuf, psize) \
+ char *p, *e; \
+ inttype quotient; \
+ e = p = end_of_integer_buffer(ibuf); *p = '\0'; \
+ number_printrev_unsigned(p, number, quotient); \
+ *psize = (size_t)(e - p)
+
+char * int32_as_string (int32_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_STRING(int32_t, number, ibuf, psize);
+ return p;
+}
+
+char * slong_as_string (long number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_STRING(long, number, ibuf, psize);
+ return p;
+}
+
+char * int64_as_string (int64_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_STRING(int64_t, number, ibuf, psize);
+ return p;
+}
+
+char * uint32_as_string (uint32_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_STRING(uint32_t, number, ibuf, psize);
+ return p;
+}
+
+char * ulong_as_string (unsigned long number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_STRING(unsigned long, number, ibuf, psize);
+ return p;
+}
+
+char * usize_as_string (size_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_STRING(size_t, number, ibuf, psize);
+ return p;
+}
+
+char * uint64_as_string (uint64_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_STRING(uint64_t, number, ibuf, psize);
+ return p;
+}
+
+/* radix variant */
+
+#define number_printrev_signed_radix_uc(p, number, radix, quotient) \
+ do { \
+ quotient = number; number /= radix; \
+ *--p = base36_uc_palindrome[MAX_RADIX - 1 + (quotient - number*radix)]; \
+ } while (number)
+
+#define number_printrev_signed_radix_lc(p, number, radix, quotient) \
+ do { \
+ quotient = number; number /= radix; \
+ *--p = base36_lc_palindrome[MAX_RADIX - 1 + (quotient - number*radix)]; \
+ } while (number)
+
+#define number_printrev_signed_radix(p, number, radix, quotient, uc) \
+ do { \
+ if (uc) { number_printrev_signed_radix_uc(p, number, radix, quotient); } \
+ else { number_printrev_signed_radix_lc(p, number, radix, quotient); } \
+ if (quotient < 0) *--p = '-'; \
+ } while (0)
+
+#define number_printrev_unsigned_radix_uc(p, number, radix, quotient) \
+ do { \
+ quotient = number; number /= radix; \
+ *--p = base36_uc_alphabet[quotient % radix]; \
+ } while (number)
+
+#define number_printrev_unsigned_radix_lc(p, number, radix, quotient) \
+ do { \
+ quotient = number; number /= radix; \
+ *--p = base36_lc_alphabet[quotient % radix]; \
+ } while (number)
+
+#define number_printrev_unsigned_radix(p, number, radix, quotient, uc) \
+ do { \
+ if (uc) { number_printrev_unsigned_radix_uc(p, number, radix, quotient); } \
+ else { number_printrev_unsigned_radix_lc(p, number, radix, quotient); } \
+ } while (0)
+
+#define SINTTYPE_AS_RADIX(inttype, number, radix, uc, ibuf, psize) \
+ char *p, *e; \
+ inttype quotient; \
+ e = p = end_of_integer_buffer(ibuf); *p = '\0'; \
+ number_printrev_signed_radix(p, number, radix, quotient, uc); \
+ *psize = (size_t)(e - p)
+
+#define UINTTYPE_AS_RADIX(inttype, number, radix, uc, ibuf, psize) \
+ char *p, *e; \
+ inttype quotient; \
+ e = p = end_of_integer_buffer(ibuf); *p = '\0'; \
+ number_printrev_unsigned_radix(p, number, radix, quotient, uc); \
+ *psize = (size_t)(e - p)
+
+char * int32_as_radix (int32_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_RADIX(int32_t, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+char * slong_as_radix (long number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_RADIX(long, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+/*
+char * ssize_as_radix (ssize_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_RADIX(ssize_t, number, radix, uc, ibuf, psize);
+ return p;
+}
+*/
+
+char * int64_as_radix (int64_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ SINTTYPE_AS_RADIX(int64_t, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+char * uint32_as_radix (uint32_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_RADIX(uint32_t, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+char * ulong_as_radix (unsigned long number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_RADIX(unsigned long, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+char * usize_as_radix (size_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_RADIX(size_t, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+char * uint64_as_radix (uint64_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_RADIX(uint64_t, number, radix, uc, ibuf, psize);
+ return p;
+}
+
+/* aaa, aab, aac, ...; unsigned only. 0 gives empty string */
+
+#define string_scan_alpha(s, c, number, radix) \
+ for (number = 0, c = *s; (c = base26_value(c)) > 0; number = number * radix + c, c = *++s)
+
+const char * alpha_to_uint32 (const char *s, uint32_t *number)
+{
+ int c;
+ string_scan_alpha(s, c, *number, 26);
+ return s;
+}
+
+const char * alpha_to_ulong (const char *s, unsigned long *number)
+{
+ int c;
+ string_scan_alpha(s, c, *number, 26);
+ return s;
+}
+
+const char * alpha_to_usize (const char *s, size_t *number)
+{
+ int c;
+ string_scan_alpha(s, c, *number, 26);
+ return s;
+}
+
+const char * alpha_to_uint64 (const char *s, uint64_t *number)
+{
+ int c;
+ string_scan_alpha(s, c, *number, 26);
+ return s;
+}
+
+#define number_printrev_unsigned_alpha_uc(p, number, radix, quotient) \
+ while (number > 0) { \
+ quotient = --number; number /= radix; \
+ *--p = base26_uc_alphabet[quotient % radix]; \
+ }
+
+#define number_printrev_unsigned_alpha_lc(p, number, radix, quotient) \
+ while (number > 0) { \
+ quotient = --number; number /= radix; \
+ *--p = base26_lc_alphabet[quotient % radix]; \
+ }
+
+#define UINTTYPE_AS_ALPHA(inttype, number, uc, ibuf, psize) \
+ char *p, *e; \
+ inttype quotient; \
+ e = p = end_of_integer_buffer(ibuf); *p = '\0'; \
+ if (uc) { number_printrev_unsigned_alpha_uc(p, number, 26, quotient); } \
+ else { number_printrev_unsigned_alpha_lc(p, number, 26, quotient); } \
+ *psize = (size_t)(e - p)
+
+char * uint32_as_alpha (uint32_t number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_ALPHA(uint32_t, number, uc, ibuf, psize);
+ return p;
+}
+
+char * ulong_as_alpha (unsigned long number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_ALPHA(unsigned long, number, uc, ibuf, psize);
+ return p;
+}
+
+char * usize_as_alpha (size_t number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_ALPHA(size_t, number, uc, ibuf, psize);
+ return p;
+}
+
+char * uint64_as_alpha (uint64_t number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize)
+{
+ UINTTYPE_AS_ALPHA(uint64_t, number, uc, ibuf, psize);
+ return p;
+}
+
+/* a variant of alphabetic, a, b, c, ..., z, aa, bb, cc, ..., zz (eg. pdf page labelling)
+ watch out: unsafe for large numbers; for buffer size N we can handle max. N * 26. */
+
+#define string_scan_alphan(s, c, number, radix) \
+ do { \
+ number = 0; \
+ if ((c = (uint16_t)base26_value(*s)) > 0) { \
+ number = c; \
+ while (c == (uint16_t)base26_value(*++s)) number += radix; \
+ } \
+ } while (0)
+
+const char * alphan_to_uint16 (const char *s, uint16_t *number)
+{
+ uint16_t c;
+ string_scan_alphan(s, c, *number, 26);
+ return s;
+}
+
+#define number_print_alphan_uc(p, e, c, number, radix) \
+ for (c = (--number) % radix, number -= c; ; number -= radix) { \
+ *p++ = base26_uc_alphabet[c]; \
+ if (number == 0 || p >= e) break; \
+ }
+
+#define number_print_alphan_lc(p, e, c, number, radix) \
+ for (c = (--number) % radix, number -= c; ; number -= radix) { \
+ *p++ = base26_lc_alphabet[c]; \
+ if (number == 0 || p >= e) break; \
+ }
+
+#define UINTTYPE_AS_ALPHAN(inttype, number, uc, ibuf, size, psize) \
+ char *p, *e; \
+ uint8_t c; \
+ p = ibuf; \
+ e = p + size; \
+ if (number > 0) { \
+ if (uc) { number_print_alphan_uc(p, e, c, number, 26); } \
+ else { number_print_alphan_lc(p, e, c, number, 26); } \
+ } \
+ *p = '\0'; \
+ *psize = (size_t)(p - ibuf)
+
+char * uint16_as_alphan (uint16_t number, int uc, char ibuf[], size_t size, size_t *psize)
+{
+ UINTTYPE_AS_ALPHAN(uint16_t, number, uc, ibuf, size, psize);
+ return ibuf;
+}
+
+/* roman numeral */
+
+/* large roman numerals? http://mathforum.org/library/drmath/view/57569.html */
+
+#define base_roman_uc_alphabet "MDCLXVI"
+#define base_roman_lc_alphabet "mdclxvi"
+
+char * uint16_as_roman (uint16_t number, int uc, char ibuf[MAX_ROMAN_DIGITS], size_t *psize)
+{
+ static const uint32_t base_roman_values[] = { 1000, 500, 100, 50, 10, 5, 1 };
+ const char *alphabet;
+ char *p;
+ uint32_t k, j, v, u, n;
+
+ n = (uint32_t)number; // uint16_t used to limit leding 'M'
+ alphabet = uc ? base_roman_uc_alphabet : base_roman_lc_alphabet;
+ for (p = ibuf, j = 0, v = base_roman_values[0]; n > 0; )
+ {
+ if (n >= v)
+ {
+ *p++ = alphabet[j];
+ n -= v;
+ continue;
+ }
+ if (j & 1)
+ k = j + 1;
+ else
+ k = j + 2;
+ u = base_roman_values[k];
+ if (n + u >= v)
+ {
+ *p++ = alphabet[k];
+ n += u;
+ }
+ else
+ v = base_roman_values[++j];
+ }
+ *p = '\0';
+ *psize = (size_t)(p - ibuf);
+ return ibuf;
+}
+
+/* IEEE-754 */
+
+#define BINARY_MODF 1
+
+#define NOT_A_NUMBER_STRING "NaN"
+#define INFINITY_STRING "INF"
+#define SIGNED_INFINITY 1
+#define SIGNED_ZERO 0
+#define SIGNED_NOT_A_NUMBER 0
+#define RADIX_CHAR '.'
+
+/* double/float to decimal */
+
+typedef struct ieee_double {
+ union {
+ double number;
+ uint64_t bits;
+ };
+ uint64_t fraction;
+ int exponent, sign;
+} ieee_double;
+
+typedef struct ieee_float {
+ union {
+ float number;
+ uint32_t bits;
+ };
+ uint32_t fraction;
+ int exponent, sign;
+} ieee_float;
+
+#define IEEE_DOUBLE_BIAS 1023
+#define IEEE_DOUBLE_MIN_EXPONENT -1023
+#define IEEE_DOUBLE_MAX_EXPONENT (0x7ff - IEEE_DOUBLE_BIAS)
+
+#define IEEE_FLOAT_BIAS 127
+#define IEEE_FLOAT_MIN_EXPONENT -127
+#define IEEE_FLOAT_MAX_EXPONENT (0xff - IEEE_FLOAT_BIAS)
+
+#define ieee_double_fraction(i) (i & 0x000fffffffffffffull)
+#define ieee_double_exponent(i) ((0x7ff & (i >> 52)) - IEEE_DOUBLE_BIAS)
+#define ieee_double_init(ieee_number, number) \
+ ieee_number.number = number, \
+ ieee_number.fraction = ieee_double_fraction(ieee_number.bits), \
+ ieee_number.exponent = ieee_double_exponent(ieee_number.bits)
+
+#define ieee_float_fraction(i) (i & 0x007fffff)
+#define ieee_float_exponent(i) ((0xff & (i >> 23)) - IEEE_FLOAT_BIAS)
+#define ieee_float_init(ieee_number, number) \
+ ieee_number.number = number, \
+ ieee_number.fraction = ieee_float_fraction(ieee_number.bits), \
+ ieee_number.exponent = ieee_float_exponent(ieee_number.bits)
+
+/* special cases */
+
+#define ieee_double_is_zero(ieee_number) (ieee_number.number == 0) // || ieee_double_too_small(ieee_number) ?
+#define ieee_double_too_small(ieee_number) (ieee_number.exponent == 0 && ieee_number.fraction != 0) // denormalized, implicit fracion bit not set
+
+#define ieee_float_is_zero(ieee_number) (ieee_number.number == 0) // || ieee_float_too_small(ieee_number) ?
+#define ieee_float_too_small(ieee_number) (ieee_number.exponent == 0 && ieee_number.fraction != 0)
+
+#define ieee_double_zero_string(ieee_number) (SIGNED_ZERO && ieee_number.sign ? "-0" : "0")
+#define ieee_double_infinity_string(ieee_number) (SIGNED_INFINITY && ieee_number.sign ? "-" INFINITY_STRING : INFINITY_STRING)
+
+#define ieee_float_zero_string ieee_double_zero_string
+#define ieee_float_infinity_string ieee_double_infinity_string
+
+#define ieee_double_special_case(ieee_number) (ieee_number.exponent == IEEE_DOUBLE_MAX_EXPONENT)
+#define ieee_double_special_string(ieee_number) (ieee_number.fraction ? NOT_A_NUMBER_STRING : ieee_double_infinity_string(ieee_number))
+
+#define ieee_float_special_case(ieee_number) (ieee_number.exponent == IEEE_FLOAT_MAX_EXPONENT)
+#define ieee_float_special_string(ieee_number) (ieee_number.fraction ? NOT_A_NUMBER_STRING : ieee_float_infinity_string(ieee_number))
+
+#if 0
+
+const double double_binary_power10[] =
+{
+ 1.0e1, 1.0e2, 1.0e4, 1.0e8, 1.0e16, 1.0e32, 1.0e64, 1.0e128, 1.0e256
+};
+
+const float float_binary_power10[] =
+{
+ 1.0e1, 1.0e2, 1.0e4, 1.0e8, 1.0e16, 1.0e32
+};
+
+const double double_binary_negpower10[] =
+{
+ 1.0e-1, 1.0e-2, 1.0e-4, 1.0e-8, 1.0e-16, 1.0e-32
+};
+
+const float float_binary_negpower10[] =
+{
+ 1.0e-1, 1.0e-2, 1.0e-4, 1.0e-8, 1.0e-16, 1.0e-32
+};
+
+#else
+
+const double double_decimal_power10[] = {
+ 1.0e0, 1.0e1, 1.0e2, 1.0e3, 1.0e4, 1.0e5, 1.0e6, 1.0e7, 1.0e8, 1.0e9,
+ 1.0e10, 1.0e11, 1.0e12, 1.0e13, 1.0e14, 1.0e15, 1.0e16, 1.0e17, 1.0e18, 1.0e19,
+ 1.0e20, 1.0e21, 1.0e22, 1.0e23, 1.0e24, 1.0e25, 1.0e26, 1.0e27, 1.0e28, 1.0e29,
+ 1.0e30, 1.0e31, 1.0e32, 1.0e33, 1.0e34, 1.0e35, 1.0e36, 1.0e37, 1.0e38, 1.0e39,
+ 1.0e40, 1.0e41, 1.0e42, 1.0e43, 1.0e44, 1.0e45, 1.0e46, 1.0e47, 1.0e48, 1.0e49,
+ 1.0e50, 1.0e51, 1.0e52, 1.0e53, 1.0e54, 1.0e55, 1.0e56, 1.0e57, 1.0e58, 1.0e59,
+ 1.0e60, 1.0e61, 1.0e62, 1.0e63, 1.0e64, 1.0e65, 1.0e66, 1.0e67, 1.0e68, 1.0e69,
+ 1.0e70, 1.0e71, 1.0e72, 1.0e73, 1.0e74, 1.0e75, 1.0e76, 1.0e77, 1.0e78, 1.0e79,
+ 1.0e80, 1.0e81, 1.0e82, 1.0e83, 1.0e84, 1.0e85, 1.0e86, 1.0e87, 1.0e88, 1.0e89,
+ 1.0e90, 1.0e91, 1.0e92, 1.0e93, 1.0e94, 1.0e95, 1.0e96, 1.0e97, 1.0e98, 1.0e99,
+ 1.0e100, 1.0e101, 1.0e102, 1.0e103, 1.0e104, 1.0e105, 1.0e106, 1.0e107, 1.0e108, 1.0e109,
+ 1.0e110, 1.0e111, 1.0e112, 1.0e113, 1.0e114, 1.0e115, 1.0e116, 1.0e117, 1.0e118, 1.0e119,
+ 1.0e120, 1.0e121, 1.0e122, 1.0e123, 1.0e124, 1.0e125, 1.0e126, 1.0e127, 1.0e128, 1.0e129,
+ 1.0e130, 1.0e131, 1.0e132, 1.0e133, 1.0e134, 1.0e135, 1.0e136, 1.0e137, 1.0e138, 1.0e139,
+ 1.0e140, 1.0e141, 1.0e142, 1.0e143, 1.0e144, 1.0e145, 1.0e146, 1.0e147, 1.0e148, 1.0e149,
+ 1.0e150, 1.0e151, 1.0e152, 1.0e153, 1.0e154, 1.0e155, 1.0e156, 1.0e157, 1.0e158, 1.0e159,
+ 1.0e160, 1.0e161, 1.0e162, 1.0e163, 1.0e164, 1.0e165, 1.0e166, 1.0e167, 1.0e168, 1.0e169,
+ 1.0e170, 1.0e171, 1.0e172, 1.0e173, 1.0e174, 1.0e175, 1.0e176, 1.0e177, 1.0e178, 1.0e179,
+ 1.0e180, 1.0e181, 1.0e182, 1.0e183, 1.0e184, 1.0e185, 1.0e186, 1.0e187, 1.0e188, 1.0e189,
+ 1.0e190, 1.0e191, 1.0e192, 1.0e193, 1.0e194, 1.0e195, 1.0e196, 1.0e197, 1.0e198, 1.0e199,
+ 1.0e200, 1.0e201, 1.0e202, 1.0e203, 1.0e204, 1.0e205, 1.0e206, 1.0e207, 1.0e208, 1.0e209,
+ 1.0e210, 1.0e211, 1.0e212, 1.0e213, 1.0e214, 1.0e215, 1.0e216, 1.0e217, 1.0e218, 1.0e219,
+ 1.0e220, 1.0e221, 1.0e222, 1.0e223, 1.0e224, 1.0e225, 1.0e226, 1.0e227, 1.0e228, 1.0e229,
+ 1.0e230, 1.0e231, 1.0e232, 1.0e233, 1.0e234, 1.0e235, 1.0e236, 1.0e237, 1.0e238, 1.0e239,
+ 1.0e240, 1.0e241, 1.0e242, 1.0e243, 1.0e244, 1.0e245, 1.0e246, 1.0e247, 1.0e248, 1.0e249,
+ 1.0e250, 1.0e251, 1.0e252, 1.0e253, 1.0e254, 1.0e255, 1.0e256, 1.0e257, 1.0e258, 1.0e259,
+ 1.0e260, 1.0e261, 1.0e262, 1.0e263, 1.0e264, 1.0e265, 1.0e266, 1.0e267, 1.0e268, 1.0e269,
+ 1.0e270, 1.0e271, 1.0e272, 1.0e273, 1.0e274, 1.0e275, 1.0e276, 1.0e277, 1.0e278, 1.0e279,
+ 1.0e280, 1.0e281, 1.0e282, 1.0e283, 1.0e284, 1.0e285, 1.0e286, 1.0e287, 1.0e288, 1.0e289,
+ 1.0e290, 1.0e291, 1.0e292, 1.0e293, 1.0e294, 1.0e295, 1.0e296, 1.0e297, 1.0e298, 1.0e299,
+ 1.0e300, 1.0e301, 1.0e302, 1.0e303, 1.0e304, 1.0e305, 1.0e306, 1.0e307, 1.0e308
+};
+
+const float float_decimal_power10[] = {
+ 1.0e0f, 1.0e1f, 1.0e2f, 1.0e3f, 1.0e4f, 1.0e5f, 1.0e6f, 1.0e7f, 1.0e8f, 1.0e9f,
+ 1.0e10f, 1.0e11f, 1.0e12f, 1.0e13f, 1.0e14f, 1.0e15f, 1.0e16f, 1.0e17f, 1.0e18f, 1.0e19f,
+ 1.0e20f, 1.0e21f, 1.0e22f, 1.0e23f, 1.0e24f, 1.0e25f, 1.0e26f, 1.0e27f, 1.0e28f, 1.0e29f,
+ 1.0e30f, 1.0e31f, 1.0e32f, 1.0e33f, 1.0e34f, 1.0e35f, 1.0e36f, 1.0e37f, 1.0e38f
+};
+
+const double double_decimal_negpower10[] = {
+ 1.0e0, 1.0e-1, 1.0e-2, 1.0e-3, 1.0e-4, 1.0e-5, 1.0e-6, 1.0e-7, 1.0e-8, 1.0e-9,
+ 1.0e-10, 1.0e-11, 1.0e-12, 1.0e-13, 1.0e-14, 1.0e-15, 1.0e-16, 1.0e-17, 1.0e-18, 1.0e-19,
+ 1.0e-20, 1.0e-21, 1.0e-22, 1.0e-23, 1.0e-24, 1.0e-25, 1.0e-26, 1.0e-27, 1.0e-28, 1.0e-29,
+ 1.0e-30, 1.0e-31, 1.0e-32, 1.0e-33, 1.0e-34, 1.0e-35, 1.0e-36, 1.0e-37, 1.0e-38, 1.0e-39,
+ 1.0e-40, 1.0e-41, 1.0e-42, 1.0e-43, 1.0e-44, 1.0e-45, 1.0e-46, 1.0e-47, 1.0e-48, 1.0e-49,
+ 1.0e-50, 1.0e-51, 1.0e-52, 1.0e-53, 1.0e-54, 1.0e-55, 1.0e-56, 1.0e-57, 1.0e-58, 1.0e-59,
+ 1.0e-60, 1.0e-61, 1.0e-62, 1.0e-63, 1.0e-64, 1.0e-65, 1.0e-66, 1.0e-67, 1.0e-68, 1.0e-69,
+ 1.0e-70, 1.0e-71, 1.0e-72, 1.0e-73, 1.0e-74, 1.0e-75, 1.0e-76, 1.0e-77, 1.0e-78, 1.0e-79,
+ 1.0e-80, 1.0e-81, 1.0e-82, 1.0e-83, 1.0e-84, 1.0e-85, 1.0e-86, 1.0e-87, 1.0e-88, 1.0e-89,
+ 1.0e-90, 1.0e-91, 1.0e-92, 1.0e-93, 1.0e-94, 1.0e-95, 1.0e-96, 1.0e-97, 1.0e-98, 1.0e-99,
+ 1.0e-100, 1.0e-101, 1.0e-102, 1.0e-103, 1.0e-104, 1.0e-105, 1.0e-106, 1.0e-107, 1.0e-108, 1.0e-109,
+ 1.0e-110, 1.0e-111, 1.0e-112, 1.0e-113, 1.0e-114, 1.0e-115, 1.0e-116, 1.0e-117, 1.0e-118, 1.0e-119,
+ 1.0e-120, 1.0e-121, 1.0e-122, 1.0e-123, 1.0e-124, 1.0e-125, 1.0e-126, 1.0e-127, 1.0e-128, 1.0e-129,
+ 1.0e-130, 1.0e-131, 1.0e-132, 1.0e-133, 1.0e-134, 1.0e-135, 1.0e-136, 1.0e-137, 1.0e-138, 1.0e-139,
+ 1.0e-140, 1.0e-141, 1.0e-142, 1.0e-143, 1.0e-144, 1.0e-145, 1.0e-146, 1.0e-147, 1.0e-148, 1.0e-149,
+ 1.0e-150, 1.0e-151, 1.0e-152, 1.0e-153, 1.0e-154, 1.0e-155, 1.0e-156, 1.0e-157, 1.0e-158, 1.0e-159,
+ 1.0e-160, 1.0e-161, 1.0e-162, 1.0e-163, 1.0e-164, 1.0e-165, 1.0e-166, 1.0e-167, 1.0e-168, 1.0e-169,
+ 1.0e-170, 1.0e-171, 1.0e-172, 1.0e-173, 1.0e-174, 1.0e-175, 1.0e-176, 1.0e-177, 1.0e-178, 1.0e-179,
+ 1.0e-180, 1.0e-181, 1.0e-182, 1.0e-183, 1.0e-184, 1.0e-185, 1.0e-186, 1.0e-187, 1.0e-188, 1.0e-189,
+ 1.0e-190, 1.0e-191, 1.0e-192, 1.0e-193, 1.0e-194, 1.0e-195, 1.0e-196, 1.0e-197, 1.0e-198, 1.0e-199,
+ 1.0e-200, 1.0e-201, 1.0e-202, 1.0e-203, 1.0e-204, 1.0e-205, 1.0e-206, 1.0e-207, 1.0e-208, 1.0e-209,
+ 1.0e-210, 1.0e-211, 1.0e-212, 1.0e-213, 1.0e-214, 1.0e-215, 1.0e-216, 1.0e-217, 1.0e-218, 1.0e-219,
+ 1.0e-220, 1.0e-221, 1.0e-222, 1.0e-223, 1.0e-224, 1.0e-225, 1.0e-226, 1.0e-227, 1.0e-228, 1.0e-229,
+ 1.0e-230, 1.0e-231, 1.0e-232, 1.0e-233, 1.0e-234, 1.0e-235, 1.0e-236, 1.0e-237, 1.0e-238, 1.0e-239,
+ 1.0e-240, 1.0e-241, 1.0e-242, 1.0e-243, 1.0e-244, 1.0e-245, 1.0e-246, 1.0e-247, 1.0e-248, 1.0e-249,
+ 1.0e-250, 1.0e-251, 1.0e-252, 1.0e-253, 1.0e-254, 1.0e-255, 1.0e-256, 1.0e-257, 1.0e-258, 1.0e-259,
+ 1.0e-260, 1.0e-261, 1.0e-262, 1.0e-263, 1.0e-264, 1.0e-265, 1.0e-266, 1.0e-267, 1.0e-268, 1.0e-269,
+ 1.0e-270, 1.0e-271, 1.0e-272, 1.0e-273, 1.0e-274, 1.0e-275, 1.0e-276, 1.0e-277, 1.0e-278, 1.0e-279,
+ 1.0e-280, 1.0e-281, 1.0e-282, 1.0e-283, 1.0e-284, 1.0e-285, 1.0e-286, 1.0e-287, 1.0e-288, 1.0e-289,
+ 1.0e-290, 1.0e-291, 1.0e-292, 1.0e-293, 1.0e-294, 1.0e-295, 1.0e-296, 1.0e-297, 1.0e-298, 1.0e-299,
+ 1.0e-300, 1.0e-301, 1.0e-302, 1.0e-303, 1.0e-304, 1.0e-305, 1.0e-306, 1.0e-307, 1.0e-308
+};
+
+const float float_decimal_negpower10[] = {
+ 1.0e0f, 1.0e-1f, 1.0e-2f, 1.0e-3f, 1.0e-4f, 1.0e-5f, 1.0e-6f, 1.0e-7f, 1.0e-8f, 1.0e-9f,
+ 1.0e-10f, 1.0e-11f, 1.0e-12f, 1.0e-13f, 1.0e-14f, 1.0e-15f, 1.0e-16f, 1.0e-17f, 1.0e-18f, 1.0e-19f,
+ 1.0e-20f, 1.0e-21f, 1.0e-22f, 1.0e-23f, 1.0e-24f, 1.0e-25f, 1.0e-26f, 1.0e-27f, 1.0e-28f, 1.0e-29f,
+ 1.0e-30f, 1.0e-31f, 1.0e-32f, 1.0e-33f, 1.0e-34f, 1.0e-35f, 1.0e-36f, 1.0e-37f, 1.0e-38f
+};
+
+#endif
+
+/* scale number by floor(log10(number)) + 1 so that the result is in range [0.1, 1) */
+
+#define ieee_double_exponent10(ieee_number) ((int)floor(log10(ieee_number.number)) + 1)
+#define ieee_float_exponent10(ieee_number) ((int)floorf(log10f(ieee_number.number)) + 1) // floorf, log10f ?
+
+#define ieee_double_exp10(ieee_number, exponent10) \
+ exponent10 = ieee_double_exponent10(ieee_number); \
+ if (exponent10 > 0) { \
+ double_negative_exp10(ieee_number.number, -exponent10); \
+ ieee_number.fraction = ieee_double_fraction(ieee_number.bits); \
+ ieee_number.exponent = ieee_double_exponent(ieee_number.bits); \
+ } else if (exponent10 < 0) { \
+ double_positive_exp10(ieee_number.number, -exponent10); \
+ ieee_number.fraction = ieee_double_fraction(ieee_number.bits); \
+ ieee_number.exponent = ieee_double_exponent(ieee_number.bits); \
+ }
+
+#define ieee_float_exp10(ieee_number, exponent10) \
+ exponent10 = ieee_float_exponent10(ieee_number); \
+ if (exponent10 > 0) { \
+ float_negative_exp10(ieee_number.number, -exponent10); \
+ ieee_number.fraction = ieee_float_fraction(ieee_number.bits); \
+ ieee_number.exponent = ieee_float_exponent(ieee_number.bits); \
+ } else if (exponent10 < 0) { \
+ float_positive_exp10(ieee_number.number, -exponent10); \
+ ieee_number.fraction = ieee_float_fraction(ieee_number.bits); \
+ ieee_number.exponent = ieee_float_exponent(ieee_number.bits); \
+ }
+
+#if BINARY_MODF
+
+/* unhide implicit bit 53, produce 56-bit denormalised fraction (binary exponent already in range [-4, -1]) */
+
+#define ieee_double_denormalize(ieee_number) \
+ (ieee_number.exponent == IEEE_DOUBLE_MIN_EXPONENT ? (++ieee_number.exponent, 0) : (ieee_number.fraction |= (1ull<<52))), \
+ ieee_number.fraction <<= (ieee_number.exponent + 4)
+
+/* unhide implicit bit 24, produce 27-bit denormalized fraction (binary exponent already in range [-4, -1]) */
+
+#define ieee_float_denormalize(ieee_number) \
+ (ieee_number.exponent == IEEE_FLOAT_MIN_EXPONENT ? (++ieee_number.exponent, 0) : (ieee_number.fraction |= (1<<23))), \
+ ieee_number.fraction <<= (ieee_number.exponent + 4)
+
+/* turn off significant bits over 56 (integer part), multiply by 10, return new integer part (subsequent decimal digit) */
+
+#define ieee_double_binary_fraction(ieee_number) \
+ (ieee_number.fraction &= ((1ull<<56) - 1), \
+ ieee_number.fraction = (ieee_number.fraction << 1) + (ieee_number.fraction << 3), \
+ ieee_number.fraction >> 56)
+
+/* turn off significant bits over 27 (integer part), multiply by 10, return the integer part (subsequent decimal digit) */
+
+#define ieee_float_binary_fraction(ieee_number) \
+ (ieee_number.fraction &= ((1<<27) - 1), \
+ ieee_number.fraction = (ieee_number.fraction << 1) + (ieee_number.fraction << 3), \
+ ieee_number.fraction >> 27)
+
+#define ieee_double_decimal(ieee_number, exponent10, digits, p) \
+ ieee_number_decimal(ieee_double_binary_fraction, ieee_number, exponent10, digits, p)
+#define ieee_float_decimal(ieee_number, exponent10, digits, p) \
+ ieee_number_decimal(ieee_float_binary_fraction, ieee_number, exponent10, digits, p)
+
+#else
+
+/* generic method */
+
+#define ieee_double_decimal_fraction(ieee_number, i) (ieee_number.number = modf(10*ieee_number.number, &i), i)
+#define ieee_float_decimal_fraction(ieee_number, i) (ieee_number.number = (float)modf(10*ieee_number.number, &i), i) // ???
+
+#define ieee_double_decimal(ieee_number, exponent10, digits, p) \
+ ieee_number_decimal(ieee_double_decimal_fraction, ieee_number, exponent10, digits, p)
+#define ieee_float_decimal(ieee_number, exponent10, digits, p) \
+ ieee_number_decimal(ieee_float_decimal_fraction, ieee_number, exponent10, digits, p)
+
+#endif
+
+#define ieee_number_decimal(method, ieee_number, exponent10, digits, p) \
+ ieee_double_denormalize(ieee_number); \
+ if (ieee_number.sign) *p++ = '-'; \
+ if (exponent10 <= 0) \
+ for (*p++ = '0', *p++ = RADIX_CHAR; exponent10 && digits; *p++ = '0', ++exponent10, --digits); \
+ else \
+ { \
+ do { *p++ = '0' + (char)method(ieee_number); } while (--exponent10); \
+ *p++ = RADIX_CHAR; \
+ } \
+ for ( ; digits && ieee_number.fraction; --digits) \
+ *p++ = '0' + (char)method(ieee_number)
+
+/* rounding to nearest integer */
+
+#if BINARY_MODF
+/* check if the mantissa has the most significant bit set, means >= 0.5 */
+# define ieee_double_half(ieee_number) (ieee_number.fraction & (1ull<<55))
+# define ieee_float_half(ieee_number) (ieee_number.fraction & (1<<26))
+#else
+# define ieee_double_half(ieee_number) (ieee_number.number >= 0.5)
+# define ieee_float_half(ieee_number) (ieee_number.number >= 0.5)
+#endif
+
+/* rounding to nearest integer */
+
+#define buffer_ceil(s, p, sign) \
+ { \
+ while (*--p == '9'); \
+ if (*p != RADIX_CHAR) ++*p++; \
+ else { \
+ char *q; \
+ for (q = p - 1; ; --q) { \
+ if (*q < '9') { ++*q; break; } \
+ *q = '0'; \
+ if (q == s) \
+ *--s = '1'; \
+ else if (sign && q - 1 == s) \
+ *s = '1', *--s = '-'; \
+ } \
+ } \
+ }
+
+#define buffer_remove_trailing_zeros(s, p, sign) \
+ { \
+ while (*--p == '0'); \
+ if (*p != RADIX_CHAR) \
+ ++p; \
+ else if (!SIGNED_ZERO && sign && p - 2 == s && *(p - 1) == '0') \
+ p -= 2, *p++ = '0'; \
+ }
+
+// if digits parameter was initially less then exponent10, then exponent10 > 0 and ieee_double_half(ieee_number) is irrelevant
+#define ieee_double_round(ieee_number, exponent10, s, p) \
+ if (exponent10 == 0 && ieee_double_half(ieee_number)) \
+ { buffer_ceil(s, p, ieee_number.sign); } \
+ else \
+ { buffer_remove_trailing_zeros(s, p, ieee_number.sign); }
+
+#define ieee_float_round(ieee_number, exponent10, s, p) \
+ if (exponent10 == 0 && ieee_float_half(ieee_number)) \
+ { buffer_ceil(s, p, ieee_number.sign); } \
+ else \
+ { buffer_remove_trailing_zeros(s, p, ieee_number.sign); }
+
+/* double to decimal */
+
+#define ieee_copy_special_string(nbuf, special, p, _p) \
+ for (p = nbuf, _p = special; ; ++p, ++_p) { \
+ if ((*p = *_p) == '\0') break; \
+ }
+
+#define ieee_copy_special_string_re(nbuf, special, p, _p, r, e) \
+ for (p = nbuf, _p = special; ; ++p, ++_p) { \
+ if ((*p = *_p) == '\0') { \
+ if (r != NULL) *r = NULL; \
+ if (e != NULL) *e = p; \
+ break; \
+ } \
+ }
+
+char * double_as_string (double number, int digits, char nbuf[MAX_NUMBER_DIGITS], size_t *psize)
+{
+ ieee_double ieee_number;
+ int exponent10;
+ char *s, *p; const char *_p;
+ s = p = nbuf + 1; // for sign/rounding
+ ieee_double_init(ieee_number, number);
+ if ((ieee_number.sign = ieee_number.bits >> 63) != 0)
+ ieee_number.number = -ieee_number.number;
+ if (ieee_double_is_zero(ieee_number)) // to avoid crash on log10(number)
+ {
+ ieee_copy_special_string(nbuf, ieee_double_zero_string(ieee_number), p, _p);
+ *psize = (size_t)(p - nbuf);
+ return nbuf;
+ }
+ if (ieee_double_special_case(ieee_number))
+ {
+ ieee_copy_special_string(nbuf, ieee_double_special_string(ieee_number), p, _p);
+ *psize = (size_t)(p - nbuf);
+ return nbuf;
+ }
+ ieee_double_exp10(ieee_number, exponent10);
+ ieee_double_decimal(ieee_number, exponent10, digits, p);
+ ieee_double_round(ieee_number, exponent10, s, p);
+ *p = '\0';
+ *psize = (size_t)(p - s);
+ return s;
+}
+
+/* float to decimal */
+
+char * float_as_string (float number, int digits, char nbuf[MAX_NUMBER_DIGITS], size_t *psize)
+{
+ ieee_float ieee_number;
+ int exponent10;
+ char *s, *p; const char *_p;
+ s = p = nbuf + 1; // for sign/rounding
+ ieee_float_init(ieee_number, number);
+ if ((ieee_number.sign = ieee_number.bits >> 31) != 0)
+ ieee_number.number = -ieee_number.number;
+ if (ieee_float_is_zero(ieee_number))
+ {
+ ieee_copy_special_string(nbuf, ieee_float_zero_string(ieee_number), p, _p);
+ *psize = (size_t)(p - nbuf);
+ return nbuf;
+ }
+ if (ieee_float_special_case(ieee_number))
+ {
+ ieee_copy_special_string(nbuf, ieee_float_special_string(ieee_number), p, _p);
+ *psize = (size_t)(p - nbuf);
+ return nbuf;
+ }
+ ieee_float_exp10(ieee_number, exponent10);
+ ieee_float_decimal(ieee_number, exponent10, digits, p);
+ ieee_float_round(ieee_number, exponent10, s, p);
+ *p = '\0';
+ *psize = (size_t)(p - s);
+ return s;
+}
+
+/* decimal string to double/float */
+
+#define string_scan_decimal(s, c, number) _scan_decimal(c, number, *++s)
+#define string_scan_fraction(s, c, number, exponent10) _scan_fraction(c, number, exponent10, *++s)
+#define string_scan_exponent10(s, c, exponent10) _scan_exponent10(c, exponent10, *++s)
+
+const char * string_to_double (const char *s, double *number)
+{
+ int sign, exponent10, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_decimal(s, c, *number);
+ if (c == '.')
+ {
+ c = *++s;
+ string_scan_fraction(s, c, *number, exponent10);
+ }
+ else
+ exponent10 = 0;
+ if (c == 'e' || c == 'E')
+ {
+ c = *++s;
+ string_scan_exponent10(s, c, exponent10);
+ }
+ double_exp10(*number, exponent10);
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * string_to_float (const char *s, float *number)
+{
+ int sign, exponent10, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_decimal(s, c, *number);
+ if (c == '.')
+ {
+ c = *++s;
+ string_scan_fraction(s, c, *number, exponent10);
+ }
+ else
+ exponent10 = 0;
+ if (c == 'e' || c == 'E')
+ {
+ c = *++s;
+ string_scan_exponent10(s, c, exponent10);
+ }
+ float_exp10(*number, exponent10);
+ if (sign) *number = -*number;
+ return s;
+}
+
+/* conventional form */
+
+const char * convert_to_double (const char *s, double *number)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_decimal(s, c, *number);
+ if (c == '.' || c == ',')
+ {
+ int exponent10;
+ c = *++s;
+ string_scan_fraction(s, c, *number, exponent10);
+ if (exponent10 < 0)
+ double_negative_exp10(*number, exponent10);
+ }
+ if (sign) *number = -*number;
+ return s;
+}
+
+const char * convert_to_float (const char *s, float *number)
+{
+ int sign, c = *s;
+ string_scan_sign(s, c, sign);
+ string_scan_decimal(s, c, *number);
+ if (c == '.' || c == ',')
+ {
+ int exponent10;
+ c = *++s;
+ string_scan_fraction(s, c, *number, exponent10);
+ if (exponent10 < 0)
+ float_negative_exp10(*number, exponent10);
+ }
+ if (sign) *number = -*number;
+ return s;
+}
+
+/* pretty common stuff */
+
+size_t bytes_to_hex_lc (const void *input, size_t size, unsigned char *output)
+{
+ size_t i;
+ const unsigned char *p;
+ for (i = 0, p = (const unsigned char *)input; i < size; ++i, ++p)
+ {
+ *output++ = base16_lc_digit1(*p);
+ *output++ = base16_lc_digit2(*p);
+ }
+ *output = '\0';
+ return 2*size + 1;
+}
+
+size_t bytes_to_hex_uc (const void *input, size_t size, unsigned char *output)
+{
+ size_t i;
+ const unsigned char *p;
+ for (i = 0, p = (const unsigned char *)input; i < size; ++i, ++p)
+ {
+ *output++ = base16_uc_digit1(*p);
+ *output++ = base16_uc_digit2(*p);
+ }
+ *output = '\0';
+ return 2*size + 1;
+}
+
+size_t hex_to_bytes (const void *input, size_t size, unsigned char *output)
+{
+ size_t i;
+ int c1, c2;
+ const unsigned char *p;
+ for (i = 1, p = (const unsigned char *)input; i < size; i += 2)
+ {
+ c1 = base16_value(*p);
+ ++p;
+ c2 = base16_value(*p);
+ ++p;
+ if (c1 >= 0 && c2 >= 0)
+ *output++ = (unsigned char)((c1<<4)|c2);
+ else
+ break;
+ }
+ return i >> 1;
+}
+
+void print_as_hex (const void *input, size_t bytes)
+{
+ const unsigned char *p;
+ for (p = (const unsigned char *)input; bytes > 0; --bytes, ++p)
+ printf("%02x", *p);
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilnumber.h b/source/luametatex/source/libraries/pplib/util/utilnumber.h
new file mode 100644
index 000000000..735432b8d
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilnumber.h
@@ -0,0 +1,428 @@
+#ifndef UTIL_NUMBER_H
+#define UTIL_NUMBER_H
+
+#include <stddef.h> // for size_t
+
+#include "utilplat.h"
+#include "utildecl.h"
+
+#if defined(__cplusplus) && defined(_MSC_VER)
+// int*_t types are in standard in msvc++
+#else
+# include <stdint.h>
+#endif
+
+/* 'long' isn't long for msvc64/mingw64, we need a type for machine word */
+
+#if defined(_WIN64) || defined(__MINGW32__)
+# define INT64F "%I64d"
+# define UINT64F "%I64u"
+#else
+# define INT64F "%lld"
+# define UINT64F "%llu"
+#endif
+
+#if defined(MSVC64)
+# define INTLW_IS_INT64
+# define intlw_t int64_t
+# define uintlw_t uint64_t
+# define INTLW(N) N##I64
+# define UINTLW(N) N##UI64
+# define INTLWF INT64F
+# define UINTLWF UINT64F
+#elif defined(__MINGW64__)
+# define INTLW_IS_INT64
+# define intlw_t int64_t
+# define uintlw_t uint64_t
+# define INTLW(N) N##LL
+# define UINTLW(N) N##ULL
+# define INTLWF INT64F
+# define UINTLWF UINT64F
+#else // 32bit or sane 64bit (LP64)
+# define INTLW_IS_LONG
+# define intlw_t long
+# define uintlw_t unsigned long
+# define INTLW(N) N##L
+# define UINTLW(N) N##UL
+# define INTLWF "%ld"
+# define UINTLWF "%lu"
+#endif
+
+// ssize_t is missing in MSVC, but defining it is risky; some environments (eg. python) typedefs ssize_t on its own way..
+// #if defined(MSVC64)
+// # define ssize_t int32_t
+// #else
+// # if defined(MSVC32)
+// # define ssize_t int64_t
+// # endif
+// #endif
+
+/* basic constants */
+
+#define MAX_RADIX 36
+#define MAX_INTEGER_DIGITS 65 /* 64-bit number in binary form plus '\0' */
+#define MAX_ROMAN_DIGITS 128 /* to handle romannumeral of short int (up to 65 leading 'M') */
+#define MAX_NUMBER_DIGITS 512
+#define NUMBER_BUFFER_SIZE MAX_NUMBER_DIGITS
+
+#define base36_uc_alphabet "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+#define base36_lc_alphabet "0123456789abcdefghijklmnopqrstuvwxyz"
+
+#define base26_uc_alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+#define base26_lc_alphabet "abcdefghijklmnopqrstuvwxyz"
+extern const int base26_lookup[];
+
+#define base36_lc_palindrome "zyxwvutsrqponmlkjihgfedcba9876543210123456789abcdefghijklmnopqrstuvwxyz"
+#define base36_uc_palindrome "ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+extern const int base36_lookup[];
+
+#define base10_palindrome "9876543210123456789"
+#define base10_alphabet "0123456789"
+extern const int base10_lookup[];
+
+#define base16_uc_alphabet "0123456789ABCDEF"
+#define base16_lc_alphabet "0123456789abcdef"
+extern const int base16_lookup[];
+
+#define base16_uc_digit1(c) base16_uc_alphabet[(c)>>4]
+#define base16_uc_digit2(c) base16_uc_alphabet[(c)&15]
+#define base16_lc_digit1(c) base16_lc_alphabet[(c)>>4]
+#define base16_lc_digit2(c) base16_lc_alphabet[(c)&15]
+
+#define base8_digit(c) ((unsigned)(c - '0') <= (unsigned)('7' - '0'))
+#define base8_value(c) (base8_digit(c) ? (c) - '0' : -1)
+
+#define base10_digit(c) ((unsigned)(c - '0') <= (unsigned)('9' - '0'))
+#define base10_value(c) (base10_lookup[(uint8_t)(c)])
+
+#define base16_digit(c) (base16_lookup[(uint8_t)(c)] >= 0)
+#define base16_value(c) (base16_lookup[(uint8_t)(c)])
+
+#define base26_digit(c) (base26_lookup[(uint8_t)(c)] >= 0)
+#define base26_value(c) (base26_lookup[(uint8_t)(c)])
+
+#define base36_digit(c) (base36_lookup[(uint8_t)(c)] >= 0)
+#define base36_value(c) (base36_lookup[(uint8_t)(c)])
+
+//#define base_digit(c, radix) ((unsigned)(base36_lookup[c]) < (unsigned)(radix))
+//#define base_value(c, radix) (base_digit(c, radix) ? base36_lookup[c] : -1)
+
+UTILDEF extern char util_number_buffer[NUMBER_BUFFER_SIZE];
+
+/* integer from string; return a pointer to character next to the last digit */
+
+UTILAPI const char * string_to_int32 (const char *s, int32_t *number);
+UTILAPI const char * string_to_slong (const char *s, long *number);
+UTILAPI const char * string_to_int64 (const char *s, int64_t *number);
+
+UTILAPI const char * string_to_uint32 (const char *s, uint32_t *number);
+UTILAPI const char * string_to_ulong (const char *s, unsigned long *number);
+UTILAPI const char * string_to_usize (const char *s, size_t *number);
+UTILAPI const char * string_to_uint64 (const char *s, uint64_t *number);
+
+UTILAPI const char * radix_to_int32 (const char *s, int32_t *number, int radix);
+UTILAPI const char * radix_to_slong (const char *s, long *number, int radix);
+UTILAPI const char * radix_to_int64 (const char *s, int64_t *number, int radix);
+
+UTILAPI const char * radix_to_uint32 (const char *s, uint32_t *number, int radix);
+UTILAPI const char * radix_to_ulong (const char *s, unsigned long *number, int radix);
+UTILAPI const char * radix_to_usize (const char *s, size_t *number, int radix);
+UTILAPI const char * radix_to_uint64 (const char *s, uint64_t *number, int radix);
+
+UTILAPI const char * alpha_to_uint32 (const char *s, uint32_t *number);
+UTILAPI const char * alpha_to_ulong (const char *s, unsigned long *number);
+UTILAPI const char * alpha_to_usize (const char *s, size_t *number);
+UTILAPI const char * alpha_to_uint64 (const char *s, uint64_t *number);
+
+/* integer to string */
+
+UTILAPI char * int32_as_string (int32_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * slong_as_string (long number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * int64_as_string (int64_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+
+#define int32_to_string(number, psize) int32_as_string(number, util_number_buffer, psize)
+#define slong_to_string(number, psize) slong_as_string(number, util_number_buffer, psize)
+#define int64_to_string(number, psize) int64_as_string(number, util_number_buffer, psize)
+
+UTILAPI char * uint32_as_string (uint32_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * ulong_as_string (unsigned long number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * usize_as_string (size_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * uint64_as_string (uint64_t number, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+
+#define uint32_to_string(number, psize) uint32_as_string(number, util_number_buffer, psize)
+#define ulong_to_string(number, psize) ulong_as_string(number, util_number_buffer, psize)
+#define usize_to_string(number, psize) usize_as_string(number, util_number_buffer, psize)
+#define uint64_to_string(number, psize) uint64_as_string(number, util_number_buffer, psize)
+
+UTILAPI char * int32_as_radix (int32_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * slong_as_radix (long number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * int64_as_radix (int64_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+
+#define int32_to_radix(number, radix, uc, psize) int32_as_radix(number, radix, uc, util_number_buffer, psize)
+#define slong_to_radix(number, radix, uc, psize) slong_as_radix(number, radix, uc, util_number_buffer, psize)
+#define int64_to_radix(number, radix, uc, psize) int64_as_radix(number, radix, uc, util_number_buffer, psize)
+
+UTILAPI char * uint32_as_radix (uint32_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * ulong_as_radix (unsigned long number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * usize_as_radix (size_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * uint64_as_radix (uint64_t number, int radix, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+
+#define uint32_to_radix(number, radix, uc, psize) uint32_as_radix(number, radix, uc, util_number_buffer, psize)
+#define ulong_to_radix(number, radix, uc, psize) ulong_as_radix(number, radix, uc, util_number_buffer, psize)
+#define usize_to_radix(number, radix, uc, psize) usize_as_radix(number, radix, uc, util_number_buffer, psize)
+#define uint64_to_radix(number, radix, uc, psize) uint64_as_radix(number, radix, uc, util_number_buffer, psize)
+
+UTILAPI char * uint32_as_alpha (uint32_t number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * ulong_as_alpha (unsigned long number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * usize_as_alpha (size_t number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+UTILAPI char * uint64_as_alpha (uint64_t number, int uc, char ibuf[MAX_INTEGER_DIGITS], size_t *psize);
+
+#define uint32_to_alpha(number, uc, psize) uint32_as_alpha(number, uc, util_number_buffer, psize)
+#define ulong_to_alpha(number, uc, psize) ulong_as_alpha(number, uc, util_number_buffer, psize)
+#define usize_to_alpha(number, uc, psize) usize_as_alpha(number, uc, util_number_buffer, psize)
+#define uint64_to_alpha(number, uc, psize) uint64_as_alpha(number, uc, util_number_buffer, psize)
+
+#if defined(INTLW_IS_INT64)
+
+# define string_to_intlw(s, number) string_to_int64(s, number)
+# define string_to_uintlw(s, number) string_to_uint64(s, number)
+
+# define radix_to_intlw(s, number, radix) radix_to_int64(s, number, radix)
+# define radix_to_uintlw(s, number, radix) radix_to_uint64(s, number, radix)
+
+# define alpha_to_uintlw(s, number) alpha_to_uint64(s, number)
+
+# define intlw_as_string(number, ibuf, psize) int64_as_string(number, ibuf, psize)
+# define uintlw_as_string(number, ibuf, psize) uint64_as_string(number, ibuf, psize)
+
+# define intlw_to_string(number, psize) int64_to_string(number, psize)
+# define uintlw_to_string(number, psize) uint64_to_string(number, psize)
+
+# define intlw_as_radix(number, radix, uc, ibuf, psize) int64_as_radix(number, radix, uc, ibuf, psize)
+# define uintlw_as_radix(number, radix, uc, ibuf, psize) uint64_as_radix(number, radix, uc, ibuf, psize)
+
+# define intlw_to_radix(number, radix, uc, psize) int64_to_radix(number, radix, uc, psize)
+# define uintlw_to_radix(number, radix, uc, psize) uint64_to_radix(number, radix, uc, psize)
+
+# define uintlw_as_alpha(number, uc, ibuf, psize) uint64_as_alpha(number, uc, ibuf, psize)
+# define uintlw_to_alpha(number, uc, psize) uint64_to_alpha(number, uc, ibuf, psize)
+
+#elif defined(INTLW_IS_LONG)
+
+# define string_to_intlw(s, number) string_to_slong(s, number)
+# define string_to_uintlw(s, number) string_to_ulong(s, number)
+
+# define radix_to_intlw(s, number, radix) radix_to_slong(s, number, radix)
+# define radix_to_uintlw(s, number, radix) radix_to_ulong(s, number, radix)
+
+# define alpha_to_uintlw(s, number) alpha_to_ulong(s, number)
+
+# define intlw_as_string(number, ibuf, psize) slong_as_string(number, ibuf, psize)
+# define uintlw_as_string(number, ibuf, psize) ulong_as_string(number, ibuf, psize)
+
+# define intlw_to_string(number, psize) slong_to_string(number, psize)
+# define uintlw_to_string(number, psize) ulong_to_string(number, psize)
+
+# define intlw_as_radix(number, radix, uc, ibuf, psize) slong_as_radix(number, radix, uc, ibuf, psize)
+# define uintlw_as_radix(number, radix, uc, ibuf, psize) ulong_as_radix(number, radix, uc, ibuf, psize)
+
+# define intlw_to_radix(number, radix, uc, psize) slong_to_radix(number, radix, uc, psize)
+# define uintlw_to_radix(number, radix, uc, psize) ulong_to_radix(number, radix, uc, psize)
+
+# define uintlw_as_alpha(number, uc, ibuf, psize) ulong_as_alpha(number, uc, ibuf, psize)
+# define uintlw_to_alpha(number, uc, psize) ulong_to_alpha(number, uc, ibuf, psize)
+
+#endif
+
+/* a..z, aa..zz, aaa..zzz (limited to uint16_t, valid for N <= buffer_size * 26) */
+
+UTILAPI const char * alphan_to_uint16 (const char *s, uint16_t *number);
+UTILAPI char * uint16_as_alphan (uint16_t number, int uc, char ibuf[], size_t size, size_t *psize);
+#define uint16_to_alphan(number, uc, psize) uint16_as_alphan(number, uc, util_number_buffer, NUMBER_BUFFER_SIZE, psize)
+
+/* roman numeral (limited to uint16_t) */
+
+UTILAPI const char * roman_to_uint16 (const char *s, uint16_t *number);
+UTILAPI char * uint16_as_roman (uint16_t number, int uc, char ibuf[MAX_ROMAN_DIGITS], size_t *psize);
+#define uint16_to_roman(number, uc, psize) uint16_as_roman(number, uc, util_number_buffer, psize)
+
+/* double/float to string */
+
+UTILAPI char * double_as_string (double number, int digits, char nbuf[MAX_NUMBER_DIGITS], size_t *psize);
+#define double_to_string(number, digits, psize) double_as_string(number, digits, util_number_buffer, psize)
+
+UTILAPI char * float_as_string (float number, int digits, char nbuf[MAX_NUMBER_DIGITS], size_t *psize);
+#define float_to_string(number, digits, psize) float_as_string(number, digits, util_number_buffer, psize)
+
+/* string to double/float */
+
+UTILAPI const char * string_to_double (const char *s, double *number);
+UTILAPI const char * string_to_float (const char *s, float *number);
+
+/* convenience form accepting comma among a dot, with not exp notation (eg. pdf) */
+
+UTILAPI const char * convert_to_double (const char *s, double *number);
+UTILAPI const char * convert_to_float (const char *s, float *number);
+
+/* binary data parsers helpers */
+
+#if 0 // masking gives more overactive warnings
+#define get_number_byte1(n) ((n) & 0x000000ffu)
+#define get_number_byte2(n) (((n) & 0x0000ff00u) >> 8)
+#define get_number_byte3(n) (((n) & 0x00ff0000u) >> 16)
+#define get_number_byte4(n) (((n) & 0xff000000u) >> 24)
+#define get_number_byte5(n) (((n) & 0x000000ff00000000ull) >> 32)
+#define get_number_byte6(n) (((n) & 0x0000ff0000000000ull) >> 40)
+#define get_number_byte7(n) (((n) & 0x00ff000000000000ull) >> 48)
+#define get_number_byte8(n) (((n) & 0xff00000000000000ull) >> 56)
+#else
+#define get_number_byte1(n) ((n) & 0xff)
+#define get_number_byte2(n) (((n) >> 8) & 0xff)
+#define get_number_byte3(n) (((n) >> 16) & 0xff)
+#define get_number_byte4(n) (((n) >> 24) & 0xff)
+#define get_number_byte5(n) (((n) >> 32) & 0xff)
+#define get_number_byte6(n) (((n) >> 40) & 0xff)
+#define get_number_byte7(n) (((n) >> 48) & 0xff)
+#define get_number_byte8(n) (((n) >> 56) & 0xff)
+#endif
+
+#define get_number_bytes_be1(n, b) (b[0] = (uint8_t)get_number_byte1(n))
+#define get_number_bytes_be2(n, b) (b[0] = (uint8_t)get_number_byte2(n), b[1] = (uint8_t)get_number_byte1(n))
+#define get_number_bytes_be3(n, b) (b[0] = (uint8_t)get_number_byte3(n), b[1] = (uint8_t)get_number_byte2(n), b[2] = (uint8_t)get_number_byte1(n))
+#define get_number_bytes_be4(n, b) (b[0] = (uint8_t)get_number_byte4(n), b[1] = (uint8_t)get_number_byte3(n), b[2] = (uint8_t)get_number_byte2(n), b[3] = (uint8_t)get_number_byte1(n))
+
+#define get_number_bytes_be5(n, b) (b[0] = (uint8_t)get_number_byte5(n), b[1] = (uint8_t)get_number_byte4(n), b[2] = (uint8_t)get_number_byte3(n), b[3] = (uint8_t)get_number_byte2(n), \
+ b[4] = (uint8_t)get_number_byte1(n))
+#define get_number_bytes_be6(n, b) (b[0] = (uint8_t)get_number_byte6(n), b[1] = (uint8_t)get_number_byte5(n), b[2] = (uint8_t)get_number_byte4(n), b[3] = (uint8_t)get_number_byte3(n), \
+ b[4] = (uint8_t)get_number_byte2(n), b[5] = (uint8_t)get_number_byte1(n))
+#define get_number_bytes_be7(n, b) (b[0] = (uint8_t)get_number_byte7(n), b[1] = (uint8_t)get_number_byte6(n), b[2] = (uint8_t)get_number_byte5(n), b[3] = (uint8_t)get_number_byte4(n), \
+ b[4] = (uint8_t)get_number_byte3(n), b[5] = (uint8_t)get_number_byte2(n), b[6] = (uint8_t)get_number_byte1(n))
+#define get_number_bytes_be8(n, b) (b[0] = (uint8_t)get_number_byte8(n), b[1] = (uint8_t)get_number_byte7(n), b[2] = (uint8_t)get_number_byte6(n), b[3] = (uint8_t)get_number_byte5(n), \
+ b[4] = (uint8_t)get_number_byte4(n), b[5] = (uint8_t)get_number_byte3(n), b[6] = (uint8_t)get_number_byte2(n), b[7] = (uint8_t)get_number_byte1(n))
+
+#define read_uint16be_as(s, int_type) ((int_type)((s[0]<<8)|s[1]))
+#define read_uint32be_as(s, int_type) ((int_type)((s[0]<<24)|(s[1]<<16)|(s[2]<<8)|s[3]))
+
+#define read_uint16le_as(s, int_type) ((int_type)((s[1]<<8)|s[0]))
+#define read_uint32le_as(s, int_type) ((int_type)((s[3]<<24)|(s[2]<<16)|(s[1]<<8)|s[0]))
+
+#define read_uint16_native(s) (*((uint16_t *)(s)))
+#define read_uint32_native(s) (*((uint32_t *)(s)))
+#define read_int16_native(s) (*((int16_t *)(s)))
+#define read_int32_native(s) (*((int32_t *)(s)))
+
+#define scan_uint16be_as(s, int_type) (s += 2, (int_type)((s[-2]<<8)|s[-1]))
+#define scan_uint32be_as(s, int_type) (s += 4, (int_type)((s[-4]<<24)|(s[-3]<<16)|(s[-2]<<8)|s[-1]))
+
+#define scan_uint16le_as(s, int_type) (s += 2, (int_type)((s[-1]<<8)|s[-2]))
+#define scan_uint32le_as(s, int_type) (s += 4, (int_type)((s[-1]<<24)|(s[-2]<<16)|(s[-3]<<8)|s[-4]))
+
+#define scan_uint16_native(s) (s += 2, read_uint16_native(s-2))
+#define scan_uint32_native(s) (s += 4, read_uint32_native(s-4))
+#define scan_int16_native(s) (s += 2, read_int16_native(s-2))
+#define scan_int32_native(s) (s += 4, read_int32_native(s-4))
+
+#define read_fixed16_16_as(s, float_type) (((float_type)read_uint32be_as(s, signed int))/(1<<16))
+#define read_fixed2_14_as(s, float_type) (((float_type)read_uint16be_as(s, signed short))/(1<<14))
+
+#define scan_fixed16_16_as(s, float_type) (((float_type)scan_uint32be_as(s, signed int))/(1<<16))
+#define scan_fixed2_14_as(s, float_type) (((float_type)scan_uint16be_as(s, signed short))/(1<<14))
+
+/* internal procedures */
+
+#define _scan_sign(c, sign, next) \
+ do { if (c == '-') { sign = 1; c = next; } else if (c == '+') { sign = 0; c = next; } else sign = 0; } while (0)
+
+#define integer_multiplied10(number) (((number) << 1) + ((number) << 3))
+
+#define _scan_integer(c, number, next) \
+ for (number = 0; base10_digit(c); number = integer_multiplied10(number) + (c - '0'), c = next)
+#define _scan_radix(c, number, radix, next) \
+ for (number = 0; (c = base36_value(c)) >= 0 && c < radix; number = number * radix + c, c = next)
+
+#define _read_integer(c, number, next) \
+ for (number = c - '0', c = next; base10_digit(c); number = integer_multiplied10(number) + (c - '0'), c = next)
+#define _read_radix(c, number, radix, next) \
+ for (number = c - '0', c = next; (c = base36_value(c)) >= 0 && c < radix; number = number * radix + c, c = next)
+
+/* rationals */
+
+#define _scan_decimal(c, number, next) \
+ for (number = 0; base10_digit(c); number = number*10 + (c - '0'), c = next)
+#define _scan_fraction(c, number, exponent10, next) \
+ for (exponent10 = 0; base10_digit(c); --exponent10, number = number*10 + (c - '0'), c = next)
+
+#define _scan_exponent10(c, exponent10, next) \
+ do { \
+ int eexponent10, eexpsign; \
+ _scan_sign(c, eexpsign, next); \
+ _scan_integer(c, eexponent10, next); \
+ if (eexpsign) \
+ exponent10 -= eexponent10; \
+ else \
+ exponent10 += eexponent10; \
+ } while(0)
+
+#if 0
+
+// kept just for sentiment ;)
+
+extern const double double_binary_power10[];
+extern const float float_binary_power10[];
+extern const double double_binary_negpower10[];
+extern const float float_binary_negpower10[];
+
+#define double_negative_exp10(number, exponent) \
+{ const double *bp10; int e = ((exponent) < 511 ? 511 : -(exponent)); \
+ for (bp10 = double_binary_negpower10; e > 0; e >>= 1, ++bp10) \
+ if (e & 1) number *= *bp10; }
+
+#define float_negative_exp10(number, exponent) \
+{ const float *bp10; int e = ((exponent) < 64 ? 64 : -(exponent)); \
+ for (bp10 = float_binary_negpower10; e > 0; e >>= 1, ++bp10) \
+ if (e & 1) number *= *bp10; }
+
+#define double_positive_exp10(number, exponent) \
+{ const double *bp10; int e = ((exponent) > 511 ? 511 : (exponent)); \
+ for (bp10 = double_binary_power10; e > 0; e >>= 1, ++bp10) \
+ if (e & 1) number *= *bp10; }
+
+#define float_positive_exp10(number, exponent) \
+{ const float *bp10; int e = ((exponent) > 64 ? 64 : (exponent)); \
+ for (bp10 = double_binary_power10; e > 0; e >>= 1, ++bp10) \
+ if (e & 1) number *= *bp10; }
+
+#define double_exp10(number, exponent) \
+ if ((exponent) < 0) double_negative_exp10(number, exponent) else if ((exponent) > 0) double_positive_exp10(number, exponent)
+
+#define float_exp10(number, exponent) \
+ if ((exponent) < 0) float_negative_exp10(number, exponent) else if ((exponent) > 0) float_positive_exp10(number, exponent)
+
+#else
+
+extern const double double_decimal_power10[];
+extern const float float_decimal_power10[];
+extern const double double_decimal_negpower10[];
+extern const float float_decimal_negpower10[];
+
+#define double_negative_exp10(number, exponent) ((number) *= double_decimal_negpower10[(exponent) < -308 ? 308 : -(exponent)])
+#define double_positive_exp10(number, exponent) ((number) *= double_decimal_power10[(exponent) > 308 ? 308 : (exponent)])
+
+#define float_negative_exp10(number, exponent) ((number) *= float_decimal_negpower10[(exponent) < -38 ? 38 : -(exponent)])
+#define float_positive_exp10(number, exponent) ((number) *= float_decimal_power10[(exponent) > 38 ? 38 : (exponent)])
+
+#define double_exp10(number, exponent) ((void)(((exponent) < 0 && double_negative_exp10(number, exponent)) || (((exponent) > 0 && double_positive_exp10(number, exponent)))))
+#define float_exp10(number, exponent) ((void)(((exponent) < 0 && float_negative_exp10(number, exponent)) || (((exponent) > 0 && float_positive_exp10(number, exponent)))))
+
+#endif
+
+/* pretty common stuff */
+
+#define bytes_to_hex(input, size, output) bytes_to_hex_lc(input, size, output)
+UTILAPI size_t bytes_to_hex_lc (const void *input, size_t size, uint8_t *output);
+UTILAPI size_t bytes_to_hex_uc (const void *input, size_t size, uint8_t *output);
+UTILAPI size_t hex_to_bytes (const void *input, size_t size, uint8_t *output);
+UTILAPI void print_as_hex (const void *input, size_t bytes);
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilplat.h b/source/luametatex/source/libraries/pplib/util/utilplat.h
new file mode 100644
index 000000000..8838f702b
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilplat.h
@@ -0,0 +1,31 @@
+
+#ifndef UTIL_PLAT_H
+#define UTIL_PLAT_H
+
+#if defined(_WIN32) || defined(WIN32)
+# ifdef _MSC_VER
+# if defined(_M_64) || defined(_WIN64)
+# define MSVC64
+# else
+# define MSVC32
+# endif
+# else
+# if defined(__MINGW64__)
+# define MINGW64
+# else
+# if defined(__MINGW32__)
+# define MINGW32
+# endif
+# endif
+# endif
+#endif
+
+#ifdef __GNUC__
+//# define FALLTHRU [[fallthrough]] // c++17
+//# define FALLTHRU [[gnu:fallthrough]] // c++14
+# define FALLTHRU __attribute__((fallthrough)); // C and C++03
+#else
+# define FALLTHRU
+#endif
+
+#endif \ No newline at end of file
diff --git a/source/luametatex/source/libraries/pplib/util/utilsha.c b/source/luametatex/source/libraries/pplib/util/utilsha.c
new file mode 100644
index 000000000..596bf76f7
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilsha.c
@@ -0,0 +1,1065 @@
+/* sha2 implementation excerpted from code by Aaron D. Gifford */
+
+/*
+ * AUTHOR: Aaron D. Gifford - http://www.aarongifford.com/
+ *
+ * Copyright (c) 2000-2001, Aaron D. Gifford
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. 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.
+ * 3. Neither the name of the copyright holder nor the names of contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTOR(S) ``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 AUTHOR OR CONTRIBUTOR(S) 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.
+ *
+ * $Id: sha2.c,v 1.1 2001/11/08 00:01:51 adg Exp adg $
+ */
+
+#include <stdio.h> /* FILE */
+#include <string.h> /* memcpy()/memset() or bcopy()/bzero() */
+//#include <assert.h> /* assert() */
+#include "utilsha.h"
+
+/*
+ * UNROLLED TRANSFORM LOOP NOTE:
+ * You can define SHA2_UNROLL_TRANSFORM to use the unrolled transform
+ * loop version for the hash transform rounds (defined using macros
+ * later in this file). Either define on the command line, for example:
+ *
+ * cc -DSHA2_UNROLL_TRANSFORM -o sha2 sha2.c sha2prog.c
+ *
+ * or define below:
+ *
+ * #define SHA2_UNROLL_TRANSFORM
+ *
+ */
+
+/*** SHA-256/384/512 Machine Architecture Definitions *****************/
+/*
+ * BYTE_ORDER NOTE:
+ *
+ * Please make sure that your system defines BYTE_ORDER. If your
+ * architecture is little-endian, make sure it also defines
+ * LITTLE_ENDIAN and that the two (BYTE_ORDER and LITTLE_ENDIAN) are
+ * equivilent.
+ *
+ * If your system does not define the above, then you can do so by
+ * hand like this:
+ *
+ * #define LITTLE_ENDIAN 1234
+ * #define BIG_ENDIAN 4321
+ *
+ * And for little-endian machines, add:
+ *
+ * #define BYTE_ORDER LITTLE_ENDIAN
+ *
+ * Or for big-endian machines:
+ *
+ * #define BYTE_ORDER BIG_ENDIAN
+ *
+ * The FreeBSD machine this was written on defines BYTE_ORDER
+ * appropriately by including <sys/types.h> (which in turn includes
+ * <machine/endian.h> where the appropriate definitions are actually
+ * made).
+ */
+
+#ifndef BYTE_ORDER
+#define BYTE_ORDER LITTLE_ENDIAN
+#endif
+
+//#if !defined(BYTE_ORDER) || (BYTE_ORDER != LITTLE_ENDIAN && BYTE_ORDER != BIG_ENDIAN)
+//#error Define BYTE_ORDER to be equal to either LITTLE_ENDIAN or BIG_ENDIAN
+//#endif
+
+/*
+ * Define the following sha2_* types to types of the correct length on
+ * the native archtecture. Most BSD systems and Linux define u_intXX_t
+ * types. Machines with very recent ANSI C headers, can use the
+ * uintXX_t definintions from inttypes.h by defining SHA2_USE_INTTYPES_H
+ * during compile or in the sha.h header file.
+ *
+ * Machines that support neither u_intXX_t nor inttypes.h's uintXX_t
+ * will need to define these three typedefs below (and the appropriate
+ * ones in sha.h too) by hand according to their system architecture.
+ *
+ * Thank you, Jun-ichiro itojun Hagino, for suggesting using u_intXX_t
+ * types and pointing out recent ANSI C support for uintXX_t in inttypes.h.
+ *
+ * PJ: replace by uintX_t
+ */
+
+//typedef uint8_t sha2_byte; /* Exactly 1 byte */
+//typedef uint32_t sha2_word32; /* Exactly 4 bytes */
+//typedef uint64_t sha2_word64; /* Exactly 8 bytes */
+
+/*** SHA-256/384/512 Various Length Definitions ***********************/
+/* NOTE: Most of these are in header */
+#define SHA256_SHORT_BLOCK_LENGTH (SHA256_BLOCK_LENGTH - 8)
+#define SHA384_SHORT_BLOCK_LENGTH (SHA384_BLOCK_LENGTH - 16)
+#define SHA512_SHORT_BLOCK_LENGTH (SHA512_BLOCK_LENGTH - 16)
+
+
+/*** ENDIAN REVERSAL MACROS *******************************************/
+#if BYTE_ORDER == LITTLE_ENDIAN
+#define REVERSE32(w, x) { \
+ uint32_t tmp = (w); \
+ tmp = (tmp >> 16) | (tmp << 16); \
+ (x) = ((tmp & 0xff00ff00UL) >> 8) | ((tmp & 0x00ff00ffUL) << 8); \
+}
+#define REVERSE64(w, x) { \
+ uint64_t tmp = (w); \
+ tmp = (tmp >> 32) | (tmp << 32); \
+ tmp = ((tmp & 0xff00ff00ff00ff00ULL) >> 8) | \
+ ((tmp & 0x00ff00ff00ff00ffULL) << 8); \
+ (x) = ((tmp & 0xffff0000ffff0000ULL) >> 16) | \
+ ((tmp & 0x0000ffff0000ffffULL) << 16); \
+}
+#endif /* BYTE_ORDER == LITTLE_ENDIAN */
+
+/*
+ * Macro for incrementally adding the unsigned 64-bit integer n to the
+ * unsigned 128-bit integer (represented using a two-element array of
+ * 64-bit words):
+ */
+#define ADDINC128(w,n) { \
+ (w)[0] += (uint64_t)(n); \
+ if ((w)[0] < (n)) { \
+ (w)[1]++; \
+ } \
+}
+
+#define MEMSET_BZERO(p,l) memset((p), 0, (l))
+#define MEMCPY_BCOPY(d,s,l) memcpy((d), (s), (l))
+
+/*** THE SIX LOGICAL FUNCTIONS ****************************************/
+/*
+ * Bit shifting and rotation (used by the six SHA-XYZ logical functions:
+ *
+ * NOTE: The naming of R and S appears backwards here (R is a SHIFT and
+ * S is a ROTATION) because the SHA-256/384/512 description document
+ * (see http://csrc.nist.gov/cryptval/shs/sha256-384-512.pdf) uses this
+ * same "backwards" definition.
+ */
+/* Shift-right (used in SHA-256, SHA-384, and SHA-512): */
+#define R(b,x) ((x) >> (b))
+/* 32-bit Rotate-right (used in SHA-256): */
+#define S32(b,x) (((x) >> (b)) | ((x) << (32 - (b))))
+/* 64-bit Rotate-right (used in SHA-384 and SHA-512): */
+#define S64(b,x) (((x) >> (b)) | ((x) << (64 - (b))))
+
+/* Two of six logical functions used in SHA-256, SHA-384, and SHA-512: */
+#define Ch(x,y,z) (((x) & (y)) ^ ((~(x)) & (z)))
+#define Maj(x,y,z) (((x) & (y)) ^ ((x) & (z)) ^ ((y) & (z)))
+
+/* Four of six logical functions used in SHA-256: */
+#define Sigma0_256(x) (S32(2, (x)) ^ S32(13, (x)) ^ S32(22, (x)))
+#define Sigma1_256(x) (S32(6, (x)) ^ S32(11, (x)) ^ S32(25, (x)))
+#define sigma0_256(x) (S32(7, (x)) ^ S32(18, (x)) ^ R(3 , (x)))
+#define sigma1_256(x) (S32(17, (x)) ^ S32(19, (x)) ^ R(10, (x)))
+
+/* Four of six logical functions used in SHA-384 and SHA-512: */
+#define Sigma0_512(x) (S64(28, (x)) ^ S64(34, (x)) ^ S64(39, (x)))
+#define Sigma1_512(x) (S64(14, (x)) ^ S64(18, (x)) ^ S64(41, (x)))
+#define sigma0_512(x) (S64( 1, (x)) ^ S64( 8, (x)) ^ R( 7, (x)))
+#define sigma1_512(x) (S64(19, (x)) ^ S64(61, (x)) ^ R( 6, (x)))
+
+static void sha512_last (sha512_state *state);
+static void sha256_transform (sha256_state *state, const uint32_t idata[16]);
+static void sha512_transform (sha512_state *state, const uint64_t idata[16]);
+
+/*** SHA-XYZ INITIAL HASH VALUES AND CONSTANTS ************************/
+/* Hash constant words K for SHA-256: */
+static const uint32_t K256[64] = {
+ 0x428a2f98UL, 0x71374491UL, 0xb5c0fbcfUL, 0xe9b5dba5UL,
+ 0x3956c25bUL, 0x59f111f1UL, 0x923f82a4UL, 0xab1c5ed5UL,
+ 0xd807aa98UL, 0x12835b01UL, 0x243185beUL, 0x550c7dc3UL,
+ 0x72be5d74UL, 0x80deb1feUL, 0x9bdc06a7UL, 0xc19bf174UL,
+ 0xe49b69c1UL, 0xefbe4786UL, 0x0fc19dc6UL, 0x240ca1ccUL,
+ 0x2de92c6fUL, 0x4a7484aaUL, 0x5cb0a9dcUL, 0x76f988daUL,
+ 0x983e5152UL, 0xa831c66dUL, 0xb00327c8UL, 0xbf597fc7UL,
+ 0xc6e00bf3UL, 0xd5a79147UL, 0x06ca6351UL, 0x14292967UL,
+ 0x27b70a85UL, 0x2e1b2138UL, 0x4d2c6dfcUL, 0x53380d13UL,
+ 0x650a7354UL, 0x766a0abbUL, 0x81c2c92eUL, 0x92722c85UL,
+ 0xa2bfe8a1UL, 0xa81a664bUL, 0xc24b8b70UL, 0xc76c51a3UL,
+ 0xd192e819UL, 0xd6990624UL, 0xf40e3585UL, 0x106aa070UL,
+ 0x19a4c116UL, 0x1e376c08UL, 0x2748774cUL, 0x34b0bcb5UL,
+ 0x391c0cb3UL, 0x4ed8aa4aUL, 0x5b9cca4fUL, 0x682e6ff3UL,
+ 0x748f82eeUL, 0x78a5636fUL, 0x84c87814UL, 0x8cc70208UL,
+ 0x90befffaUL, 0xa4506cebUL, 0xbef9a3f7UL, 0xc67178f2UL
+};
+
+/* Initial hash value H for SHA-256: */
+static const uint32_t sha256_initial_hash_value[8] = {
+ 0x6a09e667UL,
+ 0xbb67ae85UL,
+ 0x3c6ef372UL,
+ 0xa54ff53aUL,
+ 0x510e527fUL,
+ 0x9b05688cUL,
+ 0x1f83d9abUL,
+ 0x5be0cd19UL
+};
+
+/* Hash constant words K for SHA-384 and SHA-512: */
+static const uint64_t K512[80] = {
+ 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL,
+ 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL,
+ 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,
+ 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL,
+ 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL,
+ 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,
+ 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL,
+ 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL,
+ 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL,
+ 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL,
+ 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL,
+ 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,
+ 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL,
+ 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL,
+ 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL,
+ 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL,
+ 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL,
+ 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,
+ 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL,
+ 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL,
+ 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL,
+ 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL,
+ 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL,
+ 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,
+ 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL,
+ 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL,
+ 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL,
+ 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL,
+ 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL,
+ 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,
+ 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL,
+ 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL,
+ 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL,
+ 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL,
+ 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL,
+ 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,
+ 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL,
+ 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL,
+ 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL,
+ 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL
+};
+
+/* Initial hash value H for SHA-384 */
+static const uint64_t sha384_initial_hash_value[8] = {
+ 0xcbbb9d5dc1059ed8ULL,
+ 0x629a292a367cd507ULL,
+ 0x9159015a3070dd17ULL,
+ 0x152fecd8f70e5939ULL,
+ 0x67332667ffc00b31ULL,
+ 0x8eb44a8768581511ULL,
+ 0xdb0c2e0d64f98fa7ULL,
+ 0x47b5481dbefa4fa4ULL
+};
+
+/* Initial hash value H for SHA-512 */
+static const uint64_t sha512_initial_hash_value[8] = {
+ 0x6a09e667f3bcc908ULL,
+ 0xbb67ae8584caa73bULL,
+ 0x3c6ef372fe94f82bULL,
+ 0xa54ff53a5f1d36f1ULL,
+ 0x510e527fade682d1ULL,
+ 0x9b05688c2b3e6c1fULL,
+ 0x1f83d9abfb41bd6bULL,
+ 0x5be0cd19137e2179ULL
+};
+
+/*** SHA-256: *********************************************************/
+sha256_state * sha256_digest_init (sha256_state *state)
+{
+ MEMCPY_BCOPY(state->words, sha256_initial_hash_value, SHA256_DIGEST_LENGTH);
+ MEMSET_BZERO(state->buffer, SHA256_BLOCK_LENGTH);
+ state->bitcount = 0;
+ return state;
+}
+
+#ifdef SHA2_UNROLL_TRANSFORM
+
+/* Unrolled SHA-256 round macros: */
+
+#if BYTE_ORDER == LITTLE_ENDIAN
+
+#define ROUND256_0_TO_15(v, a, b, c, d, e, f, g, h) \
+ REVERSE32(v, W256[j]); \
+ T1 = (h) + Sigma1_256(e) + Ch((e), (f), (g)) + K256[j] + W256[j]; \
+ (d) += T1; \
+ (h) = T1 + Sigma0_256(a) + Maj((a), (b), (c))
+
+#else /* BYTE_ORDER == LITTLE_ENDIAN */
+
+#define ROUND256_0_TO_15(v, a, b, c, d, e, f, g, h) \
+ T1 = (h) + Sigma1_256(e) + Ch((e), (f), (g)) + K256[j] + (W256[j] = v); \
+ (d) += T1; \
+ (h) = T1 + Sigma0_256(a) + Maj((a), (b), (c))
+
+#endif /* BYTE_ORDER == LITTLE_ENDIAN */
+
+#define ROUND256(a, b, c, d, e, f, g, h) \
+ s0 = W256[(j+1)&0x0f]; \
+ s0 = sigma0_256(s0); \
+ s1 = W256[(j+14)&0x0f]; \
+ s1 = sigma1_256(s1); \
+ T1 = (h) + Sigma1_256(e) + Ch((e), (f), (g)) + K256[j] + (W256[j&0x0f] += s1 + W256[(j+9)&0x0f] + s0); \
+ (d) += T1; \
+ (h) = T1 + Sigma0_256(a) + Maj((a), (b), (c))
+
+static void sha256_transform (sha256_state *state, const uint32_t idata[16]) {
+ uint32_t a, b, c, d, e, f, g, h, s0, s1;
+ uint32_t T1, *W256, v;
+ int j;
+
+ W256 = state->buffer32;
+
+ /* Initialize registers with the prev. intermediate value */
+ a = state->words[0];
+ b = state->words[1];
+ c = state->words[2];
+ d = state->words[3];
+ e = state->words[4];
+ f = state->words[5];
+ g = state->words[6];
+ h = state->words[7];
+
+ j = 0;
+ do {
+ /* Rounds 0 to 15 (unrolled): */
+ v = idata[j]; ROUND256_0_TO_15(v, a, b, c, d, e, f, g, h); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, h, a, b, c, d, e, f, g); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, g, h, a, b, c, d, e, f); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, f, g, h, a, b, c, d, e); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, e, f, g, h, a, b, c, d); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, d, e, f, g, h, a, b, c); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, c, d, e, f, g, h, a, b); ++j;
+ v = idata[j]; ROUND256_0_TO_15(v, b, c, d, e, f, g, h, a); ++j;
+ } while (j < 16);
+
+ /* Now for the remaining rounds to 64: */
+ do {
+ ROUND256(a, b, c, d, e, f, g, h); ++j;
+ ROUND256(h, a, b, c, d, e, f, g); ++j;
+ ROUND256(g, h, a, b, c, d, e, f); ++j;
+ ROUND256(f, g, h, a, b, c, d, e); ++j;
+ ROUND256(e, f, g, h, a, b, c, d); ++j;
+ ROUND256(d, e, f, g, h, a, b, c); ++j;
+ ROUND256(c, d, e, f, g, h, a, b); ++j;
+ ROUND256(b, c, d, e, f, g, h, a); ++j;
+ } while (j < 64);
+
+ /* Compute the current intermediate hash value */
+ state->words[0] += a;
+ state->words[1] += b;
+ state->words[2] += c;
+ state->words[3] += d;
+ state->words[4] += e;
+ state->words[5] += f;
+ state->words[6] += g;
+ state->words[7] += h;
+}
+
+#else /* SHA2_UNROLL_TRANSFORM */
+
+static void sha256_transform (sha256_state *state, const uint32_t idata[16]) {
+ uint32_t a, b, c, d, e, f, g, h, s0, s1;
+ uint32_t T1, T2, *W256, v;
+ int j;
+
+ W256 = state->buffer32;
+
+ /* Initialize registers with the prev. intermediate value */
+ a = state->words[0];
+ b = state->words[1];
+ c = state->words[2];
+ d = state->words[3];
+ e = state->words[4];
+ f = state->words[5];
+ g = state->words[6];
+ h = state->words[7];
+
+ j = 0;
+ do {
+ v = idata[j];
+#if BYTE_ORDER == LITTLE_ENDIAN
+ /* Copy data while converting to host byte order */
+ REVERSE32(v, W256[j]);
+ /* Apply the SHA-256 compression function to update a..h */
+ T1 = h + Sigma1_256(e) + Ch(e, f, g) + K256[j] + W256[j];
+#else /* BYTE_ORDER == LITTLE_ENDIAN */
+ /* Apply the SHA-256 compression function to update a..h with copy */
+ T1 = h + Sigma1_256(e) + Ch(e, f, g) + K256[j] + (W256[j] = v);
+#endif /* BYTE_ORDER == LITTLE_ENDIAN */
+ T2 = Sigma0_256(a) + Maj(a, b, c);
+ h = g;
+ g = f;
+ f = e;
+ e = d + T1;
+ d = c;
+ c = b;
+ b = a;
+ a = T1 + T2;
+
+ j++;
+ } while (j < 16);
+
+ do {
+ /* Part of the message block expansion: */
+ s0 = W256[(j+1)&0x0f];
+ s0 = sigma0_256(s0);
+ s1 = W256[(j+14)&0x0f];
+ s1 = sigma1_256(s1);
+
+ /* Apply the SHA-256 compression function to update a..h */
+ T1 = h + Sigma1_256(e) + Ch(e, f, g) + K256[j] + (W256[j&0x0f] += s1 + W256[(j+9)&0x0f] + s0);
+ T2 = Sigma0_256(a) + Maj(a, b, c);
+ h = g;
+ g = f;
+ f = e;
+ e = d + T1;
+ d = c;
+ c = b;
+ b = a;
+ a = T1 + T2;
+
+ j++;
+ } while (j < 64);
+
+ /* Compute the current intermediate hash value */
+ state->words[0] += a;
+ state->words[1] += b;
+ state->words[2] += c;
+ state->words[3] += d;
+ state->words[4] += e;
+ state->words[5] += f;
+ state->words[6] += g;
+ state->words[7] += h;
+}
+
+#endif /* SHA2_UNROLL_TRANSFORM */
+
+/* PJ: alignment-safe version */
+
+#define data_aligned4(data) (((data - (const uint8_t *)(0UL)) & 3) == 0)
+#define data_aligned8(data) (((data - (const uint8_t *)(0ULL)) & 7) == 0)
+
+static void sha256_transform_aligned (sha256_state *state, const uint8_t *data) {
+ if (data_aligned4(data))
+ {
+ sha256_transform(state, (const uint32_t *)((const void *)data)); // alignment ok
+ }
+ else
+ {
+ uint32_t idata[16];
+ memcpy(&idata[0], data, 16 * sizeof(uint32_t));
+ sha256_transform(state, idata);
+ }
+}
+
+void sha256_digest_add (sha256_state *state, const void *vdata, size_t len)
+{
+ unsigned int freespace, usedspace;
+ const uint8_t *data;
+
+ if (len == 0) /* Calling with no data is valid - we do nothing */
+ return;
+
+ data = (const uint8_t *)vdata;
+
+ usedspace = (state->bitcount >> 3) % SHA256_BLOCK_LENGTH;
+ if (usedspace > 0)
+ {
+ /* Calculate how much free space is available in the buffer */
+ freespace = SHA256_BLOCK_LENGTH - usedspace;
+
+ if (len >= freespace)
+ {
+ /* Fill the buffer completely and process it */
+ MEMCPY_BCOPY(&state->buffer[usedspace], data, freespace);
+ state->bitcount += freespace << 3;
+ len -= freespace;
+ data += freespace;
+ sha256_transform(state, state->buffer32);
+ }
+ else
+ {
+ /* The buffer is not yet full */
+ MEMCPY_BCOPY(&state->buffer[usedspace], data, len);
+ state->bitcount += len << 3;
+ return;
+ }
+ }
+ while (len >= SHA256_BLOCK_LENGTH)
+ {
+ /* Process as many complete blocks as we can */
+ sha256_transform_aligned(state, data);
+
+ state->bitcount += SHA256_BLOCK_LENGTH << 3;
+ len -= SHA256_BLOCK_LENGTH;
+ data += SHA256_BLOCK_LENGTH;
+ }
+ if (len > 0)
+ {
+ /* There's left-overs, so save 'em */
+ MEMCPY_BCOPY(state->buffer, data, len);
+ state->bitcount += len << 3;
+ }
+}
+
+static void digest_hex (uint8_t digest[], const void *data, size_t size, int flags);
+
+void sha256_digest_get (sha256_state *state, uint8_t digest[], int flags) {
+ unsigned int usedspace;
+
+ usedspace = (state->bitcount >> 3) % SHA256_BLOCK_LENGTH;
+#if BYTE_ORDER == LITTLE_ENDIAN
+ /* Convert FROM host byte order */
+ REVERSE64(state->bitcount,state->bitcount);
+#endif
+ if (usedspace > 0)
+ {
+ /* Begin padding with a 1 bit: */
+ state->buffer[usedspace++] = 0x80;
+
+ if (usedspace <= SHA256_SHORT_BLOCK_LENGTH) {
+ /* Set-up for the last transform: */
+ MEMSET_BZERO(&state->buffer[usedspace], SHA256_SHORT_BLOCK_LENGTH - usedspace);
+ } else {
+ if (usedspace < SHA256_BLOCK_LENGTH) {
+ MEMSET_BZERO(&state->buffer[usedspace], SHA256_BLOCK_LENGTH - usedspace);
+ }
+ /* Do second-to-last transform: */
+ sha256_transform(state, state->buffer32);
+
+ /* And set-up for the last transform: */
+ MEMSET_BZERO(state->buffer, SHA256_SHORT_BLOCK_LENGTH);
+ }
+ }
+ else
+ {
+ /* Set-up for the last transform: */
+ MEMSET_BZERO(state->buffer, SHA256_SHORT_BLOCK_LENGTH);
+
+ /* Begin padding with a 1 bit: */
+ *state->buffer = 0x80;
+ }
+ /* Set the bit count: */
+ //*(uint64_t*)&state->buffer[SHA256_SHORT_BLOCK_LENGTH] = state->bitcount; // aliasing violation warning
+ state->buffer64[SHA256_SHORT_BLOCK_LENGTH / sizeof(uint64_t)] = state->bitcount;
+
+ /* Final transform: */
+ sha256_transform(state, state->buffer32);
+
+#if BYTE_ORDER == LITTLE_ENDIAN
+ {
+ /* Convert TO host byte order */
+ int j;
+ for (j = 0; j < 8; j++)
+ {
+ REVERSE32(state->words[j], state->words[j]);
+ }
+ }
+#endif
+ if (flags & SHA_HEX)
+ digest_hex(digest, state->words, SHA256_DIGEST_LENGTH, flags);
+ else
+ memcpy(digest, state->words, SHA256_DIGEST_LENGTH);
+}
+
+/*** SHA-512: *********************************************************/
+sha512_state * sha512_digest_init (sha512_state *state)
+{
+ MEMCPY_BCOPY(state->words, sha512_initial_hash_value, SHA512_DIGEST_LENGTH);
+ MEMSET_BZERO(state->buffer, SHA512_BLOCK_LENGTH);
+ state->bitcount[0] = 0;
+ state->bitcount[1] = 0;
+ return state;
+}
+
+#ifdef SHA2_UNROLL_TRANSFORM
+
+/* PJ: ++ operations moved out of macros! */
+
+/* Unrolled SHA-512 round macros: */
+#if BYTE_ORDER == LITTLE_ENDIAN
+
+#define ROUND512_0_TO_15(v, a, b, c, d, e, f, g, h) \
+ REVERSE64(v, W512[j]); \
+ T1 = (h) + Sigma1_512(e) + Ch((e), (f), (g)) + K512[j] + W512[j]; \
+ (d) += T1; \
+ (h) = T1 + Sigma0_512(a) + Maj((a), (b), (c))
+
+#else /* BYTE_ORDER == LITTLE_ENDIAN */
+
+#define ROUND512_0_TO_15(v, a, b, c, d, e, f, g, h) \
+ T1 = (h) + Sigma1_512(e) + Ch((e), (f), (g)) + K512[j] + (W512[j] = v); \
+ (d) += T1; \
+ (h) = T1 + Sigma0_512(a) + Maj((a), (b), (c))
+
+#endif /* BYTE_ORDER == LITTLE_ENDIAN */
+
+#define ROUND512(a, b, c, d, e, f, g, h) \
+ s0 = W512[(j+1)&0x0f]; \
+ s0 = sigma0_512(s0); \
+ s1 = W512[(j+14)&0x0f]; \
+ s1 = sigma1_512(s1); \
+ T1 = (h) + Sigma1_512(e) + Ch((e), (f), (g)) + K512[j] + (W512[j&0x0f] += s1 + W512[(j+9)&0x0f] + s0); \
+ (d) += T1; \
+ (h) = T1 + Sigma0_512(a) + Maj((a), (b), (c))
+
+static void sha512_transform (sha512_state *state, const uint64_t idata[16])
+{
+ uint64_t a, b, c, d, e, f, g, h, s0, s1;
+ uint64_t T1, *W512, v;
+ int j;
+
+ W512 = state->buffer64;
+
+ /* Initialize registers with the prev. intermediate value */
+ a = state->words[0];
+ b = state->words[1];
+ c = state->words[2];
+ d = state->words[3];
+ e = state->words[4];
+ f = state->words[5];
+ g = state->words[6];
+ h = state->words[7];
+
+ j = 0;
+ do {
+ v = idata[j]; ROUND512_0_TO_15(v, a, b, c, d, e, f, g, h); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, h, a, b, c, d, e, f, g); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, g, h, a, b, c, d, e, f); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, f, g, h, a, b, c, d, e); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, e, f, g, h, a, b, c, d); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, d, e, f, g, h, a, b, c); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, c, d, e, f, g, h, a, b); ++j;
+ v = idata[j]; ROUND512_0_TO_15(v, b, c, d, e, f, g, h, a); ++j;
+ } while (j < 16);
+
+ /* Now for the remaining rounds up to 79: */
+ do {
+ ROUND512(a, b, c, d, e, f, g, h); ++j;
+ ROUND512(h, a, b, c, d, e, f, g); ++j;
+ ROUND512(g, h, a, b, c, d, e, f); ++j;
+ ROUND512(f, g, h, a, b, c, d, e); ++j;
+ ROUND512(e, f, g, h, a, b, c, d); ++j;
+ ROUND512(d, e, f, g, h, a, b, c); ++j;
+ ROUND512(c, d, e, f, g, h, a, b); ++j;
+ ROUND512(b, c, d, e, f, g, h, a); ++j;
+ } while (j < 80);
+
+ /* Compute the current intermediate hash value */
+ state->words[0] += a;
+ state->words[1] += b;
+ state->words[2] += c;
+ state->words[3] += d;
+ state->words[4] += e;
+ state->words[5] += f;
+ state->words[6] += g;
+ state->words[7] += h;
+}
+
+#else /* SHA2_UNROLL_TRANSFORM */
+
+static void sha512_transform (sha512_state *state, const uint64_t idata[16])
+{
+ uint64_t a, b, c, d, e, f, g, h, s0, s1;
+ uint64_t T1, T2, *W512, v;
+ int j;
+
+ W512 = state->buffer64;
+
+ /* Initialize registers with the prev. intermediate value */
+ a = state->words[0];
+ b = state->words[1];
+ c = state->words[2];
+ d = state->words[3];
+ e = state->words[4];
+ f = state->words[5];
+ g = state->words[6];
+ h = state->words[7];
+
+ j = 0;
+ do {
+ v = idata[j];
+#if BYTE_ORDER == LITTLE_ENDIAN
+ /* Convert TO host byte order */
+ REVERSE64(v, W512[j]);
+ /* Apply the SHA-512 compression function to update a..h */
+ T1 = h + Sigma1_512(e) + Ch(e, f, g) + K512[j] + W512[j];
+#else /* BYTE_ORDER == LITTLE_ENDIAN */
+ /* Apply the SHA-512 compression function to update a..h with copy */
+ T1 = h + Sigma1_512(e) + Ch(e, f, g) + K512[j] + (W512[j] = v);
+#endif /* BYTE_ORDER == LITTLE_ENDIAN */
+ T2 = Sigma0_512(a) + Maj(a, b, c);
+ h = g;
+ g = f;
+ f = e;
+ e = d + T1;
+ d = c;
+ c = b;
+ b = a;
+ a = T1 + T2;
+
+ j++;
+ } while (j < 16);
+
+ do {
+ /* Part of the message block expansion: */
+ s0 = W512[(j+1)&0x0f];
+ s0 = sigma0_512(s0);
+ s1 = W512[(j+14)&0x0f];
+ s1 = sigma1_512(s1);
+
+ /* Apply the SHA-512 compression function to update a..h */
+ T1 = h + Sigma1_512(e) + Ch(e, f, g) + K512[j] + (W512[j&0x0f] += s1 + W512[(j+9)&0x0f] + s0);
+ T2 = Sigma0_512(a) + Maj(a, b, c);
+ h = g;
+ g = f;
+ f = e;
+ e = d + T1;
+ d = c;
+ c = b;
+ b = a;
+ a = T1 + T2;
+
+ j++;
+ } while (j < 80);
+
+ /* Compute the current intermediate hash value */
+ state->words[0] += a;
+ state->words[1] += b;
+ state->words[2] += c;
+ state->words[3] += d;
+ state->words[4] += e;
+ state->words[5] += f;
+ state->words[6] += g;
+ state->words[7] += h;
+}
+
+#endif /* SHA2_UNROLL_TRANSFORM */
+
+static void sha512_transform_aligned (sha512_state *state, const uint8_t *data)
+{
+ if (data_aligned8(data))
+ {
+ sha512_transform(state, (const uint64_t *)((const void *)data)); // alignment ok
+ }
+ else
+ {
+ uint64_t idata[16];
+ memcpy(&idata[0], data, 16 * sizeof(uint64_t));
+ sha512_transform(state, idata);
+ }
+}
+
+void sha512_digest_add (sha512_state *state, const void *vdata, size_t len)
+{
+ unsigned int freespace, usedspace;
+ const uint8_t *data;
+
+ if (len == 0) /* Calling with no data is valid - we do nothing */
+ return;
+
+ /* Sanity check: */
+ data = (const uint8_t *)vdata;
+
+ usedspace = (state->bitcount[0] >> 3) % SHA512_BLOCK_LENGTH;
+ if (usedspace > 0)
+ {
+ /* Calculate how much free space is available in the buffer */
+ freespace = SHA512_BLOCK_LENGTH - usedspace;
+
+ if (len >= freespace)
+ {
+ /* Fill the buffer completely and process it */
+ MEMCPY_BCOPY(&state->buffer[usedspace], data, freespace);
+ ADDINC128(state->bitcount, freespace << 3);
+ len -= freespace;
+ data += freespace;
+ sha512_transform(state, state->buffer64);
+ }
+ else
+ {
+ /* The buffer is not yet full */
+ MEMCPY_BCOPY(&state->buffer[usedspace], data, len);
+ ADDINC128(state->bitcount, len << 3);
+ return;
+ }
+ }
+ while (len >= SHA512_BLOCK_LENGTH)
+ {
+ /* Process as many complete blocks as we can */
+ sha512_transform_aligned(state, data);
+
+ ADDINC128(state->bitcount, SHA512_BLOCK_LENGTH << 3);
+ len -= SHA512_BLOCK_LENGTH;
+ data += SHA512_BLOCK_LENGTH;
+ }
+ if (len > 0)
+ {
+ /* There's left-overs, so save 'em */
+ MEMCPY_BCOPY(state->buffer, data, len);
+ ADDINC128(state->bitcount, len << 3);
+ }
+}
+
+static void sha512_last (sha512_state *state)
+{
+ unsigned int usedspace;
+
+ usedspace = (state->bitcount[0] >> 3) % SHA512_BLOCK_LENGTH;
+#if BYTE_ORDER == LITTLE_ENDIAN
+ /* Convert FROM host byte order */
+ REVERSE64(state->bitcount[0],state->bitcount[0]);
+ REVERSE64(state->bitcount[1],state->bitcount[1]);
+#endif
+ if (usedspace > 0)
+ {
+ /* Begin padding with a 1 bit: */
+ state->buffer[usedspace++] = 0x80;
+
+ if (usedspace <= SHA512_SHORT_BLOCK_LENGTH) {
+ /* Set-up for the last transform: */
+ MEMSET_BZERO(&state->buffer[usedspace], SHA512_SHORT_BLOCK_LENGTH - usedspace);
+ } else {
+ if (usedspace < SHA512_BLOCK_LENGTH) {
+ MEMSET_BZERO(&state->buffer[usedspace], SHA512_BLOCK_LENGTH - usedspace);
+ }
+ /* Do second-to-last transform: */
+ sha512_transform(state, state->buffer64);
+
+ /* And set-up for the last transform: */
+ //MEMSET_BZERO(state->buffer, SHA512_BLOCK_LENGTH - 2); // seems a typo, we overwrite last 16 bytes below
+ MEMSET_BZERO(state->buffer, SHA512_SHORT_BLOCK_LENGTH);
+ }
+ }
+ else
+ {
+ /* Prepare for final transform: */
+ MEMSET_BZERO(state->buffer, SHA512_SHORT_BLOCK_LENGTH);
+
+ /* Begin padding with a 1 bit: */
+ *state->buffer = 0x80;
+ }
+ /* Store the length of input data (in bits): */
+ //*(uint64_t*)&state->buffer[SHA512_SHORT_BLOCK_LENGTH] = state->bitcount[1]; // aliasing violation warning
+ //*(uint64_t*)&state->buffer[SHA512_SHORT_BLOCK_LENGTH+8] = state->bitcount[0];
+ state->buffer64[SHA512_SHORT_BLOCK_LENGTH / sizeof(uint64_t)] = state->bitcount[1];
+ state->buffer64[SHA512_SHORT_BLOCK_LENGTH / sizeof(uint64_t) + 1] = state->bitcount[0];
+
+ /* Final transform: */
+ sha512_transform(state, state->buffer64);
+}
+
+void sha512_digest_get (sha512_state *state, uint8_t digest[], int flags)
+{
+ /* If no digest buffer is passed, we don't bother doing this: */
+ sha512_last(state);
+
+ /* Save the hash data for output: */
+#if BYTE_ORDER == LITTLE_ENDIAN
+ {
+ /* Convert TO host byte order */
+ int j;
+ for (j = 0; j < 8; j++)
+ {
+ REVERSE64(state->words[j], state->words[j]);
+ }
+ }
+#endif
+ if (flags & SHA_HEX)
+ digest_hex(digest, state->words, SHA512_DIGEST_LENGTH, flags);
+ else
+ memcpy(digest, state->words, SHA512_DIGEST_LENGTH);
+}
+
+/*** SHA-384: *********************************************************/
+sha384_state * sha384_digest_init (sha384_state *state)
+{
+ MEMCPY_BCOPY(state->words, sha384_initial_hash_value, SHA512_DIGEST_LENGTH);
+ MEMSET_BZERO(state->buffer, SHA384_BLOCK_LENGTH);
+ state->bitcount[0] = state->bitcount[1] = 0;
+ return state;
+}
+
+void sha384_digest_add (sha384_state *state, const void *data, size_t len)
+{
+ sha512_digest_add((sha512_state *)state, data, len);
+}
+
+void sha384_digest_get (sha384_state *state, uint8_t digest[], int flags)
+{
+ sha512_last((sha512_state *)state);
+
+ /* Save the hash data for output: */
+#if BYTE_ORDER == LITTLE_ENDIAN
+ {
+ /* Convert TO host byte order */
+ int j;
+ for (j = 0; j < 6; j++)
+ {
+ REVERSE64(state->words[j], state->words[j]);
+ }
+ }
+#endif
+ if (flags & SHA_HEX)
+ digest_hex(digest, state->words, SHA384_DIGEST_LENGTH, flags);
+ else
+ memcpy(digest, state->words, SHA384_DIGEST_LENGTH);
+}
+
+/* hex output */
+
+static void digest_hex (uint8_t digest[], const void *data, size_t size, int flags)
+{
+ const char *alphabet;
+ const uint8_t *bytes;
+ size_t i;
+
+ bytes = (const uint8_t *)data;
+ alphabet = (flags & SHA_LCHEX) ? "0123456789abcdef" : "0123456789ABCDEF";
+ for (i = 0; i < size; ++i, ++bytes)
+ {
+ *digest++ = (uint8_t)alphabet[(*bytes) >> 4];
+ *digest++ = (uint8_t)alphabet[(*bytes) & 15];
+ }
+ *digest = 0;
+}
+
+/* string checksum */
+
+void sha256_digest (const void *data, size_t size, uint8_t digest[], int flags)
+{
+ sha256_state state;
+ sha256_digest_init(&state);
+ sha256_digest_add(&state, data, size);
+ sha256_digest_get(&state, digest, flags);
+}
+
+void sha384_digest (const void *data, size_t size, uint8_t digest[], int flags)
+{
+ sha384_state state;
+ sha384_digest_init(&state);
+ sha384_digest_add(&state, data, size);
+ sha384_digest_get(&state, digest, flags);
+}
+
+void sha512_digest (const void *data, size_t size, uint8_t digest[], int flags)
+{
+ sha512_state state;
+ sha512_digest_init(&state);
+ sha512_digest_add(&state, data, size);
+ sha512_digest_get(&state, digest, flags);
+}
+
+/* file checksum */
+
+#define DIGEST_BUFFER_SIZE 4096
+
+int sha256_digest_add_file (sha256_state *state, const char *filename)
+{
+ FILE *fh;
+ uint8_t buffer[DIGEST_BUFFER_SIZE];
+ size_t read;
+
+ if ((fh = fopen(filename, "rb")) == NULL)
+ return 0;
+ do {
+ read = fread(buffer, 1, DIGEST_BUFFER_SIZE, fh);
+ sha256_digest_add(state, buffer, read);
+ } while (read == DIGEST_BUFFER_SIZE);
+ fclose(fh);
+ return 1;
+}
+
+int sha256_digest_file (const char *filename, uint8_t digest[], int flags)
+{
+ sha256_state state;
+
+ sha256_digest_init(&state);
+ if (sha256_digest_add_file(&state, filename))
+ {
+ sha256_digest_get(&state, digest, flags);
+ return 1;
+ }
+ return 0;
+}
+
+int sha384_digest_add_file (sha384_state *state, const char *filename)
+{
+ FILE *fh;
+ uint8_t buffer[DIGEST_BUFFER_SIZE];
+ size_t read;
+
+ if ((fh = fopen(filename, "rb")) == NULL)
+ return 0;
+ do {
+ read = fread(buffer, 1, DIGEST_BUFFER_SIZE, fh);
+ sha384_digest_add(state, buffer, read);
+ } while (read == DIGEST_BUFFER_SIZE);
+ fclose(fh);
+ return 1;
+}
+
+int sha384_digest_file (const char *filename, uint8_t digest[], int flags)
+{
+ sha384_state state;
+
+ sha384_digest_init(&state);
+ if (sha384_digest_add_file(&state, filename))
+ {
+ sha384_digest_get(&state, digest, flags);
+ return 1;
+ }
+ return 0;
+}
+
+int sha512_digest_add_file (sha512_state *state, const char *filename)
+{
+ FILE *fh;
+ uint8_t buffer[DIGEST_BUFFER_SIZE];
+ size_t read;
+
+ if ((fh = fopen(filename, "rb")) == NULL)
+ return 0;
+ do {
+ read = fread(buffer, 1, DIGEST_BUFFER_SIZE, fh);
+ sha512_digest_add(state, buffer, read);
+ } while (read == DIGEST_BUFFER_SIZE);
+ fclose(fh);
+ return 1;
+}
+
+int sha512_digest_file (const char *filename, uint8_t digest[], int flags)
+{
+ sha512_state state;
+
+ sha512_digest_init(&state);
+ if (sha512_digest_add_file(&state, filename))
+ {
+ sha512_digest_get(&state, digest, flags);
+ return 1;
+ }
+ return 0;
+}
diff --git a/source/luametatex/source/libraries/pplib/util/utilsha.h b/source/luametatex/source/libraries/pplib/util/utilsha.h
new file mode 100644
index 000000000..6c9b1bdc9
--- /dev/null
+++ b/source/luametatex/source/libraries/pplib/util/utilsha.h
@@ -0,0 +1,79 @@
+/* sha2 implementation excerpted from code by Aaron D. Gifford */
+
+#ifndef UTIL_SHA_H
+#define UTIL_SHA_H
+
+#include <stddef.h>
+#include <stdint.h>
+#include "utildecl.h"
+
+#define SHA256_BLOCK_LENGTH 64
+#define SHA256_DIGEST_LENGTH 32
+#define SHA256_STRING_LENGTH (SHA256_DIGEST_LENGTH * 2 + 1)
+#define SHA384_BLOCK_LENGTH 128
+#define SHA384_DIGEST_LENGTH 48
+#define SHA384_STRING_LENGTH (SHA384_DIGEST_LENGTH * 2 + 1)
+#define SHA512_BLOCK_LENGTH 128
+#define SHA512_DIGEST_LENGTH 64
+#define SHA512_STRING_LENGTH (SHA512_DIGEST_LENGTH * 2 + 1)
+
+//#define sha256_state sha256_state_t
+//#define sha384_state sha384_state_t
+//#define sha512_state sha512_state_t
+
+typedef struct {
+ uint32_t words[8];
+ uint64_t bitcount;
+ union {
+ uint8_t buffer[SHA256_BLOCK_LENGTH];
+ uint32_t buffer32[SHA256_BLOCK_LENGTH / sizeof(uint32_t)];
+ uint64_t buffer64[SHA256_BLOCK_LENGTH / sizeof(uint64_t)];
+ };
+} sha256_state;
+
+typedef struct {
+ uint64_t words[8];
+ uint64_t bitcount[2];
+ union {
+ uint8_t buffer[SHA512_BLOCK_LENGTH];
+ uint64_t buffer64[SHA512_BLOCK_LENGTH / sizeof(uint64_t)];
+ };
+} sha512_state;
+
+typedef sha512_state sha384_state;
+
+enum {
+ SHA_BYTES = 0,
+ SHA_UCHEX = (1<<0),
+ SHA_LCHEX = (1<<1)
+};
+
+#define SHA_DEFAULT SHA_BYTES
+#define SHA_HEX (SHA_UCHEX|SHA_LCHEX)
+
+UTILAPI sha256_state * sha256_digest_init (sha256_state *state);
+UTILAPI sha384_state * sha384_digest_init (sha384_state *state);
+UTILAPI sha512_state * sha512_digest_init (sha512_state *state);
+
+UTILAPI void sha256_digest_add (sha256_state *state, const void *data, size_t size);
+UTILAPI void sha384_digest_add (sha384_state *state, const void *data, size_t size);
+UTILAPI void sha512_digest_add (sha512_state *state, const void *data, size_t size);
+
+UTILAPI void sha256_digest_get (sha256_state *state, uint8_t digest[], int flags);
+UTILAPI void sha384_digest_get (sha384_state *state, uint8_t digest[], int flags);
+UTILAPI void sha512_digest_get (sha512_state *state, uint8_t digest[], int flags);
+
+UTILAPI void sha256_digest (const void *data, size_t size, uint8_t digest[], int flags);
+UTILAPI void sha384_digest (const void *data, size_t size, uint8_t digest[], int flags);
+UTILAPI void sha512_digest (const void *data, size_t size, uint8_t digest[], int flags);
+
+UTILAPI int sha256_digest_add_file (sha256_state *state, const char *filename);
+UTILAPI int sha256_digest_file (const char *filename, uint8_t digest[], int flags);
+
+UTILAPI int sha384_digest_add_file (sha384_state *state, const char *filename);
+UTILAPI int sha384_digest_file (const char *filename, uint8_t digest[], int flags);
+
+UTILAPI int sha512_digest_add_file (sha512_state *state, const char *filename);
+UTILAPI int sha512_digest_file (const char *filename, uint8_t digest[], int flags);
+
+#endif
diff --git a/source/luametatex/source/libraries/readme.txt b/source/luametatex/source/libraries/readme.txt
new file mode 100644
index 000000000..8af76f93a
--- /dev/null
+++ b/source/luametatex/source/libraries/readme.txt
@@ -0,0 +1,25 @@
+Nota bene,
+
+The currently embedded libcerf library might become an optional one as soon as we decide to provide
+it as such. It doesn't put a dent in filesize but as it's used rarely (and mostly as complement to
+the complex math support) that makes sense. The library was added because some users wanted it as
+companion the other math libraries and because TeX is often about math it sort of feels okay. But
+it looks like there will never be support for the MSVC compiler. Mojca and I (Hans) adapted the
+sources included here to compile out of the box, but that didn't make it back into the original.
+
+The pplib library has a few patches with respect to memory allocation and zip compression so that
+we can hook in the minizip and mimalloc alternatives.
+
+The avl and hnj libraries are adapted to Lua(Meta)TeX and might get some more adaptations depending
+on our needs. The decnumber library that is also used in mplib is unchanged.
+
+In mimalloc we need to patch init.c: #if defined(_M_X64) || defined(_M_ARM64) to get rid of a link
+error.
+
+In decNumber.c this got added:
+
+# include "../../utilities/auxmemory.h"
+# define malloc lmt_memory_malloc
+# define free lmt_memory_free
+
+Hans \ No newline at end of file
diff --git a/source/luametatex/source/license.txt b/source/luametatex/source/license.txt
new file mode 100644
index 000000000..f98c98819
--- /dev/null
+++ b/source/luametatex/source/license.txt
@@ -0,0 +1,181 @@
+------------------------------------------------------------------------------------------
+PREAMBLE
+------------------------------------------------------------------------------------------
+
+The LuaMetaTeX program is a light weight variant of LuaTeX. This program finds its origin
+in parts of TeX (the original program, eTeX (some extensions), pdfTeX (more extensions)
+Aleph (based on Omega, directions) and of course LuaTeX (lots of things).
+
+So, basically we follow up on LuaTeX which itself is a follow up on TeX, eTeX, pdfTeX and
+Aleph. The actual starting point (in 2005) was a special Lua enhanced version of pdfTeX
+by Hartmut Henkel that we experimented with and triggered a follow up. However, the code
+base is no longer Pascal (which then gets converted to C) but regular C code instead. That
+conversion was done by Taco Hoekwater as part of the Oriental TeX project.
+
+There are many articles (presentations and documents) that discuss the development history.
+These articles and documents describing the projects shed more light on what functionality
+showed up when and why. As these projects closely relate to ConTeXt development you can
+find those documents in the ConTeXt distribution.
+
+After this conversion quite some implementation details changed over the decade that
+followed: memory management was adapted, string handling became dynamic, managing the
+table of equivalents was tuned to the mix, callbacks were added. The opening up resulted in
+some adaption of the internals too. Font handling changed, math support for opentype math
+has been introduced. Hyphenation handling, ligature building and kerning are clearly
+separated and language support has been rewritten from scratch. In addition to Lua, the
+TeX engine is also complemented by the MetaPost library. Luigi Scarso added support for
+LuaJIT and ffi and over time makes sure that the code works out okay in the regular
+TeXLive build too.
+
+In 2018-2019 the conversion from LuaTeX to LuaMetaTeX was done by Hans Hagen as part of
+an attempt to simplify the build and get rid of code that might have been useful when we
+started but no longer makes sense. Because the LuaTeX interfaces had to stabelize, this
+follow up also provides us a new testbed. The LuaMetaTeX source code is distributed as
+part of the ConTeXt distribution which is also used for testing and development. Most
+tests are done by those involved in ConTeXt development, so issues should be reported to
+the mailing lists related to this macro package.
+
+In the process the code base has been adapted substantially, although the decade of
+LuaTeX development already prepared for that. This also leads occasionally instable
+setups. We're grateful to ConTeXt community for their patience in testing these continuous
+developments.
+
+The license below is from LuaTeX and also applies to LuaMetaTeX. Although other team
+members contribute(d) to the code, we stick to this description. The --credits option
+provides more information.
+
+------------------------------------------------------------------------------------------
+EXCUSE
+------------------------------------------------------------------------------------------
+
+Although some code comes from pdfTeX and Aleph, the majority comes from good old TeX and
+eTeX or is completely new. Original TeX is a well documented program written in WEB and
+those building upon it have added comments. In LuaMetaTeX we use plain C files but the
+comments are still mostly present. When you read them you really need to keep in mind that
+some refer to good old TeX! The nice comments come from Don Knuth, the bad and fuzzy ones
+originate at us. We appologize to Don for this.
+
+------------------------------------------------------------------------------------------
+CREDITS
+------------------------------------------------------------------------------------------
+
+LuaMetaTeX builds upon the code from LuaTeX which comes from:
+
+ tex : Donald Knuth
+ etex : Peter Breitenlohner, Phil Taylor and friends
+
+The expansion and protrusion code is derived from:
+
+ pdftex : Han The Thanh and friends
+
+Some of the bidirectional text flow model is taken from:
+
+ omega : John Plaice and Yannis Haralambous
+ aleph : Giuseppe Bilotta
+
+Graphic support is provided by:
+
+ metapost : John Hobby, Taco Hoekwater, Luigi Scarso, Hans Hagen and friends
+
+All this is opened up with:
+
+ lua : Roberto Ierusalimschy, Waldemar Celes and Luiz Henrique de Figueiredo
+ lpeg : Roberto Ierusalimschy
+
+A few libraries are embedded, of which we mention:
+
+ avl : Richard McGraw (adapted)
+ decnumber : Mike Cowlishaw (IBM)
+ libcerf : Joachim Wuttke (adapted to msvc)
+ md5 : Peter Deutsch (with partial code from pplib libraries)
+ pplib : Paweł Jackowski (with partial code from libraries)
+ sha2 : Aaron D. Gifford (with partial code from pplib libraries)
+ socket : Diego Nehab (partial and adapted)
+ # zlib : Jean-loup Gailly and Mark Adler
+ miniz : Rich Geldreich etc.
+ mimalloc : Daan Leijen (Microsoft Research)
+
+The code base contains more names and references. Some libraries are partially adapted. We
+use an adapted version of the lfs from the Kepler Project. Also, MetaPost used decNumber
+for decimal number mode.
+
+Depending on demand a few optional libraries can be used, for instance curl, imagemagick,
+lz4, lzo, mujs, mysql, sqlite and zint but there are no dependencies and only very limited
+interfaces are provided (ConTeXt provides \LUA\ layers on top).
+
+------------------------------------------------------------------------------------------
+TEAM
+------------------------------------------------------------------------------------------
+
+LuaTeX : Hans Hagen, Hartmut Henkel, Taco Hoekwater, Luigi Scarso
+LuaMetaTeX : Hans Hagen, Wolfgang Schuster, Mojca Miklavec, Alan Braslau
+
+------------------------------------------------------------------------------------------
+MAIN LICENSE (consider it part of each file that refers to this file)
+------------------------------------------------------------------------------------------
+
+Copyright Taco Hoekwater & Hans Hagen & Wolfgang Schuster
+
+This file is part of LuaMetaTeX.
+
+LuaMetaTeX 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.
+
+LuaMetaTeX 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 could have received a copy of the GNU General Public License along with LuaMetaTeX; if
+not, see <http://www.gnu.org/licenses/>.
+
+------------------------------------------------------------------------------------------
+REMARK
+------------------------------------------------------------------------------------------
+
+The Lua(Meta)TeX team can always decide to relicense to a variant licence in the future,
+but please don't start one of these religious licence discussions with us. We like what
+we're doing, we permits others to use it, and that is the bottomline.
+
+------------------------------------------------------------------------------------------
+OTHER LICENSES
+------------------------------------------------------------------------------------------
+
+The files taken from elsewhere have their own license information at the top of the files
+or in a file their path. It's a mixed bag but basically all permit usage and extensions.
+
+------------------------------------------------------------------------------------------
+BUILD | FARM | REPOSITORIES
+------------------------------------------------------------------------------------------
+
+Mojca Miklavec, Hans Hagen, Alan Braslau
+
+------------------------------------------------------------------------------------------
+CONTEXT MKII | MKIV | LMTX
+------------------------------------------------------------------------------------------
+
+Hans Hagen, Wolfgang Schuster, etc
+
+------------------------------------------------------------------------------------------
+WEBSITE
+------------------------------------------------------------------------------------------
+
+http://www.luatex.org
+http://contextgarden.net
+http://www.pragma-ade.com / http://www.pragma-nl.com
+
+------------------------------------------------------------------------------------------
+SUPPORT
+------------------------------------------------------------------------------------------
+
+http://www.ntg.nl/mailman/listinfo/ntg-context
+http://www.ntg.nl/mailman/listinfo/dev-context
+
+------------------------------------------------------------------------------------------
+MORE LINKS
+------------------------------------------------------------------------------------------
+
+http://www.ntg.nl
+http://www.tug.org
+
+------------------------------------------------------------------------------------------
diff --git a/source/luametatex/source/lua/lmtcallbacklib.c b/source/luametatex/source/lua/lmtcallbacklib.c
new file mode 100644
index 000000000..8724cdd6f
--- /dev/null
+++ b/source/luametatex/source/lua/lmtcallbacklib.c
@@ -0,0 +1,615 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ These are the supported callbacks (by name). This list must have the same size and order as the
+ array in |luatexcallbackids.h|! We could have kept the names private here and maybe they will
+ become that again. On the other hand we can now use them in reports.
+
+*/
+
+callback_state_info lmt_callback_state = {
+ .metatable_id = 0,
+ .padding = 0,
+ .values = { 0 },
+};
+
+/* todo: use lua keywords instead */
+
+static const char *callbacklib_names[total_callbacks] = {
+ "", /*tex empty on purpose */
+ "find_log_file",
+ "find_format_file",
+ "open_data_file",
+ "process_jobname",
+ "start_run",
+ "stop_run",
+ "define_font",
+ "pre_output_filter",
+ "buildpage_filter",
+ "hpack_filter",
+ "vpack_filter",
+ "hyphenate",
+ "ligaturing",
+ "kerning",
+ "glyph_run",
+ "pre_linebreak_filter",
+ "linebreak_filter",
+ "post_linebreak_filter",
+ "append_to_vlist_filter",
+ "alignment_filter",
+ "local_box_filter",
+ "packed_vbox_filter",
+ "mlist_to_hlist",
+ "pre_dump",
+ "start_file",
+ "stop_file",
+ "intercept_tex_error",
+ "intercept_lua_error",
+ "show_error_message",
+ "show_warning_message",
+ "hpack_quality",
+ "vpack_quality",
+ "insert_par",
+ "append_line_filter",
+ "build_page_insert",
+ /* "fire_up_output", */
+ "wrapup_run",
+ "begin_paragraph",
+ "paragraph_context",
+ /* "get_math_char", */
+ "math_rule",
+ "make_extensible",
+ "register_extensible",
+ "show_whatsit",
+ "get_attribute",
+ "get_noad_class",
+ "get_math_dictionary",
+ "show_lua_call",
+ "trace_memory",
+ "handle_overload",
+ "missing_character",
+ "process_character",
+};
+
+/*tex
+
+ This is the generic callback handler, inspired by the one described in the \LUA\ manual(s). It
+ got adapted over time and can also handle some userdata arguments.
+
+*/
+
+static int callbacklib_aux_run(lua_State *L, int id, int special, const char *values, va_list vl, int top, int base)
+{
+ int narg = 0;
+ int nres = 0;
+ if (special == 2) {
+ /*tex copy the enclosing table */
+ lua_pushvalue(L, -2);
+ }
+ for (narg = 0; *values; narg++) {
+ switch (*values++) {
+ case callback_boolean_key:
+ /*tex A boolean: */
+ lua_pushboolean(L, va_arg(vl, int));
+ break;
+ case callback_charnum_key:
+ /*tex A (8 bit) character: */
+ {
+ char cs = (char) va_arg(vl, int);
+ lua_pushlstring(L, &cs, 1);
+ }
+ break;
+ case callback_integer_key:
+ /*tex An integer: */
+ lua_pushinteger(L, va_arg(vl, int));
+ break;
+ case callback_line_key:
+ /*tex A buffer section, with implied start: */
+ lua_pushlstring(L, (char *) (lmt_fileio_state.io_buffer + lmt_fileio_state.io_first), (size_t) va_arg(vl, int));
+ break;
+ case callback_strnumber_key:
+ /*tex A \TEX\ string (indicated by an index): */
+ {
+ size_t len;
+ const char *s = tex_makeclstring(va_arg(vl, int), &len);
+ lua_pushlstring(L, s, len);
+ }
+ break;
+ case callback_lstring_key:
+ /*tex A \LUA\ string: */
+ {
+ lstring *lstr = va_arg(vl, lstring *);
+ lua_pushlstring(L, (const char *) lstr->s, lstr->l);
+ }
+ break;
+ case callback_node_key:
+ /*tex A \TEX\ node: */
+ lmt_push_node_fast(L, va_arg(vl, int));
+ break;
+ case callback_string_key:
+ /*tex A \CCODE\ string: */
+ lua_pushstring(L, va_arg(vl, char *));
+ break;
+ case '-':
+ narg--;
+ break;
+ case '>':
+ goto ENDARGS;
+ default:
+ ;
+ }
+ }
+ ENDARGS:
+ nres = (int) strlen(values);
+ if (special == 1) {
+ nres++;
+ } else if (special == 2) {
+ narg++;
+ }
+ {
+ lmt_lua_state.saved_callback_count++;
+ int i = lua_pcall(L, narg, nres, base);
+ if (i) {
+ /*tex
+ We can't be more precise here as it could be called before \TEX\ initialization is
+ complete.
+ */
+ lua_remove(L, top + 2);
+ lmt_error(L, "run callback", id, (i == LUA_ERRRUN ? 0 : 1));
+ lua_settop(L, top);
+ return 0;
+ }
+ }
+ if (nres == 0) {
+ return 1;
+ }
+ nres = -nres;
+ while (*values) {
+ int t = lua_type(L, nres);
+ switch (*values++) {
+ case callback_boolean_key:
+ switch (t) {
+ case LUA_TBOOLEAN:
+ *va_arg(vl, int *) = lua_toboolean(L, nres);
+ break;
+ case LUA_TNIL:
+ *va_arg(vl, int *) = 0;
+ break;
+ default:
+ return tex_formatted_error("callback", "boolean or nil expected, false or nil, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ /*
+ case callback_charnum_key:
+ break;
+ */
+ case callback_integer_key:
+ switch (t) {
+ case LUA_TNUMBER:
+ *va_arg(vl, int *) = lmt_tointeger(L, nres);
+ break;
+ default:
+ return tex_formatted_error("callback", "number expected, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ case callback_line_key:
+ switch (t) {
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *s = lua_tolstring(L, nres, &len);
+ if (s && (len > 0)) {
+ int *bufloc = va_arg(vl, int *);
+ int ret = *bufloc;
+ if (tex_room_in_buffer(ret + (int) len)) {
+ strncpy((char *) (lmt_fileio_state.io_buffer + ret), s, len);
+ *bufloc += (int) len;
+ /* while (len--) { fileio_state.io_buffer[(*bufloc)++] = *s++; } */
+ while ((*bufloc) - 1 > ret && lmt_fileio_state.io_buffer[(*bufloc) - 1] == ' ') {
+ (*bufloc)--;
+ }
+ } else {
+ return 0;
+ }
+ }
+ /*tex We can assume no more arguments! */
+ }
+ break;
+ case LUA_TNIL:
+ /*tex We assume no more arguments! */
+ return 0;
+ default:
+ return tex_formatted_error("callback", "string or nil expected, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ case callback_strnumber_key:
+ switch (t) {
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *s = lua_tolstring(L, nres, &len);
+ if (s) {
+ *va_arg(vl, int *) = tex_maketexlstring(s, len);
+ } else {
+ /*tex |len| can be zero */
+ *va_arg(vl, int *) = 0;
+ }
+ }
+ break;
+ default:
+ return tex_formatted_error("callback", "string expected, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ case callback_lstring_key:
+ switch (t) {
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *s = lua_tolstring(L, nres, &len);
+ if (s && len > 0) {
+ lstring *lsret = lmt_memory_malloc(sizeof(lstring));
+ if (lsret) {
+ lsret->s = lmt_memory_malloc((unsigned) (len + 1));
+ if (lsret->s) {
+ (void) memcpy(lsret->s, s, (len + 1));
+ lsret->l = len;
+ *va_arg(vl, lstring **) = lsret;
+ } else {
+ *va_arg(vl, int *) = 0;
+ }
+ } else {
+ *va_arg(vl, int *) = 0;
+ }
+ } else {
+ /*tex |len| can be zero */
+ *va_arg(vl, int *) = 0;
+ }
+ }
+ break;
+ default:
+ return tex_formatted_error("callback", "string expected, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ case callback_node_key:
+ switch (t) {
+ case LUA_TUSERDATA:
+ *va_arg(vl, int *) = lmt_check_isnode(L, nres);
+ break;
+ default:
+ *va_arg(vl, int *) = null;
+ break;
+ }
+ break;
+ case callback_string_key:
+ switch (t) {
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *s = lua_tolstring(L, nres, &len);
+ if (s) {
+ char *ss = lmt_memory_malloc((unsigned) (len + 1));
+ if (ss) {
+ memcpy(ss, s, (len + 1));
+ }
+ *va_arg(vl, char **) = ss;
+ } else {
+ *va_arg(vl, char **) = NULL;
+ // *va_arg(vl, int *) = 0;
+ }
+ }
+ break;
+ default:
+ return tex_formatted_error("callback", "string expected, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ case callback_result_key:
+ switch (t) {
+ case LUA_TNIL:
+ *va_arg(vl, int *) = 0;
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, nres) == 0) {
+ *va_arg(vl, int *) = 0;
+ break;
+ } else {
+ return tex_formatted_error("callback", "string, false or nil expected, not: %s\n", lua_typename(L, t));
+ }
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *s = lua_tolstring(L, nres, &len);
+ if (s) {
+ char *ss = lmt_memory_malloc((unsigned) (len + 1));
+ if (ss) {
+ memcpy(ss, s, (len + 1));
+ *va_arg(vl, char **) = ss;
+ } else {
+ *va_arg(vl, char **) = NULL;
+ // *va_arg(vl, int *) = 0;
+ }
+ } else {
+ *va_arg(vl, char **) = NULL;
+ // *va_arg(vl, int *) = 0;
+ }
+ }
+ break;
+ default:
+ return tex_formatted_error("callback", "string, false or nil expected, not: %s\n", lua_typename(L, t));
+ }
+ break;
+ default:
+ return tex_formatted_error("callback", "invalid value type returned\n");
+ }
+ nres++;
+ }
+ return 1;
+}
+
+/*tex
+ Especially the \IO\ related callbacks are registered once, for instance when a file is opened,
+ and (re)used later. These are dealt with here.
+*/
+
+int lmt_run_saved_callback_close(lua_State *L, int r)
+{
+ int ret = 0;
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, r);
+ lua_push_key(close);
+ if (lua_rawget(L, -2) == LUA_TFUNCTION) {
+ ret = lua_pcall(L, 0, 0, 0);
+ if (ret) {
+ return tex_formatted_error("lua", "error in close file callback") - 1;
+ }
+ }
+ lua_settop(L, stacktop);
+ return ret;
+}
+
+int lmt_run_saved_callback_line(lua_State *L, int r, int firstpos)
+{
+ int ret = -1; /* -1 is error, >= 0 is buffer length */
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, r);
+ lua_push_key(reader);
+ if (lua_rawget(L, -2) == LUA_TFUNCTION) {
+ lua_pushvalue(L, -2);
+ lmt_lua_state.file_callback_count++;
+ ret = lua_pcall(L, 1, 1, 0);
+ if (ret) {
+ ret = tex_formatted_error("lua", "error in read line callback") - 1;
+ } else if (lua_type(L, -1) == LUA_TSTRING) {
+ size_t len;
+ const char *s = lua_tolstring(L, -1, &len);
+ if (s && len > 0) {
+ while (len >= 1 && s[len-1] == ' ') {
+ len--;
+ }
+ if (len > 0) {
+ if (tex_room_in_buffer(firstpos + (int) len)) {
+ strncpy((char *) (lmt_fileio_state.io_buffer + firstpos), s, len);
+ ret = firstpos + (int) len;
+ } else {
+ tex_overflow_error("buffer", (int) len);
+ ret = 0;
+ }
+ } else {
+ ret = 0;
+ }
+ } else {
+ ret = 0;
+ }
+ } else {
+ ret = -1;
+ }
+ }
+ lua_settop(L, stacktop);
+ return ret;
+}
+
+/*tex
+
+ Many callbacks have a specific handler, so they don't use the previously mentioned generic one.
+ The next bunch of helpers checks for them being set and deals invoking them as well as reporting
+ errors.
+
+*/
+
+int lmt_callback_okay(lua_State *L, int i, int *top)
+{
+ *top = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_callback_state.metatable_id);
+ lua_pushcfunction(L, lmt_traceback); /* goes before function */
+ if (lua_rawgeti(L, -2, i) == LUA_TFUNCTION) {
+ lmt_lua_state.saved_callback_count++;
+ return 1;
+ } else {
+ lua_pop(L, 3);
+ return 0;
+ }
+}
+
+void lmt_callback_error(lua_State *L, int top, int i)
+{
+ lua_remove(L, top + 2);
+ lmt_error(L, "callback error", -1, (i == LUA_ERRRUN ? 0 : 1));
+ lua_settop(L, top);
+}
+
+int lmt_run_and_save_callback(lua_State *L, int i, const char *values, ...)
+{
+ int top = 0;
+ int ret = 0;
+ if (lmt_callback_okay(L, i, &top)) {
+ va_list args;
+ va_start(args, values);
+ ret = callbacklib_aux_run(L, i, 1, values, args, top, top + 2);
+ va_end(args);
+ if (ret > 0) {
+ ret = lua_type(L, -1) == LUA_TTABLE ? luaL_ref(L, LUA_REGISTRYINDEX) : 0;
+ }
+ lua_settop(L, top);
+ }
+ return ret;
+}
+
+int lmt_run_callback(lua_State *L, int i, const char *values, ...)
+{
+ int top = 0;
+ int ret = 0;
+ if (lmt_callback_okay(L, i, &top)) {
+ va_list args;
+ va_start(args, values);
+ ret = callbacklib_aux_run(L, i, 0, values, args, top, top + 2);
+ va_end(args);
+ lua_settop(L, top);
+ }
+ return ret;
+}
+
+void lmt_destroy_saved_callback(lua_State *L, int i)
+{
+ luaL_unref(L, LUA_REGISTRYINDEX, i);
+}
+
+static int callbacklib_callback_found(const char *s)
+{
+ if (s) {
+ for (int cb = 0; cb < total_callbacks; cb++) {
+ if (strcmp(callbacklib_names[cb], s) == 0) {
+ return cb;
+ }
+ }
+ }
+ return -1;
+}
+
+static int callbacklib_callback_register(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ int cb = callbacklib_callback_found(s);
+ if (cb >= 0) {
+ switch (lua_type(L, 2)) {
+ case LUA_TFUNCTION:
+ lmt_callback_state.values[cb] = cb;
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 2)) {
+ goto BAD; /*tex Only |false| is valid. */
+ }
+ // fall through
+ case LUA_TNIL:
+ lmt_callback_state.values[cb] = -1;
+ break;
+ }
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_callback_state.metatable_id);
+ lua_pushvalue(L, 2); /*tex the function or nil */
+ lua_rawseti(L, -2, cb);
+ lua_rawseti(L, LUA_REGISTRYINDEX, lmt_callback_state.metatable_id);
+ lua_pushinteger(L, cb);
+ return 1;
+ }
+ BAD:
+ lua_pushnil(L);
+ return 1;
+}
+
+void lmt_run_memory_callback(const char* what, int success)
+{
+ lmt_run_callback(lmt_lua_state.lua_instance, trace_memory_callback, "Sb->", what, success);
+ fflush(stdout);
+}
+
+/*tex
+
+ The \LUA\ library that deals with callbacks has some diagnostic helpers that makes it possible
+ to implement a higher level interface.
+
+*/
+
+static int callbacklib_callback_find(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ if (s) {
+ int cb = callbacklib_callback_found(s);
+ if (cb >= 0) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_callback_state.metatable_id);
+ lua_rawgeti(L, -1, cb);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int callbacklib_callback_known(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ lua_pushboolean(L, s && (callbacklib_callback_found(s) >= 0));
+ return 1;
+}
+
+static int callbacklib_callback_list(lua_State *L)
+{
+ lua_createtable(L, 0, total_callbacks);
+ for (int cb = 1; cb < total_callbacks; cb++) {
+ lua_pushstring(L, callbacklib_names[cb]);
+ lua_pushboolean(L, lmt_callback_defined(cb));
+ lua_rawset(L, -3);
+ }
+ return 1;
+}
+
+/* todo: language function calls */
+
+void lmt_push_callback_usage(lua_State *L)
+{
+ lua_createtable(L, 0, 9);
+ lua_push_integer_at_key(L, saved, lmt_lua_state.saved_callback_count);
+ lua_push_integer_at_key(L, file, lmt_lua_state.file_callback_count);
+ lua_push_integer_at_key(L, direct, lmt_lua_state.direct_callback_count);
+ lua_push_integer_at_key(L, function, lmt_lua_state.function_callback_count);
+ lua_push_integer_at_key(L, value, lmt_lua_state.value_callback_count);
+ lua_push_integer_at_key(L, local, lmt_lua_state.local_callback_count);
+ lua_push_integer_at_key(L, bytecode, lmt_lua_state.bytecode_callback_count);
+ lua_push_integer_at_key(L, message, lmt_lua_state.message_callback_count);
+ lua_push_integer_at_key(L, count,
+ lmt_lua_state.saved_callback_count
+ + lmt_lua_state.file_callback_count
+ + lmt_lua_state.direct_callback_count
+ + lmt_lua_state.function_callback_count
+ + lmt_lua_state.value_callback_count
+ + lmt_lua_state.local_callback_count
+ + lmt_lua_state.bytecode_callback_count
+ + lmt_lua_state.message_callback_count
+ );
+}
+
+static int callbacklib_callback_usage(lua_State *L)
+{
+ lmt_push_callback_usage(L);
+ return 1;
+}
+
+static const struct luaL_Reg callbacklib_function_list[] = {
+ { "find", callbacklib_callback_find },
+ { "known", callbacklib_callback_known },
+ { "register", callbacklib_callback_register },
+ { "list", callbacklib_callback_list },
+ { "usage", callbacklib_callback_usage },
+ { NULL, NULL },
+};
+
+int luaopen_callback(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, callbacklib_function_list, 0);
+ lua_newtable(L);
+ lmt_callback_state.metatable_id = luaL_ref(L, LUA_REGISTRYINDEX);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmtcallbacklib.h b/source/luametatex/source/lua/lmtcallbacklib.h
new file mode 100644
index 000000000..6faa4ddac
--- /dev/null
+++ b/source/luametatex/source/lua/lmtcallbacklib.h
@@ -0,0 +1,105 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LCALLBACKLIB_H
+# define LMT_LCALLBACKLIB_H
+
+# include "lapi.h"
+
+typedef enum callback_callback_types {
+ find_log_file_callback = 1,
+ find_format_file_callback,
+ open_data_file_callback,
+ process_jobname_callback,
+ start_run_callback,
+ stop_run_callback,
+ define_font_callback,
+ pre_output_filter_callback,
+ buildpage_filter_callback,
+ hpack_filter_callback,
+ vpack_filter_callback,
+ hyphenate_callback,
+ ligaturing_callback,
+ kerning_callback,
+ glyph_run_callback,
+ pre_linebreak_filter_callback,
+ linebreak_filter_callback,
+ post_linebreak_filter_callback,
+ append_to_vlist_filter_callback,
+ alignment_filter_callback,
+ local_box_filter_callback,
+ packed_vbox_filter_callback,
+ mlist_to_hlist_callback,
+ pre_dump_callback,
+ start_file_callback,
+ stop_file_callback,
+ intercept_tex_error_callback,
+ intercept_lua_error_callback,
+ show_error_message_callback,
+ show_warning_message_callback,
+ hpack_quality_callback,
+ vpack_quality_callback,
+ insert_par_callback,
+ append_line_filter_callback,
+ build_page_insert_callback,
+ /* fire_up_output_callback, */
+ wrapup_run_callback,
+ begin_paragraph_callback,
+ paragraph_context_callback,
+ /* get_math_char_callback, */
+ math_rule_callback,
+ make_extensible_callback,
+ register_extensible_callback,
+ show_whatsit_callback,
+ get_attribute_callback,
+ get_noad_class_callback,
+ get_math_dictionary_callback,
+ show_lua_call_callback,
+ trace_memory_callback,
+ handle_overload_callback,
+ missing_character_callback,
+ process_character_callback,
+ total_callbacks,
+} callback_callback_types;
+
+typedef struct callback_state_info {
+ int metatable_id;
+ int padding;
+ int values[total_callbacks];
+} callback_state_info;
+
+extern callback_state_info lmt_callback_state;
+
+typedef enum callback_keys {
+ callback_boolean_key = 'b', /*tex a boolean (int) */
+ callback_charnum_key = 'c', /*tex a byte (char) */
+ callback_integer_key = 'd', /*tex an integer */
+ callback_line_key = 'l', /*tex a buffer section, with implied start */
+ callback_strnumber_key = 's', /*tex a \TEX\ string (index) */
+ callback_lstring_key = 'L', /*tex a \LUA\ string (struct) */
+ callback_node_key = 'N', /*tex a \TEX\ node (halfword) */
+ callback_string_key = 'S', /*tex a \CCODE\ string */
+ callback_result_key = 'R', /*tex a string (return value) but nil is also okay */
+} callback_keys;
+
+inline static int lmt_callback_defined (int a) { return lmt_callback_state.values[a]; }
+inline static int lmt_callback_call (lua_State *L, int i, int o, int top) { return lua_pcallk(L, i, o, top + 2, 0, NULL); }
+
+extern int lmt_callback_okay (lua_State *L, int i, int *top);
+extern void lmt_callback_error (lua_State *L, int top, int i);
+inline void lmt_callback_wrapup (lua_State *L, int top) { lua_settop(L, top); }
+
+extern int lmt_run_callback (lua_State *L, int i, const char *values, ...);
+extern int lmt_run_and_save_callback (lua_State *L, int i, const char *values, ...);
+extern int lmt_run_saved_callback_line (lua_State *L, int i, int firstpos);
+extern int lmt_run_saved_callback_close (lua_State *L, int i);
+
+extern void lmt_destroy_saved_callback (lua_State *L, int i);
+
+extern void lmt_run_memory_callback (const char *what, int success);
+
+extern void lmt_push_callback_usage (lua_State *L);
+
+# endif
+
diff --git a/source/luametatex/source/lua/lmtenginelib.c b/source/luametatex/source/lua/lmtenginelib.c
new file mode 100644
index 000000000..f8df06657
--- /dev/null
+++ b/source/luametatex/source/lua/lmtenginelib.c
@@ -0,0 +1,1146 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+engine_state_info lmt_engine_state = {
+ .lua_init = 0,
+ .lua_only = 0,
+ .luatex_banner = NULL,
+ .engine_name = NULL,
+ .startup_filename = NULL,
+ .startup_jobname = NULL,
+ .dump_name = NULL,
+ .utc_time = 0,
+ .permit_loadlib = 0,
+};
+
+/*tex
+ We assume that the strings are proper \UTF\ and in \MSWINDOWS\ we handle wide characters to get
+ that right.
+*/
+
+typedef struct environment_state_info {
+ char **argv;
+ int argc;
+ int npos;
+ char *flag;
+ char *value;
+ char *name;
+ char *ownpath;
+ char *ownbase;
+ char *ownname;
+ char *owncore;
+ char *input_name;
+ int luatex_lua_offset;
+} environment_state_info;
+
+static environment_state_info lmt_environment_state = {
+ .argv = NULL,
+ .argc = 0,
+ .npos = 0,
+ .flag = NULL,
+ .value = NULL,
+ .name = NULL,
+ .ownpath = NULL,
+ .ownbase = NULL,
+ .ownname = NULL,
+ .owncore = NULL,
+ .input_name = NULL,
+ .luatex_lua_offset = 0,
+};
+
+/*tex todo: make helpers in loslibext which has similar code */
+
+static void enginelib_splitnames(void)
+{
+ char *p = lmt_memory_strdup(lmt_environment_state.ownpath); /*tex We need to make copies! */
+ /*
+ printf("ownpath = %s\n",environment_state.ownpath);
+ printf("ownbase = %s\n",environment_state.ownbase);
+ printf("ownname = %s\n",environment_state.ownname);
+ printf("owncore = %s\n",environment_state.owncore);
+ */
+ /*
+ We loose some here but not enough to worry about. Maybe eventually we will use our own
+ |basename| and |dirname| anyway.
+ */
+ lmt_environment_state.ownbase = aux_basename(lmt_memory_strdup(p));
+ lmt_environment_state.ownname = aux_basename(lmt_memory_strdup(p));
+ lmt_environment_state.ownpath = aux_dirname(lmt_memory_strdup(p)); /* We could use p and not free later, but this is cleaner. */
+ /* */
+ for (size_t i = 0; i < strlen(lmt_environment_state.ownname); i++) {
+ if (lmt_environment_state.ownname[i] == '.') {
+ lmt_environment_state.ownname[i] = '\0';
+ break ;
+ }
+ }
+ lmt_environment_state.owncore = lmt_memory_strdup(lmt_environment_state.ownname);
+ /*
+ printf("ownpath = %s\n",environment_state.ownpath);
+ printf("ownbase = %s\n",environment_state.ownbase);
+ printf("ownname = %s\n",environment_state.ownname);
+ printf("owncore = %s\n",environment_state.owncore);
+ */
+ lmt_memory_free(p);
+}
+
+/*tex A bunch of internalized strings: see |linterface.h |.*/
+
+/* declare_shared_lua_keys; */
+/* declare_metapost_lua_keys; */
+
+char *tex_engine_input_filename(void)
+{
+ /*tex When npos equals zero we have no filename i.e. nothing that doesn't start with |--|. */
+ return lmt_environment_state.npos > 0 && lmt_environment_state.npos < lmt_environment_state.argc ? lmt_environment_state.argv[lmt_environment_state.npos] : NULL;
+}
+
+/*tex
+
+ Filenames can have spaces in which case (double) quotes are used to indicate the bounds of the
+ string. At the \TEX\ level curly braces are also an option but these are dealt with in the
+ scanner.
+
+ Comment: maybe we should also support single quotes, so that we're consistent with \LUA\ quoting.
+
+*/
+
+static char *enginelib_normalize_quotes(const char* name, const char* mesg)
+{
+ char *ret = lmt_memory_malloc(strlen(name) + 3);
+ if (ret) {
+ int must_quote = strchr(name, ' ') != NULL;
+ /* Leave room for quotes and NUL. */
+ int quoted = 0;
+ char *p = ret;
+ if (must_quote) {
+ *p++ = '"';
+ }
+ for (const char *q = name; *q; q++) {
+ if (*q == '"') {
+ quoted = ! quoted;
+ } else {
+ *p++ = *q;
+ }
+ }
+ if (must_quote) {
+ *p++ = '"';
+ }
+ *p = '\0';
+ if (quoted) {
+ tex_emergency_message("system", "unbalanced quotes in %s %s\n", mesg, name);
+ tex_emergency_exit();
+ }
+ }
+ return ret;
+}
+
+/*
+
+ We support a minimum set of options but more can be supported by supplying an (startup)
+ initialization script and/or by setting values in the |texconfig| table. At some point we might
+ provide some default initiazation script but that's for later. In fact, a bug in \LUATEX\ <
+ 1.10 made some of the command line options get lost anyway due to setting their values before
+ checking the config table (probably introduced at some time). As no one noticed that anyway,
+ removing these from the commandline is okay.
+
+ Part of the commandline handler is providing (minimal) help information and reporting credits
+ (more credits can be found in the source file). Here comes the basic help.
+
+ At some point I will likely add a |--permitloadlib| flag and block loading of libraries when
+ that flag is not given so that we satisfy operating systems and/or distributions that have some
+ restrictions on loading libraries. It also means that the optional modules will be (un)locked,
+ but we can control that in the runners so it's no big deal because we will never depend on
+ external code for the \CONTEXT\ core features.
+
+*/
+
+static void enginelib_show_help(void)
+{
+ puts(
+ "Usage: " luametatex_name_lowercase " --lua=FILE [OPTION]... [TEXNAME[.tex]] [COMMANDS]\n"
+ " or: " luametatex_name_lowercase " --lua=FILE [OPTION]... \\FIRST-LINE\n"
+ " or: " luametatex_name_lowercase " --lua=FILE [OPTION]... &FMT ARGS\n"
+ "\n"
+ "Run " luametatex_name_camelcase " on TEXNAME, usually creating TEXNAME.pdf. Any remaining COMMANDS"
+ "are processed as luatex input, after TEXNAME is read.\n"
+ "\n"
+ "Alternatively, if the first non-option argument begins with a backslash,\n"
+ luametatex_name_camelcase " interprets all non-option arguments as an input line.\n"
+ "\n"
+ "Alternatively, if the first non-option argument begins with a &, the next word\n"
+ "is taken as the FMT to read, overriding all else. Any remaining arguments are\n"
+ "processed as above.\n"
+ "\n"
+ "If no arguments or options are specified, prompt for input.\n"
+ "\n"
+ "The following regular options are understood:\n"
+ "\n"
+ " --credits display credits and exit\n"
+ " --fmt=FORMAT load the format file FORMAT\n"
+ " --help display help and exit\n"
+ " --ini be ini" luametatex_name_lowercase ", for dumping formats\n"
+ " --jobname=STRING set the job name to STRING\n"
+ " --lua=FILE load and execute a lua initialization script\n"
+ " --version display version and exit\n"
+ "\n"
+ "Alternate behaviour models can be obtained by special switches\n"
+ "\n"
+ " --luaonly run a lua file, then exit\n"
+ "\n"
+ "Loading libraries from Lua is blocked unless one explicitly permits it:\n"
+ "\n"
+ " --permitloadlib permit loading of external libraries (coming)\n"
+ "\n"
+ "See the reference manual for more information about the startup process.\n"
+ "\n"
+ "Email bug reports to " luametatex_bug_address ".\n"
+ );
+ exit(EXIT_SUCCESS);
+}
+
+/*tex
+
+ This is the minimal version info display. The credits option provides a bit more information.
+*/
+
+static void enginelib_show_version_info(void)
+{
+ tex_print_version_banner();
+ puts(
+ "\n"
+ "\n"
+ "Execute '" luametatex_name_lowercase " --credits' for credits and version details.\n"
+ "\n"
+ "There is NO warranty. Redistribution of this software is covered by the terms\n"
+ "of the GNU General Public License, version 2 or (at your option) any later\n"
+ "version. For more information about these matters, see the file named COPYING\n"
+ "and the LuaMetaTeX source.\n"
+ "\n"
+ "Functionality : level " LMT_TOSTRING(luametatex_development_id) "\n"
+ "Support : " luametatex_support_address "\n"
+ "Copyright : The Lua(Meta)TeX Team(s) (2005-2022+)\n"
+ "\n"
+ "The LuaMetaTeX project is related to ConTeXt development. This macro package\n"
+ "tightly integrates TeX and MetaPost in close cooperation with Lua. Updates will\n"
+ "happen in sync with ConTeXt and when needed. Don't be fooled by unchanged dates:\n"
+ "long term stability is the objective."
+ );
+ exit(EXIT_SUCCESS);
+}
+
+/*tex
+
+ We only mention the most relevelant credits here. The first part is there to indicate a bit of
+ history. A very large part of the code, of course, comes from Don Knuths original \TEX, and the
+ same is true for most documentation!
+
+ Most of the \ETEX\ extensions are present too. Much of the expansion and protrusion code
+ originates in \PDFTEX\ but we don't have any of its backend code. From \OMEGA\ (\ALEPH) we took
+ bits and pieces too, for instance the basics of handling directions but at this point we only
+ have two directions left (that don't need much code). One features that sticks are the left-
+ and right boxes.
+
+ The \METAPOST\ library is an important component and also add quite some code. Here we use a
+ stripped down version of the version 2 library with some extra additions.
+
+ We take \LUA\ as it is. In the meantime we went from \LUA\ 5.2 to 5.3 to 5.4 and will follow up
+ on what makes sense. For as far as possible no changes are made but there are some configuration
+ options in use. We use an \UTF8\ aware setup. Of course \LPEG\ is part of the deal.
+
+ The lean and mean \PDF\ library is made for \LUATEX\ and we use that one here too. In
+ \LUAMETATEX\ we use some of its helpers to implement for instance md5 and sha support. In
+ \LUAMETATEX\ there are some more than mentioned here but they are {\em not} part of the default
+ binary. Some libraries mentioned below can become loaded on demand.
+
+*/
+
+static void enginelib_show_credits(void)
+{
+ tex_print_version_banner();
+ puts(
+ "\n"
+ "\n"
+ "Here we mention those involved in the bits and pieces that define " luametatex_name_camelcase ". More details of\n"
+ "what comes from where can be found in the manual and other documents (that come with ConTeXt).\n"
+ "\n"
+ " luametatex : Hans Hagen, Alan Braslau, Mojca Miklavec, Wolfgang Schuster, Mikael Sundqvist\n"
+ "\n"
+ "It is a follow up on:\n"
+ "\n"
+ " luatex : Hans Hagen, Hartmut Henkel, Taco Hoekwater, Luigi Scarso\n"
+ "\n"
+ "This program itself builds upon the code from:\n"
+ "\n"
+ " tex : Donald Knuth\n"
+ "\n"
+ "We also took a few features from:\n"
+ "\n"
+ " etex : Peter Breitenlohner, Phil Taylor and friends\n"
+ "\n"
+ "The font expansion and protrusion code is derived from:\n"
+ "\n"
+ " pdftex : Han The Thanh and friends\n"
+ "\n"
+ "Part of the bidirectional text flow model is inspired by:\n"
+ "\n"
+ " omega : John Plaice and Yannis Haralambous\n"
+ " aleph : Giuseppe Bilotta\n"
+ "\n"
+ "Graphic support is originates in:\n"
+ "\n"
+ " metapost : John Hobby, Taco Hoekwater, Luigi Scarso, Hans Hagen and friends\n"
+ "\n"
+ "All this is opened up with:\n"
+ "\n"
+ " lua : Roberto Ierusalimschy, Waldemar Celes and Luiz Henrique de Figueiredo\n"
+ " lpeg : Roberto Ierusalimschy\n"
+ "\n"
+ "A few libraries are embedded, of which we mention:\n"
+ "\n"
+# ifdef MI_MALLOC_VERSION
+ " mimalloc : Daan Leijen (https://github.com/microsoft/mimalloc)\n" /* not enabled for arm yet */
+# endif
+ " miniz : Rich Geldreich etc\n"
+ " pplib : Paweł Jackowski (with partial code from libraries)\n"
+ " md5 : Peter Deutsch (with partial code from pplib libraries)\n"
+ " sha2 : Aaron D. Gifford (with partial code from pplib libraries)\n"
+ " socket : Diego Nehab (partial and adapted)\n"
+ " libcerf : Joachim Wuttke (adapted for MSVC)\n"
+ " decnumber : Mike Cowlishaw from IBM (one of the number models in MP)\n"
+ " avl : Richard (adapted a bit to fit in)\n"
+ " hjn : Raph Levien (derived from TeX's hyphenator, but adapted again)\n"
+ "\n"
+ "The code base contains more names and references. Some libraries are partially adapted or\n"
+ "have been replaced. The MetaPost library has additional functionality, some of which is\n"
+ "experimental. The LuaMetaTeX project relates to ConTeXt. This LuaMetaTeX 2+ variant is a\n"
+ "lean and mean variant of LuaTeX 1+ but the core typesetting functionality is the same and\n"
+ "and has been extended in many aspects.\n"
+ "\n"
+ "There is a lightweight subsystem for optional libraries but here we also delegate as much\n"
+ "as possibe to Lua. A few interfaces are provided bny default, others can be added using a\n"
+ "simple foreign interface subsystem. Although this is provided an dconsidered part of the\n"
+ "LuaMetaTeX engine it is not something ConTeXt depends (and will) depend on.\n"
+ "\n"
+ "version : " luametatex_version_string " | " LMT_TOSTRING(luametatex_development_id) "\n"
+ "format id : " LMT_TOSTRING(luametatex_format_fingerprint) "\n"
+# ifdef __DATE__
+ "date : " __TIME__ " | " __DATE__ "\n"
+# endif
+# ifdef LMT_COMPILER_USED
+ "compiler : " LMT_COMPILER_USED "\n"
+# endif
+ );
+ exit(EXIT_SUCCESS);
+}
+
+/*tex
+
+ Some properties of the command line (and startup call) are reflected in variables that start
+ with \type {self}.
+
+*/
+
+static void enginelib_prepare_cmdline(int zero_offset)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ /*tex We keep this reorganized |arg| table, which can start at -3! */
+ lua_createtable(L, lmt_environment_state.argc, 0);
+ for (lua_Integer i = 0; i < lmt_environment_state.argc; i++) {
+ lua_set_string_by_index(L, (int) (i - zero_offset), lmt_environment_state.argv[i]);
+ }
+ lua_setglobal(L, "arg");
+ /* */
+ lua_getglobal(L, "os");
+ lua_set_string_by_key(L, "selfbin", lmt_environment_state.argv[0]);
+ lua_set_string_by_key(L, "selfpath", lmt_environment_state.ownpath);
+ lua_set_string_by_key(L, "selfdir", lmt_environment_state.ownpath); /* for old times sake */
+ lua_set_string_by_key(L, "selfbase", lmt_environment_state.ownbase);
+ lua_set_string_by_key(L, "selfname", lmt_environment_state.ownname);
+ lua_set_string_by_key(L, "selfcore", lmt_environment_state.owncore);
+ lua_createtable(L, lmt_environment_state.argc, 0);
+ for (lua_Integer i = 0; i < lmt_environment_state.argc; i++) {
+ lua_set_string_by_index(L, (int) i, lmt_environment_state.argv[i]);
+ }
+ lua_setfield(L, -2, "selfarg");
+}
+
+/*tex
+
+ Argument checking is somewhat tricky because it can interfere with the used console (shell). It
+ makes sense to combine this with the \LUA\ command line parser code but even that is no real way
+ out. For instance, on \MSWINDOWS\ we need to deal with wide characters.
+
+ The code below is as independent from libraries as possible and differs from the the code used
+ in other \TEX\ engine. We issue no warnings and silently recover, because in the end the macro
+ package (and its \LUA\ code) can deal with that.
+
+*/
+
+static void enginelib_check_option(char **options, int i)
+{
+ char *option = options[i];
+ char *n = option;
+ lmt_environment_state.flag = NULL;
+ lmt_environment_state.value = NULL;
+ if (*n == '-') {
+ n++;
+ } else {
+ goto NOTHING;
+ }
+ if (*n == '-') {
+ n++;
+ } else {
+ goto NOTHING;
+ }
+ if (*n == '\0') {
+ return;
+ }
+ {
+ char *v = strchr(n, '=');
+ size_t l = (int) (v ? (v - n) : strlen(n));
+ lmt_environment_state.flag = lmt_memory_malloc(l + 1);
+ if (lmt_environment_state.flag) {
+ memcpy(lmt_environment_state.flag, n, l);
+ lmt_environment_state.flag[l] = '\0';
+ if (v) {
+ v++;
+ l = (int) strlen(v);
+ lmt_environment_state.value = lmt_memory_malloc(l + 1);
+ if (lmt_environment_state.value) {
+ memcpy(lmt_environment_state.value, v, l);
+ lmt_environment_state.value[l] = '\0';
+ }
+ }
+ }
+ return;
+ }
+ NOTHING:
+ if (lmt_environment_state.name == NULL && i > 0) {
+ lmt_environment_state.name = option;
+ lmt_environment_state.npos = i;
+ }
+}
+
+/*tex
+
+ The |lmt| suffix is actually a \CONTEXT\ thing but it permits us to have \LUA\ files for
+ \LUAMETATEX\ and \LUATEX\ alongside. The ones for this engine can use a more recent variant of
+ \LUA\ and thereby be not compatible. Especially syntax extension complicates this like using
+ |<const>| in \LUA 5.4+ or before that bitwise operators in \LUA\ 5.3 (not/never in \LUAJIT).
+
+*/
+
+const char *suffixes[] = { "lmt", "lua", NULL };
+
+static void enginelib_parse_options(void)
+{
+ /*tex We add 5 chars (separator and suffix) so we reserve 6. */
+ char *firstfile = (char*) lmt_memory_malloc(strlen(lmt_environment_state.ownpath) + strlen(lmt_environment_state.owncore) + 6);
+ for (int i = 0; suffixes[i]; i++) {
+ sprintf(firstfile, "%s/%s.%s", lmt_environment_state.ownpath, lmt_environment_state.owncore, suffixes[i]);
+ /* stat */
+ if (aux_is_readable(firstfile)) {
+ lmt_memory_free(lmt_engine_state.startup_filename);
+ lmt_engine_state.startup_filename = firstfile;
+ lmt_environment_state.luatex_lua_offset = 0;
+ lmt_engine_state.lua_only = 1;
+ lmt_engine_state.lua_init = 1;
+ return;
+ }
+ }
+ lmt_memory_free(firstfile);
+ firstfile = NULL;
+ /* */
+ for (int i = 1;;) {
+ if (i == lmt_environment_state.argc || *lmt_environment_state.argv[i] == '\0') {
+ break;
+ }
+ enginelib_check_option(lmt_environment_state.argv, i);
+ i++;
+ if (! lmt_environment_state.flag) {
+ continue;
+ }
+ if (strcmp(lmt_environment_state.flag, "luaonly") == 0) {
+ lmt_engine_state.lua_only = 1;
+ lmt_environment_state.luatex_lua_offset = i;
+ lmt_engine_state.lua_init = 1;
+ } else if (strcmp(lmt_environment_state.flag, "lua") == 0) {
+ if (lmt_environment_state.value) {
+ lmt_memory_free(lmt_engine_state.startup_filename);
+ lmt_engine_state.startup_filename = lmt_memory_strdup(lmt_environment_state.value);
+ lmt_environment_state.luatex_lua_offset = i - 1;
+ lmt_engine_state.lua_init = 1;
+ }
+ } else if (strcmp(lmt_environment_state.flag, "jobname") == 0) {
+ if (lmt_environment_state.value) {
+ lmt_memory_free(lmt_engine_state.startup_jobname);
+ lmt_engine_state.startup_jobname = lmt_memory_strdup(lmt_environment_state.value);
+ }
+ } else if (strcmp(lmt_environment_state.flag, "fmt") == 0) {
+ if (lmt_environment_state.value) {
+ lmt_memory_free(lmt_engine_state.dump_name);
+ lmt_engine_state.dump_name = lmt_memory_strdup(lmt_environment_state.value);
+ }
+ } else if (! lmt_engine_state.permit_loadlib && strcmp(lmt_environment_state.flag, "permitloadlib") == 0) {
+ lmt_engine_state.permit_loadlib = 1;
+ } else if (strcmp(lmt_environment_state.flag, "ini") == 0) {
+ lmt_main_state.run_state = initializing_state;
+ } else if (strcmp(lmt_environment_state.flag, "help") == 0) {
+ enginelib_show_help();
+ } else if (strcmp(lmt_environment_state.flag, "version") == 0) {
+ enginelib_show_version_info();
+ } else if (strcmp(lmt_environment_state.flag, "credits") == 0) {
+ enginelib_show_credits();
+ }
+ lmt_memory_free(lmt_environment_state.flag);
+ lmt_environment_state.flag = NULL;
+ if (lmt_environment_state.value) {
+ lmt_memory_free(lmt_environment_state.value);
+ lmt_environment_state.value = NULL;
+ }
+ }
+ /*tex This is an attempt to find |input_name| or |dump_name|. */
+ if (lmt_environment_state.argv[lmt_environment_state.npos]) { /* aka name */
+ if (lmt_engine_state.lua_only) {
+ if (! lmt_engine_state.startup_filename) {
+ lmt_engine_state.startup_filename = lmt_memory_strdup(lmt_environment_state.argv[lmt_environment_state.npos]);
+ lmt_environment_state.luatex_lua_offset = lmt_environment_state.npos;
+ }
+ } else if (lmt_environment_state.argv[lmt_environment_state.npos][0] == '&') {
+ /*tex This is historic but and might go away. */
+ if (! lmt_engine_state.dump_name) {
+ lmt_engine_state.dump_name = lmt_memory_strdup(lmt_environment_state.argv[lmt_environment_state.npos] + 1);
+ }
+ } else if (lmt_environment_state.argv[lmt_environment_state.npos][0] == '*') {
+ /*tex This is historic but and might go away. */
+ if (! lmt_environment_state.input_name) {
+ lmt_environment_state.input_name = lmt_memory_strdup(lmt_environment_state.argv[lmt_environment_state.npos] + 1);
+ }
+ } else if (lmt_environment_state.argv[lmt_environment_state.npos][0] == '\\') {
+ /*tex We have a command but this and might go away. */
+ } else {
+ /*tex We check for some suffixes first. */
+ firstfile = lmt_memory_strdup(lmt_environment_state.argv[lmt_environment_state.npos]);
+ for (int i = 0; suffixes[i]; i++) {
+ if (strstr(firstfile, suffixes[i]) == firstfile + strlen(firstfile) - 4){
+ if (lmt_engine_state.startup_filename) {
+ lmt_memory_free(firstfile);
+ } else {
+ lmt_engine_state.startup_filename = firstfile;
+ lmt_environment_state.luatex_lua_offset = lmt_environment_state.npos;
+ lmt_engine_state.lua_only = 1;
+ lmt_engine_state.lua_init = 1;
+ }
+ goto DONE;
+ }
+ }
+ if (lmt_environment_state.input_name) {
+ lmt_memory_free(firstfile);
+ } else {
+ lmt_environment_state.input_name = firstfile;
+ }
+ }
+ }
+ DONE:
+ /*tex Finalize the input filename. */
+ if (lmt_environment_state.input_name) {
+ /* probably not ok */
+ lmt_environment_state.argv[lmt_environment_state.npos] = enginelib_normalize_quotes(lmt_environment_state.input_name, "argument");
+ }
+}
+
+/*tex
+
+ Being a general purpose typesetting system, a \TEX\ system normally has its own way of dealing
+ with language, script, country etc.\ specific properties. It is for that reason that we disable
+ locales.
+
+*/
+
+static void enginelib_set_locale(void)
+{
+ setlocale(LC_ALL, "C");
+}
+
+static void enginelib_update_options(void)
+{
+ int starttime = -1;
+ int utc = -1;
+ int permitloadlib = -1;
+ if (! lmt_environment_state.input_name) {
+ tex_engine_get_config_string("jobname", &lmt_environment_state.input_name);
+ }
+ if (! lmt_engine_state.dump_name) {
+ tex_engine_get_config_string("formatname", &lmt_engine_state.dump_name);
+ }
+ tex_engine_get_config_number("starttime", &starttime);
+ if (starttime >= 0) {
+ aux_set_start_time(starttime);
+ }
+ tex_engine_get_config_boolean("useutctime", &utc);
+ if (utc >= 0 && utc <= 1) {
+ lmt_engine_state.utc_time = utc;
+ }
+ tex_engine_get_config_boolean("permitloadlib", &permitloadlib);
+ if (permitloadlib >= 0) {
+ lmt_engine_state.permit_loadlib = permitloadlib;
+ }
+}
+
+/*tex
+
+ We have now arrived at the main initializer. What happens after this is determined by what
+ callbacks are set. The engine can behave as just a \LUA\ interpreter, startup the \TEX\
+ machinery in so called virgin mode, or load a format and carry on from that.
+
+*/
+
+void tex_engine_initialize(int ac, char **av)
+{
+ /*tex Save to pass along to topenin. */
+ lmt_print_state.selector = terminal_selector_code;
+ lmt_environment_state.argc = aux_utf8_setargv(&lmt_environment_state.argv, av, ac);
+ /* initializations */
+ lmt_engine_state.lua_only = 0;
+ lmt_engine_state.lua_init = 0;
+ lmt_engine_state.startup_filename = NULL;
+ lmt_engine_state.startup_jobname = NULL;
+ lmt_engine_state.engine_name = luametatex_name_lowercase;
+ lmt_engine_state.dump_name = NULL;
+ lmt_engine_state.luatex_banner = lmt_memory_strdup(lmt_version_state.banner);
+ /* preparations */
+ lmt_environment_state.ownpath = aux_utf8_getownpath(lmt_environment_state.argv[0]);
+ enginelib_splitnames();
+ aux_set_run_time();
+ /*tex
+ Some options must be initialized before options are parsed. We don't need that many as we
+ can delegate to \LUA.
+ */
+ /*tex Parse the commandline. */
+ enginelib_parse_options();
+ /*tex Forget about locales. */
+ enginelib_set_locale();
+ /*tex Initialize the \LUA\ instance and keys. */
+ lmt_initialize();
+ /*tex This can be redone later. */
+ lmt_initialize_functions(0);
+ lmt_initialize_properties(0);
+ /*tex For word handlers. */
+ lmt_initialize_languages();
+ /*tex Here start the key definitions (will become functions). */
+ lmt_initialize_interface();
+ lmt_nodelib_initialize();
+ lmt_tokenlib_initialize();
+ lmt_fontlib_initialize();
+ /*tex Collect arguments. */
+ enginelib_prepare_cmdline(lmt_environment_state.luatex_lua_offset);
+ if (lmt_engine_state.startup_filename && ! aux_is_readable(lmt_engine_state.startup_filename)) {
+ lmt_memory_free(lmt_engine_state.startup_filename);
+ lmt_engine_state.startup_filename = NULL;
+ }
+ /*tex
+ Now run the file (in \LUATEX\ there is a special \TEX\ table pushed with limited
+ functionality (initialize, run, finish) but the normal tex helpers are not unhidden so
+ basically one has no \TEX. We no longer have that.
+ */
+ if (lmt_engine_state.startup_filename) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (lmt_engine_state.lua_only) {
+ if (luaL_loadfile(L, lmt_engine_state.startup_filename)) {
+ tex_emergency_message("lua error", "startup file: %s", lmt_error_string(L, -1));
+ tex_emergency_exit();
+ } else if (lua_pcall(L, 0, 0, 0)) {
+ tex_emergency_message("lua error", "function call: %s", lmt_error_string(L, -1));
+ lmt_traceback(L);
+ tex_emergency_exit();
+ } else {
+ /*tex We're okay. */
+ exit(lmt_error_state.default_exit_code);
+ }
+ } else {
+ /*tex a normal tex run */
+ if (luaL_loadfile(L, lmt_engine_state.startup_filename)) {
+ tex_emergency_message("lua error", "startup file: %s", lmt_error_string(L, -1));
+ tex_emergency_exit();
+ } else if (lua_pcall(L, 0, 0, 0)) {
+ tex_emergency_message("lua error", "function call: %s", lmt_error_string(L, -1));
+ lmt_traceback(L);
+ tex_emergency_exit();
+ }
+ enginelib_update_options();
+ tex_check_fmt_name();
+ }
+ } else if (lmt_engine_state.lua_init) {
+ tex_emergency_message("startup error", "no valid startup file given, quitting");
+ tex_emergency_exit();
+ } else {
+ tex_check_fmt_name();
+ }
+}
+
+/*tex
+
+ For practical and historical reasons some of the initalization and checking is split. The
+ mainbody routine call out to these functions. The timing is sort of tricky: we can use a start
+ up script, that sets some configuration parameters, and for sure some callbacks, and these, in
+ turn, are then responsible for follow up actions like telling where to find the format file
+ (when a dump is loaded) or startup file (when we're in virgin mode). When we are in neither of
+ these modes the engine is just a \LUA\ interpreter which means that only a subset of libraries
+ is initialized.
+
+*/
+
+static void tex_engine_get_config_numbers(const char *name, int *minimum, int *maximum, int *size, int *step)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (L && size) {
+ int stacktop = lua_gettop(L);
+ if (lua_getglobal(L, "texconfig") == LUA_TTABLE) {
+ switch (lua_getfield(L, -1, name)) {
+ case LUA_TNUMBER:
+ if (size) {
+ *size = (int) lmt_roundnumber(L, -1);
+ }
+ break;
+ case LUA_TTABLE:
+ if (size && lua_getfield(L, -1, "size")) {
+ *size = (int) lmt_roundnumber(L, -1);
+ }
+ lua_pop(L, 1);
+ if (size && lua_getfield(L, -1, "plus")) {
+ *size += (int) lmt_roundnumber(L, -1);
+ }
+ lua_pop(L, 1);
+ if (step && lua_getfield(L, -1, "step")) {
+ int stp = (int) lmt_roundnumber(L, -1);
+ if (stp > *step) {
+ *step = stp;
+ }
+ }
+ break;
+ }
+ if (minimum && *size < *minimum) {
+ *size = *minimum;
+ } else if (maximum && *size > *maximum) {
+ *size = *maximum;
+ }
+ }
+ lua_settop(L, stacktop);
+ }
+}
+
+void tex_engine_set_memory_data(const char *name, memory_data *data)
+{
+ tex_engine_get_config_numbers(name, &data->minimum, &data->maximum, &data->size, &data->step);
+}
+
+void tex_engine_set_limits_data(const char *name, limits_data *data)
+{
+ tex_engine_get_config_numbers(name, &data->minimum, &data->maximum, &data->size, NULL);
+}
+
+void tex_engine_get_config_boolean(const char *name, int *target)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (L) {
+ int stacktop = lua_gettop(L);
+ if (lua_getglobal(L, "texconfig") == LUA_TTABLE) {
+ switch (lua_getfield(L, -1, name)) {
+ case LUA_TBOOLEAN:
+ *target = lua_toboolean(L, -1);
+ break;
+ case LUA_TNUMBER:
+ *target = (lua_tointeger(L, -1) == 0 ? 0 : 1);
+ break;
+ }
+ }
+ lua_settop(L, stacktop);
+ }
+}
+
+void tex_engine_get_config_number(const char *name, int *target)
+{
+ tex_engine_get_config_numbers(name, NULL, NULL, target, NULL);
+}
+
+void tex_engine_get_config_string(const char *name, char **target)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (L) {
+ int stacktop = lua_gettop(L);
+ if (lua_getglobal(L, "texconfig") == LUA_TTABLE) {
+ if (lua_getfield(L, -1, name) == LUA_TSTRING) {
+ *target = lmt_memory_strdup(lua_tostring(L, -1));
+ }
+ }
+ lua_settop(L, stacktop);
+ }
+}
+
+int tex_engine_run_config_function(const char *name)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (L) {
+ if (lua_getglobal(L, "texconfig") == LUA_TTABLE) {
+ if (lua_getfield(L, -1, name) == LUA_TFUNCTION) {
+ if (! lua_pcall(L, 0, 0, 0)) {
+ return 1;
+ } else {
+ /*tex
+ We can't be more precise here as it's called before \TEX\ initialization
+ happens.
+ */
+ tex_emergency_message("lua", "this went wrong: %s\n", lmt_error_string(L, -1));
+ tex_emergency_exit();
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+void tex_engine_check_configuration(void)
+{
+ tex_engine_run_config_function("init");
+}
+
+void lmt_make_table(
+ lua_State *L,
+ const char *tab,
+ const char *mttab,
+ lua_CFunction getfunc,
+ lua_CFunction setfunc
+)
+{
+ lua_pushstring(L, tab); /*tex |[{<tex>},"dimen"]| */
+ lua_newtable(L); /*tex |[{<tex>},"dimen",{}]| */
+ lua_settable(L, -3); /*tex |[{<tex>}]| */
+ lua_pushstring(L, tab); /*tex |[{<tex>},"dimen"]| */
+ lua_gettable(L, -2); /*tex |[{<tex>},{<dimen>}]| */
+ luaL_newmetatable(L, mttab); /*tex |[{<tex>},{<dimen>},{<dimen_m>}]| */
+ lua_pushstring(L, "__index"); /*tex |[{<tex>},{<dimen>},{<dimen_m>},"__index"]| */
+ lua_pushcfunction(L, getfunc); /*tex |[{<tex>},{<dimen>},{<dimen_m>},"__index","getdimen"]| */
+ lua_settable(L, -3); /*tex |[{<tex>},{<dimen>},{<dimen_m>}]| */
+ lua_pushstring(L, "__newindex"); /*tex |[{<tex>},{<dimen>},{<dimen_m>},"__newindex"]| */
+ lua_pushcfunction(L, setfunc); /*tex |[{<tex>},{<dimen>},{<dimen_m>},"__newindex","setdimen"]| */
+ lua_settable(L, -3); /*tex |[{<tex>},{<dimen>},{<dimen_m>}]| */
+ lua_setmetatable(L, -2); /*tex |[{<tex>},{<dimen>}]| : assign the metatable */
+ lua_pop(L, 1); /*tex |[{<tex>}]| : clean the stack */
+}
+
+static void *enginelib_aux_luaalloc(
+ void *ud, /*tex Not used, but passed by \LUA. */
+ void *ptr, /*tex The old pointer. */
+ size_t osize, /*tex The old size. */
+ size_t nsize /*tex The new size. */
+)
+{
+ (void) ud;
+ lmt_lua_state.used_bytes += (int) (nsize - osize);
+ if (lmt_lua_state.used_bytes > lmt_lua_state.used_bytes_max) {
+ lmt_lua_state.used_bytes_max = lmt_lua_state.used_bytes;
+ }
+ /*tex Quite some reallocs happen in \LUA. */
+ if (nsize == 0) {
+ /* printf("free %i\n",(int) osize); */
+ lmt_memory_free(ptr);
+ return NULL;
+ } else if (osize == 0) {
+ /* printf("malloc %i\n",(int) nsize); */
+ return lmt_memory_malloc(nsize);
+ } else {
+ /* printf("realloc %i -> %i\n",(int)osize,(int)nsize); */
+ return lmt_memory_realloc(ptr, nsize);
+ }
+}
+
+static int enginelib_aux_luapanic(lua_State *L)
+{
+ (void) L;
+ tex_emergency_message("lua", "panic: unprotected error in call to Lua API (%s)\n", lmt_error_string(L, -1));
+ return tex_emergency_exit();
+}
+
+static const luaL_Reg lmt_libs_lua_function_list[] = {
+ { "_G", luaopen_base },
+ { "package", luaopen_package },
+ { "table", luaopen_table },
+ { "io", luaopen_io },
+ { "os", luaopen_os },
+ { "string", luaopen_string },
+ { "math", luaopen_math },
+ { "debug", luaopen_debug },
+ { "lpeg", luaopen_lpeg },
+ { "utf8", luaopen_utf8 },
+ { "coroutine", luaopen_coroutine },
+ { NULL, NULL },
+};
+
+static const luaL_Reg lmt_libs_extra_function_list[] = {
+ { "md5", luaopen_md5 },
+ { "sha2", luaopen_sha2 },
+ { "aes", luaopen_aes },
+ { "basexx", luaopen_basexx },
+ { "lfs", luaopen_filelib }, /* for practical reasons we keep this namespace */
+ { "fio", luaopen_fio },
+ { "sio", luaopen_sio },
+ { "sparse", luaopen_sparse },
+ { "xzip", luaopen_xzip },
+ { "xmath", luaopen_xmath },
+ { "xcomplex", luaopen_xcomplex },
+ { "xdecimal", luaopen_xdecimal },
+ { NULL, NULL },
+};
+
+static const luaL_Reg lmt_libs_socket_function_list[] = {
+ { "socket", luaopen_socket_core },
+ { "mime", luaopen_mime_core },
+ { NULL, NULL },
+};
+
+static const luaL_Reg lmt_libs_more_function_list[] = {
+ { "lua", luaopen_lua },
+ { "luac", luaopen_luac },
+ { "status", luaopen_status },
+ { "texio", luaopen_texio },
+ { NULL, NULL },
+};
+
+static const luaL_Reg lmt_libs_tex_function_list[] = {
+ { "tex", luaopen_tex },
+ { "token", luaopen_token },
+ { "node", luaopen_node },
+ { "callback", luaopen_callback },
+ { "font", luaopen_font },
+ { "language", luaopen_language },
+ { NULL, NULL },
+};
+
+static const luaL_Reg lmt_libs_mp_function_list[] = {
+ { "mplib", luaopen_mplib },
+ { NULL, NULL },
+};
+
+static const luaL_Reg lmt_libs_pdf_function_list[] = {
+ { "pdfe", luaopen_pdfe },
+ { "pdfdecode", luaopen_pdfdecode },
+ { "pngdecode", luaopen_pngdecode },
+ { NULL, NULL },
+};
+
+/*tex
+
+ So, we have different library initialization lists for the the two \TEX\ modes (ini and normal)
+ and \LUA\ mode (interpeter). It's not pretty yet but it might become better over time.
+
+ */
+
+static void enginelib_luaopen_liblist(lua_State *L, const luaL_Reg *lib)
+{
+ for (; lib->func; lib++) {
+ luaL_requiref(L, lib->name, lib->func, 1);
+ lua_setglobal(L, lib->name);
+ }
+}
+
+/*tex
+
+ In order to overcome (expected) debates about security we disable loading libraries unless
+ explicitly enabled (as in \LUATEX). An exception are the optional libraries, but as these
+ interfaces are rather bound to the cannonical \LUAMETATEX\ source code we can control these
+ from \CONTEXT\ of needed because before users can run code, we can block support of these
+ libraries. On the other hand, we have no reason to distrust the few that can (optionally) be
+ used (they also cannot clash with different \LUA\ versions).
+
+ \starttyping
+ package.loadlib = nil|
+ package.searchers[4] = nil
+ package.searchers[3] = nil
+ \stoptyping
+
+*/
+
+static int loadlib_warning(lua_State *L)
+{
+ (void) L;
+ tex_normal_error("lua loadlib", "you can only load external libraries when --permitloadlib is given");
+ return 0;
+}
+
+static void enginelib_disable_loadlib(lua_State *L)
+{
+ int top = lua_gettop(L);
+ lua_getglobal(L, "package");
+ lua_pushliteral(L, "loadlib");
+ lua_pushcfunction(L, &loadlib_warning);
+ lua_rawset(L, -3);
+ lua_pushliteral(L, "searchers");
+ lua_rawget(L, -2);
+ lua_pushnil(L);
+ lua_rawseti(L, -2, 4);
+ lua_pushnil(L);
+ lua_rawseti(L, -2, 3);
+ lua_settop(L, top);
+}
+
+void lmt_initialize(void)
+{
+ lua_State *L = lua_newstate(enginelib_aux_luaalloc, NULL);
+ if (L) {
+ /*tex By default we use the generational garbage collector. */
+ lua_gc(L, LUA_GCGEN, 0, 0);
+ /* */
+ lmt_lua_state.bytecode_max = -1;
+ lmt_lua_state.bytecode_bytes = 0;
+ lmt_lua_state.lua_instance = L;
+ /* */
+ lua_atpanic(L, &enginelib_aux_luapanic);
+ /*tex Initialize the internalized strings. */
+ lmt_initialize_shared_keys(L);
+ lmt_initialize_metapost_keys(L);
+ /*tex This initializes all the 'simple' libraries: */
+ enginelib_luaopen_liblist(L, lmt_libs_lua_function_list);
+ /*tex This initializes all the 'extra' libraries: */
+ enginelib_luaopen_liblist(L, lmt_libs_extra_function_list);
+ /*tex These are special: we extend them. */
+ luaextend_os(L);
+ luaextend_io(L);
+ luaextend_string(L);
+ /*tex Loading the socket library is a bit odd (old stuff). */
+ enginelib_luaopen_liblist(L, lmt_libs_socket_function_list);
+ /*tex This initializes the 'tex' related libraries that have some luaonly functionality */
+ enginelib_luaopen_liblist(L, lmt_libs_more_function_list);
+ /*tex This initializes the 'tex' related libraries. */
+ if (! lmt_engine_state.lua_only) {
+ enginelib_luaopen_liblist(L, lmt_libs_tex_function_list);
+ }
+ if (! lmt_engine_state.permit_loadlib) {
+ enginelib_disable_loadlib(L);
+ }
+ /*tex Optional stuff. */
+ luaopen_optional(L);
+ /*tex This initializes the 'metapost' related libraries. */
+ enginelib_luaopen_liblist(L, lmt_libs_mp_function_list);
+ /*tex This initializes the 'pdf' related libraries. */
+ enginelib_luaopen_liblist(L, lmt_libs_pdf_function_list);
+ /*tex This one can become optional! */
+ luaextend_xcomplex(L);
+ /*tex We're nearly done! In this table we're going to put some info: */
+ lua_createtable(L, 0, 0);
+ lua_setglobal(L, "texconfig");
+ /* Maybe this will embed the checkstack function that some libs need. */
+ /* lua_checkstack(L, 1); */
+ } else {
+ tex_emergency_message("system", "the Lua state can't be created");
+ tex_emergency_exit();
+ }
+}
+
+int lmt_traceback(lua_State *L)
+{
+ const char *msg = lua_tostring(L, 1);
+ luaL_traceback(L, L, msg ? msg : "<no message>", 1);
+ return 1;
+}
+
+void lmt_error(
+ lua_State *L,
+ const char *where, /*tex The message has two parts. */
+ int detail, /*tex A function slot or callback index or ... */
+ int is_fatal /*tex We quit if this is the case */
+)
+{
+ char* err = NULL;
+ if (lua_type(L, -1) == LUA_TSTRING) {
+ const char *luaerr = lua_tostring(L, -1);
+ size_t len = strlen(luaerr) + strlen(where) + 32; /*tex Add some slack. */
+ err = (char *) lmt_memory_malloc((unsigned) len);
+ if (err) {
+ if (detail >= 0) {
+ snprintf(err, len, "%s [%i]: %s", where, detail, luaerr);
+ } else {
+ snprintf(err, len, "%s: %s", where, luaerr);
+ }
+ if (lmt_error_state.last_lua_error) {
+ lmt_memory_free(lmt_error_state.last_lua_error);
+ }
+ }
+ lmt_error_state.last_lua_error = err;
+ }
+ 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. It is probably
+ too risky to show the error context now but we can imagine some more granularity.
+ */
+ tex_normal_error("lua", err ? err : where);
+ /*tex
+ This should never be reached, so there is no need to close, so let's make sure of
+ that!
+ */
+ /* lua_close(L); */
+ }
+ else {
+ tex_normal_warning("lua", err ? err : where);
+ }
+}
+
+/*tex
+
+ As with other dump related actions, this module provides its relevant properties. A dump is
+ just that: variables written to a stream, and an undump reads instead. Some basic checking
+ happens in these functions.
+
+*/
+
+void lmt_dump_engine_info(dumpstream f)
+{
+ /*tex We align |engine_name| to 4 bytes with one or more trailing |NUL|. */
+ int x = (int) strlen(lmt_engine_state.engine_name);
+ if (x > 0) {
+ char *format_engine = lmt_memory_malloc((size_t) x + 5);
+ if (format_engine) {
+ memcpy(format_engine, lmt_engine_state.engine_name, (size_t) x + 1);
+ for (int k = x; k <= x + 3; k++) {
+ format_engine[k] = 0;
+ }
+ x = x + 4 - (x % 4);
+ dump_int(f, x);
+ dump_things(f, format_engine[0], x);
+ lmt_memory_free(format_engine);
+ return;
+ }
+ }
+ tex_normal_error("system","dumping engine info failed");
+}
+
+void lmt_undump_engine_info(dumpstream f)
+{
+ int x;
+ undump_int(f, x);
+ if ((x > 1) && (x < 256)) {
+ char *format_engine = lmt_memory_malloc((size_t) x);
+ if (format_engine) {
+ undump_things(f, format_engine[0], x);
+ format_engine[x - 1] = 0;
+ if (strcmp(lmt_engine_state.engine_name, format_engine)) {
+ lmt_memory_free(format_engine);
+ goto BAD;
+ } else {
+ lmt_memory_free(format_engine);
+ return;
+ }
+ }
+ }
+ BAD:
+ tex_fatal_undump_error("engine");
+}
+
+const char *lmt_error_string(lua_State* L, int index)
+{
+ const char *s = lua_tostring(L, index);
+ return s ? s : "unknown error";
+}
diff --git a/source/luametatex/source/lua/lmtenginelib.h b/source/luametatex/source/lua/lmtenginelib.h
new file mode 100644
index 000000000..a6aef849c
--- /dev/null
+++ b/source/luametatex/source/lua/lmtenginelib.h
@@ -0,0 +1,41 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LUAINIT_H
+# define LMT_LUAINIT_H
+
+typedef struct engine_state_info {
+ int lua_init;
+ int lua_only;
+ const char *luatex_banner;
+ const char *engine_name;
+ char *startup_filename;
+ char *startup_jobname;
+ char *dump_name; /* could move to dump_state */
+ int utc_time; /* kind of obsolete, could be a callback */
+ int permit_loadlib;
+} engine_state_info;
+
+extern engine_state_info lmt_engine_state;
+
+extern void tex_engine_initialize (int ac, char **av);
+extern char *tex_engine_input_filename (void);
+extern void tex_engine_check_configuration (void);
+
+extern void tex_engine_get_config_boolean (const char *name, int *target);
+extern void tex_engine_get_config_number (const char *name, int *target);
+extern void tex_engine_get_config_string (const char *name, char **target);
+extern int tex_engine_run_config_function (const char *name);
+extern void tex_engine_set_memory_data (const char *name, memory_data *data);
+extern void tex_engine_set_limits_data (const char *name, limits_data *data);
+
+extern void lmt_make_table (lua_State *L, const char *tab, const char *mttab, lua_CFunction getfunc, lua_CFunction setfunc);
+extern int lmt_traceback (lua_State *L);
+extern void lmt_error (lua_State *L, const char *where, int detail, int fatal);
+extern void lmt_initialize (void);
+extern void lmt_dump_engine_info (dumpstream f);
+extern void lmt_undump_engine_info (dumpstream f);
+extern const char *lmt_error_string (lua_State *L, int index);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtfontlib.c b/source/luametatex/source/lua/lmtfontlib.c
new file mode 100644
index 000000000..09429d98a
--- /dev/null
+++ b/source/luametatex/source/lua/lmtfontlib.c
@@ -0,0 +1,1020 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ There is not that much font related code because much is delegated to \LUA. We're actually back
+ to original \TEX, where only dimensions matter, plus some basic information about constructing
+ (base mode) ligatures and (base mode) kerning. Also, we need to store some math specific
+ properties of glyphs so that the math machinery can do its work.
+
+ Compared to traditional \TEX\ the most impressive extension is the amount of new math parameters.
+ There are also some new concepts, like staircase kerns. In the typesetting related code this is
+ reflected in dedicated code paths.
+
+ The code is different from the code in \LUATEX. Because we don't have a backend built in, we need
+ to store less. Also, there are quite some optimizations so that large fonts consume less memory.
+ After all, we have whatever is available already in \LUA\ tables. The engine only needs a few
+ dimensions to work with, plus some ligature and kern information for old school fonts, and when
+ applicable some additional data that relates to math. So, for instance, we no longer allocate
+ memory when we have no math.
+
+ We start with some tables to which we might do more with this data and add more entries at some
+ point. We are prepared.
+
+ */
+
+
+void lmt_fontlib_initialize(void) {
+ /* nothing */
+}
+
+static int valid_math_parameter(lua_State *L, int narg) {
+ const char *s = lua_tostring(L, narg);
+ if (s) {
+ for (int i = 1; lmt_interface.math_font_parameter_values[i].name; i++) {
+ if (lmt_interface.math_font_parameter_values[i].name == s) {
+ return i;
+ }
+ }
+ }
+ return -1;
+}
+
+/*
+ Most of these special ligature indicators have never been used by fonts but they are part of
+ \TEX's legacy so of course we keep them around!
+
+*/
+
+static const char *lmt_ligature_type_strings[] = {
+ "=:", "=:|", "|=:", "|=:|", "", "=:|>", "|=:>", "|=:|>", "", "", "", "|=:|>>", NULL
+};
+
+static int fontlib_aux_count_hash_items(lua_State *L)
+{
+ int n = 0;
+ if (lua_type(L, -1) == LUA_TTABLE) {
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ n++;
+ lua_pop(L, 1);
+ }
+ }
+ return n;
+}
+
+/*tex
+
+ These macros set a field in the font or character records. Watch how we make a copy of a string!
+
+*/
+
+/*
+# define set_numeric_field_by_index(target,name,dflt) \
+ lua_key_rawgeti(name); \
+ target = (lua_type(L, -1) == LUA_TNUMBER) ? lmt_roundnumber(L, -1) : dflt ; \
+ lua_pop(L, 1);
+
+# define set_boolean_field_by_index(target,name,dflt) \
+ lua_key_rawgeti(name); \
+ target = (lua_type(L, -1) == LUA_TBOOLEAN) ? lua_toboolean(L, -1) : dflt ; \
+ lua_pop(L, 1);
+
+# define set_string_field_by_index(target,name) \
+ lua_key_rawgeti(name); \
+ target = (lua_type(L, -1) == LUA_TSTRING) ? lua_tostring(L, -1) : NULL ; \
+ lua_pop(L, 1);
+*/
+
+# define set_numeric_field_by_index(target,name,dflt) \
+ lua_push_key(name); \
+ target = (lua_rawget(L, -2) == LUA_TNUMBER) ? lmt_roundnumber(L, -1) : dflt ; \
+ lua_pop(L, 1);
+
+# define set_boolean_field_by_index(target,name,dflt) \
+ lua_push_key(name); \
+ target = (lua_rawget(L, -2) == LUA_TBOOLEAN) ? lua_toboolean(L, -1) : dflt ; \
+ lua_pop(L, 1);
+
+# define set_string_field_by_index(target,name) \
+ lua_push_key(name); \
+ target = (lua_rawget(L, -2) == LUA_TSTRING) ? lua_tostring(L, -1) : NULL ; \
+ lua_pop(L, 1);
+
+# define set_any_field_by_index(target,name) \
+ lua_push_key(name); \
+ target = (lua_rawget(L, -2) != LUA_TNIL); \
+ lua_pop(L, 1);
+
+/*tex
+
+ Font parameters can be set by number or by name. There are seven basic \TEX\ parameters in text
+ mode but in math mode there can be numerous.
+
+*/
+
+static void fontlib_aux_read_lua_parameters(lua_State *L, int f)
+{
+ lua_push_key(parameters);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ /*tex We determine the the number of parameters in the |max(nofintegerkeys(L), 7)|. */
+ int maxindex = 7;
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ int i = (int) lua_tointeger(L, -2);
+ if (i > maxindex) {
+ maxindex = i;
+ }
+ }
+ lua_pop(L, 1);
+ }
+ /*tex
+ We enlarge the parameter array. The first zeven values are already initialized to zero
+ when the font structure is allocated.
+ */
+ if (maxindex > 7) {
+ tex_set_font_parameters(f, maxindex);
+ }
+ /*tex
+ First we pick up the numeric entries. The values set with keys can later overload
+ these. It's there for old times sake, because numeric parameters are gone.
+ */
+ for (int i = 1; i <= maxindex; i++) {
+ if (lua_rawgeti(L, -1, i) == LUA_TNUMBER) {
+ halfword value = lmt_roundnumber(L, -1);
+ tex_set_font_parameter(f, i, value);
+ }
+ lua_pop(L, 1);
+ }
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ halfword value = lua_type(L, -1) == LUA_TNUMBER ? lmt_roundnumber(L, -1) : 0;
+ switch (lua_type(L, -2)) {
+ case LUA_TSTRING:
+ {
+ /* These can overload the already set-by-index values. */
+ const char *s = lua_tostring(L, -2);
+ if (lua_key_eq(s, slant)) {
+ tex_set_font_parameter(f, slant_code, value);
+ } else if (lua_key_eq(s, space)) {
+ tex_set_font_parameter(f, space_code, value);
+ } else if (lua_key_eq(s, spacestretch)) {
+ tex_set_font_parameter(f, space_stretch_code, value);
+ } else if (lua_key_eq(s, spaceshrink)) {
+ tex_set_font_parameter(f, space_shrink_code, value);
+ } else if (lua_key_eq(s, xheight)) {
+ tex_set_font_parameter(f, ex_height_code, value);
+ } else if (lua_key_eq(s, quad)) {
+ tex_set_font_parameter(f, em_width_code, value);
+ } else if (lua_key_eq(s, extraspace)) {
+ tex_set_font_parameter(f, extra_space_code, value);
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ {
+ /* Math fonts can have more than 7. */
+ int index = (int) lua_tointeger(L, -2);
+ if (index >= 8) {
+ tex_set_font_parameter(f, index, value);
+ }
+ }
+ break;
+ }
+ lua_pop(L, 1);
+ }
+ }
+ lua_pop(L, 1);
+
+}
+
+static void fontlib_aux_read_lua_math_parameters(lua_State *L, int f)
+{
+ lua_push_key(MathConstants);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ int n = (int) lmt_roundnumber(L, -1);
+ int i = 0;
+ switch (lua_type(L, -2)) {
+ case LUA_TSTRING:
+ i = valid_math_parameter(L, -2);
+ break;
+ case LUA_TNUMBER:
+ i = (int) lua_tointeger(L, -2);
+ break;
+ }
+ if (i > 0) {
+ // set_font_math_parameter(f, i, n);
+ tex_set_font_math_parameters(f, i);
+ // if (n > undefined_math_parameter || i < - undefined_math_parameter) {
+ // n = undefined_math_parameter;
+ // }
+ font_math_parameter(f, i) = n;
+ }
+ lua_pop(L, 1);
+ }
+ set_font_oldmath(f, 0);
+ } else {
+ set_font_oldmath(f, 1);
+ }
+ lua_pop(L, 1);
+}
+
+/*tex
+
+ Math kerns are tables that specify a staircase. There are upto four such lists, one for each
+ corner. Here is a complete example:
+
+ \starttyping
+ mathkerns = {
+ 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 } },
+ }
+ \stoptyping
+
+*/
+
+static void fontlib_aux_store_math_kerns(lua_State *L, int index, charinfo *co, int id)
+{
+ lua_push_key_by_index(index);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ lua_Integer k = lua_rawlen(L, -1);
+ if (k > 0) {
+ for (lua_Integer l = 1; l <= k; l++) {
+ if (lua_rawgeti(L, -1, l) == LUA_TTABLE) {
+ scaled ht, krn;
+// set_numeric_field_by_index(ht, height, min_infinity);
+// set_numeric_field_by_index(krn, kern, min_infinity);
+// if (krn > min_infinity && ht > min_infinity) {
+// tex_add_charinfo_math_kern(co, id, ht, krn);
+// }
+ set_numeric_field_by_index(ht, height, 0);
+ set_numeric_field_by_index(krn, kern, 0);
+ if (krn || ht) {
+ tex_add_charinfo_math_kern(co, id, ht, krn);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ }
+ }
+ lua_pop(L, 1);
+}
+
+static void fontlib_aux_font_char_from_lua(lua_State *L, halfword f, int i, int has_math)
+{
+ if (lua_istable(L, -1)) {
+ /*tex We need an intermediate veriable: */
+ scaled target;
+ int state;
+ charinfo *co = tex_get_charinfo(f, i);
+ set_any_field_by_index(state, callback);
+ set_charinfo_tag(co, state ? callback_tag : 0);
+ set_numeric_field_by_index(target, width, 0);
+ set_charinfo_width(co, target);
+ set_numeric_field_by_index(target, height, 0);
+ set_charinfo_height(co, target);
+ set_numeric_field_by_index(target, depth, 0);
+ set_charinfo_depth(co, target);
+ set_numeric_field_by_index(target, italic, 0);
+ set_charinfo_italic(co, target);
+ set_numeric_field_by_index(target, expansion, 1000);
+ set_charinfo_expansion(co, target);
+ set_numeric_field_by_index(target, leftprotrusion, 0);
+ set_charinfo_leftprotrusion(co, target);
+ set_numeric_field_by_index(target, rightprotrusion, 0);
+ set_charinfo_rightprotrusion(co, target);
+ set_charinfo_tag(co, 0);
+ if (has_math) {
+ tex_char_malloc_mathinfo(co);
+ set_numeric_field_by_index(target, smaller, 0);
+ set_charinfo_smaller(co, target);
+ set_numeric_field_by_index(target, vitalic, 0);
+ set_charinfo_vertical_italic(co, target);
+ /* */
+ set_numeric_field_by_index(target, topleft, 0);
+ set_charinfo_top_left_kern(co, target);
+ set_numeric_field_by_index(target, topright, 0);
+ set_charinfo_top_right_kern(co, target);
+ set_numeric_field_by_index(target, bottomright, 0);
+ set_charinfo_bottom_right_kern(co, target);
+ set_numeric_field_by_index(target, bottomleft, 0);
+ set_charinfo_bottom_left_kern(co, target);
+ /* */
+ set_numeric_field_by_index(target, leftmargin, 0);
+ set_charinfo_left_margin(co, target);
+ set_numeric_field_by_index(target, rightmargin, 0);
+ set_charinfo_right_margin(co, target);
+ set_numeric_field_by_index(target, topmargin, 0);
+ set_charinfo_top_margin(co, target);
+ set_numeric_field_by_index(target, bottommargin, 0);
+ set_charinfo_bottom_margin(co, target);
+ /* */
+ // set_numeric_field_by_index(target, options, 0);
+ // set_charinfo_options(co, target);
+ set_numeric_field_by_index(target, topaccent, INT_MIN);
+ set_charinfo_top_accent(co, target);
+ set_numeric_field_by_index(target, bottomaccent, INT_MIN);
+ set_charinfo_bottom_accent(co, target);
+ set_numeric_field_by_index(target, flataccent, INT_MIN);
+ set_charinfo_flat_accent(co, target);
+ set_numeric_field_by_index(target, next, -1);
+ if (target >= 0) {
+ set_charinfo_tag(co, list_tag);
+ set_charinfo_remainder(co, target);
+ }
+ lua_push_key(extensible);
+ switch (lua_rawget(L, -2)) {
+ case LUA_TTABLE:
+ {
+ int top, bottom, middle, extender;
+ set_numeric_field_by_index(top, top, 0);
+ set_numeric_field_by_index(bottom, bottom, 0);
+ set_numeric_field_by_index(middle, middle, 0);
+ set_numeric_field_by_index(extender, extender, 0);
+ if (top || bottom || middle || extender) {
+ set_charinfo_tag(co, extension_tag);
+ tex_set_charinfo_extensible(co, top, bottom, middle, extender);
+ } else {
+ tex_formatted_warning("font", "lua-loaded font %s char U+%X has an invalid extensible field", font_name(f), (int) i);
+ }
+ }
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, -2)) {
+ set_charinfo_tag(co, extend_last_tag);
+ }
+ break;
+ }
+ lua_pop(L, 1);
+ lua_push_key(hparts);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ set_charinfo_tag(co, extension_tag);
+ tex_set_charinfo_horizontal_parts(co, NULL);
+ for (lua_Integer k = 1; ; k++) {
+ if (lua_rawgeti(L, -1, k) == LUA_TTABLE) {
+ int glyph, startconnect, endconnect, advance, extender;
+ extinfo *h;
+ set_numeric_field_by_index(glyph, glyph, 0);
+ set_numeric_field_by_index(extender, extender, 0);
+ set_numeric_field_by_index(startconnect, start, 0);
+ set_numeric_field_by_index(endconnect, end, 0);
+ set_numeric_field_by_index(advance, advance, 0);
+ h = tex_new_charinfo_part(glyph, startconnect, endconnect, advance, extender);
+ tex_add_charinfo_horizontal_part(co, h);
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ }
+ lua_pop(L, 1);
+ lua_push_key(vparts);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ set_charinfo_tag(co, extension_tag);
+ tex_set_charinfo_vertical_parts(co, NULL);
+ for (lua_Integer k = 1; ; k++) {
+ if (lua_rawgeti(L, -1, k) == LUA_TTABLE) {
+ int glyph, startconnect, endconnect, advance, extender;
+ extinfo *h;
+ set_numeric_field_by_index(glyph, glyph, 0);
+ set_numeric_field_by_index(extender, extender, 0);
+ set_numeric_field_by_index(startconnect, start, 0);
+ set_numeric_field_by_index(endconnect, end, 0);
+ set_numeric_field_by_index(advance, advance, 0);
+ h = tex_new_charinfo_part(glyph, startconnect, endconnect, advance, extender);
+ tex_add_charinfo_vertical_part(co, h);
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ }
+ lua_pop(L, 1);
+ lua_push_key(mathkerns);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ fontlib_aux_store_math_kerns(L, lua_key_index(topleft), co, top_left_kern);
+ fontlib_aux_store_math_kerns(L, lua_key_index(topright), co, top_right_kern);
+ fontlib_aux_store_math_kerns(L, lua_key_index(bottomright), co, bottom_right_kern);
+ fontlib_aux_store_math_kerns(L, lua_key_index(bottomleft), co, bottom_left_kern);
+ }
+ lua_pop(L, 1);
+ }
+ /*tex Maybe some kerns: */
+ lua_push_key(kerns);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ int count = fontlib_aux_count_hash_items(L);
+ if (count > 0) {
+ /*tex The kerns table is still on stack. */
+ kerninfo *ckerns = lmt_memory_calloc((size_t) count + 1, sizeof(kerninfo));
+ if (ckerns) {
+ int ctr = 0;
+ /*tex Traverse the hash. */
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ int k = non_boundary_char;
+ switch (lua_type(L, -2)) {
+ case LUA_TNUMBER:
+ /*tex Adjacent char: */
+ k = (int) lua_tointeger(L, -2);
+ if (k < 0) {
+ k = non_boundary_char;
+ }
+ break;
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, -2);
+ if (lua_key_eq(s, rightboundary)) {
+ k = right_boundary_char;
+ if (! font_has_right_boundary(f)) {
+ set_font_right_boundary(f, tex_get_charinfo(f, right_boundary_char));
+ }
+ }
+ }
+ break;
+ }
+ target = lmt_roundnumber(L, -1);
+ if (k != non_boundary_char) {
+ set_kern_item(ckerns[ctr], k, target);
+ ctr++;
+ } else {
+ tex_formatted_warning("font", "lua-loaded font %s char U+%X has an invalid kern field", font_name(f), (int) i);
+ }
+ lua_pop(L, 1);
+ }
+ /*tex A guard against empty tables. */
+ if (ctr > 0) {
+ set_kern_item(ckerns[ctr], end_kern, 0);
+ set_charinfo_kerns(co, ckerns);
+ } else {
+ tex_formatted_warning("font", "lua-loaded font %s char U+%X has an invalid kerns field", font_name(f), (int) i);
+ }
+ } else {
+ tex_overflow_error("font", (count + 1) * sizeof(kerninfo));
+ }
+ }
+ }
+ lua_pop(L, 1);
+ /*tex Sometimes ligatures: */
+ lua_push_key(ligatures);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ int count = fontlib_aux_count_hash_items(L);
+ if (count > 0) {
+ /*tex The ligatures table still on stack. */
+ ligatureinfo *cligs = lmt_memory_calloc((size_t) count + 1, sizeof(ligatureinfo));
+ if (cligs) {
+ int ctr = 0;
+ /*tex Traverse the hash. */
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ int k = non_boundary_char;
+ int r = -1;
+ switch (lua_type(L, -2)) {
+ case LUA_TNUMBER:
+ /*tex Adjacent char: */
+ k = (int) lua_tointeger(L, -2);
+ if (k < 0) {
+ k = non_boundary_char;
+ }
+ break;
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, -2);
+ if (lua_key_eq(s, rightboundary)) {
+ k = right_boundary_char;
+ if (! font_has_right_boundary(f)) {
+ set_font_right_boundary(f, tex_get_charinfo(f, right_boundary_char));
+ }
+ }
+ }
+ break;
+ }
+ if (lua_istable(L, -1)) {
+ /*tex Ligature: */
+ set_numeric_field_by_index(r, char, -1);
+ }
+ if (r != -1 && k != non_boundary_char) {
+ int ligtarget = 0;
+ lua_push_key(type);
+ switch (lua_rawget(L, -2)) {
+ case LUA_TNUMBER:
+ ligtarget = lmt_tointeger(L, -1);
+ break;
+ case LUA_TSTRING:
+ {
+ const char *value = lua_tostring(L, -1);
+ int index = 0;
+ while (lmt_ligature_type_strings[index]) {
+ if (strcmp(lmt_ligature_type_strings[index], value) == 0) {
+ ligtarget = index;
+ break;
+ } else {
+ index++;
+ }
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ lua_pop(L, 1);
+ set_ligature_item(cligs[ctr], (ligtarget * 2) + 1, k, r);
+ ctr++;
+ } else {
+ tex_formatted_warning("font", "lua-loaded font %s char U+%X has an invalid ligature field", font_name(f), (int) i);
+ }
+ /*tex The iterator value: */
+ lua_pop(L, 1);
+ }
+ /*tex A guard against empty tables. */
+ if (ctr > 0) {
+ set_ligature_item(cligs[ctr], 0, end_of_ligature_code, 0);
+ set_charinfo_ligatures(co, cligs);
+ } else {
+ tex_formatted_warning("font", "lua-loaded font %s char U+%X has an invalid ligatures field", font_name(f), (int) i);
+ }
+ } else {
+ tex_overflow_error("font", (count + 1) * sizeof(ligatureinfo));
+ }
+ }
+ }
+ lua_pop(L, 1);
+ }
+}
+
+/*tex
+
+ The caller has to fix the state of the lua stack when there is an error!
+
+*/
+
+static int lmt_font_from_lua(lua_State *L, int f)
+{
+ /*tex The table is at stack |index -1| */
+ const char *nstr ;
+ set_string_field_by_index(nstr, name);
+ tex_set_font_name(f, nstr);
+ if (nstr) {
+ const char *ostr = NULL;
+ int no_math = 0;
+ int j;
+ set_string_field_by_index(ostr, original);
+ tex_set_font_original(f, ostr ? ostr : nstr);
+ set_numeric_field_by_index(j, designsize, 655360);
+ set_font_design_size(f, j);
+ set_numeric_field_by_index(j, size, font_design_size(f));
+ set_font_size(f, j);
+ set_boolean_field_by_index(j, oldmath, 0);
+ set_font_oldmath(f, j);
+ set_boolean_field_by_index(j, compactmath, 0);
+ set_font_compactmath(f, j);
+ set_numeric_field_by_index(j, mathcontrol, 0);
+ set_font_mathcontrol(f, j);
+ set_numeric_field_by_index(j, textcontrol, 0);
+ set_font_textcontrol(f, j);
+ set_numeric_field_by_index(j, textscale, 0);
+ set_font_textsize(f, j);
+ set_numeric_field_by_index(j, scriptscale, 0);
+ set_font_scriptsize(f, j);
+ set_numeric_field_by_index(j, scriptscriptscale, 0);
+ set_font_scriptscriptsize(f, j);
+ set_numeric_field_by_index(j, hyphenchar, default_hyphen_char_par);
+ set_font_hyphen_char(f, j);
+ set_numeric_field_by_index(j, skewchar, default_skew_char_par);
+ set_font_skew_char(f, j);
+ set_boolean_field_by_index(no_math, nomath, 0);
+ fontlib_aux_read_lua_parameters(L, f);
+ if (no_math) {
+ set_font_oldmath(f, 1);
+ } else {
+ fontlib_aux_read_lua_math_parameters(L, f);
+ set_boolean_field_by_index(j, oldmath, 0);
+ set_font_oldmath(f, j);
+ }
+ /*tex The characters. */
+ lua_push_key(characters);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ /*tex Find the array size values; |num| holds the number of characters to add. */
+ int num = 0;
+ int last = 0;
+ int first = -1;
+ /*tex The first key: */
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ if (lua_isnumber(L, -2)) {
+ int i = (int) lua_tointeger(L, -2);
+ if (i >= 0 && lua_istable(L, -1)) {
+ num++;
+ if (i > last) {
+ last = i;
+ }
+ if (first < 0) {
+ first = i;
+ }
+ if (first >= 0 && i < first) {
+ first = i;
+ }
+ }
+ }
+ lua_pop(L, 1);
+ }
+ if (num > 0) {
+ int fstep = 0;
+ tex_font_malloc_charinfo(f, num);
+ set_font_first_character(f, first);
+ set_font_last_character(f, last);
+ /*tex The first key: */
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ switch (lua_type(L, -2)) {
+ case LUA_TNUMBER:
+ {
+ int i = lmt_tointeger(L, -2);
+ if (i >= 0) {
+ fontlib_aux_font_char_from_lua(L, f, i, ! no_math);
+ }
+ }
+ break;
+ case LUA_TSTRING:
+ {
+ const char *b = lua_tostring(L, -2);
+ if (lua_key_eq(b, leftboundary)) {
+ fontlib_aux_font_char_from_lua(L, f, left_boundary_char, ! no_math);
+ } else if (lua_key_eq(b, rightboundary)) {
+ fontlib_aux_font_char_from_lua(L, f, right_boundary_char, ! no_math);
+ }
+ }
+ break;
+ }
+ lua_pop(L, 1);
+ }
+ lua_pop(L, 1);
+ /*tex
+
+ Handle font expansion last: We permits virtual fonts to use expansion as one
+ can always turn it off.
+
+ */
+ set_numeric_field_by_index(fstep, step, 0);
+ if (fstep > 0) {
+ int fstretch = 0;
+ int fshrink = 0;
+ if (fstep > 100) {
+ fstep = 100;
+ }
+ set_numeric_field_by_index(fshrink, shrink, 0);
+ set_numeric_field_by_index(fstretch, stretch, 0);
+ if (fshrink < 0) {
+ fshrink = 0;
+ } else if (fshrink > 500) {
+ fshrink = 500;
+ }
+ fshrink -= (fshrink % fstep);
+ if (fshrink < 0) {
+ fshrink = 0;
+ }
+ if (fstretch < 0) {
+ fstretch = 0;
+ } else if (fstretch > 1000) {
+ fstretch = 1000;
+ }
+ fstretch -= (fstretch % fstep);
+ if (fstretch < 0) {
+ fstretch = 0;
+ }
+ set_font_step(f, fstep);
+ set_font_max_stretch(f, fstretch);
+ set_font_max_shrink(f, fshrink);
+ }
+ } else {
+ tex_formatted_warning("font", "lua-loaded font '%d' with name '%s' has no characters", f, font_name(f));
+ }
+ } else {
+ tex_formatted_warning("font", "lua-loaded font '%d' with name '%s' has no character table", f, font_name(f));
+ }
+ return 1;
+ } else {
+ return tex_formatted_error("font", "lua-loaded font '%d' has no name!", f);
+ }
+}
+
+static int lmt_characters_from_lua(lua_State *L, int f)
+{
+ int no_math;
+ /*tex Speedup: */
+ set_boolean_field_by_index(no_math, nomath, 0);
+ /*tex The characters: */
+ lua_push_key(characters);
+ if (lua_rawget(L, -2) == LUA_TTABLE) {
+ /*tex Find the array size values; |num| has the amount. */
+ int num = 0;
+ int todo = 0;
+ int bc = font_first_character(f);
+ int ec = font_last_character(f);
+ /*tex First key: */
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ if (lua_isnumber(L, -2)) {
+ int i = lmt_tointeger(L, -2);
+ if (i >= 0 && lua_istable(L, -1)) {
+ todo++;
+ if (! quick_char_exists(f, i)) {
+ num++;
+ if (i > ec) {
+ ec = i;
+ }
+ if (bc < 0) {
+ bc = i;
+ }
+ if (bc >= 0 && i < bc) {
+ bc = i;
+ }
+ }
+ }
+ }
+ lua_pop(L, 1);
+ }
+ if (todo > 0) {
+ tex_font_malloc_charinfo(f, num);
+ set_font_first_character(f, bc);
+ set_font_last_character(f, ec);
+ /*tex First key: */
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ int i = lmt_tointeger(L, -2);
+ if (i >= 0) {
+ if (quick_char_exists(f, i)) {
+ charinfo *co = tex_get_charinfo(f, i);
+ set_charinfo_ligatures(co, NULL);
+ set_charinfo_kerns(co, NULL);
+ set_charinfo_math(co, NULL);
+ tex_set_charinfo_vertical_parts(co, NULL);
+ tex_set_charinfo_horizontal_parts(co, NULL);
+ }
+ fontlib_aux_font_char_from_lua(L, f, i, ! no_math);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ lua_pop(L, 1);
+ }
+ }
+ return 1;
+}
+
+/*tex
+
+ The font library has helpers for defining the font and setting or getting the current font.
+ Internally fonts are represented by font identifiers: numbers. The zero value represents the
+ predefined |nullfont| instance. The only way to load a font in \LUAMETATEX\ is to use \LUA.
+
+*/
+
+static int fontlib_current(lua_State *L)
+{
+ int i = lmt_optinteger(L, 1, 0);
+ if (i > 0) {
+ if (tex_is_valid_font(i)) {
+ tex_set_cur_font(0, i);
+ } else {
+ luaL_error(L, "expected a valid font id");
+ }
+ }
+ lua_pushinteger(L, cur_font_par);
+ return 1;
+}
+
+static int fontlib_max(lua_State *L)
+{
+ lua_pushinteger(L, tex_get_font_max_id());
+ return 1;
+}
+
+static int fontlib_setfont(lua_State *L)
+{
+ int i = lmt_checkinteger(L, 1);
+ if (i) {
+ luaL_checktype(L, 2, LUA_TTABLE);
+ if (! tex_is_valid_font(i)) {
+ return luaL_error(L, "font with id %d is not a valid font", i);
+ // } else if (font_touched(i)) {
+ // return luaL_error(L, "font with id %d has been accessed already, changing it is forbidden", i);
+ } else {
+ lua_settop(L, 2);
+ lmt_font_from_lua(L, i);
+ }
+ }
+ return 0;
+}
+
+static int fontlib_addcharacters(lua_State *L)
+{
+ int i = lmt_checkinteger(L, 1);
+ if (i) {
+ luaL_checktype(L, 2, LUA_TTABLE);
+ if (tex_is_valid_font(i)) {
+ lua_settop(L, 2);
+ lmt_characters_from_lua(L, i);
+ } else {
+ return luaL_error(L, "invalid font id %d passed", i);
+ }
+ }
+ return 0;
+}
+
+/*tex |font.define(table)| */
+
+static int fontlib_define(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ int i = lmt_optinteger(L, 2, 0);
+ if (! i) {
+ i = tex_new_font();
+ } else if (! tex_is_valid_font(i)) {
+ return luaL_error(L, "invalid font id %d passed", i);
+ }
+ lua_settop(L, 1);
+ if (lmt_font_from_lua(L, i)) {
+ lua_pushinteger(L, i);
+ return 1;
+ } else {
+ lua_pop(L, 1);
+ tex_delete_font(i);
+ return luaL_error(L, "font creation failed, error in table");
+ }
+ } else {
+ return 0;
+ }
+}
+
+static int fontlib_id(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ int cs = tex_string_locate(s, l, 0);
+ int f = -1;
+ if (cs == undefined_control_sequence || cs == undefined_cs_cmd || eq_type(cs) != set_font_cmd) {
+ lua_pushliteral(L, "not a valid font csname");
+ } else {
+ f = eq_value(cs);
+ }
+ lua_pushinteger(L, f);
+ return 1;
+ } else {
+ return luaL_error(L, "expected font csname string as argument");
+ }
+}
+
+/*tex
+
+ This returns the expected (!) next |fontid|, a first arg |true| will keep the id. This not
+ really robust as of course fonts can be defined in the meantime! In principle |define| could
+ handle that but then I also need to add similar functionality to \LUATEX.
+
+*/
+
+static int fontlib_nextid(lua_State *L)
+{
+ int keep = lua_toboolean(L, 1);
+ int id = tex_new_font();
+ lua_pushinteger(L, id);
+ if (! keep) {
+ tex_delete_font(id);
+ }
+ return 1;
+}
+
+/*tex
+
+ These are not really that useful but can be used to (for instance) mess with the nullfont
+ parameters that occasionally are used as defaults. We don't increase the font parameter array
+ when the upper bound is larger than the initial size. You can forget about that kind of abuse
+ in \LUAMETATEX.
+
+*/
+
+static int fontlib_aux_valid_fontdimen(lua_State *L, halfword *fnt, halfword *n)
+{
+ *fnt = lmt_tohalfword(L, 1);
+ *n = lmt_tohalfword(L, 2);
+ if (*n > 0 && *n <= font_parameter_count(*fnt)) {
+ return 1;
+ } else {
+ return luaL_error(L, "font with id %i has only %d fontdimens", fnt, n);
+ }
+}
+
+static int fontlib_setfontdimen(lua_State *L)
+{
+ halfword fnt, n;
+ if (fontlib_aux_valid_fontdimen(L, &fnt, &n)) {
+ tex_set_font_parameter(fnt, n, lmt_tohalfword(L, 3));
+ }
+ return 0;
+}
+
+static int fontlib_getfontdimen(lua_State *L)
+{
+ halfword fnt, n;
+ if (fontlib_aux_valid_fontdimen(L, &fnt, &n)) {
+ lua_pushinteger(L, font_parameter(fnt, n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int fontlib_getmathspec(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ halfword cs = tex_string_locate(name, lname, 0);
+ if (eq_type(cs) == mathspec_cmd) {
+ halfword ms = eq_value(cs);
+ if (ms) {
+ mathcodeval m = tex_get_math_spec(ms);
+ lua_pushinteger(L, m.class_value);
+ lua_pushinteger(L, m.family_value);
+ lua_pushinteger(L, m.character_value);
+ return 3;
+ }
+ }
+ }
+ return 0;
+}
+
+static int fontlib_getfontspec(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ halfword cs = tex_string_locate(name, lname, 0);
+ if (eq_type(cs) == fontspec_cmd) {
+ halfword fs = eq_value(cs);
+ if (fs) {
+ lua_pushinteger(L, font_spec_identifier(fs));
+ lua_pushinteger(L, font_spec_scale(fs));
+ lua_pushinteger(L, font_spec_x_scale(fs));
+ lua_pushinteger(L, font_spec_y_scale(fs));
+ return 4;
+ }
+ }
+ }
+ return 0;
+}
+
+static int fontlib_getmathindex(lua_State *L) {
+ halfword index = -1;
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ index = valid_math_parameter(L, 1);
+ break;
+ case LUA_TNUMBER:
+ index = lmt_tointeger(L, 1);
+ break;
+ }
+ if (index > 0 && index < math_parameter_last_code) {
+ lua_pushinteger(L, index);
+ lua_pushboolean(L, index >= math_parameter_first_engine_code); /* true == engine */
+ } else {
+ lua_pushinteger(L, 0);
+ lua_pushboolean(L, 0);
+ }
+ return 2;
+}
+
+static const struct luaL_Reg fontlib_function_list[] = {
+ { "current", fontlib_current },
+ { "max", fontlib_max },
+ { "setfont", fontlib_setfont },
+ { "addcharacters", fontlib_addcharacters },
+ { "define", fontlib_define },
+ { "nextid", fontlib_nextid },
+ { "id", fontlib_id },
+ { "getfontdimen", fontlib_getfontdimen },
+ { "setfontdimen", fontlib_setfontdimen },
+ { "getfontspec", fontlib_getfontspec },
+ { "getmathspec", fontlib_getmathspec },
+ { "getmathindex", fontlib_getmathindex },
+ { NULL, NULL },
+};
+
+int luaopen_font(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, fontlib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmtfontlib.h b/source/luametatex/source/lua/lmtfontlib.h
new file mode 100644
index 000000000..e76fe9197
--- /dev/null
+++ b/source/luametatex/source/lua/lmtfontlib.h
@@ -0,0 +1,10 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LUAFONTLIB_H
+# define LUAFONTLIB_H
+
+extern void lmt_fontlib_initialize (void);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtinterface.c b/source/luametatex/source/lua/lmtinterface.c
new file mode 100644
index 000000000..1aef54563
--- /dev/null
+++ b/source/luametatex/source/lua/lmtinterface.c
@@ -0,0 +1,544 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ There isn't much here because most happens in the header file. Here we also set up the
+ environment in which we run, which depends in the operating system used.
+
+*/
+
+# include "luametatex.h"
+
+lua_state_info lmt_lua_state = {
+ .lua_instance = NULL,
+ .used_bytes = 0,
+ .used_bytes_max = 0,
+ .function_table_id = 0,
+ .function_callback_count = 0,
+ .value_callback_count = 0,
+ .bytecode_callback_count = 0,
+ .local_callback_count = 0,
+ .saved_callback_count = 0,
+ .file_callback_count = 0,
+ .direct_callback_count = 0,
+ .message_callback_count = 0,
+ .function_table_size = 0,
+ .bytecode_bytes = 0,
+ .bytecode_max = 0,
+ .version_number = (int) LUA_VERSION_NUM,
+ .release_number = (int) LUA_VERSION_RELEASE_NUM,
+ .used_buffer = NULL,
+ .integer_size = sizeof(lua_Integer),
+};
+
+/*tex
+ Some more can move here, or we can move some to modules instead. It's a very stepwise
+ process because things need to keep running.
+*/
+
+lmt_keys_info lmt_keys;
+
+lmt_interface_info lmt_interface = {
+ .pack_type_values = NULL,
+ .group_code_values = NULL,
+ .par_context_values = NULL,
+ .par_begin_values = NULL,
+ .par_mode_values = NULL,
+ .math_style_name_values = NULL,
+ .math_style_variant_values = NULL,
+ .lua_function_values = NULL,
+ .direction_values = NULL,
+ .node_fill_values = NULL,
+ .page_contribute_values = NULL,
+ .math_style_values = NULL,
+ .math_parameter_values = NULL,
+ .field_type_values = NULL,
+ .node_data = NULL,
+ .command_names = NULL,
+} ;
+
+value_info *lmt_aux_allocate_value_info(size_t last)
+{
+ value_info *v = lmt_memory_calloc(last + 2, sizeof(value_info));
+ set_value_entry_nop(v, last + 1);
+ return v;
+}
+
+void lmt_initialize_interface(void)
+{
+ lmt_interface.pack_type_values = lmt_aux_allocate_value_info(packing_adapted);
+
+ # define set_pack_type_value(n,k) lmt_interface.pack_type_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_pack_type_value(packing_exactly, exactly);
+ set_pack_type_value(packing_additional, additional);
+ set_pack_type_value(packing_expanded, expanded);
+ set_pack_type_value(packing_substitute, substitute);
+ set_pack_type_value(packing_adapted, adapted);
+
+ lmt_interface.group_code_values = lmt_aux_allocate_value_info(lua_group);
+
+ # define set_group_code_value(n,k) lmt_interface.group_code_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_group_code_value(bottom_level_group, bottomlevel);
+ set_group_code_value(simple_group, simple);
+ set_group_code_value(hbox_group, hbox);
+ set_group_code_value(adjusted_hbox_group, adjustedhbox);
+ set_group_code_value(vbox_group, vbox);
+ set_group_code_value(vtop_group, vtop);
+ set_group_code_value(align_group, align);
+ set_group_code_value(no_align_group, noalign);
+ set_group_code_value(output_group, output);
+ set_group_code_value(math_group, math);
+ set_group_code_value(discretionary_group, discretionary);
+ set_group_code_value(insert_group, insert);
+ set_group_code_value(vadjust_group, vadjust);
+ set_group_code_value(vcenter_group, vcenter);
+ set_group_code_value(math_fraction_group, mathfraction);
+ set_group_code_value(math_operator_group, mathoperator);
+ set_group_code_value(math_choice_group, mathchoice);
+ set_group_code_value(also_simple_group, alsosimple);
+ set_group_code_value(semi_simple_group, semisimple);
+ set_group_code_value(math_simple_group, mathsimple);
+ set_group_code_value(math_shift_group, mathshift);
+ set_group_code_value(math_fence_group, mathfence);
+ set_group_code_value(local_box_group, localbox);
+ set_group_code_value(split_off_group, splitoff);
+ set_group_code_value(split_keep_group, splitkeep);
+ set_group_code_value(preamble_group, preamble);
+ set_group_code_value(align_set_group, alignset);
+ set_group_code_value(finish_row_group, finishrow);
+ set_group_code_value(lua_group, lua);
+
+ lmt_interface.par_context_values = lmt_aux_allocate_value_info(reset_par_context);
+
+ # define set_par_context_value(n,k) lmt_interface.par_context_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_par_context_value(normal_par_context, normal);
+ set_par_context_value(vmode_par_context, vmode);
+ set_par_context_value(vbox_par_context, vbox);
+ set_par_context_value(vtop_par_context, vtop);
+ set_par_context_value(vcenter_par_context, vcenter);
+ set_par_context_value(vadjust_par_context, vadjust);
+ set_par_context_value(insert_par_context, insert);
+ set_par_context_value(output_par_context, output);
+ set_par_context_value(align_par_context, align);
+ set_par_context_value(no_align_par_context, noalign);
+ set_par_context_value(span_par_context, span);
+ set_par_context_value(reset_par_context, reset);
+
+ lmt_interface.page_context_values = lmt_aux_allocate_value_info(alignment_page_context);
+
+ # define set_page_context_value(n,k) lmt_interface.page_context_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_page_context_value(box_page_context, box);
+ set_page_context_value(end_page_context, end);
+ set_page_context_value(vadjust_page_context, vadjust);
+ set_page_context_value(penalty_page_context, penalty);
+ set_page_context_value(boundary_page_context, boundary);
+ set_page_context_value(insert_page_context, insert);
+ set_page_context_value(hmode_par_page_context, hmodepar);
+ set_page_context_value(vmode_par_page_context, vmodepar);
+ set_page_context_value(begin_paragraph_page_context, beginparagraph);
+ set_page_context_value(before_display_page_context, beforedisplay);
+ set_page_context_value(after_display_page_context, afterdisplay);
+ set_page_context_value(after_output_page_context, afteroutput);
+ set_page_context_value(alignment_page_context, alignment);
+
+ lmt_interface.append_line_context_values = lmt_aux_allocate_value_info(post_migrate_append_line_context);
+
+ # define set_append_line_context_value(n,k) lmt_interface.append_line_context_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_append_line_context_value(box_append_line_context, box);
+ set_append_line_context_value(pre_box_append_line_context, prebox);
+ set_append_line_context_value(pre_adjust_append_line_context, preadjust);
+ set_append_line_context_value(post_adjust_append_line_context, postadjust);
+ set_append_line_context_value(pre_migrate_append_line_context, premigrate);
+ set_append_line_context_value(post_migrate_append_line_context, postmigrate);
+
+ lmt_interface.alignment_context_values = lmt_aux_allocate_value_info(wrapup_pass_alignment_context);
+
+ # define set_alignment_context_value(n,k) lmt_interface.alignment_context_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_alignment_context_value(preamble_pass_alignment_context, preamble);
+ set_alignment_context_value(preroll_pass_alignment_context, preroll);
+ set_alignment_context_value(package_pass_alignment_context, package);
+ set_alignment_context_value(wrapup_pass_alignment_context, wrapup);
+
+ lmt_interface.par_begin_values = lmt_aux_allocate_value_info(vrule_char_par_begin);
+
+ # define set_par_begin_value(n,k) lmt_interface.par_begin_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_par_begin_value(normal_par_begin, normal);
+ set_par_begin_value(force_par_begin, force);
+ set_par_begin_value(indent_par_begin, indent);
+ set_par_begin_value(no_indent_par_begin, noindent);
+ set_par_begin_value(math_char_par_begin, mathchar);
+ set_par_begin_value(char_par_begin, char);
+ set_par_begin_value(boundary_par_begin, boundary);
+ set_par_begin_value(space_par_begin, space);
+ set_par_begin_value(math_par_begin, math);
+ set_par_begin_value(kern_par_begin, kern);
+ set_par_begin_value(hskip_par_begin, hskip);
+ set_par_begin_value(un_hbox_char_par_begin, unhbox);
+ set_par_begin_value(valign_char_par_begin, valign);
+ set_par_begin_value(vrule_char_par_begin, vrule);
+
+ lmt_interface.par_mode_values = lmt_aux_allocate_value_info(math_par_subtype);
+
+ # define set_par_mode_value(n,k) lmt_interface.par_mode_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_par_mode_value(vmode_par_par_subtype, vmodepar);
+ set_par_mode_value(local_box_par_subtype, localbox);
+ set_par_mode_value(hmode_par_par_subtype, hmodepar);
+ set_par_mode_value(penalty_par_subtype, penalty);
+ set_par_mode_value(math_par_subtype, math);
+
+ lmt_interface.math_style_name_values = lmt_aux_allocate_value_info(cramped_script_script_style);
+
+ # define set_math_style_name_value(n,k) lmt_interface.math_style_name_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_math_style_name_value(display_style, display);
+ set_math_style_name_value(cramped_display_style, crampeddisplay);
+ set_math_style_name_value(text_style, text);
+ set_math_style_name_value(cramped_text_style, crampedtext);
+ set_math_style_name_value(script_style, script);
+ set_math_style_name_value(cramped_script_style, crampedscript);
+ set_math_style_name_value(script_script_style, scriptscript);
+ set_math_style_name_value(cramped_script_script_style, crampedscriptscript);
+
+ lmt_interface.math_style_variant_values = lmt_aux_allocate_value_info(math_double_superscript_variant);
+
+ # define set_math_style_variant_value(n,k) lmt_interface.math_style_variant_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_math_style_variant_value(math_normal_style_variant, normal);
+ set_math_style_variant_value(math_cramped_style_variant, cramped);
+ set_math_style_variant_value(math_subscript_style_variant, subscript);
+ set_math_style_variant_value(math_superscript_style_variant, superscript);
+ set_math_style_variant_value(math_small_style_variant, small);
+ set_math_style_variant_value(math_smaller_style_variant, smaller);
+ set_math_style_variant_value(math_numerator_style_variant, numerator);
+ set_math_style_variant_value(math_denominator_style_variant, denominator);
+ set_math_style_variant_value(math_double_superscript_variant, doublesuperscript);
+
+ lmt_interface.lua_function_values = lmt_aux_allocate_value_info(lua_value_direct_code);
+
+ # define set_lua_function_value(n,k) lmt_interface.lua_function_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_lua_function_value(lua_value_none_code, none);
+ set_lua_function_value(lua_value_integer_code, integer);
+ set_lua_function_value(lua_value_cardinal_code, cardinal);
+ set_lua_function_value(lua_value_dimension_code, dimension);
+ set_lua_function_value(lua_value_skip_code, skip);
+ set_lua_function_value(lua_value_boolean_code, boolean);
+ set_lua_function_value(lua_value_float_code, float);
+ set_lua_function_value(lua_value_string_code, string);
+ set_lua_function_value(lua_value_node_code, node);
+ set_lua_function_value(lua_value_direct_code, direct);
+
+ lmt_interface.direction_values = lmt_aux_allocate_value_info(dir_righttoleft);
+
+ # define set_direction_value(n,k) lmt_interface.direction_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_direction_value(dir_lefttoright, lefttoright);
+ set_direction_value(dir_righttoleft, righttoleft);
+
+ lmt_interface.field_type_values = lmt_aux_allocate_value_info(attribute_field);
+
+ # define set_field_type_value(n,k) lmt_interface.field_type_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_field_type_value(nil_field, nil);
+ set_field_type_value(integer_field, integer);
+ set_field_type_value(dimension_field, dimension);
+ set_field_type_value(glue_field, glue);
+ set_field_type_value(number_field, number);
+ set_field_type_value(string_field, string);
+ set_field_type_value(boolean_field, boolean);
+ set_field_type_value(function_field, function);
+ set_field_type_value(node_field, node);
+ set_field_type_value(node_list_field, nodelist);
+ set_field_type_value(token_field, token);
+ set_field_type_value(token_list_field, tokenlist);
+ set_field_type_value(attribute_field, attribute);
+
+ lmt_interface.node_fill_values = lmt_aux_allocate_value_info(filll_glue_order);
+
+ # define set_node_fill_value(n,k) lmt_interface.node_fill_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_node_fill_value(normal_glue_order, normal);
+ set_node_fill_value(fi_glue_order, fi);
+ set_node_fill_value(fil_glue_order, fil);
+ set_node_fill_value(fill_glue_order, fill);
+ set_node_fill_value(filll_glue_order, filll);
+
+ lmt_interface.page_contribute_values = lmt_aux_allocate_value_info(contribute_rule);
+
+ # define set_page_contribute_value(n,k) lmt_interface.page_contribute_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_page_contribute_value(contribute_nothing, empty);
+ set_page_contribute_value(contribute_insert, insert);
+ set_page_contribute_value(contribute_box, box);
+ set_page_contribute_value(contribute_rule, rule);
+
+ lmt_interface.math_style_values = lmt_aux_allocate_value_info(cramped_script_script_style);
+
+ # define set_math_style_value(n,k) lmt_interface.math_style_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_math_style_value(display_style, display);
+ set_math_style_value(cramped_display_style, crampeddisplay);
+ set_math_style_value(text_style, text);
+ set_math_style_value(cramped_text_style, crampedtext);
+ set_math_style_value(script_style, script);
+ set_math_style_value(cramped_script_style, crampedscript);
+ set_math_style_value(script_script_style, scriptscript);
+ set_math_style_value(cramped_script_script_style, crampedscriptscript);
+
+ lmt_interface.math_indirect_values = lmt_aux_allocate_value_info(last_math_indirect);
+
+ # define set_math_indirect_value(n,k) lmt_interface.math_indirect_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .id = n }
+
+ set_math_indirect_value(indirect_math_unset, unset);
+ set_math_indirect_value(indirect_math_regular, regular);
+ set_math_indirect_value(indirect_math_integer, integer);
+ set_math_indirect_value(indirect_math_dimension, dimension);
+ set_math_indirect_value(indirect_math_gluespec, gluespec);
+ set_math_indirect_value(indirect_math_mugluespec, mugluespec);
+ set_math_indirect_value(indirect_math_register_integer, registerinteger);
+ set_math_indirect_value(indirect_math_register_dimension, registerdimension);
+ set_math_indirect_value(indirect_math_register_gluespec, registergluespec);
+ set_math_indirect_value(indirect_math_register_mugluespec, registermugluespec);
+ set_math_indirect_value(indirect_math_internal_integer, internalinteger);
+ set_math_indirect_value(indirect_math_internal_dimension, internaldimension);
+ set_math_indirect_value(indirect_math_internal_dimension, internalgluespec);
+ set_math_indirect_value(indirect_math_internal_mugluespec, internalmugluespec);
+
+ lmt_interface.math_parameter_values = lmt_aux_allocate_value_info(last_math_parameter);
+
+ # define set_math_parameter_value(n,t,k) lmt_interface.math_parameter_values[n] = (value_info) { .lua = lua_key_index(k), .name = lua_key(k), .type = t }
+
+ set_math_parameter_value(math_parameter_quad, math_dimen_parameter, quad);
+ set_math_parameter_value(math_parameter_axis, math_dimen_parameter, axis);
+ set_math_parameter_value(math_parameter_accent_base_height, math_dimen_parameter, accentbaseheight);
+ set_math_parameter_value(math_parameter_accent_base_depth, math_dimen_parameter, accentbasedepth);
+ set_math_parameter_value(math_parameter_flattened_accent_base_height, math_dimen_parameter, flattenedaccentbaseheight);
+ set_math_parameter_value(math_parameter_flattened_accent_base_depth, math_dimen_parameter, flattenedaccentbasedepth);
+ set_math_parameter_value(math_parameter_x_scale, math_int_parameter, xscale);
+ set_math_parameter_value(math_parameter_y_scale, math_int_parameter, yscale);
+ set_math_parameter_value(math_parameter_operator_size, math_dimen_parameter, operatorsize);
+ set_math_parameter_value(math_parameter_overbar_kern, math_dimen_parameter, overbarkern);
+ set_math_parameter_value(math_parameter_overbar_rule, math_dimen_parameter, overbarrule);
+ set_math_parameter_value(math_parameter_overbar_vgap, math_dimen_parameter, overbarvgap);
+ set_math_parameter_value(math_parameter_underbar_kern, math_dimen_parameter, underbarkern);
+ set_math_parameter_value(math_parameter_underbar_rule, math_dimen_parameter, underbarrule);
+ set_math_parameter_value(math_parameter_underbar_vgap, math_dimen_parameter, underbarvgap);
+ set_math_parameter_value(math_parameter_radical_kern, math_dimen_parameter, radicalkern);
+ set_math_parameter_value(math_parameter_radical_rule, math_dimen_parameter, radicalrule);
+ set_math_parameter_value(math_parameter_radical_vgap, math_dimen_parameter, radicalvgap);
+ set_math_parameter_value(math_parameter_radical_degree_before, math_dimen_parameter, radicaldegreebefore);
+ set_math_parameter_value(math_parameter_radical_degree_after, math_dimen_parameter, radicaldegreeafter);
+ set_math_parameter_value(math_parameter_radical_degree_raise, math_int_parameter, radicaldegreeraise);
+ set_math_parameter_value(math_parameter_radical_extensible_after, math_dimen_parameter, radicalextensibleafter);
+ set_math_parameter_value(math_parameter_radical_extensible_before, math_dimen_parameter, radicalextensiblebefore);
+ set_math_parameter_value(math_parameter_stack_vgap, math_dimen_parameter, stackvgap);
+ set_math_parameter_value(math_parameter_stack_num_up, math_dimen_parameter, stacknumup);
+ set_math_parameter_value(math_parameter_stack_denom_down, math_dimen_parameter, stackdenomdown);
+ set_math_parameter_value(math_parameter_fraction_rule, math_dimen_parameter, fractionrule);
+ set_math_parameter_value(math_parameter_fraction_num_vgap, math_dimen_parameter, fractionnumvgap);
+ set_math_parameter_value(math_parameter_fraction_num_up, math_dimen_parameter, fractionnumup);
+ set_math_parameter_value(math_parameter_fraction_denom_vgap, math_dimen_parameter, fractiondenomvgap);
+ set_math_parameter_value(math_parameter_fraction_denom_down, math_dimen_parameter, fractiondenomdown);
+ set_math_parameter_value(math_parameter_fraction_del_size, math_dimen_parameter, fractiondelsize);
+ set_math_parameter_value(math_parameter_skewed_fraction_hgap, math_dimen_parameter, skewedfractionhgap);
+ set_math_parameter_value(math_parameter_skewed_fraction_vgap, math_dimen_parameter, skewedfractionvgap);
+ set_math_parameter_value(math_parameter_limit_above_vgap, math_dimen_parameter, limitabovevgap);
+ set_math_parameter_value(math_parameter_limit_above_bgap, math_dimen_parameter, limitabovebgap);
+ set_math_parameter_value(math_parameter_limit_above_kern, math_dimen_parameter, limitabovekern);
+ set_math_parameter_value(math_parameter_limit_below_vgap, math_dimen_parameter, limitbelowvgap);
+ set_math_parameter_value(math_parameter_limit_below_bgap, math_dimen_parameter, limitbelowbgap);
+ set_math_parameter_value(math_parameter_limit_below_kern, math_dimen_parameter, limitbelowkern);
+ set_math_parameter_value(math_parameter_nolimit_sup_factor, math_dimen_parameter, nolimitsupfactor);
+ set_math_parameter_value(math_parameter_nolimit_sub_factor, math_dimen_parameter, nolimitsubfactor);
+ set_math_parameter_value(math_parameter_under_delimiter_vgap, math_dimen_parameter, underdelimitervgap);
+ set_math_parameter_value(math_parameter_under_delimiter_bgap, math_dimen_parameter, underdelimiterbgap);
+ set_math_parameter_value(math_parameter_over_delimiter_vgap, math_dimen_parameter, overdelimitervgap);
+ set_math_parameter_value(math_parameter_over_delimiter_bgap, math_dimen_parameter, overdelimiterbgap);
+ set_math_parameter_value(math_parameter_subscript_shift_drop, math_dimen_parameter, subshiftdrop);
+ set_math_parameter_value(math_parameter_superscript_shift_drop, math_dimen_parameter, supshiftdrop);
+ set_math_parameter_value(math_parameter_subscript_shift_down, math_dimen_parameter, subshiftdown);
+ set_math_parameter_value(math_parameter_subscript_superscript_shift_down, math_dimen_parameter, subsupshiftdown);
+ set_math_parameter_value(math_parameter_subscript_top_max, math_dimen_parameter, subtopmax);
+ set_math_parameter_value(math_parameter_superscript_shift_up, math_dimen_parameter, supshiftup);
+ set_math_parameter_value(math_parameter_superscript_bottom_min, math_dimen_parameter, supbottommin);
+ set_math_parameter_value(math_parameter_superscript_subscript_bottom_max, math_dimen_parameter, supsubbottommax);
+ set_math_parameter_value(math_parameter_subscript_superscript_vgap, math_dimen_parameter, subsupvgap);
+ set_math_parameter_value(math_parameter_space_before_script, math_dimen_parameter, spacebeforescript);
+ set_math_parameter_value(math_parameter_space_after_script, math_dimen_parameter, spaceafterscript);
+ set_math_parameter_value(math_parameter_connector_overlap_min, math_dimen_parameter, connectoroverlapmin);
+
+ /*tex
+
+ Gone are the many:
+
+ \starttyping
+ set_math_parameter_value(math_parameter_ordinary_ordinary_spacing, math_muglue_parameter, ordordspacing);
+ \stoptyping
+
+ thanks to the more generic multiple class mechanism.
+
+ */
+
+ set_math_parameter_value(math_parameter_extra_superscript_shift, math_dimen_parameter, extrasuperscriptshift);
+ set_math_parameter_value(math_parameter_extra_subscript_shift, math_dimen_parameter, extrasubscriptshift);
+ set_math_parameter_value(math_parameter_extra_superprescript_shift, math_dimen_parameter, extrasuperprescriptshift);
+ set_math_parameter_value(math_parameter_extra_subprescript_shift, math_dimen_parameter, extrasubprescriptshift);
+
+ set_math_parameter_value(math_parameter_prime_raise, math_int_parameter, primeraise);
+ set_math_parameter_value(math_parameter_prime_raise_composed, math_int_parameter, primeraisecomposed);
+ set_math_parameter_value(math_parameter_prime_shift_up, math_dimen_parameter, primeshiftup);
+ set_math_parameter_value(math_parameter_prime_shift_drop, math_dimen_parameter, primeshiftdrop);
+ set_math_parameter_value(math_parameter_prime_space_after, math_dimen_parameter, primespaceafter);
+ set_math_parameter_value(math_parameter_prime_width, math_int_parameter, primewidth);
+
+ set_math_parameter_value(math_parameter_rule_height, math_dimen_parameter, ruleheight);
+ set_math_parameter_value(math_parameter_rule_depth, math_dimen_parameter, ruledepth);
+
+ set_math_parameter_value(math_parameter_superscript_shift_distance, math_dimen_parameter, superscriptshiftdistance);
+ set_math_parameter_value(math_parameter_subscript_shift_distance, math_dimen_parameter, subscriptshiftdistance);
+ set_math_parameter_value(math_parameter_superprescript_shift_distance, math_dimen_parameter, presuperscriptshiftdistance);
+ set_math_parameter_value(math_parameter_subprescript_shift_distance, math_dimen_parameter, presubscriptshiftdistance);
+
+ set_math_parameter_value(math_parameter_extra_superscript_space, math_dimen_parameter, extrasuperscriptspace);
+ set_math_parameter_value(math_parameter_extra_subscript_space, math_dimen_parameter, extrasubscriptspace);
+ set_math_parameter_value(math_parameter_extra_superprescript_space, math_dimen_parameter, extrasuperprescriptspace);
+ set_math_parameter_value(math_parameter_extra_subprescript_space, math_dimen_parameter, extrasubprescriptspace);
+
+ set_math_parameter_value(math_parameter_skewed_delimiter_tolerance, math_dimen_parameter, skeweddelimitertolerance);
+
+ set_math_parameter_value(math_parameter_accent_top_shift_up, math_dimen_parameter, accenttopshiftup);
+ set_math_parameter_value(math_parameter_accent_bottom_shift_down, math_dimen_parameter, accentbottomshiftdown);
+ set_math_parameter_value(math_parameter_accent_top_overshoot, math_int_parameter, accenttopovershoot);
+ set_math_parameter_value(math_parameter_accent_bottom_overshoot, math_int_parameter, accentbottomovershoot);
+ set_math_parameter_value(math_parameter_accent_superscript_drop, math_dimen_parameter, accentsuperscriptdrop);
+ set_math_parameter_value(math_parameter_accent_superscript_percent, math_int_parameter, accentsuperscriptpercent);
+ set_math_parameter_value(math_parameter_accent_extend_margin, math_int_parameter, accentextendmargin);
+ set_math_parameter_value(math_parameter_flattened_accent_top_shift_up, math_dimen_parameter, flattenedaccenttopshiftup);
+ set_math_parameter_value(math_parameter_flattened_accent_bottom_shift_down, math_dimen_parameter, flattenedaccentbottomshiftdown);
+
+ set_math_parameter_value(math_parameter_delimiter_percent, math_int_parameter, delimiterpercent);
+ set_math_parameter_value(math_parameter_delimiter_shortfall, math_dimen_parameter, delimitershortfall);
+
+ set_math_parameter_value(math_parameter_over_line_variant, math_style_parameter, overlinevariant);
+ set_math_parameter_value(math_parameter_under_line_variant, math_style_parameter, underlinevariant);
+ set_math_parameter_value(math_parameter_over_delimiter_variant, math_style_parameter, overdelimitervariant);
+ set_math_parameter_value(math_parameter_under_delimiter_variant, math_style_parameter, underdelimitervariant);
+ set_math_parameter_value(math_parameter_delimiter_over_variant, math_style_parameter, delimiterovervariant);
+ set_math_parameter_value(math_parameter_delimiter_under_variant, math_style_parameter, delimiterundervariant);
+ set_math_parameter_value(math_parameter_h_extensible_variant, math_style_parameter, hextensiblevariant);
+ set_math_parameter_value(math_parameter_v_extensible_variant, math_style_parameter, vextensiblevariant);
+ set_math_parameter_value(math_parameter_fraction_variant, math_style_parameter, fractionvariant);
+ set_math_parameter_value(math_parameter_radical_variant, math_style_parameter, radicalvariant);
+ set_math_parameter_value(math_parameter_degree_variant, math_style_parameter, degreevariant);
+ set_math_parameter_value(math_parameter_accent_variant, math_style_parameter, accentvariant);
+ set_math_parameter_value(math_parameter_top_accent_variant, math_style_parameter, topaccentvariant);
+ set_math_parameter_value(math_parameter_bottom_accent_variant, math_style_parameter, bottomaccentvariant);
+ set_math_parameter_value(math_parameter_overlay_accent_variant, math_style_parameter, overlayaccentvariant);
+ set_math_parameter_value(math_parameter_numerator_variant, math_style_parameter, numeratorvariant);
+ set_math_parameter_value(math_parameter_denominator_variant, math_style_parameter, denominatorvariant);
+ set_math_parameter_value(math_parameter_superscript_variant, math_style_parameter, superscriptvariant);
+ set_math_parameter_value(math_parameter_subscript_variant, math_style_parameter, subscriptvariant);
+ set_math_parameter_value(math_parameter_prime_variant, math_style_parameter, primevariant);
+ set_math_parameter_value(math_parameter_stack_variant, math_style_parameter, stackvariant);
+
+ lmt_interface.math_font_parameter_values = lmt_aux_allocate_value_info(math_parameter_last_code + 1);
+
+ # define set_math_font_parameter(n, t) lmt_interface.math_font_parameter_values[n] = (value_info) { .lua = lua_key_index(n), .name = lua_key(n), .type = t }
+
+ set_math_font_parameter(ScriptPercentScaleDown, math_int_parameter);
+ set_math_font_parameter(ScriptScriptPercentScaleDown, math_int_parameter);
+ set_math_font_parameter(DelimitedSubFormulaMinHeight, math_dimen_parameter);
+ set_math_font_parameter(DisplayOperatorMinHeight, math_dimen_parameter);
+ set_math_font_parameter(MathLeading, math_dimen_parameter);
+ set_math_font_parameter(AxisHeight, math_dimen_parameter);
+ set_math_font_parameter(AccentBaseHeight, math_dimen_parameter);
+ set_math_font_parameter(AccentBaseDepth, math_dimen_parameter);
+ set_math_font_parameter(FlattenedAccentBaseHeight, math_dimen_parameter);
+ set_math_font_parameter(FlattenedAccentBaseDepth, math_dimen_parameter);
+ set_math_font_parameter(SubscriptShiftDown, math_dimen_parameter);
+ set_math_font_parameter(SubscriptTopMax, math_dimen_parameter);
+ set_math_font_parameter(SubscriptBaselineDropMin, math_dimen_parameter);
+ set_math_font_parameter(SuperscriptShiftUp, math_dimen_parameter);
+ set_math_font_parameter(SuperscriptShiftUpCramped, math_dimen_parameter);
+ set_math_font_parameter(SuperscriptBottomMin, math_dimen_parameter);
+ set_math_font_parameter(SuperscriptBaselineDropMax, math_dimen_parameter);
+ set_math_font_parameter(SubSuperscriptGapMin, math_dimen_parameter);
+ set_math_font_parameter(SuperscriptBottomMaxWithSubscript, math_dimen_parameter);
+ set_math_font_parameter(SpaceBeforeScript, math_dimen_parameter);
+ set_math_font_parameter(SpaceAfterScript, math_dimen_parameter);
+ set_math_font_parameter(UpperLimitGapMin, math_dimen_parameter);
+ set_math_font_parameter(UpperLimitBaselineRiseMin, math_dimen_parameter);
+ set_math_font_parameter(LowerLimitGapMin, math_dimen_parameter);
+ set_math_font_parameter(LowerLimitBaselineDropMin, math_dimen_parameter);
+ set_math_font_parameter(StackTopShiftUp, math_dimen_parameter);
+ set_math_font_parameter(StackTopDisplayStyleShiftUp, math_dimen_parameter);
+ set_math_font_parameter(StackBottomShiftDown, math_dimen_parameter);
+ set_math_font_parameter(StackBottomDisplayStyleShiftDown, math_dimen_parameter);
+ set_math_font_parameter(StackGapMin, math_dimen_parameter);
+ set_math_font_parameter(StackDisplayStyleGapMin, math_dimen_parameter);
+ set_math_font_parameter(StretchStackTopShiftUp, math_dimen_parameter);
+ set_math_font_parameter(StretchStackBottomShiftDown, math_dimen_parameter);
+ set_math_font_parameter(StretchStackGapAboveMin, math_dimen_parameter);
+ set_math_font_parameter(StretchStackGapBelowMin, math_dimen_parameter);
+ set_math_font_parameter(FractionNumeratorShiftUp, math_dimen_parameter);
+ set_math_font_parameter(FractionNumeratorDisplayStyleShiftUp, math_dimen_parameter);
+ set_math_font_parameter(FractionDenominatorShiftDown, math_dimen_parameter);
+ set_math_font_parameter(FractionDenominatorDisplayStyleShiftDown, math_dimen_parameter);
+ set_math_font_parameter(FractionNumeratorGapMin, math_dimen_parameter);
+ set_math_font_parameter(FractionNumeratorDisplayStyleGapMin, math_dimen_parameter);
+ set_math_font_parameter(FractionRuleThickness, math_dimen_parameter);
+ set_math_font_parameter(FractionDenominatorGapMin, math_dimen_parameter);
+ set_math_font_parameter(FractionDenominatorDisplayStyleGapMin, math_dimen_parameter);
+ set_math_font_parameter(SkewedFractionHorizontalGap, math_dimen_parameter);
+ set_math_font_parameter(SkewedFractionVerticalGap, math_dimen_parameter);
+ set_math_font_parameter(OverbarVerticalGap, math_dimen_parameter);
+ set_math_font_parameter(OverbarRuleThickness, math_dimen_parameter);
+ set_math_font_parameter(OverbarExtraAscender, math_dimen_parameter);
+ set_math_font_parameter(UnderbarVerticalGap, math_dimen_parameter);
+ set_math_font_parameter(UnderbarRuleThickness, math_dimen_parameter);
+ set_math_font_parameter(UnderbarExtraDescender, math_dimen_parameter);
+ set_math_font_parameter(RadicalVerticalGap, math_dimen_parameter);
+ set_math_font_parameter(RadicalDisplayStyleVerticalGap, math_dimen_parameter);
+ set_math_font_parameter(RadicalRuleThickness, math_dimen_parameter);
+ set_math_font_parameter(RadicalExtraAscender, math_dimen_parameter);
+ set_math_font_parameter(RadicalKernBeforeDegree, math_dimen_parameter);
+ set_math_font_parameter(RadicalKernAfterDegree, math_dimen_parameter);
+ set_math_font_parameter(RadicalDegreeBottomRaisePercent, math_int_parameter);
+ set_math_font_parameter(RadicalKernAfterExtensible, math_dimen_parameter);
+ set_math_font_parameter(RadicalKernBeforeExtensible, math_dimen_parameter);
+ set_math_font_parameter(MinConnectorOverlap, math_dimen_parameter);
+ set_math_font_parameter(SubscriptShiftDownWithSuperscript, math_dimen_parameter);
+ set_math_font_parameter(FractionDelimiterSize, math_dimen_parameter);
+ set_math_font_parameter(FractionDelimiterDisplayStyleSize, math_dimen_parameter);
+ set_math_font_parameter(NoLimitSubFactor, math_int_parameter);
+ set_math_font_parameter(NoLimitSupFactor, math_int_parameter);
+ set_math_font_parameter(PrimeRaisePercent, math_int_parameter);
+ set_math_font_parameter(PrimeRaiseComposedPercent, math_int_parameter);
+ set_math_font_parameter(PrimeShiftUp, math_dimen_parameter);
+ set_math_font_parameter(PrimeShiftUpCramped, math_dimen_parameter);
+ set_math_font_parameter(PrimeBaselineDropMax, math_dimen_parameter);
+ set_math_font_parameter(PrimeSpaceAfter, math_dimen_parameter);
+ set_math_font_parameter(PrimeWidthPercent, math_int_parameter);
+ set_math_font_parameter(SkewedDelimiterTolerance, math_dimen_parameter);
+ set_math_font_parameter(AccentTopShiftUp, math_dimen_parameter);
+ set_math_font_parameter(AccentBottomShiftDown, math_dimen_parameter);
+ set_math_font_parameter(AccentTopOvershoot, math_int_parameter);
+ set_math_font_parameter(AccentBottomOvershoot, math_int_parameter);
+ set_math_font_parameter(AccentSuperscriptDrop, math_dimen_parameter);
+ set_math_font_parameter(AccentSuperscriptPercent, math_int_parameter);
+ set_math_font_parameter(AccentExtendMargin, math_dimen_parameter);
+ set_math_font_parameter(FlattenedAccentTopShiftUp, math_dimen_parameter);
+ set_math_font_parameter(FlattenedAccentBottomShiftDown, math_dimen_parameter);
+ set_math_font_parameter(DelimiterPercent, math_int_parameter);
+ set_math_font_parameter(DelimiterShortfall, math_dimen_parameter);
+}
diff --git a/source/luametatex/source/lua/lmtinterface.h b/source/luametatex/source/lua/lmtinterface.h
new file mode 100644
index 000000000..e55b03e84
--- /dev/null
+++ b/source/luametatex/source/lua/lmtinterface.h
@@ -0,0 +1,1754 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LINTERFACE_H
+# define LMT_LINTERFACE_H
+
+# define lmt_linterface_inline 1
+
+/*tex
+
+ In this file we collect all kind of interface stuff related to \LUA. It is a large file because
+ we also create \LUA\ string entries which speeds up the interfacing.
+
+*/
+
+# include "lua.h"
+# include "lauxlib.h"
+# include "lualib.h"
+
+/*tex Just in case: */
+
+extern int tex_formatted_error (const char *t, const char *fmt, ...);
+extern void tex_formatted_warning (const char *t, const char *fmt, ...);
+extern void tex_emergency_message (const char *t, const char *fmt, ...);
+
+/*tex
+
+ In the beginning we had multiple \LUA\ states but that didn't work out well if you want to
+ intercace to the \TEX\ kernel. So, we dropped that and now have only one main state.
+
+*/
+
+typedef struct lua_state_info {
+ lua_State *lua_instance;
+ int used_bytes;
+ int used_bytes_max;
+ int function_table_id;
+ int function_callback_count;
+ int value_callback_count;
+ int bytecode_callback_count;
+ int local_callback_count;
+ int saved_callback_count;
+ int file_callback_count;
+ int direct_callback_count;
+ int message_callback_count;
+ int function_table_size;
+ int bytecode_bytes;
+ int bytecode_max;
+ int version_number;
+ int release_number;
+ luaL_Buffer *used_buffer;
+ int integer_size;
+} lua_state_info ;
+
+extern lua_state_info lmt_lua_state;
+
+/*tex The libraries are opened and initialized by the following functions. */
+
+extern int luaopen_tex (lua_State *L);
+extern int luaopen_texio (lua_State *L);
+extern int luaopen_language (lua_State *L);
+extern int luaopen_filelib (lua_State *L);
+extern int luaopen_lpeg (lua_State *L);
+extern int luaopen_md5 (lua_State *L);
+extern int luaopen_sha2 (lua_State *L);
+extern int luaopen_aes (lua_State *L);
+extern int luaopen_basexx (lua_State *L);
+extern int luaopen_xmath (lua_State *L);
+extern int luaopen_xcomplex (lua_State *L);
+extern int luaopen_xdecimal (lua_State *L);
+extern int luaopen_xzip (lua_State *L);
+extern int luaopen_socket_core (lua_State *L);
+extern int luaopen_mime_core (lua_State *L);
+extern int luaopen_pdfe (lua_State *L);
+extern int luaopen_pngdecode (lua_State *L);
+extern int luaopen_pdfdecode (lua_State *L);
+extern int luaopen_mplib (lua_State *L);
+extern int luaopen_fio (lua_State *L);
+extern int luaopen_sio (lua_State *L);
+extern int luaopen_sparse (lua_State *L);
+extern int luaopen_callback (lua_State *L);
+extern int luaopen_lua (lua_State *L);
+extern int luaopen_luac (lua_State *L);
+extern int luaopen_status (lua_State *L);
+extern int luaopen_font (lua_State *L);
+extern int luaopen_node (lua_State *L);
+extern int luaopen_token (lua_State *L);
+extern int luaopen_optional (lua_State *L);
+extern int luaopen_library (lua_State *L);
+
+extern int luaextend_os (lua_State *L);
+extern int luaextend_io (lua_State *L);
+extern int luaextend_string (lua_State *L);
+extern int luaextend_xcomplex (lua_State *L);
+
+/*tex
+
+ We finetune the string hasher. When playing with \LUAJIT\ we found that its hashes was pretty
+ inefficient and geared for \URL's! So there we switched to the \LUA\ hasher an din the process
+ we also did experiments with the |LUA_HASHLIMIT| parameter. There's an (already old) article
+ about that in one of the \LUATEX\ histories.
+
+ */
+
+# if !defined(LUAI_HASHLIMIT)
+# define LUAI_HASHLIMIT 6
+# endif
+
+/*tex
+
+ Now comes a large section. Here we create and use macros that preset the access pointers
+ (indices) to keys which is faster in comparison. We also handle the arrays that hold the
+ information about what fields there are in nodes. This is code from the early times when we
+ found out that especially when a lot of access by key happens performance is hit because
+ strings get rehashed. It might be that in the meantime \LUA\ suffers less from this but we
+ keep this abstraction anyway.
+
+ As we share this mechanism between all modules and because, although it is built from
+ components, \LUAMETATEX\ is a whole, we now also moved the \MPLIB\ keys into the same
+ namespace which saves code and macros. Some are shared anyway.
+
+ There is also a bit of metatable lookup involved but we only do that for those modules for
+ which it's critical.
+
+ Contrary to \LUATEX\ we use a struct to collect the indices and keys instead of global
+ pointers. This hides the symbols better.
+
+*/
+
+// todo: add L to some below
+
+# define lua_key_eq(a,b) (a == lmt_keys.ptr_##b)
+# define lua_key_index(a) lmt_keys.idx_##a
+# define lua_key(a) lmt_keys.ptr_##a
+
+# define init_lua_key(L,a) \
+ lua_pushliteral(L, #a); \
+ lmt_keys.ptr_##a = lua_tolstring(L, -1, NULL); \
+ lmt_keys.idx_##a = luaL_ref(L, LUA_REGISTRYINDEX);
+
+# define init_lua_key_alias(L,a,b) \
+ lua_pushliteral(L, b); \
+ lmt_keys.ptr_##a = lua_tolstring(L, -1, NULL); \
+ lmt_keys.idx_##a = luaL_ref(L, LUA_REGISTRYINDEX);
+
+# define make_lua_key_ptr(L,a) const char *ptr_##a
+# define make_lua_key_idx(L,a) int idx_##a
+
+# define make_lua_key_ptr_alias(L,a,b) const char *ptr_##a
+# define make_lua_key_idx_alias(L,a,b) int idx_##a
+
+# define make_lua_key
+# define make_lua_key_alias
+
+# define lua_push_key(a) lua_rawgeti(L, LUA_REGISTRYINDEX, lua_key_index(a));
+# define lua_push_key_by_index(a) lua_rawgeti(L, LUA_REGISTRYINDEX, a);
+
+# define lua_get_metatablelua(a) do { \
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lua_key_index(a)); \
+ lua_gettable(L, LUA_REGISTRYINDEX); \
+} while (0)
+
+# define lua_push_number(L,x) lua_pushnumber (L, (lua_Number) (x))
+# define lua_push_integer(L,x) lua_pushinteger(L, (int) (x))
+# define lua_push_halfword(L,x) lua_pushinteger(L, (lua_Integer) (x))
+
+# define lua_push_number_at_index(L,i,x) \
+ lua_pushnumber(L, (lua_Number) (x)); \
+ lua_rawseti(L, -2, i);
+
+# define lua_push_integer_at_index(L,i,x) \
+ lua_pushinteger(L, (x)); \
+ lua_rawseti(L, -2, i);
+
+# define lua_push_key_at_index(L,k,i) \
+ lua_pushinteger(L, i); \
+ lua_push_key(k); \
+ lua_rawset(L, -3);
+
+# define lua_push_nil_at_key(L,k) \
+ lua_push_key(k); \
+ lua_pushnil(L); \
+ lua_rawset(L, -3);
+
+# define lua_push_number_at_key(L,k,x) \
+ lua_push_key(k); \
+ lua_pushnumber(L, (lua_Number) (x)); \
+ lua_rawset(L, -3);
+
+# define lua_push_integer_at_key(L,k,x) \
+ lua_push_key(k); \
+ lua_pushinteger(L, (x)); \
+ lua_rawset(L, -3);
+
+# define lua_push_string_at_key(L,k,s) \
+ lua_push_key(k); \
+ lua_pushstring(L, s); \
+ lua_rawset(L, -3);
+
+# define mlua_push_lstring_at_key(L,k,s,l) \
+ lua_push_key(k); \
+ lua_pushlstring(L, s, l); \
+ lua_rawset(L, -3);
+
+# define lua_push_boolean_at_key(L,k,b) \
+ lua_push_key(k); \
+ lua_pushboolean(L, b); \
+ lua_rawset(L, -3);
+
+# define lua_push_value_at_key(L,k,v) \
+ lua_push_key(k); \
+ lua_push_key(v); \
+ lua_rawset(L, -3);
+
+# define lua_push_svalue_at_key(L,k,v) \
+ lua_push_key(k); \
+ lua_push_key_by_index(v); \
+ lua_rawset(L, -3);
+
+# define lua_push_specification_at_key(L,k,x) \
+ lua_push_key(k); \
+ lmt_push_specification(L, x, 0); \
+ lua_rawset(L, -3);
+
+/*tex We put some here. These are not public (read: names can change). */
+
+/*tex Used in |lmtnodelib|. */
+
+# define NODE_METATABLE_INSTANCE "node.instance"
+# define NODE_PROPERTIES_DIRECT "node.properties"
+# define NODE_PROPERTIES_INDIRECT "node.properties.indirect"
+# define NODE_PROPERTIES_INSTANCE "node.properties.instance"
+
+/*tex Used in |lmttokenlib|. */
+
+# define TOKEN_METATABLE_INSTANCE "token.instance"
+# define TOKEN_METATABLE_PACKAGE "token.package"
+
+/*tex Used in |lmtepdflib|. */
+
+# define PDFE_METATABLE_INSTANCE "pdfe.instance"
+# define PDFE_METATABLE_DICTIONARY "pdfe.dictionary"
+# define PDFE_METATABLE_ARRAY "pdfe.array"
+# define PDFE_METATABLE_STREAM "pdfe.stream"
+# define PDFE_METATABLE_REFERENCE "pdfe.reference"
+
+/*tex Used in |lmtmplib|. */
+
+# define MP_METATABLE_INSTANCE "mp.instance"
+# define MP_METATABLE_FIGURE "mp.figure"
+# define MP_METATABLE_OBJECT "mp.object"
+
+/*tex Used in |lmtsparselib|. */
+
+# define SPARSE_METATABLE_INSTANCE "sparse.instance"
+
+/*tex
+
+ Currently we sometimes use numbers and sometimes strings in node properties. We can make that
+ consistent by having a check on number and if not then assign a string. The strings are
+ prehashed and we make a bunch of lua tables that have these values. We can preassign these at
+ startup time.
+
+*/
+
+typedef struct value_info {
+ union {
+ int id;
+ int type;
+ int value;
+ };
+ int lua;
+ const char *name;
+} value_info;
+
+typedef struct node_info {
+ int id;
+ int size;
+ value_info *subtypes;
+ value_info *fields;
+ const char *name;
+ int lua;
+ int visible;
+ int first;
+ int last;
+} node_info;
+
+typedef struct command_item {
+ int id;
+ int lua;
+ const char *name;
+ int kind;
+ int min;
+ int max;
+ int base;
+ int fixedvalue;
+} command_item;
+
+# define unknown_node 0xFFFF
+# define unknown_subtype 0xFFFF
+# define unknown_field 0xFFFF
+# define unknown_value 0xFFFF
+
+# define set_value_entry_nop(target,n) target[n].lua = 0; target[n].name = NULL; target[n].value = unknown_value;
+# define set_value_entry_key(target,n,k) target[n].lua = lua_key_index(k); target[n].name = lua_key(k); target[n].value = n;
+# define set_value_entry_lua(target,n,k) target[n].lua = lua_key_index(k); target[n].name = lua_key(k);
+# define set_value_entry_val(target,n,v,k) target[n].lua = lua_key_index(k); target[n].name = lua_key(k); target[n].value = v;
+
+extern value_info *lmt_aux_allocate_value_info(size_t last);
+
+typedef struct lmt_interface_info {
+ /*tex These are mostly used in lmtnodelib. */
+ value_info *pack_type_values;
+ value_info *group_code_values;
+ value_info *par_context_values;
+ value_info *page_context_values;
+ value_info *append_line_context_values;
+ value_info *alignment_context_values;
+ value_info *par_begin_values;
+ value_info *par_mode_values;
+ value_info *math_style_name_values;
+ value_info *math_style_variant_values;
+ /* value_info *noad_option_values; */
+ /* value_info *glyph_option_values; */
+ /*tex These are mostly used in lmttokenlib. */
+ value_info *lua_function_values;
+ value_info *direction_values;
+ value_info *node_fill_values;
+ value_info *page_contribute_values;
+ value_info *math_style_values;
+ value_info *math_parameter_values;
+ value_info *math_font_parameter_values;
+ value_info *math_indirect_values;
+ value_info *field_type_values;
+ /*tex Here's one for nodes. */
+ node_info *node_data;
+ /*tex And this one is for tokens. */
+ command_item *command_names;
+} lmt_interface_info ;
+
+extern lmt_interface_info lmt_interface;
+
+# define lmt_push_pack_type(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.pack_type_values [n].lua)
+# define lmt_push_group_code(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.group_code_values [n].lua)
+# define lmt_push_par_context(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.par_context_values [n].lua)
+# define lmt_push_page_context(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.page_context_values [n].lua)
+# define lmt_push_append_line_context(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.append_line_context_values[n].lua)
+# define lmt_push_alignment_context(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.alignment_context_values [n].lua)
+# define lmt_push_par_begin(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.par_begin_values [n].lua)
+# define lmt_push_par_mode(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.par_mode_values [n].lua)
+# define lmt_push_math_style_name(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_style_name_values [n].lua)
+# define lmt_push_math_style_variant(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_style_variant_values [n].lua)
+# define lmt_push_math_noad_option(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_noad_option_values [n].lua)
+# define lmt_push_lua_function_values(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.lua_function_values [n].lua)
+# define lmt_push_direction(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.direction_values [n].lua)
+# define lmt_push_node_fill(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.node_fill_values [n].lua)
+# define lmt_push_page_contribute(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.page_contribute_values [n].lua)
+# define lmt_push_math_style(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_style_values [n].lua)
+# define lmt_push_math_parameter(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_parameter_values [n].lua)
+# define lmt_push_math_font_parameter(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_font_parameter_values[n].lua)
+# define lmt_push_math_indirect(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.math_indirect_values [n].lua)
+# define lmt_push_field_type(L,n) lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.field_type_values [n].lua)
+
+# define lmt_name_of_pack_type(n) lmt_interface.pack_type_values [n].name
+# define lmt_name_of_group_code(n) lmt_interface.group_code_values [n].name
+# define lmt_name_of_par_context(n) lmt_interface.par_context_values [n].name
+# define lmt_name_of_page_context(n) lmt_interface.page_context_values [n].name
+# define lmt_name_of_append_line_context(n) lmt_interface.append_line_context_values[n].name
+# define lmt_name_of_alignment_context(n) lmt_interface.alignment_context_values [n].name
+# define lmt_name_of_par_begin(n) lmt_interface.par_begin_values [n].name
+# define lmt_name_of_par_mode(n) lmt_interface.par_mode_values [n].name
+# define lmt_name_of_math_style_name(n) lmt_interface.math_style_name_values [n].name
+# define lmt_name_of_math_style_variant(n) lmt_interface.math_style_variant_values [n].name
+# define lmt_name_of_math_noad_option(n) lmt_interface.math_noad_option_values [n].name
+# define lmt_name_of_lua_function_values(n) lmt_interface.lua_function_values [n].name
+# define lmt_name_of_direction(n) lmt_interface.direction_values [n].name
+# define lmt_name_of_node_fill(n) lmt_interface.node_fill_values [n].name
+# define lmt_name_of_page_contribute(n) lmt_interface.page_contribute_values [n].name
+# define lmt_name_of_math_style(n) lmt_interface.math_style_values [n].name
+# define lmt_name_of_math_parameter(n) lmt_interface.math_parameter_values [n].name
+# define lmt_name_of_math_font_parameter(n) lmt_interface.math_font_parameter_values[n].name
+# define lmt_name_of_math_indirect(n) lmt_interface.math_indirect_values [n].name
+# define lmt_name_of_field_type(n) lmt_interface.field_type_values [n].name
+
+/*tex This list will be made smaller because not all values need the boost. */
+
+# define declare_shared_lua_keys(L) \
+/* */\
+make_lua_key(L, __index);\
+make_lua_key(L, above);\
+make_lua_key(L, abovedisplayshortskip);\
+make_lua_key(L, abovedisplayskip);\
+make_lua_key(L, accent);\
+make_lua_key(L, AccentBaseHeight);\
+make_lua_key(L, AccentBaseDepth);\
+make_lua_key(L, accentbaseheight);\
+make_lua_key(L, accentbasedepth);\
+make_lua_key(L, AccentTopShiftUp);\
+make_lua_key(L, accenttopshiftup);\
+make_lua_key(L, AccentTopOvershoot);\
+make_lua_key(L, accenttopovershoot);\
+make_lua_key(L, adapted);\
+make_lua_key(L, FlattenedAccentTopShiftUp);\
+make_lua_key(L, flattenedaccenttopshiftup);\
+make_lua_key(L, AccentBottomShiftDown);\
+make_lua_key(L, accentbottomshiftdown);\
+make_lua_key(L, AccentBottomOvershoot);\
+make_lua_key(L, accentbottomovershoot);\
+make_lua_key(L, AccentSuperscriptDrop);\
+make_lua_key(L, accentsuperscriptdrop);\
+make_lua_key(L, AccentSuperscriptPercent);\
+make_lua_key(L, accentsuperscriptpercent);\
+make_lua_key(L, AccentExtendMargin);\
+make_lua_key(L, accentextendmargin);\
+make_lua_key(L, FlattenedAccentBottomShiftDown);\
+make_lua_key(L, flattenedaccentbottomshiftdown);\
+make_lua_key(L, accentkern);\
+make_lua_key(L, accentvariant);\
+make_lua_key(L, active);\
+make_lua_key(L, active_char);\
+make_lua_key(L, adapttoleftsize);\
+make_lua_key(L, adapttorightsize);\
+make_lua_key(L, additional);\
+make_lua_key(L, adjdemerits);\
+make_lua_key(L, adjust);\
+make_lua_key(L, adjustedhbox);\
+make_lua_key(L, adjustspacing);\
+make_lua_key(L, adjustspacingshrink);\
+make_lua_key(L, adjustspacingstep);\
+make_lua_key(L, adjustspacingstretch);\
+make_lua_key(L, advance);\
+make_lua_key(L, after_output);\
+make_lua_key(L, after_something);\
+make_lua_key(L, afterdisplay);\
+make_lua_key(L, afterdisplaypenalty);\
+make_lua_key(L, afteroutput);\
+make_lua_key(L, aliased);\
+make_lua_key(L, align);\
+make_lua_key(L, alignrecord);\
+make_lua_key(L, alignstack);\
+make_lua_key(L, alignhead);\
+make_lua_key(L, alignment);\
+make_lua_key(L, alignment_tab);\
+make_lua_key(L, alignset);\
+make_lua_key(L, alsosimple);\
+make_lua_key(L, anchor);\
+make_lua_key(L, argument);\
+make_lua_key(L, arithmic);\
+make_lua_key(L, attr);\
+make_lua_key(L, attribute);\
+make_lua_key(L, attribute_list);\
+make_lua_key(L, attributelist);\
+make_lua_key(L, auto);\
+make_lua_key(L, automatic);\
+make_lua_key(L, automaticpenalty);\
+make_lua_key(L, axis);\
+make_lua_key(L, AxisHeight);\
+make_lua_key(L, baselineskip);\
+make_lua_key(L, beforedisplay);\
+make_lua_key(L, beforedisplaypenalty);\
+make_lua_key(L, begin_group);\
+make_lua_key(L, begin_local);\
+make_lua_key(L, begin_paragraph);\
+make_lua_key(L, beginmath);\
+make_lua_key(L, beginparagraph);\
+make_lua_key(L, belowdisplayshortskip);\
+make_lua_key(L, belowdisplayskip);\
+make_lua_key(L, bend_tolerance);\
+make_lua_key(L, bestinsert);\
+make_lua_key(L, bestpagebreak);\
+make_lua_key(L, bestsize);\
+make_lua_key(L, bin);\
+make_lua_key(L, binbinspacing);\
+make_lua_key(L, binclosespacing);\
+make_lua_key(L, binfracspacing);\
+make_lua_key(L, bininnerspacing);\
+make_lua_key(L, binmiddlespacing);\
+make_lua_key(L, binopenspacing);\
+make_lua_key(L, binopspacing);\
+make_lua_key(L, binordspacing);\
+make_lua_key(L, binpunctspacing);\
+make_lua_key(L, binradspacing);\
+make_lua_key(L, binrelspacing);\
+make_lua_key(L, boolean);\
+make_lua_key(L, bottomaccent);\
+make_lua_key(L, bottomaccentvariant);\
+make_lua_key(L, bothflexible);\
+make_lua_key(L, bottom);\
+make_lua_key(L, bottomleft);\
+make_lua_key(L, bottomlevel);\
+make_lua_key(L, bottommargin);\
+make_lua_key(L, bottomright);\
+make_lua_key(L, boundary);\
+make_lua_key(L, box);\
+make_lua_key(L, broken);\
+make_lua_key(L, brokeninsert);\
+make_lua_key(L, brokenpenalty);\
+make_lua_key(L, bytecode);\
+make_lua_key(L, call);\
+make_lua_key(L, callback);\
+make_lua_key(L, cancel);\
+make_lua_key(L, cardinal);\
+make_lua_key(L, case_shift);\
+make_lua_key(L, catalog);\
+make_lua_key(L, Catalog);\
+make_lua_key(L, catcode_table);\
+make_lua_key(L, category);\
+make_lua_key(L, cell);\
+make_lua_key(L, char);\
+make_lua_key(L, char_given);\
+make_lua_key(L, char_number);\
+make_lua_key(L, character);\
+make_lua_key(L, characters);\
+make_lua_key(L, choice);\
+make_lua_key(L, class);\
+make_lua_key(L, cleaders);\
+make_lua_key(L, close);\
+make_lua_key(L, closebinspacing);\
+make_lua_key(L, closeclosespacing);\
+make_lua_key(L, closefracspacing);\
+make_lua_key(L, closeinnerspacing);\
+make_lua_key(L, closemiddlespacing);\
+make_lua_key(L, closeopenspacing);\
+make_lua_key(L, closeopspacing);\
+make_lua_key(L, closeordspacing);\
+make_lua_key(L, closepunctspacing);\
+make_lua_key(L, closeradspacing);\
+make_lua_key(L, closerelspacing);\
+make_lua_key(L, clubpenalties);\
+make_lua_key(L, clubpenalty);\
+make_lua_key(L, cmd);\
+make_lua_key(L, cmdname);\
+make_lua_key(L, collapse);\
+make_lua_key(L, combine_toks);\
+make_lua_key(L, command);\
+make_lua_key(L, comment);\
+make_lua_key(L, compactmath);\
+make_lua_key(L, compound);\
+make_lua_key(L, condition);\
+make_lua_key(L, conditional);\
+make_lua_key(L, conditionalmathskip);\
+make_lua_key(L, connectoroverlapmin);\
+make_lua_key(L, container);\
+make_lua_key(L, contributehead);\
+make_lua_key(L, convert);\
+make_lua_key(L, correctionskip);\
+make_lua_key(L, cost);\
+make_lua_key(L, count);\
+make_lua_key(L, cramped);\
+make_lua_key(L, crampeddisplay);\
+make_lua_key(L, crampedscript);\
+make_lua_key(L, crampedscriptscript);\
+make_lua_key(L, crampedtext);\
+make_lua_key(L, cs_name);\
+make_lua_key(L, csname);\
+make_lua_key(L, current);\
+make_lua_key(L, data);\
+make_lua_key(L, deep_frozen_cs_dont_expand);\
+make_lua_key(L, deep_frozen_cs_end_template);\
+make_lua_key(L, def);\
+make_lua_key(L, define_char_code);\
+make_lua_key(L, define_family);\
+make_lua_key(L, define_font);\
+make_lua_key(L, define_lua_call);\
+make_lua_key(L, degree);\
+make_lua_key(L, degreevariant);\
+make_lua_key(L, DelimitedSubFormulaMinHeight);\
+make_lua_key(L, delimiter);\
+make_lua_key(L, delimited);\
+make_lua_key(L, delimiter_number);\
+make_lua_key(L, delimiterpercent);\
+make_lua_key(L, DelimiterPercent);\
+make_lua_key(L, delimitershortfall);\
+make_lua_key(L, DelimiterShortfall);\
+make_lua_key(L, delimiterover);\
+make_lua_key(L, delimiterovervariant);\
+make_lua_key(L, delimiterunder);\
+make_lua_key(L, delimiterundervariant);\
+make_lua_key(L, delta);\
+make_lua_key(L, demerits);\
+make_lua_key(L, denominator);\
+make_lua_key(L, denominatorvariant);\
+make_lua_key(L, depth);\
+make_lua_key(L, designsize);\
+make_lua_key(L, dimension);\
+make_lua_key(L, dir);\
+make_lua_key(L, direct);\
+make_lua_key(L, direction);\
+make_lua_key(L, directory);\
+make_lua_key(L, disc);\
+make_lua_key(L, discpart);\
+make_lua_key(L, discretionary);\
+make_lua_key(L, display);\
+make_lua_key(L, DisplayOperatorMinHeight);\
+make_lua_key(L, displaywidowpenalties);\
+make_lua_key(L, displaywidowpenalty);\
+make_lua_key(L, doffset);\
+make_lua_key(L, doublehyphendemerits);\
+make_lua_key(L, doublesuperscript);\
+make_lua_key(L, emergencystretch);\
+make_lua_key(L, empty);\
+make_lua_key(L, end);\
+make_lua_key(L, end_cs_name);\
+make_lua_key(L, end_file);\
+make_lua_key(L, end_group);\
+make_lua_key(L, end_job);\
+make_lua_key(L, end_line);\
+make_lua_key(L, end_local);\
+make_lua_key(L, end_match);\
+make_lua_key(L, end_paragraph);\
+make_lua_key(L, end_template);\
+make_lua_key(L, endmath);\
+make_lua_key(L, equation);\
+make_lua_key(L, equation_number);\
+make_lua_key(L, equationnumber);\
+make_lua_key(L, equationnumberpenalty);\
+make_lua_key(L, escape);\
+make_lua_key(L, etex);\
+make_lua_key(L, exact);\
+make_lua_key(L, exactly);\
+make_lua_key(L, expand_after);\
+make_lua_key(L, expandable);\
+make_lua_key(L, expanded);\
+make_lua_key(L, expansion);\
+make_lua_key(L, explicit);\
+make_lua_key(L, explicit_space);\
+make_lua_key(L, explicitpenalty);\
+make_lua_key(L, expression);\
+make_lua_key(L, extender);\
+make_lua_key(L, extensible);\
+make_lua_key(L, extraspace);\
+make_lua_key(L, extrasubprescriptshift);\
+make_lua_key(L, extrasubprescriptspace);\
+make_lua_key(L, extrasubscriptshift);\
+make_lua_key(L, extrasubscriptspace);\
+make_lua_key(L, extrasuperprescriptshift);\
+make_lua_key(L, extrasuperprescriptspace);\
+make_lua_key(L, extrasuperscriptshift);\
+make_lua_key(L, extrasuperscriptspace);\
+make_lua_key(L, fam);\
+make_lua_key(L, feedbackcompound);\
+make_lua_key(L, fence);\
+make_lua_key(L, fenced);\
+make_lua_key(L, fi);\
+make_lua_key(L, fil);\
+make_lua_key(L, file);\
+make_lua_key(L, fill);\
+make_lua_key(L, filll);\
+make_lua_key(L, finalhyphendemerits);\
+make_lua_key(L, finalpenalty);\
+make_lua_key(L, finishrow);\
+make_lua_key(L, first);\
+make_lua_key(L, fixedboth);\
+make_lua_key(L, fixedbottom);\
+make_lua_key(L, fixedtop);\
+make_lua_key(L, flags);\
+make_lua_key(L, FlattenedAccentBaseHeight);\
+make_lua_key(L, flattenedaccentbaseheight);\
+make_lua_key(L, FlattenedAccentBaseDepth);\
+make_lua_key(L, flattenedaccentbasedepth);\
+make_lua_key(L, flataccent);\
+make_lua_key(L, float);\
+make_lua_key(L, followedbyspace);\
+make_lua_key(L, font);\
+make_lua_key(L, fontkern);\
+make_lua_key(L, fontspec);\
+make_lua_key(L, force);\
+make_lua_key(L, forcecheck);\
+make_lua_key(L, forcehandler);\
+make_lua_key(L, forcerulethickness);\
+make_lua_key(L, fracbinspacing);\
+make_lua_key(L, fracclosespacing);\
+make_lua_key(L, fracfracspacing);\
+make_lua_key(L, fracinnerspacing);\
+make_lua_key(L, fracmiddlespacing);\
+make_lua_key(L, fracopenspacing);\
+make_lua_key(L, fracopspacing);\
+make_lua_key(L, fracordspacing);\
+make_lua_key(L, fracpunctspacing);\
+make_lua_key(L, fracradspacing);\
+make_lua_key(L, fracrelspacing);\
+make_lua_key(L, fraction);\
+make_lua_key(L, FractionDelimiterDisplayStyleSize);\
+make_lua_key(L, FractionDelimiterSize);\
+make_lua_key(L, fractiondelsize);\
+make_lua_key(L, fractiondenomdown);\
+make_lua_key(L, FractionDenominatorDisplayStyleGapMin);\
+make_lua_key(L, FractionDenominatorDisplayStyleShiftDown);\
+make_lua_key(L, FractionDenominatorGapMin);\
+make_lua_key(L, FractionDenominatorShiftDown);\
+make_lua_key(L, fractiondenomvgap);\
+make_lua_key(L, FractionNumeratorDisplayStyleGapMin);\
+make_lua_key(L, FractionNumeratorDisplayStyleShiftUp);\
+make_lua_key(L, FractionNumeratorGapMin);\
+make_lua_key(L, FractionNumeratorShiftUp);\
+make_lua_key(L, fractionnumup);\
+make_lua_key(L, fractionnumvgap);\
+make_lua_key(L, fractionrule);\
+make_lua_key(L, FractionRuleThickness);\
+make_lua_key(L, fractionvariant);\
+make_lua_key(L, frozen);\
+make_lua_key(L, function);\
+make_lua_key(L, geometry);\
+make_lua_key(L, get_mark);\
+make_lua_key(L, ghost);\
+make_lua_key(L, gleaders);\
+make_lua_key(L, global);\
+make_lua_key(L, glue);\
+make_lua_key(L, glueorder);\
+make_lua_key(L, glueset);\
+make_lua_key(L, gluesign);\
+make_lua_key(L, gluespec);\
+make_lua_key(L, glyph);\
+make_lua_key(L, group);\
+make_lua_key(L, h);\
+make_lua_key(L, halign);\
+make_lua_key(L, hangafter);\
+make_lua_key(L, hangindent);\
+make_lua_key(L, hbox);\
+make_lua_key(L, hdelimiter);\
+make_lua_key(L, head);\
+make_lua_key(L, height);\
+make_lua_key(L, hextensible);\
+make_lua_key(L, hextensiblevariant);\
+make_lua_key(L, hlist);\
+make_lua_key(L, hmodepar);\
+make_lua_key(L, hmove);\
+make_lua_key(L, hoffset);\
+make_lua_key(L, holdhead);\
+make_lua_key(L, horizontal);\
+make_lua_key(L, horizontalmathkern);\
+make_lua_key(L, hrule);\
+make_lua_key(L, hsize);\
+make_lua_key(L, hskip);\
+make_lua_key(L, hparts);\
+make_lua_key(L, hyphenate);\
+make_lua_key(L, hyphenated);\
+make_lua_key(L, hyphenation);\
+make_lua_key(L, hyphenationmode);\
+make_lua_key(L, hyphenchar);\
+make_lua_key(L, id);\
+make_lua_key(L, ifstack);\
+make_lua_key(L, if_test);\
+make_lua_key(L, ignore);\
+make_lua_key(L, ignore_something);\
+make_lua_key(L, ignorebounds);\
+make_lua_key(L, ignored);\
+make_lua_key(L, image);\
+make_lua_key(L, immediate);\
+make_lua_key(L, immutable);\
+make_lua_key(L, indent);\
+make_lua_key(L, indentskip);\
+make_lua_key(L, index);\
+make_lua_key(L, Info);\
+make_lua_key(L, info);\
+make_lua_key(L, inner);\
+make_lua_key(L, innerbinspacing);\
+make_lua_key(L, innerclosespacing);\
+make_lua_key(L, innerfracspacing);\
+make_lua_key(L, innerinnerspacing);\
+make_lua_key(L, innermiddlespacing);\
+make_lua_key(L, inneropenspacing);\
+make_lua_key(L, inneropspacing);\
+make_lua_key(L, innerordspacing);\
+make_lua_key(L, innerpunctspacing);\
+make_lua_key(L, innerradspacing);\
+make_lua_key(L, innerrelspacing);\
+make_lua_key(L, input);\
+make_lua_key(L, insert);\
+make_lua_key(L, insertheights);\
+make_lua_key(L, insertpenalties);\
+make_lua_key(L, instance);\
+make_lua_key(L, integer);\
+make_lua_key(L, interlinepenalties);\
+make_lua_key(L, interlinepenalty);\
+make_lua_key(L, intermathskip);\
+make_lua_key(L, internal_attribute);\
+make_lua_key(L, internal_attribute_reference);\
+make_lua_key(L, internal_box_reference);\
+make_lua_key(L, internal_dimen);\
+make_lua_key(L, internal_dimen_reference);\
+make_lua_key(L, internal_glue);\
+make_lua_key(L, internal_glue_reference);\
+make_lua_key(L, internal_int);\
+make_lua_key(L, internal_int_reference);\
+make_lua_key(L, internal_mu_glue);\
+make_lua_key(L, internal_mu_glue_reference);\
+make_lua_key(L, internal_toks);\
+make_lua_key(L, internal_toks_reference);\
+make_lua_key(L, internaldimension);\
+make_lua_key(L, internalinteger);\
+make_lua_key(L, internalgluespec);\
+make_lua_key(L, internalmugluespec);\
+make_lua_key(L, invalid_char);\
+make_lua_key(L, italic);\
+make_lua_key(L, italic_correction);\
+make_lua_key(L, italiccorrection);\
+make_lua_key(L, iterator_value);\
+make_lua_key(L, kern);\
+make_lua_key(L, kerns);\
+make_lua_key(L, noadstate);\
+make_lua_key(L, language);\
+make_lua_key(L, largechar);\
+make_lua_key(L, largefamily);\
+make_lua_key(L, last);\
+make_lua_key(L, lastinsert);\
+make_lua_key(L, lastlinefit);\
+make_lua_key(L, lazyligatures);\
+make_lua_key(L, leader);\
+make_lua_key(L, leaders);\
+make_lua_key(L, leastpagecost);\
+make_lua_key(L, left);\
+make_lua_key(L, left_brace);\
+make_lua_key(L, leftboundary);\
+make_lua_key(L, leftbox);\
+make_lua_key(L, leftboxwidth);\
+make_lua_key(L, lefthangskip);\
+make_lua_key(L, leftmargin);\
+make_lua_key(L, leftmarginkern);\
+make_lua_key(L, leftprotrusion);\
+make_lua_key(L, leftskip);\
+make_lua_key(L, lefttoright);\
+make_lua_key(L, legacy);\
+make_lua_key(L, let);\
+make_lua_key(L, letter);\
+make_lua_key(L, level);\
+make_lua_key(L, lhmin);\
+make_lua_key(L, ligature);\
+make_lua_key(L, ligatures);\
+make_lua_key(L, limitabovebgap);\
+make_lua_key(L, limitabovekern);\
+make_lua_key(L, limitabovevgap);\
+make_lua_key(L, limitbelowbgap);\
+make_lua_key(L, limitbelowkern);\
+make_lua_key(L, limitbelowvgap);\
+make_lua_key(L, limits);\
+make_lua_key(L, line);\
+make_lua_key(L, linebreakpenalty);\
+make_lua_key(L, linepenalty);\
+make_lua_key(L, lineskip);\
+make_lua_key(L, lineskiplimit);\
+make_lua_key(L, list);\
+make_lua_key(L, local);\
+make_lua_key(L, local_box);\
+make_lua_key(L, localbox);\
+make_lua_key(L, log);\
+make_lua_key(L, logfile);\
+make_lua_key(L, looseness);\
+make_lua_key(L, LowerLimitBaselineDropMin);\
+make_lua_key(L, LowerLimitGapMin);\
+make_lua_key(L, lua);\
+make_lua_key(L, lua_call);\
+make_lua_key(L, lua_function_call);\
+make_lua_key(L, lua_local_call);\
+make_lua_key(L, lua_protected_call);\
+make_lua_key(L, lua_value);\
+make_lua_key(L, luatex);\
+make_lua_key(L, macro);\
+make_lua_key(L, make_box);\
+make_lua_key(L, mark);\
+make_lua_key(L, match);\
+make_lua_key(L, math);\
+make_lua_key(L, mathspec);\
+make_lua_key(L, math_accent);\
+make_lua_key(L, math_char_given);\
+make_lua_key(L, math_char_number);\
+make_lua_key(L, math_char_xgiven);\
+make_lua_key(L, math_choice);\
+make_lua_key(L, math_component);\
+make_lua_key(L, math_fence);\
+make_lua_key(L, math_fraction);\
+make_lua_key(L, math_modifier);\
+make_lua_key(L, math_radical);\
+make_lua_key(L, math_script);\
+make_lua_key(L, math_shift);\
+make_lua_key(L, math_shift_cs);\
+make_lua_key(L, math_style);\
+make_lua_key(L, mathtextchar);\
+make_lua_key(L, mathchar);\
+make_lua_key(L, mathchoice);\
+make_lua_key(L, MathConstants);\
+make_lua_key(L, mathcontrol);\
+make_lua_key(L, mathdir);\
+make_lua_key(L, mathfence);\
+make_lua_key(L, mathfraction);\
+make_lua_key(L, mathkerns);\
+make_lua_key(L, MathLeading);\
+make_lua_key(L, mathoperator);\
+make_lua_key(L, mathpack);\
+make_lua_key(L, mathpostpenalty);\
+make_lua_key(L, mathprepenalty);\
+make_lua_key(L, mathshapekern);\
+make_lua_key(L, mathshift);\
+make_lua_key(L, mathsimple);\
+make_lua_key(L, mathskip);\
+make_lua_key(L, mathstyle);\
+make_lua_key(L, medmuskip);\
+make_lua_key(L, message);\
+make_lua_key(L, middle);\
+make_lua_key(L, middlebinspacing);\
+make_lua_key(L, middlebox);\
+make_lua_key(L, middleclosespacing);\
+make_lua_key(L, middlefracspacing);\
+make_lua_key(L, middleinnerspacing);\
+make_lua_key(L, middlemiddlespacing);\
+make_lua_key(L, middleopenspacing);\
+make_lua_key(L, middleopspacing);\
+make_lua_key(L, middleordspacing);\
+make_lua_key(L, middlepunctspacing);\
+make_lua_key(L, middleradspacing);\
+make_lua_key(L, middlerelspacing);\
+make_lua_key(L, MinConnectorOverlap);\
+make_lua_key(L, mkern);\
+make_lua_key(L, mode);\
+make_lua_key(L, modeline);\
+make_lua_key(L, modifier);\
+make_lua_key(L, move_tolerance);\
+make_lua_key(L, mrule);\
+make_lua_key(L, mskip);\
+make_lua_key(L, muglue);\
+make_lua_key(L, mugluespec);\
+make_lua_key(L, mutable);\
+make_lua_key(L, name);\
+make_lua_key(L, nestedlist);\
+make_lua_key(L, new);\
+make_lua_key(L, next);\
+make_lua_key(L, nil);\
+make_lua_key(L, no);\
+make_lua_key(L, no_expand);\
+make_lua_key(L, noad);\
+make_lua_key(L, noalign);\
+make_lua_key(L, noaligned);\
+make_lua_key(L, noaxis);\
+make_lua_key(L, nocheck);\
+make_lua_key(L, nooverflow);\
+make_lua_key(L, node);\
+make_lua_key(L, nodelist);\
+make_lua_key(L, noindent);\
+make_lua_key(L, nolimits);\
+make_lua_key(L, nolimitsubfactor);\
+make_lua_key(L, NoLimitSubFactor);\
+make_lua_key(L, nolimitsupfactor);\
+make_lua_key(L, NoLimitSupFactor);\
+make_lua_key(L, nomath);\
+make_lua_key(L, none);\
+make_lua_key(L, normal);\
+make_lua_key(L, norule);\
+make_lua_key(L, noruling);\
+make_lua_key(L, noscript);\
+make_lua_key(L, nosubprescript);\
+make_lua_key(L, nosubscript);\
+make_lua_key(L, nosuperprescript);\
+make_lua_key(L, nosuperscript);\
+make_lua_key(L, nucleus);\
+make_lua_key(L, number);\
+make_lua_key(L, numerator);\
+make_lua_key(L, numeratorvariant);\
+make_lua_key(L, oldmath);\
+make_lua_key(L, op);\
+make_lua_key(L, opbinspacing);\
+make_lua_key(L, opclosespacing);\
+make_lua_key(L, open);\
+make_lua_key(L, openbinspacing);\
+make_lua_key(L, openclosespacing);\
+make_lua_key(L, openfracspacing);\
+make_lua_key(L, openinnerspacing);\
+make_lua_key(L, openmiddlespacing);\
+make_lua_key(L, openopenspacing);\
+make_lua_key(L, openopspacing);\
+make_lua_key(L, openordspacing);\
+make_lua_key(L, openpunctspacing);\
+make_lua_key(L, openradspacing);\
+make_lua_key(L, openrelspacing);\
+make_lua_key(L, openupdepth);\
+make_lua_key(L, openupheight);\
+make_lua_key(L, operator);\
+make_lua_key(L, operatorsize);\
+make_lua_key(L, opfracspacing);\
+make_lua_key(L, opinnerspacing);\
+make_lua_key(L, opmiddlespacing);\
+make_lua_key(L, opopenspacing);\
+make_lua_key(L, opopspacing);\
+make_lua_key(L, opordspacing);\
+make_lua_key(L, oppunctspacing);\
+make_lua_key(L, opradspacing);\
+make_lua_key(L, oprelspacing);\
+make_lua_key(L, options);\
+make_lua_key(L, ord);\
+make_lua_key(L, ordbinspacing);\
+make_lua_key(L, ordclosespacing);\
+make_lua_key(L, ordfracspacing);\
+make_lua_key(L, ordinnerspacing);\
+make_lua_key(L, ordmiddlespacing);\
+make_lua_key(L, ordopenspacing);\
+make_lua_key(L, ordopspacing);\
+make_lua_key(L, ordordspacing);\
+make_lua_key(L, ordpunctspacing);\
+make_lua_key(L, ordradspacing);\
+make_lua_key(L, ordrelspacing);\
+make_lua_key(L, orientation);\
+make_lua_key(L, original);\
+make_lua_key(L, orphanpenalties);\
+make_lua_key(L, orphanpenalty);\
+make_lua_key(L, other_char);\
+make_lua_key(L, outline);\
+make_lua_key(L, output);\
+make_lua_key(L, over);\
+make_lua_key(L, OverbarExtraAscender);\
+make_lua_key(L, overbarkern);\
+make_lua_key(L, overbarrule);\
+make_lua_key(L, OverbarRuleThickness);\
+make_lua_key(L, OverbarVerticalGap);\
+make_lua_key(L, overbarvgap);\
+make_lua_key(L, overdelimiter);\
+make_lua_key(L, overdelimiterbgap);\
+make_lua_key(L, overdelimitervariant);\
+make_lua_key(L, overdelimitervgap);\
+make_lua_key(L, overlayaccent);\
+make_lua_key(L, overlayaccentvariant);\
+make_lua_key(L, overlinevariant);\
+make_lua_key(L, overloaded);\
+make_lua_key(L, page);\
+make_lua_key(L, package);\
+make_lua_key(L, pagediscardshead);\
+make_lua_key(L, pagehead);\
+make_lua_key(L, pageinserthead);\
+make_lua_key(L, Pages);\
+make_lua_key(L, pages);\
+make_lua_key(L, par);\
+make_lua_key(L, parameter);\
+make_lua_key(L, parameter_reference);\
+make_lua_key(L, parameters);\
+make_lua_key(L, parfillleftskip);\
+make_lua_key(L, parfillrightskip);\
+make_lua_key(L, parinitleftskip);\
+make_lua_key(L, parinitrightskip);\
+make_lua_key(L, parfillskip);\
+make_lua_key(L, parindent);\
+make_lua_key(L, parshape);\
+make_lua_key(L, parskip);\
+make_lua_key(L, passive);\
+make_lua_key(L, pdfe);\
+make_lua_key(L, penalty);\
+make_lua_key(L, permanent);\
+make_lua_key(L, permitall);\
+make_lua_key(L, permitglue);\
+make_lua_key(L, permitmathreplace);\
+make_lua_key(L, phantom);\
+make_lua_key(L, post);\
+make_lua_key(L, post_linebreak);\
+make_lua_key(L, postadjust);\
+make_lua_key(L, postadjusthead);\
+make_lua_key(L, postmigrate);\
+make_lua_key(L, postmigratehead);\
+make_lua_key(L, pre);\
+make_lua_key(L, pre_align);\
+make_lua_key(L, preadjust);\
+make_lua_key(L, preadjusthead);\
+make_lua_key(L, preamble);\
+make_lua_key(L, prebox);\
+make_lua_key(L, preferfontthickness);\
+make_lua_key(L, prefix);\
+make_lua_key(L, premigrate);\
+make_lua_key(L, premigratehead);\
+make_lua_key(L, prepost);\
+make_lua_key(L, preroll);\
+make_lua_key(L, presub);\
+make_lua_key(L, presubscriptshiftdistance);\
+make_lua_key(L, presup);\
+make_lua_key(L, presuperscriptshiftdistance);\
+make_lua_key(L, pretolerance);\
+make_lua_key(L, prev);\
+make_lua_key(L, prevdepth);\
+make_lua_key(L, prevgraf);\
+make_lua_key(L, prime);\
+make_lua_key(L, PrimeBaselineDropMax);\
+make_lua_key(L, primeraise);\
+make_lua_key(L, PrimeRaisePercent);\
+make_lua_key(L, primeraisecomposed);\
+make_lua_key(L, PrimeRaiseComposedPercent);\
+make_lua_key(L, primeshiftdrop);\
+make_lua_key(L, PrimeShiftUp);\
+make_lua_key(L, primeshiftup);\
+make_lua_key(L, PrimeShiftUpCramped);\
+make_lua_key(L, primespaceafter);\
+make_lua_key(L, PrimeSpaceAfter);\
+make_lua_key(L, primewidth);\
+make_lua_key(L, PrimeWidthPercent);\
+make_lua_key(L, primevariant);\
+make_lua_key(L, primitive);\
+make_lua_key(L, protected);\
+make_lua_key(L, protected_call);\
+make_lua_key(L, protrudechars);\
+make_lua_key(L, protrusion);\
+make_lua_key(L, properties);\
+make_lua_key(L, ptr);\
+make_lua_key(L, punct);\
+make_lua_key(L, punctbinspacing);\
+make_lua_key(L, punctclosespacing);\
+make_lua_key(L, punctfracspacing);\
+make_lua_key(L, punctinnerspacing);\
+make_lua_key(L, punctmiddlespacing);\
+make_lua_key(L, punctopenspacing);\
+make_lua_key(L, punctopspacing);\
+make_lua_key(L, punctordspacing);\
+make_lua_key(L, punctpunctspacing);\
+make_lua_key(L, punctradspacing);\
+make_lua_key(L, punctrelspacing);\
+make_lua_key(L, quad);\
+make_lua_key(L, radbinspacing);\
+make_lua_key(L, radclosespacing);\
+make_lua_key(L, radfracspacing);\
+make_lua_key(L, radical);\
+make_lua_key(L, radicaldegreeafter);\
+make_lua_key(L, radicaldegreebefore);\
+make_lua_key(L, radicalextensibleafter);\
+make_lua_key(L, radicalextensiblebefore);\
+make_lua_key(L, RadicalKernAfterExtensible);\
+make_lua_key(L, RadicalKernBeforeExtensible);\
+make_lua_key(L, RadicalDegreeBottomRaisePercent);\
+make_lua_key(L, radicaldegreeraise);\
+make_lua_key(L, RadicalDisplayStyleVerticalGap);\
+make_lua_key(L, RadicalExtraAscender);\
+make_lua_key(L, radicalkern);\
+make_lua_key(L, RadicalKernAfterDegree);\
+make_lua_key(L, RadicalKernBeforeDegree);\
+make_lua_key(L, radicalrule);\
+make_lua_key(L, RadicalRuleThickness);\
+make_lua_key(L, radicalvariant);\
+make_lua_key(L, RadicalVerticalGap);\
+make_lua_key(L, radicalvgap);\
+make_lua_key(L, radinnerspacing);\
+make_lua_key(L, radmiddlespacing);\
+make_lua_key(L, radopenspacing);\
+make_lua_key(L, radopspacing);\
+make_lua_key(L, radordspacing);\
+make_lua_key(L, radpunctspacing);\
+make_lua_key(L, radradspacing);\
+make_lua_key(L, radrelspacing);\
+make_lua_key(L, reader);\
+make_lua_key(L, register);\
+make_lua_key(L, register_attribute);\
+make_lua_key(L, register_attribute_reference);\
+make_lua_key(L, register_box);\
+make_lua_key(L, register_box_reference);\
+make_lua_key(L, register_dimen);\
+make_lua_key(L, register_dimen_reference);\
+make_lua_key(L, register_glue);\
+make_lua_key(L, register_glue_reference);\
+make_lua_key(L, register_int);\
+make_lua_key(L, register_int_reference);\
+make_lua_key(L, register_mu_glue);\
+make_lua_key(L, register_mu_glue_reference);\
+make_lua_key(L, register_toks);\
+make_lua_key(L, register_toks_reference);\
+make_lua_key(L, registerdimension);\
+make_lua_key(L, registerinteger);\
+make_lua_key(L, registergluespec);\
+make_lua_key(L, registermugluespec);\
+make_lua_key(L, regular);\
+make_lua_key(L, rel);\
+make_lua_key(L, relax);\
+make_lua_key(L, relbinspacing);\
+make_lua_key(L, relclosespacing);\
+make_lua_key(L, relfracspacing);\
+make_lua_key(L, relinnerspacing);\
+make_lua_key(L, relmiddlespacing);\
+make_lua_key(L, relopenspacing);\
+make_lua_key(L, relopspacing);\
+make_lua_key(L, relordspacing);\
+make_lua_key(L, relpunctspacing);\
+make_lua_key(L, relradspacing);\
+make_lua_key(L, relrelspacing);\
+make_lua_key(L, remove_item);\
+make_lua_key(L, repeat);\
+make_lua_key(L, replace);\
+make_lua_key(L, reserved);\
+make_lua_key(L, reset);\
+make_lua_key(L, rhmin);\
+make_lua_key(L, right);\
+make_lua_key(L, right_brace);\
+make_lua_key(L, rightboundary);\
+make_lua_key(L, rightbox);\
+make_lua_key(L, rightboxwidth);\
+make_lua_key(L, righthangskip);\
+make_lua_key(L, rightmargin);\
+make_lua_key(L, rightmarginkern);\
+make_lua_key(L, rightprotrusion);\
+make_lua_key(L, rightskip);\
+make_lua_key(L, righttoleft);\
+make_lua_key(L, root);\
+make_lua_key(L, rooted);\
+make_lua_key(L, rule);\
+make_lua_key(L, rulebasedmathskip);\
+make_lua_key(L, ruledepth);\
+make_lua_key(L, ruleheight);\
+make_lua_key(L, same);\
+make_lua_key(L, saved);\
+make_lua_key(L, scale);\
+make_lua_key(L, script);\
+make_lua_key(L, scriptorder);\
+make_lua_key(L, ScriptPercentScaleDown);\
+make_lua_key(L, scripts);\
+make_lua_key(L, scriptscale);\
+make_lua_key(L, scriptscript);\
+make_lua_key(L, ScriptScriptPercentScaleDown);\
+make_lua_key(L, scriptscriptscale);\
+make_lua_key(L, second);\
+make_lua_key(L, semisimple);\
+make_lua_key(L, set);\
+make_lua_key(L, set_auxiliary);\
+make_lua_key(L, set_box);\
+make_lua_key(L, set_box_property);\
+make_lua_key(L, set_font);\
+make_lua_key(L, set_font_property);\
+make_lua_key(L, set_interaction);\
+make_lua_key(L, set_mark);\
+make_lua_key(L, set_math_parameter);\
+make_lua_key(L, set_page_property);\
+make_lua_key(L, set_specification);\
+make_lua_key(L, shapingpenaltiesmode);\
+make_lua_key(L, shapingpenalty);\
+make_lua_key(L, shift);\
+make_lua_key(L, shiftedsubscript);\
+make_lua_key(L, shiftedsuperscript);\
+make_lua_key(L, shiftedsubprescript);\
+make_lua_key(L, shiftedsuperprescript);\
+make_lua_key(L, shorthand_def);\
+make_lua_key(L, shrink);\
+make_lua_key(L, shrinkorder);\
+make_lua_key(L, simple);\
+make_lua_key(L, size);\
+make_lua_key(L, skewchar);\
+make_lua_key(L, skeweddelimitertolerance);\
+make_lua_key(L, SkewedDelimiterTolerance);\
+make_lua_key(L, skewedfractionhgap);\
+make_lua_key(L, SkewedFractionHorizontalGap);\
+make_lua_key(L, SkewedFractionVerticalGap);\
+make_lua_key(L, skewedfractionvgap);\
+make_lua_key(L, skip);\
+make_lua_key(L, slant);\
+make_lua_key(L, small);\
+make_lua_key(L, smallchar);\
+make_lua_key(L, smaller);\
+make_lua_key(L, smallfamily);\
+make_lua_key(L, some_item);\
+make_lua_key(L, source);\
+make_lua_key(L, space);\
+make_lua_key(L, SpaceAfterScript);\
+make_lua_key(L, spaceafterscript);\
+make_lua_key(L, spacebeforescript);\
+make_lua_key(L, SpaceBeforeScript);\
+make_lua_key(L, spacefactor);\
+make_lua_key(L, spacer);\
+make_lua_key(L, spaceshrink);\
+make_lua_key(L, spaceskip);\
+make_lua_key(L, spacestretch);\
+make_lua_key(L, span);\
+make_lua_key(L, spec);\
+make_lua_key(L, specification);\
+make_lua_key(L, specification_reference);\
+make_lua_key(L, split);\
+make_lua_key(L, split_insert);\
+make_lua_key(L, splitbottom);\
+make_lua_key(L, splitdiscardshead);\
+make_lua_key(L, splitfirst);\
+make_lua_key(L, splitkeep);\
+make_lua_key(L, splitoff);\
+make_lua_key(L, splittopskip);\
+make_lua_key(L, stack);\
+make_lua_key(L, StackBottomDisplayStyleShiftDown);\
+make_lua_key(L, StackBottomShiftDown);\
+make_lua_key(L, stackdenomdown);\
+make_lua_key(L, StackDisplayStyleGapMin);\
+make_lua_key(L, StackGapMin);\
+make_lua_key(L, stacknumup);\
+make_lua_key(L, StackTopDisplayStyleShiftUp);\
+make_lua_key(L, StackTopShiftUp);\
+make_lua_key(L, stackvariant);\
+make_lua_key(L, stackvgap);\
+make_lua_key(L, start);\
+make_lua_key(L, state);\
+make_lua_key(L, step);\
+make_lua_key(L, stretch);\
+make_lua_key(L, stretchorder);\
+make_lua_key(L, StretchStackBottomShiftDown);\
+make_lua_key(L, StretchStackGapAboveMin);\
+make_lua_key(L, StretchStackGapBelowMin);\
+make_lua_key(L, StretchStackTopShiftUp);\
+make_lua_key(L, strictend);\
+make_lua_key(L, strictstart);\
+make_lua_key(L, string);\
+make_lua_key(L, strut);\
+make_lua_key(L, style);\
+make_lua_key(L, sub);\
+make_lua_key(L, subbox);\
+make_lua_key(L, submlist);\
+make_lua_key(L, subpre);\
+make_lua_key(L, subscript);\
+make_lua_key(L, SubscriptBaselineDropMin);\
+make_lua_key(L, subscriptshiftdistance);\
+make_lua_key(L, SubscriptShiftDown);\
+make_lua_key(L, SubscriptShiftDownWithSuperscript);\
+make_lua_key(L, SubscriptTopMax);\
+make_lua_key(L, subscriptvariant);\
+make_lua_key(L, subshiftdown);\
+make_lua_key(L, subshiftdrop);\
+make_lua_key(L, substitute);\
+make_lua_key(L, SubSuperscriptGapMin);\
+make_lua_key(L, subsupshiftdown);\
+make_lua_key(L, subsupvgap);\
+make_lua_key(L, subtopmax);\
+make_lua_key(L, subtype);\
+make_lua_key(L, sup);\
+make_lua_key(L, supbottommin);\
+make_lua_key(L, superscript);\
+make_lua_key(L, SuperscriptBaselineDropMax);\
+make_lua_key(L, SuperscriptBottomMaxWithSubscript);\
+make_lua_key(L, SuperscriptBottomMin);\
+make_lua_key(L, superscriptshiftdistance);\
+make_lua_key(L, SuperscriptShiftUp);\
+make_lua_key(L, SuperscriptShiftUpCramped);\
+make_lua_key(L, superscriptvariant);\
+make_lua_key(L, suppre);\
+make_lua_key(L, supshiftdrop);\
+make_lua_key(L, supshiftup);\
+make_lua_key(L, supsubbottommax);\
+make_lua_key(L, surround);\
+make_lua_key(L, syllable);\
+make_lua_key(L, tabskip);\
+make_lua_key(L, tail);\
+make_lua_key(L, target);\
+make_lua_key(L, temp);\
+make_lua_key(L, temphead);\
+make_lua_key(L, terminal);\
+make_lua_key(L, terminal_and_logfile);\
+make_lua_key(L, tex);\
+make_lua_key(L, tex_nest);\
+make_lua_key(L, text);\
+make_lua_key(L, textcontrol);\
+make_lua_key(L, textscale);\
+make_lua_key(L, the);\
+make_lua_key(L, thickmuskip);\
+make_lua_key(L, thinmuskip);\
+make_lua_key(L, tok);\
+make_lua_key(L, token);\
+make_lua_key(L, tokenlist);\
+make_lua_key(L, tolerance);\
+make_lua_key(L, tolerant);\
+make_lua_key(L, tolerant_call);\
+make_lua_key(L, tolerant_protected_call);\
+make_lua_key(L, top);\
+make_lua_key(L, topaccent);\
+make_lua_key(L, topaccentvariant);\
+make_lua_key(L, topleft);\
+make_lua_key(L, topmargin);\
+make_lua_key(L, topright);\
+make_lua_key(L, topskip);\
+make_lua_key(L, total);\
+make_lua_key(L, tracingparagraphs);\
+make_lua_key(L, trailer);\
+make_lua_key(L, Trailer);\
+make_lua_key(L, type);\
+make_lua_key(L, uchyph);\
+make_lua_key(L, uleaders);\
+make_lua_key(L, un_hbox);\
+make_lua_key(L, un_vbox);\
+make_lua_key(L, undefined_cs);\
+make_lua_key(L, under);\
+make_lua_key(L, UnderbarExtraDescender);\
+make_lua_key(L, underbarkern);\
+make_lua_key(L, underbarrule);\
+make_lua_key(L, UnderbarRuleThickness);\
+make_lua_key(L, UnderbarVerticalGap);\
+make_lua_key(L, underbarvgap);\
+make_lua_key(L, underdelimiter);\
+make_lua_key(L, underdelimiterbgap);\
+make_lua_key(L, underdelimitervariant);\
+make_lua_key(L, underdelimitervgap);\
+make_lua_key(L, underlinevariant);\
+make_lua_key(L, unhbox);\
+make_lua_key(L, unhyphenated);\
+make_lua_key(L, unknown);\
+make_lua_key(L, unpacklist);\
+make_lua_key(L, unrolllist);\
+make_lua_key(L, unset);\
+make_lua_key(L, untraced);\
+make_lua_key(L, unvbox);\
+make_lua_key(L, uppercase);\
+make_lua_key(L, UpperLimitBaselineRiseMin);\
+make_lua_key(L, UpperLimitGapMin);\
+make_lua_key(L, user);\
+make_lua_key(L, userkern);\
+make_lua_key(L, userpenalty);\
+make_lua_key(L, userskip);\
+make_lua_key(L, v);\
+make_lua_key(L, vadjust);\
+make_lua_key(L, valign);\
+make_lua_key(L, value);\
+make_lua_key(L, variable);\
+make_lua_key(L, vbox);\
+make_lua_key(L, vcenter);\
+make_lua_key(L, vdelimiter);\
+make_lua_key(L, vertical);\
+make_lua_key(L, verticalmathkern);\
+make_lua_key(L, vextensible);\
+make_lua_key(L, vextensiblevariant);\
+make_lua_key(L, vitalic);\
+make_lua_key(L, vlist);\
+make_lua_key(L, vmode);\
+make_lua_key(L, vmodepar);\
+make_lua_key(L, vmove);\
+make_lua_key(L, void);\
+make_lua_key(L, vrule);\
+make_lua_key(L, vskip);\
+make_lua_key(L, vtop);\
+make_lua_key(L, vparts);\
+make_lua_key(L, whatsit);\
+make_lua_key(L, widowpenalties);\
+make_lua_key(L, widowpenalty);\
+make_lua_key(L, width);\
+make_lua_key(L, woffset);\
+make_lua_key(L, word);\
+make_lua_key(L, wordpenalty);\
+make_lua_key(L, wrapup);\
+make_lua_key(L, xheight);\
+make_lua_key(L, xleaders);\
+make_lua_key(L, xoffset);\
+make_lua_key(L, xray);\
+make_lua_key(L, xscale);\
+make_lua_key(L, xspaceskip);\
+make_lua_key(L, yoffset);\
+make_lua_key(L, yscale);\
+make_lua_key(L, zerospaceskip);\
+/* */ \
+make_lua_key_alias(L, empty_string, "");\
+/* */ \
+make_lua_key_alias(L, node_instance, NODE_METATABLE_INSTANCE);\
+make_lua_key_alias(L, node_properties, NODE_PROPERTIES_DIRECT);\
+make_lua_key_alias(L, node_properties_indirect, NODE_PROPERTIES_INDIRECT);\
+/* */ \
+make_lua_key_alias(L, token_instance, TOKEN_METATABLE_INSTANCE);\
+make_lua_key_alias(L, token_package, TOKEN_METATABLE_PACKAGE);\
+/* */ \
+make_lua_key_alias(L, sparse_instance, SPARSE_METATABLE_INSTANCE);\
+/* */ \
+make_lua_key_alias(L, pdfe_instance, PDFE_METATABLE_INSTANCE);\
+make_lua_key_alias(L, pdfe_dictionary, PDFE_METATABLE_DICTIONARY);\
+make_lua_key_alias(L, pdfe_array, PDFE_METATABLE_ARRAY);\
+make_lua_key_alias(L, pdfe_stream, PDFE_METATABLE_STREAM);\
+make_lua_key_alias(L, pdfe_reference, PDFE_METATABLE_REFERENCE);\
+/* done */
+
+# define declare_metapost_lua_keys(L) \
+/* */\
+/* (L, close); */\
+make_lua_key(L, color);\
+make_lua_key(L, curl);\
+make_lua_key(L, curled);\
+make_lua_key(L, curved);\
+make_lua_key(L, cycle);\
+make_lua_key(L, dash);\
+make_lua_key(L, dashes);\
+/* (L, depth); */\
+make_lua_key(L, direction_x);\
+make_lua_key(L, direction_y);\
+make_lua_key(L, elliptical);\
+make_lua_key(L, end_cycle);\
+make_lua_key(L, endpoint);\
+make_lua_key(L, error);\
+make_lua_key(L, error_line);\
+/* (L, explicit); */\
+make_lua_key(L, extensions);\
+make_lua_key(L, fig);\
+/* (L, fill); */\
+make_lua_key(L, find_file);\
+/* (L, font); */\
+make_lua_key(L, given);\
+make_lua_key(L, halt_on_error);\
+make_lua_key(L, hash);\
+/* (L, height); */\
+make_lua_key(L, htap);\
+make_lua_key(L, interaction);\
+make_lua_key(L, internals);\
+make_lua_key(L, job_name);\
+make_lua_key(L, knots);\
+make_lua_key(L, left_curl);\
+make_lua_key(L, left_tension);\
+make_lua_key(L, left_type);\
+make_lua_key(L, left_x);\
+make_lua_key(L, left_y);\
+make_lua_key(L, linecap);\
+make_lua_key(L, linejoin);\
+make_lua_key(L, make_text);\
+make_lua_key(L, math_mode);\
+make_lua_key(L, memory);\
+make_lua_key(L, miterlimit);\
+make_lua_key(L, nodes);\
+make_lua_key(L, offset);\
+/* (L, open); */\
+make_lua_key(L, open_file);\
+/* (L, outline); */\
+make_lua_key(L, pairs);\
+make_lua_key(L, path);\
+make_lua_key(L, pen);\
+make_lua_key(L, postscript);\
+make_lua_key(L, prescript);\
+make_lua_key(L, print_line);\
+make_lua_key(L, random_seed);\
+/* (L, reader); */\
+make_lua_key(L, right_curl);\
+make_lua_key(L, right_tension);\
+make_lua_key(L, right_type);\
+make_lua_key(L, right_x);\
+make_lua_key(L, right_y);\
+make_lua_key(L, run_error);\
+make_lua_key(L, run_internal);\
+make_lua_key(L, run_logger);\
+make_lua_key(L, run_overload);\
+make_lua_key(L, run_script);\
+make_lua_key(L, run_warning);\
+make_lua_key(L, rx);\
+make_lua_key(L, ry);\
+make_lua_key(L, show_mode);\
+make_lua_key(L, stacking);\
+make_lua_key(L, start_bounds);\
+make_lua_key(L, start_clip);\
+make_lua_key(L, start_group);\
+make_lua_key(L, status);\
+make_lua_key(L, stop_bounds);\
+make_lua_key(L, stop_clip);\
+make_lua_key(L, stop_group);\
+make_lua_key(L, strings);\
+make_lua_key(L, sx);\
+make_lua_key(L, sy);\
+make_lua_key(L, symbols);\
+/* (L, text); */\
+make_lua_key(L, text_mode);\
+make_lua_key(L, tokens);\
+make_lua_key(L, transform);\
+make_lua_key(L, tx);\
+make_lua_key(L, ty);\
+/* (L, type); */\
+make_lua_key(L, utf8_mode);\
+make_lua_key(L, warning);\
+/* (L, width); */\
+make_lua_key(L, writer);\
+make_lua_key(L, x_coord);\
+make_lua_key(L, y_coord);\
+/* */\
+make_lua_key_alias(L, mplib_instance, MP_METATABLE_INSTANCE);\
+make_lua_key_alias(L, mplib_figure, MP_METATABLE_FIGURE);\
+make_lua_key_alias(L, mplib_object, MP_METATABLE_OBJECT);\
+/* done */
+
+/*tex
+ We want them properly aligned so we put pointers and indices in blocks.
+*/
+
+typedef struct lmt_keys {
+# undef make_lua_key
+# undef make_lua_key_alias
+# define make_lua_key make_lua_key_ptr
+# define make_lua_key_alias make_lua_key_ptr_alias
+declare_shared_lua_keys(NULL)
+declare_metapost_lua_keys(NULL)
+# undef make_lua_key
+# undef make_lua_key_alias
+# define make_lua_key make_lua_key_idx
+# define make_lua_key_alias make_lua_key_idx_alias
+declare_shared_lua_keys(NULL)
+declare_metapost_lua_keys(NULL)
+# undef make_lua_key
+# undef make_lua_key_alias
+} lmt_keys_info ;
+
+extern lmt_keys_info lmt_keys;
+
+# define make_lua_key init_lua_key
+# define make_lua_key_alias init_lua_key_alias
+
+# define lmt_initialize_shared_keys declare_shared_lua_keys
+# define lmt_initialize_metapost_keys declare_metapost_lua_keys
+
+/*tex
+
+ We use round from |math.h| because when in a macro we check for sign we (depending on
+ optimization) can fetch numbers multiple times. I need to measure this a bit more as inlining
+ looks a bit faster on for instance |experiment.tex| but of course the bin becomes (some 10K)
+ larger.
+
+*/
+
+//define lmt_rounded(d) (lua_Integer) (round(d))
+//define lmt_roundedfloat(f) (lua_Integer) (round((double) f))
+
+# define lmt_rounded(d) (lua_Integer) (llround(d))
+# define lmt_roundedfloat(f) (lua_Integer) (llround((double) f))
+
+
+# define lmt_tolong(L,i) (long) lua_tointeger(L,i)
+# define lmt_checklong(L,i) (long) luaL_checkinteger(L,i)
+# define lmt_optlong(L,i,j) (long) luaL_optinteger(L,i,j)
+
+# define lmt_tointeger(L,i) (int) lua_tointeger(L,i)
+# define lmt_checkinteger(L,i) (int) luaL_checkinteger(L,i)
+# define lmt_optinteger(L,i,j) (int) luaL_optinteger(L,i,j)
+
+# define lmt_tosizet(L,i) (size_t) lua_tointeger(L,i)
+# define lmt_checksizet(L,i) (size_t) luaL_checkinteger(L,i)
+# define lmt_optsizet(L,i,j) (size_t) luaL_optinteger(L,i,j)
+
+# define lmt_tohalfword(L,i) (halfword) lua_tointeger(L,i)
+# define lmt_checkhalfword(L,i) (halfword) luaL_checkinteger(L,i)
+# define lmt_opthalfword(L,i,j) (halfword) luaL_optinteger(L,i,j)
+
+# define lmt_toscaled(L,i) (scaled) lua_tointeger(L,i)
+# define lmt_checkscaled(L,i) (scaled) luaL_checkinteger(L,i)
+# define lmt_optscaled(L,i,j) (scaled) luaL_optinteger(L,i,j)
+
+# define lmt_toquarterword(L,i) (quarterword) lua_tointeger(L,i)
+# define lmt_checkquarterword(L,i) (quarterword) luaL_checkinteger(L,i)
+# define lmt_optquarterword(L,i,j) (quarterword) luaL_optinteger(L,i,j)
+
+# define lmt_tosingleword(L,i) (singleword) lua_tointeger(L,i)
+# define lmt_checksingleword(L,i) (singleword) luaL_checkinteger(L,i)
+# define lmt_optsingleword(L,i,j) (singleword) luaL_optinteger(L,i,j)
+
+# undef lround
+# include <math.h>
+
+inline static int lmt_roundnumber(lua_State *L, int i)
+{
+ double n = lua_tonumber(L, i);
+ return n == 0.0 ? 0 : lround(n);
+}
+
+inline static int lmt_optroundnumber(lua_State *L, int i, int dflt)
+{
+ double n = luaL_optnumber(L, i, dflt);
+ return n == 0.0 ? 0 : lround(n);
+}
+
+inline static unsigned int lmt_uroundnumber(lua_State *L, int i)
+{
+ double n = lua_tonumber(L, i);
+ return n == 0.0 ? 0 : (unsigned int) lround(n);
+}
+
+inline static double lmt_number_from_table(lua_State *L, int i, int j, lua_Number d)
+{
+ double n;
+ lua_rawgeti(L, i, j);
+ n = luaL_optnumber(L, -1, d);
+ lua_pop(L, 1);
+ return n;
+}
+
+extern void lmt_initialize_interface(void);
+
+# define lmt_toroundnumber lmt_roundnumber
+# define lmt_touroundnumber lmt_uroundnumber
+
+/*
+# define lua_set_string_by_key(L,a,b) \
+ lua_pushstring(L, b ? b : ""); \
+ lua_setfield(L, -2, a);
+
+# define lua_set_string_by_index(L,a,b) \
+ lua_pushstring(L, b ? b : ""); \
+ lua_rawseti(L, -2, a);
+
+# define lua_set_integer_by_key(L,a,b) \
+ lua_pushinteger(L, b); \
+ lua_setfield(L, -2, a);
+
+# define lua_set_integer_by_index(L,a,b) \
+ lua_pushinteger(L, b); \
+ lua_rawseti(L, -2, a);
+
+# define lua_set_boolean_by_key(L,a,b) \
+ lua_pushboolean(L, b); \
+ lua_setfield(L, -2, a);
+
+# define lua_set_boolean_by_index(L,a,b) \
+ lua_pushboolean(L, b); \
+ lua_rawseti(L, -2, a);
+*/
+
+inline static void lua_set_string_by_key(lua_State *L, const char *a, const char *b)
+{
+ lua_pushstring(L, b ? b : "");
+ lua_setfield(L, -2, a);
+}
+
+inline static void lua_set_string_by_index(lua_State *L, int a, const char *b)
+{
+ lua_pushstring(L, b ? b : "");
+ lua_rawseti(L, -2, a);
+}
+
+inline static void lua_set_integer_by_key(lua_State *L, const char *a, int b)
+{
+ lua_pushinteger(L, b);
+ lua_setfield(L, -2, a);
+}
+
+inline static void lua_set_integer_by_index(lua_State *L, int a, int b)
+{
+ lua_pushinteger(L, b);
+ lua_rawseti(L, -2, a);
+}
+
+inline static void lua_set_cardinal_by_key(lua_State *L, const char *a, unsigned b)
+{
+ lua_pushinteger(L, b);
+ lua_setfield(L, -2, a);
+}
+
+inline static void lua_set_cardinal_by_index(lua_State *L, int a, unsigned b)
+{
+ lua_pushinteger(L, b);
+ lua_rawseti(L, -2, a);
+}
+
+inline static void lua_set_boolean_by_key(lua_State *L, const char *a, int b)
+{
+ lua_pushboolean(L, b);
+ lua_setfield(L, -2, a);
+}
+
+inline static void lua_set_boolean_by_index(lua_State *L, int a, int b)
+{
+ lua_pushboolean(L, b);
+ lua_rawseti(L, -2, a);
+}
+
+inline void lmt_string_to_buffer(const char *str)
+{
+ luaL_addstring(lmt_lua_state.used_buffer, str);
+}
+
+inline void lmt_char_to_buffer(char c)
+{
+ luaL_addchar(lmt_lua_state.used_buffer, c);
+}
+
+inline void lmt_newline_to_buffer(void)
+{
+ luaL_addchar(lmt_lua_state.used_buffer, '\n');
+}
+
+# endif
diff --git a/source/luametatex/source/lua/lmtlanguagelib.c b/source/luametatex/source/lua/lmtlanguagelib.c
new file mode 100644
index 000000000..55646e3ef
--- /dev/null
+++ b/source/luametatex/source/lua/lmtlanguagelib.c
@@ -0,0 +1,439 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This is the interface to everything that relates to hyphenation in the frontend: defining
+ a new language, setting properties for hyphenation, loading patterns and exceptions.
+
+*/
+
+# include "luametatex.h"
+
+# define LANGUAGE_METATABLE "luatex.language"
+# define LANGUAGE_FUNCTIONS "luatex.language.wordhandlers"
+
+/* todo: get rid of top */
+
+typedef struct languagelib_language {
+ tex_language *lang;
+} languagelib_language;
+
+static int languagelib_new(lua_State *L)
+{
+ languagelib_language *ulang = lua_newuserdatauv(L, sizeof(tex_language *), 0);
+ if (lua_type(L, 1) == LUA_TNUMBER) {
+ halfword lualang = lmt_tohalfword(L, 1);
+ ulang->lang = tex_get_language(lualang);
+ if (! ulang->lang) {
+ return luaL_error(L, "undefined language %d", lualang);
+ }
+ } else {
+ ulang->lang = tex_new_language(-1);
+ if (! ulang->lang) {
+ return luaL_error(L, "no room for a new language");
+ }
+ }
+ luaL_getmetatable(L, LANGUAGE_METATABLE);
+ lua_setmetatable(L, -2);
+ return 1;
+}
+
+static tex_language *languagelib_object(lua_State* L)
+{
+ tex_language *lang = NULL;
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ lang = tex_get_language(lmt_tohalfword(L, 1));
+ break;
+ case LUA_TUSERDATA:
+ {
+ languagelib_language *ulang = lua_touserdata(L, 1);
+ if (ulang && lua_getmetatable(L, 1)) {
+ luaL_getmetatable(L, LANGUAGE_METATABLE);
+ if (lua_rawequal(L, -1, -2)) {
+ lang = ulang->lang;
+ }
+ lua_pop(L, 2);
+ }
+ break;
+ }
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 1)) {
+ lang = tex_get_language(language_par);
+ }
+ break;
+ }
+ if (! lang) {
+ luaL_error(L, "argument should be a valid language id, language object, or true");
+ }
+ return lang;
+}
+
+static int languagelib_id(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ lua_pushinteger(L, lang->id);
+ return 1;
+}
+
+static int languagelib_patterns(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ if (lang->patterns) {
+ lua_pushstring(L, (char *) hnj_dictionary_tostring(lang->patterns));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TSTRING) {
+ tex_load_patterns(lang, (const unsigned char *) lua_tostring(L, 2));
+ return 0;
+ } else {
+ return luaL_error(L, "argument should be a string");
+ }
+}
+
+static int languagelib_clear_patterns(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ tex_clear_patterns(lang);
+ return 0;
+}
+
+static int languagelib_hyphenation(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ if (lang->exceptions) {
+ luaL_Buffer b;
+ int done = 0;
+ luaL_buffinit(L, &b);
+ if (lua_rawgeti(L, LUA_REGISTRYINDEX, lang->exceptions) == LUA_TTABLE) {
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ if (done) {
+ luaL_addlstring(&b, " ", 1);
+ } else {
+ done = 1;
+ }
+ luaL_addvalue(&b);
+ }
+ }
+ luaL_pushresult(&b);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TSTRING) {
+ tex_load_hyphenation(lang, (const unsigned char *) lua_tostring(L, 2));
+ return 0;
+ } else {
+ return luaL_error(L, "argument should be a string");
+ }
+}
+
+static int languagelib_pre_hyphen_char(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ lua_pushinteger(L, lang->pre_hyphen_char);
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TNUMBER) {
+ lang->pre_hyphen_char = lmt_tohalfword(L, 2);
+ } else {
+ return luaL_error(L, "argument should be a character number");
+ }
+ return 0;
+}
+
+static int languagelib_post_hyphen_char(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ lua_pushinteger(L, lang->post_hyphen_char);
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TNUMBER) {
+ lang->post_hyphen_char = lmt_tohalfword(L, 2);
+ } else {
+ return luaL_error(L, "argument should be a character number");
+ }
+ return 0;
+}
+
+static int languagelib_pre_exhyphen_char(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ lua_pushinteger(L, lang->pre_exhyphen_char);
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TNUMBER) {
+ lang->pre_exhyphen_char = lmt_tohalfword(L, 2);
+ return 0;
+ } else {
+ return luaL_error(L, "argument should be a character number");
+ }
+}
+
+/* We push nuts! */
+
+int lmt_handle_word(tex_language *lang, const char *original, const char *word, int length, halfword first, halfword last, char **replacement)
+{
+ if (lang->wordhandler && word && first && last) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int stacktop = lua_gettop(L);
+ int result = 0;
+ int res;
+ *replacement = NULL;
+ lua_pushcfunction(L, lmt_traceback); /* goes before function */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_language_state.handler_table_id);
+ lua_rawgeti(L, -1, lang->id);
+ lua_pushinteger(L, lang->id);
+ lua_pushstring(L, original);
+ lua_pushstring(L, word);
+ lua_pushinteger(L, length);
+ lua_pushinteger(L, first);
+ lua_pushinteger(L, last);
+ res = lua_pcall(L, 6, 1, 0);
+ if (res) {
+ lua_remove(L, stacktop + 1);
+ lmt_error(L, "function call", -1, res == LUA_ERRRUN ? 0 : 1);
+ }
+ ++lmt_language_state.handler_count;
+ switch (lua_type(L, -1)) {
+ case LUA_TSTRING:
+ *replacement = (char *) lmt_memory_strdup(lua_tostring(L, -1));
+ break;
+ case LUA_TNUMBER:
+ result = lmt_tointeger(L, -1);
+ break;
+ default:
+ break;
+ }
+ lua_settop(L, stacktop);
+ return result;
+ }
+ return 0;
+}
+
+void lmt_initialize_languages(void)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ lua_newtable(L);
+ lmt_language_state.handler_table_id = luaL_ref(L, LUA_REGISTRYINDEX);
+ lua_pushstring(L, LANGUAGE_FUNCTIONS);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_language_state.handler_table_id);
+ lua_settable(L, LUA_REGISTRYINDEX);
+}
+
+static int languagelib_setwordhandler(lua_State* L)
+{
+ tex_language *lang = languagelib_object(L);
+ switch (lua_type(L, 2)) {
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 2)) {
+ goto DEFAULT;
+ } else {
+ // fall-through
+ }
+ case LUA_TNIL:
+ {
+ if (lang->wordhandler) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_language_state.handler_table_id);
+ lua_pushnil(L);
+ lua_rawseti(L, -2, lang->id);
+ lang->wordhandler = 0;
+ }
+ break;
+ }
+ case LUA_TFUNCTION:
+ {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_language_state.handler_table_id);
+ lua_pushvalue(L, 2);
+ lua_rawseti(L, -2, lang->id);
+ lang->wordhandler = 1;
+ break;
+ }
+ default:
+ DEFAULT:
+ return luaL_error(L, "argument should be a function, false or nil");
+ }
+ return 0;
+}
+
+static int languagelib_sethjcode(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ halfword i = lmt_tohalfword(L, 2) ;
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ tex_set_hj_code(lang->id, i, lmt_tohalfword(L, 3), -1);
+ } else {
+ tex_set_hj_code(lang->id, i, i, -1);
+ }
+ return 0;
+ } else {
+ return luaL_error(L, "argument should be a character number");
+ }
+}
+
+static int languagelib_gethjcode(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ lua_pushinteger(L, tex_get_hj_code(lang->id, lmt_tohalfword(L, 2)));
+ return 1;
+ } else {
+ return luaL_error(L, "argument should be a character number");
+ }
+}
+
+static int languagelib_post_exhyphen_char(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ lua_pushinteger(L, lang->post_exhyphen_char);
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TNUMBER) {
+ lang->post_exhyphen_char = lmt_tohalfword(L, 2);
+ return 0;
+ } else {
+ return luaL_error(L, "argument should be a character number");
+ }
+}
+
+static int languagelib_hyphenation_min(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ if (lua_gettop(L) == 1) {
+ lua_pushinteger(L, lang->hyphenation_min);
+ return 1;
+ } else if (lua_type(L, 2) == LUA_TNUMBER) {
+ lang->hyphenation_min = lmt_tohalfword(L, 2);
+ return 0;
+ } else {
+ return luaL_error(L, "argument should be a number");
+ }
+}
+
+static int languagelib_clear_hyphenation(lua_State *L)
+{
+ tex_language *lang = languagelib_object(L);
+ tex_clear_hyphenation(lang);
+ return 0;
+}
+
+static int languagelib_clean(lua_State *L)
+{
+ char *cleaned = NULL;
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ tex_clean_hyphenation(cur_lang_par, lua_tostring(L, 1), &cleaned);
+ } else {
+ tex_language *lang = languagelib_object(L);
+ if (lang) {
+ if (lua_type(L, 2) == LUA_TSTRING) {
+ tex_clean_hyphenation(lang->id, lua_tostring(L, 2), &cleaned);
+ } else {
+ return luaL_error(L, "second argument should be a string");
+ }
+ } else {
+ return luaL_error(L, "first argument should be a string or language");
+ }
+ }
+ lua_pushstring(L, cleaned);
+ lmt_memory_free(cleaned);
+ return 1;
+}
+
+static int languagelib_hyphenate(lua_State *L)
+{
+ halfword h = lmt_check_isnode(L, 1);
+ halfword t = null;
+ if (lua_isuserdata(L, 2)) {
+ t = lmt_check_isnode(L, 2);
+ }
+ if (! t) {
+ t = h;
+ while (node_next(t)) {
+ t = node_next(t);
+ }
+ }
+ tex_hyphenate_list(h, t);
+ lmt_push_node_fast(L, h);
+ lmt_push_node_fast(L, t);
+ lua_pushboolean(L, 1);
+ return 3;
+}
+
+static int languagelib_current(lua_State *L)
+{
+ lua_pushinteger(L, language_par);
+ return 1;
+}
+
+static int languagelib_has_language(lua_State *L)
+{
+ halfword h = lmt_check_isnode(L, 1);
+ while (h) {
+ if (node_type(h) == glyph_node && get_glyph_language(h) > 0) {
+ lua_pushboolean(L, 1);
+ return 1;
+ } else {
+ h = node_next(h);
+ }
+ }
+ lua_pushboolean(L,0);
+ return 1;
+}
+
+static const struct luaL_Reg langlib_metatable[] = {
+ { "clearpatterns", languagelib_clear_patterns },
+ { "clearhyphenation", languagelib_clear_hyphenation },
+ { "patterns", languagelib_patterns },
+ { "hyphenation", languagelib_hyphenation },
+ { "prehyphenchar", languagelib_pre_hyphen_char },
+ { "posthyphenchar", languagelib_post_hyphen_char },
+ { "preexhyphenchar", languagelib_pre_exhyphen_char },
+ { "postexhyphenchar", languagelib_post_exhyphen_char },
+ { "hyphenationmin", languagelib_hyphenation_min },
+ { "sethjcode", languagelib_sethjcode },
+ { "gethjcode", languagelib_gethjcode },
+ { "setwordhandler", languagelib_setwordhandler },
+ { "id", languagelib_id },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg langlib_function_list[] = {
+ { "clearpatterns", languagelib_clear_patterns },
+ { "clearhyphenation", languagelib_clear_hyphenation },
+ { "patterns", languagelib_patterns },
+ { "hyphenation", languagelib_hyphenation },
+ { "prehyphenchar", languagelib_pre_hyphen_char },
+ { "posthyphenchar", languagelib_post_hyphen_char },
+ { "preexhyphenchar", languagelib_pre_exhyphen_char },
+ { "postexhyphenchar", languagelib_post_exhyphen_char },
+ { "hyphenationmin", languagelib_hyphenation_min },
+ { "sethjcode", languagelib_sethjcode },
+ { "gethjcode", languagelib_gethjcode },
+ { "setwordhandler", languagelib_setwordhandler },
+ { "id", languagelib_id },
+ { "clean", languagelib_clean }, /* maybe obsolete */
+ { "has_language", languagelib_has_language },
+ { "hyphenate", languagelib_hyphenate },
+ { "current", languagelib_current },
+ { "new", languagelib_new },
+ { NULL, NULL },
+};
+
+int luaopen_language(lua_State *L)
+{
+ luaL_newmetatable(L, LANGUAGE_METATABLE);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -2, "__index");
+ luaL_setfuncs(L, langlib_metatable, 0);
+ lua_newtable(L);
+ luaL_setfuncs(L, langlib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmtlanguagelib.h b/source/luametatex/source/lua/lmtlanguagelib.h
new file mode 100644
index 000000000..970ea6af5
--- /dev/null
+++ b/source/luametatex/source/lua/lmtlanguagelib.h
@@ -0,0 +1,20 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LLANGUAGELIB_H
+# define LLANGUAGELIB_H
+
+extern void lmt_initialize_languages (void);
+
+extern int lmt_handle_word (
+ tex_language *lang,
+ const char *original,
+ const char *word,
+ int length,
+ halfword first,
+ halfword last,
+ char **replacement
+);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtlibrary.c b/source/luametatex/source/lua/lmtlibrary.c
new file mode 100644
index 000000000..ff6822a02
--- /dev/null
+++ b/source/luametatex/source/lua/lmtlibrary.c
@@ -0,0 +1,106 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+
+/*tex
+
+ There is not much here. We only implement a mechanism for storing optional libraries. The
+ engine is self contained and doesn't depend on large and complex libraries. One can (try to)
+ load libraries at runtime. The optional ones that come with the engine end up in the
+ |optional| namespace.
+
+*/
+
+# include "luametatex.h"
+
+void lmt_library_initialize(lua_State *L)
+{
+ lua_getglobal(L,"optional");
+ if (! lua_istable(L, -1)) {
+ lua_pop(L, 1);
+ lua_newtable(L);
+ lua_setglobal(L, "optional");
+ } else {
+ lua_pop(L, 1);
+ }
+}
+
+void lmt_library_register(lua_State *L, const char *name, luaL_Reg functions[])
+{
+ lmt_library_initialize(L);
+ lua_getglobal(L, "optional");
+ lua_pushstring(L, name);
+ lua_newtable(L);
+ luaL_setfuncs(L, functions, 0);
+ lua_rawset(L, -3);
+ lua_pop(L, 1);
+}
+
+lmt_library lmt_library_load(const char *filename)
+{
+ lmt_library lib = { .lib = NULL };
+ if (filename && strlen(filename)) {
+ lib.lib = lmt_library_open_indeed(filename);
+ lib.okay = lib.lib != NULL;
+ if (! lib.okay) {
+ tex_formatted_error("lmt library", "unable to load '%s', quitting\n", filename);
+ }
+ }
+ return lib;
+}
+
+lmt_library_function lmt_library_find(lmt_library lib, const char *source)
+{
+ if (lib.lib && lib.okay) {
+ lmt_library_function target = lmt_library_find_indeed(lib.lib, source);
+ if (target) {
+ return target;
+ } else {
+ lib.okay = 0;
+ tex_formatted_error("lmt library", "unable to locate '%s', quitting\n", source);
+ }
+ }
+ return NULL;
+}
+
+int lmt_library_okay(lmt_library lib)
+{
+ return lib.lib && lib.okay;
+};
+
+/* experiment */
+
+int librarylib_load(lua_State *L)
+{
+ /* So we permit it in mtxrun (for now, when we test). */
+ if (lmt_engine_state.lua_only || lmt_engine_state.permit_loadlib) {
+ const char *filename = lua_tostring(L, 1);
+ const char *openname = lua_tostring(L, 2);
+ if (filename && openname) {
+ lmt_library lib = lmt_library_load(filename);
+ if (lmt_library_okay(lib)) {
+ lua_CFunction target = lmt_library_find_indeed(lib.lib, openname);
+ if (target) {
+ lua_pushcfunction(L, target);
+ lua_pushstring(L, filename);
+ return 2;
+ }
+ }
+ }
+ } else {
+ tex_formatted_error("lmt library", "loading is not permitted, quitting\n");
+ }
+ return 0;
+};
+
+static struct luaL_Reg librarylib_function_list[] = {
+ { "load", librarylib_load },
+ { NULL, NULL },
+};
+
+int luaopen_library(lua_State * L)
+{
+ lmt_library_register(L, "library", librarylib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/lua/lmtlibrary.h b/source/luametatex/source/lua/lmtlibrary.h
new file mode 100644
index 000000000..40f5f47f4
--- /dev/null
+++ b/source/luametatex/source/lua/lmtlibrary.h
@@ -0,0 +1,60 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LLIBRARY_H
+# define LMT_LLIBRARY_H
+
+/*tex
+
+ The normal \LUA\ library loader uses the same calls as below. After loading the initializer is
+ looked up and called but here we use that method for locating more functions.
+
+ -- anonymous cast: void(*)(void)
+
+*/
+
+/* Do we need LoadLibraryW here or are we never utf/wide? */
+
+/* void : dlclose(lib) | string: dlerror() */
+
+typedef void (*lmt_library_function);
+
+# ifdef _WIN32
+
+ # include <windows.h>
+
+ typedef struct lmt_library {
+ HMODULE lib;
+ int okay;
+ int padding;
+ } lmt_library;
+
+ # define lmt_library_open_indeed(filename) LoadLibraryExA(filename, NULL, 0)
+ # define lmt_library_close_indeed(lib) FreeLibrary((HMODULE) lib)
+ # define lmt_library_find_indeed(lib,source) (void *) GetProcAddress((HMODULE) lib, source)
+
+# else
+
+ # include <dlfcn.h>
+
+ typedef struct lmt_library {
+ void *lib;
+ int okay;
+ int padding;
+ } lmt_library;
+
+ # define lmt_library_open_indeed(filename) dlopen(filename, RTLD_NOW | RTLD_LOCAL)
+ # define lmt_library_close_indeed(lib) dlclose(lib)
+ # define lmt_library_find_indeed(lib,source) (void *) dlsym(lib, source)
+
+# endif
+
+extern void lmt_library_register (lua_State *L, const char *name, luaL_Reg functions[]);
+extern void lmt_library_initialize (lua_State *L);
+
+extern lmt_library lmt_library_load (const char *filename);
+extern lmt_library_function lmt_library_find (lmt_library lib, const char *source);
+extern int lmt_library_okay (lmt_library lib);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtluaclib.c b/source/luametatex/source/lua/lmtluaclib.c
new file mode 100644
index 000000000..797585aba
--- /dev/null
+++ b/source/luametatex/source/lua/lmtluaclib.c
@@ -0,0 +1,660 @@
+/*
+ See license.txt in the root of this project. Most code here is from the luac program by the
+ official Lua project developers.
+*/
+
+# include "luametatex.h"
+
+/*
+
+ This is a slightly adapted version of luac which is not in the library but a separate program.
+ We keep a copy around in order to check changes. The version below doesn't load files nor saves
+ one. It is derived from:
+
+ $Id: luac.c $
+ Lua compiler (saves bytecodes to files; also lists bytecodes)
+ See Copyright Notice in lua.h
+
+ I added this helper because I wanted to look to what extend constants were resolved beforehand
+ but in the end that was seldom the case because we get them from tables and that bit of code is
+ not resolved at bytecode compile time (so in the end macros made more sense, although the gain
+ is very little).
+
+ I considered replacing the print with writing to a buffer so that we can deal with it later but
+ it is not worth the effort.
+
+*/
+
+# include "ldebug.h"
+# include "lopcodes.h"
+# include "lopnames.h"
+
+static TString **tmname = NULL;
+
+# define toproto(L,i) getproto(s2v(L->top+(i)))
+# define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
+# define LUACVOID(p) ((const void*)(p))
+# define eventname(i) (getstr(tmname[i]))
+
+static void luaclib_aux_print_string(const TString* ts)
+{
+ const char* s = getstr(ts);
+ size_t n = tsslen(ts);
+ printf("\"");
+ for (size_t i = 0; i < n; i++) {
+ int c = (int) (unsigned char) s[i];
+ switch (c) {
+ case '"':
+ printf("\\\"");
+ break;
+ case '\\':
+ printf("\\\\");
+ break;
+ case '\a':
+ printf("\\a");
+ break;
+ case '\b':
+ printf("\\b");
+ break;
+ case '\f':
+ printf("\\f");
+ break;
+ case '\n':
+ printf("\\n");
+ break;
+ case '\r':
+ printf("\\r");
+ break;
+ case '\t':
+ printf("\\t");
+ break;
+ case '\v':
+ printf("\\v");
+ break;
+ default:
+ printf(isprint(c) ? "%c" : "\\%03d", c);
+ break;
+ }
+ }
+ printf("\"");
+}
+
+static void PrintType(const Proto* f, int i)
+{
+ const TValue* o = &f->k[i];
+ switch (ttypetag(o)) {
+ case LUA_VNIL:
+ printf("N");
+ break;
+ case LUA_VFALSE:
+ case LUA_VTRUE:
+ printf("B");
+ break;
+ case LUA_VNUMFLT:
+ printf("F");
+ break;
+ case LUA_VNUMINT:
+ printf("I");
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ printf("S");
+ break;
+ default:
+ /* cannot happen */
+ printf("?%d", ttypetag(o));
+ break;
+ }
+ printf("\t");
+}
+
+static void PrintConstant(const Proto* f, int i)
+{
+ const TValue* o = &f->k[i];
+ switch (ttypetag(o)) {
+ case LUA_VNIL:
+ printf("nil");
+ break;
+ case LUA_VFALSE:
+ printf("false");
+ break;
+ case LUA_VTRUE:
+ printf("true");
+ break;
+ case LUA_VNUMFLT:
+ {
+ char buff[100];
+ sprintf(buff,"%.14g", fltvalue(o)); /* LUA_NUMBER_FMT */
+ printf("%s", buff);
+ if (buff[strspn(buff, "-0123456789")] == '\0') {
+ printf(".0");
+ }
+ break;
+ }
+ case LUA_VNUMINT:
+# if defined(__MINGW64__) || defined(__MINGW32__)
+ printf("%I64i", ivalue(o)); /* LUA_INTEGER_FMT */
+# else
+ printf("%lli", ivalue(o)); /* LUA_INTEGER_FMT */
+# endif
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ luaclib_aux_print_string(tsvalue(o));
+ break;
+ default:
+ /* cannot happen */
+ printf("?%d", ttypetag(o));
+ break;
+ }
+}
+
+#define COMMENT "\t; "
+#define EXTRAARG GETARG_Ax(code[pc+1])
+#define EXTRAARGC (EXTRAARG*(MAXARG_C+1))
+#define ISK (isk ? "k" : "")
+
+static void luaclib_aux_print_code(const Proto* f)
+{
+ const Instruction* code = f->code;
+ int n = f->sizecode;
+ for (int pc = 0; pc < n; pc++) {
+ Instruction i = code[pc];
+ OpCode o = GET_OPCODE(i);
+ int a = GETARG_A(i);
+ int b = GETARG_B(i);
+ int c = GETARG_C(i);
+ int ax = GETARG_Ax(i);
+ int bx = GETARG_Bx(i);
+ int sb = GETARG_sB(i);
+ int sc = GETARG_sC(i);
+ int sbx = GETARG_sBx(i);
+ int isk = GETARG_k(i);
+ int line = luaG_getfuncline(f, pc);
+ printf("\t%d\t", pc + 1);
+ if (line > 0) {
+ printf("[%d]\t", line);
+ } else {
+ printf("[-]\t");
+ }
+ printf("%-9s\t", opnames[o]);
+ switch (o) {
+ case OP_MOVE:
+ printf("%d %d", a, b);
+ break;
+ case OP_LOADI:
+ printf("%d %d", a, sbx);
+ break;
+ case OP_LOADF:
+ printf("%d %d", a, sbx);
+ break;
+ case OP_LOADK:
+ printf("%d %d", a, bx);
+ printf(COMMENT);
+ PrintConstant(f, bx);
+ break;
+ case OP_LOADKX:
+ printf("%d", a);
+ printf(COMMENT);
+ PrintConstant(f, EXTRAARG);
+ break;
+ case OP_LOADFALSE:
+ printf("%d", a);
+ break;
+ case OP_LFALSESKIP:
+ printf("%d", a);
+ break;
+ case OP_LOADTRUE:
+ printf("%d", a);
+ break;
+ case OP_LOADNIL:
+ printf("%d %d", a, b);
+ printf(COMMENT "%d out", b + 1);
+ break;
+ case OP_GETUPVAL:
+ printf("%d %d", a, b);
+ printf(COMMENT "%s", UPVALNAME(b));
+ break;
+ case OP_SETUPVAL:
+ printf("%d %d", a, b);
+ printf(COMMENT "%s", UPVALNAME(b));
+ break;
+ case OP_GETTABUP:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%s", UPVALNAME(b));
+ printf(" ");
+ PrintConstant(f, c);
+ break;
+ case OP_GETTABLE:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_GETI:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_GETFIELD:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_SETTABUP:
+ printf("%d %d %d%s", a, b, c, ISK);
+ printf(COMMENT "%s", UPVALNAME(a));
+ printf(" ");
+ PrintConstant(f, b);
+ if (isk) {
+ printf(" ");
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_SETTABLE:
+ printf("%d %d %d%s", a, b, c, ISK);
+ if (isk) {
+ printf(COMMENT);
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_SETI:
+ printf("%d %d %d%s", a, b, c, ISK);
+ if (isk) {
+ printf(COMMENT);
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_SETFIELD:
+ printf("%d %d %d%s", a, b, c, ISK);
+ printf(COMMENT);
+ PrintConstant(f, b);
+ if (isk) {
+ printf(" ");
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_NEWTABLE:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%d", c + EXTRAARGC);
+ break;
+ case OP_SELF:
+ printf("%d %d %d%s", a, b, c, ISK);
+ if (isk) {
+ printf(COMMENT);
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_ADDI:
+ printf("%d %d %d", a, b, sc);
+ break;
+ case OP_ADDK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_SUBK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_MULK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_MODK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_POWK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_DIVK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_IDIVK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_BANDK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_BORK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_BXORK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_SHRI:
+ printf("%d %d %d", a, b, sc);
+ break;
+ case OP_SHLI:
+ printf("%d %d %d", a, b, sc);
+ break;
+ case OP_ADD:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_SUB:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_MUL:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_MOD:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_POW:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_DIV:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_IDIV:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_BAND:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_BOR:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_BXOR:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_SHL:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_SHR:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_MMBIN:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%s", eventname(c));
+ break;
+ case OP_MMBINI:
+ printf("%d %d %d %d", a, sb, c, isk);
+ printf(COMMENT "%s", eventname(c));
+ if (isk) {
+ printf(" flip");
+ }
+ break;
+ case OP_MMBINK:
+ printf("%d %d %d %d", a, b, c, isk);
+ printf(COMMENT "%s ", eventname(c));
+ PrintConstant(f, b);
+ if (isk) {
+ printf(" flip");
+ }
+ break;
+ case OP_UNM:
+ printf("%d %d", a, b);
+ break;
+ case OP_BNOT:
+ printf("%d %d", a, b);
+ break;
+ case OP_NOT:
+ printf("%d %d", a, b);
+ break;
+ case OP_LEN:
+ printf("%d %d", a, b);
+ break;
+ case OP_CONCAT:
+ printf("%d %d", a, b);
+ break;
+ case OP_CLOSE:
+ printf("%d", a);
+ break;
+ case OP_TBC:
+ printf("%d", a);
+ break;
+ case OP_JMP:
+ printf("%d", GETARG_sJ(i));
+ printf(COMMENT "to %d", GETARG_sJ(i) + pc + 2);
+ break;
+ case OP_EQ:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_LT:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_LE:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_EQK:
+ printf("%d %d %d", a, b, isk);
+ printf(COMMENT);
+ PrintConstant(f, b);
+ break;
+ case OP_EQI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_LTI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_LEI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_GTI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_GEI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_TEST:
+ printf("%d %d", a, isk);
+ break;
+ case OP_TESTSET:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_CALL:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ if (b==0) {
+ printf("all in ");
+ } else {
+ printf("%d in ", b - 1);
+ }
+ if (c==0) {
+ printf("all out");
+ } else {
+ printf("%d out", c- 1 );
+ }
+ break;
+ case OP_TAILCALL:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%d in", b - 1);
+ break;
+ case OP_RETURN:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ if (b == 0) {
+ printf("all out");
+ } else {
+ printf("%d out", b - 1);
+ }
+ break;
+ case OP_RETURN0:
+ break;
+ case OP_RETURN1:
+ printf("%d", a);
+ break;
+ case OP_FORLOOP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc - bx + 2);
+ break;
+ case OP_FORPREP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc + bx + 2);
+ break;
+ case OP_TFORPREP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc + bx + 2);
+ break;
+ case OP_TFORCALL:
+ printf("%d %d", a, c);
+ break;
+ case OP_TFORLOOP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc - bx + 2);
+ break;
+ case OP_SETLIST:
+ printf("%d %d %d", a, b, c);
+ if (isk) {
+ printf(COMMENT "%d", c + EXTRAARGC);
+ }
+ break;
+ case OP_CLOSURE:
+ printf("%d %d",a,bx);
+ printf(COMMENT "%p", LUACVOID(f->p[bx]));
+ break;
+ case OP_VARARG:
+ printf("%d %d", a, c);
+ printf(COMMENT);
+ if (c == 0) {
+ printf("all out");
+ } else {
+ printf("%d out", c-1);
+ }
+ break;
+ case OP_VARARGPREP:
+ printf("%d",a);
+ break;
+ case OP_EXTRAARG:
+ printf("%d", ax);
+ break;
+ default:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "not handled");
+ break;
+ }
+ printf("\n");
+ }
+}
+
+# define SS(x) ((x == 1) ? "" : "s")
+# define S(x) (int)(x),SS(x)
+
+static void luaclib_aux_print_header(const Proto* f)
+{
+ const char* s = f->source ? getstr(f->source) : "=?";
+ if (*s == '@' || *s == '=') {
+ s++;
+ } else if (*s == LUA_SIGNATURE[0]) {
+ s = "(bstring)";
+ } else {
+ s = "(string)";
+ }
+ printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
+ (f->linedefined == 0) ? "main" : "function",
+ s,
+ f->linedefined,f->lastlinedefined,
+ S(f->sizecode),LUACVOID(f)
+ );
+ printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
+ (int)(f->numparams),
+ f->is_vararg?"+":"",
+ SS(f->numparams),
+ S(f->maxstacksize),
+ S(f->sizeupvalues)
+ );
+ printf("%d local%s, %d constant%s, %d function%s\n",
+ S(f->sizelocvars),
+ S(f->sizek),
+ S(f->sizep)
+ );
+}
+
+static void luaclib_aux_print_debug(const Proto* f)
+{
+ {
+ int n = f->sizek;
+ printf("constants (%d) for %p:\n", n, LUACVOID(f));
+ for (int i = 0; i < n; i++) {
+ printf("\t%d\t", i);
+ PrintType(f, i);
+ PrintConstant(f, i);
+ printf("\n");
+ }
+ }
+ {
+ int n = f->sizelocvars;
+ printf("locals (%d) for %p:\n", n, LUACVOID(f));
+ for (int i = 0; i < n; i++) {
+ printf("\t%d\t%s\t%d\t%d\n",
+ i,
+ getstr(f->locvars[i].varname),
+ f->locvars[i].startpc+1,
+ f->locvars[i].endpc+1
+ );
+ }
+ }
+ {
+ int n = f->sizeupvalues;
+ printf("upvalues (%d) for %p:\n", n, LUACVOID(f));
+ for (int i = 0; i < n; i++) {
+ printf("\t%d\t%s\t%d\t%d\n",
+ i,
+ UPVALNAME(i),
+ f->upvalues[i].instack,
+ f->upvalues[i].idx
+ );
+ }
+ }
+}
+
+/* We only have one (needs checking). */
+
+static void luaclib_aux_print_function(const Proto* f, int full)
+{
+ int n = f->sizep;
+ luaclib_aux_print_header(f);
+ luaclib_aux_print_code(f);
+ if (full) {
+ luaclib_aux_print_debug(f);
+ }
+ for (int i = 0; i < n; i++) {
+ luaclib_aux_print_function(f->p[i], full);
+ }
+}
+
+static int luaclib_print(lua_State *L)
+{
+ int full = lua_toboolean(L, 2);
+ size_t len = 0;
+ const char *str = lua_tolstring(L, 1, &len);
+ if (len > 0 && luaL_loadbuffer(L, str, len, str) == LUA_OK) {
+ const Proto *f = toproto(L, -1);
+ if (f) {
+ tmname = G(L)->tmname;
+ luaclib_aux_print_function(f, full);
+ }
+ }
+ return 0;
+}
+
+/* So far for the adapted rip-off. */
+
+void lmt_luaclib_initialize(void)
+{
+ /* not used yet */
+}
+
+static const struct luaL_Reg luaclib_function_list[] = {
+ { "print", luaclib_print },
+ { NULL, NULL },
+};
+
+int luaopen_luac(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, luaclib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmtluaclib.h b/source/luametatex/source/lua/lmtluaclib.h
new file mode 100644
index 000000000..28b5998bb
--- /dev/null
+++ b/source/luametatex/source/lua/lmtluaclib.h
@@ -0,0 +1,10 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LUALUACLIB_H
+# define LUALUACLIB_H
+
+extern void lmt_luaclib_initialize (void);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtlualib.c b/source/luametatex/source/lua/lmtlualib.c
new file mode 100644
index 000000000..b82ddc649
--- /dev/null
+++ b/source/luametatex/source/lua/lmtlualib.c
@@ -0,0 +1,627 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Some code here originates from the beginning of \LUATEX\ developmentm like the bytecode
+ registers. They provide a way to store (compiled) \LUA\ code in the format file. In the
+ meantime there are plenty of ways to use \LUA\ code in the frontend so an interface at the
+ \TEX\ end makes no longer much sense.
+
+ This module also provides some statistics and control options. Keep in mind that the engine
+ also can act as a \LUA\ engine, so some of that property is reflected in the code.
+
+*/
+
+# define LOAD_BUF_SIZE 64*1024
+# define UINT_MAX32 0xFFFFFFFF
+
+# define LUA_FUNCTIONS "lua.functions"
+# define LUA_BYTECODES "lua.bytecodes"
+# define LUA_BYTECODES_INDIRECT "lua.bytecodes.indirect"
+
+typedef struct bytecode {
+ unsigned char *buf;
+ int size;
+ int alloc;
+} bytecode;
+
+static bytecode *lmt_bytecode_registers = NULL;
+
+void lmt_dump_registers(dumpstream f)
+{
+ dump_int(f, lmt_lua_state.version_number);
+ dump_int(f, lmt_lua_state.release_number);
+ dump_int(f, lmt_lua_state.integer_size);
+ dump_int(f, lmt_lua_state.bytecode_max);
+ if (lmt_bytecode_registers) {
+ int n = 0;
+ for (int k = 0; k <= lmt_lua_state.bytecode_max; k++) {
+ if (lmt_bytecode_registers[k].size != 0) {
+ n++;
+ }
+ }
+ dump_int(f, n);
+ for (int k = 0; k <= lmt_lua_state.bytecode_max; k++) {
+ bytecode b = lmt_bytecode_registers[k];
+ if (b.size != 0) {
+ dump_int(f, k);
+ dump_int(f, b.size);
+ dump_items(f, (char *) b.buf, 1, b.size);
+ }
+ }
+ }
+}
+
+void lmt_undump_registers(dumpstream f)
+{
+ int version_number = 0;
+ int release_number = 0;
+ int integer_size = 0;
+ undump_int(f, version_number);
+ if (version_number != lmt_lua_state.version_number) {
+ tex_fatal_undump_error("mismatching Lua version number");
+ }
+ undump_int(f, release_number);
+ if (release_number != lmt_lua_state.release_number) {
+ tex_fatal_undump_error("mismatching Lua release number");
+ }
+ undump_int(f, integer_size);
+ if (integer_size != lmt_lua_state.integer_size) {
+ tex_fatal_undump_error("different integer size");
+ }
+ undump_int(f, lmt_lua_state.bytecode_max);
+ if (lmt_lua_state.bytecode_max < 0) {
+ tex_fatal_undump_error("not enough memory for undumping bytecodes"); /* old */
+ } else {
+ size_t s = (lmt_lua_state.bytecode_max + 1) * sizeof(bytecode);
+ int n = (int) s;
+ lmt_bytecode_registers = (bytecode *) lmt_memory_malloc(s);
+ if (lmt_bytecode_registers) {
+ lmt_lua_state.bytecode_bytes = n;
+ for (int j = 0; j <= lmt_lua_state.bytecode_max; j++) {
+ lmt_bytecode_registers[j].buf = NULL;
+ lmt_bytecode_registers[j].size = 0;
+ lmt_bytecode_registers[j].alloc = 0;
+ }
+ undump_int(f, n);
+ for (int j = 0; j < n; j++) {
+ unsigned char *buffer;
+ int slot, size;
+ undump_int(f, slot);
+ undump_int(f, size);
+ buffer = (unsigned char *) lmt_memory_malloc((unsigned) size);
+ if (buffer) {
+ memset(buffer, 0, (size_t) size);
+ undump_items(f, buffer, 1, size);
+ lmt_bytecode_registers[slot].buf = buffer;
+ lmt_bytecode_registers[slot].size = size;
+ lmt_bytecode_registers[slot].alloc = size;
+ lmt_lua_state.bytecode_bytes += size;
+ } else {
+ tex_fatal_undump_error("not enough memory for undumping bytecodes");
+ }
+ }
+ }
+ }
+}
+
+static void lualib_aux_bytecode_register_shadow_set(lua_State *L, int k)
+{
+ /*tex the stack holds the value to be set */
+ luaL_getmetatable(L, LUA_BYTECODES_INDIRECT);
+ if (lua_istable(L, -1)) {
+ lua_pushvalue(L, -2);
+ lua_rawseti(L, -2, k);
+ }
+ lua_pop(L, 2); /*tex pop table or nil and value */
+}
+
+static int lualib_aux_bytecode_register_shadow_get(lua_State *L, int k)
+{
+ /*tex the stack holds the value to be set */
+ int ret = 0;
+ luaL_getmetatable(L, LUA_BYTECODES_INDIRECT);
+ if (lua_istable(L, -1)) {
+ if (lua_rawgeti(L, -1, k) != LUA_TNIL) {
+ ret = 1;
+ }
+ /*tex store the value or nil, deeper down */
+ lua_insert(L, -3);
+ /*tex pop the value or nil at top */
+ lua_pop(L, 1);
+ }
+ /*tex pop table or nil */
+ lua_pop(L, 1);
+ return ret;
+}
+
+static int lualib_aux_writer(lua_State *L, const void *b, size_t size, void *B)
+{
+ bytecode *buf = (bytecode *) B;
+ (void) L;
+ if ((int) (buf->size + (int) size) > buf->alloc) {
+ unsigned newalloc = (unsigned) (buf->alloc + (int) size + LOAD_BUF_SIZE);
+ unsigned char *bb = lmt_memory_realloc(buf->buf, newalloc);
+ if (bb) {
+ buf->buf = bb;
+ buf->alloc = newalloc;
+ } else {
+ return luaL_error(L, "something went wrong with handling bytecodes");
+ }
+ }
+ memcpy(buf->buf + buf->size, b, size);
+ buf->size += (int) size;
+ lmt_lua_state.bytecode_bytes += (unsigned) size;
+ return 0;
+}
+
+static const char *lualib_aux_reader(lua_State *L, void *ud, size_t *size)
+{
+ bytecode *buf = (bytecode *) ud;
+ (void) L;
+ *size = (size_t) buf->size;
+ return (const char *) buf->buf;
+}
+
+static int lualib_valid_bytecode(lua_State *L, int slot)
+{
+ if (slot < 0 || slot > lmt_lua_state.bytecode_max) {
+ return luaL_error(L, "bytecode register out of range");
+ } else if (lualib_aux_bytecode_register_shadow_get(L, slot) || ! lmt_bytecode_registers[slot].buf) {
+ return luaL_error(L, "undefined bytecode register");
+ } else if (lua_load(L, lualib_aux_reader, (void *) (lmt_bytecode_registers + slot), "bytecode", NULL)) {
+ return luaL_error(L, "bytecode register doesn't load well");
+ } else {
+ return 1;
+ }
+}
+
+static int lualib_get_bytecode(lua_State *L)
+{
+ int slot = lmt_checkinteger(L, 1);
+ if (lualib_valid_bytecode(L, slot)) {
+ lua_pushvalue(L, -1);
+ lualib_aux_bytecode_register_shadow_set(L, slot);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int lmt_handle_bytecode_call(lua_State *L, int slot)
+{
+ int stacktop = lua_gettop(L);
+ int error = 1;
+ if (lualib_valid_bytecode(L, slot)) {
+ /*tex function index */
+ lua_pushinteger(L, slot);
+ /*tex push traceback function */
+ lua_pushcfunction(L, lmt_traceback);
+ /*tex put it under chunk */
+ lua_insert(L, stacktop);
+ ++lmt_lua_state.bytecode_callback_count;
+ error = lua_pcall(L, 1, 0, stacktop);
+ /*tex remove traceback function */
+ lua_remove(L, stacktop);
+ if (error) {
+ lua_gc(L, LUA_GCCOLLECT, 0);
+ lmt_error(L, "bytecode call", slot, (error == LUA_ERRRUN ? 0 : 1));
+ }
+ }
+ lua_settop(L, stacktop);
+ return ! error;
+}
+
+void lmt_bytecode_call(int slot)
+{
+ lmt_handle_bytecode_call(lmt_lua_state.lua_instance, slot);
+}
+
+/*tex
+ We don't report an error so this this permits a loop over the bytecode array.
+*/
+
+static int lualib_call_bytecode(lua_State *L)
+{
+ int k = lmt_checkinteger(L, -1);
+ if (k >= 0 && ! lualib_aux_bytecode_register_shadow_get(L, k)) {
+ if (k <= lmt_lua_state.bytecode_max && lmt_bytecode_registers[k].buf) {
+ lmt_handle_bytecode_call(L, k);
+ /* We can have a function pushed! */
+ } else {
+ k = -1;
+ }
+ } else {
+ k = -1;
+ }
+ lua_pushboolean(L, k != -1);
+ /*tex At most 1. */
+ return 1;
+}
+
+static int lualib_set_bytecode(lua_State *L)
+{
+ int k = lmt_checkinteger(L, 1);
+ int i = k + 1;
+ if ((k < 0) || (k > max_bytecode_index)) {
+ return luaL_error(L, "bytecode register out of range");
+ } else {
+ int ltype = lua_type(L, 2);
+ int strip = lua_toboolean(L, 3);
+ if (ltype != LUA_TFUNCTION && ltype != LUA_TNIL) {
+ return luaL_error(L, "bytecode register should be a function or nil");
+ } else {
+ /*tex Later calls expect the function at the top of the stack. */
+ lua_settop(L, 2);
+ if (k > lmt_lua_state.bytecode_max) {
+ bytecode *r = lmt_memory_realloc(lmt_bytecode_registers, (size_t) i * sizeof(bytecode));
+ if (r) {
+ lmt_bytecode_registers = r;
+ lmt_lua_state.bytecode_bytes += ((int) sizeof(bytecode) * (k + 1 - (lmt_lua_state.bytecode_max > 0 ? lmt_lua_state.bytecode_max : 0)));
+ for (unsigned j = (unsigned) (lmt_lua_state.bytecode_max + 1); j <= (unsigned) k; j++) {
+ lmt_bytecode_registers[j].buf = NULL;
+ lmt_bytecode_registers[j].size = 0;
+ lmt_bytecode_registers[j].alloc = 0;
+ }
+ lmt_lua_state.bytecode_max = k;
+ } else {
+ return luaL_error(L, "bytecode register exceeded memory");
+ }
+ }
+ if (lmt_bytecode_registers[k].buf) {
+ lmt_memory_free(lmt_bytecode_registers[k].buf);
+ lmt_lua_state.bytecode_bytes -= lmt_bytecode_registers[k].size;
+ lmt_bytecode_registers[k].size = 0;
+ lmt_bytecode_registers[k].buf = NULL;
+ lua_pushnil(L);
+ lualib_aux_bytecode_register_shadow_set(L, k);
+ }
+ if (ltype == LUA_TFUNCTION) {
+ lmt_bytecode_registers[k].buf = lmt_memory_calloc(1, LOAD_BUF_SIZE);
+ if (lmt_bytecode_registers[k].buf) {
+ lmt_bytecode_registers[k].alloc = LOAD_BUF_SIZE;
+ // memset(lua_bytecode_registers[k].buf, 0, LOAD_BUF_SIZE);
+ lua_dump(L, lualib_aux_writer, (void *) (lmt_bytecode_registers + k), strip);
+ } else {
+ return luaL_error(L, "bytecode register exceeded memory");
+ }
+ }
+ lua_pop(L, 1);
+ }
+ }
+ return 0;
+}
+
+void lmt_initialize_functions(int set_size)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (set_size) {
+ tex_engine_get_config_number("functionsize", &lmt_lua_state.function_table_size);
+ if (lmt_lua_state.function_table_size < 0) {
+ lmt_lua_state.function_table_size = 0;
+ }
+ lua_createtable(L, lmt_lua_state.function_table_size, 0);
+ } else {
+ lua_newtable(L);
+ }
+ lmt_lua_state.function_table_id = luaL_ref(L, LUA_REGISTRYINDEX);
+ /* not needed, so unofficial */
+ lua_pushstring(L, LUA_FUNCTIONS);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_lua_state.function_table_id);
+ lua_settable(L, LUA_REGISTRYINDEX);
+}
+
+static int lualib_get_functions_table(lua_State *L)
+{
+ if (lua_toboolean(L, lua_gettop(L))) {
+ /*tex Beware: this can have side effects when used without care. */
+ lmt_initialize_functions(1);
+ }
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_lua_state.function_table_id);
+ return 1;
+}
+
+static int lualib_new_table(lua_State *L)
+{
+ int i = lmt_checkinteger(L, 1);
+ int h = lmt_checkinteger(L, 2);
+ lua_createtable(L, i < 0 ? 0 : i, h < 0 ? 0 : h);
+ return 1;
+}
+
+static int lualib_new_index(lua_State *L)
+{
+ int n = lmt_checkinteger(L, 1);
+ int t = lua_gettop(L);
+ lua_createtable(L, n < 0 ? 0 : n, 0);
+ if (t == 2) {
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_pushvalue(L, 2);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ return 1;
+}
+
+static int lualib_get_stack_top(lua_State *L)
+{
+ lua_pushinteger(L, lua_gettop(L));
+ return 1;
+}
+
+static int lualib_get_runtime(lua_State *L)
+{
+ lua_pushnumber(L, aux_get_run_time());
+ return 1;
+}
+
+static int lualib_get_currenttime(lua_State *L)
+{
+ lua_pushnumber(L, aux_get_current_time());
+ return 1;
+}
+
+static int lualib_set_exitcode(lua_State *L)
+{
+ lmt_error_state.default_exit_code = lmt_checkinteger(L, 1);
+ return 0;
+}
+
+static int lualib_get_exitcode(lua_State *L)
+{
+ lua_pushinteger(L, lmt_error_state.default_exit_code);
+ return 1;
+}
+
+/*tex
+
+ The |getpreciseticks()| call returns a number. This number has no meaning in itself but
+ successive calls can be used to calculate a delta with a previous call. When the number is fed
+ into |getpreciseseconds(n)| a number is returned representing seconds.
+
+*/
+
+# ifdef _WIN32
+
+# define clock_inittime()
+
+ static int lualib_get_preciseticks(lua_State *L)
+ {
+ LARGE_INTEGER t;
+ QueryPerformanceCounter(&t);
+ lua_pushnumber(L, (double) t.QuadPart);
+ return 1;
+ }
+
+ static int lualib_get_preciseseconds(lua_State *L)
+ {
+ LARGE_INTEGER t;
+ QueryPerformanceFrequency(&t);
+ lua_pushnumber(L, luaL_optnumber(L, 1, 0) / (double) t.QuadPart);
+ return 1;
+ }
+
+# else
+
+# if (defined(__MACH__) && ! defined(CLOCK_PROCESS_CPUTIME_ID))
+
+ /* https://stackoverflow.com/questions/5167269/clock-gettime-alternative-in-mac-os-x */
+
+# include <mach/mach_time.h>
+# define CLOCK_PROCESS_CPUTIME_ID 1
+
+ static double conversion_factor;
+
+ static void clock_inittime()
+ {
+ mach_timebase_info_data_t timebase;
+ mach_timebase_info(&timebase);
+ conversion_factor = (double)timebase.numer / (double)timebase.denom;
+ }
+
+ static int clock_gettime(int clk_id, struct timespec *t)
+ {
+ uint64_t time;
+ double nseconds, seconds;
+ (void) clk_id; /* please the compiler */
+ time = mach_absolute_time();
+ nseconds = ((double)time * conversion_factor);
+ seconds = ((double)time * conversion_factor / 1e9);
+ t->tv_sec = seconds;
+ t->tv_nsec = nseconds;
+ return 0;
+ }
+
+# else
+
+# define clock_inittime()
+
+# endif
+
+ static int lualib_get_preciseticks(lua_State *L)
+ {
+ struct timespec t;
+ clock_gettime(CLOCK_PROCESS_CPUTIME_ID,&t);
+ lua_pushnumber(L, t.tv_sec*1000000000.0 + t.tv_nsec);
+ return 1;
+ }
+
+ static int lualib_get_preciseseconds(lua_State *L)
+ {
+ lua_pushnumber(L, ((double) luaL_optnumber(L, 1, 0)) / 1000000000.0);
+ return 1;
+ }
+
+# endif
+
+static int lualib_get_startupfile(lua_State *L)
+{
+ lua_pushstring(L, lmt_engine_state.startup_filename);
+ return 1;
+}
+
+static int lualib_get_version(lua_State *L)
+{
+ lua_pushstring(L, LUA_VERSION);
+ return 1;
+}
+
+/* obsolete:
+static int lualib_get_hashchars(lua_State *L)
+{
+ lua_pushinteger(L, 1 << LUAI_HASHLIMIT);
+ return 1;
+}
+*/
+
+/*
+static int lualib_get_doing_the(lua_State *L)
+{
+ lua_pushboolean(L, lua_state.doing_the);
+ return 1;
+}
+*/
+
+/* This makes the (already old and rusty) profiler 2.5 times faster. */
+
+/*
+static lua_State *getthread (lua_State *L, int *arg) {
+ if (lua_isthread(L, 1)) {
+ *arg = 1;
+ return lua_tothread(L, 1);
+ } else {
+ *arg = 0;
+ return L;
+ }
+}
+
+static int lualib_get_debug_info(lua_State *L) {
+ lua_Debug ar;
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ if (lua_getstack(L1, 2, &ar) && lua_getinfo(L1, "nS", &ar)) {
+ ....
+ }
+ return 0;
+}
+*/
+
+/*
+static int lualib_get_debug_info(lua_State *L) {
+ if (! lua_isthread(L, 1)) {
+ lua_Debug ar;
+ if (lua_getstack(L, 2, &ar) && lua_getinfo(L, "nS", &ar)) {
+ lua_pushstring(L, ar.short_src);
+ lua_pushinteger(L, ar.linedefined);
+ if (ar.name) {
+ lua_pushstring(L, ar.name);
+ } else if (! strcmp(ar.what, "C")) {
+ lua_pushliteral(L, "<anonymous>");
+ } else if (ar.namewhat) {
+ lua_pushstring(L, ar.namewhat);
+ } else if (ar.what) {
+ lua_pushstring(L, ar.what);
+ } else {
+ lua_pushliteral(L, "<unknown>");
+ }
+ return 3;
+ }
+ }
+ return 0;
+}
+*/
+
+/*tex
+ I can make it faster if needed but then I need to patch the two lua modules (add some simple
+ helpers) which for now doesn't make much sense. This is an undocumented feature.
+*/
+
+static int lualib_get_debug_info(lua_State *L) {
+ if (! lua_isthread(L, 1)) {
+ lua_Debug ar;
+ if (lua_getstack(L, 2, &ar) && lua_getinfo(L, "nS", &ar)) {
+ lua_pushstring(L, ar.name ? ar.name : (ar.namewhat ? ar.namewhat : (ar.what ? ar.what : "<unknown>")));
+ lua_pushstring(L, ar.short_src);
+ lua_pushinteger(L, ar.linedefined);
+ return 3;
+ }
+ }
+ return 0;
+}
+
+/* */
+
+static const struct luaL_Reg lualib_function_list[] = {
+ { "newtable", lualib_new_table },
+ { "newindex", lualib_new_index },
+ { "getstacktop", lualib_get_stack_top },
+ { "getruntime", lualib_get_runtime },
+ { "getcurrenttime", lualib_get_currenttime },
+ { "getpreciseticks", lualib_get_preciseticks },
+ { "getpreciseseconds", lualib_get_preciseseconds },
+ { "getbytecode", lualib_get_bytecode },
+ { "setbytecode", lualib_set_bytecode },
+ { "callbytecode", lualib_call_bytecode },
+ { "getfunctionstable", lualib_get_functions_table },
+ { "getstartupfile", lualib_get_startupfile },
+ { "getversion", lualib_get_version },
+ /* { "gethashchars", lualib_get_hashchars }, */
+ { "setexitcode", lualib_set_exitcode },
+ { "getexitcode", lualib_get_exitcode },
+ /* { "doingthe", lualib_get_doing_the }, */
+ { "getdebuginfo", lualib_get_debug_info },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg lualib_function_list_only[] = {
+ { "newtable", lualib_new_table },
+ { "newindex", lualib_new_index },
+ { "getstacktop", lualib_get_stack_top },
+ { "getruntime", lualib_get_runtime },
+ { "getcurrenttime", lualib_get_currenttime },
+ { "getpreciseticks", lualib_get_preciseticks },
+ { "getpreciseseconds", lualib_get_preciseseconds },
+ { "getstartupfile", lualib_get_startupfile },
+ { "getversion", lualib_get_version },
+ /* { "gethashchars", lualib_get_hashchars }, */
+ { "setexitcode", lualib_set_exitcode },
+ { "getexitcode", lualib_get_exitcode },
+ { NULL, NULL },
+};
+
+static int lualib_index_bytecode(lua_State *L)
+{
+ lua_remove(L, 1);
+ return lualib_get_bytecode(L);
+}
+
+static int lualib_newindex_bytecode(lua_State *L)
+{
+ lua_remove(L, 1);
+ return lualib_set_bytecode(L);
+}
+
+int luaopen_lua(lua_State *L)
+{
+ lua_newtable(L);
+ if (lmt_engine_state.lua_only) {
+ luaL_setfuncs(L, lualib_function_list_only, 0);
+ } else {
+ luaL_setfuncs(L, lualib_function_list, 0);
+ lmt_make_table(L, "bytecode", LUA_BYTECODES, lualib_index_bytecode, lualib_newindex_bytecode);
+ lua_newtable(L);
+ lua_setfield(L, LUA_REGISTRYINDEX, LUA_BYTECODES_INDIRECT);
+ }
+ lua_pushstring(L, LUA_VERSION);
+ lua_setfield(L, -2, "version");
+ if (lmt_engine_state.startup_filename) {
+ lua_pushstring(L, lmt_engine_state.startup_filename);
+ lua_setfield(L, -2, "startupfile");
+ }
+ clock_inittime();
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmtlualib.h b/source/luametatex/source/lua/lmtlualib.h
new file mode 100644
index 000000000..88ae5ae38
--- /dev/null
+++ b/source/luametatex/source/lua/lmtlualib.h
@@ -0,0 +1,25 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LLUALIB_H
+# define LMT_LLUALIB_H
+
+/*tex
+
+ We started with multiple instances but that made no sense as dealing with isolated instances
+ and talking to \TEX\ also means that one then has to have a channel between instances. and it's
+ not worth the trouble. So we went for one instance.
+
+ This also means that the names related to directlua instances have been removed in the follow
+ up.
+
+*/
+
+extern void lmt_dump_registers (dumpstream f);
+extern void lmt_undump_registers (dumpstream f);
+extern void lmt_bytecode_call (int slot);
+
+extern void lmt_initialize_functions (int set_size);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtmplib.c b/source/luametatex/source/lua/lmtmplib.c
new file mode 100644
index 000000000..74d684c3f
--- /dev/null
+++ b/source/luametatex/source/lua/lmtmplib.c
@@ -0,0 +1,3137 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This is an adapted version of \MPLIB\ for ConTeXt LMTX. Interfaces might change as experiments
+ demand or indicate this. It's meant for usage in \LUAMETATEX, which is an engine geared at
+ \CONTEXT, and which, although useable in production, will in principle be experimental and
+ moving for a while, depending on needs, experiments and mood.
+
+ In \LUATEX\, at some point \MPLIB\ got an interface to \LUA\ and that greatly enhanced the
+ posibilities. In \LUAMETATEX\ this interface was further improved and in addition scanners
+ got added. So in the meantime we have a rather complete and tight integration of \TEX, \LUA,
+ and \METAPOST\ and in \CONTEXT\ we use that integration as much as possible.
+
+ An important difference with \LUATEX\ is that we use an upgraded \MPLIB. The \POSTSCRIPT\
+ backend has been dropped and there is no longer font and file related code because that
+ all goes via \LUA\ now. The binary frontend has been dropped to so we now only have scaled,
+ double and decimal.
+
+*/
+
+# include "mpconfig.h"
+
+# include "mp.h"
+
+/*tex
+ We can use common definitions but can only load this file after we load the \METAPOST\ stuff,
+ which defines a whole bunch of macros that can clash. Using the next one is actually a good
+ check for such conflicts.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Here are some enumeration arrays to map MPlib enums to \LUA\ strings. If needed we can also
+ predefine keys here, as we do with nodes. Some tables relate to the scanners.
+
+*/
+
+# define MPLIB_PATH 0
+# define MPLIB_PEN 1
+# define MPLIB_PATH_SIZE 8
+
+static const char *mplib_math_options[] = {
+ "scaled",
+ "double",
+ "binary", /* not available in luatex */
+ "decimal",
+ NULL
+};
+
+static const char *mplib_interaction_options[] = {
+ "unknown",
+ "batch",
+ "nonstop",
+ "scroll",
+ "errorstop",
+ "silent",
+ NULL
+};
+
+static const char *mplib_filetype_names[] = {
+ "terminal", /* mp_filetype_terminal */
+ "mp", /* mp_filetype_program */
+ "data", /* mp_filetype_text */
+ NULL
+};
+
+/*
+static const char *knot_type_enum[] = {
+ "endpoint", "explicit", "given", "curl", "open", "end_cycle"
+};
+*/
+
+static const char *mplib_fill_fields[] = {
+ "type",
+ "path", "htap",
+ "pen", "color",
+ "linejoin", "miterlimit",
+ "prescript", "postscript",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_stroked_fields[] = {
+ "type",
+ "path",
+ "pen", "color",
+ "linejoin", "miterlimit", "linecap",
+ "dash",
+ "prescript", "postscript",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_start_clip_fields[] = {
+ "type",
+ "path",
+ "prescript", "postscript",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_start_group_fields[] = {
+ "type",
+ "path",
+ "prescript", "postscript",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_start_bounds_fields[] = {
+ "type",
+ "path",
+ "prescript", "postscript",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_stop_clip_fields[] = {
+ "type",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_stop_group_fields[] = {
+ "type",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_stop_bounds_fields[] = {
+ "type",
+ "stacking",
+ NULL
+};
+
+static const char *mplib_no_fields[] = {
+ NULL
+};
+
+static const char *mplib_codes[] = {
+ "undefined",
+ "btex", /* mp_btex_command */ /* btex verbatimtex */
+ "etex", /* mp_etex_command */ /* etex */
+ "if", /* mp_if_test_command */ /* if */
+ "fiorelse", /* mp_fi_or_else_command */ /* elseif else fi */
+ "input", /* mp_input_command */ /* input endinput */
+ "iteration", /* mp_iteration_command */ /* for forsuffixes forever endfor */
+ "repeatloop", /* mp_repeat_loop_command */ /* used in repeat loop (endfor) */
+ "exittest", /* mp_exit_test_command */ /* exitif */
+ "relax", /* mp_relax_command */ /* \\ */
+ "scantokens", /* mp_scan_tokens_command */ /* scantokens */
+ "runscript", /* mp_runscript_command */ /* runscript */
+ "maketext", /* mp_maketext_command */ /* maketext */
+ "expandafter", /* mp_expand_after_command */ /* expandafter */
+ "definedmacro", /* mp_defined_macro_command */ /* */
+ "save", /* mp_save_command */ /* save */
+ "interim", /* mp_interim_command */ /* interim */
+ "let", /* mp_let_command */ /* let */
+ "newinternal", /* mp_new_internal_command */ /* newinternal */
+ "macrodef", /* mp_macro_def_command */ /* def vardef (etc) */
+ "shipout", /* mp_ship_out_command */ /* shipout */
+ "addto", /* mp_add_to_command */ /* addto */
+ "setbounds", /* mp_bounds_command */ /* setbounds clip group */
+ "protection", /* mp_protection_command */
+ "property", /* mp_property_command */
+ "show", /* mp_show_command */ /* show showvariable (etc) */
+ "mode", /* mp_mode_command */ /* batchmode (etc) */
+ "onlyset", /* mp_only_set_command */ /* randomseed, maxknotpool */
+ "message", /* mp_message_command */ /* message errmessage */
+ "everyjob", /* mp_every_job_command */ /* everyjob */
+ "delimiters", /* mp_delimiters_command */ /* delimiters */
+ "write", /* mp_write_command */ /* write */
+ "typename", /* mp_type_name_command */ /* (declare) numeric pair */
+ "leftdelimiter", /* mp_left_delimiter_command */ /* the left delimiter of a matching pair */
+ "begingroup", /* mp_begin_group_command */ /* begingroup */
+ "nullary", /* mp_nullary_command */ /* operator without arguments: normaldeviate (etc) */
+ "unary", /* mp_unary_command */ /* operator with one argument: sqrt (etc) */
+ "str", /* mp_str_command */ /* convert a suffix to a string: str */
+ "void", /* mp_void_command */ /* convert a suffix to a boolean: void */
+ "cycle", /* mp_cycle_command */ /* cycle */
+ "ofbinary", /* mp_of_binary_command */ /* binary operation taking "of", like "point of" */
+ "capsule", /* mp_capsule_command */ /* */
+ "string", /* mp_string_command */ /* */
+ "internal", /* mp_internal_quantity_command */ /* */
+ "tag", /* mp_tag_command */ /* a symbolic token without a primitive meaning */
+ "numeric", /* mp_numeric_command */ /* numeric constant */
+ "plusorminus", /* mp_plus_or_minus_command */ /* + - */
+ "secondarydef", /* mp_secondary_def_command */ /* secondarydef */
+ "tertiarybinary", /* mp_tertiary_binary_command */ /* an operator at the tertiary level: ++ (etc) */
+ "leftbrace", /* mp_left_brace_command */ /* { */
+ "pathjoin", /* mp_path_join_command */ /* .. */
+ "ampersand", /* mp_ampersand_command */ /* & */
+ "tertiarydef", /* mp_tertiary_def_command */ /* tertiarydef */
+ "primarybinary", /* mp_primary_binary_command */ /* < (etc) */
+ "equals", /* mp_equals_command */ /* = */
+ "and", /* mp_and_command */ /* and */
+ "primarydef", /* mp_primary_def_command */ /* primarydef */
+ "slash", /* mp_slash_command */ /* / */
+ "secondarybinary", /* mp_secondary_binary_command */ /* an operator at the binary level: shifted (etc) */
+ "parametertype", /* mp_parameter_commmand */ /* primary expr suffix (etc) */
+ "controls", /* mp_controls_command */ /* controls */
+ "tension", /* mp_tension_command */ /* tension */
+ "atleast", /* mp_at_least_command */ /* atleast */
+ "curl", /* mp_curl_command */ /* curl */
+ "macrospecial", /* mp_macro_special_command */ /* quote, #@ (etc) */
+ "rightdelimiter", /* mp_right_delimiter_command */ /* the right delimiter of a matching pair */
+ "leftbracket", /* mp_left_bracket_command */ /* [ */
+ "rightbracket", /* mp_right_bracket_command */ /* ] */
+ "rightbrace", /* mp_right_brace_command */ /* } */
+ "with", /* mp_with_option_command */ /* withpen (etc) */
+ "thingstoadd", /* mp_thing_to_add_command */ /* addto contour doublepath also */
+ "of", /* mp_of_command */ /* of */
+ "to", /* mp_to_command */ /* to */
+ "step", /* mp_step_command */ /* step */
+ "until", /* mp_until_command */ /* until */
+ "within", /* mp_within_command */ /* within */
+ "assignment", /* mp_assignment_command */ /* := */
+ "colon", /* mp_colon_command */ /* : */
+ "comma", /* mp_comma_command */ /* , */
+ "semicolon", /* mp_semicolon_command */ /* ; */
+ "endgroup", /* mp_end_group_command */ /* endgroup */
+ "stop", /* mp_stop_command */ /* end dump */
+ // "outertag", /* mp_outer_tag_command */ /* protection code added to command code */
+ "undefinedcs", /* mp_undefined_cs_command */ /* protection code added to command code */
+ NULL
+};
+
+static const char *mplib_states[] = {
+ "normal",
+ "skipping",
+ "flushing",
+ "absorbing",
+ "var_defining",
+ "op_defining",
+ "loop_defining",
+ NULL
+};
+
+static const char *mplib_types[] = {
+ "undefined", /* mp_undefined_type */
+ "vacuous", /* mp_vacuous_type */
+ "boolean", /* mp_boolean_type */
+ "unknownboolean", /* mp_unknown_boolean_type */
+ "string", /* mp_string_type */
+ "unknownstring", /* mp_unknown_string_type */
+ "pen", /* mp_pen_type */
+ "unknownpen", /* mp_unknown_pen_type */
+ "nep", /* mp_nep_type */
+ "unknownnep", /* mp_unknown_nep_type */
+ "path", /* mp_path_type */
+ "unknownpath", /* mp_unknown_path_type */
+ "picture", /* mp_picture_type */
+ "unknownpicture", /* mp_unknown_picture_type */
+ "transform", /* mp_transform_type */
+ "color", /* mp_color_type */
+ "cmykcolor", /* mp_cmykcolor_type */
+ "pair", /* mp_pair_type */
+ // "script", /* */
+ "numeric", /* mp_numeric_type */
+ "known", /* mp_known_type */
+ "dependent", /* mp_dependent_type */
+ "protodependent", /* mp_proto_dependent_type */
+ "independent", /* mp_independent_type */
+ "tokenlist", /* mp_token_list_type */
+ "structured", /* mp_structured_type */
+ "unsuffixedmacro", /* mp_unsuffixed_macro_type */
+ "suffixedmacro", /* mp_suffixed_macro_type */
+ NULL
+};
+
+static const char *mplib_colormodels[] = {
+ "no",
+ "grey",
+ "rgb",
+ "cmyk",
+ NULL
+};
+
+/*tex Some statistics. */
+
+typedef struct mplib_state_info {
+ int file_callbacks;
+ int text_callbacks;
+ int script_callbacks;
+ int log_callbacks;
+ int overload_callbacks;
+ int error_callbacks;
+ int warning_callbacks;
+} mplib_state_info;
+
+static mplib_state_info mplib_state = {
+ .file_callbacks = 0,
+ .text_callbacks = 0,
+ .script_callbacks = 0,
+ .log_callbacks = 0,
+ .overload_callbacks = 0,
+ .error_callbacks = 0,
+ .warning_callbacks = 0,
+};
+
+/*tex
+
+ We need a few metatable identifiers in order to access the metatables for the main object and result
+ userdata. The following code is now replaced by the method that uses keys.
+
+*/
+
+/*
+# define MP_METATABLE_INSTANCE "mp.instance"
+# define MP_METATABLE_FIGURE "mp.figure"
+# define MP_METATABLE_OBJECT "mp.object"
+*/
+
+/*tex
+ This is used for heuristics wrt curves or lines. The default value is rather small
+ and often leads to curved rectangles.
+
+ \starttabulate[||||]
+ \NC 131/65536.0 \NC 0.0019989013671875 \NC default \NC \NR
+ \NC 0.001 * 0x7FFF/0x4000 \NC 0.0019999389648438 \NC kind of the default \NC \NR
+ \NC 32/16000.0 \NC 0.002 \NC somewhat cleaner \NC \NR
+ \NC 10/ 2000.0 \NC 0.005 \NC often good enough \NC \NR
+ \stoptabulate
+
+*/
+
+# define default_bend_tolerance 131/65536.0
+# define default_move_tolerance 131/65536.0
+
+typedef enum mp_variables {
+ mp_bend_tolerance = 1,
+ mp_move_tolerance = 2,
+} mp_variables;
+
+static lua_Number mplib_aux_get_bend_tolerance(lua_State *L, int slot)
+{
+ lua_Number tolerance;
+ lua_getiuservalue(L, slot, mp_bend_tolerance);
+ tolerance = lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return tolerance;
+}
+
+static lua_Number mplib_aux_get_move_tolerance(lua_State *L, int slot)
+{
+ lua_Number tolerance;
+ lua_getiuservalue(L, slot, mp_move_tolerance);
+ tolerance = lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return tolerance;
+}
+
+static void mplib_aux_set_bend_tolerance(lua_State *L, lua_Number tolerance)
+{
+ lua_pushnumber(L, tolerance);
+ lua_setiuservalue(L, -2, mp_bend_tolerance);
+}
+
+static void mplib_aux_set_move_tolerance(lua_State *L, lua_Number tolerance)
+{
+ lua_pushnumber(L, tolerance);
+ lua_setiuservalue(L, -2, mp_move_tolerance);
+}
+
+inline static char *lmt_string_from_index(lua_State *L, int n)
+{
+ size_t l;
+ const char *x = lua_tolstring(L, n, &l);
+ // return (x && l > 0) ? lmt_generic_strdup(x) : NULL;
+ return (x && l > 0) ? lmt_memory_strdup(x) : NULL;
+}
+
+inline static char *lmt_lstring_from_index(lua_State *L, int n, size_t *l)
+{
+ const char *x = lua_tolstring(L, n, l);
+ // return (x && l > 0) ? lmt_generic_strdup(x) : NULL;
+ return (x && l > 0) ? lmt_memory_strdup(x) : NULL;
+}
+
+static void mplib_aux_invalid_object_warning(const char * detail)
+{
+ tex_formatted_warning("mp lib","lua <mp %s> expected", detail);
+}
+
+static void mplib_aux_invalid_object_error(const char * detail)
+{
+ tex_formatted_error("mp lib","lua <mp %s> expected", detail);
+}
+
+inline static MP *mplib_aux_is_mpud(lua_State *L, int n)
+{
+ MP *p = (MP *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(mplib_instance);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ mplib_aux_invalid_object_error("instance");
+ return NULL;
+}
+
+inline static MP mplib_aux_is_mp(lua_State *L, int n)
+{
+ MP *p = (MP *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(mplib_instance);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return *p;
+ }
+ }
+ mplib_aux_invalid_object_error("instance");
+ return NULL;
+}
+
+inline static mp_edge_object **mplib_aux_is_figure(lua_State *L, int n)
+{
+ mp_edge_object **p = (mp_edge_object **) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(mplib_figure);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ mplib_aux_invalid_object_warning("figure");
+ return NULL;
+}
+
+inline static mp_graphic_object **mplib_aux_is_gr_object(lua_State *L, int n)
+{
+ mp_graphic_object **p = (mp_graphic_object **) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(mplib_object);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ mplib_aux_invalid_object_warning("object");
+ return NULL;
+}
+
+/*tex In the next array entry 0 is not used */
+
+static int mplib_values_type[mp_stop_bounds_code + 1] = { 0 };
+static int mplib_values_knot[6] = { 0 };
+
+static void mplib_aux_initialize_lua(lua_State *L)
+{
+ (void) L;
+ mplib_values_type[mp_fill_code] = lua_key_index(fill);
+ mplib_values_type[mp_stroked_code] = lua_key_index(outline);
+ mplib_values_type[mp_start_clip_code] = lua_key_index(start_clip);
+ mplib_values_type[mp_start_group_code] = lua_key_index(start_group);
+ mplib_values_type[mp_start_bounds_code] = lua_key_index(start_bounds);
+ mplib_values_type[mp_stop_clip_code] = lua_key_index(stop_clip);
+ mplib_values_type[mp_stop_group_code] = lua_key_index(stop_group);
+ mplib_values_type[mp_stop_bounds_code] = lua_key_index(stop_bounds);
+
+ mplib_values_knot[mp_endpoint_knot] = lua_key_index(endpoint);
+ mplib_values_knot[mp_explicit_knot] = lua_key_index(explicit);
+ mplib_values_knot[mp_given_knot] = lua_key_index(given);
+ mplib_values_knot[mp_curl_knot] = lua_key_index(curl);
+ mplib_values_knot[mp_open_knot] = lua_key_index(open);
+ mplib_values_knot[mp_end_cycle_knot] = lua_key_index(end_cycle);
+}
+
+static void mplib_aux_push_pentype(lua_State *L, mp_gr_knot h)
+{
+ if (h && h == h->next) {
+ lua_push_value_at_key(L, type, elliptical);
+ }
+}
+
+static int mplib_set_tolerance(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ mplib_aux_set_bend_tolerance(L, luaL_optnumber(L, 2, default_bend_tolerance));
+ mplib_aux_set_move_tolerance(L, luaL_optnumber(L, 3, default_move_tolerance));
+ }
+ return 0;
+}
+
+static int mplib_get_tolerance(lua_State *L)
+{
+
+ if (lua_type(L, 1) == LUA_TUSERDATA) {
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ lua_pushnumber(L, mplib_aux_get_bend_tolerance(L, 1));
+ lua_pushnumber(L, mplib_aux_get_move_tolerance(L, 1));
+ return 2;
+ } else {
+ return 0;
+ }
+ } else {
+ lua_pushnumber(L, default_bend_tolerance);
+ lua_pushnumber(L, default_move_tolerance);
+ return 2;
+ }
+}
+
+/*tex
+
+ We start by defining the needed callback routines for the library. We could store them per
+ instance but it has no advantages so that will be done when we feel the need.
+
+*/
+
+static int mplib_aux_register_function(lua_State *L, int old_id)
+{
+ if (! (lua_isfunction(L, -1) || lua_isnil(L, -1))) {
+ return 0;
+ } else {
+ lua_pushvalue(L, -1);
+ if (old_id) {
+ luaL_unref(L, LUA_REGISTRYINDEX, old_id);
+ }
+ return luaL_ref(L, LUA_REGISTRYINDEX); /*tex |new_id| */
+ }
+}
+
+static int mplib_aux_find_file_function(lua_State *L, MP_options *options)
+{
+ options->find_file_id = mplib_aux_register_function(L, options->find_file_id);
+ return (! options->find_file_id);
+}
+
+static int mplib_aux_run_script_function(lua_State *L, MP_options *options)
+{
+ options->run_script_id = mplib_aux_register_function(L, options->run_script_id);
+ return (! options->run_script_id);
+}
+
+static int mplib_aux_run_internal_function(lua_State *L, MP_options *options)
+{
+ options->run_internal_id = mplib_aux_register_function(L, options->run_internal_id);
+ return (! options->run_internal_id);
+}
+
+static int mplib_aux_make_text_function(lua_State *L, MP_options *options)
+{
+ options->make_text_id = mplib_aux_register_function(L, options->make_text_id);
+ return (! options->make_text_id);
+}
+
+static int mplib_aux_run_logger_function(lua_State *L, MP_options *options)
+{
+ options->run_logger_id = mplib_aux_register_function(L, options->run_logger_id);
+ return (! options->run_logger_id);
+}
+
+static int mplib_aux_run_overload_function(lua_State *L, MP_options *options)
+{
+ options->run_overload_id = mplib_aux_register_function(L, options->run_overload_id);
+ return (! options->run_overload_id);
+}
+
+static int mplib_aux_run_error_function(lua_State *L, MP_options *options)
+{
+ options->run_error_id = mplib_aux_register_function(L, options->run_error_id);
+ return (! options->run_error_id);
+}
+
+static int mplib_aux_open_file_function(lua_State *L, MP_options *options)
+{
+ options->open_file_id = mplib_aux_register_function(L, options->open_file_id);
+ return (! options->open_file_id);
+}
+
+static char *mplib_aux_find_file(MP mp, const char *fname, const char *fmode, int ftype)
+{
+ if (mp->find_file_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ char *s = NULL;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->find_file_id);
+ lua_pushstring(L, fname);
+ lua_pushstring(L, fmode);
+ if (ftype > mp_filetype_text) {
+ lua_pushinteger(L, (lua_Integer) ftype - mp_filetype_text);
+ } else {
+ lua_pushstring(L, mplib_filetype_names[ftype]);
+ }
+ ++mplib_state.file_callbacks;
+ if (lua_pcall(L, 3, 1, 0)) {
+ tex_formatted_warning("mplib", "find file: %s", lua_tostring(L, -1));
+ } else {
+ s = lmt_string_from_index(L, -1);
+ }
+ lua_settop(L, stacktop);
+ return s;
+ } else if (fmode[0] != 'r' || (! access(fname, R_OK)) || ftype) {
+ // return lmt_generic_strdup(fname);
+ return lmt_memory_strdup(fname);
+ }
+ return NULL;
+}
+
+/*
+
+ In retrospect we could have has a more granular approach: a flag that tells that the result is
+ a string to be scanned. Maybe I'll that anyway but it definitely means an adaption of the low
+ level interface we have in MetaFun. Also, the interface would be a bit ugly because then we
+ would like to handle values as in the 'whatever' function which in turn means a flag indicating
+ that a string is a string and not something to be scanned as tokens, and being compatible then
+ means that this flag comes after the string which kind of conflicts with multiple (number)
+ arguments ... in the end we gain too little to accept such an ugly mess as option. So, we stick
+ to:
+
+ -- nil : nothing is injected and no scanning will happen
+ -- string : passed on in order to be scanned
+ -- table : passed on concatenated in order to be scanned
+ -- number : injected as numeric (so no scanning later on)
+ -- boolean : injected as boolean (so no scanning later on)
+
+ and dealing with other datatypes is delegated to the injectors.
+
+*/
+
+static int mplib_aux_with_path(lua_State *L, MP mp, int index, int what, int multiple);
+
+static void mplib_aux_inject_whatever(lua_State *L, MP mp, int index)
+{
+ switch (lua_type(L, index)) {
+ case LUA_TBOOLEAN:
+ mp_push_boolean_value(mp, lua_toboolean(L, index));
+ break;
+ case LUA_TNUMBER:
+ mp_push_numeric_value(mp, lua_tonumber(L, index));
+ break;
+ case LUA_TSTRING:
+ {
+ size_t l;
+ const char *s = lua_tolstring(L, index, &l);
+ mp_push_string_value(mp, s, (int) l);
+ break;
+ }
+ case LUA_TTABLE:
+ {
+ if (lua_rawgeti(L, index, 1) == LUA_TTABLE) {
+ /* table of tables */
+ lua_pop(L, 1);
+ mplib_aux_with_path(L, mp, index, 1, 0);
+ } else {
+ lua_pop(L, 1);
+ switch (lua_rawlen(L, index)) {
+ case 2 :
+ mp_push_pair_value(mp,
+ lmt_number_from_table(L, index, 1, 0.0),
+ lmt_number_from_table(L, index, 2, 0.0)
+ );
+ break;
+ case 3 :
+ mp_push_color_value(mp,
+ lmt_number_from_table(L, index, 1, 0.0),
+ lmt_number_from_table(L, index, 2, 0.0),
+ lmt_number_from_table(L, index, 3, 0.0)
+ );
+ break;
+ case 4 :
+ mp_push_cmykcolor_value(mp,
+ lmt_number_from_table(L, index, 1, 0.0),
+ lmt_number_from_table(L, index, 2, 0.0),
+ lmt_number_from_table(L, index, 3, 0.0),
+ lmt_number_from_table(L, index, 4, 0.0)
+ );
+ break;
+ case 6 :
+ mp_push_transform_value(mp,
+ lmt_number_from_table(L, index, 1, 0.0),
+ lmt_number_from_table(L, index, 2, 0.0),
+ lmt_number_from_table(L, index, 3, 0.0),
+ lmt_number_from_table(L, index, 4, 0.0),
+ lmt_number_from_table(L, index, 5, 0.0),
+ lmt_number_from_table(L, index, 6, 0.0)
+ );
+ break;
+ }
+ }
+ break;
+ }
+ }
+}
+
+static char *mplib_aux_return_whatever(lua_State *L, MP mp, int index)
+{
+ switch (lua_type(L, index)) {
+ case LUA_TBOOLEAN:
+ mp_push_boolean_value(mp, lua_toboolean(L, index));
+ break;
+ case LUA_TNUMBER:
+ mp_push_numeric_value(mp, lua_tonumber(L, index));
+ break;
+ /* A string is passed to scantokens. */
+ case LUA_TSTRING:
+ return lmt_string_from_index(L, index);
+ /*tex A table is concatenated and passed to scantokens. */
+ case LUA_TTABLE:
+ {
+ luaL_Buffer b;
+ lua_Integer n = (lua_Integer) lua_rawlen(L, index);
+ luaL_buffinit(L, &b);
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_rawgeti(L, index, i);
+ luaL_addvalue(&b);
+ lua_pop(L, 1);
+ }
+ luaL_pushresult(&b);
+ return lmt_string_from_index(L, -1);
+ }
+ }
+ return NULL;
+}
+
+static char *mplib_aux_run_script(MP mp, const char *str, size_t len, int n)
+{
+ if (mp->run_script_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->run_script_id);
+ if (str) {
+ lua_pushlstring(L, str, len);
+ } else if (n > 0) {
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ ++mplib_state.script_callbacks;
+ if (lua_pcall(L, 1, 2, 0)) {
+ tex_formatted_warning("mplib", "run script: %s", lua_tostring(L, -1));
+ } else if (lua_toboolean(L, -1)) {
+ /* value boolean */
+ mplib_aux_inject_whatever(L, mp, -2);
+ lua_settop(L, stacktop);
+ return NULL;
+ } else {
+ /* value nil */
+ char *s = mplib_aux_return_whatever(L, mp, -2);
+ lua_settop(L, stacktop);
+ return s;
+ }
+ }
+ return NULL;
+}
+
+void mplib_aux_run_internal(MP mp, int action, int n, int type, const char *name)
+{
+ if (mp->run_internal_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ ++mplib_state.script_callbacks; /* maybe a special counter */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->run_internal_id);
+ lua_pushinteger(L, action); /* 0=initialize, 1=save, 2=restore */
+ lua_pushinteger(L, n);
+ if (name) {
+ lua_pushinteger(L, type);
+ lua_pushstring(L, name);
+ if (! lua_pcall(L, 4, 0, 0)) {
+ return;
+ }
+ } else {
+ if (lua_pcall(L, 2, 0, 0)) {
+ return;
+ }
+ }
+ tex_formatted_warning("mplib", "run internal: %s", lua_tostring(L, -1));
+ }
+}
+
+static char *mplib_aux_make_text(MP mp, const char *str, size_t len, int mode)
+{
+ if (mp->make_text_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ char *s = NULL;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->make_text_id);
+ lua_pushlstring(L, str, len);
+ lua_pushinteger(L, mode);
+ ++mplib_state.text_callbacks;
+ if (lua_pcall(L, 2, 1, 0)) {
+ tex_formatted_warning("mplib", "make text: %s", lua_tostring(L, -1));
+ } else {
+ s = lmt_string_from_index(L, -1);
+ }
+ lua_settop(L, stacktop);
+ return s;
+ }
+ return NULL;
+}
+
+static void mplib_aux_run_logger(MP mp, int target, const char *str, size_t len)
+{
+ if (mp->run_logger_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->run_logger_id);
+ lua_pushinteger(L, target);
+ lua_pushlstring(L, str, len);
+ ++mplib_state.log_callbacks;
+ if (lua_pcall(L, 2, 0, 0)) {
+ tex_formatted_warning("mplib", "run logger: %s", lua_tostring(L, -1));
+ }
+ lua_settop(L, stacktop);
+ }
+}
+
+static int mplib_aux_run_overload(MP mp, int property, const char *str, int mode)
+{
+ int quit = 0;
+ if (mp->run_overload_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->run_overload_id);
+ lua_pushinteger(L, property);
+ lua_pushstring(L, str);
+ lua_pushinteger(L, mode);
+ ++mplib_state.overload_callbacks;
+ if (lua_pcall(L, 3, 1, 0)) {
+ tex_formatted_warning("mplib", "run overload: %s", lua_tostring(L, -1));
+ quit = 1;
+ } else {
+ quit = lua_toboolean(L, -1);
+ }
+ lua_settop(L, stacktop);
+ }
+ return quit;
+}
+
+static void mplib_aux_run_error(MP mp, const char *str, const char *help, int interaction)
+{
+ if (mp->run_error_id) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->run_error_id);
+ lua_pushstring(L, str);
+ lua_pushstring(L, help);
+ lua_pushinteger(L, interaction);
+ ++mplib_state.error_callbacks;
+ if (lua_pcall(L, 3, 0, 0)) {
+ tex_formatted_warning("mplib", "run error: %s", lua_tostring(L, -1));
+ }
+ lua_settop(L, stacktop);
+ }
+}
+
+/*
+
+ We keep all management in Lua, so for now we don't create an object. Files are normally closed
+ anyway. We can always make it nicer. The opener has to return an integer. A value zero indicates
+ that no file is opened.
+
+*/
+
+/* index needs checking, no need for pointer (was old) */
+
+static void *mplib_aux_open_file(MP mp, const char *fname, const char *fmode, int ftype)
+{
+ if (mp->open_file_id) {
+ int *index = mp_memory_allocate(sizeof(int));
+ if (index) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mp->open_file_id);
+ lua_pushstring(L, fname);
+ lua_pushstring(L, fmode);
+ if (ftype > mp_filetype_text) {
+ lua_pushinteger(L, (lua_Integer) ftype - mp_filetype_text);
+ } else {
+ lua_pushstring(L, mplib_filetype_names[ftype]);
+ }
+ ++mplib_state.file_callbacks;
+ if (lua_pcall(L, 3, 1, 0)) {
+ *((int*) index) = 0;
+ } else if (lua_istable(L, -1)) {
+ lua_pushvalue(L, -1);
+ *((int*) index) = luaL_ref(L, LUA_REGISTRYINDEX);
+ } else {
+ tex_normal_warning("mplib", "open file: table expected");
+ *((int*) index) = 0;
+ }
+ lua_settop(L, stacktop);
+ return index;
+ }
+ }
+ return NULL;
+}
+
+# define mplib_pop_function(idx,tag) \
+ lua_rawgeti(L, LUA_REGISTRYINDEX, idx); \
+ lua_push_key(tag); \
+ lua_rawget(L, -2);
+
+static void mplib_aux_close_file(MP mp, void *index)
+{
+ if (mp->open_file_id && index) {
+ int idx = *((int*) index);
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ mplib_pop_function(idx, close)
+ if (lua_isfunction(L, -1)) {
+ ++mplib_state.file_callbacks;
+ if (lua_pcall(L, 0, 0, 0)) {
+ /* no message */
+ } else {
+ /* nothing to be done here */
+ }
+ }
+ /*
+ if (index) {
+ luaL_unref(L, idx));
+ }
+ */
+ lua_settop(L, stacktop);
+ mp_memory_free(index);
+ }
+}
+
+static char *mplib_aux_read_file(MP mp, void *index, size_t *size)
+{
+ if (mp->open_file_id && index) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ int idx = *((int*) index);
+ char *s = NULL;
+ mplib_pop_function(idx, reader)
+ if (lua_isfunction(L, -1)) {
+ ++mplib_state.file_callbacks;
+ if (lua_pcall(L, 0, 1, 0)) {
+ *size = 0;
+ } else if (lua_type(L, -1) == LUA_TSTRING) {
+ s = lmt_lstring_from_index(L, -1, size);
+ }
+ }
+ lua_settop(L, stacktop);
+ return s;
+ }
+ return NULL;
+}
+
+static void mplib_aux_write_file(MP mp, void *index, const char *s)
+{
+ if (mp->open_file_id && index) {
+ lua_State *L = (lua_State *) mp_userdata(mp);
+ int stacktop = lua_gettop(L);
+ int idx = *((int*) index);
+ mplib_pop_function(idx, writer)
+ if (lua_isfunction(L, -1)) {
+ lua_pushstring(L, s);
+ ++mplib_state.file_callbacks;
+ if (lua_pcall(L, 1, 0, 0)) {
+ /* no message */
+ } else {
+ /* nothing to be done here */
+ }
+ }
+ lua_settop(L, stacktop);
+ }
+}
+
+static int mplib_scan_next(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ int token = 0;
+ int mode = 0;
+ int kind = 0;
+ if (mp) {
+ int keep = 0 ;
+ if (lua_gettop(L) > 1) {
+ keep = lua_toboolean(L, 2);
+ }
+ mp_scan_next_value(mp, keep, &token, &mode, &kind);
+ }
+ lua_pushinteger(L, token);
+ lua_pushinteger(L, mode);
+ lua_pushinteger(L, kind);
+ return 3;
+}
+
+static int mplib_scan_expression(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ int kind = 0;
+ if (mp) {
+ int keep = 0 ;
+ if (lua_gettop(L) > 1) {
+ keep = lua_toboolean(L, 2);
+ }
+ mp_scan_expr_value(mp, keep, &kind);
+ }
+ lua_pushinteger(L, kind);
+ return 1;
+}
+
+static int mplib_scan_token(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ int token = 0;
+ int mode = 0;
+ int kind = 0;
+ if (mp) {
+ int keep = 0 ;
+ if (lua_gettop(L) > 1) {
+ keep = lua_toboolean(L, 2);
+ }
+ mp_scan_token_value(mp, keep, &token, &mode, &kind);
+ }
+ lua_pushinteger(L, token);
+ lua_pushinteger(L, mode);
+ lua_pushinteger(L, kind);
+ return 3;
+}
+
+static int mplib_skip_token(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ lua_pushboolean(L, mp ? mp_skip_token_value(mp, lmt_tointeger(L, 2)) : 0);
+ return 1;
+}
+
+static int mplib_scan_symbol(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ int keep = 0 ;
+ int expand = 1 ;
+ int top = lua_gettop(L) ;
+ char *s = NULL;
+ if (top > 2) { // no need to check
+ expand = lua_toboolean(L, 3);
+ }
+ if (top > 1) { // no need to check
+ keep = lua_toboolean(L, 2);
+ }
+ mp_scan_symbol_value(mp, keep, &s, expand) ;
+ if (s) {
+ /* we could do without the copy */
+ lua_pushstring(L, s);
+ mp_memory_free(s);
+ return 1;
+ }
+ }
+ lua_pushliteral(L,"");
+ return 1;
+}
+
+static int mplib_scan_property(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ int keep = 0 ;
+ int top = lua_gettop(L) ;
+ int type = 0 ;
+ int property = 0 ;
+ int detail = 0 ;
+ char *s = NULL;
+ if (top > 1) {
+ keep = lua_toboolean(L, 2);
+ }
+ mp_scan_property_value(mp, keep, &type, &s, &property, &detail);
+ if (s) {
+ lua_pushinteger(L, type);
+ lua_pushstring(L, s);
+ lua_pushinteger(L, property);
+ lua_pushinteger(L, detail);
+ mp_memory_free(s);
+ return 4;
+ }
+ }
+ return 0;
+}
+
+/*tex
+ A circle has 8 points and a square 4 so let's just start with 8 slots in the table.
+*/
+
+static int aux_is_curved_gr(mp_gr_knot ith, mp_gr_knot pth, lua_Number tolerance)
+{
+ lua_Number d = pth->left_x - ith->right_x;
+ if (fabs(ith->right_x - ith->x_coord - d) <= tolerance && fabs(pth->x_coord - pth->left_x - d) <= tolerance) {
+ d = pth->left_y - ith->right_y;
+ if (fabs(ith->right_y - ith->y_coord - d) <= tolerance && fabs(pth->y_coord - pth->left_y - d) <= tolerance) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static int aux_is_duplicate_gr(mp_gr_knot pth, mp_gr_knot nxt, lua_Number tolerance)
+{
+ return (fabs(pth->x_coord - nxt->x_coord) <= tolerance && fabs(pth->y_coord - nxt->y_coord) <= tolerance);
+}
+
+# define valid_knot_type(t) (t >= mp_endpoint_knot && t <= mp_end_cycle_knot) /* pens can act weird here */
+
+// -68.031485 2.83464 l
+// -68.031485 2.83464 -68.031485 -2.83464 -68.031485 -2.83464 c
+
+static void mplib_aux_push_path(lua_State *L, mp_gr_knot h, int ispen, lua_Number bendtolerance, lua_Number movetolerance)
+{
+ if (h) {
+ int i = 0;
+ mp_gr_knot p = h;
+ mp_gr_knot q = h;
+ int iscycle = 1;
+ lua_createtable(L, ispen ? 1 : MPLIB_PATH_SIZE, ispen ? 2 : 1);
+ do {
+ mp_gr_knot n = p->next;
+ int lt = p->left_type;
+ int rt = p->right_type;
+ if (ispen) {
+ lua_createtable(L, 0, 6);
+ // } else if (i > 0 && p != h && aux_is_duplicate_gr(p, n, movetolerance) && ! aux_is_curved_gr(p, n, bendtolerance) ) {
+ } else if (i > 0 && p != h && n != h && aux_is_duplicate_gr(p, n, movetolerance) && ! aux_is_curved_gr(p, n, bendtolerance) ) {
+ n->left_x = p->left_x;
+ n->left_y = p->left_y;
+ goto NEXTONE;
+ } else {
+ int ln = lt != mp_explicit_knot;
+ int rn = rt != mp_explicit_knot;
+ int ic = i > 0 && aux_is_curved_gr(q, p, bendtolerance);
+ int st = p->state;
+ lua_createtable(L, 0, 6 + (ic ? 1 : 0) + (ln ? 1 : 0) + (rn ? 1 : 0) + (st ? 1: 0));
+ if (ln && valid_knot_type(lt)) {
+ lua_push_svalue_at_key(L, left_type, mplib_values_knot[lt]);
+ }
+ if (rn && valid_knot_type(rt)) {
+ lua_push_svalue_at_key(L, right_type, mplib_values_knot[rt]);
+ }
+ if (ic) {
+ lua_push_boolean_at_key(L, curved, 1);
+ }
+ if (st) {
+ lua_push_integer_at_key(L, state, st);
+ }
+ lua_push_number_at_key(L, x_coord, p->x_coord);
+ lua_push_number_at_key(L, y_coord, p->y_coord);
+ lua_push_number_at_key(L, left_x, p->left_x);
+ lua_push_number_at_key(L, left_y, p->left_y);
+ lua_push_number_at_key(L, right_x, p->right_x);
+ lua_push_number_at_key(L, right_y, p->right_y);
+ lua_rawseti(L, -2, ++i);
+ if (rt == mp_endpoint_knot) {
+ iscycle = 0;
+ break;
+ }
+ }
+ NEXTONE:
+ q = p;
+ p = n;
+ } while (p && p != h);
+ if (iscycle && i > 1 && aux_is_curved_gr(q, h, bendtolerance)) {
+ lua_rawgeti(L, -1, 1);
+ lua_push_boolean_at_key(L, curved, 1);
+ lua_pop(L, 1);
+ }
+ if (ispen) {
+ lua_push_boolean_at_key(L, pen, 1);
+ }
+ lua_push_boolean_at_key(L, cycle, iscycle);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static int aux_is_curved(MP mp, mp_knot ith, mp_knot pth, lua_Number tolerance)
+{
+ lua_Number d = mp_number_as_double(mp, pth->left_x) - mp_number_as_double(mp, ith->right_x);
+ if (fabs(mp_number_as_double(mp, ith->right_x) - mp_number_as_double(mp, ith->x_coord) - d) <= tolerance && fabs(mp_number_as_double(mp, pth->x_coord) - mp_number_as_double(mp, pth->left_x) - d) <= tolerance) {
+ d = mp_number_as_double(mp, pth->left_y) - mp_number_as_double(mp, ith->right_y);
+ if (fabs(mp_number_as_double(mp, ith->right_y) - mp_number_as_double(mp, ith->y_coord) - d) <= tolerance && fabs(mp_number_as_double(mp, pth->y_coord) - mp_number_as_double(mp, pth->left_y) - d) <= tolerance) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static void aux_mplib_knot_to_path(lua_State *L, MP mp, mp_knot h, int ispen, int compact, int check, lua_Number bendtolerance) // maybe also movetolerance
+{
+ int i = 1;
+ mp_knot p = h;
+ mp_knot q = h;
+ int iscycle = 1;
+ lua_createtable(L, ispen ? 1 : MPLIB_PATH_SIZE, ispen ? 2 : 1);
+ if (compact) {
+ do {
+ lua_createtable(L, 2, 0);
+ lua_push_number_at_index(L, 1, mp_number_as_double(mp, p->x_coord));
+ lua_push_number_at_index(L, 2, mp_number_as_double(mp, p->y_coord));
+ lua_rawseti(L, -2, i++);
+ if (p->right_type == mp_endpoint_knot) {
+ iscycle = 0;
+ break;
+ } else {
+ p = p->next;
+ }
+ } while (p && p != h);
+ } else {
+ do {
+ int lt = p->left_type;
+ int rt = p->right_type;
+ int ln = lt != mp_explicit_knot;
+ int rn = rt != mp_explicit_knot;
+ int ic = check && (i > 1) && aux_is_curved(mp, q, p, bendtolerance);
+ lua_createtable(L, 0, 6 + (ic ? 1 : 0) + (ln ? 1 : 0) + (rn ? 1 : 0));
+ if (ln && valid_knot_type(lt)) {
+ lua_push_svalue_at_key(L, left_type, mplib_values_knot[lt]);
+ } else {
+ /* a pen */
+ }
+ if (rn && valid_knot_type(rt)) {
+ lua_push_svalue_at_key(L, right_type, mplib_values_knot[rt]);
+ } else {
+ /* a pen */
+ }
+ if (ic) {
+ lua_push_boolean_at_key(L, curved, 1);
+ }
+ lua_push_number_at_index(L, 1, mp_number_as_double(mp, p->x_coord));
+ lua_push_number_at_index(L, 2, mp_number_as_double(mp, p->y_coord));
+ lua_push_number_at_index(L, 3, mp_number_as_double(mp, p->left_x));
+ lua_push_number_at_index(L, 4, mp_number_as_double(mp, p->left_y));
+ lua_push_number_at_index(L, 5, mp_number_as_double(mp, p->right_x));
+ lua_push_number_at_index(L, 6, mp_number_as_double(mp, p->right_y));
+ lua_rawseti(L, -2, i++);
+ if (rt == mp_endpoint_knot) {
+ iscycle = 0;
+ break;
+ } else {
+ q = p;
+ p = p->next;
+ }
+ } while (p && p != h);
+ if (check && iscycle && i > 1 && aux_is_curved(mp, q, h, bendtolerance)) {
+ lua_rawgeti(L, -1, 1);
+ lua_push_boolean_at_key(L, curved, 1);
+ lua_pop(L, 1);
+ }
+ }
+ if (ispen) {
+ lua_push_boolean_at_key(L, pen, 1);
+ }
+ lua_push_boolean_at_key(L, cycle, iscycle);
+}
+
+/*tex
+
+ A couple of scanners. I know what I want to change but not now. First some longer term
+ experiments.
+
+*/
+
+# define push_number_in_slot(L,i,n) \
+ lua_pushnumber(L, n); \
+ lua_rawseti(L, -2, i);
+
+# define kind_of_expression(n) \
+ lmt_optinteger(L, n, 0)
+
+static int mplib_scan_string(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ char *s = NULL;
+ size_t l = 0;
+ mp_scan_string_value(mp, kind_of_expression(2), &s, &l) ;
+ if (s) {
+ lua_pushlstring(L, s, l);
+ return 1;
+ }
+ }
+ lua_pushliteral(L,"");
+ return 1;
+}
+
+static int mplib_scan_boolean(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ int b = 0;
+ if (mp) {
+ mp_scan_boolean_value(mp, kind_of_expression(2), &b);
+ }
+ lua_pushboolean(L, b);
+ return 1;
+}
+
+static int mplib_scan_numeric(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ double d = 0.0;
+ if (mp) {
+ mp_scan_numeric_value(mp, kind_of_expression(2), &d);
+ }
+ lua_pushnumber(L, d);
+ return 1;
+}
+
+static int mplib_scan_integer(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ double d = 0.0;
+ if (mp) {
+ mp_scan_numeric_value(mp, kind_of_expression(2), &d);
+ }
+ lua_pushinteger(L, (int) d); /* floored */
+ return 1;
+}
+
+static int mplib_scan_pair(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ double x = 0.0;
+ double y = 0.0;
+ if (mp) {
+ mp_scan_pair_value(mp, kind_of_expression(3), &x, &y);
+ }
+ if (lua_toboolean(L, 2)) {
+ lua_createtable(L, 2, 0);
+ push_number_in_slot(L, 1, x);
+ push_number_in_slot(L, 2, y);
+ return 1;
+ } else {
+ lua_pushnumber(L, x);
+ lua_pushnumber(L, y);
+ return 2;
+ }
+}
+
+static int mplib_scan_color(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ double r = 0.0;
+ double g = 0.0;
+ double b = 0.0;
+ if (mp) {
+ mp_scan_color_value(mp, kind_of_expression(3), &r, &g, &b);
+ }
+ if (lua_toboolean(L, 2)) {
+ lua_createtable(L, 3, 0);
+ push_number_in_slot(L, 1, r);
+ push_number_in_slot(L, 2, g);
+ push_number_in_slot(L, 3, b);
+ return 1;
+ } else {
+ lua_pushnumber(L, r);
+ lua_pushnumber(L, g);
+ lua_pushnumber(L, b);
+ return 3;
+ }
+}
+
+static int mplib_scan_cmykcolor(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ double c = 0.0;
+ double m = 0.0;
+ double y = 0.0;
+ double k = 0.0;
+ if (mp) {
+ mp_scan_cmykcolor_value(mp, kind_of_expression(3), &c, &m, &y, &k);
+ }
+ if (lua_toboolean(L, 2)) {
+ lua_createtable(L, 4, 0);
+ push_number_in_slot(L, 1, c);
+ push_number_in_slot(L, 2, m);
+ push_number_in_slot(L, 3, y);
+ push_number_in_slot(L, 4, k);
+ return 1;
+ } else {
+ lua_pushnumber(L, c);
+ lua_pushnumber(L, m);
+ lua_pushnumber(L, y);
+ lua_pushnumber(L, k);
+ return 4;
+ }
+}
+
+static int mplib_scan_transform(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ double x = 0.0;
+ double y = 0.0;
+ double xx = 0.0;
+ double xy = 0.0;
+ double yx = 0.0;
+ double yy = 0.0;
+ if (mp) {
+ mp_scan_transform_value(mp, kind_of_expression(3), &x, &y, &xx, &xy, &yx, &yy);
+ }
+ if (lua_toboolean(L, 2)) {
+ lua_createtable(L, 6, 0);
+ push_number_in_slot(L, 1, x);
+ push_number_in_slot(L, 2, y);
+ push_number_in_slot(L, 3, xx);
+ push_number_in_slot(L, 4, xy);
+ push_number_in_slot(L, 5, yx);
+ push_number_in_slot(L, 6, yy);
+ return 1;
+ } else {
+ lua_pushnumber(L, x);
+ lua_pushnumber(L, y);
+ lua_pushnumber(L, xx);
+ lua_pushnumber(L, xy);
+ lua_pushnumber(L, yx);
+ lua_pushnumber(L, yy);
+ return 6;
+ }
+}
+
+static int mplib_scan_path(lua_State *L) /* 1=mp 2=compact 3=kind(prim) 4=check */
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ mp_knot p = NULL;
+ lua_Number t = mplib_aux_get_bend_tolerance(L, 1); /* iuservalue */
+ mp_scan_path_value(mp, kind_of_expression(3), &p);
+ if (p) {
+ aux_mplib_knot_to_path(L, mp, p, 0, lua_toboolean(L, 2), lua_toboolean(L, 4), t);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int mplib_scan_pen(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ mp_knot p = NULL ;
+ lua_Number t = mplib_aux_get_bend_tolerance(L, 1);
+ mp_scan_path_value(mp, kind_of_expression(3), &p) ;
+ if (p) {
+ aux_mplib_knot_to_path(L, mp, p, 1, lua_toboolean(L, 2), lua_toboolean(L, 4), t);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int mplib_inject_string(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ size_t l = 0;
+ const char *s = lua_tolstring(L, 2, &l);
+ mp_push_string_value(mp, s, (int) l);
+ }
+ return 0;
+}
+
+static int mplib_inject_boolean(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ int b = lua_toboolean(L, 2);
+ mp_push_boolean_value(mp, b);
+ }
+ return 0;
+}
+
+static int mplib_inject_numeric(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ double d = lua_tonumber(L, 2);
+ mp_push_numeric_value(mp, d);
+ }
+ return 0;
+}
+
+static int mplib_inject_integer(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ int i = lmt_tointeger(L, 2);
+ mp_push_integer_value(mp, i);
+ }
+ return 0;
+}
+
+static int mplib_inject_pair(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ mp_push_pair_value(mp,
+ luaL_optnumber(L, 2, 0),
+ luaL_optnumber(L, 3, 0)
+ );
+ break;
+ case LUA_TTABLE:
+ mp_push_pair_value(mp,
+ lmt_number_from_table(L, 2, 1, 0.0),
+ lmt_number_from_table(L, 2, 2, 0.0)
+ );
+ break;
+ }
+ }
+ return 0;
+}
+
+static int mplib_inject_color(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ mp_push_color_value(mp,
+ luaL_optnumber(L, 2, 0),
+ luaL_optnumber(L, 3, 0),
+ luaL_optnumber(L, 4, 0)
+ );
+ break;
+ case LUA_TTABLE:
+ mp_push_color_value(mp,
+ lmt_number_from_table(L, 2, 1, 0.0),
+ lmt_number_from_table(L, 2, 2, 0.0),
+ lmt_number_from_table(L, 2, 3, 0.0)
+ );
+ break;
+ }
+ }
+ return 0;
+}
+
+static int mplib_inject_cmykcolor(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ mp_push_cmykcolor_value(mp,
+ luaL_optnumber(L, 2, 0),
+ luaL_optnumber(L, 3, 0),
+ luaL_optnumber(L, 4, 0),
+ luaL_optnumber(L, 5, 0)
+ );
+ break;
+ case LUA_TTABLE:
+ mp_push_cmykcolor_value(mp,
+ lmt_number_from_table(L, 2, 1, 0.0),
+ lmt_number_from_table(L, 2, 2, 0.0),
+ lmt_number_from_table(L, 2, 3, 0.0),
+ lmt_number_from_table(L, 2, 4, 0.0)
+ );
+ break;
+ }
+ }
+ return 0;
+}
+
+static int mplib_inject_transform(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ mp_push_transform_value(mp,
+ luaL_optnumber(L, 2, 0), // 1
+ luaL_optnumber(L, 3, 0),
+ luaL_optnumber(L, 4, 0),
+ luaL_optnumber(L, 5, 0), // 1
+ luaL_optnumber(L, 6, 0),
+ luaL_optnumber(L, 7, 0)
+ );
+ break;
+ case LUA_TTABLE:
+ mp_push_transform_value(mp,
+ lmt_number_from_table(L, 2, 1, 0.0), // 1.0
+ lmt_number_from_table(L, 2, 2, 0.0),
+ lmt_number_from_table(L, 2, 3, 0.0),
+ lmt_number_from_table(L, 2, 4, 0.0), // 1.0
+ lmt_number_from_table(L, 2, 5, 0.0),
+ lmt_number_from_table(L, 2, 6, 0.0)
+ );
+ break;
+ }
+ }
+ return 0;
+}
+
+static int mplib_new(lua_State *L)
+{
+ MP *mpud = lua_newuserdatauv(L, sizeof(MP *), 2);
+ if (mpud) {
+ MP mp = NULL;
+ struct MP_options *options = mp_options();
+ lua_Number bendtolerance = default_bend_tolerance;
+ lua_Number movetolerance = default_move_tolerance;
+ options->userdata = (void *) L;
+ options->job_name = NULL;
+ options->extensions = 0 ;
+ options->utf8_mode = 0;
+ options->text_mode = 0;
+ options->show_mode = 0;
+ options->halt_on_error = 0;
+ options->find_file = mplib_aux_find_file;
+ options->run_script = mplib_aux_run_script;
+ options->run_internal = mplib_aux_run_internal;
+ options->run_logger = mplib_aux_run_logger;
+ options->run_overload = mplib_aux_run_overload;
+ options->run_error = mplib_aux_run_error;
+ options->make_text = mplib_aux_make_text;
+ options->open_file = mplib_aux_open_file;
+ options->close_file = mplib_aux_close_file;
+ options->read_file = mplib_aux_read_file;
+ options->write_file = mplib_aux_write_file;
+ options->shipout_backend = mplib_shipout_backend;
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ lua_pushnil(L);
+ while (lua_next(L, 1)) {
+ if (lua_type(L, -2) == LUA_TSTRING) {
+ const char *s = lua_tostring(L, -2);
+ if (lua_key_eq(s, random_seed)) {
+ options->random_seed = (int) lua_tointeger(L, -1);
+ } else if (lua_key_eq(s, interaction)) {
+ options->interaction = luaL_checkoption(L, -1, "silent", mplib_interaction_options);
+ } else if (lua_key_eq(s, job_name)) {
+ // options->job_name = lmt_generic_strdup(lua_tostring(L, -1));
+ options->job_name = lmt_memory_strdup(lua_tostring(L, -1));
+ } else if (lua_key_eq(s, find_file)) {
+ if (mplib_aux_find_file_function(L, options)) {
+ tex_normal_warning("mplib", "find file: function expected");
+ }
+ } else if (lua_key_eq(s, run_script)) {
+ if (mplib_aux_run_script_function(L, options)) {
+ tex_normal_warning("mplib", "run script: function expected");
+ }
+ } else if (lua_key_eq(s, run_internal)) {
+ if (mplib_aux_run_internal_function(L, options)) {
+ tex_normal_warning("mplib", "run internal: function expected");
+ }
+ } else if (lua_key_eq(s, make_text)) {
+ if (mplib_aux_make_text_function(L, options)) {
+ tex_normal_warning("mplib", "make text: function expected");
+ }
+ } else if (lua_key_eq(s, extensions)) {
+ options->extensions = (int) lua_tointeger(L, -1);
+ } else if (lua_key_eq(s, math_mode)) {
+ options->math_mode = luaL_checkoption(L, -1, "scaled", mplib_math_options);
+ } else if (lua_key_eq(s, utf8_mode)) {
+ options->utf8_mode = (int) lua_toboolean(L, -1);
+ } else if (lua_key_eq(s, text_mode)) {
+ options->text_mode = (int) lua_toboolean(L, -1);
+ } else if (lua_key_eq(s, show_mode)) {
+ options->show_mode = (int) lua_toboolean(L, -1);
+ } else if (lua_key_eq(s, halt_on_error)) {
+ options->halt_on_error = (int) lua_toboolean(L, -1);
+ } else if (lua_key_eq(s, run_logger)) {
+ if (mplib_aux_run_logger_function(L, options)) {
+ tex_normal_warning("mplib", "run logger: function expected");
+ }
+ } else if (lua_key_eq(s, run_overload)) {
+ if (mplib_aux_run_overload_function(L, options)) {
+ tex_normal_warning("mplib", "run overload: function expected");
+ }
+ } else if (lua_key_eq(s, run_error)) {
+ if (mplib_aux_run_error_function(L, options)) {
+ tex_normal_warning("mplib", "run error: function expected");
+ }
+ } else if (lua_key_eq(s, open_file)) {
+ if (mplib_aux_open_file_function(L, options)) {
+ tex_normal_warning("mplib", "open file: function expected");
+ }
+ } else if (lua_key_eq(s, bend_tolerance)) {
+ bendtolerance = lua_tonumber(L, -1);
+ } else if (lua_key_eq(s, move_tolerance)) {
+ movetolerance = lua_tonumber(L, -1);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ }
+ if (! options->job_name || ! *(options->job_name)) {
+ mp_memory_free(options); /* leaks */
+ tex_normal_warning("mplib", "job_name is not set");
+ goto BAD;
+ }
+ mp = mp_initialize(options);
+ mp_memory_free(options); /* leaks */
+ if (mp) {
+ *mpud = mp;
+ mplib_aux_set_bend_tolerance(L, bendtolerance);
+ mplib_aux_set_move_tolerance(L, movetolerance);
+ luaL_getmetatable(L, MP_METATABLE_INSTANCE);
+ lua_setmetatable(L, -2);
+ return 1;
+ }
+ }
+ BAD:
+ lua_pushnil(L);
+ return 1;
+}
+
+# define mplib_collect_id(id) do { \
+ if (id) { \
+ luaL_unref(L, LUA_REGISTRYINDEX, id); \
+ } \
+} while(0)
+
+static int mplib_instance_collect(lua_State *L)
+{
+ MP *mpud = mplib_aux_is_mpud(L, 1);
+ if (*mpud) {
+ MP mp = *mpud;
+ int run_logger_id = (mp)->run_logger_id;
+ mplib_collect_id((mp)->find_file_id);
+ mplib_collect_id((mp)->run_script_id);
+ mplib_collect_id((mp)->run_internal_id);
+ mplib_collect_id((mp)->run_overload_id);
+ mplib_collect_id((mp)->run_error_id);
+ mplib_collect_id((mp)->make_text_id);
+ mplib_collect_id((mp)->open_file_id);
+ mp_finish(mp);
+ *mpud = NULL;
+ mplib_collect_id(run_logger_id);
+ }
+ return 0;
+}
+
+static int mplib_instance_tostring(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ lua_pushfstring(L, "<mp.instance %p>", mp);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_aux_wrapresults(lua_State *L, mp_run_data *res, int status, lua_Number bendtolerance, lua_Number movetolerance)
+{
+ lua_newtable(L);
+ if (res->edges) {
+ struct mp_edge_object *p = res->edges;
+ int i = 1;
+ lua_push_key(fig);
+ lua_newtable(L);
+ while (p) {
+ struct mp_edge_object **v = lua_newuserdatauv(L, sizeof(struct mp_edge_object *), 2);
+ *v = p;
+ mplib_aux_set_bend_tolerance(L, bendtolerance);
+ mplib_aux_set_move_tolerance(L, movetolerance);
+ luaL_getmetatable(L, MP_METATABLE_FIGURE);
+ lua_setmetatable(L, -2);
+ lua_rawseti(L, -2, i);
+ i++;
+ p = p->next;
+ }
+ lua_rawset(L,-3);
+ res->edges = NULL;
+ }
+ lua_push_integer_at_key(L, status, status);
+ return 1;
+}
+
+static int mplib_execute(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ /* no string in slot 2 or an empty string means that we already filled the terminal */
+ size_t l = 0;
+ lua_Number bendtolerance = mplib_aux_get_bend_tolerance(L, 1);
+ lua_Number movetolerance = mplib_aux_get_move_tolerance(L, 1);
+ const char *s = lua_isstring(L, 2) ? lua_tolstring(L, 2, &l) : NULL;
+ int h = mp_execute(mp, s, l);
+ mp_run_data *res = mp_rundata(mp);
+ return mplib_aux_wrapresults(L, res, h, bendtolerance, movetolerance);
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int mplib_finish(lua_State *L)
+{
+ MP *mpud = mplib_aux_is_mpud(L, 1);
+ if (*mpud) {
+ MP mp = *mpud;
+ lua_Number bendtolerance = mplib_aux_get_bend_tolerance(L, 1);
+ lua_Number movetolerance = mplib_aux_get_move_tolerance(L, 1);
+ int h = mp_execute(mp, NULL, 0);
+ mp_run_data *res = mp_rundata(mp);
+ int i = mplib_aux_wrapresults(L, res, h, bendtolerance, movetolerance);
+ mp_finish(mp);
+ *mpud = NULL;
+ return i;
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_showcontext(lua_State *L)
+{
+ MP *mpud = mplib_aux_is_mpud(L, 1);
+ if (*mpud) {
+ MP mp = *mpud;
+ mp_show_context(mp);
+ }
+ return 0;
+}
+
+static int mplib_gethashentry(lua_State *L)
+{
+ MP *mpud = mplib_aux_is_mpud(L, 1);
+ if (*mpud) {
+ MP mp = *mpud;
+ char *name = (char *) lua_tostring(L, 2);
+ if (name) {
+ mp_symbol_entry *s = (mp_symbol_entry *) mp_fetch_symbol(mp, name);
+ if (s) {
+ mp_node q = s->type == mp_tag_command ? s->v.data.node : NULL;
+ lua_pushinteger(L, s->type);
+ lua_pushinteger(L, s->property);
+ if (q) {
+ lua_pushinteger(L, q->type);
+ return 3;
+ } else {
+ return 2;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static int mplib_gethashentries(lua_State *L)
+{
+ MP *mpud = mplib_aux_is_mpud(L, 1);
+ if (*mpud) {
+ MP mp = *mpud;
+ int full = lua_toboolean(L, 2);
+ if (mp_initialize_symbol_traverse(mp)) {
+ size_t n = 0;
+ lua_newtable(L);
+ while (1) {
+ mp_symbol_entry *s = (mp_symbol_entry *) mp_fetch_symbol_traverse(mp);
+ if (s) {
+ if (full) {
+ mp_node q = s->type == mp_tag_command ? s->v.data.node : NULL;
+ lua_createtable(L, (q || s->property == 0x1) ? 4 : 3, 0);
+ lua_pushinteger(L, s->type);
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, s->property);
+ lua_rawseti(L, -2, 2);
+ lua_pushlstring(L, (const char *) s->text->str, s->text->len);
+ lua_rawseti(L, -2, 3);
+ if (q) {
+ lua_pushinteger(L, q->type);
+ lua_rawseti(L, -2, 4);
+ } else if (s->property == 0x1) {
+ lua_pushinteger(L, s->v.data.indep.serial);
+ lua_rawseti(L, -2, 4);
+ }
+ } else {
+ lua_pushlstring(L, (const char *) s->text->str, s->text->len);
+ }
+ lua_rawseti(L, -2, ++n);
+ } else {
+ break;
+ }
+ }
+ mp_kill_symbol_traverse(mp);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int mplib_version(lua_State *L)
+{
+ char *s = mp_metapost_version();
+ lua_pushstring(L, s);
+ mp_memory_free(s);
+ return 1;
+}
+
+static int mplib_getstatistics(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ lua_createtable(L, 0, 9);
+ lua_push_integer_at_key(L, memory, mp->var_used); /* bytes of node memory */
+ lua_push_integer_at_key(L, hash, mp->st_count);
+ lua_push_integer_at_key(L, parameters, mp->max_param_stack); /* allocated: mp->param_size */
+ lua_push_integer_at_key(L, input, mp->max_in_stack); /* allocated: mp->stack_size */
+ lua_push_integer_at_key(L, tokens, mp->num_token_nodes);
+ lua_push_integer_at_key(L, pairs, mp->num_pair_nodes);
+ lua_push_integer_at_key(L, knots, mp->num_knot_nodes);
+ lua_push_integer_at_key(L, nodes, mp->num_value_nodes);
+ lua_push_integer_at_key(L, symbols, mp->num_symbolic_nodes);
+ lua_push_integer_at_key(L, characters, mp->max_pl_used);
+ lua_push_integer_at_key(L, strings, mp->max_strs_used);
+ lua_push_integer_at_key(L, internals, mp->int_ptr); /* allocates: mp->max_internal */
+ /* lua_push_integer_at_key(L, buffer, mp->max_buf_stack + 1); */ /* allocated: mp->buf_size */
+ /* lua_push_integer_at_key(L, open, mp->in_open_max - file_bottom); */ /* allocated: mp->max_in_open - file_bottom */
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_getstatus(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ lua_pushinteger(L, mp->scanner_status);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int mplib_aux_set_direction(lua_State *L, MP mp, mp_knot p) {
+ double direction_x = (double) lua_tonumber(L, -1);
+ double direction_y = 0;
+ lua_pop(L, 1);
+ lua_push_key(direction_y);
+ if (lua_rawget(L, -2) == LUA_TNUMBER) {
+ direction_y = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_direction(mp, p, direction_x, direction_y) ? 1 : 0;
+ } else {
+ return 0;
+ }
+}
+
+static int mplib_aux_set_left_curl(lua_State *L, MP mp, mp_knot p) {
+ double curl = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_left_curl(mp, p, curl) ? 1 : 0;
+}
+
+static int mplib_aux_set_left_tension(lua_State *L, MP mp, mp_knot p) {
+ double tension = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_left_tension(mp, p, tension) ? 1 : 0;
+}
+
+static int mplib_aux_set_left_control(lua_State *L, MP mp, mp_knot p) {
+ double x = (double) lua_tonumber(L, -1);
+ double y = 0;
+ lua_pop(L, 1);
+ lua_push_key(left_y);
+ if (lua_rawget(L, -2) == LUA_TNUMBER) {
+ y = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_left_control(mp, p, x, y) ? 1 : 0;
+ } else {
+ return 0;
+ }
+}
+
+static int mplib_aux_set_right_curl(lua_State *L, MP mp, mp_knot p) {
+ double curl = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_right_curl(mp, p, curl) ? 1 : 0;
+}
+
+static int mplib_aux_set_right_tension(lua_State *L, MP mp, mp_knot p) {
+ double tension = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_right_tension(mp, p, tension) ? 1 : 0;
+}
+
+static int mplib_aux_set_right_control(lua_State *L, MP mp, mp_knot p) {
+ double x = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ lua_push_key(right_y);
+ if (lua_rawget(L, -2) == LUA_TNUMBER) {
+ double y = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ return mp_set_knot_right_control(mp, p, x, y) ? 1 : 0;
+ } else {
+ return 0;
+ }
+}
+
+static int mplib_aux_with_path(lua_State *L, MP mp, int index, int inject, int multiple)
+{
+ // setbuf(stdout, NULL);
+ if (! mp) {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "valid instance expected");
+ return 2;
+ } else if (! lua_istable(L, index) || lua_rawlen(L, index) <= 0) {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "non empty table expected");
+ return 2;
+ } else {
+ mp_knot p = NULL;
+ mp_knot q = NULL;
+ mp_knot first = NULL;
+ const char *errormsg = NULL;
+ int cyclic = 0;
+ int curled = 0;
+ int solve = 0;
+ int numpoints = (int) lua_rawlen(L, index);
+ /*tex
+ As a bonus we check for two keys. When an index is negative we come from the
+ callback in which case we definitely cannot check the rest of the arguments.
+ */
+ if (multiple && lua_type(L, index + 1) == LUA_TBOOLEAN) {
+ cyclic = lua_toboolean(L, index + 1);
+ } else {
+ lua_push_key(close);
+ if (lua_rawget(L, index - 1) == LUA_TBOOLEAN) {
+ cyclic = lua_toboolean(L, -1);
+ }
+ lua_pop(L, 1);
+ lua_push_key(cycle); /* wins */
+ if (lua_rawget(L, index - 1) == LUA_TBOOLEAN) {
+ cyclic = lua_toboolean(L, -1);
+ }
+ lua_pop(L, 1);
+ }
+ if (multiple && lua_type(L, index + 2) == LUA_TBOOLEAN) {
+ curled = lua_toboolean(L, index + 2);
+ } else {
+ lua_push_key(curled);
+ if (lua_rawget(L, index - 1) == LUA_TBOOLEAN) {
+ curled = lua_toboolean(L, -1);
+ }
+ lua_pop(L, 1);
+ }
+ /*tex We build up the path. */
+ if (lua_rawgeti(L, index, 1) == LUA_TTABLE) {
+ lua_Unsigned len = lua_rawlen(L, -1);
+ lua_pop(L, 1);
+ if (len >= 2) {
+ /* .. : p1 .. controls a and b .. p2 : { p1 a b } */
+ /* -- : p1 .. { curl 1 } .. { curl 1 } .. p2 : { p1 nil nil } */
+ for (int i = 1; i <= numpoints; i++) {
+ if (lua_rawgeti(L, index, i) == LUA_TTABLE) {
+ double x0, y0;
+ lua_rawgeti(L, -1, 1);
+ lua_rawgeti(L, -2, 2);
+ x0 = lua_tonumber(L, -2);
+ y0 = lua_tonumber(L, -1);
+ q = p;
+ p = mp_append_knot_xy(mp, p, x0, y0); /* makes end point */
+ lua_pop(L, 2);
+ if (p) {
+ double x1, y1, x2, y2;
+ if (curled) {
+ x1 = x0;
+ y1 = y0;
+ x2 = x0;
+ y2 = y0;
+ } else {
+ lua_rawgeti(L, -1, 3);
+ lua_rawgeti(L, -2, 4);
+ lua_rawgeti(L, -3, 5);
+ lua_rawgeti(L, -4, 6);
+ x1 = luaL_optnumber(L, -4, x0);
+ y1 = luaL_optnumber(L, -3, y0);
+ x2 = luaL_optnumber(L, -2, x0);
+ y2 = luaL_optnumber(L, -1, y0);
+ lua_pop(L, 4);
+ }
+ mp_set_knot_left_control(mp, p, x1, y1);
+ mp_set_knot_right_control(mp, p, x2, y2);
+ if (! first) {
+ first = p;
+ }
+ } else {
+ errormsg = "knot creation failure";
+ goto BAD;
+ }
+ }
+ /*tex Up the next item */
+ lua_pop(L, 1);
+ }
+ } else if (len > 0) {
+ errormsg = "messy table";
+ goto BAD;
+ } else {
+ for (int i = 1; i <= numpoints; i++) {
+ if (lua_rawgeti(L, index, i) == LUA_TTABLE) {
+ /* We can probably also use the _xy here. */
+ int left_set = 0;
+ int right_set = 0;
+ double x_coord, y_coord;
+ if (! lua_istable(L, -1)) {
+ errormsg = "wrong argument types";
+ goto BAD;
+ }
+ lua_push_key(x_coord);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ errormsg = "missing x coordinate";
+ goto BAD;
+ }
+ x_coord = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ lua_push_key(y_coord);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ errormsg = "missing y coordinate";
+ goto BAD;
+ }
+ y_coord = (double) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ /* */
+ q = p;
+ if (q) {
+ /*tex
+ We have to save the right_tension because |mp_append_knot| trashes it,
+ believing that it is as yet uninitialized .. I need to check this.
+ */
+ double saved_tension = mp_number_as_double(mp, p->right_tension);
+ p = mp_append_knot(mp, p, x_coord, y_coord);
+ if (p) {
+ mp_set_knot_right_tension(mp, q, saved_tension);
+ }
+ } else {
+ p = mp_append_knot(mp, p, x_coord, y_coord);
+ }
+ if (p) {
+ errormsg = "knot creation failure";
+ goto BAD;
+ }
+ /* */
+ if (! first) {
+ first = p;
+ }
+ lua_push_key(left_curl);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L, 1);
+ } else if (! mplib_aux_set_left_curl(L, mp, p)) {
+ errormsg = "failed to set left curl";
+ goto BAD;
+ } else {
+ left_set = 1;
+ solve = 1;
+ }
+ lua_push_key(left_tension);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L, 1);
+ } else if (left_set) {
+ errormsg = "left side already set";
+ goto BAD;
+ } else if (! mplib_aux_set_left_tension(L, mp, p)) {
+ errormsg = "failed to set left tension";
+ goto BAD;
+ } else {
+ left_set = 1;
+ solve = 1;
+ }
+ lua_push_key(left_x);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L, 1);
+ } else if (left_set) {
+ errormsg = "left side already set";
+ goto BAD;
+ } else if (! mplib_aux_set_left_control(L, mp, p)) {
+ errormsg = "failed to set left control";
+ goto BAD;
+ }
+ lua_push_key(right_curl);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L, 1);
+ } else if (! mplib_aux_set_right_curl(L, mp, p)) {
+ errormsg = "failed to set right curl";
+ goto BAD;
+ } else {
+ right_set = 1;
+ solve = 1;
+ }
+ lua_push_key(right_tension);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L,1);
+ } else if (right_set) {
+ errormsg = "right side already set";
+ goto BAD;
+ } else if (! mplib_aux_set_right_tension(L, mp, p)) {
+ errormsg = "failed to set right tension";
+ goto BAD;
+ } else {
+ right_set = 1;
+ solve = 1;
+ }
+ lua_push_key(right_x);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L, 1);
+ } else if (right_set) {
+ errormsg = "right side already set";
+ goto BAD;
+ } else if (! mplib_aux_set_right_control(L, mp, p)) {
+ errormsg = "failed to set right control";
+ goto BAD;
+ }
+ lua_push_key(direction_x);
+ if (lua_rawget(L, -2) != LUA_TNUMBER) {
+ lua_pop(L, 1);
+ } else if (! mplib_aux_set_direction(L, mp, p)) {
+ errormsg = "failed to set direction";
+ goto BAD;
+ }
+ }
+ lua_pop(L, 1);
+ }
+ }
+ }
+ if (first && p) {
+ /* not: mp_close_path(mp, p, first); */
+ if (cyclic) {
+ p->right_type = mp_explicit_knot;
+ first->left_type = mp_explicit_knot;
+ } else {
+ /* check this on shapes-001.tex and arrows-001.tex */
+ p->right_type = mp_endpoint_knot;
+ first->left_type = mp_endpoint_knot;
+ }
+ p->next = first;
+ if (inject) {
+ if (solve && ! mp_solve_path(mp, first)) {
+ tex_normal_warning("lua", "failed to solve the path");
+ }
+ mp_push_path_value(mp, first);
+ return 0;
+ } else {
+ /*tex We're finished reading arguments so we squeeze the new values back into the table. */
+ if (! mp_solve_path(mp, first)) {
+ errormsg = "failed to solve the path";
+ } else {
+ /* We replace in the original table .. maybe not a good idea at all. */
+ p = first;
+ for (int i = 1; i <= numpoints; i++) {
+ lua_rawgeti(L, -1, i);
+ lua_push_number_at_key(L, left_x, mp_number_as_double(mp, p->left_x));
+ lua_push_number_at_key(L, left_y, mp_number_as_double(mp, p->left_y));
+ lua_push_number_at_key(L, right_x, mp_number_as_double(mp, p->right_x));
+ lua_push_number_at_key(L, right_y, mp_number_as_double(mp, p->right_y));
+ /*tex This is a bit overkill, wiping \unknown */
+ lua_push_nil_at_key(L, left_tension);
+ lua_push_nil_at_key(L, right_tension);
+ lua_push_nil_at_key(L, left_curl);
+ lua_push_nil_at_key(L, right_curl);
+ lua_push_nil_at_key(L, direction_x);
+ lua_push_nil_at_key(L, direction_y);
+ /*tex \unknown\ till here. */
+ lua_push_svalue_at_key(L, left_type, mplib_values_knot[p->left_type]);
+ lua_push_svalue_at_key(L, right_type, mplib_values_knot[p->right_type]);
+ lua_pop(L, 1);
+ p = p->next;
+ }
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ }
+ } else {
+ errormsg = "invalid path";
+ }
+ BAD:
+ if (p) {
+ mp_free_path(mp, p);
+ }
+ lua_pushboolean(L, 0);
+ if (errormsg) {
+ lua_pushstring(L, errormsg);
+ return 2;
+ } else {
+ return 1;
+ }
+ }
+}
+
+static int mplib_solvepath(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ return mplib_aux_with_path(L, mp, 2, 0, 1);
+ } else {
+ return 0;
+ }
+}
+
+static int mplib_inject_path(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ return mplib_aux_with_path(L, mp, 2, 1, 1);
+ } else {
+ return 0;
+ }
+}
+
+static int mplib_inject_whatever(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ mplib_aux_inject_whatever(L, mp, 2);
+ }
+ return 0;
+}
+
+/*tex The next methods are for collecting the results from |fig|. */
+
+static int mplib_figure_collect(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ mp_gr_toss_objects(*hh);
+ *hh = NULL;
+ }
+ return 0;
+}
+
+static int mplib_figure_objects(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ int i = 1;
+ struct mp_graphic_object *p = (*hh)->body;
+ lua_Number bendtolerance = mplib_aux_get_bend_tolerance(L, 1);
+ lua_Number movetolerance = mplib_aux_get_move_tolerance(L, 1);
+ lua_newtable(L);
+ while (p) {
+ struct mp_graphic_object **v = lua_newuserdatauv(L, sizeof(struct mp_graphic_object *), 2);
+ *v = p;
+ mplib_aux_set_bend_tolerance(L, bendtolerance);
+ mplib_aux_set_move_tolerance(L, movetolerance);
+ luaL_getmetatable(L, MP_METATABLE_OBJECT);
+ lua_setmetatable(L, -2);
+ lua_rawseti(L, -2, i);
+ i++;
+ p = p->next;
+ }
+ /*tex Prevent a double free: */
+ (*hh)->body = NULL;
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_stacking(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ int stacking = 0; /* This only works when before fetching objects! */
+ if (*hh) {
+ struct mp_graphic_object *p = (*hh)->body;
+ while (p) {
+ if (((mp_shape_object *) p)->stacking) {
+ stacking = 1;
+ break;
+ } else {
+ p = p->next;
+ }
+ }
+ }
+ lua_pushboolean(L, stacking);
+ return 1;
+}
+
+static int mplib_figure_tostring(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushfstring(L, "<mp.figure %p>", *hh);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_width(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushnumber(L, (*hh)->width);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_height(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushnumber(L, (*hh)->height);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_depth(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushnumber(L, (*hh)->depth);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_italic(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushnumber(L, (*hh)->italic);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_charcode(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushinteger(L, (lua_Integer) (*hh)->charcode);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_figure_tolerance(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ if (*hh) {
+ lua_pushnumber(L, mplib_aux_get_bend_tolerance(L, 1));
+ lua_pushnumber(L, mplib_aux_get_move_tolerance(L, 1));
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+static int mplib_figure_bounds(lua_State *L)
+{
+ struct mp_edge_object **hh = mplib_aux_is_figure(L, 1);
+ lua_createtable(L, 4, 0);
+ lua_push_number_at_index(L, 1, (*hh)->minx);
+ lua_push_number_at_index(L, 2, (*hh)->miny);
+ lua_push_number_at_index(L, 3, (*hh)->maxx);
+ lua_push_number_at_index(L, 4, (*hh)->maxy);
+ return 1;
+}
+
+/*tex The methods for the figure objects plus a few helpers. */
+
+static int mplib_object_collect(lua_State *L)
+{
+ struct mp_graphic_object **hh = mplib_aux_is_gr_object(L, 1);
+ if (*hh) {
+ mp_gr_toss_object(*hh);
+ *hh = NULL;
+ }
+ return 0;
+}
+
+static int mplib_object_tostring(lua_State *L)
+{
+ struct mp_graphic_object **hh = mplib_aux_is_gr_object(L, 1);
+ lua_pushfstring(L, "<mp.object %p>", *hh);
+ return 1;
+}
+
+# define pyth(a,b) (sqrt((a)*(a) + (b)*(b)))
+# define aspect_bound (10.0/65536.0)
+# define aspect_default 1.0
+# define eps 0.0001
+
+static double mplib_aux_coord_range_x(mp_gr_knot h, double dz)
+{
+ double zlo = 0.0;
+ double zhi = 0.0;
+ mp_gr_knot f = h;
+ while (h) {
+ double z = h->x_coord;
+ if (z < zlo) {
+ zlo = z;
+ } else if (z > zhi) {
+ zhi = z;
+ }
+ z = h->right_x;
+ if (z < zlo) {
+ zlo = z;
+ } else if (z > zhi) {
+ zhi = z;
+ }
+ z = h->left_x;
+ if (z < zlo) {
+ zlo = z;
+ } else if (z > zhi) {
+ zhi = z;
+ }
+ h = h->next;
+ if (h == f) {
+ break;
+ }
+ }
+ return (zhi - zlo <= dz) ? aspect_bound : aspect_default;
+}
+
+static double mplib_aux_coord_range_y(mp_gr_knot h, double dz)
+{
+ double zlo = 0.0;
+ double zhi = 0.0;
+ mp_gr_knot f = h;
+ while (h) {
+ double z = h->y_coord;
+ if (z < zlo) {
+ zlo = z;
+ } else if (z > zhi) {
+ zhi = z;
+ }
+ z = h->right_y;
+ if (z < zlo) {
+ zlo = z;
+ } else if (z > zhi) {
+ zhi = z;
+ }
+ z = h->left_y;
+ if (z < zlo) {
+ zlo = z;
+ } else if (z > zhi) {
+ zhi = z;
+ }
+ h = h->next;
+ if (h == f) {
+ break;
+ }
+ }
+ return (zhi - zlo <= dz) ? aspect_bound : aspect_default;
+}
+
+static int mplib_object_peninfo(lua_State *L)
+{
+ struct mp_graphic_object **hh = mplib_aux_is_gr_object(L, -1);
+ if (! *hh) {
+ lua_pushnil(L);
+ return 1;
+ } else {
+ mp_gr_knot p = NULL;
+ mp_gr_knot path = NULL;
+ switch ((*hh)->type) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ p = ((mp_shape_object *) (*hh))->pen;
+ path = ((mp_shape_object *) (*hh))->path;
+ break;
+ }
+ if (! p || ! path) {
+ lua_pushnil(L);
+ return 1;
+ } else {
+ double wx, wy;
+ double rx = 1.0, sx = 0.0, sy = 0.0, ry = 1.0, tx = 0.0, ty = 0.0;
+ double width = 1.0;
+ double x_coord = p->x_coord;
+ double y_coord = p->y_coord;
+ double left_x = p->left_x;
+ double left_y = p->left_y;
+ double right_x = p->right_x;
+ double right_y = p->right_y;
+ if ((right_x == x_coord) && (left_y == y_coord)) {
+ wx = fabs(left_x - x_coord);
+ wy = fabs(right_y - y_coord);
+ } else {
+ wx = pyth(left_x - x_coord, right_x - x_coord);
+ wy = pyth(left_y - y_coord, right_y - y_coord);
+ }
+ if ((wy/mplib_aux_coord_range_x(path, wx)) >= (wx/mplib_aux_coord_range_y(path, wy))) {
+ width = wy;
+ } else {
+ width = wx;
+ }
+ tx = x_coord;
+ ty = y_coord;
+ sx = left_x - tx;
+ rx = left_y - ty;
+ ry = right_x - tx;
+ sy = right_y - ty;
+ if (width != 1.0) {
+ if (width == 0.0) {
+ sx = 1.0;
+ sy = 1.0;
+ } else {
+ rx /= width;
+ ry /= width;
+ sx /= width;
+ sy /= width;
+ }
+ }
+ if (fabs(sx) < eps) {
+ sx = eps;
+ }
+ if (fabs(sy) < eps) {
+ sy = eps;
+ }
+ lua_createtable(L,0,7);
+ lua_push_number_at_key(L, width, width);
+ lua_push_number_at_key(L, rx, rx);
+ lua_push_number_at_key(L, sx, sx);
+ lua_push_number_at_key(L, sy, sy);
+ lua_push_number_at_key(L, ry, ry);
+ lua_push_number_at_key(L, tx, tx);
+ lua_push_number_at_key(L, ty, ty);
+ return 1;
+ }
+ }
+}
+
+/*tex Here is a helper that reports the valid field names of the possible objects. */
+
+static void mplib_aux_mplib_push_fields(lua_State* L, const char **fields)
+{
+ lua_newtable(L);
+ for (lua_Integer i = 0; fields[i]; i++) {
+ lua_pushstring(L, fields[i]); /* not yet an index */
+ lua_rawseti(L, -2, i + 1);
+ }
+}
+
+static int mplib_gettype(lua_State *L)
+{
+ struct mp_graphic_object **hh = mplib_aux_is_gr_object(L, 1);
+ if (*hh) {
+ lua_pushinteger(L, (*hh)->type);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int mplib_getobjecttypes(lua_State* L)
+{
+ lua_createtable(L, 7, 1);
+ lua_push_key_at_index(L, fill, mp_fill_code);
+ lua_push_key_at_index(L, outline, mp_stroked_code);
+ lua_push_key_at_index(L, start_clip, mp_start_clip_code);
+ lua_push_key_at_index(L, start_group, mp_start_group_code);
+ lua_push_key_at_index(L, start_bounds, mp_start_bounds_code);
+ lua_push_key_at_index(L, stop_clip, mp_stop_clip_code);
+ lua_push_key_at_index(L, stop_group, mp_stop_group_code);
+ lua_push_key_at_index(L, stop_bounds, mp_stop_bounds_code);
+ return 1;
+}
+
+static int mplib_getfields(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TUSERDATA) {
+ struct mp_graphic_object **hh = mplib_aux_is_gr_object(L, 1);
+ if (*hh) {
+ const char **fields;
+ switch ((*hh)->type) {
+ case mp_fill_code : fields = mplib_fill_fields; break;
+ case mp_stroked_code : fields = mplib_stroked_fields; break;
+ case mp_start_clip_code : fields = mplib_start_clip_fields; break;
+ case mp_start_group_code : fields = mplib_start_group_fields; break;
+ case mp_start_bounds_code: fields = mplib_start_bounds_fields; break;
+ case mp_stop_clip_code : fields = mplib_stop_clip_fields; break;
+ case mp_stop_group_code : fields = mplib_stop_group_fields; break;
+ case mp_stop_bounds_code : fields = mplib_stop_bounds_fields; break;
+ default : fields = mplib_no_fields; break;
+ }
+ mplib_aux_mplib_push_fields(L, fields);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_createtable(L, 8, 0);
+ mplib_aux_mplib_push_fields(L, mplib_fill_fields); lua_rawseti(L, -2, mp_fill_code);
+ mplib_aux_mplib_push_fields(L, mplib_stroked_fields); lua_rawseti(L, -2, mp_stroked_code);
+ mplib_aux_mplib_push_fields(L, mplib_start_clip_fields); lua_rawseti(L, -2, mp_start_clip_code);
+ mplib_aux_mplib_push_fields(L, mplib_start_group_fields); lua_rawseti(L, -2, mp_start_group_code);
+ mplib_aux_mplib_push_fields(L, mplib_start_bounds_fields); lua_rawseti(L, -2, mp_start_bounds_code);
+ mplib_aux_mplib_push_fields(L, mplib_stop_clip_fields); lua_rawseti(L, -2, mp_stop_clip_code);
+ mplib_aux_mplib_push_fields(L, mplib_stop_group_fields); lua_rawseti(L, -2, mp_stop_group_code);
+ mplib_aux_mplib_push_fields(L, mplib_stop_bounds_fields); lua_rawseti(L, -2, mp_stop_bounds_code);
+ }
+ return 1;
+}
+
+static int mplib_push_values(lua_State *L, const char *list[])
+{
+ lua_newtable(L);
+ for (lua_Integer i = 0; list[i]; i++) {
+ lua_pushstring(L, list[i]);
+ lua_rawseti(L, -2, i);
+ }
+ return 1;
+}
+
+static int mplib_getcodes(lua_State *L)
+{
+ return mplib_push_values(L, mplib_codes);
+}
+
+static int mplib_gettypes(lua_State *L)
+{
+ return mplib_push_values(L, mplib_types);
+}
+
+static int mplib_getcolormodels(lua_State *L)
+{
+ return mplib_push_values(L, mplib_colormodels);
+}
+
+static int mplib_getstates(lua_State *L)
+{
+ return mplib_push_values(L, mplib_states);
+}
+
+static int mplib_getcallbackstate(lua_State *L)
+{
+ lua_createtable(L, 0, 5);
+ lua_push_integer_at_key(L, file, mplib_state.file_callbacks);
+ lua_push_integer_at_key(L, text, mplib_state.text_callbacks);
+ lua_push_integer_at_key(L, script, mplib_state.script_callbacks);
+ lua_push_integer_at_key(L, log, mplib_state.log_callbacks);
+ lua_push_integer_at_key(L, overloaded, mplib_state.overload_callbacks);
+ lua_push_integer_at_key(L, error, mplib_state.error_callbacks);
+ lua_push_integer_at_key(L, warning, mplib_state.warning_callbacks);
+ lua_push_integer_at_key(L, count,
+ mplib_state.file_callbacks + mplib_state.text_callbacks
+ + mplib_state.script_callbacks + mplib_state.log_callbacks
+ + mplib_state.overload_callbacks + mplib_state.error_callbacks
+ + mplib_state.warning_callbacks
+ );
+ return 1;
+}
+
+/*tex
+
+ This assumes that the top of the stack is a table or nil already in the case.
+*/
+
+# define mplib_set_color_objects(pq) \
+object_color_model = pq->color_model; \
+object_color_a = pq->color.a_val; \
+object_color_b = pq->color.b_val; \
+object_color_c = pq->color.c_val; \
+object_color_d = pq->color.d_val;
+
+static void mplib_aux_push_color(lua_State *L, struct mp_graphic_object *p)
+{
+ if (p) {
+ int object_color_model;
+ double object_color_a, object_color_b, object_color_c, object_color_d;
+ switch (p->type) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ {
+ mp_shape_object *h = (mp_shape_object *) p;
+ mplib_set_color_objects(h);
+ }
+ break;
+ default:
+ object_color_model = mp_no_model;
+ break;
+ }
+ switch (object_color_model) {
+ case mp_grey_model:
+ lua_createtable(L, 1, 0);
+ lua_push_number_at_index(L, 1, object_color_d);
+ break;
+ case mp_rgb_model:
+ lua_createtable(L, 3, 0);
+ lua_push_number_at_index(L, 1, object_color_a);
+ lua_push_number_at_index(L, 2, object_color_b);
+ lua_push_number_at_index(L, 3, object_color_c);
+ break;
+ case mp_cmyk_model:
+ lua_createtable(L, 4, 0);
+ lua_push_number_at_index(L, 1, object_color_a);
+ lua_push_number_at_index(L, 2, object_color_b);
+ lua_push_number_at_index(L, 3, object_color_c);
+ lua_push_number_at_index(L, 4, object_color_d);
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+/*tex The dash scale is not exported, the field has no external value. */
+
+static void mplib_aux_push_dash(lua_State *L, struct mp_shape_object *h)
+{
+ if (h && h->dash) {
+ mp_dash_object *d = h->dash;
+ lua_newtable(L); /* we could start at size 2 or so */
+ lua_push_number_at_key(L, offset, d->offset);
+ if (d->array) {
+ int i = 0;
+ lua_push_key(dashes);
+ lua_newtable(L);
+ while (*(d->array + i) != -1) {
+ double ds = *(d->array + i);
+ lua_pushnumber(L, ds);
+ i++;
+ lua_rawseti(L, -2, i);
+ }
+ lua_rawset(L, -3);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static void mplib_aux_shape(lua_State *L, const char *s, struct mp_shape_object *h, lua_Number bendtolerance, lua_Number movetolerance)
+{
+ if (lua_key_eq(s, path)) {
+ mplib_aux_push_path(L, h->path, MPLIB_PATH, bendtolerance, movetolerance);
+ } else if (lua_key_eq(s, htap)) {
+ mplib_aux_push_path(L, h->htap, MPLIB_PATH, bendtolerance, movetolerance);
+ } else if (lua_key_eq(s, pen)) {
+ mplib_aux_push_path(L, h->pen, MPLIB_PEN, bendtolerance, movetolerance);
+ /* pushed in the table at the top */
+ mplib_aux_push_pentype(L, h->pen);
+ } else if (lua_key_eq(s, color)) {
+ mplib_aux_push_color(L, (mp_graphic_object *) h);
+ } else if (lua_key_eq(s, linejoin)) {
+ lua_pushnumber(L, (lua_Number) h->linejoin);
+ } else if (lua_key_eq(s, linecap)) {
+ lua_pushnumber(L, (lua_Number) h->linecap);
+ // } else if (lua_key_eq(s, stacking)) {
+ // lua_pushinteger(L, (lua_Integer) h->stacking);
+ } else if (lua_key_eq(s, miterlimit)) {
+ lua_pushnumber(L, h->miterlimit);
+ } else if (lua_key_eq(s, prescript)) {
+ lua_pushlstring(L, h->pre_script, h->pre_length);
+ } else if (lua_key_eq(s, postscript)) {
+ lua_pushlstring(L, h->post_script, h->post_length);
+ } else if (lua_key_eq(s, dash)) {
+ mplib_aux_push_dash(L, h);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static void mplib_aux_start(lua_State *L, const char *s, struct mp_start_object *h, lua_Number bendtolerance, lua_Number movetolerance)
+{
+ if (lua_key_eq(s, path)) {
+ mplib_aux_push_path(L, h->path, MPLIB_PATH, bendtolerance, movetolerance);
+ } else if (lua_key_eq(s, prescript)) {
+ lua_pushlstring(L, h->pre_script, h->pre_length);
+ } else if (lua_key_eq(s, postscript)) {
+ lua_pushlstring(L, h->post_script, h->post_length);
+ // } else if (lua_key_eq(s, stacking)) {
+ // lua_pushinteger(L, (lua_Integer) h->stacking);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+// static void mplib_aux_stop(lua_State *L, const char *s, struct mp_stop_object *h, lua_Number bendtolerance, lua_Number movetolerance)
+// {
+// if (lua_key_eq(s, stacking)) {
+// lua_pushinteger(L, (lua_Integer) h->stacking);
+// } else {
+// lua_pushnil(L);
+// }
+// }
+
+static int mplib_object_index(lua_State *L)
+{
+ struct mp_graphic_object **hh = mplib_aux_is_gr_object(L, 1); /* no need for test */
+ if (*hh) {
+ struct mp_graphic_object *h = *hh;
+ const char *s = lua_tostring(L, 2);
+ /* todo: remove stacking from specific aux */
+ if (lua_key_eq(s, type)) {
+ lua_push_key_by_index(mplib_values_type[h->type]);
+ } else if (lua_key_eq(s, stacking)) {
+ lua_pushinteger(L, (lua_Integer) h->stacking);
+ } else {
+ lua_Number bendtolerance = mplib_aux_get_bend_tolerance(L, 1);
+ lua_Number movetolerance = mplib_aux_get_move_tolerance(L, 1);
+ /* todo: we can use generic casts */
+ switch (h->type) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ mplib_aux_shape(L, s, (mp_shape_object *) h, bendtolerance, movetolerance);
+ break;
+ case mp_start_clip_code:
+ case mp_start_group_code:
+ case mp_start_bounds_code:
+ mplib_aux_start(L, s, (mp_start_object *) h, bendtolerance, movetolerance);
+ break;
+ // case mp_stop_clip_code:
+ // case mp_stop_group_code:
+ // case mp_stop_bounds_code:
+ // mplib_aux_stop_clip(L, s, (mp_stop_object *) h, bendtolerance, movetolerance);
+ // break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* Experiment: mpx, kind, macro, arguments */
+
+static int mplib_expand_tex(lua_State *L)
+{
+ MP mp = mplib_aux_is_mp(L, 1);
+ if (mp) {
+ int kind = lmt_tointeger(L, 2);
+ halfword tail = null;
+ halfword head = lmt_macro_to_tok(L, 3, &tail);
+ if (head) {
+ switch (kind) {
+ case lua_value_none_code:
+ case lua_value_dimension_code:
+ {
+ halfword value = 0;
+ halfword space = tex_get_available_token(space_token);
+ halfword relax = tex_get_available_token(deep_frozen_relax_token);
+ token_link(tail) = space;
+ token_link(space) = relax;
+ tex_begin_inserted_list(head);
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ value = tex_scan_dimen(0, 0, 0, 0, NULL);
+ lmt_error_state.intercept = 0;
+ while (cur_tok != deep_frozen_relax_token) {
+ tex_get_token();
+ }
+ if (! lmt_error_state.last_intercept) {
+ mp_push_numeric_value(mp, (double) value * (7200.0/7227.0) / 65536.0);
+ break;
+ } else if (kind == lua_value_none_code) {
+ head = lmt_macro_to_tok(L, 3, &tail);
+ goto TRYAGAIN;
+ } else {
+ // head = lmt_macro_to_tok(L, 3, &tail);
+ // goto JUSTINCASE;
+ lua_pushboolean(L, 0);
+ return 1;
+ }
+ }
+ case lua_value_integer_code:
+ case lua_value_cardinal_code:
+ case lua_value_boolean_code:
+ TRYAGAIN:
+ {
+ halfword value = 0;
+ halfword space = tex_get_available_token(space_token);
+ halfword relax = tex_get_available_token(deep_frozen_relax_token);
+ token_link(tail) = space;
+ token_link(space) = relax;
+ tex_begin_inserted_list(head);
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ value = tex_scan_int(0, NULL);
+ lmt_error_state.intercept = 0;
+ while (cur_tok != deep_frozen_relax_token) {
+ tex_get_token();
+ }
+ if (lmt_error_state.last_intercept) {
+ // head = lmt_macro_to_tok(L, 3, &tail);
+ // goto JUSTINCASE;
+ lua_pushboolean(L, 0);
+ return 1;
+ } else if (kind == lua_value_boolean_code) {
+ mp_push_boolean_value(mp, value);
+ break;
+ } else {
+ mp_push_numeric_value(mp, value);
+ break;
+ }
+ }
+ default:
+ // JUSTINCASE:
+ {
+ int len = 0;
+ const char *str = (const char *) lmt_get_expansion(head, &len);
+ mp_push_string_value(mp, str, str ? len : 0); /* len includes \0 */
+ break;
+ }
+ }
+ }
+ }
+ lua_pushboolean(L, 1);
+ return 1;
+}
+
+/* */
+
+static const struct luaL_Reg mplib_instance_metatable[] = {
+ { "__gc", mplib_instance_collect },
+ { "__tostring", mplib_instance_tostring },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg mplib_figure_metatable[] = {
+ { "__gc", mplib_figure_collect },
+ { "__tostring", mplib_figure_tostring },
+ { "objects", mplib_figure_objects },
+ { "boundingbox", mplib_figure_bounds },
+ { "width", mplib_figure_width },
+ { "height", mplib_figure_height },
+ { "depth", mplib_figure_depth },
+ { "italic", mplib_figure_italic },
+ { "charcode", mplib_figure_charcode },
+ { "tolerance", mplib_figure_tolerance },
+ { "stacking", mplib_figure_stacking },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg mplib_object_metatable[] = {
+ { "__gc", mplib_object_collect },
+ { "__tostring", mplib_object_tostring },
+ { "__index", mplib_object_index },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg mplib_instance_functions_list[] = {
+ { "execute", mplib_execute },
+ { "finish", mplib_finish },
+ { "getstatistics", mplib_getstatistics },
+ { "getstatus", mplib_getstatus },
+ { "solvepath", mplib_solvepath },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg mplib_functions_list[] = {
+ { "new", mplib_new },
+ { "version", mplib_version },
+ /* */
+ { "getfields", mplib_getfields },
+ { "gettype", mplib_gettype },
+ { "gettypes", mplib_gettypes },
+ { "getcolormodels", mplib_getcolormodels },
+ { "getcodes", mplib_getcodes },
+ { "getstates", mplib_getstates },
+ { "getobjecttypes", mplib_getobjecttypes },
+ { "getcallbackstate", mplib_getcallbackstate },
+ /* */
+ { "settolerance", mplib_set_tolerance },
+ { "gettolerance", mplib_get_tolerance },
+ /* indirect */
+ { "execute", mplib_execute },
+ { "finish", mplib_finish },
+ { "showcontext", mplib_showcontext },
+ { "gethashentries", mplib_gethashentries },
+ { "gethashentry", mplib_gethashentry },
+ { "getstatistics", mplib_getstatistics },
+ { "getstatus", mplib_getstatus },
+ { "solvepath", mplib_solvepath },
+ /* helpers */
+ { "peninfo", mplib_object_peninfo },
+ /* scanners */
+ { "scannext", mplib_scan_next },
+ { "scanexpression", mplib_scan_expression },
+ { "scantoken", mplib_scan_token },
+ { "scansymbol", mplib_scan_symbol },
+ { "scanproperty", mplib_scan_property },
+ { "scannumeric", mplib_scan_numeric },
+ { "scannumber", mplib_scan_numeric }, /* bonus */
+ { "scaninteger", mplib_scan_integer },
+ { "scanboolean", mplib_scan_boolean },
+ { "scanstring", mplib_scan_string },
+ { "scanpair", mplib_scan_pair },
+ { "scancolor", mplib_scan_color },
+ { "scancmykcolor", mplib_scan_cmykcolor },
+ { "scantransform", mplib_scan_transform },
+ { "scanpath", mplib_scan_path },
+ { "scanpen", mplib_scan_pen },
+ /* skippers */
+ { "skiptoken", mplib_skip_token },
+ /* injectors */
+ { "injectnumeric", mplib_inject_numeric },
+ { "injectnumber", mplib_inject_numeric }, /* bonus */
+ { "injectinteger", mplib_inject_integer },
+ { "injectboolean", mplib_inject_boolean },
+ { "injectstring", mplib_inject_string },
+ { "injectpair", mplib_inject_pair },
+ { "injectcolor", mplib_inject_color },
+ { "injectcmykcolor", mplib_inject_cmykcolor },
+ { "injecttransform", mplib_inject_transform },
+ { "injectpath", mplib_inject_path },
+ { "injectwhatever", mplib_inject_whatever },
+ /* */
+ { "expandtex", mplib_expand_tex },
+ /* */
+ { NULL, NULL },
+};
+
+int luaopen_mplib(lua_State *L)
+{
+ mplib_aux_initialize_lua(L);
+
+ luaL_newmetatable(L, MP_METATABLE_OBJECT);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -2, "__index");
+ luaL_setfuncs(L, mplib_object_metatable, 0);
+ luaL_newmetatable(L, MP_METATABLE_FIGURE);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -2, "__index");
+ luaL_setfuncs(L, mplib_figure_metatable, 0);
+ luaL_newmetatable(L, MP_METATABLE_INSTANCE);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -2, "__index");
+ luaL_setfuncs(L, mplib_instance_metatable, 0);
+ luaL_setfuncs(L, mplib_instance_functions_list, 0);
+ lua_newtable(L);
+ luaL_setfuncs(L, mplib_functions_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmtnodelib.c b/source/luametatex/source/lua/lmtnodelib.c
new file mode 100644
index 000000000..ff98a7064
--- /dev/null
+++ b/source/luametatex/source/lua/lmtnodelib.c
@@ -0,0 +1,10324 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This module is one of the backbones on \LUAMETATEX. It has gradually been extended based on
+ experiences in \CONTEXT\ \MKIV\ and later \LMTX. There are many helpers here and the main
+ reason is that the more callbacks one enables and the more one does in them, the larger the
+ impact on performance.
+
+ After doing lots of tests with \LUATEX\ and \LUAJITTEX, with and without jit, and with and
+ without ffi, I came to the conclusion that userdata prevents a speedup. I also found that the
+ checking of metatables as well as assignment comes with overhead that can't be neglected. This
+ is normally not really a problem but when processing fonts for more complex scripts it's quite
+ some overhead. So \unknown\ direct nodes were introduced (we call them nuts in \CONTEXT).
+
+ Because the userdata approach has some benefits, we keep that interface too. We did some
+ experiments with fast access (assuming nodes), but eventually settled for the direct approach.
+ For code that is proven to be okay, one can use the direct variants and operate on nodes more
+ directly. Currently these are numbers but don't rely on that property; treat them aslhmin
+
+ abstractions. An important aspect is that one cannot mix both methods, although with |tonode|
+ and |todirect| one can cast representations.
+
+ So the advice is: use the indexed (userdata) approach when possible and investigate the direct
+ one when speed might be an issue. For that reason we also provide some get* and set* functions
+ in the top level node namespace. There is a limited set of getters for nodes and a generic
+ getfield to complement them. The direct namespace has a few more.
+
+ Keep in mind that such speed considerations only make sense when we're accessing nodes millions
+ of times (which happens in font processing for instance). Setters are less important as
+ documents have not that many content related nodes and setting many thousands of properties is
+ hardly a burden contrary to millions of consultations. And with millions, we're talking of tens
+ of millions which is not that common.
+
+ Another change is that |__index| and |__newindex| are (as expected) exposed to users but do no
+ checking. The getfield and setfield functions do check. In fact, a fast mode can be simulated
+ by fast_getfield = __index but the (measured) benefit on average runs is not that large (some
+ 5\% when we also use the other fast ones) which is easily nilled by inefficient coding. The
+ direct variants on the other hand can be significantly faster but with the drawback of lack of
+ userdata features. With respect to speed: keep in mind that measuring a speedup on these
+ functions is not representative for a normal run, where much more happens.
+
+ A user should beware of the fact that messing around with |prev|, |next| and other links can
+ lead to crashes. Don't complain about this: you get what you ask for. Examples are bad loops
+ in nodes lists that make the program run out of stack space.
+
+ The code below differs from the \LUATEX\ code in that it drops some userdata related
+ accessors. These can easily be emulates in \LUA, which is what we do in \CONTEXT\ \LMTX. Also,
+ some optimizations, like using macros and dedicated |getfield| and |setfield| functions for
+ userdata and direct nodes were removed because on a regular run there is not much impact and
+ the less code we have, the better. In the early days of \LUATEX\ it really did improve the
+ overall performance but computers (as well as compilers) have become better. But still, it
+ could be that \LUATEX\ has a better performance here; so be it. A performance hit can also be
+ one of the side effects of the some more rigourous testing of direct node validity introduced
+ here.
+
+ Attribute nodes are special as their prev and subtype fields are used for other purposes.
+ Setting them can confuse the checkers but we don't check each case for performance reasons.
+ Messing a list up is harmless and only affects functionality which is the users responsibility
+ anyway.
+
+ In \LUAMETATEX\ nodes can have different names and properties as in \LUATEX. Some might be
+ backported but that is kind of dangerous as macro packages other than \CONTEXT\ depend on
+ stability of \LUATEX. (It's one of the reasons for \LUAMETATEX\ being around: it permits us
+ to move on).
+
+ Todo: getters/setters for leftovers.
+
+*/
+
+/*
+ direct_prev_id(n) => returns prev and id
+ direct_next_id(n) => returns next and id
+*/
+
+# include "luametatex.h"
+
+/* # define NODE_METATABLE_INSTANCE "node.instance" */
+/* # define NODE_PROPERTIES_DIRECT "node.properties" */
+/* # define NODE_PROPERTIES_INDIRECT "node.properties.indirect" */
+/* # define NODE_PROPERTIES_INSTANCE "node.properties.instance" */
+
+/*tex
+
+ There is a bit of checking for validity of direct nodes but of course one can still create
+ havoc by using flushed nodes, setting bad links, etc.
+
+ Although we could gain a little by moving the body of the valid checker into the caller (that
+ way the field variables might be shared) there is no real measurable gain in that on a regular
+ run. So, in the end I settled for function calls.
+
+*/
+
+halfword lmt_check_isdirect(lua_State *L, int i)
+{
+ halfword n = lmt_tohalfword(L, i);
+ return n && _valid_node_(n) ? n : null;
+}
+
+inline static halfword nodelib_valid_direct_from_index(lua_State *L, int i)
+{
+ halfword n = lmt_tohalfword(L, i);
+ return n && _valid_node_(n) ? n : null;
+}
+
+inline static void nodelib_push_direct_or_nil(lua_State *L, halfword n)
+{
+ if (n) {
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+inline static void nodelib_push_direct_or_nil_node_prev(lua_State *L, halfword n)
+{
+ if (n) {
+ node_prev(n) = null;
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+inline static void nodelib_push_node_on_top(lua_State *L, halfword n)
+{
+ *(halfword *) lua_newuserdatauv(L, sizeof(halfword), 0) = n;
+ lua_getmetatable(L, -2);
+ lua_setmetatable(L, -2);
+}
+
+/*tex
+ Many of these small functions used to be macros but that no longer pays off because compilers
+ became better (for instance at deciding when to inline small functions). We could have explicit
+ inline variants of these too but normally the compiler will inline small functions anyway.
+
+*/
+
+static halfword lmt_maybe_isnode(lua_State *L, int i)
+{
+ halfword *p = lua_touserdata(L, i);
+ halfword n = null;
+ if (p && lua_getmetatable(L, i)) {
+ lua_get_metatablelua(node_instance);
+ if (lua_rawequal(L, -1, -2)) {
+ n = *p;
+ }
+ lua_pop(L, 2);
+ }
+ return n;
+}
+
+halfword lmt_check_isnode(lua_State *L, int i)
+{
+ halfword n = lmt_maybe_isnode(L, i);
+ if (! n) {
+ // formatted_error("node lib", "lua <node> expected, not an object with type %s", luaL_typename(L, i));
+ luaL_error(L, "invalid node");
+ }
+ return n;
+}
+
+/* helpers */
+
+static void nodelib_push_direct_or_node(lua_State *L, int direct, halfword n)
+{
+ if (n) {
+ if (direct) {
+ lua_pushinteger(L, n);
+ } else {
+ *(halfword *) lua_newuserdatauv(L, sizeof(halfword), 0) = n;
+ lua_getmetatable(L, 1);
+ lua_setmetatable(L, -2);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static void nodelib_push_direct_or_node_node_prev(lua_State *L, int direct, halfword n)
+{
+ if (n) {
+ node_prev(n) = null;
+ if (direct) {
+ lua_pushinteger(L, n);
+ } else {
+ *(halfword *) lua_newuserdatauv(L, sizeof(halfword), 0) = n;
+ lua_getmetatable(L, 1);
+ lua_setmetatable(L, -2);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static halfword nodelib_direct_or_node_from_index(lua_State *L, int direct, int i)
+{
+ if (direct) {
+ return nodelib_valid_direct_from_index(L, i);
+ } else if (lua_isuserdata(L, i)) {
+ return lmt_check_isnode(L, i);
+ } else {
+ return null;
+ }
+}
+
+halfword lmt_check_isdirectornode(lua_State *L, int i, int *isdirect)
+{
+ *isdirect = ! lua_isuserdata(L, i);
+ return *isdirect ? nodelib_valid_direct_from_index(L, i) : lmt_check_isnode(L, i);
+}
+
+static void nodelib_push_attribute_data(lua_State* L, halfword n)
+{
+ if (node_type(n) == attribute_list_subtype) {
+ lua_newtable(L);
+ n = node_next(n);
+ while (n) {
+ lua_pushinteger(L, attribute_value(n));
+ lua_rawseti(L, -2, attribute_index(n));
+ n = node_next(n);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+/*tex Another shortcut: */
+
+inline static singleword nodelib_getdirection(lua_State *L, int i)
+{
+ return ((lua_type(L, i) == LUA_TNUMBER) ? checked_direction_value(lmt_tohalfword(L, i)) : direction_def_value);
+}
+
+/*tex
+
+ This routine finds the numerical value of a string (or number) at \LUA\ stack index |n|. If it
+ is not a valid node type |-1| is returned.
+
+*/
+
+static quarterword nodelib_aux_get_node_type_id_from_name(lua_State *L, int n, node_info *data)
+{
+ if (data) {
+ const char *s = lua_tostring(L, n);
+ for (int j = 0; data[j].id != -1; j++) {
+ if (s == data[j].name) {
+ if (data[j].visible) {
+ return (quarterword) j;
+ } else {
+ break;
+ }
+ }
+ }
+ }
+ return unknown_node;
+}
+
+static quarterword nodelib_aux_get_node_subtype_id_from_name(lua_State *L, int n, value_info *data)
+{
+ if (data) {
+ const char *s = lua_tostring(L, n);
+ for (quarterword j = 0; data[j].id != -1; j++) {
+ if (s == data[j].name) {
+ return j;
+ }
+ }
+ }
+ return unknown_subtype;
+}
+
+static quarterword nodelib_aux_get_field_index_from_name(lua_State *L, int n, value_info *data)
+{
+ if (data) {
+ const char *s = lua_tostring(L, n);
+ for (quarterword j = 0; data[j].name; j++) {
+ if (s == data[j].name) {
+ return j;
+ }
+ }
+ }
+ return unknown_field;
+}
+
+static quarterword nodelib_aux_get_valid_node_type_id(lua_State *L, int n)
+{
+ quarterword i = unknown_node;
+ switch (lua_type(L, n)) {
+ case LUA_TSTRING:
+ i = nodelib_aux_get_node_type_id_from_name(L, n, lmt_interface.node_data);
+ if (i == unknown_node) {
+ luaL_error(L, "invalid node type id: %s", lua_tostring(L, n));
+ }
+ break;
+ case LUA_TNUMBER:
+ i = lmt_toquarterword(L, n);
+ if (! tex_nodetype_is_visible(i)) {
+ luaL_error(L, "invalid node type id: %d", i);
+ }
+ break;
+ default:
+ luaL_error(L, "invalid node type id");
+ }
+ return i;
+}
+
+int lmt_get_math_style(lua_State *L, int n, int dflt)
+{
+ int i = -1;
+ switch (lua_type(L, n)) {
+ case LUA_TNUMBER:
+ i = lmt_tointeger(L, n);
+ break;
+ case LUA_TSTRING:
+ i = nodelib_aux_get_field_index_from_name(L, n, lmt_interface.math_style_values);
+ break;
+ }
+ if (i >= 0 && i <= cramped_script_script_style) {
+ return i;
+ } else {
+ return dflt;
+ }
+}
+
+int lmt_get_math_parameter(lua_State *L, int n, int dflt)
+{
+ int i;
+ switch (lua_type(L, n)) {
+ case LUA_TNUMBER:
+ i = lmt_tointeger(L, n);
+ break;
+ case LUA_TSTRING:
+ i = nodelib_aux_get_field_index_from_name(L, n, lmt_interface.math_parameter_values);
+ break;
+ default:
+ i = -1;
+ break;
+ }
+ if (i >= 0 && i < math_parameter_last) {
+ return i;
+ } else {
+ return dflt;
+ }
+}
+
+/*tex
+
+ Creates a userdata object for a number found at the stack top, if it is representing a node
+ (i.e. an pointer into |varmem|). It replaces the stack entry with the new userdata, or pushes
+ |nil| if the number is |null|, or if the index is definately out of range. This test could be
+ improved.
+
+*/
+
+void lmt_push_node(lua_State *L)
+{
+ halfword n = null;
+ if (lua_type(L, -1) == LUA_TNUMBER) {
+ n = lmt_tohalfword(L, -1);
+ }
+ lua_pop(L, 1);
+ if ((! n) || (n > lmt_node_memory_state.nodes_data.allocated)) {
+ lua_pushnil(L);
+ } else {
+ halfword *a = lua_newuserdatauv(L, sizeof(halfword), 0);
+ *a = n;
+ lua_get_metatablelua(node_instance);
+ lua_setmetatable(L, -2);
+ }
+ return;
+}
+
+void lmt_push_node_fast(lua_State *L, halfword n)
+{
+ if (n) {
+ halfword *a = lua_newuserdatauv(L, sizeof(halfword), 0);
+ *a = n;
+ lua_get_metatablelua(node_instance);
+ lua_setmetatable(L, -2);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+void lmt_push_directornode(lua_State *L, halfword n, int isdirect)
+{
+ if (! n) {
+ lua_pushnil(L);
+ } else if (isdirect) {
+ lua_push_integer(L, n);
+ } else {
+ lmt_push_node_fast(L, n);
+ }
+}
+
+/*tex getting and setting fields (helpers) */
+
+static int nodelib_getlist(lua_State *L, int n)
+{
+ if (lua_isuserdata(L, n)) {
+ return lmt_check_isnode(L, n);
+ } else {
+ return null;
+ }
+}
+
+/*tex converts type strings to type ids */
+
+static int nodelib_shared_id(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ int i = nodelib_aux_get_node_type_id_from_name(L, 1, lmt_interface.node_data);
+ if (i >= 0) {
+ lua_pushinteger(L, i);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.getid */
+
+static int nodelib_direct_getid(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ lua_pushinteger(L, node_type(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.getsubtype */
+/* node.direct.setsubtype */
+
+static int nodelib_direct_getsubtype(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ lua_pushinteger(L, node_subtype(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setsubtype(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && lua_type(L, 2) == LUA_TNUMBER) {
+ node_subtype(n) = lmt_toquarterword(L, 2);
+ }
+ return 0;
+}
+
+/* node.direct.getexpansion */
+/* node.direct.setexpansion */
+
+static int nodelib_direct_getexpansion(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_expansion(n));
+ break;
+ case kern_node:
+ lua_pushinteger(L, kern_expansion(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setexpansion(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword e = 0;
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ e = (halfword) lmt_roundnumber(L, 2);
+ }
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_expansion(n) = e;
+ break;
+ case kern_node:
+ kern_expansion(n) = e;
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getfont */
+/* node.direct.setfont */
+
+static int nodelib_direct_getfont(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_font(n));
+ break;
+ case glue_node:
+ lua_pushinteger(L, glue_font(n));
+ break;
+ case math_char_node:
+ case math_text_char_node:
+ lua_pushinteger(L, tex_fam_fnt(kernel_math_family(n), 0));
+ break;
+ case delimiter_node:
+ lua_pushinteger(L, tex_fam_fnt(delimiter_small_family(n), 0));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setfont(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_font(n) = tex_checked_font(lmt_tohalfword(L, 2));
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ glyph_character(n) = lmt_tohalfword(L, 3);
+ }
+ break;
+ case rule_node:
+ tex_set_rule_font(n, lmt_tohalfword(L, 2));
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ rule_character(n) = lmt_tohalfword(L, 3);
+ }
+ break;
+ case glue_node:
+ glue_font(n) = tex_checked_font(lmt_tohalfword(L, 2));
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getchardict(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_properties(n));
+ lua_pushinteger(L, glyph_group(n));
+ lua_pushinteger(L, glyph_index(n));
+ lua_pushinteger(L, glyph_font(n));
+ lua_pushinteger(L, glyph_character(n));
+ return 5;
+ case math_char_node:
+ case math_text_char_node:
+ lua_pushinteger(L, kernel_math_properties(n));
+ lua_pushinteger(L, kernel_math_group(n));
+ lua_pushinteger(L, kernel_math_index(n));
+ lua_pushinteger(L, tex_fam_fnt(kernel_math_family(n),0));
+ lua_pushinteger(L, kernel_math_character(n));
+ return 5;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setchardict(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_properties(n) = lmt_optquarterword(L, 2, 0);
+ glyph_group(n) = lmt_optquarterword(L, 3, 0);
+ glyph_index(n) = lmt_opthalfword(L, 4, 0);
+ break;
+ case math_char_node:
+ case math_text_char_node:
+ kernel_math_properties(n) = lmt_optquarterword(L, 2, 0);
+ kernel_math_group(n) = lmt_optquarterword(L, 3, 0);
+ kernel_math_index(n) = lmt_opthalfword(L, 4, 0);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getchar */
+/* node.direct.setchar */
+
+static int nodelib_direct_getchar(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch(node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_character(n));
+ break;
+ case rule_node:
+ lua_pushinteger(L, rule_character(n));
+ break;
+ case math_char_node:
+ case math_text_char_node:
+ lua_pushinteger(L, kernel_math_character(n));
+ break;
+ case delimiter_node:
+ /* used in wide fonts */
+ lua_pushinteger(L, delimiter_small_character(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setchar(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && lua_type(L, 2) == LUA_TNUMBER) {
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_character(n) = lmt_tohalfword(L, 2);
+ break;
+ case rule_node:
+ rule_character(n) = lmt_tohalfword(L, 2);
+ break;
+ case math_char_node:
+ case math_text_char_node:
+ kernel_math_character(n) = lmt_tohalfword(L, 2);
+ break;
+ case delimiter_node:
+ /* used in wide fonts */
+ delimiter_small_character(n) = lmt_tohalfword(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* bonus */
+
+static int nodelib_direct_getcharspec(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ AGAIN:
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_character(n));
+ lua_pushinteger(L, glyph_font(n));
+ return 2;
+ case rule_node:
+ lua_pushinteger(L, rule_character(n));
+ lua_pushinteger(L, tex_get_rule_font(n, text_style));
+ break;
+ case simple_noad:
+ n = noad_nucleus(n);
+ if (n) {
+ goto AGAIN;
+ } else {
+ break;
+ }
+ case math_char_node:
+ case math_text_char_node:
+ lua_pushinteger(L, kernel_math_character(n));
+ lua_pushinteger(L, tex_fam_fnt(kernel_math_family(n), 0));
+ lua_pushinteger(L, kernel_math_family(n));
+ return 3;
+ case delimiter_node:
+ lua_pushinteger(L, delimiter_small_character(n));
+ lua_pushinteger(L, tex_fam_fnt(delimiter_small_family(n), 0));
+ lua_pushinteger(L, delimiter_small_family(n));
+ return 3;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getfam */
+/* node.direct.setfam */
+
+static int nodelib_direct_getfam(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch(node_type(n)) {
+ case math_char_node:
+ case math_text_char_node:
+ lua_pushinteger(L, kernel_math_family(n));
+ break;
+ case delimiter_node:
+ lua_pushinteger(L, delimiter_small_family(n));
+ break;
+ case fraction_noad:
+ case simple_noad:
+ lua_pushinteger(L, noad_family(n));
+ break;
+ case rule_node:
+ lua_pushinteger(L, tex_get_rule_family(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setfam(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && lua_type(L, 2) == LUA_TNUMBER) {
+ switch (node_type(n)) {
+ case math_char_node:
+ case math_text_char_node:
+ kernel_math_family(n) = lmt_tohalfword(L, 2);
+ break;
+ case delimiter_node:
+ delimiter_small_family(n) = lmt_tohalfword(L, 2);
+ break;
+ case fraction_noad:
+ case simple_noad:
+ set_noad_family(n, lmt_tohalfword(L, 2));
+ break;
+ case rule_node:
+ tex_set_rule_family(n, lmt_tohalfword(L, 2));
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getstate(n) */
+/* node.direct.setstate(n) */
+
+/*tex
+ A zero state is considered to be false or basically the same as \quote {unset}. That way we
+ can are compatible with an unset property. This is cheaper on testing too. But I might
+ reconsider this at some point. (In which case I need to adapt the context source but by then
+ we have a lua/lmt split.)
+*/
+
+static int nodelib_direct_getstate(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int state = 0;
+ switch (node_type(n)) {
+ case glyph_node:
+ state = get_glyph_state(n);
+ break;
+ case hlist_node:
+ case vlist_node:
+ state = box_package_state(n);
+ break;
+ default:
+ goto NOPPES;
+ }
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ lua_pushboolean(L, lua_tointeger(L, 2) == state);
+ return 1;
+ } else if (state) {
+ lua_pushinteger(L, state);
+ return 1;
+ } else {
+ /*tex Indeed, |nil|. */
+ }
+ }
+ NOPPES:
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setstate(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ set_glyph_state(n, lmt_opthalfword(L, 2, 0));
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_package_state(n) = (singleword) lmt_opthalfword(L, 2, 0);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getclass(n,main,left,right) */
+/* node.direct.setclass(n,main,left,right) */
+
+static int nodelib_direct_getclass(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ lua_push_integer(L, get_noad_main_class(n));
+ lua_push_integer(L, get_noad_left_class(n));
+ lua_push_integer(L, get_noad_right_class(n));
+ return 3;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setclass(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ set_noad_main_class(n, lmt_tohalfword(L, 2));
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ set_noad_left_class(n, lmt_tohalfword(L, 3));
+ }
+ if (lua_type(L, 4) == LUA_TNUMBER) {
+ set_noad_right_class(n, lmt_tohalfword(L, 4));
+ }
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getscript(n) */
+/* node.direct.setscript(n) */
+
+static int nodelib_direct_getscript(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node && get_glyph_script(n)) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ lua_pushboolean(L, lua_tointeger(L, 2) == get_glyph_script(n));
+ } else {
+ lua_pushinteger(L, get_glyph_script(n));
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setscript(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ set_glyph_script(n, lmt_opthalfword(L, 2, 0));
+ }
+ return 0;
+}
+
+/* node.direct.getlang */
+/* node.direct.setlang */
+
+static int nodelib_direct_getlanguage(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ lua_pushinteger(L, get_glyph_language(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setlanguage(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ set_glyph_language(n, lmt_opthalfword(L, 2, 0));
+ }
+ return 0;
+}
+
+/* node.direct.getattributelist */
+/* node.direct.setattributelist */
+
+static int nodelib_direct_getattributelist(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && tex_nodetype_has_attributes(node_type(n)) && node_attr(n)) {
+ if (lua_toboolean(L, 2)) {
+ nodelib_push_attribute_data(L, n);
+ } else {
+ lua_pushinteger(L, node_attr(n));
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static void nodelib_aux_setattributelist(lua_State *L, halfword n, int index)
+{
+ if (n && tex_nodetype_has_attributes(node_type(n))) {
+ halfword a = null;
+ switch (lua_type(L, index)) {
+ case LUA_TNUMBER:
+ {
+ halfword m = nodelib_valid_direct_from_index(L, index);
+ if (m) {
+ quarterword t = node_type(m);
+ if (t == attribute_node) {
+ if (node_subtype(m) == attribute_list_subtype) {
+ a = m;
+ } else {
+ /* invalid list, we could make a proper one if needed */
+ }
+ } else if (tex_nodetype_has_attributes(t)) {
+ a = node_attr(m);
+ }
+ }
+ }
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, index)) {
+ a = tex_current_attribute_list();
+ }
+ break;
+ case LUA_TTABLE:
+ {
+ /* kind of slow because we need a sorted inject */
+ lua_pushnil(L); /* push initial key */
+ while (lua_next(L, index)) {
+ halfword key = lmt_tohalfword(L, -2);
+ halfword val = lmt_tohalfword(L, -1);
+ a = tex_patch_attribute_list(a, key, val);
+ lua_pop(L, 1); /* pop value, keep key */
+ }
+ lua_pop(L, 1); /* pop key */
+ }
+ break;
+ }
+ tex_attach_attribute_list_attribute(n, a);
+ }
+}
+
+static int nodelib_direct_setattributelist(lua_State *L)
+{
+ nodelib_aux_setattributelist(L, nodelib_valid_direct_from_index(L, 1), 2);
+ return 0;
+}
+
+/* node.direct.getpenalty */
+/* node.direct.setpenalty */
+
+static int nodelib_direct_getpenalty(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case penalty_node:
+ lua_pushinteger(L, penalty_amount(n));
+ break;
+ case disc_node:
+ lua_pushinteger(L, disc_penalty(n));
+ break;
+ case math_node:
+ lua_pushinteger(L, math_penalty(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setpenalty(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case penalty_node:
+ penalty_amount(n) = (halfword) luaL_optinteger(L, 2, 0);
+ break;
+ case disc_node:
+ disc_penalty(n) = (halfword) luaL_optinteger(L, 2, 0);
+ break;
+ case math_node:
+ math_penalty(n) = (halfword) luaL_optinteger(L, 2, 0);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getnucleus */
+/* node.direct.getsub */
+/* node.direct.getsup */
+
+static int nodelib_direct_getnucleus(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, noad_nucleus(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setnucleus(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ noad_nucleus(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getsub(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, noad_subscr(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getsubpre(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, noad_subprescr(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setsub(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ noad_subscr(n) = nodelib_valid_direct_from_index(L, 2);
+ // if (lua_gettop(L) > 2) {
+ // noad_subprescr(n) = nodelib_valid_direct_from_index(L, 3);
+ // }
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setsubpre(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ noad_subprescr(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getsup(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, noad_supscr(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getsuppre(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, noad_supprescr(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getprime(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, noad_prime(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setsup(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ noad_supscr(n) = nodelib_valid_direct_from_index(L, 2);
+ // if (lua_gettop(L) > 2) {
+ // supprescr(n) = nodelib_valid_direct_from_index(L, 3);
+ // }
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setsuppre(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ noad_supprescr(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setprime(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ noad_prime(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getkern (overlaps with getwidth) */
+/* node.direct.setkern (overlaps with getwidth) */
+
+static int nodelib_direct_getkern(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case kern_node:
+ lua_pushnumber(L, kern_amount(n));
+ if (lua_toboolean(L, 2)) {
+ lua_pushinteger(L, kern_expansion(n));
+ return 2;
+ } else {
+ break;
+ }
+ case math_node:
+ lua_pushinteger(L, math_surround(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setkern(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case kern_node:
+ kern_amount(n) = lua_type(L, 2) == LUA_TNUMBER ? (halfword) lmt_roundnumber(L, 2) : 0;
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ node_subtype(n) = lmt_toquarterword(L, 3);
+ }
+ break;
+ case math_node:
+ math_surround(n) = lua_type(L, 2) == LUA_TNUMBER ? (halfword) lmt_roundnumber(L, 2) : 0;
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getdirection */
+/* node.direct.setdirection */
+
+static int nodelib_direct_getdirection(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case dir_node:
+ lua_pushinteger(L, dir_direction(n));
+ lua_pushboolean(L, node_subtype(n));
+ return 2;
+ case hlist_node:
+ case vlist_node:
+ lua_pushinteger(L, checked_direction_value(box_dir(n)));
+ break;
+ case par_node:
+ lua_pushinteger(L, par_dir(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setdirection(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case dir_node:
+ dir_direction(n) = nodelib_getdirection(L, 2);
+ if (lua_type(L, 3) == LUA_TBOOLEAN) {
+ if (lua_toboolean(L, 3)) {
+ node_subtype(n) = (quarterword) (lua_toboolean(L, 3) ? cancel_dir_subtype : normal_dir_subtype);
+ }
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_dir(n) = (singleword) nodelib_getdirection(L, 2);
+ break;
+ case par_node:
+ par_dir(n) = nodelib_getdirection(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getanchors */
+/* node.direct.setanchors */
+
+static int nodelib_direct_getanchors(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ if (box_anchor(n)) {
+ lua_pushinteger(L, box_anchor(n));
+ } else {
+ lua_pushnil(L);
+ }
+ if (box_source_anchor(n)) {
+ lua_pushinteger(L, box_source_anchor(n));
+ } else {
+ lua_pushnil(L);
+ }
+ if (box_target_anchor(n)) {
+ lua_pushinteger(L, box_target_anchor(n));
+ } else {
+ lua_pushnil(L);
+ }
+ /* bonus detail: source, target */
+ if (box_source_anchor(n)) {
+ lua_pushinteger(L, box_anchor(n) & 0x0FFF);
+ } else {
+ lua_pushnil(L);
+ }
+ if (box_target_anchor(n)) {
+ lua_pushinteger(L, (box_anchor(n) >> 16) & 0x0FFF);
+ } else {
+ lua_pushnil(L);
+ }
+ return 5;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ if (noad_source(n)) {
+ lua_pushinteger(L, noad_source(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setanchors(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ box_anchor(n) = lmt_tohalfword(L, 2);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 2)) {
+ break;
+ }
+ break;
+ default:
+ box_anchor(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 3)) {
+ case LUA_TNUMBER :
+ box_source_anchor(n) = lmt_tohalfword(L, 3);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 3)) {
+ break;
+ }
+ default:
+ box_source_anchor(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 4)) {
+ case LUA_TNUMBER:
+ box_target_anchor(n) = lmt_tohalfword(L, 4);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 4)) {
+ break;
+ }
+ default:
+ box_target_anchor(n) = 0;
+ break;
+ }
+ tex_check_box_geometry(n);
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER :
+ noad_source(n) = lmt_tohalfword(L, 2);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 2)) {
+ break;
+ }
+ default:
+ noad_source(n) = 0;
+ break;
+ }
+ tex_check_box_geometry(n);
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getxoffset */
+/* node.direct.getyoffset */
+/* node.direct.getoffsets */
+/* node.direct.setxoffset */
+/* node.direct.setyoffset */
+/* node.direct.setoffsets */
+
+static int nodelib_direct_getoffsets(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_x_offset(n));
+ lua_pushinteger(L, glyph_y_offset(n));
+ lua_pushinteger(L, glyph_left(n));
+ lua_pushinteger(L, glyph_right(n));
+ lua_pushinteger(L, glyph_raise(n));
+ return 5;
+ case hlist_node:
+ case vlist_node:
+ lua_pushinteger(L, box_x_offset(n));
+ lua_pushinteger(L, box_y_offset(n));
+ return 2;
+ case rule_node:
+ lua_pushinteger(L, rule_x_offset(n));
+ lua_pushinteger(L, rule_y_offset(n));
+ lua_pushinteger(L, rule_left(n));
+ lua_pushinteger(L, rule_right(n));
+ return 4;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setoffsets(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ glyph_x_offset(n) = (halfword) lmt_roundnumber(L, 2);
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ glyph_y_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ }
+ if (lua_type(L, 4) == LUA_TNUMBER) {
+ glyph_left(n) = (halfword) lmt_roundnumber(L, 4);
+ }
+ if (lua_type(L, 5) == LUA_TNUMBER) {
+ glyph_right(n) = (halfword) lmt_roundnumber(L, 5);
+ }
+ if (lua_type(L, 6) == LUA_TNUMBER) {
+ glyph_raise(n) = (halfword) lmt_roundnumber(L, 6);
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ box_x_offset(n) = (halfword) lmt_roundnumber(L, 2);
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ box_y_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ }
+ tex_check_box_geometry(n);
+ break;
+ case rule_node:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ rule_x_offset(n) = (halfword) lmt_roundnumber(L, 2);
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ rule_y_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ }
+ if (lua_type(L, 4) == LUA_TNUMBER) {
+ rule_left(n) = (halfword) lmt_roundnumber(L, 4);
+ }
+ if (lua_type(L, 5) == LUA_TNUMBER) {
+ rule_right(n) = (halfword) lmt_roundnumber(L, 5);
+ }
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_addxoffset(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_x_offset(n) += (halfword) lmt_roundnumber(L, 2);
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_x_offset(n) += (halfword) lmt_roundnumber(L, 2);
+ tex_check_box_geometry(n);
+ break;
+ case rule_node:
+ rule_x_offset(n) += (halfword) lmt_roundnumber(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_addyoffset(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_y_offset(n) += (halfword) lmt_roundnumber(L, 2);
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_y_offset(n) += (halfword) lmt_roundnumber(L, 2);
+ tex_check_box_geometry(n);
+ break;
+ case rule_node:
+ rule_y_offset(n) += (halfword) lmt_roundnumber(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* */
+
+static int nodelib_direct_addmargins(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ glyph_left(n) += (halfword) lmt_roundnumber(L, 2);
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ glyph_right(n) += (halfword) lmt_roundnumber(L, 3);
+ }
+ if (lua_type(L, 4) == LUA_TNUMBER) {
+ glyph_raise(n) += (halfword) lmt_roundnumber(L, 3);
+ }
+ break;
+ case rule_node:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ rule_left(n) += (halfword) lmt_roundnumber(L, 2);
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ rule_right(n) += (halfword) lmt_roundnumber(L, 3);
+ }
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_addxymargins(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ scaled s = glyph_scale(n);
+ scaled x = glyph_x_scale(n);
+ scaled y = glyph_y_scale(n);
+ double sx, sy;
+ if (s == 0 || s == 1000) {
+ if (x == 0 || x == 1000) {
+ sx = 1;
+ } else {
+ sx = 0.001 * x;
+ }
+ if (y == 0 || y == 1000) {
+ sy = 1;
+ } else {
+ sy = 0.001 * y;
+ }
+ } else {
+ if (x == 0 || x == 1000) {
+ sx = 0.001 * s;
+ } else {
+ sx = 0.000001 * s * x;
+ }
+ if (y == 0 || y == 1000) {
+ sy = 0.001 * s;
+ } else {
+ sy = 0.000001 * s * y;
+ }
+ }
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ glyph_left(n) += scaledround(sx * lua_tonumber(L, 2));
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ glyph_right(n) += scaledround(sx * lua_tonumber(L, 3));
+ }
+ if (lua_type(L, 4) == LUA_TNUMBER) {
+ glyph_raise(n) += scaledround(sy * lua_tonumber(L, 4));
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getscale */
+/* node.direct.getxscale */
+/* node.direct.getyscale */
+/* node.direct.getxyscale */
+/* node.direct.setscale */
+/* node.direct.setxscale */
+/* node.direct.setyscale */
+/* node.direct.setxyscale */
+
+static int nodelib_direct_getscale(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ lua_pushinteger(L, glyph_scale(n));
+ return 1;
+ }
+ return 0;
+}
+
+static int nodelib_direct_getscales(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ lua_pushinteger(L, glyph_scale(n));
+ lua_pushinteger(L, glyph_x_scale(n));
+ lua_pushinteger(L, glyph_y_scale(n));
+ return 3;
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_setscales(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ glyph_scale(n) = (halfword) lmt_roundnumber(L, 2);
+ if (! glyph_scale(n)) {
+ glyph_scale(n) = 1000;
+ }
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ glyph_x_scale(n) = (halfword) lmt_roundnumber(L, 3);
+ if (! glyph_x_scale(n)) {
+ glyph_x_scale(n) = 1000;
+ }
+ }
+ if (lua_type(L, 4) == LUA_TNUMBER) {
+ glyph_y_scale(n) = (halfword) lmt_roundnumber(L, 4);
+ if (! glyph_y_scale(n)) {
+ glyph_y_scale(n) = 1000;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getxscale(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ scaled s = glyph_scale(n);
+ scaled x = glyph_x_scale(n);
+ double d;
+ if (s == 0 || s == 1000) {
+ if (x == 0 || x == 1000) {
+ goto DONE;
+ } else {
+ d = 0.001 * x;
+ }
+ } else if (x == 0 || x == 1000) {
+ d = 0.001 * s;
+ } else {
+ d = 0.000001 * s * x;
+ }
+ lua_pushnumber(L, d);
+ return 1;
+ }
+ DONE:
+ lua_pushinteger(L, 1);
+ return 1;
+}
+
+static int nodelib_direct_xscaled(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ lua_Number v = lua_tonumber(L, 2);
+ if (n && node_type(n) == glyph_node) {
+ scaled s = glyph_scale(n);
+ scaled x = glyph_x_scale(n);
+ if (s == 0 || s == 1000) {
+ if (x == 0 || x == 1000) {
+ /* okay */
+ } else {
+ v = 0.001 * x * v;
+ }
+ } else if (x == 0 || x == 1000) {
+ v = 0.001 * s * v;
+ } else {
+ v = 0.000001 * s * x * v;
+ }
+ }
+ lua_pushnumber(L, v);
+ return 1;
+}
+
+static int nodelib_direct_getyscale(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ scaled s = glyph_scale(n);
+ scaled y = glyph_y_scale(n);
+ double d;
+ if (s == 0 || s == 1000) {
+ if (y == 0 || y == 1000) {
+ goto DONE;
+ } else {
+ d = 0.001 * y;
+ }
+ } else if (y == 0 || y == 1000) {
+ d = 0.001 * s;
+ } else {
+ d = 0.000001 * s * y;
+ }
+ lua_pushnumber(L, d);
+ return 1;
+ }
+ DONE:
+ lua_pushinteger(L, 1);
+ return 1;
+}
+
+static int nodelib_direct_yscaled(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ lua_Number v = lua_tonumber(L, 2);
+ if (n && node_type(n) == glyph_node) {
+ scaled s = glyph_scale(n);
+ scaled y = glyph_y_scale(n);
+ if (s == 0 || s == 1000) {
+ if (y == 0 || y == 1000) {
+ /* okay */
+ } else {
+ v = 0.001 * y * v;
+ }
+ } else if (y == 0 || y == 1000) {
+ v = 0.001 * s * v;
+ } else {
+ v = 0.000001 * s * y * v;
+ }
+ }
+ lua_pushnumber(L, v);
+ return 1;
+}
+
+static void nodelib_aux_pushxyscales(lua_State *L, halfword n)
+{
+ scaled s = glyph_scale(n);
+ scaled x = glyph_x_scale(n);
+ scaled y = glyph_y_scale(n);
+ double dx;
+ double dy;
+ if (s && s != 1000) {
+ dx = (x && x != 1000) ? 0.000001 * s * x : 0.001 * s;
+ } else if (x && x != 1000) {
+ dx = 0.001 * x;
+ } else {
+ lua_pushinteger(L, 1);
+ goto DONEX;
+ }
+ lua_pushnumber(L, dx);
+ DONEX:
+ if (s && s != 1000) {
+ dy = (y && y != 1000) ? 0.000001 * s * y : 0.001 * s;
+ } else if (y && y != 1000) {
+ dy = 0.001 * y;
+ } else {
+ lua_pushinteger(L, 1);
+ goto DONEY;
+ }
+ lua_pushnumber(L, dy);
+ DONEY: ;
+}
+
+static int nodelib_direct_getxyscales(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ nodelib_aux_pushxyscales(L, n);
+ } else {
+ lua_pushinteger(L, 1);
+ lua_pushinteger(L, 1);
+ }
+ return 2;
+}
+
+/* node.direct.getdisc */
+/* node.direct.setdisc */
+
+/*tex
+ For the moment we don't provide setters for math discretionaries, mainly because these are
+ special and I don't want to waste time on checking and intercepting errors. They are not that
+ widely used anyway.
+*/
+
+static int nodelib_direct_getdisc(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case disc_node:
+ nodelib_push_direct_or_nil(L, disc_pre_break_head(n));
+ nodelib_push_direct_or_nil(L, disc_post_break_head(n));
+ nodelib_push_direct_or_nil(L, disc_no_break_head(n));
+ if (lua_isboolean(L, 2) && lua_toboolean(L, 2)) {
+ nodelib_push_direct_or_nil(L, disc_pre_break_tail(n));
+ nodelib_push_direct_or_nil(L, disc_post_break_tail(n));
+ nodelib_push_direct_or_nil(L, disc_no_break_tail(n));
+ return 6;
+ } else {
+ return 3;
+ }
+ case choice_node:
+ if (node_subtype(n) == discretionary_choice_subtype) {
+ nodelib_push_direct_or_nil(L, choice_pre_break(n));
+ nodelib_push_direct_or_nil(L, choice_post_break(n));
+ nodelib_push_direct_or_nil(L, choice_no_break(n));
+ if (lua_isboolean(L, 2) && lua_toboolean(L, 2)) {
+ nodelib_push_direct_or_nil(L, tex_tail_of_node_list(choice_pre_break(n)));
+ nodelib_push_direct_or_nil(L, tex_tail_of_node_list(choice_post_break(n)));
+ nodelib_push_direct_or_nil(L, tex_tail_of_node_list(choice_post_break(n)));
+ return 6;
+ } else {
+ return 3;
+ }
+ } else {
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getdiscpart(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ lua_pushinteger(L, get_glyph_discpart(n));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_getpre(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case disc_node:
+ nodelib_push_direct_or_nil(L, disc_pre_break_head(n));
+ nodelib_push_direct_or_nil(L, disc_pre_break_tail(n));
+ return 2;
+ case hlist_node:
+ case vlist_node:
+ {
+ halfword h = box_pre_migrated(n);
+ halfword t = tex_tail_of_node_list(h);
+ nodelib_push_direct_or_nil(L, h);
+ nodelib_push_direct_or_nil(L, t);
+ return 2;
+ }
+ case choice_node:
+ if (node_subtype(n) == discretionary_choice_subtype) {
+ nodelib_push_direct_or_nil(L, choice_pre_break(n));
+ return 1;
+ } else {
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getpost(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case disc_node:
+ nodelib_push_direct_or_nil(L, disc_post_break_head(n));
+ nodelib_push_direct_or_nil(L, disc_post_break_tail(n));
+ return 2;
+ case hlist_node:
+ case vlist_node:
+ {
+ halfword h = box_post_migrated(n);
+ halfword t = tex_tail_of_node_list(h);
+ nodelib_push_direct_or_nil(L, h);
+ nodelib_push_direct_or_nil(L, t);
+ return 2;
+ }
+ case choice_node:
+ if (node_subtype(n) == discretionary_choice_subtype) {
+ nodelib_push_direct_or_nil(L, choice_post_break(n));
+ return 1;
+ } else {
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getreplace(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case disc_node:
+ nodelib_push_direct_or_nil(L, disc_no_break_head(n));
+ nodelib_push_direct_or_nil(L, disc_no_break_tail(n));
+ return 2;
+ case choice_node:
+ if (node_subtype(n) == discretionary_choice_subtype) {
+ nodelib_push_direct_or_nil(L, choice_no_break(n));
+ return 1;
+ } else {
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setdisc(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == disc_node) {
+ int t = lua_gettop(L) ;
+ if (t > 1) {
+ tex_set_disc_field(n, pre_break_code, nodelib_valid_direct_from_index(L, 2));
+ if (t > 2) {
+ tex_set_disc_field(n, post_break_code, nodelib_valid_direct_from_index(L, 3));
+ if (t > 3) {
+ tex_set_disc_field(n, no_break_code, nodelib_valid_direct_from_index(L, 4));
+ if (t > 4) {
+ node_subtype(n) = lmt_toquarterword(L, 5);
+ if (t > 5) {
+ disc_penalty(n) = lmt_tohalfword(L, 6);
+ }
+ }
+ } else {
+ tex_set_disc_field(n, no_break_code, null);
+ }
+ } else {
+ tex_set_disc_field(n, post_break_code, null);
+ tex_set_disc_field(n, no_break_code, null);
+ }
+ } else {
+ tex_set_disc_field(n, pre_break_code, null);
+ tex_set_disc_field(n, post_break_code, null);
+ tex_set_disc_field(n, no_break_code, null);
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setdiscpart(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ set_glyph_discpart(n, luaL_optinteger(L, 2, glyph_discpart_unset));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_setpre(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword m = (lua_gettop(L) > 1) ? nodelib_valid_direct_from_index(L, 2) : null;
+ switch (node_type(n)) {
+ case disc_node:
+ tex_set_disc_field(n, pre_break_code, m);
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_pre_migrated(n) = m;
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setpost(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword m = (lua_gettop(L) > 1) ? nodelib_valid_direct_from_index(L, 2) : null;
+ switch (node_type(n)) {
+ case disc_node:
+ tex_set_disc_field(n, post_break_code, m);
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_post_migrated(n) = m;
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setreplace(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == disc_node) {
+ halfword m = (lua_gettop(L) > 1) ? nodelib_valid_direct_from_index(L, 2) : null;
+ tex_set_disc_field(n, no_break_code, m);
+ }
+ return 0;
+}
+
+/* node.direct.getwidth */
+/* node.direct.setwidth */
+/* node.direct.getheight (for consistency) */
+/* node.direct.setheight (for consistency) */
+/* node.direct.getdepth (for consistency) */
+/* node.direct.setdepth (for consistency) */
+
+/* split ifs for clearity .. compiler will optimize */
+
+static int nodelib_direct_getwidth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushinteger(L, box_width(n));
+ break;
+ case align_record_node:
+ lua_pushinteger(L, box_width(n));
+ if (lua_toboolean(L, 2)) {
+ lua_pushinteger(L, box_size(n));
+ return 2;
+ }
+ break;
+ case rule_node:
+ lua_pushinteger(L, rule_width(n));
+ break;
+ case glue_node:
+ case glue_spec_node:
+ lua_pushinteger(L, glue_amount(n));
+ break;
+ case glyph_node:
+ lua_pushnumber(L, tex_glyph_width(n));
+ if (lua_toboolean(L, 2)) {
+ lua_pushinteger(L, glyph_expansion(n));
+ return 2;
+ }
+ break;
+ case kern_node:
+ lua_pushinteger(L, kern_amount(n));
+ if (lua_toboolean(L, 2)) {
+ lua_pushinteger(L, kern_expansion(n));
+ return 2;
+ }
+ break;
+ case math_node:
+ lua_pushinteger(L, math_amount(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setwidth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ case align_record_node:
+ box_width(n) = lua_type(L, 2) == LUA_TNUMBER ? lmt_roundnumber(L, 2) : 0;
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ box_size(n) = lmt_roundnumber(L, 3);
+ box_package_state(n) = package_dimension_size_set;
+ }
+ break;
+ case rule_node:
+ rule_width(n) = lua_type(L, 2) == LUA_TNUMBER ? lmt_roundnumber(L, 2) : 0;
+ break;
+ case glue_node:
+ case glue_spec_node:
+ glue_amount(n) = lua_type(L, 2) == LUA_TNUMBER ? lmt_roundnumber(L, 2) : 0;
+ break;
+ case kern_node:
+ kern_amount(n) = lua_type(L, 2) == LUA_TNUMBER ? lmt_roundnumber(L, 2) : 0;
+ break;
+ case math_node:
+ math_amount(n) = lua_type(L, 2) == LUA_TNUMBER ? lmt_roundnumber(L, 2) : 0;
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getindex(lua_State* L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ lua_pushinteger(L, box_index(n));
+ break;
+ case insert_node:
+ lua_pushinteger(L, insert_index(n));
+ break;
+ case mark_node:
+ lua_pushinteger(L, mark_index(n));
+ break;
+ case adjust_node:
+ lua_pushinteger(L, adjust_index(n));
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setindex(lua_State* L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ halfword index = lmt_tohalfword(L, 2);
+ if (tex_valid_box_index(index)) {
+ box_index(n) = index;
+ } else {
+ /* error or just ignore */
+ }
+ break;
+ }
+ case insert_node:
+ {
+ halfword index = lmt_tohalfword(L, 2);
+ if (tex_valid_insert_id(index)) {
+ insert_index(n) = index;
+ } else {
+ /* error or just ignore */
+ }
+ break;
+ }
+ case mark_node:
+ {
+ halfword index = lmt_tohalfword(L, 2);
+ if (tex_valid_mark(index)) {
+ mark_index(n) = index;
+ }
+ }
+ break;
+ case adjust_node:
+ {
+ halfword index = lmt_tohalfword(L, 2);
+ if (tex_valid_adjust_index(index)) {
+ adjust_index(n) = index;
+ }
+ }
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_getheight(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushinteger(L, box_height(n));
+ break;
+ case rule_node:
+ lua_pushinteger(L, rule_height(n));
+ break;
+ case insert_node:
+ lua_pushinteger(L, insert_total_height(n));
+ break;
+ case glyph_node:
+ lua_pushinteger(L, tex_glyph_height(n));
+ break;
+ case fence_noad:
+ lua_pushinteger(L, noad_height(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setheight(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword h = 0;
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ h = lmt_roundnumber(L, 2);
+ }
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ box_height(n) = h;
+ break;
+ case rule_node:
+ rule_height(n) = h;
+ break;
+ case insert_node:
+ insert_total_height(n) = h;
+ break;
+ case fence_noad:
+ noad_height(n) = h;
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getdepth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushinteger(L, box_depth(n));
+ break;
+ case rule_node:
+ lua_pushinteger(L, rule_depth(n));
+ break;
+ case insert_node:
+ lua_pushinteger(L, insert_max_depth(n));
+ break;
+ case glyph_node:
+ lua_pushinteger(L, tex_glyph_depth(n));
+ break;
+ case fence_noad:
+ lua_pushinteger(L, noad_depth(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setdepth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword d = 0;
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ d = lmt_roundnumber(L, 2);
+ }
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ box_depth(n) = d;
+ break;
+ case rule_node:
+ rule_depth(n) = d;
+ break;
+ case insert_node:
+ insert_max_depth(n) = d;
+ break;
+ case fence_noad:
+ noad_depth(n) = d;
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_gettotal(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushinteger(L, (lua_Integer) box_total(n));
+ break;
+ case rule_node:
+ lua_pushinteger(L, (lua_Integer) rule_total(n));
+ break;
+ case insert_node:
+ lua_pushinteger(L, (lua_Integer) insert_total_height(n));
+ break;
+ case glyph_node:
+ lua_pushinteger(L, (lua_Integer) tex_glyph_total(n));
+ break;
+ case fence_noad:
+ lua_pushinteger(L, (lua_Integer) noad_total(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_settotal(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case insert_node:
+ insert_total_height(n) = lua_type(L, 2) == LUA_TNUMBER ? (halfword) lmt_roundnumber(L,2) : 0;
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getshift */
+/* node.direct.setshift */
+
+static int nodelib_direct_getshift(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ lua_pushinteger(L, box_shift_amount(n));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setshift(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ box_shift_amount(n) = (halfword) lmt_roundnumber(L,2);
+ } else {
+ box_shift_amount(n) = 0;
+ }
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.hasgeometry */
+/* node.direct.getgeometry */
+/* node.direct.setgeometry */
+/* node.direct.getorientation */
+/* node.direct.setorientation */
+
+static int nodelib_direct_hasgeometry(lua_State* L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ if (box_geometry(n)) {
+ lua_pushinteger(L, box_geometry(n));
+ return 1;
+ }
+ }
+ }
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int nodelib_direct_getgeometry(lua_State* L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ if (box_geometry(n)) {
+ lua_pushinteger(L, box_geometry(n));
+ if (lua_toboolean(L, 2)) {
+ lua_pushboolean(L, tex_has_box_geometry(n, offset_geometry));
+ lua_pushboolean(L, tex_has_box_geometry(n, orientation_geometry));
+ lua_pushboolean(L, tex_has_box_geometry(n, anchor_geometry));
+ return 4;
+ } else {
+ return 1;
+ }
+ }
+ break;
+ }
+ }
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int nodelib_direct_setgeometry(lua_State* L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ box_geometry(n) = (singleword) lmt_tohalfword(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getorientation(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ lua_pushinteger(L, box_orientation(n));
+ lua_pushinteger(L, box_x_offset(n));
+ lua_pushinteger(L, box_y_offset(n));
+ lua_pushinteger(L, box_w_offset(n));
+ lua_pushinteger(L, box_h_offset(n));
+ lua_pushinteger(L, box_d_offset(n));
+ return 6;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setorientation(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ box_orientation(n) = lmt_tohalfword(L, 2);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 2)) {
+ break;
+ }
+ default:
+ box_orientation(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 3)) {
+ case LUA_TNUMBER:
+ box_x_offset(n) = lmt_tohalfword(L, 3);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 3)) {
+ break;
+ }
+ default:
+ box_x_offset(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 4)) {
+ case LUA_TNUMBER:
+ box_y_offset(n) = lmt_tohalfword(L, 4);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 4)) {
+ break;
+ }
+ default:
+ box_y_offset(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 5)) {
+ case LUA_TNUMBER:
+ box_w_offset(n) = lmt_tohalfword(L, 5);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 5)) {
+ break;
+ }
+ default:
+ box_w_offset(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 6)) {
+ case LUA_TNUMBER:
+ box_h_offset(n) = lmt_tohalfword(L, 6);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 6)) {
+ break;
+ }
+ default:
+ box_h_offset(n) = 0;
+ break;
+ }
+ switch (lua_type(L, 7)) {
+ case LUA_TNUMBER:
+ box_d_offset(n) = lmt_tohalfword(L, 7);
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 7)) {
+ break;
+ }
+ default:
+ box_d_offset(n) = 0;
+ break;
+ }
+ tex_check_box_geometry(n);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.setoptions */
+/* node.direct.getoptions */
+
+static int nodelib_direct_getoptions(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_options(n));
+ return 1;
+ case disc_node:
+ lua_pushinteger(L, disc_options(n));
+ return 1;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ lua_pushinteger(L, noad_options(n));
+ return 1;
+ case math_char_node:
+ case math_text_char_node:
+ lua_pushinteger(L, kernel_math_options(n));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setoptions(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ set_glyph_options(n, lmt_tohalfword(L, 2));
+ break;
+ case disc_node:
+ set_disc_options(n, lmt_tohalfword(L, 2));
+ break;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ noad_options(n) = lmt_tohalfword(L, 2);
+ break;
+ case math_char_node:
+ case math_text_char_node:
+ kernel_math_options(n) = lmt_tohalfword(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getwhd */
+/* node.direct.setwhd */
+
+static int nodelib_direct_getwhd(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ AGAIN:
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushinteger(L, box_width(n));
+ lua_pushinteger(L, box_height(n));
+ lua_pushinteger(L, box_depth(n));
+ return 3;
+ case rule_node:
+ lua_pushinteger(L, rule_width(n));
+ lua_pushinteger(L, rule_height(n));
+ lua_pushinteger(L, rule_depth(n));
+ return 3;
+ case glyph_node:
+ /* or glyph_dimensions: */
+ lua_pushinteger(L, tex_glyph_width(n));
+ lua_pushinteger(L, tex_glyph_height(n));
+ lua_pushinteger(L, tex_glyph_depth(n));
+ if (lua_toboolean(L,2)) {
+ lua_pushinteger(L, glyph_expansion(n));
+ return 4;
+ } else {
+ return 3;
+ }
+ case glue_node:
+ n = glue_leader_ptr(n);
+ if (n) {
+ goto AGAIN;
+ } else {
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setwhd(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ AGAIN:
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ {
+ int top = lua_gettop(L) ;
+ if (top > 1) {
+ if ((lua_type(L, 2) == LUA_TNUMBER)) {
+ box_width(n) = (halfword) lmt_roundnumber(L, 2);
+ } else {
+ /*Leave as is */
+ }
+ if (top > 2) {
+ if ((lua_type(L, 3) == LUA_TNUMBER)) {
+ box_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else {
+ /*Leave as is */
+ }
+ if (top > 3) {
+ if ((lua_type(L, 4) == LUA_TNUMBER)) {
+ box_depth(n) = (halfword) lmt_roundnumber(L, 4);
+ } else {
+ /*Leave as is */
+ }
+ }
+ }
+ }
+ }
+ break;
+ case rule_node:
+ {
+ int top = lua_gettop(L) ;
+ if (top > 1) {
+ if ((lua_type(L, 2) == LUA_TNUMBER)) {
+ rule_width(n) = (halfword) lmt_roundnumber(L, 2);
+ } else {
+ /*Leave as is */
+ }
+ if (top > 2) {
+ if ((lua_type(L, 3) == LUA_TNUMBER)) {
+ rule_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else {
+ /*Leave as is */
+ }
+ if (top > 3) {
+ if ((lua_type(L, 4) == LUA_TNUMBER)) {
+ rule_depth(n) = (halfword) lmt_roundnumber(L, 4);
+ } else {
+ /*Leave as is */
+ }
+ }
+ }
+ }
+ }
+ break;
+ case glue_node:
+ n = glue_leader_ptr(n);
+ if (n) {
+ goto AGAIN;
+ } else {
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_hasdimensions(lua_State *L)
+{
+ int b = 0;
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ b = (box_width(n) > 0) || (box_total(n) > 0);
+ break;
+ case rule_node:
+ b = (rule_width(n) > 0) || (rule_total(n) > 0);
+ break;
+ case glyph_node:
+ b = tex_glyph_has_dimensions(n);
+ break;
+ case glue_node:
+ {
+ halfword l = glue_leader_ptr(n);
+ if (l) {
+ switch (node_type(l)) {
+ case hlist_node:
+ case vlist_node:
+ b = (box_width(l) > 0) || (box_total(l) > 0);
+ break;
+ case rule_node:
+ b = (rule_width(l) > 0) || (rule_total(l) > 0);
+ break;
+ }
+ }
+ }
+ break;
+ }
+ }
+ lua_pushboolean(L, b);
+ return 1;
+}
+
+/* node.direct.getglyphwhd */
+
+/*tex
+
+ When the height and depth of a box is calculated the |y-offset| is taken into account. In \LUATEX\
+ this is different for the height and depth, an historic artifact. However, because that can be
+ controlled we now have this helper, mostly for tracing purposes because it listens to the mode
+ parameter (and one can emulate other scenarios already).
+
+*/
+
+static int nodelib_direct_getglyphdimensions(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ scaledwhd whd = tex_glyph_dimensions_ex(n);
+ lua_pushinteger(L, whd.wd);
+ lua_pushinteger(L, whd.ht);
+ lua_pushinteger(L, whd.dp);
+ lua_pushinteger(L, glyph_expansion(n)); /* in case we need it later on */
+ nodelib_aux_pushxyscales(L, n);
+ return 6;
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_getkerndimension(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == kern_node) {
+ lua_pushinteger(L, tex_kern_dimension_ex(n));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* node.direct.getlist */
+
+static int nodelib_direct_getlist(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ case align_record_node:
+ nodelib_push_direct_or_nil_node_prev(L, box_list(n));
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ nodelib_push_direct_or_nil_node_prev(L, kernel_math_list(n));
+ break;
+ case insert_node:
+ /* kind of fuzzy */
+ nodelib_push_direct_or_nil_node_prev(L, insert_list(n));
+ break;
+ case adjust_node:
+ nodelib_push_direct_or_nil_node_prev(L, adjust_list(n));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setlist(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ box_list(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ kernel_math_list(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case insert_node:
+ /* kind of fuzzy */
+ insert_list(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case adjust_node:
+ adjust_list(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getleader */
+/* node.direct.setleader */
+
+static int nodelib_direct_getleader(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glue_node) {
+ nodelib_push_direct_or_nil(L, glue_leader_ptr(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setleader(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glue_node) {
+ glue_leader_ptr(n) = nodelib_valid_direct_from_index(L, 2);
+ }
+ return 0;
+}
+
+/* node.direct.getdata */
+/* node.direct.setdata */
+
+/*tex
+
+ These getter and setter get |data| as well as |value| fields. One can make them equivalent to
+ |getvalue| and |setvalue| if needed.
+
+*/
+
+static int nodelib_direct_getdata(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_data(n));
+ return 1;
+ case rule_node:
+ lua_pushinteger(L, rule_data(n));
+ return 1;
+ case glue_node:
+ lua_pushinteger(L, glue_data(n));
+ return 1;
+ case boundary_node:
+ lua_pushinteger(L, boundary_data(n));
+ return 1;
+ case attribute_node:
+ switch (node_subtype(n)) {
+ case attribute_list_subtype:
+ nodelib_push_attribute_data(L, n);
+ break;
+ case attribute_value_subtype:
+ /*tex Only used for introspection so it's okay to return 2 values. */
+ lua_pushinteger(L, attribute_index(n));
+ lua_pushinteger(L, attribute_value(n));
+ return 2;
+ default:
+ /*tex We just ignore. */
+ break;
+ }
+ case mark_node:
+ if (lua_toboolean(L, 2)) {
+ lmt_token_list_to_luastring(L, mark_ptr(n), 0, 0);
+ } else {
+ lmt_token_list_to_lua(L, mark_ptr(n));
+ }
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setdata(lua_State *L) /* data and value */
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_data(n) = lmt_tohalfword(L, 2);
+ break;
+ case rule_node:
+ rule_data(n) = lmt_tohalfword(L, 2);
+ break;
+ case glue_node:
+ glue_data(n) = lmt_tohalfword(L, 2);
+ break;
+ case boundary_node:
+ boundary_data(n) = lmt_tohalfword(L, 2);
+ break;
+ case attribute_node:
+ /*tex Not supported for now! */
+ break;
+ case mark_node:
+ tex_delete_token_reference(mark_ptr(n));
+ mark_ptr(n) = lmt_token_list_from_lua(L, 2); /* check ref */
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.get[left|right|]delimiter */
+/* node.direct.set[left|right|]delimiter */
+
+static int nodelib_direct_getleftdelimiter(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ nodelib_push_direct_or_nil(L, fraction_left_delimiter(n));
+ return 1;
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, radical_left_delimiter(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getrightdelimiter(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ nodelib_push_direct_or_nil(L, fraction_right_delimiter(n));
+ return 1;
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, radical_right_delimiter(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getdelimiter(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ nodelib_push_direct_or_nil(L, fraction_middle_delimiter(n));
+ return 1;
+ case fence_noad:
+ nodelib_push_direct_or_node(L, n, fence_delimiter_list(n));
+ return 1;
+ case radical_noad:
+ nodelib_push_direct_or_node(L, n, radical_left_delimiter(n));
+ return 1;
+ case accent_noad:
+ nodelib_push_direct_or_node(L, n, accent_middle_character(n)); /* not really a delimiter */
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setleftdelimiter(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ fraction_left_delimiter(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case radical_noad:
+ radical_left_delimiter(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setrightdelimiter(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ fraction_right_delimiter(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case radical_noad:
+ radical_right_delimiter(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setdelimiter(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ fraction_middle_delimiter(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case fence_noad:
+ fence_delimiter_list(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case radical_noad:
+ radical_left_delimiter(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ case accent_noad:
+ accent_middle_character(n) = nodelib_valid_direct_from_index(L, 2); /* not really a delimiter */
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.get[top|bottom] */
+/* node.direct.set[top|bottom] */
+
+static int nodelib_direct_gettop(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case accent_noad:
+ nodelib_push_direct_or_nil(L, accent_top_character(n));
+ return 1;
+ case fence_noad:
+ nodelib_push_direct_or_nil(L, fence_delimiter_top(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getbottom(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case accent_noad:
+ nodelib_push_direct_or_nil(L, accent_bottom_character(n));
+ return 1;
+ case fence_noad:
+ nodelib_push_direct_or_nil(L, fence_delimiter_bottom(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_settop(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case accent_noad:
+ accent_top_character(n) = nodelib_valid_direct_from_index(L, 2);
+ return 0;
+ case fence_noad:
+ fence_delimiter_top(n) = nodelib_valid_direct_from_index(L, 2);
+ return 0;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setbottom(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case accent_noad:
+ accent_bottom_character(n) = nodelib_valid_direct_from_index(L, 2);
+ return 0;
+ case fence_noad:
+ fence_delimiter_bottom(n) = nodelib_valid_direct_from_index(L, 2);
+ return 0;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.direct.get[numerator|denominator] */
+/* node.direct.set[numerator|denominator] */
+
+static int nodelib_direct_getnumerator(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ nodelib_push_direct_or_nil(L, fraction_numerator(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getdenominator(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ nodelib_push_direct_or_nil(L, fraction_denominator(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setnumerator(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ fraction_numerator(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setdenominator(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case fraction_noad:
+ fraction_denominator(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getdegree */
+/* node.direct.setdegree */
+
+static int nodelib_direct_getdegree(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case radical_noad:
+ nodelib_push_direct_or_nil(L, radical_degree(n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setdegree(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case radical_noad:
+ radical_degree(n) = nodelib_valid_direct_from_index(L, 2);
+ break;
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getchoice */
+/* node.direct.setchoice */
+
+static int nodelib_direct_getchoice(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ halfword c = null;
+ if (n && node_type(n) == choice_node) {
+ switch (lmt_tointeger(L, 2)) {
+ case 1: c =
+ choice_display_mlist(n);
+ break;
+ case 2: c =
+ choice_text_mlist(n);
+ break;
+ case 3:
+ c = choice_script_mlist(n);
+ break;
+ case 4:
+ c = choice_script_script_mlist(n);
+ break;
+ }
+ }
+ nodelib_push_direct_or_nil(L, c);
+ return 1;
+}
+
+static int nodelib_direct_setchoice(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == choice_node) {
+ halfword c = nodelib_valid_direct_from_index(L, 2);
+ switch (lmt_tointeger(L, 2)) {
+ case 1:
+ choice_display_mlist(n) = c;
+ break;
+ case 2:
+ choice_text_mlist(n) = c;
+ break;
+ case 3:
+ choice_script_mlist(n) = c;
+ break;
+ case 4:
+ choice_script_script_mlist(n) = c;
+ break;
+ }
+ }
+ return 0;
+}
+
+/* This is an experiment, we have a field left that we can use as attribute. */
+
+static int nodelib_direct_getglyphdata(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && (node_type(n) == glyph_node) && (glyph_data(n) != unused_attribute_value)) {
+ lua_pushinteger(L, glyph_data(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setglyphdata(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == glyph_node) {
+ glyph_data(n) = (halfword) luaL_optinteger(L, 2, unused_attribute_value);
+ }
+ return 0;
+}
+
+/* node.direct.getnext */
+/* node.direct.setnext */
+
+static int nodelib_direct_getnext(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_push_direct_or_nil(L, node_next(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setnext(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ node_next(n) = nodelib_valid_direct_from_index(L, 2);
+ }
+ return 0;
+}
+
+static int nodelib_direct_isnext(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == lmt_tohalfword(L, 2)) {
+ nodelib_push_direct_or_nil(L, node_next(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.getprev */
+/* node.direct.setprev */
+
+static int nodelib_direct_getprev(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_push_direct_or_nil(L, node_prev(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setprev(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ node_prev(n) = nodelib_valid_direct_from_index(L, 2);
+ }
+ return 0;
+}
+
+static int nodelib_direct_isprev(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == lmt_tohalfword(L, 2)) {
+ nodelib_push_direct_or_nil(L, node_prev(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.getboth */
+/* node.direct.setboth */
+
+static int nodelib_direct_getboth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_push_direct_or_nil(L, node_prev(n));
+ nodelib_push_direct_or_nil(L, node_next(n));
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+static int nodelib_direct_setboth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ node_prev(n) = nodelib_valid_direct_from_index(L, 2);
+ node_next(n) = nodelib_valid_direct_from_index(L, 3);
+ }
+ return 0;
+}
+
+static int nodelib_direct_isboth(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword typ = lmt_tohalfword(L, 2);
+ halfword prv = node_prev(n);
+ halfword nxt = node_next(n);
+ nodelib_push_direct_or_nil(L, prv && node_type(prv) == typ ? prv : null);
+ nodelib_push_direct_or_nil(L, nxt && node_type(nxt) == typ ? nxt : null);
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+/* node.direct.setlink */
+/* node.direct.setsplit */
+
+/*
+ a b b nil c d : prev-a-b-c-d-next
+ nil a b b nil c d nil : nil-a-b-c-d-nil
+*/
+
+static int nodelib_direct_setlink(lua_State *L)
+{
+ int n = lua_gettop(L);
+ halfword h = null; /* head node */
+ halfword t = null; /* tail node */
+ for (int 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) {
+ halfword c = nodelib_valid_direct_from_index(L, i); /* current node */
+ if (c) {
+ if (c != t) {
+ if (t) {
+ node_next(t) = c;
+ node_prev(c) = t;
+ } else if (i > 1) {
+ /* we assume that the first node is a kind of head */
+ node_prev(c) = null;
+ }
+ t = c;
+ if (! h) {
+ h = t;
+ }
+ } else {
+ /* we ignore duplicate nodes which can be tails or the previous */
+ }
+ } else {
+ /* we ignore bad nodes, but we could issue a message */
+ }
+ } else if (t) {
+ /* safeguard: a nil in the list can be meant as end so we nil the next of tail */
+ node_next(t) = null;
+ } else {
+ /* we just ignore nil nodes and have no tail yet */
+ }
+ }
+ nodelib_push_direct_or_nil(L, h);
+ return 1;
+}
+
+static int nodelib_direct_setsplit(lua_State *L)
+{
+ halfword l = nodelib_valid_direct_from_index(L, 1);
+ halfword r = nodelib_valid_direct_from_index(L, 2); /* maybe default to next */
+ if (l && r) {
+ if (l != r) {
+ node_prev(node_next(l)) = null;
+ node_next(node_prev(r)) = null;
+ }
+ node_next(l) = null;
+ node_prev(r) = null;
+ }
+ return 0;
+}
+
+/*tex Local_par nodes can have frozen properties. */
+
+static int nodelib_direct_getparstate(lua_State *L)
+{
+ halfword p = nodelib_valid_direct_from_index(L, 1);
+ if (! p) {
+ p = tex_find_par_par(cur_list.head);
+ } else if (node_type(p) != par_node) {
+ while (node_prev(p)) {
+ p = node_prev(p);
+ }
+ }
+ if (p && node_type(p) == par_node) {
+ int limited = lua_toboolean(L, 2);
+ lua_createtable(L, 0, 24);
+ if (p && node_type(p) == par_node) {
+ /* todo: optional: all skip components */
+ lua_push_integer_at_key(L, hsize, tex_get_par_par(p, par_hsize_code));
+ lua_push_integer_at_key(L, leftskip, glue_amount(tex_get_par_par(p, par_left_skip_code)));
+ lua_push_integer_at_key(L, rightskip, glue_amount(tex_get_par_par(p, par_right_skip_code)));
+ lua_push_integer_at_key(L, hangindent, tex_get_par_par(p, par_hang_indent_code));
+ lua_push_integer_at_key(L, hangafter, tex_get_par_par(p, par_hang_after_code));
+ lua_push_integer_at_key(L, parindent, tex_get_par_par(p, par_par_indent_code));
+ if (! limited) {
+ lua_push_integer_at_key(L, parfillleftskip, glue_amount(tex_get_par_par(p, par_par_fill_left_skip_code)));
+ lua_push_integer_at_key(L, parfillskip, glue_amount(tex_get_par_par(p, par_par_fill_right_skip_code)));
+ lua_push_integer_at_key(L, parinitleftskip, glue_amount(tex_get_par_par(p, par_par_init_left_skip_code)));
+ lua_push_integer_at_key(L, parinitrightskip, glue_amount(tex_get_par_par(p, par_par_init_right_skip_code)));
+ lua_push_integer_at_key(L, adjustspacing, tex_get_par_par(p, par_adjust_spacing_code));
+ lua_push_integer_at_key(L, protrudechars, tex_get_par_par(p, par_protrude_chars_code));
+ lua_push_integer_at_key(L, pretolerance, tex_get_par_par(p, par_pre_tolerance_code));
+ lua_push_integer_at_key(L, tolerance, tex_get_par_par(p, par_tolerance_code));
+ lua_push_integer_at_key(L, emergencystretch, tex_get_par_par(p, par_emergency_stretch_code));
+ lua_push_integer_at_key(L, looseness, tex_get_par_par(p, par_looseness_code));
+ lua_push_integer_at_key(L, lastlinefit, tex_get_par_par(p, par_last_line_fit_code));
+ lua_push_integer_at_key(L, linepenalty, tex_get_par_par(p, par_line_penalty_code));
+ lua_push_integer_at_key(L, interlinepenalty, tex_get_par_par(p, par_inter_line_penalty_code));
+ lua_push_integer_at_key(L, clubpenalty, tex_get_par_par(p, par_club_penalty_code));
+ lua_push_integer_at_key(L, widowpenalty, tex_get_par_par(p, par_widow_penalty_code));
+ lua_push_integer_at_key(L, displaywidowpenalty, tex_get_par_par(p, par_display_widow_penalty_code));
+ lua_push_integer_at_key(L, orphanpenalty, tex_get_par_par(p, par_orphan_penalty_code));
+ lua_push_integer_at_key(L, brokenpenalty, tex_get_par_par(p, par_broken_penalty_code));
+ lua_push_integer_at_key(L, adjdemerits, tex_get_par_par(p, par_adj_demerits_code));
+ lua_push_integer_at_key(L, doublehyphendemerits, tex_get_par_par(p, par_double_hyphen_demerits_code));
+ lua_push_integer_at_key(L, finalhyphendemerits, tex_get_par_par(p, par_final_hyphen_demerits_code));
+ lua_push_integer_at_key(L, baselineskip, glue_amount(tex_get_par_par(p, par_baseline_skip_code)));
+ lua_push_integer_at_key(L, lineskip, glue_amount(tex_get_par_par(p, par_line_skip_code)));
+ lua_push_integer_at_key(L, lineskiplimit, tex_get_par_par(p, par_line_skip_limit_code));
+ lua_push_integer_at_key(L, shapingpenaltiesmode, tex_get_par_par(p, par_shaping_penalties_mode_code));
+ lua_push_integer_at_key(L, shapingpenalty, tex_get_par_par(p, par_shaping_penalty_code));
+ }
+ lua_push_specification_at_key(L, parshape, tex_get_par_par(p, par_par_shape_code));
+ if (! limited) {
+ lua_push_specification_at_key(L, interlinepenalties, tex_get_par_par(p, par_inter_line_penalties_code));
+ lua_push_specification_at_key(L, clubpenalties, tex_get_par_par(p, par_club_penalties_code));
+ lua_push_specification_at_key(L, widowpenalties, tex_get_par_par(p, par_widow_penalties_code));
+ lua_push_specification_at_key(L, displaywidowpenalties, tex_get_par_par(p, par_display_widow_penalties_code));
+ lua_push_specification_at_key(L, orphanpenalties, tex_get_par_par(p, par_orphan_penalties_code));
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* node.type (converts id numbers to type names) */
+
+static int nodelib_hybrid_type(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TNUMBER) {
+ halfword i = lmt_tohalfword(L, 1);
+ if (tex_nodetype_is_visible(i)) {
+ lua_push_key_by_index(lmt_interface.node_data[i].lua);
+ return 1;
+ }
+ } else if (lmt_maybe_isnode(L, 1)) {
+ lua_push_key(node);
+ return 1;
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.new (allocate a new node) */
+
+static halfword nodelib_new_node(lua_State *L)
+{
+ quarterword i = unknown_node;
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ i = lmt_toquarterword(L, 1);
+ if (! tex_nodetype_is_visible(i)) {
+ i = unknown_node;
+ }
+ break;
+ case LUA_TSTRING:
+ i = nodelib_aux_get_node_type_id_from_name(L, 1, lmt_interface.node_data);
+ break;
+ }
+ if (tex_nodetype_is_visible(i)) {
+ quarterword j = unknown_subtype;
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ j = lmt_toquarterword(L, 2);
+ break;
+ case LUA_TSTRING:
+ j = nodelib_aux_get_node_subtype_id_from_name(L, 2, lmt_interface.node_data[i].subtypes);
+ break;
+ }
+ return tex_new_node(i, (j == unknown_subtype) ? 0 : j);
+ } else {
+ return luaL_error(L, "invalid node id for creating new node");
+ }
+}
+
+static int nodelib_userdata_new(lua_State *L)
+{
+ lmt_push_node_fast(L, nodelib_new_node(L));
+ return 1;
+}
+
+/* node.direct.new */
+
+static int nodelib_direct_new(lua_State *L)
+{
+ lua_pushinteger(L, nodelib_new_node(L));
+ return 1;
+}
+
+static int nodelib_direct_newtextglyph(lua_State* L)
+{
+ halfword glyph = tex_new_text_glyph(lmt_tohalfword(L, 1), lmt_tohalfword(L, 2));
+ nodelib_aux_setattributelist(L, glyph, 3);
+ lua_pushinteger(L, glyph);
+ return 1;
+}
+
+static int nodelib_direct_newmathglyph(lua_State* L)
+{
+ /*tex For now we don't set a properties, group and/or index here. */
+ halfword glyph = tex_new_math_glyph(lmt_tohalfword(L, 1), lmt_tohalfword(L, 2));
+ nodelib_aux_setattributelist(L, glyph, 3);
+ lua_pushinteger(L, glyph);
+ return 1;
+}
+
+/* node.free (this function returns the 'next' node, because that may be helpful) */
+
+static int nodelib_userdata_free(lua_State *L)
+{
+ if (lua_gettop(L) < 1) {
+ lua_pushnil(L);
+ } else if (! lua_isnil(L, 1)) {
+ halfword n = lmt_check_isnode(L, 1);
+ halfword p = node_next(n);
+ tex_flush_node(n);
+ lmt_push_node_fast(L, p);
+ }
+ return 1;
+}
+
+/* node.direct.free */
+
+static int nodelib_direct_free(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword p = node_next(n);
+ tex_flush_node(n);
+ n = p;
+ } else {
+ n = null;
+ }
+ nodelib_push_direct_or_nil(L, n);
+ return 1;
+}
+
+/* node.flushnode (no next returned) */
+
+static int nodelib_userdata_flushnode(lua_State *L)
+{
+ if (! lua_isnil(L, 1)) {
+ halfword n = lmt_check_isnode(L, 1);
+ tex_flush_node(n);
+ }
+ return 0;
+}
+
+/* node.direct.flush_node */
+
+static int nodelib_direct_flushnode(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ tex_flush_node(n);
+ }
+ return 0;
+}
+
+/* node.flushlist */
+
+static int nodelib_userdata_flushlist(lua_State *L)
+{
+ if (! lua_isnil(L, 1)) {
+ halfword n_ptr = lmt_check_isnode(L, 1);
+ tex_flush_node_list(n_ptr);
+ }
+ return 0;
+}
+
+/* node.direct.flush_list */
+
+static int nodelib_direct_flushlist(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ tex_flush_node_list(n);
+ }
+ return 0;
+}
+
+/* node.remove */
+
+static int nodelib_userdata_remove(lua_State *L)
+{
+ if (lua_gettop(L) < 2) {
+ return luaL_error(L, "Not enough arguments for node.remove()");
+ } else {
+ halfword head = lmt_check_isnode(L, 1);
+ if (lua_isnil(L, 2)) {
+ return 2;
+ } else {
+ halfword current = lmt_check_isnode(L, 2);
+ halfword removed = current;
+ int remove = lua_toboolean(L, 3);
+ if (head == current) {
+ if (node_prev(current)){
+ node_next(node_prev(current)) = node_next(current);
+ }
+ if (node_next(current)){
+ node_prev(node_next(current)) = node_prev(current);
+ }
+ head = node_next(current);
+ current = node_next(current);
+ } else {
+ halfword t = node_prev(current);
+ if (t) {
+ node_next(t) = node_next(current);
+ if (node_next(current)) {
+ node_prev(node_next(current)) = t;
+ }
+ current = node_next(current);
+ } else {
+ return luaL_error(L, "Bad arguments to node.remove()");
+ }
+ }
+ lmt_push_node_fast(L, head);
+ lmt_push_node_fast(L, current);
+ if (remove) {
+ tex_flush_node(removed);
+ return 2;
+ } else {
+ lmt_push_node_fast(L, removed);
+ node_next(removed) = null;
+ node_prev(removed) = null;
+ return 3;
+ }
+ }
+ }
+}
+
+/* node.direct.remove */
+
+static int nodelib_direct_remove(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ if (head) {
+ halfword current = nodelib_valid_direct_from_index(L, 2);
+ if (current) {
+ halfword removed = current;
+ int remove = lua_toboolean(L, 3);
+ halfword prev = node_prev(current);
+ if (head == current) {
+ halfword next = node_next(current);
+ if (prev){
+ node_next(prev) = next;
+ }
+ if (next){
+ node_prev(next) = prev;
+ }
+ head = node_next(current);
+ current = head;
+ } else {
+ if (prev) {
+ halfword next = node_next(current);
+ node_next(prev) = next;
+ if (next) {
+ node_prev(next) = prev;
+ }
+ current = next;
+ } else {
+ /* tex_formatted_warning("nodes","invalid arguments to node.remove"); */
+ return 2;
+ }
+ }
+ nodelib_push_direct_or_nil(L, head);
+ nodelib_push_direct_or_nil(L, current);
+ if (remove) {
+ tex_flush_node(removed);
+ return 2;
+ } else {
+ nodelib_push_direct_or_nil(L, removed);
+ node_next(removed) = null;
+ node_prev(removed) = null;
+ return 3;
+ }
+ } else {
+ lua_pushinteger(L, head);
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+/* node.insertbefore (insert a node in a list) */
+
+static int nodelib_userdata_insertbefore(lua_State *L)
+{
+ if (lua_gettop(L) < 3) {
+ return luaL_error(L, "Not enough arguments for node.insertbefore()");
+ } else if (lua_isnil(L, 3)) {
+ lua_settop(L, 2);
+ } else {
+ halfword n = lmt_check_isnode(L, 3);
+ if (lua_isnil(L, 1)) {
+ node_next(n) = null;
+ node_prev(n) = null;
+ lmt_push_node_fast(L, n);
+ lua_pushvalue(L, -1);
+ } else {
+ halfword current;
+ halfword head = lmt_check_isnode(L, 1);
+ if (lua_isnil(L, 2)) {
+ current = tex_tail_of_node_list(head);
+ } else {
+ current = lmt_check_isnode(L, 2);
+ }
+ if (head != current) {
+ halfword t = node_prev(current);
+ if (t) {
+ tex_couple_nodes(t, n);
+ } else {
+ return luaL_error(L, "Bad arguments to node.insertbefore()");
+ }
+ }
+ tex_couple_nodes(n, current);
+ lmt_push_node_fast(L, (head == current) ? n : head);
+ lmt_push_node_fast(L, n);
+ }
+ }
+ return 2;
+}
+
+/* node.direct.insertbefore */
+
+static int nodelib_direct_insertbefore(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 3);
+ if (n) {
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ halfword current = nodelib_valid_direct_from_index(L, 2);
+ /* no head, ignore current */
+ if (head) {
+ if (! current) {
+ current = tex_tail_of_node_list(head);
+ }
+ if (head != current) {
+ halfword prev = node_prev(current);
+ if (prev) {
+ tex_couple_nodes(prev, n);
+ } else {
+ /* error so just quit and return originals */
+ return 2;
+ }
+ }
+ tex_couple_nodes(n, current); /* nice but incompatible: tex_couple_nodes(tail_of_list(n),current) */
+ lua_pushinteger(L, (head == current) ? n : head);
+ lua_pushinteger(L, n);
+ } else {
+ node_next(n) = null;
+ node_prev(n) = null;
+ lua_pushinteger(L, n);
+ lua_pushinteger(L, n);
+ /* n, n */
+ }
+ } else {
+ lua_settop(L, 2);
+ }
+ return 2;
+}
+
+/* node.insertafter */
+
+static int nodelib_userdata_insertafter(lua_State *L)
+{
+ if (lua_gettop(L) < 3) {
+ return luaL_error(L, "Not enough arguments for node.insertafter()");
+ } else if (lua_isnil(L, 3)) {
+ lua_settop(L, 2);
+ } else {
+ halfword n = lmt_check_isnode(L, 3);
+ if (lua_isnil(L, 1)) {
+ node_next(n) = null;
+ node_prev(n) = null;
+ lmt_push_node_fast(L, n);
+ lua_pushvalue(L, -1);
+ } else {
+ halfword current;
+ halfword head = lmt_check_isnode(L, 1);
+ if (lua_isnil(L, 2)) {
+ current = head;
+ while (node_next(current)) {
+ current = node_next(current);
+ }
+ } else {
+ current = lmt_check_isnode(L, 2);
+ }
+ tex_try_couple_nodes(n, node_next(current));
+ tex_couple_nodes(current, n);
+ lua_pop(L, 2);
+ lmt_push_node_fast(L, n);
+ }
+ }
+ return 2;
+}
+
+/* node.direct.insertafter */
+
+static int nodelib_direct_insertafter(lua_State *L)
+{
+ /*[head][current][new]*/
+ halfword n = nodelib_valid_direct_from_index(L, 3);
+ if (n) {
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ halfword current = nodelib_valid_direct_from_index(L, 2);
+ if (head) {
+ if (! current) {
+ current = head;
+ while (node_next(current)) {
+ current = node_next(current);
+ }
+ }
+ tex_try_couple_nodes(n, node_next(current)); /* nice but incompatible: try_couple_nodes(tail_of_list(n), node_next(current)); */
+ tex_couple_nodes(current, n);
+ lua_pop(L, 2);
+ lua_pushinteger(L, n);
+ } else {
+ /* no head, ignore current */
+ node_next(n) = null;
+ node_prev(n) = null;
+ lua_pushinteger(L, n);
+ lua_pushvalue(L, -1);
+ /* n, n */
+ }
+ } else {
+ lua_settop(L, 2);
+ }
+ return 2;
+}
+
+/* */
+
+static int nodelib_direct_appendaftertail(lua_State *L)
+{
+ /*[head][current][new]*/
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ halfword n = nodelib_valid_direct_from_index(L, 2);
+ if (h && n) {
+ tex_couple_nodes(tex_tail_of_node_list(h), n);
+ }
+ return 0;
+}
+
+static int nodelib_direct_prependbeforehead(lua_State *L)
+{
+ /*[head][current][new]*/
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ halfword n = nodelib_valid_direct_from_index(L, 2);
+ if (h && n) {
+ tex_couple_nodes(n, tex_head_of_node_list(h));
+ }
+ return 0;
+}
+
+/* node.copylist */
+
+/*tex
+
+ We need to use an intermediate variable as otherwise target is used in the loop and subfields
+ get overwritten (or something like that) which results in crashes and unexpected side effects.
+
+*/
+
+static int nodelib_userdata_copylist(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ return 1; /* the nil itself */
+ } else {
+ halfword m;
+ halfword s = null;
+ halfword n = lmt_check_isnode(L, 1);
+ if ((lua_gettop(L) > 1) && (! lua_isnil(L, 2))) {
+ s = lmt_check_isnode(L, 2);
+ }
+ m = tex_copy_node_list(n, s);
+ lmt_push_node_fast(L, m);
+ return 1;
+ }
+}
+
+/* node.direct.copylist */
+
+static int nodelib_direct_copylist(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ halfword s = nodelib_valid_direct_from_index(L, 2);
+ if (n) {
+ halfword m = tex_copy_node_list(n, s);
+ lua_pushinteger(L, m);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.show (node, threshold, max) */
+/* node.direct.show */
+
+static int nodelib_userdata_show(lua_State *L)
+{
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ tex_show_node_list(n, lmt_optinteger(L, 2, show_box_depth_par), lmt_optinteger(L, 3, show_box_breadth_par));
+ }
+ return 0;
+}
+
+static int nodelib_direct_show(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ tex_show_node_list(n, lmt_optinteger(L, 2, show_box_depth_par), lmt_optinteger(L, 3, show_box_breadth_par));
+ }
+ return 0;
+}
+
+/* node.serialize(node, details, threshold, max) */
+/* node.direct.serialize */
+
+static int nodelib_aux_showlist(lua_State* L, halfword box)
+{
+ if (box) {
+ luaL_Buffer buffer;
+ int saved_selector = lmt_print_state.selector;
+ halfword levels = tracing_levels_par;
+ halfword online = tracing_online_par;
+ halfword details = show_node_details_par;
+ halfword depth = lmt_opthalfword(L, 3, show_box_depth_par);
+ halfword breadth = lmt_opthalfword(L, 4, show_box_breadth_par);
+ tracing_levels_par = 0;
+ tracing_online_par = 0;
+ show_node_details_par = lmt_opthalfword(L, 2, details);
+ lmt_print_state.selector = luabuffer_selector_code;
+ lmt_lua_state.used_buffer = &buffer;
+ luaL_buffinit(L, &buffer);
+ tex_show_node_list(box, depth, breadth);
+ tex_print_ln();
+ luaL_pushresult(&buffer);
+ lmt_lua_state.used_buffer = NULL;
+ lmt_print_state.selector = saved_selector;
+ show_node_details_par = details;
+ tracing_levels_par = levels;
+ tracing_online_par = online;
+ } else {
+ lua_pushliteral(L, "");
+ }
+ return 1;
+}
+
+static int nodelib_common_serialized(lua_State *L, halfword n)
+{
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ return nodelib_aux_showlist(L, n);
+ default:
+ {
+ halfword prv = null;
+ halfword nxt = null;
+ if (tex_nodetype_has_prev(n)) {
+ prv = node_prev(n);
+ node_prev(n) = null;
+ }
+ if (tex_nodetype_has_next(n)) {
+ nxt = node_next(n);
+ node_next(n) = null;
+ }
+ nodelib_aux_showlist(L, n);
+ if (prv) {
+ node_prev(n) = prv;
+ }
+ if (nxt) {
+ node_next(n) = nxt;
+ }
+ return 1;
+ }
+ }
+ }
+ lua_pushliteral(L, "");
+ return 1;
+}
+
+static int nodelib_userdata_serialized(lua_State *L)
+{
+ return nodelib_common_serialized(L, lmt_check_isnode(L, 1));
+}
+
+/* node.direct.show */
+
+static int nodelib_direct_serialized(lua_State *L)
+{
+ return nodelib_common_serialized(L, nodelib_valid_direct_from_index(L, 1));
+}
+
+
+/* node.copy (deep copy) */
+
+static int nodelib_userdata_copy(lua_State *L)
+{
+ if (! lua_isnil(L, 1)) {
+ halfword n = lmt_check_isnode(L, 1);
+ n = tex_copy_node(n);
+ lmt_push_node_fast(L, n);
+ }
+ return 1;
+}
+
+/* node.direct.copy (deep copy) */
+
+static int nodelib_direct_copy(lua_State *L)
+{
+ if (! lua_isnil(L, 1)) {
+ /* beware, a glue node can have number 0 (zeropt) so we cannot test for null) */
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ n = tex_copy_node(n);
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ return 1;
+}
+
+/* node.direct.copyonly (use with care) */
+
+static int nodelib_direct_copyonly(lua_State *L)
+{
+ if (! lua_isnil(L, 1)) {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ n = tex_copy_node_only(n);
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ return 1;
+}
+
+/* node.write (output a node to tex's processor) */
+/* node.append (idem but no attributes) */
+
+static int nodelib_userdata_write(lua_State *L)
+{
+ int j = lua_gettop(L);
+ for (int i = 1; i <= j; i++) {
+ halfword n = lmt_check_isnode(L, i);
+ if (n) {
+ halfword m = node_next(n);
+ tex_tail_append(n);
+ if (tex_nodetype_has_attributes(node_type(n)) && ! node_attr(n)) {
+ attach_current_attribute_list(n);
+ }
+ while (m) {
+ tex_tail_append(m);
+ if (tex_nodetype_has_attributes(node_type(m)) && ! node_attr(m)) {
+ attach_current_attribute_list(m);
+ }
+ m = node_next(m);
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+static int nodelib_userdata_append(lua_State *L)
+{
+ int j = lua_gettop(L);
+ for (int i = 1; i <= j; i++) {
+ halfword n = lmt_check_isnode(L, i);
+ if (n) {
+ halfword m = node_next(n);
+ tail_append(n);
+ while (m) {
+ tex_tail_append(m);
+ m = node_next(m);
+ }
+ }
+ }
+ return 0;
+}
+*/
+
+/* node.direct.write (output a node to tex's processor) */
+/* node.direct.append (idem no attributes) */
+
+static int nodelib_direct_write(lua_State *L)
+{
+ int j = lua_gettop(L);
+ for (int i = 1; i <= j; i++) {
+ halfword n = nodelib_valid_direct_from_index(L, i);
+ if (n) {
+ halfword m = node_next(n);
+ tex_tail_append(n);
+ if (tex_nodetype_has_attributes(node_type(n)) && ! node_attr(n)) {
+ attach_current_attribute_list(n);
+ }
+ while (m) {
+ tex_tail_append(m);
+ if (tex_nodetype_has_attributes(node_type(m)) && ! node_attr(m)) {
+ attach_current_attribute_list(m);
+ }
+ m = node_next(m);
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+static int nodelib_direct_appendtocurrentlist(lua_State *L)
+{
+ int j = lua_gettop(L);
+ for (int i = 1; i <= j; i++) {
+ halfword n = nodelib_valid_direct_from_index(L, i);
+ if (n) {
+ halfword m = node_next(n);
+ tex_tail_append(n);
+ while (m) {
+ tex_tail_append(m);
+ m = node_next(m);
+ }
+ }
+ }
+ return 0;
+}
+*/
+
+/* node.direct.last */
+
+static int nodelib_direct_lastnode(lua_State *L)
+{
+ halfword m = tex_pop_tail();
+ lua_pushinteger(L, m);
+ return 1;
+}
+
+/* node.direct.hpack */
+
+static int nodelib_aux_packing(lua_State *L, int slot)
+{
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, slot);
+ if (lua_key_eq(s, exactly)) {
+ return packing_exactly;
+ } else if (lua_key_eq(s, additional)) {
+ return packing_additional;
+ } else if (lua_key_eq(s, expanded)) {
+ return packing_expanded;
+ } else if (lua_key_eq(s, substitute)) {
+ return packing_substitute;
+ } else if (lua_key_eq(s, adapted)) {
+ return packing_adapted;
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ {
+ int m = (int) lua_tointeger(L, slot);
+ if (m >= packing_exactly && m <= packing_adapted) {
+ return m;
+ }
+ break;
+ }
+ }
+ return packing_additional;
+}
+
+static int nodelib_direct_hpack(lua_State *L)
+{
+ halfword p;
+ int w = 0;
+ int m = packing_additional;
+ singleword d = direction_def_value;
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int top = lua_gettop(L);
+ if (top > 1) {
+ w = lmt_roundnumber(L, 2);
+ if (top > 2) {
+ m = nodelib_aux_packing(L, 3);
+ if (top > 3) {
+ d = nodelib_getdirection(L, 4);
+ }
+ }
+ }
+ } else {
+ n = null;
+ }
+ p = tex_hpack(n, w, m, d, holding_none_option);
+ lua_pushinteger(L, p);
+ lua_pushinteger(L, lmt_packaging_state.last_badness);
+ lua_pushinteger(L, lmt_packaging_state.last_overshoot);
+ return 3;
+}
+
+static int nodelib_direct_repack(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ int top = lua_gettop(L);
+ int w = top > 1 ? lmt_roundnumber(L, 2) : 0;
+ int m = top > 2 ? nodelib_aux_packing(L, 3) : packing_additional;
+ tex_repack(n, w, m);
+ break;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_freeze(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ tex_freeze(n, lua_toboolean(L, 2));
+ break;
+ }
+ }
+ return 0;
+}
+
+
+/* node.direct.vpack */
+
+static int nodelib_direct_verticalbreak(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ scaled ht = lmt_roundnumber(L, 2);
+ scaled dp = lmt_roundnumber(L, 3);
+ n = tex_vert_break(n, ht, dp);
+ }
+ lua_pushinteger(L, n);
+ return 1;
+}
+
+static int nodelib_direct_vpack(lua_State *L)
+{
+ halfword p;
+ int w = 0;
+ int m = packing_additional;
+ singleword d = direction_def_value;
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int top = lua_gettop(L);
+ if (top > 1) {
+ w = lmt_roundnumber(L, 2);
+ if (top > 2) {
+ switch (lua_type(L, 3)) {
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, 3);
+ if (lua_key_eq(s, additional)) {
+ m = packing_additional;
+ } else if (lua_key_eq(s, exactly)) {
+ m = packing_exactly;
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ {
+ m = (int) lua_tointeger(L, 3);
+ if (m != packing_exactly && m != packing_additional) {
+ m = packing_additional;
+ }
+ break;
+ }
+ }
+ if (top > 3) {
+ d = nodelib_getdirection(L, 4);
+ }
+ }
+ }
+ } else {
+ n = null;
+ }
+ p = tex_vpack(n, w, m, max_dimen, d, holding_none_option);
+ lua_pushinteger(L, p);
+ lua_pushinteger(L, lmt_packaging_state.last_badness);
+ return 2;
+}
+
+/* node.direct.dimensions */
+/* node.direct.rangedimensions */
+/* node.direct.naturalwidth */
+
+static int nodelib_direct_dimensions(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top > 0) {
+ scaledwhd siz = { 0, 0, 0 };
+ glueratio g_mult = normal_glue_multiplier;
+ int vertical = 0;
+ int g_sign = normal_glue_sign;
+ int g_order = normal_glue_order;
+ int i = 1;
+ halfword n = null;
+ halfword p = null;
+ if (top > 3) {
+ i += 3;
+ g_mult = (glueratio) lua_tonumber(L, 1); /* integer or float */
+ g_sign = tex_checked_glue_sign(lmt_tohalfword(L, 2));
+ g_order = tex_checked_glue_order(lmt_tohalfword(L, 3));
+ }
+ n = nodelib_valid_direct_from_index(L, i);
+ if (lua_type(L, i + 1) == LUA_TBOOLEAN) {
+ vertical = lua_toboolean(L, i + 1);
+ } else {
+ p = nodelib_valid_direct_from_index(L, i + 1);
+ vertical = lua_toboolean(L, i + 2);
+ }
+ if (n) {
+ if (vertical) {
+ siz = tex_natural_vsizes(n, p, g_mult, g_sign, g_order);
+ } else {
+ siz = tex_natural_hsizes(n, p, g_mult, g_sign, g_order);
+ }
+ }
+ lua_pushinteger(L, siz.wd);
+ lua_pushinteger(L, siz.ht);
+ lua_pushinteger(L, siz.dp);
+ return 3;
+ } else {
+ return luaL_error(L, "missing argument to 'dimensions' (direct node expected)");
+ }
+}
+
+static int nodelib_direct_rangedimensions(lua_State *L) /* parent, first, last */
+{
+ int top = lua_gettop(L);
+ if (top > 1) {
+ scaledwhd siz = { 0, 0, 0 };
+ int vertical = 0;
+ halfword l = nodelib_valid_direct_from_index(L, 1); /* parent */
+ halfword n = nodelib_valid_direct_from_index(L, 2); /* first */
+ halfword p = n;
+ if (lua_type(L, 3) == LUA_TBOOLEAN) {
+ vertical = lua_toboolean(L, 3);
+ } else {
+ p = nodelib_valid_direct_from_index(L, 3); /* last */
+ vertical = lua_toboolean(L, 4);
+ }
+ if (l && n) {
+ if (vertical) {
+ siz = tex_natural_vsizes(n, p, (glueratio) box_glue_set(l), box_glue_sign(l), box_glue_order(l));
+ } else {
+ siz = tex_natural_hsizes(n, p, (glueratio) box_glue_set(l), box_glue_sign(l), box_glue_order(l));
+ }
+ }
+ lua_pushinteger(L, siz.wd);
+ lua_pushinteger(L, siz.ht);
+ lua_pushinteger(L, siz.dp);
+ return 3;
+ } else {
+ return luaL_error(L, "missing argument to 'rangedimensions' (2 or more direct nodes expected)");
+ }
+}
+
+static int nodelib_direct_naturalwidth(lua_State *L) /* parent, first, [last] */
+{
+ int top = lua_gettop(L);
+ if (top > 1) {
+ scaled wd = 0;
+ halfword l = nodelib_valid_direct_from_index(L, 1); /* parent */
+ halfword n = nodelib_valid_direct_from_index(L, 2); /* first */
+ halfword p = nodelib_valid_direct_from_index(L, 3); /* last */
+ if (l && n) {
+ wd = tex_natural_width(n, p, (glueratio) box_glue_set(l), box_glue_sign(l), box_glue_order(l));
+ }
+ lua_pushinteger(L, wd);
+ return 1;
+ } else {
+ return luaL_error(L, "missing argument to 'naturalwidth' (2 or more direct nodes expected)");
+ }
+}
+
+static int nodelib_direct_naturalhsize(lua_State *L)
+{
+ scaled wd = 0;
+ halfword c = null;
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ wd = tex_natural_hsize(n, &c);
+ }
+ lua_pushinteger(L, wd);
+ lua_pushinteger(L, c ? glue_amount(c) : 0);
+ nodelib_push_direct_or_nil(L, c);
+ return 3;
+}
+
+static int nodelib_direct_mlisttohlist(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int style = lmt_get_math_style(L, 2, text_style);
+ int penalties = lua_toboolean(L, 3);
+ int beginclass = lmt_optinteger(L, 4, unset_noad_class);
+ int endclass = lmt_optinteger(L, 5, unset_noad_class);
+ if (! valid_math_class_code(beginclass)) {
+ beginclass = unset_noad_class;
+ }
+ if (! valid_math_class_code(endclass)) {
+ endclass = unset_noad_class;
+ }
+ n = tex_mlist_to_hlist(n, penalties, style, beginclass, endclass, NULL);
+ }
+ nodelib_push_direct_or_nil(L, n);
+ return 1;
+}
+
+/*tex
+
+ This function is similar to |get_node_type_id|, for field identifiers. It has to do some more
+ work, because not all identifiers are valid for all types of nodes. We can make this faster if
+ needed but when this needs to be called often something is wrong with the code.
+
+*/
+
+static int nodelib_aux_get_node_field_id(lua_State *L, int n, int node)
+{
+ int t = node_type(node);
+ const char *s = lua_tostring(L, n);
+ if (! s) {
+ return -2;
+ } else if (lua_key_eq(s, next)) {
+ return 0;
+ } else if (lua_key_eq(s, id)) {
+ return 1;
+ } else if (lua_key_eq(s, subtype)) {
+ if (tex_nodetype_has_subtype(t)) {
+ return 2;
+ }
+ } else if (lua_key_eq(s, attr)) {
+ if (tex_nodetype_has_attributes(t)) {
+ return 3;
+ }
+ } else if (lua_key_eq(s, prev)) {
+ if (tex_nodetype_has_prev(t)) {
+ return -1;
+ }
+ } else {
+ value_info *fields = lmt_interface.node_data[t].fields;
+ if (fields) {
+ if (lua_key_eq(s, list)) {
+ const char *sh = lua_key(head);
+ for (int j = 0; fields[j].lua; j++) {
+ if (fields[j].name == s || fields[j].name == sh) {
+ return j + 3;
+ }
+ }
+ } else {
+ for (int j = 0; fields[j].lua; j++) {
+ if (fields[j].name == s) {
+ return j + 3;
+ }
+ }
+ }
+ }
+ }
+ return -2;
+}
+
+/* node.hasfield */
+
+static int nodelib_userdata_hasfield(lua_State *L)
+{
+ int i = -2;
+ if (! lua_isnil(L, 1)) {
+ i = nodelib_aux_get_node_field_id(L, 2, lmt_check_isnode(L, 1));
+ }
+ lua_pushboolean(L, (i != -2));
+ return 1;
+}
+
+/* node.direct.hasfield */
+
+static int nodelib_direct_hasfield(lua_State *L)
+{
+ int i = -2;
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ i = nodelib_aux_get_node_field_id(L, 2, n);
+ }
+ lua_pushboolean(L, (i != -2));
+ return 1;
+}
+
+/* node.types */
+
+static int nodelib_shared_types(lua_State *L)
+{
+ lua_newtable(L);
+ for (int i = 0; lmt_interface.node_data[i].id != -1; i++) {
+ if (lmt_interface.node_data[i].visible) {
+ lua_pushstring(L, lmt_interface.node_data[i].name);
+ lua_rawseti(L, -2, lmt_interface.node_data[i].id);
+ }
+ }
+ return 1;
+}
+
+/* node.fields (fetch the list of valid fields) */
+
+static int nodelib_shared_fields(lua_State *L)
+{
+ int offset = 2;
+ int t = nodelib_aux_get_valid_node_type_id(L, 1);
+ int f = lua_toboolean(L, 2);
+ value_info *fields = lmt_interface.node_data[t].fields;
+ lua_newtable(L);
+ if (f) {
+ lua_push_key(next);
+ lua_push_key(node);
+ lua_rawset(L, -3);
+ lua_push_key(id)
+ lua_push_key(integer);
+ lua_rawset(L, -3);
+ if (tex_nodetype_has_subtype(t)) {
+ lua_push_key(subtype);
+ lua_push_key(integer);
+ lua_rawset(L, -3);
+ offset++;
+ }
+ if (tex_nodetype_has_prev(t)) {
+ lua_push_key(prev);
+ lua_push_key(node);
+ lua_rawset(L, -3);
+ }
+ if (fields) {
+ for (lua_Integer i = 0; fields[i].lua != 0; i++) {
+ /* todo: use other macros */
+ lua_push_key_by_index(fields[i].lua);
+ lua_push_key_by_index(lmt_interface.field_type_values[fields[i].type].lua);
+ // lua_pushinteger(L, fields[i].type);
+ lua_rawset(L, -3);
+ }
+ }
+ } else {
+ lua_push_key(next);
+ lua_rawseti(L, -2, 0);
+ lua_push_key(id);
+ lua_rawseti(L, -2, 1);
+ if (tex_nodetype_has_subtype(t)) {
+ lua_push_key(subtype);
+ lua_rawseti(L, -2, 2);
+ offset++;
+ }
+ if (tex_nodetype_has_prev(t)) {
+ lua_push_key(prev);
+ lua_rawseti(L, -2, -1);
+ }
+ if (fields) {
+ for (lua_Integer i = 0; fields[i].lua != 0; i++) {
+ // lua_push_key_by_index(L, fields[i].lua);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, fields[i].lua);
+ lua_rawseti(L, -2, i + offset);
+ }
+ }
+ }
+ return 1;
+}
+
+/* These should move to texlib ... which might happen. */
+
+static int nodelib_shared_values(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ /*
+ delimiter options (bit set)
+ delimiter modes (bit set)
+ */
+ const char *s = lua_tostring(L, 1);
+ if (lua_key_eq(s, glue) || lua_key_eq(s, fill)) {
+ return lmt_push_info_values(L, lmt_interface.node_fill_values);
+ } else if (lua_key_eq(s, dir)) {
+ return lmt_push_info_values(L, lmt_interface.direction_values);
+ } else if (lua_key_eq(s, math)) {
+ /*tex A bit strange place, so moved to lmttexlib. */
+ return lmt_push_info_keys(L, lmt_interface.math_parameter_values);
+ } else if (lua_key_eq(s, style)) {
+ /*tex A bit strange place, so moved to lmttexlib. */
+ return lmt_push_info_values(L, lmt_interface.math_style_values);
+ } else if (lua_key_eq(s, page)) {
+ /*tex These are never used, whatsit related. */
+ return lmt_push_info_values(L, lmt_interface.page_contribute_values);
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_shared_subtypes(lua_State *L)
+{
+ value_info *subtypes = NULL;
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ {
+ /* official accessors */
+ const char *s = lua_tostring(L,1);
+ if (lua_key_eq(s, glyph)) subtypes = lmt_interface.node_data[glyph_node] .subtypes;
+ else if (lua_key_eq(s, glue)) subtypes = lmt_interface.node_data[glue_node] .subtypes;
+ else if (lua_key_eq(s, dir)) subtypes = lmt_interface.node_data[dir_node] .subtypes;
+ else if (lua_key_eq(s, mark)) subtypes = lmt_interface.node_data[mark_node] .subtypes;
+ else if (lua_key_eq(s, boundary)) subtypes = lmt_interface.node_data[boundary_node] .subtypes;
+ else if (lua_key_eq(s, penalty)) subtypes = lmt_interface.node_data[penalty_node] .subtypes;
+ else if (lua_key_eq(s, kern)) subtypes = lmt_interface.node_data[kern_node] .subtypes;
+ else if (lua_key_eq(s, rule)) subtypes = lmt_interface.node_data[rule_node] .subtypes;
+ else if (lua_key_eq(s, list)
+ || lua_key_eq(s, hlist)
+ || lua_key_eq(s, vlist)) subtypes = lmt_interface.node_data[hlist_node] .subtypes; /* too many but ok as reserved */
+ else if (lua_key_eq(s, adjust)) subtypes = lmt_interface.node_data[adjust_node] .subtypes;
+ else if (lua_key_eq(s, disc)) subtypes = lmt_interface.node_data[disc_node] .subtypes;
+ else if (lua_key_eq(s, math)) subtypes = lmt_interface.node_data[math_node] .subtypes;
+ else if (lua_key_eq(s, noad)) subtypes = lmt_interface.node_data[simple_noad] .subtypes;
+ else if (lua_key_eq(s, radical)) subtypes = lmt_interface.node_data[radical_noad] .subtypes;
+ else if (lua_key_eq(s, accent)) subtypes = lmt_interface.node_data[accent_noad] .subtypes;
+ else if (lua_key_eq(s, fence)) subtypes = lmt_interface.node_data[fence_noad] .subtypes;
+ else if (lua_key_eq(s, choice)) subtypes = lmt_interface.node_data[choice_node] .subtypes;
+ else if (lua_key_eq(s, par)) subtypes = lmt_interface.node_data[par_node] .subtypes;
+ else if (lua_key_eq(s, attribute)) subtypes = lmt_interface.node_data[attribute_node].subtypes;
+ }
+ break;
+ case LUA_TNUMBER:
+ switch (lua_tointeger(L, 1)) {
+ case glyph_node: subtypes = lmt_interface.node_data[glyph_node] .subtypes; break;
+ case glue_node: subtypes = lmt_interface.node_data[glue_node] .subtypes; break;
+ case dir_node: subtypes = lmt_interface.node_data[dir_node] .subtypes; break;
+ case boundary_node: subtypes = lmt_interface.node_data[boundary_node] .subtypes; break;
+ case penalty_node: subtypes = lmt_interface.node_data[penalty_node] .subtypes; break;
+ case kern_node: subtypes = lmt_interface.node_data[kern_node] .subtypes; break;
+ case rule_node: subtypes = lmt_interface.node_data[rule_node] .subtypes; break;
+ case hlist_node: subtypes = lmt_interface.node_data[hlist_node] .subtypes; break;
+ case vlist_node: subtypes = lmt_interface.node_data[vlist_node] .subtypes; break;
+ case adjust_node: subtypes = lmt_interface.node_data[adjust_node] .subtypes; break;
+ case disc_node: subtypes = lmt_interface.node_data[disc_node] .subtypes; break;
+ case math_node: subtypes = lmt_interface.node_data[math_node] .subtypes; break;
+ case simple_noad: subtypes = lmt_interface.node_data[simple_noad] .subtypes; break;
+ case radical_noad: subtypes = lmt_interface.node_data[radical_noad] .subtypes; break;
+ case accent_noad: subtypes = lmt_interface.node_data[accent_noad] .subtypes; break;
+ case fence_noad: subtypes = lmt_interface.node_data[fence_noad] .subtypes; break;
+ case choice_node: subtypes = lmt_interface.node_data[choice_node] .subtypes; break;
+ case par_node: subtypes = lmt_interface.node_data[par_node] .subtypes; break;
+ case attribute_node: subtypes = lmt_interface.node_data[attribute_node].subtypes; break;
+ }
+ break;
+ }
+ if (subtypes) {
+ lua_newtable(L);
+ for (int i = 0; subtypes[i].name; i++) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, subtypes[i].lua);
+ lua_rawseti(L, -2, subtypes[i].id);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.slide */
+
+static int nodelib_direct_slide(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ while (node_next(n)) {
+ node_prev(node_next(n)) = n;
+ n = node_next(n);
+ }
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.tail (find the end of a list) */
+
+static int nodelib_userdata_tail(lua_State *L)
+{
+ if (! lua_isnil(L, 1)) {
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ while (node_next(n)) {
+ n = node_next(n);
+ }
+ lmt_push_node_fast(L, n);
+ } else {
+ /*tex We keep the old userdata. */
+ }
+ }
+ return 1;
+}
+
+/* node.direct.tail */
+
+static int nodelib_direct_tail(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ while (node_next(n)) {
+ n = node_next(n);
+ }
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.endofmath */
+
+static int nodelib_direct_endofmath(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (node_type(n) == math_node && node_subtype(n) == end_inline_math) {
+ lua_pushinteger(L, n);
+ return 1;
+ } else {
+ int level = 1;
+ while (node_next(n)) {
+ n = node_next(n);
+ if (n && node_type(n) == math_node) {
+ switch (node_subtype(n)) {
+ case begin_inline_math:
+ ++level;
+ break;
+ case end_inline_math:
+ --level;
+ if (level > 0) {
+ break;
+ } else {
+ lua_pushinteger(L, n);
+ return 1;
+ }
+
+ }
+ }
+ }
+ // if (level > 0) {
+ // /* something is wrong */
+ // }
+ }
+ }
+ return 0;
+}
+
+/* node.hasattribute (gets attribute) */
+
+static int nodelib_userdata_hasattribute(lua_State *L)
+{
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ int key = lmt_tointeger(L, 2);
+ int val = tex_has_attribute(n, key, lmt_optinteger(L, 3, unused_attribute_value));
+ if (val > unused_attribute_value) {
+ lua_pushinteger(L, val);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.direct.has_attribute */
+
+static int nodelib_direct_hasattribute(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int key = nodelib_valid_direct_from_index(L, 2);
+ int val = tex_has_attribute(n, key, lmt_optinteger(L, 3, unused_attribute_value));
+ if (val > unused_attribute_value) {
+ lua_pushinteger(L, val);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.get_attribute */
+
+static int nodelib_userdata_getattribute(lua_State *L)
+{
+ halfword p = lmt_check_isnode(L, 1);
+ if (tex_nodetype_has_attributes(node_type(p))) {
+ p = node_attr(p);
+ if (p) {
+ p = node_next(p);
+ if (p) {
+ int i = lmt_optinteger(L, 2, 0);
+ while (p) {
+ if (attribute_index(p) == i) {
+ int v = attribute_value(p);
+ if (v == unused_attribute_value) {
+ break;
+ } else {
+ lua_pushinteger(L, v);
+ return 1;
+ }
+ } else if (attribute_index(p) > i) {
+ break;
+ }
+ p = node_next(p);
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_findattributerange(lua_State *L)
+{
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ if (h) {
+ halfword i = lmt_tohalfword(L, 2);
+ while (h) {
+ if (tex_nodetype_has_attributes(node_type(h))) {
+ halfword p = node_attr(h);
+ if (p) {
+ p = node_next(p);
+ while (p) {
+ if (attribute_index(p) == i) {
+ if (attribute_value(p) == unused_attribute_value) {
+ break;
+ } else {
+ halfword t = h;
+ while (node_next(t)) {
+ t = node_next(t);
+ }
+ while (t != h) {
+ if (tex_nodetype_has_attributes(node_type(t))) {
+ halfword a = node_attr(t);
+ if (a) {
+ a = node_next(a);
+ while (a) {
+ if (attribute_index(a) == i) {
+ if (attribute_value(a) == unused_attribute_value) {
+ break;
+ } else {
+ goto FOUND;
+ }
+ } else if (attribute_index(a) > i) {
+ break;
+ }
+ a = node_next(a);
+ }
+ }
+ }
+ t = node_prev(t);
+ }
+ FOUND:
+ lua_pushinteger(L, h);
+ lua_pushinteger(L, t);
+ return 2;
+ }
+ } else if (attribute_index(p) > i) {
+ break;
+ }
+ p = node_next(p);
+ }
+ }
+ }
+ h = node_next(h);
+ }
+ }
+ return 0;
+}
+
+/* node.direct.getattribute */
+/* node.direct.setattribute */
+/* node.direct.unsetattribute */
+/* node.direct.findattribute */
+
+static int nodelib_direct_getattribute(lua_State *L)
+{
+ halfword p = nodelib_valid_direct_from_index(L, 1);
+ if (p) {
+ if (node_type(p) != attribute_node) {
+ p = tex_nodetype_has_attributes(node_type(p)) ? node_attr(p) : null;
+ }
+ if (p) {
+ if (node_subtype(p) == attribute_list_subtype) {
+ p = node_next(p);
+ }
+ if (p) {
+ halfword index = lmt_opthalfword(L, 2, 0);
+ while (p) {
+ halfword i = attribute_index(p);
+ if (i == index) {
+ int v = attribute_value(p);
+ if (v == unused_attribute_value) {
+ break;
+ } else {
+ lua_pushinteger(L, v);
+ return 1;
+ }
+ } else if (i > index) {
+ break;
+ }
+ p = node_next(p);
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_getattributes(lua_State *L)
+{
+ halfword p = nodelib_valid_direct_from_index(L, 1);
+ if (p) {
+ if (node_type(p) != attribute_node) {
+ p = tex_nodetype_has_attributes(node_type(p)) ? node_attr(p) : null;
+ }
+ if (p) {
+ if (node_subtype(p) == attribute_list_subtype) {
+ p = node_next(p);
+ }
+ if (p) {
+ int top = lua_gettop(L);
+ for (int i = 2; i <= top; i++) {
+ halfword a = lmt_tohalfword(L, i);
+ halfword n = p;
+ halfword v = unused_attribute_value;
+ while (n) {
+ halfword id = attribute_index(n);
+ if (id == a) {
+ v = attribute_value(n);
+ break;
+ } else if (id > a) {
+ break;
+ } else {
+ n = node_next(n);
+ }
+ }
+ if (v == unused_attribute_value) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, v);
+ }
+ }
+ return top - 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setattribute(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && tex_nodetype_has_attributes(node_type(n))) { // already checked
+ halfword index = lmt_tohalfword(L, 2);
+ halfword value = lmt_optinteger(L, 3, unused_attribute_value);
+ // if (value == unused_attribute_value) {
+ // tex_unset_attribute(n, index, value);
+ // } else {
+ tex_set_attribute(n, index, value);
+ // }
+ }
+ return 0;
+}
+
+/* set_attributes(n,[initial,]key1,val1,key2,val2,...) */
+
+static int nodelib_direct_setattributes(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && tex_nodetype_has_attributes(node_type(n))) {
+ int top = lua_gettop(L);
+ int ini = 2;
+ if (lua_type(L, 2) == LUA_TBOOLEAN) {
+ ++ini;
+ if (lua_toboolean(L, 2) && ! node_attr(n)) {
+ attach_current_attribute_list(n);
+ }
+ }
+ for (int i = ini; i <= top; i += 2) {
+ halfword key = lmt_tohalfword(L, i);
+ halfword val = lmt_optinteger(L, i + 1, unused_attribute_value);
+ // if (val == unused_attribute_value) {
+ // tex_unset_attribute(p, key, val);
+ // } else {
+ tex_set_attribute(n, key, val);
+ // }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_patchattributes(lua_State *L)
+{
+ halfword p = nodelib_valid_direct_from_index(L, 1);
+ if (p) { /* todo: check if attributes */
+ halfword att = null;
+ int top = lua_gettop(L);
+ for (int i = 2; i <= top; i += 2) {
+ halfword index = lmt_tohalfword(L, i);
+ halfword value = lua_type(L, i + 1) == LUA_TNUMBER ? lmt_tohalfword(L, i + 1) : unused_attribute_value;
+ if (att) {
+ att = tex_patch_attribute_list(att, index, value);
+ } else {
+ att = tex_copy_attribute_list_set(node_attr(p), index, value);
+ }
+ }
+ tex_attach_attribute_list_attribute(p, att);
+ }
+ return 0;
+}
+
+static int nodelib_direct_findattribute(lua_State *L) /* returns attr value and node */
+{
+ halfword c = nodelib_valid_direct_from_index(L, 1);
+ if (c) {
+ halfword i = lmt_tohalfword(L, 2);
+ while (c) {
+ if (tex_nodetype_has_attributes(node_type(c))) {
+ halfword p = node_attr(c);
+ if (p) {
+ p = node_next(p);
+ while (p) {
+ if (attribute_index(p) == i) {
+ halfword ret = attribute_value(p);
+ if (ret == unused_attribute_value) {
+ break;
+ } else {
+ lua_pushinteger(L, ret);
+ lua_pushinteger(L, c);
+ return 2;
+ }
+ } else if (attribute_index(p) > i) {
+ break;
+ }
+ p = node_next(p);
+ }
+ }
+ }
+ c = node_next(c);
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_unsetattribute(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword key = lmt_checkhalfword(L, 2);
+ halfword val = lmt_opthalfword(L, 3, unused_attribute_value);
+ halfword ret = tex_unset_attribute(n, key, val);
+ if (ret > unused_attribute_value) { /* != */
+ lua_pushinteger(L, ret);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+static int nodelib_direct_unsetattributes(lua_State *L)
+{
+ halfword key = lmt_checkhalfword(L, 1);
+ halfword first = nodelib_valid_direct_from_index(L, 2);
+ halfword last = nodelib_valid_direct_from_index(L, 3);
+ if (first) {
+ tex_unset_attributes(first, last, key);
+ }
+ return 0;
+}
+
+/* node.set_attribute */
+/* node.unset_attribute */
+
+static int nodelib_userdata_setattribute(lua_State *L)
+{
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ halfword key = lmt_tohalfword(L, 2);
+ halfword val = lmt_opthalfword(L, 3, unused_attribute_value);
+ if (val == unused_attribute_value) {
+ tex_unset_attribute(n, key, val);
+ } else {
+ tex_set_attribute(n, key, val);
+ }
+ }
+ return 0;
+}
+
+static int nodelib_userdata_unsetattribute(lua_State *L)
+{
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ halfword key = lmt_checkhalfword(L, 2);
+ halfword val = lmt_opthalfword(L, 3, unused_attribute_value);
+ halfword ret = tex_unset_attribute(n, key, val);
+ if (ret > unused_attribute_value) {
+ lua_pushinteger(L, ret);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.getglue */
+/* node.direct.setglue */
+/* node.direct.iszeroglue */
+
+static int nodelib_direct_getglue(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glue_node:
+ case glue_spec_node:
+ lua_pushinteger(L, glue_amount(n));
+ lua_pushinteger(L, glue_stretch(n));
+ lua_pushinteger(L, glue_shrink(n));
+ lua_pushinteger(L, glue_stretch_order(n));
+ lua_pushinteger(L, glue_shrink_order(n));
+ return 5;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushnumber(L, (double) box_glue_set(n)); /* float */
+ lua_pushinteger(L, box_glue_order(n));
+ lua_pushinteger(L, box_glue_sign(n));
+ return 3;
+ case math_node:
+ lua_pushinteger(L, math_amount(n));
+ lua_pushinteger(L, math_stretch(n));
+ lua_pushinteger(L, math_shrink(n));
+ lua_pushinteger(L, math_stretch_order(n));
+ lua_pushinteger(L, math_shrink_order(n));
+ return 5;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setglue(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int top = lua_gettop(L);
+ switch (node_type(n)) {
+ case glue_node:
+ case glue_spec_node:
+ glue_amount(n) = ((top > 1 && lua_type(L, 2) == LUA_TNUMBER)) ? (halfword) lmt_roundnumber(L, 2) : 0;
+ glue_stretch(n) = ((top > 2 && lua_type(L, 3) == LUA_TNUMBER)) ? (halfword) lmt_roundnumber(L, 3) : 0;
+ glue_shrink(n) = ((top > 3 && lua_type(L, 4) == LUA_TNUMBER)) ? (halfword) lmt_roundnumber(L, 4) : 0;
+ glue_stretch_order(n) = tex_checked_glue_order((top > 4 && lua_type(L, 5) == LUA_TNUMBER) ? lmt_tohalfword(L, 5) : 0);
+ glue_shrink_order(n) = tex_checked_glue_order((top > 5 && lua_type(L, 6) == LUA_TNUMBER) ? lmt_tohalfword(L, 6) : 0);
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ box_glue_set(n) = ((top > 1 && lua_type(L, 2) == LUA_TNUMBER)) ? (glueratio) lua_tonumber(L, 2) : 0;
+ box_glue_order(n) = tex_checked_glue_sign((top > 2 && lua_type(L, 3) == LUA_TNUMBER) ? (halfword) lua_tointeger(L, 3) : 0);
+ box_glue_sign(n) = tex_checked_glue_order((top > 3 && lua_type(L, 4) == LUA_TNUMBER) ? (halfword) lua_tointeger(L, 4) : 0);
+ break;
+ case math_node:
+ math_amount(n) = ((top > 1 && lua_type(L, 2) == LUA_TNUMBER)) ? (halfword) lmt_roundnumber(L, 2) : 0;
+ math_stretch(n) = ((top > 2 && lua_type(L, 3) == LUA_TNUMBER)) ? (halfword) lmt_roundnumber(L, 3) : 0;
+ math_shrink(n) = ((top > 3 && lua_type(L, 4) == LUA_TNUMBER)) ? (halfword) lmt_roundnumber(L, 4) : 0;
+ math_stretch_order(n) = tex_checked_glue_order((top > 4 && lua_type(L, 5) == LUA_TNUMBER) ? lmt_tohalfword(L, 5) : 0);
+ math_shrink_order(n) = tex_checked_glue_order((top > 5 && lua_type(L, 6) == LUA_TNUMBER) ? lmt_tohalfword(L, 6) : 0);
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_iszeroglue(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glue_node:
+ case glue_spec_node:
+ lua_pushboolean(L, glue_amount(n) == 0 && glue_stretch(n) == 0 && glue_shrink(n) == 0);
+ return 1;
+ case hlist_node:
+ case vlist_node:
+ lua_pushboolean(L, box_glue_set(n) == 0.0 && box_glue_order(n) == 0 && box_glue_sign(n) == 0);
+ return 1;
+ case math_node:
+ lua_pushboolean(L, math_amount(n) == 0 && math_stretch(n) == 0 && math_shrink(n) == 0);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* direct.startofpar */
+
+static int nodelib_direct_startofpar(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ lua_pushboolean(L, n && tex_is_start_of_par_node(n));
+ return 1;
+}
+
+/* iteration */
+
+static int nodelib_aux_nil(lua_State *L)
+{
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.direct.traverse */
+/* node.direct.traverse_id */
+/* node.direct.traverse_char */
+/* node.direct.traverse_glyph */
+/* node.direct.traverse_list */
+/* node.direct.traverse_leader */
+
+static int nodelib_direct_aux_next(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ return 3;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_aux_prev(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ return 3;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_traverse(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_direct_aux_prev, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_direct_aux_next, 0);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ }
+ }
+}
+
+static int nodelib_direct_aux_next_filtered(lua_State *L)
+{
+ halfword t;
+ int i = (int) lua_tointeger(L, lua_upvalueindex(1));
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ while (t && node_type(t) != i) {
+ t = node_next(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_subtype(t));
+ return 2;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_aux_prev_filtered(lua_State *L)
+{
+ halfword t;
+ int i = (int) lua_tointeger(L, lua_upvalueindex(1));
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ while (t && node_type(t) != i) {
+ t = node_prev(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_subtype(t));
+ return 2;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_traverseid(lua_State *L)
+{
+ if (lua_isnil(L, 2)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 2);
+ if (n) {
+ if (lua_toboolean(L, 3)) {
+ if (lua_toboolean(L, 4)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_settop(L, 1);
+ lua_pushcclosure(L, nodelib_direct_aux_prev_filtered, 1);
+ } else {
+ lua_settop(L, 1);
+ lua_pushcclosure(L, nodelib_direct_aux_next_filtered, 1);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ return 0;
+ }
+ }
+}
+
+static int nodelib_direct_aux_next_char(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ while (t && (node_type(t) != glyph_node || glyph_protected(t))) {
+ t = node_next(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, glyph_character(t));
+ lua_pushinteger(L, glyph_font(t));
+ lua_pushinteger(L, glyph_data(t));
+ return 4;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_aux_prev_char(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ while (t && (node_type(t) != glyph_node || glyph_protected(t))) {
+ t = node_prev(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, glyph_character(t));
+ lua_pushinteger(L, glyph_font(t));
+ lua_pushinteger(L, glyph_data(t));
+ return 4;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_traversechar(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_direct_aux_prev_char, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_direct_aux_next_char, 0);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ }
+ }
+}
+
+static int nodelib_direct_aux_next_glyph(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ while (t && node_type(t) != glyph_node) {
+ t = node_next(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, glyph_character(t));
+ lua_pushinteger(L, glyph_font(t));
+ return 3;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_aux_prev_glyph(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ while (t && node_type(t) != glyph_node) {
+ t = node_prev(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, glyph_character(t));
+ lua_pushinteger(L, glyph_font(t));
+ return 3;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_traverseglyph(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_direct_aux_prev_glyph, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_direct_aux_next_glyph, 0);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ }
+ }
+}
+
+static int nodelib_direct_aux_next_list(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ while (t && node_type(t) != hlist_node && node_type(t) != vlist_node) {
+ t = node_next(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ nodelib_push_direct_or_nil(L, box_list(t));
+ return 4;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_aux_prev_list(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ while (t && node_type(t) != hlist_node && node_type(t) != vlist_node) {
+ t = node_prev(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ nodelib_push_direct_or_nil(L, box_list(t));
+ return 4;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_traverselist(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_direct_aux_prev_list, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_direct_aux_next_list, 0);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ }
+ }
+}
+
+/*tex This is an experiment. */
+
+static int nodelib_direct_aux_next_leader(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ while (t && ! ((node_type(t) == hlist_node || node_type(t) == vlist_node) && has_box_package_state(t, package_u_leader_set))) {
+ t = node_next(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ nodelib_push_direct_or_nil(L, box_list(t));
+ return 4;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_aux_prev_leader(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ while (t && ! ((node_type(t) == hlist_node || node_type(t) == vlist_node) && has_box_package_state(t, package_u_leader_set))) {
+ t = node_prev(t);
+ }
+ if (t) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ nodelib_push_direct_or_nil(L, box_list(t));
+ return 4;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_direct_traverseleader(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_direct_aux_prev_leader, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_direct_aux_next_leader, 0);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ }
+ }
+}
+
+
+/*tex This is an experiment. */
+
+static int nodelib_direct_aux_next_content(lua_State *L)
+{
+ halfword t;
+ halfword l = null;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ while (t) {
+ switch (node_type(t)) {
+ case glyph_node:
+ case disc_node:
+ case rule_node:
+ goto FOUND;
+ case glue_node:
+ l = glue_leader_ptr(t);
+ if (l) {
+ goto FOUND;
+ } else {
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ l = box_list(t);
+ goto FOUND;
+ }
+ t = node_next(t);
+ }
+ lua_pushnil(L);
+ return 1;
+ FOUND:
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ if (l) {
+ nodelib_push_direct_or_nil(L, l);
+ return 4;
+ } else {
+ return 3;
+ }
+}
+
+static int nodelib_direct_aux_prev_content(lua_State *L)
+{
+ halfword t;
+ halfword l = null;
+ if (lua_isnil(L, 2)) {
+ t = lmt_tohalfword(L, 1) ;
+ lua_settop(L, 1);
+ } else {
+ t = lmt_tohalfword(L, 2) ;
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ while (t) {
+ switch (node_type(t)) {
+ case glyph_node:
+ case disc_node:
+ case rule_node:
+ goto FOUND;
+ case glue_node:
+ l = glue_leader_ptr(t);
+ if (l) {
+ goto FOUND;
+ } else {
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ l = box_list(t);
+ goto FOUND;
+ }
+ t = node_prev(t);
+ }
+ lua_pushnil(L);
+ return 1;
+ FOUND:
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ if (l) {
+ nodelib_push_direct_or_nil(L, l);
+ return 4;
+ } else {
+ return 3;
+ }
+}
+
+static int nodelib_direct_traversecontent(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_direct_aux_prev_content, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_direct_aux_next_content, 0);
+ }
+ lua_pushinteger(L, n);
+ lua_pushnil(L);
+ return 3;
+ } else {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ }
+ }
+}
+
+/* node.traverse */
+/* node.traverse_id */
+/* node.traverse_char */
+/* node.traverse_glyph */
+/* node.traverse_list */
+
+static int nodelib_aux_next(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_check_isnode(L, 1);
+ lua_settop(L, 1);
+ } else {
+ t = lmt_check_isnode(L, 2);
+ t = node_next(t);
+ lua_settop(L, 2);
+ }
+ if (t) {
+ nodelib_push_node_on_top(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ return 3;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_aux_prev(lua_State *L)
+{
+ halfword t;
+ if (lua_isnil(L, 2)) {
+ t = lmt_check_isnode(L, 1);
+ lua_settop(L, 1);
+ } else {
+ t = lmt_check_isnode(L, 2);
+ t = node_prev(t);
+ lua_settop(L, 2);
+ }
+ if (t) {
+ nodelib_push_node_on_top(L, t);
+ lua_pushinteger(L, node_type(t));
+ lua_pushinteger(L, node_subtype(t));
+ return 3;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_userdata_traverse(lua_State *L)
+{
+ if (lua_isnil(L, 1)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = lmt_check_isnode(L, 1);
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_pushcclosure(L, nodelib_aux_prev, 0);
+ } else {
+ lua_pushcclosure(L, nodelib_aux_next, 0);
+ }
+ lmt_push_node_fast(L, n);
+ lua_pushnil(L);
+ return 3;
+ }
+}
+
+static int nodelib_aux_next_filtered(lua_State *L)
+{
+ halfword t;
+ int i = (int) lua_tointeger(L, lua_upvalueindex(1));
+ if (lua_isnil(L, 2)) {
+ /* first call */
+ t = lmt_check_isnode(L, 1);
+ lua_settop(L,1);
+ } else {
+ t = lmt_check_isnode(L, 2);
+ t = node_next(t);
+ lua_settop(L,2);
+ }
+ while (t && node_type(t) != i) {
+ t = node_next(t);
+ }
+ if (t) {
+ nodelib_push_node_on_top(L, t);
+ lua_pushinteger(L, node_subtype(t));
+ return 2;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_aux_prev_filtered(lua_State *L)
+{
+ halfword t;
+ int i = (int) lua_tointeger(L, lua_upvalueindex(1));
+ if (lua_isnil(L, 2)) {
+ /* first call */
+ t = lmt_check_isnode(L, 1);
+ lua_settop(L,1);
+ } else {
+ t = lmt_check_isnode(L, 2);
+ t = node_prev(t);
+ lua_settop(L,2);
+ }
+ while (t && node_type(t) != i) {
+ t = node_prev(t);
+ }
+ if (t) {
+ nodelib_push_node_on_top(L, t);
+ lua_pushinteger(L, node_subtype(t));
+ return 2;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_userdata_traverse_id(lua_State *L)
+{
+ if (lua_isnil(L, 2)) {
+ lua_pushcclosure(L, nodelib_aux_nil, 0);
+ return 1;
+ } else {
+ halfword n = lmt_check_isnode(L, 2);
+ if (lua_toboolean(L, 3)) {
+ if (lua_toboolean(L, 4)) {
+ n = tex_tail_of_node_list(n);
+ }
+ lua_settop(L, 1);
+ lua_pushcclosure(L, nodelib_aux_prev_filtered, 1);
+ } else {
+ lua_settop(L, 1);
+ lua_pushcclosure(L, nodelib_aux_next_filtered, 1);
+ }
+ lmt_push_node_fast(L, n);
+ lua_pushnil(L);
+ return 3;
+ }
+}
+
+/* node.direct.length */
+/* node.direct.count */
+
+/*tex As with some other function that have a |last| we don't take that one into account. */
+
+static int nodelib_direct_length(lua_State *L)
+{
+ halfword first = nodelib_valid_direct_from_index(L, 1);
+ halfword last = nodelib_valid_direct_from_index(L, 2);
+ int count = 0;
+ if (first) {
+ while (first != last) {
+ count++;
+ first = node_next(first);
+ }
+ }
+ lua_pushinteger(L, count);
+ return 1;
+}
+
+static int nodelib_direct_count(lua_State *L)
+{
+ quarterword id = lmt_toquarterword(L, 1);
+ halfword first = nodelib_valid_direct_from_index(L, 2);
+ halfword last = nodelib_valid_direct_from_index(L, 3);
+ int count = 0;
+ if (first) {
+ while (first != last) {
+ if (node_type(first) == id) {
+ count++;
+ }
+ first = node_next(first);
+ }
+ }
+ lua_pushinteger(L, count);
+ return 1;
+}
+
+/*tex A few helpers for later usage: */
+
+inline static int nodelib_getattribute_value(lua_State *L, halfword n, int index)
+{
+ halfword key = (halfword) lua_tointeger(L, index);
+ halfword val = tex_has_attribute(n, key, unused_attribute_value);
+ if (val == unused_attribute_value) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, val);
+ }
+ return 1;
+}
+
+inline static void nodelib_setattribute_value(lua_State *L, halfword n, int kindex, int vindex)
+{
+ if (lua_gettop(L) >= kindex) {
+ halfword key = lmt_tohalfword(L, kindex);
+ halfword val = lmt_opthalfword(L, vindex, unused_attribute_value);
+ if (val == unused_attribute_value) {
+ tex_unset_attribute(n, key, val);
+ } else {
+ tex_set_attribute(n, key, val);
+ }
+ } else {
+ luaL_error(L, "incorrect number of arguments");
+ }
+}
+
+/* node.direct.getfield */
+/* node.getfield */
+
+/*tex
+
+ The order is somewhat determined by the occurance of nodes and importance of fields. We use
+ |somenode[9]| as interface to attributes ... 30\% faster than has_attribute (1) because there
+ is no \LUA\ function overhead, and (2) because we already know that we deal with a node so no
+ checking is needed. The fast typecheck is needed (lua_check... is a slow down actually).
+
+ This is just a reminder for me: when used in the build page routine the |last_insert_ptr| and
+ |best_insert_ptr| are sort of tricky as the first in a list can be a fake node (zero zero list
+ being next). Because no properties are accessed this works ok. In the getfield routines we
+ can assume that these nodes are never seen (the pagebuilder constructs insert nodes using that
+ data). But it is something to keep an eye on when we open up more or add callbacks. So there
+ is a comment below.
+
+*/
+
+static int nodelib_common_getfield(lua_State *L, int direct, halfword n)
+{
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ {
+ return nodelib_getattribute_value(L, n, 2);
+ }
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, 2);
+ int t = node_type(n);
+ if (lua_key_eq(s, id)) {
+ lua_pushinteger(L, t);
+ } else if (lua_key_eq(s, next)) {
+ if (tex_nodetype_has_next(t)) {
+ nodelib_push_direct_or_node(L, direct, node_next(n));
+ } else {
+ /* nodelib_invalid_field_error(L, s, n); */
+ lua_pushnil(L);
+ }
+ } else if (lua_key_eq(s, prev)) {
+ if (tex_nodetype_has_prev(t)) {
+ nodelib_push_direct_or_node(L, direct, node_prev(n));
+ } else {
+ /* nodelib_invalid_field_error(L, s, n); */
+ lua_pushnil(L);
+ }
+ } else if (lua_key_eq(s, attr)) {
+ if (tex_nodetype_has_attributes(t)) {
+ nodelib_push_direct_or_node(L, direct, node_attr(n));
+ } else {
+ /* nodelib_invalid_field_error(L, s, n); */
+ lua_pushnil(L);
+ }
+ } else if (lua_key_eq(s, subtype)) {
+ if (tex_nodetype_has_subtype(t)) {
+ lua_pushinteger(L, node_subtype(n));
+ } else {
+ /* nodelib_invalid_field_error(L, s, n); */
+ lua_pushnil(L);
+ }
+ } else {
+ switch(t) {
+ case glyph_node:
+ if (lua_key_eq(s, font)) {
+ lua_pushinteger(L, glyph_font(n));
+ } else if (lua_key_eq(s, char)) {
+ lua_pushinteger(L, glyph_character(n));
+ } else if (lua_key_eq(s, xoffset)) {
+ lua_pushinteger(L, glyph_x_offset(n));
+ } else if (lua_key_eq(s, yoffset)) {
+ lua_pushinteger(L, glyph_y_offset(n));
+ } else if (lua_key_eq(s, data)) {
+ lua_pushinteger(L, glyph_data(n));
+ } else if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, tex_glyph_width(n));
+ } else if (lua_key_eq(s, height)) {
+ lua_pushinteger(L, tex_glyph_height(n));
+ } else if (lua_key_eq(s, depth)) {
+ // lua_pushinteger(L, char_depth_from_glyph(n));
+ lua_pushinteger(L, tex_glyph_depth(n));
+ } else if (lua_key_eq(s, total)) {
+ // lua_pushinteger(L, char_total_from_glyph(n));
+ lua_pushinteger(L, tex_glyph_total(n));
+ } else if (lua_key_eq(s, scale)) {
+ lua_pushinteger(L, glyph_scale(n));
+ } else if (lua_key_eq(s, xscale)) {
+ lua_pushinteger(L, glyph_x_scale(n));
+ } else if (lua_key_eq(s, yscale)) {
+ lua_pushinteger(L, glyph_y_scale(n));
+ } else if (lua_key_eq(s, expansion)) {
+ lua_pushinteger(L, glyph_expansion(n));
+ } else if (lua_key_eq(s, state)) {
+ lua_pushinteger(L, get_glyph_state(n));
+ } else if (lua_key_eq(s, script)) {
+ lua_pushinteger(L, get_glyph_script(n));
+ } else if (lua_key_eq(s, language)) {
+ lua_pushinteger(L, get_glyph_language(n));
+ } else if (lua_key_eq(s, lhmin)) {
+ lua_pushinteger(L, get_glyph_lhmin(n));
+ } else if (lua_key_eq(s, rhmin)) {
+ lua_pushinteger(L, get_glyph_rhmin(n));
+ } else if (lua_key_eq(s, left)) {
+ lua_pushinteger(L, get_glyph_left(n));
+ } else if (lua_key_eq(s, right)) {
+ lua_pushinteger(L, get_glyph_right(n));
+ } else if (lua_key_eq(s, uchyph)) {
+ lua_pushinteger(L, get_glyph_uchyph(n));
+ } else if (lua_key_eq(s, hyphenate)) {
+ lua_pushinteger(L, get_glyph_hyphenate(n));
+ } else if (lua_key_eq(s, options)) {
+ lua_pushinteger(L, get_glyph_options(n));
+ } else if (lua_key_eq(s, discpart)) {
+ lua_pushinteger(L, get_glyph_discpart(n));
+ } else if (lua_key_eq(s, protected)) {
+ lua_pushinteger(L, glyph_protected(n));
+ } else if (lua_key_eq(s, properties)) {
+ lua_pushinteger(L, glyph_properties(n));
+ } else if (lua_key_eq(s, group)) {
+ lua_pushinteger(L, glyph_group(n));
+ } else if (lua_key_eq(s, index)) {
+ lua_pushinteger(L, glyph_index(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ /* candidates: whd (width,height,depth) */
+ if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ nodelib_push_direct_or_node_node_prev(L, direct, box_list(n));
+ } else if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, box_width(n));
+ } else if (lua_key_eq(s, height)) {
+ lua_pushinteger(L, box_height(n));
+ } else if (lua_key_eq(s, depth)) {
+ lua_pushinteger(L, box_depth(n));
+ } else if (lua_key_eq(s, total)) {
+ lua_pushinteger(L, box_total(n));
+ } else if (lua_key_eq(s, direction)) {
+ lua_pushinteger(L, checked_direction_value(box_dir(n)));
+ } else if (lua_key_eq(s, shift)) {
+ lua_pushinteger(L, box_shift_amount(n));
+ } else if (lua_key_eq(s, glueorder)) {
+ lua_pushinteger(L, box_glue_order(n));
+ } else if (lua_key_eq(s, gluesign)) {
+ lua_pushinteger(L, box_glue_sign(n));
+ } else if (lua_key_eq(s, glueset)) {
+ lua_pushnumber(L, (double) box_glue_set(n)); /* float */
+ } else if (lua_key_eq(s, geometry)) {
+ lua_pushinteger(L, box_geometry(n));
+ } else if (lua_key_eq(s, orientation)) {
+ lua_pushinteger(L, box_orientation(n));
+ } else if (lua_key_eq(s, anchor)) {
+ lua_pushinteger(L, box_anchor(n));
+ } else if (lua_key_eq(s, source)) {
+ lua_pushinteger(L, box_source_anchor(n));
+ } else if (lua_key_eq(s, target)) {
+ lua_pushinteger(L, box_target_anchor(n));
+ } else if (lua_key_eq(s, xoffset)) {
+ lua_pushinteger(L, box_x_offset(n));
+ } else if (lua_key_eq(s, yoffset)) {
+ lua_pushinteger(L, box_y_offset(n));
+ } else if (lua_key_eq(s, woffset)) {
+ lua_pushinteger(L, box_w_offset(n));
+ } else if (lua_key_eq(s, hoffset)) {
+ lua_pushinteger(L, box_h_offset(n));
+ } else if (lua_key_eq(s, doffset)) {
+ lua_pushinteger(L, box_d_offset(n));
+ } else if (lua_key_eq(s, pre)) {
+ nodelib_push_direct_or_node(L, direct, box_pre_migrated(n));
+ } else if (lua_key_eq(s, post)) {
+ nodelib_push_direct_or_node(L, direct, box_post_migrated(n));
+ } else if (lua_key_eq(s, state)) {
+ lua_pushinteger(L, box_package_state(n));
+ } else if (lua_key_eq(s, index)) {
+ lua_pushinteger(L, box_index(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case disc_node:
+ if (lua_key_eq(s, pre)) {
+ nodelib_push_direct_or_node(L, direct, disc_pre_break_head(n));
+ } else if (lua_key_eq(s, post)) {
+ nodelib_push_direct_or_node(L, direct, disc_post_break_head(n));
+ } else if (lua_key_eq(s, replace)) {
+ nodelib_push_direct_or_node(L, direct, disc_no_break_head(n));
+ } else if (lua_key_eq(s, penalty)) {
+ lua_pushinteger(L, disc_penalty(n));
+ } else if (lua_key_eq(s, options)) {
+ lua_pushinteger(L, disc_options(n));
+ } else if (lua_key_eq(s, class)) {
+ lua_pushinteger(L, disc_class(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case glue_node:
+ if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, glue_amount(n));
+ } else if (lua_key_eq(s, stretch)) {
+ lua_pushinteger(L, glue_stretch(n));
+ } else if (lua_key_eq(s, shrink)) {
+ lua_pushinteger(L, glue_shrink(n));
+ } else if (lua_key_eq(s, stretchorder)) {
+ lua_pushinteger(L, glue_stretch_order(n));
+ } else if (lua_key_eq(s, shrinkorder)) {
+ lua_pushinteger(L, glue_shrink_order(n));
+ } else if (lua_key_eq(s, leader)) {
+ nodelib_push_direct_or_node(L, direct, glue_leader_ptr(n));
+ } else if (lua_key_eq(s, font)) {
+ lua_pushinteger(L, glue_font(n));
+ } else if (lua_key_eq(s, data)) {
+ lua_pushinteger(L, glue_data(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case kern_node:
+ if (lua_key_eq(s, kern)) {
+ lua_pushinteger(L, kern_amount(n));
+ } else if (lua_key_eq(s, expansion)) {
+ lua_pushinteger(L, kern_expansion(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case penalty_node:
+ if (lua_key_eq(s, penalty)) {
+ lua_pushinteger(L, penalty_amount(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case rule_node:
+ /* candidates: whd (width,height,depth) */
+ if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, rule_width(n));
+ } else if (lua_key_eq(s, height)) {
+ lua_pushinteger(L, rule_height(n));
+ } else if (lua_key_eq(s, depth)) {
+ lua_pushinteger(L, rule_depth(n));
+ } else if (lua_key_eq(s, total)) {
+ lua_pushinteger(L, rule_total(n));
+ } else if (lua_key_eq(s, xoffset)) {
+ lua_pushinteger(L,rule_x_offset(n));
+ } else if (lua_key_eq(s, yoffset)) {
+ lua_pushinteger(L,rule_y_offset(n));
+ } else if (lua_key_eq(s, left)) {
+ lua_pushinteger(L,rule_left(n));
+ } else if (lua_key_eq(s, right)) {
+ lua_pushinteger(L,rule_right(n));
+ } else if (lua_key_eq(s, data)) {
+ lua_pushinteger(L,rule_data(n));
+ } else if (lua_key_eq(s, font)) {
+ lua_pushinteger(L, tex_get_rule_font(n, text_style));
+ } else if (lua_key_eq(s, fam)) {
+ lua_pushinteger(L, tex_get_rule_font(n, text_style));
+ } else if (lua_key_eq(s, char)) {
+ lua_pushinteger(L, rule_character(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case dir_node:
+ if (lua_key_eq(s, direction)) {
+ lua_pushinteger(L, dir_direction(n));
+ } else if (lua_key_eq(s, level)) {
+ lua_pushinteger(L, dir_level(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case whatsit_node:
+ lua_pushnil(L);
+ break;
+ case par_node:
+ /* not all of them here */
+ if (lua_key_eq(s, interlinepenalty)) {
+ lua_pushinteger(L, tex_get_local_interline_penalty(n));
+ } else if (lua_key_eq(s, brokenpenalty)) {
+ lua_pushinteger(L, tex_get_local_broken_penalty(n));
+ } else if (lua_key_eq(s, direction)) {
+ lua_pushinteger(L, par_dir(n));
+ } else if (lua_key_eq(s, leftbox)) {
+ nodelib_push_direct_or_node(L, direct, par_box_left(n));
+ } else if (lua_key_eq(s, leftboxwidth)) {
+ lua_pushinteger(L, tex_get_local_left_width(n));
+ } else if (lua_key_eq(s, rightbox)) {
+ nodelib_push_direct_or_node(L, direct, par_box_right(n));
+ } else if (lua_key_eq(s, rightboxwidth)) {
+ lua_pushinteger(L, tex_get_local_right_width(n));
+ } else if (lua_key_eq(s, middlebox)) {
+ nodelib_push_direct_or_node(L, direct, par_box_middle(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case math_char_node:
+ case math_text_char_node:
+ if (lua_key_eq(s, fam)) {
+ lua_pushinteger(L, kernel_math_family(n));
+ } else if (lua_key_eq(s, char)) {
+ lua_pushinteger(L, kernel_math_character(n));
+ } else if (lua_key_eq(s, font)) {
+ lua_pushinteger(L, tex_fam_fnt(kernel_math_family(n), 0));
+ } else if (lua_key_eq(s, options)) {
+ lua_pushinteger(L, kernel_math_options(n));
+ } else if (lua_key_eq(s, properties)) {
+ lua_pushinteger(L, kernel_math_properties(n));
+ } else if (lua_key_eq(s, group)) {
+ lua_pushinteger(L, kernel_math_group(n));
+ } else if (lua_key_eq(s, index)) {
+ lua_pushinteger(L, kernel_math_index(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case mark_node:
+ if (lua_key_eq(s, index) || lua_key_eq(s, class)) {
+ lua_pushinteger(L, mark_index(n));
+ } else if (lua_key_eq(s, data) || lua_key_eq(s, mark)) {
+ if (lua_toboolean(L, 3)) {
+ lmt_token_list_to_luastring(L, mark_ptr(n), 0, 0);
+ } else {
+ lmt_token_list_to_lua(L, mark_ptr(n));
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case insert_node:
+ if (lua_key_eq(s, index)) {
+ halfword index = lmt_tohalfword(L, 3);
+ if (tex_valid_insert_id(index)) {
+ insert_index(n) = index;
+ }
+ } else if (lua_key_eq(s, cost)) {
+ lua_pushinteger(L, insert_float_cost(n));
+ } else if (lua_key_eq(s, depth)) {
+ lua_pushinteger(L, insert_max_depth(n));
+ } else if (lua_key_eq(s, height) || lua_key_eq(s, total)) {
+ lua_pushinteger(L, insert_total_height(n));
+ } else if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ nodelib_push_direct_or_node_node_prev(L, direct, insert_list(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case math_node:
+ if (lua_key_eq(s, surround)) {
+ lua_pushinteger(L, math_surround(n));
+ } else if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, math_amount(n));
+ } else if (lua_key_eq(s, stretch)) {
+ lua_pushinteger(L, math_stretch(n));
+ } else if (lua_key_eq(s, shrink)) {
+ lua_pushinteger(L, math_shrink(n));
+ } else if (lua_key_eq(s, stretchorder)) {
+ lua_pushinteger(L, math_stretch_order(n));
+ } else if (lua_key_eq(s, shrinkorder)) {
+ lua_pushinteger(L, math_shrink_order(n));
+ } else if (lua_key_eq(s, penalty)) {
+ lua_pushinteger(L, math_penalty(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case style_node:
+ if (lua_key_eq(s, style)) {
+ lmt_push_math_style_name(L, style_style(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case parameter_node:
+ if (lua_key_eq(s, style)) {
+ lmt_push_math_style_name(L, parameter_style(n));
+ } else if (lua_key_eq(s, name)) {
+ lmt_push_math_parameter(L, parameter_name(n));
+ } else if (lua_key_eq(s, value)) {
+ halfword code = parameter_name(n);
+ if (code < 0 || code >= math_parameter_last) {
+ /* error */
+ lua_pushnil(L);
+ } else if (math_parameter_value_type(code)) {
+ /* todo, see tex_getmathparm */
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, parameter_value(n));
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ if (lua_key_eq(s, nucleus)) {
+ nodelib_push_direct_or_nil(L, noad_nucleus(n));
+ } else if (lua_key_eq(s, sub)) {
+ nodelib_push_direct_or_nil(L, noad_subscr(n));
+ } else if (lua_key_eq(s, sup)) {
+ nodelib_push_direct_or_nil(L, noad_supscr(n));
+ } else if (lua_key_eq(s, prime)) {
+ nodelib_push_direct_or_nil(L, noad_prime(n));
+ } else if (lua_key_eq(s, subpre)) {
+ nodelib_push_direct_or_nil(L, noad_subprescr(n));
+ } else if (lua_key_eq(s, suppre)) {
+ nodelib_push_direct_or_nil(L, noad_supprescr(n));
+ } else if (lua_key_eq(s, options)) {
+ lua_pushinteger(L, noad_options(n));
+ } else if (lua_key_eq(s, source)) {
+ lua_pushinteger(L, noad_source(n));
+ } else if (lua_key_eq(s, scriptorder)) {
+ lua_pushinteger(L, noad_script_order(n));
+ } else if (lua_key_eq(s, class)) {
+ lua_pushinteger(L, get_noad_main_class(n));
+ lua_pushinteger(L, get_noad_left_class(n));
+ lua_pushinteger(L, get_noad_right_class(n));
+ return 3;
+ } else {
+ switch(t) {
+ case simple_noad:
+ lua_pushnil(L);
+ break;
+ case radical_noad:
+ if (lua_key_eq(s, left) || lua_key_eq(s, delimiter)) {
+ nodelib_push_direct_or_node(L, direct, radical_left_delimiter(n));
+ } else if (lua_key_eq(s, right)) {
+ nodelib_push_direct_or_node(L, direct, radical_right_delimiter(n));
+ } else if (lua_key_eq(s, degree)) {
+ nodelib_push_direct_or_node(L, direct, radical_degree(n));
+ } else if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, noad_width(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case fraction_noad:
+ if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, fraction_rule_thickness(n));
+ } else if (lua_key_eq(s, numerator)) {
+ nodelib_push_direct_or_nil(L, fraction_numerator(n));
+ } else if (lua_key_eq(s, denominator)) {
+ nodelib_push_direct_or_nil(L, fraction_denominator(n));
+ } else if (lua_key_eq(s, left)) {
+ nodelib_push_direct_or_nil(L, fraction_left_delimiter(n));
+ } else if (lua_key_eq(s, right)) {
+ nodelib_push_direct_or_nil(L, fraction_right_delimiter(n));
+ } else if (lua_key_eq(s, middle)) {
+ nodelib_push_direct_or_nil(L, fraction_middle_delimiter(n));
+ } else if (lua_key_eq(s, fam)) {
+ lua_pushinteger(L, noad_family(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case accent_noad:
+ if (lua_key_eq(s, top) || lua_key_eq(s, topaccent)) {
+ nodelib_push_direct_or_node(L, direct, accent_top_character(n));
+ } else if (lua_key_eq(s, bottom) || lua_key_eq(s, bottomaccent)) {
+ nodelib_push_direct_or_node(L, direct, accent_bottom_character(n));
+ } else if (lua_key_eq(s, middle) || lua_key_eq(s, overlayaccent)) {
+ nodelib_push_direct_or_node(L, direct, accent_middle_character(n));
+ } else if (lua_key_eq(s, fraction)) {
+ lua_pushinteger(L, accent_fraction(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case fence_noad:
+ if (lua_key_eq(s, delimiter)) {
+ nodelib_push_direct_or_node(L, direct, fence_delimiter_list(n));
+ } else if (lua_key_eq(s, top)) {
+ nodelib_push_direct_or_node(L, direct, fence_delimiter_top(n));
+ } else if (lua_key_eq(s, bottom)) {
+ nodelib_push_direct_or_node(L, direct, fence_delimiter_bottom(n));
+ } else if (lua_key_eq(s, italic)) {
+ lua_pushinteger(L, noad_italic(n));
+ } else if (lua_key_eq(s, height)) {
+ lua_pushinteger(L, noad_height(n));
+ } else if (lua_key_eq(s, depth)) {
+ lua_pushinteger(L, noad_depth(n));
+ } else if (lua_key_eq(s, total)) {
+ lua_pushinteger(L, noad_total(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ }
+ }
+ break;
+ case delimiter_node:
+ if (lua_key_eq(s, smallfamily)) {
+ lua_pushinteger(L, delimiter_small_family(n));
+ } else if (lua_key_eq(s, smallchar)) {
+ lua_pushinteger(L, delimiter_small_character(n));
+ } else if (lua_key_eq(s, largefamily)) {
+ lua_pushinteger(L, delimiter_large_family(n));
+ } else if (lua_key_eq(s, largechar)) {
+ lua_pushinteger(L, delimiter_large_character(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ nodelib_push_direct_or_node_node_prev(L, direct, kernel_math_list(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case split_node:
+ if (lua_key_eq(s, index)) {
+ lua_push_integer(L, split_insert_index(n));
+ } else if (lua_key_eq(s, lastinsert)) {
+ nodelib_push_direct_or_node(L, direct, split_last_insert(n)); /* see comment */
+ } else if (lua_key_eq(s, bestinsert)) {
+ nodelib_push_direct_or_node(L, direct, split_best_insert(n)); /* see comment */
+ } else if (lua_key_eq(s, broken)) {
+ nodelib_push_direct_or_node(L, direct, split_broken(n));
+ } else if (lua_key_eq(s, brokeninsert)) {
+ nodelib_push_direct_or_node(L, direct, split_broken_insert(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case choice_node:
+ /*tex We could check and combine some here but who knows how things evolve. */
+ if (lua_key_eq(s, display)) {
+ nodelib_push_direct_or_node(L, direct, choice_display_mlist(n));
+ } else if (lua_key_eq(s, text)) {
+ nodelib_push_direct_or_node(L, direct, choice_text_mlist(n));
+ } else if (lua_key_eq(s, script)) {
+ nodelib_push_direct_or_node(L, direct, choice_script_mlist(n));
+ } else if (lua_key_eq(s, scriptscript)) {
+ nodelib_push_direct_or_node(L, direct, choice_script_script_mlist(n));
+ } else if (lua_key_eq(s, pre)) {
+ nodelib_push_direct_or_node(L, direct, choice_pre_break(n));
+ } else if (lua_key_eq(s, post)) {
+ nodelib_push_direct_or_node(L, direct, choice_post_break(n));
+ } else if (lua_key_eq(s, replace)) {
+ nodelib_push_direct_or_node(L, direct, choice_no_break(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case attribute_node:
+ switch (node_subtype(n)) {
+ case attribute_list_subtype:
+ if (lua_key_eq(s, count)) {
+ lua_pushinteger(L, attribute_count(n));
+ } else if (lua_key_eq(s, data)) {
+ nodelib_push_attribute_data(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case attribute_value_subtype:
+ if (lua_key_eq(s, index) || lua_key_eq(s, number)) {
+ lua_pushinteger(L, attribute_index(n));
+ } else if (lua_key_eq(s, value)) {
+ lua_pushinteger(L, attribute_value(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ break;
+ case adjust_node:
+ if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ nodelib_push_direct_or_node_node_prev(L, direct, adjust_list(n));
+ } else if (lua_key_eq(s, index) || lua_key_eq(s, class)) {
+ lua_pushinteger(L, adjust_index(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case unset_node:
+ if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, box_width(n));
+ } else if (lua_key_eq(s, height)) {
+ lua_pushinteger(L, box_height(n));
+ } else if (lua_key_eq(s, depth)) {
+ lua_pushinteger(L, box_depth(n));
+ } else if (lua_key_eq(s, total)) {
+ lua_pushinteger(L, box_total(n));
+ } else if (lua_key_eq(s, direction)) {
+ lua_pushinteger(L, checked_direction_value(box_dir(n)));
+ } else if (lua_key_eq(s, shrink)) {
+ lua_pushinteger(L, box_glue_shrink(n));
+ } else if (lua_key_eq(s, glueorder)) {
+ lua_pushinteger(L, box_glue_order(n));
+ } else if (lua_key_eq(s, gluesign)) {
+ lua_pushinteger(L, box_glue_sign(n));
+ } else if (lua_key_eq(s, stretch)) {
+ lua_pushinteger(L, box_glue_stretch(n));
+ } else if (lua_key_eq(s, count)) {
+ lua_pushinteger(L, box_span_count(n));
+ } else if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ nodelib_push_direct_or_node_node_prev(L, direct, box_list(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ /*
+ case attribute_list_node:
+ lua_pushnil(L);
+ break;
+ */
+ case boundary_node:
+ if (lua_key_eq(s, data) || lua_key_eq(s, value)) {
+ lua_pushinteger(L, boundary_data(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ case glue_spec_node:
+ if (lua_key_eq(s, width)) {
+ lua_pushinteger(L, glue_amount(n));
+ } else if (lua_key_eq(s, stretch)) {
+ lua_pushinteger(L, glue_stretch(n));
+ } else if (lua_key_eq(s, shrink)) {
+ lua_pushinteger(L, glue_shrink(n));
+ } else if (lua_key_eq(s, stretchorder)) {
+ lua_pushinteger(L, glue_stretch_order(n));
+ } else if (lua_key_eq(s, shrinkorder)) {
+ lua_pushinteger(L, glue_shrink_order(n));
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ }
+ break;
+ }
+ default:
+ {
+ lua_pushnil(L);
+ break;
+ }
+ }
+ return 1;
+}
+
+static int nodelib_direct_getfield(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ return nodelib_common_getfield(L, 1, n);
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_userdata_index(lua_State *L)
+{
+ halfword n = *((halfword *) lua_touserdata(L, 1));
+ if (n) {
+ return nodelib_common_getfield(L, 0, n);
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int nodelib_userdata_getfield(lua_State *L)
+{
+ halfword n = lmt_maybe_isnode(L, 1);
+ if (n) {
+ return nodelib_common_getfield(L, 0, n);
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+/* node.setfield */
+/* node.direct.setfield */
+
+/*
+ We used to check for glue_spec nodes in some places but if you do such a you have it coming
+ anyway.
+*/
+
+static int nodelib_common_setfield(lua_State *L, int direct, halfword n)
+{
+ switch (lua_type(L, 2)) {
+ case LUA_TNUMBER:
+ {
+ nodelib_setattribute_value(L, n, 2, 3);
+ break;
+ }
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, 2);
+ int t = node_type(n);
+ if (lua_key_eq(s, next)) {
+ if (tex_nodetype_has_next(t)) {
+ node_next(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ } else if (lua_key_eq(s, prev)) {
+ if (tex_nodetype_has_prev(t)) {
+ node_prev(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ } else if (lua_key_eq(s, attr)) {
+ if (tex_nodetype_has_attributes(t)) {
+ tex_attach_attribute_list_attribute(n, nodelib_direct_or_node_from_index(L, direct, 3));
+ } else {
+ goto CANTSET;
+ }
+ } else if (lua_key_eq(s, subtype)) {
+ if (tex_nodetype_has_subtype(t)) {
+ node_subtype(n) = lmt_toquarterword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ } else {
+ switch(t) {
+ case glyph_node:
+ if (lua_key_eq(s, font)) {
+ glyph_font(n) = tex_checked_font(lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, char)) {
+ glyph_character(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, xoffset)) {
+ glyph_x_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, yoffset)) {
+ glyph_y_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, scale)) {
+ glyph_scale(n) = (halfword) lmt_roundnumber(L, 3);
+ if (! glyph_scale(n)) {
+ glyph_scale(n) = 1000;
+ }
+ } else if (lua_key_eq(s, xscale)) {
+ glyph_x_scale(n) = (halfword) lmt_roundnumber(L, 3);
+ if (! glyph_x_scale(n)) {
+ glyph_x_scale(n) = 1000;
+ }
+ } else if (lua_key_eq(s, yscale)) {
+ glyph_y_scale(n) = (halfword) lmt_roundnumber(L, 3);
+ if (! glyph_y_scale(n)) {
+ glyph_y_scale(n) = 1000;
+ }
+ } else if (lua_key_eq(s, data)) {
+ glyph_data(n) = lmt_opthalfword(L, 3, unused_attribute_value);
+ } else if (lua_key_eq(s, expansion)) {
+ glyph_expansion(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, state)) {
+ set_glyph_state(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, script)) {
+ set_glyph_script(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, language)) {
+ set_glyph_language(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, left)) {
+ set_glyph_left(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, right)) {
+ set_glyph_right(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, lhmin)) {
+ set_glyph_lhmin(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, rhmin)) {
+ set_glyph_rhmin(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, uchyph)) {
+ set_glyph_uchyph(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, hyphenate)) {
+ set_glyph_hyphenate(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, options)) {
+ set_glyph_options(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, discpart)) {
+ set_glyph_discpart(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, protected)) {
+ glyph_protected(n) = lmt_tosingleword(L, 3);
+ } else if (lua_key_eq(s, width)) {
+ /* not yet */
+ } else if (lua_key_eq(s, height)) {
+ /* not yet */
+ } else if (lua_key_eq(s, depth)) {
+ /* not yet */
+ } else if (lua_key_eq(s, properties)) {
+ glyph_properties(n) = lmt_toquarterword(L, 3);
+ } else if (lua_key_eq(s, group)) {
+ glyph_group(n) = lmt_toquarterword(L, 3);
+ } else if (lua_key_eq(s, index)) {
+ glyph_index(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case hlist_node:
+ case vlist_node:
+ if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ box_list(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, width)) {
+ box_width(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, height)) {
+ box_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, depth)) {
+ box_depth(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, direction)) {
+ box_dir(n) = (singleword) nodelib_getdirection(L, 3);
+ } else if (lua_key_eq(s, shift)) {
+ box_shift_amount(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, glueorder)) {
+ box_glue_order(n) = tex_checked_glue_order(lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, gluesign)) {
+ box_glue_sign(n) = tex_checked_glue_sign(lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, glueset)) {
+ box_glue_set(n) = (glueratio) lua_tonumber(L, 3); /* integer or float */
+ } else if (lua_key_eq(s, geometry)) {
+ box_geometry(n) = (singleword) lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, orientation)) {
+ box_orientation(n) = lmt_tohalfword(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, anchor)) {
+ box_anchor(n) = lmt_tohalfword(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, source)) {
+ box_source_anchor(n) = lmt_tohalfword(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, target)) {
+ box_target_anchor(n) = lmt_tohalfword(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, xoffset)) {
+ box_x_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, yoffset)) {
+ box_y_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, woffset)) {
+ box_w_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, hoffset)) {
+ box_h_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, doffset)) {
+ box_d_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ tex_check_box_geometry(n);
+ } else if (lua_key_eq(s, pre)) {
+ box_pre_migrated(n) = nodelib_direct_or_node_from_index(L, direct, 3);;
+ } else if (lua_key_eq(s, post)) {
+ box_post_migrated(n) = nodelib_direct_or_node_from_index(L, direct, 3);;
+ } else if (lua_key_eq(s, state)) {
+ box_package_state(n) = (singleword) lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, index)) {
+ box_index(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case disc_node:
+ if (lua_key_eq(s, pre)) {
+ tex_set_disc_field(n, pre_break_code, nodelib_direct_or_node_from_index(L, direct, 3));
+ } else if (lua_key_eq(s, post)) {
+ tex_set_disc_field(n, post_break_code, nodelib_direct_or_node_from_index(L, direct, 3));
+ } else if (lua_key_eq(s, replace)) {
+ tex_set_disc_field(n, no_break_code, nodelib_direct_or_node_from_index(L, direct, 3));
+ } else if (lua_key_eq(s, penalty)) {
+ disc_penalty(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, options)) {
+ disc_options(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, class)) {
+ disc_class(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case glue_node:
+ if (lua_key_eq(s, width)) {
+ glue_amount(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, stretch)) {
+ glue_stretch(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, shrink)) {
+ glue_shrink(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, stretchorder)) {
+ glue_stretch_order(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, shrinkorder)) {
+ glue_shrink_order(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, leader)) {
+ glue_leader_ptr(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, font)) {
+ glue_font(n) = tex_checked_font(lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, data)) {
+ glue_data(n) = (halfword) lmt_roundnumber(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case kern_node:
+ if (lua_key_eq(s, kern)) {
+ kern_amount(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, expansion)) {
+ kern_expansion(n) = (halfword) lmt_roundnumber(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case penalty_node:
+ if (lua_key_eq(s, penalty)) {
+ penalty_amount(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case rule_node:
+ if (lua_key_eq(s, width)) {
+ rule_width(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, height)) {
+ rule_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, depth)) {
+ rule_depth(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, xoffset)) {
+ rule_x_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, yoffset)) {
+ rule_y_offset(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, left)) {
+ rule_left(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, right)) {
+ rule_right(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, data)) {
+ rule_data(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, font)) {
+ tex_set_rule_font(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, fam)) {
+ tex_set_rule_family(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, char)) {
+ rule_character(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case dir_node:
+ if (lua_key_eq(s, direction)) {
+ dir_direction(n) = nodelib_getdirection(L, 3);
+ } else if (lua_key_eq(s, level)) {
+ dir_level(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case whatsit_node:
+ return 0;
+ case par_node:
+ /* not all of them here */
+ if (lua_key_eq(s, interlinepenalty)) {
+ tex_set_local_interline_penalty(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, brokenpenalty)) {
+ tex_set_local_broken_penalty(n, lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, direction)) {
+ par_dir(n) = nodelib_getdirection(L, 3);
+ } else if (lua_key_eq(s, leftbox)) {
+ par_box_left(n) = nodelib_getlist(L, 3);
+ } else if (lua_key_eq(s, leftboxwidth)) {
+ tex_set_local_left_width(n, lmt_roundnumber(L, 3));
+ } else if (lua_key_eq(s, rightbox)) {
+ par_box_right(n) = nodelib_getlist(L, 3);
+ } else if (lua_key_eq(s, rightboxwidth)) {
+ tex_set_local_right_width(n, lmt_roundnumber(L, 3));
+ } else if (lua_key_eq(s, middlebox)) {
+ par_box_middle(n) = nodelib_getlist(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case math_char_node:
+ case math_text_char_node:
+ if (lua_key_eq(s, fam)) {
+ kernel_math_family(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, char)) {
+ kernel_math_character(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, options)) {
+ kernel_math_options(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, properties)) {
+ kernel_math_properties(n) = lmt_toquarterword(L, 3);
+ } else if (lua_key_eq(s, group)) {
+ kernel_math_group(n) = lmt_toquarterword(L, 3);
+ } else if (lua_key_eq(s, index)) {
+ kernel_math_index(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case mark_node:
+ if (lua_key_eq(s, index) || lua_key_eq(s, class)) {
+ halfword m = lmt_tohalfword(L, 3);
+ if (tex_valid_mark(m)) {
+ mark_index(n) = m;
+ }
+ } else if (lua_key_eq(s, data) || lua_key_eq(s, mark)) {
+ tex_delete_token_reference(mark_ptr(n));
+ mark_ptr(n) = lmt_token_list_from_lua(L, 3); /* check ref */
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case insert_node:
+ if (lua_key_eq(s, index)) {
+ halfword index = lmt_tohalfword(L, 3);
+ if (tex_valid_insert_id(index)) {
+ insert_index(n) = index;
+ }
+ } else if (lua_key_eq(s, cost)) {
+ insert_float_cost(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, depth)) {
+ insert_max_depth(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, height) || lua_key_eq(s, total)) {
+ insert_total_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ insert_list(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case math_node:
+ if (lua_key_eq(s, surround)) {
+ math_surround(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, width)) {
+ math_amount(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, stretch)) {
+ math_stretch(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, shrink)) {
+ math_shrink(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, stretchorder)) {
+ math_stretch_order(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, shrinkorder)) {
+ math_shrink_order(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, penalty)) {
+ math_penalty(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case style_node:
+ if (lua_key_eq(s, style)) {
+ style_style(n) = (quarterword) lmt_get_math_style(L, 2, text_style);
+ } else {
+ /* return nodelib_cantset(L, n, s); */
+ }
+ return 0;
+ case parameter_node:
+ if (lua_key_eq(s, style)) {
+ parameter_style(n) = (quarterword) lmt_get_math_style(L, 2, text_style);
+ } else if (lua_key_eq(s, name)) {
+ parameter_name(n) = lmt_get_math_parameter(L, 2, parameter_name(n));
+ } else if (lua_key_eq(s, value)) {
+ halfword code = parameter_name(n);
+ if (code < 0 || code >= math_parameter_last) {
+ /* error */
+ } else if (math_parameter_value_type(code)) {
+ /* todo, see tex_setmathparm */
+ } else {
+ parameter_value(n) = lmt_tohalfword(L, 3);
+ }
+ }
+ return 0;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ /* fence has less */
+ if (lua_key_eq(s, nucleus)) {
+ noad_nucleus(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, sub)) {
+ noad_subscr(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, sup)) {
+ noad_supscr(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, subpre)) {
+ noad_subprescr(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, suppre)) {
+ noad_supprescr(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, prime)) {
+ noad_prime(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, source)) {
+ noad_source(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, options)) {
+ noad_options(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, scriptorder)) {
+ noad_script_order(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, class)) {
+ halfword c = lmt_tohalfword(L, 3);
+ set_noad_main_class(n, c);
+ set_noad_left_class(n, lmt_opthalfword(L, 4, c));
+ set_noad_right_class(n, lmt_opthalfword(L, 5, c));
+ } else {
+ switch (t) {
+ case simple_noad:
+ // return nodelib_cantset(L, n, s);
+ break;
+ case radical_noad:
+ if (lua_key_eq(s, left) || lua_key_eq(s, delimiter)) {
+ radical_left_delimiter(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, right)) {
+ radical_right_delimiter(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, degree)) {
+ radical_degree(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, width)) {
+ noad_width(n) = lmt_roundnumber(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case fraction_noad:
+ if (lua_key_eq(s, width)) {
+ fraction_rule_thickness(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, numerator)) {
+ fraction_numerator(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, denominator)) {
+ fraction_denominator(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, left)) {
+ fraction_left_delimiter(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, right)) {
+ fraction_right_delimiter(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, middle)) {
+ fraction_middle_delimiter(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, fam)) {
+ set_noad_family(n, lmt_tohalfword(L, 3));
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case accent_noad:
+ if (lua_key_eq(s, top) || lua_key_eq(s, topaccent)) {
+ accent_top_character(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, bottom) || lua_key_eq(s, bottomaccent)) {
+ accent_bottom_character(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, middle) || lua_key_eq(s, overlayaccent)) {
+ accent_middle_character(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, fraction)) {
+ accent_fraction(n) = (halfword) lmt_roundnumber(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case fence_noad:
+ if (lua_key_eq(s, delimiter)) {
+ fence_delimiter_list(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, top)) {
+ fence_delimiter_top(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, bottom)) {
+ fence_delimiter_bottom(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, italic)) {
+ noad_italic(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, height)) {
+ noad_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, depth)) {
+ noad_depth(n) = (halfword) lmt_roundnumber(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ }
+ }
+ return 0;
+ case delimiter_node:
+ if (lua_key_eq(s, smallfamily)) {
+ delimiter_small_family(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, smallchar)) {
+ delimiter_small_character(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, largefamily)) {
+ delimiter_large_family(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, largechar)) {
+ delimiter_large_character(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case sub_box_node:
+ case sub_mlist_node:
+ if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ kernel_math_list(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case split_node: /* might go away */
+ if (lua_key_eq(s, index)) {
+ halfword index = lmt_tohalfword(L, 3);
+ if (tex_valid_insert_id(index)) {
+ split_insert_index(n) = index;
+ }
+ } else if (lua_key_eq(s, lastinsert)) {
+ split_last_insert(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, bestinsert)) {
+ split_best_insert(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, broken)) {
+ split_broken(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, brokeninsert)) {
+ split_broken_insert(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case choice_node:
+ if (lua_key_eq(s, display)) {
+ choice_display_mlist(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, text)) {
+ choice_text_mlist(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, script)) {
+ choice_script_mlist(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, scriptscript)) {
+ choice_script_script_mlist(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case attribute_node:
+ switch (node_subtype(n)) {
+ case attribute_list_subtype:
+ if (lua_key_eq(s, count)) {
+ attribute_count(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case attribute_value_subtype:
+ if (lua_key_eq(s, index) || lua_key_eq(s, number)) {
+ attribute_index(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, value)) {
+ attribute_value(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ default:
+ /* just ignored */
+ return 0;
+ }
+ break;
+ case adjust_node:
+ if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ adjust_list(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else if (lua_key_eq(s, index)) {
+ halfword index = lmt_tohalfword(L, 3);
+ if (tex_valid_adjust_index(index)) {
+ adjust_index(n) = index;
+ }
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case unset_node:
+ if (lua_key_eq(s, width)) {
+ box_width(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, height)) {
+ box_height(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, depth)) {
+ box_depth(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, direction)) {
+ box_dir(n) = (singleword) nodelib_getdirection(L, 3);
+ } else if (lua_key_eq(s, shrink)) {
+ box_glue_shrink(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, glueorder)) {
+ box_glue_order(n) = tex_checked_glue_order(lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, gluesign)) {
+ box_glue_sign(n) = tex_checked_glue_sign(lmt_tohalfword(L, 3));
+ } else if (lua_key_eq(s, stretch)) {
+ box_glue_stretch(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, count)) {
+ box_span_count(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, list) || lua_key_eq(s, head)) {
+ box_list(n) = nodelib_direct_or_node_from_index(L, direct, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case boundary_node:
+ if (lua_key_eq(s, value)) {
+ boundary_data(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ case glue_spec_node:
+ if (lua_key_eq(s, width)) {
+ glue_amount(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, stretch)) {
+ glue_stretch(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, shrink)) {
+ glue_shrink(n) = (halfword) lmt_roundnumber(L, 3);
+ } else if (lua_key_eq(s, stretchorder)) {
+ glue_stretch_order(n) = lmt_tohalfword(L, 3);
+ } else if (lua_key_eq(s, shrinkorder)) {
+ glue_shrink_order(n) = lmt_tohalfword(L, 3);
+ } else {
+ goto CANTSET;
+ }
+ return 0;
+ default:
+ return luaL_error(L, "you can't assign to a %s node (%d)\n", lmt_interface.node_data[t].name, n);
+ }
+ CANTSET:
+ return luaL_error(L,"you can't set field %s in a %s node (%d)", s, lmt_interface.node_data[t].name, n);
+ }
+ return 0;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_setfield(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_common_setfield(L, 1, n);
+ }
+ return 0;
+}
+
+static int nodelib_userdata_newindex(lua_State *L)
+{
+ halfword n = *((halfword *) lua_touserdata(L, 1));
+ if (n) {
+ nodelib_common_setfield(L, 0, n);
+ }
+ return 0;
+}
+
+static int nodelib_userdata_setfield(lua_State *L)
+{
+ halfword n = lmt_maybe_isnode(L, 1);
+ if (n) {
+ nodelib_common_setfield(L, 0, n);
+ }
+ return 0;
+}
+
+/* tex serializing */
+
+static int verbose = 1; /* This might become an option (then move this in a state)! */
+
+static void nodelib_tostring(lua_State *L, halfword n, const char *tag)
+{
+ char msg[256];
+ char a[7] = { ' ', ' ', ' ', 'n', 'i', 'l', 0 };
+ char v[7] = { ' ', ' ', ' ', 'n', 'i', 'l', 0 };
+ halfword t = node_type(n);
+ halfword s = node_subtype(n);
+ node_info nd = lmt_interface.node_data[t];
+ if (tex_nodetype_has_prev(t) && node_prev(n)) {
+ snprintf(a, 7, "%6d", (int) node_prev(n));
+ }
+ if (node_next(n)) {
+ snprintf(v, 7, "%6d", (int) node_next(n));
+ }
+ if (t == whatsit_node) {
+ snprintf(msg, 255, "<%s : %s < %6d > %s : %s %d>", tag, a, (int) n, v, nd.name, s);
+ } else if (! tex_nodetype_has_subtype(n)) {
+ snprintf(msg, 255, "<%s : %s < %6d > %s : %s>", tag, a, (int) n, v, nd.name);
+ } else if (verbose) {
+ /*tex Sloooow! But subtype lists can have holes. */
+ value_info *sd = nd.subtypes;
+ int j = -1;
+ if (sd) {
+ // if (t == glyph_node) {
+ // s = tex_subtype_of_glyph(n);
+ // }
+ if (s >= nd.first && s <= nd.last) {
+ for (int i = 0; ; i++) {
+ if (sd[i].id == s) {
+ j = i;
+ break ;
+ } else if (sd[i].id < 0) {
+ break;
+ }
+ }
+ }
+ }
+ if (j < 0) {
+ snprintf(msg, 255, "<%s : %s <= %6d => %s : %s %d>", tag, a, (int) n, v, nd.name, s);
+ } else {
+ snprintf(msg, 255, "<%s : %s <= %6d => %s : %s %s>", tag, a, (int) n, v, nd.name, sd[j].name);
+ }
+ } else {
+ snprintf(msg, 255, "<%s : %s < %6d > %s : %s %d>", tag, a, (int) n, v, nd.name, s);
+ }
+ lua_pushstring(L, (const char *) msg);
+}
+
+/* __tostring node.tostring */
+
+static int nodelib_userdata_tostring(lua_State *L)
+{
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ nodelib_tostring(L, n, lua_key(node));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.tostring */
+
+static int nodelib_direct_tostring(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_tostring(L, n, lua_key(direct));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* __eq */
+
+static int nodelib_userdata_equal(lua_State *L)
+{
+ halfword n = *((halfword *) lua_touserdata(L, 1));
+ halfword m = *((halfword *) lua_touserdata(L, 2));
+ lua_pushboolean(L, (n == m));
+ return 1;
+}
+
+/* node.ligaturing */
+
+static int nodelib_direct_ligaturing(lua_State *L)
+{
+ if (lua_gettop(L) >= 1) {
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ halfword t = nodelib_valid_direct_from_index(L, 2);
+ if (h) {
+ halfword tmp_head = tex_new_node(nesting_node, unset_nesting_code);
+ halfword p = node_prev(h);
+ tex_couple_nodes(tmp_head, h);
+ node_tail(tmp_head) = t;
+ t = tex_handle_ligaturing(tmp_head, t);
+ if (p) {
+ node_next(p) = node_next(tmp_head) ;
+ }
+ node_prev(node_next(tmp_head)) = p ;
+ lua_pushinteger(L, node_next(tmp_head));
+ lua_pushinteger(L, t);
+ lua_pushboolean(L, 1);
+ tex_flush_node(tmp_head);
+ return 3;
+ }
+ }
+ lua_pushnil(L);
+ lua_pushboolean(L, 0);
+ return 2;
+}
+
+/* node.kerning */
+
+static int nodelib_direct_kerning(lua_State *L)
+{
+ if (lua_gettop(L) >= 1) {
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ halfword t = nodelib_valid_direct_from_index(L, 2);
+ if (h) {
+ halfword tmp_head = tex_new_node(nesting_node, unset_nesting_code);
+ halfword p = node_prev(h);
+ tex_couple_nodes(tmp_head, h);
+ node_tail(tmp_head) = t;
+ t = tex_handle_kerning(tmp_head, t);
+ if (p) {
+ node_next(p) = node_next(tmp_head) ;
+ }
+ node_prev(node_next(tmp_head)) = p ;
+ lua_pushinteger(L, node_next(tmp_head));
+ if (t) {
+ lua_pushinteger(L, t);
+ } else {
+ lua_pushnil(L);
+ }
+ lua_pushboolean(L, 1);
+ tex_flush_node(tmp_head);
+ return 3;
+ }
+ }
+ lua_pushnil(L);
+ lua_pushboolean(L, 0);
+ return 2;
+}
+
+/*tex
+ It's more consistent to have it here (so we will alias in lang later). Todo: if no glyph then
+ quit.
+*/
+
+static int nodelib_direct_hyphenating(lua_State *L)
+{
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ halfword t = nodelib_valid_direct_from_index(L, 2);
+ if (h) {
+ if (! t) {
+ t = h;
+ while (node_next(t)) {
+ t = node_next(t);
+ }
+ }
+ tex_hyphenate_list(h, t); /* todo: grab new tail */
+ } else {
+ /*tex We could consider setting |h| and |t| to |null|. */
+ }
+ lua_pushinteger(L, h);
+ lua_pushinteger(L, t);
+ lua_pushboolean(L, 1);
+ return 3;
+}
+
+static int nodelib_direct_collapsing(lua_State *L)
+{
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ if (h) {
+ halfword c1 = lmt_optinteger(L, 2, ex_hyphen_char_par);
+ halfword c2 = lmt_optinteger(L, 3, 0x2013);
+ halfword c3 = lmt_optinteger(L, 4, 0x2014);
+ tex_collapse_list(h, c1, c2, c3);
+ }
+ lua_pushinteger(L, h);
+ return 1;
+}
+
+/* node.protect_glyphs */
+/* node.unprotect_glyphs */
+
+inline static void nodelib_aux_protect_all(halfword h)
+{
+ while (h) {
+ if (node_type(h) == glyph_node) {
+ glyph_protected(h) = glyph_protected_text_code;
+ }
+ h = node_next(h);
+ }
+}
+inline static void nodelib_aux_unprotect_all(halfword h)
+{
+ while (h) {
+ if (node_type(h) == glyph_node) {
+ glyph_protected(h) = glyph_unprotected_code;
+ }
+ h = node_next(h);
+ }
+}
+
+inline static void nodelib_aux_protect_node(halfword n)
+{
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_protected(n) = glyph_protected_text_code;
+ break;
+ case disc_node:
+ nodelib_aux_protect_all(disc_no_break_head(n));
+ nodelib_aux_protect_all(disc_pre_break_head(n));
+ nodelib_aux_protect_all(disc_post_break_head(n));
+ break;
+ }
+}
+
+inline static void nodelib_aux_unprotect_node(halfword n)
+{
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_protected(n) = glyph_unprotected_code;
+ break;
+ case disc_node:
+ nodelib_aux_unprotect_all(disc_no_break_head(n));
+ nodelib_aux_unprotect_all(disc_pre_break_head(n));
+ nodelib_aux_unprotect_all(disc_post_break_head(n));
+ break;
+ }
+}
+
+/* node.direct.protect_glyphs */
+/* node.direct.unprotect_glyphs */
+
+static int nodelib_direct_protectglyph(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_aux_protect_node(n);
+ }
+ return 0;
+}
+
+static int nodelib_direct_unprotectglyph(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_aux_unprotect_node(n);
+ }
+ return 0;
+}
+
+static int nodelib_direct_protectglyphs(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ halfword tail = nodelib_valid_direct_from_index(L, 2);
+ if (head) {
+ while (head) {
+ nodelib_aux_protect_node(head);
+ if (head == tail) {
+ break;
+ } else {
+ head = node_next(head);
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_unprotectglyphs(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ halfword tail = nodelib_valid_direct_from_index(L, 2);
+ if (head) {
+ while (head) {
+ nodelib_aux_unprotect_node(head);
+ if (head == tail) {
+ break;
+ } else {
+ head = node_next(head);
+ }
+ }
+ }
+ return 0;
+}
+
+/* node.direct.first_glyph */
+
+static int nodelib_direct_firstglyph(lua_State *L)
+{
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ halfword t = nodelib_valid_direct_from_index(L, 2);
+ if (h) {
+ halfword savetail = null;
+ if (t) {
+ savetail = node_next(t);
+ node_next(t) = null;
+ }
+ /*tex
+ We go to the first unprocessed character so that is one with a value <= 0xFF and we
+ don't care about what the value is.
+ */
+ while (h && (node_type(h) != glyph_node || glyph_protected(h))) {
+ h = node_next(h);
+ }
+ if (savetail) {
+ node_next(t) = savetail;
+ }
+ lua_pushinteger(L, h);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.find_node(head) : node, subtype*/
+/* node.direct.find_node(head,subtype) : node */
+
+static int nodelib_direct_findnode(lua_State *L)
+{
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ if (h) {
+ halfword t = lmt_tohalfword(L, 2);
+ if (lua_gettop(L) > 2) {
+ halfword s = lmt_tohalfword(L, 3);
+ while (h) {
+ if (node_type(h) == t && node_subtype(h) == s) {
+ lua_pushinteger(L, h);
+ return 1;
+ } else {
+ h = node_next(h);
+ }
+ }
+ } else {
+ while (h) {
+ if (node_type(h) == t) {
+ lua_pushinteger(L, h);
+ lua_pushinteger(L, node_subtype(h));
+ return 2;
+ } else {
+ h = node_next(h);
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.direct.has_glyph */
+
+static int nodelib_direct_hasglyph(lua_State *L)
+{
+ halfword h = nodelib_valid_direct_from_index(L, 1);
+ while (h) {
+ switch (node_type(h)) {
+ case glyph_node:
+ case disc_node:
+ nodelib_push_direct_or_nil(L, h);
+ return 1;
+ default:
+ h = node_next(h);
+ break;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/* node.getword */
+
+static inline int nodelib_aux_in_word(halfword n)
+{
+ switch (node_type(n)) {
+ case glyph_node:
+ case disc_node:
+ return 1;
+ case kern_node:
+ return node_subtype(n) == font_kern_subtype;
+ default:
+ return 0;
+ }
+}
+
+static int nodelib_direct_getwordrange(lua_State *L)
+{
+ halfword m = nodelib_valid_direct_from_index(L, 1);
+ if (m) {
+ /*tex We don't check on type if |m|. */
+ halfword l = m;
+ halfword r = m;
+ while (node_prev(l) && nodelib_aux_in_word(node_prev(l))) {
+ l = node_prev(l);
+ }
+ while (node_next(r) && nodelib_aux_in_word(node_next(r))) {
+ r = node_next(r);
+ }
+ nodelib_push_direct_or_nil(L, l);
+ nodelib_push_direct_or_nil(L, r);
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+/* node.inuse */
+
+static int nodelib_userdata_inuse(lua_State *L)
+{
+ int counts[max_node_type + 1] = { 0 };
+ int n = tex_n_of_used_nodes(&counts[0]);
+ lua_createtable(L, 0, max_node_type);
+ for (int i = 0; i < max_node_type; i++) {
+ if (counts[i]) {
+ lua_pushstring(L, lmt_interface.node_data[i].name);
+ lua_pushinteger(L, counts[i]);
+ lua_rawset(L, -3);
+ }
+ }
+ lua_pushinteger(L, n);
+ return 2;
+}
+
+/*tex A bit of a cheat: some nodes can turn into another one due to the same size. */
+
+static int nodelib_userdata_instock(lua_State *L)
+{
+ int counts[max_node_type + 1] = { 0 };
+ int n = 0;
+ lua_createtable(L, 0, max_node_type);
+ for (int i = 1; i < max_chain_size; i++) {
+ halfword p = lmt_node_memory_state.free_chain[i];
+ while (p) {
+ if (node_type(p) <= max_node_type) {
+ ++counts[node_type(p)];
+ }
+ p = node_next(p);
+ }
+ }
+ for (int i = 0; i < max_node_type; i++) {
+ if (counts[i]) {
+ lua_pushstring(L, lmt_interface.node_data[i].name);
+ lua_pushinteger(L, counts[i]);
+ lua_rawset(L, -3);
+ n += counts[i];
+ }
+ }
+ lua_pushinteger(L, n);
+ return 2;
+}
+
+
+/* node.usedlist */
+
+static int nodelib_userdata_usedlist(lua_State *L)
+{
+ lmt_push_node_fast(L, tex_list_node_mem_usage());
+ return 1;
+}
+
+/* node.direct.usedlist */
+
+static int nodelib_direct_usedlist(lua_State *L)
+{
+ lua_pushinteger(L, tex_list_node_mem_usage());
+ return 1;
+}
+
+/* node.direct.protrusionskipable(node m) */
+
+static int nodelib_direct_protrusionskipable(lua_State *L)
+{
+ halfword n = lmt_tohalfword(L, 1);
+ if (n) {
+ lua_pushboolean(L, tex_protrusion_skipable(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.currentattributes(node m) */
+
+static int nodelib_userdata_currentattributes(lua_State* L)
+{
+ halfword n = tex_current_attribute_list();
+ if (n) {
+ lmt_push_node_fast(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.currentattributes(node m) */
+
+static int nodelib_direct_currentattributes(lua_State* L)
+{
+ halfword n = tex_current_attribute_list();
+ if (n) {
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.todirect */
+
+static int nodelib_direct_todirect(lua_State* L)
+{
+ if (lua_type(L, 1) != LUA_TNUMBER) {
+ /* assume node, no further testing, used in known situations */
+ void* n = lua_touserdata(L, 1);
+ if (n) {
+ lua_pushinteger(L, *((halfword*)n));
+ }
+ else {
+ lua_pushnil(L);
+ }
+ } /* else assume direct and returns argument */
+ return 1;
+}
+
+static int nodelib_direct_tovaliddirect(lua_State* L)
+{
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ lua_pushinteger(L, n);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* node.direct.tonode */
+
+static int nodelib_direct_tonode(lua_State* L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword* a = (halfword*) lua_newuserdatauv(L, sizeof(halfword), 0);
+ *a = n;
+ lua_get_metatablelua(node_instance);
+ lua_setmetatable(L, -2);
+ } /* else assume node and return argument */
+ return 1;
+}
+
+/* direct.ischar */
+/* direct.isglyph */
+
+/*tex
+
+ This can save a lookup call, but although there is a little benefit it doesn't pay of in the end
+ as we have to simulate it in \MKIV.
+
+ \starttyping
+ if (glyph_data(n) != unused_attribute_value) {
+ lua_pushinteger(L, glyph_data(n));
+ return 2;
+ }
+ \stoptyping
+
+ possible return values:
+
+ \starttyping
+ <nil when no node>
+ <nil when no glyph> <id of node>
+ <false when glyph and already marked as done or when not>
+ <character code when font matches or when no font passed>
+ \stoptyping
+
+ data : when checked should be equal, false or nil is zero
+ state : when checked should be equal, unless false or zero
+
+*/
+
+static int nodelib_direct_check_char(lua_State* L, halfword n)
+{
+ if (! glyph_protected(n)) {
+ halfword b = 0;
+ halfword f = (halfword) lua_tointegerx(L, 2, &b);
+ if (! b) {
+ goto OKAY;
+ } else if (f == glyph_font(n)) {
+ switch (lua_gettop(L)) {
+ case 2:
+ /* (node,font) */
+ goto OKAY;
+ case 3:
+ /* (node,font,data) */
+ if ((halfword) lua_tointegerx(L, 3, NULL) == glyph_data(n)) {
+ goto OKAY;
+ } else {
+ break;
+ }
+ case 4:
+ /* (node,font,data,state) */
+ if ((halfword) lua_tointegerx(L, 3, NULL) == glyph_data(n)) {
+ halfword state = (halfword) lua_tointegerx(L, 4, NULL);
+ if (! state || state == glyph_state(n)) {
+ goto OKAY;
+ } else {
+ break;
+ }
+ } else {
+ break;
+ }
+ case 5:
+ /* (node,font,data,scale,xscale,yscale) */
+ if (lua_tointeger(L, 3) == glyph_scale(n) && lua_tointeger(L, 4) == glyph_x_scale(n) && lua_tointeger(L, 5) == glyph_y_scale(n)) {
+ goto OKAY;
+ } else {
+ break;
+ }
+ case 6:
+ /* (node,font,data,scale,xscale,yscale) */
+ if (lua_tointegerx(L, 3, NULL) == glyph_data(n) && lua_tointeger(L, 4) == glyph_scale(n) && lua_tointeger(L, 5) == glyph_x_scale(n) && lua_tointeger(L, 6) == glyph_y_scale(n)) {
+ goto OKAY;
+ } else {
+ break;
+ }
+ /* case 7: */
+ /* (node,font,data,scale,scale,xscale,yscale)*/
+ }
+ }
+ }
+ return -1;
+ OKAY:
+ return glyph_character(n);
+}
+
+static int nodelib_direct_ischar(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (node_type(n) != glyph_node) {
+ lua_pushnil(L);
+ lua_pushinteger(L, node_type(n));
+ return 2;
+ } else {
+ halfword chr = nodelib_direct_check_char(L, n);
+ if (chr >= 0) {
+ lua_pushinteger(L, chr);
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+ }
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+/*
+ This one is kind of special and is a way to quickly test what we are at now and what is
+ coming. It saves some extra calls but has a rather hybrid set of return values, depending
+ on the situation:
+
+ \starttyping
+ isnextchar(n,[font],[data],[state],[scale,xscale,yscale])
+ isprevchar(n,[font],[data],[state],[scale,xscale,yscale])
+
+ glyph : nil | next false | next char | next char nextchar
+ otherwise : nil | next false id
+ \stoptyping
+
+ Beware: it is not always measurable faster than multiple calls but it can make code look a
+ bit better (at least in \CONTEXT\ where we can use it a few times). There are more such
+ hybrid helpers where the return value depends on the node type.
+
+ The second glyph is okay when the most meaningful properties are the same. We assume that
+ states can differ so we don't check for that. One of the few assumptions when using
+ \CONTEXT.
+
+*/
+
+inline static int nodelib_aux_similar_glyph(halfword first, halfword second)
+{
+ return
+ node_type(second) == glyph_node
+ && glyph_font(second) == glyph_font(first)
+ && glyph_data(second) == glyph_data(first)
+ /* && glyph_state(second) == glyph_state(first) */
+ && glyph_scale(second) == glyph_scale(first)
+ && glyph_x_scale(second) == glyph_x_scale(first)
+ && glyph_y_scale(second) == glyph_y_scale(first)
+ ;
+}
+
+static int nodelib_direct_isnextchar(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ /* beware, don't mix push and pop */
+ halfword nxt = node_next(n);
+ if (node_type(n) != glyph_node) {
+ nodelib_push_direct_or_nil(L, nxt);
+ lua_pushnil(L);
+ lua_pushinteger(L, node_type(n));
+ return 3;
+ } else {
+ halfword chr = nodelib_direct_check_char(L, n);
+ nodelib_push_direct_or_nil(L, nxt);
+ if (chr >= 0) {
+ lua_pushinteger(L, chr);
+ if (nxt && nodelib_aux_similar_glyph(n, nxt)) {
+ lua_pushinteger(L, glyph_character(nxt));
+ return 3;
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 2;
+ }
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_isprevchar(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ /* beware, don't mix push and pop */
+ halfword prv = node_prev(n);
+ if (node_type(n) != glyph_node) {
+ nodelib_push_direct_or_nil(L, prv);
+ lua_pushnil(L);
+ lua_pushinteger(L, node_type(n));
+ return 3;
+ } else {
+ halfword chr = nodelib_direct_check_char(L, n);
+ nodelib_push_direct_or_nil(L, prv);
+ if (chr >= 0) {
+ lua_pushinteger(L, chr);
+ if (prv && nodelib_aux_similar_glyph(n, prv)) {
+ lua_pushinteger(L, glyph_character(prv));
+ return 3;
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 2;
+ }
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_isglyph(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ if (node_type(n) != glyph_node) {
+ lua_pushboolean(L, 0);
+ lua_pushinteger(L, node_type(n));
+ } else {
+ /* protected as well as unprotected */
+ lua_pushinteger(L, glyph_character(n));
+ lua_pushinteger(L, glyph_font(n));
+ }
+ } else {
+ lua_pushnil(L); /* no glyph at all */
+ lua_pushnil(L); /* no glyph at all */
+ }
+ return 2;
+}
+
+static int nodelib_direct_isnextglyph(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_push_direct_or_nil(L, node_next(n));
+ if (node_type(n) != glyph_node) {
+ lua_pushboolean(L, 0);
+ lua_pushinteger(L, node_type(n));
+ } else {
+ /* protected as well as unprotected */
+ lua_pushinteger(L, glyph_character(n));
+ lua_pushinteger(L, glyph_font(n));
+ }
+ return 3;
+ } else {
+ return 0;
+ }
+}
+
+static int nodelib_direct_isprevglyph(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ nodelib_push_direct_or_nil(L, node_prev(n));
+ if (node_type(n) != glyph_node) {
+ lua_pushboolean(L, 0);
+ lua_pushinteger(L, node_type(n));
+ } else {
+ /* protected as well as unprotected */
+ lua_pushinteger(L, glyph_character(n));
+ lua_pushinteger(L, glyph_font(n));
+ }
+ return 3;
+ } else {
+ return 0;
+ }
+}
+
+
+/* direct.usesfont */
+
+inline static int nodelib_aux_uses_font_disc(lua_State *L, halfword n, halfword font)
+{
+ while (n) {
+ if ((node_type(n) == glyph_node) && (glyph_font(n) == font)) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ n = node_next(n);
+ }
+ return 0;
+}
+
+static int nodelib_direct_usesfont(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ halfword f = lmt_tohalfword(L, 2);
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushboolean(L, glyph_font(n) == f);
+ return 1;
+ case disc_node:
+ if (nodelib_aux_uses_font_disc(L, disc_pre_break_head(n), f)) {
+ return 1;
+ } else if (nodelib_aux_uses_font_disc(L, disc_post_break_head(n), f)) {
+ return 1;
+ } else if (nodelib_aux_uses_font_disc(L, disc_no_break_head(n), f)) {
+ return 1;
+ }
+ /*
+ {
+ halfword c = disc_pre_break_head(n);
+ while (c) {
+ if (type(c) == glyph_node && font(c) == f) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ c = node_next(c);
+ }
+ c = disc_post_break_head(n);
+ while (c) {
+ if (type(c) == glyph_node && font(c) == f) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ c = node_next(c);
+ }
+ c = disc_no_break_head(n);
+ while (c) {
+ if (type(c) == glyph_node && font(c) == f) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ c = node_next(c);
+ }
+ }
+ */
+ break;
+ /* todo: other node types */
+ }
+ }
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+/* boxes */
+
+/* node.getbox = tex.getbox */
+/* node.setbox = tex.setbox */
+
+/* node.direct.getbox */
+/* node.direct.setbox */
+
+static int nodelib_direct_getbox(lua_State *L)
+{
+ int id = lmt_get_box_id(L, 1, 1);
+ if (id >= 0) {
+ int t = tex_get_tex_box_register(id, 0);
+ if (t) {
+ lua_pushinteger(L, t);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int nodelib_direct_setbox(lua_State *L)
+{
+ int flags = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int id = lmt_get_box_id(L, slot++, 1);
+ if (id >= 0) {
+ int n;
+ switch (lua_type(L, slot)) {
+ case LUA_TBOOLEAN:
+ {
+ n = lua_toboolean(L, slot);
+ if (n == 0) {
+ n = null;
+ } else {
+ return 0;
+ }
+ }
+ break;
+ case LUA_TNIL:
+ n = null;
+ break;
+ default:
+ {
+ n = nodelib_valid_direct_from_index(L, slot);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ break;
+ default:
+ /*tex Alternatively we could |hpack|. */
+ return luaL_error(L, "setbox: incompatible node type (%s)\n",get_node_name(node_type(n)));
+ }
+ }
+ }
+ break;
+ }
+ tex_set_tex_box_register(id, n, flags, 0);
+ }
+ return 0;
+}
+
+/* node.isnode(n) */
+
+static int nodelib_userdata_isnode(lua_State *L)
+{
+ halfword n = lmt_maybe_isnode(L, 1);
+ if (n) {
+ lua_pushinteger (L, n);
+ } else {
+ lua_pushboolean (L, 0);
+ }
+ return 1;
+}
+
+/* node.direct.isdirect(n) (handy for mixed usage testing) */
+
+static int nodelib_direct_isdirect(lua_State *L)
+{
+ if (lua_type(L, 1) != LUA_TNUMBER) {
+ lua_pushboolean(L, 0); /* maybe valid test too */
+ }
+ /* else return direct */
+ return 1;
+}
+
+/* node.direct.isnode(n) (handy for mixed usage testing) */
+
+static int nodelib_direct_isnode(lua_State *L)
+{
+ if (! lmt_maybe_isnode(L, 1)) {
+ lua_pushboolean(L, 0);
+ } else {
+ /*tex Assume and return node. */
+ }
+ return 1;
+}
+
+/*tex Maybe we should allocate a proper index |0 .. var_mem_max| but not now. */
+
+static int nodelib_userdata_getproperty(lua_State *L)
+{ /* <node> */
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ lua_rawgeti(L, -1, n); /* actually it is a hash */
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_direct_getproperty(lua_State *L)
+{ /* <direct> */
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ lua_rawgeti(L, -1, n); /* actually it is a hash */
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_userdata_setproperty(lua_State *L)
+{
+ /* <node> <value> */
+ halfword n = lmt_check_isnode(L, 1);
+ if (n) {
+ lua_settop(L, 2);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ /* <node> <value> <propertytable> */
+ lua_replace(L, -3);
+ /* <propertytable> <value> */
+ lua_rawseti(L, -2, n); /* actually it is a hash */
+ }
+ return 0;
+}
+
+static int nodelib_direct_setproperty(lua_State *L)
+{
+ /* <direct> <value> */
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ lua_settop(L, 2);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ /* <node> <value> <propertytable> */
+ lua_replace(L, 1);
+ /* <propertytable> <value> */
+ lua_rawseti(L, 1, n); /* actually it is a hash */
+ }
+ return 0;
+}
+
+/*tex
+
+ These two getters are kind of tricky as they can mess up the otherwise hidden table. But
+ normally these are under control of the macro package so we can control it somewhat.
+
+*/
+
+static int nodelib_direct_getpropertiestable(lua_State *L)
+{ /* <node|direct> */
+ if (lua_toboolean(L, lua_gettop(L))) {
+ /*tex Beware: this can have side effects when used without care. */
+ lmt_initialize_properties(1);
+ }
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ return 1;
+}
+
+static int nodelib_userdata_getpropertiestable(lua_State *L)
+{ /* <node|direct> */
+ lua_get_metatablelua(node_properties_indirect);
+ return 1;
+}
+
+/* extra helpers */
+
+static void nodelib_direct_effect_done(lua_State *L, halfword amount, halfword stretch, halfword shrink, halfword stretch_order, halfword shrink_order)
+{
+ halfword parent = nodelib_valid_direct_from_index(L, 2);
+ if (parent) {
+ halfword sign = box_glue_sign(parent);
+ if (sign != normal_glue_sign) {
+ switch (node_type(parent)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ double w = (double) amount;
+ switch (sign) {
+ case stretching_glue_sign:
+ if (stretch_order == box_glue_order(parent)) {
+ w += stretch * (double) box_glue_set(parent);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (shrink_order == box_glue_order(parent)) {
+ w -= shrink * (double) box_glue_set(parent);
+ }
+ break;
+ }
+ if (lua_toboolean(L, 3)) {
+ lua_pushinteger(L, lmt_roundedfloat(w));
+ } else {
+ lua_pushnumber(L, w);
+ }
+ return;
+ }
+ }
+ }
+ }
+ lua_pushinteger(L, amount);
+}
+
+static int nodelib_direct_effectiveglue(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glue_node:
+ nodelib_direct_effect_done(L, glue_amount(n), glue_stretch(n), glue_shrink(n),glue_stretch_order(n), glue_shrink_order(n));
+ break;
+ case math_node:
+ if (math_surround(n)) {
+ lua_pushinteger(L, math_surround(n));
+ } else {
+ nodelib_direct_effect_done(L, math_amount(n), math_stretch(n), math_shrink(n), math_stretch_order(n), math_shrink_order(n));
+ }
+ break;
+ default:
+ lua_pushinteger(L, 0);
+ break;
+ }
+ } else {
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+/*tex
+
+ Disc nodes are kind of special in the sense that their head is not the head as we see it, but
+ a special node that has status info of which head and tail are part. Normally when proper
+ set/get functions are used this status node is all right but if a macro package permits
+ arbitrary messing around, then it can at some point call the following cleaner, just before
+ linebreaking kicks in. This one is not called automatically because if significantly slows down
+ the line break routing.
+
+*/
+
+static int nodelib_direct_checkdiscretionaries(lua_State *L) {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ while (n) {
+ if (node_type(n) == disc_node) {
+ tex_check_disc_field(n);
+ }
+ n = node_next(n) ;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_checkdiscretionary(lua_State *L) {
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == disc_node) {
+ halfword p = disc_pre_break_head(n);
+ disc_pre_break_tail(n) = p ? tex_tail_of_node_list(p) : null;
+ p = disc_post_break_head(n);
+ disc_post_break_tail(n) = p ? tex_tail_of_node_list(p) : null;
+ p = disc_no_break_head(n);
+ disc_no_break_tail(n) = p ? tex_tail_of_node_list(p) : null;
+ }
+ return 0;
+}
+
+static int nodelib_direct_flattendiscretionaries(lua_State *L)
+{
+ int count = 0;
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ if (head) {
+ head = tex_flatten_discretionaries(head, &count, lua_toboolean(L, 2)); /* nest */
+ } else {
+ head = null;
+ }
+ nodelib_push_direct_or_nil(L, head);
+ lua_pushinteger(L, count);
+ return 2;
+}
+
+static int nodelib_direct_softenhyphens(lua_State *L)
+{
+ int found = 0;
+ int replaced = 0;
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ if (head) {
+ tex_soften_hyphens(head, &found, &replaced);
+ }
+ nodelib_push_direct_or_nil(L, head);
+ lua_pushinteger(L, found);
+ lua_pushinteger(L, replaced);
+ return 3;
+}
+
+/*tex The fields related to input tracking: */
+
+static int nodelib_direct_setinputfields(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ /* there is no need to test for tag and line as two arguments are mandate */
+ halfword tag = lmt_tohalfword(L, 2);
+ halfword line = lmt_tohalfword(L, 3);
+ switch (node_type(n)) {
+ case glyph_node:
+ glyph_input_file(n) = tag;
+ glyph_input_line(n) = line;
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ box_input_file(n) = tag;
+ box_input_line(n) = line;
+ break;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_getinputfields(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ switch (node_type(n)) {
+ case glyph_node:
+ lua_pushinteger(L, glyph_input_file(n));
+ lua_pushinteger(L, glyph_input_line(n));
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ lua_pushinteger(L, box_input_file(n));
+ lua_pushinteger(L, box_input_line(n));
+ break;
+ default:
+ return 0;
+ }
+ return 2;
+ }
+ return 0;
+}
+
+static int nodelib_direct_makeextensible(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 3) {
+ halfword fnt = lmt_tohalfword(L, 1);
+ halfword chr = lmt_tohalfword(L, 2);
+ halfword target = lmt_tohalfword(L, 3);
+ halfword size = lmt_opthalfword(L, 4, 0);
+ halfword overlap = lmt_opthalfword(L, 5, 65536);
+ halfword attlist = null;
+ halfword b = null;
+ int horizontal = 0;
+ if (top >= 4) {
+ overlap = lmt_tohalfword(L, 4);
+ if (top >= 5) {
+ horizontal = lua_toboolean(L, 5);
+ if (top >= 6) {
+ attlist = nodelib_valid_direct_from_index(L, 6);
+ }
+ }
+ }
+ b = tex_make_extensible(fnt, chr, target, overlap, horizontal, attlist, size);
+ lua_pushinteger(L, b);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/*tex experiment */
+
+static int nodelib_direct_flattenleaders(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ int count = 0;
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ tex_flatten_leaders(n, &count);
+ break;
+ }
+ }
+ lua_pushinteger(L, count);
+ return 1;
+}
+
+/*tex test */
+
+static int nodelib_direct_isvalid(lua_State *L)
+{
+ lua_pushboolean(L, nodelib_valid_direct_from_index(L, 1));
+ return 1;
+}
+
+/* getlinestuff : LS RS LH RH ID PF FIRST LAST */
+
+inline static halfword set_effective_width(halfword source, halfword sign, halfword order, double glue)
+{
+ halfword amount = glue_amount(source);
+ switch (sign) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(source) == order) {
+ return amount + scaledround((double) glue_stretch(source) * glue);
+ } else {
+ break;
+ }
+ case shrinking_glue_sign:
+ if (glue_shrink_order(source) == order) {
+ return amount + scaledround((double) glue_shrink(source) * glue);
+ } else {
+ break;
+ }
+ }
+ return amount;
+}
+
+static int nodelib_direct_getnormalizedline(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == hlist_node && node_subtype(n) == line_list) {
+ halfword head = box_list(n);
+ halfword tail = head;
+ halfword first = head;
+ halfword last = tail;
+ halfword current = head;
+ halfword ls = 0;
+ halfword rs = 0;
+ halfword is = 0;
+ halfword pr = 0;
+ halfword pl = 0;
+ halfword ir = 0;
+ halfword il = 0;
+ halfword lh = 0;
+ halfword rh = 0;
+ halfword sign = box_glue_sign(n);
+ halfword order = box_glue_order(n);
+ double glue = box_glue_set(n);
+ while (current) {
+ tail = current ;
+ if (node_type(current) == glue_node) {
+ switch (node_subtype(current)) {
+ case left_skip_glue : ls = set_effective_width(current, sign, order, glue); break;
+ case right_skip_glue : rs = set_effective_width(current, sign, order, glue); break;
+ case par_fill_left_skip_glue : pl = set_effective_width(current, sign, order, glue); break;
+ case par_fill_right_skip_glue : pr = set_effective_width(current, sign, order, glue); break;
+ case par_init_left_skip_glue : il = set_effective_width(current, sign, order, glue); break;
+ case par_init_right_skip_glue : ir = set_effective_width(current, sign, order, glue); break;
+ case indent_skip_glue : is = set_effective_width(current, sign, order, glue); break;
+ case left_hang_skip_glue : lh = set_effective_width(current, sign, order, glue); break;
+ case right_hang_skip_glue : rh = set_effective_width(current, sign, order, glue); break;
+ }
+ }
+ current = node_next(current);
+ }
+ current = head;
+ while (current) {
+ if (node_type(current) == glue_node) {
+ switch (node_subtype(current)) {
+ case left_skip_glue:
+ case par_fill_left_skip_glue:
+ case par_init_left_skip_glue:
+ case indent_skip_glue:
+ case left_hang_skip_glue:
+ first = current;
+ current = node_next(current);
+ break;
+ default:
+ current = null;
+ break;
+ }
+ } else {
+ current = null;
+ }
+ }
+ current = tail;
+ while (current) {
+ if (node_type(current) == glue_node) {
+ switch (node_subtype(current)) {
+ case right_skip_glue:
+ case par_fill_right_skip_glue:
+ case par_init_right_skip_glue:
+ case right_hang_skip_glue:
+ last = current;
+ current = node_prev(current);
+ break;
+ default:
+ current = null;
+ break;
+ }
+ } else {
+ current = null;
+ }
+ }
+ lua_createtable(L, 0, 14); /* we could add some more */
+ lua_push_integer_at_key(L, leftskip, ls);
+ lua_push_integer_at_key(L, rightskip, rs);
+ lua_push_integer_at_key(L, lefthangskip, lh);
+ lua_push_integer_at_key(L, righthangskip, rh);
+ lua_push_integer_at_key(L, indent, is);
+ lua_push_integer_at_key(L, parfillleftskip, pl);
+ lua_push_integer_at_key(L, parfillrightskip, pr);
+ lua_push_integer_at_key(L, parinitleftskip, il);
+ lua_push_integer_at_key(L, parinitrightskip, ir);
+ lua_push_integer_at_key(L, first, first); /* points to a skip */
+ lua_push_integer_at_key(L, last, last); /* points to a skip */
+ lua_push_integer_at_key(L, head, head);
+ lua_push_integer_at_key(L, tail, tail);
+ // lua_push_integer_at_key(L, width, box_width(n));
+ return 1;
+ }
+ return 0;
+}
+
+/*tex new */
+
+static int nodelib_direct_ignoremathskip(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n && node_type(n) == math_node) {
+ lua_pushboolean(L, tex_ignore_math_skip(n));
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+static int nodelib_direct_reverse(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ n = tex_reversed_node_list(n);
+ }
+ nodelib_push_direct_or_nil(L, n);
+ return 1;
+}
+
+static int nodelib_direct_exchange(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ if (head) {
+ halfword first = nodelib_valid_direct_from_index(L, 2);
+ if (first) {
+ halfword second = nodelib_valid_direct_from_index(L, 3);
+ if (! second) {
+ second = node_next(first);
+ }
+ if (second) {
+ halfword pf = node_prev(first);
+ halfword ns = node_next(second);
+ if (first == head) {
+ head = second;
+ } else if (second == head) {
+ head = first;
+ }
+ if (second == node_next(first)) {
+ node_prev(first) = second;
+ node_next(second) = first;
+ } else {
+ halfword nf = node_next(first);
+ halfword ps = node_prev(second);
+ node_prev(first) = ps;
+ if (ps) {
+ node_next(ps) = first;
+ }
+ node_next(second) = nf;
+ if (nf) {
+ node_prev(nf) = second;
+ }
+ }
+ node_next(first) = ns;
+ node_prev(second) = pf;
+ if (pf) {
+ node_next(pf) = second;
+ }
+ if (ns) {
+ node_prev(ns) = first;
+ }
+ }
+ }
+ }
+ nodelib_push_direct_or_nil(L, head);
+ return 1;
+}
+
+/*tex experiment */
+
+inline static halfword nodelib_aux_migrate_decouple(halfword head, halfword current, halfword next, halfword *first, halfword *last)
+{
+ halfword prev = node_prev(current);
+ tex_uncouple_node(current);
+ if (current == head) {
+ node_prev(next) = null;
+ head = next;
+ } else {
+ tex_try_couple_nodes(prev, next);
+ }
+ if (*first) {
+ tex_couple_nodes(*last, current);
+ } else {
+ *first = current;
+ }
+ *last = current;
+ return head;
+}
+
+static halfword lmt_direct_migrate_locate(halfword head, halfword *first, halfword *last, int inserts, int marks)
+{
+ halfword current = head;
+ while (current) {
+ halfword next = node_next(current);
+ switch (node_type(current)) {
+ case vlist_node:
+ case hlist_node:
+ {
+ halfword list = box_list(current);
+ if (list) {
+ box_list(current) = lmt_direct_migrate_locate(list, first, last, inserts, marks);
+ }
+ break;
+ }
+ case insert_node:
+ {
+ if (inserts) {
+ head = nodelib_aux_migrate_decouple(head, current, next, first, last);
+ halfword list = insert_list(current);
+ if (list) {
+ insert_list(current) = lmt_direct_migrate_locate(list, first, last, inserts, marks);
+ }
+ }
+ break;
+ }
+ case mark_node:
+ {
+ if (marks) {
+ head = nodelib_aux_migrate_decouple(head, current, next, first, last);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+ current = next;
+ }
+ return head;
+}
+
+static int nodelib_direct_migrate(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ if (head) {
+ int inserts = lua_type(L, 3) == LUA_TBOOLEAN ? lua_toboolean(L, 2) : 1;
+ int marks = lua_type(L, 2) == LUA_TBOOLEAN ? lua_toboolean(L, 3) : 1;
+ halfword first = null;
+ halfword last = null;
+ halfword current = head;
+ while (current) {
+ switch (node_type(current)) {
+ case vlist_node:
+ case hlist_node:
+ {
+ halfword list = box_list(current);
+ if (list) {
+ box_list(current) = lmt_direct_migrate_locate(list, &first, &last, inserts, marks);
+ }
+ break;
+ }
+ case insert_node:
+ if (inserts) {
+ halfword list = insert_list(current);
+ if (list) {
+ insert_list(current) = lmt_direct_migrate_locate(list, &first, &last, inserts, marks);
+ }
+ break;
+ }
+ }
+ current = node_next(current);
+ }
+ nodelib_push_direct_or_nil(L, head);
+ nodelib_push_direct_or_nil(L, first);
+ nodelib_push_direct_or_nil(L, last);
+ return 3;
+ }
+ return 0;
+}
+
+/*tex experiment */
+
+static int nodelib_aux_no_left(halfword n, halfword l, halfword r)
+{
+ if (tex_has_glyph_option(n, (singleword) l)) {
+ return 1;
+ } else {
+ n = node_prev(n);
+ if (n) {
+ if (node_type(n) == disc_node) {
+ n = disc_no_break_tail(n);
+ }
+ if (n && node_type(n) == glyph_node && tex_has_glyph_option(n, (singleword) r)) {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static int nodelib_aux_no_right(halfword n, halfword r, halfword l)
+{
+ if (tex_has_glyph_option(n, (singleword) r)) {
+ return 1;
+ } else {
+ n = node_next(n);
+ if (node_type(n) == disc_node) {
+ n = disc_no_break_head(n);
+ }
+ if (n && node_type(n) == glyph_node && tex_has_glyph_option(n, (singleword) l)) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int nodelib_direct_hasglyphoption(lua_State *L)
+{
+ halfword current = nodelib_valid_direct_from_index(L, 1);
+ int result = 0;
+ if (current && node_type(current) == glyph_node) {
+ int option = lua_tointeger(L, 2);
+ switch (option) {
+ case glyph_option_normal_glyph: // 0x00
+ break;
+ case glyph_option_no_left_ligature: // 0x01
+ result = nodelib_aux_no_left(current, glyph_option_no_left_ligature, glyph_option_no_right_ligature);
+ break;
+ case glyph_option_no_right_ligature: // 0x02
+ result = nodelib_aux_no_right(current, glyph_option_no_right_ligature, glyph_option_no_left_ligature);
+ break;
+ case glyph_option_no_left_kern: // 0x04
+ result = nodelib_aux_no_left(current, glyph_option_no_left_kern, glyph_option_no_right_kern);
+ break;
+ case glyph_option_no_right_kern: // 0x08
+ result = nodelib_aux_no_right(current, glyph_option_no_right_kern, glyph_option_no_left_kern);
+ break;
+ case glyph_option_no_expansion: // 0x10
+ /* some day */
+ break;
+ case glyph_option_no_protrusion: // 0x20
+ /* some day */
+ break;
+ case glyph_option_no_italic_correction:
+ case glyph_option_math_discretionary:
+ case glyph_option_math_italics_too:
+ result = tex_has_glyph_option(current, option);
+ break;
+ }
+ }
+ lua_pushboolean(L, result);
+ return 1;
+}
+
+static int nodelib_direct_getspeciallist(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ halfword head = null;
+ halfword tail = null;
+ if (! s) {
+ /* error */
+ } else if (lua_key_eq(s, pageinserthead)) {
+ head = tex_get_special_node_list(page_insert_list_type, &tail);
+ } else if (lua_key_eq(s, contributehead)) {
+ head = tex_get_special_node_list(contribute_list_type, &tail);
+ } else if (lua_key_eq(s, pagehead)) {
+ head = tex_get_special_node_list(page_list_type, &tail);
+ } else if (lua_key_eq(s, temphead)) {
+ head = tex_get_special_node_list(temp_list_type, &tail);
+ } else if (lua_key_eq(s, holdhead)) {
+ head = tex_get_special_node_list(hold_list_type, &tail);
+ } else if (lua_key_eq(s, postadjusthead)) {
+ head = tex_get_special_node_list(post_adjust_list_type, &tail);
+ } else if (lua_key_eq(s, preadjusthead)) {
+ head = tex_get_special_node_list(pre_adjust_list_type, &tail);
+ } else if (lua_key_eq(s, postmigratehead)) {
+ head = tex_get_special_node_list(post_migrate_list_type, &tail);
+ } else if (lua_key_eq(s, premigratehead)) {
+ head = tex_get_special_node_list(pre_migrate_list_type, &tail);
+ } else if (lua_key_eq(s, alignhead)) {
+ head = tex_get_special_node_list(align_list_type, &tail);
+ } else if (lua_key_eq(s, pagediscardshead)) {
+ head = tex_get_special_node_list(page_discards_list_type, &tail);
+ } else if (lua_key_eq(s, splitdiscardshead)) {
+ head = tex_get_special_node_list(split_discards_list_type, &tail);
+ }
+ nodelib_push_direct_or_nil(L, head);
+ nodelib_push_direct_or_nil(L, tail);
+ return 2;
+}
+
+static int nodelib_direct_isspeciallist(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 1);
+ int istail = 0;
+ int checked = tex_is_special_node_list(head, &istail);
+ if (checked >= 0) {
+ lua_pushinteger(L, checked);
+ if (istail) {
+ lua_pushboolean(L, 1);
+ return 2;
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+static int nodelib_direct_setspeciallist(lua_State *L)
+{
+ halfword head = nodelib_valid_direct_from_index(L, 2);
+ const char *s = lua_tostring(L, 1);
+ if (! s) {
+ /* error */
+ } else if (lua_key_eq(s, pageinserthead)) {
+ tex_set_special_node_list(page_insert_list_type, head);
+ } else if (lua_key_eq(s, contributehead)) {
+ tex_set_special_node_list(contribute_list_type, head);
+ } else if (lua_key_eq(s, pagehead)) {
+ tex_set_special_node_list(page_list_type, head);
+ } else if (lua_key_eq(s, temphead)) {
+ tex_set_special_node_list(temp_list_type, head);
+ } else if (lua_key_eq(s, holdhead)) {
+ tex_set_special_node_list(hold_list_type, head);
+ } else if (lua_key_eq(s, postadjusthead)) {
+ tex_set_special_node_list(post_adjust_list_type, head);
+ } else if (lua_key_eq(s, preadjusthead)) {
+ tex_set_special_node_list(pre_adjust_list_type, head);
+ } else if (lua_key_eq(s, postmigratehead)) {
+ tex_set_special_node_list(post_migrate_list_type, head);
+ } else if (lua_key_eq(s, premigratehead)) {
+ tex_set_special_node_list(pre_migrate_list_type, head);
+ } else if (lua_key_eq(s, alignhead)) {
+ tex_set_special_node_list(align_list_type, head);
+ } else if (lua_key_eq(s, pagediscardshead)) {
+ tex_set_special_node_list(page_discards_list_type, head);
+ } else if (lua_key_eq(s, splitdiscardshead)) {
+ tex_set_special_node_list(split_discards_list_type, head);
+ }
+ return 0;
+}
+
+/*tex
+ This is just an experiment, so it might go away. Using a list can be a bit faster that traverse
+ (2-4 times) but you only see a difference on very last lists and even then one need some 10K
+ loops to notice it. If that gain is needed, I bet that the document takes a while to process
+ anyway.
+*/
+
+static int nodelib_direct_getnodes(lua_State *L)
+{
+ halfword n = nodelib_valid_direct_from_index(L, 1);
+ if (n) {
+ int i = 0;
+ /* maybe count */
+ lua_newtable(L);
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ int t = lua_tonumber(L, 2);
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ int s = lua_tonumber(L, 3);
+ while (n) {
+ if (node_type(n) == t && node_subtype(n) == s) {
+ lua_pushinteger(L, n);
+ lua_rawseti(L, -2, ++i);
+ }
+ n = node_next(n);
+ }
+ } else {
+ while (n) {
+ if (node_type(n) == t) {
+ lua_pushinteger(L, n);
+ lua_rawseti(L, -2, ++i);
+ }
+ n = node_next(n);
+ }
+ }
+ } else {
+ while (n) {
+ lua_pushinteger(L, n);
+ lua_rawseti(L, -2, ++i);
+ n = node_next(n);
+ }
+ }
+ if (i) {
+ return 1;
+ } else {
+ lua_pop(L, 1);
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/*tex experiment */
+
+static int nodelib_direct_getusedattributes(lua_State* L)
+{
+ lua_newtable(L); /* todo: preallocate */
+ for (int current = lmt_node_memory_state.nodes_data.top; current > lmt_node_memory_state.reserved; current--) {
+ if (lmt_node_memory_state.nodesizes[current] > 0 && (node_type(current) == attribute_node && node_subtype(current) != attribute_list_subtype)) {
+ if (lua_rawgeti(L, -1, attribute_index(current)) == LUA_TTABLE) {
+ lua_pushboolean(L, 1);
+ lua_rawseti(L, -2, attribute_value(current));
+ lua_pop(L, 1);
+ /* not faster: */
+ // if (lua_rawgeti(L, -1, attribute_value(current)) != LUA_TBOOLEAN) {
+ // lua_pushboolean(L, 1);
+ // lua_rawseti(L, -3, attribute_value(current));
+ // }
+ // lua_pop(L, 2);
+ } else {
+ lua_pop(L, 1);
+ lua_newtable(L);
+ lua_pushboolean(L, 1);
+ lua_rawseti(L, -2, attribute_value(current));
+ lua_rawseti(L, -2, attribute_index(current));
+ }
+ }
+ }
+ return 1;
+}
+
+static int nodelib_shared_getcachestate(lua_State *L)
+{
+ lua_pushboolean(L, attribute_cache_disabled);
+ return 1;
+}
+
+/*tex done */
+
+static int nodelib_get_property_t(lua_State *L)
+{ /* <table> <node> */
+ halfword n = lmt_check_isnode(L, 2);
+ if (n) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ /* <table> <node> <properties> */
+ lua_rawgeti(L, -1, n);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int nodelib_set_property_t(lua_State *L)
+{
+ /* <table> <node> <value> */
+ halfword n = lmt_check_isnode(L, 2);
+ if (n) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ /* <table> <node> <value> <properties> */
+ lua_insert(L, -2);
+ /* <table> <node> <properties> <value> */
+ lua_rawseti(L, -2, n);
+ }
+ return 0;
+}
+
+/* */
+
+static int nodelib_hybrid_gluetostring(lua_State *L)
+{
+ halfword glue = lua_type(L, 1) == LUA_TNUMBER ? nodelib_valid_direct_from_index(L, 1): lmt_maybe_isnode(L, 1);
+ if (glue) {
+ switch (node_type(glue)) {
+ case glue_node:
+ case glue_spec_node:
+ {
+ int saved_selector = lmt_print_state.selector;
+ char *str = NULL;
+ lmt_print_state.selector = new_string_selector_code;
+ tex_print_spec(glue, pt_unit);
+ str = tex_take_string(NULL);
+ lmt_print_state.selector = saved_selector;
+ lua_pushstring(L, str);
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static const struct luaL_Reg nodelib_p[] = {
+ { "__index", nodelib_get_property_t },
+ { "__newindex", nodelib_set_property_t },
+ { NULL, NULL },
+};
+
+void lmt_initialize_properties(int set_size)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (lmt_node_memory_state.node_properties_id) {
+ /*tex
+ We should clean up but for now we accept a leak because these tables are still empty,
+ and when you do this once again you're probably messing up. This should actually be
+ enough:
+ */
+ luaL_unref(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ lmt_node_memory_state.node_properties_id = 0;
+ }
+ if (set_size) {
+ tex_engine_get_config_number("propertiessize", &lmt_node_memory_state.node_properties_table_size);
+ if (lmt_node_memory_state.node_properties_table_size < 0) {
+ lmt_node_memory_state.node_properties_table_size = 0;
+ }
+ /*tex It's a hash, not an array because we jump by size. */
+ lua_createtable(L, 0, lmt_node_memory_state.node_properties_table_size);
+ } else {
+ lua_newtable(L);
+ }
+ /* <properties table> */
+ lmt_node_memory_state.node_properties_id = luaL_ref(L, LUA_REGISTRYINDEX);
+ /* not needed, so unofficial */
+ lua_pushstring(L, NODE_PROPERTIES_DIRECT);
+ /* <direct identifier> */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ /* <direct identifier> <properties table> */
+ lua_settable(L, LUA_REGISTRYINDEX);
+ /* */
+ lua_pushstring(L, NODE_PROPERTIES_INDIRECT);
+ /* <indirect identifier> */
+ lua_newtable(L);
+ /* <indirect identifier> <stub table> */
+ luaL_newmetatable(L, NODE_PROPERTIES_INSTANCE);
+ /* <indirect identifier> <stub table> <metatable> */
+ luaL_setfuncs(L, nodelib_p, 0);
+ /* <indirect identifier> <stub table> <metatable> */
+ lua_setmetatable(L, -2);
+ /* <indirect identifier> <stub table> */
+ lua_settable(L, LUA_REGISTRYINDEX);
+ /* */
+}
+
+/* node.direct.* */
+
+static const struct luaL_Reg nodelib_direct_function_list[] = {
+ { "checkdiscretionaries", nodelib_direct_checkdiscretionaries },
+ { "checkdiscretionary", nodelib_direct_checkdiscretionary },
+ { "copy", nodelib_direct_copy },
+ { "copylist", nodelib_direct_copylist },
+ { "copyonly", nodelib_direct_copyonly },
+ { "count", nodelib_direct_count },
+ { "currentattributes", nodelib_direct_currentattributes },
+ { "dimensions", nodelib_direct_dimensions },
+ { "effectiveglue", nodelib_direct_effectiveglue },
+ { "endofmath", nodelib_direct_endofmath },
+ { "findattribute", nodelib_direct_findattribute },
+ { "findattributerange", nodelib_direct_findattributerange },
+ { "findnode", nodelib_direct_findnode },
+ { "firstglyph", nodelib_direct_firstglyph },
+ { "flattendiscretionaries", nodelib_direct_flattendiscretionaries },
+ { "softenhyphens", nodelib_direct_softenhyphens },
+ { "flushlist", nodelib_direct_flushlist },
+ { "flushnode", nodelib_direct_flushnode },
+ { "free", nodelib_direct_free },
+ { "getattribute", nodelib_direct_getattribute },
+ { "getattributes", nodelib_direct_getattributes },
+ { "getpropertiestable", nodelib_direct_getpropertiestable },
+ { "getinputfields", nodelib_direct_getinputfields },
+ { "getattributelist", nodelib_direct_getattributelist },
+ { "getboth", nodelib_direct_getboth },
+ { "getbottom", nodelib_direct_getbottom },
+ { "getbox", nodelib_direct_getbox },
+ { "getchar", nodelib_direct_getchar },
+ { "getchardict", nodelib_direct_getchardict },
+ { "getcharspec", nodelib_direct_getcharspec },
+ { "getchoice", nodelib_direct_getchoice },
+ { "getclass", nodelib_direct_getclass },
+ { "getstate", nodelib_direct_getstate },
+ { "getscript", nodelib_direct_getscript },
+ { "getdata", nodelib_direct_getdata },
+ { "getleftdelimiter", nodelib_direct_getleftdelimiter },
+ { "getrightdelimiter", nodelib_direct_getrightdelimiter },
+ { "getdelimiter", nodelib_direct_getdelimiter },
+ { "getdenominator", nodelib_direct_getdenominator },
+ { "getdegree", nodelib_direct_getdegree },
+ { "getdepth", nodelib_direct_getdepth },
+ { "getdirection", nodelib_direct_getdirection },
+ { "getdisc", nodelib_direct_getdisc },
+ { "getdiscpart", nodelib_direct_getdiscpart },
+ { "getexpansion", nodelib_direct_getexpansion },
+ { "getfam", nodelib_direct_getfam },
+ { "getfield", nodelib_direct_getfield },
+ { "getfont", nodelib_direct_getfont },
+ { "getglue", nodelib_direct_getglue },
+ { "getglyphdata", nodelib_direct_getglyphdata },
+ { "getheight", nodelib_direct_getheight },
+ { "getindex", nodelib_direct_getindex },
+ { "getid", nodelib_direct_getid },
+ { "getkern", nodelib_direct_getkern },
+ { "getlanguage", nodelib_direct_getlanguage },
+ { "getleader", nodelib_direct_getleader },
+ { "getlist", nodelib_direct_getlist },
+ { "getnext", nodelib_direct_getnext },
+ { "getnormalizedline", nodelib_direct_getnormalizedline },
+ { "getnodes", nodelib_direct_getnodes },
+ { "getnucleus", nodelib_direct_getnucleus },
+ { "getnumerator", nodelib_direct_getnumerator },
+ { "getoffsets", nodelib_direct_getoffsets },
+ { "getanchors", nodelib_direct_getanchors },
+ { "gettop", nodelib_direct_gettop },
+ { "getscales", nodelib_direct_getscales },
+ { "getscale", nodelib_direct_getscale },
+ { "getxscale", nodelib_direct_getxscale },
+ { "getyscale", nodelib_direct_getyscale },
+ { "xscaled", nodelib_direct_xscaled },
+ { "yscaled", nodelib_direct_yscaled },
+ { "getxyscales", nodelib_direct_getxyscales },
+ { "getoptions", nodelib_direct_getoptions },
+ { "hasgeometry", nodelib_direct_hasgeometry },
+ { "getgeometry", nodelib_direct_getgeometry },
+ { "setgeometry", nodelib_direct_setgeometry },
+ { "getorientation", nodelib_direct_getorientation },
+ { "getpenalty", nodelib_direct_getpenalty },
+ { "getpost", nodelib_direct_getpost },
+ { "getpre", nodelib_direct_getpre },
+ { "getprev", nodelib_direct_getprev },
+ { "getproperty", nodelib_direct_getproperty },
+ { "getreplace", nodelib_direct_getreplace },
+ { "getshift", nodelib_direct_getshift },
+ { "getsub", nodelib_direct_getsub },
+ { "getsubpre", nodelib_direct_getsubpre },
+ { "getsubtype", nodelib_direct_getsubtype },
+ { "getsup", nodelib_direct_getsup },
+ { "getsuppre", nodelib_direct_getsuppre },
+ { "getprime", nodelib_direct_getprime },
+ { "gettotal" , nodelib_direct_gettotal },
+ { "getwhd", nodelib_direct_getwhd },
+ { "getwidth", nodelib_direct_getwidth },
+ { "getwordrange", nodelib_direct_getwordrange },
+ { "getparstate", nodelib_direct_getparstate },
+ { "hasattribute", nodelib_direct_hasattribute },
+ { "hasdimensions", nodelib_direct_hasdimensions },
+ { "hasfield", nodelib_direct_hasfield },
+ { "hasglyph", nodelib_direct_hasglyph },
+ { "hasglyphoption", nodelib_direct_hasglyphoption },
+ { "hpack", nodelib_direct_hpack },
+ { "hyphenating", nodelib_direct_hyphenating },
+ { "collapsing", nodelib_direct_collapsing }, /*tex A funny name but like |ligaturing| and |hyphenating|. */
+ { "ignoremathskip", nodelib_direct_ignoremathskip },
+ { "insertafter", nodelib_direct_insertafter },
+ { "insertbefore", nodelib_direct_insertbefore },
+ { "appendaftertail", nodelib_direct_appendaftertail },
+ { "prependbeforehead", nodelib_direct_prependbeforehead },
+ { "ischar", nodelib_direct_ischar },
+ { "isnextchar", nodelib_direct_isnextchar },
+ { "isprevchar", nodelib_direct_isprevchar },
+ { "isnextglyph", nodelib_direct_isnextglyph },
+ { "isprevglyph", nodelib_direct_isprevglyph },
+ { "isdirect", nodelib_direct_isdirect },
+ { "isglyph", nodelib_direct_isglyph },
+ { "isnode", nodelib_direct_isnode },
+ { "isvalid", nodelib_direct_isvalid },
+ { "iszeroglue", nodelib_direct_iszeroglue },
+ { "isnext", nodelib_direct_isnext },
+ { "isprev", nodelib_direct_isprev },
+ { "isboth", nodelib_direct_isboth },
+ { "kerning", nodelib_direct_kerning },
+ { "lastnode", nodelib_direct_lastnode },
+ { "length", nodelib_direct_length },
+ { "ligaturing", nodelib_direct_ligaturing },
+ { "makeextensible", nodelib_direct_makeextensible },
+ { "mlisttohlist", nodelib_direct_mlisttohlist },
+ { "naturalwidth", nodelib_direct_naturalwidth },
+ { "naturalhsize", nodelib_direct_naturalhsize },
+ { "new", nodelib_direct_new },
+ { "newtextglyph", nodelib_direct_newtextglyph },
+ { "newmathglyph", nodelib_direct_newmathglyph },
+ { "protectglyph", nodelib_direct_protectglyph },
+ { "protectglyphs", nodelib_direct_protectglyphs },
+ { "protrusionskippable", nodelib_direct_protrusionskipable },
+ { "rangedimensions", nodelib_direct_rangedimensions }, /* maybe get... */
+ { "getglyphdimensions", nodelib_direct_getglyphdimensions },
+ { "getkerndimension", nodelib_direct_getkerndimension },
+ { "patchattributes", nodelib_direct_patchattributes },
+ { "remove", nodelib_direct_remove },
+ { "repack", nodelib_direct_repack },
+ { "freeze", nodelib_direct_freeze },
+ { "setattribute", nodelib_direct_setattribute },
+ { "setattributes", nodelib_direct_setattributes },
+ { "setinputfields", nodelib_direct_setinputfields },
+ { "setattributelist", nodelib_direct_setattributelist },
+ { "setboth", nodelib_direct_setboth },
+ { "setbottom", nodelib_direct_setbottom },
+ { "setbox", nodelib_direct_setbox },
+ { "setchar", nodelib_direct_setchar },
+ { "setchardict", nodelib_direct_setchardict },
+ { "setchoice", nodelib_direct_setchoice },
+ { "setclass", nodelib_direct_setclass },
+ { "setstate", nodelib_direct_setstate },
+ { "setscript", nodelib_direct_setscript },
+ { "setdata", nodelib_direct_setdata },
+ { "setleftdelimiter", nodelib_direct_setleftdelimiter },
+ { "setrightdelimiter", nodelib_direct_setrightdelimiter },
+ { "setdelimiter", nodelib_direct_setdelimiter },
+ { "setdenominator", nodelib_direct_setdenominator },
+ { "setdegree", nodelib_direct_setdegree },
+ { "setdepth", nodelib_direct_setdepth },
+ { "setdirection", nodelib_direct_setdirection },
+ { "setdisc", nodelib_direct_setdisc },
+ { "setdiscpart", nodelib_direct_setdiscpart },
+ { "setexpansion", nodelib_direct_setexpansion },
+ { "setfam", nodelib_direct_setfam },
+ { "setfield", nodelib_direct_setfield },
+ { "setfont", nodelib_direct_setfont },
+ { "setglue", nodelib_direct_setglue },
+ { "setglyphdata", nodelib_direct_setglyphdata },
+ { "setheight", nodelib_direct_setheight },
+ { "setindex", nodelib_direct_setindex },
+ { "setkern", nodelib_direct_setkern },
+ { "setlanguage", nodelib_direct_setlanguage },
+ { "setleader", nodelib_direct_setleader },
+ { "setlink", nodelib_direct_setlink },
+ { "setlist", nodelib_direct_setlist },
+ { "setnext", nodelib_direct_setnext },
+ { "setnucleus", nodelib_direct_setnucleus },
+ { "setnumerator", nodelib_direct_setnumerator },
+ { "setoffsets", nodelib_direct_setoffsets },
+ { "addxoffset", nodelib_direct_addxoffset },
+ { "addyoffset", nodelib_direct_addyoffset },
+ { "addmargins", nodelib_direct_addmargins },
+ { "addxymargins", nodelib_direct_addxymargins },
+ { "setscales", nodelib_direct_setscales },
+ { "setanchors", nodelib_direct_setanchors },
+ { "setorientation", nodelib_direct_setorientation },
+ { "setoptions", nodelib_direct_setoptions },
+ { "setpenalty", nodelib_direct_setpenalty },
+ { "setpost", nodelib_direct_setpost },
+ { "setpre", nodelib_direct_setpre },
+ { "setprev", nodelib_direct_setprev },
+ { "setproperty", nodelib_direct_setproperty },
+ { "setreplace", nodelib_direct_setreplace },
+ { "setshift", nodelib_direct_setshift },
+ { "setsplit", nodelib_direct_setsplit },
+ { "setsub", nodelib_direct_setsub },
+ { "setsubpre", nodelib_direct_setsubpre },
+ { "setsubtype", nodelib_direct_setsubtype },
+ { "setsup", nodelib_direct_setsup },
+ { "setsuppre", nodelib_direct_setsuppre },
+ { "setprime" , nodelib_direct_setprime },
+ { "settotal" , nodelib_direct_settotal },
+ { "settop" , nodelib_direct_settop },
+ { "setwhd", nodelib_direct_setwhd },
+ { "setwidth", nodelib_direct_setwidth },
+ { "slide", nodelib_direct_slide },
+ { "startofpar", nodelib_direct_startofpar },
+ { "tail", nodelib_direct_tail },
+ { "todirect", nodelib_direct_todirect },
+ { "tonode", nodelib_direct_tonode },
+ { "tostring", nodelib_direct_tostring },
+ { "tovaliddirect", nodelib_direct_tovaliddirect },
+ { "traverse", nodelib_direct_traverse },
+ { "traversechar", nodelib_direct_traversechar },
+ { "traverseglyph", nodelib_direct_traverseglyph },
+ { "traverseid", nodelib_direct_traverseid },
+ { "traverselist", nodelib_direct_traverselist },
+ { "traversecontent", nodelib_direct_traversecontent },
+ { "traverseleader", nodelib_direct_traverseleader },
+ { "unprotectglyph", nodelib_direct_unprotectglyph },
+ { "unprotectglyphs", nodelib_direct_unprotectglyphs },
+ { "unsetattribute", nodelib_direct_unsetattribute },
+ { "unsetattributes", nodelib_direct_unsetattributes },
+ { "usedlist", nodelib_direct_usedlist },
+ { "usesfont", nodelib_direct_usesfont },
+ { "vpack", nodelib_direct_vpack },
+ { "flattenleaders", nodelib_direct_flattenleaders },
+ { "write", nodelib_direct_write },
+ /* { "appendtocurrentlist", nodelib_direct_appendtocurrentlist }, */ /* beware, we conflict in ctx */
+ { "verticalbreak", nodelib_direct_verticalbreak },
+ { "reverse", nodelib_direct_reverse },
+ { "exchange", nodelib_direct_exchange },
+ { "migrate", nodelib_direct_migrate },
+ { "getspeciallist", nodelib_direct_getspeciallist },
+ { "setspeciallist", nodelib_direct_setspeciallist },
+ { "isspeciallist", nodelib_direct_isspeciallist },
+ { "getusedattributes", nodelib_direct_getusedattributes },
+ /* dual node and direct */
+ { "type", nodelib_hybrid_type },
+ { "types", nodelib_shared_types },
+ { "fields", nodelib_shared_fields },
+ { "subtypes", nodelib_shared_subtypes },
+ { "values", nodelib_shared_values },
+ { "id", nodelib_shared_id },
+ { "show", nodelib_direct_show },
+ { "gluetostring", nodelib_hybrid_gluetostring },
+ { "serialized", nodelib_direct_serialized },
+ { "getcachestate", nodelib_shared_getcachestate },
+ { NULL, NULL },
+};
+
+/* node.* */
+
+static const struct luaL_Reg nodelib_function_list[] = {
+ /* the bare minimum for reasonable performance */
+ { "copy", nodelib_userdata_copy },
+ { "copylist", nodelib_userdata_copylist },
+ { "new", nodelib_userdata_new },
+ { "flushlist", nodelib_userdata_flushlist },
+ { "flushnode", nodelib_userdata_flushnode },
+ { "free", nodelib_userdata_free },
+ { "currentattributes", nodelib_userdata_currentattributes },
+ { "hasattribute", nodelib_userdata_hasattribute },
+ { "getattribute", nodelib_userdata_getattribute },
+ { "setattribute", nodelib_userdata_setattribute },
+ { "unsetattribute", nodelib_userdata_unsetattribute },
+ { "getpropertiestable", nodelib_userdata_getpropertiestable },
+ { "getproperty", nodelib_userdata_getproperty },
+ { "setproperty", nodelib_userdata_setproperty },
+ { "getfield", nodelib_userdata_getfield },
+ { "setfield", nodelib_userdata_setfield },
+ { "hasfield", nodelib_userdata_hasfield },
+ { "tail", nodelib_userdata_tail },
+ { "write", nodelib_userdata_write },
+ /* { "appendtocurrentlist", nodelib_userdata_append }, */ /* beware, we conflict in ctx */
+ { "isnode", nodelib_userdata_isnode },
+ { "tostring", nodelib_userdata_tostring },
+ { "usedlist", nodelib_userdata_usedlist },
+ { "inuse", nodelib_userdata_inuse },
+ { "instock", nodelib_userdata_instock },
+ { "traverse", nodelib_userdata_traverse },
+ { "traverseid", nodelib_userdata_traverse_id },
+ { "insertafter", nodelib_userdata_insertafter },
+ { "insertbefore", nodelib_userdata_insertbefore },
+ { "remove", nodelib_userdata_remove },
+ /* shared between userdata and direct */
+ { "type", nodelib_hybrid_type },
+ { "types", nodelib_shared_types },
+ { "fields", nodelib_shared_fields },
+ { "subtypes", nodelib_shared_subtypes },
+ { "values", nodelib_shared_values },
+ { "id", nodelib_shared_id },
+ { "show", nodelib_userdata_show },
+ { "gluetostring", nodelib_hybrid_gluetostring },
+ { "serialized", nodelib_userdata_serialized },
+ { "getcachestate", nodelib_shared_getcachestate },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg nodelib_metatable[] = {
+ { "__index", nodelib_userdata_index },
+ { "__newindex", nodelib_userdata_newindex },
+ { "__tostring", nodelib_userdata_tostring },
+ { "__eq", nodelib_userdata_equal },
+ { NULL, NULL },
+};
+
+int luaopen_node(lua_State *L)
+{
+ /*tex the main metatable of node userdata */
+ luaL_newmetatable(L, NODE_METATABLE_INSTANCE);
+ /* node.* */
+ luaL_setfuncs(L, nodelib_metatable, 0);
+ lua_newtable(L);
+ luaL_setfuncs(L, nodelib_function_list, 0);
+ /* node.direct */
+ lua_pushstring(L, lua_key(direct));
+ lua_newtable(L);
+ luaL_setfuncs(L, nodelib_direct_function_list, 0);
+ lua_rawset(L, -3);
+ return 1;
+}
+
+void lmt_node_list_to_lua(lua_State *L, halfword n)
+{
+ lmt_push_node_fast(L, n);
+}
+
+halfword lmt_node_list_from_lua(lua_State *L, int n)
+{
+ if (lua_isnil(L, n)) {
+ return null;
+ } else {
+ halfword list = lmt_check_isnode(L, n);
+ return list ? list : null;
+ }
+}
+
+/*tex
+ Here come the callbacks that deal with node lists. Some are called in multiple locations and
+ then get additional information passed concerning the whereabouts.
+
+ The begin paragraph callback first got |cmd| and |chr| but in the end it made more sense to
+ do it like the rest and pass a string. There is no need for more granularity.
+ */
+
+void lmt_begin_paragraph_callback(
+ int invmode,
+ int *indented,
+ int context
+)
+{
+ int callback_id = lmt_callback_defined(begin_paragraph_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lua_pushboolean(L, invmode);
+ lua_pushboolean(L, *indented);
+ lmt_push_par_begin(L, context);
+ i = lmt_callback_call(L, 3, 1, top);
+ /* done */
+ if (i) {
+ lmt_callback_error(L, top, i);
+ }
+ else {
+ *indented = lua_toboolean(L, -1);
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+}
+
+void lmt_paragraph_context_callback(
+ int context,
+ int *ignore
+)
+{
+ int callback_id = lmt_callback_defined(paragraph_context_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_push_par_context(L, context);
+ i = lmt_callback_call(L, 1, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ }
+ else {
+ *ignore = lua_toboolean(L, -1);
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+}
+
+void lmt_page_filter_callback(
+ int context,
+ halfword boundary
+)
+{
+ int callback_id = lmt_callback_defined(buildpage_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_push_page_context(L, context);
+ lua_push_halfword(L, boundary);
+ i = lmt_callback_call(L, 2, 0, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+}
+
+/*tex This one gets |tail| and optionally gets back |head|. */
+
+void lmt_append_line_filter_callback(
+ halfword context,
+ halfword index /* class */
+)
+{
+ if (cur_list.tail) {
+ int callback_id = lmt_callback_defined(append_line_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, node_next(cur_list.head));
+ lmt_node_list_to_lua(L, cur_list.tail);
+ lmt_push_append_line_context(L, context);
+ lua_push_halfword(L, index);
+ i = lmt_callback_call(L, 4, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ if (lua_type(L, -1) == LUA_TUSERDATA) {
+ int a = lmt_node_list_from_lua(L, -1);
+ node_next(cur_list.head) = a;
+ cur_list.tail = tex_tail_of_node_list(a);
+ }
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+}
+
+/*tex
+
+ Eventually the optional fixing of lists will go away because we assume that proper double linked
+ lists get returned. Keep in mind that \TEX\ itself never looks back (we didn't change that bit,
+ at least not until now) so it's only callbacks that suffer from bad |prev| fields.
+
+*/
+
+void lmt_node_filter_callback(
+ int filterid,
+ int extrainfo,
+ halfword head_node,
+ halfword *tail_node
+)
+{
+ if (head_node) {
+ /*tex We start after head (temp). */
+ halfword start_node = node_next(head_node);
+ if (start_node) {
+ int callback_id = lmt_callback_defined(filterid);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ /*tex We make sure we have no prev */
+ node_prev(start_node) = null;
+ /*tex the action */
+ lmt_node_list_to_lua(L, start_node);
+ lmt_push_group_code(L, extrainfo);
+ i = lmt_callback_call(L, 2, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ /*tex append to old head */
+ halfword start_done = lmt_node_list_from_lua(L, -1);
+ tex_try_couple_nodes(head_node, start_done);
+ /*tex redundant as we set top anyway */
+ lua_pop(L, 2);
+ /*tex find tail in order to update tail */
+ start_node = node_next(head_node);
+ if (start_node) {
+ /*tex maybe just always slide (harmless and fast) */
+ halfword last_node = node_next(start_node);
+ while (last_node) {
+ start_node = last_node;
+ last_node = node_next(start_node);
+ }
+ /*tex we're at the end now */
+ *tail_node = start_node;
+ } else {
+ /*tex we're already at the end */
+ *tail_node = head_node;
+ }
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+ }
+ return;
+}
+
+/*tex
+ Maybe this one will get extended a bit in due time.
+*/
+
+int lmt_linebreak_callback(
+ int is_broken,
+ halfword head_node,
+ halfword *new_head
+)
+{
+ if (head_node) {
+ halfword start_node = node_next(head_node);
+ if (start_node) {
+ int callback_id = lmt_callback_defined(linebreak_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (callback_id > 0 && lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ int ret = 0;
+ node_prev(start_node) = null;
+ lmt_node_list_to_lua(L, start_node);
+ lua_pushboolean(L, is_broken);
+ i = lmt_callback_call(L, 2, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ halfword *p = lua_touserdata(L, -1);
+ if (p) {
+ int a = lmt_node_list_from_lua(L, -1);
+ tex_try_couple_nodes(*new_head, a);
+ ret = 1;
+ }
+ lmt_callback_wrapup(L, top);
+ }
+ return ret;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+void lmt_alignment_callback(
+ halfword head_node,
+ halfword context,
+ halfword attr_list,
+ halfword preamble
+)
+{
+ if (head_node || preamble) {
+ int callback_id = lmt_callback_defined(alignment_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, head_node);
+ lmt_push_alignment_context(L, context);
+ lmt_node_list_to_lua(L, attr_list);
+ lmt_node_list_to_lua(L, preamble);
+ i = lmt_callback_call(L, 4, 0, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+ return;
+}
+
+void lmt_local_box_callback(
+ halfword linebox,
+ halfword leftbox,
+ halfword rightbox,
+ halfword middlebox,
+ halfword linenumber,
+ scaled leftskip,
+ scaled rightskip,
+ scaled lefthang,
+ scaled righthang,
+ scaled indentation,
+ scaled parinitleftskip,
+ scaled parinitrightskip,
+ scaled parfillleftskip,
+ scaled parfillrightskip,
+ scaled overshoot
+)
+{
+ if (linebox) {
+ int callback_id = lmt_callback_defined(local_box_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, linebox);
+ lmt_node_list_to_lua(L, leftbox);
+ lmt_node_list_to_lua(L, rightbox);
+ lmt_node_list_to_lua(L, middlebox);
+ lua_pushinteger(L, linenumber);
+ lua_pushinteger(L, leftskip);
+ lua_pushinteger(L, rightskip);
+ lua_pushinteger(L, lefthang);
+ lua_pushinteger(L, righthang);
+ lua_pushinteger(L, indentation);
+ lua_pushinteger(L, parinitleftskip);
+ lua_pushinteger(L, parinitrightskip);
+ lua_pushinteger(L, parfillleftskip);
+ lua_pushinteger(L, parfillrightskip);
+ lua_pushinteger(L, overshoot);
+ i = lmt_callback_call(L, 15, 0, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ /* todo: check if these boxes are still okay (defined) */
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+}
+
+/*tex
+ This one is a bit different from the \LUATEX\ variant. The direction parameter has been dropped
+ and prevdepth correction can be controlled.
+*/
+
+int lmt_append_to_vlist_callback(
+ halfword box,
+ int location,
+ halfword prev_depth,
+ halfword *result,
+ int *next_depth,
+ int *prev_set,
+ int *check_depth
+)
+{
+ if (box) {
+ int callback_id = lmt_callback_defined(append_to_vlist_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, box);
+ lua_push_key_by_index(location);
+ lua_pushinteger(L, (int) prev_depth);
+ i = lmt_callback_call(L, 3, 3, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ switch (lua_type(L, -3)) {
+ case LUA_TUSERDATA:
+ *result = lmt_check_isnode(L, -3);
+ break;
+ case LUA_TNIL:
+ *result = null;
+ break;
+ default:
+ tex_normal_warning("append to vlist callback", "node or nil expected");
+ break;
+ }
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ *next_depth = lmt_roundnumber(L, -2);
+ *prev_set = 1;
+ }
+ if (*result && lua_type(L, -1) == LUA_TBOOLEAN) {
+ *check_depth = lua_toboolean(L, -1);
+ }
+ lmt_callback_wrapup(L, top);
+ return 1;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+/*tex
+ Here we keep the directions although they play no real role in the
+ packing process.
+ */
+
+halfword lmt_hpack_filter_callback(
+ halfword head_node,
+ scaled size,
+ int pack_type,
+ int extrainfo,
+ int pack_direction,
+ halfword attr
+)
+{
+ if (head_node) {
+ int callback_id = lmt_callback_defined(hpack_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ node_prev(head_node) = null;
+ lmt_node_list_to_lua(L, head_node);
+ lmt_push_group_code(L, extrainfo);
+ lua_pushinteger(L, size);
+ lmt_push_pack_type(L, pack_type);
+ if (pack_direction >= 0) {
+ lua_pushinteger(L, pack_direction);
+ } else {
+ lua_pushnil(L);
+ }
+ /* maybe: (attr && attr != cache_disabled) */
+ lmt_node_list_to_lua(L, attr);
+ i = lmt_callback_call(L, 6, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ head_node = lmt_node_list_from_lua(L, -1);
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+ return head_node;
+}
+
+extern halfword lmt_packed_vbox_filter_callback(
+ halfword box,
+ int extrainfo
+)
+{
+ if (box) {
+ int callback_id = lmt_callback_defined(packed_vbox_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, box);
+ lmt_push_group_code(L, extrainfo);
+ i = lmt_callback_call(L, 2, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ box = lmt_node_list_from_lua(L, -1);
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+ return box;
+}
+
+halfword lmt_vpack_filter_callback(
+ halfword head_node,
+ scaled size,
+ int pack_type,
+ scaled maxd,
+ int extrainfo,
+ int pack_direction,
+ halfword attr
+)
+{
+ if (head_node) {
+ int callback_id = lmt_callback_defined(extrainfo == output_group ? pre_output_filter_callback : vpack_filter_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ node_prev(head_node) = null;
+ lmt_node_list_to_lua(L, head_node);
+ lmt_push_group_code(L, extrainfo);
+ lua_pushinteger(L, size);
+ lmt_push_pack_type(L, pack_type);
+ lua_pushinteger(L, maxd);
+ if (pack_direction >= 0) {
+ lua_pushinteger(L, pack_direction);
+ } else {
+ lua_pushnil(L);
+ }
+ lmt_node_list_to_lua(L, attr);
+ i = lmt_callback_call(L, 7, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ head_node = lmt_node_list_from_lua(L, -1);
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+ return head_node;
+}
diff --git a/source/luametatex/source/lua/lmtnodelib.h b/source/luametatex/source/lua/lmtnodelib.h
new file mode 100644
index 000000000..6894104b2
--- /dev/null
+++ b/source/luametatex/source/lua/lmtnodelib.h
@@ -0,0 +1,114 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LNODELIB_H
+# define LNODELIB_H
+
+extern void lmt_push_node (lua_State *L);
+extern void lmt_push_node_fast (lua_State *L, halfword n);
+extern void lmt_push_directornode (lua_State *L, halfword n, int isdirect);
+extern void lmt_node_list_to_lua (lua_State *L, halfword n);
+extern halfword lmt_node_list_from_lua (lua_State *L, int n);
+extern int lmt_get_math_style (lua_State *L, int n, int dflt);
+extern int lmt_get_math_parameter (lua_State *L, int n, int dflt);
+extern halfword lmt_check_isnode (lua_State *L, int i);
+extern halfword lmt_check_isdirect (lua_State *L, int i);
+extern halfword lmt_check_isdirectornode (lua_State *L, int i, int *isdirect);
+extern void lmt_initialize_properties (int set_size);
+
+extern halfword lmt_hpack_filter_callback(
+ halfword head_node,
+ scaled size,
+ int pack_type,
+ int extrainfo,
+ int d,
+ halfword a
+);
+
+extern halfword lmt_vpack_filter_callback(
+ halfword head_node,
+ scaled size,
+ int pack_type,
+ scaled maxd,
+ int extrainfo,
+ int d,
+ halfword a
+);
+
+extern halfword lmt_packed_vbox_filter_callback(
+ halfword box,
+ int extrainfo
+);
+
+extern void lmt_node_filter_callback(
+ int filterid,
+ int extrainfo,
+ halfword head_node,
+ halfword *tail_node
+);
+
+extern int lmt_linebreak_callback(
+ int is_broken,
+ halfword head_node,
+ halfword *new_head
+);
+
+extern void lmt_alignment_callback(
+ halfword head_node,
+ halfword context,
+ halfword attr_list,
+ halfword preamble
+);
+
+extern void lmt_local_box_callback(
+ halfword linebox,
+ halfword leftbox,
+ halfword rightbox,
+ halfword middlebox,
+ halfword linenumber,
+ scaled leftskip,
+ scaled rightskip,
+ scaled lefthang,
+ scaled righthang,
+ scaled indentation,
+ scaled parinitleftskip,
+ scaled parinitrightskip,
+ scaled parfillleftskip,
+ scaled parfillrightskip,
+ scaled overshoot
+);
+
+extern int lmt_append_to_vlist_callback(
+ halfword box,
+ int location,
+ halfword prev_depth,
+ halfword *result,
+ int *next_depth,
+ int *prev_set,
+ int *check_depth
+);
+
+extern void lmt_begin_paragraph_callback(
+ int invmode,
+ int *indented,
+ int context
+);
+
+extern void lmt_paragraph_context_callback(
+ int context,
+ int *ignore
+);
+
+
+extern void lmt_page_filter_callback(
+ int context,
+ halfword boundary
+);
+
+extern void lmt_append_line_filter_callback(
+ halfword context,
+ halfword index
+);
+
+# endif
diff --git a/source/luametatex/source/lua/lmtstatuslib.c b/source/luametatex/source/lua/lmtstatuslib.c
new file mode 100644
index 000000000..cf665ede2
--- /dev/null
+++ b/source/luametatex/source/lua/lmtstatuslib.c
@@ -0,0 +1,526 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This module has been there from the start and provides some information that doesn't really
+ fit elsewhere. In \LUATEX\ the module got extended ovet time, and in \LUAMETATEX\ most of what
+ is here has been redone, also because we want different statistics.
+
+*/
+
+# include "luametatex.h"
+
+# define STATS_METATABLE "tex.stats"
+
+typedef struct statistic_entry {
+ const char *name;
+ void *value;
+ int type;
+ int padding;
+} statistic_entry;
+
+typedef const char *(*constfunc) (void);
+typedef char *(*charfunc) (void);
+typedef lua_Number (*numfunc) (void);
+typedef int (*intfunc) (void);
+typedef int (*luafunc) (lua_State *L);
+
+static int statslib_callbackstate(lua_State *L)
+{
+ lmt_push_callback_usage(L);
+ return 1;
+}
+
+static int statslib_texstate(lua_State *L)
+{
+ lua_Integer approximate = 0
+ + (lua_Integer) lmt_string_pool_state .string_pool_data .allocated * (lua_Integer) lmt_string_pool_state .string_pool_data .itemsize
+ + (lua_Integer) lmt_string_pool_state .string_body_data .allocated * (lua_Integer) lmt_string_pool_state .string_body_data .itemsize
+ + (lua_Integer) lmt_node_memory_state .nodes_data .allocated * (lua_Integer) lmt_node_memory_state .nodes_data .itemsize
+ + (lua_Integer) lmt_node_memory_state .extra_data .allocated * (lua_Integer) lmt_node_memory_state .extra_data .itemsize
+ + (lua_Integer) lmt_token_memory_state.tokens_data .allocated * (lua_Integer) lmt_token_memory_state.tokens_data .itemsize
+ + (lua_Integer) lmt_fileio_state .io_buffer_data .allocated * (lua_Integer) lmt_fileio_state .io_buffer_data .itemsize
+ + (lua_Integer) lmt_input_state .input_stack_data .allocated * (lua_Integer) lmt_input_state .input_stack_data .itemsize
+ + (lua_Integer) lmt_input_state .in_stack_data .allocated * (lua_Integer) lmt_input_state .in_stack_data .itemsize
+ + (lua_Integer) lmt_nest_state .nest_data .allocated * (lua_Integer) lmt_nest_state .nest_data .itemsize
+ + (lua_Integer) lmt_input_state .parameter_stack_data.allocated * (lua_Integer) lmt_input_state .parameter_stack_data.itemsize
+ + (lua_Integer) lmt_save_state .save_stack_data .allocated * (lua_Integer) lmt_save_state .save_stack_data .itemsize
+ + (lua_Integer) lmt_hash_state .hash_data .allocated * (lua_Integer) lmt_hash_state .hash_data .itemsize
+ + (lua_Integer) lmt_fileio_state .io_buffer_data .allocated * (lua_Integer) lmt_fileio_state .io_buffer_data .itemsize
+ + (lua_Integer) lmt_font_state .font_data .allocated * (lua_Integer) lmt_font_state .font_data .itemsize
+ + (lua_Integer) lmt_language_state .language_data .allocated * (lua_Integer) lmt_language_state .language_data .itemsize
+ + (lua_Integer) lmt_mark_state .mark_data .allocated * (lua_Integer) lmt_mark_state .mark_data .itemsize
+ + (lua_Integer) lmt_insert_state .insert_data .allocated * (lua_Integer) lmt_insert_state .insert_data .itemsize
+ + (lua_Integer) lmt_sparse_state .sparse_data .allocated * (lua_Integer) lmt_sparse_state .sparse_data .itemsize
+ ;
+ lua_createtable(L, 0, 4);
+ lua_set_integer_by_key(L, "approximate", (int) approximate);
+ return 1;
+}
+
+static int statslib_luastate(lua_State *L)
+{
+ lua_createtable(L, 0, 6);
+ lua_set_integer_by_key(L, "functionsize", lmt_lua_state.function_table_size);
+ lua_set_integer_by_key(L, "propertiessize", lmt_node_memory_state.node_properties_table_size);
+ lua_set_integer_by_key(L, "bytecodes", lmt_lua_state.bytecode_max);
+ lua_set_integer_by_key(L, "bytecodebytes", lmt_lua_state.bytecode_bytes);
+ lua_set_integer_by_key(L, "statebytes", lmt_lua_state.used_bytes);
+ lua_set_integer_by_key(L, "statebytesmax", lmt_lua_state.used_bytes_max);
+ return 1;
+}
+
+static int statslib_errorstate(lua_State* L)
+{
+ lua_createtable(L, 0, 3);
+ lua_set_string_by_key(L, "error", lmt_error_state.last_error);
+ lua_set_string_by_key(L, "errorcontext", lmt_error_state.last_error_context);
+ lua_set_string_by_key(L, "luaerror", lmt_error_state.last_lua_error);
+ return 1;
+}
+
+static int statslib_warningstate(lua_State* L)
+{
+ lua_createtable(L, 0, 2);
+ lua_set_string_by_key(L, "warningtag", lmt_error_state.last_warning_tag);
+ lua_set_string_by_key(L, "warning", lmt_error_state.last_warning);
+ return 1;
+}
+
+static int statslib_aux_stats_name_to_id(const char *name, statistic_entry stats[])
+{
+ for (int i = 0; stats[i].name; i++) {
+ if (strcmp (stats[i].name, name) == 0) {
+ return i;
+ }
+ }
+ return -1;
+}
+
+static int statslib_aux_limits_state(lua_State* L, limits_data *data)
+{
+ lua_createtable(L, 0, 4);
+ lua_set_integer_by_key(L, "set", data->size);
+ lua_set_integer_by_key(L, "min", data->minimum);
+ lua_set_integer_by_key(L, "max", data->maximum);
+ lua_set_integer_by_key(L, "top", data->top);
+ return 1;
+}
+
+static int statslib_aux_memory_state(lua_State* L, memory_data *data)
+{
+ lua_createtable(L, 0, 9);
+ lua_set_integer_by_key(L, "set", data->size); /*tex Can |memory_data_unset|. */
+ lua_set_integer_by_key(L, "min", data->minimum);
+ lua_set_integer_by_key(L, "max", data->maximum);
+ lua_set_integer_by_key(L, "mem", data->allocated);
+ lua_set_integer_by_key(L, "all", data->allocated > 0 ? (int) lmt_rounded(((double) data->allocated) * ((double) data->itemsize)) : data->allocated);
+ lua_set_integer_by_key(L, "top", data->top - data->offset);
+ lua_set_integer_by_key(L, "ptr", data->ptr - data->offset);
+ lua_set_integer_by_key(L, "ini", data->initial); /*tex Can |memory_data_unset|. */
+ lua_set_integer_by_key(L, "stp", data->step);
+ // lua_set_integer_by_key(L, "off", data->offset);
+ return 1;
+}
+
+static int statslib_errorlinestate (lua_State* L) { return statslib_aux_limits_state(L, &lmt_error_state .line_limits); }
+static int statslib_halferrorlinestate(lua_State* L) { return statslib_aux_limits_state(L, &lmt_error_state .half_line_limits); }
+static int statslib_expandstate (lua_State* L) { return statslib_aux_limits_state(L, &lmt_expand_state .limits); }
+static int statslib_stringstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_string_pool_state .string_pool_data); }
+static int statslib_poolstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_string_pool_state .string_body_data); }
+static int statslib_lookupstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_hash_state .eqtb_data); }
+static int statslib_hashstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_hash_state .hash_data); }
+static int statslib_nodestate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_node_memory_state .nodes_data); }
+static int statslib_extrastate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_node_memory_state .extra_data); }
+static int statslib_tokenstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_token_memory_state.tokens_data); }
+static int statslib_inputstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_input_state .input_stack_data); }
+static int statslib_filestate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_input_state .in_stack_data); }
+static int statslib_parameterstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_input_state .parameter_stack_data); }
+static int statslib_neststate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_nest_state .nest_data); }
+static int statslib_savestate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_save_state .save_stack_data); }
+static int statslib_bufferstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_fileio_state .io_buffer_data); }
+static int statslib_fontstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_font_state .font_data); }
+static int statslib_languagestate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_language_state .language_data); }
+static int statslib_markstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_mark_state .mark_data); }
+static int statslib_insertstate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_insert_state .insert_data); }
+static int statslib_sparsestate (lua_State* L) { return statslib_aux_memory_state(L, &lmt_sparse_state .sparse_data); }
+
+static int statslib_readstate(lua_State *L)
+{
+ lua_createtable(L, 0, 4);
+ lua_set_string_by_key (L, "filename", tex_current_input_file_name());
+ lua_set_integer_by_key(L, "iocode", lmt_input_state.cur_input.name > io_file_input_code ? io_file_input_code : lmt_input_state.cur_input.name);
+ lua_set_integer_by_key(L, "linenumber", lmt_input_state.input_line);
+ lua_set_integer_by_key(L, "skiplinenumber", lmt_condition_state.skip_line);
+ return 1;
+}
+
+static int statslib_enginestate(lua_State *L)
+{
+ lua_createtable(L, 0, 13);
+ lua_set_string_by_key (L, "logfilename", lmt_fileio_state.log_name);
+ lua_set_string_by_key (L, "banner", lmt_engine_state.luatex_banner);
+ lua_set_string_by_key (L, "luatex_engine", lmt_engine_state.engine_name);
+ lua_set_integer_by_key(L, "luatex_version", lmt_version_state.version);
+ lua_set_integer_by_key(L, "luatex_revision", lmt_version_state.revision);
+ lua_set_string_by_key(L, "luatex_verbose", lmt_version_state.verbose);
+ lua_set_integer_by_key(L, "development_id", lmt_version_state.developmentid);
+ lua_set_string_by_key (L, "copyright", lmt_version_state.copyright);
+ lua_set_integer_by_key(L, "format_id", lmt_version_state.formatid);
+ lua_set_integer_by_key(L, "tex_hash_size", hash_size);
+ lua_set_string_by_key (L, "used_compiler", lmt_version_state.compiler);
+ // lua_set_string_by_key (L, "used_libc", lmt_version_state.libc);
+ lua_set_integer_by_key(L, "run_state", lmt_main_state.run_state);
+ lua_set_boolean_by_key(L, "permit_loadlib", lmt_engine_state.permit_loadlib);
+ return 1;
+}
+
+static int statslib_aux_getstat_indeed(lua_State *L, statistic_entry stats[], int i)
+{
+ switch (stats[i].type) {
+ case 'S':
+ /* string function pointer, no copy */
+ {
+ const char *st = (*(constfunc) stats[i].value)();
+ lua_pushstring(L, st);
+ /* No freeing here! */
+ break;
+ }
+ // case 's':
+ // /* string function pointer, copy */
+ // {
+ // char *st = (*(charfunc) stats[i].value)();
+ // lua_pushstring(L, st);
+ // lmt_memory_free(st);
+ // break;
+ // }
+ // case 'N':
+ // /* number function pointer */
+ // lua_pushnumber(L, (*(numfunc) stats[i].value)());
+ // break;
+ // case 'G':
+ // /* integer function pointer */
+ // lua_pushinteger(L, (*(intfunc) stats[i].value)());
+ // break;
+ case 'g':
+ /* integer pointer */
+ lua_pushinteger(L, *(int *) (stats[i].value));
+ break;
+ case 'c':
+ /* string pointer */
+ lua_pushstring(L, *(const char **) (stats[i].value));
+ break;
+ // case 'n': /* node */
+ // /* node pointer */
+ // if (*(halfword*) (stats[i].value)) {
+ // lmt_push_node_fast(L, *(halfword *) (stats[i].value));
+ // } else {
+ // lua_pushnil(L);
+ // }
+ // break;
+ case 'b':
+ /* boolean integer pointer */
+ lua_pushboolean(L, *(int *) (stats[i].value));
+ break;
+ case 'f':
+ (*(luafunc) stats[i].value)(L);
+ break;
+ default:
+ /* nothing reasonable */
+ lua_pushnil(L);
+ break;
+ }
+ return 1;
+}
+
+static int statslib_aux_getstats_indeed(lua_State *L, statistic_entry stats[])
+{
+ if (lua_type(L, -1) == LUA_TSTRING) {
+ const char *st = lua_tostring(L, -1);
+ int i = statslib_aux_stats_name_to_id(st, stats);
+ if (i >= 0) {
+ return statslib_aux_getstat_indeed(L, stats, i);
+ }
+ }
+ return 0;
+}
+
+static int statslib_getconstants(lua_State *L)
+{
+ lua_createtable(L, 0, 100);
+
+ lua_set_integer_by_key(L, "no_catcode_table", no_catcode_table_preset);
+ lua_set_integer_by_key(L, "default_catcode_table", default_catcode_table_preset);
+
+ lua_set_cardinal_by_key(L, "max_cardinal", max_cardinal);
+ lua_set_cardinal_by_key(L, "min_cardinal", min_cardinal);
+ lua_set_integer_by_key(L, "max_integer", max_integer);
+ lua_set_integer_by_key(L, "min_integer", min_integer);
+ lua_set_integer_by_key(L, "max_dimen", max_dimen);
+ lua_set_integer_by_key(L, "min_dimen", min_dimen);
+ lua_set_integer_by_key(L, "min_data_value", min_data_value);
+ lua_set_integer_by_key(L, "max_data_value", max_data_value);
+ lua_set_integer_by_key(L, "max_half_value", max_half_value);
+
+ lua_set_integer_by_key(L, "max_limited_scale", max_limited_scale);
+
+ lua_set_integer_by_key(L, "one_bp", one_bp);
+
+ lua_set_integer_by_key(L, "infinity", infinity);
+ lua_set_integer_by_key(L, "min_infinity", min_infinity);
+ lua_set_integer_by_key(L, "awful_bad", awful_bad);
+ lua_set_integer_by_key(L, "infinite_bad", infinite_bad);
+ lua_set_integer_by_key(L, "infinite_penalty", infinite_penalty);
+ lua_set_integer_by_key(L, "eject_penalty", eject_penalty);
+ lua_set_integer_by_key(L, "deplorable", deplorable);
+ lua_set_integer_by_key(L, "large_width_excess", large_width_excess);
+ lua_set_integer_by_key(L, "small_stretchability", small_stretchability);
+ lua_set_integer_by_key(L, "decent_criterium", decent_criterium);
+ lua_set_integer_by_key(L, "loose_criterium", loose_criterium);
+
+ lua_set_integer_by_key(L, "default_rule", default_rule);
+ lua_set_integer_by_key(L, "ignore_depth", ignore_depth);
+
+ lua_set_integer_by_key(L, "min_quarterword", min_quarterword);
+ lua_set_integer_by_key(L, "max_quarterword", max_quarterword);
+
+ lua_set_integer_by_key(L, "min_halfword", min_halfword);
+ lua_set_integer_by_key(L, "max_halfword", max_halfword);
+
+ lua_set_integer_by_key(L, "null_flag", null_flag);
+ lua_set_integer_by_key(L, "zero_glue", zero_glue);
+ lua_set_integer_by_key(L, "unity", unity);
+ lua_set_integer_by_key(L, "two", two);
+ lua_set_integer_by_key(L, "null", null);
+ lua_set_integer_by_key(L, "null_font", null_font);
+
+ lua_set_integer_by_key(L, "unused_attribute_value", unused_attribute_value);
+ lua_set_integer_by_key(L, "unused_state_value", unused_state_value);
+ lua_set_integer_by_key(L, "unused_script_value", unused_script_value);
+
+ lua_set_integer_by_key(L, "preset_rule_thickness", preset_rule_thickness);
+ lua_set_integer_by_key(L, "running_rule", null_flag);
+
+ lua_set_integer_by_key(L, "max_char_code", max_char_code);
+ lua_set_integer_by_key(L, "min_space_factor", min_space_factor);
+ lua_set_integer_by_key(L, "max_space_factor", max_space_factor);
+ lua_set_integer_by_key(L, "default_space_factor", default_space_factor);
+ lua_set_integer_by_key(L, "default_tolerance", default_tolerance);
+ lua_set_integer_by_key(L, "default_hangafter", default_hangafter);
+ lua_set_integer_by_key(L, "default_deadcycles", default_deadcycles);
+ lua_set_integer_by_key(L, "default_pre_display_gap", default_pre_display_gap);
+ lua_set_integer_by_key(L, "default_eqno_gap_step", default_eqno_gap_step);
+
+ lua_set_integer_by_key(L, "default_output_box", default_output_box);
+
+ lua_set_integer_by_key(L, "max_n_of_fonts", max_n_of_fonts);
+ lua_set_integer_by_key(L, "max_n_of_bytecodes", max_n_of_bytecodes);
+ lua_set_integer_by_key(L, "max_n_of_math_families", max_n_of_math_families);
+ lua_set_integer_by_key(L, "max_n_of_languages", max_n_of_languages);
+ lua_set_integer_by_key(L, "max_n_of_catcode_tables", max_n_of_catcode_tables);
+ /* lua_set_integer_by_key(L, "max_n_of_hjcode_tables", max_n_of_hjcode_tables); */ /* meaningless */
+ lua_set_integer_by_key(L, "max_n_of_marks", max_n_of_marks);
+
+ lua_set_integer_by_key(L, "max_character_code", max_character_code);
+ lua_set_integer_by_key(L, "max_mark_index", max_mark_index);
+
+ lua_set_integer_by_key(L, "max_toks_register_index", max_toks_register_index);
+ lua_set_integer_by_key(L, "max_box_register_index", max_box_register_index);
+ lua_set_integer_by_key(L, "max_int_register_index", max_int_register_index);
+ lua_set_integer_by_key(L, "max_dimen_register_index", max_dimen_register_index);
+ lua_set_integer_by_key(L, "max_attribute_register_index", max_attribute_register_index);
+ lua_set_integer_by_key(L, "max_glue_register_index", max_glue_register_index);
+ lua_set_integer_by_key(L, "max_mu_glue_register_index", max_mu_glue_register_index);
+
+ lua_set_integer_by_key(L, "max_bytecode_index", max_bytecode_index);
+ lua_set_integer_by_key(L, "max_math_family_index", max_math_family_index);
+ lua_set_integer_by_key(L, "max_math_class_code", max_math_class_code);
+ lua_set_integer_by_key(L, "max_function_reference", max_function_reference);
+ lua_set_integer_by_key(L, "max_category_code", max_category_code);
+
+ lua_set_integer_by_key(L, "max_newline_character", max_newline_character);
+
+ lua_set_integer_by_key(L, "max_size_of_word", max_size_of_word);
+
+ lua_set_integer_by_key(L, "tex_hash_size", hash_size);
+ lua_set_integer_by_key(L, "tex_hash_prime", hash_prime);
+ lua_set_integer_by_key(L, "tex_eqtb_size", eqtb_size);
+
+ lua_set_integer_by_key(L, "math_begin_class", math_begin_class);
+ lua_set_integer_by_key(L, "math_end_class", math_end_class);
+ lua_set_integer_by_key(L, "unused_math_family", unused_math_family);
+ lua_set_integer_by_key(L, "unused_math_style", unused_math_style);
+ lua_set_integer_by_key(L, "assumed_math_control", assumed_math_control);
+
+ lua_set_integer_by_key(L, "undefined_math_parameter", undefined_math_parameter);
+ return 1;
+}
+
+static struct statistic_entry statslib_entries[] = {
+
+ /*tex But these are now collected in tables: */
+
+ { .name = "enginestate", .value = &statslib_enginestate, .type = 'f' },
+ { .name = "errorlinestate", .value = &statslib_errorlinestate, .type = 'f' },
+ { .name = "halferrorlinestate", .value = &statslib_halferrorlinestate, .type = 'f' },
+ { .name = "expandstate", .value = &statslib_expandstate, .type = 'f' },
+ { .name = "stringstate", .value = &statslib_stringstate, .type = 'f' },
+ { .name = "poolstate", .value = &statslib_poolstate, .type = 'f' },
+ { .name = "hashstate", .value = &statslib_hashstate, .type = 'f' },
+ { .name = "lookupstate", .value = &statslib_lookupstate, .type = 'f' },
+ { .name = "nodestate", .value = &statslib_nodestate, .type = 'f' },
+ { .name = "extrastate", .value = &statslib_extrastate, .type = 'f' },
+ { .name = "tokenstate", .value = &statslib_tokenstate, .type = 'f' },
+ { .name = "inputstate", .value = &statslib_inputstate, .type = 'f' },
+ { .name = "filestate", .value = &statslib_filestate, .type = 'f' },
+ { .name = "parameterstate", .value = &statslib_parameterstate, .type = 'f' },
+ { .name = "neststate", .value = &statslib_neststate, .type = 'f' },
+ { .name = "savestate", .value = &statslib_savestate, .type = 'f' },
+ { .name = "bufferstate", .value = &statslib_bufferstate, .type = 'f' },
+ { .name = "texstate", .value = &statslib_texstate, .type = 'f' },
+ { .name = "luastate", .value = &statslib_luastate, .type = 'f' },
+ { .name = "callbackstate", .value = &statslib_callbackstate, .type = 'f' },
+ { .name = "errorstate", .value = &statslib_errorstate, .type = 'f' },
+ { .name = "warningstate", .value = &statslib_warningstate, .type = 'f' },
+ { .name = "readstate", .value = &statslib_readstate, .type = 'f' },
+ { .name = "fontstate", .value = &statslib_fontstate, .type = 'f' },
+ { .name = "languagestate", .value = &statslib_languagestate, .type = 'f' },
+ { .name = "markstate", .value = &statslib_markstate, .type = 'f' },
+ { .name = "insertstate", .value = &statslib_insertstate, .type = 'f' },
+ { .name = "sparsestate", .value = &statslib_sparsestate, .type = 'f' },
+
+ /*tex We keep these as direct accessible keys: */
+
+ { .name = "filename", .value = (void *) &tex_current_input_file_name, .type = 'S' },
+ { .name = "logfilename", .value = (void *) &lmt_fileio_state.log_name, .type = 'c' },
+ { .name = "banner", .value = (void *) &lmt_engine_state.luatex_banner, .type = 'c' },
+ { .name = "luatex_engine", .value = (void *) &lmt_engine_state.engine_name, .type = 'c' },
+ { .name = "luatex_version", .value = (void *) &lmt_version_state.version, .type = 'g' },
+ { .name = "luatex_revision", .value = (void *) &lmt_version_state.revision, .type = 'g' },
+ { .name = "luatex_verbose", .value = (void *) &lmt_version_state.verbose, .type = 'c' },
+ { .name = "copyright", .value = (void *) &lmt_version_state.copyright, .type = 'c' },
+ { .name = "development_id", .value = (void *) &lmt_version_state.developmentid, .type = 'g' },
+ { .name = "format_id", .value = (void *) &lmt_version_state.formatid, .type = 'g' },
+ { .name = "used_compiler", .value = (void *) &lmt_version_state.compiler, .type = 'c' },
+ { .name = "run_state", .value = (void *) &lmt_main_state.run_state, .type = 'g' },
+ { .name = "permit_loadlib", .value = (void *) &lmt_engine_state.permit_loadlib, .type = 'b' },
+
+ { .name = NULL, .value = NULL, .type = 0 },
+};
+
+static struct statistic_entry statslib_entries_only[] = {
+ { .name = "filename", .value = (void *) &tex_current_input_file_name, .type = 'S' },
+ { .name = "banner", .value = (void *) &lmt_engine_state.luatex_banner, .type = 'c' },
+ { .name = "luatex_engine", .value = (void *) &lmt_engine_state.engine_name, .type = 'c' },
+ { .name = "luatex_version", .value = (void *) &lmt_version_state.version, .type = 'g' },
+ { .name = "luatex_revision", .value = (void *) &lmt_version_state.revision, .type = 'g' },
+ { .name = "luatex_verbose", .value = (void *) &lmt_version_state.verbose, .type = 'c' },
+ { .name = "copyright", .value = (void *) &lmt_version_state.copyright, .type = 'c' },
+ { .name = "development_id", .value = (void *) &lmt_version_state.developmentid, .type = 'g' },
+ { .name = "format_id", .value = (void *) &lmt_version_state.formatid, .type = 'g' },
+ { .name = "used_compiler", .value = (void *) &lmt_version_state.compiler, .type = 'c' },
+
+ { .name = NULL, .value = NULL, .type = 0 },
+};
+
+static int statslib_aux_getstats(lua_State *L)
+{
+ return statslib_aux_getstats_indeed(L, statslib_entries);
+}
+
+static int statslib_aux_getstats_only(lua_State *L)
+{
+ return statslib_aux_getstats_indeed(L, statslib_entries_only);
+}
+
+static int statslib_aux_statslist(lua_State *L, statistic_entry stats[])
+{
+ lua_createtable(L, 0, 60);
+ for (int i = 0; stats[i].name; i++) {
+ lua_pushstring(L, stats[i].name);
+ statslib_aux_getstat_indeed(L, stats, i);
+ lua_rawset(L, -3);
+ }
+ return 1;
+}
+
+static int statslib_statslist(lua_State *L)
+{
+ return statslib_aux_statslist(L, statslib_entries);
+}
+
+static int statslib_statslist_only(lua_State *L)
+{
+ return statslib_aux_statslist(L, statslib_entries_only);
+}
+
+static int statslib_resetmessages(lua_State *L)
+{
+ (void) (L);
+ lmt_memory_free(lmt_error_state.last_warning);
+ lmt_memory_free(lmt_error_state.last_warning_tag);
+ lmt_memory_free(lmt_error_state.last_error);
+ lmt_memory_free(lmt_error_state.last_lua_error);
+ lmt_error_state.last_warning = NULL;
+ lmt_error_state.last_warning_tag = NULL;
+ lmt_error_state.last_error = NULL;
+ lmt_error_state.last_lua_error = NULL;
+ return 0;
+}
+
+static const struct luaL_Reg statslib_function_list[] = {
+ { "list", statslib_statslist }, /* for old times sake */
+ { "getconstants", statslib_getconstants },
+ { "resetmessages", statslib_resetmessages },
+
+ { "gettexstate", statslib_texstate },
+ { "getluastate", statslib_luastate },
+ { "geterrorstate", statslib_errorstate },
+ { "getwarningstate", statslib_warningstate },
+ { "getreadstate", statslib_readstate },
+ { "getcallbackstate", statslib_callbackstate },
+
+ { "geterrorlinestate", statslib_errorlinestate },
+ { "gethalferrorlinestate", statslib_halferrorlinestate },
+ { "getexpandstate", statslib_expandstate },
+
+ { "getstringstate", statslib_stringstate },
+ { "getpoolstate", statslib_poolstate },
+ { "gethashstate", statslib_hashstate },
+ { "getlookupstate", statslib_lookupstate },
+ { "getnodestate", statslib_nodestate },
+ { "getextrastate", statslib_extrastate },
+ { "gettokenstate", statslib_tokenstate },
+ { "getinputstate", statslib_inputstate },
+ { "getfilestate", statslib_filestate },
+ { "getparameterstate", statslib_parameterstate },
+ { "getneststate", statslib_neststate },
+ { "getsavestate", statslib_savestate },
+ { "getbufferstate", statslib_bufferstate },
+ { "getfontstate", statslib_fontstate },
+ { "getlanguagestate", statslib_languagestate },
+ { "getmarkstate", statslib_markstate },
+ { "getinsertstate", statslib_insertstate },
+ { "getsparsestate", statslib_sparsestate },
+
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg statslib_function_list_only[] = {
+ { "list", statslib_statslist_only },
+ { NULL, NULL },
+};
+
+int luaopen_status(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, lmt_engine_state.lua_only ? statslib_function_list_only : statslib_function_list, 0);
+ luaL_newmetatable(L, STATS_METATABLE);
+ lua_pushstring(L, "__index");
+ lua_pushcfunction(L, lmt_engine_state.lua_only ? statslib_aux_getstats_only : statslib_aux_getstats);
+ lua_settable(L, -3);
+ lua_setmetatable(L, -2); /*tex meta to itself */
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmttexiolib.c b/source/luametatex/source/lua/lmttexiolib.c
new file mode 100644
index 000000000..f7f7751d8
--- /dev/null
+++ b/source/luametatex/source/lua/lmttexiolib.c
@@ -0,0 +1,307 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This is a small module that deals with logging. We inherit from \TEX\ the dualistic model
+ of console (terminal) and log file. One can write to one of them or both at the same time.
+ We also inherit most of the logic that deals with going to a new line but we don't have the
+ escaping with |^^| any longer: we live in \UNICODE\ times now. Because \TEX\ itself often
+ outputs single characters and/or small strings, the console actually can have some real
+ impact on performance: updating the display, rendering with complex fonts, intercepting
+ \ANSI\ control sequences, scrolling, etc.
+
+*/
+
+# include "luametatex.h"
+
+FILE *lmt_valid_file(lua_State *L) {
+ luaL_Stream *p = (luaL_Stream *) lua_touserdata(L, 1);
+ if (p && lua_getmetatable(L, 1)) {
+ luaL_getmetatable(L, LUA_FILEHANDLE);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ return (p && (p)->closef) ? p->f : NULL;
+ }
+ return NULL;
+}
+
+typedef void (*texio_printer) (const char *);
+
+inline static int texiolib_aux_get_selector_value(lua_State *L, int i, int *l, int dflt)
+{
+ switch (lua_type(L, i)) {
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, i);
+ if (lua_key_eq(s, logfile)) {
+ *l = logfile_selector_code;
+ } else if (lua_key_eq(s, terminal)) {
+ *l = terminal_selector_code;
+ } else if (lua_key_eq(s, terminal_and_logfile)) {
+ *l = terminal_and_logfile_selector_code;
+ } else {
+ *l = dflt;
+ }
+ return 1;
+ }
+ case LUA_TNUMBER:
+ {
+ int n = lmt_tointeger(L, i);
+ *l = n >= terminal_selector_code && n <= terminal_and_logfile_selector_code ? n : dflt;
+ return 1;
+ }
+ default:
+ return luaL_error(L, "(first) argument is not 'terminal_and_logfile', 'terminal' or 'logfile'");
+ }
+}
+
+static void texiolib_aux_print(lua_State *L, int n, texio_printer printfunction, const char *dflt)
+{
+ int i = 1;
+ int saved_selector = lmt_print_state.selector;
+ if (n > 1 && texiolib_aux_get_selector_value(L, i, &lmt_print_state.selector, terminal_selector_code)) {
+ i++;
+ }
+ switch (lmt_print_state.selector) {
+ case terminal_and_logfile_selector_code:
+ case logfile_selector_code:
+ case terminal_selector_code:
+ if (i <= n) {
+ do {
+ switch (lua_type(L, i)) {
+ case LUA_TNIL:
+ break;
+ case LUA_TBOOLEAN:
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ printfunction(lua_tostring(L, i));
+ break;
+ default:
+ luaL_error(L, "argument is not a string, number or boolean");
+ }
+ i++;
+ } while (i <= n);
+ } else if (dflt) {
+ printfunction(dflt);
+ }
+ break;
+ }
+ lmt_print_state.selector = saved_selector;
+}
+
+static void texiolib_aux_print_selector(lua_State *L, int n, texio_printer printfunction, const char *dflt)
+{
+ int saved_selector = lmt_print_state.selector;
+ texiolib_aux_get_selector_value(L, 1, &lmt_print_state.selector, no_print_selector_code);
+ switch (lmt_print_state.selector) {
+ case terminal_and_logfile_selector_code:
+ case logfile_selector_code:
+ case terminal_selector_code:
+ {
+ if (n > 1) {
+ for (int i = 2; i <= n; i++) {
+ switch (lua_type(L, i)) {
+ case LUA_TNIL:
+ break;
+ case LUA_TBOOLEAN:
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ printfunction(lua_tostring(L, i));
+ break;
+ default:
+ luaL_error(L, "argument is not a string, number or boolean");
+ }
+ };
+ } else if (dflt) {
+ printfunction(dflt);
+ }
+ break;
+ }
+ }
+ lmt_print_state.selector = saved_selector;
+}
+
+static void texiolib_aux_print_stdout(lua_State *L, const char *extra)
+{
+ int i = 1;
+ int l = terminal_and_logfile_selector_code;
+ int n = lua_gettop(L);
+ if (n > 1 && texiolib_aux_get_selector_value(L, i, &l, terminal_selector_code)) {
+ i++;
+ }
+ for (; i <= n; i++) {
+ if (lua_isstring(L, i)) { /* or number */
+ const char *s = lua_tostring(L, i);
+ if (l == terminal_and_logfile_selector_code || l == terminal_selector_code) {
+ fputs(extra, stdout);
+ fputs(s, stdout);
+ }
+ if (l == terminal_and_logfile_selector_code || l == logfile_selector_code) {
+ if (lmt_print_state.loggable_info) {
+ char *v = (char*) lmt_memory_malloc(strlen(lmt_print_state.loggable_info) + strlen(extra) + strlen(s) + 1);
+ if (v) {
+ sprintf(v, "%s%s%s", lmt_print_state.loggable_info, extra, s);
+ }
+ lmt_memory_free(lmt_print_state.loggable_info);
+ lmt_print_state.loggable_info = v;
+ } else {
+ lmt_print_state.loggable_info = lmt_memory_strdup(s);
+ }
+ }
+ }
+ }
+}
+
+static void texiolib_aux_print_nlp_str(const char *s)
+{
+ tex_print_nlp();
+ tex_print_str(s);
+}
+
+static int texiolib_write(lua_State *L)
+{
+ if (lmt_main_state.ready_already == output_disabled_state || ! lmt_fileio_state.job_name) {
+ texiolib_aux_print_stdout(L, "");
+ } else {
+ int n = lua_gettop(L);
+ if (n > 0) {
+ texiolib_aux_print(L, n, tex_print_str, NULL);
+ } else {
+ /*tex We silently ignore bogus calls. */
+ }
+ }
+ return 0;
+}
+
+
+static int texiolib_write_nl(lua_State *L)
+{
+ if (lmt_main_state.ready_already == output_disabled_state || ! lmt_fileio_state.job_name) {
+ texiolib_aux_print_stdout(L, "\n");
+ } else {
+ int n = lua_gettop(L);
+ if (n > 0) {
+ texiolib_aux_print(L, n, texiolib_aux_print_nlp_str, "\n");
+ } else {
+ /*tex We silently ignore bogus calls. */
+ }
+ }
+ return 0;
+}
+
+static int texiolib_write_selector(lua_State *L)
+{
+ if (lmt_main_state.ready_already == output_disabled_state || ! lmt_fileio_state.job_name) {
+ texiolib_aux_print_stdout(L, "");
+ } else {
+ int n = lua_gettop(L);
+ if (n > 1) {
+ texiolib_aux_print_selector(L, n, tex_print_str, NULL);
+ } else {
+ /*tex We silently ignore bogus calls. */
+ }
+ }
+ return 0;
+}
+
+
+static int texiolib_write_selector_nl(lua_State *L)
+{
+ if (lmt_main_state.ready_already == output_disabled_state || ! lmt_fileio_state.job_name) {
+ texiolib_aux_print_stdout(L, "\n");
+ } else {
+ int n = lua_gettop(L);
+ if (n > 1) {
+ texiolib_aux_print_selector(L, n, texiolib_aux_print_nlp_str, "");
+ } else {
+ /*tex We silently ignore bogus calls. */
+ }
+ }
+ return 0;
+}
+
+static int texiolib_write_selector_lf(lua_State *L)
+{
+ if (lmt_main_state.ready_already == output_disabled_state || ! lmt_fileio_state.job_name) {
+ texiolib_aux_print_stdout(L, "\n");
+ } else {
+ int n = lua_gettop(L);
+ if (n >= 1) {
+ texiolib_aux_print_selector(L, n, texiolib_aux_print_nlp_str, "");
+ } else {
+ /*tex We silently ignore bogus calls. */
+ }
+ }
+ return 0;
+}
+
+/*tex At the point this function is called, the selector is log_only. */
+
+static int texiolib_closeinput(lua_State *L)
+{
+ (void) (L);
+ if (lmt_input_state.cur_input.index > 0) {
+ tex_end_token_list();
+ tex_end_file_reading();
+ }
+ return 0 ;
+}
+
+/*tex
+ This is a private hack, handy for testing runtime math font patches in lfg files with a bit of
+ low level tracing. Setting the logfile is already handles by a callback so we don't support
+ string argument here because we'd end up in that callback which then returns the same logfile
+ name as we already had.
+*/
+
+static int texiolib_setlogfile(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ /* If not writeable then all goes into the void. */
+ if (! lmt_print_state.logfile) {
+ lmt_print_state.saved_logfile = lmt_print_state.logfile;
+ lmt_print_state.saved_logfile_offset = lmt_print_state.logfile_offset;
+
+ }
+ lmt_print_state.logfile = f;
+ lmt_print_state.logfile_offset = 0;
+ } else if (lmt_print_state.logfile) {
+ lmt_print_state.logfile = lmt_print_state.saved_logfile;
+ lmt_print_state.logfile_offset = lmt_print_state.saved_logfile_offset;
+ }
+ return 0;
+}
+
+static const struct luaL_Reg texiolib_function_list[] = {
+ { "write", texiolib_write },
+ { "writenl", texiolib_write_nl },
+ { "write_nl", texiolib_write_nl }, /* depricated */
+ { "writeselector", texiolib_write_selector },
+ { "writeselectornl", texiolib_write_selector_nl },
+ { "writeselectorlf", texiolib_write_selector_lf },
+ { "closeinput", texiolib_closeinput },
+ { "setlogfile", texiolib_setlogfile },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg texiolib_function_list_only[] = {
+ { "write", texiolib_write },
+ { "writenl", texiolib_write_nl },
+ { "write_nl", texiolib_write_nl }, /* depricated */
+ { "writeselector", texiolib_write_selector },
+ { "writeselectornl", texiolib_write_selector_nl },
+ { "writeselectorlf", texiolib_write_selector_lf },
+ { NULL, NULL },
+};
+
+int luaopen_texio(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, lmt_engine_state.lua_only ? texiolib_function_list_only : texiolib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmttexiolib.h b/source/luametatex/source/lua/lmttexiolib.h
new file mode 100644
index 000000000..e690befa7
--- /dev/null
+++ b/source/luametatex/source/lua/lmttexiolib.h
@@ -0,0 +1,13 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LTEXIOLIB_H
+# define LMT_LTEXIOLIB_H
+
+# include <stdio.h>
+# include <lua.h>
+
+extern FILE *lmt_valid_file (lua_State *L);
+
+# endif
diff --git a/source/luametatex/source/lua/lmttexlib.c b/source/luametatex/source/lua/lmttexlib.c
new file mode 100644
index 000000000..12510206a
--- /dev/null
+++ b/source/luametatex/source/lua/lmttexlib.c
@@ -0,0 +1,5580 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*
+
+ This module deals with access to some if the internal quanities of \TEX, like registers,
+ internal variables and all kind of lists. Because we provide access by name and/or number
+ (index) there is quite a bit of code here, and sometimes if can look a bit confusing.
+
+ The code here differs from \LUATEX\ in the sense that there are some more checks, a bit
+ more abstraction, more access and better performance. What we see here is the result of
+ years of experimenting and usage in \CONTEXT.
+
+ A remark about some of the special node lists that one can query: because some start with
+ a so called |temp| node, we have to set the |prev| link to |nil| because otherwise at the
+ \LUA\ end we expose that |temp| node and users are not suposed to touch them! In the setter
+ no |prev| link is set so we can presume that it's not used later on anyway; this is because
+ original \TEX\ has no |prev| links.
+
+ There is still room for improvement but I'll deal with that when I have a reason (read: when
+ I need something).
+
+*/
+
+# include "luametatex.h"
+
+/*tex
+ Due to the nature of the accessors, this is the module with most metatables. However, we
+ provide getters and setters too. Users can choose what they like most.
+*/
+
+# define TEX_METATABLE_ATTRIBUTE "tex.attribute"
+# define TEX_METATABLE_SKIP "tex.skip"
+# define TEX_METATABLE_GLUE "tex.glue"
+# define TEX_METATABLE_MUSKIP "tex.muskip"
+# define TEX_METATABLE_MUGLUE "tex.muglue"
+# define TEX_METATABLE_DIMEN "tex.dimen"
+# define TEX_METATABLE_COUNT "tex.count"
+# define TEX_METATABLE_TOKS "tex.toks"
+# define TEX_METATABLE_BOX "tex.box"
+# define TEX_METATABLE_SFCODE "tex.sfcode"
+# define TEX_METATABLE_LCCODE "tex.lccode"
+# define TEX_METATABLE_UCCODE "tex.uccode"
+# define TEX_METATABLE_HCCODE "tex.hccode"
+# define TEX_METATABLE_HMCODE "tex.hmcode"
+# define TEX_METATABLE_CATCODE "tex.catcode"
+# define TEX_METATABLE_MATHCODE "tex.mathcode"
+# define TEX_METATABLE_DELCODE "tex.delcode"
+# define TEX_METATABLE_LISTS "tex.lists"
+# define TEX_METATABLE_NEST "tex.nest"
+
+# define TEX_METATABLE_TEX "tex.tex"
+
+# define TEX_NEST_INSTANCE "tex.nest.instance"
+
+/*tex Let's share these. */
+
+static void texlib_aux_show_box_index_error(lua_State *L)
+{
+ luaL_error(L, "invalid index passed, range 0.." LMT_TOSTRING(max_box_register_index) " or name expected");
+}
+
+static void texlib_aux_show_character_error(lua_State *L, int i)
+{
+ luaL_error(L, "invalid character value %d passed, range 0.." LMT_TOSTRING(max_character_code), i);
+}
+
+static void texlib_aux_show_catcode_error(lua_State *L, int i)
+{
+ luaL_error(L, "invalid catcode %d passed, range 0.." LMT_TOSTRING(max_category_code), i);
+}
+
+static void texlib_aux_show_family_error(lua_State *L, int i)
+{
+ luaL_error(L, "invalid family %d passed, range 0.." LMT_TOSTRING(max_math_family_index), i);
+}
+
+static void texlib_aux_show_class_error(lua_State *L, int i)
+{
+ luaL_error(L, "invalid class %d passed, range 0.." LMT_TOSTRING(max_math_class_code), i);
+}
+
+static void texlib_aux_show_half_error(lua_State *L, int i)
+{
+ luaL_error(L, "invalid value %d passed, range 0.." LMT_TOSTRING(max_half_value), i);
+}
+
+/*tex
+
+ The rope model dates from the time that we had multiple \LUA\ instances so probably we can
+ simplify it a bit. On the other hand, it works, and also is upgraded for nodes, tokens and some
+ caching, so there is no real need to change anything now. A complication is anyway that input
+ states can nest and any change can mess it up.
+
+ We use a flag to indicate the kind of data that we are dealing with:
+
+ \starttabulate
+ \NC 0 \NC string \NC \NR
+ \NC 1 \NC char \NC \NR
+ \NC 2 \NC token \NC \NR
+ \NC 3 \NC node \NC \NR
+ \stoptabulate
+
+ By treating simple \ASCII\ characters special we prevent mallocs. We also pack small strings if
+ only because we have the room available anyway (due to padding).
+
+ For quite a while we used to have this:
+
+ \starttyping
+ typedef struct spindle_char {
+ unsigned char c1, c2, c3, c4;
+ } spindle_char;
+
+ typedef union spindle_data {
+ spindle_char c;
+ halfword h;
+ } spindle_data;
+ \stopttyping
+
+ The spindle and rope terminology was introduced by Taco early in the development of \LUATEX,
+ but in the meantime the datastructures have been adapted to deal with tokens and nodes. There
+ are also quite some optimizations in performance and memort usage (e.g. for small strings and
+ single characters).
+
+*/
+
+# define FULL_LINE 0
+# define PARTIAL_LINE 1
+# define PACKED_SIZE 8
+# define INITIAL_SIZE 32
+# define MAX_ROPE_CACHE 5000
+
+typedef union spindle_data {
+ unsigned char c[PACKED_SIZE];
+ halfword h;
+ char *t;
+} spindle_data;
+
+typedef struct spindle_rope {
+// char *text;
+ void *next;
+ union {
+ unsigned int tsize;
+ halfword tail;
+ };
+ unsigned char kind;
+ unsigned char partial;
+ short cattable;
+ spindle_data data;
+ /* alignment, not needed when we have c[PACKED_SIZE] */
+ /* int padding; */
+} spindle_rope;
+
+typedef struct spindle {
+ spindle_rope *head;
+ spindle_rope *tail;
+ int complete;
+ /* alignment */
+ int padding;
+} spindle;
+
+typedef struct spindle_state_info {
+ int spindle_size;
+ int spindle_index;
+ spindle *spindles;
+ spindle_rope *rope_cache;
+ int rope_count;
+ /* alignment */
+ int padding;
+} spindle_state_info ;
+
+static spindle_state_info lmt_spindle_state = {
+ .spindle_size = 0,
+ .spindle_index = 0,
+ .spindles = NULL,
+ .rope_cache = NULL,
+ .rope_count = 0,
+ .padding = 0
+};
+
+# define write_spindle lmt_spindle_state.spindles[lmt_spindle_state.spindle_index]
+# define read_spindle lmt_spindle_state.spindles[lmt_spindle_state.spindle_index - 1]
+
+inline static void texlib_aux_reset_spindle(int i)
+{
+ lmt_spindle_state.spindles[i].head = NULL;
+ lmt_spindle_state.spindles[i].tail = NULL;
+ lmt_spindle_state.spindles[i].complete = 0;
+}
+
+/*
+
+ Each rope takes 48 bytes. So, caching some 100 K ropes is not really a problem. In practice we
+ seldom reach that number anyway.
+
+*/
+
+inline static spindle_rope *texlib_aux_new_rope(void)
+{
+ spindle_rope *r;
+ if (lmt_spindle_state.rope_cache) {
+ r = lmt_spindle_state.rope_cache;
+ lmt_spindle_state.rope_cache = r->next;
+ } else {
+ r = (spindle_rope *) lmt_memory_malloc(sizeof(spindle_rope));
+ ++lmt_spindle_state.rope_count;
+ if (r) {
+ r->next = NULL;
+ } else {
+ tex_overflow_error("spindle", sizeof(spindle_rope));
+ }
+ }
+ return r;
+}
+
+inline static void texlib_aux_dispose_rope(spindle_rope *r)
+{
+ if (r) {
+ if (lmt_spindle_state.rope_count > MAX_ROPE_CACHE) {
+ lmt_memory_free(r);
+ --lmt_spindle_state.rope_count;
+ } else {
+ r->next = lmt_spindle_state.rope_cache;
+ lmt_spindle_state.rope_cache = r;
+ }
+ }
+}
+
+static void texlib_aux_initialize(void)
+{
+ lmt_spindle_state.spindles = lmt_memory_malloc(INITIAL_SIZE * sizeof(spindle));
+ if (lmt_spindle_state.spindles) {
+ for (int i = 0; i < INITIAL_SIZE; i++) {
+ texlib_aux_reset_spindle(i);
+ }
+ lmt_spindle_state.spindle_index = 0;
+ lmt_spindle_state.spindle_size = INITIAL_SIZE;
+ } else {
+ tex_overflow_error("spindle", sizeof(spindle));
+ }
+}
+
+/*tex
+ We could convert strings into tokenlists here but conceptually the split is cleaner.
+*/
+
+static int texlib_aux_store(lua_State *L, int i, int partial, int cattable)
+{
+ size_t tsize = 0;
+ spindle_rope *rn = NULL;
+ unsigned char kind = unset_lua_input;
+ spindle_data data = { .h = 0 };
+ switch (lua_type(L, i)) {
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ {
+ const char *sttemp = lua_tolstring(L, i, &tsize);
+ if (! partial) {
+ while (tsize > 0 && sttemp[tsize-1] == ' ') {
+ tsize--;
+ }
+ }
+ if (tsize > PACKED_SIZE) {
+ data.t = lmt_memory_malloc(tsize + 1);
+ kind = string_lua_input;
+ if (data.t) {
+ memcpy(data.t, sttemp, (tsize + 1));
+ break;
+ } else {
+ return 0;
+ }
+ } else {
+ /*tex
+ We could append to a previous but partial interferes and in practice it then
+ never can be done.
+ */
+ for (unsigned i = 0; i < tsize; i++) {
+ /*tex When we end up here we often don't have that many bytes. */
+ data.c[i] = (unsigned char) sttemp[i];
+ }
+ kind = packed_lua_input;
+ }
+ }
+ break;
+ case LUA_TUSERDATA:
+ {
+ void *p = lua_touserdata(L, i);
+ if (p && lua_getmetatable(L, i)) {
+ lua_get_metatablelua(token_instance);
+ if (lua_rawequal(L, -1, -2)) {
+ halfword token = (*((lua_token *) p)).token;
+ if (token_link(token)) {
+ /*tex
+ We cannnot pass a list unless we copy it, alternatively we can bump the ref count
+ but a quick test didn't work out that well.
+ */
+ token = token_link(token);
+ if (token) {
+ /*tex
+ We're now past the ref count head. Like below we could actually append to a
+ current rope but so far we seldom end up in here. Maybe I'll do add that later.
+ */
+ halfword t = null;
+ kind = token_list_lua_input;
+ data.h = tex_copy_token_list(token, &t);
+ tsize = t;
+ } else {
+ lua_pop(L, 2);
+ return 0;
+ }
+ } else {
+ /*tex
+ This is a little (mostly memory) optimization. We use token list instead of adding
+ single token ropes. That way we also need to push less back into the input. We
+ check for partial. This optimization is experimental and might go.
+ */
+ if (write_spindle.tail && write_spindle.tail->partial && partial == write_spindle.tail->partial) {
+ switch (write_spindle.tail->kind) {
+ case token_lua_input:
+ /*tex
+ Okay, we now allocate a token but still pushing into the input later has
+ less (nesting) overhead then because we process a sequence.
+ */
+ write_spindle.tail->kind = token_list_lua_input;
+ write_spindle.tail->data.h = tex_store_new_token(null, write_spindle.tail->data.h);
+ write_spindle.tail->tail = tex_store_new_token(write_spindle.tail->data.h, token_info(token));
+ break;
+ case token_list_lua_input:
+ /*tex
+ Normally we have short lists but it still pays off to store the tail
+ in |tsize| instead of locating the tail each time.
+ */
+ write_spindle.tail->tail = tex_store_new_token(write_spindle.tail->tail, token_info(token));
+ break;
+ default:
+ goto SINGLE;
+ }
+ lmt_token_state.luacstrings++; /* already set */
+ write_spindle.complete = 0; /* already set */
+ lua_pop(L, 2);
+ return 1;
+ }
+ /*tex The non-optimized case: */
+ SINGLE:
+ kind = token_lua_input;
+ data.h = token_info(token);
+ }
+ lua_pop(L, 2);
+ } else {
+ lua_get_metatablelua(node_instance);
+ if (lua_rawequal(L, -1, -3)) {
+ kind = node_lua_input;
+ data.h = *((halfword *) p);
+ lua_pop(L, 3);
+ } else {
+ lua_pop(L, 3);
+ return 0;
+ }
+ }
+ } else {
+ return 0;
+ }
+ }
+ break;
+ default:
+ return 0;
+ }
+ lmt_token_state.luacstrings++;
+ rn = texlib_aux_new_rope();
+ /* set */
+ rn->tsize = (unsigned) tsize;
+ rn->next = NULL;
+ rn->kind = kind;
+ rn->partial = (unsigned char) partial;
+ rn->cattable = (short) cattable;
+ rn->data = data;
+ /* add */
+ if (write_spindle.head) {
+ write_spindle.tail->next = rn;
+ } else {
+ write_spindle.head = rn;
+ }
+ write_spindle.tail = rn;
+ write_spindle.complete = 0;
+ return 1;
+}
+
+static void texlib_aux_store_token(halfword token, int partial, int cattable)
+{
+ spindle_rope *rn = texlib_aux_new_rope();
+ /* set */
+ rn->tsize = 0;
+ rn->next = NULL;
+ rn->kind = token_lua_input;
+ rn->partial = (unsigned char) partial;
+ rn->cattable = (short) cattable;
+ rn->data.h = token;
+ /* add */
+ if (write_spindle.head) {
+ write_spindle.tail->next = rn;
+ } else {
+ write_spindle.head = rn;
+ }
+ write_spindle.tail = rn;
+ write_spindle.complete = 0;
+ lmt_token_state.luacstrings++;
+}
+
+static void lmx_aux_store_string(char *str, int len, int cattable)
+{
+ spindle_rope *rn = texlib_aux_new_rope();
+ rn->data.h = 0; /* wipes */
+ if (len > PACKED_SIZE) {
+ rn->data.t = lmt_memory_malloc((size_t) len + 1);
+ if (rn->data.t) {
+ memcpy(rn->data.t, str, (size_t) len + 1);
+ } else {
+ len = 0;
+ }
+ rn->kind = string_lua_input;
+ } else {
+ for (int i = 0; i < len; i++) {
+ /* when we end up here we often don't have that many bytes */
+ rn->data.c[i] = (unsigned char) str[i];
+ }
+ rn->kind = packed_lua_input;
+ }
+ /* set */
+ rn->tsize = (unsigned) len;
+ rn->next = NULL;
+ rn->partial = FULL_LINE;
+ rn->cattable = (unsigned char) cattable;
+ /* add */
+ if (write_spindle.head) {
+ write_spindle.tail->next = rn;
+ } else {
+ write_spindle.head = rn;
+ }
+ write_spindle.tail = rn;
+ write_spindle.complete = 0;
+ lmt_token_state.luacstrings++;
+}
+
+static int texlib_aux_cprint(lua_State *L, int partial, int cattable, int startstrings)
+{
+ int n = lua_gettop(L);
+ int t = lua_type(L, startstrings);
+ if (n > startstrings && cattable != no_catcode_table_preset && t == LUA_TNUMBER) {
+ cattable = lmt_tointeger(L, startstrings);
+ ++startstrings;
+ if (cattable != default_catcode_table_preset && cattable != no_catcode_table_preset && ! tex_valid_catcode_table(cattable)) {
+ cattable = default_catcode_table_preset;
+ }
+ t = lua_type(L, startstrings);
+ }
+ if (t == LUA_TTABLE) {
+ for (int i = 1;; i++) {
+ lua_rawgeti(L, startstrings, i);
+ if (texlib_aux_store(L, -1, partial, cattable)) {
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ } else {
+ for (int i = startstrings; i <= n; i++) {
+ texlib_aux_store(L, i, partial, cattable);
+ }
+ }
+ return 0;
+}
+
+/*tex
+ We now feed back to be tokenized input from the \TEX\ end into the same handler as we use for
+ \LUA. It saves code but more important is that we no longer need the pseudo files and lines
+ that are kind of inefficient and depend on variable nodes.
+*/
+
+void lmt_cstring_store(char *str, int len, int cattable)
+{
+ lmx_aux_store_string(str, len, cattable);
+}
+
+void lmt_tstring_store(strnumber s, int cattable)
+{
+ lmx_aux_store_string((char *) str_string(s), (int) str_length(s), cattable);
+}
+
+/*tex
+ This is a bit of a dirty trick, needed for an experiment and it's fast enough for our purpose.
+*/
+
+void lmt_cstring_print(int cattable, const char *s, int ispartial)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = lua_gettop(L);
+ lua_settop(L, 0);
+ lua_pushinteger(L, cattable);
+ lua_pushstring(L, s);
+ texlib_aux_cprint(L, ispartial ? PARTIAL_LINE : FULL_LINE, default_catcode_table_preset, 1);
+ lua_settop(L, top);
+}
+
+/* lua.write */
+
+static int texlib_write(lua_State *L)
+{
+ return texlib_aux_cprint(L, FULL_LINE, no_catcode_table_preset, 1);
+}
+
+/* lua.print */
+
+static int texlib_print(lua_State *L)
+{
+ return texlib_aux_cprint(L, FULL_LINE, default_catcode_table_preset, 1);
+}
+
+/* lua.sprint */
+
+static int texlib_sprint(lua_State *L)
+{
+ return texlib_aux_cprint(L, PARTIAL_LINE, default_catcode_table_preset, 1);
+}
+
+static int texlib_mprint(lua_State *L)
+{
+ int ini = 1;
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering local control via (run) macro");
+ }
+ texlib_aux_store_token(token_val(end_local_cmd, 0), PARTIAL_LINE, default_catcode_table_preset);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ int cs = tex_string_locate(name, lname, 0);
+ int cmd = eq_type(cs);
+ if (is_call_cmd(cmd)) {
+ texlib_aux_store_token(cs_token_flag + cs, PARTIAL_LINE, default_catcode_table_preset);
+ ++ini;
+ } else {
+ tex_local_control_message("invalid (mprint) macro");
+ }
+ }
+ if (lua_gettop(L) >= ini) {
+ texlib_aux_cprint(L, PARTIAL_LINE, default_catcode_table_preset, ini);
+ }
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering local control via mprint");
+ }
+ tex_local_control(1);
+ return 0;
+}
+
+/* we default to obeymode */
+
+static int texlib_pushlocal(lua_State *L)
+{
+ (void) L;
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("pushing local control");
+ }
+ texlib_aux_store_token(token_val(end_local_cmd, 0), PARTIAL_LINE, default_catcode_table_preset);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ return 0;
+}
+
+static int texlib_poplocal(lua_State *L)
+{
+ (void) L;
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering local control via pop");
+ }
+ tex_local_control(1);
+ return 0;
+}
+
+/* lua.cprint */
+
+static int texlib_cprint(lua_State *L)
+{
+ /*tex
+ We map a catcode to a pseudo cattable. So a negative value is a specific catcode with offset 1.
+ */
+ int cattable = lmt_tointeger(L, 1);
+ if (cattable < 0 || cattable > 15) {
+ cattable = - 12 - 0xFF ;
+ } else {
+ cattable = - cattable - 0xFF;
+ }
+ if (lua_type(L, 2) == LUA_TTABLE) {
+ for (int i = 1; ; i++) {
+ lua_rawgeti(L, 2, i);
+ if (texlib_aux_store(L, -1, PARTIAL_LINE, cattable)) {
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ } else {
+ int n = lua_gettop(L);
+ for (int i = 2; i <= n; i++) {
+ texlib_aux_store(L, i, PARTIAL_LINE, cattable);
+ }
+ }
+ return 0;
+}
+
+/* lua.tprint */
+
+static int texlib_tprint(lua_State *L)
+{
+ int n = lua_gettop(L);
+ for (int i = 1; i <= n; i++) {
+ int cattable = default_catcode_table_preset;
+ int startstrings = 1;
+ if (lua_type(L, i) != LUA_TTABLE) {
+ luaL_error(L, "no string to print");
+ }
+ lua_pushvalue(L, i); /* the table */
+ lua_pushinteger(L, 1);
+ lua_gettable(L, -2);
+ if (lua_type(L, -1) == LUA_TNUMBER) {
+ cattable = lmt_tointeger(L, -1);
+ startstrings = 2;
+ if (cattable != default_catcode_table_preset && cattable != no_catcode_table_preset && ! tex_valid_catcode_table(cattable)) {
+ cattable = default_catcode_table_preset;
+ }
+ }
+ lua_pop(L, 1);
+ for (int j = startstrings; ; j++) {
+ lua_pushinteger(L, j);
+ lua_gettable(L, -2);
+ if (texlib_aux_store(L, -1, PARTIAL_LINE, cattable)) {
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ lua_pop(L, 1); /* the table */
+ }
+ return 0;
+}
+
+static int texlib_isprintable(lua_State* L)
+{
+ halfword okay = 0;
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING :
+ okay = 1;
+ break;
+ case LUA_TUSERDATA :
+ {
+ if (lua_getmetatable(L, 1)) {
+ lua_get_metatablelua(token_instance);
+ if (lua_rawequal(L, -1, -2)) {
+ okay = 1;
+ // lua_pop(L, 2);
+ } else {
+ lua_get_metatablelua(node_instance);
+ if (lua_rawequal(L, -1, -3)) {
+ okay = 1;
+ }
+ // lua_pop(L, 3);
+ }
+ }
+ break;
+ }
+ }
+ lua_pushboolean(L, okay);
+ return 1;
+}
+
+/*tex We actually don't need to copy and could read from the string. */
+
+int lmt_cstring_input(halfword *n, int *cattable, int *partial, int *finalline)
+{
+ spindle_rope *t = read_spindle.head;
+ int ret = eof_tex_input ;
+ if (! read_spindle.complete) {
+ read_spindle.complete = 1;
+ read_spindle.tail = NULL;
+ }
+ if (t) {
+ switch (t->kind) {
+ case string_lua_input:
+ {
+ if (t->data.t) {
+ /*tex put that thing in the buffer */
+ int strsize = (int) t->tsize;
+ int newlast = lmt_fileio_state.io_first + strsize;
+ lmt_fileio_state.io_last = lmt_fileio_state.io_first;
+ if (tex_room_in_buffer(newlast)) {
+ memcpy(&lmt_fileio_state.io_buffer[lmt_fileio_state.io_last], &t->data.t[0], sizeof(unsigned char) * strsize);
+ lmt_fileio_state.io_last = newlast;
+ lmt_memory_free(t->data.t);
+ t->data.t = NULL;
+ } else {
+ return ret;
+ }
+ }
+ *cattable = t->cattable;
+ *partial = t->partial;
+ *finalline = (t->next == NULL);
+ ret = string_tex_input;
+ break;
+ }
+ case packed_lua_input:
+ {
+ unsigned strsize = t->tsize;
+ int newlast = lmt_fileio_state.io_first + strsize;
+ lmt_fileio_state.io_last = lmt_fileio_state.io_first;
+ if (tex_room_in_buffer(newlast)) {
+ for (unsigned i = 0; i < strsize; i++) {
+ /* when we end up here we often don't have that many bytes */
+ lmt_fileio_state.io_buffer[lmt_fileio_state.io_last + i] = t->data.c[i];
+ }
+ lmt_fileio_state.io_last = newlast;
+ *cattable = t->cattable;
+ *partial = t->partial;
+ *finalline = (t->next == NULL);
+ ret = string_tex_input;
+ } else {
+ return ret;
+ }
+ break;
+ }
+ case token_lua_input:
+ {
+ *n = t->data.h;
+ ret = token_tex_input;
+ break;
+ }
+ case token_list_lua_input:
+ {
+ *n = t->data.h;
+ ret = token_list_tex_input;
+ break;
+ }
+ case node_lua_input:
+ {
+ *n = t->data.h;
+ ret = node_tex_input;
+ break;
+ }
+ }
+ texlib_aux_dispose_rope(read_spindle.tail);
+ read_spindle.tail = t;
+ read_spindle.head = t->next;
+ } else {
+ texlib_aux_dispose_rope(read_spindle.tail);
+ read_spindle.tail = NULL;
+ }
+ return ret;
+}
+
+/*tex Open for reading, and make a new one for writing. */
+
+void lmt_cstring_start(void)
+{
+ lmt_spindle_state.spindle_index++;
+ if (lmt_spindle_state.spindle_size == lmt_spindle_state.spindle_index) {
+ int size = (lmt_spindle_state.spindle_size + 1) * sizeof(spindle);
+ spindle *spindles = lmt_memory_realloc(lmt_spindle_state.spindles, (size_t) size);
+ if (spindles) {
+ lmt_spindle_state.spindles = spindles;
+ texlib_aux_reset_spindle(lmt_spindle_state.spindle_index);
+ lmt_spindle_state.spindle_size++;
+ } else {
+ tex_overflow_error("spindle", size);
+ }
+ }
+}
+
+/*tex Close for reading. */
+
+void lmt_cstring_close(void)
+{
+ spindle_rope *t;
+ spindle_rope *next = read_spindle.head;
+ while (next) {
+ if (next->kind == string_tex_input && next->data.t) {
+ lmt_memory_free(next->data.t);
+ next->data.t = NULL;
+ }
+ t = next;
+ next = next->next;
+ if (t == read_spindle.tail) {
+ read_spindle.tail = NULL;
+ }
+ texlib_aux_dispose_rope(t);
+ }
+ read_spindle.head = NULL;
+ texlib_aux_dispose_rope(read_spindle.tail);
+ read_spindle.tail = NULL;
+ read_spindle.complete = 0;
+ lmt_spindle_state.spindle_index--;
+}
+
+/*tex
+ The original was close to the \TEX\ original (even using |cur_val|) but there is no need to have
+ that all-in-one loop with radix magic.
+*/
+
+static const char *texlib_aux_scan_integer_part(lua_State *L, const char *ss, int *ret, int *radix_ret)
+{
+ int negative = 0; /*tex should the answer be negated? */
+ int vacuous = 1; /*tex have no digits appeared? */
+ int overflow = 0;
+ int c = 0; /*tex the current character */
+ const char *s = ss; /*tex where we stopped in the string |ss| */
+ long long result = 0; /*tex return value */
+ while (1) {
+ c = *s++;
+ switch (c) {
+ case ' ':
+ case '+':
+ break;
+ case '-':
+ negative = ! negative;
+ break;
+ case '\'':
+ {
+ int d;
+ *radix_ret = 8;
+ c = *s++;
+ while (c) {
+ if ((c >= '0') && (c <= '0' + 7)) {
+ d = c - '0';
+ } else {
+ break;
+ }
+ if (! overflow) {
+ vacuous = 0;
+ result = result * 8 + d;
+ if (result > max_integer) {
+ overflow = 1;
+ }
+ }
+ c = *s++;
+ }
+ goto DONE;
+ }
+ case '"':
+ {
+ int d;
+ *radix_ret = 16;
+ c = *s++;
+ while (c) {
+ if ((c >= '0') && (c <= '0' + 9)) {
+ d = c - '0';
+ } else if ((c <= 'A' + 5) && (c >= 'A')) {
+ d = c - 'A' + 10;
+ } else if ((c <= 'a' + 5) && (c >= 'a')) {
+ /*tex Actually \TEX\ only handles uppercase. */
+ d = c - 'a' + 10;
+ } else {
+ goto DONE;
+ }
+ if (! overflow) {
+ vacuous = 0;
+ result = result * 16 + d;
+ if (result > max_integer) {
+ overflow = 1;
+ }
+ }
+ c = *s++;
+ }
+ goto DONE;
+ }
+ default:
+ {
+ int d;
+ *radix_ret = 10;
+ while (c) {
+ if ((c >= '0') && (c <= '0' + 9)) {
+ d = c - '0';
+ } else {
+ goto DONE;
+ }
+ if (! overflow) {
+ vacuous = 0;
+ result = result * 10 + d;
+ if (result > max_integer) {
+ overflow = 1;
+ }
+ }
+ c = *s++;
+ }
+ goto DONE;
+ }
+ }
+ }
+ DONE:
+ if (overflow) {
+ luaL_error(L, "number too big");
+ result = infinity;
+ } else if (vacuous) {
+ luaL_error(L, "missing number, treated as zero") ;
+ }
+ if (negative) {
+ result = -result;
+ }
+ *ret = (int) result;
+ if (c != ' ' && s > ss) {
+ s--;
+ }
+ return s;
+}
+
+/*tex
+ This sets |cur_val| to a dimension. We can clean this up a bit like the normal dimen scanner,
+ but it's seldom called. Scanning is like in \TEX, with gobbling spaces and such. When no unit
+ is given we assume points. When nothing is given we assume zero. Trailing crap is just ignored.
+*/
+
+static const char *texlib_aux_scan_dimen_part(lua_State * L, const char *ss, int *ret)
+{
+ int negative = 0; /*tex should the answer be negated? */
+ int fraction = 0; /*tex numerator of a fraction whose denominator is $2^{16}$ */
+ int numerator;
+ int denominator;
+ scaled special; /*tex an internal dimension */
+ int result = 0;
+ int radix = 0; /*tex the current radix */
+ int remainder = 0; /*tex the to be remainder */
+ int saved_error = lmt_scanner_state.arithmic_error; /*tex to save |arith_error| */
+ const char *s = NULL;
+ if (ss && (*ss == '.' || *ss == ',')) {
+ s = ss;
+ goto FRACTION;
+ } else {
+ s = texlib_aux_scan_integer_part(L, ss, &result, &radix);
+ }
+ if (! (char) *s) {
+ /* error, no unit, assume scaled points */
+ goto ATTACH_FRACTION;
+ }
+ if (result < 0) {
+ negative = ! negative;
+ result = -result;
+ }
+ FRACTION:
+ if ((radix == 0 || radix == 10) && (*s == '.' || *s == ',')) {
+ unsigned k = 0;
+ unsigned char digits[18];
+ s++;
+ while (1) {
+ int c = *s++;
+ if ((c > '0' + 9) || (c < '0')) {
+ break;
+ } else if (k < 17) {
+ digits[k++] = (unsigned char) c - '0';
+ }
+ }
+ fraction = tex_round_decimals_digits(digits, k);
+ if (*s != ' ') {
+ --s;
+ }
+ }
+ /* the unit can have spaces in front */
+/*UNIT: */
+ while ((char) *s == ' ') {
+ s++;
+ }
+ /* We dropped the |nd| and |nc| units as well as the |true| prefix. */
+ if (! (char) *s) {
+ goto ATTACH_FRACTION;
+ } else if (strncmp(s, "pt", 2) == 0) {
+ s += 2;
+ goto ATTACH_FRACTION;
+ } else if (strncmp(s, "mm", 2) == 0) {
+ s += 2;
+ numerator = 7227;
+ denominator = 2540;
+ goto CONVERSION;
+ } else if (strncmp(s, "cm", 2) == 0) {
+ s += 2;
+ numerator = 7227;
+ denominator = 254;
+ goto CONVERSION;
+ } else if (strncmp(s, "sp", 2) == 0) {
+ s += 2;
+ goto DONE;
+ } else if (strncmp(s, "bp", 2) == 0) {
+ s += 2;
+ numerator = 7227;
+ denominator = 7200;
+ goto CONVERSION;
+ } else if (strncmp(s, "in", 2) == 0) {
+ s += 2;
+ numerator = 7227;
+ denominator = 100;
+ goto CONVERSION;
+ } else if (strncmp(s, "dd", 2) == 0) {
+ s += 2;
+ numerator = 1238;
+ denominator = 1157;
+ goto CONVERSION;
+ } else if (strncmp(s, "cc", 2) == 0) {
+ s += 2;
+ numerator = 14856;
+ denominator = 1157;
+ goto CONVERSION;
+ } else if (strncmp(s, "pc", 2) == 0) {
+ s += 2;
+ numerator = 12;
+ denominator = 1;
+ goto CONVERSION;
+ } else if (strncmp(s, "dk", 2) == 0) {
+ s += 2;
+ numerator = 49838;
+ denominator = 7739;
+ goto CONVERSION;
+ } else if (strncmp(s, "em", 2) == 0) {
+ s += 2;
+ special = tex_get_font_em_width(cur_font_par);
+ goto SPECIAL;
+ } else if (strncmp(s, "ex", 2) == 0) {
+ s += 2;
+ special = tex_get_font_ex_height(cur_font_par);
+ goto SPECIAL;
+ } else if (strncmp(s, "px", 2) == 0) {
+ s += 2;
+ special = px_dimen_par;
+ goto SPECIAL;
+ } else if (strncmp(s, "mu", 2) == 0) {
+ s += 2;
+ goto ATTACH_FRACTION;
+ /* } else if (strncmp(s, "true", 4) == 0) { */
+ /* s += 4; */
+ /* goto UNIT; */
+ } else {
+ /* luaL_error(L, "illegal unit of measure (pt inserted)"); */
+ goto ATTACH_FRACTION;
+ }
+ SPECIAL:
+ result = tex_nx_plus_y(result, special, tex_xn_over_d_r(special, fraction, 0200000, &remainder));
+ goto DONE;
+ CONVERSION:
+ result = tex_xn_over_d_r(result, numerator, denominator, &remainder);
+ fraction = (numerator * fraction + 0200000 * remainder) / denominator;
+ result = result + (fraction / 0200000);
+ fraction = fraction % 0200000;
+ ATTACH_FRACTION:
+ if (result >= 040000) {
+ lmt_scanner_state.arithmic_error = 1;
+ } else {
+ result = result * 65536 + fraction;
+ }
+ DONE:
+ if (lmt_scanner_state.arithmic_error || (abs(result) >= 010000000000)) {
+ result = max_dimen;
+ luaL_error(L, "dimension too large");
+ }
+ *ret = negative ? - result : result;
+ lmt_scanner_state.arithmic_error = saved_error;
+ /* only when we want to report junk */
+ while ((char) *s == ' ') {
+ s++;
+ }
+ return s;
+}
+
+static int texlib_aux_dimen_to_number(lua_State *L, const char *s)
+{
+ int result = 0;
+ const char *d = texlib_aux_scan_dimen_part(L, s, &result);
+ if (*d) {
+ return luaL_error(L, "conversion failed (trailing junk?)");
+ } else {
+ return result;
+ }
+}
+
+static int texlib_aux_integer_to_number(lua_State *L, const char *s)
+{
+ int result = 0;
+ int radix = 10;
+ const char *d = texlib_aux_scan_integer_part(L, s, &result, &radix);
+ if (*d) {
+ return luaL_error(L, "conversion failed (trailing junk?)");
+ } else {
+ return result;
+ }
+}
+
+static int texlib_toscaled(lua_State *L)
+{
+ int sp;
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ sp = lmt_toroundnumber(L, 1);
+ break;
+ case LUA_TSTRING:
+ sp = texlib_aux_dimen_to_number(L, lua_tostring(L, 1));
+ break;
+ default:
+ return luaL_error(L, "string or a number expected");
+ }
+ lua_pushinteger(L, sp);
+ return 1;
+}
+
+static int texlib_tonumber(lua_State *L)
+{
+ int i;
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ i = lmt_toroundnumber(L, 1);
+ break;
+ case LUA_TSTRING:
+ i = texlib_aux_integer_to_number(L, lua_tostring(L, 1));
+ break;
+ default:
+ return luaL_error(L, "string or a number expected");
+ }
+ lua_pushinteger(L, i);
+ return 1;
+}
+
+static int texlib_error(lua_State *L)
+{
+ const char *error = luaL_checkstring(L, 1);
+ const char *help = lua_type(L, 2) == LUA_TSTRING ? luaL_checkstring(L, 2) : NULL;
+ tex_handle_error(normal_error_type, error, help);
+ return 0;
+}
+
+/*tex
+
+ The lua interface needs some extra functions. The functions themselves are quite boring, but they
+ are handy because otherwise this internal stuff has to be accessed from \CCODE\ directly, where
+ lots of the defines are not available.
+
+*/
+
+inline static int texlib_aux_valid_register_index(lua_State *L, int slot, int cmd, int base, int max)
+{
+ int index = -1;
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *str = lua_tolstring(L, 1, &len);
+ int cs = tex_string_locate(str, len, 0);
+ if (eq_type(cs) == cmd) {
+ index = eq_value(cs) - base;
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ index = lmt_tointeger(L, slot);
+ break;
+ default:
+ luaL_error(L, "string or a number expected");
+ break;
+ }
+ if (index >= 0 && index <= max) {
+ return index;
+ } else {
+ return -1;
+ }
+}
+
+static int texlib_get_register_index(lua_State *L)
+{
+ size_t len;
+ const char *str = lua_tolstring(L, 1, &len);
+ int cs = tex_string_locate(str, len, 0);
+ int index = -1;
+ switch (eq_type(cs)) {
+ case register_toks_cmd : index = eq_value(cs) - register_toks_base; break;
+ case register_int_cmd : index = eq_value(cs) - register_int_base; break;
+ case register_attribute_cmd : index = eq_value(cs) - register_attribute_base; break;
+ case register_dimen_cmd : index = eq_value(cs) - register_dimen_base; break;
+ case register_glue_cmd : index = eq_value(cs) - register_glue_base; break;
+ case register_mu_glue_cmd : index = eq_value(cs) - register_mu_glue_base; break;
+ }
+ if (index >= 0) {
+ lua_pushinteger(L, index);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+inline static int texlib_aux_checked_register(lua_State *L, int cmd, int base, int max)
+{
+ int index = texlib_aux_valid_register_index(L, 1, cmd, base, max);
+ if (index >= 0) {
+ lua_pushinteger(L, index);
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+typedef void (*setfunc) (int, halfword, int, int);
+typedef halfword (*getfunc) (int, int);
+
+int lmt_check_for_flags(lua_State *L, int slot, int *flags, int prefixes, int numeric)
+{
+ if (global_defs_par) {
+ *flags = add_global_flag(*flags);
+ }
+ if (prefixes) {
+ while (1) {
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ const char *str = lua_tostring(L, slot);
+ if (! str || lua_key_eq(str, macro)) {
+ /*tex For practical reasons we skip empty strings. */
+ slot += 1;
+ } else if (lua_key_eq(str, global)) {
+ slot += 1;
+ *flags = add_global_flag(*flags);
+ } else if (lua_key_eq(str, frozen)) {
+ slot += 1;
+ *flags = add_frozen_flag(*flags);
+ } else if (lua_key_eq(str, permanent)) {
+ slot += 1;
+ *flags = add_permanent_flag(*flags);
+ } else if (lua_key_eq(str, protected)) {
+ slot += 1;
+ *flags = add_protected_flag(*flags);
+ } else if (lua_key_eq(str, untraced)) {
+ slot += 1;
+ *flags = add_untraced_flag(*flags);
+ } else if (lua_key_eq(str, immutable)) {
+ slot += 1;
+ *flags = add_immutable_flag(*flags);
+ } else if (lua_key_eq(str, overloaded)) {
+ slot += 1;
+ *flags = add_overloaded_flag(*flags);
+ } else if (lua_key_eq(str, value)) {
+ slot += 1;
+ *flags = add_value_flag(*flags);
+ } else if (lua_key_eq(str, conditional) || lua_key_eq(str, condition)) {
+ /* condition will go, conditional stays */
+ slot += 1;
+ *flags = add_conditional_flag(*flags);
+ } else {
+ /*tex When we have this at the start we now can have a csname. */
+ return slot;
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ if (numeric) {
+ *flags |= lua_tointeger(L, slot);
+ slot += 1;
+ break;
+ } else {
+ return slot;
+ }
+ case LUA_TNIL:
+ /*tex This is quite convenient if we use some composer. */
+ slot += 1;
+ break;
+ default:
+ return slot;
+ }
+ }
+ }
+ return slot;
+}
+
+int lmt_check_for_level(lua_State *L, int slot, quarterword *level, quarterword defaultlevel)
+{
+ if (lua_type(L, slot) == LUA_TSTRING) {
+ const char *str = lua_tostring(L, slot);
+ *level = lua_key_eq(str, global) ? level_one : defaultlevel;
+ ++slot;
+ } else {
+ *level = defaultlevel;
+ }
+ return slot;
+}
+
+/* -1=noindex, 0=register 1=internal */
+
+static int texlib_aux_check_for_index(
+ lua_State *L,
+ int slot,
+ const char *what,
+ int *index,
+ int internal_cmd,
+ int register_cmd,
+ int internal_base,
+ int register_base,
+ int max_index
+) {
+ *index = -1;
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ size_t len;
+ const char *str = lua_tolstring(L, slot, &len);
+ int cs = tex_string_locate(str, len, 0);
+ if (eq_type(cs) == internal_cmd) {
+ *index = eq_value(cs) - internal_base;
+ return 1;
+ } else if (eq_type(cs) == register_cmd) {
+ *index = eq_value(cs) - register_base;
+ return 0;
+ } else {
+ luaL_error(L, "incorrect %s name", what);
+ return -1;
+ }
+ }
+ case LUA_TNUMBER:
+ *index = lmt_tointeger(L, slot);
+ if (*index >= 0 && *index <= max_index) {
+ return 0;
+ } else {
+ return -1;
+ }
+ default:
+ luaL_error(L, "%s name or valid index expected", what);
+ return -1;
+ }
+}
+
+static int texlib_get(lua_State *L);
+
+/*tex
+
+ We intercept the first string and when it is |global| then we check the second one which can
+ also be a string. It is unlikely that one will use |\global| as register name so we don't need
+ to check for the number of further arguments. This permits to treat lack of them as a reset.
+
+*/
+
+static int texlib_isdimen(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_dimen_cmd, register_dimen_base, max_dimen_register_index);
+}
+
+/* [global] name|index integer|dimension|false|nil */
+
+static int texlib_setdimen(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "dimen", &index, internal_dimen_cmd, register_dimen_cmd, internal_dimen_base, register_dimen_base, max_dimen_register_index);
+ if (state >= 0) {
+ halfword value = 0;
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ value = lmt_toroundnumber(L, slot++);
+ break;
+ case LUA_TSTRING:
+ value = texlib_aux_dimen_to_number(L, lua_tostring(L, slot++));
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, slot++)) {
+ /*tex The value |true| makes no sense. */
+ return 0;
+ }
+ break;
+ case LUA_TNONE:
+ case LUA_TNIL:
+ break;
+ default:
+ luaL_error(L, "unsupported dimen value type");
+ break;
+ }
+ tex_set_tex_dimen_register(index, value, flags, state);
+ if (state == 1 && lua_toboolean(L, slot)) {
+ tex_update_par_par(internal_dimen_cmd, index);
+ }
+ }
+ return 0;
+}
+
+static int texlib_getdimen(lua_State *L)
+{
+ int index;
+ int state = texlib_aux_check_for_index(L, 1, "dimen", &index, internal_dimen_cmd, register_dimen_cmd, internal_dimen_base, register_dimen_base, max_dimen_register_index);
+ lua_pushinteger(L, state >= 0 ? tex_get_tex_dimen_register(index, state) : 0);
+ return 1;
+}
+
+// static halfword texlib_aux_make_glue(lua_State *L, int top, int slot)
+// {
+// halfword value = copy_node(zero_glue);
+// if (++slot <= top) {
+// glue_amount(value) = lmt_toroundnumber(L, slot);
+// if (++slot <= top) {
+// glue_stretch(value) = lmt_toroundnumber(L, slot);
+// if (++slot <= top) {
+// glue_shrink(value) = lmt_toroundnumber(L, slot);
+// if (++slot <= top) {
+// glue_stretch_order(value) = lmt_tohalfword(L, slot);
+// if (++slot <= top) {
+// glue_shrink_order(value) = lmt_tohalfword(L, slot);
+// }
+// }
+// }
+// }
+// }
+// return value;
+// }
+
+static halfword texlib_aux_make_glue(lua_State *L, int top, int slot)
+{
+ halfword value = tex_copy_node(zero_glue);
+ if (slot <= top) {
+ glue_amount(value) = lmt_toroundnumber(L, slot++);
+ if (slot <= top) {
+ glue_stretch(value) = lmt_toroundnumber(L, slot++);
+ if (slot <= top) {
+ glue_shrink(value) = lmt_toroundnumber(L, slot++);
+ if (slot <= top) {
+ glue_stretch_order(value) = lmt_tohalfword(L, slot++);
+ if (slot <= top) {
+ glue_shrink_order(value) = lmt_tohalfword(L, slot++);
+ }
+ }
+ }
+ }
+ }
+ return value;
+}
+
+inline static int texlib_aux_push_glue(lua_State* L, halfword g)
+{
+ if (g) {
+ lua_pushinteger(L, glue_amount(g));
+ lua_pushinteger(L, glue_stretch(g));
+ lua_pushinteger(L, glue_shrink(g));
+ lua_pushinteger(L, glue_stretch_order(g));
+ lua_pushinteger(L, glue_shrink_order(g));
+ } else {
+ lua_pushinteger(L, 0);
+ lua_pushinteger(L, 0);
+ lua_pushinteger(L, 0);
+ lua_pushinteger(L, 0);
+ lua_pushinteger(L, 0);
+ }
+ return 5;
+}
+
+static halfword texlib_aux_get_glue_spec(lua_State *L, int slot)
+{
+ halfword value = null;
+ switch (lua_type(L, slot + 1)) {
+ case LUA_TBOOLEAN:
+ // if (lua_toboolean(L, slot + 1)) {
+ // /*tex The value |true| makes no sense. */
+ // }
+ break;
+ case LUA_TNIL:
+ case LUA_TNONE:
+ break;
+ default:
+ value = lmt_check_isnode(L, slot + 1);
+ if (node_type(value) != glue_spec_node) {
+ value = null;
+ luaL_error(L, "glue_spec expected");
+ }
+ }
+ return value;
+}
+
+static int texlib_isskip(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_glue_cmd, register_glue_base, max_glue_register_index);
+}
+
+/* [global] name|index gluespec|false|nil */
+
+static int texlib_setskip(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "skip", &index, internal_glue_cmd, register_glue_cmd, internal_glue_base, register_glue_base, max_glue_register_index);
+ if (state >= 0) {
+ halfword value = texlib_aux_get_glue_spec(L, slot++);
+ tex_set_tex_skip_register(index, value, flags, state);
+ if (state == 1 && lua_toboolean(L, slot)) {
+ tex_update_par_par(internal_glue_cmd, index);
+ }
+ }
+ return 0;
+}
+
+static int texlib_getskip(lua_State *L)
+{
+ int index;
+ int state = texlib_aux_check_for_index(L, 1, "skip", &index, internal_glue_cmd, register_glue_cmd, internal_glue_base, register_glue_base, max_glue_register_index);
+ halfword value = state >= 0 ? tex_get_tex_skip_register(index, state) : null;
+ lmt_push_node_fast(L, tex_copy_node(value ? value : zero_glue));
+ return 1;
+}
+
+static int texlib_isglue(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_glue_cmd, register_glue_base, max_glue_register_index);
+}
+
+/* [global] slot [width] [stretch] [shrink] [stretch_order] [shrink_order] */
+
+static int texlib_setglue(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "skip", &index, internal_glue_cmd, register_glue_cmd, internal_glue_base, register_glue_base, max_glue_register_index);
+ if (state >= 0) {
+ tex_set_tex_skip_register(index, texlib_aux_make_glue(L, lua_gettop(L), slot), flags, state);
+ }
+ return 0;
+}
+
+static int texlib_getglue(lua_State *L)
+{
+ int index;
+ int all = (lua_type(L, 2) == LUA_TBOOLEAN) ? lua_toboolean(L, 2) : 1;
+ int state = texlib_aux_check_for_index(L, 1, "skip", &index, internal_glue_cmd, register_glue_cmd, internal_glue_base, register_glue_base, max_glue_register_index);
+ halfword value = state >= 0 ? tex_get_tex_skip_register(index, state) : null;
+ if (! value) {
+ lua_pushinteger(L, 0);
+ if (all) {
+ /* save the trouble of testing p/m */
+ lua_pushinteger(L, 0);
+ lua_pushinteger(L, 0);
+ return 3;
+ } else {
+ return 1;
+ }
+ } else if (all) {
+ return texlib_aux_push_glue(L, value);
+ } else {
+ /* false */
+ lua_pushinteger(L, value ? glue_amount(value) : 0);
+ return 1;
+ }
+}
+
+static int texlib_ismuskip(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_mu_glue_cmd, register_mu_glue_base, max_mu_glue_register_index);
+}
+
+static int texlib_setmuskip(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "muskip", &index, internal_mu_glue_cmd, register_mu_glue_cmd, internal_mu_glue_base, register_mu_glue_base, max_mu_glue_register_index);
+ tex_set_tex_mu_skip_register(index, texlib_aux_get_glue_spec(L, slot), flags, state);
+ return 0;
+}
+
+static int texlib_getmuskip(lua_State *L)
+{
+ int index;
+ int state = texlib_aux_check_for_index(L, 1, "muskip", &index, internal_mu_glue_cmd, register_mu_glue_cmd, internal_mu_glue_base, register_mu_glue_base, max_mu_glue_register_index);
+ halfword value = state >= 0 ? tex_get_tex_mu_skip_register(index, state) : null;
+ lmt_push_node_fast(L, tex_copy_node(value ? value : zero_glue));
+ return 1;
+}
+
+static int texlib_ismuglue(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_mu_glue_cmd, register_mu_glue_base, max_mu_glue_register_index);
+}
+
+static int texlib_setmuglue(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "muskip", &index, internal_mu_glue_cmd, register_mu_glue_cmd, internal_mu_glue_base, register_mu_glue_base, max_mu_glue_register_index);
+ halfword value = texlib_aux_make_glue(L, lua_gettop(L), slot);
+ if (state >= 0) {
+ tex_set_tex_mu_skip_register(index, value, flags, state);
+ }
+ return 0;
+}
+
+static int texlib_getmuglue(lua_State *L)
+{
+ int index;
+ int all = (lua_type(L, 2) == LUA_TBOOLEAN) ? lua_toboolean(L, 2) : 1;
+ int state = texlib_aux_check_for_index(L, 1, "muskip", &index, internal_mu_glue_cmd, register_mu_glue_cmd, internal_mu_glue_base, register_mu_glue_base, max_mu_glue_register_index);
+ halfword value = state >= 0 ? tex_get_tex_mu_skip_register(index, state) : null;
+ if (! value) {
+ lua_pushinteger(L, 0);
+ return 1;
+ } else if (all) {
+ return texlib_aux_push_glue(L, value);
+ } else {
+ /* false */
+ lua_pushinteger(L, value ? glue_amount(value) : 0);
+ return 1;
+ }
+}
+
+static int texlib_iscount(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_int_cmd, register_int_base, max_int_register_index);
+}
+
+static int texlib_setcount(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "count", &index, internal_int_cmd, register_int_cmd, internal_int_base, register_int_base, max_int_register_index);
+ if (state >= 0) {
+ halfword value = lmt_optinteger(L, slot++, 0);
+ tex_set_tex_count_register(index, value, flags, state);
+ if (state == 1 && lua_toboolean(L, slot)) {
+ tex_update_par_par(internal_int_cmd, index);
+ }
+ }
+ return 0;
+}
+
+static int texlib_getcount(lua_State *L)
+{
+ int index;
+ int state = texlib_aux_check_for_index(L, 1, "count", &index, internal_int_cmd, register_int_cmd, internal_int_base, register_int_base, max_int_register_index);
+ lua_pushinteger(L, state >= 0 ? tex_get_tex_count_register(index, state) : 0);
+ return 1;
+}
+
+static int texlib_isattribute(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_attribute_cmd, register_attribute_base, max_attribute_register_index);
+}
+
+/*tex there are no system set attributes so this is a bit overkill */
+
+static int texlib_setattribute(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "attribute", &index, internal_attribute_cmd, register_attribute_cmd, internal_attribute_base, register_attribute_base, max_attribute_register_index);
+ if (state >= 0) {
+ halfword value = lmt_optinteger(L, slot++, unused_attribute_value);
+ tex_set_tex_attribute_register(index, value, flags, state);
+ }
+ return 0;
+}
+
+static int texlib_getattribute(lua_State *L)
+{
+ int index;
+ int state = texlib_aux_check_for_index(L, 1, "attribute", &index, internal_attribute_cmd, register_attribute_cmd, internal_attribute_base, register_attribute_base, max_attribute_register_index);
+ lua_pushinteger(L, state >= 0 ? tex_get_tex_attribute_register(index, state) : 0);
+ return 1;
+}
+
+/*tex todo: we can avoid memcpy as there is no need to go through the pool */
+
+/* use string_to_toks */
+
+static int texlib_istoks(lua_State *L)
+{
+ return texlib_aux_checked_register(L, register_toks_cmd, register_toks_base, max_toks_register_index);
+}
+
+/* [global] name|integer string|nil */
+
+static int texlib_settoks(lua_State *L)
+{
+ int flags = 0;
+ int index = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "toks", &index, internal_toks_cmd, register_toks_cmd, internal_toks_base, register_toks_base,max_toks_register_index);
+ if (state >= 0) {
+ lstring value = { .c = NULL, .l = 0 };
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ value.c = lua_tolstring(L, slot, &value.l);
+ break;
+ case LUA_TNIL:
+ case LUA_TNONE:
+ break;
+ default:
+ return luaL_error(L, "string or nil expected");
+ }
+ tex_set_tex_toks_register(index, value, flags, state);
+ }
+ return 0;
+}
+
+/* [global] name|index catcode string */
+
+static int texlib_scantoks(lua_State *L) // TODO
+{
+ int index = 0;
+ int flags = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int state = texlib_aux_check_for_index(L, slot++, "toks", &index, internal_toks_cmd, register_toks_cmd, internal_toks_base, register_toks_base,max_toks_register_index);
+ if (state >= 0) {
+ lstring value = { .c = NULL, .l = 0 };
+ int cattable = lmt_checkinteger(L, slot++);
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ value.c = lua_tolstring(L, slot, &value.l);
+ break;
+ case LUA_TNIL:
+ case LUA_TNONE:
+ break;
+ default:
+ return luaL_error(L, "string or nil expected");
+ }
+ tex_scan_tex_toks_register(index, cattable, value, flags, state);
+ }
+ return 0;
+}
+
+static int texlib_gettoks(lua_State *L)
+{
+ int index;
+ int slot = 1;
+ int state = texlib_aux_check_for_index(L, slot++, "toks", &index, internal_toks_cmd, register_toks_cmd, internal_toks_base, register_toks_base, max_toks_register_index);
+ if (state >= 0) {
+ if (lua_toboolean(L, slot)) {
+ lmt_token_register_to_lua(L, state ? toks_parameter(index) : toks_register(index));
+ } else {
+ strnumber value = tex_get_tex_toks_register(index, state);
+ char *s = tex_makecstring(value);
+ lua_pushstring(L, s);
+ lmt_memory_free(s);
+ tex_flush_str(value);
+ }
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+ return 1;
+}
+
+static int texlib_getmark(lua_State *L)
+{
+ if (lua_gettop(L) == 0) {
+ lua_pushinteger(L, lmt_mark_state.mark_data.ptr);
+ return 1;
+ } else if (lua_type(L, 1) == LUA_TSTRING) {
+ int mrk = -1;
+ const char *s = lua_tostring(L, 1);
+ if (lua_key_eq(s, top)) {
+ mrk = top_marks_code;
+ } else if (lua_key_eq(s, first)) {
+ mrk = first_marks_code;
+ } else if (lua_key_eq(s, bottom)) {
+ mrk = bot_marks_code;
+ } else if (lua_key_eq(s, splitfirst)) {
+ mrk = split_first_marks_code;
+ } else if (lua_key_eq(s, splitbottom)) {
+ mrk = split_bot_marks_code;
+ } else if (lua_key_eq(s, current)) {
+ mrk = current_marks_code;
+ }
+ if (mrk >= 0) {
+ int num = lmt_optinteger(L, 2, 0);
+ if (num >= 0 && num <= lmt_mark_state.mark_data.ptr) {
+ halfword ptr = tex_get_some_mark(mrk, num);
+ if (ptr) {
+ char *str = tex_tokenlist_to_tstring(ptr, 1, NULL, 0, 0, 0);
+ if (str) {
+ lua_pushstring(L, str);
+ } else {
+ lua_pushliteral(L, "");
+ }
+ return 1;
+ }
+ } else {
+ luaL_error(L, "valid mark class expected");
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+int lmt_get_box_id(lua_State *L, int i, int report)
+{
+ int index = -1;
+ switch (lua_type(L, i)) {
+ case LUA_TSTRING:
+ {
+ size_t k = 0;
+ const char *s = lua_tolstring(L, i, &k);
+ int cs = tex_string_locate(s, k, 0);
+ int cmd = eq_type(cs);
+ switch (cmd) {
+ case char_given_cmd:
+ // case math_char_given_cmd:
+ case integer_cmd:
+ index = eq_value(cs);
+ break;
+ case register_int_cmd:
+ index = register_int_number(eq_value(cs));
+ break;
+ default:
+ /* we don't accept other commands as it makes no sense */
+ break;
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ index = lmt_tointeger(L, i);
+ default:
+ break;
+ }
+ if (index >= 0 && index <= max_box_register_index) {
+ return index;
+ } else {
+ if (report) {
+ luaL_error(L, "string or a number within range expected");
+ }
+ return -1;
+ }
+}
+
+static int texlib_getbox(lua_State *L)
+{
+ halfword index = lmt_get_box_id(L, 1, 1);
+ lmt_node_list_to_lua(L, index >= 0 ? tex_get_tex_box_register(index, 0) : null);
+ return 1;
+}
+
+static int texlib_splitbox(lua_State *L)
+{
+ int index = lmt_get_box_id(L, 1, 1);
+ if (index >= 0) {
+ if (lua_isnumber(L, 2)) {
+ int m = packing_additional;
+ switch (lua_type(L, 3)) {
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, 3);
+ if (lua_key_eq(s, exactly)) {
+ m = packing_exactly;
+ } else if (lua_key_eq(s, additional)) {
+ m = packing_additional;
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ {
+ m = lmt_tointeger(L, 3);
+ if (m != packing_exactly && m != packing_additional) {
+ m = packing_exactly;
+ luaL_error(L, "wrong mode in splitbox");
+ }
+ break;
+ }
+ }
+ lmt_node_list_to_lua(L, tex_vsplit(index, lmt_toroundnumber(L, 2), m));
+ } else {
+ /* maybe a warning */
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* todo */
+
+static int texlib_isbox(lua_State *L)
+{
+ lua_pushboolean(L, lmt_get_box_id(L, 1, 0) >= 0);
+ return 1;
+}
+
+static int texlib_setbox(lua_State *L)
+{
+ int flags = 0;
+ int slot = lmt_check_for_flags(L, 1, &flags, 1, 0);
+ int index = lmt_get_box_id(L, slot++, 1);
+ if (index >= 0) {
+ int n = null;
+ switch (lua_type(L, slot)) {
+ case LUA_TBOOLEAN:
+ n = lua_toboolean(L, slot);
+ if (n) {
+ return 0;
+ } else {
+ n = null;
+ }
+ break;
+ case LUA_TNIL:
+ case LUA_TNONE:
+ break;
+ default:
+ n = lmt_node_list_from_lua(L, slot);
+ if (n) {
+ switch (node_type(n)) {
+ case hlist_node:
+ case vlist_node:
+ break;
+ default:
+ return luaL_error(L, "invalid node type %s passed", get_node_name(node_type(n)));
+ }
+ }
+ break;
+ }
+ tex_set_tex_box_register(index, n, flags, 0);
+ }
+ return 0;
+}
+
+/* [global] index first second */
+
+static int texlib_setlccode(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int ch1 = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch1)) {
+ halfword ch2 = lmt_checkhalfword(L, slot++);
+ if (character_in_range(ch2)) {
+ tex_set_lc_code(ch1, ch2, level);
+ if (slot <= top) {
+ halfword ch3 = lmt_checkhalfword(L, slot);
+ if (character_in_range(ch3)) {
+ tex_set_uc_code(ch1, ch3, level);
+ } else {
+ texlib_aux_show_character_error(L, ch3);
+ }
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch2);
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch1);
+ }
+ }
+ return 0;
+}
+
+static int texlib_setuccode(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int ch1 = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch1)) {
+ halfword ch2 = lmt_checkhalfword(L, slot++);
+ if (character_in_range(ch2)) {
+ tex_set_uc_code(ch1, ch2, level);
+ if (slot <= top) {
+ halfword ch3 = lmt_checkhalfword(L, slot);
+ if (character_in_range(ch3)) {
+ tex_set_lc_code(ch1, ch3, level);
+ } else {
+ texlib_aux_show_character_error(L, ch3);
+ }
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch2);
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch1);
+ }
+ }
+ return 0;
+}
+
+static int texlib_setsfcode(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int ch = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch)) {
+ halfword val = lmt_checkhalfword(L, slot);
+ if (half_in_range(val)) {
+ tex_set_sf_code(ch, val, level);
+ } else {
+ texlib_aux_show_half_error(L, val);
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ }
+ return 0;
+}
+
+static int texlib_sethccode(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int ch = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch)) {
+ halfword val = lmt_checkhalfword(L, slot);
+ if (half_in_range(val)) {
+ tex_set_hc_code(ch, val, level);
+ } else {
+ texlib_aux_show_half_error(L, val);
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ }
+ return 0;
+}
+
+static int texlib_sethmcode(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int ch = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch)) {
+ halfword val = lmt_checkhalfword(L, slot);
+ tex_set_hm_code(ch, val, level);
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ }
+ return 0;
+}
+
+static int texlib_getlccode(lua_State *L)
+{
+ int ch = lmt_checkinteger(L, 1);
+ if (character_in_range(ch)) {
+ lua_pushinteger(L, tex_get_lc_code(ch));
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+static int texlib_getuccode(lua_State *L)
+{
+ int ch = lmt_checkinteger(L, 1);
+ if (character_in_range(ch)) {
+ lua_pushinteger(L, tex_get_uc_code(ch));
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+static int texlib_getsfcode(lua_State *L)
+{
+ int ch = lmt_checkinteger(L, 1);
+ if (character_in_range(ch)) {
+ lua_pushinteger(L, tex_get_sf_code(ch));
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+static int texlib_gethccode(lua_State *L)
+{
+ int ch = lmt_checkinteger(L, 1);
+ if (character_in_range(ch)) {
+ lua_pushinteger(L, tex_get_hc_code(ch));
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+static int texlib_gethmcode(lua_State *L)
+{
+ int ch = lmt_checkinteger(L, 1);
+ if (character_in_range(ch)) {
+ lua_pushinteger(L, tex_get_hm_code(ch));
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+/* [global] [cattable] code value */
+
+static int texlib_setcatcode(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int cattable = ((top - slot + 1) >= 3) ? lmt_checkinteger(L, slot++) : cat_code_table_par;
+ int ch = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch)) {
+ halfword val = lmt_checkhalfword(L, slot);
+ if (catcode_in_range(val)) {
+ tex_set_cat_code(cattable, ch, val, level);
+ } else {
+ texlib_aux_show_catcode_error(L, val);
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ }
+ return 0;
+}
+
+/* [cattable] code */
+
+static int texlib_getcatcode(lua_State *L)
+{
+ int slot = 1;
+ int cattable = (lua_gettop(L) > 1) ? lmt_checkinteger(L, slot++) : cat_code_table_par;
+ int ch = lmt_checkinteger(L, slot);
+ if (character_in_range(ch)) {
+ lua_pushinteger(L, tex_get_cat_code(cattable, ch));
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ lua_pushinteger(L, 12); /* other */
+ }
+ return 1;
+}
+
+/*
+ [global] code { c f ch }
+ [global] code c f ch (a bit easier on memory, counterpart of getter)
+*/
+
+static int texlib_setmathcode(lua_State *L)
+{
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int ch = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch)) {
+ halfword cval, fval, chval;
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ cval = lmt_checkhalfword(L, slot++);
+ fval = lmt_checkhalfword(L, slot++);
+ chval = lmt_checkhalfword(L, slot);
+ break;
+ case LUA_TTABLE:
+ lua_rawgeti(L, slot, 1);
+ cval = lmt_checkhalfword(L, -1);
+ lua_rawgeti(L, slot, 2);
+ fval = lmt_checkhalfword(L, -1);
+ lua_rawgeti(L, slot, 3);
+ chval = lmt_checkhalfword(L, -1);
+ lua_pop(L, 3);
+ break;
+ default:
+ return luaL_error(L, "number of table expected");
+ }
+ if (class_in_range(cval)) {
+ if (family_in_range(fval)) {
+ if (character_in_range(chval)) {
+ mathcodeval m;
+ m.character_value = chval;
+ m.class_value = (short) cval;
+ m.family_value = (short) fval;
+ tex_set_math_code(ch, m, (quarterword) (level));
+ } else {
+ texlib_aux_show_character_error(L, chval);
+ }
+ } else {
+ texlib_aux_show_family_error(L, fval);
+ }
+ } else {
+ texlib_aux_show_class_error(L, cval);
+ }
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+return 0;
+}
+
+static int texlib_getmathcode(lua_State* L)
+{
+ mathcodeval mval = { 0, 0, 0 };
+ int ch = lmt_checkinteger(L, -1);
+ if (character_in_range(ch)) {
+ mval = tex_get_math_code(ch);
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ lua_createtable(L, 3, 0);
+ lua_pushinteger(L, mval.class_value);
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, mval.family_value);
+ lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, mval.character_value);
+ lua_rawseti(L, -2, 3);
+ return 1;
+}
+
+static int texlib_getmathcodes(lua_State* L)
+{
+ mathcodeval mval = { 0, 0, 0 };
+ int ch = lmt_checkinteger(L, -1);
+ if (character_in_range(ch)) {
+ mval = tex_get_math_code(ch);
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ lua_pushinteger(L, mval.class_value);
+ lua_pushinteger(L, mval.family_value);
+ lua_pushinteger(L, mval.character_value);
+ return 3;
+}
+
+/*
+ [global] code { c f ch }
+ [global] code c f ch (a bit easier on memory, counterpart of getter)
+*/
+
+static int texlib_setdelcode(lua_State* L)
+{
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ /* todo: when no integer than do a reset */
+ int ch = lmt_checkinteger(L, slot++);
+ if (character_in_range(ch)) {
+ halfword sfval, scval, lfval, lcval;
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ sfval = lmt_checkhalfword(L, slot++);
+ scval = lmt_checkhalfword(L, slot++);
+ lfval = lmt_checkhalfword(L, slot++);
+ lcval = lmt_checkhalfword(L, slot);
+ break;
+ case LUA_TTABLE:
+ lua_rawgeti(L, slot, 1);
+ sfval = lmt_checkhalfword(L, -1);
+ lua_rawgeti(L, slot, 2);
+ scval = lmt_checkhalfword(L, -1);
+ lua_rawgeti(L, slot, 3);
+ lfval = lmt_checkhalfword(L, -1);
+ lua_rawgeti(L, slot, 4);
+ lcval = lmt_checkhalfword(L, -1);
+ lua_pop(L, 4);
+ break;
+ default:
+ return luaL_error(L, "number of table expected");
+ }
+ if (family_in_range(sfval)) {
+ if (character_in_range(scval)) {
+ if (family_in_range(lfval)) {
+ if (character_in_range(lcval)) {
+ delcodeval d;
+ d.small.class_value = 0;
+ d.small.family_value = (short) sfval;
+ d.small.character_value = scval;
+ d.large.class_value = 0;
+ d.large.family_value = (short) lfval;
+ d.large.character_value = lcval;
+ tex_set_del_code(ch, d, (quarterword) (level));
+ }
+ else {
+ texlib_aux_show_character_error(L, lcval);
+ }
+ }
+ else {
+ texlib_aux_show_family_error(L, lfval);
+ }
+ }
+ else {
+ texlib_aux_show_character_error(L, scval);
+ }
+ }
+ else {
+ texlib_aux_show_family_error(L, sfval);
+ }
+ }
+ else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ return 0;
+}
+
+static int texlib_getdelcode(lua_State* L)
+{
+ delcodeval dval = tex_no_del_code();
+ int ch = lmt_checkinteger(L, -1);
+ if (character_in_range(ch)) {
+ dval = tex_get_del_code(ch);
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ if (tex_has_del_code(dval)) {
+ lua_createtable(L, 4, 0);
+ lua_pushinteger(L, dval.small.family_value);
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, dval.small.character_value);
+ lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, dval.large.family_value);
+ lua_rawseti(L, -2, 3);
+ lua_pushinteger(L, dval.large.character_value);
+ lua_rawseti(L, -2, 4);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int texlib_getdelcodes(lua_State* L)
+{
+ delcodeval dval = tex_no_del_code();
+ int ch = lmt_checkinteger(L, -1);
+ if (character_in_range(ch)) {
+ dval = tex_get_del_code(ch);
+ } else {
+ texlib_aux_show_character_error(L, ch);
+ }
+ if (tex_has_del_code(dval)) {
+ lua_pushinteger(L, dval.small.family_value);
+ lua_pushinteger(L, dval.small.character_value);
+ lua_pushinteger(L, dval.large.family_value);
+ lua_pushinteger(L, dval.large.character_value);
+ } else {
+ lua_pushnil(L);
+ }
+ return 4;
+}
+
+static halfword texlib_aux_getdimension(lua_State* L, int index)
+{
+ switch (lua_type(L, index)) {
+ case LUA_TNUMBER:
+ return lmt_toroundnumber(L, index);
+ case LUA_TSTRING:
+ return texlib_aux_dimen_to_number(L, lua_tostring(L, index));
+ default:
+ luaL_error(L, "string or number expected (dimension)");
+ return 0;
+ }
+}
+
+static halfword texlib_aux_getinteger(lua_State* L, int index)
+{
+ switch (lua_type(L, index)) {
+ case LUA_TNUMBER:
+ return lmt_toroundnumber(L, index);
+ default:
+ luaL_error(L, "number expected (integer)");
+ return 0;
+ }
+}
+
+static halfword texlib_toparshape(lua_State *L, int i)
+{
+ if (lua_type(L, i) == LUA_TTABLE) {
+ halfword n = (halfword) luaL_len(L, i);
+ if (n > 0) {
+ halfword p = tex_new_specification_node(n, par_shape_code, 0); /* todo: repeat but then not top based */
+ lua_push_key(repeat);
+ if (lua_rawget(L, -2) == LUA_TBOOLEAN && lua_toboolean(L, -1)) {
+ tex_set_specification_option(p, specification_option_repeat);
+ }
+ lua_pop(L, 1);
+ /* fill |p| */
+ for (int j = 1; j <= n; j++) {
+ halfword indent = 0;
+ halfword width = 0;
+ if (lua_rawgeti(L, i, j) == LUA_TTABLE) {
+ if (lua_rawgeti(L, -1, 1) == LUA_TNUMBER) {
+ indent = lmt_toroundnumber(L, -1);
+ if (lua_rawgeti(L, -2, 2) == LUA_TNUMBER) {
+ width = lmt_toroundnumber(L, -1);
+ }
+ lua_pop(L, 1);
+ }
+ lua_pop(L, 1);
+ }
+ lua_pop(L, 1);
+ tex_set_specification_indent(p, j, indent);
+ tex_set_specification_width(p, j, width);
+ }
+ return p;
+ }
+ }
+ return null;
+}
+
+static int texlib_shiftparshape(lua_State *L)
+{
+ if (par_shape_par) {
+ tex_shift_specification_list(par_shape_par, lmt_tointeger(L, 1), lua_toboolean(L, 2));
+ }
+ return 0;
+}
+
+static int texlib_snapshotpar(lua_State *L)
+{
+ halfword par = tex_find_par_par(cur_list.head);
+ if (par) {
+ if (lua_type(L, 1) == LUA_TNUMBER) {
+ tex_snapshot_par(par, lmt_tointeger(L, 1));
+ }
+ lua_pushinteger(L, par_state(par));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int texlib_getparstate(lua_State *L)
+{
+ lua_createtable(L, 0, 7);
+ lua_push_integer_at_key(L, hsize, hsize_par);
+ lua_push_integer_at_key(L, leftskip, left_skip_par ? glue_amount(left_skip_par) : 0);
+ lua_push_integer_at_key(L, rightskip, right_skip_par ? glue_amount(right_skip_par) : 0);
+ lua_push_integer_at_key(L, hangindent, hang_indent_par);
+ lua_push_integer_at_key(L, hangafter, hang_after_par);
+ lua_push_integer_at_key(L, parindent, par_indent_par);
+ lua_push_specification_at_key(L, parshape, par_shape_par);
+ return 1;
+}
+
+static int texlib_set_item(lua_State* L, int index, int prefixes)
+{
+ int flags = 0;
+ int slot = lmt_check_for_flags(L, index, &flags, prefixes, 0);
+ size_t sl;
+ const char *st = lua_tolstring(L, slot++, &sl);
+ if (sl > 0) {
+ int cs = tex_string_locate(st, sl, 0);
+ if (cs != undefined_control_sequence && has_eq_flag_bits(cs, primitive_flag_bit)) {
+ int cmd = eq_type(cs);
+ switch (cmd) {
+ case internal_int_cmd:
+ case register_int_cmd: /* ? */
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ {
+ int n = lmt_tointeger(L, slot++);
+ if (cmd == register_int_cmd) {
+ tex_word_define(flags, eq_value(cs), n);
+ } else {
+ tex_assign_internal_int_value(lua_toboolean(L, slot) ? add_frozen_flag(flags) : flags, eq_value(cs), n);
+ }
+ break;
+ }
+ default:
+ luaL_error(L, "number expected");
+ break;
+ }
+ return 1;
+ case internal_dimen_cmd:
+ case register_dimen_cmd:
+ {
+ halfword n = texlib_aux_getdimension(L, slot);
+ if (cmd == register_dimen_cmd) {
+ tex_word_define(flags, eq_value(cs), n);
+ } else {
+ tex_assign_internal_dimen_value(lua_toboolean(L, slot) ? add_frozen_flag(flags) : flags, eq_value(cs), n);
+ }
+ return 1;
+ }
+ case internal_glue_cmd:
+ case register_glue_cmd:
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ {
+ int top = lua_gettop(L);
+ halfword value = tex_copy_node(zero_glue);
+ glue_amount(value) = lmt_toroundnumber(L, slot++);
+ if (slot <= top) {
+ glue_stretch(value) = lmt_toroundnumber(L, slot++);
+ if (slot <= top) {
+ glue_shrink(value) = lmt_toroundnumber(L, slot++);
+ if (slot <= top) {
+ glue_stretch_order(value) = lmt_tohalfword(L, slot++);
+ if (slot <= top) {
+ glue_shrink_order(value) = lmt_tohalfword(L, slot);
+ }
+ }
+ }
+ }
+ if (cmd == register_glue_cmd) {
+ tex_word_define(flags, eq_value(cs), value);
+ } else {
+ tex_assign_internal_skip_value(lua_toboolean(L, slot) ? add_frozen_flag(flags) : flags, eq_value(cs), value);
+ }
+ break;
+ }
+ case LUA_TUSERDATA:
+ {
+ halfword n = lmt_check_isnode(L, slot);
+ if (node_type(n) == glue_spec_node) {
+ if (cmd == register_glue_cmd) {
+ tex_word_define(flags, eq_value(cs), n);
+ } else {
+ tex_assign_internal_skip_value(lua_toboolean(L, slot) ? add_frozen_flag(flags) : flags, eq_value(cs), n);
+ }
+ } else {
+ luaL_error(L, "gluespec node expected");
+ }
+ break;
+ }
+ default:
+ luaL_error(L, "number or node expected");
+ break;
+ }
+ return 1;
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ int t = lmt_token_list_from_lua(L, slot);
+ // define(flags, eq_value(cs), call_cmd, t); /* was call_cmd */
+ tex_define(flags, eq_value(cs), cmd == internal_toks_cmd ? internal_toks_reference_cmd : register_toks_reference_cmd, t); /* eq_value(cs) and not cs ? */
+ break;
+ }
+ default:
+ luaL_error(L, "string expected");
+ break;
+ }
+ return 1;
+ case set_page_property_cmd:
+ /*tex This could be |set_page_property_value| instead. */
+ switch (eq_value(cs)) {
+ // case page_goal_code:
+ // case page_total_code:
+ // case page_vsize_code:
+ case page_depth_code:
+ lmt_page_builder_state.depth = texlib_aux_getdimension(L, slot);
+ break;
+ // case page_stretch_code:
+ // case page_filstretch_code:
+ // case page_fillstretch_code:
+ // case page_filllstretch_code:
+ // case page_shrink_code:
+ case insert_storing_code:
+ lmt_insert_state.storing = texlib_aux_getinteger(L, slot);
+ break;
+ // case dead_cycles_code:
+ // case insert_penalties_code:
+ // case interaction_mode_code:
+ default:
+ return 0;
+ }
+ case set_auxiliary_cmd:
+ /*tex This could be |set_aux_value| instead. */
+ switch (eq_value(cs)) {
+ case space_factor_code:
+ cur_list.space_factor = texlib_aux_getinteger(L, slot);
+ return 1;
+ case prev_depth_code:
+ cur_list.prev_depth = texlib_aux_getdimension(L, slot);
+ return 1;
+ case prev_graf_code:
+ cur_list.prev_graf = texlib_aux_getinteger(L, slot);
+ return 1;
+ default:
+ return 0;
+ }
+ case set_box_property_cmd:
+ /*tex This could be |set_box_property_value| instead. */
+ return 0;
+ case set_specification_cmd:
+ {
+ int chr = internal_specification_number(eq_value(cs));
+ switch (chr) {
+ case par_shape_code:
+ {
+ halfword p = texlib_toparshape(L, slot);
+ tex_define(flags, eq_value(cs), specification_reference_cmd, p);
+ // lua_toboolean(L, slot + 1) ? add_frozen_flag(flags) : flags
+ if (is_frozen(flags) && cur_mode == hmode) {
+ tex_update_par_par(specification_reference_cmd, chr);
+ }
+ break;
+ }
+ }
+ return 0;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static int texlib_set(lua_State *L)
+{
+ texlib_set_item(L, 1, 1);
+ return 0;
+}
+
+static int texlib_newindex(lua_State *L)
+{
+ if (! texlib_set_item(L, 2, 0)) {
+ lua_rawset(L, 1);
+ }
+ return 0;
+}
+
+static int texlib_aux_convert(lua_State *L, int cur_code)
+{
+ int i = -1;
+ char *str = NULL;
+ switch (cur_code) {
+ /* ignored (yet) */
+ case insert_progress_code: /* arg <register int> */
+ case lua_code: /* arg complex */
+ case lua_escape_string_code: /* arg token list */
+ case string_code: /* arg token */
+ case cs_string_code: /* arg token */
+ case detokenized_code: /* arg token */
+ case meaning_code: /* arg token */
+ case to_mathstyle_code:
+ break;
+ /* the next fall through, and come from 'official' indices! */
+ case font_name_code: /* arg fontid */
+ case font_specification_code: /* arg fontid */
+ case font_identifier_code: /* arg fontid */
+ case number_code: /* arg int */
+ case to_integer_code: /* arg int */
+ case to_hexadecimal_code: /* arg int */
+ case to_scaled_code: /* arg int */
+ case to_sparse_scaled_code: /* arg int */
+ case to_dimension_code: /* arg int */
+ case to_sparse_dimension_code: /* arg int */
+ case roman_numeral_code: /* arg int */
+ if (lua_gettop(L) < 1) {
+ /* error */
+ }
+ i = lmt_tointeger(L, 1);
+ // fall through
+ default:
+ /* no backend here */
+ if (cur_code < 32) {
+ int texstr = tex_the_convert_string(cur_code, i);
+ if (texstr) {
+ str = tex_makecstring(texstr);
+ tex_flush_str(texstr);
+ }
+ }
+ break;
+ }
+ /* end */
+ if (str) {
+ lua_pushstring(L, str);
+ lmt_memory_free(str);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int texlib_aux_scan_internal(lua_State *L, int cmd, int code, int values)
+{
+ int retval = 1 ;
+ int save_cur_val = cur_val;
+ int save_cur_val_level = cur_val_level;
+ tex_scan_something_simple(cmd, code);
+ switch (cur_val_level) {
+ case int_val_level:
+ case dimen_val_level:
+ case attr_val_level:
+ lua_pushinteger(L, cur_val);
+ break;
+ case glue_val_level:
+ case mu_val_level:
+ switch (values) {
+ case 0:
+ lua_pushinteger(L, glue_amount(cur_val));
+ tex_flush_node(cur_val);
+ break;
+ case 1:
+ lua_pushinteger(L, glue_amount(cur_val));
+ lua_pushinteger(L, glue_stretch(cur_val));
+ lua_pushinteger(L, glue_shrink(cur_val));
+ lua_pushinteger(L, glue_stretch_order(cur_val));
+ lua_pushinteger(L, glue_shrink_order(cur_val));
+ tex_flush_node(cur_val);
+ retval = 5;
+ break;
+ default:
+ lmt_push_node_fast(L, cur_val);
+ break;
+ }
+ break;
+ case list_val_level:
+ lmt_push_node_fast(L, cur_val);
+ break;
+ default:
+ {
+ int texstr = tex_the_scanned_result();
+ char *str = tex_makecstring(texstr);
+ if (str) {
+ lua_pushstring(L, str);
+ lmt_memory_free(str);
+ } else {
+ lua_pushnil(L);
+ }
+ tex_flush_str(texstr);
+ }
+ break;
+ }
+ cur_val = save_cur_val;
+ cur_val_level = save_cur_val_level;
+ return retval;
+}
+
+/*tex
+ Todo: complete this one.
+*/
+
+static int texlib_aux_someitem(lua_State *L, int code)
+{
+ switch (code) {
+ /* the next two do not actually exist */
+ /* case attrexpr_code: */
+ /* break; */
+ /* the expressions do something complicated with arguments, yuck */
+ case numexpr_code:
+ case dimexpr_code:
+ case glueexpr_code:
+ case muexpr_code:
+ case numexpression_code:
+ case dimexpression_code:
+ break;
+ // case dimen_to_scale_code:
+ case numeric_scale_code:
+ break;
+ case index_of_register_code:
+ case index_of_character_code:
+ break;
+ case last_chk_num_code:
+ case last_chk_dim_code:
+ break;
+ /* these read a glue or muglue, todo */
+ case mu_to_glue_code:
+ case glue_to_mu_code:
+ case glue_stretch_order_code:
+ case glue_shrink_order_code:
+ case glue_stretch_code:
+ case glue_shrink_code:
+ break;
+ /* these read a fontid and a char, todo */
+ case font_id_code:
+ case glyph_x_scaled_code:
+ case glyph_y_scaled_code:
+ /* these read a font, todo */
+ case font_spec_id_code:
+ case font_spec_scale_code:
+ case font_spec_xscale_code:
+ case font_spec_yscale_code:
+ /* these need a spec, todo */
+ break;
+ case font_char_wd_code:
+ case font_char_ht_code:
+ case font_char_dp_code:
+ case font_char_ic_code:
+ case font_char_ta_code:
+ /* these read a char, todo */
+ break;
+ case font_size_code:
+ lua_pushinteger(L, font_size(cur_font_par));
+ break;
+ case font_math_control_code:
+ lua_pushinteger(L, font_mathcontrol(cur_font_par));
+ break;
+ case font_text_control_code:
+ lua_pushinteger(L, font_textcontrol(cur_font_par));
+ break;
+ case math_scale_code:
+ break;
+ case math_style_code:
+ {
+ int style = tex_current_math_style();
+ if (style >= 0) {
+ lua_pushinteger(L, style);
+ return 1;
+ } else {
+ break;
+ }
+ }
+ /* these read a char, todo */
+ case math_main_style_code:
+ {
+ int style = tex_current_math_main_style();
+ if (style >= 0) {
+ lua_pushinteger(L, style);
+ return 1;
+ } else {
+ break;
+ }
+ }
+ /* these read a char, todo */
+ case math_char_class_code:
+ case math_char_fam_code:
+ case math_char_slot_code:
+ break;
+ case last_arguments_code:
+ lua_pushinteger(L, lmt_expand_state.arguments);
+ return 1;
+ case parameter_count_code:
+ lua_pushinteger(L, tex_get_parameter_count());
+ return 1;
+ /* case lua_value_function_code: */
+ /* break; */
+ case insert_progress_code:
+ break;
+ /* these read an integer, todo */
+ case left_margin_kern_code:
+ case right_margin_kern_code:
+ break;
+ case par_shape_length_code:
+ case par_shape_indent_code:
+ case par_shape_dimen_code:
+ break;
+ case lastpenalty_code:
+ case lastkern_code:
+ case lastskip_code:
+ case lastboundary_code:
+ case last_node_type_code:
+ case last_node_subtype_code:
+ case input_line_no_code:
+ case badness_code:
+ case overshoot_code:
+ case luatex_version_code:
+ case luatex_revision_code:
+ case current_group_level_code:
+ case current_group_type_code:
+ case current_if_level_code:
+ case current_if_type_code:
+ case current_if_branch_code:
+ return texlib_aux_scan_internal(L, some_item_cmd, code, -1);
+ case last_left_class_code:
+ lua_pushinteger(L, lmt_math_state.last_left);
+ return 1;
+ case last_right_class_code:
+ lua_pushinteger(L, lmt_math_state.last_right);
+ return 1;
+ case last_atom_class_code:
+ lua_pushinteger(L, lmt_math_state.last_atom);
+ return 1;
+ case current_loop_iterator_code:
+ case last_loop_iterator_code:
+ lua_pushinteger(L, lmt_main_control_state.loop_iterator);
+ return 1;
+ case current_loop_nesting_code:
+ lua_pushinteger(L, lmt_main_control_state.loop_nesting);
+ return 1;
+ case last_par_context_code:
+ lua_pushinteger(L, lmt_main_control_state.last_par_context);
+ return 1;
+ case last_page_extra_code:
+ lua_pushinteger(L, lmt_page_builder_state.last_extra_used);
+ return 1;
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int texlib_setmath(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 3) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 1, &level, cur_level);
+ int param = lmt_get_math_parameter(L, slot++, -1);
+ int style = lmt_get_math_style(L, slot++, -1);
+ if (param < 0 || style < 0) {
+ /* invalid spec, just ignore it */
+ } else {
+ switch (math_parameter_value_type(param)) {
+ case math_int_parameter:
+ case math_dimen_parameter:
+ case math_style_parameter:
+ tex_def_math_parameter(style, param, (scaled) lmt_optroundnumber(L, slot, 0), level, indirect_math_regular);
+ break;
+ case math_muglue_parameter:
+ {
+ halfword p = tex_copy_node(zero_glue);
+ glue_amount(p) = lmt_optroundnumber(L, slot++, 0);
+ glue_stretch(p) = lmt_optroundnumber(L, slot++, 0);
+ glue_shrink(p) = lmt_optroundnumber(L, slot++, 0);
+ glue_stretch_order(p) = lmt_optroundnumber(L, slot++, 0);
+ glue_shrink_order(p) = lmt_optroundnumber(L, slot, 0);
+ tex_def_math_parameter(style, param, (scaled) p, level, indirect_math_regular);
+ break;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static int texlib_getmath(lua_State *L)
+{
+ if (lua_gettop(L) == 2) {
+ int param = lmt_get_math_parameter(L, 1, -1);
+ int style = lmt_get_math_style(L, 2, -1);
+ if (param >= 0 && style >= 0) {
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value != undefined_math_parameter) {
+ switch (math_parameter_value_type(param)) {
+ case math_int_parameter:
+ case math_dimen_parameter:
+ case math_style_parameter:
+ lua_pushinteger(L, value);
+ return 1;
+ case math_muglue_parameter:
+ if (value <= thick_mu_skip_code) {
+ value = glue_parameter(value);
+ }
+ lua_pushinteger(L, glue_amount(value));
+ lua_pushinteger(L, glue_stretch(value));
+ lua_pushinteger(L, glue_shrink(value));
+ lua_pushinteger(L, glue_stretch_order(value));
+ lua_pushinteger(L, glue_shrink_order(value));
+ return 5;
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/*tex
+
+ This one is purely for diagnostic pusposed as normally there is some scaling
+ involved related to the current style and such.
+
+*/
+
+static int texlib_getfontname(lua_State *L)
+{
+ return texlib_aux_convert(L, font_name_code);
+}
+
+static int texlib_getfontidentifier(lua_State *L)
+{
+ return texlib_aux_convert(L, font_identifier_code);
+}
+
+static int texlib_getfontoffamily(lua_State *L)
+{
+ int f = lmt_checkinteger(L, 1);
+ int s = lmt_optinteger(L, 2, 0); /* this should be a multiple of 256 ! */
+ lua_pushinteger(L, tex_fam_fnt(f, s));
+ return 1;
+}
+
+static int texlib_getnumber(lua_State *L)
+{
+ return texlib_aux_convert(L, number_code); /* check */
+}
+
+// static int texlib_getdimension(lua_State *L)
+// {
+// return texlib_aux_convert(L, to_dimension_code); /* check */
+// }
+
+static int texlib_getromannumeral(lua_State *L)
+{
+ return texlib_aux_convert(L, roman_numeral_code);
+}
+
+static int texlib_get_internal(lua_State *L, int index, int all)
+{
+ if (lua_type(L, index) == LUA_TSTRING) {
+ size_t l;
+ const char *s = lua_tolstring(L, index, &l);
+ if (l == 0) {
+ return 0;
+ } else if (lua_key_eq(s, prevdepth)) {
+ lua_pushinteger(L, cur_list.prev_depth);
+ return 1;
+ } else if (lua_key_eq(s, prevgraf)) {
+ lua_pushinteger(L, cur_list.prev_graf);
+ return 1;
+ } else if (lua_key_eq(s, spacefactor)) {
+ lua_pushinteger(L, cur_list.space_factor);
+ return 1;
+ } else {
+ /*tex
+ We no longer get the info from the primitives hash but use the current
+ primitive meaning.
+ */ /*
+ int ts = maketexlstring(s, l);
+ int cs = prim_lookup(ts);
+ flush_str(ts);
+ if (cs > 0) {
+ int cs = string_locate(s, l, 0);
+ if (cs != undefined_control_sequence && has_eq_flag_bits(cs, primitive_flag_bit)) {
+ int cmd = get_prim_eq_type(cs);
+ int code = get_prim_equiv(cs);
+ */
+ int cs = tex_string_locate(s, l, 0);
+ if (cs != undefined_control_sequence && has_eq_flag_bits(cs, primitive_flag_bit)) {
+ int cmd = eq_type(cs);
+ int code = eq_value(cs);
+ switch (cmd) {
+ case some_item_cmd:
+ return texlib_aux_someitem(L, code);
+ case convert_cmd:
+ return texlib_aux_convert(L, code);
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ case internal_int_cmd:
+ case register_int_cmd:
+ case internal_attribute_cmd:
+ case register_attribute_cmd:
+ case internal_dimen_cmd:
+ case register_dimen_cmd:
+ case lua_value_cmd:
+ case iterator_value_cmd:
+ case set_auxiliary_cmd:
+ case set_page_property_cmd:
+ case char_given_cmd:
+ // case math_char_given_cmd:
+ case integer_cmd:
+ case dimension_cmd:
+ case gluespec_cmd:
+ case mugluespec_cmd:
+ case mathspec_cmd:
+ case fontspec_cmd:
+ return texlib_aux_scan_internal(L, cmd, code, -1);
+ case internal_glue_cmd:
+ case register_glue_cmd:
+ case internal_mu_glue_cmd:
+ case register_mu_glue_cmd:
+ return texlib_aux_scan_internal(L, cmd, code, all);
+ case set_specification_cmd:
+ return lmt_push_specification(L, specification_parameter(internal_specification_number(code)), all); /* all == countonly */
+ default:
+ /* tex_formatted_warning("tex.get", "ignoring cmd %i: %s\n", cmd, s); */
+ break;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static int texlib_get(lua_State *L)
+{
+ /* stack: key [boolean] */
+ int ret = texlib_get_internal(L, 1, (lua_type(L, 2) == LUA_TBOOLEAN) ? lua_toboolean(L, 2) : -1);
+ if (ret) {
+ return ret;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int texlib_index(lua_State *L)
+{
+ /* stack: table key */
+ int ret = texlib_get_internal(L, 2, -1);
+ if (ret) {
+ return ret;
+ } else {
+ lua_rawget(L, 1);
+ return 1;
+ }
+}
+
+static int texlib_getlist(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ if (! s) {
+ lua_pushnil(L);
+ } else if (lua_key_eq(s, pageinserthead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(page_insert_list_type, NULL));
+ } else if (lua_key_eq(s, contributehead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(contribute_list_type, NULL));
+ } else if (lua_key_eq(s, pagehead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(page_list_type, NULL));
+ } else if (lua_key_eq(s, temphead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(temp_list_type, NULL));
+ } else if (lua_key_eq(s, holdhead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(hold_list_type, NULL));
+ } else if (lua_key_eq(s, postadjusthead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(post_adjust_list_type, NULL));
+ } else if (lua_key_eq(s, preadjusthead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(pre_adjust_list_type, NULL));
+ } else if (lua_key_eq(s, postmigratehead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(post_migrate_list_type, NULL));
+ } else if (lua_key_eq(s, premigratehead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(pre_migrate_list_type, NULL));
+ } else if (lua_key_eq(s, alignhead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(align_list_type, NULL));
+ } else if (lua_key_eq(s, pagediscardshead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(page_discards_list_type, NULL));
+ } else if (lua_key_eq(s, splitdiscardshead)) {
+ lmt_push_node_fast(L, tex_get_special_node_list(split_discards_list_type, NULL));
+ } else if (lua_key_eq(s, bestpagebreak)) {
+ lmt_push_node_fast(L, lmt_page_builder_state.best_break);
+ } else if (lua_key_eq(s, leastpagecost)) {
+ lua_pushinteger(L, lmt_page_builder_state.least_cost);
+ } else if (lua_key_eq(s, bestsize)) {
+ lua_pushinteger(L, lmt_page_builder_state.best_size); /* is pagegoal but can be unset and also persistent */
+ } else if (lua_key_eq(s, insertpenalties)) {
+ lua_pushinteger(L, lmt_page_builder_state.insert_penalties);
+ } else if (lua_key_eq(s, insertheights)) {
+ lua_pushinteger(L, lmt_page_builder_state.insert_heights);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* todo: accept direct node too */
+
+static int texlib_setlist(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ if (! s) {
+ /* This is silently ignored */
+ } else if (lua_key_eq(s, bestsize)) {
+ lmt_page_builder_state.best_size = lmt_toscaled(L, 2); /* is pagegoal but can be unset and also persistent */
+ } else if (lua_key_eq(s, leastpagecost)) {
+ lmt_page_builder_state.least_cost = lmt_tointeger(L, 2);
+ } else if (lua_key_eq(s, insertpenalties)) {
+ lmt_page_builder_state.insert_penalties = lmt_tointeger(L, 2);
+ } else if (lua_key_eq(s, insertheights)) {
+ lmt_page_builder_state.insert_heights = lmt_tointeger(L, 2);
+ } else {
+ halfword n = null;
+ if (! lua_isnil(L, 2)) {
+ n = lmt_check_isnode(L, 2);
+ }
+ if (lua_key_eq(s, pageinserthead)) {
+ tex_set_special_node_list(page_insert_list_type, n);
+ } else if (lua_key_eq(s, contributehead)) {
+ tex_set_special_node_list(contribute_list_type, n);
+ } else if (lua_key_eq(s, pagehead)) {
+ tex_set_special_node_list(page_list_type, n);
+ } else if (lua_key_eq(s, temphead)) {
+ tex_set_special_node_list(temp_list_type, n);
+ } else if (lua_key_eq(s, pagediscardshead)) {
+ tex_set_special_node_list(page_discards_list_type, n);
+ } else if (lua_key_eq(s, splitdiscardshead)) {
+ tex_set_special_node_list(split_discards_list_type, n);
+ } else if (lua_key_eq(s, holdhead)) {
+ tex_set_special_node_list(hold_list_type, n);
+ } else if (lua_key_eq(s, postadjusthead)) {
+ tex_set_special_node_list(post_adjust_list_type, n);
+ } else if (lua_key_eq(s, preadjusthead)) {
+ tex_set_special_node_list(pre_adjust_list_type, n);
+ } else if (lua_key_eq(s, postmigratehead)) {
+ tex_set_special_node_list(post_migrate_list_type, n);
+ } else if (lua_key_eq(s, premigratehead)) {
+ tex_set_special_node_list(pre_migrate_list_type, n);
+ } else if (lua_key_eq(s, alignhead)) {
+ tex_set_special_node_list(align_list_type, n);
+ } else if (lua_key_eq(s, bestpagebreak)) {
+ lmt_page_builder_state.best_break = n;
+ }
+ }
+ return 0;
+}
+
+static void texlib_get_nest_field(lua_State *L, const char *field, list_state_record *r)
+{
+
+ if (lua_key_eq(field, mode)) {
+ lua_pushinteger(L, r->mode);
+ } else if (lua_key_eq(field, head) || lua_key_eq(field, list)) {
+ /* we no longer check for special list nodes here so beware of prev-of-head */
+ lmt_push_node_fast(L, r->head);
+ } else if (lua_key_eq(field, tail)) {
+ /* we no longer check for special list nodes here so beware of next-of-tail */
+ lmt_push_node_fast(L, r->tail);
+ } else if (lua_key_eq(field, delimiter)) {
+ lmt_push_node_fast(L, r->delim);
+ } else if (lua_key_eq(field, prevgraf)) {
+ lua_pushinteger(L, r->prev_graf);
+ } else if (lua_key_eq(field, modeline)) {
+ lua_pushinteger(L, r->mode_line);
+ } else if (lua_key_eq(field, prevdepth)) {
+ lua_pushinteger(L, r->prev_depth);
+ } else if (lua_key_eq(field, spacefactor)) {
+ lua_pushinteger(L, r->space_factor);
+ } else if (lua_key_eq(field, noad)) {
+ lmt_push_node_fast(L, r->incomplete_noad);
+ } else if (lua_key_eq(field, direction)) {
+ lmt_push_node_fast(L, r->direction_stack);
+ } else if (lua_key_eq(field, mathdir)) {
+ lua_pushboolean(L, r->math_dir);
+ } else if (lua_key_eq(field, mathstyle)) {
+ lua_pushinteger(L, r->math_style);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static void texlib_set_nest_field(lua_State *L, int n, const char *field, list_state_record *r)
+{
+ if (lua_key_eq(field, mode)) {
+ r->mode = lmt_tointeger(L, n);
+ } else if (lua_key_eq(field, head) || lua_key_eq(field, list)) {
+ r->head = lmt_check_isnode(L, n);
+ } else if (lua_key_eq(field, tail)) {
+ r->tail = lmt_check_isnode(L, n);
+ } else if (lua_key_eq(field, delimiter)) {
+ r->delim = lmt_check_isnode(L, n);
+ } else if (lua_key_eq(field, prevgraf)) {
+ r->prev_graf = lmt_tointeger(L, n);
+ } else if (lua_key_eq(field, modeline)) {
+ r->mode_line = lmt_tointeger(L, n);
+ } else if (lua_key_eq(field, prevdepth)) {
+ r->prev_depth = lmt_toroundnumber(L, n);
+ } else if (lua_key_eq(field, spacefactor)) {
+ r->space_factor = lmt_toroundnumber(L, n);
+ } else if (lua_key_eq(field, noad)) {
+ r->incomplete_noad = lmt_check_isnode(L, n);
+ } else if (lua_key_eq(field, direction)) {
+ r->direction_stack = lmt_check_isnode(L, n);
+ } else if (lua_key_eq(field, mathdir)) {
+ r->math_dir = lua_toboolean(L, n);
+ } else if (lua_key_eq(field, mathstyle)) {
+ r->math_style = lmt_tointeger(L, n);
+ }
+}
+
+static int texlib_aux_nest_getfield(lua_State *L)
+{
+ list_state_record **rv = lua_touserdata(L, -2);
+ list_state_record *r = *rv;
+ const char *field = lua_tostring(L, -1);
+ texlib_get_nest_field(L, field, r);
+ return 1;
+}
+
+static int texlib_aux_nest_setfield(lua_State *L)
+{
+ list_state_record **rv = lua_touserdata(L, -3);
+ list_state_record *r = *rv;
+ const char *field = lua_tostring(L, -2);
+ texlib_set_nest_field(L, -1, field, r);
+ return 0;
+}
+
+static const struct luaL_Reg texlib_nest_metatable[] = {
+ { "__index", texlib_aux_nest_getfield },
+ { "__newindex", texlib_aux_nest_setfield },
+ { NULL, NULL },
+};
+
+static void texlib_aux_init_nest_lib(lua_State *L)
+{
+ luaL_newmetatable(L, TEX_NEST_INSTANCE);
+ luaL_setfuncs(L, texlib_nest_metatable, 0);
+ lua_pop(L, 1);
+}
+
+/* getnest(<number>|top|ptr,[fieldname]) */
+
+static int texlib_getnest(lua_State *L)
+{
+ int p = -1 ;
+ int t = lua_gettop(L);
+ if (t == 0) {
+ p = lmt_nest_state.nest_data.ptr;
+ } else {
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ {
+ int ptr = lmt_tointeger(L, 1);
+ if (ptr >= 0 && ptr <= lmt_nest_state.nest_data.ptr) {
+ p = ptr;
+ }
+ }
+ break;
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, 1);
+ if (lua_key_eq(s, top)) {
+ p = lmt_nest_state.nest_data.ptr;
+ } else if (lua_key_eq(s, ptr)) {
+ lua_pushinteger(L, lmt_nest_state.nest_data.ptr);
+ return 1;
+ }
+ }
+ break;
+ }
+ }
+ if (p > -1) {
+ if (t > 1) {
+ const char *field = lua_tostring(L, 2);
+ if (field) {
+ texlib_get_nest_field(L, field, &lmt_nest_state.nest[p]);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ list_state_record **nestitem = lua_newuserdatauv(L, sizeof(list_state_record *), 0);
+ *nestitem = &lmt_nest_state.nest[p];
+ luaL_getmetatable(L, TEX_NEST_INSTANCE);
+ lua_setmetatable(L, -2);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* setnest(<number>|top,fieldname,value) */
+
+static int texlib_setnest(lua_State *L)
+{
+ if (lua_gettop(L) > 2) {
+ int p = -1 ;
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ {
+ int ptr = lmt_tointeger(L, 1);
+ if (ptr >= 0 && ptr <= lmt_nest_state.nest_data.ptr) {
+ p = ptr;
+ }
+ }
+ break;
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, 1);
+ if (lua_key_eq(s, top)) {
+ p = lmt_nest_state.nest_data.ptr;
+ }
+ }
+ break;
+ }
+ if (p > -1) {
+ const char *field = lua_tostring(L, 2);
+ if (field) {
+ texlib_set_nest_field(L, 3, field, &lmt_nest_state.nest[p]);
+ }
+ }
+ }
+ return 0;
+}
+
+static int texlib_round(lua_State *L)
+{
+ /* lua_pushinteger(L, lmt_roundedfloat((double) lua_tonumber(L, 1))); */
+ lua_pushinteger(L, clippedround((double) lua_tonumber(L, 1)));
+ return 1;
+}
+
+static int texlib_scale(lua_State *L)
+{
+ double delta = luaL_checknumber(L, 2);
+ switch (lua_type(L, 1)) {
+ case LUA_TTABLE:
+ {
+ /*tex
+ We could preallocate the table or maybe scale in-place. The
+ new table is at index 3.
+ */
+ lua_newtable(L);
+ lua_pushnil(L);
+ while (lua_next(L, 1)) {
+ /*tex We have a numeric value. */
+ lua_pushvalue(L, -2);
+ lua_insert(L, -2);
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ double m = (double) lua_tonumber(L, -1) * delta;
+ lua_pop(L, 1);
+ /* lua_pushinteger(L, lmt_roundedfloat(m)); */
+ lua_pushinteger(L, clippedround(m));
+ }
+ lua_rawset(L, 3);
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ /* lua_pushinteger(L, lmt_roundedfloat((double) lua_tonumber(L, 1) * delta)); */
+ lua_pushinteger(L, clippedround((double) lua_tonumber(L, 1) * delta));
+ break;
+ default:
+ lua_pushnil(L);
+ break;
+ }
+ return 1;
+}
+
+/*tex
+ For compatibility reasons we keep the check for a boolean for a while. For consistency
+ we now support flags too: |global cs id|.
+
+*/
+
+static int texlib_definefont(lua_State *L)
+{
+ size_t l;
+ int slot = 1;
+ int flags = (lua_isboolean(L, slot) && lua_toboolean(L, slot++)) ? add_global_flag(0) : 0;
+ const char *csname = lua_tolstring(L, slot++, &l);
+ halfword id = lmt_tohalfword(L, slot++);
+ int cs = tex_string_locate(csname, l, 1);
+ lmt_check_for_flags(L, slot, &flags, 1, 1);
+ tex_define(flags, cs, set_font_cmd, id);
+ return 0;
+}
+
+static int texlib_hashtokens(lua_State *L)
+{
+ int cs = 1;
+ int nt = 0;
+ int nx = 0;
+ int all = lua_toboolean(L, 1);
+ lua_createtable(L, hash_size, 0);
+ if (all) {
+ while (cs <= hash_size) {
+ /* because strings never get freed we can as well directly access |s|. */
+ strnumber s = cs_text(cs);
+ if (s > 0) {
+ halfword n = cs_next(cs);
+ char *ss = tex_makecstring(s);
+ if (n) {
+ int mt = 0;
+ lua_createtable(L, 2, 0);
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ ++nt;
+ lua_rawseti(L, -2, ++mt);
+ while (n) {
+ s = cs_text(n);
+ if (s) {
+ ss = tex_makecstring(s);
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ lua_rawseti(L, -2, ++mt);
+ ++nt;
+ ++nx;
+ }
+ n = cs_next(n);
+ }
+ } else {
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ ++nt;
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ lua_rawseti(L, -2, cs);
+ cs++;
+ }
+ } else {
+ while (cs < hash_size) {
+ strnumber s = cs_text(cs);
+ if (s > 0) {
+ halfword n = cs_next(cs);
+ char *ss = tex_makecstring(s);
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ lua_rawseti(L, -2, ++nt);
+ while (n) {
+ s = cs_text(n);
+ if (s) {
+ ss = tex_makecstring(s);
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ lua_rawseti(L, -2, ++nt);
+ ++nx;
+ }
+ n = cs_next(n);
+ }
+ }
+ cs++;
+ }
+ }
+ lua_pushinteger(L, --cs);
+ lua_pushinteger(L, nt);
+ lua_pushinteger(L, nx);
+ return 4;
+}
+
+static int texlib_primitives(lua_State *L)
+{
+ int cs = 0;
+ int nt = 0;
+ lua_createtable(L, prim_size, 0);
+ while (cs < prim_size) {
+ strnumber s = get_prim_text(cs);
+ if (s > 0 && (get_prim_origin(cs) != no_command)) {
+ char *ss = tex_makecstring(s);
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ lua_rawseti(L, -2, ++nt);
+ }
+ cs++;
+ }
+ return 1;
+}
+
+static int texlib_extraprimitives(lua_State *L)
+{
+ int mask = 0;
+ int cs = 0;
+ int nt = 0;
+ int n = lua_gettop(L);
+ if (n == 0) {
+ mask = tex_command + etex_command + luatex_command;
+ } else {
+ for (int i = 1; i <= n; i++) {
+ if (lua_type(L, i) == LUA_TSTRING) {
+ const char *s = lua_tostring(L, i);
+ if (lua_key_eq(s, tex)) {
+ mask |= tex_command;
+ } else if (lua_key_eq(s, etex)) {
+ mask |= etex_command;
+ } else if (lua_key_eq(s, luatex)) {
+ mask |= luatex_command;
+ }
+ }
+ }
+ }
+ lua_createtable(L, prim_size, 0);
+ while (cs < prim_size) {
+ strnumber s = get_prim_text(cs);
+ if (s > 0 && (get_prim_origin(cs) & mask)) {
+ char *ss = tex_makecstring(s);
+ lua_pushstring(L, ss);
+ lmt_memory_free(ss);
+ lua_rawseti(L, -2, ++nt);
+ }
+ cs++;
+ }
+ return 1;
+}
+
+static void texlib_aux_enableprimitive(const char *pre, size_t prel, const char *prm)
+{
+ strnumber s = tex_maketexstring(prm);
+ halfword prm_val = tex_prim_lookup(s);
+ tex_flush_str(s);
+ if (prm_val != undefined_primitive && get_prim_origin(prm_val) != no_command) {
+ char *newprm;
+ size_t newlen;
+ halfword cmd = get_prim_eq_type(prm_val);
+ halfword chr = get_prim_equiv(prm_val);
+ if (strncmp(pre, prm, prel) != 0) {
+ /* not a prefix */
+ newlen = strlen(prm) + prel;
+ newprm = (char *) lmt_memory_malloc((size_t) newlen + 1);
+ if (newprm) {
+ strcpy(newprm, pre);
+ strcat(newprm + prel, prm);
+ } else {
+ tex_overflow_error("primitives", (int) newlen + 1);
+ }
+ } else {
+ newlen = strlen(prm);
+ newprm = (char *) lmt_memory_malloc((size_t) newlen + 1);
+ if (newprm) {
+ strcpy(newprm, prm);
+ } else {
+ tex_overflow_error("primitives", (int) newlen + 1);
+ }
+ }
+ if (newprm) {
+ halfword val = tex_string_locate(newprm, newlen, 1);
+ if (val == undefined_control_sequence || eq_type(val) == undefined_cs_cmd) {
+ tex_primitive_def(newprm, newlen, (singleword) cmd, chr);
+ }
+ lmt_memory_free(newprm);
+ }
+ }
+}
+
+static int texlib_enableprimitives(lua_State *L)
+{
+ if (lua_gettop(L) == 2) {
+ size_t lpre;
+ const char *pre = luaL_checklstring(L, 1, &lpre);
+ switch (lua_type(L, 2)) {
+ case LUA_TTABLE:
+ {
+ int i = 1;
+ while (1) {
+ if (lua_rawgeti(L, 2, i) == LUA_TSTRING) {
+ const char *prm = lua_tostring(L, 3);
+ texlib_aux_enableprimitive(pre, lpre, prm);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ lua_pop(L, 1);
+ i++;
+ }
+ }
+ break;
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 2)) {
+ for (int cs = 0; cs < prim_size; cs++) {
+ strnumber s = get_prim_text(cs);
+ if (s > 0) {
+ /* there is actually no need to copy */
+ char *prm = tex_makecstring(s);
+ texlib_aux_enableprimitive(pre, lpre, prm);
+ lmt_memory_free(prm);
+ }
+ }
+ }
+ break;
+ default:
+ luaL_error(L, "array of names or 'true' expected");
+ }
+ } else {
+ luaL_error(L, "wrong number of arguments");
+ }
+ return 0;
+}
+
+/*tex penalties */
+
+static halfword texlib_topenalties(lua_State *L, int i, quarterword s)
+{
+ int n = 0;
+ lua_pushnil(L);
+ while (lua_next(L, i)) {
+ n++;
+ lua_pop(L, 1);
+ }
+ if (n > 0) {
+ int j = 0;
+ halfword p = tex_new_specification_node(n, s, 0); /* todo: repeat */
+ lua_pushnil(L);
+ while (lua_next(L, i)) {
+ j++;
+ if (lua_type(L, -1) == LUA_TNUMBER) {
+ tex_set_specification_penalty(p, j, lmt_tohalfword(L, -1));
+ }
+ lua_pop(L, 1);
+ }
+ return p;
+ } else {
+ return null;
+ }
+}
+
+/*tex We should check for proper glue spec nodes ... todo. */
+
+# define get_dimen_par(P,A,B) \
+ lua_push_key(A); \
+ P = (lua_rawget(L, -2) == LUA_TNUMBER) ? lmt_roundnumber(L, -1) : B; \
+ lua_pop(L, 1);
+
+# define get_glue_par(P,A,B) \
+ lua_push_key(A); \
+ P = (lua_rawget(L, -2) == LUA_TUSERDATA) ? lmt_check_isnode(L, -1) : B; \
+ lua_pop(L, 1);
+
+# define get_integer_par(P,A,B) \
+ lua_push_key(A); \
+ P = (lua_rawget(L, -2) == LUA_TNUMBER) ? lmt_tohalfword(L, -1) : B; \
+ lua_pop(L, 1);
+
+# define get_penalties_par(P,A,B,C) \
+ lua_push_key(A); \
+ P = (lua_rawget(L, -2) == LUA_TTABLE) ? texlib_topenalties(L, lua_gettop(L), C) : B; \
+ lua_pop(L, 1);
+
+# define get_shape_par(P,A,B) \
+ lua_push_key(A); \
+ P = (lua_rawget(L, -2) == LUA_TTABLE) ? texlib_toparshape(L, lua_gettop(L)) : B; \
+ lua_pop(L, 1);
+
+/*tex
+ The next function needs to be kept in sync with the regular linebreak handler, wrt the special
+ skips. This one can be called from within the callback so then we already have intialized.
+*/
+
+
+/* par leftinit rightinit leftindent ... leftfill rightfill */
+
+static int texlib_preparelinebreak(lua_State *L)
+{
+ halfword direct;
+ halfword par = lmt_check_isdirectornode(L, 1, &direct);
+ if (node_type(par) == par_node) {
+ halfword tail = tex_tail_of_node_list(par);
+ if (node_type(tail) == glue_node && node_subtype(tail) == par_fill_right_skip_glue) {
+ tex_formatted_warning("linebreak", "list seems already prepared");
+ } else {
+ halfword parinit_left_skip_glue = null;
+ halfword parinit_right_skip_glue = null;
+ halfword parfill_left_skip_glue = null;
+ halfword parfill_right_skip_glue = null;
+ halfword final_penalty = null;
+ tex_line_break_prepare(par, &tail, &parinit_left_skip_glue, &parinit_right_skip_glue, &parfill_left_skip_glue, &parfill_right_skip_glue, &final_penalty);
+ lmt_push_directornode(L, par, direct);
+ lmt_push_directornode(L, tail, direct);
+ lmt_push_directornode(L, parinit_left_skip_glue, direct);
+ lmt_push_directornode(L, parinit_right_skip_glue, direct);
+ lmt_push_directornode(L, parfill_left_skip_glue , direct);
+ lmt_push_directornode(L, parfill_right_skip_glue, direct);
+ /* lmt_push_directornode(L, final_penalty, direct); */ /*tex Not that relevant to know. */
+ return 6;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int texlib_linebreak(lua_State *L)
+{
+ // halfword par = lmt_check_isnode(L, 1);
+ halfword direct;
+ halfword par = lmt_check_isdirectornode(L, 1, &direct);
+ if (node_type(par) == par_node) {
+ line_break_properties properties;
+ halfword tail = par;
+ halfword has_indent = null;
+ halfword has_penalty = 0;
+ halfword prepared = 0;
+ properties.initial_par = par;
+ properties.display_math = 0;
+ properties.paragraph_dir = par_dir(par);
+ properties.parfill_left_skip = null;
+ properties.parfill_right_skip = null;
+ properties.parinit_left_skip = null;
+ properties.parinit_right_skip = null;
+ while (tail) {
+ switch (node_type(tail)) {
+ case glue_node:
+ switch (node_subtype(tail)) {
+ case indent_skip_glue:
+ if (has_indent) {
+ tex_formatted_warning("linebreak", "duplicate %s glue in tex.linebreak", "indent");
+ goto NOTHING;
+ } else {
+ has_indent = 1;
+ }
+ break;
+ case par_fill_left_skip_glue:
+ if (properties.parfill_left_skip) {
+ tex_formatted_warning("linebreak", "duplicate %s glue in tex.linebreak", "leftskip");
+ goto NOTHING;
+ } else {
+ properties.parfill_left_skip = tail;
+ }
+ break;
+ case par_fill_right_skip_glue:
+ if (properties.parfill_right_skip) {
+ tex_formatted_warning("linebreak", "duplicate %s glue in tex.linebreak", "rightskip");
+ goto NOTHING;
+ } else {
+ properties.parfill_right_skip = tail;
+ }
+ break;
+ case par_init_left_skip_glue:
+ if (properties.parinit_left_skip) {
+ tex_formatted_warning("linebreak", "duplicate %s glue in tex.linebreak", "leftinit");
+ goto NOTHING;
+ } else {
+ properties.parinit_left_skip = tail;
+ }
+ break;
+ case par_init_right_skip_glue:
+ if (properties.parinit_right_skip) {
+ tex_formatted_warning("linebreak", "duplicate %s glue in tex.linebreak", "rightinit");
+ goto NOTHING;
+ } else {
+ properties.parinit_right_skip = tail;
+ }
+ break;
+ }
+ break;
+ case penalty_node:
+ if (node_subtype(tail) == line_penalty_subtype && penalty_amount(tail) == infinite_penalty && ! (properties.parfill_left_skip && properties.parfill_right_skip)) {
+ has_penalty = 1;
+ }
+ }
+ if (node_next(tail)) {
+ tail = node_next(tail);
+ } else {
+ break;
+ }
+ }
+ {
+ int has_init = properties.parinit_left_skip && properties.parinit_right_skip;
+ int has_fill = properties.parfill_left_skip && properties.parfill_right_skip;
+ if (lmt_linebreak_state.calling_back) {
+ if (has_indent && ! (has_init && has_fill && has_penalty)) {
+ tex_formatted_warning("linebreak", "[ par + leftinit + rightinit + indentglue + ... + penalty + leftfill + righfill ] expected");
+ goto NOTHING;
+ } else if (! (has_fill && has_penalty)) {
+ tex_formatted_warning("linebreak", "[ par + indentbox + ... + penalty + leftfill + righfill ] expected");
+ goto NOTHING;
+ } else {
+ prepared = 1;
+ }
+ } else {
+ if (! (has_indent && has_init && has_fill)) {
+ tex_formatted_warning("linebreak", "[ leftinit | rightinit | leftfill | rigthfill ] expected");
+ goto NOTHING;
+ } else {
+ // prepared = 0;
+ prepared = has_init && has_fill;
+ }
+ }
+ }
+ tex_push_nest();
+ node_next(temp_head) = par;
+ /*tex initialize local parameters */
+ if (lua_gettop(L) != 2 || lua_type(L, 2) != LUA_TTABLE) {
+ lua_newtable(L);
+ }
+ lua_push_key(direction);
+ if (lua_rawget(L, -2) == LUA_TNUMBER) {
+ properties.paragraph_dir = checked_direction_value(lmt_tointeger(L, -1));
+ }
+ lua_pop(L, 1);
+ get_integer_par (properties.tracing_paragraphs, tracingparagraphs, tracing_paragraphs_par);
+ get_integer_par (properties.pretolerance, pretolerance, tex_get_par_par(par, par_pre_tolerance_code));
+ get_integer_par (properties.tolerance, tolerance, tex_get_par_par(par, par_tolerance_code));
+ get_dimen_par (properties.emergency_stretch, emergencystretch, tex_get_par_par(par, par_emergency_stretch_code));
+ get_integer_par (properties.looseness, looseness, tex_get_par_par(par, par_looseness_code));
+ get_integer_par (properties.adjust_spacing, adjustspacing, tex_get_par_par(par, par_adjust_spacing_code));
+ get_integer_par (properties.protrude_chars, protrudechars, tex_get_par_par(par, par_protrude_chars_code));
+ get_integer_par (properties.adj_demerits, adjdemerits, tex_get_par_par(par, par_adj_demerits_code));
+ get_integer_par (properties.line_penalty, linepenalty, tex_get_par_par(par, par_line_penalty_code));
+ get_integer_par (properties.last_line_fit, lastlinefit, tex_get_par_par(par, par_last_line_fit_code));
+ get_integer_par (properties.double_hyphen_demerits, doublehyphendemerits, tex_get_par_par(par, par_double_hyphen_demerits_code));
+ get_integer_par (properties.final_hyphen_demerits, finalhyphendemerits, tex_get_par_par(par, par_final_hyphen_demerits_code));
+ get_dimen_par (properties.hsize, hsize, tex_get_par_par(par, par_hsize_code));
+ get_glue_par (properties.left_skip, leftskip, tex_get_par_par(par, par_left_skip_code));
+ get_glue_par (properties.right_skip, rightskip, tex_get_par_par(par, par_right_skip_code));
+ get_dimen_par (properties.hang_indent, hangindent, tex_get_par_par(par, par_hang_indent_code));
+ get_integer_par (properties.hang_after, hangafter, tex_get_par_par(par, par_hang_after_code));
+ get_integer_par (properties.inter_line_penalty, interlinepenalty, tex_get_par_par(par, par_inter_line_penalty_code));
+ get_integer_par (properties.club_penalty, clubpenalty, tex_get_par_par(par, par_club_penalty_code));
+ get_integer_par (properties.widow_penalty, widowpenalty, tex_get_par_par(par, par_widow_penalty_code));
+ get_integer_par (properties.display_widow_penalty, displaywidowpenalty, tex_get_par_par(par, par_display_widow_penalty_code));
+ get_integer_par (properties.orphan_penalty, orphanpenalty, tex_get_par_par(par, par_orphan_penalty_code));
+ get_integer_par (properties.broken_penalty, brokenpenalty, tex_get_par_par(par, par_broken_penalty_code));
+ get_glue_par (properties.baseline_skip, baselineskip, tex_get_par_par(par, par_baseline_skip_code));
+ get_glue_par (properties.line_skip, lineskip, tex_get_par_par(par, par_line_skip_code));
+ get_dimen_par (properties.line_skip_limit, lineskiplimit, tex_get_par_par(par, par_line_skip_limit_code));
+ get_integer_par (properties.adjust_spacing, adjustspacing, tex_get_par_par(par, par_adjust_spacing_code));
+ get_integer_par (properties.adjust_spacing_step, adjustspacingstep, tex_get_par_par(par, par_adjust_spacing_step_code));
+ get_integer_par (properties.adjust_spacing_shrink, adjustspacingshrink, tex_get_par_par(par, par_adjust_spacing_shrink_code));
+ get_integer_par (properties.adjust_spacing_stretch, adjustspacingstretch, tex_get_par_par(par, par_adjust_spacing_stretch_code));
+ get_integer_par (properties.hyphenation_mode, hyphenationmode, tex_get_par_par(par, par_hyphenation_mode_code));
+ get_integer_par (properties.shaping_penalties_mode, shapingpenaltiesmode, tex_get_par_par(par, par_shaping_penalties_mode_code));
+ get_integer_par (properties.shaping_penalty, shapingpenalty, tex_get_par_par(par, par_shaping_penalty_code));
+ get_shape_par (properties.par_shape, parshape, tex_get_par_par(par, par_par_shape_code));
+ get_penalties_par(properties.inter_line_penalties, interlinepenalties, tex_get_par_par(par, par_inter_line_penalties_code), inter_line_penalties_code);
+ get_penalties_par(properties.club_penalties, clubpenalties, tex_get_par_par(par, par_club_penalties_code), club_penalties_code);
+ get_penalties_par(properties.widow_penalties, widowpenalties, tex_get_par_par(par, par_widow_penalties_code), widow_penalties_code);
+ get_penalties_par(properties.display_widow_penalties,displaywidowpenalties,tex_get_par_par(par, par_display_widow_penalties_code), display_widow_penalties_code);
+ get_penalties_par(properties.orphan_penalties, orphanpenalties, tex_get_par_par(par, par_orphan_penalties_code), orphan_penalties_code);
+ if (! prepared) {
+ halfword attr_template = tail;
+ halfword final_penalty = tex_new_penalty_node(infinite_penalty, line_penalty_subtype);
+ /* */
+ get_glue_par(properties.parfill_left_skip, parfillleftskip, tex_get_par_par(par, par_par_fill_left_skip_code));
+ get_glue_par(properties.parfill_right_skip, parfillrightskip, tex_get_par_par(par, par_par_fill_right_skip_code));
+ get_glue_par(properties.parinit_left_skip, parinitleftskip, tex_get_par_par(par, par_par_init_left_skip_code));
+ get_glue_par(properties.parinit_right_skip, parinitrightskip, tex_get_par_par(par, par_par_init_right_skip_code));
+ /* */
+ properties.parfill_left_skip = tex_new_glue_node(properties.parfill_left_skip, par_fill_left_skip_glue);
+ properties.parfill_right_skip = tex_new_glue_node(properties.parfill_right_skip, par_fill_right_skip_glue);
+ tex_attach_attribute_list_copy(final_penalty, attr_template);
+ tex_attach_attribute_list_copy(properties.parfill_left_skip, attr_template);
+ tex_attach_attribute_list_copy(properties.parfill_right_skip, attr_template);
+ tex_couple_nodes(tail, final_penalty);
+ tex_couple_nodes(final_penalty, properties.parfill_left_skip);
+ tex_couple_nodes(properties.parfill_left_skip, properties.parfill_right_skip);
+ if (node_next(par)) { /* test can go, also elsewhere */
+ halfword n = node_next(par);
+ while (n) {
+ if (node_type(n) == glue_node && node_subtype(n) == indent_skip_glue) {
+ properties.parinit_left_skip = tex_new_glue_node(properties.parinit_left_skip, par_init_left_skip_glue);
+ properties.parinit_right_skip = tex_new_glue_node(properties.parinit_right_skip, par_init_right_skip_glue);
+ tex_attach_attribute_list_copy(properties.parinit_left_skip, attr_template); // maybe head .. also elsewhere
+ tex_attach_attribute_list_copy(properties.parinit_right_skip, attr_template); // maybe head .. also elsewhere
+ tex_try_couple_nodes(properties.parinit_right_skip, n);
+ tex_try_couple_nodes(properties.parinit_left_skip, properties.parinit_right_skip);
+ tex_try_couple_nodes(par, properties.parinit_left_skip);
+ break;
+ } else {
+ n = node_next(n);
+ }
+ }
+ }
+ }
+ lmt_linebreak_state.last_line_fill = properties.parfill_right_skip; /*tex I need to redo this. */
+ tex_do_line_break(&properties);
+ {
+ halfword fewest_demerits = 0;
+ halfword actual_looseness = 0;
+ /*tex return the generated list, and its prevdepth */
+ tex_get_linebreak_info(&fewest_demerits, &actual_looseness) ;
+ lmt_push_directornode(L, node_next(cur_list.head), direct);
+ lua_createtable(L, 0, 4);
+ /* set_integer_by_key(L, demerits, fewest_demerits); */
+ lua_push_key(demerits);
+ lua_pushinteger(L, fewest_demerits);
+ lua_settable(L, -3);
+ /* set_integer_by_key(L, looseness, actual_looseness); */
+ lua_push_key(looseness);
+ lua_pushinteger(L, actual_looseness);
+ lua_settable(L, -3);
+ /* set_integer_by_key(L, prevdepth, cur_list.prev_depth); */
+ lua_push_key(prevdepth);
+ lua_pushinteger(L, cur_list.prev_depth);
+ lua_settable(L, -3);
+ /* set_integer_by_key(L, prevgraf, cur_list.prev_graf); */
+ lua_push_key(prevgraf);
+ lua_pushinteger(L, cur_list.prev_graf);
+ lua_settable(L, -3);
+ }
+ tex_pop_nest();
+ if (properties.par_shape != tex_get_par_par(par, par_par_shape_code)) { tex_flush_node(properties.par_shape); }
+ if (properties.inter_line_penalties != tex_get_par_par(par, par_inter_line_penalties_code)) { tex_flush_node(properties.inter_line_penalties); }
+ if (properties.club_penalties != tex_get_par_par(par, par_club_penalties_code)) { tex_flush_node(properties.club_penalties); }
+ if (properties.widow_penalties != tex_get_par_par(par, par_widow_penalties_code)) { tex_flush_node(properties.widow_penalties); }
+ if (properties.display_widow_penalties != tex_get_par_par(par, par_display_widow_penalties_code)) { tex_flush_node(properties.display_widow_penalties); }
+ if (properties.orphan_penalties != tex_get_par_par(par, par_orphan_penalties_code)) { tex_flush_node(properties.orphan_penalties); }
+ return 2;
+ } else {
+ tex_formatted_warning("linebreak", "[ par ... ] expected");
+ }
+ NOTHING:
+ lmt_push_directornode(L, par, direct);
+ return 1;
+}
+
+static int texlib_resetparagraph(lua_State *L)
+{
+ (void) L;
+ tex_normal_paragraph(reset_par_context);
+ return 0;
+}
+
+static int texlib_shipout(lua_State *L)
+{
+ int boxnum = lmt_get_box_id(L, 1, 1);
+ if (box_register(boxnum)) {
+ tex_flush_node_list(box_register(boxnum));
+ box_register(boxnum) = null;
+ }
+ return 0;
+}
+
+static int texlib_badness(lua_State *L)
+{
+ scaled t = lmt_roundnumber(L, 1);
+ scaled s = lmt_roundnumber(L, 2);
+ lua_pushinteger(L, tex_badness(t, s));
+ return 1;
+}
+
+static int texlib_showcontext(lua_State *L)
+{
+ (void) L;
+ tex_show_context();
+ return 0;
+}
+
+/*tex
+ When we pass |true| the page builder will only be invoked in the main vertical list in which
+ case |lmt_nest_state.nest_data.ptr == 1| or |cur_list.mode != vmode|.
+*/
+
+static int texlib_triggerbuildpage(lua_State *L)
+{
+ if (lua_toboolean(L, 1) && cur_list.mode != vmode) {
+ return 0;
+ }
+ tex_build_page();
+ return 0;
+}
+
+static int texlib_getpagestate(lua_State *L)
+{
+ lua_pushinteger(L, lmt_page_builder_state.contents);
+ return 1;
+}
+
+static int texlib_getlocallevel(lua_State *L)
+{
+ lua_pushinteger(L, lmt_main_control_state.local_level);
+ return 1;
+}
+
+/* input state aka synctex */
+
+static int texlib_setinputstatemode(lua_State *L)
+{
+ input_file_state.mode = lmt_tohalfword(L, 1);
+ return 0;
+}
+static int texlib_getinputstatemode(lua_State *L)
+{
+ lua_pushinteger(L, input_file_state.mode);
+ return 1;
+}
+
+static int texlib_setinputstatefile(lua_State *L)
+{
+ lmt_input_state.cur_input.state_file = lmt_tointeger(L, 1);
+ return 0;
+}
+
+static int texlib_getinputstatefile(lua_State *L)
+{
+ lua_pushinteger(L, lmt_input_state.cur_input.state_file);
+ return 1;
+}
+
+static int texlib_forceinputstatefile(lua_State *L)
+{
+ input_file_state.forced_file = lmt_tointeger(L, 1);
+ return 0;
+}
+
+static int texlib_forceinputstateline(lua_State *L)
+{
+ input_file_state.forced_line = lmt_tointeger(L, 1);
+ return 0;
+}
+
+static int texlib_setinputstateline(lua_State *L)
+{
+ input_file_state.line = lmt_tohalfword(L, 1);
+ return 0;
+}
+
+static int texlib_getinputstateline(lua_State *L)
+{
+ lua_pushinteger(L, input_file_state.line);
+ return 1;
+}
+
+/*tex
+ This is experimental and might change. In version 10 we hope to have the final version available.
+ It actually took quite a bit of time to understand the implications of mixing lua prints in here.
+ The current variant is (so far) the most robust (wrt crashes and side effects).
+*/
+
+// # define mode cur_list.mode_field
+
+/*tex
+ When we add save levels then we can get crashes when one flushed bad groups due to out of order
+ flushing. So we play safe! But still we can have issues so best make sure you're in hmode.
+*/
+
+static int texlib_forcehmode(lua_State *L)
+{
+ if (abs(cur_list.mode) == vmode) {
+ if (lua_type(L, 1) == LUA_TBOOLEAN) {
+ tex_begin_paragraph(lua_toboolean(L, 1), force_par_begin);
+ } else {
+ tex_begin_paragraph(1, force_par_begin);
+ }
+ }
+ return 0;
+}
+
+/* tex
+ The first argument can be a number (of a token register), a macro name or the name of a token
+ list. The second argument is optional and when true forces expansion inside a definition. The
+ optional third argument can be used to force oing. The return value indicates an error: 0
+ means no error, 1 means that a bad register number has been passed, a value of 2 indicated an
+ unknown register or macro name, while 3 reports that the macro is not suitable for local
+ control because it takes arguments.
+*/
+
+static int texlib_runlocal(lua_State *L)
+{
+ // int obeymode = lua_toboolean(L, 4);
+ int obeymode = 1; /* always 1 */
+ halfword tok = -1;
+ int mac = 0 ;
+ switch (lua_type(L, 1)) {
+ case LUA_TFUNCTION:
+ {
+ /* todo: also a variant that calls an already registered function */
+ int ref;
+ halfword r, t;
+ lua_pushvalue(L, 1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+ r = tex_get_available_token(token_val(end_local_cmd, 0));
+ t = tex_get_available_token(token_val(lua_local_call_cmd, ref));
+ token_link(t) = r;
+ tex_begin_inserted_list(t);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering token scanner via function");
+ }
+ tex_local_control(obeymode);
+ luaL_unref(L, LUA_REGISTRYINDEX, ref);
+ return 0;
+ }
+ case LUA_TNUMBER:
+ {
+ halfword k = lmt_checkhalfword(L, 1);
+ if (k >= 0 && k <= 65535) {
+ tok = toks_register(k);
+ goto TOK;
+ } else {
+ tex_local_control_message("invalid token register number");
+ return 0;
+ }
+ }
+ case LUA_TSTRING:
+ {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ int cs = tex_string_locate(name, lname, 0);
+ int cmd = eq_type(cs);
+ if (cmd < call_cmd) { // is_call_cmd
+ // todo: use the better register helpers and range checkers
+ switch (cmd) {
+ case register_toks_cmd:
+ tok = toks_register(register_toks_number(eq_value(cs)));
+ goto TOK;
+ case undefined_cs_cmd:
+ tex_local_control_message("undefined macro or token register");
+ return 0;
+ default:
+ /* like cs == case undefined_control_sequence */
+ tex_local_control_message("invalid macro or token register");
+ return 0;
+ }
+ } else {
+ halfword ref = eq_value(cs);
+ halfword head = token_link(ref);
+ if (head && get_token_parameters(ref)) {
+ tex_local_control_message("macro takes arguments and is ignored");
+ return 0;
+ } else {
+ tok = cs_token_flag + cs;
+ mac = 1 ;
+ goto TOK;
+ }
+ }
+ }
+ case LUA_TUSERDATA:
+ /* no checking yet */
+ tok = token_info(lmt_token_code_from_lua(L, 1));
+ mac = 1;
+ goto TOK;
+ default:
+ return 0;
+ }
+ TOK:
+ if (tok < 0) {
+ /* nothing to do */
+ } else if (lmt_input_state.scanner_status != scanner_is_defining || lua_toboolean(L, 2)) {
+ // todo: make list
+ int grouped = lua_toboolean(L, 3);
+ if (grouped) {
+ tex_begin_inserted_list(tex_get_available_token(token_val(right_brace_cmd, 0)));
+ }
+ tex_begin_inserted_list(tex_get_available_token(token_val(end_local_cmd, 0)));
+ if (mac) {
+ tex_begin_inserted_list(tex_get_available_token(tok));
+ } else {
+ tex_begin_token_list(tok, local_text);
+ }
+ if (grouped) {
+ tex_begin_inserted_list(tex_get_available_token(token_val(left_brace_cmd, 0)));
+ }
+ /*tex hm, needed here? */
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ if (tracing_nesting_par > 2) {
+ if (mac) {
+ tex_local_control_message("entering token scanner via macro");
+ } else {
+ tex_local_control_message("entering token scanner via register");
+ }
+ }
+ tex_local_control(obeymode);
+ } else if (mac) {
+ tex_back_input(tok);
+ } else {
+ halfword h = null;
+ halfword t = null;
+ halfword r = token_link(tok);
+ while (r) {
+ t = tex_store_new_token(t, token_info(r));
+ if (! h) {
+ h = t;
+ }
+ r = token_link(r);
+ }
+ tex_begin_inserted_list(h);
+ }
+ return 0;
+}
+
+static int texlib_quitlocal(lua_State *L)
+{
+ (void) L;
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("quitting token scanner");
+ }
+ tex_end_local_control();
+ return 0;
+}
+
+/* todo: no tryagain and justincase here */
+
+static int texlib_expandasvalue(lua_State *L) /* mostly like the mp one */
+{
+ int kind = lmt_tointeger(L, 1);
+ halfword tail = null;
+ halfword head = lmt_macro_to_tok(L, 2, &tail);
+ if (head) {
+ switch (kind) {
+ case lua_value_none_code:
+ case lua_value_dimension_code:
+ {
+ halfword value = 0;
+ halfword space = tex_get_available_token(space_token);
+ halfword relax = tex_get_available_token(deep_frozen_relax_token);
+ token_link(tail) = space;
+ token_link(space) = relax;
+ tex_begin_inserted_list(head);
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ value = tex_scan_dimen(0, 0, 0, 0, NULL);
+ lmt_error_state.intercept = 0;
+ while (cur_tok != deep_frozen_relax_token) {
+ tex_get_token();
+ }
+ if (! lmt_error_state.last_intercept) {
+ lua_pushinteger(L, value);
+ break;
+ } else if (kind == lua_value_none_code) {
+ head = lmt_macro_to_tok(L, 2, &tail);
+ goto TRYAGAIN;
+ } else {
+ head = lmt_macro_to_tok(L, 2, &tail);
+ goto JUSTINCASE;
+ }
+ }
+ case lua_value_integer_code:
+ case lua_value_cardinal_code:
+ case lua_value_boolean_code:
+ TRYAGAIN:
+ {
+ halfword value = 0;
+ halfword space = tex_get_available_token(space_token);
+ halfword relax = tex_get_available_token(deep_frozen_relax_token);
+ token_link(tail) = space;
+ token_link(space) = relax;
+ tex_begin_inserted_list(head);
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ value = tex_scan_int(0, NULL);
+ lmt_error_state.intercept = 0;
+ while (cur_tok != deep_frozen_relax_token) {
+ tex_get_token();
+ }
+ if (lmt_error_state.last_intercept) {
+ head = lmt_macro_to_tok(L, 2, &tail);
+ goto JUSTINCASE;
+ } else if (kind == lua_value_boolean_code) {
+ lua_pushboolean(L, value);
+ break;
+ } else {
+ lua_pushinteger(L, value);
+ break;
+ }
+ }
+ default:
+ JUSTINCASE:
+ {
+ int len = 0;
+ const char *str = (const char *) lmt_get_expansion(head, &len);
+ lua_pushlstring(L, str, str ? len : 0); /* len includes \0 */
+ break;
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* string, expand-in-def, group */
+
+static int texlib_runstring(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top > 0) {
+ size_t lstr = 0;
+ const char *str = NULL;
+ int slot = 1;
+ halfword ct = lua_type(L, slot) == LUA_TNUMBER ? lmt_tohalfword(L, slot++) : cat_code_table_par;
+ if (! tex_valid_catcode_table(ct)) {
+ ct = cat_code_table_par;
+ }
+ str = lua_tolstring(L, slot++, &lstr);
+ if (lstr > 0) {
+ int obeymode = 1; /* always 1 */
+ int expand = lua_toboolean(L, slot++);
+ int grouped = lua_toboolean(L, slot++);
+ int ignore = lua_toboolean(L, slot++);
+ halfword h = get_reference_token();
+ halfword t = h;
+ if (grouped) {
+ // t = tex_store_new_token(a, left_brace_token + '{');
+ t = tex_store_new_token(t, token_val(right_brace_cmd, 0));
+ }
+ /*tex Options: 1=create (will trigger an error), 2=ignore. */
+ tex_parse_str_to_tok(h, &t, ct, str, lstr, ignore ? 2 : 1);
+ if (grouped) {
+ // t = tex_store_new_token(a, left_brace_token + '}');
+ t = tex_store_new_token(t, token_val(left_brace_cmd, 0));
+ }
+ if (lmt_input_state.scanner_status != scanner_is_defining || expand) {
+ // t = tex_store_new_token(t, token_val(end_local_cmd, 0));
+ tex_begin_inserted_list(tex_get_available_token(token_val(end_local_cmd, 0)));
+ tex_begin_token_list(h, local_text);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering token scanner via register");
+ }
+ tex_local_control(obeymode);
+ } else {
+ tex_begin_inserted_list(h);
+ }
+ }
+ }
+ return 0;
+}
+
+/* new, can go into luatex too */
+
+static int texlib_getmathdir(lua_State *L)
+{
+ lua_pushinteger(L, math_direction_par);
+ return 0;
+}
+
+static int texlib_setmathdir(lua_State *L)
+{
+ tex_set_math_dir(lmt_tohalfword(L, 1));
+ return 0;
+}
+
+static int texlib_getpardir(lua_State *L)
+{
+ lua_pushinteger(L, par_direction_par);
+ return 1;
+}
+
+static int texlib_setpardir(lua_State *L)
+{
+ tex_set_par_dir(lmt_tohalfword(L, 1));
+ return 0;
+}
+
+static int texlib_gettextdir(lua_State *L)
+{
+ lua_pushinteger(L, text_direction_par);
+ return 1;
+}
+
+static int texlib_settextdir(lua_State *L)
+{
+ tex_set_text_dir(lmt_tohalfword(L, 1));
+ return 0;
+}
+
+/* Getting the line direction makes no sense, it's just the text direction. */
+
+static int texlib_setlinedir(lua_State *L)
+{
+ tex_set_line_dir(lmt_tohalfword(L, 1));
+ return 0;
+}
+
+static int texlib_getboxdir(lua_State *L)
+{
+ int index = lmt_tointeger(L, 1);
+ if (index >= 0 && index <= max_box_register_index) {
+ if (box_register(index)) {
+ lua_pushinteger(L, box_dir(box_register(index)));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ texlib_aux_show_box_index_error(L);
+ }
+ return 0;
+}
+
+static int texlib_setboxdir(lua_State *L)
+{
+ int index = lmt_tointeger(L, 1);
+ if (index >= 0 && index <= max_box_register_index) {
+ tex_set_box_dir(index, lmt_tointeger(L, 2));
+ } else {
+ texlib_aux_show_box_index_error(L);
+ }
+ return 0;
+}
+
+static int texlib_gethelptext(lua_State *L)
+{
+ if (lmt_error_state.help_text) {
+ lua_pushstring(L, lmt_error_state.help_text);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int texlib_setinteraction(lua_State *L)
+{
+ if (lua_type(L,1) == LUA_TNUMBER) {
+ int i = lmt_tointeger(L, 1);
+ if (i >= 0 && i <= 3) {
+ lmt_error_state.interaction = i;
+ }
+ }
+ return 0;
+}
+
+static int texlib_getinteraction(lua_State *L)
+{
+ lua_pushinteger(L, lmt_error_state.interaction);
+ return 1;
+}
+
+static int texlib_setglyphdata(lua_State *L)
+{
+ update_tex_glyph_data(0, lmt_opthalfword(L, 1, unused_attribute_value));
+ return 0;
+}
+
+static int texlib_getglyphdata(lua_State *L)
+{
+ lua_pushinteger(L, glyph_data_par);
+ return 1;
+}
+
+static int texlib_setglyphstate(lua_State *L)
+{
+ update_tex_glyph_state(0, lmt_opthalfword(L, 1, unused_state_value));
+ return 0;
+}
+
+static int texlib_getglyphstate(lua_State *L)
+{
+ lua_pushinteger(L, glyph_state_par);
+ return 1;
+}
+
+static int texlib_setglyphscript(lua_State *L)
+{
+ update_tex_glyph_script(0, lmt_opthalfword(L, 1, unused_script_value));
+ return 0;
+}
+
+static int texlib_getglyphscript(lua_State *L)
+{
+ lua_pushinteger(L, glyph_script_par);
+ return 1;
+}
+
+static int texlib_getglyphscales(lua_State *L)
+{
+ lua_pushinteger(L, glyph_scale_par);
+ lua_pushinteger(L, glyph_x_scale_par);
+ lua_pushinteger(L, glyph_y_scale_par);
+ lua_pushinteger(L, glyph_data_par);
+ return 4;
+}
+
+static int texlib_fatalerror(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ tex_fatal_error(s);
+ return 1;
+}
+
+static int texlib_lastnodetype(lua_State *L)
+{
+ halfword tail = cur_list.tail;
+ int t = -1;
+ int s = -1;
+ if (tail) {
+ halfword mode = cur_list.mode;
+ if (mode != nomode && tail != contribute_head && node_type(tail) != glyph_node) {
+ t = node_type(tail);
+ s = node_subtype(tail);
+ } else if (mode == vmode && tail == cur_list.head) {
+ t = lmt_page_builder_state.last_node_type;
+ s = lmt_page_builder_state.last_node_subtype;
+ } else if (mode == nomode || tail == cur_list.head) {
+ /* already -1 */
+ } else {
+ t = node_type(tail);
+ s = node_subtype(tail);
+ }
+ }
+ if (t >= 0) {
+ lua_pushinteger(L, t);
+ lua_pushinteger(L, s);
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+/* we can have all defs here */
+
+static int texlib_chardef(lua_State *L)
+{
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (s) {
+ int cs = tex_string_locate(s, l, 1);
+ int flags = 0;
+ lmt_check_for_flags(L, 3, &flags, 1, 0);
+ if (tex_define_permitted(cs, flags)) {
+ int code = lmt_tointeger(L, 2);
+ if (code >= 0 && code <= max_character_code) {
+ tex_define(flags, cs, (quarterword) char_given_cmd, code);
+ } else {
+ tex_formatted_error("lua", "chardef only accepts codes in the range 0-%i", max_character_code);
+ }
+ }
+ }
+ return 0;
+}
+
+/* todo: same range checks as in texlib_setmathcode */
+
+static int texlib_mathchardef(lua_State *L)
+{
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (s) {
+ int cs = tex_string_locate(s, l, 1);
+ int flags = 0;
+ lmt_check_for_flags(L, 5, &flags, 1, 0);
+ if (tex_define_permitted(cs, flags)) {
+ mathcodeval m;
+ mathdictval d;
+ m.class_value = lmt_tointeger(L, 2);
+ m.family_value = lmt_tointeger(L, 3);
+ m.character_value = lmt_tointeger(L, 4);
+ d.properties = lmt_optquarterword(L, 6, 0);
+ d.group = lmt_optquarterword(L, 7, 0);
+ d.index = lmt_optinteger(L, 8, 0);
+ if (class_in_range(m.class_value) && family_in_range(m.family_value) && character_in_range(m.character_value)) {
+ tex_define(flags, cs, mathspec_cmd, tex_new_math_dict_spec(d, m, umath_mathcode));
+ // halfword code = math_packed_character(m.class_value, m.family_value, m.character_value);
+ // tex_define(flags, cs, (quarterword) math_char_xgiven_cmd, code);
+ } else {
+ tex_normal_error("lua", "mathchardef needs proper class, family and character codes");
+ }
+ } else {
+ /* maybe a message */
+ }
+ }
+ return 0;
+}
+
+static int texlib_setintegervalue(lua_State *L)
+{
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (s) {
+ int cs = tex_string_locate(s, l, 1);
+ int flags = 0;
+ lmt_check_for_flags(L, 3, &flags, 1, 0);
+ if (tex_define_permitted(cs, flags)) {
+ int value = lmt_optroundnumber(L, 2, 0);
+ if (value >= min_integer && value <= max_integer) {
+ tex_define(flags, cs, (quarterword) integer_cmd, value);
+ } else {
+ tex_formatted_error("lua", "integer only accepts values in the range %i-%i", min_integer, max_integer);
+ }
+ }
+ }
+ return 0;
+}
+
+static int texlib_setdimensionvalue(lua_State *L)
+{
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (s) {
+ int cs = tex_string_locate(s, l, 1);
+ int flags = 0;
+ lmt_check_for_flags(L, 3, &flags, 1, 0);
+ if (tex_define_permitted(cs, flags)) {
+ int value = lmt_optroundnumber(L, 2, 0);
+ if (value >= min_dimen && value <= max_dimen) {
+ tex_define(flags, cs, (quarterword) dimension_cmd, value);
+ } else {
+ tex_formatted_error("lua", "dimension only accepts values in the range %i-%i", min_dimen, max_dimen);
+ }
+ }
+ }
+ return 0;
+}
+
+// static int texlib_setgluespecvalue(lua_State *L)
+// {
+// return 0;
+// }
+
+static int texlib_aux_getvalue(lua_State *L, halfword level, halfword cs)
+{
+ halfword chr = eq_value(cs);
+ if (chr && ! get_token_parameters(chr)) {
+ halfword value = 0;
+ tex_begin_inserted_list(tex_get_available_token(cs_token_flag + cs));
+ if (tex_scan_tex_value(level, &value)) {
+ lua_pushinteger(L, value);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int texlib_getintegervalue(lua_State *L) /* todo, now has duplicate in tokenlib */
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ int cs = tex_string_locate(s, l, 0);
+ switch (eq_type(cs)) {
+ case integer_cmd:
+ lua_pushinteger(L, eq_value(cs));
+ return 1;
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ return texlib_aux_getvalue(L, int_val_level, cs);
+ default:
+ /* twice a lookup but fast enough for now */
+ return texlib_getcount(L);
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int texlib_getdimensionvalue(lua_State *L) /* todo, now has duplicate in tokenlib */
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ int cs = tex_string_locate(s, l, 0);
+ switch (eq_type(cs)) {
+ case dimension_cmd:
+ lua_pushinteger(L, eq_value(cs));
+ return 1;
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ return texlib_aux_getvalue(L, dimen_val_level, cs);
+ default:
+ /* twice a lookup but fast enough for now */
+ return texlib_getdimen(L);
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+// static int texlib_getgluespecvalue(lua_State *L) /* todo, now has duplicate in tokenlib */
+// {
+// return 1;
+// }
+
+/*tex
+ Negative values are internal and inline. At some point I might do this as with modes and tokens
+ although we don't have lookups here.
+
+ In these list we don't really need the predefined keys.
+*/
+
+static int texlib_getmodevalues(lua_State *L)
+{
+ lua_createtable(L, 4, 1);
+ lua_push_key_at_index(L, unset, nomode);
+ lua_push_key_at_index(L, vertical, vmode);
+ lua_push_key_at_index(L, horizontal, hmode);
+ lua_push_key_at_index(L, math, mmode);
+ return 1;
+}
+
+static int texlib_getmode(lua_State *L)
+{
+ lua_pushinteger(L, abs(cur_list.mode));
+ return 1;
+}
+
+static int texlib_getrunstatevalues(lua_State *L)
+{
+ lua_createtable(L, 2, 1);
+ lua_set_string_by_index(L, initializing_state, "initializing");
+ lua_set_string_by_index(L, updating_state, "updating");
+ lua_set_string_by_index(L, production_state, "production");
+ return 1;
+}
+
+static int texlib_setrunstate(lua_State *L)
+{
+ int state = lmt_tointeger(L, 1);
+ if (state == updating_state || state == production_state) {
+ lmt_main_state.run_state = state;
+ }
+ return 0;
+}
+
+static int texlib_gethyphenationvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 17);
+ lua_push_key_at_index(L, normal, normal_hyphenation_mode);
+ lua_push_key_at_index(L, automatic, automatic_hyphenation_mode);
+ lua_push_key_at_index(L, explicit, explicit_hyphenation_mode);
+ lua_push_key_at_index(L, syllable, syllable_hyphenation_mode);
+ lua_push_key_at_index(L, uppercase, uppercase_hyphenation_mode);
+ lua_push_key_at_index(L, compound, compound_hyphenation_mode);
+ lua_push_key_at_index(L, strictstart, strict_start_hyphenation_mode);
+ lua_push_key_at_index(L, strictend, strict_end_hyphenation_mode);
+ lua_push_key_at_index(L, automaticpenalty, automatic_penalty_hyphenation_mode);
+ lua_push_key_at_index(L, explicitpenalty, explicit_penalty_hyphenation_mode);
+ lua_push_key_at_index(L, permitglue, permit_glue_hyphenation_mode);
+ lua_push_key_at_index(L, permitall, permit_all_hyphenation_mode);
+ lua_push_key_at_index(L, permitmathreplace, permit_math_replace_hyphenation_mode);
+ lua_push_key_at_index(L, forcecheck, force_check_hyphenation_mode);
+ lua_push_key_at_index(L, lazyligatures, lazy_ligatures_hyphenation_mode);
+ lua_push_key_at_index(L, forcehandler, force_handler_hyphenation_mode);
+ lua_push_key_at_index(L, feedbackcompound, feedback_compound_hyphenation_mode);
+ lua_push_key_at_index(L, ignorebounds, ignore_bounds_hyphenation_mode);
+ lua_push_key_at_index(L, collapse, collapse_hyphenation_mode);
+ return 1;
+}
+
+static int texlib_getglyphoptionvalues(lua_State *L)
+{
+ lua_createtable(L, 3, 7);
+ lua_set_string_by_index(L, glyph_option_normal_glyph, "normal");
+ lua_set_string_by_index(L, glyph_option_no_left_ligature, "noleftligature");
+ lua_set_string_by_index(L, glyph_option_no_right_ligature, "norightligature");
+ lua_set_string_by_index(L, glyph_option_no_left_kern, "noleftkern");
+ lua_set_string_by_index(L, glyph_option_no_right_kern, "norightkern");
+ lua_set_string_by_index(L, glyph_option_no_expansion, "noexpansion");
+ lua_set_string_by_index(L, glyph_option_no_protrusion, "noprotrusion");
+ lua_set_string_by_index(L, glyph_option_no_italic_correction, "noitaliccorrection");
+ lua_set_string_by_index(L, glyph_option_math_discretionary, "mathdiscretionary");
+ lua_set_string_by_index(L, glyph_option_math_italics_too, "mathsitalicstoo");
+ return 1;
+}
+
+static int texlib_getnoadoptionvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 32);
+ lua_push_key_at_index(L, axis, noad_option_axis);
+ lua_push_key_at_index(L, noaxis, noad_option_no_axis);
+ lua_push_key_at_index(L, exact, noad_option_exact);
+ lua_push_key_at_index(L, left, noad_option_left);
+ lua_push_key_at_index(L, middle, noad_option_middle);
+ lua_push_key_at_index(L, right, noad_option_right);
+ lua_push_key_at_index(L, adapttoleftsize, noad_option_adapt_to_left_size);
+ lua_push_key_at_index(L, adapttorightsize, noad_option_adapt_to_right_size);
+ lua_push_key_at_index(L, nosubscript, noad_option_no_sub_script);
+ lua_push_key_at_index(L, nosuperscript, noad_option_no_super_script);
+ lua_push_key_at_index(L, nosubprescript, noad_option_no_sub_pre_script);
+ lua_push_key_at_index(L, nosuperprescript, noad_option_no_super_pre_script);
+ lua_push_key_at_index(L, noscript, noad_option_no_script);
+ lua_push_key_at_index(L, nooverflow, noad_option_no_overflow);
+ lua_push_key_at_index(L, void, noad_option_void);
+ lua_push_key_at_index(L, phantom, noad_option_phantom);
+ lua_push_key_at_index(L, openupheight, noad_option_openup_height);
+ lua_push_key_at_index(L, openupdepth, noad_option_openup_depth);
+ lua_push_key_at_index(L, limits, noad_option_limits);
+ lua_push_key_at_index(L, nolimits, noad_option_no_limits);
+ lua_push_key_at_index(L, preferfontthickness, noad_option_prefer_font_thickness);
+ lua_push_key_at_index(L, noruling, noad_option_no_ruling);
+ lua_push_key_at_index(L, shiftedsubscript, noad_option_shifted_sub_script);
+ lua_push_key_at_index(L, shiftedsuperscript, noad_option_shifted_super_script);
+ lua_push_key_at_index(L, shiftedsubprescript, noad_option_shifted_sub_pre_script);
+ lua_push_key_at_index(L, shiftedsuperprescript, noad_option_shifted_super_pre_script);
+ lua_push_key_at_index(L, unpacklist, noad_option_unpack_list);
+ lua_push_key_at_index(L, nocheck, noad_option_no_check);
+ lua_push_key_at_index(L, auto, noad_option_auto);
+ lua_push_key_at_index(L, unrolllist, noad_option_unroll_list);
+ lua_push_key_at_index(L, followedbyspace, noad_option_followed_by_space);
+ return 1;
+}
+
+static int texlib_getdiscoptionvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 1);
+ lua_set_string_by_index(L, disc_option_normal_word, "normalword");
+ lua_set_string_by_index(L, disc_option_pre_word, "preword");
+ lua_set_string_by_index(L, disc_option_post_word, "postword");
+ return 1;
+}
+
+static int texlib_getlistanchorvalues(lua_State *L)
+{
+ lua_createtable(L, 14, 0);
+ lua_set_string_by_index(L, left_origin_anchor, "leftorigin");
+ lua_set_string_by_index(L, left_height_anchor, "leftheight");
+ lua_set_string_by_index(L, left_depth_anchor, "leftdepth");
+ lua_set_string_by_index(L, right_origin_anchor, "rightorigin");
+ lua_set_string_by_index(L, right_height_anchor, "rightheight");
+ lua_set_string_by_index(L, right_depth_anchor, "rightdepth");
+ lua_set_string_by_index(L, center_origin_anchor, "centerorigin");
+ lua_set_string_by_index(L, center_height_anchor, "centerheight");
+ lua_set_string_by_index(L, center_depth_anchor, "centerdepth");
+ lua_set_string_by_index(L, halfway_total_anchor, "halfwaytotal");
+ lua_set_string_by_index(L, halfway_height_anchor, "halfwayheight");
+ lua_set_string_by_index(L, halfway_depth_anchor, "halfwaydepth");
+ lua_set_string_by_index(L, halfway_left_anchor, "halfwayleft");
+ lua_set_string_by_index(L, halfway_right_anchor, "halfwayright");
+ return 1;
+}
+
+static int texlib_getlistsignvalues(lua_State *L)
+{
+ lua_createtable(L, 0, 2);
+ lua_set_string_by_index(L, negate_x_anchor, "negatex");
+ lua_set_string_by_index(L, negate_y_anchor, "negatey");
+ return 1;
+}
+
+static int texlib_getlistgeometryalues(lua_State *L)
+{
+ lua_createtable(L, 3, 0);
+ lua_set_string_by_index(L, offset_geometry, "offset");
+ lua_set_string_by_index(L, orientation_geometry, "orientation");
+ lua_set_string_by_index(L, anchor_geometry, "anchor");
+ return 1;
+}
+
+static int texlib_getautomigrationvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 3);
+ lua_push_key_at_index(L, mark, auto_migrate_mark);
+ lua_push_key_at_index(L, insert, auto_migrate_insert);
+ lua_push_key_at_index(L, adjust, auto_migrate_adjust);
+ lua_push_key_at_index(L, pre, auto_migrate_pre);
+ lua_push_key_at_index(L, post, auto_migrate_post);
+ return 1;
+}
+
+static int texlib_getflagvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 15);
+ lua_push_key_at_index(L, frozen, frozen_flag_bit);
+ lua_push_key_at_index(L, permanent, permanent_flag_bit);
+ lua_push_key_at_index(L, immutable, immutable_flag_bit);
+ lua_push_key_at_index(L, primitive, primitive_flag_bit);
+ lua_push_key_at_index(L, mutable, mutable_flag_bit);
+ lua_push_key_at_index(L, noaligned, noaligned_flag_bit);
+ lua_push_key_at_index(L, instance, instance_flag_bit);
+ lua_push_key_at_index(L, untraced, untraced_flag_bit);
+ lua_push_key_at_index(L, global, global_flag_bit);
+ lua_push_key_at_index(L, tolerant, tolerant_flag_bit);
+ lua_push_key_at_index(L, protected, protected_flag_bit);
+ lua_push_key_at_index(L, overloaded, overloaded_flag_bit);
+ lua_push_key_at_index(L, aliased, aliased_flag_bit);
+ lua_push_key_at_index(L, immediate, immediate_flag_bit);
+ lua_push_key_at_index(L, conditional, conditional_flag_bit);
+ lua_push_key_at_index(L, value, value_flag_bit);
+ return 1;
+}
+
+static int texlib_getspecialmathclassvalues(lua_State *L)
+{
+ lua_createtable(L, 0, 3);
+ lua_set_string_by_index(L, math_all_class, "all");
+ lua_set_string_by_index(L, math_begin_class, "begin");
+ lua_set_string_by_index(L, math_end_class, "end");
+ return 1;
+}
+
+static int texlib_getmathclassoptionvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 19);
+ lua_set_string_by_index(L, no_pre_slack_class_option, "nopreslack");
+ lua_set_string_by_index(L, no_post_slack_class_option, "nopostslack");
+ lua_set_string_by_index(L, left_top_kern_class_option, "lefttopkern");
+ lua_set_string_by_index(L, right_top_kern_class_option, "righttopkern");
+ lua_set_string_by_index(L, left_bottom_kern_class_option, "leftbottomkern");
+ lua_set_string_by_index(L, right_bottom_kern_class_option, "rightbottomkern");
+ lua_set_string_by_index(L, look_ahead_for_end_class_option, "lookaheadforend");
+ lua_set_string_by_index(L, no_italic_correction_class_option, "noitaliccorrection");
+ lua_set_string_by_index(L, check_ligature_class_option, "checkligature");
+ lua_set_string_by_index(L, check_kern_pair_class_option, "checkkernpair");
+ lua_set_string_by_index(L, check_italic_correction_class_option, "checkitaliccorrection");
+ lua_set_string_by_index(L, flatten_class_option, "flatten");
+ lua_set_string_by_index(L, omit_penalty_class_option, "omitpenalty");
+ // lua_set_string_by_index(L, open_fence_class_option, "openfence");
+ // lua_set_string_by_index(L, close_fence_class_option, "closefence");
+ // lua_set_string_by_index(L, middle_fence_class_option, "middlefence");
+ lua_set_string_by_index(L, unpack_class_option, "unpack");
+ lua_set_string_by_index(L, raise_prime_option, "raiseprime");
+ lua_set_string_by_index(L, carry_over_left_top_kern_class_option, "carryoverlefttopkern");
+ lua_set_string_by_index(L, carry_over_left_bottom_kern_class_option, "carryoverleftbottomkern");
+ lua_set_string_by_index(L, carry_over_right_top_kern_class_option, "carryoverrighttopkern");
+ lua_set_string_by_index(L, carry_over_right_bottom_kern_class_option, "carryoverrightbottomkern");
+ lua_set_string_by_index(L, prefer_delimiter_dimensions_class_option, "preferdelimiterdimensions");
+ lua_set_string_by_index(L, auto_inject_class_option, "autoinject");
+ lua_set_string_by_index(L, remove_italic_correction_class_option, "removeitaliccorrection");
+ return 1;
+}
+
+static int texlib_getnormalizelinevalues(lua_State *L)
+{
+ lua_createtable(L, 2, 7);
+ lua_set_string_by_index(L, normalize_line_mode, "normalizeline");
+ lua_set_string_by_index(L, parindent_skip_mode, "parindentskip");
+ lua_set_string_by_index(L, swap_hangindent_mode, "swaphangindent");
+ lua_set_string_by_index(L, swap_parshape_mode, "swapparshape");
+ lua_set_string_by_index(L, break_after_dir_mode, "breakafterdir");
+ lua_set_string_by_index(L, remove_margin_kerns_mode, "removemarginkerns");
+ lua_set_string_by_index(L, clip_width_mode, "clipwidth");
+ lua_set_string_by_index(L, flatten_discretionaries_mode, "flattendiscretionaries");
+ lua_set_string_by_index(L, discard_zero_tab_skips_mode, "discardzerotabskips");
+ lua_set_string_by_index(L, flatten_h_leaders_mode, "flattenhleaders");
+ return 1;
+}
+
+static int texlib_getnormalizeparvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 0);
+ lua_set_string_by_index(L, normalize_par_mode, "normalizepar");
+ lua_set_string_by_index(L, flatten_v_leaders_mode, "flattenvleaders");
+ return 1;
+}
+
+static int texlib_geterrorvalues(lua_State *L)
+{
+ lua_createtable(L, 7, 1);
+ lua_set_string_by_index(L, normal_error_type, "normal");
+ lua_set_string_by_index(L, back_error_type, "back");
+ lua_set_string_by_index(L, insert_error_type, "insert");
+ lua_set_string_by_index(L, succumb_error_type, "succumb");
+ lua_set_string_by_index(L, eof_error_type, "eof");
+ lua_set_string_by_index(L, condition_error_type,"condition");
+ lua_set_string_by_index(L, runaway_error_type, "runaway");
+ lua_set_string_by_index(L, warning_error_type, "warning");
+ return 1;
+}
+
+static int texlib_getiovalues(lua_State *L) /* for reporting so we keep spaces */
+{
+ lua_createtable(L, 5, 1);
+ lua_set_string_by_index(L, io_initial_input_code, "initial");
+ lua_set_string_by_index(L, io_lua_input_code, "lua print");
+ lua_set_string_by_index(L, io_token_input_code, "scan token");
+ lua_set_string_by_index(L, io_token_eof_input_code, "scan token eof");
+ lua_set_string_by_index(L, io_tex_macro_code, "tex macro");
+ lua_set_string_by_index(L, io_file_input_code, "file");
+ return 1;
+}
+
+static int texlib_getfrozenparvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 20);
+ lua_set_string_by_index(L, par_hsize_category, "hsize");
+ lua_set_string_by_index(L, par_skip_category, "skip");
+ lua_set_string_by_index(L, par_hang_category, "hang");
+ lua_set_string_by_index(L, par_indent_category, "indent");
+ lua_set_string_by_index(L, par_par_fill_category, "parfill");
+ lua_set_string_by_index(L, par_adjust_category, "adjust");
+ lua_set_string_by_index(L, par_protrude_category, "protrude");
+ lua_set_string_by_index(L, par_tolerance_category, "tolerance");
+ lua_set_string_by_index(L, par_stretch_category, "stretch");
+ lua_set_string_by_index(L, par_looseness_category, "looseness");
+ lua_set_string_by_index(L, par_last_line_category, "lastline");
+ lua_set_string_by_index(L, par_line_penalty_category, "linepenalty");
+ lua_set_string_by_index(L, par_club_penalty_category, "clubpenalty");
+ lua_set_string_by_index(L, par_widow_penalty_category, "widowpenalty");
+ lua_set_string_by_index(L, par_display_penalty_category, "displaypenalty");
+ lua_set_string_by_index(L, par_broken_penalty_category, "brokenpenalty");
+ lua_set_string_by_index(L, par_demerits_category, "demerits");
+ lua_set_string_by_index(L, par_shape_category, "shape");
+ lua_set_string_by_index(L, par_line_category, "line");
+ lua_set_string_by_index(L, par_hyphenation_category, "hyphenation");
+ lua_set_string_by_index(L, par_shaping_penalty_category, "shapingpenalty");
+ lua_set_string_by_index(L, par_orphan_penalty_category, "orphanpenalty");
+ /* lua_set_string_by_index(L, par_all_category, "all"); */
+ return 1;
+}
+
+static int texlib_getshapingpenaltiesvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 2);
+ lua_push_key_at_index(L, interlinepenalty, inter_line_penalty_shaping);
+ lua_push_key_at_index(L, widowpenalty, widow_penalty_shaping);
+ lua_push_key_at_index(L, clubpenalty, club_penalty_shaping);
+ lua_push_key_at_index(L, brokenpenalty, broken_penalty_shaping);
+ return 1;
+}
+
+
+static int texlib_getprimitiveorigins(lua_State *L)
+{
+ lua_createtable(L, 2, 1);
+ lua_push_key_at_index(L, tex, tex_command);
+ lua_push_key_at_index(L, etex, etex_command);
+ lua_push_key_at_index(L, luatex, luatex_command);
+ return 1;
+}
+
+static int texlib_getlargestusedmark(lua_State* L)
+{
+ lua_pushinteger(L, lmt_mark_state.mark_data.ptr);
+ return 1;
+}
+
+static int texlib_getoutputactive(lua_State* L)
+{
+ lua_pushboolean(L, lmt_page_builder_state.output_active);
+ return 1;
+}
+
+/*tex Moved from lmtnodelib to here. */
+
+int lmt_push_info_keys(lua_State *L, value_info *values)
+{
+ lua_newtable(L);
+ for (int i = 0; values[i].name; i++) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, values[i].lua);
+ lua_rawseti(L, -2, i);
+ }
+ return 1;
+}
+
+int lmt_push_info_values(lua_State *L, value_info *values)
+{
+ lua_newtable(L);
+ for (int i = 0; values[i].name; i++) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, values[i].lua);
+ lua_rawseti(L, -2, values[i].value);
+ }
+ return 1;
+}
+
+static int texlib_getgroupvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.group_code_values);
+}
+
+static int texlib_getmathparametervalues(lua_State *L)
+{
+ return lmt_push_info_keys(L, lmt_interface.math_parameter_values);
+}
+
+static int texlib_getmathstylevalues(lua_State* L)
+{
+ return lmt_push_info_values(L, lmt_interface.math_style_values);
+}
+
+static int texlib_getpacktypevalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.pack_type_values);
+}
+
+static int texlib_getparcontextvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.par_context_values);
+}
+
+static int texlib_getpagecontextvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.page_context_values);
+}
+
+static int texlib_getappendlinecontextvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.append_line_context_values);
+}
+
+static int texlib_getalignmentcontextvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.alignment_context_values);
+}
+
+static int texlib_getparbeginvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.par_begin_values);
+}
+
+static int texlib_getparmodevalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.par_mode_values);
+}
+
+static int texlib_getmathstylenamevalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.math_style_name_values);
+}
+
+static int texlib_getmathvariantvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.math_style_variant_values);
+}
+
+// static int texlib_getmathflattenvalues(lua_State *L)
+// {
+// lua_createtable(L, 2, 3);
+// lua_set_string_by_index(L, math_flatten_ordinary, "ord");
+// lua_set_string_by_index(L, math_flatten_binary, "bin");
+// lua_set_string_by_index(L, math_flatten_relation, "rel");
+// lua_set_string_by_index(L, math_flatten_punctuation, "punct");
+// lua_set_string_by_index(L, math_flatten_inner, "inner");
+// return 1;
+// }
+
+static int texlib_getdiscstatevalues(lua_State *L)
+{
+ lua_createtable(L, 4, 1);
+ lua_set_string_by_index(L, glyph_discpart_unset, "unset");
+ lua_set_string_by_index(L, glyph_discpart_pre, "pre");
+ lua_set_string_by_index(L, glyph_discpart_post, "post");
+ lua_set_string_by_index(L, glyph_discpart_replace, "replace");
+ lua_set_string_by_index(L, glyph_discpart_always, "always");
+ return 1;
+}
+
+static int texlib_getmathcontrolvalues(lua_State *L)
+{
+ lua_createtable(L, 2, 19);
+ lua_set_string_by_index(L, math_control_use_font_control, "usefontcontrol");
+ lua_set_string_by_index(L, math_control_over_rule, "overrule");
+ lua_set_string_by_index(L, math_control_under_rule, "underrule");
+ lua_set_string_by_index(L, math_control_radical_rule, "radicalrule");
+ lua_set_string_by_index(L, math_control_fraction_rule, "fractionrule");
+ lua_set_string_by_index(L, math_control_accent_skew_half, "accentskewhalf");
+ lua_set_string_by_index(L, math_control_accent_skew_apply, "accentskewapply");
+ lua_set_string_by_index(L, math_control_apply_ordinary_kern_pair, "applyordinarykernpair");
+ lua_set_string_by_index(L, math_control_apply_vertical_italic_kern, "applyverticalitalickern");
+ lua_set_string_by_index(L, math_control_apply_ordinary_italic_kern, "applyordinaryitalickern");
+ lua_set_string_by_index(L, math_control_apply_char_italic_kern, "applycharitalickern");
+ lua_set_string_by_index(L, math_control_rebox_char_italic_kern, "reboxcharitalickern");
+ lua_set_string_by_index(L, math_control_apply_boxed_italic_kern, "applyboxeditalickern");
+ lua_set_string_by_index(L, math_control_staircase_kern, "staircasekern");
+ lua_set_string_by_index(L, math_control_apply_text_italic_kern, "applytextitalickern");
+ lua_set_string_by_index(L, math_control_check_text_italic_kern, "checktextitalickern");
+ lua_set_string_by_index(L, math_control_check_space_italic_kern, "checkspaceitalickern");
+ lua_set_string_by_index(L, math_control_apply_script_italic_kern, "applyscriptitalickern");
+ lua_set_string_by_index(L, math_control_analyze_script_nucleus_char, "analyzescriptnucleuschar");
+ lua_set_string_by_index(L, math_control_analyze_script_nucleus_list, "analyzescriptnucleuslist");
+ lua_set_string_by_index(L, math_control_analyze_script_nucleus_box, "analyzescriptnucleusbox");
+ return 1;
+}
+
+static int texlib_gettextcontrolvalues(lua_State *L)
+{
+ lua_createtable(L, 1, 0);
+ lua_set_string_by_index(L, text_control_collapse_hyphens, "collapsehyphens");
+ return 1;
+}
+
+/* relatively new */
+
+static int texlib_getinsertdistance(lua_State *L)
+{
+ return texlib_aux_push_glue(L, tex_get_insert_distance(lmt_tointeger(L, 1)));
+}
+
+static int texlib_getinsertmultiplier(lua_State *L)
+{
+ lua_pushinteger(L, tex_get_insert_multiplier(lmt_tointeger(L, 1)));
+ return 1;
+}
+
+static int texlib_getinsertlimit(lua_State *L)
+{
+ tex_set_insert_limit(lmt_tointeger(L, 1), lmt_opthalfword(L, 2, 0));
+ return 0;
+}
+
+static int texlib_setinsertdistance(lua_State *L)
+{
+ tex_set_insert_distance(lmt_tointeger(L, 1), texlib_aux_make_glue(L, lua_gettop(L), 2));
+ return 0;
+}
+
+static int texlib_setinsertmultiplier(lua_State *L)
+{
+ tex_set_insert_multiplier(lmt_tointeger(L, 1), lmt_tohalfword(L, 2));
+ return 0;
+}
+
+static int texlib_setinsertlimit(lua_State *L)
+{
+ lua_pushinteger(L, tex_get_insert_limit(lmt_tointeger(L, 1)));
+ return 1;
+}
+
+static int texlib_getinsertheight(lua_State *L)
+{
+ lua_pushinteger(L, tex_get_insert_height(lmt_tointeger(L, 1)));
+ return 1;
+}
+
+static int texlib_getinsertdepth(lua_State *L)
+{
+ lua_pushinteger(L, tex_get_insert_depth(lmt_tointeger(L, 1)));
+ return 1;
+}
+
+static int texlib_getinsertwidth(lua_State *L)
+{
+ lua_pushinteger(L, tex_get_insert_width(lmt_tointeger(L, 1)));
+ return 1;
+}
+
+static int texlib_getinsertcontent(lua_State *L)
+{
+ halfword index = lmt_tointeger(L, 1);
+ lmt_node_list_to_lua(L, tex_get_insert_content(index));
+ tex_set_insert_content(index, null);
+ return 1;
+}
+
+static int texlib_setinsertcontent(lua_State *L)
+{
+ halfword index = lmt_tointeger(L, 1);
+ tex_flush_node(tex_get_insert_content(index));
+ tex_set_insert_content(index, lmt_node_list_from_lua(L, 2));
+ return 0;
+}
+
+static int texlib_getlocalbox(lua_State *L)
+{
+ int location = lmt_tointeger(L, 1);
+ if (is_valid_local_box_code(location)) {
+ lmt_node_list_to_lua(L, tex_get_local_boxes(location));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int texlib_setlocalbox(lua_State *L)
+{
+ int location = lmt_tointeger(L, 1);
+ if (is_valid_local_box_code(location)) {
+ tex_set_local_boxes(lmt_node_list_from_lua(L, 1), location);
+ }
+ return 0;
+}
+
+static int texlib_pushsavelevel(lua_State *L)
+{
+ (void) L;
+ tex_new_save_level(lua_group);
+ return 0;
+}
+
+static int texlib_popsavelevel(lua_State *L)
+{
+ (void) L;
+ // tex_off_save();
+ tex_unsave();
+ return 0;
+}
+
+/*tex
+ When testing all these math finetuning options we needed to typeset the box contents and
+ instead of filtering from the log or piping the log to a file, this more ssd friendly
+ feature was added. The first argument is a box (id) and the second an optional detail
+ directive. This is (currently) the only case where we write to a \LUA\ buffer, but I
+ might add variants for a macro and tokenlist at some point (less interesting).
+*/
+
+/* till here */
+
+static const struct luaL_Reg texlib_function_list[] = {
+ { "write", texlib_write },
+ { "print", texlib_print },
+ { "sprint", texlib_sprint },
+ { "mprint", texlib_mprint },
+ { "tprint", texlib_tprint },
+ { "cprint", texlib_cprint },
+ { "isprintable", texlib_isprintable },
+ { "pushlocal", texlib_pushlocal },
+ { "poplocal", texlib_poplocal },
+ { "runlocal", texlib_runlocal },
+ { "runstring", texlib_runstring },
+ { "quitlocal", texlib_quitlocal },
+ { "expandasvalue", texlib_expandasvalue }, /* experiment */
+ { "error", texlib_error },
+ { "set", texlib_set },
+ { "get", texlib_get },
+ { "getregisterindex", texlib_get_register_index },
+ { "isdimen", texlib_isdimen },
+ { "setdimen", texlib_setdimen },
+ { "getdimen", texlib_getdimen },
+ { "isskip", texlib_isskip },
+ { "setskip", texlib_setskip },
+ { "getskip", texlib_getskip },
+ { "isglue", texlib_isglue },
+ { "setglue", texlib_setglue },
+ { "getglue", texlib_getglue },
+ { "ismuskip", texlib_ismuskip },
+ { "setmuskip", texlib_setmuskip },
+ { "getmuskip", texlib_getmuskip },
+ { "ismuglue", texlib_ismuglue },
+ { "setmuglue", texlib_setmuglue },
+ { "getmuglue", texlib_getmuglue },
+ { "isattribute", texlib_isattribute },
+ { "setattribute", texlib_setattribute },
+ { "getattribute", texlib_getattribute },
+ { "iscount", texlib_iscount },
+ { "setcount", texlib_setcount },
+ { "getcount", texlib_getcount },
+ { "istoks", texlib_istoks },
+ { "settoks", texlib_settoks },
+ { "scantoks", texlib_scantoks },
+ { "gettoks", texlib_gettoks },
+ { "getmark", texlib_getmark },
+ { "isbox", texlib_isbox },
+ { "setbox", texlib_setbox },
+ { "getbox", texlib_getbox },
+ { "splitbox", texlib_splitbox },
+ { "setlist", texlib_setlist },
+ { "getlist", texlib_getlist },
+ { "setnest", texlib_setnest }, /* only a message */
+ { "getnest", texlib_getnest },
+ { "setcatcode", texlib_setcatcode },
+ { "getcatcode", texlib_getcatcode },
+ { "setdelcode", texlib_setdelcode },
+ { "getdelcode", texlib_getdelcode },
+ { "getdelcodes", texlib_getdelcodes },
+ { "sethccode", texlib_sethccode },
+ { "gethccode", texlib_gethccode },
+ { "sethmcode", texlib_sethmcode },
+ { "gethmcode", texlib_gethmcode },
+ { "setlccode", texlib_setlccode },
+ { "getlccode", texlib_getlccode },
+ { "setmathcode", texlib_setmathcode },
+ { "getmathcode", texlib_getmathcode },
+ { "getmathcodes", texlib_getmathcodes },
+ { "setsfcode", texlib_setsfcode },
+ { "getsfcode", texlib_getsfcode },
+ { "setuccode", texlib_setuccode },
+ { "getuccode", texlib_getuccode },
+ { "round", texlib_round },
+ { "scale", texlib_scale },
+ { "sp", texlib_toscaled },
+ { "toscaled", texlib_toscaled },
+ { "tonumber", texlib_tonumber },
+ { "fontname", texlib_getfontname },
+ { "fontidentifier", texlib_getfontidentifier },
+ { "getfontoffamily", texlib_getfontoffamily },
+ { "number", texlib_getnumber },
+ // { "dimension", texlib_getdimension },
+ { "romannumeral", texlib_getromannumeral },
+ { "definefont", texlib_definefont },
+ { "hashtokens", texlib_hashtokens },
+ { "primitives", texlib_primitives },
+ { "extraprimitives", texlib_extraprimitives },
+ { "enableprimitives", texlib_enableprimitives },
+ { "shipout", texlib_shipout },
+ { "badness", texlib_badness },
+ { "setmath", texlib_setmath },
+ { "getmath", texlib_getmath },
+ { "linebreak", texlib_linebreak },
+ { "preparelinebreak", texlib_preparelinebreak },
+ { "resetparagraph", texlib_resetparagraph },
+ { "showcontext", texlib_showcontext },
+ { "triggerbuildpage", texlib_triggerbuildpage },
+ { "gethelptext", texlib_gethelptext },
+ { "getpagestate", texlib_getpagestate },
+ { "getlocallevel", texlib_getlocallevel },
+ { "setinputstatemode", texlib_setinputstatemode },
+ { "getinputstatemode", texlib_getinputstatemode },
+ { "setinputstatefile", texlib_setinputstatefile },
+ { "getinputstatefile", texlib_getinputstatefile },
+ { "forceinputstatefile", texlib_forceinputstatefile },
+ { "forceinputstateline", texlib_forceinputstateline },
+ { "setinputstateline", texlib_setinputstateline },
+ { "getinputstateline", texlib_getinputstateline },
+ { "forcehmode", texlib_forcehmode },
+ { "gettextdir", texlib_gettextdir },
+ { "settextdir", texlib_settextdir },
+ { "getlinedir", texlib_gettextdir }, /* we're nice */
+ { "setlinedir", texlib_setlinedir },
+ { "getmathdir", texlib_getmathdir },
+ { "setmathdir", texlib_setmathdir },
+ { "getpardir", texlib_getpardir },
+ { "setpardir", texlib_setpardir },
+ { "getboxdir", texlib_getboxdir },
+ { "setboxdir", texlib_setboxdir },
+ { "getinteraction", texlib_getinteraction },
+ { "setinteraction", texlib_setinteraction },
+ { "getglyphdata", texlib_getglyphdata },
+ { "setglyphdata", texlib_setglyphdata },
+ { "getglyphstate", texlib_getglyphstate },
+ { "setglyphstate", texlib_setglyphstate },
+ { "getglyphscript", texlib_getglyphscript },
+ { "setglyphscript", texlib_setglyphscript },
+ { "getglyphscales", texlib_getglyphscales },
+ { "fatalerror", texlib_fatalerror },
+ { "lastnodetype", texlib_lastnodetype },
+ { "chardef", texlib_chardef },
+ { "mathchardef", texlib_mathchardef },
+ { "integerdef", texlib_setintegervalue },
+ { "setintegervalue", texlib_setintegervalue },
+ { "getintegervalue", texlib_getintegervalue },
+ { "dimensiondef", texlib_setdimensionvalue },
+ { "setdimensionvalue", texlib_setdimensionvalue },
+ { "getdimensionvalue", texlib_getdimensionvalue },
+ { "getmode", texlib_getmode },
+ { "getmodevalues", texlib_getmodevalues },
+ { "getrunstatevalues", texlib_getrunstatevalues },
+ { "setrunstate", texlib_setrunstate },
+ { "gethyphenationvalues", texlib_gethyphenationvalues },
+ { "getglyphoptionvalues", texlib_getglyphoptionvalues },
+ { "getnoadoptionvalues", texlib_getnoadoptionvalues },
+ { "getdiscoptionvalues", texlib_getdiscoptionvalues },
+ { "getlistanchorvalues", texlib_getlistanchorvalues },
+ { "getlistsignvalues", texlib_getlistsignvalues },
+ { "getlistgeometryvalues", texlib_getlistgeometryalues },
+ { "getdiscstatevalues", texlib_getdiscstatevalues },
+ { "getmathparametervalues", texlib_getmathparametervalues },
+ { "getmathstylenamevalues", texlib_getmathstylenamevalues },
+ { "getmathstylevalues", texlib_getmathstylevalues },
+ { "getmathvariantvalues", texlib_getmathvariantvalues },
+ /* {"getmathflattenvalues", texlib_getmathflattenvalues }, */
+ { "getmathcontrolvalues", texlib_getmathcontrolvalues },
+ { "gettextcontrolvalues", texlib_gettextcontrolvalues },
+ { "getpacktypevalues", texlib_getpacktypevalues },
+ { "getgroupvalues", texlib_getgroupvalues },
+ { "getparcontextvalues", texlib_getparcontextvalues },
+ { "getpagecontextvalues", texlib_getpagecontextvalues },
+ { "getappendlinecontextvalues", texlib_getappendlinecontextvalues },
+ { "getalignmentcontextvalues", texlib_getalignmentcontextvalues },
+ { "getparbeginvalues", texlib_getparbeginvalues },
+ { "getparmodevalues", texlib_getparmodevalues },
+ { "getautomigrationvalues", texlib_getautomigrationvalues },
+ { "getflagvalues", texlib_getflagvalues },
+ { "getmathclassoptionvalues", texlib_getmathclassoptionvalues },
+ { "getnormalizelinevalues", texlib_getnormalizelinevalues },
+ { "getnormalizeparvalues", texlib_getnormalizeparvalues },
+ { "geterrorvalues", texlib_geterrorvalues },
+ { "getiovalues", texlib_getiovalues },
+ { "getprimitiveorigins", texlib_getprimitiveorigins },
+ { "getfrozenparvalues", texlib_getfrozenparvalues },
+ { "getshapingpenaltiesvalues", texlib_getshapingpenaltiesvalues },
+ { "getspecialmathclassvalues", texlib_getspecialmathclassvalues },
+ { "getlargestusedmark", texlib_getlargestusedmark },
+ { "getoutputactive", texlib_getoutputactive },
+ /* experiment (metafun update) */
+ { "shiftparshape", texlib_shiftparshape },
+ { "snapshotpar", texlib_snapshotpar },
+ { "getparstate", texlib_getparstate },
+ /* */
+ { "getinsertdistance", texlib_getinsertdistance },
+ { "getinsertmultiplier", texlib_getinsertmultiplier },
+ { "getinsertlimit", texlib_getinsertlimit },
+ { "getinsertheight", texlib_getinsertheight },
+ { "getinsertdepth", texlib_getinsertdepth },
+ { "getinsertwidth", texlib_getinsertwidth },
+ { "getinsertcontent", texlib_getinsertcontent },
+ { "setinsertdistance", texlib_setinsertdistance },
+ { "setinsertmultiplier", texlib_setinsertmultiplier },
+ { "setinsertlimit", texlib_setinsertlimit },
+ { "setinsertcontent", texlib_setinsertcontent },
+ { "getlocalbox", texlib_getlocalbox },
+ { "setlocalbox", texlib_setlocalbox },
+ /* */
+ { "pushsavelevel", texlib_pushsavelevel },
+ { "popsavelevel", texlib_popsavelevel },
+ /* */
+ { NULL, NULL },
+};
+
+# define defineindexers(name) \
+ static int texlib_index_##name (lua_State *L) { lua_remove(L, 1); return texlib_get##name(L); } \
+ static int texlib_newindex_##name(lua_State *L) { lua_remove(L, 1); return texlib_set##name(L); }
+
+defineindexers(attribute)
+defineindexers(skip)
+defineindexers(glue)
+defineindexers(muskip)
+defineindexers(muglue)
+defineindexers(dimen)
+defineindexers(count)
+defineindexers(toks)
+defineindexers(box)
+defineindexers(sfcode)
+defineindexers(lccode)
+defineindexers(uccode)
+defineindexers(hccode)
+defineindexers(hmcode)
+defineindexers(catcode)
+defineindexers(mathcode)
+defineindexers(delcode)
+defineindexers(list)
+defineindexers(nest)
+
+/*tex
+ At some point the |__index| and |__newindex |below will go away so that we no longer get
+ interferences when we extedn the |tex| table.
+*/
+
+int luaopen_tex(lua_State *L)
+{
+ texlib_aux_initialize();
+ /* */
+ lua_newtable(L);
+ luaL_setfuncs(L, texlib_function_list, 0);
+ lmt_make_table(L, "attribute", TEX_METATABLE_ATTRIBUTE, texlib_index_attribute, texlib_newindex_attribute);
+ lmt_make_table(L, "skip", TEX_METATABLE_SKIP, texlib_index_skip, texlib_newindex_skip);
+ lmt_make_table(L, "glue", TEX_METATABLE_GLUE, texlib_index_glue, texlib_newindex_glue);
+ lmt_make_table(L, "muskip", TEX_METATABLE_MUSKIP, texlib_index_muskip, texlib_newindex_muskip);
+ lmt_make_table(L, "muglue", TEX_METATABLE_MUGLUE, texlib_index_muglue, texlib_newindex_muglue);
+ lmt_make_table(L, "dimen", TEX_METATABLE_DIMEN, texlib_index_dimen, texlib_newindex_dimen);
+ lmt_make_table(L, "count", TEX_METATABLE_COUNT, texlib_index_count, texlib_newindex_count);
+ lmt_make_table(L, "toks", TEX_METATABLE_TOKS, texlib_index_toks, texlib_newindex_toks);
+ lmt_make_table(L, "box", TEX_METATABLE_BOX, texlib_index_box, texlib_newindex_box);
+ lmt_make_table(L, "sfcode", TEX_METATABLE_SFCODE, texlib_index_sfcode, texlib_newindex_sfcode);
+ lmt_make_table(L, "lccode", TEX_METATABLE_LCCODE, texlib_index_lccode, texlib_newindex_lccode);
+ lmt_make_table(L, "uccode", TEX_METATABLE_UCCODE, texlib_index_uccode, texlib_newindex_uccode);
+ lmt_make_table(L, "hccode", TEX_METATABLE_HCCODE, texlib_index_hccode, texlib_newindex_hccode);
+ lmt_make_table(L, "hmcode", TEX_METATABLE_HMCODE, texlib_index_hmcode, texlib_newindex_hmcode);
+ lmt_make_table(L, "catcode", TEX_METATABLE_CATCODE, texlib_index_catcode, texlib_newindex_catcode);
+ lmt_make_table(L, "mathcode", TEX_METATABLE_MATHCODE, texlib_index_mathcode, texlib_newindex_mathcode);
+ lmt_make_table(L, "delcode", TEX_METATABLE_DELCODE, texlib_index_delcode, texlib_newindex_delcode);
+ lmt_make_table(L, "lists", TEX_METATABLE_LISTS, texlib_index_list, texlib_newindex_list);
+ lmt_make_table(L, "nest", TEX_METATABLE_NEST, texlib_index_nest, texlib_newindex_nest);
+ texlib_aux_init_nest_lib(L);
+ /*tex make the meta entries and fetch it back */
+ luaL_newmetatable(L, TEX_METATABLE_TEX);
+ lua_pushstring(L, "__index");
+ lua_pushcfunction(L, texlib_index);
+ lua_settable(L, -3);
+ lua_pushstring(L, "__newindex");
+ lua_pushcfunction(L, texlib_newindex);
+ lua_settable(L, -3);
+ lua_setmetatable(L, -2);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmttexlib.h b/source/luametatex/source/lua/lmttexlib.h
new file mode 100644
index 000000000..b0033535a
--- /dev/null
+++ b/source/luametatex/source/lua/lmttexlib.h
@@ -0,0 +1,29 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LTEXLIB_H
+# define LMT_LTEXLIB_H
+
+extern void lmt_cstring_start (void);
+extern void lmt_cstring_close (void);
+extern int lmt_cstring_input (halfword *n, int *cattable, int *partial, int *finalline);
+
+extern void lmt_cstring_print (int cattable, const char *s, int ispartial);
+extern void lmt_tstring_store (strnumber s, int cattable);
+extern void lmt_cstring_store (char *s, int l, int cattable);
+
+extern int lmt_check_for_flags (lua_State *L, int slot, int *flags, int prefixes, int numeric); /* returns slot */
+extern int lmt_check_for_level (lua_State *L, int slot, quarterword *level, quarterword defaultlevel); /* returns slot */
+
+extern int lmt_get_box_id (lua_State *L, int slot, int report);
+
+/*tex
+ In the meantime keys are sequential so we can replace values by keys especially when the type
+ field is used.
+*/
+
+extern int lmt_push_info_values (lua_State *L, value_info *values);
+extern int lmt_push_info_keys (lua_State *L, value_info *values);
+
+# endif
diff --git a/source/luametatex/source/lua/lmttokenlib.c b/source/luametatex/source/lua/lmttokenlib.c
new file mode 100644
index 000000000..896b22eec
--- /dev/null
+++ b/source/luametatex/source/lua/lmttokenlib.c
@@ -0,0 +1,3894 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ The tokenlib started out as an expetiment. The first version provided a rough interface to the
+ internals but could only really be used for simple introspection and limited piping back. A major
+ step up came in a second version where Taco introduced a couple of scanners. During experiments
+ in \CONTEXT\ I added some more so now we have a reasonable repertoire of creators, accessors and
+ scanners. Piping back to \LUA\ happens in the |tex| library and that one also has been enhanced
+ and accepts tokens.
+
+ In \LUAMETATEX\ much got streamlined, partially rewritten and some more got added so we're now
+ actually at the third version. In the meantime the experimental status has been revoked. Also,
+ the internals that relate to tokens in \LUAMETATEX\ have been redone so that the interface to
+ \LUA\ feels more natural.
+
+ Tokens are numbers but these can best be treated as abstractions. The number can be split in
+ components that code some properties. However, these numbers can change depending on what
+ abstraction we decide to use. As with the nodes integers make for an efficient coding but are
+ effectively just black boxes. The Lua interface below communicates via such numbers but don't
+ make your code dependent of the values. The mentioned rework of the internals now makes sure
+ that we get less funny numbers. For instance all chr codes nor occupy proper ranges and names
+ are more meaningful.
+
+*/
+
+# include "luametatex.h"
+
+/* # define TOKEN_METATABLE_INSTANCE "luatex.token" */
+
+typedef struct lua_token_package {
+ struct {
+ quarterword level; /* not used but it reflects the original */
+ quarterword how; /* global */
+ };
+ singleword cmd;
+ singleword flag;
+ halfword chr;
+ halfword cs;
+} lua_token_package;
+
+/*
+
+ So, given what is said above, the \LUA\ interface no longer really is about magic numbers
+ combined from cmd and chr codes, sometimes called modes, but consistently tries to use the
+ combination instead of the composed number. The number is still there (and available) but users
+ need to keep in mind that constructing them directly is bad idea: the internals and therefore
+ cmd and chr codes can change! We start with a table that defines all the properties.
+
+ It must be noticed that the codebase is now rather different from \LUATEX. Of course we still
+ have most of the original commands but new ones have been added, experimental one have been
+ dropped, some have been combined. One criterium for grouping commands is that such a group gets
+ a unique treatment in reading a follow up, serialization, expansion, the main loop, the
+ registers and variables it refers to, etc. There is some logic behind it!
+
+ command_item lmt_command_names[] = {
+ { .id = escape_cmd, .lua = 0, .name = NULL, .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = too_big_char },
+ ....
+ } ;
+
+ has been replaced by a dynamic allocation and later assignment.
+
+ In principle we can add some more clever token definers for instance for integers but that will
+ be done when I need it. The special data / reference commands need some checking (min, max etc.)
+
+*/
+
+# define ignore_entry -1
+# define direct_entry -2
+
+void lmt_tokenlib_initialize(void)
+{
+
+ lmt_interface.command_names = lmt_memory_malloc((register_dimen_reference_cmd + 2) * sizeof(command_item));
+
+ lmt_interface.command_names[escape_cmd] = (command_item) { .id = escape_cmd, .lua = lua_key_index(escape), .name = lua_key(escape), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = too_big_char };
+ lmt_interface.command_names[left_brace_cmd] = (command_item) { .id = left_brace_cmd, .lua = lua_key_index(left_brace), .name = lua_key(left_brace), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[right_brace_cmd] = (command_item) { .id = right_brace_cmd, .lua = lua_key_index(right_brace), .name = lua_key(right_brace), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_shift_cmd] = (command_item) { .id = math_shift_cmd, .lua = lua_key_index(math_shift), .name = lua_key(math_shift), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[alignment_tab_cmd] = (command_item) { .id = alignment_tab_cmd, .lua = lua_key_index(alignment_tab), .name = lua_key(alignment_tab), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[end_line_cmd] = (command_item) { .id = end_line_cmd, .lua = lua_key_index(end_line), .name = lua_key(end_line), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[parameter_cmd] = (command_item) { .id = parameter_cmd, .lua = lua_key_index(parameter), .name = lua_key(parameter), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[superscript_cmd] = (command_item) { .id = superscript_cmd, .lua = lua_key_index(superscript), .name = lua_key(superscript), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[subscript_cmd] = (command_item) { .id = subscript_cmd, .lua = lua_key_index(subscript), .name = lua_key(subscript), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[ignore_cmd] = (command_item) { .id = ignore_cmd, .lua = lua_key_index(ignore), .name = lua_key(ignore), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[spacer_cmd] = (command_item) { .id = spacer_cmd, .lua = lua_key_index(spacer), .name = lua_key(spacer), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[letter_cmd] = (command_item) { .id = letter_cmd, .lua = lua_key_index(letter), .name = lua_key(letter), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[other_char_cmd] = (command_item) { .id = other_char_cmd, .lua = lua_key_index(other_char), .name = lua_key(other_char), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[active_char_cmd] = (command_item) { .id = active_char_cmd, .lua = lua_key_index(active_char), .name = lua_key(active_char), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = too_big_char };
+ lmt_interface.command_names[comment_cmd] = (command_item) { .id = comment_cmd, .lua = lua_key_index(comment), .name = lua_key(comment), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[invalid_char_cmd] = (command_item) { .id = invalid_char_cmd, .lua = lua_key_index(invalid_char), .name = lua_key(invalid_char), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[relax_cmd] = (command_item) { .id = relax_cmd, .lua = lua_key_index(relax), .name = lua_key(relax), .kind = regular_command_item, .min = 0, .max = last_relax_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[end_template_cmd] = (command_item) { .id = end_template_cmd, .lua = lua_key_index(alignment), .name = lua_key(alignment), .kind = regular_command_item, .min = 0, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[alignment_cmd] = (command_item) { .id = alignment_cmd, .lua = lua_key_index(end_template), .name = lua_key(end_template), .kind = regular_command_item, .min = 0, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[match_cmd] = (command_item) { .id = match_cmd, .lua = lua_key_index(match), .name = lua_key(match), .kind = regular_command_item, .min = 0, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[end_match_cmd] = (command_item) { .id = end_match_cmd, .lua = lua_key_index(end_match), .name = lua_key(end_match), .kind = regular_command_item, .min = 0, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[parameter_reference_cmd] = (command_item) { .id = parameter_reference_cmd, .lua = lua_key_index(parameter_reference), .name = lua_key(parameter_reference), .kind = regular_command_item, .min = 0, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[end_paragraph_cmd] = (command_item) { .id = end_paragraph_cmd, .lua = lua_key_index(end_paragraph), .name = lua_key(end_paragraph), .kind = regular_command_item, .min = 0, .max = last_end_paragraph_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[end_job_cmd] = (command_item) { .id = end_job_cmd, .lua = lua_key_index(end_job), .name = lua_key(end_job), .kind = regular_command_item, .min = 0, .max = last_end_job_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[delimiter_number_cmd] = (command_item) { .id = delimiter_number_cmd, .lua = lua_key_index(delimiter_number), .name = lua_key(delimiter_number), .kind = regular_command_item, .min = 0, .max = last_math_delimiter_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[char_number_cmd] = (command_item) { .id = char_number_cmd, .lua = lua_key_index(char_number), .name = lua_key(char_number), .kind = regular_command_item, .min = 0, .max = last_char_number_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_char_number_cmd] = (command_item) { .id = math_char_number_cmd, .lua = lua_key_index(math_char_number), .name = lua_key(math_char_number), .kind = regular_command_item, .min = 0, .max = last_math_char_number_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_mark_cmd] = (command_item) { .id = set_mark_cmd, .lua = lua_key_index(set_mark), .name = lua_key(set_mark), .kind = regular_command_item, .min = 0, .max = last_set_mark_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[node_cmd] = (command_item) { .id = node_cmd, .lua = lua_key_index(node), .name = lua_key(node), .kind = node_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[xray_cmd] = (command_item) { .id = xray_cmd, .lua = lua_key_index(xray), .name = lua_key(xray), .kind = regular_command_item, .min = 0, .max = last_xray_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[make_box_cmd] = (command_item) { .id = make_box_cmd, .lua = lua_key_index(make_box), .name = lua_key(make_box), .kind = regular_command_item, .min = 0, .max = last_nu_box_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[hmove_cmd] = (command_item) { .id = hmove_cmd, .lua = lua_key_index(hmove), .name = lua_key(hmove), .kind = regular_command_item, .min = 0, .max = last_move_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[vmove_cmd] = (command_item) { .id = vmove_cmd, .lua = lua_key_index(vmove), .name = lua_key(vmove), .kind = regular_command_item, .min = 0, .max = last_move_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[un_hbox_cmd] = (command_item) { .id = un_hbox_cmd, .lua = lua_key_index(un_hbox), .name = lua_key(un_hbox), .kind = regular_command_item, .min = 0, .max = last_un_box_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[un_vbox_cmd] = (command_item) { .id = un_vbox_cmd, .lua = lua_key_index(un_vbox), .name = lua_key(un_vbox), .kind = regular_command_item, .min = 0, .max = last_un_box_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[remove_item_cmd] = (command_item) { .id = remove_item_cmd, .lua = lua_key_index(remove_item), .name = lua_key(remove_item), .kind = regular_command_item, .min = 0, .max = last_remove_item_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[hskip_cmd] = (command_item) { .id = hskip_cmd, .lua = lua_key_index(hskip), .name = lua_key(hskip), .kind = regular_command_item, .min = first_skip_code, .max = last_skip_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[vskip_cmd] = (command_item) { .id = vskip_cmd, .lua = lua_key_index(vskip), .name = lua_key(vskip), .kind = regular_command_item, .min = first_skip_code, .max = last_skip_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[mskip_cmd] = (command_item) { .id = mskip_cmd, .lua = lua_key_index(mskip), .name = lua_key(mskip), .kind = regular_command_item, .min = 0, .max = last_mskip_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[kern_cmd] = (command_item) { .id = kern_cmd, .lua = lua_key_index(kern), .name = lua_key(kern), .kind = regular_command_item, .min = 0, .max = last_kern_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[mkern_cmd] = (command_item) { .id = mkern_cmd, .lua = lua_key_index(mkern), .name = lua_key(mkern), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[leader_cmd] = (command_item) { .id = leader_cmd, .lua = lua_key_index(leader), .name = lua_key(leader), .kind = regular_command_item, .min = first_leader_code, .max = last_leader_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[legacy_cmd] = (command_item) { .id = legacy_cmd, .lua = lua_key_index(legacy), .name = lua_key(legacy), .kind = regular_command_item, .min = first_legacy_code, .max = last_legacy_code , .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[local_box_cmd] = (command_item) { .id = local_box_cmd, .lua = lua_key_index(local_box), .name = lua_key(local_box), .kind = regular_command_item, .min = first_local_box_code, .max = last_local_box_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[halign_cmd] = (command_item) { .id = halign_cmd, .lua = lua_key_index(halign), .name = lua_key(halign), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[valign_cmd] = (command_item) { .id = valign_cmd, .lua = lua_key_index(valign), .name = lua_key(valign), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[vrule_cmd] = (command_item) { .id = vrule_cmd, .lua = lua_key_index(vrule), .name = lua_key(vrule), .kind = regular_command_item, .min = first_rule_code, .max = last_rule_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[hrule_cmd] = (command_item) { .id = hrule_cmd, .lua = lua_key_index(hrule), .name = lua_key(hrule), .kind = regular_command_item, .min = first_rule_code, .max = last_rule_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[insert_cmd] = (command_item) { .id = insert_cmd, .lua = lua_key_index(insert), .name = lua_key(insert), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[vadjust_cmd] = (command_item) { .id = vadjust_cmd, .lua = lua_key_index(vadjust), .name = lua_key(vadjust), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[ignore_something_cmd] = (command_item) { .id = ignore_something_cmd, .lua = lua_key_index(ignore_something), .name = lua_key(ignore_something), .kind = regular_command_item, .min = 0, .max = last_ignore_something_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[after_something_cmd] = (command_item) { .id = after_something_cmd, .lua = lua_key_index(after_something), .name = lua_key(after_something), .kind = regular_command_item, .min = 0, .max = last_after_something_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[penalty_cmd] = (command_item) { .id = penalty_cmd, .lua = lua_key_index(penalty), .name = lua_key(penalty), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[begin_paragraph_cmd] = (command_item) { .id = begin_paragraph_cmd, .lua = lua_key_index(begin_paragraph), .name = lua_key(begin_paragraph), .kind = regular_command_item, .min = 0, .max = last_begin_paragraph_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[italic_correction_cmd] = (command_item) { .id = italic_correction_cmd, .lua = lua_key_index(italic_correction), .name = lua_key(italic_correction), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[accent_cmd] = (command_item) { .id = accent_cmd, .lua = lua_key_index(accent), .name = lua_key(accent), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_accent_cmd] = (command_item) { .id = math_accent_cmd, .lua = lua_key_index(math_accent), .name = lua_key(math_accent), .kind = regular_command_item, .min = 0, .max = last_math_accent_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[discretionary_cmd] = (command_item) { .id = discretionary_cmd, .lua = lua_key_index(discretionary), .name = lua_key(discretionary), .kind = regular_command_item, .min = 0, .max = last_discretionary_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[equation_number_cmd] = (command_item) { .id = equation_number_cmd, .lua = lua_key_index(equation_number), .name = lua_key(equation_number), .kind = regular_command_item, .min = first_location_code, .max = last_location_code, .base = 0, .fixedvalue = 0 }; /* maybe dedicated codes */
+ lmt_interface.command_names[math_fence_cmd] = (command_item) { .id = math_fence_cmd, .lua = lua_key_index(math_fence), .name = lua_key(math_fence), .kind = regular_command_item, .min = first_fence_code, .max = last_fence_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_component_cmd] = (command_item) { .id = math_component_cmd, .lua = lua_key_index(math_component), .name = lua_key(math_component), .kind = regular_command_item, .min = first_math_component_type, .max = last_math_component_type, .base = 0, .fixedvalue = 0 }; /* a bit too tolerant */
+ lmt_interface.command_names[math_modifier_cmd] = (command_item) { .id = math_modifier_cmd, .lua = lua_key_index(math_modifier), .name = lua_key(math_modifier), .kind = regular_command_item, .min = first_math_modifier_code, .max = last_math_modifier_code, .base = 0, .fixedvalue = 0 }; /* a bit too tolerant */
+ lmt_interface.command_names[math_fraction_cmd] = (command_item) { .id = math_fraction_cmd, .lua = lua_key_index(math_fraction), .name = lua_key(math_fraction), .kind = regular_command_item, .min = 0, .max = last_math_fraction_code, .base = 0, .fixedvalue = 0 }; /* partial */
+ lmt_interface.command_names[math_style_cmd] = (command_item) { .id = math_style_cmd, .lua = lua_key_index(math_style), .name = lua_key(math_style), .kind = regular_command_item, .min = 0, .max = last_math_style, .base = 0, .fixedvalue = 0 }; /* partial */
+ lmt_interface.command_names[math_choice_cmd] = (command_item) { .id = math_choice_cmd, .lua = lua_key_index(math_choice), .name = lua_key(math_choice), .kind = regular_command_item, .min = 0, .max = last_math_choice_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[vcenter_cmd] = (command_item) { .id = vcenter_cmd, .lua = lua_key_index(vcenter), .name = lua_key(vcenter), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[case_shift_cmd] = (command_item) { .id = case_shift_cmd, .lua = lua_key_index(case_shift), .name = lua_key(case_shift), .kind = regular_command_item, .min = 0, .max = last_case_shift_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[message_cmd] = (command_item) { .id = message_cmd, .lua = lua_key_index(message), .name = lua_key(message), .kind = regular_command_item, .min = 0, .max = last_message_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[catcode_table_cmd] = (command_item) { .id = catcode_table_cmd, .lua = lua_key_index(catcode_table), .name = lua_key(catcode_table), .kind = regular_command_item, .min = 0, .max = last_catcode_table_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[end_local_cmd] = (command_item) { .id = end_local_cmd, .lua = lua_key_index(end_local), .name = lua_key(end_local), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[lua_function_call_cmd] = (command_item) { .id = lua_function_call_cmd, .lua = lua_key_index(lua_function_call), .name = lua_key(lua_function_call), .kind = reference_command_item, .min = 0, .max = max_function_reference, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[lua_protected_call_cmd] = (command_item) { .id = lua_protected_call_cmd, .lua = lua_key_index(lua_protected_call), .name = lua_key(lua_protected_call), .kind = reference_command_item, .min = 0, .max = max_function_reference, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[begin_group_cmd] = (command_item) { .id = begin_group_cmd, .lua = lua_key_index(begin_group), .name = lua_key(begin_group), .kind = regular_command_item, .min = 0, .max = last_begin_group_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[end_group_cmd] = (command_item) { .id = end_group_cmd, .lua = lua_key_index(end_group), .name = lua_key(end_group), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[explicit_space_cmd] = (command_item) { .id = explicit_space_cmd, .lua = lua_key_index(explicit_space), .name = lua_key(explicit_space), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[boundary_cmd] = (command_item) { .id = boundary_cmd, .lua = lua_key_index(boundary), .name = lua_key(boundary), .kind = regular_command_item, .min = 0, .max = last_boundary_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_radical_cmd] = (command_item) { .id = math_radical_cmd, .lua = lua_key_index(math_radical), .name = lua_key(math_radical), .kind = regular_command_item, .min = 0, .max = last_radical_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_script_cmd] = (command_item) { .id = math_script_cmd, .lua = lua_key_index(math_script), .name = lua_key(math_script), .kind = regular_command_item, .min = 0, .max = last_math_script_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[math_shift_cs_cmd] = (command_item) { .id = math_shift_cs_cmd, .lua = lua_key_index(math_shift_cs), .name = lua_key(math_shift_cs), .kind = regular_command_item, .min = 0, .max = last_math_shift_cs_code, .base = 0, .fixedvalue = 0 }; /* a bit too tolerant */
+ lmt_interface.command_names[end_cs_name_cmd] = (command_item) { .id = end_cs_name_cmd, .lua = lua_key_index(end_cs_name), .name = lua_key(end_cs_name), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[char_given_cmd] = (command_item) { .id = char_given_cmd, .lua = lua_key_index(char_given), .name = lua_key(char_given), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ // lmt_interface.command_names[math_char_given_cmd] = (command_item) { .id = math_char_given_cmd, .lua = lua_key_index(math_char_given), .name = lua_key(math_char_given), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ // lmt_interface.command_names[math_char_xgiven_cmd] = (command_item) { .id = math_char_xgiven_cmd, .lua = lua_key_index(math_char_xgiven), .name = lua_key(math_char_xgiven), .kind = character_command_item, .min = 0, .max = max_character_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[some_item_cmd] = (command_item) { .id = some_item_cmd, .lua = lua_key_index(some_item), .name = lua_key(some_item), .kind = regular_command_item, .min = 0, .max = last_some_item_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_toks_cmd] = (command_item) { .id = internal_toks_cmd, .lua = lua_key_index(internal_toks), .name = lua_key(internal_toks), .kind = internal_command_item, .min = first_toks_code, .max = last_toks_code, .base = internal_toks_base, .fixedvalue = 0 };
+ lmt_interface.command_names[register_toks_cmd] = (command_item) { .id = register_toks_cmd, .lua = lua_key_index(register_toks), .name = lua_key(register_toks), .kind = register_command_item, .min = 0, .max = biggest_reg, .base = register_toks_base, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_int_cmd] = (command_item) { .id = internal_int_cmd, .lua = lua_key_index(internal_int), .name = lua_key(internal_int), .kind = internal_command_item, .min = first_int_code, .max = last_int_code, .base = internal_int_base, .fixedvalue = 0 };
+ lmt_interface.command_names[register_int_cmd] = (command_item) { .id = register_int_cmd, .lua = lua_key_index(register_int), .name = lua_key(register_int), .kind = register_command_item, .min = 0, .max = max_int_register_index, .base = register_int_base, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_attribute_cmd] = (command_item) { .id = internal_attribute_cmd, .lua = lua_key_index(internal_attribute), .name = lua_key(internal_attribute), .kind = unused_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_attribute_cmd] = (command_item) { .id = register_attribute_cmd, .lua = lua_key_index(register_attribute), .name = lua_key(register_attribute), .kind = register_command_item, .min = 0, .max = max_attribute_register_index, .base = register_attribute_base, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_dimen_cmd] = (command_item) { .id = internal_dimen_cmd, .lua = lua_key_index(internal_dimen), .name = lua_key(internal_dimen), .kind = internal_command_item, .min = first_dimen_code, .max = last_dimen_code, .base = internal_dimen_base, .fixedvalue = 0 };
+ lmt_interface.command_names[register_dimen_cmd] = (command_item) { .id = register_dimen_cmd, .lua = lua_key_index(register_dimen), .name = lua_key(register_dimen), .kind = register_command_item, .min = 0, .max = max_dimen_register_index, .base = register_dimen_base, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_glue_cmd] = (command_item) { .id = internal_glue_cmd, .lua = lua_key_index(internal_glue), .name = lua_key(internal_glue), .kind = internal_command_item, .min = first_glue_code, .max = last_glue_code, .base = internal_glue_base, .fixedvalue = 0 };
+ lmt_interface.command_names[register_glue_cmd] = (command_item) { .id = register_glue_cmd, .lua = lua_key_index(register_glue), .name = lua_key(register_glue), .kind = register_command_item, .min = 0, .max = max_glue_register_index, .base = register_glue_base, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_mu_glue_cmd] = (command_item) { .id = internal_mu_glue_cmd, .lua = lua_key_index(internal_mu_glue), .name = lua_key(internal_mu_glue), .kind = internal_command_item, .min = first_mu_glue_code, .max = last_mu_glue_code, .base = internal_mu_glue_base, .fixedvalue = 0 };
+ lmt_interface.command_names[register_mu_glue_cmd] = (command_item) { .id = register_mu_glue_cmd, .lua = lua_key_index(register_mu_glue), .name = lua_key(register_mu_glue), .kind = register_command_item, .min = 0, .max = max_mu_glue_register_index, .base = register_mu_glue_base, .fixedvalue = 0 };
+ lmt_interface.command_names[lua_value_cmd] = (command_item) { .id = lua_value_cmd, .lua = lua_key_index(lua_value), .name = lua_key(lua_value), .kind = reference_command_item, .min = 0, .max = max_function_reference, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[iterator_value_cmd] = (command_item) { .id = iterator_value_cmd, .lua = lua_key_index(iterator_value), .name = lua_key(iterator_value), .kind = data_command_item, .min = min_iterator_value, .max = max_iterator_value, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_font_property_cmd] = (command_item) { .id = set_font_property_cmd, .lua = lua_key_index(set_font_property), .name = lua_key(set_font_property), .kind = regular_command_item, .min = 0, .max = last_font_property_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_auxiliary_cmd] = (command_item) { .id = set_auxiliary_cmd, .lua = lua_key_index(set_auxiliary), .name = lua_key(set_auxiliary), .kind = regular_command_item, .min = 0, .max = last_auxiliary_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_page_property_cmd] = (command_item) { .id = set_page_property_cmd, .lua = lua_key_index(set_page_property), .name = lua_key(set_page_property), .kind = regular_command_item, .min = 0, .max = last_page_property_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_box_property_cmd] = (command_item) { .id = set_box_property_cmd, .lua = lua_key_index(set_box_property), .name = lua_key(set_box_property), .kind = regular_command_item, .min = 0, .max = last_box_property_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_specification_cmd] = (command_item) { .id = set_specification_cmd, .lua = lua_key_index(set_specification), .name = lua_key(set_specification), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[define_char_code_cmd] = (command_item) { .id = define_char_code_cmd, .lua = lua_key_index(define_char_code), .name = lua_key(define_char_code), .kind = regular_command_item, .min = 0, .max = last_charcode_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[define_family_cmd] = (command_item) { .id = define_family_cmd, .lua = lua_key_index(define_family), .name = lua_key(define_family), .kind = regular_command_item, .min = 0, .max = last_math_size, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_math_parameter_cmd] = (command_item) { .id = set_math_parameter_cmd, .lua = lua_key_index(set_math_parameter), .name = lua_key(set_math_parameter), .kind = regular_command_item, .min = 0, .max = last_math_parameter, .base = 0, .fixedvalue = 0 };
+ // lmt_interface.command_names[set_font_cmd] = (command_item) { .id = set_font_cmd, .lua = lua_key_index(set_font), .name = lua_key(set_font), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[set_font_cmd] = (command_item) { .id = set_font_cmd, .lua = lua_key_index(set_font), .name = lua_key(set_font), .kind = data_command_item, .min = 0, .max = max_font_size, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[define_font_cmd] = (command_item) { .id = define_font_cmd, .lua = lua_key_index(define_font), .name = lua_key(define_font), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[integer_cmd] = (command_item) { .id = integer_cmd, .lua = lua_key_index(integer), .name = lua_key(integer), .kind = data_command_item, .min = min_integer, .max = max_integer, .base = direct_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[dimension_cmd] = (command_item) { .id = dimension_cmd, .lua = lua_key_index(dimension), .name = lua_key(dimension), .kind = data_command_item, .min = min_dimen, .max = max_dimen, .base = direct_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[gluespec_cmd] = (command_item) { .id = gluespec_cmd, .lua = lua_key_index(gluespec), .name = lua_key(gluespec), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[mugluespec_cmd] = (command_item) { .id = mugluespec_cmd, .lua = lua_key_index(mugluespec), .name = lua_key(mugluespec), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[mathspec_cmd] = (command_item) { .id = mathspec_cmd, .lua = lua_key_index(mathspec), .name = lua_key(fontspec), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[fontspec_cmd] = (command_item) { .id = fontspec_cmd, .lua = lua_key_index(fontspec), .name = lua_key(fontspec), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_cmd] = (command_item) { .id = register_cmd, .lua = lua_key_index(register), .name = lua_key(register), .kind = regular_command_item, .min = first_value_level, .max = last_value_level, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[combine_toks_cmd] = (command_item) { .id = combine_toks_cmd, .lua = lua_key_index(combine_toks), .name = lua_key(combine_toks), .kind = regular_command_item, .min = 0, .max = last_combine_toks_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[arithmic_cmd] = (command_item) { .id = arithmic_cmd, .lua = lua_key_index(arithmic), .name = lua_key(arithmic), .kind = regular_command_item, .min = 0, .max = last_arithmic_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[prefix_cmd] = (command_item) { .id = prefix_cmd, .lua = lua_key_index(prefix), .name = lua_key(prefix), .kind = regular_command_item, .min = 0, .max = last_prefix_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[let_cmd] = (command_item) { .id = let_cmd, .lua = lua_key_index(let), .name = lua_key(let), .kind = regular_command_item, .min = 0, .max = last_let_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[shorthand_def_cmd] = (command_item) { .id = shorthand_def_cmd, .lua = lua_key_index(shorthand_def), .name = lua_key(shorthand_def), .kind = regular_command_item, .min = 0, .max = last_shorthand_def_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[def_cmd] = (command_item) { .id = def_cmd, .lua = lua_key_index(def), .name = lua_key(def), .kind = regular_command_item, .min = 0, .max = last_def_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_box_cmd] = (command_item) { .id = set_box_cmd, .lua = lua_key_index(set_box), .name = lua_key(set_box), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[hyphenation_cmd] = (command_item) { .id = hyphenation_cmd, .lua = lua_key_index(hyphenation), .name = lua_key(hyphenation), .kind = regular_command_item, .min = 0, .max = last_hyphenation_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[set_interaction_cmd] = (command_item) { .id = set_interaction_cmd, .lua = lua_key_index(set_interaction), .name = lua_key(set_interaction), .kind = regular_command_item, .min = 0, .max = last_interaction_level, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[undefined_cs_cmd] = (command_item) { .id = undefined_cs_cmd, .lua = lua_key_index(undefined_cs), .name = lua_key(undefined_cs), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[expand_after_cmd] = (command_item) { .id = expand_after_cmd, .lua = lua_key_index(expand_after), .name = lua_key(expand_after), .kind = regular_command_item, .min = 0, .max = last_expand_after_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[no_expand_cmd] = (command_item) { .id = no_expand_cmd, .lua = lua_key_index(no_expand), .name = lua_key(no_expand), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[input_cmd] = (command_item) { .id = input_cmd, .lua = lua_key_index(input), .name = lua_key(input), .kind = regular_command_item, .min = 0, .max = last_input_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[lua_call_cmd] = (command_item) { .id = lua_call_cmd, .lua = lua_key_index(lua_call), .name = lua_key(lua_call), .kind = reference_command_item, .min = 0, .max = max_function_reference, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[lua_local_call_cmd] = (command_item) { .id = lua_local_call_cmd, .lua = lua_key_index(lua_local_call), .name = lua_key(lua_local_call), .kind = reference_command_item, .min = 0, .max = max_function_reference, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[begin_local_cmd] = (command_item) { .id = begin_local_cmd, .lua = lua_key_index(begin_local), .name = lua_key(begin_local), .kind = regular_command_item, .min = 0, .max = 0, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[if_test_cmd] = (command_item) { .id = if_test_cmd, .lua = lua_key_index(if_test), .name = lua_key(if_test), .kind = regular_command_item, .min = first_if_test_code, .max = last_if_test_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[cs_name_cmd] = (command_item) { .id = cs_name_cmd, .lua = lua_key_index(cs_name), .name = lua_key(cs_name), .kind = regular_command_item, .min = 0, .max = last_cs_name_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[convert_cmd] = (command_item) { .id = convert_cmd, .lua = lua_key_index(convert), .name = lua_key(convert), .kind = regular_command_item, .min = 0, .max = last_convert_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[the_cmd] = (command_item) { .id = the_cmd, .lua = lua_key_index(the), .name = lua_key(the), .kind = regular_command_item, .min = 0, .max = last_the_code, .base = 0, .fixedvalue = 0 };
+ lmt_interface.command_names[get_mark_cmd] = (command_item) { .id = get_mark_cmd, .lua = lua_key_index(get_mark), .name = lua_key(get_mark), .kind = regular_command_item, .min = 0, .max = last_get_mark_code, .base = 0, .fixedvalue = 0 };
+ /* lmt_interface.command_names[string_cmd] = (command_item) { .id = string_cmd, .lua = lua_key_index(string), .name = lua_key(string), .kind = regular_command_item, .min = ignore_entry, .max = max_integer, .base = 0, .fixedvalue = 0 }; */
+ lmt_interface.command_names[call_cmd] = (command_item) { .id = call_cmd, .lua = lua_key_index(call), .name = lua_key(call), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[protected_call_cmd] = (command_item) { .id = protected_call_cmd, .lua = lua_key_index(protected_call), .name = lua_key(protected_call), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[semi_protected_call_cmd] = (command_item) { .id = semi_protected_call_cmd, .lua = lua_key_index(protected_call), .name = lua_key(protected_call), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[tolerant_call_cmd] = (command_item) { .id = tolerant_call_cmd, .lua = lua_key_index(tolerant_call), .name = lua_key(tolerant_call), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[tolerant_protected_call_cmd] = (command_item) { .id = tolerant_protected_call_cmd, .lua = lua_key_index(tolerant_protected_call), .name = lua_key(tolerant_protected_call), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[tolerant_semi_protected_call_cmd] = (command_item) { .id = tolerant_semi_protected_call_cmd, .lua = lua_key_index(tolerant_protected_call), .name = lua_key(tolerant_protected_call), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[deep_frozen_end_template_cmd] = (command_item) { .id = deep_frozen_end_template_cmd, .lua = lua_key_index(deep_frozen_cs_end_template), .name = lua_key(deep_frozen_cs_end_template), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[deep_frozen_dont_expand_cmd] = (command_item) { .id = deep_frozen_dont_expand_cmd, .lua = lua_key_index(deep_frozen_cs_dont_expand), .name = lua_key(deep_frozen_cs_dont_expand), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_glue_reference_cmd] = (command_item) { .id = internal_glue_reference_cmd, .lua = lua_key_index(internal_glue_reference), .name = lua_key(internal_glue_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_glue_reference_cmd] = (command_item) { .id = register_glue_reference_cmd, .lua = lua_key_index(register_glue_reference), .name = lua_key(register_glue_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_mu_glue_reference_cmd] = (command_item) { .id = internal_mu_glue_reference_cmd, .lua = lua_key_index(internal_mu_glue_reference), .name = lua_key(internal_mu_glue_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_mu_glue_reference_cmd] = (command_item) { .id = register_mu_glue_reference_cmd, .lua = lua_key_index(register_mu_glue_reference), .name = lua_key(register_mu_glue_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_box_reference_cmd] = (command_item) { .id = internal_box_reference_cmd, .lua = lua_key_index(specification_reference), .name = lua_key(specification_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_box_reference_cmd] = (command_item) { .id = register_box_reference_cmd, .lua = lua_key_index(internal_box_reference), .name = lua_key(internal_box_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_toks_reference_cmd] = (command_item) { .id = internal_toks_reference_cmd, .lua = lua_key_index(register_box_reference), .name = lua_key(register_box_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_toks_reference_cmd] = (command_item) { .id = register_toks_reference_cmd, .lua = lua_key_index(internal_toks_reference), .name = lua_key(internal_toks_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[specification_reference_cmd] = (command_item) { .id = specification_reference_cmd, .lua = lua_key_index(register_toks_reference), .name = lua_key(register_toks_reference), .kind = token_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_int_reference_cmd] = (command_item) { .id = internal_int_reference_cmd, .lua = lua_key_index(internal_int_reference), .name = lua_key(internal_int_reference), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_int_reference_cmd] = (command_item) { .id = register_int_reference_cmd, .lua = lua_key_index(register_int_reference), .name = lua_key(register_int_reference), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_attribute_reference_cmd] = (command_item) { .id = internal_attribute_reference_cmd, .lua = lua_key_index(internal_attribute_reference), .name = lua_key(internal_attribute_reference), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_attribute_reference_cmd] = (command_item) { .id = register_attribute_reference_cmd, .lua = lua_key_index(register_attribute_reference), .name = lua_key(register_attribute_reference), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[internal_dimen_reference_cmd] = (command_item) { .id = internal_dimen_reference_cmd, .lua = lua_key_index(internal_dimen_reference), .name = lua_key(internal_dimen_reference), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_dimen_reference_cmd] = (command_item) { .id = register_dimen_reference_cmd, .lua = lua_key_index(register_dimen_reference), .name = lua_key(register_dimen_reference), .kind = regular_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+ lmt_interface.command_names[register_dimen_reference_cmd + 1] = (command_item) { .id = unknown_value, .lua = 0, .name = NULL, .kind = unused_command_item, .min = ignore_entry, .max = ignore_entry, .base = ignore_entry, .fixedvalue = 0 };
+
+ if (lmt_interface.command_names[last_cmd].id != last_cmd) {
+ tex_fatal_error("mismatch between tex and lua command name tables");
+ }
+}
+
+typedef struct saved_tex_scanner {
+ int cmd;
+ int chr;
+ int cs;
+ int tok;
+} saved_tex_scanner;
+
+inline static saved_tex_scanner tokenlib_aux_save_tex_scanner(void) {
+ return (saved_tex_scanner) {
+ .cmd = cur_cmd,
+ .chr = cur_chr,
+ .cs = cur_cs,
+ .tok = cur_tok
+ };
+}
+
+inline static void tokenlib_aux_unsave_tex_scanner(saved_tex_scanner a)
+{
+ cur_cmd = a.cmd;
+ cur_chr = a.chr;
+ cur_cs = a.cs;
+ cur_tok = a.tok;
+}
+
+static int tokenlib_aux_get_command_id(const char *s)
+{
+ for (int i = 0; lmt_interface.command_names[i].id != -1; i++) {
+ if (s == lmt_interface.command_names[i].name) {
+ return i;
+ }
+ }
+ return -1;
+}
+
+/*tex
+ We have some checkers that use the information from |command_names|:
+
+ \startitemize
+ \startitem the 0..64K counter, dimen, token etc registers \stopitem
+ \startitem the predefined internal quantities \stopitem
+ \stopitemize
+*/
+
+/*
+inline static int tokenlib_valid_cmd(int cmd)
+{
+ return cmd >= first_cmd && cmd <= last_cmd;
+}
+*/
+
+inline static int tokenlib_aux_valid_chr(int cmd, int chr)
+{
+ command_item item = lmt_interface.command_names[cmd];
+ if (chr > 0) {
+ switch (item.base) {
+ case ignore_entry:
+ case direct_entry:
+ break;
+ default:
+ if (chr >= item.min && chr <= item.max) {
+ return item.base + chr;
+ }
+ }
+ } else if (chr == item.fixedvalue) {
+ return chr;
+ }
+ return 0;
+}
+
+inline static int tokenlib_aux_valid_cs(int cs)
+{
+ return (cs >= 0 && cs <= lmt_token_memory_state.tokens_data.allocated) ? cs : -1;
+}
+
+// not ok
+
+inline static int tokenlib_aux_valid_token(int cmd, int chr, int cs)
+{
+ if (cs) {
+ cs = tokenlib_aux_valid_cs(cs);
+ if (cs >= 0) {
+ return cs_token_flag + cs;
+ }
+ } if (cmd >= first_cmd && cmd <= last_cmd) {
+ chr = tokenlib_aux_valid_chr(cmd, chr);
+ if (chr >= 0) {
+ return token_val(cmd, chr);
+ }
+ }
+ return -1;
+}
+
+inline static int tokenlib_aux_to_valid_index(int cmd, int chr)
+{
+ if (cmd >= 0 && cmd <= last_cmd) {
+ command_item item = lmt_interface.command_names[cmd];
+ switch (item.kind) {
+ case unused_command_item:
+ return 0;
+ case regular_command_item:
+ case character_command_item:
+ return chr;
+ case register_command_item:
+ case internal_command_item:
+ case reference_command_item:
+ case data_command_item:
+ {
+ halfword c = chr;
+ switch (item.base) {
+ case ignore_entry:
+ return 0;
+ case direct_entry:
+ break;
+ default:
+ chr -= item.base;
+ break;
+ }
+ if (c >= item.min && c <= item.max) {
+ return c;
+ } else {
+ return item.min;
+ }
+ }
+ case token_command_item:
+ case node_command_item:
+ return item.fixedvalue;
+ }
+ }
+ return 0;
+}
+
+inline static void tokenlib_aux_make_token_table(lua_State *L, int cmd, int chr, int cs)
+{
+ lua_createtable(L, 3, 0);
+ lua_pushinteger(L, cmd);
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, tokenlib_aux_to_valid_index(cmd, chr)); /* index or value */
+ lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, cs);
+ lua_rawseti(L, -2, 3);
+}
+
+/*tex
+
+ Takes a table |{ cmd, chr, cs }| where either the first two are taken or the last one. This is
+ something historic. So we have either |{ cmd, chr, - }| or |{ -, -, cs}| to deal with. This
+ might change in the future but we then need to check all usage in \CONTEXT\ first.
+*/
+
+inline static int lmt_token_from_lua(lua_State *L)
+{
+ int cmd, chr, cs;
+ lua_rawgeti(L, -1, 1);
+ cmd = lmt_tointeger(L, -1);
+ lua_rawgeti(L, -2, 2);
+ chr = lmt_optinteger(L, -1, 0);
+ lua_rawgeti(L, -3, 3);
+ cs = lmt_optinteger(L, -1, 0);
+ lua_pop(L, 3);
+ return tokenlib_aux_valid_token(cmd, chr, cs); /* just the token value */
+}
+
+void lmt_token_list_to_lua(lua_State *L, halfword p)
+{
+ int i = 1;
+ int v = p;
+ int max = lmt_token_memory_state.tokens_data.top; /*tex It doesn't change here. */
+ while (v && v < max) {
+ i++;
+ v = token_link(v);
+ }
+ lua_createtable(L, i, 0);
+ i = 1;
+ while (p && p < max) {
+ int cmd, chr, cs;
+ if (token_info(p) >= cs_token_flag) {
+ cs = token_info(p) - cs_token_flag;
+ cmd = eq_type(cs);
+ chr = eq_value(cs);
+ } else {
+ cs = 0;
+ cmd = token_cmd(token_info(p));
+ chr = token_chr(token_info(p));
+ }
+ tokenlib_aux_make_token_table(L, cmd, chr, cs);
+ lua_rawseti(L, -2, i++);
+ p = token_link(p);
+ }
+}
+
+void lmt_token_list_to_luastring(lua_State *L, halfword p, int nospace, int strip)
+{
+ int l;
+ char *s = tex_tokenlist_to_tstring(p, 1, &l, 0, nospace, strip); /* nasty ... preambles or not, could have been endmatchtoken */
+ if (l) {
+ lua_pushlstring(L, s, (size_t) l);
+ } else {
+ lua_pushliteral(L, "");
+ }
+}
+
+static lua_token *tokenlib_aux_check_istoken(lua_State *L, int ud);
+
+halfword lmt_token_list_from_lua(lua_State *L, int slot)
+{
+ halfword h = tex_get_available_token(null);
+ halfword p = h;
+ token_link(h) = null;
+ switch (lua_type(L, slot)) {
+ case LUA_TTABLE:
+ {
+ int j = (int) lua_rawlen(L, slot);
+ if (j > 0) {
+ for (int i = 1; i <= j; i++) {
+ int tok;
+ lua_rawgeti(L, slot, (int) i);
+ tok = lmt_token_from_lua(L);
+ if (tok >= 0) {
+ p = tex_store_new_token(p, tok);
+ }
+ lua_pop(L, 1);
+ };
+ }
+ return h;
+ }
+ case LUA_TSTRING:
+ {
+ size_t j;
+ const char *s = lua_tolstring(L, slot, &j);
+ for (size_t i = 0; i < j; i++) {
+ int tok;
+ if (s[i] == ascii_space) {
+ tok = token_val(spacer_cmd, s[i]);
+ } else {
+ int k = (int) aux_str2uni((const unsigned char *) (s + i));
+ i = i + (size_t) (utf8_size(k)) - 1;
+ tok = token_val(other_char_cmd, k);
+ }
+ p = tex_store_new_token(p, tok);
+ }
+ return h;
+ }
+ case LUA_TUSERDATA:
+ {
+ lua_token *t = tokenlib_aux_check_istoken(L, slot);
+ p = tex_store_new_token(p, t->token);
+ return h;
+ }
+ default:
+ {
+ tex_put_available_token(h);
+ return null;
+ }
+ }
+}
+
+halfword lmt_token_code_from_lua(lua_State *L, int slot)
+{
+ lua_token *t = tokenlib_aux_check_istoken(L, slot);
+ return t->token;
+}
+
+# define DEFAULT_SCAN_CODE_SET (2048 + 4096) /*tex default: letter and other */
+
+/*tex two core helpers .. todo: combine active*/
+
+# define is_active_string(s) (strlen(s) > 3 && *s == 0xEF && *(s+1) == 0xBF && *(s+2) == 0xBF)
+
+static unsigned char *tokenlib_aux_get_cs_text(int cs)
+{
+ if (cs == null_cs) {
+ return (unsigned char *) lmt_memory_strdup("\\csname\\endcsname");
+ } else if ((cs_text(cs) < 0) || (cs_text(cs) >= lmt_string_pool_state.string_pool_data.ptr)) {
+ return (unsigned char *) lmt_memory_strdup("");
+ } else if (tex_is_active_cs(cs_text(cs))) {
+ return (unsigned char *) tex_makecstring(cs_text(cs));
+ } else {
+ return (unsigned char *) tex_makecstring(cs_text(cs));
+ }
+}
+
+static lua_token *tokenlib_aux_maybe_istoken(lua_State *L, int ud)
+{
+ lua_token *t = lua_touserdata(L, ud);
+ if (t && lua_getmetatable(L, ud)) {
+ lua_get_metatablelua(token_instance);
+ if (! lua_rawequal(L, -1, -2)) {
+ t = NULL;
+ }
+ lua_pop(L, 2);
+ }
+ return t;
+}
+
+static lua_token_package *tokenlib_aux_maybe_ispackage(lua_State *L, int ud)
+{
+ lua_token_package *t = lua_touserdata(L, ud);
+ if (t && lua_getmetatable(L, ud)) {
+ lua_get_metatablelua(token_package);
+ if (! lua_rawequal(L, -1, -2)) {
+ t = NULL;
+ }
+ lua_pop(L, 2);
+ }
+ return t;
+}
+
+/*tex we could make the message a function and just inline the rest (via a macro) */
+
+lua_token *tokenlib_aux_check_istoken(lua_State *L, int ud)
+{
+ lua_token *t = tokenlib_aux_maybe_istoken(L, ud);
+ if (! t) {
+ tex_formatted_error("token lib", "lua <token> expected, not an object with type %s", luaL_typename(L, ud));
+ }
+ return t;
+}
+
+static lua_token_package *tokenlib_aux_check_ispackage(lua_State *L, int ud)
+{
+ lua_token_package *t = tokenlib_aux_maybe_ispackage(L, ud);
+ if (! t) {
+ tex_formatted_error("token lib", "lua <token package> expected, not an object with type %s", luaL_typename(L, ud));
+ }
+ return t;
+}
+
+/*tex token library functions */
+
+static void tokenlib_aux_make_new_token(lua_State *L, int cmd, int chr, int cs)
+{
+ int tok = tokenlib_aux_valid_token(cmd, chr, cs);
+ if (tok >= 0) {
+ lua_token *thetok = (lua_token *) lua_newuserdatauv(L, sizeof(lua_token), 0);
+ thetok->token = tex_get_available_token(tok);
+ thetok->origin = token_origin_lua;
+ lua_get_metatablelua(token_instance);
+ lua_setmetatable(L, -2);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static void tokenlib_aux_make_new_token_tok(lua_State *L, int tok)
+{
+ if (tok >= 0) {
+ lua_token *thetok = (lua_token *) lua_newuserdatauv(L, sizeof(lua_token), 0);
+ thetok->token = tex_get_available_token(tok);
+ thetok->origin = token_origin_lua;
+ lua_get_metatablelua(token_instance);
+ lua_setmetatable(L, -2);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+static void tokenlib_aux_make_new_package(lua_State *L, singleword cmd, singleword flag, int chr, int cs, quarterword how)
+{
+ lua_token_package *package = (lua_token_package *) lua_newuserdatauv(L, sizeof(lua_token_package), 0);
+ package->cmd = cmd;
+ package->flag = flag;
+ package->chr = chr;
+ package->cs = cs;
+ package->how = how;
+ lua_get_metatablelua(token_package);
+ lua_setmetatable(L, -2);
+}
+
+static void tokenlib_aux_push_token(lua_State *L, int tok)
+{
+ lua_token *thetok = (lua_token *) lua_newuserdatauv(L, sizeof(lua_token), 0);
+ thetok->token = tok;
+ thetok->origin = token_origin_lua;
+ lua_get_metatablelua(token_instance);
+ lua_setmetatable(L, -2);
+}
+
+static int tokenlib_getcommandid(lua_State *L)
+{
+ int id = -1;
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ id = tokenlib_aux_get_command_id(lua_tostring(L, 1));
+ break;
+ case LUA_TNUMBER:
+ id = lmt_tointeger(L, 1);
+ break;
+ }
+ if (id >= 0 && id < number_glue_pars) {
+ lua_pushinteger(L, id);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int tokenlib_scan_next(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ halfword tok = tex_get_token();
+ tokenlib_aux_make_new_token_tok(L, tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_next_expanded(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ halfword tok = tex_get_x_token();
+ tokenlib_aux_make_new_token_tok(L, tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_skip_next(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ (void) L;
+ tex_get_token();
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 0;
+}
+
+static int tokenlib_skip_next_expanded(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ (void) L;
+ tex_get_x_token();
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 0;
+}
+
+/*tex
+
+ This is experimental code:
+
+ \starttyping
+ local t1 = token.get_next()
+ local t2 = token.get_next()
+ local t3 = token.get_next()
+ local t4 = token.get_next()
+ -- watch out, we flush in sequence
+ token.put_next { t1, t2 }
+ -- but this one gets pushed in front
+ token.put_next ( t3, t4 )
+ -- so when we get wxyz we put yzwx!
+ \stoptyping
+
+ At some point we can consider a token.print that delays and goes via the same rope mechanism as
+ |texio.print| and friends but then one can as well serialize the tokens and do a normal print so
+ there is no real gain in it. After all, the tokenlib operates at the input level so we might as
+ well keep it there.
+
+*/
+
+inline static int tokenlib_aux_to_token_val(int chr)
+{
+ switch (chr) {
+ case '\n':
+ case '\r':
+ case ' ':
+ return token_val(spacer_cmd, ' ');
+ default:
+ {
+ int cmd = tex_get_cat_code(cat_code_table_par, chr);
+ switch (cmd) {
+ case escape_cmd:
+ case ignore_cmd:
+ case comment_cmd:
+ case invalid_char_cmd:
+ case active_char_cmd:
+ cmd = other_char_cmd;
+ break;
+ }
+ return token_val(cmd, chr);
+ }
+ }
+}
+
+/*tex
+ The original implementation was a bit different in the sense that I distinguished between one or
+ more arguments with the one argument case handling a table. The reason was that I considered
+ having an optional second argument that could control the catcode table.
+
+ In the end this function is not used that often (of at all), so after checking the manual, I
+ decided not to provide that feature so the code could be simplified a bit. But, as compensation,
+ nested tables became possible.
+*/
+
+static void tokenlib_aux_to_token(lua_State *L, int i, int m, int *head, int *tail)
+{
+ switch (lua_type(L, i)) {
+ case LUA_TSTRING:
+ /*tex More efficient is to iterate (but then we also need to know the length). */
+ {
+ size_t l = 0;
+ const char *s = lua_tolstring(L, i, &l);
+ const unsigned char *p = (const unsigned char *) s;
+ size_t n = aux_utf8len(s, l);
+ for (size_t j = 0; j < n; j++) {
+ int ch = *p;
+ halfword x = tex_get_available_token(tokenlib_aux_to_token_val(aux_str2uni(p)));
+ if (*head) {
+ token_link(*tail) = x;
+ } else {
+ *head = x;
+ }
+ *tail = x;
+ p += utf8_size(ch);
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ {
+ halfword t = tex_get_available_token(tokenlib_aux_to_token_val((int) lua_tointeger(L, i)));
+ if (*head) {
+ token_link(*tail) = t;
+ } else {
+ *head = t;
+ }
+ *tail = t;
+ break;
+ }
+ case LUA_TTABLE:
+ {
+ size_t n = lua_rawlen(L, i);
+ for (size_t j = 1; j <= n; j++) {
+ lua_rawgeti(L, i, j);
+ tokenlib_aux_to_token(L, -1, m, head, tail);
+ lua_pop(L, 1);
+ }
+ break;
+ }
+ case LUA_TUSERDATA:
+ {
+ /* todo: like nodelib: |maybe_is_token|. */
+ lua_token *p = lua_touserdata(L, i);
+ halfword t, q;
+ if (p && lua_getmetatable(L, i)) {
+ t = lua_rawequal(L, m, -1) ? token_info(p->token) : tokenlib_aux_to_token_val(0xFFFD);
+ lua_pop(L, 1); /* The metatable. */
+ } else {
+ t = tokenlib_aux_to_token_val(0xFFFD);
+ }
+ q = tex_get_available_token(t);
+ if (*head) {
+ token_link(*tail) = q;
+ } else {
+ *head = q;
+ }
+ *tail = q;
+ break;
+ }
+ default:
+ /*tex Just ignore it. */
+ break;
+ }
+}
+
+inline static int tokenlib_put_next(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top > 0) {
+ halfword h = null;
+ halfword t = null;
+ int m = top + 1;
+ lua_get_metatablelua(token_instance);
+ for (int i = 1; i <= top; i++) {
+ tokenlib_aux_to_token(L, i, m, &h, &t);
+ }
+ if (h) {
+ tex_begin_inserted_list(h);
+ }
+ lua_settop(L, top);
+ }
+ return 0;
+}
+
+inline static int tokenlib_put_back(lua_State *L)
+{
+ lua_token *t = tokenlib_aux_check_istoken(L, 1);
+ if (t) {
+ tex_back_input(token_info(t->token));
+ }
+ return 0;
+}
+
+static int tokenlib_scan_keyword(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ int v = 0;
+ if (s) {
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ v = tex_scan_keyword(s);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ }
+ lua_pushboolean(L, v);
+ return 1;
+}
+
+static int tokenlib_scan_keyword_cs(lua_State *L)
+{
+ const char *s = lua_tostring(L, 1);
+ int v = 0;
+ if (s) {
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ v = tex_scan_keyword_case_sensitive(s);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ }
+ lua_pushboolean(L, v);
+ return 1;
+}
+
+static int tokenlib_scan_csname(lua_State *L)
+{
+ int t;
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ if (lua_toboolean(L, 1)) {
+ /*tex unchecked (maybe backport this option to luatex) */
+ do {
+ tex_get_token();
+ } while (cur_tok == space_token);
+ } else {
+ /*tex checked */
+ tex_get_next();
+ }
+ t = cur_cs ? cs_token_flag + cur_cs : token_val (cur_cmd, cur_chr);
+ if (t >= cs_token_flag) {
+ unsigned char *s = tokenlib_aux_get_cs_text(t - cs_token_flag);
+ if (s) {
+ if (tex_is_active_cs(cs_text(t - cs_token_flag))) {
+ lua_pushstring(L, (char *) (s + 3));
+ } else {
+ lua_pushstring(L, (char *) s);
+ }
+ lmt_memory_free(s);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_integer(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int eq = lua_toboolean(L, 1);
+ halfword v = tex_scan_int(eq, NULL);
+ lua_pushinteger(L, (int) v);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_cardinal(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ unsigned int v = 0;
+ tex_scan_cardinal(&v, 0);
+ lua_pushinteger(L, (unsigned int) v);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_gobble_integer(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int eq = lua_toboolean(L, 1);
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ tex_scan_int(eq, NULL);
+ lua_pushboolean(L, ! lmt_error_state.last_intercept);
+ lmt_error_state.intercept = 0;
+ lmt_error_state.last_intercept = 0;
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+inline static void tokenlib_aux_goto_first_candidate(void)
+{
+ do {
+ tex_get_token();
+ } while (cur_cmd == spacer_cmd);
+}
+
+inline static void tokenlib_aux_goto_first_candidate_x(void)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+}
+
+inline static void tokenlib_aux_add_utf_char_to_buffer(luaL_Buffer *b, halfword chr)
+{
+ if (chr <= ascii_max) {
+ luaL_addchar(b, (unsigned char) chr);
+ } else {
+ /*
+ unsigned char word[5 + 1];
+ char *uindex = aux_uni2string((char *) word, (unsigned int) chr);
+ *uindex = '\0';
+ luaL_addstring(b, (char *) word);
+ */
+ unsigned char word[5 + 1];
+ aux_uni2string((char *) word, (unsigned int) chr);
+ luaL_addlstring(b, (char *) word, utf8_size(chr));
+ }
+}
+
+/*tex
+ We could of course work with sets or ranges but the bit of duplicate code doesn't harm that
+ much. The hexadecimal variant also deals with \LUA\ serialized numbers like |123.345E67| being
+ equivalent to |0x1.6e0276db950fp+229| (as output by the |q| formatter option).
+
+ Nota Bene: |DECIMAL| can be defined as macro or whatever else; the ms compiler reports an error,
+ so we use |SCANDECIMAL| instead.
+*/
+
+static int tokenlib_scan_float_indeed(lua_State *L, int exponent, int hexadecimal)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int negative = 0;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ tokenlib_aux_goto_first_candidate_x();
+ if (lua_toboolean(L, 1) && (cur_tok == equal_token)) {
+ tokenlib_aux_goto_first_candidate_x();
+ }
+ /*tex we collapse as in |scan_dimen| */
+ while(1) {
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ } else if (cur_tok != plus_token) {
+ break;
+ }
+ tokenlib_aux_goto_first_candidate_x();
+ }
+ if (negative) {
+ luaL_addchar(&b, '-');
+ }
+ /*tex we accept |[.,]digits| */
+ if (hexadecimal && (cur_tok == zero_token)) {
+ luaL_addchar(&b, '0');
+ tex_get_x_token();
+ if (tex_token_is_hexadecimal(cur_tok)) {
+ luaL_addchar(&b, 'x');
+ goto SCANHEXADECIMAL;
+ } else {
+ goto PICKUPDECIMAL;
+ }
+ } else {
+ goto SCANDECIMAL;
+ }
+ SCANDECIMAL:
+ if (tex_token_is_seperator(cur_tok)) {
+ luaL_addchar(&b, '.');
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_digit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else if (exponent) {
+ goto DECIMALEXPONENT;
+ } else {
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ }
+ } else {
+ goto PICKUPDECIMAL;
+ }
+ while (1) {
+ tex_get_x_token();
+ PICKUPDECIMAL:
+ if (tex_token_is_digit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else if (tex_token_is_seperator(cur_tok)) {
+ luaL_addchar(&b, '.');
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_digit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else {
+ tex_back_input(cur_tok);
+ break;
+ }
+ }
+ } else if (exponent) {
+ goto DECIMALEXPONENT;
+ } else {
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ }
+ DECIMALEXPONENT:
+ if (tex_token_is_exponent(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ tex_get_x_token();
+ if (tex_token_is_sign(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else if (tex_token_is_digit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ }
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_digit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else {
+ break;
+ }
+ }
+ }
+ tex_back_input(cur_tok);
+ goto DONE;
+ SCANHEXADECIMAL:
+ tex_get_x_token();
+ if (tex_token_is_seperator(cur_tok)) {
+ luaL_addchar(&b, '.');
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_xdigit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else if (exponent) {
+ goto HEXADECIMALEXPONENT;
+ } else {
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ }
+ } else {
+ /* hm, we could avoid this pushback */
+ tex_back_input(cur_tok);
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_xdigit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else if (tex_token_is_seperator(cur_tok)) {
+ luaL_addchar(&b, '.');
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_xdigit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else {
+ tex_back_input(cur_tok);
+ break;
+ }
+ }
+ } else if (exponent) {
+ goto HEXADECIMALEXPONENT;
+ } else {
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ }
+ }
+ HEXADECIMALEXPONENT:
+ if (tex_token_is_xexponent(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ tex_get_x_token();
+ if (tex_token_is_sign(cur_tok)) {
+ /*
+ tex_normal_warning("scanner", "no negative hexadecimal exponent permitted, ignoring minus sign");
+ */
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else if (tex_token_is_xdigit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ }
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_xdigit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else {
+ break;
+ }
+ }
+ }
+ tex_back_input(cur_tok);
+ DONE:
+ luaL_pushresult(&b);
+ {
+ int ok = 0;
+ double d = lua_tonumberx(L, -1, &ok);
+ if (ok) {
+ lua_pushnumber(L, d);
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_integer_indeed(lua_State *L, int cardinal)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int negative = 0;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ tokenlib_aux_goto_first_candidate_x();
+ if (lua_toboolean(L, 1) && (cur_tok == equal_token)) {
+ tokenlib_aux_goto_first_candidate_x();
+ }
+ /*tex we collapse as in |scan_dimen| */
+ if (! cardinal) {
+ while(1) {
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ } else if (cur_tok != plus_token) {
+ break;
+ }
+ tokenlib_aux_goto_first_candidate_x();
+ }
+ if (negative) {
+ luaL_addchar(&b, '-');
+ }
+ } else if (cur_tok == minus_token) {
+ tex_normal_warning("scanner", "positive number expected, ignoring minus sign");
+ tokenlib_aux_goto_first_candidate_x();
+ }
+ if (cur_tok == zero_token) {
+ luaL_addchar(&b, '0');
+ tex_get_x_token();
+ if (tex_token_is_hexadecimal(cur_tok)) {
+ luaL_addchar(&b, 'x');
+ goto HEXADECIMAL;
+ } else {
+ goto PICKUPDECIMAL;
+ }
+ } else {
+ goto PICKUPDECIMAL;
+ }
+ while (1) {
+ tex_get_x_token();
+ PICKUPDECIMAL:
+ if (tex_token_is_digit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else {
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ }
+ HEXADECIMAL:
+ while (1) {
+ tex_get_x_token();
+ if (tex_token_is_xdigit(cur_tok)) {
+ luaL_addchar(&b, (unsigned char) cur_chr);
+ } else {
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ }
+ DONE:
+ luaL_pushresult(&b);
+ if (cardinal) {
+ int ok = 0;
+ lua_Unsigned c = lua_tointegerx(L, -1, &ok);
+ if (ok) {
+ lua_pushinteger(L, c);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ int ok = 0;
+ lua_Integer i = lua_tointegerx(L, -1, &ok);
+ if (ok) {
+ lua_pushinteger(L, i);
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_float(lua_State *L)
+{
+ return tokenlib_scan_float_indeed(L, 1, 0);
+}
+
+static int tokenlib_scan_real(lua_State *L)
+{
+ return tokenlib_scan_float_indeed(L, 0, 0);
+}
+
+static int tokenlib_scan_luanumber(lua_State* L)
+{
+ return tokenlib_scan_float_indeed(L, 1, 1);
+}
+
+static int tokenlib_scan_luainteger(lua_State* L)
+{
+ return tokenlib_scan_integer_indeed(L, 0);
+}
+
+static int tokenlib_scan_luacardinal(lua_State* L)
+{
+ return tokenlib_scan_integer_indeed(L, 1);
+}
+
+static int tokenlib_scan_scale(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int eq = lua_toboolean(L, 1);
+ halfword val = tex_scan_scale(eq);
+ lua_pushinteger(L, val);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_dimen(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int inf = lua_toboolean(L, 1);
+ int mu = lua_toboolean(L, 2);
+ int eq = lua_toboolean(L, 3);
+ halfword order;
+ halfword val = tex_scan_dimen(mu, inf, 0, eq, &order);
+ lua_pushinteger(L, val);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ if (inf) {
+ lua_pushinteger(L, order);
+ return 2;
+ } else {
+ return 1;
+ }
+}
+
+static int tokenlib_gobble_dimen(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int inf = lua_toboolean(L, 1);
+ int mu = lua_toboolean(L, 2);
+ int eq = lua_toboolean(L, 3);
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ tex_scan_dimen(mu, inf, 0, eq, NULL);
+ lua_pushboolean(L, ! lmt_error_state.last_intercept);
+ lmt_error_state.intercept = 0;
+ lmt_error_state.last_intercept = 0;
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_skip(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int mu = lua_toboolean(L, 1) ? mu_val_level : glue_val_level;
+ int eq = lua_toboolean(L, 2);
+ halfword v = tex_scan_glue(mu, eq);
+ lmt_push_node_fast(L, v);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_glue(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int mu = lua_toboolean(L, 1) ? mu_val_level : glue_val_level;
+ int eq = lua_toboolean(L, 2);
+ int t = lua_toboolean(L, 3);
+ halfword v = tex_scan_glue(mu, eq);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ if (t) {
+ lua_createtable(L, 5, 0);
+ lua_pushinteger(L, glue_amount(v));
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, glue_stretch(v));
+ lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, glue_shrink(v));
+ lua_rawseti(L, -2, 3);
+ lua_pushinteger(L, glue_stretch_order(v));
+ lua_rawseti(L, -2, 4);
+ lua_pushinteger(L, glue_shrink_order(v));
+ lua_rawseti(L, -2, 5);
+ return 1;
+ } else {
+ lua_pushinteger(L, glue_amount(v));
+ lua_pushinteger(L, glue_stretch(v));
+ lua_pushinteger(L, glue_shrink(v));
+ lua_pushinteger(L, glue_stretch_order(v));
+ lua_pushinteger(L, glue_shrink_order(v));
+ return 5;
+ }
+}
+
+inline static void lmt_token_list_to_lua_tokens(lua_State *L, halfword t)
+{
+ int i = 1;
+ lua_newtable(L);
+ while (t) {
+ halfword n = token_link(t);
+ token_link(t) = null;
+ tokenlib_aux_push_token(L, t);
+ lua_rawseti(L, -2, i++);
+ t = n;
+ }
+}
+
+void lmt_token_register_to_lua(lua_State *L, halfword t)
+{
+ int i = 1;
+ lua_newtable(L);
+ if (t) {
+ t = token_link(t);
+ while (t) {
+ halfword m = tex_get_available_token(token_info(t));
+ tokenlib_aux_push_token(L, m);
+ lua_rawseti(L, -2, i++);
+ t = token_link(t);
+ }
+ }
+}
+
+static int tokenlib_scan_toks(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int macro = lua_toboolean(L, 1);
+ int expand = lua_toboolean(L, 2);
+ halfword defref = lmt_input_state.def_ref;
+ halfword result, t;
+ if (macro) {
+ result = expand ? tex_scan_macro_expand() : tex_scan_macro_normal();
+ } else {
+ result = expand ? tex_scan_toks_expand(0, NULL, 0) : tex_scan_toks_normal(0, NULL);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ lmt_input_state.def_ref = defref;
+ t = token_link(result);
+ token_link(result) = null;
+ tex_put_available_token(result);
+ lmt_token_list_to_lua_tokens(L, t);
+ return 1;
+}
+
+static int tokenlib_scan_tokenlist(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int macro = lua_toboolean(L, 1);
+ int expand = lua_toboolean(L, 2);
+ halfword result;
+ halfword defref = lmt_input_state.def_ref;
+ if (macro) {
+ result = expand ? tex_scan_macro_expand() : tex_scan_macro_normal();
+ } else {
+ result = expand ? tex_scan_toks_expand(0, NULL, 0) : tex_scan_toks_normal(0, NULL);
+ }
+ tokenlib_aux_push_token(L, result);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ lmt_input_state.def_ref = defref;
+ return 1;
+}
+
+/* todo: other call_cmd */
+
+static int tokenlib_scan_string(lua_State *L)
+{
+ /*tex can be simplified, no need for intermediate list */
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate_x(); /* actually this expands a following macro*/
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ {
+ halfword defref = lmt_input_state.def_ref;
+ halfword result = tex_scan_toks_expand(1, NULL, 0);
+ lmt_token_list_to_luastring(L, result, 0, 0);
+ tex_flush_token_list(result);
+ lmt_input_state.def_ref = defref;
+ break;
+ }
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ {
+ halfword t = token_link(cur_chr);
+ lmt_token_list_to_luastring(L, t, 0, 0);
+ tex_flush_token_list(t);
+ break;
+ }
+ case letter_cmd:
+ case other_char_cmd:
+ {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while (1) {
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ tex_get_x_token();
+ if (cur_cmd != letter_cmd && cur_cmd != other_char_cmd ) {
+ break ;
+ }
+ }
+ tex_back_input(cur_tok);
+ luaL_pushresult(&b);
+ break;
+ }
+ default:
+ {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ break;
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_argument(lua_State *L)
+{
+ /*tex can be simplified, no need for intermediate list */
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate();
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ {
+ halfword defref = lmt_input_state.def_ref;
+ int expand = lua_type(L, 1) == LUA_TBOOLEAN ? lua_toboolean(L, 1) : 1;
+ halfword result = expand ? tex_scan_toks_expand(1, NULL, 0) : tex_scan_toks_normal(1, NULL);
+ lmt_token_list_to_luastring(L, result, 0, 0);
+ tex_flush_token_list(result);
+ lmt_input_state.def_ref = defref;
+ break;
+ }
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ {
+ halfword result;
+ halfword defref = lmt_input_state.def_ref;
+ tex_back_input(right_brace_token + '}');
+ if (lua_type(L, 1) == LUA_TBOOLEAN && ! lua_toboolean(L, 1)) {
+ tex_expand_current_token();
+ result = tex_scan_toks_normal(1, NULL);
+ } else {
+ tex_back_input(cur_tok);
+ result = tex_scan_toks_expand(1, NULL, 0);
+ }
+ lmt_token_list_to_luastring(L, result, 0, 0);
+ tex_flush_token_list(result);
+ lmt_input_state.def_ref = defref;
+ break;
+ }
+ case letter_cmd:
+ case other_char_cmd:
+ {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ // while (1) {
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ // get_x_token();
+ // if (cur_cmd != letter_cmd && cur_cmd != other_char_cmd ) {
+ // break ;
+ // }
+ // }
+ // back_input(cur_tok);
+ luaL_pushresult(&b);
+ break;
+ }
+ default:
+ {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ break;
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static void show_right_brace_error(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Unbalanced value parsing (in Lua call)",
+ "A { has to be matched by a }."
+ );
+}
+
+static int tokenlib_scan_integer_argument(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int wrapped = 0;
+ tokenlib_aux_goto_first_candidate();
+ if (cur_cmd != left_brace_cmd) {
+ tex_back_input(cur_tok);
+ } else {
+ wrapped = 1;
+ }
+ lua_pushinteger(L, (int) tex_scan_int(0, NULL));
+ if (wrapped) {
+ tokenlib_aux_goto_first_candidate();
+ if (cur_cmd != right_brace_cmd) {
+ show_right_brace_error();
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_dimen_argument(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int wrapped = 0;
+ halfword order = 0;
+ int inf = lua_toboolean(L, 1);
+ int mu = lua_toboolean(L, 2);
+ int eq = lua_toboolean(L, 3);
+ tokenlib_aux_goto_first_candidate();
+ if (cur_cmd != left_brace_cmd) {
+ tex_back_input(cur_tok);
+ } else {
+ wrapped = 1;
+ }
+ lua_pushinteger(L, tex_scan_dimen(mu, inf, 0, eq, &order));
+ if (wrapped) {
+ tokenlib_aux_goto_first_candidate();
+ if (cur_cmd != right_brace_cmd) {
+ show_right_brace_error();
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ if (inf) {
+ lua_pushinteger(L, order);
+ return 2;
+ } else {
+ return 1;
+ }
+}
+
+static int tokenlib_scan_delimited(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ halfword left = lua_type(L, 1) == LUA_TNUMBER ? lmt_tohalfword(L, 1) : 0;
+ halfword right = lua_type(L, 2) == LUA_TNUMBER ? lmt_tohalfword(L, 2) : 0;
+ int expand = (lua_type(L, 3) == LUA_TBOOLEAN) ? expand = lua_toboolean(L, 3) : 1;
+ /* Maybe some more? */
+ if (left) {
+ left = token_val(left == 32 ? spacer_cmd : other_char_cmd, left);
+ }
+ if (right) {
+ right = token_val(right == 32 ? spacer_cmd : other_char_cmd, right);
+ } else {
+ /* actually an error as we now get a runaway argument */
+ }
+ if (expand) {
+ tokenlib_aux_goto_first_candidate_x();
+ } else {
+ tokenlib_aux_goto_first_candidate();
+ }
+ if (! left || cur_tok == left) {
+ halfword defref = lmt_input_state.def_ref;
+ halfword result = get_reference_token();
+ halfword unbalance = 0;
+ halfword p = result;
+ lmt_input_state.def_ref = result;
+ /* */
+ if (expand) {
+ /* like scan_toks_expand, maybe use |get_x_or_protected|. */
+ if (! left) {
+ goto INITIAL1; /* ugly but saved a |back_input| */
+ }
+ while (1) {
+ PICKUP:
+ tex_get_next();
+ INITIAL1:
+ switch (cur_cmd) {
+ case call_cmd:
+ case tolerant_call_cmd:
+ tex_expand_current_token();
+ goto PICKUP;
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ cur_tok = cs_token_flag + cur_cs;
+ goto APPENDTOKEN;
+ case the_cmd:
+ {
+ halfword t = null;
+ halfword h = tex_the_toks(cur_chr, &t);
+ if (h) {
+ set_token_link(p, h);
+ p = t;
+ }
+ goto PICKUP;
+ }
+ default:
+ if (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ goto PICKUP;
+ } else {
+ goto DONEEXPANDING;
+ }
+ }
+ DONEEXPANDING:
+ tex_x_token();
+ if (cur_tok == right) {
+ break;
+ } else if (cur_tok < right_brace_limit) {
+ /* if (cur_cmd < right_brace_cmd) { */
+ if (cur_cmd == left_brace_cmd || cur_cmd == relax_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ goto FINALYDONE;
+ }
+ }
+ APPENDTOKEN:
+ p = tex_store_new_token(p, cur_tok);
+ }
+ } else {
+ /* like scan_toks_normal */
+ if (! left) {
+ goto INITIAL2; /* ugly but saved a |back_input| */
+ }
+ while (1) {
+ tex_get_token();
+ INITIAL2:
+ if (cur_tok == right) {
+ break;
+ } else if (cur_tok < right_brace_limit) {
+ /* if (cur_cmd < right_brace_cmd) { */
+ if (cur_cmd == left_brace_cmd || cur_cmd == relax_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ break;
+ }
+ }
+ p = tex_store_new_token(p, cur_tok);
+ }
+ }
+ FINALYDONE:
+ /* */
+ lmt_input_state.def_ref = defref;
+ lmt_token_list_to_luastring(L, result, 0, 0);
+ tex_flush_token_list(result);
+ } else {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_gobble_until(lua_State *L) /* not ok because we can have different cs's */
+{
+ lua_token *left = tokenlib_aux_check_istoken(L, 1);
+ lua_token *right = tokenlib_aux_check_istoken(L, 2);
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ int level = 1;
+ int l = token_info(left->token);
+ int r = token_info(right->token);
+ int cmd, chr, lcmd, lchr, rcmd, rchr;
+ if (l >= cs_token_flag) {
+ lcmd = eq_type(l - cs_token_flag);
+ lchr = eq_value(l - cs_token_flag);
+ } else {
+ lcmd = token_cmd(l);
+ lchr = token_chr(l);
+ }
+ if (r >= cs_token_flag) {
+ rcmd = eq_type(r - cs_token_flag);
+ rchr = eq_value(r - cs_token_flag);
+ } else {
+ rcmd = token_cmd(l);
+ rchr = token_chr(l);
+ }
+ while (1) {
+ tex_get_token();
+ if (cur_tok >= cs_token_flag) {
+ cmd = eq_type(cur_cs);
+ chr = eq_value(cur_cs);
+ } else {
+ cmd = cur_cmd;
+ chr = cur_chr;
+ }
+ if (cmd == lcmd && chr == lchr) {
+ ++level;
+ } else if (cmd == rcmd && chr == rchr) {
+ --level;
+ if (level == 0) {
+ break;
+ }
+ }
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 0;
+}
+
+/* only csnames, todo: no need for a token list .. make a direct tostring */
+
+static int tokenlib_grab_until(lua_State *L)
+{
+ lua_token *left = tokenlib_aux_check_istoken(L, 1);
+ lua_token *right = tokenlib_aux_check_istoken(L, 2);
+ int l = token_info(left->token);
+ int r = token_info(right->token);
+ int lstr = 0;
+ int rstr = 0;
+ if (l >= cs_token_flag) {
+ lstr = cs_text(l - cs_token_flag);
+ }
+ if (r >= cs_token_flag) {
+ rstr = cs_text(r - cs_token_flag);
+ }
+ if (lstr && rstr) {
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ halfword defref = lmt_input_state.def_ref;
+ halfword result = get_reference_token();
+ halfword p = result;
+ int level = 1;
+ int nospace = lua_toboolean(L, 3);
+ int strip = lmt_optinteger(L, 4, -1);
+ while (1) {
+ tex_get_token();
+ if (cur_tok >= cs_token_flag) {
+ int str = cs_text(cur_tok - cs_token_flag);
+ if (str == lstr) {
+ ++level;
+ } else if (str == rstr) {
+ --level;
+ if (level == 0) {
+ break;
+ }
+ }
+ }
+ p = tex_store_new_token(p, cur_tok);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ lmt_input_state.def_ref = defref;
+ lmt_token_list_to_luastring(L, result, nospace, strip);
+ tex_flush_token_list(result);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int tokenlib_scan_word(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate_x();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while (1) {
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ tex_get_x_token();
+ if (cur_cmd != letter_cmd && cur_cmd != other_char_cmd) {
+ break;
+ }
+ }
+ if (! (lua_toboolean(L, 1) && ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd)))) {
+ tex_back_input(cur_tok);
+ }
+ luaL_pushresult(&b);
+ } else {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_letters(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate_x();
+ if (cur_cmd == letter_cmd) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while (1) {
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ tex_get_x_token();
+ if (cur_cmd != letter_cmd) {
+ break ;
+ }
+ }
+ if (! (lua_toboolean(L, 1) && ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd)))) {
+ tex_back_input(cur_tok);
+ }
+ luaL_pushresult(&b);
+ } else {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_char(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate(); /* no expansion */ /* optional expansion ? */ /* gobbles spaces */
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ int c = lmt_tointeger(L, 1);
+ if (c == cur_chr) {
+ lua_pushboolean(L, 1);
+ } else {
+ lua_pushboolean(L, 0);
+ tex_back_input(cur_tok);
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ tex_back_input(cur_tok);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_next_char(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ const char mapping[14][2] = { "\\", "{", "}", "$", "&", "\n", "#", "^", "_", " ", "", "", "", "%" };
+ tex_get_token();
+ switch (cur_cmd) {
+ case escape_cmd:
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case alignment_tab_cmd:
+ case end_line_cmd:
+ case parameter_cmd:
+ case superscript_cmd:
+ case subscript_cmd:
+ case ignore_cmd:
+ case spacer_cmd:
+ case comment_cmd:
+ lua_pushstring(L, mapping[cur_cmd]);
+ break;
+ case letter_cmd:
+ case other_char_cmd:
+ {
+ char buffer[6];
+ char *uindex = aux_uni2string((char *) buffer, (unsigned int) cur_chr);
+ *uindex = '\0';
+ lua_pushstring(L, buffer);
+ break;
+ }
+ default:
+ lua_pushstring(L, "");
+ break;
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_is_next_char(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate(); /* no expansion */ /* optional expansion ? */ /* gobbles spaces */
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd ) {
+ int c = lmt_tointeger(L, 1);
+ lua_pushboolean(L, c == cur_chr);
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ tex_back_input(cur_tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_peek_next(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ if (lua_toboolean(L, 1)) {
+ tokenlib_aux_goto_first_candidate();
+ } else {
+ tex_get_token();
+ }
+ // make_new_token(L, cur_cmd, cur_chr, cur_cs);
+ tokenlib_aux_make_new_token_tok(L, cur_tok);
+ tex_back_input(cur_tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_peek_next_expanded(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ if (lua_toboolean(L, 1)) {
+ tokenlib_aux_goto_first_candidate_x();
+ } else {
+ tex_get_x_token();
+ }
+ // make_new_token(L, cur_cmd, cur_chr, cur_cs);
+ tokenlib_aux_make_new_token_tok(L, cur_tok);
+ tex_back_input(cur_tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_peek_next_char(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate(); /* no expansion */ /* optional expansion ? */ /* gobbles spaces */
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd ) {
+ lua_pushinteger(L, cur_chr);
+ } else {
+ lua_pushnil(L);
+ }
+ tex_back_input(cur_tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+/*tex
+
+ This next two are experimental and might evolve. It will take a while before
+ I decide if this is the way to go. They are not used in critical code so we
+ have all time of the world.
+
+*/
+
+static int tokenlib_scan_key(lua_State *L)
+{
+ int c1 = lmt_optinteger(L, 1, '\0');
+ int c2 = lmt_optinteger(L, 2, '\0');
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate_x();
+ if ((cur_cmd == letter_cmd || cur_cmd == other_char_cmd) && (cur_chr != c1) && (cur_chr != c2)) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while (1) {
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ tex_get_x_token();
+ if ((cur_cmd != letter_cmd && cur_cmd != other_char_cmd) || (cur_chr == c1) || (cur_chr == c2)) {
+ break ;
+ }
+ }
+ /*
+ if (! (lua_toboolean(L, 1) && (cur_cmd == spacer_cmd || cur_cmd == relax_cmd))) {
+ back_input(cur_tok);
+ }
+ */
+ tex_back_input(cur_tok);
+ luaL_pushresult(&b);
+ } else {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+/* todo: other call_cmd */
+/* todo: non expandable option */
+
+static int tokenlib_scan_value(lua_State *L)
+{
+ /*tex can be simplified, no need for intermediate list */
+ int c1 = lmt_optinteger(L, 1, '\0');
+ int c2 = lmt_optinteger(L, 2, '\0');
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tokenlib_aux_goto_first_candidate_x(); /* no _x */
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ {
+ halfword result;
+ halfword defref = lmt_input_state.def_ref;
+ result = tex_scan_toks_expand(1, NULL, 0);
+ lmt_input_state.def_ref = defref;
+ lmt_token_list_to_luastring(L, result, 0, 0);
+ tex_flush_token_list(result);
+ }
+ break;
+ /*
+ case call_cmd:
+ {
+ halfword t = cur_cs ? cs_token_flag + cur_cs : token_val(cur_cmd, cur_chr);
+ if (t >= cs_token_flag) {
+ unsigned char *s = get_cs_text(t - cs_token_flag);
+ if (s) {
+ // if (is_active_cs(cs_text(t - cs_token_flag))) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ cs_name_to_buffer(s);
+ luaL_pushresult(&b);
+ lmt_memory_free(s);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ break;
+ */
+ case letter_cmd:
+ case other_char_cmd:
+ {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while (1) {
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ {
+ halfword result;
+ halfword defref = lmt_input_state.def_ref;
+ result = tex_scan_toks_expand(1, NULL, 0);
+ lmt_input_state.def_ref = defref;
+ lmt_token_list_to_luastring(L, result, 0, 0);
+ tex_flush_token_list(result);
+ luaL_addchar(&b, '{');
+ luaL_addvalue(&b);
+ luaL_addchar(&b, '}');
+ }
+ break;
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ {
+ /*tex We need to add a space. */
+ halfword t = cur_cs ? cs_token_flag + cur_cs : token_val(cur_cmd, cur_chr);
+ if (t >= cs_token_flag) {
+ unsigned char *s = tokenlib_aux_get_cs_text(t - cs_token_flag);
+ if (s) {
+ if (tex_is_active_cs(cs_text(t - cs_token_flag))) {
+ lua_pushstring(L, (char *) (s + 3));
+ luaL_addvalue(&b);
+ } else {
+ luaL_addchar(&b, '\\');
+ lua_pushstring(L, (char *) s);
+ luaL_addvalue(&b);
+ luaL_addchar(&b, ' ');
+ }
+ lmt_memory_free(s);
+ }
+ }
+ }
+ break;
+ case letter_cmd:
+ case other_char_cmd:
+ if (cur_chr == c1 || cur_chr == c2) {
+ goto DONE;
+ } else {
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ }
+ break;
+ default:
+ /* what to do */
+ tokenlib_aux_add_utf_char_to_buffer(&b, cur_chr);
+ break;
+ }
+ tex_get_x_token();
+ }
+ DONE:
+ tex_back_input(cur_tok);
+ luaL_pushresult(&b);
+ }
+ break;
+ default:
+ {
+ tex_back_input(cur_tok);
+ lua_pushnil(L);
+ }
+ break;
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+/*tex Till here. */
+
+static int tokenlib_future_expand(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ halfword spa = null;
+ halfword yes = tex_get_token(); /* no expansion */
+ halfword nop = tex_get_token(); /* no expansion */
+ while (1) {
+ halfword t = tex_get_token();
+ switch (t) {
+ case spacer_cmd:
+ spa = t; /* preserves spaces */
+ break;
+ case letter_cmd:
+ case other_char_cmd:
+ if (lua_tointeger(L, 1) == cur_chr) {
+ tex_back_input(t);
+ tex_back_input(yes);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 0;
+ }
+ default:
+ tex_back_input(t);
+ if (spa && lua_toboolean(L, 2)) {
+ tex_back_input(spa);
+ }
+ tex_back_input(nop);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 0;
+ }
+ }
+ return 0;
+}
+
+static int tokenlib_scan_code(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tex_get_x_token();
+ if (cur_cmd <= max_char_code_cmd) {
+ int cc = lmt_optinteger(L, 1, DEFAULT_SCAN_CODE_SET);
+ if (cc & (1 << (cur_cmd))) {
+ lua_pushinteger(L, (int) cur_chr);
+ } else {
+ lua_pushnil(L);
+ tex_back_input(cur_tok);
+ }
+ } else {
+ lua_pushnil(L);
+ tex_back_input(cur_tok);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_scan_token_code(lua_State *L)
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ halfword t = tex_get_token();
+ /* maybe treat spaces as such */
+ if (cur_cmd <= max_char_code_cmd) {
+ if (DEFAULT_SCAN_CODE_SET & (1 << (cur_cmd))) {
+ lua_pushinteger(L, (int) cur_chr);
+ } else {
+ lua_pushnil(L);
+ tex_back_input(t);
+ }
+ } else {
+ lua_pushnil(L);
+ tex_back_input(t);
+ }
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+static int tokenlib_is_token(lua_State *L)
+{
+ lua_pushboolean(L, tokenlib_aux_maybe_istoken(L, 1) ? 1 : 0);
+ return 1;
+}
+
+static int tokenlib_expand(lua_State *L)
+{
+ (void) L;
+ tex_expand_current_token();
+ /* should we push back? */
+ return 0;
+}
+
+static int tokenlib_is_defined(lua_State *L)
+{
+ int b = 0;
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ int cs = tex_string_locate(s, l, 0);
+ b = (cs != undefined_control_sequence) && (eq_type(cs) != undefined_cs_cmd);
+ }
+ }
+ lua_pushboolean(L, b);
+ return 1;
+}
+
+/*tex
+ The next two will be redone so that they check if valid tokens are created. For that I need to
+ clean up the \TEX\ end a bit more so that we can do proper cmd checking.
+*/
+
+static int tokenlib_create(lua_State *L)
+{
+ switch (lua_type(L, 1)) {
+ case LUA_TNUMBER:
+ {
+ int cs = 0;
+ int chr = (int) lua_tointeger(L, 1);
+ int cmd = (int) luaL_optinteger(L, 2, tex_get_cat_code(cat_code_table_par, chr));
+ switch (cmd) {
+ case escape_cmd:
+ case ignore_cmd:
+ case comment_cmd:
+ case invalid_char_cmd:
+ /* tex_formatted_warning("token lib","not a good token, catcode %i can not be returned, so 12 will be used",(int) cmd); */
+ cmd = other_char_cmd;
+ break;
+ case active_char_cmd:
+ cs = tex_active_to_cs(chr, ! lmt_hash_state.no_new_cs);
+ cmd = eq_type(cs);
+ chr = eq_value(cs);
+ break;
+ }
+ tokenlib_aux_make_new_token(L, cmd, chr, cs);
+ break;
+ }
+ case LUA_TSTRING:
+ {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ int cs = tex_string_locate(s, l, lua_toboolean(L, 2));
+ int cmd = eq_type(cs);
+ int chr = eq_value(cs);
+ tokenlib_aux_make_new_token(L, cmd, chr, cs);
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ }
+ default:
+ {
+ lua_pushnil(L);
+ break;
+ }
+ }
+ return 1;
+}
+
+/*tex
+ The order of arguments is somewhat strange but it comes from \LUATEX.
+*/
+
+static int tokenlib_new(lua_State *L)
+{
+ int chr = 0;
+ int cmd = 0;
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ cmd = (int) tokenlib_aux_get_command_id(lua_tostring(L, 1));
+ chr = (int) luaL_optinteger(L, 2, 0);
+ break;
+ case LUA_TNUMBER:
+ chr = (int) lua_tointeger(L, 1);
+ cmd = (int) luaL_optinteger(L, 2, 0);
+ break;
+ default:
+ break;
+ }
+ tokenlib_aux_make_new_token(L, cmd, chr, 0);
+ return 1;
+}
+
+/*tex
+ The next few are more test functions and at some point they will replace the above or at least
+ be combined so that we do proper checking.
+*/
+
+static int tokenlib_get_cmdchrcs(lua_State* L)
+{
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ int cs = tex_string_locate(s, l, 0);
+ int cmd = eq_type(cs);
+ int chr = eq_value(cs);
+ if (! lua_toboolean(L, 2)) {
+ /*tex This option is only for diagnostics! */
+ chr = tokenlib_aux_to_valid_index(cmd, chr);
+ }
+ lua_pushinteger(L, cmd);
+ lua_pushinteger(L, chr); /* or index */
+ lua_pushinteger(L, cs);
+ return 3;
+ }
+ return 0;
+}
+
+static int tokenlib_scan_cmdchr(lua_State *L)
+{
+ int cmd, chr;
+ halfword tok = tex_get_token();
+ if (tok >= cs_token_flag) {
+ tok -= cs_token_flag;
+ cmd = eq_type(tok);
+ chr = eq_value(tok);
+ } else {
+ cmd = token_cmd(tok);
+ chr = token_chr(tok);
+ }
+ lua_pushinteger(L, cmd);
+ lua_pushinteger(L, tokenlib_aux_to_valid_index(cmd, chr));
+ return 2;
+}
+
+static int tokenlib_scan_cmdchr_expanded(lua_State *L)
+{
+ int cmd, chr;
+ halfword tok = tex_get_x_token();
+ if (tok >= cs_token_flag) {
+ tok -= cs_token_flag;
+ cmd = eq_type(tok);
+ chr = eq_value(tok);
+ } else {
+ cmd = token_cmd(tok);
+ chr = token_chr(tok);
+ }
+ lua_pushinteger(L, cmd);
+ lua_pushinteger(L, tokenlib_aux_to_valid_index(cmd, chr));
+ return 2;
+}
+
+
+static int tokenlib_get_cstoken(lua_State* L)
+{
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ lua_pushinteger(L, (lua_Integer) tex_string_locate(s, l, 0) + cs_token_flag);
+ return 1;
+ }
+ return 0;
+}
+
+static int tokenlib_getprimitives(lua_State *L)
+{
+ int cs = 0;
+ int nt = 0;
+ int raw = lua_toboolean(L, 1);
+ lua_createtable(L, prim_size, 0);
+ while (cs < prim_size) {
+ strnumber s = get_prim_text(cs);
+ if (s > 0 && (get_prim_origin(cs) != no_command)) {
+ char *ss = tex_makecstring(s);
+ int cmd = prim_eq_type(cs);
+ int chr = prim_equiv(cs);
+ if (! raw) {
+ chr = tokenlib_aux_to_valid_index(cmd, chr);
+ }
+ lua_createtable(L, 4, 0);
+ lua_pushinteger(L, cmd);
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, chr);
+ lua_rawseti(L, -2, 2);
+ lua_pushstring(L, ss);
+ lua_rawseti(L, -2, 3);
+ lua_pushinteger(L, prim_origin(cs));
+ lua_rawseti(L, -2, 4);
+ lua_rawseti(L, -2, ++nt);
+ lmt_memory_free(ss);
+ }
+ cs++;
+ }
+ return 1;
+}
+
+/*tex token instance functions */
+
+static int tokenlib_free(lua_State *L)
+{
+ /* lua_token *n = check_istoken(L, 1); */
+ lua_token *n = lua_touserdata(L, 1);
+ if (n->origin == token_origin_lua) {
+ if (token_link(n->token)) {
+ tex_flush_token_list(n->token);
+ } else {
+ tex_put_available_token(n->token);
+ }
+ } else {
+ /*tex This can't happen (yet). */
+ }
+ return 1;
+}
+
+/*tex fast accessors */
+
+inline static int tokenlib_get_command(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword t = token_info(n->token);
+ lua_pushinteger(L, (t >= cs_token_flag) ? (int) eq_type(t - cs_token_flag) : token_cmd(t));
+ return 1;
+}
+
+inline static int tokenlib_get_index(lua_State *L)
+{
+ int cmd, chr;
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ if (tok >= cs_token_flag) {
+ tok -= cs_token_flag;
+ cmd = eq_type(tok);
+ chr = eq_value(tok);
+ } else {
+ cmd = token_cmd(tok);
+ chr = token_chr(tok);
+ }
+ lua_pushinteger(L, tokenlib_aux_to_valid_index(cmd, chr));
+ return 1;
+}
+
+inline static int tokenlib_get_range(lua_State *L)
+{
+ int cmd;
+ if (lua_type(L, 1) == LUA_TNUMBER) {
+ cmd = (int) lua_tointeger(L, 1);
+ } else {
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ cmd = (tok >= cs_token_flag) ? eq_type(tok - cs_token_flag) : token_cmd(tok);
+ }
+ if (cmd >= 0 && cmd <= last_cmd) {
+ command_item item = lmt_interface.command_names[cmd];
+ lua_pushinteger(L, item.kind);
+ switch (item.kind) {
+ case unused_command_item:
+ lua_pushboolean(L, 0);
+ lua_pushboolean(L, 0);
+ break;
+ case regular_command_item:
+ case character_command_item:
+ case register_command_item:
+ case internal_command_item:
+ case reference_command_item:
+ case data_command_item:
+ lua_pushinteger(L, item.min);
+ lua_pushinteger(L, item.max);
+ break;
+ case token_command_item:
+ case node_command_item:
+ lua_pushboolean(L, 0);
+ lua_pushboolean(L, 0);
+ break;
+ }
+ lua_pushinteger(L, item.fixedvalue);
+ return 4;
+ } else {
+ return 0;
+ }
+}
+
+inline static int tokenlib_get_cmdname(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ int cmd = (tok >= cs_token_flag) ? eq_type(tok - cs_token_flag) : token_cmd(tok);
+ lua_push_key_by_index(lmt_interface.command_names[cmd].lua);
+ return 1;
+}
+
+void lmt_push_cmd_name(lua_State *L, int cmd)
+{
+ if (cmd >= 0) {
+ lua_push_key_by_index(lmt_interface.command_names[cmd].lua);
+ } else {
+ lua_pushnil(L);
+ }
+}
+
+inline static int tokenlib_get_csname(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ if (tok >= cs_token_flag) {
+ unsigned char *s = tokenlib_aux_get_cs_text(tok - cs_token_flag);
+ if (s) {
+ if (tex_is_active_cs(cs_text(tok - cs_token_flag))) {
+ lua_pushstring(L, (char *) (s + 3));
+ } else {
+ lua_pushstring(L, (char *) s);
+ }
+ lmt_memory_free(s);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+inline static int tokenlib_get_id(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ lua_pushinteger(L, n->token);
+ return 1;
+}
+
+inline static int tokenlib_get_tok(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushinteger(L, tok);
+ return 1;
+}
+
+inline static int tokenlib_get_active(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ int result = 0;
+ if (tok >= cs_token_flag) {
+ unsigned char *s = tokenlib_aux_get_cs_text(tok - cs_token_flag);
+ if (s) {
+ result = tex_is_active_cs(cs_text(tok - cs_token_flag));
+ lmt_memory_free(s);
+ }
+ }
+ lua_pushboolean(L, result);
+ return 1;
+}
+
+inline static int tokenlib_get_expandable(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ halfword cmd = (tok >= cs_token_flag) ? eq_type(tok - cs_token_flag) : token_cmd(tok);
+ lua_pushboolean(L, cmd > max_command_cmd);
+ return 1;
+}
+
+inline static int tokenlib_get_protected(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ halfword cmd = (tok >= cs_token_flag) ? eq_type(tok - cs_token_flag) : token_cmd(tok);
+ lua_pushboolean(L, is_protected_cmd(cmd));
+ return 1;
+}
+
+inline static int tokenlib_get_tolerant(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ halfword cmd = (tok >= cs_token_flag) ? eq_type(tok - cs_token_flag) : token_cmd(tok);
+ lua_pushboolean(L, is_tolerant_cmd(cmd));
+ return 1;
+}
+
+inline static int tokenlib_get_noaligned(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, noaligned_flag_bit));
+ return 1;
+}
+
+inline static int tokenlib_get_primitive(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, primitive_flag_bit));
+ return 1;
+}
+
+inline static int tokenlib_get_permanent(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, permanent_flag_bit));
+ return 1;
+}
+
+inline static int tokenlib_get_immutable(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, immutable_flag_bit));
+ return 1;
+}
+
+inline static int tokenlib_get_mutable(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, mutable_flag_bit));
+ return 1;
+}
+
+inline static int tokenlib_get_frozen(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, frozen_flag_bit));
+ return 1;
+}
+
+inline static int tokenlib_get_instance(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, instance_flag_bit));
+ return 1;
+}
+
+
+inline static int tokenlib_get_untraced(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag && has_eq_flag_bits(tok - cs_token_flag, untraced_flag_bit));
+ return 1;
+}
+
+
+inline static int tokenlib_get_flags(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_pushboolean(L, tok >= cs_token_flag ? eq_flag(tok - cs_token_flag) : 0);
+ return 1;
+}
+
+inline static int tokenlib_get_parameters(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ if (tok >= cs_token_flag && is_call_cmd(eq_type(tok - cs_token_flag))) {
+ halfword v = eq_value(tok - cs_token_flag);
+ if (v && token_link(v)) {
+ lua_pushinteger(L, get_token_parameters(v));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 0;
+}
+
+static int tokenlib_getfield(lua_State *L)
+{
+ const char *s = lua_tostring(L, 2);
+ if (lua_key_eq(s, command)) {
+ return tokenlib_get_command(L);
+ } else if (lua_key_eq(s, index)) {
+ return tokenlib_get_index(L);
+ } else if (lua_key_eq(s, cmdname)) {
+ return tokenlib_get_cmdname(L);
+ } else if (lua_key_eq(s, csname)) {
+ return tokenlib_get_csname(L);
+ } else if (lua_key_eq(s, id)) {
+ return tokenlib_get_id(L);
+ } else if (lua_key_eq(s, tok)) {
+ return tokenlib_get_tok(L);
+ } else if (lua_key_eq(s, active)) {
+ return tokenlib_get_active(L);
+ } else if (lua_key_eq(s, expandable)) {
+ return tokenlib_get_expandable(L);
+ } else if (lua_key_eq(s, protected)) {
+ return tokenlib_get_protected(L);
+ } else if (lua_key_eq(s, frozen)) {
+ return tokenlib_get_frozen(L);
+ } else if (lua_key_eq(s, tolerant)) {
+ return tokenlib_get_tolerant(L);
+ } else if (lua_key_eq(s, noaligned)) {
+ return tokenlib_get_noaligned(L);
+ } else if (lua_key_eq(s, permanent)) {
+ return tokenlib_get_permanent(L);
+ } else if (lua_key_eq(s, immutable)) {
+ return tokenlib_get_immutable(L);
+ } else if (lua_key_eq(s, mutable)) {
+ return tokenlib_get_mutable(L);
+ } else if (lua_key_eq(s, primitive)) {
+ return tokenlib_get_primitive(L);
+ } else if (lua_key_eq(s, instance)) {
+ return tokenlib_get_instance(L);
+ } else if (lua_key_eq(s, untraced)) {
+ return tokenlib_get_untraced(L);
+ } else if (lua_key_eq(s, flags)) {
+ return tokenlib_get_flags(L);
+ } else if (lua_key_eq(s, parameters)) {
+ return tokenlib_get_parameters(L);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int tokenlib_get_fields(lua_State *L)
+{
+ halfword cmd = null;
+ halfword chr = null;
+ int flags = 0;
+ int onlyflags = lua_toboolean(L, 2);
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ {
+ size_t l;
+ const char *str = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ lua_createtable(L, 0, onlyflags ? 0 : 5);
+ halfword cs = tex_string_locate(str, l, 0);
+ cmd = eq_type(cs);
+ chr = eq_value(cs);
+ flags = eq_flag(cs);
+ if (! onlyflags) {
+ lua_push_key(csname);
+ lua_pushstring(L, str);
+ lua_rawset(L, -3);
+ }
+ break;
+ } else {
+ return 0;
+ }
+ }
+ case LUA_TUSERDATA:
+ {
+ lua_token *n = tokenlib_aux_check_istoken(L, 1);
+ halfword tok = token_info(n->token);
+ lua_createtable(L, 0, onlyflags ? 0 : 5);
+ if (tok >= cs_token_flag) {
+ int t = tok - cs_token_flag;
+ unsigned char* str = tokenlib_aux_get_cs_text(t);
+ if (str) {
+ if (! onlyflags) {
+ lua_push_key(csname);
+ if (tex_is_active_cs(cs_text(t))) {
+ lua_push_key(active);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+ lua_pushstring(L, (char*) (str + 3));
+ } else {
+ lua_pushstring(L, (char*) str);
+ }
+ lua_rawset(L, -3);
+ }
+ lmt_memory_free(str);
+ }
+ cmd = eq_type(t);
+ chr = eq_value(t);
+ } else {
+ cmd = token_cmd(tok);
+ chr = token_chr(tok);
+ }
+ break;
+ }
+ default:
+ return 0;
+
+ }
+ if (flags) {
+ if (is_frozen (flags)) { lua_push_key(frozen); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_noaligned(flags)) { lua_push_key(noaligned); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_permanent(flags)) { lua_push_key(permanent); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_immutable(flags)) { lua_push_key(immutable); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_mutable (flags)) { lua_push_key(mutable); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_primitive(flags)) { lua_push_key(primitive); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_instance (flags)) { lua_push_key(instance); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_untraced (flags)) { lua_push_key(untraced); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (flags) { lua_push_key(flags); lua_pushinteger(L, flags); lua_rawset(L, -3); }
+ if (is_protected(cmd)) { lua_push_key(protected); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ if (is_tolerant (cmd)) { lua_push_key(tolerant); lua_pushboolean(L, 1); lua_rawset(L, -3); }
+ }
+ if (! onlyflags) {
+ lua_push_key(command);
+ lua_pushinteger(L, cmd);
+ lua_rawset(L, -3);
+ lua_push_key(cmdname);
+ lua_push_key_by_index(lmt_interface.command_names[cmd].lua);
+ lua_rawset(L, -3);
+ lua_push_key(index); /* or value */
+ lua_pushinteger(L, tokenlib_aux_to_valid_index(cmd, chr));
+ lua_rawset(L, -3);
+ if (is_call_cmd(cmd) && chr && token_link(chr)) {
+ lua_push_key(parameters);
+ lua_pushinteger(L, get_token_parameters(token_link(chr)));
+ lua_rawset(L, -3);
+ }
+ }
+ return 1;
+}
+
+/*tex end */
+
+static int tokenlib_equal(lua_State* L)
+{
+ lua_token* n = tokenlib_aux_check_istoken(L, 1);
+ lua_token* m = tokenlib_aux_check_istoken(L, 2);
+ lua_pushboolean(L, token_info(n->token) == token_info(m->token));
+ return 1;
+}
+
+static int tokenlib_tostring(lua_State* L)
+{
+ lua_token* n = tokenlib_aux_maybe_istoken(L, 1);
+ if (n) {
+ halfword id = n->token;
+ halfword tok = token_info(id);
+ halfword lnk = token_link(id);
+ char* ori = (n->origin == token_origin_lua) ? "lua" : "tex";
+ halfword cmd, chr;
+ unsigned char* csn = NULL;
+ unsigned char* csp = NULL;
+ const char* cmn = NULL;
+ if (tok >= cs_token_flag) {
+ tok -= cs_token_flag;
+ csn = tokenlib_aux_get_cs_text(tok);
+ csp = csn;
+ if (csn && tex_is_active_cs(cs_text(tok))) {
+ csn += 3;
+ }
+ cmd = eq_type(tok);
+ chr = eq_value(tok);
+ } else {
+ cmd = token_cmd(tok);
+ chr = token_chr(tok);
+ }
+ if (! cmn) {
+ if (cmd >= first_cmd && cmd <= last_cmd) {
+ cmn = lmt_interface.command_names[cmd].name;
+ switch (lmt_interface.command_names[cmd].base) {
+ case ignore_entry:
+ case direct_entry:
+ break;
+ default:
+ chr -= lmt_interface.command_names[cmd].base;
+ }
+ } else {
+ cmn = "bad_token";
+ }
+ }
+ if (csn && csn[0] != '\0') {
+ if (lnk) {
+ lua_pushfstring(L, "<%s token : %d => %d : %s : %s %d>", ori, id, lnk, (char *) csn, cmn, chr);
+ } else {
+ lua_pushfstring(L, "<%s token : %d == %s : %s %d>", ori, id, (char *) csn, cmn, chr);
+ }
+ } else {
+ if (! lnk) {
+ lua_pushfstring(L, "<%s token : %d == %s %d>", ori, id, cmn, chr);
+ } else if (cmd == 0 && chr == 0) {
+ /*tex A zero escape token is less likely than an initial list refcount token. */
+ lua_pushfstring(L, "<%s token : %d => %d : refcount>", ori, id, lnk);
+ } else {
+ lua_pushfstring(L, "<%s token : %d => %d : %s %d>", ori, id, lnk, cmn, chr);
+ }
+ }
+ if (csp) {
+ lmt_memory_free(csp);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int tokenlib_package_tostring(lua_State *L)
+{
+ lua_token_package *n = tokenlib_aux_check_ispackage(L, 1);
+ if (n) {
+ if (is_call_cmd(n->cmd)) {
+ lua_pushfstring(L, "<tex token package %d: %d %d %d>", n->cs, n->cmd, n->chr, get_token_reference(n->chr));
+ } else {
+ lua_pushfstring(L, "<tex token package %d: %d %d>", n->cs, n->cmd, n->chr);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int tokenlib_type(lua_State *L)
+{
+ if (tokenlib_aux_maybe_istoken(L, 1)) {
+ lua_push_key(token);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int tokenlib_scan_token(lua_State *L) /*tex Similer to |get_next_expanded|, expands and no skips. */
+{
+ saved_tex_scanner texstate = tokenlib_aux_save_tex_scanner();
+ tex_get_x_token();
+ // make_new_token(L, cur_cmd, cur_chr, cur_cs);
+ tokenlib_aux_make_new_token_tok(L, cur_tok);
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+/*tex This is always a copy! */
+
+static int tokenlib_scan_box(lua_State *L)
+{
+ saved_tex_scanner texstate;
+ if (lua_gettop(L) > 0) {
+ const char *s = lua_tostring(L, 1);
+ halfword code = -1 ;
+ if (lua_key_eq(s, hbox)) {
+ code = vtop_code + hmode;
+ } else if (lua_key_eq(s, vbox)) {
+ code = vtop_code + vmode;
+ } else if (lua_key_eq(s, vtop)) {
+ code = vtop_code;
+ }
+ if (code >= 0) {
+ tex_back_input(token_val(make_box_cmd, code));
+ }
+ }
+ /*tex
+ This is a tricky call as we are in \LUA\ and therefore mess with the main loop.
+ */
+ texstate = tokenlib_aux_save_tex_scanner();
+ lmt_push_node_fast(L, tex_local_scan_box());
+ tokenlib_aux_unsave_tex_scanner(texstate);
+ return 1;
+}
+
+/* experiment */
+
+/* [catcodetable] csname content : \def\csname{content} */
+/* [catcodetable] csname content global : \gdef\csname{content} */
+/* [catcodetable] csname : \def\csname{} */
+
+/* TODO: check for a quick way to set a macro to empty (HH) */
+
+static int tokenlib_get_meaning(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ halfword cs = tex_string_locate(name, lname, 0);
+ halfword cmd = eq_type(cs);
+ if (is_call_cmd(cmd)) {
+ int chr = eq_value(cs);
+ if (lua_toboolean(L, 2)) {
+ if (lua_toboolean(L, 3)) {
+ lmt_token_list_to_lua(L, token_link(chr));
+ } else {
+ lmt_token_register_to_lua(L, chr);
+ }
+ } else {
+ char *str = tex_tokenlist_to_tstring(chr, 1, NULL, 0, 0, 0);
+ lua_pushstring(L, str ? str : "");
+ }
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ The final line of this routine is slightly subtle; at least, the author didn't think about it
+ until getting burnt! There is a used-up token list on the stack, namely the one that contained
+ |end_write_token|. We insert this artificial |\endwrite| to prevent runaways, as explained
+ above.) If it were not removed, and if there were numerous writes on a single page, the stack
+ would overflow.
+
+*/
+
+static void tokenlib_aux_expand_macros_in_tokenlist(halfword p)
+{
+ halfword old_mode;
+ halfword q = tex_get_available_token(right_brace_token + '}');
+ halfword r = tex_get_available_token(deep_frozen_end_write_token);
+ token_link(q) = r;
+ tex_begin_inserted_list(q);
+ tex_begin_token_list(p, write_text);
+ q = tex_get_available_token(left_brace_token + '{'); /* not needed when we expand with first arg == 1 */
+ tex_begin_inserted_list(q);
+ /*tex Now we're ready to scan |{<token list>}| |\endwrite|. */
+ old_mode = cur_list.mode;
+ cur_list.mode = 0;
+ /*tex Disable |\prevdepth|, |\spacefactor|, |\lastskip|, |\prevgraf|. */
+ cur_cs = 0; /* was write_loc i.e. eq of \write */
+ /*tex Expand macros, etc. */
+ tex_scan_toks_expand(0, NULL, 0); /* could be 1 and no left brace above */
+ // tex_scan_toks_expand(1, NULL); /* could be 1 and no left brace above */
+ tex_get_token();
+ if (cur_tok != deep_frozen_end_write_token) {
+ /*tex Recover from an unbalanced write command */
+ tex_handle_error(
+ normal_error_type,
+ "Unbalanced token list expansion",
+ "On this page there's a token list expansion with fewer real {'s than }'s. I can't\n"
+ "handle that very well; good luck."
+ );
+ do {
+ tex_get_token();
+ } while (cur_tok != deep_frozen_end_write_token);
+ }
+ cur_list.mode = old_mode;
+ /*tex Conserve stack space. */
+ tex_end_token_list();
+}
+
+static int tokenlib_get_macro(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ halfword cs = tex_string_locate(name, lname, 0);
+ halfword cmd = eq_type(cs);
+ if (is_call_cmd(cmd)) {
+ halfword chr = eq_value(cs);
+ char *str = NULL;
+ if (lua_toboolean(L, 2)) {
+ tokenlib_aux_expand_macros_in_tokenlist(chr); // todo: use return value instead of def_ref
+ str = tex_tokenlist_to_tstring(lmt_input_state.def_ref, 1, NULL, 0, 0, 0);
+ tex_flush_token_list(lmt_input_state.def_ref);
+ } else {
+ str = tex_tokenlist_to_tstring(chr, 1, NULL, 1, 0, 0);
+ }
+ lua_pushstring(L, str ? str : "");
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* maybe just memoryword */
+
+// todo: node lists:
+//
+// [internal|register]_[glue|mu_glue]_reference_cmd
+// specification_reference_cmd
+// box_reference_cmd
+
+static int tokenlib_push_macro(lua_State *L) // todo: just store cmd and flag together
+{
+ /*tex
+ We need to check for a valid hit, but what is best here, for instance using |(cmd >= call_cmd)|
+ is not okay as we miss a lot then.
+ */
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ if (lname > 0) {
+ halfword cs = tex_string_locate(name, lname, 0);
+ singleword cmd = eq_type(cs);
+ halfword chr = eq_value(cs);
+ quarterword global = lua_toboolean(L, 2) ? add_global_flag(0) : 0; /* how */
+ if (is_call_cmd(cmd)) {
+ tex_add_token_reference(chr);
+ }
+ tokenlib_aux_make_new_package(L, cmd, eq_flag(cs), chr, cs, global);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+char *lmt_get_expansion(halfword head, int *len)
+{
+ char *str = NULL;
+ halfword ref = get_reference_token();
+ set_token_link(ref, head);
+ tokenlib_aux_expand_macros_in_tokenlist(ref); // todo: use return value instead of def_ref
+ str = tex_tokenlist_to_tstring(lmt_input_state.def_ref, 1, len, 0, 0, 0);
+ tex_flush_token_list(lmt_input_state.def_ref);
+ tex_flush_token_list(ref);
+ return str;
+}
+
+static int tokenlib_get_expansion(lua_State* L)
+{
+ const char *str;
+ size_t len;
+ int slot = 1;
+ halfword ct = lua_type(L, slot) == LUA_TNUMBER ? lmt_tohalfword(L, slot++) : cat_code_table_par;
+ if (! tex_valid_catcode_table(ct)) {
+ ct = cat_code_table_par;
+ }
+ str = lua_tolstring(L, 1, &len);
+ if (len > 0) {
+ halfword h = get_reference_token();
+ halfword t = h;
+ char *s;
+ int l;
+ tex_parse_str_to_tok(h, &t, ct, str, len, 2); /* ignore unknown */
+
+ tokenlib_aux_expand_macros_in_tokenlist(h); // todo: use return value instead of def_ref
+ s = tex_tokenlist_to_tstring(lmt_input_state.def_ref, 1, &l, 0, 0, 0);
+ tex_flush_token_list(lmt_input_state.def_ref);
+ tex_flush_token_list(h);
+
+ if (l > 0) {
+ lua_pushlstring(L, (const char *) s, (size_t) l);
+ return 1;
+ }
+ }
+ lua_pushliteral(L, "");
+ return 1;
+}
+
+static int tokenlib_pop_macro(lua_State *L)
+{
+ lua_token_package *p = tokenlib_aux_check_ispackage(L, 1);
+ if (p) {
+ tex_forced_define(p->how, p->cs, p->flag, p->cmd, p->chr);
+ }
+ return 0;
+}
+
+static int tokenlib_save_lua(lua_State *L)
+{
+ halfword f = lmt_tohalfword(L, 1);
+ if (lua_toboolean(L, 2) && cur_level > 0) {
+ /* use with care */
+ halfword ptr = lmt_save_state.save_stack_data.ptr;
+ while (1) {
+ --ptr;
+ switch (save_type(ptr)) {
+ case level_boundary:
+ goto SAVE;
+ case restore_lua:
+ if (save_value(ptr) == f) {
+ return 0;
+ } else {
+ break;
+ }
+ }
+ }
+ }
+ SAVE:
+ tex_save_halfword_on_stack(restore_lua, f);
+ return 0;
+}
+
+static int tokenlib_set_lua(lua_State *L)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ if (name) {
+ int flags = 0;
+ int funct = lmt_tointeger(L, 2); /*tex todo: check range */
+ lmt_check_for_flags(L, 3, &flags, 1, 1);
+ halfword cs = tex_string_locate(name, lname, 1);
+ if (tex_define_permitted(cs, flags)) {
+ if (is_value(flags)) {
+ tex_define(flags, cs, lua_value_cmd, funct);
+ } else if (is_conditional(flags)) {
+ tex_define(flags, cs, if_test_cmd, last_if_test_code + funct);
+ /* with some effort we could combine these two an dise the flag */
+ } else if (is_protected(flags)) {
+ tex_define(flags, cs, lua_protected_call_cmd, funct);
+ } else {
+ tex_define(flags, cs, lua_call_cmd, funct);
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+/* [catcodes,]name,data[,global,frozen,protected]* */
+
+static int tokenlib_undefine_macro(lua_State *L) /* todo: protected */
+{
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ if (name) {
+ halfword cs = tex_string_locate(name, lname, 1);
+ int flags = 0;
+ lmt_check_for_flags(L, 2, &flags, 1, 1);
+ tex_define(flags, cs, undefined_cs_cmd, null);
+ }
+ return 0;
+}
+
+static int tokenlib_set_macro(lua_State *L) /* todo: protected */
+{
+ int top = lua_gettop(L);
+ if (top > 0) {
+ const char *name = NULL;
+ size_t lname = 0;
+ int slot = 1;
+ halfword ct = lua_type(L, slot) == LUA_TNUMBER ? lmt_tohalfword(L, slot++) : cat_code_table_par;
+ if (! tex_valid_catcode_table(ct)) {
+ ct = cat_code_table_par;
+ }
+ name = lua_tolstring(L, slot++, &lname);
+ if (name) {
+ size_t lstr = 0;
+ const char *str = lua_tolstring(L, slot++, &lstr);
+ halfword cs = tex_string_locate(name, lname, 1);
+ int flags = 0;
+ if (slot <= top) {
+ slot = lmt_check_for_flags(L, slot, &flags, 1, 1);
+ }
+ if (tex_define_permitted(cs, flags)) { /* we check before we allocate */
+ halfword h = get_reference_token();
+ halfword t = h;
+ if (lstr > 0) {
+ /*tex Options: 1=create (will trigger an error), 2=ignore. */
+ tex_parse_str_to_tok(h, &t, ct, str, lstr, lua_toboolean(L, slot++) ? 2 : 1);
+ }
+ tex_define(flags, cs, tex_flags_to_cmd(flags), h);
+ }
+ }
+ }
+ return 0;
+}
+
+// todo: use: is_call_cmd(cmd)
+
+halfword lmt_macro_to_tok(lua_State *L, int slot, halfword *tail)
+{
+ halfword tok = 0;
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, slot, &lname);
+ int cs = tex_string_locate(name, lname, 0);
+ int cmd = eq_type(cs);
+ if (is_call_cmd(cmd)) {
+ tok = cs_token_flag + cs;
+ } else if (cmd != undefined_cs_cmd) {
+ /*tex Bonus: not really a macro! */
+ tok = token_val(cmd, eq_value(cs));
+ }
+ break;
+ }
+ case LUA_TUSERDATA:
+ tok = token_info(lmt_token_code_from_lua(L, slot));
+ if (! is_call_cmd(tok >= cs_token_flag ? eq_type(tok - cs_token_flag) : token_cmd(tok))) {
+ tok = 0;
+ }
+ break;
+ }
+ if (tok) {
+ int top = lua_gettop(L);
+ halfword m = tex_get_available_token(tok);
+ halfword a = m;
+ halfword c = cat_code_table_par;
+ if (top > slot) {
+ int arg = 0;
+ for (int i = slot + 1; i <= top; i++) {
+ switch (lua_type(L, i)) {
+ case LUA_TBOOLEAN:
+ {
+ arg = lua_toboolean(L, i);
+ break;
+ }
+ case LUA_TSTRING:
+ {
+ size_t l;
+ const char *s = lua_tolstring(L, i, &l);
+ if (arg) {
+ a = tex_store_new_token(a, left_brace_token + '{');
+ }
+ /*tex We use option 1 so we get an undefined error. */
+ tex_parse_str_to_tok(a, &a, c, s, l, 1);
+ if (arg) {
+ a = tex_store_new_token(a, right_brace_token + '}');
+ }
+ break;
+ }
+ case LUA_TNUMBER:
+ {
+ /* catcode table */
+ c = lmt_tohalfword(L, i);
+ break;
+ }
+ case LUA_TTABLE:
+ {
+ size_t l;
+ const char *s ;
+ int j = (int) lua_rawlen(L, i);
+ for (int k = 1; k <= j; k++) {
+ lua_rawgeti(L, i, k);
+ s = lua_tolstring(L, -1, &l);
+ a = tex_store_new_token(a, left_brace_token + '{');
+ /*tex We use option 1 so we get an udndefined error. */
+ tex_parse_str_to_tok(a, &a, c, s, l, 1);
+ a = tex_store_new_token(a, right_brace_token + '}');
+ lua_pop(L, 1);
+ };
+ break;
+ }
+ case LUA_TUSERDATA:
+ {
+ a = tex_store_new_token(a, lmt_token_code_from_lua(L, i));
+ break;
+ }
+ }
+ }
+ }
+ if (tail) {
+ *tail = a;
+ }
+ return m;
+ } else {
+ if (tail) {
+ *tail = null;
+ }
+ return null;
+ }
+}
+
+static int tokenlib_expand_macro(lua_State *L)
+{
+ halfword tail = null;
+ halfword tok = lmt_macro_to_tok(L, 1, &tail);
+ if (tok) {
+ /* todo: append to tail */
+ tex_begin_inserted_list(tex_get_available_token(token_val(end_local_cmd, 0)));
+ tex_begin_inserted_list(tok);
+ // halfword h = tex_get_available_token(token_val(end_local_cmd, 0));
+ // token_link(tail) = h;
+ // tex_begin_inserted_list(tok);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering local control via (run) macro");
+ }
+ tex_local_control(1);
+ } else {
+ tex_local_control_message("invalid (run) macro");
+ }
+ return 0;
+}
+
+/* a weird place, should be in tex */
+
+static int tokenlib_set_char(lua_State *L) /* also in texlib */
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ if (name) {
+ int value = lmt_tointeger(L, 2);
+ if (value >= 0 && value <= max_character_code) {
+ int flags = 0;
+ int cs = tex_string_locate(name, lname, 1);
+ if (top > 2) {
+ lmt_check_for_flags(L, 3, &flags, 1, 0);
+ }
+ tex_define(flags, cs, char_given_cmd, value);
+ }
+ }
+ }
+ return 0;
+}
+
+/* a weird place, these should be in tex */
+
+static int tokenlib_set_constant(lua_State *L, singleword cmd, halfword min, halfword max)
+{
+ int top = lua_gettop(L);
+ if (top >= 2) {
+ size_t lname = 0;
+ const char *name = lua_tolstring(L, 1, &lname);
+ if (name) {
+ halfword value = lmt_tohalfword(L, 2);
+ if (value >= min && value <= max) {
+ int flags = 0;
+ int cs = tex_string_locate(name, lname, 1);
+ if (top > 2) {
+ lmt_check_for_flags(L, 3, &flags, 1, 0);
+ }
+ tex_define(flags, cs, cmd, value);
+ }
+ }
+ }
+ return 0;
+}
+
+static int tokenlib_get_constant(lua_State *L, halfword cmd)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (l > 0) {
+ int cs = tex_string_locate(s, l, 0);
+ if (eq_type(cs) == cmd) {
+ lua_pushinteger(L, eq_value(cs));
+ return 1;
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int tokenlib_set_integer(lua_State *L)
+{
+ return tokenlib_set_constant(L, integer_cmd, min_integer, max_integer);
+}
+
+static int tokenlib_set_dimension(lua_State *L)
+{
+ return tokenlib_set_constant(L, dimension_cmd, min_dimen, max_dimen);
+}
+
+// static int tokenlib_set_gluespec(lua_State *L)
+// {
+// return tokenlib_set_constant(L, gluespec_cmd, min_dimen, max_dimen);
+// }
+
+static int tokenlib_get_integer(lua_State *L)
+{
+ return tokenlib_get_constant(L, integer_cmd);
+}
+
+static int tokenlib_get_dimension(lua_State *L)
+{
+ return tokenlib_get_constant(L, dimension_cmd);
+}
+
+// static int tokenlib_get_gluespec(lua_State *L)
+// {
+// return tokenlib_get_constant(L, gluespec_cmd);
+// }
+
+/*
+static int tokenlib_get_command_names(lua_State *L)
+{
+ lua_createtable(L, data_cmd + 1, 0);
+ for (int i = 0; command_names[i].lua; i++) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, command_names[i].lua);
+ lua_rawseti(L, -2, i);
+ }
+ return 1;
+}
+*/
+
+static int tokenlib_serialize(lua_State *L)
+{
+ lua_token *n = tokenlib_aux_maybe_istoken(L, 1);
+ if (n) {
+ halfword t = n->token;
+ char *s;
+ tokenlib_aux_expand_macros_in_tokenlist(t); // todo: use return value instead of def_ref
+ s = tex_tokenlist_to_tstring(lmt_input_state.def_ref, 1, NULL, 0, 0, 0);
+ lua_pushstring(L, s ? s : "");
+ tex_flush_token_list(lmt_input_state.def_ref);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int tokenlib_getcommandvalues(lua_State *L)
+{
+ lua_createtable(L, number_tex_commands, 1);
+ for (int i = 0; i < number_tex_commands; i++) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_interface.command_names[i].lua);
+ lua_rawseti(L, -2, lmt_interface.command_names[i].id);
+ }
+ return 1;
+}
+
+static int tokenlib_getfunctionvalues(lua_State *L)
+{
+ return lmt_push_info_values(L, lmt_interface.lua_function_values);
+}
+
+static const struct luaL_Reg tokenlib_function_list[] = {
+ { "type", tokenlib_type },
+ { "create", tokenlib_create },
+ { "new", tokenlib_new },
+ /* */
+ { "istoken", tokenlib_is_token },
+ { "isdefined", tokenlib_is_defined },
+ /* getters */
+ { "scannext", tokenlib_scan_next },
+ { "scannextexpanded", tokenlib_scan_next_expanded },
+ { "scannextchar", tokenlib_scan_next_char },
+ /* skippers */
+ { "skipnext", tokenlib_skip_next },
+ { "skipnextexpanded", tokenlib_skip_next_expanded },
+ /* peekers */
+ { "peeknext", tokenlib_peek_next },
+ { "peeknextexpanded", tokenlib_peek_next_expanded },
+ { "peeknextchar", tokenlib_peek_next_char },
+ /* scanners */
+ { "scancmdchr", tokenlib_scan_cmdchr },
+ { "scancmdchrexpanded", tokenlib_scan_cmdchr_expanded },
+ { "scankeyword", tokenlib_scan_keyword },
+ { "scankeywordcs", tokenlib_scan_keyword_cs },
+ { "scaninteger", tokenlib_scan_integer },
+ { "scanintegerargument", tokenlib_scan_integer_argument },
+ { "scandimenargument", tokenlib_scan_dimen_argument },
+ { "scancardinal", tokenlib_scan_cardinal },
+ { "scanfloat", tokenlib_scan_float },
+ { "scanreal", tokenlib_scan_real },
+ { "scanluanumber", tokenlib_scan_luanumber },
+ { "scanluainteger", tokenlib_scan_luainteger },
+ { "scanluacardinal", tokenlib_scan_luacardinal },
+ { "scanscale", tokenlib_scan_scale },
+ { "scandimen", tokenlib_scan_dimen },
+ { "scanskip", tokenlib_scan_skip },
+ { "scanglue", tokenlib_scan_glue },
+ { "scantoks", tokenlib_scan_toks },
+ { "scantokenlist", tokenlib_scan_tokenlist },
+ { "scancode", tokenlib_scan_code },
+ { "scantokencode", tokenlib_scan_token_code }, /* doesn't expand */
+ { "scanstring", tokenlib_scan_string },
+ { "scanargument", tokenlib_scan_argument },
+ { "scandelimited", tokenlib_scan_delimited },
+ { "scanword", tokenlib_scan_word },
+ { "scanletters", tokenlib_scan_letters },
+ { "scankey", tokenlib_scan_key },
+ { "scanvalue", tokenlib_scan_value },
+ { "scanchar", tokenlib_scan_char },
+ { "scancsname", tokenlib_scan_csname },
+ { "scantoken", tokenlib_scan_token }, /* expands next token if needed */
+ { "scanbox", tokenlib_scan_box },
+ { "isnextchar", tokenlib_is_next_char },
+ /* writers */
+ { "putnext", tokenlib_put_next },
+ { "putback", tokenlib_put_back },
+ { "expand", tokenlib_expand },
+ /* getters */
+ { "getcommand", tokenlib_get_command },
+ { "getindex", tokenlib_get_index },
+ { "getrange", tokenlib_get_range },
+ /* { "get_mode", tokenlib_get_mode }, */ /* obsolete */
+ { "getcmdname", tokenlib_get_cmdname },
+ { "getcsname", tokenlib_get_csname },
+ { "getid", tokenlib_get_id },
+ { "gettok", tokenlib_get_tok }, /* obsolete */
+ { "getactive", tokenlib_get_active },
+ { "getexpandable", tokenlib_get_expandable },
+ { "getprotected", tokenlib_get_protected },
+ { "getfrozen", tokenlib_get_frozen },
+ { "gettolerant", tokenlib_get_tolerant },
+ { "getnoaligned", tokenlib_get_noaligned },
+ { "getprimitive", tokenlib_get_primitive },
+ { "getpermanent", tokenlib_get_permanent },
+ { "getimmutable", tokenlib_get_immutable },
+ { "getinstance", tokenlib_get_instance },
+ { "getflags", tokenlib_get_flags },
+ { "getparameters", tokenlib_get_parameters },
+ { "getmacro", tokenlib_get_macro },
+ { "getmeaning", tokenlib_get_meaning },
+ { "getcmdchrcs", tokenlib_get_cmdchrcs },
+ { "getcstoken", tokenlib_get_cstoken },
+ { "getfields", tokenlib_get_fields },
+ /* setters */
+ { "setmacro", tokenlib_set_macro },
+ { "undefinemacro", tokenlib_undefine_macro },
+ { "expandmacro", tokenlib_expand_macro },
+ { "setchar", tokenlib_set_char },
+ { "setlua", tokenlib_set_lua },
+ { "setinteger", tokenlib_set_integer }, /* can go ... also in texlib */
+ { "getinteger", tokenlib_get_integer }, /* can go ... also in texlib */
+ { "setdimension", tokenlib_set_dimension }, /* can go ... also in texlib */
+ { "getdimension", tokenlib_get_dimension }, /* can go ... also in texlib */
+ /* gobblers */
+ { "gobbleinteger", tokenlib_gobble_integer },
+ { "gobbledimen", tokenlib_gobble_dimen },
+ { "gobble", tokenlib_gobble_until },
+ { "grab", tokenlib_grab_until },
+ /* macros */
+ { "futureexpand", tokenlib_future_expand },
+ { "pushmacro", tokenlib_push_macro },
+ { "popmacro", tokenlib_pop_macro },
+ /* whatever */
+ { "savelua", tokenlib_save_lua },
+ { "serialize", tokenlib_serialize },
+ { "getexpansion", tokenlib_get_expansion },
+ /* interface */
+ { "getfunctionvalues", tokenlib_getfunctionvalues },
+ { "getcommandvalues", tokenlib_getcommandvalues },
+ { "getcommandid", tokenlib_getcommandid },
+ { "getprimitives", tokenlib_getprimitives },
+ /* done */
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg tokenlib_instance_metatable[] = {
+ { "__index", tokenlib_getfield },
+ { "__tostring", tokenlib_tostring },
+ { "__gc", tokenlib_free },
+ { "__eq", tokenlib_equal },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg tokenlib_package_metatable[] = {
+ { "__tostring", tokenlib_package_tostring },
+ { NULL, NULL },
+};
+
+int luaopen_token(lua_State *L)
+{
+ luaL_newmetatable(L, TOKEN_METATABLE_INSTANCE);
+ luaL_setfuncs(L, tokenlib_instance_metatable, 0);
+ luaL_newmetatable(L, TOKEN_METATABLE_PACKAGE);
+ luaL_setfuncs(L, tokenlib_package_metatable, 0);
+ lua_newtable(L);
+ luaL_setfuncs(L, tokenlib_function_list, 0);
+ return 1;
+}
+
+typedef struct LoadS { // name
+ char *s;
+ size_t size;
+} LoadS;
+
+static const char *tokenlib_aux_reader(lua_State *L, void *ud, size_t *size)
+{
+ LoadS *ls = (LoadS *) ud;
+ (void) L;
+ if (ls->size > 0) {
+ *size = ls->size;
+ ls->size = 0;
+ return ls->s;
+ } else {
+ return NULL;
+ }
+}
+
+void lmt_token_call(int p) /*tex The \TEX\ pointer to the token list. */
+{
+ LoadS ls;
+ int l = 0;
+ ls.s = tex_tokenlist_to_tstring(p, 1, &l, 0, 0, 0);
+ ls.size = (size_t) l;
+ if (ls.size > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int i;
+ int top = lua_gettop(L);
+ lua_pushcfunction(L, lmt_traceback);
+ i = lua_load(L, tokenlib_aux_reader, &ls, "=[\\directlua]", NULL);
+ if (i != 0) {
+ lmt_error(L, "token call, syntax", -1, i == LUA_ERRSYNTAX ? 0 : 1);
+ } else {
+ ++lmt_lua_state.direct_callback_count;
+ i = lua_pcall(L, 0, 0, top + 1);
+ if (i != 0) {
+ lua_remove(L, top + 1);
+ lmt_error(L, "token call, execute", -1, i == LUA_ERRRUN ? 0 : 1);
+ }
+ }
+ lua_settop(L, top);
+ }
+}
+
+void lmt_function_call(int slot, int prefix) /*tex Functions are collected in an indexed table. */
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_lua_state.function_table_id);
+ lua_pushcfunction(L, lmt_traceback);
+ if (lua_rawgeti(L, -2, slot) == LUA_TFUNCTION) {
+ int i = 1;
+ /*tex function index */
+ lua_pushinteger(L, slot);
+ if (prefix > 0) {
+ lua_pushinteger(L, prefix);
+ ++i;
+ }
+ ++lmt_lua_state.function_callback_count;
+ i = lua_pcall(L, i, 0, stacktop + 2);
+ if (i) {
+ lua_remove(L, stacktop + 2);
+ lmt_error(L, "registered function call", slot, i == LUA_ERRRUN ? 0 : 1);
+ }
+ }
+ lua_settop(L, stacktop);
+}
+
+void lmt_local_call(int slot)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ int stacktop = lua_gettop(L);
+ lua_pushcfunction(L, lmt_traceback);
+ if (lua_rawgeti(L, LUA_REGISTRYINDEX, slot) == LUA_TFUNCTION) {
+ int i;
+ ++lmt_lua_state.local_callback_count;
+ i = lua_pcall(L, 0, 0, stacktop + 1);
+ if (i) {
+ lua_remove(L, stacktop + 1);
+ lmt_error(L, "local function call", slot, i == LUA_ERRRUN ? 0 : 1);
+ }
+ }
+ lua_settop(L, stacktop);
+}
+
+int lmt_function_call_by_class(int slot, int property, halfword *value)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ int stacktop = lua_gettop(L);
+ int class = lua_value_none_code;
+ lua_pushcfunction(L, lmt_traceback);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_lua_state.function_table_id);
+ if (lua_rawgeti(L, -1, slot) == LUA_TFUNCTION) {
+ int i;
+ /*tex function index */
+ lua_pushinteger(L, slot);
+ if (property) {
+ lua_pushinteger(L, property);
+ } else {
+ lua_push_key(value);
+ }
+ ++lmt_lua_state.value_callback_count;
+ i = lua_pcall(L, 2, 2, stacktop + 1);
+ if (i) {
+ lua_remove(L, stacktop + 1);
+ lmt_error(L, "function call", slot, i == LUA_ERRRUN ? 0 : 1);
+ } else {
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ class = lmt_tointeger(L, -2);
+ }
+ switch (class) {
+ case lua_value_none_code:
+ {
+ break;
+ }
+ case lua_value_integer_code:
+ {
+ *value = lua_type(L, -1) == LUA_TNUMBER ? lmt_tohalfword(L, -1) : 0;
+ if (*value < - max_integer) {
+ *value = max_integer;
+ } else if (*value > max_integer) {
+ *value = max_integer;
+ }
+ break;
+ }
+ case lua_value_cardinal_code:
+ {
+ lua_Unsigned u = lua_type(L, -1) == LUA_TNUMBER ? (lua_Unsigned) lua_tointeger(L, -1) : 0;
+ if (u > max_cardinal) {
+ u = max_cardinal;
+ }
+ if (*value > max_integer) {
+ *value = (halfword) (u - 0x100000000);
+ } else {
+ *value = (halfword) u;
+ }
+ break;
+ }
+ case lua_value_dimension_code:
+ {
+ *value = lua_type(L, -1) == LUA_TNUMBER ? lmt_tohalfword(L, -1) : 0;
+ if (*value < - max_dimen) {
+ *value = max_dimen;
+ } else if (*value > max_dimen) {
+ *value = max_dimen;
+ }
+ break;
+ }
+ case lua_value_skip_code:
+ {
+ halfword n = lmt_check_isnode(L, -1);
+ if (n && node_type(n) == glue_spec_node) {
+ *value = n;
+ } else {
+ luaL_error(L, "gluespec node expected");
+ *value = tex_copy_node(zero_glue);
+ }
+ break;
+ }
+ case lua_value_float_code:
+ case lua_value_string_code:
+ {
+ class = lua_value_none_code;
+ break;
+ }
+ case lua_value_boolean_code:
+ {
+ *value = lua_toboolean(L, -1);
+ break;
+ }
+ case lua_value_node_code:
+ {
+ *value = lmt_check_isnode(L, -1);
+ break;
+ }
+ case lua_value_direct_code:
+ *value = lmt_check_isdirect(L, -1);
+ break;
+ default:
+ {
+ class = lua_value_none_code;
+ break;
+ }
+ }
+ }
+ }
+ lua_settop(L, stacktop);
+ return class;
+}
+
+/* some day maybe an alternative too
+
+void lmt_function_call(int slot)
+{
+ lua_State *L = lua_state.lua_instance;
+ int stacktop = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lua_state.function_table_id);
+ if (lua_rawgeti(L, -1, slot) == LUA_TFUNCTION) {
+ lua_pushinteger(L, slot);
+ ++lua_state.function_callback_count;
+ lua_call(L, 1, 0);
+ }
+ lua_settop(L,stacktop);
+}
+
+*/
+
+int lmt_push_specification(lua_State *L, halfword ptr, int onlycount)
+{
+ if (ptr) {
+ switch (node_subtype(ptr)) {
+ case par_shape_code:
+ {
+ int n = specification_count(ptr);
+ if (onlycount == 1) {
+ lua_pushinteger(L, n);
+ } else {
+ int r = specification_repeat(ptr);
+ lua_createtable(L, n, r ? 1 : 0);
+ if (r) {
+ lua_push_boolean_at_key(L, repeat, r);
+ }
+ for (int m = 1; m <= n; m++) {
+ lua_createtable(L, 2, 0);
+ lua_pushinteger(L, tex_get_specification_indent(ptr, m));
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, tex_get_specification_width(ptr, m));
+ lua_rawseti(L, -2, 2);
+ lua_rawseti(L, -2, m);
+ }
+ }
+ return 1;
+ }
+ case inter_line_penalties_code:
+ case club_penalties_code:
+ case widow_penalties_code:
+ case display_widow_penalties_code:
+ case orphan_penalties_code:
+ case math_forward_penalties_code:
+ case math_backward_penalties_code:
+ {
+ int n = specification_count(ptr);
+ if (onlycount == 1) {
+ lua_pushinteger(L, n);
+ } else {
+ lua_createtable(L, n, 0);
+ for (int m = 1; m <= n; m++) {
+ lua_pushinteger(L, tex_get_specification_penalty(ptr, m));
+ lua_rawseti(L, -2, m);
+ }
+ }
+ return 1;
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
diff --git a/source/luametatex/source/lua/lmttokenlib.h b/source/luametatex/source/lua/lmttokenlib.h
new file mode 100644
index 000000000..5339a80fe
--- /dev/null
+++ b/source/luametatex/source/lua/lmttokenlib.h
@@ -0,0 +1,52 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LTOKENLIB_H
+# define LMT_LTOKENLIB_H
+
+typedef enum token_origins {
+ token_origin_lua,
+ token_origin_tex,
+} token_origins;
+
+typedef struct lua_token {
+ int token;
+ token_origins origin;
+} lua_token;
+
+typedef enum command_item_types {
+ unused_command_item,
+ regular_command_item,
+ character_command_item,
+ register_command_item,
+ internal_command_item,
+ reference_command_item,
+ data_command_item,
+ token_command_item,
+ node_command_item,
+} command_item_types;
+
+extern void lmt_token_list_to_lua (lua_State *L, halfword p);
+extern void lmt_token_list_to_luastring (lua_State *L, halfword p, int nospace, int strip);
+extern halfword lmt_token_list_from_lua (lua_State *L, int slot);
+extern halfword lmt_token_code_from_lua (lua_State *L, int slot);
+
+extern void lmt_function_call (int slot, int prefix);
+extern int lmt_function_call_by_class (int slot, int property, halfword *value);
+extern void lmt_token_call (int p);
+extern void lmt_local_call (int slot);
+
+extern char *lmt_get_expansion (halfword head, int *len);
+
+extern void lmt_token_register_to_lua (lua_State *L, halfword t);
+
+extern void lmt_tokenlib_initialize (void);
+
+extern int lmt_push_specification (lua_State *L, halfword ptr, int onlycount);
+
+extern void lmt_push_cmd_name (lua_State *L, int cmd);
+
+extern halfword lmt_macro_to_tok (lua_State* L, int slot, halfword *tail);
+
+# endif
diff --git a/source/luametatex/source/luacore/lua54/originals/lctype.h b/source/luametatex/source/luacore/lua54/originals/lctype.h
new file mode 100644
index 000000000..6e6a5096c
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/originals/lctype.h
@@ -0,0 +1,98 @@
+/*
+** $Id: lctype.h,v 1.13 2018/06/18 12:51:05 roberto Exp $
+** 'ctype' functions for Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lctype_h
+#define lctype_h
+
+#include "lua.h"
+
+
+/*
+** WARNING: the functions defined here do not necessarily correspond
+** to the similar functions in the standard C ctype.h. They are
+** optimized for the specific needs of Lua
+*/
+
+#if !defined(LUA_USE_CTYPE)
+
+#if 'A' == 65 && '0' == 48
+/* ASCII case: can use its own tables; faster and fixed */
+#define LUA_USE_CTYPE 0
+#else
+/* must use standard C ctype */
+#define LUA_USE_CTYPE 1
+#endif
+
+#endif
+
+
+#if !LUA_USE_CTYPE /* { */
+
+#include <limits.h>
+
+#include "llimits.h"
+
+
+#define ALPHABIT 0
+#define DIGITBIT 1
+#define PRINTBIT 2
+#define SPACEBIT 3
+#define XDIGITBIT 4
+
+
+#define MASK(B) (1 << (B))
+
+
+/*
+** add 1 to char to allow index -1 (EOZ)
+*/
+#define testprop(c,p) (luai_ctype_[(c)+1] & (p))
+
+/*
+** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_'
+*/
+//#define lislalpha(c) testprop(c, MASK(ALPHABIT))
+//#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT)))
+#define lisdigit(c) testprop(c, MASK(DIGITBIT))
+#define lisspace(c) testprop(c, MASK(SPACEBIT))
+#define lisprint(c) testprop(c, MASK(PRINTBIT))
+#define lisxdigit(c) testprop(c, MASK(XDIGITBIT))
+
+#define lislalpha(c) (testprop(c, MASK(ALPHABIT)) || (c) > 0x7f)
+#define lislalnum(c) (testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT))) || (c) > 0x7f)
+
+/*
+** this 'ltolower' only works for alphabetic characters
+*/
+#define ltolower(c) ((c) | ('A' ^ 'a'))
+
+
+/* two more entries for 0 and -1 (EOZ) */
+LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
+
+
+#else /* }{ */
+
+/*
+** use standard C ctypes
+*/
+
+#include <ctype.h>
+
+
+#define lislalpha(c) (isalpha(c) || (c) == '_')
+#define lislalnum(c) (isalnum(c) || (c) == '_')
+#define lisdigit(c) (isdigit(c))
+#define lisspace(c) (isspace(c))
+#define lisprint(c) (isprint(c))
+#define lisxdigit(c) (isxdigit(c))
+
+#define ltolower(c) (tolower(c))
+
+#endif /* } */
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/originals/patches.txt b/source/luametatex/source/luacore/lua54/originals/patches.txt
new file mode 100644
index 000000000..8a3fc4363
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/originals/patches.txt
@@ -0,0 +1,11 @@
+--------------------------------------------------------------------------------------
+lctype.h : no longer needed as we dan use -DLUA_UCID now
+--------------------------------------------------------------------------------------
+
+/* lislalpha(c) testprop(c, MASK(ALPHABIT)) */
+/* lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT))) */
+
+# define lislalpha(c) (testprop(c, MASK(ALPHABIT)) || (c) > 0x7f)
+# define lislalnum(c) (testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT))) || (c) > 0x7f)
+
+--------------------------------------------------------------------------------------
diff --git a/source/luametatex/source/luacore/lua54/readme.txt b/source/luametatex/source/luacore/lua54/readme.txt
new file mode 100644
index 000000000..5637f04ae
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/readme.txt
@@ -0,0 +1,8 @@
+This is Lua 5.4 as taken from: https://github.com/lua/lua.git (intermediate releases). For
+installation instructions, license details, and further information about Lua, see the
+documentation of LUA.
+
+There is a pitfall in using release candidates: when the bytecode organization changes
+we can get crashes. At some point the luac version became an integer so we could encode
+a subnumber but that was reverted to a byte. This means that we again can get crashes
+(unless we mess a bit with that byte). It makes usage a bit fragile but so be it.
diff --git a/source/luametatex/source/luacore/lua54/src/Makefile b/source/luametatex/source/luacore/lua54/src/Makefile
new file mode 100644
index 000000000..d46e650cb
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/Makefile
@@ -0,0 +1,206 @@
+# Developer's makefile for building Lua
+# see luaconf.h for further customization
+
+# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT =======================
+
+# Warnings valid for both C and C++
+CWARNSCPP= \
+ -Wfatal-errors \
+ -Wextra \
+ -Wshadow \
+ -Wsign-compare \
+ -Wundef \
+ -Wwrite-strings \
+ -Wredundant-decls \
+ -Wdisabled-optimization \
+ -Wdouble-promotion \
+ -Wmissing-declarations \
+ # the next warnings might be useful sometimes,
+ # but usually they generate too much noise
+ # -Werror \
+ # -pedantic # warns if we use jump tables \
+ # -Wconversion \
+ # -Wsign-conversion \
+ # -Wstrict-overflow=2 \
+ # -Wformat=2 \
+ # -Wcast-qual \
+
+
+# Warnings for gcc, not valid for clang
+CWARNGCC= \
+ -Wlogical-op \
+ -Wno-aggressive-loop-optimizations \
+
+
+# The next warnings are neither valid nor needed for C++
+CWARNSC= -Wdeclaration-after-statement \
+ -Wmissing-prototypes \
+ -Wnested-externs \
+ -Wstrict-prototypes \
+ -Wc++-compat \
+ -Wold-style-definition \
+
+
+CWARNS= $(CWARNSCPP) $(CWARNSC) $(CWARNGCC)
+
+# Some useful compiler options for internal tests:
+# -DLUAI_ASSERT turns on all assertions inside Lua.
+# -DHARDSTACKTESTS forces a reallocation of the stack at every point where
+# the stack can be reallocated.
+# -DHARDMEMTESTS forces a full collection at all points where the collector
+# can run.
+# -DEMERGENCYGCTESTS forces an emergency collection at every single allocation.
+# -DEXTERNMEMCHECK removes internal consistency checking of blocks being
+# deallocated (useful when an external tool like valgrind does the check).
+# -DMAXINDEXRK=k limits range of constants in RK instruction operands.
+# -DLUA_COMPAT_5_3
+
+# -pg -malign-double
+# -DLUA_USE_CTYPE -DLUA_USE_APICHECK
+# ('-ftrapv' for runtime checks of integer overflows)
+# -fsanitize=undefined -ftrapv -fno-inline
+# TESTS= -DLUA_USER_H='"ltests.h"' -O0 -g
+
+
+LOCAL = $(TESTS) $(CWARNS)
+
+
+# enable Linux goodies
+MYCFLAGS= $(LOCAL) -std=c99 -DLUA_USE_LINUX -DLUA_USE_READLINE
+MYLDFLAGS= $(LOCAL) -Wl,-E
+MYLIBS= -ldl -lreadline
+
+
+CC= gcc
+CFLAGS= -Wall -O2 $(MYCFLAGS) -fno-stack-protector -fno-common -march=native
+AR= ar rc
+RANLIB= ranlib
+RM= rm -f
+
+
+
+# == END OF USER SETTINGS. NO NEED TO CHANGE ANYTHING BELOW THIS LINE =========
+
+
+LIBS = -lm
+
+CORE_T= liblua.a
+CORE_O= lapi.o lcode.o lctype.o ldebug.o ldo.o ldump.o lfunc.o lgc.o llex.o \
+ lmem.o lobject.o lopcodes.o lparser.o lstate.o lstring.o ltable.o \
+ ltm.o lundump.o lvm.o lzio.o ltests.o
+AUX_O= lauxlib.o
+LIB_O= lbaselib.o ldblib.o liolib.o lmathlib.o loslib.o ltablib.o lstrlib.o \
+ lutf8lib.o loadlib.o lcorolib.o linit.o
+
+LUA_T= lua
+LUA_O= lua.o
+
+
+ALL_T= $(CORE_T) $(LUA_T)
+ALL_O= $(CORE_O) $(LUA_O) $(AUX_O) $(LIB_O)
+ALL_A= $(CORE_T)
+
+all: $(ALL_T)
+ touch all
+
+o: $(ALL_O)
+
+a: $(ALL_A)
+
+$(CORE_T): $(CORE_O) $(AUX_O) $(LIB_O)
+ $(AR) $@ $?
+ $(RANLIB) $@
+
+$(LUA_T): $(LUA_O) $(CORE_T)
+ $(CC) -o $@ $(MYLDFLAGS) $(LUA_O) $(CORE_T) $(LIBS) $(MYLIBS) $(DL)
+
+
+clean:
+ $(RM) $(ALL_T) $(ALL_O)
+
+depend:
+ @$(CC) $(CFLAGS) -MM *.c
+
+echo:
+ @echo "CC = $(CC)"
+ @echo "CFLAGS = $(CFLAGS)"
+ @echo "AR = $(AR)"
+ @echo "RANLIB = $(RANLIB)"
+ @echo "RM = $(RM)"
+ @echo "MYCFLAGS = $(MYCFLAGS)"
+ @echo "MYLDFLAGS = $(MYLDFLAGS)"
+ @echo "MYLIBS = $(MYLIBS)"
+ @echo "DL = $(DL)"
+
+$(ALL_O): makefile ltests.h
+
+# DO NOT EDIT
+# automatically made with 'gcc -MM l*.c'
+
+lapi.o: lapi.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
+ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h \
+ ltable.h lundump.h lvm.h
+lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h
+lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lcode.o: lcode.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
+ llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
+ ldo.h lgc.h lstring.h ltable.h lvm.h
+lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lctype.o: lctype.c lprefix.h lctype.h lua.h luaconf.h llimits.h
+ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+ldebug.o: ldebug.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
+ lobject.h ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h \
+ ldebug.h ldo.h lfunc.h lstring.h lgc.h ltable.h lvm.h
+ldo.o: ldo.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
+ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \
+ lparser.h lstring.h ltable.h lundump.h lvm.h
+ldump.o: ldump.c lprefix.h lua.h luaconf.h lobject.h llimits.h lstate.h \
+ ltm.h lzio.h lmem.h lundump.h
+lfunc.o: lfunc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h
+lgc.o: lgc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h
+linit.o: linit.c lprefix.h lua.h luaconf.h lualib.h lauxlib.h
+liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+llex.o: llex.c lprefix.h lua.h luaconf.h lctype.h llimits.h ldebug.h \
+ lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lgc.h llex.h lparser.h \
+ lstring.h ltable.h
+lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lmem.o: lmem.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h
+loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lobject.o: lobject.c lprefix.h lua.h luaconf.h lctype.h llimits.h \
+ ldebug.h lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h \
+ lvm.h
+lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h
+loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lparser.o: lparser.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
+ llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
+ ldo.h lfunc.h lstring.h lgc.h ltable.h
+lstate.o: lstate.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
+ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h llex.h \
+ lstring.h ltable.h
+lstring.o: lstring.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
+ lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h
+lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+ltable.o: ltable.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
+ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+ltests.o: ltests.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
+ lobject.h ltm.h lzio.h lmem.h lauxlib.h lcode.h llex.h lopcodes.h \
+ lparser.h lctype.h ldebug.h ldo.h lfunc.h lopnames.h lstring.h lgc.h \
+ ltable.h lualib.h
+ltm.o: ltm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
+lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lundump.o: lundump.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
+ lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h \
+ lundump.h
+lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
+lvm.o: lvm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h \
+ ltable.h lvm.h ljumptab.h
+lzio.o: lzio.c lprefix.h lua.h luaconf.h llimits.h lmem.h lstate.h \
+ lobject.h ltm.h lzio.h
+
+# (end of Makefile)
diff --git a/source/luametatex/source/luacore/lua54/src/lapi.c b/source/luametatex/source/luacore/lua54/src/lapi.c
new file mode 100644
index 000000000..5833c7b0a
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lapi.c
@@ -0,0 +1,1460 @@
+/*
+** $Id: lapi.c $
+** Lua API
+** See Copyright Notice in lua.h
+*/
+
+#define lapi_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <limits.h>
+#include <stdarg.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lapi.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lundump.h"
+#include "lvm.h"
+
+
+
+const char lua_ident[] =
+ "$LuaVersion: " LUA_COPYRIGHT " $"
+ "$LuaAuthors: " LUA_AUTHORS " $";
+
+
+
+/*
+** Test for a valid index (one that is not the 'nilvalue').
+** '!ttisnil(o)' implies 'o != &G(L)->nilvalue', so it is not needed.
+** However, it covers the most common cases in a faster way.
+*/
+#define isvalid(L, o) (!ttisnil(o) || o != &G(L)->nilvalue)
+
+
+/* test for pseudo index */
+#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX)
+
+/* test for upvalue */
+#define isupvalue(i) ((i) < LUA_REGISTRYINDEX)
+
+
+/*
+** Convert an acceptable index to a pointer to its respective value.
+** Non-valid indices return the special nil value 'G(L)->nilvalue'.
+*/
+static TValue *index2value (lua_State *L, int idx) {
+ CallInfo *ci = L->ci;
+ if (idx > 0) {
+ StkId o = ci->func + idx;
+ api_check(L, idx <= L->ci->top - (ci->func + 1), "unacceptable index");
+ if (o >= L->top) return &G(L)->nilvalue;
+ else return s2v(o);
+ }
+ else if (!ispseudo(idx)) { /* negative index */
+ api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
+ return s2v(L->top + idx);
+ }
+ else if (idx == LUA_REGISTRYINDEX)
+ return &G(L)->l_registry;
+ else { /* upvalues */
+ idx = LUA_REGISTRYINDEX - idx;
+ api_check(L, idx <= MAXUPVAL + 1, "upvalue index too large");
+ if (ttisCclosure(s2v(ci->func))) { /* C closure? */
+ CClosure *func = clCvalue(s2v(ci->func));
+ return (idx <= func->nupvalues) ? &func->upvalue[idx-1]
+ : &G(L)->nilvalue;
+ }
+ else { /* light C function or Lua function (through a hook)?) */
+ api_check(L, ttislcf(s2v(ci->func)), "caller not a C function");
+ return &G(L)->nilvalue; /* no upvalues */
+ }
+ }
+}
+
+
+
+/*
+** Convert a valid actual index (not a pseudo-index) to its address.
+*/
+l_sinline StkId index2stack (lua_State *L, int idx) {
+ CallInfo *ci = L->ci;
+ if (idx > 0) {
+ StkId o = ci->func + idx;
+ api_check(L, o < L->top, "invalid index");
+ return o;
+ }
+ else { /* non-positive index */
+ api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
+ api_check(L, !ispseudo(idx), "invalid index");
+ return L->top + idx;
+ }
+}
+
+
+LUA_API int lua_checkstack (lua_State *L, int n) {
+ int res;
+ CallInfo *ci;
+ lua_lock(L);
+ ci = L->ci;
+ api_check(L, n >= 0, "negative 'n'");
+ if (L->stack_last - L->top > n) /* stack large enough? */
+ res = 1; /* yes; check is OK */
+ else /* need to grow stack */
+ res = luaD_growstack(L, n, 0);
+ if (res && ci->top < L->top + n)
+ ci->top = L->top + n; /* adjust frame top */
+ lua_unlock(L);
+ return res;
+}
+
+
+LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {
+ int i;
+ if (from == to) return;
+ lua_lock(to);
+ api_checknelems(from, n);
+ api_check(from, G(from) == G(to), "moving among independent states");
+ api_check(from, to->ci->top - to->top >= n, "stack overflow");
+ from->top -= n;
+ for (i = 0; i < n; i++) {
+ setobjs2s(to, to->top, from->top + i);
+ to->top++; /* stack already checked by previous 'api_check' */
+ }
+ lua_unlock(to);
+}
+
+
+LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
+ lua_CFunction old;
+ lua_lock(L);
+ old = G(L)->panic;
+ G(L)->panic = panicf;
+ lua_unlock(L);
+ return old;
+}
+
+
+LUA_API lua_Number lua_version (lua_State *L) {
+ UNUSED(L);
+ return LUA_VERSION_NUM;
+}
+
+
+
+/*
+** basic stack manipulation
+*/
+
+
+/*
+** convert an acceptable stack index into an absolute index
+*/
+LUA_API int lua_absindex (lua_State *L, int idx) {
+ return (idx > 0 || ispseudo(idx))
+ ? idx
+ : cast_int(L->top - L->ci->func) + idx;
+}
+
+
+LUA_API int lua_gettop (lua_State *L) {
+ return cast_int(L->top - (L->ci->func + 1));
+}
+
+
+LUA_API void lua_settop (lua_State *L, int idx) {
+ CallInfo *ci;
+ StkId func, newtop;
+ ptrdiff_t diff; /* difference for new top */
+ lua_lock(L);
+ ci = L->ci;
+ func = ci->func;
+ if (idx >= 0) {
+ api_check(L, idx <= ci->top - (func + 1), "new top too large");
+ diff = ((func + 1) + idx) - L->top;
+ for (; diff > 0; diff--)
+ setnilvalue(s2v(L->top++)); /* clear new slots */
+ }
+ else {
+ api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top");
+ diff = idx + 1; /* will "subtract" index (as it is negative) */
+ }
+ api_check(L, L->tbclist < L->top, "previous pop of an unclosed slot");
+ newtop = L->top + diff;
+ if (diff < 0 && L->tbclist >= newtop) {
+ lua_assert(hastocloseCfunc(ci->nresults));
+ newtop = luaF_close(L, newtop, CLOSEKTOP, 0);
+ }
+ L->top = newtop; /* correct top only after closing any upvalue */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_closeslot (lua_State *L, int idx) {
+ StkId level;
+ lua_lock(L);
+ level = index2stack(L, idx);
+ api_check(L, hastocloseCfunc(L->ci->nresults) && L->tbclist == level,
+ "no variable to close at given level");
+ level = luaF_close(L, level, CLOSEKTOP, 0);
+ setnilvalue(s2v(level));
+ lua_unlock(L);
+}
+
+
+/*
+** Reverse the stack segment from 'from' to 'to'
+** (auxiliary to 'lua_rotate')
+** Note that we move(copy) only the value inside the stack.
+** (We do not move additional fields that may exist.)
+*/
+l_sinline void reverse (lua_State *L, StkId from, StkId to) {
+ for (; from < to; from++, to--) {
+ TValue temp;
+ setobj(L, &temp, s2v(from));
+ setobjs2s(L, from, to);
+ setobj2s(L, to, &temp);
+ }
+}
+
+
+/*
+** Let x = AB, where A is a prefix of length 'n'. Then,
+** rotate x n == BA. But BA == (A^r . B^r)^r.
+*/
+LUA_API void lua_rotate (lua_State *L, int idx, int n) {
+ StkId p, t, m;
+ lua_lock(L);
+ t = L->top - 1; /* end of stack segment being rotated */
+ p = index2stack(L, idx); /* start of segment */
+ api_check(L, (n >= 0 ? n : -n) <= (t - p + 1), "invalid 'n'");
+ m = (n >= 0 ? t - n : p - n - 1); /* end of prefix */
+ reverse(L, p, m); /* reverse the prefix with length 'n' */
+ reverse(L, m + 1, t); /* reverse the suffix */
+ reverse(L, p, t); /* reverse the entire segment */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) {
+ TValue *fr, *to;
+ lua_lock(L);
+ fr = index2value(L, fromidx);
+ to = index2value(L, toidx);
+ api_check(L, isvalid(L, to), "invalid index");
+ setobj(L, to, fr);
+ if (isupvalue(toidx)) /* function upvalue? */
+ luaC_barrier(L, clCvalue(s2v(L->ci->func)), fr);
+ /* LUA_REGISTRYINDEX does not need gc barrier
+ (collector revisits it before finishing collection) */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushvalue (lua_State *L, int idx) {
+ lua_lock(L);
+ setobj2s(L, L->top, index2value(L, idx));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+
+/*
+** access functions (stack -> C)
+*/
+
+
+LUA_API int lua_type (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return (isvalid(L, o) ? ttype(o) : LUA_TNONE);
+}
+
+
+LUA_API const char *lua_typename (lua_State *L, int t) {
+ UNUSED(L);
+ api_check(L, LUA_TNONE <= t && t < LUA_NUMTYPES, "invalid type");
+ return ttypename(t);
+}
+
+
+LUA_API int lua_iscfunction (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return (ttislcf(o) || (ttisCclosure(o)));
+}
+
+
+LUA_API int lua_isinteger (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return ttisinteger(o);
+}
+
+
+LUA_API int lua_isnumber (lua_State *L, int idx) {
+ lua_Number n;
+ const TValue *o = index2value(L, idx);
+ return tonumber(o, &n);
+}
+
+
+LUA_API int lua_isstring (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return (ttisstring(o) || cvt2str(o));
+}
+
+
+LUA_API int lua_isuserdata (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return (ttisfulluserdata(o) || ttislightuserdata(o));
+}
+
+
+LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
+ const TValue *o1 = index2value(L, index1);
+ const TValue *o2 = index2value(L, index2);
+ return (isvalid(L, o1) && isvalid(L, o2)) ? luaV_rawequalobj(o1, o2) : 0;
+}
+
+
+LUA_API void lua_arith (lua_State *L, int op) {
+ lua_lock(L);
+ if (op != LUA_OPUNM && op != LUA_OPBNOT)
+ api_checknelems(L, 2); /* all other operations expect two operands */
+ else { /* for unary operations, add fake 2nd operand */
+ api_checknelems(L, 1);
+ setobjs2s(L, L->top, L->top - 1);
+ api_incr_top(L);
+ }
+ /* first operand at top - 2, second at top - 1; result go to top - 2 */
+ luaO_arith(L, op, s2v(L->top - 2), s2v(L->top - 1), L->top - 2);
+ L->top--; /* remove second operand */
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) {
+ const TValue *o1;
+ const TValue *o2;
+ int i = 0;
+ lua_lock(L); /* may call tag method */
+ o1 = index2value(L, index1);
+ o2 = index2value(L, index2);
+ if (isvalid(L, o1) && isvalid(L, o2)) {
+ switch (op) {
+ case LUA_OPEQ: i = luaV_equalobj(L, o1, o2); break;
+ case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break;
+ case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break;
+ default: api_check(L, 0, "invalid option");
+ }
+ }
+ lua_unlock(L);
+ return i;
+}
+
+
+LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) {
+ size_t sz = luaO_str2num(s, s2v(L->top));
+ if (sz != 0)
+ api_incr_top(L);
+ return sz;
+}
+
+
+LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *pisnum) {
+ lua_Number n = 0;
+ const TValue *o = index2value(L, idx);
+ int isnum = tonumber(o, &n);
+ if (pisnum)
+ *pisnum = isnum;
+ return n;
+}
+
+
+LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *pisnum) {
+ lua_Integer res = 0;
+ const TValue *o = index2value(L, idx);
+ int isnum = tointeger(o, &res);
+ if (pisnum)
+ *pisnum = isnum;
+ return res;
+}
+
+
+LUA_API int lua_toboolean (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return !l_isfalse(o);
+}
+
+
+LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {
+ TValue *o;
+ lua_lock(L);
+ o = index2value(L, idx);
+ if (!ttisstring(o)) {
+ if (!cvt2str(o)) { /* not convertible? */
+ if (len != NULL) *len = 0;
+ lua_unlock(L);
+ return NULL;
+ }
+ luaO_tostring(L, o);
+ luaC_checkGC(L);
+ o = index2value(L, idx); /* previous call may reallocate the stack */
+ }
+ if (len != NULL)
+ *len = vslen(o);
+ lua_unlock(L);
+ return svalue(o);
+}
+
+
+LUA_API lua_Unsigned lua_rawlen (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ switch (ttypetag(o)) {
+ case LUA_VSHRSTR: return tsvalue(o)->shrlen;
+ case LUA_VLNGSTR: return tsvalue(o)->u.lnglen;
+ case LUA_VUSERDATA: return uvalue(o)->len;
+ case LUA_VTABLE: return luaH_getn(hvalue(o));
+ default: return 0;
+ }
+}
+
+
+LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ if (ttislcf(o)) return fvalue(o);
+ else if (ttisCclosure(o))
+ return clCvalue(o)->f;
+ else return NULL; /* not a C function */
+}
+
+
+l_sinline void *touserdata (const TValue *o) {
+ switch (ttype(o)) {
+ case LUA_TUSERDATA: return getudatamem(uvalue(o));
+ case LUA_TLIGHTUSERDATA: return pvalue(o);
+ default: return NULL;
+ }
+}
+
+
+LUA_API void *lua_touserdata (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return touserdata(o);
+}
+
+
+LUA_API lua_State *lua_tothread (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return (!ttisthread(o)) ? NULL : thvalue(o);
+}
+
+
+/*
+** Returns a pointer to the internal representation of an object.
+** Note that ANSI C does not allow the conversion of a pointer to
+** function to a 'void*', so the conversion here goes through
+** a 'size_t'. (As the returned pointer is only informative, this
+** conversion should not be a problem.)
+*/
+LUA_API const void *lua_topointer (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ switch (ttypetag(o)) {
+ case LUA_VLCF: return cast_voidp(cast_sizet(fvalue(o)));
+ case LUA_VUSERDATA: case LUA_VLIGHTUSERDATA:
+ return touserdata(o);
+ default: {
+ if (iscollectable(o))
+ return gcvalue(o);
+ else
+ return NULL;
+ }
+ }
+}
+
+
+
+/*
+** push functions (C -> stack)
+*/
+
+
+LUA_API void lua_pushnil (lua_State *L) {
+ lua_lock(L);
+ setnilvalue(s2v(L->top));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
+ lua_lock(L);
+ setfltvalue(s2v(L->top), n);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {
+ lua_lock(L);
+ setivalue(s2v(L->top), n);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+/*
+** Pushes on the stack a string with given length. Avoid using 's' when
+** 'len' == 0 (as 's' can be NULL in that case), due to later use of
+** 'memcmp' and 'memcpy'.
+*/
+LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) {
+ TString *ts;
+ lua_lock(L);
+ ts = (len == 0) ? luaS_new(L, "") : luaS_newlstr(L, s, len);
+ setsvalue2s(L, L->top, ts);
+ api_incr_top(L);
+ luaC_checkGC(L);
+ lua_unlock(L);
+ return getstr(ts);
+}
+
+
+LUA_API const char *lua_pushstring (lua_State *L, const char *s) {
+ lua_lock(L);
+ if (s == NULL)
+ setnilvalue(s2v(L->top));
+ else {
+ TString *ts;
+ ts = luaS_new(L, s);
+ setsvalue2s(L, L->top, ts);
+ s = getstr(ts); /* internal copy's address */
+ }
+ api_incr_top(L);
+ luaC_checkGC(L);
+ lua_unlock(L);
+ return s;
+}
+
+
+LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,
+ va_list argp) {
+ const char *ret;
+ lua_lock(L);
+ ret = luaO_pushvfstring(L, fmt, argp);
+ luaC_checkGC(L);
+ lua_unlock(L);
+ return ret;
+}
+
+
+LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {
+ const char *ret;
+ va_list argp;
+ lua_lock(L);
+ va_start(argp, fmt);
+ ret = luaO_pushvfstring(L, fmt, argp);
+ va_end(argp);
+ luaC_checkGC(L);
+ lua_unlock(L);
+ return ret;
+}
+
+
+LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
+ lua_lock(L);
+ if (n == 0) {
+ setfvalue(s2v(L->top), fn);
+ api_incr_top(L);
+ }
+ else {
+ CClosure *cl;
+ api_checknelems(L, n);
+ api_check(L, n <= MAXUPVAL, "upvalue index too large");
+ cl = luaF_newCclosure(L, n);
+ cl->f = fn;
+ L->top -= n;
+ while (n--) {
+ setobj2n(L, &cl->upvalue[n], s2v(L->top + n));
+ /* does not need barrier because closure is white */
+ lua_assert(iswhite(cl));
+ }
+ setclCvalue(L, s2v(L->top), cl);
+ api_incr_top(L);
+ luaC_checkGC(L);
+ }
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushboolean (lua_State *L, int b) {
+ lua_lock(L);
+ if (b)
+ setbtvalue(s2v(L->top));
+ else
+ setbfvalue(s2v(L->top));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {
+ lua_lock(L);
+ setpvalue(s2v(L->top), p);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_pushthread (lua_State *L) {
+ lua_lock(L);
+ setthvalue(L, s2v(L->top), L);
+ api_incr_top(L);
+ lua_unlock(L);
+ return (G(L)->mainthread == L);
+}
+
+
+
+/*
+** get functions (Lua -> stack)
+*/
+
+
+l_sinline int auxgetstr (lua_State *L, const TValue *t, const char *k) {
+ const TValue *slot;
+ TString *str = luaS_new(L, k);
+ if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
+ setobj2s(L, L->top, slot);
+ api_incr_top(L);
+ }
+ else {
+ setsvalue2s(L, L->top, str);
+ api_incr_top(L);
+ luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
+ }
+ lua_unlock(L);
+ return ttype(s2v(L->top - 1));
+}
+
+
+/*
+** Get the global table in the registry. Since all predefined
+** indices in the registry were inserted right when the registry
+** was created and never removed, they must always be in the array
+** part of the registry.
+*/
+#define getGtable(L) \
+ (&hvalue(&G(L)->l_registry)->array[LUA_RIDX_GLOBALS - 1])
+
+
+LUA_API int lua_getglobal (lua_State *L, const char *name) {
+ const TValue *G;
+ lua_lock(L);
+ G = getGtable(L);
+ return auxgetstr(L, G, name);
+}
+
+
+LUA_API int lua_gettable (lua_State *L, int idx) {
+ const TValue *slot;
+ TValue *t;
+ lua_lock(L);
+ t = index2value(L, idx);
+ if (luaV_fastget(L, t, s2v(L->top - 1), slot, luaH_get)) {
+ setobj2s(L, L->top - 1, slot);
+ }
+ else
+ luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
+ lua_unlock(L);
+ return ttype(s2v(L->top - 1));
+}
+
+
+LUA_API int lua_getfield (lua_State *L, int idx, const char *k) {
+ lua_lock(L);
+ return auxgetstr(L, index2value(L, idx), k);
+}
+
+
+LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) {
+ TValue *t;
+ const TValue *slot;
+ lua_lock(L);
+ t = index2value(L, idx);
+ if (luaV_fastgeti(L, t, n, slot)) {
+ setobj2s(L, L->top, slot);
+ }
+ else {
+ TValue aux;
+ setivalue(&aux, n);
+ luaV_finishget(L, t, &aux, L->top, slot);
+ }
+ api_incr_top(L);
+ lua_unlock(L);
+ return ttype(s2v(L->top - 1));
+}
+
+
+l_sinline int finishrawget (lua_State *L, const TValue *val) {
+ if (isempty(val)) /* avoid copying empty items to the stack */
+ setnilvalue(s2v(L->top));
+ else
+ setobj2s(L, L->top, val);
+ api_incr_top(L);
+ lua_unlock(L);
+ return ttype(s2v(L->top - 1));
+}
+
+
+static Table *gettable (lua_State *L, int idx) {
+ TValue *t = index2value(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ return hvalue(t);
+}
+
+
+LUA_API int lua_rawget (lua_State *L, int idx) {
+ Table *t;
+ const TValue *val;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = gettable(L, idx);
+ val = luaH_get(t, s2v(L->top - 1));
+ L->top--; /* remove key */
+ return finishrawget(L, val);
+}
+
+
+LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) {
+ Table *t;
+ lua_lock(L);
+ t = gettable(L, idx);
+ return finishrawget(L, luaH_getint(t, n));
+}
+
+
+LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) {
+ Table *t;
+ TValue k;
+ lua_lock(L);
+ t = gettable(L, idx);
+ setpvalue(&k, cast_voidp(p));
+ return finishrawget(L, luaH_get(t, &k));
+}
+
+
+LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {
+ Table *t;
+ lua_lock(L);
+ t = luaH_new(L);
+ sethvalue2s(L, L->top, t);
+ api_incr_top(L);
+ if (narray > 0 || nrec > 0)
+ luaH_resize(L, t, narray, nrec);
+ luaC_checkGC(L);
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_getmetatable (lua_State *L, int objindex) {
+ const TValue *obj;
+ Table *mt;
+ int res = 0;
+ lua_lock(L);
+ obj = index2value(L, objindex);
+ switch (ttype(obj)) {
+ case LUA_TTABLE:
+ mt = hvalue(obj)->metatable;
+ break;
+ case LUA_TUSERDATA:
+ mt = uvalue(obj)->metatable;
+ break;
+ default:
+ mt = G(L)->mt[ttype(obj)];
+ break;
+ }
+ if (mt != NULL) {
+ sethvalue2s(L, L->top, mt);
+ api_incr_top(L);
+ res = 1;
+ }
+ lua_unlock(L);
+ return res;
+}
+
+
+LUA_API int lua_getiuservalue (lua_State *L, int idx, int n) {
+ TValue *o;
+ int t;
+ lua_lock(L);
+ o = index2value(L, idx);
+ api_check(L, ttisfulluserdata(o), "full userdata expected");
+ if (n <= 0 || n > uvalue(o)->nuvalue) {
+ setnilvalue(s2v(L->top));
+ t = LUA_TNONE;
+ }
+ else {
+ setobj2s(L, L->top, &uvalue(o)->uv[n - 1].uv);
+ t = ttype(s2v(L->top));
+ }
+ api_incr_top(L);
+ lua_unlock(L);
+ return t;
+}
+
+
+/*
+** set functions (stack -> Lua)
+*/
+
+/*
+** t[k] = value at the top of the stack (where 'k' is a string)
+*/
+static void auxsetstr (lua_State *L, const TValue *t, const char *k) {
+ const TValue *slot;
+ TString *str = luaS_new(L, k);
+ api_checknelems(L, 1);
+ if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
+ luaV_finishfastset(L, t, slot, s2v(L->top - 1));
+ L->top--; /* pop value */
+ }
+ else {
+ setsvalue2s(L, L->top, str); /* push 'str' (to make it a TValue) */
+ api_incr_top(L);
+ luaV_finishset(L, t, s2v(L->top - 1), s2v(L->top - 2), slot);
+ L->top -= 2; /* pop value and key */
+ }
+ lua_unlock(L); /* lock done by caller */
+}
+
+
+LUA_API void lua_setglobal (lua_State *L, const char *name) {
+ const TValue *G;
+ lua_lock(L); /* unlock done in 'auxsetstr' */
+ G = getGtable(L);
+ auxsetstr(L, G, name);
+}
+
+
+LUA_API void lua_settable (lua_State *L, int idx) {
+ TValue *t;
+ const TValue *slot;
+ lua_lock(L);
+ api_checknelems(L, 2);
+ t = index2value(L, idx);
+ if (luaV_fastget(L, t, s2v(L->top - 2), slot, luaH_get)) {
+ luaV_finishfastset(L, t, slot, s2v(L->top - 1));
+ }
+ else
+ luaV_finishset(L, t, s2v(L->top - 2), s2v(L->top - 1), slot);
+ L->top -= 2; /* pop index and value */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
+ lua_lock(L); /* unlock done in 'auxsetstr' */
+ auxsetstr(L, index2value(L, idx), k);
+}
+
+
+LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) {
+ TValue *t;
+ const TValue *slot;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = index2value(L, idx);
+ if (luaV_fastgeti(L, t, n, slot)) {
+ luaV_finishfastset(L, t, slot, s2v(L->top - 1));
+ }
+ else {
+ TValue aux;
+ setivalue(&aux, n);
+ luaV_finishset(L, t, &aux, s2v(L->top - 1), slot);
+ }
+ L->top--; /* pop value */
+ lua_unlock(L);
+}
+
+
+static void aux_rawset (lua_State *L, int idx, TValue *key, int n) {
+ Table *t;
+ lua_lock(L);
+ api_checknelems(L, n);
+ t = gettable(L, idx);
+ luaH_set(L, t, key, s2v(L->top - 1));
+ invalidateTMcache(t);
+ luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
+ L->top -= n;
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawset (lua_State *L, int idx) {
+ aux_rawset(L, idx, s2v(L->top - 2), 2);
+}
+
+
+LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) {
+ TValue k;
+ setpvalue(&k, cast_voidp(p));
+ aux_rawset(L, idx, &k, 1);
+}
+
+
+LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) {
+ Table *t;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = gettable(L, idx);
+ luaH_setint(L, t, n, s2v(L->top - 1));
+ luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
+ L->top--;
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_setmetatable (lua_State *L, int objindex) {
+ TValue *obj;
+ Table *mt;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ obj = index2value(L, objindex);
+ if (ttisnil(s2v(L->top - 1)))
+ mt = NULL;
+ else {
+ api_check(L, ttistable(s2v(L->top - 1)), "table expected");
+ mt = hvalue(s2v(L->top - 1));
+ }
+ switch (ttype(obj)) {
+ case LUA_TTABLE: {
+ hvalue(obj)->metatable = mt;
+ if (mt) {
+ luaC_objbarrier(L, gcvalue(obj), mt);
+ luaC_checkfinalizer(L, gcvalue(obj), mt);
+ }
+ break;
+ }
+ case LUA_TUSERDATA: {
+ uvalue(obj)->metatable = mt;
+ if (mt) {
+ luaC_objbarrier(L, uvalue(obj), mt);
+ luaC_checkfinalizer(L, gcvalue(obj), mt);
+ }
+ break;
+ }
+ default: {
+ G(L)->mt[ttype(obj)] = mt;
+ break;
+ }
+ }
+ L->top--;
+ lua_unlock(L);
+ return 1;
+}
+
+
+LUA_API int lua_setiuservalue (lua_State *L, int idx, int n) {
+ TValue *o;
+ int res;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ o = index2value(L, idx);
+ api_check(L, ttisfulluserdata(o), "full userdata expected");
+ if (!(cast_uint(n) - 1u < cast_uint(uvalue(o)->nuvalue)))
+ res = 0; /* 'n' not in [1, uvalue(o)->nuvalue] */
+ else {
+ setobj(L, &uvalue(o)->uv[n - 1].uv, s2v(L->top - 1));
+ luaC_barrierback(L, gcvalue(o), s2v(L->top - 1));
+ res = 1;
+ }
+ L->top--;
+ lua_unlock(L);
+ return res;
+}
+
+
+/*
+** 'load' and 'call' functions (run Lua code)
+*/
+
+
+#define checkresults(L,na,nr) \
+ api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \
+ "results from function overflow current stack size")
+
+
+LUA_API void lua_callk (lua_State *L, int nargs, int nresults,
+ lua_KContext ctx, lua_KFunction k) {
+ StkId func;
+ lua_lock(L);
+ api_check(L, k == NULL || !isLua(L->ci),
+ "cannot use continuations inside hooks");
+ api_checknelems(L, nargs+1);
+ api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
+ checkresults(L, nargs, nresults);
+ func = L->top - (nargs+1);
+ if (k != NULL && yieldable(L)) { /* need to prepare continuation? */
+ L->ci->u.c.k = k; /* save continuation */
+ L->ci->u.c.ctx = ctx; /* save context */
+ luaD_call(L, func, nresults); /* do the call */
+ }
+ else /* no continuation or no yieldable */
+ luaD_callnoyield(L, func, nresults); /* just do the call */
+ adjustresults(L, nresults);
+ lua_unlock(L);
+}
+
+
+
+/*
+** Execute a protected call.
+*/
+struct CallS { /* data to 'f_call' */
+ StkId func;
+ int nresults;
+};
+
+
+static void f_call (lua_State *L, void *ud) {
+ struct CallS *c = cast(struct CallS *, ud);
+ luaD_callnoyield(L, c->func, c->nresults);
+}
+
+
+
+LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc,
+ lua_KContext ctx, lua_KFunction k) {
+ struct CallS c;
+ int status;
+ ptrdiff_t func;
+ lua_lock(L);
+ api_check(L, k == NULL || !isLua(L->ci),
+ "cannot use continuations inside hooks");
+ api_checknelems(L, nargs+1);
+ api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
+ checkresults(L, nargs, nresults);
+ if (errfunc == 0)
+ func = 0;
+ else {
+ StkId o = index2stack(L, errfunc);
+ api_check(L, ttisfunction(s2v(o)), "error handler must be a function");
+ func = savestack(L, o);
+ }
+ c.func = L->top - (nargs+1); /* function to be called */
+ if (k == NULL || !yieldable(L)) { /* no continuation or no yieldable? */
+ c.nresults = nresults; /* do a 'conventional' protected call */
+ status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
+ }
+ else { /* prepare continuation (call is already protected by 'resume') */
+ CallInfo *ci = L->ci;
+ ci->u.c.k = k; /* save continuation */
+ ci->u.c.ctx = ctx; /* save context */
+ /* save information for error recovery */
+ ci->u2.funcidx = cast_int(savestack(L, c.func));
+ ci->u.c.old_errfunc = L->errfunc;
+ L->errfunc = func;
+ setoah(ci->callstatus, L->allowhook); /* save value of 'allowhook' */
+ ci->callstatus |= CIST_YPCALL; /* function can do error recovery */
+ luaD_call(L, c.func, nresults); /* do the call */
+ ci->callstatus &= ~CIST_YPCALL;
+ L->errfunc = ci->u.c.old_errfunc;
+ status = LUA_OK; /* if it is here, there were no errors */
+ }
+ adjustresults(L, nresults);
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,
+ const char *chunkname, const char *mode) {
+ ZIO z;
+ int status;
+ lua_lock(L);
+ if (!chunkname) chunkname = "?";
+ luaZ_init(L, &z, reader, data);
+ status = luaD_protectedparser(L, &z, chunkname, mode);
+ if (status == LUA_OK) { /* no errors? */
+ LClosure *f = clLvalue(s2v(L->top - 1)); /* get newly created function */
+ if (f->nupvalues >= 1) { /* does it have an upvalue? */
+ /* get global table from registry */
+ const TValue *gt = getGtable(L);
+ /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */
+ setobj(L, f->upvals[0]->v, gt);
+ luaC_barrier(L, f->upvals[0], gt);
+ }
+ }
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data, int strip) {
+ int status;
+ TValue *o;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ o = s2v(L->top - 1);
+ if (isLfunction(o))
+ status = luaU_dump(L, getproto(o), writer, data, strip);
+ else
+ status = 1;
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_status (lua_State *L) {
+ return L->status;
+}
+
+
+/*
+** Garbage-collection function
+*/
+LUA_API int lua_gc (lua_State *L, int what, ...) {
+ va_list argp;
+ int res = 0;
+ global_State *g = G(L);
+ if (g->gcstp & GCSTPGC) /* internal stop? */
+ return -1; /* all options are invalid when stopped */
+ lua_lock(L);
+ va_start(argp, what);
+ switch (what) {
+ case LUA_GCSTOP: {
+ g->gcstp = GCSTPUSR; /* stopped by the user */
+ break;
+ }
+ case LUA_GCRESTART: {
+ luaE_setdebt(g, 0);
+ g->gcstp = 0; /* (GCSTPGC must be already zero here) */
+ break;
+ }
+ case LUA_GCCOLLECT: {
+ luaC_fullgc(L, 0);
+ break;
+ }
+ case LUA_GCCOUNT: {
+ /* GC values are expressed in Kbytes: #bytes/2^10 */
+ res = cast_int(gettotalbytes(g) >> 10);
+ break;
+ }
+ case LUA_GCCOUNTB: {
+ res = cast_int(gettotalbytes(g) & 0x3ff);
+ break;
+ }
+ case LUA_GCSTEP: {
+ int data = va_arg(argp, int);
+ l_mem debt = 1; /* =1 to signal that it did an actual step */
+ lu_byte oldstp = g->gcstp;
+ g->gcstp = 0; /* allow GC to run (GCSTPGC must be zero here) */
+ if (data == 0) {
+ luaE_setdebt(g, 0); /* do a basic step */
+ luaC_step(L);
+ }
+ else { /* add 'data' to total debt */
+ debt = cast(l_mem, data) * 1024 + g->GCdebt;
+ luaE_setdebt(g, debt);
+ luaC_checkGC(L);
+ }
+ g->gcstp = oldstp; /* restore previous state */
+ if (debt > 0 && g->gcstate == GCSpause) /* end of cycle? */
+ res = 1; /* signal it */
+ break;
+ }
+ case LUA_GCSETPAUSE: {
+ int data = va_arg(argp, int);
+ res = getgcparam(g->gcpause);
+ setgcparam(g->gcpause, data);
+ break;
+ }
+ case LUA_GCSETSTEPMUL: {
+ int data = va_arg(argp, int);
+ res = getgcparam(g->gcstepmul);
+ setgcparam(g->gcstepmul, data);
+ break;
+ }
+ case LUA_GCISRUNNING: {
+ res = gcrunning(g);
+ break;
+ }
+ case LUA_GCGEN: {
+ int minormul = va_arg(argp, int);
+ int majormul = va_arg(argp, int);
+ res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
+ if (minormul != 0)
+ g->genminormul = minormul;
+ if (majormul != 0)
+ setgcparam(g->genmajormul, majormul);
+ luaC_changemode(L, KGC_GEN);
+ break;
+ }
+ case LUA_GCINC: {
+ int pause = va_arg(argp, int);
+ int stepmul = va_arg(argp, int);
+ int stepsize = va_arg(argp, int);
+ res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
+ if (pause != 0)
+ setgcparam(g->gcpause, pause);
+ if (stepmul != 0)
+ setgcparam(g->gcstepmul, stepmul);
+ if (stepsize != 0)
+ g->gcstepsize = stepsize;
+ luaC_changemode(L, KGC_INC);
+ break;
+ }
+ default: res = -1; /* invalid option */
+ }
+ va_end(argp);
+ lua_unlock(L);
+ return res;
+}
+
+
+
+/*
+** miscellaneous functions
+*/
+
+
+LUA_API int lua_error (lua_State *L) {
+ TValue *errobj;
+ lua_lock(L);
+ errobj = s2v(L->top - 1);
+ api_checknelems(L, 1);
+ /* error object is the memory error message? */
+ if (ttisshrstring(errobj) && eqshrstr(tsvalue(errobj), G(L)->memerrmsg))
+ luaM_error(L); /* raise a memory error */
+ else
+ luaG_errormsg(L); /* raise a regular error */
+ /* code unreachable; will unlock when control actually leaves the kernel */
+ return 0; /* to avoid warnings */
+}
+
+
+LUA_API int lua_next (lua_State *L, int idx) {
+ Table *t;
+ int more;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = gettable(L, idx);
+ more = luaH_next(L, t, L->top - 1);
+ if (more) {
+ api_incr_top(L);
+ }
+ else /* no more elements */
+ L->top -= 1; /* remove key */
+ lua_unlock(L);
+ return more;
+}
+
+
+LUA_API void lua_toclose (lua_State *L, int idx) {
+ int nresults;
+ StkId o;
+ lua_lock(L);
+ o = index2stack(L, idx);
+ nresults = L->ci->nresults;
+ api_check(L, L->tbclist < o, "given index below or equal a marked one");
+ luaF_newtbcupval(L, o); /* create new to-be-closed upvalue */
+ if (!hastocloseCfunc(nresults)) /* function not marked yet? */
+ L->ci->nresults = codeNresults(nresults); /* mark it */
+ lua_assert(hastocloseCfunc(L->ci->nresults));
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_concat (lua_State *L, int n) {
+ lua_lock(L);
+ api_checknelems(L, n);
+ if (n > 0)
+ luaV_concat(L, n);
+ else { /* nothing to concatenate */
+ setsvalue2s(L, L->top, luaS_newlstr(L, "", 0)); /* push empty string */
+ api_incr_top(L);
+ }
+ luaC_checkGC(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_len (lua_State *L, int idx) {
+ TValue *t;
+ lua_lock(L);
+ t = index2value(L, idx);
+ luaV_objlen(L, L->top, t);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {
+ lua_Alloc f;
+ lua_lock(L);
+ if (ud) *ud = G(L)->ud;
+ f = G(L)->frealloc;
+ lua_unlock(L);
+ return f;
+}
+
+
+LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {
+ lua_lock(L);
+ G(L)->ud = ud;
+ G(L)->frealloc = f;
+ lua_unlock(L);
+}
+
+
+void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud) {
+ lua_lock(L);
+ G(L)->ud_warn = ud;
+ G(L)->warnf = f;
+ lua_unlock(L);
+}
+
+
+void lua_warning (lua_State *L, const char *msg, int tocont) {
+ lua_lock(L);
+ luaE_warning(L, msg, tocont);
+ lua_unlock(L);
+}
+
+
+
+LUA_API void *lua_newuserdatauv (lua_State *L, size_t size, int nuvalue) {
+ Udata *u;
+ lua_lock(L);
+ api_check(L, 0 <= nuvalue && nuvalue < USHRT_MAX, "invalid value");
+ u = luaS_newudata(L, size, nuvalue);
+ setuvalue(L, s2v(L->top), u);
+ api_incr_top(L);
+ luaC_checkGC(L);
+ lua_unlock(L);
+ return getudatamem(u);
+}
+
+
+
+static const char *aux_upvalue (TValue *fi, int n, TValue **val,
+ GCObject **owner) {
+ switch (ttypetag(fi)) {
+ case LUA_VCCL: { /* C closure */
+ CClosure *f = clCvalue(fi);
+ if (!(cast_uint(n) - 1u < cast_uint(f->nupvalues)))
+ return NULL; /* 'n' not in [1, f->nupvalues] */
+ *val = &f->upvalue[n-1];
+ if (owner) *owner = obj2gco(f);
+ return "";
+ }
+ case LUA_VLCL: { /* Lua closure */
+ LClosure *f = clLvalue(fi);
+ TString *name;
+ Proto *p = f->p;
+ if (!(cast_uint(n) - 1u < cast_uint(p->sizeupvalues)))
+ return NULL; /* 'n' not in [1, p->sizeupvalues] */
+ *val = f->upvals[n-1]->v;
+ if (owner) *owner = obj2gco(f->upvals[n - 1]);
+ name = p->upvalues[n-1].name;
+ return (name == NULL) ? "(no name)" : getstr(name);
+ }
+ default: return NULL; /* not a closure */
+ }
+}
+
+
+LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
+ const char *name;
+ TValue *val = NULL; /* to avoid warnings */
+ lua_lock(L);
+ name = aux_upvalue(index2value(L, funcindex), n, &val, NULL);
+ if (name) {
+ setobj2s(L, L->top, val);
+ api_incr_top(L);
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
+ const char *name;
+ TValue *val = NULL; /* to avoid warnings */
+ GCObject *owner = NULL; /* to avoid warnings */
+ TValue *fi;
+ lua_lock(L);
+ fi = index2value(L, funcindex);
+ api_checknelems(L, 1);
+ name = aux_upvalue(fi, n, &val, &owner);
+ if (name) {
+ L->top--;
+ setobj(L, val, s2v(L->top));
+ luaC_barrier(L, owner, val);
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) {
+ static const UpVal *const nullup = NULL;
+ LClosure *f;
+ TValue *fi = index2value(L, fidx);
+ api_check(L, ttisLclosure(fi), "Lua function expected");
+ f = clLvalue(fi);
+ if (pf) *pf = f;
+ if (1 <= n && n <= f->p->sizeupvalues)
+ return &f->upvals[n - 1]; /* get its upvalue pointer */
+ else
+ return (UpVal**)&nullup;
+}
+
+
+LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
+ TValue *fi = index2value(L, fidx);
+ switch (ttypetag(fi)) {
+ case LUA_VLCL: { /* lua closure */
+ return *getupvalref(L, fidx, n, NULL);
+ }
+ case LUA_VCCL: { /* C closure */
+ CClosure *f = clCvalue(fi);
+ if (1 <= n && n <= f->nupvalues)
+ return &f->upvalue[n - 1];
+ /* else */
+ } /* FALLTHROUGH */
+ case LUA_VLCF:
+ return NULL; /* light C functions have no upvalues */
+ default: {
+ api_check(L, 0, "function expected");
+ return NULL;
+ }
+ }
+}
+
+
+LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1,
+ int fidx2, int n2) {
+ LClosure *f1;
+ UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
+ UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
+ api_check(L, *up1 != NULL && *up2 != NULL, "invalid upvalue index");
+ *up1 = *up2;
+ luaC_objbarrier(L, f1, *up1);
+}
+
+
diff --git a/source/luametatex/source/luacore/lua54/src/lapi.h b/source/luametatex/source/luacore/lua54/src/lapi.h
new file mode 100644
index 000000000..9e99cc448
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lapi.h
@@ -0,0 +1,49 @@
+/*
+** $Id: lapi.h $
+** Auxiliary functions from Lua API
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lapi_h
+#define lapi_h
+
+
+#include "llimits.h"
+#include "lstate.h"
+
+
+/* Increments 'L->top', checking for stack overflows */
+#define api_incr_top(L) {L->top++; api_check(L, L->top <= L->ci->top, \
+ "stack overflow");}
+
+
+/*
+** If a call returns too many multiple returns, the callee may not have
+** stack space to accommodate all results. In this case, this macro
+** increases its stack space ('L->ci->top').
+*/
+#define adjustresults(L,nres) \
+ { if ((nres) <= LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; }
+
+
+/* Ensure the stack has at least 'n' elements */
+#define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \
+ "not enough elements in the stack")
+
+
+/*
+** To reduce the overhead of returning from C functions, the presence of
+** to-be-closed variables in these functions is coded in the CallInfo's
+** field 'nresults', in a way that functions with no to-be-closed variables
+** with zero, one, or "all" wanted results have no overhead. Functions
+** with other number of wanted results, as well as functions with
+** variables to be closed, have an extra check.
+*/
+
+#define hastocloseCfunc(n) ((n) < LUA_MULTRET)
+
+/* Map [-1, inf) (range of 'nresults') into (-inf, -2] */
+#define codeNresults(n) (-(n) - 3)
+#define decodeNresults(n) (-(n) - 3)
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lauxlib.c b/source/luametatex/source/luacore/lua54/src/lauxlib.c
new file mode 100644
index 000000000..4ca6c6548
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lauxlib.c
@@ -0,0 +1,1112 @@
+/*
+** $Id: lauxlib.c $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+#define lauxlib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <errno.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+/*
+** This file uses only the official API of Lua.
+** Any function declared here could be written as an application function.
+*/
+
+#include "lua.h"
+
+#include "lauxlib.h"
+
+
+#if !defined(MAX_SIZET)
+/* maximum value for size_t */
+#define MAX_SIZET ((size_t)(~(size_t)0))
+#endif
+
+
+/*
+** {======================================================
+** Traceback
+** =======================================================
+*/
+
+
+#define LEVELS1 10 /* size of the first part of the stack */
+#define LEVELS2 11 /* size of the second part of the stack */
+
+
+
+/*
+** Search for 'objidx' in table at index -1. ('objidx' must be an
+** absolute index.) Return 1 + string at top if it found a good name.
+*/
+static int findfield (lua_State *L, int objidx, int level) {
+ if (level == 0 || !lua_istable(L, -1))
+ return 0; /* not found */
+ lua_pushnil(L); /* start 'next' loop */
+ while (lua_next(L, -2)) { /* for each pair in table */
+ if (lua_type(L, -2) == LUA_TSTRING) { /* ignore non-string keys */
+ if (lua_rawequal(L, objidx, -1)) { /* found object? */
+ lua_pop(L, 1); /* remove value (but keep name) */
+ return 1;
+ }
+ else if (findfield(L, objidx, level - 1)) { /* try recursively */
+ /* stack: lib_name, lib_table, field_name (top) */
+ lua_pushliteral(L, "."); /* place '.' between the two names */
+ lua_replace(L, -3); /* (in the slot occupied by table) */
+ lua_concat(L, 3); /* lib_name.field_name */
+ return 1;
+ }
+ }
+ lua_pop(L, 1); /* remove value */
+ }
+ return 0; /* not found */
+}
+
+
+/*
+** Search for a name for a function in all loaded modules
+*/
+static int pushglobalfuncname (lua_State *L, lua_Debug *ar) {
+ int top = lua_gettop(L);
+ lua_getinfo(L, "f", ar); /* push function */
+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
+ if (findfield(L, top + 1, 2)) {
+ const char *name = lua_tostring(L, -1);
+ if (strncmp(name, LUA_GNAME ".", 3) == 0) { /* name start with '_G.'? */
+ lua_pushstring(L, name + 3); /* push name without prefix */
+ lua_remove(L, -2); /* remove original name */
+ }
+ lua_copy(L, -1, top + 1); /* copy name to proper place */
+ lua_settop(L, top + 1); /* remove table "loaded" and name copy */
+ return 1;
+ }
+ else {
+ lua_settop(L, top); /* remove function and global table */
+ return 0;
+ }
+}
+
+
+static void pushfuncname (lua_State *L, lua_Debug *ar) {
+ if (pushglobalfuncname(L, ar)) { /* try first a global name */
+ lua_pushfstring(L, "function '%s'", lua_tostring(L, -1));
+ lua_remove(L, -2); /* remove name */
+ }
+ else if (*ar->namewhat != '\0') /* is there a name from code? */
+ lua_pushfstring(L, "%s '%s'", ar->namewhat, ar->name); /* use it */
+ else if (*ar->what == 'm') /* main? */
+ lua_pushliteral(L, "main chunk");
+ else if (*ar->what != 'C') /* for Lua functions, use <file:line> */
+ lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined);
+ else /* nothing left... */
+ lua_pushliteral(L, "?");
+}
+
+
+static int lastlevel (lua_State *L) {
+ lua_Debug ar;
+ int li = 1, le = 1;
+ /* find an upper bound */
+ while (lua_getstack(L, le, &ar)) { li = le; le *= 2; }
+ /* do a binary search */
+ while (li < le) {
+ int m = (li + le)/2;
+ if (lua_getstack(L, m, &ar)) li = m + 1;
+ else le = m;
+ }
+ return le - 1;
+}
+
+
+LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1,
+ const char *msg, int level) {
+ luaL_Buffer b;
+ lua_Debug ar;
+ int last = lastlevel(L1);
+ int limit2show = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1;
+ luaL_buffinit(L, &b);
+ if (msg) {
+ luaL_addstring(&b, msg);
+ luaL_addchar(&b, '\n');
+ }
+ luaL_addstring(&b, "stack traceback:");
+ while (lua_getstack(L1, level++, &ar)) {
+ if (limit2show-- == 0) { /* too many levels? */
+ int n = last - level - LEVELS2 + 1; /* number of levels to skip */
+ lua_pushfstring(L, "\n\t...\t(skipping %d levels)", n);
+ luaL_addvalue(&b); /* add warning about skip */
+ level += n; /* and skip to last levels */
+ }
+ else {
+ lua_getinfo(L1, "Slnt", &ar);
+ if (ar.currentline <= 0)
+ lua_pushfstring(L, "\n\t%s: in ", ar.short_src);
+ else
+ lua_pushfstring(L, "\n\t%s:%d: in ", ar.short_src, ar.currentline);
+ luaL_addvalue(&b);
+ pushfuncname(L, &ar);
+ luaL_addvalue(&b);
+ if (ar.istailcall)
+ luaL_addstring(&b, "\n\t(...tail calls...)");
+ }
+ }
+ luaL_pushresult(&b);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Error-report functions
+** =======================================================
+*/
+
+LUALIB_API int luaL_argerror (lua_State *L, int arg, const char *extramsg) {
+ lua_Debug ar;
+ if (!lua_getstack(L, 0, &ar)) /* no stack frame? */
+ return luaL_error(L, "bad argument #%d (%s)", arg, extramsg);
+ lua_getinfo(L, "n", &ar);
+ if (strcmp(ar.namewhat, "method") == 0) {
+ arg--; /* do not count 'self' */
+ if (arg == 0) /* error is in the self argument itself? */
+ return luaL_error(L, "calling '%s' on bad self (%s)",
+ ar.name, extramsg);
+ }
+ if (ar.name == NULL)
+ ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?";
+ return luaL_error(L, "bad argument #%d to '%s' (%s)",
+ arg, ar.name, extramsg);
+}
+
+
+LUALIB_API int luaL_typeerror (lua_State *L, int arg, const char *tname) {
+ const char *msg;
+ const char *typearg; /* name for the type of the actual argument */
+ if (luaL_getmetafield(L, arg, "__name") == LUA_TSTRING)
+ typearg = lua_tostring(L, -1); /* use the given type name */
+ else if (lua_type(L, arg) == LUA_TLIGHTUSERDATA)
+ typearg = "light userdata"; /* special name for messages */
+ else
+ typearg = luaL_typename(L, arg); /* standard name */
+ msg = lua_pushfstring(L, "%s expected, got %s", tname, typearg);
+ return luaL_argerror(L, arg, msg);
+}
+
+
+static void tag_error (lua_State *L, int arg, int tag) {
+ luaL_typeerror(L, arg, lua_typename(L, tag));
+}
+
+
+/*
+** The use of 'lua_pushfstring' ensures this function does not
+** need reserved stack space when called.
+*/
+LUALIB_API void luaL_where (lua_State *L, int level) {
+ lua_Debug ar;
+ if (lua_getstack(L, level, &ar)) { /* check function at level */
+ lua_getinfo(L, "Sl", &ar); /* get info about it */
+ if (ar.currentline > 0) { /* is there info? */
+ lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
+ return;
+ }
+ }
+ lua_pushfstring(L, ""); /* else, no information available... */
+}
+
+
+/*
+** Again, the use of 'lua_pushvfstring' ensures this function does
+** not need reserved stack space when called. (At worst, it generates
+** an error with "stack overflow" instead of the given message.)
+*/
+LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {
+ va_list argp;
+ va_start(argp, fmt);
+ luaL_where(L, 1);
+ lua_pushvfstring(L, fmt, argp);
+ va_end(argp);
+ lua_concat(L, 2);
+ return lua_error(L);
+}
+
+
+LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) {
+ int en = errno; /* calls to Lua API may change this value */
+ if (stat) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ else {
+ luaL_pushfail(L);
+ if (fname)
+ lua_pushfstring(L, "%s: %s", fname, strerror(en));
+ else
+ lua_pushstring(L, strerror(en));
+ lua_pushinteger(L, en);
+ return 3;
+ }
+}
+
+
+#if !defined(l_inspectstat) /* { */
+
+#if defined(LUA_USE_POSIX)
+
+#include <sys/wait.h>
+
+/*
+** use appropriate macros to interpret 'pclose' return status
+*/
+#define l_inspectstat(stat,what) \
+ if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \
+ else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; }
+
+#else
+
+#define l_inspectstat(stat,what) /* no op */
+
+#endif
+
+#endif /* } */
+
+
+LUALIB_API int luaL_execresult (lua_State *L, int stat) {
+ if (stat != 0 && errno != 0) /* error with an 'errno'? */
+ return luaL_fileresult(L, 0, NULL);
+ else {
+ const char *what = "exit"; /* type of termination */
+ l_inspectstat(stat, what); /* interpret result */
+ if (*what == 'e' && stat == 0) /* successful termination? */
+ lua_pushboolean(L, 1);
+ else
+ luaL_pushfail(L);
+ lua_pushstring(L, what);
+ lua_pushinteger(L, stat);
+ return 3; /* return true/fail,what,code */
+ }
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** Userdata's metatable manipulation
+** =======================================================
+*/
+
+LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {
+ if (luaL_getmetatable(L, tname) != LUA_TNIL) /* name already in use? */
+ return 0; /* leave previous value on top, but return 0 */
+ lua_pop(L, 1);
+ lua_createtable(L, 0, 2); /* create metatable */
+ lua_pushstring(L, tname);
+ lua_setfield(L, -2, "__name"); /* metatable.__name = tname */
+ lua_pushvalue(L, -1);
+ lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */
+ return 1;
+}
+
+
+LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) {
+ luaL_getmetatable(L, tname);
+ lua_setmetatable(L, -2);
+}
+
+
+LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) {
+ void *p = lua_touserdata(L, ud);
+ if (p != NULL) { /* value is a userdata? */
+ if (lua_getmetatable(L, ud)) { /* does it have a metatable? */
+ luaL_getmetatable(L, tname); /* get correct metatable */
+ if (!lua_rawequal(L, -1, -2)) /* not the same? */
+ p = NULL; /* value is a userdata with wrong metatable */
+ lua_pop(L, 2); /* remove both metatables */
+ return p;
+ }
+ }
+ return NULL; /* value is not a userdata with a metatable */
+}
+
+
+LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {
+ void *p = luaL_testudata(L, ud, tname);
+ luaL_argexpected(L, p != NULL, ud, tname);
+ return p;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Argument check functions
+** =======================================================
+*/
+
+LUALIB_API int luaL_checkoption (lua_State *L, int arg, const char *def,
+ const char *const lst[]) {
+ const char *name = (def) ? luaL_optstring(L, arg, def) :
+ luaL_checkstring(L, arg);
+ int i;
+ for (i=0; lst[i]; i++)
+ if (strcmp(lst[i], name) == 0)
+ return i;
+ return luaL_argerror(L, arg,
+ lua_pushfstring(L, "invalid option '%s'", name));
+}
+
+
+/*
+** Ensures the stack has at least 'space' extra slots, raising an error
+** if it cannot fulfill the request. (The error handling needs a few
+** extra slots to format the error message. In case of an error without
+** this extra space, Lua will generate the same 'stack overflow' error,
+** but without 'msg'.)
+*/
+LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) {
+ if (l_unlikely(!lua_checkstack(L, space))) {
+ if (msg)
+ luaL_error(L, "stack overflow (%s)", msg);
+ else
+ luaL_error(L, "stack overflow");
+ }
+}
+
+
+LUALIB_API void luaL_checktype (lua_State *L, int arg, int t) {
+ if (l_unlikely(lua_type(L, arg) != t))
+ tag_error(L, arg, t);
+}
+
+
+LUALIB_API void luaL_checkany (lua_State *L, int arg) {
+ if (l_unlikely(lua_type(L, arg) == LUA_TNONE))
+ luaL_argerror(L, arg, "value expected");
+}
+
+
+LUALIB_API const char *luaL_checklstring (lua_State *L, int arg, size_t *len) {
+ const char *s = lua_tolstring(L, arg, len);
+ if (l_unlikely(!s)) tag_error(L, arg, LUA_TSTRING);
+ return s;
+}
+
+
+LUALIB_API const char *luaL_optlstring (lua_State *L, int arg,
+ const char *def, size_t *len) {
+ if (lua_isnoneornil(L, arg)) {
+ if (len)
+ *len = (def ? strlen(def) : 0);
+ return def;
+ }
+ else return luaL_checklstring(L, arg, len);
+}
+
+
+LUALIB_API lua_Number luaL_checknumber (lua_State *L, int arg) {
+ int isnum;
+ lua_Number d = lua_tonumberx(L, arg, &isnum);
+ if (l_unlikely(!isnum))
+ tag_error(L, arg, LUA_TNUMBER);
+ return d;
+}
+
+
+LUALIB_API lua_Number luaL_optnumber (lua_State *L, int arg, lua_Number def) {
+ return luaL_opt(L, luaL_checknumber, arg, def);
+}
+
+
+static void interror (lua_State *L, int arg) {
+ if (lua_isnumber(L, arg))
+ luaL_argerror(L, arg, "number has no integer representation");
+ else
+ tag_error(L, arg, LUA_TNUMBER);
+}
+
+
+LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int arg) {
+ int isnum;
+ lua_Integer d = lua_tointegerx(L, arg, &isnum);
+ if (l_unlikely(!isnum)) {
+ interror(L, arg);
+ }
+ return d;
+}
+
+
+LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int arg,
+ lua_Integer def) {
+ return luaL_opt(L, luaL_checkinteger, arg, def);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Generic Buffer manipulation
+** =======================================================
+*/
+
+/* userdata to box arbitrary data */
+typedef struct UBox {
+ void *box;
+ size_t bsize;
+} UBox;
+
+
+static void *resizebox (lua_State *L, int idx, size_t newsize) {
+ void *ud;
+ lua_Alloc allocf = lua_getallocf(L, &ud);
+ UBox *box = (UBox *)lua_touserdata(L, idx);
+ void *temp = allocf(ud, box->box, box->bsize, newsize);
+ if (l_unlikely(temp == NULL && newsize > 0)) { /* allocation error? */
+ lua_pushliteral(L, "not enough memory");
+ lua_error(L); /* raise a memory error */
+ }
+ box->box = temp;
+ box->bsize = newsize;
+ return temp;
+}
+
+
+static int boxgc (lua_State *L) {
+ resizebox(L, 1, 0);
+ return 0;
+}
+
+
+static const luaL_Reg boxmt[] = { /* box metamethods */
+ {"__gc", boxgc},
+ {"__close", boxgc},
+ {NULL, NULL}
+};
+
+
+static void newbox (lua_State *L) {
+ UBox *box = (UBox *)lua_newuserdatauv(L, sizeof(UBox), 0);
+ box->box = NULL;
+ box->bsize = 0;
+ if (luaL_newmetatable(L, "_UBOX*")) /* creating metatable? */
+ luaL_setfuncs(L, boxmt, 0); /* set its metamethods */
+ lua_setmetatable(L, -2);
+}
+
+
+/*
+** check whether buffer is using a userdata on the stack as a temporary
+** buffer
+*/
+#define buffonstack(B) ((B)->b != (B)->init.b)
+
+
+/*
+** Whenever buffer is accessed, slot 'idx' must either be a box (which
+** cannot be NULL) or it is a placeholder for the buffer.
+*/
+#define checkbufferlevel(B,idx) \
+ lua_assert(buffonstack(B) ? lua_touserdata(B->L, idx) != NULL \
+ : lua_touserdata(B->L, idx) == (void*)B)
+
+
+/*
+** Compute new size for buffer 'B', enough to accommodate extra 'sz'
+** bytes. (The test for "not big enough" also gets the case when the
+** computation of 'newsize' overflows.)
+*/
+static size_t newbuffsize (luaL_Buffer *B, size_t sz) {
+ size_t newsize = (B->size / 2) * 3; /* buffer size * 1.5 */
+ if (l_unlikely(MAX_SIZET - sz < B->n)) /* overflow in (B->n + sz)? */
+ return luaL_error(B->L, "buffer too large");
+ if (newsize < B->n + sz) /* not big enough? */
+ newsize = B->n + sz;
+ return newsize;
+}
+
+
+/*
+** Returns a pointer to a free area with at least 'sz' bytes in buffer
+** 'B'. 'boxidx' is the relative position in the stack where is the
+** buffer's box or its placeholder.
+*/
+static char *prepbuffsize (luaL_Buffer *B, size_t sz, int boxidx) {
+ checkbufferlevel(B, boxidx);
+ if (B->size - B->n >= sz) /* enough space? */
+ return B->b + B->n;
+ else {
+ lua_State *L = B->L;
+ char *newbuff;
+ size_t newsize = newbuffsize(B, sz);
+ /* create larger buffer */
+ if (buffonstack(B)) /* buffer already has a box? */
+ newbuff = (char *)resizebox(L, boxidx, newsize); /* resize it */
+ else { /* no box yet */
+ lua_remove(L, boxidx); /* remove placeholder */
+ newbox(L); /* create a new box */
+ lua_insert(L, boxidx); /* move box to its intended position */
+ lua_toclose(L, boxidx);
+ newbuff = (char *)resizebox(L, boxidx, newsize);
+ memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */
+ }
+ B->b = newbuff;
+ B->size = newsize;
+ return newbuff + B->n;
+ }
+}
+
+/*
+** returns a pointer to a free area with at least 'sz' bytes
+*/
+LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) {
+ return prepbuffsize(B, sz, -1);
+}
+
+
+LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
+ if (l > 0) { /* avoid 'memcpy' when 's' can be NULL */
+ char *b = prepbuffsize(B, l, -1);
+ memcpy(b, s, l * sizeof(char));
+ luaL_addsize(B, l);
+ }
+}
+
+
+LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
+ luaL_addlstring(B, s, strlen(s));
+}
+
+
+LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
+ lua_State *L = B->L;
+ checkbufferlevel(B, -1);
+ lua_pushlstring(L, B->b, B->n);
+ if (buffonstack(B))
+ lua_closeslot(L, -2); /* close the box */
+ lua_remove(L, -2); /* remove box or placeholder from the stack */
+}
+
+
+LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) {
+ luaL_addsize(B, sz);
+ luaL_pushresult(B);
+}
+
+
+/*
+** 'luaL_addvalue' is the only function in the Buffer system where the
+** box (if existent) is not on the top of the stack. So, instead of
+** calling 'luaL_addlstring', it replicates the code using -2 as the
+** last argument to 'prepbuffsize', signaling that the box is (or will
+** be) below the string being added to the buffer. (Box creation can
+** trigger an emergency GC, so we should not remove the string from the
+** stack before we have the space guaranteed.)
+*/
+LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
+ lua_State *L = B->L;
+ size_t len;
+ const char *s = lua_tolstring(L, -1, &len);
+ char *b = prepbuffsize(B, len, -2);
+ memcpy(b, s, len * sizeof(char));
+ luaL_addsize(B, len);
+ lua_pop(L, 1); /* pop string */
+}
+
+
+LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
+ B->L = L;
+ B->b = B->init.b;
+ B->n = 0;
+ B->size = LUAL_BUFFERSIZE;
+ lua_pushlightuserdata(L, (void*)B); /* push placeholder */
+}
+
+
+LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {
+ luaL_buffinit(L, B);
+ return prepbuffsize(B, sz, -1);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Reference system
+** =======================================================
+*/
+
+/* index of free-list header (after the predefined values) */
+#define freelist (LUA_RIDX_LAST + 1)
+
+/*
+** The previously freed references form a linked list:
+** t[freelist] is the index of a first free index, or zero if list is
+** empty; t[t[freelist]] is the index of the second element; etc.
+*/
+LUALIB_API int luaL_ref (lua_State *L, int t) {
+ int ref;
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1); /* remove from stack */
+ return LUA_REFNIL; /* 'nil' has a unique fixed reference */
+ }
+ t = lua_absindex(L, t);
+ if (lua_rawgeti(L, t, freelist) == LUA_TNIL) { /* first access? */
+ ref = 0; /* list is empty */
+ lua_pushinteger(L, 0); /* initialize as an empty list */
+ lua_rawseti(L, t, freelist); /* ref = t[freelist] = 0 */
+ }
+ else { /* already initialized */
+ lua_assert(lua_isinteger(L, -1));
+ ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */
+ }
+ lua_pop(L, 1); /* remove element from stack */
+ if (ref != 0) { /* any free element? */
+ lua_rawgeti(L, t, ref); /* remove it from list */
+ lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */
+ }
+ else /* no free elements */
+ ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */
+ lua_rawseti(L, t, ref);
+ return ref;
+}
+
+
+LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
+ if (ref >= 0) {
+ t = lua_absindex(L, t);
+ lua_rawgeti(L, t, freelist);
+ lua_assert(lua_isinteger(L, -1));
+ lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */
+ lua_pushinteger(L, ref);
+ lua_rawseti(L, t, freelist); /* t[freelist] = ref */
+ }
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Load functions
+** =======================================================
+*/
+
+typedef struct LoadF {
+ int n; /* number of pre-read characters */
+ FILE *f; /* file being read */
+ char buff[BUFSIZ]; /* area for reading file */
+} LoadF;
+
+
+static const char *getF (lua_State *L, void *ud, size_t *size) {
+ LoadF *lf = (LoadF *)ud;
+ (void)L; /* not used */
+ if (lf->n > 0) { /* are there pre-read characters to be read? */
+ *size = lf->n; /* return them (chars already in buffer) */
+ lf->n = 0; /* no more pre-read characters */
+ }
+ else { /* read a block from file */
+ /* 'fread' can return > 0 *and* set the EOF flag. If next call to
+ 'getF' called 'fread', it might still wait for user input.
+ The next check avoids this problem. */
+ if (feof(lf->f)) return NULL;
+ *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */
+ }
+ return lf->buff;
+}
+
+
+static int errfile (lua_State *L, const char *what, int fnameindex) {
+ const char *serr = strerror(errno);
+ const char *filename = lua_tostring(L, fnameindex) + 1;
+ lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);
+ lua_remove(L, fnameindex);
+ return LUA_ERRFILE;
+}
+
+
+/*
+** Skip an optional BOM at the start of a stream. If there is an
+** incomplete BOM (the first character is correct but the rest is
+** not), returns the first character anyway to force an error
+** (as no chunk can start with 0xEF).
+*/
+static int skipBOM (FILE *f) {
+ int c = getc(f); /* read first character */
+ if (c == 0xEF && getc(f) == 0xBB && getc(f) == 0xBF) /* correct BOM? */
+ return getc(f); /* ignore BOM and return next char */
+ else /* no (valid) BOM */
+ return c; /* return first character */
+}
+
+
+/*
+** reads the first character of file 'f' and skips an optional BOM mark
+** in its beginning plus its first line if it starts with '#'. Returns
+** true if it skipped the first line. In any case, '*cp' has the
+** first "valid" character of the file (after the optional BOM and
+** a first-line comment).
+*/
+static int skipcomment (FILE *f, int *cp) {
+ int c = *cp = skipBOM(f);
+ if (c == '#') { /* first line is a comment (Unix exec. file)? */
+ do { /* skip first line */
+ c = getc(f);
+ } while (c != EOF && c != '\n');
+ *cp = getc(f); /* next character after comment, if present */
+ return 1; /* there was a comment */
+ }
+ else return 0; /* no comment */
+}
+
+
+LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename,
+ const char *mode) {
+ LoadF lf;
+ int status, readstatus;
+ int c;
+ int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */
+ if (filename == NULL) {
+ lua_pushliteral(L, "=stdin");
+ lf.f = stdin;
+ }
+ else {
+ lua_pushfstring(L, "@%s", filename);
+ lf.f = fopen(filename, "r");
+ if (lf.f == NULL) return errfile(L, "open", fnameindex);
+ }
+ lf.n = 0;
+ if (skipcomment(lf.f, &c)) /* read initial portion */
+ lf.buff[lf.n++] = '\n'; /* add newline to correct line numbers */
+ if (c == LUA_SIGNATURE[0]) { /* binary file? */
+ lf.n = 0; /* remove possible newline */
+ if (filename) { /* "real" file? */
+ lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */
+ if (lf.f == NULL) return errfile(L, "reopen", fnameindex);
+ skipcomment(lf.f, &c); /* re-read initial portion */
+ }
+ }
+ if (c != EOF)
+ lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */
+ status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode);
+ readstatus = ferror(lf.f);
+ if (filename) fclose(lf.f); /* close file (even in case of errors) */
+ if (readstatus) {
+ lua_settop(L, fnameindex); /* ignore results from 'lua_load' */
+ return errfile(L, "read", fnameindex);
+ }
+ lua_remove(L, fnameindex);
+ return status;
+}
+
+
+typedef struct LoadS {
+ const char *s;
+ size_t size;
+} LoadS;
+
+
+static const char *getS (lua_State *L, void *ud, size_t *size) {
+ LoadS *ls = (LoadS *)ud;
+ (void)L; /* not used */
+ if (ls->size == 0) return NULL;
+ *size = ls->size;
+ ls->size = 0;
+ return ls->s;
+}
+
+
+LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size,
+ const char *name, const char *mode) {
+ LoadS ls;
+ ls.s = buff;
+ ls.size = size;
+ return lua_load(L, getS, &ls, name, mode);
+}
+
+
+LUALIB_API int luaL_loadstring (lua_State *L, const char *s) {
+ return luaL_loadbuffer(L, s, strlen(s), s);
+}
+
+/* }====================================================== */
+
+
+
+LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
+ if (!lua_getmetatable(L, obj)) /* no metatable? */
+ return LUA_TNIL;
+ else {
+ int tt;
+ lua_pushstring(L, event);
+ tt = lua_rawget(L, -2);
+ if (tt == LUA_TNIL) /* is metafield nil? */
+ lua_pop(L, 2); /* remove metatable and metafield */
+ else
+ lua_remove(L, -2); /* remove only metatable */
+ return tt; /* return metafield type */
+ }
+}
+
+
+LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
+ obj = lua_absindex(L, obj);
+ if (luaL_getmetafield(L, obj, event) == LUA_TNIL) /* no metafield? */
+ return 0;
+ lua_pushvalue(L, obj);
+ lua_call(L, 1, 1);
+ return 1;
+}
+
+
+LUALIB_API lua_Integer luaL_len (lua_State *L, int idx) {
+ lua_Integer l;
+ int isnum;
+ lua_len(L, idx);
+ l = lua_tointegerx(L, -1, &isnum);
+ if (l_unlikely(!isnum))
+ luaL_error(L, "object length is not an integer");
+ lua_pop(L, 1); /* remove object */
+ return l;
+}
+
+
+LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) {
+ idx = lua_absindex(L,idx);
+ if (luaL_callmeta(L, idx, "__tostring")) { /* metafield? */
+ if (!lua_isstring(L, -1))
+ luaL_error(L, "'__tostring' must return a string");
+ }
+ else {
+ switch (lua_type(L, idx)) {
+ case LUA_TNUMBER: {
+ if (lua_isinteger(L, idx))
+ lua_pushfstring(L, "%I", (LUAI_UACINT)lua_tointeger(L, idx));
+ else
+ lua_pushfstring(L, "%f", (LUAI_UACNUMBER)lua_tonumber(L, idx));
+ break;
+ }
+ case LUA_TSTRING:
+ lua_pushvalue(L, idx);
+ break;
+ case LUA_TBOOLEAN:
+ lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false"));
+ break;
+ case LUA_TNIL:
+ lua_pushliteral(L, "nil");
+ break;
+ default: {
+ int tt = luaL_getmetafield(L, idx, "__name"); /* try name */
+ const char *kind = (tt == LUA_TSTRING) ? lua_tostring(L, -1) :
+ luaL_typename(L, idx);
+ lua_pushfstring(L, "%s: %p", kind, lua_topointer(L, idx));
+ if (tt != LUA_TNIL)
+ lua_remove(L, -2); /* remove '__name' */
+ break;
+ }
+ }
+ }
+ return lua_tolstring(L, -1, len);
+}
+
+
+/*
+** 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.
+*/
+LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
+ luaL_checkstack(L, nup, "too many upvalues");
+ for (; l->name != NULL; l++) { /* fill the table with given functions */
+ if (l->func == NULL) /* place holder? */
+ lua_pushboolean(L, 0);
+ else {
+ 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 */
+}
+
+
+/*
+** ensure that stack[idx][fname] has a table and push that table
+** into the stack
+*/
+LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) {
+ if (lua_getfield(L, idx, fname) == LUA_TTABLE)
+ return 1; /* table already there */
+ else {
+ lua_pop(L, 1); /* remove previous result */
+ idx = lua_absindex(L, idx);
+ lua_newtable(L);
+ lua_pushvalue(L, -1); /* copy to be left at top */
+ lua_setfield(L, idx, fname); /* assign new table to field */
+ return 0; /* false, because did not find table there */
+ }
+}
+
+
+/*
+** Stripped-down 'require': After checking "loaded" table, calls 'openf'
+** to open a module, registers the result in 'package.loaded' table and,
+** if 'glb' is true, also registers the result in the global table.
+** Leaves resulting module on the top.
+*/
+LUALIB_API void luaL_requiref (lua_State *L, const char *modname,
+ lua_CFunction openf, int glb) {
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
+ lua_getfield(L, -1, modname); /* LOADED[modname] */
+ if (!lua_toboolean(L, -1)) { /* package not already loaded? */
+ lua_pop(L, 1); /* remove field */
+ lua_pushcfunction(L, openf);
+ lua_pushstring(L, modname); /* argument to open function */
+ lua_call(L, 1, 1); /* call 'openf' to open module */
+ lua_pushvalue(L, -1); /* make copy of module (call result) */
+ lua_setfield(L, -3, modname); /* LOADED[modname] = module */
+ }
+ lua_remove(L, -2); /* remove LOADED table */
+ if (glb) {
+ lua_pushvalue(L, -1); /* copy of module */
+ lua_setglobal(L, modname); /* _G[modname] = module */
+ }
+}
+
+
+LUALIB_API void luaL_addgsub (luaL_Buffer *b, const char *s,
+ const char *p, const char *r) {
+ const char *wild;
+ size_t l = strlen(p);
+ while ((wild = strstr(s, p)) != NULL) {
+ luaL_addlstring(b, s, wild - s); /* push prefix */
+ luaL_addstring(b, r); /* push replacement in place of pattern */
+ s = wild + l; /* continue after 'p' */
+ }
+ luaL_addstring(b, s); /* push last suffix */
+}
+
+
+LUALIB_API const char *luaL_gsub (lua_State *L, const char *s,
+ const char *p, const char *r) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ luaL_addgsub(&b, s, p, r);
+ luaL_pushresult(&b);
+ return lua_tostring(L, -1);
+}
+
+
+static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
+ (void)ud; (void)osize; /* not used */
+ if (nsize == 0) {
+ free(ptr);
+ return NULL;
+ }
+ else
+ return realloc(ptr, nsize);
+}
+
+
+static int panic (lua_State *L) {
+ const char *msg = lua_tostring(L, -1);
+ if (msg == NULL) msg = "error object is not a string";
+ lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",
+ msg);
+ return 0; /* return to Lua to abort */
+}
+
+
+/*
+** Warning functions:
+** warnfoff: warning system is off
+** warnfon: ready to start a new message
+** warnfcont: previous message is to be continued
+*/
+static void warnfoff (void *ud, const char *message, int tocont);
+static void warnfon (void *ud, const char *message, int tocont);
+static void warnfcont (void *ud, const char *message, int tocont);
+
+
+/*
+** Check whether message is a control message. If so, execute the
+** control or ignore it if unknown.
+*/
+static int checkcontrol (lua_State *L, const char *message, int tocont) {
+ if (tocont || *(message++) != '@') /* not a control message? */
+ return 0;
+ else {
+ if (strcmp(message, "off") == 0)
+ lua_setwarnf(L, warnfoff, L); /* turn warnings off */
+ else if (strcmp(message, "on") == 0)
+ lua_setwarnf(L, warnfon, L); /* turn warnings on */
+ return 1; /* it was a control message */
+ }
+}
+
+
+static void warnfoff (void *ud, const char *message, int tocont) {
+ checkcontrol((lua_State *)ud, message, tocont);
+}
+
+
+/*
+** Writes the message and handle 'tocont', finishing the message
+** if needed and setting the next warn function.
+*/
+static void warnfcont (void *ud, const char *message, int tocont) {
+ lua_State *L = (lua_State *)ud;
+ lua_writestringerror("%s", message); /* write message */
+ if (tocont) /* not the last part? */
+ lua_setwarnf(L, warnfcont, L); /* to be continued */
+ else { /* last part */
+ lua_writestringerror("%s", "\n"); /* finish message with end-of-line */
+ lua_setwarnf(L, warnfon, L); /* next call is a new message */
+ }
+}
+
+
+static void warnfon (void *ud, const char *message, int tocont) {
+ if (checkcontrol((lua_State *)ud, message, tocont)) /* control message? */
+ return; /* nothing else to be done */
+ lua_writestringerror("%s", "Lua warning: "); /* start a new warning */
+ warnfcont(ud, message, tocont); /* finish processing */
+}
+
+
+LUALIB_API lua_State *luaL_newstate (void) {
+ lua_State *L = lua_newstate(l_alloc, NULL);
+ if (l_likely(L)) {
+ lua_atpanic(L, &panic);
+ lua_setwarnf(L, warnfoff, L); /* default is warnings off */
+ }
+ return L;
+}
+
+
+LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) {
+ lua_Number v = lua_version(L);
+ if (sz != LUAL_NUMSIZES) /* check numeric types */
+ luaL_error(L, "core and library have incompatible numeric types");
+ else if (v != ver)
+ luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",
+ (LUAI_UACNUMBER)ver, (LUAI_UACNUMBER)v);
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lauxlib.h b/source/luametatex/source/luacore/lua54/src/lauxlib.h
new file mode 100644
index 000000000..5b977e2a3
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lauxlib.h
@@ -0,0 +1,301 @@
+/*
+** $Id: lauxlib.h $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lauxlib_h
+#define lauxlib_h
+
+
+#include <stddef.h>
+#include <stdio.h>
+
+#include "luaconf.h"
+#include "lua.h"
+
+
+/* global table */
+#define LUA_GNAME "_G"
+
+
+typedef struct luaL_Buffer luaL_Buffer;
+
+
+/* extra error code for 'luaL_loadfilex' */
+#define LUA_ERRFILE (LUA_ERRERR+1)
+
+
+/* key, in the registry, for table of loaded modules */
+#define LUA_LOADED_TABLE "_LOADED"
+
+
+/* key, in the registry, for table of preloaded loaders */
+#define LUA_PRELOAD_TABLE "_PRELOAD"
+
+
+typedef struct luaL_Reg {
+ const char *name;
+ lua_CFunction func;
+} luaL_Reg;
+
+
+#define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number))
+
+LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz);
+#define luaL_checkversion(L) \
+ luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES)
+
+LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e);
+LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e);
+LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len);
+LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg);
+LUALIB_API int (luaL_typeerror) (lua_State *L, int arg, const char *tname);
+LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg,
+ size_t *l);
+LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg,
+ const char *def, size_t *l);
+LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg);
+LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def);
+
+LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg);
+LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg,
+ lua_Integer def);
+
+LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg);
+LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t);
+LUALIB_API void (luaL_checkany) (lua_State *L, int arg);
+
+LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname);
+LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname);
+LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname);
+LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);
+
+LUALIB_API void (luaL_where) (lua_State *L, int lvl);
+LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...);
+
+LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def,
+ const char *const lst[]);
+
+LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);
+LUALIB_API int (luaL_execresult) (lua_State *L, int stat);
+
+
+/* predefined references */
+#define LUA_NOREF (-2)
+#define LUA_REFNIL (-1)
+
+LUALIB_API int (luaL_ref) (lua_State *L, int t);
+LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref);
+
+LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename,
+ const char *mode);
+
+#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL)
+
+LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz,
+ const char *name, const char *mode);
+LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);
+
+LUALIB_API lua_State *(luaL_newstate) (void);
+
+LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx);
+
+LUALIB_API void (luaL_addgsub) (luaL_Buffer *b, const char *s,
+ const char *p, const char *r);
+LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s,
+ const char *p, const char *r);
+
+LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup);
+
+LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname);
+
+LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1,
+ const char *msg, int level);
+
+LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
+ lua_CFunction openf, int glb);
+
+/*
+** ===============================================================
+** some useful macros
+** ===============================================================
+*/
+
+
+#define luaL_newlibtable(L,l) \
+ lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1)
+
+#define luaL_newlib(L,l) \
+ (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))
+
+#define luaL_argcheck(L, cond,arg,extramsg) \
+ ((void)(luai_likely(cond) || luaL_argerror(L, (arg), (extramsg))))
+
+#define luaL_argexpected(L,cond,arg,tname) \
+ ((void)(luai_likely(cond) || luaL_typeerror(L, (arg), (tname))))
+
+#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))
+#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))
+
+#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i)))
+
+#define luaL_dofile(L, fn) \
+ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0))
+
+#define luaL_dostring(L, s) \
+ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0))
+
+#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n)))
+
+#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n)))
+
+#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)
+
+
+/*
+** Perform arithmetic operations on lua_Integer values with wrap-around
+** semantics, as the Lua core does.
+*/
+#define luaL_intop(op,v1,v2) \
+ ((lua_Integer)((lua_Unsigned)(v1) op (lua_Unsigned)(v2)))
+
+
+/* push the value used to represent failure/error */
+#define luaL_pushfail(L) lua_pushnil(L)
+
+
+/*
+** Internal assertions for in-house debugging
+*/
+#if !defined(lua_assert)
+
+#if defined LUAI_ASSERT
+ #include <assert.h>
+ #define lua_assert(c) assert(c)
+#else
+ #define lua_assert(c) ((void)0)
+#endif
+
+#endif
+
+
+
+/*
+** {======================================================
+** Generic Buffer manipulation
+** =======================================================
+*/
+
+struct luaL_Buffer {
+ char *b; /* buffer address */
+ size_t size; /* buffer size */
+ size_t n; /* number of characters in buffer */
+ lua_State *L;
+ union {
+ LUAI_MAXALIGN; /* ensure maximum alignment for buffer */
+ char b[LUAL_BUFFERSIZE]; /* initial buffer */
+ } init;
+};
+
+
+#define luaL_bufflen(bf) ((bf)->n)
+#define luaL_buffaddr(bf) ((bf)->b)
+
+
+#define luaL_addchar(B,c) \
+ ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \
+ ((B)->b[(B)->n++] = (c)))
+
+#define luaL_addsize(B,s) ((B)->n += (s))
+
+#define luaL_buffsub(B,s) ((B)->n -= (s))
+
+LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B);
+LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz);
+LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l);
+LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s);
+LUALIB_API void (luaL_addvalue) (luaL_Buffer *B);
+LUALIB_API void (luaL_pushresult) (luaL_Buffer *B);
+LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz);
+LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz);
+
+#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE)
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** File handles for IO library
+** =======================================================
+*/
+
+/*
+** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and
+** initial structure 'luaL_Stream' (it may contain other fields
+** after that initial structure).
+*/
+
+#define LUA_FILEHANDLE "FILE*"
+
+
+typedef struct luaL_Stream {
+ FILE *f; /* stream (NULL for incompletely created streams) */
+ lua_CFunction closef; /* to close stream (NULL for closed streams) */
+} luaL_Stream;
+
+/* }====================================================== */
+
+/*
+** {==================================================================
+** "Abstraction Layer" for basic report of messages and errors
+** ===================================================================
+*/
+
+/* print a string */
+#if !defined(lua_writestring)
+#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout)
+#endif
+
+/* print a newline and flush the output */
+#if !defined(lua_writeline)
+#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout))
+#endif
+
+/* print an error message */
+#if !defined(lua_writestringerror)
+#define lua_writestringerror(s,p) \
+ (fprintf(stderr, (s), (p)), fflush(stderr))
+#endif
+
+/* }================================================================== */
+
+
+/*
+** {============================================================
+** Compatibility with deprecated conversions
+** =============================================================
+*/
+#if defined(LUA_COMPAT_APIINTCASTS)
+
+#define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a))
+#define luaL_optunsigned(L,a,d) \
+ ((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d)))
+
+#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n)))
+#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d)))
+
+#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n)))
+#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d)))
+
+#endif
+/* }============================================================ */
+
+
+
+#endif
+
+
diff --git a/source/luametatex/source/luacore/lua54/src/lbaselib.c b/source/luametatex/source/luacore/lua54/src/lbaselib.c
new file mode 100644
index 000000000..1d60c9ded
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lbaselib.c
@@ -0,0 +1,549 @@
+/*
+** $Id: lbaselib.c $
+** Basic library
+** See Copyright Notice in lua.h
+*/
+
+#define lbaselib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+static int luaB_print (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int i;
+ for (i = 1; i <= n; i++) { /* for each argument */
+ size_t l;
+ const char *s = luaL_tolstring(L, i, &l); /* convert it to string */
+ if (i > 1) /* not the first element? */
+ lua_writestring("\t", 1); /* add a tab before it */
+ lua_writestring(s, l); /* print it */
+ lua_pop(L, 1); /* pop result */
+ }
+ lua_writeline();
+ return 0;
+}
+
+
+/*
+** Creates a warning with all given arguments.
+** Check first for errors; otherwise an error may interrupt
+** the composition of a warning, leaving it unfinished.
+*/
+static int luaB_warn (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int i;
+ luaL_checkstring(L, 1); /* at least one argument */
+ for (i = 2; i <= n; i++)
+ luaL_checkstring(L, i); /* make sure all arguments are strings */
+ for (i = 1; i < n; i++) /* compose warning */
+ lua_warning(L, lua_tostring(L, i), 1);
+ lua_warning(L, lua_tostring(L, n), 0); /* close warning */
+ return 0;
+}
+
+
+#define SPACECHARS " \f\n\r\t\v"
+
+static const char *b_str2int (const char *s, int base, lua_Integer *pn) {
+ lua_Unsigned n = 0;
+ int neg = 0;
+ s += strspn(s, SPACECHARS); /* skip initial spaces */
+ if (*s == '-') { s++; neg = 1; } /* handle sign */
+ else if (*s == '+') s++;
+ if (!isalnum((unsigned char)*s)) /* no digit? */
+ return NULL;
+ do {
+ int digit = (isdigit((unsigned char)*s)) ? *s - '0'
+ : (toupper((unsigned char)*s) - 'A') + 10;
+ if (digit >= base) return NULL; /* invalid numeral */
+ n = n * base + digit;
+ s++;
+ } while (isalnum((unsigned char)*s));
+ s += strspn(s, SPACECHARS); /* skip trailing spaces */
+ *pn = (lua_Integer)((neg) ? (0u - n) : n);
+ return s;
+}
+
+
+static int luaB_tonumber (lua_State *L) {
+ if (lua_isnoneornil(L, 2)) { /* standard conversion? */
+ if (lua_type(L, 1) == LUA_TNUMBER) { /* already a number? */
+ lua_settop(L, 1); /* yes; return it */
+ return 1;
+ }
+ else {
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ if (s != NULL && lua_stringtonumber(L, s) == l + 1)
+ return 1; /* successful conversion to number */
+ /* else not a number */
+ luaL_checkany(L, 1); /* (but there must be some parameter) */
+ }
+ }
+ else {
+ size_t l;
+ const char *s;
+ lua_Integer n = 0; /* to avoid warnings */
+ lua_Integer base = luaL_checkinteger(L, 2);
+ luaL_checktype(L, 1, LUA_TSTRING); /* no numbers as strings */
+ s = lua_tolstring(L, 1, &l);
+ luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
+ if (b_str2int(s, (int)base, &n) == s + l) {
+ lua_pushinteger(L, n);
+ return 1;
+ } /* else not a number */
+ } /* else not a number */
+ luaL_pushfail(L); /* not a number */
+ return 1;
+}
+
+
+static int luaB_error (lua_State *L) {
+ int level = (int)luaL_optinteger(L, 2, 1);
+ lua_settop(L, 1);
+ if (lua_type(L, 1) == LUA_TSTRING && level > 0) {
+ luaL_where(L, level); /* add extra information */
+ lua_pushvalue(L, 1);
+ lua_concat(L, 2);
+ }
+ return lua_error(L);
+}
+
+
+static int luaB_getmetatable (lua_State *L) {
+ luaL_checkany(L, 1);
+ if (!lua_getmetatable(L, 1)) {
+ lua_pushnil(L);
+ return 1; /* no metatable */
+ }
+ luaL_getmetafield(L, 1, "__metatable");
+ return 1; /* returns either __metatable field (if present) or metatable */
+}
+
+
+static int luaB_setmetatable (lua_State *L) {
+ int t = lua_type(L, 2);
+ luaL_checktype(L, 1, LUA_TTABLE);
+ luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
+ if (l_unlikely(luaL_getmetafield(L, 1, "__metatable") != LUA_TNIL))
+ return luaL_error(L, "cannot change a protected metatable");
+ lua_settop(L, 2);
+ lua_setmetatable(L, 1);
+ return 1;
+}
+
+
+static int luaB_rawequal (lua_State *L) {
+ luaL_checkany(L, 1);
+ luaL_checkany(L, 2);
+ lua_pushboolean(L, lua_rawequal(L, 1, 2));
+ return 1;
+}
+
+
+static int luaB_rawlen (lua_State *L) {
+ int t = lua_type(L, 1);
+ luaL_argexpected(L, t == LUA_TTABLE || t == LUA_TSTRING, 1,
+ "table or string");
+ lua_pushinteger(L, lua_rawlen(L, 1));
+ return 1;
+}
+
+
+static int luaB_rawget (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ luaL_checkany(L, 2);
+ lua_settop(L, 2);
+ lua_rawget(L, 1);
+ return 1;
+}
+
+static int luaB_rawset (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ luaL_checkany(L, 2);
+ luaL_checkany(L, 3);
+ lua_settop(L, 3);
+ lua_rawset(L, 1);
+ return 1;
+}
+
+
+static int pushmode (lua_State *L, int oldmode) {
+ if (oldmode == -1)
+ luaL_pushfail(L); /* invalid call to 'lua_gc' */
+ else
+ lua_pushstring(L, (oldmode == LUA_GCINC) ? "incremental"
+ : "generational");
+ return 1;
+}
+
+
+/*
+** check whether call to 'lua_gc' was valid (not inside a finalizer)
+*/
+#define checkvalres(res) { if (res == -1) break; }
+
+static int luaB_collectgarbage (lua_State *L) {
+ static const char *const opts[] = {"stop", "restart", "collect",
+ "count", "step", "setpause", "setstepmul",
+ "isrunning", "generational", "incremental", NULL};
+ static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
+ LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
+ LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC};
+ int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];
+ switch (o) {
+ case LUA_GCCOUNT: {
+ int k = lua_gc(L, o);
+ int b = lua_gc(L, LUA_GCCOUNTB);
+ checkvalres(k);
+ lua_pushnumber(L, (lua_Number)k + ((lua_Number)b/1024));
+ return 1;
+ }
+ case LUA_GCSTEP: {
+ int step = (int)luaL_optinteger(L, 2, 0);
+ int res = lua_gc(L, o, step);
+ checkvalres(res);
+ lua_pushboolean(L, res);
+ return 1;
+ }
+ case LUA_GCSETPAUSE:
+ case LUA_GCSETSTEPMUL: {
+ int p = (int)luaL_optinteger(L, 2, 0);
+ int previous = lua_gc(L, o, p);
+ checkvalres(previous);
+ lua_pushinteger(L, previous);
+ return 1;
+ }
+ case LUA_GCISRUNNING: {
+ int res = lua_gc(L, o);
+ checkvalres(res);
+ lua_pushboolean(L, res);
+ return 1;
+ }
+ case LUA_GCGEN: {
+ int minormul = (int)luaL_optinteger(L, 2, 0);
+ int majormul = (int)luaL_optinteger(L, 3, 0);
+ return pushmode(L, lua_gc(L, o, minormul, majormul));
+ }
+ case LUA_GCINC: {
+ int pause = (int)luaL_optinteger(L, 2, 0);
+ int stepmul = (int)luaL_optinteger(L, 3, 0);
+ int stepsize = (int)luaL_optinteger(L, 4, 0);
+ return pushmode(L, lua_gc(L, o, pause, stepmul, stepsize));
+ }
+ default: {
+ int res = lua_gc(L, o);
+ checkvalres(res);
+ lua_pushinteger(L, res);
+ return 1;
+ }
+ }
+ luaL_pushfail(L); /* invalid call (inside a finalizer) */
+ return 1;
+}
+
+
+static int luaB_type (lua_State *L) {
+ int t = lua_type(L, 1);
+ luaL_argcheck(L, t != LUA_TNONE, 1, "value expected");
+ lua_pushstring(L, lua_typename(L, t));
+ return 1;
+}
+
+
+static int luaB_next (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ lua_settop(L, 2); /* create a 2nd argument if there isn't one */
+ if (lua_next(L, 1))
+ return 2;
+ else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+
+static int pairscont (lua_State *L, int status, lua_KContext k) {
+ (void)L; (void)status; (void)k; /* unused */
+ return 3;
+}
+
+static int luaB_pairs (lua_State *L) {
+ luaL_checkany(L, 1);
+ if (luaL_getmetafield(L, 1, "__pairs") == LUA_TNIL) { /* no metamethod? */
+ lua_pushcfunction(L, luaB_next); /* will return generator, */
+ lua_pushvalue(L, 1); /* state, */
+ lua_pushnil(L); /* and initial value */
+ }
+ else {
+ lua_pushvalue(L, 1); /* argument 'self' to metamethod */
+ lua_callk(L, 1, 3, 0, pairscont); /* get 3 values from metamethod */
+ }
+ return 3;
+}
+
+
+/*
+** Traversal function for 'ipairs'
+*/
+static int ipairsaux (lua_State *L) {
+ lua_Integer i = luaL_checkinteger(L, 2);
+ i = luaL_intop(+, i, 1);
+ lua_pushinteger(L, i);
+ return (lua_geti(L, 1, i) == LUA_TNIL) ? 1 : 2;
+}
+
+
+/*
+** 'ipairs' function. Returns 'ipairsaux', given "table", 0.
+** (The given "table" may not be a table.)
+*/
+static int luaB_ipairs (lua_State *L) {
+ luaL_checkany(L, 1);
+ lua_pushcfunction(L, ipairsaux); /* iteration function */
+ lua_pushvalue(L, 1); /* state */
+ lua_pushinteger(L, 0); /* initial value */
+ return 3;
+}
+
+
+static int load_aux (lua_State *L, int status, int envidx) {
+ if (l_likely(status == LUA_OK)) {
+ if (envidx != 0) { /* 'env' parameter? */
+ lua_pushvalue(L, envidx); /* environment for loaded function */
+ if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */
+ lua_pop(L, 1); /* remove 'env' if not used by previous call */
+ }
+ return 1;
+ }
+ else { /* error (message is on top of the stack) */
+ luaL_pushfail(L);
+ lua_insert(L, -2); /* put before error message */
+ return 2; /* return fail plus error message */
+ }
+}
+
+
+static int luaB_loadfile (lua_State *L) {
+ const char *fname = luaL_optstring(L, 1, NULL);
+ const char *mode = luaL_optstring(L, 2, NULL);
+ int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */
+ int status = luaL_loadfilex(L, fname, mode);
+ return load_aux(L, status, env);
+}
+
+
+/*
+** {======================================================
+** Generic Read function
+** =======================================================
+*/
+
+
+/*
+** reserved slot, above all arguments, to hold a copy of the returned
+** string to avoid it being collected while parsed. 'load' has four
+** optional arguments (chunk, source name, mode, and environment).
+*/
+#define RESERVEDSLOT 5
+
+
+/*
+** Reader for generic 'load' function: 'lua_load' uses the
+** stack for internal stuff, so the reader cannot change the
+** stack top. Instead, it keeps its resulting string in a
+** reserved slot inside the stack.
+*/
+static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
+ (void)(ud); /* not used */
+ luaL_checkstack(L, 2, "too many nested functions");
+ lua_pushvalue(L, 1); /* get function */
+ lua_call(L, 0, 1); /* call it */
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1); /* pop result */
+ *size = 0;
+ return NULL;
+ }
+ else if (l_unlikely(!lua_isstring(L, -1)))
+ luaL_error(L, "reader function must return a string");
+ lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */
+ return lua_tolstring(L, RESERVEDSLOT, size);
+}
+
+
+static int luaB_load (lua_State *L) {
+ int status;
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ const char *mode = luaL_optstring(L, 3, "bt");
+ int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */
+ if (s != NULL) { /* loading a string? */
+ const char *chunkname = luaL_optstring(L, 2, s);
+ status = luaL_loadbufferx(L, s, l, chunkname, mode);
+ }
+ else { /* loading from a reader function */
+ const char *chunkname = luaL_optstring(L, 2, "=(load)");
+ luaL_checktype(L, 1, LUA_TFUNCTION);
+ lua_settop(L, RESERVEDSLOT); /* create reserved slot */
+ status = lua_load(L, generic_reader, NULL, chunkname, mode);
+ }
+ return load_aux(L, status, env);
+}
+
+/* }====================================================== */
+
+
+static int dofilecont (lua_State *L, int d1, lua_KContext d2) {
+ (void)d1; (void)d2; /* only to match 'lua_Kfunction' prototype */
+ return lua_gettop(L) - 1;
+}
+
+
+static int luaB_dofile (lua_State *L) {
+ const char *fname = luaL_optstring(L, 1, NULL);
+ lua_settop(L, 1);
+ if (l_unlikely(luaL_loadfile(L, fname) != LUA_OK))
+ return lua_error(L);
+ lua_callk(L, 0, LUA_MULTRET, 0, dofilecont);
+ return dofilecont(L, 0, 0);
+}
+
+
+static int luaB_assert (lua_State *L) {
+ if (l_likely(lua_toboolean(L, 1))) /* condition is true? */
+ return lua_gettop(L); /* return all arguments */
+ else { /* error */
+ luaL_checkany(L, 1); /* there must be a condition */
+ lua_remove(L, 1); /* remove it */
+ lua_pushliteral(L, "assertion failed!"); /* default message */
+ lua_settop(L, 1); /* leave only message (default if no other one) */
+ return luaB_error(L); /* call 'error' */
+ }
+}
+
+
+static int luaB_select (lua_State *L) {
+ int n = lua_gettop(L);
+ if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
+ lua_pushinteger(L, n-1);
+ return 1;
+ }
+ else {
+ lua_Integer i = luaL_checkinteger(L, 1);
+ if (i < 0) i = n + i;
+ else if (i > n) i = n;
+ luaL_argcheck(L, 1 <= i, 1, "index out of range");
+ return n - (int)i;
+ }
+}
+
+
+/*
+** Continuation function for 'pcall' and 'xpcall'. Both functions
+** already pushed a 'true' before doing the call, so in case of success
+** 'finishpcall' only has to return everything in the stack minus
+** 'extra' values (where 'extra' is exactly the number of items to be
+** ignored).
+*/
+static int finishpcall (lua_State *L, int status, lua_KContext extra) {
+ if (l_unlikely(status != LUA_OK && status != LUA_YIELD)) { /* error? */
+ lua_pushboolean(L, 0); /* first result (false) */
+ lua_pushvalue(L, -2); /* error message */
+ return 2; /* return false, msg */
+ }
+ else
+ return lua_gettop(L) - (int)extra; /* return all results */
+}
+
+
+static int luaB_pcall (lua_State *L) {
+ int status;
+ luaL_checkany(L, 1);
+ lua_pushboolean(L, 1); /* first result if no errors */
+ lua_insert(L, 1); /* put it in place */
+ status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, finishpcall);
+ return finishpcall(L, status, 0);
+}
+
+
+/*
+** Do a protected call with error handling. After 'lua_rotate', the
+** stack will have <f, err, true, f, [args...]>; so, the function passes
+** 2 to 'finishpcall' to skip the 2 first values when returning results.
+*/
+static int luaB_xpcall (lua_State *L) {
+ int status;
+ int n = lua_gettop(L);
+ luaL_checktype(L, 2, LUA_TFUNCTION); /* check error function */
+ lua_pushboolean(L, 1); /* first result */
+ lua_pushvalue(L, 1); /* function */
+ lua_rotate(L, 3, 2); /* move them below function's arguments */
+ status = lua_pcallk(L, n - 2, LUA_MULTRET, 2, 2, finishpcall);
+ return finishpcall(L, status, 2);
+}
+
+
+static int luaB_tostring (lua_State *L) {
+ luaL_checkany(L, 1);
+ luaL_tolstring(L, 1, NULL);
+ return 1;
+}
+
+
+static const luaL_Reg base_funcs[] = {
+ {"assert", luaB_assert},
+ {"collectgarbage", luaB_collectgarbage},
+ {"dofile", luaB_dofile},
+ {"error", luaB_error},
+ {"getmetatable", luaB_getmetatable},
+ {"ipairs", luaB_ipairs},
+ {"loadfile", luaB_loadfile},
+ {"load", luaB_load},
+ {"next", luaB_next},
+ {"pairs", luaB_pairs},
+ {"pcall", luaB_pcall},
+ {"print", luaB_print},
+ {"warn", luaB_warn},
+ {"rawequal", luaB_rawequal},
+ {"rawlen", luaB_rawlen},
+ {"rawget", luaB_rawget},
+ {"rawset", luaB_rawset},
+ {"select", luaB_select},
+ {"setmetatable", luaB_setmetatable},
+ {"tonumber", luaB_tonumber},
+ {"tostring", luaB_tostring},
+ {"type", luaB_type},
+ {"xpcall", luaB_xpcall},
+ /* placeholders */
+ {LUA_GNAME, NULL},
+ {"_VERSION", NULL},
+ {NULL, NULL}
+};
+
+
+LUAMOD_API int luaopen_base (lua_State *L) {
+ /* open lib into global table */
+ lua_pushglobaltable(L);
+ luaL_setfuncs(L, base_funcs, 0);
+ /* set global _G */
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -2, LUA_GNAME);
+ /* set global _VERSION */
+ lua_pushliteral(L, LUA_VERSION);
+ lua_setfield(L, -2, "_VERSION");
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lcode.c b/source/luametatex/source/luacore/lua54/src/lcode.c
new file mode 100644
index 000000000..911dbd5f1
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lcode.c
@@ -0,0 +1,1844 @@
+/*
+** $Id: lcode.c $
+** Code generator for Lua
+** See Copyright Notice in lua.h
+*/
+
+#define lcode_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <float.h>
+#include <limits.h>
+#include <math.h>
+#include <stdlib.h>
+
+#include "lua.h"
+
+#include "lcode.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "llex.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "lvm.h"
+
+
+/* Maximum number of registers in a Lua function (must fit in 8 bits) */
+#define MAXREGS 255
+
+
+#define hasjumps(e) ((e)->t != (e)->f)
+
+
+static int codesJ (FuncState *fs, OpCode o, int sj, int k);
+
+
+
+/* semantic error */
+l_noret luaK_semerror (LexState *ls, const char *msg) {
+ ls->t.token = 0; /* remove "near <token>" from final message */
+ luaX_syntaxerror(ls, msg);
+}
+
+
+/*
+** If expression is a numeric constant, fills 'v' with its value
+** and returns 1. Otherwise, returns 0.
+*/
+static int tonumeral (const expdesc *e, TValue *v) {
+ if (hasjumps(e))
+ return 0; /* not a numeral */
+ switch (e->k) {
+ case VKINT:
+ if (v) setivalue(v, e->u.ival);
+ return 1;
+ case VKFLT:
+ if (v) setfltvalue(v, e->u.nval);
+ return 1;
+ default: return 0;
+ }
+}
+
+
+/*
+** Get the constant value from a constant expression
+*/
+static TValue *const2val (FuncState *fs, const expdesc *e) {
+ lua_assert(e->k == VCONST);
+ return &fs->ls->dyd->actvar.arr[e->u.info].k;
+}
+
+
+/*
+** If expression is a constant, fills 'v' with its value
+** and returns 1. Otherwise, returns 0.
+*/
+int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v) {
+ if (hasjumps(e))
+ return 0; /* not a constant */
+ switch (e->k) {
+ case VFALSE:
+ setbfvalue(v);
+ return 1;
+ case VTRUE:
+ setbtvalue(v);
+ return 1;
+ case VNIL:
+ setnilvalue(v);
+ return 1;
+ case VKSTR: {
+ setsvalue(fs->ls->L, v, e->u.strval);
+ return 1;
+ }
+ case VCONST: {
+ setobj(fs->ls->L, v, const2val(fs, e));
+ return 1;
+ }
+ default: return tonumeral(e, v);
+ }
+}
+
+
+/*
+** Return the previous instruction of the current code. If there
+** may be a jump target between the current instruction and the
+** previous one, return an invalid instruction (to avoid wrong
+** optimizations).
+*/
+static Instruction *previousinstruction (FuncState *fs) {
+ static const Instruction invalidinstruction = ~(Instruction)0;
+ if (fs->pc > fs->lasttarget)
+ return &fs->f->code[fs->pc - 1]; /* previous instruction */
+ else
+ return cast(Instruction*, &invalidinstruction);
+}
+
+
+/*
+** Create a OP_LOADNIL instruction, but try to optimize: if the previous
+** instruction is also OP_LOADNIL and ranges are compatible, adjust
+** range of previous instruction instead of emitting a new one. (For
+** instance, 'local a; local b' will generate a single opcode.)
+*/
+void luaK_nil (FuncState *fs, int from, int n) {
+ int l = from + n - 1; /* last register to set nil */
+ Instruction *previous = previousinstruction(fs);
+ if (GET_OPCODE(*previous) == OP_LOADNIL) { /* previous is LOADNIL? */
+ int pfrom = GETARG_A(*previous); /* get previous range */
+ int pl = pfrom + GETARG_B(*previous);
+ if ((pfrom <= from && from <= pl + 1) ||
+ (from <= pfrom && pfrom <= l + 1)) { /* can connect both? */
+ if (pfrom < from) from = pfrom; /* from = min(from, pfrom) */
+ if (pl > l) l = pl; /* l = max(l, pl) */
+ SETARG_A(*previous, from);
+ SETARG_B(*previous, l - from);
+ return;
+ } /* else go through */
+ }
+ luaK_codeABC(fs, OP_LOADNIL, from, n - 1, 0); /* else no optimization */
+}
+
+
+/*
+** Gets the destination address of a jump instruction. Used to traverse
+** a list of jumps.
+*/
+static int getjump (FuncState *fs, int pc) {
+ int offset = GETARG_sJ(fs->f->code[pc]);
+ if (offset == NO_JUMP) /* point to itself represents end of list */
+ return NO_JUMP; /* end of list */
+ else
+ return (pc+1)+offset; /* turn offset into absolute position */
+}
+
+
+/*
+** Fix jump instruction at position 'pc' to jump to 'dest'.
+** (Jump addresses are relative in Lua)
+*/
+static void fixjump (FuncState *fs, int pc, int dest) {
+ Instruction *jmp = &fs->f->code[pc];
+ int offset = dest - (pc + 1);
+ lua_assert(dest != NO_JUMP);
+ if (!(-OFFSET_sJ <= offset && offset <= MAXARG_sJ - OFFSET_sJ))
+ luaX_syntaxerror(fs->ls, "control structure too long");
+ lua_assert(GET_OPCODE(*jmp) == OP_JMP);
+ SETARG_sJ(*jmp, offset);
+}
+
+
+/*
+** Concatenate jump-list 'l2' into jump-list 'l1'
+*/
+void luaK_concat (FuncState *fs, int *l1, int l2) {
+ if (l2 == NO_JUMP) return; /* nothing to concatenate? */
+ else if (*l1 == NO_JUMP) /* no original list? */
+ *l1 = l2; /* 'l1' points to 'l2' */
+ else {
+ int list = *l1;
+ int next;
+ while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */
+ list = next;
+ fixjump(fs, list, l2); /* last element links to 'l2' */
+ }
+}
+
+
+/*
+** Create a jump instruction and return its position, so its destination
+** can be fixed later (with 'fixjump').
+*/
+int luaK_jump (FuncState *fs) {
+ return codesJ(fs, OP_JMP, NO_JUMP, 0);
+}
+
+
+/*
+** Code a 'return' instruction
+*/
+void luaK_ret (FuncState *fs, int first, int nret) {
+ OpCode op;
+ switch (nret) {
+ case 0: op = OP_RETURN0; break;
+ case 1: op = OP_RETURN1; break;
+ default: op = OP_RETURN; break;
+ }
+ luaK_codeABC(fs, op, first, nret + 1, 0);
+}
+
+
+/*
+** Code a "conditional jump", that is, a test or comparison opcode
+** followed by a jump. Return jump position.
+*/
+static int condjump (FuncState *fs, OpCode op, int A, int B, int C, int k) {
+ luaK_codeABCk(fs, op, A, B, C, k);
+ return luaK_jump(fs);
+}
+
+
+/*
+** returns current 'pc' and marks it as a jump target (to avoid wrong
+** optimizations with consecutive instructions not in the same basic block).
+*/
+int luaK_getlabel (FuncState *fs) {
+ fs->lasttarget = fs->pc;
+ return fs->pc;
+}
+
+
+/*
+** Returns the position of the instruction "controlling" a given
+** jump (that is, its condition), or the jump itself if it is
+** unconditional.
+*/
+static Instruction *getjumpcontrol (FuncState *fs, int pc) {
+ Instruction *pi = &fs->f->code[pc];
+ if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1))))
+ return pi-1;
+ else
+ return pi;
+}
+
+
+/*
+** Patch destination register for a TESTSET instruction.
+** If instruction in position 'node' is not a TESTSET, return 0 ("fails").
+** Otherwise, if 'reg' is not 'NO_REG', set it as the destination
+** register. Otherwise, change instruction to a simple 'TEST' (produces
+** no register value)
+*/
+static int patchtestreg (FuncState *fs, int node, int reg) {
+ Instruction *i = getjumpcontrol(fs, node);
+ if (GET_OPCODE(*i) != OP_TESTSET)
+ return 0; /* cannot patch other instructions */
+ if (reg != NO_REG && reg != GETARG_B(*i))
+ SETARG_A(*i, reg);
+ else {
+ /* no register to put value or register already has the value;
+ change instruction to simple test */
+ *i = CREATE_ABCk(OP_TEST, GETARG_B(*i), 0, 0, GETARG_k(*i));
+ }
+ return 1;
+}
+
+
+/*
+** Traverse a list of tests ensuring no one produces a value
+*/
+static void removevalues (FuncState *fs, int list) {
+ for (; list != NO_JUMP; list = getjump(fs, list))
+ patchtestreg(fs, list, NO_REG);
+}
+
+
+/*
+** Traverse a list of tests, patching their destination address and
+** registers: tests producing values jump to 'vtarget' (and put their
+** values in 'reg'), other tests jump to 'dtarget'.
+*/
+static void patchlistaux (FuncState *fs, int list, int vtarget, int reg,
+ int dtarget) {
+ while (list != NO_JUMP) {
+ int next = getjump(fs, list);
+ if (patchtestreg(fs, list, reg))
+ fixjump(fs, list, vtarget);
+ else
+ fixjump(fs, list, dtarget); /* jump to default target */
+ list = next;
+ }
+}
+
+
+/*
+** Path all jumps in 'list' to jump to 'target'.
+** (The assert means that we cannot fix a jump to a forward address
+** because we only know addresses once code is generated.)
+*/
+void luaK_patchlist (FuncState *fs, int list, int target) {
+ lua_assert(target <= fs->pc);
+ patchlistaux(fs, list, target, NO_REG, target);
+}
+
+
+void luaK_patchtohere (FuncState *fs, int list) {
+ int hr = luaK_getlabel(fs); /* mark "here" as a jump target */
+ luaK_patchlist(fs, list, hr);
+}
+
+
+/* limit for difference between lines in relative line info. */
+#define LIMLINEDIFF 0x80
+
+
+/*
+** Save line info for a new instruction. If difference from last line
+** does not fit in a byte, of after that many instructions, save a new
+** absolute line info; (in that case, the special value 'ABSLINEINFO'
+** in 'lineinfo' signals the existence of this absolute information.)
+** Otherwise, store the difference from last line in 'lineinfo'.
+*/
+static void savelineinfo (FuncState *fs, Proto *f, int line) {
+ int linedif = line - fs->previousline;
+ int pc = fs->pc - 1; /* last instruction coded */
+ if (abs(linedif) >= LIMLINEDIFF || fs->iwthabs++ >= MAXIWTHABS) {
+ luaM_growvector(fs->ls->L, f->abslineinfo, fs->nabslineinfo,
+ f->sizeabslineinfo, AbsLineInfo, MAX_INT, "lines");
+ f->abslineinfo[fs->nabslineinfo].pc = pc;
+ f->abslineinfo[fs->nabslineinfo++].line = line;
+ linedif = ABSLINEINFO; /* signal that there is absolute information */
+ fs->iwthabs = 1; /* restart counter */
+ }
+ luaM_growvector(fs->ls->L, f->lineinfo, pc, f->sizelineinfo, ls_byte,
+ MAX_INT, "opcodes");
+ f->lineinfo[pc] = linedif;
+ fs->previousline = line; /* last line saved */
+}
+
+
+/*
+** Remove line information from the last instruction.
+** If line information for that instruction is absolute, set 'iwthabs'
+** above its max to force the new (replacing) instruction to have
+** absolute line info, too.
+*/
+static void removelastlineinfo (FuncState *fs) {
+ Proto *f = fs->f;
+ int pc = fs->pc - 1; /* last instruction coded */
+ if (f->lineinfo[pc] != ABSLINEINFO) { /* relative line info? */
+ fs->previousline -= f->lineinfo[pc]; /* correct last line saved */
+ fs->iwthabs--; /* undo previous increment */
+ }
+ else { /* absolute line information */
+ lua_assert(f->abslineinfo[fs->nabslineinfo - 1].pc == pc);
+ fs->nabslineinfo--; /* remove it */
+ fs->iwthabs = MAXIWTHABS + 1; /* force next line info to be absolute */
+ }
+}
+
+
+/*
+** Remove the last instruction created, correcting line information
+** accordingly.
+*/
+static void removelastinstruction (FuncState *fs) {
+ removelastlineinfo(fs);
+ fs->pc--;
+}
+
+
+/*
+** Emit instruction 'i', checking for array sizes and saving also its
+** line information. Return 'i' position.
+*/
+int luaK_code (FuncState *fs, Instruction i) {
+ Proto *f = fs->f;
+ /* put new instruction in code array */
+ luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction,
+ MAX_INT, "opcodes");
+ f->code[fs->pc++] = i;
+ savelineinfo(fs, f, fs->ls->lastline);
+ return fs->pc - 1; /* index of new instruction */
+}
+
+
+/*
+** Format and emit an 'iABC' instruction. (Assertions check consistency
+** of parameters versus opcode.)
+*/
+int luaK_codeABCk (FuncState *fs, OpCode o, int a, int b, int c, int k) {
+ lua_assert(getOpMode(o) == iABC);
+ lua_assert(a <= MAXARG_A && b <= MAXARG_B &&
+ c <= MAXARG_C && (k & ~1) == 0);
+ return luaK_code(fs, CREATE_ABCk(o, a, b, c, k));
+}
+
+
+/*
+** Format and emit an 'iABx' instruction.
+*/
+int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
+ lua_assert(getOpMode(o) == iABx);
+ lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx);
+ return luaK_code(fs, CREATE_ABx(o, a, bc));
+}
+
+
+/*
+** Format and emit an 'iAsBx' instruction.
+*/
+int luaK_codeAsBx (FuncState *fs, OpCode o, int a, int bc) {
+ unsigned int b = bc + OFFSET_sBx;
+ lua_assert(getOpMode(o) == iAsBx);
+ lua_assert(a <= MAXARG_A && b <= MAXARG_Bx);
+ return luaK_code(fs, CREATE_ABx(o, a, b));
+}
+
+
+/*
+** Format and emit an 'isJ' instruction.
+*/
+static int codesJ (FuncState *fs, OpCode o, int sj, int k) {
+ unsigned int j = sj + OFFSET_sJ;
+ lua_assert(getOpMode(o) == isJ);
+ lua_assert(j <= MAXARG_sJ && (k & ~1) == 0);
+ return luaK_code(fs, CREATE_sJ(o, j, k));
+}
+
+
+/*
+** Emit an "extra argument" instruction (format 'iAx')
+*/
+static int codeextraarg (FuncState *fs, int a) {
+ lua_assert(a <= MAXARG_Ax);
+ return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a));
+}
+
+
+/*
+** Emit a "load constant" instruction, using either 'OP_LOADK'
+** (if constant index 'k' fits in 18 bits) or an 'OP_LOADKX'
+** instruction with "extra argument".
+*/
+static int luaK_codek (FuncState *fs, int reg, int k) {
+ if (k <= MAXARG_Bx)
+ return luaK_codeABx(fs, OP_LOADK, reg, k);
+ else {
+ int p = luaK_codeABx(fs, OP_LOADKX, reg, 0);
+ codeextraarg(fs, k);
+ return p;
+ }
+}
+
+
+/*
+** Check register-stack level, keeping track of its maximum size
+** in field 'maxstacksize'
+*/
+void luaK_checkstack (FuncState *fs, int n) {
+ int newstack = fs->freereg + n;
+ if (newstack > fs->f->maxstacksize) {
+ if (newstack >= MAXREGS)
+ luaX_syntaxerror(fs->ls,
+ "function or expression needs too many registers");
+ fs->f->maxstacksize = cast_byte(newstack);
+ }
+}
+
+
+/*
+** Reserve 'n' registers in register stack
+*/
+void luaK_reserveregs (FuncState *fs, int n) {
+ luaK_checkstack(fs, n);
+ fs->freereg += n;
+}
+
+
+/*
+** Free register 'reg', if it is neither a constant index nor
+** a local variable.
+)
+*/
+static void freereg (FuncState *fs, int reg) {
+ if (reg >= luaY_nvarstack(fs)) {
+ fs->freereg--;
+ lua_assert(reg == fs->freereg);
+ }
+}
+
+
+/*
+** Free two registers in proper order
+*/
+static void freeregs (FuncState *fs, int r1, int r2) {
+ if (r1 > r2) {
+ freereg(fs, r1);
+ freereg(fs, r2);
+ }
+ else {
+ freereg(fs, r2);
+ freereg(fs, r1);
+ }
+}
+
+
+/*
+** Free register used by expression 'e' (if any)
+*/
+static void freeexp (FuncState *fs, expdesc *e) {
+ if (e->k == VNONRELOC)
+ freereg(fs, e->u.info);
+}
+
+
+/*
+** Free registers used by expressions 'e1' and 'e2' (if any) in proper
+** order.
+*/
+static void freeexps (FuncState *fs, expdesc *e1, expdesc *e2) {
+ int r1 = (e1->k == VNONRELOC) ? e1->u.info : -1;
+ int r2 = (e2->k == VNONRELOC) ? e2->u.info : -1;
+ freeregs(fs, r1, r2);
+}
+
+
+/*
+** Add constant 'v' to prototype's list of constants (field 'k').
+** Use scanner's table to cache position of constants in constant list
+** and try to reuse constants. Because some values should not be used
+** as keys (nil cannot be a key, integer keys can collapse with float
+** keys), the caller must provide a useful 'key' for indexing the cache.
+** Note that all functions share the same table, so entering or exiting
+** a function can make some indices wrong.
+*/
+static int addk (FuncState *fs, TValue *key, TValue *v) {
+ TValue val;
+ lua_State *L = fs->ls->L;
+ Proto *f = fs->f;
+ const TValue *idx = luaH_get(fs->ls->h, key); /* query scanner table */
+ int k, oldsize;
+ if (ttisinteger(idx)) { /* is there an index there? */
+ k = cast_int(ivalue(idx));
+ /* correct value? (warning: must distinguish floats from integers!) */
+ if (k < fs->nk && ttypetag(&f->k[k]) == ttypetag(v) &&
+ luaV_rawequalobj(&f->k[k], v))
+ return k; /* reuse index */
+ }
+ /* constant not found; create a new entry */
+ oldsize = f->sizek;
+ k = fs->nk;
+ /* numerical value does not need GC barrier;
+ table has no metatable, so it does not need to invalidate cache */
+ setivalue(&val, k);
+ luaH_finishset(L, fs->ls->h, key, idx, &val);
+ luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants");
+ while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);
+ setobj(L, &f->k[k], v);
+ fs->nk++;
+ luaC_barrier(L, f, v);
+ return k;
+}
+
+
+/*
+** Add a string to list of constants and return its index.
+*/
+static int stringK (FuncState *fs, TString *s) {
+ TValue o;
+ setsvalue(fs->ls->L, &o, s);
+ return addk(fs, &o, &o); /* use string itself as key */
+}
+
+
+/*
+** Add an integer to list of constants and return its index.
+*/
+static int luaK_intK (FuncState *fs, lua_Integer n) {
+ TValue o;
+ setivalue(&o, n);
+ return addk(fs, &o, &o); /* use integer itself as key */
+}
+
+/*
+** Add a float to list of constants and return its index. Floats
+** with integral values need a different key, to avoid collision
+** with actual integers. To that, we add to the number its smaller
+** power-of-two fraction that is still significant in its scale.
+** For doubles, that would be 1/2^52.
+** (This method is not bulletproof: there may be another float
+** with that value, and for floats larger than 2^53 the result is
+** still an integer. At worst, this only wastes an entry with
+** a duplicate.)
+*/
+static int luaK_numberK (FuncState *fs, lua_Number r) {
+ TValue o;
+ lua_Integer ik;
+ setfltvalue(&o, r);
+ if (!luaV_flttointeger(r, &ik, F2Ieq)) /* not an integral value? */
+ return addk(fs, &o, &o); /* use number itself as key */
+ else { /* must build an alternative key */
+ const int nbm = l_floatatt(MANT_DIG);
+ const lua_Number q = l_mathop(ldexp)(l_mathop(1.0), -nbm + 1);
+ const lua_Number k = (ik == 0) ? q : r + r*q; /* new key */
+ TValue kv;
+ setfltvalue(&kv, k);
+ /* result is not an integral value, unless value is too large */
+ lua_assert(!luaV_flttointeger(k, &ik, F2Ieq) ||
+ l_mathop(fabs)(r) >= l_mathop(1e6));
+ return addk(fs, &kv, &o);
+ }
+}
+
+
+/*
+** Add a false to list of constants and return its index.
+*/
+static int boolF (FuncState *fs) {
+ TValue o;
+ setbfvalue(&o);
+ return addk(fs, &o, &o); /* use boolean itself as key */
+}
+
+
+/*
+** Add a true to list of constants and return its index.
+*/
+static int boolT (FuncState *fs) {
+ TValue o;
+ setbtvalue(&o);
+ return addk(fs, &o, &o); /* use boolean itself as key */
+}
+
+
+/*
+** Add nil to list of constants and return its index.
+*/
+static int nilK (FuncState *fs) {
+ TValue k, v;
+ setnilvalue(&v);
+ /* cannot use nil as key; instead use table itself to represent nil */
+ sethvalue(fs->ls->L, &k, fs->ls->h);
+ return addk(fs, &k, &v);
+}
+
+
+/*
+** Check whether 'i' can be stored in an 'sC' operand. Equivalent to
+** (0 <= int2sC(i) && int2sC(i) <= MAXARG_C) but without risk of
+** overflows in the hidden addition inside 'int2sC'.
+*/
+static int fitsC (lua_Integer i) {
+ return (l_castS2U(i) + OFFSET_sC <= cast_uint(MAXARG_C));
+}
+
+
+/*
+** Check whether 'i' can be stored in an 'sBx' operand.
+*/
+static int fitsBx (lua_Integer i) {
+ return (-OFFSET_sBx <= i && i <= MAXARG_Bx - OFFSET_sBx);
+}
+
+
+void luaK_int (FuncState *fs, int reg, lua_Integer i) {
+ if (fitsBx(i))
+ luaK_codeAsBx(fs, OP_LOADI, reg, cast_int(i));
+ else
+ luaK_codek(fs, reg, luaK_intK(fs, i));
+}
+
+
+static void luaK_float (FuncState *fs, int reg, lua_Number f) {
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Ieq) && fitsBx(fi))
+ luaK_codeAsBx(fs, OP_LOADF, reg, cast_int(fi));
+ else
+ luaK_codek(fs, reg, luaK_numberK(fs, f));
+}
+
+
+/*
+** Convert a constant in 'v' into an expression description 'e'
+*/
+static void const2exp (TValue *v, expdesc *e) {
+ switch (ttypetag(v)) {
+ case LUA_VNUMINT:
+ e->k = VKINT; e->u.ival = ivalue(v);
+ break;
+ case LUA_VNUMFLT:
+ e->k = VKFLT; e->u.nval = fltvalue(v);
+ break;
+ case LUA_VFALSE:
+ e->k = VFALSE;
+ break;
+ case LUA_VTRUE:
+ e->k = VTRUE;
+ break;
+ case LUA_VNIL:
+ e->k = VNIL;
+ break;
+ case LUA_VSHRSTR: case LUA_VLNGSTR:
+ e->k = VKSTR; e->u.strval = tsvalue(v);
+ break;
+ default: lua_assert(0);
+ }
+}
+
+
+/*
+** Fix an expression to return the number of results 'nresults'.
+** 'e' must be a multi-ret expression (function call or vararg).
+*/
+void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {
+ Instruction *pc = &getinstruction(fs, e);
+ if (e->k == VCALL) /* expression is an open function call? */
+ SETARG_C(*pc, nresults + 1);
+ else {
+ lua_assert(e->k == VVARARG);
+ SETARG_C(*pc, nresults + 1);
+ SETARG_A(*pc, fs->freereg);
+ luaK_reserveregs(fs, 1);
+ }
+}
+
+
+/*
+** Convert a VKSTR to a VK
+*/
+static void str2K (FuncState *fs, expdesc *e) {
+ lua_assert(e->k == VKSTR);
+ e->u.info = stringK(fs, e->u.strval);
+ e->k = VK;
+}
+
+
+/*
+** Fix an expression to return one result.
+** If expression is not a multi-ret expression (function call or
+** vararg), it already returns one result, so nothing needs to be done.
+** Function calls become VNONRELOC expressions (as its result comes
+** fixed in the base register of the call), while vararg expressions
+** become VRELOC (as OP_VARARG puts its results where it wants).
+** (Calls are created returning one result, so that does not need
+** to be fixed.)
+*/
+void luaK_setoneret (FuncState *fs, expdesc *e) {
+ if (e->k == VCALL) { /* expression is an open function call? */
+ /* already returns 1 value */
+ lua_assert(GETARG_C(getinstruction(fs, e)) == 2);
+ e->k = VNONRELOC; /* result has fixed position */
+ e->u.info = GETARG_A(getinstruction(fs, e));
+ }
+ else if (e->k == VVARARG) {
+ SETARG_C(getinstruction(fs, e), 2);
+ e->k = VRELOC; /* can relocate its simple result */
+ }
+}
+
+
+/*
+** Ensure that expression 'e' is not a variable (nor a <const>).
+** (Expression still may have jump lists.)
+*/
+void luaK_dischargevars (FuncState *fs, expdesc *e) {
+ switch (e->k) {
+ case VCONST: {
+ const2exp(const2val(fs, e), e);
+ break;
+ }
+ case VLOCAL: { /* already in a register */
+ e->u.info = e->u.var.ridx;
+ e->k = VNONRELOC; /* becomes a non-relocatable value */
+ break;
+ }
+ case VUPVAL: { /* move value to some (pending) register */
+ e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0);
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXUP: {
+ e->u.info = luaK_codeABC(fs, OP_GETTABUP, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXI: {
+ freereg(fs, e->u.ind.t);
+ e->u.info = luaK_codeABC(fs, OP_GETI, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXSTR: {
+ freereg(fs, e->u.ind.t);
+ e->u.info = luaK_codeABC(fs, OP_GETFIELD, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXED: {
+ freeregs(fs, e->u.ind.t, e->u.ind.idx);
+ e->u.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
+ break;
+ }
+ case VVARARG: case VCALL: {
+ luaK_setoneret(fs, e);
+ break;
+ }
+ default: break; /* there is one value available (somewhere) */
+ }
+}
+
+
+/*
+** Ensure expression value is in register 'reg', making 'e' a
+** non-relocatable expression.
+** (Expression still may have jump lists.)
+*/
+static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VNIL: {
+ luaK_nil(fs, reg, 1);
+ break;
+ }
+ case VFALSE: {
+ luaK_codeABC(fs, OP_LOADFALSE, reg, 0, 0);
+ break;
+ }
+ case VTRUE: {
+ luaK_codeABC(fs, OP_LOADTRUE, reg, 0, 0);
+ break;
+ }
+ case VKSTR: {
+ str2K(fs, e);
+ } /* FALLTHROUGH */
+ case VK: {
+ luaK_codek(fs, reg, e->u.info);
+ break;
+ }
+ case VKFLT: {
+ luaK_float(fs, reg, e->u.nval);
+ break;
+ }
+ case VKINT: {
+ luaK_int(fs, reg, e->u.ival);
+ break;
+ }
+ case VRELOC: {
+ Instruction *pc = &getinstruction(fs, e);
+ SETARG_A(*pc, reg); /* instruction will put result in 'reg' */
+ break;
+ }
+ case VNONRELOC: {
+ if (reg != e->u.info)
+ luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0);
+ break;
+ }
+ default: {
+ lua_assert(e->k == VJMP);
+ return; /* nothing to do... */
+ }
+ }
+ e->u.info = reg;
+ e->k = VNONRELOC;
+}
+
+
+/*
+** Ensure expression value is in a register, making 'e' a
+** non-relocatable expression.
+** (Expression still may have jump lists.)
+*/
+static void discharge2anyreg (FuncState *fs, expdesc *e) {
+ if (e->k != VNONRELOC) { /* no fixed register yet? */
+ luaK_reserveregs(fs, 1); /* get a register */
+ discharge2reg(fs, e, fs->freereg-1); /* put value there */
+ }
+}
+
+
+static int code_loadbool (FuncState *fs, int A, OpCode op) {
+ luaK_getlabel(fs); /* those instructions may be jump targets */
+ return luaK_codeABC(fs, op, A, 0, 0);
+}
+
+
+/*
+** check whether list has any jump that do not produce a value
+** or produce an inverted value
+*/
+static int need_value (FuncState *fs, int list) {
+ for (; list != NO_JUMP; list = getjump(fs, list)) {
+ Instruction i = *getjumpcontrol(fs, list);
+ if (GET_OPCODE(i) != OP_TESTSET) return 1;
+ }
+ return 0; /* not found */
+}
+
+
+/*
+** Ensures final expression result (which includes results from its
+** jump lists) is in register 'reg'.
+** If expression has jumps, need to patch these jumps either to
+** its final position or to "load" instructions (for those tests
+** that do not produce values).
+*/
+static void exp2reg (FuncState *fs, expdesc *e, int reg) {
+ discharge2reg(fs, e, reg);
+ if (e->k == VJMP) /* expression itself is a test? */
+ luaK_concat(fs, &e->t, e->u.info); /* put this jump in 't' list */
+ if (hasjumps(e)) {
+ int final; /* position after whole expression */
+ int p_f = NO_JUMP; /* position of an eventual LOAD false */
+ int p_t = NO_JUMP; /* position of an eventual LOAD true */
+ if (need_value(fs, e->t) || need_value(fs, e->f)) {
+ int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs);
+ p_f = code_loadbool(fs, reg, OP_LFALSESKIP); /* skip next inst. */
+ p_t = code_loadbool(fs, reg, OP_LOADTRUE);
+ /* jump around these booleans if 'e' is not a test */
+ luaK_patchtohere(fs, fj);
+ }
+ final = luaK_getlabel(fs);
+ patchlistaux(fs, e->f, final, reg, p_f);
+ patchlistaux(fs, e->t, final, reg, p_t);
+ }
+ e->f = e->t = NO_JUMP;
+ e->u.info = reg;
+ e->k = VNONRELOC;
+}
+
+
+/*
+** Ensures final expression result is in next available register.
+*/
+void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
+ luaK_dischargevars(fs, e);
+ freeexp(fs, e);
+ luaK_reserveregs(fs, 1);
+ exp2reg(fs, e, fs->freereg - 1);
+}
+
+
+/*
+** Ensures final expression result is in some (any) register
+** and return that register.
+*/
+int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
+ luaK_dischargevars(fs, e);
+ if (e->k == VNONRELOC) { /* expression already has a register? */
+ if (!hasjumps(e)) /* no jumps? */
+ return e->u.info; /* result is already in a register */
+ if (e->u.info >= luaY_nvarstack(fs)) { /* reg. is not a local? */
+ exp2reg(fs, e, e->u.info); /* put final result in it */
+ return e->u.info;
+ }
+ /* else expression has jumps and cannot change its register
+ to hold the jump values, because it is a local variable.
+ Go through to the default case. */
+ }
+ luaK_exp2nextreg(fs, e); /* default: use next available register */
+ return e->u.info;
+}
+
+
+/*
+** Ensures final expression result is either in a register
+** or in an upvalue.
+*/
+void luaK_exp2anyregup (FuncState *fs, expdesc *e) {
+ if (e->k != VUPVAL || hasjumps(e))
+ luaK_exp2anyreg(fs, e);
+}
+
+
+/*
+** Ensures final expression result is either in a register
+** or it is a constant.
+*/
+void luaK_exp2val (FuncState *fs, expdesc *e) {
+ if (hasjumps(e))
+ luaK_exp2anyreg(fs, e);
+ else
+ luaK_dischargevars(fs, e);
+}
+
+
+/*
+** Try to make 'e' a K expression with an index in the range of R/K
+** indices. Return true iff succeeded.
+*/
+static int luaK_exp2K (FuncState *fs, expdesc *e) {
+ if (!hasjumps(e)) {
+ int info;
+ switch (e->k) { /* move constants to 'k' */
+ case VTRUE: info = boolT(fs); break;
+ case VFALSE: info = boolF(fs); break;
+ case VNIL: info = nilK(fs); break;
+ case VKINT: info = luaK_intK(fs, e->u.ival); break;
+ case VKFLT: info = luaK_numberK(fs, e->u.nval); break;
+ case VKSTR: info = stringK(fs, e->u.strval); break;
+ case VK: info = e->u.info; break;
+ default: return 0; /* not a constant */
+ }
+ if (info <= MAXINDEXRK) { /* does constant fit in 'argC'? */
+ e->k = VK; /* make expression a 'K' expression */
+ e->u.info = info;
+ return 1;
+ }
+ }
+ /* else, expression doesn't fit; leave it unchanged */
+ return 0;
+}
+
+
+/*
+** Ensures final expression result is in a valid R/K index
+** (that is, it is either in a register or in 'k' with an index
+** in the range of R/K indices).
+** Returns 1 iff expression is K.
+*/
+int luaK_exp2RK (FuncState *fs, expdesc *e) {
+ if (luaK_exp2K(fs, e))
+ return 1;
+ else { /* not a constant in the right range: put it in a register */
+ luaK_exp2anyreg(fs, e);
+ return 0;
+ }
+}
+
+
+static void codeABRK (FuncState *fs, OpCode o, int a, int b,
+ expdesc *ec) {
+ int k = luaK_exp2RK(fs, ec);
+ luaK_codeABCk(fs, o, a, b, ec->u.info, k);
+}
+
+
+/*
+** Generate code to store result of expression 'ex' into variable 'var'.
+*/
+void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) {
+ switch (var->k) {
+ case VLOCAL: {
+ freeexp(fs, ex);
+ exp2reg(fs, ex, var->u.var.ridx); /* compute 'ex' into proper place */
+ return;
+ }
+ case VUPVAL: {
+ int e = luaK_exp2anyreg(fs, ex);
+ luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0);
+ break;
+ }
+ case VINDEXUP: {
+ codeABRK(fs, OP_SETTABUP, var->u.ind.t, var->u.ind.idx, ex);
+ break;
+ }
+ case VINDEXI: {
+ codeABRK(fs, OP_SETI, var->u.ind.t, var->u.ind.idx, ex);
+ break;
+ }
+ case VINDEXSTR: {
+ codeABRK(fs, OP_SETFIELD, var->u.ind.t, var->u.ind.idx, ex);
+ break;
+ }
+ case VINDEXED: {
+ codeABRK(fs, OP_SETTABLE, var->u.ind.t, var->u.ind.idx, ex);
+ break;
+ }
+ default: lua_assert(0); /* invalid var kind to store */
+ }
+ freeexp(fs, ex);
+}
+
+
+/*
+** Emit SELF instruction (convert expression 'e' into 'e:key(e,').
+*/
+void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
+ int ereg;
+ luaK_exp2anyreg(fs, e);
+ ereg = e->u.info; /* register where 'e' was placed */
+ freeexp(fs, e);
+ e->u.info = fs->freereg; /* base register for op_self */
+ e->k = VNONRELOC; /* self expression has a fixed register */
+ luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */
+ codeABRK(fs, OP_SELF, e->u.info, ereg, key);
+ freeexp(fs, key);
+}
+
+
+/*
+** Negate condition 'e' (where 'e' is a comparison).
+*/
+static void negatecondition (FuncState *fs, expdesc *e) {
+ Instruction *pc = getjumpcontrol(fs, e->u.info);
+ lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET &&
+ GET_OPCODE(*pc) != OP_TEST);
+ SETARG_k(*pc, (GETARG_k(*pc) ^ 1));
+}
+
+
+/*
+** Emit instruction to jump if 'e' is 'cond' (that is, if 'cond'
+** is true, code will jump if 'e' is true.) Return jump position.
+** Optimize when 'e' is 'not' something, inverting the condition
+** and removing the 'not'.
+*/
+static int jumponcond (FuncState *fs, expdesc *e, int cond) {
+ if (e->k == VRELOC) {
+ Instruction ie = getinstruction(fs, e);
+ if (GET_OPCODE(ie) == OP_NOT) {
+ removelastinstruction(fs); /* remove previous OP_NOT */
+ return condjump(fs, OP_TEST, GETARG_B(ie), 0, 0, !cond);
+ }
+ /* else go through */
+ }
+ discharge2anyreg(fs, e);
+ freeexp(fs, e);
+ return condjump(fs, OP_TESTSET, NO_REG, e->u.info, 0, cond);
+}
+
+
+/*
+** Emit code to go through if 'e' is true, jump otherwise.
+*/
+void luaK_goiftrue (FuncState *fs, expdesc *e) {
+ int pc; /* pc of new jump */
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VJMP: { /* condition? */
+ negatecondition(fs, e); /* jump when it is false */
+ pc = e->u.info; /* save jump position */
+ break;
+ }
+ case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
+ pc = NO_JUMP; /* always true; do nothing */
+ break;
+ }
+ default: {
+ pc = jumponcond(fs, e, 0); /* jump when false */
+ break;
+ }
+ }
+ luaK_concat(fs, &e->f, pc); /* insert new jump in false list */
+ luaK_patchtohere(fs, e->t); /* true list jumps to here (to go through) */
+ e->t = NO_JUMP;
+}
+
+
+/*
+** Emit code to go through if 'e' is false, jump otherwise.
+*/
+void luaK_goiffalse (FuncState *fs, expdesc *e) {
+ int pc; /* pc of new jump */
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VJMP: {
+ pc = e->u.info; /* already jump if true */
+ break;
+ }
+ case VNIL: case VFALSE: {
+ pc = NO_JUMP; /* always false; do nothing */
+ break;
+ }
+ default: {
+ pc = jumponcond(fs, e, 1); /* jump if true */
+ break;
+ }
+ }
+ luaK_concat(fs, &e->t, pc); /* insert new jump in 't' list */
+ luaK_patchtohere(fs, e->f); /* false list jumps to here (to go through) */
+ e->f = NO_JUMP;
+}
+
+
+/*
+** Code 'not e', doing constant folding.
+*/
+static void codenot (FuncState *fs, expdesc *e) {
+ switch (e->k) {
+ case VNIL: case VFALSE: {
+ e->k = VTRUE; /* true == not nil == not false */
+ break;
+ }
+ case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
+ e->k = VFALSE; /* false == not "x" == not 0.5 == not 1 == not true */
+ break;
+ }
+ case VJMP: {
+ negatecondition(fs, e);
+ break;
+ }
+ case VRELOC:
+ case VNONRELOC: {
+ discharge2anyreg(fs, e);
+ freeexp(fs, e);
+ e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0);
+ e->k = VRELOC;
+ break;
+ }
+ default: lua_assert(0); /* cannot happen */
+ }
+ /* interchange true and false lists */
+ { int temp = e->f; e->f = e->t; e->t = temp; }
+ removevalues(fs, e->f); /* values are useless when negated */
+ removevalues(fs, e->t);
+}
+
+
+/*
+** Check whether expression 'e' is a small literal string
+*/
+static int isKstr (FuncState *fs, expdesc *e) {
+ return (e->k == VK && !hasjumps(e) && e->u.info <= MAXARG_B &&
+ ttisshrstring(&fs->f->k[e->u.info]));
+}
+
+/*
+** Check whether expression 'e' is a literal integer.
+*/
+int luaK_isKint (expdesc *e) {
+ return (e->k == VKINT && !hasjumps(e));
+}
+
+
+/*
+** Check whether expression 'e' is a literal integer in
+** proper range to fit in register C
+*/
+static int isCint (expdesc *e) {
+ return luaK_isKint(e) && (l_castS2U(e->u.ival) <= l_castS2U(MAXARG_C));
+}
+
+
+/*
+** Check whether expression 'e' is a literal integer in
+** proper range to fit in register sC
+*/
+static int isSCint (expdesc *e) {
+ return luaK_isKint(e) && fitsC(e->u.ival);
+}
+
+
+/*
+** Check whether expression 'e' is a literal integer or float in
+** proper range to fit in a register (sB or sC).
+*/
+static int isSCnumber (expdesc *e, int *pi, int *isfloat) {
+ lua_Integer i;
+ if (e->k == VKINT)
+ i = e->u.ival;
+ else if (e->k == VKFLT && luaV_flttointeger(e->u.nval, &i, F2Ieq))
+ *isfloat = 1;
+ else
+ return 0; /* not a number */
+ if (!hasjumps(e) && fitsC(i)) {
+ *pi = int2sC(cast_int(i));
+ return 1;
+ }
+ else
+ return 0;
+}
+
+
+/*
+** Create expression 't[k]'. 't' must have its final result already in a
+** register or upvalue. Upvalues can only be indexed by literal strings.
+** Keys can be literal strings in the constant table or arbitrary
+** values in registers.
+*/
+void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
+ if (k->k == VKSTR)
+ str2K(fs, k);
+ lua_assert(!hasjumps(t) &&
+ (t->k == VLOCAL || t->k == VNONRELOC || t->k == VUPVAL));
+ if (t->k == VUPVAL && !isKstr(fs, k)) /* upvalue indexed by non 'Kstr'? */
+ luaK_exp2anyreg(fs, t); /* put it in a register */
+ if (t->k == VUPVAL) {
+ t->u.ind.t = t->u.info; /* upvalue index */
+ t->u.ind.idx = k->u.info; /* literal string */
+ t->k = VINDEXUP;
+ }
+ else {
+ /* register index of the table */
+ t->u.ind.t = (t->k == VLOCAL) ? t->u.var.ridx: t->u.info;
+ if (isKstr(fs, k)) {
+ t->u.ind.idx = k->u.info; /* literal string */
+ t->k = VINDEXSTR;
+ }
+ else if (isCint(k)) {
+ t->u.ind.idx = cast_int(k->u.ival); /* int. constant in proper range */
+ t->k = VINDEXI;
+ }
+ else {
+ t->u.ind.idx = luaK_exp2anyreg(fs, k); /* register */
+ t->k = VINDEXED;
+ }
+ }
+}
+
+
+/*
+** Return false if folding can raise an error.
+** Bitwise operations need operands convertible to integers; division
+** operations cannot have 0 as divisor.
+*/
+static int validop (int op, TValue *v1, TValue *v2) {
+ switch (op) {
+ case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
+ case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* conversion errors */
+ lua_Integer i;
+ return (luaV_tointegerns(v1, &i, LUA_FLOORN2I) &&
+ luaV_tointegerns(v2, &i, LUA_FLOORN2I));
+ }
+ case LUA_OPDIV: case LUA_OPIDIV: case LUA_OPMOD: /* division by 0 */
+ return (nvalue(v2) != 0);
+ default: return 1; /* everything else is valid */
+ }
+}
+
+
+/*
+** Try to "constant-fold" an operation; return 1 iff successful.
+** (In this case, 'e1' has the final result.)
+*/
+static int constfolding (FuncState *fs, int op, expdesc *e1,
+ const expdesc *e2) {
+ TValue v1, v2, res;
+ if (!tonumeral(e1, &v1) || !tonumeral(e2, &v2) || !validop(op, &v1, &v2))
+ return 0; /* non-numeric operands or not safe to fold */
+ luaO_rawarith(fs->ls->L, op, &v1, &v2, &res); /* does operation */
+ if (ttisinteger(&res)) {
+ e1->k = VKINT;
+ e1->u.ival = ivalue(&res);
+ }
+ else { /* folds neither NaN nor 0.0 (to avoid problems with -0.0) */
+ lua_Number n = fltvalue(&res);
+ if (luai_numisnan(n) || n == 0)
+ return 0;
+ e1->k = VKFLT;
+ e1->u.nval = n;
+ }
+ return 1;
+}
+
+
+/*
+** Emit code for unary expressions that "produce values"
+** (everything but 'not').
+** Expression to produce final result will be encoded in 'e'.
+*/
+static void codeunexpval (FuncState *fs, OpCode op, expdesc *e, int line) {
+ int r = luaK_exp2anyreg(fs, e); /* opcodes operate only on registers */
+ freeexp(fs, e);
+ e->u.info = luaK_codeABC(fs, op, 0, r, 0); /* generate opcode */
+ e->k = VRELOC; /* all those operations are relocatable */
+ luaK_fixline(fs, line);
+}
+
+
+/*
+** Emit code for binary expressions that "produce values"
+** (everything but logical operators 'and'/'or' and comparison
+** operators).
+** Expression to produce final result will be encoded in 'e1'.
+*/
+static void finishbinexpval (FuncState *fs, expdesc *e1, expdesc *e2,
+ OpCode op, int v2, int flip, int line,
+ OpCode mmop, TMS event) {
+ int v1 = luaK_exp2anyreg(fs, e1);
+ int pc = luaK_codeABCk(fs, op, 0, v1, v2, 0);
+ freeexps(fs, e1, e2);
+ e1->u.info = pc;
+ e1->k = VRELOC; /* all those operations are relocatable */
+ luaK_fixline(fs, line);
+ luaK_codeABCk(fs, mmop, v1, v2, event, flip); /* to call metamethod */
+ luaK_fixline(fs, line);
+}
+
+
+/*
+** Emit code for binary expressions that "produce values" over
+** two registers.
+*/
+static void codebinexpval (FuncState *fs, OpCode op,
+ expdesc *e1, expdesc *e2, int line) {
+ int v2 = luaK_exp2anyreg(fs, e2); /* make sure 'e2' is in a register */
+ /* 'e1' must be already in a register or it is a constant */
+ lua_assert((VNIL <= e1->k && e1->k <= VKSTR) ||
+ e1->k == VNONRELOC || e1->k == VRELOC);
+ lua_assert(OP_ADD <= op && op <= OP_SHR);
+ finishbinexpval(fs, e1, e2, op, v2, 0, line, OP_MMBIN,
+ cast(TMS, (op - OP_ADD) + TM_ADD));
+}
+
+
+/*
+** Code binary operators with immediate operands.
+*/
+static void codebini (FuncState *fs, OpCode op,
+ expdesc *e1, expdesc *e2, int flip, int line,
+ TMS event) {
+ int v2 = int2sC(cast_int(e2->u.ival)); /* immediate operand */
+ lua_assert(e2->k == VKINT);
+ finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINI, event);
+}
+
+
+/*
+** Code binary operators with K operand.
+*/
+static void codebinK (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int flip, int line) {
+ TMS event = cast(TMS, opr + TM_ADD);
+ int v2 = e2->u.info; /* K index */
+ OpCode op = cast(OpCode, opr + OP_ADDK);
+ finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINK, event);
+}
+
+
+/* Try to code a binary operator negating its second operand.
+** For the metamethod, 2nd operand must keep its original value.
+*/
+static int finishbinexpneg (FuncState *fs, expdesc *e1, expdesc *e2,
+ OpCode op, int line, TMS event) {
+ if (!luaK_isKint(e2))
+ return 0; /* not an integer constant */
+ else {
+ lua_Integer i2 = e2->u.ival;
+ if (!(fitsC(i2) && fitsC(-i2)))
+ return 0; /* not in the proper range */
+ else { /* operating a small integer constant */
+ int v2 = cast_int(i2);
+ finishbinexpval(fs, e1, e2, op, int2sC(-v2), 0, line, OP_MMBINI, event);
+ /* correct metamethod argument */
+ SETARG_B(fs->f->code[fs->pc - 1], int2sC(v2));
+ return 1; /* successfully coded */
+ }
+ }
+}
+
+
+static void swapexps (expdesc *e1, expdesc *e2) {
+ expdesc temp = *e1; *e1 = *e2; *e2 = temp; /* swap 'e1' and 'e2' */
+}
+
+
+/*
+** Code binary operators with no constant operand.
+*/
+static void codebinNoK (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int flip, int line) {
+ OpCode op = cast(OpCode, opr + OP_ADD);
+ if (flip)
+ swapexps(e1, e2); /* back to original order */
+ codebinexpval(fs, op, e1, e2, line); /* use standard operators */
+}
+
+
+/*
+** Code arithmetic operators ('+', '-', ...). If second operand is a
+** constant in the proper range, use variant opcodes with K operands.
+*/
+static void codearith (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int flip, int line) {
+ if (tonumeral(e2, NULL) && luaK_exp2K(fs, e2)) /* K operand? */
+ codebinK(fs, opr, e1, e2, flip, line);
+ else /* 'e2' is neither an immediate nor a K operand */
+ codebinNoK(fs, opr, e1, e2, flip, line);
+}
+
+
+/*
+** Code commutative operators ('+', '*'). If first operand is a
+** numeric constant, change order of operands to try to use an
+** immediate or K operator.
+*/
+static void codecommutative (FuncState *fs, BinOpr op,
+ expdesc *e1, expdesc *e2, int line) {
+ int flip = 0;
+ if (tonumeral(e1, NULL)) { /* is first operand a numeric constant? */
+ swapexps(e1, e2); /* change order */
+ flip = 1;
+ }
+ if (op == OPR_ADD && isSCint(e2)) /* immediate operand? */
+ codebini(fs, cast(OpCode, OP_ADDI), e1, e2, flip, line, TM_ADD);
+ else
+ codearith(fs, op, e1, e2, flip, line);
+}
+
+
+/*
+** Code bitwise operations; they are all commutative, so the function
+** tries to put an integer constant as the 2nd operand (a K operand).
+*/
+static void codebitwise (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int line) {
+ int flip = 0;
+ if (e1->k == VKINT) {
+ swapexps(e1, e2); /* 'e2' will be the constant operand */
+ flip = 1;
+ }
+ if (e2->k == VKINT && luaK_exp2K(fs, e2)) /* K operand? */
+ codebinK(fs, opr, e1, e2, flip, line);
+ else /* no constants */
+ codebinNoK(fs, opr, e1, e2, flip, line);
+}
+
+
+/*
+** Emit code for order comparisons. When using an immediate operand,
+** 'isfloat' tells whether the original value was a float.
+*/
+static void codeorder (FuncState *fs, OpCode op, expdesc *e1, expdesc *e2) {
+ int r1, r2;
+ int im;
+ int isfloat = 0;
+ if (isSCnumber(e2, &im, &isfloat)) {
+ /* use immediate operand */
+ r1 = luaK_exp2anyreg(fs, e1);
+ r2 = im;
+ op = cast(OpCode, (op - OP_LT) + OP_LTI);
+ }
+ else if (isSCnumber(e1, &im, &isfloat)) {
+ /* transform (A < B) to (B > A) and (A <= B) to (B >= A) */
+ r1 = luaK_exp2anyreg(fs, e2);
+ r2 = im;
+ op = (op == OP_LT) ? OP_GTI : OP_GEI;
+ }
+ else { /* regular case, compare two registers */
+ r1 = luaK_exp2anyreg(fs, e1);
+ r2 = luaK_exp2anyreg(fs, e2);
+ }
+ freeexps(fs, e1, e2);
+ e1->u.info = condjump(fs, op, r1, r2, isfloat, 1);
+ e1->k = VJMP;
+}
+
+
+/*
+** Emit code for equality comparisons ('==', '~=').
+** 'e1' was already put as RK by 'luaK_infix'.
+*/
+static void codeeq (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) {
+ int r1, r2;
+ int im;
+ int isfloat = 0; /* not needed here, but kept for symmetry */
+ OpCode op;
+ if (e1->k != VNONRELOC) {
+ lua_assert(e1->k == VK || e1->k == VKINT || e1->k == VKFLT);
+ swapexps(e1, e2);
+ }
+ r1 = luaK_exp2anyreg(fs, e1); /* 1st expression must be in register */
+ if (isSCnumber(e2, &im, &isfloat)) {
+ op = OP_EQI;
+ r2 = im; /* immediate operand */
+ }
+ else if (luaK_exp2RK(fs, e2)) { /* 2nd expression is constant? */
+ op = OP_EQK;
+ r2 = e2->u.info; /* constant index */
+ }
+ else {
+ op = OP_EQ; /* will compare two registers */
+ r2 = luaK_exp2anyreg(fs, e2);
+ }
+ freeexps(fs, e1, e2);
+ e1->u.info = condjump(fs, op, r1, r2, isfloat, (opr == OPR_EQ));
+ e1->k = VJMP;
+}
+
+
+/*
+** Apply prefix operation 'op' to expression 'e'.
+*/
+void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) {
+ static const expdesc ef = {VKINT, {0}, NO_JUMP, NO_JUMP};
+ luaK_dischargevars(fs, e);
+ switch (op) {
+ case OPR_MINUS: case OPR_BNOT: /* use 'ef' as fake 2nd operand */
+ if (constfolding(fs, op + LUA_OPUNM, e, &ef))
+ break;
+ /* else */ /* FALLTHROUGH */
+ case OPR_LEN:
+ codeunexpval(fs, cast(OpCode, op + OP_UNM), e, line);
+ break;
+ case OPR_NOT: codenot(fs, e); break;
+ default: lua_assert(0);
+ }
+}
+
+
+/*
+** Process 1st operand 'v' of binary operation 'op' before reading
+** 2nd operand.
+*/
+void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
+ luaK_dischargevars(fs, v);
+ switch (op) {
+ case OPR_AND: {
+ luaK_goiftrue(fs, v); /* go ahead only if 'v' is true */
+ break;
+ }
+ case OPR_OR: {
+ luaK_goiffalse(fs, v); /* go ahead only if 'v' is false */
+ break;
+ }
+ case OPR_CONCAT: {
+ luaK_exp2nextreg(fs, v); /* operand must be on the stack */
+ break;
+ }
+ case OPR_ADD: case OPR_SUB:
+ case OPR_MUL: case OPR_DIV: case OPR_IDIV:
+ case OPR_MOD: case OPR_POW:
+ case OPR_BAND: case OPR_BOR: case OPR_BXOR:
+ case OPR_SHL: case OPR_SHR: {
+ if (!tonumeral(v, NULL))
+ luaK_exp2anyreg(fs, v);
+ /* else keep numeral, which may be folded or used as an immediate
+ operand */
+ break;
+ }
+ case OPR_EQ: case OPR_NE: {
+ if (!tonumeral(v, NULL))
+ luaK_exp2RK(fs, v);
+ /* else keep numeral, which may be an immediate operand */
+ break;
+ }
+ case OPR_LT: case OPR_LE:
+ case OPR_GT: case OPR_GE: {
+ int dummy, dummy2;
+ if (!isSCnumber(v, &dummy, &dummy2))
+ luaK_exp2anyreg(fs, v);
+ /* else keep numeral, which may be an immediate operand */
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+/*
+** Create code for '(e1 .. e2)'.
+** For '(e1 .. e2.1 .. e2.2)' (which is '(e1 .. (e2.1 .. e2.2))',
+** because concatenation is right associative), merge both CONCATs.
+*/
+static void codeconcat (FuncState *fs, expdesc *e1, expdesc *e2, int line) {
+ Instruction *ie2 = previousinstruction(fs);
+ if (GET_OPCODE(*ie2) == OP_CONCAT) { /* is 'e2' a concatenation? */
+ int n = GETARG_B(*ie2); /* # of elements concatenated in 'e2' */
+ lua_assert(e1->u.info + 1 == GETARG_A(*ie2));
+ freeexp(fs, e2);
+ SETARG_A(*ie2, e1->u.info); /* correct first element ('e1') */
+ SETARG_B(*ie2, n + 1); /* will concatenate one more element */
+ }
+ else { /* 'e2' is not a concatenation */
+ luaK_codeABC(fs, OP_CONCAT, e1->u.info, 2, 0); /* new concat opcode */
+ freeexp(fs, e2);
+ luaK_fixline(fs, line);
+ }
+}
+
+
+/*
+** Finalize code for binary operation, after reading 2nd operand.
+*/
+void luaK_posfix (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int line) {
+ luaK_dischargevars(fs, e2);
+ if (foldbinop(opr) && constfolding(fs, opr + LUA_OPADD, e1, e2))
+ return; /* done by folding */
+ switch (opr) {
+ case OPR_AND: {
+ lua_assert(e1->t == NO_JUMP); /* list closed by 'luaK_infix' */
+ luaK_concat(fs, &e2->f, e1->f);
+ *e1 = *e2;
+ break;
+ }
+ case OPR_OR: {
+ lua_assert(e1->f == NO_JUMP); /* list closed by 'luaK_infix' */
+ luaK_concat(fs, &e2->t, e1->t);
+ *e1 = *e2;
+ break;
+ }
+ case OPR_CONCAT: { /* e1 .. e2 */
+ luaK_exp2nextreg(fs, e2);
+ codeconcat(fs, e1, e2, line);
+ break;
+ }
+ case OPR_ADD: case OPR_MUL: {
+ codecommutative(fs, opr, e1, e2, line);
+ break;
+ }
+ case OPR_SUB: {
+ if (finishbinexpneg(fs, e1, e2, OP_ADDI, line, TM_SUB))
+ break; /* coded as (r1 + -I) */
+ /* ELSE */
+ } /* FALLTHROUGH */
+ case OPR_DIV: case OPR_IDIV: case OPR_MOD: case OPR_POW: {
+ codearith(fs, opr, e1, e2, 0, line);
+ break;
+ }
+ case OPR_BAND: case OPR_BOR: case OPR_BXOR: {
+ codebitwise(fs, opr, e1, e2, line);
+ break;
+ }
+ case OPR_SHL: {
+ if (isSCint(e1)) {
+ swapexps(e1, e2);
+ codebini(fs, OP_SHLI, e1, e2, 1, line, TM_SHL); /* I << r2 */
+ }
+ else if (finishbinexpneg(fs, e1, e2, OP_SHRI, line, TM_SHL)) {
+ /* coded as (r1 >> -I) */;
+ }
+ else /* regular case (two registers) */
+ codebinexpval(fs, OP_SHL, e1, e2, line);
+ break;
+ }
+ case OPR_SHR: {
+ if (isSCint(e2))
+ codebini(fs, OP_SHRI, e1, e2, 0, line, TM_SHR); /* r1 >> I */
+ else /* regular case (two registers) */
+ codebinexpval(fs, OP_SHR, e1, e2, line);
+ break;
+ }
+ case OPR_EQ: case OPR_NE: {
+ codeeq(fs, opr, e1, e2);
+ break;
+ }
+ case OPR_LT: case OPR_LE: {
+ OpCode op = cast(OpCode, (opr - OPR_EQ) + OP_EQ);
+ codeorder(fs, op, e1, e2);
+ break;
+ }
+ case OPR_GT: case OPR_GE: {
+ /* '(a > b)' <=> '(b < a)'; '(a >= b)' <=> '(b <= a)' */
+ OpCode op = cast(OpCode, (opr - OPR_NE) + OP_EQ);
+ swapexps(e1, e2);
+ codeorder(fs, op, e1, e2);
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+
+/*
+** Change line information associated with current position, by removing
+** previous info and adding it again with new line.
+*/
+void luaK_fixline (FuncState *fs, int line) {
+ removelastlineinfo(fs);
+ savelineinfo(fs, fs->f, line);
+}
+
+
+void luaK_settablesize (FuncState *fs, int pc, int ra, int asize, int hsize) {
+ Instruction *inst = &fs->f->code[pc];
+ int rb = (hsize != 0) ? luaO_ceillog2(hsize) + 1 : 0; /* hash size */
+ int extra = asize / (MAXARG_C + 1); /* higher bits of array size */
+ int rc = asize % (MAXARG_C + 1); /* lower bits of array size */
+ int k = (extra > 0); /* true iff needs extra argument */
+ *inst = CREATE_ABCk(OP_NEWTABLE, ra, rb, rc, k);
+ *(inst + 1) = CREATE_Ax(OP_EXTRAARG, extra);
+}
+
+
+/*
+** Emit a SETLIST instruction.
+** 'base' is register that keeps table;
+** 'nelems' is #table plus those to be stored now;
+** 'tostore' is number of values (in registers 'base + 1',...) to add to
+** table (or LUA_MULTRET to add up to stack top).
+*/
+void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) {
+ lua_assert(tostore != 0 && tostore <= LFIELDS_PER_FLUSH);
+ if (tostore == LUA_MULTRET)
+ tostore = 0;
+ if (nelems <= MAXARG_C)
+ luaK_codeABC(fs, OP_SETLIST, base, tostore, nelems);
+ else {
+ int extra = nelems / (MAXARG_C + 1);
+ nelems %= (MAXARG_C + 1);
+ luaK_codeABCk(fs, OP_SETLIST, base, tostore, nelems, 1);
+ codeextraarg(fs, extra);
+ }
+ fs->freereg = base + 1; /* free registers with list values */
+}
+
+
+/*
+** return the final target of a jump (skipping jumps to jumps)
+*/
+static int finaltarget (Instruction *code, int i) {
+ int count;
+ for (count = 0; count < 100; count++) { /* avoid infinite loops */
+ Instruction pc = code[i];
+ if (GET_OPCODE(pc) != OP_JMP)
+ break;
+ else
+ i += GETARG_sJ(pc) + 1;
+ }
+ return i;
+}
+
+
+/*
+** Do a final pass over the code of a function, doing small peephole
+** optimizations and adjustments.
+*/
+void luaK_finish (FuncState *fs) {
+ int i;
+ Proto *p = fs->f;
+ for (i = 0; i < fs->pc; i++) {
+ Instruction *pc = &p->code[i];
+ lua_assert(i == 0 || isOT(*(pc - 1)) == isIT(*pc));
+ switch (GET_OPCODE(*pc)) {
+ case OP_RETURN0: case OP_RETURN1: {
+ if (!(fs->needclose || p->is_vararg))
+ break; /* no extra work */
+ /* else use OP_RETURN to do the extra work */
+ SET_OPCODE(*pc, OP_RETURN);
+ } /* FALLTHROUGH */
+ case OP_RETURN: case OP_TAILCALL: {
+ if (fs->needclose)
+ SETARG_k(*pc, 1); /* signal that it needs to close */
+ if (p->is_vararg)
+ SETARG_C(*pc, p->numparams + 1); /* signal that it is vararg */
+ break;
+ }
+ case OP_JMP: {
+ int target = finaltarget(p->code, i);
+ fixjump(fs, i, target);
+ break;
+ }
+ default: break;
+ }
+ }
+}
diff --git a/source/luametatex/source/luacore/lua54/src/lcode.h b/source/luametatex/source/luacore/lua54/src/lcode.h
new file mode 100644
index 000000000..326582445
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lcode.h
@@ -0,0 +1,104 @@
+/*
+** $Id: lcode.h $
+** Code generator for Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lcode_h
+#define lcode_h
+
+#include "llex.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+
+
+/*
+** Marks the end of a patch list. It is an invalid value both as an absolute
+** address, and as a list link (would link an element to itself).
+*/
+#define NO_JUMP (-1)
+
+
+/*
+** grep "ORDER OPR" if you change these enums (ORDER OP)
+*/
+typedef enum BinOpr {
+ /* arithmetic operators */
+ OPR_ADD, OPR_SUB, OPR_MUL, OPR_MOD, OPR_POW,
+ OPR_DIV, OPR_IDIV,
+ /* bitwise operators */
+ OPR_BAND, OPR_BOR, OPR_BXOR,
+ OPR_SHL, OPR_SHR,
+ /* string operator */
+ OPR_CONCAT,
+ /* comparison operators */
+ OPR_EQ, OPR_LT, OPR_LE,
+ OPR_NE, OPR_GT, OPR_GE,
+ /* logical operators */
+ OPR_AND, OPR_OR,
+ OPR_NOBINOPR
+} BinOpr;
+
+
+/* true if operation is foldable (that is, it is arithmetic or bitwise) */
+#define foldbinop(op) ((op) <= OPR_SHR)
+
+
+#define luaK_codeABC(fs,o,a,b,c) luaK_codeABCk(fs,o,a,b,c,0)
+
+
+typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;
+
+
+/* get (pointer to) instruction of given 'expdesc' */
+#define getinstruction(fs,e) ((fs)->f->code[(e)->u.info])
+
+
+#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET)
+
+#define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t)
+
+LUAI_FUNC int luaK_code (FuncState *fs, Instruction i);
+LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);
+LUAI_FUNC int luaK_codeAsBx (FuncState *fs, OpCode o, int A, int Bx);
+LUAI_FUNC int luaK_codeABCk (FuncState *fs, OpCode o, int A,
+ int B, int C, int k);
+LUAI_FUNC int luaK_isKint (expdesc *e);
+LUAI_FUNC int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v);
+LUAI_FUNC void luaK_fixline (FuncState *fs, int line);
+LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n);
+LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n);
+LUAI_FUNC void luaK_checkstack (FuncState *fs, int n);
+LUAI_FUNC void luaK_int (FuncState *fs, int reg, lua_Integer n);
+LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e);
+LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e);
+LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
+LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
+LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
+LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults);
+LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e);
+LUAI_FUNC int luaK_jump (FuncState *fs);
+LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret);
+LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target);
+LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list);
+LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2);
+LUAI_FUNC int luaK_getlabel (FuncState *fs);
+LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line);
+LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
+LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1,
+ expdesc *v2, int line);
+LUAI_FUNC void luaK_settablesize (FuncState *fs, int pc,
+ int ra, int asize, int hsize);
+LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);
+LUAI_FUNC void luaK_finish (FuncState *fs);
+LUAI_FUNC l_noret luaK_semerror (LexState *ls, const char *msg);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lcorolib.c b/source/luametatex/source/luacore/lua54/src/lcorolib.c
new file mode 100644
index 000000000..785a1e81a
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lcorolib.c
@@ -0,0 +1,210 @@
+/*
+** $Id: lcorolib.c $
+** Coroutine Library
+** See Copyright Notice in lua.h
+*/
+
+#define lcorolib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <stdlib.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+static lua_State *getco (lua_State *L) {
+ lua_State *co = lua_tothread(L, 1);
+ luaL_argexpected(L, co, 1, "thread");
+ return co;
+}
+
+
+/*
+** Resumes a coroutine. Returns the number of results for non-error
+** cases or -1 for errors.
+*/
+static int auxresume (lua_State *L, lua_State *co, int narg) {
+ int status, nres;
+ if (l_unlikely(!lua_checkstack(co, narg))) {
+ lua_pushliteral(L, "too many arguments to resume");
+ return -1; /* error flag */
+ }
+ lua_xmove(L, co, narg);
+ status = lua_resume(co, L, narg, &nres);
+ if (l_likely(status == LUA_OK || status == LUA_YIELD)) {
+ if (l_unlikely(!lua_checkstack(L, nres + 1))) {
+ lua_pop(co, nres); /* remove results anyway */
+ lua_pushliteral(L, "too many results to resume");
+ return -1; /* error flag */
+ }
+ lua_xmove(co, L, nres); /* move yielded values */
+ return nres;
+ }
+ else {
+ lua_xmove(co, L, 1); /* move error message */
+ return -1; /* error flag */
+ }
+}
+
+
+static int luaB_coresume (lua_State *L) {
+ lua_State *co = getco(L);
+ int r;
+ r = auxresume(L, co, lua_gettop(L) - 1);
+ if (l_unlikely(r < 0)) {
+ lua_pushboolean(L, 0);
+ lua_insert(L, -2);
+ return 2; /* return false + error message */
+ }
+ else {
+ lua_pushboolean(L, 1);
+ lua_insert(L, -(r + 1));
+ return r + 1; /* return true + 'resume' returns */
+ }
+}
+
+
+static int luaB_auxwrap (lua_State *L) {
+ lua_State *co = lua_tothread(L, lua_upvalueindex(1));
+ int r = auxresume(L, co, lua_gettop(L));
+ if (l_unlikely(r < 0)) { /* error? */
+ int stat = lua_status(co);
+ if (stat != LUA_OK && stat != LUA_YIELD) { /* error in the coroutine? */
+ stat = lua_resetthread(co); /* close its tbc variables */
+ lua_assert(stat != LUA_OK);
+ lua_xmove(co, L, 1); /* move error message to the caller */
+ }
+ if (stat != LUA_ERRMEM && /* not a memory error and ... */
+ lua_type(L, -1) == LUA_TSTRING) { /* ... error object is a string? */
+ luaL_where(L, 1); /* add extra info, if available */
+ lua_insert(L, -2);
+ lua_concat(L, 2);
+ }
+ return lua_error(L); /* propagate error */
+ }
+ return r;
+}
+
+
+static int luaB_cocreate (lua_State *L) {
+ lua_State *NL;
+ luaL_checktype(L, 1, LUA_TFUNCTION);
+ NL = lua_newthread(L);
+ lua_pushvalue(L, 1); /* move function to top */
+ lua_xmove(L, NL, 1); /* move function from L to NL */
+ return 1;
+}
+
+
+static int luaB_cowrap (lua_State *L) {
+ luaB_cocreate(L);
+ lua_pushcclosure(L, luaB_auxwrap, 1);
+ return 1;
+}
+
+
+static int luaB_yield (lua_State *L) {
+ return lua_yield(L, lua_gettop(L));
+}
+
+
+#define COS_RUN 0
+#define COS_DEAD 1
+#define COS_YIELD 2
+#define COS_NORM 3
+
+
+static const char *const statname[] =
+ {"running", "dead", "suspended", "normal"};
+
+
+static int auxstatus (lua_State *L, lua_State *co) {
+ if (L == co) return COS_RUN;
+ else {
+ switch (lua_status(co)) {
+ case LUA_YIELD:
+ return COS_YIELD;
+ case LUA_OK: {
+ lua_Debug ar;
+ if (lua_getstack(co, 0, &ar)) /* does it have frames? */
+ return COS_NORM; /* it is running */
+ else if (lua_gettop(co) == 0)
+ return COS_DEAD;
+ else
+ return COS_YIELD; /* initial state */
+ }
+ default: /* some error occurred */
+ return COS_DEAD;
+ }
+ }
+}
+
+
+static int luaB_costatus (lua_State *L) {
+ lua_State *co = getco(L);
+ lua_pushstring(L, statname[auxstatus(L, co)]);
+ return 1;
+}
+
+
+static int luaB_yieldable (lua_State *L) {
+ lua_State *co = lua_isnone(L, 1) ? L : getco(L);
+ lua_pushboolean(L, lua_isyieldable(co));
+ return 1;
+}
+
+
+static int luaB_corunning (lua_State *L) {
+ int ismain = lua_pushthread(L);
+ lua_pushboolean(L, ismain);
+ return 2;
+}
+
+
+static int luaB_close (lua_State *L) {
+ lua_State *co = getco(L);
+ int status = auxstatus(L, co);
+ switch (status) {
+ case COS_DEAD: case COS_YIELD: {
+ status = lua_resetthread(co);
+ if (status == LUA_OK) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ else {
+ lua_pushboolean(L, 0);
+ lua_xmove(co, L, 1); /* move error message */
+ return 2;
+ }
+ }
+ default: /* normal or running coroutine */
+ return luaL_error(L, "cannot close a %s coroutine", statname[status]);
+ }
+}
+
+
+static const luaL_Reg co_funcs[] = {
+ {"create", luaB_cocreate},
+ {"resume", luaB_coresume},
+ {"running", luaB_corunning},
+ {"status", luaB_costatus},
+ {"wrap", luaB_cowrap},
+ {"yield", luaB_yield},
+ {"isyieldable", luaB_yieldable},
+ {"close", luaB_close},
+ {NULL, NULL}
+};
+
+
+
+LUAMOD_API int luaopen_coroutine (lua_State *L) {
+ luaL_newlib(L, co_funcs);
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lctype.c b/source/luametatex/source/luacore/lua54/src/lctype.c
new file mode 100644
index 000000000..954228094
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lctype.c
@@ -0,0 +1,64 @@
+/*
+** $Id: lctype.c $
+** 'ctype' functions for Lua
+** See Copyright Notice in lua.h
+*/
+
+#define lctype_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include "lctype.h"
+
+#if !LUA_USE_CTYPE /* { */
+
+#include <limits.h>
+
+
+#if defined (LUA_UCID) /* accept UniCode IDentifiers? */
+/* consider all non-ascii codepoints to be alphabetic */
+#define NONA 0x01
+#else
+#define NONA 0x00 /* default */
+#endif
+
+
+LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = {
+ 0x00, /* EOZ */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */
+ 0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */
+ 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
+ 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */
+ 0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
+ 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */
+ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05,
+ 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */
+ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 8. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 9. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* a. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* b. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ 0x00, 0x00, NONA, NONA, NONA, NONA, NONA, NONA, /* c. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* d. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* e. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, 0x00, 0x00, 0x00, /* f. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
+};
+
+#endif /* } */
diff --git a/source/luametatex/source/luacore/lua54/src/lctype.h b/source/luametatex/source/luacore/lua54/src/lctype.h
new file mode 100644
index 000000000..864e19018
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lctype.h
@@ -0,0 +1,101 @@
+/*
+** $Id: lctype.h $
+** 'ctype' functions for Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lctype_h
+#define lctype_h
+
+#include "lua.h"
+
+
+/*
+** WARNING: the functions defined here do not necessarily correspond
+** to the similar functions in the standard C ctype.h. They are
+** optimized for the specific needs of Lua.
+*/
+
+#if !defined(LUA_USE_CTYPE)
+
+#if 'A' == 65 && '0' == 48
+/* ASCII case: can use its own tables; faster and fixed */
+#define LUA_USE_CTYPE 0
+#else
+/* must use standard C ctype */
+#define LUA_USE_CTYPE 1
+#endif
+
+#endif
+
+
+#if !LUA_USE_CTYPE /* { */
+
+#include <limits.h>
+
+#include "llimits.h"
+
+
+#define ALPHABIT 0
+#define DIGITBIT 1
+#define PRINTBIT 2
+#define SPACEBIT 3
+#define XDIGITBIT 4
+
+
+#define MASK(B) (1 << (B))
+
+
+/*
+** add 1 to char to allow index -1 (EOZ)
+*/
+#define testprop(c,p) (luai_ctype_[(c)+1] & (p))
+
+/*
+** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_'
+*/
+#define lislalpha(c) testprop(c, MASK(ALPHABIT))
+#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT)))
+#define lisdigit(c) testprop(c, MASK(DIGITBIT))
+#define lisspace(c) testprop(c, MASK(SPACEBIT))
+#define lisprint(c) testprop(c, MASK(PRINTBIT))
+#define lisxdigit(c) testprop(c, MASK(XDIGITBIT))
+
+
+/*
+** In ASCII, this 'ltolower' is correct for alphabetic characters and
+** for '.'. That is enough for Lua needs. ('check_exp' ensures that
+** the character either is an upper-case letter or is unchanged by
+** the transformation, which holds for lower-case letters and '.'.)
+*/
+#define ltolower(c) \
+ check_exp(('A' <= (c) && (c) <= 'Z') || (c) == ((c) | ('A' ^ 'a')), \
+ (c) | ('A' ^ 'a'))
+
+
+/* one entry for each character and for -1 (EOZ) */
+LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
+
+
+#else /* }{ */
+
+/*
+** use standard C ctypes
+*/
+
+#include <ctype.h>
+
+
+#define lislalpha(c) (isalpha(c) || (c) == '_')
+#define lislalnum(c) (isalnum(c) || (c) == '_')
+#define lisdigit(c) (isdigit(c))
+#define lisspace(c) (isspace(c))
+#define lisprint(c) (isprint(c))
+#define lisxdigit(c) (isxdigit(c))
+
+#define ltolower(c) (tolower(c))
+
+#endif /* } */
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/ldblib.c b/source/luametatex/source/luacore/lua54/src/ldblib.c
new file mode 100644
index 000000000..6dcbaa982
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ldblib.c
@@ -0,0 +1,483 @@
+/*
+** $Id: ldblib.c $
+** Interface from Lua to its debug API
+** See Copyright Notice in lua.h
+*/
+
+#define ldblib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/*
+** The hook table at registry[HOOKKEY] maps threads to their current
+** hook function.
+*/
+static const char *const HOOKKEY = "_HOOKKEY";
+
+
+/*
+** If L1 != L, L1 can be in any state, and therefore there are no
+** guarantees about its stack space; any push in L1 must be
+** checked.
+*/
+static void checkstack (lua_State *L, lua_State *L1, int n) {
+ if (l_unlikely(L != L1 && !lua_checkstack(L1, n)))
+ luaL_error(L, "stack overflow");
+}
+
+
+static int db_getregistry (lua_State *L) {
+ lua_pushvalue(L, LUA_REGISTRYINDEX);
+ return 1;
+}
+
+
+static int db_getmetatable (lua_State *L) {
+ luaL_checkany(L, 1);
+ if (!lua_getmetatable(L, 1)) {
+ lua_pushnil(L); /* no metatable */
+ }
+ return 1;
+}
+
+
+static int db_setmetatable (lua_State *L) {
+ int t = lua_type(L, 2);
+ luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
+ lua_settop(L, 2);
+ lua_setmetatable(L, 1);
+ return 1; /* return 1st argument */
+}
+
+
+static int db_getuservalue (lua_State *L) {
+ int n = (int)luaL_optinteger(L, 2, 1);
+ if (lua_type(L, 1) != LUA_TUSERDATA)
+ luaL_pushfail(L);
+ else if (lua_getiuservalue(L, 1, n) != LUA_TNONE) {
+ lua_pushboolean(L, 1);
+ return 2;
+ }
+ return 1;
+}
+
+
+static int db_setuservalue (lua_State *L) {
+ int n = (int)luaL_optinteger(L, 3, 1);
+ luaL_checktype(L, 1, LUA_TUSERDATA);
+ luaL_checkany(L, 2);
+ lua_settop(L, 2);
+ if (!lua_setiuservalue(L, 1, n))
+ luaL_pushfail(L);
+ return 1;
+}
+
+
+/*
+** Auxiliary function used by several library functions: check for
+** an optional thread as function's first argument and set 'arg' with
+** 1 if this argument is present (so that functions can skip it to
+** access their other arguments)
+*/
+static lua_State *getthread (lua_State *L, int *arg) {
+ if (lua_isthread(L, 1)) {
+ *arg = 1;
+ return lua_tothread(L, 1);
+ }
+ else {
+ *arg = 0;
+ return L; /* function will operate over current thread */
+ }
+}
+
+
+/*
+** Variations of 'lua_settable', used by 'db_getinfo' to put results
+** from 'lua_getinfo' into result table. Key is always a string;
+** value can be a string, an int, or a boolean.
+*/
+static void settabss (lua_State *L, const char *k, const char *v) {
+ lua_pushstring(L, v);
+ lua_setfield(L, -2, k);
+}
+
+static void settabsi (lua_State *L, const char *k, int v) {
+ lua_pushinteger(L, v);
+ lua_setfield(L, -2, k);
+}
+
+static void settabsb (lua_State *L, const char *k, int v) {
+ lua_pushboolean(L, v);
+ lua_setfield(L, -2, k);
+}
+
+
+/*
+** In function 'db_getinfo', the call to 'lua_getinfo' may push
+** results on the stack; later it creates the result table to put
+** these objects. Function 'treatstackoption' puts the result from
+** 'lua_getinfo' on top of the result table so that it can call
+** 'lua_setfield'.
+*/
+static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {
+ if (L == L1)
+ lua_rotate(L, -2, 1); /* exchange object and table */
+ else
+ lua_xmove(L1, L, 1); /* move object to the "main" stack */
+ lua_setfield(L, -2, fname); /* put object into table */
+}
+
+
+/*
+** Calls 'lua_getinfo' and collects all results in a new table.
+** L1 needs stack space for an optional input (function) plus
+** two optional outputs (function and line table) from function
+** 'lua_getinfo'.
+*/
+static int db_getinfo (lua_State *L) {
+ lua_Debug ar;
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ const char *options = luaL_optstring(L, arg+2, "flnSrtu");
+ checkstack(L, L1, 3);
+ luaL_argcheck(L, options[0] != '>', arg + 2, "invalid option '>'");
+ if (lua_isfunction(L, arg + 1)) { /* info about a function? */
+ options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */
+ lua_pushvalue(L, arg + 1); /* move function to 'L1' stack */
+ lua_xmove(L, L1, 1);
+ }
+ else { /* stack level */
+ if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) {
+ luaL_pushfail(L); /* level out of range */
+ return 1;
+ }
+ }
+ if (!lua_getinfo(L1, options, &ar))
+ return luaL_argerror(L, arg+2, "invalid option");
+ lua_newtable(L); /* table to collect results */
+ if (strchr(options, 'S')) {
+ lua_pushlstring(L, ar.source, ar.srclen);
+ lua_setfield(L, -2, "source");
+ settabss(L, "short_src", ar.short_src);
+ settabsi(L, "linedefined", ar.linedefined);
+ settabsi(L, "lastlinedefined", ar.lastlinedefined);
+ settabss(L, "what", ar.what);
+ }
+ if (strchr(options, 'l'))
+ settabsi(L, "currentline", ar.currentline);
+ if (strchr(options, 'u')) {
+ settabsi(L, "nups", ar.nups);
+ settabsi(L, "nparams", ar.nparams);
+ settabsb(L, "isvararg", ar.isvararg);
+ }
+ if (strchr(options, 'n')) {
+ settabss(L, "name", ar.name);
+ settabss(L, "namewhat", ar.namewhat);
+ }
+ if (strchr(options, 'r')) {
+ settabsi(L, "ftransfer", ar.ftransfer);
+ settabsi(L, "ntransfer", ar.ntransfer);
+ }
+ if (strchr(options, 't'))
+ settabsb(L, "istailcall", ar.istailcall);
+ if (strchr(options, 'L'))
+ treatstackoption(L, L1, "activelines");
+ if (strchr(options, 'f'))
+ treatstackoption(L, L1, "func");
+ return 1; /* return table */
+}
+
+
+static int db_getlocal (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */
+ if (lua_isfunction(L, arg + 1)) { /* function argument? */
+ lua_pushvalue(L, arg + 1); /* push function */
+ lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */
+ return 1; /* return only name (there is no value) */
+ }
+ else { /* stack-level argument */
+ lua_Debug ar;
+ const char *name;
+ int level = (int)luaL_checkinteger(L, arg + 1);
+ if (l_unlikely(!lua_getstack(L1, level, &ar))) /* out of range? */
+ return luaL_argerror(L, arg+1, "level out of range");
+ checkstack(L, L1, 1);
+ name = lua_getlocal(L1, &ar, nvar);
+ if (name) {
+ lua_xmove(L1, L, 1); /* move local value */
+ lua_pushstring(L, name); /* push name */
+ lua_rotate(L, -2, 1); /* re-order */
+ return 2;
+ }
+ else {
+ luaL_pushfail(L); /* no name (nor value) */
+ return 1;
+ }
+ }
+}
+
+
+static int db_setlocal (lua_State *L) {
+ int arg;
+ const char *name;
+ lua_State *L1 = getthread(L, &arg);
+ lua_Debug ar;
+ int level = (int)luaL_checkinteger(L, arg + 1);
+ int nvar = (int)luaL_checkinteger(L, arg + 2);
+ if (l_unlikely(!lua_getstack(L1, level, &ar))) /* out of range? */
+ return luaL_argerror(L, arg+1, "level out of range");
+ luaL_checkany(L, arg+3);
+ lua_settop(L, arg+3);
+ checkstack(L, L1, 1);
+ lua_xmove(L, L1, 1);
+ name = lua_setlocal(L1, &ar, nvar);
+ if (name == NULL)
+ lua_pop(L1, 1); /* pop value (if not popped by 'lua_setlocal') */
+ lua_pushstring(L, name);
+ return 1;
+}
+
+
+/*
+** get (if 'get' is true) or set an upvalue from a closure
+*/
+static int auxupvalue (lua_State *L, int get) {
+ const char *name;
+ int n = (int)luaL_checkinteger(L, 2); /* upvalue index */
+ luaL_checktype(L, 1, LUA_TFUNCTION); /* closure */
+ name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
+ if (name == NULL) return 0;
+ lua_pushstring(L, name);
+ lua_insert(L, -(get+1)); /* no-op if get is false */
+ return get + 1;
+}
+
+
+static int db_getupvalue (lua_State *L) {
+ return auxupvalue(L, 1);
+}
+
+
+static int db_setupvalue (lua_State *L) {
+ luaL_checkany(L, 3);
+ return auxupvalue(L, 0);
+}
+
+
+/*
+** Check whether a given upvalue from a given closure exists and
+** returns its index
+*/
+static void *checkupval (lua_State *L, int argf, int argnup, int *pnup) {
+ void *id;
+ int nup = (int)luaL_checkinteger(L, argnup); /* upvalue index */
+ luaL_checktype(L, argf, LUA_TFUNCTION); /* closure */
+ id = lua_upvalueid(L, argf, nup);
+ if (pnup) {
+ luaL_argcheck(L, id != NULL, argnup, "invalid upvalue index");
+ *pnup = nup;
+ }
+ return id;
+}
+
+
+static int db_upvalueid (lua_State *L) {
+ void *id = checkupval(L, 1, 2, NULL);
+ if (id != NULL)
+ lua_pushlightuserdata(L, id);
+ else
+ luaL_pushfail(L);
+ return 1;
+}
+
+
+static int db_upvaluejoin (lua_State *L) {
+ int n1, n2;
+ checkupval(L, 1, 2, &n1);
+ checkupval(L, 3, 4, &n2);
+ luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");
+ luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");
+ lua_upvaluejoin(L, 1, n1, 3, n2);
+ return 0;
+}
+
+
+/*
+** Call hook function registered at hook table for the current
+** thread (if there is one)
+*/
+static void hookf (lua_State *L, lua_Debug *ar) {
+ static const char *const hooknames[] =
+ {"call", "return", "line", "count", "tail call"};
+ lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
+ lua_pushthread(L);
+ if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */
+ lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */
+ if (ar->currentline >= 0)
+ lua_pushinteger(L, ar->currentline); /* push current line */
+ else lua_pushnil(L);
+ lua_assert(lua_getinfo(L, "lS", ar));
+ lua_call(L, 2, 0); /* call hook function */
+ }
+}
+
+
+/*
+** Convert a string mask (for 'sethook') into a bit mask
+*/
+static int makemask (const char *smask, int count) {
+ int mask = 0;
+ if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
+ if (strchr(smask, 'r')) mask |= LUA_MASKRET;
+ if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
+ if (count > 0) mask |= LUA_MASKCOUNT;
+ return mask;
+}
+
+
+/*
+** Convert a bit mask (for 'gethook') into a string mask
+*/
+static char *unmakemask (int mask, char *smask) {
+ int i = 0;
+ if (mask & LUA_MASKCALL) smask[i++] = 'c';
+ if (mask & LUA_MASKRET) smask[i++] = 'r';
+ if (mask & LUA_MASKLINE) smask[i++] = 'l';
+ smask[i] = '\0';
+ return smask;
+}
+
+
+static int db_sethook (lua_State *L) {
+ int arg, mask, count;
+ lua_Hook func;
+ lua_State *L1 = getthread(L, &arg);
+ if (lua_isnoneornil(L, arg+1)) { /* no hook? */
+ lua_settop(L, arg+1);
+ func = NULL; mask = 0; count = 0; /* turn off hooks */
+ }
+ else {
+ const char *smask = luaL_checkstring(L, arg+2);
+ luaL_checktype(L, arg+1, LUA_TFUNCTION);
+ count = (int)luaL_optinteger(L, arg + 3, 0);
+ func = hookf; mask = makemask(smask, count);
+ }
+ if (!luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY)) {
+ /* table just created; initialize it */
+ lua_pushliteral(L, "k");
+ lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */
+ lua_pushvalue(L, -1);
+ lua_setmetatable(L, -2); /* metatable(hooktable) = hooktable */
+ }
+ checkstack(L, L1, 1);
+ lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */
+ lua_pushvalue(L, arg + 1); /* value (hook function) */
+ lua_rawset(L, -3); /* hooktable[L1] = new Lua hook */
+ lua_sethook(L1, func, mask, count);
+ return 0;
+}
+
+
+static int db_gethook (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ char buff[5];
+ int mask = lua_gethookmask(L1);
+ lua_Hook hook = lua_gethook(L1);
+ if (hook == NULL) { /* no hook? */
+ luaL_pushfail(L);
+ return 1;
+ }
+ else if (hook != hookf) /* external hook? */
+ lua_pushliteral(L, "external hook");
+ else { /* hook table must exist */
+ lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
+ checkstack(L, L1, 1);
+ lua_pushthread(L1); lua_xmove(L1, L, 1);
+ lua_rawget(L, -2); /* 1st result = hooktable[L1] */
+ lua_remove(L, -2); /* remove hook table */
+ }
+ lua_pushstring(L, unmakemask(mask, buff)); /* 2nd result = mask */
+ lua_pushinteger(L, lua_gethookcount(L1)); /* 3rd result = count */
+ return 3;
+}
+
+
+static int db_debug (lua_State *L) {
+ for (;;) {
+ char buffer[250];
+ lua_writestringerror("%s", "lua_debug> ");
+ if (fgets(buffer, sizeof(buffer), stdin) == NULL ||
+ strcmp(buffer, "cont\n") == 0)
+ return 0;
+ if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
+ lua_pcall(L, 0, 0, 0))
+ lua_writestringerror("%s\n", luaL_tolstring(L, -1, NULL));
+ lua_settop(L, 0); /* remove eventual returns */
+ }
+}
+
+
+static int db_traceback (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ const char *msg = lua_tostring(L, arg + 1);
+ if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */
+ lua_pushvalue(L, arg + 1); /* return it untouched */
+ else {
+ int level = (int)luaL_optinteger(L, arg + 2, (L == L1) ? 1 : 0);
+ luaL_traceback(L, L1, msg, level);
+ }
+ return 1;
+}
+
+
+static int db_setcstacklimit (lua_State *L) {
+ int limit = (int)luaL_checkinteger(L, 1);
+ int res = lua_setcstacklimit(L, limit);
+ lua_pushinteger(L, res);
+ return 1;
+}
+
+
+static const luaL_Reg dblib[] = {
+ {"debug", db_debug},
+ {"getuservalue", db_getuservalue},
+ {"gethook", db_gethook},
+ {"getinfo", db_getinfo},
+ {"getlocal", db_getlocal},
+ {"getregistry", db_getregistry},
+ {"getmetatable", db_getmetatable},
+ {"getupvalue", db_getupvalue},
+ {"upvaluejoin", db_upvaluejoin},
+ {"upvalueid", db_upvalueid},
+ {"setuservalue", db_setuservalue},
+ {"sethook", db_sethook},
+ {"setlocal", db_setlocal},
+ {"setmetatable", db_setmetatable},
+ {"setupvalue", db_setupvalue},
+ {"traceback", db_traceback},
+ {"setcstacklimit", db_setcstacklimit},
+ {NULL, NULL}
+};
+
+
+LUAMOD_API int luaopen_debug (lua_State *L) {
+ luaL_newlib(L, dblib);
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/ldebug.c b/source/luametatex/source/luacore/lua54/src/ldebug.c
new file mode 100644
index 000000000..fa15eaf68
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ldebug.c
@@ -0,0 +1,921 @@
+/*
+** $Id: ldebug.c $
+** Debug Interface
+** See Copyright Notice in lua.h
+*/
+
+#define ldebug_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <stdarg.h>
+#include <stddef.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lapi.h"
+#include "lcode.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lvm.h"
+
+
+
+#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_VCCL)
+
+
+static const char *funcnamefromcall (lua_State *L, CallInfo *ci,
+ const char **name);
+
+
+static int currentpc (CallInfo *ci) {
+ lua_assert(isLua(ci));
+ return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
+}
+
+
+/*
+** Get a "base line" to find the line corresponding to an instruction.
+** Base lines are regularly placed at MAXIWTHABS intervals, so usually
+** an integer division gets the right place. When the source file has
+** large sequences of empty/comment lines, it may need extra entries,
+** so the original estimate needs a correction.
+** If the original estimate is -1, the initial 'if' ensures that the
+** 'while' will run at least once.
+** The assertion that the estimate is a lower bound for the correct base
+** is valid as long as the debug info has been generated with the same
+** value for MAXIWTHABS or smaller. (Previous releases use a little
+** smaller value.)
+*/
+static int getbaseline (const Proto *f, int pc, int *basepc) {
+ if (f->sizeabslineinfo == 0 || pc < f->abslineinfo[0].pc) {
+ *basepc = -1; /* start from the beginning */
+ return f->linedefined;
+ }
+ else {
+ int i = cast_uint(pc) / MAXIWTHABS - 1; /* get an estimate */
+ /* estimate must be a lower bound of the correct base */
+ lua_assert(i < 0 ||
+ (i < f->sizeabslineinfo && f->abslineinfo[i].pc <= pc));
+ while (i + 1 < f->sizeabslineinfo && pc >= f->abslineinfo[i + 1].pc)
+ i++; /* low estimate; adjust it */
+ *basepc = f->abslineinfo[i].pc;
+ return f->abslineinfo[i].line;
+ }
+}
+
+
+/*
+** Get the line corresponding to instruction 'pc' in function 'f';
+** first gets a base line and from there does the increments until
+** the desired instruction.
+*/
+int luaG_getfuncline (const Proto *f, int pc) {
+ if (f->lineinfo == NULL) /* no debug information? */
+ return -1;
+ else {
+ int basepc;
+ int baseline = getbaseline(f, pc, &basepc);
+ while (basepc++ < pc) { /* walk until given instruction */
+ lua_assert(f->lineinfo[basepc] != ABSLINEINFO);
+ baseline += f->lineinfo[basepc]; /* correct line */
+ }
+ return baseline;
+ }
+}
+
+
+static int getcurrentline (CallInfo *ci) {
+ return luaG_getfuncline(ci_func(ci)->p, currentpc(ci));
+}
+
+
+/*
+** Set 'trap' for all active Lua frames.
+** This function can be called during a signal, under "reasonable"
+** assumptions. A new 'ci' is completely linked in the list before it
+** becomes part of the "active" list, and we assume that pointers are
+** atomic; see comment in next function.
+** (A compiler doing interprocedural optimizations could, theoretically,
+** reorder memory writes in such a way that the list could be
+** temporarily broken while inserting a new element. We simply assume it
+** has no good reasons to do that.)
+*/
+static void settraps (CallInfo *ci) {
+ for (; ci != NULL; ci = ci->previous)
+ if (isLua(ci))
+ ci->u.l.trap = 1;
+}
+
+
+/*
+** This function can be called during a signal, under "reasonable"
+** assumptions.
+** Fields 'basehookcount' and 'hookcount' (set by 'resethookcount')
+** are for debug only, and it is no problem if they get arbitrary
+** values (causes at most one wrong hook call). 'hookmask' is an atomic
+** value. We assume that pointers are atomic too (e.g., gcc ensures that
+** for all platforms where it runs). Moreover, 'hook' is always checked
+** before being called (see 'luaD_hook').
+*/
+LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
+ if (func == NULL || mask == 0) { /* turn off hooks? */
+ mask = 0;
+ func = NULL;
+ }
+ L->hook = func;
+ L->basehookcount = count;
+ resethookcount(L);
+ L->hookmask = cast_byte(mask);
+ if (mask)
+ settraps(L->ci); /* to trace inside 'luaV_execute' */
+}
+
+
+LUA_API lua_Hook lua_gethook (lua_State *L) {
+ return L->hook;
+}
+
+
+LUA_API int lua_gethookmask (lua_State *L) {
+ return L->hookmask;
+}
+
+
+LUA_API int lua_gethookcount (lua_State *L) {
+ return L->basehookcount;
+}
+
+
+LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
+ int status;
+ CallInfo *ci;
+ if (level < 0) return 0; /* invalid (negative) level */
+ lua_lock(L);
+ for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
+ level--;
+ if (level == 0 && ci != &L->base_ci) { /* level found? */
+ status = 1;
+ ar->i_ci = ci;
+ }
+ else status = 0; /* no such level */
+ lua_unlock(L);
+ return status;
+}
+
+
+static const char *upvalname (const Proto *p, int uv) {
+ TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
+ if (s == NULL) return "?";
+ else return getstr(s);
+}
+
+
+static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
+ if (clLvalue(s2v(ci->func))->p->is_vararg) {
+ int nextra = ci->u.l.nextraargs;
+ if (n >= -nextra) { /* 'n' is negative */
+ *pos = ci->func - nextra - (n + 1);
+ return "(vararg)"; /* generic name for any vararg */
+ }
+ }
+ return NULL; /* no such vararg */
+}
+
+
+const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) {
+ StkId base = ci->func + 1;
+ const char *name = NULL;
+ if (isLua(ci)) {
+ if (n < 0) /* access to vararg values? */
+ return findvararg(ci, n, pos);
+ else
+ name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
+ }
+ if (name == NULL) { /* no 'standard' name? */
+ StkId limit = (ci == L->ci) ? L->top : ci->next->func;
+ if (limit - base >= n && n > 0) { /* is 'n' inside 'ci' stack? */
+ /* generic name for any valid slot */
+ name = isLua(ci) ? "(temporary)" : "(C temporary)";
+ }
+ else
+ return NULL; /* no name */
+ }
+ if (pos)
+ *pos = base + (n - 1);
+ return name;
+}
+
+
+LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
+ const char *name;
+ lua_lock(L);
+ if (ar == NULL) { /* information about non-active function? */
+ if (!isLfunction(s2v(L->top - 1))) /* not a Lua function? */
+ name = NULL;
+ else /* consider live variables at function start (parameters) */
+ name = luaF_getlocalname(clLvalue(s2v(L->top - 1))->p, n, 0);
+ }
+ else { /* active function; get information through 'ar' */
+ StkId pos = NULL; /* to avoid warnings */
+ name = luaG_findlocal(L, ar->i_ci, n, &pos);
+ if (name) {
+ setobjs2s(L, L->top, pos);
+ api_incr_top(L);
+ }
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
+ StkId pos = NULL; /* to avoid warnings */
+ const char *name;
+ lua_lock(L);
+ name = luaG_findlocal(L, ar->i_ci, n, &pos);
+ if (name) {
+ setobjs2s(L, pos, L->top - 1);
+ L->top--; /* pop value */
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+static void funcinfo (lua_Debug *ar, Closure *cl) {
+ if (noLuaClosure(cl)) {
+ ar->source = "=[C]";
+ ar->srclen = LL("=[C]");
+ ar->linedefined = -1;
+ ar->lastlinedefined = -1;
+ ar->what = "C";
+ }
+ else {
+ const Proto *p = cl->l.p;
+ if (p->source) {
+ ar->source = getstr(p->source);
+ ar->srclen = tsslen(p->source);
+ }
+ else {
+ ar->source = "=?";
+ ar->srclen = LL("=?");
+ }
+ ar->linedefined = p->linedefined;
+ ar->lastlinedefined = p->lastlinedefined;
+ ar->what = (ar->linedefined == 0) ? "main" : "Lua";
+ }
+ luaO_chunkid(ar->short_src, ar->source, ar->srclen);
+}
+
+
+static int nextline (const Proto *p, int currentline, int pc) {
+ if (p->lineinfo[pc] != ABSLINEINFO)
+ return currentline + p->lineinfo[pc];
+ else
+ return luaG_getfuncline(p, pc);
+}
+
+
+static void collectvalidlines (lua_State *L, Closure *f) {
+ if (noLuaClosure(f)) {
+ setnilvalue(s2v(L->top));
+ api_incr_top(L);
+ }
+ else {
+ int i;
+ TValue v;
+ const Proto *p = f->l.p;
+ int currentline = p->linedefined;
+ Table *t = luaH_new(L); /* new table to store active lines */
+ sethvalue2s(L, L->top, t); /* push it on stack */
+ api_incr_top(L);
+ setbtvalue(&v); /* boolean 'true' to be the value of all indices */
+ if (!p->is_vararg) /* regular function? */
+ i = 0; /* consider all instructions */
+ else { /* vararg function */
+ lua_assert(GET_OPCODE(p->code[0]) == OP_VARARGPREP);
+ currentline = nextline(p, currentline, 0);
+ i = 1; /* skip first instruction (OP_VARARGPREP) */
+ }
+ for (; i < p->sizelineinfo; i++) { /* for each instruction */
+ currentline = nextline(p, currentline, i); /* get its line */
+ luaH_setint(L, t, currentline, &v); /* table[line] = true */
+ }
+ }
+}
+
+
+static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
+ /* calling function is a known function? */
+ if (ci != NULL && !(ci->callstatus & CIST_TAIL))
+ return funcnamefromcall(L, ci->previous, name);
+ else return NULL; /* no way to find a name */
+}
+
+
+static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
+ Closure *f, CallInfo *ci) {
+ int status = 1;
+ for (; *what; what++) {
+ switch (*what) {
+ case 'S': {
+ funcinfo(ar, f);
+ break;
+ }
+ case 'l': {
+ ar->currentline = (ci && isLua(ci)) ? getcurrentline(ci) : -1;
+ break;
+ }
+ case 'u': {
+ ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
+ if (noLuaClosure(f)) {
+ ar->isvararg = 1;
+ ar->nparams = 0;
+ }
+ else {
+ ar->isvararg = f->l.p->is_vararg;
+ ar->nparams = f->l.p->numparams;
+ }
+ break;
+ }
+ case 't': {
+ ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
+ break;
+ }
+ case 'n': {
+ ar->namewhat = getfuncname(L, ci, &ar->name);
+ if (ar->namewhat == NULL) {
+ ar->namewhat = ""; /* not found */
+ ar->name = NULL;
+ }
+ break;
+ }
+ case 'r': {
+ if (ci == NULL || !(ci->callstatus & CIST_TRAN))
+ ar->ftransfer = ar->ntransfer = 0;
+ else {
+ ar->ftransfer = ci->u2.transferinfo.ftransfer;
+ ar->ntransfer = ci->u2.transferinfo.ntransfer;
+ }
+ break;
+ }
+ case 'L':
+ case 'f': /* handled by lua_getinfo */
+ break;
+ default: status = 0; /* invalid option */
+ }
+ }
+ return status;
+}
+
+
+LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
+ int status;
+ Closure *cl;
+ CallInfo *ci;
+ TValue *func;
+ lua_lock(L);
+ if (*what == '>') {
+ ci = NULL;
+ func = s2v(L->top - 1);
+ api_check(L, ttisfunction(func), "function expected");
+ what++; /* skip the '>' */
+ L->top--; /* pop function */
+ }
+ else {
+ ci = ar->i_ci;
+ func = s2v(ci->func);
+ lua_assert(ttisfunction(func));
+ }
+ cl = ttisclosure(func) ? clvalue(func) : NULL;
+ status = auxgetinfo(L, what, ar, cl, ci);
+ if (strchr(what, 'f')) {
+ setobj2s(L, L->top, func);
+ api_incr_top(L);
+ }
+ if (strchr(what, 'L'))
+ collectvalidlines(L, cl);
+ lua_unlock(L);
+ return status;
+}
+
+
+/*
+** {======================================================
+** Symbolic Execution
+** =======================================================
+*/
+
+static const char *getobjname (const Proto *p, int lastpc, int reg,
+ const char **name);
+
+
+/*
+** Find a "name" for the constant 'c'.
+*/
+static void kname (const Proto *p, int c, const char **name) {
+ TValue *kvalue = &p->k[c];
+ *name = (ttisstring(kvalue)) ? svalue(kvalue) : "?";
+}
+
+
+/*
+** Find a "name" for the register 'c'.
+*/
+static void rname (const Proto *p, int pc, int c, const char **name) {
+ const char *what = getobjname(p, pc, c, name); /* search for 'c' */
+ if (!(what && *what == 'c')) /* did not find a constant name? */
+ *name = "?";
+}
+
+
+/*
+** Find a "name" for a 'C' value in an RK instruction.
+*/
+static void rkname (const Proto *p, int pc, Instruction i, const char **name) {
+ int c = GETARG_C(i); /* key index */
+ if (GETARG_k(i)) /* is 'c' a constant? */
+ kname(p, c, name);
+ else /* 'c' is a register */
+ rname(p, pc, c, name);
+}
+
+
+static int filterpc (int pc, int jmptarget) {
+ if (pc < jmptarget) /* is code conditional (inside a jump)? */
+ return -1; /* cannot know who sets that register */
+ else return pc; /* current position sets that register */
+}
+
+
+/*
+** Try to find last instruction before 'lastpc' that modified register 'reg'.
+*/
+static int findsetreg (const Proto *p, int lastpc, int reg) {
+ int pc;
+ int setreg = -1; /* keep last instruction that changed 'reg' */
+ int jmptarget = 0; /* any code before this address is conditional */
+ if (testMMMode(GET_OPCODE(p->code[lastpc])))
+ lastpc--; /* previous instruction was not actually executed */
+ for (pc = 0; pc < lastpc; pc++) {
+ Instruction i = p->code[pc];
+ OpCode op = GET_OPCODE(i);
+ int a = GETARG_A(i);
+ int change; /* true if current instruction changed 'reg' */
+ switch (op) {
+ case OP_LOADNIL: { /* set registers from 'a' to 'a+b' */
+ int b = GETARG_B(i);
+ change = (a <= reg && reg <= a + b);
+ break;
+ }
+ case OP_TFORCALL: { /* affect all regs above its base */
+ change = (reg >= a + 2);
+ break;
+ }
+ case OP_CALL:
+ case OP_TAILCALL: { /* affect all registers above base */
+ change = (reg >= a);
+ break;
+ }
+ case OP_JMP: { /* doesn't change registers, but changes 'jmptarget' */
+ int b = GETARG_sJ(i);
+ int dest = pc + 1 + b;
+ /* jump does not skip 'lastpc' and is larger than current one? */
+ if (dest <= lastpc && dest > jmptarget)
+ jmptarget = dest; /* update 'jmptarget' */
+ change = 0;
+ break;
+ }
+ default: /* any instruction that sets A */
+ change = (testAMode(op) && reg == a);
+ break;
+ }
+ if (change)
+ setreg = filterpc(pc, jmptarget);
+ }
+ return setreg;
+}
+
+
+/*
+** Check whether table being indexed by instruction 'i' is the
+** environment '_ENV'
+*/
+static const char *gxf (const Proto *p, int pc, Instruction i, int isup) {
+ int t = GETARG_B(i); /* table index */
+ const char *name; /* name of indexed variable */
+ if (isup) /* is an upvalue? */
+ name = upvalname(p, t);
+ else
+ getobjname(p, pc, t, &name);
+ return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field";
+}
+
+
+static const char *getobjname (const Proto *p, int lastpc, int reg,
+ const char **name) {
+ int pc;
+ *name = luaF_getlocalname(p, reg + 1, lastpc);
+ if (*name) /* is a local? */
+ return "local";
+ /* else try symbolic execution */
+ pc = findsetreg(p, lastpc, reg);
+ if (pc != -1) { /* could find instruction? */
+ Instruction i = p->code[pc];
+ OpCode op = GET_OPCODE(i);
+ switch (op) {
+ case OP_MOVE: {
+ int b = GETARG_B(i); /* move from 'b' to 'a' */
+ if (b < GETARG_A(i))
+ return getobjname(p, pc, b, name); /* get name for 'b' */
+ break;
+ }
+ case OP_GETTABUP: {
+ int k = GETARG_C(i); /* key index */
+ kname(p, k, name);
+ return gxf(p, pc, i, 1);
+ }
+ case OP_GETTABLE: {
+ int k = GETARG_C(i); /* key index */
+ rname(p, pc, k, name);
+ return gxf(p, pc, i, 0);
+ }
+ case OP_GETI: {
+ *name = "integer index";
+ return "field";
+ }
+ case OP_GETFIELD: {
+ int k = GETARG_C(i); /* key index */
+ kname(p, k, name);
+ return gxf(p, pc, i, 0);
+ }
+ case OP_GETUPVAL: {
+ *name = upvalname(p, GETARG_B(i));
+ return "upvalue";
+ }
+ case OP_LOADK:
+ case OP_LOADKX: {
+ int b = (op == OP_LOADK) ? GETARG_Bx(i)
+ : GETARG_Ax(p->code[pc + 1]);
+ if (ttisstring(&p->k[b])) {
+ *name = svalue(&p->k[b]);
+ return "constant";
+ }
+ break;
+ }
+ case OP_SELF: {
+ rkname(p, pc, i, name);
+ return "method";
+ }
+ default: break; /* go through to return NULL */
+ }
+ }
+ return NULL; /* could not find reasonable name */
+}
+
+
+/*
+** Try to find a name for a function based on the code that called it.
+** (Only works when function was called by a Lua function.)
+** Returns what the name is (e.g., "for iterator", "method",
+** "metamethod") and sets '*name' to point to the name.
+*/
+static const char *funcnamefromcode (lua_State *L, const Proto *p,
+ int pc, const char **name) {
+ TMS tm = (TMS)0; /* (initial value avoids warnings) */
+ Instruction i = p->code[pc]; /* calling instruction */
+ switch (GET_OPCODE(i)) {
+ case OP_CALL:
+ case OP_TAILCALL:
+ return getobjname(p, pc, GETARG_A(i), name); /* get function name */
+ case OP_TFORCALL: { /* for iterator */
+ *name = "for iterator";
+ return "for iterator";
+ }
+ /* other instructions can do calls through metamethods */
+ case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:
+ case OP_GETI: case OP_GETFIELD:
+ tm = TM_INDEX;
+ break;
+ case OP_SETTABUP: case OP_SETTABLE: case OP_SETI: case OP_SETFIELD:
+ tm = TM_NEWINDEX;
+ break;
+ case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
+ tm = cast(TMS, GETARG_C(i));
+ break;
+ }
+ case OP_UNM: tm = TM_UNM; break;
+ case OP_BNOT: tm = TM_BNOT; break;
+ case OP_LEN: tm = TM_LEN; break;
+ case OP_CONCAT: tm = TM_CONCAT; break;
+ case OP_EQ: tm = TM_EQ; break;
+ /* no cases for OP_EQI and OP_EQK, as they don't call metamethods */
+ case OP_LT: case OP_LTI: case OP_GTI: tm = TM_LT; break;
+ case OP_LE: case OP_LEI: case OP_GEI: tm = TM_LE; break;
+ case OP_CLOSE: case OP_RETURN: tm = TM_CLOSE; break;
+ default:
+ return NULL; /* cannot find a reasonable name */
+ }
+ *name = getstr(G(L)->tmname[tm]) + 2;
+ return "metamethod";
+}
+
+
+/*
+** Try to find a name for a function based on how it was called.
+*/
+static const char *funcnamefromcall (lua_State *L, CallInfo *ci,
+ const char **name) {
+ if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */
+ *name = "?";
+ return "hook";
+ }
+ else if (ci->callstatus & CIST_FIN) { /* was it called as a finalizer? */
+ *name = "__gc";
+ return "metamethod"; /* report it as such */
+ }
+ else if (isLua(ci))
+ return funcnamefromcode(L, ci_func(ci)->p, currentpc(ci), name);
+ else
+ return NULL;
+}
+
+/* }====================================================== */
+
+
+
+/*
+** Check whether pointer 'o' points to some value in the stack
+** frame of the current function. Because 'o' may not point to a
+** value in this stack, we cannot compare it with the region
+** boundaries (undefined behaviour in ISO C).
+*/
+static int isinstack (CallInfo *ci, const TValue *o) {
+ StkId pos;
+ for (pos = ci->func + 1; pos < ci->top; pos++) {
+ if (o == s2v(pos))
+ return 1;
+ }
+ return 0; /* not found */
+}
+
+
+/*
+** Checks whether value 'o' came from an upvalue. (That can only happen
+** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
+** upvalues.)
+*/
+static const char *getupvalname (CallInfo *ci, const TValue *o,
+ const char **name) {
+ LClosure *c = ci_func(ci);
+ int i;
+ for (i = 0; i < c->nupvalues; i++) {
+ if (c->upvals[i]->v == o) {
+ *name = upvalname(c->p, i);
+ return "upvalue";
+ }
+ }
+ return NULL;
+}
+
+
+static const char *formatvarinfo (lua_State *L, const char *kind,
+ const char *name) {
+ if (kind == NULL)
+ return ""; /* no information */
+ else
+ return luaO_pushfstring(L, " (%s '%s')", kind, name);
+}
+
+/*
+** Build a string with a "description" for the value 'o', such as
+** "variable 'x'" or "upvalue 'y'".
+*/
+static const char *varinfo (lua_State *L, const TValue *o) {
+ CallInfo *ci = L->ci;
+ const char *name = NULL; /* to avoid warnings */
+ const char *kind = NULL;
+ if (isLua(ci)) {
+ kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */
+ if (!kind && isinstack(ci, o)) /* no? try a register */
+ kind = getobjname(ci_func(ci)->p, currentpc(ci),
+ cast_int(cast(StkId, o) - (ci->func + 1)), &name);
+ }
+ return formatvarinfo(L, kind, name);
+}
+
+
+/*
+** Raise a type error
+*/
+static l_noret typeerror (lua_State *L, const TValue *o, const char *op,
+ const char *extra) {
+ const char *t = luaT_objtypename(L, o);
+ luaG_runerror(L, "attempt to %s a %s value%s", op, t, extra);
+}
+
+
+/*
+** Raise a type error with "standard" information about the faulty
+** object 'o' (using 'varinfo').
+*/
+l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
+ typeerror(L, o, op, varinfo(L, o));
+}
+
+
+/*
+** Raise an error for calling a non-callable object. Try to find a name
+** for the object based on how it was called ('funcnamefromcall'); if it
+** cannot get a name there, try 'varinfo'.
+*/
+l_noret luaG_callerror (lua_State *L, const TValue *o) {
+ CallInfo *ci = L->ci;
+ const char *name = NULL; /* to avoid warnings */
+ const char *kind = funcnamefromcall(L, ci, &name);
+ const char *extra = kind ? formatvarinfo(L, kind, name) : varinfo(L, o);
+ typeerror(L, o, "call", extra);
+}
+
+
+l_noret luaG_forerror (lua_State *L, const TValue *o, const char *what) {
+ luaG_runerror(L, "bad 'for' %s (number expected, got %s)",
+ what, luaT_objtypename(L, o));
+}
+
+
+l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {
+ if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
+ luaG_typeerror(L, p1, "concatenate");
+}
+
+
+l_noret luaG_opinterror (lua_State *L, const TValue *p1,
+ const TValue *p2, const char *msg) {
+ if (!ttisnumber(p1)) /* first operand is wrong? */
+ p2 = p1; /* now second is wrong */
+ luaG_typeerror(L, p2, msg);
+}
+
+
+/*
+** Error when both values are convertible to numbers, but not to integers
+*/
+l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {
+ lua_Integer temp;
+ if (!luaV_tointegerns(p1, &temp, LUA_FLOORN2I))
+ p2 = p1;
+ luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
+}
+
+
+l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
+ const char *t1 = luaT_objtypename(L, p1);
+ const char *t2 = luaT_objtypename(L, p2);
+ if (strcmp(t1, t2) == 0)
+ luaG_runerror(L, "attempt to compare two %s values", t1);
+ else
+ luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
+}
+
+
+/* add src:line information to 'msg' */
+const char *luaG_addinfo (lua_State *L, const char *msg, TString *src,
+ int line) {
+ char buff[LUA_IDSIZE];
+ if (src)
+ luaO_chunkid(buff, getstr(src), tsslen(src));
+ else { /* no source available; use "?" instead */
+ buff[0] = '?'; buff[1] = '\0';
+ }
+ return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
+}
+
+
+l_noret luaG_errormsg (lua_State *L) {
+ if (L->errfunc != 0) { /* is there an error handling function? */
+ StkId errfunc = restorestack(L, L->errfunc);
+ lua_assert(ttisfunction(s2v(errfunc)));
+ setobjs2s(L, L->top, L->top - 1); /* move argument */
+ setobjs2s(L, L->top - 1, errfunc); /* push function */
+ L->top++; /* assume EXTRA_STACK */
+ luaD_callnoyield(L, L->top - 2, 1); /* call it */
+ }
+ luaD_throw(L, LUA_ERRRUN);
+}
+
+
+l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
+ CallInfo *ci = L->ci;
+ const char *msg;
+ va_list argp;
+ luaC_checkGC(L); /* error message uses memory */
+ va_start(argp, fmt);
+ msg = luaO_pushvfstring(L, fmt, argp); /* format message */
+ va_end(argp);
+ if (isLua(ci)) { /* if Lua function, add source:line information */
+ luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci));
+ setobjs2s(L, L->top - 2, L->top - 1); /* remove 'msg' from the stack */
+ L->top--;
+ }
+ luaG_errormsg(L);
+}
+
+
+/*
+** Check whether new instruction 'newpc' is in a different line from
+** previous instruction 'oldpc'. More often than not, 'newpc' is only
+** one or a few instructions after 'oldpc' (it must be after, see
+** caller), so try to avoid calling 'luaG_getfuncline'. If they are
+** too far apart, there is a good chance of a ABSLINEINFO in the way,
+** so it goes directly to 'luaG_getfuncline'.
+*/
+static int changedline (const Proto *p, int oldpc, int newpc) {
+ if (p->lineinfo == NULL) /* no debug information? */
+ return 0;
+ if (newpc - oldpc < MAXIWTHABS / 2) { /* not too far apart? */
+ int delta = 0; /* line diference */
+ int pc = oldpc;
+ for (;;) {
+ int lineinfo = p->lineinfo[++pc];
+ if (lineinfo == ABSLINEINFO)
+ break; /* cannot compute delta; fall through */
+ delta += lineinfo;
+ if (pc == newpc)
+ return (delta != 0); /* delta computed successfully */
+ }
+ }
+ /* either instructions are too far apart or there is an absolute line
+ info in the way; compute line difference explicitly */
+ return (luaG_getfuncline(p, oldpc) != luaG_getfuncline(p, newpc));
+}
+
+
+/*
+** Traces the execution of a Lua function. Called before the execution
+** of each opcode, when debug is on. 'L->oldpc' stores the last
+** instruction traced, to detect line changes. When entering a new
+** function, 'npci' will be zero and will test as a new line whatever
+** the value of 'oldpc'. Some exceptional conditions may return to
+** a function without setting 'oldpc'. In that case, 'oldpc' may be
+** invalid; if so, use zero as a valid value. (A wrong but valid 'oldpc'
+** at most causes an extra call to a line hook.)
+** This function is not "Protected" when called, so it should correct
+** 'L->top' before calling anything that can run the GC.
+*/
+int luaG_traceexec (lua_State *L, const Instruction *pc) {
+ CallInfo *ci = L->ci;
+ lu_byte mask = L->hookmask;
+ const Proto *p = ci_func(ci)->p;
+ int counthook;
+ if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) { /* no hooks? */
+ ci->u.l.trap = 0; /* don't need to stop again */
+ return 0; /* turn off 'trap' */
+ }
+ pc++; /* reference is always next instruction */
+ ci->u.l.savedpc = pc; /* save 'pc' */
+ counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
+ if (counthook)
+ resethookcount(L); /* reset count */
+ else if (!(mask & LUA_MASKLINE))
+ return 1; /* no line hook and count != 0; nothing to be done now */
+ if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */
+ ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */
+ return 1; /* do not call hook again (VM yielded, so it did not move) */
+ }
+ if (!isIT(*(ci->u.l.savedpc - 1))) /* top not being used? */
+ L->top = ci->top; /* correct top */
+ if (counthook)
+ luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0); /* call count hook */
+ if (mask & LUA_MASKLINE) {
+ /* 'L->oldpc' may be invalid; use zero in this case */
+ int oldpc = (L->oldpc < p->sizecode) ? L->oldpc : 0;
+ int npci = pcRel(pc, p);
+ if (npci <= oldpc || /* call hook when jump back (loop), */
+ changedline(p, oldpc, npci)) { /* or when enter new line */
+ int newline = luaG_getfuncline(p, npci);
+ luaD_hook(L, LUA_HOOKLINE, newline, 0, 0); /* call line hook */
+ }
+ L->oldpc = npci; /* 'pc' of last call to line hook */
+ }
+ if (L->status == LUA_YIELD) { /* did hook yield? */
+ if (counthook)
+ L->hookcount = 1; /* undo decrement to zero */
+ ci->u.l.savedpc--; /* undo increment (resume will increment it again) */
+ ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */
+ luaD_throw(L, LUA_YIELD);
+ }
+ return 1; /* keep 'trap' on */
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/ldebug.h b/source/luametatex/source/luacore/lua54/src/ldebug.h
new file mode 100644
index 000000000..974960e99
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ldebug.h
@@ -0,0 +1,63 @@
+/*
+** $Id: ldebug.h $
+** Auxiliary functions from Debug Interface module
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ldebug_h
+#define ldebug_h
+
+
+#include "lstate.h"
+
+
+#define pcRel(pc, p) (cast_int((pc) - (p)->code) - 1)
+
+
+/* Active Lua function (given call info) */
+#define ci_func(ci) (clLvalue(s2v((ci)->func)))
+
+
+#define resethookcount(L) (L->hookcount = L->basehookcount)
+
+/*
+** mark for entries in 'lineinfo' array that has absolute information in
+** 'abslineinfo' array
+*/
+#define ABSLINEINFO (-0x80)
+
+
+/*
+** MAXimum number of successive Instructions WiTHout ABSolute line
+** information. (A power of two allows fast divisions.)
+*/
+#if !defined(MAXIWTHABS)
+#define MAXIWTHABS 128
+#endif
+
+
+LUAI_FUNC int luaG_getfuncline (const Proto *f, int pc);
+LUAI_FUNC const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n,
+ StkId *pos);
+LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,
+ const char *opname);
+LUAI_FUNC l_noret luaG_callerror (lua_State *L, const TValue *o);
+LUAI_FUNC l_noret luaG_forerror (lua_State *L, const TValue *o,
+ const char *what);
+LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1,
+ const TValue *p2);
+LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1,
+ const TValue *p2,
+ const char *msg);
+LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1,
+ const TValue *p2);
+LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1,
+ const TValue *p2);
+LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...);
+LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg,
+ TString *src, int line);
+LUAI_FUNC l_noret luaG_errormsg (lua_State *L);
+LUAI_FUNC int luaG_traceexec (lua_State *L, const Instruction *pc);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/ldo.c b/source/luametatex/source/luacore/lua54/src/ldo.c
new file mode 100644
index 000000000..419b3db93
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ldo.c
@@ -0,0 +1,1005 @@
+/*
+** $Id: ldo.c $
+** Stack and Call structure of Lua
+** See Copyright Notice in lua.h
+*/
+
+#define ldo_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <setjmp.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lapi.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lundump.h"
+#include "lvm.h"
+#include "lzio.h"
+
+
+
+#define errorstatus(s) ((s) > LUA_YIELD)
+
+
+/*
+** {======================================================
+** Error-recovery functions
+** =======================================================
+*/
+
+/*
+** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By
+** default, Lua handles errors with exceptions when compiling as
+** C++ code, with _longjmp/_setjmp when asked to use them, and with
+** longjmp/setjmp otherwise.
+*/
+#if !defined(LUAI_THROW) /* { */
+
+#if defined(__cplusplus) && !defined(LUA_USE_LONGJMP) /* { */
+
+/* C++ exceptions */
+#define LUAI_THROW(L,c) throw(c)
+#define LUAI_TRY(L,c,a) \
+ try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; }
+#define luai_jmpbuf int /* dummy variable */
+
+#elif defined(LUA_USE_POSIX) /* }{ */
+
+/* in POSIX, try _longjmp/_setjmp (more efficient) */
+#define LUAI_THROW(L,c) _longjmp((c)->b, 1)
+#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a }
+#define luai_jmpbuf jmp_buf
+
+#else /* }{ */
+
+/* ISO C handling with long jumps */
+#define LUAI_THROW(L,c) longjmp((c)->b, 1)
+#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a }
+#define luai_jmpbuf jmp_buf
+
+#endif /* } */
+
+#endif /* } */
+
+
+
+/* chain list of long jump buffers */
+struct lua_longjmp {
+ struct lua_longjmp *previous;
+ luai_jmpbuf b;
+ volatile int status; /* error code */
+};
+
+
+void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop) {
+ switch (errcode) {
+ case LUA_ERRMEM: { /* memory error? */
+ setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */
+ break;
+ }
+ case LUA_ERRERR: {
+ setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling"));
+ break;
+ }
+ case LUA_OK: { /* special case only for closing upvalues */
+ setnilvalue(s2v(oldtop)); /* no error message */
+ break;
+ }
+ default: {
+ lua_assert(errorstatus(errcode)); /* real error */
+ setobjs2s(L, oldtop, L->top - 1); /* error message on current top */
+ break;
+ }
+ }
+ L->top = oldtop + 1;
+}
+
+
+l_noret luaD_throw (lua_State *L, int errcode) {
+ if (L->errorJmp) { /* thread has an error handler? */
+ L->errorJmp->status = errcode; /* set status */
+ LUAI_THROW(L, L->errorJmp); /* jump to it */
+ }
+ else { /* thread has no error handler */
+ global_State *g = G(L);
+ errcode = luaE_resetthread(L, errcode); /* close all upvalues */
+ if (g->mainthread->errorJmp) { /* main thread has a handler? */
+ setobjs2s(L, g->mainthread->top++, L->top - 1); /* copy error obj. */
+ luaD_throw(g->mainthread, errcode); /* re-throw in main thread */
+ }
+ else { /* no handler at all; abort */
+ if (g->panic) { /* panic function? */
+ lua_unlock(L);
+ g->panic(L); /* call panic function (last chance to jump out) */
+ }
+ abort();
+ }
+ }
+}
+
+
+int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
+ l_uint32 oldnCcalls = L->nCcalls;
+ struct lua_longjmp lj;
+ lj.status = LUA_OK;
+ lj.previous = L->errorJmp; /* chain new error handler */
+ L->errorJmp = &lj;
+ LUAI_TRY(L, &lj,
+ (*f)(L, ud);
+ );
+ L->errorJmp = lj.previous; /* restore old error handler */
+ L->nCcalls = oldnCcalls;
+ return lj.status;
+}
+
+/* }====================================================== */
+
+
+/*
+** {==================================================================
+** Stack reallocation
+** ===================================================================
+*/
+static void correctstack (lua_State *L, StkId oldstack, StkId newstack) {
+ CallInfo *ci;
+ UpVal *up;
+ L->top = (L->top - oldstack) + newstack;
+ L->tbclist = (L->tbclist - oldstack) + newstack;
+ for (up = L->openupval; up != NULL; up = up->u.open.next)
+ up->v = s2v((uplevel(up) - oldstack) + newstack);
+ for (ci = L->ci; ci != NULL; ci = ci->previous) {
+ ci->top = (ci->top - oldstack) + newstack;
+ ci->func = (ci->func - oldstack) + newstack;
+ if (isLua(ci))
+ ci->u.l.trap = 1; /* signal to update 'trap' in 'luaV_execute' */
+ }
+}
+
+
+/* some space for error handling */
+#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200)
+
+
+/*
+** Reallocate the stack to a new size, correcting all pointers into
+** it. (There are pointers to a stack from its upvalues, from its list
+** of call infos, plus a few individual pointers.) The reallocation is
+** done in two steps (allocation + free) because the correction must be
+** done while both addresses (the old stack and the new one) are valid.
+** (In ISO C, any pointer use after the pointer has been deallocated is
+** undefined behavior.)
+** In case of allocation error, raise an error or return false according
+** to 'raiseerror'.
+*/
+int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) {
+ int oldsize = stacksize(L);
+ int i;
+ StkId newstack = luaM_reallocvector(L, NULL, 0,
+ newsize + EXTRA_STACK, StackValue);
+ lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE);
+ if (l_unlikely(newstack == NULL)) { /* reallocation failed? */
+ if (raiseerror)
+ luaM_error(L);
+ else return 0; /* do not raise an error */
+ }
+ /* number of elements to be copied to the new stack */
+ i = ((oldsize <= newsize) ? oldsize : newsize) + EXTRA_STACK;
+ memcpy(newstack, L->stack, i * sizeof(StackValue));
+ for (; i < newsize + EXTRA_STACK; i++)
+ setnilvalue(s2v(newstack + i)); /* erase new segment */
+ correctstack(L, L->stack, newstack);
+ luaM_freearray(L, L->stack, oldsize + EXTRA_STACK);
+ L->stack = newstack;
+ L->stack_last = L->stack + newsize;
+ return 1;
+}
+
+
+/*
+** Try to grow the stack by at least 'n' elements. When 'raiseerror'
+** is true, raises any error; otherwise, return 0 in case of errors.
+*/
+int luaD_growstack (lua_State *L, int n, int raiseerror) {
+ int size = stacksize(L);
+ if (l_unlikely(size > LUAI_MAXSTACK)) {
+ /* if stack is larger than maximum, thread is already using the
+ extra space reserved for errors, that is, thread is handling
+ a stack error; cannot grow further than that. */
+ lua_assert(stacksize(L) == ERRORSTACKSIZE);
+ if (raiseerror)
+ luaD_throw(L, LUA_ERRERR); /* error inside message handler */
+ return 0; /* if not 'raiseerror', just signal it */
+ }
+ else if (n < LUAI_MAXSTACK) { /* avoids arithmetic overflows */
+ int newsize = 2 * size; /* tentative new size */
+ int needed = cast_int(L->top - L->stack) + n;
+ if (newsize > LUAI_MAXSTACK) /* cannot cross the limit */
+ newsize = LUAI_MAXSTACK;
+ if (newsize < needed) /* but must respect what was asked for */
+ newsize = needed;
+ if (l_likely(newsize <= LUAI_MAXSTACK))
+ return luaD_reallocstack(L, newsize, raiseerror);
+ }
+ /* else stack overflow */
+ /* add extra size to be able to handle the error message */
+ luaD_reallocstack(L, ERRORSTACKSIZE, raiseerror);
+ if (raiseerror)
+ luaG_runerror(L, "stack overflow");
+ return 0;
+}
+
+
+/*
+** Compute how much of the stack is being used, by computing the
+** maximum top of all call frames in the stack and the current top.
+*/
+static int stackinuse (lua_State *L) {
+ CallInfo *ci;
+ int res;
+ StkId lim = L->top;
+ for (ci = L->ci; ci != NULL; ci = ci->previous) {
+ if (lim < ci->top) lim = ci->top;
+ }
+ lua_assert(lim <= L->stack_last + EXTRA_STACK);
+ res = cast_int(lim - L->stack) + 1; /* part of stack in use */
+ if (res < LUA_MINSTACK)
+ res = LUA_MINSTACK; /* ensure a minimum size */
+ return res;
+}
+
+
+/*
+** If stack size is more than 3 times the current use, reduce that size
+** to twice the current use. (So, the final stack size is at most 2/3 the
+** previous size, and half of its entries are empty.)
+** As a particular case, if stack was handling a stack overflow and now
+** it is not, 'max' (limited by LUAI_MAXSTACK) will be smaller than
+** stacksize (equal to ERRORSTACKSIZE in this case), and so the stack
+** will be reduced to a "regular" size.
+*/
+void luaD_shrinkstack (lua_State *L) {
+ int inuse = stackinuse(L);
+ int nsize = inuse * 2; /* proposed new size */
+ int max = inuse * 3; /* maximum "reasonable" size */
+ if (max > LUAI_MAXSTACK) {
+ max = LUAI_MAXSTACK; /* respect stack limit */
+ if (nsize > LUAI_MAXSTACK)
+ nsize = LUAI_MAXSTACK;
+ }
+ /* if thread is currently not handling a stack overflow and its
+ size is larger than maximum "reasonable" size, shrink it */
+ if (inuse <= LUAI_MAXSTACK && stacksize(L) > max)
+ luaD_reallocstack(L, nsize, 0); /* ok if that fails */
+ else /* don't change stack */
+ condmovestack(L,{},{}); /* (change only for debugging) */
+ luaE_shrinkCI(L); /* shrink CI list */
+}
+
+
+void luaD_inctop (lua_State *L) {
+ luaD_checkstack(L, 1);
+ L->top++;
+}
+
+/* }================================================================== */
+
+
+/*
+** Call a hook for the given event. Make sure there is a hook to be
+** called. (Both 'L->hook' and 'L->hookmask', which trigger this
+** function, can be changed asynchronously by signals.)
+*/
+void luaD_hook (lua_State *L, int event, int line,
+ int ftransfer, int ntransfer) {
+ lua_Hook hook = L->hook;
+ if (hook && L->allowhook) { /* make sure there is a hook */
+ int mask = CIST_HOOKED;
+ CallInfo *ci = L->ci;
+ ptrdiff_t top = savestack(L, L->top); /* preserve original 'top' */
+ ptrdiff_t ci_top = savestack(L, ci->top); /* idem for 'ci->top' */
+ lua_Debug ar;
+ ar.event = event;
+ ar.currentline = line;
+ ar.i_ci = ci;
+ if (ntransfer != 0) {
+ mask |= CIST_TRAN; /* 'ci' has transfer information */
+ ci->u2.transferinfo.ftransfer = ftransfer;
+ ci->u2.transferinfo.ntransfer = ntransfer;
+ }
+ if (isLua(ci) && L->top < ci->top)
+ L->top = ci->top; /* protect entire activation register */
+ luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
+ if (ci->top < L->top + LUA_MINSTACK)
+ ci->top = L->top + LUA_MINSTACK;
+ L->allowhook = 0; /* cannot call hooks inside a hook */
+ ci->callstatus |= mask;
+ lua_unlock(L);
+ (*hook)(L, &ar);
+ lua_lock(L);
+ lua_assert(!L->allowhook);
+ L->allowhook = 1;
+ ci->top = restorestack(L, ci_top);
+ L->top = restorestack(L, top);
+ ci->callstatus &= ~mask;
+ }
+}
+
+
+/*
+** Executes a call hook for Lua functions. This function is called
+** whenever 'hookmask' is not zero, so it checks whether call hooks are
+** active.
+*/
+void luaD_hookcall (lua_State *L, CallInfo *ci) {
+ L->oldpc = 0; /* set 'oldpc' for new function */
+ if (L->hookmask & LUA_MASKCALL) { /* is call hook on? */
+ int event = (ci->callstatus & CIST_TAIL) ? LUA_HOOKTAILCALL
+ : LUA_HOOKCALL;
+ Proto *p = ci_func(ci)->p;
+ ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */
+ luaD_hook(L, event, -1, 1, p->numparams);
+ ci->u.l.savedpc--; /* correct 'pc' */
+ }
+}
+
+
+/*
+** Executes a return hook for Lua and C functions and sets/corrects
+** 'oldpc'. (Note that this correction is needed by the line hook, so it
+** is done even when return hooks are off.)
+*/
+static void rethook (lua_State *L, CallInfo *ci, int nres) {
+ if (L->hookmask & LUA_MASKRET) { /* is return hook on? */
+ StkId firstres = L->top - nres; /* index of first result */
+ int delta = 0; /* correction for vararg functions */
+ int ftransfer;
+ if (isLua(ci)) {
+ Proto *p = ci_func(ci)->p;
+ if (p->is_vararg)
+ delta = ci->u.l.nextraargs + p->numparams + 1;
+ }
+ ci->func += delta; /* if vararg, back to virtual 'func' */
+ ftransfer = cast(unsigned short, firstres - ci->func);
+ luaD_hook(L, LUA_HOOKRET, -1, ftransfer, nres); /* call it */
+ ci->func -= delta;
+ }
+ if (isLua(ci = ci->previous))
+ L->oldpc = pcRel(ci->u.l.savedpc, ci_func(ci)->p); /* set 'oldpc' */
+}
+
+
+/*
+** Check whether 'func' has a '__call' metafield. If so, put it in the
+** stack, below original 'func', so that 'luaD_precall' can call it. Raise
+** an error if there is no '__call' metafield.
+*/
+StkId luaD_tryfuncTM (lua_State *L, StkId func) {
+ const TValue *tm;
+ StkId p;
+ checkstackGCp(L, 1, func); /* space for metamethod */
+ tm = luaT_gettmbyobj(L, s2v(func), TM_CALL); /* (after previous GC) */
+ if (l_unlikely(ttisnil(tm)))
+ luaG_callerror(L, s2v(func)); /* nothing to call */
+ for (p = L->top; p > func; p--) /* open space for metamethod */
+ setobjs2s(L, p, p-1);
+ L->top++; /* stack space pre-allocated by the caller */
+ setobj2s(L, func, tm); /* metamethod is the new function to be called */
+ return func;
+}
+
+
+/*
+** Given 'nres' results at 'firstResult', move 'wanted' of them to 'res'.
+** Handle most typical cases (zero results for commands, one result for
+** expressions, multiple results for tail calls/single parameters)
+** separated.
+*/
+l_sinline void moveresults (lua_State *L, StkId res, int nres, int wanted) {
+ StkId firstresult;
+ int i;
+ switch (wanted) { /* handle typical cases separately */
+ case 0: /* no values needed */
+ L->top = res;
+ return;
+ case 1: /* one value needed */
+ if (nres == 0) /* no results? */
+ setnilvalue(s2v(res)); /* adjust with nil */
+ else /* at least one result */
+ setobjs2s(L, res, L->top - nres); /* move it to proper place */
+ L->top = res + 1;
+ return;
+ case LUA_MULTRET:
+ wanted = nres; /* we want all results */
+ break;
+ default: /* two/more results and/or to-be-closed variables */
+ if (hastocloseCfunc(wanted)) { /* to-be-closed variables? */
+ L->ci->callstatus |= CIST_CLSRET; /* in case of yields */
+ L->ci->u2.nres = nres;
+ res = luaF_close(L, res, CLOSEKTOP, 1);
+ L->ci->callstatus &= ~CIST_CLSRET;
+ if (L->hookmask) { /* if needed, call hook after '__close's */
+ ptrdiff_t savedres = savestack(L, res);
+ rethook(L, L->ci, nres);
+ res = restorestack(L, savedres); /* hook can move stack */
+ }
+ wanted = decodeNresults(wanted);
+ if (wanted == LUA_MULTRET)
+ wanted = nres; /* we want all results */
+ }
+ break;
+ }
+ /* generic case */
+ firstresult = L->top - nres; /* index of first result */
+ if (nres > wanted) /* extra results? */
+ nres = wanted; /* don't need them */
+ for (i = 0; i < nres; i++) /* move all results to correct place */
+ setobjs2s(L, res + i, firstresult + i);
+ for (; i < wanted; i++) /* complete wanted number of results */
+ setnilvalue(s2v(res + i));
+ L->top = res + wanted; /* top points after the last result */
+}
+
+
+/*
+** Finishes a function call: calls hook if necessary, moves current
+** number of results to proper place, and returns to previous call
+** info. If function has to close variables, hook must be called after
+** that.
+*/
+void luaD_poscall (lua_State *L, CallInfo *ci, int nres) {
+ int wanted = ci->nresults;
+ if (l_unlikely(L->hookmask && !hastocloseCfunc(wanted)))
+ rethook(L, ci, nres);
+ /* move results to proper place */
+ moveresults(L, ci->func, nres, wanted);
+ /* function cannot be in any of these cases when returning */
+ lua_assert(!(ci->callstatus &
+ (CIST_HOOKED | CIST_YPCALL | CIST_FIN | CIST_TRAN | CIST_CLSRET)));
+ L->ci = ci->previous; /* back to caller (after closing variables) */
+}
+
+
+
+#define next_ci(L) (L->ci->next ? L->ci->next : luaE_extendCI(L))
+
+
+l_sinline CallInfo *prepCallInfo (lua_State *L, StkId func, int nret,
+ int mask, StkId top) {
+ CallInfo *ci = L->ci = next_ci(L); /* new frame */
+ ci->func = func;
+ ci->nresults = nret;
+ ci->callstatus = mask;
+ ci->top = top;
+ return ci;
+}
+
+
+/*
+** precall for C functions
+*/
+l_sinline int precallC (lua_State *L, StkId func, int nresults,
+ lua_CFunction f) {
+ int n; /* number of returns */
+ CallInfo *ci;
+ checkstackGCp(L, LUA_MINSTACK, func); /* ensure minimum stack size */
+ L->ci = ci = prepCallInfo(L, func, nresults, CIST_C,
+ L->top + LUA_MINSTACK);
+ lua_assert(ci->top <= L->stack_last);
+ if (l_unlikely(L->hookmask & LUA_MASKCALL)) {
+ int narg = cast_int(L->top - func) - 1;
+ luaD_hook(L, LUA_HOOKCALL, -1, 1, narg);
+ }
+ lua_unlock(L);
+ n = (*f)(L); /* do the actual call */
+ lua_lock(L);
+ api_checknelems(L, n);
+ luaD_poscall(L, ci, n);
+ return n;
+}
+
+
+/*
+** Prepare a function for a tail call, building its call info on top
+** of the current call info. 'narg1' is the number of arguments plus 1
+** (so that it includes the function itself). Return the number of
+** results, if it was a C function, or -1 for a Lua function.
+*/
+int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func,
+ int narg1, int delta) {
+ retry:
+ switch (ttypetag(s2v(func))) {
+ case LUA_VCCL: /* C closure */
+ return precallC(L, func, LUA_MULTRET, clCvalue(s2v(func))->f);
+ case LUA_VLCF: /* light C function */
+ return precallC(L, func, LUA_MULTRET, fvalue(s2v(func)));
+ case LUA_VLCL: { /* Lua function */
+ Proto *p = clLvalue(s2v(func))->p;
+ int fsize = p->maxstacksize; /* frame size */
+ int nfixparams = p->numparams;
+ int i;
+ checkstackGCp(L, fsize - delta, func);
+ ci->func -= delta; /* restore 'func' (if vararg) */
+ for (i = 0; i < narg1; i++) /* move down function and arguments */
+ setobjs2s(L, ci->func + i, func + i);
+ func = ci->func; /* moved-down function */
+ for (; narg1 <= nfixparams; narg1++)
+ setnilvalue(s2v(func + narg1)); /* complete missing arguments */
+ ci->top = func + 1 + fsize; /* top for new function */
+ lua_assert(ci->top <= L->stack_last);
+ ci->u.l.savedpc = p->code; /* starting point */
+ ci->callstatus |= CIST_TAIL;
+ L->top = func + narg1; /* set top */
+ return -1;
+ }
+ default: { /* not a function */
+ func = luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */
+ /* return luaD_pretailcall(L, ci, func, narg1 + 1, delta); */
+ narg1++;
+ goto retry; /* try again */
+ }
+ }
+}
+
+
+/*
+** Prepares the call to a function (C or Lua). For C functions, also do
+** the call. The function to be called is at '*func'. The arguments
+** are on the stack, right after the function. Returns the CallInfo
+** to be executed, if it was a Lua function. Otherwise (a C function)
+** returns NULL, with all the results on the stack, starting at the
+** original function position.
+*/
+CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) {
+ retry:
+ switch (ttypetag(s2v(func))) {
+ case LUA_VCCL: /* C closure */
+ precallC(L, func, nresults, clCvalue(s2v(func))->f);
+ return NULL;
+ case LUA_VLCF: /* light C function */
+ precallC(L, func, nresults, fvalue(s2v(func)));
+ return NULL;
+ case LUA_VLCL: { /* Lua function */
+ CallInfo *ci;
+ Proto *p = clLvalue(s2v(func))->p;
+ int narg = cast_int(L->top - func) - 1; /* number of real arguments */
+ int nfixparams = p->numparams;
+ int fsize = p->maxstacksize; /* frame size */
+ checkstackGCp(L, fsize, func);
+ L->ci = ci = prepCallInfo(L, func, nresults, 0, func + 1 + fsize);
+ ci->u.l.savedpc = p->code; /* starting point */
+ for (; narg < nfixparams; narg++)
+ setnilvalue(s2v(L->top++)); /* complete missing arguments */
+ lua_assert(ci->top <= L->stack_last);
+ return ci;
+ }
+ default: { /* not a function */
+ func = luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */
+ /* return luaD_precall(L, func, nresults); */
+ goto retry; /* try again with metamethod */
+ }
+ }
+}
+
+
+/*
+** Call a function (C or Lua) through C. 'inc' can be 1 (increment
+** number of recursive invocations in the C stack) or nyci (the same
+** plus increment number of non-yieldable calls).
+** This function can be called with some use of EXTRA_STACK, so it should
+** check the stack before doing anything else. 'luaD_precall' already
+** does that.
+*/
+l_sinline void ccall (lua_State *L, StkId func, int nResults, int inc) {
+ CallInfo *ci;
+ L->nCcalls += inc;
+ if (l_unlikely(getCcalls(L) >= LUAI_MAXCCALLS)) {
+ checkstackp(L, 0, func); /* free any use of EXTRA_STACK */
+ luaE_checkcstack(L);
+ }
+ if ((ci = luaD_precall(L, func, nResults)) != NULL) { /* Lua function? */
+ ci->callstatus = CIST_FRESH; /* mark that it is a "fresh" execute */
+ luaV_execute(L, ci); /* call it */
+ }
+ L->nCcalls -= inc;
+}
+
+
+/*
+** External interface for 'ccall'
+*/
+void luaD_call (lua_State *L, StkId func, int nResults) {
+ ccall(L, func, nResults, 1);
+}
+
+
+/*
+** Similar to 'luaD_call', but does not allow yields during the call.
+*/
+void luaD_callnoyield (lua_State *L, StkId func, int nResults) {
+ ccall(L, func, nResults, nyci);
+}
+
+
+/*
+** Finish the job of 'lua_pcallk' after it was interrupted by an yield.
+** (The caller, 'finishCcall', does the final call to 'adjustresults'.)
+** The main job is to complete the 'luaD_pcall' called by 'lua_pcallk'.
+** If a '__close' method yields here, eventually control will be back
+** to 'finishCcall' (when that '__close' method finally returns) and
+** 'finishpcallk' will run again and close any still pending '__close'
+** methods. Similarly, if a '__close' method errs, 'precover' calls
+** 'unroll' which calls ''finishCcall' and we are back here again, to
+** close any pending '__close' methods.
+** Note that, up to the call to 'luaF_close', the corresponding
+** 'CallInfo' is not modified, so that this repeated run works like the
+** first one (except that it has at least one less '__close' to do). In
+** particular, field CIST_RECST preserves the error status across these
+** multiple runs, changing only if there is a new error.
+*/
+static int finishpcallk (lua_State *L, CallInfo *ci) {
+ int status = getcistrecst(ci); /* get original status */
+ if (l_likely(status == LUA_OK)) /* no error? */
+ status = LUA_YIELD; /* was interrupted by an yield */
+ else { /* error */
+ StkId func = restorestack(L, ci->u2.funcidx);
+ L->allowhook = getoah(ci->callstatus); /* restore 'allowhook' */
+ func = luaF_close(L, func, status, 1); /* can yield or raise an error */
+ luaD_seterrorobj(L, status, func);
+ luaD_shrinkstack(L); /* restore stack size in case of overflow */
+ setcistrecst(ci, LUA_OK); /* clear original status */
+ }
+ ci->callstatus &= ~CIST_YPCALL;
+ L->errfunc = ci->u.c.old_errfunc;
+ /* if it is here, there were errors or yields; unlike 'lua_pcallk',
+ do not change status */
+ return status;
+}
+
+
+/*
+** Completes the execution of a C function interrupted by an yield.
+** The interruption must have happened while the function was either
+** closing its tbc variables in 'moveresults' or executing
+** 'lua_callk'/'lua_pcallk'. In the first case, it just redoes
+** 'luaD_poscall'. In the second case, the call to 'finishpcallk'
+** finishes the interrupted execution of 'lua_pcallk'. After that, it
+** calls the continuation of the interrupted function and finally it
+** completes the job of the 'luaD_call' that called the function. In
+** the call to 'adjustresults', we do not know the number of results
+** of the function called by 'lua_callk'/'lua_pcallk', so we are
+** conservative and use LUA_MULTRET (always adjust).
+*/
+static void finishCcall (lua_State *L, CallInfo *ci) {
+ int n; /* actual number of results from C function */
+ if (ci->callstatus & CIST_CLSRET) { /* was returning? */
+ lua_assert(hastocloseCfunc(ci->nresults));
+ n = ci->u2.nres; /* just redo 'luaD_poscall' */
+ /* don't need to reset CIST_CLSRET, as it will be set again anyway */
+ }
+ else {
+ int status = LUA_YIELD; /* default if there were no errors */
+ /* must have a continuation and must be able to call it */
+ lua_assert(ci->u.c.k != NULL && yieldable(L));
+ if (ci->callstatus & CIST_YPCALL) /* was inside a 'lua_pcallk'? */
+ status = finishpcallk(L, ci); /* finish it */
+ adjustresults(L, LUA_MULTRET); /* finish 'lua_callk' */
+ lua_unlock(L);
+ n = (*ci->u.c.k)(L, status, ci->u.c.ctx); /* call continuation */
+ lua_lock(L);
+ api_checknelems(L, n);
+ }
+ luaD_poscall(L, ci, n); /* finish 'luaD_call' */
+}
+
+
+/*
+** Executes "full continuation" (everything in the stack) of a
+** previously interrupted coroutine until the stack is empty (or another
+** interruption long-jumps out of the loop).
+*/
+static void unroll (lua_State *L, void *ud) {
+ CallInfo *ci;
+ UNUSED(ud);
+ while ((ci = L->ci) != &L->base_ci) { /* something in the stack */
+ if (!isLua(ci)) /* C function? */
+ finishCcall(L, ci); /* complete its execution */
+ else { /* Lua function */
+ luaV_finishOp(L); /* finish interrupted instruction */
+ luaV_execute(L, ci); /* execute down to higher C 'boundary' */
+ }
+ }
+}
+
+
+/*
+** Try to find a suspended protected call (a "recover point") for the
+** given thread.
+*/
+static CallInfo *findpcall (lua_State *L) {
+ CallInfo *ci;
+ for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */
+ if (ci->callstatus & CIST_YPCALL)
+ return ci;
+ }
+ return NULL; /* no pending pcall */
+}
+
+
+/*
+** Signal an error in the call to 'lua_resume', not in the execution
+** of the coroutine itself. (Such errors should not be handled by any
+** coroutine error handler and should not kill the coroutine.)
+*/
+static int resume_error (lua_State *L, const char *msg, int narg) {
+ L->top -= narg; /* remove args from the stack */
+ setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */
+ api_incr_top(L);
+ lua_unlock(L);
+ return LUA_ERRRUN;
+}
+
+
+/*
+** Do the work for 'lua_resume' in protected mode. Most of the work
+** depends on the status of the coroutine: initial state, suspended
+** inside a hook, or regularly suspended (optionally with a continuation
+** function), plus erroneous cases: non-suspended coroutine or dead
+** coroutine.
+*/
+static void resume (lua_State *L, void *ud) {
+ int n = *(cast(int*, ud)); /* number of arguments */
+ StkId firstArg = L->top - n; /* first argument */
+ CallInfo *ci = L->ci;
+ if (L->status == LUA_OK) /* starting a coroutine? */
+ ccall(L, firstArg - 1, LUA_MULTRET, 0); /* just call its body */
+ else { /* resuming from previous yield */
+ lua_assert(L->status == LUA_YIELD);
+ L->status = LUA_OK; /* mark that it is running (again) */
+ if (isLua(ci)) { /* yielded inside a hook? */
+ L->top = firstArg; /* discard arguments */
+ luaV_execute(L, ci); /* just continue running Lua code */
+ }
+ else { /* 'common' yield */
+ if (ci->u.c.k != NULL) { /* does it have a continuation function? */
+ lua_unlock(L);
+ n = (*ci->u.c.k)(L, LUA_YIELD, ci->u.c.ctx); /* call continuation */
+ lua_lock(L);
+ api_checknelems(L, n);
+ }
+ luaD_poscall(L, ci, n); /* finish 'luaD_call' */
+ }
+ unroll(L, NULL); /* run continuation */
+ }
+}
+
+
+/*
+** Unrolls a coroutine in protected mode while there are recoverable
+** errors, that is, errors inside a protected call. (Any error
+** interrupts 'unroll', and this loop protects it again so it can
+** continue.) Stops with a normal end (status == LUA_OK), an yield
+** (status == LUA_YIELD), or an unprotected error ('findpcall' doesn't
+** find a recover point).
+*/
+static int precover (lua_State *L, int status) {
+ CallInfo *ci;
+ while (errorstatus(status) && (ci = findpcall(L)) != NULL) {
+ L->ci = ci; /* go down to recovery functions */
+ setcistrecst(ci, status); /* status to finish 'pcall' */
+ status = luaD_rawrunprotected(L, unroll, NULL);
+ }
+ return status;
+}
+
+
+LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs,
+ int *nresults) {
+ int status;
+ lua_lock(L);
+ if (L->status == LUA_OK) { /* may be starting a coroutine */
+ if (L->ci != &L->base_ci) /* not in base level? */
+ return resume_error(L, "cannot resume non-suspended coroutine", nargs);
+ else if (L->top - (L->ci->func + 1) == nargs) /* no function? */
+ return resume_error(L, "cannot resume dead coroutine", nargs);
+ }
+ else if (L->status != LUA_YIELD) /* ended with errors? */
+ return resume_error(L, "cannot resume dead coroutine", nargs);
+ L->nCcalls = (from) ? getCcalls(from) : 0;
+ if (getCcalls(L) >= LUAI_MAXCCALLS)
+ return resume_error(L, "C stack overflow", nargs);
+ L->nCcalls++;
+ luai_userstateresume(L, nargs);
+ api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
+ status = luaD_rawrunprotected(L, resume, &nargs);
+ /* continue running after recoverable errors */
+ status = precover(L, status);
+ if (l_likely(!errorstatus(status)))
+ lua_assert(status == L->status); /* normal end or yield */
+ else { /* unrecoverable error */
+ L->status = cast_byte(status); /* mark thread as 'dead' */
+ luaD_seterrorobj(L, status, L->top); /* push error message */
+ L->ci->top = L->top;
+ }
+ *nresults = (status == LUA_YIELD) ? L->ci->u2.nyield
+ : cast_int(L->top - (L->ci->func + 1));
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_isyieldable (lua_State *L) {
+ return yieldable(L);
+}
+
+
+LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx,
+ lua_KFunction k) {
+ CallInfo *ci;
+ luai_userstateyield(L, nresults);
+ lua_lock(L);
+ ci = L->ci;
+ api_checknelems(L, nresults);
+ if (l_unlikely(!yieldable(L))) {
+ if (L != G(L)->mainthread)
+ luaG_runerror(L, "attempt to yield across a C-call boundary");
+ else
+ luaG_runerror(L, "attempt to yield from outside a coroutine");
+ }
+ L->status = LUA_YIELD;
+ ci->u2.nyield = nresults; /* save number of results */
+ if (isLua(ci)) { /* inside a hook? */
+ lua_assert(!isLuacode(ci));
+ api_check(L, nresults == 0, "hooks cannot yield values");
+ api_check(L, k == NULL, "hooks cannot continue after yielding");
+ }
+ else {
+ if ((ci->u.c.k = k) != NULL) /* is there a continuation? */
+ ci->u.c.ctx = ctx; /* save context */
+ luaD_throw(L, LUA_YIELD);
+ }
+ lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */
+ lua_unlock(L);
+ return 0; /* return to 'luaD_hook' */
+}
+
+
+/*
+** Auxiliary structure to call 'luaF_close' in protected mode.
+*/
+struct CloseP {
+ StkId level;
+ int status;
+};
+
+
+/*
+** Auxiliary function to call 'luaF_close' in protected mode.
+*/
+static void closepaux (lua_State *L, void *ud) {
+ struct CloseP *pcl = cast(struct CloseP *, ud);
+ luaF_close(L, pcl->level, pcl->status, 0);
+}
+
+
+/*
+** Calls 'luaF_close' in protected mode. Return the original status
+** or, in case of errors, the new status.
+*/
+int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status) {
+ CallInfo *old_ci = L->ci;
+ lu_byte old_allowhooks = L->allowhook;
+ for (;;) { /* keep closing upvalues until no more errors */
+ struct CloseP pcl;
+ pcl.level = restorestack(L, level); pcl.status = status;
+ status = luaD_rawrunprotected(L, &closepaux, &pcl);
+ if (l_likely(status == LUA_OK)) /* no more errors? */
+ return pcl.status;
+ else { /* an error occurred; restore saved state and repeat */
+ L->ci = old_ci;
+ L->allowhook = old_allowhooks;
+ }
+ }
+}
+
+
+/*
+** Call the C function 'func' in protected mode, restoring basic
+** thread information ('allowhook', etc.) and in particular
+** its stack level in case of errors.
+*/
+int luaD_pcall (lua_State *L, Pfunc func, void *u,
+ ptrdiff_t old_top, ptrdiff_t ef) {
+ int status;
+ CallInfo *old_ci = L->ci;
+ lu_byte old_allowhooks = L->allowhook;
+ ptrdiff_t old_errfunc = L->errfunc;
+ L->errfunc = ef;
+ status = luaD_rawrunprotected(L, func, u);
+ if (l_unlikely(status != LUA_OK)) { /* an error occurred? */
+ L->ci = old_ci;
+ L->allowhook = old_allowhooks;
+ status = luaD_closeprotected(L, old_top, status);
+ luaD_seterrorobj(L, status, restorestack(L, old_top));
+ luaD_shrinkstack(L); /* restore stack size in case of overflow */
+ }
+ L->errfunc = old_errfunc;
+ return status;
+}
+
+
+
+/*
+** Execute a protected parser.
+*/
+struct SParser { /* data to 'f_parser' */
+ ZIO *z;
+ Mbuffer buff; /* dynamic structure used by the scanner */
+ Dyndata dyd; /* dynamic structures used by the parser */
+ const char *mode;
+ const char *name;
+};
+
+
+static void checkmode (lua_State *L, const char *mode, const char *x) {
+ if (mode && strchr(mode, x[0]) == NULL) {
+ luaO_pushfstring(L,
+ "attempt to load a %s chunk (mode is '%s')", x, mode);
+ luaD_throw(L, LUA_ERRSYNTAX);
+ }
+}
+
+
+static void f_parser (lua_State *L, void *ud) {
+ LClosure *cl;
+ struct SParser *p = cast(struct SParser *, ud);
+ int c = zgetc(p->z); /* read first character */
+ if (c == LUA_SIGNATURE[0]) {
+ checkmode(L, p->mode, "binary");
+ cl = luaU_undump(L, p->z, p->name);
+ }
+ else {
+ checkmode(L, p->mode, "text");
+ cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c);
+ }
+ lua_assert(cl->nupvalues == cl->p->sizeupvalues);
+ luaF_initupvals(L, cl);
+}
+
+
+int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
+ const char *mode) {
+ struct SParser p;
+ int status;
+ incnny(L); /* cannot yield during parsing */
+ p.z = z; p.name = name; p.mode = mode;
+ p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0;
+ p.dyd.gt.arr = NULL; p.dyd.gt.size = 0;
+ p.dyd.label.arr = NULL; p.dyd.label.size = 0;
+ luaZ_initbuffer(L, &p.buff);
+ status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc);
+ luaZ_freebuffer(L, &p.buff);
+ luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size);
+ luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size);
+ luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size);
+ decnny(L);
+ return status;
+}
+
+
diff --git a/source/luametatex/source/luacore/lua54/src/ldo.h b/source/luametatex/source/luacore/lua54/src/ldo.h
new file mode 100644
index 000000000..4661aa007
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ldo.h
@@ -0,0 +1,87 @@
+/*
+** $Id: ldo.h $
+** Stack and Call structure of Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ldo_h
+#define ldo_h
+
+
+#include "lobject.h"
+#include "lstate.h"
+#include "lzio.h"
+
+
+/*
+** Macro to check stack size and grow stack if needed. Parameters
+** 'pre'/'pos' allow the macro to preserve a pointer into the
+** stack across reallocations, doing the work only when needed.
+** It also allows the running of one GC step when the stack is
+** reallocated.
+** 'condmovestack' is used in heavy tests to force a stack reallocation
+** at every check.
+*/
+#define luaD_checkstackaux(L,n,pre,pos) \
+ if (l_unlikely(L->stack_last - L->top <= (n))) \
+ { pre; luaD_growstack(L, n, 1); pos; } \
+ else { condmovestack(L,pre,pos); }
+
+/* In general, 'pre'/'pos' are empty (nothing to save) */
+#define luaD_checkstack(L,n) luaD_checkstackaux(L,n,(void)0,(void)0)
+
+
+
+#define savestack(L,p) ((char *)(p) - (char *)L->stack)
+#define restorestack(L,n) ((StkId)((char *)L->stack + (n)))
+
+
+/* macro to check stack size, preserving 'p' */
+#define checkstackp(L,n,p) \
+ luaD_checkstackaux(L, n, \
+ ptrdiff_t t__ = savestack(L, p), /* save 'p' */ \
+ p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
+
+
+/* macro to check stack size and GC, preserving 'p' */
+#define checkstackGCp(L,n,p) \
+ luaD_checkstackaux(L, n, \
+ ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \
+ luaC_checkGC(L), /* stack grow uses memory */ \
+ p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
+
+
+/* macro to check stack size and GC */
+#define checkstackGC(L,fsize) \
+ luaD_checkstackaux(L, (fsize), luaC_checkGC(L), (void)0)
+
+
+/* type of protected functions, to be ran by 'runprotected' */
+typedef void (*Pfunc) (lua_State *L, void *ud);
+
+LUAI_FUNC void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop);
+LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
+ const char *mode);
+LUAI_FUNC void luaD_hook (lua_State *L, int event, int line,
+ int fTransfer, int nTransfer);
+LUAI_FUNC void luaD_hookcall (lua_State *L, CallInfo *ci);
+LUAI_FUNC int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func,
+ int narg1, int delta);
+LUAI_FUNC CallInfo *luaD_precall (lua_State *L, StkId func, int nResults);
+LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
+LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults);
+LUAI_FUNC StkId luaD_tryfuncTM (lua_State *L, StkId func);
+LUAI_FUNC int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status);
+LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,
+ ptrdiff_t oldtop, ptrdiff_t ef);
+LUAI_FUNC void luaD_poscall (lua_State *L, CallInfo *ci, int nres);
+LUAI_FUNC int luaD_reallocstack (lua_State *L, int newsize, int raiseerror);
+LUAI_FUNC int luaD_growstack (lua_State *L, int n, int raiseerror);
+LUAI_FUNC void luaD_shrinkstack (lua_State *L);
+LUAI_FUNC void luaD_inctop (lua_State *L);
+
+LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode);
+LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/ldump.c b/source/luametatex/source/luacore/lua54/src/ldump.c
new file mode 100644
index 000000000..f848b669c
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ldump.c
@@ -0,0 +1,226 @@
+/*
+** $Id: ldump.c $
+** save precompiled Lua chunks
+** See Copyright Notice in lua.h
+*/
+
+#define ldump_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <stddef.h>
+
+#include "lua.h"
+
+#include "lobject.h"
+#include "lstate.h"
+#include "lundump.h"
+
+
+typedef struct {
+ lua_State *L;
+ lua_Writer writer;
+ void *data;
+ int strip;
+ int status;
+} DumpState;
+
+
+/*
+** All high-level dumps go through dumpVector; you can change it to
+** change the endianness of the result
+*/
+#define dumpVector(D,v,n) dumpBlock(D,v,(n)*sizeof((v)[0]))
+
+#define dumpLiteral(D, s) dumpBlock(D,s,sizeof(s) - sizeof(char))
+
+
+static void dumpBlock (DumpState *D, const void *b, size_t size) {
+ if (D->status == 0 && size > 0) {
+ lua_unlock(D->L);
+ D->status = (*D->writer)(D->L, b, size, D->data);
+ lua_lock(D->L);
+ }
+}
+
+
+#define dumpVar(D,x) dumpVector(D,&x,1)
+
+
+static void dumpByte (DumpState *D, int y) {
+ lu_byte x = (lu_byte)y;
+ dumpVar(D, x);
+}
+
+
+/* dumpInt Buff Size */
+#define DIBS ((sizeof(size_t) * 8 / 7) + 1)
+
+static void dumpSize (DumpState *D, size_t x) {
+ lu_byte buff[DIBS];
+ int n = 0;
+ do {
+ buff[DIBS - (++n)] = x & 0x7f; /* fill buffer in reverse order */
+ x >>= 7;
+ } while (x != 0);
+ buff[DIBS - 1] |= 0x80; /* mark last byte */
+ dumpVector(D, buff + DIBS - n, n);
+}
+
+
+static void dumpInt (DumpState *D, int x) {
+ dumpSize(D, x);
+}
+
+
+static void dumpNumber (DumpState *D, lua_Number x) {
+ dumpVar(D, x);
+}
+
+
+static void dumpInteger (DumpState *D, lua_Integer x) {
+ dumpVar(D, x);
+}
+
+
+static void dumpString (DumpState *D, const TString *s) {
+ if (s == NULL)
+ dumpSize(D, 0);
+ else {
+ size_t size = tsslen(s);
+ const char *str = getstr(s);
+ dumpSize(D, size + 1);
+ dumpVector(D, str, size);
+ }
+}
+
+
+static void dumpCode (DumpState *D, const Proto *f) {
+ dumpInt(D, f->sizecode);
+ dumpVector(D, f->code, f->sizecode);
+}
+
+
+static void dumpFunction(DumpState *D, const Proto *f, TString *psource);
+
+static void dumpConstants (DumpState *D, const Proto *f) {
+ int i;
+ int n = f->sizek;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++) {
+ const TValue *o = &f->k[i];
+ int tt = ttypetag(o);
+ dumpByte(D, tt);
+ switch (tt) {
+ case LUA_VNUMFLT:
+ dumpNumber(D, fltvalue(o));
+ break;
+ case LUA_VNUMINT:
+ dumpInteger(D, ivalue(o));
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ dumpString(D, tsvalue(o));
+ break;
+ default:
+ lua_assert(tt == LUA_VNIL || tt == LUA_VFALSE || tt == LUA_VTRUE);
+ }
+ }
+}
+
+
+static void dumpProtos (DumpState *D, const Proto *f) {
+ int i;
+ int n = f->sizep;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++)
+ dumpFunction(D, f->p[i], f->source);
+}
+
+
+static void dumpUpvalues (DumpState *D, const Proto *f) {
+ int i, n = f->sizeupvalues;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++) {
+ dumpByte(D, f->upvalues[i].instack);
+ dumpByte(D, f->upvalues[i].idx);
+ dumpByte(D, f->upvalues[i].kind);
+ }
+}
+
+
+static void dumpDebug (DumpState *D, const Proto *f) {
+ int i, n;
+ n = (D->strip) ? 0 : f->sizelineinfo;
+ dumpInt(D, n);
+ dumpVector(D, f->lineinfo, n);
+ n = (D->strip) ? 0 : f->sizeabslineinfo;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++) {
+ dumpInt(D, f->abslineinfo[i].pc);
+ dumpInt(D, f->abslineinfo[i].line);
+ }
+ n = (D->strip) ? 0 : f->sizelocvars;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++) {
+ dumpString(D, f->locvars[i].varname);
+ dumpInt(D, f->locvars[i].startpc);
+ dumpInt(D, f->locvars[i].endpc);
+ }
+ n = (D->strip) ? 0 : f->sizeupvalues;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++)
+ dumpString(D, f->upvalues[i].name);
+}
+
+
+static void dumpFunction (DumpState *D, const Proto *f, TString *psource) {
+ if (D->strip || f->source == psource)
+ dumpString(D, NULL); /* no debug info or same source as its parent */
+ else
+ dumpString(D, f->source);
+ dumpInt(D, f->linedefined);
+ dumpInt(D, f->lastlinedefined);
+ dumpByte(D, f->numparams);
+ dumpByte(D, f->is_vararg);
+ dumpByte(D, f->maxstacksize);
+ dumpCode(D, f);
+ dumpConstants(D, f);
+ dumpUpvalues(D, f);
+ dumpProtos(D, f);
+ dumpDebug(D, f);
+}
+
+
+static void dumpHeader (DumpState *D) {
+ dumpLiteral(D, LUA_SIGNATURE);
+ dumpByte(D, LUAC_VERSION);
+ dumpByte(D, LUAC_FORMAT);
+ dumpLiteral(D, LUAC_DATA);
+ dumpByte(D, sizeof(Instruction));
+ dumpByte(D, sizeof(lua_Integer));
+ dumpByte(D, sizeof(lua_Number));
+ dumpInteger(D, LUAC_INT);
+ dumpNumber(D, LUAC_NUM);
+}
+
+
+/*
+** dump Lua function as precompiled chunk
+*/
+int luaU_dump(lua_State *L, const Proto *f, lua_Writer w, void *data,
+ int strip) {
+ DumpState D;
+ D.L = L;
+ D.writer = w;
+ D.data = data;
+ D.strip = strip;
+ D.status = 0;
+ dumpHeader(&D);
+ dumpByte(&D, f->sizeupvalues);
+ dumpFunction(&D, f, NULL);
+ return D.status;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lfunc.c b/source/luametatex/source/luacore/lua54/src/lfunc.c
new file mode 100644
index 000000000..daba0abf5
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lfunc.c
@@ -0,0 +1,295 @@
+/*
+** $Id: lfunc.c $
+** Auxiliary functions to manipulate prototypes and closures
+** See Copyright Notice in lua.h
+*/
+
+#define lfunc_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <stddef.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+
+
+
+CClosure *luaF_newCclosure (lua_State *L, int nupvals) {
+ GCObject *o = luaC_newobj(L, LUA_VCCL, sizeCclosure(nupvals));
+ CClosure *c = gco2ccl(o);
+ c->nupvalues = cast_byte(nupvals);
+ return c;
+}
+
+
+LClosure *luaF_newLclosure (lua_State *L, int nupvals) {
+ GCObject *o = luaC_newobj(L, LUA_VLCL, sizeLclosure(nupvals));
+ LClosure *c = gco2lcl(o);
+ c->p = NULL;
+ c->nupvalues = cast_byte(nupvals);
+ while (nupvals--) c->upvals[nupvals] = NULL;
+ return c;
+}
+
+
+/*
+** fill a closure with new closed upvalues
+*/
+void luaF_initupvals (lua_State *L, LClosure *cl) {
+ int i;
+ for (i = 0; i < cl->nupvalues; i++) {
+ GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
+ UpVal *uv = gco2upv(o);
+ uv->v = &uv->u.value; /* make it closed */
+ setnilvalue(uv->v);
+ cl->upvals[i] = uv;
+ luaC_objbarrier(L, cl, uv);
+ }
+}
+
+
+/*
+** Create a new upvalue at the given level, and link it to the list of
+** open upvalues of 'L' after entry 'prev'.
+**/
+static UpVal *newupval (lua_State *L, int tbc, StkId level, UpVal **prev) {
+ GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
+ UpVal *uv = gco2upv(o);
+ UpVal *next = *prev;
+ uv->v = s2v(level); /* current value lives in the stack */
+ uv->tbc = tbc;
+ uv->u.open.next = next; /* link it to list of open upvalues */
+ uv->u.open.previous = prev;
+ if (next)
+ next->u.open.previous = &uv->u.open.next;
+ *prev = uv;
+ if (!isintwups(L)) { /* thread not in list of threads with upvalues? */
+ L->twups = G(L)->twups; /* link it to the list */
+ G(L)->twups = L;
+ }
+ return uv;
+}
+
+
+/*
+** Find and reuse, or create if it does not exist, an upvalue
+** at the given level.
+*/
+UpVal *luaF_findupval (lua_State *L, StkId level) {
+ UpVal **pp = &L->openupval;
+ UpVal *p;
+ lua_assert(isintwups(L) || L->openupval == NULL);
+ while ((p = *pp) != NULL && uplevel(p) >= level) { /* search for it */
+ lua_assert(!isdead(G(L), p));
+ if (uplevel(p) == level) /* corresponding upvalue? */
+ return p; /* return it */
+ pp = &p->u.open.next;
+ }
+ /* not found: create a new upvalue after 'pp' */
+ return newupval(L, 0, level, pp);
+}
+
+
+/*
+** Call closing method for object 'obj' with error message 'err'. The
+** boolean 'yy' controls whether the call is yieldable.
+** (This function assumes EXTRA_STACK.)
+*/
+static void callclosemethod (lua_State *L, TValue *obj, TValue *err, int yy) {
+ StkId top = L->top;
+ const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
+ setobj2s(L, top, tm); /* will call metamethod... */
+ setobj2s(L, top + 1, obj); /* with 'self' as the 1st argument */
+ setobj2s(L, top + 2, err); /* and error msg. as 2nd argument */
+ L->top = top + 3; /* add function and arguments */
+ if (yy)
+ luaD_call(L, top, 0);
+ else
+ luaD_callnoyield(L, top, 0);
+}
+
+
+/*
+** Check whether object at given level has a close metamethod and raise
+** an error if not.
+*/
+static void checkclosemth (lua_State *L, StkId level) {
+ const TValue *tm = luaT_gettmbyobj(L, s2v(level), TM_CLOSE);
+ if (ttisnil(tm)) { /* no metamethod? */
+ int idx = cast_int(level - L->ci->func); /* variable index */
+ const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
+ if (vname == NULL) vname = "?";
+ luaG_runerror(L, "variable '%s' got a non-closable value", vname);
+ }
+}
+
+
+/*
+** Prepare and call a closing method.
+** If status is CLOSEKTOP, the call to the closing method will be pushed
+** at the top of the stack. Otherwise, values can be pushed right after
+** the 'level' of the upvalue being closed, as everything after that
+** won't be used again.
+*/
+static void prepcallclosemth (lua_State *L, StkId level, int status, int yy) {
+ TValue *uv = s2v(level); /* value being closed */
+ TValue *errobj;
+ if (status == CLOSEKTOP)
+ errobj = &G(L)->nilvalue; /* error object is nil */
+ else { /* 'luaD_seterrorobj' will set top to level + 2 */
+ errobj = s2v(level + 1); /* error object goes after 'uv' */
+ luaD_seterrorobj(L, status, level + 1); /* set error object */
+ }
+ callclosemethod(L, uv, errobj, yy);
+}
+
+
+/*
+** Maximum value for deltas in 'tbclist', dependent on the type
+** of delta. (This macro assumes that an 'L' is in scope where it
+** is used.)
+*/
+#define MAXDELTA \
+ ((256ul << ((sizeof(L->stack->tbclist.delta) - 1) * 8)) - 1)
+
+
+/*
+** Insert a variable in the list of to-be-closed variables.
+*/
+void luaF_newtbcupval (lua_State *L, StkId level) {
+ lua_assert(level > L->tbclist);
+ if (l_isfalse(s2v(level)))
+ return; /* false doesn't need to be closed */
+ checkclosemth(L, level); /* value must have a close method */
+ while (cast_uint(level - L->tbclist) > MAXDELTA) {
+ L->tbclist += MAXDELTA; /* create a dummy node at maximum delta */
+ L->tbclist->tbclist.delta = 0;
+ }
+ level->tbclist.delta = cast(unsigned short, level - L->tbclist);
+ L->tbclist = level;
+}
+
+
+void luaF_unlinkupval (UpVal *uv) {
+ lua_assert(upisopen(uv));
+ *uv->u.open.previous = uv->u.open.next;
+ if (uv->u.open.next)
+ uv->u.open.next->u.open.previous = uv->u.open.previous;
+}
+
+
+/*
+** Close all upvalues up to the given stack level.
+*/
+void luaF_closeupval (lua_State *L, StkId level) {
+ UpVal *uv;
+ StkId upl; /* stack index pointed by 'uv' */
+ while ((uv = L->openupval) != NULL && (upl = uplevel(uv)) >= level) {
+ TValue *slot = &uv->u.value; /* new position for value */
+ lua_assert(uplevel(uv) < L->top);
+ luaF_unlinkupval(uv); /* remove upvalue from 'openupval' list */
+ setobj(L, slot, uv->v); /* move value to upvalue slot */
+ uv->v = slot; /* now current value lives here */
+ if (!iswhite(uv)) { /* neither white nor dead? */
+ nw2black(uv); /* closed upvalues cannot be gray */
+ luaC_barrier(L, uv, slot);
+ }
+ }
+}
+
+
+/*
+** Remove first element from the tbclist plus its dummy nodes.
+*/
+static void poptbclist (lua_State *L) {
+ StkId tbc = L->tbclist;
+ lua_assert(tbc->tbclist.delta > 0); /* first element cannot be dummy */
+ tbc -= tbc->tbclist.delta;
+ while (tbc > L->stack && tbc->tbclist.delta == 0)
+ tbc -= MAXDELTA; /* remove dummy nodes */
+ L->tbclist = tbc;
+}
+
+
+/*
+** Close all upvalues and to-be-closed variables up to the given stack
+** level. Return restored 'level'.
+*/
+StkId luaF_close (lua_State *L, StkId level, int status, int yy) {
+ ptrdiff_t levelrel = savestack(L, level);
+ luaF_closeupval(L, level); /* first, close the upvalues */
+ while (L->tbclist >= level) { /* traverse tbc's down to that level */
+ StkId tbc = L->tbclist; /* get variable index */
+ poptbclist(L); /* remove it from list */
+ prepcallclosemth(L, tbc, status, yy); /* close variable */
+ level = restorestack(L, levelrel);
+ }
+ return level;
+}
+
+
+Proto *luaF_newproto (lua_State *L) {
+ GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
+ Proto *f = gco2p(o);
+ f->k = NULL;
+ f->sizek = 0;
+ f->p = NULL;
+ f->sizep = 0;
+ f->code = NULL;
+ f->sizecode = 0;
+ f->lineinfo = NULL;
+ f->sizelineinfo = 0;
+ f->abslineinfo = NULL;
+ f->sizeabslineinfo = 0;
+ f->upvalues = NULL;
+ f->sizeupvalues = 0;
+ f->numparams = 0;
+ f->is_vararg = 0;
+ f->maxstacksize = 0;
+ f->locvars = NULL;
+ f->sizelocvars = 0;
+ f->linedefined = 0;
+ f->lastlinedefined = 0;
+ f->source = NULL;
+ return f;
+}
+
+
+void luaF_freeproto (lua_State *L, Proto *f) {
+ luaM_freearray(L, f->code, f->sizecode);
+ luaM_freearray(L, f->p, f->sizep);
+ luaM_freearray(L, f->k, f->sizek);
+ luaM_freearray(L, f->lineinfo, f->sizelineinfo);
+ luaM_freearray(L, f->abslineinfo, f->sizeabslineinfo);
+ luaM_freearray(L, f->locvars, f->sizelocvars);
+ luaM_freearray(L, f->upvalues, f->sizeupvalues);
+ luaM_free(L, f);
+}
+
+
+/*
+** Look for n-th local variable at line 'line' in function 'func'.
+** Returns NULL if not found.
+*/
+const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
+ int i;
+ for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
+ if (pc < f->locvars[i].endpc) { /* is variable active? */
+ local_number--;
+ if (local_number == 0)
+ return getstr(f->locvars[i].varname);
+ }
+ }
+ return NULL; /* not found */
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lfunc.h b/source/luametatex/source/luacore/lua54/src/lfunc.h
new file mode 100644
index 000000000..3d296971e
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lfunc.h
@@ -0,0 +1,64 @@
+/*
+** $Id: lfunc.h $
+** Auxiliary functions to manipulate prototypes and closures
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lfunc_h
+#define lfunc_h
+
+
+#include "lobject.h"
+
+
+#define sizeCclosure(n) (cast_int(offsetof(CClosure, upvalue)) + \
+ cast_int(sizeof(TValue)) * (n))
+
+#define sizeLclosure(n) (cast_int(offsetof(LClosure, upvals)) + \
+ cast_int(sizeof(TValue *)) * (n))
+
+
+/* test whether thread is in 'twups' list */
+#define isintwups(L) (L->twups != L)
+
+
+/*
+** maximum number of upvalues in a closure (both C and Lua). (Value
+** must fit in a VM register.)
+*/
+#define MAXUPVAL 255
+
+
+#define upisopen(up) ((up)->v != &(up)->u.value)
+
+
+#define uplevel(up) check_exp(upisopen(up), cast(StkId, (up)->v))
+
+
+/*
+** maximum number of misses before giving up the cache of closures
+** in prototypes
+*/
+#define MAXMISS 10
+
+
+
+/* special status to close upvalues preserving the top of the stack */
+#define CLOSEKTOP (-1)
+
+
+LUAI_FUNC Proto *luaF_newproto (lua_State *L);
+LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nupvals);
+LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nupvals);
+LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl);
+LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
+LUAI_FUNC void luaF_newtbcupval (lua_State *L, StkId level);
+LUAI_FUNC void luaF_closeupval (lua_State *L, StkId level);
+LUAI_FUNC StkId luaF_close (lua_State *L, StkId level, int status, int yy);
+LUAI_FUNC void luaF_unlinkupval (UpVal *uv);
+LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
+LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
+ int pc);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lgc.c b/source/luametatex/source/luacore/lua54/src/lgc.c
new file mode 100644
index 000000000..317ea4508
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lgc.c
@@ -0,0 +1,1730 @@
+/*
+** $Id: lgc.c $
+** Garbage Collector
+** See Copyright Notice in lua.h
+*/
+
+#define lgc_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+#include <stdio.h>
+#include <string.h>
+
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+
+
+/*
+** Maximum number of elements to sweep in each single step.
+** (Large enough to dissipate fixed overheads but small enough
+** to allow small steps for the collector.)
+*/
+#define GCSWEEPMAX 100
+
+/*
+** Maximum number of finalizers to call in each single step.
+*/
+#define GCFINMAX 10
+
+
+/*
+** Cost of calling one finalizer.
+*/
+#define GCFINALIZECOST 50
+
+
+/*
+** The equivalent, in bytes, of one unit of "work" (visiting a slot,
+** sweeping an object, etc.)
+*/
+#define WORK2MEM sizeof(TValue)
+
+
+/*
+** macro to adjust 'pause': 'pause' is actually used like
+** 'pause / PAUSEADJ' (value chosen by tests)
+*/
+#define PAUSEADJ 100
+
+
+/* mask with all color bits */
+#define maskcolors (bitmask(BLACKBIT) | WHITEBITS)
+
+/* mask with all GC bits */
+#define maskgcbits (maskcolors | AGEBITS)
+
+
+/* macro to erase all color bits then set only the current white bit */
+#define makewhite(g,x) \
+ (x->marked = cast_byte((x->marked & ~maskcolors) | luaC_white(g)))
+
+/* make an object gray (neither white nor black) */
+#define set2gray(x) resetbits(x->marked, maskcolors)
+
+
+/* make an object black (coming from any color) */
+#define set2black(x) \
+ (x->marked = cast_byte((x->marked & ~WHITEBITS) | bitmask(BLACKBIT)))
+
+
+#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
+
+#define keyiswhite(n) (keyiscollectable(n) && iswhite(gckey(n)))
+
+
+/*
+** Protected access to objects in values
+*/
+#define gcvalueN(o) (iscollectable(o) ? gcvalue(o) : NULL)
+
+
+#define markvalue(g,o) { checkliveness(g->mainthread,o); \
+ if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
+
+#define markkey(g, n) { if keyiswhite(n) reallymarkobject(g,gckey(n)); }
+
+#define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); }
+
+/*
+** mark an object that can be NULL (either because it is really optional,
+** or it was stripped as debug info, or inside an uncompleted structure)
+*/
+#define markobjectN(g,t) { if (t) markobject(g,t); }
+
+static void reallymarkobject (global_State *g, GCObject *o);
+static lu_mem atomic (lua_State *L);
+static void entersweep (lua_State *L);
+
+
+/*
+** {======================================================
+** Generic functions
+** =======================================================
+*/
+
+
+/*
+** one after last element in a hash array
+*/
+#define gnodelast(h) gnode(h, cast_sizet(sizenode(h)))
+
+
+static GCObject **getgclist (GCObject *o) {
+ switch (o->tt) {
+ case LUA_VTABLE: return &gco2t(o)->gclist;
+ case LUA_VLCL: return &gco2lcl(o)->gclist;
+ case LUA_VCCL: return &gco2ccl(o)->gclist;
+ case LUA_VTHREAD: return &gco2th(o)->gclist;
+ case LUA_VPROTO: return &gco2p(o)->gclist;
+ case LUA_VUSERDATA: {
+ Udata *u = gco2u(o);
+ lua_assert(u->nuvalue > 0);
+ return &u->gclist;
+ }
+ default: lua_assert(0); return 0;
+ }
+}
+
+
+/*
+** Link a collectable object 'o' with a known type into the list 'p'.
+** (Must be a macro to access the 'gclist' field in different types.)
+*/
+#define linkgclist(o,p) linkgclist_(obj2gco(o), &(o)->gclist, &(p))
+
+static void linkgclist_ (GCObject *o, GCObject **pnext, GCObject **list) {
+ lua_assert(!isgray(o)); /* cannot be in a gray list */
+ *pnext = *list;
+ *list = o;
+ set2gray(o); /* now it is */
+}
+
+
+/*
+** Link a generic collectable object 'o' into the list 'p'.
+*/
+#define linkobjgclist(o,p) linkgclist_(obj2gco(o), getgclist(o), &(p))
+
+
+
+/*
+** Clear keys for empty entries in tables. If entry is empty, mark its
+** entry as dead. This allows the collection of the key, but keeps its
+** entry in the table: its removal could break a chain and could break
+** a table traversal. Other places never manipulate dead keys, because
+** its associated empty value is enough to signal that the entry is
+** logically empty.
+*/
+static void clearkey (Node *n) {
+ lua_assert(isempty(gval(n)));
+ if (keyiscollectable(n))
+ setdeadkey(n); /* unused key; remove it */
+}
+
+
+/*
+** tells whether a key or value can be cleared from a weak
+** table. Non-collectable objects are never removed from weak
+** tables. Strings behave as 'values', so are never removed too. for
+** other objects: if really collected, cannot keep them; for objects
+** being finalized, keep them in keys, but not in values
+*/
+static int iscleared (global_State *g, const GCObject *o) {
+ if (o == NULL) return 0; /* non-collectable value */
+ else if (novariant(o->tt) == LUA_TSTRING) {
+ markobject(g, o); /* strings are 'values', so are never weak */
+ return 0;
+ }
+ else return iswhite(o);
+}
+
+
+/*
+** Barrier that moves collector forward, that is, marks the white object
+** 'v' being pointed by the black object 'o'. In the generational
+** mode, 'v' must also become old, if 'o' is old; however, it cannot
+** be changed directly to OLD, because it may still point to non-old
+** objects. So, it is marked as OLD0. In the next cycle it will become
+** OLD1, and in the next it will finally become OLD (regular old). By
+** then, any object it points to will also be old. If called in the
+** incremental sweep phase, it clears the black object to white (sweep
+** it) to avoid other barrier calls for this same object. (That cannot
+** be done is generational mode, as its sweep does not distinguish
+** whites from deads.)
+*/
+void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
+ global_State *g = G(L);
+ lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
+ if (keepinvariant(g)) { /* must keep invariant? */
+ reallymarkobject(g, v); /* restore invariant */
+ if (isold(o)) {
+ lua_assert(!isold(v)); /* white object could not be old */
+ setage(v, G_OLD0); /* restore generational invariant */
+ }
+ }
+ else { /* sweep phase */
+ lua_assert(issweepphase(g));
+ if (g->gckind == KGC_INC) /* incremental mode? */
+ makewhite(g, o); /* mark 'o' as white to avoid other barriers */
+ }
+}
+
+
+/*
+** barrier that moves collector backward, that is, mark the black object
+** pointing to a white object as gray again.
+*/
+void luaC_barrierback_ (lua_State *L, GCObject *o) {
+ global_State *g = G(L);
+ lua_assert(isblack(o) && !isdead(g, o));
+ lua_assert((g->gckind == KGC_GEN) == (isold(o) && getage(o) != G_TOUCHED1));
+ if (getage(o) == G_TOUCHED2) /* already in gray list? */
+ set2gray(o); /* make it gray to become touched1 */
+ else /* link it in 'grayagain' and paint it gray */
+ linkobjgclist(o, g->grayagain);
+ if (isold(o)) /* generational mode? */
+ setage(o, G_TOUCHED1); /* touched in current cycle */
+}
+
+
+void luaC_fix (lua_State *L, GCObject *o) {
+ global_State *g = G(L);
+ lua_assert(g->allgc == o); /* object must be 1st in 'allgc' list! */
+ set2gray(o); /* they will be gray forever */
+ setage(o, G_OLD); /* and old forever */
+ g->allgc = o->next; /* remove object from 'allgc' list */
+ o->next = g->fixedgc; /* link it to 'fixedgc' list */
+ g->fixedgc = o;
+}
+
+
+/*
+** create a new collectable object (with given type and size) and link
+** it to 'allgc' list.
+*/
+GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) {
+ global_State *g = G(L);
+ GCObject *o = cast(GCObject *, luaM_newobject(L, novariant(tt), sz));
+ o->marked = luaC_white(g);
+ o->tt = tt;
+ o->next = g->allgc;
+ g->allgc = o;
+ return o;
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** Mark functions
+** =======================================================
+*/
+
+
+/*
+** Mark an object. Userdata with no user values, strings, and closed
+** upvalues are visited and turned black here. Open upvalues are
+** already indirectly linked through their respective threads in the
+** 'twups' list, so they don't go to the gray list; nevertheless, they
+** are kept gray to avoid barriers, as their values will be revisited
+** by the thread or by 'remarkupvals'. Other objects are added to the
+** gray list to be visited (and turned black) later. Both userdata and
+** upvalues can call this function recursively, but this recursion goes
+** for at most two levels: An upvalue cannot refer to another upvalue
+** (only closures can), and a userdata's metatable must be a table.
+*/
+static void reallymarkobject (global_State *g, GCObject *o) {
+ switch (o->tt) {
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR: {
+ set2black(o); /* nothing to visit */
+ break;
+ }
+ case LUA_VUPVAL: {
+ UpVal *uv = gco2upv(o);
+ if (upisopen(uv))
+ set2gray(uv); /* open upvalues are kept gray */
+ else
+ set2black(uv); /* closed upvalues are visited here */
+ markvalue(g, uv->v); /* mark its content */
+ break;
+ }
+ case LUA_VUSERDATA: {
+ Udata *u = gco2u(o);
+ if (u->nuvalue == 0) { /* no user values? */
+ markobjectN(g, u->metatable); /* mark its metatable */
+ set2black(u); /* nothing else to mark */
+ break;
+ }
+ /* else... */
+ } /* FALLTHROUGH */
+ case LUA_VLCL: case LUA_VCCL: case LUA_VTABLE:
+ case LUA_VTHREAD: case LUA_VPROTO: {
+ linkobjgclist(o, g->gray); /* to be visited later */
+ break;
+ }
+ default: lua_assert(0); break;
+ }
+}
+
+
+/*
+** mark metamethods for basic types
+*/
+static void markmt (global_State *g) {
+ int i;
+ for (i=0; i < LUA_NUMTAGS; i++)
+ markobjectN(g, g->mt[i]);
+}
+
+
+/*
+** mark all objects in list of being-finalized
+*/
+static lu_mem markbeingfnz (global_State *g) {
+ GCObject *o;
+ lu_mem count = 0;
+ for (o = g->tobefnz; o != NULL; o = o->next) {
+ count++;
+ markobject(g, o);
+ }
+ return count;
+}
+
+
+/*
+** For each non-marked thread, simulates a barrier between each open
+** upvalue and its value. (If the thread is collected, the value will be
+** assigned to the upvalue, but then it can be too late for the barrier
+** to act. The "barrier" does not need to check colors: A non-marked
+** thread must be young; upvalues cannot be older than their threads; so
+** any visited upvalue must be young too.) Also removes the thread from
+** the list, as it was already visited. Removes also threads with no
+** upvalues, as they have nothing to be checked. (If the thread gets an
+** upvalue later, it will be linked in the list again.)
+*/
+static int remarkupvals (global_State *g) {
+ lua_State *thread;
+ lua_State **p = &g->twups;
+ int work = 0; /* estimate of how much work was done here */
+ while ((thread = *p) != NULL) {
+ work++;
+ if (!iswhite(thread) && thread->openupval != NULL)
+ p = &thread->twups; /* keep marked thread with upvalues in the list */
+ else { /* thread is not marked or without upvalues */
+ UpVal *uv;
+ lua_assert(!isold(thread) || thread->openupval == NULL);
+ *p = thread->twups; /* remove thread from the list */
+ thread->twups = thread; /* mark that it is out of list */
+ for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {
+ lua_assert(getage(uv) <= getage(thread));
+ work++;
+ if (!iswhite(uv)) { /* upvalue already visited? */
+ lua_assert(upisopen(uv) && isgray(uv));
+ markvalue(g, uv->v); /* mark its value */
+ }
+ }
+ }
+ }
+ return work;
+}
+
+
+static void cleargraylists (global_State *g) {
+ g->gray = g->grayagain = NULL;
+ g->weak = g->allweak = g->ephemeron = NULL;
+}
+
+
+/*
+** mark root set and reset all gray lists, to start a new collection
+*/
+static void restartcollection (global_State *g) {
+ cleargraylists(g);
+ markobject(g, g->mainthread);
+ markvalue(g, &g->l_registry);
+ markmt(g);
+ markbeingfnz(g); /* mark any finalizing object left from previous cycle */
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Traverse functions
+** =======================================================
+*/
+
+
+/*
+** Check whether object 'o' should be kept in the 'grayagain' list for
+** post-processing by 'correctgraylist'. (It could put all old objects
+** in the list and leave all the work to 'correctgraylist', but it is
+** more efficient to avoid adding elements that will be removed.) Only
+** TOUCHED1 objects need to be in the list. TOUCHED2 doesn't need to go
+** back to a gray list, but then it must become OLD. (That is what
+** 'correctgraylist' does when it finds a TOUCHED2 object.)
+*/
+static void genlink (global_State *g, GCObject *o) {
+ lua_assert(isblack(o));
+ if (getage(o) == G_TOUCHED1) { /* touched in this cycle? */
+ linkobjgclist(o, g->grayagain); /* link it back in 'grayagain' */
+ } /* everything else do not need to be linked back */
+ else if (getage(o) == G_TOUCHED2)
+ changeage(o, G_TOUCHED2, G_OLD); /* advance age */
+}
+
+
+/*
+** Traverse a table with weak values and link it to proper list. During
+** propagate phase, keep it in 'grayagain' list, to be revisited in the
+** atomic phase. In the atomic phase, if table has any white value,
+** put it in 'weak' list, to be cleared.
+*/
+static void traverseweakvalue (global_State *g, Table *h) {
+ Node *n, *limit = gnodelast(h);
+ /* if there is array part, assume it may have white values (it is not
+ worth traversing it now just to check) */
+ int hasclears = (h->alimit > 0);
+ for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
+ if (isempty(gval(n))) /* entry is empty? */
+ clearkey(n); /* clear its key */
+ else {
+ lua_assert(!keyisnil(n));
+ markkey(g, n);
+ if (!hasclears && iscleared(g, gcvalueN(gval(n)))) /* a white value? */
+ hasclears = 1; /* table will have to be cleared */
+ }
+ }
+ if (g->gcstate == GCSatomic && hasclears)
+ linkgclist(h, g->weak); /* has to be cleared later */
+ else
+ linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
+}
+
+
+/*
+** Traverse an ephemeron table and link it to proper list. Returns true
+** iff any object was marked during this traversal (which implies that
+** convergence has to continue). During propagation phase, keep table
+** in 'grayagain' list, to be visited again in the atomic phase. In
+** the atomic phase, if table has any white->white entry, it has to
+** be revisited during ephemeron convergence (as that key may turn
+** black). Otherwise, if it has any white key, table has to be cleared
+** (in the atomic phase). In generational mode, some tables
+** must be kept in some gray list for post-processing; this is done
+** by 'genlink'.
+*/
+static int traverseephemeron (global_State *g, Table *h, int inv) {
+ int marked = 0; /* true if an object is marked in this traversal */
+ int hasclears = 0; /* true if table has white keys */
+ int hasww = 0; /* true if table has entry "white-key -> white-value" */
+ unsigned int i;
+ unsigned int asize = luaH_realasize(h);
+ unsigned int nsize = sizenode(h);
+ /* traverse array part */
+ for (i = 0; i < asize; i++) {
+ if (valiswhite(&h->array[i])) {
+ marked = 1;
+ reallymarkobject(g, gcvalue(&h->array[i]));
+ }
+ }
+ /* traverse hash part; if 'inv', traverse descending
+ (see 'convergeephemerons') */
+ for (i = 0; i < nsize; i++) {
+ Node *n = inv ? gnode(h, nsize - 1 - i) : gnode(h, i);
+ if (isempty(gval(n))) /* entry is empty? */
+ clearkey(n); /* clear its key */
+ else if (iscleared(g, gckeyN(n))) { /* key is not marked (yet)? */
+ hasclears = 1; /* table must be cleared */
+ if (valiswhite(gval(n))) /* value not marked yet? */
+ hasww = 1; /* white-white entry */
+ }
+ else if (valiswhite(gval(n))) { /* value not marked yet? */
+ marked = 1;
+ reallymarkobject(g, gcvalue(gval(n))); /* mark it now */
+ }
+ }
+ /* link table into proper list */
+ if (g->gcstate == GCSpropagate)
+ linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
+ else if (hasww) /* table has white->white entries? */
+ linkgclist(h, g->ephemeron); /* have to propagate again */
+ else if (hasclears) /* table has white keys? */
+ linkgclist(h, g->allweak); /* may have to clean white keys */
+ else
+ genlink(g, obj2gco(h)); /* check whether collector still needs to see it */
+ return marked;
+}
+
+
+static void traversestrongtable (global_State *g, Table *h) {
+ Node *n, *limit = gnodelast(h);
+ unsigned int i;
+ unsigned int asize = luaH_realasize(h);
+ for (i = 0; i < asize; i++) /* traverse array part */
+ markvalue(g, &h->array[i]);
+ for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
+ if (isempty(gval(n))) /* entry is empty? */
+ clearkey(n); /* clear its key */
+ else {
+ lua_assert(!keyisnil(n));
+ markkey(g, n);
+ markvalue(g, gval(n));
+ }
+ }
+ genlink(g, obj2gco(h));
+}
+
+
+static lu_mem traversetable (global_State *g, Table *h) {
+ const char *weakkey, *weakvalue;
+ const TValue *mode = gfasttm(g, h->metatable, TM_MODE);
+ markobjectN(g, h->metatable);
+ if (mode && ttisstring(mode) && /* is there a weak mode? */
+ (cast_void(weakkey = strchr(svalue(mode), 'k')),
+ cast_void(weakvalue = strchr(svalue(mode), 'v')),
+ (weakkey || weakvalue))) { /* is really weak? */
+ if (!weakkey) /* strong keys? */
+ traverseweakvalue(g, h);
+ else if (!weakvalue) /* strong values? */
+ traverseephemeron(g, h, 0);
+ else /* all weak */
+ linkgclist(h, g->allweak); /* nothing to traverse now */
+ }
+ else /* not weak */
+ traversestrongtable(g, h);
+ return 1 + h->alimit + 2 * allocsizenode(h);
+}
+
+
+static int traverseudata (global_State *g, Udata *u) {
+ int i;
+ markobjectN(g, u->metatable); /* mark its metatable */
+ for (i = 0; i < u->nuvalue; i++)
+ markvalue(g, &u->uv[i].uv);
+ genlink(g, obj2gco(u));
+ return 1 + u->nuvalue;
+}
+
+
+/*
+** Traverse a prototype. (While a prototype is being build, its
+** arrays can be larger than needed; the extra slots are filled with
+** NULL, so the use of 'markobjectN')
+*/
+static int traverseproto (global_State *g, Proto *f) {
+ int i;
+ markobjectN(g, f->source);
+ for (i = 0; i < f->sizek; i++) /* mark literals */
+ markvalue(g, &f->k[i]);
+ for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */
+ markobjectN(g, f->upvalues[i].name);
+ for (i = 0; i < f->sizep; i++) /* mark nested protos */
+ markobjectN(g, f->p[i]);
+ for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */
+ markobjectN(g, f->locvars[i].varname);
+ return 1 + f->sizek + f->sizeupvalues + f->sizep + f->sizelocvars;
+}
+
+
+static int traverseCclosure (global_State *g, CClosure *cl) {
+ int i;
+ for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */
+ markvalue(g, &cl->upvalue[i]);
+ return 1 + cl->nupvalues;
+}
+
+/*
+** Traverse a Lua closure, marking its prototype and its upvalues.
+** (Both can be NULL while closure is being created.)
+*/
+static int traverseLclosure (global_State *g, LClosure *cl) {
+ int i;
+ markobjectN(g, cl->p); /* mark its prototype */
+ for (i = 0; i < cl->nupvalues; i++) { /* visit its upvalues */
+ UpVal *uv = cl->upvals[i];
+ markobjectN(g, uv); /* mark upvalue */
+ }
+ return 1 + cl->nupvalues;
+}
+
+
+/*
+** Traverse a thread, marking the elements in the stack up to its top
+** and cleaning the rest of the stack in the final traversal. That
+** ensures that the entire stack have valid (non-dead) objects.
+** Threads have no barriers. In gen. mode, old threads must be visited
+** at every cycle, because they might point to young objects. In inc.
+** mode, the thread can still be modified before the end of the cycle,
+** and therefore it must be visited again in the atomic phase. To ensure
+** these visits, threads must return to a gray list if they are not new
+** (which can only happen in generational mode) or if the traverse is in
+** the propagate phase (which can only happen in incremental mode).
+*/
+static int traversethread (global_State *g, lua_State *th) {
+ UpVal *uv;
+ StkId o = th->stack;
+ if (isold(th) || g->gcstate == GCSpropagate)
+ linkgclist(th, g->grayagain); /* insert into 'grayagain' list */
+ if (o == NULL)
+ return 1; /* stack not completely built yet */
+ lua_assert(g->gcstate == GCSatomic ||
+ th->openupval == NULL || isintwups(th));
+ for (; o < th->top; o++) /* mark live elements in the stack */
+ markvalue(g, s2v(o));
+ for (uv = th->openupval; uv != NULL; uv = uv->u.open.next)
+ markobject(g, uv); /* open upvalues cannot be collected */
+ if (g->gcstate == GCSatomic) { /* final traversal? */
+ for (; o < th->stack_last + EXTRA_STACK; o++)
+ setnilvalue(s2v(o)); /* clear dead stack slice */
+ /* 'remarkupvals' may have removed thread from 'twups' list */
+ if (!isintwups(th) && th->openupval != NULL) {
+ th->twups = g->twups; /* link it back to the list */
+ g->twups = th;
+ }
+ }
+ else if (!g->gcemergency)
+ luaD_shrinkstack(th); /* do not change stack in emergency cycle */
+ return 1 + stacksize(th);
+}
+
+
+/*
+** traverse one gray object, turning it to black.
+*/
+static lu_mem propagatemark (global_State *g) {
+ GCObject *o = g->gray;
+ nw2black(o);
+ g->gray = *getgclist(o); /* remove from 'gray' list */
+ switch (o->tt) {
+ case LUA_VTABLE: return traversetable(g, gco2t(o));
+ case LUA_VUSERDATA: return traverseudata(g, gco2u(o));
+ case LUA_VLCL: return traverseLclosure(g, gco2lcl(o));
+ case LUA_VCCL: return traverseCclosure(g, gco2ccl(o));
+ case LUA_VPROTO: return traverseproto(g, gco2p(o));
+ case LUA_VTHREAD: return traversethread(g, gco2th(o));
+ default: lua_assert(0); return 0;
+ }
+}
+
+
+static lu_mem propagateall (global_State *g) {
+ lu_mem tot = 0;
+ while (g->gray)
+ tot += propagatemark(g);
+ return tot;
+}
+
+
+/*
+** Traverse all ephemeron tables propagating marks from keys to values.
+** Repeat until it converges, that is, nothing new is marked. 'dir'
+** inverts the direction of the traversals, trying to speed up
+** convergence on chains in the same table.
+**
+*/
+static void convergeephemerons (global_State *g) {
+ int changed;
+ int dir = 0;
+ do {
+ GCObject *w;
+ GCObject *next = g->ephemeron; /* get ephemeron list */
+ g->ephemeron = NULL; /* tables may return to this list when traversed */
+ changed = 0;
+ while ((w = next) != NULL) { /* for each ephemeron table */
+ Table *h = gco2t(w);
+ next = h->gclist; /* list is rebuilt during loop */
+ nw2black(h); /* out of the list (for now) */
+ if (traverseephemeron(g, h, dir)) { /* marked some value? */
+ propagateall(g); /* propagate changes */
+ changed = 1; /* will have to revisit all ephemeron tables */
+ }
+ }
+ dir = !dir; /* invert direction next time */
+ } while (changed); /* repeat until no more changes */
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Sweep Functions
+** =======================================================
+*/
+
+
+/*
+** clear entries with unmarked keys from all weaktables in list 'l'
+*/
+static void clearbykeys (global_State *g, GCObject *l) {
+ for (; l; l = gco2t(l)->gclist) {
+ Table *h = gco2t(l);
+ Node *limit = gnodelast(h);
+ Node *n;
+ for (n = gnode(h, 0); n < limit; n++) {
+ if (iscleared(g, gckeyN(n))) /* unmarked key? */
+ setempty(gval(n)); /* remove entry */
+ if (isempty(gval(n))) /* is entry empty? */
+ clearkey(n); /* clear its key */
+ }
+ }
+}
+
+
+/*
+** clear entries with unmarked values from all weaktables in list 'l' up
+** to element 'f'
+*/
+static void clearbyvalues (global_State *g, GCObject *l, GCObject *f) {
+ for (; l != f; l = gco2t(l)->gclist) {
+ Table *h = gco2t(l);
+ Node *n, *limit = gnodelast(h);
+ unsigned int i;
+ unsigned int asize = luaH_realasize(h);
+ for (i = 0; i < asize; i++) {
+ TValue *o = &h->array[i];
+ if (iscleared(g, gcvalueN(o))) /* value was collected? */
+ setempty(o); /* remove entry */
+ }
+ for (n = gnode(h, 0); n < limit; n++) {
+ if (iscleared(g, gcvalueN(gval(n)))) /* unmarked value? */
+ setempty(gval(n)); /* remove entry */
+ if (isempty(gval(n))) /* is entry empty? */
+ clearkey(n); /* clear its key */
+ }
+ }
+}
+
+
+static void freeupval (lua_State *L, UpVal *uv) {
+ if (upisopen(uv))
+ luaF_unlinkupval(uv);
+ luaM_free(L, uv);
+}
+
+
+static void freeobj (lua_State *L, GCObject *o) {
+ switch (o->tt) {
+ case LUA_VPROTO:
+ luaF_freeproto(L, gco2p(o));
+ break;
+ case LUA_VUPVAL:
+ freeupval(L, gco2upv(o));
+ break;
+ case LUA_VLCL: {
+ LClosure *cl = gco2lcl(o);
+ luaM_freemem(L, cl, sizeLclosure(cl->nupvalues));
+ break;
+ }
+ case LUA_VCCL: {
+ CClosure *cl = gco2ccl(o);
+ luaM_freemem(L, cl, sizeCclosure(cl->nupvalues));
+ break;
+ }
+ case LUA_VTABLE:
+ luaH_free(L, gco2t(o));
+ break;
+ case LUA_VTHREAD:
+ luaE_freethread(L, gco2th(o));
+ break;
+ case LUA_VUSERDATA: {
+ Udata *u = gco2u(o);
+ luaM_freemem(L, o, sizeudata(u->nuvalue, u->len));
+ break;
+ }
+ case LUA_VSHRSTR: {
+ TString *ts = gco2ts(o);
+ luaS_remove(L, ts); /* remove it from hash table */
+ luaM_freemem(L, ts, sizelstring(ts->shrlen));
+ break;
+ }
+ case LUA_VLNGSTR: {
+ TString *ts = gco2ts(o);
+ luaM_freemem(L, ts, sizelstring(ts->u.lnglen));
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+
+/*
+** sweep at most 'countin' elements from a list of GCObjects erasing dead
+** objects, where a dead object is one marked with the old (non current)
+** white; change all non-dead objects back to white, preparing for next
+** collection cycle. Return where to continue the traversal or NULL if
+** list is finished. ('*countout' gets the number of elements traversed.)
+*/
+static GCObject **sweeplist (lua_State *L, GCObject **p, int countin,
+ int *countout) {
+ global_State *g = G(L);
+ int ow = otherwhite(g);
+ int i;
+ int white = luaC_white(g); /* current white */
+ for (i = 0; *p != NULL && i < countin; i++) {
+ GCObject *curr = *p;
+ int marked = curr->marked;
+ if (isdeadm(ow, marked)) { /* is 'curr' dead? */
+ *p = curr->next; /* remove 'curr' from list */
+ freeobj(L, curr); /* erase 'curr' */
+ }
+ else { /* change mark to 'white' */
+ curr->marked = cast_byte((marked & ~maskgcbits) | white);
+ p = &curr->next; /* go to next element */
+ }
+ }
+ if (countout)
+ *countout = i; /* number of elements traversed */
+ return (*p == NULL) ? NULL : p;
+}
+
+
+/*
+** sweep a list until a live object (or end of list)
+*/
+static GCObject **sweeptolive (lua_State *L, GCObject **p) {
+ GCObject **old = p;
+ do {
+ p = sweeplist(L, p, 1, NULL);
+ } while (p == old);
+ return p;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Finalization
+** =======================================================
+*/
+
+/*
+** If possible, shrink string table.
+*/
+static void checkSizes (lua_State *L, global_State *g) {
+ if (!g->gcemergency) {
+ if (g->strt.nuse < g->strt.size / 4) { /* string table too big? */
+ l_mem olddebt = g->GCdebt;
+ luaS_resize(L, g->strt.size / 2);
+ g->GCestimate += g->GCdebt - olddebt; /* correct estimate */
+ }
+ }
+}
+
+
+/*
+** Get the next udata to be finalized from the 'tobefnz' list, and
+** link it back into the 'allgc' list.
+*/
+static GCObject *udata2finalize (global_State *g) {
+ GCObject *o = g->tobefnz; /* get first element */
+ lua_assert(tofinalize(o));
+ g->tobefnz = o->next; /* remove it from 'tobefnz' list */
+ o->next = g->allgc; /* return it to 'allgc' list */
+ g->allgc = o;
+ resetbit(o->marked, FINALIZEDBIT); /* object is "normal" again */
+ if (issweepphase(g))
+ makewhite(g, o); /* "sweep" object */
+ else if (getage(o) == G_OLD1)
+ g->firstold1 = o; /* it is the first OLD1 object in the list */
+ return o;
+}
+
+
+static void dothecall (lua_State *L, void *ud) {
+ UNUSED(ud);
+ luaD_callnoyield(L, L->top - 2, 0);
+}
+
+
+static void GCTM (lua_State *L) {
+ global_State *g = G(L);
+ const TValue *tm;
+ TValue v;
+ lua_assert(!g->gcemergency);
+ setgcovalue(L, &v, udata2finalize(g));
+ tm = luaT_gettmbyobj(L, &v, TM_GC);
+ if (!notm(tm)) { /* is there a finalizer? */
+ int status;
+ lu_byte oldah = L->allowhook;
+ int oldgcstp = g->gcstp;
+ g->gcstp |= GCSTPGC; /* avoid GC steps */
+ L->allowhook = 0; /* stop debug hooks during GC metamethod */
+ setobj2s(L, L->top++, tm); /* push finalizer... */
+ setobj2s(L, L->top++, &v); /* ... and its argument */
+ L->ci->callstatus |= CIST_FIN; /* will run a finalizer */
+ status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);
+ L->ci->callstatus &= ~CIST_FIN; /* not running a finalizer anymore */
+ L->allowhook = oldah; /* restore hooks */
+ g->gcstp = oldgcstp; /* restore state */
+ if (l_unlikely(status != LUA_OK)) { /* error while running __gc? */
+ luaE_warnerror(L, "__gc");
+ L->top--; /* pops error object */
+ }
+ }
+}
+
+
+/*
+** Call a few finalizers
+*/
+static int runafewfinalizers (lua_State *L, int n) {
+ global_State *g = G(L);
+ int i;
+ for (i = 0; i < n && g->tobefnz; i++)
+ GCTM(L); /* call one finalizer */
+ return i;
+}
+
+
+/*
+** call all pending finalizers
+*/
+static void callallpendingfinalizers (lua_State *L) {
+ global_State *g = G(L);
+ while (g->tobefnz)
+ GCTM(L);
+}
+
+
+/*
+** find last 'next' field in list 'p' list (to add elements in its end)
+*/
+static GCObject **findlast (GCObject **p) {
+ while (*p != NULL)
+ p = &(*p)->next;
+ return p;
+}
+
+
+/*
+** Move all unreachable objects (or 'all' objects) that need
+** finalization from list 'finobj' to list 'tobefnz' (to be finalized).
+** (Note that objects after 'finobjold1' cannot be white, so they
+** don't need to be traversed. In incremental mode, 'finobjold1' is NULL,
+** so the whole list is traversed.)
+*/
+static void separatetobefnz (global_State *g, int all) {
+ GCObject *curr;
+ GCObject **p = &g->finobj;
+ GCObject **lastnext = findlast(&g->tobefnz);
+ while ((curr = *p) != g->finobjold1) { /* traverse all finalizable objects */
+ lua_assert(tofinalize(curr));
+ if (!(iswhite(curr) || all)) /* not being collected? */
+ p = &curr->next; /* don't bother with it */
+ else {
+ if (curr == g->finobjsur) /* removing 'finobjsur'? */
+ g->finobjsur = curr->next; /* correct it */
+ *p = curr->next; /* remove 'curr' from 'finobj' list */
+ curr->next = *lastnext; /* link at the end of 'tobefnz' list */
+ *lastnext = curr;
+ lastnext = &curr->next;
+ }
+ }
+}
+
+
+/*
+** If pointer 'p' points to 'o', move it to the next element.
+*/
+static void checkpointer (GCObject **p, GCObject *o) {
+ if (o == *p)
+ *p = o->next;
+}
+
+
+/*
+** Correct pointers to objects inside 'allgc' list when
+** object 'o' is being removed from the list.
+*/
+static void correctpointers (global_State *g, GCObject *o) {
+ checkpointer(&g->survival, o);
+ checkpointer(&g->old1, o);
+ checkpointer(&g->reallyold, o);
+ checkpointer(&g->firstold1, o);
+}
+
+
+/*
+** if object 'o' has a finalizer, remove it from 'allgc' list (must
+** search the list to find it) and link it in 'finobj' list.
+*/
+void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
+ global_State *g = G(L);
+ if (tofinalize(o) || /* obj. is already marked... */
+ gfasttm(g, mt, TM_GC) == NULL || /* or has no finalizer... */
+ (g->gcstp & GCSTPCLS)) /* or closing state? */
+ return; /* nothing to be done */
+ else { /* move 'o' to 'finobj' list */
+ GCObject **p;
+ if (issweepphase(g)) {
+ makewhite(g, o); /* "sweep" object 'o' */
+ if (g->sweepgc == &o->next) /* should not remove 'sweepgc' object */
+ g->sweepgc = sweeptolive(L, g->sweepgc); /* change 'sweepgc' */
+ }
+ else
+ correctpointers(g, o);
+ /* search for pointer pointing to 'o' */
+ for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
+ *p = o->next; /* remove 'o' from 'allgc' list */
+ o->next = g->finobj; /* link it in 'finobj' list */
+ g->finobj = o;
+ l_setbit(o->marked, FINALIZEDBIT); /* mark it as such */
+ }
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Generational Collector
+** =======================================================
+*/
+
+
+/*
+** Set the "time" to wait before starting a new GC cycle; cycle will
+** start when memory use hits the threshold of ('estimate' * pause /
+** PAUSEADJ). (Division by 'estimate' should be OK: it cannot be zero,
+** because Lua cannot even start with less than PAUSEADJ bytes).
+*/
+static void setpause (global_State *g) {
+ l_mem threshold, debt;
+ int pause = getgcparam(g->gcpause);
+ l_mem estimate = g->GCestimate / PAUSEADJ; /* adjust 'estimate' */
+ lua_assert(estimate > 0);
+ threshold = (pause < MAX_LMEM / estimate) /* overflow? */
+ ? estimate * pause /* no overflow */
+ : MAX_LMEM; /* overflow; truncate to maximum */
+ debt = gettotalbytes(g) - threshold;
+ if (debt > 0) debt = 0;
+ luaE_setdebt(g, debt);
+}
+
+
+/*
+** Sweep a list of objects to enter generational mode. Deletes dead
+** objects and turns the non dead to old. All non-dead threads---which
+** are now old---must be in a gray list. Everything else is not in a
+** gray list. Open upvalues are also kept gray.
+*/
+static void sweep2old (lua_State *L, GCObject **p) {
+ GCObject *curr;
+ global_State *g = G(L);
+ while ((curr = *p) != NULL) {
+ if (iswhite(curr)) { /* is 'curr' dead? */
+ lua_assert(isdead(g, curr));
+ *p = curr->next; /* remove 'curr' from list */
+ freeobj(L, curr); /* erase 'curr' */
+ }
+ else { /* all surviving objects become old */
+ setage(curr, G_OLD);
+ if (curr->tt == LUA_VTHREAD) { /* threads must be watched */
+ lua_State *th = gco2th(curr);
+ linkgclist(th, g->grayagain); /* insert into 'grayagain' list */
+ }
+ else if (curr->tt == LUA_VUPVAL && upisopen(gco2upv(curr)))
+ set2gray(curr); /* open upvalues are always gray */
+ else /* everything else is black */
+ nw2black(curr);
+ p = &curr->next; /* go to next element */
+ }
+ }
+}
+
+
+/*
+** Sweep for generational mode. Delete dead objects. (Because the
+** collection is not incremental, there are no "new white" objects
+** during the sweep. So, any white object must be dead.) For
+** non-dead objects, advance their ages and clear the color of
+** new objects. (Old objects keep their colors.)
+** The ages of G_TOUCHED1 and G_TOUCHED2 objects cannot be advanced
+** here, because these old-generation objects are usually not swept
+** here. They will all be advanced in 'correctgraylist'. That function
+** will also remove objects turned white here from any gray list.
+*/
+static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
+ GCObject *limit, GCObject **pfirstold1) {
+ static const lu_byte nextage[] = {
+ G_SURVIVAL, /* from G_NEW */
+ G_OLD1, /* from G_SURVIVAL */
+ G_OLD1, /* from G_OLD0 */
+ G_OLD, /* from G_OLD1 */
+ G_OLD, /* from G_OLD (do not change) */
+ G_TOUCHED1, /* from G_TOUCHED1 (do not change) */
+ G_TOUCHED2 /* from G_TOUCHED2 (do not change) */
+ };
+ int white = luaC_white(g);
+ GCObject *curr;
+ while ((curr = *p) != limit) {
+ if (iswhite(curr)) { /* is 'curr' dead? */
+ lua_assert(!isold(curr) && isdead(g, curr));
+ *p = curr->next; /* remove 'curr' from list */
+ freeobj(L, curr); /* erase 'curr' */
+ }
+ else { /* correct mark and age */
+ if (getage(curr) == G_NEW) { /* new objects go back to white */
+ int marked = curr->marked & ~maskgcbits; /* erase GC bits */
+ curr->marked = cast_byte(marked | G_SURVIVAL | white);
+ }
+ else { /* all other objects will be old, and so keep their color */
+ setage(curr, nextage[getage(curr)]);
+ if (getage(curr) == G_OLD1 && *pfirstold1 == NULL)
+ *pfirstold1 = curr; /* first OLD1 object in the list */
+ }
+ p = &curr->next; /* go to next element */
+ }
+ }
+ return p;
+}
+
+
+/*
+** Traverse a list making all its elements white and clearing their
+** age. In incremental mode, all objects are 'new' all the time,
+** except for fixed strings (which are always old).
+*/
+static void whitelist (global_State *g, GCObject *p) {
+ int white = luaC_white(g);
+ for (; p != NULL; p = p->next)
+ p->marked = cast_byte((p->marked & ~maskgcbits) | white);
+}
+
+
+/*
+** Correct a list of gray objects. Return pointer to where rest of the
+** list should be linked.
+** Because this correction is done after sweeping, young objects might
+** be turned white and still be in the list. They are only removed.
+** 'TOUCHED1' objects are advanced to 'TOUCHED2' and remain on the list;
+** Non-white threads also remain on the list; 'TOUCHED2' objects become
+** regular old; they and anything else are removed from the list.
+*/
+static GCObject **correctgraylist (GCObject **p) {
+ GCObject *curr;
+ while ((curr = *p) != NULL) {
+ GCObject **next = getgclist(curr);
+ if (iswhite(curr))
+ goto remove; /* remove all white objects */
+ else if (getage(curr) == G_TOUCHED1) { /* touched in this cycle? */
+ lua_assert(isgray(curr));
+ nw2black(curr); /* make it black, for next barrier */
+ changeage(curr, G_TOUCHED1, G_TOUCHED2);
+ goto remain; /* keep it in the list and go to next element */
+ }
+ else if (curr->tt == LUA_VTHREAD) {
+ lua_assert(isgray(curr));
+ goto remain; /* keep non-white threads on the list */
+ }
+ else { /* everything else is removed */
+ lua_assert(isold(curr)); /* young objects should be white here */
+ if (getage(curr) == G_TOUCHED2) /* advance from TOUCHED2... */
+ changeage(curr, G_TOUCHED2, G_OLD); /* ... to OLD */
+ nw2black(curr); /* make object black (to be removed) */
+ goto remove;
+ }
+ remove: *p = *next; continue;
+ remain: p = next; continue;
+ }
+ return p;
+}
+
+
+/*
+** Correct all gray lists, coalescing them into 'grayagain'.
+*/
+static void correctgraylists (global_State *g) {
+ GCObject **list = correctgraylist(&g->grayagain);
+ *list = g->weak; g->weak = NULL;
+ list = correctgraylist(list);
+ *list = g->allweak; g->allweak = NULL;
+ list = correctgraylist(list);
+ *list = g->ephemeron; g->ephemeron = NULL;
+ correctgraylist(list);
+}
+
+
+/*
+** Mark black 'OLD1' objects when starting a new young collection.
+** Gray objects are already in some gray list, and so will be visited
+** in the atomic step.
+*/
+static void markold (global_State *g, GCObject *from, GCObject *to) {
+ GCObject *p;
+ for (p = from; p != to; p = p->next) {
+ if (getage(p) == G_OLD1) {
+ lua_assert(!iswhite(p));
+ changeage(p, G_OLD1, G_OLD); /* now they are old */
+ if (isblack(p))
+ reallymarkobject(g, p);
+ }
+ }
+}
+
+
+/*
+** Finish a young-generation collection.
+*/
+static void finishgencycle (lua_State *L, global_State *g) {
+ correctgraylists(g);
+ checkSizes(L, g);
+ g->gcstate = GCSpropagate; /* skip restart */
+ if (!g->gcemergency)
+ callallpendingfinalizers(L);
+}
+
+
+/*
+** Does a young collection. First, mark 'OLD1' objects. Then does the
+** atomic step. Then, sweep all lists and advance pointers. Finally,
+** finish the collection.
+*/
+static void youngcollection (lua_State *L, global_State *g) {
+ GCObject **psurvival; /* to point to first non-dead survival object */
+ GCObject *dummy; /* dummy out parameter to 'sweepgen' */
+ lua_assert(g->gcstate == GCSpropagate);
+ if (g->firstold1) { /* are there regular OLD1 objects? */
+ markold(g, g->firstold1, g->reallyold); /* mark them */
+ g->firstold1 = NULL; /* no more OLD1 objects (for now) */
+ }
+ markold(g, g->finobj, g->finobjrold);
+ markold(g, g->tobefnz, NULL);
+ atomic(L);
+
+ /* sweep nursery and get a pointer to its last live element */
+ g->gcstate = GCSswpallgc;
+ psurvival = sweepgen(L, g, &g->allgc, g->survival, &g->firstold1);
+ /* sweep 'survival' */
+ sweepgen(L, g, psurvival, g->old1, &g->firstold1);
+ g->reallyold = g->old1;
+ g->old1 = *psurvival; /* 'survival' survivals are old now */
+ g->survival = g->allgc; /* all news are survivals */
+
+ /* repeat for 'finobj' lists */
+ dummy = NULL; /* no 'firstold1' optimization for 'finobj' lists */
+ psurvival = sweepgen(L, g, &g->finobj, g->finobjsur, &dummy);
+ /* sweep 'survival' */
+ sweepgen(L, g, psurvival, g->finobjold1, &dummy);
+ g->finobjrold = g->finobjold1;
+ g->finobjold1 = *psurvival; /* 'survival' survivals are old now */
+ g->finobjsur = g->finobj; /* all news are survivals */
+
+ sweepgen(L, g, &g->tobefnz, NULL, &dummy);
+ finishgencycle(L, g);
+}
+
+
+/*
+** Clears all gray lists, sweeps objects, and prepare sublists to enter
+** generational mode. The sweeps remove dead objects and turn all
+** surviving objects to old. Threads go back to 'grayagain'; everything
+** else is turned black (not in any gray list).
+*/
+static void atomic2gen (lua_State *L, global_State *g) {
+ cleargraylists(g);
+ /* sweep all elements making them old */
+ g->gcstate = GCSswpallgc;
+ sweep2old(L, &g->allgc);
+ /* everything alive now is old */
+ g->reallyold = g->old1 = g->survival = g->allgc;
+ g->firstold1 = NULL; /* there are no OLD1 objects anywhere */
+
+ /* repeat for 'finobj' lists */
+ sweep2old(L, &g->finobj);
+ g->finobjrold = g->finobjold1 = g->finobjsur = g->finobj;
+
+ sweep2old(L, &g->tobefnz);
+
+ g->gckind = KGC_GEN;
+ g->lastatomic = 0;
+ g->GCestimate = gettotalbytes(g); /* base for memory control */
+ finishgencycle(L, g);
+}
+
+
+/*
+** Set debt for the next minor collection, which will happen when
+** memory grows 'genminormul'%.
+*/
+static void setminordebt (global_State *g) {
+ luaE_setdebt(g, -(cast(l_mem, (gettotalbytes(g) / 100)) * g->genminormul));
+}
+
+
+/*
+** Enter generational mode. Must go until the end of an atomic cycle
+** to ensure that all objects are correctly marked and weak tables
+** are cleared. Then, turn all objects into old and finishes the
+** collection.
+*/
+static lu_mem entergen (lua_State *L, global_State *g) {
+ lu_mem numobjs;
+ luaC_runtilstate(L, bitmask(GCSpause)); /* prepare to start a new cycle */
+ luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
+ numobjs = atomic(L); /* propagates all and then do the atomic stuff */
+ atomic2gen(L, g);
+ setminordebt(g); /* set debt assuming next cycle will be minor */
+ return numobjs;
+}
+
+
+/*
+** Enter incremental mode. Turn all objects white, make all
+** intermediate lists point to NULL (to avoid invalid pointers),
+** and go to the pause state.
+*/
+static void enterinc (global_State *g) {
+ whitelist(g, g->allgc);
+ g->reallyold = g->old1 = g->survival = NULL;
+ whitelist(g, g->finobj);
+ whitelist(g, g->tobefnz);
+ g->finobjrold = g->finobjold1 = g->finobjsur = NULL;
+ g->gcstate = GCSpause;
+ g->gckind = KGC_INC;
+ g->lastatomic = 0;
+}
+
+
+/*
+** Change collector mode to 'newmode'.
+*/
+void luaC_changemode (lua_State *L, int newmode) {
+ global_State *g = G(L);
+ if (newmode != g->gckind) {
+ if (newmode == KGC_GEN) /* entering generational mode? */
+ entergen(L, g);
+ else
+ enterinc(g); /* entering incremental mode */
+ }
+ g->lastatomic = 0;
+}
+
+
+/*
+** Does a full collection in generational mode.
+*/
+static lu_mem fullgen (lua_State *L, global_State *g) {
+ enterinc(g);
+ return entergen(L, g);
+}
+
+
+/*
+** Does a major collection after last collection was a "bad collection".
+**
+** When the program is building a big structure, it allocates lots of
+** memory but generates very little garbage. In those scenarios,
+** the generational mode just wastes time doing small collections, and
+** major collections are frequently what we call a "bad collection", a
+** collection that frees too few objects. To avoid the cost of switching
+** between generational mode and the incremental mode needed for full
+** (major) collections, the collector tries to stay in incremental mode
+** after a bad collection, and to switch back to generational mode only
+** after a "good" collection (one that traverses less than 9/8 objects
+** of the previous one).
+** The collector must choose whether to stay in incremental mode or to
+** switch back to generational mode before sweeping. At this point, it
+** does not know the real memory in use, so it cannot use memory to
+** decide whether to return to generational mode. Instead, it uses the
+** number of objects traversed (returned by 'atomic') as a proxy. The
+** field 'g->lastatomic' keeps this count from the last collection.
+** ('g->lastatomic != 0' also means that the last collection was bad.)
+*/
+static void stepgenfull (lua_State *L, global_State *g) {
+ lu_mem newatomic; /* count of traversed objects */
+ lu_mem lastatomic = g->lastatomic; /* count from last collection */
+ if (g->gckind == KGC_GEN) /* still in generational mode? */
+ enterinc(g); /* enter incremental mode */
+ luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
+ newatomic = atomic(L); /* mark everybody */
+ if (newatomic < lastatomic + (lastatomic >> 3)) { /* good collection? */
+ atomic2gen(L, g); /* return to generational mode */
+ setminordebt(g);
+ }
+ else { /* another bad collection; stay in incremental mode */
+ g->GCestimate = gettotalbytes(g); /* first estimate */;
+ entersweep(L);
+ luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
+ setpause(g);
+ g->lastatomic = newatomic;
+ }
+}
+
+
+/*
+** Does a generational "step".
+** Usually, this means doing a minor collection and setting the debt to
+** make another collection when memory grows 'genminormul'% larger.
+**
+** However, there are exceptions. If memory grows 'genmajormul'%
+** larger than it was at the end of the last major collection (kept
+** in 'g->GCestimate'), the function does a major collection. At the
+** end, it checks whether the major collection was able to free a
+** decent amount of memory (at least half the growth in memory since
+** previous major collection). If so, the collector keeps its state,
+** and the next collection will probably be minor again. Otherwise,
+** we have what we call a "bad collection". In that case, set the field
+** 'g->lastatomic' to signal that fact, so that the next collection will
+** go to 'stepgenfull'.
+**
+** 'GCdebt <= 0' means an explicit call to GC step with "size" zero;
+** in that case, do a minor collection.
+*/
+static void genstep (lua_State *L, global_State *g) {
+ if (g->lastatomic != 0) /* last collection was a bad one? */
+ stepgenfull(L, g); /* do a full step */
+ else {
+ lu_mem majorbase = g->GCestimate; /* memory after last major collection */
+ lu_mem majorinc = (majorbase / 100) * getgcparam(g->genmajormul);
+ if (g->GCdebt > 0 && gettotalbytes(g) > majorbase + majorinc) {
+ lu_mem numobjs = fullgen(L, g); /* do a major collection */
+ if (gettotalbytes(g) < majorbase + (majorinc / 2)) {
+ /* collected at least half of memory growth since last major
+ collection; keep doing minor collections. */
+ lua_assert(g->lastatomic == 0);
+ }
+ else { /* bad collection */
+ g->lastatomic = numobjs; /* signal that last collection was bad */
+ setpause(g); /* do a long wait for next (major) collection */
+ }
+ }
+ else { /* regular case; do a minor collection */
+ youngcollection(L, g);
+ setminordebt(g);
+ g->GCestimate = majorbase; /* preserve base value */
+ }
+ }
+ lua_assert(isdecGCmodegen(g));
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** GC control
+** =======================================================
+*/
+
+
+/*
+** Enter first sweep phase.
+** The call to 'sweeptolive' makes the pointer point to an object
+** inside the list (instead of to the header), so that the real sweep do
+** not need to skip objects created between "now" and the start of the
+** real sweep.
+*/
+static void entersweep (lua_State *L) {
+ global_State *g = G(L);
+ g->gcstate = GCSswpallgc;
+ lua_assert(g->sweepgc == NULL);
+ g->sweepgc = sweeptolive(L, &g->allgc);
+}
+
+
+/*
+** Delete all objects in list 'p' until (but not including) object
+** 'limit'.
+*/
+static void deletelist (lua_State *L, GCObject *p, GCObject *limit) {
+ while (p != limit) {
+ GCObject *next = p->next;
+ freeobj(L, p);
+ p = next;
+ }
+}
+
+
+/*
+** Call all finalizers of the objects in the given Lua state, and
+** then free all objects, except for the main thread.
+*/
+void luaC_freeallobjects (lua_State *L) {
+ global_State *g = G(L);
+ g->gcstp = GCSTPCLS; /* no extra finalizers after here */
+ luaC_changemode(L, KGC_INC);
+ separatetobefnz(g, 1); /* separate all objects with finalizers */
+ lua_assert(g->finobj == NULL);
+ callallpendingfinalizers(L);
+ deletelist(L, g->allgc, obj2gco(g->mainthread));
+ lua_assert(g->finobj == NULL); /* no new finalizers */
+ deletelist(L, g->fixedgc, NULL); /* collect fixed objects */
+ lua_assert(g->strt.nuse == 0);
+}
+
+
+static lu_mem atomic (lua_State *L) {
+ global_State *g = G(L);
+ lu_mem work = 0;
+ GCObject *origweak, *origall;
+ GCObject *grayagain = g->grayagain; /* save original list */
+ g->grayagain = NULL;
+ lua_assert(g->ephemeron == NULL && g->weak == NULL);
+ lua_assert(!iswhite(g->mainthread));
+ g->gcstate = GCSatomic;
+ markobject(g, L); /* mark running thread */
+ /* registry and global metatables may be changed by API */
+ markvalue(g, &g->l_registry);
+ markmt(g); /* mark global metatables */
+ work += propagateall(g); /* empties 'gray' list */
+ /* remark occasional upvalues of (maybe) dead threads */
+ work += remarkupvals(g);
+ work += propagateall(g); /* propagate changes */
+ g->gray = grayagain;
+ work += propagateall(g); /* traverse 'grayagain' list */
+ convergeephemerons(g);
+ /* at this point, all strongly accessible objects are marked. */
+ /* Clear values from weak tables, before checking finalizers */
+ clearbyvalues(g, g->weak, NULL);
+ clearbyvalues(g, g->allweak, NULL);
+ origweak = g->weak; origall = g->allweak;
+ separatetobefnz(g, 0); /* separate objects to be finalized */
+ work += markbeingfnz(g); /* mark objects that will be finalized */
+ work += propagateall(g); /* remark, to propagate 'resurrection' */
+ convergeephemerons(g);
+ /* at this point, all resurrected objects are marked. */
+ /* remove dead objects from weak tables */
+ clearbykeys(g, g->ephemeron); /* clear keys from all ephemeron tables */
+ clearbykeys(g, g->allweak); /* clear keys from all 'allweak' tables */
+ /* clear values from resurrected weak tables */
+ clearbyvalues(g, g->weak, origweak);
+ clearbyvalues(g, g->allweak, origall);
+ luaS_clearcache(g);
+ g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */
+ lua_assert(g->gray == NULL);
+ return work; /* estimate of slots marked by 'atomic' */
+}
+
+
+static int sweepstep (lua_State *L, global_State *g,
+ int nextstate, GCObject **nextlist) {
+ if (g->sweepgc) {
+ l_mem olddebt = g->GCdebt;
+ int count;
+ g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX, &count);
+ g->GCestimate += g->GCdebt - olddebt; /* update estimate */
+ return count;
+ }
+ else { /* enter next state */
+ g->gcstate = nextstate;
+ g->sweepgc = nextlist;
+ return 0; /* no work done */
+ }
+}
+
+
+static lu_mem singlestep (lua_State *L) {
+ global_State *g = G(L);
+ lu_mem work;
+ lua_assert(!g->gcstopem); /* collector is not reentrant */
+ g->gcstopem = 1; /* no emergency collections while collecting */
+ switch (g->gcstate) {
+ case GCSpause: {
+ restartcollection(g);
+ g->gcstate = GCSpropagate;
+ work = 1;
+ break;
+ }
+ case GCSpropagate: {
+ if (g->gray == NULL) { /* no more gray objects? */
+ g->gcstate = GCSenteratomic; /* finish propagate phase */
+ work = 0;
+ }
+ else
+ work = propagatemark(g); /* traverse one gray object */
+ break;
+ }
+ case GCSenteratomic: {
+ work = atomic(L); /* work is what was traversed by 'atomic' */
+ entersweep(L);
+ g->GCestimate = gettotalbytes(g); /* first estimate */;
+ break;
+ }
+ case GCSswpallgc: { /* sweep "regular" objects */
+ work = sweepstep(L, g, GCSswpfinobj, &g->finobj);
+ break;
+ }
+ case GCSswpfinobj: { /* sweep objects with finalizers */
+ work = sweepstep(L, g, GCSswptobefnz, &g->tobefnz);
+ break;
+ }
+ case GCSswptobefnz: { /* sweep objects to be finalized */
+ work = sweepstep(L, g, GCSswpend, NULL);
+ break;
+ }
+ case GCSswpend: { /* finish sweeps */
+ checkSizes(L, g);
+ g->gcstate = GCScallfin;
+ work = 0;
+ break;
+ }
+ case GCScallfin: { /* call remaining finalizers */
+ if (g->tobefnz && !g->gcemergency) {
+ g->gcstopem = 0; /* ok collections during finalizers */
+ work = runafewfinalizers(L, GCFINMAX) * GCFINALIZECOST;
+ }
+ else { /* emergency mode or no more finalizers */
+ g->gcstate = GCSpause; /* finish collection */
+ work = 0;
+ }
+ break;
+ }
+ default: lua_assert(0); return 0;
+ }
+ g->gcstopem = 0;
+ return work;
+}
+
+
+/*
+** advances the garbage collector until it reaches a state allowed
+** by 'statemask'
+*/
+void luaC_runtilstate (lua_State *L, int statesmask) {
+ global_State *g = G(L);
+ while (!testbit(statesmask, g->gcstate))
+ singlestep(L);
+}
+
+
+
+/*
+** Performs a basic incremental step. The debt and step size are
+** converted from bytes to "units of work"; then the function loops
+** running single steps until adding that many units of work or
+** finishing a cycle (pause state). Finally, it sets the debt that
+** controls when next step will be performed.
+*/
+static void incstep (lua_State *L, global_State *g) {
+ int stepmul = (getgcparam(g->gcstepmul) | 1); /* avoid division by 0 */
+ l_mem debt = (g->GCdebt / WORK2MEM) * stepmul;
+ l_mem stepsize = (g->gcstepsize <= log2maxs(l_mem))
+ ? ((cast(l_mem, 1) << g->gcstepsize) / WORK2MEM) * stepmul
+ : MAX_LMEM; /* overflow; keep maximum value */
+ do { /* repeat until pause or enough "credit" (negative debt) */
+ lu_mem work = singlestep(L); /* perform one single step */
+ debt -= work;
+ } while (debt > -stepsize && g->gcstate != GCSpause);
+ if (g->gcstate == GCSpause)
+ setpause(g); /* pause until next cycle */
+ else {
+ debt = (debt / stepmul) * WORK2MEM; /* convert 'work units' to bytes */
+ luaE_setdebt(g, debt);
+ }
+}
+
+/*
+** performs a basic GC step if collector is running
+*/
+void luaC_step (lua_State *L) {
+ global_State *g = G(L);
+ lua_assert(!g->gcemergency);
+ if (gcrunning(g)) { /* running? */
+ if(isdecGCmodegen(g))
+ genstep(L, g);
+ else
+ incstep(L, g);
+ }
+}
+
+
+/*
+** Perform a full collection in incremental mode.
+** Before running the collection, check 'keepinvariant'; if it is true,
+** there may be some objects marked as black, so the collector has
+** to sweep all objects to turn them back to white (as white has not
+** changed, nothing will be collected).
+*/
+static void fullinc (lua_State *L, global_State *g) {
+ if (keepinvariant(g)) /* black objects? */
+ entersweep(L); /* sweep everything to turn them back to white */
+ /* finish any pending sweep phase to start a new cycle */
+ luaC_runtilstate(L, bitmask(GCSpause));
+ luaC_runtilstate(L, bitmask(GCScallfin)); /* run up to finalizers */
+ /* estimate must be correct after a full GC cycle */
+ lua_assert(g->GCestimate == gettotalbytes(g));
+ luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
+ setpause(g);
+}
+
+
+/*
+** Performs a full GC cycle; if 'isemergency', set a flag to avoid
+** some operations which could change the interpreter state in some
+** unexpected ways (running finalizers and shrinking some structures).
+*/
+void luaC_fullgc (lua_State *L, int isemergency) {
+ global_State *g = G(L);
+ lua_assert(!g->gcemergency);
+ g->gcemergency = isemergency; /* set flag */
+ if (g->gckind == KGC_INC)
+ fullinc(L, g);
+ else
+ fullgen(L, g);
+ g->gcemergency = 0;
+}
+
+/* }====================================================== */
+
+
diff --git a/source/luametatex/source/luacore/lua54/src/lgc.h b/source/luametatex/source/luacore/lua54/src/lgc.h
new file mode 100644
index 000000000..4a125634b
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lgc.h
@@ -0,0 +1,199 @@
+/*
+** $Id: lgc.h $
+** Garbage Collector
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lgc_h
+#define lgc_h
+
+
+#include "lobject.h"
+#include "lstate.h"
+
+/*
+** Collectable objects may have one of three colors: white, which means
+** the object is not marked; gray, which means the object is marked, but
+** its references may be not marked; and black, which means that the
+** object and all its references are marked. The main invariant of the
+** garbage collector, while marking objects, is that a black object can
+** never point to a white one. Moreover, any gray object must be in a
+** "gray list" (gray, grayagain, weak, allweak, ephemeron) so that it
+** can be visited again before finishing the collection cycle. (Open
+** upvalues are an exception to this rule.) These lists have no meaning
+** when the invariant is not being enforced (e.g., sweep phase).
+*/
+
+
+/*
+** Possible states of the Garbage Collector
+*/
+#define GCSpropagate 0
+#define GCSenteratomic 1
+#define GCSatomic 2
+#define GCSswpallgc 3
+#define GCSswpfinobj 4
+#define GCSswptobefnz 5
+#define GCSswpend 6
+#define GCScallfin 7
+#define GCSpause 8
+
+
+#define issweepphase(g) \
+ (GCSswpallgc <= (g)->gcstate && (g)->gcstate <= GCSswpend)
+
+
+/*
+** macro to tell when main invariant (white objects cannot point to black
+** ones) must be kept. During a collection, the sweep
+** phase may break the invariant, as objects turned white may point to
+** still-black objects. The invariant is restored when sweep ends and
+** all objects are white again.
+*/
+
+#define keepinvariant(g) ((g)->gcstate <= GCSatomic)
+
+
+/*
+** some useful bit tricks
+*/
+#define resetbits(x,m) ((x) &= cast_byte(~(m)))
+#define setbits(x,m) ((x) |= (m))
+#define testbits(x,m) ((x) & (m))
+#define bitmask(b) (1<<(b))
+#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2))
+#define l_setbit(x,b) setbits(x, bitmask(b))
+#define resetbit(x,b) resetbits(x, bitmask(b))
+#define testbit(x,b) testbits(x, bitmask(b))
+
+
+/*
+** Layout for bit use in 'marked' field. First three bits are
+** used for object "age" in generational mode. Last bit is used
+** by tests.
+*/
+#define WHITE0BIT 3 /* object is white (type 0) */
+#define WHITE1BIT 4 /* object is white (type 1) */
+#define BLACKBIT 5 /* object is black */
+#define FINALIZEDBIT 6 /* object has been marked for finalization */
+
+#define TESTBIT 7
+
+
+
+#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
+
+
+#define iswhite(x) testbits((x)->marked, WHITEBITS)
+#define isblack(x) testbit((x)->marked, BLACKBIT)
+#define isgray(x) /* neither white nor black */ \
+ (!testbits((x)->marked, WHITEBITS | bitmask(BLACKBIT)))
+
+#define tofinalize(x) testbit((x)->marked, FINALIZEDBIT)
+
+#define otherwhite(g) ((g)->currentwhite ^ WHITEBITS)
+#define isdeadm(ow,m) ((m) & (ow))
+#define isdead(g,v) isdeadm(otherwhite(g), (v)->marked)
+
+#define changewhite(x) ((x)->marked ^= WHITEBITS)
+#define nw2black(x) \
+ check_exp(!iswhite(x), l_setbit((x)->marked, BLACKBIT))
+
+#define luaC_white(g) cast_byte((g)->currentwhite & WHITEBITS)
+
+
+/* object age in generational mode */
+#define G_NEW 0 /* created in current cycle */
+#define G_SURVIVAL 1 /* created in previous cycle */
+#define G_OLD0 2 /* marked old by frw. barrier in this cycle */
+#define G_OLD1 3 /* first full cycle as old */
+#define G_OLD 4 /* really old object (not to be visited) */
+#define G_TOUCHED1 5 /* old object touched this cycle */
+#define G_TOUCHED2 6 /* old object touched in previous cycle */
+
+#define AGEBITS 7 /* all age bits (111) */
+
+#define getage(o) ((o)->marked & AGEBITS)
+#define setage(o,a) ((o)->marked = cast_byte(((o)->marked & (~AGEBITS)) | a))
+#define isold(o) (getage(o) > G_SURVIVAL)
+
+#define changeage(o,f,t) \
+ check_exp(getage(o) == (f), (o)->marked ^= ((f)^(t)))
+
+
+/* Default Values for GC parameters */
+#define LUAI_GENMAJORMUL 100
+#define LUAI_GENMINORMUL 20
+
+/* wait memory to double before starting new cycle */
+#define LUAI_GCPAUSE 200
+
+/*
+** some gc parameters are stored divided by 4 to allow a maximum value
+** up to 1023 in a 'lu_byte'.
+*/
+#define getgcparam(p) ((p) * 4)
+#define setgcparam(p,v) ((p) = (v) / 4)
+
+#define LUAI_GCMUL 100
+
+/* how much to allocate before next GC step (log2) */
+#define LUAI_GCSTEPSIZE 13 /* 8 KB */
+
+
+/*
+** Check whether the declared GC mode is generational. While in
+** generational mode, the collector can go temporarily to incremental
+** mode to improve performance. This is signaled by 'g->lastatomic != 0'.
+*/
+#define isdecGCmodegen(g) (g->gckind == KGC_GEN || g->lastatomic != 0)
+
+
+/*
+** Control when GC is running:
+*/
+#define GCSTPUSR 1 /* bit true when GC stopped by user */
+#define GCSTPGC 2 /* bit true when GC stopped by itself */
+#define GCSTPCLS 4 /* bit true when closing Lua state */
+#define gcrunning(g) ((g)->gcstp == 0)
+
+
+/*
+** Does one step of collection when debt becomes positive. 'pre'/'pos'
+** allows some adjustments to be done only when needed. macro
+** 'condchangemem' is used only for heavy tests (forcing a full
+** GC cycle on every opportunity)
+*/
+#define luaC_condGC(L,pre,pos) \
+ { if (G(L)->GCdebt > 0) { pre; luaC_step(L); pos;}; \
+ condchangemem(L,pre,pos); }
+
+/* more often than not, 'pre'/'pos' are empty */
+#define luaC_checkGC(L) luaC_condGC(L,(void)0,(void)0)
+
+
+#define luaC_barrier(L,p,v) ( \
+ (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \
+ luaC_barrier_(L,obj2gco(p),gcvalue(v)) : cast_void(0))
+
+#define luaC_barrierback(L,p,v) ( \
+ (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \
+ luaC_barrierback_(L,p) : cast_void(0))
+
+#define luaC_objbarrier(L,p,o) ( \
+ (isblack(p) && iswhite(o)) ? \
+ luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0))
+
+LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o);
+LUAI_FUNC void luaC_freeallobjects (lua_State *L);
+LUAI_FUNC void luaC_step (lua_State *L);
+LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);
+LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
+LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz);
+LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
+LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
+LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);
+LUAI_FUNC void luaC_changemode (lua_State *L, int newmode);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/linit.c b/source/luametatex/source/luacore/lua54/src/linit.c
new file mode 100644
index 000000000..69808f84f
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/linit.c
@@ -0,0 +1,65 @@
+/*
+** $Id: linit.c $
+** Initialization of libraries for lua.c and other clients
+** See Copyright Notice in lua.h
+*/
+
+
+#define linit_c
+#define LUA_LIB
+
+/*
+** If you embed Lua in your program and need to open the standard
+** libraries, call luaL_openlibs in your program. If you need a
+** different set of libraries, copy this file to your project and edit
+** it to suit your needs.
+**
+** You can also *preload* libraries, so that a later 'require' can
+** open the library, which is already linked to the application.
+** For that, do the following code:
+**
+** luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
+** lua_pushcfunction(L, luaopen_modname);
+** lua_setfield(L, -2, modname);
+** lua_pop(L, 1); // remove PRELOAD table
+*/
+
+#include "lprefix.h"
+
+
+#include <stddef.h>
+
+#include "lua.h"
+
+#include "lualib.h"
+#include "lauxlib.h"
+
+
+/*
+** these libs are loaded by lua.c and are readily available to any Lua
+** program
+*/
+static const luaL_Reg loadedlibs[] = {
+ {LUA_GNAME, luaopen_base},
+ {LUA_LOADLIBNAME, luaopen_package},
+ {LUA_COLIBNAME, luaopen_coroutine},
+ {LUA_TABLIBNAME, luaopen_table},
+ {LUA_IOLIBNAME, luaopen_io},
+ {LUA_OSLIBNAME, luaopen_os},
+ {LUA_STRLIBNAME, luaopen_string},
+ {LUA_MATHLIBNAME, luaopen_math},
+ {LUA_UTF8LIBNAME, luaopen_utf8},
+ {LUA_DBLIBNAME, luaopen_debug},
+ {NULL, NULL}
+};
+
+
+LUALIB_API void luaL_openlibs (lua_State *L) {
+ const luaL_Reg *lib;
+ /* "require" functions from 'loadedlibs' and set results to global table */
+ for (lib = loadedlibs; lib->func; lib++) {
+ luaL_requiref(L, lib->name, lib->func, 1);
+ lua_pop(L, 1); /* remove lib */
+ }
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/liolib.c b/source/luametatex/source/luacore/lua54/src/liolib.c
new file mode 100644
index 000000000..b08397da4
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/liolib.c
@@ -0,0 +1,828 @@
+/*
+** $Id: liolib.c $
+** Standard I/O (and system) library
+** See Copyright Notice in lua.h
+*/
+
+#define liolib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <ctype.h>
+#include <errno.h>
+#include <locale.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+
+
+/*
+** Change this macro to accept other modes for 'fopen' besides
+** the standard ones.
+*/
+#if !defined(l_checkmode)
+
+/* accepted extensions to 'mode' in 'fopen' */
+#if !defined(L_MODEEXT)
+#define L_MODEEXT "b"
+#endif
+
+/* Check whether 'mode' matches '[rwa]%+?[L_MODEEXT]*' */
+static int l_checkmode (const char *mode) {
+ return (*mode != '\0' && strchr("rwa", *(mode++)) != NULL &&
+ (*mode != '+' || ((void)(++mode), 1)) && /* skip if char is '+' */
+ (strspn(mode, L_MODEEXT) == strlen(mode))); /* check extensions */
+}
+
+#endif
+
+/*
+** {======================================================
+** l_popen spawns a new process connected to the current
+** one through the file streams.
+** =======================================================
+*/
+
+#if !defined(l_popen) /* { */
+
+#if defined(LUA_USE_POSIX) /* { */
+
+#define l_popen(L,c,m) (fflush(NULL), popen(c,m))
+#define l_pclose(L,file) (pclose(file))
+
+#elif defined(LUA_USE_WINDOWS) /* }{ */
+
+#define l_popen(L,c,m) (_popen(c,m))
+#define l_pclose(L,file) (_pclose(file))
+
+#if !defined(l_checkmodep)
+/* Windows accepts "[rw][bt]?" as valid modes */
+#define l_checkmodep(m) ((m[0] == 'r' || m[0] == 'w') && \
+ (m[1] == '\0' || ((m[1] == 'b' || m[1] == 't') && m[2] == '\0')))
+#endif
+
+#else /* }{ */
+
+/* ISO C definitions */
+#define l_popen(L,c,m) \
+ ((void)c, (void)m, \
+ luaL_error(L, "'popen' not supported"), \
+ (FILE*)0)
+#define l_pclose(L,file) ((void)L, (void)file, -1)
+
+#endif /* } */
+
+#endif /* } */
+
+
+#if !defined(l_checkmodep)
+/* By default, Lua accepts only "r" or "w" as valid modes */
+#define l_checkmodep(m) ((m[0] == 'r' || m[0] == 'w') && m[1] == '\0')
+#endif
+
+/* }====================================================== */
+
+
+#if !defined(l_getc) /* { */
+
+#if defined(LUA_USE_POSIX)
+#define l_getc(f) getc_unlocked(f)
+#define l_lockfile(f) flockfile(f)
+#define l_unlockfile(f) funlockfile(f)
+#else
+#define l_getc(f) getc(f)
+#define l_lockfile(f) ((void)0)
+#define l_unlockfile(f) ((void)0)
+#endif
+
+#endif /* } */
+
+
+/*
+** {======================================================
+** l_fseek: configuration for longer offsets
+** =======================================================
+*/
+
+#if !defined(l_fseek) /* { */
+
+#if defined(LUA_USE_POSIX) /* { */
+
+#include <sys/types.h>
+
+#define l_fseek(f,o,w) fseeko(f,o,w)
+#define l_ftell(f) ftello(f)
+#define l_seeknum off_t
+
+#elif defined(LUA_USE_WINDOWS) && !defined(_CRTIMP_TYPEINFO) \
+ && defined(_MSC_VER) && (_MSC_VER >= 1400) /* }{ */
+
+/* Windows (but not DDK) and Visual C++ 2005 or higher */
+#define l_fseek(f,o,w) _fseeki64(f,o,w)
+#define l_ftell(f) _ftelli64(f)
+#define l_seeknum __int64
+
+#else /* }{ */
+
+/* ISO C definitions */
+#define l_fseek(f,o,w) fseek(f,o,w)
+#define l_ftell(f) ftell(f)
+#define l_seeknum long
+
+#endif /* } */
+
+#endif /* } */
+
+/* }====================================================== */
+
+
+
+#define IO_PREFIX "_IO_"
+#define IOPREF_LEN (sizeof(IO_PREFIX)/sizeof(char) - 1)
+#define IO_INPUT (IO_PREFIX "input")
+#define IO_OUTPUT (IO_PREFIX "output")
+
+
+typedef luaL_Stream LStream;
+
+
+#define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE))
+
+#define isclosed(p) ((p)->closef == NULL)
+
+
+static int io_type (lua_State *L) {
+ LStream *p;
+ luaL_checkany(L, 1);
+ p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE);
+ if (p == NULL)
+ luaL_pushfail(L); /* not a file */
+ else if (isclosed(p))
+ lua_pushliteral(L, "closed file");
+ else
+ lua_pushliteral(L, "file");
+ return 1;
+}
+
+
+static int f_tostring (lua_State *L) {
+ LStream *p = tolstream(L);
+ if (isclosed(p))
+ lua_pushliteral(L, "file (closed)");
+ else
+ lua_pushfstring(L, "file (%p)", p->f);
+ return 1;
+}
+
+
+static FILE *tofile (lua_State *L) {
+ LStream *p = tolstream(L);
+ if (l_unlikely(isclosed(p)))
+ luaL_error(L, "attempt to use a closed file");
+ lua_assert(p->f);
+ return p->f;
+}
+
+
+/*
+** When creating file handles, always creates a 'closed' file handle
+** before opening the actual file; so, if there is a memory error, the
+** handle is in a consistent state.
+*/
+static LStream *newprefile (lua_State *L) {
+ LStream *p = (LStream *)lua_newuserdatauv(L, sizeof(LStream), 0);
+ p->closef = NULL; /* mark file handle as 'closed' */
+ luaL_setmetatable(L, LUA_FILEHANDLE);
+ return p;
+}
+
+
+/*
+** Calls the 'close' function from a file handle. The 'volatile' avoids
+** a bug in some versions of the Clang compiler (e.g., clang 3.0 for
+** 32 bits).
+*/
+static int aux_close (lua_State *L) {
+ LStream *p = tolstream(L);
+ volatile lua_CFunction cf = p->closef;
+ p->closef = NULL; /* mark stream as closed */
+ return (*cf)(L); /* close it */
+}
+
+
+static int f_close (lua_State *L) {
+ tofile(L); /* make sure argument is an open stream */
+ return aux_close(L);
+}
+
+
+static int io_close (lua_State *L) {
+ if (lua_isnone(L, 1)) /* no argument? */
+ lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use default output */
+ return f_close(L);
+}
+
+
+static int f_gc (lua_State *L) {
+ LStream *p = tolstream(L);
+ if (!isclosed(p) && p->f != NULL)
+ aux_close(L); /* ignore closed and incompletely open files */
+ return 0;
+}
+
+
+/*
+** function to close regular files
+*/
+static int io_fclose (lua_State *L) {
+ LStream *p = tolstream(L);
+ int res = fclose(p->f);
+ return luaL_fileresult(L, (res == 0), NULL);
+}
+
+
+static LStream *newfile (lua_State *L) {
+ LStream *p = newprefile(L);
+ p->f = NULL;
+ p->closef = &io_fclose;
+ return p;
+}
+
+
+static void opencheck (lua_State *L, const char *fname, const char *mode) {
+ LStream *p = newfile(L);
+ p->f = fopen(fname, mode);
+ if (l_unlikely(p->f == NULL))
+ luaL_error(L, "cannot open file '%s' (%s)", fname, strerror(errno));
+}
+
+
+static int io_open (lua_State *L) {
+ const char *filename = luaL_checkstring(L, 1);
+ const char *mode = luaL_optstring(L, 2, "r");
+ LStream *p = newfile(L);
+ const char *md = mode; /* to traverse/check mode */
+ luaL_argcheck(L, l_checkmode(md), 2, "invalid mode");
+ p->f = fopen(filename, mode);
+ return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
+}
+
+
+/*
+** function to close 'popen' files
+*/
+static int io_pclose (lua_State *L) {
+ LStream *p = tolstream(L);
+ errno = 0;
+ return luaL_execresult(L, l_pclose(L, p->f));
+}
+
+
+static int io_popen (lua_State *L) {
+ const char *filename = luaL_checkstring(L, 1);
+ const char *mode = luaL_optstring(L, 2, "r");
+ LStream *p = newprefile(L);
+ luaL_argcheck(L, l_checkmodep(mode), 2, "invalid mode");
+ p->f = l_popen(L, filename, mode);
+ p->closef = &io_pclose;
+ return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
+}
+
+
+static int io_tmpfile (lua_State *L) {
+ LStream *p = newfile(L);
+ p->f = tmpfile();
+ return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1;
+}
+
+
+static FILE *getiofile (lua_State *L, const char *findex) {
+ LStream *p;
+ lua_getfield(L, LUA_REGISTRYINDEX, findex);
+ p = (LStream *)lua_touserdata(L, -1);
+ if (l_unlikely(isclosed(p)))
+ luaL_error(L, "default %s file is closed", findex + IOPREF_LEN);
+ return p->f;
+}
+
+
+static int g_iofile (lua_State *L, const char *f, const char *mode) {
+ if (!lua_isnoneornil(L, 1)) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename)
+ opencheck(L, filename, mode);
+ else {
+ tofile(L); /* check that it's a valid file handle */
+ lua_pushvalue(L, 1);
+ }
+ lua_setfield(L, LUA_REGISTRYINDEX, f);
+ }
+ /* return current value */
+ lua_getfield(L, LUA_REGISTRYINDEX, f);
+ return 1;
+}
+
+
+static int io_input (lua_State *L) {
+ return g_iofile(L, IO_INPUT, "r");
+}
+
+
+static int io_output (lua_State *L) {
+ return g_iofile(L, IO_OUTPUT, "w");
+}
+
+
+static int io_readline (lua_State *L);
+
+
+/*
+** maximum number of arguments to 'f:lines'/'io.lines' (it + 3 must fit
+** in the limit for upvalues of a closure)
+*/
+#define MAXARGLINE 250
+
+/*
+** Auxiliary function to create the iteration function for 'lines'.
+** The iteration function is a closure over 'io_readline', with
+** the following upvalues:
+** 1) The file being read (first value in the stack)
+** 2) the number of arguments to read
+** 3) a boolean, true iff file has to be closed when finished ('toclose')
+** *) a variable number of format arguments (rest of the stack)
+*/
+static void aux_lines (lua_State *L, int toclose) {
+ int n = lua_gettop(L) - 1; /* number of arguments to read */
+ luaL_argcheck(L, n <= MAXARGLINE, MAXARGLINE + 2, "too many arguments");
+ lua_pushvalue(L, 1); /* file */
+ lua_pushinteger(L, n); /* number of arguments to read */
+ lua_pushboolean(L, toclose); /* close/not close file when finished */
+ lua_rotate(L, 2, 3); /* move the three values to their positions */
+ lua_pushcclosure(L, io_readline, 3 + n);
+}
+
+
+static int f_lines (lua_State *L) {
+ tofile(L); /* check that it's a valid file handle */
+ aux_lines(L, 0);
+ return 1;
+}
+
+
+/*
+** Return an iteration function for 'io.lines'. If file has to be
+** closed, also returns the file itself as a second result (to be
+** closed as the state at the exit of a generic for).
+*/
+static int io_lines (lua_State *L) {
+ int toclose;
+ if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */
+ if (lua_isnil(L, 1)) { /* no file name? */
+ lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */
+ lua_replace(L, 1); /* put it at index 1 */
+ tofile(L); /* check that it's a valid file handle */
+ toclose = 0; /* do not close it after iteration */
+ }
+ else { /* open a new file */
+ const char *filename = luaL_checkstring(L, 1);
+ opencheck(L, filename, "r");
+ lua_replace(L, 1); /* put file at index 1 */
+ toclose = 1; /* close it after iteration */
+ }
+ aux_lines(L, toclose); /* push iteration function */
+ if (toclose) {
+ lua_pushnil(L); /* state */
+ lua_pushnil(L); /* control */
+ lua_pushvalue(L, 1); /* file is the to-be-closed variable (4th result) */
+ return 4;
+ }
+ else
+ return 1;
+}
+
+
+/*
+** {======================================================
+** READ
+** =======================================================
+*/
+
+
+/* maximum length of a numeral */
+#if !defined (L_MAXLENNUM)
+#define L_MAXLENNUM 200
+#endif
+
+
+/* auxiliary structure used by 'read_number' */
+typedef struct {
+ FILE *f; /* file being read */
+ int c; /* current character (look ahead) */
+ int n; /* number of elements in buffer 'buff' */
+ char buff[L_MAXLENNUM + 1]; /* +1 for ending '\0' */
+} RN;
+
+
+/*
+** Add current char to buffer (if not out of space) and read next one
+*/
+static int nextc (RN *rn) {
+ if (l_unlikely(rn->n >= L_MAXLENNUM)) { /* buffer overflow? */
+ rn->buff[0] = '\0'; /* invalidate result */
+ return 0; /* fail */
+ }
+ else {
+ rn->buff[rn->n++] = rn->c; /* save current char */
+ rn->c = l_getc(rn->f); /* read next one */
+ return 1;
+ }
+}
+
+
+/*
+** Accept current char if it is in 'set' (of size 2)
+*/
+static int test2 (RN *rn, const char *set) {
+ if (rn->c == set[0] || rn->c == set[1])
+ return nextc(rn);
+ else return 0;
+}
+
+
+/*
+** Read a sequence of (hex)digits
+*/
+static int readdigits (RN *rn, int hex) {
+ int count = 0;
+ while ((hex ? isxdigit(rn->c) : isdigit(rn->c)) && nextc(rn))
+ count++;
+ return count;
+}
+
+
+/*
+** Read a number: first reads a valid prefix of a numeral into a buffer.
+** Then it calls 'lua_stringtonumber' to check whether the format is
+** correct and to convert it to a Lua number.
+*/
+static int read_number (lua_State *L, FILE *f) {
+ RN rn;
+ int count = 0;
+ int hex = 0;
+ char decp[2];
+ rn.f = f; rn.n = 0;
+ decp[0] = lua_getlocaledecpoint(); /* get decimal point from locale */
+ decp[1] = '.'; /* always accept a dot */
+ l_lockfile(rn.f);
+ do { rn.c = l_getc(rn.f); } while (isspace(rn.c)); /* skip spaces */
+ test2(&rn, "-+"); /* optional sign */
+ if (test2(&rn, "00")) {
+ if (test2(&rn, "xX")) hex = 1; /* numeral is hexadecimal */
+ else count = 1; /* count initial '0' as a valid digit */
+ }
+ count += readdigits(&rn, hex); /* integral part */
+ if (test2(&rn, decp)) /* decimal point? */
+ count += readdigits(&rn, hex); /* fractional part */
+ if (count > 0 && test2(&rn, (hex ? "pP" : "eE"))) { /* exponent mark? */
+ test2(&rn, "-+"); /* exponent sign */
+ readdigits(&rn, 0); /* exponent digits */
+ }
+ ungetc(rn.c, rn.f); /* unread look-ahead char */
+ l_unlockfile(rn.f);
+ rn.buff[rn.n] = '\0'; /* finish string */
+ if (l_likely(lua_stringtonumber(L, rn.buff)))
+ return 1; /* ok, it is a valid number */
+ else { /* invalid format */
+ lua_pushnil(L); /* "result" to be removed */
+ return 0; /* read fails */
+ }
+}
+
+
+static int test_eof (lua_State *L, FILE *f) {
+ int c = getc(f);
+ ungetc(c, f); /* no-op when c == EOF */
+ lua_pushliteral(L, "");
+ return (c != EOF);
+}
+
+
+static int read_line (lua_State *L, FILE *f, int chop) {
+ luaL_Buffer b;
+ int c;
+ luaL_buffinit(L, &b);
+ do { /* may need to read several chunks to get whole line */
+ char *buff = luaL_prepbuffer(&b); /* preallocate buffer space */
+ int i = 0;
+ l_lockfile(f); /* no memory errors can happen inside the lock */
+ while (i < LUAL_BUFFERSIZE && (c = l_getc(f)) != EOF && c != '\n')
+ buff[i++] = c; /* read up to end of line or buffer limit */
+ l_unlockfile(f);
+ luaL_addsize(&b, i);
+ } while (c != EOF && c != '\n'); /* repeat until end of line */
+ if (!chop && c == '\n') /* want a newline and have one? */
+ luaL_addchar(&b, c); /* add ending newline to result */
+ luaL_pushresult(&b); /* close buffer */
+ /* return ok if read something (either a newline or something else) */
+ return (c == '\n' || lua_rawlen(L, -1) > 0);
+}
+
+
+static void read_all (lua_State *L, FILE *f) {
+ size_t nr;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ do { /* read file in chunks of LUAL_BUFFERSIZE bytes */
+ char *p = luaL_prepbuffer(&b);
+ nr = fread(p, sizeof(char), LUAL_BUFFERSIZE, f);
+ luaL_addsize(&b, nr);
+ } while (nr == LUAL_BUFFERSIZE);
+ luaL_pushresult(&b); /* close buffer */
+}
+
+
+static int read_chars (lua_State *L, FILE *f, size_t n) {
+ size_t nr; /* number of chars actually read */
+ char *p;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */
+ nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */
+ luaL_addsize(&b, nr);
+ luaL_pushresult(&b); /* close buffer */
+ return (nr > 0); /* true iff read something */
+}
+
+
+static int g_read (lua_State *L, FILE *f, int first) {
+ int nargs = lua_gettop(L) - 1;
+ int n, success;
+ clearerr(f);
+ if (nargs == 0) { /* no arguments? */
+ success = read_line(L, f, 1);
+ n = first + 1; /* to return 1 result */
+ }
+ else {
+ /* ensure stack space for all results and for auxlib's buffer */
+ luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");
+ success = 1;
+ for (n = first; nargs-- && success; n++) {
+ if (lua_type(L, n) == LUA_TNUMBER) {
+ size_t l = (size_t)luaL_checkinteger(L, n);
+ success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
+ }
+ else {
+ const char *p = luaL_checkstring(L, n);
+ if (*p == '*') p++; /* skip optional '*' (for compatibility) */
+ switch (*p) {
+ case 'n': /* number */
+ success = read_number(L, f);
+ break;
+ case 'l': /* line */
+ success = read_line(L, f, 1);
+ break;
+ case 'L': /* line with end-of-line */
+ success = read_line(L, f, 0);
+ break;
+ case 'a': /* file */
+ read_all(L, f); /* read entire file */
+ success = 1; /* always success */
+ break;
+ default:
+ return luaL_argerror(L, n, "invalid format");
+ }
+ }
+ }
+ }
+ if (ferror(f))
+ return luaL_fileresult(L, 0, NULL);
+ if (!success) {
+ lua_pop(L, 1); /* remove last result */
+ luaL_pushfail(L); /* push nil instead */
+ }
+ return n - first;
+}
+
+
+static int io_read (lua_State *L) {
+ return g_read(L, getiofile(L, IO_INPUT), 1);
+}
+
+
+static int f_read (lua_State *L) {
+ return g_read(L, tofile(L), 2);
+}
+
+
+/*
+** Iteration function for 'lines'.
+*/
+static int io_readline (lua_State *L) {
+ LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1));
+ int i;
+ int n = (int)lua_tointeger(L, lua_upvalueindex(2));
+ if (isclosed(p)) /* file is already closed? */
+ return luaL_error(L, "file is already closed");
+ lua_settop(L , 1);
+ luaL_checkstack(L, n, "too many arguments");
+ for (i = 1; i <= n; i++) /* push arguments to 'g_read' */
+ lua_pushvalue(L, lua_upvalueindex(3 + i));
+ n = g_read(L, p->f, 2); /* 'n' is number of results */
+ lua_assert(n > 0); /* should return at least a nil */
+ if (lua_toboolean(L, -n)) /* read at least one value? */
+ return n; /* return them */
+ else { /* first result is false: EOF or error */
+ if (n > 1) { /* is there error information? */
+ /* 2nd result is error message */
+ return luaL_error(L, "%s", lua_tostring(L, -n + 1));
+ }
+ if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */
+ lua_settop(L, 0); /* clear stack */
+ lua_pushvalue(L, lua_upvalueindex(1)); /* push file at index 1 */
+ aux_close(L); /* close it */
+ }
+ return 0;
+ }
+}
+
+/* }====================================================== */
+
+
+static int g_write (lua_State *L, FILE *f, int arg) {
+ int nargs = lua_gettop(L) - arg;
+ int status = 1;
+ for (; nargs--; arg++) {
+ if (lua_type(L, arg) == LUA_TNUMBER) {
+ /* optimization: could be done exactly as for strings */
+ int len = lua_isinteger(L, arg)
+ ? fprintf(f, LUA_INTEGER_FMT,
+ (LUAI_UACINT)lua_tointeger(L, arg))
+ : fprintf(f, LUA_NUMBER_FMT,
+ (LUAI_UACNUMBER)lua_tonumber(L, arg));
+ status = status && (len > 0);
+ }
+ else {
+ size_t l;
+ const char *s = luaL_checklstring(L, arg, &l);
+ status = status && (fwrite(s, sizeof(char), l, f) == l);
+ }
+ }
+ if (l_likely(status))
+ return 1; /* file handle already on stack top */
+ else return luaL_fileresult(L, status, NULL);
+}
+
+
+static int io_write (lua_State *L) {
+ return g_write(L, getiofile(L, IO_OUTPUT), 1);
+}
+
+
+static int f_write (lua_State *L) {
+ FILE *f = tofile(L);
+ lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */
+ return g_write(L, f, 2);
+}
+
+
+static int f_seek (lua_State *L) {
+ static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
+ static const char *const modenames[] = {"set", "cur", "end", NULL};
+ FILE *f = tofile(L);
+ int op = luaL_checkoption(L, 2, "cur", modenames);
+ lua_Integer p3 = luaL_optinteger(L, 3, 0);
+ l_seeknum offset = (l_seeknum)p3;
+ luaL_argcheck(L, (lua_Integer)offset == p3, 3,
+ "not an integer in proper range");
+ op = l_fseek(f, offset, mode[op]);
+ if (l_unlikely(op))
+ return luaL_fileresult(L, 0, NULL); /* error */
+ else {
+ lua_pushinteger(L, (lua_Integer)l_ftell(f));
+ return 1;
+ }
+}
+
+
+static int f_setvbuf (lua_State *L) {
+ static const int mode[] = {_IONBF, _IOFBF, _IOLBF};
+ static const char *const modenames[] = {"no", "full", "line", NULL};
+ FILE *f = tofile(L);
+ int op = luaL_checkoption(L, 2, NULL, modenames);
+ lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE);
+ int res = setvbuf(f, NULL, mode[op], (size_t)sz);
+ return luaL_fileresult(L, res == 0, NULL);
+}
+
+
+
+static int io_flush (lua_State *L) {
+ return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);
+}
+
+
+static int f_flush (lua_State *L) {
+ return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL);
+}
+
+
+/*
+** functions for 'io' library
+*/
+static const luaL_Reg iolib[] = {
+ {"close", io_close},
+ {"flush", io_flush},
+ {"input", io_input},
+ {"lines", io_lines},
+ {"open", io_open},
+ {"output", io_output},
+ {"popen", io_popen},
+ {"read", io_read},
+ {"tmpfile", io_tmpfile},
+ {"type", io_type},
+ {"write", io_write},
+ {NULL, NULL}
+};
+
+
+/*
+** methods for file handles
+*/
+static const luaL_Reg meth[] = {
+ {"read", f_read},
+ {"write", f_write},
+ {"lines", f_lines},
+ {"flush", f_flush},
+ {"seek", f_seek},
+ {"close", f_close},
+ {"setvbuf", f_setvbuf},
+ {NULL, NULL}
+};
+
+
+/*
+** metamethods for file handles
+*/
+static const luaL_Reg metameth[] = {
+ {"__index", NULL}, /* place holder */
+ {"__gc", f_gc},
+ {"__close", f_gc},
+ {"__tostring", f_tostring},
+ {NULL, NULL}
+};
+
+
+static void createmeta (lua_State *L) {
+ luaL_newmetatable(L, LUA_FILEHANDLE); /* metatable for file handles */
+ luaL_setfuncs(L, metameth, 0); /* add metamethods to new metatable */
+ luaL_newlibtable(L, meth); /* create method table */
+ luaL_setfuncs(L, meth, 0); /* add file methods to method table */
+ lua_setfield(L, -2, "__index"); /* metatable.__index = method table */
+ lua_pop(L, 1); /* pop metatable */
+}
+
+
+/*
+** function to (not) close the standard files stdin, stdout, and stderr
+*/
+static int io_noclose (lua_State *L) {
+ LStream *p = tolstream(L);
+ p->closef = &io_noclose; /* keep file opened */
+ luaL_pushfail(L);
+ lua_pushliteral(L, "cannot close standard file");
+ return 2;
+}
+
+
+static void createstdfile (lua_State *L, FILE *f, const char *k,
+ const char *fname) {
+ LStream *p = newprefile(L);
+ p->f = f;
+ p->closef = &io_noclose;
+ if (k != NULL) {
+ lua_pushvalue(L, -1);
+ lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */
+ }
+ lua_setfield(L, -2, fname); /* add file to module */
+}
+
+
+LUAMOD_API int luaopen_io (lua_State *L) {
+ luaL_newlib(L, iolib); /* new module */
+ createmeta(L);
+ /* create (and set) default files */
+ createstdfile(L, stdin, IO_INPUT, "stdin");
+ createstdfile(L, stdout, IO_OUTPUT, "stdout");
+ createstdfile(L, stderr, NULL, "stderr");
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/ljumptab.h b/source/luametatex/source/luacore/lua54/src/ljumptab.h
new file mode 100644
index 000000000..8306f250c
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ljumptab.h
@@ -0,0 +1,112 @@
+/*
+** $Id: ljumptab.h $
+** Jump Table for the Lua interpreter
+** See Copyright Notice in lua.h
+*/
+
+
+#undef vmdispatch
+#undef vmcase
+#undef vmbreak
+
+#define vmdispatch(x) goto *disptab[x];
+
+#define vmcase(l) L_##l:
+
+#define vmbreak vmfetch(); vmdispatch(GET_OPCODE(i));
+
+
+static const void *const disptab[NUM_OPCODES] = {
+
+#if 0
+** you can update the following list with this command:
+**
+** sed -n '/^OP_/\!d; s/OP_/\&\&L_OP_/ ; s/,.*/,/ ; s/\/.*// ; p' lopcodes.h
+**
+#endif
+
+&&L_OP_MOVE,
+&&L_OP_LOADI,
+&&L_OP_LOADF,
+&&L_OP_LOADK,
+&&L_OP_LOADKX,
+&&L_OP_LOADFALSE,
+&&L_OP_LFALSESKIP,
+&&L_OP_LOADTRUE,
+&&L_OP_LOADNIL,
+&&L_OP_GETUPVAL,
+&&L_OP_SETUPVAL,
+&&L_OP_GETTABUP,
+&&L_OP_GETTABLE,
+&&L_OP_GETI,
+&&L_OP_GETFIELD,
+&&L_OP_SETTABUP,
+&&L_OP_SETTABLE,
+&&L_OP_SETI,
+&&L_OP_SETFIELD,
+&&L_OP_NEWTABLE,
+&&L_OP_SELF,
+&&L_OP_ADDI,
+&&L_OP_ADDK,
+&&L_OP_SUBK,
+&&L_OP_MULK,
+&&L_OP_MODK,
+&&L_OP_POWK,
+&&L_OP_DIVK,
+&&L_OP_IDIVK,
+&&L_OP_BANDK,
+&&L_OP_BORK,
+&&L_OP_BXORK,
+&&L_OP_SHRI,
+&&L_OP_SHLI,
+&&L_OP_ADD,
+&&L_OP_SUB,
+&&L_OP_MUL,
+&&L_OP_MOD,
+&&L_OP_POW,
+&&L_OP_DIV,
+&&L_OP_IDIV,
+&&L_OP_BAND,
+&&L_OP_BOR,
+&&L_OP_BXOR,
+&&L_OP_SHL,
+&&L_OP_SHR,
+&&L_OP_MMBIN,
+&&L_OP_MMBINI,
+&&L_OP_MMBINK,
+&&L_OP_UNM,
+&&L_OP_BNOT,
+&&L_OP_NOT,
+&&L_OP_LEN,
+&&L_OP_CONCAT,
+&&L_OP_CLOSE,
+&&L_OP_TBC,
+&&L_OP_JMP,
+&&L_OP_EQ,
+&&L_OP_LT,
+&&L_OP_LE,
+&&L_OP_EQK,
+&&L_OP_EQI,
+&&L_OP_LTI,
+&&L_OP_LEI,
+&&L_OP_GTI,
+&&L_OP_GEI,
+&&L_OP_TEST,
+&&L_OP_TESTSET,
+&&L_OP_CALL,
+&&L_OP_TAILCALL,
+&&L_OP_RETURN,
+&&L_OP_RETURN0,
+&&L_OP_RETURN1,
+&&L_OP_FORLOOP,
+&&L_OP_FORPREP,
+&&L_OP_TFORPREP,
+&&L_OP_TFORCALL,
+&&L_OP_TFORLOOP,
+&&L_OP_SETLIST,
+&&L_OP_CLOSURE,
+&&L_OP_VARARG,
+&&L_OP_VARARGPREP,
+&&L_OP_EXTRAARG
+
+};
diff --git a/source/luametatex/source/luacore/lua54/src/llex.c b/source/luametatex/source/luacore/lua54/src/llex.c
new file mode 100644
index 000000000..e99151787
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/llex.c
@@ -0,0 +1,581 @@
+/*
+** $Id: llex.c $
+** Lexical Analyzer
+** See Copyright Notice in lua.h
+*/
+
+#define llex_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <locale.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lctype.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "llex.h"
+#include "lobject.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "lzio.h"
+
+
+
+#define next(ls) (ls->current = zgetc(ls->z))
+
+
+
+#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r')
+
+
+/* ORDER RESERVED */
+static const char *const luaX_tokens [] = {
+ "and", "break", "do", "else", "elseif",
+ "end", "false", "for", "function", "goto", "if",
+ "in", "local", "nil", "not", "or", "repeat",
+ "return", "then", "true", "until", "while",
+ "//", "..", "...", "==", ">=", "<=", "~=",
+ "<<", ">>", "::", "<eof>",
+ "<number>", "<integer>", "<name>", "<string>"
+};
+
+
+#define save_and_next(ls) (save(ls, ls->current), next(ls))
+
+
+static l_noret lexerror (LexState *ls, const char *msg, int token);
+
+
+static void save (LexState *ls, int c) {
+ Mbuffer *b = ls->buff;
+ if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) {
+ size_t newsize;
+ if (luaZ_sizebuffer(b) >= MAX_SIZE/2)
+ lexerror(ls, "lexical element too long", 0);
+ newsize = luaZ_sizebuffer(b) * 2;
+ luaZ_resizebuffer(ls->L, b, newsize);
+ }
+ b->buffer[luaZ_bufflen(b)++] = cast_char(c);
+}
+
+
+void luaX_init (lua_State *L) {
+ int i;
+ TString *e = luaS_newliteral(L, LUA_ENV); /* create env name */
+ luaC_fix(L, obj2gco(e)); /* never collect this name */
+ for (i=0; i<NUM_RESERVED; i++) {
+ TString *ts = luaS_new(L, luaX_tokens[i]);
+ luaC_fix(L, obj2gco(ts)); /* reserved words are never collected */
+ ts->extra = cast_byte(i+1); /* reserved word */
+ }
+}
+
+
+const char *luaX_token2str (LexState *ls, int token) {
+ if (token < FIRST_RESERVED) { /* single-byte symbols? */
+ if (lisprint(token))
+ return luaO_pushfstring(ls->L, "'%c'", token);
+ else /* control character */
+ return luaO_pushfstring(ls->L, "'<\\%d>'", token);
+ }
+ else {
+ const char *s = luaX_tokens[token - FIRST_RESERVED];
+ if (token < TK_EOS) /* fixed format (symbols and reserved words)? */
+ return luaO_pushfstring(ls->L, "'%s'", s);
+ else /* names, strings, and numerals */
+ return s;
+ }
+}
+
+
+static const char *txtToken (LexState *ls, int token) {
+ switch (token) {
+ case TK_NAME: case TK_STRING:
+ case TK_FLT: case TK_INT:
+ save(ls, '\0');
+ return luaO_pushfstring(ls->L, "'%s'", luaZ_buffer(ls->buff));
+ default:
+ return luaX_token2str(ls, token);
+ }
+}
+
+
+static l_noret lexerror (LexState *ls, const char *msg, int token) {
+ msg = luaG_addinfo(ls->L, msg, ls->source, ls->linenumber);
+ if (token)
+ luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token));
+ luaD_throw(ls->L, LUA_ERRSYNTAX);
+}
+
+
+l_noret luaX_syntaxerror (LexState *ls, const char *msg) {
+ lexerror(ls, msg, ls->t.token);
+}
+
+
+/*
+** Creates a new string and anchors it in scanner's table so that it
+** will not be collected until the end of the compilation; by that time
+** it should be anchored somewhere. It also internalizes long strings,
+** ensuring there is only one copy of each unique string. The table
+** here is used as a set: the string enters as the key, while its value
+** is irrelevant. We use the string itself as the value only because it
+** is a TValue readly available. Later, the code generation can change
+** this value.
+*/
+TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
+ lua_State *L = ls->L;
+ TString *ts = luaS_newlstr(L, str, l); /* create new string */
+ const TValue *o = luaH_getstr(ls->h, ts);
+ if (!ttisnil(o)) /* string already present? */
+ ts = keystrval(nodefromval(o)); /* get saved copy */
+ else { /* not in use yet */
+ TValue *stv = s2v(L->top++); /* reserve stack space for string */
+ setsvalue(L, stv, ts); /* temporarily anchor the string */
+ luaH_finishset(L, ls->h, stv, o, stv); /* t[string] = string */
+ /* table is not a metatable, so it does not need to invalidate cache */
+ luaC_checkGC(L);
+ L->top--; /* remove string from stack */
+ }
+ return ts;
+}
+
+
+/*
+** increment line number and skips newline sequence (any of
+** \n, \r, \n\r, or \r\n)
+*/
+static void inclinenumber (LexState *ls) {
+ int old = ls->current;
+ lua_assert(currIsNewline(ls));
+ next(ls); /* skip '\n' or '\r' */
+ if (currIsNewline(ls) && ls->current != old)
+ next(ls); /* skip '\n\r' or '\r\n' */
+ if (++ls->linenumber >= MAX_INT)
+ lexerror(ls, "chunk has too many lines", 0);
+}
+
+
+void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,
+ int firstchar) {
+ ls->t.token = 0;
+ ls->L = L;
+ ls->current = firstchar;
+ ls->lookahead.token = TK_EOS; /* no look-ahead token */
+ ls->z = z;
+ ls->fs = NULL;
+ ls->linenumber = 1;
+ ls->lastline = 1;
+ ls->source = source;
+ ls->envn = luaS_newliteral(L, LUA_ENV); /* get env name */
+ luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */
+}
+
+
+
+/*
+** =======================================================
+** LEXICAL ANALYZER
+** =======================================================
+*/
+
+
+static int check_next1 (LexState *ls, int c) {
+ if (ls->current == c) {
+ next(ls);
+ return 1;
+ }
+ else return 0;
+}
+
+
+/*
+** Check whether current char is in set 'set' (with two chars) and
+** saves it
+*/
+static int check_next2 (LexState *ls, const char *set) {
+ lua_assert(set[2] == '\0');
+ if (ls->current == set[0] || ls->current == set[1]) {
+ save_and_next(ls);
+ return 1;
+ }
+ else return 0;
+}
+
+
+/* LUA_NUMBER */
+/*
+** This function is quite liberal in what it accepts, as 'luaO_str2num'
+** will reject ill-formed numerals. Roughly, it accepts the following
+** pattern:
+**
+** %d(%x|%.|([Ee][+-]?))* | 0[Xx](%x|%.|([Pp][+-]?))*
+**
+** The only tricky part is to accept [+-] only after a valid exponent
+** mark, to avoid reading '3-4' or '0xe+1' as a single number.
+**
+** The caller might have already read an initial dot.
+*/
+static int read_numeral (LexState *ls, SemInfo *seminfo) {
+ TValue obj;
+ const char *expo = "Ee";
+ int first = ls->current;
+ lua_assert(lisdigit(ls->current));
+ save_and_next(ls);
+ if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */
+ expo = "Pp";
+ for (;;) {
+ if (check_next2(ls, expo)) /* exponent mark? */
+ check_next2(ls, "-+"); /* optional exponent sign */
+ else if (lisxdigit(ls->current) || ls->current == '.') /* '%x|%.' */
+ save_and_next(ls);
+ else break;
+ }
+ if (lislalpha(ls->current)) /* is numeral touching a letter? */
+ save_and_next(ls); /* force an error */
+ save(ls, '\0');
+ if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */
+ lexerror(ls, "malformed number", TK_FLT);
+ if (ttisinteger(&obj)) {
+ seminfo->i = ivalue(&obj);
+ return TK_INT;
+ }
+ else {
+ lua_assert(ttisfloat(&obj));
+ seminfo->r = fltvalue(&obj);
+ return TK_FLT;
+ }
+}
+
+
+/*
+** read a sequence '[=*[' or ']=*]', leaving the last bracket. If
+** sequence is well formed, return its number of '='s + 2; otherwise,
+** return 1 if it is a single bracket (no '='s and no 2nd bracket);
+** otherwise (an unfinished '[==...') return 0.
+*/
+static size_t skip_sep (LexState *ls) {
+ size_t count = 0;
+ int s = ls->current;
+ lua_assert(s == '[' || s == ']');
+ save_and_next(ls);
+ while (ls->current == '=') {
+ save_and_next(ls);
+ count++;
+ }
+ return (ls->current == s) ? count + 2
+ : (count == 0) ? 1
+ : 0;
+}
+
+
+static void read_long_string (LexState *ls, SemInfo *seminfo, size_t sep) {
+ int line = ls->linenumber; /* initial line (for error message) */
+ save_and_next(ls); /* skip 2nd '[' */
+ if (currIsNewline(ls)) /* string starts with a newline? */
+ inclinenumber(ls); /* skip it */
+ for (;;) {
+ switch (ls->current) {
+ case EOZ: { /* error */
+ const char *what = (seminfo ? "string" : "comment");
+ const char *msg = luaO_pushfstring(ls->L,
+ "unfinished long %s (starting at line %d)", what, line);
+ lexerror(ls, msg, TK_EOS);
+ break; /* to avoid warnings */
+ }
+ case ']': {
+ if (skip_sep(ls) == sep) {
+ save_and_next(ls); /* skip 2nd ']' */
+ goto endloop;
+ }
+ break;
+ }
+ case '\n': case '\r': {
+ save(ls, '\n');
+ inclinenumber(ls);
+ if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */
+ break;
+ }
+ default: {
+ if (seminfo) save_and_next(ls);
+ else next(ls);
+ }
+ }
+ } endloop:
+ if (seminfo)
+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + sep,
+ luaZ_bufflen(ls->buff) - 2 * sep);
+}
+
+
+static void esccheck (LexState *ls, int c, const char *msg) {
+ if (!c) {
+ if (ls->current != EOZ)
+ save_and_next(ls); /* add current to buffer for error message */
+ lexerror(ls, msg, TK_STRING);
+ }
+}
+
+
+static int gethexa (LexState *ls) {
+ save_and_next(ls);
+ esccheck (ls, lisxdigit(ls->current), "hexadecimal digit expected");
+ return luaO_hexavalue(ls->current);
+}
+
+
+static int readhexaesc (LexState *ls) {
+ int r = gethexa(ls);
+ r = (r << 4) + gethexa(ls);
+ luaZ_buffremove(ls->buff, 2); /* remove saved chars from buffer */
+ return r;
+}
+
+
+static unsigned long readutf8esc (LexState *ls) {
+ unsigned long r;
+ int i = 4; /* chars to be removed: '\', 'u', '{', and first digit */
+ save_and_next(ls); /* skip 'u' */
+ esccheck(ls, ls->current == '{', "missing '{'");
+ r = gethexa(ls); /* must have at least one digit */
+ while (cast_void(save_and_next(ls)), lisxdigit(ls->current)) {
+ i++;
+ esccheck(ls, r <= (0x7FFFFFFFu >> 4), "UTF-8 value too large");
+ r = (r << 4) + luaO_hexavalue(ls->current);
+ }
+ esccheck(ls, ls->current == '}', "missing '}'");
+ next(ls); /* skip '}' */
+ luaZ_buffremove(ls->buff, i); /* remove saved chars from buffer */
+ return r;
+}
+
+
+static void utf8esc (LexState *ls) {
+ char buff[UTF8BUFFSZ];
+ int n = luaO_utf8esc(buff, readutf8esc(ls));
+ for (; n > 0; n--) /* add 'buff' to string */
+ save(ls, buff[UTF8BUFFSZ - n]);
+}
+
+
+static int readdecesc (LexState *ls) {
+ int i;
+ int r = 0; /* result accumulator */
+ for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */
+ r = 10*r + ls->current - '0';
+ save_and_next(ls);
+ }
+ esccheck(ls, r <= UCHAR_MAX, "decimal escape too large");
+ luaZ_buffremove(ls->buff, i); /* remove read digits from buffer */
+ return r;
+}
+
+
+static void read_string (LexState *ls, int del, SemInfo *seminfo) {
+ save_and_next(ls); /* keep delimiter (for error messages) */
+ while (ls->current != del) {
+ switch (ls->current) {
+ case EOZ:
+ lexerror(ls, "unfinished string", TK_EOS);
+ break; /* to avoid warnings */
+ case '\n':
+ case '\r':
+ lexerror(ls, "unfinished string", TK_STRING);
+ break; /* to avoid warnings */
+ case '\\': { /* escape sequences */
+ int c; /* final character to be saved */
+ save_and_next(ls); /* keep '\\' for error messages */
+ switch (ls->current) {
+ case 'a': c = '\a'; goto read_save;
+ case 'b': c = '\b'; goto read_save;
+ case 'f': c = '\f'; goto read_save;
+ case 'n': c = '\n'; goto read_save;
+ case 'r': c = '\r'; goto read_save;
+ case 't': c = '\t'; goto read_save;
+ case 'v': c = '\v'; goto read_save;
+ case 'x': c = readhexaesc(ls); goto read_save;
+ case 'u': utf8esc(ls); goto no_save;
+ case '\n': case '\r':
+ inclinenumber(ls); c = '\n'; goto only_save;
+ case '\\': case '\"': case '\'':
+ c = ls->current; goto read_save;
+ case EOZ: goto no_save; /* will raise an error next loop */
+ case 'z': { /* zap following span of spaces */
+ luaZ_buffremove(ls->buff, 1); /* remove '\\' */
+ next(ls); /* skip the 'z' */
+ while (lisspace(ls->current)) {
+ if (currIsNewline(ls)) inclinenumber(ls);
+ else next(ls);
+ }
+ goto no_save;
+ }
+ default: {
+ esccheck(ls, lisdigit(ls->current), "invalid escape sequence");
+ c = readdecesc(ls); /* digital escape '\ddd' */
+ goto only_save;
+ }
+ }
+ read_save:
+ next(ls);
+ /* go through */
+ only_save:
+ luaZ_buffremove(ls->buff, 1); /* remove '\\' */
+ save(ls, c);
+ /* go through */
+ no_save: break;
+ }
+ default:
+ save_and_next(ls);
+ }
+ }
+ save_and_next(ls); /* skip delimiter */
+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,
+ luaZ_bufflen(ls->buff) - 2);
+}
+
+
+static int llex (LexState *ls, SemInfo *seminfo) {
+ luaZ_resetbuffer(ls->buff);
+ for (;;) {
+ switch (ls->current) {
+ case '\n': case '\r': { /* line breaks */
+ inclinenumber(ls);
+ break;
+ }
+ case ' ': case '\f': case '\t': case '\v': { /* spaces */
+ next(ls);
+ break;
+ }
+ case '-': { /* '-' or '--' (comment) */
+ next(ls);
+ if (ls->current != '-') return '-';
+ /* else is a comment */
+ next(ls);
+ if (ls->current == '[') { /* long comment? */
+ size_t sep = skip_sep(ls);
+ luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */
+ if (sep >= 2) {
+ read_long_string(ls, NULL, sep); /* skip long comment */
+ luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */
+ break;
+ }
+ }
+ /* else short comment */
+ while (!currIsNewline(ls) && ls->current != EOZ)
+ next(ls); /* skip until end of line (or end of file) */
+ break;
+ }
+ case '[': { /* long string or simply '[' */
+ size_t sep = skip_sep(ls);
+ if (sep >= 2) {
+ read_long_string(ls, seminfo, sep);
+ return TK_STRING;
+ }
+ else if (sep == 0) /* '[=...' missing second bracket? */
+ lexerror(ls, "invalid long string delimiter", TK_STRING);
+ return '[';
+ }
+ case '=': {
+ next(ls);
+ if (check_next1(ls, '=')) return TK_EQ; /* '==' */
+ else return '=';
+ }
+ case '<': {
+ next(ls);
+ if (check_next1(ls, '=')) return TK_LE; /* '<=' */
+ else if (check_next1(ls, '<')) return TK_SHL; /* '<<' */
+ else return '<';
+ }
+ case '>': {
+ next(ls);
+ if (check_next1(ls, '=')) return TK_GE; /* '>=' */
+ else if (check_next1(ls, '>')) return TK_SHR; /* '>>' */
+ else return '>';
+ }
+ case '/': {
+ next(ls);
+ if (check_next1(ls, '/')) return TK_IDIV; /* '//' */
+ else return '/';
+ }
+ case '~': {
+ next(ls);
+ if (check_next1(ls, '=')) return TK_NE; /* '~=' */
+ else return '~';
+ }
+ case ':': {
+ next(ls);
+ if (check_next1(ls, ':')) return TK_DBCOLON; /* '::' */
+ else return ':';
+ }
+ case '"': case '\'': { /* short literal strings */
+ read_string(ls, ls->current, seminfo);
+ return TK_STRING;
+ }
+ case '.': { /* '.', '..', '...', or number */
+ save_and_next(ls);
+ if (check_next1(ls, '.')) {
+ if (check_next1(ls, '.'))
+ return TK_DOTS; /* '...' */
+ else return TK_CONCAT; /* '..' */
+ }
+ else if (!lisdigit(ls->current)) return '.';
+ else return read_numeral(ls, seminfo);
+ }
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9': {
+ return read_numeral(ls, seminfo);
+ }
+ case EOZ: {
+ return TK_EOS;
+ }
+ default: {
+ if (lislalpha(ls->current)) { /* identifier or reserved word? */
+ TString *ts;
+ do {
+ save_and_next(ls);
+ } while (lislalnum(ls->current));
+ ts = luaX_newstring(ls, luaZ_buffer(ls->buff),
+ luaZ_bufflen(ls->buff));
+ seminfo->ts = ts;
+ if (isreserved(ts)) /* reserved word? */
+ return ts->extra - 1 + FIRST_RESERVED;
+ else {
+ return TK_NAME;
+ }
+ }
+ else { /* single-char tokens ('+', '*', '%', '{', '}', ...) */
+ int c = ls->current;
+ next(ls);
+ return c;
+ }
+ }
+ }
+ }
+}
+
+
+void luaX_next (LexState *ls) {
+ ls->lastline = ls->linenumber;
+ if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */
+ ls->t = ls->lookahead; /* use this one */
+ ls->lookahead.token = TK_EOS; /* and discharge it */
+ }
+ else
+ ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */
+}
+
+
+int luaX_lookahead (LexState *ls) {
+ lua_assert(ls->lookahead.token == TK_EOS);
+ ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);
+ return ls->lookahead.token;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/llex.h b/source/luametatex/source/luacore/lua54/src/llex.h
new file mode 100644
index 000000000..389d2f863
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/llex.h
@@ -0,0 +1,91 @@
+/*
+** $Id: llex.h $
+** Lexical Analyzer
+** See Copyright Notice in lua.h
+*/
+
+#ifndef llex_h
+#define llex_h
+
+#include <limits.h>
+
+#include "lobject.h"
+#include "lzio.h"
+
+
+/*
+** Single-char tokens (terminal symbols) are represented by their own
+** numeric code. Other tokens start at the following value.
+*/
+#define FIRST_RESERVED (UCHAR_MAX + 1)
+
+
+#if !defined(LUA_ENV)
+#define LUA_ENV "_ENV"
+#endif
+
+
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER RESERVED"
+*/
+enum RESERVED {
+ /* terminal symbols denoted by reserved words */
+ TK_AND = FIRST_RESERVED, TK_BREAK,
+ TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
+ TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
+ TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
+ /* other terminal symbols */
+ TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE,
+ TK_SHL, TK_SHR,
+ TK_DBCOLON, TK_EOS,
+ TK_FLT, TK_INT, TK_NAME, TK_STRING
+};
+
+/* number of reserved words */
+#define NUM_RESERVED (cast_int(TK_WHILE-FIRST_RESERVED + 1))
+
+
+typedef union {
+ lua_Number r;
+ lua_Integer i;
+ TString *ts;
+} SemInfo; /* semantics information */
+
+
+typedef struct Token {
+ int token;
+ SemInfo seminfo;
+} Token;
+
+
+/* state of the lexer plus state of the parser when shared by all
+ functions */
+typedef struct LexState {
+ int current; /* current character (charint) */
+ int linenumber; /* input line counter */
+ int lastline; /* line of last token 'consumed' */
+ Token t; /* current token */
+ Token lookahead; /* look ahead token */
+ struct FuncState *fs; /* current function (parser) */
+ struct lua_State *L;
+ ZIO *z; /* input stream */
+ Mbuffer *buff; /* buffer for tokens */
+ Table *h; /* to avoid collection/reuse strings */
+ struct Dyndata *dyd; /* dynamic structures used by the parser */
+ TString *source; /* current source name */
+ TString *envn; /* environment variable name */
+} LexState;
+
+
+LUAI_FUNC void luaX_init (lua_State *L);
+LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,
+ TString *source, int firstchar);
+LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);
+LUAI_FUNC void luaX_next (LexState *ls);
+LUAI_FUNC int luaX_lookahead (LexState *ls);
+LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s);
+LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/llimits.h b/source/luametatex/source/luacore/lua54/src/llimits.h
new file mode 100644
index 000000000..52a32f92e
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/llimits.h
@@ -0,0 +1,367 @@
+/*
+** $Id: llimits.h $
+** Limits, basic types, and some other 'installation-dependent' definitions
+** See Copyright Notice in lua.h
+*/
+
+#ifndef llimits_h
+#define llimits_h
+
+
+#include <limits.h>
+#include <stddef.h>
+
+
+#include "lua.h"
+
+
+/*
+** 'lu_mem' and 'l_mem' are unsigned/signed integers big enough to count
+** the total memory used by Lua (in bytes). Usually, 'size_t' and
+** 'ptrdiff_t' should work, but we use 'long' for 16-bit machines.
+*/
+#if defined(LUAI_MEM) /* { external definitions? */
+typedef LUAI_UMEM lu_mem;
+typedef LUAI_MEM l_mem;
+#elif LUAI_IS32INT /* }{ */
+typedef size_t lu_mem;
+typedef ptrdiff_t l_mem;
+#else /* 16-bit ints */ /* }{ */
+typedef unsigned long lu_mem;
+typedef long l_mem;
+#endif /* } */
+
+
+/* chars used as small naturals (so that 'char' is reserved for characters) */
+typedef unsigned char lu_byte;
+typedef signed char ls_byte;
+
+
+/* maximum value for size_t */
+#define MAX_SIZET ((size_t)(~(size_t)0))
+
+/* maximum size visible for Lua (must be representable in a lua_Integer) */
+#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \
+ : (size_t)(LUA_MAXINTEGER))
+
+
+#define MAX_LUMEM ((lu_mem)(~(lu_mem)0))
+
+#define MAX_LMEM ((l_mem)(MAX_LUMEM >> 1))
+
+
+#define MAX_INT INT_MAX /* maximum value of an int */
+
+
+/*
+** floor of the log2 of the maximum signed value for integral type 't'.
+** (That is, maximum 'n' such that '2^n' fits in the given signed type.)
+*/
+#define log2maxs(t) (sizeof(t) * 8 - 2)
+
+
+/*
+** test whether an unsigned value is a power of 2 (or zero)
+*/
+#define ispow2(x) (((x) & ((x) - 1)) == 0)
+
+
+/* number of chars of a literal string without the ending \0 */
+#define LL(x) (sizeof(x)/sizeof(char) - 1)
+
+
+/*
+** conversion of pointer to unsigned integer:
+** this is for hashing only; there is no problem if the integer
+** cannot hold the whole pointer value
+*/
+#define point2uint(p) ((unsigned int)((size_t)(p) & UINT_MAX))
+
+
+
+/* types of 'usual argument conversions' for lua_Number and lua_Integer */
+typedef LUAI_UACNUMBER l_uacNumber;
+typedef LUAI_UACINT l_uacInt;
+
+
+/*
+** Internal assertions for in-house debugging
+*/
+#if defined LUAI_ASSERT
+#undef NDEBUG
+#include <assert.h>
+#define lua_assert(c) assert(c)
+#endif
+
+#if defined(lua_assert)
+#define check_exp(c,e) (lua_assert(c), (e))
+/* to avoid problems with conditions too long */
+#define lua_longassert(c) ((c) ? (void)0 : lua_assert(0))
+#else
+#define lua_assert(c) ((void)0)
+#define check_exp(c,e) (e)
+#define lua_longassert(c) ((void)0)
+#endif
+
+/*
+** assertion for checking API calls
+*/
+#if !defined(luai_apicheck)
+#define luai_apicheck(l,e) ((void)l, lua_assert(e))
+#endif
+
+#define api_check(l,e,msg) luai_apicheck(l,(e) && msg)
+
+
+/* macro to avoid warnings about unused variables */
+#if !defined(UNUSED)
+#define UNUSED(x) ((void)(x))
+#endif
+
+
+/* type casts (a macro highlights casts in the code) */
+#define cast(t, exp) ((t)(exp))
+
+#define cast_void(i) cast(void, (i))
+#define cast_voidp(i) cast(void *, (i))
+#define cast_num(i) cast(lua_Number, (i))
+#define cast_int(i) cast(int, (i))
+#define cast_uint(i) cast(unsigned int, (i))
+#define cast_byte(i) cast(lu_byte, (i))
+#define cast_uchar(i) cast(unsigned char, (i))
+#define cast_char(i) cast(char, (i))
+#define cast_charp(i) cast(char *, (i))
+#define cast_sizet(i) cast(size_t, (i))
+
+
+/* cast a signed lua_Integer to lua_Unsigned */
+#if !defined(l_castS2U)
+#define l_castS2U(i) ((lua_Unsigned)(i))
+#endif
+
+/*
+** cast a lua_Unsigned to a signed lua_Integer; this cast is
+** not strict ISO C, but two-complement architectures should
+** work fine.
+*/
+#if !defined(l_castU2S)
+#define l_castU2S(i) ((lua_Integer)(i))
+#endif
+
+
+/*
+** non-return type
+*/
+#if !defined(l_noret)
+
+#if defined(__GNUC__)
+#define l_noret void __attribute__((noreturn))
+#elif defined(_MSC_VER) && _MSC_VER >= 1200
+#define l_noret void __declspec(noreturn)
+#else
+#define l_noret void
+#endif
+
+#endif
+
+
+/*
+** Inline functions
+*/
+#if !defined(LUA_USE_C89)
+#define l_inline inline
+#elif defined(__GNUC__)
+#define l_inline __inline__
+#else
+#define l_inline /* empty */
+#endif
+
+#define l_sinline static l_inline
+
+
+/*
+** type for virtual-machine instructions;
+** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
+*/
+#if LUAI_IS32INT
+typedef unsigned int l_uint32;
+#else
+typedef unsigned long l_uint32;
+#endif
+
+typedef l_uint32 Instruction;
+
+
+
+/*
+** Maximum length for short strings, that is, strings that are
+** internalized. (Cannot be smaller than reserved words or tags for
+** metamethods, as these strings must be internalized;
+** #("function") = 8, #("__newindex") = 10.)
+*/
+#if !defined(LUAI_MAXSHORTLEN)
+#define LUAI_MAXSHORTLEN 40
+#endif
+
+
+/*
+** Initial size for the string table (must be power of 2).
+** The Lua core alone registers ~50 strings (reserved words +
+** metaevent keys + a few others). Libraries would typically add
+** a few dozens more.
+*/
+#if !defined(MINSTRTABSIZE)
+#define MINSTRTABSIZE 128
+#endif
+
+
+/*
+** Size of cache for strings in the API. 'N' is the number of
+** sets (better be a prime) and "M" is the size of each set (M == 1
+** makes a direct cache.)
+*/
+#if !defined(STRCACHE_N)
+#define STRCACHE_N 53
+#define STRCACHE_M 2
+#endif
+
+
+/* minimum size for string buffer */
+#if !defined(LUA_MINBUFFER)
+#define LUA_MINBUFFER 32
+#endif
+
+
+/*
+** Maximum depth for nested C calls, syntactical nested non-terminals,
+** and other features implemented through recursion in C. (Value must
+** fit in a 16-bit unsigned integer. It must also be compatible with
+** the size of the C stack.)
+*/
+#if !defined(LUAI_MAXCCALLS)
+#define LUAI_MAXCCALLS 200
+#endif
+
+
+/*
+** macros that are executed whenever program enters the Lua core
+** ('lua_lock') and leaves the core ('lua_unlock')
+*/
+#if !defined(lua_lock)
+#define lua_lock(L) ((void) 0)
+#define lua_unlock(L) ((void) 0)
+#endif
+
+/*
+** macro executed during Lua functions at points where the
+** function can yield.
+*/
+#if !defined(luai_threadyield)
+#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);}
+#endif
+
+
+/*
+** these macros allow user-specific actions when a thread is
+** created/deleted/resumed/yielded.
+*/
+#if !defined(luai_userstateopen)
+#define luai_userstateopen(L) ((void)L)
+#endif
+
+#if !defined(luai_userstateclose)
+#define luai_userstateclose(L) ((void)L)
+#endif
+
+#if !defined(luai_userstatethread)
+#define luai_userstatethread(L,L1) ((void)L)
+#endif
+
+#if !defined(luai_userstatefree)
+#define luai_userstatefree(L,L1) ((void)L)
+#endif
+
+#if !defined(luai_userstateresume)
+#define luai_userstateresume(L,n) ((void)L)
+#endif
+
+#if !defined(luai_userstateyield)
+#define luai_userstateyield(L,n) ((void)L)
+#endif
+
+
+
+/*
+** The luai_num* macros define the primitive operations over numbers.
+*/
+
+/* floor division (defined as 'floor(a/b)') */
+#if !defined(luai_numidiv)
+#define luai_numidiv(L,a,b) ((void)L, l_floor(luai_numdiv(L,a,b)))
+#endif
+
+/* float division */
+#if !defined(luai_numdiv)
+#define luai_numdiv(L,a,b) ((a)/(b))
+#endif
+
+/*
+** modulo: defined as 'a - floor(a/b)*b'; the direct computation
+** using this definition has several problems with rounding errors,
+** so it is better to use 'fmod'. 'fmod' gives the result of
+** 'a - trunc(a/b)*b', and therefore must be corrected when
+** 'trunc(a/b) ~= floor(a/b)'. That happens when the division has a
+** non-integer negative result: non-integer result is equivalent to
+** a non-zero remainder 'm'; negative result is equivalent to 'a' and
+** 'b' with different signs, or 'm' and 'b' with different signs
+** (as the result 'm' of 'fmod' has the same sign of 'a').
+*/
+#if !defined(luai_nummod)
+#define luai_nummod(L,a,b,m) \
+ { (void)L; (m) = l_mathop(fmod)(a,b); \
+ if (((m) > 0) ? (b) < 0 : ((m) < 0 && (b) > 0)) (m) += (b); }
+#endif
+
+/* exponentiation */
+#if !defined(luai_numpow)
+#define luai_numpow(L,a,b) \
+ ((void)L, (b == 2) ? (a)*(a) : l_mathop(pow)(a,b))
+#endif
+
+/* the others are quite standard operations */
+#if !defined(luai_numadd)
+#define luai_numadd(L,a,b) ((a)+(b))
+#define luai_numsub(L,a,b) ((a)-(b))
+#define luai_nummul(L,a,b) ((a)*(b))
+#define luai_numunm(L,a) (-(a))
+#define luai_numeq(a,b) ((a)==(b))
+#define luai_numlt(a,b) ((a)<(b))
+#define luai_numle(a,b) ((a)<=(b))
+#define luai_numgt(a,b) ((a)>(b))
+#define luai_numge(a,b) ((a)>=(b))
+#define luai_numisnan(a) (!luai_numeq((a), (a)))
+#endif
+
+
+
+
+
+/*
+** macro to control inclusion of some hard tests on stack reallocation
+*/
+#if !defined(HARDSTACKTESTS)
+#define condmovestack(L,pre,pos) ((void)0)
+#else
+/* realloc stack keeping its size */
+#define condmovestack(L,pre,pos) \
+ { int sz_ = stacksize(L); pre; luaD_reallocstack((L), sz_, 0); pos; }
+#endif
+
+#if !defined(HARDMEMTESTS)
+#define condchangemem(L,pre,pos) ((void)0)
+#else
+#define condchangemem(L,pre,pos) \
+ { if (gcrunning(G(L))) { pre; luaC_fullgc(L, 0); pos; } }
+#endif
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lmathlib.c b/source/luametatex/source/luacore/lua54/src/lmathlib.c
new file mode 100644
index 000000000..e0c61a168
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lmathlib.c
@@ -0,0 +1,764 @@
+/*
+** $Id: lmathlib.c $
+** Standard mathematical library
+** See Copyright Notice in lua.h
+*/
+
+#define lmathlib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <float.h>
+#include <limits.h>
+#include <math.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+#undef PI
+#define PI (l_mathop(3.141592653589793238462643383279502884))
+
+
+static int math_abs (lua_State *L) {
+ if (lua_isinteger(L, 1)) {
+ lua_Integer n = lua_tointeger(L, 1);
+ if (n < 0) n = (lua_Integer)(0u - (lua_Unsigned)n);
+ lua_pushinteger(L, n);
+ }
+ else
+ lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_sin (lua_State *L) {
+ lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_cos (lua_State *L) {
+ lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_tan (lua_State *L) {
+ lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_asin (lua_State *L) {
+ lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_acos (lua_State *L) {
+ lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_atan (lua_State *L) {
+ lua_Number y = luaL_checknumber(L, 1);
+ lua_Number x = luaL_optnumber(L, 2, 1);
+ lua_pushnumber(L, l_mathop(atan2)(y, x));
+ return 1;
+}
+
+
+static int math_toint (lua_State *L) {
+ int valid;
+ lua_Integer n = lua_tointegerx(L, 1, &valid);
+ if (l_likely(valid))
+ lua_pushinteger(L, n);
+ else {
+ luaL_checkany(L, 1);
+ luaL_pushfail(L); /* value is not convertible to integer */
+ }
+ return 1;
+}
+
+
+static void pushnumint (lua_State *L, lua_Number d) {
+ lua_Integer n;
+ if (lua_numbertointeger(d, &n)) /* does 'd' fit in an integer? */
+ lua_pushinteger(L, n); /* result is integer */
+ else
+ lua_pushnumber(L, d); /* result is float */
+}
+
+
+static int math_floor (lua_State *L) {
+ if (lua_isinteger(L, 1))
+ lua_settop(L, 1); /* integer is its own floor */
+ else {
+ lua_Number d = l_mathop(floor)(luaL_checknumber(L, 1));
+ pushnumint(L, d);
+ }
+ return 1;
+}
+
+
+static int math_ceil (lua_State *L) {
+ if (lua_isinteger(L, 1))
+ lua_settop(L, 1); /* integer is its own ceil */
+ else {
+ lua_Number d = l_mathop(ceil)(luaL_checknumber(L, 1));
+ pushnumint(L, d);
+ }
+ return 1;
+}
+
+
+static int math_fmod (lua_State *L) {
+ if (lua_isinteger(L, 1) && lua_isinteger(L, 2)) {
+ lua_Integer d = lua_tointeger(L, 2);
+ if ((lua_Unsigned)d + 1u <= 1u) { /* special cases: -1 or 0 */
+ luaL_argcheck(L, d != 0, 2, "zero");
+ lua_pushinteger(L, 0); /* avoid overflow with 0x80000... / -1 */
+ }
+ else
+ lua_pushinteger(L, lua_tointeger(L, 1) % d);
+ }
+ else
+ lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1),
+ luaL_checknumber(L, 2)));
+ return 1;
+}
+
+
+/*
+** next function does not use 'modf', avoiding problems with 'double*'
+** (which is not compatible with 'float*') when lua_Number is not
+** 'double'.
+*/
+static int math_modf (lua_State *L) {
+ if (lua_isinteger(L ,1)) {
+ lua_settop(L, 1); /* number is its own integer part */
+ lua_pushnumber(L, 0); /* no fractional part */
+ }
+ else {
+ lua_Number n = luaL_checknumber(L, 1);
+ /* integer part (rounds toward zero) */
+ lua_Number ip = (n < 0) ? l_mathop(ceil)(n) : l_mathop(floor)(n);
+ pushnumint(L, ip);
+ /* fractional part (test needed for inf/-inf) */
+ lua_pushnumber(L, (n == ip) ? l_mathop(0.0) : (n - ip));
+ }
+ return 2;
+}
+
+
+static int math_sqrt (lua_State *L) {
+ lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+
+static int math_ult (lua_State *L) {
+ lua_Integer a = luaL_checkinteger(L, 1);
+ lua_Integer b = luaL_checkinteger(L, 2);
+ lua_pushboolean(L, (lua_Unsigned)a < (lua_Unsigned)b);
+ return 1;
+}
+
+static int math_log (lua_State *L) {
+ lua_Number x = luaL_checknumber(L, 1);
+ lua_Number res;
+ if (lua_isnoneornil(L, 2))
+ res = l_mathop(log)(x);
+ else {
+ lua_Number base = luaL_checknumber(L, 2);
+#if !defined(LUA_USE_C89)
+ if (base == l_mathop(2.0))
+ res = l_mathop(log2)(x);
+ else
+#endif
+ if (base == l_mathop(10.0))
+ res = l_mathop(log10)(x);
+ else
+ res = l_mathop(log)(x)/l_mathop(log)(base);
+ }
+ lua_pushnumber(L, res);
+ return 1;
+}
+
+static int math_exp (lua_State *L) {
+ lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_deg (lua_State *L) {
+ lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI));
+ return 1;
+}
+
+static int math_rad (lua_State *L) {
+ lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0)));
+ return 1;
+}
+
+
+static int math_min (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int imin = 1; /* index of current minimum value */
+ int i;
+ luaL_argcheck(L, n >= 1, 1, "value expected");
+ for (i = 2; i <= n; i++) {
+ if (lua_compare(L, i, imin, LUA_OPLT))
+ imin = i;
+ }
+ lua_pushvalue(L, imin);
+ return 1;
+}
+
+
+static int math_max (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int imax = 1; /* index of current maximum value */
+ int i;
+ luaL_argcheck(L, n >= 1, 1, "value expected");
+ for (i = 2; i <= n; i++) {
+ if (lua_compare(L, imax, i, LUA_OPLT))
+ imax = i;
+ }
+ lua_pushvalue(L, imax);
+ return 1;
+}
+
+
+static int math_type (lua_State *L) {
+ if (lua_type(L, 1) == LUA_TNUMBER)
+ lua_pushstring(L, (lua_isinteger(L, 1)) ? "integer" : "float");
+ else {
+ luaL_checkany(L, 1);
+ luaL_pushfail(L);
+ }
+ return 1;
+}
+
+
+
+/*
+** {==================================================================
+** Pseudo-Random Number Generator based on 'xoshiro256**'.
+** ===================================================================
+*/
+
+/* number of binary digits in the mantissa of a float */
+#define FIGS l_floatatt(MANT_DIG)
+
+#if FIGS > 64
+/* there are only 64 random bits; use them all */
+#undef FIGS
+#define FIGS 64
+#endif
+
+
+/*
+** LUA_RAND32 forces the use of 32-bit integers in the implementation
+** of the PRN generator (mainly for testing).
+*/
+#if !defined(LUA_RAND32) && !defined(Rand64)
+
+/* try to find an integer type with at least 64 bits */
+
+#if (ULONG_MAX >> 31 >> 31) >= 3
+
+/* 'long' has at least 64 bits */
+#define Rand64 unsigned long
+
+#elif !defined(LUA_USE_C89) && defined(LLONG_MAX)
+
+/* there is a 'long long' type (which must have at least 64 bits) */
+#define Rand64 unsigned long long
+
+#elif (LUA_MAXUNSIGNED >> 31 >> 31) >= 3
+
+/* 'lua_Integer' has at least 64 bits */
+#define Rand64 lua_Unsigned
+
+#endif
+
+#endif
+
+
+#if defined(Rand64) /* { */
+
+/*
+** Standard implementation, using 64-bit integers.
+** If 'Rand64' has more than 64 bits, the extra bits do not interfere
+** with the 64 initial bits, except in a right shift. Moreover, the
+** final result has to discard the extra bits.
+*/
+
+/* avoid using extra bits when needed */
+#define trim64(x) ((x) & 0xffffffffffffffffu)
+
+
+/* rotate left 'x' by 'n' bits */
+static Rand64 rotl (Rand64 x, int n) {
+ return (x << n) | (trim64(x) >> (64 - n));
+}
+
+static Rand64 nextrand (Rand64 *state) {
+ Rand64 state0 = state[0];
+ Rand64 state1 = state[1];
+ Rand64 state2 = state[2] ^ state0;
+ Rand64 state3 = state[3] ^ state1;
+ Rand64 res = rotl(state1 * 5, 7) * 9;
+ state[0] = state0 ^ state3;
+ state[1] = state1 ^ state2;
+ state[2] = state2 ^ (state1 << 17);
+ state[3] = rotl(state3, 45);
+ return res;
+}
+
+
+/* must take care to not shift stuff by more than 63 slots */
+
+
+/*
+** Convert bits from a random integer into a float in the
+** interval [0,1), getting the higher FIG bits from the
+** random unsigned integer and converting that to a float.
+*/
+
+/* must throw out the extra (64 - FIGS) bits */
+#define shift64_FIG (64 - FIGS)
+
+/* to scale to [0, 1), multiply by scaleFIG = 2^(-FIGS) */
+#define scaleFIG (l_mathop(0.5) / ((Rand64)1 << (FIGS - 1)))
+
+static lua_Number I2d (Rand64 x) {
+ return (lua_Number)(trim64(x) >> shift64_FIG) * scaleFIG;
+}
+
+/* convert a 'Rand64' to a 'lua_Unsigned' */
+#define I2UInt(x) ((lua_Unsigned)trim64(x))
+
+/* convert a 'lua_Unsigned' to a 'Rand64' */
+#define Int2I(x) ((Rand64)(x))
+
+
+#else /* no 'Rand64' }{ */
+
+/* get an integer with at least 32 bits */
+#if LUAI_IS32INT
+typedef unsigned int lu_int32;
+#else
+typedef unsigned long lu_int32;
+#endif
+
+
+/*
+** Use two 32-bit integers to represent a 64-bit quantity.
+*/
+typedef struct Rand64 {
+ lu_int32 h; /* higher half */
+ lu_int32 l; /* lower half */
+} Rand64;
+
+
+/*
+** If 'lu_int32' has more than 32 bits, the extra bits do not interfere
+** with the 32 initial bits, except in a right shift and comparisons.
+** Moreover, the final result has to discard the extra bits.
+*/
+
+/* avoid using extra bits when needed */
+#define trim32(x) ((x) & 0xffffffffu)
+
+
+/*
+** basic operations on 'Rand64' values
+*/
+
+/* build a new Rand64 value */
+static Rand64 packI (lu_int32 h, lu_int32 l) {
+ Rand64 result;
+ result.h = h;
+ result.l = l;
+ return result;
+}
+
+/* return i << n */
+static Rand64 Ishl (Rand64 i, int n) {
+ lua_assert(n > 0 && n < 32);
+ return packI((i.h << n) | (trim32(i.l) >> (32 - n)), i.l << n);
+}
+
+/* i1 ^= i2 */
+static void Ixor (Rand64 *i1, Rand64 i2) {
+ i1->h ^= i2.h;
+ i1->l ^= i2.l;
+}
+
+/* return i1 + i2 */
+static Rand64 Iadd (Rand64 i1, Rand64 i2) {
+ Rand64 result = packI(i1.h + i2.h, i1.l + i2.l);
+ if (trim32(result.l) < trim32(i1.l)) /* carry? */
+ result.h++;
+ return result;
+}
+
+/* return i * 5 */
+static Rand64 times5 (Rand64 i) {
+ return Iadd(Ishl(i, 2), i); /* i * 5 == (i << 2) + i */
+}
+
+/* return i * 9 */
+static Rand64 times9 (Rand64 i) {
+ return Iadd(Ishl(i, 3), i); /* i * 9 == (i << 3) + i */
+}
+
+/* return 'i' rotated left 'n' bits */
+static Rand64 rotl (Rand64 i, int n) {
+ lua_assert(n > 0 && n < 32);
+ return packI((i.h << n) | (trim32(i.l) >> (32 - n)),
+ (trim32(i.h) >> (32 - n)) | (i.l << n));
+}
+
+/* for offsets larger than 32, rotate right by 64 - offset */
+static Rand64 rotl1 (Rand64 i, int n) {
+ lua_assert(n > 32 && n < 64);
+ n = 64 - n;
+ return packI((trim32(i.h) >> n) | (i.l << (32 - n)),
+ (i.h << (32 - n)) | (trim32(i.l) >> n));
+}
+
+/*
+** implementation of 'xoshiro256**' algorithm on 'Rand64' values
+*/
+static Rand64 nextrand (Rand64 *state) {
+ Rand64 res = times9(rotl(times5(state[1]), 7));
+ Rand64 t = Ishl(state[1], 17);
+ Ixor(&state[2], state[0]);
+ Ixor(&state[3], state[1]);
+ Ixor(&state[1], state[2]);
+ Ixor(&state[0], state[3]);
+ Ixor(&state[2], t);
+ state[3] = rotl1(state[3], 45);
+ return res;
+}
+
+
+/*
+** Converts a 'Rand64' into a float.
+*/
+
+/* an unsigned 1 with proper type */
+#define UONE ((lu_int32)1)
+
+
+#if FIGS <= 32
+
+/* 2^(-FIGS) */
+#define scaleFIG (l_mathop(0.5) / (UONE << (FIGS - 1)))
+
+/*
+** get up to 32 bits from higher half, shifting right to
+** throw out the extra bits.
+*/
+static lua_Number I2d (Rand64 x) {
+ lua_Number h = (lua_Number)(trim32(x.h) >> (32 - FIGS));
+ return h * scaleFIG;
+}
+
+#else /* 32 < FIGS <= 64 */
+
+/* must take care to not shift stuff by more than 31 slots */
+
+/* 2^(-FIGS) = 1.0 / 2^30 / 2^3 / 2^(FIGS-33) */
+#define scaleFIG \
+ (l_mathop(1.0) / (UONE << 30) / l_mathop(8.0) / (UONE << (FIGS - 33)))
+
+/*
+** use FIGS - 32 bits from lower half, throwing out the other
+** (32 - (FIGS - 32)) = (64 - FIGS) bits
+*/
+#define shiftLOW (64 - FIGS)
+
+/*
+** higher 32 bits go after those (FIGS - 32) bits: shiftHI = 2^(FIGS - 32)
+*/
+#define shiftHI ((lua_Number)(UONE << (FIGS - 33)) * l_mathop(2.0))
+
+
+static lua_Number I2d (Rand64 x) {
+ lua_Number h = (lua_Number)trim32(x.h) * shiftHI;
+ lua_Number l = (lua_Number)(trim32(x.l) >> shiftLOW);
+ return (h + l) * scaleFIG;
+}
+
+#endif
+
+
+/* convert a 'Rand64' to a 'lua_Unsigned' */
+static lua_Unsigned I2UInt (Rand64 x) {
+ return ((lua_Unsigned)trim32(x.h) << 31 << 1) | (lua_Unsigned)trim32(x.l);
+}
+
+/* convert a 'lua_Unsigned' to a 'Rand64' */
+static Rand64 Int2I (lua_Unsigned n) {
+ return packI((lu_int32)(n >> 31 >> 1), (lu_int32)n);
+}
+
+#endif /* } */
+
+
+/*
+** A state uses four 'Rand64' values.
+*/
+typedef struct {
+ Rand64 s[4];
+} RanState;
+
+
+/*
+** Project the random integer 'ran' into the interval [0, n].
+** Because 'ran' has 2^B possible values, the projection can only be
+** uniform when the size of the interval is a power of 2 (exact
+** division). Otherwise, to get a uniform projection into [0, n], we
+** first compute 'lim', the smallest Mersenne number not smaller than
+** 'n'. We then project 'ran' into the interval [0, lim]. If the result
+** is inside [0, n], we are done. Otherwise, we try with another 'ran',
+** until we have a result inside the interval.
+*/
+static lua_Unsigned project (lua_Unsigned ran, lua_Unsigned n,
+ RanState *state) {
+ if ((n & (n + 1)) == 0) /* is 'n + 1' a power of 2? */
+ return ran & n; /* no bias */
+ else {
+ lua_Unsigned lim = n;
+ /* compute the smallest (2^b - 1) not smaller than 'n' */
+ lim |= (lim >> 1);
+ lim |= (lim >> 2);
+ lim |= (lim >> 4);
+ lim |= (lim >> 8);
+ lim |= (lim >> 16);
+#if (LUA_MAXUNSIGNED >> 31) >= 3
+ lim |= (lim >> 32); /* integer type has more than 32 bits */
+#endif
+ lua_assert((lim & (lim + 1)) == 0 /* 'lim + 1' is a power of 2, */
+ && lim >= n /* not smaller than 'n', */
+ && (lim >> 1) < n); /* and it is the smallest one */
+ while ((ran &= lim) > n) /* project 'ran' into [0..lim] */
+ ran = I2UInt(nextrand(state->s)); /* not inside [0..n]? try again */
+ return ran;
+ }
+}
+
+
+static int math_random (lua_State *L) {
+ lua_Integer low, up;
+ lua_Unsigned p;
+ RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
+ Rand64 rv = nextrand(state->s); /* next pseudo-random value */
+ switch (lua_gettop(L)) { /* check number of arguments */
+ case 0: { /* no arguments */
+ lua_pushnumber(L, I2d(rv)); /* float between 0 and 1 */
+ return 1;
+ }
+ case 1: { /* only upper limit */
+ low = 1;
+ up = luaL_checkinteger(L, 1);
+ if (up == 0) { /* single 0 as argument? */
+ lua_pushinteger(L, I2UInt(rv)); /* full random integer */
+ return 1;
+ }
+ break;
+ }
+ case 2: { /* lower and upper limits */
+ low = luaL_checkinteger(L, 1);
+ up = luaL_checkinteger(L, 2);
+ break;
+ }
+ default: return luaL_error(L, "wrong number of arguments");
+ }
+ /* random integer in the interval [low, up] */
+ luaL_argcheck(L, low <= up, 1, "interval is empty");
+ /* project random integer into the interval [0, up - low] */
+ p = project(I2UInt(rv), (lua_Unsigned)up - (lua_Unsigned)low, state);
+ lua_pushinteger(L, p + (lua_Unsigned)low);
+ return 1;
+}
+
+
+static void setseed (lua_State *L, Rand64 *state,
+ lua_Unsigned n1, lua_Unsigned n2) {
+ int i;
+ state[0] = Int2I(n1);
+ state[1] = Int2I(0xff); /* avoid a zero state */
+ state[2] = Int2I(n2);
+ state[3] = Int2I(0);
+ for (i = 0; i < 16; i++)
+ nextrand(state); /* discard initial values to "spread" seed */
+ lua_pushinteger(L, n1);
+ lua_pushinteger(L, n2);
+}
+
+
+/*
+** Set a "random" seed. To get some randomness, use the current time
+** and the address of 'L' (in case the machine does address space layout
+** randomization).
+*/
+static void randseed (lua_State *L, RanState *state) {
+ lua_Unsigned seed1 = (lua_Unsigned)time(NULL);
+ lua_Unsigned seed2 = (lua_Unsigned)(size_t)L;
+ setseed(L, state->s, seed1, seed2);
+}
+
+
+static int math_randomseed (lua_State *L) {
+ RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
+ if (lua_isnone(L, 1)) {
+ randseed(L, state);
+ }
+ else {
+ lua_Integer n1 = luaL_checkinteger(L, 1);
+ lua_Integer n2 = luaL_optinteger(L, 2, 0);
+ setseed(L, state->s, n1, n2);
+ }
+ return 2; /* return seeds */
+}
+
+
+static const luaL_Reg randfuncs[] = {
+ {"random", math_random},
+ {"randomseed", math_randomseed},
+ {NULL, NULL}
+};
+
+
+/*
+** Register the random functions and initialize their state.
+*/
+static void setrandfunc (lua_State *L) {
+ RanState *state = (RanState *)lua_newuserdatauv(L, sizeof(RanState), 0);
+ randseed(L, state); /* initialize with a "random" seed */
+ lua_pop(L, 2); /* remove pushed seeds */
+ luaL_setfuncs(L, randfuncs, 1);
+}
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Deprecated functions (for compatibility only)
+** ===================================================================
+*/
+#if defined(LUA_COMPAT_MATHLIB)
+
+static int math_cosh (lua_State *L) {
+ lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_sinh (lua_State *L) {
+ lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_tanh (lua_State *L) {
+ lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_pow (lua_State *L) {
+ lua_Number x = luaL_checknumber(L, 1);
+ lua_Number y = luaL_checknumber(L, 2);
+ lua_pushnumber(L, l_mathop(pow)(x, y));
+ return 1;
+}
+
+static int math_frexp (lua_State *L) {
+ int e;
+ lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e));
+ lua_pushinteger(L, e);
+ return 2;
+}
+
+static int math_ldexp (lua_State *L) {
+ lua_Number x = luaL_checknumber(L, 1);
+ int ep = (int)luaL_checkinteger(L, 2);
+ lua_pushnumber(L, l_mathop(ldexp)(x, ep));
+ return 1;
+}
+
+static int math_log10 (lua_State *L) {
+ lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+#endif
+/* }================================================================== */
+
+
+
+static const luaL_Reg mathlib[] = {
+ {"abs", math_abs},
+ {"acos", math_acos},
+ {"asin", math_asin},
+ {"atan", math_atan},
+ {"ceil", math_ceil},
+ {"cos", math_cos},
+ {"deg", math_deg},
+ {"exp", math_exp},
+ {"tointeger", math_toint},
+ {"floor", math_floor},
+ {"fmod", math_fmod},
+ {"ult", math_ult},
+ {"log", math_log},
+ {"max", math_max},
+ {"min", math_min},
+ {"modf", math_modf},
+ {"rad", math_rad},
+ {"sin", math_sin},
+ {"sqrt", math_sqrt},
+ {"tan", math_tan},
+ {"type", math_type},
+#if defined(LUA_COMPAT_MATHLIB)
+ {"atan2", math_atan},
+ {"cosh", math_cosh},
+ {"sinh", math_sinh},
+ {"tanh", math_tanh},
+ {"pow", math_pow},
+ {"frexp", math_frexp},
+ {"ldexp", math_ldexp},
+ {"log10", math_log10},
+#endif
+ /* placeholders */
+ {"random", NULL},
+ {"randomseed", NULL},
+ {"pi", NULL},
+ {"huge", NULL},
+ {"maxinteger", NULL},
+ {"mininteger", NULL},
+ {NULL, NULL}
+};
+
+
+/*
+** Open math library
+*/
+LUAMOD_API int luaopen_math (lua_State *L) {
+ luaL_newlib(L, mathlib);
+ lua_pushnumber(L, PI);
+ lua_setfield(L, -2, "pi");
+ lua_pushnumber(L, (lua_Number)HUGE_VAL);
+ lua_setfield(L, -2, "huge");
+ lua_pushinteger(L, LUA_MAXINTEGER);
+ lua_setfield(L, -2, "maxinteger");
+ lua_pushinteger(L, LUA_MININTEGER);
+ lua_setfield(L, -2, "mininteger");
+ setrandfunc(L);
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lmem.c b/source/luametatex/source/luacore/lua54/src/lmem.c
new file mode 100644
index 000000000..9029d588c
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lmem.c
@@ -0,0 +1,201 @@
+/*
+** $Id: lmem.c $
+** Interface to Memory Manager
+** See Copyright Notice in lua.h
+*/
+
+#define lmem_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <stddef.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+
+
+#if defined(EMERGENCYGCTESTS)
+/*
+** First allocation will fail whenever not building initial state.
+** (This fail will trigger 'tryagain' and a full GC cycle at every
+** allocation.)
+*/
+static void *firsttry (global_State *g, void *block, size_t os, size_t ns) {
+ if (completestate(g) && ns > 0) /* frees never fail */
+ return NULL; /* fail */
+ else /* normal allocation */
+ return (*g->frealloc)(g->ud, block, os, ns);
+}
+#else
+#define firsttry(g,block,os,ns) ((*g->frealloc)(g->ud, block, os, ns))
+#endif
+
+
+
+
+
+/*
+** About the realloc function:
+** void *frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
+** ('osize' is the old size, 'nsize' is the new size)
+**
+** - frealloc(ud, p, x, 0) frees the block 'p' and returns NULL.
+** Particularly, frealloc(ud, NULL, 0, 0) does nothing,
+** which is equivalent to free(NULL) in ISO C.
+**
+** - frealloc(ud, NULL, x, s) creates a new block of size 's'
+** (no matter 'x'). Returns NULL if it cannot create the new block.
+**
+** - otherwise, frealloc(ud, b, x, y) reallocates the block 'b' from
+** size 'x' to size 'y'. Returns NULL if it cannot reallocate the
+** block to the new size.
+*/
+
+
+
+
+/*
+** {==================================================================
+** Functions to allocate/deallocate arrays for the Parser
+** ===================================================================
+*/
+
+/*
+** Minimum size for arrays during parsing, to avoid overhead of
+** reallocating to size 1, then 2, and then 4. All these arrays
+** will be reallocated to exact sizes or erased when parsing ends.
+*/
+#define MINSIZEARRAY 4
+
+
+void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize,
+ int size_elems, int limit, const char *what) {
+ void *newblock;
+ int size = *psize;
+ if (nelems + 1 <= size) /* does one extra element still fit? */
+ return block; /* nothing to be done */
+ if (size >= limit / 2) { /* cannot double it? */
+ if (l_unlikely(size >= limit)) /* cannot grow even a little? */
+ luaG_runerror(L, "too many %s (limit is %d)", what, limit);
+ size = limit; /* still have at least one free place */
+ }
+ else {
+ size *= 2;
+ if (size < MINSIZEARRAY)
+ size = MINSIZEARRAY; /* minimum size */
+ }
+ lua_assert(nelems + 1 <= size && size <= limit);
+ /* 'limit' ensures that multiplication will not overflow */
+ newblock = luaM_saferealloc_(L, block, cast_sizet(*psize) * size_elems,
+ cast_sizet(size) * size_elems);
+ *psize = size; /* update only when everything else is OK */
+ return newblock;
+}
+
+
+/*
+** In prototypes, the size of the array is also its number of
+** elements (to save memory). So, if it cannot shrink an array
+** to its number of elements, the only option is to raise an
+** error.
+*/
+void *luaM_shrinkvector_ (lua_State *L, void *block, int *size,
+ int final_n, int size_elem) {
+ void *newblock;
+ size_t oldsize = cast_sizet((*size) * size_elem);
+ size_t newsize = cast_sizet(final_n * size_elem);
+ lua_assert(newsize <= oldsize);
+ newblock = luaM_saferealloc_(L, block, oldsize, newsize);
+ *size = final_n;
+ return newblock;
+}
+
+/* }================================================================== */
+
+
+l_noret luaM_toobig (lua_State *L) {
+ luaG_runerror(L, "memory allocation error: block too big");
+}
+
+
+/*
+** Free memory
+*/
+void luaM_free_ (lua_State *L, void *block, size_t osize) {
+ global_State *g = G(L);
+ lua_assert((osize == 0) == (block == NULL));
+ (*g->frealloc)(g->ud, block, osize, 0);
+ g->GCdebt -= osize;
+}
+
+
+/*
+** In case of allocation fail, this function will do an emergency
+** collection to free some memory and then try the allocation again.
+** The GC should not be called while state is not fully built, as the
+** collector is not yet fully initialized. Also, it should not be called
+** when 'gcstopem' is true, because then the interpreter is in the
+** middle of a collection step.
+*/
+static void *tryagain (lua_State *L, void *block,
+ size_t osize, size_t nsize) {
+ global_State *g = G(L);
+ if (completestate(g) && !g->gcstopem) {
+ luaC_fullgc(L, 1); /* try to free some memory... */
+ return (*g->frealloc)(g->ud, block, osize, nsize); /* try again */
+ }
+ else return NULL; /* cannot free any memory without a full state */
+}
+
+
+/*
+** Generic allocation routine.
+*/
+void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
+ void *newblock;
+ global_State *g = G(L);
+ lua_assert((osize == 0) == (block == NULL));
+ newblock = firsttry(g, block, osize, nsize);
+ if (l_unlikely(newblock == NULL && nsize > 0)) {
+ newblock = tryagain(L, block, osize, nsize);
+ if (newblock == NULL) /* still no memory? */
+ return NULL; /* do not update 'GCdebt' */
+ }
+ lua_assert((nsize == 0) == (newblock == NULL));
+ g->GCdebt = (g->GCdebt + nsize) - osize;
+ return newblock;
+}
+
+
+void *luaM_saferealloc_ (lua_State *L, void *block, size_t osize,
+ size_t nsize) {
+ void *newblock = luaM_realloc_(L, block, osize, nsize);
+ if (l_unlikely(newblock == NULL && nsize > 0)) /* allocation failed? */
+ luaM_error(L);
+ return newblock;
+}
+
+
+void *luaM_malloc_ (lua_State *L, size_t size, int tag) {
+ if (size == 0)
+ return NULL; /* that's all */
+ else {
+ global_State *g = G(L);
+ void *newblock = firsttry(g, NULL, tag, size);
+ if (l_unlikely(newblock == NULL)) {
+ newblock = tryagain(L, NULL, tag, size);
+ if (newblock == NULL)
+ luaM_error(L);
+ }
+ g->GCdebt += size;
+ return newblock;
+ }
+}
diff --git a/source/luametatex/source/luacore/lua54/src/lmem.h b/source/luametatex/source/luacore/lua54/src/lmem.h
new file mode 100644
index 000000000..8c75a44be
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lmem.h
@@ -0,0 +1,93 @@
+/*
+** $Id: lmem.h $
+** Interface to Memory Manager
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lmem_h
+#define lmem_h
+
+
+#include <stddef.h>
+
+#include "llimits.h"
+#include "lua.h"
+
+
+#define luaM_error(L) luaD_throw(L, LUA_ERRMEM)
+
+
+/*
+** This macro tests whether it is safe to multiply 'n' by the size of
+** type 't' without overflows. Because 'e' is always constant, it avoids
+** the runtime division MAX_SIZET/(e).
+** (The macro is somewhat complex to avoid warnings: The 'sizeof'
+** comparison avoids a runtime comparison when overflow cannot occur.
+** The compiler should be able to optimize the real test by itself, but
+** when it does it, it may give a warning about "comparison is always
+** false due to limited range of data type"; the +1 tricks the compiler,
+** avoiding this warning but also this optimization.)
+*/
+#define luaM_testsize(n,e) \
+ (sizeof(n) >= sizeof(size_t) && cast_sizet((n)) + 1 > MAX_SIZET/(e))
+
+#define luaM_checksize(L,n,e) \
+ (luaM_testsize(n,e) ? luaM_toobig(L) : cast_void(0))
+
+
+/*
+** Computes the minimum between 'n' and 'MAX_SIZET/sizeof(t)', so that
+** the result is not larger than 'n' and cannot overflow a 'size_t'
+** when multiplied by the size of type 't'. (Assumes that 'n' is an
+** 'int' or 'unsigned int' and that 'int' is not larger than 'size_t'.)
+*/
+#define luaM_limitN(n,t) \
+ ((cast_sizet(n) <= MAX_SIZET/sizeof(t)) ? (n) : \
+ cast_uint((MAX_SIZET/sizeof(t))))
+
+
+/*
+** Arrays of chars do not need any test
+*/
+#define luaM_reallocvchar(L,b,on,n) \
+ cast_charp(luaM_saferealloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))
+
+#define luaM_freemem(L, b, s) luaM_free_(L, (b), (s))
+#define luaM_free(L, b) luaM_free_(L, (b), sizeof(*(b)))
+#define luaM_freearray(L, b, n) luaM_free_(L, (b), (n)*sizeof(*(b)))
+
+#define luaM_new(L,t) cast(t*, luaM_malloc_(L, sizeof(t), 0))
+#define luaM_newvector(L,n,t) cast(t*, luaM_malloc_(L, (n)*sizeof(t), 0))
+#define luaM_newvectorchecked(L,n,t) \
+ (luaM_checksize(L,n,sizeof(t)), luaM_newvector(L,n,t))
+
+#define luaM_newobject(L,tag,s) luaM_malloc_(L, (s), tag)
+
+#define luaM_growvector(L,v,nelems,size,t,limit,e) \
+ ((v)=cast(t *, luaM_growaux_(L,v,nelems,&(size),sizeof(t), \
+ luaM_limitN(limit,t),e)))
+
+#define luaM_reallocvector(L, v,oldn,n,t) \
+ (cast(t *, luaM_realloc_(L, v, cast_sizet(oldn) * sizeof(t), \
+ cast_sizet(n) * sizeof(t))))
+
+#define luaM_shrinkvector(L,v,size,fs,t) \
+ ((v)=cast(t *, luaM_shrinkvector_(L, v, &(size), fs, sizeof(t))))
+
+LUAI_FUNC l_noret luaM_toobig (lua_State *L);
+
+/* not to be called directly */
+LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,
+ size_t size);
+LUAI_FUNC void *luaM_saferealloc_ (lua_State *L, void *block, size_t oldsize,
+ size_t size);
+LUAI_FUNC void luaM_free_ (lua_State *L, void *block, size_t osize);
+LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int nelems,
+ int *size, int size_elem, int limit,
+ const char *what);
+LUAI_FUNC void *luaM_shrinkvector_ (lua_State *L, void *block, int *nelem,
+ int final_n, int size_elem);
+LUAI_FUNC void *luaM_malloc_ (lua_State *L, size_t size, int tag);
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/loadlib.c b/source/luametatex/source/luacore/lua54/src/loadlib.c
new file mode 100644
index 000000000..d792dffaa
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/loadlib.c
@@ -0,0 +1,767 @@
+/*
+** $Id: loadlib.c $
+** Dynamic library loader for Lua
+** See Copyright Notice in lua.h
+**
+** This module contains an implementation of loadlib for Unix systems
+** that have dlfcn, an implementation for Windows, and a stub for other
+** systems.
+*/
+
+#define loadlib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/*
+** LUA_IGMARK is a mark to ignore all before it when building the
+** luaopen_ function name.
+*/
+#if !defined (LUA_IGMARK)
+#define LUA_IGMARK "-"
+#endif
+
+
+/*
+** LUA_CSUBSEP is the character that replaces dots in submodule names
+** when searching for a C loader.
+** LUA_LSUBSEP is the character that replaces dots in submodule names
+** when searching for a Lua loader.
+*/
+#if !defined(LUA_CSUBSEP)
+#define LUA_CSUBSEP LUA_DIRSEP
+#endif
+
+#if !defined(LUA_LSUBSEP)
+#define LUA_LSUBSEP LUA_DIRSEP
+#endif
+
+
+/* prefix for open functions in C libraries */
+#define LUA_POF "luaopen_"
+
+/* separator for open functions in C libraries */
+#define LUA_OFSEP "_"
+
+
+/*
+** key for table in the registry that keeps handles
+** for all loaded C libraries
+*/
+static const char *const CLIBS = "_CLIBS";
+
+#define LIB_FAIL "open"
+
+
+#define setprogdir(L) ((void)0)
+
+
+/*
+** Special type equivalent to '(void*)' for functions in gcc
+** (to suppress warnings when converting function pointers)
+*/
+typedef void (*voidf)(void);
+
+
+/*
+** system-dependent functions
+*/
+
+/*
+** unload library 'lib'
+*/
+static void lsys_unloadlib (void *lib);
+
+/*
+** load C library in file 'path'. If 'seeglb', load with all names in
+** the library global.
+** Returns the library; in case of error, returns NULL plus an
+** error string in the stack.
+*/
+static void *lsys_load (lua_State *L, const char *path, int seeglb);
+
+/*
+** Try to find a function named 'sym' in library 'lib'.
+** Returns the function; in case of error, returns NULL plus an
+** error string in the stack.
+*/
+static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym);
+
+
+
+
+#if defined(LUA_USE_DLOPEN) /* { */
+/*
+** {========================================================================
+** This is an implementation of loadlib based on the dlfcn interface.
+** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
+** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least
+** as an emulation layer on top of native functions.
+** =========================================================================
+*/
+
+#include <dlfcn.h>
+
+/*
+** Macro to convert pointer-to-void* to pointer-to-function. This cast
+** is undefined according to ISO C, but POSIX assumes that it works.
+** (The '__extension__' in gnu compilers is only to avoid warnings.)
+*/
+#if defined(__GNUC__)
+#define cast_func(p) (__extension__ (lua_CFunction)(p))
+#else
+#define cast_func(p) ((lua_CFunction)(p))
+#endif
+
+
+static void lsys_unloadlib (void *lib) {
+ dlclose(lib);
+}
+
+
+static void *lsys_load (lua_State *L, const char *path, int seeglb) {
+ void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));
+ if (l_unlikely(lib == NULL))
+ lua_pushstring(L, dlerror());
+ return lib;
+}
+
+
+static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
+ lua_CFunction f = cast_func(dlsym(lib, sym));
+ if (l_unlikely(f == NULL))
+ lua_pushstring(L, dlerror());
+ return f;
+}
+
+/* }====================================================== */
+
+
+
+#elif defined(LUA_DL_DLL) /* }{ */
+/*
+** {======================================================================
+** This is an implementation of loadlib for Windows using native functions.
+** =======================================================================
+*/
+
+#include <windows.h>
+
+
+/*
+** optional flags for LoadLibraryEx
+*/
+#if !defined(LUA_LLE_FLAGS)
+#define LUA_LLE_FLAGS 0
+#endif
+
+
+#undef setprogdir
+
+
+/*
+** Replace in the path (on the top of the stack) any occurrence
+** of LUA_EXEC_DIR with the executable's path.
+*/
+static void setprogdir (lua_State *L) {
+ char buff[MAX_PATH + 1];
+ char *lb;
+ DWORD nsize = sizeof(buff)/sizeof(char);
+ DWORD n = GetModuleFileNameA(NULL, buff, nsize); /* get exec. name */
+ if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
+ luaL_error(L, "unable to get ModuleFileName");
+ else {
+ *lb = '\0'; /* cut name on the last '\\' to get the path */
+ luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
+ lua_remove(L, -2); /* remove original string */
+ }
+}
+
+
+
+
+static void pusherror (lua_State *L) {
+ int error = GetLastError();
+ char buffer[128];
+ if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
+ lua_pushstring(L, buffer);
+ else
+ lua_pushfstring(L, "system error %d\n", error);
+}
+
+static void lsys_unloadlib (void *lib) {
+ FreeLibrary((HMODULE)lib);
+}
+
+
+static void *lsys_load (lua_State *L, const char *path, int seeglb) {
+ HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
+ (void)(seeglb); /* not used: symbols are 'global' by default */
+ if (lib == NULL) pusherror(L);
+ return lib;
+}
+
+
+static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
+ lua_CFunction f = (lua_CFunction)(voidf)GetProcAddress((HMODULE)lib, sym);
+ if (f == NULL) pusherror(L);
+ return f;
+}
+
+/* }====================================================== */
+
+
+#else /* }{ */
+/*
+** {======================================================
+** Fallback for other systems
+** =======================================================
+*/
+
+#undef LIB_FAIL
+#define LIB_FAIL "absent"
+
+
+#define DLMSG "dynamic libraries not enabled; check your Lua installation"
+
+
+static void lsys_unloadlib (void *lib) {
+ (void)(lib); /* not used */
+}
+
+
+static void *lsys_load (lua_State *L, const char *path, int seeglb) {
+ (void)(path); (void)(seeglb); /* not used */
+ lua_pushliteral(L, DLMSG);
+ return NULL;
+}
+
+
+static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
+ (void)(lib); (void)(sym); /* not used */
+ lua_pushliteral(L, DLMSG);
+ return NULL;
+}
+
+/* }====================================================== */
+#endif /* } */
+
+
+/*
+** {==================================================================
+** Set Paths
+** ===================================================================
+*/
+
+/*
+** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment
+** variables that Lua check to set its paths.
+*/
+#if !defined(LUA_PATH_VAR)
+#define LUA_PATH_VAR "LUA_PATH"
+#endif
+
+#if !defined(LUA_CPATH_VAR)
+#define LUA_CPATH_VAR "LUA_CPATH"
+#endif
+
+
+
+/*
+** return registry.LUA_NOENV as a boolean
+*/
+static int noenv (lua_State *L) {
+ int b;
+ lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
+ b = lua_toboolean(L, -1);
+ lua_pop(L, 1); /* remove value */
+ return b;
+}
+
+
+/*
+** Set a path
+*/
+static void setpath (lua_State *L, const char *fieldname,
+ const char *envname,
+ const char *dft) {
+ const char *dftmark;
+ const char *nver = lua_pushfstring(L, "%s%s", envname, LUA_VERSUFFIX);
+ const char *path = getenv(nver); /* try versioned name */
+ if (path == NULL) /* no versioned environment variable? */
+ path = getenv(envname); /* try unversioned name */
+ if (path == NULL || noenv(L)) /* no environment variable? */
+ lua_pushstring(L, dft); /* use default */
+ else if ((dftmark = strstr(path, LUA_PATH_SEP LUA_PATH_SEP)) == NULL)
+ lua_pushstring(L, path); /* nothing to change */
+ else { /* path contains a ";;": insert default path in its place */
+ size_t len = strlen(path);
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ if (path < dftmark) { /* is there a prefix before ';;'? */
+ luaL_addlstring(&b, path, dftmark - path); /* add it */
+ luaL_addchar(&b, *LUA_PATH_SEP);
+ }
+ luaL_addstring(&b, dft); /* add default */
+ if (dftmark < path + len - 2) { /* is there a suffix after ';;'? */
+ luaL_addchar(&b, *LUA_PATH_SEP);
+ luaL_addlstring(&b, dftmark + 2, (path + len - 2) - dftmark);
+ }
+ luaL_pushresult(&b);
+ }
+ setprogdir(L);
+ lua_setfield(L, -3, fieldname); /* package[fieldname] = path value */
+ lua_pop(L, 1); /* pop versioned variable name ('nver') */
+}
+
+/* }================================================================== */
+
+
+/*
+** return registry.CLIBS[path]
+*/
+static void *checkclib (lua_State *L, const char *path) {
+ void *plib;
+ lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
+ lua_getfield(L, -1, path);
+ plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */
+ lua_pop(L, 2); /* pop CLIBS table and 'plib' */
+ return plib;
+}
+
+
+/*
+** registry.CLIBS[path] = plib -- for queries
+** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries
+*/
+static void addtoclib (lua_State *L, const char *path, void *plib) {
+ lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
+ lua_pushlightuserdata(L, plib);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -3, path); /* CLIBS[path] = plib */
+ lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */
+ lua_pop(L, 1); /* pop CLIBS table */
+}
+
+
+/*
+** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib
+** handles in list CLIBS
+*/
+static int gctm (lua_State *L) {
+ lua_Integer n = luaL_len(L, 1);
+ for (; n >= 1; n--) { /* for each handle, in reverse order */
+ lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */
+ lsys_unloadlib(lua_touserdata(L, -1));
+ lua_pop(L, 1); /* pop handle */
+ }
+ return 0;
+}
+
+
+
+/* error codes for 'lookforfunc' */
+#define ERRLIB 1
+#define ERRFUNC 2
+
+/*
+** Look for a C function named 'sym' in a dynamically loaded library
+** 'path'.
+** First, check whether the library is already loaded; if not, try
+** to load it.
+** Then, if 'sym' is '*', return true (as library has been loaded).
+** Otherwise, look for symbol 'sym' in the library and push a
+** C function with that symbol.
+** Return 0 and 'true' or a function in the stack; in case of
+** errors, return an error code and an error message in the stack.
+*/
+static int lookforfunc (lua_State *L, const char *path, const char *sym) {
+ void *reg = checkclib(L, path); /* check loaded C libraries */
+ if (reg == NULL) { /* must load library? */
+ reg = lsys_load(L, path, *sym == '*'); /* global symbols if 'sym'=='*' */
+ if (reg == NULL) return ERRLIB; /* unable to load library */
+ addtoclib(L, path, reg);
+ }
+ if (*sym == '*') { /* loading only library (no function)? */
+ lua_pushboolean(L, 1); /* return 'true' */
+ return 0; /* no errors */
+ }
+ else {
+ lua_CFunction f = lsys_sym(L, reg, sym);
+ if (f == NULL)
+ return ERRFUNC; /* unable to find function */
+ lua_pushcfunction(L, f); /* else create new function */
+ return 0; /* no errors */
+ }
+}
+
+
+static int ll_loadlib (lua_State *L) {
+ const char *path = luaL_checkstring(L, 1);
+ const char *init = luaL_checkstring(L, 2);
+ int stat = lookforfunc(L, path, init);
+ if (l_likely(stat == 0)) /* no errors? */
+ return 1; /* return the loaded function */
+ else { /* error; error message is on stack top */
+ luaL_pushfail(L);
+ lua_insert(L, -2);
+ lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
+ return 3; /* return fail, error message, and where */
+ }
+}
+
+
+
+/*
+** {======================================================
+** 'require' function
+** =======================================================
+*/
+
+
+static int readable (const char *filename) {
+ FILE *f = fopen(filename, "r"); /* try to open file */
+ if (f == NULL) return 0; /* open failed */
+ fclose(f);
+ return 1;
+}
+
+
+/*
+** Get the next name in '*path' = 'name1;name2;name3;...', changing
+** the ending ';' to '\0' to create a zero-terminated string. Return
+** NULL when list ends.
+*/
+static const char *getnextfilename (char **path, char *end) {
+ char *sep;
+ char *name = *path;
+ if (name == end)
+ return NULL; /* no more names */
+ else if (*name == '\0') { /* from previous iteration? */
+ *name = *LUA_PATH_SEP; /* restore separator */
+ name++; /* skip it */
+ }
+ sep = strchr(name, *LUA_PATH_SEP); /* find next separator */
+ if (sep == NULL) /* separator not found? */
+ sep = end; /* name goes until the end */
+ *sep = '\0'; /* finish file name */
+ *path = sep; /* will start next search from here */
+ return name;
+}
+
+
+/*
+** Given a path such as ";blabla.so;blublu.so", pushes the string
+**
+** no file 'blabla.so'
+** no file 'blublu.so'
+*/
+static void pusherrornotfound (lua_State *L, const char *path) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ luaL_addstring(&b, "no file '");
+ luaL_addgsub(&b, path, LUA_PATH_SEP, "'\n\tno file '");
+ luaL_addstring(&b, "'");
+ luaL_pushresult(&b);
+}
+
+
+static const char *searchpath (lua_State *L, const char *name,
+ const char *path,
+ const char *sep,
+ const char *dirsep) {
+ luaL_Buffer buff;
+ char *pathname; /* path with name inserted */
+ char *endpathname; /* its end */
+ const char *filename;
+ /* separator is non-empty and appears in 'name'? */
+ if (*sep != '\0' && strchr(name, *sep) != NULL)
+ name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */
+ luaL_buffinit(L, &buff);
+ /* add path to the buffer, replacing marks ('?') with the file name */
+ luaL_addgsub(&buff, path, LUA_PATH_MARK, name);
+ luaL_addchar(&buff, '\0');
+ pathname = luaL_buffaddr(&buff); /* writable list of file names */
+ endpathname = pathname + luaL_bufflen(&buff) - 1;
+ while ((filename = getnextfilename(&pathname, endpathname)) != NULL) {
+ if (readable(filename)) /* does file exist and is readable? */
+ return lua_pushstring(L, filename); /* save and return name */
+ }
+ luaL_pushresult(&buff); /* push path to create error message */
+ pusherrornotfound(L, lua_tostring(L, -1)); /* create error message */
+ return NULL; /* not found */
+}
+
+
+static int ll_searchpath (lua_State *L) {
+ const char *f = searchpath(L, luaL_checkstring(L, 1),
+ luaL_checkstring(L, 2),
+ luaL_optstring(L, 3, "."),
+ luaL_optstring(L, 4, LUA_DIRSEP));
+ if (f != NULL) return 1;
+ else { /* error message is on top of the stack */
+ luaL_pushfail(L);
+ lua_insert(L, -2);
+ return 2; /* return fail + error message */
+ }
+}
+
+
+static const char *findfile (lua_State *L, const char *name,
+ const char *pname,
+ const char *dirsep) {
+ const char *path;
+ lua_getfield(L, lua_upvalueindex(1), pname);
+ path = lua_tostring(L, -1);
+ if (l_unlikely(path == NULL))
+ luaL_error(L, "'package.%s' must be a string", pname);
+ return searchpath(L, name, path, ".", dirsep);
+}
+
+
+static int checkload (lua_State *L, int stat, const char *filename) {
+ if (l_likely(stat)) { /* module loaded successfully? */
+ lua_pushstring(L, filename); /* will be 2nd argument to module */
+ return 2; /* return open function and file name */
+ }
+ else
+ return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",
+ lua_tostring(L, 1), filename, lua_tostring(L, -1));
+}
+
+
+static int searcher_Lua (lua_State *L) {
+ const char *filename;
+ const char *name = luaL_checkstring(L, 1);
+ filename = findfile(L, name, "path", LUA_LSUBSEP);
+ if (filename == NULL) return 1; /* module not found in this path */
+ return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);
+}
+
+
+/*
+** Try to find a load function for module 'modname' at file 'filename'.
+** First, change '.' to '_' in 'modname'; then, if 'modname' has
+** the form X-Y (that is, it has an "ignore mark"), build a function
+** name "luaopen_X" and look for it. (For compatibility, if that
+** fails, it also tries "luaopen_Y".) If there is no ignore mark,
+** look for a function named "luaopen_modname".
+*/
+static int loadfunc (lua_State *L, const char *filename, const char *modname) {
+ const char *openfunc;
+ const char *mark;
+ modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
+ mark = strchr(modname, *LUA_IGMARK);
+ if (mark) {
+ int stat;
+ openfunc = lua_pushlstring(L, modname, mark - modname);
+ openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);
+ stat = lookforfunc(L, filename, openfunc);
+ if (stat != ERRFUNC) return stat;
+ modname = mark + 1; /* else go ahead and try old-style name */
+ }
+ openfunc = lua_pushfstring(L, LUA_POF"%s", modname);
+ return lookforfunc(L, filename, openfunc);
+}
+
+
+static int searcher_C (lua_State *L) {
+ const char *name = luaL_checkstring(L, 1);
+ const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
+ if (filename == NULL) return 1; /* module not found in this path */
+ return checkload(L, (loadfunc(L, filename, name) == 0), filename);
+}
+
+
+static int searcher_Croot (lua_State *L) {
+ const char *filename;
+ const char *name = luaL_checkstring(L, 1);
+ const char *p = strchr(name, '.');
+ int stat;
+ if (p == NULL) return 0; /* is root */
+ lua_pushlstring(L, name, p - name);
+ filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
+ if (filename == NULL) return 1; /* root not found */
+ if ((stat = loadfunc(L, filename, name)) != 0) {
+ if (stat != ERRFUNC)
+ return checkload(L, 0, filename); /* real error */
+ else { /* open function not found */
+ lua_pushfstring(L, "no module '%s' in file '%s'", name, filename);
+ return 1;
+ }
+ }
+ lua_pushstring(L, filename); /* will be 2nd argument to module */
+ return 2;
+}
+
+
+static int searcher_preload (lua_State *L) {
+ const char *name = luaL_checkstring(L, 1);
+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
+ if (lua_getfield(L, -1, name) == LUA_TNIL) { /* not found? */
+ lua_pushfstring(L, "no field package.preload['%s']", name);
+ return 1;
+ }
+ else {
+ lua_pushliteral(L, ":preload:");
+ return 2;
+ }
+}
+
+
+static void findloader (lua_State *L, const char *name) {
+ int i;
+ luaL_Buffer msg; /* to build error message */
+ /* push 'package.searchers' to index 3 in the stack */
+ if (l_unlikely(lua_getfield(L, lua_upvalueindex(1), "searchers")
+ != LUA_TTABLE))
+ luaL_error(L, "'package.searchers' must be a table");
+ luaL_buffinit(L, &msg);
+ /* iterate over available searchers to find a loader */
+ for (i = 1; ; i++) {
+ luaL_addstring(&msg, "\n\t"); /* error-message prefix */
+ if (l_unlikely(lua_rawgeti(L, 3, i) == LUA_TNIL)) { /* no more searchers? */
+ lua_pop(L, 1); /* remove nil */
+ luaL_buffsub(&msg, 2); /* remove prefix */
+ luaL_pushresult(&msg); /* create error message */
+ luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
+ }
+ lua_pushstring(L, name);
+ lua_call(L, 1, 2); /* call it */
+ if (lua_isfunction(L, -2)) /* did it find a loader? */
+ return; /* module loader found */
+ else if (lua_isstring(L, -2)) { /* searcher returned error message? */
+ lua_pop(L, 1); /* remove extra return */
+ luaL_addvalue(&msg); /* concatenate error message */
+ }
+ else { /* no error message */
+ lua_pop(L, 2); /* remove both returns */
+ luaL_buffsub(&msg, 2); /* remove prefix */
+ }
+ }
+}
+
+
+static int ll_require (lua_State *L) {
+ const char *name = luaL_checkstring(L, 1);
+ lua_settop(L, 1); /* LOADED table will be at index 2 */
+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
+ lua_getfield(L, 2, name); /* LOADED[name] */
+ if (lua_toboolean(L, -1)) /* is it there? */
+ return 1; /* package is already loaded */
+ /* else must load package */
+ lua_pop(L, 1); /* remove 'getfield' result */
+ findloader(L, name);
+ lua_rotate(L, -2, 1); /* function <-> loader data */
+ lua_pushvalue(L, 1); /* name is 1st argument to module loader */
+ lua_pushvalue(L, -3); /* loader data is 2nd argument */
+ /* stack: ...; loader data; loader function; mod. name; loader data */
+ lua_call(L, 2, 1); /* run loader to load module */
+ /* stack: ...; loader data; result from loader */
+ if (!lua_isnil(L, -1)) /* non-nil return? */
+ lua_setfield(L, 2, name); /* LOADED[name] = returned value */
+ else
+ lua_pop(L, 1); /* pop nil */
+ if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */
+ lua_pushboolean(L, 1); /* use true as result */
+ lua_copy(L, -1, -2); /* replace loader result */
+ lua_setfield(L, 2, name); /* LOADED[name] = true */
+ }
+ lua_rotate(L, -2, 1); /* loader data <-> module result */
+ return 2; /* return module result and loader data */
+}
+
+/* }====================================================== */
+
+
+
+
+static const luaL_Reg pk_funcs[] = {
+ {"loadlib", ll_loadlib},
+ {"searchpath", ll_searchpath},
+ /* placeholders */
+ {"preload", NULL},
+ {"cpath", NULL},
+ {"path", NULL},
+ {"searchers", NULL},
+ {"loaded", NULL},
+ {NULL, NULL}
+};
+
+
+static const luaL_Reg ll_funcs[] = {
+ {"require", ll_require},
+ {NULL, NULL}
+};
+
+
+static void createsearcherstable (lua_State *L) {
+ static const lua_CFunction searchers[] = {
+ searcher_preload,
+ searcher_Lua,
+ searcher_C,
+ searcher_Croot,
+ NULL
+ };
+ int i;
+ /* create 'searchers' table */
+ lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
+ /* fill it with predefined searchers */
+ for (i=0; searchers[i] != NULL; i++) {
+ lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */
+ lua_pushcclosure(L, searchers[i], 1);
+ lua_rawseti(L, -2, i+1);
+ }
+ lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */
+}
+
+
+/*
+** create table CLIBS to keep track of loaded C libraries,
+** setting a finalizer to close all libraries when closing state.
+*/
+static void createclibstable (lua_State *L) {
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); /* create CLIBS table */
+ lua_createtable(L, 0, 1); /* create metatable for CLIBS */
+ lua_pushcfunction(L, gctm);
+ lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */
+ lua_setmetatable(L, -2);
+}
+
+
+LUAMOD_API int luaopen_package (lua_State *L) {
+ createclibstable(L);
+ luaL_newlib(L, pk_funcs); /* create 'package' table */
+ createsearcherstable(L);
+ /* set paths */
+ setpath(L, "path", LUA_PATH_VAR, LUA_PATH_DEFAULT);
+ setpath(L, "cpath", LUA_CPATH_VAR, LUA_CPATH_DEFAULT);
+ /* store config information */
+ lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
+ LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
+ lua_setfield(L, -2, "config");
+ /* set field 'loaded' */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
+ lua_setfield(L, -2, "loaded");
+ /* set field 'preload' */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
+ lua_setfield(L, -2, "preload");
+ lua_pushglobaltable(L);
+ lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */
+ luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */
+ lua_pop(L, 1); /* pop global table */
+ return 1; /* return 'package' table */
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lobject.c b/source/luametatex/source/luacore/lua54/src/lobject.c
new file mode 100644
index 000000000..a2c006098
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lobject.c
@@ -0,0 +1,602 @@
+/*
+** $Id: lobject.c $
+** Some generic functions over Lua objects
+** See Copyright Notice in lua.h
+*/
+
+#define lobject_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <locale.h>
+#include <math.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lctype.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "lvm.h"
+
+
+/*
+** Computes ceil(log2(x))
+*/
+int luaO_ceillog2 (unsigned int x) {
+ static const lu_byte log_2[256] = { /* log_2[i] = ceil(log2(i - 1)) */
+ 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
+ 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
+ 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+ 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
+ };
+ int l = 0;
+ x--;
+ while (x >= 256) { l += 8; x >>= 8; }
+ return l + log_2[x];
+}
+
+
+static lua_Integer intarith (lua_State *L, int op, lua_Integer v1,
+ lua_Integer v2) {
+ switch (op) {
+ case LUA_OPADD: return intop(+, v1, v2);
+ case LUA_OPSUB:return intop(-, v1, v2);
+ case LUA_OPMUL:return intop(*, v1, v2);
+ case LUA_OPMOD: return luaV_mod(L, v1, v2);
+ case LUA_OPIDIV: return luaV_idiv(L, v1, v2);
+ case LUA_OPBAND: return intop(&, v1, v2);
+ case LUA_OPBOR: return intop(|, v1, v2);
+ case LUA_OPBXOR: return intop(^, v1, v2);
+ case LUA_OPSHL: return luaV_shiftl(v1, v2);
+ case LUA_OPSHR: return luaV_shiftl(v1, -v2);
+ case LUA_OPUNM: return intop(-, 0, v1);
+ case LUA_OPBNOT: return intop(^, ~l_castS2U(0), v1);
+ default: lua_assert(0); return 0;
+ }
+}
+
+
+static lua_Number numarith (lua_State *L, int op, lua_Number v1,
+ lua_Number v2) {
+ switch (op) {
+ case LUA_OPADD: return luai_numadd(L, v1, v2);
+ case LUA_OPSUB: return luai_numsub(L, v1, v2);
+ case LUA_OPMUL: return luai_nummul(L, v1, v2);
+ case LUA_OPDIV: return luai_numdiv(L, v1, v2);
+ case LUA_OPPOW: return luai_numpow(L, v1, v2);
+ case LUA_OPIDIV: return luai_numidiv(L, v1, v2);
+ case LUA_OPUNM: return luai_numunm(L, v1);
+ case LUA_OPMOD: return luaV_modf(L, v1, v2);
+ default: lua_assert(0); return 0;
+ }
+}
+
+
+int luaO_rawarith (lua_State *L, int op, const TValue *p1, const TValue *p2,
+ TValue *res) {
+ switch (op) {
+ case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
+ case LUA_OPSHL: case LUA_OPSHR:
+ case LUA_OPBNOT: { /* operate only on integers */
+ lua_Integer i1; lua_Integer i2;
+ if (tointegerns(p1, &i1) && tointegerns(p2, &i2)) {
+ setivalue(res, intarith(L, op, i1, i2));
+ return 1;
+ }
+ else return 0; /* fail */
+ }
+ case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */
+ lua_Number n1; lua_Number n2;
+ if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
+ setfltvalue(res, numarith(L, op, n1, n2));
+ return 1;
+ }
+ else return 0; /* fail */
+ }
+ default: { /* other operations */
+ lua_Number n1; lua_Number n2;
+ if (ttisinteger(p1) && ttisinteger(p2)) {
+ setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2)));
+ return 1;
+ }
+ else if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
+ setfltvalue(res, numarith(L, op, n1, n2));
+ return 1;
+ }
+ else return 0; /* fail */
+ }
+ }
+}
+
+
+void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2,
+ StkId res) {
+ if (!luaO_rawarith(L, op, p1, p2, s2v(res))) {
+ /* could not perform raw operation; try metamethod */
+ luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD));
+ }
+}
+
+
+int luaO_hexavalue (int c) {
+ if (lisdigit(c)) return c - '0';
+ else return (ltolower(c) - 'a') + 10;
+}
+
+
+static int isneg (const char **s) {
+ if (**s == '-') { (*s)++; return 1; }
+ else if (**s == '+') (*s)++;
+ return 0;
+}
+
+
+
+/*
+** {==================================================================
+** Lua's implementation for 'lua_strx2number'
+** ===================================================================
+*/
+
+#if !defined(lua_strx2number)
+
+/* maximum number of significant digits to read (to avoid overflows
+ even with single floats) */
+#define MAXSIGDIG 30
+
+/*
+** convert a hexadecimal numeric string to a number, following
+** C99 specification for 'strtod'
+*/
+static lua_Number lua_strx2number (const char *s, char **endptr) {
+ int dot = lua_getlocaledecpoint();
+ lua_Number r = l_mathop(0.0); /* result (accumulator) */
+ int sigdig = 0; /* number of significant digits */
+ int nosigdig = 0; /* number of non-significant digits */
+ int e = 0; /* exponent correction */
+ int neg; /* 1 if number is negative */
+ int hasdot = 0; /* true after seen a dot */
+ *endptr = cast_charp(s); /* nothing is valid yet */
+ while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
+ neg = isneg(&s); /* check sign */
+ if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */
+ return l_mathop(0.0); /* invalid format (no '0x') */
+ for (s += 2; ; s++) { /* skip '0x' and read numeral */
+ if (*s == dot) {
+ if (hasdot) break; /* second dot? stop loop */
+ else hasdot = 1;
+ }
+ else if (lisxdigit(cast_uchar(*s))) {
+ if (sigdig == 0 && *s == '0') /* non-significant digit (zero)? */
+ nosigdig++;
+ else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */
+ r = (r * l_mathop(16.0)) + luaO_hexavalue(*s);
+ else e++; /* too many digits; ignore, but still count for exponent */
+ if (hasdot) e--; /* decimal digit? correct exponent */
+ }
+ else break; /* neither a dot nor a digit */
+ }
+ if (nosigdig + sigdig == 0) /* no digits? */
+ return l_mathop(0.0); /* invalid format */
+ *endptr = cast_charp(s); /* valid up to here */
+ e *= 4; /* each digit multiplies/divides value by 2^4 */
+ if (*s == 'p' || *s == 'P') { /* exponent part? */
+ int exp1 = 0; /* exponent value */
+ int neg1; /* exponent sign */
+ s++; /* skip 'p' */
+ neg1 = isneg(&s); /* sign */
+ if (!lisdigit(cast_uchar(*s)))
+ return l_mathop(0.0); /* invalid; must have at least one digit */
+ while (lisdigit(cast_uchar(*s))) /* read exponent */
+ exp1 = exp1 * 10 + *(s++) - '0';
+ if (neg1) exp1 = -exp1;
+ e += exp1;
+ *endptr = cast_charp(s); /* valid up to here */
+ }
+ if (neg) r = -r;
+ return l_mathop(ldexp)(r, e);
+}
+
+#endif
+/* }====================================================== */
+
+
+/* maximum length of a numeral to be converted to a number */
+#if !defined (L_MAXLENNUM)
+#define L_MAXLENNUM 200
+#endif
+
+/*
+** Convert string 's' to a Lua number (put in 'result'). Return NULL on
+** fail or the address of the ending '\0' on success. ('mode' == 'x')
+** means a hexadecimal numeral.
+*/
+static const char *l_str2dloc (const char *s, lua_Number *result, int mode) {
+ char *endptr;
+ *result = (mode == 'x') ? lua_strx2number(s, &endptr) /* try to convert */
+ : lua_str2number(s, &endptr);
+ if (endptr == s) return NULL; /* nothing recognized? */
+ while (lisspace(cast_uchar(*endptr))) endptr++; /* skip trailing spaces */
+ return (*endptr == '\0') ? endptr : NULL; /* OK iff no trailing chars */
+}
+
+
+/*
+** Convert string 's' to a Lua number (put in 'result') handling the
+** current locale.
+** This function accepts both the current locale or a dot as the radix
+** mark. If the conversion fails, it may mean number has a dot but
+** locale accepts something else. In that case, the code copies 's'
+** to a buffer (because 's' is read-only), changes the dot to the
+** current locale radix mark, and tries to convert again.
+** The variable 'mode' checks for special characters in the string:
+** - 'n' means 'inf' or 'nan' (which should be rejected)
+** - 'x' means a hexadecimal numeral
+** - '.' just optimizes the search for the common case (no special chars)
+*/
+static const char *l_str2d (const char *s, lua_Number *result) {
+ const char *endptr;
+ const char *pmode = strpbrk(s, ".xXnN"); /* look for special chars */
+ int mode = pmode ? ltolower(cast_uchar(*pmode)) : 0;
+ if (mode == 'n') /* reject 'inf' and 'nan' */
+ return NULL;
+ endptr = l_str2dloc(s, result, mode); /* try to convert */
+ if (endptr == NULL) { /* failed? may be a different locale */
+ char buff[L_MAXLENNUM + 1];
+ const char *pdot = strchr(s, '.');
+ if (pdot == NULL || strlen(s) > L_MAXLENNUM)
+ return NULL; /* string too long or no dot; fail */
+ strcpy(buff, s); /* copy string to buffer */
+ buff[pdot - s] = lua_getlocaledecpoint(); /* correct decimal point */
+ endptr = l_str2dloc(buff, result, mode); /* try again */
+ if (endptr != NULL)
+ endptr = s + (endptr - buff); /* make relative to 's' */
+ }
+ return endptr;
+}
+
+
+#define MAXBY10 cast(lua_Unsigned, LUA_MAXINTEGER / 10)
+#define MAXLASTD cast_int(LUA_MAXINTEGER % 10)
+
+static const char *l_str2int (const char *s, lua_Integer *result) {
+ lua_Unsigned a = 0;
+ int empty = 1;
+ int neg;
+ while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
+ neg = isneg(&s);
+ if (s[0] == '0' &&
+ (s[1] == 'x' || s[1] == 'X')) { /* hex? */
+ s += 2; /* skip '0x' */
+ for (; lisxdigit(cast_uchar(*s)); s++) {
+ a = a * 16 + luaO_hexavalue(*s);
+ empty = 0;
+ }
+ }
+ else { /* decimal */
+ for (; lisdigit(cast_uchar(*s)); s++) {
+ int d = *s - '0';
+ if (a >= MAXBY10 && (a > MAXBY10 || d > MAXLASTD + neg)) /* overflow? */
+ return NULL; /* do not accept it (as integer) */
+ a = a * 10 + d;
+ empty = 0;
+ }
+ }
+ while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */
+ if (empty || *s != '\0') return NULL; /* something wrong in the numeral */
+ else {
+ *result = l_castU2S((neg) ? 0u - a : a);
+ return s;
+ }
+}
+
+
+size_t luaO_str2num (const char *s, TValue *o) {
+ lua_Integer i; lua_Number n;
+ const char *e;
+ if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */
+ setivalue(o, i);
+ }
+ else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */
+ setfltvalue(o, n);
+ }
+ else
+ return 0; /* conversion failed */
+ return (e - s) + 1; /* success; return string size */
+}
+
+
+int luaO_utf8esc (char *buff, unsigned long x) {
+ int n = 1; /* number of bytes put in buffer (backwards) */
+ lua_assert(x <= 0x7FFFFFFFu);
+ if (x < 0x80) /* ascii? */
+ buff[UTF8BUFFSZ - 1] = cast_char(x);
+ else { /* need continuation bytes */
+ unsigned int mfb = 0x3f; /* maximum that fits in first byte */
+ do { /* add continuation bytes */
+ buff[UTF8BUFFSZ - (n++)] = cast_char(0x80 | (x & 0x3f));
+ x >>= 6; /* remove added bits */
+ mfb >>= 1; /* now there is one less bit available in first byte */
+ } while (x > mfb); /* still needs continuation byte? */
+ buff[UTF8BUFFSZ - n] = cast_char((~mfb << 1) | x); /* add first byte */
+ }
+ return n;
+}
+
+
+/*
+** Maximum length of the conversion of a number to a string. Must be
+** enough to accommodate both LUA_INTEGER_FMT and LUA_NUMBER_FMT.
+** (For a long long int, this is 19 digits plus a sign and a final '\0',
+** adding to 21. For a long double, it can go to a sign, 33 digits,
+** the dot, an exponent letter, an exponent sign, 5 exponent digits,
+** and a final '\0', adding to 43.)
+*/
+#define MAXNUMBER2STR 44
+
+
+/*
+** Convert a number object to a string, adding it to a buffer
+*/
+static int tostringbuff (TValue *obj, char *buff) {
+ int len;
+ lua_assert(ttisnumber(obj));
+ if (ttisinteger(obj))
+ len = lua_integer2str(buff, MAXNUMBER2STR, ivalue(obj));
+ else {
+ len = lua_number2str(buff, MAXNUMBER2STR, fltvalue(obj));
+ if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */
+ buff[len++] = lua_getlocaledecpoint();
+ buff[len++] = '0'; /* adds '.0' to result */
+ }
+ }
+ return len;
+}
+
+
+/*
+** Convert a number object to a Lua string, replacing the value at 'obj'
+*/
+void luaO_tostring (lua_State *L, TValue *obj) {
+ char buff[MAXNUMBER2STR];
+ int len = tostringbuff(obj, buff);
+ setsvalue(L, obj, luaS_newlstr(L, buff, len));
+}
+
+
+
+
+/*
+** {==================================================================
+** 'luaO_pushvfstring'
+** ===================================================================
+*/
+
+/*
+** Size for buffer space used by 'luaO_pushvfstring'. It should be
+** (LUA_IDSIZE + MAXNUMBER2STR) + a minimal space for basic messages,
+** so that 'luaG_addinfo' can work directly on the buffer.
+*/
+#define BUFVFS (LUA_IDSIZE + MAXNUMBER2STR + 95)
+
+/* buffer used by 'luaO_pushvfstring' */
+typedef struct BuffFS {
+ lua_State *L;
+ int pushed; /* true if there is a part of the result on the stack */
+ int blen; /* length of partial string in 'space' */
+ char space[BUFVFS]; /* holds last part of the result */
+} BuffFS;
+
+
+/*
+** Push given string to the stack, as part of the result, and
+** join it to previous partial result if there is one.
+** It may call 'luaV_concat' while using one slot from EXTRA_STACK.
+** This call cannot invoke metamethods, as both operands must be
+** strings. It can, however, raise an error if the result is too
+** long. In that case, 'luaV_concat' frees the extra slot before
+** raising the error.
+*/
+static void pushstr (BuffFS *buff, const char *str, size_t lstr) {
+ lua_State *L = buff->L;
+ setsvalue2s(L, L->top, luaS_newlstr(L, str, lstr));
+ L->top++; /* may use one slot from EXTRA_STACK */
+ if (!buff->pushed) /* no previous string on the stack? */
+ buff->pushed = 1; /* now there is one */
+ else /* join previous string with new one */
+ luaV_concat(L, 2);
+}
+
+
+/*
+** empty the buffer space into the stack
+*/
+static void clearbuff (BuffFS *buff) {
+ pushstr(buff, buff->space, buff->blen); /* push buffer contents */
+ buff->blen = 0; /* space now is empty */
+}
+
+
+/*
+** Get a space of size 'sz' in the buffer. If buffer has not enough
+** space, empty it. 'sz' must fit in an empty buffer.
+*/
+static char *getbuff (BuffFS *buff, int sz) {
+ lua_assert(buff->blen <= BUFVFS); lua_assert(sz <= BUFVFS);
+ if (sz > BUFVFS - buff->blen) /* not enough space? */
+ clearbuff(buff);
+ return buff->space + buff->blen;
+}
+
+
+#define addsize(b,sz) ((b)->blen += (sz))
+
+
+/*
+** Add 'str' to the buffer. If string is larger than the buffer space,
+** push the string directly to the stack.
+*/
+static void addstr2buff (BuffFS *buff, const char *str, size_t slen) {
+ if (slen <= BUFVFS) { /* does string fit into buffer? */
+ char *bf = getbuff(buff, cast_int(slen));
+ memcpy(bf, str, slen); /* add string to buffer */
+ addsize(buff, cast_int(slen));
+ }
+ else { /* string larger than buffer */
+ clearbuff(buff); /* string comes after buffer's content */
+ pushstr(buff, str, slen); /* push string */
+ }
+}
+
+
+/*
+** Add a numeral to the buffer.
+*/
+static void addnum2buff (BuffFS *buff, TValue *num) {
+ char *numbuff = getbuff(buff, MAXNUMBER2STR);
+ int len = tostringbuff(num, numbuff); /* format number into 'numbuff' */
+ addsize(buff, len);
+}
+
+
+/*
+** this function handles only '%d', '%c', '%f', '%p', '%s', and '%%'
+ conventional formats, plus Lua-specific '%I' and '%U'
+*/
+const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
+ BuffFS buff; /* holds last part of the result */
+ const char *e; /* points to next '%' */
+ buff.pushed = buff.blen = 0;
+ buff.L = L;
+ while ((e = strchr(fmt, '%')) != NULL) {
+ addstr2buff(&buff, fmt, e - fmt); /* add 'fmt' up to '%' */
+ switch (*(e + 1)) { /* conversion specifier */
+ case 's': { /* zero-terminated string */
+ const char *s = va_arg(argp, char *);
+ if (s == NULL) s = "(null)";
+ addstr2buff(&buff, s, strlen(s));
+ break;
+ }
+ case 'c': { /* an 'int' as a character */
+ char c = cast_uchar(va_arg(argp, int));
+ addstr2buff(&buff, &c, sizeof(char));
+ break;
+ }
+ case 'd': { /* an 'int' */
+ TValue num;
+ setivalue(&num, va_arg(argp, int));
+ addnum2buff(&buff, &num);
+ break;
+ }
+ case 'I': { /* a 'lua_Integer' */
+ TValue num;
+ setivalue(&num, cast(lua_Integer, va_arg(argp, l_uacInt)));
+ addnum2buff(&buff, &num);
+ break;
+ }
+ case 'f': { /* a 'lua_Number' */
+ TValue num;
+ setfltvalue(&num, cast_num(va_arg(argp, l_uacNumber)));
+ addnum2buff(&buff, &num);
+ break;
+ }
+ case 'p': { /* a pointer */
+ const int sz = 3 * sizeof(void*) + 8; /* enough space for '%p' */
+ char *bf = getbuff(&buff, sz);
+ void *p = va_arg(argp, void *);
+ int len = lua_pointer2str(bf, sz, p);
+ addsize(&buff, len);
+ break;
+ }
+ case 'U': { /* a 'long' as a UTF-8 sequence */
+ char bf[UTF8BUFFSZ];
+ int len = luaO_utf8esc(bf, va_arg(argp, long));
+ addstr2buff(&buff, bf + UTF8BUFFSZ - len, len);
+ break;
+ }
+ case '%': {
+ addstr2buff(&buff, "%", 1);
+ break;
+ }
+ default: {
+ luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'",
+ *(e + 1));
+ }
+ }
+ fmt = e + 2; /* skip '%' and the specifier */
+ }
+ addstr2buff(&buff, fmt, strlen(fmt)); /* rest of 'fmt' */
+ clearbuff(&buff); /* empty buffer into the stack */
+ lua_assert(buff.pushed == 1);
+ return svalue(s2v(L->top - 1));
+}
+
+
+const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
+ const char *msg;
+ va_list argp;
+ va_start(argp, fmt);
+ msg = luaO_pushvfstring(L, fmt, argp);
+ va_end(argp);
+ return msg;
+}
+
+/* }================================================================== */
+
+
+#define RETS "..."
+#define PRE "[string \""
+#define POS "\"]"
+
+#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) )
+
+void luaO_chunkid (char *out, const char *source, size_t srclen) {
+ size_t bufflen = LUA_IDSIZE; /* free space in buffer */
+ if (*source == '=') { /* 'literal' source */
+ if (srclen <= bufflen) /* small enough? */
+ memcpy(out, source + 1, srclen * sizeof(char));
+ else { /* truncate it */
+ addstr(out, source + 1, bufflen - 1);
+ *out = '\0';
+ }
+ }
+ else if (*source == '@') { /* file name */
+ if (srclen <= bufflen) /* small enough? */
+ memcpy(out, source + 1, srclen * sizeof(char));
+ else { /* add '...' before rest of name */
+ addstr(out, RETS, LL(RETS));
+ bufflen -= LL(RETS);
+ memcpy(out, source + 1 + srclen - bufflen, bufflen * sizeof(char));
+ }
+ }
+ else { /* string; format as [string "source"] */
+ const char *nl = strchr(source, '\n'); /* find first new line (if any) */
+ addstr(out, PRE, LL(PRE)); /* add prefix */
+ bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */
+ if (srclen < bufflen && nl == NULL) { /* small one-line source? */
+ addstr(out, source, srclen); /* keep it */
+ }
+ else {
+ if (nl != NULL) srclen = nl - source; /* stop at first newline */
+ if (srclen > bufflen) srclen = bufflen;
+ addstr(out, source, srclen);
+ addstr(out, RETS, LL(RETS));
+ }
+ memcpy(out, POS, (LL(POS) + 1) * sizeof(char));
+ }
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lobject.h b/source/luametatex/source/luacore/lua54/src/lobject.h
new file mode 100644
index 000000000..77cc606f5
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lobject.h
@@ -0,0 +1,802 @@
+/*
+** $Id: lobject.h $
+** Type definitions for Lua objects
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lobject_h
+#define lobject_h
+
+
+#include <stdarg.h>
+
+
+#include "llimits.h"
+#include "lua.h"
+
+
+/*
+** Extra types for collectable non-values
+*/
+#define LUA_TUPVAL LUA_NUMTYPES /* upvalues */
+#define LUA_TPROTO (LUA_NUMTYPES+1) /* function prototypes */
+#define LUA_TDEADKEY (LUA_NUMTYPES+2) /* removed keys in tables */
+
+
+
+/*
+** number of all possible types (including LUA_TNONE but excluding DEADKEY)
+*/
+#define LUA_TOTALTYPES (LUA_TPROTO + 2)
+
+
+/*
+** tags for Tagged Values have the following use of bits:
+** bits 0-3: actual tag (a LUA_T* constant)
+** bits 4-5: variant bits
+** bit 6: whether value is collectable
+*/
+
+/* add variant bits to a type */
+#define makevariant(t,v) ((t) | ((v) << 4))
+
+
+
+/*
+** Union of all Lua values
+*/
+typedef union Value {
+ struct GCObject *gc; /* collectable objects */
+ void *p; /* light userdata */
+ lua_CFunction f; /* light C functions */
+ lua_Integer i; /* integer numbers */
+ lua_Number n; /* float numbers */
+ /* not used, but may avoid warnings for uninitialized value */
+ lu_byte ub;
+} Value;
+
+
+/*
+** Tagged Values. This is the basic representation of values in Lua:
+** an actual value plus a tag with its type.
+*/
+
+#define TValuefields Value value_; lu_byte tt_
+
+typedef struct TValue {
+ TValuefields;
+} TValue;
+
+
+#define val_(o) ((o)->value_)
+#define valraw(o) (val_(o))
+
+
+/* raw type tag of a TValue */
+#define rawtt(o) ((o)->tt_)
+
+/* tag with no variants (bits 0-3) */
+#define novariant(t) ((t) & 0x0F)
+
+/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */
+#define withvariant(t) ((t) & 0x3F)
+#define ttypetag(o) withvariant(rawtt(o))
+
+/* type of a TValue */
+#define ttype(o) (novariant(rawtt(o)))
+
+
+/* Macros to test type */
+#define checktag(o,t) (rawtt(o) == (t))
+#define checktype(o,t) (ttype(o) == (t))
+
+
+/* Macros for internal tests */
+
+/* collectable object has the same tag as the original value */
+#define righttt(obj) (ttypetag(obj) == gcvalue(obj)->tt)
+
+/*
+** Any value being manipulated by the program either is non
+** collectable, or the collectable object has the right tag
+** and it is not dead. The option 'L == NULL' allows other
+** macros using this one to be used where L is not available.
+*/
+#define checkliveness(L,obj) \
+ ((void)L, lua_longassert(!iscollectable(obj) || \
+ (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj))))))
+
+
+/* Macros to set values */
+
+/* set a value's tag */
+#define settt_(o,t) ((o)->tt_=(t))
+
+
+/* main macro to copy values (from 'obj2' to 'obj1') */
+#define setobj(L,obj1,obj2) \
+ { TValue *io1=(obj1); const TValue *io2=(obj2); \
+ io1->value_ = io2->value_; settt_(io1, io2->tt_); \
+ checkliveness(L,io1); lua_assert(!isnonstrictnil(io1)); }
+
+/*
+** Different types of assignments, according to source and destination.
+** (They are mostly equal now, but may be different in the future.)
+*/
+
+/* from stack to stack */
+#define setobjs2s(L,o1,o2) setobj(L,s2v(o1),s2v(o2))
+/* to stack (not from same stack) */
+#define setobj2s(L,o1,o2) setobj(L,s2v(o1),o2)
+/* from table to same table */
+#define setobjt2t setobj
+/* to new object */
+#define setobj2n setobj
+/* to table */
+#define setobj2t setobj
+
+
+/*
+** Entries in a Lua stack. Field 'tbclist' forms a list of all
+** to-be-closed variables active in this stack. Dummy entries are
+** used when the distance between two tbc variables does not fit
+** in an unsigned short. They are represented by delta==0, and
+** their real delta is always the maximum value that fits in
+** that field.
+*/
+typedef union StackValue {
+ TValue val;
+ struct {
+ TValuefields;
+ unsigned short delta;
+ } tbclist;
+} StackValue;
+
+
+/* index to stack elements */
+typedef StackValue *StkId;
+
+/* convert a 'StackValue' to a 'TValue' */
+#define s2v(o) (&(o)->val)
+
+
+
+/*
+** {==================================================================
+** Nil
+** ===================================================================
+*/
+
+/* Standard nil */
+#define LUA_VNIL makevariant(LUA_TNIL, 0)
+
+/* Empty slot (which might be different from a slot containing nil) */
+#define LUA_VEMPTY makevariant(LUA_TNIL, 1)
+
+/* Value returned for a key not found in a table (absent key) */
+#define LUA_VABSTKEY makevariant(LUA_TNIL, 2)
+
+
+/* macro to test for (any kind of) nil */
+#define ttisnil(v) checktype((v), LUA_TNIL)
+
+
+/* macro to test for a standard nil */
+#define ttisstrictnil(o) checktag((o), LUA_VNIL)
+
+
+#define setnilvalue(obj) settt_(obj, LUA_VNIL)
+
+
+#define isabstkey(v) checktag((v), LUA_VABSTKEY)
+
+
+/*
+** macro to detect non-standard nils (used only in assertions)
+*/
+#define isnonstrictnil(v) (ttisnil(v) && !ttisstrictnil(v))
+
+
+/*
+** By default, entries with any kind of nil are considered empty.
+** (In any definition, values associated with absent keys must also
+** be accepted as empty.)
+*/
+#define isempty(v) ttisnil(v)
+
+
+/* macro defining a value corresponding to an absent key */
+#define ABSTKEYCONSTANT {NULL}, LUA_VABSTKEY
+
+
+/* mark an entry as empty */
+#define setempty(v) settt_(v, LUA_VEMPTY)
+
+
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Booleans
+** ===================================================================
+*/
+
+
+#define LUA_VFALSE makevariant(LUA_TBOOLEAN, 0)
+#define LUA_VTRUE makevariant(LUA_TBOOLEAN, 1)
+
+#define ttisboolean(o) checktype((o), LUA_TBOOLEAN)
+#define ttisfalse(o) checktag((o), LUA_VFALSE)
+#define ttistrue(o) checktag((o), LUA_VTRUE)
+
+
+#define l_isfalse(o) (ttisfalse(o) || ttisnil(o))
+
+
+#define setbfvalue(obj) settt_(obj, LUA_VFALSE)
+#define setbtvalue(obj) settt_(obj, LUA_VTRUE)
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Threads
+** ===================================================================
+*/
+
+#define LUA_VTHREAD makevariant(LUA_TTHREAD, 0)
+
+#define ttisthread(o) checktag((o), ctb(LUA_VTHREAD))
+
+#define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc))
+
+#define setthvalue(L,obj,x) \
+ { TValue *io = (obj); lua_State *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTHREAD)); \
+ checkliveness(L,io); }
+
+#define setthvalue2s(L,o,t) setthvalue(L,s2v(o),t)
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Collectable Objects
+** ===================================================================
+*/
+
+/*
+** Common Header for all collectable objects (in macro form, to be
+** included in other objects)
+*/
+#define CommonHeader struct GCObject *next; lu_byte tt; lu_byte marked
+
+
+/* Common type for all collectable objects */
+typedef struct GCObject {
+ CommonHeader;
+} GCObject;
+
+
+/* Bit mark for collectable types */
+#define BIT_ISCOLLECTABLE (1 << 6)
+
+#define iscollectable(o) (rawtt(o) & BIT_ISCOLLECTABLE)
+
+/* mark a tag as collectable */
+#define ctb(t) ((t) | BIT_ISCOLLECTABLE)
+
+#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)
+
+#define gcvalueraw(v) ((v).gc)
+
+#define setgcovalue(L,obj,x) \
+ { TValue *io = (obj); GCObject *i_g=(x); \
+ val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); }
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Numbers
+** ===================================================================
+*/
+
+/* Variant tags for numbers */
+#define LUA_VNUMINT makevariant(LUA_TNUMBER, 0) /* integer numbers */
+#define LUA_VNUMFLT makevariant(LUA_TNUMBER, 1) /* float numbers */
+
+#define ttisnumber(o) checktype((o), LUA_TNUMBER)
+#define ttisfloat(o) checktag((o), LUA_VNUMFLT)
+#define ttisinteger(o) checktag((o), LUA_VNUMINT)
+
+#define nvalue(o) check_exp(ttisnumber(o), \
+ (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o)))
+#define fltvalue(o) check_exp(ttisfloat(o), val_(o).n)
+#define ivalue(o) check_exp(ttisinteger(o), val_(o).i)
+
+#define fltvalueraw(v) ((v).n)
+#define ivalueraw(v) ((v).i)
+
+#define setfltvalue(obj,x) \
+ { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_VNUMFLT); }
+
+#define chgfltvalue(obj,x) \
+ { TValue *io=(obj); lua_assert(ttisfloat(io)); val_(io).n=(x); }
+
+#define setivalue(obj,x) \
+ { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_VNUMINT); }
+
+#define chgivalue(obj,x) \
+ { TValue *io=(obj); lua_assert(ttisinteger(io)); val_(io).i=(x); }
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Strings
+** ===================================================================
+*/
+
+/* Variant tags for strings */
+#define LUA_VSHRSTR makevariant(LUA_TSTRING, 0) /* short strings */
+#define LUA_VLNGSTR makevariant(LUA_TSTRING, 1) /* long strings */
+
+#define ttisstring(o) checktype((o), LUA_TSTRING)
+#define ttisshrstring(o) checktag((o), ctb(LUA_VSHRSTR))
+#define ttislngstring(o) checktag((o), ctb(LUA_VLNGSTR))
+
+#define tsvalueraw(v) (gco2ts((v).gc))
+
+#define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc))
+
+#define setsvalue(L,obj,x) \
+ { TValue *io = (obj); TString *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(x_->tt)); \
+ checkliveness(L,io); }
+
+/* set a string to the stack */
+#define setsvalue2s(L,o,s) setsvalue(L,s2v(o),s)
+
+/* set a string to a new object */
+#define setsvalue2n setsvalue
+
+
+/*
+** Header for a string value.
+*/
+typedef struct TString {
+ CommonHeader;
+ lu_byte extra; /* reserved words for short strings; "has hash" for longs */
+ lu_byte shrlen; /* length for short strings */
+ unsigned int hash;
+ union {
+ size_t lnglen; /* length for long strings */
+ struct TString *hnext; /* linked list for hash table */
+ } u;
+ char contents[1];
+} TString;
+
+
+
+/*
+** Get the actual string (array of bytes) from a 'TString'.
+*/
+#define getstr(ts) ((ts)->contents)
+
+
+/* get the actual string (array of bytes) from a Lua value */
+#define svalue(o) getstr(tsvalue(o))
+
+/* get string length from 'TString *s' */
+#define tsslen(s) ((s)->tt == LUA_VSHRSTR ? (s)->shrlen : (s)->u.lnglen)
+
+/* get string length from 'TValue *o' */
+#define vslen(o) tsslen(tsvalue(o))
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Userdata
+** ===================================================================
+*/
+
+
+/*
+** Light userdata should be a variant of userdata, but for compatibility
+** reasons they are also different types.
+*/
+#define LUA_VLIGHTUSERDATA makevariant(LUA_TLIGHTUSERDATA, 0)
+
+#define LUA_VUSERDATA makevariant(LUA_TUSERDATA, 0)
+
+#define ttislightuserdata(o) checktag((o), LUA_VLIGHTUSERDATA)
+#define ttisfulluserdata(o) checktag((o), ctb(LUA_VUSERDATA))
+
+#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)
+#define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc))
+
+#define pvalueraw(v) ((v).p)
+
+#define setpvalue(obj,x) \
+ { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_VLIGHTUSERDATA); }
+
+#define setuvalue(L,obj,x) \
+ { TValue *io = (obj); Udata *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VUSERDATA)); \
+ checkliveness(L,io); }
+
+
+/* Ensures that addresses after this type are always fully aligned. */
+typedef union UValue {
+ TValue uv;
+ LUAI_MAXALIGN; /* ensures maximum alignment for udata bytes */
+} UValue;
+
+
+/*
+** Header for userdata with user values;
+** memory area follows the end of this structure.
+*/
+typedef struct Udata {
+ CommonHeader;
+ unsigned short nuvalue; /* number of user values */
+ size_t len; /* number of bytes */
+ struct Table *metatable;
+ GCObject *gclist;
+ UValue uv[1]; /* user values */
+} Udata;
+
+
+/*
+** Header for userdata with no user values. These userdata do not need
+** to be gray during GC, and therefore do not need a 'gclist' field.
+** To simplify, the code always use 'Udata' for both kinds of userdata,
+** making sure it never accesses 'gclist' on userdata with no user values.
+** This structure here is used only to compute the correct size for
+** this representation. (The 'bindata' field in its end ensures correct
+** alignment for binary data following this header.)
+*/
+typedef struct Udata0 {
+ CommonHeader;
+ unsigned short nuvalue; /* number of user values */
+ size_t len; /* number of bytes */
+ struct Table *metatable;
+ union {LUAI_MAXALIGN;} bindata;
+} Udata0;
+
+
+/* compute the offset of the memory area of a userdata */
+#define udatamemoffset(nuv) \
+ ((nuv) == 0 ? offsetof(Udata0, bindata) \
+ : offsetof(Udata, uv) + (sizeof(UValue) * (nuv)))
+
+/* get the address of the memory block inside 'Udata' */
+#define getudatamem(u) (cast_charp(u) + udatamemoffset((u)->nuvalue))
+
+/* compute the size of a userdata */
+#define sizeudata(nuv,nb) (udatamemoffset(nuv) + (nb))
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Prototypes
+** ===================================================================
+*/
+
+#define LUA_VPROTO makevariant(LUA_TPROTO, 0)
+
+
+/*
+** Description of an upvalue for function prototypes
+*/
+typedef struct Upvaldesc {
+ TString *name; /* upvalue name (for debug information) */
+ lu_byte instack; /* whether it is in stack (register) */
+ lu_byte idx; /* index of upvalue (in stack or in outer function's list) */
+ lu_byte kind; /* kind of corresponding variable */
+} Upvaldesc;
+
+
+/*
+** Description of a local variable for function prototypes
+** (used for debug information)
+*/
+typedef struct LocVar {
+ TString *varname;
+ int startpc; /* first point where variable is active */
+ int endpc; /* first point where variable is dead */
+} LocVar;
+
+
+/*
+** Associates the absolute line source for a given instruction ('pc').
+** The array 'lineinfo' gives, for each instruction, the difference in
+** lines from the previous instruction. When that difference does not
+** fit into a byte, Lua saves the absolute line for that instruction.
+** (Lua also saves the absolute line periodically, to speed up the
+** computation of a line number: we can use binary search in the
+** absolute-line array, but we must traverse the 'lineinfo' array
+** linearly to compute a line.)
+*/
+typedef struct AbsLineInfo {
+ int pc;
+ int line;
+} AbsLineInfo;
+
+/*
+** Function Prototypes
+*/
+typedef struct Proto {
+ CommonHeader;
+ lu_byte numparams; /* number of fixed (named) parameters */
+ lu_byte is_vararg;
+ lu_byte maxstacksize; /* number of registers needed by this function */
+ int sizeupvalues; /* size of 'upvalues' */
+ int sizek; /* size of 'k' */
+ int sizecode;
+ int sizelineinfo;
+ int sizep; /* size of 'p' */
+ int sizelocvars;
+ int sizeabslineinfo; /* size of 'abslineinfo' */
+ int linedefined; /* debug information */
+ int lastlinedefined; /* debug information */
+ TValue *k; /* constants used by the function */
+ Instruction *code; /* opcodes */
+ struct Proto **p; /* functions defined inside the function */
+ Upvaldesc *upvalues; /* upvalue information */
+ ls_byte *lineinfo; /* information about source lines (debug information) */
+ AbsLineInfo *abslineinfo; /* idem */
+ LocVar *locvars; /* information about local variables (debug information) */
+ TString *source; /* used for debug information */
+ GCObject *gclist;
+} Proto;
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Functions
+** ===================================================================
+*/
+
+#define LUA_VUPVAL makevariant(LUA_TUPVAL, 0)
+
+
+/* Variant tags for functions */
+#define LUA_VLCL makevariant(LUA_TFUNCTION, 0) /* Lua closure */
+#define LUA_VLCF makevariant(LUA_TFUNCTION, 1) /* light C function */
+#define LUA_VCCL makevariant(LUA_TFUNCTION, 2) /* C closure */
+
+#define ttisfunction(o) checktype(o, LUA_TFUNCTION)
+#define ttisLclosure(o) checktag((o), ctb(LUA_VLCL))
+#define ttislcf(o) checktag((o), LUA_VLCF)
+#define ttisCclosure(o) checktag((o), ctb(LUA_VCCL))
+#define ttisclosure(o) (ttisLclosure(o) || ttisCclosure(o))
+
+
+#define isLfunction(o) ttisLclosure(o)
+
+#define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc))
+#define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc))
+#define fvalue(o) check_exp(ttislcf(o), val_(o).f)
+#define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc))
+
+#define fvalueraw(v) ((v).f)
+
+#define setclLvalue(L,obj,x) \
+ { TValue *io = (obj); LClosure *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VLCL)); \
+ checkliveness(L,io); }
+
+#define setclLvalue2s(L,o,cl) setclLvalue(L,s2v(o),cl)
+
+#define setfvalue(obj,x) \
+ { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_VLCF); }
+
+#define setclCvalue(L,obj,x) \
+ { TValue *io = (obj); CClosure *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VCCL)); \
+ checkliveness(L,io); }
+
+
+/*
+** Upvalues for Lua closures
+*/
+typedef struct UpVal {
+ CommonHeader;
+ lu_byte tbc; /* true if it represents a to-be-closed variable */
+ TValue *v; /* points to stack or to its own value */
+ union {
+ struct { /* (when open) */
+ struct UpVal *next; /* linked list */
+ struct UpVal **previous;
+ } open;
+ TValue value; /* the value (when closed) */
+ } u;
+} UpVal;
+
+
+
+#define ClosureHeader \
+ CommonHeader; lu_byte nupvalues; GCObject *gclist
+
+typedef struct CClosure {
+ ClosureHeader;
+ lua_CFunction f;
+ TValue upvalue[1]; /* list of upvalues */
+} CClosure;
+
+
+typedef struct LClosure {
+ ClosureHeader;
+ struct Proto *p;
+ UpVal *upvals[1]; /* list of upvalues */
+} LClosure;
+
+
+typedef union Closure {
+ CClosure c;
+ LClosure l;
+} Closure;
+
+
+#define getproto(o) (clLvalue(o)->p)
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Tables
+** ===================================================================
+*/
+
+#define LUA_VTABLE makevariant(LUA_TTABLE, 0)
+
+#define ttistable(o) checktag((o), ctb(LUA_VTABLE))
+
+#define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc))
+
+#define sethvalue(L,obj,x) \
+ { TValue *io = (obj); Table *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTABLE)); \
+ checkliveness(L,io); }
+
+#define sethvalue2s(L,o,h) sethvalue(L,s2v(o),h)
+
+
+/*
+** Nodes for Hash tables: A pack of two TValue's (key-value pairs)
+** plus a 'next' field to link colliding entries. The distribution
+** of the key's fields ('key_tt' and 'key_val') not forming a proper
+** 'TValue' allows for a smaller size for 'Node' both in 4-byte
+** and 8-byte alignments.
+*/
+typedef union Node {
+ struct NodeKey {
+ TValuefields; /* fields for value */
+ lu_byte key_tt; /* key type */
+ int next; /* for chaining */
+ Value key_val; /* key value */
+ } u;
+ TValue i_val; /* direct access to node's value as a proper 'TValue' */
+} Node;
+
+
+/* copy a value into a key */
+#define setnodekey(L,node,obj) \
+ { Node *n_=(node); const TValue *io_=(obj); \
+ n_->u.key_val = io_->value_; n_->u.key_tt = io_->tt_; \
+ checkliveness(L,io_); }
+
+
+/* copy a value from a key */
+#define getnodekey(L,obj,node) \
+ { TValue *io_=(obj); const Node *n_=(node); \
+ io_->value_ = n_->u.key_val; io_->tt_ = n_->u.key_tt; \
+ checkliveness(L,io_); }
+
+
+/*
+** About 'alimit': if 'isrealasize(t)' is true, then 'alimit' is the
+** real size of 'array'. Otherwise, the real size of 'array' is the
+** smallest power of two not smaller than 'alimit' (or zero iff 'alimit'
+** is zero); 'alimit' is then used as a hint for #t.
+*/
+
+#define BITRAS (1 << 7)
+#define isrealasize(t) (!((t)->flags & BITRAS))
+#define setrealasize(t) ((t)->flags &= cast_byte(~BITRAS))
+#define setnorealasize(t) ((t)->flags |= BITRAS)
+
+
+typedef struct Table {
+ CommonHeader;
+ lu_byte flags; /* 1<<p means tagmethod(p) is not present */
+ lu_byte lsizenode; /* log2 of size of 'node' array */
+ unsigned int alimit; /* "limit" of 'array' array */
+ TValue *array; /* array part */
+ Node *node;
+ Node *lastfree; /* any free position is before this position */
+ struct Table *metatable;
+ GCObject *gclist;
+} Table;
+
+
+/*
+** Macros to manipulate keys inserted in nodes
+*/
+#define keytt(node) ((node)->u.key_tt)
+#define keyval(node) ((node)->u.key_val)
+
+#define keyisnil(node) (keytt(node) == LUA_TNIL)
+#define keyisinteger(node) (keytt(node) == LUA_VNUMINT)
+#define keyival(node) (keyval(node).i)
+#define keyisshrstr(node) (keytt(node) == ctb(LUA_VSHRSTR))
+#define keystrval(node) (gco2ts(keyval(node).gc))
+
+#define setnilkey(node) (keytt(node) = LUA_TNIL)
+
+#define keyiscollectable(n) (keytt(n) & BIT_ISCOLLECTABLE)
+
+#define gckey(n) (keyval(n).gc)
+#define gckeyN(n) (keyiscollectable(n) ? gckey(n) : NULL)
+
+
+/*
+** Dead keys in tables have the tag DEADKEY but keep their original
+** gcvalue. This distinguishes them from regular keys but allows them to
+** be found when searched in a special way. ('next' needs that to find
+** keys removed from a table during a traversal.)
+*/
+#define setdeadkey(node) (keytt(node) = LUA_TDEADKEY)
+#define keyisdead(node) (keytt(node) == LUA_TDEADKEY)
+
+/* }================================================================== */
+
+
+
+/*
+** 'module' operation for hashing (size is always a power of 2)
+*/
+#define lmod(s,size) \
+ (check_exp((size&(size-1))==0, (cast_int((s) & ((size)-1)))))
+
+
+#define twoto(x) (1<<(x))
+#define sizenode(t) (twoto((t)->lsizenode))
+
+
+/* size of buffer for 'luaO_utf8esc' function */
+#define UTF8BUFFSZ 8
+
+LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x);
+LUAI_FUNC int luaO_ceillog2 (unsigned int x);
+LUAI_FUNC int luaO_rawarith (lua_State *L, int op, const TValue *p1,
+ const TValue *p2, TValue *res);
+LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1,
+ const TValue *p2, StkId res);
+LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o);
+LUAI_FUNC int luaO_hexavalue (int c);
+LUAI_FUNC void luaO_tostring (lua_State *L, TValue *obj);
+LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt,
+ va_list argp);
+LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...);
+LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t srclen);
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/lopcodes.c b/source/luametatex/source/luacore/lua54/src/lopcodes.c
new file mode 100644
index 000000000..c67aa227c
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lopcodes.c
@@ -0,0 +1,104 @@
+/*
+** $Id: lopcodes.c $
+** Opcodes for Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+#define lopcodes_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include "lopcodes.h"
+
+
+/* ORDER OP */
+
+LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {
+/* MM OT IT T A mode opcode */
+ opmode(0, 0, 0, 0, 1, iABC) /* OP_MOVE */
+ ,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADI */
+ ,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADF */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADK */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADKX */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADFALSE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LFALSESKIP */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADTRUE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADNIL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETUPVAL */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABUP */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABLE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETFIELD */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABUP */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABLE */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETI */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETFIELD */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_NEWTABLE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SELF */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUBK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MULK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MODK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_POWK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIVK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIVK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BANDK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BORK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXORK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHRI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHLI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADD */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUB */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MUL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MOD */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_POW */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIV */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIV */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BAND */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BOR */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXOR */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHR */
+ ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBIN */
+ ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINI*/
+ ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINK*/
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_UNM */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BNOT */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_NOT */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LEN */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_CONCAT */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_CLOSE */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_TBC */
+ ,opmode(0, 0, 0, 0, 0, isJ) /* OP_JMP */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQ */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LT */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LE */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQK */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LTI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LEI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_GTI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_GEI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_TEST */
+ ,opmode(0, 0, 0, 1, 1, iABC) /* OP_TESTSET */
+ ,opmode(0, 1, 1, 0, 1, iABC) /* OP_CALL */
+ ,opmode(0, 1, 1, 0, 1, iABC) /* OP_TAILCALL */
+ ,opmode(0, 0, 1, 0, 0, iABC) /* OP_RETURN */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN0 */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN1 */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORLOOP */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORPREP */
+ ,opmode(0, 0, 0, 0, 0, iABx) /* OP_TFORPREP */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_TFORCALL */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_TFORLOOP */
+ ,opmode(0, 0, 1, 0, 0, iABC) /* OP_SETLIST */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_CLOSURE */
+ ,opmode(0, 1, 0, 0, 1, iABC) /* OP_VARARG */
+ ,opmode(0, 0, 1, 0, 1, iABC) /* OP_VARARGPREP */
+ ,opmode(0, 0, 0, 0, 0, iAx) /* OP_EXTRAARG */
+};
+
diff --git a/source/luametatex/source/luacore/lua54/src/lopcodes.h b/source/luametatex/source/luacore/lua54/src/lopcodes.h
new file mode 100644
index 000000000..7c2745159
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lopcodes.h
@@ -0,0 +1,405 @@
+/*
+** $Id: lopcodes.h $
+** Opcodes for Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lopcodes_h
+#define lopcodes_h
+
+#include "llimits.h"
+
+
+/*===========================================================================
+ We assume that instructions are unsigned 32-bit integers.
+ All instructions have an opcode in the first 7 bits.
+ Instructions can have the following formats:
+
+ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
+ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+iABC C(8) | B(8) |k| A(8) | Op(7) |
+iABx Bx(17) | A(8) | Op(7) |
+iAsBx sBx (signed)(17) | A(8) | Op(7) |
+iAx Ax(25) | Op(7) |
+isJ sJ(25) | Op(7) |
+
+ A signed argument is represented in excess K: the represented value is
+ the written unsigned value minus K, where K is half the maximum for the
+ corresponding unsigned argument.
+===========================================================================*/
+
+
+enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */
+
+
+/*
+** size and position of opcode arguments.
+*/
+#define SIZE_C 8
+#define SIZE_B 8
+#define SIZE_Bx (SIZE_C + SIZE_B + 1)
+#define SIZE_A 8
+#define SIZE_Ax (SIZE_Bx + SIZE_A)
+#define SIZE_sJ (SIZE_Bx + SIZE_A)
+
+#define SIZE_OP 7
+
+#define POS_OP 0
+
+#define POS_A (POS_OP + SIZE_OP)
+#define POS_k (POS_A + SIZE_A)
+#define POS_B (POS_k + 1)
+#define POS_C (POS_B + SIZE_B)
+
+#define POS_Bx POS_k
+
+#define POS_Ax POS_A
+
+#define POS_sJ POS_A
+
+
+/*
+** limits for opcode arguments.
+** we use (signed) 'int' to manipulate most arguments,
+** so they must fit in ints.
+*/
+
+/* Check whether type 'int' has at least 'b' bits ('b' < 32) */
+#define L_INTHASBITS(b) ((UINT_MAX >> ((b) - 1)) >= 1)
+
+
+#if L_INTHASBITS(SIZE_Bx)
+#define MAXARG_Bx ((1<<SIZE_Bx)-1)
+#else
+#define MAXARG_Bx MAX_INT
+#endif
+
+#define OFFSET_sBx (MAXARG_Bx>>1) /* 'sBx' is signed */
+
+
+#if L_INTHASBITS(SIZE_Ax)
+#define MAXARG_Ax ((1<<SIZE_Ax)-1)
+#else
+#define MAXARG_Ax MAX_INT
+#endif
+
+#if L_INTHASBITS(SIZE_sJ)
+#define MAXARG_sJ ((1 << SIZE_sJ) - 1)
+#else
+#define MAXARG_sJ MAX_INT
+#endif
+
+#define OFFSET_sJ (MAXARG_sJ >> 1)
+
+
+#define MAXARG_A ((1<<SIZE_A)-1)
+#define MAXARG_B ((1<<SIZE_B)-1)
+#define MAXARG_C ((1<<SIZE_C)-1)
+#define OFFSET_sC (MAXARG_C >> 1)
+
+#define int2sC(i) ((i) + OFFSET_sC)
+#define sC2int(i) ((i) - OFFSET_sC)
+
+
+/* creates a mask with 'n' 1 bits at position 'p' */
+#define MASK1(n,p) ((~((~(Instruction)0)<<(n)))<<(p))
+
+/* creates a mask with 'n' 0 bits at position 'p' */
+#define MASK0(n,p) (~MASK1(n,p))
+
+/*
+** the following macros help to manipulate instructions
+*/
+
+#define GET_OPCODE(i) (cast(OpCode, ((i)>>POS_OP) & MASK1(SIZE_OP,0)))
+#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \
+ ((cast(Instruction, o)<<POS_OP)&MASK1(SIZE_OP,POS_OP))))
+
+#define checkopm(i,m) (getOpMode(GET_OPCODE(i)) == m)
+
+
+#define getarg(i,pos,size) (cast_int(((i)>>(pos)) & MASK1(size,0)))
+#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \
+ ((cast(Instruction, v)<<pos)&MASK1(size,pos))))
+
+#define GETARG_A(i) getarg(i, POS_A, SIZE_A)
+#define SETARG_A(i,v) setarg(i, v, POS_A, SIZE_A)
+
+#define GETARG_B(i) check_exp(checkopm(i, iABC), getarg(i, POS_B, SIZE_B))
+#define GETARG_sB(i) sC2int(GETARG_B(i))
+#define SETARG_B(i,v) setarg(i, v, POS_B, SIZE_B)
+
+#define GETARG_C(i) check_exp(checkopm(i, iABC), getarg(i, POS_C, SIZE_C))
+#define GETARG_sC(i) sC2int(GETARG_C(i))
+#define SETARG_C(i,v) setarg(i, v, POS_C, SIZE_C)
+
+#define TESTARG_k(i) check_exp(checkopm(i, iABC), (cast_int(((i) & (1u << POS_k)))))
+#define GETARG_k(i) check_exp(checkopm(i, iABC), getarg(i, POS_k, 1))
+#define SETARG_k(i,v) setarg(i, v, POS_k, 1)
+
+#define GETARG_Bx(i) check_exp(checkopm(i, iABx), getarg(i, POS_Bx, SIZE_Bx))
+#define SETARG_Bx(i,v) setarg(i, v, POS_Bx, SIZE_Bx)
+
+#define GETARG_Ax(i) check_exp(checkopm(i, iAx), getarg(i, POS_Ax, SIZE_Ax))
+#define SETARG_Ax(i,v) setarg(i, v, POS_Ax, SIZE_Ax)
+
+#define GETARG_sBx(i) \
+ check_exp(checkopm(i, iAsBx), getarg(i, POS_Bx, SIZE_Bx) - OFFSET_sBx)
+#define SETARG_sBx(i,b) SETARG_Bx((i),cast_uint((b)+OFFSET_sBx))
+
+#define GETARG_sJ(i) \
+ check_exp(checkopm(i, isJ), getarg(i, POS_sJ, SIZE_sJ) - OFFSET_sJ)
+#define SETARG_sJ(i,j) \
+ setarg(i, cast_uint((j)+OFFSET_sJ), POS_sJ, SIZE_sJ)
+
+
+#define CREATE_ABCk(o,a,b,c,k) ((cast(Instruction, o)<<POS_OP) \
+ | (cast(Instruction, a)<<POS_A) \
+ | (cast(Instruction, b)<<POS_B) \
+ | (cast(Instruction, c)<<POS_C) \
+ | (cast(Instruction, k)<<POS_k))
+
+#define CREATE_ABx(o,a,bc) ((cast(Instruction, o)<<POS_OP) \
+ | (cast(Instruction, a)<<POS_A) \
+ | (cast(Instruction, bc)<<POS_Bx))
+
+#define CREATE_Ax(o,a) ((cast(Instruction, o)<<POS_OP) \
+ | (cast(Instruction, a)<<POS_Ax))
+
+#define CREATE_sJ(o,j,k) ((cast(Instruction, o) << POS_OP) \
+ | (cast(Instruction, j) << POS_sJ) \
+ | (cast(Instruction, k) << POS_k))
+
+
+#if !defined(MAXINDEXRK) /* (for debugging only) */
+#define MAXINDEXRK MAXARG_B
+#endif
+
+
+/*
+** invalid register that fits in 8 bits
+*/
+#define NO_REG MAXARG_A
+
+
+/*
+** R[x] - register
+** K[x] - constant (in constant table)
+** RK(x) == if k(i) then K[x] else R[x]
+*/
+
+
+/*
+** Grep "ORDER OP" if you change these enums. Opcodes marked with a (*)
+** has extra descriptions in the notes after the enumeration.
+*/
+
+typedef enum {
+/*----------------------------------------------------------------------
+ name args description
+------------------------------------------------------------------------*/
+OP_MOVE,/* A B R[A] := R[B] */
+OP_LOADI,/* A sBx R[A] := sBx */
+OP_LOADF,/* A sBx R[A] := (lua_Number)sBx */
+OP_LOADK,/* A Bx R[A] := K[Bx] */
+OP_LOADKX,/* A R[A] := K[extra arg] */
+OP_LOADFALSE,/* A R[A] := false */
+OP_LFALSESKIP,/*A R[A] := false; pc++ (*) */
+OP_LOADTRUE,/* A R[A] := true */
+OP_LOADNIL,/* A B R[A], R[A+1], ..., R[A+B] := nil */
+OP_GETUPVAL,/* A B R[A] := UpValue[B] */
+OP_SETUPVAL,/* A B UpValue[B] := R[A] */
+
+OP_GETTABUP,/* A B C R[A] := UpValue[B][K[C]:string] */
+OP_GETTABLE,/* A B C R[A] := R[B][R[C]] */
+OP_GETI,/* A B C R[A] := R[B][C] */
+OP_GETFIELD,/* A B C R[A] := R[B][K[C]:string] */
+
+OP_SETTABUP,/* A B C UpValue[A][K[B]:string] := RK(C) */
+OP_SETTABLE,/* A B C R[A][R[B]] := RK(C) */
+OP_SETI,/* A B C R[A][B] := RK(C) */
+OP_SETFIELD,/* A B C R[A][K[B]:string] := RK(C) */
+
+OP_NEWTABLE,/* A B C k R[A] := {} */
+
+OP_SELF,/* A B C R[A+1] := R[B]; R[A] := R[B][RK(C):string] */
+
+OP_ADDI,/* A B sC R[A] := R[B] + sC */
+
+OP_ADDK,/* A B C R[A] := R[B] + K[C]:number */
+OP_SUBK,/* A B C R[A] := R[B] - K[C]:number */
+OP_MULK,/* A B C R[A] := R[B] * K[C]:number */
+OP_MODK,/* A B C R[A] := R[B] % K[C]:number */
+OP_POWK,/* A B C R[A] := R[B] ^ K[C]:number */
+OP_DIVK,/* A B C R[A] := R[B] / K[C]:number */
+OP_IDIVK,/* A B C R[A] := R[B] // K[C]:number */
+
+OP_BANDK,/* A B C R[A] := R[B] & K[C]:integer */
+OP_BORK,/* A B C R[A] := R[B] | K[C]:integer */
+OP_BXORK,/* A B C R[A] := R[B] ~ K[C]:integer */
+
+OP_SHRI,/* A B sC R[A] := R[B] >> sC */
+OP_SHLI,/* A B sC R[A] := sC << R[B] */
+
+OP_ADD,/* A B C R[A] := R[B] + R[C] */
+OP_SUB,/* A B C R[A] := R[B] - R[C] */
+OP_MUL,/* A B C R[A] := R[B] * R[C] */
+OP_MOD,/* A B C R[A] := R[B] % R[C] */
+OP_POW,/* A B C R[A] := R[B] ^ R[C] */
+OP_DIV,/* A B C R[A] := R[B] / R[C] */
+OP_IDIV,/* A B C R[A] := R[B] // R[C] */
+
+OP_BAND,/* A B C R[A] := R[B] & R[C] */
+OP_BOR,/* A B C R[A] := R[B] | R[C] */
+OP_BXOR,/* A B C R[A] := R[B] ~ R[C] */
+OP_SHL,/* A B C R[A] := R[B] << R[C] */
+OP_SHR,/* A B C R[A] := R[B] >> R[C] */
+
+OP_MMBIN,/* A B C call C metamethod over R[A] and R[B] (*) */
+OP_MMBINI,/* A sB C k call C metamethod over R[A] and sB */
+OP_MMBINK,/* A B C k call C metamethod over R[A] and K[B] */
+
+OP_UNM,/* A B R[A] := -R[B] */
+OP_BNOT,/* A B R[A] := ~R[B] */
+OP_NOT,/* A B R[A] := not R[B] */
+OP_LEN,/* A B R[A] := #R[B] (length operator) */
+
+OP_CONCAT,/* A B R[A] := R[A].. ... ..R[A + B - 1] */
+
+OP_CLOSE,/* A close all upvalues >= R[A] */
+OP_TBC,/* A mark variable A "to be closed" */
+OP_JMP,/* sJ pc += sJ */
+OP_EQ,/* A B k if ((R[A] == R[B]) ~= k) then pc++ */
+OP_LT,/* A B k if ((R[A] < R[B]) ~= k) then pc++ */
+OP_LE,/* A B k if ((R[A] <= R[B]) ~= k) then pc++ */
+
+OP_EQK,/* A B k if ((R[A] == K[B]) ~= k) then pc++ */
+OP_EQI,/* A sB k if ((R[A] == sB) ~= k) then pc++ */
+OP_LTI,/* A sB k if ((R[A] < sB) ~= k) then pc++ */
+OP_LEI,/* A sB k if ((R[A] <= sB) ~= k) then pc++ */
+OP_GTI,/* A sB k if ((R[A] > sB) ~= k) then pc++ */
+OP_GEI,/* A sB k if ((R[A] >= sB) ~= k) then pc++ */
+
+OP_TEST,/* A k if (not R[A] == k) then pc++ */
+OP_TESTSET,/* A B k if (not R[B] == k) then pc++ else R[A] := R[B] (*) */
+
+OP_CALL,/* A B C R[A], ... ,R[A+C-2] := R[A](R[A+1], ... ,R[A+B-1]) */
+OP_TAILCALL,/* A B C k return R[A](R[A+1], ... ,R[A+B-1]) */
+
+OP_RETURN,/* A B C k return R[A], ... ,R[A+B-2] (see note) */
+OP_RETURN0,/* return */
+OP_RETURN1,/* A return R[A] */
+
+OP_FORLOOP,/* A Bx update counters; if loop continues then pc-=Bx; */
+OP_FORPREP,/* A Bx <check values and prepare counters>;
+ if not to run then pc+=Bx+1; */
+
+OP_TFORPREP,/* A Bx create upvalue for R[A + 3]; pc+=Bx */
+OP_TFORCALL,/* A C R[A+4], ... ,R[A+3+C] := R[A](R[A+1], R[A+2]); */
+OP_TFORLOOP,/* A Bx if R[A+2] ~= nil then { R[A]=R[A+2]; pc -= Bx } */
+
+OP_SETLIST,/* A B C k R[A][C+i] := R[A+i], 1 <= i <= B */
+
+OP_CLOSURE,/* A Bx R[A] := closure(KPROTO[Bx]) */
+
+OP_VARARG,/* A C R[A], R[A+1], ..., R[A+C-2] = vararg */
+
+OP_VARARGPREP,/*A (adjust vararg parameters) */
+
+OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */
+} OpCode;
+
+
+#define NUM_OPCODES ((int)(OP_EXTRAARG) + 1)
+
+
+
+/*===========================================================================
+ Notes:
+
+ (*) Opcode OP_LFALSESKIP is used to convert a condition to a boolean
+ value, in a code equivalent to (not cond ? false : true). (It
+ produces false and skips the next instruction producing true.)
+
+ (*) Opcodes OP_MMBIN and variants follow each arithmetic and
+ bitwise opcode. If the operation succeeds, it skips this next
+ opcode. Otherwise, this opcode calls the corresponding metamethod.
+
+ (*) Opcode OP_TESTSET is used in short-circuit expressions that need
+ both to jump and to produce a value, such as (a = b or c).
+
+ (*) In OP_CALL, if (B == 0) then B = top - A. If (C == 0), then
+ 'top' is set to last_result+1, so next open instruction (OP_CALL,
+ OP_RETURN*, OP_SETLIST) may use 'top'.
+
+ (*) In OP_VARARG, if (C == 0) then use actual number of varargs and
+ set top (like in OP_CALL with C == 0).
+
+ (*) In OP_RETURN, if (B == 0) then return up to 'top'.
+
+ (*) In OP_LOADKX and OP_NEWTABLE, the next instruction is always
+ OP_EXTRAARG.
+
+ (*) In OP_SETLIST, if (B == 0) then real B = 'top'; if k, then
+ real C = EXTRAARG _ C (the bits of EXTRAARG concatenated with the
+ bits of C).
+
+ (*) In OP_NEWTABLE, B is log2 of the hash size (which is always a
+ power of 2) plus 1, or zero for size zero. If not k, the array size
+ is C. Otherwise, the array size is EXTRAARG _ C.
+
+ (*) For comparisons, k specifies what condition the test should accept
+ (true or false).
+
+ (*) In OP_MMBINI/OP_MMBINK, k means the arguments were flipped
+ (the constant is the first operand).
+
+ (*) All 'skips' (pc++) assume that next instruction is a jump.
+
+ (*) In instructions OP_RETURN/OP_TAILCALL, 'k' specifies that the
+ function builds upvalues, which may need to be closed. C > 0 means
+ the function is vararg, so that its 'func' must be corrected before
+ returning; in this case, (C - 1) is its number of fixed parameters.
+
+ (*) In comparisons with an immediate operand, C signals whether the
+ original operand was a float. (It must be corrected in case of
+ metamethods.)
+
+===========================================================================*/
+
+
+/*
+** masks for instruction properties. The format is:
+** bits 0-2: op mode
+** bit 3: instruction set register A
+** bit 4: operator is a test (next instruction must be a jump)
+** bit 5: instruction uses 'L->top' set by previous instruction (when B == 0)
+** bit 6: instruction sets 'L->top' for next instruction (when C == 0)
+** bit 7: instruction is an MM instruction (call a metamethod)
+*/
+
+LUAI_DDEC(const lu_byte luaP_opmodes[NUM_OPCODES];)
+
+#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 7))
+#define testAMode(m) (luaP_opmodes[m] & (1 << 3))
+#define testTMode(m) (luaP_opmodes[m] & (1 << 4))
+#define testITMode(m) (luaP_opmodes[m] & (1 << 5))
+#define testOTMode(m) (luaP_opmodes[m] & (1 << 6))
+#define testMMMode(m) (luaP_opmodes[m] & (1 << 7))
+
+/* "out top" (set top for next instruction) */
+#define isOT(i) \
+ ((testOTMode(GET_OPCODE(i)) && GETARG_C(i) == 0) || \
+ GET_OPCODE(i) == OP_TAILCALL)
+
+/* "in top" (uses top from previous instruction) */
+#define isIT(i) (testITMode(GET_OPCODE(i)) && GETARG_B(i) == 0)
+
+#define opmode(mm,ot,it,t,a,m) \
+ (((mm) << 7) | ((ot) << 6) | ((it) << 5) | ((t) << 4) | ((a) << 3) | (m))
+
+
+/* number of list items to accumulate before a SETLIST instruction */
+#define LFIELDS_PER_FLUSH 50
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lopnames.h b/source/luametatex/source/luacore/lua54/src/lopnames.h
new file mode 100644
index 000000000..965cec9bf
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lopnames.h
@@ -0,0 +1,103 @@
+/*
+** $Id: lopnames.h $
+** Opcode names
+** See Copyright Notice in lua.h
+*/
+
+#if !defined(lopnames_h)
+#define lopnames_h
+
+#include <stddef.h>
+
+
+/* ORDER OP */
+
+static const char *const opnames[] = {
+ "MOVE",
+ "LOADI",
+ "LOADF",
+ "LOADK",
+ "LOADKX",
+ "LOADFALSE",
+ "LFALSESKIP",
+ "LOADTRUE",
+ "LOADNIL",
+ "GETUPVAL",
+ "SETUPVAL",
+ "GETTABUP",
+ "GETTABLE",
+ "GETI",
+ "GETFIELD",
+ "SETTABUP",
+ "SETTABLE",
+ "SETI",
+ "SETFIELD",
+ "NEWTABLE",
+ "SELF",
+ "ADDI",
+ "ADDK",
+ "SUBK",
+ "MULK",
+ "MODK",
+ "POWK",
+ "DIVK",
+ "IDIVK",
+ "BANDK",
+ "BORK",
+ "BXORK",
+ "SHRI",
+ "SHLI",
+ "ADD",
+ "SUB",
+ "MUL",
+ "MOD",
+ "POW",
+ "DIV",
+ "IDIV",
+ "BAND",
+ "BOR",
+ "BXOR",
+ "SHL",
+ "SHR",
+ "MMBIN",
+ "MMBINI",
+ "MMBINK",
+ "UNM",
+ "BNOT",
+ "NOT",
+ "LEN",
+ "CONCAT",
+ "CLOSE",
+ "TBC",
+ "JMP",
+ "EQ",
+ "LT",
+ "LE",
+ "EQK",
+ "EQI",
+ "LTI",
+ "LEI",
+ "GTI",
+ "GEI",
+ "TEST",
+ "TESTSET",
+ "CALL",
+ "TAILCALL",
+ "RETURN",
+ "RETURN0",
+ "RETURN1",
+ "FORLOOP",
+ "FORPREP",
+ "TFORPREP",
+ "TFORCALL",
+ "TFORLOOP",
+ "SETLIST",
+ "CLOSURE",
+ "VARARG",
+ "VARARGPREP",
+ "EXTRAARG",
+ NULL
+};
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/loslib.c b/source/luametatex/source/luacore/lua54/src/loslib.c
new file mode 100644
index 000000000..3e20d622b
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/loslib.c
@@ -0,0 +1,430 @@
+/*
+** $Id: loslib.c $
+** Standard Operating System library
+** See Copyright Notice in lua.h
+*/
+
+#define loslib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <errno.h>
+#include <locale.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/*
+** {==================================================================
+** List of valid conversion specifiers for the 'strftime' function;
+** options are grouped by length; group of length 2 start with '||'.
+** ===================================================================
+*/
+#if !defined(LUA_STRFTIMEOPTIONS) /* { */
+
+/* options for ANSI C 89 (only 1-char options) */
+#define L_STRFTIMEC89 "aAbBcdHIjmMpSUwWxXyYZ%"
+
+/* options for ISO C 99 and POSIX */
+#define L_STRFTIMEC99 "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%" \
+ "||" "EcECExEXEyEY" "OdOeOHOIOmOMOSOuOUOVOwOWOy" /* two-char options */
+
+/* options for Windows */
+#define L_STRFTIMEWIN "aAbBcdHIjmMpSUwWxXyYzZ%" \
+ "||" "#c#x#d#H#I#j#m#M#S#U#w#W#y#Y" /* two-char options */
+
+#if defined(LUA_USE_WINDOWS)
+#define LUA_STRFTIMEOPTIONS L_STRFTIMEWIN
+#elif defined(LUA_USE_C89)
+#define LUA_STRFTIMEOPTIONS L_STRFTIMEC89
+#else /* C99 specification */
+#define LUA_STRFTIMEOPTIONS L_STRFTIMEC99
+#endif
+
+#endif /* } */
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Configuration for time-related stuff
+** ===================================================================
+*/
+
+/*
+** type to represent time_t in Lua
+*/
+#if !defined(LUA_NUMTIME) /* { */
+
+#define l_timet lua_Integer
+#define l_pushtime(L,t) lua_pushinteger(L,(lua_Integer)(t))
+#define l_gettime(L,arg) luaL_checkinteger(L, arg)
+
+#else /* }{ */
+
+#define l_timet lua_Number
+#define l_pushtime(L,t) lua_pushnumber(L,(lua_Number)(t))
+#define l_gettime(L,arg) luaL_checknumber(L, arg)
+
+#endif /* } */
+
+
+#if !defined(l_gmtime) /* { */
+/*
+** By default, Lua uses gmtime/localtime, except when POSIX is available,
+** where it uses gmtime_r/localtime_r
+*/
+
+#if defined(LUA_USE_POSIX) /* { */
+
+#define l_gmtime(t,r) gmtime_r(t,r)
+#define l_localtime(t,r) localtime_r(t,r)
+
+#else /* }{ */
+
+/* ISO C definitions */
+#define l_gmtime(t,r) ((void)(r)->tm_sec, gmtime(t))
+#define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t))
+
+#endif /* } */
+
+#endif /* } */
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Configuration for 'tmpnam':
+** By default, Lua uses tmpnam except when POSIX is available, where
+** it uses mkstemp.
+** ===================================================================
+*/
+#if !defined(lua_tmpnam) /* { */
+
+#if defined(LUA_USE_POSIX) /* { */
+
+#include <unistd.h>
+
+#define LUA_TMPNAMBUFSIZE 32
+
+#if !defined(LUA_TMPNAMTEMPLATE)
+#define LUA_TMPNAMTEMPLATE "/tmp/lua_XXXXXX"
+#endif
+
+#define lua_tmpnam(b,e) { \
+ strcpy(b, LUA_TMPNAMTEMPLATE); \
+ e = mkstemp(b); \
+ if (e != -1) close(e); \
+ e = (e == -1); }
+
+#else /* }{ */
+
+/* ISO C definitions */
+#define LUA_TMPNAMBUFSIZE L_tmpnam
+#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); }
+
+#endif /* } */
+
+#endif /* } */
+/* }================================================================== */
+
+
+
+static int os_execute (lua_State *L) {
+ const char *cmd = luaL_optstring(L, 1, NULL);
+ int stat;
+ errno = 0;
+ stat = system(cmd);
+ if (cmd != NULL)
+ return luaL_execresult(L, stat);
+ else {
+ lua_pushboolean(L, stat); /* true if there is a shell */
+ return 1;
+ }
+}
+
+
+static int os_remove (lua_State *L) {
+ const char *filename = luaL_checkstring(L, 1);
+ return luaL_fileresult(L, remove(filename) == 0, filename);
+}
+
+
+static int os_rename (lua_State *L) {
+ const char *fromname = luaL_checkstring(L, 1);
+ const char *toname = luaL_checkstring(L, 2);
+ return luaL_fileresult(L, rename(fromname, toname) == 0, NULL);
+}
+
+
+static int os_tmpname (lua_State *L) {
+ char buff[LUA_TMPNAMBUFSIZE];
+ int err;
+ lua_tmpnam(buff, err);
+ if (l_unlikely(err))
+ return luaL_error(L, "unable to generate a unique filename");
+ lua_pushstring(L, buff);
+ return 1;
+}
+
+
+static int os_getenv (lua_State *L) {
+ lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */
+ return 1;
+}
+
+
+static int os_clock (lua_State *L) {
+ lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC);
+ return 1;
+}
+
+
+/*
+** {======================================================
+** Time/Date operations
+** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S,
+** wday=%w+1, yday=%j, isdst=? }
+** =======================================================
+*/
+
+/*
+** About the overflow check: an overflow cannot occur when time
+** is represented by a lua_Integer, because either lua_Integer is
+** large enough to represent all int fields or it is not large enough
+** to represent a time that cause a field to overflow. However, if
+** times are represented as doubles and lua_Integer is int, then the
+** time 0x1.e1853b0d184f6p+55 would cause an overflow when adding 1900
+** to compute the year.
+*/
+static void setfield (lua_State *L, const char *key, int value, int delta) {
+ #if (defined(LUA_NUMTIME) && LUA_MAXINTEGER <= INT_MAX)
+ if (l_unlikely(value > LUA_MAXINTEGER - delta))
+ luaL_error(L, "field '%s' is out-of-bound", key);
+ #endif
+ lua_pushinteger(L, (lua_Integer)value + delta);
+ lua_setfield(L, -2, key);
+}
+
+
+static void setboolfield (lua_State *L, const char *key, int value) {
+ if (value < 0) /* undefined? */
+ return; /* does not set field */
+ lua_pushboolean(L, value);
+ lua_setfield(L, -2, key);
+}
+
+
+/*
+** Set all fields from structure 'tm' in the table on top of the stack
+*/
+static void setallfields (lua_State *L, struct tm *stm) {
+ setfield(L, "year", stm->tm_year, 1900);
+ setfield(L, "month", stm->tm_mon, 1);
+ setfield(L, "day", stm->tm_mday, 0);
+ setfield(L, "hour", stm->tm_hour, 0);
+ setfield(L, "min", stm->tm_min, 0);
+ setfield(L, "sec", stm->tm_sec, 0);
+ setfield(L, "yday", stm->tm_yday, 1);
+ setfield(L, "wday", stm->tm_wday, 1);
+ setboolfield(L, "isdst", stm->tm_isdst);
+}
+
+
+static int getboolfield (lua_State *L, const char *key) {
+ int res;
+ res = (lua_getfield(L, -1, key) == LUA_TNIL) ? -1 : lua_toboolean(L, -1);
+ lua_pop(L, 1);
+ return res;
+}
+
+
+static int getfield (lua_State *L, const char *key, int d, int delta) {
+ int isnum;
+ int t = lua_getfield(L, -1, key); /* get field and its type */
+ lua_Integer res = lua_tointegerx(L, -1, &isnum);
+ if (!isnum) { /* field is not an integer? */
+ if (l_unlikely(t != LUA_TNIL)) /* some other value? */
+ return luaL_error(L, "field '%s' is not an integer", key);
+ else if (l_unlikely(d < 0)) /* absent field; no default? */
+ return luaL_error(L, "field '%s' missing in date table", key);
+ res = d;
+ }
+ else {
+ /* unsigned avoids overflow when lua_Integer has 32 bits */
+ if (!(res >= 0 ? (lua_Unsigned)res <= (lua_Unsigned)INT_MAX + delta
+ : (lua_Integer)INT_MIN + delta <= res))
+ return luaL_error(L, "field '%s' is out-of-bound", key);
+ res -= delta;
+ }
+ lua_pop(L, 1);
+ return (int)res;
+}
+
+
+static const char *checkoption (lua_State *L, const char *conv,
+ ptrdiff_t convlen, char *buff) {
+ const char *option = LUA_STRFTIMEOPTIONS;
+ int oplen = 1; /* length of options being checked */
+ for (; *option != '\0' && oplen <= convlen; option += oplen) {
+ if (*option == '|') /* next block? */
+ oplen++; /* will check options with next length (+1) */
+ else if (memcmp(conv, option, oplen) == 0) { /* match? */
+ memcpy(buff, conv, oplen); /* copy valid option to buffer */
+ buff[oplen] = '\0';
+ return conv + oplen; /* return next item */
+ }
+ }
+ luaL_argerror(L, 1,
+ lua_pushfstring(L, "invalid conversion specifier '%%%s'", conv));
+ return conv; /* to avoid warnings */
+}
+
+
+static time_t l_checktime (lua_State *L, int arg) {
+ l_timet t = l_gettime(L, arg);
+ luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds");
+ return (time_t)t;
+}
+
+
+/* maximum size for an individual 'strftime' item */
+#define SIZETIMEFMT 250
+
+
+static int os_date (lua_State *L) {
+ size_t slen;
+ const char *s = luaL_optlstring(L, 1, "%c", &slen);
+ time_t t = luaL_opt(L, l_checktime, 2, time(NULL));
+ const char *se = s + slen; /* 's' end */
+ struct tm tmr, *stm;
+ if (*s == '!') { /* UTC? */
+ stm = l_gmtime(&t, &tmr);
+ s++; /* skip '!' */
+ }
+ else
+ stm = l_localtime(&t, &tmr);
+ if (stm == NULL) /* invalid date? */
+ return luaL_error(L,
+ "date result cannot be represented in this installation");
+ if (strcmp(s, "*t") == 0) {
+ lua_createtable(L, 0, 9); /* 9 = number of fields */
+ setallfields(L, stm);
+ }
+ else {
+ char cc[4]; /* buffer for individual conversion specifiers */
+ luaL_Buffer b;
+ cc[0] = '%';
+ luaL_buffinit(L, &b);
+ while (s < se) {
+ if (*s != '%') /* not a conversion specifier? */
+ luaL_addchar(&b, *s++);
+ else {
+ size_t reslen;
+ char *buff = luaL_prepbuffsize(&b, SIZETIMEFMT);
+ s++; /* skip '%' */
+ s = checkoption(L, s, se - s, cc + 1); /* copy specifier to 'cc' */
+ reslen = strftime(buff, SIZETIMEFMT, cc, stm);
+ luaL_addsize(&b, reslen);
+ }
+ }
+ luaL_pushresult(&b);
+ }
+ return 1;
+}
+
+
+static int os_time (lua_State *L) {
+ time_t t;
+ if (lua_isnoneornil(L, 1)) /* called without args? */
+ t = time(NULL); /* get current time */
+ else {
+ struct tm ts;
+ luaL_checktype(L, 1, LUA_TTABLE);
+ lua_settop(L, 1); /* make sure table is at the top */
+ ts.tm_year = getfield(L, "year", -1, 1900);
+ ts.tm_mon = getfield(L, "month", -1, 1);
+ ts.tm_mday = getfield(L, "day", -1, 0);
+ ts.tm_hour = getfield(L, "hour", 12, 0);
+ ts.tm_min = getfield(L, "min", 0, 0);
+ ts.tm_sec = getfield(L, "sec", 0, 0);
+ ts.tm_isdst = getboolfield(L, "isdst");
+ t = mktime(&ts);
+ setallfields(L, &ts); /* update fields with normalized values */
+ }
+ if (t != (time_t)(l_timet)t || t == (time_t)(-1))
+ return luaL_error(L,
+ "time result cannot be represented in this installation");
+ l_pushtime(L, t);
+ return 1;
+}
+
+
+static int os_difftime (lua_State *L) {
+ time_t t1 = l_checktime(L, 1);
+ time_t t2 = l_checktime(L, 2);
+ lua_pushnumber(L, (lua_Number)difftime(t1, t2));
+ return 1;
+}
+
+/* }====================================================== */
+
+
+static int os_setlocale (lua_State *L) {
+ static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
+ LC_NUMERIC, LC_TIME};
+ static const char *const catnames[] = {"all", "collate", "ctype", "monetary",
+ "numeric", "time", NULL};
+ const char *l = luaL_optstring(L, 1, NULL);
+ int op = luaL_checkoption(L, 2, "all", catnames);
+ lua_pushstring(L, setlocale(cat[op], l));
+ return 1;
+}
+
+
+static int os_exit (lua_State *L) {
+ int status;
+ if (lua_isboolean(L, 1))
+ status = (lua_toboolean(L, 1) ? EXIT_SUCCESS : EXIT_FAILURE);
+ else
+ status = (int)luaL_optinteger(L, 1, EXIT_SUCCESS);
+ if (lua_toboolean(L, 2))
+ lua_close(L);
+ if (L) exit(status); /* 'if' to avoid warnings for unreachable 'return' */
+ return 0;
+}
+
+
+static const luaL_Reg syslib[] = {
+ {"clock", os_clock},
+ {"date", os_date},
+ {"difftime", os_difftime},
+ {"execute", os_execute},
+ {"exit", os_exit},
+ {"getenv", os_getenv},
+ {"remove", os_remove},
+ {"rename", os_rename},
+ {"setlocale", os_setlocale},
+ {"time", os_time},
+ {"tmpname", os_tmpname},
+ {NULL, NULL}
+};
+
+/* }====================================================== */
+
+
+
+LUAMOD_API int luaopen_os (lua_State *L) {
+ luaL_newlib(L, syslib);
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lparser.c b/source/luametatex/source/luacore/lua54/src/lparser.c
new file mode 100644
index 000000000..fe693b571
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lparser.c
@@ -0,0 +1,1967 @@
+/*
+** $Id: lparser.c $
+** Lua Parser
+** See Copyright Notice in lua.h
+*/
+
+#define lparser_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <limits.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lcode.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "llex.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+
+
+
+/* maximum number of local variables per function (must be smaller
+ than 250, due to the bytecode format) */
+#define MAXVARS 200
+
+
+#define hasmultret(k) ((k) == VCALL || (k) == VVARARG)
+
+
+/* because all strings are unified by the scanner, the parser
+ can use pointer equality for string equality */
+#define eqstr(a,b) ((a) == (b))
+
+
+/*
+** nodes for block list (list of active blocks)
+*/
+typedef struct BlockCnt {
+ struct BlockCnt *previous; /* chain */
+ int firstlabel; /* index of first label in this block */
+ int firstgoto; /* index of first pending goto in this block */
+ lu_byte nactvar; /* # active locals outside the block */
+ lu_byte upval; /* true if some variable in the block is an upvalue */
+ lu_byte isloop; /* true if 'block' is a loop */
+ lu_byte insidetbc; /* true if inside the scope of a to-be-closed var. */
+} BlockCnt;
+
+
+
+/*
+** prototypes for recursive non-terminal functions
+*/
+static void statement (LexState *ls);
+static void expr (LexState *ls, expdesc *v);
+
+
+static l_noret error_expected (LexState *ls, int token) {
+ luaX_syntaxerror(ls,
+ luaO_pushfstring(ls->L, "%s expected", luaX_token2str(ls, token)));
+}
+
+
+static l_noret errorlimit (FuncState *fs, int limit, const char *what) {
+ lua_State *L = fs->ls->L;
+ const char *msg;
+ int line = fs->f->linedefined;
+ const char *where = (line == 0)
+ ? "main function"
+ : luaO_pushfstring(L, "function at line %d", line);
+ msg = luaO_pushfstring(L, "too many %s (limit is %d) in %s",
+ what, limit, where);
+ luaX_syntaxerror(fs->ls, msg);
+}
+
+
+static void checklimit (FuncState *fs, int v, int l, const char *what) {
+ if (v > l) errorlimit(fs, l, what);
+}
+
+
+/*
+** Test whether next token is 'c'; if so, skip it.
+*/
+static int testnext (LexState *ls, int c) {
+ if (ls->t.token == c) {
+ luaX_next(ls);
+ return 1;
+ }
+ else return 0;
+}
+
+
+/*
+** Check that next token is 'c'.
+*/
+static void check (LexState *ls, int c) {
+ if (ls->t.token != c)
+ error_expected(ls, c);
+}
+
+
+/*
+** Check that next token is 'c' and skip it.
+*/
+static void checknext (LexState *ls, int c) {
+ check(ls, c);
+ luaX_next(ls);
+}
+
+
+#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); }
+
+
+/*
+** Check that next token is 'what' and skip it. In case of error,
+** raise an error that the expected 'what' should match a 'who'
+** in line 'where' (if that is not the current line).
+*/
+static void check_match (LexState *ls, int what, int who, int where) {
+ if (l_unlikely(!testnext(ls, what))) {
+ if (where == ls->linenumber) /* all in the same line? */
+ error_expected(ls, what); /* do not need a complex message */
+ else {
+ luaX_syntaxerror(ls, luaO_pushfstring(ls->L,
+ "%s expected (to close %s at line %d)",
+ luaX_token2str(ls, what), luaX_token2str(ls, who), where));
+ }
+ }
+}
+
+
+static TString *str_checkname (LexState *ls) {
+ TString *ts;
+ check(ls, TK_NAME);
+ ts = ls->t.seminfo.ts;
+ luaX_next(ls);
+ return ts;
+}
+
+
+static void init_exp (expdesc *e, expkind k, int i) {
+ e->f = e->t = NO_JUMP;
+ e->k = k;
+ e->u.info = i;
+}
+
+
+static void codestring (expdesc *e, TString *s) {
+ e->f = e->t = NO_JUMP;
+ e->k = VKSTR;
+ e->u.strval = s;
+}
+
+
+static void codename (LexState *ls, expdesc *e) {
+ codestring(e, str_checkname(ls));
+}
+
+
+/*
+** Register a new local variable in the active 'Proto' (for debug
+** information).
+*/
+static int registerlocalvar (LexState *ls, FuncState *fs, TString *varname) {
+ Proto *f = fs->f;
+ int oldsize = f->sizelocvars;
+ luaM_growvector(ls->L, f->locvars, fs->ndebugvars, f->sizelocvars,
+ LocVar, SHRT_MAX, "local variables");
+ while (oldsize < f->sizelocvars)
+ f->locvars[oldsize++].varname = NULL;
+ f->locvars[fs->ndebugvars].varname = varname;
+ f->locvars[fs->ndebugvars].startpc = fs->pc;
+ luaC_objbarrier(ls->L, f, varname);
+ return fs->ndebugvars++;
+}
+
+
+/*
+** Create a new local variable with the given 'name'. Return its index
+** in the function.
+*/
+static int new_localvar (LexState *ls, TString *name) {
+ lua_State *L = ls->L;
+ FuncState *fs = ls->fs;
+ Dyndata *dyd = ls->dyd;
+ Vardesc *var;
+ checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal,
+ MAXVARS, "local variables");
+ luaM_growvector(L, dyd->actvar.arr, dyd->actvar.n + 1,
+ dyd->actvar.size, Vardesc, USHRT_MAX, "local variables");
+ var = &dyd->actvar.arr[dyd->actvar.n++];
+ var->vd.kind = VDKREG; /* default */
+ var->vd.name = name;
+ return dyd->actvar.n - 1 - fs->firstlocal;
+}
+
+#define new_localvarliteral(ls,v) \
+ new_localvar(ls, \
+ luaX_newstring(ls, "" v, (sizeof(v)/sizeof(char)) - 1));
+
+
+
+/*
+** Return the "variable description" (Vardesc) of a given variable.
+** (Unless noted otherwise, all variables are referred to by their
+** compiler indices.)
+*/
+static Vardesc *getlocalvardesc (FuncState *fs, int vidx) {
+ return &fs->ls->dyd->actvar.arr[fs->firstlocal + vidx];
+}
+
+
+/*
+** Convert 'nvar', a compiler index level, to its corresponding
+** register. For that, search for the highest variable below that level
+** that is in a register and uses its register index ('ridx') plus one.
+*/
+static int reglevel (FuncState *fs, int nvar) {
+ while (nvar-- > 0) {
+ Vardesc *vd = getlocalvardesc(fs, nvar); /* get previous variable */
+ if (vd->vd.kind != RDKCTC) /* is in a register? */
+ return vd->vd.ridx + 1;
+ }
+ return 0; /* no variables in registers */
+}
+
+
+/*
+** Return the number of variables in the register stack for the given
+** function.
+*/
+int luaY_nvarstack (FuncState *fs) {
+ return reglevel(fs, fs->nactvar);
+}
+
+
+/*
+** Get the debug-information entry for current variable 'vidx'.
+*/
+static LocVar *localdebuginfo (FuncState *fs, int vidx) {
+ Vardesc *vd = getlocalvardesc(fs, vidx);
+ if (vd->vd.kind == RDKCTC)
+ return NULL; /* no debug info. for constants */
+ else {
+ int idx = vd->vd.pidx;
+ lua_assert(idx < fs->ndebugvars);
+ return &fs->f->locvars[idx];
+ }
+}
+
+
+/*
+** Create an expression representing variable 'vidx'
+*/
+static void init_var (FuncState *fs, expdesc *e, int vidx) {
+ e->f = e->t = NO_JUMP;
+ e->k = VLOCAL;
+ e->u.var.vidx = vidx;
+ e->u.var.ridx = getlocalvardesc(fs, vidx)->vd.ridx;
+}
+
+
+/*
+** Raises an error if variable described by 'e' is read only
+*/
+static void check_readonly (LexState *ls, expdesc *e) {
+ FuncState *fs = ls->fs;
+ TString *varname = NULL; /* to be set if variable is const */
+ switch (e->k) {
+ case VCONST: {
+ varname = ls->dyd->actvar.arr[e->u.info].vd.name;
+ break;
+ }
+ case VLOCAL: {
+ Vardesc *vardesc = getlocalvardesc(fs, e->u.var.vidx);
+ if (vardesc->vd.kind != VDKREG) /* not a regular variable? */
+ varname = vardesc->vd.name;
+ break;
+ }
+ case VUPVAL: {
+ Upvaldesc *up = &fs->f->upvalues[e->u.info];
+ if (up->kind != VDKREG)
+ varname = up->name;
+ break;
+ }
+ default:
+ return; /* other cases cannot be read-only */
+ }
+ if (varname) {
+ const char *msg = luaO_pushfstring(ls->L,
+ "attempt to assign to const variable '%s'", getstr(varname));
+ luaK_semerror(ls, msg); /* error */
+ }
+}
+
+
+/*
+** Start the scope for the last 'nvars' created variables.
+*/
+static void adjustlocalvars (LexState *ls, int nvars) {
+ FuncState *fs = ls->fs;
+ int reglevel = luaY_nvarstack(fs);
+ int i;
+ for (i = 0; i < nvars; i++) {
+ int vidx = fs->nactvar++;
+ Vardesc *var = getlocalvardesc(fs, vidx);
+ var->vd.ridx = reglevel++;
+ var->vd.pidx = registerlocalvar(ls, fs, var->vd.name);
+ }
+}
+
+
+/*
+** Close the scope for all variables up to level 'tolevel'.
+** (debug info.)
+*/
+static void removevars (FuncState *fs, int tolevel) {
+ fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel);
+ while (fs->nactvar > tolevel) {
+ LocVar *var = localdebuginfo(fs, --fs->nactvar);
+ if (var) /* does it have debug information? */
+ var->endpc = fs->pc;
+ }
+}
+
+
+/*
+** Search the upvalues of the function 'fs' for one
+** with the given 'name'.
+*/
+static int searchupvalue (FuncState *fs, TString *name) {
+ int i;
+ Upvaldesc *up = fs->f->upvalues;
+ for (i = 0; i < fs->nups; i++) {
+ if (eqstr(up[i].name, name)) return i;
+ }
+ return -1; /* not found */
+}
+
+
+static Upvaldesc *allocupvalue (FuncState *fs) {
+ Proto *f = fs->f;
+ int oldsize = f->sizeupvalues;
+ checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues");
+ luaM_growvector(fs->ls->L, f->upvalues, fs->nups, f->sizeupvalues,
+ Upvaldesc, MAXUPVAL, "upvalues");
+ while (oldsize < f->sizeupvalues)
+ f->upvalues[oldsize++].name = NULL;
+ return &f->upvalues[fs->nups++];
+}
+
+
+static int newupvalue (FuncState *fs, TString *name, expdesc *v) {
+ Upvaldesc *up = allocupvalue(fs);
+ FuncState *prev = fs->prev;
+ if (v->k == VLOCAL) {
+ up->instack = 1;
+ up->idx = v->u.var.ridx;
+ up->kind = getlocalvardesc(prev, v->u.var.vidx)->vd.kind;
+ lua_assert(eqstr(name, getlocalvardesc(prev, v->u.var.vidx)->vd.name));
+ }
+ else {
+ up->instack = 0;
+ up->idx = cast_byte(v->u.info);
+ up->kind = prev->f->upvalues[v->u.info].kind;
+ lua_assert(eqstr(name, prev->f->upvalues[v->u.info].name));
+ }
+ up->name = name;
+ luaC_objbarrier(fs->ls->L, fs->f, name);
+ return fs->nups - 1;
+}
+
+
+/*
+** Look for an active local variable with the name 'n' in the
+** function 'fs'. If found, initialize 'var' with it and return
+** its expression kind; otherwise return -1.
+*/
+static int searchvar (FuncState *fs, TString *n, expdesc *var) {
+ int i;
+ for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) {
+ Vardesc *vd = getlocalvardesc(fs, i);
+ if (eqstr(n, vd->vd.name)) { /* found? */
+ if (vd->vd.kind == RDKCTC) /* compile-time constant? */
+ init_exp(var, VCONST, fs->firstlocal + i);
+ else /* real variable */
+ init_var(fs, var, i);
+ return var->k;
+ }
+ }
+ return -1; /* not found */
+}
+
+
+/*
+** Mark block where variable at given level was defined
+** (to emit close instructions later).
+*/
+static void markupval (FuncState *fs, int level) {
+ BlockCnt *bl = fs->bl;
+ while (bl->nactvar > level)
+ bl = bl->previous;
+ bl->upval = 1;
+ fs->needclose = 1;
+}
+
+
+/*
+** Mark that current block has a to-be-closed variable.
+*/
+static void marktobeclosed (FuncState *fs) {
+ BlockCnt *bl = fs->bl;
+ bl->upval = 1;
+ bl->insidetbc = 1;
+ fs->needclose = 1;
+}
+
+
+/*
+** Find a variable with the given name 'n'. If it is an upvalue, add
+** this upvalue into all intermediate functions. If it is a global, set
+** 'var' as 'void' as a flag.
+*/
+static void singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) {
+ if (fs == NULL) /* no more levels? */
+ init_exp(var, VVOID, 0); /* default is global */
+ else {
+ int v = searchvar(fs, n, var); /* look up locals at current level */
+ if (v >= 0) { /* found? */
+ if (v == VLOCAL && !base)
+ markupval(fs, var->u.var.vidx); /* local will be used as an upval */
+ }
+ else { /* not found as local at current level; try upvalues */
+ int idx = searchupvalue(fs, n); /* try existing upvalues */
+ if (idx < 0) { /* not found? */
+ singlevaraux(fs->prev, n, var, 0); /* try upper levels */
+ if (var->k == VLOCAL || var->k == VUPVAL) /* local or upvalue? */
+ idx = newupvalue(fs, n, var); /* will be a new upvalue */
+ else /* it is a global or a constant */
+ return; /* don't need to do anything at this level */
+ }
+ init_exp(var, VUPVAL, idx); /* new or old upvalue */
+ }
+ }
+}
+
+
+/*
+** Find a variable with the given name 'n', handling global variables
+** too.
+*/
+static void singlevar (LexState *ls, expdesc *var) {
+ TString *varname = str_checkname(ls);
+ FuncState *fs = ls->fs;
+ singlevaraux(fs, varname, var, 1);
+ if (var->k == VVOID) { /* global name? */
+ expdesc key;
+ singlevaraux(fs, ls->envn, var, 1); /* get environment variable */
+ lua_assert(var->k != VVOID); /* this one must exist */
+ luaK_exp2anyregup(fs, var); /* but could be a constant */
+ codestring(&key, varname); /* key is variable name */
+ luaK_indexed(fs, var, &key); /* env[varname] */
+ }
+}
+
+
+/*
+** Adjust the number of results from an expression list 'e' with 'nexps'
+** expressions to 'nvars' values.
+*/
+static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {
+ FuncState *fs = ls->fs;
+ int needed = nvars - nexps; /* extra values needed */
+ if (hasmultret(e->k)) { /* last expression has multiple returns? */
+ int extra = needed + 1; /* discount last expression itself */
+ if (extra < 0)
+ extra = 0;
+ luaK_setreturns(fs, e, extra); /* last exp. provides the difference */
+ }
+ else {
+ if (e->k != VVOID) /* at least one expression? */
+ luaK_exp2nextreg(fs, e); /* close last expression */
+ if (needed > 0) /* missing values? */
+ luaK_nil(fs, fs->freereg, needed); /* complete with nils */
+ }
+ if (needed > 0)
+ luaK_reserveregs(fs, needed); /* registers for extra values */
+ else /* adding 'needed' is actually a subtraction */
+ fs->freereg += needed; /* remove extra values */
+}
+
+
+#define enterlevel(ls) luaE_incCstack(ls->L)
+
+
+#define leavelevel(ls) ((ls)->L->nCcalls--)
+
+
+/*
+** Generates an error that a goto jumps into the scope of some
+** local variable.
+*/
+static l_noret jumpscopeerror (LexState *ls, Labeldesc *gt) {
+ const char *varname = getstr(getlocalvardesc(ls->fs, gt->nactvar)->vd.name);
+ const char *msg = "<goto %s> at line %d jumps into the scope of local '%s'";
+ msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line, varname);
+ luaK_semerror(ls, msg); /* raise the error */
+}
+
+
+/*
+** Solves the goto at index 'g' to given 'label' and removes it
+** from the list of pending goto's.
+** If it jumps into the scope of some variable, raises an error.
+*/
+static void solvegoto (LexState *ls, int g, Labeldesc *label) {
+ int i;
+ Labellist *gl = &ls->dyd->gt; /* list of goto's */
+ Labeldesc *gt = &gl->arr[g]; /* goto to be resolved */
+ lua_assert(eqstr(gt->name, label->name));
+ if (l_unlikely(gt->nactvar < label->nactvar)) /* enter some scope? */
+ jumpscopeerror(ls, gt);
+ luaK_patchlist(ls->fs, gt->pc, label->pc);
+ for (i = g; i < gl->n - 1; i++) /* remove goto from pending list */
+ gl->arr[i] = gl->arr[i + 1];
+ gl->n--;
+}
+
+
+/*
+** Search for an active label with the given name.
+*/
+static Labeldesc *findlabel (LexState *ls, TString *name) {
+ int i;
+ Dyndata *dyd = ls->dyd;
+ /* check labels in current function for a match */
+ for (i = ls->fs->firstlabel; i < dyd->label.n; i++) {
+ Labeldesc *lb = &dyd->label.arr[i];
+ if (eqstr(lb->name, name)) /* correct label? */
+ return lb;
+ }
+ return NULL; /* label not found */
+}
+
+
+/*
+** Adds a new label/goto in the corresponding list.
+*/
+static int newlabelentry (LexState *ls, Labellist *l, TString *name,
+ int line, int pc) {
+ int n = l->n;
+ luaM_growvector(ls->L, l->arr, n, l->size,
+ Labeldesc, SHRT_MAX, "labels/gotos");
+ l->arr[n].name = name;
+ l->arr[n].line = line;
+ l->arr[n].nactvar = ls->fs->nactvar;
+ l->arr[n].close = 0;
+ l->arr[n].pc = pc;
+ l->n = n + 1;
+ return n;
+}
+
+
+static int newgotoentry (LexState *ls, TString *name, int line, int pc) {
+ return newlabelentry(ls, &ls->dyd->gt, name, line, pc);
+}
+
+
+/*
+** Solves forward jumps. Check whether new label 'lb' matches any
+** pending gotos in current block and solves them. Return true
+** if any of the goto's need to close upvalues.
+*/
+static int solvegotos (LexState *ls, Labeldesc *lb) {
+ Labellist *gl = &ls->dyd->gt;
+ int i = ls->fs->bl->firstgoto;
+ int needsclose = 0;
+ while (i < gl->n) {
+ if (eqstr(gl->arr[i].name, lb->name)) {
+ needsclose |= gl->arr[i].close;
+ solvegoto(ls, i, lb); /* will remove 'i' from the list */
+ }
+ else
+ i++;
+ }
+ return needsclose;
+}
+
+
+/*
+** Create a new label with the given 'name' at the given 'line'.
+** 'last' tells whether label is the last non-op statement in its
+** block. Solves all pending goto's to this new label and adds
+** a close instruction if necessary.
+** Returns true iff it added a close instruction.
+*/
+static int createlabel (LexState *ls, TString *name, int line,
+ int last) {
+ FuncState *fs = ls->fs;
+ Labellist *ll = &ls->dyd->label;
+ int l = newlabelentry(ls, ll, name, line, luaK_getlabel(fs));
+ if (last) { /* label is last no-op statement in the block? */
+ /* assume that locals are already out of scope */
+ ll->arr[l].nactvar = fs->bl->nactvar;
+ }
+ if (solvegotos(ls, &ll->arr[l])) { /* need close? */
+ luaK_codeABC(fs, OP_CLOSE, luaY_nvarstack(fs), 0, 0);
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+** Adjust pending gotos to outer level of a block.
+*/
+static void movegotosout (FuncState *fs, BlockCnt *bl) {
+ int i;
+ Labellist *gl = &fs->ls->dyd->gt;
+ /* correct pending gotos to current block */
+ for (i = bl->firstgoto; i < gl->n; i++) { /* for each pending goto */
+ Labeldesc *gt = &gl->arr[i];
+ /* leaving a variable scope? */
+ if (reglevel(fs, gt->nactvar) > reglevel(fs, bl->nactvar))
+ gt->close |= bl->upval; /* jump may need a close */
+ gt->nactvar = bl->nactvar; /* update goto level */
+ }
+}
+
+
+static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) {
+ bl->isloop = isloop;
+ bl->nactvar = fs->nactvar;
+ bl->firstlabel = fs->ls->dyd->label.n;
+ bl->firstgoto = fs->ls->dyd->gt.n;
+ bl->upval = 0;
+ bl->insidetbc = (fs->bl != NULL && fs->bl->insidetbc);
+ bl->previous = fs->bl;
+ fs->bl = bl;
+ lua_assert(fs->freereg == luaY_nvarstack(fs));
+}
+
+
+/*
+** generates an error for an undefined 'goto'.
+*/
+static l_noret undefgoto (LexState *ls, Labeldesc *gt) {
+ const char *msg;
+ if (eqstr(gt->name, luaS_newliteral(ls->L, "break"))) {
+ msg = "break outside loop at line %d";
+ msg = luaO_pushfstring(ls->L, msg, gt->line);
+ }
+ else {
+ msg = "no visible label '%s' for <goto> at line %d";
+ msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
+ }
+ luaK_semerror(ls, msg);
+}
+
+
+static void leaveblock (FuncState *fs) {
+ BlockCnt *bl = fs->bl;
+ LexState *ls = fs->ls;
+ int hasclose = 0;
+ int stklevel = reglevel(fs, bl->nactvar); /* level outside the block */
+ removevars(fs, bl->nactvar); /* remove block locals */
+ lua_assert(bl->nactvar == fs->nactvar); /* back to level on entry */
+ if (bl->isloop) /* has to fix pending breaks? */
+ hasclose = createlabel(ls, luaS_newliteral(ls->L, "break"), 0, 0);
+ if (!hasclose && bl->previous && bl->upval) /* still need a 'close'? */
+ luaK_codeABC(fs, OP_CLOSE, stklevel, 0, 0);
+ fs->freereg = stklevel; /* free registers */
+ ls->dyd->label.n = bl->firstlabel; /* remove local labels */
+ fs->bl = bl->previous; /* current block now is previous one */
+ if (bl->previous) /* was it a nested block? */
+ movegotosout(fs, bl); /* update pending gotos to enclosing block */
+ else {
+ if (bl->firstgoto < ls->dyd->gt.n) /* still pending gotos? */
+ undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */
+ }
+}
+
+
+/*
+** adds a new prototype into list of prototypes
+*/
+static Proto *addprototype (LexState *ls) {
+ Proto *clp;
+ lua_State *L = ls->L;
+ FuncState *fs = ls->fs;
+ Proto *f = fs->f; /* prototype of current function */
+ if (fs->np >= f->sizep) {
+ int oldsize = f->sizep;
+ luaM_growvector(L, f->p, fs->np, f->sizep, Proto *, MAXARG_Bx, "functions");
+ while (oldsize < f->sizep)
+ f->p[oldsize++] = NULL;
+ }
+ f->p[fs->np++] = clp = luaF_newproto(L);
+ luaC_objbarrier(L, f, clp);
+ return clp;
+}
+
+
+/*
+** codes instruction to create new closure in parent function.
+** The OP_CLOSURE instruction uses the last available register,
+** so that, if it invokes the GC, the GC knows which registers
+** are in use at that time.
+
+*/
+static void codeclosure (LexState *ls, expdesc *v) {
+ FuncState *fs = ls->fs->prev;
+ init_exp(v, VRELOC, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1));
+ luaK_exp2nextreg(fs, v); /* fix it at the last register */
+}
+
+
+static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) {
+ Proto *f = fs->f;
+ fs->prev = ls->fs; /* linked list of funcstates */
+ fs->ls = ls;
+ ls->fs = fs;
+ fs->pc = 0;
+ fs->previousline = f->linedefined;
+ fs->iwthabs = 0;
+ fs->lasttarget = 0;
+ fs->freereg = 0;
+ fs->nk = 0;
+ fs->nabslineinfo = 0;
+ fs->np = 0;
+ fs->nups = 0;
+ fs->ndebugvars = 0;
+ fs->nactvar = 0;
+ fs->needclose = 0;
+ fs->firstlocal = ls->dyd->actvar.n;
+ fs->firstlabel = ls->dyd->label.n;
+ fs->bl = NULL;
+ f->source = ls->source;
+ luaC_objbarrier(ls->L, f, f->source);
+ f->maxstacksize = 2; /* registers 0/1 are always valid */
+ enterblock(fs, bl, 0);
+}
+
+
+static void close_func (LexState *ls) {
+ lua_State *L = ls->L;
+ FuncState *fs = ls->fs;
+ Proto *f = fs->f;
+ luaK_ret(fs, luaY_nvarstack(fs), 0); /* final return */
+ leaveblock(fs);
+ lua_assert(fs->bl == NULL);
+ luaK_finish(fs);
+ luaM_shrinkvector(L, f->code, f->sizecode, fs->pc, Instruction);
+ luaM_shrinkvector(L, f->lineinfo, f->sizelineinfo, fs->pc, ls_byte);
+ luaM_shrinkvector(L, f->abslineinfo, f->sizeabslineinfo,
+ fs->nabslineinfo, AbsLineInfo);
+ luaM_shrinkvector(L, f->k, f->sizek, fs->nk, TValue);
+ luaM_shrinkvector(L, f->p, f->sizep, fs->np, Proto *);
+ luaM_shrinkvector(L, f->locvars, f->sizelocvars, fs->ndebugvars, LocVar);
+ luaM_shrinkvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
+ ls->fs = fs->prev;
+ luaC_checkGC(L);
+}
+
+
+
+/*============================================================*/
+/* GRAMMAR RULES */
+/*============================================================*/
+
+
+/*
+** check whether current token is in the follow set of a block.
+** 'until' closes syntactical blocks, but do not close scope,
+** so it is handled in separate.
+*/
+static int block_follow (LexState *ls, int withuntil) {
+ switch (ls->t.token) {
+ case TK_ELSE: case TK_ELSEIF:
+ case TK_END: case TK_EOS:
+ return 1;
+ case TK_UNTIL: return withuntil;
+ default: return 0;
+ }
+}
+
+
+static void statlist (LexState *ls) {
+ /* statlist -> { stat [';'] } */
+ while (!block_follow(ls, 1)) {
+ if (ls->t.token == TK_RETURN) {
+ statement(ls);
+ return; /* 'return' must be last statement */
+ }
+ statement(ls);
+ }
+}
+
+
+static void fieldsel (LexState *ls, expdesc *v) {
+ /* fieldsel -> ['.' | ':'] NAME */
+ FuncState *fs = ls->fs;
+ expdesc key;
+ luaK_exp2anyregup(fs, v);
+ luaX_next(ls); /* skip the dot or colon */
+ codename(ls, &key);
+ luaK_indexed(fs, v, &key);
+}
+
+
+static void yindex (LexState *ls, expdesc *v) {
+ /* index -> '[' expr ']' */
+ luaX_next(ls); /* skip the '[' */
+ expr(ls, v);
+ luaK_exp2val(ls->fs, v);
+ checknext(ls, ']');
+}
+
+
+/*
+** {======================================================================
+** Rules for Constructors
+** =======================================================================
+*/
+
+
+typedef struct ConsControl {
+ expdesc v; /* last list item read */
+ expdesc *t; /* table descriptor */
+ int nh; /* total number of 'record' elements */
+ int na; /* number of array elements already stored */
+ int tostore; /* number of array elements pending to be stored */
+} ConsControl;
+
+
+static void recfield (LexState *ls, ConsControl *cc) {
+ /* recfield -> (NAME | '['exp']') = exp */
+ FuncState *fs = ls->fs;
+ int reg = ls->fs->freereg;
+ expdesc tab, key, val;
+ if (ls->t.token == TK_NAME) {
+ checklimit(fs, cc->nh, MAX_INT, "items in a constructor");
+ codename(ls, &key);
+ }
+ else /* ls->t.token == '[' */
+ yindex(ls, &key);
+ cc->nh++;
+ checknext(ls, '=');
+ tab = *cc->t;
+ luaK_indexed(fs, &tab, &key);
+ expr(ls, &val);
+ luaK_storevar(fs, &tab, &val);
+ fs->freereg = reg; /* free registers */
+}
+
+
+static void closelistfield (FuncState *fs, ConsControl *cc) {
+ if (cc->v.k == VVOID) return; /* there is no list item */
+ luaK_exp2nextreg(fs, &cc->v);
+ cc->v.k = VVOID;
+ if (cc->tostore == LFIELDS_PER_FLUSH) {
+ luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */
+ cc->na += cc->tostore;
+ cc->tostore = 0; /* no more items pending */
+ }
+}
+
+
+static void lastlistfield (FuncState *fs, ConsControl *cc) {
+ if (cc->tostore == 0) return;
+ if (hasmultret(cc->v.k)) {
+ luaK_setmultret(fs, &cc->v);
+ luaK_setlist(fs, cc->t->u.info, cc->na, LUA_MULTRET);
+ cc->na--; /* do not count last expression (unknown number of elements) */
+ }
+ else {
+ if (cc->v.k != VVOID)
+ luaK_exp2nextreg(fs, &cc->v);
+ luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore);
+ }
+ cc->na += cc->tostore;
+}
+
+
+static void listfield (LexState *ls, ConsControl *cc) {
+ /* listfield -> exp */
+ expr(ls, &cc->v);
+ cc->tostore++;
+}
+
+
+static void field (LexState *ls, ConsControl *cc) {
+ /* field -> listfield | recfield */
+ switch(ls->t.token) {
+ case TK_NAME: { /* may be 'listfield' or 'recfield' */
+ if (luaX_lookahead(ls) != '=') /* expression? */
+ listfield(ls, cc);
+ else
+ recfield(ls, cc);
+ break;
+ }
+ case '[': {
+ recfield(ls, cc);
+ break;
+ }
+ default: {
+ listfield(ls, cc);
+ break;
+ }
+ }
+}
+
+
+static void constructor (LexState *ls, expdesc *t) {
+ /* constructor -> '{' [ field { sep field } [sep] ] '}'
+ sep -> ',' | ';' */
+ FuncState *fs = ls->fs;
+ int line = ls->linenumber;
+ int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);
+ ConsControl cc;
+ luaK_code(fs, 0); /* space for extra arg. */
+ cc.na = cc.nh = cc.tostore = 0;
+ cc.t = t;
+ init_exp(t, VNONRELOC, fs->freereg); /* table will be at stack top */
+ luaK_reserveregs(fs, 1);
+ init_exp(&cc.v, VVOID, 0); /* no value (yet) */
+ checknext(ls, '{');
+ do {
+ lua_assert(cc.v.k == VVOID || cc.tostore > 0);
+ if (ls->t.token == '}') break;
+ closelistfield(fs, &cc);
+ field(ls, &cc);
+ } while (testnext(ls, ',') || testnext(ls, ';'));
+ check_match(ls, '}', '{', line);
+ lastlistfield(fs, &cc);
+ luaK_settablesize(fs, pc, t->u.info, cc.na, cc.nh);
+}
+
+/* }====================================================================== */
+
+
+static void setvararg (FuncState *fs, int nparams) {
+ fs->f->is_vararg = 1;
+ luaK_codeABC(fs, OP_VARARGPREP, nparams, 0, 0);
+}
+
+
+static void parlist (LexState *ls) {
+ /* parlist -> [ {NAME ','} (NAME | '...') ] */
+ FuncState *fs = ls->fs;
+ Proto *f = fs->f;
+ int nparams = 0;
+ int isvararg = 0;
+ if (ls->t.token != ')') { /* is 'parlist' not empty? */
+ do {
+ switch (ls->t.token) {
+ case TK_NAME: {
+ new_localvar(ls, str_checkname(ls));
+ nparams++;
+ break;
+ }
+ case TK_DOTS: {
+ luaX_next(ls);
+ isvararg = 1;
+ break;
+ }
+ default: luaX_syntaxerror(ls, "<name> or '...' expected");
+ }
+ } while (!isvararg && testnext(ls, ','));
+ }
+ adjustlocalvars(ls, nparams);
+ f->numparams = cast_byte(fs->nactvar);
+ if (isvararg)
+ setvararg(fs, f->numparams); /* declared vararg */
+ luaK_reserveregs(fs, fs->nactvar); /* reserve registers for parameters */
+}
+
+
+static void body (LexState *ls, expdesc *e, int ismethod, int line) {
+ /* body -> '(' parlist ')' block END */
+ FuncState new_fs;
+ BlockCnt bl;
+ new_fs.f = addprototype(ls);
+ new_fs.f->linedefined = line;
+ open_func(ls, &new_fs, &bl);
+ checknext(ls, '(');
+ if (ismethod) {
+ new_localvarliteral(ls, "self"); /* create 'self' parameter */
+ adjustlocalvars(ls, 1);
+ }
+ parlist(ls);
+ checknext(ls, ')');
+ statlist(ls);
+ new_fs.f->lastlinedefined = ls->linenumber;
+ check_match(ls, TK_END, TK_FUNCTION, line);
+ codeclosure(ls, e);
+ close_func(ls);
+}
+
+
+static int explist (LexState *ls, expdesc *v) {
+ /* explist -> expr { ',' expr } */
+ int n = 1; /* at least one expression */
+ expr(ls, v);
+ while (testnext(ls, ',')) {
+ luaK_exp2nextreg(ls->fs, v);
+ expr(ls, v);
+ n++;
+ }
+ return n;
+}
+
+
+static void funcargs (LexState *ls, expdesc *f, int line) {
+ FuncState *fs = ls->fs;
+ expdesc args;
+ int base, nparams;
+ switch (ls->t.token) {
+ case '(': { /* funcargs -> '(' [ explist ] ')' */
+ luaX_next(ls);
+ if (ls->t.token == ')') /* arg list is empty? */
+ args.k = VVOID;
+ else {
+ explist(ls, &args);
+ if (hasmultret(args.k))
+ luaK_setmultret(fs, &args);
+ }
+ check_match(ls, ')', '(', line);
+ break;
+ }
+ case '{': { /* funcargs -> constructor */
+ constructor(ls, &args);
+ break;
+ }
+ case TK_STRING: { /* funcargs -> STRING */
+ codestring(&args, ls->t.seminfo.ts);
+ luaX_next(ls); /* must use 'seminfo' before 'next' */
+ break;
+ }
+ default: {
+ luaX_syntaxerror(ls, "function arguments expected");
+ }
+ }
+ lua_assert(f->k == VNONRELOC);
+ base = f->u.info; /* base register for call */
+ if (hasmultret(args.k))
+ nparams = LUA_MULTRET; /* open call */
+ else {
+ if (args.k != VVOID)
+ luaK_exp2nextreg(fs, &args); /* close last argument */
+ nparams = fs->freereg - (base+1);
+ }
+ init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2));
+ luaK_fixline(fs, line);
+ fs->freereg = base+1; /* call remove function and arguments and leaves
+ (unless changed) one result */
+}
+
+
+
+
+/*
+** {======================================================================
+** Expression parsing
+** =======================================================================
+*/
+
+
+static void primaryexp (LexState *ls, expdesc *v) {
+ /* primaryexp -> NAME | '(' expr ')' */
+ switch (ls->t.token) {
+ case '(': {
+ int line = ls->linenumber;
+ luaX_next(ls);
+ expr(ls, v);
+ check_match(ls, ')', '(', line);
+ luaK_dischargevars(ls->fs, v);
+ return;
+ }
+ case TK_NAME: {
+ singlevar(ls, v);
+ return;
+ }
+ default: {
+ luaX_syntaxerror(ls, "unexpected symbol");
+ }
+ }
+}
+
+
+static void suffixedexp (LexState *ls, expdesc *v) {
+ /* suffixedexp ->
+ primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */
+ FuncState *fs = ls->fs;
+ int line = ls->linenumber;
+ primaryexp(ls, v);
+ for (;;) {
+ switch (ls->t.token) {
+ case '.': { /* fieldsel */
+ fieldsel(ls, v);
+ break;
+ }
+ case '[': { /* '[' exp ']' */
+ expdesc key;
+ luaK_exp2anyregup(fs, v);
+ yindex(ls, &key);
+ luaK_indexed(fs, v, &key);
+ break;
+ }
+ case ':': { /* ':' NAME funcargs */
+ expdesc key;
+ luaX_next(ls);
+ codename(ls, &key);
+ luaK_self(fs, v, &key);
+ funcargs(ls, v, line);
+ break;
+ }
+ case '(': case TK_STRING: case '{': { /* funcargs */
+ luaK_exp2nextreg(fs, v);
+ funcargs(ls, v, line);
+ break;
+ }
+ default: return;
+ }
+ }
+}
+
+
+static void simpleexp (LexState *ls, expdesc *v) {
+ /* simpleexp -> FLT | INT | STRING | NIL | TRUE | FALSE | ... |
+ constructor | FUNCTION body | suffixedexp */
+ switch (ls->t.token) {
+ case TK_FLT: {
+ init_exp(v, VKFLT, 0);
+ v->u.nval = ls->t.seminfo.r;
+ break;
+ }
+ case TK_INT: {
+ init_exp(v, VKINT, 0);
+ v->u.ival = ls->t.seminfo.i;
+ break;
+ }
+ case TK_STRING: {
+ codestring(v, ls->t.seminfo.ts);
+ break;
+ }
+ case TK_NIL: {
+ init_exp(v, VNIL, 0);
+ break;
+ }
+ case TK_TRUE: {
+ init_exp(v, VTRUE, 0);
+ break;
+ }
+ case TK_FALSE: {
+ init_exp(v, VFALSE, 0);
+ break;
+ }
+ case TK_DOTS: { /* vararg */
+ FuncState *fs = ls->fs;
+ check_condition(ls, fs->f->is_vararg,
+ "cannot use '...' outside a vararg function");
+ init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 0, 1));
+ break;
+ }
+ case '{': { /* constructor */
+ constructor(ls, v);
+ return;
+ }
+ case TK_FUNCTION: {
+ luaX_next(ls);
+ body(ls, v, 0, ls->linenumber);
+ return;
+ }
+ default: {
+ suffixedexp(ls, v);
+ return;
+ }
+ }
+ luaX_next(ls);
+}
+
+
+static UnOpr getunopr (int op) {
+ switch (op) {
+ case TK_NOT: return OPR_NOT;
+ case '-': return OPR_MINUS;
+ case '~': return OPR_BNOT;
+ case '#': return OPR_LEN;
+ default: return OPR_NOUNOPR;
+ }
+}
+
+
+static BinOpr getbinopr (int op) {
+ switch (op) {
+ case '+': return OPR_ADD;
+ case '-': return OPR_SUB;
+ case '*': return OPR_MUL;
+ case '%': return OPR_MOD;
+ case '^': return OPR_POW;
+ case '/': return OPR_DIV;
+ case TK_IDIV: return OPR_IDIV;
+ case '&': return OPR_BAND;
+ case '|': return OPR_BOR;
+ case '~': return OPR_BXOR;
+ case TK_SHL: return OPR_SHL;
+ case TK_SHR: return OPR_SHR;
+ case TK_CONCAT: return OPR_CONCAT;
+ case TK_NE: return OPR_NE;
+ case TK_EQ: return OPR_EQ;
+ case '<': return OPR_LT;
+ case TK_LE: return OPR_LE;
+ case '>': return OPR_GT;
+ case TK_GE: return OPR_GE;
+ case TK_AND: return OPR_AND;
+ case TK_OR: return OPR_OR;
+ default: return OPR_NOBINOPR;
+ }
+}
+
+
+/*
+** Priority table for binary operators.
+*/
+static const struct {
+ lu_byte left; /* left priority for each binary operator */
+ lu_byte right; /* right priority */
+} priority[] = { /* ORDER OPR */
+ {10, 10}, {10, 10}, /* '+' '-' */
+ {11, 11}, {11, 11}, /* '*' '%' */
+ {14, 13}, /* '^' (right associative) */
+ {11, 11}, {11, 11}, /* '/' '//' */
+ {6, 6}, {4, 4}, {5, 5}, /* '&' '|' '~' */
+ {7, 7}, {7, 7}, /* '<<' '>>' */
+ {9, 8}, /* '..' (right associative) */
+ {3, 3}, {3, 3}, {3, 3}, /* ==, <, <= */
+ {3, 3}, {3, 3}, {3, 3}, /* ~=, >, >= */
+ {2, 2}, {1, 1} /* and, or */
+};
+
+#define UNARY_PRIORITY 12 /* priority for unary operators */
+
+
+/*
+** subexpr -> (simpleexp | unop subexpr) { binop subexpr }
+** where 'binop' is any binary operator with a priority higher than 'limit'
+*/
+static BinOpr subexpr (LexState *ls, expdesc *v, int limit) {
+ BinOpr op;
+ UnOpr uop;
+ enterlevel(ls);
+ uop = getunopr(ls->t.token);
+ if (uop != OPR_NOUNOPR) { /* prefix (unary) operator? */
+ int line = ls->linenumber;
+ luaX_next(ls); /* skip operator */
+ subexpr(ls, v, UNARY_PRIORITY);
+ luaK_prefix(ls->fs, uop, v, line);
+ }
+ else simpleexp(ls, v);
+ /* expand while operators have priorities higher than 'limit' */
+ op = getbinopr(ls->t.token);
+ while (op != OPR_NOBINOPR && priority[op].left > limit) {
+ expdesc v2;
+ BinOpr nextop;
+ int line = ls->linenumber;
+ luaX_next(ls); /* skip operator */
+ luaK_infix(ls->fs, op, v);
+ /* read sub-expression with higher priority */
+ nextop = subexpr(ls, &v2, priority[op].right);
+ luaK_posfix(ls->fs, op, v, &v2, line);
+ op = nextop;
+ }
+ leavelevel(ls);
+ return op; /* return first untreated operator */
+}
+
+
+static void expr (LexState *ls, expdesc *v) {
+ subexpr(ls, v, 0);
+}
+
+/* }==================================================================== */
+
+
+
+/*
+** {======================================================================
+** Rules for Statements
+** =======================================================================
+*/
+
+
+static void block (LexState *ls) {
+ /* block -> statlist */
+ FuncState *fs = ls->fs;
+ BlockCnt bl;
+ enterblock(fs, &bl, 0);
+ statlist(ls);
+ leaveblock(fs);
+}
+
+
+/*
+** structure to chain all variables in the left-hand side of an
+** assignment
+*/
+struct LHS_assign {
+ struct LHS_assign *prev;
+ expdesc v; /* variable (global, local, upvalue, or indexed) */
+};
+
+
+/*
+** check whether, in an assignment to an upvalue/local variable, the
+** upvalue/local variable is begin used in a previous assignment to a
+** table. If so, save original upvalue/local value in a safe place and
+** use this safe copy in the previous assignment.
+*/
+static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) {
+ FuncState *fs = ls->fs;
+ int extra = fs->freereg; /* eventual position to save local variable */
+ int conflict = 0;
+ for (; lh; lh = lh->prev) { /* check all previous assignments */
+ if (vkisindexed(lh->v.k)) { /* assignment to table field? */
+ if (lh->v.k == VINDEXUP) { /* is table an upvalue? */
+ if (v->k == VUPVAL && lh->v.u.ind.t == v->u.info) {
+ conflict = 1; /* table is the upvalue being assigned now */
+ lh->v.k = VINDEXSTR;
+ lh->v.u.ind.t = extra; /* assignment will use safe copy */
+ }
+ }
+ else { /* table is a register */
+ if (v->k == VLOCAL && lh->v.u.ind.t == v->u.var.ridx) {
+ conflict = 1; /* table is the local being assigned now */
+ lh->v.u.ind.t = extra; /* assignment will use safe copy */
+ }
+ /* is index the local being assigned? */
+ if (lh->v.k == VINDEXED && v->k == VLOCAL &&
+ lh->v.u.ind.idx == v->u.var.ridx) {
+ conflict = 1;
+ lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */
+ }
+ }
+ }
+ }
+ if (conflict) {
+ /* copy upvalue/local value to a temporary (in position 'extra') */
+ if (v->k == VLOCAL)
+ luaK_codeABC(fs, OP_MOVE, extra, v->u.var.ridx, 0);
+ else
+ luaK_codeABC(fs, OP_GETUPVAL, extra, v->u.info, 0);
+ luaK_reserveregs(fs, 1);
+ }
+}
+
+/*
+** Parse and compile a multiple assignment. The first "variable"
+** (a 'suffixedexp') was already read by the caller.
+**
+** assignment -> suffixedexp restassign
+** restassign -> ',' suffixedexp restassign | '=' explist
+*/
+static void restassign (LexState *ls, struct LHS_assign *lh, int nvars) {
+ expdesc e;
+ check_condition(ls, vkisvar(lh->v.k), "syntax error");
+ check_readonly(ls, &lh->v);
+ if (testnext(ls, ',')) { /* restassign -> ',' suffixedexp restassign */
+ struct LHS_assign nv;
+ nv.prev = lh;
+ suffixedexp(ls, &nv.v);
+ if (!vkisindexed(nv.v.k))
+ check_conflict(ls, lh, &nv.v);
+ enterlevel(ls); /* control recursion depth */
+ restassign(ls, &nv, nvars+1);
+ leavelevel(ls);
+ }
+ else { /* restassign -> '=' explist */
+ int nexps;
+ checknext(ls, '=');
+ nexps = explist(ls, &e);
+ if (nexps != nvars)
+ adjust_assign(ls, nvars, nexps, &e);
+ else {
+ luaK_setoneret(ls->fs, &e); /* close last expression */
+ luaK_storevar(ls->fs, &lh->v, &e);
+ return; /* avoid default */
+ }
+ }
+ init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */
+ luaK_storevar(ls->fs, &lh->v, &e);
+}
+
+
+static int cond (LexState *ls) {
+ /* cond -> exp */
+ expdesc v;
+ expr(ls, &v); /* read condition */
+ if (v.k == VNIL) v.k = VFALSE; /* 'falses' are all equal here */
+ luaK_goiftrue(ls->fs, &v);
+ return v.f;
+}
+
+
+static void gotostat (LexState *ls) {
+ FuncState *fs = ls->fs;
+ int line = ls->linenumber;
+ TString *name = str_checkname(ls); /* label's name */
+ Labeldesc *lb = findlabel(ls, name);
+ if (lb == NULL) /* no label? */
+ /* forward jump; will be resolved when the label is declared */
+ newgotoentry(ls, name, line, luaK_jump(fs));
+ else { /* found a label */
+ /* backward jump; will be resolved here */
+ int lblevel = reglevel(fs, lb->nactvar); /* label level */
+ if (luaY_nvarstack(fs) > lblevel) /* leaving the scope of a variable? */
+ luaK_codeABC(fs, OP_CLOSE, lblevel, 0, 0);
+ /* create jump and link it to the label */
+ luaK_patchlist(fs, luaK_jump(fs), lb->pc);
+ }
+}
+
+
+/*
+** Break statement. Semantically equivalent to "goto break".
+*/
+static void breakstat (LexState *ls) {
+ int line = ls->linenumber;
+ luaX_next(ls); /* skip break */
+ newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, luaK_jump(ls->fs));
+}
+
+
+/*
+** Check whether there is already a label with the given 'name'.
+*/
+static void checkrepeated (LexState *ls, TString *name) {
+ Labeldesc *lb = findlabel(ls, name);
+ if (l_unlikely(lb != NULL)) { /* already defined? */
+ const char *msg = "label '%s' already defined on line %d";
+ msg = luaO_pushfstring(ls->L, msg, getstr(name), lb->line);
+ luaK_semerror(ls, msg); /* error */
+ }
+}
+
+
+static void labelstat (LexState *ls, TString *name, int line) {
+ /* label -> '::' NAME '::' */
+ checknext(ls, TK_DBCOLON); /* skip double colon */
+ while (ls->t.token == ';' || ls->t.token == TK_DBCOLON)
+ statement(ls); /* skip other no-op statements */
+ checkrepeated(ls, name); /* check for repeated labels */
+ createlabel(ls, name, line, block_follow(ls, 0));
+}
+
+
+static void whilestat (LexState *ls, int line) {
+ /* whilestat -> WHILE cond DO block END */
+ FuncState *fs = ls->fs;
+ int whileinit;
+ int condexit;
+ BlockCnt bl;
+ luaX_next(ls); /* skip WHILE */
+ whileinit = luaK_getlabel(fs);
+ condexit = cond(ls);
+ enterblock(fs, &bl, 1);
+ checknext(ls, TK_DO);
+ block(ls);
+ luaK_jumpto(fs, whileinit);
+ check_match(ls, TK_END, TK_WHILE, line);
+ leaveblock(fs);
+ luaK_patchtohere(fs, condexit); /* false conditions finish the loop */
+}
+
+
+static void repeatstat (LexState *ls, int line) {
+ /* repeatstat -> REPEAT block UNTIL cond */
+ int condexit;
+ FuncState *fs = ls->fs;
+ int repeat_init = luaK_getlabel(fs);
+ BlockCnt bl1, bl2;
+ enterblock(fs, &bl1, 1); /* loop block */
+ enterblock(fs, &bl2, 0); /* scope block */
+ luaX_next(ls); /* skip REPEAT */
+ statlist(ls);
+ check_match(ls, TK_UNTIL, TK_REPEAT, line);
+ condexit = cond(ls); /* read condition (inside scope block) */
+ leaveblock(fs); /* finish scope */
+ if (bl2.upval) { /* upvalues? */
+ int exit = luaK_jump(fs); /* normal exit must jump over fix */
+ luaK_patchtohere(fs, condexit); /* repetition must close upvalues */
+ luaK_codeABC(fs, OP_CLOSE, reglevel(fs, bl2.nactvar), 0, 0);
+ condexit = luaK_jump(fs); /* repeat after closing upvalues */
+ luaK_patchtohere(fs, exit); /* normal exit comes to here */
+ }
+ luaK_patchlist(fs, condexit, repeat_init); /* close the loop */
+ leaveblock(fs); /* finish loop */
+}
+
+
+/*
+** Read an expression and generate code to put its results in next
+** stack slot.
+**
+*/
+static void exp1 (LexState *ls) {
+ expdesc e;
+ expr(ls, &e);
+ luaK_exp2nextreg(ls->fs, &e);
+ lua_assert(e.k == VNONRELOC);
+}
+
+
+/*
+** Fix for instruction at position 'pc' to jump to 'dest'.
+** (Jump addresses are relative in Lua). 'back' true means
+** a back jump.
+*/
+static void fixforjump (FuncState *fs, int pc, int dest, int back) {
+ Instruction *jmp = &fs->f->code[pc];
+ int offset = dest - (pc + 1);
+ if (back)
+ offset = -offset;
+ if (l_unlikely(offset > MAXARG_Bx))
+ luaX_syntaxerror(fs->ls, "control structure too long");
+ SETARG_Bx(*jmp, offset);
+}
+
+
+/*
+** Generate code for a 'for' loop.
+*/
+static void forbody (LexState *ls, int base, int line, int nvars, int isgen) {
+ /* forbody -> DO block */
+ static const OpCode forprep[2] = {OP_FORPREP, OP_TFORPREP};
+ static const OpCode forloop[2] = {OP_FORLOOP, OP_TFORLOOP};
+ BlockCnt bl;
+ FuncState *fs = ls->fs;
+ int prep, endfor;
+ checknext(ls, TK_DO);
+ prep = luaK_codeABx(fs, forprep[isgen], base, 0);
+ enterblock(fs, &bl, 0); /* scope for declared variables */
+ adjustlocalvars(ls, nvars);
+ luaK_reserveregs(fs, nvars);
+ block(ls);
+ leaveblock(fs); /* end of scope for declared variables */
+ fixforjump(fs, prep, luaK_getlabel(fs), 0);
+ if (isgen) { /* generic for? */
+ luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars);
+ luaK_fixline(fs, line);
+ }
+ endfor = luaK_codeABx(fs, forloop[isgen], base, 0);
+ fixforjump(fs, endfor, prep + 1, 1);
+ luaK_fixline(fs, line);
+}
+
+
+static void fornum (LexState *ls, TString *varname, int line) {
+ /* fornum -> NAME = exp,exp[,exp] forbody */
+ FuncState *fs = ls->fs;
+ int base = fs->freereg;
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvar(ls, varname);
+ checknext(ls, '=');
+ exp1(ls); /* initial value */
+ checknext(ls, ',');
+ exp1(ls); /* limit */
+ if (testnext(ls, ','))
+ exp1(ls); /* optional step */
+ else { /* default step = 1 */
+ luaK_int(fs, fs->freereg, 1);
+ luaK_reserveregs(fs, 1);
+ }
+ adjustlocalvars(ls, 3); /* control variables */
+ forbody(ls, base, line, 1, 0);
+}
+
+
+static void forlist (LexState *ls, TString *indexname) {
+ /* forlist -> NAME {,NAME} IN explist forbody */
+ FuncState *fs = ls->fs;
+ expdesc e;
+ int nvars = 5; /* gen, state, control, toclose, 'indexname' */
+ int line;
+ int base = fs->freereg;
+ /* create control variables */
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ /* create declared variables */
+ new_localvar(ls, indexname);
+ while (testnext(ls, ',')) {
+ new_localvar(ls, str_checkname(ls));
+ nvars++;
+ }
+ checknext(ls, TK_IN);
+ line = ls->linenumber;
+ adjust_assign(ls, 4, explist(ls, &e), &e);
+ adjustlocalvars(ls, 4); /* control variables */
+ marktobeclosed(fs); /* last control var. must be closed */
+ luaK_checkstack(fs, 3); /* extra space to call generator */
+ forbody(ls, base, line, nvars - 4, 1);
+}
+
+
+static void forstat (LexState *ls, int line) {
+ /* forstat -> FOR (fornum | forlist) END */
+ FuncState *fs = ls->fs;
+ TString *varname;
+ BlockCnt bl;
+ enterblock(fs, &bl, 1); /* scope for loop and control variables */
+ luaX_next(ls); /* skip 'for' */
+ varname = str_checkname(ls); /* first variable name */
+ switch (ls->t.token) {
+ case '=': fornum(ls, varname, line); break;
+ case ',': case TK_IN: forlist(ls, varname); break;
+ default: luaX_syntaxerror(ls, "'=' or 'in' expected");
+ }
+ check_match(ls, TK_END, TK_FOR, line);
+ leaveblock(fs); /* loop scope ('break' jumps to this point) */
+}
+
+
+static void test_then_block (LexState *ls, int *escapelist) {
+ /* test_then_block -> [IF | ELSEIF] cond THEN block */
+ BlockCnt bl;
+ FuncState *fs = ls->fs;
+ expdesc v;
+ int jf; /* instruction to skip 'then' code (if condition is false) */
+ luaX_next(ls); /* skip IF or ELSEIF */
+ expr(ls, &v); /* read condition */
+ checknext(ls, TK_THEN);
+ if (ls->t.token == TK_BREAK) { /* 'if x then break' ? */
+ int line = ls->linenumber;
+ luaK_goiffalse(ls->fs, &v); /* will jump if condition is true */
+ luaX_next(ls); /* skip 'break' */
+ enterblock(fs, &bl, 0); /* must enter block before 'goto' */
+ newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, v.t);
+ while (testnext(ls, ';')) {} /* skip semicolons */
+ if (block_follow(ls, 0)) { /* jump is the entire block? */
+ leaveblock(fs);
+ return; /* and that is it */
+ }
+ else /* must skip over 'then' part if condition is false */
+ jf = luaK_jump(fs);
+ }
+ else { /* regular case (not a break) */
+ luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */
+ enterblock(fs, &bl, 0);
+ jf = v.f;
+ }
+ statlist(ls); /* 'then' part */
+ leaveblock(fs);
+ if (ls->t.token == TK_ELSE ||
+ ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */
+ luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */
+ luaK_patchtohere(fs, jf);
+}
+
+
+static void ifstat (LexState *ls, int line) {
+ /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */
+ FuncState *fs = ls->fs;
+ int escapelist = NO_JUMP; /* exit list for finished parts */
+ test_then_block(ls, &escapelist); /* IF cond THEN block */
+ while (ls->t.token == TK_ELSEIF)
+ test_then_block(ls, &escapelist); /* ELSEIF cond THEN block */
+ if (testnext(ls, TK_ELSE))
+ block(ls); /* 'else' part */
+ check_match(ls, TK_END, TK_IF, line);
+ luaK_patchtohere(fs, escapelist); /* patch escape list to 'if' end */
+}
+
+
+static void localfunc (LexState *ls) {
+ expdesc b;
+ FuncState *fs = ls->fs;
+ int fvar = fs->nactvar; /* function's variable index */
+ new_localvar(ls, str_checkname(ls)); /* new local variable */
+ adjustlocalvars(ls, 1); /* enter its scope */
+ body(ls, &b, 0, ls->linenumber); /* function created in next register */
+ /* debug information will only see the variable after this point! */
+ localdebuginfo(fs, fvar)->startpc = fs->pc;
+}
+
+
+static int getlocalattribute (LexState *ls) {
+ /* ATTRIB -> ['<' Name '>'] */
+ if (testnext(ls, '<')) {
+ const char *attr = getstr(str_checkname(ls));
+ checknext(ls, '>');
+ if (strcmp(attr, "const") == 0)
+ return RDKCONST; /* read-only variable */
+ else if (strcmp(attr, "close") == 0)
+ return RDKTOCLOSE; /* to-be-closed variable */
+ else
+ luaK_semerror(ls,
+ luaO_pushfstring(ls->L, "unknown attribute '%s'", attr));
+ }
+ return VDKREG; /* regular variable */
+}
+
+
+static void checktoclose (FuncState *fs, int level) {
+ if (level != -1) { /* is there a to-be-closed variable? */
+ marktobeclosed(fs);
+ luaK_codeABC(fs, OP_TBC, reglevel(fs, level), 0, 0);
+ }
+}
+
+
+static void localstat (LexState *ls) {
+ /* stat -> LOCAL NAME ATTRIB { ',' NAME ATTRIB } ['=' explist] */
+ FuncState *fs = ls->fs;
+ int toclose = -1; /* index of to-be-closed variable (if any) */
+ Vardesc *var; /* last variable */
+ int vidx, kind; /* index and kind of last variable */
+ int nvars = 0;
+ int nexps;
+ expdesc e;
+ do {
+ vidx = new_localvar(ls, str_checkname(ls));
+ kind = getlocalattribute(ls);
+ getlocalvardesc(fs, vidx)->vd.kind = kind;
+ if (kind == RDKTOCLOSE) { /* to-be-closed? */
+ if (toclose != -1) /* one already present? */
+ luaK_semerror(ls, "multiple to-be-closed variables in local list");
+ toclose = fs->nactvar + nvars;
+ }
+ nvars++;
+ } while (testnext(ls, ','));
+ if (testnext(ls, '='))
+ nexps = explist(ls, &e);
+ else {
+ e.k = VVOID;
+ nexps = 0;
+ }
+ var = getlocalvardesc(fs, vidx); /* get last variable */
+ if (nvars == nexps && /* no adjustments? */
+ var->vd.kind == RDKCONST && /* last variable is const? */
+ luaK_exp2const(fs, &e, &var->k)) { /* compile-time constant? */
+ var->vd.kind = RDKCTC; /* variable is a compile-time constant */
+ adjustlocalvars(ls, nvars - 1); /* exclude last variable */
+ fs->nactvar++; /* but count it */
+ }
+ else {
+ adjust_assign(ls, nvars, nexps, &e);
+ adjustlocalvars(ls, nvars);
+ }
+ checktoclose(fs, toclose);
+}
+
+
+static int funcname (LexState *ls, expdesc *v) {
+ /* funcname -> NAME {fieldsel} [':' NAME] */
+ int ismethod = 0;
+ singlevar(ls, v);
+ while (ls->t.token == '.')
+ fieldsel(ls, v);
+ if (ls->t.token == ':') {
+ ismethod = 1;
+ fieldsel(ls, v);
+ }
+ return ismethod;
+}
+
+
+static void funcstat (LexState *ls, int line) {
+ /* funcstat -> FUNCTION funcname body */
+ int ismethod;
+ expdesc v, b;
+ luaX_next(ls); /* skip FUNCTION */
+ ismethod = funcname(ls, &v);
+ body(ls, &b, ismethod, line);
+ check_readonly(ls, &v);
+ luaK_storevar(ls->fs, &v, &b);
+ luaK_fixline(ls->fs, line); /* definition "happens" in the first line */
+}
+
+
+static void exprstat (LexState *ls) {
+ /* stat -> func | assignment */
+ FuncState *fs = ls->fs;
+ struct LHS_assign v;
+ suffixedexp(ls, &v.v);
+ if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */
+ v.prev = NULL;
+ restassign(ls, &v, 1);
+ }
+ else { /* stat -> func */
+ Instruction *inst;
+ check_condition(ls, v.v.k == VCALL, "syntax error");
+ inst = &getinstruction(fs, &v.v);
+ SETARG_C(*inst, 1); /* call statement uses no results */
+ }
+}
+
+
+static void retstat (LexState *ls) {
+ /* stat -> RETURN [explist] [';'] */
+ FuncState *fs = ls->fs;
+ expdesc e;
+ int nret; /* number of values being returned */
+ int first = luaY_nvarstack(fs); /* first slot to be returned */
+ if (block_follow(ls, 1) || ls->t.token == ';')
+ nret = 0; /* return no values */
+ else {
+ nret = explist(ls, &e); /* optional return values */
+ if (hasmultret(e.k)) {
+ luaK_setmultret(fs, &e);
+ if (e.k == VCALL && nret == 1 && !fs->bl->insidetbc) { /* tail call? */
+ SET_OPCODE(getinstruction(fs,&e), OP_TAILCALL);
+ lua_assert(GETARG_A(getinstruction(fs,&e)) == luaY_nvarstack(fs));
+ }
+ nret = LUA_MULTRET; /* return all values */
+ }
+ else {
+ if (nret == 1) /* only one single value? */
+ first = luaK_exp2anyreg(fs, &e); /* can use original slot */
+ else { /* values must go to the top of the stack */
+ luaK_exp2nextreg(fs, &e);
+ lua_assert(nret == fs->freereg - first);
+ }
+ }
+ }
+ luaK_ret(fs, first, nret);
+ testnext(ls, ';'); /* skip optional semicolon */
+}
+
+
+static void statement (LexState *ls) {
+ int line = ls->linenumber; /* may be needed for error messages */
+ enterlevel(ls);
+ switch (ls->t.token) {
+ case ';': { /* stat -> ';' (empty statement) */
+ luaX_next(ls); /* skip ';' */
+ break;
+ }
+ case TK_IF: { /* stat -> ifstat */
+ ifstat(ls, line);
+ break;
+ }
+ case TK_WHILE: { /* stat -> whilestat */
+ whilestat(ls, line);
+ break;
+ }
+ case TK_DO: { /* stat -> DO block END */
+ luaX_next(ls); /* skip DO */
+ block(ls);
+ check_match(ls, TK_END, TK_DO, line);
+ break;
+ }
+ case TK_FOR: { /* stat -> forstat */
+ forstat(ls, line);
+ break;
+ }
+ case TK_REPEAT: { /* stat -> repeatstat */
+ repeatstat(ls, line);
+ break;
+ }
+ case TK_FUNCTION: { /* stat -> funcstat */
+ funcstat(ls, line);
+ break;
+ }
+ case TK_LOCAL: { /* stat -> localstat */
+ luaX_next(ls); /* skip LOCAL */
+ if (testnext(ls, TK_FUNCTION)) /* local function? */
+ localfunc(ls);
+ else
+ localstat(ls);
+ break;
+ }
+ case TK_DBCOLON: { /* stat -> label */
+ luaX_next(ls); /* skip double colon */
+ labelstat(ls, str_checkname(ls), line);
+ break;
+ }
+ case TK_RETURN: { /* stat -> retstat */
+ luaX_next(ls); /* skip RETURN */
+ retstat(ls);
+ break;
+ }
+ case TK_BREAK: { /* stat -> breakstat */
+ breakstat(ls);
+ break;
+ }
+ case TK_GOTO: { /* stat -> 'goto' NAME */
+ luaX_next(ls); /* skip 'goto' */
+ gotostat(ls);
+ break;
+ }
+ default: { /* stat -> func | assignment */
+ exprstat(ls);
+ break;
+ }
+ }
+ lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg &&
+ ls->fs->freereg >= luaY_nvarstack(ls->fs));
+ ls->fs->freereg = luaY_nvarstack(ls->fs); /* free registers */
+ leavelevel(ls);
+}
+
+/* }====================================================================== */
+
+
+/*
+** compiles the main function, which is a regular vararg function with an
+** upvalue named LUA_ENV
+*/
+static void mainfunc (LexState *ls, FuncState *fs) {
+ BlockCnt bl;
+ Upvaldesc *env;
+ open_func(ls, fs, &bl);
+ setvararg(fs, 0); /* main function is always declared vararg */
+ env = allocupvalue(fs); /* ...set environment upvalue */
+ env->instack = 1;
+ env->idx = 0;
+ env->kind = VDKREG;
+ env->name = ls->envn;
+ luaC_objbarrier(ls->L, fs->f, env->name);
+ luaX_next(ls); /* read first token */
+ statlist(ls); /* parse main body */
+ check(ls, TK_EOS);
+ close_func(ls);
+}
+
+
+LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
+ Dyndata *dyd, const char *name, int firstchar) {
+ LexState lexstate;
+ FuncState funcstate;
+ LClosure *cl = luaF_newLclosure(L, 1); /* create main closure */
+ setclLvalue2s(L, L->top, cl); /* anchor it (to avoid being collected) */
+ luaD_inctop(L);
+ lexstate.h = luaH_new(L); /* create table for scanner */
+ sethvalue2s(L, L->top, lexstate.h); /* anchor it */
+ luaD_inctop(L);
+ funcstate.f = cl->p = luaF_newproto(L);
+ luaC_objbarrier(L, cl, cl->p);
+ funcstate.f->source = luaS_new(L, name); /* create and anchor TString */
+ luaC_objbarrier(L, funcstate.f, funcstate.f->source);
+ lexstate.buff = buff;
+ lexstate.dyd = dyd;
+ dyd->actvar.n = dyd->gt.n = dyd->label.n = 0;
+ luaX_setinput(L, &lexstate, z, funcstate.f->source, firstchar);
+ mainfunc(&lexstate, &funcstate);
+ lua_assert(!funcstate.prev && funcstate.nups == 1 && !lexstate.fs);
+ /* all scopes should be correctly finished */
+ lua_assert(dyd->actvar.n == 0 && dyd->gt.n == 0 && dyd->label.n == 0);
+ L->top--; /* remove scanner's table */
+ return cl; /* closure is on the stack, too */
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lparser.h b/source/luametatex/source/luacore/lua54/src/lparser.h
new file mode 100644
index 000000000..5e4500f18
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lparser.h
@@ -0,0 +1,171 @@
+/*
+** $Id: lparser.h $
+** Lua Parser
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lparser_h
+#define lparser_h
+
+#include "llimits.h"
+#include "lobject.h"
+#include "lzio.h"
+
+
+/*
+** Expression and variable descriptor.
+** Code generation for variables and expressions can be delayed to allow
+** optimizations; An 'expdesc' structure describes a potentially-delayed
+** variable/expression. It has a description of its "main" value plus a
+** list of conditional jumps that can also produce its value (generated
+** by short-circuit operators 'and'/'or').
+*/
+
+/* kinds of variables/expressions */
+typedef enum {
+ VVOID, /* when 'expdesc' describes the last expression of a list,
+ this kind means an empty list (so, no expression) */
+ VNIL, /* constant nil */
+ VTRUE, /* constant true */
+ VFALSE, /* constant false */
+ VK, /* constant in 'k'; info = index of constant in 'k' */
+ VKFLT, /* floating constant; nval = numerical float value */
+ VKINT, /* integer constant; ival = numerical integer value */
+ VKSTR, /* string constant; strval = TString address;
+ (string is fixed by the lexer) */
+ VNONRELOC, /* expression has its value in a fixed register;
+ info = result register */
+ VLOCAL, /* local variable; var.ridx = register index;
+ var.vidx = relative index in 'actvar.arr' */
+ VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */
+ VCONST, /* compile-time <const> variable;
+ info = absolute index in 'actvar.arr' */
+ VINDEXED, /* indexed variable;
+ ind.t = table register;
+ ind.idx = key's R index */
+ VINDEXUP, /* indexed upvalue;
+ ind.t = table upvalue;
+ ind.idx = key's K index */
+ VINDEXI, /* indexed variable with constant integer;
+ ind.t = table register;
+ ind.idx = key's value */
+ VINDEXSTR, /* indexed variable with literal string;
+ ind.t = table register;
+ ind.idx = key's K index */
+ VJMP, /* expression is a test/comparison;
+ info = pc of corresponding jump instruction */
+ VRELOC, /* expression can put result in any register;
+ info = instruction pc */
+ VCALL, /* expression is a function call; info = instruction pc */
+ VVARARG /* vararg expression; info = instruction pc */
+} expkind;
+
+
+#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXSTR)
+#define vkisindexed(k) (VINDEXED <= (k) && (k) <= VINDEXSTR)
+
+
+typedef struct expdesc {
+ expkind k;
+ union {
+ lua_Integer ival; /* for VKINT */
+ lua_Number nval; /* for VKFLT */
+ TString *strval; /* for VKSTR */
+ int info; /* for generic use */
+ struct { /* for indexed variables */
+ short idx; /* index (R or "long" K) */
+ lu_byte t; /* table (register or upvalue) */
+ } ind;
+ struct { /* for local variables */
+ lu_byte ridx; /* register holding the variable */
+ unsigned short vidx; /* compiler index (in 'actvar.arr') */
+ } var;
+ } u;
+ int t; /* patch list of 'exit when true' */
+ int f; /* patch list of 'exit when false' */
+} expdesc;
+
+
+/* kinds of variables */
+#define VDKREG 0 /* regular */
+#define RDKCONST 1 /* constant */
+#define RDKTOCLOSE 2 /* to-be-closed */
+#define RDKCTC 3 /* compile-time constant */
+
+/* description of an active local variable */
+typedef union Vardesc {
+ struct {
+ TValuefields; /* constant value (if it is a compile-time constant) */
+ lu_byte kind;
+ lu_byte ridx; /* register holding the variable */
+ short pidx; /* index of the variable in the Proto's 'locvars' array */
+ TString *name; /* variable name */
+ } vd;
+ TValue k; /* constant value (if any) */
+} Vardesc;
+
+
+
+/* description of pending goto statements and label statements */
+typedef struct Labeldesc {
+ TString *name; /* label identifier */
+ int pc; /* position in code */
+ int line; /* line where it appeared */
+ lu_byte nactvar; /* number of active variables in that position */
+ lu_byte close; /* goto that escapes upvalues */
+} Labeldesc;
+
+
+/* list of labels or gotos */
+typedef struct Labellist {
+ Labeldesc *arr; /* array */
+ int n; /* number of entries in use */
+ int size; /* array size */
+} Labellist;
+
+
+/* dynamic structures used by the parser */
+typedef struct Dyndata {
+ struct { /* list of all active local variables */
+ Vardesc *arr;
+ int n;
+ int size;
+ } actvar;
+ Labellist gt; /* list of pending gotos */
+ Labellist label; /* list of active labels */
+} Dyndata;
+
+
+/* control of blocks */
+struct BlockCnt; /* defined in lparser.c */
+
+
+/* state needed to generate code for a given function */
+typedef struct FuncState {
+ Proto *f; /* current function header */
+ struct FuncState *prev; /* enclosing function */
+ struct LexState *ls; /* lexical state */
+ struct BlockCnt *bl; /* chain of current blocks */
+ int pc; /* next position to code (equivalent to 'ncode') */
+ int lasttarget; /* 'label' of last 'jump label' */
+ int previousline; /* last line that was saved in 'lineinfo' */
+ int nk; /* number of elements in 'k' */
+ int np; /* number of elements in 'p' */
+ int nabslineinfo; /* number of elements in 'abslineinfo' */
+ int firstlocal; /* index of first local var (in Dyndata array) */
+ int firstlabel; /* index of first label (in 'dyd->label->arr') */
+ short ndebugvars; /* number of elements in 'f->locvars' */
+ lu_byte nactvar; /* number of active local variables */
+ lu_byte nups; /* number of upvalues */
+ lu_byte freereg; /* first free register */
+ lu_byte iwthabs; /* instructions issued since last absolute line info */
+ lu_byte needclose; /* function needs to close upvalues when returning */
+} FuncState;
+
+
+LUAI_FUNC int luaY_nvarstack (FuncState *fs);
+LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
+ Dyndata *dyd, const char *name, int firstchar);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lprefix.h b/source/luametatex/source/luacore/lua54/src/lprefix.h
new file mode 100644
index 000000000..484f2ad6f
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lprefix.h
@@ -0,0 +1,45 @@
+/*
+** $Id: lprefix.h $
+** Definitions for Lua code that must come before any other header file
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lprefix_h
+#define lprefix_h
+
+
+/*
+** Allows POSIX/XSI stuff
+*/
+#if !defined(LUA_USE_C89) /* { */
+
+#if !defined(_XOPEN_SOURCE)
+#define _XOPEN_SOURCE 600
+#elif _XOPEN_SOURCE == 0
+#undef _XOPEN_SOURCE /* use -D_XOPEN_SOURCE=0 to undefine it */
+#endif
+
+/*
+** Allows manipulation of large files in gcc and some other compilers
+*/
+#if !defined(LUA_32BITS) && !defined(_FILE_OFFSET_BITS)
+#define _LARGEFILE_SOURCE 1
+#define _FILE_OFFSET_BITS 64
+#endif
+
+#endif /* } */
+
+
+/*
+** Windows stuff
+*/
+#if defined(_WIN32) /* { */
+
+#if !defined(_CRT_SECURE_NO_WARNINGS)
+#define _CRT_SECURE_NO_WARNINGS /* avoid warnings about ISO C functions */
+#endif
+
+#endif /* } */
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/lstate.c b/source/luametatex/source/luacore/lua54/src/lstate.c
new file mode 100644
index 000000000..1ffe1a0f7
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lstate.c
@@ -0,0 +1,440 @@
+/*
+** $Id: lstate.c $
+** Global State
+** See Copyright Notice in lua.h
+*/
+
+#define lstate_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <stddef.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lapi.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "llex.h"
+#include "lmem.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+
+
+
+/*
+** thread state + extra space
+*/
+typedef struct LX {
+ lu_byte extra_[LUA_EXTRASPACE];
+ lua_State l;
+} LX;
+
+
+/*
+** Main thread combines a thread state and the global state
+*/
+typedef struct LG {
+ LX l;
+ global_State g;
+} LG;
+
+
+
+#define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l)))
+
+
+/*
+** A macro to create a "random" seed when a state is created;
+** the seed is used to randomize string hashes.
+*/
+#if !defined(luai_makeseed)
+
+#include <time.h>
+
+/*
+** Compute an initial seed with some level of randomness.
+** Rely on Address Space Layout Randomization (if present) and
+** current time.
+*/
+#define addbuff(b,p,e) \
+ { size_t t = cast_sizet(e); \
+ memcpy(b + p, &t, sizeof(t)); p += sizeof(t); }
+
+static unsigned int luai_makeseed (lua_State *L) {
+ char buff[3 * sizeof(size_t)];
+ unsigned int h = cast_uint(time(NULL));
+ int p = 0;
+ addbuff(buff, p, L); /* heap variable */
+ addbuff(buff, p, &h); /* local variable */
+ addbuff(buff, p, &lua_newstate); /* public function */
+ lua_assert(p == sizeof(buff));
+ return luaS_hash(buff, p, h);
+}
+
+#endif
+
+
+/*
+** set GCdebt to a new value keeping the value (totalbytes + GCdebt)
+** invariant (and avoiding underflows in 'totalbytes')
+*/
+void luaE_setdebt (global_State *g, l_mem debt) {
+ l_mem tb = gettotalbytes(g);
+ lua_assert(tb > 0);
+ if (debt < tb - MAX_LMEM)
+ debt = tb - MAX_LMEM; /* will make 'totalbytes == MAX_LMEM' */
+ g->totalbytes = tb - debt;
+ g->GCdebt = debt;
+}
+
+
+LUA_API int lua_setcstacklimit (lua_State *L, unsigned int limit) {
+ UNUSED(L); UNUSED(limit);
+ return LUAI_MAXCCALLS; /* warning?? */
+}
+
+
+CallInfo *luaE_extendCI (lua_State *L) {
+ CallInfo *ci;
+ lua_assert(L->ci->next == NULL);
+ ci = luaM_new(L, CallInfo);
+ lua_assert(L->ci->next == NULL);
+ L->ci->next = ci;
+ ci->previous = L->ci;
+ ci->next = NULL;
+ ci->u.l.trap = 0;
+ L->nci++;
+ return ci;
+}
+
+
+/*
+** free all CallInfo structures not in use by a thread
+*/
+void luaE_freeCI (lua_State *L) {
+ CallInfo *ci = L->ci;
+ CallInfo *next = ci->next;
+ ci->next = NULL;
+ while ((ci = next) != NULL) {
+ next = ci->next;
+ luaM_free(L, ci);
+ L->nci--;
+ }
+}
+
+
+/*
+** free half of the CallInfo structures not in use by a thread,
+** keeping the first one.
+*/
+void luaE_shrinkCI (lua_State *L) {
+ CallInfo *ci = L->ci->next; /* first free CallInfo */
+ CallInfo *next;
+ if (ci == NULL)
+ return; /* no extra elements */
+ while ((next = ci->next) != NULL) { /* two extra elements? */
+ CallInfo *next2 = next->next; /* next's next */
+ ci->next = next2; /* remove next from the list */
+ L->nci--;
+ luaM_free(L, next); /* free next */
+ if (next2 == NULL)
+ break; /* no more elements */
+ else {
+ next2->previous = ci;
+ ci = next2; /* continue */
+ }
+ }
+}
+
+
+/*
+** Called when 'getCcalls(L)' larger or equal to LUAI_MAXCCALLS.
+** If equal, raises an overflow error. If value is larger than
+** LUAI_MAXCCALLS (which means it is handling an overflow) but
+** not much larger, does not report an error (to allow overflow
+** handling to work).
+*/
+void luaE_checkcstack (lua_State *L) {
+ if (getCcalls(L) == LUAI_MAXCCALLS)
+ luaG_runerror(L, "C stack overflow");
+ else if (getCcalls(L) >= (LUAI_MAXCCALLS / 10 * 11))
+ luaD_throw(L, LUA_ERRERR); /* error while handling stack error */
+}
+
+
+LUAI_FUNC void luaE_incCstack (lua_State *L) {
+ L->nCcalls++;
+ if (l_unlikely(getCcalls(L) >= LUAI_MAXCCALLS))
+ luaE_checkcstack(L);
+}
+
+
+static void stack_init (lua_State *L1, lua_State *L) {
+ int i; CallInfo *ci;
+ /* initialize stack array */
+ L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, StackValue);
+ L1->tbclist = L1->stack;
+ for (i = 0; i < BASIC_STACK_SIZE + EXTRA_STACK; i++)
+ setnilvalue(s2v(L1->stack + i)); /* erase new stack */
+ L1->top = L1->stack;
+ L1->stack_last = L1->stack + BASIC_STACK_SIZE;
+ /* initialize first ci */
+ ci = &L1->base_ci;
+ ci->next = ci->previous = NULL;
+ ci->callstatus = CIST_C;
+ ci->func = L1->top;
+ ci->u.c.k = NULL;
+ ci->nresults = 0;
+ setnilvalue(s2v(L1->top)); /* 'function' entry for this 'ci' */
+ L1->top++;
+ ci->top = L1->top + LUA_MINSTACK;
+ L1->ci = ci;
+}
+
+
+static void freestack (lua_State *L) {
+ if (L->stack == NULL)
+ return; /* stack not completely built yet */
+ L->ci = &L->base_ci; /* free the entire 'ci' list */
+ luaE_freeCI(L);
+ lua_assert(L->nci == 0);
+ luaM_freearray(L, L->stack, stacksize(L) + EXTRA_STACK); /* free stack */
+}
+
+
+/*
+** Create registry table and its predefined values
+*/
+static void init_registry (lua_State *L, global_State *g) {
+ /* create registry */
+ Table *registry = luaH_new(L);
+ sethvalue(L, &g->l_registry, registry);
+ luaH_resize(L, registry, LUA_RIDX_LAST, 0);
+ /* registry[LUA_RIDX_MAINTHREAD] = L */
+ setthvalue(L, &registry->array[LUA_RIDX_MAINTHREAD - 1], L);
+ /* registry[LUA_RIDX_GLOBALS] = new table (table of globals) */
+ sethvalue(L, &registry->array[LUA_RIDX_GLOBALS - 1], luaH_new(L));
+}
+
+
+/*
+** open parts of the state that may cause memory-allocation errors.
+*/
+static void f_luaopen (lua_State *L, void *ud) {
+ global_State *g = G(L);
+ UNUSED(ud);
+ stack_init(L, L); /* init stack */
+ init_registry(L, g);
+ luaS_init(L);
+ luaT_init(L);
+ luaX_init(L);
+ g->gcstp = 0; /* allow gc */
+ setnilvalue(&g->nilvalue); /* now state is complete */
+ luai_userstateopen(L);
+}
+
+
+/*
+** preinitialize a thread with consistent values without allocating
+** any memory (to avoid errors)
+*/
+static void preinit_thread (lua_State *L, global_State *g) {
+ G(L) = g;
+ L->stack = NULL;
+ L->ci = NULL;
+ L->nci = 0;
+ L->twups = L; /* thread has no upvalues */
+ L->nCcalls = 0;
+ L->errorJmp = NULL;
+ L->hook = NULL;
+ L->hookmask = 0;
+ L->basehookcount = 0;
+ L->allowhook = 1;
+ resethookcount(L);
+ L->openupval = NULL;
+ L->status = LUA_OK;
+ L->errfunc = 0;
+ L->oldpc = 0;
+}
+
+
+static void close_state (lua_State *L) {
+ global_State *g = G(L);
+ if (!completestate(g)) /* closing a partially built state? */
+ luaC_freeallobjects(L); /* just collect its objects */
+ else { /* closing a fully built state */
+ L->ci = &L->base_ci; /* unwind CallInfo list */
+ luaD_closeprotected(L, 1, LUA_OK); /* close all upvalues */
+ luaC_freeallobjects(L); /* collect all objects */
+ luai_userstateclose(L);
+ }
+ luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size);
+ freestack(L);
+ lua_assert(gettotalbytes(g) == sizeof(LG));
+ (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */
+}
+
+
+LUA_API lua_State *lua_newthread (lua_State *L) {
+ global_State *g;
+ lua_State *L1;
+ lua_lock(L);
+ g = G(L);
+ luaC_checkGC(L);
+ /* create new thread */
+ L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l;
+ L1->marked = luaC_white(g);
+ L1->tt = LUA_VTHREAD;
+ /* link it on list 'allgc' */
+ L1->next = g->allgc;
+ g->allgc = obj2gco(L1);
+ /* anchor it on L stack */
+ setthvalue2s(L, L->top, L1);
+ api_incr_top(L);
+ preinit_thread(L1, g);
+ L1->hookmask = L->hookmask;
+ L1->basehookcount = L->basehookcount;
+ L1->hook = L->hook;
+ resethookcount(L1);
+ /* initialize L1 extra space */
+ memcpy(lua_getextraspace(L1), lua_getextraspace(g->mainthread),
+ LUA_EXTRASPACE);
+ luai_userstatethread(L, L1);
+ stack_init(L1, L); /* init stack */
+ lua_unlock(L);
+ return L1;
+}
+
+
+void luaE_freethread (lua_State *L, lua_State *L1) {
+ LX *l = fromstate(L1);
+ luaF_closeupval(L1, L1->stack); /* close all upvalues */
+ lua_assert(L1->openupval == NULL);
+ luai_userstatefree(L, L1);
+ freestack(L1);
+ luaM_free(L, l);
+}
+
+
+int luaE_resetthread (lua_State *L, int status) {
+ CallInfo *ci = L->ci = &L->base_ci; /* unwind CallInfo list */
+ setnilvalue(s2v(L->stack)); /* 'function' entry for basic 'ci' */
+ ci->func = L->stack;
+ ci->callstatus = CIST_C;
+ if (status == LUA_YIELD)
+ status = LUA_OK;
+ L->status = LUA_OK; /* so it can run __close metamethods */
+ status = luaD_closeprotected(L, 1, status);
+ if (status != LUA_OK) /* errors? */
+ luaD_seterrorobj(L, status, L->stack + 1);
+ else
+ L->top = L->stack + 1;
+ ci->top = L->top + LUA_MINSTACK;
+ luaD_reallocstack(L, cast_int(ci->top - L->stack), 0);
+ return status;
+}
+
+
+LUA_API int lua_resetthread (lua_State *L) {
+ int status;
+ lua_lock(L);
+ status = luaE_resetthread(L, L->status);
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
+ int i;
+ lua_State *L;
+ global_State *g;
+ LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG)));
+ if (l == NULL) return NULL;
+ L = &l->l.l;
+ g = &l->g;
+ L->tt = LUA_VTHREAD;
+ g->currentwhite = bitmask(WHITE0BIT);
+ L->marked = luaC_white(g);
+ preinit_thread(L, g);
+ g->allgc = obj2gco(L); /* by now, only object is the main thread */
+ L->next = NULL;
+ incnny(L); /* main thread is always non yieldable */
+ g->frealloc = f;
+ g->ud = ud;
+ g->warnf = NULL;
+ g->ud_warn = NULL;
+ g->mainthread = L;
+ g->seed = luai_makeseed(L);
+ g->gcstp = GCSTPGC; /* no GC while building state */
+ g->strt.size = g->strt.nuse = 0;
+ g->strt.hash = NULL;
+ setnilvalue(&g->l_registry);
+ g->panic = NULL;
+ g->gcstate = GCSpause;
+ g->gckind = KGC_INC;
+ g->gcstopem = 0;
+ g->gcemergency = 0;
+ g->finobj = g->tobefnz = g->fixedgc = NULL;
+ g->firstold1 = g->survival = g->old1 = g->reallyold = NULL;
+ g->finobjsur = g->finobjold1 = g->finobjrold = NULL;
+ g->sweepgc = NULL;
+ g->gray = g->grayagain = NULL;
+ g->weak = g->ephemeron = g->allweak = NULL;
+ g->twups = NULL;
+ g->totalbytes = sizeof(LG);
+ g->GCdebt = 0;
+ g->lastatomic = 0;
+ setivalue(&g->nilvalue, 0); /* to signal that state is not yet built */
+ setgcparam(g->gcpause, LUAI_GCPAUSE);
+ setgcparam(g->gcstepmul, LUAI_GCMUL);
+ g->gcstepsize = LUAI_GCSTEPSIZE;
+ setgcparam(g->genmajormul, LUAI_GENMAJORMUL);
+ g->genminormul = LUAI_GENMINORMUL;
+ for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL;
+ if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {
+ /* memory allocation error: free partial state */
+ close_state(L);
+ L = NULL;
+ }
+ return L;
+}
+
+
+LUA_API void lua_close (lua_State *L) {
+ lua_lock(L);
+ L = G(L)->mainthread; /* only the main thread can be closed */
+ close_state(L);
+}
+
+
+void luaE_warning (lua_State *L, const char *msg, int tocont) {
+ lua_WarnFunction wf = G(L)->warnf;
+ if (wf != NULL)
+ wf(G(L)->ud_warn, msg, tocont);
+}
+
+
+/*
+** Generate a warning from an error message
+*/
+void luaE_warnerror (lua_State *L, const char *where) {
+ TValue *errobj = s2v(L->top - 1); /* error object */
+ const char *msg = (ttisstring(errobj))
+ ? svalue(errobj)
+ : "error object is not a string";
+ /* produce warning "error in %s (%s)" (where, msg) */
+ luaE_warning(L, "error in ", 1);
+ luaE_warning(L, where, 1);
+ luaE_warning(L, " (", 1);
+ luaE_warning(L, msg, 1);
+ luaE_warning(L, ")", 0);
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lstate.h b/source/luametatex/source/luacore/lua54/src/lstate.h
new file mode 100644
index 000000000..61e82cde7
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lstate.h
@@ -0,0 +1,404 @@
+/*
+** $Id: lstate.h $
+** Global State
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lstate_h
+#define lstate_h
+
+#include "lua.h"
+
+#include "lobject.h"
+#include "ltm.h"
+#include "lzio.h"
+
+
+/*
+** Some notes about garbage-collected objects: All objects in Lua must
+** be kept somehow accessible until being freed, so all objects always
+** belong to one (and only one) of these lists, using field 'next' of
+** the 'CommonHeader' for the link:
+**
+** 'allgc': all objects not marked for finalization;
+** 'finobj': all objects marked for finalization;
+** 'tobefnz': all objects ready to be finalized;
+** 'fixedgc': all objects that are not to be collected (currently
+** only small strings, such as reserved words).
+**
+** For the generational collector, some of these lists have marks for
+** generations. Each mark points to the first element in the list for
+** that particular generation; that generation goes until the next mark.
+**
+** 'allgc' -> 'survival': new objects;
+** 'survival' -> 'old': objects that survived one collection;
+** 'old1' -> 'reallyold': objects that became old in last collection;
+** 'reallyold' -> NULL: objects old for more than one cycle.
+**
+** 'finobj' -> 'finobjsur': new objects marked for finalization;
+** 'finobjsur' -> 'finobjold1': survived """";
+** 'finobjold1' -> 'finobjrold': just old """";
+** 'finobjrold' -> NULL: really old """".
+**
+** All lists can contain elements older than their main ages, due
+** to 'luaC_checkfinalizer' and 'udata2finalize', which move
+** objects between the normal lists and the "marked for finalization"
+** lists. Moreover, barriers can age young objects in young lists as
+** OLD0, which then become OLD1. However, a list never contains
+** elements younger than their main ages.
+**
+** The generational collector also uses a pointer 'firstold1', which
+** points to the first OLD1 object in the list. It is used to optimize
+** 'markold'. (Potentially OLD1 objects can be anywhere between 'allgc'
+** and 'reallyold', but often the list has no OLD1 objects or they are
+** after 'old1'.) Note the difference between it and 'old1':
+** 'firstold1': no OLD1 objects before this point; there can be all
+** ages after it.
+** 'old1': no objects younger than OLD1 after this point.
+*/
+
+/*
+** Moreover, there is another set of lists that control gray objects.
+** These lists are linked by fields 'gclist'. (All objects that
+** can become gray have such a field. The field is not the same
+** in all objects, but it always has this name.) Any gray object
+** must belong to one of these lists, and all objects in these lists
+** must be gray (with two exceptions explained below):
+**
+** 'gray': regular gray objects, still waiting to be visited.
+** 'grayagain': objects that must be revisited at the atomic phase.
+** That includes
+** - black objects got in a write barrier;
+** - all kinds of weak tables during propagation phase;
+** - all threads.
+** 'weak': tables with weak values to be cleared;
+** 'ephemeron': ephemeron tables with white->white entries;
+** 'allweak': tables with weak keys and/or weak values to be cleared.
+**
+** The exceptions to that "gray rule" are:
+** - TOUCHED2 objects in generational mode stay in a gray list (because
+** they must be visited again at the end of the cycle), but they are
+** marked black because assignments to them must activate barriers (to
+** move them back to TOUCHED1).
+** - Open upvales are kept gray to avoid barriers, but they stay out
+** of gray lists. (They don't even have a 'gclist' field.)
+*/
+
+
+
+/*
+** About 'nCcalls': This count has two parts: the lower 16 bits counts
+** the number of recursive invocations in the C stack; the higher
+** 16 bits counts the number of non-yieldable calls in the stack.
+** (They are together so that we can change and save both with one
+** instruction.)
+*/
+
+
+/* true if this thread does not have non-yieldable calls in the stack */
+#define yieldable(L) (((L)->nCcalls & 0xffff0000) == 0)
+
+/* real number of C calls */
+#define getCcalls(L) ((L)->nCcalls & 0xffff)
+
+
+/* Increment the number of non-yieldable calls */
+#define incnny(L) ((L)->nCcalls += 0x10000)
+
+/* Decrement the number of non-yieldable calls */
+#define decnny(L) ((L)->nCcalls -= 0x10000)
+
+/* Non-yieldable call increment */
+#define nyci (0x10000 | 1)
+
+
+
+
+struct lua_longjmp; /* defined in ldo.c */
+
+
+/*
+** Atomic type (relative to signals) to better ensure that 'lua_sethook'
+** is thread safe
+*/
+#if !defined(l_signalT)
+#include <signal.h>
+#define l_signalT sig_atomic_t
+#endif
+
+
+/*
+** Extra stack space to handle TM calls and some other extras. This
+** space is not included in 'stack_last'. It is used only to avoid stack
+** checks, either because the element will be promptly popped or because
+** there will be a stack check soon after the push. Function frames
+** never use this extra space, so it does not need to be kept clean.
+*/
+#define EXTRA_STACK 5
+
+
+#define BASIC_STACK_SIZE (2*LUA_MINSTACK)
+
+#define stacksize(th) cast_int((th)->stack_last - (th)->stack)
+
+
+/* kinds of Garbage Collection */
+#define KGC_INC 0 /* incremental gc */
+#define KGC_GEN 1 /* generational gc */
+
+
+typedef struct stringtable {
+ TString **hash;
+ int nuse; /* number of elements */
+ int size;
+} stringtable;
+
+
+/*
+** Information about a call.
+** About union 'u':
+** - field 'l' is used only for Lua functions;
+** - field 'c' is used only for C functions.
+** About union 'u2':
+** - field 'funcidx' is used only by C functions while doing a
+** protected call;
+** - field 'nyield' is used only while a function is "doing" an
+** yield (from the yield until the next resume);
+** - field 'nres' is used only while closing tbc variables when
+** returning from a function;
+** - field 'transferinfo' is used only during call/returnhooks,
+** before the function starts or after it ends.
+*/
+typedef struct CallInfo {
+ StkId func; /* function index in the stack */
+ StkId top; /* top for this function */
+ struct CallInfo *previous, *next; /* dynamic call link */
+ union {
+ struct { /* only for Lua functions */
+ const Instruction *savedpc;
+ volatile l_signalT trap;
+ int nextraargs; /* # of extra arguments in vararg functions */
+ } l;
+ struct { /* only for C functions */
+ lua_KFunction k; /* continuation in case of yields */
+ ptrdiff_t old_errfunc;
+ lua_KContext ctx; /* context info. in case of yields */
+ } c;
+ } u;
+ union {
+ int funcidx; /* called-function index */
+ int nyield; /* number of values yielded */
+ int nres; /* number of values returned */
+ struct { /* info about transferred values (for call/return hooks) */
+ unsigned short ftransfer; /* offset of first value transferred */
+ unsigned short ntransfer; /* number of values transferred */
+ } transferinfo;
+ } u2;
+ short nresults; /* expected number of results from this function */
+ unsigned short callstatus;
+} CallInfo;
+
+
+/*
+** Bits in CallInfo status
+*/
+#define CIST_OAH (1<<0) /* original value of 'allowhook' */
+#define CIST_C (1<<1) /* call is running a C function */
+#define CIST_FRESH (1<<2) /* call is on a fresh "luaV_execute" frame */
+#define CIST_HOOKED (1<<3) /* call is running a debug hook */
+#define CIST_YPCALL (1<<4) /* doing a yieldable protected call */
+#define CIST_TAIL (1<<5) /* call was tail called */
+#define CIST_HOOKYIELD (1<<6) /* last hook called yielded */
+#define CIST_FIN (1<<7) /* function "called" a finalizer */
+#define CIST_TRAN (1<<8) /* 'ci' has transfer information */
+#define CIST_CLSRET (1<<9) /* function is closing tbc variables */
+/* Bits 10-12 are used for CIST_RECST (see below) */
+#define CIST_RECST 10
+#if defined(LUA_COMPAT_LT_LE)
+#define CIST_LEQ (1<<13) /* using __lt for __le */
+#endif
+
+
+/*
+** Field CIST_RECST stores the "recover status", used to keep the error
+** status while closing to-be-closed variables in coroutines, so that
+** Lua can correctly resume after an yield from a __close method called
+** because of an error. (Three bits are enough for error status.)
+*/
+#define getcistrecst(ci) (((ci)->callstatus >> CIST_RECST) & 7)
+#define setcistrecst(ci,st) \
+ check_exp(((st) & 7) == (st), /* status must fit in three bits */ \
+ ((ci)->callstatus = ((ci)->callstatus & ~(7 << CIST_RECST)) \
+ | ((st) << CIST_RECST)))
+
+
+/* active function is a Lua function */
+#define isLua(ci) (!((ci)->callstatus & CIST_C))
+
+/* call is running Lua code (not a hook) */
+#define isLuacode(ci) (!((ci)->callstatus & (CIST_C | CIST_HOOKED)))
+
+/* assume that CIST_OAH has offset 0 and that 'v' is strictly 0/1 */
+#define setoah(st,v) ((st) = ((st) & ~CIST_OAH) | (v))
+#define getoah(st) ((st) & CIST_OAH)
+
+
+/*
+** 'global state', shared by all threads of this state
+*/
+typedef struct global_State {
+ lua_Alloc frealloc; /* function to reallocate memory */
+ void *ud; /* auxiliary data to 'frealloc' */
+ l_mem totalbytes; /* number of bytes currently allocated - GCdebt */
+ l_mem GCdebt; /* bytes allocated not yet compensated by the collector */
+ lu_mem GCestimate; /* an estimate of the non-garbage memory in use */
+ lu_mem lastatomic; /* see function 'genstep' in file 'lgc.c' */
+ stringtable strt; /* hash table for strings */
+ TValue l_registry;
+ TValue nilvalue; /* a nil value */
+ unsigned int seed; /* randomized seed for hashes */
+ lu_byte currentwhite;
+ lu_byte gcstate; /* state of garbage collector */
+ lu_byte gckind; /* kind of GC running */
+ lu_byte gcstopem; /* stops emergency collections */
+ lu_byte genminormul; /* control for minor generational collections */
+ lu_byte genmajormul; /* control for major generational collections */
+ lu_byte gcstp; /* control whether GC is running */
+ lu_byte gcemergency; /* true if this is an emergency collection */
+ lu_byte gcpause; /* size of pause between successive GCs */
+ lu_byte gcstepmul; /* GC "speed" */
+ lu_byte gcstepsize; /* (log2 of) GC granularity */
+ GCObject *allgc; /* list of all collectable objects */
+ GCObject **sweepgc; /* current position of sweep in list */
+ GCObject *finobj; /* list of collectable objects with finalizers */
+ GCObject *gray; /* list of gray objects */
+ GCObject *grayagain; /* list of objects to be traversed atomically */
+ GCObject *weak; /* list of tables with weak values */
+ GCObject *ephemeron; /* list of ephemeron tables (weak keys) */
+ GCObject *allweak; /* list of all-weak tables */
+ GCObject *tobefnz; /* list of userdata to be GC */
+ GCObject *fixedgc; /* list of objects not to be collected */
+ /* fields for generational collector */
+ GCObject *survival; /* start of objects that survived one GC cycle */
+ GCObject *old1; /* start of old1 objects */
+ GCObject *reallyold; /* objects more than one cycle old ("really old") */
+ GCObject *firstold1; /* first OLD1 object in the list (if any) */
+ GCObject *finobjsur; /* list of survival objects with finalizers */
+ GCObject *finobjold1; /* list of old1 objects with finalizers */
+ GCObject *finobjrold; /* list of really old objects with finalizers */
+ struct lua_State *twups; /* list of threads with open upvalues */
+ lua_CFunction panic; /* to be called in unprotected errors */
+ struct lua_State *mainthread;
+ TString *memerrmsg; /* message for memory-allocation errors */
+ TString *tmname[TM_N]; /* array with tag-method names */
+ struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */
+ TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */
+ lua_WarnFunction warnf; /* warning function */
+ void *ud_warn; /* auxiliary data to 'warnf' */
+} global_State;
+
+
+/*
+** 'per thread' state
+*/
+struct lua_State {
+ CommonHeader;
+ lu_byte status;
+ lu_byte allowhook;
+ unsigned short nci; /* number of items in 'ci' list */
+ StkId top; /* first free slot in the stack */
+ global_State *l_G;
+ CallInfo *ci; /* call info for current function */
+ StkId stack_last; /* end of stack (last element + 1) */
+ StkId stack; /* stack base */
+ UpVal *openupval; /* list of open upvalues in this stack */
+ StkId tbclist; /* list of to-be-closed variables */
+ GCObject *gclist;
+ struct lua_State *twups; /* list of threads with open upvalues */
+ struct lua_longjmp *errorJmp; /* current error recover point */
+ CallInfo base_ci; /* CallInfo for first level (C calling Lua) */
+ volatile lua_Hook hook;
+ ptrdiff_t errfunc; /* current error handling function (stack index) */
+ l_uint32 nCcalls; /* number of nested (non-yieldable | C) calls */
+ int oldpc; /* last pc traced */
+ int basehookcount;
+ int hookcount;
+ volatile l_signalT hookmask;
+};
+
+
+#define G(L) (L->l_G)
+
+/*
+** 'g->nilvalue' being a nil value flags that the state was completely
+** build.
+*/
+#define completestate(g) ttisnil(&g->nilvalue)
+
+
+/*
+** Union of all collectable objects (only for conversions)
+** ISO C99, 6.5.2.3 p.5:
+** "if a union contains several structures that share a common initial
+** sequence [...], and if the union object currently contains one
+** of these structures, it is permitted to inspect the common initial
+** part of any of them anywhere that a declaration of the complete type
+** of the union is visible."
+*/
+union GCUnion {
+ GCObject gc; /* common header */
+ struct TString ts;
+ struct Udata u;
+ union Closure cl;
+ struct Table h;
+ struct Proto p;
+ struct lua_State th; /* thread */
+ struct UpVal upv;
+};
+
+
+/*
+** ISO C99, 6.7.2.1 p.14:
+** "A pointer to a union object, suitably converted, points to each of
+** its members [...], and vice versa."
+*/
+#define cast_u(o) cast(union GCUnion *, (o))
+
+/* macros to convert a GCObject into a specific value */
+#define gco2ts(o) \
+ check_exp(novariant((o)->tt) == LUA_TSTRING, &((cast_u(o))->ts))
+#define gco2u(o) check_exp((o)->tt == LUA_VUSERDATA, &((cast_u(o))->u))
+#define gco2lcl(o) check_exp((o)->tt == LUA_VLCL, &((cast_u(o))->cl.l))
+#define gco2ccl(o) check_exp((o)->tt == LUA_VCCL, &((cast_u(o))->cl.c))
+#define gco2cl(o) \
+ check_exp(novariant((o)->tt) == LUA_TFUNCTION, &((cast_u(o))->cl))
+#define gco2t(o) check_exp((o)->tt == LUA_VTABLE, &((cast_u(o))->h))
+#define gco2p(o) check_exp((o)->tt == LUA_VPROTO, &((cast_u(o))->p))
+#define gco2th(o) check_exp((o)->tt == LUA_VTHREAD, &((cast_u(o))->th))
+#define gco2upv(o) check_exp((o)->tt == LUA_VUPVAL, &((cast_u(o))->upv))
+
+
+/*
+** macro to convert a Lua object into a GCObject
+** (The access to 'tt' tries to ensure that 'v' is actually a Lua object.)
+*/
+#define obj2gco(v) check_exp((v)->tt >= LUA_TSTRING, &(cast_u(v)->gc))
+
+
+/* actual number of total bytes allocated */
+#define gettotalbytes(g) cast(lu_mem, (g)->totalbytes + (g)->GCdebt)
+
+LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt);
+LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
+LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L);
+LUAI_FUNC void luaE_freeCI (lua_State *L);
+LUAI_FUNC void luaE_shrinkCI (lua_State *L);
+LUAI_FUNC void luaE_checkcstack (lua_State *L);
+LUAI_FUNC void luaE_incCstack (lua_State *L);
+LUAI_FUNC void luaE_warning (lua_State *L, const char *msg, int tocont);
+LUAI_FUNC void luaE_warnerror (lua_State *L, const char *where);
+LUAI_FUNC int luaE_resetthread (lua_State *L, int status);
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/lstring.c b/source/luametatex/source/luacore/lua54/src/lstring.c
new file mode 100644
index 000000000..13dcaf425
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lstring.c
@@ -0,0 +1,273 @@
+/*
+** $Id: lstring.c $
+** String table (keeps all strings handled by Lua)
+** See Copyright Notice in lua.h
+*/
+
+#define lstring_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <string.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+
+
+/*
+** Maximum size for string table.
+*/
+#define MAXSTRTB cast_int(luaM_limitN(MAX_INT, TString*))
+
+
+/*
+** equality for long strings
+*/
+int luaS_eqlngstr (TString *a, TString *b) {
+ size_t len = a->u.lnglen;
+ lua_assert(a->tt == LUA_VLNGSTR && b->tt == LUA_VLNGSTR);
+ return (a == b) || /* same instance or... */
+ ((len == b->u.lnglen) && /* equal length and ... */
+ (memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */
+}
+
+
+unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) {
+ unsigned int h = seed ^ cast_uint(l);
+ for (; l > 0; l--)
+ h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));
+ return h;
+}
+
+
+unsigned int luaS_hashlongstr (TString *ts) {
+ lua_assert(ts->tt == LUA_VLNGSTR);
+ if (ts->extra == 0) { /* no hash? */
+ size_t len = ts->u.lnglen;
+ ts->hash = luaS_hash(getstr(ts), len, ts->hash);
+ ts->extra = 1; /* now it has its hash */
+ }
+ return ts->hash;
+}
+
+
+static void tablerehash (TString **vect, int osize, int nsize) {
+ int i;
+ for (i = osize; i < nsize; i++) /* clear new elements */
+ vect[i] = NULL;
+ for (i = 0; i < osize; i++) { /* rehash old part of the array */
+ TString *p = vect[i];
+ vect[i] = NULL;
+ while (p) { /* for each string in the list */
+ TString *hnext = p->u.hnext; /* save next */
+ unsigned int h = lmod(p->hash, nsize); /* new position */
+ p->u.hnext = vect[h]; /* chain it into array */
+ vect[h] = p;
+ p = hnext;
+ }
+ }
+}
+
+
+/*
+** Resize the string table. If allocation fails, keep the current size.
+** (This can degrade performance, but any non-zero size should work
+** correctly.)
+*/
+void luaS_resize (lua_State *L, int nsize) {
+ stringtable *tb = &G(L)->strt;
+ int osize = tb->size;
+ TString **newvect;
+ if (nsize < osize) /* shrinking table? */
+ tablerehash(tb->hash, osize, nsize); /* depopulate shrinking part */
+ newvect = luaM_reallocvector(L, tb->hash, osize, nsize, TString*);
+ if (l_unlikely(newvect == NULL)) { /* reallocation failed? */
+ if (nsize < osize) /* was it shrinking table? */
+ tablerehash(tb->hash, nsize, osize); /* restore to original size */
+ /* leave table as it was */
+ }
+ else { /* allocation succeeded */
+ tb->hash = newvect;
+ tb->size = nsize;
+ if (nsize > osize)
+ tablerehash(newvect, osize, nsize); /* rehash for new size */
+ }
+}
+
+
+/*
+** Clear API string cache. (Entries cannot be empty, so fill them with
+** a non-collectable string.)
+*/
+void luaS_clearcache (global_State *g) {
+ int i, j;
+ for (i = 0; i < STRCACHE_N; i++)
+ for (j = 0; j < STRCACHE_M; j++) {
+ if (iswhite(g->strcache[i][j])) /* will entry be collected? */
+ g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */
+ }
+}
+
+
+/*
+** Initialize the string table and the string cache
+*/
+void luaS_init (lua_State *L) {
+ global_State *g = G(L);
+ int i, j;
+ stringtable *tb = &G(L)->strt;
+ tb->hash = luaM_newvector(L, MINSTRTABSIZE, TString*);
+ tablerehash(tb->hash, 0, MINSTRTABSIZE); /* clear array */
+ tb->size = MINSTRTABSIZE;
+ /* pre-create memory-error message */
+ g->memerrmsg = luaS_newliteral(L, MEMERRMSG);
+ luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */
+ for (i = 0; i < STRCACHE_N; i++) /* fill cache with valid strings */
+ for (j = 0; j < STRCACHE_M; j++)
+ g->strcache[i][j] = g->memerrmsg;
+}
+
+
+
+/*
+** creates a new string object
+*/
+static TString *createstrobj (lua_State *L, size_t l, int tag, unsigned int h) {
+ TString *ts;
+ GCObject *o;
+ size_t totalsize; /* total size of TString object */
+ totalsize = sizelstring(l);
+ o = luaC_newobj(L, tag, totalsize);
+ ts = gco2ts(o);
+ ts->hash = h;
+ ts->extra = 0;
+ getstr(ts)[l] = '\0'; /* ending 0 */
+ return ts;
+}
+
+
+TString *luaS_createlngstrobj (lua_State *L, size_t l) {
+ TString *ts = createstrobj(L, l, LUA_VLNGSTR, G(L)->seed);
+ ts->u.lnglen = l;
+ return ts;
+}
+
+
+void luaS_remove (lua_State *L, TString *ts) {
+ stringtable *tb = &G(L)->strt;
+ TString **p = &tb->hash[lmod(ts->hash, tb->size)];
+ while (*p != ts) /* find previous element */
+ p = &(*p)->u.hnext;
+ *p = (*p)->u.hnext; /* remove element from its list */
+ tb->nuse--;
+}
+
+
+static void growstrtab (lua_State *L, stringtable *tb) {
+ if (l_unlikely(tb->nuse == MAX_INT)) { /* too many strings? */
+ luaC_fullgc(L, 1); /* try to free some... */
+ if (tb->nuse == MAX_INT) /* still too many? */
+ luaM_error(L); /* cannot even create a message... */
+ }
+ if (tb->size <= MAXSTRTB / 2) /* can grow string table? */
+ luaS_resize(L, tb->size * 2);
+}
+
+
+/*
+** Checks whether short string exists and reuses it or creates a new one.
+*/
+static TString *internshrstr (lua_State *L, const char *str, size_t l) {
+ TString *ts;
+ global_State *g = G(L);
+ stringtable *tb = &g->strt;
+ unsigned int h = luaS_hash(str, l, g->seed);
+ TString **list = &tb->hash[lmod(h, tb->size)];
+ lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */
+ for (ts = *list; ts != NULL; ts = ts->u.hnext) {
+ if (l == ts->shrlen && (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) {
+ /* found! */
+ if (isdead(g, ts)) /* dead (but not collected yet)? */
+ changewhite(ts); /* resurrect it */
+ return ts;
+ }
+ }
+ /* else must create a new string */
+ if (tb->nuse >= tb->size) { /* need to grow string table? */
+ growstrtab(L, tb);
+ list = &tb->hash[lmod(h, tb->size)]; /* rehash with new size */
+ }
+ ts = createstrobj(L, l, LUA_VSHRSTR, h);
+ memcpy(getstr(ts), str, l * sizeof(char));
+ ts->shrlen = cast_byte(l);
+ ts->u.hnext = *list;
+ *list = ts;
+ tb->nuse++;
+ return ts;
+}
+
+
+/*
+** new string (with explicit length)
+*/
+TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
+ if (l <= LUAI_MAXSHORTLEN) /* short string? */
+ return internshrstr(L, str, l);
+ else {
+ TString *ts;
+ if (l_unlikely(l >= (MAX_SIZE - sizeof(TString))/sizeof(char)))
+ luaM_toobig(L);
+ ts = luaS_createlngstrobj(L, l);
+ memcpy(getstr(ts), str, l * sizeof(char));
+ return ts;
+ }
+}
+
+
+/*
+** Create or reuse a zero-terminated string, first checking in the
+** cache (using the string address as a key). The cache can contain
+** only zero-terminated strings, so it is safe to use 'strcmp' to
+** check hits.
+*/
+TString *luaS_new (lua_State *L, const char *str) {
+ unsigned int i = point2uint(str) % STRCACHE_N; /* hash */
+ int j;
+ TString **p = G(L)->strcache[i];
+ for (j = 0; j < STRCACHE_M; j++) {
+ if (strcmp(str, getstr(p[j])) == 0) /* hit? */
+ return p[j]; /* that is it */
+ }
+ /* normal route */
+ for (j = STRCACHE_M - 1; j > 0; j--)
+ p[j] = p[j - 1]; /* move out last element */
+ /* new element is first in the list */
+ p[0] = luaS_newlstr(L, str, strlen(str));
+ return p[0];
+}
+
+
+Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue) {
+ Udata *u;
+ int i;
+ GCObject *o;
+ if (l_unlikely(s > MAX_SIZE - udatamemoffset(nuvalue)))
+ luaM_toobig(L);
+ o = luaC_newobj(L, LUA_VUSERDATA, sizeudata(nuvalue, s));
+ u = gco2u(o);
+ u->len = s;
+ u->nuvalue = nuvalue;
+ u->metatable = NULL;
+ for (i = 0; i < nuvalue; i++)
+ setnilvalue(&u->uv[i].uv);
+ return u;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lstring.h b/source/luametatex/source/luacore/lua54/src/lstring.h
new file mode 100644
index 000000000..450c2390d
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lstring.h
@@ -0,0 +1,57 @@
+/*
+** $Id: lstring.h $
+** String table (keep all strings handled by Lua)
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lstring_h
+#define lstring_h
+
+#include "lgc.h"
+#include "lobject.h"
+#include "lstate.h"
+
+
+/*
+** Memory-allocation error message must be preallocated (it cannot
+** be created after memory is exhausted)
+*/
+#define MEMERRMSG "not enough memory"
+
+
+/*
+** Size of a TString: Size of the header plus space for the string
+** itself (including final '\0').
+*/
+#define sizelstring(l) (offsetof(TString, contents) + ((l) + 1) * sizeof(char))
+
+#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \
+ (sizeof(s)/sizeof(char))-1))
+
+
+/*
+** test whether a string is a reserved word
+*/
+#define isreserved(s) ((s)->tt == LUA_VSHRSTR && (s)->extra > 0)
+
+
+/*
+** equality for short strings, which are always internalized
+*/
+#define eqshrstr(a,b) check_exp((a)->tt == LUA_VSHRSTR, (a) == (b))
+
+
+LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l, unsigned int seed);
+LUAI_FUNC unsigned int luaS_hashlongstr (TString *ts);
+LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b);
+LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
+LUAI_FUNC void luaS_clearcache (global_State *g);
+LUAI_FUNC void luaS_init (lua_State *L);
+LUAI_FUNC void luaS_remove (lua_State *L, TString *ts);
+LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue);
+LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
+LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);
+LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lstrlib.c b/source/luametatex/source/luacore/lua54/src/lstrlib.c
new file mode 100644
index 000000000..0b4fdbb7b
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lstrlib.c
@@ -0,0 +1,1874 @@
+/*
+** $Id: lstrlib.c $
+** Standard library for string operations and pattern-matching
+** See Copyright Notice in lua.h
+*/
+
+#define lstrlib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <ctype.h>
+#include <float.h>
+#include <limits.h>
+#include <locale.h>
+#include <math.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/*
+** maximum number of captures that a pattern can do during
+** pattern-matching. This limit is arbitrary, but must fit in
+** an unsigned char.
+*/
+#if !defined(LUA_MAXCAPTURES)
+#define LUA_MAXCAPTURES 32
+#endif
+
+
+/* macro to 'unsign' a character */
+#define uchar(c) ((unsigned char)(c))
+
+
+/*
+** Some sizes are better limited to fit in 'int', but must also fit in
+** 'size_t'. (We assume that 'lua_Integer' cannot be smaller than 'int'.)
+*/
+#define MAX_SIZET ((size_t)(~(size_t)0))
+
+#define MAXSIZE \
+ (sizeof(size_t) < sizeof(int) ? MAX_SIZET : (size_t)(INT_MAX))
+
+
+
+
+static int str_len (lua_State *L) {
+ size_t l;
+ luaL_checklstring(L, 1, &l);
+ lua_pushinteger(L, (lua_Integer)l);
+ return 1;
+}
+
+
+/*
+** translate a relative initial string position
+** (negative means back from end): clip result to [1, inf).
+** The length of any string in Lua must fit in a lua_Integer,
+** so there are no overflows in the casts.
+** The inverted comparison avoids a possible overflow
+** computing '-pos'.
+*/
+static size_t posrelatI (lua_Integer pos, size_t len) {
+ if (pos > 0)
+ return (size_t)pos;
+ else if (pos == 0)
+ return 1;
+ else if (pos < -(lua_Integer)len) /* inverted comparison */
+ return 1; /* clip to 1 */
+ else return len + (size_t)pos + 1;
+}
+
+
+/*
+** Gets an optional ending string position from argument 'arg',
+** with default value 'def'.
+** Negative means back from end: clip result to [0, len]
+*/
+static size_t getendpos (lua_State *L, int arg, lua_Integer def,
+ size_t len) {
+ lua_Integer pos = luaL_optinteger(L, arg, def);
+ if (pos > (lua_Integer)len)
+ return len;
+ else if (pos >= 0)
+ return (size_t)pos;
+ else if (pos < -(lua_Integer)len)
+ return 0;
+ else return len + (size_t)pos + 1;
+}
+
+
+static int str_sub (lua_State *L) {
+ size_t l;
+ const char *s = luaL_checklstring(L, 1, &l);
+ size_t start = posrelatI(luaL_checkinteger(L, 2), l);
+ size_t end = getendpos(L, 3, -1, l);
+ if (start <= end)
+ lua_pushlstring(L, s + start - 1, (end - start) + 1);
+ else lua_pushliteral(L, "");
+ return 1;
+}
+
+
+static int str_reverse (lua_State *L) {
+ size_t l, i;
+ luaL_Buffer b;
+ const char *s = luaL_checklstring(L, 1, &l);
+ char *p = luaL_buffinitsize(L, &b, l);
+ for (i = 0; i < l; i++)
+ p[i] = s[l - i - 1];
+ luaL_pushresultsize(&b, l);
+ return 1;
+}
+
+
+static int str_lower (lua_State *L) {
+ size_t l;
+ size_t i;
+ luaL_Buffer b;
+ const char *s = luaL_checklstring(L, 1, &l);
+ char *p = luaL_buffinitsize(L, &b, l);
+ for (i=0; i<l; i++)
+ p[i] = tolower(uchar(s[i]));
+ luaL_pushresultsize(&b, l);
+ return 1;
+}
+
+
+static int str_upper (lua_State *L) {
+ size_t l;
+ size_t i;
+ luaL_Buffer b;
+ const char *s = luaL_checklstring(L, 1, &l);
+ char *p = luaL_buffinitsize(L, &b, l);
+ for (i=0; i<l; i++)
+ p[i] = toupper(uchar(s[i]));
+ luaL_pushresultsize(&b, l);
+ return 1;
+}
+
+
+static int str_rep (lua_State *L) {
+ size_t l, lsep;
+ const char *s = luaL_checklstring(L, 1, &l);
+ lua_Integer n = luaL_checkinteger(L, 2);
+ const char *sep = luaL_optlstring(L, 3, "", &lsep);
+ if (n <= 0)
+ lua_pushliteral(L, "");
+ else if (l_unlikely(l + lsep < l || l + lsep > MAXSIZE / n))
+ return luaL_error(L, "resulting string too large");
+ else {
+ size_t totallen = (size_t)n * l + (size_t)(n - 1) * lsep;
+ luaL_Buffer b;
+ char *p = luaL_buffinitsize(L, &b, totallen);
+ while (n-- > 1) { /* first n-1 copies (followed by separator) */
+ memcpy(p, s, l * sizeof(char)); p += l;
+ if (lsep > 0) { /* empty 'memcpy' is not that cheap */
+ memcpy(p, sep, lsep * sizeof(char));
+ p += lsep;
+ }
+ }
+ memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */
+ luaL_pushresultsize(&b, totallen);
+ }
+ return 1;
+}
+
+
+static int str_byte (lua_State *L) {
+ size_t l;
+ const char *s = luaL_checklstring(L, 1, &l);
+ lua_Integer pi = luaL_optinteger(L, 2, 1);
+ size_t posi = posrelatI(pi, l);
+ size_t pose = getendpos(L, 3, pi, l);
+ int n, i;
+ if (posi > pose) return 0; /* empty interval; return no values */
+ if (l_unlikely(pose - posi >= (size_t)INT_MAX)) /* arithmetic overflow? */
+ return luaL_error(L, "string slice too long");
+ n = (int)(pose - posi) + 1;
+ luaL_checkstack(L, n, "string slice too long");
+ for (i=0; i<n; i++)
+ lua_pushinteger(L, uchar(s[posi+i-1]));
+ return n;
+}
+
+
+static int str_char (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int i;
+ luaL_Buffer b;
+ char *p = luaL_buffinitsize(L, &b, n);
+ for (i=1; i<=n; i++) {
+ lua_Unsigned c = (lua_Unsigned)luaL_checkinteger(L, i);
+ luaL_argcheck(L, c <= (lua_Unsigned)UCHAR_MAX, i, "value out of range");
+ p[i - 1] = uchar(c);
+ }
+ luaL_pushresultsize(&b, n);
+ return 1;
+}
+
+
+/*
+** Buffer to store the result of 'string.dump'. It must be initialized
+** after the call to 'lua_dump', to ensure that the function is on the
+** top of the stack when 'lua_dump' is called. ('luaL_buffinit' might
+** push stuff.)
+*/
+struct str_Writer {
+ int init; /* true iff buffer has been initialized */
+ luaL_Buffer B;
+};
+
+
+static int writer (lua_State *L, const void *b, size_t size, void *ud) {
+ struct str_Writer *state = (struct str_Writer *)ud;
+ if (!state->init) {
+ state->init = 1;
+ luaL_buffinit(L, &state->B);
+ }
+ luaL_addlstring(&state->B, (const char *)b, size);
+ return 0;
+}
+
+
+static int str_dump (lua_State *L) {
+ struct str_Writer state;
+ int strip = lua_toboolean(L, 2);
+ luaL_checktype(L, 1, LUA_TFUNCTION);
+ lua_settop(L, 1); /* ensure function is on the top of the stack */
+ state.init = 0;
+ if (l_unlikely(lua_dump(L, writer, &state, strip) != 0))
+ return luaL_error(L, "unable to dump given function");
+ luaL_pushresult(&state.B);
+ return 1;
+}
+
+
+
+/*
+** {======================================================
+** METAMETHODS
+** =======================================================
+*/
+
+#if defined(LUA_NOCVTS2N) /* { */
+
+/* no coercion from strings to numbers */
+
+static const luaL_Reg stringmetamethods[] = {
+ {"__index", NULL}, /* placeholder */
+ {NULL, NULL}
+};
+
+#else /* }{ */
+
+static int tonum (lua_State *L, int arg) {
+ if (lua_type(L, arg) == LUA_TNUMBER) { /* already a number? */
+ lua_pushvalue(L, arg);
+ return 1;
+ }
+ else { /* check whether it is a numerical string */
+ size_t len;
+ const char *s = lua_tolstring(L, arg, &len);
+ return (s != NULL && lua_stringtonumber(L, s) == len + 1);
+ }
+}
+
+
+static void trymt (lua_State *L, const char *mtname) {
+ lua_settop(L, 2); /* back to the original arguments */
+ if (l_unlikely(lua_type(L, 2) == LUA_TSTRING ||
+ !luaL_getmetafield(L, 2, mtname)))
+ luaL_error(L, "attempt to %s a '%s' with a '%s'", mtname + 2,
+ luaL_typename(L, -2), luaL_typename(L, -1));
+ lua_insert(L, -3); /* put metamethod before arguments */
+ lua_call(L, 2, 1); /* call metamethod */
+}
+
+
+static int arith (lua_State *L, int op, const char *mtname) {
+ if (tonum(L, 1) && tonum(L, 2))
+ lua_arith(L, op); /* result will be on the top */
+ else
+ trymt(L, mtname);
+ return 1;
+}
+
+
+static int arith_add (lua_State *L) {
+ return arith(L, LUA_OPADD, "__add");
+}
+
+static int arith_sub (lua_State *L) {
+ return arith(L, LUA_OPSUB, "__sub");
+}
+
+static int arith_mul (lua_State *L) {
+ return arith(L, LUA_OPMUL, "__mul");
+}
+
+static int arith_mod (lua_State *L) {
+ return arith(L, LUA_OPMOD, "__mod");
+}
+
+static int arith_pow (lua_State *L) {
+ return arith(L, LUA_OPPOW, "__pow");
+}
+
+static int arith_div (lua_State *L) {
+ return arith(L, LUA_OPDIV, "__div");
+}
+
+static int arith_idiv (lua_State *L) {
+ return arith(L, LUA_OPIDIV, "__idiv");
+}
+
+static int arith_unm (lua_State *L) {
+ return arith(L, LUA_OPUNM, "__unm");
+}
+
+
+static const luaL_Reg stringmetamethods[] = {
+ {"__add", arith_add},
+ {"__sub", arith_sub},
+ {"__mul", arith_mul},
+ {"__mod", arith_mod},
+ {"__pow", arith_pow},
+ {"__div", arith_div},
+ {"__idiv", arith_idiv},
+ {"__unm", arith_unm},
+ {"__index", NULL}, /* placeholder */
+ {NULL, NULL}
+};
+
+#endif /* } */
+
+/* }====================================================== */
+
+/*
+** {======================================================
+** PATTERN MATCHING
+** =======================================================
+*/
+
+
+#define CAP_UNFINISHED (-1)
+#define CAP_POSITION (-2)
+
+
+typedef struct MatchState {
+ const char *src_init; /* init of source string */
+ const char *src_end; /* end ('\0') of source string */
+ const char *p_end; /* end ('\0') of pattern */
+ lua_State *L;
+ int matchdepth; /* control for recursive depth (to avoid C stack overflow) */
+ unsigned char level; /* total number of captures (finished or unfinished) */
+ struct {
+ const char *init;
+ ptrdiff_t len;
+ } capture[LUA_MAXCAPTURES];
+} MatchState;
+
+
+/* recursive function */
+static const char *match (MatchState *ms, const char *s, const char *p);
+
+
+/* maximum recursion depth for 'match' */
+#if !defined(MAXCCALLS)
+#define MAXCCALLS 200
+#endif
+
+
+#define L_ESC '%'
+#define SPECIALS "^$*+?.([%-"
+
+
+static int check_capture (MatchState *ms, int l) {
+ l -= '1';
+ if (l_unlikely(l < 0 || l >= ms->level ||
+ ms->capture[l].len == CAP_UNFINISHED))
+ return luaL_error(ms->L, "invalid capture index %%%d", l + 1);
+ return l;
+}
+
+
+static int capture_to_close (MatchState *ms) {
+ int level = ms->level;
+ for (level--; level>=0; level--)
+ if (ms->capture[level].len == CAP_UNFINISHED) return level;
+ return luaL_error(ms->L, "invalid pattern capture");
+}
+
+
+static const char *classend (MatchState *ms, const char *p) {
+ switch (*p++) {
+ case L_ESC: {
+ if (l_unlikely(p == ms->p_end))
+ luaL_error(ms->L, "malformed pattern (ends with '%%')");
+ return p+1;
+ }
+ case '[': {
+ if (*p == '^') p++;
+ do { /* look for a ']' */
+ if (l_unlikely(p == ms->p_end))
+ luaL_error(ms->L, "malformed pattern (missing ']')");
+ if (*(p++) == L_ESC && p < ms->p_end)
+ p++; /* skip escapes (e.g. '%]') */
+ } while (*p != ']');
+ return p+1;
+ }
+ default: {
+ return p;
+ }
+ }
+}
+
+
+static int match_class (int c, int cl) {
+ int res;
+ switch (tolower(cl)) {
+ case 'a' : res = isalpha(c); break;
+ case 'c' : res = iscntrl(c); break;
+ case 'd' : res = isdigit(c); break;
+ case 'g' : res = isgraph(c); break;
+ case 'l' : res = islower(c); break;
+ case 'p' : res = ispunct(c); break;
+ case 's' : res = isspace(c); break;
+ case 'u' : res = isupper(c); break;
+ case 'w' : res = isalnum(c); break;
+ case 'x' : res = isxdigit(c); break;
+ case 'z' : res = (c == 0); break; /* deprecated option */
+ default: return (cl == c);
+ }
+ return (islower(cl) ? res : !res);
+}
+
+
+static int matchbracketclass (int c, const char *p, const char *ec) {
+ int sig = 1;
+ if (*(p+1) == '^') {
+ sig = 0;
+ p++; /* skip the '^' */
+ }
+ while (++p < ec) {
+ if (*p == L_ESC) {
+ p++;
+ if (match_class(c, uchar(*p)))
+ return sig;
+ }
+ else if ((*(p+1) == '-') && (p+2 < ec)) {
+ p+=2;
+ if (uchar(*(p-2)) <= c && c <= uchar(*p))
+ return sig;
+ }
+ else if (uchar(*p) == c) return sig;
+ }
+ return !sig;
+}
+
+
+static int singlematch (MatchState *ms, const char *s, const char *p,
+ const char *ep) {
+ if (s >= ms->src_end)
+ return 0;
+ else {
+ int c = uchar(*s);
+ switch (*p) {
+ case '.': return 1; /* matches any char */
+ case L_ESC: return match_class(c, uchar(*(p+1)));
+ case '[': return matchbracketclass(c, p, ep-1);
+ default: return (uchar(*p) == c);
+ }
+ }
+}
+
+
+static const char *matchbalance (MatchState *ms, const char *s,
+ const char *p) {
+ if (l_unlikely(p >= ms->p_end - 1))
+ luaL_error(ms->L, "malformed pattern (missing arguments to '%%b')");
+ if (*s != *p) return NULL;
+ else {
+ int b = *p;
+ int e = *(p+1);
+ int cont = 1;
+ while (++s < ms->src_end) {
+ if (*s == e) {
+ if (--cont == 0) return s+1;
+ }
+ else if (*s == b) cont++;
+ }
+ }
+ return NULL; /* string ends out of balance */
+}
+
+
+static const char *max_expand (MatchState *ms, const char *s,
+ const char *p, const char *ep) {
+ ptrdiff_t i = 0; /* counts maximum expand for item */
+ while (singlematch(ms, s + i, p, ep))
+ i++;
+ /* keeps trying to match with the maximum repetitions */
+ while (i>=0) {
+ const char *res = match(ms, (s+i), ep+1);
+ if (res) return res;
+ i--; /* else didn't match; reduce 1 repetition to try again */
+ }
+ return NULL;
+}
+
+
+static const char *min_expand (MatchState *ms, const char *s,
+ const char *p, const char *ep) {
+ for (;;) {
+ const char *res = match(ms, s, ep+1);
+ if (res != NULL)
+ return res;
+ else if (singlematch(ms, s, p, ep))
+ s++; /* try with one more repetition */
+ else return NULL;
+ }
+}
+
+
+static const char *start_capture (MatchState *ms, const char *s,
+ const char *p, int what) {
+ const char *res;
+ int level = ms->level;
+ if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures");
+ ms->capture[level].init = s;
+ ms->capture[level].len = what;
+ ms->level = level+1;
+ if ((res=match(ms, s, p)) == NULL) /* match failed? */
+ ms->level--; /* undo capture */
+ return res;
+}
+
+
+static const char *end_capture (MatchState *ms, const char *s,
+ const char *p) {
+ int l = capture_to_close(ms);
+ const char *res;
+ ms->capture[l].len = s - ms->capture[l].init; /* close capture */
+ if ((res = match(ms, s, p)) == NULL) /* match failed? */
+ ms->capture[l].len = CAP_UNFINISHED; /* undo capture */
+ return res;
+}
+
+
+static const char *match_capture (MatchState *ms, const char *s, int l) {
+ size_t len;
+ l = check_capture(ms, l);
+ len = ms->capture[l].len;
+ if ((size_t)(ms->src_end-s) >= len &&
+ memcmp(ms->capture[l].init, s, len) == 0)
+ return s+len;
+ else return NULL;
+}
+
+
+static const char *match (MatchState *ms, const char *s, const char *p) {
+ if (l_unlikely(ms->matchdepth-- == 0))
+ luaL_error(ms->L, "pattern too complex");
+ init: /* using goto's to optimize tail recursion */
+ if (p != ms->p_end) { /* end of pattern? */
+ switch (*p) {
+ case '(': { /* start capture */
+ if (*(p + 1) == ')') /* position capture? */
+ s = start_capture(ms, s, p + 2, CAP_POSITION);
+ else
+ s = start_capture(ms, s, p + 1, CAP_UNFINISHED);
+ break;
+ }
+ case ')': { /* end capture */
+ s = end_capture(ms, s, p + 1);
+ break;
+ }
+ case '$': {
+ if ((p + 1) != ms->p_end) /* is the '$' the last char in pattern? */
+ goto dflt; /* no; go to default */
+ s = (s == ms->src_end) ? s : NULL; /* check end of string */
+ break;
+ }
+ case L_ESC: { /* escaped sequences not in the format class[*+?-]? */
+ switch (*(p + 1)) {
+ case 'b': { /* balanced string? */
+ s = matchbalance(ms, s, p + 2);
+ if (s != NULL) {
+ p += 4; goto init; /* return match(ms, s, p + 4); */
+ } /* else fail (s == NULL) */
+ break;
+ }
+ case 'f': { /* frontier? */
+ const char *ep; char previous;
+ p += 2;
+ if (l_unlikely(*p != '['))
+ luaL_error(ms->L, "missing '[' after '%%f' in pattern");
+ ep = classend(ms, p); /* points to what is next */
+ previous = (s == ms->src_init) ? '\0' : *(s - 1);
+ if (!matchbracketclass(uchar(previous), p, ep - 1) &&
+ matchbracketclass(uchar(*s), p, ep - 1)) {
+ p = ep; goto init; /* return match(ms, s, ep); */
+ }
+ s = NULL; /* match failed */
+ break;
+ }
+ case '0': case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ case '8': case '9': { /* capture results (%0-%9)? */
+ s = match_capture(ms, s, uchar(*(p + 1)));
+ if (s != NULL) {
+ p += 2; goto init; /* return match(ms, s, p + 2) */
+ }
+ break;
+ }
+ default: goto dflt;
+ }
+ break;
+ }
+ default: dflt: { /* pattern class plus optional suffix */
+ const char *ep = classend(ms, p); /* points to optional suffix */
+ /* does not match at least once? */
+ if (!singlematch(ms, s, p, ep)) {
+ if (*ep == '*' || *ep == '?' || *ep == '-') { /* accept empty? */
+ p = ep + 1; goto init; /* return match(ms, s, ep + 1); */
+ }
+ else /* '+' or no suffix */
+ s = NULL; /* fail */
+ }
+ else { /* matched once */
+ switch (*ep) { /* handle optional suffix */
+ case '?': { /* optional */
+ const char *res;
+ if ((res = match(ms, s + 1, ep + 1)) != NULL)
+ s = res;
+ else {
+ p = ep + 1; goto init; /* else return match(ms, s, ep + 1); */
+ }
+ break;
+ }
+ case '+': /* 1 or more repetitions */
+ s++; /* 1 match already done */
+ /* FALLTHROUGH */
+ case '*': /* 0 or more repetitions */
+ s = max_expand(ms, s, p, ep);
+ break;
+ case '-': /* 0 or more repetitions (minimum) */
+ s = min_expand(ms, s, p, ep);
+ break;
+ default: /* no suffix */
+ s++; p = ep; goto init; /* return match(ms, s + 1, ep); */
+ }
+ }
+ break;
+ }
+ }
+ }
+ ms->matchdepth++;
+ return s;
+}
+
+
+
+static const char *lmemfind (const char *s1, size_t l1,
+ const char *s2, size_t l2) {
+ if (l2 == 0) return s1; /* empty strings are everywhere */
+ else if (l2 > l1) return NULL; /* avoids a negative 'l1' */
+ else {
+ const char *init; /* to search for a '*s2' inside 's1' */
+ l2--; /* 1st char will be checked by 'memchr' */
+ l1 = l1-l2; /* 's2' cannot be found after that */
+ while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {
+ init++; /* 1st char is already checked */
+ if (memcmp(init, s2+1, l2) == 0)
+ return init-1;
+ else { /* correct 'l1' and 's1' to try again */
+ l1 -= init-s1;
+ s1 = init;
+ }
+ }
+ return NULL; /* not found */
+ }
+}
+
+
+/*
+** get information about the i-th capture. If there are no captures
+** and 'i==0', return information about the whole match, which
+** is the range 's'..'e'. If the capture is a string, return
+** its length and put its address in '*cap'. If it is an integer
+** (a position), push it on the stack and return CAP_POSITION.
+*/
+static size_t get_onecapture (MatchState *ms, int i, const char *s,
+ const char *e, const char **cap) {
+ if (i >= ms->level) {
+ if (l_unlikely(i != 0))
+ luaL_error(ms->L, "invalid capture index %%%d", i + 1);
+ *cap = s;
+ return e - s;
+ }
+ else {
+ ptrdiff_t capl = ms->capture[i].len;
+ *cap = ms->capture[i].init;
+ if (l_unlikely(capl == CAP_UNFINISHED))
+ luaL_error(ms->L, "unfinished capture");
+ else if (capl == CAP_POSITION)
+ lua_pushinteger(ms->L, (ms->capture[i].init - ms->src_init) + 1);
+ return capl;
+ }
+}
+
+
+/*
+** Push the i-th capture on the stack.
+*/
+static void push_onecapture (MatchState *ms, int i, const char *s,
+ const char *e) {
+ const char *cap;
+ ptrdiff_t l = get_onecapture(ms, i, s, e, &cap);
+ if (l != CAP_POSITION)
+ lua_pushlstring(ms->L, cap, l);
+ /* else position was already pushed */
+}
+
+
+static int push_captures (MatchState *ms, const char *s, const char *e) {
+ int i;
+ int nlevels = (ms->level == 0 && s) ? 1 : ms->level;
+ luaL_checkstack(ms->L, nlevels, "too many captures");
+ for (i = 0; i < nlevels; i++)
+ push_onecapture(ms, i, s, e);
+ return nlevels; /* number of strings pushed */
+}
+
+
+/* check whether pattern has no special characters */
+static int nospecials (const char *p, size_t l) {
+ size_t upto = 0;
+ do {
+ if (strpbrk(p + upto, SPECIALS))
+ return 0; /* pattern has a special character */
+ upto += strlen(p + upto) + 1; /* may have more after \0 */
+ } while (upto <= l);
+ return 1; /* no special chars found */
+}
+
+
+static void prepstate (MatchState *ms, lua_State *L,
+ const char *s, size_t ls, const char *p, size_t lp) {
+ ms->L = L;
+ ms->matchdepth = MAXCCALLS;
+ ms->src_init = s;
+ ms->src_end = s + ls;
+ ms->p_end = p + lp;
+}
+
+
+static void reprepstate (MatchState *ms) {
+ ms->level = 0;
+ lua_assert(ms->matchdepth == MAXCCALLS);
+}
+
+
+static int str_find_aux (lua_State *L, int find) {
+ size_t ls, lp;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ const char *p = luaL_checklstring(L, 2, &lp);
+ size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
+ if (init > ls) { /* start after string's end? */
+ luaL_pushfail(L); /* cannot find anything */
+ return 1;
+ }
+ /* explicit request or no special characters? */
+ if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) {
+ /* do a plain search */
+ const char *s2 = lmemfind(s + init, ls - init, p, lp);
+ if (s2) {
+ lua_pushinteger(L, (s2 - s) + 1);
+ lua_pushinteger(L, (s2 - s) + lp);
+ return 2;
+ }
+ }
+ else {
+ MatchState ms;
+ const char *s1 = s + init;
+ int anchor = (*p == '^');
+ if (anchor) {
+ p++; lp--; /* skip anchor character */
+ }
+ prepstate(&ms, L, s, ls, p, lp);
+ do {
+ const char *res;
+ reprepstate(&ms);
+ if ((res=match(&ms, s1, p)) != NULL) {
+ if (find) {
+ lua_pushinteger(L, (s1 - s) + 1); /* start */
+ lua_pushinteger(L, res - s); /* end */
+ return push_captures(&ms, NULL, 0) + 2;
+ }
+ else
+ return push_captures(&ms, s1, res);
+ }
+ } while (s1++ < ms.src_end && !anchor);
+ }
+ luaL_pushfail(L); /* not found */
+ return 1;
+}
+
+
+static int str_find (lua_State *L) {
+ return str_find_aux(L, 1);
+}
+
+
+static int str_match (lua_State *L) {
+ return str_find_aux(L, 0);
+}
+
+
+/* state for 'gmatch' */
+typedef struct GMatchState {
+ const char *src; /* current position */
+ const char *p; /* pattern */
+ const char *lastmatch; /* end of last match */
+ MatchState ms; /* match state */
+} GMatchState;
+
+
+static int gmatch_aux (lua_State *L) {
+ GMatchState *gm = (GMatchState *)lua_touserdata(L, lua_upvalueindex(3));
+ const char *src;
+ gm->ms.L = L;
+ for (src = gm->src; src <= gm->ms.src_end; src++) {
+ const char *e;
+ reprepstate(&gm->ms);
+ if ((e = match(&gm->ms, src, gm->p)) != NULL && e != gm->lastmatch) {
+ gm->src = gm->lastmatch = e;
+ return push_captures(&gm->ms, src, e);
+ }
+ }
+ return 0; /* not found */
+}
+
+
+static int gmatch (lua_State *L) {
+ size_t ls, lp;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ const char *p = luaL_checklstring(L, 2, &lp);
+ size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
+ GMatchState *gm;
+ lua_settop(L, 2); /* keep strings on closure to avoid being collected */
+ gm = (GMatchState *)lua_newuserdatauv(L, sizeof(GMatchState), 0);
+ if (init > ls) /* start after string's end? */
+ init = ls + 1; /* avoid overflows in 's + init' */
+ prepstate(&gm->ms, L, s, ls, p, lp);
+ gm->src = s + init; gm->p = p; gm->lastmatch = NULL;
+ lua_pushcclosure(L, gmatch_aux, 3);
+ return 1;
+}
+
+
+static void add_s (MatchState *ms, luaL_Buffer *b, const char *s,
+ const char *e) {
+ size_t l;
+ lua_State *L = ms->L;
+ const char *news = lua_tolstring(L, 3, &l);
+ const char *p;
+ while ((p = (char *)memchr(news, L_ESC, l)) != NULL) {
+ luaL_addlstring(b, news, p - news);
+ p++; /* skip ESC */
+ if (*p == L_ESC) /* '%%' */
+ luaL_addchar(b, *p);
+ else if (*p == '0') /* '%0' */
+ luaL_addlstring(b, s, e - s);
+ else if (isdigit(uchar(*p))) { /* '%n' */
+ const char *cap;
+ ptrdiff_t resl = get_onecapture(ms, *p - '1', s, e, &cap);
+ if (resl == CAP_POSITION)
+ luaL_addvalue(b); /* add position to accumulated result */
+ else
+ luaL_addlstring(b, cap, resl);
+ }
+ else
+ luaL_error(L, "invalid use of '%c' in replacement string", L_ESC);
+ l -= p + 1 - news;
+ news = p + 1;
+ }
+ luaL_addlstring(b, news, l);
+}
+
+
+/*
+** Add the replacement value to the string buffer 'b'.
+** Return true if the original string was changed. (Function calls and
+** table indexing resulting in nil or false do not change the subject.)
+*/
+static int add_value (MatchState *ms, luaL_Buffer *b, const char *s,
+ const char *e, int tr) {
+ lua_State *L = ms->L;
+ switch (tr) {
+ case LUA_TFUNCTION: { /* call the function */
+ int n;
+ lua_pushvalue(L, 3); /* push the function */
+ n = push_captures(ms, s, e); /* all captures as arguments */
+ lua_call(L, n, 1); /* call it */
+ break;
+ }
+ case LUA_TTABLE: { /* index the table */
+ push_onecapture(ms, 0, s, e); /* first capture is the index */
+ lua_gettable(L, 3);
+ break;
+ }
+ default: { /* LUA_TNUMBER or LUA_TSTRING */
+ add_s(ms, b, s, e); /* add value to the buffer */
+ return 1; /* something changed */
+ }
+ }
+ if (!lua_toboolean(L, -1)) { /* nil or false? */
+ lua_pop(L, 1); /* remove value */
+ luaL_addlstring(b, s, e - s); /* keep original text */
+ return 0; /* no changes */
+ }
+ else if (l_unlikely(!lua_isstring(L, -1)))
+ return luaL_error(L, "invalid replacement value (a %s)",
+ luaL_typename(L, -1));
+ else {
+ luaL_addvalue(b); /* add result to accumulator */
+ return 1; /* something changed */
+ }
+}
+
+
+static int str_gsub (lua_State *L) {
+ size_t srcl, lp;
+ const char *src = luaL_checklstring(L, 1, &srcl); /* subject */
+ const char *p = luaL_checklstring(L, 2, &lp); /* pattern */
+ const char *lastmatch = NULL; /* end of last match */
+ int tr = lua_type(L, 3); /* replacement type */
+ lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); /* max replacements */
+ int anchor = (*p == '^');
+ lua_Integer n = 0; /* replacement count */
+ int changed = 0; /* change flag */
+ MatchState ms;
+ luaL_Buffer b;
+ luaL_argexpected(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||
+ tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3,
+ "string/function/table");
+ luaL_buffinit(L, &b);
+ if (anchor) {
+ p++; lp--; /* skip anchor character */
+ }
+ prepstate(&ms, L, src, srcl, p, lp);
+ while (n < max_s) {
+ const char *e;
+ reprepstate(&ms); /* (re)prepare state for new match */
+ if ((e = match(&ms, src, p)) != NULL && e != lastmatch) { /* match? */
+ n++;
+ changed = add_value(&ms, &b, src, e, tr) | changed;
+ src = lastmatch = e;
+ }
+ else if (src < ms.src_end) /* otherwise, skip one character */
+ luaL_addchar(&b, *src++);
+ else break; /* end of subject */
+ if (anchor) break;
+ }
+ if (!changed) /* no changes? */
+ lua_pushvalue(L, 1); /* return original string */
+ else { /* something changed */
+ luaL_addlstring(&b, src, ms.src_end-src);
+ luaL_pushresult(&b); /* create and return new string */
+ }
+ lua_pushinteger(L, n); /* number of substitutions */
+ return 2;
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** STRING FORMAT
+** =======================================================
+*/
+
+#if !defined(lua_number2strx) /* { */
+
+/*
+** Hexadecimal floating-point formatter
+*/
+
+#define SIZELENMOD (sizeof(LUA_NUMBER_FRMLEN)/sizeof(char))
+
+
+/*
+** Number of bits that goes into the first digit. It can be any value
+** between 1 and 4; the following definition tries to align the number
+** to nibble boundaries by making what is left after that first digit a
+** multiple of 4.
+*/
+#define L_NBFD ((l_floatatt(MANT_DIG) - 1)%4 + 1)
+
+
+/*
+** Add integer part of 'x' to buffer and return new 'x'
+*/
+static lua_Number adddigit (char *buff, int n, lua_Number x) {
+ lua_Number dd = l_mathop(floor)(x); /* get integer part from 'x' */
+ int d = (int)dd;
+ buff[n] = (d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */
+ return x - dd; /* return what is left */
+}
+
+
+static int num2straux (char *buff, int sz, lua_Number x) {
+ /* if 'inf' or 'NaN', format it like '%g' */
+ if (x != x || x == (lua_Number)HUGE_VAL || x == -(lua_Number)HUGE_VAL)
+ return l_sprintf(buff, sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)x);
+ else if (x == 0) { /* can be -0... */
+ /* create "0" or "-0" followed by exponent */
+ return l_sprintf(buff, sz, LUA_NUMBER_FMT "x0p+0", (LUAI_UACNUMBER)x);
+ }
+ else {
+ int e;
+ lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */
+ int n = 0; /* character count */
+ if (m < 0) { /* is number negative? */
+ buff[n++] = '-'; /* add sign */
+ m = -m; /* make it positive */
+ }
+ buff[n++] = '0'; buff[n++] = 'x'; /* add "0x" */
+ m = adddigit(buff, n++, m * (1 << L_NBFD)); /* add first digit */
+ e -= L_NBFD; /* this digit goes before the radix point */
+ if (m > 0) { /* more digits? */
+ buff[n++] = lua_getlocaledecpoint(); /* add radix point */
+ do { /* add as many digits as needed */
+ m = adddigit(buff, n++, m * 16);
+ } while (m > 0);
+ }
+ n += l_sprintf(buff + n, sz - n, "p%+d", e); /* add exponent */
+ lua_assert(n < sz);
+ return n;
+ }
+}
+
+
+static int lua_number2strx (lua_State *L, char *buff, int sz,
+ const char *fmt, lua_Number x) {
+ int n = num2straux(buff, sz, x);
+ if (fmt[SIZELENMOD] == 'A') {
+ int i;
+ for (i = 0; i < n; i++)
+ buff[i] = toupper(uchar(buff[i]));
+ }
+ else if (l_unlikely(fmt[SIZELENMOD] != 'a'))
+ return luaL_error(L, "modifiers for format '%%a'/'%%A' not implemented");
+ return n;
+}
+
+#endif /* } */
+
+
+/*
+** Maximum size for items formatted with '%f'. This size is produced
+** by format('%.99f', -maxfloat), and is equal to 99 + 3 ('-', '.',
+** and '\0') + number of decimal digits to represent maxfloat (which
+** is maximum exponent + 1). (99+3+1, adding some extra, 110)
+*/
+#define MAX_ITEMF (110 + l_floatatt(MAX_10_EXP))
+
+
+/*
+** All formats except '%f' do not need that large limit. The other
+** float formats use exponents, so that they fit in the 99 limit for
+** significant digits; 's' for large strings and 'q' add items directly
+** to the buffer; all integer formats also fit in the 99 limit. The
+** worst case are floats: they may need 99 significant digits, plus
+** '0x', '-', '.', 'e+XXXX', and '\0'. Adding some extra, 120.
+*/
+#define MAX_ITEM 120
+
+
+/* valid flags in a format specification */
+#if !defined(L_FMTFLAGSF)
+
+/* valid flags for a, A, e, E, f, F, g, and G conversions */
+#define L_FMTFLAGSF "-+#0 "
+
+/* valid flags for o, x, and X conversions */
+#define L_FMTFLAGSX "-#0"
+
+/* valid flags for d and i conversions */
+#define L_FMTFLAGSI "-+0 "
+
+/* valid flags for u conversions */
+#define L_FMTFLAGSU "-0"
+
+/* valid flags for c, p, and s conversions */
+#define L_FMTFLAGSC "-"
+
+#endif
+
+
+/*
+** Maximum size of each format specification (such as "%-099.99d"):
+** Initial '%', flags (up to 5), width (2), period, precision (2),
+** length modifier (8), conversion specifier, and final '\0', plus some
+** extra.
+*/
+#define MAX_FORMAT 32
+
+
+static void addquoted (luaL_Buffer *b, const char *s, size_t len) {
+ luaL_addchar(b, '"');
+ while (len--) {
+ if (*s == '"' || *s == '\\' || *s == '\n') {
+ luaL_addchar(b, '\\');
+ luaL_addchar(b, *s);
+ }
+ else if (iscntrl(uchar(*s))) {
+ char buff[10];
+ if (!isdigit(uchar(*(s+1))))
+ l_sprintf(buff, sizeof(buff), "\\%d", (int)uchar(*s));
+ else
+ l_sprintf(buff, sizeof(buff), "\\%03d", (int)uchar(*s));
+ luaL_addstring(b, buff);
+ }
+ else
+ luaL_addchar(b, *s);
+ s++;
+ }
+ luaL_addchar(b, '"');
+}
+
+
+/*
+** Serialize a floating-point number in such a way that it can be
+** scanned back by Lua. Use hexadecimal format for "common" numbers
+** (to preserve precision); inf, -inf, and NaN are handled separately.
+** (NaN cannot be expressed as a numeral, so we write '(0/0)' for it.)
+*/
+static int quotefloat (lua_State *L, char *buff, lua_Number n) {
+ const char *s; /* for the fixed representations */
+ if (n == (lua_Number)HUGE_VAL) /* inf? */
+ s = "1e9999";
+ else if (n == -(lua_Number)HUGE_VAL) /* -inf? */
+ s = "-1e9999";
+ else if (n != n) /* NaN? */
+ s = "(0/0)";
+ else { /* format number as hexadecimal */
+ int nb = lua_number2strx(L, buff, MAX_ITEM,
+ "%" LUA_NUMBER_FRMLEN "a", n);
+ /* ensures that 'buff' string uses a dot as the radix character */
+ if (memchr(buff, '.', nb) == NULL) { /* no dot? */
+ char point = lua_getlocaledecpoint(); /* try locale point */
+ char *ppoint = (char *)memchr(buff, point, nb);
+ if (ppoint) *ppoint = '.'; /* change it to a dot */
+ }
+ return nb;
+ }
+ /* for the fixed representations */
+ return l_sprintf(buff, MAX_ITEM, "%s", s);
+}
+
+
+static void addliteral (lua_State *L, luaL_Buffer *b, int arg) {
+ switch (lua_type(L, arg)) {
+ case LUA_TSTRING: {
+ size_t len;
+ const char *s = lua_tolstring(L, arg, &len);
+ addquoted(b, s, len);
+ break;
+ }
+ case LUA_TNUMBER: {
+ char *buff = luaL_prepbuffsize(b, MAX_ITEM);
+ int nb;
+ if (!lua_isinteger(L, arg)) /* float? */
+ nb = quotefloat(L, buff, lua_tonumber(L, arg));
+ else { /* integers */
+ lua_Integer n = lua_tointeger(L, arg);
+ const char *format = (n == LUA_MININTEGER) /* corner case? */
+ ? "0x%" LUA_INTEGER_FRMLEN "x" /* use hex */
+ : LUA_INTEGER_FMT; /* else use default format */
+ nb = l_sprintf(buff, MAX_ITEM, format, (LUAI_UACINT)n);
+ }
+ luaL_addsize(b, nb);
+ break;
+ }
+ case LUA_TNIL: case LUA_TBOOLEAN: {
+ luaL_tolstring(L, arg, NULL);
+ luaL_addvalue(b);
+ break;
+ }
+ default: {
+ luaL_argerror(L, arg, "value has no literal form");
+ }
+ }
+}
+
+
+static const char *get2digits (const char *s) {
+ if (isdigit(uchar(*s))) {
+ s++;
+ if (isdigit(uchar(*s))) s++; /* (2 digits at most) */
+ }
+ return s;
+}
+
+
+/*
+** Check whether a conversion specification is valid. When called,
+** first character in 'form' must be '%' and last character must
+** be a valid conversion specifier. 'flags' are the accepted flags;
+** 'precision' signals whether to accept a precision.
+*/
+static void checkformat (lua_State *L, const char *form, const char *flags,
+ int precision) {
+ const char *spec = form + 1; /* skip '%' */
+ spec += strspn(spec, flags); /* skip flags */
+ if (*spec != '0') { /* a width cannot start with '0' */
+ spec = get2digits(spec); /* skip width */
+ if (*spec == '.' && precision) {
+ spec++;
+ spec = get2digits(spec); /* skip precision */
+ }
+ }
+ if (!isalpha(uchar(*spec))) /* did not go to the end? */
+ luaL_error(L, "invalid conversion specification: '%s'", form);
+}
+
+
+/*
+** Get a conversion specification and copy it to 'form'.
+** Return the address of its last character.
+*/
+static const char *getformat (lua_State *L, const char *strfrmt,
+ char *form) {
+ /* spans flags, width, and precision ('0' is included as a flag) */
+ size_t len = strspn(strfrmt, L_FMTFLAGSF "123456789.");
+ len++; /* adds following character (should be the specifier) */
+ /* still needs space for '%', '\0', plus a length modifier */
+ if (len >= MAX_FORMAT - 10)
+ luaL_error(L, "invalid format (too long)");
+ *(form++) = '%';
+ memcpy(form, strfrmt, len * sizeof(char));
+ *(form + len) = '\0';
+ return strfrmt + len - 1;
+}
+
+
+/*
+** add length modifier into formats
+*/
+static void addlenmod (char *form, const char *lenmod) {
+ size_t l = strlen(form);
+ size_t lm = strlen(lenmod);
+ char spec = form[l - 1];
+ strcpy(form + l - 1, lenmod);
+ form[l + lm - 1] = spec;
+ form[l + lm] = '\0';
+}
+
+
+static int str_format (lua_State *L) {
+ int top = lua_gettop(L);
+ int arg = 1;
+ size_t sfl;
+ const char *strfrmt = luaL_checklstring(L, arg, &sfl);
+ const char *strfrmt_end = strfrmt+sfl;
+ const char *flags;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while (strfrmt < strfrmt_end) {
+ if (*strfrmt != L_ESC)
+ luaL_addchar(&b, *strfrmt++);
+ else if (*++strfrmt == L_ESC)
+ luaL_addchar(&b, *strfrmt++); /* %% */
+ else { /* format item */
+ char form[MAX_FORMAT]; /* to store the format ('%...') */
+ int maxitem = MAX_ITEM; /* maximum length for the result */
+ char *buff = luaL_prepbuffsize(&b, maxitem); /* to put result */
+ int nb = 0; /* number of bytes in result */
+ if (++arg > top)
+ return luaL_argerror(L, arg, "no value");
+ strfrmt = getformat(L, strfrmt, form);
+ switch (*strfrmt++) {
+ case 'c': {
+ checkformat(L, form, L_FMTFLAGSC, 0);
+ nb = l_sprintf(buff, maxitem, form, (int)luaL_checkinteger(L, arg));
+ break;
+ }
+ case 'd': case 'i':
+ flags = L_FMTFLAGSI;
+ goto intcase;
+ case 'u':
+ flags = L_FMTFLAGSU;
+ goto intcase;
+ case 'o': case 'x': case 'X':
+ flags = L_FMTFLAGSX;
+ intcase: {
+ lua_Integer n = luaL_checkinteger(L, arg);
+ checkformat(L, form, flags, 1);
+ addlenmod(form, LUA_INTEGER_FRMLEN);
+ nb = l_sprintf(buff, maxitem, form, (LUAI_UACINT)n);
+ break;
+ }
+ case 'a': case 'A':
+ checkformat(L, form, L_FMTFLAGSF, 1);
+ addlenmod(form, LUA_NUMBER_FRMLEN);
+ nb = lua_number2strx(L, buff, maxitem, form,
+ luaL_checknumber(L, arg));
+ break;
+ case 'f':
+ maxitem = MAX_ITEMF; /* extra space for '%f' */
+ buff = luaL_prepbuffsize(&b, maxitem);
+ /* FALLTHROUGH */
+ case 'e': case 'E': case 'g': case 'G': {
+ lua_Number n = luaL_checknumber(L, arg);
+ checkformat(L, form, L_FMTFLAGSF, 1);
+ addlenmod(form, LUA_NUMBER_FRMLEN);
+ nb = l_sprintf(buff, maxitem, form, (LUAI_UACNUMBER)n);
+ break;
+ }
+ case 'p': {
+ const void *p = lua_topointer(L, arg);
+ checkformat(L, form, L_FMTFLAGSC, 0);
+ if (p == NULL) { /* avoid calling 'printf' with argument NULL */
+ p = "(null)"; /* result */
+ form[strlen(form) - 1] = 's'; /* format it as a string */
+ }
+ nb = l_sprintf(buff, maxitem, form, p);
+ break;
+ }
+ case 'q': {
+ if (form[2] != '\0') /* modifiers? */
+ return luaL_error(L, "specifier '%%q' cannot have modifiers");
+ addliteral(L, &b, arg);
+ break;
+ }
+ case 's': {
+ size_t l;
+ const char *s = luaL_tolstring(L, arg, &l);
+ if (form[2] == '\0') /* no modifiers? */
+ luaL_addvalue(&b); /* keep entire string */
+ else {
+ luaL_argcheck(L, l == strlen(s), arg, "string contains zeros");
+ checkformat(L, form, L_FMTFLAGSC, 1);
+ if (strchr(form, '.') == NULL && l >= 100) {
+ /* no precision and string is too long to be formatted */
+ luaL_addvalue(&b); /* keep entire string */
+ }
+ else { /* format the string into 'buff' */
+ nb = l_sprintf(buff, maxitem, form, s);
+ lua_pop(L, 1); /* remove result from 'luaL_tolstring' */
+ }
+ }
+ break;
+ }
+ default: { /* also treat cases 'pnLlh' */
+ return luaL_error(L, "invalid conversion '%s' to 'format'", form);
+ }
+ }
+ lua_assert(nb < maxitem);
+ luaL_addsize(&b, nb);
+ }
+ }
+ luaL_pushresult(&b);
+ return 1;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** PACK/UNPACK
+** =======================================================
+*/
+
+
+/* value used for padding */
+#if !defined(LUAL_PACKPADBYTE)
+#define LUAL_PACKPADBYTE 0x00
+#endif
+
+/* maximum size for the binary representation of an integer */
+#define MAXINTSIZE 16
+
+/* number of bits in a character */
+#define NB CHAR_BIT
+
+/* mask for one character (NB 1's) */
+#define MC ((1 << NB) - 1)
+
+/* size of a lua_Integer */
+#define SZINT ((int)sizeof(lua_Integer))
+
+
+/* dummy union to get native endianness */
+static const union {
+ int dummy;
+ char little; /* true iff machine is little endian */
+} nativeendian = {1};
+
+
+/*
+** information to pack/unpack stuff
+*/
+typedef struct Header {
+ lua_State *L;
+ int islittle;
+ int maxalign;
+} Header;
+
+
+/*
+** options for pack/unpack
+*/
+typedef enum KOption {
+ Kint, /* signed integers */
+ Kuint, /* unsigned integers */
+ Kfloat, /* single-precision floating-point numbers */
+ Knumber, /* Lua "native" floating-point numbers */
+ Kdouble, /* double-precision floating-point numbers */
+ Kchar, /* fixed-length strings */
+ Kstring, /* strings with prefixed length */
+ Kzstr, /* zero-terminated strings */
+ Kpadding, /* padding */
+ Kpaddalign, /* padding for alignment */
+ Knop /* no-op (configuration or spaces) */
+} KOption;
+
+
+/*
+** Read an integer numeral from string 'fmt' or return 'df' if
+** there is no numeral
+*/
+static int digit (int c) { return '0' <= c && c <= '9'; }
+
+static int getnum (const char **fmt, int df) {
+ if (!digit(**fmt)) /* no number? */
+ return df; /* return default value */
+ else {
+ int a = 0;
+ do {
+ a = a*10 + (*((*fmt)++) - '0');
+ } while (digit(**fmt) && a <= ((int)MAXSIZE - 9)/10);
+ return a;
+ }
+}
+
+
+/*
+** Read an integer numeral and raises an error if it is larger
+** than the maximum size for integers.
+*/
+static int getnumlimit (Header *h, const char **fmt, int df) {
+ int sz = getnum(fmt, df);
+ if (l_unlikely(sz > MAXINTSIZE || sz <= 0))
+ return luaL_error(h->L, "integral size (%d) out of limits [1,%d]",
+ sz, MAXINTSIZE);
+ return sz;
+}
+
+
+/*
+** Initialize Header
+*/
+static void initheader (lua_State *L, Header *h) {
+ h->L = L;
+ h->islittle = nativeendian.little;
+ h->maxalign = 1;
+}
+
+
+/*
+** Read and classify next option. 'size' is filled with option's size.
+*/
+static KOption getoption (Header *h, const char **fmt, int *size) {
+ /* dummy structure to get native alignment requirements */
+ struct cD { char c; union { LUAI_MAXALIGN; } u; };
+ int opt = *((*fmt)++);
+ *size = 0; /* default */
+ switch (opt) {
+ case 'b': *size = sizeof(char); return Kint;
+ case 'B': *size = sizeof(char); return Kuint;
+ case 'h': *size = sizeof(short); return Kint;
+ case 'H': *size = sizeof(short); return Kuint;
+ case 'l': *size = sizeof(long); return Kint;
+ case 'L': *size = sizeof(long); return Kuint;
+ case 'j': *size = sizeof(lua_Integer); return Kint;
+ case 'J': *size = sizeof(lua_Integer); return Kuint;
+ case 'T': *size = sizeof(size_t); return Kuint;
+ case 'f': *size = sizeof(float); return Kfloat;
+ case 'n': *size = sizeof(lua_Number); return Knumber;
+ case 'd': *size = sizeof(double); return Kdouble;
+ case 'i': *size = getnumlimit(h, fmt, sizeof(int)); return Kint;
+ case 'I': *size = getnumlimit(h, fmt, sizeof(int)); return Kuint;
+ case 's': *size = getnumlimit(h, fmt, sizeof(size_t)); return Kstring;
+ case 'c':
+ *size = getnum(fmt, -1);
+ if (l_unlikely(*size == -1))
+ luaL_error(h->L, "missing size for format option 'c'");
+ return Kchar;
+ case 'z': return Kzstr;
+ case 'x': *size = 1; return Kpadding;
+ case 'X': return Kpaddalign;
+ case ' ': break;
+ case '<': h->islittle = 1; break;
+ case '>': h->islittle = 0; break;
+ case '=': h->islittle = nativeendian.little; break;
+ case '!': {
+ const int maxalign = offsetof(struct cD, u);
+ h->maxalign = getnumlimit(h, fmt, maxalign);
+ break;
+ }
+ default: luaL_error(h->L, "invalid format option '%c'", opt);
+ }
+ return Knop;
+}
+
+
+/*
+** Read, classify, and fill other details about the next option.
+** 'psize' is filled with option's size, 'notoalign' with its
+** alignment requirements.
+** Local variable 'size' gets the size to be aligned. (Kpadal option
+** always gets its full alignment, other options are limited by
+** the maximum alignment ('maxalign'). Kchar option needs no alignment
+** despite its size.
+*/
+static KOption getdetails (Header *h, size_t totalsize,
+ const char **fmt, int *psize, int *ntoalign) {
+ KOption opt = getoption(h, fmt, psize);
+ int align = *psize; /* usually, alignment follows size */
+ if (opt == Kpaddalign) { /* 'X' gets alignment from following option */
+ if (**fmt == '\0' || getoption(h, fmt, &align) == Kchar || align == 0)
+ luaL_argerror(h->L, 1, "invalid next option for option 'X'");
+ }
+ if (align <= 1 || opt == Kchar) /* need no alignment? */
+ *ntoalign = 0;
+ else {
+ if (align > h->maxalign) /* enforce maximum alignment */
+ align = h->maxalign;
+ if (l_unlikely((align & (align - 1)) != 0)) /* not a power of 2? */
+ luaL_argerror(h->L, 1, "format asks for alignment not power of 2");
+ *ntoalign = (align - (int)(totalsize & (align - 1))) & (align - 1);
+ }
+ return opt;
+}
+
+
+/*
+** Pack integer 'n' with 'size' bytes and 'islittle' endianness.
+** The final 'if' handles the case when 'size' is larger than
+** the size of a Lua integer, correcting the extra sign-extension
+** bytes if necessary (by default they would be zeros).
+*/
+static void packint (luaL_Buffer *b, lua_Unsigned n,
+ int islittle, int size, int neg) {
+ char *buff = luaL_prepbuffsize(b, size);
+ int i;
+ buff[islittle ? 0 : size - 1] = (char)(n & MC); /* first byte */
+ for (i = 1; i < size; i++) {
+ n >>= NB;
+ buff[islittle ? i : size - 1 - i] = (char)(n & MC);
+ }
+ if (neg && size > SZINT) { /* negative number need sign extension? */
+ for (i = SZINT; i < size; i++) /* correct extra bytes */
+ buff[islittle ? i : size - 1 - i] = (char)MC;
+ }
+ luaL_addsize(b, size); /* add result to buffer */
+}
+
+
+/*
+** Copy 'size' bytes from 'src' to 'dest', correcting endianness if
+** given 'islittle' is different from native endianness.
+*/
+static void copywithendian (char *dest, const char *src,
+ int size, int islittle) {
+ if (islittle == nativeendian.little)
+ memcpy(dest, src, size);
+ else {
+ dest += size - 1;
+ while (size-- != 0)
+ *(dest--) = *(src++);
+ }
+}
+
+
+static int str_pack (lua_State *L) {
+ luaL_Buffer b;
+ Header h;
+ const char *fmt = luaL_checkstring(L, 1); /* format string */
+ int arg = 1; /* current argument to pack */
+ size_t totalsize = 0; /* accumulate total size of result */
+ initheader(L, &h);
+ lua_pushnil(L); /* mark to separate arguments from string buffer */
+ luaL_buffinit(L, &b);
+ while (*fmt != '\0') {
+ int size, ntoalign;
+ KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
+ totalsize += ntoalign + size;
+ while (ntoalign-- > 0)
+ luaL_addchar(&b, LUAL_PACKPADBYTE); /* fill alignment */
+ arg++;
+ switch (opt) {
+ case Kint: { /* signed integers */
+ lua_Integer n = luaL_checkinteger(L, arg);
+ if (size < SZINT) { /* need overflow check? */
+ lua_Integer lim = (lua_Integer)1 << ((size * NB) - 1);
+ luaL_argcheck(L, -lim <= n && n < lim, arg, "integer overflow");
+ }
+ packint(&b, (lua_Unsigned)n, h.islittle, size, (n < 0));
+ break;
+ }
+ case Kuint: { /* unsigned integers */
+ lua_Integer n = luaL_checkinteger(L, arg);
+ if (size < SZINT) /* need overflow check? */
+ luaL_argcheck(L, (lua_Unsigned)n < ((lua_Unsigned)1 << (size * NB)),
+ arg, "unsigned overflow");
+ packint(&b, (lua_Unsigned)n, h.islittle, size, 0);
+ break;
+ }
+ case Kfloat: { /* C float */
+ float f = (float)luaL_checknumber(L, arg); /* get argument */
+ char *buff = luaL_prepbuffsize(&b, sizeof(f));
+ /* move 'f' to final result, correcting endianness if needed */
+ copywithendian(buff, (char *)&f, sizeof(f), h.islittle);
+ luaL_addsize(&b, size);
+ break;
+ }
+ case Knumber: { /* Lua float */
+ lua_Number f = luaL_checknumber(L, arg); /* get argument */
+ char *buff = luaL_prepbuffsize(&b, sizeof(f));
+ /* move 'f' to final result, correcting endianness if needed */
+ copywithendian(buff, (char *)&f, sizeof(f), h.islittle);
+ luaL_addsize(&b, size);
+ break;
+ }
+ case Kdouble: { /* C double */
+ double f = (double)luaL_checknumber(L, arg); /* get argument */
+ char *buff = luaL_prepbuffsize(&b, sizeof(f));
+ /* move 'f' to final result, correcting endianness if needed */
+ copywithendian(buff, (char *)&f, sizeof(f), h.islittle);
+ luaL_addsize(&b, size);
+ break;
+ }
+ case Kchar: { /* fixed-size string */
+ size_t len;
+ const char *s = luaL_checklstring(L, arg, &len);
+ luaL_argcheck(L, len <= (size_t)size, arg,
+ "string longer than given size");
+ luaL_addlstring(&b, s, len); /* add string */
+ while (len++ < (size_t)size) /* pad extra space */
+ luaL_addchar(&b, LUAL_PACKPADBYTE);
+ break;
+ }
+ case Kstring: { /* strings with length count */
+ size_t len;
+ const char *s = luaL_checklstring(L, arg, &len);
+ luaL_argcheck(L, size >= (int)sizeof(size_t) ||
+ len < ((size_t)1 << (size * NB)),
+ arg, "string length does not fit in given size");
+ packint(&b, (lua_Unsigned)len, h.islittle, size, 0); /* pack length */
+ luaL_addlstring(&b, s, len);
+ totalsize += len;
+ break;
+ }
+ case Kzstr: { /* zero-terminated string */
+ size_t len;
+ const char *s = luaL_checklstring(L, arg, &len);
+ luaL_argcheck(L, strlen(s) == len, arg, "string contains zeros");
+ luaL_addlstring(&b, s, len);
+ luaL_addchar(&b, '\0'); /* add zero at the end */
+ totalsize += len + 1;
+ break;
+ }
+ case Kpadding: luaL_addchar(&b, LUAL_PACKPADBYTE); /* FALLTHROUGH */
+ case Kpaddalign: case Knop:
+ arg--; /* undo increment */
+ break;
+ }
+ }
+ luaL_pushresult(&b);
+ return 1;
+}
+
+
+static int str_packsize (lua_State *L) {
+ Header h;
+ const char *fmt = luaL_checkstring(L, 1); /* format string */
+ size_t totalsize = 0; /* accumulate total size of result */
+ initheader(L, &h);
+ while (*fmt != '\0') {
+ int size, ntoalign;
+ KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
+ luaL_argcheck(L, opt != Kstring && opt != Kzstr, 1,
+ "variable-length format");
+ size += ntoalign; /* total space used by option */
+ luaL_argcheck(L, totalsize <= MAXSIZE - size, 1,
+ "format result too large");
+ totalsize += size;
+ }
+ lua_pushinteger(L, (lua_Integer)totalsize);
+ return 1;
+}
+
+
+/*
+** Unpack an integer with 'size' bytes and 'islittle' endianness.
+** If size is smaller than the size of a Lua integer and integer
+** is signed, must do sign extension (propagating the sign to the
+** higher bits); if size is larger than the size of a Lua integer,
+** it must check the unread bytes to see whether they do not cause an
+** overflow.
+*/
+static lua_Integer unpackint (lua_State *L, const char *str,
+ int islittle, int size, int issigned) {
+ lua_Unsigned res = 0;
+ int i;
+ int limit = (size <= SZINT) ? size : SZINT;
+ for (i = limit - 1; i >= 0; i--) {
+ res <<= NB;
+ res |= (lua_Unsigned)(unsigned char)str[islittle ? i : size - 1 - i];
+ }
+ if (size < SZINT) { /* real size smaller than lua_Integer? */
+ if (issigned) { /* needs sign extension? */
+ lua_Unsigned mask = (lua_Unsigned)1 << (size*NB - 1);
+ res = ((res ^ mask) - mask); /* do sign extension */
+ }
+ }
+ else if (size > SZINT) { /* must check unread bytes */
+ int mask = (!issigned || (lua_Integer)res >= 0) ? 0 : MC;
+ for (i = limit; i < size; i++) {
+ if (l_unlikely((unsigned char)str[islittle ? i : size - 1 - i] != mask))
+ luaL_error(L, "%d-byte integer does not fit into Lua Integer", size);
+ }
+ }
+ return (lua_Integer)res;
+}
+
+
+static int str_unpack (lua_State *L) {
+ Header h;
+ const char *fmt = luaL_checkstring(L, 1);
+ size_t ld;
+ const char *data = luaL_checklstring(L, 2, &ld);
+ size_t pos = posrelatI(luaL_optinteger(L, 3, 1), ld) - 1;
+ int n = 0; /* number of results */
+ luaL_argcheck(L, pos <= ld, 3, "initial position out of string");
+ initheader(L, &h);
+ while (*fmt != '\0') {
+ int size, ntoalign;
+ KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign);
+ luaL_argcheck(L, (size_t)ntoalign + size <= ld - pos, 2,
+ "data string too short");
+ pos += ntoalign; /* skip alignment */
+ /* stack space for item + next position */
+ luaL_checkstack(L, 2, "too many results");
+ n++;
+ switch (opt) {
+ case Kint:
+ case Kuint: {
+ lua_Integer res = unpackint(L, data + pos, h.islittle, size,
+ (opt == Kint));
+ lua_pushinteger(L, res);
+ break;
+ }
+ case Kfloat: {
+ float f;
+ copywithendian((char *)&f, data + pos, sizeof(f), h.islittle);
+ lua_pushnumber(L, (lua_Number)f);
+ break;
+ }
+ case Knumber: {
+ lua_Number f;
+ copywithendian((char *)&f, data + pos, sizeof(f), h.islittle);
+ lua_pushnumber(L, f);
+ break;
+ }
+ case Kdouble: {
+ double f;
+ copywithendian((char *)&f, data + pos, sizeof(f), h.islittle);
+ lua_pushnumber(L, (lua_Number)f);
+ break;
+ }
+ case Kchar: {
+ lua_pushlstring(L, data + pos, size);
+ break;
+ }
+ case Kstring: {
+ size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0);
+ luaL_argcheck(L, len <= ld - pos - size, 2, "data string too short");
+ lua_pushlstring(L, data + pos + size, len);
+ pos += len; /* skip string */
+ break;
+ }
+ case Kzstr: {
+ size_t len = strlen(data + pos);
+ luaL_argcheck(L, pos + len < ld, 2,
+ "unfinished string for format 'z'");
+ lua_pushlstring(L, data + pos, len);
+ pos += len + 1; /* skip string plus final '\0' */
+ break;
+ }
+ case Kpaddalign: case Kpadding: case Knop:
+ n--; /* undo increment */
+ break;
+ }
+ pos += size;
+ }
+ lua_pushinteger(L, pos + 1); /* next position */
+ return n + 1;
+}
+
+/* }====================================================== */
+
+
+static const luaL_Reg strlib[] = {
+ {"byte", str_byte},
+ {"char", str_char},
+ {"dump", str_dump},
+ {"find", str_find},
+ {"format", str_format},
+ {"gmatch", gmatch},
+ {"gsub", str_gsub},
+ {"len", str_len},
+ {"lower", str_lower},
+ {"match", str_match},
+ {"rep", str_rep},
+ {"reverse", str_reverse},
+ {"sub", str_sub},
+ {"upper", str_upper},
+ {"pack", str_pack},
+ {"packsize", str_packsize},
+ {"unpack", str_unpack},
+ {NULL, NULL}
+};
+
+
+static void createmetatable (lua_State *L) {
+ /* table to be metatable for strings */
+ luaL_newlibtable(L, stringmetamethods);
+ luaL_setfuncs(L, stringmetamethods, 0);
+ lua_pushliteral(L, ""); /* dummy string */
+ lua_pushvalue(L, -2); /* copy table */
+ lua_setmetatable(L, -2); /* set table as metatable for strings */
+ lua_pop(L, 1); /* pop dummy string */
+ lua_pushvalue(L, -2); /* get string library */
+ lua_setfield(L, -2, "__index"); /* metatable.__index = string */
+ lua_pop(L, 1); /* pop metatable */
+}
+
+
+/*
+** Open string library
+*/
+LUAMOD_API int luaopen_string (lua_State *L) {
+ luaL_newlib(L, strlib);
+ createmetatable(L);
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/ltable.c b/source/luametatex/source/luacore/lua54/src/ltable.c
new file mode 100644
index 000000000..1b1cd2415
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ltable.c
@@ -0,0 +1,980 @@
+/*
+** $Id: ltable.c $
+** Lua tables (hash)
+** See Copyright Notice in lua.h
+*/
+
+#define ltable_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+/*
+** Implementation of tables (aka arrays, objects, or hash tables).
+** Tables keep its elements in two parts: an array part and a hash part.
+** Non-negative integer keys are all candidates to be kept in the array
+** part. The actual size of the array is the largest 'n' such that
+** more than half the slots between 1 and n are in use.
+** Hash uses a mix of chained scatter table with Brent's variation.
+** A main invariant of these tables is that, if an element is not
+** in its main position (i.e. the 'original' position that its hash gives
+** to it), then the colliding element is in its own main position.
+** Hence even when the load factor reaches 100%, performance remains good.
+*/
+
+#include <math.h>
+#include <limits.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "lvm.h"
+
+
+/*
+** MAXABITS is the largest integer such that MAXASIZE fits in an
+** unsigned int.
+*/
+#define MAXABITS cast_int(sizeof(int) * CHAR_BIT - 1)
+
+
+/*
+** MAXASIZE is the maximum size of the array part. It is the minimum
+** between 2^MAXABITS and the maximum size that, measured in bytes,
+** fits in a 'size_t'.
+*/
+#define MAXASIZE luaM_limitN(1u << MAXABITS, TValue)
+
+/*
+** MAXHBITS is the largest integer such that 2^MAXHBITS fits in a
+** signed int.
+*/
+#define MAXHBITS (MAXABITS - 1)
+
+
+/*
+** MAXHSIZE is the maximum size of the hash part. It is the minimum
+** between 2^MAXHBITS and the maximum size such that, measured in bytes,
+** it fits in a 'size_t'.
+*/
+#define MAXHSIZE luaM_limitN(1u << MAXHBITS, Node)
+
+
+/*
+** When the original hash value is good, hashing by a power of 2
+** avoids the cost of '%'.
+*/
+#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))
+
+/*
+** for other types, it is better to avoid modulo by power of 2, as
+** they can have many 2 factors.
+*/
+#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1))))
+
+
+#define hashstr(t,str) hashpow2(t, (str)->hash)
+#define hashboolean(t,p) hashpow2(t, p)
+
+
+#define hashpointer(t,p) hashmod(t, point2uint(p))
+
+
+#define dummynode (&dummynode_)
+
+static const Node dummynode_ = {
+ {{NULL}, LUA_VEMPTY, /* value's value and type */
+ LUA_VNIL, 0, {NULL}} /* key type, next, and key value */
+};
+
+
+static const TValue absentkey = {ABSTKEYCONSTANT};
+
+
+/*
+** Hash for integers. To allow a good hash, use the remainder operator
+** ('%'). If integer fits as a non-negative int, compute an int
+** remainder, which is faster. Otherwise, use an unsigned-integer
+** remainder, which uses all bits and ensures a non-negative result.
+*/
+static Node *hashint (const Table *t, lua_Integer i) {
+ lua_Unsigned ui = l_castS2U(i);
+ if (ui <= (unsigned int)INT_MAX)
+ return hashmod(t, cast_int(ui));
+ else
+ return hashmod(t, ui);
+}
+
+
+/*
+** Hash for floating-point numbers.
+** The main computation should be just
+** n = frexp(n, &i); return (n * INT_MAX) + i
+** but there are some numerical subtleties.
+** In a two-complement representation, INT_MAX does not has an exact
+** representation as a float, but INT_MIN does; because the absolute
+** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the
+** absolute value of the product 'frexp * -INT_MIN' is smaller or equal
+** to INT_MAX. Next, the use of 'unsigned int' avoids overflows when
+** adding 'i'; the use of '~u' (instead of '-u') avoids problems with
+** INT_MIN.
+*/
+#if !defined(l_hashfloat)
+static int l_hashfloat (lua_Number n) {
+ int i;
+ lua_Integer ni;
+ n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN);
+ if (!lua_numbertointeger(n, &ni)) { /* is 'n' inf/-inf/NaN? */
+ lua_assert(luai_numisnan(n) || l_mathop(fabs)(n) == cast_num(HUGE_VAL));
+ return 0;
+ }
+ else { /* normal case */
+ unsigned int u = cast_uint(i) + cast_uint(ni);
+ return cast_int(u <= cast_uint(INT_MAX) ? u : ~u);
+ }
+}
+#endif
+
+
+/*
+** returns the 'main' position of an element in a table (that is,
+** the index of its hash value).
+*/
+static Node *mainpositionTV (const Table *t, const TValue *key) {
+ switch (ttypetag(key)) {
+ case LUA_VNUMINT: {
+ lua_Integer i = ivalue(key);
+ return hashint(t, i);
+ }
+ case LUA_VNUMFLT: {
+ lua_Number n = fltvalue(key);
+ return hashmod(t, l_hashfloat(n));
+ }
+ case LUA_VSHRSTR: {
+ TString *ts = tsvalue(key);
+ return hashstr(t, ts);
+ }
+ case LUA_VLNGSTR: {
+ TString *ts = tsvalue(key);
+ return hashpow2(t, luaS_hashlongstr(ts));
+ }
+ case LUA_VFALSE:
+ return hashboolean(t, 0);
+ case LUA_VTRUE:
+ return hashboolean(t, 1);
+ case LUA_VLIGHTUSERDATA: {
+ void *p = pvalue(key);
+ return hashpointer(t, p);
+ }
+ case LUA_VLCF: {
+ lua_CFunction f = fvalue(key);
+ return hashpointer(t, f);
+ }
+ default: {
+ GCObject *o = gcvalue(key);
+ return hashpointer(t, o);
+ }
+ }
+}
+
+
+l_sinline Node *mainpositionfromnode (const Table *t, Node *nd) {
+ TValue key;
+ getnodekey(cast(lua_State *, NULL), &key, nd);
+ return mainpositionTV(t, &key);
+}
+
+
+/*
+** Check whether key 'k1' is equal to the key in node 'n2'. This
+** equality is raw, so there are no metamethods. Floats with integer
+** values have been normalized, so integers cannot be equal to
+** floats. It is assumed that 'eqshrstr' is simply pointer equality, so
+** that short strings are handled in the default case.
+** A true 'deadok' means to accept dead keys as equal to their original
+** values. All dead keys are compared in the default case, by pointer
+** identity. (Only collectable objects can produce dead keys.) Note that
+** dead long strings are also compared by identity.
+** Once a key is dead, its corresponding value may be collected, and
+** then another value can be created with the same address. If this
+** other value is given to 'next', 'equalkey' will signal a false
+** positive. In a regular traversal, this situation should never happen,
+** as all keys given to 'next' came from the table itself, and therefore
+** could not have been collected. Outside a regular traversal, we
+** have garbage in, garbage out. What is relevant is that this false
+** positive does not break anything. (In particular, 'next' will return
+** some other valid item on the table or nil.)
+*/
+static int equalkey (const TValue *k1, const Node *n2, int deadok) {
+ if ((rawtt(k1) != keytt(n2)) && /* not the same variants? */
+ !(deadok && keyisdead(n2) && iscollectable(k1)))
+ return 0; /* cannot be same key */
+ switch (keytt(n2)) {
+ case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE:
+ return 1;
+ case LUA_VNUMINT:
+ return (ivalue(k1) == keyival(n2));
+ case LUA_VNUMFLT:
+ return luai_numeq(fltvalue(k1), fltvalueraw(keyval(n2)));
+ case LUA_VLIGHTUSERDATA:
+ return pvalue(k1) == pvalueraw(keyval(n2));
+ case LUA_VLCF:
+ return fvalue(k1) == fvalueraw(keyval(n2));
+ case ctb(LUA_VLNGSTR):
+ return luaS_eqlngstr(tsvalue(k1), keystrval(n2));
+ default:
+ return gcvalue(k1) == gcvalueraw(keyval(n2));
+ }
+}
+
+
+/*
+** True if value of 'alimit' is equal to the real size of the array
+** part of table 't'. (Otherwise, the array part must be larger than
+** 'alimit'.)
+*/
+#define limitequalsasize(t) (isrealasize(t) || ispow2((t)->alimit))
+
+
+/*
+** Returns the real size of the 'array' array
+*/
+LUAI_FUNC unsigned int luaH_realasize (const Table *t) {
+ if (limitequalsasize(t))
+ return t->alimit; /* this is the size */
+ else {
+ unsigned int size = t->alimit;
+ /* compute the smallest power of 2 not smaller than 'n' */
+ size |= (size >> 1);
+ size |= (size >> 2);
+ size |= (size >> 4);
+ size |= (size >> 8);
+ size |= (size >> 16);
+#if (UINT_MAX >> 30) > 3
+ size |= (size >> 32); /* unsigned int has more than 32 bits */
+#endif
+ size++;
+ lua_assert(ispow2(size) && size/2 < t->alimit && t->alimit < size);
+ return size;
+ }
+}
+
+
+/*
+** Check whether real size of the array is a power of 2.
+** (If it is not, 'alimit' cannot be changed to any other value
+** without changing the real size.)
+*/
+static int ispow2realasize (const Table *t) {
+ return (!isrealasize(t) || ispow2(t->alimit));
+}
+
+
+static unsigned int setlimittosize (Table *t) {
+ t->alimit = luaH_realasize(t);
+ setrealasize(t);
+ return t->alimit;
+}
+
+
+#define limitasasize(t) check_exp(isrealasize(t), t->alimit)
+
+
+
+/*
+** "Generic" get version. (Not that generic: not valid for integers,
+** which may be in array part, nor for floats with integral values.)
+** See explanation about 'deadok' in function 'equalkey'.
+*/
+static const TValue *getgeneric (Table *t, const TValue *key, int deadok) {
+ Node *n = mainpositionTV(t, key);
+ for (;;) { /* check whether 'key' is somewhere in the chain */
+ if (equalkey(key, n, deadok))
+ return gval(n); /* that's it */
+ else {
+ int nx = gnext(n);
+ if (nx == 0)
+ return &absentkey; /* not found */
+ n += nx;
+ }
+ }
+}
+
+
+/*
+** returns the index for 'k' if 'k' is an appropriate key to live in
+** the array part of a table, 0 otherwise.
+*/
+static unsigned int arrayindex (lua_Integer k) {
+ if (l_castS2U(k) - 1u < MAXASIZE) /* 'k' in [1, MAXASIZE]? */
+ return cast_uint(k); /* 'key' is an appropriate array index */
+ else
+ return 0;
+}
+
+
+/*
+** returns the index of a 'key' for table traversals. First goes all
+** elements in the array part, then elements in the hash part. The
+** beginning of a traversal is signaled by 0.
+*/
+static unsigned int findindex (lua_State *L, Table *t, TValue *key,
+ unsigned int asize) {
+ unsigned int i;
+ if (ttisnil(key)) return 0; /* first iteration */
+ i = ttisinteger(key) ? arrayindex(ivalue(key)) : 0;
+ if (i - 1u < asize) /* is 'key' inside array part? */
+ return i; /* yes; that's the index */
+ else {
+ const TValue *n = getgeneric(t, key, 1);
+ if (l_unlikely(isabstkey(n)))
+ luaG_runerror(L, "invalid key to 'next'"); /* key not found */
+ i = cast_int(nodefromval(n) - gnode(t, 0)); /* key index in hash table */
+ /* hash elements are numbered after array ones */
+ return (i + 1) + asize;
+ }
+}
+
+
+int luaH_next (lua_State *L, Table *t, StkId key) {
+ unsigned int asize = luaH_realasize(t);
+ unsigned int i = findindex(L, t, s2v(key), asize); /* find original key */
+ for (; i < asize; i++) { /* try first array part */
+ if (!isempty(&t->array[i])) { /* a non-empty entry? */
+ setivalue(s2v(key), i + 1);
+ setobj2s(L, key + 1, &t->array[i]);
+ return 1;
+ }
+ }
+ for (i -= asize; cast_int(i) < sizenode(t); i++) { /* hash part */
+ if (!isempty(gval(gnode(t, i)))) { /* a non-empty entry? */
+ Node *n = gnode(t, i);
+ getnodekey(L, s2v(key), n);
+ setobj2s(L, key + 1, gval(n));
+ return 1;
+ }
+ }
+ return 0; /* no more elements */
+}
+
+
+static void freehash (lua_State *L, Table *t) {
+ if (!isdummy(t))
+ luaM_freearray(L, t->node, cast_sizet(sizenode(t)));
+}
+
+
+/*
+** {=============================================================
+** Rehash
+** ==============================================================
+*/
+
+/*
+** Compute the optimal size for the array part of table 't'. 'nums' is a
+** "count array" where 'nums[i]' is the number of integers in the table
+** between 2^(i - 1) + 1 and 2^i. 'pna' enters with the total number of
+** integer keys in the table and leaves with the number of keys that
+** will go to the array part; return the optimal size. (The condition
+** 'twotoi > 0' in the for loop stops the loop if 'twotoi' overflows.)
+*/
+static unsigned int computesizes (unsigned int nums[], unsigned int *pna) {
+ int i;
+ unsigned int twotoi; /* 2^i (candidate for optimal size) */
+ unsigned int a = 0; /* number of elements smaller than 2^i */
+ unsigned int na = 0; /* number of elements to go to array part */
+ unsigned int optimal = 0; /* optimal size for array part */
+ /* loop while keys can fill more than half of total size */
+ for (i = 0, twotoi = 1;
+ twotoi > 0 && *pna > twotoi / 2;
+ i++, twotoi *= 2) {
+ a += nums[i];
+ if (a > twotoi/2) { /* more than half elements present? */
+ optimal = twotoi; /* optimal size (till now) */
+ na = a; /* all elements up to 'optimal' will go to array part */
+ }
+ }
+ lua_assert((optimal == 0 || optimal / 2 < na) && na <= optimal);
+ *pna = na;
+ return optimal;
+}
+
+
+static int countint (lua_Integer key, unsigned int *nums) {
+ unsigned int k = arrayindex(key);
+ if (k != 0) { /* is 'key' an appropriate array index? */
+ nums[luaO_ceillog2(k)]++; /* count as such */
+ return 1;
+ }
+ else
+ return 0;
+}
+
+
+/*
+** Count keys in array part of table 't': Fill 'nums[i]' with
+** number of keys that will go into corresponding slice and return
+** total number of non-nil keys.
+*/
+static unsigned int numusearray (const Table *t, unsigned int *nums) {
+ int lg;
+ unsigned int ttlg; /* 2^lg */
+ unsigned int ause = 0; /* summation of 'nums' */
+ unsigned int i = 1; /* count to traverse all array keys */
+ unsigned int asize = limitasasize(t); /* real array size */
+ /* traverse each slice */
+ for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) {
+ unsigned int lc = 0; /* counter */
+ unsigned int lim = ttlg;
+ if (lim > asize) {
+ lim = asize; /* adjust upper limit */
+ if (i > lim)
+ break; /* no more elements to count */
+ }
+ /* count elements in range (2^(lg - 1), 2^lg] */
+ for (; i <= lim; i++) {
+ if (!isempty(&t->array[i-1]))
+ lc++;
+ }
+ nums[lg] += lc;
+ ause += lc;
+ }
+ return ause;
+}
+
+
+static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) {
+ int totaluse = 0; /* total number of elements */
+ int ause = 0; /* elements added to 'nums' (can go to array part) */
+ int i = sizenode(t);
+ while (i--) {
+ Node *n = &t->node[i];
+ if (!isempty(gval(n))) {
+ if (keyisinteger(n))
+ ause += countint(keyival(n), nums);
+ totaluse++;
+ }
+ }
+ *pna += ause;
+ return totaluse;
+}
+
+
+/*
+** Creates an array for the hash part of a table with the given
+** size, or reuses the dummy node if size is zero.
+** The computation for size overflow is in two steps: the first
+** comparison ensures that the shift in the second one does not
+** overflow.
+*/
+static void setnodevector (lua_State *L, Table *t, unsigned int size) {
+ if (size == 0) { /* no elements to hash part? */
+ t->node = cast(Node *, dummynode); /* use common 'dummynode' */
+ t->lsizenode = 0;
+ t->lastfree = NULL; /* signal that it is using dummy node */
+ }
+ else {
+ int i;
+ int lsize = luaO_ceillog2(size);
+ if (lsize > MAXHBITS || (1u << lsize) > MAXHSIZE)
+ luaG_runerror(L, "table overflow");
+ size = twoto(lsize);
+ t->node = luaM_newvector(L, size, Node);
+ for (i = 0; i < (int)size; i++) {
+ Node *n = gnode(t, i);
+ gnext(n) = 0;
+ setnilkey(n);
+ setempty(gval(n));
+ }
+ t->lsizenode = cast_byte(lsize);
+ t->lastfree = gnode(t, size); /* all positions are free */
+ }
+}
+
+
+/*
+** (Re)insert all elements from the hash part of 'ot' into table 't'.
+*/
+static void reinsert (lua_State *L, Table *ot, Table *t) {
+ int j;
+ int size = sizenode(ot);
+ for (j = 0; j < size; j++) {
+ Node *old = gnode(ot, j);
+ if (!isempty(gval(old))) {
+ /* doesn't need barrier/invalidate cache, as entry was
+ already present in the table */
+ TValue k;
+ getnodekey(L, &k, old);
+ luaH_set(L, t, &k, gval(old));
+ }
+ }
+}
+
+
+/*
+** Exchange the hash part of 't1' and 't2'.
+*/
+static void exchangehashpart (Table *t1, Table *t2) {
+ lu_byte lsizenode = t1->lsizenode;
+ Node *node = t1->node;
+ Node *lastfree = t1->lastfree;
+ t1->lsizenode = t2->lsizenode;
+ t1->node = t2->node;
+ t1->lastfree = t2->lastfree;
+ t2->lsizenode = lsizenode;
+ t2->node = node;
+ t2->lastfree = lastfree;
+}
+
+
+/*
+** Resize table 't' for the new given sizes. Both allocations (for
+** the hash part and for the array part) can fail, which creates some
+** subtleties. If the first allocation, for the hash part, fails, an
+** error is raised and that is it. Otherwise, it copies the elements from
+** the shrinking part of the array (if it is shrinking) into the new
+** hash. Then it reallocates the array part. If that fails, the table
+** is in its original state; the function frees the new hash part and then
+** raises the allocation error. Otherwise, it sets the new hash part
+** into the table, initializes the new part of the array (if any) with
+** nils and reinserts the elements of the old hash back into the new
+** parts of the table.
+*/
+void luaH_resize (lua_State *L, Table *t, unsigned int newasize,
+ unsigned int nhsize) {
+ unsigned int i;
+ Table newt; /* to keep the new hash part */
+ unsigned int oldasize = setlimittosize(t);
+ TValue *newarray;
+ /* create new hash part with appropriate size into 'newt' */
+ setnodevector(L, &newt, nhsize);
+ if (newasize < oldasize) { /* will array shrink? */
+ t->alimit = newasize; /* pretend array has new size... */
+ exchangehashpart(t, &newt); /* and new hash */
+ /* re-insert into the new hash the elements from vanishing slice */
+ for (i = newasize; i < oldasize; i++) {
+ if (!isempty(&t->array[i]))
+ luaH_setint(L, t, i + 1, &t->array[i]);
+ }
+ t->alimit = oldasize; /* restore current size... */
+ exchangehashpart(t, &newt); /* and hash (in case of errors) */
+ }
+ /* allocate new array */
+ newarray = luaM_reallocvector(L, t->array, oldasize, newasize, TValue);
+ if (l_unlikely(newarray == NULL && newasize > 0)) { /* allocation failed? */
+ freehash(L, &newt); /* release new hash part */
+ luaM_error(L); /* raise error (with array unchanged) */
+ }
+ /* allocation ok; initialize new part of the array */
+ exchangehashpart(t, &newt); /* 't' has the new hash ('newt' has the old) */
+ t->array = newarray; /* set new array part */
+ t->alimit = newasize;
+ for (i = oldasize; i < newasize; i++) /* clear new slice of the array */
+ setempty(&t->array[i]);
+ /* re-insert elements from old hash part into new parts */
+ reinsert(L, &newt, t); /* 'newt' now has the old hash */
+ freehash(L, &newt); /* free old hash part */
+}
+
+
+void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) {
+ int nsize = allocsizenode(t);
+ luaH_resize(L, t, nasize, nsize);
+}
+
+/*
+** nums[i] = number of keys 'k' where 2^(i - 1) < k <= 2^i
+*/
+static void rehash (lua_State *L, Table *t, const TValue *ek) {
+ unsigned int asize; /* optimal size for array part */
+ unsigned int na; /* number of keys in the array part */
+ unsigned int nums[MAXABITS + 1];
+ int i;
+ int totaluse;
+ for (i = 0; i <= MAXABITS; i++) nums[i] = 0; /* reset counts */
+ setlimittosize(t);
+ na = numusearray(t, nums); /* count keys in array part */
+ totaluse = na; /* all those keys are integer keys */
+ totaluse += numusehash(t, nums, &na); /* count keys in hash part */
+ /* count extra key */
+ if (ttisinteger(ek))
+ na += countint(ivalue(ek), nums);
+ totaluse++;
+ /* compute new size for array part */
+ asize = computesizes(nums, &na);
+ /* resize the table to new computed sizes */
+ luaH_resize(L, t, asize, totaluse - na);
+}
+
+
+
+/*
+** }=============================================================
+*/
+
+
+Table *luaH_new (lua_State *L) {
+ GCObject *o = luaC_newobj(L, LUA_VTABLE, sizeof(Table));
+ Table *t = gco2t(o);
+ t->metatable = NULL;
+ t->flags = cast_byte(maskflags); /* table has no metamethod fields */
+ t->array = NULL;
+ t->alimit = 0;
+ setnodevector(L, t, 0);
+ return t;
+}
+
+
+void luaH_free (lua_State *L, Table *t) {
+ freehash(L, t);
+ luaM_freearray(L, t->array, luaH_realasize(t));
+ luaM_free(L, t);
+}
+
+
+static Node *getfreepos (Table *t) {
+ if (!isdummy(t)) {
+ while (t->lastfree > t->node) {
+ t->lastfree--;
+ if (keyisnil(t->lastfree))
+ return t->lastfree;
+ }
+ }
+ return NULL; /* could not find a free place */
+}
+
+
+
+/*
+** inserts a new key into a hash table; first, check whether key's main
+** position is free. If not, check whether colliding node is in its main
+** position or not: if it is not, move colliding node to an empty place and
+** put new key in its main position; otherwise (colliding node is in its main
+** position), new key goes to an empty position.
+*/
+void luaH_newkey (lua_State *L, Table *t, const TValue *key, TValue *value) {
+ Node *mp;
+ TValue aux;
+ if (l_unlikely(ttisnil(key)))
+ luaG_runerror(L, "table index is nil");
+ else if (ttisfloat(key)) {
+ lua_Number f = fltvalue(key);
+ lua_Integer k;
+ if (luaV_flttointeger(f, &k, F2Ieq)) { /* does key fit in an integer? */
+ setivalue(&aux, k);
+ key = &aux; /* insert it as an integer */
+ }
+ else if (l_unlikely(luai_numisnan(f)))
+ luaG_runerror(L, "table index is NaN");
+ }
+ if (ttisnil(value))
+ return; /* do not insert nil values */
+ mp = mainpositionTV(t, key);
+ if (!isempty(gval(mp)) || isdummy(t)) { /* main position is taken? */
+ Node *othern;
+ Node *f = getfreepos(t); /* get a free place */
+ if (f == NULL) { /* cannot find a free place? */
+ rehash(L, t, key); /* grow table */
+ /* whatever called 'newkey' takes care of TM cache */
+ luaH_set(L, t, key, value); /* insert key into grown table */
+ return;
+ }
+ lua_assert(!isdummy(t));
+ othern = mainpositionfromnode(t, mp);
+ if (othern != mp) { /* is colliding node out of its main position? */
+ /* yes; move colliding node into free position */
+ while (othern + gnext(othern) != mp) /* find previous */
+ othern += gnext(othern);
+ gnext(othern) = cast_int(f - othern); /* rechain to point to 'f' */
+ *f = *mp; /* copy colliding node into free pos. (mp->next also goes) */
+ if (gnext(mp) != 0) {
+ gnext(f) += cast_int(mp - f); /* correct 'next' */
+ gnext(mp) = 0; /* now 'mp' is free */
+ }
+ setempty(gval(mp));
+ }
+ else { /* colliding node is in its own main position */
+ /* new node will go into free position */
+ if (gnext(mp) != 0)
+ gnext(f) = cast_int((mp + gnext(mp)) - f); /* chain new position */
+ else lua_assert(gnext(f) == 0);
+ gnext(mp) = cast_int(f - mp);
+ mp = f;
+ }
+ }
+ setnodekey(L, mp, key);
+ luaC_barrierback(L, obj2gco(t), key);
+ lua_assert(isempty(gval(mp)));
+ setobj2t(L, gval(mp), value);
+}
+
+
+/*
+** Search function for integers. If integer is inside 'alimit', get it
+** directly from the array part. Otherwise, if 'alimit' is not equal to
+** the real size of the array, key still can be in the array part. In
+** this case, try to avoid a call to 'luaH_realasize' when key is just
+** one more than the limit (so that it can be incremented without
+** changing the real size of the array).
+*/
+const TValue *luaH_getint (Table *t, lua_Integer key) {
+ if (l_castS2U(key) - 1u < t->alimit) /* 'key' in [1, t->alimit]? */
+ return &t->array[key - 1];
+ else if (!limitequalsasize(t) && /* key still may be in the array part? */
+ (l_castS2U(key) == t->alimit + 1 ||
+ l_castS2U(key) - 1u < luaH_realasize(t))) {
+ t->alimit = cast_uint(key); /* probably '#t' is here now */
+ return &t->array[key - 1];
+ }
+ else {
+ Node *n = hashint(t, key);
+ for (;;) { /* check whether 'key' is somewhere in the chain */
+ if (keyisinteger(n) && keyival(n) == key)
+ return gval(n); /* that's it */
+ else {
+ int nx = gnext(n);
+ if (nx == 0) break;
+ n += nx;
+ }
+ }
+ return &absentkey;
+ }
+}
+
+
+/*
+** search function for short strings
+*/
+const TValue *luaH_getshortstr (Table *t, TString *key) {
+ Node *n = hashstr(t, key);
+ lua_assert(key->tt == LUA_VSHRSTR);
+ for (;;) { /* check whether 'key' is somewhere in the chain */
+ if (keyisshrstr(n) && eqshrstr(keystrval(n), key))
+ return gval(n); /* that's it */
+ else {
+ int nx = gnext(n);
+ if (nx == 0)
+ return &absentkey; /* not found */
+ n += nx;
+ }
+ }
+}
+
+
+const TValue *luaH_getstr (Table *t, TString *key) {
+ if (key->tt == LUA_VSHRSTR)
+ return luaH_getshortstr(t, key);
+ else { /* for long strings, use generic case */
+ TValue ko;
+ setsvalue(cast(lua_State *, NULL), &ko, key);
+ return getgeneric(t, &ko, 0);
+ }
+}
+
+
+/*
+** main search function
+*/
+const TValue *luaH_get (Table *t, const TValue *key) {
+ switch (ttypetag(key)) {
+ case LUA_VSHRSTR: return luaH_getshortstr(t, tsvalue(key));
+ case LUA_VNUMINT: return luaH_getint(t, ivalue(key));
+ case LUA_VNIL: return &absentkey;
+ case LUA_VNUMFLT: {
+ lua_Integer k;
+ if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */
+ return luaH_getint(t, k); /* use specialized version */
+ /* else... */
+ } /* FALLTHROUGH */
+ default:
+ return getgeneric(t, key, 0);
+ }
+}
+
+
+/*
+** Finish a raw "set table" operation, where 'slot' is where the value
+** should have been (the result of a previous "get table").
+** Beware: when using this function you probably need to check a GC
+** barrier and invalidate the TM cache.
+*/
+void luaH_finishset (lua_State *L, Table *t, const TValue *key,
+ const TValue *slot, TValue *value) {
+ if (isabstkey(slot))
+ luaH_newkey(L, t, key, value);
+ else
+ setobj2t(L, cast(TValue *, slot), value);
+}
+
+
+/*
+** beware: when using this function you probably need to check a GC
+** barrier and invalidate the TM cache.
+*/
+void luaH_set (lua_State *L, Table *t, const TValue *key, TValue *value) {
+ const TValue *slot = luaH_get(t, key);
+ luaH_finishset(L, t, key, slot, value);
+}
+
+
+void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) {
+ const TValue *p = luaH_getint(t, key);
+ if (isabstkey(p)) {
+ TValue k;
+ setivalue(&k, key);
+ luaH_newkey(L, t, &k, value);
+ }
+ else
+ setobj2t(L, cast(TValue *, p), value);
+}
+
+
+/*
+** Try to find a boundary in the hash part of table 't'. From the
+** caller, we know that 'j' is zero or present and that 'j + 1' is
+** present. We want to find a larger key that is absent from the
+** table, so that we can do a binary search between the two keys to
+** find a boundary. We keep doubling 'j' until we get an absent index.
+** If the doubling would overflow, we try LUA_MAXINTEGER. If it is
+** absent, we are ready for the binary search. ('j', being max integer,
+** is larger or equal to 'i', but it cannot be equal because it is
+** absent while 'i' is present; so 'j > i'.) Otherwise, 'j' is a
+** boundary. ('j + 1' cannot be a present integer key because it is
+** not a valid integer in Lua.)
+*/
+static lua_Unsigned hash_search (Table *t, lua_Unsigned j) {
+ lua_Unsigned i;
+ if (j == 0) j++; /* the caller ensures 'j + 1' is present */
+ do {
+ i = j; /* 'i' is a present index */
+ if (j <= l_castS2U(LUA_MAXINTEGER) / 2)
+ j *= 2;
+ else {
+ j = LUA_MAXINTEGER;
+ if (isempty(luaH_getint(t, j))) /* t[j] not present? */
+ break; /* 'j' now is an absent index */
+ else /* weird case */
+ return j; /* well, max integer is a boundary... */
+ }
+ } while (!isempty(luaH_getint(t, j))); /* repeat until an absent t[j] */
+ /* i < j && t[i] present && t[j] absent */
+ while (j - i > 1u) { /* do a binary search between them */
+ lua_Unsigned m = (i + j) / 2;
+ if (isempty(luaH_getint(t, m))) j = m;
+ else i = m;
+ }
+ return i;
+}
+
+
+static unsigned int binsearch (const TValue *array, unsigned int i,
+ unsigned int j) {
+ while (j - i > 1u) { /* binary search */
+ unsigned int m = (i + j) / 2;
+ if (isempty(&array[m - 1])) j = m;
+ else i = m;
+ }
+ return i;
+}
+
+
+/*
+** Try to find a boundary in table 't'. (A 'boundary' is an integer index
+** such that t[i] is present and t[i+1] is absent, or 0 if t[1] is absent
+** and 'maxinteger' if t[maxinteger] is present.)
+** (In the next explanation, we use Lua indices, that is, with base 1.
+** The code itself uses base 0 when indexing the array part of the table.)
+** The code starts with 'limit = t->alimit', a position in the array
+** part that may be a boundary.
+**
+** (1) If 't[limit]' is empty, there must be a boundary before it.
+** As a common case (e.g., after 't[#t]=nil'), check whether 'limit-1'
+** is present. If so, it is a boundary. Otherwise, do a binary search
+** between 0 and limit to find a boundary. In both cases, try to
+** use this boundary as the new 'alimit', as a hint for the next call.
+**
+** (2) If 't[limit]' is not empty and the array has more elements
+** after 'limit', try to find a boundary there. Again, try first
+** the special case (which should be quite frequent) where 'limit+1'
+** is empty, so that 'limit' is a boundary. Otherwise, check the
+** last element of the array part. If it is empty, there must be a
+** boundary between the old limit (present) and the last element
+** (absent), which is found with a binary search. (This boundary always
+** can be a new limit.)
+**
+** (3) The last case is when there are no elements in the array part
+** (limit == 0) or its last element (the new limit) is present.
+** In this case, must check the hash part. If there is no hash part
+** or 'limit+1' is absent, 'limit' is a boundary. Otherwise, call
+** 'hash_search' to find a boundary in the hash part of the table.
+** (In those cases, the boundary is not inside the array part, and
+** therefore cannot be used as a new limit.)
+*/
+lua_Unsigned luaH_getn (Table *t) {
+ unsigned int limit = t->alimit;
+ if (limit > 0 && isempty(&t->array[limit - 1])) { /* (1)? */
+ /* there must be a boundary before 'limit' */
+ if (limit >= 2 && !isempty(&t->array[limit - 2])) {
+ /* 'limit - 1' is a boundary; can it be a new limit? */
+ if (ispow2realasize(t) && !ispow2(limit - 1)) {
+ t->alimit = limit - 1;
+ setnorealasize(t); /* now 'alimit' is not the real size */
+ }
+ return limit - 1;
+ }
+ else { /* must search for a boundary in [0, limit] */
+ unsigned int boundary = binsearch(t->array, 0, limit);
+ /* can this boundary represent the real size of the array? */
+ if (ispow2realasize(t) && boundary > luaH_realasize(t) / 2) {
+ t->alimit = boundary; /* use it as the new limit */
+ setnorealasize(t);
+ }
+ return boundary;
+ }
+ }
+ /* 'limit' is zero or present in table */
+ if (!limitequalsasize(t)) { /* (2)? */
+ /* 'limit' > 0 and array has more elements after 'limit' */
+ if (isempty(&t->array[limit])) /* 'limit + 1' is empty? */
+ return limit; /* this is the boundary */
+ /* else, try last element in the array */
+ limit = luaH_realasize(t);
+ if (isempty(&t->array[limit - 1])) { /* empty? */
+ /* there must be a boundary in the array after old limit,
+ and it must be a valid new limit */
+ unsigned int boundary = binsearch(t->array, t->alimit, limit);
+ t->alimit = boundary;
+ return boundary;
+ }
+ /* else, new limit is present in the table; check the hash part */
+ }
+ /* (3) 'limit' is the last element and either is zero or present in table */
+ lua_assert(limit == luaH_realasize(t) &&
+ (limit == 0 || !isempty(&t->array[limit - 1])));
+ if (isdummy(t) || isempty(luaH_getint(t, cast(lua_Integer, limit + 1))))
+ return limit; /* 'limit + 1' is absent */
+ else /* 'limit + 1' is also present */
+ return hash_search(t, limit);
+}
+
+
+
+#if defined(LUA_DEBUG)
+
+/* export these functions for the test library */
+
+Node *luaH_mainposition (const Table *t, const TValue *key) {
+ return mainpositionTV(t, key);
+}
+
+int luaH_isdummy (const Table *t) { return isdummy(t); }
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/ltable.h b/source/luametatex/source/luacore/lua54/src/ltable.h
new file mode 100644
index 000000000..7bbbcb213
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ltable.h
@@ -0,0 +1,66 @@
+/*
+** $Id: ltable.h $
+** Lua tables (hash)
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ltable_h
+#define ltable_h
+
+#include "lobject.h"
+
+
+#define gnode(t,i) (&(t)->node[i])
+#define gval(n) (&(n)->i_val)
+#define gnext(n) ((n)->u.next)
+
+
+/*
+** Clear all bits of fast-access metamethods, which means that the table
+** may have any of these metamethods. (First access that fails after the
+** clearing will set the bit again.)
+*/
+#define invalidateTMcache(t) ((t)->flags &= ~maskflags)
+
+
+/* true when 't' is using 'dummynode' as its hash part */
+#define isdummy(t) ((t)->lastfree == NULL)
+
+
+/* allocated size for hash nodes */
+#define allocsizenode(t) (isdummy(t) ? 0 : sizenode(t))
+
+
+/* returns the Node, given the value of a table entry */
+#define nodefromval(v) cast(Node *, (v))
+
+
+LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key);
+LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key,
+ TValue *value);
+LUAI_FUNC const TValue *luaH_getshortstr (Table *t, TString *key);
+LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key);
+LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key);
+LUAI_FUNC void luaH_newkey (lua_State *L, Table *t, const TValue *key,
+ TValue *value);
+LUAI_FUNC void luaH_set (lua_State *L, Table *t, const TValue *key,
+ TValue *value);
+LUAI_FUNC void luaH_finishset (lua_State *L, Table *t, const TValue *key,
+ const TValue *slot, TValue *value);
+LUAI_FUNC Table *luaH_new (lua_State *L);
+LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned int nasize,
+ unsigned int nhsize);
+LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize);
+LUAI_FUNC void luaH_free (lua_State *L, Table *t);
+LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
+LUAI_FUNC lua_Unsigned luaH_getn (Table *t);
+LUAI_FUNC unsigned int luaH_realasize (const Table *t);
+
+
+#if defined(LUA_DEBUG)
+LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key);
+LUAI_FUNC int luaH_isdummy (const Table *t);
+#endif
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/ltablib.c b/source/luametatex/source/luacore/lua54/src/ltablib.c
new file mode 100644
index 000000000..e6bc4d04a
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ltablib.c
@@ -0,0 +1,430 @@
+/*
+** $Id: ltablib.c $
+** Library for Table Manipulation
+** See Copyright Notice in lua.h
+*/
+
+#define ltablib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <limits.h>
+#include <stddef.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/*
+** Operations that an object must define to mimic a table
+** (some functions only need some of them)
+*/
+#define TAB_R 1 /* read */
+#define TAB_W 2 /* write */
+#define TAB_L 4 /* length */
+#define TAB_RW (TAB_R | TAB_W) /* read/write */
+
+
+#define aux_getn(L,n,w) (checktab(L, n, (w) | TAB_L), luaL_len(L, n))
+
+
+static int checkfield (lua_State *L, const char *key, int n) {
+ lua_pushstring(L, key);
+ return (lua_rawget(L, -n) != LUA_TNIL);
+}
+
+
+/*
+** Check that 'arg' either is a table or can behave like one (that is,
+** has a metatable with the required metamethods)
+*/
+static void checktab (lua_State *L, int arg, int what) {
+ if (lua_type(L, arg) != LUA_TTABLE) { /* is it not a table? */
+ int n = 1; /* number of elements to pop */
+ if (lua_getmetatable(L, arg) && /* must have metatable */
+ (!(what & TAB_R) || checkfield(L, "__index", ++n)) &&
+ (!(what & TAB_W) || checkfield(L, "__newindex", ++n)) &&
+ (!(what & TAB_L) || checkfield(L, "__len", ++n))) {
+ lua_pop(L, n); /* pop metatable and tested metamethods */
+ }
+ else
+ luaL_checktype(L, arg, LUA_TTABLE); /* force an error */
+ }
+}
+
+
+static int tinsert (lua_State *L) {
+ lua_Integer pos; /* where to insert new element */
+ lua_Integer e = aux_getn(L, 1, TAB_RW);
+ e = luaL_intop(+, e, 1); /* first empty element */
+ switch (lua_gettop(L)) {
+ case 2: { /* called with only 2 arguments */
+ pos = e; /* insert new element at the end */
+ break;
+ }
+ case 3: {
+ lua_Integer i;
+ pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */
+ /* check whether 'pos' is in [1, e] */
+ luaL_argcheck(L, (lua_Unsigned)pos - 1u < (lua_Unsigned)e, 2,
+ "position out of bounds");
+ for (i = e; i > pos; i--) { /* move up elements */
+ lua_geti(L, 1, i - 1);
+ lua_seti(L, 1, i); /* t[i] = t[i - 1] */
+ }
+ break;
+ }
+ default: {
+ return luaL_error(L, "wrong number of arguments to 'insert'");
+ }
+ }
+ lua_seti(L, 1, pos); /* t[pos] = v */
+ return 0;
+}
+
+
+static int tremove (lua_State *L) {
+ lua_Integer size = aux_getn(L, 1, TAB_RW);
+ lua_Integer pos = luaL_optinteger(L, 2, size);
+ if (pos != size) /* validate 'pos' if given */
+ /* check whether 'pos' is in [1, size + 1] */
+ luaL_argcheck(L, (lua_Unsigned)pos - 1u <= (lua_Unsigned)size, 2,
+ "position out of bounds");
+ lua_geti(L, 1, pos); /* result = t[pos] */
+ for ( ; pos < size; pos++) {
+ lua_geti(L, 1, pos + 1);
+ lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */
+ }
+ lua_pushnil(L);
+ lua_seti(L, 1, pos); /* remove entry t[pos] */
+ return 1;
+}
+
+
+/*
+** Copy elements (1[f], ..., 1[e]) into (tt[t], tt[t+1], ...). Whenever
+** possible, copy in increasing order, which is better for rehashing.
+** "possible" means destination after original range, or smaller
+** than origin, or copying to another table.
+*/
+static int tmove (lua_State *L) {
+ lua_Integer f = luaL_checkinteger(L, 2);
+ lua_Integer e = luaL_checkinteger(L, 3);
+ lua_Integer t = luaL_checkinteger(L, 4);
+ int tt = !lua_isnoneornil(L, 5) ? 5 : 1; /* destination table */
+ checktab(L, 1, TAB_R);
+ checktab(L, tt, TAB_W);
+ if (e >= f) { /* otherwise, nothing to move */
+ lua_Integer n, i;
+ luaL_argcheck(L, f > 0 || e < LUA_MAXINTEGER + f, 3,
+ "too many elements to move");
+ n = e - f + 1; /* number of elements to move */
+ luaL_argcheck(L, t <= LUA_MAXINTEGER - n + 1, 4,
+ "destination wrap around");
+ if (t > e || t <= f || (tt != 1 && !lua_compare(L, 1, tt, LUA_OPEQ))) {
+ for (i = 0; i < n; i++) {
+ lua_geti(L, 1, f + i);
+ lua_seti(L, tt, t + i);
+ }
+ }
+ else {
+ for (i = n - 1; i >= 0; i--) {
+ lua_geti(L, 1, f + i);
+ lua_seti(L, tt, t + i);
+ }
+ }
+ }
+ lua_pushvalue(L, tt); /* return destination table */
+ return 1;
+}
+
+
+static void addfield (lua_State *L, luaL_Buffer *b, lua_Integer i) {
+ lua_geti(L, 1, i);
+ if (l_unlikely(!lua_isstring(L, -1)))
+ luaL_error(L, "invalid value (%s) at index %I in table for 'concat'",
+ luaL_typename(L, -1), (LUAI_UACINT)i);
+ luaL_addvalue(b);
+}
+
+
+static int tconcat (lua_State *L) {
+ luaL_Buffer b;
+ lua_Integer last = aux_getn(L, 1, TAB_R);
+ size_t lsep;
+ const char *sep = luaL_optlstring(L, 2, "", &lsep);
+ lua_Integer i = luaL_optinteger(L, 3, 1);
+ last = luaL_optinteger(L, 4, last);
+ luaL_buffinit(L, &b);
+ for (; i < last; i++) {
+ addfield(L, &b, i);
+ luaL_addlstring(&b, sep, lsep);
+ }
+ if (i == last) /* add last value (if interval was not empty) */
+ addfield(L, &b, i);
+ luaL_pushresult(&b);
+ return 1;
+}
+
+
+/*
+** {======================================================
+** Pack/unpack
+** =======================================================
+*/
+
+static int tpack (lua_State *L) {
+ int i;
+ int n = lua_gettop(L); /* number of elements to pack */
+ lua_createtable(L, n, 1); /* create result table */
+ lua_insert(L, 1); /* put it at index 1 */
+ for (i = n; i >= 1; i--) /* assign elements */
+ lua_seti(L, 1, i);
+ lua_pushinteger(L, n);
+ lua_setfield(L, 1, "n"); /* t.n = number of elements */
+ return 1; /* return table */
+}
+
+
+static int tunpack (lua_State *L) {
+ lua_Unsigned n;
+ lua_Integer i = luaL_optinteger(L, 2, 1);
+ lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1));
+ if (i > e) return 0; /* empty range */
+ n = (lua_Unsigned)e - i; /* number of elements minus 1 (avoid overflows) */
+ if (l_unlikely(n >= (unsigned int)INT_MAX ||
+ !lua_checkstack(L, (int)(++n))))
+ return luaL_error(L, "too many results to unpack");
+ for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */
+ lua_geti(L, 1, i);
+ }
+ lua_geti(L, 1, e); /* push last element */
+ return (int)n;
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** Quicksort
+** (based on 'Algorithms in MODULA-3', Robert Sedgewick;
+** Addison-Wesley, 1993.)
+** =======================================================
+*/
+
+
+/* type for array indices */
+typedef unsigned int IdxT;
+
+
+/*
+** Produce a "random" 'unsigned int' to randomize pivot choice. This
+** macro is used only when 'sort' detects a big imbalance in the result
+** of a partition. (If you don't want/need this "randomness", ~0 is a
+** good choice.)
+*/
+#if !defined(l_randomizePivot) /* { */
+
+#include <time.h>
+
+/* size of 'e' measured in number of 'unsigned int's */
+#define sof(e) (sizeof(e) / sizeof(unsigned int))
+
+/*
+** Use 'time' and 'clock' as sources of "randomness". Because we don't
+** know the types 'clock_t' and 'time_t', we cannot cast them to
+** anything without risking overflows. A safe way to use their values
+** is to copy them to an array of a known type and use the array values.
+*/
+static unsigned int l_randomizePivot (void) {
+ clock_t c = clock();
+ time_t t = time(NULL);
+ unsigned int buff[sof(c) + sof(t)];
+ unsigned int i, rnd = 0;
+ memcpy(buff, &c, sof(c) * sizeof(unsigned int));
+ memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int));
+ for (i = 0; i < sof(buff); i++)
+ rnd += buff[i];
+ return rnd;
+}
+
+#endif /* } */
+
+
+/* arrays larger than 'RANLIMIT' may use randomized pivots */
+#define RANLIMIT 100u
+
+
+static void set2 (lua_State *L, IdxT i, IdxT j) {
+ lua_seti(L, 1, i);
+ lua_seti(L, 1, j);
+}
+
+
+/*
+** Return true iff value at stack index 'a' is less than the value at
+** index 'b' (according to the order of the sort).
+*/
+static int sort_comp (lua_State *L, int a, int b) {
+ if (lua_isnil(L, 2)) /* no function? */
+ return lua_compare(L, a, b, LUA_OPLT); /* a < b */
+ else { /* function */
+ int res;
+ lua_pushvalue(L, 2); /* push function */
+ lua_pushvalue(L, a-1); /* -1 to compensate function */
+ lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */
+ lua_call(L, 2, 1); /* call function */
+ res = lua_toboolean(L, -1); /* get result */
+ lua_pop(L, 1); /* pop result */
+ return res;
+ }
+}
+
+
+/*
+** Does the partition: Pivot P is at the top of the stack.
+** precondition: a[lo] <= P == a[up-1] <= a[up],
+** so it only needs to do the partition from lo + 1 to up - 2.
+** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up]
+** returns 'i'.
+*/
+static IdxT partition (lua_State *L, IdxT lo, IdxT up) {
+ IdxT i = lo; /* will be incremented before first use */
+ IdxT j = up - 1; /* will be decremented before first use */
+ /* loop invariant: a[lo .. i] <= P <= a[j .. up] */
+ for (;;) {
+ /* next loop: repeat ++i while a[i] < P */
+ while ((void)lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) {
+ if (l_unlikely(i == up - 1)) /* a[i] < P but a[up - 1] == P ?? */
+ luaL_error(L, "invalid order function for sorting");
+ lua_pop(L, 1); /* remove a[i] */
+ }
+ /* after the loop, a[i] >= P and a[lo .. i - 1] < P */
+ /* next loop: repeat --j while P < a[j] */
+ while ((void)lua_geti(L, 1, --j), sort_comp(L, -3, -1)) {
+ if (l_unlikely(j < i)) /* j < i but a[j] > P ?? */
+ luaL_error(L, "invalid order function for sorting");
+ lua_pop(L, 1); /* remove a[j] */
+ }
+ /* after the loop, a[j] <= P and a[j + 1 .. up] >= P */
+ if (j < i) { /* no elements out of place? */
+ /* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */
+ lua_pop(L, 1); /* pop a[j] */
+ /* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */
+ set2(L, up - 1, i);
+ return i;
+ }
+ /* otherwise, swap a[i] - a[j] to restore invariant and repeat */
+ set2(L, i, j);
+ }
+}
+
+
+/*
+** Choose an element in the middle (2nd-3th quarters) of [lo,up]
+** "randomized" by 'rnd'
+*/
+static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) {
+ IdxT r4 = (up - lo) / 4; /* range/4 */
+ IdxT p = rnd % (r4 * 2) + (lo + r4);
+ lua_assert(lo + r4 <= p && p <= up - r4);
+ return p;
+}
+
+
+/*
+** Quicksort algorithm (recursive function)
+*/
+static void auxsort (lua_State *L, IdxT lo, IdxT up,
+ unsigned int rnd) {
+ while (lo < up) { /* loop for tail recursion */
+ IdxT p; /* Pivot index */
+ IdxT n; /* to be used later */
+ /* sort elements 'lo', 'p', and 'up' */
+ lua_geti(L, 1, lo);
+ lua_geti(L, 1, up);
+ if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */
+ set2(L, lo, up); /* swap a[lo] - a[up] */
+ else
+ lua_pop(L, 2); /* remove both values */
+ if (up - lo == 1) /* only 2 elements? */
+ return; /* already sorted */
+ if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */
+ p = (lo + up)/2; /* middle element is a good pivot */
+ else /* for larger intervals, it is worth a random pivot */
+ p = choosePivot(lo, up, rnd);
+ lua_geti(L, 1, p);
+ lua_geti(L, 1, lo);
+ if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */
+ set2(L, p, lo); /* swap a[p] - a[lo] */
+ else {
+ lua_pop(L, 1); /* remove a[lo] */
+ lua_geti(L, 1, up);
+ if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */
+ set2(L, p, up); /* swap a[up] - a[p] */
+ else
+ lua_pop(L, 2);
+ }
+ if (up - lo == 2) /* only 3 elements? */
+ return; /* already sorted */
+ lua_geti(L, 1, p); /* get middle element (Pivot) */
+ lua_pushvalue(L, -1); /* push Pivot */
+ lua_geti(L, 1, up - 1); /* push a[up - 1] */
+ set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */
+ p = partition(L, lo, up);
+ /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */
+ if (p - lo < up - p) { /* lower interval is smaller? */
+ auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */
+ n = p - lo; /* size of smaller interval */
+ lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */
+ }
+ else {
+ auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */
+ n = up - p; /* size of smaller interval */
+ up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */
+ }
+ if ((up - lo) / 128 > n) /* partition too imbalanced? */
+ rnd = l_randomizePivot(); /* try a new randomization */
+ } /* tail call auxsort(L, lo, up, rnd) */
+}
+
+
+static int sort (lua_State *L) {
+ lua_Integer n = aux_getn(L, 1, TAB_RW);
+ if (n > 1) { /* non-trivial interval? */
+ luaL_argcheck(L, n < INT_MAX, 1, "array too big");
+ if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
+ luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */
+ lua_settop(L, 2); /* make sure there are two arguments */
+ auxsort(L, 1, (IdxT)n, 0);
+ }
+ return 0;
+}
+
+/* }====================================================== */
+
+
+static const luaL_Reg tab_funcs[] = {
+ {"concat", tconcat},
+ {"insert", tinsert},
+ {"pack", tpack},
+ {"unpack", tunpack},
+ {"remove", tremove},
+ {"move", tmove},
+ {"sort", sort},
+ {NULL, NULL}
+};
+
+
+LUAMOD_API int luaopen_table (lua_State *L) {
+ luaL_newlib(L, tab_funcs);
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/ltm.c b/source/luametatex/source/luacore/lua54/src/ltm.c
new file mode 100644
index 000000000..b657b783a
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ltm.c
@@ -0,0 +1,271 @@
+/*
+** $Id: ltm.c $
+** Tag methods
+** See Copyright Notice in lua.h
+*/
+
+#define ltm_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <string.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lvm.h"
+
+
+static const char udatatypename[] = "userdata";
+
+LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTYPES] = {
+ "no value",
+ "nil", "boolean", udatatypename, "number",
+ "string", "table", "function", udatatypename, "thread",
+ "upvalue", "proto" /* these last cases are used for tests only */
+};
+
+
+void luaT_init (lua_State *L) {
+ static const char *const luaT_eventname[] = { /* ORDER TM */
+ "__index", "__newindex",
+ "__gc", "__mode", "__len", "__eq",
+ "__add", "__sub", "__mul", "__mod", "__pow",
+ "__div", "__idiv",
+ "__band", "__bor", "__bxor", "__shl", "__shr",
+ "__unm", "__bnot", "__lt", "__le",
+ "__concat", "__call", "__close"
+ };
+ int i;
+ for (i=0; i<TM_N; i++) {
+ G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
+ luaC_fix(L, obj2gco(G(L)->tmname[i])); /* never collect these names */
+ }
+}
+
+
+/*
+** function to be used with macro "fasttm": optimized for absence of
+** tag methods
+*/
+const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {
+ const TValue *tm = luaH_getshortstr(events, ename);
+ lua_assert(event <= TM_EQ);
+ if (notm(tm)) { /* no tag method? */
+ events->flags |= cast_byte(1u<<event); /* cache this fact */
+ return NULL;
+ }
+ else return tm;
+}
+
+
+const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
+ Table *mt;
+ switch (ttype(o)) {
+ case LUA_TTABLE:
+ mt = hvalue(o)->metatable;
+ break;
+ case LUA_TUSERDATA:
+ mt = uvalue(o)->metatable;
+ break;
+ default:
+ mt = G(L)->mt[ttype(o)];
+ }
+ return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue);
+}
+
+
+/*
+** Return the name of the type of an object. For tables and userdata
+** with metatable, use their '__name' metafield, if present.
+*/
+const char *luaT_objtypename (lua_State *L, const TValue *o) {
+ Table *mt;
+ if ((ttistable(o) && (mt = hvalue(o)->metatable) != NULL) ||
+ (ttisfulluserdata(o) && (mt = uvalue(o)->metatable) != NULL)) {
+ const TValue *name = luaH_getshortstr(mt, luaS_new(L, "__name"));
+ if (ttisstring(name)) /* is '__name' a string? */
+ return getstr(tsvalue(name)); /* use it as type name */
+ }
+ return ttypename(ttype(o)); /* else use standard type name */
+}
+
+
+void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
+ const TValue *p2, const TValue *p3) {
+ StkId func = L->top;
+ setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
+ setobj2s(L, func + 1, p1); /* 1st argument */
+ setobj2s(L, func + 2, p2); /* 2nd argument */
+ setobj2s(L, func + 3, p3); /* 3rd argument */
+ L->top = func + 4;
+ /* metamethod may yield only when called from Lua code */
+ if (isLuacode(L->ci))
+ luaD_call(L, func, 0);
+ else
+ luaD_callnoyield(L, func, 0);
+}
+
+
+void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
+ const TValue *p2, StkId res) {
+ ptrdiff_t result = savestack(L, res);
+ StkId func = L->top;
+ setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
+ setobj2s(L, func + 1, p1); /* 1st argument */
+ setobj2s(L, func + 2, p2); /* 2nd argument */
+ L->top += 3;
+ /* metamethod may yield only when called from Lua code */
+ if (isLuacode(L->ci))
+ luaD_call(L, func, 1);
+ else
+ luaD_callnoyield(L, func, 1);
+ res = restorestack(L, result);
+ setobjs2s(L, res, --L->top); /* move result to its place */
+}
+
+
+static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
+ StkId res, TMS event) {
+ const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */
+ if (notm(tm))
+ tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
+ if (notm(tm)) return 0;
+ luaT_callTMres(L, tm, p1, p2, res);
+ return 1;
+}
+
+
+void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
+ StkId res, TMS event) {
+ if (l_unlikely(!callbinTM(L, p1, p2, res, event))) {
+ switch (event) {
+ case TM_BAND: case TM_BOR: case TM_BXOR:
+ case TM_SHL: case TM_SHR: case TM_BNOT: {
+ if (ttisnumber(p1) && ttisnumber(p2))
+ luaG_tointerror(L, p1, p2);
+ else
+ luaG_opinterror(L, p1, p2, "perform bitwise operation on");
+ }
+ /* calls never return, but to avoid warnings: *//* FALLTHROUGH */
+ default:
+ luaG_opinterror(L, p1, p2, "perform arithmetic on");
+ }
+ }
+}
+
+
+void luaT_tryconcatTM (lua_State *L) {
+ StkId top = L->top;
+ if (l_unlikely(!callbinTM(L, s2v(top - 2), s2v(top - 1), top - 2,
+ TM_CONCAT)))
+ luaG_concaterror(L, s2v(top - 2), s2v(top - 1));
+}
+
+
+void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2,
+ int flip, StkId res, TMS event) {
+ if (flip)
+ luaT_trybinTM(L, p2, p1, res, event);
+ else
+ luaT_trybinTM(L, p1, p2, res, event);
+}
+
+
+void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
+ int flip, StkId res, TMS event) {
+ TValue aux;
+ setivalue(&aux, i2);
+ luaT_trybinassocTM(L, p1, &aux, flip, res, event);
+}
+
+
+/*
+** Calls an order tag method.
+** For lessequal, LUA_COMPAT_LT_LE keeps compatibility with old
+** behavior: if there is no '__le', try '__lt', based on l <= r iff
+** !(r < l) (assuming a total order). If the metamethod yields during
+** this substitution, the continuation has to know about it (to negate
+** the result of r<l); bit CIST_LEQ in the call status keeps that
+** information.
+*/
+int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
+ TMS event) {
+ if (callbinTM(L, p1, p2, L->top, event)) /* try original event */
+ return !l_isfalse(s2v(L->top));
+#if defined(LUA_COMPAT_LT_LE)
+ else if (event == TM_LE) {
+ /* try '!(p2 < p1)' for '(p1 <= p2)' */
+ L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */
+ if (callbinTM(L, p2, p1, L->top, TM_LT)) {
+ L->ci->callstatus ^= CIST_LEQ; /* clear mark */
+ return l_isfalse(s2v(L->top));
+ }
+ /* else error will remove this 'ci'; no need to clear mark */
+ }
+#endif
+ luaG_ordererror(L, p1, p2); /* no metamethod found */
+ return 0; /* to avoid warnings */
+}
+
+
+int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
+ int flip, int isfloat, TMS event) {
+ TValue aux; const TValue *p2;
+ if (isfloat) {
+ setfltvalue(&aux, cast_num(v2));
+ }
+ else
+ setivalue(&aux, v2);
+ if (flip) { /* arguments were exchanged? */
+ p2 = p1; p1 = &aux; /* correct them */
+ }
+ else
+ p2 = &aux;
+ return luaT_callorderTM(L, p1, p2, event);
+}
+
+
+void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci,
+ const Proto *p) {
+ int i;
+ int actual = cast_int(L->top - ci->func) - 1; /* number of arguments */
+ int nextra = actual - nfixparams; /* number of extra arguments */
+ ci->u.l.nextraargs = nextra;
+ luaD_checkstack(L, p->maxstacksize + 1);
+ /* copy function to the top of the stack */
+ setobjs2s(L, L->top++, ci->func);
+ /* move fixed parameters to the top of the stack */
+ for (i = 1; i <= nfixparams; i++) {
+ setobjs2s(L, L->top++, ci->func + i);
+ setnilvalue(s2v(ci->func + i)); /* erase original parameter (for GC) */
+ }
+ ci->func += actual + 1;
+ ci->top += actual + 1;
+ lua_assert(L->top <= ci->top && ci->top <= L->stack_last);
+}
+
+
+void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) {
+ int i;
+ int nextra = ci->u.l.nextraargs;
+ if (wanted < 0) {
+ wanted = nextra; /* get all extra arguments available */
+ checkstackGCp(L, nextra, where); /* ensure stack space */
+ L->top = where + nextra; /* next instruction will need top */
+ }
+ for (i = 0; i < wanted && i < nextra; i++)
+ setobjs2s(L, where + i, ci->func - nextra + i);
+ for (; i < wanted; i++) /* complete required results with nil */
+ setnilvalue(s2v(where + i));
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/ltm.h b/source/luametatex/source/luacore/lua54/src/ltm.h
new file mode 100644
index 000000000..73b833c60
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/ltm.h
@@ -0,0 +1,103 @@
+/*
+** $Id: ltm.h $
+** Tag methods
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ltm_h
+#define ltm_h
+
+
+#include "lobject.h"
+
+
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER TM" and "ORDER OP"
+*/
+typedef enum {
+ TM_INDEX,
+ TM_NEWINDEX,
+ TM_GC,
+ TM_MODE,
+ TM_LEN,
+ TM_EQ, /* last tag method with fast access */
+ TM_ADD,
+ TM_SUB,
+ TM_MUL,
+ TM_MOD,
+ TM_POW,
+ TM_DIV,
+ TM_IDIV,
+ TM_BAND,
+ TM_BOR,
+ TM_BXOR,
+ TM_SHL,
+ TM_SHR,
+ TM_UNM,
+ TM_BNOT,
+ TM_LT,
+ TM_LE,
+ TM_CONCAT,
+ TM_CALL,
+ TM_CLOSE,
+ TM_N /* number of elements in the enum */
+} TMS;
+
+
+/*
+** Mask with 1 in all fast-access methods. A 1 in any of these bits
+** in the flag of a (meta)table means the metatable does not have the
+** corresponding metamethod field. (Bit 7 of the flag is used for
+** 'isrealasize'.)
+*/
+#define maskflags (~(~0u << (TM_EQ + 1)))
+
+
+/*
+** Test whether there is no tagmethod.
+** (Because tagmethods use raw accesses, the result may be an "empty" nil.)
+*/
+#define notm(tm) ttisnil(tm)
+
+
+#define gfasttm(g,et,e) ((et) == NULL ? NULL : \
+ ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
+
+#define fasttm(l,et,e) gfasttm(G(l), et, e)
+
+#define ttypename(x) luaT_typenames_[(x) + 1]
+
+LUAI_DDEC(const char *const luaT_typenames_[LUA_TOTALTYPES];)
+
+
+LUAI_FUNC const char *luaT_objtypename (lua_State *L, const TValue *o);
+
+LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename);
+LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o,
+ TMS event);
+LUAI_FUNC void luaT_init (lua_State *L);
+
+LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
+ const TValue *p2, const TValue *p3);
+LUAI_FUNC void luaT_callTMres (lua_State *L, const TValue *f,
+ const TValue *p1, const TValue *p2, StkId p3);
+LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
+ StkId res, TMS event);
+LUAI_FUNC void luaT_tryconcatTM (lua_State *L);
+LUAI_FUNC void luaT_trybinassocTM (lua_State *L, const TValue *p1,
+ const TValue *p2, int inv, StkId res, TMS event);
+LUAI_FUNC void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
+ int inv, StkId res, TMS event);
+LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1,
+ const TValue *p2, TMS event);
+LUAI_FUNC int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
+ int inv, int isfloat, TMS event);
+
+LUAI_FUNC void luaT_adjustvarargs (lua_State *L, int nfixparams,
+ struct CallInfo *ci, const Proto *p);
+LUAI_FUNC void luaT_getvarargs (lua_State *L, struct CallInfo *ci,
+ StkId where, int wanted);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lua.c b/source/luametatex/source/luacore/lua54/src/lua.c
new file mode 100644
index 000000000..7f7dc2b22
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lua.c
@@ -0,0 +1,677 @@
+/*
+** $Id: lua.c $
+** Lua stand-alone interpreter
+** See Copyright Notice in lua.h
+*/
+
+#define lua_c
+
+#include "lprefix.h"
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <signal.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+#if !defined(LUA_PROGNAME)
+#define LUA_PROGNAME "lua"
+#endif
+
+#if !defined(LUA_INIT_VAR)
+#define LUA_INIT_VAR "LUA_INIT"
+#endif
+
+#define LUA_INITVARVERSION LUA_INIT_VAR LUA_VERSUFFIX
+
+
+static lua_State *globalL = NULL;
+
+static const char *progname = LUA_PROGNAME;
+
+
+#if defined(LUA_USE_POSIX) /* { */
+
+/*
+** Use 'sigaction' when available.
+*/
+static void setsignal (int sig, void (*handler)(int)) {
+ struct sigaction sa;
+ sa.sa_handler = handler;
+ sa.sa_flags = 0;
+ sigemptyset(&sa.sa_mask); /* do not mask any signal */
+ sigaction(sig, &sa, NULL);
+}
+
+#else /* }{ */
+
+#define setsignal signal
+
+#endif /* } */
+
+
+/*
+** Hook set by signal function to stop the interpreter.
+*/
+static void lstop (lua_State *L, lua_Debug *ar) {
+ (void)ar; /* unused arg. */
+ lua_sethook(L, NULL, 0, 0); /* reset hook */
+ luaL_error(L, "interrupted!");
+}
+
+
+/*
+** Function to be called at a C signal. Because a C signal cannot
+** just change a Lua state (as there is no proper synchronization),
+** this function only sets a hook that, when called, will stop the
+** interpreter.
+*/
+static void laction (int i) {
+ int flag = LUA_MASKCALL | LUA_MASKRET | LUA_MASKLINE | LUA_MASKCOUNT;
+ setsignal(i, SIG_DFL); /* if another SIGINT happens, terminate process */
+ lua_sethook(globalL, lstop, flag, 1);
+}
+
+
+static void print_usage (const char *badoption) {
+ lua_writestringerror("%s: ", progname);
+ if (badoption[1] == 'e' || badoption[1] == 'l')
+ lua_writestringerror("'%s' needs argument\n", badoption);
+ else
+ lua_writestringerror("unrecognized option '%s'\n", badoption);
+ lua_writestringerror(
+ "usage: %s [options] [script [args]]\n"
+ "Available options are:\n"
+ " -e stat execute string 'stat'\n"
+ " -i enter interactive mode after executing 'script'\n"
+ " -l mod require library 'mod' into global 'mod'\n"
+ " -l g=mod require library 'mod' into global 'g'\n"
+ " -v show version information\n"
+ " -E ignore environment variables\n"
+ " -W turn warnings on\n"
+ " -- stop handling options\n"
+ " - stop handling options and execute stdin\n"
+ ,
+ progname);
+}
+
+
+/*
+** Prints an error message, adding the program name in front of it
+** (if present)
+*/
+static void l_message (const char *pname, const char *msg) {
+ if (pname) lua_writestringerror("%s: ", pname);
+ lua_writestringerror("%s\n", msg);
+}
+
+
+/*
+** Check whether 'status' is not OK and, if so, prints the error
+** message on the top of the stack. It assumes that the error object
+** is a string, as it was either generated by Lua or by 'msghandler'.
+*/
+static int report (lua_State *L, int status) {
+ if (status != LUA_OK) {
+ const char *msg = lua_tostring(L, -1);
+ l_message(progname, msg);
+ lua_pop(L, 1); /* remove message */
+ }
+ return status;
+}
+
+
+/*
+** Message handler used to run all chunks
+*/
+static int msghandler (lua_State *L) {
+ const char *msg = lua_tostring(L, 1);
+ if (msg == NULL) { /* is error object not a string? */
+ if (luaL_callmeta(L, 1, "__tostring") && /* does it have a metamethod */
+ lua_type(L, -1) == LUA_TSTRING) /* that produces a string? */
+ return 1; /* that is the message */
+ else
+ msg = lua_pushfstring(L, "(error object is a %s value)",
+ luaL_typename(L, 1));
+ }
+ luaL_traceback(L, L, msg, 1); /* append a standard traceback */
+ return 1; /* return the traceback */
+}
+
+
+/*
+** Interface to 'lua_pcall', which sets appropriate message function
+** and C-signal handler. Used to run all chunks.
+*/
+static int docall (lua_State *L, int narg, int nres) {
+ int status;
+ int base = lua_gettop(L) - narg; /* function index */
+ lua_pushcfunction(L, msghandler); /* push message handler */
+ lua_insert(L, base); /* put it under function and args */
+ globalL = L; /* to be available to 'laction' */
+ setsignal(SIGINT, laction); /* set C-signal handler */
+ status = lua_pcall(L, narg, nres, base);
+ setsignal(SIGINT, SIG_DFL); /* reset C-signal handler */
+ lua_remove(L, base); /* remove message handler from the stack */
+ return status;
+}
+
+
+static void print_version (void) {
+ lua_writestring(LUA_COPYRIGHT, strlen(LUA_COPYRIGHT));
+ lua_writeline();
+}
+
+
+/*
+** Create the 'arg' table, which stores all arguments from the
+** command line ('argv'). It should be aligned so that, at index 0,
+** it has 'argv[script]', which is the script name. The arguments
+** to the script (everything after 'script') go to positive indices;
+** other arguments (before the script name) go to negative indices.
+** If there is no script name, assume interpreter's name as base.
+** (If there is no interpreter's name either, 'script' is -1, so
+** table sizes are zero.)
+*/
+static void createargtable (lua_State *L, char **argv, int argc, int script) {
+ int i, narg;
+ narg = argc - (script + 1); /* number of positive indices */
+ lua_createtable(L, narg, script + 1);
+ for (i = 0; i < argc; i++) {
+ lua_pushstring(L, argv[i]);
+ lua_rawseti(L, -2, i - script);
+ }
+ lua_setglobal(L, "arg");
+}
+
+
+static int dochunk (lua_State *L, int status) {
+ if (status == LUA_OK) status = docall(L, 0, 0);
+ return report(L, status);
+}
+
+
+static int dofile (lua_State *L, const char *name) {
+ return dochunk(L, luaL_loadfile(L, name));
+}
+
+
+static int dostring (lua_State *L, const char *s, const char *name) {
+ return dochunk(L, luaL_loadbuffer(L, s, strlen(s), name));
+}
+
+
+/*
+** Receives 'globname[=modname]' and runs 'globname = require(modname)'.
+*/
+static int dolibrary (lua_State *L, char *globname) {
+ int status;
+ char *modname = strchr(globname, '=');
+ if (modname == NULL) /* no explicit name? */
+ modname = globname; /* module name is equal to global name */
+ else {
+ *modname = '\0'; /* global name ends here */
+ modname++; /* module name starts after the '=' */
+ }
+ lua_getglobal(L, "require");
+ lua_pushstring(L, modname);
+ status = docall(L, 1, 1); /* call 'require(modname)' */
+ if (status == LUA_OK)
+ lua_setglobal(L, globname); /* globname = require(modname) */
+ return report(L, status);
+}
+
+
+/*
+** Push on the stack the contents of table 'arg' from 1 to #arg
+*/
+static int pushargs (lua_State *L) {
+ int i, n;
+ if (lua_getglobal(L, "arg") != LUA_TTABLE)
+ luaL_error(L, "'arg' is not a table");
+ n = (int)luaL_len(L, -1);
+ luaL_checkstack(L, n + 3, "too many arguments to script");
+ for (i = 1; i <= n; i++)
+ lua_rawgeti(L, -i, i);
+ lua_remove(L, -i); /* remove table from the stack */
+ return n;
+}
+
+
+static int handle_script (lua_State *L, char **argv) {
+ int status;
+ const char *fname = argv[0];
+ if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
+ fname = NULL; /* stdin */
+ status = luaL_loadfile(L, fname);
+ if (status == LUA_OK) {
+ int n = pushargs(L); /* push arguments to script */
+ status = docall(L, n, LUA_MULTRET);
+ }
+ return report(L, status);
+}
+
+
+/* bits of various argument indicators in 'args' */
+#define has_error 1 /* bad option */
+#define has_i 2 /* -i */
+#define has_v 4 /* -v */
+#define has_e 8 /* -e */
+#define has_E 16 /* -E */
+
+
+/*
+** Traverses all arguments from 'argv', returning a mask with those
+** needed before running any Lua code or an error code if it finds any
+** invalid argument. In case of error, 'first' is the index of the bad
+** argument. Otherwise, 'first' is -1 if there is no program name,
+** 0 if there is no script name, or the index of the script name.
+*/
+static int collectargs (char **argv, int *first) {
+ int args = 0;
+ int i;
+ if (argv[0] != NULL) { /* is there a program name? */
+ if (argv[0][0]) /* not empty? */
+ progname = argv[0]; /* save it */
+ }
+ else { /* no program name */
+ *first = -1;
+ return 0;
+ }
+ for (i = 1; argv[i] != NULL; i++) { /* handle arguments */
+ *first = i;
+ if (argv[i][0] != '-') /* not an option? */
+ return args; /* stop handling options */
+ switch (argv[i][1]) { /* else check option */
+ case '-': /* '--' */
+ if (argv[i][2] != '\0') /* extra characters after '--'? */
+ return has_error; /* invalid option */
+ *first = i + 1;
+ return args;
+ case '\0': /* '-' */
+ return args; /* script "name" is '-' */
+ case 'E':
+ if (argv[i][2] != '\0') /* extra characters? */
+ return has_error; /* invalid option */
+ args |= has_E;
+ break;
+ case 'W':
+ if (argv[i][2] != '\0') /* extra characters? */
+ return has_error; /* invalid option */
+ break;
+ case 'i':
+ args |= has_i; /* (-i implies -v) *//* FALLTHROUGH */
+ case 'v':
+ if (argv[i][2] != '\0') /* extra characters? */
+ return has_error; /* invalid option */
+ args |= has_v;
+ break;
+ case 'e':
+ args |= has_e; /* FALLTHROUGH */
+ case 'l': /* both options need an argument */
+ if (argv[i][2] == '\0') { /* no concatenated argument? */
+ i++; /* try next 'argv' */
+ if (argv[i] == NULL || argv[i][0] == '-')
+ return has_error; /* no next argument or it is another option */
+ }
+ break;
+ default: /* invalid option */
+ return has_error;
+ }
+ }
+ *first = 0; /* no script name */
+ return args;
+}
+
+
+/*
+** Processes options 'e' and 'l', which involve running Lua code, and
+** 'W', which also affects the state.
+** Returns 0 if some code raises an error.
+*/
+static int runargs (lua_State *L, char **argv, int n) {
+ int i;
+ for (i = 1; i < n; i++) {
+ int option = argv[i][1];
+ lua_assert(argv[i][0] == '-'); /* already checked */
+ switch (option) {
+ case 'e': case 'l': {
+ int status;
+ char *extra = argv[i] + 2; /* both options need an argument */
+ if (*extra == '\0') extra = argv[++i];
+ lua_assert(extra != NULL);
+ status = (option == 'e')
+ ? dostring(L, extra, "=(command line)")
+ : dolibrary(L, extra);
+ if (status != LUA_OK) return 0;
+ break;
+ }
+ case 'W':
+ lua_warning(L, "@on", 0); /* warnings on */
+ break;
+ }
+ }
+ return 1;
+}
+
+
+static int handle_luainit (lua_State *L) {
+ const char *name = "=" LUA_INITVARVERSION;
+ const char *init = getenv(name + 1);
+ if (init == NULL) {
+ name = "=" LUA_INIT_VAR;
+ init = getenv(name + 1); /* try alternative name */
+ }
+ if (init == NULL) return LUA_OK;
+ else if (init[0] == '@')
+ return dofile(L, init+1);
+ else
+ return dostring(L, init, name);
+}
+
+
+/*
+** {==================================================================
+** Read-Eval-Print Loop (REPL)
+** ===================================================================
+*/
+
+#if !defined(LUA_PROMPT)
+#define LUA_PROMPT "> "
+#define LUA_PROMPT2 ">> "
+#endif
+
+#if !defined(LUA_MAXINPUT)
+#define LUA_MAXINPUT 512
+#endif
+
+
+/*
+** lua_stdin_is_tty detects whether the standard input is a 'tty' (that
+** is, whether we're running lua interactively).
+*/
+#if !defined(lua_stdin_is_tty) /* { */
+
+#if defined(LUA_USE_POSIX) /* { */
+
+#include <unistd.h>
+#define lua_stdin_is_tty() isatty(0)
+
+#elif defined(LUA_USE_WINDOWS) /* }{ */
+
+#include <io.h>
+#include <windows.h>
+
+#define lua_stdin_is_tty() _isatty(_fileno(stdin))
+
+#else /* }{ */
+
+/* ISO C definition */
+#define lua_stdin_is_tty() 1 /* assume stdin is a tty */
+
+#endif /* } */
+
+#endif /* } */
+
+
+/*
+** lua_readline defines how to show a prompt and then read a line from
+** the standard input.
+** lua_saveline defines how to "save" a read line in a "history".
+** lua_freeline defines how to free a line read by lua_readline.
+*/
+#if !defined(lua_readline) /* { */
+
+#if defined(LUA_USE_READLINE) /* { */
+
+#include <readline/readline.h>
+#include <readline/history.h>
+#define lua_initreadline(L) ((void)L, rl_readline_name="lua")
+#define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL)
+#define lua_saveline(L,line) ((void)L, add_history(line))
+#define lua_freeline(L,b) ((void)L, free(b))
+
+#else /* }{ */
+
+#define lua_initreadline(L) ((void)L)
+#define lua_readline(L,b,p) \
+ ((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \
+ fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */
+#define lua_saveline(L,line) { (void)L; (void)line; }
+#define lua_freeline(L,b) { (void)L; (void)b; }
+
+#endif /* } */
+
+#endif /* } */
+
+
+/*
+** Return the string to be used as a prompt by the interpreter. Leave
+** the string (or nil, if using the default value) on the stack, to keep
+** it anchored.
+*/
+static const char *get_prompt (lua_State *L, int firstline) {
+ if (lua_getglobal(L, firstline ? "_PROMPT" : "_PROMPT2") == LUA_TNIL)
+ return (firstline ? LUA_PROMPT : LUA_PROMPT2); /* use the default */
+ else { /* apply 'tostring' over the value */
+ const char *p = luaL_tolstring(L, -1, NULL);
+ lua_remove(L, -2); /* remove original value */
+ return p;
+ }
+}
+
+/* mark in error messages for incomplete statements */
+#define EOFMARK "<eof>"
+#define marklen (sizeof(EOFMARK)/sizeof(char) - 1)
+
+
+/*
+** Check whether 'status' signals a syntax error and the error
+** message at the top of the stack ends with the above mark for
+** incomplete statements.
+*/
+static int incomplete (lua_State *L, int status) {
+ if (status == LUA_ERRSYNTAX) {
+ size_t lmsg;
+ const char *msg = lua_tolstring(L, -1, &lmsg);
+ if (lmsg >= marklen && strcmp(msg + lmsg - marklen, EOFMARK) == 0) {
+ lua_pop(L, 1);
+ return 1;
+ }
+ }
+ return 0; /* else... */
+}
+
+
+/*
+** Prompt the user, read a line, and push it into the Lua stack.
+*/
+static int pushline (lua_State *L, int firstline) {
+ char buffer[LUA_MAXINPUT];
+ char *b = buffer;
+ size_t l;
+ const char *prmt = get_prompt(L, firstline);
+ int readstatus = lua_readline(L, b, prmt);
+ if (readstatus == 0)
+ return 0; /* no input (prompt will be popped by caller) */
+ lua_pop(L, 1); /* remove prompt */
+ l = strlen(b);
+ if (l > 0 && b[l-1] == '\n') /* line ends with newline? */
+ b[--l] = '\0'; /* remove it */
+ if (firstline && b[0] == '=') /* for compatibility with 5.2, ... */
+ lua_pushfstring(L, "return %s", b + 1); /* change '=' to 'return' */
+ else
+ lua_pushlstring(L, b, l);
+ lua_freeline(L, b);
+ return 1;
+}
+
+
+/*
+** Try to compile line on the stack as 'return <line>;'; on return, stack
+** has either compiled chunk or original line (if compilation failed).
+*/
+static int addreturn (lua_State *L) {
+ const char *line = lua_tostring(L, -1); /* original line */
+ const char *retline = lua_pushfstring(L, "return %s;", line);
+ int status = luaL_loadbuffer(L, retline, strlen(retline), "=stdin");
+ if (status == LUA_OK) {
+ lua_remove(L, -2); /* remove modified line */
+ if (line[0] != '\0') /* non empty? */
+ lua_saveline(L, line); /* keep history */
+ }
+ else
+ lua_pop(L, 2); /* pop result from 'luaL_loadbuffer' and modified line */
+ return status;
+}
+
+
+/*
+** Read multiple lines until a complete Lua statement
+*/
+static int multiline (lua_State *L) {
+ for (;;) { /* repeat until gets a complete statement */
+ size_t len;
+ const char *line = lua_tolstring(L, 1, &len); /* get what it has */
+ int status = luaL_loadbuffer(L, line, len, "=stdin"); /* try it */
+ if (!incomplete(L, status) || !pushline(L, 0)) {
+ lua_saveline(L, line); /* keep history */
+ return status; /* cannot or should not try to add continuation line */
+ }
+ lua_pushliteral(L, "\n"); /* add newline... */
+ lua_insert(L, -2); /* ...between the two lines */
+ lua_concat(L, 3); /* join them */
+ }
+}
+
+
+/*
+** Read a line and try to load (compile) it first as an expression (by
+** adding "return " in front of it) and second as a statement. Return
+** the final status of load/call with the resulting function (if any)
+** in the top of the stack.
+*/
+static int loadline (lua_State *L) {
+ int status;
+ lua_settop(L, 0);
+ if (!pushline(L, 1))
+ return -1; /* no input */
+ if ((status = addreturn(L)) != LUA_OK) /* 'return ...' did not work? */
+ status = multiline(L); /* try as command, maybe with continuation lines */
+ lua_remove(L, 1); /* remove line from the stack */
+ lua_assert(lua_gettop(L) == 1);
+ return status;
+}
+
+
+/*
+** Prints (calling the Lua 'print' function) any values on the stack
+*/
+static void l_print (lua_State *L) {
+ int n = lua_gettop(L);
+ if (n > 0) { /* any result to be printed? */
+ luaL_checkstack(L, LUA_MINSTACK, "too many results to print");
+ lua_getglobal(L, "print");
+ lua_insert(L, 1);
+ if (lua_pcall(L, n, 0, 0) != LUA_OK)
+ l_message(progname, lua_pushfstring(L, "error calling 'print' (%s)",
+ lua_tostring(L, -1)));
+ }
+}
+
+
+/*
+** Do the REPL: repeatedly read (load) a line, evaluate (call) it, and
+** print any results.
+*/
+static void doREPL (lua_State *L) {
+ int status;
+ const char *oldprogname = progname;
+ progname = NULL; /* no 'progname' on errors in interactive mode */
+ lua_initreadline(L);
+ while ((status = loadline(L)) != -1) {
+ if (status == LUA_OK)
+ status = docall(L, 0, LUA_MULTRET);
+ if (status == LUA_OK) l_print(L);
+ else report(L, status);
+ }
+ lua_settop(L, 0); /* clear stack */
+ lua_writeline();
+ progname = oldprogname;
+}
+
+/* }================================================================== */
+
+
+/*
+** Main body of stand-alone interpreter (to be called in protected mode).
+** Reads the options and handles them all.
+*/
+static int pmain (lua_State *L) {
+ int argc = (int)lua_tointeger(L, 1);
+ char **argv = (char **)lua_touserdata(L, 2);
+ int script;
+ int args = collectargs(argv, &script);
+ int optlim = (script > 0) ? script : argc; /* first argv not an option */
+ luaL_checkversion(L); /* check that interpreter has correct version */
+ if (args == has_error) { /* bad arg? */
+ print_usage(argv[script]); /* 'script' has index of bad arg. */
+ return 0;
+ }
+ if (args & has_v) /* option '-v'? */
+ print_version();
+ if (args & has_E) { /* option '-E'? */
+ lua_pushboolean(L, 1); /* signal for libraries to ignore env. vars. */
+ lua_setfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
+ }
+ luaL_openlibs(L); /* open standard libraries */
+ createargtable(L, argv, argc, script); /* create table 'arg' */
+ lua_gc(L, LUA_GCGEN, 0, 0); /* GC in generational mode */
+ if (!(args & has_E)) { /* no option '-E'? */
+ if (handle_luainit(L) != LUA_OK) /* run LUA_INIT */
+ return 0; /* error running LUA_INIT */
+ }
+ if (!runargs(L, argv, optlim)) /* execute arguments -e and -l */
+ return 0; /* something failed */
+ if (script > 0) { /* execute main script (if there is one) */
+ if (handle_script(L, argv + script) != LUA_OK)
+ return 0; /* interrupt in case of error */
+ }
+ if (args & has_i) /* -i option? */
+ doREPL(L); /* do read-eval-print loop */
+ else if (script < 1 && !(args & (has_e | has_v))) { /* no active option? */
+ if (lua_stdin_is_tty()) { /* running in interactive mode? */
+ print_version();
+ doREPL(L); /* do read-eval-print loop */
+ }
+ else dofile(L, NULL); /* executes stdin as a file */
+ }
+ lua_pushboolean(L, 1); /* signal no errors */
+ return 1;
+}
+
+
+int main (int argc, char **argv) {
+ int status, result;
+ lua_State *L = luaL_newstate(); /* create state */
+ if (L == NULL) {
+ l_message(argv[0], "cannot create state: not enough memory");
+ return EXIT_FAILURE;
+ }
+ lua_pushcfunction(L, &pmain); /* to call 'pmain' in protected mode */
+ lua_pushinteger(L, argc); /* 1st argument */
+ lua_pushlightuserdata(L, argv); /* 2nd argument */
+ status = lua_pcall(L, 2, 1, 0); /* do the call */
+ result = lua_toboolean(L, -1); /* get result */
+ report(L, status);
+ lua_close(L);
+ return (result && status == LUA_OK) ? EXIT_SUCCESS : EXIT_FAILURE;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lua.h b/source/luametatex/source/luacore/lua54/src/lua.h
new file mode 100644
index 000000000..219784cc0
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lua.h
@@ -0,0 +1,518 @@
+/*
+** $Id: lua.h $
+** Lua - A Scripting Language
+** Lua.org, PUC-Rio, Brazil (http://www.lua.org)
+** See Copyright Notice at the end of this file
+*/
+
+
+#ifndef lua_h
+#define lua_h
+
+#include <stdarg.h>
+#include <stddef.h>
+
+
+#include "luaconf.h"
+
+
+#define LUA_VERSION_MAJOR "5"
+#define LUA_VERSION_MINOR "4"
+#define LUA_VERSION_RELEASE "5"
+
+#define LUA_VERSION_NUM 504
+#define LUA_VERSION_RELEASE_NUM (LUA_VERSION_NUM * 100 + 5)
+
+#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
+#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE
+#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2022 Lua.org, PUC-Rio"
+#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes"
+
+
+/* mark for precompiled code ('<esc>Lua') */
+#define LUA_SIGNATURE "\x1bLua"
+
+/* option for multiple returns in 'lua_pcall' and 'lua_call' */
+#define LUA_MULTRET (-1)
+
+
+/*
+** Pseudo-indices
+** (-LUAI_MAXSTACK is the minimum valid index; we keep some free empty
+** space after that to help overflow detection)
+*/
+#define LUA_REGISTRYINDEX (-LUAI_MAXSTACK - 1000)
+#define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i))
+
+
+/* thread status */
+#define LUA_OK 0
+#define LUA_YIELD 1
+#define LUA_ERRRUN 2
+#define LUA_ERRSYNTAX 3
+#define LUA_ERRMEM 4
+#define LUA_ERRERR 5
+
+
+typedef struct lua_State lua_State;
+
+
+/*
+** basic types
+*/
+#define LUA_TNONE (-1)
+
+#define LUA_TNIL 0
+#define LUA_TBOOLEAN 1
+#define LUA_TLIGHTUSERDATA 2
+#define LUA_TNUMBER 3
+#define LUA_TSTRING 4
+#define LUA_TTABLE 5
+#define LUA_TFUNCTION 6
+#define LUA_TUSERDATA 7
+#define LUA_TTHREAD 8
+
+#define LUA_NUMTYPES 9
+
+
+
+/* minimum Lua stack available to a C function */
+#define LUA_MINSTACK 20
+
+
+/* predefined values in the registry */
+#define LUA_RIDX_MAINTHREAD 1
+#define LUA_RIDX_GLOBALS 2
+#define LUA_RIDX_LAST LUA_RIDX_GLOBALS
+
+
+/* type of numbers in Lua */
+typedef LUA_NUMBER lua_Number;
+
+
+/* type for integer functions */
+typedef LUA_INTEGER lua_Integer;
+
+/* unsigned integer type */
+typedef LUA_UNSIGNED lua_Unsigned;
+
+/* type for continuation-function contexts */
+typedef LUA_KCONTEXT lua_KContext;
+
+
+/*
+** Type for C functions registered with Lua
+*/
+typedef int (*lua_CFunction) (lua_State *L);
+
+/*
+** Type for continuation functions
+*/
+typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx);
+
+
+/*
+** Type for functions that read/write blocks when loading/dumping Lua chunks
+*/
+typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz);
+
+typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud);
+
+
+/*
+** Type for memory-allocation functions
+*/
+typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);
+
+
+/*
+** Type for warning functions
+*/
+typedef void (*lua_WarnFunction) (void *ud, const char *msg, int tocont);
+
+
+
+
+/*
+** generic extra include file
+*/
+#if defined(LUA_USER_H)
+#include LUA_USER_H
+#endif
+
+
+/*
+** RCS ident string
+*/
+extern const char lua_ident[];
+
+
+/*
+** state manipulation
+*/
+LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud);
+LUA_API void (lua_close) (lua_State *L);
+LUA_API lua_State *(lua_newthread) (lua_State *L);
+LUA_API int (lua_resetthread) (lua_State *L);
+
+LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf);
+
+
+LUA_API lua_Number (lua_version) (lua_State *L);
+
+
+/*
+** basic stack manipulation
+*/
+LUA_API int (lua_absindex) (lua_State *L, int idx);
+LUA_API int (lua_gettop) (lua_State *L);
+LUA_API void (lua_settop) (lua_State *L, int idx);
+LUA_API void (lua_pushvalue) (lua_State *L, int idx);
+LUA_API void (lua_rotate) (lua_State *L, int idx, int n);
+LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx);
+LUA_API int (lua_checkstack) (lua_State *L, int n);
+
+LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n);
+
+
+/*
+** access functions (stack -> C)
+*/
+
+LUA_API int (lua_isnumber) (lua_State *L, int idx);
+LUA_API int (lua_isstring) (lua_State *L, int idx);
+LUA_API int (lua_iscfunction) (lua_State *L, int idx);
+LUA_API int (lua_isinteger) (lua_State *L, int idx);
+LUA_API int (lua_isuserdata) (lua_State *L, int idx);
+LUA_API int (lua_type) (lua_State *L, int idx);
+LUA_API const char *(lua_typename) (lua_State *L, int tp);
+
+LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum);
+LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum);
+LUA_API int (lua_toboolean) (lua_State *L, int idx);
+LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len);
+LUA_API lua_Unsigned (lua_rawlen) (lua_State *L, int idx);
+LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx);
+LUA_API void *(lua_touserdata) (lua_State *L, int idx);
+LUA_API lua_State *(lua_tothread) (lua_State *L, int idx);
+LUA_API const void *(lua_topointer) (lua_State *L, int idx);
+
+
+/*
+** Comparison and arithmetic functions
+*/
+
+#define LUA_OPADD 0 /* ORDER TM, ORDER OP */
+#define LUA_OPSUB 1
+#define LUA_OPMUL 2
+#define LUA_OPMOD 3
+#define LUA_OPPOW 4
+#define LUA_OPDIV 5
+#define LUA_OPIDIV 6
+#define LUA_OPBAND 7
+#define LUA_OPBOR 8
+#define LUA_OPBXOR 9
+#define LUA_OPSHL 10
+#define LUA_OPSHR 11
+#define LUA_OPUNM 12
+#define LUA_OPBNOT 13
+
+LUA_API void (lua_arith) (lua_State *L, int op);
+
+#define LUA_OPEQ 0
+#define LUA_OPLT 1
+#define LUA_OPLE 2
+
+LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2);
+LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op);
+
+
+/*
+** push functions (C -> stack)
+*/
+LUA_API void (lua_pushnil) (lua_State *L);
+LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n);
+LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n);
+LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len);
+LUA_API const char *(lua_pushstring) (lua_State *L, const char *s);
+LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt,
+ va_list argp);
+LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...);
+LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n);
+LUA_API void (lua_pushboolean) (lua_State *L, int b);
+LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p);
+LUA_API int (lua_pushthread) (lua_State *L);
+
+
+/*
+** get functions (Lua -> stack)
+*/
+LUA_API int (lua_getglobal) (lua_State *L, const char *name);
+LUA_API int (lua_gettable) (lua_State *L, int idx);
+LUA_API int (lua_getfield) (lua_State *L, int idx, const char *k);
+LUA_API int (lua_geti) (lua_State *L, int idx, lua_Integer n);
+LUA_API int (lua_rawget) (lua_State *L, int idx);
+LUA_API int (lua_rawgeti) (lua_State *L, int idx, lua_Integer n);
+LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p);
+
+LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec);
+LUA_API void *(lua_newuserdatauv) (lua_State *L, size_t sz, int nuvalue);
+LUA_API int (lua_getmetatable) (lua_State *L, int objindex);
+LUA_API int (lua_getiuservalue) (lua_State *L, int idx, int n);
+
+
+/*
+** set functions (stack -> Lua)
+*/
+LUA_API void (lua_setglobal) (lua_State *L, const char *name);
+LUA_API void (lua_settable) (lua_State *L, int idx);
+LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k);
+LUA_API void (lua_seti) (lua_State *L, int idx, lua_Integer n);
+LUA_API void (lua_rawset) (lua_State *L, int idx);
+LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n);
+LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p);
+LUA_API int (lua_setmetatable) (lua_State *L, int objindex);
+LUA_API int (lua_setiuservalue) (lua_State *L, int idx, int n);
+
+
+/*
+** 'load' and 'call' functions (load and run Lua code)
+*/
+LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults,
+ lua_KContext ctx, lua_KFunction k);
+#define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL)
+
+LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc,
+ lua_KContext ctx, lua_KFunction k);
+#define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL)
+
+LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt,
+ const char *chunkname, const char *mode);
+
+LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data, int strip);
+
+
+/*
+** coroutine functions
+*/
+LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx,
+ lua_KFunction k);
+LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg,
+ int *nres);
+LUA_API int (lua_status) (lua_State *L);
+LUA_API int (lua_isyieldable) (lua_State *L);
+
+#define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL)
+
+
+/*
+** Warning-related functions
+*/
+LUA_API void (lua_setwarnf) (lua_State *L, lua_WarnFunction f, void *ud);
+LUA_API void (lua_warning) (lua_State *L, const char *msg, int tocont);
+
+
+/*
+** garbage-collection function and options
+*/
+
+#define LUA_GCSTOP 0
+#define LUA_GCRESTART 1
+#define LUA_GCCOLLECT 2
+#define LUA_GCCOUNT 3
+#define LUA_GCCOUNTB 4
+#define LUA_GCSTEP 5
+#define LUA_GCSETPAUSE 6
+#define LUA_GCSETSTEPMUL 7
+#define LUA_GCISRUNNING 9
+#define LUA_GCGEN 10
+#define LUA_GCINC 11
+
+LUA_API int (lua_gc) (lua_State *L, int what, ...);
+
+
+/*
+** miscellaneous functions
+*/
+
+LUA_API int (lua_error) (lua_State *L);
+
+LUA_API int (lua_next) (lua_State *L, int idx);
+
+LUA_API void (lua_concat) (lua_State *L, int n);
+LUA_API void (lua_len) (lua_State *L, int idx);
+
+LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s);
+
+LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud);
+LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud);
+
+LUA_API void (lua_toclose) (lua_State *L, int idx);
+LUA_API void (lua_closeslot) (lua_State *L, int idx);
+
+
+/*
+** {==============================================================
+** some useful macros
+** ===============================================================
+*/
+
+#define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE))
+
+#define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL)
+#define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL)
+
+#define lua_pop(L,n) lua_settop(L, -(n)-1)
+
+#define lua_newtable(L) lua_createtable(L, 0, 0)
+
+#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n)))
+
+#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0)
+
+#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION)
+#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE)
+#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA)
+#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL)
+#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN)
+#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD)
+#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE)
+#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0)
+
+#define lua_pushliteral(L, s) lua_pushstring(L, "" s)
+
+#define lua_pushglobaltable(L) \
+ ((void)lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS))
+
+#define lua_tostring(L,i) lua_tolstring(L, (i), NULL)
+
+
+#define lua_insert(L,idx) lua_rotate(L, (idx), 1)
+
+#define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1))
+
+#define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1))
+
+/* }============================================================== */
+
+
+/*
+** {==============================================================
+** compatibility macros
+** ===============================================================
+*/
+#if defined(LUA_COMPAT_APIINTCASTS)
+
+#define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n))
+#define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is))
+#define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL)
+
+#endif
+
+#define lua_newuserdata(L,s) lua_newuserdatauv(L,s,1)
+#define lua_getuservalue(L,idx) lua_getiuservalue(L,idx,1)
+#define lua_setuservalue(L,idx) lua_setiuservalue(L,idx,1)
+
+#define LUA_NUMTAGS LUA_NUMTYPES
+
+/* }============================================================== */
+
+/*
+** {======================================================================
+** Debug API
+** =======================================================================
+*/
+
+
+/*
+** Event codes
+*/
+#define LUA_HOOKCALL 0
+#define LUA_HOOKRET 1
+#define LUA_HOOKLINE 2
+#define LUA_HOOKCOUNT 3
+#define LUA_HOOKTAILCALL 4
+
+
+/*
+** Event masks
+*/
+#define LUA_MASKCALL (1 << LUA_HOOKCALL)
+#define LUA_MASKRET (1 << LUA_HOOKRET)
+#define LUA_MASKLINE (1 << LUA_HOOKLINE)
+#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT)
+
+typedef struct lua_Debug lua_Debug; /* activation record */
+
+
+/* Functions to be called by the debugger in specific events */
+typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
+
+
+LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar);
+LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar);
+LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n);
+LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n);
+LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n);
+LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n);
+
+LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n);
+LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1,
+ int fidx2, int n2);
+
+LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count);
+LUA_API lua_Hook (lua_gethook) (lua_State *L);
+LUA_API int (lua_gethookmask) (lua_State *L);
+LUA_API int (lua_gethookcount) (lua_State *L);
+
+LUA_API int (lua_setcstacklimit) (lua_State *L, unsigned int limit);
+
+struct lua_Debug {
+ int event;
+ const char *name; /* (n) */
+ const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */
+ const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */
+ const char *source; /* (S) */
+ size_t srclen; /* (S) */
+ int currentline; /* (l) */
+ int linedefined; /* (S) */
+ int lastlinedefined; /* (S) */
+ unsigned char nups; /* (u) number of upvalues */
+ unsigned char nparams;/* (u) number of parameters */
+ char isvararg; /* (u) */
+ char istailcall; /* (t) */
+ unsigned short ftransfer; /* (r) index of first value transferred */
+ unsigned short ntransfer; /* (r) number of transferred values */
+ char short_src[LUA_IDSIZE]; /* (S) */
+ /* private part */
+ struct CallInfo *i_ci; /* active function */
+};
+
+/* }====================================================================== */
+
+
+/******************************************************************************
+* Copyright (C) 1994-2022 Lua.org, PUC-Rio.
+*
+* 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.
+******************************************************************************/
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/luaconf.h b/source/luametatex/source/luacore/lua54/src/luaconf.h
new file mode 100644
index 000000000..e4650fbce
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/luaconf.h
@@ -0,0 +1,787 @@
+/*
+** $Id: luaconf.h $
+** Configuration file for Lua
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef luaconf_h
+#define luaconf_h
+
+#include <limits.h>
+#include <stddef.h>
+
+
+/*
+** ===================================================================
+** General Configuration File for Lua
+**
+** Some definitions here can be changed externally, through the compiler
+** (e.g., with '-D' options): They are commented out or protected
+** by '#if !defined' guards. However, several other definitions
+** should be changed directly here, either because they affect the
+** Lua ABI (by making the changes here, you ensure that all software
+** connected to Lua, such as C libraries, will be compiled with the same
+** configuration); or because they are seldom changed.
+**
+** Search for "@@" to find all configurable definitions.
+** ===================================================================
+*/
+
+
+/*
+** {====================================================================
+** System Configuration: macros to adapt (if needed) Lua to some
+** particular platform, for instance restricting it to C89.
+** =====================================================================
+*/
+
+/*
+@@ LUA_USE_C89 controls the use of non-ISO-C89 features.
+** Define it if you want Lua to avoid the use of a few C99 features
+** or Windows-specific features on Windows.
+*/
+/* #define LUA_USE_C89 */
+
+
+/*
+** By default, Lua on Windows use (some) specific Windows features
+*/
+#if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE)
+#define LUA_USE_WINDOWS /* enable goodies for regular Windows */
+#endif
+
+
+#if defined(LUA_USE_WINDOWS)
+#define LUA_DL_DLL /* enable support for DLL */
+#define LUA_USE_C89 /* broadly, Windows is C89 */
+#endif
+
+
+#if defined(LUA_USE_LINUX)
+#define LUA_USE_POSIX
+#define LUA_USE_DLOPEN /* needs an extra library: -ldl */
+#endif
+
+
+#if defined(LUA_USE_MACOSX)
+#define LUA_USE_POSIX
+#define LUA_USE_DLOPEN /* MacOS does not need -ldl */
+#endif
+
+
+/*
+@@ LUAI_IS32INT is true iff 'int' has (at least) 32 bits.
+*/
+#define LUAI_IS32INT ((UINT_MAX >> 30) >= 3)
+
+/* }================================================================== */
+
+
+
+/*
+** {==================================================================
+** Configuration for Number types. These options should not be
+** set externally, because any other code connected to Lua must
+** use the same configuration.
+** ===================================================================
+*/
+
+/*
+@@ LUA_INT_TYPE defines the type for Lua integers.
+@@ LUA_FLOAT_TYPE defines the type for Lua floats.
+** Lua should work fine with any mix of these options supported
+** by your C compiler. The usual configurations are 64-bit integers
+** and 'double' (the default), 32-bit integers and 'float' (for
+** restricted platforms), and 'long'/'double' (for C compilers not
+** compliant with C99, which may not have support for 'long long').
+*/
+
+/* predefined options for LUA_INT_TYPE */
+#define LUA_INT_INT 1
+#define LUA_INT_LONG 2
+#define LUA_INT_LONGLONG 3
+
+/* predefined options for LUA_FLOAT_TYPE */
+#define LUA_FLOAT_FLOAT 1
+#define LUA_FLOAT_DOUBLE 2
+#define LUA_FLOAT_LONGDOUBLE 3
+
+
+/* Default configuration ('long long' and 'double', for 64-bit Lua) */
+#define LUA_INT_DEFAULT LUA_INT_LONGLONG
+#define LUA_FLOAT_DEFAULT LUA_FLOAT_DOUBLE
+
+
+/*
+@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats.
+*/
+#define LUA_32BITS 0
+
+
+/*
+@@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for
+** C89 ('long' and 'double'); Windows always has '__int64', so it does
+** not need to use this case.
+*/
+#if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS)
+#define LUA_C89_NUMBERS 1
+#else
+#define LUA_C89_NUMBERS 0
+#endif
+
+
+#if LUA_32BITS /* { */
+/*
+** 32-bit integers and 'float'
+*/
+#if LUAI_IS32INT /* use 'int' if big enough */
+#define LUA_INT_TYPE LUA_INT_INT
+#else /* otherwise use 'long' */
+#define LUA_INT_TYPE LUA_INT_LONG
+#endif
+#define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT
+
+#elif LUA_C89_NUMBERS /* }{ */
+/*
+** largest types available for C89 ('long' and 'double')
+*/
+#define LUA_INT_TYPE LUA_INT_LONG
+#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE
+
+#else /* }{ */
+/* use defaults */
+
+#define LUA_INT_TYPE LUA_INT_DEFAULT
+#define LUA_FLOAT_TYPE LUA_FLOAT_DEFAULT
+
+#endif /* } */
+
+
+/* }================================================================== */
+
+
+
+/*
+** {==================================================================
+** Configuration for Paths.
+** ===================================================================
+*/
+
+/*
+** LUA_PATH_SEP is the character that separates templates in a path.
+** LUA_PATH_MARK is the string that marks the substitution points in a
+** template.
+** LUA_EXEC_DIR in a Windows path is replaced by the executable's
+** directory.
+*/
+#define LUA_PATH_SEP ";"
+#define LUA_PATH_MARK "?"
+#define LUA_EXEC_DIR "!"
+
+
+/*
+@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for
+** Lua libraries.
+@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for
+** C libraries.
+** CHANGE them if your machine has a non-conventional directory
+** hierarchy or if you want to install your libraries in
+** non-conventional directories.
+*/
+
+#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
+#if defined(_WIN32) /* { */
+/*
+** In Windows, any exclamation mark ('!') in the path is replaced by the
+** path of the directory of the executable file of the current process.
+*/
+#define LUA_LDIR "!\\lua\\"
+#define LUA_CDIR "!\\"
+#define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\"
+
+#if !defined(LUA_PATH_DEFAULT)
+#define LUA_PATH_DEFAULT \
+ LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \
+ LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \
+ LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \
+ ".\\?.lua;" ".\\?\\init.lua"
+#endif
+
+#if !defined(LUA_CPATH_DEFAULT)
+#define LUA_CPATH_DEFAULT \
+ LUA_CDIR"?.dll;" \
+ LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \
+ LUA_CDIR"loadall.dll;" ".\\?.dll"
+#endif
+
+#else /* }{ */
+
+#define LUA_ROOT "/usr/local/"
+#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/"
+#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/"
+
+#if !defined(LUA_PATH_DEFAULT)
+#define LUA_PATH_DEFAULT \
+ LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \
+ LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \
+ "./?.lua;" "./?/init.lua"
+#endif
+
+#if !defined(LUA_CPATH_DEFAULT)
+#define LUA_CPATH_DEFAULT \
+ LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so"
+#endif
+
+#endif /* } */
+
+
+/*
+@@ LUA_DIRSEP is the directory separator (for submodules).
+** CHANGE it if your machine does not use "/" as the directory separator
+** and is not Windows. (On Windows Lua automatically uses "\".)
+*/
+#if !defined(LUA_DIRSEP)
+
+#if defined(_WIN32)
+#define LUA_DIRSEP "\\"
+#else
+#define LUA_DIRSEP "/"
+#endif
+
+#endif
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Marks for exported symbols in the C code
+** ===================================================================
+*/
+
+/*
+@@ LUA_API is a mark for all core API functions.
+@@ LUALIB_API is a mark for all auxiliary library functions.
+@@ LUAMOD_API is a mark for all standard library opening functions.
+** CHANGE them if you need to define those functions in some special way.
+** For instance, if you want to create one Windows DLL with the core and
+** the libraries, you may want to use the following definition (define
+** LUA_BUILD_AS_DLL to get it).
+*/
+#if defined(LUA_BUILD_AS_DLL) /* { */
+
+#if defined(LUA_CORE) || defined(LUA_LIB) /* { */
+#define LUA_API __declspec(dllexport)
+#else /* }{ */
+#define LUA_API __declspec(dllimport)
+#endif /* } */
+
+#else /* }{ */
+
+#define LUA_API extern
+
+#endif /* } */
+
+
+/*
+** More often than not the libs go together with the core.
+*/
+#define LUALIB_API LUA_API
+#define LUAMOD_API LUA_API
+
+
+/*
+@@ LUAI_FUNC is a mark for all extern functions that are not to be
+** exported to outside modules.
+@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables,
+** none of which to be exported to outside modules (LUAI_DDEF for
+** definitions and LUAI_DDEC for declarations).
+** CHANGE them if you need to mark them in some special way. Elf/gcc
+** (versions 3.2 and later) mark them as "hidden" to optimize access
+** when Lua is compiled as a shared library. Not all elf targets support
+** this attribute. Unfortunately, gcc does not offer a way to check
+** whether the target offers that support, and those without support
+** give a warning about it. To avoid these warnings, change to the
+** default definition.
+*/
+#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \
+ defined(__ELF__) /* { */
+#define LUAI_FUNC __attribute__((visibility("internal"))) extern
+#else /* }{ */
+#define LUAI_FUNC extern
+#endif /* } */
+
+#define LUAI_DDEC(dec) LUAI_FUNC dec
+#define LUAI_DDEF /* empty */
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Compatibility with previous versions
+** ===================================================================
+*/
+
+/*
+@@ LUA_COMPAT_5_3 controls other macros for compatibility with Lua 5.3.
+** You can define it to get all options, or change specific options
+** to fit your specific needs.
+*/
+#if defined(LUA_COMPAT_5_3) /* { */
+
+/*
+@@ LUA_COMPAT_MATHLIB controls the presence of several deprecated
+** functions in the mathematical library.
+** (These functions were already officially removed in 5.3;
+** nevertheless they are still available here.)
+*/
+#define LUA_COMPAT_MATHLIB
+
+/*
+@@ LUA_COMPAT_APIINTCASTS controls the presence of macros for
+** manipulating other integer types (lua_pushunsigned, lua_tounsigned,
+** luaL_checkint, luaL_checklong, etc.)
+** (These macros were also officially removed in 5.3, but they are still
+** available here.)
+*/
+#define LUA_COMPAT_APIINTCASTS
+
+
+/*
+@@ LUA_COMPAT_LT_LE controls the emulation of the '__le' metamethod
+** using '__lt'.
+*/
+#define LUA_COMPAT_LT_LE
+
+
+/*
+@@ The following macros supply trivial compatibility for some
+** changes in the API. The macros themselves document how to
+** change your code to avoid using them.
+** (Once more, these macros were officially removed in 5.3, but they are
+** still available here.)
+*/
+#define lua_strlen(L,i) lua_rawlen(L, (i))
+
+#define lua_objlen(L,i) lua_rawlen(L, (i))
+
+#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
+#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT)
+
+#endif /* } */
+
+/* }================================================================== */
+
+
+
+/*
+** {==================================================================
+** Configuration for Numbers (low-level part).
+** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_*
+** satisfy your needs.
+** ===================================================================
+*/
+
+/*
+@@ LUAI_UACNUMBER is the result of a 'default argument promotion'
+@@ over a floating number.
+@@ l_floatatt(x) corrects float attribute 'x' to the proper float type
+** by prefixing it with one of FLT/DBL/LDBL.
+@@ LUA_NUMBER_FRMLEN is the length modifier for writing floats.
+@@ LUA_NUMBER_FMT is the format for writing floats.
+@@ lua_number2str converts a float to a string.
+@@ l_mathop allows the addition of an 'l' or 'f' to all math operations.
+@@ l_floor takes the floor of a float.
+@@ lua_str2number converts a decimal numeral to a number.
+*/
+
+
+/* The following definitions are good for most cases here */
+
+#define l_floor(x) (l_mathop(floor)(x))
+
+#define lua_number2str(s,sz,n) \
+ l_sprintf((s), sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)(n))
+
+/*
+@@ lua_numbertointeger converts a float number with an integral value
+** to an integer, or returns 0 if float is not within the range of
+** a lua_Integer. (The range comparisons are tricky because of
+** rounding. The tests here assume a two-complement representation,
+** where MININTEGER always has an exact representation as a float;
+** MAXINTEGER may not have one, and therefore its conversion to float
+** may have an ill-defined value.)
+*/
+#define lua_numbertointeger(n,p) \
+ ((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \
+ (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \
+ (*(p) = (LUA_INTEGER)(n), 1))
+
+
+/* now the variable definitions */
+
+#if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */
+
+#define LUA_NUMBER float
+
+#define l_floatatt(n) (FLT_##n)
+
+#define LUAI_UACNUMBER double
+
+#define LUA_NUMBER_FRMLEN ""
+#define LUA_NUMBER_FMT "%.7g"
+
+#define l_mathop(op) op##f
+
+#define lua_str2number(s,p) strtof((s), (p))
+
+
+#elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */
+
+#define LUA_NUMBER long double
+
+#define l_floatatt(n) (LDBL_##n)
+
+#define LUAI_UACNUMBER long double
+
+#define LUA_NUMBER_FRMLEN "L"
+#define LUA_NUMBER_FMT "%.19Lg"
+
+#define l_mathop(op) op##l
+
+#define lua_str2number(s,p) strtold((s), (p))
+
+#elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */
+
+#define LUA_NUMBER double
+
+#define l_floatatt(n) (DBL_##n)
+
+#define LUAI_UACNUMBER double
+
+#define LUA_NUMBER_FRMLEN ""
+#define LUA_NUMBER_FMT "%.14g"
+
+#define l_mathop(op) op
+
+#define lua_str2number(s,p) strtod((s), (p))
+
+#else /* }{ */
+
+#error "numeric float type not defined"
+
+#endif /* } */
+
+
+
+/*
+@@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER.
+@@ LUAI_UACINT is the result of a 'default argument promotion'
+@@ over a LUA_INTEGER.
+@@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers.
+@@ LUA_INTEGER_FMT is the format for writing integers.
+@@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER.
+@@ LUA_MININTEGER is the minimum value for a LUA_INTEGER.
+@@ LUA_MAXUNSIGNED is the maximum value for a LUA_UNSIGNED.
+@@ lua_integer2str converts an integer to a string.
+*/
+
+
+/* The following definitions are good for most cases here */
+
+#define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d"
+
+#define LUAI_UACINT LUA_INTEGER
+
+#define lua_integer2str(s,sz,n) \
+ l_sprintf((s), sz, LUA_INTEGER_FMT, (LUAI_UACINT)(n))
+
+/*
+** use LUAI_UACINT here to avoid problems with promotions (which
+** can turn a comparison between unsigneds into a signed comparison)
+*/
+#define LUA_UNSIGNED unsigned LUAI_UACINT
+
+
+/* now the variable definitions */
+
+#if LUA_INT_TYPE == LUA_INT_INT /* { int */
+
+#define LUA_INTEGER int
+#define LUA_INTEGER_FRMLEN ""
+
+#define LUA_MAXINTEGER INT_MAX
+#define LUA_MININTEGER INT_MIN
+
+#define LUA_MAXUNSIGNED UINT_MAX
+
+#elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */
+
+#define LUA_INTEGER long
+#define LUA_INTEGER_FRMLEN "l"
+
+#define LUA_MAXINTEGER LONG_MAX
+#define LUA_MININTEGER LONG_MIN
+
+#define LUA_MAXUNSIGNED ULONG_MAX
+
+#elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */
+
+/* use presence of macro LLONG_MAX as proxy for C99 compliance */
+#if defined(LLONG_MAX) /* { */
+/* use ISO C99 stuff */
+
+#define LUA_INTEGER long long
+#define LUA_INTEGER_FRMLEN "ll"
+
+#define LUA_MAXINTEGER LLONG_MAX
+#define LUA_MININTEGER LLONG_MIN
+
+#define LUA_MAXUNSIGNED ULLONG_MAX
+
+#elif defined(LUA_USE_WINDOWS) /* }{ */
+/* in Windows, can use specific Windows types */
+
+#define LUA_INTEGER __int64
+#define LUA_INTEGER_FRMLEN "I64"
+
+#define LUA_MAXINTEGER _I64_MAX
+#define LUA_MININTEGER _I64_MIN
+
+#define LUA_MAXUNSIGNED _UI64_MAX
+
+#else /* }{ */
+
+#error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \
+ or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)"
+
+#endif /* } */
+
+#else /* }{ */
+
+#error "numeric integer type not defined"
+
+#endif /* } */
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Dependencies with C99 and other C details
+** ===================================================================
+*/
+
+/*
+@@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89.
+** (All uses in Lua have only one format item.)
+*/
+#if !defined(LUA_USE_C89)
+#define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i)
+#else
+#define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i))
+#endif
+
+
+/*
+@@ lua_strx2number converts a hexadecimal numeral to a number.
+** In C99, 'strtod' does that conversion. Otherwise, you can
+** leave 'lua_strx2number' undefined and Lua will provide its own
+** implementation.
+*/
+#if !defined(LUA_USE_C89)
+#define lua_strx2number(s,p) lua_str2number(s,p)
+#endif
+
+
+/*
+@@ lua_pointer2str converts a pointer to a readable string in a
+** non-specified way.
+*/
+#define lua_pointer2str(buff,sz,p) l_sprintf(buff,sz,"%p",p)
+
+
+/*
+@@ lua_number2strx converts a float to a hexadecimal numeral.
+** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that.
+** Otherwise, you can leave 'lua_number2strx' undefined and Lua will
+** provide its own implementation.
+*/
+#if !defined(LUA_USE_C89)
+#define lua_number2strx(L,b,sz,f,n) \
+ ((void)L, l_sprintf(b,sz,f,(LUAI_UACNUMBER)(n)))
+#endif
+
+
+/*
+** 'strtof' and 'opf' variants for math functions are not valid in
+** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the
+** availability of these variants. ('math.h' is already included in
+** all files that use these macros.)
+*/
+#if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF))
+#undef l_mathop /* variants not available */
+#undef lua_str2number
+#define l_mathop(op) (lua_Number)op /* no variant */
+#define lua_str2number(s,p) ((lua_Number)strtod((s), (p)))
+#endif
+
+
+/*
+@@ LUA_KCONTEXT is the type of the context ('ctx') for continuation
+** functions. It must be a numerical type; Lua will use 'intptr_t' if
+** available, otherwise it will use 'ptrdiff_t' (the nearest thing to
+** 'intptr_t' in C89)
+*/
+#define LUA_KCONTEXT ptrdiff_t
+
+#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \
+ __STDC_VERSION__ >= 199901L
+#include <stdint.h>
+#if defined(INTPTR_MAX) /* even in C99 this type is optional */
+#undef LUA_KCONTEXT
+#define LUA_KCONTEXT intptr_t
+#endif
+#endif
+
+
+/*
+@@ lua_getlocaledecpoint gets the locale "radix character" (decimal point).
+** Change that if you do not want to use C locales. (Code using this
+** macro must include the header 'locale.h'.)
+*/
+#if !defined(lua_getlocaledecpoint)
+#define lua_getlocaledecpoint() (localeconv()->decimal_point[0])
+#endif
+
+
+/*
+** macros to improve jump prediction, used mostly for error handling
+** and debug facilities. (Some macros in the Lua API use these macros.
+** Define LUA_NOBUILTIN if you do not want '__builtin_expect' in your
+** code.)
+*/
+#if !defined(luai_likely)
+
+#if defined(__GNUC__) && !defined(LUA_NOBUILTIN)
+#define luai_likely(x) (__builtin_expect(((x) != 0), 1))
+#define luai_unlikely(x) (__builtin_expect(((x) != 0), 0))
+#else
+#define luai_likely(x) (x)
+#define luai_unlikely(x) (x)
+#endif
+
+#endif
+
+
+#if defined(LUA_CORE) || defined(LUA_LIB)
+/* shorter names for Lua's own use */
+#define l_likely(x) luai_likely(x)
+#define l_unlikely(x) luai_unlikely(x)
+#endif
+
+
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Language Variations
+** =====================================================================
+*/
+
+/*
+@@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some
+** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from
+** numbers to strings. Define LUA_NOCVTS2N to turn off automatic
+** coercion from strings to numbers.
+*/
+/* #define LUA_NOCVTN2S */
+/* #define LUA_NOCVTS2N */
+
+
+/*
+@@ LUA_USE_APICHECK turns on several consistency checks on the C API.
+** Define it as a help when debugging C code.
+*/
+#if defined(LUA_USE_APICHECK)
+#include <assert.h>
+#define luai_apicheck(l,e) assert(e)
+#endif
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Macros that affect the API and must be stable (that is, must be the
+** same when you compile Lua and when you compile code that links to
+** Lua).
+** =====================================================================
+*/
+
+/*
+@@ LUAI_MAXSTACK limits the size of the Lua stack.
+** CHANGE it if you need a different limit. This limit is arbitrary;
+** its only purpose is to stop Lua from consuming unlimited stack
+** space (and to reserve some numbers for pseudo-indices).
+** (It must fit into max(size_t)/32 and max(int)/2.)
+*/
+#if LUAI_IS32INT
+#define LUAI_MAXSTACK 1000000
+#else
+#define LUAI_MAXSTACK 15000
+#endif
+
+
+/*
+@@ LUA_EXTRASPACE defines the size of a raw memory area associated with
+** a Lua state with very fast access.
+** CHANGE it if you need a different size.
+*/
+#define LUA_EXTRASPACE (sizeof(void *))
+
+
+/*
+@@ LUA_IDSIZE gives the maximum size for the description of the source
+** of a function in debug information.
+** CHANGE it if you want a different size.
+*/
+#define LUA_IDSIZE 60
+
+
+/*
+@@ LUAL_BUFFERSIZE is the initial buffer size used by the lauxlib
+** buffer system.
+*/
+#define LUAL_BUFFERSIZE ((int)(16 * sizeof(void*) * sizeof(lua_Number)))
+
+
+/*
+@@ LUAI_MAXALIGN defines fields that, when used in a union, ensure
+** maximum alignment for the other items in that union.
+*/
+#define LUAI_MAXALIGN lua_Number n; double u; void *s; lua_Integer i; long l
+
+/* }================================================================== */
+
+
+
+
+
+/* =================================================================== */
+
+/*
+** Local configuration. You can use this space to add your redefinitions
+** without modifying the main part of the file.
+*/
+
+
+
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/lua54/src/lualib.h b/source/luametatex/source/luacore/lua54/src/lualib.h
new file mode 100644
index 000000000..262552907
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lualib.h
@@ -0,0 +1,52 @@
+/*
+** $Id: lualib.h $
+** Lua standard libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lualib_h
+#define lualib_h
+
+#include "lua.h"
+
+
+/* version suffix for environment variable names */
+#define LUA_VERSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR
+
+
+LUAMOD_API int (luaopen_base) (lua_State *L);
+
+#define LUA_COLIBNAME "coroutine"
+LUAMOD_API int (luaopen_coroutine) (lua_State *L);
+
+#define LUA_TABLIBNAME "table"
+LUAMOD_API int (luaopen_table) (lua_State *L);
+
+#define LUA_IOLIBNAME "io"
+LUAMOD_API int (luaopen_io) (lua_State *L);
+
+#define LUA_OSLIBNAME "os"
+LUAMOD_API int (luaopen_os) (lua_State *L);
+
+#define LUA_STRLIBNAME "string"
+LUAMOD_API int (luaopen_string) (lua_State *L);
+
+#define LUA_UTF8LIBNAME "utf8"
+LUAMOD_API int (luaopen_utf8) (lua_State *L);
+
+#define LUA_MATHLIBNAME "math"
+LUAMOD_API int (luaopen_math) (lua_State *L);
+
+#define LUA_DBLIBNAME "debug"
+LUAMOD_API int (luaopen_debug) (lua_State *L);
+
+#define LUA_LOADLIBNAME "package"
+LUAMOD_API int (luaopen_package) (lua_State *L);
+
+
+/* open all previous libraries */
+LUALIB_API void (luaL_openlibs) (lua_State *L);
+
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lundump.c b/source/luametatex/source/luacore/lua54/src/lundump.c
new file mode 100644
index 000000000..5aa55c445
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lundump.c
@@ -0,0 +1,333 @@
+/*
+** $Id: lundump.c $
+** load precompiled Lua chunks
+** See Copyright Notice in lua.h
+*/
+
+#define lundump_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <limits.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstring.h"
+#include "lundump.h"
+#include "lzio.h"
+
+
+#if !defined(luai_verifycode)
+#define luai_verifycode(L,f) /* empty */
+#endif
+
+
+typedef struct {
+ lua_State *L;
+ ZIO *Z;
+ const char *name;
+} LoadState;
+
+
+static l_noret error (LoadState *S, const char *why) {
+ luaO_pushfstring(S->L, "%s: bad binary format (%s)", S->name, why);
+ luaD_throw(S->L, LUA_ERRSYNTAX);
+}
+
+
+/*
+** All high-level loads go through loadVector; you can change it to
+** adapt to the endianness of the input
+*/
+#define loadVector(S,b,n) loadBlock(S,b,(n)*sizeof((b)[0]))
+
+static void loadBlock (LoadState *S, void *b, size_t size) {
+ if (luaZ_read(S->Z, b, size) != 0)
+ error(S, "truncated chunk");
+}
+
+
+#define loadVar(S,x) loadVector(S,&x,1)
+
+
+static lu_byte loadByte (LoadState *S) {
+ int b = zgetc(S->Z);
+ if (b == EOZ)
+ error(S, "truncated chunk");
+ return cast_byte(b);
+}
+
+
+static size_t loadUnsigned (LoadState *S, size_t limit) {
+ size_t x = 0;
+ int b;
+ limit >>= 7;
+ do {
+ b = loadByte(S);
+ if (x >= limit)
+ error(S, "integer overflow");
+ x = (x << 7) | (b & 0x7f);
+ } while ((b & 0x80) == 0);
+ return x;
+}
+
+
+static size_t loadSize (LoadState *S) {
+ return loadUnsigned(S, ~(size_t)0);
+}
+
+
+static int loadInt (LoadState *S) {
+ return cast_int(loadUnsigned(S, INT_MAX));
+}
+
+
+static lua_Number loadNumber (LoadState *S) {
+ lua_Number x;
+ loadVar(S, x);
+ return x;
+}
+
+
+static lua_Integer loadInteger (LoadState *S) {
+ lua_Integer x;
+ loadVar(S, x);
+ return x;
+}
+
+
+/*
+** Load a nullable string into prototype 'p'.
+*/
+static TString *loadStringN (LoadState *S, Proto *p) {
+ lua_State *L = S->L;
+ TString *ts;
+ size_t size = loadSize(S);
+ if (size == 0) /* no string? */
+ return NULL;
+ else if (--size <= LUAI_MAXSHORTLEN) { /* short string? */
+ char buff[LUAI_MAXSHORTLEN];
+ loadVector(S, buff, size); /* load string into buffer */
+ ts = luaS_newlstr(L, buff, size); /* create string */
+ }
+ else { /* long string */
+ ts = luaS_createlngstrobj(L, size); /* create string */
+ setsvalue2s(L, L->top, ts); /* anchor it ('loadVector' can GC) */
+ luaD_inctop(L);
+ loadVector(S, getstr(ts), size); /* load directly in final place */
+ L->top--; /* pop string */
+ }
+ luaC_objbarrier(L, p, ts);
+ return ts;
+}
+
+
+/*
+** Load a non-nullable string into prototype 'p'.
+*/
+static TString *loadString (LoadState *S, Proto *p) {
+ TString *st = loadStringN(S, p);
+ if (st == NULL)
+ error(S, "bad format for constant string");
+ return st;
+}
+
+
+static void loadCode (LoadState *S, Proto *f) {
+ int n = loadInt(S);
+ f->code = luaM_newvectorchecked(S->L, n, Instruction);
+ f->sizecode = n;
+ loadVector(S, f->code, n);
+}
+
+
+static void loadFunction(LoadState *S, Proto *f, TString *psource);
+
+
+static void loadConstants (LoadState *S, Proto *f) {
+ int i;
+ int n = loadInt(S);
+ f->k = luaM_newvectorchecked(S->L, n, TValue);
+ f->sizek = n;
+ for (i = 0; i < n; i++)
+ setnilvalue(&f->k[i]);
+ for (i = 0; i < n; i++) {
+ TValue *o = &f->k[i];
+ int t = loadByte(S);
+ switch (t) {
+ case LUA_VNIL:
+ setnilvalue(o);
+ break;
+ case LUA_VFALSE:
+ setbfvalue(o);
+ break;
+ case LUA_VTRUE:
+ setbtvalue(o);
+ break;
+ case LUA_VNUMFLT:
+ setfltvalue(o, loadNumber(S));
+ break;
+ case LUA_VNUMINT:
+ setivalue(o, loadInteger(S));
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ setsvalue2n(S->L, o, loadString(S, f));
+ break;
+ default: lua_assert(0);
+ }
+ }
+}
+
+
+static void loadProtos (LoadState *S, Proto *f) {
+ int i;
+ int n = loadInt(S);
+ f->p = luaM_newvectorchecked(S->L, n, Proto *);
+ f->sizep = n;
+ for (i = 0; i < n; i++)
+ f->p[i] = NULL;
+ for (i = 0; i < n; i++) {
+ f->p[i] = luaF_newproto(S->L);
+ luaC_objbarrier(S->L, f, f->p[i]);
+ loadFunction(S, f->p[i], f->source);
+ }
+}
+
+
+/*
+** Load the upvalues for a function. The names must be filled first,
+** because the filling of the other fields can raise read errors and
+** the creation of the error message can call an emergency collection;
+** in that case all prototypes must be consistent for the GC.
+*/
+static void loadUpvalues (LoadState *S, Proto *f) {
+ int i, n;
+ n = loadInt(S);
+ f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc);
+ f->sizeupvalues = n;
+ for (i = 0; i < n; i++) /* make array valid for GC */
+ f->upvalues[i].name = NULL;
+ for (i = 0; i < n; i++) { /* following calls can raise errors */
+ f->upvalues[i].instack = loadByte(S);
+ f->upvalues[i].idx = loadByte(S);
+ f->upvalues[i].kind = loadByte(S);
+ }
+}
+
+
+static void loadDebug (LoadState *S, Proto *f) {
+ int i, n;
+ n = loadInt(S);
+ f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte);
+ f->sizelineinfo = n;
+ loadVector(S, f->lineinfo, n);
+ n = loadInt(S);
+ f->abslineinfo = luaM_newvectorchecked(S->L, n, AbsLineInfo);
+ f->sizeabslineinfo = n;
+ for (i = 0; i < n; i++) {
+ f->abslineinfo[i].pc = loadInt(S);
+ f->abslineinfo[i].line = loadInt(S);
+ }
+ n = loadInt(S);
+ f->locvars = luaM_newvectorchecked(S->L, n, LocVar);
+ f->sizelocvars = n;
+ for (i = 0; i < n; i++)
+ f->locvars[i].varname = NULL;
+ for (i = 0; i < n; i++) {
+ f->locvars[i].varname = loadStringN(S, f);
+ f->locvars[i].startpc = loadInt(S);
+ f->locvars[i].endpc = loadInt(S);
+ }
+ n = loadInt(S);
+ for (i = 0; i < n; i++)
+ f->upvalues[i].name = loadStringN(S, f);
+}
+
+
+static void loadFunction (LoadState *S, Proto *f, TString *psource) {
+ f->source = loadStringN(S, f);
+ if (f->source == NULL) /* no source in dump? */
+ f->source = psource; /* reuse parent's source */
+ f->linedefined = loadInt(S);
+ f->lastlinedefined = loadInt(S);
+ f->numparams = loadByte(S);
+ f->is_vararg = loadByte(S);
+ f->maxstacksize = loadByte(S);
+ loadCode(S, f);
+ loadConstants(S, f);
+ loadUpvalues(S, f);
+ loadProtos(S, f);
+ loadDebug(S, f);
+}
+
+
+static void checkliteral (LoadState *S, const char *s, const char *msg) {
+ char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */
+ size_t len = strlen(s);
+ loadVector(S, buff, len);
+ if (memcmp(s, buff, len) != 0)
+ error(S, msg);
+}
+
+
+static void fchecksize (LoadState *S, size_t size, const char *tname) {
+ if (loadByte(S) != size)
+ error(S, luaO_pushfstring(S->L, "%s size mismatch", tname));
+}
+
+
+#define checksize(S,t) fchecksize(S,sizeof(t),#t)
+
+static void checkHeader (LoadState *S) {
+ /* skip 1st char (already read and checked) */
+ checkliteral(S, &LUA_SIGNATURE[1], "not a binary chunk");
+ if (loadByte(S) != LUAC_VERSION)
+ error(S, "version mismatch");
+ if (loadByte(S) != LUAC_FORMAT)
+ error(S, "format mismatch");
+ checkliteral(S, LUAC_DATA, "corrupted chunk");
+ checksize(S, Instruction);
+ checksize(S, lua_Integer);
+ checksize(S, lua_Number);
+ if (loadInteger(S) != LUAC_INT)
+ error(S, "integer format mismatch");
+ if (loadNumber(S) != LUAC_NUM)
+ error(S, "float format mismatch");
+}
+
+
+/*
+** Load precompiled chunk.
+*/
+LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) {
+ LoadState S;
+ LClosure *cl;
+ if (*name == '@' || *name == '=')
+ S.name = name + 1;
+ else if (*name == LUA_SIGNATURE[0])
+ S.name = "binary string";
+ else
+ S.name = name;
+ S.L = L;
+ S.Z = Z;
+ checkHeader(&S);
+ cl = luaF_newLclosure(L, loadByte(&S));
+ setclLvalue2s(L, L->top, cl);
+ luaD_inctop(L);
+ cl->p = luaF_newproto(L);
+ luaC_objbarrier(L, cl, cl->p);
+ loadFunction(&S, cl->p, NULL);
+ lua_assert(cl->nupvalues == cl->p->sizeupvalues);
+ luai_verifycode(L, cl->p);
+ return cl;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lundump.h b/source/luametatex/source/luacore/lua54/src/lundump.h
new file mode 100644
index 000000000..f3748a998
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lundump.h
@@ -0,0 +1,36 @@
+/*
+** $Id: lundump.h $
+** load precompiled Lua chunks
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lundump_h
+#define lundump_h
+
+#include "llimits.h"
+#include "lobject.h"
+#include "lzio.h"
+
+
+/* data to catch conversion errors */
+#define LUAC_DATA "\x19\x93\r\n\x1a\n"
+
+#define LUAC_INT 0x5678
+#define LUAC_NUM cast_num(370.5)
+
+/*
+** Encode major-minor version in one byte, one nibble for each
+*/
+#define MYINT(s) (s[0]-'0') /* assume one-digit numerals */
+#define LUAC_VERSION (MYINT(LUA_VERSION_MAJOR)*16+MYINT(LUA_VERSION_MINOR))
+
+#define LUAC_FORMAT 0 /* this is the official format */
+
+/* load one chunk; from lundump.c */
+LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, const char* name);
+
+/* dump one chunk; from ldump.c */
+LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w,
+ void* data, int strip);
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lutf8lib.c b/source/luametatex/source/luacore/lua54/src/lutf8lib.c
new file mode 100644
index 000000000..e7bf098f6
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lutf8lib.c
@@ -0,0 +1,286 @@
+/*
+** $Id: lutf8lib.c $
+** Standard library for UTF-8 manipulation
+** See Copyright Notice in lua.h
+*/
+
+#define lutf8lib_c
+#define LUA_LIB
+
+#include "lprefix.h"
+
+
+#include <assert.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+#define MAXUNICODE 0x10FFFFu
+
+#define MAXUTF 0x7FFFFFFFu
+
+/*
+** Integer type for decoded UTF-8 values; MAXUTF needs 31 bits.
+*/
+#if (UINT_MAX >> 30) >= 1
+typedef unsigned int utfint;
+#else
+typedef unsigned long utfint;
+#endif
+
+
+#define iscont(p) ((*(p) & 0xC0) == 0x80)
+
+
+/* from strlib */
+/* translate a relative string position: negative means back from end */
+static lua_Integer u_posrelat (lua_Integer pos, size_t len) {
+ if (pos >= 0) return pos;
+ else if (0u - (size_t)pos > len) return 0;
+ else return (lua_Integer)len + pos + 1;
+}
+
+
+/*
+** Decode one UTF-8 sequence, returning NULL if byte sequence is
+** invalid. The array 'limits' stores the minimum value for each
+** sequence length, to check for overlong representations. Its first
+** entry forces an error for non-ascii bytes with no continuation
+** bytes (count == 0).
+*/
+static const char *utf8_decode (const char *s, utfint *val, int strict) {
+ static const utfint limits[] =
+ {~(utfint)0, 0x80, 0x800, 0x10000u, 0x200000u, 0x4000000u};
+ unsigned int c = (unsigned char)s[0];
+ utfint res = 0; /* final result */
+ if (c < 0x80) /* ascii? */
+ res = c;
+ else {
+ int count = 0; /* to count number of continuation bytes */
+ for (; c & 0x40; c <<= 1) { /* while it needs continuation bytes... */
+ unsigned int cc = (unsigned char)s[++count]; /* read next byte */
+ if ((cc & 0xC0) != 0x80) /* not a continuation byte? */
+ return NULL; /* invalid byte sequence */
+ res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */
+ }
+ res |= ((utfint)(c & 0x7F) << (count * 5)); /* add first byte */
+ if (count > 5 || res > MAXUTF || res < limits[count])
+ return NULL; /* invalid byte sequence */
+ s += count; /* skip continuation bytes read */
+ }
+ if (strict) {
+ /* check for invalid code points; too large or surrogates */
+ if (res > MAXUNICODE || (0xD800u <= res && res <= 0xDFFFu))
+ return NULL;
+ }
+ if (val) *val = res;
+ return s + 1; /* +1 to include first byte */
+}
+
+
+/*
+** utf8len(s [, i [, j [, lax]]]) --> number of characters that
+** start in the range [i,j], or nil + current position if 's' is not
+** well formed in that interval
+*/
+static int utflen (lua_State *L) {
+ lua_Integer n = 0; /* counter for the number of characters */
+ size_t len; /* string length in bytes */
+ const char *s = luaL_checklstring(L, 1, &len);
+ lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
+ lua_Integer posj = u_posrelat(luaL_optinteger(L, 3, -1), len);
+ int lax = lua_toboolean(L, 4);
+ luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 2,
+ "initial position out of bounds");
+ luaL_argcheck(L, --posj < (lua_Integer)len, 3,
+ "final position out of bounds");
+ while (posi <= posj) {
+ const char *s1 = utf8_decode(s + posi, NULL, !lax);
+ if (s1 == NULL) { /* conversion error? */
+ luaL_pushfail(L); /* return fail ... */
+ lua_pushinteger(L, posi + 1); /* ... and current position */
+ return 2;
+ }
+ posi = s1 - s;
+ n++;
+ }
+ lua_pushinteger(L, n);
+ return 1;
+}
+
+
+/*
+** codepoint(s, [i, [j [, lax]]]) -> returns codepoints for all
+** characters that start in the range [i,j]
+*/
+static int codepoint (lua_State *L) {
+ size_t len;
+ const char *s = luaL_checklstring(L, 1, &len);
+ lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
+ lua_Integer pose = u_posrelat(luaL_optinteger(L, 3, posi), len);
+ int lax = lua_toboolean(L, 4);
+ int n;
+ const char *se;
+ luaL_argcheck(L, posi >= 1, 2, "out of bounds");
+ luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of bounds");
+ if (posi > pose) return 0; /* empty interval; return no values */
+ if (pose - posi >= INT_MAX) /* (lua_Integer -> int) overflow? */
+ return luaL_error(L, "string slice too long");
+ n = (int)(pose - posi) + 1; /* upper bound for number of returns */
+ luaL_checkstack(L, n, "string slice too long");
+ n = 0; /* count the number of returns */
+ se = s + pose; /* string end */
+ for (s += posi - 1; s < se;) {
+ utfint code;
+ s = utf8_decode(s, &code, !lax);
+ if (s == NULL)
+ return luaL_error(L, "invalid UTF-8 code");
+ lua_pushinteger(L, code);
+ n++;
+ }
+ return n;
+}
+
+
+static void pushutfchar (lua_State *L, int arg) {
+ lua_Unsigned code = (lua_Unsigned)luaL_checkinteger(L, arg);
+ luaL_argcheck(L, code <= MAXUTF, arg, "value out of range");
+ lua_pushfstring(L, "%U", (long)code);
+}
+
+
+/*
+** utfchar(n1, n2, ...) -> char(n1)..char(n2)...
+*/
+static int utfchar (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ if (n == 1) /* optimize common case of single char */
+ pushutfchar(L, 1);
+ else {
+ int i;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ for (i = 1; i <= n; i++) {
+ pushutfchar(L, i);
+ luaL_addvalue(&b);
+ }
+ luaL_pushresult(&b);
+ }
+ return 1;
+}
+
+
+/*
+** offset(s, n, [i]) -> index where n-th character counting from
+** position 'i' starts; 0 means character at 'i'.
+*/
+static int byteoffset (lua_State *L) {
+ size_t len;
+ const char *s = luaL_checklstring(L, 1, &len);
+ lua_Integer n = luaL_checkinteger(L, 2);
+ lua_Integer posi = (n >= 0) ? 1 : len + 1;
+ posi = u_posrelat(luaL_optinteger(L, 3, posi), len);
+ luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3,
+ "position out of bounds");
+ if (n == 0) {
+ /* find beginning of current byte sequence */
+ while (posi > 0 && iscont(s + posi)) posi--;
+ }
+ else {
+ if (iscont(s + posi))
+ return luaL_error(L, "initial position is a continuation byte");
+ if (n < 0) {
+ while (n < 0 && posi > 0) { /* move back */
+ do { /* find beginning of previous character */
+ posi--;
+ } while (posi > 0 && iscont(s + posi));
+ n++;
+ }
+ }
+ else {
+ n--; /* do not move for 1st character */
+ while (n > 0 && posi < (lua_Integer)len) {
+ do { /* find beginning of next character */
+ posi++;
+ } while (iscont(s + posi)); /* (cannot pass final '\0') */
+ n--;
+ }
+ }
+ }
+ if (n == 0) /* did it find given character? */
+ lua_pushinteger(L, posi + 1);
+ else /* no such character */
+ luaL_pushfail(L);
+ return 1;
+}
+
+
+static int iter_aux (lua_State *L, int strict) {
+ size_t len;
+ const char *s = luaL_checklstring(L, 1, &len);
+ lua_Unsigned n = (lua_Unsigned)lua_tointeger(L, 2);
+ if (n < len) {
+ while (iscont(s + n)) n++; /* skip continuation bytes */
+ }
+ if (n >= len) /* (also handles original 'n' being negative) */
+ return 0; /* no more codepoints */
+ else {
+ utfint code;
+ const char *next = utf8_decode(s + n, &code, strict);
+ if (next == NULL)
+ return luaL_error(L, "invalid UTF-8 code");
+ lua_pushinteger(L, n + 1);
+ lua_pushinteger(L, code);
+ return 2;
+ }
+}
+
+
+static int iter_auxstrict (lua_State *L) {
+ return iter_aux(L, 1);
+}
+
+static int iter_auxlax (lua_State *L) {
+ return iter_aux(L, 0);
+}
+
+
+static int iter_codes (lua_State *L) {
+ int lax = lua_toboolean(L, 2);
+ luaL_checkstring(L, 1);
+ lua_pushcfunction(L, lax ? iter_auxlax : iter_auxstrict);
+ lua_pushvalue(L, 1);
+ lua_pushinteger(L, 0);
+ return 3;
+}
+
+
+/* pattern to match a single UTF-8 character */
+#define UTF8PATT "[\0-\x7F\xC2-\xFD][\x80-\xBF]*"
+
+
+static const luaL_Reg funcs[] = {
+ {"offset", byteoffset},
+ {"codepoint", codepoint},
+ {"char", utfchar},
+ {"len", utflen},
+ {"codes", iter_codes},
+ /* placeholders */
+ {"charpattern", NULL},
+ {NULL, NULL}
+};
+
+
+LUAMOD_API int luaopen_utf8 (lua_State *L) {
+ luaL_newlib(L, funcs);
+ lua_pushlstring(L, UTF8PATT, sizeof(UTF8PATT)/sizeof(char) - 1);
+ lua_setfield(L, -2, "charpattern");
+ return 1;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lvm.c b/source/luametatex/source/luacore/lua54/src/lvm.c
new file mode 100644
index 000000000..614df0557
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lvm.c
@@ -0,0 +1,1899 @@
+/*
+** $Id: lvm.c $
+** Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+#define lvm_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+#include <float.h>
+#include <limits.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lvm.h"
+
+
+/*
+** By default, use jump tables in the main interpreter loop on gcc
+** and compatible compilers.
+*/
+#if !defined(LUA_USE_JUMPTABLE)
+#if defined(__GNUC__)
+#define LUA_USE_JUMPTABLE 1
+#else
+#define LUA_USE_JUMPTABLE 0
+#endif
+#endif
+
+
+
+/* limit for table tag-method chains (to avoid infinite loops) */
+#define MAXTAGLOOP 2000
+
+
+/*
+** 'l_intfitsf' checks whether a given integer is in the range that
+** can be converted to a float without rounding. Used in comparisons.
+*/
+
+/* number of bits in the mantissa of a float */
+#define NBM (l_floatatt(MANT_DIG))
+
+/*
+** Check whether some integers may not fit in a float, testing whether
+** (maxinteger >> NBM) > 0. (That implies (1 << NBM) <= maxinteger.)
+** (The shifts are done in parts, to avoid shifting by more than the size
+** of an integer. In a worst case, NBM == 113 for long double and
+** sizeof(long) == 32.)
+*/
+#if ((((LUA_MAXINTEGER >> (NBM / 4)) >> (NBM / 4)) >> (NBM / 4)) \
+ >> (NBM - (3 * (NBM / 4)))) > 0
+
+/* limit for integers that fit in a float */
+#define MAXINTFITSF ((lua_Unsigned)1 << NBM)
+
+/* check whether 'i' is in the interval [-MAXINTFITSF, MAXINTFITSF] */
+#define l_intfitsf(i) ((MAXINTFITSF + l_castS2U(i)) <= (2 * MAXINTFITSF))
+
+#else /* all integers fit in a float precisely */
+
+#define l_intfitsf(i) 1
+
+#endif
+
+
+/*
+** Try to convert a value from string to a number value.
+** If the value is not a string or is a string not representing
+** a valid numeral (or if coercions from strings to numbers
+** are disabled via macro 'cvt2num'), do not modify 'result'
+** and return 0.
+*/
+static int l_strton (const TValue *obj, TValue *result) {
+ lua_assert(obj != result);
+ if (!cvt2num(obj)) /* is object not a string? */
+ return 0;
+ else
+ return (luaO_str2num(svalue(obj), result) == vslen(obj) + 1);
+}
+
+
+/*
+** Try to convert a value to a float. The float case is already handled
+** by the macro 'tonumber'.
+*/
+int luaV_tonumber_ (const TValue *obj, lua_Number *n) {
+ TValue v;
+ if (ttisinteger(obj)) {
+ *n = cast_num(ivalue(obj));
+ return 1;
+ }
+ else if (l_strton(obj, &v)) { /* string coercible to number? */
+ *n = nvalue(&v); /* convert result of 'luaO_str2num' to a float */
+ return 1;
+ }
+ else
+ return 0; /* conversion failed */
+}
+
+
+/*
+** try to convert a float to an integer, rounding according to 'mode'.
+*/
+int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode) {
+ lua_Number f = l_floor(n);
+ if (n != f) { /* not an integral value? */
+ if (mode == F2Ieq) return 0; /* fails if mode demands integral value */
+ else if (mode == F2Iceil) /* needs ceil? */
+ f += 1; /* convert floor to ceil (remember: n != f) */
+ }
+ return lua_numbertointeger(f, p);
+}
+
+
+/*
+** try to convert a value to an integer, rounding according to 'mode',
+** without string coercion.
+** ("Fast track" handled by macro 'tointegerns'.)
+*/
+int luaV_tointegerns (const TValue *obj, lua_Integer *p, F2Imod mode) {
+ if (ttisfloat(obj))
+ return luaV_flttointeger(fltvalue(obj), p, mode);
+ else if (ttisinteger(obj)) {
+ *p = ivalue(obj);
+ return 1;
+ }
+ else
+ return 0;
+}
+
+
+/*
+** try to convert a value to an integer.
+*/
+int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode) {
+ TValue v;
+ if (l_strton(obj, &v)) /* does 'obj' point to a numerical string? */
+ obj = &v; /* change it to point to its corresponding number */
+ return luaV_tointegerns(obj, p, mode);
+}
+
+
+/*
+** Try to convert a 'for' limit to an integer, preserving the semantics
+** of the loop. Return true if the loop must not run; otherwise, '*p'
+** gets the integer limit.
+** (The following explanation assumes a positive step; it is valid for
+** negative steps mutatis mutandis.)
+** If the limit is an integer or can be converted to an integer,
+** rounding down, that is the limit.
+** Otherwise, check whether the limit can be converted to a float. If
+** the float is too large, clip it to LUA_MAXINTEGER. If the float
+** is too negative, the loop should not run, because any initial
+** integer value is greater than such limit; so, the function returns
+** true to signal that. (For this latter case, no integer limit would be
+** correct; even a limit of LUA_MININTEGER would run the loop once for
+** an initial value equal to LUA_MININTEGER.)
+*/
+static int forlimit (lua_State *L, lua_Integer init, const TValue *lim,
+ lua_Integer *p, lua_Integer step) {
+ if (!luaV_tointeger(lim, p, (step < 0 ? F2Iceil : F2Ifloor))) {
+ /* not coercible to in integer */
+ lua_Number flim; /* try to convert to float */
+ if (!tonumber(lim, &flim)) /* cannot convert to float? */
+ luaG_forerror(L, lim, "limit");
+ /* else 'flim' is a float out of integer bounds */
+ if (luai_numlt(0, flim)) { /* if it is positive, it is too large */
+ if (step < 0) return 1; /* initial value must be less than it */
+ *p = LUA_MAXINTEGER; /* truncate */
+ }
+ else { /* it is less than min integer */
+ if (step > 0) return 1; /* initial value must be greater than it */
+ *p = LUA_MININTEGER; /* truncate */
+ }
+ }
+ return (step > 0 ? init > *p : init < *p); /* not to run? */
+}
+
+
+/*
+** Prepare a numerical for loop (opcode OP_FORPREP).
+** Return true to skip the loop. Otherwise,
+** after preparation, stack will be as follows:
+** ra : internal index (safe copy of the control variable)
+** ra + 1 : loop counter (integer loops) or limit (float loops)
+** ra + 2 : step
+** ra + 3 : control variable
+*/
+static int forprep (lua_State *L, StkId ra) {
+ TValue *pinit = s2v(ra);
+ TValue *plimit = s2v(ra + 1);
+ TValue *pstep = s2v(ra + 2);
+ if (ttisinteger(pinit) && ttisinteger(pstep)) { /* integer loop? */
+ lua_Integer init = ivalue(pinit);
+ lua_Integer step = ivalue(pstep);
+ lua_Integer limit;
+ if (step == 0)
+ luaG_runerror(L, "'for' step is zero");
+ setivalue(s2v(ra + 3), init); /* control variable */
+ if (forlimit(L, init, plimit, &limit, step))
+ return 1; /* skip the loop */
+ else { /* prepare loop counter */
+ lua_Unsigned count;
+ if (step > 0) { /* ascending loop? */
+ count = l_castS2U(limit) - l_castS2U(init);
+ if (step != 1) /* avoid division in the too common case */
+ count /= l_castS2U(step);
+ }
+ else { /* step < 0; descending loop */
+ count = l_castS2U(init) - l_castS2U(limit);
+ /* 'step+1' avoids negating 'mininteger' */
+ count /= l_castS2U(-(step + 1)) + 1u;
+ }
+ /* store the counter in place of the limit (which won't be
+ needed anymore) */
+ setivalue(plimit, l_castU2S(count));
+ }
+ }
+ else { /* try making all values floats */
+ lua_Number init; lua_Number limit; lua_Number step;
+ if (l_unlikely(!tonumber(plimit, &limit)))
+ luaG_forerror(L, plimit, "limit");
+ if (l_unlikely(!tonumber(pstep, &step)))
+ luaG_forerror(L, pstep, "step");
+ if (l_unlikely(!tonumber(pinit, &init)))
+ luaG_forerror(L, pinit, "initial value");
+ if (step == 0)
+ luaG_runerror(L, "'for' step is zero");
+ if (luai_numlt(0, step) ? luai_numlt(limit, init)
+ : luai_numlt(init, limit))
+ return 1; /* skip the loop */
+ else {
+ /* make sure internal values are all floats */
+ setfltvalue(plimit, limit);
+ setfltvalue(pstep, step);
+ setfltvalue(s2v(ra), init); /* internal index */
+ setfltvalue(s2v(ra + 3), init); /* control variable */
+ }
+ }
+ return 0;
+}
+
+
+/*
+** Execute a step of a float numerical for loop, returning
+** true iff the loop must continue. (The integer case is
+** written online with opcode OP_FORLOOP, for performance.)
+*/
+static int floatforloop (StkId ra) {
+ lua_Number step = fltvalue(s2v(ra + 2));
+ lua_Number limit = fltvalue(s2v(ra + 1));
+ lua_Number idx = fltvalue(s2v(ra)); /* internal index */
+ idx = luai_numadd(L, idx, step); /* increment index */
+ if (luai_numlt(0, step) ? luai_numle(idx, limit)
+ : luai_numle(limit, idx)) {
+ chgfltvalue(s2v(ra), idx); /* update internal index */
+ setfltvalue(s2v(ra + 3), idx); /* and control variable */
+ return 1; /* jump back */
+ }
+ else
+ return 0; /* finish the loop */
+}
+
+
+/*
+** Finish the table access 'val = t[key]'.
+** if 'slot' is NULL, 't' is not a table; otherwise, 'slot' points to
+** t[k] entry (which must be empty).
+*/
+void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val,
+ const TValue *slot) {
+ int loop; /* counter to avoid infinite loops */
+ const TValue *tm; /* metamethod */
+ for (loop = 0; loop < MAXTAGLOOP; loop++) {
+ if (slot == NULL) { /* 't' is not a table? */
+ lua_assert(!ttistable(t));
+ tm = luaT_gettmbyobj(L, t, TM_INDEX);
+ if (l_unlikely(notm(tm)))
+ luaG_typeerror(L, t, "index"); /* no metamethod */
+ /* else will try the metamethod */
+ }
+ else { /* 't' is a table */
+ lua_assert(isempty(slot));
+ tm = fasttm(L, hvalue(t)->metatable, TM_INDEX); /* table's metamethod */
+ if (tm == NULL) { /* no metamethod? */
+ setnilvalue(s2v(val)); /* result is nil */
+ return;
+ }
+ /* else will try the metamethod */
+ }
+ if (ttisfunction(tm)) { /* is metamethod a function? */
+ luaT_callTMres(L, tm, t, key, val); /* call it */
+ return;
+ }
+ t = tm; /* else try to access 'tm[key]' */
+ if (luaV_fastget(L, t, key, slot, luaH_get)) { /* fast track? */
+ setobj2s(L, val, slot); /* done */
+ return;
+ }
+ /* else repeat (tail call 'luaV_finishget') */
+ }
+ luaG_runerror(L, "'__index' chain too long; possible loop");
+}
+
+
+/*
+** Finish a table assignment 't[key] = val'.
+** If 'slot' is NULL, 't' is not a table. Otherwise, 'slot' points
+** to the entry 't[key]', or to a value with an absent key if there
+** is no such entry. (The value at 'slot' must be empty, otherwise
+** 'luaV_fastget' would have done the job.)
+*/
+void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
+ TValue *val, const TValue *slot) {
+ int loop; /* counter to avoid infinite loops */
+ for (loop = 0; loop < MAXTAGLOOP; loop++) {
+ const TValue *tm; /* '__newindex' metamethod */
+ if (slot != NULL) { /* is 't' a table? */
+ Table *h = hvalue(t); /* save 't' table */
+ lua_assert(isempty(slot)); /* slot must be empty */
+ tm = fasttm(L, h->metatable, TM_NEWINDEX); /* get metamethod */
+ if (tm == NULL) { /* no metamethod? */
+ luaH_finishset(L, h, key, slot, val); /* set new value */
+ invalidateTMcache(h);
+ luaC_barrierback(L, obj2gco(h), val);
+ return;
+ }
+ /* else will try the metamethod */
+ }
+ else { /* not a table; check metamethod */
+ tm = luaT_gettmbyobj(L, t, TM_NEWINDEX);
+ if (l_unlikely(notm(tm)))
+ luaG_typeerror(L, t, "index");
+ }
+ /* try the metamethod */
+ if (ttisfunction(tm)) {
+ luaT_callTM(L, tm, t, key, val);
+ return;
+ }
+ t = tm; /* else repeat assignment over 'tm' */
+ if (luaV_fastget(L, t, key, slot, luaH_get)) {
+ luaV_finishfastset(L, t, slot, val);
+ return; /* done */
+ }
+ /* else 'return luaV_finishset(L, t, key, val, slot)' (loop) */
+ }
+ luaG_runerror(L, "'__newindex' chain too long; possible loop");
+}
+
+
+/*
+** Compare two strings 'ls' x 'rs', returning an integer less-equal-
+** -greater than zero if 'ls' is less-equal-greater than 'rs'.
+** The code is a little tricky because it allows '\0' in the strings
+** and it uses 'strcoll' (to respect locales) for each segments
+** of the strings.
+*/
+static int l_strcmp (const TString *ls, const TString *rs) {
+ const char *l = getstr(ls);
+ size_t ll = tsslen(ls);
+ const char *r = getstr(rs);
+ size_t lr = tsslen(rs);
+ for (;;) { /* for each segment */
+ int temp = strcoll(l, r);
+ if (temp != 0) /* not equal? */
+ return temp; /* done */
+ else { /* strings are equal up to a '\0' */
+ size_t len = strlen(l); /* index of first '\0' in both strings */
+ if (len == lr) /* 'rs' is finished? */
+ return (len == ll) ? 0 : 1; /* check 'ls' */
+ else if (len == ll) /* 'ls' is finished? */
+ return -1; /* 'ls' is less than 'rs' ('rs' is not finished) */
+ /* both strings longer than 'len'; go on comparing after the '\0' */
+ len++;
+ l += len; ll -= len; r += len; lr -= len;
+ }
+ }
+}
+
+
+/*
+** Check whether integer 'i' is less than float 'f'. If 'i' has an
+** exact representation as a float ('l_intfitsf'), compare numbers as
+** floats. Otherwise, use the equivalence 'i < f <=> i < ceil(f)'.
+** If 'ceil(f)' is out of integer range, either 'f' is greater than
+** all integers or less than all integers.
+** (The test with 'l_intfitsf' is only for performance; the else
+** case is correct for all values, but it is slow due to the conversion
+** from float to int.)
+** When 'f' is NaN, comparisons must result in false.
+*/
+l_sinline int LTintfloat (lua_Integer i, lua_Number f) {
+ if (l_intfitsf(i))
+ return luai_numlt(cast_num(i), f); /* compare them as floats */
+ else { /* i < f <=> i < ceil(f) */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
+ return i < fi; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f > 0; /* greater? */
+ }
+}
+
+
+/*
+** Check whether integer 'i' is less than or equal to float 'f'.
+** See comments on previous function.
+*/
+l_sinline int LEintfloat (lua_Integer i, lua_Number f) {
+ if (l_intfitsf(i))
+ return luai_numle(cast_num(i), f); /* compare them as floats */
+ else { /* i <= f <=> i <= floor(f) */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
+ return i <= fi; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f > 0; /* greater? */
+ }
+}
+
+
+/*
+** Check whether float 'f' is less than integer 'i'.
+** See comments on previous function.
+*/
+l_sinline int LTfloatint (lua_Number f, lua_Integer i) {
+ if (l_intfitsf(i))
+ return luai_numlt(f, cast_num(i)); /* compare them as floats */
+ else { /* f < i <=> floor(f) < i */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
+ return fi < i; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f < 0; /* less? */
+ }
+}
+
+
+/*
+** Check whether float 'f' is less than or equal to integer 'i'.
+** See comments on previous function.
+*/
+l_sinline int LEfloatint (lua_Number f, lua_Integer i) {
+ if (l_intfitsf(i))
+ return luai_numle(f, cast_num(i)); /* compare them as floats */
+ else { /* f <= i <=> ceil(f) <= i */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
+ return fi <= i; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f < 0; /* less? */
+ }
+}
+
+
+/*
+** Return 'l < r', for numbers.
+*/
+l_sinline int LTnum (const TValue *l, const TValue *r) {
+ lua_assert(ttisnumber(l) && ttisnumber(r));
+ if (ttisinteger(l)) {
+ lua_Integer li = ivalue(l);
+ if (ttisinteger(r))
+ return li < ivalue(r); /* both are integers */
+ else /* 'l' is int and 'r' is float */
+ return LTintfloat(li, fltvalue(r)); /* l < r ? */
+ }
+ else {
+ lua_Number lf = fltvalue(l); /* 'l' must be float */
+ if (ttisfloat(r))
+ return luai_numlt(lf, fltvalue(r)); /* both are float */
+ else /* 'l' is float and 'r' is int */
+ return LTfloatint(lf, ivalue(r));
+ }
+}
+
+
+/*
+** Return 'l <= r', for numbers.
+*/
+l_sinline int LEnum (const TValue *l, const TValue *r) {
+ lua_assert(ttisnumber(l) && ttisnumber(r));
+ if (ttisinteger(l)) {
+ lua_Integer li = ivalue(l);
+ if (ttisinteger(r))
+ return li <= ivalue(r); /* both are integers */
+ else /* 'l' is int and 'r' is float */
+ return LEintfloat(li, fltvalue(r)); /* l <= r ? */
+ }
+ else {
+ lua_Number lf = fltvalue(l); /* 'l' must be float */
+ if (ttisfloat(r))
+ return luai_numle(lf, fltvalue(r)); /* both are float */
+ else /* 'l' is float and 'r' is int */
+ return LEfloatint(lf, ivalue(r));
+ }
+}
+
+
+/*
+** return 'l < r' for non-numbers.
+*/
+static int lessthanothers (lua_State *L, const TValue *l, const TValue *r) {
+ lua_assert(!ttisnumber(l) || !ttisnumber(r));
+ if (ttisstring(l) && ttisstring(r)) /* both are strings? */
+ return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
+ else
+ return luaT_callorderTM(L, l, r, TM_LT);
+}
+
+
+/*
+** Main operation less than; return 'l < r'.
+*/
+int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
+ if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
+ return LTnum(l, r);
+ else return lessthanothers(L, l, r);
+}
+
+
+/*
+** return 'l <= r' for non-numbers.
+*/
+static int lessequalothers (lua_State *L, const TValue *l, const TValue *r) {
+ lua_assert(!ttisnumber(l) || !ttisnumber(r));
+ if (ttisstring(l) && ttisstring(r)) /* both are strings? */
+ return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
+ else
+ return luaT_callorderTM(L, l, r, TM_LE);
+}
+
+
+/*
+** Main operation less than or equal to; return 'l <= r'.
+*/
+int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
+ if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
+ return LEnum(l, r);
+ else return lessequalothers(L, l, r);
+}
+
+
+/*
+** Main operation for equality of Lua values; return 't1 == t2'.
+** L == NULL means raw equality (no metamethods)
+*/
+int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
+ const TValue *tm;
+ if (ttypetag(t1) != ttypetag(t2)) { /* not the same variant? */
+ if (ttype(t1) != ttype(t2) || ttype(t1) != LUA_TNUMBER)
+ return 0; /* only numbers can be equal with different variants */
+ else { /* two numbers with different variants */
+ /* One of them is an integer. If the other does not have an
+ integer value, they cannot be equal; otherwise, compare their
+ integer values. */
+ lua_Integer i1, i2;
+ return (luaV_tointegerns(t1, &i1, F2Ieq) &&
+ luaV_tointegerns(t2, &i2, F2Ieq) &&
+ i1 == i2);
+ }
+ }
+ /* values have same type and same variant */
+ switch (ttypetag(t1)) {
+ case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE: return 1;
+ case LUA_VNUMINT: return (ivalue(t1) == ivalue(t2));
+ case LUA_VNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
+ case LUA_VLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
+ case LUA_VLCF: return fvalue(t1) == fvalue(t2);
+ case LUA_VSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
+ case LUA_VLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
+ case LUA_VUSERDATA: {
+ if (uvalue(t1) == uvalue(t2)) return 1;
+ else if (L == NULL) return 0;
+ tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);
+ if (tm == NULL)
+ tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);
+ break; /* will try TM */
+ }
+ case LUA_VTABLE: {
+ if (hvalue(t1) == hvalue(t2)) return 1;
+ else if (L == NULL) return 0;
+ tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);
+ if (tm == NULL)
+ tm = fasttm(L, hvalue(t2)->metatable, TM_EQ);
+ break; /* will try TM */
+ }
+ default:
+ return gcvalue(t1) == gcvalue(t2);
+ }
+ if (tm == NULL) /* no TM? */
+ return 0; /* objects are different */
+ else {
+ luaT_callTMres(L, tm, t1, t2, L->top); /* call TM */
+ return !l_isfalse(s2v(L->top));
+ }
+}
+
+
+/* macro used by 'luaV_concat' to ensure that element at 'o' is a string */
+#define tostring(L,o) \
+ (ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1)))
+
+#define isemptystr(o) (ttisshrstring(o) && tsvalue(o)->shrlen == 0)
+
+/* copy strings in stack from top - n up to top - 1 to buffer */
+static void copy2buff (StkId top, int n, char *buff) {
+ size_t tl = 0; /* size already copied */
+ do {
+ size_t l = vslen(s2v(top - n)); /* length of string being copied */
+ memcpy(buff + tl, svalue(s2v(top - n)), l * sizeof(char));
+ tl += l;
+ } while (--n > 0);
+}
+
+
+/*
+** Main operation for concatenation: concat 'total' values in the stack,
+** from 'L->top - total' up to 'L->top - 1'.
+*/
+void luaV_concat (lua_State *L, int total) {
+ if (total == 1)
+ return; /* "all" values already concatenated */
+ do {
+ StkId top = L->top;
+ int n = 2; /* number of elements handled in this pass (at least 2) */
+ if (!(ttisstring(s2v(top - 2)) || cvt2str(s2v(top - 2))) ||
+ !tostring(L, s2v(top - 1)))
+ luaT_tryconcatTM(L); /* may invalidate 'top' */
+ else if (isemptystr(s2v(top - 1))) /* second operand is empty? */
+ cast_void(tostring(L, s2v(top - 2))); /* result is first operand */
+ else if (isemptystr(s2v(top - 2))) { /* first operand is empty string? */
+ setobjs2s(L, top - 2, top - 1); /* result is second op. */
+ }
+ else {
+ /* at least two non-empty string values; get as many as possible */
+ size_t tl = vslen(s2v(top - 1));
+ TString *ts;
+ /* collect total length and number of strings */
+ for (n = 1; n < total && tostring(L, s2v(top - n - 1)); n++) {
+ size_t l = vslen(s2v(top - n - 1));
+ if (l_unlikely(l >= (MAX_SIZE/sizeof(char)) - tl)) {
+ L->top = top - total; /* pop strings to avoid wasting stack */
+ luaG_runerror(L, "string length overflow");
+ }
+ tl += l;
+ }
+ if (tl <= LUAI_MAXSHORTLEN) { /* is result a short string? */
+ char buff[LUAI_MAXSHORTLEN];
+ copy2buff(top, n, buff); /* copy strings to buffer */
+ ts = luaS_newlstr(L, buff, tl);
+ }
+ else { /* long string; copy strings directly to final result */
+ ts = luaS_createlngstrobj(L, tl);
+ copy2buff(top, n, getstr(ts));
+ }
+ setsvalue2s(L, top - n, ts); /* create result */
+ }
+ total -= n - 1; /* got 'n' strings to create one new */
+ L->top -= n - 1; /* popped 'n' strings and pushed one */
+ } while (total > 1); /* repeat until only 1 result left */
+}
+
+
+/*
+** Main operation 'ra = #rb'.
+*/
+void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) {
+ const TValue *tm;
+ switch (ttypetag(rb)) {
+ case LUA_VTABLE: {
+ Table *h = hvalue(rb);
+ tm = fasttm(L, h->metatable, TM_LEN);
+ if (tm) break; /* metamethod? break switch to call it */
+ setivalue(s2v(ra), luaH_getn(h)); /* else primitive len */
+ return;
+ }
+ case LUA_VSHRSTR: {
+ setivalue(s2v(ra), tsvalue(rb)->shrlen);
+ return;
+ }
+ case LUA_VLNGSTR: {
+ setivalue(s2v(ra), tsvalue(rb)->u.lnglen);
+ return;
+ }
+ default: { /* try metamethod */
+ tm = luaT_gettmbyobj(L, rb, TM_LEN);
+ if (l_unlikely(notm(tm))) /* no metamethod? */
+ luaG_typeerror(L, rb, "get length of");
+ break;
+ }
+ }
+ luaT_callTMres(L, tm, rb, rb, ra);
+}
+
+
+/*
+** Integer division; return 'm // n', that is, floor(m/n).
+** C division truncates its result (rounds towards zero).
+** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer,
+** otherwise 'floor(q) == trunc(q) - 1'.
+*/
+lua_Integer luaV_idiv (lua_State *L, lua_Integer m, lua_Integer n) {
+ if (l_unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
+ if (n == 0)
+ luaG_runerror(L, "attempt to divide by zero");
+ return intop(-, 0, m); /* n==-1; avoid overflow with 0x80000...//-1 */
+ }
+ else {
+ lua_Integer q = m / n; /* perform C division */
+ if ((m ^ n) < 0 && m % n != 0) /* 'm/n' would be negative non-integer? */
+ q -= 1; /* correct result for different rounding */
+ return q;
+ }
+}
+
+
+/*
+** Integer modulus; return 'm % n'. (Assume that C '%' with
+** negative operands follows C99 behavior. See previous comment
+** about luaV_idiv.)
+*/
+lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) {
+ if (l_unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
+ if (n == 0)
+ luaG_runerror(L, "attempt to perform 'n%%0'");
+ return 0; /* m % -1 == 0; avoid overflow with 0x80000...%-1 */
+ }
+ else {
+ lua_Integer r = m % n;
+ if (r != 0 && (r ^ n) < 0) /* 'm/n' would be non-integer negative? */
+ r += n; /* correct result for different rounding */
+ return r;
+ }
+}
+
+
+/*
+** Float modulus
+*/
+lua_Number luaV_modf (lua_State *L, lua_Number m, lua_Number n) {
+ lua_Number r;
+ luai_nummod(L, m, n, r);
+ return r;
+}
+
+
+/* number of bits in an integer */
+#define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT)
+
+/*
+** Shift left operation. (Shift right just negates 'y'.)
+*/
+#define luaV_shiftr(x,y) luaV_shiftl(x,intop(-, 0, y))
+
+
+lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) {
+ if (y < 0) { /* shift right? */
+ if (y <= -NBITS) return 0;
+ else return intop(>>, x, -y);
+ }
+ else { /* shift left */
+ if (y >= NBITS) return 0;
+ else return intop(<<, x, y);
+ }
+}
+
+
+/*
+** create a new Lua closure, push it in the stack, and initialize
+** its upvalues.
+*/
+static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,
+ StkId ra) {
+ int nup = p->sizeupvalues;
+ Upvaldesc *uv = p->upvalues;
+ int i;
+ LClosure *ncl = luaF_newLclosure(L, nup);
+ ncl->p = p;
+ setclLvalue2s(L, ra, ncl); /* anchor new closure in stack */
+ for (i = 0; i < nup; i++) { /* fill in its upvalues */
+ if (uv[i].instack) /* upvalue refers to local variable? */
+ ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx);
+ else /* get upvalue from enclosing function */
+ ncl->upvals[i] = encup[uv[i].idx];
+ luaC_objbarrier(L, ncl, ncl->upvals[i]);
+ }
+}
+
+
+/*
+** finish execution of an opcode interrupted by a yield
+*/
+void luaV_finishOp (lua_State *L) {
+ CallInfo *ci = L->ci;
+ StkId base = ci->func + 1;
+ Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */
+ OpCode op = GET_OPCODE(inst);
+ switch (op) { /* finish its execution */
+ case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
+ setobjs2s(L, base + GETARG_A(*(ci->u.l.savedpc - 2)), --L->top);
+ break;
+ }
+ case OP_UNM: case OP_BNOT: case OP_LEN:
+ case OP_GETTABUP: case OP_GETTABLE: case OP_GETI:
+ case OP_GETFIELD: case OP_SELF: {
+ setobjs2s(L, base + GETARG_A(inst), --L->top);
+ break;
+ }
+ case OP_LT: case OP_LE:
+ case OP_LTI: case OP_LEI:
+ case OP_GTI: case OP_GEI:
+ case OP_EQ: { /* note that 'OP_EQI'/'OP_EQK' cannot yield */
+ int res = !l_isfalse(s2v(L->top - 1));
+ L->top--;
+#if defined(LUA_COMPAT_LT_LE)
+ if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */
+ ci->callstatus ^= CIST_LEQ; /* clear mark */
+ res = !res; /* negate result */
+ }
+#endif
+ lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
+ if (res != GETARG_k(inst)) /* condition failed? */
+ ci->u.l.savedpc++; /* skip jump instruction */
+ break;
+ }
+ case OP_CONCAT: {
+ StkId top = L->top - 1; /* top when 'luaT_tryconcatTM' was called */
+ int a = GETARG_A(inst); /* first element to concatenate */
+ int total = cast_int(top - 1 - (base + a)); /* yet to concatenate */
+ setobjs2s(L, top - 2, top); /* put TM result in proper position */
+ L->top = top - 1; /* top is one after last element (at top-2) */
+ luaV_concat(L, total); /* concat them (may yield again) */
+ break;
+ }
+ case OP_CLOSE: { /* yielded closing variables */
+ ci->u.l.savedpc--; /* repeat instruction to close other vars. */
+ break;
+ }
+ case OP_RETURN: { /* yielded closing variables */
+ StkId ra = base + GETARG_A(inst);
+ /* adjust top to signal correct number of returns, in case the
+ return is "up to top" ('isIT') */
+ L->top = ra + ci->u2.nres;
+ /* repeat instruction to close other vars. and complete the return */
+ ci->u.l.savedpc--;
+ break;
+ }
+ default: {
+ /* only these other opcodes can yield */
+ lua_assert(op == OP_TFORCALL || op == OP_CALL ||
+ op == OP_TAILCALL || op == OP_SETTABUP || op == OP_SETTABLE ||
+ op == OP_SETI || op == OP_SETFIELD);
+ break;
+ }
+ }
+}
+
+
+
+
+/*
+** {==================================================================
+** Macros for arithmetic/bitwise/comparison opcodes in 'luaV_execute'
+** ===================================================================
+*/
+
+#define l_addi(L,a,b) intop(+, a, b)
+#define l_subi(L,a,b) intop(-, a, b)
+#define l_muli(L,a,b) intop(*, a, b)
+#define l_band(a,b) intop(&, a, b)
+#define l_bor(a,b) intop(|, a, b)
+#define l_bxor(a,b) intop(^, a, b)
+
+#define l_lti(a,b) (a < b)
+#define l_lei(a,b) (a <= b)
+#define l_gti(a,b) (a > b)
+#define l_gei(a,b) (a >= b)
+
+
+/*
+** Arithmetic operations with immediate operands. 'iop' is the integer
+** operation, 'fop' is the float operation.
+*/
+#define op_arithI(L,iop,fop) { \
+ StkId ra = RA(i); \
+ TValue *v1 = vRB(i); \
+ int imm = GETARG_sC(i); \
+ if (ttisinteger(v1)) { \
+ lua_Integer iv1 = ivalue(v1); \
+ pc++; setivalue(s2v(ra), iop(L, iv1, imm)); \
+ } \
+ else if (ttisfloat(v1)) { \
+ lua_Number nb = fltvalue(v1); \
+ lua_Number fimm = cast_num(imm); \
+ pc++; setfltvalue(s2v(ra), fop(L, nb, fimm)); \
+ }}
+
+
+/*
+** Auxiliary function for arithmetic operations over floats and others
+** with two register operands.
+*/
+#define op_arithf_aux(L,v1,v2,fop) { \
+ lua_Number n1; lua_Number n2; \
+ if (tonumberns(v1, n1) && tonumberns(v2, n2)) { \
+ pc++; setfltvalue(s2v(ra), fop(L, n1, n2)); \
+ }}
+
+
+/*
+** Arithmetic operations over floats and others with register operands.
+*/
+#define op_arithf(L,fop) { \
+ StkId ra = RA(i); \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = vRC(i); \
+ op_arithf_aux(L, v1, v2, fop); }
+
+
+/*
+** Arithmetic operations with K operands for floats.
+*/
+#define op_arithfK(L,fop) { \
+ StkId ra = RA(i); \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = KC(i); lua_assert(ttisnumber(v2)); \
+ op_arithf_aux(L, v1, v2, fop); }
+
+
+/*
+** Arithmetic operations over integers and floats.
+*/
+#define op_arith_aux(L,v1,v2,iop,fop) { \
+ StkId ra = RA(i); \
+ if (ttisinteger(v1) && ttisinteger(v2)) { \
+ lua_Integer i1 = ivalue(v1); lua_Integer i2 = ivalue(v2); \
+ pc++; setivalue(s2v(ra), iop(L, i1, i2)); \
+ } \
+ else op_arithf_aux(L, v1, v2, fop); }
+
+
+/*
+** Arithmetic operations with register operands.
+*/
+#define op_arith(L,iop,fop) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = vRC(i); \
+ op_arith_aux(L, v1, v2, iop, fop); }
+
+
+/*
+** Arithmetic operations with K operands.
+*/
+#define op_arithK(L,iop,fop) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = KC(i); lua_assert(ttisnumber(v2)); \
+ op_arith_aux(L, v1, v2, iop, fop); }
+
+
+/*
+** Bitwise operations with constant operand.
+*/
+#define op_bitwiseK(L,op) { \
+ StkId ra = RA(i); \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = KC(i); \
+ lua_Integer i1; \
+ lua_Integer i2 = ivalue(v2); \
+ if (tointegerns(v1, &i1)) { \
+ pc++; setivalue(s2v(ra), op(i1, i2)); \
+ }}
+
+
+/*
+** Bitwise operations with register operands.
+*/
+#define op_bitwise(L,op) { \
+ StkId ra = RA(i); \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = vRC(i); \
+ lua_Integer i1; lua_Integer i2; \
+ if (tointegerns(v1, &i1) && tointegerns(v2, &i2)) { \
+ pc++; setivalue(s2v(ra), op(i1, i2)); \
+ }}
+
+
+/*
+** Order operations with register operands. 'opn' actually works
+** for all numbers, but the fast track improves performance for
+** integers.
+*/
+#define op_order(L,opi,opn,other) { \
+ StkId ra = RA(i); \
+ int cond; \
+ TValue *rb = vRB(i); \
+ if (ttisinteger(s2v(ra)) && ttisinteger(rb)) { \
+ lua_Integer ia = ivalue(s2v(ra)); \
+ lua_Integer ib = ivalue(rb); \
+ cond = opi(ia, ib); \
+ } \
+ else if (ttisnumber(s2v(ra)) && ttisnumber(rb)) \
+ cond = opn(s2v(ra), rb); \
+ else \
+ Protect(cond = other(L, s2v(ra), rb)); \
+ docondjump(); }
+
+
+/*
+** Order operations with immediate operand. (Immediate operand is
+** always small enough to have an exact representation as a float.)
+*/
+#define op_orderI(L,opi,opf,inv,tm) { \
+ StkId ra = RA(i); \
+ int cond; \
+ int im = GETARG_sB(i); \
+ if (ttisinteger(s2v(ra))) \
+ cond = opi(ivalue(s2v(ra)), im); \
+ else if (ttisfloat(s2v(ra))) { \
+ lua_Number fa = fltvalue(s2v(ra)); \
+ lua_Number fim = cast_num(im); \
+ cond = opf(fa, fim); \
+ } \
+ else { \
+ int isf = GETARG_C(i); \
+ Protect(cond = luaT_callorderiTM(L, s2v(ra), im, inv, isf, tm)); \
+ } \
+ docondjump(); }
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Function 'luaV_execute': main interpreter loop
+** ===================================================================
+*/
+
+/*
+** some macros for common tasks in 'luaV_execute'
+*/
+
+
+#define RA(i) (base+GETARG_A(i))
+#define RB(i) (base+GETARG_B(i))
+#define vRB(i) s2v(RB(i))
+#define KB(i) (k+GETARG_B(i))
+#define RC(i) (base+GETARG_C(i))
+#define vRC(i) s2v(RC(i))
+#define KC(i) (k+GETARG_C(i))
+#define RKC(i) ((TESTARG_k(i)) ? k + GETARG_C(i) : s2v(base + GETARG_C(i)))
+
+
+
+#define updatetrap(ci) (trap = ci->u.l.trap)
+
+#define updatebase(ci) (base = ci->func + 1)
+
+
+#define updatestack(ci) \
+ { if (l_unlikely(trap)) { updatebase(ci); ra = RA(i); } }
+
+
+/*
+** Execute a jump instruction. The 'updatetrap' allows signals to stop
+** tight loops. (Without it, the local copy of 'trap' could never change.)
+*/
+#define dojump(ci,i,e) { pc += GETARG_sJ(i) + e; updatetrap(ci); }
+
+
+/* for test instructions, execute the jump instruction that follows it */
+#define donextjump(ci) { Instruction ni = *pc; dojump(ci, ni, 1); }
+
+/*
+** do a conditional jump: skip next instruction if 'cond' is not what
+** was expected (parameter 'k'), else do next instruction, which must
+** be a jump.
+*/
+#define docondjump() if (cond != GETARG_k(i)) pc++; else donextjump(ci);
+
+
+/*
+** Correct global 'pc'.
+*/
+#define savepc(L) (ci->u.l.savedpc = pc)
+
+
+/*
+** Whenever code can raise errors, the global 'pc' and the global
+** 'top' must be correct to report occasional errors.
+*/
+#define savestate(L,ci) (savepc(L), L->top = ci->top)
+
+
+/*
+** Protect code that, in general, can raise errors, reallocate the
+** stack, and change the hooks.
+*/
+#define Protect(exp) (savestate(L,ci), (exp), updatetrap(ci))
+
+/* special version that does not change the top */
+#define ProtectNT(exp) (savepc(L), (exp), updatetrap(ci))
+
+/*
+** Protect code that can only raise errors. (That is, it cannot change
+** the stack or hooks.)
+*/
+#define halfProtect(exp) (savestate(L,ci), (exp))
+
+/* 'c' is the limit of live values in the stack */
+#define checkGC(L,c) \
+ { luaC_condGC(L, (savepc(L), L->top = (c)), \
+ updatetrap(ci)); \
+ luai_threadyield(L); }
+
+
+/* fetch an instruction and prepare its execution */
+#define vmfetch() { \
+ if (l_unlikely(trap)) { /* stack reallocation or hooks? */ \
+ trap = luaG_traceexec(L, pc); /* handle hooks */ \
+ updatebase(ci); /* correct stack */ \
+ } \
+ i = *(pc++); \
+}
+
+#define vmdispatch(o) switch(o)
+#define vmcase(l) case l:
+#define vmbreak break
+
+
+void luaV_execute (lua_State *L, CallInfo *ci) {
+ LClosure *cl;
+ TValue *k;
+ StkId base;
+ const Instruction *pc;
+ int trap;
+#if LUA_USE_JUMPTABLE
+#include "ljumptab.h"
+#endif
+ startfunc:
+ trap = L->hookmask;
+ returning: /* trap already set */
+ cl = clLvalue(s2v(ci->func));
+ k = cl->p->k;
+ pc = ci->u.l.savedpc;
+ if (l_unlikely(trap)) {
+ if (pc == cl->p->code) { /* first instruction (not resuming)? */
+ if (cl->p->is_vararg)
+ trap = 0; /* hooks will start after VARARGPREP instruction */
+ else /* check 'call' hook */
+ luaD_hookcall(L, ci);
+ }
+ ci->u.l.trap = 1; /* assume trap is on, for now */
+ }
+ base = ci->func + 1;
+ /* main loop of interpreter */
+ for (;;) {
+ Instruction i; /* instruction being executed */
+ vmfetch();
+ #if 0
+ /* low-level line tracing for debugging Lua */
+ printf("line: %d\n", luaG_getfuncline(cl->p, pcRel(pc, cl->p)));
+ #endif
+ lua_assert(base == ci->func + 1);
+ lua_assert(base <= L->top && L->top <= L->stack_last);
+ /* invalidate top for instructions not expecting it */
+ lua_assert(isIT(i) || (cast_void(L->top = base), 1));
+ vmdispatch (GET_OPCODE(i)) {
+ vmcase(OP_MOVE) {
+ StkId ra = RA(i);
+ setobjs2s(L, ra, RB(i));
+ vmbreak;
+ }
+ vmcase(OP_LOADI) {
+ StkId ra = RA(i);
+ lua_Integer b = GETARG_sBx(i);
+ setivalue(s2v(ra), b);
+ vmbreak;
+ }
+ vmcase(OP_LOADF) {
+ StkId ra = RA(i);
+ int b = GETARG_sBx(i);
+ setfltvalue(s2v(ra), cast_num(b));
+ vmbreak;
+ }
+ vmcase(OP_LOADK) {
+ StkId ra = RA(i);
+ TValue *rb = k + GETARG_Bx(i);
+ setobj2s(L, ra, rb);
+ vmbreak;
+ }
+ vmcase(OP_LOADKX) {
+ StkId ra = RA(i);
+ TValue *rb;
+ rb = k + GETARG_Ax(*pc); pc++;
+ setobj2s(L, ra, rb);
+ vmbreak;
+ }
+ vmcase(OP_LOADFALSE) {
+ StkId ra = RA(i);
+ setbfvalue(s2v(ra));
+ vmbreak;
+ }
+ vmcase(OP_LFALSESKIP) {
+ StkId ra = RA(i);
+ setbfvalue(s2v(ra));
+ pc++; /* skip next instruction */
+ vmbreak;
+ }
+ vmcase(OP_LOADTRUE) {
+ StkId ra = RA(i);
+ setbtvalue(s2v(ra));
+ vmbreak;
+ }
+ vmcase(OP_LOADNIL) {
+ StkId ra = RA(i);
+ int b = GETARG_B(i);
+ do {
+ setnilvalue(s2v(ra++));
+ } while (b--);
+ vmbreak;
+ }
+ vmcase(OP_GETUPVAL) {
+ StkId ra = RA(i);
+ int b = GETARG_B(i);
+ setobj2s(L, ra, cl->upvals[b]->v);
+ vmbreak;
+ }
+ vmcase(OP_SETUPVAL) {
+ StkId ra = RA(i);
+ UpVal *uv = cl->upvals[GETARG_B(i)];
+ setobj(L, uv->v, s2v(ra));
+ luaC_barrier(L, uv, s2v(ra));
+ vmbreak;
+ }
+ vmcase(OP_GETTABUP) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *upval = cl->upvals[GETARG_B(i)]->v;
+ TValue *rc = KC(i);
+ TString *key = tsvalue(rc); /* key must be a string */
+ if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, upval, rc, ra, slot));
+ vmbreak;
+ }
+ vmcase(OP_GETTABLE) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ TValue *rc = vRC(i);
+ lua_Unsigned n;
+ if (ttisinteger(rc) /* fast track for integers? */
+ ? (cast_void(n = ivalue(rc)), luaV_fastgeti(L, rb, n, slot))
+ : luaV_fastget(L, rb, rc, slot, luaH_get)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, rb, rc, ra, slot));
+ vmbreak;
+ }
+ vmcase(OP_GETI) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ int c = GETARG_C(i);
+ if (luaV_fastgeti(L, rb, c, slot)) {
+ setobj2s(L, ra, slot);
+ }
+ else {
+ TValue key;
+ setivalue(&key, c);
+ Protect(luaV_finishget(L, rb, &key, ra, slot));
+ }
+ vmbreak;
+ }
+ vmcase(OP_GETFIELD) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ TValue *rc = KC(i);
+ TString *key = tsvalue(rc); /* key must be a string */
+ if (luaV_fastget(L, rb, key, slot, luaH_getshortstr)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, rb, rc, ra, slot));
+ vmbreak;
+ }
+ vmcase(OP_SETTABUP) {
+ const TValue *slot;
+ TValue *upval = cl->upvals[GETARG_A(i)]->v;
+ TValue *rb = KB(i);
+ TValue *rc = RKC(i);
+ TString *key = tsvalue(rb); /* key must be a string */
+ if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
+ luaV_finishfastset(L, upval, slot, rc);
+ }
+ else
+ Protect(luaV_finishset(L, upval, rb, rc, slot));
+ vmbreak;
+ }
+ vmcase(OP_SETTABLE) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *rb = vRB(i); /* key (table is in 'ra') */
+ TValue *rc = RKC(i); /* value */
+ lua_Unsigned n;
+ if (ttisinteger(rb) /* fast track for integers? */
+ ? (cast_void(n = ivalue(rb)), luaV_fastgeti(L, s2v(ra), n, slot))
+ : luaV_fastget(L, s2v(ra), rb, slot, luaH_get)) {
+ luaV_finishfastset(L, s2v(ra), slot, rc);
+ }
+ else
+ Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
+ vmbreak;
+ }
+ vmcase(OP_SETI) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ int c = GETARG_B(i);
+ TValue *rc = RKC(i);
+ if (luaV_fastgeti(L, s2v(ra), c, slot)) {
+ luaV_finishfastset(L, s2v(ra), slot, rc);
+ }
+ else {
+ TValue key;
+ setivalue(&key, c);
+ Protect(luaV_finishset(L, s2v(ra), &key, rc, slot));
+ }
+ vmbreak;
+ }
+ vmcase(OP_SETFIELD) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *rb = KB(i);
+ TValue *rc = RKC(i);
+ TString *key = tsvalue(rb); /* key must be a string */
+ if (luaV_fastget(L, s2v(ra), key, slot, luaH_getshortstr)) {
+ luaV_finishfastset(L, s2v(ra), slot, rc);
+ }
+ else
+ Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
+ vmbreak;
+ }
+ vmcase(OP_NEWTABLE) {
+ StkId ra = RA(i);
+ int b = GETARG_B(i); /* log2(hash size) + 1 */
+ int c = GETARG_C(i); /* array size */
+ Table *t;
+ if (b > 0)
+ b = 1 << (b - 1); /* size is 2^(b - 1) */
+ lua_assert((!TESTARG_k(i)) == (GETARG_Ax(*pc) == 0));
+ if (TESTARG_k(i)) /* non-zero extra argument? */
+ c += GETARG_Ax(*pc) * (MAXARG_C + 1); /* add it to size */
+ pc++; /* skip extra argument */
+ L->top = ra + 1; /* correct top in case of emergency GC */
+ t = luaH_new(L); /* memory allocation */
+ sethvalue2s(L, ra, t);
+ if (b != 0 || c != 0)
+ luaH_resize(L, t, c, b); /* idem */
+ checkGC(L, ra + 1);
+ vmbreak;
+ }
+ vmcase(OP_SELF) {
+ StkId ra = RA(i);
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ TValue *rc = RKC(i);
+ TString *key = tsvalue(rc); /* key must be a string */
+ setobj2s(L, ra + 1, rb);
+ if (luaV_fastget(L, rb, key, slot, luaH_getstr)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, rb, rc, ra, slot));
+ vmbreak;
+ }
+ vmcase(OP_ADDI) {
+ op_arithI(L, l_addi, luai_numadd);
+ vmbreak;
+ }
+ vmcase(OP_ADDK) {
+ op_arithK(L, l_addi, luai_numadd);
+ vmbreak;
+ }
+ vmcase(OP_SUBK) {
+ op_arithK(L, l_subi, luai_numsub);
+ vmbreak;
+ }
+ vmcase(OP_MULK) {
+ op_arithK(L, l_muli, luai_nummul);
+ vmbreak;
+ }
+ vmcase(OP_MODK) {
+ op_arithK(L, luaV_mod, luaV_modf);
+ vmbreak;
+ }
+ vmcase(OP_POWK) {
+ op_arithfK(L, luai_numpow);
+ vmbreak;
+ }
+ vmcase(OP_DIVK) {
+ op_arithfK(L, luai_numdiv);
+ vmbreak;
+ }
+ vmcase(OP_IDIVK) {
+ op_arithK(L, luaV_idiv, luai_numidiv);
+ vmbreak;
+ }
+ vmcase(OP_BANDK) {
+ op_bitwiseK(L, l_band);
+ vmbreak;
+ }
+ vmcase(OP_BORK) {
+ op_bitwiseK(L, l_bor);
+ vmbreak;
+ }
+ vmcase(OP_BXORK) {
+ op_bitwiseK(L, l_bxor);
+ vmbreak;
+ }
+ vmcase(OP_SHRI) {
+ StkId ra = RA(i);
+ TValue *rb = vRB(i);
+ int ic = GETARG_sC(i);
+ lua_Integer ib;
+ if (tointegerns(rb, &ib)) {
+ pc++; setivalue(s2v(ra), luaV_shiftl(ib, -ic));
+ }
+ vmbreak;
+ }
+ vmcase(OP_SHLI) {
+ StkId ra = RA(i);
+ TValue *rb = vRB(i);
+ int ic = GETARG_sC(i);
+ lua_Integer ib;
+ if (tointegerns(rb, &ib)) {
+ pc++; setivalue(s2v(ra), luaV_shiftl(ic, ib));
+ }
+ vmbreak;
+ }
+ vmcase(OP_ADD) {
+ op_arith(L, l_addi, luai_numadd);
+ vmbreak;
+ }
+ vmcase(OP_SUB) {
+ op_arith(L, l_subi, luai_numsub);
+ vmbreak;
+ }
+ vmcase(OP_MUL) {
+ op_arith(L, l_muli, luai_nummul);
+ vmbreak;
+ }
+ vmcase(OP_MOD) {
+ op_arith(L, luaV_mod, luaV_modf);
+ vmbreak;
+ }
+ vmcase(OP_POW) {
+ op_arithf(L, luai_numpow);
+ vmbreak;
+ }
+ vmcase(OP_DIV) { /* float division (always with floats) */
+ op_arithf(L, luai_numdiv);
+ vmbreak;
+ }
+ vmcase(OP_IDIV) { /* floor division */
+ op_arith(L, luaV_idiv, luai_numidiv);
+ vmbreak;
+ }
+ vmcase(OP_BAND) {
+ op_bitwise(L, l_band);
+ vmbreak;
+ }
+ vmcase(OP_BOR) {
+ op_bitwise(L, l_bor);
+ vmbreak;
+ }
+ vmcase(OP_BXOR) {
+ op_bitwise(L, l_bxor);
+ vmbreak;
+ }
+ vmcase(OP_SHR) {
+ op_bitwise(L, luaV_shiftr);
+ vmbreak;
+ }
+ vmcase(OP_SHL) {
+ op_bitwise(L, luaV_shiftl);
+ vmbreak;
+ }
+ vmcase(OP_MMBIN) {
+ StkId ra = RA(i);
+ Instruction pi = *(pc - 2); /* original arith. expression */
+ TValue *rb = vRB(i);
+ TMS tm = (TMS)GETARG_C(i);
+ StkId result = RA(pi);
+ lua_assert(OP_ADD <= GET_OPCODE(pi) && GET_OPCODE(pi) <= OP_SHR);
+ Protect(luaT_trybinTM(L, s2v(ra), rb, result, tm));
+ vmbreak;
+ }
+ vmcase(OP_MMBINI) {
+ StkId ra = RA(i);
+ Instruction pi = *(pc - 2); /* original arith. expression */
+ int imm = GETARG_sB(i);
+ TMS tm = (TMS)GETARG_C(i);
+ int flip = GETARG_k(i);
+ StkId result = RA(pi);
+ Protect(luaT_trybiniTM(L, s2v(ra), imm, flip, result, tm));
+ vmbreak;
+ }
+ vmcase(OP_MMBINK) {
+ StkId ra = RA(i);
+ Instruction pi = *(pc - 2); /* original arith. expression */
+ TValue *imm = KB(i);
+ TMS tm = (TMS)GETARG_C(i);
+ int flip = GETARG_k(i);
+ StkId result = RA(pi);
+ Protect(luaT_trybinassocTM(L, s2v(ra), imm, flip, result, tm));
+ vmbreak;
+ }
+ vmcase(OP_UNM) {
+ StkId ra = RA(i);
+ TValue *rb = vRB(i);
+ lua_Number nb;
+ if (ttisinteger(rb)) {
+ lua_Integer ib = ivalue(rb);
+ setivalue(s2v(ra), intop(-, 0, ib));
+ }
+ else if (tonumberns(rb, nb)) {
+ setfltvalue(s2v(ra), luai_numunm(L, nb));
+ }
+ else
+ Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM));
+ vmbreak;
+ }
+ vmcase(OP_BNOT) {
+ StkId ra = RA(i);
+ TValue *rb = vRB(i);
+ lua_Integer ib;
+ if (tointegerns(rb, &ib)) {
+ setivalue(s2v(ra), intop(^, ~l_castS2U(0), ib));
+ }
+ else
+ Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT));
+ vmbreak;
+ }
+ vmcase(OP_NOT) {
+ StkId ra = RA(i);
+ TValue *rb = vRB(i);
+ if (l_isfalse(rb))
+ setbtvalue(s2v(ra));
+ else
+ setbfvalue(s2v(ra));
+ vmbreak;
+ }
+ vmcase(OP_LEN) {
+ StkId ra = RA(i);
+ Protect(luaV_objlen(L, ra, vRB(i)));
+ vmbreak;
+ }
+ vmcase(OP_CONCAT) {
+ StkId ra = RA(i);
+ int n = GETARG_B(i); /* number of elements to concatenate */
+ L->top = ra + n; /* mark the end of concat operands */
+ ProtectNT(luaV_concat(L, n));
+ checkGC(L, L->top); /* 'luaV_concat' ensures correct top */
+ vmbreak;
+ }
+ vmcase(OP_CLOSE) {
+ StkId ra = RA(i);
+ Protect(luaF_close(L, ra, LUA_OK, 1));
+ vmbreak;
+ }
+ vmcase(OP_TBC) {
+ StkId ra = RA(i);
+ /* create new to-be-closed upvalue */
+ halfProtect(luaF_newtbcupval(L, ra));
+ vmbreak;
+ }
+ vmcase(OP_JMP) {
+ dojump(ci, i, 0);
+ vmbreak;
+ }
+ vmcase(OP_EQ) {
+ StkId ra = RA(i);
+ int cond;
+ TValue *rb = vRB(i);
+ Protect(cond = luaV_equalobj(L, s2v(ra), rb));
+ docondjump();
+ vmbreak;
+ }
+ vmcase(OP_LT) {
+ op_order(L, l_lti, LTnum, lessthanothers);
+ vmbreak;
+ }
+ vmcase(OP_LE) {
+ op_order(L, l_lei, LEnum, lessequalothers);
+ vmbreak;
+ }
+ vmcase(OP_EQK) {
+ StkId ra = RA(i);
+ TValue *rb = KB(i);
+ /* basic types do not use '__eq'; we can use raw equality */
+ int cond = luaV_rawequalobj(s2v(ra), rb);
+ docondjump();
+ vmbreak;
+ }
+ vmcase(OP_EQI) {
+ StkId ra = RA(i);
+ int cond;
+ int im = GETARG_sB(i);
+ if (ttisinteger(s2v(ra)))
+ cond = (ivalue(s2v(ra)) == im);
+ else if (ttisfloat(s2v(ra)))
+ cond = luai_numeq(fltvalue(s2v(ra)), cast_num(im));
+ else
+ cond = 0; /* other types cannot be equal to a number */
+ docondjump();
+ vmbreak;
+ }
+ vmcase(OP_LTI) {
+ op_orderI(L, l_lti, luai_numlt, 0, TM_LT);
+ vmbreak;
+ }
+ vmcase(OP_LEI) {
+ op_orderI(L, l_lei, luai_numle, 0, TM_LE);
+ vmbreak;
+ }
+ vmcase(OP_GTI) {
+ op_orderI(L, l_gti, luai_numgt, 1, TM_LT);
+ vmbreak;
+ }
+ vmcase(OP_GEI) {
+ op_orderI(L, l_gei, luai_numge, 1, TM_LE);
+ vmbreak;
+ }
+ vmcase(OP_TEST) {
+ StkId ra = RA(i);
+ int cond = !l_isfalse(s2v(ra));
+ docondjump();
+ vmbreak;
+ }
+ vmcase(OP_TESTSET) {
+ StkId ra = RA(i);
+ TValue *rb = vRB(i);
+ if (l_isfalse(rb) == GETARG_k(i))
+ pc++;
+ else {
+ setobj2s(L, ra, rb);
+ donextjump(ci);
+ }
+ vmbreak;
+ }
+ vmcase(OP_CALL) {
+ StkId ra = RA(i);
+ CallInfo *newci;
+ int b = GETARG_B(i);
+ int nresults = GETARG_C(i) - 1;
+ if (b != 0) /* fixed number of arguments? */
+ L->top = ra + b; /* top signals number of arguments */
+ /* else previous instruction set top */
+ savepc(L); /* in case of errors */
+ if ((newci = luaD_precall(L, ra, nresults)) == NULL)
+ updatetrap(ci); /* C call; nothing else to be done */
+ else { /* Lua call: run function in this same C frame */
+ ci = newci;
+ goto startfunc;
+ }
+ vmbreak;
+ }
+ vmcase(OP_TAILCALL) {
+ StkId ra = RA(i);
+ int b = GETARG_B(i); /* number of arguments + 1 (function) */
+ int n; /* number of results when calling a C function */
+ int nparams1 = GETARG_C(i);
+ /* delta is virtual 'func' - real 'func' (vararg functions) */
+ int delta = (nparams1) ? ci->u.l.nextraargs + nparams1 : 0;
+ if (b != 0)
+ L->top = ra + b;
+ else /* previous instruction set top */
+ b = cast_int(L->top - ra);
+ savepc(ci); /* several calls here can raise errors */
+ if (TESTARG_k(i)) {
+ luaF_closeupval(L, base); /* close upvalues from current call */
+ lua_assert(L->tbclist < base); /* no pending tbc variables */
+ lua_assert(base == ci->func + 1);
+ }
+ if ((n = luaD_pretailcall(L, ci, ra, b, delta)) < 0) /* Lua function? */
+ goto startfunc; /* execute the callee */
+ else { /* C function? */
+ ci->func -= delta; /* restore 'func' (if vararg) */
+ luaD_poscall(L, ci, n); /* finish caller */
+ updatetrap(ci); /* 'luaD_poscall' can change hooks */
+ goto ret; /* caller returns after the tail call */
+ }
+ }
+ vmcase(OP_RETURN) {
+ StkId ra = RA(i);
+ int n = GETARG_B(i) - 1; /* number of results */
+ int nparams1 = GETARG_C(i);
+ if (n < 0) /* not fixed? */
+ n = cast_int(L->top - ra); /* get what is available */
+ savepc(ci);
+ if (TESTARG_k(i)) { /* may there be open upvalues? */
+ ci->u2.nres = n; /* save number of returns */
+ if (L->top < ci->top)
+ L->top = ci->top;
+ luaF_close(L, base, CLOSEKTOP, 1);
+ updatetrap(ci);
+ updatestack(ci);
+ }
+ if (nparams1) /* vararg function? */
+ ci->func -= ci->u.l.nextraargs + nparams1;
+ L->top = ra + n; /* set call for 'luaD_poscall' */
+ luaD_poscall(L, ci, n);
+ updatetrap(ci); /* 'luaD_poscall' can change hooks */
+ goto ret;
+ }
+ vmcase(OP_RETURN0) {
+ if (l_unlikely(L->hookmask)) {
+ StkId ra = RA(i);
+ L->top = ra;
+ savepc(ci);
+ luaD_poscall(L, ci, 0); /* no hurry... */
+ trap = 1;
+ }
+ else { /* do the 'poscall' here */
+ int nres;
+ L->ci = ci->previous; /* back to caller */
+ L->top = base - 1;
+ for (nres = ci->nresults; l_unlikely(nres > 0); nres--)
+ setnilvalue(s2v(L->top++)); /* all results are nil */
+ }
+ goto ret;
+ }
+ vmcase(OP_RETURN1) {
+ if (l_unlikely(L->hookmask)) {
+ StkId ra = RA(i);
+ L->top = ra + 1;
+ savepc(ci);
+ luaD_poscall(L, ci, 1); /* no hurry... */
+ trap = 1;
+ }
+ else { /* do the 'poscall' here */
+ int nres = ci->nresults;
+ L->ci = ci->previous; /* back to caller */
+ if (nres == 0)
+ L->top = base - 1; /* asked for no results */
+ else {
+ StkId ra = RA(i);
+ setobjs2s(L, base - 1, ra); /* at least this result */
+ L->top = base;
+ for (; l_unlikely(nres > 1); nres--)
+ setnilvalue(s2v(L->top++)); /* complete missing results */
+ }
+ }
+ ret: /* return from a Lua function */
+ if (ci->callstatus & CIST_FRESH)
+ return; /* end this frame */
+ else {
+ ci = ci->previous;
+ goto returning; /* continue running caller in this frame */
+ }
+ }
+ vmcase(OP_FORLOOP) {
+ StkId ra = RA(i);
+ if (ttisinteger(s2v(ra + 2))) { /* integer loop? */
+ lua_Unsigned count = l_castS2U(ivalue(s2v(ra + 1)));
+ if (count > 0) { /* still more iterations? */
+ lua_Integer step = ivalue(s2v(ra + 2));
+ lua_Integer idx = ivalue(s2v(ra)); /* internal index */
+ chgivalue(s2v(ra + 1), count - 1); /* update counter */
+ idx = intop(+, idx, step); /* add step to index */
+ chgivalue(s2v(ra), idx); /* update internal index */
+ setivalue(s2v(ra + 3), idx); /* and control variable */
+ pc -= GETARG_Bx(i); /* jump back */
+ }
+ }
+ else if (floatforloop(ra)) /* float loop */
+ pc -= GETARG_Bx(i); /* jump back */
+ updatetrap(ci); /* allows a signal to break the loop */
+ vmbreak;
+ }
+ vmcase(OP_FORPREP) {
+ StkId ra = RA(i);
+ savestate(L, ci); /* in case of errors */
+ if (forprep(L, ra))
+ pc += GETARG_Bx(i) + 1; /* skip the loop */
+ vmbreak;
+ }
+ vmcase(OP_TFORPREP) {
+ StkId ra = RA(i);
+ /* create to-be-closed upvalue (if needed) */
+ halfProtect(luaF_newtbcupval(L, ra + 3));
+ pc += GETARG_Bx(i);
+ i = *(pc++); /* go to next instruction */
+ lua_assert(GET_OPCODE(i) == OP_TFORCALL && ra == RA(i));
+ goto l_tforcall;
+ }
+ vmcase(OP_TFORCALL) {
+ l_tforcall: {
+ StkId ra = RA(i);
+ /* 'ra' has the iterator function, 'ra + 1' has the state,
+ 'ra + 2' has the control variable, and 'ra + 3' has the
+ to-be-closed variable. The call will use the stack after
+ these values (starting at 'ra + 4')
+ */
+ /* push function, state, and control variable */
+ memcpy(ra + 4, ra, 3 * sizeof(*ra));
+ L->top = ra + 4 + 3;
+ ProtectNT(luaD_call(L, ra + 4, GETARG_C(i))); /* do the call */
+ updatestack(ci); /* stack may have changed */
+ i = *(pc++); /* go to next instruction */
+ lua_assert(GET_OPCODE(i) == OP_TFORLOOP && ra == RA(i));
+ goto l_tforloop;
+ }}
+ vmcase(OP_TFORLOOP) {
+ l_tforloop: {
+ StkId ra = RA(i);
+ if (!ttisnil(s2v(ra + 4))) { /* continue loop? */
+ setobjs2s(L, ra + 2, ra + 4); /* save control variable */
+ pc -= GETARG_Bx(i); /* jump back */
+ }
+ vmbreak;
+ }}
+ vmcase(OP_SETLIST) {
+ StkId ra = RA(i);
+ int n = GETARG_B(i);
+ unsigned int last = GETARG_C(i);
+ Table *h = hvalue(s2v(ra));
+ if (n == 0)
+ n = cast_int(L->top - ra) - 1; /* get up to the top */
+ else
+ L->top = ci->top; /* correct top in case of emergency GC */
+ last += n;
+ if (TESTARG_k(i)) {
+ last += GETARG_Ax(*pc) * (MAXARG_C + 1);
+ pc++;
+ }
+ if (last > luaH_realasize(h)) /* needs more space? */
+ luaH_resizearray(L, h, last); /* preallocate it at once */
+ for (; n > 0; n--) {
+ TValue *val = s2v(ra + n);
+ setobj2t(L, &h->array[last - 1], val);
+ last--;
+ luaC_barrierback(L, obj2gco(h), val);
+ }
+ vmbreak;
+ }
+ vmcase(OP_CLOSURE) {
+ StkId ra = RA(i);
+ Proto *p = cl->p->p[GETARG_Bx(i)];
+ halfProtect(pushclosure(L, p, cl->upvals, base, ra));
+ checkGC(L, ra + 1);
+ vmbreak;
+ }
+ vmcase(OP_VARARG) {
+ StkId ra = RA(i);
+ int n = GETARG_C(i) - 1; /* required results */
+ Protect(luaT_getvarargs(L, ci, ra, n));
+ vmbreak;
+ }
+ vmcase(OP_VARARGPREP) {
+ ProtectNT(luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p));
+ if (l_unlikely(trap)) { /* previous "Protect" updated trap */
+ luaD_hookcall(L, ci);
+ L->oldpc = 1; /* next opcode will be seen as a "new" line */
+ }
+ updatebase(ci); /* function has new base after adjustment */
+ vmbreak;
+ }
+ vmcase(OP_EXTRAARG) {
+ lua_assert(0);
+ vmbreak;
+ }
+ }
+ }
+}
+
+/* }================================================================== */
diff --git a/source/luametatex/source/luacore/lua54/src/lvm.h b/source/luametatex/source/luacore/lua54/src/lvm.h
new file mode 100644
index 000000000..1bc16f3a5
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lvm.h
@@ -0,0 +1,136 @@
+/*
+** $Id: lvm.h $
+** Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lvm_h
+#define lvm_h
+
+
+#include "ldo.h"
+#include "lobject.h"
+#include "ltm.h"
+
+
+#if !defined(LUA_NOCVTN2S)
+#define cvt2str(o) ttisnumber(o)
+#else
+#define cvt2str(o) 0 /* no conversion from numbers to strings */
+#endif
+
+
+#if !defined(LUA_NOCVTS2N)
+#define cvt2num(o) ttisstring(o)
+#else
+#define cvt2num(o) 0 /* no conversion from strings to numbers */
+#endif
+
+
+/*
+** You can define LUA_FLOORN2I if you want to convert floats to integers
+** by flooring them (instead of raising an error if they are not
+** integral values)
+*/
+#if !defined(LUA_FLOORN2I)
+#define LUA_FLOORN2I F2Ieq
+#endif
+
+
+/*
+** Rounding modes for float->integer coercion
+ */
+typedef enum {
+ F2Ieq, /* no rounding; accepts only integral values */
+ F2Ifloor, /* takes the floor of the number */
+ F2Iceil /* takes the ceil of the number */
+} F2Imod;
+
+
+/* convert an object to a float (including string coercion) */
+#define tonumber(o,n) \
+ (ttisfloat(o) ? (*(n) = fltvalue(o), 1) : luaV_tonumber_(o,n))
+
+
+/* convert an object to a float (without string coercion) */
+#define tonumberns(o,n) \
+ (ttisfloat(o) ? ((n) = fltvalue(o), 1) : \
+ (ttisinteger(o) ? ((n) = cast_num(ivalue(o)), 1) : 0))
+
+
+/* convert an object to an integer (including string coercion) */
+#define tointeger(o,i) \
+ (l_likely(ttisinteger(o)) ? (*(i) = ivalue(o), 1) \
+ : luaV_tointeger(o,i,LUA_FLOORN2I))
+
+
+/* convert an object to an integer (without string coercion) */
+#define tointegerns(o,i) \
+ (l_likely(ttisinteger(o)) ? (*(i) = ivalue(o), 1) \
+ : luaV_tointegerns(o,i,LUA_FLOORN2I))
+
+
+#define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2))
+
+#define luaV_rawequalobj(t1,t2) luaV_equalobj(NULL,t1,t2)
+
+
+/*
+** fast track for 'gettable': if 't' is a table and 't[k]' is present,
+** return 1 with 'slot' pointing to 't[k]' (position of final result).
+** Otherwise, return 0 (meaning it will have to check metamethod)
+** with 'slot' pointing to an empty 't[k]' (if 't' is a table) or NULL
+** (otherwise). 'f' is the raw get function to use.
+*/
+#define luaV_fastget(L,t,k,slot,f) \
+ (!ttistable(t) \
+ ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
+ : (slot = f(hvalue(t), k), /* else, do raw access */ \
+ !isempty(slot))) /* result not empty? */
+
+
+/*
+** Special case of 'luaV_fastget' for integers, inlining the fast case
+** of 'luaH_getint'.
+*/
+#define luaV_fastgeti(L,t,k,slot) \
+ (!ttistable(t) \
+ ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
+ : (slot = (l_castS2U(k) - 1u < hvalue(t)->alimit) \
+ ? &hvalue(t)->array[k - 1] : luaH_getint(hvalue(t), k), \
+ !isempty(slot))) /* result not empty? */
+
+
+/*
+** Finish a fast set operation (when fast get succeeds). In that case,
+** 'slot' points to the place to put the value.
+*/
+#define luaV_finishfastset(L,t,slot,v) \
+ { setobj2t(L, cast(TValue *,slot), v); \
+ luaC_barrierback(L, gcvalue(t), v); }
+
+
+
+
+LUAI_FUNC int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2);
+LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);
+LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r);
+LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n);
+LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode);
+LUAI_FUNC int luaV_tointegerns (const TValue *obj, lua_Integer *p,
+ F2Imod mode);
+LUAI_FUNC int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode);
+LUAI_FUNC void luaV_finishget (lua_State *L, const TValue *t, TValue *key,
+ StkId val, const TValue *slot);
+LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
+ TValue *val, const TValue *slot);
+LUAI_FUNC void luaV_finishOp (lua_State *L);
+LUAI_FUNC void luaV_execute (lua_State *L, CallInfo *ci);
+LUAI_FUNC void luaV_concat (lua_State *L, int total);
+LUAI_FUNC lua_Integer luaV_idiv (lua_State *L, lua_Integer x, lua_Integer y);
+LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y);
+LUAI_FUNC lua_Number luaV_modf (lua_State *L, lua_Number x, lua_Number y);
+LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y);
+LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb);
+
+#endif
diff --git a/source/luametatex/source/luacore/lua54/src/lzio.c b/source/luametatex/source/luacore/lua54/src/lzio.c
new file mode 100644
index 000000000..cd0a02d5f
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lzio.c
@@ -0,0 +1,68 @@
+/*
+** $Id: lzio.c $
+** Buffered streams
+** See Copyright Notice in lua.h
+*/
+
+#define lzio_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+
+#include <string.h>
+
+#include "lua.h"
+
+#include "llimits.h"
+#include "lmem.h"
+#include "lstate.h"
+#include "lzio.h"
+
+
+int luaZ_fill (ZIO *z) {
+ size_t size;
+ lua_State *L = z->L;
+ const char *buff;
+ lua_unlock(L);
+ buff = z->reader(L, z->data, &size);
+ lua_lock(L);
+ if (buff == NULL || size == 0)
+ return EOZ;
+ z->n = size - 1; /* discount char being returned */
+ z->p = buff;
+ return cast_uchar(*(z->p++));
+}
+
+
+void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) {
+ z->L = L;
+ z->reader = reader;
+ z->data = data;
+ z->n = 0;
+ z->p = NULL;
+}
+
+
+/* --------------------------------------------------------------- read --- */
+size_t luaZ_read (ZIO *z, void *b, size_t n) {
+ while (n) {
+ size_t m;
+ if (z->n == 0) { /* no bytes in buffer? */
+ if (luaZ_fill(z) == EOZ) /* try to read more */
+ return n; /* no more input; return number of missing bytes */
+ else {
+ z->n++; /* luaZ_fill consumed first byte; put it back */
+ z->p--;
+ }
+ }
+ m = (n <= z->n) ? n : z->n; /* min. between n and z->n */
+ memcpy(b, z->p, m);
+ z->n -= m;
+ z->p += m;
+ b = (char *)b + m;
+ n -= m;
+ }
+ return 0;
+}
+
diff --git a/source/luametatex/source/luacore/lua54/src/lzio.h b/source/luametatex/source/luacore/lua54/src/lzio.h
new file mode 100644
index 000000000..38f397fd2
--- /dev/null
+++ b/source/luametatex/source/luacore/lua54/src/lzio.h
@@ -0,0 +1,66 @@
+/*
+** $Id: lzio.h $
+** Buffered streams
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lzio_h
+#define lzio_h
+
+#include "lua.h"
+
+#include "lmem.h"
+
+
+#define EOZ (-1) /* end of stream */
+
+typedef struct Zio ZIO;
+
+#define zgetc(z) (((z)->n--)>0 ? cast_uchar(*(z)->p++) : luaZ_fill(z))
+
+
+typedef struct Mbuffer {
+ char *buffer;
+ size_t n;
+ size_t buffsize;
+} Mbuffer;
+
+#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0)
+
+#define luaZ_buffer(buff) ((buff)->buffer)
+#define luaZ_sizebuffer(buff) ((buff)->buffsize)
+#define luaZ_bufflen(buff) ((buff)->n)
+
+#define luaZ_buffremove(buff,i) ((buff)->n -= (i))
+#define luaZ_resetbuffer(buff) ((buff)->n = 0)
+
+
+#define luaZ_resizebuffer(L, buff, size) \
+ ((buff)->buffer = luaM_reallocvchar(L, (buff)->buffer, \
+ (buff)->buffsize, size), \
+ (buff)->buffsize = size)
+
+#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0)
+
+
+LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader,
+ void *data);
+LUAI_FUNC size_t luaZ_read (ZIO* z, void *b, size_t n); /* read next n bytes */
+
+
+
+/* --------- Private Part ------------------ */
+
+struct Zio {
+ size_t n; /* bytes still unread */
+ const char *p; /* current position in buffer */
+ lua_Reader reader; /* reader function */
+ void *data; /* additional data */
+ lua_State *L; /* Lua state (for reader) */
+};
+
+
+LUAI_FUNC int luaZ_fill (ZIO *z);
+
+#endif
diff --git a/source/luametatex/source/luacore/luac/luac.c b/source/luametatex/source/luacore/luac/luac.c
new file mode 100644
index 000000000..56ddc4148
--- /dev/null
+++ b/source/luametatex/source/luacore/luac/luac.c
@@ -0,0 +1,724 @@
+/*
+** $Id: luac.c $
+** Lua compiler (saves bytecodes to files; also lists bytecodes)
+** See Copyright Notice in lua.h
+*/
+
+#define luac_c
+#define LUA_CORE
+
+#include "lprefix.h"
+
+#include <ctype.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+#include "lauxlib.h"
+
+#include "ldebug.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lopnames.h"
+#include "lstate.h"
+#include "lundump.h"
+
+static void PrintFunction(const Proto* f, int full);
+#define luaU_print PrintFunction
+
+#define PROGNAME "luac" /* default program name */
+#define OUTPUT PROGNAME ".out" /* default output file */
+
+static int listing=0; /* list bytecodes? */
+static int dumping=1; /* dump bytecodes? */
+static int stripping=0; /* strip debug information? */
+static char Output[]={ OUTPUT }; /* default output file name */
+static const char* output=Output; /* actual output file name */
+static const char* progname=PROGNAME; /* actual program name */
+static TString **tmname;
+
+static void fatal(const char* message)
+{
+ fprintf(stderr,"%s: %s\n",progname,message);
+ exit(EXIT_FAILURE);
+}
+
+static void cannot(const char* what)
+{
+ fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno));
+ exit(EXIT_FAILURE);
+}
+
+static void usage(const char* message)
+{
+ if (*message=='-')
+ fprintf(stderr,"%s: unrecognized option '%s'\n",progname,message);
+ else
+ fprintf(stderr,"%s: %s\n",progname,message);
+ fprintf(stderr,
+ "usage: %s [options] [filenames]\n"
+ "Available options are:\n"
+ " -l list (use -l -l for full listing)\n"
+ " -o name output to file 'name' (default is \"%s\")\n"
+ " -p parse only\n"
+ " -s strip debug information\n"
+ " -v show version information\n"
+ " -- stop handling options\n"
+ " - stop handling options and process stdin\n"
+ ,progname,Output);
+ exit(EXIT_FAILURE);
+}
+
+#define IS(s) (strcmp(argv[i],s)==0)
+
+static int doargs(int argc, char* argv[])
+{
+ int i;
+ int version=0;
+ if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0];
+ for (i=1; i<argc; i++)
+ {
+ if (*argv[i]!='-') /* end of options; keep it */
+ break;
+ else if (IS("--")) /* end of options; skip it */
+ {
+ ++i;
+ if (version) ++version;
+ break;
+ }
+ else if (IS("-")) /* end of options; use stdin */
+ break;
+ else if (IS("-l")) /* list */
+ ++listing;
+ else if (IS("-o")) /* output file */
+ {
+ output=argv[++i];
+ if (output==NULL || *output==0 || (*output=='-' && output[1]!=0))
+ usage("'-o' needs argument");
+ if (IS("-")) output=NULL;
+ }
+ else if (IS("-p")) /* parse only */
+ dumping=0;
+ else if (IS("-s")) /* strip debug information */
+ stripping=1;
+ else if (IS("-v")) /* show version */
+ ++version;
+ else /* unknown option */
+ usage(argv[i]);
+ }
+ if (i==argc && (listing || !dumping))
+ {
+ dumping=0;
+ argv[--i]=Output;
+ }
+ if (version)
+ {
+ printf("%s\n",LUA_COPYRIGHT);
+ if (version==argc-1) exit(EXIT_SUCCESS);
+ }
+ return i;
+}
+
+#define FUNCTION "(function()end)();"
+
+static const char* reader(lua_State* L, void* ud, size_t* size)
+{
+ UNUSED(L);
+ if ((*(int*)ud)--)
+ {
+ *size=sizeof(FUNCTION)-1;
+ return FUNCTION;
+ }
+ else
+ {
+ *size=0;
+ return NULL;
+ }
+}
+
+#define toproto(L,i) getproto(s2v(L->top+(i)))
+
+static const Proto* combine(lua_State* L, int n)
+{
+ if (n==1)
+ return toproto(L,-1);
+ else
+ {
+ Proto* f;
+ int i=n;
+ if (lua_load(L,reader,&i,"=(" PROGNAME ")",NULL)!=LUA_OK) fatal(lua_tostring(L,-1));
+ f=toproto(L,-1);
+ for (i=0; i<n; i++)
+ {
+ f->p[i]=toproto(L,i-n-1);
+ if (f->p[i]->sizeupvalues>0) f->p[i]->upvalues[0].instack=0;
+ }
+ f->sizelineinfo=0;
+ return f;
+ }
+}
+
+static int writer(lua_State* L, const void* p, size_t size, void* u)
+{
+ UNUSED(L);
+ return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0);
+}
+
+static int pmain(lua_State* L)
+{
+ int argc=(int)lua_tointeger(L,1);
+ char** argv=(char**)lua_touserdata(L,2);
+ const Proto* f;
+ int i;
+ tmname=G(L)->tmname;
+ if (!lua_checkstack(L,argc)) fatal("too many input files");
+ for (i=0; i<argc; i++)
+ {
+ const char* filename=IS("-") ? NULL : argv[i];
+ if (luaL_loadfile(L,filename)!=LUA_OK) fatal(lua_tostring(L,-1));
+ }
+ f=combine(L,argc);
+ if (listing) luaU_print(f,listing>1);
+ if (dumping)
+ {
+ FILE* D= (output==NULL) ? stdout : fopen(output,"wb");
+ if (D==NULL) cannot("open");
+ lua_lock(L);
+ luaU_dump(L,f,writer,D,stripping);
+ lua_unlock(L);
+ if (ferror(D)) cannot("write");
+ if (fclose(D)) cannot("close");
+ }
+ return 0;
+}
+
+int main(int argc, char* argv[])
+{
+ lua_State* L;
+ int i=doargs(argc,argv);
+ argc-=i; argv+=i;
+ if (argc<=0) usage("no input files given");
+ L=luaL_newstate();
+ if (L==NULL) fatal("cannot create state: not enough memory");
+ lua_pushcfunction(L,&pmain);
+ lua_pushinteger(L,argc);
+ lua_pushlightuserdata(L,argv);
+ if (lua_pcall(L,2,0,0)!=LUA_OK) fatal(lua_tostring(L,-1));
+ lua_close(L);
+ return EXIT_SUCCESS;
+}
+
+/*
+** print bytecodes
+*/
+
+#define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
+#define VOID(p) ((const void*)(p))
+#define eventname(i) (getstr(tmname[i]))
+
+static void PrintString(const TString* ts)
+{
+ const char* s=getstr(ts);
+ size_t i,n=tsslen(ts);
+ printf("\"");
+ for (i=0; i<n; i++)
+ {
+ int c=(int)(unsigned char)s[i];
+ switch (c)
+ {
+ case '"':
+ printf("\\\"");
+ break;
+ case '\\':
+ printf("\\\\");
+ break;
+ case '\a':
+ printf("\\a");
+ break;
+ case '\b':
+ printf("\\b");
+ break;
+ case '\f':
+ printf("\\f");
+ break;
+ case '\n':
+ printf("\\n");
+ break;
+ case '\r':
+ printf("\\r");
+ break;
+ case '\t':
+ printf("\\t");
+ break;
+ case '\v':
+ printf("\\v");
+ break;
+ default:
+ if (isprint(c)) printf("%c",c); else printf("\\%03d",c);
+ break;
+ }
+ }
+ printf("\"");
+}
+
+static void PrintType(const Proto* f, int i)
+{
+ const TValue* o=&f->k[i];
+ switch (ttypetag(o))
+ {
+ case LUA_VNIL:
+ printf("N");
+ break;
+ case LUA_VFALSE:
+ case LUA_VTRUE:
+ printf("B");
+ break;
+ case LUA_VNUMFLT:
+ printf("F");
+ break;
+ case LUA_VNUMINT:
+ printf("I");
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ printf("S");
+ break;
+ default: /* cannot happen */
+ printf("?%d",ttypetag(o));
+ break;
+ }
+ printf("\t");
+}
+
+static void PrintConstant(const Proto* f, int i)
+{
+ const TValue* o=&f->k[i];
+ switch (ttypetag(o))
+ {
+ case LUA_VNIL:
+ printf("nil");
+ break;
+ case LUA_VFALSE:
+ printf("false");
+ break;
+ case LUA_VTRUE:
+ printf("true");
+ break;
+ case LUA_VNUMFLT:
+ {
+ char buff[100];
+ sprintf(buff,LUA_NUMBER_FMT,fltvalue(o));
+ printf("%s",buff);
+ if (buff[strspn(buff,"-0123456789")]=='\0') printf(".0");
+ break;
+ }
+ case LUA_VNUMINT:
+ printf(LUA_INTEGER_FMT,ivalue(o));
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ PrintString(tsvalue(o));
+ break;
+ default: /* cannot happen */
+ printf("?%d",ttypetag(o));
+ break;
+ }
+}
+
+#define COMMENT "\t; "
+#define EXTRAARG GETARG_Ax(code[pc+1])
+#define EXTRAARGC (EXTRAARG*(MAXARG_C+1))
+#define ISK (isk ? "k" : "")
+
+static void PrintCode(const Proto* f)
+{
+ const Instruction* code=f->code;
+ int pc,n=f->sizecode;
+ for (pc=0; pc<n; pc++)
+ {
+ Instruction i=code[pc];
+ OpCode o=GET_OPCODE(i);
+ int a=GETARG_A(i);
+ int b=GETARG_B(i);
+ int c=GETARG_C(i);
+ int ax=GETARG_Ax(i);
+ int bx=GETARG_Bx(i);
+ int sb=GETARG_sB(i);
+ int sc=GETARG_sC(i);
+ int sbx=GETARG_sBx(i);
+ int isk=GETARG_k(i);
+ int line=luaG_getfuncline(f,pc);
+ printf("\t%d\t",pc+1);
+ if (line>0) printf("[%d]\t",line); else printf("[-]\t");
+ printf("%-9s\t",opnames[o]);
+ switch (o)
+ {
+ case OP_MOVE:
+ printf("%d %d",a,b);
+ break;
+ case OP_LOADI:
+ printf("%d %d",a,sbx);
+ break;
+ case OP_LOADF:
+ printf("%d %d",a,sbx);
+ break;
+ case OP_LOADK:
+ printf("%d %d",a,bx);
+ printf(COMMENT); PrintConstant(f,bx);
+ break;
+ case OP_LOADKX:
+ printf("%d",a);
+ printf(COMMENT); PrintConstant(f,EXTRAARG);
+ break;
+ case OP_LOADFALSE:
+ printf("%d",a);
+ break;
+ case OP_LFALSESKIP:
+ printf("%d",a);
+ break;
+ case OP_LOADTRUE:
+ printf("%d",a);
+ break;
+ case OP_LOADNIL:
+ printf("%d %d",a,b);
+ printf(COMMENT "%d out",b+1);
+ break;
+ case OP_GETUPVAL:
+ printf("%d %d",a,b);
+ printf(COMMENT "%s",UPVALNAME(b));
+ break;
+ case OP_SETUPVAL:
+ printf("%d %d",a,b);
+ printf(COMMENT "%s",UPVALNAME(b));
+ break;
+ case OP_GETTABUP:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%s",UPVALNAME(b));
+ printf(" "); PrintConstant(f,c);
+ break;
+ case OP_GETTABLE:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_GETI:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_GETFIELD:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_SETTABUP:
+ printf("%d %d %d%s",a,b,c,ISK);
+ printf(COMMENT "%s",UPVALNAME(a));
+ printf(" "); PrintConstant(f,b);
+ if (isk) { printf(" "); PrintConstant(f,c); }
+ break;
+ case OP_SETTABLE:
+ printf("%d %d %d%s",a,b,c,ISK);
+ if (isk) { printf(COMMENT); PrintConstant(f,c); }
+ break;
+ case OP_SETI:
+ printf("%d %d %d%s",a,b,c,ISK);
+ if (isk) { printf(COMMENT); PrintConstant(f,c); }
+ break;
+ case OP_SETFIELD:
+ printf("%d %d %d%s",a,b,c,ISK);
+ printf(COMMENT); PrintConstant(f,b);
+ if (isk) { printf(" "); PrintConstant(f,c); }
+ break;
+ case OP_NEWTABLE:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%d",c+EXTRAARGC);
+ break;
+ case OP_SELF:
+ printf("%d %d %d%s",a,b,c,ISK);
+ if (isk) { printf(COMMENT); PrintConstant(f,c); }
+ break;
+ case OP_ADDI:
+ printf("%d %d %d",a,b,sc);
+ break;
+ case OP_ADDK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_SUBK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_MULK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_MODK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_POWK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_DIVK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_IDIVK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_BANDK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_BORK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_BXORK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_SHRI:
+ printf("%d %d %d",a,b,sc);
+ break;
+ case OP_SHLI:
+ printf("%d %d %d",a,b,sc);
+ break;
+ case OP_ADD:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_SUB:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_MUL:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_MOD:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_POW:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_DIV:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_IDIV:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_BAND:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_BOR:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_BXOR:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_SHL:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_SHR:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_MMBIN:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%s",eventname(c));
+ break;
+ case OP_MMBINI:
+ printf("%d %d %d %d",a,sb,c,isk);
+ printf(COMMENT "%s",eventname(c));
+ if (isk) printf(" flip");
+ break;
+ case OP_MMBINK:
+ printf("%d %d %d %d",a,b,c,isk);
+ printf(COMMENT "%s ",eventname(c)); PrintConstant(f,b);
+ if (isk) printf(" flip");
+ break;
+ case OP_UNM:
+ printf("%d %d",a,b);
+ break;
+ case OP_BNOT:
+ printf("%d %d",a,b);
+ break;
+ case OP_NOT:
+ printf("%d %d",a,b);
+ break;
+ case OP_LEN:
+ printf("%d %d",a,b);
+ break;
+ case OP_CONCAT:
+ printf("%d %d",a,b);
+ break;
+ case OP_CLOSE:
+ printf("%d",a);
+ break;
+ case OP_TBC:
+ printf("%d",a);
+ break;
+ case OP_JMP:
+ printf("%d",GETARG_sJ(i));
+ printf(COMMENT "to %d",GETARG_sJ(i)+pc+2);
+ break;
+ case OP_EQ:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_LT:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_LE:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_EQK:
+ printf("%d %d %d",a,b,isk);
+ printf(COMMENT); PrintConstant(f,b);
+ break;
+ case OP_EQI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_LTI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_LEI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_GTI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_GEI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_TEST:
+ printf("%d %d",a,isk);
+ break;
+ case OP_TESTSET:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_CALL:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT);
+ if (b==0) printf("all in "); else printf("%d in ",b-1);
+ if (c==0) printf("all out"); else printf("%d out",c-1);
+ break;
+ case OP_TAILCALL:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%d in",b-1);
+ break;
+ case OP_RETURN:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT);
+ if (b==0) printf("all out"); else printf("%d out",b-1);
+ break;
+ case OP_RETURN0:
+ break;
+ case OP_RETURN1:
+ printf("%d",a);
+ break;
+ case OP_FORLOOP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc-bx+2);
+ break;
+ case OP_FORPREP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc+bx+2);
+ break;
+ case OP_TFORPREP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc+bx+2);
+ break;
+ case OP_TFORCALL:
+ printf("%d %d",a,c);
+ break;
+ case OP_TFORLOOP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc-bx+2);
+ break;
+ case OP_SETLIST:
+ printf("%d %d %d",a,b,c);
+ if (isk) printf(COMMENT "%d",c+EXTRAARGC);
+ break;
+ case OP_CLOSURE:
+ printf("%d %d",a,bx);
+ printf(COMMENT "%p",VOID(f->p[bx]));
+ break;
+ case OP_VARARG:
+ printf("%d %d",a,c);
+ printf(COMMENT);
+ if (c==0) printf("all out"); else printf("%d out",c-1);
+ break;
+ case OP_VARARGPREP:
+ printf("%d",a);
+ break;
+ case OP_EXTRAARG:
+ printf("%d",ax);
+ break;
+#if 0
+ default:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "not handled");
+ break;
+#endif
+ }
+ printf("\n");
+ }
+}
+
+
+#define SS(x) ((x==1)?"":"s")
+#define S(x) (int)(x),SS(x)
+
+static void PrintHeader(const Proto* f)
+{
+ const char* s=f->source ? getstr(f->source) : "=?";
+ if (*s=='@' || *s=='=')
+ s++;
+ else if (*s==LUA_SIGNATURE[0])
+ s="(bstring)";
+ else
+ s="(string)";
+ printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
+ (f->linedefined==0)?"main":"function",s,
+ f->linedefined,f->lastlinedefined,
+ S(f->sizecode),VOID(f));
+ printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
+ (int)(f->numparams),f->is_vararg?"+":"",SS(f->numparams),
+ S(f->maxstacksize),S(f->sizeupvalues));
+ printf("%d local%s, %d constant%s, %d function%s\n",
+ S(f->sizelocvars),S(f->sizek),S(f->sizep));
+}
+
+static void PrintDebug(const Proto* f)
+{
+ int i,n;
+ n=f->sizek;
+ printf("constants (%d) for %p:\n",n,VOID(f));
+ for (i=0; i<n; i++)
+ {
+ printf("\t%d\t",i);
+ PrintType(f,i);
+ PrintConstant(f,i);
+ printf("\n");
+ }
+ n=f->sizelocvars;
+ printf("locals (%d) for %p:\n",n,VOID(f));
+ for (i=0; i<n; i++)
+ {
+ printf("\t%d\t%s\t%d\t%d\n",
+ i,getstr(f->locvars[i].varname),f->locvars[i].startpc+1,f->locvars[i].endpc+1);
+ }
+ n=f->sizeupvalues;
+ printf("upvalues (%d) for %p:\n",n,VOID(f));
+ for (i=0; i<n; i++)
+ {
+ printf("\t%d\t%s\t%d\t%d\n",
+ i,UPVALNAME(i),f->upvalues[i].instack,f->upvalues[i].idx);
+ }
+}
+
+static void PrintFunction(const Proto* f, int full)
+{
+ int i,n=f->sizep;
+ PrintHeader(f);
+ PrintCode(f);
+ if (full) PrintDebug(f);
+ for (i=0; i<n; i++) PrintFunction(f->p[i],full);
+}
diff --git a/source/luametatex/source/luacore/luapeg/lpcap.c b/source/luametatex/source/luacore/luapeg/lpcap.c
new file mode 100644
index 000000000..b332fde49
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpcap.c
@@ -0,0 +1,555 @@
+/*
+** $Id: lpcap.c $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+#include "lua.h"
+#include "lauxlib.h"
+
+#include "lpcap.h"
+#include "lptypes.h"
+
+
+#define captype(cap) ((cap)->kind)
+
+#define isclosecap(cap) (captype(cap) == Cclose)
+
+#define closeaddr(c) ((c)->s + (c)->siz - 1)
+
+#define isfullcap(cap) ((cap)->siz != 0)
+
+#define getfromktable(cs,v) lua_rawgeti((cs)->L, ktableidx((cs)->ptop), v)
+
+#define pushluaval(cs) getfromktable(cs, (cs)->cap->idx)
+
+
+
+/*
+** Put at the cache for Lua values the value indexed by 'v' in ktable
+** of the running pattern (if it is not there yet); returns its index.
+*/
+static int updatecache (CapState *cs, int v) {
+ int idx = cs->ptop + 1; /* stack index of cache for Lua values */
+ if (v != cs->valuecached) { /* not there? */
+ getfromktable(cs, v); /* get value from 'ktable' */
+ lua_replace(cs->L, idx); /* put it at reserved stack position */
+ cs->valuecached = v; /* keep track of what is there */
+ }
+ return idx;
+}
+
+
+static int pushcapture (CapState *cs);
+
+
+/*
+** Goes back in a list of captures looking for an open capture
+** corresponding to a close
+*/
+static Capture *findopen (Capture *cap) {
+ int n = 0; /* number of closes waiting an open */
+ for (;;) {
+ cap--;
+ if (isclosecap(cap)) n++; /* one more open to skip */
+ else if (!isfullcap(cap))
+ if (n-- == 0) return cap;
+ }
+}
+
+
+/*
+** Go to the next capture
+*/
+static void nextcap (CapState *cs) {
+ Capture *cap = cs->cap;
+ if (!isfullcap(cap)) { /* not a single capture? */
+ int n = 0; /* number of opens waiting a close */
+ for (;;) { /* look for corresponding close */
+ cap++;
+ if (isclosecap(cap)) {
+ if (n-- == 0) break;
+ }
+ else if (!isfullcap(cap)) n++;
+ }
+ }
+ cs->cap = cap + 1; /* + 1 to skip last close (or entire single capture) */
+}
+
+
+/*
+** Push on the Lua stack all values generated by nested captures inside
+** the current capture. Returns number of values pushed. 'addextra'
+** makes it push the entire match after all captured values. The
+** entire match is pushed also if there are no other nested values,
+** so the function never returns zero.
+*/
+static int pushnestedvalues (CapState *cs, int addextra) {
+ Capture *co = cs->cap;
+ if (isfullcap(cs->cap++)) { /* no nested captures? */
+ lua_pushlstring(cs->L, co->s, co->siz - 1); /* push whole match */
+ return 1; /* that is it */
+ }
+ else {
+ int n = 0;
+ while (!isclosecap(cs->cap)) /* repeat for all nested patterns */
+ n += pushcapture(cs);
+ if (addextra || n == 0) { /* need extra? */
+ lua_pushlstring(cs->L, co->s, cs->cap->s - co->s); /* push whole match */
+ n++;
+ }
+ cs->cap++; /* skip close entry */
+ return n;
+ }
+}
+
+
+/*
+** Push only the first value generated by nested captures
+*/
+static void pushonenestedvalue (CapState *cs) {
+ int n = pushnestedvalues(cs, 0);
+ if (n > 1)
+ lua_pop(cs->L, n - 1); /* pop extra values */
+}
+
+
+/*
+** Try to find a named group capture with the name given at the top of
+** the stack; goes backward from 'cap'.
+*/
+static Capture *findback (CapState *cs, Capture *cap) {
+ lua_State *L = cs->L;
+ while (cap-- > cs->ocap) { /* repeat until end of list */
+ if (isclosecap(cap))
+ cap = findopen(cap); /* skip nested captures */
+ else if (!isfullcap(cap))
+ continue; /* opening an enclosing capture: skip and get previous */
+ if (captype(cap) == Cgroup) {
+ getfromktable(cs, cap->idx); /* get group name */
+ if (lp_equal(L, -2, -1)) { /* right group? */
+ lua_pop(L, 2); /* remove reference name and group name */
+ return cap;
+ }
+ else lua_pop(L, 1); /* remove group name */
+ }
+ }
+ luaL_error(L, "back reference '%s' not found", lua_tostring(L, -1));
+ return NULL; /* to avoid warnings */
+}
+
+
+/*
+** Back-reference capture. Return number of values pushed.
+*/
+static int backrefcap (CapState *cs) {
+ int n;
+ Capture *curr = cs->cap;
+ pushluaval(cs); /* reference name */
+ cs->cap = findback(cs, curr); /* find corresponding group */
+ n = pushnestedvalues(cs, 0); /* push group's values */
+ cs->cap = curr + 1;
+ return n;
+}
+
+
+/*
+** Table capture: creates a new table and populates it with nested
+** captures.
+*/
+static int tablecap (CapState *cs) {
+ lua_State *L = cs->L;
+ int n = 0;
+ lua_newtable(L);
+ if (isfullcap(cs->cap++))
+ return 1; /* table is empty */
+ while (!isclosecap(cs->cap)) {
+ if (captype(cs->cap) == Cgroup && cs->cap->idx != 0) { /* named group? */
+ pushluaval(cs); /* push group name */
+ pushonenestedvalue(cs);
+ lua_settable(L, -3);
+ }
+ else { /* not a named group */
+ int i;
+ int k = pushcapture(cs);
+ for (i = k; i > 0; i--) /* store all values into table */
+ lua_rawseti(L, -(i + 1), n + i);
+ n += k;
+ }
+ }
+ cs->cap++; /* skip close entry */
+ return 1; /* number of values pushed (only the table) */
+}
+
+
+/*
+** Table-query capture
+*/
+static int querycap (CapState *cs) {
+ int idx = cs->cap->idx;
+ pushonenestedvalue(cs); /* get nested capture */
+ lua_gettable(cs->L, updatecache(cs, idx)); /* query cap. value at table */
+ if (!lua_isnil(cs->L, -1))
+ return 1;
+ else { /* no value */
+ lua_pop(cs->L, 1); /* remove nil */
+ return 0;
+ }
+}
+
+
+/*
+** Fold capture
+*/
+static int foldcap (CapState *cs) {
+ int n;
+ lua_State *L = cs->L;
+ int idx = cs->cap->idx;
+ if (isfullcap(cs->cap++) || /* no nested captures? */
+ isclosecap(cs->cap) || /* no nested captures (large subject)? */
+ (n = pushcapture(cs)) == 0) /* nested captures with no values? */
+ return luaL_error(L, "no initial value for fold capture");
+ if (n > 1)
+ lua_pop(L, n - 1); /* leave only one result for accumulator */
+ while (!isclosecap(cs->cap)) {
+ lua_pushvalue(L, updatecache(cs, idx)); /* get folding function */
+ lua_insert(L, -2); /* put it before accumulator */
+ n = pushcapture(cs); /* get next capture's values */
+ lua_call(L, n + 1, 1); /* call folding function */
+ }
+ cs->cap++; /* skip close entry */
+ return 1; /* only accumulator left on the stack */
+}
+
+
+/*
+** Function capture
+*/
+static int functioncap (CapState *cs) {
+ int n;
+ int top = lua_gettop(cs->L);
+ pushluaval(cs); /* push function */
+ n = pushnestedvalues(cs, 0); /* push nested captures */
+ lua_call(cs->L, n, LUA_MULTRET); /* call function */
+ return lua_gettop(cs->L) - top; /* return function's results */
+}
+
+
+/*
+** Select capture
+*/
+static int numcap (CapState *cs) {
+ int idx = cs->cap->idx; /* value to select */
+ if (idx == 0) { /* no values? */
+ nextcap(cs); /* skip entire capture */
+ return 0; /* no value produced */
+ }
+ else {
+ int n = pushnestedvalues(cs, 0);
+ if (n < idx) /* invalid index? */
+ return luaL_error(cs->L, "no capture '%d'", idx);
+ else {
+ lua_pushvalue(cs->L, -(n - idx + 1)); /* get selected capture */
+ lua_replace(cs->L, -(n + 1)); /* put it in place of 1st capture */
+ lua_pop(cs->L, n - 1); /* remove other captures */
+ return 1;
+ }
+ }
+}
+
+
+/*
+** Return the stack index of the first runtime capture in the given
+** list of captures (or zero if no runtime captures)
+*/
+int finddyncap (Capture *cap, Capture *last) {
+ for (; cap < last; cap++) {
+ if (cap->kind == Cruntime)
+ return cap->idx; /* stack position of first capture */
+ }
+ return 0; /* no dynamic captures in this segment */
+}
+
+
+/*
+** Calls a runtime capture. Returns number of captures "removed" by the
+** call, that is, those inside the group capture. Captures to be added
+** are on the Lua stack.
+*/
+int runtimecap (CapState *cs, Capture *close, const char *s, int *rem) {
+ int n, id;
+ lua_State *L = cs->L;
+ int otop = lua_gettop(L);
+ Capture *open = findopen(close); /* get open group capture */
+ assert(captype(open) == Cgroup);
+ id = finddyncap(open, close); /* get first dynamic capture argument */
+ close->kind = Cclose; /* closes the group */
+ close->s = s;
+ cs->cap = open; cs->valuecached = 0; /* prepare capture state */
+ luaL_checkstack(L, 4, "too many runtime captures");
+ pushluaval(cs); /* push function to be called */
+ lua_pushvalue(L, SUBJIDX); /* push original subject */
+ lua_pushinteger(L, s - cs->s + 1); /* push current position */
+ n = pushnestedvalues(cs, 0); /* push nested captures */
+ lua_call(L, n + 2, LUA_MULTRET); /* call dynamic function */
+ if (id > 0) { /* are there old dynamic captures to be removed? */
+ int i;
+ for (i = id; i <= otop; i++)
+ lua_remove(L, id); /* remove old dynamic captures */
+ *rem = otop - id + 1; /* total number of dynamic captures removed */
+ }
+ else
+ *rem = 0; /* no dynamic captures removed */
+ return close - open - 1; /* number of captures to be removed */
+}
+
+
+/*
+** Auxiliary structure for substitution and string captures: keep
+** information about nested captures for future use, avoiding to push
+** string results into Lua
+*/
+typedef struct StrAux {
+ int isstring; /* whether capture is a string */
+ union {
+ Capture *cp; /* if not a string, respective capture */
+ struct { /* if it is a string... */
+ const char *s; /* ... starts here */
+ const char *e; /* ... ends here */
+ } s;
+ } u;
+} StrAux;
+
+#define MAXSTRCAPS 10
+
+/*
+** Collect values from current capture into array 'cps'. Current
+** capture must be Cstring (first call) or Csimple (recursive calls).
+** (In first call, fills %0 with whole match for Cstring.)
+** Returns number of elements in the array that were filled.
+*/
+static int getstrcaps (CapState *cs, StrAux *cps, int n) {
+ int k = n++;
+ cps[k].isstring = 1; /* get string value */
+ cps[k].u.s.s = cs->cap->s; /* starts here */
+ if (!isfullcap(cs->cap++)) { /* nested captures? */
+ while (!isclosecap(cs->cap)) { /* traverse them */
+ if (n >= MAXSTRCAPS) /* too many captures? */
+ nextcap(cs); /* skip extra captures (will not need them) */
+ else if (captype(cs->cap) == Csimple) /* string? */
+ n = getstrcaps(cs, cps, n); /* put info. into array */
+ else {
+ cps[n].isstring = 0; /* not a string */
+ cps[n].u.cp = cs->cap; /* keep original capture */
+ nextcap(cs);
+ n++;
+ }
+ }
+ cs->cap++; /* skip close */
+ }
+ cps[k].u.s.e = closeaddr(cs->cap - 1); /* ends here */
+ return n;
+}
+
+
+/*
+** add next capture value (which should be a string) to buffer 'b'
+*/
+static int addonestring (luaL_Buffer *b, CapState *cs, const char *what);
+
+
+/*
+** String capture: add result to buffer 'b' (instead of pushing
+** it into the stack)
+*/
+static void stringcap (luaL_Buffer *b, CapState *cs) {
+ StrAux cps[MAXSTRCAPS];
+ int n;
+ size_t len, i;
+ const char *fmt; /* format string */
+ fmt = lua_tolstring(cs->L, updatecache(cs, cs->cap->idx), &len);
+ n = getstrcaps(cs, cps, 0) - 1; /* collect nested captures */
+ for (i = 0; i < len; i++) { /* traverse them */
+ if (fmt[i] != '%') /* not an escape? */
+ luaL_addchar(b, fmt[i]); /* add it to buffer */
+ else if (fmt[++i] < '0' || fmt[i] > '9') /* not followed by a digit? */
+ luaL_addchar(b, fmt[i]); /* add to buffer */
+ else {
+ int l = fmt[i] - '0'; /* capture index */
+ if (l > n)
+ luaL_error(cs->L, "invalid capture index (%d)", l);
+ else if (cps[l].isstring)
+ luaL_addlstring(b, cps[l].u.s.s, cps[l].u.s.e - cps[l].u.s.s);
+ else {
+ Capture *curr = cs->cap;
+ cs->cap = cps[l].u.cp; /* go back to evaluate that nested capture */
+ if (!addonestring(b, cs, "capture"))
+ luaL_error(cs->L, "no values in capture index %d", l);
+ cs->cap = curr; /* continue from where it stopped */
+ }
+ }
+ }
+}
+
+
+/*
+** Substitution capture: add result to buffer 'b'
+*/
+static void substcap (luaL_Buffer *b, CapState *cs) {
+ const char *curr = cs->cap->s;
+ if (isfullcap(cs->cap)) /* no nested captures? */
+ luaL_addlstring(b, curr, cs->cap->siz - 1); /* keep original text */
+ else {
+ cs->cap++; /* skip open entry */
+ while (!isclosecap(cs->cap)) { /* traverse nested captures */
+ const char *next = cs->cap->s;
+ luaL_addlstring(b, curr, next - curr); /* add text up to capture */
+ if (addonestring(b, cs, "replacement"))
+ curr = closeaddr(cs->cap - 1); /* continue after match */
+ else /* no capture value */
+ curr = next; /* keep original text in final result */
+ }
+ luaL_addlstring(b, curr, cs->cap->s - curr); /* add last piece of text */
+ }
+ cs->cap++; /* go to next capture */
+}
+
+
+/*
+** Evaluates a capture and adds its first value to buffer 'b'; returns
+** whether there was a value
+*/
+static int addonestring (luaL_Buffer *b, CapState *cs, const char *what) {
+ switch (captype(cs->cap)) {
+ case Cstring:
+ stringcap(b, cs); /* add capture directly to buffer */
+ return 1;
+ case Csubst:
+ substcap(b, cs); /* add capture directly to buffer */
+ return 1;
+ default: {
+ lua_State *L = cs->L;
+ int n = pushcapture(cs);
+ if (n > 0) {
+ if (n > 1) lua_pop(L, n - 1); /* only one result */
+ if (!lua_isstring(L, -1))
+ luaL_error(L, "invalid %s value (a %s)", what, luaL_typename(L, -1));
+ luaL_addvalue(b);
+ }
+ return n;
+ }
+ }
+}
+
+
+#if !defined(MAXRECLEVEL)
+#define MAXRECLEVEL 200
+#endif
+
+
+/*
+** Push all values of the current capture into the stack; returns
+** number of values pushed
+*/
+static int pushcapture (CapState *cs) {
+ lua_State *L = cs->L;
+ int res;
+ luaL_checkstack(L, 4, "too many captures");
+ if (cs->reclevel++ > MAXRECLEVEL)
+ return luaL_error(L, "subcapture nesting too deep");
+ switch (captype(cs->cap)) {
+ case Cposition: {
+ lua_pushinteger(L, cs->cap->s - cs->s + 1);
+ cs->cap++;
+ res = 1;
+ break;
+ }
+ case Cconst: {
+ pushluaval(cs);
+ cs->cap++;
+ res = 1;
+ break;
+ }
+ case Carg: {
+ int arg = (cs->cap++)->idx;
+ if (arg + FIXEDARGS > cs->ptop)
+ return luaL_error(L, "reference to absent extra argument #%d", arg);
+ lua_pushvalue(L, arg + FIXEDARGS);
+ res = 1;
+ break;
+ }
+ case Csimple: {
+ int k = pushnestedvalues(cs, 1);
+ lua_insert(L, -k); /* make whole match be first result */
+ res = k;
+ break;
+ }
+ case Cruntime: {
+ lua_pushvalue(L, (cs->cap++)->idx); /* value is in the stack */
+ res = 1;
+ break;
+ }
+ case Cstring: {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ stringcap(&b, cs);
+ luaL_pushresult(&b);
+ res = 1;
+ break;
+ }
+ case Csubst: {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ substcap(&b, cs);
+ luaL_pushresult(&b);
+ res = 1;
+ break;
+ }
+ case Cgroup: {
+ if (cs->cap->idx == 0) /* anonymous group? */
+ res = pushnestedvalues(cs, 0); /* add all nested values */
+ else { /* named group: add no values */
+ nextcap(cs); /* skip capture */
+ res = 0;
+ }
+ break;
+ }
+ case Cbackref: res = backrefcap(cs); break;
+ case Ctable: res = tablecap(cs); break;
+ case Cfunction: res = functioncap(cs); break;
+ case Cnum: res = numcap(cs); break;
+ case Cquery: res = querycap(cs); break;
+ case Cfold: res = foldcap(cs); break;
+ default: assert(0); res = 0;
+ }
+ cs->reclevel--;
+ return res;
+}
+
+
+/*
+** Prepare a CapState structure and traverse the entire list of
+** captures in the stack pushing its results. 's' is the subject
+** string, 'r' is the final position of the match, and 'ptop'
+** the index in the stack where some useful values were pushed.
+** Returns the number of results pushed. (If the list produces no
+** results, push the final position of the match.)
+*/
+int getcaptures (lua_State *L, const char *s, const char *r, int ptop) {
+ Capture *capture = (Capture *)lua_touserdata(L, caplistidx(ptop));
+ int n = 0;
+ if (!isclosecap(capture)) { /* is there any capture? */
+ CapState cs;
+ cs.ocap = cs.cap = capture; cs.L = L; cs.reclevel = 0;
+ cs.s = s; cs.valuecached = 0; cs.ptop = ptop;
+ do { /* collect their values */
+ n += pushcapture(&cs);
+ } while (!isclosecap(cs.cap));
+ }
+ if (n == 0) { /* no capture values? */
+ lua_pushinteger(L, r - s + 1); /* return only end position */
+ n = 1;
+ }
+ return n;
+}
+
+
diff --git a/source/luametatex/source/luacore/luapeg/lpcap.h b/source/luametatex/source/luacore/luapeg/lpcap.h
new file mode 100644
index 000000000..dc10d6969
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpcap.h
@@ -0,0 +1,57 @@
+/*
+** $Id: lpcap.h $
+*/
+
+#if !defined(lpcap_h)
+#define lpcap_h
+
+
+#include "lptypes.h"
+
+
+/* kinds of captures */
+typedef enum CapKind {
+ Cclose, /* not used in trees */
+ Cposition,
+ Cconst, /* ktable[key] is Lua constant */
+ Cbackref, /* ktable[key] is "name" of group to get capture */
+ Carg, /* 'key' is arg's number */
+ Csimple, /* next node is pattern */
+ Ctable, /* next node is pattern */
+ Cfunction, /* ktable[key] is function; next node is pattern */
+ Cquery, /* ktable[key] is table; next node is pattern */
+ Cstring, /* ktable[key] is string; next node is pattern */
+ Cnum, /* numbered capture; 'key' is number of value to return */
+ Csubst, /* substitution capture; next node is pattern */
+ Cfold, /* ktable[key] is function; next node is pattern */
+ Cruntime, /* not used in trees (is uses another type for tree) */
+ Cgroup /* ktable[key] is group's "name" */
+} CapKind;
+
+
+typedef struct Capture {
+ const char *s; /* subject position */
+ unsigned short idx; /* extra info (group name, arg index, etc.) */
+ byte kind; /* kind of capture */
+ byte siz; /* size of full capture + 1 (0 = not a full capture) */
+} Capture;
+
+
+typedef struct CapState {
+ Capture *cap; /* current capture */
+ Capture *ocap; /* (original) capture list */
+ lua_State *L;
+ int ptop; /* index of last argument to 'match' */
+ const char *s; /* original string */
+ int valuecached; /* value stored in cache slot */
+ int reclevel; /* recursion level */
+} CapState;
+
+
+int runtimecap (CapState *cs, Capture *close, const char *s, int *rem);
+int getcaptures (lua_State *L, const char *s, const char *r, int ptop);
+int finddyncap (Capture *cap, Capture *last);
+
+#endif
+
+
diff --git a/source/luametatex/source/luacore/luapeg/lpcode.c b/source/luametatex/source/luacore/luapeg/lpcode.c
new file mode 100644
index 000000000..392345972
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpcode.c
@@ -0,0 +1,1014 @@
+/*
+** $Id: lpcode.c $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+#include <limits.h>
+
+
+#include "lua.h"
+#include "lauxlib.h"
+
+#include "lptypes.h"
+#include "lpcode.h"
+
+
+/* signals a "no-instruction */
+#define NOINST -1
+
+
+
+static const Charset fullset_ =
+ {{0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF}};
+
+static const Charset *fullset = &fullset_;
+
+/*
+** {======================================================
+** Analysis and some optimizations
+** =======================================================
+*/
+
+/*
+** Check whether a charset is empty (returns IFail), singleton (IChar),
+** full (IAny), or none of those (ISet). When singleton, '*c' returns
+** which character it is. (When generic set, the set was the input,
+** so there is no need to return it.)
+*/
+static Opcode charsettype (const byte *cs, int *c) {
+ int count = 0; /* number of characters in the set */
+ int i;
+ int candidate = -1; /* candidate position for the singleton char */
+ for (i = 0; i < CHARSETSIZE; i++) { /* for each byte */
+ int b = cs[i];
+ if (b == 0) { /* is byte empty? */
+ if (count > 1) /* was set neither empty nor singleton? */
+ return ISet; /* neither full nor empty nor singleton */
+ /* else set is still empty or singleton */
+ }
+ else if (b == 0xFF) { /* is byte full? */
+ if (count < (i * BITSPERCHAR)) /* was set not full? */
+ return ISet; /* neither full nor empty nor singleton */
+ else count += BITSPERCHAR; /* set is still full */
+ }
+ else if ((b & (b - 1)) == 0) { /* has byte only one bit? */
+ if (count > 0) /* was set not empty? */
+ return ISet; /* neither full nor empty nor singleton */
+ else { /* set has only one char till now; track it */
+ count++;
+ candidate = i;
+ }
+ }
+ else return ISet; /* byte is neither empty, full, nor singleton */
+ }
+ switch (count) {
+ case 0: return IFail; /* empty set */
+ case 1: { /* singleton; find character bit inside byte */
+ int b = cs[candidate];
+ *c = candidate * BITSPERCHAR;
+ if ((b & 0xF0) != 0) { *c += 4; b >>= 4; }
+ if ((b & 0x0C) != 0) { *c += 2; b >>= 2; }
+ if ((b & 0x02) != 0) { *c += 1; }
+ return IChar;
+ }
+ default: {
+ assert(count == CHARSETSIZE * BITSPERCHAR); /* full set */
+ return IAny;
+ }
+ }
+}
+
+
+/*
+** A few basic operations on Charsets
+*/
+static void cs_complement (Charset *cs) {
+ loopset(i, cs->cs[i] = ~cs->cs[i]);
+}
+
+static int cs_equal (const byte *cs1, const byte *cs2) {
+ loopset(i, if (cs1[i] != cs2[i]) return 0);
+ return 1;
+}
+
+static int cs_disjoint (const Charset *cs1, const Charset *cs2) {
+ loopset(i, if ((cs1->cs[i] & cs2->cs[i]) != 0) return 0;)
+ return 1;
+}
+
+
+/*
+** If 'tree' is a 'char' pattern (TSet, TChar, TAny), convert it into a
+** charset and return 1; else return 0.
+*/
+int tocharset (TTree *tree, Charset *cs) {
+ switch (tree->tag) {
+ case TSet: { /* copy set */
+ loopset(i, cs->cs[i] = treebuffer(tree)[i]);
+ return 1;
+ }
+ case TChar: { /* only one char */
+ assert(0 <= tree->u.n && tree->u.n <= UCHAR_MAX);
+ loopset(i, cs->cs[i] = 0); /* erase all chars */
+ setchar(cs->cs, tree->u.n); /* add that one */
+ return 1;
+ }
+ case TAny: {
+ loopset(i, cs->cs[i] = 0xFF); /* add all characters to the set */
+ return 1;
+ }
+ default: return 0;
+ }
+}
+
+
+/*
+** Visit a TCall node taking care to stop recursion. If node not yet
+** visited, return 'f(sib2(tree))', otherwise return 'def' (default
+** value)
+*/
+static int callrecursive (TTree *tree, int f (TTree *t), int def) {
+ int key = tree->key;
+ assert(tree->tag == TCall);
+ assert(sib2(tree)->tag == TRule);
+ if (key == 0) /* node already visited? */
+ return def; /* return default value */
+ else { /* first visit */
+ int result;
+ tree->key = 0; /* mark call as already visited */
+ result = f(sib2(tree)); /* go to called rule */
+ tree->key = key; /* restore tree */
+ return result;
+ }
+}
+
+
+/*
+** Check whether a pattern tree has captures
+*/
+int hascaptures (TTree *tree) {
+ tailcall:
+ switch (tree->tag) {
+ case TCapture: case TRunTime:
+ return 1;
+ case TCall:
+ return callrecursive(tree, hascaptures, 0);
+ case TRule: /* do not follow siblings */
+ tree = sib1(tree); goto tailcall;
+ case TOpenCall: assert(0);
+ default: {
+ switch (numsiblings[tree->tag]) {
+ case 1: /* return hascaptures(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case 2:
+ if (hascaptures(sib1(tree)))
+ return 1;
+ /* else return hascaptures(sib2(tree)); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(numsiblings[tree->tag] == 0); return 0;
+ }
+ }
+ }
+}
+
+
+/*
+** Checks how a pattern behaves regarding the empty string,
+** in one of two different ways:
+** A pattern is *nullable* if it can match without consuming any character;
+** A pattern is *nofail* if it never fails for any string
+** (including the empty string).
+** The difference is only for predicates and run-time captures;
+** for other patterns, the two properties are equivalent.
+** (With predicates, &'a' is nullable but not nofail. Of course,
+** nofail => nullable.)
+** These functions are all convervative in the following way:
+** p is nullable => nullable(p)
+** nofail(p) => p cannot fail
+** The function assumes that TOpenCall is not nullable;
+** this will be checked again when the grammar is fixed.
+** Run-time captures can do whatever they want, so the result
+** is conservative.
+*/
+int checkaux (TTree *tree, int pred) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ case TFalse: case TOpenCall:
+ return 0; /* not nullable */
+ case TRep: case TTrue:
+ return 1; /* no fail */
+ case TNot: case TBehind: /* can match empty, but can fail */
+ if (pred == PEnofail) return 0;
+ else return 1; /* PEnullable */
+ case TAnd: /* can match empty; fail iff body does */
+ if (pred == PEnullable) return 1;
+ /* else return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TRunTime: /* can fail; match empty iff body does */
+ if (pred == PEnofail) return 0;
+ /* else return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TSeq:
+ if (!checkaux(sib1(tree), pred)) return 0;
+ /* else return checkaux(sib2(tree), pred); */
+ tree = sib2(tree); goto tailcall;
+ case TChoice:
+ if (checkaux(sib2(tree), pred)) return 1;
+ /* else return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TCapture: case TGrammar: case TRule:
+ /* return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TCall: /* return checkaux(sib2(tree), pred); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(0); return 0;
+ }
+}
+
+
+/*
+** number of characters to match a pattern (or -1 if variable)
+*/
+int fixedlen (TTree *tree) {
+ int len = 0; /* to accumulate in tail calls */
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ return len + 1;
+ case TFalse: case TTrue: case TNot: case TAnd: case TBehind:
+ return len;
+ case TRep: case TRunTime: case TOpenCall:
+ return -1;
+ case TCapture: case TRule: case TGrammar:
+ /* return fixedlen(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case TCall: {
+ int n1 = callrecursive(tree, fixedlen, -1);
+ if (n1 < 0)
+ return -1;
+ else
+ return len + n1;
+ }
+ case TSeq: {
+ int n1 = fixedlen(sib1(tree));
+ if (n1 < 0)
+ return -1;
+ /* else return fixedlen(sib2(tree)) + len; */
+ len += n1; tree = sib2(tree); goto tailcall;
+ }
+ case TChoice: {
+ int n1 = fixedlen(sib1(tree));
+ int n2 = fixedlen(sib2(tree));
+ if (n1 != n2 || n1 < 0)
+ return -1;
+ else
+ return len + n1;
+ }
+ default: assert(0); return 0;
+ };
+}
+
+
+/*
+** Computes the 'first set' of a pattern.
+** The result is a conservative aproximation:
+** match p ax -> x (for some x) ==> a belongs to first(p)
+** or
+** a not in first(p) ==> match p ax -> fail (for all x)
+**
+** The set 'follow' is the first set of what follows the
+** pattern (full set if nothing follows it).
+**
+** The function returns 0 when this resulting set can be used for
+** test instructions that avoid the pattern altogether.
+** A non-zero return can happen for two reasons:
+** 1) match p '' -> '' ==> return has bit 1 set
+** (tests cannot be used because they would always fail for an empty input);
+** 2) there is a match-time capture ==> return has bit 2 set
+** (optimizations should not bypass match-time captures).
+*/
+static int getfirst (TTree *tree, const Charset *follow, Charset *firstset) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny: {
+ tocharset(tree, firstset);
+ return 0;
+ }
+ case TTrue: {
+ loopset(i, firstset->cs[i] = follow->cs[i]);
+ return 1; /* accepts the empty string */
+ }
+ case TFalse: {
+ loopset(i, firstset->cs[i] = 0);
+ return 0;
+ }
+ case TChoice: {
+ Charset csaux;
+ int e1 = getfirst(sib1(tree), follow, firstset);
+ int e2 = getfirst(sib2(tree), follow, &csaux);
+ loopset(i, firstset->cs[i] |= csaux.cs[i]);
+ return e1 | e2;
+ }
+ case TSeq: {
+ if (!nullable(sib1(tree))) {
+ /* when p1 is not nullable, p2 has nothing to contribute;
+ return getfirst(sib1(tree), fullset, firstset); */
+ tree = sib1(tree); follow = fullset; goto tailcall;
+ }
+ else { /* FIRST(p1 p2, fl) = FIRST(p1, FIRST(p2, fl)) */
+ Charset csaux;
+ int e2 = getfirst(sib2(tree), follow, &csaux);
+ int e1 = getfirst(sib1(tree), &csaux, firstset);
+ if (e1 == 0) return 0; /* 'e1' ensures that first can be used */
+ else if ((e1 | e2) & 2) /* one of the children has a matchtime? */
+ return 2; /* pattern has a matchtime capture */
+ else return e2; /* else depends on 'e2' */
+ }
+ }
+ case TRep: {
+ getfirst(sib1(tree), follow, firstset);
+ loopset(i, firstset->cs[i] |= follow->cs[i]);
+ return 1; /* accept the empty string */
+ }
+ case TCapture: case TGrammar: case TRule: {
+ /* return getfirst(sib1(tree), follow, firstset); */
+ tree = sib1(tree); goto tailcall;
+ }
+ case TRunTime: { /* function invalidates any follow info. */
+ int e = getfirst(sib1(tree), fullset, firstset);
+ if (e) return 2; /* function is not "protected"? */
+ else return 0; /* pattern inside capture ensures first can be used */
+ }
+ case TCall: {
+ /* return getfirst(sib2(tree), follow, firstset); */
+ tree = sib2(tree); goto tailcall;
+ }
+ case TAnd: {
+ int e = getfirst(sib1(tree), follow, firstset);
+ loopset(i, firstset->cs[i] &= follow->cs[i]);
+ return e;
+ }
+ case TNot: {
+ if (tocharset(sib1(tree), firstset)) {
+ cs_complement(firstset);
+ return 1;
+ }
+ /* else go through */
+ }
+ case TBehind: { /* instruction gives no new information */
+ /* call 'getfirst' only to check for math-time captures */
+ int e = getfirst(sib1(tree), follow, firstset);
+ loopset(i, firstset->cs[i] = follow->cs[i]); /* uses follow */
+ return e | 1; /* always can accept the empty string */
+ }
+ default: assert(0); return 0;
+ }
+}
+
+
+/*
+** If 'headfail(tree)' true, then 'tree' can fail only depending on the
+** next character of the subject.
+*/
+static int headfail (TTree *tree) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny: case TFalse:
+ return 1;
+ case TTrue: case TRep: case TRunTime: case TNot:
+ case TBehind:
+ return 0;
+ case TCapture: case TGrammar: case TRule: case TAnd:
+ tree = sib1(tree); goto tailcall; /* return headfail(sib1(tree)); */
+ case TCall:
+ tree = sib2(tree); goto tailcall; /* return headfail(sib2(tree)); */
+ case TSeq:
+ if (!nofail(sib2(tree))) return 0;
+ /* else return headfail(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case TChoice:
+ if (!headfail(sib1(tree))) return 0;
+ /* else return headfail(sib2(tree)); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(0); return 0;
+ }
+}
+
+
+/*
+** Check whether the code generation for the given tree can benefit
+** from a follow set (to avoid computing the follow set when it is
+** not needed)
+*/
+static int needfollow (TTree *tree) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ case TFalse: case TTrue: case TAnd: case TNot:
+ case TRunTime: case TGrammar: case TCall: case TBehind:
+ return 0;
+ case TChoice: case TRep:
+ return 1;
+ case TCapture:
+ tree = sib1(tree); goto tailcall;
+ case TSeq:
+ tree = sib2(tree); goto tailcall;
+ default: assert(0); return 0;
+ }
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** Code generation
+** =======================================================
+*/
+
+
+/*
+** size of an instruction
+*/
+int sizei (const Instruction *i) {
+ switch((Opcode)i->i.code) {
+ case ISet: case ISpan: return CHARSETINSTSIZE;
+ case ITestSet: return CHARSETINSTSIZE + 1;
+ case ITestChar: case ITestAny: case IChoice: case IJmp: case ICall:
+ case IOpenCall: case ICommit: case IPartialCommit: case IBackCommit:
+ return 2;
+ default: return 1;
+ }
+}
+
+
+/*
+** state for the compiler
+*/
+typedef struct CompileState {
+ Pattern *p; /* pattern being compiled */
+ int ncode; /* next position in p->code to be filled */
+ lua_State *L;
+} CompileState;
+
+
+/*
+** code generation is recursive; 'opt' indicates that the code is being
+** generated as the last thing inside an optional pattern (so, if that
+** code is optional too, it can reuse the 'IChoice' already in place for
+** the outer pattern). 'tt' points to a previous test protecting this
+** code (or NOINST). 'fl' is the follow set of the pattern.
+*/
+static void codegen (CompileState *compst, TTree *tree, int opt, int tt,
+ const Charset *fl);
+
+
+void realloccode (lua_State *L, Pattern *p, int nsize) {
+ void *ud;
+ lua_Alloc f = lua_getallocf(L, &ud);
+ void *newblock = f(ud, p->code, p->codesize * sizeof(Instruction),
+ nsize * sizeof(Instruction));
+ if (newblock == NULL && nsize > 0)
+ luaL_error(L, "not enough memory");
+ p->code = (Instruction *)newblock;
+ p->codesize = nsize;
+}
+
+
+static int nextinstruction (CompileState *compst) {
+ int size = compst->p->codesize;
+ if (compst->ncode >= size)
+ realloccode(compst->L, compst->p, size * 2);
+ return compst->ncode++;
+}
+
+
+#define getinstr(cs,i) ((cs)->p->code[i])
+
+
+static int addinstruction (CompileState *compst, Opcode op, int aux) {
+ int i = nextinstruction(compst);
+ getinstr(compst, i).i.code = op;
+ getinstr(compst, i).i.aux = aux;
+ return i;
+}
+
+
+/*
+** Add an instruction followed by space for an offset (to be set later)
+*/
+static int addoffsetinst (CompileState *compst, Opcode op) {
+ int i = addinstruction(compst, op, 0); /* instruction */
+ addinstruction(compst, (Opcode)0, 0); /* open space for offset */
+ assert(op == ITestSet || sizei(&getinstr(compst, i)) == 2);
+ return i;
+}
+
+
+/*
+** Set the offset of an instruction
+*/
+static void setoffset (CompileState *compst, int instruction, int offset) {
+ getinstr(compst, instruction + 1).offset = offset;
+}
+
+
+/*
+** Add a capture instruction:
+** 'op' is the capture instruction; 'cap' the capture kind;
+** 'key' the key into ktable; 'aux' is the optional capture offset
+**
+*/
+static int addinstcap (CompileState *compst, Opcode op, int cap, int key,
+ int aux) {
+ int i = addinstruction(compst, op, joinkindoff(cap, aux));
+ getinstr(compst, i).i.key = key;
+ return i;
+}
+
+
+#define gethere(compst) ((compst)->ncode)
+
+#define target(code,i) ((i) + code[i + 1].offset)
+
+
+/*
+** Patch 'instruction' to jump to 'target'
+*/
+static void jumptothere (CompileState *compst, int instruction, int target) {
+ if (instruction >= 0)
+ setoffset(compst, instruction, target - instruction);
+}
+
+
+/*
+** Patch 'instruction' to jump to current position
+*/
+static void jumptohere (CompileState *compst, int instruction) {
+ jumptothere(compst, instruction, gethere(compst));
+}
+
+
+/*
+** Code an IChar instruction, or IAny if there is an equivalent
+** test dominating it
+*/
+static void codechar (CompileState *compst, int c, int tt) {
+ if (tt >= 0 && getinstr(compst, tt).i.code == ITestChar &&
+ getinstr(compst, tt).i.aux == c)
+ addinstruction(compst, IAny, 0);
+ else
+ addinstruction(compst, IChar, c);
+}
+
+
+/*
+** Add a charset posfix to an instruction
+*/
+static void addcharset (CompileState *compst, const byte *cs) {
+ int p = gethere(compst);
+ int i;
+ for (i = 0; i < (int)CHARSETINSTSIZE - 1; i++)
+ nextinstruction(compst); /* space for buffer */
+ /* fill buffer with charset */
+ loopset(j, getinstr(compst, p).buff[j] = cs[j]);
+}
+
+
+/*
+** code a char set, optimizing unit sets for IChar, "complete"
+** sets for IAny, and empty sets for IFail; also use an IAny
+** when instruction is dominated by an equivalent test.
+*/
+static void codecharset (CompileState *compst, const byte *cs, int tt) {
+ int c = 0; /* (=) to avoid warnings */
+ Opcode op = charsettype(cs, &c);
+ switch (op) {
+ case IChar: codechar(compst, c, tt); break;
+ case ISet: { /* non-trivial set? */
+ if (tt >= 0 && getinstr(compst, tt).i.code == ITestSet &&
+ cs_equal(cs, getinstr(compst, tt + 2).buff))
+ addinstruction(compst, IAny, 0);
+ else {
+ addinstruction(compst, ISet, 0);
+ addcharset(compst, cs);
+ }
+ break;
+ }
+ default: addinstruction(compst, op, c); break;
+ }
+}
+
+
+/*
+** code a test set, optimizing unit sets for ITestChar, "complete"
+** sets for ITestAny, and empty sets for IJmp (always fails).
+** 'e' is true iff test should accept the empty string. (Test
+** instructions in the current VM never accept the empty string.)
+*/
+static int codetestset (CompileState *compst, Charset *cs, int e) {
+ if (e) return NOINST; /* no test */
+ else {
+ int c = 0;
+ Opcode op = charsettype(cs->cs, &c);
+ switch (op) {
+ case IFail: return addoffsetinst(compst, IJmp); /* always jump */
+ case IAny: return addoffsetinst(compst, ITestAny);
+ case IChar: {
+ int i = addoffsetinst(compst, ITestChar);
+ getinstr(compst, i).i.aux = c;
+ return i;
+ }
+ case ISet: {
+ int i = addoffsetinst(compst, ITestSet);
+ addcharset(compst, cs->cs);
+ return i;
+ }
+ default: assert(0); return 0;
+ }
+ }
+}
+
+
+/*
+** Find the final destination of a sequence of jumps
+*/
+static int finaltarget (Instruction *code, int i) {
+ while (code[i].i.code == IJmp)
+ i = target(code, i);
+ return i;
+}
+
+
+/*
+** final label (after traversing any jumps)
+*/
+static int finallabel (Instruction *code, int i) {
+ return finaltarget(code, target(code, i));
+}
+
+
+/*
+** <behind(p)> == behind n; <p> (where n = fixedlen(p))
+*/
+static void codebehind (CompileState *compst, TTree *tree) {
+ if (tree->u.n > 0)
+ addinstruction(compst, IBehind, tree->u.n);
+ codegen(compst, sib1(tree), 0, NOINST, fullset);
+}
+
+
+/*
+** Choice; optimizations:
+** - when p1 is headfail or
+** when first(p1) and first(p2) are disjoint, than
+** a character not in first(p1) cannot go to p1, and a character
+** in first(p1) cannot go to p2 (at it is not in first(p2)).
+** (The optimization is not valid if p1 accepts the empty string,
+** as then there is no character at all...)
+** - when p2 is empty and opt is true; a IPartialCommit can reuse
+** the Choice already active in the stack.
+*/
+static void codechoice (CompileState *compst, TTree *p1, TTree *p2, int opt,
+ const Charset *fl) {
+ int emptyp2 = (p2->tag == TTrue);
+ Charset cs1, cs2;
+ int e1 = getfirst(p1, fullset, &cs1);
+ if (headfail(p1) ||
+ (!e1 && (getfirst(p2, fl, &cs2), cs_disjoint(&cs1, &cs2)))) {
+ /* <p1 / p2> == test (fail(p1)) -> L1 ; p1 ; jmp L2; L1: p2; L2: */
+ int test = codetestset(compst, &cs1, 0);
+ int jmp = NOINST;
+ codegen(compst, p1, 0, test, fl);
+ if (!emptyp2)
+ jmp = addoffsetinst(compst, IJmp);
+ jumptohere(compst, test);
+ codegen(compst, p2, opt, NOINST, fl);
+ jumptohere(compst, jmp);
+ }
+ else if (opt && emptyp2) {
+ /* p1? == IPartialCommit; p1 */
+ jumptohere(compst, addoffsetinst(compst, IPartialCommit));
+ codegen(compst, p1, 1, NOINST, fullset);
+ }
+ else {
+ /* <p1 / p2> ==
+ test(first(p1)) -> L1; choice L1; <p1>; commit L2; L1: <p2>; L2: */
+ int pcommit;
+ int test = codetestset(compst, &cs1, e1);
+ int pchoice = addoffsetinst(compst, IChoice);
+ codegen(compst, p1, emptyp2, test, fullset);
+ pcommit = addoffsetinst(compst, ICommit);
+ jumptohere(compst, pchoice);
+ jumptohere(compst, test);
+ codegen(compst, p2, opt, NOINST, fl);
+ jumptohere(compst, pcommit);
+ }
+}
+
+
+/*
+** And predicate
+** optimization: fixedlen(p) = n ==> <&p> == <p>; behind n
+** (valid only when 'p' has no captures)
+*/
+static void codeand (CompileState *compst, TTree *tree, int tt) {
+ int n = fixedlen(tree);
+ if (n >= 0 && n <= MAXBEHIND && !hascaptures(tree)) {
+ codegen(compst, tree, 0, tt, fullset);
+ if (n > 0)
+ addinstruction(compst, IBehind, n);
+ }
+ else { /* default: Choice L1; p1; BackCommit L2; L1: Fail; L2: */
+ int pcommit;
+ int pchoice = addoffsetinst(compst, IChoice);
+ codegen(compst, tree, 0, tt, fullset);
+ pcommit = addoffsetinst(compst, IBackCommit);
+ jumptohere(compst, pchoice);
+ addinstruction(compst, IFail, 0);
+ jumptohere(compst, pcommit);
+ }
+}
+
+
+/*
+** Captures: if pattern has fixed (and not too big) length, and it
+** has no nested captures, use a single IFullCapture instruction
+** after the match; otherwise, enclose the pattern with OpenCapture -
+** CloseCapture.
+*/
+static void codecapture (CompileState *compst, TTree *tree, int tt,
+ const Charset *fl) {
+ int len = fixedlen(sib1(tree));
+ if (len >= 0 && len <= MAXOFF && !hascaptures(sib1(tree))) {
+ codegen(compst, sib1(tree), 0, tt, fl);
+ addinstcap(compst, IFullCapture, tree->cap, tree->key, len);
+ }
+ else {
+ addinstcap(compst, IOpenCapture, tree->cap, tree->key, 0);
+ codegen(compst, sib1(tree), 0, tt, fl);
+ addinstcap(compst, ICloseCapture, Cclose, 0, 0);
+ }
+}
+
+
+static void coderuntime (CompileState *compst, TTree *tree, int tt) {
+ addinstcap(compst, IOpenCapture, Cgroup, tree->key, 0);
+ codegen(compst, sib1(tree), 0, tt, fullset);
+ addinstcap(compst, ICloseRunTime, Cclose, 0, 0);
+}
+
+
+/*
+** Repetion; optimizations:
+** When pattern is a charset, can use special instruction ISpan.
+** When pattern is head fail, or if it starts with characters that
+** are disjoint from what follows the repetions, a simple test
+** is enough (a fail inside the repetition would backtrack to fail
+** again in the following pattern, so there is no need for a choice).
+** When 'opt' is true, the repetion can reuse the Choice already
+** active in the stack.
+*/
+static void coderep (CompileState *compst, TTree *tree, int opt,
+ const Charset *fl) {
+ Charset st;
+ if (tocharset(tree, &st)) {
+ addinstruction(compst, ISpan, 0);
+ addcharset(compst, st.cs);
+ }
+ else {
+ int e1 = getfirst(tree, fullset, &st);
+ if (headfail(tree) || (!e1 && cs_disjoint(&st, fl))) {
+ /* L1: test (fail(p1)) -> L2; <p>; jmp L1; L2: */
+ int jmp;
+ int test = codetestset(compst, &st, 0);
+ codegen(compst, tree, 0, test, fullset);
+ jmp = addoffsetinst(compst, IJmp);
+ jumptohere(compst, test);
+ jumptothere(compst, jmp, test);
+ }
+ else {
+ /* test(fail(p1)) -> L2; choice L2; L1: <p>; partialcommit L1; L2: */
+ /* or (if 'opt'): partialcommit L1; L1: <p>; partialcommit L1; */
+ int commit, l2;
+ int test = codetestset(compst, &st, e1);
+ int pchoice = NOINST;
+ if (opt)
+ jumptohere(compst, addoffsetinst(compst, IPartialCommit));
+ else
+ pchoice = addoffsetinst(compst, IChoice);
+ l2 = gethere(compst);
+ codegen(compst, tree, 0, NOINST, fullset);
+ commit = addoffsetinst(compst, IPartialCommit);
+ jumptothere(compst, commit, l2);
+ jumptohere(compst, pchoice);
+ jumptohere(compst, test);
+ }
+ }
+}
+
+
+/*
+** Not predicate; optimizations:
+** In any case, if first test fails, 'not' succeeds, so it can jump to
+** the end. If pattern is headfail, that is all (it cannot fail
+** in other parts); this case includes 'not' of simple sets. Otherwise,
+** use the default code (a choice plus a failtwice).
+*/
+static void codenot (CompileState *compst, TTree *tree) {
+ Charset st;
+ int e = getfirst(tree, fullset, &st);
+ int test = codetestset(compst, &st, e);
+ if (headfail(tree)) /* test (fail(p1)) -> L1; fail; L1: */
+ addinstruction(compst, IFail, 0);
+ else {
+ /* test(fail(p))-> L1; choice L1; <p>; failtwice; L1: */
+ int pchoice = addoffsetinst(compst, IChoice);
+ codegen(compst, tree, 0, NOINST, fullset);
+ addinstruction(compst, IFailTwice, 0);
+ jumptohere(compst, pchoice);
+ }
+ jumptohere(compst, test);
+}
+
+
+/*
+** change open calls to calls, using list 'positions' to find
+** correct offsets; also optimize tail calls
+*/
+static void correctcalls (CompileState *compst, int *positions,
+ int from, int to) {
+ int i;
+ Instruction *code = compst->p->code;
+ for (i = from; i < to; i += sizei(&code[i])) {
+ if (code[i].i.code == IOpenCall) {
+ int n = code[i].i.key; /* rule number */
+ int rule = positions[n]; /* rule position */
+ assert(rule == from || code[rule - 1].i.code == IRet);
+ if (code[finaltarget(code, i + 2)].i.code == IRet) /* call; ret ? */
+ code[i].i.code = IJmp; /* tail call */
+ else
+ code[i].i.code = ICall;
+ jumptothere(compst, i, rule); /* call jumps to respective rule */
+ }
+ }
+ assert(i == to);
+}
+
+
+/*
+** Code for a grammar:
+** call L1; jmp L2; L1: rule 1; ret; rule 2; ret; ...; L2:
+*/
+static void codegrammar (CompileState *compst, TTree *grammar) {
+ int positions[MAXRULES];
+ int rulenumber = 0;
+ TTree *rule;
+ int firstcall = addoffsetinst(compst, ICall); /* call initial rule */
+ int jumptoend = addoffsetinst(compst, IJmp); /* jump to the end */
+ int start = gethere(compst); /* here starts the initial rule */
+ jumptohere(compst, firstcall);
+ for (rule = sib1(grammar); rule->tag == TRule; rule = sib2(rule)) {
+ positions[rulenumber++] = gethere(compst); /* save rule position */
+ codegen(compst, sib1(rule), 0, NOINST, fullset); /* code rule */
+ addinstruction(compst, IRet, 0);
+ }
+ assert(rule->tag == TTrue);
+ jumptohere(compst, jumptoend);
+ correctcalls(compst, positions, start, gethere(compst));
+}
+
+
+static void codecall (CompileState *compst, TTree *call) {
+ int c = addoffsetinst(compst, IOpenCall); /* to be corrected later */
+ getinstr(compst, c).i.key = sib2(call)->cap; /* rule number */
+ assert(sib2(call)->tag == TRule);
+}
+
+
+/*
+** Code first child of a sequence
+** (second child is called in-place to allow tail call)
+** Return 'tt' for second child
+*/
+static int codeseq1 (CompileState *compst, TTree *p1, TTree *p2,
+ int tt, const Charset *fl) {
+ if (needfollow(p1)) {
+ Charset fl1;
+ getfirst(p2, fl, &fl1); /* p1 follow is p2 first */
+ codegen(compst, p1, 0, tt, &fl1);
+ }
+ else /* use 'fullset' as follow */
+ codegen(compst, p1, 0, tt, fullset);
+ if (fixedlen(p1) != 0) /* can 'p1' consume anything? */
+ return NOINST; /* invalidate test */
+ else return tt; /* else 'tt' still protects sib2 */
+}
+
+
+/*
+** Main code-generation function: dispatch to auxiliar functions
+** according to kind of tree. ('needfollow' should return true
+** only for consructions that use 'fl'.)
+*/
+static void codegen (CompileState *compst, TTree *tree, int opt, int tt,
+ const Charset *fl) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: codechar(compst, tree->u.n, tt); break;
+ case TAny: addinstruction(compst, IAny, 0); break;
+ case TSet: codecharset(compst, treebuffer(tree), tt); break;
+ case TTrue: break;
+ case TFalse: addinstruction(compst, IFail, 0); break;
+ case TChoice: codechoice(compst, sib1(tree), sib2(tree), opt, fl); break;
+ case TRep: coderep(compst, sib1(tree), opt, fl); break;
+ case TBehind: codebehind(compst, tree); break;
+ case TNot: codenot(compst, sib1(tree)); break;
+ case TAnd: codeand(compst, sib1(tree), tt); break;
+ case TCapture: codecapture(compst, tree, tt, fl); break;
+ case TRunTime: coderuntime(compst, tree, tt); break;
+ case TGrammar: codegrammar(compst, tree); break;
+ case TCall: codecall(compst, tree); break;
+ case TSeq: {
+ tt = codeseq1(compst, sib1(tree), sib2(tree), tt, fl); /* code 'p1' */
+ /* codegen(compst, p2, opt, tt, fl); */
+ tree = sib2(tree); goto tailcall;
+ }
+ default: assert(0);
+ }
+}
+
+
+/*
+** Optimize jumps and other jump-like instructions.
+** * Update labels of instructions with labels to their final
+** destinations (e.g., choice L1; ... L1: jmp L2: becomes
+** choice L2)
+** * Jumps to other instructions that do jumps become those
+** instructions (e.g., jump to return becomes a return; jump
+** to commit becomes a commit)
+*/
+static void peephole (CompileState *compst) {
+ Instruction *code = compst->p->code;
+ int i;
+ for (i = 0; i < compst->ncode; i += sizei(&code[i])) {
+ redo:
+ switch (code[i].i.code) {
+ case IChoice: case ICall: case ICommit: case IPartialCommit:
+ case IBackCommit: case ITestChar: case ITestSet:
+ case ITestAny: { /* instructions with labels */
+ jumptothere(compst, i, finallabel(code, i)); /* optimize label */
+ break;
+ }
+ case IJmp: {
+ int ft = finaltarget(code, i);
+ switch (code[ft].i.code) { /* jumping to what? */
+ case IRet: case IFail: case IFailTwice:
+ case IEnd: { /* instructions with unconditional implicit jumps */
+ code[i] = code[ft]; /* jump becomes that instruction */
+ code[i + 1].i.code = IAny; /* 'no-op' for target position */
+ break;
+ }
+ case ICommit: case IPartialCommit:
+ case IBackCommit: { /* inst. with unconditional explicit jumps */
+ int fft = finallabel(code, ft);
+ code[i] = code[ft]; /* jump becomes that instruction... */
+ jumptothere(compst, i, fft); /* but must correct its offset */
+ goto redo; /* reoptimize its label */
+ }
+ default: {
+ jumptothere(compst, i, ft); /* optimize label */
+ break;
+ }
+ }
+ break;
+ }
+ default: break;
+ }
+ }
+ assert(code[i - 1].i.code == IEnd);
+}
+
+
+/*
+** Compile a pattern
+*/
+Instruction *compile (lua_State *L, Pattern *p) {
+ CompileState compst;
+ compst.p = p; compst.ncode = 0; compst.L = L;
+ realloccode(L, p, 2); /* minimum initial size */
+ codegen(&compst, p->tree, 0, NOINST, fullset);
+ addinstruction(&compst, IEnd, 0);
+ realloccode(L, p, compst.ncode); /* set final size */
+ peephole(&compst);
+ return p->code;
+}
+
+
+/* }====================================================== */
+
diff --git a/source/luametatex/source/luacore/luapeg/lpcode.h b/source/luametatex/source/luacore/luapeg/lpcode.h
new file mode 100644
index 000000000..34ee27637
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpcode.h
@@ -0,0 +1,40 @@
+/*
+** $Id: lpcode.h $
+*/
+
+#if !defined(lpcode_h)
+#define lpcode_h
+
+#include "lua.h"
+
+#include "lptypes.h"
+#include "lptree.h"
+#include "lpvm.h"
+
+int tocharset (TTree *tree, Charset *cs);
+int checkaux (TTree *tree, int pred);
+int fixedlen (TTree *tree);
+int hascaptures (TTree *tree);
+int lp_gc (lua_State *L);
+Instruction *compile (lua_State *L, Pattern *p);
+void realloccode (lua_State *L, Pattern *p, int nsize);
+int sizei (const Instruction *i);
+
+
+#define PEnullable 0
+#define PEnofail 1
+
+/*
+** nofail(t) implies that 't' cannot fail with any input
+*/
+#define nofail(t) checkaux(t, PEnofail)
+
+/*
+** (not nullable(t)) implies 't' cannot match without consuming
+** something
+*/
+#define nullable(t) checkaux(t, PEnullable)
+
+
+
+#endif
diff --git a/source/luametatex/source/luacore/luapeg/lpprint.c b/source/luametatex/source/luacore/luapeg/lpprint.c
new file mode 100644
index 000000000..df62cbeed
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpprint.c
@@ -0,0 +1,244 @@
+/*
+** $Id: lpprint.c $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+#include <ctype.h>
+#include <limits.h>
+#include <stdio.h>
+
+
+#include "lptypes.h"
+#include "lpprint.h"
+#include "lpcode.h"
+
+
+#if defined(LPEG_DEBUG)
+
+/*
+** {======================================================
+** Printing patterns (for debugging)
+** =======================================================
+*/
+
+
+void printcharset (const byte *st) {
+ int i;
+ printf("[");
+ for (i = 0; i <= UCHAR_MAX; i++) {
+ int first = i;
+ while (testchar(st, i) && i <= UCHAR_MAX) i++;
+ if (i - 1 == first) /* unary range? */
+ printf("(%02x)", first);
+ else if (i - 1 > first) /* non-empty range? */
+ printf("(%02x-%02x)", first, i - 1);
+ }
+ printf("]");
+}
+
+
+static const char *capkind (int kind) {
+ const char *const modes[] = {
+ "close", "position", "constant", "backref",
+ "argument", "simple", "table", "function",
+ "query", "string", "num", "substitution", "fold",
+ "runtime", "group"};
+ return modes[kind];
+}
+
+
+static void printjmp (const Instruction *op, const Instruction *p) {
+ printf("-> %d", (int)(p + (p + 1)->offset - op));
+}
+
+
+void printinst (const Instruction *op, const Instruction *p) {
+ const char *const names[] = {
+ "any", "char", "set",
+ "testany", "testchar", "testset",
+ "span", "behind",
+ "ret", "end",
+ "choice", "jmp", "call", "open_call",
+ "commit", "partial_commit", "back_commit", "failtwice", "fail", "giveup",
+ "fullcapture", "opencapture", "closecapture", "closeruntime"
+ };
+ printf("%02ld: %s ", (long)(p - op), names[p->i.code]);
+ switch ((Opcode)p->i.code) {
+ case IChar: {
+ printf("'%c'", p->i.aux);
+ break;
+ }
+ case ITestChar: {
+ printf("'%c'", p->i.aux); printjmp(op, p);
+ break;
+ }
+ case IFullCapture: {
+ printf("%s (size = %d) (idx = %d)",
+ capkind(getkind(p)), getoff(p), p->i.key);
+ break;
+ }
+ case IOpenCapture: {
+ printf("%s (idx = %d)", capkind(getkind(p)), p->i.key);
+ break;
+ }
+ case ISet: {
+ printcharset((p+1)->buff);
+ break;
+ }
+ case ITestSet: {
+ printcharset((p+2)->buff); printjmp(op, p);
+ break;
+ }
+ case ISpan: {
+ printcharset((p+1)->buff);
+ break;
+ }
+ case IOpenCall: {
+ printf("-> %d", (p + 1)->offset);
+ break;
+ }
+ case IBehind: {
+ printf("%d", p->i.aux);
+ break;
+ }
+ case IJmp: case ICall: case ICommit: case IChoice:
+ case IPartialCommit: case IBackCommit: case ITestAny: {
+ printjmp(op, p);
+ break;
+ }
+ default: break;
+ }
+ printf("\n");
+}
+
+
+void printpatt (Instruction *p, int n) {
+ Instruction *op = p;
+ while (p < op + n) {
+ printinst(op, p);
+ p += sizei(p);
+ }
+}
+
+
+#if defined(LPEG_DEBUG)
+static void printcap (Capture *cap) {
+ printf("%s (idx: %d - size: %d) -> %p\n",
+ capkind(cap->kind), cap->idx, cap->siz, cap->s);
+}
+
+
+void printcaplist (Capture *cap, Capture *limit) {
+ printf(">======\n");
+ for (; cap->s && (limit == NULL || cap < limit); cap++)
+ printcap(cap);
+ printf("=======\n");
+}
+#endif
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Printing trees (for debugging)
+** =======================================================
+*/
+
+static const char *tagnames[] = {
+ "char", "set", "any",
+ "true", "false",
+ "rep",
+ "seq", "choice",
+ "not", "and",
+ "call", "opencall", "rule", "grammar",
+ "behind",
+ "capture", "run-time"
+};
+
+
+void printtree (TTree *tree, int ident) {
+ int i;
+ for (i = 0; i < ident; i++) printf(" ");
+ printf("%s", tagnames[tree->tag]);
+ switch (tree->tag) {
+ case TChar: {
+ int c = tree->u.n;
+ if (isprint(c))
+ printf(" '%c'\n", c);
+ else
+ printf(" (%02X)\n", c);
+ break;
+ }
+ case TSet: {
+ printcharset(treebuffer(tree));
+ printf("\n");
+ break;
+ }
+ case TOpenCall: case TCall: {
+ assert(sib2(tree)->tag == TRule);
+ printf(" key: %d (rule: %d)\n", tree->key, sib2(tree)->cap);
+ break;
+ }
+ case TBehind: {
+ printf(" %d\n", tree->u.n);
+ printtree(sib1(tree), ident + 2);
+ break;
+ }
+ case TCapture: {
+ printf(" kind: '%s' key: %d\n", capkind(tree->cap), tree->key);
+ printtree(sib1(tree), ident + 2);
+ break;
+ }
+ case TRule: {
+ printf(" n: %d key: %d\n", tree->cap, tree->key);
+ printtree(sib1(tree), ident + 2);
+ break; /* do not print next rule as a sibling */
+ }
+ case TGrammar: {
+ TTree *rule = sib1(tree);
+ printf(" %d\n", tree->u.n); /* number of rules */
+ for (i = 0; i < tree->u.n; i++) {
+ printtree(rule, ident + 2);
+ rule = sib2(rule);
+ }
+ assert(rule->tag == TTrue); /* sentinel */
+ break;
+ }
+ default: {
+ int sibs = numsiblings[tree->tag];
+ printf("\n");
+ if (sibs >= 1) {
+ printtree(sib1(tree), ident + 2);
+ if (sibs >= 2)
+ printtree(sib2(tree), ident + 2);
+ }
+ break;
+ }
+ }
+}
+
+
+void printktable (lua_State *L, int idx) {
+ int n, i;
+ lua_getuservalue(L, idx);
+ if (lua_isnil(L, -1)) /* no ktable? */
+ return;
+ n = lua_rawlen(L, -1);
+ printf("[");
+ for (i = 1; i <= n; i++) {
+ printf("%d = ", i);
+ lua_rawgeti(L, -1, i);
+ if (lua_isstring(L, -1))
+ printf("%s ", lua_tostring(L, -1));
+ else
+ printf("%s ", lua_typename(L, lua_type(L, -1)));
+ lua_pop(L, 1);
+ }
+ printf("]\n");
+ /* leave ktable at the stack */
+}
+
+/* }====================================================== */
+
+#endif
diff --git a/source/luametatex/source/luacore/luapeg/lpprint.h b/source/luametatex/source/luacore/luapeg/lpprint.h
new file mode 100644
index 000000000..15ef121d7
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpprint.h
@@ -0,0 +1,36 @@
+/*
+** $Id: lpprint.h $
+*/
+
+
+#if !defined(lpprint_h)
+#define lpprint_h
+
+
+#include "lptree.h"
+#include "lpvm.h"
+
+
+#if defined(LPEG_DEBUG)
+
+void printpatt (Instruction *p, int n);
+void printtree (TTree *tree, int ident);
+void printktable (lua_State *L, int idx);
+void printcharset (const byte *st);
+void printcaplist (Capture *cap, Capture *limit);
+void printinst (const Instruction *op, const Instruction *p);
+
+#else
+
+#define printktable(L,idx) \
+ luaL_error(L, "function only implemented in debug mode")
+#define printtree(tree,i) \
+ luaL_error(L, "function only implemented in debug mode")
+#define printpatt(p,n) \
+ luaL_error(L, "function only implemented in debug mode")
+
+#endif
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/luapeg/lptree.c b/source/luametatex/source/luacore/luapeg/lptree.c
new file mode 100644
index 000000000..345ca69e3
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lptree.c
@@ -0,0 +1,1305 @@
+/*
+** $Id: lptree.c $
+** Copyright 2013, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+#include <ctype.h>
+#include <limits.h>
+#include <string.h>
+
+
+#include "lua.h"
+#include "lauxlib.h"
+
+#include "lptypes.h"
+#include "lpcap.h"
+#include "lpcode.h"
+#include "lpprint.h"
+#include "lptree.h"
+
+
+/* number of siblings for each tree */
+const byte numsiblings[] = {
+ 0, 0, 0, /* char, set, any */
+ 0, 0, /* true, false */
+ 1, /* rep */
+ 2, 2, /* seq, choice */
+ 1, 1, /* not, and */
+ 0, 0, 2, 1, /* call, opencall, rule, grammar */
+ 1, /* behind */
+ 1, 1 /* capture, runtime capture */
+};
+
+
+static TTree *newgrammar (lua_State *L, int arg);
+
+
+/*
+** returns a reasonable name for value at index 'idx' on the stack
+*/
+static const char *val2str (lua_State *L, int idx) {
+ const char *k = lua_tostring(L, idx);
+ if (k != NULL)
+ return lua_pushfstring(L, "%s", k);
+ else
+ return lua_pushfstring(L, "(a %s)", luaL_typename(L, idx));
+}
+
+
+/*
+** Fix a TOpenCall into a TCall node, using table 'postable' to
+** translate a key to its rule address in the tree. Raises an
+** error if key does not exist.
+*/
+static void fixonecall (lua_State *L, int postable, TTree *g, TTree *t) {
+ int n;
+ lua_rawgeti(L, -1, t->key); /* get rule's name */
+ lua_gettable(L, postable); /* query name in position table */
+ n = lua_tonumber(L, -1); /* get (absolute) position */
+ lua_pop(L, 1); /* remove position */
+ if (n == 0) { /* no position? */
+ lua_rawgeti(L, -1, t->key); /* get rule's name again */
+ luaL_error(L, "rule '%s' undefined in given grammar", val2str(L, -1));
+ }
+ t->tag = TCall;
+ t->u.ps = n - (t - g); /* position relative to node */
+ assert(sib2(t)->tag == TRule);
+ sib2(t)->key = t->key; /* fix rule's key */
+}
+
+
+/*
+** Transform left associative constructions into right
+** associative ones, for sequence and choice; that is:
+** (t11 + t12) + t2 => t11 + (t12 + t2)
+** (t11 * t12) * t2 => t11 * (t12 * t2)
+** (that is, Op (Op t11 t12) t2 => Op t11 (Op t12 t2))
+*/
+static void correctassociativity (TTree *tree) {
+ TTree *t1 = sib1(tree);
+ assert(tree->tag == TChoice || tree->tag == TSeq);
+ while (t1->tag == tree->tag) {
+ int n1size = tree->u.ps - 1; /* t1 == Op t11 t12 */
+ int n11size = t1->u.ps - 1;
+ int n12size = n1size - n11size - 1;
+ memmove(sib1(tree), sib1(t1), n11size * sizeof(TTree)); /* move t11 */
+ tree->u.ps = n11size + 1;
+ sib2(tree)->tag = tree->tag;
+ sib2(tree)->u.ps = n12size + 1;
+ }
+}
+
+
+/*
+** Make final adjustments in a tree. Fix open calls in tree 't',
+** making them refer to their respective rules or raising appropriate
+** errors (if not inside a grammar). Correct associativity of associative
+** constructions (making them right associative). Assume that tree's
+** ktable is at the top of the stack (for error messages).
+*/
+static void finalfix (lua_State *L, int postable, TTree *g, TTree *t) {
+ tailcall:
+ switch (t->tag) {
+ case TGrammar: /* subgrammars were already fixed */
+ return;
+ case TOpenCall: {
+ if (g != NULL) /* inside a grammar? */
+ fixonecall(L, postable, g, t);
+ else { /* open call outside grammar */
+ lua_rawgeti(L, -1, t->key);
+ luaL_error(L, "rule '%s' used outside a grammar", val2str(L, -1));
+ }
+ break;
+ }
+ case TSeq: case TChoice:
+ correctassociativity(t);
+ break;
+ }
+ switch (numsiblings[t->tag]) {
+ case 1: /* finalfix(L, postable, g, sib1(t)); */
+ t = sib1(t); goto tailcall;
+ case 2:
+ finalfix(L, postable, g, sib1(t));
+ t = sib2(t); goto tailcall; /* finalfix(L, postable, g, sib2(t)); */
+ default: assert(numsiblings[t->tag] == 0); break;
+ }
+}
+
+
+
+/*
+** {===================================================================
+** KTable manipulation
+**
+** - The ktable of a pattern 'p' can be shared by other patterns that
+** contain 'p' and no other constants. Because of this sharing, we
+** should not add elements to a 'ktable' unless it was freshly created
+** for the new pattern.
+**
+** - The maximum index in a ktable is USHRT_MAX, because trees and
+** patterns use unsigned shorts to store those indices.
+** ====================================================================
+*/
+
+/*
+** Create a new 'ktable' to the pattern at the top of the stack.
+*/
+static void newktable (lua_State *L, int n) {
+ lua_createtable(L, n, 0); /* create a fresh table */
+ lua_setuservalue(L, -2); /* set it as 'ktable' for pattern */
+}
+
+
+/*
+** Add element 'idx' to 'ktable' of pattern at the top of the stack;
+** Return index of new element.
+** If new element is nil, does not add it to table (as it would be
+** useless) and returns 0, as ktable[0] is always nil.
+*/
+static int addtoktable (lua_State *L, int idx) {
+ if (lua_isnil(L, idx)) /* nil value? */
+ return 0;
+ else {
+ int n;
+ lua_getuservalue(L, -1); /* get ktable from pattern */
+ n = lua_rawlen(L, -1);
+ if (n >= USHRT_MAX)
+ luaL_error(L, "too many Lua values in pattern");
+ lua_pushvalue(L, idx); /* element to be added */
+ lua_rawseti(L, -2, ++n);
+ lua_pop(L, 1); /* remove 'ktable' */
+ return n;
+ }
+}
+
+
+/*
+** Return the number of elements in the ktable at 'idx'.
+** In Lua 5.2/5.3, default "environment" for patterns is nil, not
+** a table. Treat it as an empty table. In Lua 5.1, assumes that
+** the environment has no numeric indices (len == 0)
+*/
+static int ktablelen (lua_State *L, int idx) {
+ if (!lua_istable(L, idx)) return 0;
+ else return lua_rawlen(L, idx);
+}
+
+
+/*
+** Concatentate the contents of table 'idx1' into table 'idx2'.
+** (Assume that both indices are negative.)
+** Return the original length of table 'idx2' (or 0, if no
+** element was added, as there is no need to correct any index).
+*/
+static int concattable (lua_State *L, int idx1, int idx2) {
+ int i;
+ int n1 = ktablelen(L, idx1);
+ int n2 = ktablelen(L, idx2);
+ if (n1 + n2 > USHRT_MAX)
+ luaL_error(L, "too many Lua values in pattern");
+ if (n1 == 0) return 0; /* nothing to correct */
+ for (i = 1; i <= n1; i++) {
+ lua_rawgeti(L, idx1, i);
+ lua_rawseti(L, idx2 - 1, n2 + i); /* correct 'idx2' */
+ }
+ return n2;
+}
+
+
+/*
+** When joining 'ktables', constants from one of the subpatterns must
+** be renumbered; 'correctkeys' corrects their indices (adding 'n'
+** to each of them)
+*/
+static void correctkeys (TTree *tree, int n) {
+ if (n == 0) return; /* no correction? */
+ tailcall:
+ switch (tree->tag) {
+ case TOpenCall: case TCall: case TRunTime: case TRule: {
+ if (tree->key > 0)
+ tree->key += n;
+ break;
+ }
+ case TCapture: {
+ if (tree->key > 0 && tree->cap != Carg && tree->cap != Cnum)
+ tree->key += n;
+ break;
+ }
+ default: break;
+ }
+ switch (numsiblings[tree->tag]) {
+ case 1: /* correctkeys(sib1(tree), n); */
+ tree = sib1(tree); goto tailcall;
+ case 2:
+ correctkeys(sib1(tree), n);
+ tree = sib2(tree); goto tailcall; /* correctkeys(sib2(tree), n); */
+ default: assert(numsiblings[tree->tag] == 0); break;
+ }
+}
+
+
+/*
+** Join the ktables from p1 and p2 the ktable for the new pattern at the
+** top of the stack, reusing them when possible.
+*/
+static void joinktables (lua_State *L, int p1, TTree *t2, int p2) {
+ int n1, n2;
+ lua_getuservalue(L, p1); /* get ktables */
+ lua_getuservalue(L, p2);
+ n1 = ktablelen(L, -2);
+ n2 = ktablelen(L, -1);
+ if (n1 == 0 && n2 == 0) /* are both tables empty? */
+ lua_pop(L, 2); /* nothing to be done; pop tables */
+ else if (n2 == 0 || lp_equal(L, -2, -1)) { /* 2nd table empty or equal? */
+ lua_pop(L, 1); /* pop 2nd table */
+ lua_setuservalue(L, -2); /* set 1st ktable into new pattern */
+ }
+ else if (n1 == 0) { /* first table is empty? */
+ lua_setuservalue(L, -3); /* set 2nd table into new pattern */
+ lua_pop(L, 1); /* pop 1st table */
+ }
+ else {
+ lua_createtable(L, n1 + n2, 0); /* create ktable for new pattern */
+ /* stack: new p; ktable p1; ktable p2; new ktable */
+ concattable(L, -3, -1); /* from p1 into new ktable */
+ concattable(L, -2, -1); /* from p2 into new ktable */
+ lua_setuservalue(L, -4); /* new ktable becomes 'p' environment */
+ lua_pop(L, 2); /* pop other ktables */
+ correctkeys(t2, n1); /* correction for indices from p2 */
+ }
+}
+
+
+/*
+** copy 'ktable' of element 'idx' to new tree (on top of stack)
+*/
+static void copyktable (lua_State *L, int idx) {
+ lua_getuservalue(L, idx);
+ lua_setuservalue(L, -2);
+}
+
+
+/*
+** merge 'ktable' from 'stree' at stack index 'idx' into 'ktable'
+** from tree at the top of the stack, and correct corresponding
+** tree.
+*/
+static void mergektable (lua_State *L, int idx, TTree *stree) {
+ int n;
+ lua_getuservalue(L, -1); /* get ktables */
+ lua_getuservalue(L, idx);
+ n = concattable(L, -1, -2);
+ lua_pop(L, 2); /* remove both ktables */
+ correctkeys(stree, n);
+}
+
+
+/*
+** Create a new 'ktable' to the pattern at the top of the stack, adding
+** all elements from pattern 'p' (if not 0) plus element 'idx' to it.
+** Return index of new element.
+*/
+static int addtonewktable (lua_State *L, int p, int idx) {
+ newktable(L, 1);
+ if (p)
+ mergektable(L, p, NULL);
+ return addtoktable(L, idx);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Tree generation
+** =======================================================
+*/
+
+/*
+** In 5.2, could use 'luaL_testudata'...
+*/
+static int testpattern (lua_State *L, int idx) {
+ if (lua_touserdata(L, idx)) { /* value is a userdata? */
+ if (lua_getmetatable(L, idx)) { /* does it have a metatable? */
+ luaL_getmetatable(L, PATTERN_T);
+ if (lua_rawequal(L, -1, -2)) { /* does it have the correct mt? */
+ lua_pop(L, 2); /* remove both metatables */
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+
+static Pattern *getpattern (lua_State *L, int idx) {
+ return (Pattern *)luaL_checkudata(L, idx, PATTERN_T);
+}
+
+
+static int getsize (lua_State *L, int idx) {
+ return (lua_rawlen(L, idx) - sizeof(Pattern)) / sizeof(TTree) + 1;
+}
+
+
+static TTree *gettree (lua_State *L, int idx, int *len) {
+ Pattern *p = getpattern(L, idx);
+ if (len)
+ *len = getsize(L, idx);
+ return p->tree;
+}
+
+
+/*
+** create a pattern. Set its uservalue (the 'ktable') equal to its
+** metatable. (It could be any empty sequence; the metatable is at
+** hand here, so we use it.)
+*/
+static TTree *newtree (lua_State *L, int len) {
+ size_t size = (len - 1) * sizeof(TTree) + sizeof(Pattern);
+ Pattern *p = (Pattern *)lua_newuserdata(L, size);
+ luaL_getmetatable(L, PATTERN_T);
+ lua_pushvalue(L, -1);
+ lua_setuservalue(L, -3);
+ lua_setmetatable(L, -2);
+ p->code = NULL; p->codesize = 0;
+ return p->tree;
+}
+
+
+static TTree *newleaf (lua_State *L, int tag) {
+ TTree *tree = newtree(L, 1);
+ tree->tag = tag;
+ return tree;
+}
+
+
+static TTree *newcharset (lua_State *L) {
+ TTree *tree = newtree(L, bytes2slots(CHARSETSIZE) + 1);
+ tree->tag = TSet;
+ loopset(i, treebuffer(tree)[i] = 0);
+ return tree;
+}
+
+
+/*
+** add to tree a sequence where first sibling is 'sib' (with size
+** 'sibsize'); returns position for second sibling
+*/
+static TTree *seqaux (TTree *tree, TTree *sib, int sibsize) {
+ tree->tag = TSeq; tree->u.ps = sibsize + 1;
+ memcpy(sib1(tree), sib, sibsize * sizeof(TTree));
+ return sib2(tree);
+}
+
+
+/*
+** Build a sequence of 'n' nodes, each with tag 'tag' and 'u.n' got
+** from the array 's' (or 0 if array is NULL). (TSeq is binary, so it
+** must build a sequence of sequence of sequence...)
+*/
+static void fillseq (TTree *tree, int tag, int n, const char *s) {
+ int i;
+ for (i = 0; i < n - 1; i++) { /* initial n-1 copies of Seq tag; Seq ... */
+ tree->tag = TSeq; tree->u.ps = 2;
+ sib1(tree)->tag = tag;
+ sib1(tree)->u.n = s ? (byte)s[i] : 0;
+ tree = sib2(tree);
+ }
+ tree->tag = tag; /* last one does not need TSeq */
+ tree->u.n = s ? (byte)s[i] : 0;
+}
+
+
+/*
+** Numbers as patterns:
+** 0 == true (always match); n == TAny repeated 'n' times;
+** -n == not (TAny repeated 'n' times)
+*/
+static TTree *numtree (lua_State *L, int n) {
+ if (n == 0)
+ return newleaf(L, TTrue);
+ else {
+ TTree *tree, *nd;
+ if (n > 0)
+ tree = nd = newtree(L, 2 * n - 1);
+ else { /* negative: code it as !(-n) */
+ n = -n;
+ tree = newtree(L, 2 * n);
+ tree->tag = TNot;
+ nd = sib1(tree);
+ }
+ fillseq(nd, TAny, n, NULL); /* sequence of 'n' any's */
+ return tree;
+ }
+}
+
+
+/*
+** Convert value at index 'idx' to a pattern
+*/
+static TTree *getpatt (lua_State *L, int idx, int *len) {
+ TTree *tree;
+ switch (lua_type(L, idx)) {
+ case LUA_TSTRING: {
+ size_t slen;
+ const char *s = lua_tolstring(L, idx, &slen); /* get string */
+ if (slen == 0) /* empty? */
+ tree = newleaf(L, TTrue); /* always match */
+ else {
+ tree = newtree(L, 2 * ((int) slen - 1) + 1);
+ fillseq(tree, TChar, (int) slen, s); /* sequence of 'slen' chars */
+ }
+ break;
+ }
+ case LUA_TNUMBER: {
+ int n = lua_tointeger(L, idx);
+ tree = numtree(L, n);
+ break;
+ }
+ case LUA_TBOOLEAN: {
+ tree = (lua_toboolean(L, idx) ? newleaf(L, TTrue) : newleaf(L, TFalse));
+ break;
+ }
+ case LUA_TTABLE: {
+ tree = newgrammar(L, idx);
+ break;
+ }
+ case LUA_TFUNCTION: {
+ tree = newtree(L, 2);
+ tree->tag = TRunTime;
+ tree->key = addtonewktable(L, 0, idx);
+ sib1(tree)->tag = TTrue;
+ break;
+ }
+ default: {
+ return gettree(L, idx, len);
+ }
+ }
+ lua_replace(L, idx); /* put new tree into 'idx' slot */
+ if (len)
+ *len = getsize(L, idx);
+ return tree;
+}
+
+
+/*
+** create a new tree, whith a new root and one sibling.
+** Sibling must be on the Lua stack, at index 1.
+*/
+static TTree *newroot1sib (lua_State *L, int tag) {
+ int s1;
+ TTree *tree1 = getpatt(L, 1, &s1);
+ TTree *tree = newtree(L, 1 + s1); /* create new tree */
+ tree->tag = tag;
+ memcpy(sib1(tree), tree1, s1 * sizeof(TTree));
+ copyktable(L, 1);
+ return tree;
+}
+
+
+/*
+** create a new tree, whith a new root and 2 siblings.
+** Siblings must be on the Lua stack, first one at index 1.
+*/
+static TTree *newroot2sib (lua_State *L, int tag) {
+ int s1, s2;
+ TTree *tree1 = getpatt(L, 1, &s1);
+ TTree *tree2 = getpatt(L, 2, &s2);
+ TTree *tree = newtree(L, 1 + s1 + s2); /* create new tree */
+ tree->tag = tag;
+ tree->u.ps = 1 + s1;
+ memcpy(sib1(tree), tree1, s1 * sizeof(TTree));
+ memcpy(sib2(tree), tree2, s2 * sizeof(TTree));
+ joinktables(L, 1, sib2(tree), 2);
+ return tree;
+}
+
+
+static int lp_P (lua_State *L) {
+ luaL_checkany(L, 1);
+ getpatt(L, 1, NULL);
+ lua_settop(L, 1);
+ return 1;
+}
+
+
+/*
+** sequence operator; optimizations:
+** false x => false, x true => x, true x => x
+** (cannot do x . false => false because x may have runtime captures)
+*/
+static int lp_seq (lua_State *L) {
+ TTree *tree1 = getpatt(L, 1, NULL);
+ TTree *tree2 = getpatt(L, 2, NULL);
+ if (tree1->tag == TFalse || tree2->tag == TTrue)
+ lua_pushvalue(L, 1); /* false . x == false, x . true = x */
+ else if (tree1->tag == TTrue)
+ lua_pushvalue(L, 2); /* true . x = x */
+ else
+ newroot2sib(L, TSeq);
+ return 1;
+}
+
+
+/*
+** choice operator; optimizations:
+** charset / charset => charset
+** true / x => true, x / false => x, false / x => x
+** (x / true is not equivalent to true)
+*/
+static int lp_choice (lua_State *L) {
+ Charset st1, st2;
+ TTree *t1 = getpatt(L, 1, NULL);
+ TTree *t2 = getpatt(L, 2, NULL);
+ if (tocharset(t1, &st1) && tocharset(t2, &st2)) {
+ TTree *t = newcharset(L);
+ loopset(i, treebuffer(t)[i] = st1.cs[i] | st2.cs[i]);
+ }
+ else if (nofail(t1) || t2->tag == TFalse)
+ lua_pushvalue(L, 1); /* true / x => true, x / false => x */
+ else if (t1->tag == TFalse)
+ lua_pushvalue(L, 2); /* false / x => x */
+ else
+ newroot2sib(L, TChoice);
+ return 1;
+}
+
+
+/*
+** p^n
+*/
+static int lp_star (lua_State *L) {
+ int size1;
+ int n = (int)luaL_checkinteger(L, 2);
+ TTree *tree1 = getpatt(L, 1, &size1);
+ if (n >= 0) { /* seq tree1 (seq tree1 ... (seq tree1 (rep tree1))) */
+ TTree *tree = newtree(L, (n + 1) * (size1 + 1));
+ if (nullable(tree1))
+ luaL_error(L, "loop body may accept empty string");
+ while (n--) /* repeat 'n' times */
+ tree = seqaux(tree, tree1, size1);
+ tree->tag = TRep;
+ memcpy(sib1(tree), tree1, size1 * sizeof(TTree));
+ }
+ else { /* choice (seq tree1 ... choice tree1 true ...) true */
+ TTree *tree;
+ n = -n;
+ /* size = (choice + seq + tree1 + true) * n, but the last has no seq */
+ tree = newtree(L, n * (size1 + 3) - 1);
+ for (; n > 1; n--) { /* repeat (n - 1) times */
+ tree->tag = TChoice; tree->u.ps = n * (size1 + 3) - 2;
+ sib2(tree)->tag = TTrue;
+ tree = sib1(tree);
+ tree = seqaux(tree, tree1, size1);
+ }
+ tree->tag = TChoice; tree->u.ps = size1 + 1;
+ sib2(tree)->tag = TTrue;
+ memcpy(sib1(tree), tree1, size1 * sizeof(TTree));
+ }
+ copyktable(L, 1);
+ return 1;
+}
+
+
+/*
+** #p == &p
+*/
+static int lp_and (lua_State *L) {
+ newroot1sib(L, TAnd);
+ return 1;
+}
+
+
+/*
+** -p == !p
+*/
+static int lp_not (lua_State *L) {
+ newroot1sib(L, TNot);
+ return 1;
+}
+
+
+/*
+** [t1 - t2] == Seq (Not t2) t1
+** If t1 and t2 are charsets, make their difference.
+*/
+static int lp_sub (lua_State *L) {
+ Charset st1, st2;
+ int s1, s2;
+ TTree *t1 = getpatt(L, 1, &s1);
+ TTree *t2 = getpatt(L, 2, &s2);
+ if (tocharset(t1, &st1) && tocharset(t2, &st2)) {
+ TTree *t = newcharset(L);
+ loopset(i, treebuffer(t)[i] = st1.cs[i] & ~st2.cs[i]);
+ }
+ else {
+ TTree *tree = newtree(L, 2 + s1 + s2);
+ tree->tag = TSeq; /* sequence of... */
+ tree->u.ps = 2 + s2;
+ sib1(tree)->tag = TNot; /* ...not... */
+ memcpy(sib1(sib1(tree)), t2, s2 * sizeof(TTree)); /* ...t2 */
+ memcpy(sib2(tree), t1, s1 * sizeof(TTree)); /* ... and t1 */
+ joinktables(L, 1, sib1(tree), 2);
+ }
+ return 1;
+}
+
+
+static int lp_set (lua_State *L) {
+ size_t l;
+ const char *s = luaL_checklstring(L, 1, &l);
+ TTree *tree = newcharset(L);
+ while (l--) {
+ setchar(treebuffer(tree), (byte)(*s));
+ s++;
+ }
+ return 1;
+}
+
+
+static int lp_range (lua_State *L) {
+ int arg;
+ int top = lua_gettop(L);
+ TTree *tree = newcharset(L);
+ for (arg = 1; arg <= top; arg++) {
+ int c;
+ size_t l;
+ const char *r = luaL_checklstring(L, arg, &l);
+ luaL_argcheck(L, l == 2, arg, "range must have two characters");
+ for (c = (byte)r[0]; c <= (byte)r[1]; c++)
+ setchar(treebuffer(tree), c);
+ }
+ return 1;
+}
+
+
+/*
+** Look-behind predicate
+*/
+static int lp_behind (lua_State *L) {
+ TTree *tree;
+ TTree *tree1 = getpatt(L, 1, NULL);
+ int n = fixedlen(tree1);
+ luaL_argcheck(L, n >= 0, 1, "pattern may not have fixed length");
+ luaL_argcheck(L, !hascaptures(tree1), 1, "pattern have captures");
+ luaL_argcheck(L, n <= MAXBEHIND, 1, "pattern too long to look behind");
+ tree = newroot1sib(L, TBehind);
+ tree->u.n = n;
+ return 1;
+}
+
+
+/*
+** Create a non-terminal
+*/
+static int lp_V (lua_State *L) {
+ TTree *tree = newleaf(L, TOpenCall);
+ luaL_argcheck(L, !lua_isnoneornil(L, 1), 1, "non-nil value expected");
+ tree->key = addtonewktable(L, 0, 1);
+ return 1;
+}
+
+
+/*
+** Create a tree for a non-empty capture, with a body and
+** optionally with an associated Lua value (at index 'labelidx' in the
+** stack)
+*/
+static int capture_aux (lua_State *L, int cap, int labelidx) {
+ TTree *tree = newroot1sib(L, TCapture);
+ tree->cap = cap;
+ tree->key = (labelidx == 0) ? 0 : addtonewktable(L, 1, labelidx);
+ return 1;
+}
+
+
+/*
+** Fill a tree with an empty capture, using an empty (TTrue) sibling.
+** (The 'key' field must be filled by the caller to finish the tree.)
+*/
+static TTree *auxemptycap (TTree *tree, int cap) {
+ tree->tag = TCapture;
+ tree->cap = cap;
+ sib1(tree)->tag = TTrue;
+ return tree;
+}
+
+
+/*
+** Create a tree for an empty capture.
+*/
+static TTree *newemptycap (lua_State *L, int cap, int key) {
+ TTree *tree = auxemptycap(newtree(L, 2), cap);
+ tree->key = key;
+ return tree;
+}
+
+
+/*
+** Create a tree for an empty capture with an associated Lua value.
+*/
+static TTree *newemptycapkey (lua_State *L, int cap, int idx) {
+ TTree *tree = auxemptycap(newtree(L, 2), cap);
+ tree->key = addtonewktable(L, 0, idx);
+ return tree;
+}
+
+
+/*
+** Captures with syntax p / v
+** (function capture, query capture, string capture, or number capture)
+*/
+static int lp_divcapture (lua_State *L) {
+ switch (lua_type(L, 2)) {
+ case LUA_TFUNCTION: return capture_aux(L, Cfunction, 2);
+ case LUA_TTABLE: return capture_aux(L, Cquery, 2);
+ case LUA_TSTRING: return capture_aux(L, Cstring, 2);
+ case LUA_TNUMBER: {
+ int n = lua_tointeger(L, 2);
+ TTree *tree = newroot1sib(L, TCapture);
+ luaL_argcheck(L, 0 <= n && n <= SHRT_MAX, 1, "invalid number");
+ tree->cap = Cnum;
+ tree->key = n;
+ return 1;
+ }
+ default: return luaL_argerror(L, 2, "invalid replacement value");
+ }
+}
+
+
+static int lp_substcapture (lua_State *L) {
+ return capture_aux(L, Csubst, 0);
+}
+
+
+static int lp_tablecapture (lua_State *L) {
+ return capture_aux(L, Ctable, 0);
+}
+
+
+static int lp_groupcapture (lua_State *L) {
+ if (lua_isnoneornil(L, 2))
+ return capture_aux(L, Cgroup, 0);
+ else
+ return capture_aux(L, Cgroup, 2);
+}
+
+
+static int lp_foldcapture (lua_State *L) {
+ luaL_checktype(L, 2, LUA_TFUNCTION);
+ return capture_aux(L, Cfold, 2);
+}
+
+
+static int lp_simplecapture (lua_State *L) {
+ return capture_aux(L, Csimple, 0);
+}
+
+
+static int lp_poscapture (lua_State *L) {
+ newemptycap(L, Cposition, 0);
+ return 1;
+}
+
+
+static int lp_argcapture (lua_State *L) {
+ int n = (int)luaL_checkinteger(L, 1);
+ luaL_argcheck(L, 0 < n && n <= SHRT_MAX, 1, "invalid argument index");
+ newemptycap(L, Carg, n);
+ return 1;
+}
+
+
+static int lp_backref (lua_State *L) {
+ luaL_checkany(L, 1);
+ newemptycapkey(L, Cbackref, 1);
+ return 1;
+}
+
+
+/*
+** Constant capture
+*/
+static int lp_constcapture (lua_State *L) {
+ int i;
+ int n = lua_gettop(L); /* number of values */
+ if (n == 0) /* no values? */
+ newleaf(L, TTrue); /* no capture */
+ else if (n == 1)
+ newemptycapkey(L, Cconst, 1); /* single constant capture */
+ else { /* create a group capture with all values */
+ TTree *tree = newtree(L, 1 + 3 * (n - 1) + 2);
+ newktable(L, n); /* create a 'ktable' for new tree */
+ tree->tag = TCapture;
+ tree->cap = Cgroup;
+ tree->key = 0;
+ tree = sib1(tree);
+ for (i = 1; i <= n - 1; i++) {
+ tree->tag = TSeq;
+ tree->u.ps = 3; /* skip TCapture and its sibling */
+ auxemptycap(sib1(tree), Cconst);
+ sib1(tree)->key = addtoktable(L, i);
+ tree = sib2(tree);
+ }
+ auxemptycap(tree, Cconst);
+ tree->key = addtoktable(L, i);
+ }
+ return 1;
+}
+
+
+static int lp_matchtime (lua_State *L) {
+ TTree *tree;
+ luaL_checktype(L, 2, LUA_TFUNCTION);
+ tree = newroot1sib(L, TRunTime);
+ tree->key = addtonewktable(L, 1, 2);
+ return 1;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Grammar - Tree generation
+** =======================================================
+*/
+
+/*
+** push on the stack the index and the pattern for the
+** initial rule of grammar at index 'arg' in the stack;
+** also add that index into position table.
+*/
+static void getfirstrule (lua_State *L, int arg, int postab) {
+ lua_rawgeti(L, arg, 1); /* access first element */
+ if (lua_isstring(L, -1)) { /* is it the name of initial rule? */
+ lua_pushvalue(L, -1); /* duplicate it to use as key */
+ lua_gettable(L, arg); /* get associated rule */
+ }
+ else {
+ lua_pushinteger(L, 1); /* key for initial rule */
+ lua_insert(L, -2); /* put it before rule */
+ }
+ if (!testpattern(L, -1)) { /* initial rule not a pattern? */
+ if (lua_isnil(L, -1))
+ luaL_error(L, "grammar has no initial rule");
+ else
+ luaL_error(L, "initial rule '%s' is not a pattern", lua_tostring(L, -2));
+ }
+ lua_pushvalue(L, -2); /* push key */
+ lua_pushinteger(L, 1); /* push rule position (after TGrammar) */
+ lua_settable(L, postab); /* insert pair at position table */
+}
+
+/*
+** traverse grammar at index 'arg', pushing all its keys and patterns
+** into the stack. Create a new table (before all pairs key-pattern) to
+** collect all keys and their associated positions in the final tree
+** (the "position table").
+** Return the number of rules and (in 'totalsize') the total size
+** for the new tree.
+*/
+static int collectrules (lua_State *L, int arg, int *totalsize) {
+ int n = 1; /* to count number of rules */
+ int postab = lua_gettop(L) + 1; /* index of position table */
+ int size; /* accumulator for total size */
+ lua_newtable(L); /* create position table */
+ getfirstrule(L, arg, postab);
+ size = 2 + getsize(L, postab + 2); /* TGrammar + TRule + rule */
+ lua_pushnil(L); /* prepare to traverse grammar table */
+ while (lua_next(L, arg) != 0) {
+ if (lua_tonumber(L, -2) == 1 ||
+ lp_equal(L, -2, postab + 1)) { /* initial rule? */
+ lua_pop(L, 1); /* remove value (keep key for lua_next) */
+ continue;
+ }
+ if (!testpattern(L, -1)) /* value is not a pattern? */
+ luaL_error(L, "rule '%s' is not a pattern", val2str(L, -2));
+ luaL_checkstack(L, LUA_MINSTACK, "grammar has too many rules");
+ lua_pushvalue(L, -2); /* push key (to insert into position table) */
+ lua_pushinteger(L, size);
+ lua_settable(L, postab);
+ size += 1 + getsize(L, -1); /* update size */
+ lua_pushvalue(L, -2); /* push key (for next lua_next) */
+ n++;
+ }
+ *totalsize = size + 1; /* TTrue to finish list of rules */
+ return n;
+}
+
+
+static void buildgrammar (lua_State *L, TTree *grammar, int frule, int n) {
+ int i;
+ TTree *nd = sib1(grammar); /* auxiliary pointer to traverse the tree */
+ for (i = 0; i < n; i++) { /* add each rule into new tree */
+ int ridx = frule + 2*i + 1; /* index of i-th rule */
+ int rulesize;
+ TTree *rn = gettree(L, ridx, &rulesize);
+ nd->tag = TRule;
+ nd->key = 0; /* will be fixed when rule is used */
+ nd->cap = i; /* rule number */
+ nd->u.ps = rulesize + 1; /* point to next rule */
+ memcpy(sib1(nd), rn, rulesize * sizeof(TTree)); /* copy rule */
+ mergektable(L, ridx, sib1(nd)); /* merge its ktable into new one */
+ nd = sib2(nd); /* move to next rule */
+ }
+ nd->tag = TTrue; /* finish list of rules */
+}
+
+
+/*
+** Check whether a tree has potential infinite loops
+*/
+static int checkloops (TTree *tree) {
+ tailcall:
+ if (tree->tag == TRep && nullable(sib1(tree)))
+ return 1;
+ else if (tree->tag == TGrammar)
+ return 0; /* sub-grammars already checked */
+ else {
+ switch (numsiblings[tree->tag]) {
+ case 1: /* return checkloops(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case 2:
+ if (checkloops(sib1(tree))) return 1;
+ /* else return checkloops(sib2(tree)); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(numsiblings[tree->tag] == 0); return 0;
+ }
+ }
+}
+
+
+/*
+** Give appropriate error message for 'verifyrule'. If a rule appears
+** twice in 'passed', there is path from it back to itself without
+** advancing the subject.
+*/
+static int verifyerror (lua_State *L, int *passed, int npassed) {
+ int i, j;
+ for (i = npassed - 1; i >= 0; i--) { /* search for a repetition */
+ for (j = i - 1; j >= 0; j--) {
+ if (passed[i] == passed[j]) {
+ lua_rawgeti(L, -1, passed[i]); /* get rule's key */
+ return luaL_error(L, "rule '%s' may be left recursive", val2str(L, -1));
+ }
+ }
+ }
+ return luaL_error(L, "too many left calls in grammar");
+}
+
+
+/*
+** Check whether a rule can be left recursive; raise an error in that
+** case; otherwise return 1 iff pattern is nullable.
+** The return value is used to check sequences, where the second pattern
+** is only relevant if the first is nullable.
+** Parameter 'nb' works as an accumulator, to allow tail calls in
+** choices. ('nb' true makes function returns true.)
+** Parameter 'passed' is a list of already visited rules, 'npassed'
+** counts the elements in 'passed'.
+** Assume ktable at the top of the stack.
+*/
+static int verifyrule (lua_State *L, TTree *tree, int *passed, int npassed,
+ int nb) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ case TFalse:
+ return nb; /* cannot pass from here */
+ case TTrue:
+ case TBehind: /* look-behind cannot have calls */
+ return 1;
+ case TNot: case TAnd: case TRep:
+ /* return verifyrule(L, sib1(tree), passed, npassed, 1); */
+ tree = sib1(tree); nb = 1; goto tailcall;
+ case TCapture: case TRunTime:
+ /* return verifyrule(L, sib1(tree), passed, npassed, nb); */
+ tree = sib1(tree); goto tailcall;
+ case TCall:
+ /* return verifyrule(L, sib2(tree), passed, npassed, nb); */
+ tree = sib2(tree); goto tailcall;
+ case TSeq: /* only check 2nd child if first is nb */
+ if (!verifyrule(L, sib1(tree), passed, npassed, 0))
+ return nb;
+ /* else return verifyrule(L, sib2(tree), passed, npassed, nb); */
+ tree = sib2(tree); goto tailcall;
+ case TChoice: /* must check both children */
+ nb = verifyrule(L, sib1(tree), passed, npassed, nb);
+ /* return verifyrule(L, sib2(tree), passed, npassed, nb); */
+ tree = sib2(tree); goto tailcall;
+ case TRule:
+ if (npassed >= MAXRULES)
+ return verifyerror(L, passed, npassed);
+ else {
+ passed[npassed++] = tree->key;
+ /* return verifyrule(L, sib1(tree), passed, npassed); */
+ tree = sib1(tree); goto tailcall;
+ }
+ case TGrammar:
+ return nullable(tree); /* sub-grammar cannot be left recursive */
+ default: assert(0); return 0;
+ }
+}
+
+
+static void verifygrammar (lua_State *L, TTree *grammar) {
+ int passed[MAXRULES];
+ TTree *rule;
+ /* check left-recursive rules */
+ for (rule = sib1(grammar); rule->tag == TRule; rule = sib2(rule)) {
+ if (rule->key == 0) continue; /* unused rule */
+ verifyrule(L, sib1(rule), passed, 0, 0);
+ }
+ assert(rule->tag == TTrue);
+ /* check infinite loops inside rules */
+ for (rule = sib1(grammar); rule->tag == TRule; rule = sib2(rule)) {
+ if (rule->key == 0) continue; /* unused rule */
+ if (checkloops(sib1(rule))) {
+ lua_rawgeti(L, -1, rule->key); /* get rule's key */
+ luaL_error(L, "empty loop in rule '%s'", val2str(L, -1));
+ }
+ }
+ assert(rule->tag == TTrue);
+}
+
+
+/*
+** Give a name for the initial rule if it is not referenced
+*/
+static void initialrulename (lua_State *L, TTree *grammar, int frule) {
+ if (sib1(grammar)->key == 0) { /* initial rule is not referenced? */
+ int n = lua_rawlen(L, -1) + 1; /* index for name */
+ lua_pushvalue(L, frule); /* rule's name */
+ lua_rawseti(L, -2, n); /* ktable was on the top of the stack */
+ sib1(grammar)->key = n;
+ }
+}
+
+
+static TTree *newgrammar (lua_State *L, int arg) {
+ int treesize;
+ int frule = lua_gettop(L) + 2; /* position of first rule's key */
+ int n = collectrules(L, arg, &treesize);
+ TTree *g = newtree(L, treesize);
+ luaL_argcheck(L, n <= MAXRULES, arg, "grammar has too many rules");
+ g->tag = TGrammar; g->u.n = n;
+ lua_newtable(L); /* create 'ktable' */
+ lua_setuservalue(L, -2);
+ buildgrammar(L, g, frule, n);
+ lua_getuservalue(L, -1); /* get 'ktable' for new tree */
+ finalfix(L, frule - 1, g, sib1(g));
+ initialrulename(L, g, frule);
+ verifygrammar(L, g);
+ lua_pop(L, 1); /* remove 'ktable' */
+ lua_insert(L, -(n * 2 + 2)); /* move new table to proper position */
+ lua_pop(L, n * 2 + 1); /* remove position table + rule pairs */
+ return g; /* new table at the top of the stack */
+}
+
+/* }====================================================== */
+
+
+static Instruction *prepcompile (lua_State *L, Pattern *p, int idx) {
+ lua_getuservalue(L, idx); /* push 'ktable' (may be used by 'finalfix') */
+ finalfix(L, 0, NULL, p->tree);
+ lua_pop(L, 1); /* remove 'ktable' */
+ return compile(L, p);
+}
+
+
+static int lp_printtree (lua_State *L) {
+ TTree *tree = getpatt(L, 1, NULL);
+ int c = lua_toboolean(L, 2);
+ if (c) {
+ lua_getuservalue(L, 1); /* push 'ktable' (may be used by 'finalfix') */
+ finalfix(L, 0, NULL, tree);
+ lua_pop(L, 1); /* remove 'ktable' */
+ }
+ printktable(L, 1);
+ printtree(tree, 0);
+ return 0;
+}
+
+
+static int lp_printcode (lua_State *L) {
+ Pattern *p = getpattern(L, 1);
+ printktable(L, 1);
+ if (p->code == NULL) /* not compiled yet? */
+ prepcompile(L, p, 1);
+ printpatt(p->code, p->codesize);
+ return 0;
+}
+
+
+/*
+** Get the initial position for the match, interpreting negative
+** values from the end of the subject
+*/
+static size_t initposition (lua_State *L, size_t len) {
+ lua_Integer ii = luaL_optinteger(L, 3, 1);
+ if (ii > 0) { /* positive index? */
+ if ((size_t)ii <= len) /* inside the string? */
+ return (size_t)ii - 1; /* return it (corrected to 0-base) */
+ else return len; /* crop at the end */
+ }
+ else { /* negative index */
+ if ((size_t)(-ii) <= len) /* inside the string? */
+ return len - ((size_t)(-ii)); /* return position from the end */
+ else return 0; /* crop at the beginning */
+ }
+}
+
+
+/*
+** Main match function
+*/
+static int lp_match (lua_State *L) {
+ Capture capture[INITCAPSIZE];
+ const char *r;
+ size_t l;
+ Pattern *p = (getpatt(L, 1, NULL), getpattern(L, 1));
+ Instruction *code = (p->code != NULL) ? p->code : prepcompile(L, p, 1);
+ const char *s = luaL_checklstring(L, SUBJIDX, &l);
+ size_t i = initposition(L, l);
+ int ptop = lua_gettop(L);
+ lua_pushnil(L); /* initialize subscache */
+ lua_pushlightuserdata(L, capture); /* initialize caplistidx */
+ lua_getuservalue(L, 1); /* initialize penvidx */
+ r = match(L, s, s + i, s + l, code, capture, ptop);
+ if (r == NULL) {
+ lua_pushnil(L);
+ return 1;
+ }
+ return getcaptures(L, s, r, ptop);
+}
+
+
+
+/*
+** {======================================================
+** Library creation and functions not related to matching
+** =======================================================
+*/
+
+/* maximum limit for stack size */
+#define MAXLIM (INT_MAX / 100)
+
+static int lp_setmax (lua_State *L) {
+ lua_Integer lim = luaL_checkinteger(L, 1);
+ luaL_argcheck(L, 0 < lim && lim <= MAXLIM, 1, "out of range");
+ lua_settop(L, 1);
+ lua_setfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
+ return 0;
+}
+
+
+static int lp_version (lua_State *L) {
+ lua_pushstring(L, VERSION);
+ return 1;
+}
+
+
+static int lp_type (lua_State *L) {
+ if (testpattern(L, 1))
+ lua_pushliteral(L, "pattern");
+ else
+ lua_pushnil(L);
+ return 1;
+}
+
+
+int lp_gc (lua_State *L) {
+ Pattern *p = getpattern(L, 1);
+ realloccode(L, p, 0); /* delete code block */
+ return 0;
+}
+
+
+static void createcat (lua_State *L, const char *catname, int (catf) (int)) {
+ TTree *t = newcharset(L);
+ int i;
+ for (i = 0; i <= UCHAR_MAX; i++)
+ if (catf(i)) setchar(treebuffer(t), i);
+ lua_setfield(L, -2, catname);
+}
+
+
+static int lp_locale (lua_State *L) {
+ if (lua_isnoneornil(L, 1)) {
+ lua_settop(L, 0);
+ lua_createtable(L, 0, 12);
+ }
+ else {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ lua_settop(L, 1);
+ }
+ createcat(L, "alnum", isalnum);
+ createcat(L, "alpha", isalpha);
+ createcat(L, "cntrl", iscntrl);
+ createcat(L, "digit", isdigit);
+ createcat(L, "graph", isgraph);
+ createcat(L, "lower", islower);
+ createcat(L, "print", isprint);
+ createcat(L, "punct", ispunct);
+ createcat(L, "space", isspace);
+ createcat(L, "upper", isupper);
+ createcat(L, "xdigit", isxdigit);
+ return 1;
+}
+
+
+static struct luaL_Reg pattreg[] = {
+ {"ptree", lp_printtree},
+ {"pcode", lp_printcode},
+ {"match", lp_match},
+ {"B", lp_behind},
+ {"V", lp_V},
+ {"C", lp_simplecapture},
+ {"Cc", lp_constcapture},
+ {"Cmt", lp_matchtime},
+ {"Cb", lp_backref},
+ {"Carg", lp_argcapture},
+ {"Cp", lp_poscapture},
+ {"Cs", lp_substcapture},
+ {"Ct", lp_tablecapture},
+ {"Cf", lp_foldcapture},
+ {"Cg", lp_groupcapture},
+ {"P", lp_P},
+ {"S", lp_set},
+ {"R", lp_range},
+ {"locale", lp_locale},
+ {"version", lp_version},
+ {"setmaxstack", lp_setmax},
+ {"type", lp_type},
+ {NULL, NULL}
+};
+
+
+static struct luaL_Reg metareg[] = {
+ {"__mul", lp_seq},
+ {"__add", lp_choice},
+ {"__pow", lp_star},
+ {"__gc", lp_gc},
+ {"__len", lp_and},
+ {"__div", lp_divcapture},
+ {"__unm", lp_not},
+ {"__sub", lp_sub},
+ {NULL, NULL}
+};
+
+
+int luaopen_lpeg (lua_State *L);
+int luaopen_lpeg (lua_State *L) {
+ luaL_newmetatable(L, PATTERN_T);
+ lua_pushnumber(L, MAXBACK); /* initialize maximum backtracking */
+ lua_setfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
+ luaL_setfuncs(L, metareg, 0);
+ luaL_newlib(L, pattreg);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -3, "__index");
+ return 1;
+}
+
+/* }====================================================== */
diff --git a/source/luametatex/source/luacore/luapeg/lptree.h b/source/luametatex/source/luacore/luapeg/lptree.h
new file mode 100644
index 000000000..25906d5f4
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lptree.h
@@ -0,0 +1,82 @@
+/*
+** $Id: lptree.h $
+*/
+
+#if !defined(lptree_h)
+#define lptree_h
+
+
+#include "lptypes.h"
+
+
+/*
+** types of trees
+*/
+typedef enum TTag {
+ TChar = 0, /* 'n' = char */
+ TSet, /* the set is stored in next CHARSETSIZE bytes */
+ TAny,
+ TTrue,
+ TFalse,
+ TRep, /* 'sib1'* */
+ TSeq, /* 'sib1' 'sib2' */
+ TChoice, /* 'sib1' / 'sib2' */
+ TNot, /* !'sib1' */
+ TAnd, /* &'sib1' */
+ TCall, /* ktable[key] is rule's key; 'sib2' is rule being called */
+ TOpenCall, /* ktable[key] is rule's key */
+ TRule, /* ktable[key] is rule's key (but key == 0 for unused rules);
+ 'sib1' is rule's pattern;
+ 'sib2' is next rule; 'cap' is rule's sequential number */
+ TGrammar, /* 'sib1' is initial (and first) rule */
+ TBehind, /* 'sib1' is pattern, 'n' is how much to go back */
+ TCapture, /* captures: 'cap' is kind of capture (enum 'CapKind');
+ ktable[key] is Lua value associated with capture;
+ 'sib1' is capture body */
+ TRunTime /* run-time capture: 'key' is Lua function;
+ 'sib1' is capture body */
+} TTag;
+
+
+/*
+** Tree trees
+** The first child of a tree (if there is one) is immediately after
+** the tree. A reference to a second child (ps) is its position
+** relative to the position of the tree itself.
+*/
+typedef struct TTree {
+ byte tag;
+ byte cap; /* kind of capture (if it is a capture) */
+ unsigned short key; /* key in ktable for Lua data (0 if no key) */
+ union {
+ int ps; /* occasional second child */
+ int n; /* occasional counter */
+ } u;
+} TTree;
+
+
+/*
+** A complete pattern has its tree plus, if already compiled,
+** its corresponding code
+*/
+typedef struct Pattern {
+ union Instruction *code;
+ int codesize;
+ TTree tree[1];
+} Pattern;
+
+
+/* number of children for each tree */
+extern const byte numsiblings[];
+
+/* access to children */
+#define sib1(t) ((t) + 1)
+#define sib2(t) ((t) + (t)->u.ps)
+
+
+
+
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/luapeg/lptypes.h b/source/luametatex/source/luacore/luapeg/lptypes.h
new file mode 100644
index 000000000..acb21cc32
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lptypes.h
@@ -0,0 +1,146 @@
+/*
+** $Id: lptypes.h $
+** LPeg - PEG pattern matching for Lua
+** Copyright 2007-2019, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+** written by Roberto Ierusalimschy
+*/
+
+#if !defined(lptypes_h)
+#define lptypes_h
+
+// # include <assert.h>
+# define assert(condition) ((void)0)
+
+#include <limits.h>
+
+#include "lua.h"
+
+
+#define VERSION "1.0.2"
+
+
+#define PATTERN_T "lpeg-pattern"
+#define MAXSTACKIDX "lpeg-maxstack"
+
+
+/*
+** compatibility with Lua 5.1
+*/
+#if (LUA_VERSION_NUM == 501)
+
+#define lp_equal lua_equal
+
+#define lua_getuservalue lua_getfenv
+#define lua_setuservalue lua_setfenv
+
+#define lua_rawlen lua_objlen
+
+#define luaL_setfuncs(L,f,n) luaL_register(L,NULL,f)
+#define luaL_newlib(L,f) luaL_register(L,"lpeg",f)
+
+#endif
+
+
+#if !defined(lp_equal)
+#define lp_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
+#endif
+
+
+/* default maximum size for call/backtrack stack */
+#if !defined(MAXBACK)
+#define MAXBACK 400
+#endif
+
+
+/* maximum number of rules in a grammar (limited by 'unsigned char') */
+#if !defined(MAXRULES)
+#define MAXRULES 250
+#endif
+
+
+
+/* initial size for capture's list */
+#define INITCAPSIZE 32
+
+
+/* index, on Lua stack, for subject */
+#define SUBJIDX 2
+
+/* number of fixed arguments to 'match' (before capture arguments) */
+#define FIXEDARGS 3
+
+/* index, on Lua stack, for capture list */
+#define caplistidx(ptop) ((ptop) + 2)
+
+/* index, on Lua stack, for pattern's ktable */
+#define ktableidx(ptop) ((ptop) + 3)
+
+/* index, on Lua stack, for backtracking stack */
+#define stackidx(ptop) ((ptop) + 4)
+
+
+
+typedef unsigned char byte;
+
+
+#define BITSPERCHAR 8
+
+#define CHARSETSIZE ((UCHAR_MAX/BITSPERCHAR) + 1)
+
+
+
+typedef struct Charset {
+ byte cs[CHARSETSIZE];
+} Charset;
+
+
+
+#define loopset(v,b) { int v; for (v = 0; v < CHARSETSIZE; v++) {b;} }
+
+/* access to charset */
+#define treebuffer(t) ((byte *)((t) + 1))
+
+/* number of slots needed for 'n' bytes */
+#define bytes2slots(n) (((n) - 1) / sizeof(TTree) + 1)
+
+/* set 'b' bit in charset 'cs' */
+#define setchar(cs,b) ((cs)[(b) >> 3] |= (1 << ((b) & 7)))
+
+
+/*
+** in capture instructions, 'kind' of capture and its offset are
+** packed in field 'aux', 4 bits for each
+*/
+#define getkind(op) ((op)->i.aux & 0xF)
+#define getoff(op) (((op)->i.aux >> 4) & 0xF)
+#define joinkindoff(k,o) ((k) | ((o) << 4))
+
+#define MAXOFF 0xF
+#define MAXAUX 0xFF
+
+
+/* maximum number of bytes to look behind */
+#define MAXBEHIND MAXAUX
+
+
+/* maximum size (in elements) for a pattern */
+#define MAXPATTSIZE (SHRT_MAX - 10)
+
+
+/* size (in elements) for an instruction plus extra l bytes */
+#define instsize(l) (((l) + sizeof(Instruction) - 1)/sizeof(Instruction) + 1)
+
+
+/* size (in elements) for a ISet instruction */
+#define CHARSETINSTSIZE instsize(CHARSETSIZE)
+
+/* size (in elements) for a IFunc instruction */
+#define funcinstsize(p) ((p)->i.aux + 2)
+
+
+
+#define testchar(st,c) (((int)(st)[((c) >> 3)] & (1 << ((c) & 7))))
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/luapeg/lpvm.c b/source/luametatex/source/luacore/luapeg/lpvm.c
new file mode 100644
index 000000000..1265a1dcf
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpvm.c
@@ -0,0 +1,406 @@
+/*
+** $Id: lpvm.c $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+#include <limits.h>
+#include <string.h>
+
+
+#include "lua.h"
+#include "lauxlib.h"
+
+#include "lpcap.h"
+#include "lptypes.h"
+#include "lpvm.h"
+#include "lpprint.h"
+
+
+/* initial size for call/backtrack stack */
+#if !defined(INITBACK)
+#define INITBACK MAXBACK
+#endif
+
+
+#define getoffset(p) (((p) + 1)->offset)
+
+static const Instruction giveup = {{IGiveup, 0, 0}};
+
+
+/*
+** {======================================================
+** Virtual Machine
+** =======================================================
+*/
+
+
+typedef struct Stack {
+ const char *s; /* saved position (or NULL for calls) */
+ const Instruction *p; /* next instruction */
+ int caplevel;
+} Stack;
+
+
+#define getstackbase(L, ptop) ((Stack *)lua_touserdata(L, stackidx(ptop)))
+
+
+/*
+** Ensures the size of array 'capture' (with size '*capsize' and
+** 'captop' elements being used) is enough to accomodate 'n' extra
+** elements plus one. (Because several opcodes add stuff to the capture
+** array, it is simpler to ensure the array always has at least one free
+** slot upfront and check its size later.)
+*/
+
+// static Capture *growcap (lua_State *L, Capture *capture, int *capsize,
+// int captop, int n, int ptop) {
+// if (*capsize - captop > n)
+// return capture; /* no need to grow array */
+// else { /* must grow */
+// Capture *newc;
+// int newsize = captop + n + 1; /* minimum size needed */
+// if (newsize < INT_MAX/((int)sizeof(Capture) * 2))
+// newsize *= 2; /* twice that size, if not too big */
+// else if (newsize >= INT_MAX/((int)sizeof(Capture)))
+// luaL_error(L, "too many captures");
+// else
+// // We grow by one and that sort of freezes lpeg.
+// newc = (Capture *)lua_newuserdata(L, newsize * sizeof(Capture));
+// memcpy(newc, capture, captop * sizeof(Capture));
+// *capsize = newsize;
+// lua_replace(L, caplistidx(ptop));
+// return newc;
+// }
+// }
+
+static Capture *growcap (lua_State *L, Capture *capture, int *capsize,
+ int captop, int n, int ptop) {
+ if (*capsize - captop > n)
+ return capture; /* no need to grow array */
+ else { /* must grow */
+ Capture *newc;
+ int newsize = captop + n + 1; /* minimum size needed */
+ if (newsize < INT_MAX/2) {
+ newsize *= 2; /* twice that size, if not too big */
+ if (newsize > INT_MAX) {
+ newsize = INT_MAX;
+ }
+ } else if (newsize < INT_MAX) {
+ newsize += newsize/2; /* or maybe /4 */
+ if (newsize > INT_MAX) {
+ newsize = INT_MAX;
+ }
+ } else {
+ luaL_error(L, "too many captures");
+ }
+ /* not a realloc, probably impossible */
+ newc = (Capture *)lua_newuserdata(L, newsize * sizeof(Capture));
+ memcpy(newc, capture, captop * sizeof(Capture));
+ *capsize = newsize;
+ lua_replace(L, caplistidx(ptop));
+ return newc;
+ }
+}
+
+
+/*
+** Double the size of the stack
+*/
+static Stack *doublestack (lua_State *L, Stack **stacklimit, int ptop) {
+ Stack *stack = getstackbase(L, ptop);
+ Stack *newstack;
+ int n = *stacklimit - stack; /* current stack size */
+ int max, newn;
+ lua_getfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
+ max = lua_tointeger(L, -1); /* maximum allowed size */
+ lua_pop(L, 1);
+ if (n >= max) /* already at maximum size? */
+ luaL_error(L, "backtrack stack overflow (current limit is %d)", max);
+ newn = 2 * n; /* new size */
+ if (newn > max) newn = max;
+ newstack = (Stack *)lua_newuserdata(L, newn * sizeof(Stack));
+ memcpy(newstack, stack, n * sizeof(Stack));
+ lua_replace(L, stackidx(ptop));
+ *stacklimit = newstack + newn;
+ return newstack + n; /* return next position */
+}
+
+
+/*
+** Interpret the result of a dynamic capture: false -> fail;
+** true -> keep current position; number -> next position.
+** Return new subject position. 'fr' is stack index where
+** is the result; 'curr' is current subject position; 'limit'
+** is subject's size.
+*/
+static int resdyncaptures (lua_State *L, int fr, int curr, int limit) {
+ lua_Integer res;
+ if (!lua_toboolean(L, fr)) { /* false value? */
+ lua_settop(L, fr - 1); /* remove results */
+ return -1; /* and fail */
+ }
+ else if (lua_isboolean(L, fr)) /* true? */
+ res = curr; /* keep current position */
+ else {
+ res = lua_tointeger(L, fr) - 1; /* new position */
+ if (res < curr || res > limit)
+ luaL_error(L, "invalid position returned by match-time capture");
+ }
+ lua_remove(L, fr); /* remove first result (offset) */
+ return res;
+}
+
+
+/*
+** Add capture values returned by a dynamic capture to the list
+** 'capture', nested inside a group. 'fd' indexes the first capture
+** value, 'n' is the number of values (at least 1). The open group
+** capture is already in 'capture', before the place for the new entries.
+*/
+static void adddyncaptures (const char *s, Capture *capture, int n, int fd) {
+ int i;
+ assert(capture[-1].kind == Cgroup && capture[-1].siz == 0);
+ capture[-1].idx = 0; /* make group capture an anonymous group */
+ for (i = 0; i < n; i++) { /* add runtime captures */
+ capture[i].kind = Cruntime;
+ capture[i].siz = 1; /* mark it as closed */
+ capture[i].idx = fd + i; /* stack index of capture value */
+ capture[i].s = s;
+ }
+ capture[n].kind = Cclose; /* close group */
+ capture[n].siz = 1;
+ capture[n].s = s;
+}
+
+
+/*
+** Remove dynamic captures from the Lua stack (called in case of failure)
+*/
+static int removedyncap (lua_State *L, Capture *capture,
+ int level, int last) {
+ int id = finddyncap(capture + level, capture + last); /* index of 1st cap. */
+ int top = lua_gettop(L);
+ if (id == 0) return 0; /* no dynamic captures? */
+ lua_settop(L, id - 1); /* remove captures */
+ return top - id + 1; /* number of values removed */
+}
+
+
+/*
+** Opcode interpreter
+*/
+const char *match (lua_State *L, const char *o, const char *s, const char *e,
+ Instruction *op, Capture *capture, int ptop) {
+ Stack stackbase[INITBACK];
+ Stack *stacklimit = stackbase + INITBACK;
+ Stack *stack = stackbase; /* point to first empty slot in stack */
+ int capsize = INITCAPSIZE;
+ int captop = 0; /* point to first empty slot in captures */
+ int ndyncap = 0; /* number of dynamic captures (in Lua stack) */
+ const Instruction *p = op; /* current instruction */
+ stack->p = &giveup; stack->s = s; stack->caplevel = 0; stack++;
+ lua_pushlightuserdata(L, stackbase);
+ for (;;) {
+#if defined(DEBUG)
+ printf("-------------------------------------\n");
+ printcaplist(capture, capture + captop);
+ printf("s: |%s| stck:%d, dyncaps:%d, caps:%d ",
+ s, (int)(stack - getstackbase(L, ptop)), ndyncap, captop);
+ printinst(op, p);
+#endif
+ assert(stackidx(ptop) + ndyncap == lua_gettop(L) && ndyncap <= captop);
+ switch ((Opcode)p->i.code) {
+ case IEnd: {
+ assert(stack == getstackbase(L, ptop) + 1);
+ capture[captop].kind = Cclose;
+ capture[captop].s = NULL;
+ return s;
+ }
+ case IGiveup: {
+ assert(stack == getstackbase(L, ptop));
+ return NULL;
+ }
+ case IRet: {
+ assert(stack > getstackbase(L, ptop) && (stack - 1)->s == NULL);
+ p = (--stack)->p;
+ continue;
+ }
+ case IAny: {
+ if (s < e) { p++; s++; }
+ else goto fail;
+ continue;
+ }
+ case ITestAny: {
+ if (s < e) p += 2;
+ else p += getoffset(p);
+ continue;
+ }
+ case IChar: {
+ if ((byte)*s == p->i.aux && s < e) { p++; s++; }
+ else goto fail;
+ continue;
+ }
+ case ITestChar: {
+ if ((byte)*s == p->i.aux && s < e) p += 2;
+ else p += getoffset(p);
+ continue;
+ }
+ case ISet: {
+ int c = (byte)*s;
+ if (testchar((p+1)->buff, c) && s < e)
+ { p += CHARSETINSTSIZE; s++; }
+ else goto fail;
+ continue;
+ }
+ case ITestSet: {
+ int c = (byte)*s;
+ if (testchar((p + 2)->buff, c) && s < e)
+ p += 1 + CHARSETINSTSIZE;
+ else p += getoffset(p);
+ continue;
+ }
+ case IBehind: {
+ int n = p->i.aux;
+ if (n > s - o) goto fail;
+ s -= n; p++;
+ continue;
+ }
+ case ISpan: {
+ for (; s < e; s++) {
+ int c = (byte)*s;
+ if (!testchar((p+1)->buff, c)) break;
+ }
+ p += CHARSETINSTSIZE;
+ continue;
+ }
+ case IJmp: {
+ p += getoffset(p);
+ continue;
+ }
+ case IChoice: {
+ if (stack == stacklimit)
+ stack = doublestack(L, &stacklimit, ptop);
+ stack->p = p + getoffset(p);
+ stack->s = s;
+ stack->caplevel = captop;
+ stack++;
+ p += 2;
+ continue;
+ }
+ case ICall: {
+ if (stack == stacklimit)
+ stack = doublestack(L, &stacklimit, ptop);
+ stack->s = NULL;
+ stack->p = p + 2; /* save return address */
+ stack++;
+ p += getoffset(p);
+ continue;
+ }
+ case ICommit: {
+ assert(stack > getstackbase(L, ptop) && (stack - 1)->s != NULL);
+ stack--;
+ p += getoffset(p);
+ continue;
+ }
+ case IPartialCommit: {
+ assert(stack > getstackbase(L, ptop) && (stack - 1)->s != NULL);
+ (stack - 1)->s = s;
+ (stack - 1)->caplevel = captop;
+ p += getoffset(p);
+ continue;
+ }
+ case IBackCommit: {
+ assert(stack > getstackbase(L, ptop) && (stack - 1)->s != NULL);
+ s = (--stack)->s;
+ captop = stack->caplevel;
+ p += getoffset(p);
+ continue;
+ }
+ case IFailTwice:
+ assert(stack > getstackbase(L, ptop));
+ stack--;
+ /* go through */
+ case IFail:
+ fail: { /* pattern failed: try to backtrack */
+ do { /* remove pending calls */
+ assert(stack > getstackbase(L, ptop));
+ s = (--stack)->s;
+ } while (s == NULL);
+ if (ndyncap > 0) /* is there matchtime captures? */
+ ndyncap -= removedyncap(L, capture, stack->caplevel, captop);
+ captop = stack->caplevel;
+ p = stack->p;
+#if defined(DEBUG)
+ printf("**FAIL**\n");
+#endif
+ continue;
+ }
+ case ICloseRunTime: {
+ CapState cs;
+ int rem, res, n;
+ int fr = lua_gettop(L) + 1; /* stack index of first result */
+ cs.reclevel = 0; cs.L = L;
+ cs.s = o; cs.ocap = capture; cs.ptop = ptop;
+ n = runtimecap(&cs, capture + captop, s, &rem); /* call function */
+ captop -= n; /* remove nested captures */
+ ndyncap -= rem; /* update number of dynamic captures */
+ fr -= rem; /* 'rem' items were popped from Lua stack */
+ res = resdyncaptures(L, fr, s - o, e - o); /* get result */
+ if (res == -1) /* fail? */
+ goto fail;
+ s = o + res; /* else update current position */
+ n = lua_gettop(L) - fr + 1; /* number of new captures */
+ ndyncap += n; /* update number of dynamic captures */
+ if (n == 0) /* no new captures? */
+ captop--; /* remove open group */
+ else { /* new captures; keep original open group */
+ if (fr + n >= SHRT_MAX)
+ luaL_error(L, "too many results in match-time capture");
+ /* add new captures + close group to 'capture' list */
+ capture = growcap(L, capture, &capsize, captop, n + 1, ptop);
+ adddyncaptures(s, capture + captop, n, fr);
+ captop += n + 1; /* new captures + close group */
+ }
+ p++;
+ continue;
+ }
+ case ICloseCapture: {
+ const char *s1 = s;
+ assert(captop > 0);
+ /* if possible, turn capture into a full capture */
+ if (capture[captop - 1].siz == 0 &&
+ s1 - capture[captop - 1].s < UCHAR_MAX) {
+ capture[captop - 1].siz = s1 - capture[captop - 1].s + 1;
+ p++;
+ continue;
+ }
+ else {
+ capture[captop].siz = 1; /* mark entry as closed */
+ capture[captop].s = s;
+ goto pushcapture;
+ }
+ }
+ case IOpenCapture:
+ capture[captop].siz = 0; /* mark entry as open */
+ capture[captop].s = s;
+ goto pushcapture;
+ case IFullCapture:
+ capture[captop].siz = getoff(p) + 1; /* save capture size */
+ capture[captop].s = s - getoff(p);
+ /* goto pushcapture; */
+ pushcapture: {
+ capture[captop].idx = p->i.key;
+ capture[captop].kind = getkind(p);
+ captop++;
+ capture = growcap(L, capture, &capsize, captop, 0, ptop);
+ p++;
+ continue;
+ }
+ default: assert(0); return NULL;
+ }
+ }
+}
+
+/* }====================================================== */
+
+
diff --git a/source/luametatex/source/luacore/luapeg/lpvm.h b/source/luametatex/source/luacore/luapeg/lpvm.h
new file mode 100644
index 000000000..69ec33dce
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/lpvm.h
@@ -0,0 +1,58 @@
+/*
+** $Id: lpvm.h $
+*/
+
+#if !defined(lpvm_h)
+#define lpvm_h
+
+#include "lpcap.h"
+
+
+/* Virtual Machine's instructions */
+typedef enum Opcode {
+ IAny, /* if no char, fail */
+ IChar, /* if char != aux, fail */
+ ISet, /* if char not in buff, fail */
+ ITestAny, /* in no char, jump to 'offset' */
+ ITestChar, /* if char != aux, jump to 'offset' */
+ ITestSet, /* if char not in buff, jump to 'offset' */
+ ISpan, /* read a span of chars in buff */
+ IBehind, /* walk back 'aux' characters (fail if not possible) */
+ IRet, /* return from a rule */
+ IEnd, /* end of pattern */
+ IChoice, /* stack a choice; next fail will jump to 'offset' */
+ IJmp, /* jump to 'offset' */
+ ICall, /* call rule at 'offset' */
+ IOpenCall, /* call rule number 'key' (must be closed to a ICall) */
+ ICommit, /* pop choice and jump to 'offset' */
+ IPartialCommit, /* update top choice to current position and jump */
+ IBackCommit, /* "fails" but jump to its own 'offset' */
+ IFailTwice, /* pop one choice and then fail */
+ IFail, /* go back to saved state on choice and jump to saved offset */
+ IGiveup, /* internal use */
+ IFullCapture, /* complete capture of last 'off' chars */
+ IOpenCapture, /* start a capture */
+ ICloseCapture,
+ ICloseRunTime
+} Opcode;
+
+
+
+typedef union Instruction {
+ struct Inst {
+ byte code;
+ byte aux;
+ short key;
+ } i;
+ int offset;
+ byte buff[1];
+} Instruction;
+
+
+void printpatt (Instruction *p, int n);
+const char *match (lua_State *L, const char *o, const char *s, const char *e,
+ Instruction *op, Capture *capture, int ptop);
+
+
+#endif
+
diff --git a/source/luametatex/source/luacore/luapeg/readme.txt b/source/luametatex/source/luacore/luapeg/readme.txt
new file mode 100644
index 000000000..17b6b404d
--- /dev/null
+++ b/source/luametatex/source/luacore/luapeg/readme.txt
@@ -0,0 +1,9 @@
+Commented line in lptypes.h:
+
+ # include <assert.h>
+
+Added line in lptypes.h:
+
+ # define assert(condition) ((void)0)
+
+Maybe some day lua_assert will be used in lpeg. \ No newline at end of file
diff --git a/source/luametatex/source/luacore/luasocket/LICENSE b/source/luametatex/source/luacore/luasocket/LICENSE
new file mode 100644
index 000000000..b63545107
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/LICENSE
@@ -0,0 +1,20 @@
+LuaSocket 3.0 license
+Copyright © 2004-2013 Diego Nehab
+
+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.
diff --git a/source/luametatex/source/luacore/luasocket/NEW b/source/luametatex/source/luacore/luasocket/NEW
new file mode 100644
index 000000000..0bff64c1d
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/NEW
@@ -0,0 +1,44 @@
+What's New
+
+Main changes for LuaSocket 3.0-rc1 are IPv6 support and Lua 5.2 compatibility.
+
+ * Added: Compatible with Lua 5.2
+ - Note that unless you define LUA_COMPAT_MODULE, package
+ tables will not be exported as globals!
+ * Added: IPv6 support;
+ - Socket.connect and socket.bind support IPv6 addresses;
+ - Getpeername and getsockname support IPv6 addresses, and
+ return the socket family as a third value;
+ - URL module updated to support IPv6 host names;
+ - New socket.tcp6 and socket.udp6 functions;
+ - New socket.dns.getaddrinfo and socket.dns.getnameinfo functions;
+ * Added: getoption method;
+ * Fixed: url.unescape was returning additional values;
+ * Fixed: mime.qp, mime.unqp, mime.b64, and mime.unb64 could
+ mistaking their own stack slots for functions arguments;
+ * Fixed: Receiving zero-length datagram is now possible;
+ * Improved: Hidden all internal library symbols;
+ * Improved: Better error messages;
+ * Improved: Better documentation of socket options.
+ * Fixed: manual sample of HTTP authentication now uses correct
+ "authorization" header (Alexandre Ittner);
+ * Fixed: failure on bind() was destroying the socket (Sam Roberts);
+ * Fixed: receive() returns immediatelly if prefix can satisfy
+ bytes requested (M Joonas Pihlaja);
+ * Fixed: multicast didn't work on Windows, or anywhere
+ else for that matter (Herbert Leuwer, Adrian Sietsma);
+ * Fixed: select() now reports an error when called with more
+ sockets than FD_SETSIZE (Lorenzo Leonini);
+ * Fixed: manual links to home.html changed to index.html (Robert Hahn);
+ * Fixed: mime.unb64() would return an empty string on results that started
+ with a null character (Robert Raschke);
+ * Fixed: HTTP now automatically redirects on 303 and 307 (Jonathan Gray);
+ * Fixed: calling sleep() with negative numbers could
+ block forever, wasting CPU. Now it returns immediately (MPB);
+ * Improved: FTP commands are now sent in upper case to
+ help buggy servers (Anders Eurenius);
+ * Improved: known headers now sent in canonic
+ capitalization to help buggy servers (Joseph Stewart);
+ * Improved: Clarified tcp:receive() in the manual (MPB);
+ * Improved: Decent makefiles (LHF).
+ * Fixed: RFC links in documentation now point to IETF (Cosmin Apreutesei).
diff --git a/source/luametatex/source/luacore/luasocket/README b/source/luametatex/source/luacore/luasocket/README
new file mode 100644
index 000000000..cd8ee59d1
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/README
@@ -0,0 +1,11 @@
+This is the LuaSocket 3.0-rc1. It has been tested on Windows 7, Mac OS X,
+and Linux.
+
+Please use the project page at GitHub
+
+ https://github.com/diegonehab/luasocket
+
+to file bug reports or propose changes.
+
+Have fun,
+Diego Nehab.
diff --git a/source/luametatex/source/luacore/luasocket/doc.zip b/source/luametatex/source/luacore/luasocket/doc.zip
new file mode 100644
index 000000000..179929626
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/doc.zip
Binary files differ
diff --git a/source/luametatex/source/luacore/luasocket/etc.zip b/source/luametatex/source/luacore/luasocket/etc.zip
new file mode 100644
index 000000000..2b8db2078
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/etc.zip
Binary files differ
diff --git a/source/luametatex/source/luacore/luasocket/lua.zip b/source/luametatex/source/luacore/luasocket/lua.zip
new file mode 100644
index 000000000..f69111dc4
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/lua.zip
Binary files differ
diff --git a/source/luametatex/source/luacore/luasocket/samples.zip b/source/luametatex/source/luacore/luasocket/samples.zip
new file mode 100644
index 000000000..e8d7eb3c2
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/samples.zip
Binary files differ
diff --git a/source/luametatex/source/luacore/luasocket/src/auxiliar.c b/source/luametatex/source/luacore/luasocket/src/auxiliar.c
new file mode 100644
index 000000000..93a66a09f
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/auxiliar.c
@@ -0,0 +1,154 @@
+/*=========================================================================*\
+* Auxiliar routines for class hierarchy manipulation
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "auxiliar.h"
+#include <string.h>
+#include <stdio.h>
+
+/*-------------------------------------------------------------------------*\
+* Initializes the module
+\*-------------------------------------------------------------------------*/
+int auxiliar_open(lua_State *L) {
+ (void) L;
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Creates a new class with given methods
+* Methods whose names start with __ are passed directly to the metatable.
+\*-------------------------------------------------------------------------*/
+void auxiliar_newclass(lua_State *L, const char *classname, luaL_Reg *func) {
+ luaL_newmetatable(L, classname); /* mt */
+ /* create __index table to place methods */
+ lua_pushstring(L, "__index"); /* mt,"__index" */
+ lua_newtable(L); /* mt,"__index",it */
+ /* put class name into class metatable */
+ lua_pushstring(L, "class"); /* mt,"__index",it,"class" */
+ lua_pushstring(L, classname); /* mt,"__index",it,"class",classname */
+ lua_rawset(L, -3); /* mt,"__index",it */
+ /* pass all methods that start with _ to the metatable, and all others
+ * to the index table */
+ for (; func->name; func++) { /* mt,"__index",it */
+ lua_pushstring(L, func->name);
+ lua_pushcfunction(L, func->func);
+ lua_rawset(L, func->name[0] == '_' ? -5: -3);
+ }
+ lua_rawset(L, -3); /* mt */
+ lua_pop(L, 1);
+}
+
+/*-------------------------------------------------------------------------*\
+* Prints the value of a class in a nice way
+\*-------------------------------------------------------------------------*/
+int auxiliar_tostring(lua_State *L) {
+ char buf[32];
+ if (!lua_getmetatable(L, 1)) goto error;
+ lua_pushstring(L, "__index");
+ lua_gettable(L, -2);
+ if (!lua_istable(L, -1)) goto error;
+ lua_pushstring(L, "class");
+ lua_gettable(L, -2);
+ if (!lua_isstring(L, -1)) goto error;
+ sprintf(buf, "%p", lua_touserdata(L, 1));
+ lua_pushfstring(L, "%s: %s", lua_tostring(L, -1), buf);
+ return 1;
+error:
+ lua_pushstring(L, "invalid object passed to 'auxiliar.c:__tostring'");
+ lua_error(L);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Insert class into group
+\*-------------------------------------------------------------------------*/
+void auxiliar_add2group(lua_State *L, const char *classname, const char *groupname) {
+ luaL_getmetatable(L, classname);
+ lua_pushstring(L, groupname);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+ lua_pop(L, 1);
+}
+
+/*-------------------------------------------------------------------------*\
+* Make sure argument is a boolean
+\*-------------------------------------------------------------------------*/
+int auxiliar_checkboolean(lua_State *L, int objidx) {
+ if (!lua_isboolean(L, objidx))
+ auxiliar_typeerror(L, objidx, lua_typename(L, LUA_TBOOLEAN));
+ return lua_toboolean(L, objidx);
+}
+
+/*-------------------------------------------------------------------------*\
+* Return userdata pointer if object belongs to a given class, abort with
+* error otherwise
+\*-------------------------------------------------------------------------*/
+void *auxiliar_checkclass(lua_State *L, const char *classname, int objidx) {
+ void *data = auxiliar_getclassudata(L, classname, objidx);
+ if (!data) {
+ char msg[45];
+ sprintf(msg, "%.35s expected", classname);
+ luaL_argerror(L, objidx, msg);
+ }
+ return data;
+}
+
+/*-------------------------------------------------------------------------*\
+* Return userdata pointer if object belongs to a given group, abort with
+* error otherwise
+\*-------------------------------------------------------------------------*/
+void *auxiliar_checkgroup(lua_State *L, const char *groupname, int objidx) {
+ void *data = auxiliar_getgroupudata(L, groupname, objidx);
+ if (!data) {
+ char msg[45];
+ sprintf(msg, "%.35s expected", groupname);
+ luaL_argerror(L, objidx, msg);
+ }
+ return data;
+}
+
+/*-------------------------------------------------------------------------*\
+* Set object class
+\*-------------------------------------------------------------------------*/
+void auxiliar_setclass(lua_State *L, const char *classname, int objidx) {
+ luaL_getmetatable(L, classname);
+ if (objidx < 0) objidx--;
+ lua_setmetatable(L, objidx);
+}
+
+/*-------------------------------------------------------------------------*\
+* Get a userdata pointer if object belongs to a given group. Return NULL
+* otherwise
+\*-------------------------------------------------------------------------*/
+void *auxiliar_getgroupudata(lua_State *L, const char *groupname, int objidx) {
+ if (!lua_getmetatable(L, objidx))
+ return NULL;
+ lua_pushstring(L, groupname);
+ lua_rawget(L, -2);
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 2);
+ return NULL;
+ } else {
+ lua_pop(L, 2);
+ return lua_touserdata(L, objidx);
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Get a userdata pointer if object belongs to a given class. Return NULL
+* otherwise
+\*-------------------------------------------------------------------------*/
+void *auxiliar_getclassudata(lua_State *L, const char *classname, int objidx) {
+ return luaL_testudata(L, objidx, classname);
+}
+
+/*-------------------------------------------------------------------------*\
+* Throws error when argument does not have correct type.
+* Used to be part of lauxlib in Lua 5.1, was dropped from 5.2.
+\*-------------------------------------------------------------------------*/
+int auxiliar_typeerror (lua_State *L, int narg, const char *tname) {
+ const char *msg = lua_pushfstring(L, "%s expected, got %s", tname,
+ luaL_typename(L, narg));
+ return luaL_argerror(L, narg, msg);
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/auxiliar.h b/source/luametatex/source/luacore/luasocket/src/auxiliar.h
new file mode 100644
index 000000000..e8c3ead82
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/auxiliar.h
@@ -0,0 +1,54 @@
+#ifndef AUXILIAR_H
+#define AUXILIAR_H
+/*=========================================================================*\
+* Auxiliar routines for class hierarchy manipulation
+* LuaSocket toolkit (but completely independent of other LuaSocket modules)
+*
+* A LuaSocket class is a name associated with Lua metatables. A LuaSocket
+* group is a name associated with a class. A class can belong to any number
+* of groups. This module provides the functionality to:
+*
+* - create new classes
+* - add classes to groups
+* - set the class of objects
+* - check if an object belongs to a given class or group
+* - get the userdata associated to objects
+* - print objects in a pretty way
+*
+* LuaSocket class names follow the convention <module>{<class>}. Modules
+* can define any number of classes and groups. The module tcp.c, for
+* example, defines the classes tcp{master}, tcp{client} and tcp{server} and
+* the groups tcp{client,server} and tcp{any}. Module functions can then
+* perform type-checking on their arguments by either class or group.
+*
+* LuaSocket metatables define the __index metamethod as being a table. This
+* table has one field for each method supported by the class, and a field
+* "class" with the class name.
+*
+* The mapping from class name to the corresponding metatable and the
+* reverse mapping are done using lauxlib.
+\*=========================================================================*/
+
+#include "luasocket.h"
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int auxiliar_open(lua_State *L);
+void auxiliar_newclass(lua_State *L, const char *classname, luaL_Reg *func);
+int auxiliar_tostring(lua_State *L);
+void auxiliar_add2group(lua_State *L, const char *classname, const char *group);
+int auxiliar_checkboolean(lua_State *L, int objidx);
+void *auxiliar_checkclass(lua_State *L, const char *classname, int objidx);
+void *auxiliar_checkgroup(lua_State *L, const char *groupname, int objidx);
+void auxiliar_setclass(lua_State *L, const char *classname, int objidx);
+void *auxiliar_getgroupudata(lua_State *L, const char *groupname, int objidx);
+void *auxiliar_getclassudata(lua_State *L, const char *groupname, int objidx);
+int auxiliar_typeerror(lua_State *L, int narg, const char *tname);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* AUXILIAR_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/buffer.c b/source/luametatex/source/luacore/luasocket/src/buffer.c
new file mode 100644
index 000000000..7148be34f
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/buffer.c
@@ -0,0 +1,273 @@
+/*=========================================================================*\
+* Input/Output interface for Lua programs
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "buffer.h"
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int recvraw(p_buffer buf, size_t wanted, luaL_Buffer *b);
+static int recvline(p_buffer buf, luaL_Buffer *b);
+static int recvall(p_buffer buf, luaL_Buffer *b);
+static int buffer_get(p_buffer buf, const char **data, size_t *count);
+static void buffer_skip(p_buffer buf, size_t count);
+static int sendraw(p_buffer buf, const char *data, size_t count, size_t *sent);
+
+/* min and max macros */
+#ifndef MIN
+#define MIN(x, y) ((x) < (y) ? x : y)
+#endif
+#ifndef MAX
+#define MAX(x, y) ((x) > (y) ? x : y)
+#endif
+
+/*=========================================================================*\
+* Exported functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int buffer_open(lua_State *L) {
+ (void) L;
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Initializes C structure
+\*-------------------------------------------------------------------------*/
+void buffer_init(p_buffer buf, p_io io, p_timeout tm) {
+ buf->first = buf->last = 0;
+ buf->io = io;
+ buf->tm = tm;
+ buf->received = buf->sent = 0;
+ buf->birthday = timeout_gettime();
+}
+
+/*-------------------------------------------------------------------------*\
+* object:getstats() interface
+\*-------------------------------------------------------------------------*/
+int buffer_meth_getstats(lua_State *L, p_buffer buf) {
+ lua_pushnumber(L, (lua_Number) buf->received);
+ lua_pushnumber(L, (lua_Number) buf->sent);
+ lua_pushnumber(L, timeout_gettime() - buf->birthday);
+ return 3;
+}
+
+/*-------------------------------------------------------------------------*\
+* object:setstats() interface
+\*-------------------------------------------------------------------------*/
+int buffer_meth_setstats(lua_State *L, p_buffer buf) {
+ buf->received = (long) luaL_optnumber(L, 2, (lua_Number) buf->received);
+ buf->sent = (long) luaL_optnumber(L, 3, (lua_Number) buf->sent);
+ if (lua_isnumber(L, 4)) buf->birthday = timeout_gettime() - lua_tonumber(L, 4);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* object:send() interface
+\*-------------------------------------------------------------------------*/
+int buffer_meth_send(lua_State *L, p_buffer buf) {
+ int top = lua_gettop(L);
+ int err = IO_DONE;
+ size_t size = 0, sent = 0;
+ const char *data = luaL_checklstring(L, 2, &size);
+ long start = (long) luaL_optnumber(L, 3, 1);
+ long end = (long) luaL_optnumber(L, 4, -1);
+ timeout_markstart(buf->tm);
+ if (start < 0) start = (long) (size+start+1);
+ if (end < 0) end = (long) (size+end+1);
+ if (start < 1) start = (long) 1;
+ if (end > (long) size) end = (long) size;
+ if (start <= end) err = sendraw(buf, data+start-1, end-start+1, &sent);
+ /* check if there was an error */
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, buf->io->error(buf->io->ctx, err));
+ lua_pushnumber(L, (lua_Number) (sent+start-1));
+ } else {
+ lua_pushnumber(L, (lua_Number) (sent+start-1));
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+#ifdef LUASOCKET_DEBUG
+ /* push time elapsed during operation as the last return value */
+ lua_pushnumber(L, timeout_gettime() - timeout_getstart(buf->tm));
+#endif
+ return lua_gettop(L) - top;
+}
+
+/*-------------------------------------------------------------------------*\
+* object:receive() interface
+\*-------------------------------------------------------------------------*/
+int buffer_meth_receive(lua_State *L, p_buffer buf) {
+ int err = IO_DONE, top;
+ luaL_Buffer b;
+ size_t size;
+ const char *part = luaL_optlstring(L, 3, "", &size);
+ timeout_markstart(buf->tm);
+ /* make sure we don't confuse buffer stuff with arguments */
+ lua_settop(L, 3);
+ top = lua_gettop(L);
+ /* initialize buffer with optional extra prefix
+ * (useful for concatenating previous partial results) */
+ luaL_buffinit(L, &b);
+ luaL_addlstring(&b, part, size);
+ /* receive new patterns */
+ if (!lua_isnumber(L, 2)) {
+ const char *p= luaL_optstring(L, 2, "*l");
+ if (p[0] == '*' && p[1] == 'l') err = recvline(buf, &b);
+ else if (p[0] == '*' && p[1] == 'a') err = recvall(buf, &b);
+ else luaL_argcheck(L, 0, 2, "invalid receive pattern");
+ /* get a fixed number of bytes (minus what was already partially
+ * received) */
+ } else {
+ double n = lua_tonumber(L, 2);
+ size_t wanted = (size_t) n;
+ luaL_argcheck(L, n >= 0, 2, "invalid receive pattern");
+ if (size == 0 || wanted > size)
+ err = recvraw(buf, wanted-size, &b);
+ }
+ /* check if there was an error */
+ if (err != IO_DONE) {
+ /* we can't push anyting in the stack before pushing the
+ * contents of the buffer. this is the reason for the complication */
+ luaL_pushresult(&b);
+ lua_pushstring(L, buf->io->error(buf->io->ctx, err));
+ lua_pushvalue(L, -2);
+ lua_pushnil(L);
+ lua_replace(L, -4);
+ } else {
+ luaL_pushresult(&b);
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+#ifdef LUASOCKET_DEBUG
+ /* push time elapsed during operation as the last return value */
+ lua_pushnumber(L, timeout_gettime() - timeout_getstart(buf->tm));
+#endif
+ return lua_gettop(L) - top;
+}
+
+/*-------------------------------------------------------------------------*\
+* Determines if there is any data in the read buffer
+\*-------------------------------------------------------------------------*/
+int buffer_isempty(p_buffer buf) {
+ return buf->first >= buf->last;
+}
+
+/*=========================================================================*\
+* Internal functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Sends a block of data (unbuffered)
+\*-------------------------------------------------------------------------*/
+#define STEPSIZE 8192
+static int sendraw(p_buffer buf, const char *data, size_t count, size_t *sent) {
+ p_io io = buf->io;
+ p_timeout tm = buf->tm;
+ size_t total = 0;
+ int err = IO_DONE;
+ while (total < count && err == IO_DONE) {
+ size_t done = 0;
+ size_t step = (count-total <= STEPSIZE)? count-total: STEPSIZE;
+ err = io->send(io->ctx, data+total, step, &done, tm);
+ total += done;
+ }
+ *sent = total;
+ buf->sent += total;
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Reads a fixed number of bytes (buffered)
+\*-------------------------------------------------------------------------*/
+static int recvraw(p_buffer buf, size_t wanted, luaL_Buffer *b) {
+ int err = IO_DONE;
+ size_t total = 0;
+ while (err == IO_DONE) {
+ size_t count; const char *data;
+ err = buffer_get(buf, &data, &count);
+ count = MIN(count, wanted - total);
+ luaL_addlstring(b, data, count);
+ buffer_skip(buf, count);
+ total += count;
+ if (total >= wanted) break;
+ }
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Reads everything until the connection is closed (buffered)
+\*-------------------------------------------------------------------------*/
+static int recvall(p_buffer buf, luaL_Buffer *b) {
+ int err = IO_DONE;
+ size_t total = 0;
+ while (err == IO_DONE) {
+ const char *data; size_t count;
+ err = buffer_get(buf, &data, &count);
+ total += count;
+ luaL_addlstring(b, data, count);
+ buffer_skip(buf, count);
+ }
+ if (err == IO_CLOSED) {
+ if (total > 0) return IO_DONE;
+ else return IO_CLOSED;
+ } else return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Reads a line terminated by a CR LF pair or just by a LF. The CR and LF
+* are not returned by the function and are discarded from the buffer
+\*-------------------------------------------------------------------------*/
+static int recvline(p_buffer buf, luaL_Buffer *b) {
+ int err = IO_DONE;
+ while (err == IO_DONE) {
+ size_t count, pos; const char *data;
+ err = buffer_get(buf, &data, &count);
+ pos = 0;
+ while (pos < count && data[pos] != '\n') {
+ /* we ignore all \r's */
+ if (data[pos] != '\r') luaL_addchar(b, data[pos]);
+ pos++;
+ }
+ if (pos < count) { /* found '\n' */
+ buffer_skip(buf, pos+1); /* skip '\n' too */
+ break; /* we are done */
+ } else /* reached the end of the buffer */
+ buffer_skip(buf, pos);
+ }
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Skips a given number of bytes from read buffer. No data is read from the
+* transport layer
+\*-------------------------------------------------------------------------*/
+static void buffer_skip(p_buffer buf, size_t count) {
+ buf->received += count;
+ buf->first += count;
+ if (buffer_isempty(buf))
+ buf->first = buf->last = 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Return any data available in buffer, or get more data from transport layer
+* if buffer is empty
+\*-------------------------------------------------------------------------*/
+static int buffer_get(p_buffer buf, const char **data, size_t *count) {
+ int err = IO_DONE;
+ p_io io = buf->io;
+ p_timeout tm = buf->tm;
+ if (buffer_isempty(buf)) {
+ size_t got;
+ err = io->recv(io->ctx, buf->data, BUF_SIZE, &got, tm);
+ buf->first = 0;
+ buf->last = got;
+ }
+ *count = buf->last - buf->first;
+ *data = buf->data + buf->first;
+ return err;
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/buffer.h b/source/luametatex/source/luacore/luasocket/src/buffer.h
new file mode 100644
index 000000000..a0901fcc8
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/buffer.h
@@ -0,0 +1,52 @@
+#ifndef BUF_H
+#define BUF_H
+/*=========================================================================*\
+* Input/Output interface for Lua programs
+* LuaSocket toolkit
+*
+* Line patterns require buffering. Reading one character at a time involves
+* too many system calls and is very slow. This module implements the
+* LuaSocket interface for input/output on connected objects, as seen by
+* Lua programs.
+*
+* Input is buffered. Output is *not* buffered because there was no simple
+* way of making sure the buffered output data would ever be sent.
+*
+* The module is built on top of the I/O abstraction defined in io.h and the
+* timeout management is done with the timeout.h interface.
+\*=========================================================================*/
+#include "luasocket.h"
+#include "io.h"
+#include "timeout.h"
+
+/* buffer size in bytes */
+#define BUF_SIZE 8192
+
+/* buffer control structure */
+typedef struct t_buffer_ {
+ double birthday; /* throttle support info: creation time, */
+ size_t sent, received; /* bytes sent, and bytes received */
+ p_io io; /* IO driver used for this buffer */
+ p_timeout tm; /* timeout management for this buffer */
+ size_t first, last; /* index of first and last bytes of stored data */
+ char data[BUF_SIZE]; /* storage space for buffer data */
+} t_buffer;
+typedef t_buffer *p_buffer;
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int buffer_open(lua_State *L);
+void buffer_init(p_buffer buf, p_io io, p_timeout tm);
+int buffer_meth_getstats(lua_State *L, p_buffer buf);
+int buffer_meth_setstats(lua_State *L, p_buffer buf);
+int buffer_meth_send(lua_State *L, p_buffer buf);
+int buffer_meth_receive(lua_State *L, p_buffer buf);
+int buffer_isempty(p_buffer buf);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* BUF_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/compat.c b/source/luametatex/source/luacore/luasocket/src/compat.c
new file mode 100644
index 000000000..34ffdaf71
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/compat.c
@@ -0,0 +1,39 @@
+#include "luasocket.h"
+#include "compat.h"
+
+#if LUA_VERSION_NUM==501
+
+/*
+** Adapted from Lua 5.2
+*/
+void luasocket_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
+ luaL_checkstack(L, nup+1, "too many upvalues");
+ for (; l->name != NULL; l++) { /* fill the table with given functions */
+ int i;
+ lua_pushstring(L, l->name);
+ for (i = 0; i < nup; i++) /* copy upvalues to the top */
+ lua_pushvalue(L, -(nup+1));
+ lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */
+ lua_settable(L, -(nup + 3));
+ }
+ lua_pop(L, nup); /* remove upvalues */
+}
+
+/*
+** Duplicated from Lua 5.2
+*/
+void *luasocket_testudata (lua_State *L, int ud, const char *tname) {
+ void *p = lua_touserdata(L, ud);
+ if (p != NULL) { /* value is a userdata? */
+ if (lua_getmetatable(L, ud)) { /* does it have a metatable? */
+ luaL_getmetatable(L, tname); /* get correct metatable */
+ if (!lua_rawequal(L, -1, -2)) /* not the same? */
+ p = NULL; /* value is a userdata with wrong metatable */
+ lua_pop(L, 2); /* remove both metatables */
+ return p;
+ }
+ }
+ return NULL; /* value is not a userdata with a metatable */
+}
+
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/compat.h b/source/luametatex/source/luacore/luasocket/src/compat.h
new file mode 100644
index 000000000..fa2d7d7c6
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/compat.h
@@ -0,0 +1,22 @@
+#ifndef COMPAT_H
+#define COMPAT_H
+
+#if LUA_VERSION_NUM==501
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+void luasocket_setfuncs (lua_State *L, const luaL_Reg *l, int nup);
+void *luasocket_testudata ( lua_State *L, int arg, const char *tname);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#define luaL_setfuncs luasocket_setfuncs
+#define luaL_testudata luasocket_testudata
+
+#endif
+
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/except.c b/source/luametatex/source/luacore/luasocket/src/except.c
new file mode 100644
index 000000000..9c3317f26
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/except.c
@@ -0,0 +1,129 @@
+/*=========================================================================*\
+* Simple exception support
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "except.h"
+#include <stdio.h>
+
+#if LUA_VERSION_NUM < 502
+#define lua_pcallk(L, na, nr, err, ctx, cont) \
+ (((void)ctx),((void)cont),lua_pcall(L, na, nr, err))
+#endif
+
+#if LUA_VERSION_NUM < 503
+typedef int lua_KContext;
+#endif
+
+/*=========================================================================*\
+* Internal function prototypes.
+\*=========================================================================*/
+static int global_protect(lua_State *L);
+static int global_newtry(lua_State *L);
+static int protected_(lua_State *L);
+static int finalize(lua_State *L);
+static int do_nothing(lua_State *L);
+
+/* except functions */
+static luaL_Reg func[] = {
+ {"newtry", global_newtry},
+ {"protect", global_protect},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Try factory
+\*-------------------------------------------------------------------------*/
+static void wrap(lua_State *L) {
+ lua_createtable(L, 1, 0);
+ lua_pushvalue(L, -2);
+ lua_rawseti(L, -2, 1);
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_setmetatable(L, -2);
+}
+
+static int finalize(lua_State *L) {
+ if (!lua_toboolean(L, 1)) {
+ lua_pushvalue(L, lua_upvalueindex(2));
+ lua_call(L, 0, 0);
+ lua_settop(L, 2);
+ wrap(L);
+ lua_error(L);
+ return 0;
+ } else return lua_gettop(L);
+}
+
+static int do_nothing(lua_State *L) {
+ (void) L;
+ return 0;
+}
+
+static int global_newtry(lua_State *L) {
+ lua_settop(L, 1);
+ if (lua_isnil(L, 1)) lua_pushcfunction(L, do_nothing);
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_insert(L, -2);
+ lua_pushcclosure(L, finalize, 2);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Protect factory
+\*-------------------------------------------------------------------------*/
+static int unwrap(lua_State *L) {
+ if (lua_istable(L, -1) && lua_getmetatable(L, -1)) {
+ int r = lua_rawequal(L, -1, lua_upvalueindex(1));
+ lua_pop(L, 1);
+ if (r) {
+ lua_pushnil(L);
+ lua_rawgeti(L, -2, 1);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int protected_finish(lua_State *L, int status, lua_KContext ctx) {
+ (void)ctx;
+ if (status != 0 && status != LUA_YIELD) {
+ if (unwrap(L)) return 2;
+ else return lua_error(L);
+ } else return lua_gettop(L);
+}
+
+#if LUA_VERSION_NUM == 502
+static int protected_cont(lua_State *L) {
+ int ctx = 0;
+ int status = lua_getctx(L, &ctx);
+ return protected_finish(L, status, ctx);
+}
+#else
+#define protected_cont protected_finish
+#endif
+
+static int protected_(lua_State *L) {
+ int status;
+ lua_pushvalue(L, lua_upvalueindex(2));
+ lua_insert(L, 1);
+ status = lua_pcallk(L, lua_gettop(L) - 1, LUA_MULTRET, 0, 0, protected_cont);
+ return protected_finish(L, status, 0);
+}
+
+static int global_protect(lua_State *L) {
+ lua_settop(L, 1);
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_insert(L, 1);
+ lua_pushcclosure(L, protected_, 2);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Init module
+\*-------------------------------------------------------------------------*/
+int except_open(lua_State *L) {
+ lua_newtable(L); /* metatable for wrapped exceptions */
+ lua_pushboolean(L, 0);
+ lua_setfield(L, -2, "__metatable");
+ luaL_setfuncs(L, func, 1);
+ return 0;
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/except.h b/source/luametatex/source/luacore/luasocket/src/except.h
new file mode 100644
index 000000000..71c31fd4d
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/except.h
@@ -0,0 +1,46 @@
+#ifndef EXCEPT_H
+#define EXCEPT_H
+/*=========================================================================*\
+* Exception control
+* LuaSocket toolkit (but completely independent from other modules)
+*
+* This provides support for simple exceptions in Lua. During the
+* development of the HTTP/FTP/SMTP support, it became aparent that
+* error checking was taking a substantial amount of the coding. These
+* function greatly simplify the task of checking errors.
+*
+* The main idea is that functions should return nil as their first return
+* values when they find an error, and return an error message (or value)
+* following nil. In case of success, as long as the first value is not nil,
+* the other values don't matter.
+*
+* The idea is to nest function calls with the "try" function. This function
+* checks the first value, and, if it's falsy, wraps the second value in a
+* table with metatable and calls "error" on it. Otherwise, it returns all
+* values it received. Basically, it works like the Lua "assert" function,
+* but it creates errors targeted specifically at "protect".
+*
+* The "newtry" function is a factory for "try" functions that call a
+* finalizer in protected mode before calling "error".
+*
+* The "protect" function returns a new function that behaves exactly like
+* the function it receives, but the new function catches exceptions thrown
+* by "try" functions and returns nil followed by the error message instead.
+*
+* With these three functions, it's easy to write functions that throw
+* exceptions on error, but that don't interrupt the user script.
+\*=========================================================================*/
+
+#include "luasocket.h"
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int except_open(lua_State *L);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/inet.c b/source/luametatex/source/luacore/luasocket/src/inet.c
new file mode 100644
index 000000000..ec73feadc
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/inet.c
@@ -0,0 +1,537 @@
+/*=========================================================================*\
+* Internet domain functions
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "inet.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+/*=========================================================================*\
+* Internal function prototypes.
+\*=========================================================================*/
+static int inet_global_toip(lua_State *L);
+static int inet_global_getaddrinfo(lua_State *L);
+static int inet_global_tohostname(lua_State *L);
+static int inet_global_getnameinfo(lua_State *L);
+static void inet_pushresolved(lua_State *L, struct hostent *hp);
+static int inet_global_gethostname(lua_State *L);
+
+/* DNS functions */
+static luaL_Reg func[] = {
+ { "toip", inet_global_toip},
+ { "getaddrinfo", inet_global_getaddrinfo},
+ { "tohostname", inet_global_tohostname},
+ { "getnameinfo", inet_global_getnameinfo},
+ { "gethostname", inet_global_gethostname},
+ { NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int inet_open(lua_State *L)
+{
+ lua_pushstring(L, "dns");
+ lua_newtable(L);
+ luaL_setfuncs(L, func, 0);
+ lua_settable(L, -3);
+ return 0;
+}
+
+/*=========================================================================*\
+* Global Lua functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Returns all information provided by the resolver given a host name
+* or ip address
+\*-------------------------------------------------------------------------*/
+static int inet_gethost(const char *address, struct hostent **hp) {
+ struct in_addr addr;
+ if (inet_aton(address, &addr))
+ return socket_gethostbyaddr((char *) &addr, sizeof(addr), hp);
+ else
+ return socket_gethostbyname(address, hp);
+}
+
+/*-------------------------------------------------------------------------*\
+* Returns all information provided by the resolver given a host name
+* or ip address
+\*-------------------------------------------------------------------------*/
+static int inet_global_tohostname(lua_State *L) {
+ const char *address = luaL_checkstring(L, 1);
+ struct hostent *hp = NULL;
+ int err = inet_gethost(address, &hp);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_hoststrerror(err));
+ return 2;
+ }
+ lua_pushstring(L, hp->h_name);
+ inet_pushresolved(L, hp);
+ return 2;
+}
+
+static int inet_global_getnameinfo(lua_State *L) {
+ char hbuf[NI_MAXHOST];
+ char sbuf[NI_MAXSERV];
+ int i, ret;
+ struct addrinfo hints;
+ struct addrinfo *resolved, *iter;
+ const char *host = luaL_optstring(L, 1, NULL);
+ const char *serv = luaL_optstring(L, 2, NULL);
+
+ if (!(host || serv))
+ luaL_error(L, "host and serv cannot be both nil");
+
+ memset(&hints, 0, sizeof(hints));
+ hints.ai_socktype = SOCK_STREAM;
+ hints.ai_family = AF_UNSPEC;
+
+ ret = getaddrinfo(host, serv, &hints, &resolved);
+ if (ret != 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_gaistrerror(ret));
+ return 2;
+ }
+
+ lua_newtable(L);
+ for (i = 1, iter = resolved; iter; i++, iter = iter->ai_next) {
+ getnameinfo(iter->ai_addr, (socklen_t) iter->ai_addrlen,
+ hbuf, host? (socklen_t) sizeof(hbuf): 0,
+ sbuf, serv? (socklen_t) sizeof(sbuf): 0, 0);
+ if (host) {
+ lua_pushnumber(L, i);
+ lua_pushstring(L, hbuf);
+ lua_settable(L, -3);
+ }
+ }
+ freeaddrinfo(resolved);
+
+ if (serv) {
+ lua_pushstring(L, sbuf);
+ return 2;
+ } else {
+ return 1;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Returns all information provided by the resolver given a host name
+* or ip address
+\*-------------------------------------------------------------------------*/
+static int inet_global_toip(lua_State *L)
+{
+ const char *address = luaL_checkstring(L, 1);
+ struct hostent *hp = NULL;
+ int err = inet_gethost(address, &hp);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_hoststrerror(err));
+ return 2;
+ }
+ lua_pushstring(L, inet_ntoa(*((struct in_addr *) hp->h_addr)));
+ inet_pushresolved(L, hp);
+ return 2;
+}
+
+int inet_optfamily(lua_State* L, int narg, const char* def)
+{
+ static const char* optname[] = { "unspec", "inet", "inet6", NULL };
+ static int optvalue[] = { AF_UNSPEC, AF_INET, AF_INET6, 0 };
+
+ return optvalue[luaL_checkoption(L, narg, def, optname)];
+}
+
+int inet_optsocktype(lua_State* L, int narg, const char* def)
+{
+ static const char* optname[] = { "stream", "dgram", NULL };
+ static int optvalue[] = { SOCK_STREAM, SOCK_DGRAM, 0 };
+
+ return optvalue[luaL_checkoption(L, narg, def, optname)];
+}
+
+static int inet_global_getaddrinfo(lua_State *L)
+{
+ const char *hostname = luaL_checkstring(L, 1);
+ struct addrinfo *iterator = NULL, *resolved = NULL;
+ struct addrinfo hints;
+ int i = 1, ret = 0;
+ memset(&hints, 0, sizeof(hints));
+ hints.ai_socktype = SOCK_STREAM;
+ hints.ai_family = AF_UNSPEC;
+ ret = getaddrinfo(hostname, NULL, &hints, &resolved);
+ if (ret != 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_gaistrerror(ret));
+ return 2;
+ }
+ lua_newtable(L);
+ for (iterator = resolved; iterator; iterator = iterator->ai_next) {
+ char hbuf[NI_MAXHOST];
+ ret = getnameinfo(iterator->ai_addr, (socklen_t) iterator->ai_addrlen,
+ hbuf, (socklen_t) sizeof(hbuf), NULL, 0, NI_NUMERICHOST);
+ if (ret){
+ freeaddrinfo(resolved);
+ lua_pushnil(L);
+ lua_pushstring(L, socket_gaistrerror(ret));
+ return 2;
+ }
+ lua_pushnumber(L, i);
+ lua_newtable(L);
+ switch (iterator->ai_family) {
+ case AF_INET:
+ lua_pushliteral(L, "family");
+ lua_pushliteral(L, "inet");
+ lua_settable(L, -3);
+ break;
+ case AF_INET6:
+ lua_pushliteral(L, "family");
+ lua_pushliteral(L, "inet6");
+ lua_settable(L, -3);
+ break;
+ case AF_UNSPEC:
+ lua_pushliteral(L, "family");
+ lua_pushliteral(L, "unspec");
+ lua_settable(L, -3);
+ break;
+ default:
+ lua_pushliteral(L, "family");
+ lua_pushliteral(L, "unknown");
+ lua_settable(L, -3);
+ break;
+ }
+ lua_pushliteral(L, "addr");
+ lua_pushstring(L, hbuf);
+ lua_settable(L, -3);
+ lua_settable(L, -3);
+ i++;
+ }
+ freeaddrinfo(resolved);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Gets the host name
+\*-------------------------------------------------------------------------*/
+static int inet_global_gethostname(lua_State *L)
+{
+ char name[257];
+ name[256] = '\0';
+ if (gethostname(name, 256) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(errno));
+ return 2;
+ } else {
+ lua_pushstring(L, name);
+ return 1;
+ }
+}
+
+/*=========================================================================*\
+* Lua methods
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Retrieves socket peer name
+\*-------------------------------------------------------------------------*/
+int inet_meth_getpeername(lua_State *L, p_socket ps, int family)
+{
+ int err;
+ struct sockaddr_storage peer;
+ socklen_t peer_len = sizeof(peer);
+ char name[INET6_ADDRSTRLEN];
+ char port[6]; /* 65535 = 5 bytes + 0 to terminate it */
+ if (getpeername(*ps, (SA *) &peer, &peer_len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(errno));
+ return 2;
+ }
+ err = getnameinfo((struct sockaddr *) &peer, peer_len,
+ name, INET6_ADDRSTRLEN,
+ port, sizeof(port), NI_NUMERICHOST | NI_NUMERICSERV);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, gai_strerror(err));
+ return 2;
+ }
+ lua_pushstring(L, name);
+ lua_pushinteger(L, (int) strtol(port, (char **) NULL, 10));
+ switch (family) {
+ case AF_INET: lua_pushliteral(L, "inet"); break;
+ case AF_INET6: lua_pushliteral(L, "inet6"); break;
+ case AF_UNSPEC: lua_pushliteral(L, "unspec"); break;
+ default: lua_pushliteral(L, "unknown"); break;
+ }
+ return 3;
+}
+
+/*-------------------------------------------------------------------------*\
+* Retrieves socket local name
+\*-------------------------------------------------------------------------*/
+int inet_meth_getsockname(lua_State *L, p_socket ps, int family)
+{
+ int err;
+ struct sockaddr_storage peer;
+ socklen_t peer_len = sizeof(peer);
+ char name[INET6_ADDRSTRLEN];
+ char port[6]; /* 65535 = 5 bytes + 0 to terminate it */
+ if (getsockname(*ps, (SA *) &peer, &peer_len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(errno));
+ return 2;
+ }
+ err=getnameinfo((struct sockaddr *)&peer, peer_len,
+ name, INET6_ADDRSTRLEN, port, 6, NI_NUMERICHOST | NI_NUMERICSERV);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, gai_strerror(err));
+ return 2;
+ }
+ lua_pushstring(L, name);
+ lua_pushstring(L, port);
+ switch (family) {
+ case AF_INET: lua_pushliteral(L, "inet"); break;
+ case AF_INET6: lua_pushliteral(L, "inet6"); break;
+ case AF_UNSPEC: lua_pushliteral(L, "unspec"); break;
+ default: lua_pushliteral(L, "unknown"); break;
+ }
+ return 3;
+}
+
+/*=========================================================================*\
+* Internal functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Passes all resolver information to Lua as a table
+\*-------------------------------------------------------------------------*/
+static void inet_pushresolved(lua_State *L, struct hostent *hp)
+{
+ char **alias;
+ struct in_addr **addr;
+ int i, resolved;
+ lua_newtable(L); resolved = lua_gettop(L);
+ lua_pushstring(L, "name");
+ lua_pushstring(L, hp->h_name);
+ lua_settable(L, resolved);
+ lua_pushstring(L, "ip");
+ lua_pushstring(L, "alias");
+ i = 1;
+ alias = hp->h_aliases;
+ lua_newtable(L);
+ if (alias) {
+ while (*alias) {
+ lua_pushnumber(L, i);
+ lua_pushstring(L, *alias);
+ lua_settable(L, -3);
+ i++; alias++;
+ }
+ }
+ lua_settable(L, resolved);
+ i = 1;
+ lua_newtable(L);
+ addr = (struct in_addr **) hp->h_addr_list;
+ if (addr) {
+ while (*addr) {
+ lua_pushnumber(L, i);
+ lua_pushstring(L, inet_ntoa(**addr));
+ lua_settable(L, -3);
+ i++; addr++;
+ }
+ }
+ lua_settable(L, resolved);
+}
+
+/*-------------------------------------------------------------------------*\
+* Tries to create a new inet socket
+\*-------------------------------------------------------------------------*/
+const char *inet_trycreate(p_socket ps, int family, int type, int protocol) {
+ const char *err = socket_strerror(socket_create(ps, family, type, protocol));
+ if (err == NULL && family == AF_INET6) {
+ int yes = 1;
+ setsockopt(*ps, IPPROTO_IPV6, IPV6_V6ONLY, (void *)&yes, sizeof(yes));
+ }
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* "Disconnects" a DGRAM socket
+\*-------------------------------------------------------------------------*/
+const char *inet_trydisconnect(p_socket ps, int family, p_timeout tm)
+{
+ switch (family) {
+ case AF_INET: {
+ struct sockaddr_in sin;
+ memset((char *) &sin, 0, sizeof(sin));
+ sin.sin_family = AF_UNSPEC;
+ sin.sin_addr.s_addr = INADDR_ANY;
+ return socket_strerror(socket_connect(ps, (SA *) &sin,
+ sizeof(sin), tm));
+ }
+ case AF_INET6: {
+ struct sockaddr_in6 sin6;
+ struct in6_addr addrany = IN6ADDR_ANY_INIT;
+ memset((char *) &sin6, 0, sizeof(sin6));
+ sin6.sin6_family = AF_UNSPEC;
+ sin6.sin6_addr = addrany;
+ return socket_strerror(socket_connect(ps, (SA *) &sin6,
+ sizeof(sin6), tm));
+ }
+ }
+ return NULL;
+}
+
+/*-------------------------------------------------------------------------*\
+* Tries to connect to remote address (address, port)
+\*-------------------------------------------------------------------------*/
+const char *inet_tryconnect(p_socket ps, int *family, const char *address,
+ const char *serv, p_timeout tm, struct addrinfo *connecthints)
+{
+ struct addrinfo *iterator = NULL, *resolved = NULL;
+ const char *err = NULL;
+ int current_family = *family;
+ /* try resolving */
+ err = socket_gaistrerror(getaddrinfo(address, serv,
+ connecthints, &resolved));
+ if (err != NULL) {
+ if (resolved) freeaddrinfo(resolved);
+ return err;
+ }
+ for (iterator = resolved; iterator; iterator = iterator->ai_next) {
+ timeout_markstart(tm);
+ /* create new socket if necessary. if there was no
+ * bind, we need to create one for every new family
+ * that shows up while iterating. if there was a
+ * bind, all families will be the same and we will
+ * not enter this branch. */
+ if (current_family != iterator->ai_family || *ps == SOCKET_INVALID) {
+ socket_destroy(ps);
+ err = inet_trycreate(ps, iterator->ai_family,
+ iterator->ai_socktype, iterator->ai_protocol);
+ if (err) continue;
+ current_family = iterator->ai_family;
+ /* set non-blocking before connect */
+ socket_setnonblocking(ps);
+ }
+ /* try connecting to remote address */
+ err = socket_strerror(socket_connect(ps, (SA *) iterator->ai_addr,
+ (socklen_t) iterator->ai_addrlen, tm));
+ /* if success or timeout is zero, break out of loop */
+ if (err == NULL || timeout_iszero(tm)) {
+ *family = current_family;
+ break;
+ }
+ }
+ freeaddrinfo(resolved);
+ /* here, if err is set, we failed */
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Tries to accept a socket
+\*-------------------------------------------------------------------------*/
+const char *inet_tryaccept(p_socket server, int family, p_socket client,
+ p_timeout tm) {
+ socklen_t len;
+ t_sockaddr_storage addr;
+ switch (family) {
+ case AF_INET6: len = sizeof(struct sockaddr_in6); break;
+ case AF_INET: len = sizeof(struct sockaddr_in); break;
+ default: len = sizeof(addr); break;
+ }
+ return socket_strerror(socket_accept(server, client, (SA *) &addr,
+ &len, tm));
+}
+
+/*-------------------------------------------------------------------------*\
+* Tries to bind socket to (address, port)
+\*-------------------------------------------------------------------------*/
+const char *inet_trybind(p_socket ps, int *family, const char *address,
+ const char *serv, struct addrinfo *bindhints) {
+ struct addrinfo *iterator = NULL, *resolved = NULL;
+ const char *err = NULL;
+ int current_family = *family;
+ /* translate luasocket special values to C */
+ if (strcmp(address, "*") == 0) address = NULL;
+ if (!serv) serv = "0";
+ /* try resolving */
+ err = socket_gaistrerror(getaddrinfo(address, serv, bindhints, &resolved));
+ if (err) {
+ if (resolved) freeaddrinfo(resolved);
+ return err;
+ }
+ /* iterate over resolved addresses until one is good */
+ for (iterator = resolved; iterator; iterator = iterator->ai_next) {
+ if (current_family != iterator->ai_family || *ps == SOCKET_INVALID) {
+ socket_destroy(ps);
+ err = inet_trycreate(ps, iterator->ai_family,
+ iterator->ai_socktype, iterator->ai_protocol);
+ if (err) continue;
+ current_family = iterator->ai_family;
+ }
+ /* try binding to local address */
+ err = socket_strerror(socket_bind(ps, (SA *) iterator->ai_addr,
+ (socklen_t) iterator->ai_addrlen));
+ /* keep trying unless bind succeeded */
+ if (err == NULL) {
+ *family = current_family;
+ /* set to non-blocking after bind */
+ socket_setnonblocking(ps);
+ break;
+ }
+ }
+ /* cleanup and return error */
+ freeaddrinfo(resolved);
+ /* here, if err is set, we failed */
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Some systems do not provide these so that we provide our own.
+\*-------------------------------------------------------------------------*/
+#ifdef LUASOCKET_INET_ATON
+int inet_aton(const char *cp, struct in_addr *inp)
+{
+ unsigned int a = 0, b = 0, c = 0, d = 0;
+ int n = 0, r;
+ unsigned long int addr = 0;
+ r = sscanf(cp, "%u.%u.%u.%u%n", &a, &b, &c, &d, &n);
+ if (r == 0 || n == 0) return 0;
+ cp += n;
+ if (*cp) return 0;
+ if (a > 255 || b > 255 || c > 255 || d > 255) return 0;
+ if (inp) {
+ addr += a; addr <<= 8;
+ addr += b; addr <<= 8;
+ addr += c; addr <<= 8;
+ addr += d;
+ inp->s_addr = htonl(addr);
+ }
+ return 1;
+}
+#endif
+
+#ifdef LUASOCKET_INET_PTON
+int inet_pton(int af, const char *src, void *dst)
+{
+ struct addrinfo hints, *res;
+ int ret = 1;
+ memset(&hints, 0, sizeof(struct addrinfo));
+ hints.ai_family = af;
+ hints.ai_flags = AI_NUMERICHOST;
+ if (getaddrinfo(src, NULL, &hints, &res) != 0) return -1;
+ if (af == AF_INET) {
+ struct sockaddr_in *in = (struct sockaddr_in *) res->ai_addr;
+ memcpy(dst, &in->sin_addr, sizeof(in->sin_addr));
+ } else if (af == AF_INET6) {
+ struct sockaddr_in6 *in = (struct sockaddr_in6 *) res->ai_addr;
+ memcpy(dst, &in->sin6_addr, sizeof(in->sin6_addr));
+ } else {
+ ret = -1;
+ }
+ freeaddrinfo(res);
+ return ret;
+}
+
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/inet.h b/source/luametatex/source/luacore/luasocket/src/inet.h
new file mode 100644
index 000000000..5618b61b3
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/inet.h
@@ -0,0 +1,56 @@
+#ifndef INET_H
+#define INET_H
+/*=========================================================================*\
+* Internet domain functions
+* LuaSocket toolkit
+*
+* This module implements the creation and connection of internet domain
+* sockets, on top of the socket.h interface, and the interface of with the
+* resolver.
+*
+* The function inet_aton is provided for the platforms where it is not
+* available. The module also implements the interface of the internet
+* getpeername and getsockname functions as seen by Lua programs.
+*
+* The Lua functions toip and tohostname are also implemented here.
+\*=========================================================================*/
+#include "luasocket.h"
+#include "socket.h"
+#include "timeout.h"
+
+#ifdef _WIN32
+#define LUASOCKET_INET_ATON
+#endif
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int inet_open(lua_State *L);
+
+int inet_optfamily(lua_State* L, int narg, const char* def);
+int inet_optsocktype(lua_State* L, int narg, const char* def);
+
+int inet_meth_getpeername(lua_State *L, p_socket ps, int family);
+int inet_meth_getsockname(lua_State *L, p_socket ps, int family);
+
+const char *inet_trycreate(p_socket ps, int family, int type, int protocol);
+const char *inet_trydisconnect(p_socket ps, int family, p_timeout tm);
+const char *inet_tryconnect(p_socket ps, int *family, const char *address, const char *serv, p_timeout tm, struct addrinfo *connecthints);
+const char *inet_tryaccept(p_socket server, int family, p_socket client, p_timeout tm);
+const char *inet_trybind(p_socket ps, int *family, const char *address, const char *serv, struct addrinfo *bindhints);
+
+#ifdef LUASOCKET_INET_ATON
+int inet_aton(const char *cp, struct in_addr *inp);
+#endif
+
+#ifdef LUASOCKET_INET_PTON
+const char *inet_ntop(int af, const void *src, char *dst, socklen_t cnt);
+int inet_pton(int af, const char *src, void *dst);
+#endif
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* INET_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/io.c b/source/luametatex/source/luacore/luasocket/src/io.c
new file mode 100644
index 000000000..5ad4b3afc
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/io.c
@@ -0,0 +1,28 @@
+/*=========================================================================*\
+* Input/Output abstraction
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "io.h"
+
+/*-------------------------------------------------------------------------*\
+* Initializes C structure
+\*-------------------------------------------------------------------------*/
+void io_init(p_io io, p_send send, p_recv recv, p_error error, void *ctx) {
+ io->send = send;
+ io->recv = recv;
+ io->error = error;
+ io->ctx = ctx;
+}
+
+/*-------------------------------------------------------------------------*\
+* I/O error strings
+\*-------------------------------------------------------------------------*/
+const char *io_strerror(int err) {
+ switch (err) {
+ case IO_DONE: return NULL;
+ case IO_CLOSED: return "closed";
+ case IO_TIMEOUT: return "timeout";
+ default: return "unknown error";
+ }
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/io.h b/source/luametatex/source/luacore/luasocket/src/io.h
new file mode 100644
index 000000000..b8a54df6e
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/io.h
@@ -0,0 +1,70 @@
+#ifndef IO_H
+#define IO_H
+/*=========================================================================*\
+* Input/Output abstraction
+* LuaSocket toolkit
+*
+* This module defines the interface that LuaSocket expects from the
+* transport layer for streamed input/output. The idea is that if any
+* transport implements this interface, then the buffer.c functions
+* automatically work on it.
+*
+* The module socket.h implements this interface, and thus the module tcp.h
+* is very simple.
+\*=========================================================================*/
+#include "luasocket.h"
+#include "timeout.h"
+
+/* IO error codes */
+enum {
+ IO_DONE = 0, /* operation completed successfully */
+ IO_TIMEOUT = -1, /* operation timed out */
+ IO_CLOSED = -2, /* the connection has been closed */
+ IO_UNKNOWN = -3
+};
+
+/* interface to error message function */
+typedef const char *(*p_error) (
+ void *ctx, /* context needed by send */
+ int err /* error code */
+);
+
+/* interface to send function */
+typedef int (*p_send) (
+ void *ctx, /* context needed by send */
+ const char *data, /* pointer to buffer with data to send */
+ size_t count, /* number of bytes to send from buffer */
+ size_t *sent, /* number of bytes sent uppon return */
+ p_timeout tm /* timeout control */
+);
+
+/* interface to recv function */
+typedef int (*p_recv) (
+ void *ctx, /* context needed by recv */
+ char *data, /* pointer to buffer where data will be writen */
+ size_t count, /* number of bytes to receive into buffer */
+ size_t *got, /* number of bytes received uppon return */
+ p_timeout tm /* timeout control */
+);
+
+/* IO driver definition */
+typedef struct t_io_ {
+ void *ctx; /* context needed by send/recv */
+ p_send send; /* send function pointer */
+ p_recv recv; /* receive function pointer */
+ p_error error; /* strerror function */
+} t_io;
+typedef t_io *p_io;
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+void io_init(p_io io, p_send send, p_recv recv, p_error error, void *ctx);
+const char *io_strerror(int err);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* IO_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/luasocket.c b/source/luametatex/source/luacore/luasocket/src/luasocket.c
new file mode 100644
index 000000000..0fd99f703
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/luasocket.c
@@ -0,0 +1,104 @@
+/*=========================================================================*\
+* LuaSocket toolkit
+* Networking support for the Lua language
+* Diego Nehab
+* 26/11/1999
+*
+* This library is part of an effort to progressively increase the network
+* connectivity of the Lua language. The Lua interface to networking
+* functions follows the Sockets API closely, trying to simplify all tasks
+* involved in setting up both client and server connections. The provided
+* IO routines, however, follow the Lua style, being very similar to the
+* standard Lua read and write functions.
+\*=========================================================================*/
+
+#include "luasocket.h"
+#include "auxiliar.h"
+#include "except.h"
+#include "timeout.h"
+#include "buffer.h"
+#include "inet.h"
+#include "tcp.h"
+#include "udp.h"
+#include "select.h"
+
+/*-------------------------------------------------------------------------*\
+* Internal function prototypes
+\*-------------------------------------------------------------------------*/
+static int global_skip(lua_State *L);
+static int global_unload(lua_State *L);
+static int base_open(lua_State *L);
+
+/*-------------------------------------------------------------------------*\
+* Modules and functions
+\*-------------------------------------------------------------------------*/
+static const luaL_Reg mod[] = {
+ {"auxiliar", auxiliar_open},
+ {"except", except_open},
+ {"timeout", timeout_open},
+ {"buffer", buffer_open},
+ {"inet", inet_open},
+ {"tcp", tcp_open},
+ {"udp", udp_open},
+ {"select", select_open},
+ {NULL, NULL}
+};
+
+static luaL_Reg func[] = {
+ {"skip", global_skip},
+ {"__unload", global_unload},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Skip a few arguments
+\*-------------------------------------------------------------------------*/
+static int global_skip(lua_State *L) {
+ int amount = (int) luaL_checkinteger(L, 1);
+ int ret = lua_gettop(L) - amount - 1;
+ return ret >= 0 ? ret : 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Unloads the library
+\*-------------------------------------------------------------------------*/
+static int global_unload(lua_State *L) {
+ (void) L;
+ socket_close();
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Setup basic stuff.
+\*-------------------------------------------------------------------------*/
+static int base_open(lua_State *L) {
+ if (socket_open()) {
+ /* export functions (and leave namespace table on top of stack) */
+ lua_newtable(L);
+ luaL_setfuncs(L, func, 0);
+#ifdef LUASOCKET_DEBUG
+ lua_pushstring(L, "_DEBUG");
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+#endif
+ /* make version string available to scripts */
+ lua_pushstring(L, "_VERSION");
+ lua_pushstring(L, LUASOCKET_VERSION);
+ lua_rawset(L, -3);
+ return 1;
+ } else {
+ lua_pushstring(L, "unable to initialize library");
+ lua_error(L);
+ return 0;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Initializes all library modules.
+\*-------------------------------------------------------------------------*/
+LUASOCKET_API int luaopen_socket_core(lua_State *L) {
+ int i;
+ base_open(L);
+ for (i = 0; mod[i].name; i++) mod[i].func(L);
+ return 1;
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/luasocket.h b/source/luametatex/source/luacore/luasocket/src/luasocket.h
new file mode 100644
index 000000000..d22b1bead
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/luasocket.h
@@ -0,0 +1,36 @@
+#ifndef LUASOCKET_H
+#define LUASOCKET_H
+/*=========================================================================*\
+* LuaSocket toolkit
+* Networking support for the Lua language
+* Diego Nehab
+* 9/11/1999
+\*=========================================================================*/
+
+/*-------------------------------------------------------------------------* \
+* Current socket library version
+\*-------------------------------------------------------------------------*/
+#define LUASOCKET_VERSION "LuaSocket 3.0-rc1"
+#define LUASOCKET_COPYRIGHT "Copyright (C) 1999-2013 Diego Nehab"
+
+/*-------------------------------------------------------------------------*\
+* This macro prefixes all exported API functions
+\*-------------------------------------------------------------------------*/
+#ifndef LUASOCKET_API
+#ifdef _WIN32
+#define LUASOCKET_API __declspec(dllexport)
+#else
+#define LUASOCKET_API __attribute__ ((visibility ("default")))
+#endif
+#endif
+
+#include "lua.h"
+#include "lauxlib.h"
+#include "compat.h"
+
+/*-------------------------------------------------------------------------*\
+* Initializes the library.
+\*-------------------------------------------------------------------------*/
+LUASOCKET_API int luaopen_socket_core(lua_State *L);
+
+#endif /* LUASOCKET_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/mime.c b/source/luametatex/source/luacore/luasocket/src/mime.c
new file mode 100644
index 000000000..05602f566
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/mime.c
@@ -0,0 +1,852 @@
+/*=========================================================================*\
+* MIME support functions
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "mime.h"
+#include <string.h>
+#include <ctype.h>
+
+/*=========================================================================*\
+* Don't want to trust escape character constants
+\*=========================================================================*/
+typedef unsigned char UC;
+static const char CRLF[] = "\r\n";
+static const char EQCRLF[] = "=\r\n";
+
+/*=========================================================================*\
+* Internal function prototypes.
+\*=========================================================================*/
+static int mime_global_wrp(lua_State *L);
+static int mime_global_b64(lua_State *L);
+static int mime_global_unb64(lua_State *L);
+static int mime_global_qp(lua_State *L);
+static int mime_global_unqp(lua_State *L);
+static int mime_global_qpwrp(lua_State *L);
+static int mime_global_eol(lua_State *L);
+static int mime_global_dot(lua_State *L);
+
+static size_t dot(int c, size_t state, luaL_Buffer *buffer);
+/*static void b64setup(UC *base);*/
+static size_t b64encode(UC c, UC *input, size_t size, luaL_Buffer *buffer);
+static size_t b64pad(const UC *input, size_t size, luaL_Buffer *buffer);
+static size_t b64decode(UC c, UC *input, size_t size, luaL_Buffer *buffer);
+
+/*static void qpsetup(UC *class, UC *unbase);*/
+static void qpquote(UC c, luaL_Buffer *buffer);
+static size_t qpdecode(UC c, UC *input, size_t size, luaL_Buffer *buffer);
+static size_t qpencode(UC c, UC *input, size_t size,
+ const char *marker, luaL_Buffer *buffer);
+static size_t qppad(UC *input, size_t size, luaL_Buffer *buffer);
+
+/* code support functions */
+static luaL_Reg func[] = {
+ { "dot", mime_global_dot },
+ { "b64", mime_global_b64 },
+ { "eol", mime_global_eol },
+ { "qp", mime_global_qp },
+ { "qpwrp", mime_global_qpwrp },
+ { "unb64", mime_global_unb64 },
+ { "unqp", mime_global_unqp },
+ { "wrp", mime_global_wrp },
+ { NULL, NULL }
+};
+
+/*-------------------------------------------------------------------------*\
+* Quoted-printable globals
+\*-------------------------------------------------------------------------*/
+enum {QP_PLAIN, QP_QUOTED, QP_CR, QP_IF_LAST};
+
+static const UC qpclass[] = {
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_IF_LAST, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_CR, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_IF_LAST, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_QUOTED, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN, QP_PLAIN,
+ QP_PLAIN, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED,
+ QP_QUOTED, QP_QUOTED, QP_QUOTED, QP_QUOTED
+};
+
+static const UC qpbase[] = "0123456789ABCDEF";
+
+static const UC qpunbase[] = {
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 255,
+ 255, 255, 255, 255, 255, 255, 10, 11, 12, 13, 14, 15,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 10, 11, 12, 13, 14, 15, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255
+};
+
+/*-------------------------------------------------------------------------*\
+* Base64 globals
+\*-------------------------------------------------------------------------*/
+static const UC b64base[] =
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+static const UC b64unbase[] = {
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 62, 255, 255, 255, 63,
+ 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 255, 255, 255, 0,
+ 255, 255, 255, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 255, 255,
+ 255, 255, 255, 255, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
+ 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
+ 51, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255
+};
+
+/*=========================================================================*\
+* Exported functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+LUASOCKET_API int luaopen_mime_core(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, func, 0);
+ /* make version string available to scripts */
+ lua_pushstring(L, "_VERSION");
+ lua_pushstring(L, MIME_VERSION);
+ lua_rawset(L, -3);
+ /* initialize lookup tables */
+ /*qpsetup(qpclass, qpunbase);*/
+ /*b64setup(b64unbase);*/
+ return 1;
+}
+
+/*=========================================================================*\
+* Global Lua functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Incrementaly breaks a string into lines. The string can have CRLF breaks.
+* A, n = wrp(l, B, length)
+* A is a copy of B, broken into lines of at most 'length' bytes.
+* 'l' is how many bytes are left for the first line of B.
+* 'n' is the number of bytes left in the last line of A.
+\*-------------------------------------------------------------------------*/
+static int mime_global_wrp(lua_State *L)
+{
+ size_t size = 0;
+ int left = (int) luaL_checknumber(L, 1);
+ const UC *input = (const UC *) luaL_optlstring(L, 2, NULL, &size);
+ const UC *last = input + size;
+ int length = (int) luaL_optnumber(L, 3, 76);
+ luaL_Buffer buffer;
+ /* end of input black-hole */
+ if (!input) {
+ /* if last line has not been terminated, add a line break */
+ if (left < length) lua_pushstring(L, CRLF);
+ /* otherwise, we are done */
+ else lua_pushnil(L);
+ lua_pushnumber(L, length);
+ return 2;
+ }
+ luaL_buffinit(L, &buffer);
+ while (input < last) {
+ switch (*input) {
+ case '\r':
+ break;
+ case '\n':
+ luaL_addstring(&buffer, CRLF);
+ left = length;
+ break;
+ default:
+ if (left <= 0) {
+ left = length;
+ luaL_addstring(&buffer, CRLF);
+ }
+ luaL_addchar(&buffer, *input);
+ left--;
+ break;
+ }
+ input++;
+ }
+ luaL_pushresult(&buffer);
+ lua_pushnumber(L, left);
+ return 2;
+}
+
+#if 0
+/*-------------------------------------------------------------------------*\
+* Fill base64 decode map.
+\*-------------------------------------------------------------------------*/
+static void b64setup(UC *unbase)
+{
+ int i;
+ for (i = 0; i <= 255; i++) unbase[i] = (UC) 255;
+ for (i = 0; i < 64; i++) unbase[b64base[i]] = (UC) i;
+ unbase['='] = 0;
+
+ printf("static const UC b64unbase[] = {\n");
+ for (int i = 0; i < 256; i++) {
+ printf("%d, ", unbase[i]);
+ }
+ printf("\n}\n;");
+}
+#endif
+
+/*-------------------------------------------------------------------------*\
+* Acumulates bytes in input buffer until 3 bytes are available.
+* Translate the 3 bytes into Base64 form and append to buffer.
+* Returns new number of bytes in buffer.
+\*-------------------------------------------------------------------------*/
+static size_t b64encode(UC c, UC *input, size_t size,
+ luaL_Buffer *buffer)
+{
+ input[size++] = c;
+ if (size == 3) {
+ UC code[4];
+ unsigned long value = 0;
+ value += input[0]; value <<= 8;
+ value += input[1]; value <<= 8;
+ value += input[2];
+ code[3] = b64base[value & 0x3f]; value >>= 6;
+ code[2] = b64base[value & 0x3f]; value >>= 6;
+ code[1] = b64base[value & 0x3f]; value >>= 6;
+ code[0] = b64base[value];
+ luaL_addlstring(buffer, (char *) code, 4);
+ size = 0;
+ }
+ return size;
+}
+
+/*-------------------------------------------------------------------------*\
+* Encodes the Base64 last 1 or 2 bytes and adds padding '='
+* Result, if any, is appended to buffer.
+* Returns 0.
+\*-------------------------------------------------------------------------*/
+static size_t b64pad(const UC *input, size_t size,
+ luaL_Buffer *buffer)
+{
+ unsigned long value = 0;
+ UC code[4] = {'=', '=', '=', '='};
+ switch (size) {
+ case 1:
+ value = input[0] << 4;
+ code[1] = b64base[value & 0x3f]; value >>= 6;
+ code[0] = b64base[value];
+ luaL_addlstring(buffer, (char *) code, 4);
+ break;
+ case 2:
+ value = input[0]; value <<= 8;
+ value |= input[1]; value <<= 2;
+ code[2] = b64base[value & 0x3f]; value >>= 6;
+ code[1] = b64base[value & 0x3f]; value >>= 6;
+ code[0] = b64base[value];
+ luaL_addlstring(buffer, (char *) code, 4);
+ break;
+ default:
+ break;
+ }
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Acumulates bytes in input buffer until 4 bytes are available.
+* Translate the 4 bytes from Base64 form and append to buffer.
+* Returns new number of bytes in buffer.
+\*-------------------------------------------------------------------------*/
+static size_t b64decode(UC c, UC *input, size_t size,
+ luaL_Buffer *buffer)
+{
+ /* ignore invalid characters */
+ if (b64unbase[c] > 64) return size;
+ input[size++] = c;
+ /* decode atom */
+ if (size == 4) {
+ UC decoded[3];
+ int valid, value = 0;
+ value = b64unbase[input[0]]; value <<= 6;
+ value |= b64unbase[input[1]]; value <<= 6;
+ value |= b64unbase[input[2]]; value <<= 6;
+ value |= b64unbase[input[3]];
+ decoded[2] = (UC) (value & 0xff); value >>= 8;
+ decoded[1] = (UC) (value & 0xff); value >>= 8;
+ decoded[0] = (UC) value;
+ /* take care of paddding */
+ valid = (input[2] == '=') ? 1 : (input[3] == '=') ? 2 : 3;
+ luaL_addlstring(buffer, (char *) decoded, valid);
+ return 0;
+ /* need more data */
+ } else return size;
+}
+
+/*-------------------------------------------------------------------------*\
+* Incrementally applies the Base64 transfer content encoding to a string
+* A, B = b64(C, D)
+* A is the encoded version of the largest prefix of C .. D that is
+* divisible by 3. B has the remaining bytes of C .. D, *without* encoding.
+* The easiest thing would be to concatenate the two strings and
+* encode the result, but we can't afford that or Lua would dupplicate
+* every chunk we received.
+\*-------------------------------------------------------------------------*/
+static int mime_global_b64(lua_State *L)
+{
+ UC atom[3];
+ size_t isize = 0, asize = 0;
+ const UC *input = (const UC *) luaL_optlstring(L, 1, NULL, &isize);
+ const UC *last = input + isize;
+ luaL_Buffer buffer;
+ /* end-of-input blackhole */
+ if (!input) {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* make sure we don't confuse buffer stuff with arguments */
+ lua_settop(L, 2);
+ /* process first part of the input */
+ luaL_buffinit(L, &buffer);
+ while (input < last)
+ asize = b64encode(*input++, atom, asize, &buffer);
+ input = (const UC *) luaL_optlstring(L, 2, NULL, &isize);
+ /* if second part is nil, we are done */
+ if (!input) {
+ size_t osize = 0;
+ asize = b64pad(atom, asize, &buffer);
+ luaL_pushresult(&buffer);
+ /* if the output is empty and the input is nil, return nil */
+ lua_tolstring(L, -1, &osize);
+ if (osize == 0) lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* otherwise process the second part */
+ last = input + isize;
+ while (input < last)
+ asize = b64encode(*input++, atom, asize, &buffer);
+ luaL_pushresult(&buffer);
+ lua_pushlstring(L, (char *) atom, asize);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Incrementally removes the Base64 transfer content encoding from a string
+* A, B = b64(C, D)
+* A is the encoded version of the largest prefix of C .. D that is
+* divisible by 4. B has the remaining bytes of C .. D, *without* encoding.
+\*-------------------------------------------------------------------------*/
+static int mime_global_unb64(lua_State *L)
+{
+ UC atom[4];
+ size_t isize = 0, asize = 0;
+ const UC *input = (const UC *) luaL_optlstring(L, 1, NULL, &isize);
+ const UC *last = input + isize;
+ luaL_Buffer buffer;
+ /* end-of-input blackhole */
+ if (!input) {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* make sure we don't confuse buffer stuff with arguments */
+ lua_settop(L, 2);
+ /* process first part of the input */
+ luaL_buffinit(L, &buffer);
+ while (input < last)
+ asize = b64decode(*input++, atom, asize, &buffer);
+ input = (const UC *) luaL_optlstring(L, 2, NULL, &isize);
+ /* if second is nil, we are done */
+ if (!input) {
+ size_t osize = 0;
+ luaL_pushresult(&buffer);
+ /* if the output is empty and the input is nil, return nil */
+ lua_tolstring(L, -1, &osize);
+ if (osize == 0) lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* otherwise, process the rest of the input */
+ last = input + isize;
+ while (input < last)
+ asize = b64decode(*input++, atom, asize, &buffer);
+ luaL_pushresult(&buffer);
+ lua_pushlstring(L, (char *) atom, asize);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Quoted-printable encoding scheme
+* all (except CRLF in text) can be =XX
+* CLRL in not text must be =XX=XX
+* 33 through 60 inclusive can be plain
+* 62 through 126 inclusive can be plain
+* 9 and 32 can be plain, unless in the end of a line, where must be =XX
+* encoded lines must be no longer than 76 not counting CRLF
+* soft line-break are =CRLF
+* To encode one byte, we need to see the next two.
+* Worst case is when we see a space, and wonder if a CRLF is comming
+\*-------------------------------------------------------------------------*/
+#if 0
+/*-------------------------------------------------------------------------*\
+* Split quoted-printable characters into classes
+* Precompute reverse map for encoding
+\*-------------------------------------------------------------------------*/
+static void qpsetup(UC *cl, UC *unbase)
+{
+
+ int i;
+ for (i = 0; i < 256; i++) cl[i] = QP_QUOTED;
+ for (i = 33; i <= 60; i++) cl[i] = QP_PLAIN;
+ for (i = 62; i <= 126; i++) cl[i] = QP_PLAIN;
+ cl['\t'] = QP_IF_LAST;
+ cl[' '] = QP_IF_LAST;
+ cl['\r'] = QP_CR;
+ for (i = 0; i < 256; i++) unbase[i] = 255;
+ unbase['0'] = 0; unbase['1'] = 1; unbase['2'] = 2;
+ unbase['3'] = 3; unbase['4'] = 4; unbase['5'] = 5;
+ unbase['6'] = 6; unbase['7'] = 7; unbase['8'] = 8;
+ unbase['9'] = 9; unbase['A'] = 10; unbase['a'] = 10;
+ unbase['B'] = 11; unbase['b'] = 11; unbase['C'] = 12;
+ unbase['c'] = 12; unbase['D'] = 13; unbase['d'] = 13;
+ unbase['E'] = 14; unbase['e'] = 14; unbase['F'] = 15;
+ unbase['f'] = 15;
+
+printf("static UC qpclass[] = {");
+ for (int i = 0; i < 256; i++) {
+ if (i % 6 == 0) {
+ printf("\n ");
+ }
+ switch(cl[i]) {
+ case QP_QUOTED:
+ printf("QP_QUOTED, ");
+ break;
+ case QP_PLAIN:
+ printf("QP_PLAIN, ");
+ break;
+ case QP_CR:
+ printf("QP_CR, ");
+ break;
+ case QP_IF_LAST:
+ printf("QP_IF_LAST, ");
+ break;
+ }
+ }
+printf("\n};\n");
+
+printf("static const UC qpunbase[] = {");
+ for (int i = 0; i < 256; i++) {
+ int c = qpunbase[i];
+ printf("%d, ", c);
+ }
+printf("\";\n");
+}
+#endif
+
+/*-------------------------------------------------------------------------*\
+* Output one character in form =XX
+\*-------------------------------------------------------------------------*/
+static void qpquote(UC c, luaL_Buffer *buffer)
+{
+ luaL_addchar(buffer, '=');
+ luaL_addchar(buffer, qpbase[c >> 4]);
+ luaL_addchar(buffer, qpbase[c & 0x0F]);
+}
+
+/*-------------------------------------------------------------------------*\
+* Accumulate characters until we are sure about how to deal with them.
+* Once we are sure, output to the buffer, in the correct form.
+\*-------------------------------------------------------------------------*/
+static size_t qpencode(UC c, UC *input, size_t size,
+ const char *marker, luaL_Buffer *buffer)
+{
+ input[size++] = c;
+ /* deal with all characters we can have */
+ while (size > 0) {
+ switch (qpclass[input[0]]) {
+ /* might be the CR of a CRLF sequence */
+ case QP_CR:
+ if (size < 2) return size;
+ if (input[1] == '\n') {
+ luaL_addstring(buffer, marker);
+ return 0;
+ } else qpquote(input[0], buffer);
+ break;
+ /* might be a space and that has to be quoted if last in line */
+ case QP_IF_LAST:
+ if (size < 3) return size;
+ /* if it is the last, quote it and we are done */
+ if (input[1] == '\r' && input[2] == '\n') {
+ qpquote(input[0], buffer);
+ luaL_addstring(buffer, marker);
+ return 0;
+ } else luaL_addchar(buffer, input[0]);
+ break;
+ /* might have to be quoted always */
+ case QP_QUOTED:
+ qpquote(input[0], buffer);
+ break;
+ /* might never have to be quoted */
+ default:
+ luaL_addchar(buffer, input[0]);
+ break;
+ }
+ input[0] = input[1]; input[1] = input[2];
+ size--;
+ }
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Deal with the final characters
+\*-------------------------------------------------------------------------*/
+static size_t qppad(UC *input, size_t size, luaL_Buffer *buffer)
+{
+ size_t i;
+ for (i = 0; i < size; i++) {
+ if (qpclass[input[i]] == QP_PLAIN) luaL_addchar(buffer, input[i]);
+ else qpquote(input[i], buffer);
+ }
+ if (size > 0) luaL_addstring(buffer, EQCRLF);
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Incrementally converts a string to quoted-printable
+* A, B = qp(C, D, marker)
+* Marker is the text to be used to replace CRLF sequences found in A.
+* A is the encoded version of the largest prefix of C .. D that
+* can be encoded without doubts.
+* B has the remaining bytes of C .. D, *without* encoding.
+\*-------------------------------------------------------------------------*/
+static int mime_global_qp(lua_State *L)
+{
+ size_t asize = 0, isize = 0;
+ UC atom[3];
+ const UC *input = (const UC *) luaL_optlstring(L, 1, NULL, &isize);
+ const UC *last = input + isize;
+ const char *marker = luaL_optstring(L, 3, CRLF);
+ luaL_Buffer buffer;
+ /* end-of-input blackhole */
+ if (!input) {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* make sure we don't confuse buffer stuff with arguments */
+ lua_settop(L, 3);
+ /* process first part of input */
+ luaL_buffinit(L, &buffer);
+ while (input < last)
+ asize = qpencode(*input++, atom, asize, marker, &buffer);
+ input = (const UC *) luaL_optlstring(L, 2, NULL, &isize);
+ /* if second part is nil, we are done */
+ if (!input) {
+ asize = qppad(atom, asize, &buffer);
+ luaL_pushresult(&buffer);
+ if (!(*lua_tostring(L, -1))) lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* otherwise process rest of input */
+ last = input + isize;
+ while (input < last)
+ asize = qpencode(*input++, atom, asize, marker, &buffer);
+ luaL_pushresult(&buffer);
+ lua_pushlstring(L, (char *) atom, asize);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Accumulate characters until we are sure about how to deal with them.
+* Once we are sure, output the to the buffer, in the correct form.
+\*-------------------------------------------------------------------------*/
+static size_t qpdecode(UC c, UC *input, size_t size, luaL_Buffer *buffer) {
+ int d;
+ input[size++] = c;
+ /* deal with all characters we can deal */
+ switch (input[0]) {
+ /* if we have an escape character */
+ case '=':
+ if (size < 3) return size;
+ /* eliminate soft line break */
+ if (input[1] == '\r' && input[2] == '\n') return 0;
+ /* decode quoted representation */
+ c = qpunbase[input[1]]; d = qpunbase[input[2]];
+ /* if it is an invalid, do not decode */
+ if (c > 15 || d > 15) luaL_addlstring(buffer, (char *)input, 3);
+ else luaL_addchar(buffer, (char) ((c << 4) + d));
+ return 0;
+ case '\r':
+ if (size < 2) return size;
+ if (input[1] == '\n') luaL_addlstring(buffer, (char *)input, 2);
+ return 0;
+ default:
+ if (input[0] == '\t' || (input[0] > 31 && input[0] < 127))
+ luaL_addchar(buffer, input[0]);
+ return 0;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Incrementally decodes a string in quoted-printable
+* A, B = qp(C, D)
+* A is the decoded version of the largest prefix of C .. D that
+* can be decoded without doubts.
+* B has the remaining bytes of C .. D, *without* decoding.
+\*-------------------------------------------------------------------------*/
+static int mime_global_unqp(lua_State *L)
+{
+ size_t asize = 0, isize = 0;
+ UC atom[3];
+ const UC *input = (const UC *) luaL_optlstring(L, 1, NULL, &isize);
+ const UC *last = input + isize;
+ luaL_Buffer buffer;
+ /* end-of-input blackhole */
+ if (!input) {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* make sure we don't confuse buffer stuff with arguments */
+ lua_settop(L, 2);
+ /* process first part of input */
+ luaL_buffinit(L, &buffer);
+ while (input < last)
+ asize = qpdecode(*input++, atom, asize, &buffer);
+ input = (const UC *) luaL_optlstring(L, 2, NULL, &isize);
+ /* if second part is nil, we are done */
+ if (!input) {
+ luaL_pushresult(&buffer);
+ if (!(*lua_tostring(L, -1))) lua_pushnil(L);
+ lua_pushnil(L);
+ return 2;
+ }
+ /* otherwise process rest of input */
+ last = input + isize;
+ while (input < last)
+ asize = qpdecode(*input++, atom, asize, &buffer);
+ luaL_pushresult(&buffer);
+ lua_pushlstring(L, (char *) atom, asize);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Incrementally breaks a quoted-printed string into lines
+* A, n = qpwrp(l, B, length)
+* A is a copy of B, broken into lines of at most 'length' bytes.
+* 'l' is how many bytes are left for the first line of B.
+* 'n' is the number of bytes left in the last line of A.
+* There are two complications: lines can't be broken in the middle
+* of an encoded =XX, and there might be line breaks already
+\*-------------------------------------------------------------------------*/
+static int mime_global_qpwrp(lua_State *L)
+{
+ size_t size = 0;
+ int left = (int) luaL_checknumber(L, 1);
+ const UC *input = (const UC *) luaL_optlstring(L, 2, NULL, &size);
+ const UC *last = input + size;
+ int length = (int) luaL_optnumber(L, 3, 76);
+ luaL_Buffer buffer;
+ /* end-of-input blackhole */
+ if (!input) {
+ if (left < length) lua_pushstring(L, EQCRLF);
+ else lua_pushnil(L);
+ lua_pushnumber(L, length);
+ return 2;
+ }
+ /* process all input */
+ luaL_buffinit(L, &buffer);
+ while (input < last) {
+ switch (*input) {
+ case '\r':
+ break;
+ case '\n':
+ left = length;
+ luaL_addstring(&buffer, CRLF);
+ break;
+ case '=':
+ if (left <= 3) {
+ left = length;
+ luaL_addstring(&buffer, EQCRLF);
+ }
+ luaL_addchar(&buffer, *input);
+ left--;
+ break;
+ default:
+ if (left <= 1) {
+ left = length;
+ luaL_addstring(&buffer, EQCRLF);
+ }
+ luaL_addchar(&buffer, *input);
+ left--;
+ break;
+ }
+ input++;
+ }
+ luaL_pushresult(&buffer);
+ lua_pushnumber(L, left);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Here is what we do: \n, and \r are considered candidates for line
+* break. We issue *one* new line marker if any of them is seen alone, or
+* followed by a different one. That is, \n\n and \r\r will issue two
+* end of line markers each, but \r\n, \n\r etc will only issue *one*
+* marker. This covers Mac OS, Mac OS X, VMS, Unix and DOS, as well as
+* probably other more obscure conventions.
+*
+* c is the current character being processed
+* last is the previous character
+\*-------------------------------------------------------------------------*/
+#define eolcandidate(c) (c == '\r' || c == '\n')
+static int eolprocess(int c, int last, const char *marker,
+ luaL_Buffer *buffer)
+{
+ if (eolcandidate(c)) {
+ if (eolcandidate(last)) {
+ if (c == last) luaL_addstring(buffer, marker);
+ return 0;
+ } else {
+ luaL_addstring(buffer, marker);
+ return c;
+ }
+ } else {
+ luaL_addchar(buffer, (char) c);
+ return 0;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Converts a string to uniform EOL convention.
+* A, n = eol(o, B, marker)
+* A is the converted version of the largest prefix of B that can be
+* converted unambiguously. 'o' is the context returned by the previous
+* call. 'n' is the new context.
+\*-------------------------------------------------------------------------*/
+static int mime_global_eol(lua_State *L)
+{
+ int ctx = (int) luaL_checkinteger(L, 1);
+ size_t isize = 0;
+ const char *input = luaL_optlstring(L, 2, NULL, &isize);
+ const char *last = input + isize;
+ const char *marker = luaL_optstring(L, 3, CRLF);
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ /* end of input blackhole */
+ if (!input) {
+ lua_pushnil(L);
+ lua_pushnumber(L, 0);
+ return 2;
+ }
+ /* process all input */
+ while (input < last)
+ ctx = eolprocess(*input++, ctx, marker, &buffer);
+ luaL_pushresult(&buffer);
+ lua_pushnumber(L, ctx);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Takes one byte and stuff it if needed.
+\*-------------------------------------------------------------------------*/
+static size_t dot(int c, size_t state, luaL_Buffer *buffer)
+{
+ luaL_addchar(buffer, (char) c);
+ switch (c) {
+ case '\r':
+ return 1;
+ case '\n':
+ return (state == 1)? 2: 0;
+ case '.':
+ if (state == 2)
+ luaL_addchar(buffer, '.');
+ /* Falls through. */
+ default:
+ return 0;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Incrementally applies smtp stuffing to a string
+* A, n = dot(l, D)
+\*-------------------------------------------------------------------------*/
+static int mime_global_dot(lua_State *L)
+{
+ size_t isize = 0, state = (size_t) luaL_checknumber(L, 1);
+ const char *input = luaL_optlstring(L, 2, NULL, &isize);
+ const char *last = input + isize;
+ luaL_Buffer buffer;
+ /* end-of-input blackhole */
+ if (!input) {
+ lua_pushnil(L);
+ lua_pushnumber(L, 2);
+ return 2;
+ }
+ /* process all input */
+ luaL_buffinit(L, &buffer);
+ while (input < last)
+ state = dot(*input++, state, &buffer);
+ luaL_pushresult(&buffer);
+ lua_pushnumber(L, (lua_Number) state);
+ return 2;
+}
+
diff --git a/source/luametatex/source/luacore/luasocket/src/mime.h b/source/luametatex/source/luacore/luasocket/src/mime.h
new file mode 100644
index 000000000..4d938f46e
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/mime.h
@@ -0,0 +1,22 @@
+#ifndef MIME_H
+#define MIME_H
+/*=========================================================================*\
+* Core MIME support
+* LuaSocket toolkit
+*
+* This module provides functions to implement transfer content encodings
+* and formatting conforming to RFC 2045. It is used by mime.lua, which
+* provide a higher level interface to this functionality.
+\*=========================================================================*/
+#include "luasocket.h"
+
+/*-------------------------------------------------------------------------*\
+* Current MIME library version
+\*-------------------------------------------------------------------------*/
+#define MIME_VERSION "MIME 1.0.3"
+#define MIME_COPYRIGHT "Copyright (C) 2004-2013 Diego Nehab"
+#define MIME_AUTHORS "Diego Nehab"
+
+LUASOCKET_API int luaopen_mime_core(lua_State *L);
+
+#endif /* MIME_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/options.c b/source/luametatex/source/luacore/luasocket/src/options.c
new file mode 100644
index 000000000..2b53c67b7
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/options.c
@@ -0,0 +1,455 @@
+/*=========================================================================*\
+* Common option interface
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+#include "auxiliar.h"
+#include "options.h"
+#include "inet.h"
+#include <string.h>
+
+/*=========================================================================*\
+* Internal functions prototypes
+\*=========================================================================*/
+static int opt_setmembership(lua_State *L, p_socket ps, int level, int name);
+static int opt_ip6_setmembership(lua_State *L, p_socket ps, int level, int name);
+static int opt_setboolean(lua_State *L, p_socket ps, int level, int name);
+static int opt_getboolean(lua_State *L, p_socket ps, int level, int name);
+static int opt_setint(lua_State *L, p_socket ps, int level, int name);
+static int opt_getint(lua_State *L, p_socket ps, int level, int name);
+static int opt_set(lua_State *L, p_socket ps, int level, int name,
+ void *val, int len);
+static int opt_get(lua_State *L, p_socket ps, int level, int name,
+ void *val, int* len);
+
+/*=========================================================================*\
+* Exported functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Calls appropriate option handler
+\*-------------------------------------------------------------------------*/
+int opt_meth_setoption(lua_State *L, p_opt opt, p_socket ps)
+{
+ const char *name = luaL_checkstring(L, 2); /* obj, name, ... */
+ while (opt->name && strcmp(name, opt->name))
+ opt++;
+ if (!opt->func) {
+ char msg[57];
+ sprintf(msg, "unsupported option `%.35s'", name);
+ luaL_argerror(L, 2, msg);
+ }
+ return opt->func(L, ps);
+}
+
+int opt_meth_getoption(lua_State *L, p_opt opt, p_socket ps)
+{
+ const char *name = luaL_checkstring(L, 2); /* obj, name, ... */
+ while (opt->name && strcmp(name, opt->name))
+ opt++;
+ if (!opt->func) {
+ char msg[57];
+ sprintf(msg, "unsupported option `%.35s'", name);
+ luaL_argerror(L, 2, msg);
+ }
+ return opt->func(L, ps);
+}
+
+/*------------------------------------------------------*/
+/* enables reuse of local address */
+int opt_set_reuseaddr(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, SOL_SOCKET, SO_REUSEADDR);
+}
+
+int opt_get_reuseaddr(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, SOL_SOCKET, SO_REUSEADDR);
+}
+
+/*------------------------------------------------------*/
+/* enables reuse of local port */
+int opt_set_reuseport(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, SOL_SOCKET, SO_REUSEPORT);
+}
+
+int opt_get_reuseport(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, SOL_SOCKET, SO_REUSEPORT);
+}
+
+/*------------------------------------------------------*/
+/* disables the Nagle algorithm */
+int opt_set_tcp_nodelay(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, IPPROTO_TCP, TCP_NODELAY);
+}
+
+int opt_get_tcp_nodelay(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, IPPROTO_TCP, TCP_NODELAY);
+}
+
+/*------------------------------------------------------*/
+#ifdef TCP_KEEPIDLE
+
+int opt_get_tcp_keepidle(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, IPPROTO_TCP, TCP_KEEPIDLE);
+}
+
+int opt_set_tcp_keepidle(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, IPPROTO_TCP, TCP_KEEPIDLE);
+}
+
+#endif
+
+/*------------------------------------------------------*/
+#ifdef TCP_KEEPCNT
+
+int opt_get_tcp_keepcnt(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, IPPROTO_TCP, TCP_KEEPCNT);
+}
+
+int opt_set_tcp_keepcnt(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, IPPROTO_TCP, TCP_KEEPCNT);
+}
+
+#endif
+
+/*------------------------------------------------------*/
+#ifdef TCP_KEEPINTVL
+
+int opt_get_tcp_keepintvl(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, IPPROTO_TCP, TCP_KEEPINTVL);
+}
+
+int opt_set_tcp_keepintvl(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, IPPROTO_TCP, TCP_KEEPINTVL);
+}
+
+#endif
+
+/*------------------------------------------------------*/
+int opt_set_keepalive(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, SOL_SOCKET, SO_KEEPALIVE);
+}
+
+int opt_get_keepalive(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, SOL_SOCKET, SO_KEEPALIVE);
+}
+
+/*------------------------------------------------------*/
+int opt_set_dontroute(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, SOL_SOCKET, SO_DONTROUTE);
+}
+
+int opt_get_dontroute(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, SOL_SOCKET, SO_DONTROUTE);
+}
+
+/*------------------------------------------------------*/
+int opt_set_broadcast(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, SOL_SOCKET, SO_BROADCAST);
+}
+
+int opt_get_broadcast(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, SOL_SOCKET, SO_BROADCAST);
+}
+
+/*------------------------------------------------------*/
+int opt_set_recv_buf_size(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, SOL_SOCKET, SO_RCVBUF);
+}
+
+int opt_get_recv_buf_size(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, SOL_SOCKET, SO_RCVBUF);
+}
+
+/*------------------------------------------------------*/
+int opt_get_send_buf_size(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, SOL_SOCKET, SO_SNDBUF);
+}
+
+int opt_set_send_buf_size(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, SOL_SOCKET, SO_SNDBUF);
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip6_unicast_hops(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, IPPROTO_IPV6, IPV6_UNICAST_HOPS);
+}
+
+int opt_get_ip6_unicast_hops(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, IPPROTO_IPV6, IPV6_UNICAST_HOPS);
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip6_multicast_hops(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, IPPROTO_IPV6, IPV6_MULTICAST_HOPS);
+}
+
+int opt_get_ip6_multicast_hops(lua_State *L, p_socket ps)
+{
+ return opt_getint(L, ps, IPPROTO_IPV6, IPV6_MULTICAST_HOPS);
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip_multicast_loop(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, IPPROTO_IP, IP_MULTICAST_LOOP);
+}
+
+int opt_get_ip_multicast_loop(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, IPPROTO_IP, IP_MULTICAST_LOOP);
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip6_multicast_loop(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, IPPROTO_IPV6, IPV6_MULTICAST_LOOP);
+}
+
+int opt_get_ip6_multicast_loop(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, IPPROTO_IPV6, IPV6_MULTICAST_LOOP);
+}
+
+/*------------------------------------------------------*/
+int opt_set_linger(lua_State *L, p_socket ps)
+{
+ struct linger li; /* obj, name, table */
+ if (!lua_istable(L, 3)) auxiliar_typeerror(L,3,lua_typename(L, LUA_TTABLE));
+ lua_pushstring(L, "on");
+ lua_gettable(L, 3);
+ if (!lua_isboolean(L, -1))
+ luaL_argerror(L, 3, "boolean 'on' field expected");
+ li.l_onoff = (u_short) lua_toboolean(L, -1);
+ lua_pushstring(L, "timeout");
+ lua_gettable(L, 3);
+ if (!lua_isnumber(L, -1))
+ luaL_argerror(L, 3, "number 'timeout' field expected");
+ li.l_linger = (u_short) lua_tonumber(L, -1);
+ return opt_set(L, ps, SOL_SOCKET, SO_LINGER, (char *) &li, sizeof(li));
+}
+
+int opt_get_linger(lua_State *L, p_socket ps)
+{
+ struct linger li; /* obj, name */
+ int len = sizeof(li);
+ int err = opt_get(L, ps, SOL_SOCKET, SO_LINGER, (char *) &li, &len);
+ if (err)
+ return err;
+ lua_newtable(L);
+ lua_pushboolean(L, li.l_onoff);
+ lua_setfield(L, -2, "on");
+ lua_pushinteger(L, li.l_linger);
+ lua_setfield(L, -2, "timeout");
+ return 1;
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip_multicast_ttl(lua_State *L, p_socket ps)
+{
+ return opt_setint(L, ps, IPPROTO_IP, IP_MULTICAST_TTL);
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip_multicast_if(lua_State *L, p_socket ps)
+{
+ const char *address = luaL_checkstring(L, 3); /* obj, name, ip */
+ struct in_addr val;
+ val.s_addr = htonl(INADDR_ANY);
+ if (strcmp(address, "*") && !inet_aton(address, &val))
+ luaL_argerror(L, 3, "ip expected");
+ return opt_set(L, ps, IPPROTO_IP, IP_MULTICAST_IF,
+ (char *) &val, sizeof(val));
+}
+
+int opt_get_ip_multicast_if(lua_State *L, p_socket ps)
+{
+ struct in_addr val;
+ socklen_t len = sizeof(val);
+ if (getsockopt(*ps, IPPROTO_IP, IP_MULTICAST_IF, (char *) &val, &len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, "getsockopt failed");
+ return 2;
+ }
+ lua_pushstring(L, inet_ntoa(val));
+ return 1;
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip_add_membership(lua_State *L, p_socket ps)
+{
+ return opt_setmembership(L, ps, IPPROTO_IP, IP_ADD_MEMBERSHIP);
+}
+
+int opt_set_ip_drop_membersip(lua_State *L, p_socket ps)
+{
+ return opt_setmembership(L, ps, IPPROTO_IP, IP_DROP_MEMBERSHIP);
+}
+
+/*------------------------------------------------------*/
+int opt_set_ip6_add_membership(lua_State *L, p_socket ps)
+{
+ return opt_ip6_setmembership(L, ps, IPPROTO_IPV6, IPV6_ADD_MEMBERSHIP);
+}
+
+int opt_set_ip6_drop_membersip(lua_State *L, p_socket ps)
+{
+ return opt_ip6_setmembership(L, ps, IPPROTO_IPV6, IPV6_DROP_MEMBERSHIP);
+}
+
+/*------------------------------------------------------*/
+int opt_get_ip6_v6only(lua_State *L, p_socket ps)
+{
+ return opt_getboolean(L, ps, IPPROTO_IPV6, IPV6_V6ONLY);
+}
+
+int opt_set_ip6_v6only(lua_State *L, p_socket ps)
+{
+ return opt_setboolean(L, ps, IPPROTO_IPV6, IPV6_V6ONLY);
+}
+
+/*------------------------------------------------------*/
+int opt_get_error(lua_State *L, p_socket ps)
+{
+ int val = 0;
+ socklen_t len = sizeof(val);
+ if (getsockopt(*ps, SOL_SOCKET, SO_ERROR, (char *) &val, &len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, "getsockopt failed");
+ return 2;
+ }
+ lua_pushstring(L, socket_strerror(val));
+ return 1;
+}
+
+/*=========================================================================*\
+* Auxiliar functions
+\*=========================================================================*/
+static int opt_setmembership(lua_State *L, p_socket ps, int level, int name)
+{
+ struct ip_mreq val; /* obj, name, table */
+ if (!lua_istable(L, 3)) auxiliar_typeerror(L,3,lua_typename(L, LUA_TTABLE));
+ lua_pushstring(L, "multiaddr");
+ lua_gettable(L, 3);
+ if (!lua_isstring(L, -1))
+ luaL_argerror(L, 3, "string 'multiaddr' field expected");
+ if (!inet_aton(lua_tostring(L, -1), &val.imr_multiaddr))
+ luaL_argerror(L, 3, "invalid 'multiaddr' ip address");
+ lua_pushstring(L, "interface");
+ lua_gettable(L, 3);
+ if (!lua_isstring(L, -1))
+ luaL_argerror(L, 3, "string 'interface' field expected");
+ val.imr_interface.s_addr = htonl(INADDR_ANY);
+ if (strcmp(lua_tostring(L, -1), "*") &&
+ !inet_aton(lua_tostring(L, -1), &val.imr_interface))
+ luaL_argerror(L, 3, "invalid 'interface' ip address");
+ return opt_set(L, ps, level, name, (char *) &val, sizeof(val));
+}
+
+static int opt_ip6_setmembership(lua_State *L, p_socket ps, int level, int name)
+{
+ struct ipv6_mreq val; /* obj, opt-name, table */
+ memset(&val, 0, sizeof(val));
+ if (!lua_istable(L, 3)) auxiliar_typeerror(L,3,lua_typename(L, LUA_TTABLE));
+ lua_pushstring(L, "multiaddr");
+ lua_gettable(L, 3);
+ if (!lua_isstring(L, -1))
+ luaL_argerror(L, 3, "string 'multiaddr' field expected");
+ if (!inet_pton(AF_INET6, lua_tostring(L, -1), &val.ipv6mr_multiaddr))
+ luaL_argerror(L, 3, "invalid 'multiaddr' ip address");
+ lua_pushstring(L, "interface");
+ lua_gettable(L, 3);
+ /* By default we listen to interface on default route
+ * (sigh). However, interface= can override it. We should
+ * support either number, or name for it. Waiting for
+ * windows port of if_nametoindex */
+ if (!lua_isnil(L, -1)) {
+ if (lua_isnumber(L, -1)) {
+ val.ipv6mr_interface = (unsigned int) lua_tonumber(L, -1);
+ } else
+ luaL_argerror(L, -1, "number 'interface' field expected");
+ }
+ return opt_set(L, ps, level, name, (char *) &val, sizeof(val));
+}
+
+static
+int opt_get(lua_State *L, p_socket ps, int level, int name, void *val, int* len)
+{
+ socklen_t socklen = *len;
+ if (getsockopt(*ps, level, name, (char *) val, &socklen) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, "getsockopt failed");
+ return 2;
+ }
+ *len = socklen;
+ return 0;
+}
+
+static
+int opt_set(lua_State *L, p_socket ps, int level, int name, void *val, int len)
+{
+ if (setsockopt(*ps, level, name, (char *) val, len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, "setsockopt failed");
+ return 2;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+static int opt_getboolean(lua_State *L, p_socket ps, int level, int name)
+{
+ int val = 0;
+ int len = sizeof(val);
+ int err = opt_get(L, ps, level, name, (char *) &val, &len);
+ if (err)
+ return err;
+ lua_pushboolean(L, val);
+ return 1;
+}
+
+static int opt_setboolean(lua_State *L, p_socket ps, int level, int name)
+{
+ int val = auxiliar_checkboolean(L, 3); /* obj, name, bool */
+ return opt_set(L, ps, level, name, (char *) &val, sizeof(val));
+}
+
+static int opt_getint(lua_State *L, p_socket ps, int level, int name)
+{
+ int val = 0;
+ int len = sizeof(val);
+ int err = opt_get(L, ps, level, name, (char *) &val, &len);
+ if (err)
+ return err;
+ lua_pushnumber(L, val);
+ return 1;
+}
+
+static int opt_setint(lua_State *L, p_socket ps, int level, int name)
+{
+ int val = (int) lua_tonumber(L, 3); /* obj, name, int */
+ return opt_set(L, ps, level, name, (char *) &val, sizeof(val));
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/options.h b/source/luametatex/source/luacore/luasocket/src/options.h
new file mode 100644
index 000000000..41f733748
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/options.h
@@ -0,0 +1,102 @@
+#ifndef OPTIONS_H
+#define OPTIONS_H
+/*=========================================================================*\
+* Common option interface
+* LuaSocket toolkit
+*
+* This module provides a common interface to socket options, used mainly by
+* modules UDP and TCP.
+\*=========================================================================*/
+
+#include "luasocket.h"
+#include "socket.h"
+
+/* option registry */
+typedef struct t_opt {
+ const char *name;
+ int (*func)(lua_State *L, p_socket ps);
+} t_opt;
+typedef t_opt *p_opt;
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int opt_meth_setoption(lua_State *L, p_opt opt, p_socket ps);
+int opt_meth_getoption(lua_State *L, p_opt opt, p_socket ps);
+
+int opt_set_reuseaddr(lua_State *L, p_socket ps);
+int opt_get_reuseaddr(lua_State *L, p_socket ps);
+
+int opt_set_reuseport(lua_State *L, p_socket ps);
+int opt_get_reuseport(lua_State *L, p_socket ps);
+
+int opt_set_tcp_nodelay(lua_State *L, p_socket ps);
+int opt_get_tcp_nodelay(lua_State *L, p_socket ps);
+
+#ifdef TCP_KEEPIDLE
+int opt_set_tcp_keepidle(lua_State *L, p_socket ps);
+int opt_get_tcp_keepidle(lua_State *L, p_socket ps);
+#endif
+
+#ifdef TCP_KEEPCNT
+int opt_set_tcp_keepcnt(lua_State *L, p_socket ps);
+int opt_get_tcp_keepcnt(lua_State *L, p_socket ps);
+#endif
+
+#ifdef TCP_KEEPINTVL
+int opt_set_tcp_keepintvl(lua_State *L, p_socket ps);
+int opt_get_tcp_keepintvl(lua_State *L, p_socket ps);
+#endif
+
+int opt_set_keepalive(lua_State *L, p_socket ps);
+int opt_get_keepalive(lua_State *L, p_socket ps);
+
+int opt_set_dontroute(lua_State *L, p_socket ps);
+int opt_get_dontroute(lua_State *L, p_socket ps);
+
+int opt_set_broadcast(lua_State *L, p_socket ps);
+int opt_get_broadcast(lua_State *L, p_socket ps);
+
+int opt_set_recv_buf_size(lua_State *L, p_socket ps);
+int opt_get_recv_buf_size(lua_State *L, p_socket ps);
+
+int opt_set_send_buf_size(lua_State *L, p_socket ps);
+int opt_get_send_buf_size(lua_State *L, p_socket ps);
+
+int opt_set_ip6_unicast_hops(lua_State *L, p_socket ps);
+int opt_get_ip6_unicast_hops(lua_State *L, p_socket ps);
+
+int opt_set_ip6_multicast_hops(lua_State *L, p_socket ps);
+int opt_get_ip6_multicast_hops(lua_State *L, p_socket ps);
+
+int opt_set_ip_multicast_loop(lua_State *L, p_socket ps);
+int opt_get_ip_multicast_loop(lua_State *L, p_socket ps);
+
+int opt_set_ip6_multicast_loop(lua_State *L, p_socket ps);
+int opt_get_ip6_multicast_loop(lua_State *L, p_socket ps);
+
+int opt_set_linger(lua_State *L, p_socket ps);
+int opt_get_linger(lua_State *L, p_socket ps);
+
+int opt_set_ip_multicast_ttl(lua_State *L, p_socket ps);
+
+int opt_set_ip_multicast_if(lua_State *L, p_socket ps);
+int opt_get_ip_multicast_if(lua_State *L, p_socket ps);
+
+int opt_set_ip_add_membership(lua_State *L, p_socket ps);
+int opt_set_ip_drop_membersip(lua_State *L, p_socket ps);
+
+int opt_set_ip6_add_membership(lua_State *L, p_socket ps);
+int opt_set_ip6_drop_membersip(lua_State *L, p_socket ps);
+
+int opt_set_ip6_v6only(lua_State *L, p_socket ps);
+int opt_get_ip6_v6only(lua_State *L, p_socket ps);
+
+int opt_get_error(lua_State *L, p_socket ps);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/pierror.h b/source/luametatex/source/luacore/luasocket/src/pierror.h
new file mode 100644
index 000000000..cb773ab7f
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/pierror.h
@@ -0,0 +1,28 @@
+#ifndef PIERROR_H
+#define PIERROR_H
+/*=========================================================================*\
+* Error messages
+* Defines platform independent error messages
+\*=========================================================================*/
+
+#define PIE_HOST_NOT_FOUND "host not found"
+#define PIE_ADDRINUSE "address already in use"
+#define PIE_ISCONN "already connected"
+#define PIE_ACCESS "permission denied"
+#define PIE_CONNREFUSED "connection refused"
+#define PIE_CONNABORTED "closed"
+#define PIE_CONNRESET "closed"
+#define PIE_TIMEDOUT "timeout"
+#define PIE_AGAIN "temporary failure in name resolution"
+#define PIE_BADFLAGS "invalid value for ai_flags"
+#define PIE_BADHINTS "invalid value for hints"
+#define PIE_FAIL "non-recoverable failure in name resolution"
+#define PIE_FAMILY "ai_family not supported"
+#define PIE_MEMORY "memory allocation failure"
+#define PIE_NONAME "host or service not provided, or not known"
+#define PIE_OVERFLOW "argument buffer overflow"
+#define PIE_PROTOCOL "resolved protocol is unknown"
+#define PIE_SERVICE "service not supported for socket type"
+#define PIE_SOCKTYPE "ai_socktype not supported"
+
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/select.c b/source/luametatex/source/luacore/luasocket/src/select.c
new file mode 100644
index 000000000..bb47c4592
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/select.c
@@ -0,0 +1,214 @@
+/*=========================================================================*\
+* Select implementation
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "socket.h"
+#include "timeout.h"
+#include "select.h"
+
+#include <string.h>
+
+/*=========================================================================*\
+* Internal function prototypes.
+\*=========================================================================*/
+static t_socket getfd(lua_State *L);
+static int dirty(lua_State *L);
+static void collect_fd(lua_State *L, int tab, int itab,
+ fd_set *set, t_socket *max_fd);
+static int check_dirty(lua_State *L, int tab, int dtab, fd_set *set);
+static void return_fd(lua_State *L, fd_set *set, t_socket max_fd,
+ int itab, int tab, int start);
+static void make_assoc(lua_State *L, int tab);
+static int global_select(lua_State *L);
+
+/* functions in library namespace */
+static luaL_Reg func[] = {
+ {"select", global_select},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int select_open(lua_State *L) {
+ lua_pushstring(L, "_SETSIZE");
+ lua_pushinteger(L, FD_SETSIZE);
+ lua_rawset(L, -3);
+ lua_pushstring(L, "_SOCKETINVALID");
+ lua_pushinteger(L, SOCKET_INVALID);
+ lua_rawset(L, -3);
+ luaL_setfuncs(L, func, 0);
+ return 0;
+}
+
+/*=========================================================================*\
+* Global Lua functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Waits for a set of sockets until a condition is met or timeout.
+\*-------------------------------------------------------------------------*/
+static int global_select(lua_State *L) {
+ int rtab, wtab, itab, ret, ndirty;
+ t_socket max_fd = SOCKET_INVALID;
+ fd_set rset, wset;
+ t_timeout tm;
+ double t = luaL_optnumber(L, 3, -1);
+ FD_ZERO(&rset); FD_ZERO(&wset);
+ lua_settop(L, 3);
+ lua_newtable(L); itab = lua_gettop(L);
+ lua_newtable(L); rtab = lua_gettop(L);
+ lua_newtable(L); wtab = lua_gettop(L);
+ collect_fd(L, 1, itab, &rset, &max_fd);
+ collect_fd(L, 2, itab, &wset, &max_fd);
+ ndirty = check_dirty(L, 1, rtab, &rset);
+ t = ndirty > 0? 0.0: t;
+ timeout_init(&tm, t, -1);
+ timeout_markstart(&tm);
+ ret = socket_select(max_fd+1, &rset, &wset, NULL, &tm);
+ if (ret > 0 || ndirty > 0) {
+ return_fd(L, &rset, max_fd+1, itab, rtab, ndirty);
+ return_fd(L, &wset, max_fd+1, itab, wtab, 0);
+ make_assoc(L, rtab);
+ make_assoc(L, wtab);
+ return 2;
+ } else if (ret == 0) {
+ lua_pushstring(L, "timeout");
+ return 3;
+ } else {
+ luaL_error(L, "select failed");
+ return 3;
+ }
+}
+
+/*=========================================================================*\
+* Internal functions
+\*=========================================================================*/
+static t_socket getfd(lua_State *L) {
+ t_socket fd = SOCKET_INVALID;
+ lua_pushstring(L, "getfd");
+ lua_gettable(L, -2);
+ if (!lua_isnil(L, -1)) {
+ lua_pushvalue(L, -2);
+ lua_call(L, 1, 1);
+ if (lua_isnumber(L, -1)) {
+ double numfd = lua_tonumber(L, -1);
+ fd = (numfd >= 0.0)? (t_socket) numfd: SOCKET_INVALID;
+ }
+ }
+ lua_pop(L, 1);
+ return fd;
+}
+
+static int dirty(lua_State *L) {
+ int is = 0;
+ lua_pushstring(L, "dirty");
+ lua_gettable(L, -2);
+ if (!lua_isnil(L, -1)) {
+ lua_pushvalue(L, -2);
+ lua_call(L, 1, 1);
+ is = lua_toboolean(L, -1);
+ }
+ lua_pop(L, 1);
+ return is;
+}
+
+static void collect_fd(lua_State *L, int tab, int itab,
+ fd_set *set, t_socket *max_fd) {
+ int i = 1, n = 0;
+ /* nil is the same as an empty table */
+ if (lua_isnil(L, tab)) return;
+ /* otherwise we need it to be a table */
+ luaL_checktype(L, tab, LUA_TTABLE);
+ for ( ;; ) {
+ t_socket fd;
+ lua_pushnumber(L, i);
+ lua_gettable(L, tab);
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ break;
+ }
+ /* getfd figures out if this is a socket */
+ fd = getfd(L);
+ if (fd != SOCKET_INVALID) {
+ /* make sure we don't overflow the fd_set */
+#ifdef _WIN32
+ if (n >= FD_SETSIZE)
+ luaL_argerror(L, tab, "too many sockets");
+#else
+ if (fd >= FD_SETSIZE)
+ luaL_argerror(L, tab, "descriptor too large for set size");
+#endif
+ FD_SET(fd, set);
+ n++;
+ /* keep track of the largest descriptor so far */
+ if (*max_fd == SOCKET_INVALID || *max_fd < fd)
+ *max_fd = fd;
+ /* make sure we can map back from descriptor to the object */
+ lua_pushnumber(L, (lua_Number) fd);
+ lua_pushvalue(L, -2);
+ lua_settable(L, itab);
+ }
+ lua_pop(L, 1);
+ i = i + 1;
+ }
+}
+
+static int check_dirty(lua_State *L, int tab, int dtab, fd_set *set) {
+ int ndirty = 0, i = 1;
+ if (lua_isnil(L, tab))
+ return 0;
+ for ( ;; ) {
+ t_socket fd;
+ lua_pushnumber(L, i);
+ lua_gettable(L, tab);
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ break;
+ }
+ fd = getfd(L);
+ if (fd != SOCKET_INVALID && dirty(L)) {
+ lua_pushnumber(L, ++ndirty);
+ lua_pushvalue(L, -2);
+ lua_settable(L, dtab);
+ FD_CLR(fd, set);
+ }
+ lua_pop(L, 1);
+ i = i + 1;
+ }
+ return ndirty;
+}
+
+static void return_fd(lua_State *L, fd_set *set, t_socket max_fd,
+ int itab, int tab, int start) {
+ t_socket fd;
+ for (fd = 0; fd < max_fd; fd++) {
+ if (FD_ISSET(fd, set)) {
+ lua_pushnumber(L, ++start);
+ lua_pushnumber(L, (lua_Number) fd);
+ lua_gettable(L, itab);
+ lua_settable(L, tab);
+ }
+ }
+}
+
+static void make_assoc(lua_State *L, int tab) {
+ int i = 1, atab;
+ lua_newtable(L); atab = lua_gettop(L);
+ for ( ;; ) {
+ lua_pushnumber(L, i);
+ lua_gettable(L, tab);
+ if (!lua_isnil(L, -1)) {
+ lua_pushnumber(L, i);
+ lua_pushvalue(L, -2);
+ lua_settable(L, atab);
+ lua_pushnumber(L, i);
+ lua_settable(L, atab);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ i = i+1;
+ }
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/select.h b/source/luametatex/source/luacore/luasocket/src/select.h
new file mode 100644
index 000000000..5d45fe753
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/select.h
@@ -0,0 +1,23 @@
+#ifndef SELECT_H
+#define SELECT_H
+/*=========================================================================*\
+* Select implementation
+* LuaSocket toolkit
+*
+* Each object that can be passed to the select function has to export
+* method getfd() which returns the descriptor to be passed to the
+* underlying select function. Another method, dirty(), should return
+* true if there is data ready for reading (required for buffered input).
+\*=========================================================================*/
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int select_open(lua_State *L);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* SELECT_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/serial.c b/source/luametatex/source/luacore/luasocket/src/serial.c
new file mode 100644
index 000000000..21485d3e2
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/serial.c
@@ -0,0 +1,171 @@
+/*=========================================================================*\
+* Serial stream
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "auxiliar.h"
+#include "socket.h"
+#include "options.h"
+#include "unix.h"
+
+#include <string.h>
+#include <sys/un.h>
+
+/*
+Reuses userdata definition from unix.h, since it is useful for all
+stream-like objects.
+
+If we stored the serial path for use in error messages or userdata
+printing, we might need our own userdata definition.
+
+Group usage is semi-inherited from unix.c, but unnecessary since we
+have only one object type.
+*/
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int global_create(lua_State *L);
+static int meth_send(lua_State *L);
+static int meth_receive(lua_State *L);
+static int meth_close(lua_State *L);
+static int meth_settimeout(lua_State *L);
+static int meth_getfd(lua_State *L);
+static int meth_setfd(lua_State *L);
+static int meth_dirty(lua_State *L);
+static int meth_getstats(lua_State *L);
+static int meth_setstats(lua_State *L);
+
+/* serial object methods */
+static luaL_Reg serial_methods[] = {
+ {"__gc", meth_close},
+ {"__tostring", auxiliar_tostring},
+ {"close", meth_close},
+ {"dirty", meth_dirty},
+ {"getfd", meth_getfd},
+ {"getstats", meth_getstats},
+ {"setstats", meth_setstats},
+ {"receive", meth_receive},
+ {"send", meth_send},
+ {"setfd", meth_setfd},
+ {"settimeout", meth_settimeout},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+LUASOCKET_API int luaopen_socket_serial(lua_State *L) {
+ /* create classes */
+ auxiliar_newclass(L, "serial{client}", serial_methods);
+ /* create class groups */
+ auxiliar_add2group(L, "serial{client}", "serial{any}");
+ lua_pushcfunction(L, global_create);
+ return 1;
+}
+
+/*=========================================================================*\
+* Lua methods
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Just call buffered IO methods
+\*-------------------------------------------------------------------------*/
+static int meth_send(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "serial{client}", 1);
+ return buffer_meth_send(L, &un->buf);
+}
+
+static int meth_receive(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "serial{client}", 1);
+ return buffer_meth_receive(L, &un->buf);
+}
+
+static int meth_getstats(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "serial{client}", 1);
+ return buffer_meth_getstats(L, &un->buf);
+}
+
+static int meth_setstats(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "serial{client}", 1);
+ return buffer_meth_setstats(L, &un->buf);
+}
+
+/*-------------------------------------------------------------------------*\
+* Select support methods
+\*-------------------------------------------------------------------------*/
+static int meth_getfd(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "serial{any}", 1);
+ lua_pushnumber(L, (int) un->sock);
+ return 1;
+}
+
+/* this is very dangerous, but can be handy for those that are brave enough */
+static int meth_setfd(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "serial{any}", 1);
+ un->sock = (t_socket) luaL_checknumber(L, 2);
+ return 0;
+}
+
+static int meth_dirty(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "serial{any}", 1);
+ lua_pushboolean(L, !buffer_isempty(&un->buf));
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Closes socket used by object
+\*-------------------------------------------------------------------------*/
+static int meth_close(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "serial{any}", 1);
+ socket_destroy(&un->sock);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+
+/*-------------------------------------------------------------------------*\
+* Just call tm methods
+\*-------------------------------------------------------------------------*/
+static int meth_settimeout(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "serial{any}", 1);
+ return timeout_meth_settimeout(L, &un->tm);
+}
+
+/*=========================================================================*\
+* Library functions
+\*=========================================================================*/
+
+
+/*-------------------------------------------------------------------------*\
+* Creates a serial object
+\*-------------------------------------------------------------------------*/
+static int global_create(lua_State *L) {
+ const char* path = luaL_checkstring(L, 1);
+
+ /* allocate unix object */
+ p_unix un = (p_unix) lua_newuserdata(L, sizeof(t_unix));
+
+ /* open serial device */
+ t_socket sock = open(path, O_NOCTTY|O_RDWR);
+
+ /*printf("open %s on %d\n", path, sock);*/
+
+ if (sock < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(errno));
+ lua_pushnumber(L, errno);
+ return 3;
+ }
+ /* set its type as client object */
+ auxiliar_setclass(L, "serial{client}", -1);
+ /* initialize remaining structure fields */
+ socket_setnonblocking(&sock);
+ un->sock = sock;
+ io_init(&un->io, (p_send) socket_write, (p_recv) socket_read,
+ (p_error) socket_ioerror, &un->sock);
+ timeout_init(&un->tm, -1, -1);
+ buffer_init(&un->buf, &un->io, &un->tm);
+ return 1;
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/socket.c b/source/luametatex/source/luacore/luasocket/src/socket.c
new file mode 100644
index 000000000..84165c70e
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/socket.c
@@ -0,0 +1,5 @@
+#ifdef _WIN32
+#include "wsocket.c"
+#else
+#include "usocket.c"
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/socket.h b/source/luametatex/source/luacore/luasocket/src/socket.h
new file mode 100644
index 000000000..e541f27d4
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/socket.h
@@ -0,0 +1,73 @@
+#ifndef SOCKET_H
+#define SOCKET_H
+/*=========================================================================*\
+* Socket compatibilization module
+* LuaSocket toolkit
+*
+* BSD Sockets and WinSock are similar, but there are a few irritating
+* differences. Also, not all *nix platforms behave the same. This module
+* (and the associated usocket.h and wsocket.h) factor these differences and
+* creates a interface compatible with the io.h module.
+\*=========================================================================*/
+#include "io.h"
+
+/*=========================================================================*\
+* Platform specific compatibilization
+\*=========================================================================*/
+#ifdef _WIN32
+#include "wsocket.h"
+#else
+#include "usocket.h"
+#endif
+
+/*=========================================================================*\
+* The connect and accept functions accept a timeout and their
+* implementations are somewhat complicated. We chose to move
+* the timeout control into this module for these functions in
+* order to simplify the modules that use them.
+\*=========================================================================*/
+#include "timeout.h"
+
+/* convenient shorthand */
+typedef struct sockaddr SA;
+
+/*=========================================================================*\
+* Functions bellow implement a comfortable platform independent
+* interface to sockets
+\*=========================================================================*/
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int socket_waitfd(p_socket ps, int sw, p_timeout tm);
+int socket_open(void);
+int socket_close(void);
+void socket_destroy(p_socket ps);
+int socket_select(t_socket n, fd_set *rfds, fd_set *wfds, fd_set *efds, p_timeout tm);
+int socket_create(p_socket ps, int domain, int type, int protocol);
+int socket_bind(p_socket ps, SA *addr, socklen_t addr_len);
+int socket_listen(p_socket ps, int backlog);
+void socket_shutdown(p_socket ps, int how);
+int socket_connect(p_socket ps, SA *addr, socklen_t addr_len, p_timeout tm);
+int socket_accept(p_socket ps, p_socket pa, SA *addr, socklen_t *addr_len, p_timeout tm);
+int socket_send(p_socket ps, const char *data, size_t count, size_t *sent, p_timeout tm);
+int socket_sendto(p_socket ps, const char *data, size_t count, size_t *sent, SA *addr, socklen_t addr_len, p_timeout tm);
+int socket_recv(p_socket ps, char *data, size_t count, size_t *got, p_timeout tm);
+int socket_recvfrom(p_socket ps, char *data, size_t count, size_t *got, SA *addr, socklen_t *addr_len, p_timeout tm);
+int socket_write(p_socket ps, const char *data, size_t count, size_t *sent, p_timeout tm);
+int socket_read(p_socket ps, char *data, size_t count, size_t *got, p_timeout tm);
+void socket_setblocking(p_socket ps);
+void socket_setnonblocking(p_socket ps);
+int socket_gethostbyaddr(const char *addr, socklen_t len, struct hostent **hp);
+int socket_gethostbyname(const char *addr, struct hostent **hp);
+const char *socket_hoststrerror(int err);
+const char *socket_strerror(int err);
+const char *socket_ioerror(p_socket ps, int err);
+const char *socket_gaistrerror(int err);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* SOCKET_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/tcp.c b/source/luametatex/source/luacore/luasocket/src/tcp.c
new file mode 100644
index 000000000..5876bfb87
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/tcp.c
@@ -0,0 +1,471 @@
+/*=========================================================================*\
+* TCP object
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "auxiliar.h"
+#include "socket.h"
+#include "inet.h"
+#include "options.h"
+#include "tcp.h"
+
+#include <string.h>
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int global_create(lua_State *L);
+static int global_create4(lua_State *L);
+static int global_create6(lua_State *L);
+static int global_connect(lua_State *L);
+static int meth_connect(lua_State *L);
+static int meth_listen(lua_State *L);
+static int meth_getfamily(lua_State *L);
+static int meth_bind(lua_State *L);
+static int meth_send(lua_State *L);
+static int meth_getstats(lua_State *L);
+static int meth_setstats(lua_State *L);
+static int meth_getsockname(lua_State *L);
+static int meth_getpeername(lua_State *L);
+static int meth_shutdown(lua_State *L);
+static int meth_receive(lua_State *L);
+static int meth_accept(lua_State *L);
+static int meth_close(lua_State *L);
+static int meth_getoption(lua_State *L);
+static int meth_setoption(lua_State *L);
+static int meth_gettimeout(lua_State *L);
+static int meth_settimeout(lua_State *L);
+static int meth_getfd(lua_State *L);
+static int meth_setfd(lua_State *L);
+static int meth_dirty(lua_State *L);
+
+/* tcp object methods */
+static luaL_Reg tcp_methods[] = {
+ {"__gc", meth_close},
+ {"__tostring", auxiliar_tostring},
+ {"accept", meth_accept},
+ {"bind", meth_bind},
+ {"close", meth_close},
+ {"connect", meth_connect},
+ {"dirty", meth_dirty},
+ {"getfamily", meth_getfamily},
+ {"getfd", meth_getfd},
+ {"getoption", meth_getoption},
+ {"getpeername", meth_getpeername},
+ {"getsockname", meth_getsockname},
+ {"getstats", meth_getstats},
+ {"setstats", meth_setstats},
+ {"listen", meth_listen},
+ {"receive", meth_receive},
+ {"send", meth_send},
+ {"setfd", meth_setfd},
+ {"setoption", meth_setoption},
+ {"setpeername", meth_connect},
+ {"setsockname", meth_bind},
+ {"settimeout", meth_settimeout},
+ {"gettimeout", meth_gettimeout},
+ {"shutdown", meth_shutdown},
+ {NULL, NULL}
+};
+
+/* socket option handlers */
+static t_opt optget[] = {
+ {"keepalive", opt_get_keepalive},
+ {"reuseaddr", opt_get_reuseaddr},
+ {"reuseport", opt_get_reuseport},
+ {"tcp-nodelay", opt_get_tcp_nodelay},
+#ifdef TCP_KEEPIDLE
+ {"tcp-keepidle", opt_get_tcp_keepidle},
+#endif
+#ifdef TCP_KEEPCNT
+ {"tcp-keepcnt", opt_get_tcp_keepcnt},
+#endif
+#ifdef TCP_KEEPINTVL
+ {"tcp-keepintvl", opt_get_tcp_keepintvl},
+#endif
+ {"linger", opt_get_linger},
+ {"error", opt_get_error},
+ {"recv-buffer-size", opt_get_recv_buf_size},
+ {"send-buffer-size", opt_get_send_buf_size},
+ {NULL, NULL}
+};
+
+static t_opt optset[] = {
+ {"keepalive", opt_set_keepalive},
+ {"reuseaddr", opt_set_reuseaddr},
+ {"reuseport", opt_set_reuseport},
+ {"tcp-nodelay", opt_set_tcp_nodelay},
+#ifdef TCP_KEEPIDLE
+ {"tcp-keepidle", opt_set_tcp_keepidle},
+#endif
+#ifdef TCP_KEEPCNT
+ {"tcp-keepcnt", opt_set_tcp_keepcnt},
+#endif
+#ifdef TCP_KEEPINTVL
+ {"tcp-keepintvl", opt_set_tcp_keepintvl},
+#endif
+ {"ipv6-v6only", opt_set_ip6_v6only},
+ {"linger", opt_set_linger},
+ {"recv-buffer-size", opt_set_recv_buf_size},
+ {"send-buffer-size", opt_set_send_buf_size},
+ {NULL, NULL}
+};
+
+/* functions in library namespace */
+static luaL_Reg func[] = {
+ {"tcp", global_create},
+ {"tcp4", global_create4},
+ {"tcp6", global_create6},
+ {"connect", global_connect},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int tcp_open(lua_State *L)
+{
+ /* create classes */
+ auxiliar_newclass(L, "tcp{master}", tcp_methods);
+ auxiliar_newclass(L, "tcp{client}", tcp_methods);
+ auxiliar_newclass(L, "tcp{server}", tcp_methods);
+ /* create class groups */
+ auxiliar_add2group(L, "tcp{master}", "tcp{any}");
+ auxiliar_add2group(L, "tcp{client}", "tcp{any}");
+ auxiliar_add2group(L, "tcp{server}", "tcp{any}");
+ /* define library functions */
+ luaL_setfuncs(L, func, 0);
+ return 0;
+}
+
+/*=========================================================================*\
+* Lua methods
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Just call buffered IO methods
+\*-------------------------------------------------------------------------*/
+static int meth_send(lua_State *L) {
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{client}", 1);
+ return buffer_meth_send(L, &tcp->buf);
+}
+
+static int meth_receive(lua_State *L) {
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{client}", 1);
+ return buffer_meth_receive(L, &tcp->buf);
+}
+
+static int meth_getstats(lua_State *L) {
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{client}", 1);
+ return buffer_meth_getstats(L, &tcp->buf);
+}
+
+static int meth_setstats(lua_State *L) {
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{client}", 1);
+ return buffer_meth_setstats(L, &tcp->buf);
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call option handler
+\*-------------------------------------------------------------------------*/
+static int meth_getoption(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ return opt_meth_getoption(L, optget, &tcp->sock);
+}
+
+static int meth_setoption(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ return opt_meth_setoption(L, optset, &tcp->sock);
+}
+
+/*-------------------------------------------------------------------------*\
+* Select support methods
+\*-------------------------------------------------------------------------*/
+static int meth_getfd(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ lua_pushnumber(L, (int) tcp->sock);
+ return 1;
+}
+
+/* this is very dangerous, but can be handy for those that are brave enough */
+static int meth_setfd(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ tcp->sock = (t_socket) luaL_checknumber(L, 2);
+ return 0;
+}
+
+static int meth_dirty(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ lua_pushboolean(L, !buffer_isempty(&tcp->buf));
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Waits for and returns a client object attempting connection to the
+* server object
+\*-------------------------------------------------------------------------*/
+static int meth_accept(lua_State *L)
+{
+ p_tcp server = (p_tcp) auxiliar_checkclass(L, "tcp{server}", 1);
+ p_timeout tm = timeout_markstart(&server->tm);
+ t_socket sock;
+ const char *err = inet_tryaccept(&server->sock, server->family, &sock, tm);
+ /* if successful, push client socket */
+ if (err == NULL) {
+ p_tcp clnt = (p_tcp) lua_newuserdata(L, sizeof(t_tcp));
+ auxiliar_setclass(L, "tcp{client}", -1);
+ /* initialize structure fields */
+ memset(clnt, 0, sizeof(t_tcp));
+ socket_setnonblocking(&sock);
+ clnt->sock = sock;
+ io_init(&clnt->io, (p_send) socket_send, (p_recv) socket_recv,
+ (p_error) socket_ioerror, &clnt->sock);
+ timeout_init(&clnt->tm, -1, -1);
+ buffer_init(&clnt->buf, &clnt->io, &clnt->tm);
+ clnt->family = server->family;
+ return 1;
+ } else {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Binds an object to an address
+\*-------------------------------------------------------------------------*/
+static int meth_bind(lua_State *L) {
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{master}", 1);
+ const char *address = luaL_checkstring(L, 2);
+ const char *port = luaL_checkstring(L, 3);
+ const char *err;
+ struct addrinfo bindhints;
+ memset(&bindhints, 0, sizeof(bindhints));
+ bindhints.ai_socktype = SOCK_STREAM;
+ bindhints.ai_family = tcp->family;
+ bindhints.ai_flags = AI_PASSIVE;
+ err = inet_trybind(&tcp->sock, &tcp->family, address, port, &bindhints);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Turns a master tcp object into a client object.
+\*-------------------------------------------------------------------------*/
+static int meth_connect(lua_State *L) {
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ const char *address = luaL_checkstring(L, 2);
+ const char *port = luaL_checkstring(L, 3);
+ struct addrinfo connecthints;
+ const char *err;
+ memset(&connecthints, 0, sizeof(connecthints));
+ connecthints.ai_socktype = SOCK_STREAM;
+ /* make sure we try to connect only to the same family */
+ connecthints.ai_family = tcp->family;
+ timeout_markstart(&tcp->tm);
+ err = inet_tryconnect(&tcp->sock, &tcp->family, address, port,
+ &tcp->tm, &connecthints);
+ /* have to set the class even if it failed due to non-blocking connects */
+ auxiliar_setclass(L, "tcp{client}", 1);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Closes socket used by object
+\*-------------------------------------------------------------------------*/
+static int meth_close(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ socket_destroy(&tcp->sock);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Returns family as string
+\*-------------------------------------------------------------------------*/
+static int meth_getfamily(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ if (tcp->family == AF_INET6) {
+ lua_pushliteral(L, "inet6");
+ return 1;
+ } else if (tcp->family == AF_INET) {
+ lua_pushliteral(L, "inet4");
+ return 1;
+ } else {
+ lua_pushliteral(L, "inet4");
+ return 1;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Puts the sockt in listen mode
+\*-------------------------------------------------------------------------*/
+static int meth_listen(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{master}", 1);
+ int backlog = (int) luaL_optnumber(L, 2, 32);
+ int err = socket_listen(&tcp->sock, backlog);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(err));
+ return 2;
+ }
+ /* turn master object into a server object */
+ auxiliar_setclass(L, "tcp{server}", 1);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Shuts the connection down partially
+\*-------------------------------------------------------------------------*/
+static int meth_shutdown(lua_State *L)
+{
+ /* SHUT_RD, SHUT_WR, SHUT_RDWR have the value 0, 1, 2, so we can use method index directly */
+ static const char* methods[] = { "receive", "send", "both", NULL };
+ p_tcp tcp = (p_tcp) auxiliar_checkclass(L, "tcp{client}", 1);
+ int how = luaL_checkoption(L, 2, "both", methods);
+ socket_shutdown(&tcp->sock, how);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call inet methods
+\*-------------------------------------------------------------------------*/
+static int meth_getpeername(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ return inet_meth_getpeername(L, &tcp->sock, tcp->family);
+}
+
+static int meth_getsockname(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ return inet_meth_getsockname(L, &tcp->sock, tcp->family);
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call tm methods
+\*-------------------------------------------------------------------------*/
+static int meth_settimeout(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ return timeout_meth_settimeout(L, &tcp->tm);
+}
+
+static int meth_gettimeout(lua_State *L)
+{
+ p_tcp tcp = (p_tcp) auxiliar_checkgroup(L, "tcp{any}", 1);
+ return timeout_meth_gettimeout(L, &tcp->tm);
+}
+
+/*=========================================================================*\
+* Library functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Creates a master tcp object
+\*-------------------------------------------------------------------------*/
+static int tcp_create(lua_State *L, int family) {
+ p_tcp tcp = (p_tcp) lua_newuserdata(L, sizeof(t_tcp));
+ memset(tcp, 0, sizeof(t_tcp));
+ /* set its type as master object */
+ auxiliar_setclass(L, "tcp{master}", -1);
+ /* if family is AF_UNSPEC, we leave the socket invalid and
+ * store AF_UNSPEC into family. This will allow it to later be
+ * replaced with an AF_INET6 or AF_INET socket upon first use. */
+ tcp->sock = SOCKET_INVALID;
+ tcp->family = family;
+ io_init(&tcp->io, (p_send) socket_send, (p_recv) socket_recv,
+ (p_error) socket_ioerror, &tcp->sock);
+ timeout_init(&tcp->tm, -1, -1);
+ buffer_init(&tcp->buf, &tcp->io, &tcp->tm);
+ if (family != AF_UNSPEC) {
+ const char *err = inet_trycreate(&tcp->sock, family, SOCK_STREAM, 0);
+ if (err != NULL) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ socket_setnonblocking(&tcp->sock);
+ }
+ return 1;
+}
+
+static int global_create(lua_State *L) {
+ return tcp_create(L, AF_UNSPEC);
+}
+
+static int global_create4(lua_State *L) {
+ return tcp_create(L, AF_INET);
+}
+
+static int global_create6(lua_State *L) {
+ return tcp_create(L, AF_INET6);
+}
+
+static int global_connect(lua_State *L) {
+ const char *remoteaddr = luaL_checkstring(L, 1);
+ const char *remoteserv = luaL_checkstring(L, 2);
+ const char *localaddr = luaL_optstring(L, 3, NULL);
+ const char *localserv = luaL_optstring(L, 4, "0");
+ int family = inet_optfamily(L, 5, "unspec");
+ p_tcp tcp = (p_tcp) lua_newuserdata(L, sizeof(t_tcp));
+ struct addrinfo bindhints, connecthints;
+ const char *err = NULL;
+ /* initialize tcp structure */
+ memset(tcp, 0, sizeof(t_tcp));
+ io_init(&tcp->io, (p_send) socket_send, (p_recv) socket_recv,
+ (p_error) socket_ioerror, &tcp->sock);
+ timeout_init(&tcp->tm, -1, -1);
+ buffer_init(&tcp->buf, &tcp->io, &tcp->tm);
+ tcp->sock = SOCKET_INVALID;
+ tcp->family = AF_UNSPEC;
+ /* allow user to pick local address and port */
+ memset(&bindhints, 0, sizeof(bindhints));
+ bindhints.ai_socktype = SOCK_STREAM;
+ bindhints.ai_family = family;
+ bindhints.ai_flags = AI_PASSIVE;
+ if (localaddr) {
+ err = inet_trybind(&tcp->sock, &tcp->family, localaddr,
+ localserv, &bindhints);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ }
+ /* try to connect to remote address and port */
+ memset(&connecthints, 0, sizeof(connecthints));
+ connecthints.ai_socktype = SOCK_STREAM;
+ /* make sure we try to connect only to the same family */
+ connecthints.ai_family = tcp->family;
+ err = inet_tryconnect(&tcp->sock, &tcp->family, remoteaddr, remoteserv,
+ &tcp->tm, &connecthints);
+ if (err) {
+ socket_destroy(&tcp->sock);
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ auxiliar_setclass(L, "tcp{client}", -1);
+ return 1;
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/tcp.h b/source/luametatex/source/luacore/luasocket/src/tcp.h
new file mode 100644
index 000000000..9b282efeb
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/tcp.h
@@ -0,0 +1,43 @@
+#ifndef TCP_H
+#define TCP_H
+/*=========================================================================*\
+* TCP object
+* LuaSocket toolkit
+*
+* The tcp.h module is basicly a glue that puts together modules buffer.h,
+* timeout.h socket.h and inet.h to provide the LuaSocket TCP (AF_INET,
+* SOCK_STREAM) support.
+*
+* Three classes are defined: master, client and server. The master class is
+* a newly created tcp object, that has not been bound or connected. Server
+* objects are tcp objects bound to some local address. Client objects are
+* tcp objects either connected to some address or returned by the accept
+* method of a server object.
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "buffer.h"
+#include "timeout.h"
+#include "socket.h"
+
+typedef struct t_tcp_ {
+ t_socket sock;
+ t_io io;
+ t_buffer buf;
+ t_timeout tm;
+ int family;
+} t_tcp;
+
+typedef t_tcp *p_tcp;
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int tcp_open(lua_State *L);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* TCP_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/timeout.c b/source/luametatex/source/luacore/luasocket/src/timeout.c
new file mode 100644
index 000000000..2bdc0698c
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/timeout.c
@@ -0,0 +1,226 @@
+/*=========================================================================*\
+* Timeout management functions
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "auxiliar.h"
+#include "timeout.h"
+
+#include <stdio.h>
+#include <limits.h>
+#include <float.h>
+
+#ifdef _WIN32
+#include <windows.h>
+#else
+#include <time.h>
+#include <sys/time.h>
+#endif
+
+/* min and max macros */
+#ifndef MIN
+#define MIN(x, y) ((x) < (y) ? x : y)
+#endif
+#ifndef MAX
+#define MAX(x, y) ((x) > (y) ? x : y)
+#endif
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int timeout_lua_gettime(lua_State *L);
+static int timeout_lua_sleep(lua_State *L);
+
+static luaL_Reg func[] = {
+ { "gettime", timeout_lua_gettime },
+ { "sleep", timeout_lua_sleep },
+ { NULL, NULL }
+};
+
+/*=========================================================================*\
+* Exported functions.
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Initialize structure
+\*-------------------------------------------------------------------------*/
+void timeout_init(p_timeout tm, double block, double total) {
+ tm->block = block;
+ tm->total = total;
+}
+
+/*-------------------------------------------------------------------------*\
+* Determines how much time we have left for the next system call,
+* if the previous call was successful
+* Input
+* tm: timeout control structure
+* Returns
+* the number of ms left or -1 if there is no time limit
+\*-------------------------------------------------------------------------*/
+double timeout_get(p_timeout tm) {
+ if (tm->block < 0.0 && tm->total < 0.0) {
+ return -1;
+ } else if (tm->block < 0.0) {
+ double t = tm->total - timeout_gettime() + tm->start;
+ return MAX(t, 0.0);
+ } else if (tm->total < 0.0) {
+ return tm->block;
+ } else {
+ double t = tm->total - timeout_gettime() + tm->start;
+ return MIN(tm->block, MAX(t, 0.0));
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Returns time since start of operation
+* Input
+* tm: timeout control structure
+* Returns
+* start field of structure
+\*-------------------------------------------------------------------------*/
+double timeout_getstart(p_timeout tm) {
+ return tm->start;
+}
+
+/*-------------------------------------------------------------------------*\
+* Determines how much time we have left for the next system call,
+* if the previous call was a failure
+* Input
+* tm: timeout control structure
+* Returns
+* the number of ms left or -1 if there is no time limit
+\*-------------------------------------------------------------------------*/
+double timeout_getretry(p_timeout tm) {
+ if (tm->block < 0.0 && tm->total < 0.0) {
+ return -1;
+ } else if (tm->block < 0.0) {
+ double t = tm->total - timeout_gettime() + tm->start;
+ return MAX(t, 0.0);
+ } else if (tm->total < 0.0) {
+ double t = tm->block - timeout_gettime() + tm->start;
+ return MAX(t, 0.0);
+ } else {
+ double t = tm->total - timeout_gettime() + tm->start;
+ return MIN(tm->block, MAX(t, 0.0));
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Marks the operation start time in structure
+* Input
+* tm: timeout control structure
+\*-------------------------------------------------------------------------*/
+p_timeout timeout_markstart(p_timeout tm) {
+ tm->start = timeout_gettime();
+ return tm;
+}
+
+/*-------------------------------------------------------------------------*\
+* Gets time in s, relative to January 1, 1970 (UTC)
+* Returns
+* time in s.
+\*-------------------------------------------------------------------------*/
+#ifdef _WIN32
+double timeout_gettime(void) {
+ FILETIME ft;
+ double t;
+ GetSystemTimeAsFileTime(&ft);
+ /* Windows file time (time since January 1, 1601 (UTC)) */
+ t = ft.dwLowDateTime/1.0e7 + ft.dwHighDateTime*(4294967296.0/1.0e7);
+ /* convert to Unix Epoch time (time since January 1, 1970 (UTC)) */
+ return (t - 11644473600.0);
+}
+#else
+double timeout_gettime(void) {
+ struct timeval v;
+ gettimeofday(&v, (struct timezone *) NULL);
+ /* Unix Epoch time (time since January 1, 1970 (UTC)) */
+ return v.tv_sec + v.tv_usec/1.0e6;
+}
+#endif
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int timeout_open(lua_State *L) {
+ luaL_setfuncs(L, func, 0);
+ return 0;
+}
+
+/*-------------------------------------------------------------------------*\
+* Sets timeout values for IO operations
+* Lua Input: base, time [, mode]
+* time: time out value in seconds
+* mode: "b" for block timeout, "t" for total timeout. (default: b)
+\*-------------------------------------------------------------------------*/
+int timeout_meth_settimeout(lua_State *L, p_timeout tm) {
+ double t = luaL_optnumber(L, 2, -1);
+ const char *mode = luaL_optstring(L, 3, "b");
+ switch (*mode) {
+ case 'b':
+ tm->block = t;
+ break;
+ case 'r': case 't':
+ tm->total = t;
+ break;
+ default:
+ luaL_argcheck(L, 0, 3, "invalid timeout mode");
+ break;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Gets timeout values for IO operations
+* Lua Output: block, total
+\*-------------------------------------------------------------------------*/
+int timeout_meth_gettimeout(lua_State *L, p_timeout tm) {
+ lua_pushnumber(L, tm->block);
+ lua_pushnumber(L, tm->total);
+ return 2;
+}
+
+/*=========================================================================*\
+* Test support functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Returns the time the system has been up, in secconds.
+\*-------------------------------------------------------------------------*/
+static int timeout_lua_gettime(lua_State *L)
+{
+ lua_pushnumber(L, timeout_gettime());
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Sleep for n seconds.
+\*-------------------------------------------------------------------------*/
+#ifdef _WIN32
+int timeout_lua_sleep(lua_State *L)
+{
+ double n = luaL_checknumber(L, 1);
+ if (n < 0.0) n = 0.0;
+ if (n < DBL_MAX/1000.0) n *= 1000.0;
+ if (n > INT_MAX) n = INT_MAX;
+ Sleep((int)n);
+ return 0;
+}
+#else
+int timeout_lua_sleep(lua_State *L)
+{
+ double n = luaL_checknumber(L, 1);
+ struct timespec t, r;
+ if (n < 0.0) n = 0.0;
+ if (n > INT_MAX) n = INT_MAX;
+ t.tv_sec = (int) n;
+ n -= t.tv_sec;
+ t.tv_nsec = (int) (n * 1000000000);
+ if (t.tv_nsec >= 1000000000) t.tv_nsec = 999999999;
+ while (nanosleep(&t, &r) != 0) {
+ t.tv_sec = r.tv_sec;
+ t.tv_nsec = r.tv_nsec;
+ }
+ return 0;
+}
+#endif
diff --git a/source/luametatex/source/luacore/luasocket/src/timeout.h b/source/luametatex/source/luacore/luasocket/src/timeout.h
new file mode 100644
index 000000000..9e5250d33
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/timeout.h
@@ -0,0 +1,40 @@
+#ifndef TIMEOUT_H
+#define TIMEOUT_H
+/*=========================================================================*\
+* Timeout management functions
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+/* timeout control structure */
+typedef struct t_timeout_ {
+ double block; /* maximum time for blocking calls */
+ double total; /* total number of miliseconds for operation */
+ double start; /* time of start of operation */
+} t_timeout;
+typedef t_timeout *p_timeout;
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+void timeout_init(p_timeout tm, double block, double total);
+double timeout_get(p_timeout tm);
+double timeout_getstart(p_timeout tm);
+double timeout_getretry(p_timeout tm);
+p_timeout timeout_markstart(p_timeout tm);
+
+double timeout_gettime(void);
+
+int timeout_open(lua_State *L);
+
+int timeout_meth_settimeout(lua_State *L, p_timeout tm);
+int timeout_meth_gettimeout(lua_State *L, p_timeout tm);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#define timeout_iszero(tm) ((tm)->block == 0.0)
+
+#endif /* TIMEOUT_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/udp.c b/source/luametatex/source/luacore/luasocket/src/udp.c
new file mode 100644
index 000000000..62b6a20dd
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/udp.c
@@ -0,0 +1,488 @@
+/*=========================================================================*\
+* UDP object
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "auxiliar.h"
+#include "socket.h"
+#include "inet.h"
+#include "options.h"
+#include "udp.h"
+
+#include <string.h>
+#include <stdlib.h>
+
+/* min and max macros */
+#ifndef MIN
+#define MIN(x, y) ((x) < (y) ? x : y)
+#endif
+#ifndef MAX
+#define MAX(x, y) ((x) > (y) ? x : y)
+#endif
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int global_create(lua_State *L);
+static int global_create4(lua_State *L);
+static int global_create6(lua_State *L);
+static int meth_send(lua_State *L);
+static int meth_sendto(lua_State *L);
+static int meth_receive(lua_State *L);
+static int meth_receivefrom(lua_State *L);
+static int meth_getfamily(lua_State *L);
+static int meth_getsockname(lua_State *L);
+static int meth_getpeername(lua_State *L);
+static int meth_gettimeout(lua_State *L);
+static int meth_setsockname(lua_State *L);
+static int meth_setpeername(lua_State *L);
+static int meth_close(lua_State *L);
+static int meth_setoption(lua_State *L);
+static int meth_getoption(lua_State *L);
+static int meth_settimeout(lua_State *L);
+static int meth_getfd(lua_State *L);
+static int meth_setfd(lua_State *L);
+static int meth_dirty(lua_State *L);
+
+/* udp object methods */
+static luaL_Reg udp_methods[] = {
+ {"__gc", meth_close},
+ {"__tostring", auxiliar_tostring},
+ {"close", meth_close},
+ {"dirty", meth_dirty},
+ {"getfamily", meth_getfamily},
+ {"getfd", meth_getfd},
+ {"getpeername", meth_getpeername},
+ {"getsockname", meth_getsockname},
+ {"receive", meth_receive},
+ {"receivefrom", meth_receivefrom},
+ {"send", meth_send},
+ {"sendto", meth_sendto},
+ {"setfd", meth_setfd},
+ {"setoption", meth_setoption},
+ {"getoption", meth_getoption},
+ {"setpeername", meth_setpeername},
+ {"setsockname", meth_setsockname},
+ {"settimeout", meth_settimeout},
+ {"gettimeout", meth_gettimeout},
+ {NULL, NULL}
+};
+
+/* socket options for setoption */
+static t_opt optset[] = {
+ {"dontroute", opt_set_dontroute},
+ {"broadcast", opt_set_broadcast},
+ {"reuseaddr", opt_set_reuseaddr},
+ {"reuseport", opt_set_reuseport},
+ {"ip-multicast-if", opt_set_ip_multicast_if},
+ {"ip-multicast-ttl", opt_set_ip_multicast_ttl},
+ {"ip-multicast-loop", opt_set_ip_multicast_loop},
+ {"ip-add-membership", opt_set_ip_add_membership},
+ {"ip-drop-membership", opt_set_ip_drop_membersip},
+ {"ipv6-unicast-hops", opt_set_ip6_unicast_hops},
+ {"ipv6-multicast-hops", opt_set_ip6_unicast_hops},
+ {"ipv6-multicast-loop", opt_set_ip6_multicast_loop},
+ {"ipv6-add-membership", opt_set_ip6_add_membership},
+ {"ipv6-drop-membership", opt_set_ip6_drop_membersip},
+ {"ipv6-v6only", opt_set_ip6_v6only},
+ {"recv-buffer-size", opt_set_recv_buf_size},
+ {"send-buffer-size", opt_set_send_buf_size},
+ {NULL, NULL}
+};
+
+/* socket options for getoption */
+static t_opt optget[] = {
+ {"dontroute", opt_get_dontroute},
+ {"broadcast", opt_get_broadcast},
+ {"reuseaddr", opt_get_reuseaddr},
+ {"reuseport", opt_get_reuseport},
+ {"ip-multicast-if", opt_get_ip_multicast_if},
+ {"ip-multicast-loop", opt_get_ip_multicast_loop},
+ {"error", opt_get_error},
+ {"ipv6-unicast-hops", opt_get_ip6_unicast_hops},
+ {"ipv6-multicast-hops", opt_get_ip6_unicast_hops},
+ {"ipv6-multicast-loop", opt_get_ip6_multicast_loop},
+ {"ipv6-v6only", opt_get_ip6_v6only},
+ {"recv-buffer-size", opt_get_recv_buf_size},
+ {"send-buffer-size", opt_get_send_buf_size},
+ {NULL, NULL}
+};
+
+/* functions in library namespace */
+static luaL_Reg func[] = {
+ {"udp", global_create},
+ {"udp4", global_create4},
+ {"udp6", global_create6},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int udp_open(lua_State *L) {
+ /* create classes */
+ auxiliar_newclass(L, "udp{connected}", udp_methods);
+ auxiliar_newclass(L, "udp{unconnected}", udp_methods);
+ /* create class groups */
+ auxiliar_add2group(L, "udp{connected}", "udp{any}");
+ auxiliar_add2group(L, "udp{unconnected}", "udp{any}");
+ auxiliar_add2group(L, "udp{connected}", "select{able}");
+ auxiliar_add2group(L, "udp{unconnected}", "select{able}");
+ /* define library functions */
+ luaL_setfuncs(L, func, 0);
+ /* export default UDP size */
+ lua_pushliteral(L, "_DATAGRAMSIZE");
+ lua_pushinteger(L, UDP_DATAGRAMSIZE);
+ lua_rawset(L, -3);
+ return 0;
+}
+
+/*=========================================================================*\
+* Lua methods
+\*=========================================================================*/
+static const char *udp_strerror(int err) {
+ /* a 'closed' error on an unconnected means the target address was not
+ * accepted by the transport layer */
+ if (err == IO_CLOSED) return "refused";
+ else return socket_strerror(err);
+}
+
+/*-------------------------------------------------------------------------*\
+* Send data through connected udp socket
+\*-------------------------------------------------------------------------*/
+static int meth_send(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkclass(L, "udp{connected}", 1);
+ p_timeout tm = &udp->tm;
+ size_t count, sent = 0;
+ int err;
+ const char *data = luaL_checklstring(L, 2, &count);
+ timeout_markstart(tm);
+ err = socket_send(&udp->sock, data, count, &sent, tm);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, udp_strerror(err));
+ return 2;
+ }
+ lua_pushnumber(L, (lua_Number) sent);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Send data through unconnected udp socket
+\*-------------------------------------------------------------------------*/
+static int meth_sendto(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkclass(L, "udp{unconnected}", 1);
+ size_t count, sent = 0;
+ const char *data = luaL_checklstring(L, 2, &count);
+ const char *ip = luaL_checkstring(L, 3);
+ const char *port = luaL_checkstring(L, 4);
+ p_timeout tm = &udp->tm;
+ int err;
+ struct addrinfo aihint;
+ struct addrinfo *ai;
+ memset(&aihint, 0, sizeof(aihint));
+ aihint.ai_family = udp->family;
+ aihint.ai_socktype = SOCK_DGRAM;
+ aihint.ai_flags = AI_NUMERICHOST;
+#ifdef AI_NUMERICSERV
+ aihint.ai_flags |= AI_NUMERICSERV;
+#endif
+ err = getaddrinfo(ip, port, &aihint, &ai);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, gai_strerror(err));
+ return 2;
+ }
+
+ /* create socket if on first sendto if AF_UNSPEC was set */
+ if (udp->family == AF_UNSPEC && udp->sock == SOCKET_INVALID) {
+ struct addrinfo *ap;
+ const char *errstr = NULL;
+ for (ap = ai; ap != NULL; ap = ap->ai_next) {
+ errstr = inet_trycreate(&udp->sock, ap->ai_family, SOCK_DGRAM, 0);
+ if (errstr == NULL) {
+ socket_setnonblocking(&udp->sock);
+ udp->family = ap->ai_family;
+ break;
+ }
+ }
+ if (errstr != NULL) {
+ lua_pushnil(L);
+ lua_pushstring(L, errstr);
+ freeaddrinfo(ai);
+ return 2;
+ }
+ }
+
+ timeout_markstart(tm);
+ err = socket_sendto(&udp->sock, data, count, &sent, ai->ai_addr,
+ (socklen_t) ai->ai_addrlen, tm);
+ freeaddrinfo(ai);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, udp_strerror(err));
+ return 2;
+ }
+ lua_pushnumber(L, (lua_Number) sent);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Receives data from a UDP socket
+\*-------------------------------------------------------------------------*/
+static int meth_receive(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ char buf[UDP_DATAGRAMSIZE];
+ size_t got, wanted = (size_t) luaL_optnumber(L, 2, sizeof(buf));
+ char *dgram = wanted > sizeof(buf)? (char *) malloc(wanted): buf;
+ int err;
+ p_timeout tm = &udp->tm;
+ timeout_markstart(tm);
+ if (!dgram) {
+ lua_pushnil(L);
+ lua_pushliteral(L, "out of memory");
+ return 2;
+ }
+ err = socket_recv(&udp->sock, dgram, wanted, &got, tm);
+ /* Unlike TCP, recv() of zero is not closed, but a zero-length packet. */
+ if (err != IO_DONE && err != IO_CLOSED) {
+ lua_pushnil(L);
+ lua_pushstring(L, udp_strerror(err));
+ if (wanted > sizeof(buf)) free(dgram);
+ return 2;
+ }
+ lua_pushlstring(L, dgram, got);
+ if (wanted > sizeof(buf)) free(dgram);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Receives data and sender from a UDP socket
+\*-------------------------------------------------------------------------*/
+static int meth_receivefrom(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkclass(L, "udp{unconnected}", 1);
+ char buf[UDP_DATAGRAMSIZE];
+ size_t got, wanted = (size_t) luaL_optnumber(L, 2, sizeof(buf));
+ char *dgram = wanted > sizeof(buf)? (char *) malloc(wanted): buf;
+ struct sockaddr_storage addr;
+ socklen_t addr_len = sizeof(addr);
+ char addrstr[INET6_ADDRSTRLEN];
+ char portstr[6];
+ int err;
+ p_timeout tm = &udp->tm;
+ timeout_markstart(tm);
+ if (!dgram) {
+ lua_pushnil(L);
+ lua_pushliteral(L, "out of memory");
+ return 2;
+ }
+ err = socket_recvfrom(&udp->sock, dgram, wanted, &got, (SA *) &addr,
+ &addr_len, tm);
+ /* Unlike TCP, recv() of zero is not closed, but a zero-length packet. */
+ if (err != IO_DONE && err != IO_CLOSED) {
+ lua_pushnil(L);
+ lua_pushstring(L, udp_strerror(err));
+ if (wanted > sizeof(buf)) free(dgram);
+ return 2;
+ }
+ err = getnameinfo((struct sockaddr *)&addr, addr_len, addrstr,
+ INET6_ADDRSTRLEN, portstr, 6, NI_NUMERICHOST | NI_NUMERICSERV);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, gai_strerror(err));
+ if (wanted > sizeof(buf)) free(dgram);
+ return 2;
+ }
+ lua_pushlstring(L, dgram, got);
+ lua_pushstring(L, addrstr);
+ lua_pushinteger(L, (int) strtol(portstr, (char **) NULL, 10));
+ if (wanted > sizeof(buf)) free(dgram);
+ return 3;
+}
+
+/*-------------------------------------------------------------------------*\
+* Returns family as string
+\*-------------------------------------------------------------------------*/
+static int meth_getfamily(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ if (udp->family == AF_INET6) {
+ lua_pushliteral(L, "inet6");
+ return 1;
+ } else {
+ lua_pushliteral(L, "inet4");
+ return 1;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Select support methods
+\*-------------------------------------------------------------------------*/
+static int meth_getfd(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ lua_pushnumber(L, (int) udp->sock);
+ return 1;
+}
+
+/* this is very dangerous, but can be handy for those that are brave enough */
+static int meth_setfd(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ udp->sock = (t_socket) luaL_checknumber(L, 2);
+ return 0;
+}
+
+static int meth_dirty(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ (void) udp;
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call inet methods
+\*-------------------------------------------------------------------------*/
+static int meth_getpeername(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkclass(L, "udp{connected}", 1);
+ return inet_meth_getpeername(L, &udp->sock, udp->family);
+}
+
+static int meth_getsockname(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ return inet_meth_getsockname(L, &udp->sock, udp->family);
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call option handler
+\*-------------------------------------------------------------------------*/
+static int meth_setoption(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ return opt_meth_setoption(L, optset, &udp->sock);
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call option handler
+\*-------------------------------------------------------------------------*/
+static int meth_getoption(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ return opt_meth_getoption(L, optget, &udp->sock);
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call tm methods
+\*-------------------------------------------------------------------------*/
+static int meth_settimeout(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ return timeout_meth_settimeout(L, &udp->tm);
+}
+
+static int meth_gettimeout(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ return timeout_meth_gettimeout(L, &udp->tm);
+}
+
+/*-------------------------------------------------------------------------*\
+* Turns a master udp object into a client object.
+\*-------------------------------------------------------------------------*/
+static int meth_setpeername(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ p_timeout tm = &udp->tm;
+ const char *address = luaL_checkstring(L, 2);
+ int connecting = strcmp(address, "*");
+ const char *port = connecting? luaL_checkstring(L, 3): "0";
+ struct addrinfo connecthints;
+ const char *err;
+ memset(&connecthints, 0, sizeof(connecthints));
+ connecthints.ai_socktype = SOCK_DGRAM;
+ /* make sure we try to connect only to the same family */
+ connecthints.ai_family = udp->family;
+ if (connecting) {
+ err = inet_tryconnect(&udp->sock, &udp->family, address,
+ port, tm, &connecthints);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ auxiliar_setclass(L, "udp{connected}", 1);
+ } else {
+ /* we ignore possible errors because Mac OS X always
+ * returns EAFNOSUPPORT */
+ inet_trydisconnect(&udp->sock, udp->family, tm);
+ auxiliar_setclass(L, "udp{unconnected}", 1);
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Closes socket used by object
+\*-------------------------------------------------------------------------*/
+static int meth_close(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkgroup(L, "udp{any}", 1);
+ socket_destroy(&udp->sock);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Turns a master object into a server object
+\*-------------------------------------------------------------------------*/
+static int meth_setsockname(lua_State *L) {
+ p_udp udp = (p_udp) auxiliar_checkclass(L, "udp{unconnected}", 1);
+ const char *address = luaL_checkstring(L, 2);
+ const char *port = luaL_checkstring(L, 3);
+ const char *err;
+ struct addrinfo bindhints;
+ memset(&bindhints, 0, sizeof(bindhints));
+ bindhints.ai_socktype = SOCK_DGRAM;
+ bindhints.ai_family = udp->family;
+ bindhints.ai_flags = AI_PASSIVE;
+ err = inet_trybind(&udp->sock, &udp->family, address, port, &bindhints);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*=========================================================================*\
+* Library functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Creates a master udp object
+\*-------------------------------------------------------------------------*/
+static int udp_create(lua_State *L, int family) {
+ /* allocate udp object */
+ p_udp udp = (p_udp) lua_newuserdata(L, sizeof(t_udp));
+ auxiliar_setclass(L, "udp{unconnected}", -1);
+ /* if family is AF_UNSPEC, we leave the socket invalid and
+ * store AF_UNSPEC into family. This will allow it to later be
+ * replaced with an AF_INET6 or AF_INET socket upon first use. */
+ udp->sock = SOCKET_INVALID;
+ timeout_init(&udp->tm, -1, -1);
+ udp->family = family;
+ if (family != AF_UNSPEC) {
+ const char *err = inet_trycreate(&udp->sock, family, SOCK_DGRAM, 0);
+ if (err != NULL) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ socket_setnonblocking(&udp->sock);
+ }
+ return 1;
+}
+
+static int global_create(lua_State *L) {
+ return udp_create(L, AF_UNSPEC);
+}
+
+static int global_create4(lua_State *L) {
+ return udp_create(L, AF_INET);
+}
+
+static int global_create6(lua_State *L) {
+ return udp_create(L, AF_INET6);
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/udp.h b/source/luametatex/source/luacore/luasocket/src/udp.h
new file mode 100644
index 000000000..07d5247fc
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/udp.h
@@ -0,0 +1,39 @@
+#ifndef UDP_H
+#define UDP_H
+/*=========================================================================*\
+* UDP object
+* LuaSocket toolkit
+*
+* The udp.h module provides LuaSocket with support for UDP protocol
+* (AF_INET, SOCK_DGRAM).
+*
+* Two classes are defined: connected and unconnected. UDP objects are
+* originally unconnected. They can be "connected" to a given address
+* with a call to the setpeername function. The same function can be used to
+* break the connection.
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "timeout.h"
+#include "socket.h"
+
+#define UDP_DATAGRAMSIZE 8192
+
+typedef struct t_udp_ {
+ t_socket sock;
+ t_timeout tm;
+ int family;
+} t_udp;
+typedef t_udp *p_udp;
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int udp_open(lua_State *L);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* UDP_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/unix.c b/source/luametatex/source/luacore/luasocket/src/unix.c
new file mode 100644
index 000000000..268d8b212
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/unix.c
@@ -0,0 +1,69 @@
+/*=========================================================================*\
+* Unix domain socket
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "unixstream.h"
+#include "unixdgram.h"
+
+/*-------------------------------------------------------------------------*\
+* Modules and functions
+\*-------------------------------------------------------------------------*/
+static const luaL_Reg mod[] = {
+ {"stream", unixstream_open},
+ {"dgram", unixdgram_open},
+ {NULL, NULL}
+};
+
+static void add_alias(lua_State *L, int index, const char *name, const char *target)
+{
+ lua_getfield(L, index, target);
+ lua_setfield(L, index, name);
+}
+
+static int compat_socket_unix_call(lua_State *L)
+{
+ /* Look up socket.unix.stream in the socket.unix table (which is the first
+ * argument). */
+ lua_getfield(L, 1, "stream");
+
+ /* Replace the stack entry for the socket.unix table with the
+ * socket.unix.stream function. */
+ lua_replace(L, 1);
+
+ /* Call socket.unix.stream, passing along any arguments. */
+ int n = lua_gettop(L);
+ lua_call(L, n-1, LUA_MULTRET);
+
+ /* Pass along the return values from socket.unix.stream. */
+ n = lua_gettop(L);
+ return n;
+}
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+LUASOCKET_API int luaopen_socket_unix(lua_State *L)
+{
+ int i;
+ lua_newtable(L);
+ int socket_unix_table = lua_gettop(L);
+
+ for (i = 0; mod[i].name; i++)
+ mod[i].func(L);
+
+ /* Add backwards compatibility aliases "tcp" and "udp" for the "stream" and
+ * "dgram" functions. */
+ add_alias(L, socket_unix_table, "tcp", "stream");
+ add_alias(L, socket_unix_table, "udp", "dgram");
+
+ /* Add a backwards compatibility function and a metatable setup to call it
+ * for the old socket.unix() interface. */
+ lua_pushcfunction(L, compat_socket_unix_call);
+ lua_setfield(L, socket_unix_table, "__call");
+ lua_pushvalue(L, socket_unix_table);
+ lua_setmetatable(L, socket_unix_table);
+
+ return 1;
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/unix.h b/source/luametatex/source/luacore/luasocket/src/unix.h
new file mode 100644
index 000000000..c20356189
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/unix.h
@@ -0,0 +1,26 @@
+#ifndef UNIX_H
+#define UNIX_H
+/*=========================================================================*\
+* Unix domain object
+* LuaSocket toolkit
+*
+* This module is just an example of how to extend LuaSocket with a new
+* domain.
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "buffer.h"
+#include "timeout.h"
+#include "socket.h"
+
+typedef struct t_unix_ {
+ t_socket sock;
+ t_io io;
+ t_buffer buf;
+ t_timeout tm;
+} t_unix;
+typedef t_unix *p_unix;
+
+LUASOCKET_API int luaopen_socket_unix(lua_State *L);
+
+#endif /* UNIX_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/unixdgram.c b/source/luametatex/source/luacore/luasocket/src/unixdgram.c
new file mode 100644
index 000000000..69093d734
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/unixdgram.c
@@ -0,0 +1,405 @@
+/*=========================================================================*\
+* Unix domain socket dgram submodule
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "auxiliar.h"
+#include "socket.h"
+#include "options.h"
+#include "unix.h"
+
+#include <string.h>
+#include <stdlib.h>
+
+#include <sys/un.h>
+
+#define UNIXDGRAM_DATAGRAMSIZE 8192
+
+/* provide a SUN_LEN macro if sys/un.h doesn't (e.g. Android) */
+#ifndef SUN_LEN
+#define SUN_LEN(ptr) \
+ ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
+ + strlen ((ptr)->sun_path))
+#endif
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int global_create(lua_State *L);
+static int meth_connect(lua_State *L);
+static int meth_bind(lua_State *L);
+static int meth_send(lua_State *L);
+static int meth_receive(lua_State *L);
+static int meth_close(lua_State *L);
+static int meth_setoption(lua_State *L);
+static int meth_settimeout(lua_State *L);
+static int meth_gettimeout(lua_State *L);
+static int meth_getfd(lua_State *L);
+static int meth_setfd(lua_State *L);
+static int meth_dirty(lua_State *L);
+static int meth_receivefrom(lua_State *L);
+static int meth_sendto(lua_State *L);
+static int meth_getsockname(lua_State *L);
+
+static const char *unixdgram_tryconnect(p_unix un, const char *path);
+static const char *unixdgram_trybind(p_unix un, const char *path);
+
+/* unixdgram object methods */
+static luaL_Reg unixdgram_methods[] = {
+ {"__gc", meth_close},
+ {"__tostring", auxiliar_tostring},
+ {"bind", meth_bind},
+ {"close", meth_close},
+ {"connect", meth_connect},
+ {"dirty", meth_dirty},
+ {"getfd", meth_getfd},
+ {"send", meth_send},
+ {"sendto", meth_sendto},
+ {"receive", meth_receive},
+ {"receivefrom", meth_receivefrom},
+ {"setfd", meth_setfd},
+ {"setoption", meth_setoption},
+ {"setpeername", meth_connect},
+ {"setsockname", meth_bind},
+ {"getsockname", meth_getsockname},
+ {"settimeout", meth_settimeout},
+ {"gettimeout", meth_gettimeout},
+ {NULL, NULL}
+};
+
+/* socket option handlers */
+static t_opt optset[] = {
+ {"reuseaddr", opt_set_reuseaddr},
+ {NULL, NULL}
+};
+
+/* functions in library namespace */
+static luaL_Reg func[] = {
+ {"dgram", global_create},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int unixdgram_open(lua_State *L)
+{
+ /* create classes */
+ auxiliar_newclass(L, "unixdgram{connected}", unixdgram_methods);
+ auxiliar_newclass(L, "unixdgram{unconnected}", unixdgram_methods);
+ /* create class groups */
+ auxiliar_add2group(L, "unixdgram{connected}", "unixdgram{any}");
+ auxiliar_add2group(L, "unixdgram{unconnected}", "unixdgram{any}");
+ auxiliar_add2group(L, "unixdgram{connected}", "select{able}");
+ auxiliar_add2group(L, "unixdgram{unconnected}", "select{able}");
+
+ luaL_setfuncs(L, func, 0);
+ return 0;
+}
+
+/*=========================================================================*\
+* Lua methods
+\*=========================================================================*/
+static const char *unixdgram_strerror(int err)
+{
+ /* a 'closed' error on an unconnected means the target address was not
+ * accepted by the transport layer */
+ if (err == IO_CLOSED) return "refused";
+ else return socket_strerror(err);
+}
+
+static int meth_send(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixdgram{connected}", 1);
+ p_timeout tm = &un->tm;
+ size_t count, sent = 0;
+ int err;
+ const char *data = luaL_checklstring(L, 2, &count);
+ timeout_markstart(tm);
+ err = socket_send(&un->sock, data, count, &sent, tm);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, unixdgram_strerror(err));
+ return 2;
+ }
+ lua_pushnumber(L, (lua_Number) sent);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Send data through unconnected unixdgram socket
+\*-------------------------------------------------------------------------*/
+static int meth_sendto(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixdgram{unconnected}", 1);
+ size_t count, sent = 0;
+ const char *data = luaL_checklstring(L, 2, &count);
+ const char *path = luaL_checkstring(L, 3);
+ p_timeout tm = &un->tm;
+ int err;
+ struct sockaddr_un remote;
+ size_t len = strlen(path);
+
+ if (len >= sizeof(remote.sun_path)) {
+ lua_pushnil(L);
+ lua_pushstring(L, "path too long");
+ return 2;
+ }
+
+ memset(&remote, 0, sizeof(remote));
+ strcpy(remote.sun_path, path);
+ remote.sun_family = AF_UNIX;
+ timeout_markstart(tm);
+#ifdef UNIX_HAS_SUN_LEN
+ remote.sun_len = sizeof(remote.sun_family) + sizeof(remote.sun_len)
+ + len + 1;
+ err = socket_sendto(&un->sock, data, count, &sent, (SA *) &remote, remote.sun_len, tm);
+#else
+ err = socket_sendto(&un->sock, data, count, &sent, (SA *) &remote,
+ sizeof(remote.sun_family) + len, tm);
+#endif
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, unixdgram_strerror(err));
+ return 2;
+ }
+ lua_pushnumber(L, (lua_Number) sent);
+ return 1;
+}
+
+static int meth_receive(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ char buf[UNIXDGRAM_DATAGRAMSIZE];
+ size_t got, wanted = (size_t) luaL_optnumber(L, 2, sizeof(buf));
+ char *dgram = wanted > sizeof(buf)? (char *) malloc(wanted): buf;
+ int err;
+ p_timeout tm = &un->tm;
+ timeout_markstart(tm);
+ if (!dgram) {
+ lua_pushnil(L);
+ lua_pushliteral(L, "out of memory");
+ return 2;
+ }
+ err = socket_recv(&un->sock, dgram, wanted, &got, tm);
+ /* Unlike STREAM, recv() of zero is not closed, but a zero-length packet. */
+ if (err != IO_DONE && err != IO_CLOSED) {
+ lua_pushnil(L);
+ lua_pushstring(L, unixdgram_strerror(err));
+ if (wanted > sizeof(buf)) free(dgram);
+ return 2;
+ }
+ lua_pushlstring(L, dgram, got);
+ if (wanted > sizeof(buf)) free(dgram);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Receives data and sender from a DGRAM socket
+\*-------------------------------------------------------------------------*/
+static int meth_receivefrom(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixdgram{unconnected}", 1);
+ char buf[UNIXDGRAM_DATAGRAMSIZE];
+ size_t got, wanted = (size_t) luaL_optnumber(L, 2, sizeof(buf));
+ char *dgram = wanted > sizeof(buf)? (char *) malloc(wanted): buf;
+ struct sockaddr_un addr;
+ socklen_t addr_len = sizeof(addr);
+ int err;
+ p_timeout tm = &un->tm;
+ timeout_markstart(tm);
+ if (!dgram) {
+ lua_pushnil(L);
+ lua_pushliteral(L, "out of memory");
+ return 2;
+ }
+ addr.sun_path[0] = '\0';
+ err = socket_recvfrom(&un->sock, dgram, wanted, &got, (SA *) &addr,
+ &addr_len, tm);
+ /* Unlike STREAM, recv() of zero is not closed, but a zero-length packet. */
+ if (err != IO_DONE && err != IO_CLOSED) {
+ lua_pushnil(L);
+ lua_pushstring(L, unixdgram_strerror(err));
+ if (wanted > sizeof(buf)) free(dgram);
+ return 2;
+ }
+
+ lua_pushlstring(L, dgram, got);
+ /* the path may be empty, when client send without bind */
+ lua_pushstring(L, addr.sun_path);
+ if (wanted > sizeof(buf)) free(dgram);
+ return 2;
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call option handler
+\*-------------------------------------------------------------------------*/
+static int meth_setoption(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ return opt_meth_setoption(L, optset, &un->sock);
+}
+
+/*-------------------------------------------------------------------------*\
+* Select support methods
+\*-------------------------------------------------------------------------*/
+static int meth_getfd(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ lua_pushnumber(L, (int) un->sock);
+ return 1;
+}
+
+/* this is very dangerous, but can be handy for those that are brave enough */
+static int meth_setfd(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ un->sock = (t_socket) luaL_checknumber(L, 2);
+ return 0;
+}
+
+static int meth_dirty(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ (void) un;
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Binds an object to an address
+\*-------------------------------------------------------------------------*/
+static const char *unixdgram_trybind(p_unix un, const char *path) {
+ struct sockaddr_un local;
+ size_t len = strlen(path);
+ if (len >= sizeof(local.sun_path)) return "path too long";
+ memset(&local, 0, sizeof(local));
+ strcpy(local.sun_path, path);
+ local.sun_family = AF_UNIX;
+ size_t addrlen = SUN_LEN(&local);
+#ifdef UNIX_HAS_SUN_LEN
+ local.sun_len = addrlen + 1;
+#endif
+ int err = socket_bind(&un->sock, (SA *) &local, addrlen);
+ if (err != IO_DONE) socket_destroy(&un->sock);
+ return socket_strerror(err);
+}
+
+static int meth_bind(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixdgram{unconnected}", 1);
+ const char *path = luaL_checkstring(L, 2);
+ const char *err = unixdgram_trybind(un, path);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+static int meth_getsockname(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ struct sockaddr_un peer = {0};
+ socklen_t peer_len = sizeof(peer);
+
+ if (getsockname(un->sock, (SA *) &peer, &peer_len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(errno));
+ return 2;
+ }
+
+ lua_pushstring(L, peer.sun_path);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Turns a master unixdgram object into a client object.
+\*-------------------------------------------------------------------------*/
+static const char *unixdgram_tryconnect(p_unix un, const char *path)
+{
+ struct sockaddr_un remote;
+ size_t len = strlen(path);
+ if (len >= sizeof(remote.sun_path)) return "path too long";
+ memset(&remote, 0, sizeof(remote));
+ strcpy(remote.sun_path, path);
+ remote.sun_family = AF_UNIX;
+ timeout_markstart(&un->tm);
+ size_t addrlen = SUN_LEN(&remote);
+#ifdef UNIX_HAS_SUN_LEN
+ remote.sun_len = addrlen + 1;
+#endif
+ int err = socket_connect(&un->sock, (SA *) &remote, addrlen, &un->tm);
+ if (err != IO_DONE) socket_destroy(&un->sock);
+ return socket_strerror(err);
+}
+
+static int meth_connect(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ const char *path = luaL_checkstring(L, 2);
+ const char *err = unixdgram_tryconnect(un, path);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ /* turn unconnected object into a connected object */
+ auxiliar_setclass(L, "unixdgram{connected}", 1);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Closes socket used by object
+\*-------------------------------------------------------------------------*/
+static int meth_close(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ socket_destroy(&un->sock);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call tm methods
+\*-------------------------------------------------------------------------*/
+static int meth_settimeout(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ return timeout_meth_settimeout(L, &un->tm);
+}
+
+static int meth_gettimeout(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixdgram{any}", 1);
+ return timeout_meth_gettimeout(L, &un->tm);
+}
+
+/*=========================================================================*\
+* Library functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Creates a master unixdgram object
+\*-------------------------------------------------------------------------*/
+static int global_create(lua_State *L)
+{
+ t_socket sock;
+ int err = socket_create(&sock, AF_UNIX, SOCK_DGRAM, 0);
+ /* try to allocate a system socket */
+ if (err == IO_DONE) {
+ /* allocate unixdgram object */
+ p_unix un = (p_unix) lua_newuserdata(L, sizeof(t_unix));
+ /* set its type as master object */
+ auxiliar_setclass(L, "unixdgram{unconnected}", -1);
+ /* initialize remaining structure fields */
+ socket_setnonblocking(&sock);
+ un->sock = sock;
+ io_init(&un->io, (p_send) socket_send, (p_recv) socket_recv,
+ (p_error) socket_ioerror, &un->sock);
+ timeout_init(&un->tm, -1, -1);
+ buffer_init(&un->buf, &un->io, &un->tm);
+ return 1;
+ } else {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(err));
+ return 2;
+ }
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/unixdgram.h b/source/luametatex/source/luacore/luasocket/src/unixdgram.h
new file mode 100644
index 000000000..a1a0166bd
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/unixdgram.h
@@ -0,0 +1,28 @@
+#ifndef UNIXDGRAM_H
+#define UNIXDGRAM_H
+/*=========================================================================*\
+* DGRAM object
+* LuaSocket toolkit
+*
+* The dgram.h module provides LuaSocket with support for DGRAM protocol
+* (AF_INET, SOCK_DGRAM).
+*
+* Two classes are defined: connected and unconnected. DGRAM objects are
+* originally unconnected. They can be "connected" to a given address
+* with a call to the setpeername function. The same function can be used to
+* break the connection.
+\*=========================================================================*/
+
+#include "unix.h"
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int unixdgram_open(lua_State *L);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* UNIXDGRAM_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/unixstream.c b/source/luametatex/source/luacore/luasocket/src/unixstream.c
new file mode 100644
index 000000000..02aced9c8
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/unixstream.c
@@ -0,0 +1,355 @@
+/*=========================================================================*\
+* Unix domain socket stream sub module
+* LuaSocket toolkit
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "auxiliar.h"
+#include "socket.h"
+#include "options.h"
+#include "unixstream.h"
+
+#include <string.h>
+#include <sys/un.h>
+
+/*=========================================================================*\
+* Internal function prototypes
+\*=========================================================================*/
+static int global_create(lua_State *L);
+static int meth_connect(lua_State *L);
+static int meth_listen(lua_State *L);
+static int meth_bind(lua_State *L);
+static int meth_send(lua_State *L);
+static int meth_shutdown(lua_State *L);
+static int meth_receive(lua_State *L);
+static int meth_accept(lua_State *L);
+static int meth_close(lua_State *L);
+static int meth_setoption(lua_State *L);
+static int meth_settimeout(lua_State *L);
+static int meth_getfd(lua_State *L);
+static int meth_setfd(lua_State *L);
+static int meth_dirty(lua_State *L);
+static int meth_getstats(lua_State *L);
+static int meth_setstats(lua_State *L);
+static int meth_getsockname(lua_State *L);
+
+static const char *unixstream_tryconnect(p_unix un, const char *path);
+static const char *unixstream_trybind(p_unix un, const char *path);
+
+/* unixstream object methods */
+static luaL_Reg unixstream_methods[] = {
+ {"__gc", meth_close},
+ {"__tostring", auxiliar_tostring},
+ {"accept", meth_accept},
+ {"bind", meth_bind},
+ {"close", meth_close},
+ {"connect", meth_connect},
+ {"dirty", meth_dirty},
+ {"getfd", meth_getfd},
+ {"getstats", meth_getstats},
+ {"setstats", meth_setstats},
+ {"listen", meth_listen},
+ {"receive", meth_receive},
+ {"send", meth_send},
+ {"setfd", meth_setfd},
+ {"setoption", meth_setoption},
+ {"setpeername", meth_connect},
+ {"setsockname", meth_bind},
+ {"getsockname", meth_getsockname},
+ {"settimeout", meth_settimeout},
+ {"shutdown", meth_shutdown},
+ {NULL, NULL}
+};
+
+/* socket option handlers */
+static t_opt optset[] = {
+ {"keepalive", opt_set_keepalive},
+ {"reuseaddr", opt_set_reuseaddr},
+ {"linger", opt_set_linger},
+ {NULL, NULL}
+};
+
+/* functions in library namespace */
+static luaL_Reg func[] = {
+ {"stream", global_create},
+ {NULL, NULL}
+};
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int unixstream_open(lua_State *L)
+{
+ /* create classes */
+ auxiliar_newclass(L, "unixstream{master}", unixstream_methods);
+ auxiliar_newclass(L, "unixstream{client}", unixstream_methods);
+ auxiliar_newclass(L, "unixstream{server}", unixstream_methods);
+
+ /* create class groups */
+ auxiliar_add2group(L, "unixstream{master}", "unixstream{any}");
+ auxiliar_add2group(L, "unixstream{client}", "unixstream{any}");
+ auxiliar_add2group(L, "unixstream{server}", "unixstream{any}");
+
+ luaL_setfuncs(L, func, 0);
+ return 0;
+}
+
+/*=========================================================================*\
+* Lua methods
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Just call buffered IO methods
+\*-------------------------------------------------------------------------*/
+static int meth_send(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{client}", 1);
+ return buffer_meth_send(L, &un->buf);
+}
+
+static int meth_receive(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{client}", 1);
+ return buffer_meth_receive(L, &un->buf);
+}
+
+static int meth_getstats(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{client}", 1);
+ return buffer_meth_getstats(L, &un->buf);
+}
+
+static int meth_setstats(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{client}", 1);
+ return buffer_meth_setstats(L, &un->buf);
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call option handler
+\*-------------------------------------------------------------------------*/
+static int meth_setoption(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ return opt_meth_setoption(L, optset, &un->sock);
+}
+
+/*-------------------------------------------------------------------------*\
+* Select support methods
+\*-------------------------------------------------------------------------*/
+static int meth_getfd(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ lua_pushnumber(L, (int) un->sock);
+ return 1;
+}
+
+/* this is very dangerous, but can be handy for those that are brave enough */
+static int meth_setfd(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ un->sock = (t_socket) luaL_checknumber(L, 2);
+ return 0;
+}
+
+static int meth_dirty(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ lua_pushboolean(L, !buffer_isempty(&un->buf));
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Waits for and returns a client object attempting connection to the
+* server object
+\*-------------------------------------------------------------------------*/
+static int meth_accept(lua_State *L) {
+ p_unix server = (p_unix) auxiliar_checkclass(L, "unixstream{server}", 1);
+ p_timeout tm = timeout_markstart(&server->tm);
+ t_socket sock;
+ int err = socket_accept(&server->sock, &sock, NULL, NULL, tm);
+ /* if successful, push client socket */
+ if (err == IO_DONE) {
+ p_unix clnt = (p_unix) lua_newuserdata(L, sizeof(t_unix));
+ auxiliar_setclass(L, "unixstream{client}", -1);
+ /* initialize structure fields */
+ socket_setnonblocking(&sock);
+ clnt->sock = sock;
+ io_init(&clnt->io, (p_send)socket_send, (p_recv)socket_recv,
+ (p_error) socket_ioerror, &clnt->sock);
+ timeout_init(&clnt->tm, -1, -1);
+ buffer_init(&clnt->buf, &clnt->io, &clnt->tm);
+ return 1;
+ } else {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(err));
+ return 2;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Binds an object to an address
+\*-------------------------------------------------------------------------*/
+static const char *unixstream_trybind(p_unix un, const char *path) {
+ struct sockaddr_un local;
+ size_t len = strlen(path);
+ int err;
+ if (len >= sizeof(local.sun_path)) return "path too long";
+ memset(&local, 0, sizeof(local));
+ strcpy(local.sun_path, path);
+ local.sun_family = AF_UNIX;
+#ifdef UNIX_HAS_SUN_LEN
+ local.sun_len = sizeof(local.sun_family) + sizeof(local.sun_len)
+ + len + 1;
+ err = socket_bind(&un->sock, (SA *) &local, local.sun_len);
+
+#else
+ err = socket_bind(&un->sock, (SA *) &local,
+ sizeof(local.sun_family) + len);
+#endif
+ if (err != IO_DONE) socket_destroy(&un->sock);
+ return socket_strerror(err);
+}
+
+static int meth_bind(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{master}", 1);
+ const char *path = luaL_checkstring(L, 2);
+ const char *err = unixstream_trybind(un, path);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+static int meth_getsockname(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ struct sockaddr_un peer = {0};
+ socklen_t peer_len = sizeof(peer);
+
+ if (getsockname(un->sock, (SA *) &peer, &peer_len) < 0) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(errno));
+ return 2;
+ }
+
+ lua_pushstring(L, peer.sun_path);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Turns a master unixstream object into a client object.
+\*-------------------------------------------------------------------------*/
+static const char *unixstream_tryconnect(p_unix un, const char *path)
+{
+ struct sockaddr_un remote;
+ int err;
+ size_t len = strlen(path);
+ if (len >= sizeof(remote.sun_path)) return "path too long";
+ memset(&remote, 0, sizeof(remote));
+ strcpy(remote.sun_path, path);
+ remote.sun_family = AF_UNIX;
+ timeout_markstart(&un->tm);
+#ifdef UNIX_HAS_SUN_LEN
+ remote.sun_len = sizeof(remote.sun_family) + sizeof(remote.sun_len)
+ + len + 1;
+ err = socket_connect(&un->sock, (SA *) &remote, remote.sun_len, &un->tm);
+#else
+ err = socket_connect(&un->sock, (SA *) &remote,
+ sizeof(remote.sun_family) + len, &un->tm);
+#endif
+ if (err != IO_DONE) socket_destroy(&un->sock);
+ return socket_strerror(err);
+}
+
+static int meth_connect(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{master}", 1);
+ const char *path = luaL_checkstring(L, 2);
+ const char *err = unixstream_tryconnect(un, path);
+ if (err) {
+ lua_pushnil(L);
+ lua_pushstring(L, err);
+ return 2;
+ }
+ /* turn master object into a client object */
+ auxiliar_setclass(L, "unixstream{client}", 1);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Closes socket used by object
+\*-------------------------------------------------------------------------*/
+static int meth_close(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ socket_destroy(&un->sock);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Puts the sockt in listen mode
+\*-------------------------------------------------------------------------*/
+static int meth_listen(lua_State *L)
+{
+ p_unix un = (p_unix) auxiliar_checkclass(L, "unixstream{master}", 1);
+ int backlog = (int) luaL_optnumber(L, 2, 32);
+ int err = socket_listen(&un->sock, backlog);
+ if (err != IO_DONE) {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(err));
+ return 2;
+ }
+ /* turn master object into a server object */
+ auxiliar_setclass(L, "unixstream{server}", 1);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Shuts the connection down partially
+\*-------------------------------------------------------------------------*/
+static int meth_shutdown(lua_State *L)
+{
+ /* SHUT_RD, SHUT_WR, SHUT_RDWR have the value 0, 1, 2, so we can use method index directly */
+ static const char* methods[] = { "receive", "send", "both", NULL };
+ p_unix stream = (p_unix) auxiliar_checkclass(L, "unixstream{client}", 1);
+ int how = luaL_checkoption(L, 2, "both", methods);
+ socket_shutdown(&stream->sock, how);
+ lua_pushnumber(L, 1);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Just call tm methods
+\*-------------------------------------------------------------------------*/
+static int meth_settimeout(lua_State *L) {
+ p_unix un = (p_unix) auxiliar_checkgroup(L, "unixstream{any}", 1);
+ return timeout_meth_settimeout(L, &un->tm);
+}
+
+/*=========================================================================*\
+* Library functions
+\*=========================================================================*/
+/*-------------------------------------------------------------------------*\
+* Creates a master unixstream object
+\*-------------------------------------------------------------------------*/
+static int global_create(lua_State *L) {
+ t_socket sock;
+ int err = socket_create(&sock, AF_UNIX, SOCK_STREAM, 0);
+ /* try to allocate a system socket */
+ if (err == IO_DONE) {
+ /* allocate unixstream object */
+ p_unix un = (p_unix) lua_newuserdata(L, sizeof(t_unix));
+ /* set its type as master object */
+ auxiliar_setclass(L, "unixstream{master}", -1);
+ /* initialize remaining structure fields */
+ socket_setnonblocking(&sock);
+ un->sock = sock;
+ io_init(&un->io, (p_send) socket_send, (p_recv) socket_recv,
+ (p_error) socket_ioerror, &un->sock);
+ timeout_init(&un->tm, -1, -1);
+ buffer_init(&un->buf, &un->io, &un->tm);
+ return 1;
+ } else {
+ lua_pushnil(L);
+ lua_pushstring(L, socket_strerror(err));
+ return 2;
+ }
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/unixstream.h b/source/luametatex/source/luacore/luasocket/src/unixstream.h
new file mode 100644
index 000000000..7916affa7
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/unixstream.h
@@ -0,0 +1,29 @@
+#ifndef UNIXSTREAM_H
+#define UNIXSTREAM_H
+/*=========================================================================*\
+* UNIX STREAM object
+* LuaSocket toolkit
+*
+* The unixstream.h module is basicly a glue that puts together modules buffer.h,
+* timeout.h socket.h and inet.h to provide the LuaSocket UNIX STREAM (AF_UNIX,
+* SOCK_STREAM) support.
+*
+* Three classes are defined: master, client and server. The master class is
+* a newly created unixstream object, that has not been bound or connected. Server
+* objects are unixstream objects bound to some local address. Client objects are
+* unixstream objects either connected to some address or returned by the accept
+* method of a server object.
+\*=========================================================================*/
+#include "unix.h"
+
+#ifndef _WIN32
+#pragma GCC visibility push(hidden)
+#endif
+
+int unixstream_open(lua_State *L);
+
+#ifndef _WIN32
+#pragma GCC visibility pop
+#endif
+
+#endif /* UNIXSTREAM_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/usocket.c b/source/luametatex/source/luacore/luasocket/src/usocket.c
new file mode 100644
index 000000000..2245cdd05
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/usocket.c
@@ -0,0 +1,454 @@
+/*=========================================================================*\
+* Socket compatibilization module for Unix
+* LuaSocket toolkit
+*
+* The code is now interrupt-safe.
+* The penalty of calling select to avoid busy-wait is only paid when
+* the I/O call fail in the first place.
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include "socket.h"
+#include "pierror.h"
+
+#include <string.h>
+#include <signal.h>
+
+/*-------------------------------------------------------------------------*\
+* Wait for readable/writable/connected socket with timeout
+\*-------------------------------------------------------------------------*/
+#ifndef SOCKET_SELECT
+#include <sys/poll.h>
+
+#define WAITFD_R POLLIN
+#define WAITFD_W POLLOUT
+#define WAITFD_C (POLLIN|POLLOUT)
+int socket_waitfd(p_socket ps, int sw, p_timeout tm) {
+ int ret;
+ struct pollfd pfd;
+ pfd.fd = *ps;
+ pfd.events = sw;
+ pfd.revents = 0;
+ if (timeout_iszero(tm)) return IO_TIMEOUT; /* optimize timeout == 0 case */
+ do {
+ int t = (int)(timeout_getretry(tm)*1e3);
+ ret = poll(&pfd, 1, t >= 0? t: -1);
+ } while (ret == -1 && errno == EINTR);
+ if (ret == -1) return errno;
+ if (ret == 0) return IO_TIMEOUT;
+ if (sw == WAITFD_C && (pfd.revents & (POLLIN|POLLERR))) return IO_CLOSED;
+ return IO_DONE;
+}
+#else
+
+#define WAITFD_R 1
+#define WAITFD_W 2
+#define WAITFD_C (WAITFD_R|WAITFD_W)
+
+int socket_waitfd(p_socket ps, int sw, p_timeout tm) {
+ int ret;
+ fd_set rfds, wfds, *rp, *wp;
+ struct timeval tv, *tp;
+ double t;
+ if (*ps >= FD_SETSIZE) return EINVAL;
+ if (timeout_iszero(tm)) return IO_TIMEOUT; /* optimize timeout == 0 case */
+ do {
+ /* must set bits within loop, because select may have modifed them */
+ rp = wp = NULL;
+ if (sw & WAITFD_R) { FD_ZERO(&rfds); FD_SET(*ps, &rfds); rp = &rfds; }
+ if (sw & WAITFD_W) { FD_ZERO(&wfds); FD_SET(*ps, &wfds); wp = &wfds; }
+ t = timeout_getretry(tm);
+ tp = NULL;
+ if (t >= 0.0) {
+ tv.tv_sec = (int)t;
+ tv.tv_usec = (int)((t-tv.tv_sec)*1.0e6);
+ tp = &tv;
+ }
+ ret = select(*ps+1, rp, wp, NULL, tp);
+ } while (ret == -1 && errno == EINTR);
+ if (ret == -1) return errno;
+ if (ret == 0) return IO_TIMEOUT;
+ if (sw == WAITFD_C && FD_ISSET(*ps, &rfds)) return IO_CLOSED;
+ return IO_DONE;
+}
+#endif
+
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int socket_open(void) {
+ /* installs a handler to ignore sigpipe or it will crash us */
+ signal(SIGPIPE, SIG_IGN);
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Close module
+\*-------------------------------------------------------------------------*/
+int socket_close(void) {
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Close and inutilize socket
+\*-------------------------------------------------------------------------*/
+void socket_destroy(p_socket ps) {
+ if (*ps != SOCKET_INVALID) {
+ close(*ps);
+ *ps = SOCKET_INVALID;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Select with timeout control
+\*-------------------------------------------------------------------------*/
+int socket_select(t_socket n, fd_set *rfds, fd_set *wfds, fd_set *efds,
+ p_timeout tm) {
+ int ret;
+ do {
+ struct timeval tv;
+ double t = timeout_getretry(tm);
+ tv.tv_sec = (int) t;
+ tv.tv_usec = (int) ((t - tv.tv_sec) * 1.0e6);
+ /* timeout = 0 means no wait */
+ ret = select(n, rfds, wfds, efds, t >= 0.0 ? &tv: NULL);
+ } while (ret < 0 && errno == EINTR);
+ return ret;
+}
+
+/*-------------------------------------------------------------------------*\
+* Creates and sets up a socket
+\*-------------------------------------------------------------------------*/
+int socket_create(p_socket ps, int domain, int type, int protocol) {
+ *ps = socket(domain, type, protocol);
+ if (*ps != SOCKET_INVALID) return IO_DONE;
+ else return errno;
+}
+
+/*-------------------------------------------------------------------------*\
+* Binds or returns error message
+\*-------------------------------------------------------------------------*/
+int socket_bind(p_socket ps, SA *addr, socklen_t len) {
+ int err = IO_DONE;
+ socket_setblocking(ps);
+ if (bind(*ps, addr, len) < 0) err = errno;
+ socket_setnonblocking(ps);
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+*
+\*-------------------------------------------------------------------------*/
+int socket_listen(p_socket ps, int backlog) {
+ int err = IO_DONE;
+ if (listen(*ps, backlog)) err = errno;
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+*
+\*-------------------------------------------------------------------------*/
+void socket_shutdown(p_socket ps, int how) {
+ shutdown(*ps, how);
+}
+
+/*-------------------------------------------------------------------------*\
+* Connects or returns error message
+\*-------------------------------------------------------------------------*/
+int socket_connect(p_socket ps, SA *addr, socklen_t len, p_timeout tm) {
+ int err;
+ /* avoid calling on closed sockets */
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ /* call connect until done or failed without being interrupted */
+ do if (connect(*ps, addr, len) == 0) return IO_DONE;
+ while ((err = errno) == EINTR);
+ /* if connection failed immediately, return error code */
+ if (err != EINPROGRESS && err != EAGAIN) return err;
+ /* zero timeout case optimization */
+ if (timeout_iszero(tm)) return IO_TIMEOUT;
+ /* wait until we have the result of the connection attempt or timeout */
+ err = socket_waitfd(ps, WAITFD_C, tm);
+ if (err == IO_CLOSED) {
+ if (recv(*ps, (char *) &err, 0, 0) == 0) return IO_DONE;
+ else return errno;
+ } else return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Accept with timeout
+\*-------------------------------------------------------------------------*/
+int socket_accept(p_socket ps, p_socket pa, SA *addr, socklen_t *len, p_timeout tm) {
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ int err;
+ if ((*pa = accept(*ps, addr, len)) != SOCKET_INVALID) return IO_DONE;
+ err = errno;
+ if (err == EINTR) continue;
+ if (err != EAGAIN && err != ECONNABORTED) return err;
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+ /* can't reach here */
+ return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Send with timeout
+\*-------------------------------------------------------------------------*/
+int socket_send(p_socket ps, const char *data, size_t count,
+ size_t *sent, p_timeout tm)
+{
+ int err;
+ *sent = 0;
+ /* avoid making system calls on closed sockets */
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ /* loop until we send something or we give up on error */
+ for ( ;; ) {
+ long put = (long) send(*ps, data, count, 0);
+ /* if we sent anything, we are done */
+ if (put >= 0) {
+ *sent = put;
+ return IO_DONE;
+ }
+ err = errno;
+ /* EPIPE means the connection was closed */
+ if (err == EPIPE) return IO_CLOSED;
+ /* EPROTOTYPE means the connection is being closed (on Yosemite!)*/
+ if (err == EPROTOTYPE) continue;
+ /* we call was interrupted, just try again */
+ if (err == EINTR) continue;
+ /* if failed fatal reason, report error */
+ if (err != EAGAIN) return err;
+ /* wait until we can send something or we timeout */
+ if ((err = socket_waitfd(ps, WAITFD_W, tm)) != IO_DONE) return err;
+ }
+ /* can't reach here */
+ return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Sendto with timeout
+\*-------------------------------------------------------------------------*/
+int socket_sendto(p_socket ps, const char *data, size_t count, size_t *sent,
+ SA *addr, socklen_t len, p_timeout tm)
+{
+ int err;
+ *sent = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ long put = (long) sendto(*ps, data, count, 0, addr, len);
+ if (put >= 0) {
+ *sent = put;
+ return IO_DONE;
+ }
+ err = errno;
+ if (err == EPIPE) return IO_CLOSED;
+ if (err == EPROTOTYPE) continue;
+ if (err == EINTR) continue;
+ if (err != EAGAIN) return err;
+ if ((err = socket_waitfd(ps, WAITFD_W, tm)) != IO_DONE) return err;
+ }
+ return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Receive with timeout
+\*-------------------------------------------------------------------------*/
+int socket_recv(p_socket ps, char *data, size_t count, size_t *got, p_timeout tm) {
+ int err;
+ *got = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ long taken = (long) recv(*ps, data, count, 0);
+ if (taken > 0) {
+ *got = taken;
+ return IO_DONE;
+ }
+ err = errno;
+ if (taken == 0) return IO_CLOSED;
+ if (err == EINTR) continue;
+ if (err != EAGAIN) return err;
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+ return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Recvfrom with timeout
+\*-------------------------------------------------------------------------*/
+int socket_recvfrom(p_socket ps, char *data, size_t count, size_t *got,
+ SA *addr, socklen_t *len, p_timeout tm) {
+ int err;
+ *got = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ long taken = (long) recvfrom(*ps, data, count, 0, addr, len);
+ if (taken > 0) {
+ *got = taken;
+ return IO_DONE;
+ }
+ err = errno;
+ if (taken == 0) return IO_CLOSED;
+ if (err == EINTR) continue;
+ if (err != EAGAIN) return err;
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+ return IO_UNKNOWN;
+}
+
+
+/*-------------------------------------------------------------------------*\
+* Write with timeout
+*
+* socket_read and socket_write are cut-n-paste of socket_send and socket_recv,
+* with send/recv replaced with write/read. We can't just use write/read
+* in the socket version, because behaviour when size is zero is different.
+\*-------------------------------------------------------------------------*/
+int socket_write(p_socket ps, const char *data, size_t count,
+ size_t *sent, p_timeout tm)
+{
+ int err;
+ *sent = 0;
+ /* avoid making system calls on closed sockets */
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ /* loop until we send something or we give up on error */
+ for ( ;; ) {
+ long put = (long) write(*ps, data, count);
+ /* if we sent anything, we are done */
+ if (put >= 0) {
+ *sent = put;
+ return IO_DONE;
+ }
+ err = errno;
+ /* EPIPE means the connection was closed */
+ if (err == EPIPE) return IO_CLOSED;
+ /* EPROTOTYPE means the connection is being closed (on Yosemite!)*/
+ if (err == EPROTOTYPE) continue;
+ /* we call was interrupted, just try again */
+ if (err == EINTR) continue;
+ /* if failed fatal reason, report error */
+ if (err != EAGAIN) return err;
+ /* wait until we can send something or we timeout */
+ if ((err = socket_waitfd(ps, WAITFD_W, tm)) != IO_DONE) return err;
+ }
+ /* can't reach here */
+ return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Read with timeout
+* See note for socket_write
+\*-------------------------------------------------------------------------*/
+int socket_read(p_socket ps, char *data, size_t count, size_t *got, p_timeout tm) {
+ int err;
+ *got = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ long taken = (long) read(*ps, data, count);
+ if (taken > 0) {
+ *got = taken;
+ return IO_DONE;
+ }
+ err = errno;
+ if (taken == 0) return IO_CLOSED;
+ if (err == EINTR) continue;
+ if (err != EAGAIN) return err;
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+ return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Put socket into blocking mode
+\*-------------------------------------------------------------------------*/
+void socket_setblocking(p_socket ps) {
+ int flags = fcntl(*ps, F_GETFL, 0);
+ flags &= (~(O_NONBLOCK));
+ fcntl(*ps, F_SETFL, flags);
+}
+
+/*-------------------------------------------------------------------------*\
+* Put socket into non-blocking mode
+\*-------------------------------------------------------------------------*/
+void socket_setnonblocking(p_socket ps) {
+ int flags = fcntl(*ps, F_GETFL, 0);
+ flags |= O_NONBLOCK;
+ fcntl(*ps, F_SETFL, flags);
+}
+
+/*-------------------------------------------------------------------------*\
+* DNS helpers
+\*-------------------------------------------------------------------------*/
+int socket_gethostbyaddr(const char *addr, socklen_t len, struct hostent **hp) {
+ *hp = gethostbyaddr(addr, len, AF_INET);
+ if (*hp) return IO_DONE;
+ else if (h_errno) return h_errno;
+ else if (errno) return errno;
+ else return IO_UNKNOWN;
+}
+
+int socket_gethostbyname(const char *addr, struct hostent **hp) {
+ *hp = gethostbyname(addr);
+ if (*hp) return IO_DONE;
+ else if (h_errno) return h_errno;
+ else if (errno) return errno;
+ else return IO_UNKNOWN;
+}
+
+/*-------------------------------------------------------------------------*\
+* Error translation functions
+* Make sure important error messages are standard
+\*-------------------------------------------------------------------------*/
+const char *socket_hoststrerror(int err) {
+ if (err <= 0) return io_strerror(err);
+ switch (err) {
+ case HOST_NOT_FOUND: return PIE_HOST_NOT_FOUND;
+ default: return hstrerror(err);
+ }
+}
+
+const char *socket_strerror(int err) {
+ if (err <= 0) return io_strerror(err);
+ switch (err) {
+ case EADDRINUSE: return PIE_ADDRINUSE;
+ case EISCONN: return PIE_ISCONN;
+ case EACCES: return PIE_ACCESS;
+ case ECONNREFUSED: return PIE_CONNREFUSED;
+ case ECONNABORTED: return PIE_CONNABORTED;
+ case ECONNRESET: return PIE_CONNRESET;
+ case ETIMEDOUT: return PIE_TIMEDOUT;
+ default: {
+ return strerror(err);
+ }
+ }
+}
+
+const char *socket_ioerror(p_socket ps, int err) {
+ (void) ps;
+ return socket_strerror(err);
+}
+
+const char *socket_gaistrerror(int err) {
+ if (err == 0) return NULL;
+ switch (err) {
+ case EAI_AGAIN: return PIE_AGAIN;
+ case EAI_BADFLAGS: return PIE_BADFLAGS;
+#ifdef EAI_BADHINTS
+ case EAI_BADHINTS: return PIE_BADHINTS;
+#endif
+ case EAI_FAIL: return PIE_FAIL;
+ case EAI_FAMILY: return PIE_FAMILY;
+ case EAI_MEMORY: return PIE_MEMORY;
+ case EAI_NONAME: return PIE_NONAME;
+#ifdef EAI_OVERFLOW
+ case EAI_OVERFLOW: return PIE_OVERFLOW;
+#endif
+#ifdef EAI_PROTOCOL
+ case EAI_PROTOCOL: return PIE_PROTOCOL;
+#endif
+ case EAI_SERVICE: return PIE_SERVICE;
+ case EAI_SOCKTYPE: return PIE_SOCKTYPE;
+ case EAI_SYSTEM: return strerror(errno);
+ default: return gai_strerror(err);
+ }
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/usocket.h b/source/luametatex/source/luacore/luasocket/src/usocket.h
new file mode 100644
index 000000000..45f2f99f7
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/usocket.h
@@ -0,0 +1,59 @@
+#ifndef USOCKET_H
+#define USOCKET_H
+/*=========================================================================*\
+* Socket compatibilization module for Unix
+* LuaSocket toolkit
+\*=========================================================================*/
+
+/*=========================================================================*\
+* BSD include files
+\*=========================================================================*/
+/* error codes */
+#include <errno.h>
+/* close function */
+#include <unistd.h>
+/* fnctnl function and associated constants */
+#include <fcntl.h>
+/* struct sockaddr */
+#include <sys/types.h>
+/* socket function */
+#include <sys/socket.h>
+/* struct timeval */
+#include <sys/time.h>
+/* gethostbyname and gethostbyaddr functions */
+#include <netdb.h>
+/* sigpipe handling */
+#include <signal.h>
+/* IP stuff*/
+#include <netinet/in.h>
+#include <arpa/inet.h>
+/* TCP options (nagle algorithm disable) */
+#include <netinet/tcp.h>
+#include <net/if.h>
+
+#ifndef SO_REUSEPORT
+#define SO_REUSEPORT SO_REUSEADDR
+#endif
+
+/* Some platforms use IPV6_JOIN_GROUP instead if
+ * IPV6_ADD_MEMBERSHIP. The semantics are same, though. */
+#ifndef IPV6_ADD_MEMBERSHIP
+#ifdef IPV6_JOIN_GROUP
+#define IPV6_ADD_MEMBERSHIP IPV6_JOIN_GROUP
+#endif /* IPV6_JOIN_GROUP */
+#endif /* !IPV6_ADD_MEMBERSHIP */
+
+/* Same with IPV6_DROP_MEMBERSHIP / IPV6_LEAVE_GROUP. */
+#ifndef IPV6_DROP_MEMBERSHIP
+#ifdef IPV6_LEAVE_GROUP
+#define IPV6_DROP_MEMBERSHIP IPV6_LEAVE_GROUP
+#endif /* IPV6_LEAVE_GROUP */
+#endif /* !IPV6_DROP_MEMBERSHIP */
+
+typedef int t_socket;
+typedef t_socket *p_socket;
+typedef struct sockaddr_storage t_sockaddr_storage;
+
+#define SOCKET_INVALID (-1)
+
+#endif /* USOCKET_H */
diff --git a/source/luametatex/source/luacore/luasocket/src/wsocket.c b/source/luametatex/source/luacore/luasocket/src/wsocket.c
new file mode 100644
index 000000000..7cd41159d
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/wsocket.c
@@ -0,0 +1,434 @@
+/*=========================================================================*\
+* Socket compatibilization module for Win32
+* LuaSocket toolkit
+*
+* The penalty of calling select to avoid busy-wait is only paid when
+* the I/O call fail in the first place.
+\*=========================================================================*/
+#include "luasocket.h"
+
+#include <string.h>
+
+#include "socket.h"
+#include "pierror.h"
+
+/* WinSock doesn't have a strerror... */
+static const char *wstrerror(int err);
+
+/*-------------------------------------------------------------------------*\
+* Initializes module
+\*-------------------------------------------------------------------------*/
+int socket_open(void) {
+ WSADATA wsaData;
+ WORD wVersionRequested = MAKEWORD(2, 0);
+ int err = WSAStartup(wVersionRequested, &wsaData );
+ if (err != 0) return 0;
+ if ((LOBYTE(wsaData.wVersion) != 2 || HIBYTE(wsaData.wVersion) != 0) &&
+ (LOBYTE(wsaData.wVersion) != 1 || HIBYTE(wsaData.wVersion) != 1)) {
+ WSACleanup();
+ return 0;
+ }
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Close module
+\*-------------------------------------------------------------------------*/
+int socket_close(void) {
+ WSACleanup();
+ return 1;
+}
+
+/*-------------------------------------------------------------------------*\
+* Wait for readable/writable/connected socket with timeout
+\*-------------------------------------------------------------------------*/
+#define WAITFD_R 1
+#define WAITFD_W 2
+#define WAITFD_E 4
+#define WAITFD_C (WAITFD_E|WAITFD_W)
+
+int socket_waitfd(p_socket ps, int sw, p_timeout tm) {
+ int ret;
+ fd_set rfds, wfds, efds, *rp = NULL, *wp = NULL, *ep = NULL;
+ struct timeval tv, *tp = NULL;
+ double t;
+ if (timeout_iszero(tm)) return IO_TIMEOUT; /* optimize timeout == 0 case */
+ if (sw & WAITFD_R) {
+ FD_ZERO(&rfds);
+ FD_SET(*ps, &rfds);
+ rp = &rfds;
+ }
+ if (sw & WAITFD_W) { FD_ZERO(&wfds); FD_SET(*ps, &wfds); wp = &wfds; }
+ if (sw & WAITFD_C) { FD_ZERO(&efds); FD_SET(*ps, &efds); ep = &efds; }
+ if ((t = timeout_get(tm)) >= 0.0) {
+ tv.tv_sec = (int) t;
+ tv.tv_usec = (int) ((t-tv.tv_sec)*1.0e6);
+ tp = &tv;
+ }
+ ret = select(0, rp, wp, ep, tp);
+ if (ret == -1) return WSAGetLastError();
+ if (ret == 0) return IO_TIMEOUT;
+ if (sw == WAITFD_C && FD_ISSET(*ps, &efds)) return IO_CLOSED;
+ return IO_DONE;
+}
+
+/*-------------------------------------------------------------------------*\
+* Select with int timeout in ms
+\*-------------------------------------------------------------------------*/
+int socket_select(t_socket n, fd_set *rfds, fd_set *wfds, fd_set *efds,
+ p_timeout tm) {
+ struct timeval tv;
+ double t = timeout_get(tm);
+ tv.tv_sec = (int) t;
+ tv.tv_usec = (int) ((t - tv.tv_sec) * 1.0e6);
+ if (n <= 0) {
+ Sleep((DWORD) (1000*t));
+ return 0;
+ } else return select(0, rfds, wfds, efds, t >= 0.0? &tv: NULL);
+}
+
+/*-------------------------------------------------------------------------*\
+* Close and inutilize socket
+\*-------------------------------------------------------------------------*/
+void socket_destroy(p_socket ps) {
+ if (*ps != SOCKET_INVALID) {
+ socket_setblocking(ps); /* close can take a long time on WIN32 */
+ closesocket(*ps);
+ *ps = SOCKET_INVALID;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+*
+\*-------------------------------------------------------------------------*/
+void socket_shutdown(p_socket ps, int how) {
+ socket_setblocking(ps);
+ shutdown(*ps, how);
+ socket_setnonblocking(ps);
+}
+
+/*-------------------------------------------------------------------------*\
+* Creates and sets up a socket
+\*-------------------------------------------------------------------------*/
+int socket_create(p_socket ps, int domain, int type, int protocol) {
+ *ps = socket(domain, type, protocol);
+ if (*ps != SOCKET_INVALID) return IO_DONE;
+ else return WSAGetLastError();
+}
+
+/*-------------------------------------------------------------------------*\
+* Connects or returns error message
+\*-------------------------------------------------------------------------*/
+int socket_connect(p_socket ps, SA *addr, socklen_t len, p_timeout tm) {
+ int err;
+ /* don't call on closed socket */
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ /* ask system to connect */
+ if (connect(*ps, addr, len) == 0) return IO_DONE;
+ /* make sure the system is trying to connect */
+ err = WSAGetLastError();
+ if (err != WSAEWOULDBLOCK && err != WSAEINPROGRESS) return err;
+ /* zero timeout case optimization */
+ if (timeout_iszero(tm)) return IO_TIMEOUT;
+ /* we wait until something happens */
+ err = socket_waitfd(ps, WAITFD_C, tm);
+ if (err == IO_CLOSED) {
+ int elen = sizeof(err);
+ /* give windows time to set the error (yes, disgusting) */
+ Sleep(10);
+ /* find out why we failed */
+ getsockopt(*ps, SOL_SOCKET, SO_ERROR, (char *)&err, &elen);
+ /* we KNOW there was an error. if 'why' is 0, we will return
+ * "unknown error", but it's not really our fault */
+ return err > 0? err: IO_UNKNOWN;
+ } else return err;
+
+}
+
+/*-------------------------------------------------------------------------*\
+* Binds or returns error message
+\*-------------------------------------------------------------------------*/
+int socket_bind(p_socket ps, SA *addr, socklen_t len) {
+ int err = IO_DONE;
+ socket_setblocking(ps);
+ if (bind(*ps, addr, len) < 0) err = WSAGetLastError();
+ socket_setnonblocking(ps);
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+*
+\*-------------------------------------------------------------------------*/
+int socket_listen(p_socket ps, int backlog) {
+ int err = IO_DONE;
+ socket_setblocking(ps);
+ if (listen(*ps, backlog) < 0) err = WSAGetLastError();
+ socket_setnonblocking(ps);
+ return err;
+}
+
+/*-------------------------------------------------------------------------*\
+* Accept with timeout
+\*-------------------------------------------------------------------------*/
+int socket_accept(p_socket ps, p_socket pa, SA *addr, socklen_t *len,
+ p_timeout tm) {
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ int err;
+ /* try to get client socket */
+ if ((*pa = accept(*ps, addr, len)) != SOCKET_INVALID) return IO_DONE;
+ /* find out why we failed */
+ err = WSAGetLastError();
+ /* if we failed because there was no connectoin, keep trying */
+ if (err != WSAEWOULDBLOCK && err != WSAECONNABORTED) return err;
+ /* call select to avoid busy wait */
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Send with timeout
+* On windows, if you try to send 10MB, the OS will buffer EVERYTHING
+* this can take an awful lot of time and we will end up blocked.
+* Therefore, whoever calls this function should not pass a huge buffer.
+\*-------------------------------------------------------------------------*/
+int socket_send(p_socket ps, const char *data, size_t count,
+ size_t *sent, p_timeout tm)
+{
+ int err;
+ *sent = 0;
+ /* avoid making system calls on closed sockets */
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ /* loop until we send something or we give up on error */
+ for ( ;; ) {
+ /* try to send something */
+ int put = send(*ps, data, (int) count, 0);
+ /* if we sent something, we are done */
+ if (put > 0) {
+ *sent = put;
+ return IO_DONE;
+ }
+ /* deal with failure */
+ err = WSAGetLastError();
+ /* we can only proceed if there was no serious error */
+ if (err != WSAEWOULDBLOCK) return err;
+ /* avoid busy wait */
+ if ((err = socket_waitfd(ps, WAITFD_W, tm)) != IO_DONE) return err;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Sendto with timeout
+\*-------------------------------------------------------------------------*/
+int socket_sendto(p_socket ps, const char *data, size_t count, size_t *sent,
+ SA *addr, socklen_t len, p_timeout tm)
+{
+ int err;
+ *sent = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ int put = sendto(*ps, data, (int) count, 0, addr, len);
+ if (put > 0) {
+ *sent = put;
+ return IO_DONE;
+ }
+ err = WSAGetLastError();
+ if (err != WSAEWOULDBLOCK) return err;
+ if ((err = socket_waitfd(ps, WAITFD_W, tm)) != IO_DONE) return err;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Receive with timeout
+\*-------------------------------------------------------------------------*/
+int socket_recv(p_socket ps, char *data, size_t count, size_t *got,
+ p_timeout tm)
+{
+ int err, prev = IO_DONE;
+ *got = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ int taken = recv(*ps, data, (int) count, 0);
+ if (taken > 0) {
+ *got = taken;
+ return IO_DONE;
+ }
+ if (taken == 0) return IO_CLOSED;
+ err = WSAGetLastError();
+ /* On UDP, a connreset simply means the previous send failed.
+ * So we try again.
+ * On TCP, it means our socket is now useless, so the error passes.
+ * (We will loop again, exiting because the same error will happen) */
+ if (err != WSAEWOULDBLOCK) {
+ if (err != WSAECONNRESET || prev == WSAECONNRESET) return err;
+ prev = err;
+ }
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Recvfrom with timeout
+\*-------------------------------------------------------------------------*/
+int socket_recvfrom(p_socket ps, char *data, size_t count, size_t *got,
+ SA *addr, socklen_t *len, p_timeout tm)
+{
+ int err, prev = IO_DONE;
+ *got = 0;
+ if (*ps == SOCKET_INVALID) return IO_CLOSED;
+ for ( ;; ) {
+ int taken = recvfrom(*ps, data, (int) count, 0, addr, len);
+ if (taken > 0) {
+ *got = taken;
+ return IO_DONE;
+ }
+ if (taken == 0) return IO_CLOSED;
+ err = WSAGetLastError();
+ /* On UDP, a connreset simply means the previous send failed.
+ * So we try again.
+ * On TCP, it means our socket is now useless, so the error passes.
+ * (We will loop again, exiting because the same error will happen) */
+ if (err != WSAEWOULDBLOCK) {
+ if (err != WSAECONNRESET || prev == WSAECONNRESET) return err;
+ prev = err;
+ }
+ if ((err = socket_waitfd(ps, WAITFD_R, tm)) != IO_DONE) return err;
+ }
+}
+
+/*-------------------------------------------------------------------------*\
+* Put socket into blocking mode
+\*-------------------------------------------------------------------------*/
+void socket_setblocking(p_socket ps) {
+ u_long argp = 0;
+ ioctlsocket(*ps, FIONBIO, &argp);
+}
+
+/*-------------------------------------------------------------------------*\
+* Put socket into non-blocking mode
+\*-------------------------------------------------------------------------*/
+void socket_setnonblocking(p_socket ps) {
+ u_long argp = 1;
+ ioctlsocket(*ps, FIONBIO, &argp);
+}
+
+/*-------------------------------------------------------------------------*\
+* DNS helpers
+\*-------------------------------------------------------------------------*/
+int socket_gethostbyaddr(const char *addr, socklen_t len, struct hostent **hp) {
+ *hp = gethostbyaddr(addr, len, AF_INET);
+ if (*hp) return IO_DONE;
+ else return WSAGetLastError();
+}
+
+int socket_gethostbyname(const char *addr, struct hostent **hp) {
+ *hp = gethostbyname(addr);
+ if (*hp) return IO_DONE;
+ else return WSAGetLastError();
+}
+
+/*-------------------------------------------------------------------------*\
+* Error translation functions
+\*-------------------------------------------------------------------------*/
+const char *socket_hoststrerror(int err) {
+ if (err <= 0) return io_strerror(err);
+ switch (err) {
+ case WSAHOST_NOT_FOUND: return PIE_HOST_NOT_FOUND;
+ default: return wstrerror(err);
+ }
+}
+
+const char *socket_strerror(int err) {
+ if (err <= 0) return io_strerror(err);
+ switch (err) {
+ case WSAEADDRINUSE: return PIE_ADDRINUSE;
+ case WSAECONNREFUSED : return PIE_CONNREFUSED;
+ case WSAEISCONN: return PIE_ISCONN;
+ case WSAEACCES: return PIE_ACCESS;
+ case WSAECONNABORTED: return PIE_CONNABORTED;
+ case WSAECONNRESET: return PIE_CONNRESET;
+ case WSAETIMEDOUT: return PIE_TIMEDOUT;
+ default: return wstrerror(err);
+ }
+}
+
+const char *socket_ioerror(p_socket ps, int err) {
+ (void) ps;
+ return socket_strerror(err);
+}
+
+static const char *wstrerror(int err) {
+ switch (err) {
+ case WSAEINTR: return "Interrupted function call";
+ case WSAEACCES: return PIE_ACCESS; /* "Permission denied"; */
+ case WSAEFAULT: return "Bad address";
+ case WSAEINVAL: return "Invalid argument";
+ case WSAEMFILE: return "Too many open files";
+ case WSAEWOULDBLOCK: return "Resource temporarily unavailable";
+ case WSAEINPROGRESS: return "Operation now in progress";
+ case WSAEALREADY: return "Operation already in progress";
+ case WSAENOTSOCK: return "Socket operation on nonsocket";
+ case WSAEDESTADDRREQ: return "Destination address required";
+ case WSAEMSGSIZE: return "Message too long";
+ case WSAEPROTOTYPE: return "Protocol wrong type for socket";
+ case WSAENOPROTOOPT: return "Bad protocol option";
+ case WSAEPROTONOSUPPORT: return "Protocol not supported";
+ case WSAESOCKTNOSUPPORT: return PIE_SOCKTYPE; /* "Socket type not supported"; */
+ case WSAEOPNOTSUPP: return "Operation not supported";
+ case WSAEPFNOSUPPORT: return "Protocol family not supported";
+ case WSAEAFNOSUPPORT: return PIE_FAMILY; /* "Address family not supported by protocol family"; */
+ case WSAEADDRINUSE: return PIE_ADDRINUSE; /* "Address already in use"; */
+ case WSAEADDRNOTAVAIL: return "Cannot assign requested address";
+ case WSAENETDOWN: return "Network is down";
+ case WSAENETUNREACH: return "Network is unreachable";
+ case WSAENETRESET: return "Network dropped connection on reset";
+ case WSAECONNABORTED: return "Software caused connection abort";
+ case WSAECONNRESET: return PIE_CONNRESET; /* "Connection reset by peer"; */
+ case WSAENOBUFS: return "No buffer space available";
+ case WSAEISCONN: return PIE_ISCONN; /* "Socket is already connected"; */
+ case WSAENOTCONN: return "Socket is not connected";
+ case WSAESHUTDOWN: return "Cannot send after socket shutdown";
+ case WSAETIMEDOUT: return PIE_TIMEDOUT; /* "Connection timed out"; */
+ case WSAECONNREFUSED: return PIE_CONNREFUSED; /* "Connection refused"; */
+ case WSAEHOSTDOWN: return "Host is down";
+ case WSAEHOSTUNREACH: return "No route to host";
+ case WSAEPROCLIM: return "Too many processes";
+ case WSASYSNOTREADY: return "Network subsystem is unavailable";
+ case WSAVERNOTSUPPORTED: return "Winsock.dll version out of range";
+ case WSANOTINITIALISED:
+ return "Successful WSAStartup not yet performed";
+ case WSAEDISCON: return "Graceful shutdown in progress";
+ case WSAHOST_NOT_FOUND: return PIE_HOST_NOT_FOUND; /* "Host not found"; */
+ case WSATRY_AGAIN: return "Nonauthoritative host not found";
+ case WSANO_RECOVERY: return PIE_FAIL; /* "Nonrecoverable name lookup error"; */
+ case WSANO_DATA: return "Valid name, no data record of requested type";
+ default: return "Unknown error";
+ }
+}
+
+const char *socket_gaistrerror(int err) {
+ if (err == 0) return NULL;
+ switch (err) {
+ case EAI_AGAIN: return PIE_AGAIN;
+ case EAI_BADFLAGS: return PIE_BADFLAGS;
+#ifdef EAI_BADHINTS
+ case EAI_BADHINTS: return PIE_BADHINTS;
+#endif
+ case EAI_FAIL: return PIE_FAIL;
+ case EAI_FAMILY: return PIE_FAMILY;
+ case EAI_MEMORY: return PIE_MEMORY;
+ case EAI_NONAME: return PIE_NONAME;
+#ifdef EAI_OVERFLOW
+ case EAI_OVERFLOW: return PIE_OVERFLOW;
+#endif
+#ifdef EAI_PROTOCOL
+ case EAI_PROTOCOL: return PIE_PROTOCOL;
+#endif
+ case EAI_SERVICE: return PIE_SERVICE;
+ case EAI_SOCKTYPE: return PIE_SOCKTYPE;
+#ifdef EAI_SYSTEM
+ case EAI_SYSTEM: return strerror(errno);
+#endif
+ default: return gai_strerror(err);
+ }
+}
diff --git a/source/luametatex/source/luacore/luasocket/src/wsocket.h b/source/luametatex/source/luacore/luasocket/src/wsocket.h
new file mode 100644
index 000000000..398664026
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/src/wsocket.h
@@ -0,0 +1,33 @@
+#ifndef WSOCKET_H
+#define WSOCKET_H
+/*=========================================================================*\
+* Socket compatibilization module for Win32
+* LuaSocket toolkit
+\*=========================================================================*/
+
+/*=========================================================================*\
+* WinSock include files
+\*=========================================================================*/
+#include <winsock2.h>
+#include <ws2tcpip.h>
+
+typedef int socklen_t;
+typedef SOCKADDR_STORAGE t_sockaddr_storage;
+typedef SOCKET t_socket;
+typedef t_socket *p_socket;
+
+#ifndef IPV6_V6ONLY
+#define IPV6_V6ONLY 27
+#endif
+
+#define SOCKET_INVALID (INVALID_SOCKET)
+
+#ifndef SO_REUSEPORT
+#define SO_REUSEPORT SO_REUSEADDR
+#endif
+
+#ifndef AI_NUMERICSERV
+#define AI_NUMERICSERV (0)
+#endif
+
+#endif /* WSOCKET_H */
diff --git a/source/luametatex/source/luacore/luasocket/test.zip b/source/luametatex/source/luacore/luasocket/test.zip
new file mode 100644
index 000000000..9faa04474
--- /dev/null
+++ b/source/luametatex/source/luacore/luasocket/test.zip
Binary files differ
diff --git a/source/luametatex/source/luacore/readme.txt b/source/luametatex/source/luacore/readme.txt
new file mode 100644
index 000000000..89d39cb6d
--- /dev/null
+++ b/source/luametatex/source/luacore/readme.txt
@@ -0,0 +1,34 @@
+About luasocket and luasec:
+
+Till mid 2021 we had the luasec code in the source tree but it was not used yet. It requires
+openssl which is pretty large and we need a bunch of header files. In order to compile luasec
+we need openssl headers and unfortunately there are a few included files that one need to
+make. This create a depedency unless we make a few simple ones; after all we only need it for
+a few platforms. I couldn't locate a neutral header set so it never came to compilation (I
+started making a set myself but could not motivate myself to finish it). We could use it as
+optional library (which then demands a bit different interface). But, no matter what we
+decide, we definitely don't want to compile openssl and include it in the binary. One problem
+with these additional libraries is that they add more code than luametatex itself has so that
+makes no sense.
+
+For the record, an alternative is to use the more lightweight armmbed or polarssl library but
+then I need either to make wrappers or adapt the luasec code.
+
+Anyway, when we consider secure http we also enter the endless updating of protocols because
+the internet is more and more wrapped in security due to lack of control over bad behaviour
+and abuse around it. Plugging holes is not among the objectives of this project also because
+it conflicts with long term stability of what basically is a typesetting engine.
+
+On a positive note, when we use sockets to serve http we can hide behind a proxy, for instance
+nginx is easy to set up and Lua(Meta)TeX happily sits behind it. When downloading something we
+need to cache anyway so then we can as well use libcurl for which we have interfaces built in
+already. If installing openssl is considered a valid option, then libcurl can hardly be seen
+as a hurdle. We probably need that anyway some day in the installer and updater.
+
+The basic socket library is quite stable. In ConTeXt the Lua files already have been 'redone'
+to fit it the lot. In the code base some C files have been removed (serial and unix specific
+stuff) and at some point I might decide to strip away the files and functionality that we
+don't need. Occasionally there are updates to the library but in general it's rather long
+term stable.
+
+So to summarize: luasocket stayed and luasec is no longer considered as a built-in. \ No newline at end of file
diff --git a/source/luametatex/source/luametatex.c b/source/luametatex/source/luametatex.c
new file mode 100644
index 000000000..4ce273547
--- /dev/null
+++ b/source/luametatex/source/luametatex.c
@@ -0,0 +1,61 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ The version number can be queried with |\luatexversion| and the revision with with
+ |\luatexrevision|. Traditionally the revision can be any character and \PDFTEX\ occasionally
+ used no digits. Here we still use a character but we will stick to 0 upto 9 so users can expect
+ a number represented as string. Further comments have been moved to the manual.
+
+*/
+
+# ifndef LMT_COMPILER_USED
+ # define LMT_COMPILER_USED "unknown"
+# endif
+
+/*tex
+ It would be nice if we could test if musl is used. Comments in the web indicate that there
+ never be some macro to check for that (argument: it shouldn't matter code/api wise). Well it
+ does matter if you have to make a choice for a binary (set path to a tree), as needed in a
+ TeX distribution that ships a lot. A bit lack of imagination I guess or maybe it's only for
+ people who compile themselves. So if no one cares, I don't either. Maybe CMAKE can help some
+ day.
+*/
+
+// # ifndef LMT_LIBC_USED
+// # if defined(__GLIBC__)
+// # define LMT_LIBC_USED "glibc"
+// # elif defined(__UCLIBC__)
+// # define LMT_LIBC_USED "uclibc"
+// # else
+// # define LMT_LIBC_USED "unknown"
+// # endif
+// # endif
+
+version_state_info lmt_version_state = {
+ .version = luametatex_version,
+ .revision = luametatex_revision,
+ .verbose = luametatex_version_string,
+ .banner = "This is " luametatex_name_camelcase ", Version " luametatex_version_string,
+ .compiler = LMT_COMPILER_USED,
+ // .libc = LMT_LIBC_USED,
+ .developmentid = luametatex_development_id,
+ .formatid = luametatex_format_fingerprint,
+ .copyright = luametatex_copyright_holder,
+};
+
+int main(int ac, char* *av)
+{
+ /*tex We set up the whole machinery, for instance booting \LUA. */
+ tex_engine_initialize(ac, av);
+ /*tex Kind of special: */
+ aux_set_interrupt_handler();
+ /*tex Now we're ready for the more traditional \TEX\ initializations */
+ tex_main_body();
+ /*tex When we arrive here we had a succesful run. */
+ return EXIT_SUCCESS; /* unreachable */
+}
diff --git a/source/luametatex/source/luametatex.h b/source/luametatex/source/luametatex.h
new file mode 100644
index 000000000..c2536f461
--- /dev/null
+++ b/source/luametatex/source/luametatex.h
@@ -0,0 +1,345 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LUAMETATEX_H
+# define LMT_LUAMETATEX_H
+
+/*tex
+
+ The \LUATEX\ project started in 2005 with an experiments by Hartmut and me: adding the \LUA\
+ Scripting language (that I knew from the \SCITE\ editor) to \PDFTEX. When we came to the
+ conclusion that a more tight integration made sense Taco did the impressive conversion from
+ \PASCAL\ |WEB\ to \CWEB. This happened in the perspective of the Oriental \TEX\ project, that
+ has as objective high quality Arabic typesetting. The way to achieve that was opening up the
+ font machinery and access to the paragraph building. It was an intense development period,
+ with Taco doing the coding, Hans exploring possibilities and extending \CONTEXT, and Idris
+ making fonts and testing. Taco and I discussed, compiled, accepted and rejected ideas. These
+ were interesting times! Over the years that we had used \TEX\ we could finally explore what we
+ had been talking about for years (long trips to user group meetings are good for that). We
+ ame to the first version(s) of \LUATEX\ with \CONTEXT\ \MKIV\ providing a testbed and as we
+ progressed we ended up with something we liked a lot.
+
+ After half a decade, where in the meantime Taco also had turned MetaPost into a library, we
+ had a version that had proved itself well. The following years, with Taco having less time
+ available, I started loking at the code. Some more got added to the Lua interfaces. Math got
+ split code paths and some new primitives were introduced. Luigi started taking care of managing
+ the code base so that I could cross compile for \MSWINDOWS. He also deals with the libraries
+ that were used and integration in \TEXLIVE\ and maintains the (by now stable) \METAPOST\ code
+ base.
+
+ After a while it became clear that users other than \CONTEXT\ wanted the program to stay as it
+ was and not introduce features or improve interfaces in ways that demanded a change in used
+ \LUA\ code. So, after a decade of development the official stable release took place. We already
+ had a split between stable (normally the \TEXLIVE\ release) and experimental (that we used for
+ development). However, in practice experimental versions were seen as real releases and we got
+ complaints that something could be broken (which actually is natural for an experimental
+ version). So, this split model didn't work out well in practice: you cannot explore and
+ experiment when you cannot play with yet unfinished code.
+
+ So at some point I decided that the best approach to a follow up, one not interfering with
+ usage of a stable \LUATEX, would be a more drastic split: the idea of \LUAMETATEX\ took shape.
+ This code base is the result of that. For whatever bad was introduced in \LUAMETATEX, and maybe
+ already before that in \LUATEX), you can blame me (Hans) and not Taco: Luigi consistently added
+ (hh) to the \LUATEX\ svn entries when that was feasible, so one can check where I messed up.
+ In the end all this work can be considered a co-product and the \CONTEXT\ (dev) community was
+ instrumental in this as well.
+
+ There are some fundamental changes: there is no backend but maybe I'll introduce a framework
+ for that at some point because the impact on performance has been quite noticeable (although
+ it has been compensated in the meantime). There is no support for \LUAJIT, because it doesn't
+ keep up with \LUA. Also, there is no support for \FFI, because that project is orphaned, but
+ there are other ways. Some more is delegated to \LUA, but also some more has been added to \TEX.
+
+ Over the 15 years that it took to go from the first version of \LUATEX\ in 2005 to the first
+ release of \LUAMETATEX\ in 2020 (although intermediate versions have always been good enough
+ to be used in production with \CONTEXT) I've written numerous articles in user group journals
+ as well as several presentations each year on progress and features. There are also wrapups
+ available in the \CONTEXT\ distribution that shed some light on how the developments
+ progress(ed). In the end it's all a work of many. There are no commercial interrests and
+ everything is done out of love for TeX and in free time, so take that into account when you
+ bark about code or documentation.
+
+ The \LUAMETATEX\ code base is maintained by Hans Hagen and Wolfgang Schuster (code, programming,
+ etc) with help from Mojca Miklavec (distribution, compile farm, etc) and Alan Braslau (testing,
+ feedback, etc). Of course with get help from all those \CONTEXT\ users who are always very
+ willing to test.
+
+ We start with the version numbers. While \LUATEX\ operates in the 100 range, the \LUAMETATEX\
+ engine takes the 200 range. Revisions range from 00 upto 99 and the dates \unknown\ depend on
+ the mood. The |2.05.00| version with the development id |20200229| was more or less the first
+ official version, in the sense that most of the things on my initial todo list were done. It's
+ a kind of virtual date as it happens to be a leapyear. As with LuaTeX the .10 version will be
+ the first 'stable' one, released somewhere around the ConTeXt 2021 meeting.
+
+ 2.08.18 : around TeXLive 2021 code freeze (so a bit of a reference version)
+ 2.09.35 : near the end of 2021 (so close to the 2.10 release date)
+ 2.09.55 : in July 2022 (the official release of the new math engine)
+ 2.10.00 : a few days before the ctx 2022 meeting (starting September 19)
+
+ At some point the \CONTEXT\ group will be responsible for guaranteeing that the official version
+ is what comes with \CONTEXT\ and that long term support and stabilty is guaranteed and that no
+ feature creep or messing up happens. We'll see.
+
+*/
+
+# include "tex/textypes.h"
+
+# define luametatex_version 210
+# define luametatex_revision 00
+# define luametatex_version_string "2.10.00"
+# define luametatex_development_id 20220918
+
+# define luametatex_name_camelcase "LuaMetaTeX"
+# define luametatex_name_lowercase "luametatex"
+# define luametatex_copyright_holder "Taco Hoekwater, Hans Hagen & Wolfgang Schuster"
+# define luametatex_bug_address "dev-context@ntg.nl"
+# define luametatex_support_address "context@ntg.nl"
+
+/*tex
+
+ One difference with \LUATEX\ is that we keep global variables that kind of belong together in
+ structures. This also has the advantage that we have more specific access (via a namespace) and
+ don't use that many macros (that can conflict later on).
+
+*/
+
+typedef struct version_state_info {
+ int version;
+ int revision;
+ const char *verbose;
+ const char *banner;
+ const char *compiler;
+ // const char *libc;
+ int developmentid;
+ int formatid;
+ const char *copyright;
+} version_state_info;
+
+extern version_state_info lmt_version_state;
+
+/*tex
+
+ This is actually the main headere file. Of course we could split it up and be more explicit in
+ other files but this is simple and just works. There is of course some overhead in loading
+ headers that are not used, but because compilation is simple and fast I don't care.
+
+*/
+
+# include <stdarg.h>
+# include <string.h>
+# include <math.h>
+# include <stdlib.h>
+# include <errno.h>
+# include <float.h>
+# include <locale.h>
+# include <ctype.h>
+# include <stdint.h>
+# include <stdio.h>
+# include <time.h>
+# include <signal.h>
+# include <sys/stat.h>
+
+# ifdef _WIN32
+ # include <windows.h>
+ # include <winerror.h>
+ # include <fcntl.h>
+ # include <io.h>
+# else
+ # include <unistd.h>
+ # include <sys/time.h>
+# endif
+
+/*tex
+
+ We use stock \LUA\ where we only adapt the bytecode format flag so that we can use intermediate
+ \LUA\ versions without crashes due to different bytecode. Here are some constants that have to
+ be set:
+
+ \starttyping
+ # define LUAI_HASHLIMIT 6
+ # define LUA_USE_JUMPTABLE 0
+ # define LUA_BUILD_AS_DLL 0
+ # define LUA_CORE 0
+ \stoptyping
+
+ Earlier versions of \LUA\ an definitely \LUAJIT\ needed the |LUAI_HASHLIMIT| setting to be
+ adapted in order not to loose performance. This flag is no longer in \LUA\ version 5.4+.
+
+*/
+
+# include "lua.h"
+# include "lauxlib.h"
+
+# define LUA_VERSION_STRING ("Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR "." LUA_VERSION_RELEASE)
+
+/*tex
+
+ The code in \LUAMETATEX\ is a follow up on \LUATEX\ which is itself a follow up on \PDFTEX\
+ (and parts of \ALEPH). The original \PASCAL\ code has been converted \CCODE. Substantial amounts
+ of code were added over a decade. Stepwise artifacts have been removed (for instance originating
+ in the transations from \PASCAL, or from integration in the infrastructure), parts of code has
+ been rewritten. As much as possible we keep the old naming intact (so that most of the \TEX\
+ documentation applies. However, as we now assume \CCODE, some things have changed. Among the
+ changes are handling datatypes and certain checks. For instance, when |null| is used this is
+ now always assumed to be |0|, so a zero test is also valid. Old side effects of zero nodes for
+ zero gluespecs are gone because these have been reimplemented. Of course we keep |NULL| as
+ abstraction for unset pointers. This way it's clear when we have a \CCODE\ pointer or a \TEX\
+ managed one (where |null| or |0| means no node or token).
+
+ As with all \TEX\ engines, \LUATEX\ started out with the \PASCAL\ version of \TEX\ and as
+ mentioned we started with \PDFTEX. The first thing that was done (by Taco) was to create a
+ permanent \CCODE\ base instead of \PASCAL. In the process, some macros and library interfacing
+ wrappers were moved to the \LUATEX\ code base. Sometimes \PASCAL\ and \CCODE\ don't map well
+ end intermediate functions were used for that. Over time some artifacts that resulted from
+ automatic conversions from one to the other has been removed.
+
+ In the next stage of \LUATEX\ development, we went a but further and tried to get rid of more
+ dependencies. Among the rationales for this is that we depend on \LUA, and whatever works for
+ the \LUA\ codebase (which is quite portable) should also work for \LUATEX. But there are always
+ some overloads because (especially in \LUATEX\ where one can use \KPSE) the integration in a
+ \TEX\ ecosystem expects some behaviour with respect to files and running subprocesses and such.
+ In \LUAMETATEX\ there is less of that because \CONTEXT\ does more of that itself.
+
+ So, one of the biggest complications was the dependency on the \WEBC\ helpers and file system
+ interface. However, because that was already kind of isolated, it could be removed. If needed
+ we can always bring back \KPSE\ as an external library. In the process there can be some side
+ effects but in the end it gives a cleaner codebase and less depedencies. We suddenly don't need
+ all kind of tweaks to get the program compiled.
+
+ The \TEX\ memory model is based on packing data in memory words, but that concept is somewhat
+ fluid as in the past we had 16 byte processors too. However, we now mostly think in 32 bit and
+ internally \LUATEX\ will pack most of its node data in a multiples of 64 bits (called words). On
+ the one hand there is more memory involved but on the other hand it suits the architectures
+ well. In \LUAMETATEX\ we target 64 bit machines, but still provide binaries for 32 bit
+ architectures. The endianness related code has been dropped, simply because already for decades,
+ format files are not shared between platforms either.
+
+ Because \TEX\ efficiently implements its own memory management of nodes, the address of a node
+ is actually a number. Numbers like are sometimes indicates as |pointer|, but can also be called
+ |halfword|. Dimensions also fit into half a word and are called |scaled| but again we see them
+ being called |halfword|. What term is used depends a bit on the location and also on the
+ original code. For now we keep this mix but maybe some day we will normalize this. I did look
+ into more dynamic loading (only using the main memory numeric address pointers because that is
+ fast and efficient) but it makes the code more complex and probably hit performance badly. But
+ I keep an eye on it.
+
+ When we have halfwords representing pointers (into the main memory array) we indicate an unset
+ pointer as |null| (lowercase). But, because the usage of |null| and |0| was kind of mixed and
+ inconstent the |null| is only used to indicate zeroing a halfword encoded pointer. It will
+ always remain |0|.
+
+ We could reshuffle a lot more and normalize defines and enums but for now we stick to the way
+ it's done in order to divert not too much from the ancestors. However, in due time it can
+ evolve. Some constants used in \TEX\ the program now have a prefix |namespace_| or suffix
+ |_code| or |_cmd| in order not to clash with other usage. Some of these are in files like
+ |texcommands.h| and |texequivalents.h| but others end up in other |.h| files. This might change
+ but in the end it's not that important. Consider the spread a side effect of the still present
+ ideas of literate programming.
+
+ Some of the modules put data into the structures that could have been kept private but for now
+ I decided to be a bit consistent. However, of course there are still quite some private
+ variables left.
+
+*/
+
+/*tex This is not used (yet) as I don't expect much from it, but \LUA\ has some of it. */
+
+# if defined(__GNUC__)
+# define lmt_likely(x) (__builtin_expect(((x) != 0), 1))
+# define lmt_unlikely(x) (__builtin_expect(((x) != 0), 0))
+# else
+# define lmt_likely(x) (x)
+# define lmt_unlikely(x) (x)
+# endif
+
+# include "utilities/auxarithmetic.h"
+# include "utilities/auxmemory.h"
+# include "utilities/auxzlib.h"
+
+# include "tex/texmainbody.h"
+
+# include "lua/lmtinterface.h"
+# include "lua/lmtlibrary.h"
+# include "lua/lmttexiolib.h"
+
+# include "utilities/auxsystem.h"
+# include "utilities/auxsparsearray.h"
+# include "utilities/auxunistring.h"
+# include "utilities/auxfile.h"
+
+# include "libraries/hnj/hnjhyphen.h"
+
+# include "tex/texexpand.h"
+# include "tex/texmarks.h"
+# include "tex/texconditional.h"
+# include "tex/textextcodes.h"
+# include "tex/texmathcodes.h"
+# include "tex/texalign.h"
+# include "tex/texrules.h"
+/* "tex/texdirections.h" */
+# include "tex/texerrors.h"
+# include "tex/texinputstack.h"
+# include "tex/texstringpool.h"
+# include "tex/textoken.h"
+# include "tex/texprinting.h"
+# include "tex/texfileio.h"
+# include "tex/texarithmetic.h"
+# include "tex/texnesting.h"
+# include "tex/texadjust.h"
+# include "tex/texinserts.h"
+# include "tex/texlocalboxes.h"
+# include "tex/texpackaging.h"
+# include "tex/texscanning.h"
+# include "tex/texbuildpage.h"
+# include "tex/texmaincontrol.h"
+# include "tex/texdumpdata.h"
+# include "tex/texmainbody.h"
+# include "tex/texnodes.h"
+# include "tex/texdirections.h"
+# include "tex/texlinebreak.h"
+# include "tex/texmath.h"
+# include "tex/texmlist.h"
+# include "tex/texcommands.h"
+# include "tex/texprimitive.h"
+# include "tex/texequivalents.h"
+# include "tex/texfont.h"
+# include "tex/texlanguage.h"
+
+# include "lua/lmtcallbacklib.h"
+# include "lua/lmttokenlib.h"
+# include "lua/lmtnodelib.h"
+# include "lua/lmtlanguagelib.h"
+# include "lua/lmtfontlib.h"
+# include "lua/lmtlualib.h"
+# include "lua/lmttexlib.h"
+# include "lua/lmtenginelib.h"
+
+/*tex
+
+ We use proper warnings, error messages, and confusion reporting instead of:
+
+ \starttyping
+ # ifdef HAVE_ASSERT_H
+ # include <assert.h>
+ # else
+ # define assert(expr)
+ # endif
+ \stoptyping
+
+ In fact, we don't use assert at all in \LUAMETATEX\ because if we need it we should do a decent
+ test and report an issue. In the \TEXLIVE\ eco system there can be assignments and function
+ calls in asserts which can disappear in case of e.g. compiling with msvc, so the above define
+ is even wrong!
+
+*/
+
+// # ifndef _WIN32
+//
+// /* We don't want these use |foo_s| instead of |foo| messages. This will move. */
+//
+// # define _CRT_SECURE_NO_WARNINGS
+//
+// # endif
+
+# endif
diff --git a/source/luametatex/source/luaoptional/cmake/mujs/CMakeLists.txt b/source/luametatex/source/luaoptional/cmake/mujs/CMakeLists.txt
new file mode 100644
index 000000000..cfe2ee2bf
--- /dev/null
+++ b/source/luametatex/source/luaoptional/cmake/mujs/CMakeLists.txt
@@ -0,0 +1,107 @@
+# This file is made by Mojca and Hans and is subjected to changes
+# as we proceed with luametatex and the contextgarden compile farm.
+
+cmake_minimum_required(VERSION 3.7)
+
+# Lucky us: only normal C is used:
+
+project (mujs
+ VERSION 1.0.6
+ DESCRIPTION "MuJS embeddable Javascript interpreter"
+ LANGUAGES C)
+
+# The jsrepr.c is not needed and depends on utf.c as well has some function
+# pointer cast issue (accessing unknown name field).
+
+set (mujs_sources
+ jsarray.c
+ jsboolean.c
+ jsbuiltin.c
+ jscompile.c
+ jsdate.c
+ jsdtoa.c
+ jsdump.c
+ jserror.c
+ jsfunction.c
+ jsgc.c
+ jsintern.c
+ jslex.c
+ jsmath.c
+ jsnumber.c
+ jsobject.c
+ json.c
+ jsparse.c
+ jsproperty.c
+ jsregexp.c
+# jsrepr.c
+ jsrun.c
+ jsstate.c
+ jsstring.c
+ jsvalue.c
+ regexp.c
+ utf.c
+ utftype.c
+)
+
+set (mujs_headers
+ jsbuiltin.h
+ jscompile.h
+ jsi.h
+ jslex.h
+ jsparse.h
+ jsrun.h
+ jsvalue.h
+ mujs.h
+ regexp.h
+ utf.h
+)
+
+# We need this in order for msvc to export the symbols (which is default on
+# gcc). Otherwise we need this dllexport stuff.
+
+set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS ON)
+
+# The previous one has to come before the next one!
+
+if (MSVC)
+
+ add_library(mujs SHARED ${mujs_headers} ${mujs_sources} )
+
+else()
+
+ # Is this hack still needed or does the above work ok.?
+
+ add_library(mujs SHARED ${mujs_headers} one.c)
+
+endif()
+
+# As per make file.
+
+set_property(TARGET mujs PROPERTY C_STANDARD 99)
+
+# We want consistent and predictable names:
+
+set_target_properties(mujs PROPERTIES OUTPUT_NAME "libmujs")
+
+# Some options based on what's in upstream's make file.
+
+if (NOT MSVC)
+
+ target_compile_options(mujs
+ PRIVATE
+ -pedantic
+ -Wall
+ -Wextra
+ -Wno-unused-parameter
+ )
+
+ if (CMAKE_C_COMPILER_ID STREQUAL "Clang")
+
+ target_compile_options(mujs
+ PRIVATE
+ -Wunreachable-code
+ )
+
+ endif()
+
+endif()
diff --git a/source/luametatex/source/luaoptional/cmake/mujs/CMakeSettings.json b/source/luametatex/source/luaoptional/cmake/mujs/CMakeSettings.json
new file mode 100644
index 000000000..fc67a089b
--- /dev/null
+++ b/source/luametatex/source/luaoptional/cmake/mujs/CMakeSettings.json
@@ -0,0 +1,28 @@
+{
+ "configurations": [
+ {
+ "name": "msvc-x64-release",
+ "generator": "Ninja",
+ "configurationType": "Release",
+ "inheritEnvironments": [ "msvc_x64_x64" ],
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": "",
+ "variables": []
+ },
+ {
+ "name": "msvc-x64-debug",
+ "generator": "Ninja",
+ "configurationType": "Debug",
+ "inheritEnvironments": [ "msvc_x64_x64" ],
+ "buildRoot": "${projectDir}\\build\\${name}",
+ "installRoot": "${projectDir}\\install\\${name}",
+ "cmakeCommandArgs": "",
+ "buildCommandArgs": "-v",
+ "ctestCommandArgs": "",
+ "variables": []
+ }
+ ]
+} \ No newline at end of file
diff --git a/source/luametatex/source/luaoptional/lmtcerflib.c b/source/luametatex/source/luaoptional/lmtcerflib.c
new file mode 100644
index 000000000..b18e3fb47
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtcerflib.c
@@ -0,0 +1,133 @@
+/*
+
+ See license.txt in the root of this project.
+
+ In order to match the xmath library we also support complex error functions. For that we use
+ the libcerf funcitonality. That library itself is a follow up on other code (you can find
+ articles on the web).
+
+ One complication is that the library (at the time we started using it) is not suitable for the
+ MSVC compiler so we use adapted code, so yet another succession. We currently embed libcerf but
+ when we have the optional library compilation up and running on the garden that might become a
+ real optional module instead.
+
+ Note: Alan has to test if all works okay.
+
+*/
+
+# include "lmtoptional.h"
+# include "luametatex.h"
+
+# include <complex.h>
+# include <cerf.h>
+
+/*tex We start with some similar code as in |xcomplex.c|. */
+
+# define COMPLEX_METATABLE "complex number"
+
+# if (_MSC_VER)
+
+ # define Complex _Dcomplex
+
+ static Complex lmt_tocomplex(lua_State *L, int i)
+ {
+ switch (lua_type(L, i)) {
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ return _Cbuild(luaL_checknumber(L, i), 0);
+ default:
+ return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
+ }
+ }
+
+# else
+
+ # define Complex double complex
+
+ static Complex lmt_tocomplex(lua_State *L, int i)
+ {
+ switch (lua_type(L, i)) {
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ return luaL_checknumber(L, i);
+ default:
+ return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
+ }
+ }
+
+# endif
+
+static int lmt_pushcomplex(lua_State *L, Complex z)
+{
+ Complex *p = lua_newuserdatauv(L, sizeof(Complex), 0);
+ luaL_setmetatable(L, COMPLEX_METATABLE);
+ *p = z;
+ return 1;
+}
+
+/*tex We use that here: */
+
+static int xcomplexlib_cerf_erf (lua_State *L) {
+ return lmt_pushcomplex(L, cerf(lmt_tocomplex(L, 1)));
+}
+
+static int xcomplexlib_cerf_erfc (lua_State *L) {
+ return lmt_pushcomplex(L, lmt_tocomplex(L, 1));
+}
+
+static int xcomplexlib_cerf_erfcx (lua_State *L) {
+ return lmt_pushcomplex(L, cerfcx(lmt_tocomplex(L, 1)));
+}
+
+static int xcomplexlib_cerf_erfi (lua_State *L) {
+ return lmt_pushcomplex(L, cerfi(lmt_tocomplex(L, 1)));
+}
+
+static int xcomplexlib_cerf_dawson (lua_State *L) {
+ return lmt_pushcomplex(L, cdawson(lmt_tocomplex(L, 1)));
+}
+
+static int xcomplexlib_cerf_voigt (lua_State *L) {
+ lua_pushnumber(L, voigt(lua_tonumber(L, 1), lua_tonumber(L, 2), lua_tonumber(L, 3)));
+ return 1;
+}
+
+static int xcomplexlib_cerf_voigt_hwhm (lua_State *L) {
+ int error = 0;
+ double result = voigt_hwhm(lua_tonumber(L, 1), lua_tonumber(L, 2), &error);
+ lua_pushnumber(L, result);
+ switch (error) {
+ case 1 :
+ tex_formatted_warning("voigt_hwhm", "bad arguments");
+ break;
+ case 2 :
+ tex_formatted_warning("voigt_hwhm", "huge deviation");
+ break;
+ case 3 :
+ tex_formatted_warning("voigt_hwhm", "no convergence");
+ break;
+ }
+ return 1;
+}
+
+static struct luaL_Reg xcomplexlib_cerf_function_list[] = {
+ { "erf", xcomplexlib_cerf_erf },
+ { "erfc", xcomplexlib_cerf_erfc },
+ { "erfcx", xcomplexlib_cerf_erfcx },
+ { "erfi", xcomplexlib_cerf_erfi },
+ { "dawson", xcomplexlib_cerf_dawson },
+ { "voigt", xcomplexlib_cerf_voigt },
+ { "voigt_hwhm", xcomplexlib_cerf_voigt_hwhm },
+ { NULL, NULL },
+};
+
+int luaextend_xcomplex(lua_State *L)
+{
+ lua_getglobal(L, "string");
+ for (const luaL_Reg *lib = xcomplexlib_cerf_function_list; lib->name; lib++) {
+ lua_pushcfunction(L, lib->func);
+ lua_setfield(L, -2, lib->name);
+ }
+ lua_pop(L, 1);
+ return 1;
+}
diff --git a/source/luametatex/source/luaoptional/lmtcurl.c b/source/luametatex/source/luaoptional/lmtcurl.c
new file mode 100644
index 000000000..6a54174e5
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtcurl.c
@@ -0,0 +1,506 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef void* curl_instance ;
+typedef int curl_return_code ;
+typedef int curl_error_code ;
+
+typedef enum curl_option_type {
+ curl_ignore = 0,
+ curl_integer = 1,
+ curl_string = 2,
+ curl_function = 3, /* ignored */
+ curl_offset = 4, /* ignored */
+} curl_option_type;
+
+/*tex At the \LUA\ end we can have a mapping of useful ones, */
+
+static const int curl_options[] = {
+ curl_ignore, /* 0 */
+ curl_string, /* 1 file | writedata */
+ curl_string, /* 2 url */
+ curl_integer, /* 3 port */
+ curl_string, /* 4 proxy */
+ curl_string, /* 5 userpwd */
+ curl_string, /* 6 proxyuserpwd */
+ curl_string, /* 7 range */
+ curl_ignore, /* 8 */
+ curl_string, /* 9 infile | readdata */
+ curl_string, /* 10 errorbuffer */
+ curl_function, /* 11 writefunction */
+ curl_function, /* 12 readfunction */
+ curl_integer, /* 13 timeout */
+ curl_integer, /* 14 infilesize */
+ curl_string, /* 15 postfields */
+ curl_string, /* 16 referer */
+ curl_string, /* 17 ftpport */
+ curl_string, /* 18 useragent */
+ curl_integer, /* 19 low_speed_limit */
+ curl_integer, /* 20 low_speed_time */
+ curl_integer, /* 21 resume_from */
+ curl_string, /* 22 cookie */
+ curl_string, /* 23 httpheader | rtspheader */
+ curl_string, /* 24 httppost */
+ curl_string, /* 25 sslcert */
+ curl_string, /* 26 keypasswd */
+ curl_integer, /* 27 crlf */
+ curl_string, /* 28 quote */
+ curl_string, /* 29 writeheader | headerdata */
+ curl_ignore, /* 30 */
+ curl_string, /* 31 cookiefile */
+ curl_integer, /* 32 sslversion */
+ curl_integer, /* 33 timecondition */
+ curl_integer, /* 34 timevalue */
+ curl_ignore, /* 35 */
+ curl_string, /* 36 customrequest */
+ curl_string, /* 37 stderr */
+ curl_ignore, /* 38 */
+ curl_string, /* 39 postquote */
+ curl_string, /* 40 writeinfo */
+ curl_integer, /* 41 verbose */
+ curl_integer, /* 42 header */
+ curl_integer, /* 43 noprogress */
+ curl_integer, /* 44 nobody */
+ curl_integer, /* 45 failonerror */
+ curl_integer, /* 46 upload */
+ curl_integer, /* 47 post */
+ curl_integer, /* 48 dirlistonly */
+ curl_ignore, /* 49 */
+ curl_integer, /* 50 append */
+ curl_integer, /* 51 netrc */
+ curl_integer, /* 52 followlocation */
+ curl_integer, /* 53 transfertext */
+ curl_integer, /* 54 put */
+ curl_ignore, /* 55 */
+ curl_function, /* 56 progressfunction */
+ curl_string, /* 57 xferinfodata | progressdata */
+ curl_integer, /* 58 autoreferer */
+ curl_integer, /* 59 proxyport */
+ curl_integer, /* 60 postfieldsize */
+ curl_integer, /* 61 httpproxytunnel */
+ curl_string, /* 62 interface */
+ curl_string, /* 63 krblevel */
+ curl_integer, /* 64 ssl_verifypeer */
+ curl_string, /* 65 cainfo */
+ curl_ignore, /* 66 */
+ curl_ignore, /* 67 */
+ curl_integer, /* 68 maxredirs */
+ curl_integer, /* 69 filetime */
+ curl_string, /* 70 telnetoptions */
+ curl_integer, /* 71 maxconnects */
+ curl_integer, /* 72 closepolicy */
+ curl_ignore, /* 73 */
+ curl_integer, /* 74 fresh_connect */
+ curl_integer, /* 75 forbid_reuse */
+ curl_string, /* 76 random_file */
+ curl_string, /* 77 egdsocket */
+ curl_integer, /* 78 connecttimeout */
+ curl_function, /* 79 headerfunction */
+ curl_integer, /* 80 httpget */
+ curl_integer, /* 81 ssl_verifyhost */
+ curl_string, /* 82 cookiejar */
+ curl_string, /* 83 ssl_cipher_list */
+ curl_integer, /* 84 http_version */
+ curl_integer, /* 85 ftp_use_epsv */
+ curl_string, /* 86 sslcerttype */
+ curl_string, /* 87 sslkey */
+ curl_string, /* 88 sslkeytype */
+ curl_string, /* 89 sslengine */
+ curl_integer, /* 90 sslengine_default */
+ curl_integer, /* 91 dns_use_global_cache */
+ curl_integer, /* 92 dns_cache_timeout */
+ curl_string, /* 93 prequote */
+ curl_function, /* 94 debugfunction */
+ curl_string, /* 95 debugdata */
+ curl_integer, /* 96 cookiesession */
+ curl_string, /* 97 capath */
+ curl_integer, /* 98 buffersize */
+ curl_integer, /* 99 nosignal */
+ curl_string, /* 100 share */
+ curl_integer, /* 101 proxytype */
+ curl_string, /* 102 accept_encoding */
+ curl_string, /* 103 private */
+ curl_string, /* 104 http200aliases */
+ curl_integer, /* 105 unrestricted_auth */
+ curl_integer, /* 106 ftp_use_eprt */
+ curl_integer, /* 107 httpauth */
+ curl_function, /* 108 ssl_ctx_function */
+ curl_string, /* 109 ssl_ctx_data */
+ curl_integer, /* 110 ftp_create_missing_dirs */
+ curl_integer, /* 111 proxyauth */
+ curl_integer, /* 112 server_response_timeout | ftp_response_timeout */
+ curl_integer, /* 113 ipresolve */
+ curl_integer, /* 114 maxfilesize */
+ curl_offset, /* 115 infilesize_large */
+ curl_offset, /* 116 resume_from_large */
+ curl_offset, /* 117 maxfilesize_large */
+ curl_string, /* 118 netrc_file */
+ curl_integer, /* 119 use_ssl */
+ curl_offset, /* 120 postfieldsize_large */
+ curl_integer, /* 121 tcp_nodelay */
+ curl_ignore, /* 122 */
+ curl_ignore, /* 123 */
+ curl_ignore, /* 124 */
+ curl_ignore, /* 125 */
+ curl_ignore, /* 126 */
+ curl_ignore, /* 127 */
+ curl_ignore, /* 128 */
+ curl_integer, /* 129 ftpsslauth */
+ curl_function, /* 130 ioctlfunction */
+ curl_string, /* 131 ioctldata */
+ curl_ignore, /* 132 */
+ curl_ignore, /* 133 */
+ curl_string, /* 134 ftp_account */
+ curl_string, /* 135 cookielist */
+ curl_integer, /* 136 ignore_content_length */
+ curl_integer, /* 137 ftp_skip_pasv_ip */
+ curl_integer, /* 138 ftp_filemethod */
+ curl_integer, /* 139 localport */
+ curl_integer, /* 140 localportrange */
+ curl_integer, /* 141 connect_only */
+ curl_function, /* 142 conv_from_network_function */
+ curl_function, /* 143 conv_to_network_function */
+ curl_function, /* 144 conv_from_utf8_function */
+ curl_offset, /* 145 max_send_speed_large */
+ curl_offset, /* 146 max_recv_speed_large */
+ curl_string, /* 147 ftp_alternative_to_user */
+ curl_function, /* 148 sockoptfunction */
+ curl_string, /* 149 sockoptdata */
+ curl_integer, /* 150 ssl_sessionid_cache */
+ curl_integer, /* 151 ssh_auth_types */
+ curl_string, /* 152 ssh_public_keyfile */
+ curl_string, /* 153 ssh_private_keyfile */
+ curl_integer, /* 154 ftp_ssl_ccc */
+ curl_integer, /* 155 timeout_ms */
+ curl_integer, /* 156 connecttimeout_ms */
+ curl_integer, /* 157 http_transfer_decoding */
+ curl_integer, /* 158 http_content_decoding */
+ curl_integer, /* 159 new_file_perms */
+ curl_integer, /* 160 new_directory_perms */
+ curl_integer, /* 161 postredir */
+ curl_string, /* 162 ssh_host_public_key_md5 */
+ curl_function, /* 163 opensocketfunction */
+ curl_string, /* 164 opensocketdata */
+ curl_string, /* 165 copypostfields */
+ curl_integer, /* 166 proxy_transfer_mode */
+ curl_function, /* 167 seekfunction */
+ curl_string, /* 168 seekdata */
+ curl_string, /* 169 crlfile */
+ curl_string, /* 170 issuercert */
+ curl_integer, /* 171 address_scope */
+ curl_integer, /* 172 certinfo */
+ curl_string, /* 173 username */
+ curl_string, /* 174 password */
+ curl_string, /* 175 proxyusername */
+ curl_string, /* 176 proxypassword */
+ curl_string, /* 177 noproxy */
+ curl_integer, /* 178 tftp_blksize */
+ curl_string, /* 179 socks5_gssapi_service */
+ curl_integer, /* 180 socks5_gssapi_nec */
+ curl_integer, /* 181 protocols */
+ curl_integer, /* 182 redir_protocols */
+ curl_string, /* 183 ssh_knownhosts */
+ curl_function, /* 184 ssh_keyfunction */
+ curl_string, /* 185 ssh_keydata */
+ curl_string, /* 186 mail_from */
+ curl_string, /* 187 mail_rcpt */
+ curl_integer, /* 188 ftp_use_pret */
+ curl_integer, /* 189 rtsp_request */
+ curl_string, /* 190 rtsp_session_id */
+ curl_string, /* 191 rtsp_stream_uri */
+ curl_string, /* 192 rtsp_transport */
+ curl_integer, /* 193 rtsp_client_cseq */
+ curl_integer, /* 194 rtsp_server_cseq */
+ curl_string, /* 195 interleavedata */
+ curl_function, /* 196 interleavefunction */
+ curl_integer, /* 197 wildcardmatch */
+ curl_function, /* 198 chunk_bgn_function */
+ curl_function, /* 199 chunk_end_function */
+ curl_function, /* 200 fnmatch_function */
+ curl_string, /* 201 chunk_data */
+ curl_string, /* 202 fnmatch_data */
+ curl_string, /* 203 resolve */
+ curl_string, /* 204 tlsauth_username */
+ curl_string, /* 205 tlsauth_password */
+ curl_string, /* 206 tlsauth_type */
+ curl_integer, /* 207 transfer_encoding */
+ curl_function, /* 208 closesocketfunction */
+ curl_string, /* 209 closesocketdata */
+ curl_integer, /* 210 gssapi_delegation */
+ curl_string, /* 211 dns_servers */
+ curl_integer, /* 212 accepttimeout_ms */
+ curl_integer, /* 213 tcp_keepalive */
+ curl_integer, /* 214 tcp_keepidle */
+ curl_integer, /* 215 tcp_keepintvl */
+ curl_integer, /* 216 ssl_options */
+ curl_string, /* 217 mail_auth */
+ curl_integer, /* 218 sasl_ir */
+ curl_function, /* 219 xferinfofunction */
+ curl_string, /* 220 xoauth2_bearer */
+ curl_string, /* 221 dns_interface */
+ curl_string, /* 222 dns_local_ip4 */
+ curl_string, /* 223 dns_local_ip6 */
+ curl_string, /* 224 login_options */
+ curl_integer, /* 225 ssl_enable_npn */
+ curl_integer, /* 226 ssl_enable_alpn */
+ curl_integer /* 227 expect_100_timeout_ms */
+};
+
+# define curl_option_min 1
+# define curl_option_max 227
+# define curl_option_writedata 1
+# define curl_option_url 2
+# define curl_option_writefunction 11
+
+# define curl_integer_base 0 /* long */
+# define curl_string_base 10000
+# define curl_object_base 10000
+# define curl_function_base 20000
+# define curl_offset_base 30000
+# define curl_offset_blob 40000
+
+typedef size_t (*curl_write_callback) (
+ char *buffer,
+ size_t size,
+ size_t nitems,
+ void *userdata
+);
+
+typedef struct curllib_state_info {
+
+ int initialized;
+ int padding;
+
+ char * (*curl_version) (
+ void
+ );
+
+ void (*curl_free) (
+ void* p
+ );
+
+ curl_instance (*curl_easy_init) (
+ void
+ );
+
+ void (*curl_easy_cleanup) (
+ curl_instance handle
+ );
+
+ curl_return_code (*curl_easy_perform) (
+ curl_instance handle
+ );
+
+ curl_return_code (*curl_easy_setopt) (
+ curl_instance handle,
+ int option,
+ ...
+ );
+
+ char* (*curl_easy_escape) (
+ curl_instance handle,
+ const char *url,
+ int length
+ );
+
+ char* (*curl_easy_unescape) (
+ curl_instance handle,
+ const char *url,
+ int length,
+ int *outlength
+ );
+
+ const char* (*curl_easy_strerror) (
+ curl_error_code errcode
+ );
+
+} curllib_state_info;
+
+static curllib_state_info curllib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .curl_version = NULL,
+ .curl_free = NULL,
+ .curl_easy_init = NULL,
+ .curl_easy_cleanup = NULL,
+ .curl_easy_perform = NULL,
+ .curl_easy_setopt = NULL,
+ .curl_easy_escape = NULL,
+ .curl_easy_unescape = NULL,
+ .curl_easy_strerror = NULL,
+
+};
+
+static int curllib_initialize(lua_State * L)
+{
+ if (! curllib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ curllib_state.curl_version = lmt_library_find(lib, "curl_version");
+ curllib_state.curl_free = lmt_library_find(lib, "curl_free");
+ curllib_state.curl_easy_init = lmt_library_find(lib, "curl_easy_init");
+ curllib_state.curl_easy_cleanup = lmt_library_find(lib, "curl_easy_cleanup");
+ curllib_state.curl_easy_perform = lmt_library_find(lib, "curl_easy_perform");
+ curllib_state.curl_easy_setopt = lmt_library_find(lib, "curl_easy_setopt");
+ curllib_state.curl_easy_escape = lmt_library_find(lib, "curl_easy_escape");
+ curllib_state.curl_easy_unescape = lmt_library_find(lib, "curl_easy_unescape");
+ curllib_state.curl_easy_strerror = lmt_library_find(lib, "curl_easy_strerror");
+
+ curllib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, curllib_state.initialized);
+ return 1;
+}
+
+/* fetch(url, { options }) | fetch({ options }) */
+
+/* we don't need threads so we can just use the local init */
+
+static size_t curllib_write_cb(char *data, size_t n, size_t l, void *b)
+{
+ luaL_addlstring((luaL_Buffer *) b, data, n * l);
+ return n * l;
+}
+
+/*tex
+ Always assume a table as we need to sanitize keys anyway. A former variant also accepted strings
+ but why have more code than needed.
+*/
+
+static int curllib_fetch(lua_State * L)
+{
+ if (curllib_state.initialized) {
+ if (lua_type(L,1) == LUA_TTABLE) {
+ curl_instance *curl = curllib_state.curl_easy_init();
+ if (curl) {
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ curllib_state.curl_easy_setopt(curl, curl_object_base + curl_option_writedata, &buffer);
+ curllib_state.curl_easy_setopt(curl, curl_function_base + curl_option_writefunction, &curllib_write_cb);
+ lua_pushnil(L); /* first key */
+ while (lua_next(L, 1) != 0) {
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ int o = lmt_tointeger(L, -2);
+ if (o >= curl_option_min && o <= curl_option_max) {
+ switch (curl_options[o]) {
+ case curl_string:
+ if (lua_type(L, -1) == LUA_TSTRING) {
+ curllib_state.curl_easy_setopt(curl, curl_string_base + o, lua_tostring(L, -1));
+ } else {
+ // return luaL_error(L, "curl option %d must be a string", o);
+ }
+ break;
+ case curl_integer:
+ switch (lua_type(L, -1)) {
+ case LUA_TNUMBER:
+ curllib_state.curl_easy_setopt(curl, curl_integer_base + o, lua_tointeger(L, -1));
+ break;
+ case LUA_TBOOLEAN:
+ curllib_state.curl_easy_setopt(curl, curl_integer_base + o, lua_toboolean(L, -1));
+ break;
+ default:
+ // return luaL_error(L, "curl option %d must be a number of boolean", o);
+ break;
+ }
+ break;
+ }
+ } else {
+ // return luaL_error(L, "curl option %d is invalid", o);
+ }
+ } else {
+ // return luaL_error(L, "curl option id should en a number");
+ }
+ lua_pop(L, 1); /* removes 'value' and keeps 'key' for next iteration */
+ }
+ int result = curllib_state.curl_easy_perform(curl);
+ if (result) {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, curllib_state.curl_easy_strerror(result));
+ result = 2;
+ } else {
+ luaL_pushresult(&buffer);
+ result = 1;
+ }
+ curllib_state.curl_easy_cleanup(curl);
+ return result;
+ }
+ }
+ }
+ return 0;
+}
+
+static int curllib_escape(lua_State * L)
+{
+ if (curllib_state.initialized) {
+ curl_instance *curl = curllib_state.curl_easy_init();
+ if (curl) {
+ size_t length = 0;
+ const char * url = lua_tolstring(L, 1, &length);
+ char *s = curllib_state.curl_easy_escape(curl, url, (int) length);
+ if (s) {
+ lua_pushstring(L,(const char *) s);
+ curllib_state.curl_free(s);
+ curllib_state.curl_easy_cleanup(curl);
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static int curllib_unescape(lua_State * L)
+{
+ if (curllib_state.initialized) {
+ curl_instance *curl = curllib_state.curl_easy_init();
+ if (curl) {
+ size_t length = 0;
+ const char *url = lua_tolstring(L, 1, &length);
+ int l = 0;
+ char *s = curllib_state.curl_easy_unescape(curl, url, (int) length, &l);
+ if (s) {
+ lua_pushlstring(L, s, l);
+ curllib_state.curl_free(s);
+ curllib_state.curl_easy_cleanup(curl);
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static int curllib_getversion(lua_State * L)
+{
+ if (curllib_state.initialized) {
+ char *version = curllib_state.curl_version();
+ if (version) {
+ lua_pushstring(L, version);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static struct luaL_Reg curllib_function_list[] = {
+ { "initialize", curllib_initialize },
+ { "fetch", curllib_fetch },
+ { "escape", curllib_escape },
+ { "unescape", curllib_unescape },
+ { "getversion", curllib_getversion },
+ { NULL, NULL },
+};
+
+int luaopen_curl(lua_State * L)
+{
+ lmt_library_register(L, "curl", curllib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtforeign.c b/source/luametatex/source/luaoptional/lmtforeign.c
new file mode 100644
index 000000000..da04eca12
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtforeign.c
@@ -0,0 +1,1191 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ In \LUATEX\ we provide an ffi library that is derived from luajit but it got orphaned a few years
+ after it showed up. A problem with such libraries is that they need to be maintained actively
+ because platforms and processors evolve. So, having a mechanism like that makes not much sense in
+ a \TEX\ engine. In \LUAMETATEX\ we therefore don't use that library but have a model for delayed
+ loading of optional libraries. A few interfaces are built in (like zint) but we don't ship any
+ library: you get what is installed on the system (which actually is the whole idea behind using
+ most libraries). Delayed loading is implemented by using function pointers and in practice that
+ is fast enough (after all we use them in \TEX\ as well as \METAPOST\ without much penalty).
+
+ But \unknown\ what if a user wants to use a library and doesn't want to write an interface? We
+ kind of end up again with something ffi. When looking around I ran into an \LUA\ module that
+ was made a few years ago (for 5.1 and 5.2) called 'alien' that also binds to libffi. But that
+ library looks a bit more complex than we need. For instance, mechanisms for callbacks use libffi
+ calls than need some compile time properties that normally come from the h files generated on
+ the system and I don't want to impose on users to also install and compile a whole chain of
+ dependencies. We could (and maybe some day will if users really need it) provide callbacks
+ too but then we also need to keep some system specific 'constants' in sync. We then probaly
+ also need to provide libraries at the contextgarden.
+
+ The basics of an interface as used in this module (running over specs) is given in the \LUA\
+ manual\ and we also use it for callbacks in \LUATEX\ and therefore \LUAMETATEX. There we use
+ varargs but here specification if converted into a recipe that libffi will bind to a function.
+ Some code below looks like the code in alien (after all I took a good look at it). The ffi
+ part is filtered from the ffi.h.in file. The interfaces are sort of what we do with other
+ libraries.
+
+ For the record: when testing, I just used a version of libffi that came with inkscape and I
+ saw several other instances on my system disk. A quick test with loading showed that it is no
+ problem in the ecosystem that we use in \TEX. The buildot on the contextgarden generates
+ binaries for several platforms and one can observe that some platforms (like bsd) are not
+ that downward compatible, so there we have multiple versions. This also means that finding
+ matching libraries can be an issue. In \CONTEXT\ we never depend on external or evolving
+ libraries so it's a user's choice in the end.
+
+ The \LUATEX\ build script and infrastructure are more complex than the \LUAMETATEX\ ones and
+ it's often the libraries that make for the - sometimes incompatible - changes which in turn
+ demands adaptation of the scripts etc in the build farm. We try to avoid that as much as
+ possible but if we ever decide to also provide libraries that match the binaries, but it
+ remains a depencenie that you want to avoid in long running projects.
+
+ Comment: I might look into a vararg variant some day, just for fun. Actually, this module is
+ mostly about the fun, so it will take some time to evolve.
+
+*/
+
+/*tex
+ Because it is an optional module, we use the optional interface.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+/*tex
+ We need to define a few ffi datatypes and function prototypes. We need to keep an eye on how
+ the library evolves but I assume the api is rather stable. We don't want to depend on a system
+ specific header file.
+*/
+
+typedef struct ffi_type {
+ size_t size;
+ unsigned short alignment;
+ unsigned short type;
+ struct ffi_type **elements;
+} ffi_type;
+
+typedef enum ffi_types {
+ ffi_void_type,
+ ffi_int_type,
+ ffi_float_type,
+ ffi_double_type,
+ ffi_longdouble_type,
+ ffi_uint8_type,
+ ffi_int8_type,
+ ffi_uint16_type,
+ ffi_int16_type,
+ ffi_uint32_type,
+ ffi_int32_type,
+ ffi_uint64_type,
+ ffi_int64_type,
+ ffi_struct_type,
+ ffi_pointer_type,
+ ffi_complex_type, /* unsupported */
+ ffi_last_type,
+} ffi_types;
+
+/*
+ The libffi api document says that the size and alignment should be zero but somehow we do crash
+ when we set the size to some value. Only size_t is now system dependent (e.g. on 32 bit windows
+ it's different).
+
+ We only need to support the architectures and operating systems that the ecosystem runs on so we
+ check a bit differently. We just don't want all these dependencies in the source tree. We have:
+
+ -- 32 64 bit intel linux | freebsd | openbsd
+ -- 64 bit intel osx
+ -- 32 64 bit intel windows mingw
+ -- 64 bit windows msvc
+ -- 64 bit arm msvc
+ -- 32 64 bit arm (rpi etc)
+ -- 64 bit arm darwin
+
+*/
+
+# if PTRDIFF_MAX == 65535
+# define ffi_size_t_type ffi_uint16_type
+# elif PTRDIFF_MAX == 2147483647
+# define ffi_size_t_type ffi_uint32_type
+# elif PTRDIFF_MAX == 9223372036854775807
+# define ffi_size_t_type ffi_uint64_type
+# elif defined(_WIN64)
+# define ffi_size_t_type ffi_uint64_type
+# else
+# define ffi_size_t_type ffi_uint32_type
+# endif
+
+/*tex This comes from the libffi.h* file: */
+
+typedef enum ffi_abi {
+
+# if defined (X86_WIN64)
+
+ FFI_FIRST_ABI = 0,
+ FFI_WIN64, /* sizeof(long double) == 8 - microsoft compilers */
+ FFI_GNUW64, /* sizeof(long double) == 16 - GNU compilers */
+ FFI_LAST_ABI,
+# ifdef __GNUC__
+ FFI_DEFAULT_ABI = FFI_GNUW64
+# else
+ FFI_DEFAULT_ABI = FFI_WIN64
+# endif
+
+# elif defined (X86_64) || (defined (__x86_64__) && defined (X86_DARWIN))
+
+ FFI_FIRST_ABI = 1,
+ FFI_UNIX64,
+ FFI_WIN64,
+ FFI_EFI64 = FFI_WIN64,
+ FFI_GNUW64,
+ FFI_LAST_ABI,
+ FFI_DEFAULT_ABI = FFI_UNIX64
+
+# elif defined (X86_WIN32)
+
+ FFI_FIRST_ABI = 0,
+ FFI_SYSV = 1,
+ FFI_STDCALL = 2,
+ FFI_THISCALL = 3,
+ FFI_FASTCALL = 4,
+ FFI_MS_CDECL = 5,
+ FFI_PASCAL = 6,
+ FFI_REGISTER = 7,
+ FFI_LAST_ABI,
+ FFI_DEFAULT_ABI = FFI_MS_CDECL
+
+# else
+
+ FFI_FIRST_ABI = 0,
+ FFI_SYSV = 1,
+ FFI_THISCALL = 3,
+ FFI_FASTCALL = 4,
+ FFI_STDCALL = 5,
+ FFI_PASCAL = 6,
+ FFI_REGISTER = 7,
+ FFI_MS_CDECL = 8,
+ FFI_LAST_ABI,
+ FFI_DEFAULT_ABI = FFI_SYSV
+
+#endif
+
+} ffi_abi;
+
+typedef enum ffi_status {
+ FFI_OK,
+ FFI_BAD_TYPEDEF,
+ FFI_BAD_ABI
+} ffi_status;
+
+typedef struct {
+ ffi_abi abi;
+ unsigned nargs;
+ ffi_type **arg_types;
+ ffi_type *rtype;
+ unsigned bytes;
+ unsigned flags;
+} ffi_cif;
+
+typedef struct foreign_state_info {
+
+ int initialized;
+ int padding;
+
+ ffi_status (*ffi_prep_cif) (
+ ffi_cif *cif,
+ ffi_abi abi,
+ unsigned int nargs,
+ ffi_type *rtype,
+ ffi_type **atypes
+ );
+
+ void (*ffi_call) (
+ ffi_cif *cif,
+ void (*fn) (void),
+ void *rvalue,
+ void **avalue
+ );
+
+ ffi_type ffi_type_void;
+ ffi_type ffi_type_uint8;
+ ffi_type ffi_type_int8;
+ ffi_type ffi_type_uint16;
+ ffi_type ffi_type_int16;
+ ffi_type ffi_type_uint32;
+ ffi_type ffi_type_int32;
+ ffi_type ffi_type_uint64;
+ ffi_type ffi_type_int64;
+ ffi_type ffi_type_float;
+ ffi_type ffi_type_double;
+ ffi_type ffi_type_pointer;
+ ffi_type ffi_type_size_t;
+
+
+} foreign_state_info;
+
+static foreign_state_info foreign_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .ffi_prep_cif = NULL,
+ .ffi_call = NULL,
+
+ .ffi_type_void = { .size = 1, .alignment = 0, .type = ffi_void_type, .elements = NULL },
+ .ffi_type_uint8 = { .size = sizeof(uint8_t), .alignment = 0, .type = ffi_uint8_type, .elements = NULL },
+ .ffi_type_int8 = { .size = sizeof(int8_t), .alignment = 0, .type = ffi_int8_type, .elements = NULL },
+ .ffi_type_uint16 = { .size = sizeof(uint16_t), .alignment = 0, .type = ffi_uint16_type, .elements = NULL },
+ .ffi_type_int16 = { .size = sizeof(int16_t), .alignment = 0, .type = ffi_int16_type, .elements = NULL },
+ .ffi_type_uint32 = { .size = sizeof(uint32_t), .alignment = 0, .type = ffi_uint32_type, .elements = NULL },
+ .ffi_type_int32 = { .size = sizeof(int32_t), .alignment = 0, .type = ffi_int32_type, .elements = NULL },
+ .ffi_type_uint64 = { .size = sizeof(uint64_t), .alignment = 0, .type = ffi_uint64_type, .elements = NULL },
+ .ffi_type_int64 = { .size = sizeof(int64_t), .alignment = 0, .type = ffi_int64_type, .elements = NULL },
+ .ffi_type_float = { .size = sizeof(float), .alignment = 0, .type = ffi_float_type, .elements = NULL },
+ .ffi_type_double = { .size = sizeof(double), .alignment = 0, .type = ffi_double_type, .elements = NULL },
+ .ffi_type_pointer = { .size = sizeof(void *), .alignment = 0, .type = ffi_pointer_type, .elements = NULL },
+ .ffi_type_size_t = { .size = sizeof(size_t), .alignment = 0, .type = ffi_size_t_type, .elements = NULL },
+
+};
+
+/*tex
+ We use similar names as in other modules:
+*/
+
+#define FOREIGN_METATABLE_LIBRARY "foreign.library"
+#define FOREIGN_METATABLE_FUNCTION "foreign.function"
+#define FOREIGN_METATABLE_POINTER "foreign.pointer"
+
+/*tex
+ First I had some info structure as we have elsewhere but in the end not much was needed so we
+ now have some simple arrays instead.
+*/
+
+typedef enum foreign_type {
+ foreign_type_void,
+ foreign_type_byte, foreign_type_char,
+ foreign_type_short, foreign_type_ushort,
+ foreign_type_int, foreign_type_uint,
+ foreign_type_long, foreign_type_ulong,
+ foreign_type_longlong, foreign_type_ulonglong,
+ foreign_type_float, foreign_type_double,
+ foreign_type_size_t,
+ foreign_type_string,
+ foreign_type_pointer,
+ foreign_type_reference_to_char,
+ foreign_type_reference_to_int,
+ foreign_type_reference_to_uint,
+ foreign_type_reference_to_double,
+ foreign_type_max,
+} foreign_type;
+
+# define foreign_first_value_return_type foreign_type_void
+# define foreign_last_value_return_type foreign_type_pointer
+
+static const char *foreign_typenames[] = {
+ "void",
+ /* basic types */
+ "byte", "char",
+ "short", "ushort",
+ "int", "uint",
+ "long", "ulong",
+ "longlong", "ulonglong",
+ "float", "double",
+ "size_t",
+ "string",
+ "pointer",
+ "reference to char",
+ "reference to int",
+ "reference to uint",
+ "reference to double",
+ NULL,
+};
+
+static ffi_type *foreign_typecodes[] = {
+ &foreign_state.ffi_type_void,
+ &foreign_state.ffi_type_int8, &foreign_state.ffi_type_uint8,
+ &foreign_state.ffi_type_int16, &foreign_state.ffi_type_uint16,
+ &foreign_state.ffi_type_int32, &foreign_state.ffi_type_uint32,
+ &foreign_state.ffi_type_int64, &foreign_state.ffi_type_uint64,
+ &foreign_state.ffi_type_int64, &foreign_state.ffi_type_uint64,
+ &foreign_state.ffi_type_float, &foreign_state.ffi_type_double,
+ &foreign_state.ffi_type_size_t,
+ &foreign_state.ffi_type_pointer, /* string */
+ &foreign_state.ffi_type_pointer, /* pointer */
+ &foreign_state.ffi_type_pointer,
+ &foreign_state.ffi_type_pointer,
+ &foreign_state.ffi_type_pointer,
+ &foreign_state.ffi_type_pointer,
+ NULL,
+};
+
+typedef struct foreign_library {
+ void *library;
+ char *name;
+ ffi_abi abi;
+ int padding;
+} foreign_library;
+
+typedef enum foreign_states {
+ foreign_state_initialized,
+ foreign_state_registered,
+} foreign_states;
+
+typedef struct foreign_function {
+ foreign_library *library;
+ char *name;
+ void *function;
+ foreign_type result_type;
+ int nofarguments;
+ foreign_type *arguments;
+ ffi_type *ffi_result_type;
+ ffi_type **ffi_arguments;
+ ffi_cif cif;
+ ffi_abi abi;
+} foreign_function;
+
+typedef enum foreign_pointer_types {
+ foreign_pointer_state_regular,
+ foreign_pointer_state_buffer,
+} foreign_pointer_types;
+
+typedef struct foreign_pointer {
+ void *ptr;
+ int state;
+ int padding;
+} foreign_pointer;
+
+/*tex
+ We use the already defined helpers instead of setting up loading here. That way we're also
+ consistent in lookups. You need to pass the resolved name (so at the \LUA\ end we wrap the
+ loader to use the library resolver. So no check for loaders here etc.
+*/
+
+
+#ifdef WIN32
+# ifndef WINDOWS
+# define WINDOWS
+# endif
+#endif
+
+#if !defined(WINDOWS) || defined(_WIN64)
+#define FFI_STDCALL FFI_DEFAULT_ABI
+#endif
+
+#ifdef __APPLE__
+#define FFI_SYSV FFI_DEFAULT_ABI
+#endif
+
+typedef struct foreign_abi_entry {
+ const char *name;
+ ffi_abi abi;
+} foreign_abi_entry;
+
+# define foreign_abi_max 3
+
+static foreign_abi_entry foreign_abi_map[] = {
+ { .name = "default", .abi = FFI_DEFAULT_ABI },
+ { .name = "cdecl", .abi = FFI_SYSV },
+ { .name = "stdcall", .abi = FFI_STDCALL },
+};
+
+typedef enum foreign_library_uv_slots {
+ library_name_uv = 1,
+ library_registry_uv = 2,
+
+} foreign_library_uv_slots;
+
+typedef enum foreign_function_uv_slots {
+ function_name_uv = 1,
+ function_finalizer_uv = 2,
+} foreign_function_uv_slots;
+
+static int foreignlib_not_yet_initialized(lua_State *L)
+{
+ return luaL_error(L, "foreign: not yet initialized");
+}
+
+static int foreignlib_allocation_error(lua_State *L)
+{
+ return luaL_error(L, "foreign: allocation error");
+}
+
+static foreign_library *foreignlib_library_check(lua_State *L, int index)
+{
+ return (foreign_library *) luaL_checkudata(L, index, FOREIGN_METATABLE_LIBRARY);
+}
+
+static foreign_function *foreignlib_function_check(lua_State *L, int index)
+{
+ return (foreign_function *) luaL_checkudata(L, index, FOREIGN_METATABLE_FUNCTION);
+}
+
+static foreign_pointer *foreignlib_pointer_check(lua_State *L, int index)
+{
+ return (foreign_pointer *) luaL_checkudata(L, index, FOREIGN_METATABLE_POINTER);
+}
+
+static int foreignlib_library_tostring(lua_State *L)
+{
+ foreign_library *library = foreignlib_library_check(L, 1);
+ if (library) {
+ lua_pushfstring(L, "<foreign.library %s>", library->name ? library->name : "unknown");
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int foreignlib_function_tostring(lua_State *L)
+{
+ foreign_function *function = foreignlib_function_check(L, 1);
+ if (function) {
+ foreign_library *library = function->library;
+ if (library) {
+ lua_pushfstring(L, "<foreign.function %s in library %s>", function->name ? function->name : "unknown", ((library && library->name) ? library->name : "unknown"));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int foreignlib_pointer_tostring(lua_State *L)
+{
+ foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
+ if (! pointer) {
+ return 0;
+ } else {
+ lua_pushfstring(L, pointer->state == foreign_pointer_state_buffer ? "<foreign.buffer %p>" : "<foreign.pointer %p>", pointer->ptr);
+ return 1;
+ }
+}
+
+static int foreignlib_pointer_gc(lua_State *L)
+{
+ foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
+ if (pointer->state == foreign_pointer_state_buffer) {
+ lmt_memory_free(pointer->ptr);
+ /* not needed: */
+ pointer->state = foreign_pointer_state_regular;
+ pointer->ptr = NULL;
+ }
+ return 0;
+}
+
+/*tex
+ We accept numbers as well as names (just in case go symboloc as we do with other modules).
+*/
+
+static int foreignlib_type_found(lua_State *L, int slot, int dflt)
+{
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ {
+ int i = (int) lua_tointeger(L, slot);
+ if (i >= 0 && i < foreign_type_max) {
+ return i;
+ }
+ break;
+ }
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, slot);
+ for (int i = 0; i < foreign_type_max; i++) {
+ if (strcmp(s, foreign_typenames[i]) == 0) {
+ return i;
+ }
+ }
+ break;
+ }
+ }
+ return dflt;
+}
+
+static int foreignlib_abi_found(lua_State *L, int slot, int dflt)
+{
+ switch (lua_type(L, slot)) {
+ case LUA_TNUMBER:
+ {
+ int i = (int) lua_tointeger(L, slot);
+ if (i >= 0 && i < foreign_abi_max) {
+ return foreign_abi_map[i].abi;
+ }
+ break;
+ }
+ case LUA_TSTRING:
+ {
+ const char *s = lua_tostring(L, slot);
+ for (int i = 0; i < foreign_abi_max; i++) {
+ if (strcmp(s, foreign_abi_map[i].name) == 0) {
+ return foreign_abi_map[i].abi;
+ }
+ }
+ break;
+ }
+ }
+ return dflt;
+}
+
+static int foreignlib_types(lua_State* L)
+{
+ lua_createtable(L, foreign_type_max, 0);
+ for (lua_Integer i = 0; i < foreign_type_max; i++) {
+ lua_pushstring(L, foreign_typenames[i]);
+ lua_rawseti(L, -2, i + 1);
+ }
+ return 1;
+}
+
+static int foreignlib_abivalues(lua_State* L)
+{
+ lua_createtable(L, 0, foreign_abi_max);
+ for (lua_Integer i = 0; i < foreign_abi_max; i++) {
+ lua_pushstring(L, foreign_abi_map[i].name);
+ lua_pushinteger(L, foreign_abi_map[i].abi);
+ lua_rawset(L, -3);
+ }
+ return 1;
+}
+
+static int foreignlib_load(lua_State *L)
+{
+ if (foreign_state.initialized) {
+ size_t len;
+ const char *libraryname = lua_tolstring(L, 1, &len);
+ if (libraryname && len > 0) {
+ foreign_library *library = (foreign_library *) lua_newuserdatauv(L, sizeof(foreign_library), 2);
+ if (library) {
+ void *libraryreference = lmt_library_open_indeed(libraryname);
+ if (libraryreference) {
+ library->name = lmt_memory_malloc(sizeof(char) * (len + 1));
+ if (library->name) {
+ strcpy(library->name, libraryname);
+ library->library = libraryreference;
+ library->abi = foreignlib_abi_found(L, 2, FFI_DEFAULT_ABI);
+ lua_pushvalue(L, 1);
+ lua_setiuservalue(L, -2, library_name_uv);
+ lua_newtable(L);
+ lua_setiuservalue(L, -2, library_registry_uv);
+ luaL_getmetatable(L, FOREIGN_METATABLE_LIBRARY);
+ lua_setmetatable(L, -2);
+ return 1;
+ } else {
+ goto ALLOCATION_ERROR;
+ }
+ } else {
+ return luaL_error(L, "foreign: invalid library");
+ }
+ } else {
+ goto ALLOCATION_ERROR;
+ }
+ } else {
+ return luaL_error(L, "foreign: invalid library name");
+ }
+ ALLOCATION_ERROR:
+ return foreignlib_allocation_error(L);
+ } else {
+ return foreignlib_not_yet_initialized(L);
+ }
+}
+
+static int foreignlib_library_register(lua_State *L)
+{
+ if (foreign_state.initialized) {
+ /* 1:library 2:specification */
+ foreign_library *library = foreignlib_library_check(L, 1);
+ if (lua_type(L, 2) == LUA_TTABLE) {
+ /* 1:library 2:specification -1:name */
+ if (lua_getfield(L, 2, "name") == LUA_TSTRING) {
+ /* 1:library 2:specification -2:name */
+ lua_getiuservalue(L, 1, library_registry_uv);
+ /* 1:library 2:specification -2:name -1:registry */
+ lua_pushvalue(L, -2);
+ /* 1:library 2:specification -3:name -2:registry -1:name */
+ lua_rawget(L, -2);
+ if (lua_type(L, -1) == LUA_TUSERDATA) {
+ /* 1:library 2:specification -3:name -2:registry -1:function */
+ return 1;
+ } else {
+ /* 1:library 2:specification -3:name -2:registry -1:nil */
+ size_t len;
+ const char *functionname = lua_tolstring(L, -3, &len);
+ void *functionreference = lmt_library_find_indeed(library->library, functionname);
+ lua_pop(L, 1);
+ if (functionreference) {
+ /* 1:library 2:specification -2:name -1:registry */
+ foreign_function *function = (foreign_function *) lua_newuserdatauv(L, sizeof(foreign_function), 2);
+ if (function) {
+ /* 1:library 2:specification -3:name -2:registry -1:function */
+ lua_pushvalue(L, -3);
+ /* 1:library 2:specification -4:name -3:registry -2:function -1:name */
+ lua_pushvalue(L, -2);
+ /* 1:library 2:specification -5:name -4:registry -3:function -2:name -1:function */
+ lua_rawset(L, -4);
+ /* 1:library 2:specification -3:name -2:registry -1:function */
+ lua_pushvalue(L, -3);
+ /* 1:library 2:specification -4:name -3:registry -2:function -1:name */
+ lua_setiuservalue(L, -2, function_name_uv);
+ lua_getfield(L, 2, "finalizer");
+ /* 1:library 2:specification -4:name -3:registry -2:function -1:finalizer */
+ lua_setiuservalue(L, -2, function_finalizer_uv);
+ /* 1:library 2:specification -3:name -2:registry -1:function */
+ luaL_getmetatable(L, FOREIGN_METATABLE_FUNCTION);
+ /* 1:library 2:specification -4:name -3:registry -2:function -1:metatable */
+ lua_setmetatable(L, -2);
+ /* 1:library 2:specification -3:name -2:registry -1:function */
+ function->name = (char *) lmt_memory_malloc((size_t) len + 1);
+ if (function->name) {
+ strcpy(function->name, functionname);
+ function->function = functionreference;
+ function->library = library;
+ function->arguments = NULL;
+ function->ffi_arguments = NULL;
+ /* set the return type */
+ lua_getfield(L, 2, "result");
+ function->result_type = foreignlib_type_found(L, -1, foreign_type_void);
+ if (function->result_type >= foreign_first_value_return_type && function->result_type <= foreign_last_value_return_type) {
+ function->ffi_result_type = foreign_typecodes[function->result_type];
+ lua_pop(L, 1);
+ /* set the abi (will move to library) */
+ lua_getfield(L, 2, "abi");
+ function->abi = foreignlib_abi_found(L, -1, library->abi);
+ lua_pop(L, 1);
+ /* set the argument types */
+ switch (lua_getfield(L, 2, "arguments")) {
+ case LUA_TTABLE:
+ {
+ function->nofarguments = (int) lua_rawlen(L, -1);
+ if (function->nofarguments > 0) {
+ function->ffi_arguments = (ffi_type **) lmt_memory_malloc(function->nofarguments * sizeof(ffi_type *));
+ function->arguments = (foreign_type *) lmt_memory_malloc(function->nofarguments * sizeof(foreign_type));
+ if (function->ffi_arguments && function->arguments) {
+ for (lua_Integer i = 0; i < function->nofarguments; i++) {
+ lua_rawgeti(L, -1, i + 1);
+ function->arguments[i] = foreignlib_type_found(L, -1, foreign_type_int); /* maybe issue an error */
+ function->ffi_arguments[i] = foreign_typecodes[function->arguments[i]];
+ lua_pop(L, 1);
+ }
+ } else {
+ goto ALLOCATION_ERROR;
+ }
+ }
+ break;
+ }
+ case LUA_TSTRING:
+ {
+ /* Just one argument, no varag here as it's too ugly otherwise. */
+ function->nofarguments = 1;
+ function->ffi_arguments = (ffi_type **) lmt_memory_malloc(sizeof(ffi_type *));
+ function->arguments = (foreign_type *) lmt_memory_malloc(sizeof(foreign_type));
+ if (function->ffi_arguments && function->arguments) {
+ function->arguments[0] = foreignlib_type_found(L, -1, foreign_type_int); /* maybe issue an error */
+ function->ffi_arguments[0] = foreign_typecodes[function->arguments[0]];
+ } else {
+ goto ALLOCATION_ERROR;
+ }
+ break;
+ }
+ }
+ lua_pop(L, 1);
+ if (foreign_state.ffi_prep_cif(&(function->cif), function->abi, function->nofarguments, function->ffi_result_type, function->ffi_arguments) == FFI_OK) {
+ return 1;
+ } else {
+ return luaL_error(L, "foreign: error in libffi preparation");
+ }
+ } else {
+ return luaL_error(L, "foreign: invalid return type for function %s", functionname);
+ }
+ } else {
+ goto ALLOCATION_ERROR;
+ }
+ }
+ } else {
+ return luaL_error(L, "foreign: unknown function %s", functionname);
+ }
+ }
+ } else {
+ return luaL_error(L, "foreign: function name expected");
+ }
+ } else {
+ return luaL_error(L, "foreign: specification table expected");
+ }
+ ALLOCATION_ERROR:
+ return foreignlib_allocation_error(L);
+ } else {
+ return foreignlib_not_yet_initialized(L);
+ }
+}
+
+static int foreignlib_library_registered(lua_State *L)
+{
+ if (foreign_state.initialized) {
+ foreign_library *library = foreignlib_library_check(L, 1);
+ if (library) {
+ lua_getiuservalue(L, 1, library_registry_uv);
+ if (lua_type(L, 2) == LUA_TSTRING) {
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ if (lua_type(L, -1) == LUA_TUSERDATA) {
+ /* 1:library 2:name -3:registry -2:name -1:function */
+ return 1;
+ } else {
+ size_t len;
+ const char *functionname = lua_tolstring(L, 2, &len);
+ return luaL_error(L, "foreign: unknown function %s", functionname);
+ }
+ } else {
+ lua_newtable(L);
+ lua_pushnil(L);
+ while (lua_next(L, -3)) {
+ /* key -2 value -1 | key has to stay*/
+ lua_pushvalue(L, -2);
+ lua_rawset(L, -4);
+ }
+ lua_pop(L, 1);
+ return 1;
+ }
+ }
+ } else {
+ return foreignlib_not_yet_initialized(L);
+ }
+ return 0;
+}
+
+static int foreignlib_library_available(lua_State *L)
+{
+ if (foreign_state.initialized) {
+ foreign_library *library = foreignlib_library_check(L, 1);
+ if (library && lua_type(L, 2) == LUA_TSTRING) {
+ lua_getiuservalue(L, 1, library_registry_uv);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ lua_pushboolean(L, lua_type(L, -1) == LUA_TUSERDATA);
+ return 1;
+ }
+ } else {
+ return foreignlib_not_yet_initialized(L);
+ }
+ return 0;
+}
+
+ /*tex This one is adapted from the alien version (watch the way pointer arguments are returned). */
+
+static int foreignlib_function_call(lua_State *L)
+{
+ int nofreturnvalues = 1; /* we always return at least nil */
+ foreign_function *function = foreignlib_function_check(L, 1);
+ ffi_cif *cif = &(function->cif);
+ int nofarguments = lua_gettop(L) - 1;
+ void **arguments = NULL;
+ int luacall = 0;
+ if (nofarguments != function->nofarguments) {
+ return luaL_error(L, "foreign: function '%s' expects %d arguments", function->name, function->nofarguments);
+ }
+ lua_getiuservalue(L, 1, function_finalizer_uv);
+ luacall = lua_type(L, -1) == LUA_TFUNCTION;
+ if (! luacall) {
+ lua_pop(L, 1);
+ }
+ if (nofarguments > 0) {
+ arguments = lmt_memory_malloc(sizeof(void*) * nofarguments);
+ if (arguments) {
+ for (int i = 0; i < nofarguments; i++) {
+ void *argument = NULL;
+ int slot = i + 2;
+ switch (function->arguments[i]) {
+ case foreign_type_byte : argument = lmt_memory_malloc(sizeof(char)); *((char *) argument) = (signed char) lua_tointeger(L, slot); break;
+ case foreign_type_char : argument = lmt_memory_malloc(sizeof(unsigned char)); *((unsigned char *) argument) = (unsigned char) lua_tointeger(L, slot); break;
+ case foreign_type_short : argument = lmt_memory_malloc(sizeof(short)); *((short *) argument) = (short) lua_tointeger(L, slot); break;
+ case foreign_type_ushort : argument = lmt_memory_malloc(sizeof(unsigned short)); *((unsigned short *) argument) = (unsigned short) lua_tointeger(L, slot); break;
+ case foreign_type_int : argument = lmt_memory_malloc(sizeof(int)); *((int *) argument) = (int) lua_tointeger(L, slot); break;
+ case foreign_type_uint : argument = lmt_memory_malloc(sizeof(unsigned int)); *((unsigned int *) argument) = (unsigned int) lua_tointeger(L, slot); break;
+ case foreign_type_long : argument = lmt_memory_malloc(sizeof(long)); *((long *) argument) = (long) lua_tointeger(L, slot); break;
+ case foreign_type_ulong : argument = lmt_memory_malloc(sizeof(unsigned long)); *((unsigned long *) argument) = (unsigned long) lua_tointeger(L, slot); break;
+ case foreign_type_longlong : argument = lmt_memory_malloc(sizeof(long long)); *((long long *) argument) = (long long) lua_tointeger(L, slot); break;
+ case foreign_type_ulonglong: argument = lmt_memory_malloc(sizeof(unsigned long long)); *((unsigned long long *) argument) = (unsigned long long) lua_tointeger(L, slot); break;
+ case foreign_type_float : argument = lmt_memory_malloc(sizeof(float)); *((float *) argument) = (float) lua_tonumber (L, slot); break;
+ case foreign_type_double : argument = lmt_memory_malloc(sizeof(double)); *((double *) argument) = (double) lua_tonumber (L, slot); break;
+ case foreign_type_size_t : argument = lmt_memory_malloc(sizeof(size_t)); *((size_t *) argument) = (size_t) lua_tointeger(L, slot); break;
+ case foreign_type_string :
+ {
+ argument = lmt_memory_malloc(sizeof(char*));
+ if (argument) {
+ *((const char**) argument) = lua_type(L, slot) == LUA_TSTRING ? lua_tostring(L, slot) : NULL;
+ break;
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ case foreign_type_pointer :
+ {
+ /* why not just use the pointers */
+ argument = lmt_memory_malloc(sizeof(char*));
+ if (argument) {
+ switch (lua_type(L, slot)) {
+ case LUA_TSTRING:
+ {
+ /*tex A packed 5.4 string. */
+ *((const char **) argument) = lua_tostring(L, slot);
+ break;
+ }
+ case LUA_TUSERDATA:
+ {
+ /*tex A constructed array or so. */
+ foreign_pointer *pointer = foreignlib_pointer_check(L, slot);
+ *((void **) argument) = pointer ? pointer->ptr : NULL;
+ break;
+ }
+ default:
+ {
+ *((void **) argument) = NULL;
+ break;
+ }
+ }
+ break;
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ case foreign_type_reference_to_char:
+ {
+ argument = lmt_memory_malloc(sizeof(char *));
+ if (argument) {
+ *((char **) argument) = lmt_memory_malloc(sizeof(char));
+ **((char **) argument) = (char) lua_tointeger(L, slot);
+ nofreturnvalues++;
+ break;
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ case foreign_type_reference_to_int:
+ {
+ argument = lmt_memory_malloc(sizeof(int *));
+ if (argument) {
+ *((int **) argument) = lmt_memory_malloc(sizeof(int));
+ **((int **) argument) = (int) lua_tointeger(L, slot);
+ nofreturnvalues++;
+ break;
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ case foreign_type_reference_to_uint:
+ {
+ argument = lmt_memory_malloc(sizeof(unsigned int *));
+ if (argument) {
+ *((unsigned int **) argument) = lmt_memory_malloc(sizeof(unsigned int));
+ **((unsigned int **) argument) = (unsigned int) lua_tointeger(L, slot);
+ nofreturnvalues++;
+ break;
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ case foreign_type_reference_to_double:
+ {
+ argument = lmt_memory_malloc(sizeof(double *));
+ if (argument) {
+ *((double **) argument) = lmt_memory_malloc(sizeof(double));
+ **((double **) argument) = (double) lua_tonumber(L, slot);
+ nofreturnvalues++;
+ break;
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ default:
+ return luaL_error(L, "foreign: invalid parameter %d for '%s')", function->arguments[i], function->name);
+ }
+ arguments[i] = argument;
+ }
+ } else {
+ return foreignlib_allocation_error(L);
+ }
+ }
+ switch (function->result_type) {
+ case foreign_type_void : { foreign_state.ffi_call(cif, function->function, NULL, arguments); lua_pushnil (L); break; }
+ case foreign_type_byte : { int r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (signed char) r); break; }
+ case foreign_type_char : { int r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (unsigned char) r); break; }
+ case foreign_type_short : { int r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (short) r); break; }
+ case foreign_type_ushort : { int r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (unsigned short) r); break; }
+ case foreign_type_int : { int r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (int) r); break; }
+ case foreign_type_uint : { int r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (unsigned int) r); break; }
+ case foreign_type_long : { long r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (long) r); break; }
+ case foreign_type_ulong : { unsigned long r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (unsigned long) r); break; }
+ case foreign_type_longlong : { long long r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (lua_Integer) r); break; }
+ case foreign_type_ulonglong: { unsigned long long r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, (lua_Integer) r); break; }
+ case foreign_type_float : { float r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushnumber (L, r); break; }
+ case foreign_type_double : { double r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushnumber (L, r); break; }
+ case foreign_type_size_t : { size_t r; foreign_state.ffi_call(cif, function->function, &r, arguments); lua_pushinteger(L, r); break; }
+ case foreign_type_string :
+ {
+ void *str = NULL;
+ foreign_state.ffi_call(cif, function->function, &str, arguments);
+ if (str) {
+ lua_pushstring(L, (char *) str);
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ }
+ case foreign_type_pointer :
+ {
+ void *ptr = NULL;
+ foreign_state.ffi_call(cif, function->function, &ptr, arguments);
+ if (ptr) {
+ foreign_pointer *pointer = (foreign_pointer *) lua_newuserdatauv(L, sizeof(foreign_pointer), 0);
+ luaL_getmetatable(L, FOREIGN_METATABLE_POINTER);
+ lua_setmetatable(L, -2);
+ pointer->ptr = ptr;
+ pointer->state = foreign_pointer_state_regular;
+ } else {
+ lua_pushnil(L);
+ }
+ break;
+ }
+ default:
+ return luaL_error(L, "foreign: invalid return value %d for '%s')", function->result_type, function->name);
+ }
+ for (int i = 0; i < nofarguments; i++) {
+ switch (function->arguments[i]) {
+ case foreign_type_reference_to_char : lua_pushinteger(L, **(char **) arguments[i]); break;
+ case foreign_type_reference_to_int : lua_pushinteger(L, **(int **) arguments[i]); break;
+ case foreign_type_reference_to_uint : lua_pushinteger(L, **(unsigned int **) arguments[i]); break;
+ case foreign_type_reference_to_double: lua_pushnumber (L, **(double **) arguments[i]); break;
+ default: break;
+ }
+ lmt_memory_free(arguments[i]); /* not needed for pointers when we just use pointer */
+ }
+ lmt_memory_free(arguments);
+ if (luacall) {
+ lua_call(L, nofreturnvalues, 1);
+ return 1;
+ } else {
+ return nofreturnvalues;
+ }
+}
+
+static int foreignlib_library_gc(lua_State *L)
+{
+ foreign_library *library = foreignlib_library_check(L, 1);
+ if (library->library) {
+ lmt_library_open_indeed(library->library);
+ lmt_memory_free(library->name);
+ }
+ return 0;
+}
+
+static int foreignlib_function_gc(lua_State *L)
+{
+ foreign_function *function = foreignlib_function_check(L, 1);
+ lmt_memory_free(function->name);
+ lmt_memory_free(function->arguments);
+ lmt_memory_free(function->ffi_arguments);
+ return 0;
+}
+
+/* */
+
+static int foreignlib_newbuffer(lua_State *L)
+{
+ size_t size = lua_tointeger(L, 1);
+ foreign_pointer *pointer = (foreign_pointer *) lua_newuserdatauv(L, sizeof(foreign_pointer), 0);
+ luaL_getmetatable(L, FOREIGN_METATABLE_POINTER);
+ lua_setmetatable(L, -2);
+ pointer->ptr = lmt_memory_malloc(size);
+ pointer->state = foreign_pointer_state_buffer;
+ return 1;
+}
+
+static int foreignlib_getbuffer(lua_State *L)
+{
+ foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
+ if (pointer && pointer->state == foreign_pointer_state_buffer && pointer->ptr) {
+ size_t size = lua_tointeger(L, 2);
+ if (size > 0) {
+ lua_pushlstring(L, pointer->ptr, size);
+ } else {
+ lua_pushnil(L);
+ }
+ lmt_memory_free(pointer->ptr);
+ pointer->ptr = NULL;
+ pointer->state = foreign_pointer_state_regular;
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/* pointer to array of pointers */
+
+static int foreignlib_totable(lua_State *L)
+{
+ foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
+ if (pointer) {
+ void *ptr = pointer->ptr;
+ if (ptr) {
+ int resulttype = foreignlib_type_found(L, 2, foreign_type_void);
+ int size = (int) luaL_optinteger(L, 3, -1);
+ lua_createtable(L, size > 0 ? size : 0, 0);
+ switch (resulttype) {
+ case foreign_type_void:
+ return 0;
+ case foreign_type_string:
+ {
+ void **ptr = pointer->ptr;
+ if (ptr) {
+ lua_Integer r = 0;
+ lua_newtable(L);
+ if (size < 0) {
+ while (ptr[r]) {
+ lua_pushstring(L, ptr[r]);
+ lua_rawseti(L, -2, ++r);
+ }
+ } else {
+ for (lua_Integer i = 0; i < size; i++) {
+ lua_pushstring(L, ptr[i]);
+ lua_rawseti(L, -2, ++r);
+ }
+ }
+ }
+ break;
+ }
+ case foreign_type_byte : { signed char *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_char : { unsigned char *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_short : { short *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_ushort : { unsigned short *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_int : { int *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_uint : { unsigned int *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_long : { long *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_ulong : { unsigned long *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_longlong : { long long *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_ulonglong: { unsigned long long *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_float : { float *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushnumber (L, (lua_Number) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_double : { double *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushnumber (L, (lua_Number) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ case foreign_type_size_t : { size_t *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
+ }
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+/*tex
+
+ Here we prepare some metatables. Todo: newindex. When we don't use a metatable for the
+ library we can have more keys, like list and so.
+
+ local library = foreign.load("whatever","abi")
+
+ library:register { name = ..., result = ..., arguments = { ... }, abi = ... )
+ library:registered ("name")
+ library:registered ()
+ library:available ("name")
+
+ foreign.load()
+ foreign.abivalues()
+ foreign.types()
+
+ todo: ckeck what this abi does: probably better at lib loading time than per function
+
+*/
+
+static struct luaL_Reg foreignlib_function_methods[] = {
+ { "register", foreignlib_library_register },
+ { "registered", foreignlib_library_registered },
+ { "available", foreignlib_library_available },
+ { NULL, NULL },
+};
+
+static void foreignlib_populate(lua_State *L)
+{
+ luaL_newmetatable(L, FOREIGN_METATABLE_LIBRARY);
+ lua_pushliteral(L, "__gc");
+ lua_pushcfunction(L, foreignlib_library_gc);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__tostring");
+ lua_pushcfunction(L, foreignlib_library_tostring);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__index");
+ lua_newtable(L);
+ for (int i = 0; foreignlib_function_methods[i].name; i++) {
+ lua_pushstring(L, foreignlib_function_methods[i].name);
+ lua_pushcfunction(L, foreignlib_function_methods[i].func);
+ lua_settable(L, -3);
+ }
+ lua_settable(L, -3);
+ lua_pop(L, 1);
+
+ luaL_newmetatable(L, FOREIGN_METATABLE_FUNCTION);
+ lua_pushliteral(L, "__gc");
+ lua_pushcfunction(L, foreignlib_function_gc);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__tostring");
+ lua_pushcfunction(L, foreignlib_function_tostring);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__call");
+ lua_pushcfunction(L, foreignlib_function_call);
+ lua_settable(L, -3);
+ lua_pop(L, 1);
+
+ luaL_newmetatable(L, FOREIGN_METATABLE_POINTER);
+ lua_pushliteral(L, "__gc");
+ lua_pushcfunction(L, foreignlib_pointer_gc);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__tostring");
+ lua_pushcfunction(L, foreignlib_pointer_tostring);
+ lua_settable(L, -3);
+}
+
+/*tex
+ Finally it all somes together in the initializer. We expect the caller to handle the lookup
+ of |libffi| which can have different names per operating system.
+*/
+
+static int foreignlib_initialize(lua_State * L)
+{
+ if (! foreign_state.initialized) {
+ if (lmt_engine_state.permit_loadlib) {
+ /*tex Just an experiment. */
+ const char *filename = lua_tostring(L, 1); /* libffi */
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ foreign_state.ffi_prep_cif = lmt_library_find(lib, "ffi_prep_cif");
+ foreign_state.ffi_call = lmt_library_find(lib, "ffi_call" );
+
+ foreign_state.initialized = lmt_library_okay(lib);
+ }
+ if (foreign_state.initialized) {
+ foreignlib_populate(L);
+ }
+ } else {
+ return luaL_error(L, "foreign: use --permitloadlib to enable this");
+ }
+ }
+ lua_pushboolean(L, foreign_state.initialized);
+ return 1;
+}
+
+static struct luaL_Reg foreignlib_function_list[] = {
+ { "initialize", foreignlib_initialize },
+ { "load", foreignlib_load },
+ { "types", foreignlib_types },
+ { "newbuffer", foreignlib_newbuffer },
+ { "getbuffer", foreignlib_getbuffer },
+ { "abivalues", foreignlib_abivalues }, /* mostly for diagnostics */
+ { "totable", foreignlib_totable },
+ { NULL, NULL },
+};
+
+int luaopen_foreign(lua_State * L)
+{
+ lmt_library_register(L, "foreign", foreignlib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtghostscript.c b/source/luametatex/source/luaoptional/lmtghostscript.c
new file mode 100644
index 000000000..b16c3767c
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtghostscript.c
@@ -0,0 +1,175 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+# define GS_ARG_ENCODING_UTF8 1
+
+typedef struct gslib_state_info {
+
+ int initialized;
+ int padding;
+ luaL_Buffer outbuffer;
+ luaL_Buffer errbuffer;
+
+ int (*gsapi_new_instance) (
+ void **pinstance,
+ void *caller_handle
+ );
+
+ void (*gsapi_delete_instance) (
+ void * instance
+ );
+
+ int (*gsapi_set_arg_encoding) (
+ void *instance,
+ int encoding
+ );
+
+ int (*gsapi_init_with_args) (
+ void *instance,
+ int argc,
+ const char **argv
+ );
+
+ int (*gsapi_set_stdio) (
+ void *instance,
+ int (*stdin_fn )(void *caller_handle, char *buf, int len),
+ int (*stdout_fn)(void *caller_handle, const char *str, int len),
+ int (*stderr_fn)(void *caller_handle, const char *str, int len)
+ );
+
+ /*
+ int (*gsapi_run_string_begin) (void *instance, int user_errors, int *pexit_code);
+ int (*gsapi_run_string_continue) (void *instance, const char *str, unsigned int length, int user_errors, int *pexit_code);
+ int (*gsapi_run_string_end) (void *instance, int user_errors, int *pexit_code);
+ int (*gsapi_run_string_with_length) (void *instance, const char *str, unsigned int length, int user_errors, int *pexit_code);
+ int (*gsapi_run_string) (void *instance, const char *str, int user_errors, int *pexit_code);
+ int (*gsapi_run_file) (void *instance, const char *file_name, int user_errors, int *pexit_code);
+ int (*gsapi_exit) (void *instance);
+ */
+
+} gslib_state_info;
+
+static gslib_state_info gslib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+ /* .outbuffer = NULL, */
+ /* .errbuffer = NULL, */
+
+ .gsapi_new_instance = NULL,
+ .gsapi_delete_instance = NULL,
+ .gsapi_set_arg_encoding = NULL,
+ .gsapi_init_with_args = NULL,
+ .gsapi_set_stdio = NULL,
+
+};
+
+static int gslib_initialize(lua_State * L)
+{
+ if (! gslib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ gslib_state.gsapi_new_instance = lmt_library_find(lib, "gsapi_new_instance");
+ gslib_state.gsapi_delete_instance = lmt_library_find(lib, "gsapi_delete_instance");
+ gslib_state.gsapi_set_arg_encoding = lmt_library_find(lib, "gsapi_set_arg_encoding");
+ gslib_state.gsapi_init_with_args = lmt_library_find(lib, "gsapi_init_with_args");
+ gslib_state.gsapi_set_stdio = lmt_library_find(lib, "gsapi_set_stdio");
+
+ gslib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, gslib_state.initialized);
+ return 1;
+}
+
+/* We could have a callback for stdout and error. */
+
+static int gslib_stdout(void * caller_handle, const char *str, int len)
+{
+ (void)caller_handle;
+ luaL_addlstring(&gslib_state.outbuffer, str, len);
+ return len;
+}
+
+static int gslib_stderr(void * caller_handle, const char *str, int len)
+{
+ (void)caller_handle;
+ luaL_addlstring(&gslib_state.errbuffer, str, len);
+ return len;
+}
+
+static int gslib_execute(lua_State * L)
+{
+ if (gslib_state.initialized) {
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ size_t n = (int) lua_rawlen(L, 1);
+ if (n > 0) {
+ void *instance = NULL;
+ int result = gslib_state.gsapi_new_instance(&instance, NULL);
+ if (result >= 0) {
+ /*tex
+ Strings are not yet garbage colected. We add some slack. Here MSVC wants
+ |char**| and gcc wants |const char**| i.e.\ doesn't like a castso we just
+ accept the less annoying MSVC warning.
+ */
+ const char** arguments = malloc((n + 2) * sizeof(char*));
+ if (arguments) {
+ int m = 1;
+ /*tex This is a kind of dummy. */
+ arguments[0] = "ghostscript";
+ luaL_buffinit(L, &gslib_state.outbuffer);
+ luaL_buffinit(L, &gslib_state.errbuffer);
+ gslib_state.gsapi_set_stdio(instance, NULL, &gslib_stdout, &gslib_stderr);
+ for (size_t i = 1; i <= n; i++) {
+ lua_rawgeti(L, 1, i);
+ switch (lua_type(L, -1)) {
+ case LUA_TSTRING:
+ case LUA_TNUMBER:
+ {
+ size_t l = 0;
+ const char *s = lua_tolstring(L, -1, &l);
+ if (l > 0) {
+ arguments[m] = s;
+ m += 1;
+ }
+ }
+ break;
+ }
+ lua_pop(L, 1);
+ }
+ arguments[m] = NULL;
+ result = gslib_state.gsapi_set_arg_encoding(instance, GS_ARG_ENCODING_UTF8);
+ result = gslib_state.gsapi_init_with_args(instance, m, arguments);
+ gslib_state.gsapi_delete_instance(instance);
+ /* Nothing done with the array cells! No gc done yet anyway. */
+ free((void *) arguments);
+ lua_pushboolean(L, result >= 0);
+ luaL_pushresult(&gslib_state.outbuffer);
+ luaL_pushresult(&gslib_state.errbuffer);
+ return 3;
+ }
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static struct luaL_Reg gslib_function_list[] = {
+ { "initialize", gslib_initialize },
+ { "execute", gslib_execute },
+ { NULL, NULL },
+};
+
+int luaopen_ghostscript(lua_State * L)
+{
+ lmt_library_register(L, "ghostscript", gslib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtgraphicsmagick.c b/source/luametatex/source/luaoptional/lmtgraphicsmagick.c
new file mode 100644
index 000000000..c71c68c8c
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtgraphicsmagick.c
@@ -0,0 +1,199 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/* For now just a simple conversion, like in the example module. */
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef enum gmlib_NoiseType {
+ UniformNoise,
+ GaussianNoise,
+ MultiplicativeGaussianNoise,
+ ImpulseNoise,
+ LaplacianNoise,
+ PoissonNoise,
+ RandomNoise,
+ UndefinedNoise
+} gmlib_NoiseType;
+
+typedef struct gmlib_state_info {
+
+ int initialized;
+ int padding;
+
+ void (*gm_InitializeMagick) (
+ // void **argv
+ void *path
+ );
+
+ void (*gm_DestroyMagick) (
+ void
+ );
+
+ void * (*gm_NewMagickWand) (
+ void
+ );
+
+ void (*gm_DestroyMagickWand) (
+ void *wand
+ );
+
+ int (*gm_MagickReadImage) (
+ void *wand,
+ const char *name
+ );
+
+ int (*gm_MagickWriteImage) (
+ void *wand,
+ const char *name
+ );
+
+ int (*gm_MagickBlurImage) (
+ void *wand,
+ const double radius,
+ const double sigma
+ );
+
+ int (*gm_MagickAddNoiseImage) (
+ void *wand,
+ const gmlib_NoiseType noise_type
+ );
+
+} gmlib_state_info;
+
+static gmlib_state_info gmlib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .gm_InitializeMagick = NULL,
+ .gm_DestroyMagick = NULL,
+ .gm_NewMagickWand = NULL,
+ .gm_DestroyMagickWand = NULL,
+ .gm_MagickReadImage = NULL,
+ .gm_MagickWriteImage = NULL,
+
+ .gm_MagickBlurImage = NULL,
+ .gm_MagickAddNoiseImage = NULL,
+
+};
+
+static int gmlib_initialize(lua_State * L) // todo: table
+{
+ if (! gmlib_state.initialized) {
+ const char *filename1 = lua_tostring(L,1);
+ const char *filename2 = lua_tostring(L,2);
+ if (filename1) {
+
+ lmt_library lib = lmt_library_load(filename1);
+
+ gmlib_state.gm_InitializeMagick = lmt_library_find(lib, "InitializeMagick");
+ gmlib_state.gm_DestroyMagick = lmt_library_find(lib, "DestroyMagick");
+
+ gmlib_state.initialized = lmt_library_okay(lib);
+ }
+ if (gmlib_state.initialized && filename2) {
+
+ lmt_library lib = lmt_library_load(filename2);
+
+ gmlib_state.gm_NewMagickWand = lmt_library_find(lib, "NewMagickWand");
+ gmlib_state.gm_DestroyMagickWand = lmt_library_find(lib, "DestroyMagickWand");
+ gmlib_state.gm_MagickReadImage = lmt_library_find(lib, "MagickReadImage");
+ gmlib_state.gm_MagickWriteImage = lmt_library_find(lib, "MagickWriteImage");
+
+ gmlib_state.gm_MagickBlurImage = lmt_library_find(lib, "MagickBlurImage");
+ gmlib_state.gm_MagickAddNoiseImage = lmt_library_find(lib, "MagickAddNoiseImage");
+
+ gmlib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, gmlib_state.initialized);
+ return 1;
+}
+
+/* We could have a callback for stdout and error. */
+
+/* Somehow not in gm: (void) MagickImageCommand(image_info, arg_count, args, NULL, exception); */
+
+static int gmlib_execute(lua_State * L)
+{
+ if (gmlib_state.initialized) {
+ if (gmlib_state.initialized == 1) {
+ /* Once per run. */
+ gmlib_state.gm_InitializeMagick(NULL);
+ gmlib_state.initialized = 2;
+ }
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ void *wand = NULL;
+ const char *inpname = NULL;
+ const char *outname = NULL;
+ lua_getfield(L, -1, "inputfile" ); inpname = luaL_optstring(L, -1, NULL); lua_pop(L, 1);
+ lua_getfield(L, -1, "outputfile"); outname = luaL_optstring(L, -1, NULL); lua_pop(L, 1);
+ /* gmlib_state.gm_InitializeMagick(NULL); */
+ wand = gmlib_state.gm_NewMagickWand();
+ if (wand) {
+ int state = gmlib_state.gm_MagickReadImage(wand, inpname); /* todo: check return status */
+ if (state) {
+ /* fun stuff */
+ if (lua_getfield(L, -1, "blur" ) == LUA_TTABLE) {
+ lua_getfield(L, -1, "radius");
+ lua_getfield(L, -2, "sigma");
+ gmlib_state.gm_MagickBlurImage(wand, lua_tonumber(L, -2), lua_tonumber(L, -1));
+ lua_pop(L, 3);
+ } else {
+ lua_pop(L, 1);
+ }
+ if (lua_getfield(L, -1, "noise" ) == LUA_TTABLE) {
+ lua_getfield(L, -1, "type");
+ gmlib_state.gm_MagickAddNoiseImage(wand, lua_tointeger(L, -1));
+ lua_pop(L, 2);
+ } else {
+ lua_pop(L, 1);
+ }
+ /* done */
+ state = gmlib_state.gm_MagickWriteImage(wand, outname); /* todo: check return status */
+ gmlib_state.gm_DestroyMagickWand(wand);
+ if (state) {
+ lua_pushboolean(L, 1);
+ return 1;
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "possible write error");
+ return 2;
+ }
+ } else {
+ gmlib_state.gm_DestroyMagickWand(wand);
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "possible read error");
+ return 2;
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "possible memory issue");
+ return 2;
+ }
+ /* gmlib_state.gm_DestroyMagick(); */
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "invalid specification");
+ return 2;
+ }
+ }
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "not initialized");
+ return 2;
+}
+
+static struct luaL_Reg gmlib_function_list[] = {
+ { "initialize", gmlib_initialize },
+ { "execute", gmlib_execute },
+ { NULL, NULL },
+};
+
+int luaopen_graphicsmagick(lua_State * L)
+{
+ lmt_library_register(L, "graphicsmagick", gmlib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmthb.c b/source/luametatex/source/luaoptional/lmthb.c
new file mode 100644
index 000000000..d853256cf
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmthb.c
@@ -0,0 +1,761 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ This is using similar c-lua-interfacing code as that Kai Eigner wrote for ffi. I cleaned it up
+ a bit but the principles remain because that way we are downward compatible. Don't expect
+ miracles here. We use function pointers as we delay binding to the module. We use the system
+ library as it comes, because after all, that is what is expected: shaping conform what the
+ system offers.
+
+ This interface is only for testing. We load the font in \LUA\ anyway, so we don't need to
+ collect information here. The code runs on top of the \CONTEXT\ font plugin interface that
+ itself was written for testing purposes. When we wanted to test uniscribe the hb command
+ line program could be used for that, but more direct support was also added. The tests that
+ were done at that time (irr it was when xetex switched to hb and folks used that as reference)
+ ended up in articles. Later we used this mechanism to check how Idris advanced Arabic font
+ behaves in different shapers (context, uniscribe, hb, ...) as we try to follow uniscribe when
+ possible and this gave the glue to that. It showed interesting differences and overlap in
+ interpretation (and made us wonder when bugs - in whatever program or standard - get turned
+ into features, but that's another matter, and we can always adapt and provide variants and
+ overloads if needed).
+
+ The following code is not dependent on h files so we don't need to install a whole bunch of
+ dependencies. Also, because we delay loading, there is no default overhead in startup. The
+ loading of the library happens (as usual) at the \LUA\ end, but in order for it to work okay
+ the initializer needs to be called, so that the functions get resolved. So, it works a bit
+ like the ffi interface: delayed loading, but (maybe) with a bit less overhead. I should
+ probably look at the latest api to see if things can be done with less code but on the other
+ hand there is no real reason to change something that already worked okay some years ago.
+
+ I guess that the script enumeration is no longer right but it probably doesn't matter as
+ numbers are passed anyway. We can probably make that into an integer (I need to test that
+ some day) as these enumerations are just that: integers, and the less hard-coding we have
+ here the better.
+
+ When this module is used (which is triggered via loading an optional module and setting the
+ mode in a font definition) other features of the \CONTEXT\ font handler are lost for that
+ specific font instance, simply because these mechanism operate independently. But that is
+ probably what a user expects anyway: no interference from other code, just the results from
+ a library. It makes no sense to complicate the machinery even more. This is comparable with
+ basemode and nodemode that are also seperated code paths.
+
+ So, we could probably simplify the following typedefs, but this is what Kai started with so
+ I stick to it. From the enumerations only the direction constant is used.
+
+*/
+
+typedef struct hb_blob_t hb_blob_t;
+
+/* typedef int hb_memory_mode_t; */
+
+typedef enum hb_memory_mode_t {
+ HB_MEMORY_MODE_DUPLICATE,
+ HB_MEMORY_MODE_READONLY,
+ HB_MEMORY_MODE_WRITABLE,
+ HB_MEMORY_MODE_READONLY_MAY_MAKE_WRITABLE
+} hb_memory_mode_t;
+
+typedef void (*hb_destroy_func_t) (
+ void *user_data
+);
+
+typedef struct hb_face_t hb_face_t;
+typedef const struct hb_language_impl_t *hb_language_t;
+typedef struct hb_buffer_t hb_buffer_t;
+
+/* typedef int hb_script_t; */
+/* typedef int hb_direction_t; */
+
+/*
+ The content of this enum doesn't really matter here because we don't use it. Integers are
+ passed around. So, even if the following is not up to date we're okay.
+*/
+
+typedef enum hb_script_t {
+ HB_SCRIPT_COMMON, HB_SCRIPT_INHERITED, HB_SCRIPT_UNKNOWN,
+
+ HB_SCRIPT_ARABIC, HB_SCRIPT_ARMENIAN, HB_SCRIPT_BENGALI, HB_SCRIPT_CYRILLIC,
+ HB_SCRIPT_DEVANAGARI, HB_SCRIPT_GEORGIAN, HB_SCRIPT_GREEK,
+ HB_SCRIPT_GUJARATI, HB_SCRIPT_GURMUKHI, HB_SCRIPT_HANGUL, HB_SCRIPT_HAN,
+ HB_SCRIPT_HEBREW, HB_SCRIPT_HIRAGANA, HB_SCRIPT_KANNADA, HB_SCRIPT_KATAKANA,
+ HB_SCRIPT_LAO, HB_SCRIPT_LATIN, HB_SCRIPT_MALAYALAM, HB_SCRIPT_ORIYA,
+ HB_SCRIPT_TAMIL, HB_SCRIPT_TELUGU, HB_SCRIPT_THAI, HB_SCRIPT_TIBETAN,
+ HB_SCRIPT_BOPOMOFO, HB_SCRIPT_BRAILLE, HB_SCRIPT_CANADIAN_SYLLABICS,
+ HB_SCRIPT_CHEROKEE, HB_SCRIPT_ETHIOPIC, HB_SCRIPT_KHMER, HB_SCRIPT_MONGOLIAN,
+ HB_SCRIPT_MYANMAR, HB_SCRIPT_OGHAM, HB_SCRIPT_RUNIC, HB_SCRIPT_SINHALA,
+ HB_SCRIPT_SYRIAC, HB_SCRIPT_THAANA, HB_SCRIPT_YI, HB_SCRIPT_DESERET,
+ HB_SCRIPT_GOTHIC, HB_SCRIPT_OLD_ITALIC, HB_SCRIPT_BUHID, HB_SCRIPT_HANUNOO,
+ HB_SCRIPT_TAGALOG, HB_SCRIPT_TAGBANWA, HB_SCRIPT_CYPRIOT, HB_SCRIPT_LIMBU,
+ HB_SCRIPT_LINEAR_B, HB_SCRIPT_OSMANYA, HB_SCRIPT_SHAVIAN, HB_SCRIPT_TAI_LE,
+ HB_SCRIPT_UGARITIC, HB_SCRIPT_BUGINESE, HB_SCRIPT_COPTIC,
+ HB_SCRIPT_GLAGOLITIC, HB_SCRIPT_KHAROSHTHI, HB_SCRIPT_NEW_TAI_LUE,
+ HB_SCRIPT_OLD_PERSIAN, HB_SCRIPT_SYLOTI_NAGRI, HB_SCRIPT_TIFINAGH,
+ HB_SCRIPT_BALINESE, HB_SCRIPT_CUNEIFORM, HB_SCRIPT_NKO, HB_SCRIPT_PHAGS_PA,
+ HB_SCRIPT_PHOENICIAN, HB_SCRIPT_CARIAN, HB_SCRIPT_CHAM, HB_SCRIPT_KAYAH_LI,
+ HB_SCRIPT_LEPCHA, HB_SCRIPT_LYCIAN, HB_SCRIPT_LYDIAN, HB_SCRIPT_OL_CHIKI,
+ HB_SCRIPT_REJANG, HB_SCRIPT_SAURASHTRA, HB_SCRIPT_SUNDANESE, HB_SCRIPT_VAI,
+ HB_SCRIPT_AVESTAN, HB_SCRIPT_BAMUM, HB_SCRIPT_EGYPTIAN_HIEROGLYPHS,
+ HB_SCRIPT_IMPERIAL_ARAMAIC, HB_SCRIPT_INSCRIPTIONAL_PAHLAVI,
+ HB_SCRIPT_INSCRIPTIONAL_PARTHIAN, HB_SCRIPT_JAVANESE, HB_SCRIPT_KAITHI,
+ HB_SCRIPT_LISU, HB_SCRIPT_MEETEI_MAYEK, HB_SCRIPT_OLD_SOUTH_ARABIAN,
+ HB_SCRIPT_OLD_TURKIC, HB_SCRIPT_SAMARITAN, HB_SCRIPT_TAI_THAM,
+ HB_SCRIPT_TAI_VIET, HB_SCRIPT_BATAK, HB_SCRIPT_BRAHMI, HB_SCRIPT_MANDAIC,
+ HB_SCRIPT_CHAKMA, HB_SCRIPT_MEROITIC_CURSIVE, HB_SCRIPT_MEROITIC_HIEROGLYPHS,
+ HB_SCRIPT_MIAO, HB_SCRIPT_SHARADA, HB_SCRIPT_SORA_SOMPENG, HB_SCRIPT_TAKRI,
+ HB_SCRIPT_BASSA_VAH, HB_SCRIPT_CAUCASIAN_ALBANIAN, HB_SCRIPT_DUPLOYAN,
+ HB_SCRIPT_ELBASAN, HB_SCRIPT_GRANTHA, HB_SCRIPT_KHOJKI, HB_SCRIPT_KHUDAWADI,
+ HB_SCRIPT_LINEAR_A, HB_SCRIPT_MAHAJANI, HB_SCRIPT_MANICHAEAN,
+ HB_SCRIPT_MENDE_KIKAKUI, HB_SCRIPT_MODI, HB_SCRIPT_MRO, HB_SCRIPT_NABATAEAN,
+ HB_SCRIPT_OLD_NORTH_ARABIAN, HB_SCRIPT_OLD_PERMIC, HB_SCRIPT_PAHAWH_HMONG,
+ HB_SCRIPT_PALMYRENE, HB_SCRIPT_PAU_CIN_HAU, HB_SCRIPT_PSALTER_PAHLAVI,
+ HB_SCRIPT_SIDDHAM, HB_SCRIPT_TIRHUTA, HB_SCRIPT_WARANG_CITI, HB_SCRIPT_AHOM,
+ HB_SCRIPT_ANATOLIAN_HIEROGLYPHS, HB_SCRIPT_HATRAN, HB_SCRIPT_MULTANI,
+ HB_SCRIPT_OLD_HUNGARIAN, HB_SCRIPT_SIGNWRITING, HB_SCRIPT_ADLAM,
+ HB_SCRIPT_BHAIKSUKI, HB_SCRIPT_MARCHEN, HB_SCRIPT_OSAGE, HB_SCRIPT_TANGUT,
+ HB_SCRIPT_NEWA, HB_SCRIPT_MASARAM_GONDI, HB_SCRIPT_NUSHU, HB_SCRIPT_SOYOMBO,
+ HB_SCRIPT_ZANABAZAR_SQUARE, HB_SCRIPT_DOGRA, HB_SCRIPT_GUNJALA_GONDI,
+ HB_SCRIPT_HANIFI_ROHINGYA, HB_SCRIPT_MAKASAR, HB_SCRIPT_MEDEFAIDRIN,
+ HB_SCRIPT_OLD_SOGDIAN, HB_SCRIPT_SOGDIAN, HB_SCRIPT_ELYMAIC,
+ HB_SCRIPT_NANDINAGARI, HB_SCRIPT_NYIAKENG_PUACHUE_HMONG, HB_SCRIPT_WANCHO,
+
+ HB_SCRIPT_INVALID, _HB_SCRIPT_MAX_VALUE, _HB_SCRIPT_MAX_VALUE_SIGNED,
+} hb_script_t;
+
+typedef enum hb_direction_t {
+ HB_DIRECTION_INVALID,
+ HB_DIRECTION_LTR,
+ HB_DIRECTION_RTL,
+ HB_DIRECTION_TTB,
+ HB_DIRECTION_BTT
+} hb_direction_t;
+
+typedef int hb_bool_t;
+
+typedef uint32_t hb_tag_t;
+
+typedef struct hb_feature_t {
+ hb_tag_t tag;
+ uint32_t value;
+ unsigned int start;
+ unsigned int end;
+} hb_feature_t;
+
+typedef struct hb_font_t hb_font_t;
+
+typedef uint32_t hb_codepoint_t;
+typedef int32_t hb_position_t;
+typedef uint32_t hb_mask_t;
+
+typedef union _hb_var_int_t {
+ uint32_t u32;
+ int32_t i32;
+ uint16_t u16[2];
+ int16_t i16[2];
+ uint8_t u8[4];
+ int8_t i8[4];
+} hb_var_int_t;
+
+typedef struct hb_glyph_info_t {
+ hb_codepoint_t codepoint;
+ hb_mask_t mask;
+ uint32_t cluster;
+ /* private */
+ hb_var_int_t var1;
+ hb_var_int_t var2;
+} hb_glyph_info_t;
+
+typedef struct hb_glyph_position_t {
+ hb_position_t x_advance;
+ hb_position_t y_advance;
+ hb_position_t x_offset;
+ hb_position_t y_offset;
+ /* private */
+ hb_var_int_t var;
+} hb_glyph_position_t;
+
+/*tex
+
+ We only need to initialize the font and call a shaper. There is no need to interface more as we
+ won't use those features. I never compiled this library myself and just took it from the system
+ (e.g from inkscape). Keep in mind that names can be different on windows and linux.
+
+ If needed we can reuse buffers and cache a bit more but it probably doesn't make much difference
+ performance wise. Also, in a bit more complex document font handling is not the most time
+ critical and when you use specific scripts in \TEX\ that are not supported otherwise and
+ therefore demand a library run time is probably the least of your problems. So best is that we
+ keep it all abstract.
+
+*/
+
+# define HBLIB_METATABLE "optional.hblib"
+
+typedef struct hblib_data {
+ hb_font_t *font;
+} hblib_data;
+
+typedef struct hblib_state_info {
+
+ int initialized;
+ int padding;
+
+ const char * (*hb_version_string) (
+ void
+ );
+
+ hb_blob_t * (*hb_blob_create) (
+ const char *data,
+ unsigned int length,
+ hb_memory_mode_t mode, /* Could be int I guess. */
+ void *user_data,
+ hb_destroy_func_t destroy
+ );
+
+ void (*hb_blob_destroy) (
+ hb_blob_t *blob
+ );
+
+ hb_face_t * (*hb_face_create) (
+ hb_blob_t *blob,
+ unsigned int index
+ );
+
+ void (*hb_face_destroy) (
+ hb_face_t *face
+ );
+
+ hb_language_t (*hb_language_from_string) (
+ const char *str,
+ int len
+ );
+
+ void (*hb_buffer_set_language) (
+ hb_buffer_t *buffer,
+ hb_language_t language
+ );
+
+ hb_script_t (*hb_script_from_string) (
+ const char *s,
+ int len
+ );
+
+ void (*hb_buffer_set_script) (
+ hb_buffer_t *buffer,
+ hb_script_t script
+ );
+
+ hb_direction_t (*hb_direction_from_string) (
+ const char *str,
+ int len
+ );
+
+ void (*hb_buffer_set_direction) (
+ hb_buffer_t *buffer,
+ hb_direction_t direction
+ );
+
+ hb_bool_t (*hb_feature_from_string) (
+ const char *str,
+ int len,
+ hb_feature_t *feature
+ );
+
+ hb_bool_t (*hb_shape_full) (
+ hb_font_t *font,
+ hb_buffer_t *buffer,
+ const hb_feature_t *features,
+ unsigned int num_features,
+ const char * const *shaper_list
+ );
+
+ hb_buffer_t * (*hb_buffer_create )(
+ void
+ );
+
+ void (*hb_buffer_destroy)(
+ hb_buffer_t *buffer
+ );
+
+ void (*hb_buffer_add_utf8) (
+ hb_buffer_t *buffer,
+ const char *text,
+ int text_length,
+ unsigned int item_offset,
+ int item_length
+ );
+
+ void (*hb_buffer_add_utf32) (
+ hb_buffer_t *buffer,
+ const char *text,
+ int text_length,
+ unsigned int item_offset,
+ int item_length
+ );
+
+ /* void (*hb_buffer_add) (
+ hb_buffer_t *buffer,
+ hb_codepoint_t codepoint,
+ unsigned int cluster
+ ); */
+
+ unsigned int (*hb_buffer_get_length) (
+ hb_buffer_t *buffer
+ );
+
+ hb_glyph_info_t * (*hb_buffer_get_glyph_infos) (
+ hb_buffer_t *buffer,
+ unsigned int *length
+ );
+
+ hb_glyph_position_t * (*hb_buffer_get_glyph_positions) (
+ hb_buffer_t *buffer,
+ unsigned int *length
+ );
+
+ void (*hb_buffer_reverse) (
+ hb_buffer_t *buffer
+ );
+
+ void (*hb_buffer_reset) (
+ hb_buffer_t *buffer
+ );
+
+ void (*hb_buffer_guess_segment_properties) (
+ hb_buffer_t *buffer
+ );
+
+ hb_font_t * (*hb_font_create) (
+ hb_face_t *face
+ );
+
+ void (*hb_font_destroy) (
+ hb_font_t *font
+ );
+
+ void (*hb_font_set_scale) (
+ hb_font_t *font,
+ int x_scale,
+ int y_scale
+ );
+
+ void (*hb_ot_font_set_funcs) (
+ hb_font_t *font
+ );
+
+ unsigned int (*hb_face_get_upem) (
+ hb_face_t *face
+ );
+
+ const char ** (*hb_shape_list_shapers) (
+ void
+ );
+
+} hblib_state_info;
+
+static hblib_state_info hblib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .hb_version_string = NULL,
+ .hb_blob_create = NULL,
+ .hb_blob_destroy = NULL,
+ .hb_face_create = NULL,
+ .hb_face_destroy = NULL,
+ .hb_language_from_string = NULL,
+ .hb_buffer_set_language = NULL,
+ .hb_script_from_string = NULL,
+ .hb_buffer_set_script = NULL,
+ .hb_direction_from_string = NULL,
+ .hb_buffer_set_direction = NULL,
+ .hb_feature_from_string = NULL,
+ .hb_shape_full = NULL,
+ .hb_buffer_create = NULL,
+ .hb_buffer_destroy = NULL,
+ .hb_buffer_add_utf8 = NULL,
+ .hb_buffer_add_utf32 = NULL,
+ /* .hb_buffer_add = NULL, */
+ .hb_buffer_get_length = NULL,
+ .hb_buffer_get_glyph_infos = NULL,
+ .hb_buffer_get_glyph_positions = NULL,
+ .hb_buffer_reverse = NULL,
+ .hb_buffer_reset = NULL,
+ .hb_buffer_guess_segment_properties = NULL,
+ .hb_font_create = NULL,
+ .hb_font_destroy = NULL,
+ .hb_font_set_scale = NULL,
+ .hb_ot_font_set_funcs = NULL,
+ .hb_face_get_upem = NULL,
+ .hb_shape_list_shapers = NULL,
+
+};
+
+/* <boolean> = initialize(full_path_of_library) */
+
+static int hblib_initialize(lua_State * L)
+{
+ if (! hblib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ hblib_state.hb_version_string = lmt_library_find(lib, "hb_version_string");
+ hblib_state.hb_language_from_string = lmt_library_find(lib, "hb_language_from_string");
+ hblib_state.hb_script_from_string = lmt_library_find(lib, "hb_script_from_string");
+ hblib_state.hb_direction_from_string = lmt_library_find(lib, "hb_direction_from_string");
+ hblib_state.hb_feature_from_string = lmt_library_find(lib, "hb_feature_from_string");
+
+ hblib_state.hb_buffer_set_language = lmt_library_find(lib, "hb_buffer_set_language");
+ hblib_state.hb_buffer_set_script = lmt_library_find(lib, "hb_buffer_set_script");
+ hblib_state.hb_buffer_set_direction = lmt_library_find(lib, "hb_buffer_set_direction");
+
+ hblib_state.hb_buffer_create = lmt_library_find(lib, "hb_buffer_create");
+ hblib_state.hb_buffer_destroy = lmt_library_find(lib, "hb_buffer_destroy");
+ hblib_state.hb_buffer_reverse = lmt_library_find(lib, "hb_buffer_reverse");
+ hblib_state.hb_buffer_get_length = lmt_library_find(lib, "hb_buffer_get_length");
+ hblib_state.hb_buffer_reset = lmt_library_find(lib, "hb_buffer_reset");
+ hblib_state.hb_buffer_add_utf8 = lmt_library_find(lib, "hb_buffer_add_utf8");
+ hblib_state.hb_buffer_add_utf32 = lmt_library_find(lib, "hb_buffer_add_utf32");
+
+ hblib_state.hb_blob_create = lmt_library_find(lib, "hb_blob_create");
+ hblib_state.hb_blob_destroy = lmt_library_find(lib, "hb_blob_destroy");
+
+ hblib_state.hb_face_create = lmt_library_find(lib, "hb_face_create");
+ hblib_state.hb_face_destroy = lmt_library_find(lib, "hb_face_destroy");
+ hblib_state.hb_face_get_upem = lmt_library_find(lib, "hb_face_get_upem");
+
+ hblib_state.hb_font_create = lmt_library_find(lib, "hb_font_create");
+ hblib_state.hb_font_destroy = lmt_library_find(lib, "hb_font_destroy");
+ hblib_state.hb_font_set_scale = lmt_library_find(lib, "hb_font_set_scale");
+
+ hblib_state.hb_shape_list_shapers = lmt_library_find(lib, "hb_shape_list_shapers");
+ hblib_state.hb_shape_full = lmt_library_find(lib, "hb_shape_full");
+
+ hblib_state.hb_ot_font_set_funcs = lmt_library_find(lib, "hb_ot_font_set_funcs");
+
+ hblib_state.hb_buffer_guess_segment_properties = lmt_library_find(lib, "hb_buffer_guess_segment_properties");
+ hblib_state.hb_buffer_get_glyph_positions = lmt_library_find(lib, "hb_buffer_get_glyph_positions");
+ hblib_state.hb_buffer_get_glyph_infos = lmt_library_find(lib, "hb_buffer_get_glyph_infos");
+
+ hblib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, hblib_state.initialized);
+ return 1;
+}
+
+/* <string> = getversion() */
+
+static int hblib_get_version(lua_State * L)
+{
+ if (hblib_state.initialized) {
+ lua_pushstring(L, hblib_state.hb_version_string());
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* <instance> = loadfont(identifier, fontdata) */
+
+static int hblib_load_font(lua_State * L)
+{
+ if (hblib_state.initialized) {
+ int id = (int) lua_tointeger(L, 1);
+ const char *str= lua_tostring(L, 2);
+ int size = (int) lua_rawlen(L, 2);
+ hb_blob_t *blob = hblib_state.hb_blob_create(str, size, 0, NULL, NULL);
+ hb_face_t *face = hblib_state.hb_face_create(blob, id);
+ unsigned int scale = hblib_state.hb_face_get_upem(face);
+ hb_font_t *font = hblib_state.hb_font_create(face);
+ hblib_state.hb_font_set_scale(font, scale, scale);
+ hblib_state.hb_ot_font_set_funcs(font);
+ hblib_data *data = lua_newuserdatauv(L, sizeof(data), 0);
+ data->font = font;
+ luaL_getmetatable(L, HBLIB_METATABLE);
+ lua_setmetatable(L, -2);
+ hblib_state.hb_blob_destroy(blob);
+ hblib_state.hb_face_destroy(face);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* <table> = shapestring(instance, script, language, direction, { shapers }, { features }, text, reverse) */
+
+static int hblib_utf8len(const char *text, size_t size) /* todo: take from utilities */
+{
+ size_t ls = size;
+ int ind = 0;
+ int num = 0;
+ while (ind < (int) ls) {
+ unsigned char i = (unsigned char) *(text + ind);
+ if (i < 0x80) {
+ ind += 1;
+ } else if (i >= 0xF0) {
+ ind += 4;
+ } else if (i >= 0xE0) {
+ ind += 3;
+ } else if (i >= 0xC0) {
+ ind += 2;
+ } else {
+ ind += 1;
+ }
+ num += 1;
+ }
+ return num;
+}
+
+static int hblib_utf32len(const char *text, size_t size)
+{
+ /* not okay, hb doesn't stop at \0 */
+ /* (void) s; */
+ /* return (int) size / 4; */
+ /* so we do this instead */
+ size_t ls = size;
+ int ind = 0;
+ int num = 0;
+ while (ind < (int) ls) {
+ unsigned char i = (unsigned char) *(text + ind);
+ if (i) {
+ ind += 4;
+ } else {
+ break;
+ }
+ num += 1;
+ }
+ return num;
+}
+
+/*tex
+
+ Maybe with |utfbits == 0| take a table with code points, but then we might also need cluster
+ stuff, so there is no gain here.
+
+ I remember some issues with passing features (maybe because some defaults are always set) but
+ it's not really that important because one actually expects the library to handle them that way
+ (read: only enable additional ones). But I will look into it when needed.
+
+*/
+
+static int hblib_shape_string(lua_State * L)
+{
+ if (hblib_state.initialized) {
+ hblib_data *data = luaL_checkudata(L, 1, HBLIB_METATABLE);
+ if (data == NULL) {
+ lua_pushnil(L);
+ } else {
+ /* Maybe we can better take a table, so it's a yet undecided api. */
+ size_t nofscript = 0;
+ const char *script = lua_tolstring(L, 2, &nofscript);
+ size_t noflanguage = 0;
+ const char *language = lua_tolstring(L, 3, &noflanguage);
+ size_t nofdirection = 0;
+ const char *direction = lua_tolstring(L, 4, &nofdirection);
+ int nofshapers = 0;
+ const char * *shapers = NULL; /* slot 5 */
+ int noffeatures = 0;
+ hb_feature_t *features = NULL; /* slot 6 */
+ size_t noftext = 0;
+ const char *text = lua_tolstring(L, 7, &noftext);
+ int reverse = lua_toboolean(L, 8);
+ int utfbits = (int) luaL_optinteger(L, 9, 8);
+ hb_buffer_t *buffer = NULL;
+ /*
+ Shapers are passed as a table; why not pass the length here too ... simpler in
+ ffi -) Maybe I'll make this more static: a general setshaper or so, which is
+ more natural than having it as argument to the shape function.
+
+ MSVC wants |char**| for the shapers and gcc wants |const char**| i.e.\ doesn't
+ like a cast so we just accept the less annoying MSVC warning.
+ */
+ if (lua_istable(L,5)) {
+ lua_Unsigned n = lua_rawlen(L, 5);
+ if (n > 0) {
+ shapers = malloc((size_t) (n + 1) * sizeof(char *));
+ if (shapers) {
+ for (lua_Unsigned i = 0; i < n; i++) {
+ lua_rawgeti(L, 5, i + 1);
+ if (lua_isstring(L, -1)) {
+ shapers[nofshapers] = lua_tostring(L, -1);
+ nofshapers += 1;
+ }
+ lua_pop(L, 1);
+ }
+ } else {
+ luaL_error(L, "optional hblib: unable to allocate shaper memory");
+ }
+ /* sentinal */
+ shapers[nofshapers] = NULL;
+ }
+ }
+ /*
+ Features need to be converted to a table of features (manual work); simpler in
+ ffi -) Maybe I'll move this to the loadfont function.
+ */
+ if (lua_istable(L, 6)) {
+ lua_Unsigned n = lua_rawlen(L, 6);
+ if (n > 0) {
+ features = malloc((size_t) n * sizeof(hb_feature_t));
+ if (features) {
+ for (lua_Unsigned i = 0; i < n; i++) {
+ lua_rawgeti(L, 6, i + 1);
+ if (lua_isstring(L, -1)) {
+ size_t l = 0;
+ const char *s = lua_tolstring(L, -1, &l);
+ hblib_state.hb_feature_from_string(s, (int) l, &features[noffeatures]);
+ noffeatures += 1;
+ }
+ lua_pop(L, 1);
+ }
+ } else {
+ luaL_error(L, "optional hblib: unable to allocate feature memory");
+ }
+ }
+ }
+ /* Some preparations (see original ffi variant). */
+ buffer =hblib_state. hb_buffer_create(); /* we could put this in the data blob */
+ /*
+ When using ffi we used to use utf32 plus some slack because utf8 crashed. It would
+ be more handy if we could pass an array of integers (maybe we can).
+ */
+ if (utfbits == 32) {
+ hblib_state.hb_buffer_add_utf32(buffer, text, (int) noftext, 0, hblib_utf32len(text, noftext));
+ } else { /* 8 */
+ hblib_state.hb_buffer_add_utf8(buffer, text, (int) noftext, 0, hblib_utf8len(text, noftext));
+ }
+ hblib_state.hb_buffer_set_language(buffer, hblib_state.hb_language_from_string(language, (int) noflanguage));
+ hblib_state.hb_buffer_set_script(buffer, hblib_state.hb_script_from_string(script, (int) nofscript));
+ hblib_state.hb_buffer_set_direction(buffer, hblib_state.hb_direction_from_string(direction, (int) nofdirection));
+ hblib_state.hb_buffer_guess_segment_properties(buffer);
+ /* Do it! */
+ hblib_state.hb_shape_full(data->font, buffer, features, noffeatures, shapers);
+ /* Fixup. */
+ if (reverse) {
+ hblib_state.hb_buffer_reverse(buffer);
+ }
+ /* Convert the result: plain and simple.*/
+ {
+ unsigned length = hblib_state.hb_buffer_get_length(buffer);
+ hb_glyph_info_t *infos = hblib_state.hb_buffer_get_glyph_infos(buffer, NULL);
+ hb_glyph_position_t *positions = hblib_state.hb_buffer_get_glyph_positions(buffer, NULL);
+ lua_createtable(L, length, 0);
+ for (unsigned i = 0; i < length; i++) {
+ lua_createtable(L, 6, 0);
+ lua_pushinteger(L, infos[i].codepoint);
+ lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, infos[i].cluster);
+ lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, positions[i].x_offset);
+ lua_rawseti(L, -2, 3);
+ lua_pushinteger(L, positions[i].y_offset);
+ lua_rawseti(L, -2, 4);
+ lua_pushinteger(L, positions[i].x_advance);
+ lua_rawseti(L, -2, 5);
+ lua_pushinteger(L, positions[i].y_advance);
+ lua_rawseti(L, -2, 6);
+ lua_rawseti(L, -2, i + 1);
+ }
+ }
+ hblib_state.hb_buffer_destroy(buffer);
+ free((void *) shapers); /* we didn't make copies of the lua strings, ms compiler gives warning */
+ free((void *) features);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* <table> = getshapers() */
+
+static int hblib_get_shapers(lua_State * L)
+{
+ if (hblib_state.initialized) {
+ const char * *shapers = hblib_state.hb_shape_list_shapers();
+ if (shapers) {
+ int nofshapers = 0;
+ lua_createtable(L, 1, 0);
+ while (1) {
+ const char *s = shapers[nofshapers];
+ if (s) {
+ nofshapers++;
+ lua_pushstring(L, s);
+ lua_rawseti(L, -2, nofshapers);
+ } else {
+ break;
+ }
+ }
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* private */
+
+static int hblib_free(lua_State * L)
+{
+ if (hblib_state.initialized) {
+ hblib_data *data = luaL_checkudata(L, 1, HBLIB_METATABLE);
+ if (data) {
+ hblib_state.hb_font_destroy(data->font);
+ }
+ }
+ return 0;
+}
+
+/* <string> = tostring(instance) */
+
+static int hblib_tostring(lua_State * L)
+{
+ if (hblib_state.initialized) {
+ hblib_data *data = luaL_checkudata(L, 1, HBLIB_METATABLE);
+ if (data) {
+ lua_pushfstring(L, "<optional.hblib.instance %p>", data);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*tex We can do with a rather mimimal user data object. */
+
+static const struct luaL_Reg hblib_metatable[] = {
+ { "__tostring", hblib_tostring },
+ { "__gc", hblib_free },
+ { NULL, NULL },
+};
+
+/*tex
+
+ Idem, just the collected calls of the ffi variant. The less the better because that way there
+ is no tricky code needed at the \LUA\ end.
+
+*/
+
+static struct luaL_Reg hblib_function_list[] = {
+ { "initialize", hblib_initialize },
+ { "getversion", hblib_get_version },
+ { "getshapers", hblib_get_shapers },
+ { "loadfont", hblib_load_font },
+ { "shapestring", hblib_shape_string },
+ { NULL, NULL },
+};
+
+int luaopen_hb(lua_State *L)
+{
+ luaL_newmetatable(L, HBLIB_METATABLE);
+ luaL_setfuncs(L, hblib_metatable, 0);
+ lmt_library_register(L, "hb", hblib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtimagemagick.c b/source/luametatex/source/luaoptional/lmtimagemagick.c
new file mode 100644
index 000000000..9af5e6cd7
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtimagemagick.c
@@ -0,0 +1,144 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/* This one is real simple. */
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef struct imlib_state_info {
+
+ int initialized;
+ int padding;
+
+ int (*im_MagickCommandGenesis) (
+ void *image_info,
+ // int *command,
+ void *command,
+ int argc,
+ const char **argv,
+ char **metadata,
+ void *exception
+ );
+
+ void * (*im_AcquireImageInfo) (
+ void
+ );
+
+ void * (*im_AcquireExceptionInfo) (
+ void
+ );
+
+ int (*im_ConvertImageCommand) (
+ void *image_info,
+ int argc,
+ const char **argv,
+ char **metadata,
+ void *exception
+ );
+
+} imlib_state_info;
+
+static imlib_state_info imlib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .im_MagickCommandGenesis = NULL,
+ .im_AcquireImageInfo = NULL,
+ .im_AcquireExceptionInfo = NULL,
+ .im_ConvertImageCommand = NULL,
+
+};
+
+static int imlib_initialize(lua_State * L) // todo: table
+{
+ if (! imlib_state.initialized) {
+ const char *filename1 = lua_tostring(L,1);
+ const char *filename2 = lua_tostring(L,2);
+ if (filename1) {
+
+ lmt_library lib = lmt_library_load(filename1);
+
+ imlib_state.initialized = lmt_library_okay(lib);
+
+ imlib_state.im_AcquireImageInfo = lmt_library_find(lib, "AcquireImageInfo");
+ imlib_state.im_AcquireExceptionInfo = lmt_library_find(lib, "AcquireExceptionInfo");
+
+ }
+ if (imlib_state.initialized && filename2) {
+
+ lmt_library lib = lmt_library_load(filename2);
+
+ imlib_state.im_MagickCommandGenesis = lmt_library_find(lib, "MagickCommandGenesis");
+ imlib_state.im_ConvertImageCommand = lmt_library_find(lib, "ConvertImageCommand");
+
+ imlib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, imlib_state.initialized);
+ return 1;
+}
+
+static int imlib_execute(lua_State * L)
+{
+ if (imlib_state.initialized) {
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ const char *inpname = NULL;
+ const char *outname = NULL;
+ lua_getfield(L, -1, "inputfile" ); inpname = lua_tostring(L, -1); lua_pop(L, 1);
+ lua_getfield(L, -1, "outputfile"); outname = lua_tostring(L, -1); lua_pop(L, 1);
+ if (inpname && outname) {
+ lua_Integer nofarguments = 0;
+ lua_Integer nofoptions = 0;
+ const char **arguments = NULL;
+ void *info = imlib_state.im_AcquireImageInfo();
+ void *exep = imlib_state.im_AcquireExceptionInfo();
+ if (lua_getfield(L, -1, "options" ) == LUA_TTABLE) {
+ nofoptions = luaL_len(L, -1);
+ }
+ arguments = lmt_memory_malloc((nofoptions + 4) * sizeof(char *));
+ arguments[nofarguments++] = "convert";
+ arguments[nofarguments++] = inpname;
+ for (lua_Integer i = 1; i <= nofoptions; i++) {
+ switch (lua_rawgeti(L, -1, i)) {
+ case LUA_TSTRING:
+ case LUA_TNUMBER:
+ arguments[nofarguments++] = lua_tostring(L, -1);
+ break;
+ case LUA_TBOOLEAN:
+ arguments[nofarguments++] = lua_toboolean(L, -1) ? "true" : "false";
+ break;
+ }
+ lua_pop(L, 1);
+ }
+ arguments[nofarguments++] = outname;
+ imlib_state.im_MagickCommandGenesis(info, imlib_state.im_ConvertImageCommand, (int) nofarguments, arguments, NULL, exep);
+ lmt_memory_free((char *) arguments);
+ lua_pop(L, 1);
+ lua_pushboolean(L, 1);
+ return 2;
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "invalid specification");
+ return 2;
+ }
+ }
+ lua_pushboolean(L, 0);
+ lua_pushliteral(L, "not initialized");
+ return 2;
+}
+
+static struct luaL_Reg imlib_function_list[] = {
+ { "initialize", imlib_initialize },
+ { "execute", imlib_execute },
+ { NULL, NULL },
+};
+
+int luaopen_imagemagick(lua_State * L)
+{
+ lmt_library_register(L, "imagemagick", imlib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtkpse.c b/source/luametatex/source/luaoptional/lmtkpse.c
new file mode 100644
index 000000000..e593f8b9b
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtkpse.c
@@ -0,0 +1,311 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+/*tex
+
+ As part of the lean and mean concept we have no \KPSE\ on board and as with \LUATEX\ the
+ \CONTEXT\ macro package doesn't need it. However, because we might want to play with it being
+ a runner for other engines (as we do with the \LUATEX\ binary in kpse mode), we have at least
+ an interface for it. One problem is to locate the right version of the delayed loaded kpse
+ library (but we can add some clever locating code for that if needed). We keep the interface
+ mostly the same as \LUATEX.
+
+ This is actually a left-over from an experiment, but it works okay, so I moved the code into
+ the source tree and made a proper \CONTEXT\ library wrapper too. We are less clever than in
+ \LUATEX, so there are no additional lookup functions. After all, it is just about locating
+ files and not about writing a searcher in \LUA. So, there no subdir magic either, as one has
+ \LUA\ for that kind of stuff. No \DPI\ related magic either. In \LUATEX\ there are some more
+ functions in the \type {kpse} namespace but these don't really relate to locating files.
+
+ We can actually omit the next two lists and pass numbers but then we need to store that list at
+ the \LUA\ end so we don't save much (but I might do it some day nevertheless). The nect code is
+ rather lightweight which is on purpose. Of course occationally we need to check the \API\ but
+ \KPSE\ pretty stable and we don't need the extra stuff that it provides (keep in mind that it
+ has to serve all kind of programs in the \TEX\ infrastructure so it's a complex beast).
+
+*/
+
+typedef enum kpselib_file_format_type {
+ kpse_gf_format, kpse_pk_format, kpse_any_glyph_format, kpse_tfm_format, kpse_afm_format,
+ kpse_base_format, kpse_bib_format, kpse_bst_format, kpse_cnf_format, kpse_db_format,
+ kpse_fmt_format, kpse_fontmap_format, kpse_mem_format, kpse_mf_format, kpse_mfpool_format,
+ kpse_mft_format, kpse_mp_format, kpse_mppool_format, kpse_mpsupport_format, kpse_ocp_format,
+ kpse_ofm_format, kpse_opl_format, kpse_otp_format, kpse_ovf_format, kpse_ovp_format,
+ kpse_pict_format, kpse_tex_format, kpse_texdoc_format, kpse_texpool_format,
+ kpse_texsource_format, kpse_tex_ps_header_format, kpse_troff_font_format, kpse_type1_format,
+ kpse_vf_format, kpse_dvips_config_format, kpse_ist_format, kpse_truetype_format,
+ kpse_type42_format, kpse_web2c_format, kpse_program_text_format, kpse_program_binary_format,
+ kpse_miscfonts_format, kpse_web_format, kpse_cweb_format, kpse_enc_format, kpse_cmap_format,
+ kpse_sfd_format, kpse_opentype_format, kpse_pdftex_config_format, kpse_lig_format,
+ kpse_texmfscripts_format, kpse_lua_format, kpse_fea_format, kpse_cid_format, kpse_mlbib_format,
+ kpse_mlbst_format, kpse_clua_format, /* kpse_ris_format, */ /* kpse_bltxml_format, */
+ kpse_last_format
+} kpselib_file_format_type;
+
+static const char *const kpselib_file_type_names[] = {
+ "gf", "pk", "bitmap font", "tfm", "afm", "base", "bib", "bst", "cnf", "ls-R", "fmt", "map",
+ "mem", "mf", "mfpool", "mft", "mp", "mppool", "MetaPost support", "ocp", "ofm", "opl", "otp",
+ "ovf", "ovp", "graphic/figure", "tex", "TeX system documentation", "texpool",
+ "TeX system sources", "PostScript header", "Troff fonts", "type1 fonts", "vf", "dvips config",
+ "ist", "truetype fonts", "type42 fonts", "web2c files", "other text files", "other binary files",
+ "misc fonts", "web", "cweb", "enc files", "cmap files", "subfont definition files",
+ "opentype fonts", "pdftex config", "lig files", "texmfscripts", "lua", "font feature files",
+ "cid maps", "mlbib", "mlbst", "clua",
+ NULL
+};
+
+typedef struct kpselib_state_info {
+
+ int initialized;
+ int prognameset;
+
+ void (*lib_kpse_set_program_name) ( const char *prog, const char *name );
+ void (*lib_kpse_reset_program_name) ( const char *name );
+ char * (*lib_kpse_path_expand) ( const char *name );
+ char * (*lib_kpse_brace_expand) ( const char *name );
+ char * (*lib_kpse_var_expand) ( const char *name );
+ char * (*lib_kpse_var_value) ( const char *name );
+ char * (*lib_kpse_readable_file) ( const char *name );
+ char * (*lib_kpse_find_file) ( const char *name, int filetype, int mustexist );
+ char **(*lib_kpse_all_path_search) ( const char *path, const char *name );
+
+} kpselib_state_info;
+
+static kpselib_state_info kpselib_state = {
+
+ .initialized = 0,
+ .prognameset = 0,
+
+ .lib_kpse_set_program_name = NULL,
+ .lib_kpse_reset_program_name = NULL,
+ .lib_kpse_path_expand = NULL,
+ .lib_kpse_brace_expand = NULL,
+ .lib_kpse_var_expand = NULL,
+ .lib_kpse_var_value = NULL,
+ .lib_kpse_readable_file = NULL,
+ .lib_kpse_find_file = NULL,
+ .lib_kpse_all_path_search = NULL,
+
+};
+
+static int kpselib_aux_valid_progname(lua_State *L)
+{
+ (void) L;
+ if (kpselib_state.prognameset) {
+ return 1;
+ } else if (! kpselib_state.initialized) {
+ tex_normal_warning("kpse", "not yet initialized");
+ return 0;
+ } else {
+ tex_normal_warning("kpse", "no program name set");
+ return 0;
+ }
+}
+
+static int kpselib_set_program_name(lua_State *L)
+{
+ (void) L;
+ if (kpselib_state.initialized) {
+ const char *exe_name = luaL_checkstring(L, 1);
+ const char *prog_name = luaL_optstring(L, 2, exe_name);
+ if (kpselib_state.prognameset) {
+ kpselib_state.lib_kpse_reset_program_name(prog_name);
+ } else {
+ kpselib_state.lib_kpse_set_program_name(exe_name, prog_name);
+ kpselib_state.prognameset = 1;
+ }
+ }
+ return 0;
+}
+
+static int kpselib_find_file(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ unsigned filetype = kpse_tex_format;
+ int mustexist = 0;
+ const char *filename = luaL_checkstring(L, 1);
+ int top = lua_gettop(L);
+ for (int i = 2; i <= top; i++) {
+ switch (lua_type(L, i)) {
+ case LUA_TBOOLEAN:
+ mustexist = lua_toboolean(L, i);
+ break;
+ case LUA_TNUMBER:
+ /*tex This is different from \LUATEX: we accept a filetype number. */
+ filetype = (unsigned) lua_tointeger(L, i);
+ break;
+ case LUA_TSTRING:
+ filetype = luaL_checkoption(L, i, NULL, kpselib_file_type_names);
+ break;
+ }
+ if (filetype >= kpse_last_format) {
+ filetype = kpse_tex_format;
+ }
+ }
+ lua_pushstring(L, kpselib_state.lib_kpse_find_file(filename, filetype, mustexist));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*
+ I'll ask Taco about the free. For now it will do. Currently I only need to do some lookups for
+ checking clashes with other installations (issue reported on context ml).
+*/
+
+static int kpselib_find_files(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ const char *userpath = luaL_checkstring(L, 1);
+ const char *filename = luaL_checkstring(L, 2);
+ char *filepath = kpselib_state.lib_kpse_path_expand(userpath);
+ if (filepath) {
+ char **result = kpselib_state.lib_kpse_all_path_search(filepath, filename);
+ /* free(filepath); */ /* crashes, so it looks like def kpse keeps it */
+ if (result) {
+ lua_Integer r = 0;
+ lua_newtable(L);
+ while (result[r]) {
+ lua_pushstring(L, result[r]);
+ lua_rawseti(L, -2, ++r);
+ }
+ /* free(result); */ /* idem */
+ return 1;
+ }
+ } else {
+ /* free(filepath); */ /* idem */
+ }
+ }
+ return 0;
+}
+
+static int kpselib_expand_path(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ lua_pushstring(L, kpselib_state.lib_kpse_path_expand(luaL_checkstring(L, 1)));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int kpselib_expand_braces(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ lua_pushstring(L, kpselib_state.lib_kpse_brace_expand(luaL_checkstring(L, 1)));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int kpselib_expand_var(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ lua_pushstring(L, kpselib_state.lib_kpse_var_expand(luaL_checkstring(L, 1)));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int kpselib_var_value(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ lua_pushstring(L, kpselib_state.lib_kpse_var_value(luaL_checkstring(L, 1)));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int kpselib_readable_file(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ /* Why the dup? */
+ char *name = strdup(luaL_checkstring(L, 1));
+ lua_pushstring(L, kpselib_state.lib_kpse_readable_file(name));
+ free(name);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int kpselib_get_file_types(lua_State *L)
+{
+ if (kpselib_aux_valid_progname(L)) {
+ lua_createtable(L, kpse_last_format, 0);
+ for (lua_Integer i = 0; i < kpse_last_format; i++) {
+ if (kpselib_file_type_names[i]) {
+ lua_pushstring(L, kpselib_file_type_names[i]);
+ lua_rawseti(L, -2, i + 1);
+ } else {
+ break;
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int kpselib_initialize(lua_State *L)
+{
+ if (! kpselib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ kpselib_state.lib_kpse_set_program_name = lmt_library_find(lib, "kpse_set_program_name");
+ kpselib_state.lib_kpse_reset_program_name = lmt_library_find(lib, "kpse_reset_program_name");
+ kpselib_state.lib_kpse_all_path_search = lmt_library_find(lib, "kpse_all_path_search");
+ kpselib_state.lib_kpse_find_file = lmt_library_find(lib, "kpse_find_file");
+ kpselib_state.lib_kpse_path_expand = lmt_library_find(lib, "kpse_path_expand");
+ kpselib_state.lib_kpse_brace_expand = lmt_library_find(lib, "kpse_brace_expand");
+ kpselib_state.lib_kpse_var_expand = lmt_library_find(lib, "kpse_var_expand");
+ kpselib_state.lib_kpse_var_value = lmt_library_find(lib, "kpse_var_value");
+ kpselib_state.lib_kpse_readable_file = lmt_library_find(lib, "kpse_readable_file");
+
+ kpselib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, kpselib_state.initialized);
+ return 1;
+}
+
+/*tex We use the official names here, with underscores. */
+
+/* init_prog : no need */
+/* show_path : maybe */
+/* lookup : maybe */
+/* default_texmfcnf : not that useful */
+/* record_output_file : makes no sense */
+/* record_input_file : makes no sense */
+/* check_permissions : luatex extra */
+
+static struct luaL_Reg kpselib_function_list[] = {
+ { "initialize", kpselib_initialize },
+ { "set_program_name", kpselib_set_program_name },
+ { "find_file", kpselib_find_file },
+ { "find_files", kpselib_find_files },
+ { "expand_path", kpselib_expand_path },
+ { "expand_var", kpselib_expand_var },
+ { "expand_braces", kpselib_expand_braces },
+ { "var_value", kpselib_var_value },
+ { "readable_file", kpselib_readable_file },
+ { "get_file_types", kpselib_get_file_types },
+ { NULL, NULL },
+};
+
+int luaopen_kpse(lua_State * L)
+{
+ lmt_library_register(L, "kpse", kpselib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtlz4.c b/source/luametatex/source/luaoptional/lmtlz4.c
new file mode 100644
index 000000000..d54442635
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtlz4.c
@@ -0,0 +1,193 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include <stdlib.h>
+
+# include "luametatex.h"
+
+# define LZ4F_VERSION 100 /* used to check for an incompatible API breaking change */
+
+typedef struct lz4lib_state_info {
+
+ int initialized;
+ int padding;
+
+ int (*LZ4_compressBound) (int inputSize);
+ int (*LZ4_compress_fast) (const char *src, char *dst, int srcSize, int dstCapacity, int acceleration);
+ int (*LZ4_decompress_safe) (const char *src, char *dst, int compressedSize, int dstCapacity);
+ size_t (*LZ4F_compressFrameBound) (size_t srcSize, void *);
+ size_t (*LZ4F_compressFrame) (void *dstBuffer, size_t dstCapacity, const void* srcBuffer, size_t srcSize, void *);
+ unsigned (*LZ4F_isError) (int code);
+ int (*LZ4F_createDecompressionContext) (void **dctxPtr, unsigned version);
+ int (*LZ4F_freeDecompressionContext) (void *dctx);
+ size_t (*LZ4F_decompress) (void *dctx, void *dstBuffer, size_t *dstSizePtr, const void *srcBuffer, size_t *srcSizePtr, void *);
+
+} lz4lib_state_info;
+
+static lz4lib_state_info lz4lib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .LZ4_compressBound = NULL,
+ .LZ4_compress_fast = NULL,
+ .LZ4_decompress_safe = NULL,
+ .LZ4F_compressFrameBound = NULL,
+ .LZ4F_compressFrame = NULL,
+ .LZ4F_isError = NULL,
+ .LZ4F_createDecompressionContext = NULL,
+ .LZ4F_freeDecompressionContext = NULL,
+ .LZ4F_decompress = NULL,
+
+};
+
+static int lz4lib_compress(lua_State *L)
+{
+ if (lz4lib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ lua_Integer acceleration = luaL_optinteger(L, 2, 1);
+ size_t targetsize = lz4lib_state.LZ4_compressBound((int) sourcesize);
+ luaL_Buffer buffer;
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ int result = lz4lib_state.LZ4_compress_fast(source, target, (int) sourcesize, (int) targetsize, (int) acceleration);
+ if (result > 0) {
+ luaL_pushresultsize(&buffer, result);
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ return 1;
+}
+
+/*
+
+ There is no info about the target size so we don't provide a decompress function. Either use
+ the frame variant or save and restore the targetsize,
+
+ static int lz4lib_decompress(lua_State *L)
+ {
+ lua_pushnil(L);
+ return 1;
+ }
+
+*/
+
+static int lz4lib_decompresssize(lua_State *L)
+{
+ if (lz4lib_state.initialized) {
+ size_t sourcesize = 0;
+ size_t targetsize = luaL_checkinteger(L, 2);
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ if (source && targetsize > 0) {
+ luaL_Buffer buffer;
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ int result = lz4lib_state.LZ4_decompress_safe(source, target, (int) sourcesize, (int) targetsize);
+ if (result > 0) {
+ luaL_pushresultsize(&buffer, result);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ return 1;
+}
+
+static int lz4lib_framecompress(lua_State *L)
+{
+ if (lz4lib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ luaL_Buffer buffer;
+ size_t targetsize = lz4lib_state.LZ4F_compressFrameBound(sourcesize, NULL);
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ size_t result = lz4lib_state.LZ4F_compressFrame(target, targetsize, source, sourcesize, NULL);
+ luaL_pushresultsize(&buffer, result);
+ }
+ return 1;
+}
+
+static int lz4lib_framedecompress(lua_State *L)
+{
+ if (lz4lib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ if (source) {
+ void *context = NULL;
+ int errorcode = lz4lib_state.LZ4F_createDecompressionContext(&context, LZ4F_VERSION);
+ if (lz4lib_state.LZ4F_isError(errorcode)) {
+ lua_pushnil(L);
+ } else {
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ while (1) {
+ size_t targetsize = 0xFFFF;
+ char *target = luaL_prepbuffsize(&buffer, targetsize);
+ size_t consumed = sourcesize;
+ size_t errorcode = lz4lib_state.LZ4F_decompress(context, target, &targetsize, source, &consumed, NULL);
+ if (lz4lib_state.LZ4F_isError((int) errorcode)) {
+ lua_pushnil(L);
+ break;
+ } else if (targetsize == 0) {
+ luaL_pushresult(&buffer);
+ break;
+ } else {
+ luaL_addsize(&buffer, targetsize);
+ sourcesize -= consumed;
+ source += consumed;
+ }
+ }
+ }
+ if (context) {
+ lz4lib_state.LZ4F_freeDecompressionContext(context);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ }
+ return 1;
+}
+
+static int lz4lib_initialize(lua_State *L)
+{
+ if (! lz4lib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ lz4lib_state.LZ4_compressBound = lmt_library_find(lib, "LZ4_compressBound");
+ lz4lib_state.LZ4_compress_fast = lmt_library_find(lib, "LZ4_compress_fast");
+ lz4lib_state.LZ4_decompress_safe = lmt_library_find(lib, "LZ4_decompress_safe");
+ lz4lib_state.LZ4F_compressFrameBound = lmt_library_find(lib, "LZ4F_compressFrameBound");
+ lz4lib_state.LZ4F_compressFrame = lmt_library_find(lib, "LZ4F_compressFrame");
+ lz4lib_state.LZ4F_isError = lmt_library_find(lib, "LZ4F_isError");
+ lz4lib_state.LZ4F_createDecompressionContext = lmt_library_find(lib, "LZ4F_createDecompressionContext");
+ lz4lib_state.LZ4F_freeDecompressionContext = lmt_library_find(lib, "LZ4F_freeDecompressionContext");
+ lz4lib_state.LZ4F_decompress = lmt_library_find(lib, "LZ4F_decompress");
+
+ lz4lib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, lz4lib_state.initialized);
+ return 1;
+}
+
+static struct luaL_Reg lz4lib_function_list[] = {
+ { "initialize", lz4lib_initialize },
+ { "compress", lz4lib_compress },
+ /* { "decompress", lz4lib_decompress }, */
+ { "decompresssize", lz4lib_decompresssize },
+ { "framecompress", lz4lib_framecompress },
+ { "framedecompress", lz4lib_framedecompress },
+ { NULL, NULL },
+};
+
+int luaopen_lz4(lua_State * L)
+{
+ lmt_library_register(L, "lz4", lz4lib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtlzma.c b/source/luametatex/source/luaoptional/lmtlzma.c
new file mode 100644
index 000000000..6ffe6fedf
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtlzma.c
@@ -0,0 +1,228 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include <stdlib.h>
+
+# include "luametatex.h"
+
+/*
+ We only need a few definitions and it's nice that they are already prepared for extensions.
+*/
+
+typedef enum {
+ LZMA_RESERVED_ENUM = 0
+} lzma_reserved_enum;
+
+typedef enum {
+ LZMA_OK = 0,
+ LZMA_STREAM_END = 1,
+ LZMA_NO_CHECK = 2,
+ LZMA_UNSUPPORTED_CHECK = 3,
+ LZMA_GET_CHECK = 4,
+ LZMA_MEM_ERROR = 5,
+ LZMA_MEMLIMIT_ERROR = 6,
+ LZMA_FORMAT_ERROR = 7,
+ LZMA_OPTIONS_ERROR = 8,
+ LZMA_DATA_ERROR = 9,
+ LZMA_BUF_ERROR = 10,
+ LZMA_PROG_ERROR = 11,
+} lzma_ret;
+
+typedef enum {
+ LZMA_RUN = 0,
+ LZMA_SYNC_FLUSH = 1,
+ LZMA_FULL_FLUSH = 2,
+ LZMA_FULL_BARRIER = 4,
+ LZMA_FINISH = 3
+} lzma_action;
+
+typedef enum {
+ LZMA_CHECK_NONE = 0,
+ LZMA_CHECK_CRC32 = 1,
+ LZMA_CHECK_CRC64 = 4,
+ LZMA_CHECK_SHA256 = 10
+} lzma_check;
+
+typedef struct lzma_internal_s lzma_internal;
+
+typedef struct {
+ void *(*alloc)(void *opaque, size_t nmemb, size_t size);
+ void (*free )(void *opaque, void *ptr);
+ void *opaque;
+} lzma_allocator;
+
+typedef struct {
+ const uint8_t *next_in;
+ size_t avail_in;
+ uint64_t total_in;
+ uint8_t *next_out;
+ size_t avail_out;
+ uint64_t total_out;
+ const lzma_allocator *allocator;
+ lzma_internal *internal;
+ void *reserved_ptr1;
+ void *reserved_ptr2;
+ void *reserved_ptr3;
+ void *reserved_ptr4;
+ uint64_t reserved_int1;
+ uint64_t reserved_int2;
+ size_t reserved_int3;
+ size_t reserved_int4;
+ lzma_reserved_enum reserved_enum1;
+ lzma_reserved_enum reserved_enum2;
+} lzma_stream;
+
+
+# define LZMA_STREAM_INIT { NULL, 0, 0, NULL, 0, 0, NULL, NULL, NULL, NULL, NULL, NULL, 0, 0, 0, 0, LZMA_RESERVED_ENUM, LZMA_RESERVED_ENUM }
+
+# define LZMA_TELL_NO_CHECK UINT32_C(0x01)
+# define LZMA_TELL_UNSUPPORTED_CHECK UINT32_C(0x02)
+# define LZMA_TELL_ANY_CHECK UINT32_C(0x04)
+# define LZMA_CONCATENATED UINT32_C(0x08)
+
+typedef struct lzmalib_state_info {
+
+ int initialized;
+ int padding;
+
+ int (*lzma_auto_decoder) (lzma_stream *strm, uint64_t memlimit, uint32_t flags);
+ int (*lzma_easy_encoder) (lzma_stream *strm, uint32_t preset, lzma_check check);
+ int (*lzma_code) (lzma_stream *strm, lzma_action action);
+ int (*lzma_end) (lzma_stream *strm);
+
+} lzmalib_state_info;
+
+static lzmalib_state_info lzmalib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .lzma_auto_decoder = NULL,
+ .lzma_easy_encoder = NULL,
+ .lzma_code = NULL,
+ .lzma_end = NULL,
+};
+
+
+# define lzma_default_level 6
+# define lzma_default_size 0xFFFF
+
+static int lzmalib_compress(lua_State *L)
+{
+ if (lzmalib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ int level = lmt_optinteger(L, 2, lzma_default_level);
+ int targetsize = lmt_optinteger(L, 3, lzma_default_size);
+ if (level < 0 || level > 9) {
+ level = lzma_default_level;
+ }
+ if (source) {
+ lzma_stream strm = LZMA_STREAM_INIT;
+ int errorcode = lzmalib_state.lzma_easy_encoder(&strm, level, LZMA_CHECK_CRC64);
+ if (errorcode == LZMA_OK) {
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ strm.next_in = (const uint8_t *) source;
+ strm.avail_in = sourcesize;
+ if (targetsize < lzma_default_size) {
+ targetsize = lzma_default_size;
+ }
+ while (1) {
+ char *target = luaL_prepbuffsize(&buffer, targetsize);
+ size_t produced = strm.total_out;
+ strm.next_out = (uint8_t *) target;
+ strm.avail_out = targetsize;
+ errorcode = lzmalib_state.lzma_code(&strm, LZMA_FINISH);
+ produced = strm.total_out - produced;
+ luaL_addsize(&buffer, produced);
+ if (errorcode == LZMA_STREAM_END) {
+ lzmalib_state.lzma_end(&strm);
+ luaL_pushresult(&buffer);
+ return 1;
+ } else if (errorcode != LZMA_OK) {
+ lzmalib_state.lzma_end(&strm);
+ break;
+ }
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int lzmalib_decompress(lua_State *L)
+{
+ if (lzmalib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ int targetsize = lmt_optinteger(L, 2, lzma_default_size);
+ if (source) {
+ lzma_stream strm = LZMA_STREAM_INIT;
+ int errorcode = lzmalib_state.lzma_auto_decoder(&strm, UINT64_MAX, LZMA_CONCATENATED);
+ if (errorcode == LZMA_OK) {
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ strm.next_in = (const uint8_t *) source;
+ strm.avail_in = sourcesize;
+ if (targetsize < lzma_default_size) {
+ targetsize = lzma_default_size;
+ }
+ while (1) {
+ char *target = luaL_prepbuffsize(&buffer, targetsize);
+ size_t produced = strm.total_out;
+ strm.next_out = (uint8_t *) target;
+ strm.avail_out = targetsize;
+ errorcode = lzmalib_state.lzma_code(&strm, LZMA_RUN);
+ produced = strm.total_out - produced;
+ luaL_addsize(&buffer, produced);
+ if (errorcode == LZMA_STREAM_END || produced == 0) {
+ lzmalib_state.lzma_end(&strm);
+ luaL_pushresult(&buffer);
+ return 1;
+ } else if (errorcode != LZMA_OK) {
+ lzmalib_state.lzma_end(&strm);
+ break;
+ }
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int lzmalib_initialize(lua_State *L)
+{
+ if (! lzmalib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ lzmalib_state.lzma_auto_decoder = lmt_library_find(lib, "lzma_auto_decoder");
+ lzmalib_state.lzma_easy_encoder = lmt_library_find(lib, "lzma_easy_encoder");
+ lzmalib_state.lzma_code = lmt_library_find(lib, "lzma_code");
+ lzmalib_state.lzma_end = lmt_library_find(lib, "lzma_end");
+
+ lzmalib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, lzmalib_state.initialized);
+ return 1;
+}
+
+static struct luaL_Reg lzmalib_function_list[] = {
+ { "initialize", lzmalib_initialize },
+ { "compress", lzmalib_compress },
+ { "decompress", lzmalib_decompress },
+ { NULL, NULL },
+};
+
+int luaopen_lzma(lua_State * L)
+{
+ lmt_library_register(L, "lzma", lzmalib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtlzo.c b/source/luametatex/source/luaoptional/lmtlzo.c
new file mode 100644
index 000000000..766e824ca
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtlzo.c
@@ -0,0 +1,108 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include <stdlib.h>
+
+# include "luametatex.h"
+
+# define lzo_output_length(n) (n + n / 16 + 64 + 64) /* we add 64 instead of 3 */
+
+# define LZO_E_OK 0
+
+typedef struct lzolib_state_info {
+
+ int initialized;
+ int padding;
+
+ int (*lzo1x_1_compress) (const char *source, size_t sourcesize, char *target, size_t *targetsize, void *wrkmem);
+ int (*lzo1x_decompress_safe) (const char *source, size_t sourcesize, char *target, size_t *targetsize, void *wrkmem);
+
+} lzolib_state_info;
+
+static lzolib_state_info lzolib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .lzo1x_1_compress = NULL,
+ .lzo1x_decompress_safe = NULL,
+
+};
+
+static int lzolib_compress(lua_State *L)
+{
+ if (lzolib_state.initialized) {
+ char *wrkmem = lmt_memory_malloc(16384 + 32); /* we some plenty of slack, normally 2 seemss enough */
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ luaL_Buffer buffer;
+ size_t targetsize = lzo_output_length(sourcesize);
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ int result = lzolib_state.lzo1x_1_compress(source, sourcesize, target, &targetsize, wrkmem);
+ if (result == LZO_E_OK) {
+ luaL_pushresultsize(&buffer, targetsize);
+ } else {
+ lua_pushnil(L);
+ }
+ lmt_memory_free(wrkmem);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int lzolib_decompresssize(lua_State *L)
+{
+ if (lzolib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ size_t targetsize = luaL_checkinteger(L, 2);
+ if (source && targetsize > 0) {
+ luaL_Buffer buffer;
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ int result = lzolib_state.lzo1x_decompress_safe(source, sourcesize, target, &targetsize, NULL);
+ if (result == LZO_E_OK) {
+ luaL_pushresultsize(&buffer, targetsize);
+ } else {
+ lua_pushnil(L);
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int lzolib_initialize(lua_State *L)
+{
+ if (! lzolib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ lzolib_state.lzo1x_1_compress = lmt_library_find(lib, "lzo1x_1_compress");
+ lzolib_state.lzo1x_decompress_safe = lmt_library_find(lib, "lzo1x_decompress_safe");
+
+ lzolib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, lzolib_state.initialized);
+ return 1;
+}
+
+static struct luaL_Reg lzolib_function_list[] = {
+ { "initialize", lzolib_initialize },
+ { "compress", lzolib_compress },
+ { "decompresssize", lzolib_decompresssize },
+ { NULL, NULL },
+};
+
+int luaopen_lzo(lua_State * L)
+{
+ lmt_library_register(L, "lzo", lzolib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtmujs.c b/source/luametatex/source/luaoptional/lmtmujs.c
new file mode 100644
index 000000000..e1abfdc0b
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtmujs.c
@@ -0,0 +1,609 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+ The \CLANGUAGE\ interface looks quite a bit like the \LUA\ interface. This module will only
+ provide print-to-tex functions and no other interfacing. It really makes no sense to provide
+ more. An interesting lightweight interface could map onto \LUA\ calls but there is no gain
+ either. Consider it an experiment that might attract kids to \TEX, just because \JAVASCRIPT\
+ looks familiar. We have only one instance. Of course we could use some userdata object but I
+ don't think it is worth the effort and one would like to be persistent across calls. (We used
+ to have multiple \LUA\ instances which made no sense either.)
+
+ url: https://mujs.com/index.html
+
+ Keep in mind: we don't have a \JAVASCRIPT\ interoreter embedded because this is just a small
+ minimal interface to code that {\em can} be loaded at runtime, if present at all.
+
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef struct js_State js_State;
+
+typedef void (*js_CFunction) (js_State *J);
+typedef void (*js_Report) (js_State *J, const char *message);
+typedef void (*js_Finalize) (js_State *J, void *p);
+
+typedef enum js_states {
+ JS_STRICT = 1,
+} js_states;
+
+typedef enum js_properties {
+ JS_READONLY = 1,
+ JS_DONTENUM = 2,
+ JS_DONTCONF = 4,
+} js_properties;
+
+/*tex A couple of status variables: */
+
+typedef struct mujslib_state_info {
+
+ js_State *instance;
+ int initialized;
+ int find_file_id;
+ int open_file_id;
+ int close_file_id;
+ int read_file_id;
+ int seek_file_id;
+ int console_id;
+ int padding;
+
+ struct js_State * (*js_newstate) (
+ void *alloc,
+ void *actx,
+ int flags
+ );
+
+ void (*js_freestate) (
+ js_State *J
+ );
+
+ void (*js_setreport) (
+ js_State *J,
+ js_Report report
+ );
+
+ int (*js_dostring) (
+ js_State *J,
+ const char *source
+ );
+
+ void (*js_newcfunction) (
+ js_State *J,
+ js_CFunction fun,
+ const char *name,
+ int length
+ );
+
+ void (*js_newuserdata) (
+ js_State *J,
+ const char *tag,
+ void *data,
+ js_Finalize finalize
+ );
+
+ void (*js_newcconstructor) (
+ js_State *J,
+ js_CFunction fun,
+ js_CFunction con,
+ const char *name,
+ int length
+ );
+
+ int (*js_dofile) (
+ js_State *J,
+ const char *filename
+ );
+
+ void (*js_currentfunction) (
+ js_State *J
+ );
+
+ void (*js_getglobal) (js_State *J, const char *name );
+ void (*js_setglobal) (js_State *J, const char *name );
+ void (*js_defglobal) (js_State *J, const char *name, int atts );
+
+ void (*js_getproperty) (js_State *J, int idx, const char *name );
+ void (*js_setproperty) (js_State *J, int idx, const char *name );
+ void (*js_defproperty) (js_State *J, int idx, const char *name, int atts);
+
+ void (*js_pushundefined) (js_State *J );
+ void (*js_pushnull) (js_State *J );
+ void (*js_pushnumber) (js_State *J, double v );
+ void (*js_pushstring) (js_State *J, const char *v );
+
+ const char * (*js_tostring) (js_State *J, int idx );
+ int (*js_tointeger) (js_State *J, int idx );
+ void * (*js_touserdata) (js_State *J, int idx, const char *tag );
+
+ int (*js_isnumber) (js_State *J, int idx );
+ int (*js_isstring) (js_State *J, int idx );
+ int (*js_isundefined) (js_State *J, int idx );
+
+} mujslib_state_info;
+
+static mujslib_state_info mujslib_state = {
+
+ .initialized = 0,
+ .instance = NULL,
+ .find_file_id = 0,
+ .open_file_id = 0,
+ .close_file_id = 0,
+ .read_file_id = 0,
+ .seek_file_id = 0,
+ .console_id = 0,
+ .padding = 0,
+
+ .js_newstate = NULL,
+ .js_freestate = NULL,
+ .js_setreport = NULL,
+ .js_dostring = NULL,
+ .js_newcfunction = NULL,
+ .js_newuserdata = NULL,
+ .js_newcconstructor = NULL,
+ .js_dofile = NULL,
+ .js_currentfunction = NULL,
+
+ .js_getglobal = NULL,
+ .js_setglobal = NULL,
+ .js_defglobal = NULL,
+
+ .js_getproperty = NULL,
+ .js_setproperty = NULL,
+ .js_defproperty = NULL,
+
+ .js_pushundefined = NULL,
+ .js_pushnull = NULL,
+ .js_pushnumber = NULL,
+ .js_pushstring = NULL,
+
+ .js_tostring = NULL,
+ .js_tointeger = NULL,
+ .js_touserdata = NULL,
+
+ .js_isnumber = NULL,
+ .js_isstring = NULL,
+ .js_isundefined = NULL,
+
+};
+
+/*tex A few callbacks: */
+
+static int mujslib_register_function(lua_State * L, int old_id)
+{
+ if (! (lua_isfunction(L, -1) || lua_isnil(L, -1))) {
+ return 0;
+ } else {
+ lua_pushvalue(L, -1);
+ if (old_id) {
+ luaL_unref(L, LUA_REGISTRYINDEX, old_id);
+ }
+ return luaL_ref(L, LUA_REGISTRYINDEX);
+ }
+}
+
+static int mujslib_set_find_file(lua_State *L)
+{
+ mujslib_state.find_file_id = mujslib_register_function(L, mujslib_state.find_file_id);
+ return 0;
+}
+
+static int mujslib_set_open_file(lua_State *L)
+{
+ mujslib_state.open_file_id = mujslib_register_function(L, mujslib_state.open_file_id);
+ return 0;
+}
+
+static int mujslib_set_close_file(lua_State *L)
+{
+ mujslib_state.close_file_id = mujslib_register_function(L, mujslib_state.close_file_id);
+ return 0;
+}
+
+static int mujslib_set_read_file(lua_State *L)
+{
+ mujslib_state.read_file_id = mujslib_register_function(L, mujslib_state.read_file_id);
+ return 0;
+}
+
+static int mujslib_set_seek_file(lua_State *L)
+{
+ mujslib_state.seek_file_id = mujslib_register_function(L, mujslib_state.seek_file_id);
+ return 0;
+}
+
+static int mujslib_set_console(lua_State *L)
+{
+ mujslib_state.console_id = mujslib_register_function(L, mujslib_state.console_id);
+ return 0;
+}
+
+static char *mujslib_find_file(const char *fname, const char *fmode)
+{
+ if (mujslib_state.find_file_id) {
+ lua_State *L = lmt_lua_state.lua_instance; /* todo: pass */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mujslib_state.find_file_id);
+ lua_pushstring(L, fname);
+ lua_pushstring(L, fmode);
+ if (lua_pcall(L, 2, 1, 0)) {
+ tex_formatted_warning("mujs", "find file: %s\n", lua_tostring(L, -1));
+ } else {
+ char *s = NULL;
+ const char *x = lua_tostring(L, -1);
+ if (x) {
+ s = strdup(x);
+ }
+ lua_pop(L, 1);
+ return s;
+ }
+ } else {
+ tex_normal_warning("mujs", "missing callback: find file");
+ }
+ return NULL;
+}
+
+/*tex A few helpers: */
+
+static void mujslib_aux_texcprint(js_State *J, int ispartial)
+{
+ int c = default_catcode_table_preset;
+ int i = 0;
+ if (mujslib_state.js_isnumber(J, 1)) {
+ if (mujslib_state.js_isnumber(J, 2) || mujslib_state.js_isstring(J, 2)) {
+ c = mujslib_state.js_tointeger(J, 1);
+ i = 2;
+ } else {
+ i = 1;
+ }
+ } else if (mujslib_state.js_isstring(J, 1)) {
+ i = 1;
+ }
+ if (i) {
+ const char *s = mujslib_state.js_tostring(J, i);
+ if (s) {
+ lmt_cstring_print(c, s, ispartial);
+ }
+ } else {
+ tex_normal_warning("mujs", "invalid argument(s) for printing to tex");
+ }
+ mujslib_state.js_pushundefined(J); /* needed ? */
+}
+
+static void mujslib_aux_texprint(js_State *J)
+{
+ mujslib_aux_texcprint(J, 0); /* full line */
+}
+
+static void mujslib_aux_texsprint(js_State *J)
+{
+ mujslib_aux_texcprint(J, 1); /* partial line */
+}
+
+static void mujslib_aux_feedback(js_State *J, const char *category, const char *message)
+{
+ if (message) {
+ if (mujslib_state.console_id) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mujslib_state.console_id);
+ lua_pushstring(L, category);
+ lua_pushstring(L, message);
+ if (lua_pcall(L, 2, 0, 0)) {
+ tex_formatted_warning("mujs", "console: %s\n", lua_tostring(L, -1));
+ }
+ } else {
+ tex_print_message(message);
+ }
+ }
+ mujslib_state.js_pushundefined(J);
+}
+
+static void mujslib_aux_console(js_State *J)
+{
+ mujslib_aux_feedback(J, "console", mujslib_state.js_tostring(J, 1));
+}
+
+static void mujslib_aux_report(js_State *J, const char *s)
+{
+ mujslib_aux_feedback(J, "report", s);
+}
+
+/*tex
+ The interfaces: for loading files a finder callback is mandate so that
+ we keep control over what gets read from where.
+*/
+
+static int mujslib_execute(lua_State *L)
+{
+ if (mujslib_state.instance) {
+ const char *s = lua_tostring(L, 1);
+ if (s) {
+ mujslib_state.js_dostring(mujslib_state.instance, s);
+ }
+ }
+ return 0;
+}
+
+static int mujslib_dofile(lua_State *L)
+{
+ if (mujslib_state.instance) {
+ const char *name = lua_tostring(L, 1);
+ if (name) {
+ char *found = mujslib_find_file(name, "rb");
+ if (found) {
+ mujslib_state.js_dofile(mujslib_state.instance, found);
+ }
+ free(found);
+ }
+ } else {
+ tex_normal_warning("mujs", "missing callback: find file");
+ }
+ return 0;
+}
+
+static void mujslib_start(void)
+{
+ if (mujslib_state.instance) {
+ mujslib_state.js_freestate(mujslib_state.instance);
+ }
+ mujslib_state.instance = mujslib_state.js_newstate(NULL, NULL, JS_STRICT);
+ if (mujslib_state.instance) {
+ mujslib_state.js_newcfunction(mujslib_state.instance, mujslib_aux_texprint, "texprint", 2);
+ mujslib_state.js_setglobal (mujslib_state.instance, "texprint");
+ mujslib_state.js_newcfunction(mujslib_state.instance, mujslib_aux_texsprint, "texsprint", 2);
+ mujslib_state.js_setglobal (mujslib_state.instance, "texsprint");
+ mujslib_state.js_newcfunction(mujslib_state.instance, mujslib_aux_console, "console", 1);
+ mujslib_state.js_setglobal (mujslib_state.instance, "console");
+ mujslib_state.js_setreport (mujslib_state.instance, mujslib_aux_report);
+ }
+}
+
+static int mujslib_reset(lua_State *L)
+{
+ if (mujslib_state.initialized) {
+ mujslib_start();
+ }
+ lua_pushboolean(L, mujslib_state.initialized && mujslib_state.instance);
+ return 1;
+}
+
+/*tex
+ File handling: we go via the \LUA\ interface so that we have control
+ over what happens. Another benefit is that we don't need memory
+ management when fetching data from files.
+*/
+
+static void mujslib_file_finalize(js_State *J, void *p)
+{
+ int *id = p;
+ (void) J;
+ if (*id) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mujslib_state.close_file_id);
+ lua_pushinteger(L, *id);
+ if (lua_pcall(L, 1, 0, 0)) {
+ tex_formatted_warning("mujs", "close file: %s\n", lua_tostring(L, -1));
+ }
+ lua_settop(L,top);
+ }
+}
+
+static void mujslib_file_close(js_State *J)
+{
+ if (mujslib_state.instance) {
+ if (mujslib_state.close_file_id) {
+ int *id = mujslib_state.js_touserdata(J, 0, "File");
+ if (*id) {
+ mujslib_file_finalize(J, id);
+ }
+ } else {
+ tex_normal_warning("mujs", "missing callback: close file");
+ }
+ }
+ mujslib_state.js_pushundefined(J);
+}
+
+static void mujslib_file_read(js_State *J)
+{
+ if (mujslib_state.instance) {
+ if (mujslib_state.read_file_id) {
+ int *id = mujslib_state.js_touserdata(J, 0, "File");
+ if (*id) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = lua_gettop(L);
+ int n = 1;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mujslib_state.read_file_id);
+ lua_pushinteger(L, *id);
+ if (mujslib_state.js_isstring(J, 1)) {
+ const char *how = mujslib_state.js_tostring(J, 1);
+ if (how) {
+ lua_pushstring(L, how);
+ n = 2;
+ }
+ } else if (mujslib_state.js_isnumber(J, 1)) {
+ int how = mujslib_state.js_tointeger(J, 1);
+ if (how) {
+ lua_pushinteger(L, how);
+ n = 2;
+ }
+ }
+ if (lua_pcall(L, n, 1, 0)) {
+ tex_formatted_warning("mujs", "close file: %s\n", lua_tostring(L, -1));
+ } else {
+ const char *result = strdup(lua_tostring(L, -1));
+ if (result) {
+ mujslib_state.js_pushstring(J, result);
+ lua_settop(L, top);
+ return;
+ }
+ }
+ lua_settop(L, top);
+ }
+ } else {
+ tex_normal_warning("mujs", "missing callback: read file");
+ }
+ }
+ mujslib_state.js_pushundefined(J);
+}
+
+static void mujslib_file_seek(js_State *J)
+{
+ if (mujslib_state.instance) {
+ if (mujslib_state.seek_file_id) {
+ int *id = mujslib_state.js_touserdata(J, 0, "File");
+ if (*id) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = lua_gettop(L);
+ int n = 2;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mujslib_state.seek_file_id);
+ lua_pushinteger(L, *id);
+ /* no checking here */
+ lua_pushstring(L, mujslib_state.js_tostring(J, 1));
+ if (mujslib_state.js_isnumber(J, 2)) {
+ lua_pushinteger(L, mujslib_state.js_tointeger(J, 2));
+ n = 3;
+ }
+ if (lua_pcall(L, n, 1, 0)) {
+ tex_formatted_warning("mujs", "seek file: %s\n", lua_tostring(L, -1));
+ } else if (lua_type(L, -1) == LUA_TNUMBER) {
+ mujslib_state.js_pushnumber(J, lua_tonumber(L, -1));
+ lua_settop(L, top);
+ return;
+ }
+ lua_settop(L, top);
+ }
+ } else {
+ tex_normal_warning("mujs", "missing callback: seek file");
+ }
+ }
+ mujslib_state.js_pushundefined(J);
+}
+
+static void mujslib_file_new(js_State *J)
+{
+ if (mujslib_state.instance) {
+ if (mujslib_state.open_file_id) {
+ const char *name = mujslib_state.js_tostring(J, 1);
+ if (name) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = lua_gettop(L);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, mujslib_state.open_file_id);
+ lua_pushstring(L, name);
+ if (lua_pcall(L, 1, 1, 0)) {
+ tex_formatted_warning("mujs", "open file: %s\n", lua_tostring(L, -1));
+ } else {
+ int *id = malloc(sizeof(int));
+ if (id) {
+ *((int*) id) = (int) lua_tointeger(L, -1);
+ lua_settop(L, top);
+ if (id) {
+ mujslib_state.js_currentfunction(J);
+ mujslib_state.js_getproperty(J, -1, "prototype");
+ mujslib_state.js_newuserdata(J, "File", id, mujslib_file_finalize);
+ return;
+ }
+ }
+ }
+ lua_settop(L, top);
+ }
+ } else {
+ tex_normal_warning("mujs", "missing callback: open file");
+ }
+ }
+ mujslib_state.js_pushnull(J);
+}
+
+/* Setting things up. */
+
+static void mujslib_file_initialize(js_State *J)
+{
+ mujslib_state.js_getglobal(J, "Object");
+ mujslib_state.js_getproperty(J, -1, "prototype");
+ mujslib_state.js_newuserdata(J, "File", stdin, NULL);
+ {
+ mujslib_state.js_newcfunction(J, mujslib_file_read, "File.prototype.read", 0);
+ mujslib_state.js_defproperty(J, -2, "read", JS_DONTENUM);
+ mujslib_state.js_newcfunction(J, mujslib_file_seek, "File.prototype.seek", 0);
+ mujslib_state.js_defproperty(J, -2, "seek", JS_DONTENUM);
+ mujslib_state.js_newcfunction(J, mujslib_file_close, "File.prototype.close", 0);
+ mujslib_state.js_defproperty(J, -2, "close", JS_DONTENUM);
+ }
+ mujslib_state.js_newcconstructor(J, mujslib_file_new, mujslib_file_new, "File", 1);
+ mujslib_state.js_defglobal(J, "File", JS_DONTENUM);
+}
+
+static int mujslib_initialize(lua_State *L)
+{
+ if (! mujslib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ mujslib_state.js_newstate = lmt_library_find(lib, "js_newstate");
+ mujslib_state.js_freestate = lmt_library_find(lib, "js_freestate");
+ mujslib_state.js_setreport = lmt_library_find(lib, "js_setreport");
+
+ mujslib_state.js_newcfunction = lmt_library_find(lib, "js_newcfunction");
+ mujslib_state.js_newuserdata = lmt_library_find(lib, "js_newuserdata");
+ mujslib_state.js_newcconstructor = lmt_library_find(lib, "js_newcconstructor");
+
+ mujslib_state.js_pushundefined = lmt_library_find(lib, "js_pushundefined");
+ mujslib_state.js_pushnull = lmt_library_find(lib, "js_pushnull");
+ mujslib_state.js_pushnumber = lmt_library_find(lib, "js_pushnumber");
+ mujslib_state.js_pushstring = lmt_library_find(lib, "js_pushstring");
+
+ mujslib_state.js_dostring = lmt_library_find(lib, "js_dostring");
+ mujslib_state.js_dofile = lmt_library_find(lib, "js_dofile");
+
+ mujslib_state.js_tostring = lmt_library_find(lib, "js_tostring");
+ mujslib_state.js_tointeger = lmt_library_find(lib, "js_tointeger");
+ mujslib_state.js_touserdata = lmt_library_find(lib, "js_touserdata");
+
+ mujslib_state.js_getglobal = lmt_library_find(lib, "js_getglobal");
+ mujslib_state.js_setglobal = lmt_library_find(lib, "js_setglobal");
+ mujslib_state.js_defglobal = lmt_library_find(lib, "js_defglobal");
+
+ mujslib_state.js_getproperty = lmt_library_find(lib, "js_getproperty");
+ mujslib_state.js_setproperty = lmt_library_find(lib, "js_setproperty");
+ mujslib_state.js_defproperty = lmt_library_find(lib, "js_defproperty");
+
+ mujslib_state.js_isstring = lmt_library_find(lib, "js_isstring");
+ mujslib_state.js_isnumber = lmt_library_find(lib, "js_isnumber");
+ mujslib_state.js_isundefined = lmt_library_find(lib, "js_isundefined");
+
+ mujslib_state.js_currentfunction = lmt_library_find(lib, "js_currentfunction");
+
+ mujslib_state.initialized = lmt_library_okay(lib);
+
+ mujslib_start();
+
+ mujslib_file_initialize(mujslib_state.instance);
+ }
+ }
+ lua_pushboolean(L, mujslib_state.initialized && mujslib_state.instance);
+ return 1;
+}
+
+static struct luaL_Reg mujslib_function_list[] = {
+ { "initialize", mujslib_initialize }, /* mandate */
+ { "reset", mujslib_reset },
+ { "execute", mujslib_execute },
+ { "dofile", mujslib_dofile },
+ { "setfindfile", mujslib_set_find_file }, /* mandate */
+ { "setopenfile", mujslib_set_open_file }, /* mandate */
+ { "setclosefile", mujslib_set_close_file }, /* mandate */
+ { "setreadfile", mujslib_set_read_file }, /* mandate */
+ { "setseekfile", mujslib_set_seek_file },
+ { "setconsole", mujslib_set_console },
+ { NULL, NULL },
+};
+
+int luaopen_mujs(lua_State *L)
+{
+ lmt_library_register(L, "mujs", mujslib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtmysql.c b/source/luametatex/source/luaoptional/lmtmysql.c
new file mode 100644
index 000000000..8509df7aa
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtmysql.c
@@ -0,0 +1,325 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef void mysql_instance;
+typedef void mysql_result;
+typedef char **mysql_row;
+typedef unsigned int mysql_offset;
+
+typedef struct mysql_field {
+ char *name;
+ char *org_name;
+ char *table;
+ char *org_table;
+ char *db;
+ char *catalog;
+ char *def;
+ unsigned long length;
+ unsigned long max_length;
+ unsigned int name_length;
+ unsigned int org_name_length;
+ unsigned int table_length;
+ unsigned int org_table_length;
+ unsigned int db_length;
+ unsigned int catalog_length;
+ unsigned int def_length;
+ unsigned int flags;
+ unsigned int decimals;
+ unsigned int charsetnr;
+ int type;
+ void *extension;
+} mysql_field;
+
+# define MYSQLLIB_METATABLE "luatex.mysqllib"
+
+typedef struct mysqllib_data {
+ /*tex There is not much more than a pointer currently. */
+ mysql_instance * db;
+} mysqllib_data ;
+
+typedef struct mysqllib_state_info {
+
+ int initialized;
+ int padding;
+
+ mysql_instance * (*mysql_init) (
+ mysql_instance *mysql
+ );
+
+ mysql_instance * (*mysql_real_connect) (
+ mysql_instance *mysql,
+ const char *host,
+ const char *user,
+ const char *passwd,
+ const char *db,
+ unsigned int port,
+ const char *unix_socket,
+ unsigned long clientflag
+ );
+
+ unsigned int (*mysql_errno) (
+ mysql_instance *mysql
+ );
+
+ const char * (*mysql_error) (
+ mysql_instance *mysql
+ );
+
+ int (*mysql_real_query) (
+ mysql_instance *mysql,
+ const char *q,
+ unsigned long length
+ );
+
+ mysql_result * (*mysql_store_result) (
+ mysql_instance *mysql
+ );
+
+ void (*mysql_free_result) (
+ mysql_result *result
+ );
+
+ unsigned long long (*mysql_num_rows) (
+ mysql_result *res
+ );
+
+ mysql_row (*mysql_fetch_row) (
+ mysql_result *result
+ );
+
+ unsigned int (*mysql_affected_rows) (
+ mysql_instance *mysql
+ );
+
+ unsigned int (*mysql_field_count) (
+ mysql_instance *mysql
+ );
+
+ unsigned int (*mysql_num_fields) (
+ mysql_result *res
+ );
+
+ mysql_field * (*mysql_fetch_fields) (
+ mysql_result *res
+ );
+
+ mysql_offset (*mysql_field_seek) (
+ mysql_result *result,
+ mysql_offset offset
+ );
+
+ void (*mysql_close) (
+ mysql_instance *sock
+ );
+
+} mysqllib_state_info;
+
+static mysqllib_state_info mysqllib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .mysql_init = NULL,
+ .mysql_real_connect = NULL,
+ .mysql_errno = NULL,
+ .mysql_error = NULL,
+ .mysql_real_query = NULL,
+ .mysql_store_result = NULL,
+ .mysql_free_result = NULL,
+ .mysql_num_rows = NULL,
+ .mysql_fetch_row = NULL,
+ .mysql_affected_rows = NULL,
+ .mysql_field_count = NULL,
+ .mysql_num_fields = NULL,
+ .mysql_fetch_fields = NULL,
+ .mysql_field_seek = NULL,
+ .mysql_close = NULL,
+
+};
+
+static int mysqllib_initialize(lua_State * L)
+{
+ if (! mysqllib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename != NULL) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ mysqllib_state.mysql_init = lmt_library_find(lib, "mysql_init" );
+ mysqllib_state.mysql_real_connect = lmt_library_find(lib, "mysql_real_connect" );
+ mysqllib_state.mysql_errno = lmt_library_find(lib, "mysql_errno" );
+ mysqllib_state.mysql_error = lmt_library_find(lib, "mysql_error" );
+ mysqllib_state.mysql_real_query = lmt_library_find(lib, "mysql_real_query" );
+ mysqllib_state.mysql_store_result = lmt_library_find(lib, "mysql_store_result" );
+ mysqllib_state.mysql_free_result = lmt_library_find(lib, "mysql_free_result" );
+ mysqllib_state.mysql_num_rows = lmt_library_find(lib, "mysql_num_rows" );
+ mysqllib_state.mysql_fetch_row = lmt_library_find(lib, "mysql_fetch_row" );
+ mysqllib_state.mysql_affected_rows = lmt_library_find(lib, "mysql_affected_rows" );
+ mysqllib_state.mysql_field_count = lmt_library_find(lib, "mysql_field_count" );
+ mysqllib_state.mysql_num_fields = lmt_library_find(lib, "mysql_num_fields" );
+ mysqllib_state.mysql_fetch_fields = lmt_library_find(lib, "mysql_fetch_fields" );
+ mysqllib_state.mysql_field_seek = lmt_library_find(lib, "mysql_field_seek" );
+ mysqllib_state.mysql_close = lmt_library_find(lib, "mysql_close" );
+
+ mysqllib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, mysqllib_state.initialized);
+ return 1;
+}
+
+static int mysqllib_open(lua_State * L)
+{
+ if (mysqllib_state.initialized) {
+ const char * database = luaL_checkstring(L, 1);
+ const char * username = luaL_optstring(L, 2, NULL);
+ const char * password = luaL_optstring(L, 3, NULL);
+ const char * host = luaL_optstring(L, 4, NULL);
+ int port = lmt_optinteger(L, 5, 0);
+ const char * socket = NULL; /* luaL_optstring(L, 6, NULL); */
+ int flag = 0; /* luaL_optinteger(L, 7, 0); */
+ mysql_instance * db = mysqllib_state.mysql_init(NULL);
+ if (db != NULL) {
+ if (mysqllib_state.mysql_real_connect(db, host, username, password, database, port, socket, flag)) {
+ mysqllib_data *data = lua_newuserdatauv(L, sizeof(data), 0);
+ data->db = db ;
+ luaL_getmetatable(L, MYSQLLIB_METATABLE);
+ lua_setmetatable(L, -2);
+ return 1;
+ } else {
+ mysqllib_state.mysql_close(db);
+ }
+ }
+ }
+ return 0;
+}
+
+static int mysqllib_close(lua_State * L)
+{
+ if (mysqllib_state.initialized) {
+ mysqllib_data * data = luaL_checkudata(L, 1, MYSQLLIB_METATABLE);
+ if (data != NULL) {
+ mysqllib_state.mysql_close(data->db);
+ data->db = NULL;
+ }
+ }
+ return 0;
+}
+
+/* execute(database,querystring,callback) : callback(nofcolumns,values,fields) */
+
+static int mysqllib_execute(lua_State * L)
+{
+ if (mysqllib_state.initialized) {
+ mysqllib_data * data = luaL_checkudata(L, 1, MYSQLLIB_METATABLE);
+ if (data != NULL) {
+ size_t length = 0;
+ const char *query = lua_tolstring(L, 2, &length);
+ if (query != NULL) {
+ int error = mysqllib_state.mysql_real_query(data->db, query, (int) length);
+ if (!error) {
+ mysql_result * result = mysqllib_state.mysql_store_result(data->db);
+ if (result != NULL) {
+ int nofrows = 0;
+ int nofcolumns = 0;
+ mysqllib_state.mysql_field_seek(result, 0);
+ nofrows = (int) mysqllib_state.mysql_num_rows(result);
+ nofcolumns = mysqllib_state.mysql_num_fields(result);
+ /* This is similar to sqlite but there the callback is more indirect. */
+ if (nofcolumns > 0 && nofrows > 0) {
+ for (int r = 0; r < nofrows; r++) {
+ mysql_row row = mysqllib_state.mysql_fetch_row(result);
+ lua_pushvalue(L, -1);
+ lua_pushinteger(L, nofcolumns);
+ lua_createtable(L, nofcolumns, 0);
+ for (int c = 0; c < nofcolumns; c++) {
+ lua_pushstring(L, row[c]);
+ lua_rawseti(L, -2, (lua_Integer)c + 1);
+ }
+ if (r) {
+ lua_call(L, 2, 0);
+ } else {
+ mysql_field * fields = mysqllib_state.mysql_fetch_fields(result);
+ lua_createtable(L, nofcolumns, 0);
+ for (int c = 0; c < nofcolumns; c++) {
+ lua_pushstring(L, fields[c].name);
+ lua_rawseti(L, -2, (lua_Integer)c + 1);
+ }
+ lua_call(L, 3, 0);
+ }
+ }
+ }
+ mysqllib_state.mysql_free_result(result);
+ }
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ }
+ }
+ }
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int mysqllib_getmessage(lua_State * L)
+{
+ if (mysqllib_state.initialized) {
+ mysqllib_data * data = luaL_checkudata(L, 1, MYSQLLIB_METATABLE);
+ if (data != NULL) {
+ lua_pushstring(L, mysqllib_state.mysql_error(data->db));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* private */
+
+static int mysqllib_free(lua_State * L)
+{
+ return mysqllib_close(L);
+}
+
+/* <string> = tostring(instance) */
+
+static int mysqllib_tostring(lua_State * L)
+{
+ if (mysqllib_state.initialized) {
+ mysqllib_data * data = luaL_checkudata(L, 1, MYSQLLIB_METATABLE);
+ if (data != NULL) {
+ (void) lua_pushfstring(L, "<mysqllib-instance %p>", data);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static const struct luaL_Reg mysqllib_metatable[] = {
+ { "__tostring", mysqllib_tostring },
+ { "__gc", mysqllib_free },
+ { NULL, NULL },
+};
+
+static struct luaL_Reg mysqllib_function_list[] = {
+ { "initialize", mysqllib_initialize },
+ { "open", mysqllib_open },
+ { "close", mysqllib_close },
+ { "execute", mysqllib_execute },
+ { "getmessage", mysqllib_getmessage },
+ { NULL, NULL },
+};
+
+int luaopen_mysql(lua_State * L)
+{
+ luaL_newmetatable(L, MYSQLLIB_METATABLE);
+ luaL_setfuncs(L, mysqllib_metatable, 0);
+ lmt_library_register(L, "mysql", mysqllib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtoptional.c b/source/luametatex/source/luaoptional/lmtoptional.c
new file mode 100644
index 000000000..0cfbd166c
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtoptional.c
@@ -0,0 +1,50 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+/*tex
+
+ We don't want the binary top explode and have depdencies that will kill this project in the
+ end. So, we provide optionals: these are loaded lazy and libraries need to be present in
+ the tree. They are unofficial and not supported in the sense that ConTeXt doesn't depend on
+ them.
+
+ The socket library is a candidate for ending up here too, as are the optional rest modules
+ lzo and lz4.
+
+*/
+
+int luaopen_optional(lua_State *L) {
+ /*tex We always have an |optional| root table. */
+ lmt_library_initialize(L);
+ luaopen_library(L);
+ luaopen_foreign(L); /* maybe in main */
+ /*tex These are kind of standard. */
+ luaopen_sqlite(L);
+ luaopen_mysql(L);
+ luaopen_postgress(L);
+ luaopen_curl(L);
+ luaopen_ghostscript(L);
+ luaopen_graphicsmagick(L);
+ luaopen_imagemagick(L);
+ luaopen_zint(L);
+ /*tex These are fun. */
+ luaopen_mujs(L);
+ /*tex These might be handy. */
+ luaopen_lzo(L);
+ luaopen_lz4(L);
+ luaopen_zstd(L);
+ luaopen_lzma(L);
+ /*tex These are extras. */
+# ifdef LMT_KPSE_TOO
+ luaopen_kpse(L);
+# endif
+# ifdef LMT_HB_TOO
+ luaopen_hb(L);
+# endif
+ /*tex Done. */
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtoptional.h b/source/luametatex/source/luaoptional/lmtoptional.h
new file mode 100644
index 000000000..bceec90df
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtoptional.h
@@ -0,0 +1,34 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LUAOPTIONAL_H
+# define LMT_LUAOPTIONAL_H
+
+# include <lua.h>
+
+/*tex This saves a bunch of h files. */
+
+extern int luaopen_optional (lua_State *L);
+extern int luaopen_library (lua_State *L);
+extern int luaopen_foreign (lua_State *L);
+
+extern int luaopen_sqlite (lua_State *L);
+extern int luaopen_mysql (lua_State *L);
+extern int luaopen_curl (lua_State *L);
+extern int luaopen_postgress (lua_State *L);
+extern int luaopen_ghostscript (lua_State *L);
+extern int luaopen_graphicsmagick(lua_State *L);
+extern int luaopen_imagemagick (lua_State *L);
+extern int luaopen_zint (lua_State *L);
+extern int luaopen_mujs (lua_State *L);
+extern int luaopen_lzo (lua_State *L);
+extern int luaopen_lz4 (lua_State *L);
+extern int luaopen_zstd (lua_State *L);
+extern int luaopen_lzma (lua_State *L);
+extern int luaopen_kpse (lua_State *L); /*tex For testing compatibility, if needed at all, not really I guess. */
+extern int luaopen_hb (lua_State *L); /*tex For when Idris needs to check fonts some day ... old stuff, not tested much. */
+
+extern int luaextend_xcomplex (lua_State *L);
+
+# endif
diff --git a/source/luametatex/source/luaoptional/lmtpostgress.c b/source/luametatex/source/luaoptional/lmtpostgress.c
new file mode 100644
index 000000000..cdf515155
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtpostgress.c
@@ -0,0 +1,306 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef void PGconn;
+typedef void PGresult;
+
+typedef enum postgres_polling_status_type {
+ PGRES_POLLING_FAILED,
+ PGRES_POLLING_READING,
+ PGRES_POLLING_WRITING,
+ PGRES_POLLING_OK
+} postgres_polling_status_type;
+
+typedef enum postgres_exec_status_type {
+ PGRES_EMPTY_QUERY,
+ PGRES_COMMAND_OK,
+ PGRES_TUPLES_OK,
+ PGRES_COPY_OUT,
+ PGRES_COPY_IN,
+ PGRES_BAD_RESPONSE,
+ PGRES_NONFATAL_ERROR,
+ PGRES_FATAL_ERROR,
+ PGRES_COPY_BOTH,
+ PGRES_SINGLE_TUPLE
+} postgres_exec_status_type;
+
+typedef enum postgres_connection_status_type {
+ PGRES_CONNECTION_OK,
+ PGRES_CONNECTION_BAD,
+ PGRES_CONNECTION_STARTED,
+ PGRES_CONNECTION_MADE,
+ PGRES_CONNECTION_AWAITING_RESPONSE,
+ PGRES_CONNECTION_AUTH_OK,
+ PGRES_CONNECTION_SETENV,
+ PGRES_CONNECTION_SSL_STARTUP,
+ PGRES_CONNECTION_NEEDED
+} postgres_connection_status_type;
+
+# define POSTGRESSLIB_METATABLE "luatex.postgresslib"
+
+typedef struct postgresslib_data {
+ /*tex There is not much more than a pointer currently. */
+ PGconn * db;
+} postgresslib_data ;
+
+typedef struct postgresslib_state_info {
+
+ int initialized;
+ int padding;
+
+ PGconn * (*PQsetdbLogin) (
+ const char *pghost,
+ const char *pgport,
+ const char *pgoptions,
+ const char *pgtty,
+ const char *dbName,
+ const char *login,
+ const char *pwd
+ );
+
+ postgres_connection_status_type (*PQstatus) (
+ const PGconn *conn
+ );
+
+ void (*PQfinish) (
+ PGconn *conn
+ );
+
+ char * (*PQerrorMessage) (
+ const PGconn *conn
+ );
+
+ int (*PQsendQuery) (
+ PGconn *conn,
+ const char *command
+ );
+
+ PGresult * (*PQgetResult) (
+ PGconn *conn
+ );
+
+ postgres_exec_status_type (*PQresultStatus) (
+ const PGresult *res
+ );
+
+ int (*PQntuples) (
+ const PGresult *res
+ );
+
+ int (*PQnfields) (
+ const PGresult *res
+ );
+
+ void (*PQclear) (
+ PGresult *res
+ );
+
+ char * (*PQfname) (
+ const PGresult *res,
+ int column_number
+ );
+
+ char * (*PQgetvalue) (
+ const PGresult *res,
+ int row_number,
+ int column_number
+ );
+
+} postgresslib_state_info;
+
+static postgresslib_state_info postgresslib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .PQsetdbLogin = NULL,
+ .PQstatus = NULL,
+ .PQfinish = NULL,
+ .PQerrorMessage = NULL,
+ .PQsendQuery = NULL,
+ .PQgetResult = NULL,
+ .PQresultStatus = NULL,
+ .PQntuples = NULL,
+ .PQnfields = NULL,
+ .PQclear = NULL,
+ .PQfname = NULL,
+ .PQgetvalue = NULL,
+
+};
+
+static int postgresslib_initialize(lua_State * L)
+{
+ if (! postgresslib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename != NULL) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ postgresslib_state.PQsetdbLogin = lmt_library_find(lib, "PQsetdbLogin");
+ postgresslib_state.PQstatus = lmt_library_find(lib, "PQstatus");
+ postgresslib_state.PQfinish = lmt_library_find(lib, "PQfinish");
+ postgresslib_state.PQerrorMessage = lmt_library_find(lib, "PQerrorMessage");
+ postgresslib_state.PQsendQuery = lmt_library_find(lib, "PQsendQuery");
+ postgresslib_state.PQgetResult = lmt_library_find(lib, "PQgetResult");
+ postgresslib_state.PQresultStatus = lmt_library_find(lib, "PQresultStatus");
+ postgresslib_state.PQntuples = lmt_library_find(lib, "PQntuples");
+ postgresslib_state.PQnfields = lmt_library_find(lib, "PQnfields");
+ postgresslib_state.PQclear = lmt_library_find(lib, "PQclear");
+ postgresslib_state.PQfname = lmt_library_find(lib, "PQfname");
+ postgresslib_state.PQgetvalue = lmt_library_find(lib, "PQgetvalue");
+
+ postgresslib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, postgresslib_state.initialized);
+ return 1;
+}
+
+static int postgresslib_open(lua_State * L)
+{
+ if (postgresslib_state.initialized) {
+ const char *database = luaL_checkstring(L, 1);
+ const char *username = luaL_optstring(L, 2, NULL);
+ const char *password = luaL_optstring(L, 3, NULL);
+ const char *host = luaL_optstring(L, 4, NULL);
+ const char *port = luaL_optstring(L, 5, NULL);
+ PGconn *db = postgresslib_state.PQsetdbLogin(host, port, NULL, NULL, database, username, password);
+ if (db != NULL && postgresslib_state.PQstatus(db) == PGRES_CONNECTION_BAD) {
+ postgresslib_state.PQfinish(db);
+ } else {
+ postgresslib_data *data = lua_newuserdatauv(L, sizeof(data), 0);
+ data->db = db ;
+ luaL_getmetatable(L, POSTGRESSLIB_METATABLE);
+ lua_setmetatable(L, -2);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int postgresslib_close(lua_State * L)
+{
+ if (postgresslib_state.initialized) {
+ postgresslib_data * data = luaL_checkudata(L,1,POSTGRESSLIB_METATABLE);
+ if (data != NULL) {
+ postgresslib_state.PQfinish(data->db);
+ data->db = NULL;
+ }
+ }
+ return 0;
+}
+
+/* execute(database,querystring,callback) : callback(nofcolumns,values,fields) */
+
+static int postgresslib_execute(lua_State * L)
+{
+ if (postgresslib_state.initialized) {
+ postgresslib_data * data = luaL_checkudata(L, 1, POSTGRESSLIB_METATABLE);
+ if (data != NULL) {
+ size_t length = 0;
+ const char *query = lua_tolstring(L, 2, &length);
+ if (query != NULL) {
+ int error = postgresslib_state.PQsendQuery(data->db, query);
+ if (!error) {
+ PGresult * result = postgresslib_state.PQgetResult(data->db);
+ if (result) {
+ if (postgresslib_state.PQresultStatus(result) == PGRES_TUPLES_OK) {
+ int nofrows = postgresslib_state.PQntuples(result);
+ int nofcolumns = postgresslib_state.PQnfields(result);
+ /* This is similar to sqlite but there the callback is more indirect. */
+ if (nofcolumns > 0 && nofrows > 0) {
+ for (int r = 0; r < nofrows; r++) {
+ lua_pushvalue(L, -1);
+ lua_pushinteger(L, nofcolumns);
+ lua_createtable(L, nofcolumns, 0);
+ for (int c = 0; c < nofcolumns; c++) {
+ lua_pushstring(L, postgresslib_state.PQgetvalue(result, r, c));
+ lua_rawseti(L,- 2, (lua_Integer)c + 1);
+ }
+ if (r) {
+ lua_call(L, 2, 0);
+ } else {
+ lua_createtable(L, nofcolumns, 0);
+ for (int c = 0; c < nofcolumns; c++) {
+ lua_pushstring(L, postgresslib_state.PQfname(result,c));
+ lua_rawseti(L, -2, (lua_Integer)c + 1);
+ }
+ lua_call(L,3,0);
+ }
+ }
+ }
+ }
+ postgresslib_state.PQclear(result);
+ }
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ }
+ }
+ }
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int postgresslib_getmessage(lua_State * L)
+{
+ if (postgresslib_state.initialized) {
+ postgresslib_data * data = luaL_checkudata(L, 1, POSTGRESSLIB_METATABLE);
+ if (data != NULL) {
+ lua_pushstring(L, postgresslib_state.PQerrorMessage(data->db));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* private */
+
+static int postgresslib_free(lua_State * L)
+{
+ return postgresslib_close(L);
+}
+
+/* <string> = tostring(instance) */
+
+static int postgresslib_tostring(lua_State * L)
+ {
+ if (postgresslib_state.initialized) {
+ postgresslib_data * data = luaL_checkudata(L, 1, POSTGRESSLIB_METATABLE);
+ if (data != NULL) {
+ (void) lua_pushfstring(L, "<postgresslib-instance %p>", data);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static const struct luaL_Reg postgresslib_metatable[] = {
+ { "__tostring", postgresslib_tostring },
+ { "__gc", postgresslib_free },
+ { NULL, NULL },
+};
+
+static struct luaL_Reg postgresslib_function_list[] = {
+ { "initialize", postgresslib_initialize },
+ { "open", postgresslib_open },
+ { "close", postgresslib_close },
+ { "execute", postgresslib_execute },
+ { "getmessage", postgresslib_getmessage },
+ { NULL, NULL },
+};
+
+int luaopen_postgress(lua_State * L)
+{
+ luaL_newmetatable(L, POSTGRESSLIB_METATABLE);
+ luaL_setfuncs(L, postgresslib_metatable, 0);
+ lmt_library_register(L, "postgress", postgresslib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtsqlite.c b/source/luametatex/source/luaoptional/lmtsqlite.c
new file mode 100644
index 000000000..e6e8f1239
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtsqlite.c
@@ -0,0 +1,228 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+typedef struct sqlite3_instance sqlite3_instance;
+
+# define SQLITELIB_METATABLE "luatex.sqlitelib"
+
+typedef struct sqlitelib_data {
+ /*tex There is not much more than a pointer currently. */
+ sqlite3_instance *db;
+} sqlitelib_data ;
+
+typedef struct sqlitelib_state_info {
+
+ int initialized;
+ int padding;
+
+ int (*sqlite3_initialize) (
+ void
+ );
+
+ int (*sqlite3_open) (
+ const char *filename,
+ sqlite3_instance **ppDb
+ );
+
+ int (*sqlite3_close) (
+ sqlite3_instance *
+ );
+
+ int (*sqlite3_exec) (
+ sqlite3_instance *,
+ const char *sql,
+ int (*callback)(void*, int, char**, char**),
+ void *,
+ char **errmsg
+ );
+
+ const char * (*sqlite3_errmsg) (
+ sqlite3_instance *
+ );
+
+} sqlitelib_state_info;
+
+static sqlitelib_state_info sqlitelib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .sqlite3_initialize = NULL,
+ .sqlite3_open = NULL,
+ .sqlite3_close = NULL,
+ .sqlite3_exec = NULL,
+ .sqlite3_errmsg = NULL,
+
+};
+
+static int sqlitelib_initialize(lua_State * L)
+{
+ if (! sqlitelib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ sqlitelib_state.sqlite3_initialize = lmt_library_find(lib, "sqlite3_initialize");
+ sqlitelib_state.sqlite3_open = lmt_library_find(lib, "sqlite3_open");
+ sqlitelib_state.sqlite3_close = lmt_library_find(lib, "sqlite3_close");
+ sqlitelib_state.sqlite3_exec = lmt_library_find(lib, "sqlite3_exec");
+ sqlitelib_state.sqlite3_errmsg = lmt_library_find(lib, "sqlite3_errmsg");
+
+ sqlitelib_state.initialized = lmt_library_okay(lib);
+ }
+ if (sqlitelib_state.initialized) {
+ sqlitelib_state.sqlite3_initialize();
+ }
+ }
+ lua_pushboolean(L, sqlitelib_state.initialized);
+ return 1;
+}
+
+static int sqlitelib_open(lua_State * L)
+{
+ if (sqlitelib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename != NULL) {
+ sqlitelib_data *data = lua_newuserdatauv(L, sizeof(data), 0);
+ if (! sqlitelib_state.sqlite3_open(filename, &(data->db))) {
+ luaL_getmetatable(L, SQLITELIB_METATABLE);
+ lua_setmetatable(L, -2);
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static int sqlitelib_close(lua_State * L)
+{
+ if (sqlitelib_state.initialized) {
+ sqlitelib_data * data = luaL_checkudata(L, 1, SQLITELIB_METATABLE);
+ if (data != NULL) {
+ sqlitelib_state.sqlite3_close(data->db);
+ data->db = NULL;
+ }
+ }
+ return 0;
+}
+
+/* we could save the fields in the registry */
+
+static int rows_done = 0; /* can go on stack */
+
+static int sqlitelib_callback(void * L, int nofcolumns, char **values, char **fields)
+{
+ lua_pushvalue(L, -1);
+ lua_pushinteger(L, nofcolumns);
+ if (nofcolumns > 0 && values != NULL) {
+ lua_createtable(L, nofcolumns, 0);
+ for (int i = 0; i < nofcolumns; i++) {
+ lua_pushstring(L, values[i]);
+ lua_rawseti(L, -2, (lua_Integer)i + 1);
+ }
+ if (! rows_done && fields != NULL) {
+ lua_createtable(L, nofcolumns, 0);
+ for (int i = 0; i < nofcolumns; i++) {
+ lua_pushstring(L, fields[i]);
+ lua_rawseti(L, -2, (lua_Integer)i + 1);
+ }
+ lua_call(L, 3, 0);
+ } else {
+ lua_call(L, 2, 0);
+ }
+ } else {
+ lua_call(L, 1, 0);
+ }
+ ++rows_done;
+ return 0;
+}
+
+/* execute(database,querystring,callback) : callback(nofcolumns,values,fields) */
+
+static int sqlitelib_execute(lua_State * L)
+{
+ if (sqlitelib_state.initialized && ! rows_done) {
+ sqlitelib_data * data = luaL_checkudata(L, 1, SQLITELIB_METATABLE);
+ if (data != NULL) {
+ const char *query = lua_tostring(L, 2);
+ if (query != NULL) {
+ int result = 0;
+ rows_done = 0;
+ if (lua_isfunction(L, 3)) {
+ result = sqlitelib_state.sqlite3_exec(data->db, query, &sqlitelib_callback, L, NULL);
+ } else {
+ result = sqlitelib_state.sqlite3_exec(data->db, query, NULL, NULL, NULL);
+ }
+ rows_done = 0;
+ lua_pushboolean(L, ! result);
+ return 1;
+ }
+ }
+ }
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int sqlitelib_getmessage(lua_State * L)
+{
+ if (sqlitelib_state.initialized) {
+ sqlitelib_data * data = luaL_checkudata(L, 1, SQLITELIB_METATABLE);
+ if (data != NULL) {
+ lua_pushstring(L, sqlitelib_state.sqlite3_errmsg(data->db));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* private */
+
+static int sqlitelib_free(lua_State * L)
+{
+ return sqlitelib_close(L);
+}
+
+/* <string> = tostring(instance) */
+
+static int sqlitelib_tostring(lua_State * L)
+{
+ if (sqlitelib_state.initialized) {
+ sqlitelib_data * data = luaL_checkudata(L, 1, SQLITELIB_METATABLE);
+ if (data != NULL) {
+ (void) lua_pushfstring(L, "<sqlitelib-instance %p>", data);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static const struct luaL_Reg sqlitelib_metatable[] = {
+ { "__tostring", sqlitelib_tostring },
+ { "__gc", sqlitelib_free },
+ { NULL, NULL },
+};
+
+static struct luaL_Reg sqlitelib_function_list[] = {
+ { "initialize", sqlitelib_initialize },
+ { "open", sqlitelib_open },
+ { "close", sqlitelib_close },
+ { "execute", sqlitelib_execute },
+ { "getmessage", sqlitelib_getmessage },
+ { NULL, NULL },
+};
+
+int luaopen_sqlite(lua_State * L)
+{
+ luaL_newmetatable(L, SQLITELIB_METATABLE);
+ luaL_setfuncs(L, sqlitelib_metatable, 0);
+ lmt_library_register(L, "sqlite", sqlitelib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtzint.c b/source/luametatex/source/luaoptional/lmtzint.c
new file mode 100644
index 000000000..0783238c0
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtzint.c
@@ -0,0 +1,518 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*
+ For a long time the zint api was quite stable but in after 2020 it started changing: the data
+ structures got fields added in the middle So, after a few updates Michal Vlasák suggested that
+ we adapt to versions. We can always decide to drop older ones when we get too many. The next
+ variant is a mix of our attempts to deal with this issue.
+
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+# define ZINT_UNICODE_MODE 1
+# define ZINT_OUT_BUFFER 0
+# define ZINT_DM_SQUARE 100
+
+struct zint_vector;
+
+typedef struct {
+ int symbology;
+ float height;
+ int whitespace_width;
+ int whitespace_height;
+ int border_width;
+ int output_options;
+ char fgcolour[10];
+ char bgcolour[10];
+ char *fgcolor;
+ char *bgcolor;
+ char outfile[256];
+ float scale;
+ int option_1;
+ int option_2;
+ int option_3;
+ int show_hrt;
+ int fontsize;
+ int input_mode;
+ int eci;
+ unsigned char text[128];
+ int rows;
+ int width;
+ char primary[128];
+ unsigned char encoded_data[200][143];
+ float row_height[200];
+ char errtxt[100];
+ unsigned char *bitmap;
+ int bitmap_width;
+ int bitmap_height;
+ unsigned char *alphamap;
+ unsigned int bitmap_byte_length;
+ float dot_size;
+ struct zint_vector *vector;
+ int debug;
+ int warn_level;
+} zint_symbol_210;
+
+struct zint_structapp {
+ int index;
+ int count;
+ char id[32];
+};
+
+typedef struct {
+ int symbology;
+ float height;
+ float scale;
+ int whitespace_width;
+ int whitespace_height;
+ int border_width;
+ int output_options;
+ char fgcolour[10];
+ char bgcolour[10];
+ char *fgcolor;
+ char *bgcolor;
+ char outfile[256];
+ char primary[128];
+ int option_1;
+ int option_2;
+ int option_3;
+ int show_hrt;
+ int fontsize;
+ int input_mode;
+ int eci;
+ float dot_size;
+ float guard_descent;
+ struct zint_structapp structapp;
+ int warn_level;
+ int debug;
+ unsigned char text[128];
+ int rows;
+ int width;
+ unsigned char encoded_data[200][144];
+ float row_height[200];
+ char errtxt[100];
+ unsigned char *bitmap;
+ int bitmap_width;
+ int bitmap_height;
+ unsigned char *alphamap;
+ unsigned int bitmap_byte_length;
+ struct zint_vector *vector;
+} zint_symbol_211;
+
+
+typedef struct zint_rectangle zint_rectangle;
+
+typedef struct {
+ double x;
+ double y;
+ double w;
+ double h;
+ zint_rectangle *next;
+} lmt_zint_rectangle;
+
+static void lmt_zint_get_rect(
+ zint_rectangle *zint_,
+ lmt_zint_rectangle *lmt
+)
+{
+ struct {
+ float x;
+ float y;
+ float height;
+ float width;
+ int colour;
+ zint_rectangle *next;
+ } *zint = (void*) zint_;
+ lmt->x = (double) zint->x;
+ lmt->y = (double) zint->y;
+ lmt->w = (double) zint->width;
+ lmt->h = (double) zint->height;
+ lmt->next = zint->next;
+}
+
+typedef struct zint_circle zint_circle;
+
+typedef struct {
+ double x;
+ double y;
+ double d;
+ zint_circle *next;
+} lmt_zint_circle;
+
+static void lmt_zint_get_circle_210
+(
+ zint_circle *zint_,
+ lmt_zint_circle *lmt
+)
+{
+ struct {
+ float x;
+ float y;
+ float diameter;
+ int colour;
+ zint_circle *next;
+ } *zint = (void*) zint_;
+ lmt->x = (double) zint->x;
+ lmt->y = (double) zint->y;
+ lmt->d = (double) zint->diameter;
+ lmt->next = zint->next;
+}
+
+static void lmt_zint_get_circle_211
+(
+ zint_circle *zint_,
+ lmt_zint_circle *lmt
+)
+{
+ struct {
+ float x;
+ float y;
+ float diameter;
+ float width;
+ int colour;
+ zint_circle *next;
+ } *zint = (void*) zint_;
+ lmt->x = (double) zint->x;
+ lmt->y = (double) zint->y;
+ lmt->d = (double) zint->diameter;
+ lmt->next = zint->next;
+}
+
+typedef struct zint_hexagon zint_hexagon;
+
+typedef struct {
+ double x;
+ double y;
+ double d;
+ zint_hexagon *next;
+} lmt_zint_hexagon;
+
+static void lmt_zint_get_hexagon
+(
+ zint_hexagon *zint_,
+ lmt_zint_hexagon *lmt
+)
+{
+ struct {
+ float x;
+ float y;
+ float diameter;
+ int rotation;
+ zint_hexagon *next;
+ } *zint = (void *) zint_;
+ lmt->x = (double) zint->x;
+ lmt->y = (double) zint->y;
+ lmt->d = (double) zint->diameter;
+ lmt->next = zint->next;
+}
+
+typedef struct zint_string zint_string;
+
+typedef struct {
+ double x;
+ double y;
+ double s;
+ const char *t;
+ zint_string *next;
+} lmt_zint_string;
+
+static void lmt_zint_next_string(zint_string *zint_, lmt_zint_string *lmt)
+{
+ struct {
+ float x;
+ float y;
+ float fsize;
+ float width;
+ int length;
+ int rotation;
+ int halign;
+ unsigned char *text;
+ zint_string *next;
+ } *zint = (void *) zint_;
+ lmt->x = (double) zint->x;
+ lmt->y = (double) zint->y;
+ lmt->s = (double) zint->fsize;
+ lmt->t = (const char *) zint->text;
+ lmt->next = zint->next;
+}
+
+typedef struct zint_symbol zint_symbol;
+
+typedef struct zint_vector {
+ float width;
+ float height;
+ zint_rectangle *rectangles;
+ zint_hexagon *hexagons;
+ zint_string *strings;
+ zint_circle *circles;
+} zint_vector;
+
+static zint_vector *lmt_zint_vector_210(zint_symbol *symbol_)
+{
+ zint_symbol_210 *symbol = (void*) symbol_;
+ return symbol->vector;
+}
+
+static zint_vector *lmt_zint_vector_211(zint_symbol *symbol_)
+{
+ zint_symbol_211 *symbol = (void*) symbol_;
+ return symbol->vector;
+}
+
+static void lmt_zint_symbol_set_options_210(zint_symbol *symbol_, int symbology, int input_mode, int output_options, int square)
+{
+ zint_symbol_210 *symbol = (void*) symbol_;
+ symbol->symbology = symbology;
+ symbol->input_mode = input_mode;
+ symbol->output_options = output_options;
+ if (square)
+ symbol->option_3 = ZINT_DM_SQUARE;
+}
+
+static void lmt_zint_symbol_set_options_211(zint_symbol *symbol_, int symbology, int input_mode, int output_options, int square)
+{
+ zint_symbol_211 *symbol = (void*) symbol_;
+ symbol->symbology = symbology;
+ symbol->input_mode = input_mode;
+ symbol->output_options = output_options;
+ if (square) {
+ symbol->option_3 = ZINT_DM_SQUARE;
+ }
+}
+
+typedef struct zintlib_state_info {
+
+ int initialized;
+ int version;
+
+ int (*ZBarcode_Version) (
+ void
+ );
+
+ zint_symbol * (*ZBarcode_Create) (
+ void
+ );
+
+ void (*ZBarcode_Delete) (
+ zint_symbol *symbol
+ );
+
+ int (*ZBarcode_Encode_and_Buffer_Vector) (
+ zint_symbol *symbol,
+ const unsigned char *input,
+ int length,
+ int rotate_angle
+ );
+
+} zintlib_state_info;
+
+static zintlib_state_info zintlib_state = {
+
+ .initialized = 0,
+ .version = 0,
+
+ .ZBarcode_Version = NULL,
+ .ZBarcode_Create = NULL,
+ .ZBarcode_Delete = NULL,
+ .ZBarcode_Encode_and_Buffer_Vector = NULL,
+
+};
+
+static void (*lmt_zint_get_circle) (
+ zint_circle *zint_,
+ lmt_zint_circle *lmt
+);
+
+static zint_vector *(*lmt_zint_vector)(
+ zint_symbol *symbol_
+);
+static void (*lmt_zint_symbol_set_options)(
+ zint_symbol *symbol,
+ int symbology,
+ int input_mode,
+ int output_options,
+ int square
+);
+
+static int zintlib_initialize(lua_State * L)
+{
+ if (! zintlib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ zintlib_state.ZBarcode_Version = lmt_library_find(lib, "ZBarcode_Version");
+ zintlib_state.ZBarcode_Create = lmt_library_find(lib, "ZBarcode_Create");
+ zintlib_state.ZBarcode_Delete = lmt_library_find(lib, "ZBarcode_Delete");
+ zintlib_state.ZBarcode_Encode_and_Buffer_Vector = lmt_library_find(lib, "ZBarcode_Encode_and_Buffer_Vector");
+
+ zintlib_state.initialized = lmt_library_okay(lib);
+
+ if (zintlib_state.ZBarcode_Version) {
+ zintlib_state.version = zintlib_state.ZBarcode_Version();
+ }
+ zintlib_state.version = zintlib_state.version / 100;
+ if (zintlib_state.version < 210) {
+ zintlib_state.initialized = 0;
+ } else if (zintlib_state.version < 211) {
+ lmt_zint_get_circle = lmt_zint_get_circle_210;
+ lmt_zint_vector = lmt_zint_vector_210;
+ lmt_zint_symbol_set_options = lmt_zint_symbol_set_options_210;
+ } else {
+ lmt_zint_get_circle = lmt_zint_get_circle_211;
+ lmt_zint_vector = lmt_zint_vector_211;
+ lmt_zint_symbol_set_options = lmt_zint_symbol_set_options_211;
+ }
+ }
+ }
+ lua_pushboolean(L, zintlib_state.initialized);
+ return 1;
+}
+
+static int zintlib_execute(lua_State * L)
+{
+ if (zintlib_state.initialized) {
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ int code = -1;
+ size_t l = 0;
+ const unsigned char *s = NULL;
+ const char *o = NULL;
+ if (lua_getfield(L, 1, "code") == LUA_TNUMBER) {
+ code = lmt_tointeger(L, -1);
+ }
+ lua_pop(L, 1);
+ switch (lua_getfield(L, 1, "text")) {
+ case LUA_TSTRING:
+ case LUA_TNUMBER:
+ s = (const unsigned char *) lua_tolstring(L, -1, &l);
+ break;
+ }
+ lua_pop(L, 1);
+ if (lua_getfield(L, 1, "option") == LUA_TSTRING) {
+ /* for the moment one option */
+ o = lua_tostring(L, -1);
+ }
+ lua_pop(L, 1);
+ if (code >= 0 && l > 0) {
+ zint_symbol *symbol = zintlib_state.ZBarcode_Create();
+ if (symbol) {
+ /*tex
+ We could handle this at the \LUA\ end but as we only have a few options we
+ do it here.
+ */
+ int square = (o && (strcmp(o, "square") == 0)) ? 1 : 0;
+ lmt_zint_symbol_set_options(symbol, code, ZINT_UNICODE_MODE, ZINT_OUT_BUFFER, square);
+ if (zintlib_state.ZBarcode_Encode_and_Buffer_Vector(symbol, s, (int) l, 0)) {
+ zintlib_state.ZBarcode_Delete(symbol);
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "invalid result");
+ } else {
+ zint_vector *vector = lmt_zint_vector(symbol);
+ if (vector) {
+ /*tex
+ It's a bit like the svg output ... first I used named fields but a
+ list is more efficient, not so much in the \LUA\ interfacing but in
+ generating an compact path at the \METAPOST\ end.
+ */
+ lua_createtable(L, 0, 4);
+ if (vector->rectangles) {
+ lmt_zint_rectangle rectangle;
+ int i = 1;
+ lua_newtable(L);
+ for (zint_rectangle *r = vector->rectangles; r; r = rectangle.next) {
+ lmt_zint_get_rect(r, &rectangle);
+ lua_createtable(L, 4, 0);
+ lua_pushinteger(L, lmt_roundedfloat(rectangle.x)); lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, lmt_roundedfloat(rectangle.y)); lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, lmt_roundedfloat(rectangle.w)); lua_rawseti(L, -2, 3);
+ lua_pushinteger(L, lmt_roundedfloat(rectangle.h)); lua_rawseti(L, -2, 4);
+ lua_rawseti(L, -2, i++);
+ }
+ lua_setfield(L, -2, "rectangles");
+ }
+ if (vector->hexagons) {
+ lmt_zint_hexagon hexagon;
+ int i = 1;
+ lua_newtable(L);
+ for (zint_hexagon *h = vector->hexagons; h; h = hexagon.next) {
+ lmt_zint_get_hexagon(h, &hexagon);
+ lua_createtable(L, 0, 3);
+ lua_pushinteger(L, lmt_roundedfloat(hexagon.x)); lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, lmt_roundedfloat(hexagon.y)); lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, lmt_roundedfloat(hexagon.d)); lua_rawseti(L, -2, 3);
+ lua_rawseti(L, -2, i++);
+ }
+ lua_setfield(L, -2, "hexagons");
+ }
+ if (vector->circles) {
+ lmt_zint_circle circle;
+ int i = 1;
+ lua_newtable(L);
+ for (zint_circle *c = vector->circles; c; c = circle.next) {
+ lmt_zint_get_circle(c, &circle);
+ lua_createtable(L, 0, 3);
+ lua_pushinteger(L, lmt_roundedfloat(circle.x)); lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, lmt_roundedfloat(circle.y)); lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, lmt_roundedfloat(circle.d)); lua_rawseti(L, -2, 3);
+ lua_rawseti(L, -2, i++);
+ }
+ lua_setfield(L, -2, "circles");
+ }
+ if (vector->strings) {
+ lmt_zint_string string;
+ int i = 1;
+ lua_newtable(L);
+ for (zint_string *s = vector->strings; s; s = string.next) {
+ lmt_zint_next_string(s, &string);
+ lua_createtable(L, 0, 4);
+ lua_pushinteger(L, lmt_roundedfloat(string.x)); lua_rawseti(L, -2, 1);
+ lua_pushinteger(L, lmt_roundedfloat(string.y)); lua_rawseti(L, -2, 2);
+ lua_pushinteger(L, lmt_roundedfloat(string.s)); lua_rawseti(L, -2, 3);
+ lua_pushstring (L, string.t ); lua_rawseti(L, -2, 4);
+ lua_rawseti(L, -2, i++);
+ }
+ lua_setfield(L, -2, "strings");
+ }
+ zintlib_state.ZBarcode_Delete(symbol);
+ return 1;
+ } else {
+ zintlib_state.ZBarcode_Delete(symbol);
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "invalid result vector");
+ }
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "invalid result symbol");
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "invalid code");
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "invalid specification");
+ }
+ } else {
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "not initialized");
+ }
+ return 2;
+}
+
+static struct luaL_Reg zintlib_function_list[] = {
+ { "initialize", zintlib_initialize },
+ { "execute", zintlib_execute },
+ { NULL, NULL },
+};
+
+int luaopen_zint(lua_State * L)
+{
+ lmt_library_register(L, "zint", zintlib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/lmtzstd.c b/source/luametatex/source/luaoptional/lmtzstd.c
new file mode 100644
index 000000000..ebb188d54
--- /dev/null
+++ b/source/luametatex/source/luaoptional/lmtzstd.c
@@ -0,0 +1,118 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+# include "lmtoptional.h"
+
+# define ZSTD_DEFAULTCLEVEL 3
+
+typedef struct zstdlib_state_info {
+
+ int initialized;
+ int padding;
+
+ size_t (*ZSTD_compressBound) (size_t srcSize);
+ size_t (*ZSTD_getFrameContentSize) (const void *, size_t);
+ size_t (*ZSTD_compress) (void *dst, size_t dstCapacity, const void *src, size_t srcSize, int compressionLevel);
+ size_t (*ZSTD_decompress) (void *dst, size_t dstCapacity, const void *src, size_t compressedSize);
+ /* int (*ZSTD_minCLevel) (void); */
+ /* int (*ZSTD_maxCLevel) (void); */
+ /* unsigned (*ZSTD_isError) (size_t code); */
+ /* const char *(*ZSTD_getErrorName) (size_t code); */
+
+} zstdlib_state_info;
+
+static zstdlib_state_info zstdlib_state = {
+
+ .initialized = 0,
+ .padding = 0,
+
+ .ZSTD_compressBound = NULL,
+ .ZSTD_getFrameContentSize = NULL,
+ .ZSTD_compress = NULL,
+ .ZSTD_decompress = NULL,
+ /* .ZSTD_minCLevel = NULL, */
+ /* .ZSTD_maxCLevel = NULL, */
+ /* .ZSTD_isError = NULL, */
+ /* .ZSTD_getErrorName = NULL, */
+
+};
+
+static int zstdlib_compress(lua_State *L)
+{
+ if (zstdlib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ int level = lmt_optinteger(L, 2, ZSTD_DEFAULTCLEVEL);
+ size_t targetsize = zstdlib_state.ZSTD_compressBound(sourcesize);
+ luaL_Buffer buffer;
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ size_t result = zstdlib_state.ZSTD_compress(target, targetsize, source, sourcesize, level);
+ if (result > 0) {
+ luaL_pushresultsize(&buffer, result);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int zstdlib_decompress(lua_State *L)
+{
+ if (zstdlib_state.initialized) {
+ size_t sourcesize = 0;
+ const char *source = luaL_checklstring(L, 1, &sourcesize);
+ size_t targetsize = zstdlib_state.ZSTD_getFrameContentSize(source, sourcesize);
+ luaL_Buffer buffer;
+ char *target = luaL_buffinitsize(L, &buffer, targetsize);
+ size_t result = zstdlib_state.ZSTD_decompress(target, targetsize, source, sourcesize);
+ if (result > 0) {
+ luaL_pushresultsize(&buffer, result);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int zstdlib_initialize(lua_State *L)
+{
+ if (! zstdlib_state.initialized) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename) {
+
+ lmt_library lib = lmt_library_load(filename);
+
+ zstdlib_state.ZSTD_compressBound = lmt_library_find(lib, "ZSTD_compressBound");
+ zstdlib_state.ZSTD_getFrameContentSize = lmt_library_find(lib, "ZSTD_getFrameContentSize");
+ zstdlib_state.ZSTD_compress = lmt_library_find(lib, "ZSTD_compress");
+ zstdlib_state.ZSTD_decompress = lmt_library_find(lib, "ZSTD_decompress");
+ /* zstdlib_state.ZSTD_minCLevel = lmt_library_find(lib, "ZSTD_minCLevel"); */
+ /* zstdlib_state.ZSTD_maxCLevel = lmt_library_find(lib, "ZSTD_maxCLevel"); */
+ /* zstdlib_state.ZSTD_isError = lmt_library_find(lib, "ZSTD_isError"); */
+ /* zstdlib_state.ZSTD_getErrorName = lmt_library_find(lib, "ZSTD_getErrorName"); */
+
+ zstdlib_state.initialized = lmt_library_okay(lib);
+ }
+ }
+ lua_pushboolean(L, zstdlib_state.initialized);
+ return 1;
+}
+
+static struct luaL_Reg zstdlib_function_list[] = {
+ { "initialize", zstdlib_initialize },
+ { "compress", zstdlib_compress },
+ { "decompress", zstdlib_decompress },
+ { NULL, NULL },
+};
+
+int luaopen_zstd(lua_State * L)
+{
+ lmt_library_register(L, "zstd", zstdlib_function_list);
+ return 0;
+}
diff --git a/source/luametatex/source/luaoptional/readme.txt b/source/luametatex/source/luaoptional/readme.txt
new file mode 100644
index 000000000..31b489da9
--- /dev/null
+++ b/source/luametatex/source/luaoptional/readme.txt
@@ -0,0 +1,30 @@
+Nota bene,
+
+This is the directory where optional module support ends up. Optional modules have an interface but
+are not (nor will be) part of the binary. We might ship some at the context garden (like zint and
+mujs) but the large one (read: with many dependencies or written in c++) have to come from the
+operating system because if you use a library that is what you want: the external black box thing.
+No sources end up in the distribution either, athough we will archive some.
+
+There will be no user modules here, just those interfaces that we provide and maintain as part of
+standard ConTeXt LMTX. What users add themselves is up to them, including (long time !) support. So,
+this is the canonnical version of optional.
+
+We might at some point add some safeguards so that we can be sure that ConTeXt is run with the
+right binary because we want to prevent side effects (of any kind) resulting from a binary being
+used with the same name and different features ... just because one of the objective is to have
+a long term stable binary / macro package combination. Of course, what users do on their machines
+is up to them.
+
+It might take a while before the interfaces and way we do this is stable. Also, keep in mind that
+regular users never deal with these matters directly and only use the interfaces at the TeX and
+Lua end.
+
+PS. The socket library (and maybe cerf) are also candidates for optional although cerf needs to be
+compiled for windows which is not supported out of the box and sockets are way to large. We only
+do optional libs that add little to the binary, a few KB at most! I'll definitely try to stick to
+this principle!
+
+PS. Todo: move function pointers into state structures.
+
+Hans
diff --git a/source/luametatex/source/luarest/lmtaeslib.c b/source/luametatex/source/luarest/lmtaeslib.c
new file mode 100644
index 000000000..5dbd3556a
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtaeslib.c
@@ -0,0 +1,115 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+# include <utilcrypt.h>
+
+// AES_HAS_IV AES_INLINE_IV AES_CONTINUE AES_NULL_PADDING
+
+static const uint8_t nulliv[16] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
+
+typedef size_t aes_coder (
+ const void *input,
+ size_t length,
+ void *output,
+ const void *key,
+ size_t keylength,
+ const void *iv,
+ int flags
+);
+
+/* data key [block] [inline] [padding] */ /* key : 16 24 32 */
+
+/* random_bytes is taken from pplib */
+
+static int aeslib_aux_code(lua_State *L, aes_coder code) {
+ size_t inputlength = 0;
+ const char *input = lua_tolstring(L, 1, &inputlength);
+ if (inputlength) {
+ size_t keylength = 0;
+ const char *key = lua_tolstring(L, 2, &keylength);
+ if (keylength == 16 || keylength == 24 || keylength == 32) {
+ luaL_Buffer buffer;
+ /* always */
+ int flags = 0;
+ /* the same length as input plus optional 16 from iv */
+ char *output = NULL;
+ size_t outputlength = 0;
+ /* this is optional, iv get copied in aes */
+ const uint8_t *iv = NULL;
+ switch (lua_type(L, 3)) {
+ case LUA_TSTRING:
+ {
+ size_t ivlength = 0;
+ iv = (const uint8_t *) lua_tolstring(L, 3, &ivlength);
+ if (ivlength != 16) {
+ iv = nulliv;
+ }
+ break;
+ }
+ case LUA_TBOOLEAN:
+ if (lua_toboolean(L, 3)) {
+ uint8_t randiv[16];
+ random_bytes(randiv, 16);
+ iv = (const uint8_t *) randiv;
+ break;
+ }
+ // fall through
+ default:
+ iv = nulliv;
+ }
+ if (lua_toboolean(L, 4)) {
+ flags |= AES_INLINE_IV;
+ }
+ if (! lua_toboolean(L, 5)) {
+ flags |= AES_NULL_PADDING;
+ }
+ /* always multiples of 16 and we might have the iv too */
+ output = luaL_buffinitsize(L, &buffer, inputlength + 32);
+ outputlength = code(input, inputlength, output, key, keylength, iv, flags);
+ if (outputlength) {
+ luaL_pushresultsize(&buffer, outputlength);
+ return 1;
+ }
+ } else {
+ luaL_error(L, "aeslib: key of length 16, 24 or 32 expected");
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int aeslib_encode(lua_State *L) {
+ return aeslib_aux_code(L, &aes_encode_data);
+}
+
+static int aeslib_decode(lua_State *L) {
+ return aeslib_aux_code(L, &aes_decode_data);
+}
+
+static int aeslib_random(lua_State *L) {
+ uint8_t iv[32];
+ int n = (int) luaL_optinteger(L, 1, 16);
+ if (n > 32) {
+ n = 32;
+ }
+ random_bytes(iv, n);
+ lua_pushlstring(L, (const char *) iv, n);
+ return 1;
+}
+
+static struct luaL_Reg aeslib_function_list[] = {
+ /*tex We started out with this: */
+ { "encode", aeslib_encode },
+ { "decode", aeslib_decode },
+ { "random", aeslib_random },
+ { NULL, NULL },
+};
+
+int luaopen_aes(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, aeslib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtbasexxlib.c b/source/luametatex/source/luarest/lmtbasexxlib.c
new file mode 100644
index 000000000..fca7fcef8
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtbasexxlib.c
@@ -0,0 +1,193 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/* # define BASEXX_PDF 1 */
+
+# include <utiliof.h>
+# include <utilbasexx.h>
+# include <utillzw.h>
+
+/*tex
+
+ First I had a mix of own code and LHF code (base64 and base85) but in the end I decided to reuse
+ some of pplibs code. Performance is ok, although we can speed up the base16 coders. When needed,
+ we can have a few more bur normally pure \LUA\ is quite ok for our purpose.
+
+*/
+
+# define encode_nl(L) \
+ (lua_type(L, 2) == LUA_TNUMBER) ? (lmt_tointeger(L, 2)) : ( (lua_isboolean(L, 2)) ? 80 : 0 )
+
+# define lua_iof_push(L,out) \
+ lua_pushlstring(L,(const char *) out->buf, iof_size(out))
+
+static int basexxlib_encode_16(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = 2 * l;
+ size_t nl = encode_nl(L);
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ if (nl) {
+ base16_encode_ln(inp, out, 0, nl);
+ } else {
+ base16_encode(inp, out);
+ }
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_decode_16(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = l / 2;
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ base16_decode(inp, out);
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_encode_64(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L,1,&l);
+ size_t n = 4 * l;
+ size_t nl = encode_nl(L);
+ iof *inp = iof_filter_string_reader(s,l);
+ iof *out = iof_filter_buffer_writer(n);
+ if (nl) {
+ base64_encode_ln(inp,out,0,nl);
+ } else {
+ base64_encode(inp,out);
+ }
+ lua_iof_push(L,out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_decode_64(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = l;
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ base64_decode(inp, out);
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_encode_85(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = 5 * l;
+ size_t nl = encode_nl(L);
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ if (nl) {
+ base85_encode_ln(inp, out, 0, 80);
+ } else {
+ base85_encode(inp, out);
+ }
+ lua_iof_push(L,out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_decode_85(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = l;
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ base85_decode(inp, out);
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_encode_RL(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = 2 * l;
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ runlength_encode(inp, out);
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_decode_RL(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = 2 * l;
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ runlength_decode(inp, out);
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static int basexxlib_encode_LZW(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = 2 * l;
+ char *t = lmt_memory_malloc(n);
+ int flags = lmt_optinteger(L, 2, LZW_ENCODER_DEFAULTS);
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_string_writer(t, n);
+ lzw_encode(inp, out, flags);
+ lua_pushlstring(L, t, iof_size(out));
+ lmt_memory_free(t);
+ return 1;
+}
+
+static int basexxlib_decode_LZW(lua_State *L)
+{
+ size_t l;
+ const unsigned char *s = (const unsigned char*) luaL_checklstring(L, 1, &l);
+ size_t n = 2 * l;
+ iof *inp = iof_filter_string_reader(s, l);
+ iof *out = iof_filter_buffer_writer(n);
+ int flags = lmt_optinteger(L, 2, LZW_DECODER_DEFAULTS);
+ lzw_decode(inp, out, flags);
+ lua_iof_push(L, out);
+ iof_close(out);
+ return 1;
+}
+
+static struct luaL_Reg basexxlib_function_list[] = {
+ { "encode16", basexxlib_encode_16 },
+ { "decode16", basexxlib_decode_16 },
+ { "encode64", basexxlib_encode_64 },
+ { "decode64", basexxlib_decode_64 },
+ { "encode85", basexxlib_encode_85 },
+ { "decode85", basexxlib_decode_85 },
+ { "encodeRL", basexxlib_encode_RL },
+ { "decodeRL", basexxlib_decode_RL },
+ { "encodeLZW", basexxlib_encode_LZW },
+ { "decodeLZW", basexxlib_decode_LZW },
+ { NULL, NULL },
+};
+
+int luaopen_basexx(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, basexxlib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtdecodelib.c b/source/luametatex/source/luarest/lmtdecodelib.c
new file mode 100644
index 000000000..064ac1182
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtdecodelib.c
@@ -0,0 +1,600 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Some png helpers, I could have introduced a userdata for blobs at some point but it's not that
+ useful as string sare also sequences of bytes and lua handles those well. These are interfaces
+ can change any time we like without notice till we like what we have.
+
+*/
+
+/* t xsize ysize bpp (includes mask) */
+
+static int pnglib_applyfilter(lua_State *L)
+{
+ size_t size;
+ const char *s = luaL_checklstring(L, 1, &size);
+ int xsize = lmt_tointeger(L, 2);
+ int ysize = lmt_tointeger(L, 3);
+ int slice = lmt_tointeger(L, 4);
+ int len = xsize * slice + 1; /* filter byte */
+ int n = 0;
+ int m = len - 1;
+ unsigned char *t;
+ if (ysize * len != (int) size) {
+ tex_formatted_warning("png filter", "sizes don't match: %i expected, %i provided", ysize *len, size);
+ return 0;
+ }
+ t = lmt_memory_malloc(size);
+ if (! t) {
+ tex_normal_warning("png filter", "not enough memory");
+ return 0;
+ }
+ memcpy(t, s, size);
+ for (int i = 0; i < ysize; i++) {
+ switch (t[n]) {
+ case 0 :
+ break;
+ case 1 :
+ for (int j = n + slice + 1; j <= n + m; j++) {
+ t[j] = (unsigned char) (t[j] + t[j-slice]);
+ }
+ break;
+ case 2 :
+ if (i > 0) {
+ for (int j = n + 1; j <= n + m; j++) {
+ t[j] = (unsigned char) (t[j] + t[j-len]);
+ }
+ }
+ break;
+ case 3 :
+ if (i > 0) {
+ for (int j = n + 1; j <= n + slice; j++) {
+ t[j] = (unsigned char) (t[j] + t[j-len]/2);
+ }
+ for (int j = n + slice + 1; j <= n + m; j++) {
+ t[j] = (unsigned char) (t[j] + (t[j-slice] + t[j-len])/2);
+ }
+ } else {
+ for (int j = n + slice + 1; j <= n + m; j++) {
+ t[j] = (unsigned char) (t[j] + t[j-slice]/2);
+ }
+ }
+ break;
+ case 4 :
+ if (i > 0) {
+ for (int j = n + 1; j <= n + slice; j++) {
+ int p = j - len;
+ t[j] = (unsigned char) (t[j] + t[p]);
+ }
+ for (int j = n + slice + 1; j <= n + m; j++) {
+ int p = j - len;
+ unsigned char a = t[j-slice];
+ unsigned char b = t[p];
+ unsigned char c = t[p-slice];
+ int pa = b - c;
+ int pb = a - c;
+ int pc = pa + pb;
+ if (pa < 0) { pa = - pa; }
+ if (pb < 0) { pb = - pb; }
+ if (pc < 0) { pc = - pc; }
+ t[j] = (unsigned char) (t[j] + ((pa <= pb && pa <= pc) ? a : ((pb <= pc) ? b : c)));
+ }
+ } else {
+ /* What to do here? */
+ /*
+ for (int j = n + slice + 1; j <= n + m; j++) {
+ int p = j - len;
+ unsigned char a = t[j-slice];
+ unsigned char b = t[p];
+ unsigned char c = t[p-slice];
+ int pa = b - c;
+ int pb = a - c;
+ int pc = pa + pb;
+ if (pa < 0) { pa = - pa; }
+ if (pb < 0) { pb = - pb; }
+ if (pc < 0) { pc = - pc; }
+ t[j] = (unsigned char) (t[j] + ((pa <= pb && pa <= pc) ? a : ((pb <= pc) ? b : c)));
+ }
+ */
+ }
+ break;
+ default:
+ break;
+ }
+ n = n + len;
+ }
+ /* wipe out filter byte */
+ {
+ int j = 0; /* source */
+ int m = 0; /* target */
+ for (int i = 0; i < ysize; i++) {
+ // (void) memcpy(&t[m], &t[j+1], len-1); /* target source size */
+ (void) memmove(&t[m], &t[j+1], (size_t)len - 1); /* target source size */
+ j += len;
+ m += len - 1;
+ }
+ lua_pushlstring(L, (char *) t, size-ysize);
+ /*
+ int j = 0;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ for (int i = 0; i < ysize; i++) {
+ luaL_addlstring(&b, (const char *)&t[j+1], len-1);
+ j += len;
+ }
+ luaL_pushresult(&b);
+ */
+ }
+ lmt_memory_free(t);
+ return 1;
+}
+
+/* t xsize ysize bpp (includes mask) bytes */
+
+static int pnglib_splitmask(lua_State *L)
+{
+ size_t size;
+ const char *t = luaL_checklstring(L, 1, &size);
+ int xsize = lmt_tointeger(L, 2);
+ int ysize = lmt_tointeger(L, 3);
+ int bpp = lmt_tointeger(L, 4); /* 1 or 3 */
+ int bytes = lmt_tointeger(L, 5); /* 1 or 2 */
+ int slice = (bpp + 1) * bytes;
+ int len = xsize * slice;
+ int blen = bpp * bytes;
+ int mlen = bytes;
+ int nt = 0;
+ int nb = 0;
+ int nm = 0;
+ int bsize = ysize * xsize * blen;
+ int msize = ysize * xsize * mlen;
+ char *b, *m;
+ /* we assume that the filter byte is gone */
+ if (ysize * len != (int) size) {
+ tex_formatted_warning("png split", "sizes don't match: %i expected, %i provided", ysize * len, size);
+ return 0;
+ }
+ b = lmt_memory_malloc(bsize);
+ m = lmt_memory_malloc(msize);
+ if (! (b && m)) {
+ tex_normal_warning("png split mask", "not enough memory");
+ return 0;
+ }
+ /* a bit optimized */
+ switch (blen) {
+ case 1:
+ /* 8 bit gray or indexed graphics */
+ for (int i = 0; i < ysize * xsize; i++) {
+ b[nb++] = t[nt++];
+ m[nm++] = t[nt++];
+ }
+ break;
+ case 3:
+ /* 8 bit rgb graphics */
+ for (int i = 0; i < ysize * xsize; i++) {
+ /*
+ b[nb++] = t[nt++];
+ b[nb++] = t[nt++];
+ b[nb++] = t[nt++];
+ */
+ memcpy(&b[nb], &t[nt], 3);
+ nt += 3;
+ nb += 3;
+ m[nm++] = t[nt++];
+ }
+ break;
+ default:
+ /* everything else */
+ for (int i = 0; i < ysize * xsize; i++) {
+ memcpy (&b[nb], &t[nt], blen);
+ nt += blen;
+ nb += blen;
+ memcpy (&m[nm], &t[nt], mlen);
+ nt += mlen;
+ nm += mlen;
+ }
+ break;
+ }
+ lua_pushlstring(L, b, bsize);
+ lmt_memory_free(b);
+ lua_pushlstring(L, m, msize);
+ lmt_memory_free(m);
+ return 2;
+}
+
+/* output input xsize ysize slice pass filter */
+
+static int pnglib_interlace(lua_State *L)
+{
+ int xstarts[] = { 0, 4, 0, 2, 0, 1, 0 };
+ int ystarts[] = { 0, 0, 4, 0, 2, 0, 1 };
+ int xsteps[] = { 8, 8, 4, 4, 2, 2, 1 };
+ int ysteps[] = { 8, 8, 8, 4, 4, 2, 2 };
+ size_t isize = 0;
+ size_t psize = 0;
+ const char *inp;
+ const char *pre;
+ char *out;
+ int xsize, ysize, xstep, ystep, xstart, ystart, slice, pass, nx, ny;
+ int target, start, step, size;
+ /* dimensions */
+ xsize = lmt_tointeger(L, 1);
+ ysize = lmt_tointeger(L, 2);
+ slice = lmt_tointeger(L, 3);
+ pass = lmt_tointeger(L, 4);
+ if (pass < 1 || pass > 7) {
+ tex_formatted_warning("png interlace", "bass pass: %i (1..7)", pass);
+ return 0;
+ }
+ pass = pass - 1;
+ /* */
+ nx = (xsize + xsteps[pass] - xstarts[pass] - 1) / xsteps[pass];
+ ny = (ysize + ysteps[pass] - ystarts[pass] - 1) / ysteps[pass];
+ /* */
+ xstart = xstarts[pass];
+ xstep = xsteps[pass];
+ ystart = ystarts[pass];
+ ystep = ysteps[pass];
+ /* */
+ xstep = xstep * slice;
+ xstart = xstart * slice;
+ xsize = xsize * slice;
+ target = ystart * xsize + xstart;
+ ystep = ystep * xsize;
+ /* */
+ step = nx * xstep;
+ size = ysize * xsize;
+ start = 0;
+ /* */
+ inp = luaL_checklstring(L, 5, &isize);
+ pre = NULL;
+ out = NULL;
+ if (pass > 0) {
+ pre = luaL_checklstring(L, 6, &psize);
+ if ((int) psize < size) {
+ tex_formatted_warning("png interlace", "output sizes don't match: %i expected, %i provided", psize, size);
+ return 0;
+ }
+ }
+ /* todo: some more checking */
+ out = lmt_memory_malloc(size);
+ if (out) {
+ if (pass == 0) {
+ memset(out, 0, size);
+ }
+ else {
+ memcpy(out, pre, psize);
+ }
+ } else {
+ tex_normal_warning("png interlace", "not enough memory");
+ return 0;
+ }
+ switch (slice) {
+ case 1:
+ for (int j = 0; j < ny; j++) {
+ int t = target + j * ystep;
+ for (int i = t; i < t + step; i += xstep) {
+ out[i] = inp[start];
+ start = start + slice;
+ }
+ }
+ break;
+ case 2:
+ for (int j = 0; j < ny; j++) {
+ int t = target + j * ystep;
+ for (int i = t; i < t + step; i += xstep) {
+ out[i] = inp[start];
+ out[i+1] = inp[start+1];
+ start = start + slice;
+ }
+ }
+ break;
+ case 3:
+ for (int j = 0; j < ny; j++) {
+ int t = target + j * ystep;
+ for (int i = t; i < t + step;i += xstep) {
+ out[i] = inp[start];
+ out[i+1] = inp[start+1];
+ out[i+2] = inp[start+2];
+ start = start + slice;
+ }
+ }
+ break;
+ default:
+ for (int j = 0; j < ny; j++) {
+ int t = target + j * ystep;
+ for (int i = t; i < t + step; i += xstep) {
+ memcpy(&out[i], &inp[start], slice);
+ start = start + slice;
+ }
+ }
+ break;
+ }
+ lua_pushlstring(L, out, size);
+ lmt_memory_free(out);
+ return 1;
+}
+
+/* content xsize ysize parts run factor */
+
+# define extract1(a,b) ((a >> b) & 0x01)
+# define extract2(a,b) ((a >> b) & 0x03)
+# define extract4(a,b) ((a >> b) & 0x0F)
+
+static int pnglib_expand(lua_State *L)
+{
+ size_t tsize;
+ const char *t = luaL_checklstring(L, 1, &tsize);
+ char *o = NULL;
+ int n = 0;
+ int k = 0;
+ int xsize = lmt_tointeger(L, 2);
+ int ysize = lmt_tointeger(L, 3);
+ int parts = lmt_tointeger(L, 4);
+ int xline = lmt_tointeger(L, 5);
+ int factor = lua_toboolean(L, 6);
+ int size = ysize * xsize;
+ int extra = ysize * xsize + 16; /* probably a few bytes is enough */
+ if (xline*ysize > (int) tsize) {
+ tex_formatted_warning("png expand","expand sizes don't match: %i expected, %i provided",size,parts*tsize);
+ return 0;
+ }
+ o = lmt_memory_malloc(extra);
+ if (! o) {
+ tex_normal_warning ("png expand", "not enough memory");
+ return 0;
+ }
+ /* we could use on branch and factor variables ,, saves code, costs cycles */
+ if (factor) {
+ switch (parts) {
+ case 4:
+ for (int i = 0; i < ysize; i++) {
+ k = i * xsize;
+ for (int j = n; j < n + xline; j++) {
+ unsigned char v = t[j];
+ o[k++] = (unsigned char) extract4 (v, 4) * 0x11;
+ o[k++] = (unsigned char) extract4 (v, 0) * 0x11;
+ }
+ n = n + xline;
+ }
+ break;
+ case 2:
+ for (int i = 0; i < ysize; i++) {
+ k = i * xsize;
+ for (int j = n; j < n + xline; j++) {
+ unsigned char v = t[j];
+ for (int b = 6; b >= 0; b -= 2) {
+ o[k++] = (unsigned char) extract2 (v, b) * 0x55;
+ }
+ }
+ n = n + xline;
+ }
+ break;
+ default:
+ for (int i = 0; i < ysize; i++) {
+ k = i * xsize;
+ for (int j = n; j < n + xline; j++) {
+ unsigned char v = t[j];
+ for (int b = 7; b >= 0; b--) {
+ o[k++] = (unsigned char) extract1 (v, b) * 0xFF;
+ }
+ }
+ n = n + xline;
+ }
+ break;
+ }
+ } else {
+ switch (parts) {
+ case 4:
+ for (int i = 0; i < ysize; i++) {
+ k = i * xsize;
+ for (int j = n; j < n + xline; j++) {
+ unsigned char v = t[j];
+ o[k++] = (unsigned char) extract4 (v, 4);
+ o[k++] = (unsigned char) extract4 (v, 0);
+ }
+ n = n + xline;
+ }
+ break;
+ case 2:
+ for (int i = 0; i < ysize; i++) {
+ k = i * xsize;
+ for (int j = n; j < n + xline; j++) {
+ unsigned char v = t[j];
+ for (int b = 6; b >= 0; b -= 2) {
+ o[k++] = (unsigned char) extract2 (v, b);
+ }
+ }
+ n = n + xline;
+ }
+ break;
+ default:
+ for (int i = 0; i < ysize; i++) {
+ k = i * xsize;
+ for (int j = n; j < n + xline; j++) {
+ unsigned char v = t[j];
+ for (int b = 7; b >= 0; b--) {
+ o[k++] = (unsigned char) extract1 (v, b);
+ }
+ }
+ n = n + xline;
+ }
+ break;
+ }
+ }
+ lua_pushlstring(L, o, size);
+ lmt_memory_free(o);
+ return 1;
+}
+
+/*tex
+ This is just a quick and dirty experiment. We need to satisfy pdf standards
+ and simple graphics can be converted this way. Maybe add some more control
+ over calculating |k|.
+*/
+
+static int pnglib_tocmyk(lua_State *L)
+{
+ size_t tsize;
+ const char *t = luaL_checklstring(L, 1, &tsize);
+ int depth = lmt_optinteger(L, 2, 0);
+ if ((tsize > 0) && (depth == 8 || depth == 16)) {
+ size_t osize = 0;
+ char *o = NULL;
+ if (depth == 8) {
+ o = lmt_memory_malloc(4 * (tfloor(tsize/3) + 1)); /*tex Plus some slack. */
+ } else {
+ o = lmt_memory_malloc(8 * (tfloor(tsize/6) + 1)); /*tex Plus some slack. */
+ }
+ if (! o) {
+ tex_normal_warning ("png tocmyk", "not enough memory");
+ return 0;
+ } else if (depth == 8) {
+ /*
+ for (size_t i = 0; i < tsize; i += 3) {
+ o[osize++] = (const char) (0xFF - t[i]);
+ o[osize++] = (const char) (0xFF - t[i + 1]);
+ o[osize++] = (const char) (0xFF - t[i + 2]);
+ o[osize++] = '\0';
+ }
+ */
+ for (size_t i = 0; i < tsize; ) {
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = '\0';
+ }
+ } else {
+ /*tex This needs checking! */
+ /*
+ for (size_t i = 0; i < tsize; i += 6) {
+ o[osize++] = (const char) (0xFF - t[i]);
+ o[osize++] = (const char) (0xFF - t[i + 1]);
+ o[osize++] = (const char) (0xFF - t[i + 2]);
+ o[osize++] = (const char) (0xFF - t[i + 3]);
+ o[osize++] = (const char) (0xFF - t[i + 4]);
+ o[osize++] = (const char) (0xFF - t[i + 5]);
+ o[osize++] = '\0';
+ o[osize++] = '\0';
+ }
+ */
+ for (size_t i = 0; i < tsize; ) {
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = (const char) (0xFF - t[i++]);
+ o[osize++] = '\0';
+ o[osize++] = '\0';
+ }
+ }
+ lua_pushlstring(L, o, osize-1);
+ lmt_memory_free(o);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+/*tex Make a mask for a pallete. */
+
+static int pnglib_tomask(lua_State *L) /* for palette */
+{
+ size_t tsize, ssize;
+ const char *t = luaL_checklstring(L, 1, &tsize);
+ const char *s = luaL_checklstring(L, 2, &ssize);
+ size_t xsize = lmt_tosizet(L, 3);
+ size_t ysize = lmt_tosizet(L, 4);
+ int colordepth = lmt_tointeger(L, 5);
+ size_t osize = xsize * ysize;
+ if (osize == tsize) {
+ char *o = lmt_memory_malloc(osize);
+ char *v = lmt_memory_calloc(256,1);
+ size_t len = xsize * colordepth / 8; // ceil
+ size_t k = 0;
+ memset(v, 0xFF, 256);
+ memcpy(v, s, ssize > 256 ? 256 : ssize);
+ for (size_t i = 0; i < ysize; i++) {
+ size_t f = i * len;
+ size_t l = f + len;
+ switch (colordepth) {
+ case 8:
+ for (size_t j = f; j < l; j++) {
+ int c = t[j];
+ o[k++] = (unsigned char) v[c];
+ }
+ break;
+ case 4:
+ for (size_t j = f; j < l; j++) {
+ int c = t[j];
+ o[k++] = (unsigned char) v[(c >> 4) & 0x0F];
+ o[k++] = (unsigned char) v[(c >> 0) & 0x0F];
+ }
+ break;
+ case 2:
+ for (size_t j = f; j < l; j++) {
+ int c = t[j];
+ o[k++] = (unsigned char) v[(c >> 6) & 0x03];
+ o[k++] = (unsigned char) v[(c >> 4) & 0x03];
+ o[k++] = (unsigned char) v[(c >> 2) & 0x03];
+ o[k++] = (unsigned char) v[(c >> 0) & 0x03];
+ }
+ break;
+ default:
+ for (size_t j = f; j < l; j++) {
+ int c = t[j];
+ o[k++] = (unsigned char) v[(c >> 7) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 6) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 5) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 4) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 3) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 2) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 1) & 0x01];
+ o[k++] = (unsigned char) v[(c >> 0) & 0x01];
+ }
+ break;
+ }
+ }
+ lua_pushlstring(L, o, osize);
+ lmt_memory_free(o);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static const struct luaL_Reg pngdecodelib_function_list[] = {
+ { "applyfilter", pnglib_applyfilter },
+ { "splitmask", pnglib_splitmask },
+ { "interlace", pnglib_interlace },
+ { "expand", pnglib_expand },
+ { "tocmyk", pnglib_tocmyk },
+ { "tomask", pnglib_tomask },
+ { NULL, NULL },
+};
+
+int luaopen_pngdecode(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, pngdecodelib_function_list, 0);
+ return 1;
+}
+
+/*tex This is a placeholder! */
+
+static const struct luaL_Reg pdfdecodelib_function_list[] = {
+ { NULL, NULL }
+};
+
+int luaopen_pdfdecode(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, pdfdecodelib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtfilelib.c b/source/luametatex/source/luarest/lmtfilelib.c
new file mode 100644
index 000000000..8a814d713
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtfilelib.c
@@ -0,0 +1,877 @@
+/*
+
+ See license.txt in the root of this project.
+
+ This is a replacement for lfs, a file system manipulation library from the Kepler project. I
+ started from the lfs.c file from luatex because we need to keep a similar interface. That
+ file mentioned:
+
+ Copyright Kepler Project 2003 - 2017 (http://keplerproject.github.io/luafilesystem)
+
+ The original library offers the following functions:
+
+ lfs.attributes(filepath [, attributename | attributetable])
+ lfs.chdir(path)
+ lfs.currentdir()
+ lfs.dir(path)
+ lfs.link(old, new[, symlink])
+ -- lfs.lock(fh, mode)
+ -- lfs.lock_dir(path)
+ lfs.mkdir(path)
+ lfs.rmdir(path)
+ -- lfs.setmode(filepath, mode)
+ lfs.symlinkattributes(filepath [, attributename])
+ lfs.touch(filepath [, atime [, mtime]])
+ -- lfs.unlock(fh)
+
+ We have additional code in other modules and the code was already adapted a little. In the
+ meantime the code looks quite different.
+
+ Because \TEX| is multi-platform we try to provide a consistent interface. So, for instance
+ blocksize and inode number are not relevant for us, nor are user and group ids. The lock
+ functions have been removed as they serve no purpose in a \TEX\ system and devices make no
+ sense either. The iterator could be improved. I also fixed some anomalities. Permissions are
+ not useful either.
+
+*/
+
+# include "../lua/lmtinterface.h"
+# include "../utilities/auxmemory.h"
+
+# ifndef R_OK
+# define F_OK 0x0
+# define W_OK 0x2
+# define R_OK 0x4
+# endif
+
+# define DIR_METATABLE "file.directory"
+
+# ifndef _WIN32
+ # ifndef _FILE_OFFSET_BITS
+ # define _FILE_OFFSET_BITS 64
+ # endif
+# endif
+
+# ifdef _WIN32
+ # ifndef WINVER
+ # define WINVER 0x0601
+ # undef _WIN32_WINNT
+ # define _WIN32_WINNT 0x0601
+ # endif
+# endif
+
+// # ifndef _LARGEFILE64_SOURCE
+ # define _LARGEFILE64_SOURCE 1
+// # endif
+
+# include <errno.h>
+# include <stdio.h>
+# include <string.h>
+# include <stdlib.h>
+# include <time.h>
+# include <sys/stat.h>
+
+// # ifdef _MSC_VER
+// # ifndef MAX_PATH
+// # define MAX_PATH 256
+// # endif
+// # endif
+
+# ifdef _WIN32
+
+ # include <direct.h>
+ # include <windows.h>
+ # include <io.h>
+ # include <sys/locking.h>
+ # include <sys/utime.h>
+ # include <fcntl.h>
+
+ # define MY_MAXPATHLEN MAX_PATH
+
+# else
+
+ /* the next one is sensitive for c99 */
+
+ # include <unistd.h>
+ # include <dirent.h>
+ # include <fcntl.h>
+ # include <sys/types.h>
+ # include <utime.h>
+ # include <sys/param.h>
+
+ # define MY_MAXPATHLEN MAXPATHLEN
+
+# endif
+
+/* This has to go to the h file. See luainit.c where it's also needed. */
+
+# ifdef _WIN32
+
+ # include "../utilities/auxfile.h"
+
+ # ifndef S_ISDIR
+ # define S_ISDIR(mode) (mode & _S_IFDIR)
+ # endif
+
+ # ifndef S_ISREG
+ # define S_ISREG(mode) (mode & _S_IFREG)
+ # endif
+
+ # ifndef S_ISLNK
+ # define S_ISLNK(mode) (0)
+ # endif
+
+ # ifndef S_ISSUB
+ # define S_ISSUB(mode) (file_data.attrib & _A_SUBDIR)
+ # endif
+
+ # define info_struct struct _stati64
+ # define utime_struct struct __utimbuf64
+
+ # define exec_mode_flag _S_IEXEC
+
+ /*
+ There is a difference between msvc and mingw wrt the daylight saving time correction being
+ applied toy the times. I couldn't figure it out and don't want to waste more time on it.
+ */
+
+ typedef struct dir_data {
+ intptr_t handle;
+ int closed;
+ char pattern[MY_MAXPATHLEN+1];
+ } dir_data;
+
+ static int get_stat(const char *s, info_struct *i)
+ {
+ LPWSTR w = aux_utf8_to_wide(s);
+ int r = _wstati64(w, i);
+ lmt_memory_free(w);
+ return r;
+ }
+
+ static int mk_dir(const char *s)
+ {
+ LPWSTR w = aux_utf8_to_wide(s);
+ int r = _wmkdir(w);
+ lmt_memory_free(w);
+ return r;
+ }
+
+ static int ch_dir(const char *s)
+ {
+ LPWSTR w = aux_utf8_to_wide(s);
+ int r = _wchdir(w);
+ lmt_memory_free(w);
+ return r;
+ }
+
+ static int rm_dir(const char *s)
+ {
+ LPWSTR w = aux_utf8_to_wide(s);
+ int r = _wrmdir(w);
+ lmt_memory_free(w);
+ return r;
+ }
+
+ static int mk_symlink(const char *t, const char *f)
+ {
+ LPWSTR wt = aux_utf8_to_wide(t);
+ LPWSTR wf = aux_utf8_to_wide(f);
+ int r = (CreateSymbolicLinkA(t, f, 0x2) != 0);
+ lmt_memory_free(wt);
+ lmt_memory_free(wf);
+ return r;
+ }
+
+ static int mk_link(const char *t, const char *f)
+ {
+ LPWSTR wt = aux_utf8_to_wide(t);
+ LPWSTR wf = aux_utf8_to_wide(f);
+ int r = (CreateSymbolicLinkA(t, f, 0x3) != 0);
+ lmt_memory_free(wt);
+ lmt_memory_free(wf);
+ return r;
+ }
+
+ static int ch_to_exec(const char *s, int n)
+ {
+ LPWSTR w = aux_utf8_to_wide(s);
+ int r = _wchmod(w, n);
+ lmt_memory_free(w);
+ return r;
+ }
+
+ // # ifdef _MSC_VER
+ //
+ // static int set_utime(const char *s, utime_struct *b)
+ // {
+ // LPWSTR w = utf8_to_wide(s);
+ // HANDLE h = CreateFileW(w, GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ // int r = -1;
+ // lmt_memory_free(w);
+ // if (h != INVALID_HANDLE_VALUE) {
+ // r = SetFileTime(h, (const struct _FILETIME *) b, (const struct _FILETIME *) b, (const struct _FILETIME *) b);
+ // CloseHandle(h);
+ // }
+ // return r;
+ // }
+ //
+ // # else
+
+ static int set_utime(const char *s, utime_struct *b)
+ {
+ LPWSTR w = aux_utf8_to_wide(s);
+ int r = _wutime64(w, b);
+ lmt_memory_free(w);
+ return r;
+ }
+
+ // # endif
+
+# else
+
+ # define info_struct struct stat
+ # define utime_struct struct utimbuf
+
+ typedef struct dir_data {
+ DIR *handle;
+ int closed;
+ char pattern[MY_MAXPATHLEN+1];
+ } dir_data;
+
+ # define get_stat stat
+ # define mk_dir(p) (mkdir((p), S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH))
+ # define ch_dir chdir
+ # define get_cwd getcwd
+ # define rm_dir rmdir
+ # define mk_symlink(f,t) (symlink(f,t) != -1)
+ # define mk_link(f,t) (link(f,t) != -1)
+ # define ch_to_exec(f,n) (chmod(f,n))
+ # define exec_mode_flag S_IXUSR | S_IXGRP | S_IXOTH
+ # define set_utime(f,b) utime(f,b)
+
+# endif
+
+# include <lua.h>
+# include <lauxlib.h>
+# include <lualib.h>
+
+/*
+ This function changes the current directory.
+
+ success = chdir(name)
+*/
+
+static int filelib_chdir(lua_State *L) {
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ lua_pushboolean(L, ! ch_dir(luaL_checkstring(L, 1)));
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+/*
+ This function returns the current directory or false.
+
+ name = currentdir()
+*/
+
+# ifdef _WIN32
+
+ static int filelib_currentdir(lua_State *L)
+ {
+ LPWSTR wpath = NULL;
+ int size = 256;
+ while (1) {
+ LPWSTR temp = lmt_memory_realloc(wpath, size * sizeof(WCHAR));
+ wpath = temp;
+ if (! wpath) {
+ lua_pushboolean(L, 0);
+ break;
+ } else if (_wgetcwd(wpath, size)) {
+ char * path = aux_utf8_from_wide(wpath);
+ lua_pushstring(L, path);
+ lmt_memory_free(path);
+ break;
+ } else if (errno != ERANGE) {
+ lua_pushboolean(L, 0);
+ break;
+ } else {
+ size *= 2;
+ }
+ }
+ lmt_memory_free(wpath);
+ return 1;
+ }
+
+# else
+
+ static int filelib_currentdir(lua_State *L)
+ {
+ char *path = NULL;
+ size_t size = MY_MAXPATHLEN;
+ while (1) {
+ path = lmt_memory_realloc(path, size);
+ if (! path) {
+ lua_pushboolean(L,0);
+ break;
+ }
+ if (get_cwd(path, size)) {
+ lua_pushstring(L, path);
+ break;
+ }
+ if (errno != ERANGE) {
+ lua_pushboolean(L,0);
+ break;
+ }
+ size *= 2;
+ }
+ lmt_memory_free(path);
+ return 1;
+ }
+
+# endif
+
+/*
+ This functions create a link:
+
+ success = link(target,name,[true=symbolic])
+ success = symlink(target,name)
+*/
+
+static int filelib_link(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING && lua_type(L, 2) == LUA_TSTRING) {
+ const char *oldpath = lua_tostring(L, 1);
+ const char *newpath = lua_tostring(L, 2);
+ lua_pushboolean(L, lua_toboolean(L, 3) ? mk_symlink(oldpath, newpath) : mk_link(oldpath, newpath));
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+static int filelib_symlink(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING && lua_type(L, 2) == LUA_TSTRING) {
+ const char *oldpath = lua_tostring(L, 1);
+ const char *newpath = lua_tostring(L, 2);
+ lua_pushboolean(L, mk_symlink(oldpath, newpath));
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+/*
+ This function creates a directory.
+
+ success = mkdir(name)
+*/
+
+static int filelib_mkdir(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ lua_pushboolean(L, mk_dir(lua_tostring(L, 1)) != -1);
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+/*
+ This function removes a directory (non-recursive).
+
+ success = mkdir(name)
+*/
+
+static int filelib_rmdir(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ lua_pushboolean(L, rm_dir(luaL_checkstring(L, 1)) != -1);
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+/*
+ The directory iterator returns multiple values:
+
+ for name, mode, size, mtime in dir(path) do ... end
+
+ For practical reasons we keep the metatable the same.
+
+*/
+
+# ifdef _WIN32
+
+ inline static int push_entry(lua_State *L, struct _wfinddata_t file_data, int details)
+ {
+ char *s = aux_utf8_from_wide(file_data.name);
+ lua_pushstring(L, s);
+ lmt_memory_free(s);
+ if (S_ISSUB(file_data.attrib)) {
+ lua_push_key(directory);
+ } else {
+ lua_push_key(file);
+ }
+ if (details) {
+ lua_pushinteger(L, file_data.size);
+ lua_pushinteger(L, file_data.time_write);
+ return 4;
+ } else {
+ return 2;
+ }
+ }
+
+ static int filelib_aux_dir_iterator(lua_State *L)
+ {
+ struct _wfinddata_t file_data;
+ int details = 1;
+ dir_data *d = (dir_data *) luaL_checkudata(L, 1, DIR_METATABLE);
+ lua_getiuservalue(L, 1, 1);
+ details = lua_toboolean(L, -1);
+ lua_pop(L, 1);
+ luaL_argcheck(L, d->closed == 0, 1, "closed directory");
+ if (d->handle == 0L) {
+ /* first entry */
+ LPWSTR s = aux_utf8_to_wide(d->pattern);
+ if ((d->handle = _wfindfirst(s, &file_data)) == -1L) {
+ d->closed = 1;
+ lmt_memory_free(s);
+ return 0;
+ } else {
+ lmt_memory_free(s);
+ return push_entry(L, file_data, details);
+ }
+ } else if (_wfindnext(d->handle, &file_data) == -1L) {
+ /* no more entries */
+ /* lmt_memory_free(d->handle); */ /* is done for us */
+ _findclose(d->handle);
+ d->closed = 1;
+ return 0;
+ } else {
+ /* successive entries */
+ return push_entry(L, file_data, details);
+ }
+ }
+
+ static int filelib_aux_dir_close(lua_State *L)
+ {
+ dir_data *d = (dir_data *) lua_touserdata(L, 1);
+ if (!d->closed && d->handle) {
+ _findclose(d->handle);
+ }
+ d->closed = 1;
+ return 0;
+ }
+
+ static int filelib_dir(lua_State *L)
+ {
+ const char *path = luaL_checkstring(L, 1);
+ int detail = lua_type(L, 2) == LUA_TBOOLEAN ? lua_toboolean(L, 2) : 1;
+ dir_data *d ;
+ lua_pushcfunction(L, filelib_aux_dir_iterator);
+ d = (dir_data *) lua_newuserdatauv(L, sizeof(dir_data), 1);
+ lua_pushboolean(L, detail);
+ lua_setiuservalue(L, -2, 1);
+ luaL_getmetatable(L, DIR_METATABLE);
+ lua_setmetatable(L, -2);
+ d->closed = 0;
+ d->handle = 0L;
+ if (path && strlen(path) > MY_MAXPATHLEN-2) {
+ luaL_error(L, "path too long: %s", path);
+ } else {
+ sprintf(d->pattern, "%s/*", path ? path : "."); /* brrr */
+ }
+ return 2;
+ }
+
+# else
+
+ /*tex
+
+ On unix we cannot get the size and time in one go without interference. Also, not all file
+ systems return this field. So eventually we might not do this on unix and revert to the
+ slower method at the lua end when DT_DIR is undefined. After a report from the mailing
+ list about symbolic link issues this is what Taco and I came up with. The |_less| variant
+ is mainly there because in \UNIX\ we then can avoid a costly |stat| when we don't need the
+ details (only a symlink demands such a |stat|).
+
+ */
+
+ static int filelib_aux_dir_iterator(lua_State *L)
+ {
+ struct dirent *entry;
+ dir_data *d;
+ int details = 1;
+ lua_pushcfunction(L, filelib_aux_dir_iterator);
+ d = (dir_data *) luaL_checkudata(L, 1, DIR_METATABLE);
+ lua_getiuservalue(L, 1, 1);
+ details = lua_toboolean(L, -1);
+ lua_pop(L, 1);
+ luaL_argcheck(L, d->closed == 0, 1, "closed directory");
+ entry = readdir (d->handle);
+ if (entry) {
+ lua_pushstring(L, entry->d_name);
+# ifdef _DIRENT_HAVE_D_TYPE
+ if (! details) {
+ if (entry->d_type == DT_DIR) {
+ lua_push_key(directory);
+ return 2;
+ } else if (entry->d_type == DT_REG) {
+ lua_push_key(file);
+ return 2;
+ }
+ }
+# endif
+ /*tex We can have a symlink and/or we need the details an dfor both we need to |get_stat|. */
+ {
+ info_struct info;
+ char file_path[2*MY_MAXPATHLEN];
+ snprintf(file_path, 2*MY_MAXPATHLEN, "%s/%s", d->pattern, entry->d_name);
+ if (! get_stat(file_path, &info)) {
+ if (S_ISDIR(info.st_mode)) {
+ lua_push_key(directory);
+ } else if (S_ISREG(info.st_mode) || S_ISLNK(info.st_mode)) {
+ lua_push_key(file);
+ } else {
+ lua_pushnil(L);
+ return 2;
+ }
+ if (details) {
+ lua_pushinteger(L, info.st_size);
+ lua_pushinteger(L, info.st_mtime);
+ return 4;
+ }
+ } else {
+ lua_pushnil(L);
+ }
+ return 2;
+ }
+ } else {
+ closedir(d->handle);
+ d->closed = 1;
+ return 0;
+ }
+ }
+
+ static int filelib_aux_dir_close(lua_State *L)
+ {
+ dir_data *d = (dir_data *) lua_touserdata(L, 1);
+ if (!d->closed && d->handle) {
+ closedir(d->handle);
+ }
+ d->closed = 1;
+ return 0;
+ }
+
+ static int filelib_dir(lua_State *L)
+ {
+ const char *path = luaL_checkstring(L, 1);
+ dir_data *d;
+ lua_pushcfunction(L, filelib_aux_dir_iterator);
+ d = (dir_data *) lua_newuserdatauv(L, sizeof(dir_data), 1);
+ lua_pushboolean(L, lua_type(L, 2) == LUA_TBOOLEAN ? lua_toboolean(L, 2) : 1);
+ lua_setiuservalue(L, -2, 1);
+ luaL_getmetatable(L, DIR_METATABLE);
+ lua_setmetatable(L, -2);
+ d->closed = 0;
+ d->handle = opendir(path ? path : ".");
+ if (! d->handle) {
+ luaL_error(L, "cannot open %s: %s", path, strerror(errno));
+ }
+ snprintf(d->pattern, MY_MAXPATHLEN, "%s", path ? path : ".");
+ return 2;
+ }
+
+# endif
+
+static int dir_create_meta(lua_State *L)
+{
+ luaL_newmetatable(L, DIR_METATABLE);
+ lua_newtable(L);
+ lua_pushcfunction(L, filelib_aux_dir_iterator);
+ lua_setfield(L, -2, "next");
+ lua_pushcfunction(L, filelib_aux_dir_close);
+ lua_setfield(L, -2, "close");
+ lua_setfield(L, -2, "__index");
+ lua_pushcfunction(L, filelib_aux_dir_close);
+ lua_setfield(L, -2, "__gc");
+ return 1;
+}
+
+# define mode2string(mode) \
+ ((S_ISREG(mode)) ? "file" : ((S_ISDIR(mode)) ? "directory" : ((S_ISLNK(mode)) ? "link" : "other")))
+
+/* We keep this for a while: will change to { r, w, x hash } */
+
+# ifdef _WIN32
+
+ static const char *perm2string(unsigned short mode)
+ {
+ static char perms[10] = "---------";
+ /* persistent change hence the for loop */
+ for (int i = 0; i < 9; i++) {
+ perms[i]='-';
+ }
+ if (mode & _S_IREAD) { perms[0] = 'r'; perms[3] = 'r'; perms[6] = 'r'; }
+ if (mode & _S_IWRITE) { perms[1] = 'w'; perms[4] = 'w'; perms[7] = 'w'; }
+ if (mode & _S_IEXEC) { perms[2] = 'x'; perms[5] = 'x'; perms[8] = 'x'; }
+ return perms;
+ }
+
+# else
+
+ static const char *perm2string(mode_t mode)
+ {
+ static char perms[10] = "---------";
+ /* persistent change hence the for loop */
+ for (int i = 0; i < 9; i++) {
+ perms[i]='-';
+ }
+ if (mode & S_IRUSR) perms[0] = 'r';
+ if (mode & S_IWUSR) perms[1] = 'w';
+ if (mode & S_IXUSR) perms[2] = 'x';
+ if (mode & S_IRGRP) perms[3] = 'r';
+ if (mode & S_IWGRP) perms[4] = 'w';
+ if (mode & S_IXGRP) perms[5] = 'x';
+ if (mode & S_IROTH) perms[6] = 'r';
+ if (mode & S_IWOTH) perms[7] = 'w';
+ if (mode & S_IXOTH) perms[8] = 'x';
+ return perms;
+ }
+
+# endif
+
+/*
+ The next one sets access time and modification values for a file:
+
+ utime(filename) : current, current
+ utime(filename,acess) : access, access
+ utime(filename,acess,modification) : access, modification
+*/
+
+static int filelib_touch(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ const char *file = luaL_checkstring(L, 1);
+ utime_struct utb, *buf;
+ if (lua_gettop(L) == 1) {
+ buf = NULL;
+ } else {
+ utb.actime = (time_t) luaL_optinteger(L, 2, 0);
+ utb.modtime = (time_t) luaL_optinteger(L, 3, utb.actime);
+ buf = &utb;
+ }
+ lua_pushboolean(L, set_utime(file, buf) != -1);
+ } else {
+ lua_pushboolean(L, 0);
+ }
+ return 1;
+}
+
+static void push_st_mode (lua_State *L, info_struct *info) { lua_pushstring (L, mode2string (info->st_mode)); } /* inode protection mode */
+static void push_st_size (lua_State *L, info_struct *info) { lua_pushinteger(L, (lua_Integer) info->st_size); } /* file size, in bytes */
+static void push_st_mtime(lua_State *L, info_struct *info) { lua_pushinteger(L, (lua_Integer) info->st_mtime); } /* time of last data modification */
+static void push_st_atime(lua_State *L, info_struct *info) { lua_pushinteger(L, (lua_Integer) info->st_atime); } /* time of last access */
+static void push_st_ctime(lua_State *L, info_struct *info) { lua_pushinteger(L, (lua_Integer) info->st_ctime); } /* time of last file status change */
+static void push_st_perm (lua_State *L, info_struct *info) { lua_pushstring (L, perm2string (info->st_mode)); } /* permissions string */
+static void push_st_nlink(lua_State *L, info_struct *info) { lua_pushinteger(L, (lua_Integer) info->st_nlink); } /* number of hard links to the file */
+
+typedef void (*push_info_struct_function) (lua_State *L, info_struct *info);
+
+struct file_stat_members {
+ const char *name;
+ push_info_struct_function push;
+};
+
+static struct file_stat_members members[] = {
+ { "mode", push_st_mode },
+ { "size", push_st_size },
+ { "modification", push_st_mtime },
+ { "access", push_st_atime },
+ { "change", push_st_ctime },
+ { "permissions", push_st_perm },
+ { "nlink", push_st_nlink },
+ { NULL, NULL },
+};
+
+/*
+ Get file or symbolic link information. Returns a table or nil.
+*/
+
+static int filelib_attributes(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ info_struct info;
+ const char *file = luaL_checkstring(L, 1);
+ if (get_stat(file, &info)) {
+ /* bad news */
+ } else if (lua_isstring(L, 2)) {
+ const char *member = lua_tostring(L, 2);
+ for (int i = 0; members[i].name; i++) {
+ if (strcmp(members[i].name, member) == 0) {
+ members[i].push(L, &info);
+ return 1;
+ }
+ }
+ } else {
+ lua_settop(L, 2);
+ if (! lua_istable(L, 2)) {
+ lua_createtable(L, 0, 6);
+ }
+ for (int i = 0; members[i].name; i++) {
+ lua_pushstring(L, members[i].name);
+ members[i].push(L, &info);
+ lua_rawset(L, -3);
+ }
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+# define is_whatever(L,IS_OK,okay) do { \
+ if (lua_type(L, 1) == LUA_TSTRING) { \
+ info_struct info; \
+ const char *name = lua_tostring(L, 1); \
+ if (get_stat(name, &info)) { \
+ lua_pushboolean(L, 0); \
+ } else { \
+ lua_pushboolean(L, okay && ! access(name, IS_OK)); \
+ } \
+ } else { \
+ lua_pushboolean(L, 0); \
+ } \
+ return 1; \
+} while(1)
+
+static int filelib_isdir (lua_State *L) { is_whatever(L, F_OK,(S_ISDIR(info.st_mode))); }
+static int filelib_isreadabledir (lua_State *L) { is_whatever(L, R_OK,(S_ISDIR(info.st_mode))); }
+static int filelib_iswriteabledir (lua_State *L) { is_whatever(L, W_OK,(S_ISDIR(info.st_mode))); }
+
+static int filelib_isfile (lua_State *L) { is_whatever(L, F_OK,(S_ISREG(info.st_mode) || S_ISLNK(info.st_mode))); }
+static int filelib_isreadablefile (lua_State *L) { is_whatever(L, R_OK,(S_ISREG(info.st_mode) || S_ISLNK(info.st_mode))); }
+static int filelib_iswriteablefile(lua_State *L) { is_whatever(L, W_OK,(S_ISREG(info.st_mode) || S_ISLNK(info.st_mode))); }
+
+static int filelib_setexecutable(lua_State *L)
+{
+ int ok = 0;
+ if (lua_type(L, 1) == LUA_TSTRING) {
+ info_struct info;
+ const char *name = lua_tostring(L, 1);
+ if (! get_stat(name, &info) && S_ISREG(info.st_mode)) {
+ if (ch_to_exec(name, info.st_mode | exec_mode_flag)) {
+ /* the setting failed */
+ } else {
+ ok = 1;
+ }
+ } else {
+ /* not a valid file */
+ }
+ }
+ lua_pushboolean(L, ok);
+ return 1;
+}
+
+/*
+ Push the symlink target to the top of the stack. Assumes the file name is at position 1 of the
+ stack. Returns 1 if successful (with the target on top of the stack), 0 on failure (with stack
+ unchanged, and errno set).
+
+ link("name") : table
+ link("name","target") : targetname
+*/
+
+// # ifdef _WIN32
+//
+// static int filelib_symlinkattributes(lua_State *L)
+// {
+// lua_pushnil(L);
+// return 1;
+// }
+//
+// # else
+//
+// static int push_link_target(lua_State *L)
+// {
+// const char *file = luaL_checkstring(L, 1);
+// char *target = NULL;
+// int tsize, size = 256; /* size = initial buffer capacity */
+// while (1) {
+// target = lmt_memory_realloc(target, size);
+// if (! target) {
+// return 0;
+// }
+// tsize = readlink(file, target, size);
+// if (tsize < 0) {
+// /* error */
+// lmt_memory_free(target);
+// return 0;
+// }
+// if (tsize < size) {
+// break;
+// }
+// /* possibly truncated readlink() result, double size and retry */
+// size *= 2;
+// }
+// target[tsize] = '\0';
+// lua_pushlstring(L, target, tsize);
+// lmt_memory_free(target);
+// return 1;
+// }
+//
+// static int filelib_symlinkattributes(lua_State *L)
+// {
+// if (lua_isstring(L, 2) && (strcmp(lua_tostring(L, 2), "target") == 0)) {
+// if (! push_link_target(L)) {
+// lua_pushnil(L);
+// }
+// } else {
+// int ret = filelib_attributes(L);
+// if (ret == 1 && lua_type(L, -1) == LUA_TTABLE) {
+// if (push_link_target(L)) {
+// lua_setfield(L, -2, "target");
+// }
+// } else {
+// lua_pushnil(L);
+// }
+// }
+// return 1;
+// }
+//
+// # endif
+
+static const struct luaL_Reg filelib_function_list[] = {
+ { "attributes", filelib_attributes },
+ { "chdir", filelib_chdir },
+ { "currentdir", filelib_currentdir },
+ { "dir", filelib_dir },
+ { "mkdir", filelib_mkdir },
+ { "rmdir", filelib_rmdir },
+ { "touch", filelib_touch },
+ /* */
+ { "link", filelib_link },
+ { "symlink", filelib_symlink },
+ { "setexecutable", filelib_setexecutable },
+ /* { "symlinkattributes", filelib_symlinkattributes }, */
+ /* */
+ { "isdir", filelib_isdir },
+ { "isfile", filelib_isfile },
+ { "iswriteabledir", filelib_iswriteabledir },
+ { "iswriteablefile", filelib_iswriteablefile },
+ { "isreadabledir", filelib_isreadabledir },
+ { "isreadablefile", filelib_isreadablefile },
+ /* */
+ { NULL, NULL },
+};
+
+int luaopen_filelib(lua_State *L) {
+ dir_create_meta(L);
+ luaL_newlib(L,filelib_function_list);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtiolibext.c b/source/luametatex/source/luarest/lmtiolibext.c
new file mode 100644
index 000000000..319eb40c6
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtiolibext.c
@@ -0,0 +1,1608 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ Lua doesn't have cardinals so basically we could stick to integers and accept that we have a
+ limited range.
+
+*/
+
+# include "luametatex.h"
+
+# ifdef _WIN32
+
+ # define lua_popen(L,c,m) ((void)L, _popen(c,m))
+ # define lua_pclose(L,file) ((void)L, _pclose(file))
+
+# else
+
+ # define lua_popen(L,c,m) ((void)L, fflush(NULL), popen(c,m))
+ # define lua_pclose(L,file) ((void)L, pclose(file))
+
+# endif
+
+/* Mojca: we need to sort this out! */
+
+# ifdef LUA_USE_POSIX
+
+ # define l_fseek(f,o,w) fseeko(f,o,w)
+ # define l_ftell(f) ftello(f)
+ # define l_seeknum off_t
+
+# elif defined(LUA_WIN) && !defined(_CRTIMP_TYPEINFO) && defined(_MSC_VER) && (_MSC_VER >= 1400)
+
+ # define l_fseek(f,o,w) _fseeki64(f,o,w)
+ # define l_ftell(f) _ftelli64(f)
+ # define l_seeknum __int64
+
+# elif defined(__MINGW32__)
+
+ # define l_fseek(f,o,w) fseeko64(f,o,w)
+ # define l_ftell(f) ftello64(f)
+ # define l_seeknum int64_t
+
+# else
+
+ # define l_fseek(f,o,w) fseek(f,o,w)
+ # define l_ftell(f) ftell(f)
+ # define l_seeknum long
+
+# endif
+
+# define uchar(c) ((unsigned char)(c))
+
+/*tex
+
+ A few helpers to avoid reading numbers as strings. For now we put them in their own namespace.
+ We also have a few helpers that can make \IO\ functions \TEX\ friendly.
+
+*/
+
+static int fiolib_readcardinal1(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, a);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readcardinal1(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if (p >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p]);
+ lua_pushinteger(L, a);
+ }
+ return 1;
+}
+
+static int fiolib_readcardinal2(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ if (b == EOF) {
+ lua_pushnil(L);
+ } else {
+ /* (a<<8) | b */
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readcardinal2_le(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer b = getc(f);
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else {
+ /* (a<<8) | b */
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readcardinal2(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 1) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p]);
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ return 1;
+}
+
+static int siolib_readcardinal2_le(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 1) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer a = uchar(s[p]);
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ return 1;
+}
+
+static int fiolib_readcardinal3(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ if (c == EOF) {
+ lua_pushnil(L);
+ } else {
+ /* (a<<16) | (b<<8) | c */
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readcardinal3_le(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer c = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else {
+ /* (a<<16) | (b<<8) | c */
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readcardinal3(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 2) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p]);
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ return 1;
+}
+
+static int siolib_readcardinal3_le(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 2) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer a = uchar(s[p]);
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ return 1;
+}
+
+static int fiolib_readcardinal4(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ lua_Integer d = getc(f);
+ if (d == EOF) {
+ lua_pushnil(L);
+ } else {
+ /* (a<<24) | (b<<16) | (c<<8) | d */
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readcardinal4_le(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer d = getc(f);
+ lua_Integer c = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else {
+ /* (a<<24) | (b<<16) | (c<<8) | d */
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readcardinal4(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 3) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer d = uchar(s[p]);
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ return 1;
+}
+
+static int siolib_readcardinal4_le(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 3) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer d = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer a = uchar(s[p]);
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ return 1;
+}
+
+static int fiolib_readcardinaltable(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ lua_Integer m = lua_tointeger(L, 3);
+ lua_createtable(L, (int) n, 0);
+ switch (m) {
+ case 1:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ break;
+ } else {
+ lua_pushinteger(L, a);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 2:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ if (b == EOF) {
+ break;
+ } else {
+ /* (a<<8) | b */
+ lua_pushinteger(L, 0x100 * a + b);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 3:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ if (c == EOF) {
+ break;
+ } else {
+ /* (a<<16) | (b<<8) | c */
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 4:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ lua_Integer d = getc(f);
+ if (d == EOF) {
+ break;
+ } else {
+ /* (a<<24) | (b<<16) | (c<<8) | d */
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readcardinaltable(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer n = lua_tointeger(L, 3);
+ lua_Integer m = lua_tointeger(L, 4);
+ lua_Integer l = (lua_Integer) ls;
+ lua_createtable(L, (int) n, 0);
+ switch (m) {
+ case 1:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if (p >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_pushinteger(L, a);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 2:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if ((p + 1) >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_pushinteger(L, 0x100 * a + b);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 3:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if ((p + 2) >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 4:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if ((p + 3) >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer d = uchar(s[p++]);
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ return 1;
+}
+
+static int fiolib_readinteger1(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, a - 0x100);
+ } else {
+ lua_pushinteger(L, a);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readinteger1(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if (p >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, a - 0x100);
+ } else {
+ lua_pushinteger(L, a);
+ }
+ }
+ return 1;
+}
+
+static int fiolib_readinteger2(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ if (b == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x100 * a + b - 0x10000);
+ } else {
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readinteger2_le(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer b = getc(f);
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x100 * a + b - 0x10000);
+ } else {
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readinteger2(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 1) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x100 * a + b - 0x10000);
+ } else {
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ }
+ return 1;
+}
+
+static int siolib_readinteger2_le(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 1) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer a = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x100 * a + b - 0x10000);
+ } else {
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ }
+ return 1;
+}
+
+static int fiolib_readinteger3(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ if (c == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c - 0x1000000);
+ } else {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readinteger3_le(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer c = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c - 0x1000000);
+ } else {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readinteger3(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 2) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c - 0x1000000);
+ } else {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ }
+ return 1;
+}
+
+static int siolib_readinteger3_le(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 2) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer a = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c - 0x1000000);
+ } else {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ }
+ return 1;
+}
+
+static int fiolib_readinteger4(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ lua_Integer d = getc(f);
+ if (d == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d - 0x100000000);
+ } else {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readinteger4_le(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer d = getc(f);
+ lua_Integer c = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ lua_pushnil(L);
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d - 0x100000000);
+ } else {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readinteger4(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 3) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer d = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d - 0x100000000);
+ } else {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ }
+ return 1;
+}
+
+static int siolib_readinteger4_le(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 3) >= l) {
+ lua_pushnil(L);
+ } else {
+ lua_Integer d = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer a = uchar(s[p]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d - 0x100000000);
+ } else {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ }
+ return 1;
+}
+
+static int fiolib_readintegertable(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ lua_Integer m = lua_tointeger(L, 3);
+ lua_createtable(L, (int) n, 0);
+ switch (m) {
+ case 1:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ break;
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, a - 0x100);
+ } else {
+ lua_pushinteger(L, a);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ break;
+ case 2:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ if (b == EOF) {
+ break;
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x100 * a + b - 0x10000);
+ } else {
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ break;
+ case 3:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ if (c == EOF) {
+ break;
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c - 0x1000000);
+ } else {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ break;
+ case 4:
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ lua_Integer b = getc(f);
+ lua_Integer c = getc(f);
+ lua_Integer d = getc(f);
+ if (d == EOF) {
+ break;
+ } else if (a >= 0x80) {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d - 0x100000000);
+ } else {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ break;
+ default:
+ break;
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readintegertable(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer n = lua_tointeger(L, 3);
+ lua_Integer m = lua_tointeger(L, 4);
+ lua_Integer l = (lua_Integer) ls;
+ lua_createtable(L, (int) n, 0);
+ switch (m) {
+ case 1:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if (p >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, a - 0x100);
+ } else {
+ lua_pushinteger(L, a);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 2:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if ((p + 1) >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x100 * a + b - 0x10000);
+ } else {
+ lua_pushinteger(L, 0x100 * a + b);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 3:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if ((p + 2) >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c - 0x1000000);
+ } else {
+ lua_pushinteger(L, 0x10000 * a + 0x100 * b + c);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ case 4:
+ for (lua_Integer i = 1; i <= n; i++) {
+ if ((p + 3) >= l) {
+ break;
+ } else {
+ lua_Integer a = uchar(s[p++]);
+ lua_Integer b = uchar(s[p++]);
+ lua_Integer c = uchar(s[p++]);
+ lua_Integer d = uchar(s[p++]);
+ if (a >= 0x80) {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d - 0x100000000);
+ } else {
+ lua_pushinteger(L, 0x1000000 * a + 0x10000 * b + 0x100 * c + d);
+ }
+ lua_rawseti(L, -2, i);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ return 1;
+}
+
+/* from ff */
+
+static int fiolib_readfixed2(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ int a = getc(f);
+ int b = getc(f);
+ if (b == EOF) {
+ lua_pushnil(L);
+ } else {
+ int n = 0x100 * a + b; /* really an int because we shift */
+ lua_pushnumber(L, (double) ((n>>8) + ((n&0xff)/256.0)));
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readfixed2(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 3) >= l) {
+ lua_pushnil(L);
+ } else {
+ int a = uchar(s[p++]);
+ int b = uchar(s[p]);
+ int n = 0x100 * a + b; /* really an int because we shift */
+ lua_pushnumber(L, (double) ((n>>8) + ((n&0xff)/256.0)));
+ }
+ return 1;
+}
+
+static int fiolib_readfixed4(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ int a = getc(f);
+ int b = getc(f);
+ int c = getc(f);
+ int d = getc(f);
+ if (d == EOF) {
+ lua_pushnil(L);
+ } else {
+ int n = 0x1000000 * a + 0x10000 * b + 0x100 * c + d; /* really an int because we shift */
+ lua_pushnumber(L, (double) ((n>>16) + ((n&0xffff)/65536.0)));
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readfixed4(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 3) >= l) {
+ lua_pushnil(L);
+ } else {
+ int a = uchar(s[p++]);
+ int b = uchar(s[p++]);
+ int c = uchar(s[p++]);
+ int d = uchar(s[p]);
+ int n = 0x1000000 * a + 0x10000 * b + 0x100 * c + d; /* really an int because we shift */
+ lua_pushnumber(L, (double) ((n>>16) + ((n&0xffff)/65536.0)));
+ }
+ return 1;
+}
+
+static int fiolib_read2dot14(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ int a = getc(f);
+ int b = getc(f);
+ if (b == EOF) {
+ lua_pushnil(L);
+ } else {
+ int n = 0x100 * a + b; /* really an int because we shift */
+ /* from ff */
+ lua_pushnumber(L, (double) (((n<<16)>>(16+14)) + ((n&0x3fff)/16384.0)));
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_read2dot14(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if ((p + 1) >= l) {
+ lua_pushnil(L);
+ } else {
+ int a = uchar(s[p++]);
+ int b = uchar(s[p]);
+ int n = 0x100 * a + b; /* really an int because we shift */
+ lua_pushnumber(L, (double) (((n<<16)>>(16+14)) + ((n&0x3fff)/16384.0)));
+ }
+ return 1;
+}
+
+static int fiolib_getposition(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ long p = ftell(f);
+ if (p < 0) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, p);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_setposition(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ long p = lmt_tolong(L, 2);
+ p = fseek(f, p, SEEK_SET);
+ if (p < 0) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, p);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_skipposition(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ long p = lmt_tolong(L, 2);
+ p = fseek(f, ftell(f) + p, SEEK_SET);
+ if (p < 0) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, p);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int fiolib_readbytetable(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ lua_createtable(L, (int) n, 0);
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ break;
+ } else {
+ /*
+ lua_pushinteger(L, i);
+ lua_pushinteger(L, a);
+ lua_rawset(L, -3);
+ */
+ lua_pushinteger(L, a);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readbytetable(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer n = lua_tointeger(L, 3);
+ lua_Integer l = (lua_Integer) ls;
+ if (p >= l) {
+ lua_pushnil(L);
+ } else {
+ if (p + n >= l) {
+ n = l - p ;
+ }
+ lua_createtable(L, (int) n, 0);
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = uchar(s[p++]);
+ lua_pushinteger(L, a);
+ lua_rawseti(L, -2, i);
+ }
+ }
+ return 1;
+}
+
+static int fiolib_readbytes(lua_State *L) {
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = getc(f);
+ if (a == EOF) {
+ return (int) (i - 1);
+ } else {
+ lua_pushinteger(L, a);
+ }
+ }
+ return (int) n;
+ } else {
+ return 0;
+ }
+}
+
+static int siolib_readbytes(lua_State *L) {
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer n = lua_tointeger(L, 3);
+ lua_Integer l = (lua_Integer) ls;
+ if (p >= l) {
+ return 0;
+ } else {
+ if (p + n >= l) {
+ n = l - p ;
+ }
+ lua_createtable(L, (int) n, 0);
+ for (lua_Integer i = 1; i <= n; i++) {
+ lua_Integer a = uchar(s[p++]);
+ lua_pushinteger(L, a);
+ }
+ return (int) n;
+ }
+}
+
+static int fiolib_readcline(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ luaL_Buffer buf;
+ int c;
+ int n = 0;
+ luaL_buffinit(L, &buf);
+ do {
+ char *b = luaL_prepbuffer(&buf);
+ int i = 0;
+ while (i < LUAL_BUFFERSIZE) {
+ c = fgetc(f);
+ if (c == '\n') {
+ goto GOOD;
+ } else if (c == '\r') {
+ c = fgetc(f);
+ if (c != EOF && c != '\n') {
+ ungetc((int) c, f);
+ }
+ goto GOOD;
+ } else {
+ n++;
+ b[i++] = (char) c;
+ }
+ }
+ } while (c != EOF);
+ goto BAD;
+ GOOD:
+ if (n > 0) {
+ luaL_addsize(&buf, n);
+ luaL_pushresult(&buf);
+ } else {
+ lua_pushnil(L);
+ }
+ lua_pushinteger(L, ftell(f));
+ return 2;
+ }
+ BAD:
+ lua_pushnil(L);
+ return 1;
+}
+
+
+static int siolib_readcline(lua_State *L)
+{
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if (p < l) {
+ lua_Integer i = p;
+ int n = 0;
+ while (p < l) {
+ int c = uchar(s[p++]);
+ if (c == '\n') {
+ goto GOOD;
+ } else if (c == '\r') {
+ if (p < l) {
+ c = uchar(s[p++]);
+ if (c != EOF && c != '\n') {
+ --p;
+ }
+ }
+ goto GOOD;
+ } else {
+ n++;
+ }
+ }
+ goto BAD;
+ GOOD:
+ if (n > 0) {
+ lua_pushlstring(L, &s[i], n);
+ lua_pushinteger(L, p);
+ return 2;
+ }
+ }
+ BAD:
+ lua_pushnil(L);
+ lua_pushinteger(L, p + 1);
+ return 2;
+}
+
+static int fiolib_readcstring(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ luaL_Buffer buf;
+ int c;
+ int n = 0;
+ luaL_buffinit(L, &buf);
+ do {
+ char *b = luaL_prepbuffer(&buf);
+ int i = 0;
+ while (i < LUAL_BUFFERSIZE) {
+ c = fgetc(f);
+ if (c == '\0') {
+ goto GOOD;
+ } else {
+ n++;
+ b[i++] = (char) c;
+ }
+ }
+ } while (c != EOF);
+ goto BAD;
+ GOOD:
+ if (n > 0) {
+ luaL_addsize(&buf, n);
+ luaL_pushresult(&buf);
+ } else {
+ lua_pushliteral(L,"");
+ }
+ lua_pushinteger(L, ftell(f));
+ return 2;
+ }
+ BAD:
+ lua_pushnil(L);
+ return 1;
+}
+
+static int siolib_readcstring(lua_State *L)
+{
+ size_t ls = 0;
+ const char *s = luaL_checklstring(L, 1, &ls);
+ lua_Integer p = luaL_checkinteger(L, 2) - 1;
+ lua_Integer l = (lua_Integer) ls;
+ if (p < l) {
+ lua_Integer i = p;
+ int n = 0;
+ while (p < l) {
+ int c = uchar(s[p++]);
+ if (c == '\0') {
+ goto GOOD;
+ } else {
+ n++;
+ }
+ };
+ goto BAD;
+ GOOD:
+ if (n > 0) {
+ lua_pushlstring(L, &s[i], n);
+ } else {
+ lua_pushliteral(L,"");
+ }
+ lua_pushinteger(L, p + 1);
+ return 2;
+ }
+ BAD:
+ lua_pushnil(L);
+ lua_pushinteger(L, p + 1);
+ return 2;
+}
+
+/* will be completed */
+
+static int fiolib_writecardinal1(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc(n & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal1(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[1] = { n & 0xFF };
+ lua_pushlstring(L, buffer, 1);
+ return 1;
+}
+
+static int fiolib_writecardinal2(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc((n >> 8) & 0xFF, f);
+ putc( n & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal2(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[2] = { (n >> 8) & 0xFF, n & 0xFF };
+ lua_pushlstring(L, buffer, 2);
+ return 1;
+}
+
+static int fiolib_writecardinal2_le(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc( n & 0xFF, f);
+ putc((n >> 8) & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal2_le(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[2] = { n & 0xFF, (n >> 8) & 0xFF };
+ lua_pushlstring(L, buffer, 2);
+ return 1;
+}
+
+static int fiolib_writecardinal3(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc((n >> 16) & 0xFF, f);
+ putc((n >> 8) & 0xFF, f);
+ putc( n & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal3(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[3] = { (n >> 16) & 0xFF, (n >> 8) & 0xFF, n & 0xFF };
+ lua_pushlstring(L, buffer, 3);
+ return 1;
+}
+
+
+static int fiolib_writecardinal3_le(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc( n & 0xFF, f);
+ putc((n >> 8) & 0xFF, f);
+ putc((n >> 16) & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal3_le(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[3] = { n & 0xFF, (n >> 8) & 0xFF, (n >> 16) & 0xFF };
+ lua_pushlstring(L, buffer, 3);
+ return 1;
+}
+
+static int fiolib_writecardinal4(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc((n >> 24) & 0xFF, f);
+ putc((n >> 16) & 0xFF, f);
+ putc((n >> 8) & 0xFF, f);
+ putc( n & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal4(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[4] = { (n >> 24) & 0xFF, (n >> 16) & 0xFF, (n >> 8) & 0xFF, n & 0xFF };
+ lua_pushlstring(L, buffer, 4);
+ return 1;
+}
+
+static int fiolib_writecardinal4_le(lua_State *L)
+{
+ FILE *f = lmt_valid_file(L);
+ if (f) {
+ lua_Integer n = lua_tointeger(L, 2);
+ putc( n & 0xFF, f);
+ putc((n >> 8) & 0xFF, f);
+ putc((n >> 16) & 0xFF, f);
+ putc((n >> 24) & 0xFF, f);
+ }
+ return 0;
+}
+
+static int siolib_tocardinal4_le(lua_State *L)
+{
+ lua_Integer n = lua_tointeger(L, 1);
+ char buffer[4] = { n & 0xFF, (n >> 8) & 0xFF, (n >> 16) & 0xFF, (n >> 24) & 0xFF };
+ lua_pushlstring(L, buffer, 4);
+ return 1;
+}
+
+/* */
+
+static const luaL_Reg fiolib_function_list[] = {
+ /* helpers */
+
+ { "readcardinal1", fiolib_readcardinal1 },
+ { "readcardinal2", fiolib_readcardinal2 },
+ { "readcardinal3", fiolib_readcardinal3 },
+ { "readcardinal4", fiolib_readcardinal4 },
+
+ { "readcardinal1le", fiolib_readcardinal1 },
+ { "readcardinal2le", fiolib_readcardinal2_le },
+ { "readcardinal3le", fiolib_readcardinal3_le },
+ { "readcardinal4le", fiolib_readcardinal4_le },
+
+ { "readcardinaltable", fiolib_readcardinaltable },
+
+ { "readinteger1", fiolib_readinteger1 },
+ { "readinteger2", fiolib_readinteger2 },
+ { "readinteger3", fiolib_readinteger3 },
+ { "readinteger4", fiolib_readinteger4 },
+
+ { "readinteger1le", fiolib_readinteger1 },
+ { "readinteger2le", fiolib_readinteger2_le },
+ { "readinteger3le", fiolib_readinteger3_le },
+ { "readinteger4le", fiolib_readinteger4_le },
+
+ { "readintegertable", fiolib_readintegertable },
+
+ { "readfixed2", fiolib_readfixed2 },
+ { "readfixed4", fiolib_readfixed4 },
+
+ { "read2dot14", fiolib_read2dot14 },
+
+ { "setposition", fiolib_setposition },
+ { "getposition", fiolib_getposition },
+ { "skipposition", fiolib_skipposition },
+
+ { "readbytes", fiolib_readbytes },
+ { "readbytetable", fiolib_readbytetable },
+
+ { "readcline", fiolib_readcline },
+ { "readcstring", fiolib_readcstring },
+
+ { "writecardinal1", fiolib_writecardinal1 },
+ { "writecardinal2", fiolib_writecardinal2 },
+ { "writecardinal3", fiolib_writecardinal3 },
+ { "writecardinal4", fiolib_writecardinal4 },
+
+ { "writecardinal1le", fiolib_writecardinal1 },
+ { "writecardinal2le", fiolib_writecardinal2_le },
+ { "writecardinal3le", fiolib_writecardinal3_le },
+ { "writecardinal4le", fiolib_writecardinal4_le },
+
+ { NULL, NULL }
+};
+
+static const luaL_Reg siolib_function_list[] = {
+
+ { "readcardinal1", siolib_readcardinal1 },
+ { "readcardinal2", siolib_readcardinal2 },
+ { "readcardinal3", siolib_readcardinal3 },
+ { "readcardinal4", siolib_readcardinal4 },
+
+ { "readcardinal1le", siolib_readcardinal1 },
+ { "readcardinal2le", siolib_readcardinal2_le },
+ { "readcardinal3le", siolib_readcardinal3_le },
+ { "readcardinal4le", siolib_readcardinal4_le },
+
+ { "readcardinaltable", siolib_readcardinaltable },
+
+ { "readinteger1", siolib_readinteger1 },
+ { "readinteger2", siolib_readinteger2 },
+ { "readinteger3", siolib_readinteger3 },
+ { "readinteger4", siolib_readinteger4 },
+
+ { "readinteger1le", siolib_readinteger1 },
+ { "readinteger2le", siolib_readinteger2_le },
+ { "readinteger3le", siolib_readinteger3_le },
+ { "readinteger4le", siolib_readinteger4_le },
+
+ { "readintegertable", siolib_readintegertable },
+
+ { "readfixed2", siolib_readfixed2 },
+ { "readfixed4", siolib_readfixed4 },
+ { "read2dot14", siolib_read2dot14 },
+
+ { "readbytes", siolib_readbytes },
+ { "readbytetable", siolib_readbytetable },
+
+ { "readcline", siolib_readcline },
+ { "readcstring", siolib_readcstring },
+
+ { "tocardinal1", siolib_tocardinal1 },
+ { "tocardinal2", siolib_tocardinal2 },
+ { "tocardinal3", siolib_tocardinal3 },
+ { "tocardinal4", siolib_tocardinal4 },
+
+ { "tocardinal1le", siolib_tocardinal1 },
+ { "tocardinal2le", siolib_tocardinal2_le },
+ { "tocardinal3le", siolib_tocardinal3_le },
+ { "tocardinal4le", siolib_tocardinal4_le },
+
+ { NULL, NULL }
+};
+
+/*tex
+
+ The sio helpers might be handy at some point. Speed-wise there is no gain over file access
+ because with ssd and caching we basically operate in memory too. We keep them as complement to
+ the file ones. I did consider using an userdata object for the position etc but some simple
+ tests demonstrated that there is no real gain and the current ones permits to wrap up whatever
+ interface one likes.
+
+*/
+
+int luaopen_fio(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, fiolib_function_list, 0);
+ return 1;
+}
+
+int luaopen_sio(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, siolib_function_list, 0);
+ return 1;
+}
+
+/* We patch a function in the standard |io| library. */
+
+/*tex
+
+ The following code overloads the |io.open| function to deal with so called wide characters on
+ windows.
+
+*/
+
+# if _WIN32
+
+# define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE))
+
+ static int l_checkmode(const char *mode) {
+ return (
+ *mode != '\0'
+ && strchr("rwa", *(mode++))
+ && (*mode != '+' || ((void)(++mode), 1))
+ && (strspn(mode, "b") == strlen(mode))
+ );
+ }
+
+ typedef luaL_Stream LStream;
+
+ static LStream *newprefile(lua_State *L) {
+ LStream *p = (LStream *)lua_newuserdatauv(L, sizeof(LStream), 0);
+ p->closef = NULL;
+ luaL_setmetatable(L, LUA_FILEHANDLE);
+ return p;
+ }
+
+ static int io_fclose(lua_State *L) {
+ LStream *p = tolstream(L);
+ int res = fclose(p->f);
+ return luaL_fileresult(L, (res == 0), NULL);
+ }
+
+ static LStream *newfile(lua_State *L) {
+ /*tex Watch out: lua 5.4 has different closers. */
+ LStream *p = newprefile(L);
+ p->f = NULL;
+ p->closef = &io_fclose;
+ return p;
+ }
+
+ static int io_open(lua_State *L)
+ {
+ const char *filename = luaL_checkstring(L, 1);
+ const char *mode = luaL_optstring(L, 2, "r");
+ LStream *p = newfile(L);
+ const char *md = mode; /* to traverse/check mode */
+ luaL_argcheck(L, l_checkmode(md), 2, "invalid mode");
+ p->f = aux_utf8_fopen(filename, mode);
+ return (p->f) ? 1 : luaL_fileresult(L, 0, filename);
+ }
+
+ static int io_pclose(lua_State *L) {
+ LStream *p = tolstream(L);
+ return luaL_execresult(L, _pclose(p->f));
+ }
+
+ static int io_popen(lua_State *L)
+ {
+ const char *filename = luaL_checkstring(L, 1);
+ const char *mode = luaL_optstring(L, 2, "r");
+ LStream *p = newprefile(L);
+ p->f = aux_utf8_popen(filename, mode);
+ p->closef = &io_pclose;
+ return (p->f) ? 1 : luaL_fileresult(L, 0, filename);
+ }
+
+ int luaextend_io(lua_State *L)
+ {
+ lua_getglobal(L, "io");
+ lua_pushcfunction(L, io_open); lua_setfield(L, -2, "open");
+ lua_pushcfunction(L, io_popen); lua_setfield(L, -2, "popen");
+ lua_pop(L, 1);
+ /*tex
+ Larger doesn't work and limits to 512 but then no amount is okay as there's always more
+ to demand.
+ */
+ _setmaxstdio(2048);
+ return 1;
+ }
+
+# else
+
+ int luaextend_io(lua_State *L)
+ {
+ (void) L;
+ return 1;
+ }
+
+# endif
diff --git a/source/luametatex/source/luarest/lmtmd5lib.c b/source/luametatex/source/luarest/lmtmd5lib.c
new file mode 100644
index 000000000..2355b53ce
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtmd5lib.c
@@ -0,0 +1,88 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include <ctype.h>
+
+# include <utilmd5.h>
+# include <utiliof.h>
+# include <utilbasexx.h>
+
+# include "luametatex.h"
+
+/*
+# define wrapped_md5(message,len,output) md5_digest(message,len,(unsigned char *) output, 0)
+
+static int md5lib_sum(lua_State *L)
+{
+ char buf[16];
+ size_t l;
+ const char *message = luaL_checklstring(L, 1, &l);
+ wrapped_md5(message, l, buf);
+ lua_pushlstring(L, buf, 16L);
+ return 1;
+}
+
+static int md5lib_hex(lua_State *L)
+{
+ char buf[16];
+ char hex[32];
+ iof *inp = iof_filter_string_reader(buf, 16);
+ iof *out = iof_filter_string_writer(hex, 32);
+ size_t l;
+ const char *message = luaL_checklstring(L, 1, &l);
+ wrapped_md5(message, l, buf);
+ base16_encode_lc(inp, out);
+ lua_pushlstring(L, hex, iof_size(out));
+ iof_free(inp);
+ iof_free(out);
+ return 1;
+}
+
+static int md5lib_HEX(lua_State *L)
+{
+ char buf[16];
+ char hex[32];
+ iof *inp = iof_filter_string_reader(buf, 16);
+ iof *out = iof_filter_string_writer(hex, 32);
+ size_t l;
+ const char *message = luaL_checklstring(L, 1, &l);
+ wrapped_md5(message, l, buf);
+ base16_encode_uc(inp, out);
+ lua_pushlstring(L, hex, iof_size(out));
+ iof_free(inp);
+ iof_free(out);
+ return 1;
+}
+*/
+
+# define MD5_RESULT_LENGTH (MD5_STRING_LENGTH-1)
+
+# define md5_body(MD5_LENGTH, CONVERSION, RESULT_LENGTH) do { \
+ if (lua_type(L, 1) == LUA_TSTRING) { \
+ uint8_t result[MD5_LENGTH]; \
+ size_t size = 0; \
+ const char *data = lua_tolstring(L, 1, &size); \
+ md5_digest(data, size, (unsigned char *) result, CONVERSION); \
+ lua_pushlstring(L, (const char *)result, RESULT_LENGTH); \
+ return 1; \
+ } \
+ return 0; \
+} while (0)
+
+static int md5lib_sum(lua_State *L) { md5_body(MD5_DIGEST_LENGTH, MD5_BYTES, MD5_DIGEST_LENGTH); }
+static int md5lib_hex(lua_State *L) { md5_body(MD5_STRING_LENGTH, MD5_LCHEX, MD5_RESULT_LENGTH); }
+static int md5lib_HEX(lua_State *L) { md5_body(MD5_STRING_LENGTH, MD5_UCHEX, MD5_RESULT_LENGTH); }
+
+static struct luaL_Reg md5lib_function_list[] = {
+ { "sum", md5lib_sum },
+ { "hex", md5lib_hex },
+ { "HEX", md5lib_HEX },
+ { NULL, NULL },
+};
+
+int luaopen_md5(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, md5lib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtoslibext.c b/source/luametatex/source/luarest/lmtoslibext.c
new file mode 100644
index 000000000..74cbfad9e
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtoslibext.c
@@ -0,0 +1,430 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+# if defined (_WIN32)
+# define MKDIR(a,b) mkdir(a)
+# else
+# define MKDIR(a,b) mkdir(a,b)
+# endif
+
+/*tex
+
+ An attempt to figure out the basic platform, does not care about niceties like version numbers
+ yet, and ignores platforms where \LUATEX\ is unlikely to successfully compile without major
+ porting effort (amiga,mac,os2,vms). We dropped solaris, cygwin, hpux, iris, sysv, dos, djgpp
+ etc. Basically we have either a windows or some kind of unix brand.
+
+*/
+
+# ifdef _WIN32
+# define OSLIB_PLATTYPE "windows"
+# define OSLIB_PLATNAME "windows"
+# else
+# include <sys/param.h>
+# include <sys/utsname.h>
+# if defined(__linux__) || defined (__gnu_linux__)
+# define OSLIB_PLATNAME "linux"
+# elif defined(__MACH__) && defined(__APPLE__)
+# define OSLIB_PLATNAME "macosx"
+# elif defined(__FreeBSD__)
+# define OSLIB_PLATNAME "freebsd"
+# elif defined(__OpenBSD__)
+# define OSLIB_PLATNAME "openbsd"
+# elif defined(__BSD__)
+# define OSLIB_PLATNAME "bsd"
+# elif defined(__GNU__)
+# define OSLIB_PLATNAME "gnu"
+# else
+# define OSLIB_PLATNAME "generic"
+# endif
+# define OSLIB_PLATTYPE "unix"
+# endif
+
+/*tex
+
+ There could be more platforms that don't have these two, but win32 and sunos are for sure.
+ |gettimeofday()| for win32 is using an alternative definition
+
+*/
+
+# ifndef _WIN32
+# include <sys/time.h> /*tex for |gettimeofday()| */
+# include <sys/times.h> /*tex for |times()| */
+# include <sys/wait.h>
+# endif
+
+static int oslib_sleep(lua_State *L)
+{
+ lua_Number interval = luaL_checknumber(L, 1);
+ lua_Number units = luaL_optnumber(L, 2, 1);
+# ifdef _WIN32
+ Sleep((DWORD) (1e3 * interval / units));
+# else /* assumes posix or bsd */
+ usleep((unsigned) (1e6 * interval / units));
+# endif
+ return 0;
+}
+
+# ifdef _WIN32
+
+ # define _UTSNAME_LENGTH 65
+
+ /*tex Structure describing the system and machine. */
+
+ typedef struct utsname {
+ char sysname [_UTSNAME_LENGTH];
+ char nodename[_UTSNAME_LENGTH];
+ char release [_UTSNAME_LENGTH];
+ char version [_UTSNAME_LENGTH];
+ char machine [_UTSNAME_LENGTH];
+ } utsname;
+
+ /*tex Get name and information about current kernel. */
+
+ /*tex
+
+ \starttabulate[|T|r|]
+ \NC Windows 10 \NC 10.0 \NC \NR
+ \NC Windows Server 2016 \NC 10.0 \NC \NR
+ \NC Windows 8.1 \NC 6.3 \NC \NR
+ \NC Windows Server 2012 R2 \NC 6.3 \NC \NR
+ \NC Windows 8 \NC 6.2 \NC \NR
+ \NC Windows Server 2012 \NC 6.2 \NC \NR
+ \NC Windows 7 \NC 6.1 \NC \NR
+ \NC Windows Server 2008 R2 \NC 6.1 \NC \NR
+ \NC Windows Server 2008 \NC 6.0 \NC \NR
+ \NC Windows Vista \NC 6.0 \NC \NR
+ \NC Windows Server 2003 R2 \NC 5.2 \NC \NR
+ \NC Windows Server 2003 \NC 5.2 \NC \NR
+ \NC Windows XP 64-Bit Edition \NC 5.2 \NC \NR
+ \NC Windows XP \NC 5.1 \NC \NR
+ \NC Windows 2000 \NC 5.0 \NC \NR
+ \stoptabulate
+
+ */
+
+ static int uname(struct utsname *uts)
+ {
+ OSVERSIONINFO osver;
+ SYSTEM_INFO sysinfo;
+ DWORD sLength;
+ memset(uts, 0, sizeof(*uts));
+ osver.dwOSVersionInfoSize = sizeof(osver);
+ GetVersionEx(&osver);
+ GetSystemInfo(&sysinfo);
+ strcpy(uts->sysname, "Windows");
+ sprintf(uts->version, "%ld.%02ld", osver.dwMajorVersion, osver.dwMinorVersion);
+ if (osver.szCSDVersion[0] != '\0' && (strlen(osver.szCSDVersion) + strlen(uts->version) + 1) < sizeof(uts->version)) {
+ strcat(uts->version, " ");
+ strcat(uts->version, osver.szCSDVersion);
+ }
+ sprintf(uts->release, "build %ld", osver.dwBuildNumber & 0xFFFF);
+ switch (sysinfo.wProcessorArchitecture) {
+ case PROCESSOR_ARCHITECTURE_AMD64:
+ strcpy(uts->machine, "x86_64");
+ break;
+# ifdef PROCESSOR_ARCHITECTURE_ARM64
+ case PROCESSOR_ARCHITECTURE_ARM64:
+ strcpy(uts->machine, "arm64");
+ break;
+# endif
+ case PROCESSOR_ARCHITECTURE_INTEL:
+ strcpy(uts->machine, "i386");
+ break;
+ default:
+ strcpy(uts->machine, "unknown");
+ break;
+ }
+ sLength = sizeof(uts->nodename) - 1;
+ GetComputerName(uts->nodename, &sLength);
+ return 0;
+ }
+
+# endif
+
+static int oslib_uname(lua_State *L)
+{
+ struct utsname uts;
+ if (uname(&uts) >= 0) {
+ lua_createtable(L,0,5);
+ lua_pushstring(L, uts.sysname);
+ lua_setfield(L, -2, "sysname");
+ lua_pushstring(L, uts.machine);
+ lua_setfield(L, -2, "machine");
+ lua_pushstring(L, uts.release);
+ lua_setfield(L, -2, "release");
+ lua_pushstring(L, uts.version);
+ lua_setfield(L, -2, "version");
+ lua_pushstring(L, uts.nodename);
+ lua_setfield(L, -2, "nodename");
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+# if defined(_MSC_VER) || defined(_MSC_EXTENSIONS)
+ # define DELTA_EPOCH_IN_MICROSECS 11644473600000000Ui64
+# else
+ # define DELTA_EPOCH_IN_MICROSECS 11644473600000000ULL
+# endif
+
+# ifdef _WIN32
+
+ # ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
+ # define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x04
+ # endif
+
+ static int oslib_gettimeofday(lua_State *L)
+ {
+ FILETIME ft;
+ __int64 tmpres = 0;
+ GetSystemTimeAsFileTime(&ft);
+ tmpres |= ft.dwHighDateTime;
+ tmpres <<= 32;
+ tmpres |= ft.dwLowDateTime;
+ tmpres /= 10;
+ /*tex Convert file time to unix epoch: */
+ tmpres -= DELTA_EPOCH_IN_MICROSECS;
+ /*tex Float: */
+ lua_pushnumber(L, (double) tmpres / 1000000.0);
+ return 1;
+ }
+
+ static int oslib_enableansi(lua_State *L)
+ {
+ HANDLE handle = GetStdHandle(STD_OUTPUT_HANDLE);
+ DWORD mode = 0;
+ int done = 0;
+ if (GetConsoleMode(handle, &mode)) {
+ mode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
+ if (SetConsoleMode(handle, mode)) {
+ done = 1;
+ } else {
+ /* bad */
+ }
+ }
+ lua_pushboolean(L, done);
+ return 1;
+ }
+
+# else
+
+ static int oslib_gettimeofday(lua_State *L)
+ {
+ double v;
+ struct timeval tv;
+ gettimeofday(&tv, NULL);
+ v = (double) tv.tv_sec + (double) tv.tv_usec / 1000000.0;
+ /*tex Float: */
+ lua_pushnumber(L, v);
+ return 1;
+ }
+
+ static int oslib_enableansi(lua_State *L)
+ {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+
+# endif
+
+/*tex Historically we have a different os.execute than Lua! */
+
+static int oslib_execute(lua_State *L)
+{
+ const char *cmd = luaL_optstring(L, 1, NULL);
+ if (cmd) {
+ lua_pushinteger(L, aux_utf8_system(cmd) || lmt_error_state.default_exit_code);
+ } else {
+ lua_pushinteger(L, 0);
+ }
+ return 1;
+}
+
+# ifdef _WIN32
+
+ static int oslib_remove (lua_State *L)
+ {
+ const char *filename = luaL_checkstring(L, 1);
+ return luaL_fileresult(L, aux_utf8_remove(filename) == 0, filename);
+ }
+
+ static int oslib_rename (lua_State *L)
+ {
+ const char *fromname = luaL_checkstring(L, 1);
+ const char *toname = luaL_checkstring(L, 2);
+ return luaL_fileresult(L, aux_utf8_rename(fromname, toname) == 0, NULL);
+ }
+
+ static int oslib_getcodepage(lua_State *L)
+ {
+ lua_pushinteger(L, (int) GetOEMCP());
+ lua_pushinteger(L, (int) GetACP());
+ return 2;
+ }
+
+ /*
+ static int oslib_getenv(lua_State *L) {
+ LPWSTR wkey = utf8_to_wide(luaL_checkstring(L, 1));
+ char * val = wide_to_utf8(_wgetenv(wkey));
+ lmt_memory_free(wkey);
+ lua_pushstring(L, val);
+ lmt_memory_free(val);
+ return 1;
+ }
+ */
+
+ static int oslib_getenv(lua_State *L)
+ {
+ const char *key = luaL_checkstring(L, 1);
+ char* val = NULL;
+ if (key) {
+ size_t wlen = 0;
+ LPWSTR wkey = aux_utf8_to_wide(key);
+ _wgetenv_s(&wlen, NULL, 0, wkey);
+ if (wlen) {
+ LPWSTR wval = (LPWSTR) lmt_memory_malloc(wlen * sizeof(WCHAR));
+ if (!_wgetenv_s(&wlen, wval, wlen, wkey)) {
+ val = aux_utf8_from_wide(wval);
+ }
+ }
+ }
+ if (val) {
+ lua_pushstring(L, val);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+ }
+
+ static int oslib_setenv(lua_State *L)
+ {
+ const char *key = luaL_optstring(L, 1, NULL);
+ if (key) {
+ LPWSTR wkey = aux_utf8_to_wide(key);
+ const char *val = luaL_optstring(L, 2, NULL);
+ if (val) {
+ LPWSTR wval = aux_utf8_to_wide(val);
+ if (_wputenv_s(wkey, wval)) {
+ return luaL_error(L, "unable to change environment");
+ }
+ lmt_memory_free(wval);
+ } else {
+ if (_wputenv_s(wkey, NULL)) {
+ return luaL_error(L, "unable to change environment");
+ }
+ }
+ lmt_memory_free(wkey);
+ }
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+
+# else
+
+ static int oslib_getcodepage(lua_State *L)
+ {
+ lua_pushboolean(L,0);
+ lua_pushboolean(L,0);
+ return 2;
+ }
+
+ static int oslib_setenv(lua_State *L)
+ {
+ const char *key = luaL_optstring(L, 1, NULL);
+ if (key) {
+ const char *val = luaL_optstring(L, 2, NULL);
+ if (val) {
+ char *value = lmt_memory_malloc((unsigned) (strlen(key) + strlen(val) + 2));
+ sprintf(value, "%s=%s", key, val);
+ if (putenv(value)) {
+ /* lmt_memory_free(value); */ /* valgrind reports some issue otherwise */
+ return luaL_error(L, "unable to change environment");
+ } else {
+ /* lmt_memory_free(value); */ /* valgrind reports some issue otherwise */
+ }
+ } else {
+ (void) unsetenv(key);
+ }
+ }
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+
+# endif
+
+static const luaL_Reg oslib_function_list[] = {
+ { "sleep", oslib_sleep },
+ { "uname", oslib_uname },
+ { "gettimeofday", oslib_gettimeofday },
+ { "setenv", oslib_setenv },
+ { "execute", oslib_execute },
+# ifdef _WIN32
+ { "rename", oslib_rename },
+ { "remove", oslib_remove },
+ { "getenv", oslib_getenv },
+# endif
+ { "enableansi", oslib_enableansi },
+ { "getcodepage", oslib_getcodepage },
+ { NULL, NULL },
+};
+
+
+/*tex
+ The |environ| variable is depricated on windows so it made sense to just drop this old \LUATEX\
+ feature.
+*/
+
+# ifndef _WIN32
+ extern char **environ;
+# else
+ # define environ _environ
+# endif
+
+int luaextend_os(lua_State *L)
+{
+ /*tex We locate the library: */
+ lua_getglobal(L, "os");
+ /*tex A few constant strings: */
+ lua_pushliteral(L, OSLIB_PLATTYPE);
+ lua_setfield(L, -2, "type");
+ lua_pushliteral(L, OSLIB_PLATNAME);
+ lua_setfield(L, -2, "name");
+ /*tex The extra functions: */
+ for (const luaL_Reg *lib = oslib_function_list; lib->name; lib++) {
+ lua_pushcfunction(L, lib->func);
+ lua_setfield(L, -2, lib->name);
+ }
+ /*tex Environment variables: */
+ if (0) {
+ char **envpointer = environ; /*tex Provided by the standard library. */
+ if (envpointer) {
+ lua_pushstring(L, "env");
+ lua_newtable(L);
+ while (*envpointer) {
+ /* TODO: perhaps a memory leak here */
+ char *envitem = lmt_memory_strdup(*envpointer);
+ char *envitem_orig = envitem;
+ char *envkey = envitem;
+ while (*envitem != '=') {
+ envitem++;
+ }
+ *envitem = 0;
+ envitem++;
+ lua_pushstring(L, envkey);
+ lua_pushstring(L, envitem);
+ lua_rawset(L, -3);
+ envpointer++;
+ lmt_memory_free(envitem_orig);
+ }
+ lua_rawset(L, -3);
+ }
+ }
+ /*tex Done. */
+ lua_pop(L, 1);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtpdfelib.c b/source/luametatex/source/luarest/lmtpdfelib.c
new file mode 100644
index 000000000..b22626749
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtpdfelib.c
@@ -0,0 +1,1850 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This file hosts the encapsulated \PDF\ support code used for inclusion and access from \LUA.
+
+*/
+
+# include "luametatex.h"
+
+// # define PDFE_METATABLE_INSTANCE "pdfe.instance"
+// # define PDFE_METATABLE_DICTIONARY "pdfe.dictionary"
+// # define PDFE_METATABLE_ARRAY "pdfe.array"
+// # define PDFE_METATABLE_STREAM "pdfe.stream"
+// # define PDFE_METATABLE_REFERENCE "pdfe.reference"
+
+# include "../libraries/pplib/pplib.h"
+
+/*tex
+
+ We start with some housekeeping. Dictionaries, arrays, streams and references get userdata,
+ while strings, names, integers, floats and booleans become regular \LUA\ objects. We need to
+ define a few metatable identifiers too.
+
+*/
+
+typedef struct pdfe_document {
+ ppdoc *document;
+ int open;
+ int isfile;
+ char *memstream;
+ int pages;
+ int index;
+} pdfe_document ;
+
+typedef struct pdfe_dictionary {
+ ppdict *dictionary;
+} pdfe_dictionary;
+
+typedef struct pdfe_array {
+ pparray *array;
+} pdfe_array;
+
+typedef struct pdfe_stream {
+ ppstream *stream;
+ int decode;
+ int open;
+} pdfe_stream;
+
+typedef struct pdfe_reference {
+ /* ppref *reference; */
+ ppxref *xref;
+ int onum;
+} pdfe_reference;
+
+/*tex
+
+ We need to check if we have the right userdata. A similar warning is issued when encounter a
+ problem. We don't exit.
+
+*/
+
+static void pdfe_invalid_object_warning(const char *detail)
+{
+ tex_formatted_warning("pdfe lib", "lua <pdfe %s> expected",detail);
+}
+
+/* todo: use luaL_checkudata */
+
+static pdfe_document *pdfelib_aux_check_isdocument(lua_State *L, int n)
+{
+ pdfe_document *p = (pdfe_document *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(pdfe_instance);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ pdfe_invalid_object_warning("document");
+ return NULL;
+}
+
+static pdfe_dictionary *pdfelib_aux_check_isdictionary(lua_State *L, int n)
+{
+ pdfe_dictionary *p = (pdfe_dictionary *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(pdfe_dictionary);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ pdfe_invalid_object_warning("dictionary");
+ return NULL;
+}
+
+static pdfe_array *pdfelib_aux_check_isarray(lua_State *L, int n)
+{
+ pdfe_array *p = (pdfe_array *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(pdfe_array);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ pdfe_invalid_object_warning("array");
+ return NULL;
+}
+
+static pdfe_stream *pdfelib_aux_check_isstream(lua_State *L, int n)
+{
+ pdfe_stream *p = (pdfe_stream *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(pdfe_stream);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ pdfe_invalid_object_warning("stream");
+ return NULL;
+}
+
+static pdfe_reference *pdfelib_aux_check_isreference(lua_State *L, int n)
+{
+ pdfe_reference *p = (pdfe_reference *) lua_touserdata(L, n);
+ if (p && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(pdfe_reference);
+ if (! lua_rawequal(L, -1, -2)) {
+ p = NULL;
+ }
+ lua_pop(L, 2);
+ if (p) {
+ return p;
+ }
+ }
+ pdfe_invalid_object_warning("reference");
+ return NULL;
+}
+
+/*tex
+
+ Reporting the type of a userdata is just a sequence of tests till we find the right one. We
+ return nothing is it is no pdfe type.
+
+ \starttyping
+ t = pdfe.type(<pdfe document|dictionary|array|reference|stream>)
+ \stoptyping
+
+*/
+
+/*
+# define check_type(field,meta,name) do { \
+ lua_get_metatablelua(meta); \
+ if (lua_rawequal(L, -1, -2)) { \
+ lua_pushstring(L, name); \
+ return 1; \
+ } \
+ lua_pop(L, 1); \
+} while (0)
+
+static int pdfelib_type(lua_State *L)
+{
+ void *p = lua_touserdata(L, 1);
+ if (p && lua_getmetatable(L, 1)) {
+ check_type(document, pdfe_instance, PDFE_METATABLE_INSTANCE);
+ check_type(dictionary, pdfe_dictionary, PDFE_METATABLE_DICTIONARY);
+ check_type(array, pdfe_array, PDFE_METATABLE_ARRAY);
+ check_type(reference, pdfe_reference, PDFE_METATABLE_REFERENCE);
+ check_type(stream, pdfe_stream, PDFE_METATABLE_STREAM);
+ }
+ return 0;
+}
+*/
+
+# define check_type(field,meta) do { \
+ lua_get_metatablelua(meta); \
+ if (lua_rawequal(L, -1, -2)) { \
+ lua_push_key(meta); \
+ return 1; \
+ } \
+ lua_pop(L, 1); \
+} while (0)
+
+static int pdfelib_type(lua_State *L)
+{
+ void *p = lua_touserdata(L, 1);
+ if (p && lua_getmetatable(L, 1)) {
+ check_type(document, pdfe_instance);
+ check_type(dictionary, pdfe_dictionary);
+ check_type(array, pdfe_array);
+ check_type(reference, pdfe_reference);
+ check_type(stream, pdfe_stream);
+ }
+ return 0;
+}
+
+/*tex
+
+ The \type {tostring} metamethods are similar and report a pdfe type plus a pointer value, as is
+ rather usual in \LUA. I ditched the macro that defined them and are now verbose.
+
+*/
+
+static int pdfelib_document_tostring(lua_State *L) {
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ lua_pushfstring(L, "<pdfe.document %p>", p->document);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_dictionary_tostring(lua_State *L) {
+ pdfe_dictionary *p = pdfelib_aux_check_isdictionary(L, 1);
+ if (p) {
+ lua_pushfstring(L, "<pdfe.dictionary %p>", p->dictionary);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_array_tostring(lua_State *L) {
+ pdfe_array *p = pdfelib_aux_check_isarray(L, 1);
+ if (p) {
+ lua_pushfstring(L, "<pdfe.array %p>", p->array);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_stream_tostring(lua_State *L) {
+ pdfe_stream *p = pdfelib_aux_check_isstream(L, 1);
+ if (p) {
+ lua_pushfstring(L, "<pdfe.stream %p>", p->stream);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_reference_tostring(lua_State *L) {
+ pdfe_reference *p = pdfelib_aux_check_isreference(L, 1);
+ if (p) {
+ lua_pushfstring(L, "<pdfe.reference %d>", p->onum);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ The pushers look rather similar. We have two variants, one that just pushes the object, and
+ another that also pushes some extra information.
+
+*/
+
+inline static void pdfe_push_dictionary(lua_State *L, ppdict *dictionary)
+{
+ pdfe_dictionary *d = (pdfe_dictionary *) lua_newuserdatauv(L, sizeof(pdfe_dictionary), 0);
+ luaL_getmetatable(L, PDFE_METATABLE_DICTIONARY);
+ lua_setmetatable(L, -2);
+ d->dictionary = dictionary;
+}
+
+static int pdfelib_aux_pushdictionary(lua_State *L, ppdict *dictionary)
+{
+ if (dictionary) {
+ pdfe_push_dictionary(L, dictionary);
+ lua_pushinteger(L, (lua_Integer) dictionary->size);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_aux_pushdictionaryonly(lua_State *L, ppdict *dictionary)
+{
+ if (dictionary) {
+ pdfe_push_dictionary(L, dictionary);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+inline static void pdfe_push_array(lua_State *L, pparray *array)
+{
+ pdfe_array *a = (pdfe_array *) lua_newuserdatauv(L, sizeof(pdfe_array), 0);
+ luaL_getmetatable(L, PDFE_METATABLE_ARRAY);
+ lua_setmetatable(L, -2);
+ a->array = array;
+}
+
+static int pdfelib_aux_pusharray(lua_State *L, pparray *array)
+{
+ if (array) {
+ pdfe_push_array(L, array);
+ lua_pushinteger(L, (lua_Integer) array->size);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_aux_pusharrayonly(lua_State *L, pparray *array)
+{
+ if (array) {
+ pdfe_push_array(L, array);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+inline static void pdfe_push_stream(lua_State *L, ppstream *stream)
+{
+ pdfe_stream *s = (pdfe_stream *) lua_newuserdatauv(L, sizeof(pdfe_stream), 0);
+ luaL_getmetatable(L, PDFE_METATABLE_STREAM);
+ lua_setmetatable(L, -2);
+ s->stream = stream;
+ s->open = 0;
+ s->decode = 0;
+}
+
+static int pdfelib_aux_pushstream(lua_State *L, ppstream *stream)
+{
+ if (stream) {
+ pdfe_push_stream(L, stream);
+ if (pdfelib_aux_pushdictionary(L, stream->dict) > 0) {
+ return 3;
+ } else {
+ return 1;
+ }
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_aux_pushstreamonly(lua_State *L, ppstream *stream)
+{
+ if (stream) {
+ pdfe_push_stream(L, stream);
+ if (pdfelib_aux_pushdictionaryonly(L, stream->dict) > 0) {
+ return 2;
+ } else {
+ return 1;
+ }
+ } else {
+ return 0;
+ }
+}
+
+inline static void pdfe_push_reference(lua_State *L, ppref *reference)
+{
+ pdfe_reference *r = (pdfe_reference *) lua_newuserdatauv(L, sizeof(pdfe_reference), 0);
+ luaL_getmetatable(L, PDFE_METATABLE_REFERENCE);
+ lua_setmetatable(L, -2);
+ r->xref = reference->xref;
+ r->onum = (int) reference->number;
+ }
+
+static int pdfelib_aux_pushreference(lua_State *L, ppref *reference)
+{
+ if (reference && reference->number != 0) {
+ pdfe_push_reference(L, reference);
+ lua_pushinteger(L, (lua_Integer) reference->number);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ The next function checks for the type and then pushes the matching data on the stack.
+
+ \starttabulate[|c|l|l|l|]
+ \BC type \BC meaning \BC value \BC detail \NC \NR
+ \NC \type {0} \NC none \NC nil \NC \NC \NR
+ \NC \type {1} \NC null \NC nil \NC \NC \NR
+ \NC \type {2} \NC boolean \NC boolean \NC \NC \NR
+ \NC \type {3} \NC boolean \NC integer \NC \NC \NR
+ \NC \type {4} \NC number \NC float \NC \NC \NR
+ \NC \type {5} \NC name \NC string \NC \NC \NR
+ \NC \type {6} \NC string \NC string \NC type \NC \NR
+ \NC \type {7} \NC array \NC arrayobject \NC size \NC \NR
+ \NC \type {8} \NC dictionary \NC dictionaryobject \NC size \NC \NR
+ \NC \type {9} \NC stream \NC streamobject \NC dictionary size \NC \NR
+ \NC \type {10} \NC reference \NC integer \NC \NC \NR
+ \LL
+ \stoptabulate
+
+ A name and string can be distinguished by the extra type value that a string has.
+
+*/
+
+static int pdfelib_aux_pushvalue(lua_State *L, ppobj *object)
+{
+ switch (object->type) {
+ case PPNONE:
+ case PPNULL:
+ lua_pushnil(L);
+ return 1;
+ case PPBOOL:
+ lua_pushboolean(L, (int) object->integer);
+ return 1;
+ case PPINT:
+ lua_pushinteger(L, (lua_Integer) object-> integer);
+ return 1;
+ case PPNUM:
+ lua_pushnumber(L, (double) object->number);
+ return 1;
+ case PPNAME:
+ {
+ ppname *n = ppname_decoded(object->name) ;
+ lua_pushlstring(L, ppname_data(n), ppname_size(n));
+ return 1;
+ }
+ case PPSTRING:
+ lua_pushlstring(L, ppstring_data(object->string), ppstring_size(object->string));
+ lua_pushboolean(L, ppstring_hex(object->string));
+ return 2;
+ case PPARRAY:
+ return pdfelib_aux_pusharray(L, object->array);
+ case PPDICT:
+ return pdfelib_aux_pushdictionary(L, object->dict);
+ case PPSTREAM:
+ return pdfelib_aux_pushstream(L, object->stream);
+ case PPREF:
+ return pdfelib_aux_pushreference(L, object->ref);
+ }
+ return 0;
+}
+
+/*tex
+
+ We need to start someplace when we traverse a document's tree. There are three places:
+
+ \starttyping
+ catalogdictionary = getcatalog(documentobject)
+ trailerdictionary = gettrailer(documentobject)
+ infodictionary = getinfo (documentobject)
+ \stoptyping
+
+*/
+
+static int pdfelib_getcatalog(lua_State *L)
+{
+ pdfe_document* p = pdfelib_aux_check_isdocument (L, 1);
+ if (p) {
+ return pdfelib_aux_pushdictionaryonly (L, ppdoc_catalog (p->document));
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_gettrailer(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ return pdfelib_aux_pushdictionaryonly (L, ppdoc_trailer (p->document));
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_getinfo(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ return pdfelib_aux_pushdictionaryonly (L, ppdoc_info (p->document));
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ We have three more helpers.
+
+ \starttyping
+ [key,] type, value, detail = getfromdictionary(dictionaryobject,name|index)
+ type, value, detail = getfromarray (arrayobject,index)
+ [key,] type, value, detail = getfromstream (streamobject,name|index)
+ \stoptyping
+
+*/
+
+static int pdfelib_getfromarray(lua_State *L)
+{
+ pdfe_array *a = pdfelib_aux_check_isarray(L, 1);
+ if (a) {
+ unsigned int index = lmt_checkinteger(L, 2) - 1;
+ if (index < a->array->size) {
+ ppobj *object = pparray_at(a->array,index);
+ if (object) {
+ lua_pushinteger(L, (lua_Integer) object->type);
+ return 1 + pdfelib_aux_pushvalue(L, object);
+ }
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getfromdictionary(lua_State *L)
+{
+ pdfe_dictionary *d = pdfelib_aux_check_isdictionary(L, 1);
+ if (d) {
+ if (lua_type(L, 2) == LUA_TSTRING) {
+ const char *name = luaL_checkstring(L, 2);
+ ppobj *object = ppdict_get_obj(d->dictionary, name);
+ if (object) {
+ lua_pushinteger(L, (lua_Integer) object->type);
+ return 1 + pdfelib_aux_pushvalue(L, object);
+ }
+ } else {
+ unsigned int index = lmt_checkinteger(L, 2) - 1;
+ if (index < d->dictionary->size) {
+ ppobj *object = ppdict_at(d->dictionary,index);
+ if (object) {
+ ppname *key = ppname_decoded(ppdict_key(d->dictionary, index));
+ lua_pushlstring(L, ppname_data(key), ppname_size(key));
+ lua_pushinteger(L, (lua_Integer) object->type);
+ return 2 + pdfelib_aux_pushvalue(L, object);
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getfromstream(lua_State *L)
+{
+ pdfe_stream *s = (pdfe_stream *) lua_touserdata(L, 1);
+ // pdfe_stream *s = check_isstream(L, 1);
+ if (s) {
+ ppdict *d = s->stream->dict;
+ if (lua_type(L, 2) == LUA_TSTRING) {
+ const char *name = luaL_checkstring(L, 2);
+ ppobj *object = ppdict_get_obj(d, name);
+ if (object) {
+ lua_pushinteger(L, (lua_Integer) object->type);
+ return 1 + pdfelib_aux_pushvalue(L, object);
+ }
+ } else {
+ unsigned int index = lmt_checkinteger(L, 2) - 1;
+ if (index < d->size) {
+ ppobj *object = ppdict_at(d, index);
+ if (object) {
+ ppname *key = ppname_decoded(ppdict_key(d, index));
+ lua_pushlstring(L, ppname_data(key), ppname_size(key));
+ lua_pushinteger(L, (lua_Integer) object->type);
+ return 2 + pdfelib_aux_pushvalue(L, object);
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ An indexed table with all entries in an array can be fetched with::
+
+ \starttyping
+ t = arraytotable(arrayobject)
+ \stoptyping
+
+ An hashed table with all entries in an dictionary can be fetched with::
+
+ \starttyping
+ t = dictionarytotable(arrayobject)
+ \stoptyping
+
+*/
+
+static void pdfelib_totable(lua_State *L, ppobj *object, int flat)
+{
+ int n = pdfelib_aux_pushvalue(L, object);
+ if (flat && n < 2) {
+ return;
+ } else {
+ /* [value] [extra] [more] */
+ lua_createtable(L, n + 1, 0);
+ if (n == 1) {
+ /* value { nil, nil } */
+ lua_insert(L, -2);
+ /* { nil, nil } value */
+ lua_rawseti(L, -2, 2);
+ /* { nil , value } */
+ } else if (n == 2) {
+ /* value extra { nil, nil, nil } */
+ lua_insert(L, -3);
+ /* { nil, nil, nil } value extra */
+ lua_rawseti(L, -3, 3);
+ /* { nil, nil, extra } value */
+ lua_rawseti(L, -2, 2);
+ /* { nil, value, extra } */
+ } else if (n == 3) {
+ /* value extra more { nil, nil, nil, nil } */
+ lua_insert(L, -4);
+ /* { nil, nil, nil, nil, nil } value extra more */
+ lua_rawseti(L, -4, 4);
+ /* { nil, nil, nil, more } value extra */
+ lua_rawseti(L, -3, 3);
+ /* { nil, nil, extra, more } value */
+ lua_rawseti(L, -2, 2);
+ /* { nil, value, extra, more } */
+ }
+ lua_pushinteger(L, (lua_Integer) object->type);
+ /* { nil, [value], [extra], [more] } type */
+ lua_rawseti(L, -2, 1);
+ /* { type, [value], [extra], [more] } */
+ }
+}
+
+static int pdfelib_arraytotable(lua_State *L)
+{
+ pdfe_array *a = pdfelib_aux_check_isarray(L, 1);
+ if (a) {
+ int flat = lua_isboolean(L, 2);
+ int j = 0;
+ lua_createtable(L, (int) a->array->size, 0);
+ /* table */
+ for (unsigned int i = 0; i < a->array->size; i++) {
+ ppobj *object = pparray_at(a->array,i);
+ if (object) {
+ pdfelib_totable(L, object,flat);
+ /* table { type, [value], [extra], [more] } */
+ lua_rawseti(L, -2, ++j);
+ /* table[i] = { type, [value], [extra], [more] } */
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_dictionarytotable(lua_State *L)
+{
+ pdfe_dictionary *d = pdfelib_aux_check_isdictionary(L, 1);
+ if (d) {
+ int flat = lua_isboolean(L, 2);
+ lua_createtable(L, 0, (int) d->dictionary->size);
+ /* table */
+ for (unsigned int i = 0; i < d->dictionary->size; i++) {
+ ppobj *object = ppdict_at(d->dictionary, i);
+ if (object) {
+ ppname *key = ppname_decoded(ppdict_key(d->dictionary, i));
+ lua_pushlstring(L, ppname_data(key), ppname_size(key));
+ /* table key */
+ pdfelib_totable(L, object, flat);
+ /* table key { type, [value], [extra], [more] } */
+ lua_rawset(L, -3);
+ /* table[key] = { type, [value], [extra] } */
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ All pages are collected with:
+
+ \starttyping
+ { { dict, size, objnum }, ... } = pagestotable(document)
+ \stoptyping
+
+*/
+
+static int pdfelib_pagestotable(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ ppdoc *d = p->document;
+ int i = 1;
+ int j = 0;
+ lua_createtable(L, (int) ppdoc_page_count(d), 0);
+ /* pages[1..n] */
+ for (ppref *r = ppdoc_first_page(d); r; r = ppdoc_next_page(d), ++i) {
+ lua_createtable(L, 3, 0);
+ if (ppref_obj(r)) {
+ pdfelib_aux_pushdictionary(L, ppref_obj(r)->dict);
+ /* table dictionary n */
+ lua_rawseti(L, -3, 2);
+ /* table dictionary */
+ lua_rawseti(L, -2, 1);
+ /* table */
+ lua_pushinteger(L, r->number);
+ /* table reference */
+ lua_rawseti(L, -2, 3);
+ /* table */
+ lua_rawseti(L, -2, ++j);
+ /* pages[i] = { dictionary, size, objnum } */
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ Streams can be fetched on one go:
+
+ \starttyping
+ string, n = readwholestream(streamobject,decode)
+ \stoptyping
+
+*/
+
+static int pdfelib_stream_readwhole(lua_State *L)
+{
+ pdfe_stream *s = pdfelib_aux_check_isstream(L, 1);
+ if (s) {
+ uint8_t *b = NULL;
+ int decode = 0;
+ size_t n = 0;
+ if (s->open > 0) {
+ ppstream_done(s->stream);
+ s->open = 0;
+ s->decode = 0;
+ }
+ if (lua_gettop(L) > 1 && lua_isboolean(L, 2)) {
+ decode = lua_toboolean(L, 2);
+ }
+ b = ppstream_all(s->stream, &n, decode);
+ lua_pushlstring(L, (const char *) b, n);
+ lua_pushinteger(L, (lua_Integer) n);
+ ppstream_done(s->stream);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ Alternatively streams can be fetched stepwise:
+
+ \starttyping
+ okay = openstream(streamobject,[decode])
+ string, n = readfromstream(streamobject)
+ closestream(streamobject)
+ \stoptyping
+
+*/
+
+static int pdfelib_stream_open(lua_State *L)
+{
+ pdfe_stream *s = pdfelib_aux_check_isstream(L, 1);
+ if (s) {
+ if (s->open == 0) {
+ if (lua_gettop(L) > 1) {
+ s->decode = lua_isboolean(L, 2);
+ }
+ s->open = 1;
+ }
+ lua_pushboolean(L,1);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_stream_close(lua_State *L)
+{
+ pdfe_stream *s = pdfelib_aux_check_isstream(L, 1);
+ if (s && s->open > 0) {
+ ppstream_done(s->stream);
+ s->open = 0;
+ s->decode = 0;
+ }
+ return 0;
+}
+
+static int pdfelib_stream_read(lua_State *L)
+{
+ pdfe_stream *s = pdfelib_aux_check_isstream(L, 1);
+ if (s) {
+ size_t n = 0;
+ uint8_t *d = NULL;
+ if (s->open == 1) {
+ d = ppstream_first(s->stream, &n, s->decode);
+ s->open = 2;
+ } else if (s->open == 2) {
+ d = ppstream_next(s->stream, &n);
+ } else {
+ return 0;
+ }
+ lua_pushlstring(L, (const char *) d, n);
+ lua_pushinteger(L, (lua_Integer) n);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ There are two methods for opening a document: files and strings.
+
+ \starttyping
+ documentobject = open(filename)
+ documentobject = new(string,length)
+ \stoptyping
+
+ Closing happens with:
+
+ \starttyping
+ close(documentobject)
+ \stoptyping
+
+ When the \type {new} function gets a peudo filename as third argument, no user data will be
+ created but the stream is accessible as image.
+
+*/
+
+/*
+static int pdfelib_test(lua_State *L)
+{
+ const char *filename = luaL_checkstring(L, 1);
+ ppdoc *d = ppdoc_load(filename);
+ if (d) {
+ lua_pushboolean(L,1);
+ ppdoc_free(d);
+ } else {
+ lua_pushboolean(L,0);
+ }
+ return 1;
+}
+*/
+
+static void aux_pdfelib_open(lua_State *L, FILE *f)
+{
+ pdfe_document *p = (pdfe_document *) lua_newuserdatauv(L, sizeof(pdfe_document), 0);
+ ppdoc *d = ppdoc_filehandle(f, 1);
+ luaL_getmetatable(L, PDFE_METATABLE_INSTANCE);
+ lua_setmetatable(L, -2);
+ p->document = d;
+ p->open = 1;
+ p->isfile = 1;
+ p->memstream = NULL;
+}
+
+static int pdfelib_open(lua_State *L)
+{
+ const char *filename = luaL_checkstring(L, 1);
+ FILE *f = aux_utf8_fopen(filename, "rb");
+ if (f) {
+ aux_pdfelib_open(L, f);
+ return 1;
+ } else {
+ tex_formatted_warning("pdfe lib", "no valid pdf file '%s'", filename);
+ return 0;
+ }
+}
+
+static int pdfelib_openfile(lua_State *L)
+{
+ luaL_Stream *fs = ((luaL_Stream *) luaL_checkudata(L, 1, LUA_FILEHANDLE));
+ FILE *f = (fs->closef) ? fs->f : NULL;
+ if (f) {
+ aux_pdfelib_open(L, f);
+ /*tex We trick \LUA\ in believing the file is closed. */
+ fs->closef = NULL;
+ return 1;
+ } else {
+ tex_formatted_warning("pdfe lib", "no valid file handle");
+ return 0;
+ }
+}
+
+static int pdfelib_new(lua_State *L)
+{
+ size_t streamsize = 0;
+ const char *docstream = NULL;
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ docstream = lua_tolstring(L, 1, &streamsize);
+ if (! docstream) {
+ tex_normal_warning("pdfe lib", "invalid string");
+ return 0;
+ } else {
+ break;
+ }
+ case LUA_TLIGHTUSERDATA:
+ /*tex
+ The stream comes as a sequence of bytes. This could happen from a library (we used
+ this for swiglib gm output tests).
+ */
+ docstream = (const char *) lua_touserdata(L, 1);
+ if (! docstream) {
+ tex_normal_warning("pdfe lib", "invalid lightuserdata");
+ return 0;
+ } else {
+ break;
+ }
+ default:
+ tex_normal_warning("pdfe lib", "string or lightuserdata expected");
+ return 0;
+ }
+ streamsize = luaL_optinteger(L, 2, streamsize);
+ if (streamsize > 0) {
+ char *memstream = lmt_generic_malloc((unsigned) (streamsize + 1)); /* we have no hook into pdfe free */
+ if (memstream) {
+ ppdoc *d = NULL;
+ memcpy(memstream, docstream, (streamsize + 1));
+ memstream[streamsize] = '\0';
+ d = ppdoc_mem(memstream, streamsize);
+ if (d) {
+ pdfe_document *p = (pdfe_document *) lua_newuserdatauv(L, sizeof(pdfe_document), 0);
+ luaL_getmetatable(L, PDFE_METATABLE_INSTANCE);
+ lua_setmetatable(L, -2);
+ p->document = d;
+ p->open = 1;
+ p->isfile = 0;
+ p->memstream = memstream;
+ return 1;
+ } else {
+ tex_normal_warning("pdfe lib", "unable to handle stream");
+ }
+ } else {
+ tex_normal_warning("pdfe lib", "not enough memory for new stream");
+ }
+ } else {
+ tex_normal_warning("pdfe lib", "stream with size > 0 expected");
+ }
+ return 0;
+}
+
+/*
+
+ There is no garbage collection needed as the library itself manages the objects. Normally
+ objects don't take much space. Streams use buffers so (I assume) that they are not
+ persistent. The only collector is in the parent object (the document).
+
+*/
+
+static int pdfelib_document_free(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p && p->open) {
+ if (p->document) {
+ ppdoc_free(p->document);
+ p->document = NULL;
+ }
+ if (p->memstream) {
+ /* pplib does this: xfree(p->memstream); */
+ p->memstream = NULL;
+ }
+ p->open = 0;
+ }
+ return 0;
+}
+
+static int pdfelib_close(lua_State *L)
+{
+ return pdfelib_document_free(L);
+}
+
+/*tex
+
+ A document is can be uncrypted with:
+
+ \starttyping
+ status = unencrypt(documentobject,user,owner)
+ \stoptyping
+
+ Instead of a password \type {nil} can be passed, so there are three possible useful combinations.
+
+*/
+
+static int pdfelib_unencrypt(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ size_t u = 0;
+ size_t o = 0;
+ const char* user = NULL;
+ const char* owner = NULL;
+ int top = lua_gettop(L);
+ if (top > 1) {
+ if (lua_type(L,2) == LUA_TSTRING) {
+ user = lua_tolstring(L, 2, &u);
+ } else {
+ /*tex we're not too picky but normally it will be nil or false */
+ }
+ if (top > 2) {
+ if (lua_type(L,3) == LUA_TSTRING) {
+ owner = lua_tolstring(L, 3, &o);
+ } else {
+ /*tex we're not too picky but normally it will be nil or false */
+ }
+ }
+ lua_pushinteger(L, (lua_Integer) ppdoc_crypt_pass(p->document, user, u, owner, o));
+ return 1;
+ }
+ }
+ lua_pushinteger(L, (lua_Integer) PPCRYPT_FAIL);
+ return 1;
+}
+
+/*tex
+
+ There are a couple of ways to get information about the document:
+
+ \starttyping
+ n = getsize (documentobject)
+ major, minor = getversion (documentobject)
+ status = getstatus (documentobject)
+ n = getnofobjects (documentobject)
+ n = getnofpages (documentobject)
+ bytes, waste = getmemoryusage(documentobject)
+ \stoptyping
+
+*/
+
+static int pdfelib_getsize(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ lua_pushinteger(L, (lua_Integer) ppdoc_file_size(p->document));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+
+static int pdfelib_getversion(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ int minor;
+ int major = ppdoc_version_number(p->document, &minor);
+ lua_pushinteger(L, (lua_Integer) major);
+ lua_pushinteger(L, (lua_Integer) minor);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_getstatus(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ lua_pushinteger(L, (lua_Integer) ppdoc_crypt_status(p->document));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_getnofobjects(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ lua_pushinteger(L, (lua_Integer) ppdoc_objects(p->document));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_getnofpages(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ lua_pushinteger(L, (lua_Integer) ppdoc_page_count(p->document));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_getmemoryusage(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ size_t w = 0;
+ size_t m = ppdoc_memory(p->document, &w);
+ lua_pushinteger(L, (lua_Integer) m);
+ lua_pushinteger(L, (lua_Integer) w);
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+/*
+ A specific page dictionary can be filtered with the next command. So, there is no need to parse
+ the document page tree (with these \type {kids} arrays).
+
+ \starttyping
+ dictionaryobject = getpage(documentobject,pagenumber)
+ \stoptyping
+
+*/
+
+static int pdfelib_aux_pushpage(lua_State *L, ppdoc *d, int page)
+{
+ if ((page <= 0) || (page > ((int) ppdoc_page_count(d)))) {
+ return 0;
+ } else {
+ ppref *pp = ppdoc_page(d, page);
+ return pdfelib_aux_pushdictionaryonly(L, ppref_obj(pp)->dict);
+ }
+}
+
+static int pdfelib_getpage(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ return pdfelib_aux_pushpage(L, p->document, lmt_checkinteger(L, 2));
+ } else {
+ return 0;
+ }
+}
+
+static int pdfelib_aux_pushpages(lua_State *L, ppdoc *d)
+{
+ int i = 1;
+ lua_createtable(L, (int) ppdoc_page_count(d), 0);
+ /* pages[1..n] */
+ for (ppref *r = ppdoc_first_page(d); r; r = ppdoc_next_page(d), ++i) {
+ pdfelib_aux_pushdictionaryonly(L,ppref_obj(r)->dict);
+ lua_rawseti(L, -2, i);
+ }
+ return 1 ;
+}
+
+static int pdfelib_getpages(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ return pdfelib_aux_pushpages(L, p->document);
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ The boundingbox (\type {MediaBox) and similar boxes can be available in a (page) doctionary but
+ also in a parent object. Therefore a helper is available that does the (backtracked) lookup.
+
+ \starttyping
+ { lx, ly, rx, ry } = getbox(dictionaryobject)
+ \stoptyping
+
+*/
+
+static int pdfelib_getbox(lua_State *L)
+{
+ if (lua_gettop(L) > 1 && lua_type(L,2) == LUA_TSTRING) {
+ pdfe_dictionary *p = pdfelib_aux_check_isdictionary(L, 1);
+ if (p) {
+ const char *key = lua_tostring(L, 2);
+ pprect box = { 0, 0, 0, 0 };
+ pprect *r = ppdict_get_box(p->dictionary, key, &box);
+ if (r) {
+ lua_createtable(L, 4, 0);
+ lua_pushnumber(L, r->lx);
+ lua_rawseti(L, -2, 1);
+ lua_pushnumber(L, r->ly);
+ lua_rawseti(L, -2, 2);
+ lua_pushnumber(L, r->rx);
+ lua_rawseti(L, -2, 3);
+ lua_pushnumber(L, r->ry);
+ lua_rawseti(L, -2, 4);
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ This one is needed when you use the detailed getters and run into an object reference. The
+ regular getters resolve this automatically.
+
+ \starttyping
+ [dictionary|array|stream]object = getfromreference(referenceobject)
+ \stoptyping
+
+*/
+
+static int pdfelib_getfromreference(lua_State *L)
+{
+ pdfe_reference *r = pdfelib_aux_check_isreference(L, 1);
+ if (r && r->xref) {
+ ppref *rr = ppxref_find(r->xref, (ppuint) r->onum);
+ if (rr) {
+ ppobj *o = ppref_obj(rr);
+ if (o) {
+ lua_pushinteger(L, (lua_Integer) o->type);
+ return 1 + pdfelib_aux_pushvalue(L, o);
+ }
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getfromobject(lua_State *L)
+{
+ pdfe_document *p = pdfelib_aux_check_isdocument(L, 1);
+ if (p) {
+ ppref *rr = ppxref_find(p->document->xref, lua_tointeger(L, 2));
+ if (rr) {
+ ppobj *o = ppref_obj(rr);
+ if (o) {
+ lua_pushinteger(L, (lua_Integer) o->type);
+ return 1 + pdfelib_aux_pushvalue(L, o);
+ }
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ Here are some convenient getters:
+
+ \starttyping
+ <string> = getstring (array|dict|ref,index|key)
+ <integer> = getinteger (array|dict|ref,index|key)
+ <number> = getnumber (array|dict|ref,index|key)
+ <boolan> = getboolean (array|dict|ref,index|key)
+ <string> = getname (array|dict|ref,index|key)
+ <dictionary> = getdictionary(array|dict|ref,index|key)
+ <array> = getarray (array|dict|ref,index|key)
+ <stream>, <dict> = getstream (array|dict|ref,index|key)
+ \stoptyping
+
+ We report issues when reasonable but are silent when it makes sense. We don't error on this
+ because we expect the user code to act reasonable on a return value.
+
+*/
+
+static int pdfelib_valid_index(lua_State *L, void **p, int *t)
+{
+ *t = lua_type(L, 2);
+ *p = lua_touserdata(L, 1);
+ lua_settop(L, 2);
+ if (! *p) {
+ switch (*t) {
+ case LUA_TSTRING:
+ tex_normal_warning("pdfe lib", "lua <pdfe dictionary> expected");
+ break;
+ case LUA_TNUMBER:
+ tex_normal_warning("pdfe lib", "lua <pdfe array> expected");
+ break;
+ default:
+ tex_normal_warning("pdfe lib", "invalid arguments");
+ break;
+ }
+ return 0;
+ } else if (! lua_getmetatable(L, 1)) {
+ tex_normal_warning("pdfe lib", "first argument should be a <pde array> or <pde dictionary>");
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+static void pdfelib_invalid_index_warning(void)
+{
+ tex_normal_warning("pdfe lib", "second argument should be integer or string");
+}
+
+/*tex
+
+ The direct fetcher returns the result or |NULL| when there is nothing found. The indirect
+ fetcher passes a pointer to the target variable and returns success state.
+
+ The next two functions used to be macros but as we try to avoid large ones with much code, they
+ are now functions.
+
+*/
+
+typedef void * (*pp_a_direct) (void *a, size_t index);
+typedef void * (*pp_d_direct) (void *d, const char *key);
+typedef int (*pp_a_indirect) (void *a, size_t index, void **value);
+typedef int (*pp_d_indirect) (void *d, const char *key, void **value);
+
+static int pdfelib_get_value_direct(lua_State *L, void **value, pp_d_direct get_d, pp_a_direct get_a)
+{
+ int t = 0;
+ void *p = NULL;
+ if (pdfelib_valid_index(L, &p, &t)) {
+ switch (t) {
+ case LUA_TSTRING:
+ {
+ const char *key = lua_tostring(L, 2);
+ lua_get_metatablelua(pdfe_dictionary);
+ if (lua_rawequal(L, -1, -2)) {
+ *value = get_d(((pdfe_dictionary *) p)->dictionary, key);
+ return 1;
+ } else {
+ lua_get_metatablelua(pdfe_reference);
+ if (lua_rawequal(L, -1, -3)) {
+ ppref *r = (((pdfe_reference *) p)->xref) ? ppxref_find(((pdfe_reference *) p)->xref, (ppuint) (((pdfe_reference *) p)->onum)) : NULL; \
+ ppobj *o = (r) ? ppref_obj(r) : NULL;
+ if (o && o->type == PPDICT) {
+ *value = get_d((ppdict *) o->dict, key);
+ return 1;
+ }
+ }
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ {
+ size_t index = lua_tointeger(L, 2);
+ lua_get_metatablelua(pdfe_array);
+ if (lua_rawequal(L, -1, -2)) {
+ *value = get_a(((pdfe_array *) p)->array, index);
+ return 2;
+ } else {
+ lua_get_metatablelua(pdfe_reference);
+ if (lua_rawequal(L, -1, -3)) {
+ ppref *r = (((pdfe_reference *) p)->xref) ? ppxref_find(((pdfe_reference *) p)->xref, (ppuint) (((pdfe_reference *) p)->onum)) : NULL; \
+ ppobj *o = (r) ? ppref_obj(r) : NULL;
+ if (o && o->type == PPARRAY) {
+ *value = get_a((pparray *) o->array, index);
+ return 2;
+ }
+ }
+ }
+ }
+ break;
+ default:
+ pdfelib_invalid_index_warning();
+ break;
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_get_value_indirect(lua_State *L, void **value, pp_d_indirect get_d, pp_a_indirect get_a)
+{
+ int t = 0;
+ void *p = NULL;
+ if (pdfelib_valid_index(L, &p, &t)) {
+ switch (t) {
+ case LUA_TSTRING:
+ {
+ const char *key = lua_tostring(L, 2);
+ lua_get_metatablelua(pdfe_dictionary);
+ if (lua_rawequal(L, -1, -2)) {
+ return get_d(((pdfe_dictionary *) p)->dictionary, key, value);
+ } else {
+ lua_get_metatablelua(pdfe_reference);
+ if (lua_rawequal(L, -1, -3)) {
+ ppref *r = (((pdfe_reference *) p)->xref) ? ppxref_find(((pdfe_reference *) p)->xref, (ppuint) (((pdfe_reference *) p)->onum)) : NULL;
+ ppobj *o = (r) ? ppref_obj(r) : NULL;
+ if (o && o->type == PPDICT)
+ return get_d(o->dict, key, value);
+ }
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ {
+ size_t index = lua_tointeger(L, 2);
+ lua_get_metatablelua(pdfe_array);
+ if (lua_rawequal(L, -1, -2)) {
+ return get_a(((pdfe_array *) p)->array, index, value);
+ } else {
+ lua_get_metatablelua(pdfe_reference);
+ if (lua_rawequal(L, -1, -3)) {
+ ppref *r = (((pdfe_reference *) p)->xref) ? ppxref_find(((pdfe_reference *) p)->xref, (ppuint) (((pdfe_reference *) p)->onum)) : NULL;
+ ppobj *o = (r) ? ppref_obj(r) : NULL;
+ if (o && o->type == PPARRAY)
+ return get_a(o->array, index, value);
+ }
+ }
+ }
+ break;
+ default:
+ pdfelib_invalid_index_warning();
+ break;
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getstring(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ ppstring *value = NULL;
+ int okay = 0;
+ int how = 0;
+ if (lua_type(L, 3) == LUA_TBOOLEAN) {
+ if (lua_toboolean(L, 3)) {
+ how = 1;
+ } else {
+ how = 2;
+ }
+ }
+ okay = pdfelib_get_value_direct(L, (void *) &value, (void *) &ppdict_rget_string, (void *) &pparray_rget_string);
+ if (okay && value) {
+ if (how == 1) {
+ value = ppstring_decoded(value);
+ }
+ /*tex This used to return one value but we made it \LUATEX\ compatible. */
+ lua_pushlstring(L, ppstring_data(value), ppstring_size(value));
+ if (how == 2) {
+ lua_pushboolean(L, ppstring_hex(value));
+ return 2;
+ } else {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getinteger(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ ppint value = 0;
+ if (pdfelib_get_value_indirect(L, (void *) &value, (void *) &ppdict_rget_int, (void *) &pparray_rget_int)) {
+ lua_pushinteger(L, (lua_Integer) value);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getnumber(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ ppnum value = 0;
+ if (pdfelib_get_value_indirect(L, (void *) &value, (void *) &ppdict_rget_num, (void *) &pparray_rget_num)) {
+ lua_pushnumber(L, value);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getboolean(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ int value = 0;
+ if (pdfelib_get_value_indirect(L, (void *) &value, (void *) &ppdict_rget_bool, (void *) &pparray_rget_bool)) {
+ lua_pushboolean(L, value);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getname(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ ppname *value = NULL;
+ pdfelib_get_value_direct(L, (void *) &value, (void *) &ppdict_rget_name, (void *) &pparray_rget_name);
+ if (value) {
+ value = ppname_decoded(value) ;
+ lua_pushlstring(L, ppname_data(value), ppname_size(value));
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getdictionary(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ ppdict *value = NULL;
+ pdfelib_get_value_direct(L, (void *) &value, (void *) &ppdict_rget_dict, (void *) &pparray_rget_dict);
+ if (value) {
+ return pdfelib_aux_pushdictionaryonly(L, value);
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getarray(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ pparray *value = NULL;
+ pdfelib_get_value_direct(L, (void *) &value, (void *) &ppdict_rget_array, (void *) &pparray_rget_array);
+ if (value) {
+ return pdfelib_aux_pusharrayonly(L, value);
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_getstream(lua_State *L)
+{
+ if (lua_gettop(L) > 1) {
+ ppobj *value = NULL;
+ pdfelib_get_value_direct(L, (void *) &value, (void *) &ppdict_rget_obj, (void *) &pparray_rget_obj);
+ if (value && value->type == PPSTREAM) {
+ return pdfelib_aux_pushstreamonly(L, (ppstream *) value->stream);
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ The generic pushed that does a similar job as the previous getters acts upon
+ the type.
+
+*/
+
+static int pdfelib_pushvalue(lua_State *L, ppobj *object)
+{
+ switch (object->type) {
+ case PPNONE:
+ case PPNULL:
+ lua_pushnil(L);
+ break;
+ case PPBOOL:
+ lua_pushboolean(L, (int) object->integer);
+ break;
+ case PPINT:
+ lua_pushinteger(L, (lua_Integer) object->integer);
+ break;
+ case PPNUM:
+ lua_pushnumber(L, (double) object->number);
+ break;
+ case PPNAME:
+ {
+ ppname *n = ppname_decoded(object->name) ;
+ lua_pushlstring(L, ppname_data(n), ppname_size(n));
+ }
+ break;
+ case PPSTRING:
+ lua_pushlstring(L, ppstring_data(object->string), ppstring_size(object->string));
+ break;
+ case PPARRAY:
+ return pdfelib_aux_pusharrayonly(L, object->array);
+ case PPDICT:
+ return pdfelib_aux_pushdictionary(L, object->dict);
+ case PPSTREAM:
+ return pdfelib_aux_pushstream(L, object->stream);
+ case PPREF:
+ pdfelib_aux_pushreference(L, object->ref);
+ break;
+ /*tex We get a funny message in clang about covering all cases. */
+ /*
+ default:
+ lua_pushnil(L);
+ break;
+ */
+ }
+ return 1;
+}
+
+/*tex
+
+ Finally we arrived at the acessors for the userdata objects. The use previously defined helpers.
+
+*/
+
+static int pdfelib_document_access(lua_State *L)
+{
+ if (lua_type(L, 2) == LUA_TSTRING) {
+ pdfe_document *p = (pdfe_document *) lua_touserdata(L, 1);
+ const char *s = lua_tostring(L, 2);
+ if (lua_key_eq(s, catalog) || lua_key_eq(s, Catalog)) {
+ return pdfelib_aux_pushdictionaryonly(L, ppdoc_catalog(p->document));
+ } else if (lua_key_eq(s, info) || lua_key_eq(s, Info)) {
+ return pdfelib_aux_pushdictionaryonly(L, ppdoc_info(p->document));
+ } else if (lua_key_eq(s, trailer) || lua_key_eq(s, Trailer)) {
+ return pdfelib_aux_pushdictionaryonly(L, ppdoc_trailer(p->document));
+ } else if (lua_key_eq(s, pages) || lua_key_eq(s, Pages)) {
+ return pdfelib_aux_pushpages(L, p->document);
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_array_access(lua_State *L)
+{
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ pdfe_array *p = (pdfe_array *) lua_touserdata(L, 1);
+ ppint index = lua_tointeger(L, 2) - 1;
+ ppobj *o = pparray_rget_obj(p->array, index);
+ if (o) {
+ return pdfelib_pushvalue(L, o);
+ }
+ }
+ return 0;
+}
+
+static int pdfelib_dictionary_access(lua_State *L)
+{
+ pdfe_dictionary *p = (pdfe_dictionary *) lua_touserdata(L, 1);
+ switch (lua_type(L, 2)) {
+ case LUA_TSTRING:
+ {
+ const char *key = lua_tostring(L, 2);
+ ppobj *o = ppdict_rget_obj(p->dictionary, key);
+ if (o) {
+ return pdfelib_pushvalue(L, o);
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ {
+ ppint index = lua_tointeger(L, 2) - 1;
+ ppobj *o = ppdict_at(p->dictionary, index);
+ if (o) {
+ return pdfelib_pushvalue(L, o);
+ }
+ }
+ break;
+ }
+ return 0;
+}
+
+static int pdfelib_stream_access(lua_State *L)
+{
+ pdfe_stream *p = (pdfe_stream *) lua_touserdata(L, 1);
+ switch (lua_type(L, 2)) {
+ case LUA_TSTRING:
+ {
+ const char *key = lua_tostring(L, 2);
+ ppobj *o = ppdict_rget_obj(p->stream->dict, key);
+ if (o) {
+ return pdfelib_pushvalue(L, o);
+ }
+ }
+ break;
+ case LUA_TNUMBER:
+ {
+ ppint index = lua_tointeger(L, 2) - 1;
+ ppobj *o = ppdict_at(p->stream->dict, index);
+ if (o) {
+ return pdfelib_pushvalue(L, o);
+ }
+ }
+ break;
+ }
+ return 0;
+}
+
+/*tex
+
+ The length metamethods are defined last.
+
+*/
+
+static int pdfelib_array_size(lua_State *L)
+{
+ pdfe_array *p = (pdfe_array *) lua_touserdata(L, 1);
+ lua_pushinteger(L, (lua_Integer) p->array->size);
+ return 1;
+}
+
+static int pdfelib_dictionary_size(lua_State *L)
+{
+ pdfe_dictionary *p = (pdfe_dictionary *) lua_touserdata(L, 1);
+ lua_pushinteger(L, (lua_Integer) p->dictionary->size);
+ return 1;
+}
+
+static int pdfelib_stream_size(lua_State *L)
+{
+ pdfe_stream *p = (pdfe_stream *) lua_touserdata(L, 1);
+ lua_pushinteger(L, (lua_Integer) p->stream->dict->size);
+ return 1;
+}
+
+/*tex
+
+ We now initialize the main interface. We might add few more informational helpers but this is
+ it.
+
+*/
+
+static const struct luaL_Reg pdfelib_function_list[] = {
+ /* management */
+ { "type", pdfelib_type },
+ { "open", pdfelib_open },
+ { "openfile", pdfelib_openfile },
+ { "new", pdfelib_new },
+ { "close", pdfelib_close },
+ { "unencrypt", pdfelib_unencrypt },
+ /* statistics */
+ { "getversion", pdfelib_getversion },
+ { "getstatus", pdfelib_getstatus },
+ { "getsize", pdfelib_getsize },
+ { "getnofobjects", pdfelib_getnofobjects },
+ { "getnofpages", pdfelib_getnofpages },
+ { "getmemoryusage", pdfelib_getmemoryusage },
+ /* getters */
+ { "getcatalog", pdfelib_getcatalog },
+ { "gettrailer", pdfelib_gettrailer },
+ { "getinfo", pdfelib_getinfo },
+ { "getpage", pdfelib_getpage },
+ { "getpages", pdfelib_getpages },
+ { "getbox", pdfelib_getbox },
+ { "getfromreference", pdfelib_getfromreference },
+ { "getfromdictionary", pdfelib_getfromdictionary },
+ { "getfromarray", pdfelib_getfromarray },
+ { "getfromstream", pdfelib_getfromstream },
+ /* handy too */
+ { "getfromobject", pdfelib_getfromobject },
+ /* collectors */
+ { "dictionarytotable", pdfelib_dictionarytotable },
+ { "arraytotable", pdfelib_arraytotable },
+ { "pagestotable", pdfelib_pagestotable },
+ /* more getters */
+ { "getstring", pdfelib_getstring },
+ { "getinteger", pdfelib_getinteger },
+ { "getnumber", pdfelib_getnumber },
+ { "getboolean", pdfelib_getboolean },
+ { "getname", pdfelib_getname },
+ { "getdictionary", pdfelib_getdictionary },
+ { "getarray", pdfelib_getarray },
+ { "getstream", pdfelib_getstream },
+ /* streams */
+ { "readwholestream", pdfelib_stream_readwhole },
+ /* not really needed */
+ { "openstream", pdfelib_stream_open },
+ { "readfromstream", pdfelib_stream_read },
+ { "closestream", pdfelib_stream_close },
+ /* only for me, a test hook */
+ /* { "test", pdfelib_test }, */
+ /* done */
+ { NULL, NULL }
+};
+
+/*tex
+
+ The user data metatables are defined as follows. Watch how only the document needs a garbage
+ collector.
+
+*/
+
+static const struct luaL_Reg pdfelib_instance_metatable[] = {
+ { "__tostring", pdfelib_document_tostring },
+ { "__gc", pdfelib_document_free },
+ { "__index", pdfelib_document_access },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg pdfelib_dictionary_metatable[] = {
+ { "__tostring", pdfelib_dictionary_tostring },
+ { "__index", pdfelib_dictionary_access },
+ { "__len", pdfelib_dictionary_size },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg pdfelib_array_metatable[] = {
+ { "__tostring", pdfelib_array_tostring },
+ { "__index", pdfelib_array_access },
+ { "__len", pdfelib_array_size },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg pdfelib_stream_metatable[] = {
+ { "__tostring", pdfelib_stream_tostring },
+ { "__index", pdfelib_stream_access },
+ { "__len", pdfelib_stream_size },
+ { "__call", pdfelib_stream_readwhole },
+ { NULL, NULL },
+};
+
+static const struct luaL_Reg pdfelib_reference_metatable[] = {
+ { "__tostring", pdfelib_reference_tostring },
+ { NULL, NULL },
+};
+
+/*tex
+
+ Finally we have arrived at the main initialiser that will be called as part of \LUATEX's
+ initializer.
+
+*/
+
+/*tex
+
+ Here we hook in the error handler.
+
+*/
+
+static void pdfelib_message(const char *message, void *alien)
+{
+ (void) (alien);
+ tex_normal_warning("pdfe", message);
+}
+
+int luaopen_pdfe(lua_State *L)
+{
+ /*tex First the four userdata object get their metatables defined. */
+
+ luaL_newmetatable(L, PDFE_METATABLE_DICTIONARY);
+ luaL_setfuncs(L, pdfelib_dictionary_metatable, 0);
+
+ luaL_newmetatable(L, PDFE_METATABLE_ARRAY);
+ luaL_setfuncs(L, pdfelib_array_metatable, 0);
+
+ luaL_newmetatable(L, PDFE_METATABLE_STREAM);
+ luaL_setfuncs(L, pdfelib_stream_metatable, 0);
+
+ luaL_newmetatable(L, PDFE_METATABLE_REFERENCE);
+ luaL_setfuncs(L, pdfelib_reference_metatable, 0);
+
+ /*tex Then comes the main (document) metatable: */
+
+ luaL_newmetatable(L, PDFE_METATABLE_INSTANCE);
+ luaL_setfuncs(L, pdfelib_instance_metatable, 0);
+
+ /*tex Last the library opens up itself to the world. */
+
+ lua_newtable(L);
+ luaL_setfuncs(L, pdfelib_function_list, 0);
+
+ pplog_callback(pdfelib_message, stderr);
+
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtsha2lib.c b/source/luametatex/source/luarest/lmtsha2lib.c
new file mode 100644
index 000000000..a420af137
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtsha2lib.c
@@ -0,0 +1,57 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+# include <utilsha.h>
+
+# define SHA256_RESULT_LENGTH (SHA256_STRING_LENGTH-1)
+# define SHA384_RESULT_LENGTH (SHA384_STRING_LENGTH-1)
+# define SHA512_RESULT_LENGTH (SHA512_STRING_LENGTH-1)
+
+# define sha2_body(SHA_DIGEST_LENGTH, SHA_CALCULATE, CONVERSION, SHA_RESULT_LENGTH) do { \
+ if (lua_type(L, 1) == LUA_TSTRING) { \
+ uint8_t result[SHA_DIGEST_LENGTH]; \
+ size_t size = 0; \
+ const char *data = lua_tolstring(L, 1, &size); \
+ SHA_CALCULATE(data, size, result, CONVERSION); \
+ lua_pushlstring(L, (const char *) result, SHA_RESULT_LENGTH); \
+ return 1; \
+ } \
+ return 0; \
+} while (0)
+
+static int sha2lib_256_sum(lua_State *L) { sha2_body(SHA256_DIGEST_LENGTH, sha256_digest, SHA_BYTES, SHA256_DIGEST_LENGTH); }
+static int sha2lib_384_sum(lua_State *L) { sha2_body(SHA384_DIGEST_LENGTH, sha384_digest, SHA_BYTES, SHA384_DIGEST_LENGTH); }
+static int sha2lib_512_sum(lua_State *L) { sha2_body(SHA512_DIGEST_LENGTH, sha512_digest, SHA_BYTES, SHA512_DIGEST_LENGTH); }
+static int sha2lib_256_hex(lua_State *L) { sha2_body(SHA256_STRING_LENGTH, sha256_digest, SHA_LCHEX, SHA256_RESULT_LENGTH); }
+static int sha2lib_384_hex(lua_State *L) { sha2_body(SHA384_STRING_LENGTH, sha384_digest, SHA_LCHEX, SHA384_RESULT_LENGTH); }
+static int sha2lib_512_hex(lua_State *L) { sha2_body(SHA512_STRING_LENGTH, sha512_digest, SHA_LCHEX, SHA512_RESULT_LENGTH); }
+static int sha2lib_256_HEX(lua_State *L) { sha2_body(SHA256_STRING_LENGTH, sha256_digest, SHA_UCHEX, SHA256_RESULT_LENGTH); }
+static int sha2lib_384_HEX(lua_State *L) { sha2_body(SHA384_STRING_LENGTH, sha384_digest, SHA_UCHEX, SHA384_RESULT_LENGTH); }
+static int sha2lib_512_HEX(lua_State *L) { sha2_body(SHA512_STRING_LENGTH, sha512_digest, SHA_UCHEX, SHA512_RESULT_LENGTH); }
+
+static struct luaL_Reg sha2lib_function_list[] = {
+ /*tex We started out with this: */
+ { "digest256", sha2lib_256_sum },
+ { "digest384", sha2lib_384_sum },
+ { "digest512", sha2lib_512_sum },
+ /*tex The next is consistent with |md5lib|: */
+ { "sum256", sha2lib_256_sum },
+ { "sum384", sha2lib_384_sum },
+ { "sum512", sha2lib_512_sum },
+ { "hex256", sha2lib_256_hex },
+ { "hex384", sha2lib_384_hex },
+ { "hex512", sha2lib_512_hex },
+ { "HEX256", sha2lib_256_HEX },
+ { "HEX384", sha2lib_384_HEX },
+ { "HEX512", sha2lib_512_HEX },
+ { NULL, NULL },
+};
+
+int luaopen_sha2(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, sha2lib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtsparselib.c b/source/luametatex/source/luarest/lmtsparselib.c
new file mode 100644
index 000000000..a5b599cea
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtsparselib.c
@@ -0,0 +1,305 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+ This module just provides as a more compact alternative for storing bitsets. I have no clue if
+ it ever will be used but we had this sparse tree mechanism so the overhead in terms of code is
+ neglectable. A possible application is bitmaps. Because we cross the c boundary it's about three
+ times slower when we get/set values than staying in \LUA\ although traversing from |min| to
+ |max| is performance wise the same. We could actually gain a bit when we add more helpers (like
+ |inc| and |dec| or so).
+
+ So, for the moment I consider this a low impact, and thereby undocumented, fun project.
+*/
+
+# define SPARSE_STACK 8
+# define SPARSE_BYTES 4
+
+typedef struct sa_tree_object {
+ sa_tree tree;
+ int min;
+ int max;
+} sa_tree_object;
+
+static sa_tree_object *sparselib_aux_check_is_sa_object(lua_State *L, int n)
+{
+ sa_tree_object *o = (sa_tree_object *) lua_touserdata(L, n);
+ if (o && lua_getmetatable(L, n)) {
+ lua_get_metatablelua(sparse_instance);
+ if (! lua_rawequal(L, -1, -2)) {
+ o = NULL;
+ }
+ lua_pop(L, 2);
+ if (o) {
+ return o;
+ }
+ }
+ tex_normal_warning("sparse lib", "lua <sparse object> expected");
+ return NULL;
+}
+
+/* bytes=1|2|4, default=0|* */
+
+static int sparselib_new(lua_State *L)
+{
+ int bytes = lmt_optinteger(L, 1, SPARSE_BYTES);
+ int defval = lmt_optinteger(L, 2, 0);
+ sa_tree_item item = { .int_value = defval };
+ sa_tree_object *o = lua_newuserdatauv(L, sizeof(sa_tree_object), 0);
+ switch (bytes) {
+ case 1:
+ {
+ unsigned char d = (defval < 0 ? 0 : (defval > 0xFF ? 0xFF : defval));
+ for (int i = 0; i <= 3; i++) {
+ item.uchar_value[i] = d ;
+ }
+ break;
+ }
+ case 2:
+ {
+ unsigned short d = (defval < 0 ? 0 : (defval > 0xFFFF ? 0xFFFF : defval));
+ for (int i = 0; i <= 1; i++) {
+ item.ushort_value[i] = d ;
+ }
+ break;
+ }
+ case 4:
+ break;
+ default:
+ bytes = SPARSE_BYTES;
+ break;
+ }
+ o->tree = sa_new_tree(SPARSE_STACK, bytes, item);
+ o->min = -1;
+ o->max = -1;
+ luaL_setmetatable(L, SPARSE_METATABLE_INSTANCE);
+ return 1;
+}
+
+static int sparselib_gc(lua_State *L)
+{
+ sa_tree_object *o = (sa_tree_object *) lua_touserdata(L, 1);
+ if (o) {
+ sa_destroy_tree(o->tree);
+ }
+ return 0;
+}
+
+static int sparselib_tostring(lua_State *L) {
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ lua_pushfstring(L, "<sa.object %p>", o->tree);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/* sparse, index, value */
+
+static int sparselib_set(lua_State *L) /* maybe also globalset as fast one */
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ quarterword level;
+ int slot = lmt_check_for_level(L, 2, &level, cur_level);
+ int n = lmt_tointeger(L, slot++);
+ if (n >= 0) {
+ int v = lmt_tointeger(L, slot++);
+ if (o->min < 0) {
+ o->min = n;
+ o->max = n;
+ } else if (n < o->min) {
+ o->min = n;
+ } else if (n > o->max) {
+ o->max = n;
+ }
+ sa_set_item_n(o->tree, n, v, (int) level);
+ }
+ }
+ return 0;
+}
+
+/* sparse, index */
+
+static int sparselib_get(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ int n = lmt_tointeger(L, 2);
+ if (n >= 0) {
+ lua_pushinteger(L, sa_get_item_n(o->tree, n));
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int sparselib_min(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ lua_pushinteger(L, o->min >= 0 ? o->min : 0);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int sparselib_max(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ lua_pushinteger(L, o->max >= 0 ? o->max : 0);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int sparselib_range(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ lua_pushinteger(L, o->min >= 0 ? o->min : 0);
+ lua_pushinteger(L, o->max >= 0 ? o->max : 0);
+ } else {
+ lua_pushnil(L);
+ lua_pushnil(L);
+ }
+ return 2;
+}
+
+static int sparselib_aux_nil(lua_State *L)
+{
+ lua_pushnil(L);
+ return 1;
+}
+
+static int sparselib_aux_next(lua_State *L)
+{
+ sa_tree_object *o = (sa_tree_object *) lua_touserdata(L, lua_upvalueindex(1));
+ int ind = lmt_tointeger(L, lua_upvalueindex(2));
+ if (ind <= o->max) {
+ lua_pushinteger(L, (lua_Integer) ind + 1);
+ lua_replace(L, lua_upvalueindex(2));
+ lua_pushinteger(L, ind);
+ lua_pushinteger(L, sa_get_item_n(o->tree, ind));
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+static int sparselib_traverse(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o && o->min >= 0) {
+ lua_settop(L, 1);
+ lua_pushinteger(L, o->min);
+ lua_pushcclosure(L, sparselib_aux_next, 2);
+ } else {
+ lua_pushcclosure(L, sparselib_aux_nil, 0);
+ }
+ return 1;
+}
+
+static int sparselib_concat(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ sa_tree t = o->tree;
+ if (t->bytes == 1) {
+ luaL_Buffer buffer;
+ int min = lmt_optinteger(L, 2, o->min);
+ int max = lmt_optinteger(L, 3, o->max);
+ if (min < 0) {
+ min = 0;
+ }
+ if (max < min) {
+ max = min;
+ }
+ /* quick hack: we can add whole slices */
+ luaL_buffinitsize(L, &buffer, (size_t) max - (size_t) min + 1);
+ for (int i = min; i <= max; i++) {
+ char c;
+ int h = LMT_SA_H_PART(i);
+ if (t->tree[h]) {
+ int m = LMT_SA_M_PART(i);
+ if (t->tree[h][m]) {
+ c = (char) t->tree[h][m][LMT_SA_L_PART(i)/4].uchar_value[i%4];
+ } else {
+ c = (char) t->dflt.uchar_value[i%4];
+ }
+ } else {
+ c = (char) t->dflt.uchar_value[i%4];
+ }
+ luaL_addlstring(&buffer, &c, 1);
+ }
+ luaL_pushresult(&buffer);
+ return 1;
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static int sparselib_restore(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ /* restore_sa_stack(o->tree, cur_level); */
+ sa_restore_stack(o->tree, cur_level+1);
+ }
+ return 0;
+}
+
+static int sparselib_wipe(lua_State *L)
+{
+ sa_tree_object *o = sparselib_aux_check_is_sa_object(L, 1);
+ if (o) {
+ int bytes = o->tree->bytes;
+ sa_tree_item dflt = o->tree->dflt;
+ sa_destroy_tree(o->tree);
+ o->tree = sa_new_tree(SPARSE_STACK, bytes, dflt);
+ o->min = -1;
+ o->max = -1;
+ }
+ return 0;
+}
+
+static const struct luaL_Reg sparselib_instance[] = {
+ { "__tostring", sparselib_tostring },
+ { "__gc", sparselib_gc },
+ { "__index", sparselib_get },
+ { "__newindex", sparselib_set },
+ { NULL, NULL },
+};
+
+static const luaL_Reg sparselib_function_list[] =
+{
+ { "new", sparselib_new },
+ { "set", sparselib_set },
+ { "get", sparselib_get },
+ { "min", sparselib_min },
+ { "max", sparselib_max },
+ { "range", sparselib_range },
+ { "traverse", sparselib_traverse },
+ { "concat", sparselib_concat },
+ { "restore", sparselib_restore },
+ { "wipe", sparselib_wipe },
+ { NULL, NULL },
+};
+
+int luaopen_sparse(lua_State *L)
+{
+ luaL_newmetatable(L, SPARSE_METATABLE_INSTANCE);
+ luaL_setfuncs(L, sparselib_instance, 0);
+ lua_newtable(L);
+ luaL_setfuncs(L, sparselib_function_list, 0);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtstrlibext.c b/source/luametatex/source/luarest/lmtstrlibext.c
new file mode 100644
index 000000000..78d7f760c
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtstrlibext.c
@@ -0,0 +1,927 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ The relative ordering of the header files is important here, otherwise some of the defines that
+ are needed for lua_sdump come out wrong.
+
+*/
+
+/* todo: byteconcat and utf concat (no separator) */
+
+# include "luametatex.h"
+
+/*tex Helpers */
+
+# define utf_fffd "\xEF\xBF\xBD"
+
+inline static int strlib_aux_tounicode(const char *s, size_t l, size_t *p)
+{
+ unsigned char i = s[*p];
+ *p += 1;
+ if (i < 0x80) {
+ return i;
+ } else if (i >= 0xF0) {
+ if ((*p + 2) < l) {
+ unsigned char j = s[*p];
+ unsigned char k = s[*p + 1];
+ unsigned char l = s[*p + 2];
+ if (j >= 0x80 && k >= 0x80 && l >= 0x80) {
+ *p += 3;
+ return (((((i - 0xF0) * 0x40) + (j - 0x80)) * 0x40) + (k - 0x80)) * 0x40 + (l - 0x80);
+ }
+ }
+ } else if (i >= 0xE0) {
+ if ((*p + 1) < l) {
+ unsigned char j = s[*p];
+ unsigned char k = s[*p + 1];
+ if (j >= 0x80 && k >= 0x80) {
+ *p += 2;
+ return (((i - 0xE0) * 0x40) + (j - 0x80)) * 0x40 + (k - 0x80);
+ }
+ }
+ } else if (i >= 0xC0) {
+ if (*p < l) {
+ unsigned char j = s[*p];
+ if (j >= 0x80) {
+ *p += 1;
+ return ((i - 0xC0) * 0x40) + (j - 0x80);
+ }
+ }
+ }
+ return 0xFFFD;
+}
+
+inline static int strlib_aux_tounichar(const char *s, size_t l, size_t p)
+{
+ unsigned char i = s[p++];
+ if (i < 0x80) {
+ return 1;
+ } else if (i >= 0xF0) {
+ if ((p + 2) < l) {
+ unsigned char j = s[p];
+ unsigned char k = s[p + 1];
+ unsigned char l = s[p + 2];
+ if (j >= 0x80 && k >= 0x80 && l >= 0x80) {
+ return 4;
+ }
+ }
+ } else if (i >= 0xE0) {
+ if ((p + 1) < l) {
+ unsigned char j = s[p];
+ unsigned char k = s[p + 1];
+ if (j >= 0x80 && k >= 0x80) {
+ return 3;
+ }
+ }
+ } else if (i >= 0xC0) {
+ if (p < l) {
+ unsigned char j = s[p];
+ if (j >= 0x80) {
+ return 2;
+ }
+ }
+ }
+ return 0;
+}
+
+inline static size_t strlib_aux_toline(const char *s, size_t l, size_t p, size_t *b)
+{
+ size_t i = p;
+ while (i < l) {
+ if (s[i] == 13) {
+ if ((i + 1) < l) {
+ if (s[i + 1] == 10) {
+ *b = 2; /* cr lf */
+ } else {
+ *b = 1; /* cr */
+ }
+ }
+ return i - p;
+ } else if (s[i] == 10) {
+ *b = 1; /* lf */
+ return i - p;
+ } else {
+ /* other */
+ i += 1;
+ }
+ }
+ return i - p ;
+}
+
+/*tex End of helpers. */
+
+static int strlib_aux_bytepairs(lua_State *L)
+{
+ size_t ls = 0;
+ const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls);
+ size_t ind = lmt_tointeger(L, lua_upvalueindex(2));
+ if (ind < ls) {
+ unsigned char i;
+ /*tex iterator */
+ if (ind + 1 < ls) {
+ lua_pushinteger(L, ind + 2);
+ } else {
+ lua_pushinteger(L, ind + 1);
+ }
+ lua_replace(L, lua_upvalueindex(2));
+ i = (unsigned char)*(s + ind);
+ /*tex byte one */
+ lua_pushinteger(L, i);
+ if (ind + 1 < ls) {
+ /*tex byte two */
+ i = (unsigned char)*(s + ind + 1);
+ lua_pushinteger(L, i);
+ } else {
+ /*tex odd string length */
+ lua_pushnil(L);
+ }
+ return 2;
+ } else {
+ return 0;
+ }
+}
+
+static int strlib_bytepairs(lua_State *L)
+{
+ luaL_checkstring(L, 1);
+ lua_settop(L, 1);
+ lua_pushinteger(L, 0);
+ lua_pushcclosure(L, strlib_aux_bytepairs, 2);
+ return 1;
+}
+
+static int strlib_aux_bytes(lua_State *L)
+{
+ size_t ls = 0;
+ const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls);
+ size_t ind = lmt_tointeger(L, lua_upvalueindex(2));
+ if (ind < ls) {
+ /*tex iterator */
+ lua_pushinteger(L, ind + 1);
+ lua_replace(L, lua_upvalueindex(2));
+ /*tex byte */
+ lua_pushinteger(L, (unsigned char)*(s + ind));
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int strlib_bytes(lua_State *L)
+{
+ luaL_checkstring(L, 1);
+ lua_settop(L, 1);
+ lua_pushinteger(L, 0);
+ lua_pushcclosure(L, strlib_aux_bytes, 2);
+ return 1;
+}
+
+static int strlib_aux_utf_failed(lua_State *L, int new_ind)
+{
+ lua_pushinteger(L, new_ind);
+ lua_replace(L, lua_upvalueindex(2));
+ lua_pushliteral(L, utf_fffd);
+ return 1;
+}
+
+/* kind of complex ... these masks */
+
+static int strlib_aux_utfcharacters(lua_State *L)
+{
+ static const unsigned char mask[4] = { 0x80, 0xE0, 0xF0, 0xF8 };
+ static const unsigned char mequ[4] = { 0x00, 0xC0, 0xE0, 0xF0 };
+ size_t ls = 0;
+ const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls);
+ size_t ind = lmt_tointeger(L, lua_upvalueindex(2));
+ size_t l = ls;
+ if (ind >= l) {
+ return 0;
+ } else {
+ unsigned char c = (unsigned char) s[ind];
+ for (size_t j = 0; j < 4; j++) {
+ if ((c & mask[j]) == mequ[j]) {
+ if (ind + 1 + j > l) {
+ /*tex The result will not fit. */
+ return strlib_aux_utf_failed(L, (int) l);
+ }
+ for (size_t k = 1; k <= j; k++) {
+ c = (unsigned char) s[ind + k];
+ if ((c & 0xC0) != 0x80) {
+ /*tex We have a bad follow byte. */
+ return strlib_aux_utf_failed(L, (int) (ind + k));
+ }
+ }
+ /*tex The iterator. */
+ lua_pushinteger(L, ind + j + 1);
+ lua_replace(L, lua_upvalueindex(2));
+ lua_pushlstring(L, ind + s, j + 1);
+ return 1;
+ }
+ }
+ return strlib_aux_utf_failed(L, (int) (ind + 1)); /* we found a follow byte! */
+ }
+}
+
+static int strlib_utfcharacters(lua_State *L)
+{
+ luaL_checkstring(L, 1);
+ lua_settop(L, 1);
+ lua_pushinteger(L, 0);
+ lua_pushcclosure(L, strlib_aux_utfcharacters, 2);
+ return 1;
+}
+
+static int strlib_aux_utfvalues(lua_State *L)
+{
+ size_t l = 0;
+ const char *s = lua_tolstring(L, lua_upvalueindex(1), &l);
+ size_t ind = lmt_tointeger(L, lua_upvalueindex(2));
+ if (ind < l) {
+ int v = strlib_aux_tounicode(s, l, &ind);
+ lua_pushinteger(L, ind);
+ lua_replace(L, lua_upvalueindex(2));
+ lua_pushinteger(L, v);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int strlib_utfvalues(lua_State *L)
+{
+ luaL_checkstring(L, 1);
+ lua_settop(L, 1);
+ lua_pushinteger(L, 0);
+ lua_pushcclosure(L, strlib_aux_utfvalues, 2);
+ return 1;
+}
+
+static int strlib_aux_characterpairs(lua_State *L)
+{
+ size_t ls = 0;
+ const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls);
+ size_t ind = lmt_tointeger(L, lua_upvalueindex(2));
+ if (ind < ls) {
+ char b[1];
+ lua_pushinteger(L, ind + 2); /*tex So we can overshoot ls here. */
+ lua_replace(L, lua_upvalueindex(2));
+ b[0] = s[ind];
+ lua_pushlstring(L, b, 1);
+ if ((ind + 1) < ls) {
+ b[0] = s[ind + 1];
+ lua_pushlstring(L, b, 1);
+ } else {
+ lua_pushliteral(L, "");
+ }
+ return 2;
+ } else {
+ return 0; /* string ended */
+ }
+}
+
+static int strlib_characterpairs(lua_State *L)
+{
+ luaL_checkstring(L, 1);
+ lua_settop(L, 1);
+ lua_pushinteger(L, 0);
+ lua_pushcclosure(L, strlib_aux_characterpairs, 2);
+ return 1;
+}
+
+static int strlib_aux_characters(lua_State *L)
+{
+ size_t ls = 0;
+ const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls);
+ size_t ind = lmt_tointeger(L, lua_upvalueindex(2));
+ if (ind < ls) {
+ char b[1];
+ lua_pushinteger(L, ind + 1); /* iterator */
+ lua_replace(L, lua_upvalueindex(2));
+ b[0] = *(s + ind);
+ lua_pushlstring(L, b, 1);
+ return 1;
+ } else {
+ return 0; /* string ended */
+ }
+}
+
+static int strlib_characters(lua_State *L)
+{
+ luaL_checkstring(L, 1);
+ lua_settop(L, 1);
+ lua_pushinteger(L, 0);
+ lua_pushcclosure(L, strlib_aux_characters, 2);
+ return 1;
+}
+
+static int strlib_bytetable(lua_State *L)
+{
+ size_t l;
+ const char *s = luaL_checklstring(L, 1, &l);
+ lua_createtable(L, (int) l, 0);
+ for (size_t i = 0; i < l; i++) {
+ lua_pushinteger(L, (unsigned char)*(s + i));
+ lua_rawseti(L, -2, i + 1);
+ }
+ return 1;
+}
+
+static int strlib_utfvaluetable(lua_State *L)
+{
+ size_t n = 1;
+ size_t l = 0;
+ size_t p = 0;
+ const char *s = luaL_checklstring(L, 1, &l);
+ lua_createtable(L, (int) l, 0);
+ while (p < l) {
+ lua_pushinteger(L, strlib_aux_tounicode(s, l, &p));
+ lua_rawseti(L, -2, n++);
+ }
+ return 1;
+}
+
+static int strlib_utfcharactertable(lua_State *L)
+{
+ size_t n = 1;
+ size_t l = 0;
+ size_t p = 0;
+ const char *s = luaL_checklstring(L, 1, &l);
+ lua_createtable(L, (int) l, 0);
+ while (p < l) {
+ int b = strlib_aux_tounichar(s, l, p);
+ if (b) {
+ lua_pushlstring(L, s + p, b);
+ p += b;
+ } else {
+ lua_pushliteral(L, utf_fffd);
+ p += 1;
+ }
+ lua_rawseti(L, -2, n++);
+ }
+ return 1;
+}
+
+static int strlib_linetable(lua_State *L)
+{
+ size_t n = 1;
+ size_t l = 0;
+ size_t p = 0;
+ const char *s = luaL_checklstring(L, 1, &l);
+ lua_createtable(L, (int) l, 0);
+ while (p < l) {
+ size_t b = 0;
+ size_t m = strlib_aux_toline(s, l, p, &b);
+ if (m) {
+ lua_pushlstring(L, s + p, m);
+ } else {
+ lua_pushliteral(L, "");
+ }
+ p += m + b;
+ lua_rawseti(L, -2, n++);
+ }
+ return 1;
+}
+
+/*tex
+
+ We provide a few helpers that we derived from the lua utf8 module and slunicode. That way we're
+ sort of covering a decent mix.
+
+*/
+
+# define MAXUNICODE 0x10FFFF
+
+/*tex
+
+ This is a combination of slunicode and utf8 converters but without mode and a bit faster on the
+ average than the utf8 one. The one character branch is a bit more efficient, as is preallocating
+ the buffer size.
+
+*/
+
+static int strlib_utfcharacter(lua_State *L) /* todo: use tounichar here too */
+{
+ int n = lua_gettop(L);
+ if (n == 1) {
+ char u[6];
+ char *c = aux_uni2string(&u[0], (unsigned) lua_tointeger(L, 1));
+ *c = '\0';
+ lua_pushstring(L, u);
+ return 1;
+ } else {
+ luaL_Buffer b;
+ luaL_buffinitsize(L, &b, (size_t) n * 4);
+ for (int i = 1; i <= n; i++) {
+ unsigned u = (unsigned) lua_tointeger(L, i);
+ if (u <= MAXUNICODE) {
+ if (0x80 > u) {
+ luaL_addchar(&b, (unsigned char) u);
+ } else {
+ if (0x800 > u)
+ luaL_addchar(&b, (unsigned char) (0xC0 | (u >> 6)));
+ else {
+ if (0x10000 > u)
+ luaL_addchar(&b, (unsigned char) (0xE0 | (u >> 12)));
+ else {
+ luaL_addchar(&b, (unsigned char) (0xF0 | (u >> 18)));
+ luaL_addchar(&b, (unsigned char) (0x80 | (0x3F & (u >> 12))));
+ }
+ luaL_addchar(&b, 0x80 | (0x3F & (u >> 6)));
+ }
+ luaL_addchar(&b, 0x80 | (0x3F & u));
+ }
+ }
+ }
+ luaL_pushresult(&b);
+ return 1;
+ }
+}
+
+/*tex
+
+ The \UTF8 codepoint function takes two arguments, being positions in the string, while slunicode
+ byte takes two arguments representing the number of utf characters. The variant below always
+ returns all codepoints.
+
+*/
+
+static int strlib_utfvalue(lua_State *L)
+{
+ size_t l = 0;
+ size_t p = 0;
+ int i = 0;
+ const char *s = luaL_checklstring(L, 1, &l);
+ while (p < l) {
+ lua_pushinteger(L, strlib_aux_tounicode(s, l, &p));
+ i++;
+ }
+ return i;
+}
+
+/*tex This is a simplified version of utf8.len but without range. */
+
+static int strlib_utflength(lua_State *L)
+{
+ size_t ls = 0;
+ size_t ind = 0;
+ size_t n = 0;
+ const char *s = lua_tolstring(L, 1, &ls);
+ while (ind < ls) {
+ unsigned char i = (unsigned char) *(s + ind);
+ if (i < 0x80) {
+ ind += 1;
+ } else if (i >= 0xF0) {
+ ind += 4;
+ } else if (i >= 0xE0) {
+ ind += 3;
+ } else if (i >= 0xC0) {
+ ind += 2;
+ } else {
+ /*tex bad news, stupid recovery */
+ ind += 1;
+ }
+ n++;
+ }
+ lua_pushinteger(L, n);
+ return 1;
+}
+
+/*tex A handy one that formats a float but also strips trailing zeros. */
+
+static int strlib_format_f6(lua_State *L)
+{
+ double n = luaL_optnumber(L, 1, 0.0);
+ if (n == 0.0) {
+ lua_pushliteral(L, "0");
+ } else if (n == 1.0) {
+ lua_pushliteral(L, "1");
+ } else {
+ char s[128];
+ int i, l;
+ /* we should check for max int */
+ if (fmod(n, 1) == 0) {
+ i = snprintf(s, 128, "%i", (int) n);
+ } else {
+ if (lua_type(L, 2) == LUA_TSTRING) {
+ const char *f = lua_tostring(L, 2);
+ i = snprintf(s, 128, f, n);
+ } else {
+ i = snprintf(s, 128, "%0.6f", n) ;
+ }
+ l = i - 1;
+ while (l > 1) {
+ if (s[l - 1] == '.') {
+ break;
+ } else if (s[l] == '0') {
+ s[l] = '\0';
+ --i;
+ } else {
+ break;
+ }
+ l--;
+ }
+ }
+ lua_pushlstring(L, s, i);
+ }
+ return 1;
+}
+
+/*tex
+ The next one is mostly provided as check because doing it in pure \LUA\ is not slower and it's
+ not a bottleneck anyway. There are soms subtle side effects when we don't check for these ranges,
+ especially the trigger bytes (|0xD7FF| etc.) because we can get negative numbers which means
+ wrapping around and such.
+*/
+
+inline static unsigned char strlib_aux_hexdigit(unsigned char n) {
+ return (n < 10 ? '0' : 'A' - 10) + n;
+}
+
+# define invalid_unicode(u) ( \
+ (u >= 0x00E000 && u <= 0x00F8FF) || \
+ (u >= 0x0F0000 && u <= 0x0FFFFF) || \
+ (u >= 0x100000 && u <= 0x10FFFF) || \
+ /* (u >= 0x00D800 && u <= 0x00DFFF)) { */ \
+ (u >= 0x00D7FF && u <= 0x00DFFF) \
+)
+
+static int strlib_format_tounicode16(lua_State *L)
+{
+ lua_Integer u = lua_tointeger(L, 1);
+ if (invalid_unicode(u)) {
+ lua_pushliteral(L, "FFFD");
+ } else if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
+ char s[4] ;
+ s[3] = strlib_aux_hexdigit((unsigned char) ((u & 0x000F) >> 0));
+ s[2] = strlib_aux_hexdigit((unsigned char) ((u & 0x00F0) >> 4));
+ s[1] = strlib_aux_hexdigit((unsigned char) ((u & 0x0F00) >> 8));
+ s[0] = strlib_aux_hexdigit((unsigned char) ((u & 0xF000) >> 12));
+ lua_pushlstring(L, s, 4);
+ } else {
+ unsigned u1, u2;
+ char s[8] ;
+ u = u - 0x10000; /* negative when invalid range */
+ u1 = (unsigned) (u >> 10) + 0xD800;
+ u2 = (unsigned) (u % 0x400) + 0xDC00;
+ s[3] = strlib_aux_hexdigit((unsigned char) ((u1 & 0x000F) >> 0));
+ s[2] = strlib_aux_hexdigit((unsigned char) ((u1 & 0x00F0) >> 4));
+ s[1] = strlib_aux_hexdigit((unsigned char) ((u1 & 0x0F00) >> 8));
+ s[0] = strlib_aux_hexdigit((unsigned char) ((u1 & 0xF000) >> 12));
+ s[7] = strlib_aux_hexdigit((unsigned char) ((u2 & 0x000F) >> 0));
+ s[6] = strlib_aux_hexdigit((unsigned char) ((u2 & 0x00F0) >> 4));
+ s[5] = strlib_aux_hexdigit((unsigned char) ((u2 & 0x0F00) >> 8));
+ s[4] = strlib_aux_hexdigit((unsigned char) ((u2 & 0xF000) >> 12));
+ lua_pushlstring(L, s, 8);
+ }
+ return 1;
+}
+
+static int strlib_format_toutf8(lua_State *L) /* could be integrated into utfcharacter */
+{
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ lua_Integer n = lua_rawlen(L, 1);
+ if (n > 0) {
+ luaL_Buffer b;
+ luaL_buffinitsize(L, &b, (n + 1) * 4);
+ for (lua_Integer i = 0; i <= n; i++) {
+ /* there should be one operation for getting a number from a table */
+ if (lua_rawgeti(L, 1, i) == LUA_TNUMBER) {
+ unsigned u = (unsigned) lua_tointeger(L, -1);
+ if (0x80 > u) {
+ luaL_addchar(&b, (unsigned char) u);
+ } else if (invalid_unicode(u)) {
+ luaL_addchar(&b, 0xFF);
+ luaL_addchar(&b, 0xFD);
+ } else {
+ if (0x800 > u)
+ luaL_addchar(&b, (unsigned char) (0xC0 | (u >> 6)));
+ else {
+ if (0x10000 > u)
+ luaL_addchar(&b, (unsigned char) (0xE0 | (u >> 12)));
+ else {
+ luaL_addchar(&b, (unsigned char) (0xF0 | (u >>18)));
+ luaL_addchar(&b, (unsigned char) (0x80 | (0x3F & (u >> 12))));
+ }
+ luaL_addchar(&b, 0x80 | (0x3F & (u >> 6)));
+ }
+ luaL_addchar(&b, 0x80 | (0x3F & u));
+ }
+ }
+ lua_pop(L, 1);
+ }
+ luaL_pushresult(&b);
+ } else {
+ lua_pushliteral(L, "");
+ }
+ return 1;
+ }
+ return 0;
+}
+
+/*
+static int strlib_format_toutf16(lua_State* L) {
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ lua_Integer n = lua_rawlen(L, 1);
+ if (n > 0) {
+ luaL_Buffer b;
+ luaL_buffinitsize(L, &b, (n + 2) * 4);
+ for (lua_Integer i = 0; i <= n; i++) {
+ if (lua_rawgeti(L, 1, i) == LUA_TNUMBER) {
+ unsigned u = (unsigned) lua_tointeger(L, -1);
+ if (invalid_unicode(u)) {
+ luaL_addchar(&b, 0xFF);
+ luaL_addchar(&b, 0xFD);
+ } else if (u < 0x10000) {
+ luaL_addchar(&b, (unsigned char) ((u & 0x00FF) ));
+ luaL_addchar(&b, (unsigned char) ((u & 0xFF00) >> 8));
+ } else {
+ u = u - 0x10000;
+ luaL_addchar(&b, (unsigned char) ((((u>>10)+0xD800) & 0x00FF) ));
+ luaL_addchar(&b, (unsigned char) ((((u>>10)+0xD800) & 0xFF00) >> 8));
+ luaL_addchar(&b, (unsigned char) (( (u%1024+0xDC00) & 0x00FF) ));
+ luaL_addchar(&b, (unsigned char) (( (u%1024+0xDC00) & 0xFF00) >> 8));
+ }
+ }
+ lua_pop(L, 1);
+ }
+ luaL_addchar(&b, 0);
+ luaL_addchar(&b, 0);
+ luaL_pushresult(&b);
+ } else {
+ lua_pushliteral(L, "");
+ }
+ return 1;
+ }
+ return 0;
+}
+*/
+
+static int strlib_format_toutf32(lua_State *L)
+{
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ lua_Integer n = lua_rawlen(L, 1);
+ if (n > 0) {
+ luaL_Buffer b;
+ luaL_buffinitsize(L, &b, (n + 2) * 4);
+ for (lua_Integer i = 0; i <= n; i++) {
+ /* there should be one operation for getting a number from a table */
+ if (lua_rawgeti(L, 1, i) == LUA_TNUMBER) {
+ unsigned u = (unsigned) lua_tointeger(L, -1);
+ if (invalid_unicode(u)) {
+ luaL_addchar(&b, 0x00);
+ luaL_addchar(&b, 0x00);
+ luaL_addchar(&b, 0xFF);
+ luaL_addchar(&b, 0xFD);
+ } else {
+ luaL_addchar(&b, (unsigned char) ((u & 0x000000FF) ));
+ luaL_addchar(&b, (unsigned char) ((u & 0x0000FF00) >> 8));
+ luaL_addchar(&b, (unsigned char) ((u & 0x00FF0000) >> 16));
+ luaL_addchar(&b, (unsigned char) ((u & 0xFF000000) >> 24));
+ }
+ }
+ lua_pop(L, 1);
+ }
+ for (int i = 0; i <= 3; i++) {
+ luaL_addchar(&b, 0);
+ }
+ luaL_pushresult(&b);
+ } else {
+ lua_pushliteral(L, "");
+ }
+ return 1;
+ }
+ return 0;
+}
+
+// static char map[] = {
+// '0', '1', '2', '3',
+// '4', '5', '6', '7',
+// '8', '9', 'A', 'B',
+// 'C', 'D', 'E', 'F',
+// };
+
+static int strlib_pack_rows_columns(lua_State* L)
+{
+ if (lua_type(L, 1) == LUA_TTABLE) {
+ lua_Integer rows = lua_rawlen(L, 1);
+ if (lua_rawgeti(L, 1, 1) == LUA_TTABLE) {
+ lua_Integer columns = lua_rawlen(L, -1);
+ switch (lua_rawgeti(L, -1, 1)) {
+ case LUA_TNUMBER:
+ {
+ lua_Integer size = rows * columns;
+ char *result = lmt_memory_malloc(size);
+ lua_pop(L, 2); /* row and cell */
+ if (result) {
+ char *first = result;
+ for (lua_Integer r = 1; r <= rows; r++) {
+ if (lua_rawgeti(L, -1, r) == LUA_TTABLE) {
+ for (lua_Integer c = 1; c <= columns; c++) {
+ if (lua_rawgeti(L, -1, c) == LUA_TNUMBER) {
+ lua_Integer v = lua_tointeger(L, -1);
+ if (v < 0) {
+ v = 0;
+ } else if (v > 255) {
+ v = 255;
+ }
+ *result++ = (char) v;
+ }
+ lua_pop(L, 1);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ lua_pushlstring(L, first, result - first);
+ return 1;
+ }
+ }
+ case LUA_TTABLE:
+ {
+ lua_Integer mode = lua_rawlen(L, -1);
+ lua_Integer size = rows * columns * mode;
+ char *result = lmt_memory_malloc(size);
+ lua_pop(L, 2); /* row and cell */
+ if (result) {
+ char *first = result;
+ for (lua_Integer r = 1; r <= rows; r++) {
+ if (lua_rawgeti(L, -1, r) == LUA_TTABLE) {
+ for (lua_Integer c = 1; c <= columns; c++) {
+ if (lua_rawgeti(L, -1, c) == LUA_TTABLE) {
+ for (int i = 1; i <= mode; i++) {
+ if (lua_rawgeti(L, -1, i) == LUA_TNUMBER) {
+ lua_Integer v = lua_tointeger(L, -1);
+ if (v < 0) {
+ v = 0;
+ } else if (v > 255) {
+ v = 255;
+ }
+ *result++ = (char) v;
+ }
+ lua_pop(L, 1);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ lua_pushlstring(L, first, result - first);
+ return 1;
+ }
+ }
+ }
+ }
+ }
+ lua_pushnil(L);
+ return 1;
+}
+
+static const luaL_Reg strlib_function_list[] = {
+ { "characters", strlib_characters },
+ { "characterpairs", strlib_characterpairs },
+ { "bytes", strlib_bytes },
+ { "bytepairs", strlib_bytepairs },
+ { "bytetable", strlib_bytetable },
+ { "linetable", strlib_linetable },
+ { "utfvalues", strlib_utfvalues },
+ { "utfcharacters", strlib_utfcharacters },
+ { "utfcharacter", strlib_utfcharacter },
+ { "utfvalue", strlib_utfvalue },
+ { "utflength", strlib_utflength },
+ { "utfvaluetable", strlib_utfvaluetable },
+ { "utfcharactertable", strlib_utfcharactertable },
+ { "f6", strlib_format_f6 },
+ { "tounicode16", strlib_format_tounicode16 },
+ { "toutf8", strlib_format_toutf8 },
+ /* { "toutf16", strlib_format_toutf16 }, */ /* untested */
+ { "toutf32", strlib_format_toutf32 },
+ { "packrowscolumns", strlib_pack_rows_columns },
+ { NULL, NULL },
+};
+
+int luaextend_string(lua_State * L)
+{
+ lua_getglobal(L, "string");
+ for (const luaL_Reg *lib = strlib_function_list; lib->name; lib++) {
+ lua_pushcfunction(L, lib->func);
+ lua_setfield(L, -2, lib->name);
+ }
+ lua_pop(L, 1);
+ return 1;
+}
+
+/*
+ The next (old, moved here) experiment was used to check if using some buffer is more efficient
+ than using a table that we concat. It makes no difference. If we ever use this, the initializer
+ |luaextend_string_buffer| will me merged into |luaextend_string|. We could gain a little on a
+ bit more efficient |luaL_checkudata| as we use elsewhere because in practice (surprise) its
+ overhead makes buffers like this {\em 50 percent} slower than the concatinated variant and
+ twice as slow when we reuse a temporary table. It's just better to stay at the \LUA\ end.
+*/
+
+/*
+# define STRING_BUFFER_METATABLE "string.buffer"
+
+typedef struct lmt_string_buffer {
+ char *buffer;
+ size_t length;
+ size_t size;
+ size_t step;
+ size_t padding;
+} lmt_string_buffer;
+
+static int strlib_buffer_gc(lua_State* L)
+{
+ lmt_string_buffer *b = (lmt_string_buffer *) luaL_checkudata(L, 1, STRING_BUFFER_METATABLE);
+ if (b && b->buffer) {
+ lmt_memory_free(b->buffer);
+ }
+ return 0;
+}
+
+static int strlib_buffer_new(lua_State* L)
+{
+ size_t size = lmt_optsizet(L, 1, LUAL_BUFFERSIZE);
+ size_t step = lmt_optsizet(L, 2, size);
+ lmt_string_buffer *b = (lmt_string_buffer *) lua_newuserdatauv(L, sizeof(lmt_string_buffer), 0);
+ b->buffer = lmt_memory_malloc(size);
+ b->size = size;
+ b->step = step;
+ b->length = 0;
+ luaL_setmetatable(L, STRING_BUFFER_METATABLE);
+ return 1;
+
+}
+
+static int strlib_buffer_add(lua_State* L)
+{
+ lmt_string_buffer *b = (lmt_string_buffer *) luaL_checkudata(L, 1, STRING_BUFFER_METATABLE);
+ switch (lua_type(L, 2)) {
+ case LUA_TSTRING:
+ {
+ size_t l;
+ const char *s = lua_tolstring(L, 2, &l);
+ size_t length = b->length + l;
+ if (length >= b->size) {
+ while (length >= b->size) {
+ b->size += b->step;
+ }
+ b->buffer = lmt_memory_realloc(b->buffer, b->size);
+ }
+ memcpy(&b->buffer[b->length], s, l);
+ b->length = length;
+ }
+ break;
+ default:
+ break;
+ }
+ return 0;
+}
+
+static int strlib_buffer_get_data(lua_State* L)
+{
+ lmt_string_buffer *b = (lmt_string_buffer *) luaL_checkudata(L, 1, STRING_BUFFER_METATABLE);
+ if (b->buffer) {
+ lua_pushlstring(L, b->buffer, b->length);
+ lua_pushinteger(L, (int) b->length);
+ return 2;
+ } else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+static int strlib_buffer_get_size(lua_State* L)
+{
+ lmt_string_buffer *b = (lmt_string_buffer *) luaL_checkudata(L, 1, STRING_BUFFER_METATABLE);
+ lua_pushinteger(L, b->length);
+ return 1;
+}
+
+static const luaL_Reg strlib_function_list_buffer[] = {
+ { "newbuffer", strlib_buffer_new },
+ { "addtobuffer", strlib_buffer_add },
+ { "getbufferdata", strlib_buffer_get_data },
+ { "getbuffersize", strlib_buffer_get_size },
+ { NULL, NULL },
+};
+
+int luaextend_string_buffer(lua_State * L)
+{
+ lua_getglobal(L, "string");
+ for (const luaL_Reg *lib = strlib_function_list_buffer; lib->name; lib++) {
+ lua_pushcfunction(L, lib->func);
+ lua_setfield(L, -2, lib->name);
+ }
+ lua_pop(L, 1);
+ luaL_newmetatable(L, STRING_BUFFER_METATABLE);
+ lua_pushcfunction(L, strlib_buffer_gc);
+ lua_setfield(L, -2, "__gc");
+ lua_pop(L, 1);
+ return 1;
+}
+
+*/
diff --git a/source/luametatex/source/luarest/lmtxcomplexlib.c b/source/luametatex/source/luarest/lmtxcomplexlib.c
new file mode 100644
index 000000000..b97a5ca23
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtxcomplexlib.c
@@ -0,0 +1,403 @@
+/*
+
+ See license.txt in the root of this project.
+
+ This is a reformatted and slightly adapted version of lcomplex.c:
+
+ title : C99 complex numbers for Lua 5.3+
+ author : Luiz Henrique de Figueiredo <lhf@tecgraf.puc-rio.br>
+ date : 26 Jul 2018 17:57:06
+ licence: This code is hereby placed in the public domain and also under the MIT license
+
+ That implementation doesn't work for MSVC so I rewrote the code to support the microsoft
+ compiler. I no longer use the macro approach to save bytes because with expanded code it is
+ easier to get rid of some compiler warnings (if possible at all).
+
+ In an optional module we hook the error functions into the complex library.
+
+ Note: Alan has to test if all works okay.
+
+*/
+
+# include "luametatex.h"
+
+# include <complex.h>
+
+# define COMPLEX_METATABLE "complex number"
+
+# if (_MSC_VER)
+
+ /*tex
+ Instead of the somewhat strange two-doubles-in-a-row hack in C the microsoft vatiant
+ uses structs. Here we use the double variant.
+ */
+
+ # define Complex _Dcomplex
+
+ inline static Complex xcomplexlib_get(lua_State *L, int i)
+ {
+ switch (lua_type(L, i)) {
+ case LUA_TUSERDATA:
+ return *((Complex*) luaL_checkudata(L, i, COMPLEX_METATABLE));
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ return _Cbuild(luaL_checknumber(L, i), 0);
+ default:
+ return _Cbuild(0, 0);
+ }
+ }
+
+# else
+
+ /*tex
+ Here we use the two-doubles-in-a-row variant.
+ */
+
+ # define Complex double complex
+
+ inline static Complex xcomplexlib_get(lua_State *L, int i)
+ {
+ switch (lua_type(L, i)) {
+ case LUA_TUSERDATA:
+ return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ return luaL_checknumber(L, i);
+ default:
+ return 0;
+ }
+ }
+
+# endif
+
+inline static int xcomplexlib_push(lua_State *L, Complex z)
+{
+ Complex *p = lua_newuserdatauv(L, sizeof(Complex), 0);
+ luaL_setmetatable(L, COMPLEX_METATABLE);
+ *p = z;
+ return 1;
+}
+
+# if (_MSC_VER)
+
+ static int xcomplexlib_new(lua_State *L)
+ {
+ xcomplexlib_push(L, _Cbuild(0, 0));
+ return 1;
+ }
+
+ static int xcomplexlib_inew(lua_State *L)
+ {
+ xcomplexlib_push(L, _Cbuild(0, 1));
+ return 1;
+ }
+
+ static int xcomplexlib_eq(lua_State *L)
+ {
+ Complex a = xcomplexlib_get(L, 1);
+ Complex b = xcomplexlib_get(L, 2);
+ lua_pushboolean(L, creal(a) == creal(b) && cimag(a) == cimag(b));
+ return 1;
+ }
+
+ static int xcomplexlib_add(lua_State *L) {
+ Complex a = xcomplexlib_get(L, 1);
+ Complex b = xcomplexlib_get(L, 2);
+ return xcomplexlib_push(L, _Cbuild(creal(a) + creal(b), cimag(a) + cimag(b)));
+ }
+
+ static int xcomplexlib_sub(lua_State *L) {
+ Complex a = xcomplexlib_get(L, 1);
+ Complex b = xcomplexlib_get(L, 2);
+ return xcomplexlib_push(L, _Cbuild(creal(a) - creal(b), cimag(a) - cimag(b)));
+ }
+
+ static int xcomplexlib_neg(lua_State *L) {
+ Complex a = xcomplexlib_get(L, 1);
+ return xcomplexlib_push(L, _Cbuild(-creal(a), -cimag(a)));
+ }
+
+ static int xcomplexlib_div(lua_State *L) {
+ Complex b = xcomplexlib_get(L, 2);
+ if (creal(b) == 0.0 || cimag(b) == 0.0) {
+ return 0;
+ } else {
+ Complex a = xcomplexlib_get(L, 1);
+ Complex t = { 1 / creal(b), 1 / cimag(b) };
+ return xcomplexlib_push(L, _Cmulcc(a, t));
+ }
+ }
+
+ static int xcomplexlib_mul(lua_State *L) {
+ Complex a = xcomplexlib_get(L, 1);
+ Complex b = xcomplexlib_get(L, 2);
+ return xcomplexlib_push(L, _Cmulcc(a, b));
+ }
+
+# else
+
+ static int xcomplexlib_new(lua_State *L)
+ {
+ return xcomplexlib_push(L, luaL_optnumber(L, 1, 0) + luaL_optnumber(L, 2, 0) * I);
+ }
+
+ static int xcomplexlib_inew(lua_State *L)
+ {
+ return xcomplexlib_push(L, I);
+ }
+
+ static int xcomplexlib_eq(lua_State *L)
+ {
+ lua_pushboolean(L, xcomplexlib_get(L, 1) == xcomplexlib_get(L, 2));
+ return 1;
+ }
+
+ static int xcomplexlib_add(lua_State *L)
+ {
+ return xcomplexlib_push(L, xcomplexlib_get(L, 1) + xcomplexlib_get(L, 2));
+ }
+
+ static int xcomplexlib_sub(lua_State *L)
+ {
+ return xcomplexlib_push(L, xcomplexlib_get(L, 1) - xcomplexlib_get(L, 2));
+ }
+
+ static int xcomplexlib_neg(lua_State *L)
+ {
+ return xcomplexlib_push(L, - xcomplexlib_get(L, 1));
+ }
+
+ static int xcomplexlib_div(lua_State *L)
+ {
+ return xcomplexlib_push(L, xcomplexlib_get(L, 1) / xcomplexlib_get(L, 2));
+ }
+
+ static int xcomplexlib_mul(lua_State *L)
+ {
+ return xcomplexlib_push(L, xcomplexlib_get(L, 1) * xcomplexlib_get(L, 2));
+ }
+
+# endif
+
+static int xcomplexlib_abs(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) cabs(xcomplexlib_get(L, 1)));
+ return 1;
+}
+
+static int xcomplexlib_acos(lua_State *L)
+{
+ return xcomplexlib_push(L, cacos(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_acosh(lua_State *L)
+{
+ return xcomplexlib_push(L, cacosh(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_arg(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) carg(xcomplexlib_get(L, 1)));
+ return 1;
+}
+
+static int xcomplexlib_asin(lua_State *L)
+{
+ return xcomplexlib_push(L, casin(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_asinh(lua_State *L)
+{
+ return xcomplexlib_push(L, casinh(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_atan(lua_State *L)
+{
+ return xcomplexlib_push(L, catan(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_atanh(lua_State *L)
+{
+ return xcomplexlib_push(L, catanh(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_cos(lua_State *L)
+{
+ return xcomplexlib_push(L, ccos(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_cosh(lua_State *L)
+{
+ return xcomplexlib_push(L, ccosh(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_exp(lua_State *L)
+{
+ xcomplexlib_push(L, cexp(xcomplexlib_get(L, 1)));
+ return 1;
+}
+
+static int xcomplexlib_imag(lua_State *L) {
+ lua_pushnumber(L, (lua_Number) (cimag)(xcomplexlib_get(L, 1)));
+ return 1;
+}
+
+static int xcomplexlib_log(lua_State *L)
+{
+ return xcomplexlib_push(L, clog(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_pow(lua_State *L)
+{
+ return xcomplexlib_push(L, cpow(xcomplexlib_get(L, 1), xcomplexlib_get(L, 2)));
+}
+
+static int xcomplexlib_proj(lua_State *L)
+{
+ return xcomplexlib_push(L, cproj(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_real(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) creal(xcomplexlib_get(L, 1)));
+ return 1;
+}
+
+static int xcomplexlib_sin(lua_State *L)
+{
+ return xcomplexlib_push(L, csin(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_sinh(lua_State *L)
+{
+ return xcomplexlib_push(L, csinh(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_sqrt(lua_State *L)
+{
+ return xcomplexlib_push(L, csqrt(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_tan(lua_State *L)
+{
+ return xcomplexlib_push(L, ctan(xcomplexlib_get(L, 1)));
+}
+
+static int xcomplexlib_tanh(lua_State *L)
+{
+ return xcomplexlib_push(L, ctanh(xcomplexlib_get(L, 1)));
+}
+
+/*tex A few convenience functions: */
+
+static int xcomplexlib_tostring(lua_State *L)
+{
+ Complex z = xcomplexlib_get(L, 1);
+ lua_Number x = creal(z);
+ lua_Number y = cimag(z);
+ lua_settop(L, 0);
+ if (x != 0.0 || y == 0.0) {
+ lua_pushnumber(L, x);
+ }
+ if (y != 0.0) {
+ if (y == 1.0) {
+ if (x != 0.0) {
+ lua_pushliteral(L, "+");
+ }
+ } else if (y == -1.0) {
+ lua_pushliteral(L, "-");
+ } else {
+ if (y > 0.0 && x != 0.0) {
+ lua_pushliteral(L, "+");
+ }
+ lua_pushnumber(L, y);
+ }
+ lua_pushliteral(L, "i");
+ }
+ lua_concat(L, lua_gettop(L));
+ return 1;
+}
+
+static int xcomplexlib_topair(lua_State *L)
+{
+ Complex z = xcomplexlib_get(L, 1);
+ lua_pushnumber(L, (lua_Number) creal(z));
+ lua_pushnumber(L, (lua_Number) cimag(z));
+ return 2;
+}
+
+static int xcomplexlib_totable(lua_State *L)
+{
+ Complex z = xcomplexlib_get(L, 1);
+ lua_createtable(L, 2, 0);
+ lua_pushnumber(L, (lua_Number) creal(z));
+ lua_pushnumber(L, (lua_Number) cimag(z));
+ lua_rawseti(L, -3, 1);
+ lua_rawseti(L, -3, 2);
+ return 1;
+}
+
+/*tex Now we assemble the library: */
+
+static const struct luaL_Reg xcomplexlib_function_list[] = {
+ /* management */
+ { "new", xcomplexlib_new },
+ { "tostring", xcomplexlib_tostring },
+ { "topair", xcomplexlib_topair },
+ { "totable", xcomplexlib_totable },
+ { "i", xcomplexlib_inew },
+ /* operators */
+ { "__add", xcomplexlib_add },
+ { "__div", xcomplexlib_div },
+ { "__eq", xcomplexlib_eq },
+ { "__mul", xcomplexlib_mul },
+ { "__sub", xcomplexlib_sub },
+ { "__unm", xcomplexlib_neg },
+ { "__pow", xcomplexlib_pow },
+ /* functions */
+ { "abs", xcomplexlib_abs },
+ { "acos", xcomplexlib_acos },
+ { "acosh", xcomplexlib_acosh },
+ { "arg", xcomplexlib_arg },
+ { "asin", xcomplexlib_asin },
+ { "asinh", xcomplexlib_asinh },
+ { "atan", xcomplexlib_atan },
+ { "atanh", xcomplexlib_atanh },
+ { "conj", xcomplexlib_neg },
+ { "cos", xcomplexlib_cos },
+ { "cosh", xcomplexlib_cosh },
+ { "exp", xcomplexlib_exp },
+ { "imag", xcomplexlib_imag },
+ { "log", xcomplexlib_log },
+ { "pow", xcomplexlib_pow },
+ { "proj", xcomplexlib_proj },
+ { "real", xcomplexlib_real },
+ { "sin", xcomplexlib_sin },
+ { "sinh", xcomplexlib_sinh },
+ { "sqrt", xcomplexlib_sqrt },
+ { "tan", xcomplexlib_tan },
+ { "tanh", xcomplexlib_tanh },
+ /* */
+ { NULL, NULL },
+};
+
+int luaopen_xcomplex(lua_State *L)
+{
+ luaL_newmetatable(L, COMPLEX_METATABLE);
+ luaL_setfuncs(L, xcomplexlib_function_list, 0);
+ lua_pushliteral(L, "__index");
+ lua_pushvalue(L, -2);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__tostring");
+ lua_pushliteral(L, "tostring");
+ lua_gettable(L, -3);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "I");
+ lua_pushliteral(L, "i");
+ lua_gettable(L, -3);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__name"); /* kind of redundant */
+ lua_pushliteral(L, "complex");
+ lua_settable(L, -3);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtxdecimallib.c b/source/luametatex/source/luarest/lmtxdecimallib.c
new file mode 100644
index 000000000..5f3673821
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtxdecimallib.c
@@ -0,0 +1,503 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*
+ decNumberCompare(decNumber *, const decNumber *, const decNumber *, decContext *);
+
+ decNumberRemainder(decNumber *, const decNumber *, const decNumber *, decContext *);
+ decNumberRemainderNear(decNumber *, const decNumber *, const decNumber *, decContext *);
+
+ # define decNumberIsCanonical(dn)
+ # define decNumberIsFinite(dn)
+ # define decNumberIsInfinite(dn)
+ # define decNumberIsNaN(dn)
+ # define decNumberIsNegative(dn)
+ # define decNumberIsQNaN(dn)
+ # define decNumberIsSNaN(dn)
+ # define decNumberIsSpecial(dn)
+ # define decNumberIsZero(dn)
+ # define decNumberRadix(dn)
+
+ The main reason why we have this module is that we already load the library in \METAPOST\
+ so it was a trivial extension to make. Because it is likely that we keep decimal support
+ there, it is also quite likely that we keep this module, even if it's rarely used. The binary
+ number system used in \METAPOST\ is not included. It is even less likely to be used and adds
+ much to the binary. Some more functions might be added here so that we become more compatible
+ with the other math libraries that are present.
+
+*/
+
+# include <luametatex.h>
+
+# include <decContext.h>
+# include <decNumber.h>
+
+# define DECIMAL_METATABLE "decimal number"
+
+typedef decNumber *decimal;
+
+static decContext context;
+
+# define min_precision 25
+# define default_precision 50
+# define max_precision 2500
+
+static void xdecimallib_initialize(void)
+{
+ decContextDefault(&context, DEC_INIT_BASE);
+ context.traps = 0;
+ context.emax = 999999;
+ context.emin = -999999;
+ context.digits = default_precision;
+}
+
+/*tex
+ Todo: Use metatable at the top. But we're not going to crunch numbers anyway so for now there
+ is no need for it. Anyway, the overhade of calculations is much larger than that of locating
+ a metatable.
+*/
+
+inline static decimal xdecimallib_push(lua_State *L)
+{
+ decimal p = lua_newuserdatauv(L, sizeof(decNumber), 0);
+ luaL_setmetatable(L, DECIMAL_METATABLE);
+ return p;
+}
+
+static void decNumberFromDouble(decNumber *A, double B, decContext *C) /* from mplib, extra arg */
+{
+ char buf[1000];
+ char *c;
+ snprintf(buf, 1000, "%-650.325lf", B);
+ c = buf;
+ while (*c++) {
+ if (*c == ' ') {
+ *c = '\0';
+ break;
+ }
+ }
+ decNumberFromString(A, buf, C);
+}
+
+inline static int xdecimallib_new(lua_State *L)
+{
+ decimal p = xdecimallib_push(L);
+ switch (lua_type(L, 1)) {
+ case LUA_TSTRING:
+ decNumberFromString(p, lua_tostring(L, 1), &context);
+ break;
+ case LUA_TNUMBER:
+ if (lua_isinteger(L, 1)) {
+ decNumberFromInt32(p, (int32_t) lua_tointeger(L, 1));
+ } else {
+ decNumberFromDouble(p, lua_tonumber(L, 1), &context);
+ }
+ break;
+ default:
+ decNumberZero(p);
+ break;
+ }
+ return 1;
+}
+
+/*
+ This is nicer for the user. Beware, we create a userdata object on the stack so we need to
+ replace the original non userdata.
+*/
+
+static decimal xdecimallib_get(lua_State *L, int i)
+{
+ switch (lua_type(L, i)) {
+ case LUA_TUSERDATA:
+ return (decimal) luaL_checkudata(L, i, DECIMAL_METATABLE);
+ case LUA_TSTRING:
+ {
+ decimal p = xdecimallib_push(L);
+ decNumberFromString(p, lua_tostring(L, i), &context);
+ lua_replace(L, i);
+ return p;
+ }
+ case LUA_TNUMBER:
+ {
+ decimal p = xdecimallib_push(L);
+ if (lua_isinteger(L, i)) {
+ decNumberFromInt32(p, (int32_t) lua_tointeger(L, i));
+ } else {
+ decNumberFromDouble(p, lua_tonumber(L, i), &context);
+ }
+ lua_replace(L, i);
+ return p;
+ }
+ default:
+ {
+ decimal p = xdecimallib_push(L);
+ decNumberZero(p);
+ lua_replace(L, i);
+ return p;
+ }
+ }
+}
+
+static int xdecimallib_tostring(lua_State *L)
+{
+ decimal a = xdecimallib_get(L, 1);
+ luaL_Buffer buffer;
+ char *b = luaL_buffinitsize(L, &buffer, (size_t) a->digits + 14);
+ decNumberToString(a, b);
+ luaL_addsize(&buffer, strlen(b));
+ luaL_pushresult(&buffer);
+ return 1;
+}
+
+static int xdecimallib_toengstring(lua_State *L)
+{
+ decimal a = xdecimallib_get(L, 1);
+ luaL_Buffer buffer;
+ char *b = luaL_buffinitsize(L, &buffer, (size_t) a->digits + 14);
+ decNumberToEngString(a, b);
+ luaL_addsize(&buffer, strlen(b));
+ luaL_pushresult(&buffer);
+ return 1;
+}
+
+static int xdecimallib_tonumber(lua_State *L)
+{
+ decimal a = xdecimallib_get(L, 1);
+ char *buffer = lmt_memory_malloc((size_t) a->digits + 14); /* could be shared */
+ if (buffer) {
+ double result = 0.0;
+ decNumberToString(a, buffer);
+ if (sscanf(buffer, "%lf", &result)) {
+ lua_pushnumber(L, result);
+ } else {
+ lua_pushnil(L);
+ }
+ lmt_memory_free(buffer);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static int xdecimallib_copy(lua_State *L)
+{
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberCopy(p, a);
+ return 1;
+}
+
+static int xdecimallib_eq(lua_State *L)
+{
+ decNumber result;
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decNumberCompare(&result, a, b, &context);
+ lua_pushboolean(L, decNumberIsZero(&result));
+ return 1;
+}
+
+static int xdecimallib_le(lua_State *L)
+{
+ decNumber result;
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2); /* todo: also number or string */
+ decNumberCompare(&result, a, b, &context);
+ lua_pushboolean(L, decNumberIsNegative(&result) || decNumberIsZero(&result));
+ return 1;
+}
+
+static int xdecimallib_lt(lua_State *L)
+{
+ decNumber result;
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2); /* todo: also number or string */
+ decNumberCompare(&result, a, b, &context);
+ lua_pushboolean(L, decNumberIsNegative(&result));
+ return 1;
+}
+
+static int xdecimallib_add(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberAdd(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_sub(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberSubtract(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_mul(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberMultiply(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_div(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberDivide(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_idiv(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberDivideInteger(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_mod(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberRemainder(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_neg(lua_State* L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberCopyNegate(p, a);
+ return 1;
+}
+
+static int xdecimallib_min(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberMin(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_max(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberMax(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_minus(lua_State* L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberNextMinus(p, a, &context);
+ return 1;
+}
+
+static int xdecimallib_plus(lua_State* L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberNextPlus(p, a, &context);
+ return 1;
+}
+
+static int xdecimallib_trim(lua_State* L) {
+ decimal a = xdecimallib_get(L, 1);
+ decNumberTrim(a);
+ return 0;
+}
+
+static int xdecimallib_pow(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberPower(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_abs(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberCopyAbs(p, a);
+ return 1;
+}
+
+static int xdecimallib_sqrt(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberSquareRoot(p, a, &context);
+ return 1;
+}
+
+static int xdecimallib_ln(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberLn(p, a, &context);
+ return 1;
+}
+
+static int xdecimallib_log10(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberLog10(p, a, &context);
+ return 1;
+}
+
+static int xdecimallib_exp(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal p = xdecimallib_push(L);
+ decNumberExp(p, a, &context);
+ return 1;
+}
+
+static int xdecimallib_rotate(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberRotate(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_shift(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberShift(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_left(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ lua_Integer shift = luaL_optinteger(L, 2, 1);
+ decimal p = xdecimallib_push(L);
+ decNumber s;
+ decNumberFromInt32(&s, (int32_t) shift);
+ decNumberShift(p, a, &s, &context);
+ return 1;
+}
+
+static int xdecimallib_right(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ lua_Integer shift = - luaL_optinteger(L, 2, 1);
+ decimal p = xdecimallib_push(L);
+ decNumber s;
+ decNumberFromInt32(&s, (int32_t) shift);
+ decNumberShift(p, a, &s, &context);
+ return 1;
+}
+
+static int xdecimallib_and(lua_State *L) {
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberAnd(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_or(lua_State *L)
+{
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberOr(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_xor(lua_State *L)
+{
+ decimal a = xdecimallib_get(L, 1);
+ decimal b = xdecimallib_get(L, 2);
+ decimal p = xdecimallib_push(L);
+ decNumberXor(p, a, b, &context);
+ return 1;
+}
+
+static int xdecimallib_setp(lua_State *L)
+{
+ int i = (int) luaL_optinteger(L, 1, default_precision);
+ if (i < min_precision) {
+ context.digits = min_precision;
+ } else if (i > max_precision) {
+ context.digits = max_precision;
+ } else {
+ context.digits = i;
+ }
+ lua_pushinteger(L, context.digits);
+ return 1;
+}
+
+static int xdecimallib_getp(lua_State *L)
+{
+ lua_pushinteger(L, context.digits);
+ return 1;
+}
+
+static const luaL_Reg xdecimallib_function_list[] =
+{
+ /* management */
+ { "new", xdecimallib_new },
+ { "copy", xdecimallib_copy },
+ { "trim", xdecimallib_trim },
+ { "tostring", xdecimallib_tostring },
+ { "toengstring", xdecimallib_toengstring },
+ { "tonumber", xdecimallib_tonumber },
+ { "setprecision", xdecimallib_setp },
+ { "getprecision", xdecimallib_getp },
+ /* operators */
+ { "__add", xdecimallib_add },
+ { "__idiv", xdecimallib_idiv },
+ { "__div", xdecimallib_div },
+ { "__mod", xdecimallib_mod },
+ { "__eq", xdecimallib_eq },
+ { "__le", xdecimallib_le },
+ { "__lt", xdecimallib_lt },
+ { "__mul", xdecimallib_mul },
+ { "__sub", xdecimallib_sub },
+ { "__unm", xdecimallib_neg },
+ { "__pow", xdecimallib_pow },
+ { "__bor", xdecimallib_or },
+ { "__bxor", xdecimallib_xor },
+ { "__band", xdecimallib_and },
+ { "__shl", xdecimallib_left },
+ { "__shr", xdecimallib_right },
+ /* functions */
+ { "conj", xdecimallib_neg },
+ { "abs", xdecimallib_abs },
+ { "pow", xdecimallib_pow },
+ { "sqrt", xdecimallib_sqrt },
+ { "ln", xdecimallib_ln },
+ { "log", xdecimallib_log10 },
+ { "exp", xdecimallib_exp },
+ { "bor", xdecimallib_or },
+ { "bxor", xdecimallib_xor },
+ { "band", xdecimallib_and },
+ { "shift", xdecimallib_shift },
+ { "rotate", xdecimallib_rotate },
+ { "minus", xdecimallib_minus },
+ { "plus", xdecimallib_plus },
+ { "min", xdecimallib_min },
+ { "max", xdecimallib_max },
+ /* */
+ { NULL, NULL },
+};
+
+int luaopen_xdecimal(lua_State *L)
+{
+ xdecimallib_initialize();
+
+ luaL_newmetatable(L, DECIMAL_METATABLE);
+ luaL_setfuncs(L, xdecimallib_function_list, 0);
+ lua_pushliteral(L, "__index");
+ lua_pushvalue(L, -2);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__tostring");
+ lua_pushliteral(L, "tostring");
+ lua_gettable(L, -3);
+ lua_settable(L, -3);
+ lua_pushliteral(L, "__name");
+ lua_pushliteral(L, "decimal");
+ lua_settable(L, -3);
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtxmathlib.c b/source/luametatex/source/luarest/lmtxmathlib.c
new file mode 100644
index 000000000..474398228
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtxmathlib.c
@@ -0,0 +1,500 @@
+/*
+
+ See license.txt in the root of this project.
+
+ This is a reformatted and slightly adapted version of lmathx.c:
+
+ title : C99 math functions for Lua 5.3+
+ author : Luiz Henrique de Figueiredo <lhf@tecgraf.puc-rio.br>
+ date : 24 Jun 2015 09:51:50
+ licence: This code is hereby placed in the public domain.
+
+ In the end I just expanded and adapted the code a bit which made it easier to get rid of some
+ compiler warnings (if possible at all).
+
+*/
+
+# include "luametatex.h"
+
+# include <math.h>
+
+# define xmathlib_pi ((lua_Number)(3.141592653589793238462643383279502884))
+# define xmathlib_180 ((lua_Number) 180.0)
+# define xmathlib_inf ((lua_Number) INFINITY)
+# define xmathlib_nan ((lua_Number) NAN)
+
+static int xmathlib_acos(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) acos(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_acosh(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) acosh(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_asin(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) asin(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_asinh(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) asinh(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_atan(lua_State *L)
+{
+ if (lua_gettop(L) == 1) {
+ lua_pushnumber(L, (lua_Number) atan(luaL_checknumber(L, 1)));
+ } else {
+ lua_pushnumber(L, (lua_Number) atan2(luaL_checknumber(L, 1),luaL_checknumber(L, 2)));
+ }
+ return 1;
+}
+
+static int xmathlib_atan2(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) atan2(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_atanh(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) atanh(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_cbrt(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) cbrt(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_ceil(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) ceil(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_copysign (lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) copysign(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_cos(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) cos(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_cosh(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) cosh(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_deg(lua_State *L)
+{
+ lua_pushnumber(L, luaL_checknumber(L, 1) * (xmathlib_180 / xmathlib_pi));
+ return 1;
+}
+
+static int xmathlib_erf(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) erf(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_erfc(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) erfc(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_exp(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) exp(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_exp2(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) exp2(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_expm1(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) expm1(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_fabs(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) fabs(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_fdim(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) fdim(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_floor(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) floor(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_fma(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) fma(luaL_checknumber(L, 1), luaL_checknumber(L, 2), luaL_checknumber(L, 3)));
+ return 1;
+}
+
+static int xmathlib_fmax(lua_State *L)
+{
+ int n = lua_gettop(L);
+ lua_Number m = luaL_checknumber(L, 1);
+ for (int i = 2; i <= n; i++) {
+ m = (lua_Number) fmax(m, luaL_checknumber(L, i));
+ }
+ lua_pushnumber(L, m);
+ return 1;
+}
+
+static int xmathlib_fmin(lua_State *L)
+{
+ int n = lua_gettop(L);
+ lua_Number m = luaL_checknumber(L, 1);
+ for (int i = 2; i <= n; i++) {
+ m = (lua_Number) fmin(m, luaL_checknumber(L, i));
+ }
+ lua_pushnumber(L, m);
+ return 1;
+}
+
+static int xmathlib_fmod(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) fmod(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_frexp(lua_State *L)
+{
+ int e;
+ lua_pushnumber(L, (lua_Number) frexp(luaL_checknumber(L, 1), &e));
+ lua_pushinteger(L, e);
+ return 2;
+}
+static int xmathlib_fremquo(lua_State *L)
+{
+ int e;
+ lua_pushnumber(L, (lua_Number) remquo(luaL_checknumber(L, 1),luaL_checknumber(L, 2), &e));
+ lua_pushinteger(L, e);
+ return 2;
+}
+
+static int xmathlib_gamma(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) tgamma(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_hypot(lua_State *L)
+{
+ lua_pushnumber(L, hypot(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_isfinite(lua_State *L)
+{
+ lua_pushboolean(L, isfinite(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_isinf(lua_State *L)
+{
+ lua_pushboolean(L, isinf(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_isnan(lua_State *L)
+{
+ lua_pushboolean(L, isnan(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_isnormal (lua_State *L)
+{
+ lua_pushboolean(L, isnormal(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_j0(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) j0(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_j1(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) j1(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_jn(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) jn((int) luaL_checkinteger(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_ldexp(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) ldexp(luaL_checknumber(L, 1), (int) luaL_checkinteger(L, 2)));
+ return 1;
+}
+
+static int xmathlib_lgamma(lua_State *L)
+{
+ lua_pushnumber (L, (lua_Number) lgamma(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_log(lua_State *L)
+{
+ if (lua_gettop(L) == 1) {
+ lua_pushnumber(L, (lua_Number) log(luaL_checknumber(L, 1)));
+ } else {
+ lua_Number n = luaL_checknumber(L, 2);
+ if (n == 10.0) {
+ n = (lua_Number) log10(luaL_checknumber(L, 1));
+ } else if (n == 2.0) {
+ n = (lua_Number) log2(luaL_checknumber(L, 1));
+ } else {
+ n = (lua_Number) log(luaL_checknumber(L, 1)) / (lua_Number) log(n);
+ }
+ lua_pushnumber(L, n);
+ }
+ return 1;
+}
+
+static int xmathlib_log10(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) log10(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_log1p(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) log1p(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_log2(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) log2(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_logb(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) logb(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_modf(lua_State *L)
+{
+ lua_Number ip;
+ lua_Number fp = (lua_Number) modf(luaL_checknumber(L, 1), &ip);
+ lua_pushnumber(L, ip);
+ lua_pushnumber(L, fp);
+ return 2;
+}
+
+static int xmathlib_nearbyint(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) nearbyint(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_nextafter(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) nextafter(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_pow(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) pow(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_rad(lua_State *L)
+{
+ lua_pushnumber(L, (luaL_checknumber(L, 1) * (xmathlib_pi / xmathlib_180)));
+ return 1;
+}
+
+static int xmathlib_remainder(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) remainder(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int xmathlib_round(lua_State *L)
+{
+ lua_pushinteger(L, lround(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_scalbn(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) scalbn(luaL_checknumber(L, 1), (int) luaL_checkinteger(L, 2)));
+ return 1;
+}
+
+static int xmathlib_sin(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) sin(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_sinh(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) sinh(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_sqrt(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) sqrt(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_tan(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) tan(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_tanh(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) tanh(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_tgamma(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) tgamma(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_trunc(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) trunc(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_y0(lua_State *L)
+{
+ lua_pushnumber(L, (lua_Number) y0(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_y1(lua_State *L)
+{
+ lua_pushnumber(L, y1(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int xmathlib_yn(lua_State *L)
+{
+ lua_pushnumber(L, yn((int) luaL_checkinteger(L, 1), luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static const luaL_Reg xmathlib_function_list[] =
+{
+ { "acos", xmathlib_acos },
+ { "acosh", xmathlib_acosh },
+ { "asin", xmathlib_asin },
+ { "asinh", xmathlib_asinh },
+ { "atan", xmathlib_atan },
+ { "atan2", xmathlib_atan2 },
+ { "atanh", xmathlib_atanh },
+ { "cbrt", xmathlib_cbrt },
+ { "ceil", xmathlib_ceil },
+ { "copysign", xmathlib_copysign },
+ { "cos", xmathlib_cos },
+ { "cosh", xmathlib_cosh },
+ { "deg", xmathlib_deg },
+ { "erf", xmathlib_erf },
+ { "erfc", xmathlib_erfc },
+ { "exp", xmathlib_exp },
+ { "exp2", xmathlib_exp2 },
+ { "expm1", xmathlib_expm1 },
+ { "fabs", xmathlib_fabs },
+ { "fdim", xmathlib_fdim },
+ { "floor", xmathlib_floor },
+ { "fma", xmathlib_fma },
+ { "fmax", xmathlib_fmax },
+ { "fmin", xmathlib_fmin },
+ { "fmod", xmathlib_fmod },
+ { "frexp", xmathlib_frexp },
+ { "gamma", xmathlib_gamma },
+ { "hypot", xmathlib_hypot },
+ { "isfinite", xmathlib_isfinite },
+ { "isinf", xmathlib_isinf },
+ { "isnan", xmathlib_isnan },
+ { "isnormal", xmathlib_isnormal },
+ { "j0", xmathlib_j0 },
+ { "j1", xmathlib_j1 },
+ { "jn", xmathlib_jn },
+ { "ldexp", xmathlib_ldexp },
+ { "lgamma", xmathlib_lgamma },
+ { "log", xmathlib_log },
+ { "log10", xmathlib_log10 },
+ { "log1p", xmathlib_log1p },
+ { "log2", xmathlib_log2 },
+ { "logb", xmathlib_logb },
+ { "modf", xmathlib_modf },
+ { "nearbyint", xmathlib_nearbyint },
+ { "nextafter", xmathlib_nextafter },
+ { "pow", xmathlib_pow },
+ { "rad", xmathlib_rad },
+ { "remainder", xmathlib_remainder },
+ { "remquo", xmathlib_fremquo },
+ { "round", xmathlib_round },
+ { "scalbn", xmathlib_scalbn },
+ { "sin", xmathlib_sin },
+ { "sinh", xmathlib_sinh },
+ { "sqrt", xmathlib_sqrt },
+ { "tan", xmathlib_tan },
+ { "tanh", xmathlib_tanh },
+ { "tgamma", xmathlib_tgamma },
+ { "trunc", xmathlib_trunc },
+ { "y0", xmathlib_y0 },
+ { "y1", xmathlib_y1 },
+ { "yn", xmathlib_yn },
+ { NULL, NULL },
+};
+
+int luaopen_xmath(lua_State *L)
+{
+ luaL_newlib(L, xmathlib_function_list);
+ lua_pushnumber(L, xmathlib_inf);
+ lua_setfield(L, -2, "inf");
+ lua_pushnumber(L, xmathlib_nan);
+ lua_setfield(L, -2, "nan");
+ lua_pushnumber(L, xmathlib_pi);
+ lua_setfield(L, -2, "pi");
+ return 1;
+}
diff --git a/source/luametatex/source/luarest/lmtziplib.c b/source/luametatex/source/luarest/lmtziplib.c
new file mode 100644
index 000000000..099f99830
--- /dev/null
+++ b/source/luametatex/source/luarest/lmtziplib.c
@@ -0,0 +1,206 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# define ZLIB_CONST 1
+
+# include "luametatex.h"
+
+/*tex
+
+ This is a rather minimalistic interface to zlib. We can wrap around it and need some specific
+ file overhead anyway. Also, we never needed all that stream stuff.
+
+*/
+
+# define ziplib_in_char_ptr const unsigned char *
+# define ziplib_out_char_ptr unsigned char *
+
+# define ziplib_buffer_size 16*1024
+
+static int ziplib_aux_compress(
+ lua_State *L,
+ const char *data,
+ int size,
+ int level,
+ int method,
+ int window,
+ int memory,
+ int strategy,
+ int buffersize
+)
+{
+ int state;
+ z_stream zipstream;
+ zipstream.zalloc = &lmt_zlib_alloc; /* Z_NULL */
+ zipstream.zfree = &lmt_zlib_free; /* Z_NULL */
+ zipstream.next_out = Z_NULL;
+ zipstream.avail_out = 0;
+ zipstream.next_in = Z_NULL;
+ zipstream.avail_in = 0;
+ state = deflateInit2(&zipstream, level, method, window, memory, strategy);
+ if (state == Z_OK) {
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ zipstream.next_in = (ziplib_in_char_ptr) data;
+ zipstream.avail_in = size;
+ while (1) {
+ zipstream.next_out = (ziplib_out_char_ptr) luaL_prepbuffsize(&buffer, buffersize);
+ zipstream.avail_out = buffersize;
+ state = deflate(&zipstream, Z_FINISH);
+ if (state != Z_OK && state != Z_STREAM_END) {
+ lua_pushnil(L);
+ break;
+ } else {
+ luaL_addsize(&buffer, buffersize - zipstream.avail_out);
+ if (zipstream.avail_out != 0) {
+ luaL_pushresult(&buffer);
+ break;
+ }
+ }
+ }
+ deflateEnd(&zipstream);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int ziplib_compress(lua_State *L)
+{
+ const char *data = luaL_checkstring(L, 1);
+ int size = (int) lua_rawlen(L, 1);
+ int level = lmt_optinteger(L, 2, Z_DEFAULT_COMPRESSION);
+ int method = lmt_optinteger(L, 3, Z_DEFLATED);
+ int window = lmt_optinteger(L, 4, 15);
+ int memory = lmt_optinteger(L, 5, 8);
+ int strategy = lmt_optinteger(L, 6, Z_DEFAULT_STRATEGY);
+ return ziplib_aux_compress(L, data, size, level, method, window, memory, strategy, ziplib_buffer_size);
+}
+
+static int ziplib_compresssize(lua_State *L)
+{
+ const char *data = luaL_checkstring(L, 1);
+ int size = (int) lua_rawlen(L, 1);
+ int level = lmt_optinteger(L, 2, Z_DEFAULT_COMPRESSION);
+ int buffersize = lmt_optinteger(L, 3, ziplib_buffer_size);
+ int window = lmt_optinteger(L, 4, 15); /* like decompresssize */
+ return ziplib_aux_compress(L, data, size, level, Z_DEFLATED, window, 8, Z_DEFAULT_STRATEGY, buffersize);
+}
+
+static int ziplib_decompress(lua_State *L)
+{
+ const char *data = luaL_checkstring(L, 1);
+ int size = (int) lua_rawlen(L, 1);
+ int window = lmt_optinteger(L, 2, 15);
+ int state;
+ z_stream zipstream;
+ zipstream.zalloc = &lmt_zlib_alloc; /* Z_NULL */
+ zipstream.zfree = &lmt_zlib_free; /* Z_NULL */
+ zipstream.next_out = Z_NULL;
+ zipstream.avail_out = 0;
+ zipstream.next_in = Z_NULL;
+ zipstream.avail_in = 0;
+ state = inflateInit2(&zipstream, window);
+ if (state == Z_OK) {
+ luaL_Buffer buffer;
+ luaL_buffinit(L, &buffer);
+ zipstream.next_in = (ziplib_in_char_ptr) data;
+ zipstream.avail_in = size;
+ while (1) {
+ zipstream.next_out = (ziplib_out_char_ptr) luaL_prepbuffsize(&buffer, ziplib_buffer_size);
+ zipstream.avail_out = ziplib_buffer_size;
+ state = inflate(&zipstream, Z_NO_FLUSH);
+ luaL_addsize(&buffer, ziplib_buffer_size - zipstream.avail_out);
+ if (state == Z_STREAM_END) {
+ luaL_pushresult(&buffer);
+ break;
+ } else if (state != Z_OK) {
+ lua_pushnil(L);
+ break;
+ } else if (zipstream.avail_out == 0) {
+ continue;
+ } else if (zipstream.avail_in == 0) {
+ luaL_pushresult(&buffer);
+ break;
+ }
+ }
+ inflateEnd(&zipstream);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int ziplib_decompresssize(lua_State *L)
+{
+ const char *data = luaL_checkstring(L, 1);
+ int size = (int) lua_rawlen(L, 1);
+ int targetsize = lmt_tointeger(L, 2);
+ int window = lmt_optinteger(L, 3, 15);
+ int state;
+ z_stream zipstream;
+ zipstream.zalloc = &lmt_zlib_alloc; /* Z_NULL */
+ zipstream.zfree = &lmt_zlib_free; /* Z_NULL */
+ zipstream.next_out = Z_NULL;
+ zipstream.avail_out = 0;
+ zipstream.next_in = Z_NULL;
+ zipstream.avail_in = 0;
+ state = inflateInit2(&zipstream, window);
+ if (state == Z_OK) {
+ luaL_Buffer buffer;
+ zipstream.next_in = (ziplib_in_char_ptr) data;
+ zipstream.avail_in = size;
+ zipstream.next_out = (ziplib_out_char_ptr) luaL_buffinitsize(L, &buffer, (lua_Integer) targetsize + 100);
+ zipstream.avail_out = targetsize + 100;
+ state = inflate(&zipstream, Z_NO_FLUSH); /* maybe Z_FINISH buffer large enough */
+ if (state != Z_OK && state != Z_STREAM_END) {
+ lua_pushnil(L);
+ } else if (zipstream.avail_in == 0) {
+ luaL_pushresultsize(&buffer, targetsize);
+ } else {
+ lua_pushnil(L);
+ }
+ inflateEnd(&zipstream);
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int ziplib_adler32(lua_State *L)
+{
+ int checksum = lmt_optinteger(L, 2, 0);
+ size_t buffersize = 0;
+ const char *buffer = lua_tolstring(L, 1, &buffersize);
+ checksum = adler32(checksum, (ziplib_in_char_ptr) buffer, (unsigned int) buffersize);
+ lua_pushinteger(L, checksum);
+ return 1;
+}
+
+static int ziplib_crc32(lua_State *L)
+{
+ int checksum = lmt_optinteger(L, 2, 0);
+ size_t buffersize = 0;
+ const char *buffer = lua_tolstring(L, 1, &buffersize);
+ checksum = crc32(checksum, (ziplib_in_char_ptr) buffer, (unsigned int) buffersize);
+ lua_pushinteger(L, checksum);
+ return 1;
+}
+
+static struct luaL_Reg ziplib_function_list[] = {
+ { "compress", ziplib_compress },
+ { "compresssize", ziplib_compresssize },
+ { "decompress", ziplib_decompress },
+ { "decompresssize", ziplib_decompresssize },
+ { "adler32", ziplib_adler32 },
+ { "crc32", ziplib_crc32 },
+ { NULL, NULL },
+};
+
+int luaopen_xzip(lua_State *L) {
+ lua_newtable(L);
+ luaL_setfuncs(L, ziplib_function_list, 0);
+ return 1;
+}
+
diff --git a/source/luametatex/source/mp/mpc/mp.c b/source/luametatex/source/mp/mpc/mp.c
new file mode 100644
index 000000000..0e9c4bf2d
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mp.c
@@ -0,0 +1,22101 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# include "mpconfig.h"
+# include "mp.h"
+# include "mpmath.h"
+# include "mpmathdouble.h"
+# include "mpmathbinary.h"
+# include "mpmathdecimal.h"
+# include "mpstrings.h"
+
+
+# define default_banner "This is MPLIB for LuaMetaTeX, version 3.14"
+# define odd(A) (abs(A) % 2 == 1)
+# define loc mp->cur_input.loc_field
+# define inf_t mp->math->md_inf_t
+# define negative_inf_t mp->math->md_negative_inf_t
+# define check_arith() \
+ if (mp->arith_error) { \
+ mp_clear_arith(mp); \
+ }
+# define arc_tol_k mp->math->md_arc_tol_k
+# define coef_bound_k mp->math->md_coef_bound_k
+# define coef_bound_minus_1 mp->math->md_coef_bound_minus_1
+# define sqrt_8_e_k mp->math->md_sqrt_8_e_k
+# define twelve_ln_2_k mp->math->md_twelve_ln_2_k
+# define twelvebits_3 mp->math->md_twelvebits_3
+# define one_k mp->math->md_one_k
+# define epsilon_t mp->math->md_epsilon_t
+# define unity_t mp->math->md_unity_t
+# define zero_t mp->math->md_zero_t
+# define two_t mp->math->md_two_t
+# define three_t mp->math->md_three_t
+# define half_unit_t mp->math->md_half_unit_t
+# define three_quarter_unit_t mp->math->md_three_quarter_unit_t
+# define twentysixbits_sqrt2_t mp->math->md_twentysixbits_sqrt2_t
+# define twentyeightbits_d_t mp->math->md_twentyeightbits_d_t
+# define twentysevenbits_sqrt2_d_t mp->math->md_twentysevenbits_sqrt2_d_t
+# define warning_limit_t mp->math->md_warning_limit_t
+# define precision_default mp->math->md_precision_default
+# define precision_min mp->math->md_precision_min
+# define precision_max mp->math->md_precision_max
+# define fraction_one_t mp->math->md_fraction_one_t
+# define fraction_half_t mp->math->md_fraction_half_t
+# define fraction_three_t mp->math->md_fraction_three_t
+# define fraction_four_t mp->math->md_fraction_four_t
+# define one_eighty_deg_t mp->math->md_one_eighty_deg_t
+# define negative_one_eighty_deg_t mp->math->md_negative_one_eighty_deg_t
+# define three_sixty_deg_t mp->math->md_three_sixty_deg_t
+# define max_quarterword 0x3FFF
+# define max_halfword 0xFFFFFFF
+# define max_num_token_nodes 8000
+# define max_num_pair_nodes 1000
+# define max_num_knot_nodes 1000
+# define max_num_value_nodes 1000
+# define max_num_symbolic_nodes 1000
+# define mp_link(A) (A)->link
+# define mp_type(A) (A)->type
+# define mp_name_type(A) (A)->name_type
+# define mp_set_link(A,B) (A)->link = (mp_node) (B)
+# define mp_max_command_code mp_stop
+# define mp_max_pre_command mp_etex_command
+# define mp_min_command (mp_defined_macro_command+1)
+# define mp_max_statement_command mp_type_name_command
+# define mp_min_primary_command mp_type_name_command
+# define mp_min_suffix_token mp_internal_command
+# define mp_max_suffix_token mp_numeric_command
+# define mp_max_primary_command mp_plus_or_minus_command
+# define mp_min_tertiary_command mp_plus_or_minus_command
+# define mp_max_tertiary_command mp_tertiary_binary_command
+# define mp_min_expression_command mp_left_brace_command
+# define mp_max_expression_command mp_equals_command
+# define mp_min_secondary_command mp_and_command
+# define mp_max_secondary_command mp_secondary_binary_command
+# define mp_end_of_statement (cur_cmd>mp_comma_command)
+# define unknown_tag 1
+# define mp_min_of_operation mp_substring_operation
+# define max_given_internal mp_restore_clip_color_internal
+# define set_text(A) { \
+ (A)->text = (B) ; \
+}
+# define set_eq_type(A,B) { \
+ (A)->type = (B) ; \
+}
+# define set_eq_property(A,B) { \
+ (A)->property = (B) ; \
+}
+# define set_equiv(A,B) { \
+ (A)->v.data.node = NULL ; \
+ (A)->v.data.indep.serial = (B); \
+}
+# define set_equiv_node(A,B) { \
+ (A)->v.data.node = (B) ; \
+ (A)->v.data.indep.serial = 0; \
+}
+# define set_equiv_sym(A,B) { \
+ (A)->v.data.node = (mp_node) (B); \
+ (A)->v.data.indep.serial = 0; \
+}
+# define mp_id_lookup(A,B,C,D) mp_do_id_lookup((A), mp->symbols, (B), (C), (D))
+# define mp_set_value_sym(A,B) do_set_value_sym (mp, (mp_token_node) (A), (B))
+# define mp_set_value_number(A,B) do_set_value_number(mp, (mp_token_node) (A), &(B))
+# define mp_set_value_node(A,B) do_set_value_node (mp, (mp_token_node) (A), (B))
+# define mp_set_value_str(A,B) do_set_value_str (mp, (mp_token_node) (A), (B))
+# define mp_set_value_knot(A,B) do_set_value_knot (mp, (mp_token_node) (A), (B))
+# define mp_get_ref_count(A) mp_get_indep_value(A)
+# define mp_set_ref_count(A,B) mp_set_indep_value(A,B)
+# define mp_add_mac_ref(A) mp_set_ref_count((A), mp_get_ref_count((A))+1)
+# define mp_decr_mac_ref(A) mp_set_ref_count((A), mp_get_ref_count((A))-1)
+# define mp_get_attribute_head(A) mp_do_get_attribute_head(mp, (mp_value_node) (A))
+# define mp_set_attribute_head(A,B) mp_do_set_attribute_head(mp, (mp_value_node) (A),(mp_node) (B))
+# define mp_get_subscr_head(A) mp_do_get_subscr_head(mp,(mp_value_node) (A))
+# define mp_set_subscr_head(A,B) mp_do_set_subscr_head(mp,(mp_value_node) (A),(mp_node) (B))
+# define mp_collective_subscript (void *)0
+# define mp_subscript(A) ((mp_value_node)(A))->subscript
+# define mp_x_part(A) ((mp_pair_node) (A))->x_part
+# define mp_y_part(A) ((mp_pair_node) (A))->y_part
+# define mp_tx_part(A) ((mp_transform_node) (A))->tx_part
+# define mp_ty_part(A) ((mp_transform_node) (A))->ty_part
+# define mp_xx_part(A) ((mp_transform_node) (A))->xx_part
+# define mp_xy_part(A) ((mp_transform_node) (A))->xy_part
+# define mp_yx_part(A) ((mp_transform_node) (A))->yx_part
+# define mp_yy_part(A) ((mp_transform_node) (A))->yy_part
+# define mp_red_part(A) ((mp_color_node) (A))->red_part
+# define mp_green_part(A) ((mp_color_node) (A))->green_part
+# define mp_blue_part(A) ((mp_color_node) (A))->blue_part
+# define mp_grey_part(A) ((mp_color_node) (A))->grey_part
+# define mp_cyan_part(A) ((mp_color_node) (A))->cyan_part
+# define mp_magenta_part(A) ((mp_color_node) (A))->magenta_part
+# define mp_yellow_part(A) ((mp_color_node) (A))->yellow_part
+# define mp_black_part(A) ((mp_color_node) (A))->black_part
+# define mp_next_knot(A) (A)->next
+# define mp_left_type(A) (A)->left_type
+# define mp_right_type(A) (A)->right_type
+# define mp_prev_knot(A) (A)->prev
+# define mp_knot_info(A) (A)->info
+# define mp_originator(A) (A)->originator
+# define mp_knotstate(A) (A)->state
+# define mp_minx mp->bbmin[mp_x_code]
+# define mp_maxx mp->bbmax[mp_x_code]
+# define mp_miny mp->bbmin[mp_y_code]
+# define mp_maxy mp->bbmax[mp_y_code]
+# define one_third_inf_t mp->math->md_one_third_inf_t
+# define mp_copy_pen(mp,A) mp_make_pen(mp, mp_copy_path(mp, (A)),0)
+# define mp_pen_is_elliptical(A) ((A)==mp_next_knot((A)))
+# define mp_fraction mp_number
+# define mp_angle mp_number
+# define new_number(A) mp->math->md_allocate(mp, &(A), mp_scaled_type)
+# define new_fraction(A) mp->math->md_allocate(mp, &(A), mp_fraction_type)
+# define new_angle(A) mp->math->md_allocate(mp, &(A), mp_angle_type)
+# define new_number_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_scaled_type, &(B))
+# define new_fraction_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_fraction_type, &(B))
+# define new_angle_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_angle_type, &(B))
+# define new_number_from_double(mp,A,B) mp->math->md_allocate_double(mp, &(A), B)
+# define new_number_abs(A,B) mp->math->md_allocate_abs(mp, &(A), mp_scaled_type, &(B))
+# define free_number(A) mp->math->md_free(mp, &(A))
+# define set_precision() mp->math->md_set_precision(mp)
+# define free_math() mp->math->md_free_math(mp)
+# define scan_numeric_token(A) mp->math->md_scan_numeric(mp,A)
+# define scan_fractional_token(A) mp->math->md_scan_fractional(mp,A)
+# define set_number_from_of_the_way(A,t,B,C) mp->math->md_from_oftheway(mp,&(A),&(t),&(B),&(C))
+# define set_number_from_int(A,B) mp->math->md_from_int(&(A),B)
+# define set_number_from_scaled(A,B) mp->math->md_from_scaled(&(A),B)
+# define set_number_from_boolean(A,B) mp->math->md_from_boolean(&(A),B)
+# define set_number_from_double(A,B) mp->math->md_from_double(&(A),B)
+# define set_number_from_addition(A,B,C) mp->math->md_from_addition(&(A),&(B),&(C))
+# define set_number_half_from_addition(A,B,C) mp->math->md_half_from_addition(&(A),&(B),&(C))
+# define set_number_from_subtraction(A,B,C) mp->math->md_from_subtraction(&(A),&(B),&(C))
+# define set_number_half_from_subtraction(A,B,C) mp->math->md_half_from_subtraction(&(A),&(B),&(C))
+# define set_number_from_div(A,B,C) mp->math->md_from_div(&(A),&(B),&(C))
+# define set_number_from_mul(A,B,C) mp->math->md_from_mul(&(A),&(B),&(C))
+# define number_int_div(A,C) mp->math->md_from_int_div(&(A),&(A),C)
+# define set_number_from_int_mul(A,B,C) mp->math->md_from_int_mul(&(A),&(B),C)
+# define set_number_to_unity(A) mp->math->md_clone(&(A), &unity_t)
+# define set_number_to_zero(A) mp->math->md_clone(&(A), &zero_t)
+# define set_number_to_inf(A) mp->math->md_clone(&(A), &inf_t)
+# define set_number_to_negative_inf(A) mp->math->md_clone(&(A), &negative_inf_t)
+# define old_set_number_to_neg_inf(A) do { set_number_to_inf(A); number_negate(A); } while (0)
+# define init_randoms(A) mp->math->md_init_randoms(mp,A)
+# define print_number(A) mp->math->md_print(mp,&(A))
+# define number_tostring(A) mp->math->md_tostring(mp,&(A))
+# define make_scaled(R,A,B) mp->math->md_make_scaled(mp,&(R),&(A),&(B))
+# define take_scaled(R,A,B) mp->math->md_take_scaled(mp,&(R),&(A),&(B))
+# define make_fraction(R,A,B) mp->math->md_make_fraction(mp,&(R),&(A),&(B))
+# define take_fraction(R,A,B) mp->math->md_take_fraction(mp,&(R),&(A),&(B))
+# define pyth_add(R,A,B) mp->math->md_pyth_add(mp,&(R),&(A),&(B))
+# define pyth_sub(R,A,B) mp->math->md_pyth_sub(mp,&(R),&(A),&(B))
+# define power_of(R,A,B) mp->math->md_power_of(mp,&(R),&(A),&(B))
+# define n_arg(R,A,B) mp->math->md_n_arg(mp,&(R),&(A),&(B))
+# define m_log(R,A) mp->math->md_m_log(mp,&(R),&(A))
+# define m_exp(R,A) mp->math->md_m_exp(mp,&(R),&(A))
+# define m_unif_rand(R,A) mp->math->md_m_unif_rand(mp,&(R),&(A))
+# define m_norm_rand(R) mp->math->md_m_norm_rand(mp,&(R))
+# define velocity(R,A,B,C,D,E) mp->math->md_velocity(mp,&(R),&(A),&(B),&(C),&(D),&(E))
+# define ab_vs_cd(A,B,C,D) mp->math->md_ab_vs_cd(&(A),&(B),&(C),&(D))
+# define crossing_point(R,A,B,C) mp->math->md_crossing_point(mp,&(R),&(A),&(B),&(C))
+# define n_sin_cos(A,S,C) mp->math->md_sin_cos(mp,&(A),&(S),&(C))
+# define square_rt(A,S) mp->math->md_sqrt(mp,&(A),&(S))
+# define slow_add(R,A,B) mp->math->md_slow_add(mp,&(R),&(A),&(B))
+# define round_unscaled(A) mp->math->md_round_unscaled(&(A))
+# define floor_scaled(A) mp->math->md_floor_scaled(&(A))
+# define fraction_to_round_scaled(A) mp->math->md_fraction_to_round_scaled(&(A))
+# define number_to_int(A) mp->math->md_to_int(&(A))
+# define number_to_boolean(A) mp->math->md_to_boolean(&(A))
+# define number_to_scaled(A) mp->math->md_to_scaled(&(A))
+# define number_to_double(A) mp->math->md_to_double(&(A))
+# define number_negate(A) mp->math->md_negate(&(A))
+# define number_add(A,B) mp->math->md_add(&(A),&(B))
+# define number_subtract(A,B) mp->math->md_subtract(&(A),&(B))
+# define number_half(A) mp->math->md_half(&(A))
+# define number_double(A) mp->math->md_do_double(&(A))
+# define number_add_scaled(A,B) mp->math->md_add_scaled(&(A),B)
+# define number_multiply_int(A,B) mp->math->md_multiply_int(&(A),B)
+# define number_divide_int(A,B) mp->math->md_divide_int(&(A),B)
+# define number_abs(A) mp->math->md_abs(&(A))
+# define number_modulo(A,B) mp->math->md_modulo(&(A),&(B))
+# define number_nonequalabs(A,B) mp->math->md_nonequalabs(&(A),&(B))
+# define number_odd(A) mp->math->md_odd(&(A))
+# define number_equal(A,B) mp->math->md_equal(&(A),&(B))
+# define number_greater(A,B) mp->math->md_greater(&(A),&(B))
+# define number_less(A,B) mp->math->md_less(&(A),&(B))
+# define number_clone(A,B) mp->math->md_clone(&(A),&(B))
+# define number_negated_clone(A,B) mp->math->md_negated_clone(&(A),&(B))
+# define number_abs_clone(A,B) mp->math->md_abs_clone(&(A),&(B))
+# define number_swap(A,B) mp->math->md_swap(&(A),&(B));
+# define convert_scaled_to_angle(A) mp->math->md_scaled_to_angle(&(A));
+# define convert_angle_to_scaled(A) mp->math->md_angle_to_scaled(&(A));
+# define convert_fraction_to_scaled(A) mp->math->md_fraction_to_scaled(&(A));
+# define convert_scaled_to_fraction(A) mp->math->md_scaled_to_fraction(&(A));
+# define number_zero(A) number_equal(A, zero_t)
+# define number_infinite(A) number_equal(A, inf_t)
+# define number_unity(A) number_equal(A, unity_t)
+# define number_negative(A) number_less(A, zero_t)
+# define number_nonnegative(A) (! number_negative(A))
+# define number_positive(A) number_greater(A, zero_t)
+# define number_nonpositive(A) (! number_positive(A))
+# define number_nonzero(A) (! number_zero(A))
+# define number_greaterequal(A,B) (! number_less(A,B))
+# define number_lessequal(A,B) (! number_greater(A,B))
+# define mp_path_ptr(A) (A)->path
+# define mp_pen_ptr(A) (A)->pen
+# define mp_dash_ptr(A) ((mp_shape_node) (A))->dash
+# define mp_line_cap(A) ((mp_shape_node) (A))->linecap
+# define mp_line_join(A) ((mp_shape_node) (A))->linejoin
+# define mp_miterlimit(A) ((mp_shape_node) (A))->miterlimit
+# define mp_set_linecap(A,B) ((mp_shape_node) (A))->linecap = (short) (B)
+# define mp_set_linejoin(A,B) ((mp_shape_node) (A))->linejoin = (short) (B)
+# define mp_pre_script(A) ((mp_shape_node) (A))->pre_script
+# define mp_post_script(A) ((mp_shape_node) (A))->post_script
+# define mp_color_model(A) ((mp_shape_node) (A))->color_model
+# define mp_stacking(A) ((mp_shape_node) (A))->stacking
+# define mp_pen_type(A) ((mp_shape_node) (A))->pen_type
+# define mp_cyan_color(A) ((mp_shape_node) (A))->cyan
+# define mp_magenta_color(A) ((mp_shape_node) (A))->magenta
+# define mp_yellow_color(A) ((mp_shape_node) (A))->yellow
+# define mp_black_color(A) ((mp_shape_node) (A))->black
+# define mp_red_color(A) ((mp_shape_node) (A))->red
+# define mp_green_color(A) ((mp_shape_node) (A))->green
+# define mp_blue_color(A) ((mp_shape_node) (A))->blue
+# define mp_gray_color(A) ((mp_shape_node) (A))->grey
+# define mp_grey_color(A) ((mp_shape_node) (A))->grey
+# define mp_has_color(A) (mp_type((A))<mp_start_clip_node_type)
+# define mp_has_script(A) (mp_type((A))<=mp_start_bounds_node_type)
+# define mp_has_pen(A) (mp_type((A))<=mp_stroked_node_type)
+# define mp_is_start_or_stop(A) (mp_type((A))>=mp_start_clip_node_type)
+# define mp_is_stop(A) (mp_type((A))>=mp_stop_clip_node_type)
+# define mp_get_dash_list(A) (mp_dash_node) (((mp_dash_node) (A))->link)
+# define mp_set_dash_list(A,B) ((mp_dash_node) (A))->link = (mp_node) ((B))
+# define mp_bblast(A) ((mp_edge_header_node) (A))->bblast
+# define mp_edge_list(A) ((mp_edge_header_node) (A))->list
+# define mp_obj_tail(A) ((mp_edge_header_node) (A))->obj_tail
+# define mp_edge_ref_count(A) ((mp_edge_header_node) (A))->ref_count
+# define mp_add_edge_ref(mp,A) mp_edge_ref_count((A)) += 1
+# define mp_delete_edge_ref(mp,A) { \
+ if (mp_edge_ref_count((A)) == 0) { \
+ mp_toss_edges(mp, (mp_edge_header_node) (A)); \
+ } else { \
+ mp_edge_ref_count((A)) -= 1; \
+ } \
+}
+# define mp_dash_info(A) ((mp_dash_node) (A))->dash_info
+# define zero_off 0
+# define near_zero_angle_k mp->math->md_near_zero_angle_t
+# define stack_1(A) mp->bisect_stack[(A)]
+# define stack_2(A) mp->bisect_stack[(A)+1]
+# define stack_3(A) mp->bisect_stack[(A)+2]
+# define stack_min(A) mp->bisect_stack[(A)+3]
+# define stack_max(A) mp->bisect_stack[(A)+4]
+# define int_packets 20
+# define u_packet(A) ((A)- 5)
+# define v_packet(A) ((A)-10)
+# define x_packet(A) ((A)-15)
+# define y_packet(A) ((A)-20)
+# define l_packets (mp->bisect_ptr-int_packets)
+# define r_packets mp->bisect_ptr
+# define ul_packet u_packet(l_packets)
+# define vl_packet v_packet(l_packets)
+# define xl_packet x_packet(l_packets)
+# define yl_packet y_packet(l_packets)
+# define ur_packet u_packet(r_packets)
+# define vr_packet v_packet(r_packets)
+# define xr_packet x_packet(r_packets)
+# define yr_packet y_packet(r_packets)
+# define u1l stack_1(ul_packet)
+# define u2l stack_2(ul_packet)
+# define u3l stack_3(ul_packet)
+# define v1l stack_1(vl_packet)
+# define v2l stack_2(vl_packet)
+# define v3l stack_3(vl_packet)
+# define x1l stack_1(xl_packet)
+# define x2l stack_2(xl_packet)
+# define x3l stack_3(xl_packet)
+# define y1l stack_1(yl_packet)
+# define y2l stack_2(yl_packet)
+# define y3l stack_3(yl_packet)
+# define u1r stack_1(ur_packet)
+# define u2r stack_2(ur_packet)
+# define u3r stack_3(ur_packet)
+# define v1r stack_1(vr_packet)
+# define v2r stack_2(vr_packet)
+# define v3r stack_3(vr_packet)
+# define x1r stack_1(xr_packet)
+# define x2r stack_2(xr_packet)
+# define x3r stack_3(xr_packet)
+# define y1r stack_1(yr_packet)
+# define y2r stack_2(yr_packet)
+# define y3r stack_3(yr_packet)
+# define stack_dx mp->bisect_stack[mp->bisect_ptr]
+# define stack_dy mp->bisect_stack[mp->bisect_ptr+1]
+# define stack_tol mp->bisect_stack[mp->bisect_ptr+2]
+# define stack_uv mp->bisect_stack[mp->bisect_ptr+3]
+# define stack_xy mp->bisect_stack[mp->bisect_ptr+4]
+# define int_increment (int_packets+int_packets+5)
+# define max_patience 5000
+# define half(A) ((A)/2)
+# define intersection_run_shift 8
+# define mp_get_indep_scale(A) ((mp_value_node) (A))->data.indep.scale
+# define mp_set_indep_scale(A,B) ((mp_value_node) (A))->data.indep.scale = (B)
+# define mp_get_indep_value(A) ((mp_value_node) (A))->data.indep.serial
+# define mp_set_indep_value(A,B) ((mp_value_node) (A))->data.indep.serial = (B)
+# define mp_get_dep_value(A) ((mp_value_node) (A))->data.n
+# define mp_get_dep_list(A) ((mp_value_node) (A))->attr_head
+# define mp_get_prev_dep(A) ((mp_value_node) (A))->subscr_head
+# define mp_get_dep_info(A) do_get_dep_info(mp, (A))
+# define mp_set_dep_value(A,B) do_set_dep_value(mp,(A),&(B))
+# define mp_set_dep_list(A,B) ((mp_value_node) (A))->attr_head = (mp_node) (B)
+# define mp_set_prev_dep(A,B) ((mp_value_node) (A))->subscr_head = (mp_node) (B)
+# define mp_set_dep_info(A,B) ((mp_value_node) (A))->parent = (mp_node) (B)
+# define independent_needing_fix 0
+# define fraction_threshold_k mp->math->md_fraction_threshold_t
+# define half_fraction_threshold_k mp->math->md_half_fraction_threshold_t
+# define scaled_threshold_k mp->math->md_scaled_threshold_t
+# define half_scaled_threshold_k mp->math->md_half_scaled_threshold_t
+# define p_over_v_threshold_k mp->math->md_p_over_v_threshold_t
+# define independent_being_fixed 1
+# define two_to_the(A) (1<<(unsigned)(A))
+# define cur_cmd mp->cur_mod_->command
+# define cur_mod number_to_scaled(mp->cur_mod_->data.n)
+# define cur_mod_number mp->cur_mod_->data.n
+# define cur_mod_node mp->cur_mod_->data.node
+# define cur_mod_str mp->cur_mod_->data.str
+# define cur_sym mp->cur_mod_->data.sym
+# define cur_sym_mod mp->cur_mod_->name_type
+# define set_cur_cmd(A) mp->cur_mod_->command = (A)
+# define set_cur_mod(A) set_number_from_scaled(mp->cur_mod_->data.n, (A))
+# define set_cur_mod_number(A) number_clone(mp->cur_mod_->data.n, (A))
+# define set_cur_mod_node(A) mp->cur_mod_->data.node = (A)
+# define set_cur_mod_str(A) mp->cur_mod_->data.str = (A)
+# define set_cur_sym(A) mp->cur_mod_->data.sym = (A)
+# define set_cur_sym_mod(A) mp->cur_mod_->name_type = (A)
+# define iindex mp->cur_input.index_field
+# define start mp->cur_input.start_field
+# define limit mp->cur_input.limit_field
+# define name mp->cur_input.name_field
+# define is_term (mp_string) 0
+# define is_read (mp_string) 1
+# define is_scantok (mp_string) 2
+# define max_spec_src is_scantok
+# define terminal_input (name == is_term)
+# define cur_file mp->input_file[iindex]
+# define line mp->line_stack[iindex]
+# define nloc mp->cur_input.nloc_field
+# define nstart mp->cur_input.nstart_field
+# define token_type iindex
+# define token_state (iindex<=mp_macro_text)
+# define file_state (iindex>mp_macro_text)
+# define param_start limit
+# define get_t_next(mp) do { \
+ mp_get_next(mp); \
+ if (cur_cmd <= mp_max_pre_command) { \
+ mp_t_next(mp); \
+ } \
+} while (0)
+# define mp_if_line_field(A) ((mp_if_node) (A))->if_line_field
+# define MP_VOID (mp_node) (1)
+# define MP_PROGRESSION_FLAG (mp_node) (2)
+# define cur_exp_value_boolean number_to_int(mp->cur_exp.data.n)
+# define cur_exp_value_number mp->cur_exp.data.n
+# define cur_exp_node mp->cur_exp.data.node
+# define cur_exp_str mp->cur_exp.data.str
+# define cur_exp_knot mp->cur_exp.data.p
+# define min_tension three_quarter_unit_t
+# define mp_floor(a) ((a) >= 0 ? (int) (a) : -(int) (-(a)))
+# define bezier_error (720*(256*256*16))+1
+# define mp_sign(v) ((v) > 0 ? 1 : ((v)<0 ? -1 : 0 ))
+# define mp_out(A) (double)((A)/16)
+# define p_nextnext mp_next_knot(mp_next_knot(p))
+# define p_next mp_next_knot(p)
+# define equation_threshold_k mp->math->md_equation_threshold_t
+# define make_cp_a_colored_object(cp,p) do { \
+ cp = p; \
+ while (cp != NULL) { \
+ if (mp_has_color(cp)) { \
+ break; \
+ } else { \
+ cp = mp_link(cp); \
+ } \
+ } \
+} while (0)
+# define set_color_val(A,B) do { \
+ if (number_negative(A)) { \
+ set_number_to_zero(A); \
+ } else if (number_greater(A,unity_t)) { \
+ set_number_to_unity(A); \
+ } else { \
+ number_clone(A, (B)); \
+ } \
+} while (0)
+# define message_code 0
+# define err_message_code 1
+# define err_help_code 2
+# define max_integer 0x7FFFFFFF
+# define gr_next_knot(A) (A)->next
+# define gr_originator(A) (A)->originator
+# define mp_knotstate(A) (A)->state
+# define gr_type(A) (A)->type
+# define gr_link(A) (A)->next
+# define gr_color_model(A) (A)->color_model
+# define gr_red_val(A) (A)->color.a_val
+# define gr_green_val(A) (A)->color.b_val
+# define gr_blue_val(A) (A)->color.c_val
+# define gr_cyan_val(A) (A)->color.a_val
+# define gr_magenta_val(A) (A)->color.b_val
+# define gr_yellow_val(A) (A)->color.c_val
+# define gr_black_val(A) (A)->color.d_val
+# define gr_grey_val(A) (A)->color.d_val
+# define gr_path_ptr(A) (A)->path
+# define gr_htap_ptr(A) (A)->htap
+# define gr_pen_ptr(A) (A)->pen
+# define gr_linejoin_val(A) (A)->linejoin
+# define gr_linecap_val(A) (A)->linecap
+# define gr_stacking_val(A) (A)->stacking
+# define gr_miterlimit_val(A) (A)->miterlimit
+# define gr_pre_script(A) (A)->pre_script
+# define gr_post_script(A) (A)->post_script
+# define gr_pre_length(A) (A)->pre_length
+# define gr_post_length(A) (A)->post_length
+# define gr_dash_ptr(A) (A)->dash
+# define mp_gr_export_color(q,p) \
+if (mp_color_model(p) == mp_uninitialized_model) { \
+ gr_color_model(q) = number_to_scaled(internal_value(mp_default_color_model_internal))/65536; \
+ gr_cyan_val(q) = 0; \
+ gr_magenta_val(q) = 0; \
+ gr_yellow_val(q) = 0; \
+ gr_black_val(q) = gr_color_model(q) == mp_cmyk_model ? (number_to_scaled(unity_t)/65536.0) : 0; \
+} else { \
+ gr_color_model(q) = mp_color_model(p); \
+ gr_cyan_val(q) = number_to_double(p->cyan); \
+ gr_magenta_val(q) = number_to_double(p->magenta); \
+ gr_yellow_val(q) = number_to_double(p->yellow); \
+ gr_black_val(q) = number_to_double(p->black); \
+}
+# define mp_gr_export_scripts(q,p) \
+if (mp_pre_script (p)) { \
+ gr_pre_script(q) = mp_strndup((const char *) mp_pre_script(p)->str, mp_pre_script(p)->len); \
+ gr_pre_length(q) = mp_pre_script(p)->len; \
+} \
+if (mp_post_script(p)) { \
+ gr_post_script(q) = mp_strndup((const char *) mp_post_script(p)->str, mp_post_script(p)->len); \
+ gr_post_length(q) = mp_post_script(p)->len; \
+}
+ MP_options *mp_options (void);
+ MP mp_initialize (MP_options * opt);
+ static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype);
+ static void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype);
+ static char *mp_read_file (MP mp, void *f, size_t * size);
+ static void mp_close_file (MP mp, void *f);
+ static void mp_write_file (MP mp, void *f, const char *s);
+ static char *mp_run_script (MP mp, const char *str, size_t len, int n);
+ static void mp_run_internal (MP mp, int action, int n, int type, const char *iname);
+ static void mp_run_logger (MP mp, int target, const char *s, size_t l);
+ static int mp_run_overload (MP mp, int property, const char *, int);
+ static void mp_run_error (MP mp, const char *, const char *, int);
+ static void mp_run_warning (MP mp, const char *);
+ static char *mp_make_text (MP mp, const char *str, size_t len, int mode);
+ static void mp_print_str (MP mp, const char *s);
+ static void mp_print_nl (MP mp, const char *s);
+ static void mp_print_fmt (MP mp, const char *s, ...);
+ static void mp_print_ln (MP mp);
+ static void mp_print_chr (MP mp, unsigned char k);
+ static void mp_print_mp_str (MP mp, mp_string s);
+ static void mp_print_nl (MP mp, const char *s);
+ static void mp_print_two (MP mp, mp_number *x, mp_number *y);
+ static void mp_print_nl_only (MP mp);
+ static void mp_print_int (MP mp, int n);
+ static void mp_get_next (MP mp);
+ static void mp_begin_file_reading (MP mp);
+ static void mp_free_node (MP mp, mp_node p, size_t siz);
+ static void mp_free_symbolic_node (MP mp, mp_node p);
+ static void mp_free_value_node (MP mp, mp_node p);
+ static void mp_print_type (MP mp, int t);
+ static void mp_fix_date_and_time (MP mp);
+ static void mp_begin_diagnostic (MP mp);
+ static void mp_end_diagnostic (MP mp, int blank_line);
+ static void mp_print_diagnostic (MP mp, const char *s, const char *t, int nuline);
+ static int mp_compare_symbols_entry (void *p, const void *pa, const void *pb);
+ static void *mp_copy_symbols_entry (const void *p);
+ static void *mp_delete_symbols_entry (void *p);
+ static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len);
+ inline static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B);
+ inline static void do_set_value_number (MP mp, mp_token_node A, mp_number *B);
+ inline static void do_set_value_str (MP mp, mp_token_node A, mp_string B);
+ inline static void do_set_value_node (MP mp, mp_token_node A, mp_node B);
+ inline static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B);
+ static void mp_free_token_node (MP mp, mp_node p);
+ static void mp_flush_token_list (MP mp, mp_node p);
+ static void mp_show_token_list (MP mp, mp_node p, mp_node q);
+ static void mp_show_token_list_space (MP mp, mp_node p, mp_node q);
+ static void mp_print_capsule (MP mp, mp_node p);
+ static mp_node mp_do_get_subscr_head (MP mp, mp_value_node A);
+ static mp_node mp_do_get_attribute_head (MP mp, mp_value_node A);
+ static void mp_do_set_attribute_head (MP mp, mp_value_node A, mp_node d);
+ static void mp_do_set_subscr_head (MP mp, mp_value_node A, mp_node d);
+ static mp_node mp_new_value_node (MP mp);
+ static void mp_print_variable_name (MP mp, mp_node p);
+ static void mp_flush_cur_exp (MP mp, mp_value v);
+ static void mp_flush_below_variable (MP mp, mp_node p);
+ static void mp_pr_path (MP mp, mp_knot h);
+ static void mp_print_path (MP mp, mp_knot h, const char *s, int nuline);
+ static mp_knot mp_new_knot (MP mp);
+ static mp_gr_knot mp_gr_new_knot (MP mp);
+ static void mp_toss_knot_list (MP mp, mp_knot p);
+ static void mp_toss_knot (MP mp, mp_knot p);
+ static void mp_free_knot (MP mp, mp_knot p);
+ static void mp_reallocate_paths (MP mp, int l);
+ static void mp_solve_choices (MP mp, mp_knot p, mp_knot q, int n);
+ static void mp_reduce_angle (MP mp, mp_number *a);
+ static void mp_curl_ratio (MP mp, mp_number *ret, mp_number *gamma, mp_number *a_tension, mp_number *b_tension);
+ static void mp_set_controls (MP mp, mp_knot p, mp_knot q, int k);
+ static void mp_solve_rising_cubic (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *x_orig);
+ static void mp_pr_pen (MP mp, mp_knot h);
+ static void mp_print_pen (MP mp, mp_knot h, const char *s, int nuline);
+ static mp_knot mp_convex_hull (MP mp, mp_knot h);
+ void mp_simplify_path (MP mp, mp_knot h);
+ static void mp_move_knot (MP mp, mp_knot p, mp_knot q);
+ static void mp_sqrt_det (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig);
+ static void mp_flush_dash_list (MP mp, mp_edge_header_node h);
+ static mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p);
+ static void mp_toss_edges (MP mp, mp_edge_header_node h);
+ static mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q);
+ static void mp_print_edges (MP mp, mp_node h, const char *s, int nuline);
+ static void mp_print_obj_color (MP mp, mp_node p);
+ static void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h);
+ static void mp_x_retrace_error (MP mp);
+ static void mp_set_bbox (MP mp, mp_edge_header_node h, int top_level);
+ static void mp_split_cubic (MP mp, mp_knot p, mp_number *t);
+ static mp_knot mp_split_cubic_knot (MP mp, mp_knot p, mp_number *t);
+ static void mp_remove_cubic (MP mp, mp_knot p);
+ static mp_knot mp_pen_walk (MP mp, mp_knot w, int k);
+ static void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number *x0, mp_number *x1, mp_number *x2, mp_number *y0, mp_number *y1, mp_number *y2, int rise, int turn_amt);
+ static int mp_get_turn_amt (MP mp, mp_knot w, mp_number *dx, mp_number *dy, int ccw);
+ static mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number *x, mp_number *y);
+ static void mp_set_min_max (MP mp, int v);
+ static void mp_new_indep (MP mp, mp_node p);
+ inline static mp_node do_get_dep_info (MP mp, mp_value_node p);
+ inline static void do_set_dep_value (MP mp, mp_value_node p, mp_number *q);
+ static void mp_free_dep_node (MP mp, mp_value_node p);
+ static void mp_print_dependency (MP mp, mp_value_node p, int t);
+ static mp_value_node mp_p_plus_fq (MP mp, mp_value_node p, mp_number *f, mp_value_node q, mp_variable_type t, mp_variable_type tt);
+ static mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number *v, int t0, int t1);
+ static void mp_val_too_big (MP mp, mp_number *x);
+ static void mp_make_known (MP mp, mp_value_node p, mp_value_node q);
+ static void mp_fix_dependencies (MP mp);
+ static void mp_ring_delete (MP mp, mp_node p);
+ static void mp_exclaim_redundant_equation (MP mp);
+ static const char *mp_cmd_mod_string (MP mp, int c, int m);
+ static void mp_print_cmd_mod (MP mp, int c, int m);
+ static void mp_reallocate_input_stack (MP mp, int newsize);
+ static int mp_true_line (MP mp);
+ static void mp_push_input (MP mp);
+ static void mp_pop_input (MP mp);
+ static void mp_back_input (MP mp);
+ static void mp_back_error (MP mp, const char *msg, const char *hlp) ;
+ static void mp_runaway (MP mp);
+ static void mp_firm_up_the_line (MP mp);
+ static int mp_move_to_next_line (MP mp);
+ static void mp_t_next (MP mp);
+ static void mp_scan_primary (MP mp);
+ static void mp_scan_secondary (MP mp);
+ static void mp_scan_tertiary (MP mp);
+ static void mp_scan_expression (MP mp);
+ static void mp_scan_suffix (MP mp);
+ static void mp_pass_text (MP mp);
+ static void mp_conditional (MP mp);
+ static void mp_start_input (MP mp);
+ static void mp_begin_iteration (MP mp);
+ static void mp_resume_iteration (MP mp);
+ static void mp_stop_iteration (MP mp);
+ static void check_script_result (MP mp, char *s);
+ static void mp_get_x_next (MP mp);
+ static void mp_macro_call (MP mp, mp_node def_ref, mp_node arg_list, mp_sym macro_name);
+ static void mp_print_macro_name (MP mp, mp_node a, mp_sym n);
+ static void mp_print_arg (MP mp, mp_node q, int n, int b, int bb);
+ static void mp_scan_text_arg (MP mp, mp_sym l_delim, mp_sym r_delim);
+ static void mp_push_condition_stack (MP mp);
+ static void mp_pop_condition_stack (MP mp);
+ static void mp_begin_name (MP mp);
+ static int mp_more_name (MP mp, unsigned char c);
+ static void mp_end_name (MP mp);
+ static void mp_open_write_file (MP mp, char *s, int n);
+ static void mp_set_cur_exp_knot (MP mp, mp_knot n);
+ static void mp_set_cur_exp_node (MP mp, mp_node n);
+ static void mp_set_cur_exp_value_boolean (MP mp, int b);
+ static void mp_set_cur_exp_value_scaled (MP mp, int s);
+ static void mp_set_cur_exp_value_number (MP mp, mp_number *n);
+ static void mp_set_cur_exp_str (MP mp, mp_string s);
+ static mp_node mp_stash_cur_exp (MP mp);
+ static void mp_print_dp (MP mp, int t, mp_value_node p, int verbosity);
+ static void mp_unstash_cur_exp (MP mp, mp_node p);
+ static void mp_print_exp (MP mp, mp_node p, int verbosity);
+ static void mp_print_big_node (MP mp, mp_node p, int verbosity);
+ static void mp_disp_err (MP mp, mp_node p);
+ static void mp_recycle_value (MP mp, mp_node p);
+ static void mp_recycle_independent_value (MP mp, mp_node p);
+ static void mp_show_transformed_dependency (MP mp, mp_number *v, mp_variable_type t, mp_node p);
+ static void mp_known_pair (MP mp);
+ static void do_boolean_error (MP mp);
+ static void push_of_path_result (MP mp, int what, mp_knot p);
+ static mp_knot mp_simple_knot(MP mp, mp_number *x, mp_number *y);
+ static mp_knot mp_complex_knot(MP mp, mp_knot o);
+ static int mp_pict_color_type (MP mp, int c);
+ static void mp_bad_color_part (MP mp, int c);
+ static mp_edge_header_node mp_scale_edges (MP mp, mp_number *se_sf, mp_edge_header_node se_pic);
+ static void mp_path_length (MP mp, mp_number *n);
+ static void mp_pair_value (MP mp, mp_number *x, mp_number *y);
+ static void mp_do_type_declaration (MP mp);
+ static void mp_do_max_knot_pool (MP mp);
+ static void mp_do_random_seed (MP mp);
+ static void mp_do_protection (MP mp);
+ static void mp_do_property (MP mp);
+ static void mp_def_delims (MP mp);
+ static void mp_do_statement (MP mp);
+ static void mp_do_interim (MP mp);
+ static void mp_do_let (MP mp);
+ static void mp_do_show (MP mp);
+ static void mp_disp_token (MP mp);
+ static void mp_do_show_token (MP mp);
+ static void mp_do_show_stats (MP mp);
+ static void mp_disp_var (MP mp, mp_node p);
+ static void mp_do_show_var (MP mp);
+ static void mp_do_show_dependencies (MP mp);
+ static void mp_do_show_whatever (MP mp);
+ static void mp_scan_with_list (MP mp, mp_node p, mp_node pp);
+ static mp_edge_header_node mp_find_edges_var (MP mp, mp_node t);
+ static mp_node mp_start_draw_cmd (MP mp, int sep);
+ static void mp_do_bounds (MP mp);
+ static void mp_do_add_to (MP mp);
+ static void mp_ship_out (MP mp, mp_node h);
+
+ static void mp_do_ship_out (MP mp);
+ static void mp_do_message (MP mp);
+ static void mp_no_string_err (MP mp, const char *s);
+ static void mp_do_write (MP mp);
+ static void mp_do_write_string (MP mp, mp_string t);
+
+ static void mp_make_eq (MP mp, mp_node lhs);
+
+ static void mp_do_equation (MP mp);
+ static void mp_do_assignment (MP mp);
+ static void mp_try_eq (MP mp, mp_node l, mp_node r);
+ static mp_node mp_scan_declared_variable (MP mp);
+ static void mp_check_delimiter (MP mp, mp_sym l_delim, mp_sym r_delim);
+ static void mp_do_new_internal (MP mp);
+ static void mp_shipout_backend (MP mp, void *h);
+ static void mp_close_files (MP mp);
+ static void mp_close_files_and_terminate (MP mp);
+ static void mp_final_cleanup (MP mp);
+ static void mp_init_prim (MP mp);
+ static void mp_init_tab (MP mp);
+
+void mp_jump_out (MP mp)
+{
+ if (mp->internal != NULL && mp->history < mp_system_error_stop) {
+ mp_close_files_and_terminate(mp);
+ }
+ longjmp(*(mp->jump_buf), 1);
+}
+void mp_warn (MP mp, const char *msg)
+{
+ int selector = mp->selector;
+ mp_normalize_selector(mp);
+ mp_print_nl(mp, "Warning: ");
+ mp_print_str(mp, msg);
+ mp_print_ln(mp);
+ mp->selector = selector;
+}
+void mp_fatal_error (MP mp, const char *s)
+{
+ mp_normalize_selector(mp);
+ if (mp->interaction == mp_error_stop_mode) {
+ mp->interaction = mp_scroll_mode;
+ }
+ mp_error(mp, "Emergency stop", s);
+ mp->history = mp_fatal_error_stop;
+ mp_jump_out(mp);
+}
+void mp_confusion (MP mp, const char *s)
+{
+ char msg[256];
+ const char *hlp = NULL;
+ mp_normalize_selector(mp);
+ if (mp->history < mp_error_message_issued) {
+ mp_snprintf(msg, 256, "This can't happen (%s)", s);
+ hlp =
+ "I'm broken. Please show this to someone who can fix can fix it and try\n"
+ "again";
+ } else {
+ hlp =
+ "One of your faux pas seems to have wounded me deeply ... in fact, I'm barely\n"
+ "conscious. Please fix it and try again.";
+ mp_snprintf(msg, 256, "I can't go on meeting you like this");
+ }
+ if (mp->interaction == mp_error_stop_mode) {
+ mp->interaction = mp_scroll_mode;
+ }
+ mp_error(mp, msg, hlp);
+ mp->history=mp_fatal_error_stop;
+ mp_jump_out(mp);
+}
+
+MP_options *mp_options (void)
+{
+ MP_options *opt = mp_memory_clear_allocate(sizeof(MP_options));
+ return opt;
+}
+
+static MP mp_do_new (jmp_buf *buf)
+{
+ MP mp = mp_memory_clear_allocate(sizeof(MP_instance));
+ if (mp == NULL) {
+ mp_memory_free(buf);
+ return NULL;
+ } else {
+ mp->jump_buf = buf;
+ return mp;
+ }
+}
+
+static void mp_free (MP mp)
+{
+ mp_memory_free(mp->banner);
+ mp_memory_free(mp->buffer);
+ mp_dealloc_strings(mp);
+ for (int i = 0; i < 55; i++) {
+ free_number(mp->randoms[i]);
+ }
+ while (mp->value_nodes) {
+ mp_node p = mp->value_nodes;
+ mp->value_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_value_node_data));
+ }
+ while (mp->symbolic_nodes) {
+ mp_node p = mp->symbolic_nodes;
+ mp->symbolic_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_node_data));
+ }
+ while (mp->pair_nodes) {
+ mp_node p = mp->pair_nodes;
+ mp->pair_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_pair_node_data));
+ }
+ while (mp->token_nodes) {
+ mp_node p = mp->token_nodes;
+ mp->token_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_node_data));
+ }
+ while (mp->knot_nodes) {
+ mp_knot p = mp->knot_nodes;
+ mp->knot_nodes = p->next;
+ mp_free_knot(mp, p);
+ }
+ if (mp->symbols != NULL) {
+ avl_destroy (mp->symbols);
+ }
+ if (mp->frozen_symbols != NULL) {
+ avl_destroy (mp->frozen_symbols);
+ }
+ for (int k = 0; k<mp->path_size; k++) {
+ free_number(mp->delta_x[k]);
+ free_number(mp->delta_y[k]);
+ free_number(mp->delta[k]);
+ free_number(mp->psi[k]);
+ }
+ mp_memory_free(mp->delta_x);
+ mp_memory_free(mp->delta_y);
+ mp_memory_free(mp->delta);
+ mp_memory_free(mp->psi);
+ for (int k = 0; k < mp->path_size; k++) {
+ free_number(mp->theta[k]);
+ free_number(mp->uu[k]);
+ free_number(mp->vv[k]);
+ free_number(mp->ww[k]);
+ }
+ mp_memory_free(mp->theta);
+ mp_memory_free(mp->uu);
+ mp_memory_free(mp->vv);
+ mp_memory_free(mp->ww);
+ free_number(mp->st);
+ free_number(mp->ct);
+ free_number(mp->sf);
+ free_number(mp->cf);
+ for (int i = 0; i <= mp_y_code; i++) {
+ free_number(mp->bbmin[i]);
+ free_number(mp->bbmax[i]);
+ }
+ for (int k = 0; k <= 7; k++) {
+ free_number(mp->half_cos[k]);
+ free_number(mp->d_cos[k]);
+ }
+ free_number(mp->cur_x);
+ free_number(mp->cur_y);
+ for (int i=0; i<bistack_size + 1; i++) {
+ free_number(mp->bisect_stack[i]);
+ }
+ mp_memory_free(mp->bisect_stack);
+ free_number(mp->cur_t);
+ free_number(mp->cur_tt);
+ free_number(mp->max_t);
+ free_number(mp->delx);
+ free_number(mp->dely);
+ free_number(mp->appr_t);
+ free_number(mp->appr_tt);
+ mp_memory_free(mp->input_stack);
+ mp_memory_free(mp->input_file);
+ mp_memory_free(mp->line_stack);
+ mp_memory_free(mp->param_stack);
+ mp_memory_free(mp->cur_name);
+ mp_memory_free(mp->job_name);
+ for (int i = 0; i < mp_proto_dependent_type + 1; i++) {
+ free_number(mp->max_c[i]);
+ }
+ for (int k = 0; k <= mp->max_internal; k++) {
+ free_number(mp->internal[k].v.data.n);
+ mp_memory_free(internal_name(k));
+ }
+ mp_memory_free(mp->internal);
+ mp_close_files(mp);
+ if (mp->rd_fname != NULL) {
+ mp_memory_free(mp->rd_file);
+ mp_memory_free(mp->rd_fname);
+ mp->rd_file = NULL;
+ mp->rd_fname = NULL;
+ }
+ if (mp->wr_fname != NULL) {
+ mp_memory_free(mp->wr_file);
+ mp_memory_free(mp->wr_fname);
+ mp->wr_file = NULL;
+ mp->wr_fname = NULL;
+ }
+ mp_memory_free(mp->term_in);
+ mp->term_in = NULL;
+
+ mp_memory_free(mp->jump_buf);
+ mp_free_symbolic_node(mp, mp->spec_head);
+ mp_free_symbolic_node(mp, mp->temp_head);
+ mp_free_symbolic_node(mp, mp->hold_head);
+ mp_free_value_node(mp, mp->end_attr);
+ mp_free_node(mp, (mp_node) mp->null_dash, sizeof(mp_dash_node_data));
+ mp_free_dep_node(mp, mp->dep_head);
+ mp_free_symbolic_node(mp, mp->cur_mod_);
+ mp_free_value_node(mp, mp->bad_vardef);
+ free_number(mp->cur_exp.data.n);
+ mp_free_value_node(mp, mp->temp_val);
+ free_number(mp->txx);
+ free_number(mp->txy);
+ free_number(mp->tyx);
+ free_number(mp->tyy);
+ free_number(mp->tx);
+ free_number(mp->ty);
+ mp_free_value_node(mp, mp->inf_val);
+ mp_free_value_node(mp, mp->zero_val);
+
+ free_math();
+ mp_memory_free(mp);
+}
+
+static void mp_do_initialize (MP mp)
+{
+ mp->int_ptr = max_given_internal;
+ for (int k = '0'; k <= '9'; k++) {
+ mp->char_class[k] = mp_digit_class;
+ }
+ for (int k = 'A'; k <= 'Z'; k++) {
+ mp->char_class[k] = mp_letter_class;
+ }
+ for (int k = 'a'; k <= 'z'; k++) {
+ mp->char_class[k] = mp_letter_class;
+ }
+ mp->char_class['.'] = mp_period_class;
+ mp->char_class[' '] = mp_space_class;
+ mp->char_class['%'] = mp_percent_class;
+ mp->char_class['"'] = mp_string_class;
+ mp->char_class[','] = mp_comma_class;
+ mp->char_class[';'] = mp_semicolon_class;
+ mp->char_class['('] = mp_left_parenthesis_class;
+ mp->char_class[')'] = mp_right_parenthesis_class;
+ mp->char_class['_'] = mp_letter_class;
+ mp->char_class['<'] = 10;
+ mp->char_class['='] = 10;
+ mp->char_class['>'] = 10;
+ mp->char_class[':'] = 10;
+ mp->char_class['|'] = 10;
+ mp->char_class['`'] = 11;
+ mp->char_class['\''] = 11;
+ mp->char_class['+'] = 12;
+ mp->char_class['-'] = 12;
+ mp->char_class['/'] = 13;
+ mp->char_class['*'] = 13;
+ mp->char_class['\\'] = 13;
+ mp->char_class['^'] = 13;
+ mp->char_class['!'] = 14;
+ mp->char_class['?'] = 14;
+ mp->char_class['#'] = mp_suffix_class;
+ mp->char_class['&'] = mp_suffix_class;
+ mp->char_class['@'] = mp_suffix_class;
+ mp->char_class['$'] = mp_suffix_class;
+ mp->char_class['^'] = 16;
+ mp->char_class['~'] = 16;
+ mp->char_class['['] = mp_left_bracket_class;
+ mp->char_class[']'] = mp_right_bracket_class;
+ mp->char_class['{'] = mp_brace_class;
+ mp->char_class['}'] = mp_brace_class;
+ for (int k = 0; k < ' '; k++) {
+ mp->char_class[k] = mp_invalid_class;
+ }
+ mp->char_class['\r'] = mp_space_class;
+ mp->char_class['\n'] = mp_space_class;
+ mp->char_class['\t'] = mp_space_class;
+ mp->char_class['\f'] = mp_space_class;
+ for (int k = 127; k <= 255; k++) {
+ mp->char_class[k] = mp->utf8_mode ? mp_letter_class : mp_invalid_class;
+ }
+ if (mp->text_mode) {
+ mp->char_class[2] = mp_string_class;
+ }
+ mp->save_ptr = NULL;
+ for (int k = 0; k <= 7; k++) {
+ new_fraction(mp->half_cos[k]);
+ new_fraction(mp->d_cos[k]);
+ }
+ number_clone(mp->half_cos[0], fraction_half_t);
+ number_clone(mp->half_cos[1], twentysixbits_sqrt2_t);
+ number_clone(mp->half_cos[2], zero_t);
+ number_clone(mp->d_cos[0], twentyeightbits_d_t);
+ number_clone(mp->d_cos[1], twentysevenbits_sqrt2_d_t);
+ number_clone(mp->d_cos[2], zero_t);
+ for (int k = 3; k <= 4; k++) {
+ number_negated_clone(mp->half_cos[k], mp->half_cos[4 - k]);
+ number_negated_clone(mp->d_cos[k], mp->d_cos[4 - k]);
+ }
+ for (int k = 5; k <= 7; k++) {
+ number_clone(mp->half_cos[k], mp->half_cos[8 - k]);
+ number_clone(mp->d_cos[k], mp->d_cos[8 - k]);
+ }
+ mp->spec_p1 = NULL;
+ mp->spec_p2 = NULL;
+ mp->fix_needed = 0;
+ mp->watch_coefs = 1;
+ mp->expand_depth = 10000;
+ mp->cond_ptr = NULL;
+ mp->if_limit = mp_no_if_code;
+ mp->cur_if = 0;
+ mp->if_line = 0;
+ mp->loop_ptr = NULL;
+ mp->cur_name = mp_strdup("");
+ memset(&mp->cur_exp.data, 0, sizeof(mp_value));
+ new_number(mp->cur_exp.data.n);
+ mp->var_flag = 0;
+ mp->eof_line = mp_rtsl (mp, "\0", 1);
+ mp->eof_line->refs = MAX_STR_REF;
+ mp->eof_file = mp_rtsl (mp, "%", 1);
+ mp->eof_file->refs = MAX_STR_REF;
+ mp->every_job_sym = NULL;
+ mp->long_help_seen = 0;
+ mp->ten_pow[0] = 1;
+ for (int i = 1; i <= 9; i++) {
+ mp->ten_pow[i] = 10 * mp->ten_pow[i - 1];
+ }
+}
+
+MP mp_initialize (MP_options * opt)
+{
+ MP mp;
+ jmp_buf *buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (buf == NULL || setjmp(*buf) != 0) {
+ return NULL;
+ }
+ mp = mp_do_new(buf);
+ if (mp == NULL) {
+ return NULL;
+ }
+ if (opt->job_name == NULL || ! *(opt->job_name)) {
+ return NULL;
+ }
+ mp->job_name = mp_strdup(opt->job_name);
+ mp->userdata = opt->userdata;
+ mp->extensions = opt->extensions;
+ mp->find_file = mp_find_file;
+ mp->open_file = mp_open_file;
+ mp->close_file = mp_close_file;
+ mp->write_file = mp_write_file;
+ mp->read_file = mp_read_file;
+ mp->run_script = mp_run_script;
+ mp->run_internal = mp_run_internal;
+ mp->run_logger = mp_run_logger;
+ mp->run_overload = mp_run_overload;
+ mp->run_error = mp_run_error;
+ mp->run_warning = mp_run_warning;
+ mp->make_text = mp_make_text;
+ mp->shipout_backend = mp_shipout_backend;
+ mp->find_file_id = 0;
+ mp->run_script_id = 0;
+ mp->run_logger_id = 0;
+ mp->run_error_id = 0;
+ mp->run_warning_id = 0;
+ mp->run_overload_id = 0;
+ mp->make_text_id = 0;
+ mp->open_file_id = 0;
+
+
+ mp->find_file = opt->find_file ? opt->find_file : mp_find_file ;
+ mp->open_file = opt->open_file ? opt->open_file : mp_open_file ;
+ mp->read_file = opt->read_file ? opt->read_file : mp_read_file ;
+ mp->close_file = opt->close_file ? opt->close_file : mp_close_file ;
+ mp->write_file = opt->write_file ? opt->write_file : mp_write_file ;
+ mp->shipout_backend = opt->shipout_backend ? opt->shipout_backend : mp_shipout_backend;
+ mp->run_script = opt->run_script ? opt->run_script : mp_run_script ;
+ mp->run_internal = opt->run_internal ? opt->run_internal : mp_run_internal ;
+ mp->run_logger = opt->run_logger ? opt->run_logger : mp_run_logger ;
+ mp->run_overload = opt->run_overload ? opt->run_overload : mp_run_overload ;
+ mp->run_error = opt->run_error ? opt->run_error : mp_run_error ;
+ mp->run_warning = opt->run_warning ? opt->run_warning : mp_run_warning ;
+ mp->make_text = opt->make_text ? opt->make_text : mp_make_text ;
+
+ mp->find_file_id = opt->find_file_id;
+ mp->run_script_id = opt->run_script_id;
+ mp->run_internal_id = opt->run_internal_id;
+ mp->run_logger_id = opt->run_logger_id;
+ mp->run_overload_id = opt->run_overload_id;
+ mp->run_error_id = opt->run_error_id;
+ mp->run_warning_id = opt->run_warning_id;
+ mp->make_text_id = opt->make_text_id;
+ mp->open_file_id = opt->open_file_id;
+
+ if (opt->banner && *(opt->banner)) {
+ mp->banner = mp_strdup(opt->banner);
+ } else {
+ mp->banner = mp_strdup(default_banner);
+ }
+ switch (opt->math_mode) {
+ case mp_math_scaled_mode:
+ mp->math = mp_initialize_scaled_math(mp);
+ break;
+ case mp_math_decimal_mode:
+ mp->math = mp_initialize_decimal_math(mp);
+ break;
+ case mp_math_binary_mode:
+ mp->math = mp_initialize_binary_math(mp);
+ break;
+ default:
+ mp->math = mp_initialize_double_math(mp);
+ break;
+ }
+ mp->param_size = 4;
+ mp->max_in_open = 0;
+ mp->halt_on_error = opt->halt_on_error ? 1 : 0;
+ mp->utf8_mode = opt->utf8_mode ? 1 : 0;
+ mp->text_mode = opt->text_mode ? 1 : 0;
+ mp->show_mode = opt->show_mode ? 1 : 0;
+ mp->buf_size = 200;
+ mp->buffer = mp_memory_allocate((size_t) (mp->buf_size + 1) * sizeof(unsigned char));
+ mp_initialize_strings(mp);
+ mp->interaction = opt->interaction;
+ if (mp->interaction == mp_unspecified_mode || mp->interaction > mp_silent_mode) {
+ mp->interaction = mp_error_stop_mode;
+ }
+ if (mp->interaction < mp_unspecified_mode) {
+ mp->interaction = mp_batch_mode;
+ }
+ mp->use_err_help = 0;
+ mp->finished = 0;
+ mp->arith_error = 0;
+ mp->random_seed = opt->random_seed;
+ for (int i = 0; i < 55; i++) {
+ new_fraction(mp->randoms[i]);
+ }
+ mp->math_mode = opt->math_mode;
+ mp->token_nodes = NULL;
+ mp->num_token_nodes = 0;
+ mp->pair_nodes = NULL;
+ mp->num_pair_nodes = 0;
+ mp->knot_nodes = NULL;
+ mp->max_knot_nodes = max_num_knot_nodes;
+ mp->num_knot_nodes = 0;
+ mp->value_nodes = NULL;
+ mp->num_value_nodes = 0;
+ mp->symbolic_nodes = NULL;
+ mp->num_symbolic_nodes = 0;
+
+ mp->max_internal = 1000 + max_given_internal;
+ mp->internal = mp_memory_allocate((size_t) (mp->max_internal + 1) * sizeof(mp_internal));
+ memset(mp->internal, 0, (size_t) (mp->max_internal + 1) * sizeof(mp_internal));
+ for (int i = 1; i <= mp->max_internal; i++) {
+ new_number(mp->internal[i].v.data.n);
+ }
+ for (int i = 1; i <= max_given_internal; i++) {
+ set_internal_type(i, mp_known_type);
+ }
+ set_internal_type(mp_number_system_internal, mp_string_type);
+ set_internal_type(mp_job_name_internal, mp_string_type);
+ mp->symbols = avl_create(mp_compare_symbols_entry, mp_copy_symbols_entry, mp_delete_symbols_entry, mp_memory_allocate, mp_memory_free, NULL);
+ mp->frozen_symbols = avl_create(mp_compare_symbols_entry, mp_copy_symbols_entry, mp_delete_symbols_entry, mp_memory_allocate, mp_memory_free, NULL);
+ mp->bisect_stack = mp_memory_allocate((size_t) (bistack_size + 1) * sizeof(mp_number));
+ for (int i=0; i<bistack_size + 1; i++) {
+ new_number(mp->bisect_stack[i]);
+ }
+ mp->stack_size = 16;
+ mp->input_stack = mp_memory_allocate((size_t) (mp->stack_size + 1) * sizeof(mp_in_state_record));
+ mp_reallocate_input_stack(mp, mp_file_bottom_text + 4);
+ mp->param_stack = mp_memory_allocate((size_t) (mp->param_size + 1) * sizeof(mp_node));
+ mp->max_read_files = 8;
+ mp->rd_file = mp_memory_allocate((size_t) (mp->max_read_files + 1) * sizeof(void *));
+ mp->rd_fname = mp_memory_allocate((size_t) (mp->max_read_files + 1) * sizeof(char *));
+ mp->max_write_files = 8;
+ mp->wr_file = mp_memory_allocate((size_t) (mp->max_write_files + 1) * sizeof(void *));
+ mp->wr_fname = mp_memory_allocate((size_t) (mp->max_write_files + 1) * sizeof(char *));
+ memset(mp->rd_fname, 0, sizeof(char *) * (mp->max_read_files + 1));
+ memset(mp->wr_fname, 0, sizeof(char *) * (mp->max_write_files + 1));
+
+ mp_reallocate_paths(mp, 1000);
+ mp->history = mp_fatal_error_stop;
+ mp_do_initialize(mp);
+ mp_init_tab(mp);
+ switch (opt->math_mode) {
+ case mp_math_scaled_mode:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "scaled"));
+ break;
+ case mp_math_decimal_mode:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "decimal"));
+ break;
+ case mp_math_binary_mode:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "binary"));
+ break;
+ default:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "double"));
+ break;
+ }
+ mp_init_prim(mp);
+ mp_fix_date_and_time(mp);
+ mp->history = mp_spotless;
+ set_precision();
+ if (mp->job_name != NULL) {
+ if (internal_string(mp_job_name_internal) != 0) {
+ delete_str_ref(internal_string(mp_job_name_internal));
+ }
+ set_internal_string(mp_job_name_internal, mp_rts(mp, mp->job_name));
+ }
+ return mp;
+}
+
+int mp_status (MP mp) { return mp->history; }
+int mp_finished (MP mp) { return mp->finished; }
+void *mp_userdata (MP mp) { return mp->userdata; }
+
+static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype)
+{
+ (void) mp; (void) fname; (void) fmode; (void) ftype;
+ mp_fatal_error(mp, "no 'find_file' callback set");
+ return NULL;
+}
+
+static char *mp_run_script (MP mp, const char *str, size_t len, int n)
+{
+ (void) mp; (void) str; (void) len; (void) n;
+ mp_fatal_error(mp, "no 'run_script' callback set");
+ return NULL;
+}
+
+void mp_run_internal (MP mp, int action, int n, int type, const char *iname)
+{
+ (void) mp; (void) action; (void) n; (void) type; (void) iname;
+ mp_fatal_error(mp, "no 'run_internal' callback set");
+}
+
+static void mp_run_logger (MP mp, int target, const char *s, size_t l)
+{
+ (void) mp; (void) target; (void) s; (void) l;
+ mp_fatal_error(mp, "no 'run_logger' callback set");
+}
+
+static int mp_run_overload (MP mp, int property, const char *str, int mode)
+{
+ (void) mp; (void) property; (void) str; (void) mode;
+ mp_fatal_error(mp, "no 'run_overload' callback set");
+ return 0;
+}
+
+static void mp_check_overload (MP mp, mp_sym p)
+{
+ if (number_nonzero(internal_value(mp_overloadmode_internal))) {
+ if (mp->run_overload(mp, p->property, (const char *) p->text->str, number_to_int(internal_value(mp_overloadmode_internal)))) {
+ p->property = 0;
+ } else {
+ }
+ } else {
+ p->property = 0;
+ }
+}
+
+static void mp_run_error (MP mp, const char *msg, const char *hlp, int interaction)
+{
+ (void) mp; (void) msg; (void) hlp; (void) interaction;
+ mp_fatal_error(mp, "no 'run_error' callback set");
+}
+
+static void mp_run_warning (MP mp, const char *msg)
+{
+ (void) mp; (void) msg;
+ mp_fatal_error(mp, "no 'run_warning' callback set");
+}
+
+static char *mp_make_text (MP mp, const char *str, size_t len, int mode)
+{
+ (void) mp; (void) mode; (void) str; (void) len;
+ mp_fatal_error(mp, "no 'make_text' callback set");
+ return NULL;
+}
+
+static void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype)
+{
+ (void) mp; (void) fname; (void) fmode; (void) ftype;
+ mp_fatal_error(mp, "no 'open_file' callback set");
+ return NULL;
+}
+
+static int mp_do_open_file (MP mp, void **f, int ftype, const char *mode)
+{
+ char *s = (mp->find_file)(mp, mp->name_of_file, mode, ftype);
+ if (s != NULL) {
+ mp_memory_free(mp->name_of_file);
+ mp->name_of_file = mp_strdup(s);
+
+ lmt_memory_free(s);
+ *f = (mp->open_file)(mp, mp->name_of_file, mode, ftype);
+ } else {
+ *f = NULL;
+ }
+ return (*f ? 1 : 0);
+}
+
+static int mp_open_in (MP mp, void **f, int ftype)
+{
+ return mp_do_open_file(mp, f, ftype, "r");
+}
+
+static int mp_open_out (MP mp, void **f, int ftype)
+{
+ return mp_do_open_file(mp, f, ftype, "w");
+}
+
+static char *mp_read_file (MP mp, void *f, size_t *size)
+{
+ (void) mp; (void) f; (void) size;
+ mp_fatal_error(mp, "no 'read_file' callback set");
+ return NULL;
+}
+
+static void mp_write_file (MP mp, void *f, const char *s)
+{
+ (void) mp; (void) f; (void) s;
+ mp_fatal_error(mp, "no 'read_file' callback set");
+}
+
+static void mp_close_file (MP mp, void *f)
+{
+ (void) mp; (void) f;
+ mp_fatal_error(mp, "no 'close_file' callback set");
+}
+
+static void mp_reallocate_buffer (MP mp, size_t l)
+{
+ if (l > max_halfword) {
+ mp_confusion(mp, "buffer size");
+ } else {
+ unsigned char *buffer = mp_memory_allocate((size_t) (l + 1) * sizeof(unsigned char));
+ memcpy(buffer, mp->buffer, (mp->buf_size + 1));
+ mp_memory_free(mp->buffer);
+ mp->buffer = buffer;
+ mp->buf_size = l;
+ }
+}
+
+static int mp_input_ln (MP mp, void *f)
+{
+ char *s;
+ size_t size = 0;
+ mp->last = mp->first;
+ s = (mp->read_file)(mp, f, &size);
+ if (s == NULL) {
+ return 0;
+ } else if (size > 0) {
+ mp->last = mp->first + size;
+ if (mp->last >= mp->max_buf_stack) {
+ mp->max_buf_stack = mp->last + 1;
+ while (mp->max_buf_stack > mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size >> 2)));
+ }
+ }
+ memcpy((mp->buffer + mp->first), s, size);
+ }
+ lmt_memory_free(s);
+ return 1;
+}
+
+static void mp_print_ln (MP mp)
+{
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ mp_log_cr(mp_both_logging_target);
+ mp->term_offset = 0;
+ mp->file_offset = 0;
+ break;
+ case mp_log_only_selector:
+ mp_log_cr(mp_file_logging_target);
+ mp->file_offset = 0;
+ break;
+ case mp_term_only_selector:
+ mp_log_cr(mp_term_logging_target);
+ mp->term_offset = 0;
+ break;
+ case mp_no_print_selector:
+ case mp_new_string_selector:
+ break;
+ default:
+ mp_fputs("\n", mp->wr_file[mp->selector - mp_first_file_selector]);
+ }
+}
+
+static void mp_print_chr (MP mp, unsigned char s)
+{
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ mp_log_chr(mp_both_logging_target, s);
+ mp->term_offset = 1;
+ mp->file_offset = 1;
+ break;
+ case mp_log_only_selector:
+ mp_log_chr(mp_file_logging_target, s);
+ mp->file_offset = 1;
+ break;
+ case mp_term_only_selector:
+ mp_log_chr(mp_term_logging_target, s);
+ mp->term_offset = 1;
+ break;
+ case mp_no_print_selector:
+ break;
+ case mp_new_string_selector:
+ mp_str_room(mp, 1);
+ mp_append_char(mp, s);
+ break;
+ default:
+ {
+ unsigned char ss[2] = { s, 0 };
+ mp_fputs((char *) ss, mp->wr_file[mp->selector - mp_first_file_selector]);
+ }
+ }
+}
+
+void mp_print_e_chr (MP mp, unsigned char s)
+{
+ mp_print_chr(mp, s);
+}
+
+static void mp_do_print (MP mp, const char *s, size_t len)
+{
+ if (len == 0) {
+ return;
+ } else if (mp->selector == mp_new_string_selector) {
+ mp_str_room(mp, (int) len);
+ memcpy((mp->cur_string + mp->cur_length), s, len);
+ mp->cur_length += len;
+ } else {
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ mp_log_mpstr(mp_both_logging_target, s, (int) len);
+ mp->term_offset = 1;
+ mp->file_offset = 1;
+ break;
+ case mp_log_only_selector:
+ mp_log_mpstr(mp_file_logging_target, s, (int) len);
+ mp->file_offset = 1;
+ break;
+ case mp_term_only_selector:
+ mp_log_mpstr(mp_term_logging_target, s, (int) len);
+ mp->term_offset = 1;
+ break;
+ case mp_no_print_selector:
+ break;
+ case mp_new_string_selector:
+ mp_str_room(mp, (int) len);
+ mp_append_str(mp, s);
+ break;
+ default:
+ mp_fputs(s, mp->wr_file[mp->selector - mp_first_file_selector]);
+ break;
+ }
+ }
+}
+
+static void mp_print_str (MP mp, const char *s)
+{
+ mp_do_print(mp, s, strlen(s));
+}
+
+void mp_print_e_str (MP mp, const char *s)
+{
+ mp_print_str(mp,s);
+}
+
+static void mp_print_fmt (MP mp, const char *s, ...)
+{
+ va_list ap;
+ char pval[256];
+ va_start(ap, s);
+ vsnprintf(pval, 256, s, ap);
+ mp_do_print(mp, pval, strlen(pval));
+ va_end(ap);
+}
+
+static void mp_print_mp_str (MP mp, mp_string s)
+{
+ mp_do_print(mp, (const char *) s->str, s->len);
+}
+
+static void mp_print_nl_only (MP mp)
+{
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ if (mp->file_offset > 0) {
+ mp_log_cr(mp_file_logging_target);
+ mp->file_offset = 0;
+ }
+ if (mp->term_offset > 0) {
+ mp_log_cr(mp_term_logging_target);
+ mp->term_offset = 0;
+ }
+ break;
+ case mp_log_only_selector:
+ if (mp->file_offset > 0) {
+ mp_log_cr(mp_file_logging_target);
+ mp->file_offset = 0;
+ }
+ break;
+ case mp_term_only_selector:
+ if (mp->term_offset > 0) {
+ mp_log_cr(mp_term_logging_target);
+ mp->term_offset = 0;
+ }
+ break;
+ case mp_no_print_selector:
+ case mp_new_string_selector:
+ break;
+ }
+}
+
+static void mp_print_nl (MP mp, const char *s)
+{
+ mp_print_nl_only(mp);
+ mp_print_str(mp, s);
+}
+
+static void mp_print_int (MP mp, int n)
+{
+ char s[12];
+ mp_snprintf(s, 12, "%d", (int) n);
+ mp_print_str(mp, s);
+}
+
+void mp_error (MP mp, const char *msg, const char *hlp)
+{
+ int selector = mp->selector;
+ mp_normalize_selector(mp);
+ mp->run_error(mp, msg, hlp, mp->interaction);
+ if (mp->history < mp_error_message_issued) {
+ mp->history = mp_error_message_issued;
+ }
+ if (mp->halt_on_error) {
+ mp->history = mp_fatal_error_stop;
+ mp_jump_out(mp);
+ }
+ ++mp->error_count;
+ if (mp->error_count == 100) {
+ mp_print_nl(mp, "(That makes 100 errors; please try again.)");
+ mp->history = mp_fatal_error_stop;
+ mp_jump_out(mp);
+ }
+ mp->selector = selector;
+}
+
+void mp_normalize_selector (MP mp)
+{
+ mp->selector = mp->interaction == mp_batch_mode ? mp_log_only_selector : mp_term_and_log_selector;
+}
+
+static void mp_clear_arith (MP mp) {
+ mp_error(
+ mp,
+ "Arithmetic overflow",
+ "Uh, oh. A little while ago one of the quantities that I was computing got too\n"
+ "large, so I'm afraid your answers will be somewhat askew. You'll probably have to\n"
+ "adopt different tactics next time. But I shall try to carry on anyway."
+ );
+ mp->arith_error = 0;
+}
+
+static void mp_print_two (MP mp, mp_number *x, mp_number *y)
+{
+ mp_print_chr(mp, '(');
+ print_number(*x);
+ mp_print_chr(mp, ',');
+ print_number(*y);
+ mp_print_chr(mp, ')');
+}
+
+void mp_new_randoms (MP mp)
+{
+ mp_number x;
+ new_number(x);
+ for (int k = 0; k <= 23; k++) {
+ set_number_from_subtraction(x, mp->randoms[k], mp->randoms[k + 31]);
+ if (number_negative(x)) {
+ number_add(x, fraction_one_t);
+ }
+ number_clone(mp->randoms[k], x);
+ }
+ for (int k = 24; k <= 54; k++) {
+ set_number_from_subtraction(x, mp->randoms[k], mp->randoms[k - 24]);
+ if (number_negative(x)) {
+ number_add(x, fraction_one_t);
+ }
+ number_clone(mp->randoms[k], x);
+ }
+ free_number(x);
+ mp->j_random = 54;
+}
+
+void *mp_allocate_node (MP mp, size_t size)
+{
+ void *p = mp_memory_allocate(size);
+ ((mp_node) p)->link = NULL;
+ ((mp_node) p)->hasnumber = 0;
+ mp->var_used += size;
+ if (mp->var_used > mp->var_used_max) {
+ mp->var_used_max = mp->var_used;
+ }
+ return p;
+}
+
+void *mp_allocate_dash (MP mp)
+{
+ void *p = mp_memory_allocate(sizeof(mp_dash_object));
+ mp->var_used += sizeof(mp_dash_object);
+ if (mp->var_used > mp->var_used_max) {
+ mp->var_used_max = mp->var_used;
+ }
+ return p;
+}
+
+void *mp_memory_allocate (size_t size)
+{
+ void *w = lmt_memory_malloc(size);
+ if (! w) {
+ printf("mplib ran out of memory, case 1");
+ exit(EXIT_FAILURE);
+ }
+ return w;
+}
+
+void *mp_memory_clear_allocate (size_t size)
+{
+ void *w = lmt_memory_calloc(1, size);
+ if (! w) {
+ printf("mplib ran out of memory, case 2");
+ exit(EXIT_FAILURE);
+ }
+ return w;
+}
+
+void *mp_memory_reallocate (void *p, size_t size)
+{
+ void *w = lmt_memory_realloc(p, size);
+ if (! w) {
+ printf("mplib ran out of memory, case 3");
+ exit(EXIT_FAILURE);
+ }
+ return w;
+}
+
+void mp_memory_free (void *p)
+{
+ lmt_memory_free(p);
+}
+
+# define mp_get_sym_info(A) mp_get_indep_value(A)
+# define mp_set_sym_info(A,B) mp_set_indep_value(A, (B))
+# define mp_get_sym_sym(A) (A)->data.sym
+# define mp_set_sym_sym(A,B) (A)->data.sym = (mp_sym)(B)
+
+static mp_node mp_new_symbolic_node (MP mp)
+{
+ mp_symbolic_node p;
+ if (mp->symbolic_nodes) {
+ p = (mp_symbolic_node) mp->symbolic_nodes;
+ mp->symbolic_nodes = p->link;
+ mp->num_symbolic_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_node_data));
+ new_number(p->data.n);
+ p->hasnumber = 1;
+ }
+ p->type = mp_symbol_node_type;
+ p->name_type = mp_normal_operation;
+ return (mp_node) p;
+}
+
+static void mp_free_node (MP mp, mp_node p, size_t siz)
+{
+ if (p) {
+ mp->var_used -= siz;
+ if (mp->math_mode > mp_math_double_mode) {
+ if (p->hasnumber >= 1 && is_number(((mp_symbolic_node) p)->data.n)) {
+ free_number(((mp_symbolic_node) p)->data.n);
+ }
+ if (p->hasnumber == 2 && is_number(((mp_value_node) p)->subscript)) {
+ free_number(((mp_value_node) p)->subscript);
+ }
+ if (mp_type(p) == mp_dash_node_type) {
+ free_number(((mp_dash_node) p)->start_x);
+ free_number(((mp_dash_node) p)->stop_x);
+ free_number(((mp_dash_node) p)->dash_y);
+ }
+ }
+ mp_memory_free(p);
+ }
+}
+
+static void mp_free_symbolic_node (MP mp, mp_node p)
+{
+ if (p) {
+ if (mp->num_symbolic_nodes < max_num_symbolic_nodes) {
+ p->link = mp->symbolic_nodes;
+ mp->symbolic_nodes = p;
+ mp->num_symbolic_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_node_data);
+ mp_memory_free(p);
+ }
+ }
+}
+
+static void mp_free_value_node (MP mp, mp_node p)
+{
+ if (p) {
+ if (mp->num_value_nodes < max_num_value_nodes) {
+ p->link = mp->value_nodes;
+ mp->value_nodes = p;
+ mp->num_value_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_value_node_data);
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(((mp_value_node) p)->data.n);
+ free_number(((mp_value_node) p)->subscript);
+ }
+ mp_memory_free(p);
+ }
+ }
+}
+
+static void mp_flush_node_list (MP mp, mp_node p)
+{
+ while (p != NULL) {
+ mp_node q = p;
+ p = p->link;
+ if (q->type != mp_symbol_node_type) {
+ mp_free_token_node(mp, q);
+ } else {
+ mp_free_symbolic_node(mp, q);
+ }
+ }
+}
+
+static const char *mp_type_string(int t)
+{
+ const char *s = NULL;
+ switch (t) {
+ case mp_undefined_type: s = "undefined"; break;
+ case mp_vacuous_type: s = "vacuous"; break;
+ case mp_boolean_type: s = "boolean"; break;
+ case mp_unknown_boolean_type: s = "unknown boolean"; break;
+ case mp_string_type: s = "string"; break;
+ case mp_unknown_string_type: s = "unknown string"; break;
+ case mp_pen_type: s = "pen"; break;
+ case mp_unknown_pen_type: s = "unknown pen"; break;
+ case mp_nep_type: s = "pen"; break;
+ case mp_unknown_nep_type: s = "unknown pen"; break;
+ case mp_path_type: s = "path"; break;
+ case mp_unknown_path_type: s = "unknown path"; break;
+ case mp_picture_type: s = "picture"; break;
+ case mp_unknown_picture_type: s = "unknown picture"; break;
+ case mp_transform_type: s = "transform"; break;
+ case mp_color_type: s = "color"; break;
+ case mp_cmykcolor_type: s = "cmykcolor"; break;
+ case mp_pair_type: s = "pair"; break;
+ case mp_known_type: s = "known numeric"; break;
+ case mp_dependent_type: s = "dependent"; break;
+ case mp_proto_dependent_type: s = "proto-dependent"; break;
+ case mp_numeric_type: s = "numeric"; break;
+ case mp_independent_type: s = "independent"; break;
+ case mp_token_list_type: s = "token list"; break;
+ case mp_structured_type: s = "mp_structured"; break;
+ case mp_unsuffixed_macro_type: s = "unsuffixed macro"; break;
+ case mp_suffixed_macro_type: s = "suffixed macro"; break;
+ case mp_symbol_node_type: s = "symbol node"; break;
+ case mp_token_node_type: s = "token node"; break;
+ case mp_value_node_type: s = "value node"; break;
+ case mp_attribute_node_type: s = "attribute node"; break;
+ case mp_subscript_node_type: s = "subscript node"; break;
+ case mp_pair_node_type: s = "pair node"; break;
+ case mp_transform_node_type: s = "transform node"; break;
+ case mp_color_node_type: s = "color node"; break;
+ case mp_cmykcolor_node_type: s = "cmykcolor node"; break;
+ case mp_fill_node_type: s = "fill node"; break;
+ case mp_stroked_node_type: s = "stroked node"; break;
+ case mp_start_clip_node_type: s = "start clip node"; break;
+ case mp_start_group_node_type: s = "start group node"; break;
+ case mp_start_bounds_node_type: s = "start bounds node"; break;
+ case mp_stop_clip_node_type: s = "stop clip node"; break;
+ case mp_stop_group_node_type: s = "stop group node"; break;
+ case mp_stop_bounds_node_type: s = "stop bounds node"; break;
+ case mp_dash_node_type: s = "dash node"; break;
+ case mp_dep_node_type: s = "dependency node"; break;
+ case mp_if_node_type: s = "if node"; break;
+ case mp_edge_header_node_type: s = "edge header node"; break;
+ default:
+ {
+ char ss[256];
+ mp_snprintf(ss, 256, "<unknown type %d>", t);
+ s = mp_strdup(ss);
+ }
+ break;
+ }
+ return s;
+}
+
+void mp_print_type (MP mp, int t)
+{
+ if (t >= 0 && t <= mp_edge_header_node_type) {
+ mp_print_str(mp, mp_type_string(t));
+ } else {
+ mp_print_str(mp, "unknown");
+ }
+}
+
+static const char *mp_op_string (int c)
+{
+ if (c <= mp_numeric_type) {
+ return mp_type_string(c);
+ } else {
+ switch (c) {
+ case mp_true_operation : return "true";
+ case mp_false_operation : return "false";
+ case mp_null_picture_operation : return "nullpicture";
+ case mp_null_pen_operation : return "nullpen";
+ case mp_read_string_operation : return "readstring";
+ case mp_pen_circle_operation : return "pencircle";
+ case mp_normal_deviate_operation : return "normaldeviate";
+ case mp_read_from_operation : return "readfrom";
+ case mp_close_from_operation : return "closefrom";
+ case mp_odd_operation : return "odd";
+ case mp_known_operation : return "known";
+ case mp_unknown_operation : return "unknown";
+ case mp_not_operation : return "not";
+ case mp_decimal_operation : return "decimal";
+ case mp_reverse_operation : return "reverse";
+ case mp_uncycle_operation : return "uncycle";
+ case mp_make_path_operation : return "makepath";
+ case mp_make_pen_operation : return "makepen";
+ case mp_make_nep_operation : return "makenep";
+ case mp_convexed_operation : return "convexed";
+ case mp_uncontrolled_operation : return "uncontrolled";
+ case mp_oct_operation : return "oct";
+ case mp_hex_operation : return "hex";
+ case mp_ASCII_operation : return "ASCII";
+ case mp_char_operation : return "char";
+ case mp_length_operation : return "length";
+ case mp_turning_operation : return "turningnumber";
+ case mp_x_part_operation : return "xpart";
+ case mp_y_part_operation : return "ypart";
+ case mp_xx_part_operation : return "xxpart";
+ case mp_xy_part_operation : return "xypart";
+ case mp_yx_part_operation : return "yxpart";
+ case mp_yy_part_operation : return "yypart";
+ case mp_red_part_operation : return "redpart";
+ case mp_green_part_operation : return "greenpart";
+ case mp_blue_part_operation : return "bluepart";
+ case mp_cyan_part_operation : return "cyanpart";
+ case mp_magenta_part_operation : return "magentapart";
+ case mp_yellow_part_operation : return "yellowpart";
+ case mp_black_part_operation : return "blackpart";
+ case mp_grey_part_operation : return "greypart";
+ case mp_color_model_operation : return "colormodel";
+ case mp_prescript_part_operation : return "prescriptpart";
+ case mp_postscript_part_operation : return "postscriptpart";
+ case mp_stacking_part_operation : return "stackingpart";
+ case mp_path_part_operation : return "pathpart";
+ case mp_pen_part_operation : return "penpart";
+ case mp_dash_part_operation : return "dashpart";
+ case mp_sqrt_operation : return "sqrt";
+ case mp_m_exp_operation : return "mexp";
+ case mp_m_log_operation : return "mlog";
+ case mp_sin_d_operation : return "sind";
+ case mp_cos_d_operation : return "cosd";
+ case mp_floor_operation : return "floor";
+ case mp_uniform_deviate_operation : return "uniformdeviate";
+ case mp_ll_corner_operation : return "llcorner";
+ case mp_lr_corner_operation : return "lrcorner";
+ case mp_ul_corner_operation : return "ulcorner";
+ case mp_ur_corner_operation : return "urcorner";
+ case mp_center_of_operation : return "centerof";
+ case mp_center_of_mass_operation : return "centerofmass";
+ case mp_corners_operation : return "corners";
+ case mp_x_range_operation : return "xrange";
+ case mp_y_range_operation : return "yrange";
+ case mp_delta_point_operation : return "deltapoint";
+ case mp_delta_precontrol_operation : return "deltaprecontrol";
+ case mp_delta_postcontrol_operation: return "deltapostcontrol";
+ case mp_delta_direction_operation : return "deltadirection";
+ case mp_arc_length_operation : return "arclength";
+ case mp_angle_operation : return "angle";
+ case mp_cycle_operation : return "cycle";
+ case mp_no_cycle_operation : return "nocycle";
+ case mp_filled_operation : return "filled";
+ case mp_stroked_operation : return "stroked";
+ case mp_clipped_operation : return "clipped";
+ case mp_grouped_operation : return "grouped";
+ case mp_bounded_operation : return "bounded";
+ case mp_plus_operation : return "+";
+ case mp_minus_operation : return "-";
+ case mp_times_operation : return "*";
+ case mp_over_operation : return "/";
+ case mp_power_operation : return "^";
+ case mp_pythag_add_operation : return "++";
+ case mp_pythag_sub_operation : return "+-+";
+ case mp_or_operation : return "or";
+ case mp_and_operation : return "and";
+ case mp_less_than_operation : return "<";
+ case mp_less_or_equal_operation : return "<=";
+ case mp_greater_than_operation : return ">";
+ case mp_greater_or_equal_operation : return ">=";
+ case mp_equal_operation : return "=";
+ case mp_unequal_operation : return "<>";
+ case mp_concatenate_operation : return "&";
+ case mp_just_append_operation : return "&&";
+ case mp_rotated_operation : return "rotated";
+ case mp_slanted_operation : return "slanted";
+ case mp_scaled_operation : return "scaled";
+ case mp_shifted_operation : return "shifted";
+ case mp_transformed_operation : return "transformed";
+ case mp_x_scaled_operation : return "xscaled";
+ case mp_y_scaled_operation : return "yscaled";
+ case mp_z_scaled_operation : return "zscaled";
+ case mp_intertimes_operation : return "intersectiontimes";
+ case mp_intertimes_list_operation : return "intersectiontimeslist";
+ case mp_substring_operation : return "substring";
+ case mp_subpath_operation : return "subpath";
+ case mp_direction_time_operation : return "directiontime";
+ case mp_point_operation : return "point";
+ case mp_precontrol_operation : return "precontrol";
+ case mp_postcontrol_operation : return "postcontrol";
+ case mp_direction_operation : return "direction";
+ case mp_path_point_operation : return "pathpoint";
+ case mp_path_precontrol_operation : return "pathprecontrol";
+ case mp_path_postcontrol_operation : return "pathpostcontrol";
+ case mp_path_direction_operation : return "pathdirection";
+ case mp_pen_offset_operation : return "penoffset";
+ case mp_arc_time_operation : return "arctime";
+ case mp_arc_point_operation : return "arcpoint";
+ case mp_arc_point_list_operation : return "arcpointlist";
+ case mp_subarc_length_operation : return "subarclength";
+ case mp_version_operation : return "mpversion";
+ case mp_envelope_operation : return "envelope";
+ case mp_boundingpath_operation : return "boundingpath";
+
+ case mp_pen_type_operation : return "pen";
+ case mp_nep_type_operation : return "nep";
+ case mp_path_type_operation : return "path";
+ case mp_picture_type_operation : return "picture";
+ case mp_transform_type_operation : return "transform";
+ case mp_color_type_operation : return "color";
+ case mp_cmykcolor_type_operation : return "cmykcolor";
+ case mp_pair_type_operation : return "pair";
+ case mp_numeric_type_operation : return "numeric";
+
+ default : return "..";
+ }
+ }
+}
+static void mp_print_op (MP mp, int c)
+{
+ mp_print_str(mp, mp_op_string(c));
+}
+
+static void mp_fix_date_and_time (MP mp)
+{
+ time_t aclock = time ((time_t *) 0);
+ struct tm *tmptr = localtime (&aclock);
+ number_clone(internal_value(mp_time_internal), unity_t);
+ number_multiply_int(internal_value(mp_time_internal), (tmptr->tm_hour * 60 + tmptr->tm_min));
+ number_clone(internal_value(mp_hour_internal), unity_t);
+ number_multiply_int(internal_value(mp_hour_internal), (tmptr->tm_hour));
+ number_clone(internal_value(mp_minute_internal), unity_t);
+ number_multiply_int(internal_value(mp_minute_internal), (tmptr->tm_min));
+ number_clone(internal_value(mp_day_internal), unity_t);
+ number_multiply_int(internal_value(mp_day_internal), (tmptr->tm_mday));
+ number_clone(internal_value(mp_month_internal), unity_t);
+ number_multiply_int(internal_value(mp_month_internal), (tmptr->tm_mon + 1));
+ number_clone(internal_value(mp_year_internal), unity_t);
+ number_multiply_int(internal_value(mp_year_internal), (tmptr->tm_year + 1900));
+}
+
+static void mp_begin_diagnostic (MP mp)
+{
+ mp->old_selector = mp->selector;
+ if (number_nonpositive(internal_value(mp_tracing_online_internal)) && (mp->selector == mp_term_and_log_selector)) {
+ mp->selector = mp_log_only_selector;
+ if (mp->history == mp_spotless) {
+ mp->history = mp_warning_issued;
+ }
+ }
+}
+
+void mp_end_diagnostic (MP mp, int blank_line)
+{
+ mp_print_nl(mp, "");
+ if (blank_line) {
+ mp_print_ln(mp);
+ }
+ mp->selector = mp->old_selector;
+}
+
+static void mp_print_diagnostic (MP mp, const char *s, const char *t, int nuline)
+{
+ mp_begin_diagnostic(mp);
+ if (nuline) {
+ mp_print_nl(mp, s);
+ } else {
+ mp_print_str(mp, s);
+ }
+ mp_print_str(mp, " at line ");
+ mp_print_int(mp, mp_true_line(mp));
+ mp_print_str(mp, t);
+ mp_print_chr(mp, ':');
+}
+
+# define text(A) (A)->text
+# define eq_type(A) (A)->type
+# define eq_property(A) (A)->property
+# define equiv(A) (A)->v.data.indep.serial
+# define equiv_node(A) (A)->v.data.node
+# define equiv_sym(A) (mp_sym)(A)->v.data.node
+
+static int mp_compare_symbols_entry (void *p, const void *pa, const void *pb)
+{
+ const mp_symbol_entry *a = (const mp_symbol_entry *) pa;
+ const mp_symbol_entry *b = (const mp_symbol_entry *) pb;
+ (void) p;
+ if (a->text->len != b->text->len) {
+ return (a->text->len > b->text->len ? 1 : -1);
+ }
+ return strncmp ((const char *) a->text->str, (const char *) b->text->str, a->text->len);
+}
+
+static void *mp_copy_symbols_entry (const void *p)
+{
+
+ mp_symbol_entry *fp = (mp_symbol_entry *) p;
+ MP mp = (MP)fp->parent;
+ mp_sym ff = mp_memory_allocate(sizeof(mp_symbol_entry));
+ if (ff == NULL) {
+ return NULL;
+ }
+ ff->text = mp_aux_copy_strings_entry(fp->text);
+ if (ff->text == NULL) {
+ return NULL;
+ }
+ ff->v = fp->v;
+ ff->type = fp->type;
+ ff->property = fp->property;
+ ff->parent = mp;
+ new_number_clone(ff->v.data.n, fp->v.data.n);
+ return ff;
+}
+
+static void *mp_delete_symbols_entry (void *p)
+{
+ mp_sym ff = (mp_sym) p;
+ MP mp = (MP) ff->parent;
+ free_number(ff->v.data.n);
+ mp_memory_free(ff->text->str);
+ mp_memory_free(ff->text);
+ mp_memory_free(ff);
+ return NULL;
+}
+
+static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len)
+{
+ mp_sym ff = mp_memory_clear_allocate(sizeof(mp_symbol_entry));
+ ff->parent = mp;
+ ff->text = mp_memory_allocate(sizeof(mp_lstring));
+ ff->text->str = nam;
+ ff->text->len = len;
+ ff->type = mp_tag_command;
+ ff->v.type = mp_known_type;
+ new_number(ff->v.data.n);
+ return ff;
+}
+
+static mp_sym mp_do_id_lookup (MP mp, avl_tree symbols, char *j, size_t l, int insert_new)
+{
+ mp_sym str;
+ mp->id_lookup_test->text->str = (unsigned char *) j;
+ mp->id_lookup_test->text->len = l;
+ str = (mp_sym) avl_find(mp->id_lookup_test, symbols);
+ if (str == NULL && insert_new) {
+ unsigned char *nam = (unsigned char *) mp_strndup(j, l);
+ mp_sym s = new_symbols_entry(mp, nam, l);
+ mp->st_count++;
+ avl_ins(s, symbols, avl_false);
+ str = (mp_sym) avl_find(s, symbols);
+ mp_delete_symbols_entry(s);
+ }
+ return str;
+}
+
+int mp_initialize_symbol_traverse (MP mp)
+{
+ mp->symbol_iterator = avl_iterator_new(mp->symbols, AVL_ITERATOR_INI_PRE);
+ return (mp->symbol_iterator != NULL);
+}
+
+void mp_kill_symbol_traverse (MP mp)
+{
+ avl_iterator_kill(mp->symbol_iterator);
+}
+
+void *mp_fetch_symbol_traverse (MP mp)
+{
+ return avl_iterator_next(mp->symbol_iterator);
+}
+
+void *mp_fetch_symbol (MP mp, char *s)
+{
+ return mp_id_lookup(mp, s, strlen(s), 0);
+}
+
+static void mp_primitive (MP mp, const char *ss, int c, int o)
+{
+
+ set_cur_sym(mp_id_lookup(mp, (char *) ss, strlen(ss), 1));
+ set_eq_type(cur_sym, c);
+ set_eq_property(cur_sym, 0x1);
+ set_equiv(cur_sym, o);
+}
+
+static mp_sym mp_frozen_primitive (MP mp, const char *ss, int c, int o)
+{
+
+ mp_sym str = mp_do_id_lookup(mp, mp->frozen_symbols, (char *) ss, strlen(ss), 1);
+ str->type = c;
+ str->property = 0x1;
+ str->v.data.indep.serial = o;
+ return str;
+}
+
+static int mp_is_frozen (MP mp, mp_sym sym)
+{
+ mp_sym temp = mp_do_id_lookup(mp, mp->frozen_symbols, (char *) sym->text->str, sym->text->len, 0);
+ if (temp == mp->frozen_inaccessible) {
+ return 0;
+ } else {
+ return (temp == sym);
+ }
+}
+
+# define mp_get_value_sym(A) ((mp_token_node) (A))->data.sym
+# define mp_get_value_number(A) ((mp_token_node) (A))->data.n
+# define mp_get_value_node(A) ((mp_token_node) (A))->data.node
+# define mp_get_value_str(A) ((mp_token_node) (A))->data.str
+# define mp_get_value_knot(A) ((mp_token_node) (A))->data.p
+
+inline static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B)
+{
+ (void) mp;
+ A->data.sym=(B);
+}
+
+inline static void do_set_value_number (MP mp, mp_token_node A, mp_number *B)
+{
+ (void) mp;
+ A->data.p = NULL;
+ A->data.str = NULL;
+ A->data.node = NULL;
+ number_clone(A->data.n, *B);
+}
+
+inline static void do_set_value_str (MP mp, mp_token_node A, mp_string B)
+{
+ (void) mp;
+ A->data.p = NULL;
+ A->data.str = (B);
+ add_str_ref((B));
+ A->data.node = NULL;
+ number_clone(A->data.n, zero_t);
+}
+
+inline static void do_set_value_node (MP mp, mp_token_node A, mp_node B)
+{
+ (void) mp;
+ A->data.p = NULL;
+ A->data.str = NULL;
+ A->data.node = B;
+ number_clone(A->data.n, zero_t);
+}
+
+inline static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B)
+{
+ (void) mp;
+ A->data.p = (B);
+ A->data.str = NULL;
+ A->data.node = NULL;
+ number_clone(A->data.n, zero_t);
+}
+
+static mp_node mp_new_token_node (MP mp)
+{
+ mp_node p;
+ if (mp->token_nodes) {
+ p = mp->token_nodes;
+ mp->token_nodes = p->link;
+ mp->num_token_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_node_data));
+ new_number(p->data.n);
+ p->hasnumber = 1;
+ }
+ p->type = mp_token_node_type;
+ return (mp_node) p;
+}
+
+static void mp_free_token_node (MP mp, mp_node p)
+{
+ if (p) {
+ if (mp->num_token_nodes < max_num_token_nodes) {
+ p->link = mp->token_nodes;
+ mp->token_nodes = p;
+ mp->num_token_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_node_data);
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(((mp_value_node) p)->data.n);
+ }
+ mp_memory_free(p);
+ }
+ }
+}
+
+static mp_node mp_new_num_tok (MP mp, mp_number *v)
+{
+ mp_node p = mp_new_token_node(mp);
+ mp_set_value_number(p, *v);
+ p->type = mp_known_type;
+ p->name_type = mp_token_operation;
+ return p;
+}
+
+static void mp_flush_token_list (MP mp, mp_node p)
+{
+ while (p != NULL) {
+ mp_node q = p;
+ p = mp_link(p);
+ switch (mp_type(q)) {
+ case mp_symbol_node_type:
+ mp_free_symbolic_node(mp, q);
+ continue;
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_known_type:
+ break;
+ case mp_string_type:
+ delete_str_ref(mp_get_value_str(q));
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ case mp_pair_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_transform_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ mp_recycle_value(mp, q);
+ break;
+ default:
+ mp_confusion(mp, "token");
+ }
+ mp_free_token_node(mp, q);
+ }
+}
+
+void mp_show_token_list (MP mp, mp_node p, mp_node q)
+{
+ int cclass = mp_percent_class;
+ (void) q;
+ while (p != NULL) {
+ int c = mp_letter_class;
+ if (mp_type(p) != mp_symbol_node_type) {
+ if (mp_name_type(p) == mp_token_operation) {
+ if (mp_type(p) == mp_known_type) {
+ if (cclass == mp_digit_class) {
+ mp_print_chr(mp, ' ');
+ }
+ if (number_negative(mp_get_value_number(p))) {
+ if (cclass == mp_left_bracket_class) {
+ mp_print_chr(mp, ' ');
+ }
+ mp_print_chr(mp, '[');
+ print_number(mp_get_value_number(p));
+ mp_print_chr(mp, ']');
+ c = mp_right_bracket_class;
+ } else {
+ print_number(mp_get_value_number(p));
+ c = mp_digit_class;
+ }
+ } else if (mp_type(p) == mp_string_type) {
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, mp_get_value_str(p));
+ mp_print_chr(mp, '"');
+ c = mp_string_class;
+ } else {
+ mp_print_str(mp, " BAD");
+ }
+ } else if ((mp_name_type(p) != mp_capsule_operation) || (mp_type(p) < mp_vacuous_type) || (mp_type(p) > mp_independent_type)) {
+ mp_print_str(mp, " BAD");
+ } else {
+ mp_print_capsule(mp, p);
+ c = mp_right_parenthesis_class;
+ }
+ } else if (mp_name_type(p) == mp_expr_operation || mp_name_type(p) == mp_suffix_operation || mp_name_type(p) == mp_text_operation) {
+ int r = mp_get_sym_info(p);
+ if (mp_name_type(p) == mp_expr_operation) {
+ mp_print_str(mp, "(EXPR");
+ } else if (mp_name_type(p) == mp_suffix_operation) {
+ mp_print_str(mp, "(SUFFIX");
+ } else {
+ mp_print_str(mp, "(TEXT");
+ }
+ mp_print_int(mp, r);
+ mp_print_chr(mp, ')');
+ c = mp_right_parenthesis_class;
+ } else {
+ mp_sym sr = mp_get_sym_sym(p);
+ if (sr == mp_collective_subscript) {
+ if (cclass == mp_left_bracket_class) {
+ mp_print_chr(mp, ' ');
+ }
+ mp_print_str(mp, "[]");
+ c = mp_right_bracket_class;
+ } else {
+ mp_string rr = text(sr);
+ if (rr == NULL || rr->str == NULL) {
+ mp_print_str(mp, " NONEXISTENT");
+ } else {
+ c = mp->char_class[(rr->str[0])];
+ if (c == cclass) {
+ switch (c) {
+ case mp_letter_class:
+ mp_print_chr(mp, '.');
+ break;
+ case mp_comma_class:
+ case mp_semicolon_class:
+ case mp_left_parenthesis_class:
+ case mp_right_parenthesis_class:
+ break;
+ default:
+ mp_print_chr(mp, ' ');
+ break;
+ }
+ }
+ mp_print_mp_str(mp, rr);
+ }
+ }
+ }
+ cclass = c;
+ p = mp_link(p);
+ }
+ return;
+}
+
+void mp_show_token_list_space (MP mp, mp_node p, mp_node q)
+{
+ (void) q;
+ while (p != NULL) {
+ if (mp_type(p) != mp_symbol_node_type) {
+ if (mp_name_type(p) == mp_token_operation) {
+ if (mp_type(p) == mp_known_type) {
+ if (number_negative(mp_get_value_number(p))) {
+ mp_print_str(mp, "[ ");
+ print_number(mp_get_value_number(p));
+ mp_print_str(mp, " ]");
+ } else {
+ print_number(mp_get_value_number(p));
+ }
+ } else if (mp_type(p) == mp_string_type) {
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, mp_get_value_str(p));
+ mp_print_chr(mp, '"');
+ } else {
+ mp_print_str(mp, "BAD");
+ }
+ } else if ((mp_name_type(p) != mp_capsule_operation) || (mp_type(p) < mp_vacuous_type) || (mp_type(p) > mp_independent_type)) {
+ mp_print_str(mp, "BAD");
+ } else {
+ mp_print_capsule(mp, p);
+ }
+ } else if (mp_name_type(p) == mp_expr_operation || mp_name_type(p) == mp_suffix_operation || mp_name_type(p) == mp_text_operation) {
+ int r = mp_get_sym_info(p);
+ if (mp_name_type(p) == mp_expr_operation) {
+ mp_print_str(mp, "(EXPR ");
+ } else if (mp_name_type(p) == mp_suffix_operation) {
+ mp_print_str(mp, "(SUFFIX ");
+ } else {
+ mp_print_str(mp, "(TEXT ");
+ }
+ mp_print_int(mp, r);
+ mp_print_chr(mp, ')');
+ } else {
+ mp_sym sr = mp_get_sym_sym(p);
+ if (sr == mp_collective_subscript) {
+ mp_print_str(mp, "[]");
+ } else {
+ mp_string rr = text(sr);
+ if (rr == NULL || rr->str == NULL) {
+ mp_print_str(mp, "NONEXISTENT");
+ } else {
+ mp_print_mp_str(mp, rr);
+ }
+ }
+ }
+ p = mp_link(p);
+ if (p) {
+ mp_print_chr(mp, ' ');
+ }
+ }
+ return;
+}
+
+static void mp_delete_mac_ref (MP mp, mp_node p)
+{
+ if (mp_get_ref_count(p) == 0) {
+ mp_flush_token_list(mp, p);
+ } else {
+ mp_decr_mac_ref(p);
+ }
+}
+
+static void mp_show_macro (MP mp, mp_node p, mp_node q)
+{
+ p = mp_link(p);
+ while (mp_name_type(p) != mp_macro_operation) {
+ mp_node r = mp_link(p);
+ mp_link(p) = NULL;
+ mp_show_token_list(mp, p, NULL);
+ mp_link(p) = r;
+ p = r;
+ }
+ switch (mp_get_sym_info(p)) {
+ case mp_general_macro:
+ mp_print_str(mp, "-> ");
+ break;
+ case mp_primary_macro:
+ case mp_secondary_macro:
+ case mp_tertiary_macro:
+ mp_print_str(mp, "<");
+ mp_print_cmd_mod(mp, mp_parameter_commmand, mp_get_sym_info(p));
+ mp_print_str(mp, "> -> ");
+ break;
+ case mp_expr_macro:
+ mp_print_str(mp, "<expr> -> ");
+ break;
+ case mp_of_macro:
+ mp_print_str(mp, "<expr> of <primary> -> ");
+ break;
+ case mp_suffix_macro:
+ mp_print_str(mp, "<suffix> -> ");
+ break;
+ case mp_text_macro:
+ mp_print_str(mp, "<text> -> ");
+ break;
+ }
+ mp_show_token_list(mp, mp_link(p), q);
+}
+
+static mp_node mp_do_get_attribute_head (MP mp, mp_value_node A)
+{
+ (void) mp;
+ return A->attr_head;
+}
+
+static mp_node mp_do_get_subscr_head (MP mp, mp_value_node A)
+{
+ return A->subscr_head;
+ (void) mp;
+}
+
+static void mp_do_set_attribute_head (MP mp, mp_value_node A, mp_node d)
+{
+ (void) mp;
+ A->attr_head = d;
+}
+
+static void mp_do_set_subscr_head (MP mp, mp_value_node A, mp_node d)
+{
+ (void) mp;
+ A->subscr_head = d;
+}
+
+static mp_node mp_new_value_node (MP mp)
+{
+ mp_value_node p;
+ if (mp->value_nodes) {
+ p = (mp_value_node) mp->value_nodes;
+ mp->value_nodes = p->link;
+ mp->num_value_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_value_node_data));
+ new_number(p->data.n);
+ new_number(p->subscript);
+ p->hasnumber = 2;
+ }
+ mp_type(p) = mp_value_node_type;
+ return (mp_node) p;
+}
+
+# define mp_get_hashloc(A) ((mp_value_node)(A))->hashloc_
+# define mp_set_hashloc(A,B) ((mp_value_node)(A))->hashloc_ = B
+# define mp_get_parent(A) ((mp_value_node)(A))->parent
+# define mp_set_parent(A,B) ((mp_value_node)(A))->parent = B
+
+static mp_value_node mp_get_attribute_node (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_new_value_node(mp);
+ mp_type(p) = mp_attribute_node_type;
+ return p;
+}
+
+static mp_value_node mp_get_subscr_node (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_new_value_node(mp);
+ mp_type(p) = mp_subscript_node_type;
+ return p;
+}
+
+static mp_node mp_get_pair_node (MP mp)
+{
+ mp_node p;
+ if (mp->pair_nodes) {
+ p = mp->pair_nodes;
+ mp->pair_nodes = p->link;
+ mp->num_pair_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_pair_node_data));
+ }
+ mp_type(p) = mp_pair_node_type;
+ return (mp_node) p;
+}
+
+static void mp_free_pair_node (MP mp, mp_node p)
+{
+ if (p) {
+ if (mp->num_pair_nodes < max_num_pair_nodes) {
+ p->link = mp->pair_nodes;
+ mp->pair_nodes = p;
+ mp->num_pair_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_pair_node_data);
+ mp_memory_free(p);
+ }
+ }
+}
+
+static void mp_init_pair_node (MP mp, mp_node p)
+{
+ mp_node q;
+ mp_type(p) = mp_pair_type;
+ q = mp_get_pair_node(mp);
+ mp_y_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_y_part(q));
+ mp_name_type(mp_y_part(q)) = mp_y_part_operation;
+ mp_link(mp_y_part(q)) = p;
+ mp_x_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_x_part(q));
+ mp_name_type(mp_x_part(q)) = mp_x_part_operation;
+ mp_link(mp_x_part(q)) = p;
+ mp_set_value_node(p, q);
+}
+
+static mp_node mp_get_transform_node (MP mp)
+{
+ mp_transform_node p = (mp_transform_node) mp_allocate_node(mp, sizeof(mp_transform_node_data));
+ mp_type(p) = mp_transform_node_type;
+ return (mp_node) p;
+}
+
+static void mp_init_transform_node (MP mp, mp_node p)
+{
+ mp_node q;
+ mp_type(p) = mp_transform_type;
+ q = mp_get_transform_node(mp);
+ mp_yy_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_yy_part(q));
+ mp_name_type(mp_yy_part(q)) = mp_yy_part_operation;
+ mp_link(mp_yy_part(q)) = p;
+ mp_yx_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_yx_part(q));
+ mp_name_type(mp_yx_part(q)) = mp_yx_part_operation;
+ mp_link(mp_yx_part(q)) = p;
+ mp_xy_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_xy_part(q));
+ mp_name_type(mp_xy_part(q)) = mp_xy_part_operation;
+ mp_link(mp_xy_part(q)) = p;
+ mp_xx_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_xx_part(q));
+ mp_name_type(mp_xx_part(q)) = mp_xx_part_operation;
+ mp_link(mp_xx_part(q)) = p;
+ mp_ty_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_ty_part(q));
+ mp_name_type(mp_ty_part(q)) = mp_y_part_operation;
+ mp_link(mp_ty_part(q)) = p;
+ mp_tx_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_tx_part(q));
+ mp_name_type(mp_tx_part(q)) = mp_x_part_operation;
+ mp_link(mp_tx_part(q)) = p;
+ mp_set_value_node(p, q);
+}
+
+static void mp_init_color_node (MP mp, mp_node p, int type)
+{
+ mp_node q = (mp_node) mp_allocate_node(mp, sizeof(mp_color_node_data));
+ q->link = NULL;
+ mp_type(p) = type;
+ switch (type) {
+ case mp_color_type:
+ mp_type(q) = mp_color_node_type;
+ mp_red_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_red_part(q));
+ mp_name_type(mp_red_part(q)) = mp_red_part_operation;
+ mp_link(mp_red_part(q)) = p;
+ mp_green_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_green_part(q));
+ mp_name_type(mp_green_part(q)) = mp_green_part_operation;
+ mp_link(mp_green_part(q)) = p;
+ mp_blue_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_blue_part(q));
+ mp_name_type(mp_blue_part(q)) = mp_blue_part_operation;
+ mp_link(mp_blue_part(q)) = p;
+ break;
+ case mp_cmykcolor_type:
+ mp_type(q) = mp_cmykcolor_node_type;
+ mp_cyan_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_cyan_part(q));
+ mp_name_type(mp_cyan_part(q)) = mp_cyan_part_operation;
+ mp_link(mp_cyan_part(q)) = p;
+ mp_magenta_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_magenta_part(q));
+ mp_name_type(mp_magenta_part(q)) = mp_magenta_part_operation;
+ mp_link(mp_magenta_part(q)) = p;
+ mp_yellow_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_yellow_part(q));
+ mp_name_type(mp_yellow_part(q)) = mp_yellow_part_operation;
+ mp_link(mp_yellow_part(q)) = p;
+ mp_black_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_black_part(q));
+ mp_name_type(mp_black_part(q)) = mp_black_part_operation;
+ mp_link(mp_black_part(q)) = p;
+ break;
+ }
+ mp_set_value_node(p, q);
+}
+
+static mp_node mp_id_transform (MP mp)
+{
+ mp_node q;
+ mp_node p = mp_new_value_node(mp);
+ mp_name_type(p) = mp_capsule_operation;
+ mp_set_value_number(p, zero_t);
+ mp_init_transform_node(mp, p);
+ q = mp_get_value_node(p);
+ mp_type(mp_tx_part(q)) = mp_known_type;
+ mp_set_value_number(mp_tx_part(q), zero_t);
+ mp_type(mp_ty_part(q)) = mp_known_type;
+ mp_set_value_number(mp_ty_part(q), zero_t);
+ mp_type(mp_xy_part(q)) = mp_known_type;
+ mp_set_value_number(mp_xy_part(q), zero_t);
+ mp_type(mp_yx_part(q)) = mp_known_type;
+ mp_set_value_number(mp_yx_part(q), zero_t);
+ mp_type(mp_xx_part(q)) = mp_known_type;
+ mp_set_value_number(mp_xx_part(q), unity_t);
+ mp_type(mp_yy_part(q)) = mp_known_type;
+ mp_set_value_number(mp_yy_part(q), unity_t);
+ return p;
+}
+
+static void mp_new_root (MP mp, mp_sym x)
+{
+ mp_node p = mp_new_value_node(mp);
+ mp_type(p) = mp_undefined_type;
+ mp_name_type(p) = mp_root_operation;
+ mp_set_value_sym(p, x);
+ set_equiv_node(x, p);
+}
+
+void mp_print_variable_name (MP mp, mp_node p)
+{
+ mp_node q = NULL;
+ mp_node r = NULL;
+ while (mp_name_type(p) >= mp_x_part_operation) {
+ switch (mp_name_type(p)) {
+ case mp_x_part_operation : mp_print_str(mp, "xpart "); break;
+ case mp_y_part_operation : mp_print_str(mp, "ypart "); break;
+ case mp_xx_part_operation : mp_print_str(mp, "xxpart "); break;
+ case mp_xy_part_operation : mp_print_str(mp, "xypart "); break;
+ case mp_yx_part_operation : mp_print_str(mp, "yxpart "); break;
+ case mp_yy_part_operation : mp_print_str(mp, "yypart "); break;
+ case mp_red_part_operation : mp_print_str(mp, "redpart "); break;
+ case mp_green_part_operation : mp_print_str(mp, "greenpart "); break;
+ case mp_blue_part_operation : mp_print_str(mp, "bluepart "); break;
+ case mp_cyan_part_operation : mp_print_str(mp, "cyanpart "); break;
+ case mp_magenta_part_operation: mp_print_str(mp, "magentapart "); break;
+ case mp_yellow_part_operation : mp_print_str(mp, "yellowpart "); break;
+ case mp_black_part_operation : mp_print_str(mp, "blackpart "); break;
+ case mp_grey_part_operation : mp_print_str(mp, "greypart "); break;
+ case mp_capsule_operation : mp_print_fmt(mp, "%%CAPSULE%p", p); return;
+ default : break;
+ }
+ p = mp_link(p);
+ }
+ while (mp_name_type(p) > mp_saved_root_operation) {
+ if (mp_name_type(p) == mp_subscript_operation) {
+ r = mp_new_num_tok(mp, &(mp_subscript(p)));
+ do {
+ p = mp_link(p);
+ } while (mp_name_type(p) != mp_attribute_operation);
+ } else if (mp_name_type(p) == mp_structured_root_operation) {
+ p = mp_link(p);
+ goto FOUND;
+ } else if (mp_name_type(p) != mp_attribute_operation) {
+ mp_confusion(mp, "variable");
+ } else {
+ r = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(r, mp_get_hashloc(p));
+ }
+ mp_set_link(r, q);
+ q = r;
+ FOUND:
+ p = mp_get_parent((mp_value_node) p);
+ }
+ r = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(r, mp_get_value_sym(p));
+ mp_link(r) = q;
+ if (mp_name_type(p) == mp_saved_root_operation) {
+ mp_print_str(mp, "(SAVED)");
+ }
+ mp_show_token_list(mp, r, NULL);
+ mp_flush_token_list(mp, r);
+}
+
+static int mp_interesting (MP mp, mp_node p)
+{
+ if (number_positive(internal_value(mp_tracing_capsules_internal))) {
+ return 1;
+ } else {
+ mp_name_type_type t = mp_name_type(p);
+ if (t >= mp_x_part_operation && t != mp_capsule_operation) {
+ mp_node tt = mp_get_value_node(mp_link(p));
+ switch (t) {
+ case mp_x_part_operation: t = mp_name_type(mp_x_part (tt)); break;
+ case mp_y_part_operation: t = mp_name_type(mp_y_part (tt)); break;
+ case mp_xx_part_operation: t = mp_name_type(mp_xx_part (tt)); break;
+ case mp_xy_part_operation: t = mp_name_type(mp_xy_part (tt)); break;
+ case mp_yx_part_operation: t = mp_name_type(mp_yx_part (tt)); break;
+ case mp_yy_part_operation: t = mp_name_type(mp_yy_part (tt)); break;
+ case mp_red_part_operation: t = mp_name_type(mp_red_part (tt)); break;
+ case mp_green_part_operation: t = mp_name_type(mp_green_part (tt)); break;
+ case mp_blue_part_operation: t = mp_name_type(mp_blue_part (tt)); break;
+ case mp_cyan_part_operation: t = mp_name_type(mp_cyan_part (tt)); break;
+ case mp_magenta_part_operation: t = mp_name_type(mp_magenta_part(tt)); break;
+ case mp_yellow_part_operation: t = mp_name_type(mp_yellow_part (tt)); break;
+ case mp_black_part_operation: t = mp_name_type(mp_black_part (tt)); break;
+ case mp_grey_part_operation: t = mp_name_type(mp_grey_part (tt)); break;
+ default: break;
+ }
+ }
+ return (t != mp_capsule_operation);
+ }
+}
+
+static mp_node mp_new_structure (MP mp, mp_node p)
+{
+ mp_node r = NULL;
+ switch (mp_name_type(p)) {
+ case mp_root_operation:
+ {
+ mp_sym q = mp_get_value_sym(p);
+ r = mp_new_value_node(mp);
+ set_equiv_node(q, r);
+ }
+ break;
+ case mp_subscript_operation:
+ {
+ mp_node q_new;
+ mp_node q = p;
+ do {
+ q = mp_link(q);
+ } while (mp_name_type(q) != mp_attribute_operation);
+ q = mp_get_parent((mp_value_node) q);
+ r = mp->temp_head;
+ mp_set_link(r, mp_get_subscr_head(q));
+ do {
+ q_new = r;
+ r = mp_link(r);
+ } while (r != p);
+ r = (mp_node) mp_get_subscr_node(mp);
+ if (q_new == mp->temp_head) {
+ mp_set_subscr_head(q, r);
+ } else {
+ mp_set_link(q_new, r);
+ }
+ number_clone(mp_subscript(r), mp_subscript(p));
+ }
+ break;
+ case mp_attribute_operation:
+ {
+ mp_value_node rr;
+ mp_node q = mp_get_parent((mp_value_node) p);
+ r = mp_get_attribute_head(q);
+ do {
+ q = r;
+ r = mp_link(r);
+ } while (r != p);
+ rr = mp_get_attribute_node(mp);
+ r = (mp_node) rr;
+ mp_set_link(q, rr);
+ mp_set_hashloc(rr, mp_get_hashloc(p));
+ mp_set_parent(rr, mp_get_parent((mp_value_node) p));
+ if (mp_get_hashloc(p) == mp_collective_subscript) {
+ q = mp->temp_head;
+ mp_set_link(q, mp_get_subscr_head(mp_get_parent((mp_value_node) p)));
+ while (mp_link(q) != p) {
+ q = mp_link(q);
+ }
+ if (q == mp->temp_head) {
+ mp_set_subscr_head(mp_get_parent((mp_value_node) p), (mp_node) rr);
+ } else {
+ mp_set_link(q, rr);
+ }
+ }
+ }
+ break;
+ default:
+ mp_confusion(mp, "structure");
+ break;
+ }
+ if (r) {
+ mp_value_node q;
+ mp_set_link(r, mp_link(p));
+ mp_set_value_sym(r, mp_get_value_sym(p));
+ mp_type(r) = mp_structured_type;
+ mp_name_type(r) = mp_name_type(p);
+ mp_set_attribute_head(r, p);
+ mp_name_type(p) = mp_structured_root_operation;
+ q = mp_get_attribute_node(mp);
+ mp_set_link(p, q);
+ mp_set_subscr_head(r, (mp_node) q);
+ mp_set_parent(q, r);
+ mp_type(q) = mp_undefined_type;
+ mp_name_type(q) = mp_attribute_operation;
+ mp_set_link(q, mp->end_attr);
+ mp_set_hashloc(q, mp_collective_subscript);
+ }
+ return r;
+}
+
+static mp_node mp_find_variable (MP mp, mp_node t)
+{
+ mp_sym p_sym = mp_get_sym_sym(t);
+
+ if (eq_type(p_sym) != mp_tag_command) {
+ return NULL;
+ } else {
+ mp_node p, q, r, s;
+ mp_node pp, qq, rr, ss;
+ t = mp_link(t);
+ if (equiv_node(p_sym) == NULL) {
+ mp_new_root (mp, p_sym);
+ }
+ p = equiv_node(p_sym);
+ pp = p;
+ while (t != NULL) {
+ if (mp_type(pp) != mp_structured_type) {
+ if (mp_type(pp) > mp_structured_type) {
+ return NULL;
+ } else {
+ ss = mp_new_structure(mp, pp);
+ if (p == pp) {
+ p = ss;
+ }
+ pp = ss;
+ }
+ }
+ if (mp_type(p) != mp_structured_type) {
+ p = mp_new_structure(mp, p);
+ }
+ if (mp_type(t) != mp_symbol_node_type) {
+ mp_number nn, save_subscript;
+ new_number_clone(nn, mp_get_value_number(t));
+ pp = mp_link(mp_get_attribute_head(pp));
+ q = mp_link(mp_get_attribute_head(p));
+ new_number_clone(save_subscript, mp_subscript(q));
+ set_number_to_inf(mp_subscript(q));
+ s = mp->temp_head;
+ mp_set_link(s, mp_get_subscr_head(p));
+ do {
+ r = s;
+ s = mp_link(s);
+ } while (number_greater(nn, mp_subscript(s)));
+ if (number_equal(nn, mp_subscript(s))) {
+ p = s;
+ } else {
+ mp_value_node p1 = mp_get_subscr_node(mp);
+ if (r == mp->temp_head) {
+ mp_set_subscr_head(p, (mp_node) p1);
+ } else {
+ mp_set_link(r, p1);
+ }
+ mp_set_link(p1, s);
+ number_clone(mp_subscript(p1), nn);
+ mp_name_type(p1) = mp_subscript_operation;
+ mp_type(p1) = mp_undefined_type;
+ p = (mp_node) p1;
+ }
+ number_clone(mp_subscript(q), save_subscript);
+ free_number(save_subscript);
+ free_number(nn);
+ } else {
+ mp_sym nn1 = mp_get_sym_sym(t);
+ ss = mp_get_attribute_head(pp);
+ do {
+ rr = ss;
+ ss = mp_link(ss);
+ } while (nn1 > mp_get_hashloc(ss));
+ if (nn1 < mp_get_hashloc(ss)) {
+ qq = (mp_node) mp_get_attribute_node(mp);
+ mp_set_link(rr, qq);
+ mp_set_link(qq, ss);
+ mp_set_hashloc(qq, nn1);
+ mp_name_type(qq) = mp_attribute_operation;
+ mp_type(qq) = mp_undefined_type;
+ mp_set_parent((mp_value_node) qq, pp);
+ ss = qq;
+ }
+ if (p == pp) {
+ p = ss;
+ pp = ss;
+ } else {
+ pp = ss;
+ s = mp_get_attribute_head(p);
+ do {
+ r = s;
+ s = mp_link(s);
+ } while (nn1 > mp_get_hashloc(s));
+ if (nn1 == mp_get_hashloc(s)) {
+ p = s;
+ } else {
+ q = (mp_node) mp_get_attribute_node(mp);
+ mp_set_link(r, q);
+ mp_set_link(q, s);
+ mp_set_hashloc(q, nn1);
+ mp_name_type(q) = mp_attribute_operation;
+ mp_type(q) = mp_undefined_type;
+ mp_set_parent((mp_value_node) q, p);
+ p = q;
+ }
+ }
+ }
+ t = mp_link(t);
+ }
+ if (mp_type(pp) >= mp_structured_type) {
+ if (mp_type(pp) == mp_structured_type) {
+ pp = mp_get_attribute_head(pp);
+ } else {
+ return NULL;
+ }
+ }
+ if (mp_type(p) == mp_structured_type) {
+ p = mp_get_attribute_head(p);
+ }
+ if (mp_type(p) == mp_undefined_type) {
+ if (mp_type(pp) == mp_undefined_type) {
+ mp_type(pp) = mp_numeric_type;
+ mp_set_value_number(pp, zero_t);
+ }
+ mp_type(p) = mp_type(pp);
+ mp_set_value_number(p, zero_t);
+ }
+ return p;
+ }
+}
+
+static void mp_flush_variable (MP mp, mp_node p, mp_node t, int discard_suffixes)
+{
+ while (t != NULL) {
+ if (mp_type(p) != mp_structured_type) {
+ return;
+ } else {
+ mp_sym n = mp_get_sym_sym(t);
+ t = mp_link(t);
+ if (n == mp_collective_subscript) {
+ mp_node q = mp_get_subscr_head(p);
+ mp_node r = NULL;
+ while (mp_name_type(q) == mp_subscript_operation) {
+ mp_flush_variable(mp, q, t, discard_suffixes);
+ if (t != NULL) {
+ r = q;
+ } else if (mp_type(q) == mp_structured_type) {
+ r = q;
+ } else {
+ if (r == NULL) {
+ mp_set_subscr_head(p, mp_link(q));
+ } else {
+ mp_set_link(r, mp_link(q));
+ }
+ mp_free_value_node(mp, q);
+ }
+ q = r == NULL ? mp_get_subscr_head(p) : mp_link(r);
+ }
+ }
+ p = mp_get_attribute_head(p);
+ do {
+ p = mp_link(p);
+ } while (mp_get_hashloc(p) < n);
+ if (mp_get_hashloc(p) != n) {
+ return;
+ }
+ }
+ }
+ if (discard_suffixes) {
+ mp_flush_below_variable(mp, p);
+ } else {
+ if (mp_type(p) == mp_structured_type) {
+ p = mp_get_attribute_head(p);
+ }
+ mp_recycle_value(mp, p);
+ }
+}
+
+void mp_flush_below_variable (MP mp, mp_node p)
+{
+ if (mp_type(p) != mp_structured_type) {
+ mp_recycle_value(mp, p);
+ } else {
+ mp_node r;
+ mp_node q = mp_get_subscr_head(p);
+ while (mp_name_type(q) == mp_subscript_operation) {
+ mp_flush_below_variable(mp, q);
+ r = q;
+ q = mp_link(q);
+ mp_free_value_node(mp, r);
+ }
+ r = mp_get_attribute_head(p);
+ q = mp_link(r);
+ mp_recycle_value(mp, r);
+ mp_free_value_node(mp, r);
+ do {
+ mp_flush_below_variable(mp, q);
+ r = q;
+ q = mp_link(q);
+ mp_free_value_node(mp, r);
+ } while (q != mp->end_attr);
+ mp_type(p) = mp_undefined_type;
+ }
+}
+
+static int mp_und_type (MP mp, mp_node p)
+{
+ (void) mp;
+ switch (mp_type(p)) {
+ case mp_vacuous_type:
+ return mp_undefined_type;
+ case mp_boolean_type:
+ case mp_unknown_boolean_type:
+ return mp_unknown_boolean_type;
+ case mp_string_type:
+ case mp_unknown_string_type:
+ return mp_unknown_string_type;
+ case mp_pen_type:
+ case mp_unknown_pen_type:
+ return mp_unknown_pen_type;
+ case mp_nep_type:
+ case mp_unknown_nep_type:
+ return mp_unknown_nep_type;
+ case mp_path_type:
+ case mp_unknown_path_type:
+ return mp_unknown_path_type;
+ case mp_picture_type:
+ case mp_unknown_picture_type:
+ return mp_unknown_picture_type;
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ case mp_numeric_type:
+ return mp_type(p);
+ case mp_known_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ return mp_numeric_type;
+ default:
+ return 0;
+ }
+}
+
+static void mp_clear_symbol (MP mp, mp_sym p, int saving)
+{
+ mp_node q = equiv_node(p);
+ if (eq_property(p) > 0) {
+ mp_check_overload(mp, p);
+ }
+ switch (eq_type(p)) {
+ case mp_defined_macro_command:
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ if (!saving) {
+ mp_delete_mac_ref(mp, q);
+ }
+ break;
+ case mp_tag_command:
+ if (q != NULL) {
+ if (saving) {
+ mp_name_type(q) = mp_saved_root_operation;
+ } else {
+ mp_flush_below_variable(mp, q);
+ mp_free_value_node(mp, q);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ set_equiv(p, mp->frozen_undefined->v.data.indep.serial);
+ set_eq_type(p, mp->frozen_undefined->type);
+}
+
+static void mp_save_boundary (MP mp)
+{
+ mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data));
+ p->type = 0;
+ p->link = mp->save_ptr;
+ mp->save_ptr = p;
+}
+
+static void mp_save_variable (MP mp, mp_sym q)
+{
+ if (mp->save_ptr != NULL) {
+ mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data));
+ p->type = mp_normal_operation;
+ p->link = mp->save_ptr;
+ p->value.v.data.indep.scale = eq_type(q);
+ p->value.v.data.indep.serial = equiv(q);
+ p->value.v.data.node = equiv_node(q);
+ p->value.v.data.p = (mp_knot)q;
+ mp->save_ptr = p;
+ }
+ mp_clear_symbol(mp, q, (mp->save_ptr != NULL));
+}
+
+static void mp_unsave_variable (MP mp)
+{
+ mp_sym q = (mp_sym)mp->save_ptr->value.v.data.p;
+ if (number_positive(internal_value(mp_tracing_restores_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{restoring ");
+ mp_print_mp_str(mp,text(q));
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+ }
+ mp_clear_symbol(mp, q, 0);
+ set_eq_type(q, mp->save_ptr->value.v.data.indep.scale);
+ set_equiv(q,mp->save_ptr->value.v.data.indep.serial);
+ q->v.data.node = mp->save_ptr->value.v.data.node;
+
+ if (eq_type(q) == mp_tag_command) {
+ mp_node pp = q->v.data.node;
+ if (pp != NULL) {
+ mp_name_type(pp) = mp_root_operation;
+ }
+ }
+}
+
+static void mp_save_internal (MP mp, int q)
+{
+ if (mp->save_ptr != NULL) {
+ mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data));
+ p->type = mp_internal_operation;
+ p->link = mp->save_ptr;
+ p->value = mp->internal[q];
+ p->value.v.data.indep.serial = q;
+ if (internal_run(q) == 1) {
+ mp->run_internal(mp, 1, q, internal_type(q), internal_name(q));
+ }
+ new_number_clone(p->value.v.data.n, mp->internal[q].v.data.n);
+ mp->save_ptr = p;
+ }
+}
+
+static void mp_unsave_internal (MP mp)
+{
+ int q = mp->save_ptr->value.v.data.indep.serial;
+ mp_internal saved = mp->save_ptr->value;
+ if (number_positive(internal_value(mp_tracing_restores_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{restoring ");
+ mp_print_str(mp, internal_name(q));
+ mp_print_chr(mp, '=');
+ switch (internal_type(q)) {
+ case mp_known_type:
+ case mp_numeric_type:
+ print_number(saved.v.data.n);
+ break;
+ case mp_boolean_type:
+ mp_print_str(mp, number_to_boolean(saved.v.data.n) == mp_true_operation ? "true" : "false");
+ break;
+ case mp_string_type:
+ {
+ char *s = mp_str(mp, saved.v.data.str);
+ mp_print_str(mp, s);
+ break;
+ }
+ default:
+ mp_confusion(mp, "internal restore");
+ break;
+ }
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+ }
+ free_number(mp->internal[q].v.data.n);
+ if (internal_run(q) == 1) {
+ mp->run_internal(mp, 2, q, internal_type(q), internal_name(q));
+ }
+ mp->internal[q] = saved;
+}
+
+static void mp_unsave (MP mp)
+{
+ mp_save_data *p;
+ while (mp->save_ptr->type != 0) {
+ if (mp->save_ptr->type == mp_internal_operation) {
+ mp_unsave_internal(mp);
+ } else {
+ mp_unsave_variable(mp);
+ }
+ p = mp->save_ptr->link;
+ mp_memory_free(mp->save_ptr);
+ mp->save_ptr = p;
+ }
+ p = mp->save_ptr->link;
+ mp_memory_free(mp->save_ptr);
+ mp->save_ptr = p;
+}
+
+void mp_pr_path (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ do {
+ mp_knot q = mp_next_knot(p);
+ if ((p == NULL) || (q == NULL)) {
+ mp_print_nl(mp, "???");
+ return;
+ } else {
+ mp_print_two(mp, &(p->x_coord), &(p->y_coord));
+ switch (mp_knotstate(p)) {
+ case mp_begin_knot:
+ mp_print_str(mp, " {begin}");
+ break;
+ case mp_end_knot:
+ mp_print_str(mp, " {end}");
+ break;
+ }
+ switch (mp_right_type(p)) {
+ case mp_endpoint_knot:
+ {
+ if (mp_left_type(p) == mp_open_knot) {
+ mp_print_str(mp, " {open?}");
+ }
+ if ((mp_left_type(q) != mp_endpoint_knot) || (q != h)) {
+ q = NULL;
+ }
+ goto DONE1;
+ }
+ break;
+ case mp_explicit_knot:
+ {
+ mp_print_str(mp, " .. controls ");
+ mp_print_two(mp, &(p->right_x), &(p->right_y));
+ mp_print_str(mp, " and ");
+ if (mp_left_type(q) != mp_explicit_knot) {
+ mp_print_str(mp, "??");
+ } else {
+ mp_print_two(mp, &(q->left_x), &(q->left_y));
+ }
+ goto DONE1;
+ }
+ break;
+ case mp_open_knot:
+ {
+ if ((mp_left_type(p) != mp_explicit_knot) && (mp_left_type(p) != mp_open_knot)) {
+ mp_print_str(mp, " {open?}");
+ }
+ }
+ break;
+ case mp_curl_knot:
+ case mp_given_knot:
+ {
+ if (mp_left_type(p) == mp_open_knot) {
+ mp_print_str(mp, " ??");
+ }
+ if (mp_right_type(p) == mp_curl_knot) {
+ mp_print_str(mp, " {curl");
+ print_number(p->right_curl);
+ } else {
+ mp_number n_sin, n_cos;
+ new_fraction(n_sin);
+ new_fraction(n_cos);
+ n_sin_cos(p->right_given, n_cos, n_sin);
+ mp_print_str(mp, " {");
+ print_number(n_cos);
+ mp_print_chr(mp, ',');
+ print_number(n_sin);
+ free_number(n_sin);
+ free_number(n_cos);
+ }
+ mp_print_str(mp, "} ");
+ }
+ break;
+ default:
+ {
+ mp_print_str(mp, "???");
+ }
+ break;
+ }
+ if (mp_left_type(q) <= mp_explicit_knot) {
+ mp_print_str(mp, " .. control ?");
+ } else if ((! number_equal(p->right_tension, unity_t)) || (! number_equal(q->left_tension, unity_t))) {
+ mp_number v1;
+ mp_print_str(mp, " .. tension");
+ if (number_negative(p->right_tension)) {
+ mp_print_str(mp, " atleast");
+ }
+ new_number_abs(v1, p->right_tension);
+ print_number(v1);
+ if (! number_equal(p->right_tension, q->left_tension)) {
+ mp_print_str(mp, " and");
+ if (number_negative(q->left_tension)) {
+ mp_print_str(mp, " atleast");
+ }
+ number_abs_clone(v1, p->left_tension);
+ print_number(v1);
+ }
+ free_number(v1);
+ }
+
+ DONE1:
+ p = q;
+ if (p && ((p != h) || (mp_left_type(h) != mp_endpoint_knot))) {
+ mp_number n_sin, n_cos;
+ new_fraction(n_sin);
+ new_fraction(n_cos);
+ mp_print_nl(mp, " .. ");
+ if (mp_left_type(p) == mp_given_knot) {
+ n_sin_cos(p->left_given, n_cos, n_sin);
+ mp_print_str(mp, "{");
+ print_number(n_cos);
+ mp_print_chr(mp, ',');
+ print_number(n_sin);
+ mp_print_chr(mp, '}');
+ } else if (mp_left_type(p) == mp_curl_knot) {
+ mp_print_str(mp, "{curl ");
+ print_number(p->left_curl);
+ mp_print_chr(mp, '}');
+ }
+ free_number(n_sin);
+ free_number(n_cos);
+ }
+ }
+ } while (p != h);
+ if (mp_left_type(h) != mp_endpoint_knot) {
+ mp_print_str(mp, " cycle");
+ }
+}
+
+void mp_print_path (MP mp, mp_knot h, const char *s, int nuline)
+{
+ mp_print_diagnostic(mp, "Path", s, nuline);
+ mp_print_ln(mp);
+ mp_pr_path(mp, h);
+ mp_end_diagnostic(mp, 1);
+}
+
+static mp_knot mp_new_knot (MP mp)
+{
+ mp_knot q;
+ if (mp->knot_nodes) {
+ q = mp->knot_nodes;
+ mp->knot_nodes = q->next;
+ mp->num_knot_nodes--;
+ } else {
+ q = mp_memory_clear_allocate(sizeof(struct mp_knot_data));
+ }
+ new_number(q->x_coord);
+ new_number(q->y_coord);
+ new_number(q->left_x);
+ new_number(q->left_y);
+ new_number(q->right_x);
+ new_number(q->right_y);
+ return q;
+}
+
+static mp_gr_knot mp_gr_new_knot (MP mp)
+{
+ mp_gr_knot q = mp_memory_allocate(sizeof(struct mp_gr_knot_data));
+ (void) mp;
+ return q;
+}
+
+static mp_knot mp_copy_knot (MP mp, mp_knot p)
+{
+ mp_knot q;
+ if (mp->knot_nodes) {
+ q = mp->knot_nodes;
+ mp->knot_nodes = q->next;
+ mp->num_knot_nodes--;
+ } else {
+ q = mp_memory_allocate(sizeof(struct mp_knot_data));
+ }
+ memcpy(q, p, sizeof(struct mp_knot_data));
+ if (mp->math_mode > mp_math_double_mode) {
+ new_number_clone(q->x_coord, p->x_coord);
+ new_number_clone(q->y_coord, p->y_coord);
+ new_number_clone(q->left_x, p->left_x);
+ new_number_clone(q->left_y, p->left_y);
+ new_number_clone(q->right_x, p->right_x);
+ new_number_clone(q->right_y, p->right_y);
+ }
+ mp_prev_knot(q) = NULL;
+ mp_next_knot(q) = NULL;
+ return q;
+}
+
+static mp_gr_knot mp_export_knot (MP mp, mp_knot p)
+{
+ mp_gr_knot q = mp_gr_new_knot(mp);
+ q->x_coord = number_to_double(p->x_coord);
+ q->y_coord = number_to_double(p->y_coord);
+ q->left_x = number_to_double(p->left_x);
+ q->left_y = number_to_double(p->left_y);
+ q->right_x = number_to_double(p->right_x);
+ q->right_y = number_to_double(p->right_y);
+ q->left_type = p->left_type;
+ q->right_type = p->right_type;
+ q->info = p->info;
+ q->originator = p->originator;
+ q->state = p->state;
+ q->prev = NULL;
+ q->next = NULL;
+ return q;
+}
+
+static mp_knot mp_copy_path (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return NULL;
+ } else {
+ mp_knot q = mp_copy_knot(mp, p);
+ mp_knot qq = q;
+ mp_knot pp = mp_next_knot(p);
+ while (pp != p) {
+ mp_knot k = mp_copy_knot(mp, pp);
+ mp_next_knot(qq) = k;
+ mp_prev_knot(k) = qq;
+ qq = mp_next_knot(qq);
+ pp = mp_next_knot(pp);
+ }
+ mp_next_knot(qq) = q;
+ mp_prev_knot(q) = qq;
+ return q;
+ }
+}
+
+static mp_gr_knot mp_export_path (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return NULL;
+ } else {
+ mp_gr_knot q = mp_export_knot(mp, p);
+ mp_gr_knot qq = q;
+ mp_knot pp = mp_next_knot(p);
+ while (pp != p) {
+ mp_gr_knot k = mp_export_knot(mp, pp);
+ mp_prev_knot(k) = qq;
+ mp_next_knot(qq) = k;
+ qq = k;
+ pp = mp_next_knot(pp);
+ }
+ mp_prev_knot(q) = qq;
+ mp_next_knot(qq) = q;
+ return q;
+ }
+}
+
+static mp_gr_knot mp_export_knot_list (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return NULL;
+ } else {
+ mp_gr_knot q = mp_export_path(mp, p);
+ return q;
+ }
+}
+
+static mp_knot mp_htap_ypoc (MP mp, mp_knot p)
+{
+ mp_knot q = mp_new_knot(mp);
+ mp_knot qq = q;
+ mp_knot pp = p;
+ while (1) {
+ mp_right_type(qq) = mp_left_type(pp);
+ mp_left_type(qq) = mp_right_type(pp);
+ number_clone(qq->x_coord, pp->x_coord);
+ number_clone(qq->y_coord, pp->y_coord);
+ number_clone(qq->right_x, pp->left_x);
+ number_clone(qq->right_y, pp->left_y);
+ number_clone(qq->left_x, pp->right_x);
+ number_clone(qq->left_y, pp->right_y);
+ mp_originator(qq) = mp_originator(pp);
+ mp_knotstate(qq) = mp_knotstate(pp);
+ if (mp_next_knot(pp) == p) {
+ mp_prev_knot(qq) = q;
+ mp_next_knot(q) = qq;
+ mp->path_tail = pp;
+ return q;
+ } else {
+ mp_knot rr = mp_new_knot(mp);
+ mp_prev_knot(qq) = rr;
+ mp_next_knot(rr) = qq;
+ qq = rr;
+ pp = mp_next_knot(pp);
+ }
+ }
+}
+
+static void mp_free_knot (MP mp, mp_knot q)
+{
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(q->x_coord);
+ free_number(q->y_coord);
+ free_number(q->left_x);
+ free_number(q->left_y);
+ free_number(q->right_x);
+ free_number(q->right_y);
+ }
+ mp_memory_free(q);
+}
+
+static void mp_toss_knot (MP mp, mp_knot q)
+{
+ if (mp->num_knot_nodes < mp->max_knot_nodes) {
+ mp_next_knot(q) = mp->knot_nodes;
+ mp->knot_nodes = q;
+ mp->num_knot_nodes++;
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(q->x_coord);
+ free_number(q->y_coord);
+ free_number(q->left_x);
+ free_number(q->left_y);
+ free_number(q->right_x);
+ free_number(q->right_y);
+ }
+ } else {
+ mp_free_knot(mp, q);
+ }
+}
+
+static void mp_toss_knot_list (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return;
+ } else {
+ mp_knot q = p;
+ do {
+ mp_knot r = mp_next_knot(q);
+ mp_toss_knot(mp, q);
+ q = r;
+ } while (q != p);
+ }
+}
+
+void mp_make_choices (MP mp, mp_knot knots)
+{
+ mp_knot h;
+ mp_knot p, q;
+ int k, n;
+ mp_knot s, t;
+
+ check_arith();
+ if (number_positive(internal_value(mp_tracing_choices_internal))) {
+ mp_print_path(mp, knots, ", before choices", 1);
+ }
+ p = knots;
+ do {
+ q = mp_next_knot(p);
+ if (number_equal(p->x_coord, q->x_coord) && number_equal(p->y_coord, q->y_coord) && mp_right_type(p) > mp_explicit_knot) {
+ mp_right_type(p) = mp_explicit_knot;
+ if (mp_left_type(p) == mp_open_knot) {
+ mp_left_type(p) = mp_curl_knot;
+ set_number_to_unity(p->left_curl);
+ }
+ mp_left_type(q) = mp_explicit_knot;
+ if (mp_right_type(q) == mp_open_knot) {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_to_unity(q->right_curl);
+ }
+ number_clone(p->right_x, p->x_coord);
+ number_clone(q->left_x, p->x_coord);
+ number_clone(p->right_y, p->y_coord);
+ number_clone(q->left_y, p->y_coord);
+ }
+ p = q;
+ } while (p != knots);
+
+ h = knots;
+ while (1) {
+ if (mp_left_type(h) != mp_open_knot) {
+ break;
+ } else if (mp_right_type(h) != mp_open_knot) {
+ break;
+ } else {
+ h = mp_next_knot(h);
+ if (h == knots) {
+ mp_left_type(h) = mp_end_cycle_knot;
+ break;
+ }
+ }
+ }
+ p = h;
+ do {
+ q = mp_next_knot(p);
+ if (mp_right_type(p) >= mp_given_knot) {
+ while ((mp_left_type(q) == mp_open_knot) && (mp_right_type(q) == mp_open_knot)) {
+ q = mp_next_knot(q);
+ }
+ mp_number sine, cosine;
+ mp_number arg1, arg2, r1, r2;
+ mp_number delx, dely;
+ new_fraction(sine);
+ new_fraction(cosine);
+ new_number(arg1);
+ new_number(arg2);
+ new_fraction(r1);
+ new_fraction(r2);
+ new_number(delx);
+ new_number(dely);
+
+ {
+ RESTART:
+ k = 0;
+ s = p;
+ n = mp->path_size;
+ do {
+ t = mp_next_knot(s);
+ set_number_from_subtraction(mp->delta_x[k], t->x_coord, s->x_coord);
+ set_number_from_subtraction(mp->delta_y[k], t->y_coord, s->y_coord);
+ pyth_add(mp->delta[k], mp->delta_x[k], mp->delta_y[k]);
+ if (k > 0) {
+ make_fraction(r1, mp->delta_y[k - 1], mp->delta[k - 1]);
+ number_clone(sine, r1);
+ make_fraction(r2, mp->delta_x[k - 1], mp->delta[k - 1]);
+ number_clone(cosine, r2);
+ take_fraction(r1, mp->delta_x[k], cosine);
+ take_fraction(r2, mp->delta_y[k], sine);
+ set_number_from_addition(arg1, r1, r2);
+ take_fraction(r1, mp->delta_y[k], cosine);
+ take_fraction(r2, mp->delta_x[k], sine);
+ set_number_from_subtraction(arg2, r1, r2);
+ n_arg(mp->psi[k], arg1, arg2 );
+ }
+ ++k;
+ s = t;
+ if (k == mp->path_size) {
+ mp_reallocate_paths(mp, mp->path_size + (mp->path_size / 4));
+ goto RESTART;
+ } else if (s == q) {
+ n = k;
+ }
+ } while (! ((k >= n) && (mp_left_type(s) != mp_end_cycle_knot)));
+ if (k == n) {
+ set_number_to_zero(mp->psi[k]);
+ } else {
+ number_clone(mp->psi[k], mp->psi[1]);
+ }
+ }
+ {
+ if (mp_left_type(q) == mp_open_knot) {
+ set_number_from_subtraction(delx, q->right_x, q->x_coord);
+ set_number_from_subtraction(dely, q->right_y, q->y_coord);
+ if (number_zero(delx) && number_zero(dely)) {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_to_unity(q->left_curl);
+ } else {
+ mp_left_type(q) = mp_given_knot;
+ n_arg(q->left_given, delx, dely);
+ }
+ }
+ if ((mp_right_type(p) == mp_open_knot) && (mp_left_type(p) == mp_explicit_knot)) {
+ set_number_from_subtraction(delx, p->x_coord, p->left_x);
+ set_number_from_subtraction(dely, p->y_coord, p->left_y);
+ if (number_zero(delx) && number_zero(dely)) {
+ mp_right_type(p) = mp_curl_knot;
+ set_number_to_unity(p->right_curl);
+ } else {
+ mp_right_type(p) = mp_given_knot;
+ n_arg(p->right_given, delx, dely);
+ }
+ }
+ }
+ free_number(sine);
+ free_number(cosine);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(r1);
+ free_number(r2);
+ free_number(delx);
+ free_number(dely);
+
+ mp_solve_choices(mp, p, q, n);
+ } else if (mp_right_type(p) == mp_endpoint_knot) {
+ number_clone(p->right_x, p->x_coord);
+ number_clone(p->right_y, p->y_coord);
+ number_clone(q->left_x, q->x_coord);
+ number_clone(q->left_y, q->y_coord);
+ }
+ p = q;
+ } while (p != h);
+ if (number_positive(internal_value(mp_tracing_choices_internal))) {
+ mp_print_path(mp, knots, ", after choices", 1);
+ }
+ if (mp->arith_error) {
+ mp_back_error(
+ mp,
+ "Some number got too big",
+ "The path that I just computed is out of range. So it will probably look funny.\n"
+ "Proceed, for a laugh."
+ );
+ mp_get_x_next(mp);
+ mp->arith_error = 0;
+ }
+}
+
+void mp_reallocate_paths (MP mp, int l)
+{
+ mp->delta_x = mp_memory_reallocate(mp->delta_x, (size_t) (l + 1) * sizeof(mp_number));
+ mp->delta_y = mp_memory_reallocate(mp->delta_y, (size_t) (l + 1) * sizeof(mp_number));
+ mp->delta = mp_memory_reallocate(mp->delta, (size_t) (l + 1) * sizeof(mp_number));
+ mp->psi = mp_memory_reallocate(mp->psi, (size_t) (l + 1) * sizeof(mp_number));
+ mp->theta = mp_memory_reallocate(mp->theta, (size_t) (l + 1) * sizeof(mp_number));
+ mp->uu = mp_memory_reallocate(mp->uu, (size_t) (l + 1) * sizeof(mp_number));
+ mp->vv = mp_memory_reallocate(mp->vv, (size_t) (l + 1) * sizeof(mp_number));
+ mp->ww = mp_memory_reallocate(mp->ww, (size_t) (l + 1) * sizeof(mp_number));
+ for (int k = mp->path_size; k<l; k++) {
+ new_number(mp->delta_x[k]);
+ new_number(mp->delta_y[k]);
+ new_number(mp->delta[k]);
+ new_angle(mp->psi[k]);
+ new_angle(mp->theta[k]);
+ new_fraction(mp->uu[k]);
+ new_angle(mp->vv[k]);
+ new_fraction(mp->ww[k]);
+ }
+ mp->path_size = l;
+}
+
+void mp_solve_choices (MP mp, mp_knot p, mp_knot q, int n)
+{
+ int k = 0;
+ mp_knot r = 0;
+ mp_knot s = p;
+ mp_number ff;
+ new_fraction(ff);
+ while (1) {
+ mp_knot t = mp_next_knot(s);
+ if (k == 0) {
+ switch (mp_right_type(s)) {
+ case mp_given_knot:
+ if (mp_left_type(t) == mp_given_knot) {
+ {
+ mp_number arg1;
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->delta_x[0], mp->delta_y[0]);
+ new_number(arg1);
+ set_number_from_subtraction(arg1, p->right_given, narg);
+ n_sin_cos(arg1, mp->ct, mp->st);
+ set_number_from_subtraction(arg1, q->left_given, narg);
+ n_sin_cos(arg1, mp->cf, mp->sf);
+ number_negate(mp->sf);
+ mp_set_controls (mp, p, q, 0);
+ free_number(narg);
+ free_number(arg1);
+ free_number(ff);
+ return;
+ }
+ } else {
+ {
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->delta_x[0], mp->delta_y[0]);
+ set_number_from_subtraction(mp->vv[0], s->right_given, narg);
+ free_number(narg);
+ mp_reduce_angle(mp, &mp->vv[0]);
+ set_number_to_zero(mp->uu[0]);
+ set_number_to_zero(mp->ww[0]);
+ }
+ }
+ break;
+ case mp_curl_knot:
+ if (mp_left_type(t) == mp_curl_knot) {
+ {
+ mp_number lt, rt;
+ mp_right_type(p) = mp_explicit_knot;
+ mp_left_type(q) = mp_explicit_knot;
+ new_number_abs(lt, q->left_tension);
+ new_number_abs(rt, p->right_tension);
+ if (number_unity(rt)) {
+ mp_number arg2;
+ new_number(arg2);
+ if (number_nonnegative(mp->delta_x[0])) {
+ set_number_from_addition(arg2, mp->delta_x[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_x[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_addition(p->right_x, p->x_coord, arg2);
+ if (number_nonnegative(mp->delta_y[0])) {
+ set_number_from_addition(arg2, mp->delta_y[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_y[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_addition(p->right_y, p->y_coord, arg2);
+ free_number(arg2);
+ } else {
+ mp_number arg2, r1;
+ new_fraction(r1);
+ new_number_clone(arg2, rt);
+ number_multiply_int(arg2, 3);
+ make_fraction(ff, unity_t, arg2);
+ free_number(arg2);
+ take_fraction(r1, mp->delta_x[0], ff);
+ set_number_from_addition(p->right_x, p->x_coord, r1);
+ take_fraction(r1, mp->delta_y[0], ff);
+ set_number_from_addition(p->right_y, p->y_coord, r1);
+ }
+ if (number_unity(lt)) {
+ mp_number arg2;
+ new_number(arg2);
+ if (number_nonnegative(mp->delta_x[0])) {
+ set_number_from_addition(arg2, mp->delta_x[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_x[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_subtraction(q->left_x, q->x_coord, arg2);
+ if (number_nonnegative(mp->delta_y[0])) {
+ set_number_from_addition(arg2, mp->delta_y[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_y[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_subtraction(q->left_y, q->y_coord, arg2);
+ free_number(arg2);
+ } else {
+ mp_number arg2, r1;
+ new_fraction(r1);
+ new_number_clone(arg2, lt);
+ number_multiply_int(arg2, 3);
+ make_fraction(ff, unity_t, arg2);
+ free_number(arg2);
+ take_fraction(r1, mp->delta_x[0], ff);
+ set_number_from_subtraction(q->left_x, q->x_coord, r1);
+ take_fraction(r1, mp->delta_y[0], ff);
+ set_number_from_subtraction(q->left_y, q->y_coord, r1);
+ free_number(r1);
+ }
+ free_number(ff);
+ free_number(lt);
+ free_number(rt);
+ return;
+ }
+ } else {
+ {
+ mp_number lt, rt, cc;
+ new_number_clone(cc, s->right_curl);
+ new_number_abs(lt, t->left_tension);
+ new_number_abs(rt, s->right_tension);
+ if (number_unity(rt) && number_unity(lt)) {
+ mp_number arg1, arg2;
+ new_number_clone(arg1, cc);
+ new_number_clone(arg2, cc);
+ number_double(arg1);
+ number_add(arg1, unity_t);
+ number_add(arg2, two_t);
+ make_fraction(mp->uu[0], arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ } else {
+ mp_curl_ratio(mp, &mp->uu[0], &cc, &rt, &lt);
+ }
+ take_fraction(mp->vv[0], mp->psi[1], mp->uu[0]);
+ number_negate(mp->vv[0]);
+ set_number_to_zero(mp->ww[0]);
+ free_number(rt);
+ free_number(lt);
+ free_number(cc);
+ }
+ }
+ break;
+ case mp_open_knot:
+ set_number_to_zero(mp->uu[0]);
+ set_number_to_zero(mp->vv[0]);
+ number_clone(mp->ww[0], fraction_one_t);
+ break;
+ }
+ } else {
+ switch (mp_left_type(s)) {
+ case mp_end_cycle_knot:
+ case mp_open_knot:
+ {
+ mp_number aa, bb, cc, acc;
+ mp_number dd, ee;
+ new_fraction(aa);
+ new_fraction(bb);
+ new_fraction(cc);
+ new_fraction(acc);
+ new_number(dd);
+ new_number(ee);
+ {
+ mp_number absval;
+ new_number_abs(absval, r->right_tension);
+ if (number_equal(absval, unity_t)) {
+ number_clone(aa, fraction_half_t);
+ number_clone(dd, mp->delta[k]);
+ number_double(dd);
+ } else {
+ mp_number arg1, arg2, ret;
+ new_number(arg1);
+ new_number_abs(arg2, r->right_tension);
+ number_multiply_int(arg2, 3);
+ number_subtract(arg2, unity_t);
+ make_fraction(aa, unity_t, arg2);
+ number_abs_clone(arg2, r->right_tension);
+ new_fraction(ret);
+ make_fraction(ret, unity_t, arg2);
+ set_number_from_subtraction(arg1, fraction_three_t, ret);
+ take_fraction(arg2, mp->delta[k], arg1);
+ number_clone(dd, arg2);
+ free_number(ret);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ number_abs_clone(absval, t->left_tension);
+ if (number_equal(absval, unity_t)) {
+ number_clone(bb, fraction_half_t);
+ number_clone(ee, mp->delta[k - 1]);
+ number_double(ee);
+ } else {
+ mp_number arg1, arg2, ret;
+ new_number(arg1);
+ new_number_abs(arg2, t->left_tension);
+ number_multiply_int(arg2, 3);
+ number_subtract(arg2, unity_t);
+ make_fraction(bb, unity_t, arg2);
+ number_abs_clone(arg2, t->left_tension);
+ new_fraction(ret);
+ make_fraction(ret, unity_t, arg2);
+ set_number_from_subtraction(arg1, fraction_three_t, ret);
+ take_fraction(ee, mp->delta[k - 1], arg1);
+ free_number(ret);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ free_number(absval);
+ }
+ {
+ mp_number r1;
+ new_number(r1);
+ take_fraction(r1, mp->uu[k - 1], aa);
+ set_number_from_subtraction(cc, fraction_one_t, r1);
+ free_number(r1);
+ }
+ {
+ mp_number rt, lt;
+ mp_number arg2;
+ new_number_clone(arg2, dd);
+ take_fraction(dd, arg2, cc);
+ new_number_abs(lt, s->left_tension);
+ new_number_abs(rt, s->right_tension);
+ if (! number_equal(lt, rt)) {
+ mp_number r1;
+ new_number(r1);
+ if (number_less(lt, rt)) {
+ make_fraction(r1, lt, rt);
+ take_fraction(ff, r1, r1);
+ number_clone(r1, dd);
+ take_fraction(dd, r1, ff);
+ } else {
+ make_fraction(r1, rt, lt);
+ take_fraction(ff, r1, r1);
+ number_clone(r1, ee);
+ take_fraction(ee, r1, ff);
+ }
+ free_number(r1);
+ }
+ free_number(rt);
+ free_number(lt);
+ set_number_from_addition(arg2, dd, ee);
+ make_fraction(ff, ee, arg2);
+ free_number(arg2);
+ }
+ take_fraction(mp->uu[k], ff, bb);
+ take_fraction(acc, mp->psi[k + 1], mp->uu[k]);
+ number_negate(acc);
+ if (mp_right_type(r) == mp_curl_knot) {
+ mp_number r1, arg2;
+ new_fraction(r1);
+ new_number(arg2);
+ set_number_from_subtraction(arg2, fraction_one_t, ff);
+ take_fraction(r1, mp->psi[1], arg2);
+ set_number_to_zero(mp->ww[k]);
+ set_number_from_subtraction(mp->vv[k], acc, r1);
+ free_number(r1);
+ free_number(arg2);
+ } else {
+ mp_number arg1, r1;
+ new_fraction(r1);
+ new_number(arg1);
+ set_number_from_subtraction(arg1, fraction_one_t, ff);
+ make_fraction(ff, arg1, cc);
+ free_number(arg1);
+ take_fraction(r1, mp->psi[k], ff);
+ number_subtract(acc, r1);
+ number_clone(r1, ff);
+ take_fraction(ff, r1, aa);
+ take_fraction(r1, mp->vv[k - 1], ff);
+ set_number_from_subtraction(mp->vv[k], acc, r1 );
+ if (number_zero(mp->ww[k - 1])) {
+ set_number_to_zero(mp->ww[k]);
+ } else {
+ take_fraction(mp->ww[k], mp->ww[k - 1], ff);
+ number_negate(mp->ww[k]);
+ }
+ free_number(r1);
+ }
+ if (mp_left_type(s) == mp_end_cycle_knot) {
+ mp_number arg2, r1;
+ new_number(arg2);
+ new_number(r1);
+ set_number_to_zero(aa);
+ number_clone(bb, fraction_one_t);
+ do {
+ --k;
+ if (k == 0) {
+ k = n;
+ }
+ take_fraction(r1, aa, mp->uu[k]);
+ set_number_from_subtraction(aa, mp->vv[k], r1);
+ take_fraction(r1, bb, mp->uu[k]);
+ set_number_from_subtraction(bb, mp->ww[k], r1);
+ } while (k != n);
+ set_number_from_subtraction(arg2, fraction_one_t, bb);
+ make_fraction(r1, aa, arg2);
+ number_clone(aa, r1);
+ number_clone(mp->theta[n], aa);
+ number_clone(mp->vv[0], aa);
+ for (k = 1; k < n; k++) {
+ take_fraction(r1, aa, mp->ww[k]);
+ number_add(mp->vv[k], r1);
+ }
+ free_number(arg2);
+ free_number(r1);
+ free_number(aa);
+ free_number(bb);
+ free_number(cc);
+ free_number(acc);
+ free_number(dd);
+ free_number(ee);
+ goto FOUND;
+ }
+ free_number(aa);
+ free_number(bb);
+ free_number(cc);
+ free_number(acc);
+ free_number(dd);
+ free_number(ee);
+ }
+ break;
+ case mp_curl_knot:
+ {
+ mp_number lt, rt, cc;
+ new_number_clone(cc, s->left_curl);
+ new_number_abs(lt, s->left_tension);
+ new_number_abs(rt, r->right_tension);
+ if (number_unity(rt) && number_unity(lt)) {
+ mp_number arg1, arg2;
+ new_number_clone(arg1, cc);
+ new_number_clone(arg2, cc);
+ number_double(arg1);
+ number_add(arg1, unity_t);
+ number_add(arg2, two_t);
+ make_fraction(ff, arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ } else {
+ mp_curl_ratio(mp, &ff, &cc, &lt, &rt);
+ }
+ {
+ mp_number arg1, arg2, r1;
+ new_fraction(r1);
+ new_fraction(arg1);
+ new_number(arg2);
+ take_fraction(arg1, mp->vv[n - 1], ff);
+ take_fraction(r1, ff, mp->uu[n - 1]);
+ set_number_from_subtraction(arg2, fraction_one_t, r1);
+ make_fraction(mp->theta[n], arg1, arg2);
+ number_negate(mp->theta[n]);
+ free_number(r1);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ free_number(rt);
+ free_number(lt);
+ free_number(cc);
+ goto FOUND;
+ }
+ break;
+ case mp_given_knot:
+ {
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->delta_x[n - 1], mp->delta_y[n - 1]);
+ set_number_from_subtraction(mp->theta[n], s->left_given, narg);
+ free_number(narg);
+ mp_reduce_angle(mp, &mp->theta[n]);
+ goto FOUND;
+ }
+ break;
+ }
+ }
+ r = s;
+ s = t;
+ ++k;
+ }
+FOUND:
+ {
+ mp_number r1;
+ new_number(r1);
+ for (k = n - 1; k >= 0; k--) {
+ take_fraction(r1, mp->theta[k + 1], mp->uu[k]);
+ set_number_from_subtraction(mp->theta[k], mp->vv[k], r1);
+ }
+ free_number(r1);
+ }
+ s = p;
+ k = 0;
+ {
+ mp_number arg;
+ new_number(arg);
+ do {
+ mp_knot t = mp_next_knot(s);
+ n_sin_cos(mp->theta[k], mp->ct, mp->st);
+ number_negated_clone(arg, mp->psi[k + 1]);
+ number_subtract(arg, mp->theta[k + 1]);
+ n_sin_cos(arg, mp->cf, mp->sf);
+ mp_set_controls (mp, s, t, k);
+ ++k;
+ s = t;
+ } while (k != n);
+ free_number(arg);
+ }
+ free_number(ff);
+}
+
+static void mp_reduce_angle (MP mp, mp_number *a)
+{
+ mp_number abs_a;
+ new_number_abs(abs_a, *a);
+ if (number_greater(abs_a, one_eighty_deg_t)) {
+ if (number_positive(*a)) {
+ number_subtract(*a, three_sixty_deg_t);
+ } else {
+ number_add(*a, three_sixty_deg_t);
+ }
+ }
+ free_number(abs_a);
+}
+
+void mp_curl_ratio (MP mp, mp_number *ret, mp_number *gamma_orig, mp_number *a_tension, mp_number *b_tension)
+{
+ mp_number alpha, beta, gamma, num, denom, ff;
+ mp_number arg1;
+ new_number(arg1);
+ new_fraction(alpha);
+ new_fraction(beta);
+ new_fraction(gamma);
+ new_fraction(ff);
+ new_fraction(denom);
+ new_fraction(num);
+ make_fraction(alpha, unity_t, *a_tension);
+ make_fraction(beta, unity_t, *b_tension);
+ number_clone(gamma, *gamma_orig);
+ if (number_lessequal(alpha, beta)) {
+ make_fraction(ff, alpha, beta);
+ number_clone(arg1, ff);
+ take_fraction(ff, arg1, arg1);
+ number_clone(arg1, gamma);
+ take_fraction(gamma, arg1, ff);
+ convert_fraction_to_scaled(beta);
+ take_fraction(denom, gamma, alpha);
+ number_add(denom, three_t);
+ } else {
+ make_fraction(ff, beta, alpha);
+ number_clone(arg1, ff);
+ take_fraction(ff, arg1, arg1);
+ take_fraction(arg1, beta, ff);
+ convert_fraction_to_scaled(arg1);
+ number_clone(beta, arg1);
+ take_fraction(denom, gamma, alpha);
+ set_number_from_div(arg1, ff, twelvebits_3);
+ number_add(denom, arg1);
+ }
+ number_subtract(denom, beta);
+ set_number_from_subtraction(arg1, fraction_three_t, alpha);
+ take_fraction(num, gamma, arg1);
+ number_add(num, beta);
+ number_clone(arg1, denom);
+ number_double(arg1);
+ number_double(arg1);
+ if (number_greaterequal(num, arg1)) {
+ number_clone(*ret, fraction_four_t);
+ } else {
+ make_fraction(*ret, num, denom);
+ }
+ free_number(alpha);
+ free_number(beta);
+ free_number(gamma);
+ free_number(num);
+ free_number(denom);
+ free_number(ff);
+ free_number(arg1);
+}
+
+void mp_set_controls (MP mp, mp_knot p, mp_knot q, int k)
+{
+ mp_number rr, ss;
+ mp_number lt, rt;
+ mp_number sine;
+ mp_number tmp;
+ mp_number r1, r2;
+ new_number(tmp);
+ new_number(r1);
+ new_number(r2);
+ new_number_abs(lt, q->left_tension);
+ new_number_abs(rt, p->right_tension);
+ new_fraction(sine);
+ new_fraction(rr);
+ new_fraction(ss);
+ velocity(rr, mp->st, mp->ct, mp->sf, mp->cf, rt);
+ velocity(ss, mp->sf, mp->cf, mp->st, mp->ct, lt);
+ if (number_negative(p->right_tension) || number_negative(q->left_tension)) {
+ if ((number_nonnegative(mp->st) && number_nonnegative(mp->sf)) || (number_nonpositive(mp->st) && number_nonpositive(mp->sf))) {
+ mp_number r1, r2, arg1;
+ new_fraction(r1);
+ new_fraction(r2);
+ new_number_abs(arg1, mp->st);
+ take_fraction(r1, arg1, mp->cf);
+ number_abs_clone(arg1, mp->sf);
+ take_fraction(r2, arg1, mp->ct);
+ set_number_from_addition(sine, r1, r2);
+ if (number_positive(sine)) {
+ set_number_from_addition(arg1, fraction_one_t, unity_t);
+ number_clone(r1, sine);
+ take_fraction(sine, r1, arg1);
+ if (number_negative(p->right_tension)) {
+ number_abs_clone(arg1, mp->sf);
+ if (ab_vs_cd(arg1, fraction_one_t, rr, sine) < 0) {
+ number_abs_clone(arg1, mp->sf);
+ make_fraction(rr, arg1, sine);
+ }
+ }
+ if (number_negative(q->left_tension)) {
+ number_abs_clone(arg1, mp->st);
+ if (ab_vs_cd(arg1, fraction_one_t, ss, sine) < 0) {
+ number_abs_clone(arg1, mp->st);
+ make_fraction(ss, arg1, sine);
+ }
+ }
+ }
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+ }
+ }
+ take_fraction(r1, mp->delta_x [k], mp->ct);
+ take_fraction(r2, mp->delta_y [k], mp->st);
+ number_subtract(r1, r2);
+ take_fraction(tmp, r1, rr);
+ set_number_from_addition(p->right_x, p->x_coord, tmp);
+ take_fraction(r1, mp->delta_y[k], mp->ct);
+ take_fraction(r2, mp->delta_x[k], mp->st);
+ number_add(r1, r2);
+ take_fraction(tmp, r1, rr);
+ set_number_from_addition(p->right_y, p->y_coord, tmp);
+ take_fraction(r1, mp->delta_x[k], mp->cf);
+ take_fraction(r2, mp->delta_y[k], mp->sf);
+ number_add(r1, r2);
+ take_fraction(tmp, r1, ss);
+ set_number_from_subtraction(q->left_x, q->x_coord, tmp);
+ take_fraction(r1, mp->delta_y[k], mp->cf);
+ take_fraction(r2, mp->delta_x[k], mp->sf);
+ number_subtract(r1, r2);
+ take_fraction(tmp, r1, ss);
+ set_number_from_subtraction(q->left_y, q->y_coord, tmp);
+ mp_right_type(p) = mp_explicit_knot;
+ mp_left_type(q) = mp_explicit_knot;
+ free_number(tmp);
+ free_number(r1);
+ free_number(r2);
+ free_number(lt);
+ free_number(rt);
+ free_number(rr);
+ free_number(ss);
+ free_number(sine);
+}
+
+# define TOO_LARGE(a) (fabs((a))>4096.0)
+# define PI 3.1415926535897932384626433832795028841971
+
+static int out_of_range (MP mp, double a)
+{
+ (void) mp;
+ mp_number t;
+ new_number_from_double(mp, t, fabs(a));
+ if (number_greaterequal(t, inf_t)) {
+ free_number(t);
+ return 1;
+ } else {
+ free_number(t);
+ return 0;
+ }
+}
+
+static int mp_link_knotpair (MP mp, mp_knot p, mp_knot q)
+{
+ (void) mp;
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else {
+ mp_prev_knot(q) = p;
+ mp_next_knot(p) = q;
+ set_number_from_double(p->right_tension, 1.0);
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ mp_right_type(p) = mp_open_knot;
+ }
+ set_number_from_double(q->left_tension, 1.0);
+ if (mp_left_type(q) == mp_endpoint_knot) {
+ mp_left_type(q) = mp_open_knot;
+ }
+ return 1;
+ }
+}
+
+static int mp_link_knotpair_xy (MP mp, mp_knot p, mp_knot q)
+{
+ (void) mp;
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else {
+ mp_prev_knot(q) = p;
+ mp_next_knot(p) = q;
+ return 1;
+ }
+}
+
+int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q)
+{
+ return mp_link_knotpair(mp, p, q);
+}
+
+int mp_close_path (MP mp, mp_knot q, mp_knot first)
+{
+ if (q == NULL || first == NULL) {
+ return 0;
+ } else {
+ mp_prev_knot(first) = q;
+ mp_next_knot(q) = first;
+ mp_right_type(q) = mp_endpoint_knot;
+ set_number_from_double(q->right_tension, 1.0);
+ mp_left_type(first) = mp_endpoint_knot;
+ set_number_from_double(first->left_tension, 1.0);
+ return 1;
+ }
+}
+
+mp_knot mp_create_knot (MP mp)
+{
+ mp_knot q = mp_new_knot(mp);
+ mp_left_type(q) = mp_endpoint_knot;
+ mp_right_type(q) = mp_endpoint_knot;
+ return q;
+}
+
+int mp_set_knot (MP mp, mp_knot p, double x, double y)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x)) {
+ return 0;
+ } else if (out_of_range(mp, y)) {
+ return 0;
+ } else {
+ set_number_from_double(p->x_coord, x);
+ set_number_from_double(p->y_coord, y);
+ return 1;
+ }
+}
+
+mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y)
+{
+ mp_knot q = mp_create_knot(mp);
+ if (q == NULL) {
+ return NULL;
+ } else if (! mp_set_knot(mp, q, x, y)) {
+ mp_memory_free(q);
+ return NULL;
+ } else if (p == NULL) {
+ return q;
+ } else if (mp_link_knotpair(mp, p, q)) {
+ return q;
+ } else {
+ mp_memory_free(q);
+ return NULL;
+ }
+}
+
+mp_knot mp_append_knot_xy (MP mp, mp_knot p, double x, double y)
+{
+ mp_knot q = mp_create_knot(mp);
+ if (q == NULL) {
+ return NULL;
+ } else if (! mp_set_knot(mp, q, x, y)) {
+ mp_memory_free(q);
+ return NULL;
+ } else if (p == NULL) {
+ return q;
+ } else if (mp_link_knotpair_xy(mp, p, q)) {
+ mp_right_type(p) = mp_explicit_knot;
+ mp_left_type(p) = mp_explicit_knot;
+ return q;
+ } else {
+ mp_memory_free(q);
+ return NULL;
+ }
+}
+
+int mp_set_knot_curl (MP mp, mp_knot q, double value)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(value)) {
+ return 0;
+ } else {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, value);
+ if (mp_left_type(q) == mp_open_knot) {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knot_left_curl (MP mp, mp_knot q, double value)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(value)) {
+ return 0;
+ } else {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, value);
+ if (mp_right_type(q) == mp_open_knot) {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knot_right_curl (MP mp, mp_knot q, double value)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(value)) {
+ return 0;
+ } else {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, value);
+ if (mp_left_type(q) == mp_open_knot) {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knot_simple_curl (MP mp, mp_knot q)
+{
+ if (q == NULL) {
+ return 0;
+ } else {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, 1.0);
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, 1.0);
+ return 1;
+ }
+}
+
+int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (mp_set_knot_curl(mp, p, t1)) {
+ return mp_set_knot_curl(mp, q, t2);
+ } else {
+ return 0;
+ }
+}
+
+int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(t1)) {
+ return 0;
+ } else if (TOO_LARGE(t2)) {
+ return 0;
+ } else if ((fabs(t1) < 0.75)) {
+ return 0;
+ } else if ((fabs(t2) < 0.75)) {
+ return 0;
+ } else {
+ set_number_from_double(p->right_tension, t1);
+ set_number_from_double(q->left_tension, t2);
+ return 1;
+ }
+}
+
+int mp_set_knot_left_tension (MP mp, mp_knot p, double t1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (TOO_LARGE(t1)) {
+ return 0;
+ } else if ((fabs(t1) < 0.75)) {
+ return 0;
+ } else {
+ set_number_from_double(p->left_tension, t1);
+ return 1;
+ }
+}
+
+int mp_set_knot_right_tension (MP mp, mp_knot p, double t1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (TOO_LARGE(t1)) {
+ return 0;
+ } else if ((fabs(t1) < 0.75)) {
+ return 0;
+ } else {
+ set_number_from_double(p->right_tension, t1);
+ return 1;
+ }
+}
+
+int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x1)) {
+ return 0;
+ } else if (out_of_range(mp, y1)) {
+ return 0;
+ } else if (out_of_range(mp, x2)) {
+ return 0;
+ } else if (out_of_range(mp, y2)) {
+ return 0;
+ } else {
+ mp_right_type(p) = mp_explicit_knot;
+ set_number_from_double(p->right_x, x1);
+ set_number_from_double(p->right_y, y1);
+ mp_left_type(q) = mp_explicit_knot;
+ set_number_from_double(q->left_x, x2);
+ set_number_from_double(q->left_y, y2);
+ return 1;
+ }
+}
+
+int mp_set_knot_left_control (MP mp, mp_knot p, double x1, double y1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x1)) {
+ return 0;
+ } else if (out_of_range(mp, y1)) {
+ return 0;
+ } else {
+ mp_left_type(p) = mp_explicit_knot;
+ set_number_from_double(p->left_x, x1);
+ set_number_from_double(p->left_y, y1);
+ return 1;
+ }
+}
+
+int mp_set_knot_right_control (MP mp, mp_knot p, double x1, double y1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x1)) {
+ return 0;
+ } else if (out_of_range(mp, y1)) {
+ return 0;
+ } else {
+ mp_right_type(p) = mp_explicit_knot;
+ set_number_from_double(p->right_x, x1);
+ set_number_from_double(p->right_y, y1);
+ return 1;
+ }
+}
+
+int mp_set_knot_direction (MP mp, mp_knot q, double x, double y)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(x)) {
+ return 0;
+ } else if (TOO_LARGE(y)) {
+ return 0;
+ } else {
+ double value = 0;
+ if (!(x == 0 && y == 0)) {
+ value = atan2(y, x) * (180.0 / PI) * 16.0;
+ }
+ mp_right_type(q) = mp_given_knot;
+ set_number_from_double(q->right_curl, value);
+ if (mp_left_type(q) == mp_open_knot) {
+ mp_left_type(q) = mp_given_knot;
+ set_number_from_double(q->left_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (mp_set_knot_direction(mp,p, x1, y1)) {
+ return mp_set_knot_direction(mp,q, x2, y2);
+ } else {
+ return 0;
+ }
+}
+
+static int path_needs_fixing(mp_knot source)
+{
+ mp_knot sourcehead = source;
+ do {
+ source = source->next;
+ } while (source && source != sourcehead);
+ if (! source) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+int mp_solve_path (MP mp, mp_knot first)
+{
+ if (first == NULL) {
+ return 0;
+ } else if (path_needs_fixing(first)) {
+ return 0;
+ } else {
+ int saved_arith_error = mp->arith_error;
+ int retval = 1;
+ jmp_buf *saved_jump_buf = mp->jump_buf;
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) {
+ return 0;
+ } else {
+ mp->arith_error = 0;
+ mp_make_choices(mp, first);
+ if (mp->arith_error) {
+ retval = 0;
+ }
+ mp->arith_error = saved_arith_error;
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = saved_jump_buf;
+ return retval;
+ }
+ }
+}
+
+void mp_free_path (MP mp, mp_knot p)
+{
+ mp_toss_knot_list(mp, p);
+}
+
+double mp_number_as_double (MP mp, mp_number n) {
+ (void) mp;
+ return number_to_double(n);
+}
+
+static void mp_eval_cubic (MP mp, mp_number *r, mp_knot p, mp_knot q, int c, mp_number *t)
+{
+ mp_number x1, x2, x3;
+ new_number(x1);
+ new_number(x2);
+ new_number(x3);
+ if (c == mp_x_code) {
+ set_number_from_of_the_way(x1, *t, p->x_coord, p->right_x);
+ set_number_from_of_the_way(x2, *t, p->right_x, q->left_x);
+ set_number_from_of_the_way(x3, *t, q->left_x, q->x_coord);
+ } else {
+ set_number_from_of_the_way(x1, *t, p->y_coord, p->right_y);
+ set_number_from_of_the_way(x2, *t, p->right_y, q->left_y);
+ set_number_from_of_the_way(x3, *t, q->left_y, q->y_coord);
+ }
+ set_number_from_of_the_way(x1, *t, x1, x2);
+ set_number_from_of_the_way(x2, *t, x2, x3);
+ set_number_from_of_the_way(*r, *t, x1, x2);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+}
+
+static void mp_bound_cubic (MP mp, mp_knot p, mp_knot q, int c)
+{
+ int wavy;
+ mp_number del1, del2, del3, del, dmax;
+ mp_number t, tt;
+ mp_number x;
+ new_fraction(t);
+ new_fraction(tt);
+ if (c == mp_x_code) {
+ new_number_clone(x, q->x_coord);
+ } else {
+ new_number_clone(x, q->y_coord);
+ }
+ new_number(del1);
+ new_number(del2);
+ new_number(del3);
+ new_number(del);
+ new_number(dmax);
+ if (number_less(x, mp->bbmin[c])) {
+ number_clone(mp->bbmin[c], x);
+ }
+ if (number_greater(x, mp->bbmax[c])) {
+ number_clone(mp->bbmax[c], x);
+ }
+ wavy = 1;
+ if (c == mp_x_code) {
+ if (number_lessequal(mp->bbmin[c], p->right_x) && number_lessequal(p->right_x, mp->bbmax[c])) {
+ if (number_lessequal(mp->bbmin[c], q->left_x) && number_lessequal(q->left_x, mp->bbmax[c])) {
+ wavy = 0;
+ }
+ }
+ } else {
+ if (number_lessequal(mp->bbmin[c], p->right_y) && number_lessequal(p->right_y, mp->bbmax[c])) {
+ if (number_lessequal(mp->bbmin[c], q->left_y) && number_lessequal(q->left_y, mp->bbmax[c])) {
+ wavy = 0;
+ }
+ }
+ }
+ if (wavy) {
+ if (c == mp_x_code) {
+ set_number_from_subtraction(del1, p->right_x, p->x_coord);
+ set_number_from_subtraction(del2, q->left_x, p->right_x);
+ set_number_from_subtraction(del3, q->x_coord, q->left_x);
+ } else {
+ set_number_from_subtraction(del1, p->right_y, p->y_coord);
+ set_number_from_subtraction(del2, q->left_y, p->right_y);
+ set_number_from_subtraction(del3, q->y_coord, q->left_y);
+ }
+ if (number_nonzero(del1)) {
+ number_clone(del, del1);
+ } else if (number_nonzero(del2)) {
+ number_clone(del, del2);
+ } else {
+ number_clone(del, del3);
+ }
+ if (number_nonzero(del)) {
+ mp_number absval1;
+ new_number(absval1);
+ number_abs_clone(dmax, del1);
+ number_abs_clone(absval1, del2);
+ if (number_greater(absval1, dmax)) {
+ number_clone(dmax, absval1);
+ }
+ number_abs_clone(absval1, del3);
+ if (number_greater(absval1, dmax)) {
+ number_clone(dmax, absval1);
+ }
+ while (number_less(dmax, fraction_half_t)) {
+ number_double(dmax);
+ number_double(del1);
+ number_double(del2);
+ number_double(del3);
+ }
+ free_number(absval1);
+ }
+ if (number_negative(del)) {
+ number_negate(del1);
+ number_negate(del2);
+ number_negate(del3);
+ }
+ crossing_point(t, del1, del2, del3);
+ if (number_less(t, fraction_one_t)) {
+ {
+ mp_eval_cubic(mp, &x, p, q, c, &t);
+ if (number_less(x, mp->bbmin[c])) {
+ number_clone(mp->bbmin[c], x);
+ }
+ if (number_greater(x, mp->bbmax[c])) {
+ number_clone(mp->bbmax[c], x);
+ }
+ set_number_from_of_the_way(del2, t, del2, del3);
+ if (number_positive(del2)) {
+ set_number_to_zero(del2);
+ }
+ {
+ mp_number arg2, arg3;
+ new_number(arg2);
+ new_number(arg3);
+ number_negated_clone(arg2, del2);
+ number_negated_clone(arg3, del3);
+ crossing_point(tt, zero_t, arg2, arg3);
+ free_number(arg2);
+ free_number(arg3);
+ }
+ if (number_less(tt, fraction_one_t)) {
+ mp_number arg;
+ new_number(arg);
+ set_number_from_of_the_way(arg, t, tt, fraction_one_t);
+ mp_eval_cubic(mp, &x, p, q, c, &arg);
+ free_number(arg);
+ if (number_less(x, mp->bbmin[c])) {
+ number_clone(mp->bbmin[c], x);
+ }
+ if (number_greater(x, mp->bbmax[c])) {
+ number_clone(mp->bbmax[c], x);
+ }
+ }
+ }
+ }
+ }
+ free_number(del3);
+ free_number(del2);
+ free_number(del1);
+ free_number(del);
+ free_number(dmax);
+ free_number(x);
+ free_number(t);
+ free_number(tt);
+}
+
+static void mp_path_bbox (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ number_clone(mp_minx, h->x_coord);
+ number_clone(mp_miny, h->y_coord);
+ number_clone(mp_maxx, mp_minx);
+ number_clone(mp_maxy, mp_miny);
+ do {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ return;
+ } else {
+ mp_knot q = mp_next_knot(p);
+ mp_bound_cubic(mp, p, q, mp_x_code);
+ mp_bound_cubic(mp, p, q, mp_y_code);
+ p = q;
+ }
+ } while (p != h);
+}
+
+static void mp_path_xbox (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ number_clone(mp_minx, h->x_coord);
+ number_clone(mp_maxx, mp_minx);
+ set_number_to_zero(mp_miny);
+ set_number_to_zero(mp_maxy);
+ do {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ return;
+ } else {
+ mp_knot q = mp_next_knot(p);
+ mp_bound_cubic(mp, p, q, mp_x_code);
+ p = q;
+ }
+ } while (p != h);
+}
+
+static void mp_path_ybox (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ set_number_to_zero(mp_minx);
+ set_number_to_zero(mp_maxx);
+ number_clone(mp_miny, h->y_coord);
+ number_clone(mp_maxy, mp_miny);
+ do {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ return;
+ } else {
+ mp_knot q = mp_next_knot(p);
+ mp_bound_cubic(mp, p, q, mp_y_code);
+ p = q;
+ }
+ } while (p != h);
+}
+
+static void mp_arc_test (MP mp,
+ mp_number *ret, mp_number *dx0, mp_number *dy0, mp_number *dx1,
+ mp_number *dy1, mp_number *dx2, mp_number *dy2, mp_number *v0,
+ mp_number *v02, mp_number *v2, mp_number *a_goal, mp_number *tol_orig
+)
+{
+ int simple;
+ mp_number dx01, dy01, dx12, dy12, dx02, dy02;
+ mp_number v002, v022;
+ mp_number arc;
+ mp_number arc1;
+ mp_number simply;
+ mp_number tol;
+ new_number(arc );
+ new_number(arc1);
+ new_number(dx01);
+ new_number(dy01);
+ new_number(dx12);
+ new_number(dy12);
+ new_number(dx02);
+ new_number(dy02);
+ new_number(v002);
+ new_number(v022);
+ new_number(simply);
+ new_number_clone(tol, *tol_orig);
+ set_number_half_from_addition(dx01, *dx0, *dx1);
+ set_number_half_from_addition(dx12, *dx1, *dx2);
+ set_number_half_from_addition(dx02, dx01, dx12);
+ set_number_half_from_addition(dy01, *dy0, *dy1);
+ set_number_half_from_addition(dy12, *dy1, *dy2);
+ set_number_half_from_addition(dy02, dy01, dy12);
+
+ {
+ mp_number tmp, arg1, arg2 ;
+ new_number(tmp);
+ new_number(arg1);
+ new_number(arg2);
+ set_number_half_from_addition(arg1, *dx0, dx02);
+ number_add(arg1, dx01);
+ set_number_half_from_addition(arg2, *dy0, dy02);
+ number_add(arg2, dy01);
+ pyth_add(v002, arg1, arg2);
+ set_number_half_from_addition(arg1, dx02, *dx2);
+ number_add(arg1, dx12);
+ set_number_half_from_addition(arg2, dy02, *dy2);
+ number_add(arg2, dy12);
+ pyth_add(v022, arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ number_clone(tmp, *v02);
+ number_add_scaled(tmp, 2);
+ number_half(tmp);
+ set_number_half_from_addition(arc1, *v0, tmp);
+ number_subtract(arc1, v002);
+ number_half(arc1);
+ set_number_from_addition(arc1, v002, arc1);
+ set_number_half_from_addition(arc, *v2, tmp);
+ number_subtract(arc, v022);
+ number_half(arc);
+ set_number_from_addition(arc, v022, arc);
+ set_number_to_inf(tmp);
+ number_subtract(tmp,arc1);
+ if (number_less(arc, tmp)) {
+ free_number(tmp);
+ number_add(arc, arc1);
+ } else {
+ free_number(tmp);
+ mp->arith_error = 1;
+ if (number_infinite(*a_goal)) {
+ set_number_to_inf(*ret);
+ } else {
+ set_number_to_unity(*ret);
+ number_double(*ret);
+ number_negate(*ret);
+ }
+ goto DONE;
+ }
+ }
+ simple = (number_nonnegative(*dx0) && number_nonnegative(*dx1) && number_nonnegative(*dx2))
+ || (number_nonpositive(*dx0) && number_nonpositive(*dx1) && number_nonpositive(*dx2));
+ if (simple) {
+ simple = (number_nonnegative(*dy0) && number_nonnegative(*dy1) && number_nonnegative(*dy2))
+ || (number_nonpositive(*dy0) && number_nonpositive(*dy1) && number_nonpositive(*dy2));
+ }
+ if (!simple) {
+ simple = (number_greaterequal(*dx0, *dy0) && number_greaterequal(*dx1, *dy1) && number_greaterequal(*dx2, *dy2))
+ || (number_lessequal (*dx0, *dy0) && number_lessequal (*dx1, *dy1) && number_lessequal (*dx2, *dy2));
+ if (simple) {
+ mp_number neg_dx0, neg_dx1, neg_dx2;
+ new_number(neg_dx0);
+ new_number(neg_dx1);
+ new_number(neg_dx2);
+ number_negated_clone(neg_dx0, *dx0);
+ number_negated_clone(neg_dx1, *dx1);
+ number_negated_clone(neg_dx2, *dx2);
+ simple = (number_greaterequal(neg_dx0, *dy0) && number_greaterequal(neg_dx1, *dy1) && number_greaterequal(neg_dx2, *dy2))
+ || (number_lessequal (neg_dx0, *dy0) && number_lessequal (neg_dx1, *dy1) && number_lessequal (neg_dx2, *dy2));
+ free_number(neg_dx0);
+ free_number(neg_dx1);
+ free_number(neg_dx2);
+ }
+ }
+ set_number_half_from_addition(simply, *v0, *v2);
+ number_negate(simply);
+ number_add(simply, arc);
+ number_subtract(simply, *v02);
+ number_abs(simply);
+ if (simple && number_lessequal(simply, tol)) {
+ if (number_less(arc, *a_goal)){
+ number_clone(*ret, arc);
+ } else {
+ mp_number tmp;
+ mp_number tmp2;
+ mp_number tmp3;
+ mp_number tmp4;
+ mp_number tmp5;
+ new_number_clone(tmp, *v02);
+ new_number(tmp2);
+ new_number(tmp3);
+ new_number(tmp4);
+ new_number(tmp5);
+ number_add_scaled(tmp, 2);
+ number_half(tmp);
+ number_half(tmp);
+ if (number_lessequal(*a_goal, arc1)) {
+ number_clone(tmp2, *v0);
+ number_half(tmp2);
+ set_number_from_subtraction(tmp3, arc1, tmp2);
+ number_subtract(tmp3, tmp);
+ mp_solve_rising_cubic(mp, &tmp5, &tmp2, &tmp3, &tmp, a_goal);
+ number_half(tmp5);
+ set_number_to_unity(tmp3);
+ number_subtract(tmp5, tmp3);
+ number_subtract(tmp5, tmp3);
+ number_clone(*ret, tmp5);
+ } else {
+ number_clone(tmp2, *v2);
+ number_half(tmp2);
+ set_number_from_subtraction(tmp3, arc, arc1);
+ number_subtract(tmp3, tmp);
+ number_subtract(tmp3, tmp2);
+ set_number_from_subtraction(tmp4, *a_goal, arc1);
+ mp_solve_rising_cubic(mp, &tmp5, &tmp, &tmp3, &tmp2, &tmp4);
+ number_half(tmp5);
+ set_number_to_unity(tmp2);
+ set_number_to_unity(tmp3);
+ number_half(tmp2);
+ number_subtract(tmp2, tmp3);
+ number_subtract(tmp2, tmp3);
+ set_number_from_addition(*ret, tmp2, tmp5);
+ }
+ free_number(tmp);
+ free_number(tmp2);
+ free_number(tmp3);
+ free_number(tmp4);
+ free_number(tmp5);
+ }
+ } else {
+ mp_number a_new, a_aux;
+ mp_number a, b;
+ mp_number half_v02;
+ new_number(a_new);
+ new_number(a_aux);
+ new_number(half_v02);
+ set_number_to_inf(a_aux);
+ number_subtract(a_aux, *a_goal);
+ if (number_greater(*a_goal, a_aux)) {
+ set_number_from_subtraction(a_aux, *a_goal, a_aux);
+ set_number_to_inf(a_new);
+ } else {
+ set_number_from_addition(a_new, *a_goal, *a_goal);
+ set_number_to_zero(a_aux);
+ }
+ {
+ mp_number half_tol;
+ new_number_clone(half_tol, tol);
+ number_half(half_tol);
+ number_add(tol, half_tol);
+ free_number(half_tol);
+ }
+ number_clone(half_v02, *v02);
+ number_half(half_v02);
+ new_number(a);
+ mp_arc_test(mp, &a, dx0, dy0, &dx01, &dy01, &dx02, &dy02, v0, &v002, &half_v02, &a_new, &tol);
+ if (number_negative(a)) {
+ set_number_to_unity(*ret);
+ number_double(*ret);
+ number_subtract(*ret, a);
+ number_half(*ret);
+ number_negate(*ret);
+ } else {
+ if (number_greater(a, a_aux)) {
+ number_subtract(a_aux, a);
+ number_add(a_new, a_aux);
+ }
+ new_number(b);
+ mp_arc_test(mp, &b, &dx02, &dy02, &dx12, &dy12, dx2, dy2, &half_v02, &v022, v2, &a_new, &tol);
+ if (number_negative(b)) {
+ mp_number tmp ;
+ new_number(tmp);
+ number_negated_clone(tmp, b);
+ number_half(tmp);
+ number_negate(tmp);
+ number_clone(*ret, tmp);
+ set_number_to_unity(tmp);
+ number_half(tmp);
+ number_subtract(*ret, tmp);
+ free_number(tmp);
+ } else {
+ set_number_from_subtraction(*ret, b, a);
+ number_half(*ret);
+ set_number_from_addition(*ret, a, *ret);
+ }
+ free_number(b);
+ }
+ free_number(half_v02);
+ free_number(a_aux);
+ free_number(a_new);
+ free_number(a);
+ }
+ DONE:
+ free_number(arc);
+ free_number(arc1);
+ free_number(dx01);
+ free_number(dy01);
+ free_number(dx12);
+ free_number(dy12);
+ free_number(dx02);
+ free_number(dy02);
+ free_number(v002);
+ free_number(v022);
+ free_number(simply);
+ free_number(tol);
+}
+
+void mp_solve_rising_cubic (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *x_orig)
+{
+ mp_number abc;
+ mp_number a, b, c, x;
+ mp_number ab, bc, ac;
+ mp_number t;
+ mp_number xx;
+ mp_number neg_x;
+ if (number_negative(*a_orig) || number_negative(*c_orig)) {
+ mp_confusion(mp, "rising cubic");
+ }
+ new_number(t);
+ new_number(abc);
+ new_number_clone(a, *a_orig);
+ new_number_clone(b, *b_orig);
+ new_number_clone(c, *c_orig);
+ new_number_clone(x, *x_orig);
+ new_number(ab);
+ new_number(bc);
+ new_number(ac);
+ new_number(xx);
+ new_number(neg_x);
+ set_number_from_addition(abc, a, b);
+ number_add(abc, c);
+ if (number_nonpositive(x)) {
+ set_number_to_zero(*ret);
+ } else if (number_greaterequal(x, abc)) {
+ set_number_to_unity(*ret);
+ } else {
+ number_clone(t, epsilon_t);
+ while (number_greater(a, one_third_inf_t) || number_greater(b, one_third_inf_t) || number_greater(c, one_third_inf_t)) {
+ number_half(a);
+ number_half(b);
+ number_half(c);
+ number_half(x);
+ }
+ do {
+ number_add(t, t);
+ set_number_half_from_addition(ab, a, b);
+ set_number_half_from_addition(bc, b, c);
+ set_number_half_from_addition(ac, ab, bc);
+
+ number_clone(xx,x);
+ number_subtract(xx, a);
+ number_subtract(xx, ab);
+ number_subtract(xx, ac);
+ number_negated_clone(neg_x, x);
+ if (number_less(xx, neg_x)) {
+ number_double(x);
+ number_clone(b, ab);
+ number_clone(c, ac);
+ } else {
+ number_add(x, xx);
+ number_clone(a, ac);
+ number_clone(b, bc);
+ number_add(t, epsilon_t);
+ }
+ } while (number_less(t, unity_t));
+ set_number_from_subtraction(*ret, t, unity_t);
+ }
+ free_number(abc);
+ free_number(t);
+ free_number(a);
+ free_number(b);
+ free_number(c);
+ free_number(ab);
+ free_number(bc);
+ free_number(ac);
+ free_number(xx);
+ free_number(x);
+ free_number(neg_x);
+}
+
+static void mp_do_arc_test (MP mp,
+ mp_number *ret, mp_number *dx0, mp_number *dy0, mp_number *dx1,
+ mp_number *dy1, mp_number *dx2, mp_number *dy2, mp_number *a_goal
+)
+{
+ mp_number v0, v1, v2;
+ mp_number v02;
+ new_number(v0);
+ new_number(v1);
+ new_number(v2);
+ pyth_add(v0, *dx0, *dy0);
+ pyth_add(v1, *dx1, *dy1);
+ pyth_add(v2, *dx2, *dy2);
+ if ((number_greaterequal(v0, fraction_four_t)) || (number_greaterequal(v1, fraction_four_t)) || (number_greaterequal(v2, fraction_four_t))) {
+ mp->arith_error = 1;
+ if (number_infinite(*a_goal)) {
+ set_number_to_inf(*ret);
+ } else {
+ set_number_to_unity(*ret);
+ number_double(*ret);
+ number_negate(*ret);
+ }
+ } else {
+ mp_number arg1, arg2;
+ new_number(v02);
+ new_number(arg1);
+ new_number(arg2);
+ set_number_half_from_addition(arg1, *dx0, *dx2);
+ number_add(arg1, *dx1);
+ set_number_half_from_addition(arg2, *dy0, *dy2);
+ number_add(arg2, *dy1);
+ pyth_add(v02, arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ mp_arc_test(mp, ret, dx0, dy0, dx1, dy1, dx2, dy2, &v0, &v02, &v2, a_goal, &arc_tol_k);
+ free_number(v02);
+ }
+ free_number(v0);
+ free_number(v1);
+ free_number(v2);
+}
+
+static void mp_get_arc_length (MP mp, mp_number *ret, mp_knot h)
+{
+ mp_number a;
+ mp_number a_tot;
+ mp_number arg1, arg2, arg3, arg4, arg5, arg6;
+ mp_number arcgoal;
+ mp_knot p = h;
+ new_number(a_tot);
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ new_number(arg4);
+ new_number(arg5);
+ new_number(arg6);
+ new_number(a);
+ new_number(arcgoal);
+ set_number_to_inf(arcgoal);
+ while (mp_right_type(p) != mp_endpoint_knot) {
+ mp_knot q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->right_x, p->x_coord);
+ set_number_from_subtraction(arg2, p->right_y, p->y_coord);
+ set_number_from_subtraction(arg3, q->left_x, p->right_x);
+ set_number_from_subtraction(arg4, q->left_y, p->right_y);
+ set_number_from_subtraction(arg5, q->x_coord, q->left_x);
+ set_number_from_subtraction(arg6, q->y_coord, q->left_y);
+ mp_do_arc_test(mp, &a, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arcgoal);
+ slow_add(a_tot, a, a_tot);
+
+ if (q == h) {
+ break;
+ } else {
+ p = q;
+ }
+ }
+ free_number(arcgoal);
+ free_number(a);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ free_number(arg4);
+ free_number(arg5);
+ free_number(arg6);
+ check_arith();
+ number_clone(*ret, a_tot);
+ free_number(a_tot);
+}
+
+static void mp_get_subarc_length (MP mp, mp_number *ret, mp_knot h, mp_number *first, mp_number *last)
+{
+ mp_number a;
+ mp_number a_tot, a_cnt;
+ mp_number arg1, arg2, arg3, arg4, arg5, arg6;
+ mp_number arcgoal;
+ mp_knot p = h;
+ new_number(a_tot);
+ new_number(a_cnt);
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ new_number(arg4);
+ new_number(arg5);
+ new_number(arg6);
+ new_number(a);
+ new_number(arcgoal);
+ set_number_to_inf(arcgoal);
+ while (mp_right_type(p) != mp_endpoint_knot) {
+ mp_knot q = mp_next_knot(p);
+ if (number_greaterequal(a_cnt, *last)) {
+ break;
+ } else if (number_greaterequal(a_cnt, *first)) {
+ set_number_from_subtraction(arg1, p->right_x, p->x_coord);
+ set_number_from_subtraction(arg2, p->right_y, p->y_coord);
+ set_number_from_subtraction(arg3, q->left_x, p->right_x);
+ set_number_from_subtraction(arg4, q->left_y, p->right_y);
+ set_number_from_subtraction(arg5, q->x_coord, q->left_x);
+ set_number_from_subtraction(arg6, q->y_coord, q->left_y);
+ mp_do_arc_test(mp, &a, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arcgoal);
+ slow_add(a_tot, a, a_tot);
+ }
+ if (q == h) {
+ break;
+ } else {
+ p = q;
+ number_add(a_cnt, unity_t);
+ }
+ }
+ free_number(arcgoal);
+ free_number(a);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ free_number(arg4);
+ free_number(arg5);
+ free_number(arg6);
+ check_arith();
+ number_clone(*ret, a_tot);
+ free_number(a_cnt);
+ free_number(a_tot);
+}
+
+static mp_knot mp_get_arc_time(MP mp, mp_number *ret, mp_knot h, mp_number *arc0_orig, int local)
+{
+ if (number_negative(*arc0_orig)) {
+ if (mp_left_type(h) == mp_endpoint_knot) {
+ set_number_to_zero(*ret);
+ } else {
+ mp_number neg_arc0;
+ mp_knot p = mp_htap_ypoc(mp, h);
+ new_number(neg_arc0);
+ number_negated_clone(neg_arc0, *arc0_orig);
+ mp_get_arc_time(mp, ret, p, &neg_arc0, 0);
+ number_negate(*ret);
+ mp_toss_knot_list(mp, p);
+ free_number(neg_arc0);
+ }
+ check_arith();
+ } else {
+ mp_knot p, q, k;
+ mp_number t_tot;
+ mp_number t;
+ mp_number arc, arc0;
+ mp_number arg1, arg2, arg3, arg4, arg5, arg6;
+ new_number(t_tot);
+ new_number_clone(arc0, *arc0_orig);
+ if (number_infinite(arc0)) {
+ number_add_scaled(arc0, -1);
+ }
+ new_number_clone(arc, arc0);
+ p = h;
+ k = h;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ new_number(arg4);
+ new_number(arg5);
+ new_number(arg6);
+ new_number(t);
+ while ((mp_right_type(p) != mp_endpoint_knot) && number_positive(arc)) {
+ k = p;
+ q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->right_x, p->x_coord);
+ set_number_from_subtraction(arg2, p->right_y, p->y_coord);
+ set_number_from_subtraction(arg3, q->left_x, p->right_x);
+ set_number_from_subtraction(arg4, q->left_y, p->right_y);
+ set_number_from_subtraction(arg5, q->x_coord, q->left_x);
+ set_number_from_subtraction(arg6, q->y_coord, q->left_y);
+ mp_do_arc_test(mp, &t, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arc);
+ if (number_negative(t)) {
+ number_add(t_tot, t);
+ number_add(t_tot, two_t);
+ set_number_to_zero(arc);
+ } else {
+ number_add(t_tot, unity_t);
+ number_subtract(arc, t);
+ }
+ if (q == h) {
+ if (number_positive(arc)) {
+ mp_number n, n1, d1, v1;
+ new_number(n);
+ new_number(n1);
+ new_number(d1);
+ new_number(v1);
+ set_number_from_subtraction(d1, arc0, arc);
+ set_number_from_div(n1, arc, d1);
+ number_clone(n, n1);
+ set_number_from_mul(n1, n1, d1);
+ number_subtract(arc, n1);
+ number_clone(d1, inf_t);
+ number_clone(v1, n);
+ number_add(v1, epsilon_t);
+ set_number_from_div(d1, d1, v1);
+ if (number_greater(t_tot, d1)) {
+ mp->arith_error = 1;
+ check_arith();
+ set_number_to_inf(*ret);
+ free_number(n);
+ free_number(n1);
+ free_number(d1);
+ free_number(v1);
+ goto RETURN;
+ }
+ set_number_from_mul(t_tot, t_tot, v1);
+ free_number(n);
+ free_number(n1);
+ free_number(d1);
+ free_number(v1);
+ }
+ }
+ p = q;
+ }
+ check_arith();
+ if (local) {
+ number_add(t, two_t);
+ number_clone(*ret, t);
+ } else {
+ number_clone(*ret, t_tot);
+ }
+ h = k;
+ RETURN:
+ free_number(t_tot);
+ free_number(t);
+ free_number(arc);
+ free_number(arc0);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ free_number(arg4);
+ free_number(arg5);
+ free_number(arg6);
+ }
+ return h;
+}
+
+static mp_knot mp_make_pen (MP mp, mp_knot h, int need_hull)
+{
+ mp_knot q = h;
+ do {
+ mp_knot p = q;
+ q = mp_next_knot(q);
+ mp_prev_knot(q) = p;
+ } while (q != h);
+ if (need_hull) {
+ h = mp_convex_hull(mp, h);
+ if (mp_pen_is_elliptical(h)) {
+ number_clone(h->left_x, h->x_coord);
+ number_clone(h->left_y, h->y_coord);
+ number_clone(h->right_x, h->x_coord);
+ number_clone(h->right_y, h->y_coord);
+ }
+ }
+ return h;
+}
+
+static mp_knot mp_get_pen_circle (MP mp, mp_number *diam)
+{
+ mp_knot h = mp_new_knot(mp);
+ mp_next_knot(h) = h;
+ mp_prev_knot(h) = h;
+ mp_originator(h) = mp_program_code;
+ mp_knotstate(h) = mp_regular_knot;
+ set_number_to_zero(h->x_coord);
+ set_number_to_zero(h->y_coord);
+ number_clone(h->left_x, *diam);
+ set_number_to_zero(h->left_y);
+ set_number_to_zero(h->right_x);
+ number_clone(h->right_y, *diam);
+ return h;
+}
+
+void mp_pr_pen (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ {
+ mp_number v1;
+ new_number(v1);
+ mp_print_str(mp, "pencircle transformed (");
+ print_number(h->x_coord);
+ mp_print_chr(mp, ',');
+ print_number(h->y_coord);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->left_x, h->x_coord);
+ print_number(v1);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->right_x, h->x_coord);
+ print_number(v1);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->left_y, h->y_coord);
+ print_number(v1);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->right_y, h->y_coord);
+ print_number(v1);
+ mp_print_chr(mp, ')');
+ free_number(v1);
+ }
+ } else {
+ mp_knot p = h;
+ do {
+ mp_knot q = mp_next_knot(p);
+ mp_print_two(mp, &(p->x_coord), &(p->y_coord));
+ mp_print_nl(mp, " .. ");
+ if ((q == NULL) || (mp_prev_knot(q) != p)) {
+ mp_print_nl(mp, "???");
+ return;
+ }
+ p = q;
+ } while (p != h);
+ mp_print_str(mp, "cycle");
+ }
+}
+
+void mp_print_pen (MP mp, mp_knot h, const char *s, int nuline) {
+ mp_print_diagnostic(mp, "Pen", s, nuline);
+ mp_print_ln(mp);
+ mp_pr_pen(mp, h);
+ mp_end_diagnostic(mp, 1);
+}
+
+static void mp_make_path (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ mp_knot p;
+ mp_number center_x, center_y;
+ mp_number width_x, width_y;
+ mp_number height_x, height_y;
+ mp_number dx, dy;
+ new_number(width_x);
+ new_number(width_y);
+ new_number(height_x);
+ new_number(height_y);
+ new_number(dx);
+ new_number(dy);
+ new_number_clone(center_x, h->x_coord);
+ new_number_clone(center_y, h->y_coord);
+ set_number_from_subtraction(width_x, h->left_x, center_x);
+ set_number_from_subtraction(width_y, h->left_y, center_y);
+ set_number_from_subtraction(height_x, h->right_x, center_x);
+ set_number_from_subtraction(height_y, h->right_y, center_y);
+ p = h;
+ for (int k = 0; k <= 7; k++) {
+
+ int kk = (k + 6) % 8;
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, mp->half_cos[k], width_x);
+ take_fraction(r2, mp->half_cos[kk], height_x);
+ number_add(r1, r2);
+ set_number_from_addition(p->x_coord, center_x, r1);
+ take_fraction(r1, mp->half_cos[k], width_y);
+ take_fraction(r2, mp->half_cos[kk], height_y);
+ number_add(r1, r2);
+ set_number_from_addition(p->y_coord, center_y, r1);
+ take_fraction(r1, mp->d_cos[kk], width_x);
+ take_fraction(r2, mp->d_cos[k], height_x);
+ number_negated_clone(dx, r1);
+ number_add(dx, r2);
+ take_fraction(r1, mp->d_cos[kk], width_y);
+ take_fraction(r2, mp->d_cos[k], height_y);
+ number_negated_clone(dy, r1);
+ number_add(dy, r2);
+ set_number_from_addition(p->right_x, p->x_coord, dx);
+ set_number_from_addition(p->right_y, p->y_coord, dy);
+ set_number_from_subtraction(p->left_x, p->x_coord, dx);
+ set_number_from_subtraction(p->left_y, p->y_coord, dy);
+ free_number(r1);
+ free_number(r2);
+ mp_left_type(p) = mp_explicit_knot;
+ mp_right_type(p) = mp_explicit_knot;
+ mp_originator(p) = mp_program_code;
+ mp_knotstate(p) = mp_regular_knot;
+
+ if (k == 7) {
+ mp_prev_knot(h) = p;
+ mp_next_knot(p) = h;
+ } else {
+ mp_knot k = mp_new_knot(mp);
+ mp_prev_knot(k) = p;
+ mp_next_knot(p) = k;
+ }
+ p = mp_next_knot(p);
+ }
+ free_number(dx);
+ free_number(dy);
+ free_number(center_x);
+ free_number(center_y);
+ free_number(width_x);
+ free_number(width_y);
+ free_number(height_x);
+ free_number(height_y);
+ } else {
+ mp_knot p = h;
+ do {
+ mp_left_type(p) = mp_explicit_knot;
+ mp_right_type(p) = mp_explicit_knot;
+ number_clone(p->left_x, p->x_coord);
+ number_clone(p->left_y, p->y_coord);
+ number_clone(p->right_x, p->x_coord);
+ number_clone(p->right_y, p->y_coord);
+ p = mp_next_knot(p);
+ } while (p != h);
+ }
+}
+
+mp_knot mp_convex_hull (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ return h;
+ } else {
+ mp_knot l, r;
+ mp_knot p, q;
+ mp_knot s;
+ mp_number dx, dy;
+ new_number(dx);
+ new_number(dy);
+ l = h;
+ p = mp_next_knot(h);
+ while (p != h) {
+ if (number_lessequal(p->x_coord, l->x_coord) && (number_less(p->x_coord, l->x_coord) || number_less(p->y_coord, l->y_coord))) {
+ l = p;
+ }
+ p = mp_next_knot(p);
+ }
+ r = h;
+ p = mp_next_knot(h);
+ while (p != h) {
+ if (number_greaterequal(p->x_coord, r->x_coord) && (number_greater(p->x_coord, r->x_coord) || number_greater(p->y_coord, r->y_coord))) {
+ r = p;
+ }
+ p = mp_next_knot(p);
+ }
+ if (l != r) {
+ mp_knot s = mp_next_knot(r);
+ {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ set_number_from_subtraction(dx, r->x_coord, l->x_coord);
+ set_number_from_subtraction(dy, r->y_coord, l->y_coord);
+ p = mp_next_knot(l);
+ while (p != r) {
+ q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->y_coord, l->y_coord);
+ set_number_from_subtraction(arg2, p->x_coord, l->x_coord);
+ if (ab_vs_cd(dx, arg1, dy, arg2) > 0) {
+ mp_move_knot(mp, p, r);
+ }
+ p = q;
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ p = s;
+ while (p != l) {
+ q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->y_coord, l->y_coord);
+ set_number_from_subtraction(arg2, p->x_coord, l->x_coord);
+ if (ab_vs_cd(dx, arg1, dy, arg2) < 0) {
+ mp_move_knot(mp, p, l);
+ }
+ p = q;
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ p = mp_next_knot(l);
+ while (p != r) {
+ q = mp_prev_knot(p);
+ while (number_greater(q->x_coord, p->x_coord)) {
+ q = mp_prev_knot(q);
+ }
+ while (number_equal(q->x_coord, p->x_coord)) {
+ if (number_greater(q->y_coord, p->y_coord)) {
+ q = mp_prev_knot(q);
+ } else {
+ break;
+ }
+ }
+ if (q == mp_prev_knot(p)) {
+ p = mp_next_knot(p);
+ } else {
+ p = mp_next_knot(p);
+ mp_move_knot(mp, mp_prev_knot(p), q);
+ }
+ }
+ p = mp_next_knot(r);
+ while (p != l) {
+ q = mp_prev_knot(p);
+ while (number_less(q->x_coord, p->x_coord)) {
+ q = mp_prev_knot(q);
+ }
+ while (number_equal(q->x_coord, p->x_coord)) {
+ if (number_less(q->y_coord, p->y_coord)) {
+ q = mp_prev_knot(q);
+ } else {
+ break;
+ }
+ }
+ if (q == mp_prev_knot(p)) {
+ p = mp_next_knot(p);
+ } else {
+ p = mp_next_knot(p);
+ mp_move_knot(mp, mp_prev_knot(p), q);
+ }
+ }
+ }
+ if (l != mp_next_knot(l)) {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ p = l;
+ q = mp_next_knot(l);
+ while (1) {
+ set_number_from_subtraction(dx, q->x_coord, p->x_coord);
+ set_number_from_subtraction(dy, q->y_coord, p->y_coord);
+ p = q;
+ q = mp_next_knot(q);
+ if (p == l) {
+ break;
+ } else if (p != r) {
+ set_number_from_subtraction(arg1, q->y_coord, p->y_coord);
+ set_number_from_subtraction(arg2, q->x_coord, p->x_coord);
+ if (ab_vs_cd(dx, arg1, dy, arg2) <= 0) {
+ s = mp_prev_knot(p);
+ mp_memory_free(p);
+ mp_next_knot(s) = q;
+ mp_prev_knot(q) = s;
+ if (s == l) {
+ p = s;
+ } else {
+ p = mp_prev_knot(s);
+ q = s;
+ }
+ }
+ }
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ free_number(dx);
+ free_number(dy);
+ return l;
+ }
+}
+
+void mp_simplify_path (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ (void) mp;
+ do {
+ p->left_x = p->x_coord;
+ p->left_y = p->y_coord;
+ p->right_x = p->x_coord;
+ p->right_y = p->y_coord;
+ p = mp_next_knot(p);
+ } while (p != h);
+}
+
+void mp_move_knot (MP mp, mp_knot p, mp_knot q)
+{
+ (void) mp;
+ mp_next_knot(mp_prev_knot(p)) = mp_next_knot(p);
+ mp_prev_knot(mp_next_knot(p)) = mp_prev_knot(p);
+ mp_prev_knot(p) = q;
+ mp_next_knot(p) = mp_next_knot(q);
+ mp_next_knot(q) = p;
+ mp_prev_knot(mp_next_knot(p)) = p;
+}
+
+static void mp_find_offset (MP mp, mp_number *x_orig, mp_number *y_orig, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ mp_fraction xx, yy;
+ mp_number wx, wy, hx, hy;
+ mp_fraction d;
+ new_fraction(xx);
+ new_fraction(yy);
+ new_number(wx);
+ new_number(wy);
+ new_number(hx);
+ new_number(hy);
+ new_fraction(d);
+ if (number_zero(*x_orig) && number_zero(*y_orig)) {
+ number_clone(mp->cur_x, h->x_coord);
+ number_clone(mp->cur_y, h->y_coord);
+ } else {
+ mp_number x, y, abs_x, abs_y;
+ new_number_clone(x, *x_orig);
+ new_number_clone(y, *y_orig);
+ set_number_from_subtraction(wx, h->left_x, h->x_coord);
+ set_number_from_subtraction(wy, h->left_y, h->y_coord);
+ set_number_from_subtraction(hx, h->right_x, h->x_coord);
+ set_number_from_subtraction(hy, h->right_y, h->y_coord);
+
+ new_number_abs(abs_x, x);
+ new_number_abs(abs_y, y);
+ while (number_less(abs_x, fraction_half_t) && number_less(abs_y, fraction_half_t)) {
+ number_double(x);
+ number_double(y);
+ number_abs_clone(abs_x, x);
+ number_abs_clone(abs_y, y);
+ }
+ {
+ mp_number r1, r2, arg1;
+ new_number(arg1);
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, x, hy);
+ number_negated_clone(arg1, hx);
+ take_fraction(r2, y, arg1);
+ number_add(r1, r2);
+ number_negate(r1);
+ number_clone(yy, r1);
+ number_negated_clone(arg1, wy);
+ take_fraction(r1, x, arg1);
+ take_fraction(r2, y, wx);
+ number_add(r1, r2);
+ number_clone(xx, r1);
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+ }
+ pyth_add(d, xx, yy);
+ if (number_positive(d)) {
+ mp_number ret;
+ new_fraction(ret);
+ make_fraction(ret, xx, d);
+ number_half(ret);
+ number_clone(xx, ret);
+ make_fraction(ret, yy, d);
+ number_half(ret);
+ number_clone(yy, ret);
+ free_number(ret);
+ }
+ {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, xx, wx);
+ take_fraction(r2, yy, hx);
+ number_add(r1, r2);
+ set_number_from_addition(mp->cur_x, h->x_coord, r1);
+ take_fraction(r1, xx, wy);
+ take_fraction(r2, yy, hy);
+ number_add(r1, r2);
+ set_number_from_addition(mp->cur_y, h->y_coord, r1);
+ free_number(r1);
+ free_number(r2);
+ }
+ free_number(abs_x);
+ free_number(abs_y);
+ free_number(x);
+ free_number(y);
+ }
+ free_number(xx);
+ free_number(yy);
+ free_number(wx);
+ free_number(wy);
+ free_number(hx);
+ free_number(hy);
+ free_number(d);
+ } else {
+ mp_knot p, q;
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ q = h;
+ do {
+ p = q;
+ q = mp_next_knot(q);
+ set_number_from_subtraction(arg1, q->x_coord, p->x_coord);
+ set_number_from_subtraction(arg2, q->y_coord, p->y_coord);
+ } while (ab_vs_cd(arg1, *y_orig, arg2, *x_orig) < 0);
+ do {
+ p = q;
+ q = mp_next_knot(q);
+ set_number_from_subtraction(arg1, q->x_coord, p->x_coord);
+ set_number_from_subtraction(arg2, q->y_coord, p->y_coord);
+ } while (ab_vs_cd(arg1, *y_orig, arg2, *x_orig) > 0);
+ number_clone(mp->cur_x, p->x_coord);
+ number_clone(mp->cur_y, p->y_coord);
+ free_number(arg1);
+ free_number(arg2);
+ }
+}
+
+static void mp_pen_bbox (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_fraction(arg2);
+ number_clone(arg2, fraction_one_t);
+ mp_find_offset(mp, &arg1, &arg2, h);
+ number_clone(mp_maxx, mp->cur_x);
+ number_clone(mp_minx, h->x_coord);
+ number_double(mp_minx);
+ number_subtract(mp_minx, mp->cur_x);
+ number_negate(arg2);
+ mp_find_offset(mp, &arg2, &arg1, h);
+ number_clone(mp_maxy, mp->cur_y);
+ number_clone(mp_miny, h->y_coord);
+ number_double(mp_miny);
+ number_subtract(mp_miny, mp->cur_y);
+ free_number(arg1);
+ free_number(arg2);
+ } else {
+ mp_knot p = mp_next_knot(h);
+ number_clone(mp_minx, h->x_coord);
+ number_clone(mp_maxx, mp_minx);
+ number_clone(mp_miny, h->y_coord);
+ number_clone(mp_maxy, mp_miny);
+ while (p != h) {
+ if (number_less(p->x_coord, mp_minx)) {
+ number_clone(mp_minx, p->x_coord);
+ }
+ if (number_less(p->y_coord, mp_miny)) {
+ number_clone(mp_miny, p->y_coord);
+ }
+ if (number_greater(p->x_coord, mp_maxx)) {
+ number_clone(mp_maxx, p->x_coord);
+ }
+ if (number_greater(p->y_coord, mp_maxy)) {
+ number_clone(mp_maxy, p->y_coord);
+ }
+ p = mp_next_knot(p);
+ }
+ }
+}
+
+static mp_node mp_new_shape_node (MP mp, mp_knot p, int type)
+{
+ mp_shape_node t = mp_allocate_node(mp, sizeof(mp_shape_node_data));
+ mp_type(t) = type;
+ mp_path_ptr(t) = p;
+ mp_pen_ptr(t) = NULL;
+ mp_dash_ptr(t) = NULL;
+ new_number(t->red);
+ new_number(t->green);
+ new_number(t->blue);
+ new_number(t->black);
+ new_number(t->miterlimit);
+ new_number(t->dashscale);
+ set_number_to_unity(t->dashscale);
+ mp_color_model(t) = mp_uninitialized_model;
+ mp_pen_type(t) = 0;
+ mp_pre_script(t) = NULL;
+ mp_post_script(t) = NULL;
+ if (number_greater(internal_value(mp_linejoin_internal), unity_t)) {
+ t->linejoin = mp_beveled_linejoin_code;
+ } else if (number_positive(internal_value(mp_linejoin_internal))) {
+ t->linejoin = mp_rounded_linejoin_code;
+ } else {
+ t->linejoin = mp_mitered_linejoin_code;
+ }
+ t->stacking = round_unscaled(internal_value(mp_stacking_internal));
+ if (number_less(internal_value(mp_miterlimit_internal), unity_t)) {
+ set_number_to_unity(t->miterlimit);
+ } else {
+ number_clone(t->miterlimit, internal_value(mp_miterlimit_internal));
+ }
+ if (number_greater(internal_value(mp_linecap_internal), unity_t)) {
+ t->linecap = mp_squared_linecap_code;
+ } else if (number_positive(internal_value(mp_linecap_internal))) {
+ t->linecap = mp_rounded_linecap_code;
+ } else {
+ t->linecap = mp_butt_linecap_code;
+ }
+ return (mp_node) t;
+}
+
+static mp_edge_header_node mp_free_shape_node (MP mp, mp_shape_node p)
+{
+ mp_edge_header_node e = NULL;
+ mp_toss_knot_list(mp, mp_path_ptr(p));
+ if (mp_pen_ptr(p) != NULL) {
+ mp_toss_knot_list(mp, mp_pen_ptr(p));
+ }
+ if (mp_pre_script(p) != NULL) {
+ delete_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ delete_str_ref(mp_post_script(p));
+ }
+ e = (mp_edge_header_node) mp_dash_ptr(p);
+ free_number(p->red);
+ free_number(p->green);
+ free_number(p->blue);
+ free_number(p->black);
+ free_number(p->miterlimit);
+ free_number(p->dashscale);
+ mp_free_node(mp, (mp_node) p, sizeof(mp_shape_node_data));
+ return e ;
+}
+
+void mp_sqrt_det (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ mp_number a, b, c, d;
+ mp_number maxabs;
+ unsigned s = 64;
+ mp_number tmp;
+ new_number_clone(a, *a_orig);
+ new_number_clone(b, *b_orig);
+ new_number_clone(c, *c_orig);
+ new_number_clone(d, *d_orig);
+ new_number_abs(maxabs, a);
+ new_number_abs(tmp, b);
+ if (number_greater(tmp, maxabs)) {
+ number_clone(maxabs, tmp);
+ }
+ number_abs_clone(tmp, c);
+ if (number_greater(tmp, maxabs)) {
+ number_clone(maxabs, tmp);
+ }
+ number_abs_clone(tmp, d);
+ if (number_greater(tmp, maxabs)) {
+ number_clone(maxabs, tmp);
+ }
+ free_number(tmp);
+ while ((number_less(maxabs, fraction_one_t)) && (s > 1)) {
+ number_double(a);
+ number_double(b);
+ number_double(c);
+ number_double(d);
+ number_double(maxabs);
+ s = s/2;
+ }
+ {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, a, d);
+ take_fraction(r2, b, c);
+ number_subtract(r1, r2);
+ number_abs(r1);
+ square_rt(*ret, r1);
+ number_multiply_int(*ret, s);
+ free_number(r1);
+ free_number(r2);
+ }
+ free_number(a);
+ free_number(b);
+ free_number(c);
+ free_number(d);
+ free_number(maxabs);
+}
+
+static void mp_get_pen_scale (MP mp, mp_number *ret, mp_knot p)
+{
+ if (p == NULL) {
+ set_number_to_zero(*ret);
+ } else {
+ mp_number a, b, c, d;
+ new_number(a);
+ new_number(b);
+ new_number(c);
+ new_number(d);
+ set_number_from_subtraction(a, p->left_x, p->x_coord);
+ set_number_from_subtraction(b, p->right_x, p->x_coord);
+ set_number_from_subtraction(c, p->left_y, p->y_coord);
+ set_number_from_subtraction(d, p->right_y, p->y_coord);
+ mp_sqrt_det(mp, ret, &a, &b, &c, &d);
+ free_number(a);
+ free_number(b);
+ free_number(c);
+ free_number(d);
+ }
+}
+
+static mp_node mp_new_bounds_node (MP mp, mp_knot p, int c)
+{
+ switch (c) {
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ {
+ mp_start_node t = (mp_start_node) mp_allocate_node(mp, sizeof(mp_start_node_data));
+ mp_type(t) = c;
+ t->path = p;
+ t->link = NULL;
+ t->stacking = round_unscaled(internal_value(mp_stacking_internal));
+ mp_pre_script(t) = NULL;
+ mp_post_script(t) = NULL;
+ return (mp_node) t;
+ }
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ {
+ mp_stop_node t = (mp_stop_node) mp_allocate_node(mp, sizeof(mp_stop_node_data));
+ mp_type(t) = c;
+ t->link = NULL;
+ t->stacking = round_unscaled(internal_value(mp_stacking_internal));
+ return (mp_node) t;
+ }
+ break;
+ default:
+ break;
+ }
+ return NULL;
+}
+
+static void mp_free_start_node (MP mp, mp_start_node p)
+{
+ mp_toss_knot_list(mp, mp_path_ptr(p));
+ if (mp_pre_script(p) != NULL) {
+ delete_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ delete_str_ref(mp_post_script(p));
+ }
+ mp_free_node(mp, (mp_node) p, sizeof(mp_start_node_data));
+}
+
+static void mp_free_stop_node (MP mp, mp_stop_node p)
+{
+ mp_free_node(mp, (mp_node) p, sizeof(mp_stop_node_data));
+}
+
+static mp_dash_node mp_get_dash_node (MP mp)
+{
+ mp_dash_node p = (mp_dash_node) mp_allocate_node(mp, sizeof(mp_dash_node_data));
+ p->hasnumber = 0;
+ new_number(p->start_x);
+ new_number(p->stop_x);
+ new_number(p->dash_y);
+ mp_type(p) = mp_dash_node_type;
+ return p;
+}
+
+static void mp_init_bbox (MP mp, mp_edge_header_node h)
+{
+ (void) mp;
+ mp_bblast(h) = mp_edge_list(h);
+ h->bbtype = mp_no_bounds_code;
+ set_number_to_inf(h->minx);
+ set_number_to_inf(h->miny);
+ set_number_to_negative_inf(h->maxx);
+ set_number_to_negative_inf(h->maxy);
+}
+
+static mp_edge_header_node mp_get_edge_header_node (MP mp)
+{
+ mp_edge_header_node p = (mp_edge_header_node) mp_allocate_node(mp, sizeof(mp_edge_header_node_data));
+ mp_type(p) = mp_edge_header_node_type;
+ new_number(p->start_x);
+ new_number(p->stop_x);
+ new_number(p->dash_y);
+ new_number(p->minx);
+ new_number(p->miny);
+ new_number(p->maxx);
+ new_number(p->maxy);
+ p->list = mp_new_token_node(mp);
+ return p;
+}
+
+static void mp_init_edges (MP mp, mp_edge_header_node h)
+{
+ mp_set_dash_list(h, mp->null_dash);
+ mp_obj_tail(h) = mp_edge_list(h);
+ mp_link(mp_edge_list(h)) = NULL;
+ mp_edge_ref_count(h) = 0;
+ mp_init_bbox(mp, h);
+}
+
+void mp_toss_edges (MP mp, mp_edge_header_node h)
+{
+ mp_node q;
+ mp_edge_header_node r;
+ mp_flush_dash_list(mp, h);
+ q = mp_link(mp_edge_list(h));
+ while (q != NULL) {
+ mp_node p = q;
+ q = mp_link(q);
+ r = mp_toss_gr_object(mp, p);
+ if (r != NULL) {
+ mp_delete_edge_ref(mp, r);
+ }
+ }
+ free_number(h->start_x);
+ free_number(h->stop_x);
+ free_number(h->dash_y);
+ free_number(h->minx);
+ free_number(h->miny);
+ free_number(h->maxx);
+ free_number(h->maxy);
+ mp_free_token_node(mp, h->list);
+ mp_free_node(mp, (mp_node) h, sizeof(mp_edge_header_node_data));
+}
+
+void mp_flush_dash_list (MP mp, mp_edge_header_node h)
+{
+ mp_dash_node q = mp_get_dash_list(h);
+ while (q != mp->null_dash) {
+ mp_dash_node p = q;
+ q = (mp_dash_node) mp_link(q);
+ mp_free_node(mp, (mp_node) p, sizeof(mp_dash_node_data));
+ }
+ mp_set_dash_list(h, mp->null_dash);
+}
+
+mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p)
+{
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ return mp_free_shape_node(mp, (mp_shape_node) p);
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ mp_free_start_node(mp, (mp_start_node) p);
+ return NULL;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ mp_free_stop_node(mp, (mp_stop_node) p);
+ return NULL;
+ default:
+ return NULL;
+ }
+}
+
+static mp_edge_header_node mp_private_edges (MP mp, mp_edge_header_node h)
+{
+ if (mp_edge_ref_count(h) == 0) {
+ return h;
+ } else {
+ mp_edge_header_node hh;
+ mp_dash_node p, pp;
+ mp_edge_ref_count(h) -= 1;
+ hh = (mp_edge_header_node) mp_copy_objects (mp, mp_link(mp_edge_list(h)), NULL);
+ pp = (mp_dash_node) hh;
+ p = mp_get_dash_list(h);
+ while ((p != mp->null_dash)) {
+ mp_link(pp) = (mp_node) mp_get_dash_node(mp);
+ pp = (mp_dash_node) mp_link(pp);
+ number_clone(pp->start_x, p->start_x);
+ number_clone(pp->stop_x, p->stop_x);
+ p = (mp_dash_node) mp_link(p);
+ }
+ mp_link(pp) = (mp_node) mp->null_dash;
+ number_clone(hh->dash_y, h->dash_y);
+
+ number_clone(hh->minx, h->minx);
+ number_clone(hh->miny, h->miny);
+ number_clone(hh->maxx, h->maxx);
+ number_clone(hh->maxy, h->maxy);
+ hh->bbtype = h->bbtype;
+ p = (mp_dash_node) mp_edge_list(h);
+ pp = (mp_dash_node) mp_edge_list(hh);
+ while ((p != (mp_dash_node) mp_bblast(h))) {
+ if (p == NULL) {
+ mp_confusion(mp, "boundingbox last");
+ } else {
+ p = (mp_dash_node) mp_link(p);
+ pp = (mp_dash_node) mp_link(pp);
+ }
+ }
+ mp_bblast(hh) = (mp_node) pp;
+
+ return hh;
+ }
+}
+
+static mp_dash_object *mp_export_dashes (MP mp, mp_shape_node q, mp_number *w)
+{
+ mp_dash_node h = (mp_dash_node) mp_dash_ptr(q);
+ if (h == NULL || mp_get_dash_list(h) == mp->null_dash) {
+ return NULL;
+ } else {
+ mp_dash_object *d;
+ mp_dash_node p;
+ mp_number scf;
+ mp_number dashoff;
+ double *dashes = NULL;
+ int num_dashes = 1;
+ new_number(scf);
+ p = mp_get_dash_list(h);
+ mp_get_pen_scale(mp, &scf, mp_pen_ptr(q));
+ if (number_zero(scf)) {
+ if (number_zero(*w)) {
+ number_clone(scf, q->dashscale);
+ } else {
+ free_number(scf);
+ return NULL;
+ }
+ } else {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, *w, scf);
+ take_scaled(scf, ret, q->dashscale);
+ free_number(ret);
+ }
+ number_clone(*w, scf);
+ d = mp_allocate_dash(mp);
+ set_number_from_addition(mp->null_dash->start_x, p->start_x, h->dash_y);
+ {
+ mp_number ret, arg1;
+ new_number(ret);
+ new_number(arg1);
+ new_number(dashoff);
+ while (p != mp->null_dash) {
+ dashes = mp_memory_reallocate(dashes, (size_t) (num_dashes + 2) * sizeof(double));
+ set_number_from_subtraction(arg1, p->stop_x, p->start_x);
+ take_scaled(ret, arg1, scf);
+ dashes[(num_dashes - 1)] = number_to_double(ret);
+ set_number_from_subtraction(arg1, ((mp_dash_node) mp_link(p))->start_x, p->stop_x);
+ take_scaled(ret, arg1, scf);
+ dashes[(num_dashes)] = number_to_double(ret);
+ dashes[(num_dashes + 1)] = -1.0;
+ num_dashes += 2;
+ p = (mp_dash_node) mp_link(p);
+ }
+ d->array = dashes;
+ mp_dash_offset(mp, &dashoff, h);
+ take_scaled(ret, dashoff, scf);
+ d->offset = number_to_double(ret);
+ free_number(ret);
+ free_number(arg1);
+ }
+ free_number(dashoff);
+ free_number(scf);
+ return d;
+ }
+}
+
+mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q) {
+ mp_node pp;
+ int k = 0;
+ mp_edge_header_node hh = mp_get_edge_header_node(mp);
+ mp_set_dash_list(hh, mp->null_dash);
+ mp_edge_ref_count(hh) = 0;
+ pp = mp_edge_list(hh);
+ while (p != q) {
+ {
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ k = sizeof(mp_shape_node_data);
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ k = sizeof(mp_start_node_data);
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ k = sizeof(mp_stop_node_data);
+ break;
+ default:
+ break;
+ }
+ mp_link(pp) = mp_allocate_node(mp, (size_t) k);
+ pp = mp_link(pp);
+ memcpy(pp, p, (size_t) k);
+ pp->link = NULL;
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ {
+ mp_shape_node tt = (mp_shape_node) pp;
+ mp_shape_node t = (mp_shape_node) p;
+ new_number_clone(tt->red, t->red);
+ new_number_clone(tt->green, t->green);
+ new_number_clone(tt->blue, t->blue);
+ new_number_clone(tt->black, t->black);
+ new_number_clone(tt->miterlimit, t->miterlimit);
+ new_number_clone(tt->dashscale, t->dashscale);
+ mp_path_ptr(tt) = mp_copy_path(mp, mp_path_ptr(t));
+ if (mp_pre_script(p) != NULL) {
+ add_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ add_str_ref(mp_post_script(p));
+ }
+ if (mp_pen_ptr(t) != NULL) {
+ mp_pen_ptr(tt) = mp_copy_pen(mp, mp_pen_ptr(t));
+ }
+ if (mp_dash_ptr(p) != NULL) {
+ mp_add_edge_ref(mp, mp_dash_ptr(pp));
+ }
+ }
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ {
+ mp_start_node tt = (mp_start_node) pp;
+ mp_start_node t = (mp_start_node) p;
+ mp_path_ptr(tt) = mp_copy_path(mp, mp_path_ptr(t));
+ if (mp_pre_script(p) != NULL) {
+ add_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ add_str_ref(mp_post_script(p));
+ }
+ }
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ break;
+ default:
+ break;
+ }
+ p = mp_link(p);
+ }
+ }
+ mp_obj_tail(hh) = pp;
+ mp_link(pp) = NULL;
+ return hh;
+}
+
+static mp_node mp_skip_1component (MP mp, mp_node p)
+{
+ int lev = 0;
+ (void) mp;
+ do {
+ if (mp_is_start_or_stop (p)) {
+ if (mp_is_stop(p)) {
+ --lev;
+ } else {
+ ++lev;
+ }
+ }
+ p = mp_link(p);
+ } while (lev != 0);
+ return p;
+}
+
+void mp_print_edges (MP mp, mp_node h, const char *s, int nuline)
+{
+ mp_node p = mp_edge_list(h);
+ mp_number scf;
+ new_number(scf);
+ mp_print_diagnostic(mp, "Edge structure", s, nuline);
+ while (mp_link(p) != NULL) {
+ p = mp_link(p);
+ mp_print_ln(mp);
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ mp_print_str(mp, "Filled contour ");
+ mp_print_obj_color (mp, p);
+ mp_print_chr(mp, ':');
+ mp_print_ln(mp);
+ mp_pr_path(mp, mp_path_ptr((mp_shape_node) p));
+ mp_print_ln(mp);
+ if ((mp_pen_ptr((mp_shape_node) p) != NULL)) {
+ switch (((mp_shape_node) p)->linejoin) {
+ case mp_mitered_linejoin_code:
+ mp_print_str(mp, "mitered joins limited ");
+ print_number(((mp_shape_node) p)->miterlimit);
+ break;
+ case mp_rounded_linejoin_code:
+ mp_print_str(mp, "round joins");
+ break;
+ case mp_beveled_linejoin_code:
+ mp_print_str(mp, "beveled joins");
+ break;
+ default:
+ mp_print_str(mp, "?? joins");
+ break;
+ }
+ mp_print_str(mp, " with pen");
+ mp_print_ln(mp);
+ mp_pr_pen(mp, mp_pen_ptr((mp_shape_node) p));
+ }
+ break;
+ case mp_stroked_node_type:
+ mp_print_str(mp, "Filled pen stroke ");
+ mp_print_obj_color (mp, p);
+ mp_print_chr(mp, ':');
+ mp_print_ln(mp);
+ mp_pr_path(mp, mp_path_ptr((mp_shape_node) p));
+ if (mp_dash_ptr(p) != NULL) {
+ mp_dash_node ppd, hhd;
+ int ok_to_dash = mp_pen_is_elliptical(mp_pen_ptr((mp_shape_node) p));
+ mp_print_nl(mp, "dashed (");
+ if (! ok_to_dash) {
+ set_number_to_unity(scf);
+ } else {
+ number_clone(scf, ((mp_shape_node) p)->dashscale);
+ }
+ hhd = (mp_dash_node) mp_dash_ptr(p);
+ ppd = mp_get_dash_list(hhd);
+ if ((ppd == mp->null_dash) || number_negative(hhd->dash_y)) {
+ mp_print_str(mp, " ??");
+ } else {
+ mp_number dashoff;
+ mp_number ret, arg1;
+ new_number(ret);
+ new_number(arg1);
+ new_number(dashoff);
+ set_number_from_addition(mp->null_dash->start_x, ppd->start_x, hhd->dash_y );
+ while (ppd != mp->null_dash) {
+ mp_print_str(mp, "on ");
+ set_number_from_subtraction(arg1, ppd->stop_x, ppd->start_x);
+ take_scaled(ret, arg1, scf);
+ print_number( ret);
+ mp_print_str(mp, " off ");
+ set_number_from_subtraction(arg1, ((mp_dash_node) mp_link(ppd))->start_x, ppd->stop_x);
+ take_scaled(ret, arg1, scf);
+ print_number(ret);
+ ppd = (mp_dash_node) mp_link(ppd);
+ if (ppd != mp->null_dash) {
+ mp_print_chr(mp, ' ');
+ }
+ }
+ mp_print_str(mp, ") shifted ");
+ mp_dash_offset(mp, &dashoff, hhd);
+ take_scaled(ret, dashoff, scf);
+ number_negate(ret);
+ print_number(ret);
+ free_number(dashoff);
+ free_number(ret);
+ free_number(arg1);
+ if (!ok_to_dash || number_zero(hhd->dash_y)) {
+ mp_print_str(mp, " (this will be ignored)");
+ }
+ }
+ }
+ mp_print_ln(mp);
+ switch (((mp_shape_node) p)->linecap) {
+ case mp_butt_linecap_code:
+ mp_print_str(mp, "butt");
+ break;
+ case mp_rounded_linecap_code:
+ mp_print_str(mp, "round");
+ break;
+ case mp_squared_linecap_code:
+ mp_print_str(mp, "square");
+ break;
+ default:
+ mp_print_str(mp, "??");
+ break;
+ }
+ mp_print_str(mp, " ends, ");
+ switch (((mp_shape_node) p)->linejoin) {
+ case mp_mitered_linejoin_code:
+ mp_print_str(mp, "mitered joins limited ");
+ print_number(((mp_shape_node) p)->miterlimit);
+ break;
+ case mp_rounded_linejoin_code:
+ mp_print_str(mp, "round joins");
+ break;
+ case mp_beveled_linejoin_code:
+ mp_print_str(mp, "beveled joins");
+ break;
+ default:
+ mp_print_str(mp, "?? joins");
+ break;
+ }
+
+ mp_print_str(mp, " with pen");
+ mp_print_ln(mp);
+ if (mp_pen_ptr((mp_shape_node) p) == NULL) {
+ mp_print_str(mp, "???");
+ } else {
+ mp_pr_pen(mp, mp_pen_ptr((mp_shape_node) p));
+ }
+ break;
+ case mp_start_clip_node_type:
+ mp_print_str(mp, "clipping path:");
+ goto COMMONSTART;
+ case mp_start_group_node_type:
+ mp_print_str(mp, "setgroup path:");
+ goto COMMONSTART;
+ case mp_start_bounds_node_type:
+ mp_print_str(mp, "setbounds path:");
+ COMMONSTART:
+ mp_print_ln(mp);
+ mp_pr_path(mp, mp_path_ptr((mp_start_node) p));
+ break;
+ case mp_stop_clip_node_type:
+ mp_print_str(mp, "stop clipping");
+ break;
+ case mp_stop_group_node_type:
+ mp_print_str(mp, "stop group");
+ break;
+ case mp_stop_bounds_node_type:
+ mp_print_str(mp, "end of setbounds");
+ break;
+
+ default:
+ mp_print_str(mp, "[unknown object type!]");
+ break;
+ }
+ }
+ mp_print_nl(mp, "End edges");
+ if (p != mp_obj_tail(h)) {
+ mp_print_str(mp, "?");
+ }
+ mp_end_diagnostic(mp, 1);
+ free_number(scf);
+}
+
+void mp_print_obj_color (MP mp, mp_node p)
+{
+ mp_shape_node p0 = (mp_shape_node) p;
+ switch (mp_color_model(p)) {
+ case mp_grey_model:
+ if (number_positive(p0->grey)) {
+ mp_print_str(mp, "greyed ");
+ mp_print_chr(mp, '(');
+ print_number(p0->grey);
+ mp_print_chr(mp, ')');
+ };
+ break;
+ case mp_cmyk_model:
+ if (number_positive(p0->cyan) || number_positive(p0->magenta)
+ || number_positive(p0->yellow) || number_positive(p0->black)) {
+ mp_print_str(mp, "processcolored ");
+ mp_print_chr(mp, '(');
+ print_number(p0->cyan);
+ mp_print_chr(mp, ',');
+ print_number(p0->magenta);
+ mp_print_chr(mp, ',');
+ print_number(p0->yellow);
+ mp_print_chr(mp, ',');
+ print_number(p0->black);
+ mp_print_chr(mp, ')');
+ };
+ break;
+ case mp_rgb_model:
+ if (number_positive(p0->red) || number_positive(p0->green) || number_positive(p0->blue)) {
+ mp_print_str(mp, "colored ");
+ mp_print_chr(mp, '(');
+ print_number(p0->red);
+ mp_print_chr(mp, ',');
+ print_number(p0->green);
+ mp_print_chr(mp, ',');
+ print_number(p0->blue);
+ mp_print_chr(mp, ')');
+ }
+ break;
+ default:
+ break;
+ }
+}
+
+void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h)
+{
+ if (mp_get_dash_list(h) == mp->null_dash || number_negative(h->dash_y)) {
+ mp_confusion(mp, "dash offset");
+ } else if (number_zero(h->dash_y)) {
+ set_number_to_zero(*x);
+ } else {
+ number_clone(*x, (mp_get_dash_list(h))->start_x);
+ number_modulo(*x, h->dash_y);
+ number_negate(*x);
+ if (number_negative(*x)) {
+ number_add(*x, h->dash_y);
+ }
+ }
+}
+
+static mp_edge_header_node mp_make_dashes (MP mp, mp_edge_header_node h)
+{
+ if (mp_get_dash_list(h) != mp->null_dash) {
+ return h;
+ } else {
+ mp_node p;
+ mp_node p0;
+ mp_knot pp, qq, rr;
+ mp_dash_node d, dd;
+ mp_number y0;
+ mp_dash_node dln;
+ mp_edge_header_node hh;
+ mp_node ds;
+
+ new_number(y0);
+ p0 = NULL;
+ p = mp_link(mp_edge_list(h));
+ while (p != NULL) {
+ if (mp_type(p) != mp_stroked_node_type) {
+ mp_back_error(
+ mp,
+ "Picture is too complicated to use as a dash pattern",
+ "When you say 'dashed p', picture p should not contain any text, filled regions,\n"
+ "or clipping paths. This time it did so I'll just make it a solid line instead."
+ );
+ mp_get_x_next(mp);
+ goto NOT_FOUND;
+ }
+ pp = mp_path_ptr((mp_shape_node) p);
+ if (p0 == NULL) {
+ p0 = p;
+ number_clone(y0, pp->y_coord);
+ }
+ if (! number_equal(((mp_shape_node) p)->red, ((mp_shape_node) p0)->red)
+ || ! number_equal(((mp_shape_node) p)->black, ((mp_shape_node) p0)->black)
+ || ! number_equal(((mp_shape_node) p)->green, ((mp_shape_node) p0)->green)
+ || ! number_equal(((mp_shape_node) p)->blue, ((mp_shape_node) p0)->blue)
+ ) {
+ mp_back_error(
+ mp,
+ "Picture is too complicated to use as a dash pattern",
+ "When you say 'dashed p', everything in picture p should be the same color. I\n"
+ "can't handle your color changes so I'll just make it a solid line instead."
+ );
+ mp_get_x_next(mp);
+ goto NOT_FOUND;
+ }
+ rr = pp;
+ if (mp_next_knot(pp) != pp) {
+ do {
+ qq = rr;
+ rr = mp_next_knot(rr);
+ {
+ mp_number x0, x1, x2, x3;
+ new_number_clone(x0, qq->x_coord);
+ new_number_clone(x1, qq->right_x);
+ new_number_clone(x2, rr->left_x);
+ new_number_clone(x3, rr->x_coord);
+ if (number_greater(x0, x1) || number_greater(x1, x2) || number_greater(x2, x3)) {
+ if (number_less(x0, x1) || number_less(x1, x2) || number_less(x2, x3)) {
+ mp_number a1, a2, a3, a4;
+ int test;
+ new_number(a1);
+ new_number(a2);
+ new_number(a3);
+ new_number(a4);
+ set_number_from_subtraction(a1, x2, x1);
+ set_number_from_subtraction(a2, x2, x1);
+ set_number_from_subtraction(a3, x1, x0);
+ set_number_from_subtraction(a4, x3, x2);
+ test = ab_vs_cd(a1, a2, a3, a4);
+ free_number(a1);
+ free_number(a2);
+ free_number(a3);
+ free_number(a4);
+ if (test > 0) {
+ mp_x_retrace_error(mp);
+ free_number(x0);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ goto NOT_FOUND;
+ }
+ }
+ }
+ if (number_greater(pp->x_coord, x0) || number_greater(x0, x3)) {
+ if (number_less(pp->x_coord, x0) || number_less(x0, x3)) {
+ mp_x_retrace_error(mp);
+ free_number(x0);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ goto NOT_FOUND;
+ }
+ }
+ free_number(x0);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ }
+ } while (mp_right_type(rr) != mp_endpoint_knot);
+ }
+ d = (mp_dash_node) mp_get_dash_node(mp);
+ if (mp_dash_ptr(p) == NULL) {
+ mp_dash_info(d) = NULL;
+ } else {
+ mp_dash_info(d) = p;
+ }
+ if (number_less(pp->x_coord, rr->x_coord)) {
+ number_clone(d->start_x, pp->x_coord);
+ number_clone(d->stop_x, rr->x_coord);
+ } else {
+ number_clone(d->start_x, rr->x_coord);
+ number_clone(d->stop_x, pp->x_coord);
+ }
+ number_clone(mp->null_dash->start_x, d->stop_x);
+ dd = (mp_dash_node) h;
+ while (number_less(((mp_dash_node) mp_link(dd))->start_x, d->stop_x)) {
+ dd = (mp_dash_node) mp_link(dd);
+ }
+ if ((dd != (mp_dash_node) h) && number_greater(dd->stop_x, d->start_x)) {
+ mp_x_retrace_error(mp);
+ goto NOT_FOUND;
+ }
+ mp_link(d) = mp_link(dd);
+ mp_link(dd) = (mp_node) d;
+
+ p = mp_link(p);
+ }
+ if (mp_get_dash_list(h) == mp->null_dash) {
+ goto NOT_FOUND;
+ } else {
+ {
+ mp_number hsf;
+ new_number(hsf);
+ d = (mp_dash_node) h;
+ while (mp_link(d) != (mp_node) mp->null_dash) {
+ ds = mp_dash_info(mp_link(d));
+ if (ds == NULL) {
+ d = (mp_dash_node) mp_link(d);
+ } else {
+ hh = (mp_edge_header_node) mp_dash_ptr(ds);
+ number_clone(hsf, ((mp_shape_node) ds)->dashscale);
+ if (hh == NULL) {
+ mp_confusion(mp, "dash pattern");
+ return NULL;
+ } else if (number_zero(((mp_dash_node) hh)->dash_y )) {
+ d = (mp_dash_node) mp_link(d);
+ } else if (mp_get_dash_list (hh) == NULL) {
+ mp_confusion(mp, "dash list");
+ return NULL;
+ } else {
+ mp_number xoff;
+ mp_number dashoff;
+ mp_number r1, r2;
+ new_number(r1);
+ new_number(r2);
+ dln = (mp_dash_node) mp_link(d);
+ dd = mp_get_dash_list(hh);
+ new_number(xoff);
+ new_number(dashoff);
+ mp_dash_offset(mp, &dashoff, (mp_dash_node) hh);
+ take_scaled(r1, hsf, dd->start_x);
+ take_scaled(r2, hsf, dashoff);
+ number_add(r1, r2);
+ set_number_from_subtraction(xoff, dln->start_x, r1);
+ free_number(dashoff);
+ take_scaled(r1, hsf, dd->start_x);
+ take_scaled(r2, hsf, hh->dash_y);
+ set_number_from_addition(mp->null_dash->start_x, r1, r2);
+ number_clone(mp->null_dash->stop_x, mp->null_dash->start_x);
+ {
+ mp_number r1;
+ new_number(r1);
+ take_scaled(r1, hsf, dd->stop_x);
+ number_add(r1, xoff);
+ while (number_less(r1, dln->start_x)) {
+ dd = (mp_dash_node) mp_link(dd);
+ take_scaled(r1, hsf, dd->stop_x);
+ number_add(r1, xoff);
+ }
+ free_number(r1);
+ }
+ while (number_lessequal(dln->start_x, dln->stop_x)) {
+ if (dd == mp->null_dash) {
+ mp_number ret;
+ new_number(ret);
+ dd = mp_get_dash_list(hh);
+ take_scaled(ret, hsf, hh->dash_y);
+ number_add(xoff, ret);
+ free_number(ret);
+ }
+ {
+ mp_number r1;
+ new_number(r1);
+ take_scaled(r1, hsf, dd->start_x);
+ number_add(r1, xoff);
+ if (number_lessequal(r1, dln->stop_x)) {
+ mp_link(d) = (mp_node) mp_get_dash_node(mp);
+ d = (mp_dash_node) mp_link(d);
+ mp_link(d) = (mp_node) dln;
+ take_scaled(r1, hsf, dd->start_x );
+ number_add(r1, xoff);
+ if (number_greater(dln->start_x, r1)) {
+ number_clone(d->start_x, dln->start_x);
+ } else {
+ number_clone(d->start_x, r1);
+ }
+ take_scaled(r1, hsf, dd->stop_x);
+ number_add(r1, xoff);
+ if (number_less(dln->stop_x, r1)) {
+ number_clone(d->stop_x, dln->stop_x );
+ } else {
+ number_clone(d->stop_x, r1);
+ }
+ }
+ free_number(r1);
+ }
+ dd = (mp_dash_node) mp_link(dd);
+ take_scaled(r1, hsf, dd->start_x);
+ set_number_from_addition(dln->start_x , xoff, r1);
+ }
+ free_number(xoff);
+ free_number(r1);
+ free_number(r2);
+ mp_link(d) = mp_link(dln);
+ mp_free_node(mp, (mp_node) dln, sizeof(mp_dash_node_data));
+ }
+ }
+ }
+ free_number(hsf);
+ }
+ d = mp_get_dash_list(h);
+ while (mp_link(d) != (mp_node) mp->null_dash) {
+ d = (mp_dash_node) mp_link(d);
+ }
+ dd = mp_get_dash_list(h);
+ set_number_from_subtraction(h->dash_y, d->stop_x, dd->start_x);
+ {
+ mp_number absval;
+ new_number(absval);
+ number_abs_clone(absval, y0);
+ if (number_greater(absval, h->dash_y) ) {
+ number_clone(h->dash_y, absval);
+ } else if (d != dd) {
+ mp_set_dash_list(h, mp_link(dd));
+ set_number_from_addition(d->stop_x, dd->stop_x, h->dash_y);
+ mp_free_node(mp, (mp_node) dd, sizeof(mp_dash_node_data));
+ }
+ free_number(absval);
+ }
+ free_number(y0);
+ return h;
+ }
+ NOT_FOUND:
+ free_number(y0);
+ mp_flush_dash_list(mp, h);
+ mp_delete_edge_ref(mp, h);
+ return NULL;
+ }
+}
+
+void mp_x_retrace_error (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Picture is too complicated to use as a dash pattern",
+ "When you say 'dashed p', every path in p should be monotone in x and there must\n"
+ "be no overlapping. This failed so I'll just make it a solid line instead."
+ );
+ mp_get_x_next(mp);
+}
+
+static void mp_adjust_bbox (MP mp, mp_edge_header_node h)
+{
+ if (number_less(mp_minx, h->minx)) {
+ number_clone(h->minx, mp_minx);
+ }
+ if (number_less(mp_miny, h->miny)) {
+ number_clone(h->miny, mp_miny);
+ }
+ if (number_greater(mp_maxx, h->maxx)) {
+ number_clone(h->maxx, mp_maxx);
+ }
+ if (number_greater(mp_maxy, h->maxy)) {
+ number_clone(h->maxy, mp_maxy);
+ }
+}
+
+static void mp_box_ends (MP mp, mp_knot p, mp_knot pp, mp_edge_header_node h)
+{
+ if (mp_right_type(p) != mp_endpoint_knot) {
+ mp_fraction dx, dy;
+ mp_number d;
+ mp_number z;
+ mp_number xx, yy;
+ new_fraction(dx);
+ new_fraction(dy);
+ new_number(xx);
+ new_number(yy);
+ new_number(z);
+ new_number(d);
+ mp_knot q = mp_next_knot(p);
+ while (1) {
+ if (q == mp_next_knot(p)) {
+ set_number_from_subtraction(dx, p->x_coord, p->right_x);
+ set_number_from_subtraction(dy, p->y_coord, p->right_y);
+ if (number_zero(dx) && number_zero(dy)) {
+ set_number_from_subtraction(dx, p->x_coord, q->left_x);
+ set_number_from_subtraction(dy, p->y_coord, q->left_y);
+ }
+ } else {
+ set_number_from_subtraction(dx, p->x_coord, p->left_x);
+ set_number_from_subtraction(dy, p->y_coord, p->left_y);
+ if (number_zero(dx) && number_zero(dy)) {
+ set_number_from_subtraction(dx, p->x_coord, q->right_x);
+ set_number_from_subtraction(dy, p->y_coord, q->right_y);
+ }
+ }
+ set_number_from_subtraction(dx, p->x_coord, q->x_coord);
+ set_number_from_subtraction(dy, p->y_coord, q->y_coord);
+
+ pyth_add(d, dx, dy);
+ if (number_positive(d)) {
+ mp_number arg1, r;
+ new_fraction(r);
+ new_number(arg1);
+ make_fraction(r, dx, d);
+ number_clone(dx, r);
+ make_fraction(r, dy, d);
+ number_clone(dy, r);
+ free_number(r);
+ number_negated_clone(arg1, dy);
+ mp_find_offset(mp, &arg1, &dx, pp);
+ free_number(arg1);
+ number_clone(xx, mp->cur_x);
+ number_clone(yy, mp->cur_y);
+
+ for (int i = 1; i <= 2; i++) {
+ mp_number r1, r2, arg1;
+ new_number(arg1);
+ new_fraction(r1);
+ new_fraction(r2);
+ mp_find_offset(mp, &dx, &dy, pp);
+ set_number_from_subtraction(arg1, xx, mp->cur_x);
+ take_fraction(r1, arg1, dx);
+ set_number_from_subtraction(arg1, yy, mp->cur_y);
+ take_fraction(r2, arg1, dy);
+ set_number_from_addition(d, r1, r2);
+ if ((number_negative(d) && (i == 1)) || (number_positive(d) && (i == 2))) {
+ mp_confusion(mp, "box ends");
+ }
+ take_fraction(r1, d, dx);
+ set_number_from_addition(z, p->x_coord, mp->cur_x);
+ number_add(z, r1);
+ if (number_less(z, h->minx)) {
+ number_clone(h->minx, z);
+ }
+ if (number_greater(z, h->maxx)) {
+ number_clone(h->maxx, z);
+ }
+ take_fraction(r1, d, dy);
+ set_number_from_addition(z, p->y_coord, mp->cur_y);
+ number_add(z, r1);
+ if (number_less(z, h->miny)) {
+ number_clone(h->miny, z);
+ }
+ if (number_greater(z, h->maxy)) {
+ number_clone(h->maxy, z);
+ }
+ free_number(r1);
+ free_number(r2);
+ free_number(arg1);
+
+ number_negate(dx);
+ number_negate(dy);
+ }
+ }
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ goto DONE;
+ } else {
+ do {
+ q = p;
+ p = mp_next_knot(p);
+ } while (mp_right_type(p) != mp_endpoint_knot);
+ }
+ }
+ DONE:
+ free_number(dx);
+ free_number(dy);
+ free_number(xx);
+ free_number(yy);
+ free_number(z);
+ free_number(d);
+ }
+}
+
+void mp_set_bbox (MP mp, mp_edge_header_node h, int top_level)
+{
+ switch (h->bbtype ) {
+ case mp_no_bounds_code:
+ break;
+ case mp_bounds_set_code:
+ if (number_positive(internal_value(mp_true_corners_internal))) {
+ mp_init_bbox(mp, h);
+ }
+ break;
+ case mp_bounds_unset_code:
+ if (number_nonpositive(internal_value(mp_true_corners_internal))) {
+ mp_init_bbox(mp, h);
+ }
+ break;
+ }
+ while (mp_link(mp_bblast(h)) != NULL) {
+ mp_node p = mp_link(mp_bblast(h));
+ mp_bblast(h) = p;
+ switch (mp_type(p)) {
+ case mp_stop_clip_node_type:
+ if (top_level) {
+ mp_confusion(mp, "clip");
+ break;
+ } else {
+ return;
+ }
+ case mp_start_bounds_node_type:
+ if (number_positive(internal_value(mp_true_corners_internal))) {
+ h->bbtype = mp_bounds_unset_code;
+ } else {
+ h->bbtype = mp_bounds_set_code;
+ mp_path_bbox(mp, mp_path_ptr((mp_start_node) p));
+ mp_adjust_bbox(mp, h);
+ {
+ int lev = 1;
+ while (lev != 0) {
+ if (mp_link(p) == NULL) {
+ mp_confusion(mp, "bounds");
+ } else {
+ p = mp_link(p);
+ if (mp_type(p) == mp_start_bounds_node_type) {
+ ++lev;
+ } else if (mp_type(p) == mp_stop_bounds_node_type) {
+ --lev;
+ }
+ }
+ }
+ mp_bblast(h) = p;
+ }
+ }
+ break;
+ case mp_stop_bounds_node_type:
+ if (number_nonpositive (internal_value(mp_true_corners_internal))) {
+ mp_confusion(mp, "bounds");
+ }
+ break;
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ {
+ mp_number x0a, y0a, x1a, y1a;
+ mp_path_bbox(mp, mp_path_ptr((mp_shape_node) p));
+ if (mp_pen_ptr((mp_shape_node) p) != NULL) {
+ new_number_clone(x0a, mp_minx);
+ new_number_clone(y0a, mp_miny);
+ new_number_clone(x1a, mp_maxx);
+ new_number_clone(y1a, mp_maxy);
+ mp_pen_bbox(mp, mp_pen_ptr((mp_shape_node) p));
+ number_add(mp_minx, x0a);
+ number_add(mp_miny, y0a);
+ number_add(mp_maxx, x1a);
+ number_add(mp_maxy, y1a);
+ free_number(x0a);
+ free_number(y0a);
+ free_number(x1a);
+ free_number(y1a);
+ }
+ mp_adjust_bbox(mp, h);
+ if ((mp_left_type(mp_path_ptr((mp_shape_node) p)) == mp_endpoint_knot) && (((mp_shape_node) p)->linecap == 2)) {
+ mp_box_ends(mp, mp_path_ptr((mp_shape_node) p), mp_pen_ptr((mp_shape_node) p), h);
+ }
+ }
+ break;
+ case mp_start_clip_node_type:
+ {
+ mp_number sminx, sminy, smaxx, smaxy;
+ mp_number x0a, y0a, x1a, y1a;
+ mp_path_bbox(mp, mp_path_ptr((mp_start_node) p));
+ new_number_clone(x0a, mp_minx);
+ new_number_clone(y0a, mp_miny);
+ new_number_clone(x1a, mp_maxx);
+ new_number_clone(y1a, mp_maxy);
+ new_number_clone(sminx, h->minx);
+ new_number_clone(sminy, h->miny);
+ new_number_clone(smaxx, h->maxx);
+ new_number_clone(smaxy, h->maxy);
+ set_number_to_inf(h->minx);
+ set_number_to_inf(h->miny);
+ set_number_to_negative_inf(h->maxx);
+ set_number_to_negative_inf(h->maxy);
+ mp_set_bbox(mp, h, 0);
+
+ if (number_less(h->minx, x0a)) {
+ number_clone(h->minx, x0a);
+ }
+ if (number_less(h->miny, y0a)) {
+ number_clone(h->miny, y0a);
+ }
+ if (number_greater(h->maxx, x1a)) {
+ number_clone(h->maxx, x1a);
+ }
+ if (number_greater(h->maxy, y1a)) {
+ number_clone(h->maxy, y1a);
+ }
+ number_clone(mp_minx, sminx);
+ number_clone(mp_miny, sminy);
+ number_clone(mp_maxx, smaxx);
+ number_clone(mp_maxy, smaxy);
+ mp_adjust_bbox(mp, h);
+ free_number(sminx);
+ free_number(sminy);
+ free_number(smaxx);
+ free_number(smaxy);
+ free_number(x0a);
+ free_number(y0a);
+ free_number(x1a);
+ free_number(y1a);
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+ if (! top_level) {
+ mp_confusion(mp, "boundingbox");
+ }
+}
+
+static mp_knot mp_offset_prep (MP mp, mp_knot c, mp_knot h)
+{
+ int n;
+ mp_knot c0, p, q, q0, r, w, ww;
+ int k_needed;
+ mp_knot w0;
+ mp_number dxin, dyin;
+ int turn_amt;
+ mp_number max_coef;
+ mp_number ss;
+ mp_number x0, x1, x2, y0, y1, y2;
+ mp_number t0, t1, t2;
+ mp_number du, dv, dx, dy;
+ mp_number dx0, dy0;
+ mp_number x0a, x1a,x2a, y0a, y1a, y2a;
+ mp_number t;
+ mp_number s;
+ mp_number dx_m;
+ mp_number dy_m;
+ mp_number dxin_m;
+ mp_number u0, u1, v0, v1;
+ int d_sign;
+ new_number(max_coef);
+ new_number(dxin);
+ new_number(dyin);
+ new_number(dx0);
+ new_number(dy0);
+ new_number(x0);
+ new_number(y0);
+ new_number(x1);
+ new_number(y1);
+ new_number(x2);
+ new_number(y2);
+ new_number(du);
+ new_number(dv);
+ new_number(dx);
+ new_number(dy);
+ new_number(x0a);
+ new_number(y0a);
+ new_number(x1a);
+ new_number(y1a);
+ new_number(x2a);
+ new_number(y2a);
+ new_number(t0);
+ new_number(t1);
+ new_number(t2);
+ new_number(u0);
+ new_number(u1);
+ new_number(v0);
+ new_number(v1);
+ new_number(dx_m);
+ new_number(dy_m);
+ new_number(dxin_m);
+ new_fraction(ss);
+ new_fraction(s);
+ new_fraction(t);
+ n = 0;
+ p = h;
+ do {
+ ++n;
+ p = mp_next_knot(p);
+ } while (p != h);
+
+ {
+ mp_knot hn = mp_next_knot(h);
+ mp_knot hp = mp_prev_knot(h);
+ set_number_from_subtraction(dxin, hn->x_coord, hp->x_coord);
+ set_number_from_subtraction(dyin, hn->y_coord, hp->y_coord);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ set_number_from_subtraction(dxin, hp->y_coord, h->y_coord);
+ set_number_from_subtraction(dyin, h->x_coord, hp->x_coord);
+ }
+ }
+ w0 = h;
+
+ p = c;
+ c0 = c;
+ k_needed = 0;
+ do {
+ q = mp_next_knot(p);
+ mp_knot_info(p) = zero_off + k_needed;
+ k_needed = 0;
+ set_number_from_subtraction(x0, p->right_x, p->x_coord);
+ set_number_from_subtraction(x2, q->x_coord, q->left_x);
+ set_number_from_subtraction(x1, q->left_x, p->right_x);
+ set_number_from_subtraction(y0, p->right_y, p->y_coord);
+ set_number_from_subtraction(y2, q->y_coord, q->left_y);
+ set_number_from_subtraction(y1, q->left_y, p->right_y);
+ {
+
+ mp_number absval;
+ new_number_abs(absval, x1);
+ number_abs_clone(max_coef, x0);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, x2);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, y0);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, y1);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, y2);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ free_number(absval);
+ if (number_zero(max_coef)) {
+ goto NOT_FOUND;
+ }
+ }
+ while (number_less(max_coef, fraction_half_t)) {
+ number_double(max_coef);
+ number_double(x0);
+ number_double(x1);
+ number_double(x2);
+ number_double(y0);
+ number_double(y1);
+ number_double(y2);
+ }
+ number_clone(dx_m, zero_t);
+ number_clone(dy_m, zero_t);
+ number_clone(dx, x0);
+ number_clone(dy, y0);
+ if (number_zero(dx) && number_zero(dy)) {
+ number_clone(dx, x1);
+ number_clone(dy, y1);
+ if (number_zero(dx) && number_zero(dy)) {
+ number_clone(dx, x2);
+ number_clone(dy, y2);
+ }
+ }
+ if (p == c) {
+ number_clone(dx0, dx);
+ number_clone(dy0, dy);
+ }
+ {
+ turn_amt = mp_get_turn_amt(mp, w0, &dx, &dy, ab_vs_cd(dy, dxin, dx, dyin) >= 0);
+ w = mp_pen_walk(mp, w0, turn_amt);
+ w0 = w;
+ mp_knot_info(p) = mp_knot_info(p) + turn_amt;
+ }
+ number_clone(dxin, x2);
+ number_clone(dyin, y2);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ number_clone(dxin, x1);
+ number_clone(dyin, y1);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ number_clone(dxin, x0);
+ number_clone(dyin, y0);
+ }
+ }
+ {
+ int sign = ab_vs_cd(dx, dyin, dxin, dy);
+ if (sign < 0) {
+ d_sign = -1;
+ } else if (sign == 0) {
+ d_sign = 0;
+ } else {
+ d_sign = 1;
+ }
+ }
+ if (d_sign == 0) {
+ {
+ int t;
+ set_number_from_subtraction(u0, q->x_coord, p->x_coord);
+ set_number_from_subtraction(u1, q->y_coord, p->y_coord);
+ t = ab_vs_cd(dx, u1, u0, dy) + ab_vs_cd(u0, dyin, dxin, u1);
+
+ if (t < 0) {
+ d_sign = -1;
+ } else if (t == 0) {
+ d_sign = 0;
+ } else {
+ d_sign = 1;
+ }
+ }
+ }
+ if (d_sign == 0) {
+ if (number_zero(dx)) {
+ d_sign = number_positive(dy) ? 1 : -1;
+ } else {
+ d_sign = number_positive(dx) ? 1 : -1;
+ }
+ }
+ {
+ mp_number r1, r2, arg1;
+ new_number(arg1);
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, x0, y2);
+ take_fraction(r2, x2, y0);
+ number_half(r1);
+ number_half(r2);
+ set_number_from_subtraction(t0, r1, r2);
+ set_number_from_addition(arg1, y0, y2);
+ take_fraction(r1, x1, arg1);
+ set_number_from_addition(arg1, x0, x2);
+
+ take_fraction(r2, y1, arg1);
+ number_half(r1);
+ number_half(r2);
+ set_number_from_subtraction(t1, r1, r2);
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+ }
+ if (number_zero(t0)) {
+ set_number_from_scaled(t0, d_sign);
+ }
+ if (number_positive(t0)) {
+ mp_number arg3;
+ new_number(arg3);
+ number_negated_clone(arg3, t0);
+ crossing_point(t, t0, t1, arg3);
+ free_number(arg3);
+ set_number_from_of_the_way(u0, t, x0, x1);
+ set_number_from_of_the_way(u1, t, x1, x2);
+ set_number_from_of_the_way(v0, t, y0, y1);
+ set_number_from_of_the_way(v1, t, y1, y2);
+ } else {
+ mp_number arg1;
+ new_number(arg1);
+ number_negated_clone(arg1, t0);
+ crossing_point(t, arg1, t1, t0);
+ free_number(arg1);
+ set_number_from_of_the_way(u0, t, x2, x1);
+ set_number_from_of_the_way(u1, t, x1, x0);
+ set_number_from_of_the_way(v0, t, y2, y1);
+ set_number_from_of_the_way(v1, t, y1, y0);
+ }
+ {
+ mp_number tmp1, tmp2, r1, r2, arg1;
+ new_fraction(r1);
+ new_fraction(r2);
+ new_number(arg1);
+ new_number(tmp1);
+ new_number(tmp2);
+ set_number_from_of_the_way(tmp1, t, u0, u1);
+ set_number_from_of_the_way(tmp2, t, v0, v1);
+ set_number_from_addition(arg1, x0, x2);
+ take_fraction(r1, arg1, tmp1);
+ set_number_from_addition(arg1, y0, y2);
+ take_fraction(r2, arg1, tmp2);
+ set_number_from_addition(ss, r1, r2);
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+ free_number(tmp1);
+ free_number(tmp2);
+ }
+ turn_amt = mp_get_turn_amt(mp, w, &dxin, &dyin, (d_sign > 0));
+ if (number_negative(ss)) {
+ turn_amt = turn_amt - d_sign * n;
+ }
+ ww = mp_prev_knot(w);
+ {
+ mp_number abs_du, abs_dv;
+ new_number(abs_du);
+ new_number(abs_dv);
+ set_number_from_subtraction(du, ww->x_coord, w->x_coord);
+ set_number_from_subtraction(dv, ww->y_coord, w->y_coord);
+ number_abs_clone(abs_du, du);
+ number_abs_clone(abs_dv, dv);
+ if (number_greaterequal(abs_du, abs_dv)) {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, dv, du);
+ take_fraction(r1, x0, s);
+ set_number_from_subtraction(t0, r1, y0);
+ take_fraction(r1, x1, s);
+ set_number_from_subtraction(t1, r1, y1);
+ take_fraction(r1, x2, s);
+ set_number_from_subtraction(t2, r1, y2);
+ if (number_negative(du)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, du, dv);
+ take_fraction(r1, y0, s);
+ set_number_from_subtraction(t0, x0, r1);
+ take_fraction(r1, y1, s);
+ set_number_from_subtraction(t1, x1, r1);
+ take_fraction(r1, y2, s);
+ set_number_from_subtraction(t2, x2, r1);
+ if (number_negative(dv)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ }
+ free_number(abs_du);
+ free_number(abs_dv);
+ if (number_negative(t0)) {
+ set_number_to_zero(t0);
+ }
+ }
+ crossing_point(t, t0, t1, t2);
+ if (turn_amt >= 0) {
+ if (number_negative(t2)) {
+ number_clone(t, fraction_one_t);
+ number_add_scaled(t, 1);
+ } else {
+ mp_number tmp, arg1, r1;
+ new_fraction(r1);
+ new_number(tmp);
+ new_number(arg1);
+ set_number_from_of_the_way(u0, t, x0, x1);
+ set_number_from_of_the_way(u1, t, x1, x2);
+ set_number_from_of_the_way(tmp, t, u0, u1);
+ number_negated_clone(arg1, du);
+ take_fraction(ss, arg1, tmp);
+ set_number_from_of_the_way(v0, t, y0, y1);
+ set_number_from_of_the_way(v1, t, y1, y2);
+ set_number_from_of_the_way(tmp, t, v0, v1);
+ number_negated_clone(arg1, dv);
+ take_fraction(r1, arg1, tmp);
+ number_add(ss, r1);
+ free_number(tmp);
+ if (number_negative(ss)) {
+ number_clone(t, fraction_one_t);
+ number_add_scaled(t, 1);
+ }
+ free_number(arg1);
+ free_number(r1);
+ }
+ } else if (number_greater(t, fraction_one_t)) {
+ number_clone(t, fraction_one_t);
+ }
+ if (number_greater(t, fraction_one_t)) {
+ mp_fin_offset_prep(mp, p, w, &x0, &x1, &x2, &y0, &y1, &y2, 1, turn_amt);
+ } else {
+ mp_split_cubic(mp, p, &t);
+ r = mp_next_knot(p);
+ set_number_from_of_the_way(x1a, t, x0, x1);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2a, t, x1a, x1);
+ set_number_from_of_the_way(y1a, t, y0, y1);
+ set_number_from_of_the_way(y1, t, y1, y2);
+ set_number_from_of_the_way(y2a, t, y1a, y1);
+ mp_fin_offset_prep (mp, p, w, &x0, &x1a, &x2a, &y0, &y1a, &y2a, 1, 0);
+ number_clone(x0, x2a);
+ number_clone(y0, y2a);
+ mp_knot_info(r) = zero_off - 1;
+ if (turn_amt >= 0) {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ set_number_from_of_the_way(t1, t, t1, t2);
+ if (number_positive(t1)) {
+ set_number_to_zero(t1);
+ }
+ number_negated_clone(arg2, t1);
+ number_negated_clone(arg3, t2);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ if (number_greater(t, fraction_one_t)) {
+ number_clone(t, fraction_one_t);
+ }
+ mp_split_cubic(mp, r, &t);
+ mp_knot_info(mp_next_knot(r)) = zero_off + 1;
+ set_number_from_of_the_way(x1a, t, x1, x2);
+ set_number_from_of_the_way(x1, t, x0, x1);
+ set_number_from_of_the_way(x0a, t, x1, x1a);
+ set_number_from_of_the_way(y1a, t, y1, y2);
+ set_number_from_of_the_way(y1, t, y0, y1);
+ set_number_from_of_the_way(y0a, t, y1, y1a);
+ mp_fin_offset_prep (mp, mp_next_knot(r), w, &x0a, &x1a, &x2, &y0a, &y1a, &y2, 1, turn_amt);
+ number_clone(x2, x0a);
+ number_clone(y2, y0a);
+
+ mp_fin_offset_prep(mp, r, ww, &x0, &x1, &x2, &y0, &y1, &y2, -1, 0);
+ } else {
+ mp_fin_offset_prep(mp, r, ww, &x0, &x1, &x2, &y0, &y1, &y2, -1, (-1 - turn_amt));
+ }
+ }
+ w0 = mp_pen_walk (mp, w0, turn_amt);
+
+ NOT_FOUND:
+ q0 = q;
+ do {
+ r = mp_next_knot(p);
+ if (r != p && r != q
+ && number_equal(p->x_coord, p->right_x)
+ && number_equal(p->y_coord, p->right_y)
+ && number_equal(p->x_coord, r->left_x)
+ && number_equal(p->y_coord, r->left_y)
+ && number_equal(p->x_coord, r->x_coord)
+ && number_equal(p->y_coord, r->y_coord)) {
+ {
+ k_needed = mp_knot_info(p) - zero_off;
+ if (r == q) {
+ q = p;
+ } else {
+ mp_knot_info(p) = k_needed + mp_knot_info(r);
+ k_needed = 0;
+ }
+ if (r == c) {
+ mp_knot_info(p) = mp_knot_info(c);
+ c = p;
+ }
+ if (r == mp->spec_p1) {
+ mp->spec_p1 = p;
+ }
+ if (r == mp->spec_p2) {
+ mp->spec_p2 = p;
+ }
+ r = p;
+ mp_remove_cubic(mp, p);
+ }
+ }
+ p = r;
+ } while (p != q);
+ if ((q != q0) && (q != c || c == c0)) {
+ q = mp_next_knot(q);
+ }
+ } while (q != c);
+ mp->spec_offset = mp_knot_info(c) - zero_off;
+ if (mp_next_knot(c) == c) {
+ mp_knot_info(c) = zero_off + n;
+ } else {
+ mp_knot_info(c) += k_needed;
+ while (w0 != h) {
+ mp_knot_info(c) += 1;
+ w0 = mp_next_knot(w0);
+ }
+ while (mp_knot_info(c) <= zero_off - n) {
+ mp_knot_info(c) += n;
+ }
+ while (mp_knot_info(c) > zero_off) {
+ mp_knot_info(c) -= n;
+ }
+ ;
+ if ((mp_knot_info(c) != zero_off) && ab_vs_cd(dy0, dxin, dx0, dyin) >= 0) {
+ mp_knot_info(c) += n;
+ }
+ }
+ free_number(ss);
+ free_number(s);
+ free_number(dxin);
+ free_number(dyin);
+ free_number(dx0);
+ free_number(dy0);
+ free_number(x0);
+ free_number(y0);
+ free_number(x1);
+ free_number(y1);
+ free_number(x2);
+ free_number(y2);
+ free_number(max_coef);
+ free_number(du);
+ free_number(dv);
+ free_number(dx);
+ free_number(dy);
+ free_number(x0a);
+ free_number(y0a);
+ free_number(x1a);
+ free_number(y1a);
+ free_number(x2a);
+ free_number(y2a);
+ free_number(t0);
+ free_number(t1);
+ free_number(t2);
+ free_number(u0);
+ free_number(u1);
+ free_number(v0);
+ free_number(v1);
+ free_number(dx_m);
+ free_number(dy_m);
+ free_number(dxin_m);
+ free_number(t);
+ return c;
+}
+
+void mp_split_cubic (MP mp, mp_knot p, mp_number *t)
+{
+ mp_number v;
+ mp_knot q = mp_next_knot(p);
+ mp_knot r = mp_new_knot(mp);
+ mp_prev_knot(r) = p;
+ mp_next_knot(p) = r;
+ mp_prev_knot(q) = r;
+ mp_next_knot(r) = q;
+ mp_originator(r) = mp_program_code;
+ mp_knotstate(r) = mp_regular_knot;
+ mp_left_type(r) = mp_explicit_knot;
+ mp_right_type(r) = mp_explicit_knot;
+ new_number(v);
+ set_number_from_of_the_way(v, *t, p->right_x, q->left_x);
+ set_number_from_of_the_way(p->right_x, *t, p->x_coord, p->right_x);
+ set_number_from_of_the_way(q->left_x, *t, q->left_x, q->x_coord);
+ set_number_from_of_the_way(r->left_x, *t, p->right_x, v);
+ set_number_from_of_the_way(r->right_x, *t, v, q->left_x);
+ set_number_from_of_the_way(r->x_coord, *t, r->left_x, r->right_x);
+ set_number_from_of_the_way(v, *t, p->right_y, q->left_y);
+ set_number_from_of_the_way(p->right_y, *t, p->y_coord, p->right_y);
+ set_number_from_of_the_way(q->left_y, *t, q->left_y, q->y_coord);
+ set_number_from_of_the_way(r->left_y, *t, p->right_y, v);
+ set_number_from_of_the_way(r->right_y, *t, v, q->left_y);
+ set_number_from_of_the_way(r->y_coord, *t, r->left_y, r->right_y);
+ free_number(v);
+}
+
+static mp_knot mp_split_cubic_knot (MP mp, mp_knot p, mp_number *t)
+{
+ mp_number v;
+ mp_knot k = mp_new_knot(mp);
+ mp_knot r = mp_copy_knot(mp, mp_next_knot(p));
+ mp_knot l = mp_copy_knot(mp, p);
+ mp_originator(k) = mp_program_code;
+ mp_knotstate(k) = mp_regular_knot;
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ new_number(v);
+ set_number_from_of_the_way(v, *t, l->right_x, r->left_x);
+ set_number_from_of_the_way(l->right_x, *t, l->x_coord, l->right_x);
+ set_number_from_of_the_way(r->left_x, *t, r->left_x, r->x_coord);
+ set_number_from_of_the_way(k->left_x, *t, l->right_x, v);
+ set_number_from_of_the_way(k->right_x, *t, v, r->left_x);
+ set_number_from_of_the_way(k->x_coord, *t, k->left_x, k->right_x);
+ set_number_from_of_the_way(v, *t, l->right_y, r->left_y);
+ set_number_from_of_the_way(l->right_y, *t, l->y_coord, l->right_y);
+ set_number_from_of_the_way(r->left_y, *t, r->left_y, r->y_coord);
+ set_number_from_of_the_way(k->left_y, *t, l->right_y, v);
+ set_number_from_of_the_way(k->right_y, *t, v, r->left_y);
+ set_number_from_of_the_way(k->y_coord, *t, k->left_y, k->right_y);
+ free_number(v);
+ mp_toss_knot(mp, l);
+ mp_toss_knot(mp, r);
+ return k;
+}
+
+void mp_remove_cubic (MP mp, mp_knot p)
+{
+ mp_knot q = mp_next_knot(p);
+ mp_prev_knot(q) = mp_next_knot(p);
+ mp_next_knot(p) = mp_next_knot(q);
+ number_clone(p->right_x, q->right_x);
+ number_clone(p->right_y, q->right_y);
+ mp_toss_knot(mp, q);
+}
+
+mp_knot mp_pen_walk (MP mp, mp_knot w, int k)
+{
+ (void) mp;
+ while (k > 0) {
+ w = mp_next_knot(w);
+ --k;
+ }
+ while (k < 0) {
+ w = mp_prev_knot(w);
+ ++k;
+ }
+ return w;
+}
+
+void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number *x0, mp_number *x1, mp_number *x2, mp_number *y0, mp_number *y1, mp_number *y2, int rise, int turn_amt)
+{
+ mp_number du, dv;
+ mp_number t0, t1, t2;
+ mp_number t;
+ mp_number s;
+ mp_number v;
+ mp_knot q = mp_next_knot(p);
+ new_number(du);
+ new_number(dv);
+ new_number(v);
+ new_number(t0);
+ new_number(t1);
+ new_number(t2);
+ new_fraction(s);
+ new_fraction(t);
+ while (1) {
+ mp_knot ww = rise > 0 ? mp_next_knot(w) : mp_prev_knot(w);
+ {
+ mp_number abs_du, abs_dv;
+ new_number(abs_du);
+ new_number(abs_dv);
+ set_number_from_subtraction(du, ww->x_coord, w->x_coord);
+ set_number_from_subtraction(dv, ww->y_coord, w->y_coord);
+ number_abs_clone(abs_du, du);
+ number_abs_clone(abs_dv, dv);
+ if (number_greaterequal(abs_du, abs_dv)) {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, dv, du);
+ take_fraction(r1, *x0, s);
+ set_number_from_subtraction(t0, r1, *y0);
+ take_fraction(r1, *x1, s);
+ set_number_from_subtraction(t1, r1, *y1);
+ take_fraction(r1, *x2, s);
+ set_number_from_subtraction(t2, r1, *y2);
+ if (number_negative(du)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, du, dv);
+ take_fraction(r1, *y0, s);
+ set_number_from_subtraction(t0, *x0, r1);
+ take_fraction(r1, *y1, s);
+ set_number_from_subtraction(t1, *x1, r1);
+ take_fraction(r1, *y2, s);
+ set_number_from_subtraction(t2, *x2, r1);
+ if (number_negative(dv)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ }
+ free_number(abs_du);
+ free_number(abs_dv);
+ if (number_negative(t0)) {
+ set_number_to_zero(t0);
+ }
+ }
+ crossing_point(t, t0, t1, t2);
+ if (number_greaterequal(t, fraction_one_t)) {
+ if (turn_amt > 0) {
+ number_clone(t, fraction_one_t);
+ } else {
+ goto RETURN;
+ }
+ }
+ {
+ mp_split_cubic(mp, p, &t);
+ p = mp_next_knot(p);
+ mp_knot_info(p) = zero_off + rise;
+ --turn_amt;
+ set_number_from_of_the_way(v, t, *x0, *x1);
+ set_number_from_of_the_way(*x1, t, *x1, *x2);
+ set_number_from_of_the_way(*x0, t, v, *x1);
+ set_number_from_of_the_way(v, t, *y0, *y1);
+ set_number_from_of_the_way(*y1, t, *y1, *y2);
+ set_number_from_of_the_way(*y0, t, v, *y1);
+ if (turn_amt < 0) {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ set_number_from_of_the_way(t1, t, t1, t2);
+ if (number_positive(t1)) {
+ set_number_to_zero(t1);
+ }
+ number_negated_clone(arg2, t1);
+ number_negated_clone(arg3, t2);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ if (number_greater(t, fraction_one_t)) {
+ number_clone(t, fraction_one_t);
+ }
+ ++turn_amt;
+ if (number_equal(t,fraction_one_t) && (mp_next_knot(p) != q)) {
+ mp_knot_info(mp_next_knot(p)) = mp_knot_info(mp_next_knot(p)) - rise;
+ } else {
+ mp_split_cubic(mp, p, &t);
+ mp_knot_info(mp_next_knot(p)) = zero_off - rise;
+ set_number_from_of_the_way(v, t, *x1, *x2);
+ set_number_from_of_the_way(*x1, t, *x0, *x1);
+ set_number_from_of_the_way(*x2, t, *x1, v);
+ set_number_from_of_the_way(v, t, *y1, *y2);
+ set_number_from_of_the_way(*y1, t, *y0, *y1);
+ set_number_from_of_the_way(*y2, t, *y1, v);
+ }
+ }
+ }
+ w = ww;
+ }
+ RETURN:
+ free_number(s);
+ free_number(t);
+ free_number(du);
+ free_number(dv);
+ free_number(v);
+ free_number(t0);
+ free_number(t1);
+ free_number(t2);
+}
+
+int mp_get_turn_amt (MP mp, mp_knot w, mp_number *dx, mp_number *dy, int ccw)
+{
+ int s = 0;
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ if (ccw) {
+ int t;
+ mp_knot ww = mp_next_knot(w);
+ do {
+ set_number_from_subtraction(arg1, ww->x_coord, w->x_coord);
+ set_number_from_subtraction(arg2, ww->y_coord, w->y_coord);
+ t = ab_vs_cd(*dy, arg1, *dx, arg2);
+ if (t < 0) {
+ break;
+ } else {
+ ++s;
+ w = ww;
+ ww = mp_next_knot(ww);
+ }
+ } while (t > 0);
+ } else {
+ mp_knot ww = mp_prev_knot(w);
+ set_number_from_subtraction(arg1, w->x_coord, ww->x_coord);
+ set_number_from_subtraction(arg2, w->y_coord, ww->y_coord);
+ while (ab_vs_cd(*dy, arg1, *dx, arg2) < 0) {
+ --s;
+ w = ww;
+ ww = mp_prev_knot(ww);
+ set_number_from_subtraction(arg1, w->x_coord, ww->x_coord);
+ set_number_from_subtraction(arg2, w->y_coord, ww->y_coord);
+ }
+ }
+ free_number(arg1);
+ free_number(arg2);
+ return s;
+}
+
+static void mp_print_spec (MP mp, mp_knot cur_spec, mp_knot cur_pen, const char *s)
+{
+ mp_knot w;
+ mp_knot p = cur_spec;
+ mp_print_diagnostic(mp, "Envelope spec", s, 1);
+ w = mp_pen_walk(mp, cur_pen, mp->spec_offset);
+ mp_print_ln(mp);
+ mp_print_two(mp, &(cur_spec->x_coord), &(cur_spec->y_coord));
+ mp_print_str(mp, " % beginning with offset ");
+ mp_print_two(mp, &(w->x_coord), &(w->y_coord));
+ do {
+ while (1) {
+ mp_knot q = mp_next_knot(p);
+ mp_print_nl(mp, " .. controls ");
+ mp_print_two(mp, &(p->right_x), &(p->right_y));
+ mp_print_str(mp, " and ");
+ mp_print_two(mp, &(q->left_x), &(q->left_y));
+ mp_print_nl(mp, " .. ");
+ mp_print_two(mp, &(q->x_coord), &(q->y_coord));
+
+ p = q;
+ if ((p == cur_spec) || (mp_knot_info(p) != zero_off)) {
+ break;
+ }
+ }
+ if (mp_knot_info(p) != zero_off) {
+ w = mp_pen_walk (mp, w, (mp_knot_info(p) - zero_off));
+ mp_print_str(mp, " % ");
+ if (mp_knot_info(p) > zero_off) {
+ mp_print_str(mp, "counter");
+ }
+ mp_print_str(mp, "clockwise to offset ");
+ mp_print_two(mp, &(w->x_coord), &(w->y_coord));
+ }
+ } while (p != cur_spec);
+ mp_print_nl(mp, " & cycle");
+ mp_end_diagnostic(mp, 1);
+}
+
+static mp_knot mp_make_envelope (MP mp, mp_knot c, mp_knot h, int linejoin, int linecap, mp_number *miterlimit)
+{
+ mp_knot p, q, r, q0;
+ mp_knot w, w0;
+ int k, k0;
+ mp_number qx, qy;
+ mp_fraction dxin, dyin, dxout, dyout;
+ int join_type = 0;
+ mp_number tmp;
+ mp_number max_ht;
+ int kk;
+ mp_knot ww;
+
+ new_number(max_ht);
+ new_number(tmp);
+ new_fraction(dxin);
+ new_fraction(dyin);
+ new_fraction(dxout);
+ new_fraction(dyout);
+ mp->spec_p1 = NULL;
+ mp->spec_p2 = NULL;
+ new_number(qx);
+ new_number(qy);
+ if (mp_left_type(c) == mp_endpoint_knot) {
+ mp->spec_p1 = mp_htap_ypoc(mp, c);
+ mp->spec_p2 = mp->path_tail;
+ mp_originator(mp->spec_p1) = mp_program_code;
+ mp_knotstate(mp->spec_p1) = mp_regular_knot;
+ mp_prev_knot(mp->spec_p1) = mp_next_knot(mp->spec_p2);
+ mp_next_knot(mp->spec_p2) = mp_next_knot(mp->spec_p1);
+ mp_prev_knot(c) = mp->spec_p1;
+ mp_next_knot(mp->spec_p1) = c;
+ mp_remove_cubic(mp, mp->spec_p1);
+ c = mp->spec_p1;
+ if (c != mp_next_knot(c)) {
+ mp_originator(mp->spec_p2) = mp_program_code;
+ mp_knotstate(mp->spec_p2) = mp_regular_knot;
+ mp_remove_cubic(mp, mp->spec_p2);
+ } else {
+ mp_left_type(c) = mp_explicit_knot;
+ mp_right_type(c) = mp_explicit_knot;
+ number_clone(c->left_x, c->x_coord);
+ number_clone(c->left_y, c->y_coord);
+ number_clone(c->right_x, c->x_coord);
+ number_clone(c->right_y, c->y_coord);
+ }
+ }
+ c = mp_offset_prep (mp, c, h);
+ if (number_positive(internal_value(mp_tracing_specs_internal))) {
+ mp_print_spec(mp, c, h, "");
+ }
+ h = mp_pen_walk (mp, h, mp->spec_offset);
+
+ w = h;
+ p = c;
+ do {
+ q = mp_next_knot(p);
+ q0 = q;
+ number_clone(qx, q->x_coord);
+ number_clone(qy, q->y_coord);
+ k = mp_knot_info(q);
+ k0 = k;
+ w0 = w;
+ if (k != zero_off) {
+ if (k < zero_off) {
+ join_type = 2;
+ } else {
+ if ((q != mp->spec_p1) && (q != mp->spec_p2)) {
+ join_type = linejoin;
+ } else if (linecap == mp_squared_linecap_code) {
+ join_type = 3;
+ } else {
+ join_type = 2 - linecap;
+ }
+ if ((join_type == 0) || (join_type == 3)) {
+ set_number_from_subtraction(dxin, q->x_coord, q->left_x);
+ set_number_from_subtraction(dyin, q->y_coord, q->left_y);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ set_number_from_subtraction(dxin, q->x_coord, p->right_x);
+ set_number_from_subtraction(dyin, q->y_coord, p->right_y);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ set_number_from_subtraction(dxin, q->x_coord, p->x_coord);
+ set_number_from_subtraction(dyin, q->y_coord, p->y_coord);
+ if (p != c) {
+ number_add(dxin, w->x_coord);
+ number_add(dyin, w->y_coord);
+ }
+ }
+ }
+ pyth_add(tmp, dxin, dyin);
+ if (number_zero(tmp)) {
+ join_type = 2;
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, dxin, tmp);
+ number_clone(dxin, r1);
+ make_fraction(r1, dyin, tmp);
+ number_clone(dyin, r1);
+ free_number(r1);
+ set_number_from_subtraction(dxout, q->right_x, q->x_coord);
+ set_number_from_subtraction(dyout, q->right_y, q->y_coord);
+ if (number_zero(dxout) && number_zero(dyout)) {
+ r = mp_next_knot(q);
+ set_number_from_subtraction(dxout, r->left_x, q->x_coord);
+ set_number_from_subtraction(dyout, r->left_y, q->y_coord);
+ if (number_zero(dxout) && number_zero(dyout)) {
+ set_number_from_subtraction(dxout, r->x_coord, q->x_coord);
+ set_number_from_subtraction(dyout, r->y_coord, q->y_coord);
+ }
+ }
+ if (q == c) {
+ number_subtract(dxout, h->x_coord);
+ number_subtract(dyout, h->y_coord);
+ }
+ pyth_add(tmp, dxout, dyout);
+ if (number_zero(tmp)) {
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, dxout, tmp);
+ number_clone(dxout, r1);
+ make_fraction(r1, dyout, tmp);
+ number_clone(dyout, r1);
+ free_number(r1);
+ }
+ }
+ if (join_type == 0) {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, dxin, dxout);
+ take_fraction(r2, dyin, dyout);
+ number_add(r1, r2);
+ number_half(r1);
+ number_add(r1, fraction_half_t);
+ take_fraction(tmp, *miterlimit, r1);
+ if (number_less(tmp, unity_t)) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, *miterlimit, tmp);
+ if (number_less(ret, unity_t)) {
+ join_type = 2;
+ }
+ free_number(ret);
+ }
+ free_number(r1);
+ free_number(r2);
+ }
+ }
+ }
+ }
+ number_add(p->right_x, w->x_coord);
+ number_add(p->right_y, w->y_coord);
+ number_add(q->left_x, w->x_coord);
+ number_add(q->left_y, w->y_coord);
+ number_add(q->x_coord, w->x_coord);
+ number_add(q->y_coord, w->y_coord);
+ mp_left_type(q) = mp_explicit_knot;
+ mp_right_type(q) = mp_explicit_knot;
+
+ while (k != zero_off) {
+ if (k > zero_off) {
+ w = mp_next_knot(w);
+ --k;
+ } else {
+ w = mp_prev_knot(w);
+ ++k;
+ }
+ if ((join_type == 1) || (k == zero_off)) {
+ mp_number xtot, ytot;
+ new_number(xtot);
+ new_number(ytot);
+ set_number_from_addition(xtot, qx, w->x_coord);
+ set_number_from_addition(ytot, qy, w->y_coord);
+ q = mp_insert_knot(mp, q, &xtot, &ytot);
+ free_number(xtot);
+ free_number(ytot);
+ }
+ }
+ if (q != mp_next_knot(p)) {
+ p = mp_next_knot(p);
+ if ((join_type == 0) || (join_type == 3)) {
+ if (join_type == 0) {
+ mp_number det;
+ mp_number absdet;
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ new_fraction(det);
+ new_fraction(absdet);
+ take_fraction(r1, dyout, dxin);
+ take_fraction(r2, dxout, dyin);
+ set_number_from_subtraction(det, r1, r2);
+ number_abs_clone(absdet, det);
+ if (number_less(absdet, near_zero_angle_k)) {
+ r = NULL;
+ } else {
+ mp_number xtot, ytot, xsub, ysub;
+ new_fraction(xsub);
+ new_fraction(ysub);
+ new_number(xtot);
+ new_number(ytot);
+ set_number_from_subtraction(tmp, q->x_coord, p->x_coord);
+ take_fraction(r1, tmp, dyout);
+ set_number_from_subtraction(tmp, q->y_coord, p->y_coord);
+ take_fraction(r2, tmp, dxout);
+ set_number_from_subtraction(tmp, r1, r2);
+ make_fraction(r1, tmp, det);
+ number_clone(tmp, r1);
+ take_fraction(xsub, tmp, dxin);
+ take_fraction(ysub, tmp, dyin);
+ set_number_from_addition(xtot, p->x_coord, xsub);
+ set_number_from_addition(ytot, p->y_coord, ysub);
+ r = mp_insert_knot(mp, p, &xtot, &ytot);
+ free_number(xtot);
+ free_number(ytot);
+ free_number(xsub);
+ free_number(ysub);
+ }
+ free_number(r1);
+ free_number(r2);
+ free_number(det);
+ free_number(absdet);
+ } else {
+ mp_number ht_x, ht_y;
+ mp_number ht_x_abs, ht_y_abs;
+ mp_number xtot, ytot, xsub, ysub;
+ new_fraction(xsub);
+ new_fraction(ysub);
+ new_number(xtot);
+ new_number(ytot);
+ new_fraction(ht_x);
+ new_fraction(ht_y);
+ new_fraction(ht_x_abs);
+ new_fraction(ht_y_abs);
+ set_number_from_subtraction(ht_x, w->y_coord, w0->y_coord);
+ set_number_from_subtraction(ht_y, w0->x_coord, w->x_coord);
+ number_abs_clone(ht_x_abs, ht_x);
+ number_abs_clone(ht_y_abs, ht_y);
+ while (number_less(ht_x_abs, fraction_half_t) && number_less(ht_y_abs, fraction_half_t)) {
+ number_double(ht_x);
+ number_double(ht_y);
+ number_abs_clone(ht_x_abs, ht_x);
+ number_abs_clone(ht_y_abs, ht_y);
+ }
+ set_number_to_zero(max_ht);
+ kk = zero_off;
+ ww = w;
+ while (1) {
+ if (kk > k0) {
+ ww = mp_next_knot(ww);
+ --kk;
+ } else {
+ ww = mp_prev_knot(ww);
+ ++kk;
+ }
+ if (kk == k0) {
+ break;
+ } else {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ set_number_from_subtraction(tmp, ww->x_coord, w0->x_coord);
+ take_fraction(r1, tmp, ht_x);
+ set_number_from_subtraction(tmp, ww->y_coord, w0->y_coord);
+ take_fraction(r2, tmp, ht_y);
+ set_number_from_addition(tmp, r1, r2);
+ free_number(r1);
+ free_number(r2);
+ if (number_greater(tmp, max_ht)) {
+ number_clone(max_ht, tmp);
+ }
+ }
+ }
+ {
+ mp_number r1 ,r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, dxin, ht_x);
+ take_fraction(r2, dyin, ht_y);
+ number_add(r1, r2);
+ make_fraction(tmp, max_ht, r1);
+ free_number(r1);
+ free_number(r2);
+ }
+ take_fraction(xsub, tmp, dxin);
+ take_fraction(ysub, tmp, dyin);
+ set_number_from_addition(xtot, p->x_coord, xsub);
+ set_number_from_addition(ytot, p->y_coord, ysub);
+ r = mp_insert_knot(mp, p, &xtot, &ytot);
+ {
+ mp_number r1 ,r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, dxout, ht_x);
+ take_fraction(r2, dyout, ht_y);
+ number_add(r1, r2);
+ make_fraction(tmp, max_ht, r1);
+ free_number(r1);
+ free_number(r2);
+ }
+ take_fraction(xsub, tmp, dxout);
+ take_fraction(ysub, tmp, dyout);
+ set_number_from_addition(xtot, q->x_coord, xsub);
+ set_number_from_addition(ytot, q->y_coord, ysub);
+ r = mp_insert_knot(mp, r, &xtot, &ytot);
+ free_number(xsub);
+ free_number(ysub);
+ free_number(xtot);
+ free_number(ytot);
+ free_number(ht_x);
+ free_number(ht_y);
+ free_number(ht_x_abs);
+ free_number(ht_y_abs);
+ }
+ if (r != NULL) {
+ number_clone(r->right_x, r->x_coord);
+ number_clone(r->right_y, r->y_coord);
+ }
+ }
+ }
+ p = q;
+ } while (q0 != c);
+ free_number(max_ht);
+ free_number(tmp);
+ free_number(qx);
+ free_number(qy);
+ free_number(dxin);
+ free_number(dyin);
+ free_number(dxout);
+ free_number(dyout);
+ return c;
+}
+
+mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number *x, mp_number *y)
+{
+ mp_knot r = mp_new_knot(mp);
+ mp_knot n = mp_next_knot(q);
+ mp_next_knot(r) = n;
+ mp_prev_knot(n) = r;
+ mp_prev_knot(r) = q;
+ mp_next_knot(q) = r;
+ number_clone(r->right_x, q->right_x);
+ number_clone(r->right_y, q->right_y);
+ number_clone(r->x_coord, *x);
+ number_clone(r->y_coord, *y);
+ number_clone(q->right_x, q->x_coord);
+ number_clone(q->right_y, q->y_coord);
+ number_clone(r->left_x, r->x_coord);
+ number_clone(r->left_y, r->y_coord);
+ mp_left_type(r) = mp_explicit_knot;
+ mp_right_type(r) = mp_explicit_knot;
+ mp_originator(r) = mp_program_code;
+ mp_knotstate(r) = mp_regular_knot;
+ return r;
+}
+
+static void mp_find_direction_time (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig, mp_knot h)
+{
+ mp_number max;
+ mp_knot p, q;
+ mp_number n;
+ mp_number tt;
+ mp_number abs_x, abs_y;
+ mp_number x1, x2, x3, y1, y2, y3;
+ mp_number phi;
+ mp_number t;
+ mp_number x, y;
+ new_number(max);
+ new_number(x1);
+ new_number(x2);
+ new_number(x3);
+ new_number(y1);
+ new_number(y2);
+ new_number(y3);
+ new_fraction(t);
+ new_angle(phi);
+ set_number_to_zero(*ret);
+ new_number(x);
+ new_number(y);
+ new_number(abs_x);
+ new_number(abs_y);
+ new_number(n);
+ new_fraction(tt);
+ number_clone(x, *x_orig);
+ number_clone(y, *y_orig);
+ number_abs_clone(abs_x, *x_orig);
+ number_abs_clone(abs_y, *y_orig);
+ if (number_less(abs_x, abs_y)) {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, x, abs_y);
+ number_clone(x, r1);
+ free_number(r1);
+ if (number_positive(y)) {
+ number_clone(y, fraction_one_t);
+ } else {
+ number_negated_clone(y, fraction_one_t);
+ }
+ } else if (number_zero(x)) {
+ goto FREE;
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, y, abs_x);
+ number_clone(y, r1);
+ free_number(r1);
+ if (number_positive(x)) {
+ number_clone(x, fraction_one_t);
+ } else {
+ number_negated_clone(x, fraction_one_t);
+ }
+ }
+ p = h;
+ while (1) {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ break;
+ } else {
+ q = mp_next_knot(p);
+ set_number_to_zero(tt);
+ {
+ mp_number absval;
+ new_number(absval);
+ set_number_from_subtraction(x1, p->right_x, p->x_coord);
+ set_number_from_subtraction(x2, q->left_x, p->right_x);
+ set_number_from_subtraction(x3, q->x_coord, q->left_x);
+ set_number_from_subtraction(y1, p->right_y, p->y_coord);
+ set_number_from_subtraction(y2, q->left_y, p->right_y);
+ set_number_from_subtraction(y3, q->y_coord, q->left_y);
+ number_abs_clone(absval, x2);
+ number_abs_clone(max, x1);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, x3);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, y1);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, y2);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, y3);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ free_number(absval);
+ if (number_zero(max)) {
+ goto FOUND;
+ }
+ while (number_less(max, fraction_half_t)) {
+ number_double(max);
+ number_double(x1);
+ number_double(x2);
+ number_double(x3);
+ number_double(y1);
+ number_double(y2);
+ number_double(y3);
+ }
+ number_clone(t, x1);
+ {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, x1, x);
+ take_fraction(r2, y1, y);
+ set_number_from_addition(x1, r1, r2);
+ take_fraction(r1, y1, x);
+ take_fraction(r2, t, y);
+ set_number_from_subtraction(y1, r1, r2);
+ number_clone(t, x2);
+ take_fraction(r1, x2, x);
+ take_fraction(r2, y2, y);
+ set_number_from_addition(x2, r1, r2);
+ take_fraction(r1, y2, x);
+ take_fraction(r2, t, y);
+ set_number_from_subtraction(y2, r1, r2);
+ number_clone(t, x3);
+ take_fraction(r1, x3 ,x);
+ take_fraction(r2, y3, y);
+ set_number_from_addition(x3, r1, r2);
+ take_fraction(r1, y3, x);
+ take_fraction(r2, t, y);
+ set_number_from_subtraction(y3, r1, r2);
+ free_number(r1);
+ free_number(r2);
+ }
+ }
+ if (number_zero(y1) && (number_zero(x1) || number_positive(x1))) {
+ goto FOUND;
+ }
+ if (number_positive(n)) {
+ mp_number theta;
+ mp_number tmp;
+ new_angle(theta);
+ n_arg(theta, x1, y1);
+ new_angle(tmp);
+ set_number_from_subtraction(tmp, theta, one_eighty_deg_t);
+ if (number_nonnegative(theta) && number_nonpositive(phi) && number_greaterequal(phi, tmp)) {
+ free_number(tmp);
+ free_number(theta);
+ goto FOUND;
+ }
+ set_number_from_addition(tmp, theta, one_eighty_deg_t);
+ if (number_nonpositive(theta) && number_nonnegative(phi) && number_lessequal(phi, tmp)) {
+ free_number(tmp);
+ free_number(theta);
+ goto FOUND;
+ }
+ free_number(tmp);
+ free_number(theta);
+ if (p == h) {
+ break;
+ }
+ }
+ if (number_nonzero(x3) || number_nonzero(y3)) {
+ n_arg(phi, x3, y3);
+ }
+ if (number_negative(x1) && number_negative(x2) && number_negative(x3)) {
+ goto DONE;
+ }
+ {
+ if (ab_vs_cd(y1, y3, y2, y2) == 0) {
+ {
+ if (ab_vs_cd(y1, y2, zero_t, zero_t) < 0) {
+ mp_number tmp, arg2;
+ new_number(tmp);
+ new_number(arg2);
+ set_number_from_subtraction(arg2, y1, y2);
+ make_fraction(t, y1, arg2);
+ free_number(arg2);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2, t, x2, x3);
+ set_number_from_of_the_way(tmp, t, x1, x2);
+ if (number_zero(tmp) || number_positive(tmp)) {
+ free_number(tmp);
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ } else {
+ free_number(tmp);
+ }
+ } else if (number_zero(y3)) {
+ if (number_zero(y1)) {
+ {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ number_negated_clone(arg1, x1);
+ number_negated_clone(arg2, x2);
+ number_negated_clone(arg3, x3);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ if (number_lessequal(t, fraction_one_t)) {
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ } else if (ab_vs_cd(x1, x3, x2, x2) <= 0) {
+ mp_number arg2;
+ new_number(arg2);
+ set_number_from_subtraction(arg2, x1, x2);
+ make_fraction(t, x1, arg2);
+ free_number(arg2);
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ }
+ }
+ } else if (number_zero(x3) || number_positive(x3)) {
+ set_number_to_unity(tt);
+ goto FOUND;
+ }
+ }
+ goto DONE;
+ }
+ }
+ }
+ if (number_zero(y1) || number_negative(y1)) {
+ if (number_negative(y1)) {
+ number_negate(y1);
+ number_negate(y2);
+ number_negate(y3);
+ } else if (number_positive(y2)) {
+ number_negate(y2);
+ number_negate(y3);
+ }
+ }
+ crossing_point(t, y1, y2, y3);
+ if (number_greater(t, fraction_one_t)) {
+ goto DONE;
+ }
+ set_number_from_of_the_way(y2, t, y2, y3);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2, t, x2, x3);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ if (number_zero(x1) || number_positive(x1)) {
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ }
+ if (number_positive(y2)) {
+ set_number_to_zero(y2);
+ }
+ number_clone(tt, t);
+ {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ number_negated_clone(arg2, y2);
+ number_negated_clone(arg3, y3);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ }
+ if (number_greater(t, fraction_one_t)) {
+ goto DONE;
+ } else {
+ mp_number tmp;
+ new_number(tmp);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2, t, x2, x3);
+ set_number_from_of_the_way(tmp, t, x1, x2);
+ if (number_nonnegative(tmp)) {
+ free_number(tmp);
+ set_number_from_of_the_way(t, t, tt, fraction_one_t);
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ }
+ free_number(tmp);
+ }
+ DONE:
+ p = q;
+ number_add(n, unity_t);
+ }
+ }
+ set_number_to_unity(*ret);
+ number_negate(*ret);
+ goto FREE;
+ FOUND:
+ set_number_from_addition(*ret, n, tt);
+ goto FREE;
+ FREE:
+ free_number(x);
+ free_number(y);
+ free_number(abs_x);
+ free_number(abs_y);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ free_number(y1);
+ free_number(y2);
+ free_number(y3);
+ free_number(t);
+ free_number(phi);
+ free_number(n);
+ free_number(max);
+ free_number(tt);
+}
+
+void mp_set_min_max (MP mp, int v)
+{
+ if (number_negative(stack_1(v))) {
+ if (number_nonnegative (stack_3(v))) {
+ if (number_negative(stack_2(v))) {
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ } else {
+ number_clone(stack_min(v), stack_1(v));
+ }
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ number_add(stack_max(v), stack_3(v));
+ if (number_negative(stack_max(v))) {
+ set_number_to_zero(stack_max(v));
+ }
+ } else {
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ number_add(stack_min(v), stack_3(v));
+ if (number_greater(stack_min(v), stack_1(v))) {
+ number_clone(stack_min(v), stack_1(v));
+ }
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ if (number_negative(stack_max(v))) {
+ set_number_to_zero(stack_max(v));
+ }
+ }
+ } else if (number_nonpositive(stack_3(v))) {
+ if (number_positive(stack_2(v))) {
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ } else {
+ number_clone(stack_max(v), stack_1(v));
+ }
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ number_add(stack_min(v), stack_3(v));
+ if (number_positive(stack_min(v))) {
+ set_number_to_zero(stack_min(v));
+ }
+ } else {
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ number_add(stack_max(v), stack_3(v));
+ if (number_less(stack_max(v), stack_1(v))) {
+ number_clone(stack_max(v), stack_1(v));
+ }
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ if (number_positive(stack_min(v))) {
+ set_number_to_zero(stack_min(v));
+ }
+ }
+}
+
+static int mp_cubic_intersection(MP mp, mp_knot p, mp_knot pp, int run)
+{
+ mp_knot q, qq;
+ mp_number x_two_t;
+ mp_number x_two_t_low_precision;
+ mp->time_to_go = max_patience;
+ set_number_from_scaled(mp->max_t, 2);
+ new_number_clone(x_two_t, two_t);
+ new_number(x_two_t_low_precision);
+ number_double(x_two_t);
+ number_double(x_two_t);
+ set_number_from_double(x_two_t_low_precision, -0.5);
+ number_add(x_two_t_low_precision, x_two_t);
+ q = mp_next_knot(p);
+ qq = mp_next_knot(pp);
+ mp->bisect_ptr = int_packets;
+ set_number_from_subtraction(u1r, p->right_x, p->x_coord);
+ set_number_from_subtraction(u2r, q->left_x, p->right_x);
+ set_number_from_subtraction(u3r, q->x_coord, q->left_x);
+ mp_set_min_max(mp, ur_packet);
+ set_number_from_subtraction(v1r, p->right_y, p->y_coord);
+ set_number_from_subtraction(v2r, q->left_y, p->right_y);
+ set_number_from_subtraction(v3r, q->y_coord, q->left_y);
+ mp_set_min_max(mp, vr_packet);
+ set_number_from_subtraction(x1r, pp->right_x, pp->x_coord);
+ set_number_from_subtraction(x2r, qq->left_x, pp->right_x);
+ set_number_from_subtraction(x3r, qq->x_coord, qq->left_x);
+ mp_set_min_max(mp, xr_packet);
+ set_number_from_subtraction(y1r, pp->right_y, pp->y_coord);
+ set_number_from_subtraction(y2r, qq->left_y, pp->right_y);
+ set_number_from_subtraction(y3r, qq->y_coord, qq->left_y);
+ mp_set_min_max(mp, yr_packet);
+ set_number_from_subtraction(mp->delx, p->x_coord, pp->x_coord);
+ set_number_from_subtraction(mp->dely, p->y_coord, pp->y_coord);
+ mp->tol = 0;
+ mp->uv = r_packets;
+ mp->xy = r_packets;
+ mp->three_l = 0;
+ set_number_from_scaled(mp->cur_t, 1);
+ set_number_from_scaled(mp->cur_tt, 1);
+
+ CONTINUE:
+ while (1) {
+ if (((x_packet (mp->xy))+4)>bistack_size
+ || ((u_packet (mp->uv))+4)>bistack_size
+ || ((y_packet (mp->xy))+4)>bistack_size
+ || ((v_packet (mp->uv))+4)>bistack_size){
+ set_number_from_scaled(mp->cur_t,1);
+ set_number_from_scaled(mp->cur_tt,1);
+ goto NOT_FOUND;
+ }
+ if (number_greater(mp->max_t, x_two_t)){
+ set_number_from_scaled(mp->cur_t,1);
+ set_number_from_scaled(mp->cur_tt,1);
+ goto NOT_FOUND;
+ }
+ if (number_to_scaled(mp->delx) - mp->tol <= number_to_scaled(stack_max (x_packet (mp->xy))) - number_to_scaled(stack_min (u_packet (mp->uv)))) {
+ if (number_to_scaled(mp->delx) + mp->tol >= number_to_scaled(stack_min (x_packet (mp->xy))) - number_to_scaled(stack_max (u_packet (mp->uv)))) {
+ if (number_to_scaled(mp->dely) - mp->tol <= number_to_scaled(stack_max (y_packet (mp->xy))) - number_to_scaled(stack_min (v_packet (mp->uv)))) {
+ if (number_to_scaled(mp->dely) + mp->tol >= number_to_scaled(stack_min (y_packet (mp->xy))) - number_to_scaled(stack_max (v_packet (mp->uv)))) {
+ if (number_to_scaled(mp->cur_t) >= number_to_scaled(mp->max_t)) {
+ if (number_equal(mp->max_t, x_two_t) || number_greater(mp->max_t, x_two_t_low_precision)) {
+ if (run == 1) {
+ number_divide_int(mp->cur_t,1<<2);
+ number_divide_int(mp->cur_tt,1<<2);
+ set_number_from_scaled(mp->cur_t, ((number_to_scaled(mp->cur_t) + 1)/2));
+ set_number_from_scaled(mp->cur_tt, ((number_to_scaled(mp->cur_tt) + 1)/2));
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+ return 1;
+ } else {
+ run--;
+ goto NOT_FOUND;
+ }
+ }
+ number_double(mp->max_t);
+ number_clone(mp->appr_t, mp->cur_t);
+ number_clone(mp->appr_tt, mp->cur_tt);
+ }
+ number_clone(stack_dx, mp->delx);
+ number_clone(stack_dy, mp->dely);
+ set_number_from_scaled(stack_tol, mp->tol);
+ set_number_from_scaled(stack_uv, mp->uv);
+ set_number_from_scaled(stack_xy, mp->xy);
+ mp->bisect_ptr = mp->bisect_ptr + int_increment;
+ number_double(mp->cur_t);
+ number_double(mp->cur_tt);
+ number_clone(u1l, stack_1(u_packet (mp->uv)));
+ number_clone(u3r, stack_3(u_packet (mp->uv)));
+ set_number_half_from_addition(u2l, u1l, stack_2(u_packet(mp->uv)));
+ set_number_half_from_addition(u2r, u3r, stack_2(u_packet(mp->uv)));
+ set_number_half_from_addition(u3l, u2l, u2r);
+ number_clone(u1r, u3l);
+ mp_set_min_max(mp, ul_packet);
+ mp_set_min_max(mp, ur_packet);
+ number_clone(v1l, stack_1(v_packet (mp->uv)));
+ number_clone(v3r, stack_3(v_packet (mp->uv)));
+ set_number_half_from_addition(v2l, v1l, stack_2(v_packet(mp->uv)));
+ set_number_half_from_addition(v2r, v3r, stack_2(v_packet(mp->uv)));
+ set_number_half_from_addition(v3l, v2l, v2r);
+ number_clone(v1r, v3l);
+ mp_set_min_max(mp, vl_packet);
+ mp_set_min_max(mp, vr_packet);
+ number_clone(x1l, stack_1(x_packet (mp->xy)));
+ number_clone(x3r, stack_3(x_packet (mp->xy)));
+ set_number_half_from_addition(x2l, x1l, stack_2(x_packet(mp->xy)));
+ set_number_half_from_addition(x2r, x3r, stack_2(x_packet(mp->xy)));
+ set_number_half_from_addition(x3l, x2l, x2r);
+ number_clone(x1r, x3l);
+ mp_set_min_max(mp, xl_packet);
+ mp_set_min_max(mp, xr_packet);
+ number_clone(y1l, stack_1(y_packet (mp->xy)));
+ number_clone(y3r, stack_3(y_packet (mp->xy)));
+ set_number_half_from_addition(y2l, y1l, stack_2(y_packet(mp->xy)));
+ set_number_half_from_addition(y2r, y3r, stack_2(y_packet(mp->xy)));
+ set_number_half_from_addition(y3l, y2l, y2r);
+ number_clone(y1r, y3l);
+ mp_set_min_max(mp, yl_packet);
+ mp_set_min_max(mp, yr_packet);
+ mp->uv = l_packets;
+ mp->xy = l_packets;
+ number_double(mp->delx);
+ number_double(mp->dely);
+ mp->tol = mp->tol - mp->three_l + (int) mp->tol_step;
+ mp->tol += mp->tol;
+ mp->three_l = mp->three_l + (int) mp->tol_step;
+
+ goto CONTINUE;
+ }
+ }
+ }
+ }
+ if (mp->time_to_go > 0) {
+ --mp->time_to_go;
+ } else {
+ number_divide_int(mp->appr_t, 1<<2);
+ number_divide_int(mp->appr_tt, 1<<2);
+ while (number_less(mp->appr_t, unity_t)) {
+ number_double(mp->appr_t);
+ number_double(mp->appr_tt);
+ }
+ number_clone(mp->cur_t, mp->appr_t);
+ number_clone(mp->cur_tt, mp->appr_tt);
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+ return 2;
+ }
+ NOT_FOUND:
+ if (odd(number_to_scaled(mp->cur_tt))) {
+
+ if (odd(number_to_scaled(mp->cur_t))) {
+
+ set_number_from_scaled(mp->cur_t, half (number_to_scaled(mp->cur_t)));
+ set_number_from_scaled(mp->cur_tt, half (number_to_scaled(mp->cur_tt)));
+ if (number_to_scaled(mp->cur_t) == 0) {
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+ return 3;
+ } else {
+ mp->bisect_ptr -= int_increment;
+ mp->three_l -= (int) mp->tol_step;
+ number_clone(mp->delx, stack_dx);
+ number_clone(mp->dely, stack_dy);
+ mp->tol = number_to_scaled(stack_tol);
+ mp->uv = number_to_scaled(stack_uv);
+ mp->xy = number_to_scaled(stack_xy);
+ goto NOT_FOUND;
+ }
+ } else {
+ set_number_from_scaled(mp->cur_t, number_to_scaled(mp->cur_t) + 1);
+ number_add(mp->delx, stack_1(u_packet (mp->uv)));
+ number_add(mp->delx, stack_2(u_packet (mp->uv)));
+ number_add(mp->delx, stack_3(u_packet (mp->uv)));
+ number_add(mp->dely, stack_1(v_packet (mp->uv)));
+ number_add(mp->dely, stack_2(v_packet (mp->uv)));
+ number_add(mp->dely, stack_3(v_packet (mp->uv)));
+ mp->uv = mp->uv + int_packets;
+ set_number_from_scaled(mp->cur_tt, number_to_scaled(mp->cur_tt) - 1);
+ mp->xy = mp->xy - int_packets;
+ number_add(mp->delx, stack_1(x_packet (mp->xy)));
+ number_add(mp->delx, stack_2(x_packet (mp->xy)));
+ number_add(mp->delx, stack_3(x_packet (mp->xy)));
+ number_add(mp->dely, stack_1(y_packet (mp->xy)));
+ number_add(mp->dely, stack_2(y_packet (mp->xy)));
+ number_add(mp->dely, stack_3(y_packet (mp->xy)));
+ }
+ } else {
+ set_number_from_scaled(mp->cur_tt, number_to_scaled(mp->cur_tt) + 1);
+ mp->tol = mp->tol + mp->three_l;
+ number_subtract(mp->delx, stack_1(x_packet (mp->xy)));
+ number_subtract(mp->delx, stack_2(x_packet (mp->xy)));
+ number_subtract(mp->delx, stack_3(x_packet (mp->xy)));
+ number_subtract(mp->dely, stack_1(y_packet (mp->xy)));
+ number_subtract(mp->dely, stack_2(y_packet (mp->xy)));
+ number_subtract(mp->dely, stack_3(y_packet (mp->xy)));
+ mp->xy = mp->xy + int_packets;
+ }
+ }
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+}
+
+static mp_knot mp_path_intersection_add(MP mp, mp_knot list, mp_knot *last, mp_number *t, mp_number *tt)
+{
+ int a = number_to_scaled(*t) >> intersection_run_shift;
+ int aa = number_to_scaled(*tt) >> intersection_run_shift;
+ int b = (list ? number_to_scaled((*last)->x_coord) : -1) >> intersection_run_shift ;
+ int bb = (list ? number_to_scaled((*last)->y_coord) : -1) >> intersection_run_shift ;
+ if (a == b && aa == bb) {
+ } else {
+ mp_knot k = mp_new_knot(mp);
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ number_clone(k->x_coord, *t);
+ number_clone(k->y_coord, *tt);
+ if (list) {
+ mp_prev_knot(k) = *last;
+ mp_next_knot(*last) = k;
+ mp_prev_knot(list) = k;
+ mp_next_knot(k) = list;
+ } else {
+ list = k;
+ mp_prev_knot(k) = k;
+ mp_next_knot(k) = k;
+ }
+ *last = k;
+ }
+ return list;
+}
+
+static mp_knot mp_path_intersection(MP mp, mp_knot h, mp_knot hh, int path, mp_knot *last)
+{
+ mp_number n, nn;
+ int done = 0;
+ mp_knot list = NULL;
+ mp_knot l = NULL;
+ mp_knot ll = NULL;
+ if (last) {
+ *last = NULL;
+ }
+ if (mp_right_type(h) == mp_endpoint_knot) {
+ number_clone(h->right_x, h->x_coord);
+ number_clone(h->left_x, h->x_coord);
+ number_clone(h->right_y, h->y_coord);
+ number_clone(h->left_y, h->y_coord);
+ mp_right_type(h) = mp_explicit_knot;
+ }
+ if (mp_right_type(hh) == mp_endpoint_knot) {
+ number_clone(hh->right_x, hh->x_coord);
+ number_clone(hh->left_x, hh->x_coord);
+ number_clone(hh->right_y, hh->y_coord);
+ number_clone(hh->left_y, hh->y_coord);
+ mp_right_type(hh) = mp_explicit_knot;
+ }
+ new_number(n);
+ new_number(nn);
+ mp->tol_step = 0;
+ do {
+ mp_knot p, pp;
+ int t = -1;
+ int tt = -1;
+
+
+ number_negated_clone(n, unity_t);
+ p = h;
+ do {
+ if (mp_right_type(p) != mp_endpoint_knot) {
+
+
+ number_negated_clone(nn, unity_t);
+ pp = hh;
+ do {
+ if (mp_right_type(pp) != mp_endpoint_knot) {
+ int run = 0;
+ int retrials = 0;
+ RETRY:
+ ++run;
+ mp_cubic_intersection(mp, p, pp, run);
+ if (number_positive(mp->cur_t)) {
+ number_add(mp->cur_t, n);
+ number_add(mp->cur_tt, nn);
+ done = 1;
+ if (path) {
+ list = mp_path_intersection_add(mp, list, last, &(mp->cur_t), &(mp->cur_tt));
+ if (t == number_to_scaled(mp->cur_t) && tt == number_to_scaled(mp->cur_tt)) {
+ if (retrials == 8) {
+ break;
+ } else {
+ retrials += 1;
+ goto RETRY;
+ }
+ } else {
+ retrials = 0;
+ t = number_to_scaled(mp->cur_t);
+ tt = number_to_scaled(mp->cur_tt);
+ goto RETRY;
+ }
+ } else {
+ goto DONE;
+ }
+ }
+ }
+ number_add(nn, unity_t);
+ ll = pp;
+ pp = mp_next_knot(pp);
+ } while (pp != hh);
+ }
+ number_add(n, unity_t);
+ l = p;
+ p = mp_next_knot(p);
+ } while (p != h);
+ mp->tol_step = mp->tol_step + 3;
+ if (done) {
+ goto DONE;
+ }
+ } while (mp->tol_step <= 3);
+ DONE:
+ if (path && l && ll && number_equal(l->x_coord, ll->x_coord) && number_equal(l->y_coord, ll->y_coord)) {
+ list = mp_path_intersection_add(mp, list, last, &n, &nn);
+ }
+ if (! done) {
+ number_negated_clone(mp->cur_t, unity_t);
+ number_negated_clone(mp->cur_tt, unity_t);
+ if (path && ! list) {
+ mp_knot k = mp_new_knot(mp);
+ number_clone(k->x_coord, mp->cur_t);
+ number_clone(k->y_coord, mp->cur_tt);
+ mp_prev_knot(k) = k;
+ mp_next_knot(k) = k;
+ list = k;
+ if (last) {
+ *last = k;
+ }
+ }
+ }
+ free_number(n);
+ free_number(nn);
+ return list;
+}
+
+static void mp_new_indep (MP mp, mp_node p)
+{
+ (void) mp;
+ if (mp->serial_no >= max_integer) {
+ mp_fatal_error(mp, "Variable instance identifiers exhausted");
+ }
+ mp_type(p) = mp_independent_type;
+ mp->serial_no = mp->serial_no + 1;
+ mp_set_indep_scale(p, 0);
+ mp_set_indep_value(p, mp->serial_no);
+}
+
+inline static mp_node do_get_dep_info (MP mp, mp_value_node p)
+{
+ (void) mp;
+ mp_node d;
+ d = p->parent;
+ return d;
+}
+
+inline static void do_set_dep_value (MP mp, mp_value_node p, mp_number *q)
+{
+ number_clone(p->data.n, *q);
+ p->attr_head = NULL;
+ p->subscr_head = NULL;
+}
+
+static mp_value_node mp_get_dep_node (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_new_value_node(mp);
+ mp_type(p) = mp_dep_node_type;
+ return p;
+}
+
+static void mp_free_dep_node (MP mp, mp_value_node p)
+{
+ mp_free_value_node(mp, (mp_node) p);
+}
+
+void mp_print_dependency (MP mp, mp_value_node p, int t)
+{
+ mp_number v;
+ mp_node q;
+ mp_value_node pp = p;
+ new_number(v);
+ while (1) {
+ number_abs_clone(v, mp_get_dep_value(p));
+ q = mp_get_dep_info(p);
+ if (q == NULL) {
+ if (number_nonzero(v) || (p == pp)) {
+ if (number_positive(mp_get_dep_value(p)) && p != pp) {
+ mp_print_chr(mp, '+');
+ }
+ print_number(mp_get_dep_value(p));
+ }
+ return;
+ }
+ if (number_negative(mp_get_dep_value(p))) {
+ mp_print_chr(mp, '-');
+ } else if (p != pp) {
+ mp_print_chr(mp, '+');
+ }
+ if (t == mp_dependent_type) {
+ fraction_to_round_scaled(v);
+ }
+ if (! number_equal(v, unity_t)) {
+ print_number(v);
+ }
+ if (mp_type(q) != mp_independent_type) {
+ mp_confusion(mp, "dependency");
+ } else {
+ mp_print_variable_name(mp, q);
+ set_number_from_scaled(v, mp_get_indep_scale(q));
+ while (number_positive(v)) {
+ mp_print_str(mp, "*4");
+ number_add_scaled(v, -2);
+ }
+ p = (mp_value_node) mp_link(p);
+ }
+ }
+}
+
+static void mp_max_coef (MP mp, mp_number *x, mp_value_node p)
+{
+ mp_number(absv);
+ new_number(absv);
+ set_number_to_zero(*x);
+ while (mp_get_dep_info(p) != NULL) {
+ number_abs_clone(absv, mp_get_dep_value(p));
+ if (number_greater(absv, *x)) {
+ number_clone(*x, absv);
+ }
+ p = (mp_value_node) mp_link(p);
+ }
+ free_number(absv);
+}
+
+static mp_value_node mp_p_plus_fq (MP mp,
+ mp_value_node p, mp_number *f,
+ mp_value_node q, mp_variable_type t,
+ mp_variable_type tt
+)
+{
+ mp_node pp, qq;
+ mp_value_node r, s;
+ mp_number threshold;
+ mp_number half_threshold;
+ mp_number v, vv;
+ new_number(v);
+ new_number(vv);
+ if (t == mp_dependent_type) {
+ new_number_clone(threshold, fraction_threshold_k);
+ new_number_clone(half_threshold, half_fraction_threshold_k);
+ } else {
+ new_number_clone(threshold, scaled_threshold_k);
+ new_number_clone(half_threshold, half_scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ pp = mp_get_dep_info(p);
+ qq = mp_get_dep_info(q);
+ while (1) {
+ if (pp == qq) {
+ if (pp == NULL) {
+ break;
+ } else {
+ mp_number r1;
+ mp_number absv;
+ new_fraction(r1);
+ new_number(absv);
+ if (tt == mp_dependent_type) {
+ take_fraction(r1, *f, mp_get_dep_value(q));
+ } else {
+ take_scaled(r1, *f, mp_get_dep_value(q));
+ }
+ set_number_from_addition(v, mp_get_dep_value(p), r1);
+ free_number(r1);
+ mp_set_dep_value(p, v);
+ s = p;
+ p = (mp_value_node) mp_link(p);
+ number_abs_clone(absv, v);
+ if (number_less(absv, threshold)) {
+ mp_free_dep_node(mp, s);
+ } else {
+ if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) {
+ mp_type(qq) = independent_needing_fix;
+ mp->fix_needed = 1;
+ }
+ mp_set_link(r, s);
+ r = s;
+ }
+ free_number(absv);
+ pp = mp_get_dep_info(p);
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ }
+ } else {
+ if (pp == NULL) {
+ set_number_to_negative_inf(v);
+ } else if (mp_type(pp) == mp_independent_type || (mp_type(pp) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(v, mp_get_indep_value(pp));
+ } else {
+ number_clone(v, mp_get_value_number(pp));
+ }
+ if (qq == NULL) {
+ set_number_to_negative_inf(vv);
+ } else if (mp_type(qq) == mp_independent_type || (mp_type(qq) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(vv, mp_get_indep_value(qq));
+ } else {
+ number_clone(vv, mp_get_value_number(qq));
+ }
+ if (number_less(v, vv)) {
+ mp_number absv;
+ {
+ mp_number r1;
+ mp_number arg1, arg2;
+ new_fraction(r1);
+ new_number_clone(arg1, *f);
+ new_number_clone(arg2, mp_get_dep_value(q));
+ if (tt == mp_dependent_type) {
+ take_fraction(r1, arg1, arg2);
+ } else {
+ take_scaled(r1, arg1, arg2);
+ }
+ number_clone(v, r1);
+ free_number(r1);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ new_number_abs(absv, v);
+ if (number_greater(absv, half_threshold)) {
+ s = mp_get_dep_node(mp);
+ mp_set_dep_info(s, qq);
+ mp_set_dep_value(s, v);
+ if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) {
+ mp_type(qq) = independent_needing_fix;
+ mp->fix_needed = 1;
+ }
+ mp_set_link(r, s);
+ r = s;
+ }
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ free_number(absv);
+ } else {
+ mp_set_link(r, p);
+ r = p;
+ p = (mp_value_node) mp_link(p);
+ pp = mp_get_dep_info(p);
+ }
+ }
+ }
+ {
+ mp_number r1;
+ mp_number arg1, arg2;
+ new_fraction(r1);
+ new_number(arg1);
+ new_number(arg2);
+ number_clone(arg1, mp_get_dep_value(q));
+ number_clone(arg2, *f);
+ if (t == mp_dependent_type) {
+ take_fraction(r1, arg1, arg2);
+ } else {
+ take_scaled(r1, arg1, arg2);
+ }
+ slow_add(arg1, mp_get_dep_value(p), r1);
+ mp_set_dep_value(p, arg1);
+ free_number(r1);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ mp_set_link(r, p);
+ mp->dep_final = p;
+ free_number(threshold);
+ free_number(half_threshold);
+ free_number(v);
+ free_number(vv);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+static mp_value_node mp_p_plus_q (MP mp, mp_value_node p, mp_value_node q, mp_variable_type t)
+{
+ mp_node pp, qq;
+ mp_value_node s;
+ mp_value_node r;
+ mp_number threshold;
+ mp_number v, vv;
+ new_number(v);
+ new_number(vv);
+ new_number(threshold);
+ if (t == mp_dependent_type) {
+ number_clone(threshold, fraction_threshold_k);
+ } else {
+ number_clone(threshold, scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ pp = mp_get_dep_info(p);
+ qq = mp_get_dep_info(q);
+ while (1) {
+ if (pp == qq) {
+ if (pp == NULL) {
+ break;
+ } else {
+ mp_number test;
+ new_number(test);
+ set_number_from_addition(v, mp_get_dep_value(p), mp_get_dep_value(q));
+ mp_set_dep_value(p, v);
+ s = p;
+ p = (mp_value_node) mp_link(p);
+ pp = mp_get_dep_info(p);
+ number_abs_clone(test, v);
+ if (number_less(test, threshold)) {
+ mp_free_dep_node(mp, s);
+ } else {
+ if (number_greaterequal(test, coef_bound_k) && mp->watch_coefs) {
+ mp_type(qq) = independent_needing_fix;
+ mp->fix_needed = 1;
+ }
+ mp_set_link(r, s);
+ r = s;
+ }
+ free_number(test);
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ }
+ } else {
+ if (pp == NULL) {
+ set_number_to_zero(v);
+ } else if (mp_type(pp) == mp_independent_type || (mp_type(pp) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(v, mp_get_indep_value(pp));
+ } else {
+ number_clone(v, mp_get_value_number(pp));
+ }
+ if (qq == NULL) {
+ set_number_to_zero(vv);
+ } else if (mp_type(qq) == mp_independent_type || (mp_type(qq) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(vv, mp_get_indep_value(qq));
+ } else {
+ number_clone(vv, mp_get_value_number(qq));
+ }
+ if (number_less(v, vv)) {
+ s = mp_get_dep_node(mp);
+ mp_set_dep_info(s, qq);
+ mp_set_dep_value(s, mp_get_dep_value(q));
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ mp_set_link(r, s);
+ r = s;
+ } else {
+ mp_set_link(r, p);
+ r = p;
+ p = (mp_value_node) mp_link(p);
+ pp = mp_get_dep_info(p);
+ }
+ }
+ }
+ {
+ mp_number r1;
+ new_number(r1);
+ slow_add(r1, mp_get_dep_value(p), mp_get_dep_value(q));
+ mp_set_dep_value(p, r1);
+ free_number(r1);
+ }
+ mp_set_link(r, p);
+ mp->dep_final = p;
+ free_number(v);
+ free_number(vv);
+ free_number(threshold);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+static mp_value_node mp_p_times_v (MP mp, mp_value_node p, mp_number *v, int t0, int t1, int v_is_scaled)
+{
+ mp_value_node r, s;
+ mp_number w;
+ mp_number threshold;
+ int scaling_down = (t0 != t1) ? 1 : (! v_is_scaled);
+ new_number(threshold);
+ new_number(w);
+ if (t1 == mp_dependent_type) {
+ number_clone(threshold, half_fraction_threshold_k);
+ } else {
+ number_clone(threshold, half_scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ while (mp_get_dep_info(p) != NULL) {
+ mp_number test;
+ new_number(test);
+ if (scaling_down) {
+ take_fraction(w, *v, mp_get_dep_value(p));
+ } else {
+ take_scaled(w, *v, mp_get_dep_value(p));
+ }
+ number_abs_clone(test, w);
+ if (number_lessequal(test, threshold)) {
+ s = (mp_value_node) mp_link(p);
+ mp_free_dep_node(mp, p);
+ p = s;
+ } else {
+ if (number_greaterequal(test, coef_bound_k)) {
+ mp->fix_needed = 1;
+ mp_type(mp_get_dep_info(p)) = independent_needing_fix;
+ }
+ mp_set_link(r, p);
+ r = p;
+ mp_set_dep_value(p, w);
+ p = (mp_value_node) mp_link(p);
+ }
+ free_number(test);
+ }
+ mp_set_link(r, p);
+ {
+ mp_number r1;
+ new_number(r1);
+ if (v_is_scaled) {
+ take_scaled(r1, mp_get_dep_value(p), *v);
+ } else {
+ take_fraction(r1, mp_get_dep_value(p), *v);
+ }
+ mp_set_dep_value(p, r1);
+ free_number(r1);
+ }
+ free_number(w);
+ free_number(threshold);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number *v_orig, int t0, int t1)
+{
+ mp_value_node r, s;
+ mp_number w;
+ mp_number threshold;
+ mp_number v;
+ int scaling_down = (t0 != t1);
+ new_number(w);
+ new_number(threshold);
+ new_number_clone(v, *v_orig);
+ if (t1 == mp_dependent_type) {
+ number_clone(threshold, half_fraction_threshold_k);
+ } else {
+ number_clone(threshold, half_scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ while (mp_get_dep_info(p) != NULL) {
+ if (scaling_down) {
+ mp_number x, absv;
+ new_number_abs(absv, v);
+ if (number_less(absv, p_over_v_threshold_k)) {
+ new_number_clone(x, v);
+ convert_scaled_to_fraction(x);
+ make_scaled(w, mp_get_dep_value(p), x);
+ } else {
+ new_number_clone(x, mp_get_dep_value(p));
+ fraction_to_round_scaled(x);
+ make_scaled(w, x, v);
+ }
+ free_number(x);
+ free_number(absv);
+ } else {
+ make_scaled(w, mp_get_dep_value(p), v);
+ }
+ {
+ mp_number test;
+ new_number(test);
+ number_abs_clone(test, w);
+ if (number_lessequal(test, threshold)) {
+ s = (mp_value_node) mp_link(p);
+ mp_free_dep_node(mp, p);
+ p = s;
+ } else {
+ if (number_greaterequal(test, coef_bound_k)) {
+ mp->fix_needed = 1;
+ mp_type(mp_get_dep_info(p)) = independent_needing_fix;
+ }
+ mp_set_link(r, p);
+ r = p;
+ mp_set_dep_value(p, w);
+ p = (mp_value_node) mp_link(p);
+ }
+ free_number(test);
+ }
+ }
+ mp_set_link(r, p);
+ {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, mp_get_dep_value(p), v);
+ mp_set_dep_value(p, ret);
+ free_number(ret);
+ }
+ free_number(v);
+ free_number(w);
+ free_number(threshold);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+static mp_value_node mp_p_with_x_becoming_q (MP mp, mp_value_node p, mp_node x, mp_node q, int t)
+{
+ mp_value_node s = p;
+ mp_value_node r = (mp_value_node) mp->temp_head;
+ int sx = mp_get_indep_value(x);
+ while (mp_get_dep_info(s) != NULL && mp_get_indep_value(mp_get_dep_info(s)) > sx) {
+ r = s;
+ s = (mp_value_node) mp_link(s);
+ }
+ if (mp_get_dep_info(s) == NULL || mp_get_dep_info(s) != x) {
+ return p;
+ } else {
+ mp_value_node ret;
+ mp_number v1;
+ mp_set_link(mp->temp_head, p);
+ mp_set_link(r, mp_link(s));
+ new_number_clone(v1, mp_get_dep_value(s));
+ mp_free_dep_node(mp, s);
+ ret = mp_p_plus_fq(mp, (mp_value_node) mp_link(mp->temp_head), &v1, (mp_value_node) q, t, mp_dependent_type);
+ free_number(v1);
+ return ret;
+ }
+}
+
+static void mp_val_too_big (MP mp, mp_number *x)
+{
+ if (number_positive(internal_value(mp_warning_check_internal))) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Value is too large (%s)", number_tostring(*x));
+ mp_error(
+ mp,
+ msg,
+ "The equation I just processed has given some variable a value outside of the\n"
+ "safetyp range. Continue and I'll try to cope with that big value; but it might be\n"
+ "dangerous. (Set 'warningcheck := 0' to suppress this message.)"
+ );
+ }
+}
+
+void mp_make_known (MP mp, mp_value_node p, mp_value_node q)
+{
+ mp_variable_type t = mp_type(p);
+ mp_number absp;
+ new_number(absp);
+ mp_set_prev_dep(mp_link(q), mp_get_prev_dep(p));
+ mp_set_link(mp_get_prev_dep(p), mp_link(q));
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, mp_get_dep_value(q));
+ mp_free_dep_node(mp, q);
+ number_abs_clone(absp, mp_get_value_number(p));
+ if (number_greaterequal(absp, warning_limit_t)) {
+ mp_val_too_big (mp, &(mp_get_value_number(p)));
+ }
+ if ((number_positive(internal_value(mp_tracing_equations_internal))) && mp_interesting(mp, (mp_node) p)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "#### ");
+ mp_print_variable_name(mp, (mp_node) p);
+ mp_print_chr(mp, '=');
+ print_number(mp_get_value_number(p));
+ mp_end_diagnostic(mp, 0);
+ }
+ if (cur_exp_node == (mp_node) p && mp->cur_exp.type == t) {
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ mp_free_value_node(mp, (mp_node) p);
+ }
+ free_number(absp);
+}
+
+static void mp_fix_dependencies (MP mp)
+{
+ mp_value_node r = (mp_value_node) mp_link(mp->dep_head);
+ mp_value_node s = NULL;
+ while (r != mp->dep_head) {
+ mp_value_node t = r;
+ mp_value_node q;
+ while (1) {
+ mp_node x;
+ if (t == r) {
+ q = (mp_value_node) mp_get_dep_list(t);
+ } else {
+ q = (mp_value_node) mp_link(r);
+ }
+ x = mp_get_dep_info(q);
+ if (x == NULL) {
+ break;
+ } else if (mp_type(x) <= independent_being_fixed) {
+ if (mp_type(x) < independent_being_fixed) {
+ mp_value_node p = mp_get_dep_node(mp);
+ mp_set_link(p, s);
+ s = p;
+ mp_set_dep_info(s, x);
+ mp_type(x) = independent_being_fixed;
+ }
+ mp_set_dep_value(q, mp_get_dep_value(q));
+ number_divide_int(mp_get_dep_value(q), 4);
+ if (number_zero(mp_get_dep_value(q))) {
+ mp_set_link(r, mp_link(q));
+ mp_free_dep_node(mp, q);
+ q = r;
+ }
+ }
+ r = q;
+ }
+ r = (mp_value_node) mp_link(q);
+ if (q == (mp_value_node) mp_get_dep_list(t)) {
+ mp_make_known(mp, t, q);
+ }
+ }
+ while (s != NULL) {
+ mp_value_node p = (mp_value_node) mp_link(s);
+ mp_node x = mp_get_dep_info(s);
+ mp_free_dep_node(mp, s);
+ s = p;
+ mp_type(x) = mp_independent_type;
+ mp_set_indep_scale(x, mp_get_indep_scale(x) + 2);
+ }
+ mp->fix_needed = 0;
+}
+
+static void mp_new_dep (MP mp, mp_node q, mp_variable_type newtype, mp_value_node p)
+{
+ mp_node r;
+ mp_type(q) = newtype;
+ mp_set_dep_list(q, p);
+ mp_set_prev_dep(q, (mp_node) mp->dep_head);
+ r = mp_link(mp->dep_head);
+ mp_set_link(mp->dep_final, r);
+ mp_set_prev_dep(r, (mp_node) mp->dep_final);
+ mp_set_link(mp->dep_head, q);
+}
+
+static mp_value_node mp_const_dependency (MP mp, mp_number *v)
+{
+ mp->dep_final = mp_get_dep_node(mp);
+ mp_set_dep_value(mp->dep_final, *v);
+ mp_set_dep_info(mp->dep_final, NULL);
+ return mp->dep_final;
+}
+
+static mp_value_node mp_single_dependency (MP mp, mp_node p)
+{
+ mp_value_node q;
+ int m = mp_get_indep_scale(p);
+ if (m > 28) {
+ q = mp_const_dependency(mp, &zero_t);
+ } else {
+ mp_value_node rr;
+ q = mp_get_dep_node(mp);
+ mp_set_dep_value(q, zero_t);
+ set_number_from_scaled(mp_get_dep_value(q), (int) two_to_the(28 - m));
+ mp_set_dep_info(q, p);
+ rr = mp_const_dependency(mp, &zero_t);
+ mp_set_link(q, rr);
+ }
+ return q;
+}
+
+static mp_value_node mp_copy_dep_list (MP mp, mp_value_node p)
+{
+ mp_value_node q = mp_get_dep_node(mp);
+ mp->dep_final = q;
+ while (1) {
+ mp_set_dep_info(mp->dep_final, mp_get_dep_info(p));
+ mp_set_dep_value(mp->dep_final, mp_get_dep_value(p));
+ if (mp_get_dep_info(mp->dep_final) == NULL) {
+ break;
+ } else {
+ mp_set_link(mp->dep_final, mp_get_dep_node(mp));
+ mp->dep_final = (mp_value_node) mp_link(mp->dep_final);
+ p = (mp_value_node) mp_link(p);
+ }
+ }
+ return q;
+}
+
+static mp_value_node find_node_with_largest_coefficient (MP mp, mp_value_node p, mp_number *v);
+
+static void display_new_dependency (MP mp, mp_value_node p, mp_node x, int n);
+
+static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, int n);
+
+static mp_value_node divide_p_by_minusv_removing_q (MP mp,
+ mp_value_node p, mp_value_node q,
+ mp_value_node *final_node, mp_number *v, int t
+);
+
+static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, int n);
+
+static void mp_linear_eq (MP mp, mp_value_node p, int t)
+{
+ mp_value_node r;
+ mp_node x;
+ int n;
+ mp_number v;
+ mp_value_node prev_r;
+ mp_value_node final_node;
+ mp_value_node qq;
+ new_number(v);
+ qq = find_node_with_largest_coefficient(mp, p, &v);
+ x = mp_get_dep_info(qq);
+ n = mp_get_indep_scale(x);
+ p = divide_p_by_minusv_removing_q(mp, p, qq, &final_node, &v, t);
+ if (number_positive(internal_value(mp_tracing_equations_internal))) {
+ display_new_dependency(mp, p, (mp_node) x, n);
+ }
+ prev_r = (mp_value_node) mp->dep_head;
+ r = (mp_value_node) mp_link(mp->dep_head);
+ while (r != mp->dep_head) {
+ mp_value_node s = (mp_value_node) mp_get_dep_list(r);
+ mp_value_node q = mp_p_with_x_becoming_q(mp, s, x, (mp_node) p, mp_type(r));
+ if (mp_get_dep_info(q) == NULL) {
+ mp_make_known(mp, r, q);
+ } else {
+ mp_set_dep_list(r, q);
+ do {
+ q = (mp_value_node) mp_link(q);
+ } while (mp_get_dep_info(q) != NULL);
+ prev_r = q;
+ }
+ r = (mp_value_node) mp_link(prev_r);
+ }
+ if (n > 0) {
+ p = divide_p_by_2_n(mp, p, n);
+ }
+ change_to_known(mp, p, (mp_node) x, final_node, n);
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ free_number(v);
+}
+
+static mp_value_node find_node_with_largest_coefficient (MP mp, mp_value_node p, mp_number *v)
+{
+ mp_number vabs;
+ mp_number rabs;
+ mp_value_node q = p;
+ mp_value_node r = (mp_value_node) mp_link(p);
+ new_number(vabs);
+ new_number(rabs);
+ number_clone(*v, mp_get_dep_value(q));
+ while (mp_get_dep_info(r) != NULL) {
+ number_abs_clone(vabs, *v);
+ number_abs_clone(rabs, mp_get_dep_value(r));
+ if (number_greater(rabs, vabs)) {
+ q = r;
+ number_clone(*v, mp_get_dep_value(r));
+ }
+ r = (mp_value_node) mp_link(r);
+ }
+ free_number(vabs);
+ free_number(rabs);
+ return q;
+}
+
+static mp_value_node divide_p_by_minusv_removing_q (MP mp,
+ mp_value_node p, mp_value_node q,
+ mp_value_node *final_node, mp_number *v, int t
+)
+{
+ mp_value_node r = p;
+ mp_value_node s = (mp_value_node) mp->temp_head;
+ mp_set_link(s, p);
+ do {
+ if (r == q) {
+ mp_set_link(s, mp_link(r));
+ mp_free_dep_node(mp, r);
+ } else {
+ mp_number w;
+ mp_number absw;
+ new_number(w);
+ new_number(absw);
+ make_fraction(w, mp_get_dep_value(r), *v);
+ number_abs_clone(absw, w);
+ if (number_lessequal(absw, half_fraction_threshold_k)) {
+ mp_set_link(s, mp_link(r));
+ mp_free_dep_node(mp, r);
+ } else {
+ number_negate(w);
+ mp_set_dep_value(r, w);
+ s = r;
+ }
+ free_number(w);
+ free_number(absw);
+ }
+ r = (mp_value_node) mp_link(s);
+ } while (mp_get_dep_info(r) != NULL);
+ if (t == mp_proto_dependent_type) {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, mp_get_dep_value(r), *v);
+ number_negate(ret);
+ mp_set_dep_value(r, ret);
+ free_number(ret);
+ } else if (number_to_scaled(*v) != -number_to_scaled(fraction_one_t)) {
+ mp_number ret;
+ new_fraction(ret);
+ make_fraction(ret, mp_get_dep_value(r), *v);
+ number_negate(ret);
+ mp_set_dep_value(r, ret);
+ free_number(ret);
+ }
+ *final_node = r;
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+static void display_new_dependency (MP mp, mp_value_node p, mp_node x, int n)
+{
+ if (mp_interesting(mp, x)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "## ");
+ mp_print_variable_name(mp, x);
+ while (n > 0) {
+ mp_print_str(mp, "*4");
+ n = n - 2;
+ }
+ mp_print_chr(mp, '=');
+ mp_print_dependency(mp, p, mp_dependent_type);
+ mp_end_diagnostic(mp, 0);
+ }
+}
+
+static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, int n)
+{
+ mp_value_node pp = NULL;
+ if (n > 0) {
+ mp_value_node r;
+ mp_value_node s;
+ mp_number absw;
+ mp_number w;
+ new_number(w);
+ new_number(absw);
+ s = (mp_value_node) mp->temp_head;
+ mp_set_link(mp->temp_head, p);
+ r = p;
+ do {
+ if (n > 30) {
+ set_number_to_zero(w);
+ } else {
+ number_clone(w, mp_get_dep_value(r));
+ number_divide_int(w, two_to_the(n));
+ }
+ number_abs_clone(absw, w);
+ if (number_lessequal(absw, half_fraction_threshold_k) && (mp_get_dep_info(r) != NULL)) {
+ mp_set_link(s, mp_link(r));
+ mp_free_dep_node(mp, r);
+ } else {
+ mp_set_dep_value(r, w);
+ s = r;
+ }
+ r = (mp_value_node) mp_link(s);
+ } while (mp_get_dep_info(s) != NULL);
+ pp = (mp_value_node) mp_link(mp->temp_head);
+ free_number(absw);
+ free_number(w);
+ }
+ return pp;
+}
+
+static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, int n)
+{
+ (void) n;
+ if (mp_get_dep_info(p) == NULL) {
+ mp_number absx;
+ mp_type(x) = mp_known_type;
+ mp_set_value_number(x, mp_get_dep_value(p));
+ new_number_abs(absx, mp_get_value_number(x));
+ if (number_greaterequal(absx, warning_limit_t)) {
+ mp_val_too_big(mp, &(mp_get_value_number(x)));
+ }
+ free_number(absx);
+ mp_free_dep_node(mp, p);
+ if (cur_exp_node == x && mp->cur_exp.type == mp_independent_type) {
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(x)));
+ mp->cur_exp.type = mp_known_type;
+ mp_free_value_node(mp, x);
+ }
+ } else {
+ mp->dep_final = final_node;
+ mp_new_dep(mp, x, mp_dependent_type, p);
+ if (cur_exp_node == x && mp->cur_exp.type == mp_independent_type) {
+ mp->cur_exp.type = mp_dependent_type;
+ }
+ }
+}
+
+static mp_node mp_new_ring_entry (MP mp, mp_node p)
+{
+ mp_node q = mp_new_value_node(mp);
+ mp_name_type(q) = mp_capsule_operation;
+ mp_type(q) = mp_type(p);
+ if (mp_get_value_node(p) == NULL) {
+ mp_set_value_node(q, p);
+ } else {
+ mp_set_value_node(q, mp_get_value_node(p));
+ }
+ mp_set_value_node(p, q);
+ return q;
+}
+
+void mp_ring_delete (MP mp, mp_node p)
+{
+ (void) mp;
+ mp_node q = mp_get_value_node(p);
+ if (q != NULL && q != p) {
+ while (mp_get_value_node(q) != p) {
+ q = mp_get_value_node(q);
+ }
+ mp_set_value_node(q, mp_get_value_node(p));
+ }
+}
+
+static void mp_nonlinear_eq (MP mp, mp_value v, mp_node p, int flush_p)
+{
+ mp_variable_type t = mp_type(p) - unknown_tag;
+ mp_node q = mp_get_value_node(p);
+ if (flush_p) {
+ mp_type(p) = mp_vacuous_type;
+ } else {
+ p = q;
+ }
+ do {
+ mp_node r = mp_get_value_node(q);
+ mp_type(q) = t;
+ switch (t) {
+ case mp_boolean_type:
+ mp_set_value_number(q, v.data.n);
+ break;
+ case mp_string_type:
+ mp_set_value_str(q, v.data.str);
+ add_str_ref(v.data.str);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_set_value_knot(q, mp_copy_pen(mp, v.data.p));
+ break;
+ case mp_path_type:
+ mp_set_value_knot(q, mp_copy_path(mp, v.data.p));
+ break;
+ case mp_picture_type:
+ mp_set_value_node(q, v.data.node);
+ mp_add_edge_ref(mp, v.data.node);
+ break;
+ default:
+ break;
+ }
+ q = r;
+ } while (q != p);
+}
+
+static void mp_ring_merge (MP mp, mp_node p, mp_node q)
+{
+ mp_node r = mp_get_value_node(p);
+ while (r != p) {
+ if (r == q) {
+ mp_exclaim_redundant_equation(mp);
+ return;
+ } else {
+ r = mp_get_value_node(r);
+ }
+ }
+ r = mp_get_value_node(p);
+ mp_set_value_node(p, mp_get_value_node(q));
+ mp_set_value_node(q, r);
+}
+
+static void mp_exclaim_redundant_equation (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Redundant equation",
+ "I already knew that this equation was true. But perhaps no harm has been done;\n"
+ "let's continue."
+ );
+ mp_get_x_next(mp);
+}
+
+const char *mp_cmd_mod_string (MP mp, int c, int m)
+{
+ switch (c) {
+ case mp_add_to_command: return "addto";
+ case mp_assignment_command: return ":=";
+ case mp_at_least_command: return "atleast";
+ case mp_begin_group_command: return "begingroup";
+ case mp_colon_command: return ":";
+ case mp_comma_command: return ",";
+ case mp_controls_command: return "controls";
+ case mp_curl_command: return "curl";
+ case mp_delimiters_command: return "delimiters";
+ case mp_end_group_command: return "endgroup";
+ case mp_every_job_command: return "everyjob";
+ case mp_exit_test_command: return "exitif";
+ case mp_expand_after_command: return "expandafter";
+ case mp_interim_command: return "interim";
+ case mp_left_brace_command: return "{";
+ case mp_left_bracket_command: return "[";
+ case mp_let_command: return "let";
+ case mp_new_internal_command: return "newinternal";
+ case mp_of_command: return "of";
+ case mp_path_join_command: return "..";
+ case mp_relax_command: return "\\";
+ case mp_right_brace_command: return "}";
+ case mp_right_bracket_command: return "]";
+ case mp_save_command: return "save";
+ case mp_scan_tokens_command: return "scantokens";
+ case mp_runscript_command: return "runscript";
+ case mp_maketext_command: return "maketext";
+ case mp_semicolon_command: return ";";
+ case mp_ship_out_command: return "shipout";
+ case mp_step_command: return "step";
+ case mp_str_command: return "str";
+ case mp_void_command: return "void";
+ case mp_tension_command: return "tension";
+ case mp_to_command: return "to";
+ case mp_until_command: return "until";
+ case mp_within_command: return "within";
+ case mp_write_command: return "write";
+ case mp_btex_command: return m == mp_btex_code ? "btex" : "verbatimtex";
+ case mp_etex_command: return "etex";
+ case mp_macro_def_command:
+ switch (m) {
+ case mp_end_def_code : return "enddef";
+ case mp_def_code : return "def";
+ case mp_var_def_code : return "vardef";
+ case mp_primary_def_code : return "primarydef";
+ case mp_secondary_def_code: return "secondarydef";
+ case mp_tertiary_def_code : return "tertiarydef";
+ default: return "?def";
+ }
+ break;
+ case mp_iteration_command:
+ switch (m) {
+ case mp_end_for_code : return "endfor";
+ case mp_start_forever_code : return "forever";
+ case mp_start_for_code : return "for";
+ case mp_start_forsuffixes_code: return "forsuffixes";
+ }
+ break;
+ case mp_only_set_command:
+ switch (m) {
+ case mp_random_seed_code : return"randomseed";
+ case mp_max_knot_pool_code: return"maxknotpool";
+ }
+ break;
+ case mp_macro_special_command:
+ switch (m) {
+ case mp_macro_prefix_code: return "#@";
+ case mp_macro_at_code : return "@";
+ case mp_macro_suffix_code: return "@#";
+ case mp_macro_quote_code : return "quote";
+ }
+ break;
+ case mp_parameter_commmand:
+ switch (m) {
+ case mp_expr_parameter : return "expr";
+ case mp_suffix_parameter: return "suffix";
+ case mp_text_parameter : return "text";
+ case mp_primary_macro : return "primary";
+ case mp_secondary_macro : return "secondary";
+ default : return "tertiary";
+ }
+ break;
+ case mp_input_command:
+ return m == 0 ? "input" : "endinput";
+ case mp_if_test_command:
+ case mp_fi_or_else_command:
+ switch (m) {
+ case mp_if_code : return "if";
+ case mp_fi_code : return "fi";
+ case mp_else_code : return "else";
+ case mp_else_if_code: return "elseif";
+ }
+ break;
+ case mp_nullary_command:
+ case mp_unary_command:
+ case mp_of_binary_command:
+ case mp_secondary_binary_command:
+ case mp_tertiary_binary_command:
+ case mp_primary_binary_command:
+ case mp_cycle_command:
+ case mp_plus_or_minus_command:
+ case mp_slash_command:
+ case mp_ampersand_command:
+ case mp_equals_command:
+ case mp_and_command:
+ return mp_op_string((int) m);
+ case mp_type_name_command:
+ return "";
+ case mp_stop_command:
+ return cur_mod == 0 ? "end" : "dump";
+ case mp_mode_command:
+ switch (m) {
+ case mp_batch_mode : return "batchmode";
+ case mp_nonstop_mode : return "nonstopmode";
+ case mp_scroll_mode : return "scrollmode";
+ case mp_error_stop_mode: return "errorstopmode";
+ default : return "silentmode";
+ }
+ break;
+ case mp_protection_command:
+ switch (m) {
+ case 0: return "inner";
+ case 1: return "outer";
+ }
+ break;
+ case mp_property_command:
+ return "setproperty";
+ case mp_show_command:
+ switch (m) {
+ case mp_show_token_code : return "showtoken";
+ case mp_show_stats_code : return "showstats";
+ case mp_show_code : return "show";
+ case mp_show_var_code : return "showvariable";
+ case mp_show_dependencies_code: return "showdependencies";
+ }
+ break;
+ case mp_left_delimiter_command:
+ case mp_right_delimiter_command:
+ return c == mp_left_delimiter_command ? "left delimiter" : "right delimiter";
+ case mp_tag_command:
+ return m == 0 ? "tag" : "variable";
+ case mp_defined_macro_command:
+ return "macro:";
+ case mp_primary_def_command:
+ return "primarydef";
+ case mp_secondary_def_command:
+ return "secondarydef";
+ case mp_tertiary_def_command:
+ return "tertiarydef";
+ case mp_repeat_loop_command:
+ return "[repeat the loop]";
+ case mp_internal_command:
+ return internal_name(m);
+ case mp_thing_to_add_command:
+ switch (m) {
+ case mp_add_contour_code : return "contour";
+ case mp_add_double_path_code: return "doublepath";
+ case mp_add_also_code : return "also";
+ }
+ break;
+ case mp_with_option_command:
+ switch (m) {
+ case mp_with_pen_code : return "withpen";
+ case mp_with_pre_script_code : return "withprescript";
+ case mp_with_post_script_code : return "withpostscript";
+ case mp_with_stacking_code : return "withstacking";
+ case mp_with_no_model_code : return "withoutcolor";
+ case mp_with_rgb_model_code : return "withrgbcolor";
+ case mp_with_uninitialized_model_code: return "withcolor";
+ case mp_with_cmyk_model_code : return "withcmykcolor";
+ case mp_with_grey_model_code : return "withgreyscale";
+ case mp_with_linecap_code : return "withlinecap";
+ case mp_with_linejoin_code : return "withlinejoin";
+ case mp_with_miterlimit_code : return "withmiterlimit";
+ default : return "dashed";
+ }
+ break;
+ case mp_bounds_command:
+ switch (m) {
+ case mp_start_clip_node_type : return "clip";
+ case mp_start_group_node_type : return "setgroup";
+ case mp_start_bounds_node_type: return "setbounds";
+ }
+ break;
+ case mp_message_command:
+ if (m < err_message_code) {
+ return "message";
+ } else if (m == err_message_code) {
+ return "errmessage";
+ } else {
+ return "errhelp";
+ }
+ }
+ return "[unknown command code!]";
+}
+
+void mp_print_cmd_mod (MP mp, int c, int m)
+{
+ mp_print_str(mp, mp_cmd_mod_string(mp, c, m));
+}
+
+static void mp_show_cmd_mod (MP mp, int c, int m)
+{
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{");
+ switch (c) {
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ mp_print_cmd_mod(mp, mp_macro_def_command, c);
+ mp_print_str(mp, "'d macro:");
+ mp_print_ln(mp);
+ mp_show_token_list(mp, mp_link(mp_link(cur_mod_node)),0);
+ break;
+ default:
+ mp_print_cmd_mod(mp, c, m);
+ break;
+ }
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+}
+
+static void mp_reallocate_input_stack (MP mp, int newsize)
+{
+ int n = newsize + 1;
+ mp->input_file = mp_memory_reallocate(mp->input_file, (size_t) (n + 1) * sizeof(void *));
+ mp->line_stack = mp_memory_reallocate(mp->line_stack, (size_t) (n + 1) * sizeof(int));
+ for (int k = mp->max_in_open; k <= n; k++) {
+ mp->input_file[k] = NULL;
+ mp->line_stack[k] = 0;
+ }
+ mp->max_in_open = newsize;
+}
+
+static void mp_check_param_size (MP mp, int k)
+{
+ while (k >= mp->param_size) {
+ mp->param_stack = mp_memory_reallocate(mp->param_stack, (size_t) ((k + k / 4) + 1) * sizeof(mp_node));
+ mp->param_size = k + k / 4;
+ }
+}
+
+int mp_true_line (MP mp)
+{
+ int k;
+ if (file_state && (name > max_spec_src)) {
+ return line;
+ } else {
+ k = mp->input_ptr;
+ while ((k > 0) && ((mp->input_stack[(k - 1)].index_field < mp_file_bottom_text)
+ || (mp->input_stack[(k - 1)].name_field <= max_spec_src))) {
+ --k;
+ }
+ return (k > 0 ? mp->line_stack[(k - 1) + mp_file_bottom_text] : 0);
+ }
+}
+
+void mp_show_context (MP mp)
+{
+ mp->file_ptr = mp->input_ptr;
+ mp->input_stack[mp->file_ptr] = mp->cur_input;
+ while (1) {
+ mp->cur_input = mp->input_stack[mp->file_ptr];
+
+ if ((mp->file_ptr == mp->input_ptr) || file_state || (token_type != mp_backed_up_text) || (nloc != NULL)) {
+ if (file_state) {
+ if (name > max_spec_src) {
+ mp_print_nl(mp, "<line ");
+ mp_print_int(mp, mp_true_line(mp));
+ mp_print_chr(mp, '>');
+ } else if (terminal_input) {
+ if (mp->file_ptr == 0) {
+ mp_print_nl(mp, "<direct>");
+ } else {
+ mp_print_nl(mp, "<insert>");
+ }
+ } else if (name == is_scantok) {
+ mp_print_nl(mp, "<scantokens>");
+ } else {
+ mp_print_nl(mp, "<read>");
+ }
+ mp_print_chr(mp, ' ');
+
+ if (limit > 0) {
+ for (int i = start; i <= limit - 1; i++) {
+ mp_print_chr(mp, mp->buffer[i]);
+ }
+ }
+ } else {
+ {
+ switch (token_type) {
+ case mp_forever_text:
+ mp_print_nl(mp, "<forever> ");
+ break;
+ case mp_loop_text:
+ {
+ mp_node pp = mp->param_stack[param_start];
+ mp_print_nl(mp, "<for(");
+ if (pp != NULL) {
+ if (mp_link(pp) == MP_VOID) {
+ mp_print_exp(mp, pp, 0);
+ } else {
+ mp_show_token_list(mp, pp, NULL);
+ }
+ }
+ mp_print_str(mp, ")> ");
+ }
+ break;
+ case mp_parameter_text:
+ mp_print_nl(mp, "<argument> ");
+ break;
+ case mp_backed_up_text:
+ mp_print_nl(mp, nloc == NULL ? "<recently read> " : "<to be read again> ");
+ break;
+ case mp_inserted_text:
+ mp_print_nl(mp, "<inserted text> ");
+ break;
+ case mp_macro_text:
+ mp_print_nl(mp, "<macro> ");
+
+ if (name != NULL) {
+ mp_print_mp_str(mp, name);
+ } else {
+ {
+ mp_node pp = mp->param_stack[param_start];
+ if (pp == NULL) {
+ mp_show_token_list(mp, mp->param_stack[param_start + 1], NULL);
+ } else {
+ mp_node qq = pp;
+ while (mp_link(qq) != NULL) {
+ qq = mp_link(qq);
+ }
+ mp_link(qq) = mp->param_stack[param_start + 1];
+ mp_show_token_list(mp, pp, NULL);
+ mp_link(qq) = NULL;
+ }
+ }
+ }
+ mp_print_str(mp, " -> ");
+ break;
+ default:
+ mp_print_nl(mp, "?");
+ break;
+ }
+ }
+ if (token_type == mp_macro_text) {
+ mp_show_macro(mp, nstart, nloc);
+ } else if (mp->show_mode) {
+ mp_show_token_list_space(mp, nstart, nloc);
+ } else {
+ mp_show_token_list(mp, nstart, nloc);
+ }
+ }
+ }
+ if (file_state && (name > max_spec_src || mp->file_ptr == 0)) {
+ break;
+ } else {
+ --mp->file_ptr;
+ }
+ }
+ mp->cur_input = mp->input_stack[mp->input_ptr];
+}
+
+void mp_push_input (MP mp)
+{
+ if (mp->input_ptr > mp->max_in_stack) {
+ mp->max_in_stack = mp->input_ptr;
+ if (mp->input_ptr == mp->stack_size) {
+ int l = (mp->stack_size + (mp->stack_size/4));
+ if (l > 1000) {
+ mp_fatal_error(mp, "job aborted, more than 1000 input levels");
+ } else {
+ mp_in_state_record *s = mp_memory_reallocate(mp->input_stack, (size_t) (l + 1) * sizeof(mp_in_state_record));
+ if (s) {
+ mp->input_stack = s;
+ mp->stack_size = l;
+ } else {
+ mp_fatal_error(mp, "job aborted, out of memory");
+ }
+ }
+ }
+ }
+ mp->input_stack[mp->input_ptr] = mp->cur_input;
+ ++mp->input_ptr;
+}
+
+void mp_pop_input (MP mp)
+{
+ --mp->input_ptr;
+ mp->cur_input = mp->input_stack[mp->input_ptr];
+}
+
+static void mp_begin_token_list (MP mp, mp_node p, int t)
+{
+ mp_push_input(mp);
+ nstart = p;
+ token_type = t;
+ param_start = mp->param_ptr;
+ nloc = p;
+}
+
+static void mp_end_token_list (MP mp)
+{
+ if (token_type >= mp_backed_up_text) {
+ if (token_type <= mp_inserted_text) {
+ mp_flush_token_list(mp, nstart);
+ goto DONE;
+ } else {
+ mp_delete_mac_ref(mp, nstart);
+ }
+ }
+ while (mp->param_ptr > param_start) {
+ mp_node p;
+ --mp->param_ptr;
+ p = mp->param_stack[mp->param_ptr];
+ if (p != NULL) {
+ if (mp_link(p) == MP_VOID) {
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ } else {
+ mp_flush_token_list(mp, p);
+ }
+ }
+ }
+ DONE:
+ mp_pop_input(mp);
+}
+
+static void mp_encapsulate (MP mp, mp_value_node p)
+{
+ mp_node q = mp_new_value_node(mp);
+ mp_name_type(q) = mp_capsule_operation;
+ mp_new_dep(mp, q, mp->cur_exp.type, p);
+ mp_set_cur_exp_node(mp, q);
+}
+static void mp_install (MP mp, mp_node r, mp_node q)
+{
+ if (mp_type(q) == mp_known_type) {
+ mp_type(r) = mp_known_type;
+ mp_set_value_number(r, mp_get_value_number(q));
+ } else if (mp_type(q) == mp_independent_type) {
+ mp_value_node p = mp_single_dependency(mp, q);
+ if (p == mp->dep_final) {
+ mp_type(r) = mp_known_type;
+ mp_set_value_number(r, zero_t);
+ mp_free_dep_node(mp, p);
+ } else {
+ mp_new_dep(mp, r, mp_dependent_type, p);
+ }
+ } else {
+ mp_new_dep(mp, r, mp_type(q), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) q)));
+ }
+}
+
+static void mp_make_exp_copy (MP mp, mp_node p)
+{
+ RESTART:
+ mp->cur_exp.type = mp_type(p);
+ switch (mp->cur_exp.type) {
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_known_type:
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ {
+ mp_node t = mp_new_ring_entry(mp, p);
+ mp_set_cur_exp_node(mp, t);
+ }
+ break;
+ case mp_string_type:
+ mp_set_cur_exp_str(mp, mp_get_value_str(p));
+ break;
+ case mp_picture_type:
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ mp_add_edge_ref(mp, cur_exp_node);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_set_cur_exp_knot(mp, mp_copy_pen(mp, mp_get_value_knot(p)));
+ break;
+ case mp_path_type:
+ mp_set_cur_exp_knot(mp, mp_copy_path(mp, mp_get_value_knot(p)));
+ break;
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ {
+ mp_node t;
+ mp_value_node q;
+ if (mp_get_value_node(p) == NULL) {
+ switch (mp_type(p)) {
+ case mp_pair_type:
+ mp_init_pair_node(mp, p);
+ break;
+ case mp_color_type:
+ mp_init_color_node(mp, p, mp_color_type);
+ break;
+ case mp_cmykcolor_type:
+ mp_init_color_node(mp, p, mp_cmykcolor_type);
+ break;
+ case mp_transform_type:
+ mp_init_transform_node(mp, p);
+ break;
+ default:
+ break;
+ }
+ }
+ t = mp_new_value_node(mp);
+ mp_name_type(t) = mp_capsule_operation;
+ q = (mp_value_node) mp_get_value_node(p);
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ mp_init_pair_node(mp, t);
+ mp_install(mp, mp_y_part(mp_get_value_node(t)), mp_y_part(q));
+ mp_install(mp, mp_x_part(mp_get_value_node(t)), mp_x_part(q));
+ break;
+ case mp_color_type:
+ mp_init_color_node(mp, t, mp_color_type);
+ mp_install(mp, mp_blue_part(mp_get_value_node(t)), mp_blue_part(q));
+ mp_install(mp, mp_green_part(mp_get_value_node(t)), mp_green_part(q));
+ mp_install(mp, mp_red_part(mp_get_value_node(t)), mp_red_part(q));
+ break;
+ case mp_cmykcolor_type:
+ mp_init_color_node(mp, t, mp_cmykcolor_type);
+ mp_install(mp, mp_black_part(mp_get_value_node(t)), mp_black_part(q));
+ mp_install(mp, mp_yellow_part(mp_get_value_node(t)), mp_yellow_part(q));
+ mp_install(mp, mp_magenta_part(mp_get_value_node(t)), mp_magenta_part(q));
+ mp_install(mp, mp_cyan_part(mp_get_value_node(t)), mp_cyan_part(q));
+ break;
+ case mp_transform_type:
+ mp_init_transform_node(mp, t);
+ mp_install(mp, mp_yy_part(mp_get_value_node(t)), mp_yy_part(q));
+ mp_install(mp, mp_yx_part(mp_get_value_node(t)), mp_yx_part(q));
+ mp_install(mp, mp_xy_part(mp_get_value_node(t)), mp_xy_part(q));
+ mp_install(mp, mp_xx_part(mp_get_value_node(t)), mp_xx_part(q));
+ mp_install(mp, mp_ty_part(mp_get_value_node(t)), mp_ty_part(q));
+ mp_install(mp, mp_tx_part(mp_get_value_node(t)), mp_tx_part(q));
+ break;
+ default:
+ break;
+ }
+ mp_set_cur_exp_node(mp, t);
+ }
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ mp_encapsulate (mp, mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) p)));
+ break;
+ case mp_numeric_type:
+ mp_new_indep(mp, p);
+ goto RESTART;
+ case mp_independent_type:
+ {
+ mp_value_node q = mp_single_dependency(mp, p);
+ if (q == mp->dep_final) {
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &zero_t);
+ mp_free_dep_node(mp, q);
+ } else {
+ mp->cur_exp.type = mp_dependent_type;
+ mp_encapsulate (mp, q);
+ }
+ }
+ break;
+ case mp_undefined_type:
+ mp_confusion(mp, "undefined copy");
+ break;
+ default:
+ mp_confusion(mp, "copy");
+ break;
+ }
+}
+
+static mp_node mp_cur_tok (MP mp)
+{
+ mp_node p;
+ if (cur_sym == NULL && (cur_sym_mod == 0 || cur_sym_mod == mp_normal_operation)) {
+ if (cur_cmd == mp_capsule_command) {
+ mp_number save_exp_num;
+ mp_value save_exp = mp->cur_exp;
+ new_number(save_exp_num);
+ number_clone(save_exp_num, cur_exp_value_number);
+ mp_make_exp_copy(mp, cur_mod_node);
+ p = mp_stash_cur_exp(mp);
+ mp_link(p) = NULL;
+ mp->cur_exp = save_exp;
+ number_clone(mp->cur_exp.data.n, save_exp_num);
+ free_number(save_exp_num);
+ } else {
+ p = mp_new_token_node(mp);
+ mp_name_type(p) = mp_token_operation;
+ if (cur_cmd == mp_numeric_command) {
+ mp_set_value_number(p, cur_mod_number);
+ mp_type(p) = mp_known_type;
+ } else {
+ mp_set_value_str(p, cur_mod_str);
+ mp_type(p) = mp_string_type;
+ }
+ }
+ } else {
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, cur_sym);
+ mp_name_type(p) = cur_sym_mod;
+ }
+ return p;
+}
+
+void mp_back_input (MP mp)
+{
+ mp_node p = mp_cur_tok(mp);
+ while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp);
+ }
+ mp_begin_token_list(mp, p, mp_backed_up_text);
+}
+
+static void mp_back_error (MP mp, const char *msg, const char *hlp)
+{
+ mp_back_input(mp);
+ mp_error(mp, msg, hlp);
+}
+
+static void mp_ins_error (MP mp, const char *msg, const char *hlp)
+{
+ mp_back_input(mp);
+ token_type = mp_inserted_text;
+ mp_error(mp, msg, hlp);
+}
+
+void mp_begin_file_reading (MP mp)
+{
+ if (mp->in_open == (mp->max_in_open-1)) {
+ mp_reallocate_input_stack (mp, (mp->max_in_open + mp->max_in_open / 4));
+ }
+ if (mp->first == mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + mp->buf_size / 4));
+ }
+ mp->in_open++;
+ mp_push_input(mp);
+ iindex = (int) mp->in_open;
+ if (mp->in_open_max < mp->in_open) {
+ mp->in_open_max = mp->in_open;
+ }
+ start = (int) mp->first;
+ name = is_term;
+}
+
+static void mp_end_file_reading (MP mp)
+{
+ if (mp->in_open > iindex) {
+ if ((name <= max_spec_src)) {
+ mp_confusion(mp, "endinput");
+ } else {
+ (mp->close_file) (mp, mp->input_file[mp->in_open]);
+ --mp->in_open;
+ }
+ }
+ mp->first = (size_t) start;
+ if (iindex != mp->in_open) {
+ mp_confusion(mp, "endinput");
+ } else {
+ if (name > max_spec_src) {
+ (mp->close_file) (mp, cur_file);
+ }
+ mp_pop_input(mp);
+ --mp->in_open;
+ }
+}
+
+static int mp_check_outer_validity (MP mp)
+{
+ if (mp->scanner_status == mp_normal_state) {
+ return 1;
+ } else if (mp->scanner_status == mp_tex_flushing_state) {
+ if (cur_sym != NULL) {
+ return 1;
+ } else {
+ char msg[256];
+ mp_snprintf(msg, 256, "TeX mode didn't end; all text was ignored after line %d", (int) mp->warning_line);
+ set_cur_sym(mp->frozen_etex);
+ mp_ins_error(
+ mp,
+ msg,
+ "The file ended while I was looking for the 'etex' to finish this TeX material.\n"
+ "I've inserted 'etex' now."
+ );
+ return 0;
+ }
+ } else {
+
+ if (mp->scanner_status > mp_skipping_state) {
+ {
+ char msg[256];
+ const char *mst = NULL;
+ const char *hlp =
+ "I suspect you have forgotten an 'enddef', causing me to read past where you\n"
+ "wanted me to stop. I'll try to recover.";
+ mp_runaway(mp);
+ if (cur_sym == NULL) {
+ mst = "File ended while scanning";
+ } else {
+ mst = "Forbidden token found while scanning";
+ }
+ switch (mp->scanner_status) {
+ case mp_flushing_state:
+ {
+ mp_snprintf(msg, 256, "%s to the end of the statement", mst);
+ hlp =
+ "A previous error seems to have propagated, causing me to read past where\n"
+ "you wanted me to stop. I'll try to recover.";
+ set_cur_sym(mp->frozen_semicolon);
+ }
+ break;
+ case mp_absorbing_state:
+ {
+ mp_snprintf(msg, 256, "%s a text argument", mst);
+ hlp =
+ "It seems that a right delimiter was left out, causing me to read past where\n"
+ "you wanted me to stop. I'll try to recover.";
+ if (mp->warning_info == NULL) {
+ set_cur_sym(mp->frozen_end_group);
+ } else {
+ set_cur_sym(mp->frozen_right_delimiter);
+ set_equiv_sym(cur_sym, mp->warning_info);
+ }
+ }
+ break;
+ case mp_var_defining_state:
+ {
+ mp_string s;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_variable_name(mp, mp->warning_info_node);
+ s = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "%s the definition of %s", mst, s->str);
+ delete_str_ref(s);
+ set_cur_sym(mp->frozen_end_def);
+ }
+ break;
+ case mp_op_defining_state:
+ {
+ char *s = mp_str(mp, text(mp->warning_info));
+ mp_snprintf(msg, 256, "%s the definition of %s", mst, s);
+ set_cur_sym(mp->frozen_end_def);
+ }
+ break;
+ case mp_loop_defining_state:
+ {
+ char *s = mp_str(mp, text(mp->warning_info));
+ mp_snprintf(msg, 256, "%s the text of a %s loop", mst, s);
+ hlp =
+ "I suspect you have forgotten an 'endfor', causing me to read past where\n"
+ "you wanted me to stop. I'll try to recover.";
+ set_cur_sym(mp->frozen_end_for);
+ }
+ break;
+ }
+ mp_ins_error(mp, msg, hlp);
+ }
+ } else {
+ char msg[256];
+ const char *hlp = NULL;
+ mp_snprintf(msg, 256, "Incomplete if; all text was ignored after line %d", (int) mp->warning_line);
+ if (cur_sym == NULL) {
+ hlp =
+ "The file ended while I was skipping conditional text. This kind of error happens\n"
+ "when you say 'if ...' and forget the matching 'fi'. I've inserted a 'fi'; this\n"
+ "might work.";
+ } else {
+ hlp =
+ "A forbidden 'outer' token occurred in skipped text. This kind of error happens\n"
+ "when you say 'if ...' and forget the matching 'fi'. I've inserted a 'fi'; this\n"
+ "might work.";
+ }
+ set_cur_sym(mp->frozen_fi);
+ mp_ins_error(mp, msg, hlp);
+ }
+ return 0;
+ }
+}
+
+void mp_runaway (MP mp)
+{
+ if (mp->scanner_status > mp_flushing_state) {
+ mp_print_nl(mp, "Runaway ");
+ switch (mp->scanner_status) {
+ case mp_absorbing_state:
+ mp_print_str(mp, "text?");
+ break;
+ case mp_var_defining_state:
+ case mp_op_defining_state:
+ mp_print_str(mp, "definition?");
+ break;
+ case mp_loop_defining_state:
+ mp_print_str(mp, "loop?");
+ break;
+ }
+ mp_print_ln(mp);
+ mp_show_token_list(mp, mp_link(mp->hold_head), NULL);
+ }
+}
+
+void mp_get_next (MP mp)
+{
+ mp_sym cur_sym_;
+ RESTART:
+ set_cur_sym(NULL);
+ set_cur_sym_mod(0);
+ if (file_state) {
+ int k;
+ unsigned char c;
+ int cclass;
+ SWITCH:
+ c = mp->buffer[loc];
+ ++loc;
+ cclass = mp->char_class[c];
+ switch (cclass) {
+ case mp_digit_class:
+ scan_numeric_token((c - '0'));
+ return;
+ case mp_period_class:
+ cclass = mp->char_class[mp->buffer[loc]];
+ if (cclass > mp_period_class) {
+ goto SWITCH;
+ } else if (cclass < mp_period_class) {
+ scan_fractional_token(0);
+ return;
+ } else {
+ break;
+ }
+ case mp_space_class:
+ goto SWITCH;
+ case mp_percent_class:
+ if (mp->scanner_status == mp_tex_flushing_state && loc < limit) {
+ goto SWITCH;
+ }
+ if (mp_move_to_next_line(mp)) {
+ goto RESTART;
+ } else {
+ goto SWITCH;
+ }
+ case mp_string_class:
+ if (mp->scanner_status == mp_tex_flushing_state) {
+ goto SWITCH;
+ } else {
+ unsigned char cend = c == '"' ? '"' : 3 ;
+ if (mp->buffer[loc] == cend) {
+ set_cur_mod_str(mp_rts(mp,""));
+ } else {
+ k = loc;
+ mp->buffer[limit + 1] = cend;
+ do {
+ ++loc;
+ } while (mp->buffer[loc] != cend);
+ if (loc > limit) {
+ loc = limit;
+ mp_error(
+ mp,
+ "Incomplete string token has been flushed",
+ "Strings should finish on the same line as they began. I've deleted the partial\n"
+ "string."
+ );
+ goto RESTART;
+ }
+ mp_str_room(mp, (size_t) (loc - k));
+ do {
+ mp_append_char(mp, mp->buffer[k]);
+ ++k;
+ } while (k != loc);
+ set_cur_mod_str(mp_make_string(mp));
+ }
+ ++loc;
+ set_cur_cmd(mp_string_command);
+ return;
+ }
+ case mp_comma_class:
+ case mp_semicolon_class:
+ case mp_left_parenthesis_class:
+ case mp_right_parenthesis_class:
+ k = loc - 1;
+ goto FOUND;
+ case mp_invalid_class:
+ if (mp->scanner_status == mp_tex_flushing_state) {
+ goto SWITCH;
+ } else {
+ mp_error(
+ mp,
+ "Text line contains an invalid character",
+ "A funny symbol that I can\'t read has just been input. Continue, and I'll forget\n"
+ "that it ever happened."
+ );
+ goto RESTART;
+ }
+ default:
+ break;
+ }
+ k = loc - 1;
+ while (mp->char_class[mp->buffer[loc]] == cclass) {
+ ++loc;
+ }
+ FOUND:
+ set_cur_sym(mp_id_lookup(mp, (char *) (mp->buffer + k), (size_t) (loc - k), 1));
+ } else {
+ if (nloc != NULL && mp_type(nloc) == mp_symbol_node_type) {
+ int cur_sym_mod_ = mp_name_type(nloc);
+ int cur_info = mp_get_sym_info(nloc);
+ set_cur_sym(mp_get_sym_sym(nloc));
+ set_cur_sym_mod(cur_sym_mod_);
+ nloc = mp_link(nloc);
+ if (cur_sym_mod_ == mp_expr_operation) {
+ set_cur_cmd(mp_capsule_command);
+ set_cur_mod_node(mp->param_stack[param_start + cur_info]);
+ set_cur_sym_mod(0);
+ set_cur_sym(NULL);
+ return;
+ } else if (cur_sym_mod_ == mp_suffix_operation || cur_sym_mod_ == mp_text_operation) {
+ mp_begin_token_list(mp, mp->param_stack[param_start + cur_info], (int) mp_parameter_text);
+ goto RESTART;
+ }
+ } else if (nloc != NULL) {
+ if (mp_name_type(nloc) == mp_token_operation) {
+ if (mp_type(nloc) == mp_known_type) {
+ set_cur_mod_number(mp_get_value_number(nloc));
+ set_cur_cmd(mp_numeric_command);
+ } else {
+ set_cur_mod_str(mp_get_value_str(nloc));
+ set_cur_cmd(mp_string_command);
+ add_str_ref(cur_mod_str);
+ }
+ } else {
+ set_cur_mod_node(nloc);
+ set_cur_cmd(mp_capsule_command);
+ }
+ nloc = mp_link(nloc);
+ return;
+ } else {
+ mp_end_token_list(mp);
+ goto RESTART;
+ }
+ }
+ cur_sym_ = cur_sym;
+ set_cur_cmd(eq_type(cur_sym_));
+ set_cur_mod(equiv(cur_sym_));
+ set_cur_mod_node(equiv_node(cur_sym_));
+
+}
+
+static int mp_move_to_next_line (MP mp)
+{
+ if (name > max_spec_src) {
+ ++line;
+ mp->first = (size_t) start;
+ if (! mp->force_eof) {
+ if (mp_input_ln(mp, cur_file)) {
+ mp_firm_up_the_line(mp);
+ } else {
+ mp->force_eof = 1;
+ }
+ };
+ if (mp->force_eof) {
+ mp->force_eof = 0;
+ --loc;
+ if (mp->interaction < mp_silent_mode) {
+ mp_print_chr(mp, ')');
+ --mp->open_parens;
+ update_terminal();
+ }
+ mp_end_file_reading(mp);
+ mp_check_outer_validity(mp);
+ return 1;
+ } else {
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ }
+ } else if (mp->input_ptr > 0) {
+ mp_end_file_reading(mp);
+ return 1;
+ } else if (mp->interaction > mp_nonstop_mode) {
+ if (limit == start && mp->interaction < mp_silent_mode) {
+ mp_print_nl(mp, "(Please type a command or say `end')");
+ }
+ mp_print_ln(mp);
+ mp->first = (size_t) start;
+ if (! mp_input_ln(mp, mp->term_in)) {
+ longjmp(*(mp->jump_buf), 1);
+ }
+ mp->buffer[mp->last] = '%';
+ limit = (int) mp->last;
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ } else {
+ mp_fatal_error(mp, "job aborted, no legal end found");
+ }
+ return 0;
+}
+
+void mp_firm_up_the_line (MP mp)
+{
+ limit = (int) mp->last;
+}
+
+static void mp_t_next (MP mp)
+{
+ if ((mp->extensions == 1) && (cur_cmd == mp_btex_command)) {
+ char *txt = NULL;
+ char *ptr = NULL;
+ int slin = line;
+ int size = 0;
+ int done = 0;
+ int mode = round_unscaled(internal_value(mp_texscriptmode_internal)) ;
+ int verb = cur_mod == mp_verbatim_code;
+ int first;
+ if (loc <= limit && mp->char_class[mp->buffer[loc]] == mp_space_class) {
+ ++loc;
+ } else {
+ }
+ first = loc;
+ while (1) {
+ if (loc < limit - 4) {
+ if (mp->buffer[loc] == 'e') {
+ ++loc;
+ if (mp->buffer[loc] == 't') {
+ ++loc;
+ if (mp->buffer[loc] == 'e') {
+ ++loc;
+ if (mp->buffer[loc] == 'x') {
+ if (first == (loc - 3)) {
+ done = 1;
+ } else if (mp->char_class[mp->buffer[loc - 4]] == mp_space_class) {
+ done = 2;
+ }
+ if (done) {
+ if ((loc + 1) <= limit) {
+ int c = mp->char_class[mp->buffer[loc + 1]] ;
+ if (c != mp_letter_class) {
+ ++loc;
+ break;
+ } else {
+ done = 0;
+ }
+ } else {
+ ++loc;
+ break;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ if (loc >= limit) {
+ if (size) {
+ txt = mp_memory_reallocate(txt, (size_t) (size + limit - first + 1));
+ } else {
+ txt = mp_memory_allocate((size_t) (limit - first + 1));
+ }
+ memcpy(txt + size, mp->buffer + first, limit - first);
+ size += limit - first + 1;
+ if (mode <= 0) {
+ txt[size - 1] = ' ';
+ } else if (verb) {
+ txt[size - 1] = '\n';
+ } else if (mode >= 2) {
+ txt[size - 1] = '\n';
+ } else {
+ txt[size - 1] = ' ';
+ }
+ if (mp_move_to_next_line(mp)) {
+ goto FATAL_ERROR;
+ }
+ first = loc;
+ } else {
+ ++loc;
+ }
+ }
+ if (done) {
+ int l = loc - 5 ;
+ int n = l - first + 1 ;
+ if (done == 2) {
+ l -= 1;
+ n -= 1;
+ }
+ if (size) {
+ txt = mp_memory_reallocate(txt, (size_t) (size + n + 1));
+ } else {
+ txt = mp_memory_allocate((size_t) (n + 1));
+ }
+ memcpy(txt + size, mp->buffer + first, n);
+ size += n;
+ if (verb && mode >= 3) {
+ txt[size] = '\0';
+ ptr = txt;
+ } else if (mode >= 4) {
+ txt[size] = '\0';
+ ptr = txt;
+ } else {
+ while ((size > 1) && (mp->char_class[(unsigned char) txt[size-1]] == mp_space_class || txt[size-1] == '\n')) {
+ --size;
+ }
+ txt[size] = '\0';
+ ptr = txt;
+ while ((size > 1) && (mp->char_class[(unsigned char) ptr[0]] == mp_space_class || ptr[0] == '\n')) {
+ ++ptr;
+ --size;
+ }
+ }
+ check_script_result(mp, mp->make_text(mp, ptr, size, verb));
+ mp_memory_free(txt);
+ mp_get_next(mp);
+ return;
+ }
+ FATAL_ERROR:
+ {
+ char msg[256];
+ if (slin > 0) {
+ mp_snprintf(msg, 256, "No matching 'etex' for '%stex'.", verb ? "verbatim" : "b");
+ } else {
+ mp_snprintf(msg, 256, "No matching 'etex' for '%stex' in line %d.", verb ? "verbatim" : "b",slin);
+ }
+ mp_error(mp, msg, "An 'etex' is missing at this input level, nothing gets done.");
+ mp_memory_free(txt);
+ }
+ } else {
+ {
+ mp_error(
+ mp,
+ "A 'btex/verbatimtex ... etex' definition needs an extension",
+ "This file contains picture expressions for 'btex ... etex' blocks. Such files\n"
+ "need an extension (plugin) that seems to be absent."
+ );
+ }
+ }
+}
+
+static mp_node mp_scan_toks (MP mp, mp_command_code terminator, mp_subst_list_item * subst_list, mp_node tail_end, int suffix_count)
+{
+ int cur_data;
+ int cur_data_mod = 0;
+ mp_node p = mp->hold_head;
+ int balance = 1;
+ mp_link(mp->hold_head) = NULL;
+ while (1) {
+ get_t_next(mp);
+ cur_data = -1;
+ if (cur_sym != NULL) {
+ {
+ mp_subst_list_item *q = subst_list;
+ while (q != NULL) {
+ if (q->info == cur_sym && q->info_mod == cur_sym_mod) {
+ cur_data = q->value_data;
+ cur_data_mod = q->value_mod;
+ set_cur_cmd(mp_relax_command);
+ break;
+ }
+ q = q->link;
+ }
+ }
+ if (cur_cmd == terminator) {
+ if (cur_mod > 0) {
+ ++balance;
+ } else {
+ --balance;
+ if (balance == 0)
+ break;
+ }
+ } else if (cur_cmd == mp_macro_special_command) {
+ if (cur_mod == mp_macro_quote_code) {
+ get_t_next(mp);
+ } else if (cur_mod <= suffix_count) {
+ cur_data = cur_mod - 1;
+ cur_data_mod = mp_suffix_operation;
+ }
+ }
+ }
+ if (cur_data != -1) {
+ mp_node pp = mp_new_symbolic_node(mp);
+ mp_set_sym_info(pp, cur_data);
+ mp_name_type(pp) = cur_data_mod;
+ mp_link(p) = pp;
+ } else {
+ mp_link(p) = mp_cur_tok(mp);
+ }
+ p = mp_link(p);
+ }
+ mp_link(p) = tail_end;
+ while (subst_list) {
+ mp_subst_list_item *q = subst_list->link;
+ mp_memory_free(subst_list);
+ subst_list = q;
+ }
+ return mp_link(mp->hold_head);
+}
+
+static void mp_get_symbol (MP mp)
+{
+ RESTART:
+ get_t_next(mp);
+ if ((cur_sym == NULL) || mp_is_frozen(mp, cur_sym)) {
+ const char *hlp = NULL;
+ if (cur_sym != NULL) {
+ hlp =
+ "Sorry: You can't redefine my error-recovery tokens. I've inserted an\n"
+ "inaccessible symbol so that your definition will be completed without\n"
+ "mixing me up too badly.";
+ } else {
+ hlp =
+ "Sorry: You can't redefine a number, string, or expr. I've inserted an\n"
+ "inaccessible symbol so that your definition will be completed without\n"
+ "mixing me up too badly.";
+ if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+ }
+ }
+ set_cur_sym(mp->frozen_inaccessible);
+ mp_ins_error(mp, "Missing symbolic token inserted", hlp);
+ goto RESTART;
+ }
+}
+
+static void mp_get_clear_symbol (MP mp)
+{
+ mp_get_symbol(mp);
+ mp_clear_symbol(mp, cur_sym, 0);
+}
+
+static void mp_check_equals (MP mp)
+{
+ if (cur_cmd != mp_equals_command && cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing '=' has been inserted",
+ "The next thing in this 'def' should have been '=', because I've already looked at\n"
+ "the definition heading. But don't worry; I'll pretend that an equals sign was\n"
+ "present. Everything from here to 'enddef' will be the replacement text of this\n"
+ "macro."
+ );
+ }
+}
+
+static void mp_make_op_def (MP mp, int code)
+{
+ mp_node q, r;
+ mp_command_code m = (code == mp_primary_def_code) ? mp_primary_def_command : (code == mp_secondary_def_code ? mp_secondary_def_command : mp_tertiary_def_command);
+ mp_subst_list_item *qm = NULL;
+ mp_subst_list_item *qn = NULL;
+ mp_get_symbol(mp);
+ qm = mp_memory_allocate(sizeof(mp_subst_list_item));
+ qm->link = NULL;
+ qm->info = cur_sym;
+ qm->info_mod = cur_sym_mod;
+ qm->value_data = 0;
+ qm->value_mod = mp_expr_operation;
+ mp_get_clear_symbol(mp);
+ mp->warning_info = cur_sym;
+ mp_get_symbol(mp);
+ qn = mp_memory_allocate(sizeof(mp_subst_list_item));
+ qn->link = qm;
+ qn->info = cur_sym;
+ qn->info_mod = cur_sym_mod;
+ qn->value_data = 1;
+ qn->value_mod = mp_expr_operation;
+ get_t_next(mp);
+ mp_check_equals(mp);
+ mp->scanner_status = mp_op_defining_state;
+ q = mp_new_symbolic_node(mp);
+ mp_set_ref_count(q, 0);
+ r = mp_new_symbolic_node(mp);
+ mp_link(q) = r;
+ mp_set_sym_info(r, mp_general_macro);
+ mp_name_type(r) = mp_macro_operation;
+ mp_link(r) = mp_scan_toks(mp, mp_macro_def_command, qn, NULL, 0);
+ mp->scanner_status = mp_normal_state;
+ set_eq_type(mp->warning_info, m);
+ set_equiv_node(mp->warning_info, q);
+ mp_get_x_next(mp);
+}
+
+static void mp_scan_def (MP mp, int code)
+{
+ int n;
+ int k;
+ mp_subst_list_item *r = NULL;
+ mp_subst_list_item *rp = NULL;
+ mp_node q;
+ mp_node p;
+ int sym_type;
+ mp_sym l_delim, r_delim;
+ int c = mp_general_macro;
+ mp_link(mp->hold_head) = NULL;
+ q = mp_new_symbolic_node(mp);
+ mp_set_ref_count(q, 0);
+ r = NULL;
+ if (code == mp_def_code) {
+ mp_get_clear_symbol(mp);
+ mp->warning_info = cur_sym;
+ get_t_next(mp);
+ mp->scanner_status = mp_op_defining_state;
+ n = 0;
+ set_eq_type(mp->warning_info, mp_defined_macro_command);
+ set_equiv_node(mp->warning_info, q);
+ } else {
+ p = mp_scan_declared_variable(mp);
+ mp_flush_variable(mp, equiv_node(mp_get_sym_sym(p)), mp_link(p), 1);
+ mp->warning_info_node = mp_find_variable(mp, p);
+ mp_flush_node_list(mp, p);
+ if (mp->warning_info_node == NULL) {
+ mp_error(
+ mp,
+ "This variable already starts with a macro",
+ "After 'vardef a' you can't say 'vardef a.b'. So I'll have to discard this\n"
+ "definition."
+ );
+ mp->warning_info_node = mp->bad_vardef;
+ }
+ mp->scanner_status = mp_var_defining_state;
+ n = 2;
+ if (cur_cmd == mp_macro_special_command && cur_mod == mp_macro_suffix_code) {
+ n = 3;
+ get_t_next(mp);
+ }
+ mp_type(mp->warning_info_node) = mp_unsuffixed_macro_type - 2 + n;
+ mp_set_value_node(mp->warning_info_node, q);
+ }
+ k = n;
+ if (cur_cmd == mp_left_delimiter_command) {
+ do {
+ l_delim = cur_sym;
+ r_delim = equiv_sym(cur_sym);
+ get_t_next(mp);
+ if (cur_cmd == mp_parameter_commmand) {
+ switch (cur_mod) {
+ case mp_expr_parameter:
+ sym_type = mp_expr_operation;
+ goto OKAY;
+ break;
+ case mp_suffix_parameter:
+ sym_type = mp_suffix_operation;
+ goto OKAY;
+ break;
+ case mp_text_parameter:
+ sym_type = mp_text_operation;
+ goto OKAY;
+ break;
+ default:
+ break;
+ }
+ }
+ mp_back_error(
+ mp,
+ "Missing parameter type; 'expr' will be assumed",
+ "You should've had 'expr' or 'suffix' or 'text' here."
+ );
+ sym_type = mp_expr_operation;
+ OKAY:
+ do {
+ mp_link(q) = mp_new_symbolic_node(mp);
+ q = mp_link(q);
+ mp_name_type(q) = sym_type;
+ mp_set_sym_info(q, k);
+ mp_get_symbol(mp);
+ rp = mp_memory_allocate(sizeof(mp_subst_list_item));
+ rp->link = NULL;
+ rp->value_data = k;
+ rp->value_mod = sym_type;
+ rp->info = cur_sym;
+ rp->info_mod = cur_sym_mod;
+ mp_check_param_size(mp, k);
+ ++k;
+ rp->link = r;
+ r = rp;
+ get_t_next(mp);
+ } while (cur_cmd == mp_comma_command);
+
+ mp_check_delimiter(mp, l_delim, r_delim);
+ get_t_next(mp);
+ } while (cur_cmd == mp_left_delimiter_command);
+ }
+ if (cur_cmd == mp_parameter_commmand) {
+ rp = mp_memory_allocate(sizeof(mp_subst_list_item));
+ rp->link = NULL;
+ rp->value_data = k;
+ switch (cur_mod) {
+ case mp_expr_parameter:
+ rp->value_mod = mp_expr_operation;
+ c = mp_expr_macro;
+ break;
+ case mp_suffix_parameter:
+ rp->value_mod = mp_suffix_operation;
+ c = mp_suffix_macro;
+ break;
+ case mp_text_parameter:
+ rp->value_mod = mp_text_operation;
+ c = mp_text_macro;
+ break;
+ default:
+ c = cur_mod;
+ rp->value_mod = mp_expr_operation;
+ break;
+ }
+ mp_check_param_size(mp, k);
+ ++k;
+ mp_get_symbol(mp);
+ rp->info = cur_sym;
+ rp->info_mod = cur_sym_mod;
+ rp->link = r;
+ r = rp;
+ get_t_next(mp);
+ if (c == mp_expr_macro && cur_cmd == mp_of_command) {
+ c = mp_of_macro;
+ rp = mp_memory_allocate(sizeof(mp_subst_list_item));
+ rp->link = NULL;
+ mp_check_param_size(mp, k);
+ rp->value_data = k;
+ rp->value_mod = mp_expr_operation;
+ mp_get_symbol(mp);
+ rp->info = cur_sym;
+ rp->info_mod = cur_sym_mod;
+ rp->link = r;
+ r = rp;
+ get_t_next(mp);
+ }
+ }
+ mp_check_equals(mp);
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_info(p, c);
+ mp_name_type(p) = mp_macro_operation;
+ mp_link(q) = p;
+ if (code == mp_def_code) {
+ mp_link(p) = mp_scan_toks(mp, mp_macro_def_command, r, NULL, (int) n);
+ } else {
+ mp_node qq = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(qq, mp->bg_loc);
+ mp_link(p) = qq;
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, mp->eg_loc);
+ mp_link(qq) = mp_scan_toks(mp, mp_macro_def_command, r, p, (int) n);
+ }
+ if (mp->warning_info_node == mp->bad_vardef) {
+ mp_flush_token_list(mp, mp_get_value_node(mp->bad_vardef));
+ }
+ mp->scanner_status = mp_normal_state;
+ mp_get_x_next(mp);
+}
+
+static void mp_check_expansion_depth (MP mp)
+{
+ if (++mp->expand_depth_count >= mp->expand_depth) {
+ if (mp->interaction >= mp_error_stop_mode) {
+ mp->interaction=mp_scroll_mode;
+ }
+ mp_error(
+ mp,
+ "Maximum expansion depth reached",
+ "Recursive macro expansion cannot be unlimited because of runtime stack\n"
+ "constraints. The limit is 10000 recursion levels in total."
+ );
+ mp->history=mp_fatal_error_stop;
+ mp_jump_out(mp);
+ }
+}
+
+static void mp_expand (MP mp)
+{
+ mp_check_expansion_depth(mp);
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t) && cur_cmd != mp_defined_macro_command) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ switch (cur_cmd) {
+ case mp_if_test_command:
+ mp_conditional(mp);
+ break;
+ case mp_fi_or_else_command:
+ if (cur_mod > mp->if_limit) {
+ if (mp->if_limit == mp_if_code) {
+ mp_back_input(mp);
+ set_cur_sym(mp->frozen_colon);
+ mp_ins_error(mp, "Missing ':' has been inserted", "Something was missing here");
+ } else {
+ const char *hlp = "I'm ignoring this; it doesn't match any if.";
+ switch (cur_mod) {
+ case mp_fi_code:
+ mp_error(mp, "Extra 'fi'", hlp);
+ break;
+ case mp_else_code:
+ mp_error(mp, "Extra 'else'", hlp);
+ break;
+ default:
+ mp_error(mp, "Extra 'elseif'", hlp);
+ break;
+ }
+ }
+ } else {
+ while (cur_mod != mp_fi_code) {
+ mp_pass_text(mp);
+ }
+ mp_pop_condition_stack(mp);
+ }
+ break;
+ case mp_input_command:
+ if (cur_mod > 0) {
+ mp->force_eof = 1;
+ } else {
+ mp_start_input(mp);
+ }
+ break;
+ case mp_iteration_command:
+ if (cur_mod == mp_end_for_code) {
+ {
+ mp_error(
+ mp,
+ "Extra 'endfor'",
+ "I'm not currently working on a for loop, so I had better not try to end anything."
+ );
+ }
+ } else {
+ mp_begin_iteration(mp);
+ }
+ break;
+ case mp_repeat_loop_command:
+ {
+ while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp);
+ }
+ if (mp->loop_ptr == NULL) {
+ mp_error(
+ mp,
+ "Lost loop",
+ "I'm confused; after exiting from a loop, I still seem to want to repeat it. I'll\n"
+ "try to forget the problem."
+ );
+ } else {
+ mp_resume_iteration(mp);
+ }
+ }
+ break;
+ case mp_exit_test_command:
+ {
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_boolean_type) {
+ do_boolean_error(mp);
+ }
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ mp_show_cmd_mod(mp, mp_nullary_command, cur_exp_value_boolean);
+ }
+ if (cur_exp_value_boolean == mp_true_operation) {
+ if (mp->loop_ptr != NULL) {
+ mp_node p = NULL;
+ do {
+ if (file_state) {
+ mp_end_file_reading(mp);
+ } else {
+ if (token_type <= mp_loop_text) {
+ p = nstart;
+ }
+ mp_end_token_list(mp);
+ }
+ } while (p == NULL);
+ if (p != mp->loop_ptr->info) {
+ mp_fatal_error(mp, "*** (loop confusion)");
+ }
+ mp_stop_iteration(mp);
+ } else if (cur_cmd == mp_semicolon_command) {
+ mp_error(
+ mp,
+ "No loop is in progress",
+ "Why say 'exitif' when there's nothing to exit from?"
+ );
+ } else {
+ mp_back_error(
+ mp,
+ "No loop is in progress",
+ "Why say 'exitif' when there's nothing to exit from?"
+ );
+ }
+ } else if (cur_cmd != mp_semicolon_command) {
+ mp_back_error(
+ mp,
+ "Missing ';' has been inserted",
+ "After 'exitif <boolean exp>' I expect to see a semicolon. I shall pretend that\n"
+ "one was there."
+ );
+ }
+ }
+ break;
+ case mp_relax_command:
+ break;
+ case mp_expand_after_command:
+ {
+ mp_node p;
+ get_t_next(mp);
+ p = mp_cur_tok(mp);
+ get_t_next(mp);
+ if (cur_cmd < mp_min_command) {
+ mp_expand(mp);
+ } else {
+ mp_back_input(mp);
+ }
+ mp_begin_token_list(mp, p, mp_backed_up_text);
+ }
+ break;
+ case mp_scan_tokens_command:
+ {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a string",
+ "I'm going to flush this expression, since scantokens should be followed by a\n"
+ "known string."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_back_input(mp);
+ if (cur_exp_str->len > 0) {
+ size_t k;
+ size_t j;
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_begin_file_reading(mp);
+ name = is_scantok;
+ k = mp->first + (size_t) cur_exp_str->len;
+ if (k >= mp->max_buf_stack) {
+ while (k >= mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size / 4)));
+ }
+ mp->max_buf_stack = k + 1;
+ }
+ j = 0;
+ limit = (int) k;
+ while (mp->first < (size_t) limit) {
+ mp->buffer[mp->first] = *(cur_exp_str->str + j);
+ j++;
+ ++mp->first;
+ }
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ }
+ }
+ break;
+ case mp_runscript_command:
+ {
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ switch (mp->cur_exp.type) {
+ case mp_string_type:
+ {
+ mp_back_input(mp);
+ if (cur_exp_str->len > 0) {
+ check_script_result(mp, mp->run_script(mp, (const char*) cur_exp_str->str, cur_exp_str->len, 0));
+ }
+ }
+ break;
+ case mp_numeric_type:
+ case mp_known_type:
+ {
+ int n = 0 ;
+ mp_back_input(mp);
+ n = (int) number_to_scaled (cur_exp_value_number) / 65536;
+ if (n > 0) {
+ check_script_result(mp, mp->run_script(mp, NULL, 0, n));
+ }
+ }
+ break;
+ default:
+ {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a string",
+ "I'm going to flush this expression, since runscript should be followed by a known\n"
+ "string or number."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ }
+ }
+ }
+ break;
+ case mp_maketext_command:
+ {
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ if (mp->cur_exp.type == mp_string_type) {
+ mp_back_input(mp);
+ if (cur_exp_str->len > 0) {
+ check_script_result(mp, mp->make_text(mp, (const char*) cur_exp_str->str, cur_exp_str->len, 0));
+ }
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a string",
+ "I'm going to flush this expression, since 'maketext' should be followed by a\n"
+ "known string."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ }
+ }
+ break;
+ case mp_defined_macro_command:
+ mp_macro_call(mp, cur_mod_node, NULL, cur_sym);
+ break;
+ default:
+ break;
+ };
+ mp->expand_depth_count--;
+}
+
+void check_script_result (MP mp, char *s)
+{
+ if (s) {
+ size_t size = strlen(s);
+ if (size > 0) {
+ size_t k ;
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_begin_file_reading(mp);
+ name = is_scantok;
+ mp->last = mp->first;
+ k = mp->first + size;
+ if (k >= mp->max_buf_stack) {
+ while (k >= mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size / 4)));
+ }
+ mp->max_buf_stack = k + 1;
+ }
+ limit = (int) k;
+ memcpy((mp->buffer + mp->first), s, size);
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ lmt_memory_free(s);
+ }
+}
+
+static void mp_get_x_next (MP mp)
+{
+ get_t_next(mp);
+ if (cur_cmd < mp_min_command) {
+ mp_node save_exp = mp_stash_cur_exp(mp);
+ do {
+ if (cur_cmd == mp_defined_macro_command) {
+ mp_macro_call(mp, cur_mod_node, NULL, cur_sym);
+ } else {
+ mp_expand(mp);
+ }
+ get_t_next(mp);
+ } while (cur_cmd < mp_min_command);
+ mp_unstash_cur_exp(mp, save_exp);
+ }
+}
+
+static void mp_macro_call (MP mp, mp_node def_ref, mp_node arg_list, mp_sym macro_name)
+{
+ int n;
+ mp_node tail = 0;
+ mp_sym l_delim = NULL;
+ mp_sym r_delim = NULL;
+ mp_node r = mp_link(def_ref);
+ mp_add_mac_ref(def_ref);
+ if (arg_list == NULL) {
+ n = 0;
+ } else {
+ n = 1;
+ tail = arg_list;
+ while (mp_link(tail) != NULL) {
+ ++n;
+ tail = mp_link(tail);
+ }
+ }
+ if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_ln(mp);
+ mp_print_macro_name(mp, arg_list, macro_name);
+ if (n == 3) {
+ mp_print_str(mp, "@#");
+ }
+ mp_show_macro (mp, def_ref, NULL);
+ if (arg_list != NULL) {
+ mp_node p = arg_list;
+ n = 0;
+ do {
+ mp_node q = (mp_node) mp_get_sym_sym(p);
+ mp_print_arg(mp, q, n, 0, 0);
+ ++n;
+ p = mp_link(p);
+ } while (p != NULL);
+ }
+ mp_end_diagnostic(mp, 0);
+ }
+ set_cur_cmd(mp_comma_command + 1);
+ while (mp_name_type(r) == mp_expr_operation || mp_name_type(r) == mp_suffix_operation || mp_name_type(r) == mp_text_operation) {
+ if (cur_cmd != mp_comma_command) {
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_left_delimiter_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_macro_name(mp, arg_list, macro_name);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Missing argument to %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ if (mp_name_type(r) == mp_suffix_operation || mp_name_type(r) == mp_text_operation) {
+ mp_set_cur_exp_value_number(mp, &zero_t);
+ mp->cur_exp.type = mp_token_list_type;
+ } else {
+ mp_set_cur_exp_value_number(mp, &zero_t);
+ mp->cur_exp.type = mp_known_type;
+ }
+ mp_back_error(
+ mp,
+ msg,
+ "That macro has more parameters than you thought. I'll continue by pretending that\n"
+ "each missing argument is either zero or null."
+ );
+ set_cur_cmd(mp_right_delimiter_command);
+ goto FOUND;
+ }
+ l_delim = cur_sym;
+ r_delim = equiv_sym(cur_sym);
+ }
+ if (mp_name_type(r) == mp_text_operation) {
+ mp_scan_text_arg(mp, l_delim, r_delim);
+ } else {
+ mp_get_x_next(mp);
+ if (mp_name_type(r) == mp_suffix_operation) {
+ mp_scan_suffix(mp);
+ } else {
+ mp_scan_expression(mp);
+ }
+ }
+ if ((cur_cmd != mp_comma_command) && ((cur_cmd != mp_right_delimiter_command) || (equiv_sym(cur_sym) != l_delim))) {
+ switch (mp_name_type(mp_link(r))) {
+ case mp_expr_operation:
+ case mp_suffix_operation:
+ case mp_text_operation:
+ {
+ mp_back_error(
+ mp,
+ "Missing ',' has been inserted",
+ "I've finished reading a macro argument and am about to read another; the\n"
+ "arguments weren't delimited correctly."
+ );
+ set_cur_cmd(mp_comma_command);
+ }
+ break;
+ default:
+ {
+ char msg[256];
+ mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim)));
+ mp_back_error(mp, msg, "I've gotten to the end of the macro parameter list.");
+ }
+ break;
+ }
+ }
+ FOUND:
+ {
+ mp_node p = mp_new_symbolic_node(mp);
+ if (mp->cur_exp.type == mp_token_list_type) {
+ mp_set_sym_sym(p, mp->cur_exp.data.node);
+ } else {
+ mp_set_sym_sym(p, mp_stash_cur_exp(mp));
+ }
+ if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, mp_get_sym_info(r), mp_name_type(r));
+ mp_end_diagnostic(mp, 0);
+ }
+ if (arg_list == NULL) {
+ arg_list = p;
+ } else {
+ mp_link(tail) = p;
+ }
+ tail = p;
+ ++n;
+ }
+
+ r = mp_link(r);
+ }
+ if (cur_cmd == mp_comma_command) {
+ char msg[256];
+ mp_string rname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_macro_name(mp, arg_list, macro_name);
+ rname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Too many arguments to %s; Missing '%s' has been inserted",
+ mp_str(mp, rname), mp_str(mp, text(r_delim)));
+ delete_str_ref(rname);
+
+ mp_error(
+ mp,
+ msg,
+ "I'm going to assume that the comma I just read was a right delimiter, and then:\n"
+ "I'll begin expanding the macro."
+ );
+ }
+ if (mp_get_sym_info(r) != mp_general_macro) {
+ if (mp_get_sym_info(r) < mp_text_macro) {
+ mp_get_x_next(mp);
+ if (mp_get_sym_info(r) != mp_suffix_macro) {
+ if ((cur_cmd == mp_equals_command) || (cur_cmd == mp_assignment_command)) {
+ mp_get_x_next(mp);
+ }
+ }
+ }
+ switch (mp_get_sym_info(r)) {
+ case mp_primary_macro:
+ mp_scan_primary(mp);
+ break;
+ case mp_secondary_macro:
+ mp_scan_secondary(mp);
+ break;
+ case mp_tertiary_macro:
+ mp_scan_tertiary(mp);
+ break;
+ case mp_expr_macro:
+ mp_scan_expression(mp);
+ break;
+ case mp_of_macro:
+ {
+ mp_node p;
+ mp_scan_expression(mp);
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, mp_stash_cur_exp(mp));
+ if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, 0, 0);
+ mp_end_diagnostic(mp, 0);
+ }
+ if (arg_list == NULL) {
+ arg_list = p;
+ } else {
+ mp_link(tail) = p;
+ }
+ tail = p;
+ ++n;
+ if (cur_cmd != mp_of_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_macro_name(mp, arg_list, macro_name);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Missing 'of' has been inserted for %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_back_error(mp, msg, "I've got the first argument; will look now for the other.");
+ }
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ }
+ break;
+ case mp_suffix_macro:
+ {
+ if (cur_cmd != mp_left_delimiter_command) {
+ l_delim = NULL;
+ } else {
+ l_delim = cur_sym;
+ r_delim = equiv_sym(cur_sym);
+ mp_get_x_next(mp);
+ }
+ mp_scan_suffix(mp);
+ if (l_delim != NULL) {
+ if ((cur_cmd != mp_right_delimiter_command) || (equiv_sym(cur_sym) != l_delim)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim)));
+ mp_back_error(mp, msg, "I've gotten to the end of the macro parameter list.");
+ }
+ mp_get_x_next(mp);
+ }
+ }
+ break;
+ case mp_text_macro:
+ mp_scan_text_arg(mp, NULL, NULL);
+ break;
+ }
+ mp_back_input(mp);
+ {
+ mp_node p = mp_new_symbolic_node(mp);
+ if (mp->cur_exp.type == mp_token_list_type) {
+ mp_set_sym_sym(p, mp->cur_exp.data.node);
+ } else {
+ mp_set_sym_sym(p, mp_stash_cur_exp(mp));
+ }
+ if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, mp_get_sym_info(r), mp_name_type(r));
+ mp_end_diagnostic(mp, 0);
+ }
+ if (arg_list == NULL) {
+ arg_list = p;
+ } else {
+ mp_link(tail) = p;
+ }
+ tail = p;
+ ++n;
+ }
+
+ }
+ r = mp_link(r);
+
+ while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp);
+ }
+ if (mp->param_ptr + n > mp->max_param_stack) {
+ mp->max_param_stack = mp->param_ptr + n;
+ mp_check_param_size(mp, mp->max_param_stack);
+ }
+ mp_begin_token_list(mp, def_ref, mp_macro_text);
+ name = macro_name ? text(macro_name) : NULL;
+ nloc = r;
+ if (n > 0) {
+ mp_node p = arg_list;
+ do {
+ mp->param_stack[mp->param_ptr] = (mp_node) mp_get_sym_sym(p);
+ ++mp->param_ptr;
+ p = mp_link(p);
+ } while (p != NULL);
+ mp_flush_node_list(mp, arg_list);
+ }
+}
+
+static void mp_print_macro_name (MP mp, mp_node a, mp_sym n)
+{
+ if (n) {
+ mp_print_mp_str(mp,text(n));
+ } else {
+ mp_node p = (mp_node) mp_get_sym_sym(a);
+ if (p) {
+ mp_node q = p;
+ while (mp_link(q) != NULL) {
+ q = mp_link(q);
+ }
+ mp_link(q) = (mp_node) mp_get_sym_sym(mp_link(a));
+ mp_show_token_list(mp, p, NULL);
+ mp_link(q) = NULL;
+ } else {
+ mp_print_mp_str(mp,text(mp_get_sym_sym((mp_node) mp_get_sym_sym(mp_link(a)))));
+ }
+ }
+}
+
+static void mp_print_arg (MP mp, mp_node q, int n, int b, int bb)
+{
+ if (q && mp_link(q) == MP_VOID) {
+ mp_print_nl(mp, "(EXPR");
+ } else if ((bb < mp_text_operation) && (b != mp_text_macro)) {
+ mp_print_nl(mp, "(SUFFIX");
+ } else {
+ mp_print_nl(mp, "(TEXT");
+ }
+ mp_print_int(mp, n);
+ mp_print_str(mp, ")<-");
+ if (q && mp_link(q) == MP_VOID) {
+ mp_print_exp(mp, q, 1);
+ } else {
+ mp_show_token_list(mp, q, NULL);
+ }
+}
+
+void mp_scan_text_arg (MP mp, mp_sym l_delim, mp_sym r_delim)
+{
+ int balance = 1;
+ mp->warning_info = l_delim;
+ mp->scanner_status = mp_absorbing_state;
+ mp_node p = mp->hold_head;
+ mp_link(mp->hold_head) = NULL;
+ while (1) {
+ get_t_next(mp);
+ if (l_delim == NULL) {
+ if (mp_end_of_statement) {
+ if (balance == 1) {
+ break;
+ } else if (cur_cmd == mp_end_group_command) {
+ --balance;
+ }
+ } else if (cur_cmd == mp_begin_group_command) {
+ ++balance;
+ }
+ } else {
+ if (cur_cmd == mp_right_delimiter_command) {
+ if (equiv_sym(cur_sym) == l_delim) {
+ --balance;
+ if (balance == 0) {
+ break;
+ }
+ }
+ } else if (cur_cmd == mp_left_delimiter_command) {
+ if (equiv_sym(cur_sym) == r_delim) {
+ ++balance;
+ }
+ }
+ }
+ mp_link(p) = mp_cur_tok(mp);
+ p = mp_link(p);
+ }
+ mp_set_cur_exp_node(mp, mp_link(mp->hold_head));
+ mp->cur_exp.type = mp_token_list_type;
+ mp->scanner_status = mp_normal_state;
+}
+
+static void mp_stack_argument (MP mp, mp_node p)
+{
+ if (mp->param_ptr == mp->max_param_stack) {
+ ++mp->max_param_stack;
+ mp_check_param_size(mp, mp->max_param_stack);
+ }
+ mp->param_stack[mp->param_ptr] = p;
+ ++mp->param_ptr;
+}
+
+static mp_node mp_get_if_node (MP mp) {
+ mp_if_node p = (mp_if_node) mp_allocate_node(mp, sizeof(mp_if_node_data));
+ mp_type(p) = mp_if_node_type;
+ return (mp_node) p;
+}
+
+void mp_pass_text (MP mp)
+{
+ int level = 0;
+ mp->scanner_status = mp_skipping_state;
+ mp->warning_line = mp_true_line(mp);
+ while (1) {
+ get_t_next(mp);
+ if (cur_cmd <= mp_fi_or_else_command) {
+ if (cur_cmd < mp_fi_or_else_command) {
+ ++level;
+ } else if (level == 0) {
+ break;
+ } else if (cur_mod == mp_fi_code) {
+ --level;
+ }
+ } else {
+ if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+ }
+ }
+ }
+ mp->scanner_status = mp_normal_state;
+}
+
+static void mp_push_condition_stack (MP mp)
+{
+ mp_node p = mp_get_if_node(mp);
+ mp_link(p) = mp->cond_ptr;
+ mp_type(p) = (int) mp->if_limit;
+ mp_name_type(p) = mp->cur_if;
+ mp_if_line_field(p) = mp->if_line;
+ mp->cond_ptr = p;
+ mp->if_limit = mp_if_code;
+ mp->if_line = mp_true_line(mp);
+ mp->cur_if = mp_if_code;
+}
+
+static void mp_pop_condition_stack (MP mp)
+{
+ mp_node p = mp->cond_ptr;
+ mp->if_line = mp_if_line_field(p);
+ mp->cur_if = mp_name_type(p);
+ mp->if_limit = mp_type(p);
+ mp->cond_ptr = mp_link(p);
+ mp_free_node(mp, p, sizeof(mp_if_node_data));
+}
+
+static void mp_change_if_limit (MP mp, int l, mp_node p)
+{
+ if (p == mp->cond_ptr) {
+ mp->if_limit = l;
+ } else {
+ mp_node q = mp->cond_ptr;
+ while (1) {
+ if (q == NULL) {
+ mp_confusion(mp, "if");
+ return;
+ } else if (mp_link(q) == p) {
+ mp_type(q) = l;
+ return;
+ } else {
+ q = mp_link(q);
+ }
+ }
+ }
+}
+
+static void mp_check_colon (MP mp)
+{
+ if (cur_cmd != mp_colon_command) {
+ mp_back_error(
+ mp,
+ "Missing ':' has been inserted",
+ "There should've been a colon after the condition. I shall pretend that one was\n"
+ "there."
+ );
+ }
+}
+
+void mp_conditional (MP mp)
+{
+ mp_node save_cond_ptr;
+ int new_if_limit;
+ mp_push_condition_stack(mp);
+ save_cond_ptr = mp->cond_ptr;
+ RESWITCH:
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_boolean_type) {
+ do_boolean_error(mp);
+ }
+ new_if_limit = mp_else_if_code;
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_str(mp, cur_exp_value_boolean == mp_true_operation ? "{true}" : "{false}");
+ mp_end_diagnostic(mp, 0);
+ }
+ FOUND:
+ mp_check_colon(mp);
+ if (cur_exp_value_boolean == mp_true_operation) {
+ mp_change_if_limit (mp, (int) new_if_limit, save_cond_ptr);
+ return;
+ }
+ while (1) {
+ mp_pass_text(mp);
+ if (mp->cond_ptr == save_cond_ptr) {
+ goto DONE;
+ } else if (cur_mod == mp_fi_code) {
+ mp_pop_condition_stack(mp);
+ }
+ }
+ DONE:
+ mp->cur_if = (int) cur_mod;
+ mp->if_line = mp_true_line(mp);
+ if (cur_mod == mp_fi_code) {
+ mp_pop_condition_stack(mp);
+ } else if (cur_mod == mp_else_if_code) {
+ goto RESWITCH;
+ } else {
+ mp_set_cur_exp_value_boolean(mp, mp_true_operation);
+ new_if_limit = mp_fi_code;
+ mp_get_x_next(mp);
+ goto FOUND;
+ }
+}
+
+static void mp_bad_for (MP mp, const char *s)
+{
+ char msg[256];
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_snprintf(msg, 256, "Improper %s has been replaced by 0", s);
+ mp_back_error(
+ mp,
+ msg,
+ "When you say 'for x=a step b until c', the initial value 'a' and the step size\n"
+ "'b' and the final value 'c' must have known numeric values. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+void mp_begin_iteration (MP mp)
+{
+ mp_node q;
+ mp_sym n = cur_sym;
+ mp_subst_list_item *p = NULL;
+ int m = cur_mod;
+ mp_loop_data *s = mp_memory_allocate(sizeof(mp_loop_data));
+ s->type = NULL;
+ s->list = NULL;
+ s->info = NULL;
+ s->list_start = NULL;
+ s->link = NULL;
+ s->var = NULL;
+ s->point = NULL;
+ new_number(s->value);
+ new_number(s->old_value);
+ new_number(s->step_size);
+ new_number(s->final_value);
+ if (m == mp_start_forever_code) {
+ s->type = MP_VOID;
+ mp_get_x_next(mp);
+ } else {
+ mp_get_symbol(mp);
+ p = mp_memory_allocate(sizeof(mp_subst_list_item));
+ p->link = NULL;
+ p->info = cur_sym;
+ s->var = cur_sym;
+ p->info_mod = cur_sym_mod;
+ p->value_data = 0;
+ if (m == mp_start_for_code) {
+ p->value_mod = mp_expr_operation;
+ } else {
+ p->value_mod = mp_suffix_operation;
+ }
+ mp_get_x_next(mp);
+ if (p->value_mod == mp_expr_operation && cur_cmd == mp_within_command) {
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type == mp_path_type) {
+ number_clone(s->value, zero_t);
+ number_clone(s->old_value, zero_t);
+ number_clone(s->step_size, unity_t);
+ {
+ mp_knot p = cur_exp_knot;
+
+ int l = 0;
+ while (1) {
+ mp_knot n = mp_next_knot(p);
+ if (n == cur_exp_knot) {
+ s->point = p;
+ set_number_from_int(s->final_value, l);
+ break;
+ } else {
+ p = n;
+ ++l;
+ }
+ }
+ }
+ s->type = MP_PROGRESSION_FLAG;
+ s->list = mp_new_symbolic_node(mp);
+ s->list_start = s->list;
+ q = s->list;
+ } else {
+ if (mp->cur_exp.type != mp_picture_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ new_expr.data.node = (mp_node) mp_get_edge_header_node(mp);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper iteration spec has been replaced by nullpicture",
+ "When you say 'for x in p', p must be a known picture."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp_init_edges(mp, (mp_edge_header_node) mp->cur_exp.data.node);
+ mp->cur_exp.type = mp_picture_type;
+ }
+ s->type = mp->cur_exp.data.node;
+ mp->cur_exp.type = mp_vacuous_type;
+ q = mp_link(mp_edge_list(mp->cur_exp.data.node));
+ if (q != NULL && mp_is_start_or_stop (q) && mp_skip_1component(mp, q) == NULL) {
+ q = mp_link(q);
+ }
+ s->list = q;
+ }
+ } else {
+ if ((cur_cmd != mp_equals_command) && (cur_cmd != mp_assignment_command)) {
+ mp_back_error(
+ mp,
+ "Missing '=' has been inserted",
+ "The next thing in this loop should have been '=' or ':='. But don't worry; I'll\n"
+ "pretend that an equals sign was present, and I'll look for the values next."
+ );
+ }
+ s->type = NULL;
+ s->list = mp_new_symbolic_node(mp);
+ s->list_start = s->list;
+ q = s->list;
+ do {
+ mp_get_x_next(mp);
+ if (m != mp_start_for_code) {
+ mp_scan_suffix(mp);
+ } else {
+ if (cur_cmd >= mp_colon_command && cur_cmd <= mp_comma_command) {
+ goto CONTINUE;
+ }
+ mp_scan_expression(mp);
+ if (cur_cmd == mp_step_command && q == s->list) {
+ {
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_for (mp, "initial value");
+ }
+ number_clone(s->value, cur_exp_value_number);
+ number_clone(s->old_value, cur_exp_value_number);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_for (mp, "step size");
+ }
+ number_clone(s->step_size, cur_exp_value_number);
+ if (cur_cmd != mp_until_command) {
+ mp_back_error(
+ mp,
+ "Missing 'until' has been inserted",
+ "I assume you meant to say 'until' after 'step'. So I'll look for the final value\n"
+ "and colon next."
+ );
+ }
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_for (mp, "final value");
+ }
+ number_clone(s->final_value, cur_exp_value_number);
+ s->type = MP_PROGRESSION_FLAG;
+ break;
+ }
+ }
+ mp_set_cur_exp_node(mp, mp_stash_cur_exp(mp));
+ }
+ mp_link(q) = mp_new_symbolic_node(mp);
+ q = mp_link(q);
+ mp_set_sym_sym(q, mp->cur_exp.data.node);
+ if (m == mp_start_for_code) {
+ mp_name_type(q) = mp_expr_operation;
+ } else if (m == mp_start_forsuffixes_code) {
+ mp_name_type(q) = mp_suffix_operation;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ CONTINUE:
+ ;
+ } while (cur_cmd == mp_comma_command);
+ }
+ }
+ if (cur_cmd != mp_colon_command) {
+ mp_back_error(
+ mp,
+ "Missing ':' has been inserted",
+ "The next thing in this loop should have been a ':'. So I'll pretend that a colon\n"
+ "was present; everything from here to 'endfor' will be iterated."
+ );
+ }
+ q = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(q, mp->frozen_repeat_loop);
+ mp->scanner_status = mp_loop_defining_state;
+ mp->warning_info = n;
+ s->info = mp_scan_toks(mp, mp_iteration_command, p, q, 0);
+ mp->scanner_status = mp_normal_state;
+ s->link = mp->loop_ptr;
+ mp->loop_ptr = s;
+
+ mp_resume_iteration(mp);
+}
+
+void mp_resume_iteration (MP mp)
+{
+ mp_node p, q;
+ p = mp->loop_ptr->type;
+ if (p == MP_PROGRESSION_FLAG) {
+ mp_set_cur_exp_value_number(mp, &(mp->loop_ptr->value));
+ if ((number_positive(mp->loop_ptr->step_size) && number_greater(cur_exp_value_number, mp->loop_ptr->final_value))
+ || (number_negative(mp->loop_ptr->step_size) && number_less (cur_exp_value_number, mp->loop_ptr->final_value))) {
+ mp_stop_iteration(mp);
+ return;
+ }
+ mp->cur_exp.type = mp_known_type;
+ q = mp_stash_cur_exp(mp);
+ number_clone(mp->loop_ptr->old_value, cur_exp_value_number);
+ set_number_from_addition(mp->loop_ptr->value, cur_exp_value_number, mp->loop_ptr->step_size);
+ if (number_positive(mp->loop_ptr->step_size) && number_less(mp->loop_ptr->value, cur_exp_value_number)) {
+ if (number_positive(mp->loop_ptr->final_value)) {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->final_value, -1);
+ } else {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->value, 1);
+ }
+ } else if (number_negative(mp->loop_ptr->step_size) && number_greater(mp->loop_ptr->value, cur_exp_value_number)) {
+ if (number_negative(mp->loop_ptr->final_value)) {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->final_value, 1);
+ } else {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->value, -1);
+ }
+ }
+ if (mp->loop_ptr->point != NULL) {
+ mp->loop_ptr->point = mp_next_knot(mp->loop_ptr->point);
+ }
+ } else if (p == NULL) {
+ p = mp->loop_ptr->list;
+ if (p != NULL && p == mp->loop_ptr->list_start) {
+ q = p;
+ p = mp_link(p);
+ mp_free_symbolic_node(mp, q);
+ mp->loop_ptr->list = p;
+ }
+ if (p == NULL) {
+ mp_stop_iteration(mp);
+ return;
+ }
+ mp->loop_ptr->list = mp_link(p);
+ q = (mp_node) mp_get_sym_sym(p);
+ if (q) {
+ number_clone(mp->loop_ptr->old_value, q->data.n);
+ }
+ mp_free_symbolic_node(mp, p);
+ } else if (p == MP_VOID) {
+ mp_begin_token_list(mp, mp->loop_ptr->info, mp_forever_text);
+ return;
+ } else {
+ q = mp->loop_ptr->list;
+ if (q == NULL) {
+ goto NOT_FOUND;
+ } else if (! mp_is_start_or_stop(q)) {
+ q = mp_link(q);
+ } else if (! mp_is_stop(q)) {
+ q = mp_skip_1component(mp, q);
+ } else {
+ goto NOT_FOUND;
+ }
+ mp_set_cur_exp_node(mp, (mp_node) mp_copy_objects (mp, mp->loop_ptr->list, q));
+ mp_init_bbox(mp, (mp_edge_header_node) cur_exp_node);
+ mp->cur_exp.type = mp_picture_type;
+ mp->loop_ptr->list = q;
+ q = mp_stash_cur_exp(mp);
+ }
+ mp_begin_token_list(mp, mp->loop_ptr->info, mp_loop_text);
+ mp_stack_argument(mp, q);
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{loop value=");
+ if ((q != NULL) && (mp_link(q) == MP_VOID)) {
+ mp_print_exp(mp, q, 1);
+ } else {
+ mp_show_token_list(mp, q, NULL);
+ }
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+ }
+ return;
+ NOT_FOUND:
+ mp_stop_iteration(mp);
+}
+
+void mp_stop_iteration (MP mp)
+{
+ mp_node p = mp->loop_ptr->type;
+ if (p == MP_PROGRESSION_FLAG) {
+ mp_free_symbolic_node(mp, mp->loop_ptr->list);
+ if (mp->loop_ptr->point) {
+ mp_toss_knot_list(mp, mp->loop_ptr->point);
+ }
+ } else if (p == NULL) {
+ mp_node q = mp->loop_ptr->list;
+ while (q != NULL) {
+ p = (mp_node) mp_get_sym_sym(q);
+ if (p != NULL) {
+ if (mp_link(p) == MP_VOID) {
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ } else {
+ mp_flush_token_list(mp, p);
+ }
+ }
+ p = q;
+ q = mp_link(q);
+ mp_free_symbolic_node(mp, p);
+ }
+ } else if (p > MP_PROGRESSION_FLAG) {
+ mp_delete_edge_ref(mp, p);
+ }
+ {
+ mp_loop_data *tmp = mp->loop_ptr;
+ mp->loop_ptr = tmp->link;
+ mp_flush_token_list(mp, tmp->info);
+ free_number(tmp->value);
+ free_number(tmp->step_size);
+ free_number(tmp->final_value);
+ mp_memory_free(tmp);
+ }
+}
+
+void mp_begin_name (MP mp)
+{
+ mp_memory_free(mp->cur_name);
+ mp->cur_name = NULL;
+ mp->quoted_filename = 0;
+}
+
+int mp_more_name (MP mp, unsigned char c)
+{
+ if (c == '"') {
+ mp->quoted_filename = ! mp->quoted_filename;
+ } else if ((c == ' ' || c == '\t') && (mp->quoted_filename == 0)) {
+ return 0;
+ } else {
+ mp_str_room(mp, 1);
+ mp_append_char(mp, c);
+ }
+ return 1;
+}
+
+void mp_end_name (MP mp)
+{
+ mp->cur_name = mp_memory_allocate((size_t) (mp->cur_length + 1) * sizeof(char));
+ (void) memcpy(mp->cur_name, (char *) (mp->cur_string), mp->cur_length);
+ mp->cur_name[mp->cur_length] = 0;
+ mp_reset_cur_string(mp);
+}
+
+void mp_pack_file_name (MP mp, const char *n)
+{
+ mp_memory_free(mp->name_of_file);
+ mp->name_of_file = mp_strdup(n);
+}
+
+static mp_string mp_make_name_string (MP mp)
+{
+ int name_length = (int) strlen(mp->name_of_file);
+ mp_str_room(mp, name_length);
+ for (int k = 0; k < name_length; k++) {
+ mp_append_char(mp, (unsigned char) mp->name_of_file[k]);
+ }
+ return mp_make_string(mp);
+}
+
+static void mp_scan_file_name (MP mp)
+{
+ mp_begin_name(mp);
+ while (mp->buffer[loc] == ' ') {
+ ++loc;
+ }
+ while (1) {
+ if ((mp->buffer[loc] == ';') || (mp->buffer[loc] == '%')) {
+ break;
+ } else if (! mp_more_name(mp, mp->buffer[loc])) {
+ break;
+ } else {
+ ++loc;
+ }
+ }
+ mp_end_name(mp);
+}
+
+static void mp_ptr_scan_file (MP mp, char *s)
+{
+ char *p = s;
+ char *q = p + strlen(s);
+ mp_begin_name(mp);
+ while (p < q) {
+ if (! mp_more_name(mp, (unsigned char) (*p))) {
+ break;
+ } else {
+ p++;
+ }
+ }
+ mp_end_name(mp);
+}
+
+void mp_start_input (MP mp)
+{
+ while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp);
+ }
+ if (token_state) {
+ mp_error(
+ mp,
+ "File names can't appear within macros",
+ "Sorry ... I've converted what follows to tokens, possibly garbaging the name you\n"
+ "gave. Please delete the tokens and insert the name again."
+ );
+ }
+ if (file_state) {
+ mp_scan_file_name(mp);
+ } else {
+ mp_memory_free(mp->cur_name);
+ mp->cur_name = mp_strdup("");
+ }
+ mp_begin_file_reading(mp);
+ mp_pack_file_name(mp, mp->cur_name);
+ if (mp_open_in(mp, &cur_file, mp_filetype_program)) {
+ char *fname = NULL;
+ name = mp_make_name_string(mp);
+ fname = mp_strdup(mp->name_of_file);
+ if (mp->interaction < mp_silent_mode) {
+ if ((mp->term_offset > 0) || (mp->file_offset > 0)) {
+ mp_print_chr(mp, ' ');
+ }
+ mp_print_chr(mp, '(');
+ ++mp->open_parens;
+ mp_print_str(mp, fname);
+ }
+ mp_memory_free(fname);
+ update_terminal();
+ mp_flush_string(mp, name);
+ name = mp_rts(mp, mp->cur_name);
+ mp_memory_free(mp->cur_name);
+ mp->cur_name = NULL;
+
+ line = 1;
+ mp_input_ln(mp, cur_file);
+ mp_firm_up_the_line(mp);
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ } else {
+ mp_fatal_error(mp, "invalid input file");
+ mp_end_file_reading(mp);
+ }
+}
+
+static int mp_start_read_input (MP mp, char *s, int n)
+{
+ mp_ptr_scan_file(mp, s);
+ mp_pack_file_name(mp, mp->cur_name);
+ mp_begin_file_reading(mp);
+ if (! mp_open_in(mp, &mp->rd_file[n], mp_filetype_text + n)) {
+ mp_end_file_reading(mp);
+ return 0;
+ } else if (! mp_input_ln(mp, mp->rd_file[n])) {
+ (mp->close_file)(mp, mp->rd_file[n]);
+ mp_end_file_reading(mp);
+ return 0;
+ } else {
+ mp->rd_fname[n] = mp_strdup(s);
+ return 1;
+ }
+}
+
+void mp_open_write_file (MP mp, char *s, int n)
+{
+ mp_ptr_scan_file(mp, s);
+ mp_pack_file_name(mp, mp->cur_name);
+ if (mp_open_out(mp, &mp->wr_file[n], mp_filetype_text + n)) {
+ mp->wr_fname[n] = mp_strdup(s);
+ } else {
+ mp_fatal_error(mp, "invalid write file");
+ }
+}
+
+void mp_set_cur_exp_node (MP mp, mp_node n)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ cur_exp_node = n;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+ set_number_to_zero(mp->cur_exp.data.n);
+}
+
+void mp_set_cur_exp_knot (MP mp, mp_knot n)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ cur_exp_knot = n;
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ set_number_to_zero(mp->cur_exp.data.n);
+}
+
+void mp_set_cur_exp_value_boolean (MP mp, int b)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ set_number_from_boolean(mp->cur_exp.data.n, b);
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+}
+
+void mp_set_cur_exp_value_scaled (MP mp, int s)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ set_number_from_scaled(mp->cur_exp.data.n, s);
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+}
+
+void mp_set_cur_exp_value_number (MP mp, mp_number *n)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ number_clone(mp->cur_exp.data.n, *n);
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+}
+
+void mp_set_cur_exp_str (MP mp, mp_string s)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ cur_exp_str = s;
+ add_str_ref(cur_exp_str);
+ cur_exp_node = NULL;
+ cur_exp_knot = NULL;
+ set_number_to_zero(mp->cur_exp.data.n);
+}
+
+static mp_node mp_stash_cur_exp (MP mp)
+{
+ mp_node p;
+ mp_variable_type exp_type = mp->cur_exp.type;
+ switch (exp_type) {
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_pair_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ case mp_cmykcolor_type:
+ p = cur_exp_node;
+ break;
+ default:
+ p = mp_new_value_node(mp);
+ mp_name_type(p) = mp_capsule_operation;
+ mp_type(p) = mp->cur_exp.type;
+ mp_set_value_number(p, cur_exp_value_number);
+ if (cur_exp_str) {
+ mp_set_value_str(p, cur_exp_str);
+ } else if (cur_exp_knot) {
+ mp_set_value_knot(p, cur_exp_knot);
+ } else if (cur_exp_node) {
+ mp_set_value_node(p, cur_exp_node);
+ }
+ break;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_link(p) = MP_VOID;
+ return p;
+}
+
+void mp_unstash_cur_exp (MP mp, mp_node p)
+{
+ mp->cur_exp.type = mp_type(p);
+ switch (mp->cur_exp.type) {
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_pair_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ case mp_cmykcolor_type:
+ mp_set_cur_exp_node(mp, p);
+ break;
+ case mp_token_list_type:
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_path_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_set_cur_exp_knot(mp, mp_get_value_knot(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_string_type:
+ mp_set_cur_exp_str(mp, mp_get_value_str(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_picture_type:
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_boolean_type:
+ case mp_known_type:
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ mp_free_value_node(mp, p);
+ break;
+ default:
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ if (mp_get_value_knot(p)) {
+ mp_set_cur_exp_knot(mp, mp_get_value_knot(p));
+ } else if (mp_get_value_node(p)) {
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ } else if (mp_get_value_str(p)) {
+ mp_set_cur_exp_str(mp, mp_get_value_str(p));
+ }
+ mp_free_value_node(mp, p);
+ break;
+ }
+}
+
+void mp_print_exp (MP mp, mp_node p, int verbosity)
+{
+ int restore_cur_exp;
+ mp_variable_type t;
+ mp_number vv;
+ mp_node v = NULL;
+ new_number(vv);
+ if (p != NULL) {
+ restore_cur_exp = 0;
+ } else {
+ p = mp_stash_cur_exp(mp);
+ restore_cur_exp = 1;
+ }
+ t = mp_type(p);
+ if (t < mp_dependent_type) {
+ if (t != mp_vacuous_type && t != mp_known_type && mp_get_value_node(p) != NULL) {
+ v = mp_get_value_node(p);
+ } else {
+ number_clone(vv, mp_get_value_number(p));
+ }
+ } else if (t < mp_independent_type) {
+ v = (mp_node) mp_get_dep_list((mp_value_node) p);
+ }
+ switch (t) {
+ case mp_vacuous_type:
+ mp_print_str(mp, "vacuous");
+ break;
+ case mp_boolean_type:
+ mp_print_str(mp, number_to_boolean(vv) == mp_true_operation ? "true": "false");
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_numeric_type:
+ {
+ {
+ mp_print_type(mp, t);
+ if (v != NULL) {
+ mp_print_chr(mp, ' ');
+ while ((mp_name_type(v) == mp_capsule_operation) && (v != p)) {
+ v = mp_get_value_node(v);
+ }
+ mp_print_variable_name(mp, v);
+ };
+ }
+ }
+ break;
+ case mp_string_type:
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, mp_get_value_str(p));
+ mp_print_chr(mp, '"');
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ {
+ if (verbosity <= 1) {
+ mp_print_type(mp, t);
+ } else {
+ if (mp->selector == mp_term_and_log_selector)
+ if (number_nonpositive(internal_value(mp_tracing_online_internal))) {
+ mp->selector = mp_term_only_selector;
+ mp_print_type(mp, t);
+ mp_print_str(mp, " (see the transcript file)");
+ mp->selector = mp_term_and_log_selector;
+ };
+ switch (t) {
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_print_pen(mp, mp_get_value_knot(p), "", 0);
+ break;
+ case mp_path_type:
+ mp_print_path(mp, mp_get_value_knot(p), "", 0);
+ break;
+ case mp_picture_type:
+ mp_print_edges(mp, v, "", 0);
+ break;
+ default:
+ break;
+ }
+ }
+ }
+ break;
+ case mp_transform_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ mp_print_chr(mp, '(');
+ mp_print_big_node(mp, mp_tx_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_ty_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_xx_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_xy_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_yx_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_yy_part(v), verbosity);
+ mp_print_chr(mp, ')');
+ }
+ break;
+ case mp_color_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ mp_print_chr(mp, '(');
+ mp_print_big_node(mp, mp_red_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_green_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_blue_part(v), verbosity);
+ mp_print_chr(mp, ')');
+ }
+ break;
+ case mp_pair_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ mp_print_chr(mp, '(');
+ mp_print_big_node(mp, mp_x_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_y_part(v), verbosity);
+ mp_print_chr(mp, ')');
+ }
+ break;
+ case mp_cmykcolor_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ mp_print_chr(mp, '(');
+ mp_print_big_node(mp, mp_cyan_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_magenta_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_yellow_part(v), verbosity);
+ mp_print_chr(mp, ',');
+ mp_print_big_node(mp, mp_black_part(v), verbosity);
+ mp_print_chr(mp, ')');
+ }
+ break;
+ case mp_known_type:
+ print_number(vv);
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ mp_print_dp(mp, t, (mp_value_node) v, verbosity);
+ break;
+ case mp_independent_type:
+ mp_print_variable_name(mp, p);
+ break;
+ default:
+ mp_confusion(mp, "expression");
+ break;
+ }
+ if (restore_cur_exp) {
+ mp_unstash_cur_exp(mp, p);
+ }
+ free_number(vv);
+}
+
+void mp_print_big_node (MP mp, mp_node v, int verbosity)
+{
+ switch (mp_type(v)) {
+ case mp_known_type:
+ print_number(mp_get_value_number(v));
+ break;
+ case mp_independent_type:
+ mp_print_variable_name(mp, v);
+ break;
+ default:
+ mp_print_dp(mp, mp_type(v), (mp_value_node) mp_get_dep_list((mp_value_node) v), verbosity);
+ break;
+ }
+}
+
+static void mp_print_dp (MP mp, int t, mp_value_node p, int verbosity)
+{
+ mp_value_node q = (mp_value_node) mp_link(p);
+ if ((mp_get_dep_info(q) == NULL) || (verbosity > 0)) {
+ mp_print_dependency(mp, p, t);
+ } else {
+ mp_print_str(mp, "linearform");
+ }
+}
+
+void mp_disp_err (MP mp, mp_node p)
+{
+ if (mp->interaction >= mp_error_stop_mode) {
+ wake_up_terminal();
+ }
+ mp_print_nl(mp, "<error> ");
+ mp_print_exp(mp, p, 1);
+}
+
+void mp_flush_cur_exp (MP mp, mp_value v)
+{
+ if (is_number(mp->cur_exp.data.n)) {
+ free_number(mp->cur_exp.data.n);
+ }
+ switch (mp->cur_exp.type) {
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_pair_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ case mp_cmykcolor_type:
+ mp_recycle_value(mp, cur_exp_node);
+ mp_free_value_node(mp, cur_exp_node);
+ break;
+ case mp_string_type:
+ delete_str_ref(cur_exp_str);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ mp_toss_knot_list(mp, cur_exp_knot);
+ break;
+ case mp_picture_type:
+ mp_delete_edge_ref(mp, cur_exp_node);
+ break;
+ default:
+ break;
+ }
+ mp->cur_exp = v;
+ mp->cur_exp.type = mp_known_type;
+}
+
+static void mp_recycle_value (MP mp, mp_node p)
+{
+ if (p != NULL && p != MP_VOID) {
+ mp_variable_type t = mp_type(p);
+ switch (t) {
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_known_type:
+ case mp_numeric_type:
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ mp_ring_delete (mp, p);
+ break;
+ case mp_string_type:
+ delete_str_ref(mp_get_value_str(p));
+ break;
+ case mp_path_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_toss_knot_list(mp, mp_get_value_knot(p));
+ break;
+ case mp_picture_type:
+ mp_delete_edge_ref(mp, mp_get_value_node(p));
+ break;
+ case mp_cmykcolor_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_cyan_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_magenta_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_yellow_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_black_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_cyan_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_magenta_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_black_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_yellow_part(mp_get_value_node(p)));
+ mp_free_node(mp, mp_get_value_node(p), sizeof(mp_color_node_data));
+ }
+ break;
+ case mp_pair_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_x_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_y_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_x_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_y_part(mp_get_value_node(p)));
+ mp_free_pair_node(mp, mp_get_value_node(p));
+ }
+ break;
+ case mp_color_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_red_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_green_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_blue_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_red_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_green_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_blue_part(mp_get_value_node(p)));
+ mp_free_node(mp, mp_get_value_node(p), sizeof(mp_color_node_data));
+ }
+ break;
+ case mp_transform_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_tx_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_ty_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_xx_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_xy_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_yx_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_yy_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_tx_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_ty_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_xx_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_xy_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_yx_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_yy_part(mp_get_value_node(p)));
+ mp_free_node(mp, mp_get_value_node(p), sizeof(mp_transform_node_data));
+ }
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ {
+ mp_value_node qq = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ while (mp_get_dep_info(qq) != NULL) {
+ qq = (mp_value_node) mp_link(qq);
+ }
+ mp_set_link(mp_get_prev_dep((mp_value_node) p), mp_link(qq));
+ mp_set_prev_dep(mp_link(qq), mp_get_prev_dep((mp_value_node) p));
+ mp_set_link(qq, NULL);
+ mp_flush_node_list(mp, (mp_node) mp_get_dep_list((mp_value_node) p));
+ }
+ break;
+ case mp_independent_type:
+ mp_recycle_independent_value(mp, p);
+ break;
+ case mp_token_list_type:
+ case mp_structured_type:
+ mp_confusion(mp, "recycle");
+ break;
+ case mp_unsuffixed_macro_type:
+ case mp_suffixed_macro_type:
+ mp_delete_mac_ref(mp, mp_get_value_node(p));
+ break;
+ default:
+ break;
+ }
+ mp_type(p) = mp_undefined_type;
+ }
+}
+
+static void mp_recycle_independent_value (MP mp, mp_node p)
+{
+ mp_value_node q, r, s;
+ mp_node pp;
+ mp_number v ;
+ mp_number test;
+ mp_variable_type t = mp_type(p);
+ new_number(test);
+ new_number(v);
+ if (t < mp_dependent_type) {
+ number_clone(v, mp_get_value_number(p));
+ }
+ set_number_to_zero(mp->max_c[mp_dependent_type]);
+ set_number_to_zero(mp->max_c[mp_proto_dependent_type]);
+ mp->max_link[mp_dependent_type] = NULL;
+ mp->max_link[mp_proto_dependent_type] = NULL;
+ q = (mp_value_node) mp_link(mp->dep_head);
+ while (q != mp->dep_head) {
+ s = (mp_value_node) mp->temp_head;
+ mp_set_link(s, mp_get_dep_list(q));
+ while (1) {
+ r = (mp_value_node) mp_link(s);
+ if (mp_get_dep_info(r) == NULL) {
+ break;
+ } else if (mp_get_dep_info(r) != p) {
+ s = r;
+ } else {
+ t = mp_type(q);
+ if (mp_link(s) == mp_get_dep_list(q)) {
+ mp_set_dep_list(q, mp_link(r));
+ }
+ mp_set_link(s, mp_link(r));
+ mp_set_dep_info(r, (mp_node) q);
+ number_abs_clone(test, mp_get_dep_value(r));
+ if (number_greater(test, mp->max_c[t])) {
+ if (number_positive(mp->max_c[t])) {
+ mp_set_link(mp->max_ptr[t], (mp_node) mp->max_link[t]);
+ mp->max_link[t] = mp->max_ptr[t];
+ }
+ number_clone(mp->max_c[t], test);
+ mp->max_ptr[t] = r;
+ } else {
+ mp_set_link(r, mp->max_link[t]);
+ mp->max_link[t] = r;
+ }
+ }
+ }
+ q = (mp_value_node) mp_link(r);
+ }
+ if (number_positive(mp->max_c[mp_dependent_type]) || number_positive(mp->max_c[mp_proto_dependent_type])) {
+ mp_number test, ret;
+ new_number(ret);
+ new_number_clone(test, mp->max_c[mp_dependent_type]);
+ number_divide_int(test, 4096);
+ if (number_greaterequal(test, mp->max_c[mp_proto_dependent_type])) {
+ t = mp_dependent_type;
+ } else {
+ t = mp_proto_dependent_type;
+ }
+ s = mp->max_ptr[t];
+ pp = (mp_node) mp_get_dep_info(s);
+ number_clone(v, mp_get_dep_value(s));
+ if (t == mp_dependent_type) {
+ mp_set_dep_value(s, fraction_one_t);
+ } else {
+ mp_set_dep_value(s, unity_t);
+ }
+ number_negate(mp_get_dep_value(s));
+ r = (mp_value_node) mp_get_dep_list((mp_value_node) pp);
+ mp_set_link(s, r);
+ while (mp_get_dep_info(r) != NULL) {
+ r = (mp_value_node) mp_link(r);
+ }
+ q = (mp_value_node) mp_link(r);
+ mp_set_link(r, NULL);
+ mp_set_prev_dep(q, mp_get_prev_dep((mp_value_node) pp));
+ mp_set_link(mp_get_prev_dep((mp_value_node) pp), (mp_node) q);
+ mp_new_indep(mp, pp);
+ if (cur_exp_node == pp && mp->cur_exp.type == t) {
+ mp->cur_exp.type = mp_independent_type;
+ }
+ if (number_positive(internal_value(mp_tracing_equations_internal)) && mp_interesting(mp, p)) {
+ mp_begin_diagnostic(mp);
+ mp_show_transformed_dependency(mp, &v, t, p);
+ mp_print_dependency(mp, s, t);
+ mp_end_diagnostic(mp, 0);
+ }
+ t = mp_dependent_type + mp_proto_dependent_type - t;
+ if (number_positive(mp->max_c[t])) {
+ mp_set_link(mp->max_ptr[t], (mp_node) mp->max_link[t]);
+ mp->max_link[t] = mp->max_ptr[t];
+ }
+ if (t != mp_dependent_type) {
+ for (t = mp_dependent_type; t <= mp_proto_dependent_type; t=t+1) {
+ r = mp->max_link[t];
+ while (r != NULL) {
+ q = (mp_value_node) mp_get_dep_info(r);
+ number_negated_clone(test, v);
+ make_fraction(ret, mp_get_dep_value(r), test);
+ mp_set_dep_list(q, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(q), &ret, s, t, mp_dependent_type));
+ if (mp_get_dep_list(q) == (mp_node) mp->dep_final) {
+ mp_make_known(mp, q, mp->dep_final);
+ }
+ q = r;
+ r = (mp_value_node) mp_link(r);
+ mp_free_dep_node(mp, q);
+ }
+ }
+ } else {
+ for (t = mp_dependent_type; t <= mp_proto_dependent_type; t++) {
+ r = mp->max_link[t];
+ while (r != NULL) {
+ q = (mp_value_node) mp_get_dep_info(r);
+ if (t == mp_dependent_type) {
+ if (cur_exp_node == (mp_node) q && mp->cur_exp.type == mp_dependent_type) {
+ mp->cur_exp.type = mp_proto_dependent_type;
+ }
+ mp_set_dep_list(q, mp_p_over_v(mp, (mp_value_node) mp_get_dep_list(q), &unity_t, mp_dependent_type, mp_proto_dependent_type));
+ mp_type(q) = mp_proto_dependent_type;
+ fraction_to_round_scaled(mp_get_dep_value(r));
+ }
+ number_negated_clone(test, v);
+ make_scaled(ret, mp_get_dep_value(r), test);
+ mp_set_dep_list(q, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(q), &ret, s, mp_proto_dependent_type, mp_proto_dependent_type));
+ if (mp_get_dep_list(q) == (mp_node) mp->dep_final) {
+ mp_make_known(mp, q, mp->dep_final);
+ }
+ q = r;
+ r = (mp_value_node) mp_link(r);
+ mp_free_dep_node(mp, q);
+ }
+ }
+ }
+ mp_flush_node_list(mp, (mp_node) s);
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ check_arith();
+ free_number(ret);
+ }
+ free_number(v);
+ free_number(test);
+}
+
+static void mp_show_transformed_dependency (MP mp, mp_number *v, mp_variable_type t, mp_node p)
+{
+ mp_number vv;
+ mp_print_nl(mp, "### ");
+ if (number_positive(*v)) {
+ mp_print_chr(mp, '-');
+ }
+ if (t == mp_dependent_type) {
+ new_number_clone(vv, mp->max_c[mp_dependent_type]);
+ fraction_to_round_scaled(vv);
+ } else {
+ new_number_clone(vv, mp->max_c[mp_proto_dependent_type]);
+ }
+ if (! number_equal(vv, unity_t)) {
+ print_number(vv);
+ }
+ mp_print_variable_name(mp, p);
+ while (mp_get_indep_scale(p) > 0) {
+ mp_print_str(mp, "*4");
+ mp_set_indep_scale(p, mp_get_indep_scale(p)-2);
+ }
+ if (t == mp_dependent_type) {
+ mp_print_chr(mp, '=');
+ } else {
+ mp_print_str(mp, " = ");
+ }
+ free_number(vv);
+}
+
+static void mp_bad_exp (MP mp, const char *s)
+{
+ char msg[256];
+ int save_flag;
+ {
+ mp_string cm;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_cmd_mod(mp, cur_cmd, cur_mod);
+ mp->selector = selector;
+ cm = mp_make_string(mp);
+ mp_snprintf(msg, 256, "%s expression can't begin with '%s'", s, mp_str(mp, cm));
+ delete_str_ref(cm);
+ }
+ mp_back_input(mp);
+ set_cur_sym(NULL);
+ set_cur_cmd(mp_numeric_command);
+ set_cur_mod_number(zero_t);
+ mp_ins_error(
+ mp,
+ msg,
+ "I'm afraid I need some sort of value in order to continue, so I've tentatively\n"
+ "inserted '0'."
+ );
+ save_flag = mp->var_flag;
+ mp->var_flag = 0;
+ mp_get_x_next(mp);
+ mp->var_flag = save_flag;
+}
+
+static void mp_stash_in (MP mp, mp_node p)
+{
+ mp_type(p) = mp->cur_exp.type;
+ if (mp->cur_exp.type == mp_known_type) {
+ mp_set_value_number(p, cur_exp_value_number);
+ } else if (mp->cur_exp.type == mp_independent_type) {
+ mp_value_node q = mp_single_dependency(mp, cur_exp_node);
+ if (q == mp->dep_final) {
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, zero_t);
+ mp_free_dep_node(mp, q);
+ } else {
+ mp_new_dep(mp, p, mp_dependent_type, q);
+ }
+ mp_recycle_value(mp, cur_exp_node);
+ mp_free_value_node(mp, cur_exp_node);
+ } else {
+ mp_set_dep_list((mp_value_node) p, mp_get_dep_list((mp_value_node) cur_exp_node));
+ mp_set_prev_dep((mp_value_node) p, mp_get_prev_dep((mp_value_node) cur_exp_node));
+ mp_set_link(mp_get_prev_dep((mp_value_node) p), p);
+ mp_free_dep_node(mp, (mp_value_node) cur_exp_node);
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+}
+
+static void mp_back_expr (MP mp)
+{
+ mp_node p = mp_stash_cur_exp(mp);
+ mp_link(p) = NULL;
+ mp_begin_token_list(mp, p, mp_backed_up_text);
+}
+
+static void mp_bad_subscript (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_error(
+ mp,
+ "Improper subscript has been replaced by zero",
+ "A bracketed subscript must have a known numeric value; unfortunately, what I\n"
+ "found was the value that appears just above this error message. So I'll try a\n"
+ "zero subscript."
+ );
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static char *mp_obliterated (MP mp, mp_node q)
+{
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_show_token_list(mp, q, NULL);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Variable %s has been obliterated", mp_str(mp, sname));
+ delete_str_ref(sname);
+ return mp_strdup(msg);
+}
+
+static void mp_binary_mac (MP mp, mp_node p, mp_node c, mp_sym n)
+{
+ mp_node q = mp_new_symbolic_node(mp);
+ mp_node r = mp_new_symbolic_node(mp);
+ mp_link(q) = r;
+ mp_set_sym_sym(q, p);
+ mp_set_sym_sym(r, mp_stash_cur_exp(mp));
+ mp_macro_call(mp, c, q, n);
+}
+
+static mp_knot mp_pair_to_knot (MP mp)
+{
+ mp_knot q = mp_new_knot(mp);
+ mp_left_type(q) = mp_endpoint_knot;
+ mp_right_type(q) = mp_endpoint_knot;
+ mp_originator(q) = mp_metapost_user;
+ mp_knotstate(q) = mp_regular_knot;
+ mp_prev_knot(q) = q;
+ mp_next_knot(q) = q;
+ mp_known_pair(mp);
+ number_clone(q->x_coord, mp->cur_x);
+ number_clone(q->y_coord, mp->cur_y);
+ return q;
+}
+
+void mp_known_pair (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (mp->cur_exp.type != mp_pair_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Undefined coordinates have been replaced by (0,0)",
+ "I need x and y numbers for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ set_number_to_zero(mp->cur_x);
+ set_number_to_zero(mp->cur_y);
+ } else {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if (mp_type(mp_x_part(p)) == mp_known_type) {
+ number_clone(mp->cur_x, mp_get_value_number(mp_x_part(p)));
+ } else {
+ mp_disp_err(mp, mp_x_part(p));
+ mp_back_error(
+ mp,
+ "Undefined x coordinate has been replaced by 0",
+ "I need a 'known' x value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_recycle_value(mp, mp_x_part(p));
+ set_number_to_zero(mp->cur_x);
+ }
+ if (mp_type(mp_y_part(p)) == mp_known_type) {
+ number_clone(mp->cur_y, mp_get_value_number(mp_y_part(p)));
+ } else {
+ mp_disp_err(mp, mp_y_part(p));
+ mp_back_error(
+ mp,
+ "Undefined y coordinate has been replaced by 0",
+ "I need a 'known' y value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_recycle_value(mp, mp_y_part(p));
+ set_number_to_zero(mp->cur_y);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+
+static int mp_scan_direction (MP mp)
+{
+ int t;
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_curl_command) {
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if ((mp->cur_exp.type != mp_known_type) || (number_negative(cur_exp_value_number))) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_to_unity(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper curl has been replaced by 1",
+ "A curl must be a known, nonnegative number."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ t = mp_curl_knot;
+ } else {
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type > mp_pair_type) {
+ mp_number xx;
+ new_number(xx);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Undefined x coordinate has been replaced by 0",
+ "I need a 'known' x value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ number_clone(xx, cur_exp_value_number);
+ if (cur_cmd != mp_comma_command) {
+ mp_back_error(
+ mp,
+ "Missing ',' has been inserted",
+ "I've got the x coordinate of a path direction; will look for the y coordinate\n"
+ "next."
+ );
+ }
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Undefined y coordinate has been replaced by 0",
+ "I need a 'known' y value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ number_clone(mp->cur_y, cur_exp_value_number);
+ number_clone(mp->cur_x, xx);
+ free_number(xx);
+ } else {
+ mp_known_pair(mp);
+ }
+ if (number_zero(mp->cur_x) && number_zero(mp->cur_y)) {
+ t = mp_open_knot;
+ } else {
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->cur_x, mp->cur_y);
+ t = mp_given_knot;
+ mp_set_cur_exp_value_number(mp, &narg);
+ free_number(narg);
+ }
+ }
+ if (cur_cmd != mp_right_brace_command) {
+ mp_back_error(
+ mp,
+ "Missing '}' has been inserted",
+ "I've scanned a direction spec for part of a path, so a right brace should have\n"
+ "come next. I shall pretend that one was there."
+ );
+ }
+ mp_get_x_next(mp);
+ return t;
+}
+
+static void push_of_path_result (MP mp, int what, mp_knot p)
+{
+ switch (what) {
+ case 0:
+ mp_pair_value(mp, &(p->x_coord), &(p->y_coord));
+ break;
+ case 1:
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ mp_pair_value(mp, &(p->x_coord), &(p->y_coord));
+ } else {
+ mp_pair_value(mp, &(p->left_x), &(p->left_y));
+ }
+ break;
+ case 2:
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ mp_pair_value(mp, &(p->x_coord), &(p->y_coord));
+ } else {
+ mp_pair_value(mp, &(p->right_x), &(p->right_y));
+ }
+ break;
+ case 3:
+ {
+ mp_number x, y;
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ new_number_clone(x, p->x_coord);
+ new_number_clone(y, p->y_coord);
+ } else {
+ new_number_clone(x, p->right_x);
+ new_number_clone(y, p->right_y);
+ }
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ number_subtract(x, p->x_coord);
+ number_subtract(y, p->y_coord);
+ } else {
+ number_subtract(x, p->left_x);
+ number_subtract(y, p->left_y);
+ }
+ mp_pair_value(mp, &x, &y);
+ free_number(x);
+ free_number(y);
+ }
+ break;
+ }
+}
+
+static void mp_finish_read (MP mp)
+{
+ mp_str_room(mp, (int) mp->last - (int) start);
+ for (size_t k = (size_t) start; k < mp->last; k++) {
+ mp_append_char(mp, mp->buffer[k]);
+ }
+ mp_end_file_reading(mp);
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, mp_make_string(mp));
+ }
+static void mp_do_nullary (MP mp, int c)
+{
+ check_arith();
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ mp_show_cmd_mod(mp, mp_nullary_command, c);
+ }
+ switch (c) {
+ case mp_true_operation:
+ case mp_false_operation:
+ mp->cur_exp.type = mp_boolean_type;
+ mp_set_cur_exp_value_boolean(mp, c);
+ break;
+ case mp_null_picture_operation:
+ mp->cur_exp.type = mp_picture_type;
+ mp_set_cur_exp_node(mp, (mp_node) mp_get_edge_header_node(mp));
+ mp_init_edges(mp, (mp_edge_header_node) cur_exp_node);
+ break;
+ case mp_null_pen_operation:
+ mp->cur_exp.type = mp_pen_type;
+ mp_set_cur_exp_knot(mp, mp_get_pen_circle(mp, &zero_t));
+ break;
+ case mp_normal_deviate_operation:
+ {
+ mp_number r;
+ new_number(r);
+ m_norm_rand(r);
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &r);
+ free_number(r);
+ }
+ break;
+ case mp_pen_circle_operation:
+ mp->cur_exp.type = mp_pen_type;
+ mp_set_cur_exp_knot(mp, mp_get_pen_circle(mp, &unity_t));
+ break;
+ case mp_version_operation:
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, mp_intern(mp, metapost_version));
+ break;
+ case mp_path_point_operation:
+ case mp_path_precontrol_operation:
+ case mp_path_postcontrol_operation:
+ case mp_path_direction_operation:
+ if (mp->loop_ptr && mp->loop_ptr->point != NULL) {
+ push_of_path_result(mp, c - mp_path_point_operation, mp->loop_ptr->point);
+ } else {
+ mp_pair_value(mp, &zero_t, &zero_t);
+ }
+ break;
+ }
+ check_arith();
+}
+
+static int mp_pict_color_type (MP mp, int c)
+{
+ return (
+ (mp_link(mp_edge_list(cur_exp_node)) != NULL)
+ &&
+ (
+ (! mp_has_color(mp_link(mp_edge_list(cur_exp_node))))
+ ||
+ ((
+ (mp_color_model(mp_link(mp_edge_list(cur_exp_node))) == c)
+ ||
+ (
+ (mp_color_model(mp_link(mp_edge_list(cur_exp_node))) == mp_uninitialized_model)
+ &&
+ (number_to_scaled(internal_value(mp_default_color_model_internal))/number_to_scaled(unity_t)) == c
+ )
+ ))
+ )
+ );
+}
+
+static mp_knot mp_simple_knot(MP mp, mp_number *x, mp_number *y)
+{
+ mp_knot k = mp_new_knot(mp);
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ mp_originator(k) = mp_program_code;
+ mp_knotstate(k) = mp_regular_knot;
+ number_clone(k->x_coord, *x);
+ number_clone(k->y_coord, *y);
+ number_clone(k->left_x, *x);
+ number_clone(k->left_y, *y);
+ number_clone(k->right_x, *x);
+ number_clone(k->right_y, *y);
+ return k;
+}
+
+static mp_knot mp_complex_knot(MP mp, mp_knot o)
+{
+ mp_knot k = mp_new_knot(mp);
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ mp_originator(k) = mp_program_code;
+ mp_knotstate(k) = mp_regular_knot;
+ number_clone(k->x_coord, o->x_coord);
+ number_clone(k->y_coord, o->y_coord);
+ number_clone(k->left_x, o->left_x);
+ number_clone(k->left_y, o->left_y);
+ number_clone(k->right_x, o->right_x);
+ number_clone(k->right_y, o->right_y);
+ return k;
+}
+
+static int mp_nice_pair (MP mp, mp_node p, int t)
+{
+ (void) mp;
+ if (t == mp_pair_type) {
+ p = mp_get_value_node(p);
+ if (mp_type(mp_x_part(p)) == mp_known_type && mp_type(mp_y_part(p)) == mp_known_type)
+ return 1;
+ }
+ return 0;
+}
+static int mp_nice_color_or_pair (MP mp, mp_node p, int t)
+{
+ mp_node q;
+ (void) mp;
+ switch (t) {
+ case mp_pair_type:
+ q = mp_get_value_node(p);
+ if (mp_type(mp_x_part(q)) == mp_known_type
+ && mp_type(mp_y_part(q)) == mp_known_type)
+ return 1;
+ break;
+ case mp_color_type:
+ q = mp_get_value_node(p);
+ if (mp_type(mp_red_part (q)) == mp_known_type
+ && mp_type(mp_green_part(q)) == mp_known_type
+ && mp_type(mp_blue_part (q)) == mp_known_type)
+ return 1;
+ break;
+ case mp_cmykcolor_type:
+ q = mp_get_value_node(p);
+ if (mp_type(mp_cyan_part (q)) == mp_known_type
+ && mp_type(mp_magenta_part(q)) == mp_known_type
+ && mp_type(mp_yellow_part (q)) == mp_known_type
+ && mp_type(mp_black_part (q)) == mp_known_type)
+ return 1;
+ break;
+ }
+ return 0;
+}
+static void mp_print_known_or_unknown_type (MP mp, int t, mp_node v)
+{
+ mp_print_chr(mp, '(');
+ if (t > mp_known_type) {
+ mp_print_str(mp, "unknown numeric");
+ } else {
+ switch (t) {
+ case mp_pair_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ if (! mp_nice_color_or_pair (mp, v, t)) {
+ mp_print_str(mp, "unknown ");
+ }
+ break;
+ }
+ mp_print_type(mp, t);
+ }
+ mp_print_chr(mp, ')');
+}
+static void mp_bad_unary (MP mp, int c)
+{
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_op(mp, c);
+ mp_print_known_or_unknown_type(mp, mp->cur_exp.type, cur_exp_node);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Not implemented: %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ msg,
+ "I'm afraid I don't know how to apply that operation to that particular type.\n"
+ "Continue, and I'll simply return the argument (shown above) as the result of the\n"
+ "operation."
+ );
+ mp_get_x_next(mp);
+}
+static void mp_negate_dep_list (MP mp, mp_value_node p)
+{
+ (void) mp;
+ while (1) {
+ number_negate(mp_get_dep_value(p));
+ if (mp_get_dep_info(p) == NULL)
+ return;
+ p = (mp_value_node) mp_link(p);
+ }
+}
+static void mp_negate_value(MP mp, mp_node r)
+{
+ if (mp_type(r) == mp_known_type) {
+ mp_set_value_number(r, mp_get_value_number(r));
+ number_negate(mp_get_value_number(r));
+ } else {
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) r));
+ }
+}
+static void negate_cur_expr (MP mp)
+{
+ switch (mp->cur_exp.type) {
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ case mp_independent_type:
+ {
+ mp_node q = cur_exp_node;
+ mp_make_exp_copy(mp, q);
+ if (mp->cur_exp.type == mp_dependent_type) {
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node));
+ } else if (mp->cur_exp.type <= mp_pair_type) {
+ mp_node p = mp_get_value_node(cur_exp_node);
+
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ mp_negate_value(mp, mp_x_part(p));
+ mp_negate_value(mp, mp_y_part(p));
+ break;
+ case mp_color_type:
+ mp_negate_value(mp, mp_red_part(p));
+ mp_negate_value(mp, mp_green_part(p));
+ mp_negate_value(mp, mp_blue_part(p));
+ break;
+ case mp_cmykcolor_type:
+ mp_negate_value(mp, mp_cyan_part(p));
+ mp_negate_value(mp, mp_magenta_part(p));
+ mp_negate_value(mp, mp_yellow_part(p));
+ mp_negate_value(mp, mp_black_part(p));
+ break;
+ default:
+ break;
+ }
+ }
+ mp_recycle_value(mp, q);
+ mp_free_value_node(mp, q);
+ }
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node));
+ break;
+ case mp_known_type:
+ if (is_number(cur_exp_value_number)) {
+ number_negate(cur_exp_value_number);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, mp_minus_operation);
+ break;
+ }
+}
+static void mp_pair_to_path (MP mp) {
+ mp_set_cur_exp_knot(mp, mp_pair_to_knot(mp));
+ mp->cur_exp.type = mp_path_type;
+}
+static void mp_take_part (MP mp, int c)
+{
+ mp_node p = mp_get_value_node(cur_exp_node);
+ mp_set_value_node(mp->temp_val, p);
+ mp_type(mp->temp_val) = mp->cur_exp.type;
+ mp_link(p) = mp->temp_val;
+ mp_free_value_node(mp, cur_exp_node);
+ switch (c) {
+ case mp_x_part_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_make_exp_copy(mp, mp_x_part(p));
+ } else {
+ mp_make_exp_copy(mp, mp_tx_part(p));
+ }
+ break;
+ case mp_y_part_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_make_exp_copy(mp, mp_y_part(p));
+ } else {
+ mp_make_exp_copy(mp, mp_ty_part(p));
+ }
+ break;
+ case mp_xx_part_operation:
+ mp_make_exp_copy(mp, mp_xx_part(p));
+ break;
+ case mp_xy_part_operation:
+ mp_make_exp_copy(mp, mp_xy_part(p));
+ break;
+ case mp_yx_part_operation:
+ mp_make_exp_copy(mp, mp_yx_part(p));
+ break;
+ case mp_yy_part_operation:
+ mp_make_exp_copy(mp, mp_yy_part(p));
+ break;
+ case mp_red_part_operation:
+ mp_make_exp_copy(mp, mp_red_part(p));
+ break;
+ case mp_green_part_operation:
+ mp_make_exp_copy(mp, mp_green_part(p));
+ break;
+ case mp_blue_part_operation:
+ mp_make_exp_copy(mp, mp_blue_part(p));
+ break;
+ case mp_cyan_part_operation:
+ mp_make_exp_copy(mp, mp_cyan_part(p));
+ break;
+ case mp_magenta_part_operation:
+ mp_make_exp_copy(mp, mp_magenta_part(p));
+ break;
+ case mp_yellow_part_operation:
+ mp_make_exp_copy(mp, mp_yellow_part(p));
+ break;
+ case mp_black_part_operation:
+ mp_make_exp_copy(mp, mp_black_part(p));
+ break;
+ case mp_grey_part_operation:
+ mp_make_exp_copy(mp, mp_grey_part(p));
+ break;
+ }
+ mp_recycle_value(mp, mp->temp_val);
+}
+static void mp_take_pict_part (MP mp, int c)
+{
+ mp_node p;
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ p = mp_link(mp_edge_list(cur_exp_node));
+ if (p != NULL) {
+ switch (c) {
+ case mp_x_part_operation:
+ case mp_y_part_operation:
+ case mp_xx_part_operation:
+ case mp_xy_part_operation:
+ case mp_yx_part_operation:
+ case mp_yy_part_operation:
+ goto NOT_FOUND;
+ case mp_red_part_operation:
+ case mp_green_part_operation:
+ case mp_blue_part_operation:
+ if (mp_has_color(p)) {
+ switch (c) {
+ case mp_red_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->red);
+ break;
+ case mp_green_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->green);
+ break;
+ case mp_blue_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->blue);
+ break;
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_cyan_part_operation:
+ case mp_magenta_part_operation:
+ case mp_yellow_part_operation:
+ case mp_black_part_operation:
+ if (mp_has_color(p)) {
+ if (mp_color_model(p) == mp_uninitialized_model && c == mp_black_part_operation) {
+ set_number_to_unity(new_expr.data.n);
+ } else {
+ switch (c) {
+ case mp_cyan_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->cyan);
+ break;
+ case mp_magenta_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->magenta);
+ break;
+ case mp_yellow_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->yellow);
+ break;
+ case mp_black_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->black);
+ break;
+ }
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_grey_part_operation:
+ if (mp_has_color(p)) {
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->grey);
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_color_model_operation:
+ if (mp_has_color(p)) {
+ if (mp_color_model(p) == mp_uninitialized_model) {
+ number_clone(new_expr.data.n, internal_value(mp_default_color_model_internal));
+ } else {
+ number_clone(new_expr.data.n, unity_t);
+ number_multiply_int(new_expr.data.n, mp_color_model(p));
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_prescript_part_operation:
+ if (! mp_has_script(p)) {
+ goto NOT_FOUND;
+ } else {
+ if (mp_pre_script(p)) {
+ new_expr.data.str = mp_pre_script(p);
+ add_str_ref(new_expr.data.str);
+ } else {
+ new_expr.data.str = mp_rts(mp,"");
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ };
+ break;
+ case mp_postscript_part_operation:
+ if (! mp_has_script(p)) {
+ goto NOT_FOUND;
+ } else {
+ if (mp_post_script(p)) {
+ new_expr.data.str = mp_post_script(p);
+ add_str_ref(new_expr.data.str);
+ } else {
+ new_expr.data.str = mp_rts(mp,"");
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ };
+ break;
+ case mp_stacking_part_operation:
+ number_clone(new_expr.data.n, unity_t);
+ number_multiply_int(new_expr.data.n, mp_stacking(p));
+ mp_flush_cur_exp(mp, new_expr);
+ break;
+ case mp_path_part_operation:
+ if (mp_is_stop(p)) {
+ mp_confusion(mp, "picture");
+ } else {
+ new_expr.data.node = NULL;
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ new_expr.data.p = mp_copy_path(mp, mp_path_ptr((mp_shape_node) p));
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ new_expr.data.p = mp_copy_path(mp, mp_path_ptr((mp_start_node) p));
+ break;
+ default:
+ break;
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_path_type;
+ }
+ break;
+ case mp_pen_part_operation:
+ if (! mp_has_pen(p)) {
+ goto NOT_FOUND;
+ } else {
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ if (mp_pen_ptr((mp_shape_node) p) == NULL) {
+ goto NOT_FOUND;
+ } else {
+ new_expr.data.p = mp_copy_pen(mp, mp_pen_ptr((mp_shape_node) p));
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pen_type((mp_shape_node) p) ? mp_nep_type : mp_pen_type ;
+ }
+ break;
+ default:
+ break;
+ }
+ }
+ break;
+ case mp_dash_part_operation:
+ if (mp_type(p) != mp_stroked_node_type) {
+ goto NOT_FOUND;
+ } else if (mp_dash_ptr(p) == NULL) {
+ goto NOT_FOUND;
+ } else {
+ mp_add_edge_ref(mp, mp_dash_ptr(p));
+ new_expr.data.node = (mp_node) mp_scale_edges(mp,
+ &(((mp_shape_node) p)->dashscale), (mp_edge_header_node) mp_dash_ptr(p));
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_picture_type;
+ }
+ break;
+ }
+ return;
+ };
+ NOT_FOUND:
+ switch (c) {
+ case mp_prescript_part_operation:
+ case mp_postscript_part_operation:
+ new_expr.data.str = mp_rts(mp,"");
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ break;
+ case mp_path_part_operation:
+ new_expr.data.p = mp_new_knot(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp_left_type(cur_exp_knot) = mp_endpoint_knot;
+ mp_right_type(cur_exp_knot) = mp_endpoint_knot;
+ mp_prev_knot(cur_exp_knot) = cur_exp_knot;
+ mp_next_knot(cur_exp_knot) = cur_exp_knot;
+ set_number_to_zero(cur_exp_knot->x_coord);
+ set_number_to_zero(cur_exp_knot->y_coord);
+ mp_originator(cur_exp_knot) = mp_metapost_user;
+ mp_knotstate(cur_exp_knot) = mp_regular_knot;
+ mp->cur_exp.type = mp_path_type;
+ break;
+ case mp_pen_part_operation:
+ new_expr.data.p = mp_get_pen_circle(mp, &zero_t);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pen_type;
+ break;
+ case mp_dash_part_operation:
+ new_expr.data.node = (mp_node) mp_get_edge_header_node(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp_init_edges(mp, (mp_edge_header_node) cur_exp_node);
+ mp->cur_exp.type = mp_picture_type;
+ break;
+ default:
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ break;
+ }
+}
+static void mp_str_to_num (MP mp)
+{
+ int n;
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cur_exp_str->len == 0) {
+ n = -1;
+ } else {
+ n = cur_exp_str->str[0];
+ }
+ number_clone(new_expr.data.n, unity_t);
+ number_multiply_int(new_expr.data.n, n);
+ mp_flush_cur_exp(mp, new_expr);
+}
+static void mp_path_length (MP mp, mp_number *n)
+{
+ mp_knot p = cur_exp_knot;
+ int l = mp_left_type(p) == mp_endpoint_knot ? -1 : 0;
+ do {
+ p = mp_next_knot(p);
+ ++l;
+ } while (p != cur_exp_knot);
+ set_number_from_int(*n, l);
+}
+static void mp_picture_length (MP mp, mp_number *n)
+{
+ mp_node p = mp_link(mp_edge_list(cur_exp_node));
+ int l = 0;
+ if (p != NULL) {
+ if (mp_is_start_or_stop(p) && mp_skip_1component(mp, p) == NULL) {
+ p = mp_link(p);
+ }
+ while (p != NULL) {
+ if (! mp_is_start_or_stop(p)) {
+ p = mp_link(p);
+ } else if (! mp_is_stop(p)) {
+ p = mp_skip_1component(mp, p);
+ } else {
+ break;
+ }
+ ++l;
+ }
+ }
+ set_number_from_int(*n, l);
+}
+static void mp_an_angle (MP mp, mp_number *ret, mp_number *xpar, mp_number *ypar)
+{
+ set_number_to_zero(*ret);
+ if (! (number_zero(*xpar) && number_zero(*ypar))) {
+ n_arg(*ret, *xpar, *ypar);
+ }
+}
+static void mp_bezier_slope (MP mp,
+ mp_number *ret, mp_number *AX, mp_number *AY, mp_number *BX,
+ mp_number *BY, mp_number *CX, mp_number *CY, mp_number *DX,
+ mp_number *DY
+);
+static void mp_turn_cycles (MP mp, mp_number *turns, mp_knot c)
+{
+ int selector;
+ mp_angle res, ang;
+ mp_knot p;
+ mp_number xp, yp;
+ mp_number x, y;
+ mp_number arg1, arg2;
+ mp_angle in_angle, out_angle;
+ mp_angle seven_twenty_deg_t;
+ set_number_to_zero(*turns);
+ new_number(arg1);
+ new_number(arg2);
+ new_number(xp);
+ new_number(yp);
+ new_number(x);
+ new_number(y);
+ new_angle(in_angle);
+ new_angle(out_angle);
+ new_angle(ang);
+ new_angle(res);
+ new_angle(seven_twenty_deg_t);
+ number_clone(seven_twenty_deg_t, three_sixty_deg_t);
+ number_double(seven_twenty_deg_t);
+ p = c;
+ selector = mp->selector;
+ mp->selector = mp_term_only_selector;
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "");
+ mp_end_diagnostic(mp, 0);
+ }
+ do {
+ number_clone(xp, p_next->x_coord);
+ number_clone(yp, p_next->y_coord);
+ mp_bezier_slope(mp, &ang, &(p->x_coord), &(p->y_coord), &(p->right_x), &(p->right_y), &(p_next->left_x), &(p_next->left_y), &xp, &yp);
+ if (number_greater(ang, seven_twenty_deg_t)) {
+ mp_error(mp, "Strange path", NULL);
+ mp->selector = selector;
+ set_number_to_zero(*turns);
+ goto DONE;
+ }
+ number_add(res, ang);
+ if (number_greater(res, one_eighty_deg_t)) {
+ number_subtract(res, three_sixty_deg_t);
+ number_add(*turns, unity_t);
+ }
+ if (number_lessequal(res, negative_one_eighty_deg_t)) {
+ number_add(res, three_sixty_deg_t);
+ number_subtract(*turns, unity_t);
+ }
+ number_clone(x, p_next->left_x);
+ number_clone(y, p_next->left_y);
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p->right_x);
+ number_clone(y, p->right_y);
+ }
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p->x_coord);
+ number_clone(y, p->y_coord);
+ }
+ set_number_from_subtraction(arg1, xp, x);
+ set_number_from_subtraction(arg2, yp, y);
+ mp_an_angle(mp, &in_angle, &arg1, &arg2);
+ number_clone(x, p_next->right_x);
+ number_clone(y, p_next->right_y);
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p_nextnext->left_x);
+ number_clone(y, p_nextnext->left_y);
+ }
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p_nextnext->x_coord);
+ number_clone(y, p_nextnext->y_coord);
+ }
+ set_number_from_subtraction(arg1, x, xp);
+ set_number_from_subtraction(arg2, y, yp);
+ mp_an_angle(mp, &out_angle, &arg1, &arg2);
+ set_number_from_subtraction(ang, out_angle, in_angle);
+ mp_reduce_angle(mp, &ang);
+ if (number_nonzero(ang)) {
+ number_add(res, ang);
+ if (number_greaterequal(res, one_eighty_deg_t)) {
+ number_subtract(res, three_sixty_deg_t);
+ number_add(*turns, unity_t);
+ }
+ if (number_lessequal(res, negative_one_eighty_deg_t)) {
+ number_add(res, three_sixty_deg_t);
+ number_subtract(*turns, unity_t);
+ }
+ }
+ p = mp_next_knot(p);
+ } while (p != c);
+ mp->selector = selector;
+ DONE:
+ free_number(xp);
+ free_number(yp);
+ free_number(x);
+ free_number(y);
+ free_number(seven_twenty_deg_t);
+ free_number(in_angle);
+ free_number(out_angle);
+ free_number(ang);
+ free_number(res);
+ free_number(arg1);
+ free_number(arg2);
+}
+static void mp_turn_cycles_wrapper (MP mp, mp_number *ret, mp_knot c)
+{
+ if (mp_next_knot(c) == c) {
+ set_number_to_unity(*ret);
+ } else {
+ mp_turn_cycles (mp, ret, c);
+ }
+}
+static int mp_test_known (MP mp, int c)
+{
+ int b = mp_false_operation;
+ switch (mp->cur_exp.type) {
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_string_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ case mp_known_type:
+ b = mp_true_operation;
+ break;
+ case mp_transform_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_tx_part(p)) == mp_known_type) &&
+ (mp_type(mp_ty_part(p)) == mp_known_type) &&
+ (mp_type(mp_xx_part(p)) == mp_known_type) &&
+ (mp_type(mp_xy_part(p)) == mp_known_type) &&
+ (mp_type(mp_yx_part(p)) == mp_known_type) &&
+ (mp_type(mp_yy_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_red_part(p)) == mp_known_type) &&
+ (mp_type(mp_green_part(p)) == mp_known_type) &&
+ (mp_type(mp_blue_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_cyan_part(p)) == mp_known_type) &&
+ (mp_type(mp_magenta_part(p)) == mp_known_type) &&
+ (mp_type(mp_yellow_part(p)) == mp_known_type) &&
+ (mp_type(mp_black_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_x_part(p)) == mp_known_type) &&
+ (mp_type(mp_y_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ if (c == mp_known_operation) {
+ return b;
+ } else {
+ return b == mp_true_operation ? mp_false_operation : mp_true_operation;
+ }
+}
+static void mp_pair_value (MP mp, mp_number *x, mp_number *y)
+{
+ mp_node p;
+ mp_value new_expr;
+ mp_number x1, y1;
+ new_number_clone(x1, *x);
+ new_number_clone(y1, *y);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ p = mp_new_value_node(mp);
+ new_expr.type = mp_type(p);
+ new_expr.data.node = p;
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pair_type;
+ mp_name_type(p) = mp_capsule_operation;
+ mp_init_pair_node(mp, p);
+ p = mp_get_value_node(p);
+ mp_type(mp_x_part(p)) = mp_known_type;
+ mp_set_value_number(mp_x_part(p), x1);
+ mp_type(mp_y_part(p)) = mp_known_type;
+ mp_set_value_number(mp_y_part(p), y1);
+ free_number(x1);
+ free_number(y1);
+}
+static int mp_get_cur_bbox (MP mp)
+{
+ switch (mp->cur_exp.type) {
+ case mp_picture_type:
+ {
+ mp_edge_header_node p = (mp_edge_header_node) cur_exp_node;
+ mp_set_bbox(mp, p, 1);
+ if (number_greater(p->minx, p->maxx)) {
+ set_number_to_zero(mp_minx);
+ set_number_to_zero(mp_maxx);
+ set_number_to_zero(mp_miny);
+ set_number_to_zero(mp_maxy);
+ } else {
+ number_clone(mp_minx, p->minx);
+ number_clone(mp_maxx, p->maxx);
+ number_clone(mp_miny, p->miny);
+ number_clone(mp_maxy, p->maxy);
+ }
+ }
+ break;
+ case mp_path_type:
+ mp_path_bbox(mp, cur_exp_knot);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_pen_bbox(mp, cur_exp_knot);
+ break;
+ default:
+ return 0;
+ }
+ return 1;
+}
+static int mp_get_cur_xbox (MP mp)
+{
+ if (mp->cur_exp.type == mp_path_type) {
+ mp_path_xbox(mp, cur_exp_knot);
+ return 1;
+ } else {
+ return mp_get_cur_bbox(mp);
+ }
+}
+static int mp_get_cur_ybox (MP mp)
+{
+ if (mp->cur_exp.type == mp_path_type) {
+ mp_path_ybox(mp, cur_exp_knot);
+ return 1;
+ } else {
+ return mp_get_cur_bbox(mp);
+ }
+}
+static void mp_do_read_or_close (MP mp, int c)
+{
+ int n = mp->read_files;
+ int n0 = mp->read_files;
+ char *fn = mp_strdup(mp_str(mp, cur_exp_str));
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ while (mp_strcmp(fn, mp->rd_fname[n]) != 0) {
+ if (n > 0) {
+ --n;
+ } else if (c == mp_close_from_operation) {
+ goto CLOSE_FILE;
+ } else {
+ if (n0 == mp->read_files) {
+ if (mp->read_files < mp->max_read_files) {
+ ++mp->read_files;
+ } else {
+ void **rd_file;
+ char **rd_fname;
+ int l;
+ l = mp->max_read_files + (mp->max_read_files / 4);
+ rd_file = mp_memory_allocate((size_t) (l + 1) * sizeof(void *));
+ rd_fname = mp_memory_allocate((size_t) (l + 1) * sizeof(char *));
+ for (int k = 0; k <= l; k++) {
+ if (k <= mp->max_read_files) {
+ rd_file[k] = mp->rd_file[k];
+ rd_fname[k] = mp->rd_fname[k];
+ } else {
+ rd_file[k] = 0;
+ rd_fname[k] = NULL;
+ }
+ }
+ mp_memory_free(mp->rd_file);
+ mp_memory_free(mp->rd_fname);
+ mp->max_read_files = l;
+ mp->rd_file = rd_file;
+ mp->rd_fname = rd_fname;
+ }
+ }
+ n = n0;
+ if (mp_start_read_input(mp, fn, n)) {
+ goto FOUND;
+ } else {
+ goto NOT_FOUND;
+ }
+ }
+ if (mp->rd_fname[n] == NULL) {
+ n0 = n;
+ }
+ }
+ if (c == mp_close_from_operation) {
+ (mp->close_file) (mp, mp->rd_file[n]);
+ goto NOT_FOUND;
+ }
+ mp_begin_file_reading(mp);
+ name = is_read;
+ if (mp_input_ln(mp, mp->rd_file[n])) {
+ goto FOUND;
+ }
+ mp_end_file_reading(mp);
+ NOT_FOUND:
+ mp_memory_free(mp->rd_fname[n]);
+ mp->rd_fname[n] = NULL;
+ if (n == mp->read_files - 1) {
+ mp->read_files = n;
+ }
+ if (c == mp_close_from_operation) {
+ goto CLOSE_FILE;
+ }
+ new_expr.data.str = mp->eof_file;
+ add_str_ref(new_expr.data.str);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ return;
+ CLOSE_FILE:
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_vacuous_type;
+ return;
+ FOUND:
+ mp_flush_cur_exp(mp, new_expr);
+ mp_finish_read(mp);
+}
+
+
+static void mp_do_unary (MP mp, int c)
+{
+ check_arith();
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{");
+ mp_print_op(mp, c);
+ mp_print_chr(mp, '(');
+ mp_print_exp(mp, NULL, 0);
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+ }
+ switch (c) {
+ case mp_plus_operation:
+ if (mp->cur_exp.type < mp_color_type) {
+ mp_bad_unary(mp, mp_plus_operation);
+ }
+ break;
+ case mp_minus_operation:
+ negate_cur_expr(mp);
+ break;
+ case mp_not_operation:
+ if (mp->cur_exp.type != mp_boolean_type) {
+ mp_bad_unary(mp, mp_not_operation);
+ } else {
+ mp_set_cur_exp_value_boolean(mp, (cur_exp_value_boolean == mp_true_operation) ? mp_false_operation : mp_true_operation);
+ }
+ break;
+ case mp_sqrt_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ square_rt(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_m_exp_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ m_exp(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_m_log_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ m_log(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_sin_d_operation:
+ case mp_cos_d_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n_sin, n_cos, arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ new_fraction(n_sin);
+ new_fraction(n_cos);
+ number_clone(arg1, cur_exp_value_number);
+ number_clone(arg2, unity_t);
+ number_multiply_int(arg2, 360);
+ number_modulo(arg1, arg2);
+ convert_scaled_to_angle(arg1);
+ n_sin_cos(arg1, n_cos, n_sin);
+ if (c == mp_sin_d_operation) {
+ fraction_to_round_scaled(n_sin);
+ mp_set_cur_exp_value_number(mp, &n_sin);
+ } else {
+ fraction_to_round_scaled(n_cos);
+ mp_set_cur_exp_value_number(mp, &n_cos);
+ }
+ free_number(arg1);
+ free_number(arg2);
+ free_number(n_sin);
+ free_number(n_cos);
+ }
+ break;
+ case mp_floor_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ number_clone(n, cur_exp_value_number);
+ floor_scaled(n);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_uniform_deviate_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ m_unif_rand(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_odd_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_set_cur_exp_value_boolean(mp, number_odd(cur_exp_value_number) ? mp_true_operation : mp_false_operation);
+ mp->cur_exp.type = mp_boolean_type;
+ }
+ break;
+ case mp_angle_operation:
+ if (mp_nice_pair (mp, cur_exp_node, mp->cur_exp.type)) {
+ mp_value expr;
+ mp_node p;
+ mp_number narg;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ new_angle(narg);
+ p = mp_get_value_node(cur_exp_node);
+ n_arg(narg, mp_get_value_number(mp_x_part(p)), mp_get_value_number(mp_y_part(p)));
+ number_clone(expr.data.n, narg);
+ convert_angle_to_scaled(expr.data.n);
+ free_number(narg);
+ mp_flush_cur_exp(mp, expr);
+ } else {
+ mp_bad_unary(mp, mp_angle_operation);
+ }
+ break;
+ case mp_x_part_operation:
+ case mp_y_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ case mp_transform_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ mp_take_pict_part(mp, c);
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_xx_part_operation:
+ case mp_xy_part_operation:
+ case mp_yx_part_operation:
+ case mp_yy_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_transform_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ mp_take_pict_part(mp, c);
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_red_part_operation:
+ case mp_green_part_operation:
+ case mp_blue_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_color_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ if (mp_pict_color_type(mp, mp_rgb_model)) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_color_part(mp, c);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_cyan_part_operation:
+ case mp_magenta_part_operation:
+ case mp_yellow_part_operation:
+ case mp_black_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_cmykcolor_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ if (mp_pict_color_type(mp, mp_cmyk_model)) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_color_part(mp, c);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_grey_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ break;
+ case mp_picture_type:
+ if (mp_pict_color_type(mp, mp_grey_model)) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_color_part(mp, c);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_color_model_operation:
+ case mp_path_part_operation:
+ case mp_pen_part_operation:
+ case mp_dash_part_operation:
+ case mp_prescript_part_operation:
+ case mp_postscript_part_operation:
+ case mp_stacking_part_operation:
+ if (mp->cur_exp.type == mp_picture_type) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_unary(mp, c);
+ }
+ break;
+ case mp_char_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, mp_char_operation);
+ } else {
+ int n = round_unscaled(cur_exp_value_number) % 256;
+ unsigned char s[2];
+ mp_set_cur_exp_value_scaled(mp, n);
+ mp->cur_exp.type = mp_string_type;
+ if (number_negative(cur_exp_value_number)) {
+ n = number_to_scaled(cur_exp_value_number) + 256;
+ mp_set_cur_exp_value_scaled(mp, n);
+ }
+ s[0] = (unsigned char) number_to_scaled(cur_exp_value_number);
+ s[1] = '\0';
+ mp_set_cur_exp_str(mp, mp_rtsl (mp, (char *) s, 1));
+ }
+ break;
+ case mp_decimal_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, mp_decimal_operation);
+ } else {
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ print_number(cur_exp_value_number);
+ mp_set_cur_exp_str(mp, mp_make_string(mp));
+ mp->selector = selector;
+ mp->cur_exp.type = mp_string_type;
+ }
+ break;
+ case mp_oct_operation:
+ case mp_hex_operation:
+ case mp_ASCII_operation:
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_str_to_num(mp);
+ }
+ break;
+ case mp_length_operation:
+ switch (mp->cur_exp.type) {
+ case mp_string_type:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ number_clone(expr.data.n, unity_t);
+ number_multiply_int(expr.data.n, (int) cur_exp_str->len);
+ mp_flush_cur_exp(mp, expr);
+ break;
+ }
+ case mp_path_type:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_path_length(mp, &expr.data.n);
+ mp_flush_cur_exp(mp, expr);
+ break;
+ }
+ case mp_known_type:
+ {
+ mp_set_cur_exp_value_number(mp, &cur_exp_value_number);
+ number_abs(cur_exp_value_number);
+ break;
+ }
+ case mp_picture_type:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_picture_length(mp, &expr.data.n);
+ mp_flush_cur_exp(mp, expr);
+ break;
+ }
+ default:
+ if (mp_nice_pair (mp, cur_exp_node, mp->cur_exp.type)) {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ pyth_add(expr.data.n,
+ mp_get_value_number(mp_x_part(mp_get_value_node(cur_exp_node))),
+ mp_get_value_number(mp_y_part(mp_get_value_node(cur_exp_node)))
+ );
+ mp_flush_cur_exp(mp, expr);
+ } else {
+ mp_bad_unary(mp, c);
+ }
+ break;
+ }
+ break;
+ case mp_turning_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_flush_cur_exp(mp, expr);
+ } else if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_turning_operation);
+ } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ expr.data.p = NULL;
+ mp_flush_cur_exp(mp, expr);
+ } else {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_turn_cycles_wrapper(mp, &expr.data.n, cur_exp_knot);
+ mp_flush_cur_exp(mp, expr);
+ }
+ break;
+
+ case mp_boolean_type_operation:
+ case mp_string_type_operation:
+ case mp_pen_type_operation:
+ case mp_nep_type_operation:
+ case mp_path_type_operation:
+ case mp_picture_type_operation:
+ {
+ mp_value expr;
+ int type = (c - mp_boolean_type_operation) * 2 + mp_boolean_type ;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, (mp->cur_exp.type == type || mp->cur_exp.type == (type + 1)) ? mp_true_operation : mp_false_operation);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_transform_type_operation:
+ case mp_color_type_operation:
+ case mp_cmykcolor_type_operation:
+ case mp_pair_type_operation:
+ {
+ mp_value expr;
+ int type = (c - mp_transform_type_operation) + mp_transform_type;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, mp->cur_exp.type == type ? mp_true_operation : mp_false_operation);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_numeric_type_operation:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, (mp->cur_exp.type >= mp_known_type && mp->cur_exp.type <= mp_independent_type) ? mp_true_operation : mp_false_operation);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_known_operation:
+ case mp_unknown_operation:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, mp_test_known(mp, c));
+ mp_flush_cur_exp(mp, expr);
+ cur_exp_node = NULL;
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_cycle_operation:
+ case mp_no_cycle_operation:
+ {
+ mp_value expr;
+ int b = 0;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ if (mp->cur_exp.type != mp_path_type) {
+ b = (c == mp_cycle_operation) ? mp_false_operation : mp_true_operation;
+ } else if (mp_left_type(cur_exp_knot) != mp_endpoint_knot) {
+ b = (c == mp_cycle_operation) ? mp_true_operation : mp_false_operation;
+ } else {
+ b = (c == mp_cycle_operation) ? mp_false_operation : mp_true_operation;
+ }
+ set_number_from_boolean(expr.data.n, b);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_arc_length_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_arc_length_operation);
+ } else {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_get_arc_length(mp, &expr.data.n, cur_exp_knot);
+ mp_flush_cur_exp(mp, expr);
+ }
+ break;
+ case mp_filled_operation:
+ case mp_stroked_operation:
+ case mp_clipped_operation:
+ case mp_grouped_operation:
+ case mp_bounded_operation:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ if (mp->cur_exp.type != mp_picture_type) {
+ set_number_from_boolean(expr.data.n, mp_false_operation);
+ } else if (mp_link(mp_edge_list(cur_exp_node)) == NULL) {
+ set_number_from_boolean(expr.data.n, mp_false_operation);
+ } else {
+ int type = c - mp_filled_operation + mp_fill_node_type;
+ set_number_from_boolean(expr.data.n, mp_type(mp_link(mp_edge_list(cur_exp_node))) == type ? mp_true_operation: mp_false_operation);
+ }
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_make_pen_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_make_pen_operation);
+ } else {
+ mp->cur_exp.type = mp_pen_type;
+ mp_set_cur_exp_knot(mp, mp_make_pen(mp, cur_exp_knot, 1));
+ }
+ break;
+ case mp_make_nep_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp->cur_exp.type = mp_nep_type;
+ mp_set_cur_exp_knot(mp, cur_exp_knot);
+ }
+ break;
+ case mp_convexed_operation:
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_convexed_operation);
+ } else {
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, mp_convex_hull(mp, cur_exp_knot));
+ mp_simplify_path(mp, cur_exp_knot);
+ }
+ break;
+ case mp_uncontrolled_operation:
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_uncontrolled_operation);
+ } else {
+ mp->cur_exp.type = mp_path_type;
+ mp_simplify_path(mp, cur_exp_knot);
+ }
+ break;
+ case mp_make_path_operation:
+ if (mp->cur_exp.type != mp_pen_type && mp->cur_exp.type != mp_nep_type) {
+ mp_bad_unary(mp, mp_make_path_operation);
+ } else {
+ mp->cur_exp.type = mp_path_type;
+ mp_make_path(mp, cur_exp_knot);
+ }
+ break;
+ case mp_reverse_operation:
+ switch (mp->cur_exp.type) {
+ case mp_path_type:
+ {
+ mp_knot pk = mp_htap_ypoc(mp, cur_exp_knot);
+ if (mp_right_type(pk) == mp_endpoint_knot) {
+ pk = mp_next_knot(pk);
+ }
+ mp_toss_knot_list(mp, cur_exp_knot);
+ mp_set_cur_exp_knot(mp, pk);
+ }
+ break;
+ case mp_pair_type:
+ mp_pair_to_path(mp);
+ break;
+ default:
+ mp_bad_unary(mp, mp_reverse_operation);
+ break;
+ }
+ break;
+ case mp_uncycle_operation:
+ switch (mp->cur_exp.type) {
+ case mp_path_type:
+ mp_right_type(mp_prev_knot(cur_exp_knot)) = mp_endpoint_knot;
+ mp_left_type(cur_exp_knot) = mp_endpoint_knot;
+ break;
+ case mp_pair_type:
+ mp_pair_to_path(mp);
+ break;
+ default:
+ mp_bad_unary(mp, mp_uncycle_operation);
+ break;
+ }
+ break;
+ case mp_ll_corner_operation:
+ if (mp_get_cur_bbox(mp)) {
+ mp_pair_value(mp, &mp_minx, &mp_miny);
+ } else {
+ mp_bad_unary(mp, mp_ll_corner_operation);
+ }
+ break;
+ case mp_lr_corner_operation:
+ if (mp_get_cur_bbox(mp)) {
+ mp_pair_value(mp, &mp_maxx, &mp_miny);
+ } else {
+ mp_bad_unary(mp, mp_lr_corner_operation);
+ }
+ break;
+ case mp_ul_corner_operation:
+ if (mp_get_cur_bbox(mp)) {
+ mp_pair_value(mp, &mp_minx, &mp_maxy);
+ } else {
+ mp_bad_unary(mp, mp_ul_corner_operation);
+ }
+ break;
+ case mp_ur_corner_operation:
+ if (! mp_get_cur_bbox(mp)) {
+ mp_bad_unary(mp, mp_ur_corner_operation);
+ } else {
+ mp_pair_value(mp, &mp_maxx, &mp_maxy);
+ }
+ break;
+ case mp_center_of_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ } else if (mp_get_cur_bbox(mp)) {
+ mp_number x, y;
+ new_number(x);
+ new_number(y);
+ set_number_half_from_subtraction(x, mp_maxx, mp_minx);
+ set_number_half_from_subtraction(y, mp_maxy, mp_miny);
+ number_add(x, mp_minx);
+ number_add(y, mp_miny);
+ mp_pair_value(mp, &x, &y);
+ } else {
+ mp_bad_unary(mp, mp_center_of_operation);
+ }
+ break;
+ case mp_center_of_mass_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ } else if (mp->cur_exp.type == mp_path_type) {
+ mp_knot p = cur_exp_knot;
+ int l = 0;
+ mp_number x, y;
+ new_number(x);
+ new_number(y);
+ do {
+ ++l;
+ p = mp_next_knot(p);
+ number_add(x, p->x_coord);
+ number_add(y, p->y_coord);
+ } while (p != cur_exp_knot);
+ number_divide_int(x, l);
+ number_divide_int(y, l);
+ mp_pair_value(mp, &x, &y);
+ free_number(x);
+ free_number(y);
+ } else {
+ mp_bad_unary(mp, mp_center_of_mass_operation);
+ }
+ break;
+ case mp_corners_operation:
+ if (! mp_get_cur_bbox(mp)) {
+ mp_bad_unary(mp, mp_corners_operation);
+ } else {
+ mp_knot ll = mp_simple_knot(mp, &mp_minx, &mp_miny);
+ mp_knot lr = mp_simple_knot(mp, &mp_maxx, &mp_miny);
+ mp_knot ur = mp_simple_knot(mp, &mp_maxx, &mp_maxy);
+ mp_knot ul = mp_simple_knot(mp, &mp_minx, &mp_maxy);
+ mp_prev_knot(lr) = ll;
+ mp_next_knot(ll) = lr;
+ mp_prev_knot(ur) = lr;
+ mp_next_knot(lr) = ur;
+ mp_prev_knot(ul) = ur;
+ mp_next_knot(ur) = ul;
+ mp_prev_knot(ll) = ul;
+ mp_next_knot(ul) = ll;
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, ll);
+ }
+ break;
+ case mp_x_range_operation:
+ if (mp_get_cur_xbox(mp)) {
+ mp_pair_value(mp, &mp_minx, &mp_maxx);
+ } else {
+ mp_bad_unary(mp, mp_x_range_operation);
+ }
+ break;
+ case mp_y_range_operation:
+ if (mp_get_cur_ybox(mp)) {
+ mp_pair_value(mp, &mp_miny, &mp_maxy);
+ } else {
+ mp_bad_unary(mp, mp_y_range_operation);
+ }
+ break;
+ case mp_delta_point_operation:
+ case mp_delta_precontrol_operation:
+ case mp_delta_postcontrol_operation:
+ case mp_delta_direction_operation:
+ if (mp->cur_exp.type == mp_known_type) {
+ mp_set_cur_exp_value_number(mp, &cur_exp_value_number);
+ if (mp->loop_ptr && mp->loop_ptr->point != NULL) {
+ mp_knot p = mp->loop_ptr->point;
+ int n = round_unscaled(cur_exp_value_number);
+ if (n > 0) {
+ while (n--) {
+ p = mp_next_knot(p);
+ }
+ } else if (n < 0) {
+ while (n++) {
+ p = mp_prev_knot(p);
+ }
+ }
+ push_of_path_result(mp, c - mp_delta_point_operation, p);
+ }
+ } else {
+ mp_bad_unary(mp, c);
+ }
+ break;
+ case mp_read_from_operation:
+ case mp_close_from_operation:
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_do_read_or_close(mp, c);
+ }
+ break;
+ }
+ check_arith();
+}
+
+static void mp_bad_color_part (MP mp, int c)
+{
+ mp_node p;
+ mp_value new_expr;
+ char msg[256];
+ int selector;
+ mp_string sname;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ p = mp_link(mp_edge_list(cur_exp_node));
+ mp_disp_err(mp, NULL);
+ selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_op(mp, c);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ switch (mp_color_model(p)) {
+ case mp_grey_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of grey object", mp_str(mp, sname)); break;
+ case mp_cmyk_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of cmyk object", mp_str(mp, sname)); break;
+ case mp_rgb_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of rgb object", mp_str(mp, sname)); break;
+ case mp_no_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of marking object", mp_str(mp, sname)); break;
+ default: mp_snprintf(msg, 256, "Wrong picture color model: %s of defaulted object", mp_str(mp, sname)); break;
+ }
+ delete_str_ref(sname);
+ mp_error(
+ mp,
+ msg,
+ "You can only ask for the redpart, greenpart, bluepart of a rgb object, the\n"
+ "cyanpart, magentapart, yellowpart or blackpart of a cmyk object, or the greypart\n"
+ "of a grey object. No mixing and matching, please."
+ );
+ if (c == mp_black_part_operation) {
+ number_clone(new_expr.data.n, unity_t);
+ } else {
+ set_number_to_zero(new_expr.data.n);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static void mp_bezier_slope (MP mp,
+ mp_number *ret, mp_number *AX, mp_number *AY, mp_number *BX,
+ mp_number *BY, mp_number *CX, mp_number *CY, mp_number *DX,
+ mp_number *DY
+)
+{
+ double a, b, c;
+ mp_number deltax, deltay;
+ mp_number xi, xo, xm;
+ double res = 0.0;
+ double ax = number_to_double(*AX);
+ double ay = number_to_double(*AY);
+ double bx = number_to_double(*BX);
+ double by = number_to_double(*BY);
+ double cx = number_to_double(*CX);
+ double cy = number_to_double(*CY);
+ double dx = number_to_double(*DX);
+ double dy = number_to_double(*DY);
+ new_number(deltax);
+ new_number(deltay);
+ set_number_from_subtraction(deltax, *BX, *AX);
+ set_number_from_subtraction(deltay, *BY, *AY);
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *CX, *AX);
+ set_number_from_subtraction(deltay, *CY, *AY);
+ }
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *DX, *AX);
+ set_number_from_subtraction(deltay, *DY, *AY);
+ }
+ new_number(xi);
+ new_number(xm);
+ new_number(xo);
+ mp_an_angle(mp, &xi, &deltax, &deltay);
+ set_number_from_subtraction(deltax, *CX, *BX);
+ set_number_from_subtraction(deltay, *CY, *BY);
+ mp_an_angle(mp, &xm, &deltax, &deltay);
+ set_number_from_subtraction(deltax, *DX, *CX);
+ set_number_from_subtraction(deltay, *DY, *CY);
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *DX, *BX);
+ set_number_from_subtraction(deltay, *DY, *BY);
+ }
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *DX, *AX);
+ set_number_from_subtraction(deltay, *DY, *AY);
+ }
+ mp_an_angle(mp, &xo, &deltax, &deltay);
+ a = (bx - ax) * (cy - by) - (cx - bx) * (by - ay);
+ b = (bx - ax) * (dy - cy) - (by - ay) * (dx - cx);
+ c = (cx - bx) * (dy - cy) - (dx - cx) * (cy - by);
+ if ((a == 0.0) && (c == 0.0)) {
+ res = (b == 0.0 ? 0.0 : (mp_out(number_to_double(xo)) - mp_out(number_to_double(xi))));
+ } else if ((a == 0.0) || (c == 0.0)) {
+ if ((mp_sign (b) == mp_sign (a)) || (mp_sign (b) == mp_sign (c))) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ } else {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ }
+ } else if ((mp_sign (a) * mp_sign (c)) < 0.0) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ } else if (mp_sign (a) == mp_sign (b)) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ } else if ((b * b) == (4.0 * a * c)) {
+ res = (double) bezier_error;
+ } else if ((b * b) < (4.0 * a * c)) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res <= 0.0 && res > -180.0) {
+ res += 360.0;
+ } else if (res >= 0.0 && res < 180.0) {
+ res -= 360.0;
+ }
+ } else {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ }
+ free_number(deltax);
+ free_number(deltay);
+ free_number(xi);
+ free_number(xo);
+ free_number(xm);
+ set_number_from_double(*ret, res);
+ convert_scaled_to_angle(*ret);
+}
+
+static void mp_bad_binary (MP mp, mp_node p, int c)
+{
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ if (c >= mp_min_of_operation) {
+ mp_print_op(mp, c);
+ }
+ mp_print_known_or_unknown_type(mp, mp_type(p), p);
+ if (c >= mp_min_of_operation) {
+ mp_print_str(mp, "of");
+ } else {
+ mp_print_op(mp, c);
+ }
+ mp_print_known_or_unknown_type(mp, mp->cur_exp.type, cur_exp_node);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Not implemented: %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_disp_err(mp, p);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ msg,
+ "I'm afraid I don't know how to apply that operation to that combination of types.\n"
+ "Continue, and I'll return the second argument (see above) as the result of the"
+ "operation."
+ );
+ mp_get_x_next(mp);
+}
+static void mp_bad_envelope_pen (MP mp)
+{
+ mp_disp_err(mp, NULL);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not implemented: 'envelope(elliptical pen) of (path)'",
+ "I'm afraid I don't know how to apply that operation to that combination of types.\n"
+ "Continue, and I'll return the second argument (see above) as the result of the\n"
+ "operation."
+ );
+ mp_get_x_next(mp);
+}
+static mp_node mp_tarnished (MP mp, mp_node p)
+{
+ mp_node q = mp_get_value_node(p);
+ (void) mp;
+ switch (mp_type(p)) {
+ case mp_pair_type:
+ return (
+ (mp_type(mp_x_part(q)) == mp_independent_type) ||
+ (mp_type(mp_y_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ case mp_color_type:
+ return (
+ (mp_type(mp_red_part(q)) == mp_independent_type) ||
+ (mp_type(mp_green_part(q)) == mp_independent_type) ||
+ (mp_type(mp_blue_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ case mp_cmykcolor_type:
+ return (
+ (mp_type(mp_cyan_part(q)) == mp_independent_type) ||
+ (mp_type(mp_magenta_part(q)) == mp_independent_type) ||
+ (mp_type(mp_yellow_part(q)) == mp_independent_type) ||
+ (mp_type(mp_black_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ case mp_transform_type:
+ return (
+ (mp_type(mp_tx_part(q)) == mp_independent_type) ||
+ (mp_type(mp_ty_part(q)) == mp_independent_type) ||
+ (mp_type(mp_xx_part(q)) == mp_independent_type) ||
+ (mp_type(mp_xy_part(q)) == mp_independent_type) ||
+ (mp_type(mp_yx_part(q)) == mp_independent_type) ||
+ (mp_type(mp_yy_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ default:
+ return NULL;
+ }
+}
+static void mp_dep_finish (MP mp, mp_value_node v, mp_value_node q, int t)
+{
+ mp_value_node p = (q == NULL) ? (mp_value_node) cur_exp_node : q;
+ mp_set_dep_list(p, v);
+ mp_type(p) = t;
+ if (mp_get_dep_info(v) == NULL) {
+ mp_number vv;
+ new_number_clone(vv, mp_get_value_number(v));
+ if (q == NULL) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number_clone(new_expr.data.n, vv);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_recycle_value(mp, (mp_node) p);
+ mp_type(q) = mp_known_type;
+ mp_set_value_number(q, vv);
+ }
+ free_number(vv);
+ } else if (q == NULL) {
+ mp->cur_exp.type = t;
+ }
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+}
+
+static void mp_add_or_subtract (MP mp, mp_node p, mp_node q, int c)
+{
+ mp_variable_type s, t;
+ mp_value_node r;
+ mp_value_node v = NULL;
+ mp_number vv;
+ new_number(vv);
+ if (q == NULL) {
+ t = mp->cur_exp.type;
+ if (t < mp_dependent_type) {
+ number_clone(vv, cur_exp_value_number);
+ } else {
+ v = (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node);
+ }
+ } else {
+ t = mp_type(q);
+ if (t < mp_dependent_type) {
+ number_clone(vv, mp_get_value_number(q));
+ } else {
+ v = (mp_value_node) mp_get_dep_list((mp_value_node) q);
+ }
+ }
+ if (t == mp_known_type) {
+ mp_value_node qq = (mp_value_node) q;
+ if (c == mp_minus_operation) {
+ number_negate(vv);
+ }
+ if (mp_type(p) == mp_known_type) {
+ slow_add(vv, mp_get_value_number(p), vv);
+ if (q == NULL) {
+ mp_set_cur_exp_value_number(mp, &vv);
+ } else {
+ mp_set_value_number(q, vv);
+ }
+ free_number(vv);
+ return;
+ } else {
+ r = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ while (mp_get_dep_info(r) != NULL) {
+ r = (mp_value_node) mp_link(r);
+ }
+ slow_add(vv, mp_get_dep_value(r), vv);
+ mp_set_dep_value(r, vv);
+ if (qq == NULL) {
+ qq = mp_get_dep_node(mp);
+ mp_set_cur_exp_node(mp, (mp_node) qq);
+ mp->cur_exp.type = mp_type(p);
+ mp_name_type(qq) = mp_capsule_operation;
+ }
+ mp_set_dep_list(qq, mp_get_dep_list((mp_value_node) p));
+ mp_type(qq) = mp_type(p);
+ mp_set_prev_dep(qq, mp_get_prev_dep((mp_value_node) p));
+ mp_link(mp_get_prev_dep((mp_value_node) p)) = (mp_node) qq;
+ mp_type(p) = mp_known_type;
+ }
+ } else {
+ if (c == mp_minus_operation) {
+ mp_negate_dep_list(mp, v);
+ }
+ if (mp_type(p) == mp_known_type) {
+ while (mp_get_dep_info(v) != NULL) {
+ v = (mp_value_node) mp_link(v);
+ }
+ slow_add(vv, mp_get_value_number(p), mp_get_dep_value(v));
+ mp_set_dep_value(v, vv);
+ } else {
+ s = mp_type(p);
+ r = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ if (t == mp_dependent_type) {
+ if (s == mp_dependent_type) {
+ int b;
+ mp_number ret1, ret2;
+ new_fraction(ret1);
+ new_fraction(ret2);
+ mp_max_coef(mp, &ret1, r);
+ mp_max_coef(mp, &ret2, v);
+ number_add(ret1, ret2);
+ b = number_less(ret1, coef_bound_k);
+ free_number(ret1);
+ free_number(ret2);
+ if (b) {
+ v = mp_p_plus_q(mp, v, r, mp_dependent_type);
+ goto DONE;
+ }
+ }
+ t = mp_proto_dependent_type;
+ v = mp_p_over_v(mp, v, &unity_t, mp_dependent_type, mp_proto_dependent_type);
+ }
+ if (s == mp_proto_dependent_type) {
+ v = mp_p_plus_q(mp, v, r, mp_proto_dependent_type);
+ } else {
+ v = mp_p_plus_fq(mp, v, &unity_t, r, mp_proto_dependent_type, mp_dependent_type);
+ }
+ DONE:
+ if (q != NULL) {
+ mp_dep_finish(mp, v, (mp_value_node) q, t);
+ } else {
+ mp->cur_exp.type = t;
+ mp_dep_finish(mp, v, NULL, t);
+ }
+ }
+ }
+ free_number(vv);
+}
+static void mp_dep_mult (MP mp, mp_value_node p, mp_number *v, int v_is_scaled)
+{
+ mp_value_node q;
+ int s, t;
+ if (p == NULL) {
+ q = (mp_value_node) cur_exp_node;
+ } else if (mp_type(p) != mp_known_type) {
+ q = p;
+ } else {
+ mp_number r1, arg1;
+ new_number_clone(arg1, mp_get_dep_value(p));
+ if (v_is_scaled) {
+ new_number(r1);
+ take_scaled(r1, arg1, *v);
+ } else {
+ new_fraction(r1);
+ take_fraction(r1, arg1, *v);
+ }
+ mp_set_dep_value(p, r1);
+ free_number(r1);
+ free_number(arg1);
+ return;
+ }
+ t = mp_type(q);
+ q = (mp_value_node) mp_get_dep_list(q);
+ s = t;
+ if (t == mp_dependent_type && v_is_scaled) {
+ mp_number arg1, arg2;
+ new_fraction(arg1);
+ mp_max_coef(mp, &arg1, q);
+ new_number_abs(arg2, *v);
+ if (ab_vs_cd(arg1, arg2, coef_bound_minus_1, unity_t) >= 0) {
+ t = mp_proto_dependent_type;
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ q = mp_p_times_v(mp, q, v, s, t, v_is_scaled);
+ mp_dep_finish(mp, q, p, t);
+}
+static void mp_hard_times (MP mp, mp_node p)
+{
+ mp_value_node q;
+ mp_value_node pp;
+ mp_number v;
+ new_number(v);
+ if (mp_type(p) <= mp_pair_type) {
+ q = (mp_value_node) mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, p);
+ p = (mp_node) q;
+ }
+ pp = (mp_value_node) p;
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ {
+ mp_node r = mp_x_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_y_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_node r = mp_red_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_green_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_blue_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_node r = mp_cyan_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_yellow_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_magenta_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_black_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ }
+ break;
+ default:
+ break;
+ }
+ free_number(v);
+}
+static void mp_dep_div (MP mp, mp_value_node p, mp_number *v)
+{
+ mp_value_node q;
+ int s, t;
+ if (p == NULL) {
+ q = (mp_value_node) cur_exp_node;
+ } else if (mp_type(p) != mp_known_type) {
+ q = p;
+ } else {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, mp_get_value_number(p), *v);
+ mp_set_value_number(p, ret);
+ free_number(ret);
+ return;
+ }
+ t = mp_type(q);
+ q = (mp_value_node) mp_get_dep_list(q);
+ s = t;
+ if (t == mp_dependent_type) {
+ mp_number arg1, arg2;
+ new_number(arg2);
+ new_fraction(arg1);
+ mp_max_coef(mp, &arg1, q);
+ number_abs_clone(arg2, *v);
+ if (ab_vs_cd(arg1, unity_t, coef_bound_minus_1, arg2) >= 0) {
+ t = mp_proto_dependent_type;
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ q = mp_p_over_v(mp, q, v, s, t);
+ mp_dep_finish(mp, q, p, t);
+}
+static void mp_set_up_trans (MP mp, int c)
+{
+ mp_node p, q, r;
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ if ((c != mp_transformed_operation) || (mp->cur_exp.type != mp_transform_type)) {
+ p = mp_stash_cur_exp(mp);
+ mp_set_cur_exp_node(mp, mp_id_transform(mp));
+ mp->cur_exp.type = mp_transform_type;
+ q = mp_get_value_node(cur_exp_node);
+ switch (c) {
+ case mp_rotated_operation:
+ if (mp_type(p) == mp_known_type) {
+ mp_number n_sin, n_cos, arg1, arg2;
+ new_fraction(n_sin);
+ new_fraction(n_cos);
+ new_number_clone(arg2, unity_t);
+ new_number_clone(arg1, mp_get_value_number(p));
+ number_multiply_int(arg2, 360);
+ number_modulo(arg1, arg2);
+ convert_scaled_to_angle(arg1);
+ n_sin_cos(arg1, n_cos, n_sin);
+ fraction_to_round_scaled(n_sin);
+ fraction_to_round_scaled(n_cos);
+ mp_set_value_number(mp_xx_part(q), n_cos);
+ mp_set_value_number(mp_yx_part(q), n_sin);
+ mp_set_value_number(mp_xy_part(q), mp_get_value_number(mp_yx_part(q)));
+ number_negate(mp_get_value_number(mp_xy_part(q)));
+ mp_set_value_number(mp_yy_part(q), mp_get_value_number(mp_xx_part(q)));
+ free_number(arg1);
+ free_number(arg2);
+ free_number(n_sin);
+ free_number(n_cos);
+ goto DONE;
+ }
+ break;
+ case mp_slanted_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_xy_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_scaled_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_xx_part(q), p);
+ mp_install(mp, mp_yy_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_shifted_operation:
+ if (mp_type(p) == mp_pair_type) {
+ r = mp_get_value_node(p);
+ mp_install(mp, mp_tx_part(q), mp_x_part(r));
+ mp_install(mp, mp_ty_part(q), mp_y_part(r));
+ goto DONE;
+ }
+ break;
+ case mp_x_scaled_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_xx_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_y_scaled_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_yy_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_z_scaled_operation:
+ if (mp_type(p) == mp_pair_type) {
+ {
+ r = mp_get_value_node(p);
+ mp_install(mp, mp_xx_part(q), mp_x_part(r));
+ mp_install(mp, mp_yy_part(q), mp_x_part(r));
+ mp_install(mp, mp_yx_part(q), mp_y_part(r));
+ if (mp_type(mp_y_part(r)) == mp_known_type) {
+ mp_set_value_number(mp_y_part(r), mp_get_value_number(mp_y_part(r)));
+ number_negate(mp_get_value_number(mp_y_part(r)));
+ } else {
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) mp_y_part(r)));
+ }
+ mp_install(mp, mp_xy_part(q), mp_y_part(r));
+ goto DONE;
+ }
+ }
+ break;
+ case mp_transformed_operation:
+ break;
+ }
+ mp_disp_err(mp, p);
+ mp_back_error(
+ mp,
+ "Improper transformation argument",
+ "The expression shown above has the wrong type, so I can't transform anything\n"
+ "using it. Proceed, and I'll omit the transformation."
+ );
+ mp_get_x_next(mp);
+ DONE:
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ }
+ q = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_tx_part(q)) == mp_known_type) &&
+ (mp_type(mp_ty_part(q)) == mp_known_type) &&
+ (mp_type(mp_xx_part(q)) == mp_known_type) &&
+ (mp_type(mp_xy_part(q)) == mp_known_type) &&
+ (mp_type(mp_yx_part(q)) == mp_known_type) &&
+ (mp_type(mp_yy_part(q)) == mp_known_type) ) {
+ number_clone(mp->txx, mp_get_value_number(mp_xx_part(q)));
+ number_clone(mp->txy, mp_get_value_number(mp_xy_part(q)));
+ number_clone(mp->tyx, mp_get_value_number(mp_yx_part(q)));
+ number_clone(mp->tyy, mp_get_value_number(mp_yy_part(q)));
+ number_clone(mp->tx, mp_get_value_number(mp_tx_part(q)));
+ number_clone(mp->ty, mp_get_value_number(mp_ty_part(q)));
+ new_number(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+static void mp_set_up_known_trans (MP mp, int c)
+{
+ mp_set_up_trans(mp, c);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Transform components aren't all known",
+ "I'm unable to apply a partially specified transformation except to a fully known\n"
+ "pair or transform. Proceed, and I'll omit the transformation."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ set_number_to_unity(mp->txx);
+ set_number_to_zero(mp->txy);
+ set_number_to_zero(mp->tyx);
+ set_number_to_unity(mp->tyy);
+ set_number_to_zero(mp->tx);
+ set_number_to_zero(mp->ty);
+ }
+}
+static void mp_number_trans (MP mp, mp_number *p, mp_number *q)
+{
+ mp_number r1, r2, v;
+ new_number(r1);
+ new_number(r2);
+ new_number(v);
+ take_scaled(r1, *p, mp->txx);
+ take_scaled(r2, *q, mp->txy);
+ number_add(r1, r2);
+ set_number_from_addition(v, r1, mp->tx);
+ take_scaled(r1, *p, mp->tyx);
+ take_scaled(r2, *q, mp->tyy);
+ number_add(r1, r2);
+ set_number_from_addition(*q, r1, mp->ty);
+ number_clone(*p,v);
+ free_number(r1);
+ free_number(r2);
+ free_number(v);
+}
+static void mp_do_path_trans (MP mp, mp_knot p)
+{
+ mp_knot q = p;
+ do {
+ if (mp_left_type(q) != mp_endpoint_knot) {
+ mp_number_trans(mp, &q->left_x, &q->left_y);
+ }
+ mp_number_trans(mp, &q->x_coord, &q->y_coord);
+ if (mp_right_type(q) != mp_endpoint_knot) {
+ mp_number_trans(mp, &q->right_x, &q->right_y);
+ }
+ q = mp_next_knot(q);
+ } while (q != p);
+}
+static void mp_do_pen_trans (MP mp, mp_knot p)
+{
+ mp_knot q = p;
+ if (mp_pen_is_elliptical(p)) {
+ mp_number_trans(mp, &p->left_x, &p->left_y);
+ mp_number_trans(mp, &p->right_x, &p->right_y);
+ }
+ do {
+ mp_number_trans(mp, &q->x_coord, &q->y_coord);
+ q = mp_next_knot(q);
+ } while (q != p);
+}
+static void mp_do_path_pen_trans (MP mp, mp_shape_node p, mp_number *sqdet, int sgndet)
+{
+ mp_number sx, sy;
+ if (mp_pen_ptr(p) != NULL) {
+ new_number_clone(sx, mp->tx);
+ new_number_clone(sy, mp->ty);
+ set_number_to_zero(mp->tx);
+ set_number_to_zero(mp->ty);
+ mp_do_pen_trans(mp, mp_pen_ptr(p));
+ if (number_nonzero(*sqdet) && ((mp_type(p) == mp_stroked_node_type) && (mp_dash_ptr(p) != NULL))) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, ((mp_shape_node) p)->dashscale, *sqdet);
+ number_clone(((mp_shape_node) p)->dashscale, ret);
+ free_number(ret);
+ }
+ if (! mp_pen_is_elliptical(mp_pen_ptr(p)) && sgndet < 0) {
+ mp_pen_ptr(p) = mp_make_pen(mp, mp_copy_path(mp, mp_pen_ptr(p)), 1);
+ }
+ number_clone(mp->tx, sx);
+ number_clone(mp->ty, sy);
+ free_number(sx);
+ free_number(sy);
+ }
+}
+static mp_edge_header_node mp_edges_trans (MP mp, mp_edge_header_node h)
+{
+ mp_node q;
+ mp_dash_node r, s;
+ mp_number sqdet;
+ int sgndet;
+ h = mp_private_edges(mp, h);
+ new_number(sqdet);
+ mp_sqrt_det(mp, &sqdet, &(mp->txx), &(mp->txy), &(mp->tyx), &(mp->tyy));
+ sgndet = ab_vs_cd(mp->txx, mp->tyy, mp->txy, mp->tyx);
+ if (mp_get_dash_list(h) != mp->null_dash) {
+ if (number_nonzero(mp->txy) || number_nonzero(mp->tyx) || number_nonzero(mp->ty) || number_nonequalabs(mp->txx, mp->tyy)) {
+ mp_flush_dash_list(mp, h);
+ } else {
+ mp_number abs_tyy, ret;
+ new_number(abs_tyy);
+ if (number_negative(mp->txx)) {
+ {
+ r = mp_get_dash_list(h);
+ mp_set_dash_list(h, mp->null_dash);
+ while (r != mp->null_dash) {
+ s = r;
+ r = (mp_dash_node) mp_link(r);
+ number_swap(s->start_x, s->stop_x );
+ mp_link(s) = (mp_node) mp_get_dash_list(h);
+ mp_set_dash_list(h, s);
+ }
+ }
+ }
+ r = mp_get_dash_list(h);
+ {
+ mp_number arg1;
+ new_number(arg1);
+ while (r != mp->null_dash) {
+ take_scaled(arg1, r->start_x, mp->txx);
+ set_number_from_addition(r->start_x, arg1, mp->tx);
+ take_scaled(arg1, r->stop_x, mp->txx);
+ set_number_from_addition(r->stop_x, arg1, mp->tx);
+ r = (mp_dash_node) mp_link(r);
+ }
+ free_number(arg1);
+ }
+ number_abs_clone(abs_tyy, mp->tyy);
+ new_number(ret);
+ take_scaled(ret, h->dash_y, abs_tyy);
+ number_clone(h->dash_y, ret);
+ free_number(ret);
+ free_number(abs_tyy);
+ }
+ }
+ if (number_zero(mp->txx) && number_zero(mp->tyy)) {
+ number_swap(h->minx, h->miny);
+ number_swap(h->maxx, h->maxy);
+ } else if (number_nonzero(mp->txy) || number_nonzero(mp->tyx)) {
+ mp_init_bbox(mp, h);
+ goto DONE1;
+ }
+ if (number_lessequal(h->minx, h->maxx)) {
+ mp_number tot, ret;
+ new_number(tot);
+ new_number(ret);
+ set_number_from_addition(tot,mp->txx,mp->txy);
+ take_scaled(ret, h->minx, tot);
+ set_number_from_addition(h->minx,ret, mp->tx);
+ take_scaled(ret, h->maxx, tot);
+ set_number_from_addition(h->maxx,ret, mp->tx);
+ set_number_from_addition(tot,mp->tyx,mp->tyy);
+ take_scaled(ret, h->miny, tot);
+ set_number_from_addition(h->miny, ret, mp->ty);
+ take_scaled(ret, h->maxy, tot);
+ set_number_from_addition(h->maxy, ret, mp->ty);
+ set_number_from_addition(tot, mp->txx, mp->txy);
+ if (number_negative(tot)) {
+ number_swap(h->minx, h->maxx);
+ }
+ set_number_from_addition(tot, mp->tyx, mp->tyy);
+ if (number_negative(tot)) {
+ number_swap(h->miny, h->maxy);
+ }
+ free_number(ret);
+ free_number(tot);
+ }
+ DONE1:
+ q = mp_link(mp_edge_list(h));
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ mp_do_path_trans(mp, mp_path_ptr((mp_shape_node) q));
+ mp_do_path_pen_trans(mp, (mp_shape_node) q, &sqdet, sgndet);
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ mp_do_path_trans(mp, mp_path_ptr((mp_start_node) q));
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ free_number(sqdet);
+ return h;
+}
+static void mp_do_edges_trans (MP mp, mp_node p, int c)
+{
+ mp_set_up_known_trans (mp, c);
+ mp_set_value_node(p, (mp_node) mp_edges_trans(mp, (mp_edge_header_node) mp_get_value_node(p)));
+ mp_unstash_cur_exp(mp, p);
+}
+static mp_edge_header_node mp_scale_edges (MP mp, mp_number *se_sf, mp_edge_header_node se_pic)
+{
+ number_clone(mp->txx, *se_sf);
+ number_clone(mp->tyy, *se_sf);
+ set_number_to_zero(mp->txy);
+ set_number_to_zero(mp->tyx);
+ set_number_to_zero(mp->tx);
+ set_number_to_zero(mp->ty);
+ return mp_edges_trans(mp, se_pic);
+}
+static void mp_bilin1 (MP mp, mp_node p, mp_number *t, mp_node q, mp_number *u, mp_number *delta_orig)
+{
+ mp_number delta;
+ new_number_clone(delta, *delta_orig);
+ if (! number_equal(*t, unity_t)) {
+ mp_dep_mult(mp, (mp_value_node) p, t, 1);
+ }
+ if (number_nonzero(*u)) {
+ if (mp_type(q) == mp_known_type) {
+ mp_number tmp;
+ new_number(tmp);
+ take_scaled(tmp, mp_get_value_number(q), *u);
+ number_add(delta, tmp);
+ free_number(tmp);
+ } else {
+ if (mp_type(p) != mp_proto_dependent_type) {
+ if (mp_type(p) == mp_known_type) {
+ mp_new_dep(mp, p, mp_type(p), mp_const_dependency(mp, &(mp_get_value_number(p))));
+ } else {
+ mp_set_dep_list((mp_value_node) p,
+ mp_p_times_v(mp,
+ (mp_value_node) mp_get_dep_list((mp_value_node) p), &unity_t,
+ mp_dependent_type, mp_proto_dependent_type, 1));
+ }
+ mp_type(p) = mp_proto_dependent_type;
+ }
+ mp_set_dep_list((mp_value_node) p,
+ mp_p_plus_fq(mp,
+ (mp_value_node) mp_get_dep_list((mp_value_node) p), u,
+ (mp_value_node) mp_get_dep_list((mp_value_node) q),
+ mp_proto_dependent_type, mp_type(q)));
+ }
+ }
+ if (mp_type(p) == mp_known_type) {
+ mp_set_value_number(p, mp_get_value_number(p));
+ number_add(mp_get_value_number(p), delta);
+ } else {
+ mp_number tmp;
+ mp_value_node r = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ while (mp_get_dep_info(r) != NULL) {
+ r = (mp_value_node) mp_link(r);
+ }
+ new_number_clone(tmp, mp_get_value_number(r));
+ number_add(delta, tmp);
+
+ if (r != (mp_value_node) mp_get_dep_list((mp_value_node) p)) {
+ mp_set_value_number(r, delta);
+ } else {
+ mp_recycle_value(mp, p);
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, delta);
+ }
+ free_number(tmp);
+ }
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ free_number(delta);
+}
+static void mp_add_mult_dep (MP mp, mp_value_node p, mp_number *v, mp_node r)
+{
+ if (mp_type(r) == mp_known_type) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, mp_get_value_number(r), *v);
+ mp_set_dep_value(mp->dep_final, mp_get_dep_value(mp->dep_final));
+ number_add(mp_get_dep_value(mp->dep_final), ret);
+ free_number(ret);
+ } else {
+ mp_set_dep_list(p, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(p), v, (mp_value_node) mp_get_dep_list((mp_value_node) r), mp_proto_dependent_type, mp_type(r)));
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ }
+}
+static void mp_bilin2 (MP mp, mp_node p, mp_node t, mp_number *v, mp_node u, mp_node q)
+{
+ mp_number vv;
+ new_number_clone(vv, mp_get_value_number(p));
+ mp_new_dep(mp, p, mp_proto_dependent_type, mp_const_dependency(mp, &zero_t));
+ if (number_nonzero(vv)) {
+ mp_add_mult_dep(mp, (mp_value_node) p, &vv, t);
+ }
+ if (number_nonzero(*v)) {
+ mp_number arg1;
+ new_number_clone(arg1, *v);
+ mp_add_mult_dep(mp, (mp_value_node) p, &arg1, u);
+ free_number(arg1);
+ }
+ if (q != NULL) {
+ mp_add_mult_dep(mp, (mp_value_node) p, &unity_t, q);
+ }
+ if (mp_get_dep_list((mp_value_node) p) == (mp_node) mp->dep_final) {
+ number_clone(vv, mp_get_dep_value(mp->dep_final));
+ mp_recycle_value(mp, p);
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, vv);
+ }
+ free_number(vv);
+}
+static void mp_bilin3 (MP mp, mp_node p, mp_number *t, mp_number *v, mp_number *u, mp_number *delta_orig)
+{
+ mp_number delta;
+ mp_number tmp;
+ new_number(tmp);
+ new_number_clone(delta, *delta_orig);
+ if (! number_equal(*t, unity_t)) {
+ take_scaled(tmp, mp_get_value_number(p), *t);
+ } else {
+ number_clone(tmp, mp_get_value_number(p));
+ }
+ number_add(delta, tmp);
+ if (number_nonzero(*u)) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, *v, *u);
+ mp_set_value_number(p, delta);
+ number_add(mp_get_value_number(p), ret);
+ free_number(ret);
+ } else {
+ mp_set_value_number(p, delta);
+ }
+ free_number(tmp);
+ free_number(delta);
+}
+
+static void mp_big_trans (MP mp, mp_node p, int c)
+{
+ mp_node q = mp_get_value_node(p);
+ if (mp_type(q) == mp_pair_node_type) {
+ if (mp_type(mp_x_part(q)) != mp_known_type || mp_type(mp_y_part(q)) != mp_known_type) {
+ goto UNKNOWN;
+ }
+ } else if (mp_type(mp_tx_part(q)) != mp_known_type || mp_type(mp_ty_part(q)) != mp_known_type ||
+ mp_type(mp_xx_part(q)) != mp_known_type || mp_type(mp_xy_part(q)) != mp_known_type ||
+ mp_type(mp_yx_part(q)) != mp_known_type || mp_type(mp_yy_part(q)) != mp_known_type) {
+ goto UNKNOWN;
+ }
+ {
+ mp_node r, pp, qq;
+ mp_set_up_trans(mp, c);
+ if (mp->cur_exp.type == mp_known_type) {
+ mp_make_exp_copy(mp, p);
+ r = mp_get_value_node(cur_exp_node);
+ if (mp->cur_exp.type == mp_transform_type) {
+ mp_bilin3(mp, mp_yy_part(r), &(mp->tyy), &(mp_get_value_number(mp_xy_part(q))), &(mp->tyx), &zero_t);
+ mp_bilin3(mp, mp_yx_part(r), &(mp->tyy), &(mp_get_value_number(mp_xx_part(q))), &(mp->tyx), &zero_t);
+ mp_bilin3(mp, mp_xy_part(r), &(mp->txx), &(mp_get_value_number(mp_yy_part(q))), &(mp->txy), &zero_t);
+ mp_bilin3(mp, mp_xx_part(r), &(mp->txx), &(mp_get_value_number(mp_yx_part(q))), &(mp->txy), &zero_t);
+ }
+ mp_bilin3(mp, mp_y_part(r), &(mp->tyy), &(mp_get_value_number(mp_x_part(q))), &(mp->tyx), &(mp->ty));
+ mp_bilin3(mp, mp_x_part(r), &(mp->txx), &(mp_get_value_number(mp_y_part(q))), &(mp->txy), &(mp->tx));
+ } else {
+ pp = mp_stash_cur_exp(mp);
+ qq = mp_get_value_node(pp);
+ mp_make_exp_copy(mp, p);
+ r = mp_get_value_node(cur_exp_node);
+ if (mp->cur_exp.type == mp_transform_type) {
+ mp_bilin2(mp, mp_yy_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_xy_part(q))), mp_yx_part(qq), NULL);
+ mp_bilin2(mp, mp_yx_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_xx_part(q))), mp_yx_part(qq), NULL);
+ mp_bilin2(mp, mp_xy_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_yy_part(q))), mp_xy_part(qq), NULL);
+ mp_bilin2(mp, mp_xx_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_yx_part(q))), mp_xy_part(qq), NULL);
+ }
+ mp_bilin2(mp, mp_y_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_x_part(q))), mp_yx_part(qq), mp_y_part(qq));
+ mp_bilin2(mp, mp_x_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_y_part(q))), mp_xy_part(qq), mp_x_part(qq));
+ mp_recycle_value(mp, pp);
+ mp_free_value_node(mp, pp);
+ }
+ return;
+ }
+ UNKNOWN:
+ {
+ mp_node r;
+ mp_set_up_known_trans(mp, c);
+ mp_make_exp_copy(mp, p);
+ r = mp_get_value_node(cur_exp_node);
+ if (mp->cur_exp.type == mp_transform_type) {
+ mp_bilin1(mp, mp_yy_part(r), &(mp->tyy), mp_xy_part(q), &(mp->tyx), &zero_t);
+ mp_bilin1(mp, mp_yx_part(r), &(mp->tyy), mp_xx_part(q), &(mp->tyx), &zero_t);
+ mp_bilin1(mp, mp_xy_part(r), &(mp->txx), mp_yy_part(q), &(mp->txy), &zero_t);
+ mp_bilin1(mp, mp_xx_part(r), &(mp->txx), mp_yx_part(q), &(mp->txy), &zero_t);
+ }
+ mp_bilin1(mp, mp_y_part(r), &(mp->tyy), mp_x_part(q), &(mp->tyx), &(mp->ty));
+ mp_bilin1(mp, mp_x_part(r), &(mp->txx), mp_y_part(q), &(mp->txy), &(mp->tx));
+
+ return;
+ }
+}
+static void mp_chop_path (MP mp, mp_node p)
+{
+ mp_knot q;
+ mp_knot pp, qq;
+ mp_number a, b;
+ mp_number l;
+ int reversed;
+ new_number(l);
+ mp_path_length(mp, &l);
+ new_number_clone(a, mp_get_value_number(mp_x_part(p)));
+ new_number_clone(b, mp_get_value_number(mp_y_part(p)));
+ if (number_lessequal(a, b)) {
+ reversed = 0;
+ } else {
+ reversed = 1;
+ number_swap (a, b);
+ }
+ if (number_negative(a)) {
+ if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ set_number_to_zero(a);
+ if (number_negative(b)) {
+ set_number_to_zero(b);
+ }
+ } else {
+ do {
+ number_add(a, l);
+ number_add(b, l);
+ } while (number_negative(a));
+ }
+ }
+ if (number_greater(b, l)) {
+ if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ number_clone(b, l);
+ if (number_greater(a, l)) {
+ number_clone(a, l);
+ }
+ } else {
+ while (number_greaterequal(a, l)) {
+ number_subtract(a, l);
+ number_subtract(b, l);
+ }
+ }
+ }
+ q = cur_exp_knot;
+ while (number_greaterequal(a, unity_t)) {
+ q = mp_next_knot(q);
+ number_subtract(a, unity_t);
+ number_subtract(b, unity_t);
+ }
+ if (number_equal(b, a)) {
+ if (number_positive(a)) {
+ mp_number arg1;
+ new_number_clone(arg1, a);
+ convert_scaled_to_fraction(arg1);
+ mp_split_cubic(mp, q, &arg1);
+ free_number(arg1);
+ q = mp_next_knot(q);
+ }
+ pp = mp_copy_knot(mp, q);
+ qq = pp;
+ } else {
+ mp_knot rr;
+ pp = mp_copy_knot(mp, q);
+ qq = pp;
+ do {
+ q = mp_next_knot(q);
+ rr = qq;
+ qq = mp_copy_knot(mp, q);
+ mp_prev_knot(qq) = rr;
+ mp_next_knot(rr) = qq;
+ number_subtract(b, unity_t);
+ } while (number_positive(b));
+ if (number_positive(a)) {
+ mp_knot ss = pp;
+ mp_number arg1;
+ new_number_clone(arg1, a);
+ convert_scaled_to_fraction(arg1);
+ mp_split_cubic(mp, ss, &arg1);
+ free_number(arg1);
+ pp = mp_next_knot(ss);
+ mp_toss_knot(mp, ss);
+ if (rr == ss) {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ set_number_from_subtraction(arg1, unity_t, a);
+ new_number_clone(arg2, b);
+ make_scaled(b, arg2, arg1);
+ free_number(arg1);
+ free_number(arg2);
+ rr = pp;
+ }
+ }
+ if (number_negative(b)) {
+ mp_number arg1;
+ new_number(arg1);
+ set_number_from_addition(arg1, b, unity_t);
+ convert_scaled_to_fraction(arg1);
+ mp_split_cubic(mp, rr, &arg1);
+ free_number(arg1);
+ mp_toss_knot(mp, qq);
+ qq = mp_next_knot(rr);
+ }
+ }
+ mp_left_type(pp) = mp_endpoint_knot;
+ mp_right_type(qq) = mp_endpoint_knot;
+ mp_prev_knot(pp) = qq;
+ mp_next_knot(qq) = pp;
+ mp_toss_knot_list(mp, cur_exp_knot);
+ if (reversed) {
+ mp_set_cur_exp_knot(mp, mp_next_knot(mp_htap_ypoc(mp, pp)));
+ mp_toss_knot_list(mp, pp);
+ } else {
+ mp_set_cur_exp_knot(mp, pp);
+ }
+ free_number(l);
+ free_number(a);
+ free_number(b);
+}
+static void mp_set_up_offset (MP mp, mp_node p)
+{
+ mp_find_offset(mp, &(mp_get_value_number(mp_x_part(p))), &(mp_get_value_number(mp_y_part(p))), cur_exp_knot);
+ mp_pair_value(mp, &(mp->cur_x), &(mp->cur_y));
+}
+static void mp_set_up_direction_time (MP mp, mp_node p)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_find_direction_time(mp, &new_expr.data.n, &(mp_get_value_number(mp_x_part(p))), &(mp_get_value_number(mp_y_part(p))), cur_exp_knot);
+ mp_flush_cur_exp(mp, new_expr);
+}
+static void mp_set_up_envelope (MP mp, mp_node p)
+{
+ mp_knot q = mp_copy_path(mp, cur_exp_knot);
+
+ if (mp_pen_is_elliptical(mp_get_value_knot(p))) {
+ mp_bad_envelope_pen(mp);
+ mp_set_cur_exp_knot(mp, q);
+ mp->cur_exp.type = mp_path_type;
+ } else {
+ int linejoin = mp_mitered_linejoin_code;
+ int linecap = mp_butt_linecap_code;
+ mp_number miterlimit;
+ new_number(miterlimit);
+ if (number_greater(internal_value(mp_linejoin_internal), unity_t)) {
+ linejoin = mp_beveled_linejoin_code;
+ } else if (number_positive(internal_value(mp_linejoin_internal))) {
+ linejoin = mp_rounded_linejoin_code;
+ }
+ if (number_greater(internal_value(mp_linecap_internal), unity_t)) {
+ linecap = mp_squared_linecap_code;
+ } else if (number_positive(internal_value(mp_linecap_internal))) {
+ linecap = mp_rounded_linecap_code;
+ }
+ if (number_less(internal_value(mp_miterlimit_internal), unity_t)) {
+ set_number_to_unity(miterlimit);
+ } else {
+ number_clone(miterlimit, internal_value(mp_miterlimit_internal));
+ }
+ mp_set_cur_exp_knot(mp, mp_make_envelope(mp, q, mp_get_value_knot(p), linejoin, linecap, &miterlimit));
+ mp->cur_exp.type = mp_path_type;
+ }
+}
+static void mp_set_up_boundingpath (MP mp, mp_node p)
+{
+ mp_number miterlimit;
+ mp_knot q = mp_copy_path(mp, cur_exp_knot);
+ mp_knot qq;
+ int linejoin = mp_mitered_linejoin_code;
+ int linecap = mp_butt_linecap_code;
+ mp_knot pen = mp_get_value_knot(p);
+ new_number(miterlimit);
+ if (mp_pen_is_elliptical(mp_get_value_knot(p))) {
+ mp_knot kp, kq;
+ pen = mp_copy_pen(mp, mp_get_value_knot(p));
+ mp_make_path(mp, pen);
+ kq = pen;
+ do {
+ kp = kq;
+ kq = mp_next_knot(kq);
+ mp_prev_knot(kq) = kp;
+ } while (kq != pen);
+ mp_close_path_cycle(mp, kp, pen);
+ }
+ if (number_greater(internal_value(mp_linejoin_internal), unity_t)) {
+ linejoin = mp_beveled_linejoin_code;
+ } else if (number_positive(internal_value(mp_linejoin_internal))) {
+ linejoin = mp_rounded_linejoin_code;
+ }
+ if (number_greater(internal_value(mp_linecap_internal), unity_t)) {
+ linecap = mp_squared_linecap_code;
+ } else if (number_positive(internal_value(mp_linecap_internal))) {
+ linecap = mp_rounded_linecap_code;
+ }
+ if (number_less(internal_value(mp_miterlimit_internal), unity_t)) {
+ set_number_to_unity(miterlimit);
+ } else {
+ number_clone(miterlimit, internal_value(mp_miterlimit_internal));
+ }
+ qq = mp_make_envelope(mp, q, pen, linejoin, linecap, &miterlimit);
+ mp_set_cur_exp_knot(mp, qq);
+ mp->cur_exp.type = mp_path_type;
+ if (! mp_get_cur_bbox(mp)) {
+ mp_bad_binary(mp, p, mp_boundingpath_operation);
+ mp_set_cur_exp_knot(mp, q);
+ mp->cur_exp.type = mp_path_type;
+ return;
+ } else {
+ mp_knot ll = mp_new_knot(mp);
+ mp_knot lr = mp_new_knot(mp);
+ mp_knot ur = mp_new_knot(mp);
+ mp_knot ul = mp_new_knot(mp);
+ if (ll == NULL || lr == NULL || ur == NULL || ul == NULL){
+ mp_bad_binary(mp, p, mp_boundingpath_operation);
+ mp_set_cur_exp_knot(mp, q);
+ mp->cur_exp.type = mp_path_type;
+ return;
+ } else {
+ mp_left_type(ll) = mp_endpoint_knot;
+ mp_right_type(ll) = mp_endpoint_knot;
+ mp_originator(ll) = mp_program_code;
+ mp_knotstate(ll) = mp_regular_knot;
+ number_clone(ll->x_coord, mp_minx);
+ number_clone(ll->y_coord, mp_miny);
+ mp_originator(lr) = mp_program_code;
+ mp_knotstate(lr) = mp_regular_knot;
+ number_clone(lr->x_coord, mp_maxx);
+ number_clone(lr->y_coord, mp_miny);
+ mp_originator(ur) = mp_program_code;
+ mp_knotstate(ur) = mp_regular_knot;
+ number_clone(ur->x_coord, mp_maxx);
+ number_clone(ur->y_coord, mp_maxy);
+ mp_originator(ul) = mp_program_code;
+ mp_knotstate(ul) = mp_regular_knot;
+ number_clone(ul->x_coord, mp_minx);
+ number_clone(ul->y_coord, mp_maxy);
+ mp_prev_knot(lr) = ll;
+ mp_next_knot(ll) = lr;
+ mp_prev_knot(ur) = lr;
+ mp_next_knot(lr) = ur;
+ mp_prev_knot(ul) = ur;
+ mp_next_knot(ur) = ul;
+ mp_close_path_cycle(mp, ul, ll);
+ mp_make_path(mp,ll);
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, ll);
+ mp_free_path(mp,qq);
+ }
+ }
+}
+static void mp_find_point (MP mp, mp_number *v_orig, int c)
+{
+ mp_knot p;
+ mp_number n;
+ mp_number v;
+ new_number(n);
+ new_number_clone(v, *v_orig);
+ p = cur_exp_knot;
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ set_number_to_unity(n);
+ number_negate(n);
+ }
+ do {
+ p = mp_next_knot(p);
+ number_add(n, unity_t);
+ } while (p != cur_exp_knot);
+ if (number_zero(n)) {
+ set_number_to_zero(v);
+ } else if (number_negative(v)) {
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ set_number_to_zero(v);
+ } else {
+ number_negate(v);
+ number_add_scaled(v, -1);
+ number_modulo(v, n);
+ number_negate(v);
+ number_add_scaled(v, -1);
+ number_add(v, n);
+ }
+ } else if (number_greater(v, n)) {
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ number_clone(v, n);
+ } else {
+ number_modulo(v, n);
+ }
+ }
+ p = cur_exp_knot;
+ while (number_greaterequal(v, unity_t)) {
+ p = mp_next_knot(p);
+ number_subtract(v, unity_t);
+ }
+ if (number_nonzero(v)) {
+ convert_scaled_to_fraction(v);
+ mp_split_cubic(mp, p, &v);
+ p = mp_next_knot(p);
+ }
+ push_of_path_result(mp, c - mp_point_operation, p);
+ free_number(v);
+ free_number(n);
+}
+
+static void mp_finish_binary (MP mp, mp_node old_p, mp_node old_exp)
+{
+ check_arith();
+ if (old_p != NULL) {
+ mp_recycle_value(mp, old_p);
+ mp_free_value_node(mp, old_p);
+ }
+ if (old_exp != NULL) {
+ mp_recycle_value(mp, old_exp);
+ mp_free_value_node(mp, old_exp);
+ }
+}
+
+static void mp_do_binary (MP mp, mp_node p, int c)
+{
+ mp_node old_p, old_exp;
+ mp_value new_expr;
+ check_arith();
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{(");
+ mp_print_exp(mp, p, 0);
+ mp_print_chr(mp, ')');
+ mp_print_op(mp, (int) c);
+ mp_print_chr(mp, '(');
+ mp_print_exp(mp, NULL, 0);
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+ }
+ switch (mp_type(p)) {
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ old_p = mp_tarnished(mp, p);
+ break;
+ case mp_independent_type:
+ old_p = MP_VOID;
+ break;
+ default:
+ old_p = NULL;
+ break;
+ }
+ if (old_p != NULL) {
+ mp_node q = mp_stash_cur_exp(mp);
+ old_p = p;
+ mp_make_exp_copy(mp, old_p);
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, q);
+ }
+ switch (mp->cur_exp.type) {
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ old_exp = mp_tarnished(mp, cur_exp_node);
+ break;
+ case mp_independent_type:
+ old_exp = MP_VOID;
+ break;
+ default:
+ old_exp = NULL;
+ break;
+ }
+ if (old_exp != NULL) {
+ old_exp = cur_exp_node;
+ mp_make_exp_copy(mp, old_exp);
+ }
+ switch (c) {
+ case mp_plus_operation:
+ case mp_minus_operation:
+ if ((mp->cur_exp.type < mp_color_type) || (mp_type(p) < mp_color_type)) {
+ mp_bad_binary(mp, p, c);
+ } else {
+ if ((mp->cur_exp.type > mp_pair_type) && (mp_type(p) > mp_pair_type)) {
+ mp_add_or_subtract(mp, p, NULL, c);
+ } else if (mp->cur_exp.type != mp_type(p)) {
+
+ mp_bad_binary(mp, p, c);
+ } else {
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ mp_add_or_subtract(mp, mp_x_part(q), mp_x_part(r), c);
+ mp_add_or_subtract(mp, mp_y_part(q), mp_y_part(r), c);
+ break;
+ case mp_color_type:
+ mp_add_or_subtract(mp, mp_red_part(q), mp_red_part(r), c);
+ mp_add_or_subtract(mp, mp_green_part(q), mp_green_part(r), c);
+ mp_add_or_subtract(mp, mp_blue_part(q), mp_blue_part(r), c);
+ break;
+ case mp_cmykcolor_type:
+ mp_add_or_subtract(mp, mp_cyan_part(q), mp_cyan_part(r), c);
+ mp_add_or_subtract(mp, mp_magenta_part(q), mp_magenta_part(r), c);
+ mp_add_or_subtract(mp, mp_yellow_part(q), mp_yellow_part(r), c);
+ mp_add_or_subtract(mp, mp_black_part(q), mp_black_part(r), c);
+ break;
+ case mp_transform_type:
+ mp_add_or_subtract(mp, mp_tx_part(q), mp_tx_part(r), c);
+ mp_add_or_subtract(mp, mp_ty_part(q), mp_ty_part(r), c);
+ mp_add_or_subtract(mp, mp_xx_part(q), mp_xx_part(r), c);
+ mp_add_or_subtract(mp, mp_xy_part(q), mp_xy_part(r), c);
+ mp_add_or_subtract(mp, mp_yx_part(q), mp_yx_part(r), c);
+ mp_add_or_subtract(mp, mp_yy_part(q), mp_yy_part(r), c);
+ break;
+ default:
+ break;
+ }
+ }
+ }
+ break;
+ case mp_less_than_operation:
+ case mp_less_or_equal_operation:
+ case mp_greater_than_operation:
+ case mp_greater_or_equal_operation:
+ case mp_equal_operation:
+ case mp_unequal_operation:
+ check_arith();
+ if ((mp->cur_exp.type > mp_pair_type) && (mp_type(p) > mp_pair_type)) {
+ mp_add_or_subtract(mp, p, NULL, mp_minus_operation);
+ } else if (mp->cur_exp.type != mp_type(p)) {
+ mp_bad_binary(mp, p, (int) c);
+ goto DONE;
+ } else {
+ switch (mp->cur_exp.type) {
+ case mp_string_type:
+ {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_from_scaled(new_expr.data.n, mp_str_vs_str(mp, mp_get_value_str(p), cur_exp_str));
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_unknown_string_type:
+ case mp_unknown_boolean_type:
+ {
+ mp_node q = mp_get_value_node(cur_exp_node);
+ while ((q != cur_exp_node) && (q != p)) {
+ q = mp_get_value_node(q);
+ }
+ if (q == p) {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_set_cur_exp_node(mp, NULL);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ }
+ break;
+ case mp_pair_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_x_part(r);
+ part_type = mp_x_part_operation;
+ mp_add_or_subtract(mp, mp_x_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_y_part(r);
+ part_type = mp_y_part_operation;
+ mp_add_or_subtract(mp, mp_y_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_color_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_red_part(r);
+ part_type = mp_red_part_operation;
+ mp_add_or_subtract(mp, mp_red_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_green_part(r);
+ part_type = mp_green_part_operation;
+ mp_add_or_subtract(mp, mp_green_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_blue_part(r);
+ part_type = mp_blue_part_operation;
+ mp_add_or_subtract(mp, mp_blue_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_cyan_part(r);
+ part_type = mp_cyan_part_operation;
+ mp_add_or_subtract(mp, mp_cyan_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_magenta_part(r);
+ part_type = mp_magenta_part_operation;
+ mp_add_or_subtract(mp, mp_magenta_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_yellow_part(r);
+ part_type = mp_yellow_part_operation;
+ mp_add_or_subtract(mp, mp_yellow_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_black_part(r);
+ part_type = mp_black_part_operation;
+ mp_add_or_subtract(mp, mp_black_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_transform_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_tx_part(r);
+ part_type = mp_x_part_operation;
+ mp_add_or_subtract(mp, mp_tx_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_ty_part(r);
+ part_type = mp_y_part_operation;
+ mp_add_or_subtract(mp, mp_ty_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_xx_part(r);
+ part_type = mp_xx_part_operation;
+ mp_add_or_subtract(mp, mp_xx_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_xy_part(r);
+ part_type = mp_xy_part_operation;
+ mp_add_or_subtract(mp, mp_xy_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_yx_part(r);
+ part_type = mp_yx_part_operation;
+ mp_add_or_subtract(mp, mp_yx_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_yy_part(r);
+ part_type = mp_yy_part_operation;
+ mp_add_or_subtract(mp, mp_yy_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_boolean_type:
+ {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_from_boolean(new_expr.data.n, number_to_scaled(cur_exp_value_number) - number_to_scaled(mp_get_value_number(p)));
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ default:
+ mp_bad_binary(mp, p, (int) c);
+ goto DONE;
+ break;
+ }
+ }
+ if (mp->cur_exp.type != mp_known_type) {
+ const char *hlp = NULL;
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_disp_err(mp, p);
+ hlp = "The quantities shown above have not been equated.";
+ } else {
+ hlp =
+ "Oh dear. I can't decide if the expression above is positive, negative, or zero.\n"
+ "So this comparison test won't be 'true'.";
+ }
+ mp_disp_err(mp, NULL);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_from_boolean(new_expr.data.n, mp_false_operation);
+ mp_back_error(mp, "Unknown relation will be considered false", hlp);
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ int b = 0;
+ switch (c) {
+ case mp_less_than_operation:
+ b = number_negative(cur_exp_value_number);
+ break;
+ case mp_less_or_equal_operation:
+ b = number_nonpositive(cur_exp_value_number);
+ break;
+ case mp_greater_than_operation:
+ b = number_positive(cur_exp_value_number);
+ break;
+ case mp_greater_or_equal_operation:
+ b = number_nonnegative(cur_exp_value_number);
+ break;
+ case mp_equal_operation:
+ b = number_zero(cur_exp_value_number);
+ break;
+ case mp_unequal_operation:
+ b = number_nonzero(cur_exp_value_number);
+ break;
+ };
+ mp_set_cur_exp_value_boolean(mp, b ? mp_true_operation : mp_false_operation);
+ }
+ mp->cur_exp.type = mp_boolean_type;
+ DONE:
+ mp->arith_error = 0;
+ break;
+ case mp_and_operation:
+ case mp_or_operation:
+ if ((mp_type(p) != mp_boolean_type) || (mp->cur_exp.type != mp_boolean_type)) {
+ mp_bad_binary(mp, p, (int) c);
+ } else if (number_to_boolean(p->data.n) == c + mp_false_operation - mp_and_operation) {
+ mp_set_cur_exp_value_boolean(mp, number_to_boolean(p->data.n));
+ }
+ break;
+ case mp_times_operation:
+ if ((mp->cur_exp.type < mp_color_type) || (mp_type(p) < mp_color_type)) {
+ mp_bad_binary(mp, p, mp_times_operation);
+ } else if ((mp->cur_exp.type == mp_known_type) || (mp_type(p) == mp_known_type)) {
+ mp_number vv;
+ new_fraction(vv);
+ if (mp_type(p) == mp_known_type) {
+ number_clone(vv, mp_get_value_number(p));
+ mp_free_value_node(mp, p);
+ } else {
+ number_clone(vv, cur_exp_value_number);
+ mp_unstash_cur_exp(mp, p);
+ }
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, cur_exp_value_number, vv);
+ mp_set_cur_exp_value_number(mp, &ret);
+ free_number(ret);
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ }
+ break;
+ default:
+ {
+ mp_dep_mult(mp, NULL, &vv, 1);
+ }
+ break;
+ }
+ free_number(vv);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ } else if ((mp_nice_color_or_pair(mp, p, mp_type(p)) && (mp->cur_exp.type > mp_pair_type))
+ || (mp_nice_color_or_pair(mp, cur_exp_node, mp->cur_exp.type) && (mp_type(p) > mp_pair_type))) {
+ mp_hard_times(mp, p);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ } else {
+ mp_bad_binary(mp, p, mp_times_operation);
+ }
+ break;
+ case mp_over_operation:
+ if ((mp->cur_exp.type != mp_known_type) || (mp_type(p) < mp_color_type)) {
+ mp_bad_binary(mp, p, mp_over_operation);
+ } else {
+ mp_number v_n;
+ new_number_clone(v_n, cur_exp_value_number);
+ mp_unstash_cur_exp(mp, p);
+ if (number_zero(v_n)) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Division by zero",
+ "You're trying to divide the quantity shown above the error message by zero. I'm\n"
+ "going to divide it by one instead."
+ );
+ mp_get_x_next(mp);
+ } else {
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, cur_exp_value_number, v_n);
+ mp_set_cur_exp_value_number(mp, &ret);
+ free_number(ret);
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_dep_div(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &v_n);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_dep_div(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &v_n);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_dep_div(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &v_n);
+ }
+ break;
+ default:
+ {
+ mp_dep_div(mp, NULL, &v_n);
+ }
+ break;
+ }
+ }
+ free_number(v_n);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ }
+ break;
+ case mp_power_operation:
+ if ((mp->cur_exp.type == mp_known_type) && (mp_type(p) == mp_known_type)) {
+ mp_number r;
+ new_number(r);
+ power_of(r, mp_get_value_number(p), cur_exp_value_number);
+ check_arith();
+ mp_set_cur_exp_value_number(mp, &r);
+ free_number(r);
+ } else
+ mp_bad_binary(mp, p, (int) c);
+ break;
+ case mp_pythag_add_operation:
+ case mp_pythag_sub_operation:
+ if ((mp->cur_exp.type == mp_known_type) && (mp_type(p) == mp_known_type)) {
+ mp_number r;
+ new_number(r);
+ if (c == mp_pythag_add_operation) {
+ pyth_add(r, mp_get_value_number(p), cur_exp_value_number);
+ } else {
+ pyth_sub(r, mp_get_value_number(p), cur_exp_value_number);
+ }
+ mp_set_cur_exp_value_number(mp, &r);
+ free_number(r);
+ } else
+ mp_bad_binary(mp, p, (int) c);
+ break;
+ case mp_rotated_operation:
+ case mp_slanted_operation:
+ case mp_scaled_operation:
+ case mp_shifted_operation:
+ case mp_transformed_operation:
+ case mp_x_scaled_operation:
+ case mp_y_scaled_operation:
+ case mp_z_scaled_operation:
+ switch (mp_type(p)) {
+ case mp_path_type:
+ mp_set_up_known_trans(mp, (int) c);
+ mp_unstash_cur_exp(mp, p);
+ mp_do_path_trans(mp, cur_exp_knot);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ case mp_pen_type:
+ mp_set_up_known_trans(mp, (int) c);
+ mp_unstash_cur_exp(mp, p);
+ mp_do_pen_trans(mp, cur_exp_knot);
+ mp_set_cur_exp_knot(mp, mp_convex_hull(mp, cur_exp_knot));
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ case mp_nep_type:
+ mp_set_up_known_trans(mp, (int) c);
+ mp_unstash_cur_exp(mp, p);
+ mp_do_pen_trans(mp, cur_exp_knot);
+ mp_set_cur_exp_knot(mp, cur_exp_knot);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ case mp_pair_type:
+ case mp_transform_type:
+ mp_big_trans(mp, p, (int) c);
+ break;
+ case mp_picture_type:
+ mp_do_edges_trans(mp, p, (int) c);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ default:
+ mp_bad_binary(mp, p, (int) c);
+ break;
+ }
+ break;
+ case mp_concatenate_operation:
+ case mp_just_append_operation:
+ if ((mp->cur_exp.type == mp_string_type) && (mp_type(p) == mp_string_type)) {
+ mp_string str = mp_cat(mp, mp_get_value_str(p), cur_exp_str);
+ delete_str_ref(cur_exp_str) ;
+ mp_set_cur_exp_str(mp, str);
+ } else {
+ mp_bad_binary(mp, p, c);
+ }
+ break;
+ case mp_substring_operation:
+ if (mp_nice_pair(mp, p, mp_type(p)) && (mp->cur_exp.type == mp_string_type)) {
+ mp_string str = mp_chop_string (mp,
+ cur_exp_str,
+ round_unscaled(mp_get_value_number(mp_x_part(mp_get_value_node(p)))),
+ round_unscaled(mp_get_value_number(mp_y_part(mp_get_value_node(p))))
+ );
+ delete_str_ref(cur_exp_str) ;
+ mp_set_cur_exp_str(mp, str);
+ } else {
+ mp_bad_binary(mp, p, mp_substring_operation);
+ }
+ break;
+ case mp_subpath_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp_nice_pair(mp, p, mp_type(p)) && (mp->cur_exp.type == mp_path_type)) {
+ mp_chop_path(mp, mp_get_value_node(p));
+ } else {
+ mp_bad_binary(mp, p, mp_subpath_operation);
+ }
+ break;
+ case mp_point_operation:
+ case mp_precontrol_operation:
+ case mp_postcontrol_operation:
+ case mp_direction_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type)) {
+ mp_find_point(mp, &(mp_get_value_number(p)), (int) c);
+ } else {
+ mp_bad_binary(mp, p, c);
+ }
+ break;
+ case mp_pen_offset_operation:
+ if ((mp->cur_exp.type == mp_pen_type || mp->cur_exp.type == mp_nep_type) && mp_nice_pair(mp, p, mp_type(p))) {
+ mp_set_up_offset(mp, mp_get_value_node(p));
+ } else {
+ mp_bad_binary(mp, p, mp_pen_offset_operation);
+ }
+ break;
+ case mp_direction_time_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && mp_nice_pair(mp, p, mp_type(p))) {
+ mp_set_up_direction_time(mp, mp_get_value_node(p));
+ } else {
+ mp_bad_binary(mp, p, mp_direction_time_operation);
+ }
+ break;
+ case mp_envelope_operation:
+ if ((mp_type(p) != mp_pen_type && mp_type(p) != mp_nep_type) || (mp->cur_exp.type != mp_path_type)) {
+ mp_bad_binary(mp, p, mp_envelope_operation);
+ } else {
+ mp_set_up_envelope(mp, p);
+ }
+ break;
+ case mp_boundingpath_operation:
+ if ((mp_type(p) != mp_pen_type && mp_type(p) != mp_nep_type) || (mp->cur_exp.type != mp_path_type)) {
+ mp_bad_binary(mp, p, mp_boundingpath_operation);
+ } else {
+ mp_set_up_boundingpath(mp, p);
+ }
+ break;
+ case mp_arc_time_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type)) {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_arc_time(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(p)), 0);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_bad_binary(mp, p, (int) c);
+ }
+ break;
+ case mp_arc_point_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type || mp_type(p) == mp_pair_type)) {
+ mp_knot k;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (mp_type(p) == mp_pair_type) {
+ mp_knot f = cur_exp_knot;
+ mp_node q = mp_get_value_node(p);
+ mp_number x;
+ new_number_clone(x, mp_get_value_number(mp_x_part(q)));
+ if (number_greater(x, zero_t)) {
+ while (number_greater(x, zero_t)) {
+ f = mp_next_knot(f);
+ number_subtract(x, unity_t);
+ }
+ } else {
+ while (number_less(x, zero_t)) {
+ f = mp_next_knot(f);
+ number_add(x, unity_t);
+ }
+ }
+ k = mp_get_arc_time(mp, &new_expr.data.n, f, &(mp_get_value_number(mp_y_part(q))), 1);
+ free_number(x);
+ } else {
+ k = mp_get_arc_time(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(p)), 1);
+ }
+ if (k) {
+ int toss = 0;
+ if (number_equal(new_expr.data.n, unity_t)) {
+ k = mp_next_knot(k);
+ } else if (! number_equal(new_expr.data.n, zero_t)) {
+ convert_scaled_to_fraction(new_expr.data.n);
+ k = mp_split_cubic_knot(mp, k, &new_expr.data.n);
+ toss = 1;
+ }
+ mp_pair_value(mp, &(k->x_coord), &(k->y_coord));
+ if (toss) {
+ mp_toss_knot(mp, k);
+ }
+ } else {
+ mp_bad_unary(mp, mp_arc_point_operation);
+ }
+ } else {
+ mp_bad_unary(mp, mp_arc_point_operation);
+ }
+ break;
+ case mp_arc_point_list_operation:
+
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && mp_type(p) == mp_known_type) {
+
+ mp_knot cur = cur_exp_knot;
+ mp_number len, aln, seg, tot, tim, stp, acc, tmp;
+ mp_knot last = NULL;
+ mp_knot list = NULL;
+ int iscycle = mp_left_type(cur_exp_knot) == mp_explicit_knot;
+ new_number(len);
+ mp_path_length(mp, &len);
+ new_number(aln);
+ mp_get_arc_length(mp, &aln, cur_exp_knot);
+ new_number(seg);
+ new_number(tot);
+ new_number(tim);
+ new_number(stp);
+ set_number_from_div(stp, aln, mp_get_value_number(p));
+ new_number(acc);
+ mp_get_subarc_length(mp, &acc, cur_exp_knot, &zero_t, &unity_t);
+ new_number(tmp);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ list = mp_complex_knot(mp, cur_exp_knot);
+ mp_prev_knot(list) = list;
+ mp_next_knot(list) = list;
+ last = list;
+ number_clone(tot, stp);
+ while (number_lessequal(tot, aln)) {
+ mp_knot k;
+ while (1) {
+ if (number_lessequal(tot, acc)) {
+ break;
+ } else {
+ number_add(seg, unity_t);
+ number_clone(tim, acc);
+ cur = mp_next_knot(cur);
+ mp_get_subarc_length(mp, &tmp, cur, &zero_t, &unity_t);
+ number_add(acc, tmp) ;
+ }
+ }
+ number_clone(tmp, tot);
+ number_subtract(tmp, tim);
+ k = mp_get_arc_time(mp, &new_expr.data.n, cur, &tmp, 1);
+ if (k) {
+ int toss = 0;
+ mp_knot kk;
+ if (number_equal(new_expr.data.n, unity_t)) {
+ k = mp_next_knot(k);
+ } else if (! number_equal(new_expr.data.n, zero_t)) {
+ convert_scaled_to_fraction(new_expr.data.n);
+ k = mp_split_cubic_knot(mp, k, &new_expr.data.n);
+ toss = 1;
+ }
+ kk = mp_complex_knot(mp, k);
+ mp_prev_knot(list) = kk;
+ mp_next_knot(kk) = list;
+ mp_prev_knot(kk) = last;
+ mp_next_knot(last) = kk;
+ last = kk;
+ if (toss) {
+ mp_toss_knot(mp, k);
+ }
+ number_add(tot, stp);
+ } else {
+ break;
+ }
+ }
+ free_number(len);
+ free_number(aln);
+ free_number(seg);
+ free_number(tot);
+ free_number(tim);
+ free_number(stp);
+ free_number(acc);
+ free_number(tmp);
+ if (list) {
+ if (iscycle) {
+ mp_left_type(list) = mp_explicit_knot;
+ mp_right_type(last) = mp_explicit_knot;
+ } else {
+ mp_left_type(list) = mp_endpoint_knot;
+ mp_right_type(last) = mp_endpoint_knot;
+ }
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, list);
+ } else {
+ mp_bad_unary(mp, mp_arc_point_list_operation);
+ }
+ } else {
+ mp_bad_unary(mp, mp_arc_point_list_operation);
+ }
+ break;
+ case mp_subarc_length_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && mp_type(p) == mp_pair_type) {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_node q = mp_get_value_node(p);
+ mp_get_subarc_length(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(mp_x_part(q))), &(mp_get_value_number(mp_y_part(q))));
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_bad_unary(mp, mp_subarc_length_operation);
+ }
+ break;
+ case mp_intertimes_operation:
+ case mp_intertimes_list_operation:
+ if (mp_type(p) == mp_pair_type) {
+ mp_node q = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, p);
+ mp_pair_to_path(mp);
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, q);
+ }
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_path_type)) {
+ if (c == mp_intertimes_operation) {
+
+ mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 0, NULL);
+ mp_pair_value(mp, &mp->cur_t, &mp->cur_tt);
+ } else {
+ mp_knot last = NULL;
+ mp_knot list = mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 1, &last);
+ mp_left_type(list) = mp_endpoint_knot;
+ mp_right_type(last) = mp_endpoint_knot;
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, list);
+ }
+ } else {
+ mp_bad_binary(mp, p, c);
+ }
+ break;
+ }
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ mp_finish_binary(mp, old_p, old_exp);
+}
+
+static void mp_frac_mult (MP mp, mp_number *n, mp_number *d)
+{
+ mp_node old_exp;
+ mp_number v;
+ new_fraction(v);
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{(");
+ print_number(*n);
+ mp_print_chr(mp, '/');
+ print_number(*d);
+ mp_print_str(mp, ")*(");
+ mp_print_exp(mp, NULL, 0);
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+ }
+ switch (mp->cur_exp.type) {
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ old_exp = mp_tarnished(mp, cur_exp_node);
+ break;
+ case mp_independent_type:
+ old_exp = MP_VOID;
+ break;
+ default:
+ old_exp = NULL;
+ break;
+ }
+ if (old_exp != NULL) {
+ old_exp = cur_exp_node;
+ mp_make_exp_copy(mp, old_exp);
+ }
+ make_fraction(v, *n, *d);
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ mp_number r1, arg1;
+ new_fraction(r1);
+ new_number_clone(arg1, cur_exp_value_number);
+ take_fraction(r1, arg1, v);
+ mp_set_cur_exp_value_number(mp, &r1);
+ free_number(r1);
+ free_number(arg1);
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ }
+ break;
+ default:
+ {
+ mp_dep_mult(mp, NULL, &v, 0);
+ }
+ break;
+ }
+ if (old_exp != NULL) {
+ mp_recycle_value(mp, old_exp);
+ mp_free_value_node(mp, old_exp);
+ }
+ free_number(v);
+}
+
+static void worry_about_bad_statement (MP mp);
+
+static void flush_unparsable_junk_after_statement (MP mp);
+
+void mp_do_statement (MP mp)
+{
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ if (cur_cmd > mp_max_primary_command) {
+ worry_about_bad_statement(mp);
+ } else if (cur_cmd > mp_max_statement_command) {
+ mp_value new_expr;
+ mp->var_flag = mp_assignment_command;
+ mp_scan_expression(mp);
+ if (cur_cmd < mp_end_group_command) {
+ if (cur_cmd == mp_equals_command) {
+ mp_do_equation(mp);
+ } else if (cur_cmd == mp_assignment_command) {
+ mp_do_assignment(mp);
+ } else if (mp->cur_exp.type == mp_string_type) {
+ if (number_positive(internal_value(mp_tracing_titles_internal))) {
+ mp_print_nl(mp, "");
+ mp_print_mp_str(mp, cur_exp_str);
+ update_terminal();
+ }
+ } else if (mp->cur_exp.type != mp_vacuous_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Isolated expression",
+ "I couldn't find an '=' or ':=' after the expression that is shown above this\n"
+ "error message, so I guess I'll just ignore it and carry on."
+ );
+ mp_get_x_next(mp);
+ }
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ } else {
+ if (number_positive(internal_value(mp_tracing_commands_internal))) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ switch (cur_cmd) {
+ case mp_type_name_command:
+ mp_do_type_declaration(mp);
+ break;
+ case mp_macro_def_command:
+ switch (cur_mod) {
+ case mp_def_code:
+ case mp_var_def_code:
+ mp_scan_def(mp, cur_mod);
+ break;
+ case mp_primary_def_code:
+ case mp_secondary_def_code:
+ case mp_tertiary_def_code:
+ mp_make_op_def(mp, cur_mod);
+ break;
+ }
+ break;
+ case mp_only_set_command:
+ switch (cur_mod) {
+ case mp_random_seed_code:
+ mp_do_random_seed(mp);
+ break;
+ case mp_max_knot_pool_code:
+ mp_do_max_knot_pool(mp);
+ break;
+ }
+ break;
+ case mp_mode_command:
+ mp_print_ln(mp);
+ mp->interaction = cur_mod;
+ mp->selector = mp->interaction == mp_batch_mode ? mp_log_only_selector : mp_term_and_log_selector;
+ mp_get_x_next(mp);
+ break;
+ case mp_protection_command:
+ mp_do_protection(mp);
+ break;
+ case mp_property_command:
+ mp_do_property(mp);
+ break;
+ case mp_delimiters_command:
+ mp_def_delims(mp);
+ break;
+ case mp_save_command:
+ do {
+ mp_get_symbol(mp);
+ mp_save_variable(mp, cur_sym);
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+ break;
+ case mp_interim_command:
+ mp_do_interim(mp);
+ break;
+ case mp_let_command:
+ mp_do_let(mp);
+ break;
+ case mp_new_internal_command:
+ mp_do_new_internal(mp);
+ break;
+ case mp_show_command:
+ mp_do_show_whatever(mp);
+ break;
+ case mp_add_to_command:
+ mp_do_add_to(mp);
+ break;
+ case mp_bounds_command:
+ mp_do_bounds(mp);
+ break;
+ case mp_ship_out_command:
+ mp_do_ship_out(mp);
+ break;
+ case mp_every_job_command:
+ mp_get_symbol(mp);
+ mp->every_job_sym = cur_sym;
+ mp_get_x_next(mp);
+ break;
+ case mp_message_command:
+ mp_do_message(mp);
+ break;
+ case mp_write_command:
+ mp_do_write(mp);
+ break;
+ default:
+ break;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ if (cur_cmd < mp_semicolon_command) {
+ flush_unparsable_junk_after_statement(mp);
+ }
+ mp->error_count = 0;
+}
+
+static void worry_about_bad_statement (MP mp)
+{
+ if (cur_cmd < mp_semicolon_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_cmd_mod(mp, cur_cmd, cur_mod);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "A statement can't begin with '%s'", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_back_error(
+ mp,
+ msg,
+ "I was looking for the beginning of a new statement. If you just proceed without\n"
+ "changing anything, I'll ignore everything up to the next ';'."
+ );
+ mp_get_x_next(mp);
+ }
+}
+
+static void flush_unparsable_junk_after_statement (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Extra tokens will be flushed",
+ "I've just read as much of that statement as I could fathom, so a semicolon should\n"
+ "have been next. It's very puzzling ... but I'll try to get myself back together,\n"
+ "by ignoring everything up to the next ';'."
+ );
+ mp->scanner_status = mp_flushing_state;
+ do {
+ get_t_next(mp);
+ if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+ }
+ } while (! mp_end_of_statement);
+ mp->scanner_status = mp_normal_state;
+}
+
+static void trace_equation (MP mp, mp_node lhs)
+{
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{(");
+ mp_print_exp(mp, lhs, 0);
+ mp_print_str(mp, ")=(");
+ mp_print_exp(mp, NULL, 0);
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+}
+
+void mp_do_equation (MP mp)
+{
+ mp_node lhs = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp->var_flag = mp_assignment_command;
+ mp_scan_expression(mp);
+ if (cur_cmd == mp_equals_command) {
+ mp_do_equation(mp);
+ } else if (cur_cmd == mp_assignment_command) {
+ mp_do_assignment(mp);
+ }
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ trace_equation(mp, lhs);
+ }
+ if (mp->cur_exp.type == mp_unknown_path_type) {
+ if (mp_type(lhs) == mp_pair_type) {
+ mp_node p;
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, lhs);
+ lhs = p;
+ }
+ }
+ mp_make_eq(mp, lhs);
+}
+
+static void bad_lhs (MP mp)
+{
+ mp_disp_err(mp, NULL);
+ mp_error(
+ mp,
+ "Improper ':=' will be changed to '='",
+ "I didn't find a variable name at the left of the ':=', so I'm going to pretend\n"
+ "that you said '=' instead."
+ );
+ mp_do_equation(mp);
+}
+
+static void bad_internal_assignment (MP mp, mp_node lhs)
+{
+ char msg[256];
+ mp_disp_err(mp, NULL);
+ if (internal_type(mp_get_sym_info(lhs)) == mp_known_type) {
+ mp_snprintf(msg, 256,
+ "Internal quantity '%s' must receive a known numeric value",
+ internal_name(mp_get_sym_info(lhs))
+ );
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything but a known numeric value, so I'll\n"
+ "have to ignore this assignment."
+ );
+ } else if (internal_type(mp_get_sym_info(lhs)) == mp_boolean_type) {
+ mp_snprintf(msg, 256,
+ "Internal quantity '%s' must receive a known boolean value",
+ internal_name(mp_get_sym_info(lhs))
+ );
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything but a known boolean value, so I'll\n"
+ "have to ignore this assignment."
+ );
+ } else {
+ mp_snprintf(msg, 256,
+ "Internal quantity '%s' must receive a known string",
+ internal_name(mp_get_sym_info(lhs))
+ );
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything but a known string value, so I'll\n"
+ "have to ignore this assignment."
+ );
+ }
+ mp_get_x_next(mp);
+}
+
+static void forbidden_internal_assignment (MP mp, mp_node lhs)
+{
+ char msg[256];
+ mp_snprintf(msg, 256,"Internal quantity '%s' is read-only", internal_name(mp_get_sym_info(lhs)));
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything just yet (it is read-only), so\n"
+ "I'll have to ignore this assignment."
+ );
+ mp_get_x_next(mp);
+}
+
+static void bad_internal_assignment_precision (MP mp, mp_node lhs, mp_number *min, mp_number *max)
+{
+ char msg[256];
+ char hlp[256];
+ mp_snprintf(msg, 256,
+ "Bad '%s' has been ignored",
+ internal_name(mp_get_sym_info(lhs)));
+ mp_snprintf(hlp, 256,
+ "Precision values are limited by the current numbersystem.\n"
+ "Currently I am using '%s'; the allowed precision range is [%s,%s].",
+ mp_str(mp, internal_string(mp_number_system_internal)), number_tostring(*min), number_tostring(*max));
+ mp_back_error(mp, msg, hlp);
+ mp_get_x_next(mp);
+}
+
+static void bad_expression_assignment (MP mp, mp_node lhs)
+{
+ char *msg = mp_obliterated(mp, lhs);
+ mp_back_error(
+ mp,
+ msg,
+ "It seems you did a nasty thing --- probably by accident, but nevertheless you\n"
+ "nearly hornswoggled me ... While I was evaluating the right-hand side of this\n"
+ "command, something happened, and the left-hand side is no longer a variable! So I\n"
+ "won't change anything."
+ );
+ mp_memory_free(msg);
+ mp_get_x_next(mp);
+}
+
+static void trace_assignment (MP mp, mp_node lhs)
+{
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{");
+ if (mp_name_type(lhs) == mp_internal_operation) {
+ mp_print_str(mp, internal_name(mp_get_sym_info(lhs)));
+ } else {
+ mp_show_token_list(mp, lhs, NULL);
+ }
+ mp_print_str(mp, ":=");
+ mp_print_exp(mp, NULL, 0);
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+}
+
+void mp_do_assignment (MP mp)
+{
+ if (mp->cur_exp.type != mp_token_list_type) {
+ bad_lhs(mp);
+ } else {
+ mp_node lhs = cur_exp_node;
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ mp->var_flag = mp_assignment_command;
+ mp_scan_expression(mp);
+ if (cur_cmd == mp_equals_command) {
+ mp_do_equation(mp);
+ } else if (cur_cmd == mp_assignment_command) {
+ mp_do_assignment(mp);
+ }
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ trace_assignment (mp, lhs);
+ }
+ if (mp_name_type(lhs) == mp_internal_operation) {
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ case mp_string_type:
+ case mp_boolean_type:
+ if (internal_type(mp_get_sym_info(lhs)) == mp->cur_exp.type) {
+ switch (mp_get_sym_info(lhs)) {
+ case mp_number_system_internal:
+ forbidden_internal_assignment(mp, lhs);
+ break;
+
+ case mp_number_precision_internal:
+ if (mp->cur_exp.type == mp_known_type
+ && (! number_less (cur_exp_value_number, precision_min))
+ && (! number_greater(cur_exp_value_number, precision_max))
+ ) {
+ if (internal_type(mp_get_sym_info(lhs)) == mp_string_type) {
+ add_str_ref(cur_exp_str);
+ set_internal_string(mp_get_sym_info(lhs), cur_exp_str);
+ } else {
+ number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number);
+ }
+ set_precision();
+ } else {
+ bad_internal_assignment_precision(mp, lhs, &precision_min, &precision_max);
+ }
+ default:
+ if (internal_type(mp_get_sym_info(lhs)) == mp_string_type) {
+ add_str_ref(cur_exp_str);
+ set_internal_string(mp_get_sym_info(lhs), cur_exp_str);
+ } else {
+ number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number);
+ }
+ break;
+ }
+ } else {
+ bad_internal_assignment(mp, lhs);
+ }
+ break;
+ default:
+ bad_internal_assignment(mp, lhs);
+ }
+ } else {
+ mp_node p = mp_find_variable(mp, lhs);
+ if (p != NULL) {
+ mp_node q = mp_stash_cur_exp(mp);
+ mp->cur_exp.type = mp_und_type(mp, p);
+ mp_recycle_value(mp, p);
+ mp_type(p) = mp->cur_exp.type;
+ mp_set_value_number(p, zero_t);
+ mp_make_exp_copy(mp, p);
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, q);
+ mp_make_eq(mp, p);
+ } else {
+ bad_expression_assignment(mp, lhs);
+ }
+ }
+ mp_flush_node_list(mp, lhs);
+ }
+}
+
+static void announce_bad_equation (MP mp, mp_node lhs)
+{
+ char msg[256];
+ mp_snprintf(msg, 256,
+ "Equation cannot be performed (%s=%s)",
+ (mp_type(lhs) <= mp_pair_type ? mp_type_string(mp_type(lhs)) : "numeric"),
+ (mp->cur_exp.type <= mp_pair_type ? mp_type_string(mp->cur_exp.type) : "numeric"));
+ mp_disp_err(mp, lhs);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ msg,
+ "I'm sorry, but I don't know how to make such things equal. (See the two\n"
+ "expressions just above the error message.)"
+ );
+ mp_get_x_next(mp);
+}
+
+static void mp_exclaim_inconsistent_equation (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Inconsistent equation",
+ "The equation I just read contradicts what was said before. But don't worry;\n"
+ "continue and I'll just ignore it."
+ );
+ mp_get_x_next(mp);
+}
+
+static void mp_exclaim_redundant_or_inconsistent_equation (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Redundant or inconsistent equation",
+ "An equation between already-known quantities can't help. But don't worry;\n"
+ "continue and I'll just ignore it."
+ );
+ mp_get_x_next(mp);
+}
+
+static void report_redundant_or_inconsistent_equation (MP mp, mp_node lhs, mp_number *v)
+{
+ if (mp->cur_exp.type <= mp_string_type) {
+ if (mp->cur_exp.type == mp_string_type) {
+ if (mp_str_vs_str(mp, mp_get_value_str(lhs), cur_exp_str) != 0) {
+ mp_exclaim_inconsistent_equation(mp);
+ } else {
+ mp_exclaim_redundant_equation(mp);
+ }
+ } else if (number_equal(*v, cur_exp_value_number)) {
+ mp_exclaim_redundant_equation(mp);
+ } else {
+ mp_exclaim_inconsistent_equation(mp);
+ }
+ } else {
+ mp_exclaim_redundant_or_inconsistent_equation(mp);
+ }
+}
+
+void mp_make_eq (MP mp, mp_node lhs)
+{
+ mp_value new_expr;
+ mp_variable_type t;
+ mp_number v;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(v);
+ RESTART:
+ t = mp_type(lhs);
+ if (t <= mp_pair_type) {
+ number_clone(v, mp_get_value_number(lhs));
+ }
+ switch (t) {
+ case mp_boolean_type:
+ case mp_string_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ if (mp->cur_exp.type == t + unknown_tag) {
+ new_number(new_expr.data.n);
+ switch (t) {
+ case mp_boolean_type:
+ number_clone(new_expr.data.n, v);
+ break;
+ case mp_string_type:
+ new_expr.data.str = mp_get_value_str(lhs);
+ break;
+ case mp_picture_type:
+ new_expr.data.node = mp_get_value_node(lhs);
+ break;
+ default:
+ new_expr.data.p = mp_get_value_knot(lhs);
+ break;
+ }
+ mp_nonlinear_eq(mp, new_expr, cur_exp_node, 0);
+ mp_unstash_cur_exp(mp, cur_exp_node);
+ } else if (mp->cur_exp.type == t) {
+ report_redundant_or_inconsistent_equation(mp, lhs, &v);
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ if (mp->cur_exp.type == t - unknown_tag) {
+ mp_nonlinear_eq(mp, mp->cur_exp, lhs, 1);
+ } else if (mp->cur_exp.type == t) {
+ mp_ring_merge (mp, lhs, cur_exp_node);
+ } else if (mp->cur_exp.type == mp_pair_type) {
+ if (t == mp_unknown_path_type) {
+ mp_pair_to_path(mp);
+ goto RESTART;
+ }
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ if (mp->cur_exp.type == t) {
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_node p = mp_get_value_node(lhs);
+ switch (t) {
+ case mp_transform_type:
+ mp_try_eq(mp, mp_yy_part(p), mp_yy_part(q));
+ mp_try_eq(mp, mp_yx_part(p), mp_yx_part(q));
+ mp_try_eq(mp, mp_xy_part(p), mp_xy_part(q));
+ mp_try_eq(mp, mp_xx_part(p), mp_xx_part(q));
+ mp_try_eq(mp, mp_ty_part(p), mp_ty_part(q));
+ mp_try_eq(mp, mp_tx_part(p), mp_tx_part(q));
+ break;
+ case mp_color_type:
+ mp_try_eq(mp, mp_blue_part(p), mp_blue_part(q));
+ mp_try_eq(mp, mp_green_part(p), mp_green_part(q));
+ mp_try_eq(mp, mp_red_part(p), mp_red_part(q));
+ break;
+ case mp_cmykcolor_type:
+ mp_try_eq(mp, mp_black_part(p), mp_black_part(q));
+ mp_try_eq(mp, mp_yellow_part(p), mp_yellow_part(q));
+ mp_try_eq(mp, mp_magenta_part(p), mp_magenta_part(q));
+ mp_try_eq(mp, mp_cyan_part(p), mp_cyan_part(q));
+ break;
+ case mp_pair_type:
+ mp_try_eq(mp, mp_y_part(p), mp_y_part(q));
+ mp_try_eq(mp, mp_x_part(p), mp_x_part(q));
+ break;
+ default:
+ break;
+ }
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_known_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ if (mp->cur_exp.type >= mp_known_type) {
+ mp_try_eq(mp, lhs, NULL);
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_vacuous_type:
+ announce_bad_equation(mp, lhs);
+ break;
+ default:
+ announce_bad_equation(mp, lhs);
+ break;
+ }
+ check_arith();
+ mp_recycle_value(mp, lhs);
+ free_number(v);
+ mp_free_value_node(mp, lhs);
+}
+
+static void deal_with_redundant_or_inconsistent_equation (MP mp, mp_value_node p, mp_node r)
+{
+ mp_number absp;
+ new_number_abs(absp, mp_get_value_number(p));
+ if (number_greater(absp, equation_threshold_k)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Inconsistent equation (off by %s)", number_tostring (mp_get_value_number(p)));
+ mp_back_error(
+ mp,
+ msg,
+ "The equation I just read contradicts what was said before. But don't worry;\n"
+ "continue and I'll just ignore it."
+ );
+ mp_get_x_next(mp);
+ } else if (r == NULL) {
+ mp_exclaim_redundant_equation(mp);
+ }
+ free_number(absp);
+ mp_free_dep_node(mp, p);
+}
+
+void mp_try_eq (MP mp, mp_node l, mp_node r)
+{
+ mp_value_node p;
+ mp_value_node q;
+ mp_value_node pp;
+ mp_variable_type tt;
+ int copied;
+ mp_variable_type t = mp_type(l);
+ switch (t) {
+ case mp_known_type:
+ {
+ mp_number arg1;
+ new_number(arg1);
+ number_negated_clone(arg1, mp_get_value_number(l));
+ t = mp_dependent_type;
+ p = mp_const_dependency(mp, &arg1);
+ q = p;
+ free_number(arg1);
+ }
+ break;
+ case mp_independent_type:
+ {
+ t = mp_dependent_type;
+ p = mp_single_dependency(mp, l);
+ number_negate(mp_get_dep_value(p));
+ q = mp->dep_final;
+ }
+ break;
+ default:
+ {
+ mp_value_node ll = (mp_value_node) l;
+ p = (mp_value_node) mp_get_dep_list(ll);
+ q = p;
+ while (1) {
+ number_negate(mp_get_dep_value(q));
+ if (mp_get_dep_info(q) == NULL) {
+ break;
+ } else {
+ q = (mp_value_node) mp_link(q);
+ }
+ }
+ mp_link(mp_get_prev_dep(ll)) = mp_link(q);
+ mp_set_prev_dep((mp_value_node) mp_link(q), mp_get_prev_dep(ll));
+ mp_type(ll) = mp_known_type;
+ }
+ break;
+ }
+ if (r == NULL) {
+ if (mp->cur_exp.type == mp_known_type) {
+ number_add(mp_get_value_number(q), cur_exp_value_number);
+ goto DONE1;
+ } else {
+ tt = mp->cur_exp.type;
+ if (tt == mp_independent_type) {
+ pp = mp_single_dependency(mp, cur_exp_node);
+ } else {
+ pp = (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node);
+ }
+ }
+ } else if (mp_type(r) == mp_known_type) {
+ number_add(mp_get_dep_value(q), mp_get_value_number(r));
+ goto DONE1;
+ } else {
+ tt = mp_type(r);
+ if (tt == mp_independent_type) {
+ pp = mp_single_dependency(mp, r);
+ } else {
+ pp = (mp_value_node) mp_get_dep_list((mp_value_node) r);
+ }
+ }
+ if (tt != mp_independent_type) {
+ copied = 0;
+ } else {
+ copied = 1;
+ tt = mp_dependent_type;
+ }
+ mp->watch_coefs = 0;
+ if (t == tt) {
+ p = mp_p_plus_q(mp, p, pp, (int) t);
+ } else if (t == mp_proto_dependent_type) {
+ p = mp_p_plus_fq(mp, p, &unity_t, pp, mp_proto_dependent_type, mp_dependent_type);
+ } else {
+ mp_number x;
+ new_number(x);
+ q = p;
+ while (mp_get_dep_info(q) != NULL) {
+ number_clone(x, mp_get_dep_value(q));
+ fraction_to_round_scaled(x);
+ mp_set_dep_value(q, x);
+ q = (mp_value_node) mp_link(q);
+ }
+ free_number(x);
+ t = mp_proto_dependent_type;
+ p = mp_p_plus_q(mp, p, pp, (int) t);
+ }
+ mp->watch_coefs = 1;
+ if (copied) {
+ mp_flush_node_list(mp, (mp_node) pp);
+ }
+ DONE1:
+ if (mp_get_dep_info(p) == NULL) {
+ deal_with_redundant_or_inconsistent_equation(mp, p, r);
+ } else {
+ mp_linear_eq(mp, p, (int) t);
+ if (r == NULL && mp->cur_exp.type != mp_known_type && mp_type(cur_exp_node) == mp_known_type) {
+ mp_node pp = cur_exp_node;
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(pp)));
+ mp->cur_exp.type = mp_known_type;
+ mp_free_value_node(mp, pp);
+ }
+ }
+}
+
+mp_node mp_scan_declared_variable (MP mp)
+{
+ mp_sym x;
+ mp_node h, t;
+ mp_get_symbol(mp);
+ x = cur_sym;
+ if (cur_cmd != mp_tag_command) {
+ mp_clear_symbol(mp, x, 0);
+ }
+ h = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(h, x);
+ t = h;
+ while (1) {
+ mp_get_x_next(mp);
+ if (cur_sym == NULL) {
+ break;
+ } else if (cur_cmd != mp_tag_command) {
+ if (cur_cmd != mp_internal_command) {
+ if (cur_cmd == mp_left_bracket_command) {
+ mp_sym ll = cur_sym;
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_right_bracket_command) {
+ set_cur_sym(mp_collective_subscript);
+ } else {
+ mp_back_input(mp);
+ set_cur_sym(ll);
+ set_cur_cmd(mp_left_bracket_command);
+ break;
+ }
+ } else {
+ break;
+ }
+ }
+ }
+ mp_link(t) = mp_new_symbolic_node(mp);
+ t = mp_link(t);
+ mp_set_sym_sym(t, cur_sym);
+ mp_name_type(t) = cur_sym_mod;
+ }
+ if (eq_property(x) != 0) {
+ mp_check_overload(mp, x);
+ }
+ if (eq_type(x) != mp_tag_command) {
+ mp_clear_symbol(mp, x, 0);
+ }
+ if (equiv_node(x) == NULL) {
+ mp_new_root (mp, x);
+ }
+ return h;
+}
+
+static void flush_spurious_symbols_after_declared_variable (MP mp);
+
+void mp_do_type_declaration (MP mp)
+{
+ int t = mp_numeric_type;
+ switch (cur_mod) {
+ case mp_string_type_operation: t = mp_unknown_string_type; break;
+ case mp_boolean_type_operation: t = mp_unknown_boolean_type; break;
+ case mp_path_type_operation: t = mp_unknown_path_type; break;
+ case mp_pen_type_operation: t = mp_unknown_pen_type; break;
+ case mp_nep_type_operation: t = mp_unknown_nep_type; break;
+ case mp_picture_type_operation: t = mp_unknown_picture_type; break;
+ case mp_transform_type_operation: t = mp_transform_type; break;
+ case mp_color_type_operation: t = mp_color_type; break;
+ case mp_cmykcolor_type_operation: t = mp_cmykcolor_type; break;
+ case mp_pair_type_operation: t = mp_pair_type; break;
+ case mp_numeric_type_operation: t = mp_numeric_type; break;
+ }
+ do {
+ mp_node p = mp_scan_declared_variable(mp);
+ mp_node q;
+ mp_flush_variable(mp, equiv_node(mp_get_sym_sym(p)), mp_link(p), 0);
+ q = mp_find_variable(mp, p);
+ if (q != NULL) {
+ mp_type(q) = t;
+ mp_set_value_number(q, zero_t);
+ } else {
+ mp_back_error(
+ mp,
+ "Declared variable conflicts with previous vardef",
+ "You can't use, e.g., 'numeric foo[]' after 'vardef foo'. Proceed, and I'll ignore\n"
+ "the illegal redeclaration."
+ );
+ mp_get_x_next(mp);
+ }
+ mp_flush_node_list(mp, p);
+ if (cur_cmd < mp_comma_command) {
+ flush_spurious_symbols_after_declared_variable(mp);
+ }
+ } while (! mp_end_of_statement);
+}
+
+static void flush_spurious_symbols_after_declared_variable (MP mp)
+{
+ const char *hlp = NULL;
+ if (cur_cmd == mp_numeric_command) {
+ hlp =
+ "Variables in declarations must consist entirely of names and explicit subscripts\n"
+ "like 'x15a' aren't permitted. I'm going to discard the junk I found here, up to the\n"
+ "next comma or the end of the declaration.";
+ } else {
+ hlp =
+ "Variables in declarations must consist entirely of names and collective\n"
+ "subscripts, e.g., 'x[]a'. Are you trying to use a reserved word in a variable\n"
+ "name? I'm going to discard the junk I found here, up to the next comma or the end\n"
+ "of the declaration.";
+ }
+ mp_back_error(
+ mp,
+ "Illegal suffix of declared variable will be flushed",
+ hlp
+ );
+ mp_get_x_next(mp);
+ mp->scanner_status = mp_flushing_state;
+ do {
+ get_t_next(mp);
+ if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+ }
+ } while (cur_cmd < mp_comma_command);
+ mp->scanner_status = mp_normal_state;
+}
+
+static void mp_main_control (MP mp) {
+ do {
+ mp_do_statement(mp);
+ if (cur_cmd == mp_end_group_command) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_error(
+ mp,
+ "Extra 'endgroup'",
+ "I'm not currently working on a 'begingroup', so I had better not try to end\n"
+ "anything."
+ );
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ } while (cur_cmd != mp_stop_command);
+}
+
+int mp_run (MP mp)
+{
+ if (mp->history < mp_fatal_error_stop) {
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) {
+ return mp->history;
+ }
+ mp_main_control(mp);
+ mp_final_cleanup(mp);
+ mp_close_files_and_terminate(mp);
+ }
+ return mp->history;
+}
+
+void mp_set_internal (MP mp, char *n, char *v, int isstring)
+{
+ size_t l = strlen(n);
+ char err[256];
+ const char *errid = NULL;
+ if (l > 0) {
+ mp_sym p = mp_id_lookup(mp, n, l, 0);
+ if (p == NULL) {
+ errid = "variable does not exist";
+ } else if (eq_type(p) != mp_internal_command) {
+ errid = "variable is not an internal";
+ } else if ((internal_type(equiv(p)) == mp_string_type) && (isstring)) {
+ set_internal_string(equiv(p), mp_rts(mp, v));
+ } else if ((internal_type(equiv(p)) == mp_known_type) && (! isstring)) {
+ int test = atoi(v);
+ if (test > 16383 && mp->math_mode == mp_math_scaled_mode) {
+ errid = "value is too large";
+ } else if (test < -16383 && mp->math_mode == mp_math_scaled_mode) {
+ errid = "value is too small";
+ } else {
+ number_clone(internal_value(equiv(p)), unity_t);
+ number_multiply_int(internal_value(equiv(p)), test);
+ }
+ } else {
+ errid = "value has the wrong type";
+ }
+ }
+ if (errid != NULL) {
+ if (isstring) {
+ mp_snprintf(err, 256, "%s=\"%s\": %s, assignment ignored.", n, v, errid);
+ } else {
+ mp_snprintf(err, 256, "%s=%d: %s, assignment ignored.", n, atoi (v), errid);
+ }
+ mp_warn(mp, err);
+ }
+}
+
+void mplib_shipout_backend (MP mp, void *voidh)
+{
+ mp_edge_header_node h = (mp_edge_header_node) voidh;
+ mp_edge_object *hh = mp_gr_export (mp, h);
+ if (hh) {
+ mp_run_data *run = mp_rundata(mp);
+ if (run->edges == NULL) {
+ run->edges = hh;
+ } else {
+ mp_edge_object *p = run->edges;
+ while (p->next != NULL) {
+ p = p->next;
+ }
+ p->next = hh;
+ }
+ }
+}
+
+mp_run_data *mp_rundata (MP mp) {
+ return &(mp->run_data);
+}
+
+int mp_execute (MP mp, const char *s, size_t l)
+{
+ (void) l;
+ if (mp->finished) {
+ return mp->history;
+ } else if (mp->history < mp_fatal_error_stop) {
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) {
+ return mp->history;
+ } else {
+ mp->term_offset = 0;
+ mp->file_offset = 0;
+ if (mp->term_in == NULL) {
+ mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal);
+ mp->last = 0;
+ }
+ if (s && l > 0) {
+ (mp->write_file)(mp, mp->term_in, s);
+ } else {
+ }
+ if (mp->run_state == 0) {
+
+ mp->term_offset = 0;
+ mp->file_offset = 0;
+ mp_log_string(mp_term_logging_target, mp->banner);
+ mp_log_string(mp_term_logging_target, ", running in ");
+ mp_log_string(mp_term_logging_target, mp_str(mp, internal_string(mp_number_system_internal)));
+ mp_log_string(mp_term_logging_target, " mode.");
+ mp_print_ln(mp);
+ update_terminal();
+
+ mp->input_ptr = 0;
+ mp->max_in_stack = mp_file_bottom_text;
+ mp->in_open = mp_file_bottom_text;
+ mp->open_parens = 0;
+ mp->max_buf_stack = 0;
+ mp->param_ptr = 0;
+ mp->max_param_stack = 0;
+ start = loc = 0;
+ iindex = mp_file_bottom_text;
+ nloc = nstart = NULL;
+ mp->first = 0;
+ line = 0;
+ name = is_term;
+ mp->force_eof = 0;
+ if (mp->term_in == NULL) {
+ mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal);
+ }
+ mp->last = 0;
+ mp->scanner_status = mp_normal_state;
+ mp_fix_date_and_time(mp);
+ if (mp->random_seed == 0) {
+ mp->random_seed = (number_to_scaled(internal_value(mp_time_internal))/number_to_scaled(unity_t))
+ + number_to_scaled(internal_value(mp_day_internal));
+ }
+ init_randoms(mp->random_seed);
+ mp->selector = mp->interaction == mp_batch_mode ? mp_no_print_selector : mp_term_only_selector;
+ mp->history = mp_spotless;
+ if (mp->every_job_sym != NULL) {
+ set_cur_sym(mp->every_job_sym);
+ mp_back_input(mp);
+ }
+ }
+ mp->run_state = 1;
+ mp_input_ln(mp, mp->term_in);
+ mp_firm_up_the_line(mp);
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ do {
+ mp_do_statement(mp);
+ } while (cur_cmd != mp_stop_command);
+ mp_final_cleanup(mp);
+ mp_close_files_and_terminate(mp);
+ }
+ }
+ return mp->history;
+}
+
+int mp_finish (MP mp)
+{
+ int history = 0;
+ if (mp->finished || mp->history >= mp_fatal_error_stop) {
+ history = mp->history;
+ mp_free(mp);
+ } else {
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) {
+ history = mp->history;
+ } else {
+ history = mp->history;
+ mp_final_cleanup(mp);
+ }
+ mp_close_files_and_terminate(mp);
+ mp_free(mp);
+ }
+ return history;
+}
+
+char *mp_metapost_version(void) {
+ return mp_strdup(metapost_version);
+}
+
+void mp_do_max_knot_pool (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing ':=' has been inserted",
+ "Always say 'maxknotpool := <numeric expression>'."
+ );
+ };
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Unknown value will be ignored",
+ "Your expression was too random for me to handle, so I won't change the maximum\n"
+ "seed just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ int p = (int) number_to_scaled (cur_exp_value_number) / 65536;
+ if (p > mp->max_knot_nodes) {
+ mp->max_knot_nodes = p;
+ } else if (p > max_num_knot_nodes) {
+ } else {
+ }
+ }
+}
+
+void mp_do_random_seed (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing ':=' has been inserted",
+ "Always say 'randomseed := <numeric expression>'."
+ );
+ };
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Unknown value will be ignored",
+ "Your expression was too random for me to handle, so I won't change the random\n"
+ "seed just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ init_randoms(number_to_scaled(cur_exp_value_number));
+ if (mp->interaction < mp_silent_mode && (mp->selector == mp_log_only_selector || mp->selector == mp_term_and_log_selector)) {
+ int selector = mp->selector;
+ mp->selector = mp_log_only_selector;
+ mp_print_nl(mp, "{randomseed:=");
+ print_number(cur_exp_value_number);
+ mp_print_chr(mp, '}');
+ mp_print_nl(mp, "");
+ mp->selector = selector;
+ }
+ }
+}
+
+void mp_do_protection (MP mp)
+{
+
+ do {
+
+ mp_get_symbol(mp);
+
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+void mp_do_property (MP mp)
+{
+ int p = 0;
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ switch (mp->cur_exp.type) {
+ case mp_numeric_type:
+ case mp_known_type:
+ {
+ mp_back_input(mp);
+ p = (int) number_to_scaled (cur_exp_value_number) / 65536;
+ }
+ break;
+ default:
+ mp_back_error(mp, "Bad property value", NULL);
+ break;
+ }
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_colon_command) {
+ do {
+ mp_get_symbol(mp);
+ set_eq_property(cur_sym, p);
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+ } else {
+ mp_back_error(mp, "Bad property specification, colon expected", NULL);
+ }
+}
+
+void mp_def_delims (MP mp)
+{
+ mp_sym l_delim, r_delim;
+ mp_get_clear_symbol(mp);
+ l_delim = cur_sym;
+ mp_get_clear_symbol(mp);
+ r_delim = cur_sym;
+ set_eq_type(l_delim, mp_left_delimiter_command);
+ set_equiv_sym(l_delim, r_delim);
+ set_eq_type(r_delim, mp_right_delimiter_command);
+ set_equiv_sym(r_delim, l_delim);
+ mp_get_x_next(mp);
+}
+
+void mp_check_delimiter (MP mp, mp_sym l_delim, mp_sym r_delim)
+{
+ if (cur_cmd == mp_right_delimiter_command && equiv_sym(cur_sym) == l_delim) {
+ return;
+ } else if (cur_sym != r_delim) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim)));
+ mp_back_error(
+ mp,
+ msg,
+ "I found no right delimiter to match a left one. So I've put one in, behind the\n"
+ "scenes; this may fix the problem."
+ );
+ } else {
+ char msg[256];
+ mp_snprintf(msg, 256, "The token '%s' is no longer a right delimiter", mp_str(mp, text(r_delim)));
+ mp_error(
+ mp,
+ msg,
+ "Strange: This token has lost its former meaning! I'll read it as a right\n"
+ "delimiter this time; but watch out, I'll probably miss it later."
+ );
+ }
+}
+
+void mp_do_interim (MP mp) {
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_internal_command) {
+ char msg[256];
+ mp_snprintf(msg, 256,
+ "The token '%s' isn't an internal quantity",
+ (cur_sym == NULL ? "(%CAPSULE)" : mp_str(mp, text(cur_sym)))
+ );
+ mp_back_error(mp, msg, "Something like 'tracingonline' should follow 'interim'.");
+ } else {
+ mp_save_internal(mp, cur_mod);
+ mp_back_input(mp);
+ }
+ mp_do_statement(mp);
+}
+
+void mp_do_let (MP mp)
+{
+ mp_sym l;
+ mp_get_symbol(mp);
+ l = cur_sym;
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_equals_command && cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing '=' has been inserted",
+ "You should have said 'let symbol = something'. But don't worry; I'll pretend that\n"
+ "an equals sign was present. The next token I read will be 'something'."
+ );
+ }
+ mp_get_symbol(mp);
+ switch (cur_cmd) {
+ case mp_defined_macro_command:
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ mp_add_mac_ref(cur_mod_node);
+ break;
+ default:
+ break;
+ }
+ mp_clear_symbol(mp, l, 0);
+ set_eq_type(l, cur_cmd);
+ switch (cur_cmd) {
+ case mp_tag_command:
+ set_equiv(l, 0);
+ break;
+ case mp_defined_macro_command:
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ set_equiv_node(l, cur_mod_node);
+ break;
+ case mp_left_delimiter_command:
+ case mp_right_delimiter_command:
+ set_equiv_sym(l, equiv_sym(cur_sym));
+ break;
+ default:
+ set_equiv(l, cur_mod);
+ break;
+ }
+ mp_get_x_next(mp);
+}
+
+void mp_grow_internals (MP mp, int l)
+{
+ if (l > max_halfword) {
+ mp_confusion(mp, "out of memory");
+ } else {
+ mp_internal *internal = mp_memory_allocate((size_t) (l + 1) * sizeof(mp_internal));
+ for (int k = 0; k <= l; k++) {
+ if (k <= mp->max_internal) {
+ memcpy(internal + k, mp->internal + k, sizeof(mp_internal));
+ } else {
+ memset(internal + k, 0, sizeof(mp_internal));
+ new_number(((mp_internal *)(internal + k))->v.data.n);
+ }
+ }
+ mp_memory_free(mp->internal);
+ mp->internal = internal;
+ mp->max_internal = l;
+ }
+}
+
+void mp_do_new_internal (MP mp)
+{
+ int the_type = mp_known_type;
+ int run_script = 0;
+ mp_get_next(mp);
+ if (cur_cmd == mp_type_name_command && cur_mod == mp_string_type_operation) {
+ the_type = mp_string_type;
+ } else if (cur_cmd == mp_type_name_command && cur_mod == mp_boolean_type_operation) {
+ the_type = mp_boolean_type;
+ } else if (cur_cmd == mp_type_name_command && cur_mod == mp_numeric_type_operation) {
+ the_type = mp_numeric_type;
+ } else if (! (cur_cmd == mp_type_name_command && cur_mod == mp_numeric_type_operation)) {
+ mp_back_input(mp);
+ }
+ if (mp_numeric_type == mp_known_type) {
+ } else {
+ if (the_type == mp_numeric_type) {
+ the_type = mp_known_type;
+ }
+ mp_get_next(mp);
+ if (cur_cmd == mp_runscript_command) {
+ run_script = 1;
+ } else {
+ mp_back_input(mp);
+ }
+ }
+ do {
+ if (mp->int_ptr == mp->max_internal) {
+ mp_grow_internals(mp, (mp->max_internal + (mp->max_internal / 4)));
+ }
+ mp_get_clear_symbol(mp);
+ ++mp->int_ptr;
+ set_eq_type(cur_sym, mp_internal_command);
+ set_equiv(cur_sym, mp->int_ptr);
+ mp_memory_free(internal_name(mp->int_ptr));
+ set_internal_name(mp->int_ptr, mp_strdup(mp_str(mp, text(cur_sym))));
+ if (the_type == mp_string_type) {
+ set_internal_string(mp->int_ptr, mp_rts(mp,""));
+ } else {
+ set_number_to_zero(internal_value(mp->int_ptr));
+ }
+ set_internal_type(mp->int_ptr, the_type);
+ set_internal_run(mp->int_ptr, run_script);
+ if (run_script) {
+ mp->run_internal(mp, 0, mp->int_ptr, the_type, internal_name(mp->int_ptr));
+ }
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+void mp_do_show (MP mp)
+{
+ do {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ mp_print_nl(mp, ">> ");
+ mp_print_exp(mp, NULL, 2);
+ mp_flush_cur_exp(mp, new_expr);
+ } while (cur_cmd == mp_comma_command);
+}
+
+void mp_disp_token (MP mp)
+{
+ mp_print_nl(mp, "> ");
+ if (cur_sym == NULL) {
+ switch (cur_cmd) {
+ case mp_numeric_command:
+ print_number(cur_mod_number);
+ break;
+ case mp_capsule_command:
+ mp_print_capsule(mp, cur_mod_node);
+ break;
+ default:
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, cur_mod_str);
+ mp_print_chr(mp, '"');
+ delete_str_ref(cur_mod_str);
+ break;
+ }
+ } else {
+ mp_print_mp_str(mp,text(cur_sym));
+ mp_print_chr(mp, '=');
+
+ mp_print_cmd_mod(mp, cur_cmd, cur_mod);
+ if (cur_cmd == mp_defined_macro_command) {
+ mp_print_ln(mp);
+ mp_show_macro (mp, cur_mod_node, NULL);
+ }
+ }
+}
+
+void mp_do_show_token (MP mp)
+{
+ do {
+ get_t_next(mp);
+ mp_disp_token(mp);
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+void mp_do_show_stats (MP mp)
+{
+ mp_print_nl(mp, "Memory usage ");
+ mp_print_int(mp, (int) mp->var_used);
+ mp_print_ln(mp);
+ mp_print_nl(mp, "String usage ");
+ mp_print_int(mp, (int) mp->strs_in_use);
+ mp_print_chr(mp, '&');
+ mp_print_int(mp, (int) mp->pool_in_use);
+ mp_print_ln(mp);
+ mp_get_x_next(mp);
+}
+
+void mp_disp_var (MP mp, mp_node p)
+{
+ if (mp_type(p) == mp_structured_type) {
+ mp_node q = mp_get_attribute_head(p);
+ do {
+ mp_disp_var(mp, q);
+ q = mp_link(q);
+ } while (q != mp->end_attr);
+ q = mp_get_subscr_head(p);
+ while (mp_name_type(q) == mp_subscript_operation) {
+ mp_disp_var(mp, q);
+ q = mp_link(q);
+ }
+ } else if (mp_type(p) >= mp_unsuffixed_macro_type) {
+ mp_print_nl(mp, "");
+ mp_print_variable_name(mp, p);
+ if (mp_type(p) > mp_unsuffixed_macro_type) {
+ mp_print_str(mp, "@#");
+ }
+ mp_print_str(mp, "=macro:");
+ mp_show_macro(mp, mp_get_value_node(p), NULL);
+ } else if (mp_type(p) != mp_undefined_type) {
+ mp_print_nl(mp, "");
+ mp_print_variable_name(mp, p);
+ mp_print_chr(mp, '=');
+ mp_print_exp(mp, p, 0);
+ }
+}
+
+void mp_do_show_var (MP mp)
+{
+ do {
+ get_t_next(mp);
+ if (cur_sym != NULL && cur_sym_mod == 0 && cur_cmd == mp_tag_command) {
+ if (cur_mod != 0 || cur_mod_node != NULL) {
+ mp_disp_var(mp, cur_mod_node);
+ goto DONE;
+ }
+ }
+ mp_disp_token(mp);
+ DONE:
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+void mp_do_show_dependencies (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_link(mp->dep_head);
+ while (p != mp->dep_head) {
+ if (mp_interesting(mp, (mp_node) p)) {
+ mp_print_nl(mp, "");
+ mp_print_variable_name(mp, (mp_node) p);
+ if (mp_type(p) == mp_dependent_type) {
+ mp_print_chr(mp, '=');
+ } else {
+ mp_print_str(mp, " = ");
+ }
+ mp_print_dependency(mp, (mp_value_node) mp_get_dep_list(p), mp_type(p));
+ }
+ p = (mp_value_node) mp_get_dep_list(p);
+ while (mp_get_dep_info(p) != NULL)
+ p = (mp_value_node) mp_link(p);
+ p = (mp_value_node) mp_link(p);
+ }
+ mp_get_x_next(mp);
+}
+
+void mp_do_show_whatever (MP mp)
+{
+ if (mp->interaction == mp_error_stop_mode) {
+ wake_up_terminal();
+ }
+ switch (cur_mod) {
+ case mp_show_token_code:
+ mp_do_show_token(mp);
+ break;
+ case mp_show_stats_code:
+ mp_do_show_stats(mp);
+ break;
+ case mp_show_code:
+ mp_do_show(mp);
+ break;
+ case mp_show_var_code:
+ mp_do_show_var(mp);
+ break;
+ case mp_show_dependencies_code:
+ mp_do_show_dependencies(mp);
+ break;
+ }
+ if (number_positive(internal_value(mp_showstopping_internal))) {
+ const char *hlp = NULL;
+ if (mp->interaction < mp_error_stop_mode) {
+ --mp->error_count;
+ } else {
+ hlp = "This isn't an error message; I'm just showing something.";
+ }
+ if (cur_cmd == mp_semicolon_command) {
+ mp_error(mp, "OK", hlp);
+ } else {
+ mp_back_error(mp, "OK", hlp);
+ mp_get_x_next(mp);
+ }
+ }
+}
+
+static void complain_invalid_with_list (MP mp, mp_variable_type t)
+{
+ mp_value new_expr;
+ const char *hlp = NULL;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ switch (t) {
+ case mp_with_pre_script_code:
+ hlp =
+ "Next time say 'withprescript <known string expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_post_script_code:
+ hlp =
+ "Next time say 'withpostscript <known string expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_stacking_code:
+ hlp =
+ "Next time say 'withstacking <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_dashed_code:
+ hlp =
+ "Next time say 'dashed <known picture expression>'; I'll ignore the bad 'with'\n"
+ "clause and look for another.";
+ break;
+ case mp_with_uninitialized_model_code:
+ hlp =
+ "Next time say 'withcolor <known color expression>'; I'll ignore the bad 'with'\n"
+ "clause and look for another.";
+ break;
+ case mp_with_rgb_model_code:
+ hlp =
+ "Next time say 'withrgbcolor <known color expression>'; I'll ignore the bad 'with'\n"
+ "clause and look for another.";
+ break;
+ case mp_with_cmyk_model_code:
+ hlp =
+ "Next time say 'withcmykcolor <known cmykcolor expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_grey_model_code:
+ hlp =
+ "Next time say 'withgreyscale <known numeric expression>'; I'll ignore the bad\n"
+ " with' clause and look for another.";
+ break;
+ case mp_with_linecap_code:
+ hlp =
+ "Next time say 'withlinecap <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_linejoin_code:
+ hlp =
+ "Next time say 'withlinejoin <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_miterlimit_code:
+ hlp =
+ "Next time say 'miterlimit <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ default:
+ hlp =
+ "Next time say 'withpen <known pen expression>'; I'll ignore the bad 'with' clause\n"
+ "and look for another.";
+ break;
+ }
+ mp_back_error(mp, "Improper type", hlp);
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+void mp_scan_with_list (MP mp, mp_node p, mp_node pstop)
+{
+ mp_node cp = MP_VOID;
+ mp_node pp = MP_VOID;
+ mp_node dp = MP_VOID;
+ mp_node ap = MP_VOID;
+ mp_node bp = MP_VOID;
+ mp_node sp = MP_VOID;
+ mp_node spstop = MP_VOID;
+ mp_number ml;
+ int miterlimit = 0;
+ int linecap = -1;
+ int linejoin = -1;
+ while (cur_cmd == mp_with_option_command) {
+ int t;
+ CONTINUE:
+ t = cur_mod;
+ mp_get_x_next(mp);
+ if (t != mp_with_no_model_code) {
+ mp_scan_expression(mp);
+ }
+ switch (t) {
+ case mp_with_uninitialized_model_code :
+ switch (mp->cur_exp.type) {
+ case mp_cmykcolor_type:
+ case mp_color_type:
+ case mp_known_type:
+ case mp_boolean_type:
+ {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ switch (mp->cur_exp.type) {
+ case mp_color_type:
+ {
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_rgb_model;
+ set_color_val(mp_red_color(cp), mp_get_value_number(mp_red_part(q)));
+ set_color_val(mp_green_color(cp), mp_get_value_number(mp_green_part(q)));
+ set_color_val(mp_blue_color(cp), mp_get_value_number(mp_blue_part(q)));
+ set_number_to_zero(mp_black_color(cp));
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_cmyk_model;
+ set_color_val(mp_cyan_color(cp), mp_get_value_number(mp_cyan_part(q)));
+ set_color_val(mp_magenta_color(cp), mp_get_value_number(mp_magenta_part(q)));
+ set_color_val(mp_yellow_color(cp), mp_get_value_number(mp_yellow_part(q)));
+ set_color_val(mp_black_color(cp), mp_get_value_number(mp_black_part(q)));
+ }
+ break;
+ case mp_known_type:
+ {
+
+
+ mp_color_model(cp) = mp_grey_model;
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_color_val(mp_grey_color(cp), cur_exp_value_number);
+
+ }
+ break;
+ default:
+ switch (cur_exp_value_boolean) {
+ case mp_false_operation:
+ mp_color_model(cp) = mp_no_model;
+ break;
+ case mp_true_operation:
+ mp_color_model(cp) = mp_uninitialized_model;
+ break;
+ default:
+ break;
+ }
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_number_to_zero(mp_black_color(cp));
+ break;
+ }
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ default:
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ break;
+ case mp_with_rgb_model_code:
+ if (mp->cur_exp.type != mp_color_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_rgb_model;
+ set_color_val(mp_red_color(cp), mp_get_value_number(mp_red_part(q)));
+ set_color_val(mp_green_color(cp), mp_get_value_number(mp_green_part(q)));
+ set_color_val(mp_blue_color(cp), mp_get_value_number(mp_blue_part(q)));
+ set_number_to_zero(mp_black_color(cp));
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_with_cmyk_model_code:
+ if (mp->cur_exp.type != mp_cmykcolor_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_cmyk_model;
+ set_color_val(mp_cyan_color(cp), mp_get_value_number(mp_cyan_part(q)));
+ set_color_val(mp_magenta_color(cp), mp_get_value_number(mp_magenta_part(q)));
+ set_color_val(mp_yellow_color(cp), mp_get_value_number(mp_yellow_part(q)));
+ set_color_val(mp_black_color(cp), mp_get_value_number(mp_black_part(q)));
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_with_grey_model_code:
+ if (mp->cur_exp.type != mp_known_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+
+
+ mp_color_model(cp) = mp_grey_model;
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_color_val(mp_grey_color(cp), cur_exp_value_number);
+
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_with_no_model_code:
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ mp_color_model(cp) = mp_no_model;
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_number_to_zero(mp_grey_color(cp));
+ }
+ break;
+ case mp_with_pen_code:
+ if (mp->cur_exp.type != mp_pen_type && mp->cur_exp.type != mp_nep_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ if (pp == MP_VOID) {
+ pp = p;
+ while (pp != NULL) {
+ if (mp_has_pen(pp)) {
+ break;
+ } else {
+ pp = mp_link(pp);
+ }
+ }
+ }
+ if (pp != NULL) {
+ switch (mp_type(pp)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ if (mp_pen_ptr((mp_shape_node) pp) != NULL) {
+ mp_toss_knot_list(mp, mp_pen_ptr((mp_shape_node) pp));
+ }
+ mp_pen_ptr((mp_shape_node) pp) = cur_exp_knot;
+ mp_pen_type((mp_shape_node) pp) = mp->cur_exp.type == mp_nep_type;
+ break;
+ default:
+ break;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ break;
+ case mp_with_pre_script_code:
+ if (mp->cur_exp.type != mp_string_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else if (cur_exp_str->len) {
+ if (ap == MP_VOID) {
+ ap = p;
+ }
+ while ((ap != NULL) && (! mp_has_script(ap))) {
+ ap = mp_link(ap);
+ }
+ if (ap != NULL) {
+ if (mp_pre_script(ap) != NULL) {
+ int selector = mp->selector;
+ mp_string s = mp_pre_script(ap);
+ mp->selector = mp_new_string_selector;
+ mp_str_room(mp, (int) (mp_pre_script(ap)->len + cur_exp_str->len + 2));
+ mp_print_mp_str(mp, cur_exp_str);
+ mp_str_room(mp, 1);
+ mp_append_char(mp, 13);
+ mp_print_mp_str(mp, mp_pre_script(ap));
+ mp_pre_script(ap) = mp_make_string(mp);
+ delete_str_ref(s);
+ mp->selector = selector;
+ } else {
+ mp_pre_script(ap) = cur_exp_str;
+ }
+ add_str_ref(mp_pre_script(ap));
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ break;
+ case mp_with_post_script_code:
+ if (mp->cur_exp.type != mp_string_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else if (cur_exp_str->len) {
+ if (bp == MP_VOID) {
+ bp = p;
+ }
+ while ((bp != NULL) && (! mp_has_script(bp))) {
+ bp = mp_link(bp);
+ }
+ if (bp != NULL) {
+ if (mp_post_script(bp) != NULL) {
+ int selector = mp->selector;
+ mp_string s = mp_post_script(bp);
+ mp->selector = mp_new_string_selector;
+ mp_str_room(mp, (int) (mp_post_script(bp)->len + cur_exp_str->len + 2));
+ mp_print_mp_str(mp, mp_post_script(bp));
+ mp_str_room(mp, 1);
+ mp_append_char(mp, 13);
+ mp_print_mp_str(mp, cur_exp_str);
+ mp_post_script(bp) = mp_make_string(mp);
+ delete_str_ref(s);
+ mp->selector = selector;
+ } else {
+ mp_post_script(bp) = cur_exp_str;
+ }
+ add_str_ref(mp_post_script(bp));
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ break;
+ case mp_with_stacking_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ if (sp == MP_VOID) {
+ sp = p;
+ }
+ if (pp && spstop == MP_VOID) {
+ spstop = pstop;
+ }
+ if (sp != NULL) {
+ mp_stacking(sp) = round_unscaled(cur_exp_value_number);
+ }
+ if (pp && spstop != NULL) {
+ mp_stacking(spstop) = round_unscaled(cur_exp_value_number);
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ break;
+ case mp_pair_type:
+ {
+ if (pp && mp_nice_pair(mp, cur_exp_node, mp->cur_exp.type)) {
+ if (sp == MP_VOID) {
+ sp = p;
+ }
+ if (spstop == MP_VOID) {
+ spstop = pstop;
+ }
+ if (sp != NULL) {
+ mp_stacking(sp) = round_unscaled(mp_get_value_number(mp_x_part(mp_get_value_node(cur_exp_node))));
+ }
+ if (spstop != NULL) {
+ mp_stacking(spstop) = round_unscaled(mp_get_value_number(mp_y_part(mp_get_value_node(cur_exp_node))));
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ } else {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_linecap_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ linecap = round_unscaled(cur_exp_value_number);
+ mp->cur_exp.type = mp_vacuous_type;
+ break;
+ }
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_linejoin_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ linejoin = round_unscaled(cur_exp_value_number);
+ mp->cur_exp.type = mp_vacuous_type;
+ break;
+ }
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_miterlimit_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ miterlimit = 1;
+ new_number_clone(ml, cur_exp_value_number);
+ mp->cur_exp.type = mp_vacuous_type;
+ break;
+ }
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_dashed_code:
+ if (mp->cur_exp.type != mp_picture_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ // fall through
+ default:
+ if (dp == MP_VOID) {
+ dp = p;
+ while (dp != NULL) {
+ if (mp_type(dp) == mp_stroked_node_type) {
+ break;
+ } else {
+ dp = mp_link(dp);
+ }
+ }
+ }
+ if (dp != NULL) {
+ if (mp_dash_ptr(dp) != NULL) {
+ mp_delete_edge_ref(mp, mp_dash_ptr(dp));
+ }
+ mp_dash_ptr(dp) = (mp_node) mp_make_dashes(mp, (mp_edge_header_node) cur_exp_node);
+ set_number_to_unity(((mp_shape_node) dp)->dashscale);
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ break;
+ }
+ }
+ if (cp > MP_VOID) {
+ mp_node q = mp_link(cp);
+ while (q != NULL) {
+ if (mp_has_color(q)) {
+ mp_shape_node q0 = (mp_shape_node) q;
+ mp_shape_node cp0 = (mp_shape_node) cp;
+ number_clone(q0->red, cp0->red);
+ number_clone(q0->green, cp0->green);
+ number_clone(q0->blue, cp0->blue);
+ number_clone(q0->black, cp0->black);
+ mp_color_model(q) = mp_color_model(cp);
+ }
+ q = mp_link(q);
+ }
+ }
+ if (pp > MP_VOID) {
+ mp_node q = mp_link(pp);
+ while (q != NULL) {
+ if (mp_has_pen(q)) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ if (mp_pen_ptr((mp_shape_node) q) != NULL) {
+ mp_toss_knot_list(mp, mp_pen_ptr((mp_shape_node) q));
+ }
+ mp_pen_ptr((mp_shape_node) q) = mp_copy_pen(mp, mp_pen_ptr((mp_shape_node) pp));
+ break;
+ default:
+ break;
+ }
+ }
+ q = mp_link(q);
+ }
+ }
+ if (dp > MP_VOID) {
+ mp_node q = mp_link(dp);
+ while (q != NULL) {
+ if (mp_type(q) == mp_stroked_node_type) {
+ if (mp_dash_ptr(q) != NULL) {
+ mp_delete_edge_ref(mp, mp_dash_ptr(q));
+ }
+ mp_dash_ptr(q) = mp_dash_ptr(dp);
+ set_number_to_unity(((mp_shape_node) q)->dashscale);
+ if (mp_dash_ptr(q) != NULL) {
+ mp_add_edge_ref(mp, mp_dash_ptr(q));
+ }
+ }
+ q = mp_link(q);
+ }
+ }
+ if (linecap >= 0 && linecap < mp_weird_linecap_code) {
+ mp_node q = p;
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ mp_set_linecap(q, linecap);
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ }
+ if (linejoin >= 0 && linejoin < mp_weird_linejoin_code) {
+ mp_node q = p;
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ mp_set_linejoin(q, linejoin);
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ }
+ if (miterlimit) {
+ mp_node q = p;
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ number_clone(mp_miterlimit(q), ml);
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ free_number(ml);
+ }
+ if (! pp && sp > MP_VOID) {
+ mp_node q = mp_link(sp);
+ while (q != NULL) {
+ mp_stacking(q) = mp_stacking(sp);
+ q = mp_link(q);
+ }
+ }
+}
+
+mp_edge_header_node mp_find_edges_var (MP mp, mp_node t)
+{
+ mp_edge_header_node cur_edges = NULL;
+ mp_node p = mp_find_variable(mp, t);
+ if (p == NULL) {
+ char *msg = mp_obliterated(mp, t);
+ mp_back_error(
+ mp,
+ msg,
+ "It seems you did a nasty thing --- probably by accident, but nevertheless you\n"
+ "nearly hornswoggled me ... While I was evaluating the right-hand side of thisn"
+ "command, something happened, and the left-hand side is no longer a variable! So In"
+ "won't change anything."
+ );
+ mp_memory_free(msg);
+ mp_get_x_next(mp);
+ } else if (mp_type(p) != mp_picture_type) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_show_token_list(mp, t, NULL);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Variable %s is the wrong type(%s)", mp_str(mp, sname), mp_type_string(mp_type(p)));
+ delete_str_ref(sname);
+ mp_back_error(
+ mp,
+ msg,
+ "I was looking for a 'known' picture variable. So I'll not change anything just\n"
+ "now."
+ );
+ mp_get_x_next(mp);
+ } else {
+ mp_set_value_node(p, (mp_node) mp_private_edges(mp, (mp_edge_header_node) mp_get_value_node(p)));
+ cur_edges = (mp_edge_header_node) mp_get_value_node(p);
+ }
+ mp_flush_node_list(mp, t);
+ return cur_edges;
+}
+
+mp_node mp_start_draw_cmd (MP mp, int sep)
+{
+ mp_node lhv = NULL;
+ int add_type = 0;
+ mp_get_x_next(mp);
+ mp->var_flag = sep;
+ mp_scan_primary(mp);
+ if (mp->cur_exp.type != mp_token_list_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a suitable variable",
+ "At this point I needed to see the name of a picture variable. (Or perhaps you\n"
+ "have indeed presented me with one; I might have missed it, if it wasn't followed\n"
+ "by the proper token.) So I'll not change anything just now.\n"
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ lhv = cur_exp_node;
+ add_type = (int) cur_mod;
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ }
+ mp->last_add_type = add_type;
+ return lhv;
+}
+
+void mp_do_bounds (MP mp)
+{
+ mp_edge_header_node lhe;
+ int c = cur_cmd;
+ int m = cur_mod;
+ mp_node lhv = mp_start_draw_cmd(mp, mp_to_command);
+ if (lhv != NULL) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ lhe = mp_find_edges_var(mp, lhv);
+ if (lhe == NULL) {
+ new_number(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ } else if (mp->cur_exp.type != mp_path_type) {
+ char msg[256];
+ mp_disp_err(mp, NULL);
+ new_number(new_expr.data.n);
+ mp_snprintf(msg, 256, "Improper '%s'", mp_cmd_mod_string(mp, c, m));
+ mp_back_error(
+ mp,
+ msg,
+ "This expression should have specified a known path. So I'll not change anything\n"
+ "just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ mp_back_error(
+ mp,
+ "Not a cycle",
+ "That contour should have ended with '..cycle' or '&cycle'. So I'll not change\n"
+ "anything just now."
+ );
+ mp_get_x_next(mp);
+ } else {
+ mp_node p = mp_new_bounds_node(mp, cur_exp_knot, (int) m);
+ mp_node pp;
+ int mm = 0;
+ switch (m) {
+ case mp_start_clip_node_type : mm = mp_stop_clip_node_type; break;
+ case mp_start_group_node_type : mm = mp_stop_group_node_type; break;
+ case mp_start_bounds_node_type: mm = mp_stop_bounds_node_type; break;
+ }
+ pp = mp_new_bounds_node(mp, NULL, mm);
+ mp_scan_with_list(mp, p, pp);
+ mp_link(p) = mp_link(mp_edge_list(lhe));
+ mp_link(mp_edge_list(lhe)) = p;
+ if (mp_obj_tail(lhe) == mp_edge_list(lhe)) {
+ mp_obj_tail(lhe) = p;
+ }
+ mp_link(mp_obj_tail(lhe)) = pp;
+ mp_obj_tail(lhe) = pp;
+ mp_init_bbox(mp, lhe);
+ }
+ }
+}
+
+void mp_do_add_to (MP mp)
+{
+ mp_node lhv = mp_start_draw_cmd(mp, mp_thing_to_add_command);
+ if (lhv != NULL) {
+ mp_edge_header_node lhe;
+ mp_node p;
+ mp_edge_header_node e;
+ int add_type = mp->last_add_type;
+ if (add_type == mp_add_also_code) {
+ p = NULL;
+ e = NULL;
+ if (mp->cur_exp.type != mp_picture_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper 'addto'",
+ "This expression should have specified a known picture. So I'll not change\n"
+ "anything just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ e = mp_private_edges(mp, (mp_edge_header_node) cur_exp_node);
+ mp->cur_exp.type = mp_vacuous_type;
+ p = mp_link(mp_edge_list(e));
+ }
+ } else {
+ e = NULL;
+ p = NULL;
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper 'addto'",
+ "This expression should have specified a known path. So I'll not change anything\n"
+ "just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else if (add_type != mp_add_contour_code) {
+ p = mp_new_shape_node(mp, cur_exp_knot, mp_stroked_node_type);
+ mp->cur_exp.type = mp_vacuous_type;
+ } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ mp_back_error(
+ mp,
+ "Not a cycle",
+ "That contour should have ended with '.. cycle' or '& cycle'. So I'll not change\n"
+ "anything just now."
+ );
+ mp_get_x_next(mp);
+ } else {
+ p = mp_new_shape_node(mp, cur_exp_knot, mp_fill_node_type);
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ mp_scan_with_list(mp, p, NULL);
+ lhe = mp_find_edges_var(mp, lhv);
+ if (lhe == NULL) {
+ if ((e == NULL) && (p != NULL)) {
+ e = mp_toss_gr_object(mp, p);
+ }
+ if (e != NULL) {
+ mp_delete_edge_ref(mp, e);
+ }
+ } else if (add_type == mp_add_also_code) {
+ if (e != NULL) {
+ if (mp_link(mp_edge_list(e)) != NULL) {
+ mp_link(mp_obj_tail(lhe)) = mp_link(mp_edge_list(e));
+ mp_obj_tail(lhe) = mp_obj_tail(e);
+ mp_obj_tail(e) = mp_edge_list(e);
+ mp_link(mp_edge_list(e)) = NULL;
+ mp_flush_dash_list(mp, lhe);
+ }
+ mp_toss_edges(mp, e);
+ }
+ } else if (p != NULL) {
+ mp_link(mp_obj_tail(lhe)) = p;
+ mp_obj_tail(lhe) = p;
+ if (add_type == mp_add_double_path_code) {
+ if (mp_pen_ptr((mp_shape_node) p) == NULL) {
+ mp_pen_ptr((mp_shape_node) p) = mp_get_pen_circle(mp, &zero_t);
+ }
+ }
+ }
+ }
+}
+
+void mp_do_ship_out (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_picture_type) {
+ mp_disp_err(mp, NULL);
+ set_number_to_zero(new_expr.data.n);
+ mp_back_error(mp, "Not a known picture", "I can only output known pictures.");
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_ship_out(mp, cur_exp_node);
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+
+void mp_do_message (MP mp)
+{
+ mp_value new_expr;
+ int m = cur_mod;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_no_string_err(mp, "A message should be a known string expression.");
+ } else {
+ switch (m) {
+ case message_code:
+ mp_print_nl(mp, "");
+ mp_print_mp_str(mp, cur_exp_str);
+ break;
+ case err_message_code:
+ {
+ char msg[256];
+ mp_snprintf(msg, 256, "%s", mp_str(mp, cur_exp_str));
+ if (mp->err_help != NULL) {
+ mp->use_err_help = 1;
+ mp_back_error(mp, msg, NULL);
+ } else if (mp->long_help_seen) {
+ mp_back_error(mp, msg, "(That was another 'errmessage'.)");
+ } else {
+ if (mp->interaction < mp_error_stop_mode) {
+ mp->long_help_seen = 1;
+ }
+ mp_back_error(
+ mp,
+ msg,
+ "This error message was generated by an 'errmessage' command, so I can't give any\n"
+ "explicit help. Pretend that you're Miss Marple: Examine all clues, and deduce the\n"
+ "truth by inspired guesses."
+ );
+ }
+ mp_get_x_next(mp);
+ mp->use_err_help = 0;
+ }
+ break;
+ case err_help_code:
+ {
+ if (mp->err_help != NULL) {
+ delete_str_ref(mp->err_help);
+ } if (cur_exp_str->len == 0) {
+ mp->err_help = NULL;
+ } else {
+ mp->err_help = cur_exp_str;
+ add_str_ref(mp->err_help);
+ }
+ }
+ break;
+ }
+ }
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static void mp_no_string_err (MP mp, const char *s)
+{
+ mp_disp_err(mp, NULL);
+ mp_back_error(mp, "Not a string", s);
+ mp_get_x_next(mp);
+}
+
+void mp_do_write (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_no_string_err(mp, "The text to be written should be a known string expression");
+ } else if (cur_cmd != mp_to_command) {
+ mp_back_error(mp, "Missing 'to' clause", "A write command should end with 'to <filename>'");
+ mp_get_x_next(mp);
+ } else {
+ mp_string t = cur_exp_str;
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_no_string_err(mp, "I can\'t write to that file name. It isn't a known string");
+ } else {
+ mp_do_write_string(mp, t);
+ }
+ }
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static void mp_do_write_string (MP mp, mp_string t)
+{
+ char *fn = mp_str(mp, cur_exp_str);
+ int n = mp->write_files;
+ int n0 = mp->write_files;
+ while (mp_strcmp(fn, mp->wr_fname[n]) != 0) {
+ if (n == 0) {
+ if (n0 == mp->write_files) {
+ if (mp->write_files < mp->max_write_files) {
+ ++mp->write_files;
+ } else {
+ int l = mp->max_write_files + (mp->max_write_files / 4);
+ void **wr_file = mp_memory_allocate((size_t) (l + 1) * sizeof(void *));
+ char **wr_fname = mp_memory_allocate((size_t) (l + 1) * sizeof(char *));
+ for (int k = 0; k <= l; k++) {
+ if (k <= mp->max_write_files) {
+ wr_file[k] = mp->wr_file[k];
+ wr_fname[k] = mp->wr_fname[k];
+ } else {
+ wr_file[k] = 0;
+ wr_fname[k] = NULL;
+ }
+ }
+ mp_memory_free(mp->wr_file);
+ mp_memory_free(mp->wr_fname);
+ mp->max_write_files = l;
+ mp->wr_file = wr_file;
+ mp->wr_fname = wr_fname;
+ }
+ }
+ n = n0;
+ mp_open_write_file(mp, fn, n);
+ } else {
+ --n;
+ if (mp->wr_fname[n] == NULL) {
+ n0 = n;
+ }
+ }
+ }
+ if (mp_str_vs_str(mp, t, mp->eof_line) == 0) {
+ (mp->close_file)(mp, mp->wr_file[n]);
+ mp_memory_free(mp->wr_fname[n]);
+ mp->wr_fname[n] = NULL;
+ if (n == mp->write_files - 1) {
+ mp->write_files = n;
+ }
+ } else {
+ int selector = mp->selector;
+ mp->selector = n + mp_first_file_selector;
+ mp_print_mp_str(mp, t);
+ mp_print_ln(mp);
+ mp->selector = selector;
+ }
+}
+
+struct mp_edge_object *mp_gr_export (MP mp, mp_edge_header_node h)
+{
+ mp_node p;
+ mp_edge_object *hh = mp_memory_allocate(sizeof(mp_edge_object));
+ mp_graphic_object *hp = NULL;
+ mp_set_bbox(mp, h, 1);
+ hh->parent = mp;
+ hh->body = NULL;
+ hh->next = NULL;
+ hh->minx = number_to_double(h->minx);
+ hh->minx = fabs(hh->minx) < 0.00001 ? 0 : hh->minx;
+ hh->miny = number_to_double(h->miny);
+ hh->miny = fabs(hh->miny) < 0.00001 ? 0 : hh->miny;
+ hh->maxx = number_to_double(h->maxx);
+ hh->maxx = fabs(hh->maxx) < 0.00001 ? 0 : hh->maxx;
+ hh->maxy = number_to_double(h->maxy);
+ hh->maxy = fabs(hh->maxy) < 0.00001 ? 0 : hh->maxy;
+ hh->charcode = round_unscaled(internal_value(mp_char_code_internal));
+ hh->width = number_to_double(internal_value(mp_char_wd_internal));
+ hh->height = number_to_double(internal_value(mp_char_ht_internal));
+ hh->depth = number_to_double(internal_value(mp_char_dp_internal));
+ hh->italic = number_to_double(internal_value(mp_char_ic_internal));
+ p = mp_link(mp_edge_list(h));
+ while (p != NULL) {
+ mp_graphic_object *hq = mp_new_graphic_object(mp, (int) ((mp_type(p) - mp_fill_node_type) + 1));
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ {
+ mp_number d_width;
+ mp_shape_node p0 = (mp_shape_node) p;
+ mp_shape_object *tf = (mp_shape_object *) hq;
+ gr_pen_ptr(tf) = mp_export_knot_list(mp, mp_pen_ptr(p0));
+ new_number(d_width);
+ mp_get_pen_scale(mp, &d_width, mp_pen_ptr(p0));
+ free_number(d_width);
+ if ((mp_pen_ptr(p0) == NULL) || mp_pen_is_elliptical(mp_pen_ptr(p0))) {
+ gr_path_ptr(tf) = mp_export_knot_list(mp, mp_path_ptr(p0));
+ } else {
+ mp_knot pc = mp_copy_path(mp, mp_path_ptr(p0));
+ mp_knot pp = mp_make_envelope(mp, pc, mp_pen_ptr(p0), p0->linejoin, 0, &(p0->miterlimit));
+ gr_path_ptr(tf) = mp_export_knot_list(mp, pp);
+ mp_toss_knot_list(mp, pp);
+ pc = mp_htap_ypoc(mp, mp_path_ptr(p0));
+ pp = mp_make_envelope(mp, pc, mp_pen_ptr((mp_shape_node) p), p0->linejoin, 0, &(p0->miterlimit));
+ gr_htap_ptr(tf) = mp_export_knot_list(mp, pp);
+ mp_toss_knot_list(mp, pp);
+ }
+ mp_gr_export_color(tf, p0);
+ mp_gr_export_scripts(tf, p);
+ gr_linejoin_val(tf) = p0->linejoin;
+ gr_stacking_val(tf) = p0->stacking;
+ gr_miterlimit_val(tf) = number_to_double(p0->miterlimit);
+ }
+ break;
+ case mp_stroked_node_type:
+ {
+ mp_number d_width;
+ mp_shape_node p0 = (mp_shape_node) p;
+ mp_shape_object *ts = (mp_shape_object *) hq;
+ gr_pen_ptr(ts) = mp_export_knot_list(mp, mp_pen_ptr(p0));
+ new_number(d_width);
+ mp_get_pen_scale(mp, &d_width, mp_pen_ptr(p0));
+ if (mp_pen_is_elliptical(mp_pen_ptr(p0))) {
+ gr_path_ptr(ts) = mp_export_knot_list(mp, mp_path_ptr(p0));
+ } else {
+ mp_knot pc = mp_copy_path(mp, mp_path_ptr(p0));
+ int t = p0->linecap;
+ if (mp_left_type(pc) != mp_endpoint_knot) {
+ mp_left_type(mp_insert_knot(mp, pc, &(pc->x_coord), &(pc->y_coord))) = mp_endpoint_knot;
+ mp_right_type(pc) = mp_endpoint_knot;
+ pc = mp_next_knot(pc);
+ t = 1;
+ }
+ pc = mp_make_envelope(mp, pc, mp_pen_ptr(p0), p0->linejoin, (int) t, &(p0->miterlimit));
+ gr_path_ptr(ts) = mp_export_knot_list(mp, pc);
+ mp_toss_knot_list(mp, pc);
+ }
+ mp_gr_export_color(ts, p0);
+ mp_gr_export_scripts(ts, p);
+ gr_linejoin_val(ts) = p0->linejoin;
+ gr_miterlimit_val(ts) = number_to_double(p0->miterlimit);
+ gr_linecap_val(ts) = p0->linecap;
+ gr_stacking_val(ts) = p0->stacking;
+ gr_dash_ptr(ts) = mp_export_dashes(mp, p0, &d_width);
+ free_number(d_width);
+ }
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ {
+ mp_start_node p0 = (mp_start_node) p;
+ mp_start_object *tb = (mp_start_object *) hq;
+ gr_path_ptr(tb) = mp_export_knot_list(mp, mp_path_ptr((mp_start_node) p));
+ gr_stacking_val(tb) = p0->stacking;
+ mp_gr_export_scripts(tb, p);
+ }
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ {
+ mp_stop_node p0 = (mp_stop_node) p;
+ mp_stop_object *tb = (mp_stop_object *) hq;
+ gr_stacking_val(tb) = p0->stacking;
+ }
+ break;
+ default:
+ break;
+ }
+ if (hh->body == NULL) {
+ hh->body = hq;
+ } else {
+ gr_link(hp) = hq;
+ }
+ hp = hq;
+ p = mp_link(p);
+ }
+ return hh;
+}
+
+static void mp_do_gr_toss_dashes (mp_dash_object *dl) {
+ if (dl) {
+ mp_memory_free(dl->array);
+ mp_memory_free(dl);
+ }
+}
+
+static void mp_do_gr_toss_knot_list (mp_gr_knot p)
+{
+ if (p) {
+ mp_gr_knot q = p;
+ do {
+ mp_gr_knot r = gr_next_knot(q);
+ mp_memory_free(q);
+ q = r;
+ } while (q != p);
+ }
+}
+
+mp_graphic_object *mp_new_graphic_object (MP mp, int type)
+{
+ mp_graphic_object *p;
+ size_t size;
+ (void) mp;
+ switch (type) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ size = sizeof(mp_shape_object);
+ break;
+ case mp_start_clip_code:
+ case mp_start_group_code:
+ case mp_start_bounds_code:
+ size = sizeof(mp_start_object);
+ break;
+ default:
+ size = sizeof(mp_graphic_object);
+ break;
+ }
+ p = (mp_graphic_object *) mp_memory_allocate(size);
+ memset(p, 0, size);
+ gr_type(p) = type;
+ return p;
+}
+
+void mp_gr_toss_object (mp_graphic_object *p)
+{
+ switch (gr_type(p)) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ {
+ mp_shape_object *o = (mp_shape_object *) p;
+ mp_memory_free(gr_pre_script(o));
+ mp_memory_free(gr_post_script(o));
+ mp_do_gr_toss_knot_list(gr_pen_ptr(o));
+ mp_do_gr_toss_knot_list(gr_path_ptr(o));
+ if (gr_htap_ptr(o)) {
+ mp_do_gr_toss_knot_list(gr_htap_ptr(o));
+ }
+ if (gr_dash_ptr(o)) {
+ mp_do_gr_toss_dashes(gr_dash_ptr(o));
+ }
+ }
+ break;
+ case mp_start_clip_code:
+ case mp_start_group_code:
+ case mp_start_bounds_code:
+ {
+ mp_start_object *o = (mp_start_object *) p;
+ mp_memory_free(gr_pre_script(o));
+ mp_memory_free(gr_post_script(o));
+ mp_do_gr_toss_knot_list(gr_path_ptr(o));
+ }
+ break;
+ case mp_stop_clip_code:
+ case mp_stop_group_code:
+ case mp_stop_bounds_code:
+ break;
+ }
+ mp_memory_free(p);
+}
+
+void mp_gr_toss_objects (mp_edge_object *hh)
+{
+ mp_graphic_object *p = hh->body;
+ while (p) {
+ mp_graphic_object *q = gr_link(p);
+ mp_gr_toss_object(p);
+ p = q;
+ }
+ mp_memory_free(hh);
+}
+
+void mp_ship_out (MP mp, mp_node h) {
+ (mp->shipout_backend)(mp, h);
+}
+
+static void mp_shipout_backend (MP mp, void *voidh)
+{
+ (void) mp;
+ (void) voidh;
+}
+
+void mp_scan_symbol_value (MP mp, int keep, char **s, int expand)
+{
+ if (mp->extensions) {
+ if (expand) {
+ mp_get_x_next(mp);
+ } else {
+ mp_get_next(mp);
+ }
+ if (keep) {
+ mp_back_input(mp);
+ }
+ if (cur_sym == NULL && (cur_sym_mod == 0 || cur_sym_mod == mp_normal_operation)) {
+ *s = NULL;
+ } else {
+ unsigned char *r = NULL;
+ mp_node p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, cur_sym);
+ mp_name_type(p) = cur_sym_mod;
+ if (mp_type(p) == mp_symbol_node_type) {
+ mp_sym sr = mp_get_sym_sym(p);
+ mp_string rr = text(sr);
+ if (rr && rr->str) {
+ r = rr->str;
+ }
+ } else if (mp_name_type(p) == mp_token_operation) {
+ if (mp_type(p) == mp_string_type) {
+ r = mp_get_value_str(p)->str;
+ }
+ }
+ mp_free_symbolic_node(mp, p);
+ if (r) {
+ *s = (char *) mp_strdup((char *) r);
+ } else {
+ *s = NULL;
+ }
+ }
+ }
+}
+
+void mp_scan_property_value (MP mp, int keep, int *kind, char **str, int *property, int *detail)
+{
+ if (mp->extensions) {
+ mp_symbol_entry *entry;
+ mp_get_symbol(mp);
+ entry = cur_sym;
+ if (entry) {
+ mp_node node = entry->type == mp_tag_command ? entry->v.data.node : NULL;
+ *kind = entry->type;
+ *str = (char *) mp_strdup((char *) entry->text->str);
+ *property = entry->property;
+ if (node) {
+ *detail = node->type;
+ }
+ if (keep) {
+ mp_back_input(mp);
+ }
+ }
+ }
+}
+
+void mp_scan_next_value (MP mp, int keep, int *token, int *mode, int *kind)
+{
+ if (mp->extensions) {
+ mp_get_next(mp);
+ if (keep) {
+ mp_back_input(mp);
+ }
+ *token = cur_cmd;
+ *mode = cur_mod;
+ *kind = mp->cur_exp.type;
+ }
+}
+
+void mp_scan_expr_value (MP mp, int keep, int *kind)
+{
+ if (mp->extensions) {
+ mp_get_next(mp);
+ mp_scan_primary(mp);
+ *kind = mp->cur_exp.type;
+ if (keep) {
+ mp_back_input(mp);
+ mp_back_expr(mp);
+ }
+ }
+}
+
+void mp_scan_token_value (MP mp, int keep, int *token, int *mode, int *kind)
+{
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ if (keep) {
+ mp_back_input(mp);
+ }
+ *token = cur_cmd;
+ *mode = cur_mod;
+ *kind = mp->cur_exp.type;
+ }
+}
+
+int mp_skip_token_value (MP mp, int token)
+{
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ if (token == cur_cmd) {
+ return 1;
+ } else {
+ mp_back_input(mp);
+ }
+ }
+ return 0;
+}
+
+static void mp_scan_something (MP mp, int primary)
+{
+ mp_get_x_next(mp);
+ switch (primary) {
+ case 0: mp_scan_expression(mp); break;
+ case 1: mp_scan_primary(mp); break;
+ case 2: mp_scan_secondary(mp); break;
+ case 3: mp_scan_tertiary(mp); break;
+ default: mp_scan_expression(mp); break;
+ }
+}
+
+void mp_scan_numeric_value (MP mp, int primary, double *d)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_back_input(mp);
+ } else {
+ mp_back_input(mp);
+ *d = number_to_double(cur_exp_value_number);
+ }
+ }
+}
+
+# define mp_set_double_value(mp,target,what) \
+if (mp_type(what) == mp_known_type) { \
+ *target = number_to_double(mp_get_value_number(what)); \
+}
+
+void mp_scan_pair_value (MP mp, int primary, double *x, double *y)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_pair_type) {
+ mp_back_input(mp);
+ } else {
+ mp_node p ;
+ mp_back_input(mp);
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, x, mp_x_part(p));
+ mp_set_double_value(mp, y, mp_y_part(p));
+ }
+ }
+}
+
+void mp_scan_color_value (MP mp, int primary, double *r, double *g, double *b)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_color_type) {
+ mp_back_input(mp);
+ } else {
+ mp_node p ;
+ mp_back_input(mp);
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, r, mp_red_part(p));
+ mp_set_double_value(mp, g, mp_green_part(p));
+ mp_set_double_value(mp, b, mp_blue_part(p));
+ }
+ }
+}
+
+void mp_scan_cmykcolor_value (MP mp, int primary, double *c, double *m, double *y, double *k)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_cmykcolor_type) {
+ mp_back_input(mp);
+ } else {
+ mp_node p ;
+ mp_back_input(mp);
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, c, mp_cyan_part(p));
+ mp_set_double_value(mp, m, mp_magenta_part(p));
+ mp_set_double_value(mp, y, mp_yellow_part(p));
+ mp_set_double_value(mp, k, mp_black_part(p));
+ }
+ }
+}
+
+void mp_scan_transform_value (MP mp, int primary, double *x, double *y, double *xx, double *xy, double *yx, double *yy)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_transform_type) {
+ mp_back_input(mp);
+ } else {
+ mp_node p ;
+ mp_back_input(mp);
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, x, mp_x_part(p));
+ mp_set_double_value(mp, y, mp_y_part(p));
+ mp_set_double_value(mp, xx, mp_xx_part(p));
+ mp_set_double_value(mp, xy, mp_xy_part(p));
+ mp_set_double_value(mp, yx, mp_yx_part(p));
+ mp_set_double_value(mp, yy, mp_yy_part(p));
+ }
+ }
+}
+
+void mp_scan_path_value (MP mp, int primary, mp_knot *k)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_path_type && mp->cur_exp.type != mp_pen_type) {
+ mp_back_input(mp);
+ } else {
+ mp_back_input(mp);
+ *k = cur_exp_knot;
+ }
+ }
+}
+
+void mp_scan_boolean_value (MP mp, int primary, int *b)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_boolean_type) {
+ mp_back_input(mp);
+ } else {
+ mp_back_input(mp);
+ *b = cur_exp_value_boolean == mp_true_operation ? 1 : 0 ;
+ }
+ }
+}
+
+void mp_scan_string_value (MP mp, int primary, char **s, size_t *l)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_back_input(mp);
+ *s = NULL ;
+ *l = 0;
+ } else {
+ mp_back_input(mp);
+ *s = (char *) cur_exp_str->str ;
+ *l = cur_exp_str->len;
+ }
+ }
+}
+
+void mp_push_numeric_value (MP mp, double n)
+{
+ mp_number m;
+ new_number_from_double(mp, m, n);
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &m);
+ mp_back_expr(mp);
+}
+
+void mp_push_integer_value (MP mp, int i)
+{
+ mp_number m;
+ new_number(m);
+ set_number_from_int(m, i);
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &m);
+ mp_back_expr(mp);
+}
+
+void mp_push_boolean_value (MP mp, int b)
+{
+ mp->cur_exp.type = mp_boolean_type;
+ mp_set_cur_exp_value_boolean(mp, b ? mp_true_operation : mp_false_operation);
+ mp_back_expr(mp);
+}
+
+void mp_push_string_value (MP mp, const char *s, int l)
+{
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, mp_rtsl(mp, (char *) s, l));
+ mp_back_expr(mp);
+}
+
+void mp_push_pair_value (MP mp, double x, double y)
+{
+ mp_number px, py;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_pair_node(mp, p);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, px, x);
+ new_number_from_double(mp, py, y);
+ mp_type(mp_x_part(v)) = mp_known_type;
+ mp_type(mp_y_part(v)) = mp_known_type;
+ mp_set_value_number(mp_x_part(v), px);
+ mp_set_value_number(mp_y_part(v), py);
+ free_number(px);
+ free_number(py);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_pair_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_color_value (MP mp, double r, double g, double b)
+{
+ mp_number pr, pg, pb;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_color_node(mp, p, mp_color_type);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, pr, r);
+ new_number_from_double(mp, pg, g);
+ new_number_from_double(mp, pb, b);
+ mp_type(mp_red_part (v)) = mp_known_type;
+ mp_type(mp_green_part(v)) = mp_known_type;
+ mp_type(mp_blue_part (v)) = mp_known_type;
+ mp_set_value_number(mp_red_part (v), pr);
+ mp_set_value_number(mp_green_part(v), pg);
+ mp_set_value_number(mp_blue_part (v), pb);
+ free_number(pr);
+ free_number(pg);
+ free_number(pb);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_color_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_cmykcolor_value (MP mp, double c, double m, double y, double k)
+{
+ mp_number pc, pm, py, pk;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_color_node(mp, p, mp_cmykcolor_type);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, pc, c);
+ new_number_from_double(mp, pm, m);
+ new_number_from_double(mp, py, y);
+ new_number_from_double(mp, pk, k);
+ mp_type(mp_cyan_part (v)) = mp_known_type;
+ mp_type(mp_magenta_part(v)) = mp_known_type;
+ mp_type(mp_yellow_part (v)) = mp_known_type;
+ mp_type(mp_black_part (v)) = mp_known_type;
+ mp_set_value_number(mp_cyan_part (v), pc);
+ mp_set_value_number(mp_magenta_part(v), pm);
+ mp_set_value_number(mp_yellow_part (v), py);
+ mp_set_value_number(mp_black_part (v), pk);
+ free_number(pc);
+ free_number(pm);
+ free_number(py);
+ free_number(pk);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_cmykcolor_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_transform_value (MP mp, double x, double y, double xx, double xy, double yx, double yy)
+{
+ mp_number px, py, pxx, pxy, pyx, pyy ;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_transform_node(mp, p);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, px, x);
+ new_number_from_double(mp, py, y);
+ new_number_from_double(mp, pxx, xx);
+ new_number_from_double(mp, pxy, xy);
+ new_number_from_double(mp, pyx, yx);
+ new_number_from_double(mp, pyy, yy);
+ mp_type(mp_x_part (v)) = mp_known_type;
+ mp_type(mp_y_part (v)) = mp_known_type;
+ mp_type(mp_xx_part(v)) = mp_known_type;
+ mp_type(mp_xy_part(v)) = mp_known_type;
+ mp_type(mp_yx_part(v)) = mp_known_type;
+ mp_type(mp_yy_part(v)) = mp_known_type;
+ mp_set_value_number(mp_x_part (v), px);
+ mp_set_value_number(mp_y_part (v), py);
+ mp_set_value_number(mp_xx_part(v), pxx);
+ mp_set_value_number(mp_xy_part(v), pxy);
+ mp_set_value_number(mp_yx_part(v), pyx);
+ mp_set_value_number(mp_yy_part(v), pyy);
+ free_number(px);
+ free_number(py);
+ free_number(pxx);
+ free_number(pxy);
+ free_number(pyx);
+ free_number(pyy);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_transform_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_path_value (MP mp, mp_knot k)
+{
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, k);
+ mp_back_expr(mp);
+}
+
+static void check_for_mediation (MP mp);
+static void mp_primary_error(MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ mp_disp_err(mp, NULL);
+ new_number(new_expr.data.n);
+ mp_back_error(
+ mp,
+ "Nonnumeric part has been replaced by 0",
+ "I've started to scan a pair (x,y), color (r,g,b), cmykcolor (c,m,y,k) or\n"
+ "transform (tx,ty,xx,xy,yx,yy) but ran into a non-numeric type. I'll recover\n"
+ "as good as possible."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+}
+void mp_scan_primary (MP mp)
+{
+ mp_command_code my_var_flag = mp->var_flag;
+ mp->var_flag = 0;
+ RESTART:
+ check_arith();
+ switch (cur_cmd) {
+ case mp_left_delimiter_command:
+ {
+ mp_sym l_delim = cur_sym;
+ mp_sym r_delim = equiv_sym(cur_sym);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if ((cur_cmd == mp_comma_command) && (mp->cur_exp.type >= mp_known_type)) {
+ mp_node q = mp_new_value_node(mp);
+ mp_node p1 = mp_stash_cur_exp(mp);
+ mp_node r;
+ mp_name_type(q) = mp_capsule_operation;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ if (cur_cmd != mp_comma_command) {
+ mp_init_pair_node(mp, q);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_y_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_x_part(r));
+ } else {
+ mp_node p2 = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ if (cur_cmd != mp_comma_command) {
+ mp_init_color_node(mp, q, mp_color_type);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_blue_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_red_part(r));
+ mp_unstash_cur_exp(mp, p2);
+ mp_stash_in(mp, mp_green_part(r));
+ } else {
+ mp_node p3 = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ if (cur_cmd != mp_comma_command) {
+ mp_init_color_node(mp, q, mp_cmykcolor_type);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_black_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_cyan_part(r));
+ mp_unstash_cur_exp(mp, p2);
+ mp_stash_in(mp, mp_magenta_part(r));
+ mp_unstash_cur_exp(mp, p3);
+ mp_stash_in(mp, mp_yellow_part(r));
+ } else {
+ mp_node p4 = mp_stash_cur_exp(mp);
+ mp_node p5;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ p5 = mp_stash_cur_exp(mp);
+ goto HERE;
+ }
+ if (cur_cmd != mp_comma_command) {
+ mp_primary_error(mp);
+ p5 = mp_stash_cur_exp(mp);
+ goto HERE;
+ }
+ p5 = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ HERE:
+ mp_init_transform_node(mp, q);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_ty_part(r));
+ mp_unstash_cur_exp(mp, p5);
+ mp_stash_in(mp, mp_tx_part(r));
+ mp_unstash_cur_exp(mp, p4);
+ mp_stash_in(mp, mp_yy_part(r));
+ mp_unstash_cur_exp(mp, p3);
+ mp_stash_in(mp, mp_yx_part(r));
+ mp_unstash_cur_exp(mp, p2);
+ mp_stash_in(mp, mp_xy_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_xx_part(r));
+ }
+ }
+ }
+ mp_check_delimiter(mp, l_delim, r_delim);
+ mp->cur_exp.type = mp_type(q);
+ mp_set_cur_exp_node(mp, q);
+ } else {
+ mp_check_delimiter(mp, l_delim, r_delim);
+ }
+ }
+ break;
+ case mp_begin_group_command:
+ {
+ int group_line = mp_true_line(mp);
+ if (number_positive(internal_value(mp_tracing_commands_internal))) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ mp_save_boundary(mp);
+ do {
+ mp_do_statement(mp);
+ } while (cur_cmd == mp_semicolon_command);
+ if (cur_cmd != mp_end_group_command) {
+ char msg[256];
+ mp_snprintf(msg, 256, "A group begun on line %d never ended", (int) group_line);
+ mp_back_error(
+ mp,
+ msg,
+ "I saw a 'begingroup' back there that hasn't been matched by 'endgroup'. So I've\n"
+ "inserted 'endgroup' now."
+ );
+ set_cur_cmd(mp_end_group_command);
+ }
+ mp_unsave(mp);
+ if (number_positive(internal_value(mp_tracing_commands_internal))) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ }
+ break;
+ case mp_string_command:
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, cur_mod_str);
+ break;
+ case mp_numeric_command:
+ {
+ mp_number num, denom;
+ mp_set_cur_exp_value_number(mp, &cur_mod_number);
+ mp->cur_exp.type = mp_known_type;
+ mp_get_x_next(mp);
+
+
+ if (cur_cmd != mp_slash_command) {
+ new_number(num);
+ new_number(denom);
+ } else {
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_numeric_command) {
+ mp_back_input(mp);
+ set_cur_cmd(mp_slash_command);
+ set_cur_mod(mp_over_operation);
+ set_cur_sym(mp->frozen_slash);
+
+ goto DONE;
+ } else {
+ new_number_clone(num, cur_exp_value_number);
+ new_number_clone(denom, cur_mod_number);
+
+
+ if (number_zero(denom)) {
+ mp_error(mp, "Division by zero", "I'll pretend that you meant to divide by 1.");
+ } else {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, num, denom);
+ mp_set_cur_exp_value_number(mp, &ret);
+ free_number(ret);
+ }
+ check_arith();
+ mp_get_x_next(mp);
+ }
+ }
+ if (cur_cmd >= mp_min_primary_command && cur_cmd < mp_numeric_command) {
+ mp_number absnum, absdenom;
+ mp_node p = mp_stash_cur_exp(mp);
+ mp_scan_primary(mp);
+ new_number_abs(absnum, num);
+ new_number_abs(absdenom, denom);
+ if (number_greaterequal(absnum, absdenom) || (mp->cur_exp.type < mp_color_type)) {
+ mp_do_binary(mp, p, mp_times_operation);
+ } else {
+ mp_frac_mult(mp, &num, &denom);
+ mp_free_value_node(mp, p);
+ }
+ free_number(absnum);
+ free_number(absdenom);
+ }
+ free_number(num);
+ free_number(denom);
+ goto DONE;
+ }
+ case mp_nullary_command:
+ mp_do_nullary(mp, (int) cur_mod);
+ break;
+ case mp_unary_command:
+ case mp_type_name_command:
+ case mp_cycle_command:
+ case mp_plus_or_minus_command:
+ {
+ int c = (int) cur_mod;
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_do_unary(mp, c);
+ goto DONE;
+ }
+ case mp_of_binary_command:
+ {
+ mp_node p;
+ int c = (int) cur_mod;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_of_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_cmd_mod(mp, mp_of_binary_command, c);
+ mp->selector = selector;
+ sname = mp_make_string(mp);
+ mp_snprintf(msg, 256, "Missing 'of' has been inserted for %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_back_error(mp, msg, "I've got the first argument; will look now for the other.");
+ }
+ p = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_do_binary(mp, p, c);
+ goto DONE;
+ }
+ case mp_str_command:
+ {
+ int selector = mp->selector;
+ mp_get_x_next(mp);
+ mp_scan_suffix(mp);
+ mp->selector = mp_new_string_selector;
+ mp_show_token_list(mp, cur_exp_node, NULL);
+ mp_flush_token_list(mp, cur_exp_node);
+ mp_set_cur_exp_str(mp, mp_make_string(mp));
+ mp->selector = selector;
+ mp->cur_exp.type = mp_string_type;
+ goto DONE;
+ }
+ case mp_void_command:
+ {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_suffix(mp);
+ if (cur_exp_node == NULL) {
+ set_number_from_boolean(new_expr.data.n, mp_true_operation);
+ } else {
+ set_number_from_boolean(new_expr.data.n, mp_false_operation);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ cur_exp_node = NULL;
+ mp->cur_exp.type = mp_boolean_type;
+ goto DONE;
+ }
+ case mp_internal_command:
+ {
+ int qq = cur_mod;
+ if (my_var_flag == mp_assignment_command) {
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_assignment_command) {
+ mp_set_cur_exp_node(mp, mp_new_symbolic_node(mp));
+ mp_set_sym_info(cur_exp_node, qq);
+ mp_name_type(cur_exp_node) = mp_internal_operation;
+ mp->cur_exp.type = mp_token_list_type;
+ goto DONE;
+ }
+ mp_back_input(mp);
+ }
+ if (internal_type(qq) == mp_string_type) {
+ mp_set_cur_exp_str(mp, internal_string(qq));
+ } else {
+ mp_set_cur_exp_value_number(mp, &(internal_value(qq)));
+ }
+ mp->cur_exp.type = internal_type(qq);
+ }
+ break;
+ case mp_capsule_command:
+ mp_make_exp_copy(mp, cur_mod_node);
+ break;
+ case mp_tag_command:
+ {
+ mp_node p = 0;
+ mp_node q = 0;
+ mp_node t = 0;
+ mp_node macro_ref = 0;
+ int tt = mp_vacuous_type;
+ mp_node pre_head = mp_new_symbolic_node(mp);
+ mp_node tail = pre_head;
+ mp_node post_head = NULL;
+ while (1) {
+ t = mp_cur_tok(mp);
+ mp_link(tail) = t;
+ if (tt != mp_undefined_type) {
+ mp_sym qq;
+ p = mp_link(pre_head);
+ qq = mp_get_sym_sym(p);
+ tt = mp_undefined_type;
+
+ if (eq_type(qq) == mp_tag_command) {
+ q = equiv_node(qq);
+ if (q == NULL) {
+ goto DONE2;
+ }
+ while (1) {
+ p = mp_link(p);
+ if (p == NULL) {
+ tt = mp_type(q);
+ goto DONE2;
+ }
+ if (mp_type(q) != mp_structured_type) {
+ goto DONE2;
+ }
+ q = mp_link(mp_get_attribute_head(q));
+ if (mp_type(p) == mp_symbol_node_type) {
+ do {
+ q = mp_link(q);
+ } while (! (mp_get_hashloc(q) >= mp_get_sym_sym(p)));
+ if (mp_get_hashloc(q) > mp_get_sym_sym(p)) {
+ goto DONE2;
+ }
+ }
+ }
+ }
+ DONE2:
+ if (tt >= mp_unsuffixed_macro_type) {
+ mp_link(tail) = NULL;
+ if (tt > mp_unsuffixed_macro_type) {
+ post_head = mp_new_symbolic_node(mp);
+ tail = post_head;
+ mp_link(tail) = t;
+ tt = mp_undefined_type;
+ macro_ref = mp_get_value_node(q);
+ mp_add_mac_ref(macro_ref);
+ } else {
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(pre_head, mp_link(pre_head));
+ mp_link(pre_head) = p;
+ mp_set_sym_sym(p, t);
+ mp_macro_call(mp, mp_get_value_node(q), pre_head, NULL);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ }
+ }
+ mp_get_x_next(mp);
+ tail = t;
+ if (cur_cmd == mp_left_bracket_command) {
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_right_bracket_command) {
+ mp_back_input(mp);
+ mp_back_expr(mp);
+ set_cur_cmd(mp_left_bracket_command);
+ set_cur_mod_number(zero_t);
+ set_cur_sym(mp->frozen_left_bracket);
+ } else {
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_subscript(mp);
+ }
+ set_cur_cmd(mp_numeric_command);
+ set_cur_mod_number(cur_exp_value_number);
+ set_cur_sym(NULL);
+ }
+ }
+ if (cur_cmd > mp_max_suffix_token) {
+ break;
+ } else if (cur_cmd < mp_min_suffix_token) {
+ break;
+ }
+ }
+ if (post_head != NULL) {
+ mp_back_input(mp);
+ p = mp_new_symbolic_node(mp);
+ q = mp_link(post_head);
+ mp_set_sym_sym(pre_head, mp_link(pre_head));
+ mp_link(pre_head) = post_head;
+ mp_set_sym_sym(post_head, q);
+ mp_link(post_head) = p;
+ mp_set_sym_sym(p, mp_link(q));
+ mp_link(q) = NULL;
+ mp_macro_call(mp, macro_ref, pre_head, NULL);
+ mp_decr_mac_ref(macro_ref);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ q = mp_link(pre_head);
+ mp_free_symbolic_node(mp, pre_head);
+ if (cur_cmd == my_var_flag) {
+ mp->cur_exp.type = mp_token_list_type;
+ mp_set_cur_exp_node(mp, q);
+ goto DONE;
+ }
+ p = mp_find_variable(mp, q);
+ if (p != NULL) {
+ mp_make_exp_copy(mp, p);
+ } else {
+ mp_value new_expr;
+ char *msg = mp_obliterated (mp, q);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_back_error(
+ mp,
+ msg,
+ "While I was evaluating the suffix of this variable, something was redefined, and\n"
+ "it's no longer a variable! In order to get back on my feet, I've inserted '0'\n"
+ "instead."
+ );
+ mp_memory_free(msg);
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ mp_flush_node_list(mp, q);
+ goto DONE;
+ }
+ break;
+ default:
+ mp_bad_exp(mp, "A primary");
+ goto RESTART;
+ break;
+ }
+ mp_get_x_next(mp);
+ DONE:
+ check_for_mediation(mp);
+}
+static void check_for_mediation (MP mp)
+{
+ if (cur_cmd == mp_left_bracket_command && mp->cur_exp.type >= mp_known_type) {
+ mp_node p = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_comma_command) {
+ mp_back_input(mp);
+ mp_back_expr(mp);
+ set_cur_cmd(mp_left_bracket_command);
+ set_cur_mod_number(zero_t);
+ set_cur_sym(mp->frozen_left_bracket);
+ mp_unstash_cur_exp(mp, p);
+ } else {
+ mp_node q = mp_stash_cur_exp(mp);
+ mp_node r;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_right_bracket_command) {
+ mp_back_error(
+ mp,
+ "Missing ']' has been inserted",
+ "I've scanned an expression of the form 'a[b,c', so a right bracket should have\n"
+ "come next. I shall pretend that one was there."
+ );
+ }
+ r = mp_stash_cur_exp(mp);
+ mp_make_exp_copy(mp, q);
+ mp_do_binary(mp, r, mp_minus_operation);
+ mp_do_binary(mp, p, mp_times_operation);
+ mp_do_binary(mp, q, mp_plus_operation);
+ mp_get_x_next(mp);
+ }
+ }
+}
+static void mp_scan_suffix (MP mp)
+{
+ mp_node h = mp_new_symbolic_node(mp);
+ mp_node t = h;
+ while (1) {
+ mp_node p;
+ if (cur_cmd == mp_left_bracket_command) {
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_subscript(mp);
+ }
+ if (cur_cmd != mp_right_bracket_command) {
+ mp_back_error(
+ mp,
+ "Missing ']' has been inserted",
+ "I've seen a '[' and a subscript value, in a suffix, so a right bracket should\n"
+ "have come next. I shall pretend that one was there."
+ );
+ }
+ set_cur_cmd(mp_numeric_command);
+ set_cur_mod_number(cur_exp_value_number);
+ }
+ if (cur_cmd == mp_numeric_command) {
+ mp_number arg1;
+ new_number_clone(arg1, cur_mod_number);
+ p = mp_new_num_tok(mp, &arg1);
+ free_number(arg1);
+ } else if ((cur_cmd == mp_tag_command) || (cur_cmd == mp_internal_command)) {
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, cur_sym);
+ mp_name_type(p) = cur_sym_mod;
+ } else {
+ break;
+ }
+ mp_link(t) = p;
+ t = p;
+ mp_get_x_next(mp);
+ }
+ mp_set_cur_exp_node(mp, mp_link(h));
+ mp_free_symbolic_node(mp, h);
+ mp->cur_exp.type = mp_token_list_type;
+}
+static void mp_scan_secondary (MP mp)
+{
+ mp_node cc = NULL;
+ mp_sym mac_name = NULL;
+ RESTART:
+ if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) {
+ mp_bad_exp(mp, "A secondary");
+ }
+ mp_scan_primary(mp);
+ CONTINUE:
+ if (cur_cmd <= mp_max_secondary_command && cur_cmd >= mp_min_secondary_command) {
+ mp_node p = mp_stash_cur_exp(mp);
+ int d = cur_cmd;
+ int c = cur_mod;
+ if (d == mp_primary_def_command) {
+ cc = cur_mod_node;
+ mac_name = cur_sym;
+ mp_add_mac_ref(cc);
+ }
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ if (d != mp_primary_def_command) {
+ mp_do_binary(mp, p, c);
+ } else {
+ mp_back_input(mp);
+ mp_binary_mac(mp, p, cc, mac_name);
+ mp_decr_mac_ref(cc);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ goto CONTINUE;
+ }
+}
+static void mp_scan_tertiary (MP mp)
+{
+ mp_node cc = NULL;
+ mp_sym mac_name = NULL;
+ RESTART:
+ if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) {
+ mp_bad_exp(mp, "A tertiary");
+ }
+ mp_scan_secondary(mp);
+ CONTINUE:
+ if (cur_cmd <= mp_max_tertiary_command && cur_cmd >= mp_min_tertiary_command) {
+ mp_node p = mp_stash_cur_exp(mp);
+ int c = cur_mod;
+ int d = cur_cmd;
+ if (d == mp_secondary_def_command) {
+ cc = cur_mod_node;
+ mac_name = cur_sym;
+ mp_add_mac_ref(cc);
+ }
+ mp_get_x_next(mp);
+ mp_scan_secondary(mp);
+ if (d != mp_secondary_def_command) {
+ mp_do_binary(mp, p, c);
+ } else {
+ mp_back_input(mp);
+ mp_binary_mac(mp, p, cc, mac_name);
+ mp_decr_mac_ref(cc);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ goto CONTINUE;
+ }
+}
+static int mp_scan_path (MP mp);
+static void mp_scan_expression (MP mp)
+{
+ int my_var_flag = mp->var_flag;
+ mp_check_expansion_depth(mp);
+ RESTART:
+ if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) {
+ mp_bad_exp(mp, "An");
+ }
+ mp_scan_tertiary(mp);
+ CONTINUE:
+ if (cur_cmd <= mp_max_expression_command) {
+ if (cur_cmd >= mp_min_expression_command) {
+ if ((cur_cmd != mp_equals_command) || (my_var_flag != mp_assignment_command)) {
+ mp_node cc = NULL;
+ mp_sym mac_name;
+ mac_name = NULL;
+ mp_node p = mp_stash_cur_exp(mp);
+ int d = cur_cmd;
+ int c = cur_mod;
+ if (d == mp_tertiary_def_command) {
+ cc = cur_mod_node;
+ mac_name = cur_sym;
+ mp_add_mac_ref(cc);
+ }
+ if ((d < mp_ampersand_command) || ((d == mp_ampersand_command) && ((mp_type(p) == mp_pair_type) || (mp_type(p) == mp_path_type)))) {
+ mp_unstash_cur_exp(mp, p);
+ if (! mp_scan_path(mp)) {
+ mp->expand_depth_count--;
+ return;
+ }
+ } else {
+ mp_get_x_next(mp);
+ mp_scan_tertiary(mp);
+ if (d != mp_tertiary_def_command) {
+ mp_do_binary(mp, p, c);
+ } else {
+ mp_back_input(mp);
+ mp_binary_mac(mp, p, cc, mac_name);
+ mp_decr_mac_ref(cc);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ }
+ goto CONTINUE;
+ }
+ }
+ }
+ mp->expand_depth_count--;
+}
+static void force_valid_tension_setting (MP mp)
+{
+ if ((mp->cur_exp.type != mp_known_type) || number_less(cur_exp_value_number, min_tension)) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ number_clone(new_expr.data.n, unity_t);
+ mp_back_error(
+ mp,
+ "Improper tension has been set to 1",
+ "The expression above should have been a number >= 3/4."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+static int mp_scan_path (MP mp)
+{
+ mp_knot path_p, path_q, r;
+ mp_knot pp = NULL;
+ mp_knot qq = NULL;
+ int d, dd;
+ int cycle_hit = 0;
+ mp_number x, y;
+ int t = mp_endpoint_knot;
+ if (mp->cur_exp.type == mp_pair_type) {
+ path_p = mp_pair_to_knot(mp);
+ } else if (mp->cur_exp.type == mp_path_type) {
+ path_p = cur_exp_knot;
+ } else {
+ return 0;
+ }
+ path_q = path_p;
+ while (mp_next_knot(path_q) != path_p) {
+ path_q = mp_next_knot(path_q);
+ }
+ if (mp_left_type(path_p) != mp_endpoint_knot) {
+ r = mp_copy_knot(mp, path_p);
+ mp_prev_knot(r) = path_q;
+ mp_next_knot(path_q) = r;
+ path_q = r;
+ }
+ mp_left_type(path_p) = mp_open_knot;
+ mp_right_type(path_q) = mp_open_knot;
+ new_number(y);
+ new_number(x);
+ CONTINUE_PATH:
+ if (cur_cmd == mp_left_brace_command) {
+ t = mp_scan_direction(mp);
+ if (t != mp_open_knot) {
+ mp_right_type(path_q) = (unsigned char) t;
+ number_clone(path_q->right_given, cur_exp_value_number);
+ if (mp_left_type(path_q) == mp_open_knot) {
+ mp_left_type(path_q) = (unsigned char) t;
+ number_clone(path_q->left_given, cur_exp_value_number);
+ }
+ }
+ }
+ d = cur_cmd;
+ dd = cur_mod;
+ if (d == mp_path_join_command) {
+ mp_get_x_next(mp);
+ switch (cur_cmd) {
+ case mp_tension_command:
+ mp_get_x_next(mp);
+ set_number_from_scaled(y, cur_cmd);
+ if (cur_cmd == mp_at_least_command) {
+ mp_get_x_next(mp);
+ }
+ mp_scan_primary(mp);
+ force_valid_tension_setting(mp);
+ if (number_to_scaled(y) == mp_at_least_command && is_number(cur_exp_value_number)) {
+ number_negate(cur_exp_value_number);
+ }
+ number_clone(path_q->right_tension, cur_exp_value_number);
+ if (cur_cmd == mp_and_command) {
+ mp_get_x_next(mp);
+ set_number_from_scaled(y, cur_cmd);
+ if (cur_cmd == mp_at_least_command) {
+ mp_get_x_next(mp);
+ }
+ mp_scan_primary(mp);
+ force_valid_tension_setting(mp);
+ if (number_to_scaled(y) == mp_at_least_command && is_number(cur_exp_value_number)) {
+ number_negate(cur_exp_value_number);
+ }
+ }
+ number_clone(y, cur_exp_value_number);
+ break;
+ case mp_controls_command:
+ mp_right_type(path_q) = mp_explicit_knot;
+ t = mp_explicit_knot;
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_known_pair(mp);
+ number_clone(path_q->right_x, mp->cur_x);
+ number_clone(path_q->right_y, mp->cur_y);
+ if (cur_cmd != mp_and_command) {
+ number_clone(x, path_q->right_x);
+ number_clone(y, path_q->right_y);
+ } else {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_known_pair(mp);
+ number_clone(x, mp->cur_x);
+ number_clone(y, mp->cur_y);
+ }
+ break;
+ default:
+ set_number_to_unity(path_q->right_tension);
+ set_number_to_unity(y);
+ mp_back_input(mp);
+ goto DONE;
+ break;
+ }
+ if (cur_cmd != mp_path_join_command) {
+ mp_back_error(
+ mp,
+ "Missing '..' has been inserted",
+ "A path join command should end with two dots."
+ );
+ }
+ DONE:
+ ;
+ } else if (d != mp_ampersand_command) {
+ goto FINISH_PATH;
+ }
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_left_brace_command) {
+ t = mp_scan_direction(mp);
+ if (mp_right_type(path_q) != mp_explicit_knot) {
+ number_clone(x, cur_exp_value_number);
+ } else {
+ t = mp_explicit_knot;
+ }
+ } else if (mp_right_type(path_q) != mp_explicit_knot) {
+ t = mp_open_knot;
+ set_number_to_zero(x);
+ }
+ if (cur_cmd == mp_cycle_command) {
+ if (cur_mod == mp_cycle_operation) {
+ cycle_hit = 1;
+ mp_get_x_next(mp);
+ pp = path_p;
+ qq = path_p;
+ if (d == mp_ampersand_command && path_p == path_q) {
+ d = mp_path_join_command;
+ set_number_to_unity(path_q->right_tension);
+ set_number_to_unity(y);
+ }
+ } else {
+ mp_get_x_next(mp);
+ qq = pp;
+ goto FINISH_PATH;
+ }
+ } else {
+ mp_scan_tertiary(mp);
+ if (mp->cur_exp.type != mp_path_type) {
+ pp = mp_pair_to_knot(mp);
+ } else {
+ pp = cur_exp_knot;
+ }
+ qq = pp;
+ while (mp_next_knot(qq) != pp) {
+ qq = mp_next_knot(qq);
+ }
+ if (mp_left_type(pp) != mp_endpoint_knot) {
+ r = mp_copy_knot(mp, pp);
+ mp_prev_knot(r) = qq;
+ mp_next_knot(qq) = r;
+ qq = r;
+ }
+ mp_left_type(pp) = mp_open_knot;
+ mp_right_type(qq) = mp_open_knot;
+ }
+ if (d == mp_ampersand_command && dd != mp_just_append_operation) {
+ if (! (number_equal(path_q->x_coord, pp->x_coord)) || ! (number_equal(path_q->y_coord, pp->y_coord))) {
+ mp_back_error(
+ mp,
+ "Paths don't touch; '&' will be changed to '..'",
+ "When you join paths 'p & q', the ending point of p must be exactly equal to the\n"
+ "starting point of q. So I'm going to pretend that you said 'p .. q' instead."
+ );
+ mp_get_x_next(mp);
+ d = mp_path_join_command;
+ set_number_to_unity(path_q->right_tension);
+ set_number_to_unity(y);
+ }
+ }
+ if (mp_right_type(pp) == mp_open_knot && ((t == mp_curl_knot) || (t == mp_given_knot))) {
+ mp_right_type(pp) = (unsigned char) t;
+ number_clone(pp->right_given, x);
+ }
+ if (d == mp_ampersand_command) {
+ if (dd == mp_just_append_operation) {
+ mp_left_type(pp) = mp_explicit_knot;
+ mp_right_type(path_q) = mp_explicit_knot;
+ mp_prev_knot(pp) = path_q;
+ mp_next_knot(path_q) = pp;
+ number_clone(pp->left_x, path_q->x_coord);
+ number_clone(pp->left_y, path_q->y_coord);
+ number_clone(path_q->right_x, pp->x_coord);
+ number_clone(path_q->right_y, pp->y_coord);
+ mp_knotstate(pp) = mp_begin_knot;
+ mp_knotstate(path_q) = mp_end_knot;
+ path_q = pp;
+ } else {
+ if (mp_left_type(path_q) == mp_open_knot && mp_right_type(path_q) == mp_open_knot) {
+ mp_left_type(path_q) = mp_curl_knot;
+ set_number_to_unity(path_q->left_curl);
+ }
+ if (mp_right_type(pp) == mp_open_knot && t == mp_open_knot) {
+ mp_right_type(pp) = mp_curl_knot;
+ set_number_to_unity(pp->right_curl);
+ }
+ mp_right_type(path_q) = mp_right_type(pp);
+ mp_prev_knot(pp) = mp_next_knot(path_q);
+ mp_next_knot(path_q) = mp_next_knot(pp);
+ number_clone(path_q->right_x, pp->right_x);
+ number_clone(path_q->right_y, pp->right_y);
+ mp_memory_free(pp);
+ }
+ if (qq == pp) {
+ qq = path_q;
+ }
+ } else {
+ if (mp_right_type(path_q) == mp_open_knot && ((mp_left_type(path_q) == mp_curl_knot) || (mp_left_type(path_q) == mp_given_knot))) {
+ mp_right_type(path_q) = mp_left_type(path_q);
+ number_clone(path_q->right_given, path_q->left_given);
+ }
+ mp_prev_knot(pp) = path_q;
+ mp_next_knot(path_q) = pp;
+ number_clone(pp->left_y, y);
+ if (t != mp_open_knot) {
+ number_clone(pp->left_x, x);
+ mp_left_type(pp) = (unsigned char) t;
+ };
+ }
+ path_q = qq;
+ if (cur_cmd >= mp_min_expression_command && cur_cmd <= mp_ampersand_command && ! cycle_hit) {
+ goto CONTINUE_PATH;
+ }
+ FINISH_PATH:
+ if (cycle_hit) {
+ if (d == mp_ampersand_command) {
+ path_p = path_q;
+ }
+ } else {
+ mp_left_type(path_p) = mp_endpoint_knot;
+ if (mp_right_type(path_p) == mp_open_knot) {
+ mp_right_type(path_p) = mp_curl_knot;
+ set_number_to_unity(path_p->right_curl);
+ }
+ mp_right_type(path_q) = mp_endpoint_knot;
+ if (mp_left_type(path_q) == mp_open_knot) {
+ mp_left_type(path_q) = mp_curl_knot;
+ set_number_to_unity(path_q->left_curl);
+ }
+ mp_prev_knot(path_p) = path_q;
+ mp_next_knot(path_q) = path_p;
+ }
+ mp_make_choices(mp, path_p);
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, path_p);
+ free_number(x);
+ free_number(y);
+ return 1;
+}
+static void do_boolean_error (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ set_number_from_boolean(new_expr.data.n, mp_false_operation);
+ mp_back_error(
+ mp,
+ "Undefined condition will be treated as 'false'",
+ "The expression shown above should have had a definite true-or-false value. I'm\n"
+ "changing it to 'false'."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_boolean_type;
+}
+
+void mp_print_capsule (MP mp, mp_node p)
+{
+ mp_print_chr(mp, '(');
+ mp_print_exp(mp, p, 0);
+ mp_print_chr(mp, ')');
+}
+
+static void mp_close_files (MP mp)
+{
+ if (mp->rd_fname != NULL) {
+ for (int k = 0; k < (int) mp->read_files; k++) {
+ if (mp->rd_fname[k] != NULL) {
+ (mp->close_file)(mp, mp->rd_file[k]);
+ mp_memory_free(mp->rd_fname[k]);
+ mp->rd_fname[k] = NULL;
+ }
+ }
+ }
+ if (mp->wr_fname != NULL) {
+ for (int k = 0; k < (int) mp->write_files; k++) {
+ if (mp->wr_fname[k] != NULL) {
+ (mp->close_file)(mp, mp->wr_file[k]);
+ mp_memory_free(mp->wr_fname[k]);
+ mp->wr_fname[k] = NULL;
+ }
+ }
+ }
+}
+
+void mp_close_files_and_terminate (MP mp)
+{
+ if (mp->finished) {
+ return;
+ } else {
+ mp_close_files(mp);
+ wake_up_terminal();
+ mp_print_ln(mp);
+ mp->finished = 1;
+ }
+}
+
+void mp_final_cleanup (MP mp)
+{
+ while (mp->input_ptr > 0) {
+ if (token_state) {
+ mp_end_token_list(mp);
+ } else {
+ mp_end_file_reading(mp);
+ }
+ }
+ while (mp->loop_ptr != NULL) {
+ mp_stop_iteration(mp);
+ }
+ if (mp->interaction < mp_silent_mode) {
+ while (mp->open_parens > 0) {
+ mp_print_str(mp, " )");
+ --mp->open_parens;
+ }
+ }
+ while (mp->cond_ptr != NULL) {
+ mp_print_nl(mp, "(end occurred when ");
+ mp_print_cmd_mod(mp, mp_fi_or_else_command, mp->cur_if);
+ if (mp->if_line != 0) {
+ mp_print_str(mp, " on line ");
+ mp_print_int(mp, mp->if_line);
+ }
+ mp_print_str(mp, " was incomplete)");
+ mp->if_line = mp_if_line_field(mp->cond_ptr);
+ mp->cur_if = mp_name_type(mp->cond_ptr);
+ mp->cond_ptr = mp_link(mp->cond_ptr);
+ }
+ if (mp->history != mp_spotless) {
+ if (((mp->history == mp_warning_issued) || (mp->interaction < mp_error_stop_mode))) {
+ if (mp->selector == mp_term_and_log_selector) {
+ mp->selector = mp_term_only_selector;
+ mp_print_nl(mp, "(see the transcript file for additional information)");
+ mp->selector = mp_term_and_log_selector;
+ }
+ }
+ }
+}
+
+ void mp_init_prim (MP mp)
+{
+ mp_primitive(mp, "tracingtitles", mp_internal_command, mp_tracing_titles_internal);
+ mp_primitive(mp, "tracingequations", mp_internal_command, mp_tracing_equations_internal);
+ mp_primitive(mp, "tracingcapsules", mp_internal_command, mp_tracing_capsules_internal);
+ mp_primitive(mp, "tracingchoices", mp_internal_command, mp_tracing_choices_internal);
+ mp_primitive(mp, "tracingspecs", mp_internal_command, mp_tracing_specs_internal);
+ mp_primitive(mp, "tracingcommands", mp_internal_command, mp_tracing_commands_internal);
+ mp_primitive(mp, "tracingrestores", mp_internal_command, mp_tracing_restores_internal);
+ mp_primitive(mp, "tracingmacros", mp_internal_command, mp_tracing_macros_internal);
+ mp_primitive(mp, "tracingoutput", mp_internal_command, mp_tracing_output_internal);
+ mp_primitive(mp, "tracingstats", mp_internal_command, mp_tracing_stats_internal);
+ mp_primitive(mp, "tracingonline", mp_internal_command, mp_tracing_online_internal);
+ mp_primitive(mp, "year", mp_internal_command, mp_year_internal);
+ mp_primitive(mp, "month", mp_internal_command, mp_month_internal);
+ mp_primitive(mp, "day", mp_internal_command, mp_day_internal);
+ mp_primitive(mp, "time", mp_internal_command, mp_time_internal);
+ mp_primitive(mp, "hour", mp_internal_command, mp_hour_internal);
+ mp_primitive(mp, "minute", mp_internal_command, mp_minute_internal);
+ mp_primitive(mp, "charcode", mp_internal_command, mp_char_code_internal);
+ mp_primitive(mp, "charwd", mp_internal_command, mp_char_wd_internal);
+ mp_primitive(mp, "charht", mp_internal_command, mp_char_ht_internal);
+ mp_primitive(mp, "chardp", mp_internal_command, mp_char_dp_internal);
+ mp_primitive(mp, "charic", mp_internal_command, mp_char_ic_internal);
+ mp_primitive(mp, "pausing", mp_internal_command, mp_pausing_internal);
+ mp_primitive(mp, "showstopping", mp_internal_command, mp_showstopping_internal);
+ mp_primitive(mp, "texscriptmode", mp_internal_command, mp_texscriptmode_internal);
+ mp_primitive(mp, "overloadmode", mp_internal_command, mp_overloadmode_internal);
+ mp_primitive(mp, "linejoin", mp_internal_command, mp_linejoin_internal);
+ mp_primitive(mp, "linecap", mp_internal_command, mp_linecap_internal);
+ mp_primitive(mp, "stacking", mp_internal_command, mp_stacking_internal);
+ mp_primitive(mp, "miterlimit", mp_internal_command, mp_miterlimit_internal);
+ mp_primitive(mp, "warningcheck", mp_internal_command, mp_warning_check_internal);
+ mp_primitive(mp, "truecorners", mp_internal_command, mp_true_corners_internal);
+ mp_primitive(mp, "defaultcolormodel", mp_internal_command, mp_default_color_model_internal);
+ mp_primitive(mp, "restoreclipcolor", mp_internal_command, mp_restore_clip_color_internal);
+ mp_primitive(mp, "numbersystem", mp_internal_command, mp_number_system_internal);
+ mp_primitive(mp, "numberprecision", mp_internal_command, mp_number_precision_internal);
+ mp_primitive(mp, "jobname", mp_internal_command, mp_job_name_internal);
+ mp_primitive(mp, "..", mp_path_join_command, 0);
+ mp_primitive(mp, "[", mp_left_bracket_command, 0);
+ mp->frozen_left_bracket = mp_frozen_primitive (mp, "[", mp_left_bracket_command, 0);
+ mp_primitive(mp, "]", mp_right_bracket_command, 0);
+ mp_primitive(mp, "}", mp_right_brace_command, 0);
+ mp_primitive(mp, "{", mp_left_brace_command, 0);
+ mp_primitive(mp, ":", mp_colon_command, 0);
+ mp->frozen_colon = mp_frozen_primitive (mp, ":", mp_colon_command, 0);
+ mp_primitive(mp, ":=", mp_assignment_command, 0);
+ mp_primitive(mp, ",", mp_comma_command, 0);
+ mp_primitive(mp, ";", mp_semicolon_command, 0);
+ mp->frozen_semicolon = mp_frozen_primitive (mp, ";", mp_semicolon_command, 0);
+ mp_primitive(mp, "\\", mp_relax_command, 0);
+ mp_primitive(mp, "addto", mp_add_to_command, 0);
+ mp_primitive(mp, "atleast", mp_at_least_command, 0);
+ mp_primitive(mp, "begingroup", mp_begin_group_command, 0);
+ mp->bg_loc = cur_sym;
+ mp_primitive(mp, "controls", mp_controls_command, 0);
+ mp_primitive(mp, "curl", mp_curl_command, 0);
+ mp_primitive(mp, "delimiters", mp_delimiters_command, 0);
+ mp_primitive(mp, "endgroup", mp_end_group_command, 0);
+ mp->eg_loc = cur_sym;
+ mp->frozen_end_group = mp_frozen_primitive (mp, "endgroup", mp_end_group_command, 0);
+ mp_primitive(mp, "everyjob", mp_every_job_command, 0);
+ mp_primitive(mp, "exitif", mp_exit_test_command, 0);
+ mp_primitive(mp, "expandafter", mp_expand_after_command, 0);
+ mp_primitive(mp, "interim", mp_interim_command, 0);
+ mp_primitive(mp, "let", mp_let_command, 0);
+ mp_primitive(mp, "newinternal", mp_new_internal_command, 0);
+ mp_primitive(mp, "of", mp_of_command, 0);
+ mp_primitive(mp, "randomseed", mp_only_set_command, mp_random_seed_code);
+ mp_primitive(mp, "maxknotpool", mp_only_set_command, mp_max_knot_pool_code);
+ mp_primitive(mp, "save", mp_save_command, 0);
+ mp_primitive(mp, "scantokens", mp_scan_tokens_command, 0);
+ mp_primitive(mp, "runscript", mp_runscript_command, 0);
+ mp_primitive(mp, "maketext", mp_maketext_command, 0);
+ mp_primitive(mp, "shipout", mp_ship_out_command, 0);
+ mp_primitive(mp, "step", mp_step_command, 0);
+ mp_primitive(mp, "str", mp_str_command, 0);
+ mp_primitive(mp, "void", mp_void_command, 0);
+ mp_primitive(mp, "tension", mp_tension_command, 0);
+ mp_primitive(mp, "to", mp_to_command, 0);
+ mp_primitive(mp, "until", mp_until_command, 0);
+ mp_primitive(mp, "within", mp_within_command, 0);
+ mp_primitive(mp, "write", mp_write_command, 0);
+ mp_primitive(mp, "btex", mp_btex_command, mp_btex_code);
+ mp_primitive(mp, "verbatimtex", mp_btex_command, mp_verbatim_code);
+ mp_primitive(mp, "etex", mp_etex_command, 0);
+ mp->frozen_etex = mp_frozen_primitive (mp, "etex", mp_etex_command, 0);
+ mp_primitive(mp, "def", mp_macro_def_command, mp_def_code);
+ mp_primitive(mp, "vardef", mp_macro_def_command, mp_var_def_code);
+ mp_primitive(mp, "primarydef", mp_macro_def_command, mp_primary_def_code);
+ mp_primitive(mp, "secondarydef", mp_macro_def_command, mp_secondary_def_code);
+ mp_primitive(mp, "tertiarydef", mp_macro_def_command, mp_tertiary_def_code);
+ mp_primitive(mp, "enddef", mp_macro_def_command, mp_end_def_code);
+ mp->frozen_end_def = mp_frozen_primitive(mp, "enddef", mp_macro_def_command, mp_end_def_code);
+ mp_primitive(mp, "for", mp_iteration_command, mp_start_for_code);
+ mp_primitive(mp, "forsuffixes", mp_iteration_command, mp_start_forsuffixes_code);
+ mp_primitive(mp, "forever", mp_iteration_command, mp_start_forever_code);
+ mp_primitive(mp, "endfor", mp_iteration_command, mp_end_for_code);
+ mp->frozen_end_for = mp_frozen_primitive (mp, "endfor", mp_iteration_command, mp_end_for_code);
+ mp_primitive(mp, "quote", mp_macro_special_command, mp_macro_quote_code);
+ mp_primitive(mp, "#@", mp_macro_special_command, mp_macro_prefix_code);
+ mp_primitive(mp, "@", mp_macro_special_command, mp_macro_at_code);
+ mp_primitive(mp, "@#", mp_macro_special_command, mp_macro_suffix_code);
+ mp_primitive(mp, "expr", mp_parameter_commmand, mp_expr_parameter);
+ mp_primitive(mp, "suffix", mp_parameter_commmand, mp_suffix_parameter);
+ mp_primitive(mp, "text", mp_parameter_commmand, mp_text_parameter);
+ mp_primitive(mp, "primary", mp_parameter_commmand, mp_primary_macro);
+ mp_primitive(mp, "secondary", mp_parameter_commmand, mp_secondary_macro);
+ mp_primitive(mp, "tertiary", mp_parameter_commmand, mp_tertiary_macro);
+ mp_primitive(mp, "input", mp_input_command, 0);
+ mp_primitive(mp, "endinput", mp_input_command, 1);
+ mp_primitive(mp, "if", mp_if_test_command, mp_if_code);
+ mp_primitive(mp, "fi", mp_fi_or_else_command, mp_fi_code);
+ mp->frozen_fi = mp_frozen_primitive (mp, "fi", mp_fi_or_else_command, mp_fi_code);
+ mp_primitive(mp, "else", mp_fi_or_else_command, mp_else_code);
+ mp_primitive(mp, "elseif", mp_fi_or_else_command, mp_else_if_code);
+ mp_primitive(mp, "true", mp_nullary_command, mp_true_operation);
+ mp_primitive(mp, "false", mp_nullary_command, mp_false_operation);
+ mp_primitive(mp, "nullpicture", mp_nullary_command, mp_null_picture_operation);
+ mp_primitive(mp, "nullpen", mp_nullary_command, mp_null_pen_operation);
+ mp_primitive(mp, "readstring", mp_nullary_command, mp_read_string_operation);
+ mp_primitive(mp, "pencircle", mp_nullary_command, mp_pen_circle_operation);
+ mp_primitive(mp, "normaldeviate", mp_nullary_command, mp_normal_deviate_operation);
+ mp_primitive(mp, "readfrom", mp_unary_command, mp_read_from_operation);
+ mp_primitive(mp, "closefrom", mp_unary_command, mp_close_from_operation);
+ mp_primitive(mp, "odd", mp_unary_command, mp_odd_operation);
+ mp_primitive(mp, "known", mp_unary_command, mp_known_operation);
+ mp_primitive(mp, "unknown", mp_unary_command, mp_unknown_operation);
+ mp_primitive(mp, "not", mp_unary_command, mp_not_operation);
+ mp_primitive(mp, "decimal", mp_unary_command, mp_decimal_operation);
+ mp_primitive(mp, "reverse", mp_unary_command, mp_reverse_operation);
+ mp_primitive(mp, "uncycle", mp_unary_command, mp_uncycle_operation);
+ mp_primitive(mp, "makepath", mp_unary_command, mp_make_path_operation);
+ mp_primitive(mp, "makepen", mp_unary_command, mp_make_pen_operation);
+ mp_primitive(mp, "makenep", mp_unary_command, mp_make_nep_operation);
+ mp_primitive(mp, "convexed", mp_unary_command, mp_convexed_operation);
+ mp_primitive(mp, "uncontrolled", mp_unary_command, mp_uncontrolled_operation);
+ mp_primitive(mp, "oct", mp_unary_command, mp_oct_operation);
+ mp_primitive(mp, "hex", mp_unary_command, mp_hex_operation);
+ mp_primitive(mp, "ASCII", mp_unary_command, mp_ASCII_operation);
+ mp_primitive(mp, "char", mp_unary_command, mp_char_operation);
+ mp_primitive(mp, "length", mp_unary_command, mp_length_operation);
+ mp_primitive(mp, "turningnumber", mp_unary_command, mp_turning_operation);
+ mp_primitive(mp, "xpart", mp_unary_command, mp_x_part_operation);
+ mp_primitive(mp, "ypart", mp_unary_command, mp_y_part_operation);
+ mp_primitive(mp, "xxpart", mp_unary_command, mp_xx_part_operation);
+ mp_primitive(mp, "xypart", mp_unary_command, mp_xy_part_operation);
+ mp_primitive(mp, "yxpart", mp_unary_command, mp_yx_part_operation);
+ mp_primitive(mp, "yypart", mp_unary_command, mp_yy_part_operation);
+ mp_primitive(mp, "redpart", mp_unary_command, mp_red_part_operation);
+ mp_primitive(mp, "greenpart", mp_unary_command, mp_green_part_operation);
+ mp_primitive(mp, "bluepart", mp_unary_command, mp_blue_part_operation);
+ mp_primitive(mp, "cyanpart", mp_unary_command, mp_cyan_part_operation);
+ mp_primitive(mp, "magentapart", mp_unary_command, mp_magenta_part_operation);
+ mp_primitive(mp, "yellowpart", mp_unary_command, mp_yellow_part_operation);
+ mp_primitive(mp, "blackpart", mp_unary_command, mp_black_part_operation);
+ mp_primitive(mp, "greypart", mp_unary_command, mp_grey_part_operation);
+ mp_primitive(mp, "colormodel", mp_unary_command, mp_color_model_operation);
+ mp_primitive(mp, "prescriptpart", mp_unary_command, mp_prescript_part_operation);
+ mp_primitive(mp, "postscriptpart", mp_unary_command, mp_postscript_part_operation);
+ mp_primitive(mp, "stackingpart", mp_unary_command, mp_stacking_part_operation);
+ mp_primitive(mp, "pathpart", mp_unary_command, mp_path_part_operation);
+ mp_primitive(mp, "penpart", mp_unary_command, mp_pen_part_operation);
+ mp_primitive(mp, "dashpart", mp_unary_command, mp_dash_part_operation);
+ mp_primitive(mp, "sqrt", mp_unary_command, mp_sqrt_operation);
+ mp_primitive(mp, "mexp", mp_unary_command, mp_m_exp_operation);
+ mp_primitive(mp, "mlog", mp_unary_command, mp_m_log_operation);
+ mp_primitive(mp, "sind", mp_unary_command, mp_sin_d_operation);
+ mp_primitive(mp, "cosd", mp_unary_command, mp_cos_d_operation);
+ mp_primitive(mp, "floor", mp_unary_command, mp_floor_operation);
+ mp_primitive(mp, "uniformdeviate", mp_unary_command, mp_uniform_deviate_operation);
+ mp_primitive(mp, "llcorner", mp_unary_command, mp_ll_corner_operation);
+ mp_primitive(mp, "lrcorner", mp_unary_command, mp_lr_corner_operation);
+ mp_primitive(mp, "ulcorner", mp_unary_command, mp_ul_corner_operation);
+ mp_primitive(mp, "urcorner", mp_unary_command, mp_ur_corner_operation);
+ mp_primitive(mp, "centerof", mp_unary_command, mp_center_of_operation);
+ mp_primitive(mp, "centerofmass", mp_unary_command, mp_center_of_mass_operation);
+ mp_primitive(mp, "corners", mp_unary_command, mp_corners_operation);
+ mp_primitive(mp, "xrange", mp_unary_command, mp_x_range_operation);
+ mp_primitive(mp, "yrange", mp_unary_command, mp_y_range_operation);
+ mp_primitive(mp, "deltapoint", mp_unary_command, mp_delta_point_operation);
+ mp_primitive(mp, "deltaprecontrol", mp_unary_command, mp_delta_precontrol_operation);
+ mp_primitive(mp, "deltapostcontrol", mp_unary_command, mp_delta_postcontrol_operation);
+ mp_primitive(mp, "deltadirection", mp_unary_command, mp_delta_direction_operation);
+ mp_primitive(mp, "arclength", mp_unary_command, mp_arc_length_operation);
+ mp_primitive(mp, "angle", mp_unary_command, mp_angle_operation);
+ mp_primitive(mp, "cycle", mp_cycle_command, mp_cycle_operation);
+ mp_primitive(mp, "nocycle", mp_cycle_command, mp_no_cycle_operation);
+ mp_primitive(mp, "stroked", mp_unary_command, mp_stroked_operation);
+ mp_primitive(mp, "filled", mp_unary_command, mp_filled_operation);
+ mp_primitive(mp, "clipped", mp_unary_command, mp_clipped_operation);
+ mp_primitive(mp, "grouped", mp_unary_command, mp_grouped_operation);
+ mp_primitive(mp, "bounded", mp_unary_command, mp_bounded_operation);
+ mp_primitive(mp, "+", mp_plus_or_minus_command, mp_plus_operation);
+ mp_primitive(mp, "-", mp_plus_or_minus_command, mp_minus_operation);
+ mp_primitive(mp, "*", mp_secondary_binary_command, mp_times_operation);
+ mp_primitive(mp, "/", mp_slash_command, mp_over_operation);
+ mp->frozen_slash = mp_frozen_primitive (mp, "/", mp_slash_command, mp_over_operation);
+ mp_primitive(mp, "^", mp_secondary_binary_command, mp_power_operation);
+ mp_primitive(mp, "++", mp_tertiary_binary_command, mp_pythag_add_operation);
+ mp_primitive(mp, "+-+", mp_tertiary_binary_command, mp_pythag_sub_operation);
+ mp_primitive(mp, "or", mp_tertiary_binary_command, mp_or_operation);
+ mp_primitive(mp, "and", mp_and_command, mp_and_operation);
+ mp_primitive(mp, "<", mp_primary_binary_command, mp_less_than_operation);
+ mp_primitive(mp, "<=", mp_primary_binary_command, mp_less_or_equal_operation);
+ mp_primitive(mp, ">", mp_primary_binary_command, mp_greater_than_operation);
+ mp_primitive(mp, ">=", mp_primary_binary_command, mp_greater_or_equal_operation);
+ mp_primitive(mp, "=", mp_equals_command, mp_equal_operation);
+ mp_primitive(mp, "<>", mp_primary_binary_command, mp_unequal_operation);
+ mp_primitive(mp, "substring", mp_of_binary_command, mp_substring_operation);
+ mp_primitive(mp, "subpath", mp_of_binary_command, mp_subpath_operation);
+ mp_primitive(mp, "directiontime", mp_of_binary_command, mp_direction_time_operation);
+ mp_primitive(mp, "point", mp_of_binary_command, mp_point_operation);
+ mp_primitive(mp, "precontrol", mp_of_binary_command, mp_precontrol_operation);
+ mp_primitive(mp, "postcontrol", mp_of_binary_command, mp_postcontrol_operation);
+ mp_primitive(mp, "direction", mp_of_binary_command, mp_direction_operation);
+ mp_primitive(mp, "pathpoint", mp_nullary_command, mp_path_point_operation);
+ mp_primitive(mp, "pathprecontrol", mp_nullary_command, mp_path_precontrol_operation);
+ mp_primitive(mp, "pathpostcontrol", mp_nullary_command, mp_path_postcontrol_operation);
+ mp_primitive(mp, "pathdirection", mp_nullary_command, mp_path_direction_operation);
+ mp_primitive(mp, "penoffset", mp_of_binary_command, mp_pen_offset_operation);
+ mp_primitive(mp, "arctime", mp_of_binary_command, mp_arc_time_operation);
+ mp_primitive(mp, "arcpoint", mp_of_binary_command, mp_arc_point_operation);
+ mp_primitive(mp, "arcpointlist", mp_of_binary_command, mp_arc_point_list_operation);
+ mp_primitive(mp, "subarclength", mp_of_binary_command, mp_subarc_length_operation);
+ mp_primitive(mp, "mpversion", mp_nullary_command, mp_version_operation);
+ mp_primitive(mp, "&", mp_ampersand_command, mp_concatenate_operation);
+ mp_primitive(mp, "&&", mp_ampersand_command, mp_just_append_operation);
+ mp_primitive(mp, "rotated", mp_secondary_binary_command, mp_rotated_operation);
+ mp_primitive(mp, "slanted", mp_secondary_binary_command, mp_slanted_operation);
+ mp_primitive(mp, "scaled", mp_secondary_binary_command, mp_scaled_operation);
+ mp_primitive(mp, "shifted", mp_secondary_binary_command, mp_shifted_operation);
+ mp_primitive(mp, "transformed", mp_secondary_binary_command, mp_transformed_operation);
+ mp_primitive(mp, "xscaled", mp_secondary_binary_command, mp_x_scaled_operation);
+ mp_primitive(mp, "yscaled", mp_secondary_binary_command, mp_y_scaled_operation);
+ mp_primitive(mp, "zscaled", mp_secondary_binary_command, mp_z_scaled_operation);
+ mp_primitive(mp, "intersectiontimes", mp_tertiary_binary_command, mp_intertimes_operation);
+ mp_primitive(mp, "intersectiontimeslist", mp_tertiary_binary_command, mp_intertimes_list_operation);
+ mp_primitive(mp, "envelope", mp_of_binary_command, mp_envelope_operation);
+ mp_primitive(mp, "boundingpath", mp_of_binary_command, mp_boundingpath_operation);
+ mp_primitive(mp, "numeric", mp_type_name_command, mp_numeric_type_operation);
+ mp_primitive(mp, "string", mp_type_name_command, mp_string_type_operation);
+ mp_primitive(mp, "boolean", mp_type_name_command, mp_boolean_type_operation);
+ mp_primitive(mp, "path", mp_type_name_command, mp_path_type_operation);
+ mp_primitive(mp, "pen", mp_type_name_command, mp_pen_type_operation);
+ mp_primitive(mp, "nep", mp_type_name_command, mp_nep_type_operation);
+ mp_primitive(mp, "picture", mp_type_name_command, mp_picture_type_operation);
+ mp_primitive(mp, "transform", mp_type_name_command, mp_transform_type_operation);
+ mp_primitive(mp, "color", mp_type_name_command, mp_color_type_operation);
+ mp_primitive(mp, "rgbcolor", mp_type_name_command, mp_color_type_operation);
+ mp_primitive(mp, "cmykcolor", mp_type_name_command, mp_cmykcolor_type_operation);
+ mp_primitive(mp, "pair", mp_type_name_command, mp_pair_type_operation);
+ mp_primitive(mp, "end", mp_stop_command, 0);
+ mp_primitive(mp, "dump", mp_stop_command, 1);
+ mp->frozen_dump = mp_frozen_primitive (mp, "dump", mp_stop_command, 1);
+ mp_primitive(mp, "batchmode", mp_mode_command, mp_batch_mode);
+ mp_primitive(mp, "nonstopmode", mp_mode_command, mp_nonstop_mode);
+ mp_primitive(mp, "scrollmode", mp_mode_command, mp_scroll_mode);
+ mp_primitive(mp, "errorstopmode", mp_mode_command, mp_error_stop_mode);
+ mp_primitive(mp, "silentmode", mp_mode_command, mp_silent_mode);
+ mp_primitive(mp, "inner", mp_protection_command, 0);
+ mp_primitive(mp, "outer", mp_protection_command, 1);
+ mp_primitive(mp, "setproperty", mp_property_command, 1);
+ mp_primitive(mp, "showtoken", mp_show_command, mp_show_token_code);
+ mp_primitive(mp, "showstats", mp_show_command, mp_show_stats_code);
+ mp_primitive(mp, "show", mp_show_command, mp_show_code);
+ mp_primitive(mp, "showvariable", mp_show_command, mp_show_var_code);
+ mp_primitive(mp, "showdependencies", mp_show_command, mp_show_dependencies_code);
+ mp_primitive(mp, "doublepath", mp_thing_to_add_command, mp_add_double_path_code);
+ mp_primitive(mp, "contour", mp_thing_to_add_command, mp_add_contour_code);
+ mp_primitive(mp, "also", mp_thing_to_add_command, mp_add_also_code);
+ mp_primitive(mp, "withpen", mp_with_option_command, mp_with_pen_code);
+ mp_primitive(mp, "dashed", mp_with_option_command, mp_with_dashed_code);
+ mp_primitive(mp, "withprescript", mp_with_option_command, mp_with_pre_script_code);
+ mp_primitive(mp, "withpostscript", mp_with_option_command, mp_with_post_script_code);
+ mp_primitive(mp, "withstacking", mp_with_option_command, mp_with_stacking_code);
+ mp_primitive(mp, "withlinecap", mp_with_option_command, mp_with_linecap_code);
+ mp_primitive(mp, "withlinejoin", mp_with_option_command, mp_with_linejoin_code);
+ mp_primitive(mp, "withmiterlimit", mp_with_option_command, mp_with_miterlimit_code);
+ mp_primitive(mp, "withoutcolor", mp_with_option_command, mp_with_no_model_code);
+ mp_primitive(mp, "withgreyscale", mp_with_option_command, mp_with_grey_model_code);
+ mp_primitive(mp, "withcolor", mp_with_option_command, mp_with_uninitialized_model_code);
+ mp_primitive(mp, "withrgbcolor", mp_with_option_command, mp_with_rgb_model_code);
+ mp_primitive(mp, "withcmykcolor", mp_with_option_command, mp_with_cmyk_model_code);
+ mp_primitive(mp, "clip", mp_bounds_command, mp_start_clip_node_type);
+ mp_primitive(mp, "setgroup", mp_bounds_command, mp_start_group_node_type);
+ mp_primitive(mp, "setbounds", mp_bounds_command, mp_start_bounds_node_type);
+ mp_primitive(mp, "message", mp_message_command, message_code);
+ mp_primitive(mp, "errmessage", mp_message_command, err_message_code);
+ mp_primitive(mp, "errhelp", mp_message_command, err_help_code);
+
+}
+
+ void mp_init_tab (MP mp)
+{
+ mp->spec_head = mp_new_symbolic_node(mp);
+ mp->temp_head = mp_new_symbolic_node(mp);
+ mp->hold_head = mp_new_symbolic_node(mp);
+ number_clone(internal_value(mp_default_color_model_internal),unity_t);
+ number_multiply_int(internal_value(mp_default_color_model_internal), mp_rgb_model);
+ number_clone(internal_value(mp_restore_clip_color_internal), unity_t);
+ set_internal_string(mp_number_system_internal, mp_intern (mp, "scaled"));
+ number_clone(internal_value(mp_number_precision_internal), precision_default);
+ number_clone(internal_value(mp_texscriptmode_internal), unity_t);
+ number_clone(internal_value(mp_overloadmode_internal), zero_t);
+ set_internal_name(mp_tracing_titles_internal, mp_strdup("tracingtitles"));
+ set_internal_name(mp_tracing_equations_internal, mp_strdup("tracingequations"));
+ set_internal_name(mp_tracing_capsules_internal, mp_strdup("tracingcapsules"));
+ set_internal_name(mp_tracing_choices_internal, mp_strdup("tracingchoices"));
+ set_internal_name(mp_tracing_specs_internal, mp_strdup("tracingspecs"));
+ set_internal_name(mp_tracing_commands_internal, mp_strdup("tracingcommands"));
+ set_internal_name(mp_tracing_restores_internal, mp_strdup("tracingrestores"));
+ set_internal_name(mp_tracing_macros_internal, mp_strdup("tracingmacros"));
+ set_internal_name(mp_tracing_output_internal, mp_strdup("tracingoutput"));
+ set_internal_name(mp_tracing_stats_internal, mp_strdup("tracingstats"));
+ set_internal_name(mp_tracing_online_internal, mp_strdup("tracingonline"));
+ set_internal_name(mp_year_internal, mp_strdup("year"));
+ set_internal_name(mp_month_internal, mp_strdup("month"));
+ set_internal_name(mp_day_internal, mp_strdup("day"));
+ set_internal_name(mp_time_internal, mp_strdup("time"));
+ set_internal_name(mp_hour_internal, mp_strdup("hour"));
+ set_internal_name(mp_minute_internal, mp_strdup("minute"));
+ set_internal_name(mp_char_code_internal, mp_strdup("charcode"));
+ set_internal_name(mp_char_wd_internal, mp_strdup("charwd"));
+ set_internal_name(mp_char_ht_internal, mp_strdup("charht"));
+ set_internal_name(mp_char_dp_internal, mp_strdup("chardp"));
+ set_internal_name(mp_char_ic_internal, mp_strdup("charic"));
+ set_internal_name(mp_pausing_internal, mp_strdup("pausing"));
+ set_internal_name(mp_showstopping_internal, mp_strdup("showstopping"));
+ set_internal_name(mp_texscriptmode_internal, mp_strdup("texscriptmode"));
+ set_internal_name(mp_overloadmode_internal, mp_strdup("overloadmode"));
+ set_internal_name(mp_linejoin_internal, mp_strdup("linejoin"));
+ set_internal_name(mp_linecap_internal, mp_strdup("linecap"));
+ set_internal_name(mp_stacking_internal, mp_strdup("stacking"));
+ set_internal_name(mp_miterlimit_internal, mp_strdup("miterlimit"));
+ set_internal_name(mp_warning_check_internal, mp_strdup("warningcheck"));
+ set_internal_name(mp_true_corners_internal, mp_strdup("truecorners"));
+ set_internal_name(mp_default_color_model_internal, mp_strdup("defaultcolormodel"));
+ set_internal_name(mp_restore_clip_color_internal, mp_strdup("restoreclipcolor"));
+ set_internal_name(mp_job_name_internal, mp_strdup("jobname"));
+ set_internal_name(mp_number_system_internal, mp_strdup("numbersystem"));
+ set_internal_name(mp_number_precision_internal, mp_strdup("numberprecision"));
+ mp->id_lookup_test = new_symbols_entry(mp, NULL, 0);
+ mp->st_count = 0;
+ mp->frozen_bad_vardef = mp_frozen_primitive(mp, "a bad variable", mp_tag_command, 0);
+ mp->frozen_right_delimiter = mp_frozen_primitive(mp, ")", mp_right_delimiter_command, 0);
+ mp->frozen_inaccessible = mp_frozen_primitive(mp, " INACCESSIBLE", mp_tag_command, 0);
+ mp->frozen_undefined = mp_frozen_primitive(mp, " UNDEFINED", mp_tag_command, 0);
+ mp->end_attr = (mp_node) mp_get_attribute_node(mp);
+ mp_set_hashloc(mp->end_attr, (mp_sym)-1);
+ mp_set_parent((mp_value_node) mp->end_attr, NULL);
+ new_fraction(mp->st);
+ new_fraction(mp->ct);
+ new_fraction(mp->sf);
+ new_fraction(mp->cf);
+ for (int i = 0; i <= mp_y_code; i++) {
+ new_number(mp->bbmin[i]);
+ new_number(mp->bbmax[i]);
+ }
+ new_number(mp->cur_x);
+ new_number(mp->cur_y);
+ mp->null_dash = mp_get_dash_node(mp);
+ new_number(mp->cur_t);
+ new_number(mp->cur_tt);
+ new_number(mp->max_t);
+ new_number(mp->delx);
+ new_number(mp->dely);
+ new_number(mp->appr_t);
+ new_number(mp->appr_tt);
+ mp->serial_no = 0;
+ mp->dep_head = mp_get_dep_node(mp);
+ mp_set_link(mp->dep_head, mp->dep_head);
+ mp_set_prev_dep(mp->dep_head, mp->dep_head);
+ mp_set_dep_info(mp->dep_head, NULL);
+ mp_set_dep_list(mp->dep_head, NULL);
+ mp->cur_mod_ = mp_new_symbolic_node(mp);
+ mp->bad_vardef = mp_new_value_node(mp);
+ mp_name_type(mp->bad_vardef) = mp_root_operation;
+ mp_set_value_sym(mp->bad_vardef, mp->frozen_bad_vardef);
+ mp->frozen_repeat_loop =
+
+ mp_frozen_primitive (mp, " ENDFOR", mp_repeat_loop_command, 0);
+ for (int i = 0; i < mp_proto_dependent_type + 1; i++) {
+ new_number(mp->max_c[i]);
+ }
+ mp->temp_val = mp_new_value_node(mp);
+ mp_name_type(mp->temp_val) = mp_capsule_operation;
+ new_number(mp->txx);
+ new_number(mp->txy);
+ new_number(mp->tyx);
+ new_number(mp->tyy);
+ new_number(mp->tx);
+ new_number(mp->ty);
+ mp->inf_val = mp_new_value_node(mp);
+ mp_set_value_number(mp->inf_val, fraction_four_t);
+ mp->zero_val = mp_new_value_node(mp);
+ mp_set_value_number(mp->zero_val, zero_t);
+
+}
+
diff --git a/source/luametatex/source/mp/mpc/mp.h b/source/luametatex/source/mp/mpc/mp.h
new file mode 100644
index 000000000..252a625aa
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mp.h
@@ -0,0 +1,1514 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# ifndef MP_H
+# define MP_H 1
+
+# include "avl.h"
+# include "auxmemory.h"
+# include <string.h>
+# include <setjmp.h>
+
+# define metapost_version "3.14"
+
+typedef struct MP_instance *MP;
+typedef enum mp_number_type {
+ mp_nan_type,
+ mp_scaled_type,
+ mp_fraction_type,
+ mp_angle_type,
+ mp_double_type,
+ mp_binary_type,
+ mp_decimal_type
+} mp_number_type;
+typedef union mp_number_store {
+ void *num;
+ double dval;
+ int val;
+} mp_number_store;
+typedef struct mp_number_data {
+ mp_number_store data;
+ mp_number_type type;
+} mp_number_data;
+typedef struct mp_number_data mp_number;
+# define is_number(A) ((A).type != mp_nan_type)
+enum mp_filetype {
+ mp_filetype_terminal,
+ mp_filetype_program,
+ mp_filetype_text
+};
+typedef char *(*mp_file_finder) (MP, const char *, const char *, int);
+typedef char *(*mp_script_runner) (MP, const char *m, size_t len, int n);
+typedef void (*mp_internal_runner) (MP, int action, int n, int type, const char *iname);
+typedef void (*mp_log_runner) (MP, int, const char *s, size_t l);
+typedef int (*mp_overload_runner) (MP, int, const char *, int);
+typedef void (*mp_error_runner) (MP, const char *, const char *, int);
+typedef void (*mp_warning_runner) (MP, const char *);
+typedef char *(*mp_text_maker) (MP, const char *, size_t, int);
+typedef void *(*mp_file_opener) (MP, const char *, const char *, int);
+typedef char *(*mp_file_reader) (MP, void *, size_t *);
+typedef void (*mp_file_closer) (MP, void *);
+typedef int (*mp_file_eoftest) (MP, void *);
+typedef void (*mp_file_flush) (MP, void *);
+typedef void (*mp_file_writer) (MP, void *, const char *);
+typedef struct mp_lstring {
+ unsigned char *str;
+ size_t len;
+ int refs;
+} mp_lstring;
+typedef mp_lstring *mp_string;
+enum mp_interaction_mode {
+ mp_unspecified_mode,
+ mp_batch_mode,
+ mp_nonstop_mode,
+ mp_scroll_mode,
+ mp_error_stop_mode,
+ mp_silent_mode
+};
+enum mp_history_state {
+ mp_spotless,
+ mp_warning_issued,
+ mp_error_message_issued,
+ mp_fatal_error_stop,
+ mp_system_error_stop
+};
+typedef enum mp_math_mode {
+ mp_math_scaled_mode,
+ mp_math_double_mode,
+ mp_math_binary_mode,
+ mp_math_decimal_mode
+} mp_math_mode;
+typedef struct mp_knot_data *mp_knot;
+typedef struct mp_knot_data {
+ mp_number x_coord;
+ mp_number y_coord;
+ union {
+ mp_number left_x;
+ mp_number left_curl;
+ mp_number left_given;
+ };
+ union {
+ mp_number left_y;
+ mp_number left_tension;
+ };
+ union {
+ mp_number right_x;
+ mp_number right_curl;
+ mp_number right_given;
+ };
+ union {
+ mp_number right_y;
+ mp_number right_tension;
+ };
+ mp_knot next;
+ mp_knot prev;
+ unsigned char left_type;
+ unsigned char right_type;
+ unsigned char originator;
+ unsigned char state;
+ signed int info;
+} mp_knot_data;
+typedef struct mp_gr_knot_data *mp_gr_knot;
+typedef struct mp_gr_knot_data {
+ double x_coord;
+ double y_coord;
+ double left_x;
+ double left_y;
+ double right_x;
+ double right_y;
+ mp_gr_knot next;
+ mp_gr_knot prev;
+ unsigned char left_type;
+ unsigned char right_type;
+ unsigned char originator;
+ unsigned char state;
+ signed int info;
+} mp_gr_knot_data;
+enum mp_knot_originator {
+ mp_program_code,
+ mp_metapost_user
+};
+enum mp_knot_states {
+ mp_regular_knot,
+ mp_begin_knot,
+ mp_end_knot,
+ mp_single_knot,
+};
+# undef term_in
+# undef term_out
+typedef struct mp_run_data
+{
+ void *term_in;
+ struct mp_edge_object *edges;
+} mp_run_data;
+typedef struct mp_color {
+ double a_val;
+ double b_val;
+ double c_val;
+ double d_val;
+} mp_color;
+typedef struct mp_dash_object {
+ double offset;
+ double *array;
+} mp_dash_object;
+typedef struct mp_graphic_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+} mp_graphic_object;
+typedef struct mp_shape_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+ char *pre_script;
+ char *post_script;
+ size_t pre_length;
+ size_t post_length;
+ mp_color color;
+ mp_gr_knot path;
+ mp_gr_knot htap;
+ mp_gr_knot pen;
+ double miterlimit;
+ mp_dash_object *dash;
+ unsigned char color_model;
+ unsigned char linejoin;
+ unsigned char linecap;
+ unsigned char padding;
+} mp_shape_object;
+typedef struct mp_start_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+ char *pre_script;
+ char *post_script;
+ size_t pre_length;
+ size_t post_length;
+ mp_gr_knot path;
+} mp_start_object;
+typedef struct mp_stop_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+ char *pre_script;
+ char *post_script;
+ size_t pre_length;
+ size_t post_length;
+ mp_gr_knot path;
+} mp_stop_object;
+typedef struct mp_edge_object {
+ struct mp_graphic_object *body;
+ struct mp_edge_object *next;
+ MP parent;
+ double minx;
+ double miny;
+ double maxx;
+ double maxy;
+ double width;
+ double height;
+ double depth;
+ double italic;
+ int charcode;
+ int padding;
+} mp_edge_object;
+typedef void (*mp_backend_writer) (MP, void *);
+
+typedef struct MP_options {
+ int halt_on_error;
+ void *userdata;
+ char *banner;
+ int utf8_mode;
+ int text_mode;
+ int show_mode;
+ mp_file_finder find_file;
+ mp_script_runner run_script;
+ mp_internal_runner run_internal;
+ mp_log_runner run_logger;
+ mp_overload_runner run_overload;
+ mp_error_runner run_error;
+ mp_warning_runner run_warning;
+ mp_text_maker make_text;
+ mp_file_opener open_file;
+ mp_file_closer close_file;
+ mp_file_reader read_file;
+ mp_file_writer write_file;
+ int find_file_id;
+ int run_script_id;
+ int run_internal_id;
+ int run_logger_id;
+ int run_overload_id;
+ int run_error_id;
+ int run_warning_id;
+ int make_text_id;
+ int open_file_id;
+ int interaction;
+ int extensions;
+ int random_seed;
+ int math_mode;
+ char *job_name;
+ mp_backend_writer shipout_backend;
+
+} MP_options;
+extern MP_options *mp_options (void);
+extern MP mp_initialize (MP_options * opt);
+extern int mp_status (MP mp);
+extern int mp_finished (MP mp);
+extern void *mp_userdata (MP mp);
+extern void mp_print_e_str (MP mp, const char *s);
+extern void mp_print_e_chr (MP mp, unsigned char k);
+extern void mp_show_context (MP mp);
+extern void mp_error (MP mp, const char *msg, const char *hlp);
+extern void mp_warn (MP mp, const char *msg);
+extern void mp_fatal_error (MP mp, const char *s);
+extern int mp_initialize_symbol_traverse (MP mp);
+extern void mp_kill_symbol_traverse (MP mp);
+extern void *mp_fetch_symbol_traverse (MP mp);
+extern void *mp_fetch_symbol (MP mp, char *s);
+int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q);
+int mp_close_path (MP mp, mp_knot q, mp_knot first);
+mp_knot mp_create_knot (MP mp);
+int mp_set_knot (MP mp, mp_knot p, double x, double y);
+mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y);
+mp_knot mp_append_knot_xy (MP mp, mp_knot p, double x, double y);
+int mp_set_knot_curl (MP mp, mp_knot q, double value);
+int mp_set_knot_left_curl (MP mp, mp_knot q, double value);
+int mp_set_knot_right_curl (MP mp, mp_knot q, double value);
+int mp_set_knot_simple_curl (MP mp, mp_knot q);
+int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2) ;
+int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2) ;
+int mp_set_knot_left_tension (MP mp, mp_knot p, double t1);
+int mp_set_knot_right_tension (MP mp, mp_knot p, double t1);
+int mp_set_knot_left_control (MP mp, mp_knot p, double t1, double t2);
+int mp_set_knot_right_control (MP mp, mp_knot p, double t1, double t2);
+int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) ;
+int mp_set_knot_direction (MP mp, mp_knot q, double x, double y) ;
+int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) ;
+int mp_solve_path (MP mp, mp_knot first);
+void mp_free_path (MP mp, mp_knot p);
+double mp_number_as_double (MP mp, mp_number n);
+void mp_set_internal (MP mp, char *n, char *v, int isstring);
+void mplib_shipout_backend (MP mp, void *h);
+extern mp_run_data *mp_rundata (MP mp);
+int mp_run (MP mp);
+int mp_execute (MP mp, const char *s, size_t l);
+int mp_finish (MP mp);
+char *mp_metapost_version (void);
+void mp_scan_next_value (MP mp, int keep, int *token, int *mode, int *kind);
+void mp_scan_expr_value (MP mp, int keep, int *kind);
+void mp_scan_token_value (MP mp, int keep, int *token, int *mode, int *kind);
+void mp_scan_symbol_value (MP mp, int keep, char **s, int expand);
+void mp_scan_property_value (MP mp, int keep, int *kind, char **s, int *property, int *detail);
+int mp_skip_token_value (MP mp, int token);
+void mp_scan_numeric_value (MP mp, int primary, double *d);
+void mp_scan_boolean_value (MP mp, int primary, int *b);
+void mp_scan_string_value (MP mp, int primary, char **s, size_t *l);
+void mp_scan_pair_value (MP mp, int primary, double *x, double *y);
+void mp_scan_color_value (MP mp, int primary, double *r, double *g, double *b);
+void mp_scan_cmykcolor_value (MP mp, int primary, double *c, double *m, double *y, double *k);
+void mp_scan_transform_value (MP mp, int primary, double *x, double *y, double *xx, double *xy, double *yx, double *yy);
+void mp_scan_path_value (MP mp, int primary, mp_knot *k);
+void mp_push_numeric_value (MP mp, double n);
+void mp_push_integer_value (MP mp, int i);
+void mp_push_boolean_value (MP mp, int b);
+void mp_push_string_value (MP mp, const char *s, int l);
+void mp_push_pair_value (MP mp, double x, double y);
+void mp_push_color_value (MP mp, double r, double g, double b);
+void mp_push_cmykcolor_value (MP mp, double c, double m, double y, double k);
+void mp_push_transform_value (MP mp, double x, double y, double xx, double xy, double yx, double yy);
+void mp_push_path_value (MP mp, mp_knot k);
+
+typedef enum mp_color_model {
+ mp_no_model,
+ mp_grey_model,
+ mp_rgb_model,
+ mp_cmyk_model,
+ mp_uninitialized_model,
+} mp_color_model;
+typedef enum mp_knot_type {
+ mp_endpoint_knot,
+ mp_explicit_knot,
+ mp_given_knot,
+ mp_curl_knot,
+ mp_open_knot,
+ mp_end_cycle_knot
+} mp_knot_type;
+enum mp_graphical_object_code {
+ mp_unset_code,
+ mp_fill_code,
+ mp_stroked_code,
+ mp_start_clip_code,
+ mp_start_group_code,
+ mp_start_bounds_code,
+ mp_stop_clip_code,
+ mp_stop_group_code,
+ mp_stop_bounds_code,
+ mp_final_graphic
+};
+
+extern void *mp_memory_allocate (size_t size);
+extern void *mp_memory_clear_allocate (size_t size);
+extern void *mp_memory_reallocate (void *p, size_t size);
+extern void mp_memory_free (void *p);
+extern void *mp_allocate_node (MP mp, size_t size);
+extern void *mp_allocate_dash (MP mp);
+
+typedef enum mp_command_code {
+ mp_undefined_command,
+ mp_btex_command,
+ mp_etex_command,
+ mp_if_test_command,
+ mp_fi_or_else_command,
+ mp_input_command,
+ mp_iteration_command,
+ mp_repeat_loop_command,
+ mp_exit_test_command,
+ mp_relax_command,
+ mp_scan_tokens_command,
+ mp_runscript_command,
+ mp_maketext_command,
+ mp_expand_after_command,
+ mp_defined_macro_command,
+ mp_save_command,
+ mp_interim_command,
+ mp_let_command,
+ mp_new_internal_command,
+ mp_macro_def_command,
+ mp_ship_out_command,
+ mp_add_to_command,
+ mp_bounds_command,
+ mp_protection_command,
+ mp_property_command,
+ mp_show_command,
+ mp_mode_command,
+ mp_only_set_command,
+ mp_message_command,
+ mp_every_job_command,
+ mp_delimiters_command,
+ mp_write_command,
+ mp_type_name_command,
+ mp_left_delimiter_command,
+ mp_begin_group_command,
+ mp_nullary_command,
+ mp_unary_command,
+ mp_str_command,
+ mp_void_command,
+ mp_cycle_command,
+ mp_of_binary_command,
+ mp_capsule_command,
+ mp_string_command,
+ mp_internal_command,
+ mp_tag_command,
+ mp_numeric_command,
+ mp_plus_or_minus_command,
+ mp_secondary_def_command,
+ mp_tertiary_binary_command,
+ mp_left_brace_command,
+ mp_path_join_command,
+ mp_ampersand_command,
+ mp_tertiary_def_command,
+ mp_primary_binary_command,
+ mp_equals_command,
+ mp_and_command,
+ mp_primary_def_command,
+ mp_slash_command,
+ mp_secondary_binary_command,
+ mp_parameter_commmand,
+ mp_controls_command,
+ mp_tension_command,
+ mp_at_least_command,
+ mp_curl_command,
+ mp_macro_special_command,
+ mp_right_delimiter_command,
+ mp_left_bracket_command,
+ mp_right_bracket_command,
+ mp_right_brace_command,
+ mp_with_option_command,
+ mp_thing_to_add_command,
+ mp_of_command,
+ mp_to_command,
+ mp_step_command,
+ mp_until_command,
+ mp_within_command,
+ mp_assignment_command,
+ mp_colon_command,
+ mp_comma_command,
+ mp_semicolon_command,
+ mp_end_group_command,
+ mp_stop_command,
+
+ mp_undefined_cs_command,
+} mp_command_code;
+typedef enum mp_variable_type {
+ mp_undefined_type,
+ mp_vacuous_type,
+ mp_boolean_type,
+ mp_unknown_boolean_type,
+ mp_string_type,
+ mp_unknown_string_type,
+ mp_pen_type,
+ mp_unknown_pen_type,
+ mp_nep_type,
+ mp_unknown_nep_type,
+ mp_path_type,
+ mp_unknown_path_type,
+ mp_picture_type,
+ mp_unknown_picture_type,
+ mp_transform_type,
+ mp_color_type,
+ mp_cmykcolor_type,
+ mp_pair_type,
+ mp_numeric_type,
+ mp_known_type,
+ mp_dependent_type,
+ mp_proto_dependent_type,
+ mp_independent_type,
+ mp_token_list_type,
+ mp_structured_type,
+ mp_unsuffixed_macro_type,
+ mp_suffixed_macro_type,
+ mp_symbol_node_type,
+ mp_token_node_type,
+ mp_value_node_type,
+ mp_attribute_node_type,
+ mp_subscript_node_type,
+ mp_pair_node_type,
+ mp_transform_node_type,
+ mp_color_node_type,
+ mp_cmykcolor_node_type,
+ mp_fill_node_type,
+ mp_stroked_node_type,
+ mp_start_clip_node_type,
+ mp_start_group_node_type,
+ mp_start_bounds_node_type,
+ mp_stop_clip_node_type,
+ mp_stop_group_node_type,
+ mp_stop_bounds_node_type,
+ mp_dash_node_type,
+ mp_dep_node_type,
+ mp_if_node_type,
+ mp_edge_header_node_type,
+} mp_variable_type;
+typedef enum mp_name_type_type {
+ mp_root_operation,
+ mp_saved_root_operation,
+ mp_structured_root_operation,
+ mp_subscript_operation,
+ mp_attribute_operation,
+ mp_x_part_operation,
+ mp_y_part_operation,
+ mp_xx_part_operation,
+ mp_xy_part_operation,
+ mp_yx_part_operation,
+ mp_yy_part_operation,
+ mp_red_part_operation,
+ mp_green_part_operation,
+ mp_blue_part_operation,
+ mp_cyan_part_operation,
+ mp_magenta_part_operation,
+ mp_yellow_part_operation,
+ mp_black_part_operation,
+ mp_grey_part_operation,
+ mp_capsule_operation,
+ mp_token_operation,
+ mp_boolean_type_operation,
+ mp_string_type_operation,
+ mp_pen_type_operation,
+ mp_nep_type_operation,
+ mp_path_type_operation,
+ mp_picture_type_operation,
+ mp_transform_type_operation,
+ mp_color_type_operation,
+ mp_cmykcolor_type_operation,
+ mp_pair_type_operation,
+ mp_numeric_type_operation,
+ mp_normal_operation,
+ mp_internal_operation,
+ mp_macro_operation,
+ mp_expr_operation,
+ mp_suffix_operation,
+ mp_text_operation,
+ mp_true_operation,
+ mp_false_operation,
+ mp_null_picture_operation,
+ mp_null_pen_operation,
+ mp_read_string_operation,
+ mp_pen_circle_operation,
+ mp_normal_deviate_operation,
+ mp_read_from_operation,
+ mp_close_from_operation,
+ mp_odd_operation,
+ mp_known_operation,
+ mp_unknown_operation,
+ mp_not_operation,
+ mp_decimal_operation,
+ mp_reverse_operation,
+ mp_uncycle_operation,
+ mp_make_path_operation,
+ mp_make_pen_operation,
+ mp_make_nep_operation,
+ mp_convexed_operation,
+ mp_uncontrolled_operation,
+ mp_oct_operation,
+ mp_hex_operation,
+ mp_ASCII_operation,
+ mp_char_operation,
+ mp_length_operation,
+ mp_turning_operation,
+ mp_color_model_operation,
+ mp_path_part_operation,
+ mp_pen_part_operation,
+ mp_dash_part_operation,
+ mp_prescript_part_operation,
+ mp_postscript_part_operation,
+ mp_stacking_part_operation,
+ mp_sqrt_operation,
+ mp_m_exp_operation,
+ mp_m_log_operation,
+ mp_sin_d_operation,
+ mp_cos_d_operation,
+ mp_floor_operation,
+ mp_uniform_deviate_operation,
+ mp_ll_corner_operation,
+ mp_lr_corner_operation,
+ mp_ul_corner_operation,
+ mp_ur_corner_operation,
+ mp_center_of_operation,
+ mp_center_of_mass_operation,
+ mp_corners_operation,
+ mp_x_range_operation,
+ mp_y_range_operation,
+ mp_delta_point_operation,
+ mp_delta_precontrol_operation,
+ mp_delta_postcontrol_operation,
+ mp_delta_direction_operation,
+ mp_arc_length_operation,
+ mp_angle_operation,
+ mp_cycle_operation,
+ mp_no_cycle_operation,
+ mp_filled_operation,
+ mp_stroked_operation,
+ mp_clipped_operation,
+ mp_grouped_operation,
+ mp_bounded_operation,
+ mp_plus_operation,
+ mp_minus_operation,
+ mp_times_operation,
+ mp_over_operation,
+ mp_power_operation,
+ mp_pythag_add_operation,
+ mp_pythag_sub_operation,
+ mp_or_operation,
+ mp_and_operation,
+ mp_less_than_operation,
+ mp_less_or_equal_operation,
+ mp_greater_than_operation,
+ mp_greater_or_equal_operation,
+ mp_equal_operation,
+ mp_unequal_operation,
+ mp_concatenate_operation,
+ mp_just_append_operation,
+ mp_rotated_operation,
+ mp_slanted_operation,
+ mp_scaled_operation,
+ mp_shifted_operation,
+ mp_transformed_operation,
+ mp_uncycled_operation,
+ mp_x_scaled_operation,
+ mp_y_scaled_operation,
+ mp_z_scaled_operation,
+ mp_intertimes_operation,
+ mp_intertimes_list_operation,
+ mp_double_dot_operation,
+ mp_substring_operation,
+ mp_subpath_operation,
+ mp_direction_time_operation,
+ mp_point_operation,
+ mp_precontrol_operation,
+ mp_postcontrol_operation,
+ mp_direction_operation,
+ mp_path_point_operation,
+ mp_path_precontrol_operation,
+ mp_path_postcontrol_operation,
+ mp_path_direction_operation,
+ mp_pen_offset_operation,
+ mp_arc_time_operation,
+ mp_arc_point_operation,
+ mp_arc_point_list_operation,
+ mp_subarc_length_operation,
+ mp_version_operation,
+ mp_envelope_operation,
+ mp_boundingpath_operation,
+
+} mp_name_type_type;
+typedef enum mp_class_codes {
+ mp_digit_class = 0,
+ mp_period_class = 1,
+ mp_space_class = 2,
+ mp_percent_class = 3,
+ mp_string_class = 4,
+ mp_comma_class = 5,
+ mp_semicolon_class = 6,
+ mp_left_parenthesis_class = 7,
+ mp_right_parenthesis_class = 8,
+ mp_letter_class = 9,
+ mp_suffix_class = 15,
+ mp_left_bracket_class = 17,
+ mp_right_bracket_class = 18,
+ mp_brace_class = 19,
+ mp_invalid_class = 20,
+ mp_max_class = 20,
+} mp_class_codes;
+typedef enum mp_text_codes {
+ mp_forever_text,
+ mp_loop_text,
+ mp_parameter_text,
+ mp_backed_up_text,
+ mp_inserted_text,
+ mp_macro_text,
+ mp_file_bottom_text,
+} mp_text_codes;
+typedef enum mp_scanner_states {
+ mp_normal_state,
+ mp_skipping_state,
+ mp_flushing_state,
+ mp_absorbing_state,
+ mp_var_defining_state,
+ mp_op_defining_state,
+ mp_loop_defining_state,
+ mp_tex_flushing_state,
+} mp_scanner_states;
+typedef enum mp_verbatim_codes {
+ mp_btex_code,
+ mp_verbatim_code,
+} mp_verbatim_codes;
+typedef enum mp_def_codes {
+ mp_end_def_code,
+ mp_def_code,
+ mp_var_def_code,
+ mp_primary_def_code,
+ mp_secondary_def_code,
+ mp_tertiary_def_code,
+} mp_def_codes;
+typedef enum mp_only_set_codes {
+ mp_random_seed_code,
+ mp_max_knot_pool_code,
+} mp_only_set_codes;
+typedef enum mp_for_codes {
+ mp_end_for_code,
+ mp_start_forever_code,
+ mp_start_for_code,
+ mp_start_forsuffixes_code,
+} mp_for_codes;
+typedef enum mp_macro_fix_codes {
+ mp_macro_quote_code,
+ mp_macro_prefix_code,
+ mp_macro_at_code,
+ mp_macro_suffix_code,
+} mp_macro_fix_codes;
+typedef enum mp_if_codes {
+ mp_no_if_code,
+ mp_if_code,
+ mp_fi_code,
+ mp_else_code,
+ mp_else_if_code,
+} mp_if_codes;
+typedef enum mp_show_codes {
+ mp_show_token_code,
+ mp_show_stats_code,
+ mp_show_code,
+ mp_show_var_code,
+ mp_show_dependencies_code,
+} mp_show_codes;
+typedef enum mp_with_codes {
+ mp_with_pen_code,
+ mp_with_dashed_code,
+ mp_with_pre_script_code,
+ mp_with_post_script_code,
+ mp_with_stacking_code,
+ mp_with_no_model_code,
+ mp_with_grey_model_code,
+ mp_with_uninitialized_model_code,
+ mp_with_rgb_model_code,
+ mp_with_cmyk_model_code,
+ mp_with_linecap_code,
+ mp_with_linejoin_code,
+ mp_with_miterlimit_code,
+} mp_with_codes;
+typedef enum mp_add_codes {
+ mp_add_double_path_code,
+ mp_add_contour_code,
+ mp_add_also_code,
+} mp_add_codes ;
+
+typedef void (*convert_func) (mp_number *r);
+typedef void (*m_log_func) (MP mp, mp_number *r, mp_number *a);
+typedef void (*m_exp_func) (MP mp, mp_number *r, mp_number *a);
+typedef void (*m_unif_rand_func) (MP mp, mp_number *ret, mp_number *x_orig);
+typedef void (*m_norm_rand_func) (MP mp, mp_number *ret);
+typedef void (*pyth_add_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*pyth_sub_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*power_of_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*n_arg_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*velocity_func) (MP mp, mp_number *r, mp_number *a, mp_number *b, mp_number *c, mp_number *d, mp_number *e);
+typedef int (*ab_vs_cd_func) (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+typedef void (*crossing_point_func) (MP mp, mp_number *r, mp_number *a, mp_number *b, mp_number *c);
+typedef void (*number_from_int_func) (mp_number *A, int B);
+typedef void (*number_from_boolean_func) (mp_number *A, int B);
+typedef void (*number_from_scaled_func) (mp_number *A, int B);
+typedef void (*number_from_double_func) (mp_number *A, double B);
+typedef void (*number_from_addition_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_half_from_addition_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_subtraction_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_half_from_subtraction_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_div_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_mul_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_int_div_func) (mp_number *A, mp_number *B, int C);
+typedef void (*number_from_int_mul_func) (mp_number *A, mp_number *B, int C);
+typedef void (*number_from_oftheway_func) (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+typedef void (*number_negate_func) (mp_number *A);
+typedef void (*number_add_func) (mp_number *A, mp_number *B);
+typedef void (*number_subtract_func) (mp_number *A, mp_number *B);
+typedef void (*number_modulo_func) (mp_number *A, mp_number *B);
+typedef void (*number_half_func) (mp_number *A);
+typedef void (*number_double_func) (mp_number *A);
+typedef void (*number_abs_func) (mp_number *A);
+typedef void (*number_clone_func) (mp_number *A, mp_number *B);
+typedef void (*number_negated_clone_func) (mp_number *A, mp_number *B);
+typedef void (*number_abs_clone_func) (mp_number *A, mp_number *B);
+typedef void (*number_swap_func) (mp_number *A, mp_number *B);
+typedef void (*number_add_scaled_func) (mp_number *A, int b);
+typedef void (*number_multiply_int_func) (mp_number *A, int b);
+typedef void (*number_divide_int_func) (mp_number *A, int b);
+typedef int (*number_to_int_func) (mp_number *A);
+typedef int (*number_to_boolean_func) (mp_number *A);
+typedef int (*number_to_scaled_func) (mp_number *A);
+typedef int (*number_round_func) (mp_number *A);
+typedef void (*number_floor_func) (mp_number *A);
+typedef double (*number_to_double_func) (mp_number *A);
+typedef int (*number_odd_func) (mp_number *A);
+typedef int (*number_equal_func) (mp_number *A, mp_number *B);
+typedef int (*number_less_func) (mp_number *A, mp_number *B);
+typedef int (*number_greater_func) (mp_number *A, mp_number *B);
+typedef int (*number_nonequalabs_func) (mp_number *A, mp_number *B);
+typedef void (*make_scaled_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*make_fraction_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*take_fraction_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*take_scaled_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*sin_cos_func) (MP mp, mp_number *A, mp_number *S, mp_number *C);
+typedef void (*slow_add_func) (MP mp, mp_number *A, mp_number *S, mp_number *C);
+typedef void (*sqrt_func) (MP mp, mp_number *ret, mp_number *A);
+typedef void (*init_randoms_func) (MP mp, int seed);
+typedef void (*allocate_number_func) (MP mp, mp_number *A, mp_number_type t);
+typedef void (*allocate_number_clone_func) (MP mp, mp_number *A, mp_number_type t, mp_number *B);
+typedef void (*allocate_number_abs_func) (MP mp, mp_number *A, mp_number_type t, mp_number *B);
+typedef void (*allocate_number_double_func) (MP mp, mp_number *A, double B);
+typedef void (*free_number_func) (MP mp, mp_number *n);
+typedef void (*fraction_to_round_scaled_func) (mp_number *n);
+typedef void (*print_func) (MP mp, mp_number *A);
+typedef char *(*tostring_func) (MP mp, mp_number *A);
+typedef void (*scan_func) (MP mp, int A);
+typedef void (*mp_free_func) (MP mp);
+typedef void (*set_precision_func) (MP mp);
+typedef struct math_data {
+ mp_number md_precision_default;
+ mp_number md_precision_max;
+ mp_number md_precision_min;
+ mp_number md_epsilon_t;
+ mp_number md_inf_t;
+ mp_number md_negative_inf_t;
+ mp_number md_one_third_inf_t;
+ mp_number md_zero_t;
+ mp_number md_unity_t;
+ mp_number md_two_t;
+ mp_number md_three_t;
+ mp_number md_half_unit_t;
+ mp_number md_three_quarter_unit_t;
+ mp_number md_fraction_one_t;
+ mp_number md_fraction_half_t;
+ mp_number md_fraction_three_t;
+ mp_number md_fraction_four_t;
+ mp_number md_one_eighty_deg_t;
+ mp_number md_negative_one_eighty_deg_t;
+ mp_number md_three_sixty_deg_t;
+ mp_number md_one_k;
+ mp_number md_sqrt_8_e_k;
+ mp_number md_twelve_ln_2_k;
+ mp_number md_coef_bound_k;
+ mp_number md_coef_bound_minus_1;
+ mp_number md_twelvebits_3;
+ mp_number md_arc_tol_k;
+ mp_number md_twentysixbits_sqrt2_t;
+ mp_number md_twentyeightbits_d_t;
+ mp_number md_twentysevenbits_sqrt2_d_t;
+ mp_number md_fraction_threshold_t;
+ mp_number md_half_fraction_threshold_t;
+ mp_number md_scaled_threshold_t;
+ mp_number md_half_scaled_threshold_t;
+ mp_number md_near_zero_angle_t;
+ mp_number md_p_over_v_threshold_t;
+ mp_number md_equation_threshold_t;
+ mp_number md_warning_limit_t;
+ allocate_number_func md_allocate;
+ allocate_number_clone_func md_allocate_clone;
+ allocate_number_abs_func md_allocate_abs;
+ allocate_number_double_func md_allocate_double;
+ free_number_func md_free;
+ number_from_int_func md_from_int;
+ number_from_boolean_func md_from_boolean;
+ number_from_scaled_func md_from_scaled;
+ number_from_double_func md_from_double;
+ number_from_addition_func md_from_addition;
+ number_half_from_addition_func md_half_from_addition;
+ number_from_subtraction_func md_from_subtraction;
+ number_half_from_subtraction_func md_half_from_subtraction;
+ number_from_div_func md_from_div;
+ number_from_mul_func md_from_mul;
+ number_from_int_div_func md_from_int_div;
+ number_from_int_mul_func md_from_int_mul;
+ number_from_oftheway_func md_from_oftheway;
+ number_negate_func md_negate;
+ number_add_func md_add;
+ number_subtract_func md_subtract;
+ number_half_func md_half;
+ number_modulo_func md_modulo;
+ number_double_func md_do_double;
+ number_abs_func md_abs;
+ number_clone_func md_clone;
+ number_negated_clone_func md_negated_clone;
+ number_abs_clone_func md_abs_clone;
+ number_swap_func md_swap;
+ number_add_scaled_func md_add_scaled;
+ number_multiply_int_func md_multiply_int;
+ number_divide_int_func md_divide_int;
+ number_to_int_func md_to_int;
+ number_to_boolean_func md_to_boolean;
+ number_to_scaled_func md_to_scaled;
+ number_to_double_func md_to_double;
+ number_odd_func md_odd;
+ number_equal_func md_equal;
+ number_less_func md_less;
+ number_greater_func md_greater;
+ number_nonequalabs_func md_nonequalabs;
+ number_round_func md_round_unscaled;
+ number_floor_func md_floor_scaled;
+ make_scaled_func md_make_scaled;
+ make_fraction_func md_make_fraction;
+ take_fraction_func md_take_fraction;
+ take_scaled_func md_take_scaled;
+ velocity_func md_velocity;
+ ab_vs_cd_func md_ab_vs_cd;
+ crossing_point_func md_crossing_point;
+ n_arg_func md_n_arg;
+ m_log_func md_m_log;
+ m_exp_func md_m_exp;
+ m_unif_rand_func md_m_unif_rand;
+ m_norm_rand_func md_m_norm_rand;
+ pyth_add_func md_pyth_add;
+ pyth_sub_func md_pyth_sub;
+ power_of_func md_power_of;
+ fraction_to_round_scaled_func md_fraction_to_round_scaled;
+ convert_func md_fraction_to_scaled;
+ convert_func md_scaled_to_fraction;
+ convert_func md_scaled_to_angle;
+ convert_func md_angle_to_scaled;
+ init_randoms_func md_init_randoms;
+ sin_cos_func md_sin_cos;
+ sqrt_func md_sqrt;
+ slow_add_func md_slow_add;
+ print_func md_print;
+ tostring_func md_tostring;
+ scan_func md_scan_numeric;
+ scan_func md_scan_fractional;
+ mp_free_func md_free_math;
+ set_precision_func md_set_precision;
+} math_data;
+typedef struct mp_value_node_data *mp_value_node;
+typedef struct mp_node_data *mp_node;
+typedef struct mp_symbol_entry *mp_sym;
+typedef unsigned short quarterword;
+typedef int halfword;
+typedef struct mp_independent_data {
+ int scale;
+ int serial;
+} mp_independent_data;
+typedef struct mp_value_data {
+ mp_independent_data indep;
+ mp_number n;
+ mp_string str;
+ mp_sym sym;
+ mp_node node;
+ mp_knot p;
+} mp_value_data;
+typedef struct mp_value {
+ mp_variable_type type;
+ int padding;
+ mp_value_data data;
+} mp_value;
+typedef enum mp_given_internal {
+ mp_number_system_internal = 1,
+ mp_number_precision_internal,
+ mp_job_name_internal,
+ mp_tracing_titles_internal,
+ mp_tracing_equations_internal,
+ mp_tracing_capsules_internal,
+ mp_tracing_choices_internal,
+ mp_tracing_specs_internal,
+ mp_tracing_commands_internal,
+ mp_tracing_restores_internal,
+ mp_tracing_macros_internal,
+ mp_tracing_output_internal,
+ mp_tracing_stats_internal,
+ mp_tracing_online_internal,
+ mp_year_internal,
+ mp_month_internal,
+ mp_day_internal,
+ mp_time_internal,
+ mp_hour_internal,
+ mp_minute_internal,
+ mp_char_code_internal,
+ mp_char_wd_internal,
+ mp_char_ht_internal,
+ mp_char_dp_internal,
+ mp_char_ic_internal,
+ mp_pausing_internal,
+ mp_showstopping_internal,
+ mp_texscriptmode_internal,
+ mp_overloadmode_internal,
+ mp_linejoin_internal,
+ mp_linecap_internal,
+ mp_stacking_internal,
+ mp_miterlimit_internal,
+ mp_warning_check_internal,
+ mp_true_corners_internal,
+ mp_default_color_model_internal,
+ mp_restore_clip_color_internal,
+} mp_given_internal;
+typedef struct mp_internal {
+ mp_value v;
+ char *intname;
+ int run;
+ int padding;
+} mp_internal;
+typedef struct mp_symbol_entry {
+ int type;
+ int property;
+ mp_value v;
+ mp_string text;
+ void *parent;
+} mp_symbol_entry;
+typedef enum mp_macro_info {
+ mp_general_macro,
+ mp_primary_macro,
+ mp_secondary_macro,
+ mp_tertiary_macro,
+ mp_expr_macro,
+ mp_of_macro,
+ mp_suffix_macro,
+ mp_text_macro,
+ mp_expr_parameter,
+ mp_suffix_parameter,
+ mp_text_parameter
+} mp_macro_info;
+typedef struct mp_save_data {
+ int type;
+ int padding;
+ mp_internal value;
+ struct mp_save_data *link;
+} mp_save_data;
+enum mp_bb_code {
+ mp_x_code,
+ mp_y_code
+};
+typedef struct mp_dash_node_data *mp_dash_node;
+typedef struct mp_in_state_record {
+ int start_field;
+ int loc_field;
+ int limit_field;
+ int index_field;
+ mp_node nstart_field;
+ mp_node nloc_field;
+ mp_string name_field;
+} mp_in_state_record;
+typedef struct mp_subst_list_item {
+ mp_name_type_type info_mod;
+ int value_mod;
+ int value_data;
+ int padding;
+ mp_sym info;
+ struct mp_subst_list_item *link;
+} mp_subst_list_item;
+typedef struct mp_loop_data {
+ mp_sym var ;
+ mp_node info;
+ mp_node type;
+ mp_node list;
+ mp_node list_start;
+ mp_number old_value;
+ mp_number value;
+ mp_number step_size;
+ mp_number final_value;
+ struct mp_loop_data *link;
+ mp_knot point;
+} mp_loop_data;
+typedef struct File {
+ FILE *f;
+} File;
+
+# define bistack_size 1500
+
+typedef struct MP_instance {
+ int halt_on_error;
+ void *userdata;
+ char *banner;
+ int utf8_mode;
+ int text_mode;
+ int show_mode;
+ mp_file_finder find_file;
+ mp_script_runner run_script;
+ mp_internal_runner run_internal;
+ mp_log_runner run_logger;
+ mp_overload_runner run_overload;
+ mp_error_runner run_error;
+ mp_warning_runner run_warning;
+ mp_text_maker make_text;
+ mp_file_opener open_file;
+ mp_file_closer close_file;
+ mp_file_reader read_file;
+ mp_file_writer write_file;
+ int find_file_id;
+ int run_script_id;
+ int run_internal_id;
+ int run_logger_id;
+ int run_overload_id;
+ int run_error_id;
+ int run_warning_id;
+ int make_text_id;
+ int open_file_id;
+ int interaction;
+ int extensions;
+ int random_seed;
+ int math_mode;
+ char *job_name;
+ mp_backend_writer shipout_backend;
+
+ math_data *math;
+ int max_in_open;
+ int param_size;
+ int padding_size;
+ char *name_of_file;
+ size_t buf_size;
+ unsigned char *buffer;
+ size_t first;
+ size_t last;
+ size_t max_buf_stack;
+ void *term_in;
+ avl_tree strings;
+ unsigned char *cur_string;
+ size_t cur_length;
+ size_t cur_string_size;
+ int pool_in_use;
+ int max_pl_used;
+ int strs_in_use;
+ int max_strs_used;
+ unsigned int selector;
+ unsigned int term_offset;
+ unsigned int file_offset;
+ int history;
+ int error_count;
+ int use_err_help;
+ int padding_help;
+ mp_string err_help;
+ jmp_buf *jump_buf;
+ int run_state;
+ int finished;
+ int arith_error;
+ mp_number randoms[55];
+ int j_random;
+ int j_padding;
+ mp_node token_nodes;
+ mp_node pair_nodes;
+ int num_token_nodes;
+ int num_pair_nodes;
+ mp_knot knot_nodes;
+ mp_node value_nodes;
+ int max_knot_nodes;
+ int num_knot_nodes;
+ int num_value_nodes;
+ mp_node symbolic_nodes;
+ int num_symbolic_nodes;
+ size_t var_used;
+ size_t var_used_max;
+ mp_dash_node null_dash;
+ mp_value_node dep_head;
+ mp_node inf_val;
+ mp_node zero_val;
+ mp_node temp_val;
+ mp_node end_attr;
+ mp_node bad_vardef;
+ mp_node temp_head;
+ mp_node hold_head;
+ mp_node spec_head;
+ mp_internal *internal;
+ int int_ptr;
+ int max_internal;
+ unsigned int old_selector;
+ int char_class[256];
+ int st_count;
+ avl_tree symbols;
+ avl_tree frozen_symbols;
+ avl_iterator symbol_iterator;
+ mp_sym frozen_bad_vardef;
+ mp_sym frozen_colon;
+ mp_sym frozen_end_def;
+ mp_sym frozen_end_for;
+ mp_sym frozen_end_group;
+ mp_sym frozen_etex;
+ mp_sym frozen_fi;
+ mp_sym frozen_inaccessible;
+ mp_sym frozen_left_bracket;
+ mp_sym frozen_repeat_loop;
+ mp_sym frozen_right_delimiter;
+ mp_sym frozen_semicolon;
+ mp_sym frozen_slash;
+ mp_sym frozen_undefined;
+ mp_sym frozen_dump;
+ mp_sym id_lookup_test;
+ mp_save_data *save_ptr;
+ mp_knot path_tail;
+ int path_size;
+ int path_padding;
+ mp_number *delta_x;
+ mp_number *delta_y;
+ mp_number *delta;
+ mp_number *psi;
+ mp_number *theta;
+ mp_number *uu;
+ mp_number *vv;
+ mp_number *ww;
+ mp_number st;
+ mp_number ct;
+ mp_number sf;
+ mp_number cf;
+ mp_number bbmin[mp_y_code + 1];
+ mp_number bbmax[mp_y_code + 1];
+ mp_number half_cos[8];
+ mp_number d_cos[8];
+ mp_number cur_x;
+ mp_number cur_y;
+ int spec_offset;
+ int spec_padding;
+ mp_knot spec_p1;
+ mp_knot spec_p2;
+ unsigned int tol_step;
+ mp_number *bisect_stack;
+ int bisect_ptr;
+ mp_number cur_t;
+ mp_number cur_tt;
+ int time_to_go;
+ mp_number max_t;
+ mp_number delx;
+ mp_number dely;
+ int tol;
+ int uv;
+ int xy;
+ int three_l;
+ mp_number appr_t;
+ mp_number appr_tt;
+ int serial_no;
+ int fix_needed;
+ int watch_coefs;
+ mp_value_node dep_final;
+ mp_node cur_mod_;
+ mp_in_state_record *input_stack;
+ int input_ptr;
+ int max_in_stack;
+ mp_in_state_record cur_input;
+ int stack_size;
+ int in_open;
+ int in_open_max;
+ unsigned int open_parens;
+ void **input_file;
+ int *line_stack;
+ mp_node *param_stack;
+ int param_ptr;
+ int max_param_stack;
+ int file_ptr;
+ int scanner_status;
+ mp_sym warning_info;
+ int warning_line;
+ mp_node warning_info_node;
+ int force_eof;
+ mp_sym bg_loc;
+ mp_sym eg_loc;
+ int expand_depth_count;
+ int expand_depth;
+ mp_node cond_ptr;
+ int if_limit;
+ int cur_if;
+ int if_line;
+ mp_loop_data *loop_ptr;
+ char *cur_name;
+ int quoted_filename;
+ int max_read_files;
+ void **rd_file;
+ char **rd_fname;
+ int read_files;
+ int max_write_files;
+ void **wr_file;
+ char **wr_fname;
+ int write_files;
+ mp_value cur_exp;
+ mp_number max_c[mp_proto_dependent_type + 1];
+ mp_value_node max_ptr[mp_proto_dependent_type + 1];
+ mp_value_node max_link[mp_proto_dependent_type + 1];
+ int var_flag;
+ mp_string eof_line;
+ mp_string eof_file;
+ mp_number txx;
+ mp_number txy;
+ mp_number tyx;
+ mp_number tyy;
+ mp_number tx;
+ mp_number ty;
+ mp_run_data run_data;
+ int last_add_type;
+ mp_sym every_job_sym;
+ int long_help_seen;
+ int ten_pow[10];
+ int scaled_out;
+
+} MP_instance;
+void mp_normalize_selector (MP mp);
+void mp_jump_out (MP mp);
+void mp_confusion (MP mp, const char *s);
+void mp_new_randoms (MP mp);
+# define mp_snprintf snprintf
+void mp_make_choices (MP mp, mp_knot knots);
+void mp_pack_file_name (MP mp, const char *n);
+void mp_grow_internals (MP mp, int l);
+
+# define update_terminal() mp_print_nl_only(mp);
+# define clear_terminal()
+# define wake_up_terminal() mp_print_nl_only(mp);
+typedef enum mp_selectors {
+ mp_new_string_selector,
+ mp_no_print_selector,
+ mp_term_only_selector,
+ mp_log_only_selector,
+ mp_term_and_log_selector,
+ mp_first_file_selector,
+} mp_selectors;
+typedef enum mp_logging_targets {
+ mp_void_logging_target,
+ mp_term_logging_target,
+ mp_file_logging_target,
+ mp_both_logging_target,
+ mp_error_logging_target,
+} mp_logging_targets;
+# define mp_fputs(b,f) (mp->write_file)(mp, f, b)
+# define mp_log_string(target,s) (mp->run_logger)(mp, target, s, strlen(s))
+# define mp_log_mpstr(target,s,l) (mp->run_logger)(mp, target, s, l)
+# define mp_log_cr(target) (mp->run_logger)(mp, target, "\n", 1)
+# define mp_log_chr(target,s) { unsigned char ss[2] = { s, 0 }; (mp->run_logger)(mp, target, (const char *) ss, 1); }
+# define mp_log_error(s) (mp->run_logger)(mp, mp_error_logging_target, s, strlen(s))
+typedef struct mp_node_data {
+ union {
+ mp_command_code command;
+ mp_variable_type type;
+ };
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ mp_value_data data;
+} mp_node_data;
+typedef struct mp_node_data *mp_symbolic_node;
+typedef enum mp_linecap_codes {
+ mp_butt_linecap_code,
+ mp_rounded_linecap_code,
+ mp_squared_linecap_code,
+ mp_weird_linecap_code,
+} mp_linecap_codes;
+typedef enum mp_linejoin_codes {
+ mp_mitered_linejoin_code,
+ mp_rounded_linejoin_code,
+ mp_beveled_linejoin_code,
+ mp_weird_linejoin_code,
+} mp_linejoin_codes;
+# define internal_value(A) mp->internal[(A)].v.data.n
+# define internal_string(A) mp->internal[A].v.data.str
+# define set_internal_string(A,B) mp->internal[(A)].v.data.str=(B)
+# define internal_name(A) mp->internal[(A)].intname
+# define set_internal_name(A,B) mp->internal[(A)].intname=(B)
+# define internal_type(A) mp->internal[A].v.type
+# define set_internal_type(A,B) mp->internal[(A)].v.type=(B)
+# define internal_run(A) mp->internal[(A)].run
+# define set_internal_run(A,B) mp->internal[(A)].run=(B)
+typedef struct mp_node_data *mp_token_node;
+typedef struct mp_value_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ mp_value_data data;
+ mp_number subscript;
+ mp_sym hashloc_;
+ mp_node parent;
+ mp_node attr_head;
+ mp_node subscr_head;
+} mp_value_node_data;
+typedef struct mp_pair_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ mp_node x_part;
+ mp_node y_part;
+} mp_pair_node_data;
+typedef struct mp_pair_node_data *mp_pair_node;
+typedef struct mp_transform_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ mp_node tx_part;
+ mp_node ty_part;
+ mp_node xx_part;
+ mp_node yx_part;
+ mp_node xy_part;
+ mp_node yy_part;
+} mp_transform_node_data;
+typedef struct mp_transform_node_data *mp_transform_node;
+typedef struct mp_color_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ union {
+ mp_node red_part;
+ mp_node cyan_part;
+ };
+ union {
+ mp_node green_part;
+ mp_node magenta_part;
+ };
+ union {
+ mp_node blue_part;
+ mp_node yellow_part;
+ };
+ union {
+ mp_node grey_part;
+ mp_node black_part;
+ };
+} mp_color_node_data;
+typedef struct mp_color_node_data *mp_color_node;
+typedef struct mp_shape_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int stacking;
+ struct mp_node_data *link;
+ mp_string pre_script;
+ mp_string post_script;
+ union {
+ mp_number red;
+ mp_number cyan;
+ };
+ union {
+ mp_number green;
+ mp_number magenta;
+ };
+ union {
+ mp_number blue;
+ mp_number yellow;
+ };
+ union {
+ mp_number black;
+ mp_number grey;
+ };
+ mp_knot path;
+ mp_knot pen;
+ mp_node dash;
+ mp_number dashscale;
+ mp_number miterlimit;
+ unsigned char color_model;
+ unsigned char linejoin;
+ unsigned char linecap;
+ unsigned char pen_type;
+} mp_shape_node_data;
+typedef struct mp_shape_node_data *mp_shape_node;
+typedef struct mp_start_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int stacking;
+ struct mp_node_data *link;
+ mp_string pre_script;
+ mp_string post_script;
+ mp_knot path;
+} mp_start_node_data;
+typedef struct mp_start_node_data *mp_start_node;
+typedef struct mp_stop_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int stacking;
+ struct mp_node_data *link;
+} mp_stop_node_data;
+typedef struct mp_stop_node_data *mp_stop_node;
+typedef struct mp_dash_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ mp_number start_x;
+ mp_number stop_x;
+ mp_number dash_y;
+ mp_node dash_info;
+} mp_dash_node_data;
+typedef struct mp_edge_header_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ mp_number start_x;
+ mp_number stop_x;
+ mp_number dash_y;
+ mp_node dash_info;
+ mp_number minx;
+ mp_number miny;
+ mp_number maxx;
+ mp_number maxy;
+ mp_node bblast;
+ int bbtype;
+ int ref_count;
+ mp_node list;
+ mp_node obj_tail;
+} mp_edge_header_node_data;
+typedef struct mp_edge_header_node_data *mp_edge_header_node;
+typedef enum mp_bound_codes {
+ mp_no_bounds_code,
+ mp_bounds_set_code,
+ mp_bounds_unset_code,
+} mp_bound_codes;
+typedef struct mp_if_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int if_line_field;
+ struct mp_node_data *link;
+} mp_if_node_data;
+typedef struct mp_if_node_data *mp_if_node;
+
+struct mp_edge_object *mp_gr_export (MP mp, mp_edge_header_node h);
+mp_graphic_object *mp_new_graphic_object (MP mp, int type);
+void mp_gr_toss_objects (mp_edge_object *hh);
+void mp_gr_toss_object (mp_graphic_object *p);
+
+# endif
+
diff --git a/source/luametatex/source/mp/mpc/mpconfig.h b/source/luametatex/source/mp/mpc/mpconfig.h
new file mode 100644
index 000000000..509e6c526
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpconfig.h
@@ -0,0 +1,26 @@
+# ifndef MPCONFIG_H
+# define MPCONFIG_H
+
+# include <errno.h>
+# include <string.h>
+# include <float.h>
+# include <math.h>
+# include <stdlib.h>
+# include <stdarg.h>
+# include <ctype.h>
+# include <sys/stat.h>
+# include <time.h>
+
+# ifdef _WIN32
+
+ # include <stdio.h>
+ # include <fcntl.h>
+ # include <io.h>
+
+# else
+
+ # include <unistd.h>
+
+# endif
+
+# endif
diff --git a/source/luametatex/source/mp/mpc/mpmath.c b/source/luametatex/source/mp/mpc/mpmath.c
new file mode 100644
index 000000000..42a596dac
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmath.c
@@ -0,0 +1,1501 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# include "mpconfig.h"
+# include "mpmath.h"
+# include "mpstrings.h"
+
+# define coef_bound 04525252525
+# define fraction_threshold 2685
+# define half_fraction_threshold 1342
+# define scaled_threshold 8
+# define half_scaled_threshold 4
+# define near_zero_angle 26844
+# define p_over_v_threshold 0x80000
+# define equation_threshold 64
+# define unity 0x10000
+# define two (2*unity)
+# define three (3*unity)
+# define half_unit (unity/2)
+# define three_quarter_unit (3*(unity/4))
+# define EL_GORDO 0x7fffffff
+# define negative_EL_GORDO (-EL_GORDO)
+# define one_third_EL_GORDO 05252525252
+# define TWEXP31 2147483648.0
+# define TWEXP28 268435456.0
+# define TWEXP16 65536.0
+# define TWEXP_16 (1.0/65536.0)
+# define TWEXP_28 (1.0/268435456.0)
+# define no_crossing (fraction_one + 1)
+# define one_crossing fraction_one
+# define zero_crossing 0
+# define fraction_half 0x08000000
+# define fraction_one 0x10000000
+# define fraction_two 0x20000000
+# define fraction_three 0x30000000
+# define fraction_four 0x40000000
+# define negate_x 1
+# define negate_y 2
+# define switch_x_and_y 4
+# define first_octant 1
+# define second_octant (first_octant + switch_x_and_y)
+# define third_octant (first_octant + switch_x_and_y + negate_x)
+# define fourth_octant (first_octant + negate_x)
+# define fifth_octant (first_octant + negate_x + negate_y)
+# define sixth_octant (first_octant + switch_x_and_y + negate_x + negate_y)
+# define seventh_octant (first_octant + switch_x_and_y + negate_y)
+# define eighth_octant (first_octant + negate_y)
+# define forty_five_deg 0x02D00000
+# define ninety_deg 0x05A00000
+# define one_eighty_deg 0x0B400000
+# define negative_one_eighty_deg -0x0B400000
+# define three_sixty_deg 0x16800000
+# define odd(A) (abs(A)%2==1)
+# define two_to_the(A) (1<<(unsigned)(A))
+# define set_cur_cmd(A) mp->cur_mod_->command = (A)
+# define set_cur_mod(A) mp->cur_mod_->data.n.data.val = (A)
+
+static int mp_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *B);
+static void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *B);
+static void mp_allocate_double (MP mp, mp_number *n, double v);
+static void mp_allocate_number (MP mp, mp_number *n, mp_number_type t);
+static void mp_crossing_point (MP mp, mp_number *ret, mp_number *a, mp_number *b, mp_number *c);
+static void mp_fraction_to_round_scaled (mp_number *x);
+static void mp_free_number (MP mp, mp_number *n);
+static void mp_free_scaled_math (MP mp);
+static void mp_init_randoms (MP mp, int seed);
+static void mp_m_exp (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_m_log (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_m_norm_rand (MP mp, mp_number *ret);
+static void mp_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig);
+static int mp_make_scaled (MP mp, int p, int q);
+static void mp_n_arg (MP mp, mp_number *ret, mp_number *x, mp_number *y);
+static void mp_n_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin);
+static void mp_number_abs (mp_number *A);
+static void mp_number_abs_clone (mp_number *A, mp_number *B);
+static void mp_number_add (mp_number *A, mp_number *B);
+static void mp_number_add_scaled (mp_number *A, int B);
+static void mp_number_angle_to_scaled (mp_number *A);
+static void mp_number_clone (mp_number *A, mp_number *B);
+static void mp_number_divide_int (mp_number *A, int B);
+static void mp_number_double (mp_number *A);
+static int mp_number_equal (mp_number *A, mp_number *B);
+static void mp_number_floor (mp_number *i);
+static void mp_number_fraction_to_scaled (mp_number *A);
+static int mp_number_greater (mp_number *A, mp_number *B);
+static void mp_number_half (mp_number *A);
+static int mp_number_less (mp_number *A, mp_number *B);
+static void mp_number_make_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_number_make_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_number_modulo (mp_number *a, mp_number *b);
+static void mp_number_multiply_int (mp_number *A, int B);
+static void mp_number_negate (mp_number *A);
+static void mp_number_negated_clone (mp_number *A, mp_number *B);
+static int mp_number_nonequalabs (mp_number *A, mp_number *B);
+static int mp_number_odd (mp_number *A);
+static void mp_number_scaled_to_angle (mp_number *A);
+static void mp_number_scaled_to_fraction (mp_number *A);
+static void mp_number_subtract (mp_number *A, mp_number *B);
+static void mp_number_swap (mp_number *A, mp_number *B);
+static void mp_number_take_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_number_take_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static int mp_number_to_boolean (mp_number *A);
+static double mp_number_to_double (mp_number *A);
+static int mp_number_to_int (mp_number *A);
+static int mp_number_to_scaled (mp_number *A);
+static void mp_power_of (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_print_number (MP mp, mp_number *n);
+static void mp_pyth_add (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_pyth_sub (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static int mp_round_decimals (MP mp, unsigned char *b, int k);
+static int mp_round_unscaled (mp_number *x_orig);
+static void mp_scaled_set_precision (MP mp);
+static void mp_scan_fractional_token (MP mp, int n);
+static void mp_scan_numeric_token (MP mp, int n);
+static void mp_set_number_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_from_boolean (mp_number *A, int B);
+static void mp_set_number_from_div (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_from_double (mp_number *A, double B);
+static void mp_set_number_from_int (mp_number *A, int B);
+static void mp_set_number_from_int_div (mp_number *A, mp_number *B, int C);
+static void mp_set_number_from_int_mul (mp_number *A, mp_number *B, int C);
+static void mp_set_number_from_mul (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+static void mp_set_number_from_scaled (mp_number *A, int B);
+static void mp_set_number_from_subtraction (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_half_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C);
+static void mp_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig);
+static void mp_square_rt (MP mp, mp_number *ret, mp_number *x_orig);
+static int mp_take_fraction (MP mp, int q, int f);
+static int mp_take_scaled (MP mp, int q, int f);
+static void mp_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t);
+static void mp_wrapup_numeric_token (MP mp, int n, int f);
+static char *mp_number_tostring (MP mp, mp_number *n);
+static char *mp_string_scaled (MP mp, int s);
+static const int mp_m_spec_log[29] = {
+ 0, 93032640, 38612034, 17922280, 8662214, 4261238, 2113709, 1052693, 525315,
+ 262400, 131136, 65552, 32772, 16385, 8192, 4096, 2048, 1024, 512, 256, 128,
+ 64, 32, 16, 8, 4, 2, 1, 1
+};
+static const int mp_m_spec_atan[27] = {
+ 0, 27855475, 14718068, 7471121, 3750058, 1876857, 938658, 469357, 234682,
+ 117342, 58671, 29335, 14668, 7334, 3667, 1833, 917, 458, 229, 115, 57, 29,
+ 14, 7, 4, 2, 1
+};
+
+math_data *mp_initialize_scaled_math(MP mp)
+{
+ math_data *math = (math_data *) mp_memory_allocate(sizeof(math_data));
+ math->md_allocate = mp_allocate_number;
+ math->md_free = mp_free_number;
+ math->md_allocate_clone = mp_allocate_clone;
+ math->md_allocate_abs = mp_allocate_abs;
+ math->md_allocate_double = mp_allocate_double;
+ mp_allocate_number(mp, &math->md_precision_default, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_max, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_min, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_epsilon_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_negative_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_warning_limit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_one_third_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_unity_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_two_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_quarter_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_zero_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_arc_tol_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_one_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_half_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_three_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_four_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_three_sixty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_one_eighty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_negative_one_eighty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_one_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_sqrt_8_e_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twelve_ln_2_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_minus_1, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twelvebits_3, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twentysixbits_sqrt2_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentyeightbits_d_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentysevenbits_sqrt2_d_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_half_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_near_zero_angle_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_p_over_v_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_equation_threshold_t, mp_scaled_type);
+ math->md_precision_default.data.val = unity * 10;
+ math->md_precision_max.data.val = unity * 10;
+ math->md_precision_min.data.val = unity * 10;
+ math->md_epsilon_t.data.val = 1;
+ math->md_inf_t.data.val = EL_GORDO;
+ math->md_negative_inf_t.data.val = negative_EL_GORDO;
+ math->md_one_third_inf_t.data.val = one_third_EL_GORDO;
+ math->md_warning_limit_t.data.val = fraction_one;
+ math->md_unity_t.data.val = unity;
+ math->md_two_t.data.val = two;
+ math->md_three_t.data.val = three;
+ math->md_half_unit_t.data.val = half_unit;
+ math->md_three_quarter_unit_t.data.val = three_quarter_unit;
+ math->md_arc_tol_k.data.val = (unity/4096);
+ math->md_fraction_one_t.data.val = fraction_one;
+ math->md_fraction_half_t.data.val = fraction_half;
+ math->md_fraction_three_t.data.val = fraction_three;
+ math->md_fraction_four_t.data.val = fraction_four;
+ math->md_three_sixty_deg_t.data.val = three_sixty_deg;
+ math->md_one_eighty_deg_t.data.val = one_eighty_deg;
+ math->md_negative_one_eighty_deg_t.data.val = negative_one_eighty_deg;
+ math->md_one_k.data.val = 1024;
+ math->md_sqrt_8_e_k.data.val = 112429;
+ math->md_twelve_ln_2_k.data.val = 139548960;
+ math->md_coef_bound_k.data.val = coef_bound;
+ math->md_coef_bound_minus_1.data.val = coef_bound - 1;
+ math->md_twelvebits_3.data.val = 1365;
+ math->md_twentysixbits_sqrt2_t.data.val = 94906266;
+ math->md_twentyeightbits_d_t.data.val = 35596755;
+ math->md_twentysevenbits_sqrt2_d_t.data.val = 25170707;
+ math->md_fraction_threshold_t.data.val = fraction_threshold;
+ math->md_half_fraction_threshold_t.data.val = half_fraction_threshold;
+ math->md_scaled_threshold_t.data.val = scaled_threshold;
+ math->md_half_scaled_threshold_t.data.val = half_scaled_threshold;
+ math->md_near_zero_angle_t.data.val = near_zero_angle;
+ math->md_p_over_v_threshold_t.data.val = p_over_v_threshold;
+ math->md_equation_threshold_t.data.val = equation_threshold;
+ math->md_from_int = mp_set_number_from_int;
+ math->md_from_boolean = mp_set_number_from_boolean;
+ math->md_from_scaled = mp_set_number_from_scaled;
+ math->md_from_double = mp_set_number_from_double;
+ math->md_from_addition = mp_set_number_from_addition;
+ math->md_half_from_addition = mp_set_number_half_from_addition;
+ math->md_from_subtraction = mp_set_number_from_subtraction;
+ math->md_half_from_subtraction = mp_set_number_half_from_subtraction;
+ math->md_from_oftheway = mp_set_number_from_of_the_way;
+ math->md_from_div = mp_set_number_from_div;
+ math->md_from_mul = mp_set_number_from_mul;
+ math->md_from_int_div = mp_set_number_from_int_div;
+ math->md_from_int_mul = mp_set_number_from_int_mul;
+ math->md_negate = mp_number_negate;
+ math->md_add = mp_number_add;
+ math->md_subtract = mp_number_subtract;
+ math->md_half = mp_number_half;
+ math->md_do_double = mp_number_double;
+ math->md_abs = mp_number_abs;
+ math->md_clone = mp_number_clone;
+ math->md_negated_clone = mp_number_negated_clone;
+ math->md_abs_clone = mp_number_abs_clone;
+ math->md_swap = mp_number_swap;
+ math->md_add_scaled = mp_number_add_scaled;
+ math->md_multiply_int = mp_number_multiply_int;
+ math->md_divide_int = mp_number_divide_int;
+ math->md_to_int = mp_number_to_int;
+ math->md_to_boolean = mp_number_to_boolean;
+ math->md_to_scaled = mp_number_to_scaled;
+ math->md_to_double = mp_number_to_double;
+ math->md_odd = mp_number_odd;
+ math->md_equal = mp_number_equal;
+ math->md_less = mp_number_less;
+ math->md_greater = mp_number_greater;
+ math->md_nonequalabs = mp_number_nonequalabs;
+ math->md_round_unscaled = mp_round_unscaled;
+ math->md_floor_scaled = mp_number_floor;
+ math->md_fraction_to_round_scaled = mp_fraction_to_round_scaled;
+ math->md_make_scaled = mp_number_make_scaled;
+ math->md_make_fraction = mp_number_make_fraction;
+ math->md_take_fraction = mp_number_take_fraction;
+ math->md_take_scaled = mp_number_take_scaled;
+ math->md_velocity = mp_velocity;
+ math->md_n_arg = mp_n_arg;
+ math->md_m_log = mp_m_log;
+ math->md_m_exp = mp_m_exp;
+ math->md_m_unif_rand = mp_m_unif_rand;
+ math->md_m_norm_rand = mp_m_norm_rand;
+ math->md_pyth_add = mp_pyth_add;
+ math->md_pyth_sub = mp_pyth_sub;
+ math->md_power_of = mp_power_of;
+ math->md_fraction_to_scaled = mp_number_fraction_to_scaled;
+ math->md_scaled_to_fraction = mp_number_scaled_to_fraction;
+ math->md_scaled_to_angle = mp_number_scaled_to_angle;
+ math->md_angle_to_scaled = mp_number_angle_to_scaled;
+ math->md_init_randoms = mp_init_randoms;
+ math->md_sin_cos = mp_n_sin_cos;
+ math->md_slow_add = mp_slow_add;
+ math->md_sqrt = mp_square_rt;
+ math->md_print = mp_print_number;
+ math->md_tostring = mp_number_tostring;
+ math->md_modulo = mp_number_modulo;
+ math->md_ab_vs_cd = mp_ab_vs_cd;
+ math->md_crossing_point = mp_crossing_point;
+ math->md_scan_numeric = mp_scan_numeric_token;
+ math->md_scan_fractional = mp_scan_fractional_token;
+ math->md_free_math = mp_free_scaled_math;
+ math->md_set_precision = mp_scaled_set_precision;
+ return math;
+}
+
+void mp_scaled_set_precision (MP mp)
+{
+ (void) mp;
+}
+
+void mp_free_scaled_math (MP mp)
+{
+ mp_free_number(mp, &(mp->math->md_epsilon_t));
+ mp_free_number(mp, &(mp->math->md_inf_t));
+ mp_free_number(mp, &(mp->math->md_negative_inf_t));
+ mp_free_number(mp, &(mp->math->md_arc_tol_k));
+ mp_free_number(mp, &(mp->math->md_three_sixty_deg_t));
+ mp_free_number(mp, &(mp->math->md_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_negative_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_fraction_one_t));
+ mp_free_number(mp, &(mp->math->md_fraction_half_t));
+ mp_free_number(mp, &(mp->math->md_fraction_three_t));
+ mp_free_number(mp, &(mp->math->md_fraction_four_t));
+ mp_free_number(mp, &(mp->math->md_zero_t));
+ mp_free_number(mp, &(mp->math->md_half_unit_t));
+ mp_free_number(mp, &(mp->math->md_three_quarter_unit_t));
+ mp_free_number(mp, &(mp->math->md_unity_t));
+ mp_free_number(mp, &(mp->math->md_two_t));
+ mp_free_number(mp, &(mp->math->md_three_t));
+ mp_free_number(mp, &(mp->math->md_one_third_inf_t));
+ mp_free_number(mp, &(mp->math->md_warning_limit_t));
+ mp_free_number(mp, &(mp->math->md_one_k));
+ mp_free_number(mp, &(mp->math->md_sqrt_8_e_k));
+ mp_free_number(mp, &(mp->math->md_twelve_ln_2_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_minus_1));
+ mp_free_number(mp, &(mp->math->md_twelvebits_3));
+ mp_free_number(mp, &(mp->math->md_twentysixbits_sqrt2_t));
+ mp_free_number(mp, &(mp->math->md_twentyeightbits_d_t));
+ mp_free_number(mp, &(mp->math->md_twentysevenbits_sqrt2_d_t));
+ mp_free_number(mp, &(mp->math->md_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_near_zero_angle_t));
+ mp_free_number(mp, &(mp->math->md_p_over_v_threshold_t));
+ mp_free_number(mp, &(mp->math->md_equation_threshold_t));
+ mp_memory_free(mp->math);
+}
+
+void mp_allocate_number (MP mp, mp_number *n, mp_number_type t)
+{
+ (void) mp;
+ n->data.val = 0;
+ n->type = t;
+}
+
+void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.val = v->data.val;
+}
+
+void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.val = abs(v->data.val);
+}
+
+void mp_allocate_double (MP mp, mp_number *n, double v)
+{
+ (void) mp;
+ n->type = mp_scaled_type;
+ n->data.val = (int) (v * 65536.0);
+}
+
+void mp_free_number (MP mp, mp_number *n)
+{
+ (void) mp;
+ n->type = mp_nan_type;
+}
+
+void mp_set_number_from_int(mp_number *A, int B)
+{
+ A->data.val = B * 65536;
+}
+
+void mp_set_number_from_boolean(mp_number *A, int B)
+{
+ A->data.val = B;
+}
+
+void mp_set_number_from_scaled(mp_number *A, int B)
+{
+ A->data.val = B;
+}
+
+void mp_set_number_from_double(mp_number *A, double B)
+{
+ A->data.val = (int) (B * 65536.0);
+}
+
+void mp_set_number_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val + C->data.val;
+}
+
+void mp_set_number_half_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = (B->data.val + C->data.val) / 2;
+}
+
+void mp_set_number_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val - C->data.val;
+}
+
+void mp_set_number_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = (B->data.val - C->data.val) / 2;
+}
+
+void mp_set_number_from_div(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val / C->data.val;
+}
+
+void mp_set_number_from_mul(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val * C->data.val;
+}
+
+void mp_set_number_from_int_div(mp_number *A, mp_number *B, int C)
+{
+ A->data.val = B->data.val / C;
+}
+
+void mp_set_number_from_int_mul(mp_number *A, mp_number *B, int C)
+{
+ A->data.val = B->data.val * C;
+}
+
+void mp_set_number_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C)
+{
+ (void) mp;
+ A->data.val = B->data.val - mp_take_fraction(mp, (B->data.val - C->data.val), t->data.val);
+}
+
+void mp_number_negate(mp_number *A)
+{
+ A->data.val = -A->data.val;
+}
+
+void mp_number_add(mp_number *A, mp_number *B)
+{
+ A->data.val = A->data.val + B->data.val;
+}
+
+void mp_number_subtract(mp_number *A, mp_number *B)
+{
+ A->data.val = A->data.val - B->data.val;
+}
+
+void mp_number_half(mp_number *A)
+{
+ A->data.val = A->data.val / 2;
+}
+
+void mp_number_double(mp_number *A)
+{
+ A->data.val = A->data.val + A->data.val;
+}
+
+void mp_number_add_scaled(mp_number *A, int B)
+{
+ A->data.val = A->data.val + B;
+}
+
+void mp_number_multiply_int(mp_number *A, int B)
+{
+ A->data.val = B * A->data.val;
+}
+
+void mp_number_divide_int(mp_number *A, int B)
+{
+ A->data.val = A->data.val / B;
+}
+
+void mp_number_abs(mp_number *A)
+{
+ A->data.val = abs(A->data.val);
+}
+
+void mp_number_clone(mp_number *A, mp_number *B)
+{
+ A->data.val = B->data.val;
+}
+
+void mp_number_negated_clone(mp_number *A, mp_number *B)
+{
+ A->data.val = -B->data.val;
+}
+
+void mp_number_abs_clone(mp_number *A, mp_number *B)
+{
+ A->data.val = abs(B->data.val);
+}
+
+void mp_number_swap(mp_number *A, mp_number *B)
+{
+ int swap_tmp = A->data.val;
+ A->data.val = B->data.val;
+ B->data.val = swap_tmp;
+}
+
+void mp_number_fraction_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ A->data.val = A->data.val / 4096;
+}
+
+void mp_number_angle_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ if (A->data.val >= 0) {
+ A->data.val = (A->data.val + 8) / 16;
+ } else {
+ A->data.val = -((-A->data.val + 8) / 16);
+ }
+}
+
+void mp_number_scaled_to_fraction(mp_number *A)
+{
+ A->type = mp_fraction_type;
+ A->data.val = A->data.val * 4096;
+}
+
+void mp_number_scaled_to_angle(mp_number *A)
+{
+ A->type = mp_angle_type;
+ A->data.val = A->data.val * 16;
+}
+
+int mp_number_to_int(mp_number *A)
+{
+ return A->data.val;
+}
+
+int mp_number_to_scaled(mp_number *A)
+{
+ return A->data.val;
+}
+
+int mp_number_to_boolean(mp_number *A)
+{
+ return A->data.val;
+}
+
+double mp_number_to_double(mp_number *A)
+{
+ return A->data.val / 65536.0;
+}
+
+int mp_number_odd(mp_number *A)
+{
+ return odd(mp_round_unscaled(A));
+}
+
+int mp_number_equal(mp_number *A, mp_number *B) {
+ return A->data.val == B->data.val;
+}
+
+int mp_number_greater(mp_number *A, mp_number *B)
+{
+ return A->data.val > B->data.val;
+}
+
+int mp_number_less(mp_number *A, mp_number *B)
+{
+ return A->data.val < B->data.val;
+}
+
+int mp_number_nonequalabs(mp_number *A, mp_number *B)
+{
+ return abs(A->data.val) != abs(B->data.val);
+}
+
+static char *mp_string_scaled (MP mp, int s)
+{
+ (void) mp;
+ static char scaled_string[32];
+ int i = 0;
+ if (s < 0) {
+ scaled_string[i++] = '-';
+ s = -s;
+ }
+ mp_snprintf ((scaled_string+i), 12, "%d", (int) (s / unity));
+ while (*(scaled_string+i)) {
+ i++;
+ }
+ s = 10 * (s % unity) + 5;
+ if (s != 5) {
+ int delta = 10;
+ scaled_string[i++] = '.';
+ do {
+ if (delta > unity) {
+ s = s + 0100000 - (delta / 2);
+ }
+ scaled_string[i++] = '0' + (s / unity);
+ s = 10 * (s % unity);
+ delta = delta * 10;
+ } while (s > delta);
+ }
+ scaled_string[i] = '\0';
+ return scaled_string;
+}
+
+void mp_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ int x = x_orig->data.val;
+ int y = y_orig->data.val;
+ if (x >= 0) {
+ if (y <= EL_GORDO - x) {
+ ret->data.val = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.val = EL_GORDO;
+ }
+ } else if (-y <= EL_GORDO + x) {
+ ret->data.val = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.val = negative_EL_GORDO;
+ }
+}
+
+static int mp_make_fraction (MP mp, int p, int q)
+{
+ if (q == 0) {
+ mp_confusion (mp, "division by zero");
+ return 0;
+ } else {
+ double d = TWEXP28 * (double) p / (double) q;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ mp->arith_error = 1;
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? -q : q) & 077777) * (((i & 037777) << 1) - 1) & 04000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ mp->arith_error = 1;
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? q : -q) & 077777) * (((i & 037777) << 1) + 1) & 04000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+ }
+}
+
+void mp_number_make_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q)
+{
+ ret->data.val = mp_make_fraction (mp, p->data.val, q->data.val);
+}
+
+int mp_take_fraction (MP mp, int p, int q)
+{
+ double d = (double) p *(double) q *TWEXP_28;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ if (d != TWEXP31 || (((p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((p & 077777) * (q & 077777)) & 040000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ if (d != -TWEXP31 || ((-(p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && ((-(p & 077777) * (q & 077777)) & 040000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+}
+
+void mp_number_take_fraction (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ ret->data.val = mp_take_fraction (mp, p_orig->data.val, q_orig->data.val);
+}
+
+static int mp_take_scaled (MP mp, int p, int q)
+{
+ double d = (double) p *(double) q *TWEXP_16;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ if (d != TWEXP31 || (((p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((p & 077777) * (q & 077777)) & 040000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ if (d != -TWEXP31 || ((-(p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && ((-(p & 077777) * (q & 077777)) & 040000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+}
+
+void mp_number_take_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ ret->data.val = mp_take_scaled(mp, p_orig->data.val, q_orig->data.val);
+}
+
+int mp_make_scaled (MP mp, int p, int q)
+{
+ if (q == 0) {
+ mp_confusion (mp, "division by zero");
+ return 0;
+ } else {
+ double d = TWEXP16 * (double) p / (double) q;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ mp->arith_error = 1;
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? -q : q) & 077777) * (((i & 037777) << 1) - 1) & 04000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ mp->arith_error = 1;
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? q : -q) & 077777) * (((i & 037777) << 1) + 1) & 04000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+ }
+}
+
+void mp_number_make_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ ret->data.val = mp_make_scaled(mp, p_orig->data.val, q_orig->data.val);
+}
+
+static int mp_round_decimals (MP mp, unsigned char *b, int k)
+{
+ unsigned a = 0;
+ int l = 0;
+ (void) mp;
+ for (l = k-1; l >= 0; l-- ) {
+ if (l<16) {
+ a = (a + (unsigned) (*(b+l) - '0') * two) / 10;
+ }
+ }
+ return (int) (a + 1)/2;
+}
+
+static void mp_wrapup_numeric_token (MP mp, int n, int f)
+{
+ if (n < 32768) {
+ int mod = (n * unity + f);
+ set_cur_mod(mod);
+ if (mod >= fraction_one) {
+ if (internal_value(mp_warning_check_internal).data.val > 0 && (mp->scanner_status != mp_tex_flushing_state)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Number is too large (%s)", mp_string_scaled(mp,mod));
+ mp_error(
+ mp,
+ msg,
+ "It is at least 4096. Continue and I'll try to cope with that big value;\n"
+ "but it might be dangerous. (Set warningcheck:=0 to suppress this message.)"
+ );
+ }
+ }
+ } else if (mp->scanner_status != mp_tex_flushing_state) {
+ mp_error(
+ mp,
+ "Enormous number has been reduced",
+ "I can\'t handle numbers bigger than 32767.99998; so I've changed your constant\n"
+ "to that maximum amount."
+ );
+ set_cur_mod(EL_GORDO);
+ }
+ set_cur_cmd(mp_numeric_command);
+}
+
+void mp_scan_fractional_token (MP mp, int n)
+{
+ int f;
+ int k = 0;
+ do {
+ k++;
+ mp->cur_input.loc_field++;
+ } while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class);
+ f = mp_round_decimals(mp, (unsigned char *)(mp->buffer+mp->cur_input.loc_field-k), (int) k);
+ if (f == unity) {
+ n++;
+ f = 0;
+ }
+ mp_wrapup_numeric_token(mp, n, f);
+}
+
+void mp_scan_numeric_token (MP mp, int n)
+{
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ if (n < 32768) {
+ n = 10 * n + mp->buffer[mp->cur_input.loc_field] - '0';
+ }
+ mp->cur_input.loc_field++;
+ }
+ if (! (mp->buffer[mp->cur_input.loc_field] == '.' && mp->char_class[mp->buffer[mp->cur_input.loc_field + 1]] == mp_digit_class)) {
+ mp_wrapup_numeric_token(mp, n, 0);
+ } else {
+ mp->cur_input.loc_field++;
+ mp_scan_fractional_token(mp, n);
+ }
+}
+
+void mp_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t)
+{
+ int acc, num, denom;
+ acc = mp_take_fraction(mp, st->data.val - (sf->data.val / 16), sf->data.val - (st->data.val / 16));
+ acc = mp_take_fraction(mp, acc, ct->data.val - cf->data.val);
+ num = fraction_two + mp_take_fraction(mp, acc, 379625062);
+ denom = fraction_three + mp_take_fraction(mp, ct->data.val, 497706707) + mp_take_fraction (mp, cf->data.val, 307599661);
+ if (t->data.val != unity) {
+ num = mp_make_scaled (mp, num, t->data.val);
+ }
+ if (num / 4 >= denom) {
+ ret->data.val = fraction_four;
+ } else {
+ ret->data.val = mp_make_fraction(mp, num, denom);
+ }
+}
+
+static int mp_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ int a = a_orig->data.val;
+ int b = b_orig->data.val;
+ int c = c_orig->data.val;
+ int d = d_orig->data.val;
+ if (a < 0) {
+ a = -a;
+ b = -b;
+ }
+ if (c < 0) {
+ c = -c;
+ d = -d;
+ }
+ if (d <= 0) {
+ if (b >= 0) {
+ if ((a == 0 || b == 0) && (c == 0 || d == 0)) {
+ return 0;
+ } else {
+ return 1;
+ }
+ } else if (d == 0) {
+ return a == 0 ? 0 : -1;
+ } else {
+ int q = a;
+ a = c;
+ c = q;
+ q = -b;
+ b = -d;
+ d = q;
+ }
+ } else if (b <= 0) {
+ if (b < 0 && a > 0) {
+ return -1;
+ } else {
+ return c == 0 ? 0 : -1;
+ }
+ }
+ while (1) {
+ int q = a / d;
+ int r = c / b;
+ if (q != r) {
+ return q > r ? 1 : -1;
+ } else {
+ q = a % d;
+ r = c % b;
+ if (r == 0) {
+ return q ? 1 : 0;
+ } else if (q == 0) {
+ return -1;
+ } else {
+ a = b;
+ b = q;
+ c = d;
+ d = r;
+ }
+ }
+ }
+}
+
+static void mp_crossing_point (MP mp, mp_number *ret, mp_number *aa, mp_number *bb, mp_number *cc)
+{
+ int x, xx, x0, x1, x2;
+ int a = aa->data.val;
+ int b = bb->data.val;
+ int c = cc->data.val;
+ int d;
+ (void) mp;
+ if (a < 0) {
+ ret->data.val = zero_crossing;
+ return;
+ } else if (c >= 0) {
+ if (b >= 0) {
+ if (c > 0) {
+ ret->data.val = no_crossing;
+ } else if ((a == 0) && (b == 0)) {
+ ret->data.val = no_crossing;
+ } else {
+ ret->data.val = one_crossing;
+ }
+ return;
+ } else if (a == 0) {
+ ret->data.val = zero_crossing;
+ return;
+ }
+ } else if (a == 0) {
+ if (b <= 0) {
+ ret->data.val = zero_crossing;
+ return;
+ }
+ }
+ d = 1;
+ x0 = a;
+ x1 = a - b;
+ x2 = b - c;
+ do {
+ x = (x1 + x2) / 2;
+ if (x1 - x0 > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ xx = x1 + x - x0;
+ if (xx > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ x0 = x0 - xx;
+ if ((x <= x0) && (x + x2 <= x0)) {
+ ret->data.val = no_crossing;
+ return;
+ } else {
+ x1 = x;
+ d = d + d + 1;
+ }
+ }
+ }
+ } while (d < fraction_one);
+ ret->data.val = d - fraction_one;
+}
+
+int mp_round_unscaled(mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ if (x >= 32768) {
+ return 1 + ((x-32768) / 65536);
+ } else if (x >= -32768) {
+ return 0;
+ } else {
+ return -(1+((-(x+1)-32768) / 65536));
+ }
+}
+
+void mp_number_floor(mp_number *i)
+{
+ i->data.val = i->data.val&-65536;
+}
+
+void mp_fraction_to_round_scaled(mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ x_orig->type = mp_scaled_type;
+ x_orig->data.val = (x>=2048 ? 1+((x-2048) / 4096) : ( x>=-2048 ? 0 : -(1+((-(x+1)-2048) / 4096))));
+}
+
+void mp_square_rt (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ if (x <= 0) {
+ if (x < 0) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Square root of %s has been replaced by 0", mp_string_scaled(mp, x));
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ ret->data.val = 0;
+ } else {
+ int k = 23;
+ int y;
+ int q = 2;
+ while (x < fraction_two) {
+ k--;
+ x = x + x + x + x;
+ }
+ if (x < fraction_four)
+ y = 0;
+ else {
+ x = x - fraction_four;
+ y = 1;
+ }
+ do {
+ x += x;
+ y += y;
+ if (x >= fraction_four) {
+ x = x - fraction_four;
+ y++;
+ };
+ x += x;
+ y = y + y - q;
+ q += q;
+ if (x >= fraction_four) {
+ x = x - fraction_four;
+ y++;
+ };
+ if (y > (int) q) {
+ y -= q;
+ q += 2;
+ } else if (y <= 0) {
+ q -= 2;
+ y += q;
+ };
+ k--;
+ } while (k != 0);
+ ret->data.val = (int) (q/2);
+ }
+}
+
+void mp_pyth_add (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ int a = abs(a_orig->data.val);
+ int b = abs(b_orig->data.val);
+ if (a < b) {
+ int r = b;
+ b = a;
+ a = r;
+ }
+ if (b > 0) {
+ int big;
+ if (a < fraction_two) {
+ big = 0;
+ } else {
+ a = a / 4;
+ b = b / 4;
+ big = 1;
+ }
+ while (1) {
+ int r = mp_make_fraction(mp, b, a);
+ r = mp_take_fraction(mp, r, r);
+ if (r == 0) {
+ break;
+ } else {
+ r = mp_make_fraction(mp, r, fraction_four + r);
+ a = a + mp_take_fraction(mp, a + a, r);
+ b = mp_take_fraction(mp, b, r);
+ }
+ }
+ if (big) {
+ if (a < fraction_two) {
+ a = a + a + a + a;
+ } else {
+ mp->arith_error = 1;
+ a = EL_GORDO;
+ }
+ }
+ }
+ ret->data.val = a;
+}
+
+void mp_pyth_sub (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ int a = abs(a_orig->data.val);
+ int b = abs(b_orig->data.val);
+ if (a <= b) {
+ if (a < b) {
+ char msg[256];
+ char *astr = mp_strdup(mp_string_scaled(mp, a));
+ mp_snprintf(msg, 256, "Pythagorean subtraction %s+-+%s has been replaced by 0", astr, mp_string_scaled(mp, b));
+ mp_memory_free(astr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ a = 0;
+ } else {
+ int big;
+ if (a < fraction_four) {
+ big = 0;
+ } else {
+ a = (int) a/2;
+ b = (int) b/2;
+ big = 1;
+ }
+ while (1) {
+ int r = mp_make_fraction(mp, b, a);
+ r = mp_take_fraction(mp, r, r);
+ if (r == 0) {
+ break;
+ } else {
+ r = mp_make_fraction(mp, r, fraction_four - r);
+ a = a - mp_take_fraction(mp, a + a, r);
+ b = mp_take_fraction(mp, b, r);
+ }
+ }
+ if (big) {
+ a *= 2;
+ }
+ }
+ ret->data.val = a;
+}
+
+void mp_power_of (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ double p = pow(mp_number_to_double(a_orig), mp_number_to_double(b_orig));
+ long r = lround(p * 65536.0);
+ if (r > 0) {
+ if (r >= EL_GORDO) {
+ mp->arith_error = 1;
+ r = EL_GORDO;
+ }
+ } else if (r < 0) {
+ if (r <= - EL_GORDO) {
+ mp->arith_error = 1;
+ r = - EL_GORDO;
+ }
+ }
+ ret->data.val = r;
+}
+
+void mp_m_log (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ if (x <= 0) {
+ {
+ char msg[256];
+ mp_snprintf(msg, 256, "Logarithm of %s has been replaced by 0", mp_string_scaled(mp, x));
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take logs of non-positive numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.val = 0;
+ }
+ } else {
+ int k = 2;
+ int y = 1302456956 + 4 - 100;
+ int z = 27595 + 6553600;
+ while (x < fraction_four) {
+ x = 2*x;
+ y -= 93032639;
+ z -= 48782;
+ }
+ y = y + (z / unity);
+ while (x > fraction_four + 4) {
+ {
+ z = ((x - 1) / two_to_the (k)) + 1;
+ while (x < fraction_four + z) {
+ z = (z + 1)/2;
+ k++;
+ };
+ y += mp_m_spec_log[k];
+ x -= z;
+ }
+ }
+ ret->data.val = (y / 8);
+ }
+}
+
+void mp_m_exp (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ int y, z;
+ int x = x_orig->data.val;
+ if (x > 174436200) {
+ mp->arith_error = 1;
+ ret->data.val = EL_GORDO;
+ } else if (x < -197694359) {
+ ret->data.val = 0;
+ } else {
+ if (x <= 0) {
+ z = -8 * x;
+ y = 04000000;
+ } else {
+ if (x <= 127919879) {
+ z = 1023359037 - 8 * x;
+ } else {
+ z = 8 * (174436200 - x);
+ }
+ y = EL_GORDO;
+ }
+ {
+ int k = 1;
+ while (z > 0) {
+ while (z >= mp_m_spec_log[k]) {
+ z -= mp_m_spec_log[k];
+ y = y - 1 - ((y - two_to_the(k - 1)) / two_to_the(k));
+ }
+ k++;
+ }
+ }
+ if (x <= 127919879) {
+ ret->data.val = ((y + 8) / 16);
+ } else {
+ ret->data.val = y;
+ }
+ }
+}
+
+void mp_n_arg (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ int z;
+ int t;
+ int k;
+ int octant;
+ int x = x_orig->data.val;
+ int y = y_orig->data.val;
+ if (x >= 0) {
+ octant = first_octant;
+ } else {
+ x = -x;
+ octant = first_octant + negate_x;
+ }
+ if (y < 0) {
+ y = -y;
+ octant = octant + negate_y;
+ }
+ if (x < y) {
+ t = y;
+ y = x;
+ x = t;
+ octant = octant + switch_x_and_y;
+ }
+ if (x == 0) {
+ mp_error(
+ mp,
+ "angle(0,0) is taken as zero",
+ "The 'angle' between two identical points is undefined. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.val = 0;
+ } else {
+ ret->type = mp_angle_type;
+ while (x >= fraction_two) {
+ x = x/2;
+ y = y/2;
+ }
+ z = 0;
+ if (y > 0) {
+ while (x < fraction_one) {
+ x += x;
+ y += y;
+ };
+ k = 0;
+ do {
+ y += y;
+ k++;
+ if (y > x) {
+ z = z + mp_m_spec_atan[k];
+ t = x;
+ x = x + (y / two_to_the(k + k));
+ y = y - t;
+ };
+ } while (k != 15);
+ do {
+ y += y;
+ k++;
+ if (y > x) {
+ z = z + mp_m_spec_atan[k];
+ y = y - x;
+ };
+ } while (k != 26);
+ }
+
+ switch (octant) {
+ case first_octant: ret->data.val = z; break;
+ case second_octant: ret->data.val = -z + ninety_deg; break;
+ case third_octant: ret->data.val = z + ninety_deg; break;
+ case fourth_octant: ret->data.val = -z + one_eighty_deg; break;
+ case fifth_octant: ret->data.val = z - one_eighty_deg; break;
+ case sixth_octant: ret->data.val = -z - ninety_deg; break;
+ case seventh_octant: ret->data.val = z - ninety_deg; break;
+ case eighth_octant: ret->data.val = -z; break;
+ }
+ }
+}
+
+void mp_n_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin)
+{
+ int k;
+ int q;
+ int x, y, t;
+ int z = z_orig->data.val;
+ mp_number x_n, y_n, ret;
+ mp_allocate_number(mp, &ret, mp_scaled_type);
+ mp_allocate_number(mp, &x_n, mp_scaled_type);
+ mp_allocate_number(mp, &y_n, mp_scaled_type);
+ while (z < 0) {
+ z = z + three_sixty_deg;
+ }
+ z = z % three_sixty_deg;
+ q = z / forty_five_deg;
+ z = z % forty_five_deg;
+ x = fraction_one;
+ y = x;
+ if (! odd(q)) {
+ z = forty_five_deg - z;
+ }
+ k = 1;
+ while (z > 0) {
+ if (z >= mp_m_spec_atan[k]) {
+ z = z - mp_m_spec_atan[k];
+ t = x;
+ x = t + y / two_to_the(k);
+ y = y - t / two_to_the(k);
+ }
+ k++;
+ }
+ if (y < 0) {
+ y = 0;
+ }
+ switch (q) {
+ case 0: break;
+ case 1: t = x; x = y; y = t; break;
+ case 2: t = x; x = -y; y = t; break;
+ case 3: x = -x; break;
+ case 4: x = -x; y = -y; break;
+ case 5: t = x; x = -y; y = -t; break;
+ case 6: t = x; x = y; y = -t; break;
+ case 7: y = -y; break;
+ }
+ x_n.data.val = x;
+ y_n.data.val = y;
+ mp_pyth_add(mp, &ret, &x_n, &y_n);
+ n_cos->data.val = mp_make_fraction(mp, x, ret.data.val);
+ n_sin->data.val = mp_make_fraction(mp, y, ret.data.val);
+ mp_free_number(mp, &ret);
+ mp_free_number(mp, &x_n);
+ mp_free_number(mp, &y_n);
+}
+
+void mp_init_randoms (MP mp, int seed)
+{
+ int k = 1;
+ int j = abs(seed);
+ while (j >= fraction_one) {
+ j = j/2;
+ }
+ for (int i = 0; i <= 54; i++) {
+ int jj = k;
+ k = j - k;
+ j = jj;
+ if (k < 0) {
+ k += fraction_one;
+ }
+ mp->randoms[(i * 21) % 55].data.val = j;
+ }
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+}
+
+void mp_print_number (MP mp, mp_number *n)
+{
+ mp_print_e_str(mp, mp_string_scaled(mp, n->data.val));
+}
+
+char *mp_number_tostring (MP mp, mp_number *n)
+{
+ return mp_string_scaled(mp, n->data.val);
+}
+
+void mp_number_modulo(mp_number *a, mp_number *b)
+{
+ a->data.val = a->data.val % b->data.val;
+}
+
+static void mp_next_random (MP mp, mp_number *ret)
+{
+ if ( mp->j_random == 0) {
+ mp_new_randoms(mp);
+ } else {
+ mp->j_random = mp->j_random-1;
+ }
+ mp_number_clone(ret, &(mp->randoms[mp->j_random]));
+}
+
+static void mp_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ mp_number x, abs_x, u, y;
+ mp_allocate_number(mp, &y, mp_fraction_type);
+ mp_allocate_clone(mp, &x, mp_scaled_type, x_orig);
+ mp_allocate_abs(mp, &abs_x, mp_scaled_type, &x);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_next_random(mp, &u);
+ mp_number_take_fraction(mp, &y, &abs_x, &u);
+ if (mp_number_equal(&y, &abs_x)) {
+ mp_number_clone(ret, &((math_data *)mp->math)->md_zero_t);
+ } else if (mp_number_greater(&x, &((math_data *)mp->math)->md_zero_t)) {
+ mp_number_clone(ret, &y);
+ } else {
+ mp_number_clone(ret, &y);
+ mp_number_negate(ret);
+ }
+ mp_free_number(mp, &y);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &x);
+ mp_free_number(mp, &u);
+}
+
+static void mp_m_norm_rand (MP mp, mp_number *ret)
+{
+ mp_number abs_x, u, r, la, xa;
+ mp_allocate_number(mp, &la, mp_scaled_type);
+ mp_allocate_number(mp, &xa, mp_scaled_type);
+ mp_allocate_number(mp, &abs_x, mp_scaled_type);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_allocate_number(mp, &r, mp_scaled_type);
+ do {
+ do {
+ mp_number v;
+ mp_allocate_number(mp, &v, mp_scaled_type);
+ mp_next_random(mp, &v);
+ mp_number_subtract(&v, &((math_data *)mp->math)->md_fraction_half_t);
+ mp_number_take_fraction(mp, &xa, &((math_data *)mp->math)->md_sqrt_8_e_k, &v);
+ mp_free_number(mp, &v);
+ mp_next_random(mp, &u);
+ mp_number_clone(&abs_x, &xa);
+ mp_number_abs(&abs_x);
+ } while (! mp_number_less(&abs_x, &u));
+ mp_number_make_fraction(mp, &r, &xa, &u);
+ mp_number_clone(&xa, &r);
+ mp_m_log(mp, &la, &u);
+ mp_set_number_from_subtraction(&la, &((math_data *)mp->math)->md_twelve_ln_2_k, &la);
+ } while (mp_ab_vs_cd(&((math_data *)mp->math)->md_one_k, &la, &xa, &xa) < 0);
+ mp_number_clone(ret, &xa);
+ mp_free_number(mp, &r);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &la);
+ mp_free_number(mp, &xa);
+ mp_free_number(mp, &u);
+}
diff --git a/source/luametatex/source/mp/mpc/mpmath.h b/source/luametatex/source/mp/mpc/mpmath.h
new file mode 100644
index 000000000..c82707bb8
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmath.h
@@ -0,0 +1,12 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# ifndef MPMATH_H
+# define MPMATH_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_scaled_math (MP mp);
+
+# endif
+
diff --git a/source/luametatex/source/mp/mpc/mpmathbinary.c b/source/luametatex/source/mp/mpc/mpmathbinary.c
new file mode 100644
index 000000000..77adce0c6
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmathbinary.c
@@ -0,0 +1,16 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# include <stdio.h>
+
+# include "mpconfig.h"
+# include "mpmathbinary.h"
+
+extern void tex_normal_warning (const char *t, const char *p);
+
+math_data *mp_initialize_binary_math (MP mp)
+{
+ (void) (mp);
+ tex_normal_warning("mplib", "binary mode is not available.");
+ return NULL;
+}
diff --git a/source/luametatex/source/mp/mpc/mpmathbinary.h b/source/luametatex/source/mp/mpc/mpmathbinary.h
new file mode 100644
index 000000000..a321842ac
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmathbinary.h
@@ -0,0 +1,12 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# ifndef MPMATHBINARY_H
+# define MPMATHBINARY_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_binary_math (MP mp);
+
+# endif
+
diff --git a/source/luametatex/source/mp/mpc/mpmathdecimal.c b/source/luametatex/source/mp/mpc/mpmathdecimal.c
new file mode 100644
index 000000000..5ffa1e04f
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmathdecimal.c
@@ -0,0 +1,1603 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# include "mpconfig.h"
+# include "mpmathdecimal.h"
+
+# define DECNUMDIGITS 1000
+# include "decNumber.h"
+
+
+# define E_STRING "2.7182818284590452353602874713526624977572470936999595749669676277240766303535"
+# define PI_STRING "3.1415926535897932384626433832795028841971693993751058209749445923078164062862"
+# define fraction_multiplier 4096
+# define angle_multiplier 16
+# define unity 1
+# define two 2
+# define three 3
+# define four 4
+# define half_unit 0.5
+# define three_quarter_unit 0.75
+# define coef_bound ((7.0/3.0)*fraction_multiplier)
+# define fraction_threshold 0.04096
+# define half_fraction_threshold (fraction_threshold/2)
+# define scaled_threshold 0.000122
+# define half_scaled_threshold (scaled_threshold/2)
+# define near_zero_angle (0.0256*angle_multiplier)
+# define p_over_v_threshold 0x80000
+# define equation_threshold 0.001
+# define epsilon pow(2.0,-173.0)
+# define epsilonf pow(2.0,-52.0)
+# define EL_GORDO "1E1000000"
+# define negative_EL_GORDO "-1E1000000"
+# define warning_limit "1E1000000"
+# define DECPRECISION_DEFAULT 34
+# define FACTORIALS_CACHESIZE 50
+# define too_precise(a) (a == (DEC_Inexact+DEC_Rounded))
+# define too_large(a) (a & DEC_Overflow)
+# define fraction_half (fraction_multiplier/2)
+# define fraction_one (1*fraction_multiplier)
+# define fraction_two (2*fraction_multiplier)
+# define fraction_three (3*fraction_multiplier)
+# define fraction_four (4*fraction_multiplier)
+# define no_crossing mp_decimal_data.fraction_one_plus_decNumber
+# define one_crossing mp_decimal_data.fraction_one_decNumber
+# define zero_crossing mp_decimal_data.zero
+# define odd(A) (abs(A) % 2 == 1)
+# define set_cur_cmd(A) mp->cur_mod_->type = (A)
+# define set_cur_mod(A) decNumberCopy((decNumber *) (mp->cur_mod_->data.n.data.num), A)
+# define decNumberIsPositive(A) (! (decNumberIsZero(A) || decNumberIsNegative(A)))
+
+static int mp_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_double (MP mp, mp_number *n, double v);
+static void mp_allocate_number (MP mp, mp_number *n, mp_number_type t);
+static void mp_decnumber_check (MP mp, decNumber *dec, decContext *context);
+static void mp_decimal_abs (mp_number *A);
+static void mp_decimal_crossing_point (MP mp, mp_number *ret, mp_number *a, mp_number *b, mp_number *c);
+static void mp_decimal_fraction_to_round_scaled (mp_number *x);
+static void mp_decimal_m_exp (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_decimal_m_log (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_decimal_m_norm_rand (MP mp, mp_number *ret);
+static void mp_decimal_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig);
+void mp_decimal_make_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q);
+static void mp_decimal_n_arg (MP mp, mp_number *ret, mp_number *x, mp_number *y);
+static void mp_decimal_number_make_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_number_make_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_number_modulo (mp_number *a, mp_number *b);
+static void mp_decimal_number_take_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_number_take_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_power_of (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_decimal_print_number (MP mp, mp_number *n);
+static void mp_decimal_pyth_add (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_decimal_pyth_sub (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_decimal_scan_fractional_token (MP mp, int n);
+static void mp_decimal_scan_numeric_token (MP mp, int n);
+static void mp_decimal_set_precision (MP mp);
+static void mp_decimal_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin);
+static void mp_decimal_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig);
+static void mp_decimal_square_rt (MP mp, mp_number *ret, mp_number *x_orig);
+void mp_decimal_take_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q);
+static void mp_decimal_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t);
+static void mp_free_decimal_math (MP mp);
+static void mp_free_number (MP mp, mp_number *n);
+static void mp_init_randoms (MP mp, int seed);
+static void mp_number_abs_clone (mp_number *A, mp_number *B);
+static void mp_number_add (mp_number *A, mp_number *B);
+static void mp_number_add_scaled (mp_number *A, int B);
+static void mp_number_angle_to_scaled (mp_number *A);
+static void mp_number_clone (mp_number *A, mp_number *B);
+static void mp_number_divide_int (mp_number *A, int B);
+static void mp_number_double (mp_number *A);
+static int mp_number_equal (mp_number *A, mp_number *B);
+static void mp_number_floor (mp_number *i);
+static void mp_number_fraction_to_scaled (mp_number *A);
+static int mp_number_greater (mp_number *A, mp_number *B);
+static void mp_number_half (mp_number *A);
+static int mp_number_less (mp_number *A, mp_number *B);
+static void mp_number_multiply_int (mp_number *A, int B);
+static void mp_number_negate (mp_number *A);
+static void mp_number_negated_clone (mp_number *A, mp_number *B);
+static int mp_number_nonequalabs (mp_number *A, mp_number *B);
+static int mp_number_odd (mp_number *A);
+static void mp_number_scaled_to_angle (mp_number *A);
+static void mp_number_scaled_to_fraction (mp_number *A);
+static void mp_number_subtract (mp_number *A, mp_number *B);
+static void mp_number_swap (mp_number *A, mp_number *B);
+static int mp_number_to_boolean (mp_number *A);
+static double mp_number_to_double (mp_number *A);
+static int mp_number_to_int (mp_number *A);
+static int mp_number_to_scaled (mp_number *A);
+static int mp_round_unscaled (mp_number *x_orig);
+static void mp_set_decimal_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_boolean (mp_number *A, int B);
+static void mp_set_decimal_from_div (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_double (mp_number *A, double B);
+static void mp_set_decimal_from_int (mp_number *A, int B);
+static void mp_set_decimal_from_int_div (mp_number *A, mp_number *B, int C);
+static void mp_set_decimal_from_int_mul (mp_number *A, mp_number *B, int C);
+static void mp_set_decimal_from_mul (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_scaled (mp_number *A, int B);
+static void mp_set_decimal_from_subtraction (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_half_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C);
+static void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop);
+static char *mp_decimal_number_tostring (MP mp, mp_number *n);
+static char *mp_decnumber_tostring (decNumber *n);
+typedef struct mp_decimal_info {
+ decContext set;
+ decContext limitedset;
+ decNumber zero;
+ decNumber one;
+ decNumber minusone;
+ decNumber two_decNumber;
+ decNumber three_decNumber;
+ decNumber four_decNumber;
+ decNumber fraction_multiplier_decNumber;
+ decNumber angle_multiplier_decNumber;
+ decNumber fraction_one_decNumber;
+ decNumber fraction_one_plus_decNumber;
+ decNumber PI_decNumber;
+ decNumber epsilon_decNumber;
+ decNumber EL_GORDO_decNumber;
+ decNumber negative_EL_GORDO_decNumber;
+ decNumber **factorials;
+ int last_cached_factorial;
+ int initialized;
+} mp_decimal_info;
+mp_decimal_info mp_decimal_data = {
+ .factorials = NULL,
+ .last_cached_factorial = 0,
+ .initialized = 0,
+};
+static void checkZero(decNumber *ret)
+{
+ if (decNumberIsZero(ret) && decNumberIsNegative(ret)) {
+ decNumberZero(ret);
+ }
+}
+static int decNumberLess(decNumber *a, decNumber *b)
+{
+ decNumber comp;
+ decNumberCompare(&comp, a, b, &mp_decimal_data.set);
+ return decNumberIsNegative(&comp);
+}
+static int decNumberGreater(decNumber *a, decNumber *b)
+{
+ decNumber comp;
+ decNumberCompare(&comp, a, b, &mp_decimal_data.set);
+ return decNumberIsPositive(&comp);
+}
+static void decNumberFromDouble(decNumber *A, double B)
+{
+ char buffer[1000];
+ char *c = buffer;
+ snprintf(buffer, 1000, "%-650.325lf", B);
+ while (*c++) {
+ if (*c == ' ') {
+ *c = '\0';
+ break;
+ }
+ }
+ decNumberFromString(A, buffer, &mp_decimal_data.set);
+}
+static double decNumberToDouble(decNumber *A)
+{
+ char *buffer = mp_memory_allocate(A->digits + 14);
+ double res = 0.0;
+ decNumberToString(A, buffer);
+ if (sscanf(buffer, "%lf", &res)) {
+ mp_memory_free(buffer);
+ return res;
+ } else {
+ mp_memory_free(buffer);
+ return 0.0;
+ }
+}
+
+void mp_decnumber_check(MP mp, decNumber *dec, decContext *context)
+{
+ int test = 0;
+ (void) mp;
+ if (context->status & DEC_Overflow) {
+ test = 1;
+ context->status &= ~DEC_Overflow;
+ }
+ if (context->status & DEC_Underflow) {
+ test = 1;
+ context->status &= ~DEC_Underflow;
+ }
+ if (context->status & DEC_Errors) {
+ test = 1;
+ decNumberZero(dec);
+ }
+ context->status = 0;
+ if (decNumberIsSpecial(dec)) {
+ test = 1;
+ if (decNumberIsInfinite(dec)) {
+ if (decNumberIsNegative(dec)) {
+ decNumberCopyNegate(dec, &mp_decimal_data.EL_GORDO_decNumber);
+ } else {
+ decNumberCopy(dec, &mp_decimal_data.EL_GORDO_decNumber);
+ }
+ } else {
+ decNumberZero(dec);
+ }
+ }
+ if (decNumberIsZero(dec) && decNumberIsNegative(dec)) {
+ decNumberZero(dec);
+ }
+ mp->arith_error = test;
+}
+
+static void decNumberAtan(decNumber *result, decNumber *x_orig, decContext *localset)
+{
+ decNumber x;
+ decNumberCopy(&x, x_orig);
+ if (decNumberIsZero(&x)) {
+ decNumberCopy(result, &x);
+ } else {
+ decNumber f, g, mx2, term;
+ for (int i = 0; i<2; i++) {
+ decNumber y;
+ decNumberMultiply(&y, &x, &x, localset);
+ decNumberAdd(&y, &y, &mp_decimal_data.one, localset);
+ decNumberSquareRoot(&y, &y, localset);
+ decNumberSubtract(&y, &y, &mp_decimal_data.one, localset);
+ decNumberDivide(&x, &y, &x, localset);
+ if (decNumberIsZero(&x)) {
+ decNumberCopy(result, &x);
+ return;
+ }
+ }
+ decNumberCopy(&f, &x);
+ decNumberCopy(&g, &mp_decimal_data.one);
+ decNumberCopy(&term, &x);
+ decNumberCopy(result, &x);
+ decNumberMultiply(&mx2, &x, &x, localset);
+ decNumberMinus (&mx2, &mx2, localset);
+ for (int i = 0; i < 2 * localset->digits; i++) {
+ decNumberMultiply(&f, &f, &mx2, localset);
+ decNumberAdd(&g, &g, &mp_decimal_data.two_decNumber, localset);
+ decNumberDivide(&term, &f, &g, localset);
+ decNumberAdd(result, result, &term, localset);
+ }
+ decNumberAdd(result, result, result, localset);
+ decNumberAdd(result, result, result, localset);
+ }
+}
+
+static void decNumberAtan2(decNumber *result, decNumber *y, decNumber *x, decContext *localset)
+{
+ if (! decNumberIsInfinite(x) && ! decNumberIsZero(y) && ! decNumberIsInfinite(y) && ! decNumberIsZero(x)) {
+ decNumber temp;
+ decNumberDivide(&temp, y, x, localset);
+ decNumberAtan(result, &temp, localset);
+ if (decNumberIsNegative(x)) {
+ if (decNumberIsNegative(y)) {
+ decNumberSubtract(result, result, &mp_decimal_data.PI_decNumber, localset);
+ } else {
+ decNumberAdd(result, result, &mp_decimal_data.PI_decNumber, localset);
+ }
+ }
+ } else {
+ if (decNumberIsInfinite(y) && decNumberIsInfinite(x)) {
+ decNumberDivide(result, &mp_decimal_data.PI_decNumber, &mp_decimal_data.four_decNumber, localset);
+ if (decNumberIsNegative(x) ) {
+ decNumber a;
+ decNumberFromDouble(&a, 3.0);
+ decNumberMultiply(result, result, &a, localset);
+ }
+ } else if (!decNumberIsZero(y) && !decNumberIsInfinite(x) ) {
+ decNumberDivide(result, &mp_decimal_data.PI_decNumber, &mp_decimal_data.two_decNumber, localset);
+ } else {
+ if (decNumberIsNegative(x)) {
+ decNumberCopy(result, &mp_decimal_data.PI_decNumber);
+ } else {
+ decNumberZero(result);
+ }
+ }
+ if (decNumberIsNegative(y)) {
+ decNumberMinus(result, result, localset);
+ }
+ }
+}
+
+math_data *mp_initialize_decimal_math (MP mp)
+{
+ math_data *math = (math_data *) mp_memory_allocate(sizeof(math_data));
+ decContextDefault(&mp_decimal_data.set, DEC_INIT_BASE);
+ mp_decimal_data.set.traps = 0;
+ decContextDefault(&mp_decimal_data.limitedset, DEC_INIT_BASE);
+ mp_decimal_data.limitedset.traps = 0;
+ mp_decimal_data.limitedset.emax = 999999;
+ mp_decimal_data.limitedset.emin = -999999;
+ mp_decimal_data.set.digits = DECPRECISION_DEFAULT;
+ mp_decimal_data.limitedset.digits = DECPRECISION_DEFAULT;
+ if (! mp_decimal_data.initialized) {
+ mp_decimal_data.initialized = 1 ;
+ decNumberFromInt32(&mp_decimal_data.one, 1);
+ decNumberFromInt32(&mp_decimal_data.minusone, -1);
+ decNumberFromInt32(&mp_decimal_data.zero, 0);
+ decNumberFromInt32(&mp_decimal_data.two_decNumber, two);
+ decNumberFromInt32(&mp_decimal_data.three_decNumber, three);
+ decNumberFromInt32(&mp_decimal_data.four_decNumber, four);
+ decNumberFromInt32(&mp_decimal_data.fraction_multiplier_decNumber, fraction_multiplier);
+ decNumberFromInt32(&mp_decimal_data.fraction_one_decNumber, fraction_one);
+ decNumberFromInt32(&mp_decimal_data.fraction_one_plus_decNumber, (fraction_one+1));
+ decNumberFromInt32(&mp_decimal_data.angle_multiplier_decNumber, angle_multiplier);
+ decNumberFromString(&mp_decimal_data.PI_decNumber, PI_STRING, &mp_decimal_data.set);
+ decNumberFromDouble(&mp_decimal_data.epsilon_decNumber, epsilon);
+ decNumberFromString(&mp_decimal_data.EL_GORDO_decNumber, EL_GORDO, &mp_decimal_data.set);
+ decNumberFromString(&mp_decimal_data.negative_EL_GORDO_decNumber, negative_EL_GORDO, &mp_decimal_data.set);
+ mp_decimal_data.factorials = (decNumber **) mp_memory_allocate(FACTORIALS_CACHESIZE * sizeof(decNumber *));
+ mp_decimal_data.factorials[0] = (decNumber *) mp_memory_allocate(sizeof(decNumber));
+ decNumberCopy(mp_decimal_data.factorials[0], &mp_decimal_data.one);
+ }
+ math->md_allocate = mp_allocate_number;
+ math->md_free = mp_free_number;
+ math->md_allocate_clone = mp_allocate_clone;
+ math->md_allocate_abs = mp_allocate_abs;
+ math->md_allocate_double = mp_allocate_double;
+ mp_allocate_number(mp, &math->md_precision_default, mp_scaled_type);
+ decNumberFromInt32( math->md_precision_default.data.num, DECPRECISION_DEFAULT);
+ mp_allocate_number(mp, &math->md_precision_max, mp_scaled_type);
+ decNumberFromInt32( math->md_precision_max.data.num, DECNUMDIGITS);
+ mp_allocate_number(mp, &math->md_precision_min, mp_scaled_type);
+ decNumberFromInt32( math->md_precision_min.data.num, 2);
+ mp_allocate_number(mp, &math->md_epsilon_t, mp_scaled_type);
+ decNumberCopy( math->md_epsilon_t.data.num, &mp_decimal_data.epsilon_decNumber);
+ mp_allocate_number(mp, &math->md_inf_t, mp_scaled_type);
+ decNumberCopy( math->md_inf_t.data.num, &mp_decimal_data.EL_GORDO_decNumber);
+ mp_allocate_number(mp, &math->md_negative_inf_t, mp_scaled_type);
+ decNumberCopy( math->md_negative_inf_t.data.num, &mp_decimal_data.negative_EL_GORDO_decNumber);
+ mp_allocate_number(mp, &math->md_warning_limit_t, mp_scaled_type);
+ decNumberFromString( math->md_warning_limit_t.data.num, warning_limit, &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_one_third_inf_t, mp_scaled_type);
+ decNumberDivide( math->md_one_third_inf_t.data.num, math->md_inf_t.data.num, &mp_decimal_data.three_decNumber, &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_unity_t, mp_scaled_type);
+ decNumberCopy( math->md_unity_t.data.num, &mp_decimal_data.one);
+ mp_allocate_number(mp, &math->md_two_t, mp_scaled_type);
+ decNumberFromInt32( math->md_two_t.data.num, two);
+ mp_allocate_number(mp, &math->md_three_t, mp_scaled_type);
+ decNumberFromInt32( math->md_three_t.data.num, three);
+ mp_allocate_number(mp, &math->md_half_unit_t, mp_scaled_type);
+ decNumberFromString( math->md_half_unit_t.data.num, "0.5", &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_three_quarter_unit_t, mp_scaled_type);
+ decNumberFromString( math->md_three_quarter_unit_t.data.num, "0.75", &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_zero_t, mp_scaled_type);
+ decNumberZero( math->md_zero_t.data.num);
+ {
+ decNumber fourzeroninesix;
+ decNumberFromInt32(&fourzeroninesix, 4096);
+ mp_allocate_number(mp, &math->md_arc_tol_k, mp_fraction_type);
+ decNumberDivide( math->md_arc_tol_k.data.num, &mp_decimal_data.one, &fourzeroninesix, &mp_decimal_data.set);
+ }
+ mp_allocate_number(mp, &math->md_fraction_one_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_one_t.data.num, fraction_one);
+ mp_allocate_number(mp, &math->md_fraction_half_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_half_t.data.num, fraction_half);
+ mp_allocate_number(mp, &math->md_fraction_three_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_three_t.data.num, fraction_three);
+ mp_allocate_number(mp, &math->md_fraction_four_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_four_t.data.num, fraction_four);
+ mp_allocate_number(mp, &math->md_three_sixty_deg_t, mp_angle_type);
+ decNumberFromInt32( math->md_three_sixty_deg_t.data.num, 360 * angle_multiplier);
+ mp_allocate_number(mp, &math->md_one_eighty_deg_t, mp_angle_type);
+ decNumberFromInt32( math->md_one_eighty_deg_t.data.num, 180 * angle_multiplier);
+ mp_allocate_number(mp, &math->md_negative_one_eighty_deg_t, mp_angle_type);
+ decNumberFromInt32( math->md_negative_one_eighty_deg_t.data.num, -180 * angle_multiplier);
+ mp_allocate_number(mp, &math->md_one_k, mp_scaled_type);
+ decNumberFromDouble( math->md_one_k.data.num, 1.0/64);
+ mp_allocate_number(mp, &math->md_sqrt_8_e_k, mp_scaled_type);
+ decNumberFromDouble( math->md_sqrt_8_e_k.data.num, 112428.82793 / 65536.0);
+ mp_allocate_number(mp, &math->md_twelve_ln_2_k, mp_fraction_type);
+ decNumberFromDouble( math->md_twelve_ln_2_k.data.num, 139548959.6165 / 65536.0);
+ mp_allocate_number(mp, &math->md_coef_bound_k, mp_fraction_type);
+ decNumberFromDouble( math->md_coef_bound_k.data.num,coef_bound);
+ mp_allocate_number(mp, &math->md_coef_bound_minus_1, mp_fraction_type);
+ decNumberFromDouble( math->md_coef_bound_minus_1.data.num,coef_bound - 1 / 65536.0);
+ mp_allocate_number(mp, &math->md_twelvebits_3, mp_scaled_type);
+ decNumberFromDouble( math->md_twelvebits_3.data.num, 1365 / 65536.0);
+ mp_allocate_number(mp, &math->md_twentysixbits_sqrt2_t, mp_fraction_type);
+ decNumberFromDouble( math->md_twentysixbits_sqrt2_t.data.num, 94906265.62 / 65536.0);
+ mp_allocate_number(mp, &math->md_twentyeightbits_d_t, mp_fraction_type);
+ decNumberFromDouble( math->md_twentyeightbits_d_t.data.num, 35596754.69 / 65536.0);
+ mp_allocate_number(mp, &math->md_twentysevenbits_sqrt2_d_t, mp_fraction_type);
+ decNumberFromDouble( math->md_twentysevenbits_sqrt2_d_t.data.num, 25170706.63 / 65536.0);
+ mp_allocate_number(mp, &math->md_fraction_threshold_t, mp_fraction_type);
+ decNumberFromDouble( math->md_fraction_threshold_t.data.num, fraction_threshold);
+ mp_allocate_number(mp, &math->md_half_fraction_threshold_t, mp_fraction_type);
+ decNumberFromDouble( math->md_half_fraction_threshold_t.data.num, half_fraction_threshold);
+ mp_allocate_number(mp, &math->md_scaled_threshold_t, mp_scaled_type);
+ decNumberFromDouble( math->md_scaled_threshold_t.data.num, scaled_threshold);
+ mp_allocate_number(mp, &math->md_half_scaled_threshold_t, mp_scaled_type);
+ decNumberFromDouble( math->md_half_scaled_threshold_t.data.num, half_scaled_threshold);
+ mp_allocate_number(mp, &math->md_near_zero_angle_t, mp_angle_type);
+ decNumberFromDouble( math->md_near_zero_angle_t.data.num, near_zero_angle);
+ mp_allocate_number(mp, &math->md_p_over_v_threshold_t, mp_fraction_type);
+ decNumberFromDouble( math->md_p_over_v_threshold_t.data.num, p_over_v_threshold);
+ mp_allocate_number(mp, &math->md_equation_threshold_t, mp_scaled_type);
+ decNumberFromDouble( math->md_equation_threshold_t.data.num, equation_threshold);
+ math->md_from_int = mp_set_decimal_from_int;
+ math->md_from_boolean = mp_set_decimal_from_boolean;
+ math->md_from_scaled = mp_set_decimal_from_scaled;
+ math->md_from_double = mp_set_decimal_from_double;
+ math->md_from_addition = mp_set_decimal_from_addition;
+ math->md_half_from_addition = mp_set_decimal_half_from_addition;
+ math->md_from_subtraction = mp_set_decimal_from_subtraction;
+ math->md_half_from_subtraction = mp_set_decimal_half_from_subtraction;
+ math->md_from_oftheway = mp_set_decimal_from_of_the_way;
+ math->md_from_div = mp_set_decimal_from_div;
+ math->md_from_mul = mp_set_decimal_from_mul;
+ math->md_from_int_div = mp_set_decimal_from_int_div;
+ math->md_from_int_mul = mp_set_decimal_from_int_mul;
+ math->md_negate = mp_number_negate;
+ math->md_add = mp_number_add;
+ math->md_subtract = mp_number_subtract;
+ math->md_half = mp_number_half;
+ math->md_do_double = mp_number_double;
+ math->md_abs = mp_decimal_abs;
+ math->md_clone = mp_number_clone;
+ math->md_negated_clone = mp_number_negated_clone;
+ math->md_abs_clone = mp_number_abs_clone;
+ math->md_swap = mp_number_swap;
+ math->md_add_scaled = mp_number_add_scaled;
+ math->md_multiply_int = mp_number_multiply_int;
+ math->md_divide_int = mp_number_divide_int;
+ math->md_to_boolean = mp_number_to_boolean;
+ math->md_to_scaled = mp_number_to_scaled;
+ math->md_to_double = mp_number_to_double;
+ math->md_to_int = mp_number_to_int;
+ math->md_odd = mp_number_odd;
+ math->md_equal = mp_number_equal;
+ math->md_less = mp_number_less;
+ math->md_greater = mp_number_greater;
+ math->md_nonequalabs = mp_number_nonequalabs;
+ math->md_round_unscaled = mp_round_unscaled;
+ math->md_floor_scaled = mp_number_floor;
+ math->md_fraction_to_round_scaled = mp_decimal_fraction_to_round_scaled;
+ math->md_make_scaled = mp_decimal_number_make_scaled;
+ math->md_make_fraction = mp_decimal_number_make_fraction;
+ math->md_take_fraction = mp_decimal_number_take_fraction;
+ math->md_take_scaled = mp_decimal_number_take_scaled;
+ math->md_velocity = mp_decimal_velocity;
+ math->md_n_arg = mp_decimal_n_arg;
+ math->md_m_log = mp_decimal_m_log;
+ math->md_m_exp = mp_decimal_m_exp;
+ math->md_m_unif_rand = mp_decimal_m_unif_rand;
+ math->md_m_norm_rand = mp_decimal_m_norm_rand;
+ math->md_pyth_add = mp_decimal_pyth_add;
+ math->md_pyth_sub = mp_decimal_pyth_sub;
+ math->md_power_of = mp_decimal_power_of;
+ math->md_fraction_to_scaled = mp_number_fraction_to_scaled;
+ math->md_scaled_to_fraction = mp_number_scaled_to_fraction;
+ math->md_scaled_to_angle = mp_number_scaled_to_angle;
+ math->md_angle_to_scaled = mp_number_angle_to_scaled;
+ math->md_init_randoms = mp_init_randoms;
+ math->md_sin_cos = mp_decimal_sin_cos;
+ math->md_slow_add = mp_decimal_slow_add;
+ math->md_sqrt = mp_decimal_square_rt;
+ math->md_print = mp_decimal_print_number;
+ math->md_tostring = mp_decimal_number_tostring;
+ math->md_modulo = mp_decimal_number_modulo;
+ math->md_ab_vs_cd = mp_ab_vs_cd;
+ math->md_crossing_point = mp_decimal_crossing_point;
+ math->md_scan_numeric = mp_decimal_scan_numeric_token;
+ math->md_scan_fractional = mp_decimal_scan_fractional_token;
+ math->md_free_math = mp_free_decimal_math;
+ math->md_set_precision = mp_decimal_set_precision;
+ return math;
+}
+
+void mp_decimal_set_precision (MP mp)
+{
+ int i = decNumberToInt32((decNumber *) internal_value(mp_number_precision_internal).data.num, &mp_decimal_data.set);
+ mp_decimal_data.set.digits = i;
+ mp_decimal_data.limitedset.digits = i;
+}
+
+void mp_free_decimal_math (MP mp)
+{
+ mp_free_number(mp, &(mp->math->md_three_sixty_deg_t));
+ mp_free_number(mp, &(mp->math->md_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_negative_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_fraction_one_t));
+ mp_free_number(mp, &(mp->math->md_zero_t));
+ mp_free_number(mp, &(mp->math->md_half_unit_t));
+ mp_free_number(mp, &(mp->math->md_three_quarter_unit_t));
+ mp_free_number(mp, &(mp->math->md_unity_t));
+ mp_free_number(mp, &(mp->math->md_two_t));
+ mp_free_number(mp, &(mp->math->md_three_t));
+ mp_free_number(mp, &(mp->math->md_one_third_inf_t));
+ mp_free_number(mp, &(mp->math->md_inf_t));
+ mp_free_number(mp, &(mp->math->md_negative_inf_t));
+ mp_free_number(mp, &(mp->math->md_warning_limit_t));
+ mp_free_number(mp, &(mp->math->md_one_k));
+ mp_free_number(mp, &(mp->math->md_sqrt_8_e_k));
+ mp_free_number(mp, &(mp->math->md_twelve_ln_2_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_minus_1));
+ mp_free_number(mp, &(mp->math->md_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_near_zero_angle_t));
+ mp_free_number(mp, &(mp->math->md_p_over_v_threshold_t));
+ mp_free_number(mp, &(mp->math->md_equation_threshold_t));
+ mp_memory_free(mp->math);
+}
+
+void mp_allocate_number (MP mp, mp_number *n, mp_number_type t)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = t;
+ decNumberZero(n->data.num);
+}
+
+void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = t;
+ decNumberZero(n->data.num);
+ decNumberCopy(n->data.num, v->data.num);
+}
+
+void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = t;
+ decNumberZero(n->data.num);
+ decNumberAbs(n->data.num, v->data.num, &mp_decimal_data.set);
+}
+
+void mp_allocate_double (MP mp, mp_number *n, double v)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = mp_scaled_type;
+ decNumberZero(n->data.num);
+ decNumberFromDouble(n->data.num, v);
+}
+
+void mp_free_number (MP mp, mp_number *n)
+{
+ (void) mp;
+ if (n->data.num) {
+ mp_memory_free(n->data.num);
+ n->data.num = NULL;
+ n->type = mp_nan_type;
+ }
+}
+
+void mp_set_decimal_from_int(mp_number *A, int B)
+{
+ decNumberFromInt32(A->data.num, B);
+}
+
+void mp_set_decimal_from_boolean(mp_number *A, int B)
+{
+ decNumberFromInt32(A->data.num, B);
+}
+
+void mp_set_decimal_from_scaled(mp_number *A, int B)
+{
+ decNumber c;
+ decNumberFromInt32(&c, 65536);
+ decNumberFromInt32(A->data.num,B);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_double(mp_number *A, double B)
+{
+ decNumberFromDouble(A->data.num, B);
+}
+
+void mp_set_decimal_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberAdd(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_half_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumber c;
+ decNumberAdd(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+ decNumberFromInt32(&c, 2);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberSubtract(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumber c;
+ decNumberSubtract(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+ decNumberFromInt32(&c, 2);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_div(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberDivide(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_mul(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberMultiply(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_int_div(mp_number *A, mp_number *B, int C)
+{
+ decNumber c;
+ decNumberFromInt32(&c, C);
+ decNumberDivide(A->data.num, B->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_int_mul(mp_number *A, mp_number *B, int C)
+{
+ decNumber c;
+ decNumberFromInt32(&c, C);
+ decNumberMultiply(A->data.num, B->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C)
+{
+ decNumber c;
+ decNumber r1;
+ decNumberSubtract(&c, B->data.num, C->data.num, &mp_decimal_data.set);
+ mp_decimal_take_fraction(mp, &r1, &c, t->data.num);
+ decNumberSubtract(A->data.num, B->data.num, &r1, &mp_decimal_data.set);
+ mp_decnumber_check(mp, A->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_negate(mp_number *A)
+{
+ decNumberCopyNegate(A->data.num, A->data.num);
+ checkZero(A->data.num);
+}
+
+void mp_number_add(mp_number *A, mp_number *B)
+{
+ decNumberAdd(A->data.num, A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_subtract(mp_number *A, mp_number *B)
+{
+ decNumberSubtract(A->data.num, A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_half(mp_number *A)
+{
+ decNumber c;
+ decNumberFromInt32(&c, 2);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_number_double(mp_number *A)
+{
+ decNumber c;
+ decNumberFromInt32(&c, 2);
+ decNumberMultiply(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_number_add_scaled(mp_number *A, int B)
+{
+ decNumber b, c;
+ decNumberFromInt32(&c, 65536);
+ decNumberFromInt32(&b, B);
+ decNumberDivide(&b, &b, &c, &mp_decimal_data.set);
+ decNumberAdd(A->data.num, A->data.num, &b, &mp_decimal_data.set);
+}
+
+void mp_number_multiply_int(mp_number *A, int B)
+{
+ decNumber b;
+ decNumberFromInt32(&b, B);
+ decNumberMultiply(A->data.num, A->data.num, &b, &mp_decimal_data.set);
+}
+
+void mp_number_divide_int(mp_number *A, int B)
+{
+ decNumber b;
+ decNumberFromInt32(&b, B);
+ decNumberDivide(A->data.num, A->data.num, &b, &mp_decimal_data.set);
+}
+
+void mp_decimal_abs(mp_number *A)
+{
+ decNumberAbs(A->data.num, A->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_clone(mp_number *A, mp_number *B)
+{
+ decNumberCopy(A->data.num, B->data.num);
+}
+
+void mp_number_negated_clone(mp_number *A, mp_number *B)
+{
+ decNumberCopyNegate(A->data.num, B->data.num);
+ checkZero(A->data.num);
+}
+
+void mp_number_abs_clone(mp_number *A, mp_number *B)
+{
+ decNumberAbs(A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_swap(mp_number *A, mp_number *B)
+{
+ decNumber swap_tmp;
+ decNumberCopy(&swap_tmp, A->data.num);
+ decNumberCopy(A->data.num, B->data.num);
+ decNumberCopy(B->data.num, &swap_tmp);
+}
+
+void mp_number_fraction_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ decNumberDivide(A->data.num, A->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_number_angle_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ decNumberDivide(A->data.num, A->data.num, &mp_decimal_data.angle_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_number_scaled_to_fraction(mp_number *A)
+{
+ A->type = mp_fraction_type;
+ decNumberMultiply(A->data.num, A->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_number_scaled_to_angle(mp_number *A)
+{
+ A->type = mp_angle_type;
+ decNumberMultiply(A->data.num, A->data.num, &mp_decimal_data.angle_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+int mp_number_to_scaled(mp_number *A)
+{
+ int32_t result;
+ decNumber corrected;
+ decNumberFromInt32(&corrected, 65536);
+ decNumberMultiply(&corrected, &corrected, A->data.num, &mp_decimal_data.set);
+ decNumberReduce(&corrected, &corrected, &mp_decimal_data.set);
+ result = (int) floor(decNumberToDouble(&corrected) + 0.5);
+ return result;
+}
+
+int mp_number_to_int(mp_number *A)
+{
+ int32_t result;
+ mp_decimal_data.set.status = 0;
+ result = decNumberToInt32(A->data.num, &mp_decimal_data.set);
+ if (mp_decimal_data.set.status == DEC_Invalid_operation) {
+ mp_decimal_data.set.status = 0;
+ return 0;
+ } else {
+ return result;
+ }
+}
+
+int mp_number_to_boolean(mp_number *A)
+{
+ uint32_t result;
+ mp_decimal_data.set.status = 0;
+ result = decNumberToUInt32(A->data.num, &mp_decimal_data.set);
+ if (mp_decimal_data.set.status == DEC_Invalid_operation) {
+ mp_decimal_data.set.status = 0;
+ return mp_false_operation;
+ } else {
+ return result ;
+ }
+}
+
+double mp_number_to_double(mp_number *A)
+{
+ char *buffer = mp_memory_allocate((size_t) ((decNumber *) A->data.num)->digits + 14);
+ double res = 0.0;
+ decNumberToString(A->data.num, buffer);
+ if (sscanf(buffer, "%lf", &res)) {
+ mp_memory_free(buffer);
+ return res;
+ } else {
+ mp_memory_free(buffer);
+ return 0.0;
+ }
+}
+
+int mp_number_odd(mp_number *A)
+{
+ decNumber r1, r2;
+ decNumberAbs(&r1, A->data.num, &mp_decimal_data.set);
+ decNumberRemainder(&r2, &r1, &mp_decimal_data.two_decNumber, &mp_decimal_data.set);
+ decNumberCompare(&r1, &r2, &mp_decimal_data.one, &mp_decimal_data.set);
+ return decNumberIsZero(&r1);
+}
+
+int mp_number_equal(mp_number *A, mp_number *B)
+{
+ decNumber res;
+ decNumberCompare(&res, A->data.num, B->data.num, &mp_decimal_data.set);
+ return decNumberIsZero(&res);
+}
+
+int mp_number_greater(mp_number *A, mp_number *B)
+{
+ decNumber res;
+ decNumberCompare(&res, A->data.num, B->data.num, &mp_decimal_data.set);
+ return decNumberIsPositive(&res);
+}
+
+int mp_number_less(mp_number *A, mp_number *B)
+{
+ decNumber res;
+ decNumberCompare(&res, A->data.num, B->data.num, &mp_decimal_data.set);
+ return decNumberIsNegative(&res);
+}
+
+int mp_number_nonequalabs(mp_number *A, mp_number *B)
+{
+ decNumber res, a, b;
+ decNumberCopyAbs(&a, A->data.num);
+ decNumberCopyAbs(&b, B->data.num);
+ decNumberCompare(&res, &a, &b, &mp_decimal_data.set);
+ return ! decNumberIsZero(&res);
+}
+
+char *mp_decnumber_tostring(decNumber *n)
+{
+ decNumber corrected;
+ char *buffer = mp_memory_allocate((size_t) ((decNumber *) n)->digits + 14);
+ decNumberCopy(&corrected, n);
+ decNumberTrim(&corrected);
+ decNumberToString(&corrected, buffer);
+ return buffer;
+}
+
+char *mp_decimal_number_tostring (MP mp, mp_number *n)
+{
+ (void) mp;
+ return mp_decnumber_tostring(n->data.num);
+}
+
+void mp_decimal_print_number (MP mp, mp_number *n)
+{
+ char *str = mp_decnumber_tostring(n->data.num);
+ mp_print_e_str(mp, str);
+ mp_memory_free(str);
+}
+
+void mp_decimal_slow_add (MP mp, mp_number *ret, mp_number *A, mp_number *B)
+{
+ (void) mp;
+ decNumberAdd(ret->data.num, A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_make_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q)
+{
+ decNumberDivide(ret, p, q, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret, &mp_decimal_data.set);
+ decNumberMultiply(ret, ret, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_decimal_number_make_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q)
+{
+ mp_decimal_make_fraction(mp, ret->data.num, p->data.num, q->data.num);
+}
+
+void mp_decimal_take_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q)
+{
+ (void) mp;
+ decNumberMultiply(ret, p, q, &mp_decimal_data.set);
+ decNumberDivide(ret, ret, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_decimal_number_take_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q)
+{
+ mp_decimal_take_fraction(mp, ret->data.num, p->data.num, q->data.num);
+}
+
+void mp_decimal_number_take_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ (void) mp;
+ decNumberMultiply(ret->data.num, p_orig->data.num, q_orig->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_number_make_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ decNumberDivide(ret->data.num, p_orig->data.num, q_orig->data.num, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop)
+{
+ decNumber result;
+ size_t l = stop-start+1;
+ char *buf = mp_memory_allocate(l + 1);
+ buf[l] = '\0';
+ (void) strncpy(buf, (const char *) start, l);
+ mp_decimal_data.set.status = 0;
+ decNumberFromString(&result,buf, &mp_decimal_data.set);
+ mp_memory_free(buf);
+ if (mp_decimal_data.set.status == 0) {
+ set_cur_mod(&result);
+ } else if (mp->scanner_status != mp_tex_flushing_state) {
+ if (too_large(mp_decimal_data.set.status)) {
+ mp_decnumber_check(mp, &result, &mp_decimal_data.set);
+ set_cur_mod(&result);
+ mp_error(
+ mp,
+ "Enormous number has been reduced",
+ "I could not handle this number specification because it is out of range."
+ );
+ } else if (too_precise(mp_decimal_data.set.status)) {
+ set_cur_mod(&result);
+ if (decNumberIsPositive((decNumber *) internal_value(mp_warning_check_internal).data.num) && (mp->scanner_status != mp_tex_flushing_state)) {
+ char msg[256];
+ mp_snprintf (msg, 256, "Number is too precise (numberprecision = %d)", mp_decimal_data.set.digits);
+ mp_error(
+ mp,
+ msg,
+ "Continue and I'll round the value until it fits the current numberprecision\n"
+ "(Set warningcheck:=0 to suppress this message.)"
+ );
+ }
+ } else {
+ mp_error(
+ mp,
+ "Erroneous number specification changed to zero",
+ "I could not handle this number specification"
+ );
+ decNumberZero(&result);
+ set_cur_mod(&result);
+ }
+ }
+ set_cur_cmd((mp_variable_type) mp_numeric_command);
+}
+
+static void find_exponent (MP mp)
+{
+ if (mp->buffer[mp->cur_input.loc_field] == 'e'
+ || mp->buffer[mp->cur_input.loc_field] == 'E') {
+ mp->cur_input.loc_field++;
+ if (! (mp->buffer[mp->cur_input.loc_field] == '+'
+ || mp->buffer[mp->cur_input.loc_field] == '-'
+ || mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class)) {
+ mp->cur_input.loc_field--;
+ return;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '+' ||
+ mp->buffer[mp->cur_input.loc_field] == '-') {
+ mp->cur_input.loc_field++;
+ }
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+}
+
+void mp_decimal_scan_fractional_token (MP mp, int n)
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+void mp_decimal_scan_numeric_token (MP mp, int n)
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '.' && mp->buffer[mp->cur_input.loc_field+1] != '.') {
+ mp->cur_input.loc_field++;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+ find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+void mp_decimal_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t)
+{
+ decNumber acc, num, denom;
+ decNumber r1, r2;
+ decNumber arg1, arg2;
+ decNumber i16, fone, fhalf, ftwo, sqrtfive;
+ decNumberFromInt32(&i16, 16);
+ decNumberFromInt32(&fone, fraction_one);
+ decNumberFromInt32(&fhalf, fraction_half);
+ decNumberFromInt32(&ftwo, fraction_two);
+ decNumberFromInt32(&sqrtfive, 5);
+ decNumberSquareRoot(&sqrtfive, &sqrtfive, &mp_decimal_data.set);
+
+ decNumberDivide(&arg1, sf->data.num, &i16, &mp_decimal_data.set);
+ decNumberSubtract(&arg1, st->data.num,&arg1, &mp_decimal_data.set);
+ decNumberDivide(&arg2, st->data.num, &i16, &mp_decimal_data.set);
+ decNumberSubtract(&arg2, sf->data.num,&arg2, &mp_decimal_data.set);
+ mp_decimal_take_fraction(mp, &acc, &arg1, &arg2);
+
+ decNumberCopy(&arg1, &acc);
+ decNumberSubtract(&arg2, ct->data.num, cf->data.num, &mp_decimal_data.set);
+ mp_decimal_take_fraction(mp, &acc, &arg1, &arg2);
+
+ decNumberSquareRoot(&arg1, &mp_decimal_data.two_decNumber, &mp_decimal_data.set);
+ decNumberMultiply(&arg1, &arg1, &fone, &mp_decimal_data.set);
+ mp_decimal_take_fraction(mp, &r1, &acc, &arg1);
+ decNumberAdd(&num, &ftwo, &r1, &mp_decimal_data.set);
+
+ decNumberSubtract(&arg1,&sqrtfive, &mp_decimal_data.one, &mp_decimal_data.set);
+ decNumberMultiply(&arg1,&arg1,&fhalf, &mp_decimal_data.set);
+ decNumberMultiply(&arg1,&arg1,&mp_decimal_data.three_decNumber, &mp_decimal_data.set);
+
+ decNumberSubtract(&arg2,&mp_decimal_data.three_decNumber, &sqrtfive, &mp_decimal_data.set);
+ decNumberMultiply(&arg2,&arg2, &fhalf, &mp_decimal_data.set);
+ decNumberMultiply(&arg2,&arg2, &mp_decimal_data.three_decNumber, &mp_decimal_data.set);
+ mp_decimal_take_fraction(mp, &r1, ct->data.num, &arg1) ;
+ mp_decimal_take_fraction(mp, &r2, cf->data.num, &arg2);
+
+ decNumberFromInt32(&denom, fraction_three);
+ decNumberAdd(&denom, &denom, &r1, &mp_decimal_data.set);
+ decNumberAdd(&denom, &denom, &r2, &mp_decimal_data.set);
+
+ decNumberCompare(&arg1, t->data.num, &mp_decimal_data.one, &mp_decimal_data.set);
+ if (! decNumberIsZero(&arg1)) {
+ decNumberDivide(&num, &num, t->data.num, &mp_decimal_data.set);
+ }
+ decNumberCopy(&r2, &num);
+ decNumberDivide(&r2, &r2, &mp_decimal_data.four_decNumber, &mp_decimal_data.set);
+ if (decNumberLess(&denom, &r2)) {
+ decNumberFromInt32(ret->data.num, fraction_four);
+ } else {
+ mp_decimal_make_fraction(mp, ret->data.num, &num, &denom);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+int mp_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ decNumber a, b, c, d;
+ decNumber ab, cd;
+ decNumberCopy(&a, (decNumber *) a_orig->data.num);
+ decNumberCopy(&b, (decNumber *) b_orig->data.num);
+ decNumberCopy(&c, (decNumber *) c_orig->data.num);
+ decNumberCopy(&d, (decNumber *) d_orig->data.num);
+ decNumberMultiply(&ab, (decNumber *) a_orig->data.num, (decNumber *)b_orig->data.num, &mp_decimal_data.set);
+ decNumberMultiply(&cd, (decNumber *) c_orig->data.num, (decNumber *)d_orig->data.num, &mp_decimal_data.set);
+ if (decNumberLess(&ab, &cd)) {
+ return -1;
+ } else if (decNumberGreater(&ab, &cd)) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static void mp_decimal_crossing_point (MP mp, mp_number *ret, mp_number *aa, mp_number *bb, mp_number *cc)
+{
+ decNumber a, b, c;
+ double d;
+ decNumber x, xx, x0, x1, x2;
+ decNumber scratch, scratch2;
+ decNumberCopy(&a, (decNumber *) aa->data.num);
+ decNumberCopy(&b, (decNumber *) bb->data.num);
+ decNumberCopy(&c, (decNumber *) cc->data.num);
+ if (decNumberIsNegative(&a)) {
+ decNumberCopy(ret->data.num, &zero_crossing);
+ goto RETURN;
+ }
+ if (! decNumberIsNegative(&c)) {
+ if (! decNumberIsNegative(&b)) {
+ if (decNumberIsPositive(&c)) {
+ decNumberCopy(ret->data.num, &no_crossing);
+ } else if (decNumberIsZero(&a) && decNumberIsZero(&b)) {
+ decNumberCopy(ret->data.num, &no_crossing);
+ } else {
+ decNumberCopy(ret->data.num, &one_crossing);
+ }
+ goto RETURN;
+ }
+ if (decNumberIsZero(&a)) {
+ decNumberCopy(ret->data.num, &zero_crossing);
+ goto RETURN;
+ }
+ } else if (decNumberIsZero(&a) && ! decNumberIsPositive(&b)) {
+ decNumberCopy(ret->data.num, &zero_crossing);
+ goto RETURN;
+ }
+ d = epsilonf;
+ decNumberCopy(&x0, &a);
+ decNumberSubtract(&x1, &a, &b, &mp_decimal_data.set);
+ decNumberSubtract(&x2, &b, &c, &mp_decimal_data.set);
+ decNumberFromDouble(&scratch2, 1E-12);
+ do {
+ decNumberAdd(&x, &x1, &x2, &mp_decimal_data.set);
+ decNumberDivide(&x, &x, &mp_decimal_data.two_decNumber, &mp_decimal_data.set);
+ decNumberAdd(&x, &x, &scratch2, &mp_decimal_data.set);
+ decNumberSubtract(&scratch, &x1, &x0, &mp_decimal_data.set);
+ if (decNumberGreater(&scratch, &x0)) {
+ decNumberCopy(&x2, &x);
+ decNumberAdd(&x0, &x0, &x0, &mp_decimal_data.set);
+ d += d;
+ } else {
+ decNumberAdd(&xx, &scratch, &x, &mp_decimal_data.set);
+ if (decNumberGreater(&xx,&x0)) {
+ decNumberCopy(&x2,&x);
+ decNumberAdd(&x0, &x0, &x0, &mp_decimal_data.set);
+ d += d;
+ } else {
+ decNumberSubtract(&x0, &x0, &xx, &mp_decimal_data.set);
+ if (! decNumberGreater(&x,&x0)) {
+ decNumberAdd(&scratch, &x, &x2, &mp_decimal_data.set);
+ if (! decNumberGreater(&scratch, &x0)) {
+ decNumberCopy(ret->data.num, &no_crossing);
+ goto RETURN;
+ }
+ }
+ decNumberCopy(&x1,&x);
+ d = d + d + epsilonf;
+ }
+ }
+ } while (d < fraction_one);
+ decNumberFromDouble(&scratch, d);
+ decNumberSubtract(ret->data.num,&scratch, &mp_decimal_data.fraction_one_decNumber, &mp_decimal_data.set);
+ RETURN:
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+int mp_round_unscaled(mp_number *x_orig)
+{
+ return (int) lround(mp_number_to_double(x_orig));
+}
+
+void mp_number_floor(mp_number *i)
+{
+ int round = mp_decimal_data.set.round;
+ mp_decimal_data.set.round = DEC_ROUND_FLOOR;
+ decNumberToIntegralValue(i->data.num, i->data.num, &mp_decimal_data.set);
+ mp_decimal_data.set.round = round;
+}
+
+void mp_decimal_fraction_to_round_scaled(mp_number *x_orig)
+{
+ x_orig->type = mp_scaled_type;
+ decNumberDivide(x_orig->data.num, x_orig->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_decimal_square_rt (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ decNumber x;
+ decNumberCopy(&x, x_orig->data.num);
+ if (! decNumberIsPositive(&x)) {
+ if (decNumberIsNegative(&x)) {
+ char msg[256];
+ char *xstr = mp_decimal_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Square root of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ decNumberZero(ret->data.num);
+ } else {
+ decNumberSquareRoot(ret->data.num, &x, &mp_decimal_data.set);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_pyth_add (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ decNumber a, b;
+ decNumber asq, bsq;
+ decNumberCopyAbs(&a, a_orig->data.num);
+ decNumberCopyAbs(&b, b_orig->data.num);
+ decNumberMultiply(&asq, &a, &a, &mp_decimal_data.set);
+ decNumberMultiply(&bsq, &b, &b, &mp_decimal_data.set);
+ decNumberAdd(&a, &asq, &bsq, &mp_decimal_data.set);
+ decNumberSquareRoot(ret->data.num, &a, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_pyth_sub (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ decNumber a, b;
+ decNumberCopyAbs(&a, a_orig->data.num);
+ decNumberCopyAbs(&b, b_orig->data.num);
+ if (! decNumberGreater(&a, &b)) {
+ if (decNumberLess(&a, &b)) {
+ char msg[256];
+ char *astr = mp_decimal_number_tostring(mp, a_orig);
+ char *bstr = mp_decimal_number_tostring(mp, b_orig);
+ mp_snprintf(msg, 256, "Pythagorean subtraction %s+-+%s has been replaced by 0", astr, bstr);
+ mp_memory_free(astr);
+ mp_memory_free(bstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ decNumberZero(&a);
+ } else {
+ decNumber asq, bsq;
+ decNumberMultiply(&asq, &a, &a, &mp_decimal_data.set);
+ decNumberMultiply(&bsq, &b, &b, &mp_decimal_data.set);
+ decNumberSubtract(&a, &asq, &bsq, &mp_decimal_data.set);
+ decNumberSquareRoot(&a, &a, &mp_decimal_data.set);
+ }
+ decNumberCopy(ret->data.num, &a);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_power_of (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ decNumberPower(ret->data.num, a_orig->data.num, b_orig->data.num, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_m_log (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ if (! decNumberIsPositive((decNumber *) x_orig->data.num)) {
+ char msg[256];
+ char *xstr = mp_decimal_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Logarithm of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take logs of non-positive numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ decNumberZero(ret->data.num);
+ } else {
+ decNumber twofivesix;
+ decNumberFromInt32(&twofivesix, 256);
+ decNumberLn(ret->data.num, x_orig->data.num, &mp_decimal_data.limitedset);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.limitedset);
+ decNumberMultiply(ret->data.num, ret->data.num, &twofivesix, &mp_decimal_data.set);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+void mp_decimal_m_exp (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ decNumber temp, twofivesix;
+ decNumberFromInt32(&twofivesix, 256);
+ decNumberDivide(&temp, x_orig->data.num, &twofivesix, &mp_decimal_data.set);
+ mp_decimal_data.limitedset.status = 0;
+ decNumberExp(ret->data.num, &temp, &mp_decimal_data.limitedset);
+ if (mp_decimal_data.limitedset.status & DEC_Clamped) {
+ if (decNumberIsPositive((decNumber *) x_orig->data.num)) {
+ mp->arith_error = 1;
+ decNumberCopy(ret->data.num, &mp_decimal_data.EL_GORDO_decNumber);
+ } else {
+ decNumberZero(ret->data.num);
+ }
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.limitedset);
+ mp_decimal_data.limitedset.status = 0;
+}
+
+void mp_decimal_n_arg (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ if (decNumberIsZero((decNumber *) x_orig->data.num) && decNumberIsZero((decNumber *) y_orig->data.num)) {
+ mp_error(
+ mp,
+ "angle(0,0) is taken as zero",
+ "The 'angle' between two identical points is undefined. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ decNumberZero(ret->data.num);
+ } else {
+ decNumber atan2val, oneeighty_angle;
+ ret->type = mp_angle_type;
+ decNumberFromInt32(&oneeighty_angle, 180 * angle_multiplier);
+ decNumberDivide(&oneeighty_angle, &oneeighty_angle, &mp_decimal_data.PI_decNumber, &mp_decimal_data.set);
+ checkZero(y_orig->data.num);
+ checkZero(x_orig->data.num);
+ decNumberAtan2(&atan2val, y_orig->data.num, x_orig->data.num, &mp_decimal_data.set);
+ decNumberMultiply(ret->data.num,&atan2val, &oneeighty_angle, &mp_decimal_data.set);
+ checkZero(ret->data.num);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+static void sinecosine(decNumber *theangle, decNumber *c, decNumber *s)
+{
+ int prec = mp_decimal_data.set.digits/2;
+ decNumber p, pxa, fac, cc;
+ decNumber n1, n2, p1;
+ decNumberZero(c);
+ decNumberZero(s);
+ if (prec < DECPRECISION_DEFAULT) {
+ prec = DECPRECISION_DEFAULT;
+ }
+ for (int n = 0; n < prec; n++) {
+ decNumberFromInt32(&p1, n);
+ decNumberFromInt32(&n1, 2*n);
+ decNumberPower(&p, &mp_decimal_data.minusone, &p1, &mp_decimal_data.limitedset);
+ if (n == 0) {
+ decNumberCopy(&pxa, &mp_decimal_data.one);
+ } else {
+ decNumberPower(&pxa, theangle, &n1, &mp_decimal_data.limitedset);
+ }
+ if (2*n < mp_decimal_data.last_cached_factorial) {
+ decNumberCopy(&fac,mp_decimal_data.factorials[2*n]);
+ } else {
+ decNumberCopy(&fac,mp_decimal_data.factorials[mp_decimal_data.last_cached_factorial]);
+ for (int i = mp_decimal_data.last_cached_factorial+1; i <= 2*n; i++) {
+ decNumberFromInt32(&cc, i);
+ decNumberMultiply (&fac, &fac, &cc, &mp_decimal_data.set);
+ if (i < FACTORIALS_CACHESIZE) {
+ mp_decimal_data.factorials[i] = mp_memory_allocate(sizeof(decNumber));
+ decNumberCopy(mp_decimal_data.factorials[i], &fac);
+ mp_decimal_data.last_cached_factorial = i;
+ }
+ }
+ }
+ decNumberDivide(&pxa, &pxa, &fac, &mp_decimal_data.set);
+ decNumberMultiply(&pxa, &pxa, &p, &mp_decimal_data.set);
+ decNumberAdd(s, s, &pxa, &mp_decimal_data.set);
+ decNumberFromInt32(&n2, 2*n+1);
+ decNumberMultiply(&fac, &fac, &n2, &mp_decimal_data.set);
+ decNumberPower(&pxa, theangle, &n2, &mp_decimal_data.limitedset);
+ decNumberDivide(&pxa, &pxa, &fac, &mp_decimal_data.set);
+ decNumberMultiply(&pxa, &pxa, &p, &mp_decimal_data.set);
+ decNumberAdd(c, c, &pxa, &mp_decimal_data.set);
+ }
+}
+
+void mp_decimal_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin)
+{
+ decNumber rad;
+ decNumber one_eighty;
+ double tmp = mp_number_to_double(z_orig)/16.0;
+ if ((tmp == 90.0)||(tmp == -270)){
+ decNumberZero(n_cos->data.num);
+ decNumberCopy(n_sin->data.num, &mp_decimal_data.fraction_multiplier_decNumber);
+ } else if ((tmp == -90.0)||(tmp == 270.0)) {
+ decNumberZero(n_cos->data.num);
+ decNumberCopyNegate(n_sin->data.num, &mp_decimal_data.fraction_multiplier_decNumber);
+ } else if ((tmp == 180.0) || (tmp == -180.0)) {
+ decNumberCopyNegate(n_cos->data.num, &mp_decimal_data.fraction_multiplier_decNumber);
+ decNumberZero(n_sin->data.num);
+ } else {
+ decNumberFromInt32(&one_eighty, 180 * 16);
+ decNumberMultiply(&rad, z_orig->data.num, &mp_decimal_data.PI_decNumber, &mp_decimal_data.set);
+ decNumberDivide(&rad, &rad, &one_eighty, &mp_decimal_data.set);
+ sinecosine(&rad, n_sin->data.num, n_cos->data.num);
+ decNumberMultiply(n_cos->data.num, n_cos->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+ decNumberMultiply(n_sin->data.num, n_sin->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+ }
+ mp_decnumber_check(mp, n_cos->data.num, &mp_decimal_data.set);
+ mp_decnumber_check(mp, n_sin->data.num, &mp_decimal_data.set);
+}
+
+# define KK 100
+# define LL 37
+# define MM (1L<<30)
+# define mod_diff(x,y) (((x)-(y))&(MM-1))
+# define QUALITY 1009
+# define TT 70
+# define is_odd(x) ((x)&1)
+
+typedef struct mp_decimal_random_info {
+ long x[KK];
+ long buf[QUALITY];
+ long dummy;
+ long started;
+ long *ptr;
+} mp_decimal_random_info;
+
+mp_decimal_random_info mp_decimal_random_data = {
+ .dummy = -1,
+ .started = -1,
+ .ptr = &mp_decimal_random_data.dummy
+};
+
+static void ran_array(long aa[],int n)
+{
+ int i, j;
+ for (j = 0; j < KK;j++) {
+ aa[j] = mp_decimal_random_data.x[j];
+ }
+ for (; j < n; j++) {
+ aa[j] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (i = 0; i < LL ; i++, j++) {
+ mp_decimal_random_data.x[i] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (;i < KK; i++, j++) {
+ mp_decimal_random_data.x[i] = mod_diff(aa[j - KK], mp_decimal_random_data.x[i - LL]);
+ }
+}
+
+
+static void ran_start(long seed)
+{
+ int t, j;
+ long x[KK+KK-1];
+ long ss=(seed+2)&(MM-2);
+ for (j = 0; j < KK; j++) {
+ x[j] = ss;
+ ss <<= 1;
+ if (ss >= MM) {
+ ss -= MM - 2;
+ }
+ }
+ x[1]++;
+ for (ss = seed & (MM-1), t = TT - 1; t;) {
+ for (j = KK - 1; j > 0; j--) {
+ x[j + j] = x[j];
+ x[j + j - 1] = 0;
+ }
+ for (j = KK + KK - 2; j >= KK; j--) {
+ x[j - (KK - LL)] = mod_diff(x[j - (KK - LL)], x[j]);
+ x[j - KK] = mod_diff(x[j - KK], x[j]);
+ }
+ if (is_odd(ss)) {
+ for (j = KK; j > 0; j--) {
+ x[j] = x[j-1];
+ }
+ x[0] = x[KK];
+ x[LL] = mod_diff(x[LL], x[KK]);
+ }
+ if (ss) {
+ ss >>= 1;
+ } else {
+ t--;
+ }
+ }
+ for (j = 0; j < LL; j++) {
+ mp_decimal_random_data.x[j + KK -LL] = x[j];
+ }
+ for (; j < KK; j++) {
+ mp_decimal_random_data.x[j - LL] = x[j];
+ }
+ for (j = 0; j < 10; j++) {
+ ran_array(x, KK + KK - 1);
+ }
+ mp_decimal_random_data.ptr = &mp_decimal_random_data.started;
+}
+
+# define ran_arr_next() (*mp_decimal_random_data.ptr>=0? *mp_decimal_random_data.ptr++: ran_arr_cycle())
+
+static long ran_arr_cycle(void)
+{
+ if (mp_decimal_random_data.ptr == &mp_decimal_random_data.dummy) {
+ ran_start(314159L);
+ }
+ ran_array(mp_decimal_random_data.buf, QUALITY);
+ mp_decimal_random_data.buf[KK] = -1;
+ mp_decimal_random_data.ptr = mp_decimal_random_data.buf + 1;
+ return mp_decimal_random_data.buf[0];
+}
+
+void mp_init_randoms (MP mp, int seed)
+{
+ int k = 1;
+ int j = abs(seed);
+ while (j >= fraction_one) {
+ j = j/2;
+ }
+ for (int i = 0; i <= 54; i++) {
+ int jj = k;
+ k = j - k;
+ j = jj;
+ if (k < 0) {
+ k += fraction_one;
+ }
+ decNumberFromInt32(mp->randoms[(i * 21) % 55].data.num, j);
+ }
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ ran_start((unsigned long) seed);
+}
+
+void mp_decimal_number_modulo(mp_number *a, mp_number *b)
+{
+ decNumberRemainder(a->data.num, a->data.num, b->data.num, &mp_decimal_data.set);
+}
+
+static void mp_next_unif_random (MP mp, mp_number *ret)
+{
+ decNumber a;
+ decNumber b;
+ unsigned long int op = (unsigned)ran_arr_next();
+ (void) mp;
+ decNumberFromInt32(&a, op);
+ decNumberFromInt32(&b, MM);
+ decNumberDivide(&a, &a, &b, &mp_decimal_data.set);
+ decNumberCopy(ret->data.num, &a);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+static void mp_next_random (MP mp, mp_number *ret)
+{
+ if (mp->j_random == 0) {
+ mp_new_randoms(mp);
+ } else {
+ mp->j_random = mp->j_random-1;
+ }
+ mp_number_clone(ret, &(mp->randoms[mp->j_random]));
+}
+
+static void mp_decimal_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ mp_number x, abs_x, u, y;
+ mp_allocate_number(mp, &y, mp_fraction_type);
+ mp_allocate_clone(mp, &x, mp_scaled_type, x_orig);
+ mp_allocate_abs(mp, &abs_x, mp_scaled_type, &x);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_next_unif_random(mp, &u);
+ decNumberMultiply(y.data.num, abs_x.data.num, u.data.num, &mp_decimal_data.set);
+ if (mp_number_equal(&y, &abs_x)) {
+ mp_number_clone(ret, &((math_data *)mp->math)->md_zero_t);
+ } else if (mp_number_greater(&x, &((math_data *)mp->math)->md_zero_t)) {
+ mp_number_clone(ret, &y);
+ } else {
+ mp_number_negated_clone(ret, &y);
+ }
+ mp_free_number(mp, &x);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &y);
+ mp_free_number(mp, &u);
+}
+
+static void mp_decimal_m_norm_rand (MP mp, mp_number *ret)
+{
+ mp_number abs_x, u, r, la, xa;
+ mp_allocate_number(mp, &la, mp_scaled_type);
+ mp_allocate_number(mp, &xa, mp_scaled_type);
+ mp_allocate_number(mp, &abs_x, mp_scaled_type);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_allocate_number(mp, &r, mp_scaled_type);
+ do {
+ do {
+ mp_number v;
+ mp_allocate_number(mp, &v, mp_scaled_type);
+ mp_next_random(mp, &v);
+ mp_number_subtract(&v, &((math_data *)mp->math)->md_fraction_half_t);
+ mp_decimal_number_take_fraction(mp, &xa, &((math_data *)mp->math)->md_sqrt_8_e_k, &v);
+ mp_free_number(mp, &v);
+ mp_next_random(mp, &u);
+ mp_number_clone(&abs_x, &xa);
+ mp_decimal_abs(&abs_x);
+ } while (! mp_number_less(&abs_x, &u));
+ mp_decimal_number_make_fraction(mp, &r, &xa, &u);
+ mp_number_clone(&xa, &r);
+ mp_decimal_m_log(mp, &la, &u);
+ mp_set_decimal_from_subtraction(&la, &((math_data *)mp->math)->md_twelve_ln_2_k, &la);
+ } while (mp_ab_vs_cd(&((math_data *)mp->math)->md_one_k, &la, &xa, &xa) < 0);
+ mp_number_clone(ret, &xa);
+ mp_free_number(mp, &r);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &la);
+ mp_free_number(mp, &xa);
+ mp_free_number(mp, &u);
+}
diff --git a/source/luametatex/source/mp/mpc/mpmathdecimal.h b/source/luametatex/source/mp/mpc/mpmathdecimal.h
new file mode 100644
index 000000000..ef96d07cd
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmathdecimal.h
@@ -0,0 +1,12 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# ifndef MPMATHDECIMAL_H
+# define MPMATHDECIMAL_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_decimal_math (MP mp);
+
+# endif
+
diff --git a/source/luametatex/source/mp/mpc/mpmathdouble.c b/source/luametatex/source/mp/mpc/mpmathdouble.c
new file mode 100644
index 000000000..99be94727
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmathdouble.c
@@ -0,0 +1,1160 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# include "mpconfig.h"
+# include "mpmathdouble.h"
+
+
+# define PI 3.1415926535897932384626433832795028841971
+# define fraction_multiplier 4096.0
+# define angle_multiplier 16.0
+# define coef_bound ((7.0/3.0)*fraction_multiplier)
+# define fraction_threshold 0.04096
+# define half_fraction_threshold (fraction_threshold/2)
+# define scaled_threshold 0.000122
+# define half_scaled_threshold (scaled_threshold/2)
+# define near_zero_angle (0.0256*angle_multiplier)
+# define p_over_v_threshold 0x80000
+# define equation_threshold 0.001
+# define warning_limit pow(2.0,52.0)
+# define epsilon pow(2.0,-52.0)
+# define unity 1.0
+# define two 2.0
+# define three 3.0
+# define half_unit 0.5
+# define three_quarter_unit 0.75
+# define EL_GORDO (DBL_MAX/2.0-1.0)
+# define negative_EL_GORDO (-EL_GORDO)
+# define one_third_EL_GORDO (EL_GORDO/3.0)
+# define fraction_half (0.5*fraction_multiplier)
+# define fraction_one (1.0*fraction_multiplier)
+# define fraction_two (2.0*fraction_multiplier)
+# define fraction_three (3.0*fraction_multiplier)
+# define fraction_four (4.0*fraction_multiplier)
+# define no_crossing (fraction_one + 1)
+# define one_crossing fraction_one
+# define zero_crossing 0
+# define one_eighty_deg (180.0*angle_multiplier)
+# define negative_one_eighty_deg (-180.0*angle_multiplier)
+# define three_sixty_deg (360.0*angle_multiplier)
+# define odd(A) (abs(A)%2==1)
+# define two_to_the(A) (1<<(unsigned)(A))
+# define set_cur_cmd(A) mp->cur_mod_->command = (A)
+# define set_cur_mod(A) mp->cur_mod_->data.n.data.dval = (A)
+
+static int mp_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_double (MP mp, mp_number *n, double v);
+static void mp_allocate_number (MP mp, mp_number *n, mp_number_type t);
+static int mp_double_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_double_abs (mp_number *A);
+static void mp_double_crossing_point (MP mp, mp_number *ret, mp_number *a, mp_number *b, mp_number *c);
+static void mp_double_fraction_to_round_scaled (mp_number *x);
+static void mp_double_m_exp (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_m_log (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_m_norm_rand (MP mp, mp_number *ret);
+static void mp_double_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_n_arg (MP mp, mp_number *ret, mp_number *x, mp_number *y);
+static void mp_double_number_make_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_number_make_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_number_take_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_number_take_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_power_of (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_double_print_number (MP mp, mp_number *n);
+static void mp_double_pyth_add (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_double_pyth_sub (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_double_scan_fractional_token (MP mp, int n);
+static void mp_double_scan_numeric_token (MP mp, int n);
+static void mp_double_set_precision (MP mp);
+static void mp_double_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin);
+static void mp_double_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig);
+static void mp_double_square_rt (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t);
+static void mp_free_double_math (MP mp);
+static void mp_free_number (MP mp, mp_number *n);
+static void mp_init_randoms (MP mp, int seed);
+static void mp_number_abs_clone (mp_number *A, mp_number *B);
+static void mp_number_add (mp_number *A, mp_number *B);
+static void mp_number_add_scaled (mp_number *A, int B);
+static void mp_number_angle_to_scaled (mp_number *A);
+static void mp_number_clone (mp_number *A, mp_number *B);
+static void mp_number_divide_int (mp_number *A, int B);
+static void mp_number_double (mp_number *A);
+static int mp_number_equal (mp_number *A, mp_number *B);
+static void mp_number_floor (mp_number *i);
+static void mp_number_fraction_to_scaled (mp_number *A);
+static int mp_number_greater (mp_number *A, mp_number *B);
+static void mp_number_half (mp_number *A);
+static int mp_number_less (mp_number *A, mp_number *B);
+static void mp_number_modulo (mp_number *a, mp_number *b);
+static void mp_number_multiply_int (mp_number *A, int B);
+static void mp_number_negate (mp_number *A);
+static void mp_number_negated_clone (mp_number *A, mp_number *B);
+static int mp_number_nonequalabs (mp_number *A, mp_number *B);
+static int mp_number_odd (mp_number *A);
+static void mp_number_scaled_to_angle (mp_number *A);
+static void mp_number_scaled_to_fraction (mp_number *A);
+static void mp_number_subtract (mp_number *A, mp_number *B);
+static void mp_number_swap (mp_number *A, mp_number *B);
+static int mp_number_to_boolean (mp_number *A);
+static double mp_number_to_double (mp_number *A);
+static int mp_number_to_int (mp_number *A);
+static int mp_number_to_scaled (mp_number *A);
+static int mp_round_unscaled (mp_number *x_orig);
+static void mp_set_double_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_from_boolean (mp_number *A, int B);
+static void mp_set_double_from_div (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_from_double (mp_number *A, double B);
+static void mp_set_double_from_int (mp_number *A, int B);
+static void mp_set_double_from_int_div (mp_number *A, mp_number *B, int C);
+static void mp_set_double_from_int_mul (mp_number *A, mp_number *B, int C);
+static void mp_set_double_from_mul (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+static void mp_set_double_from_scaled (mp_number *A, int B);
+static void mp_set_double_from_subtraction (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_half_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C);
+static void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop);
+static char *mp_double_number_tostring (MP mp, mp_number *n);
+inline double mp_double_make_fraction (double p, double q) { return (p / q) * fraction_multiplier; }
+inline double mp_double_take_fraction (double p, double q) { return (p * q) / fraction_multiplier; }
+inline double mp_double_make_scaled (double p, double q) { return p / q; }
+
+math_data *mp_initialize_double_math(MP mp)
+{
+ math_data *math = (math_data *) mp_memory_allocate(sizeof(math_data));
+ math->md_allocate = mp_allocate_number;
+ math->md_free = mp_free_number;
+ math->md_allocate_clone = mp_allocate_clone;
+ math->md_allocate_abs = mp_allocate_abs;
+ math->md_allocate_double = mp_allocate_double;
+ mp_allocate_number(mp, &math->md_precision_default, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_max, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_min, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_epsilon_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_negative_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_warning_limit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_one_third_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_unity_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_two_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_quarter_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_zero_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_arc_tol_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_one_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_half_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_three_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_four_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_three_sixty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_one_eighty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_negative_one_eighty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_one_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_sqrt_8_e_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twelve_ln_2_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_minus_1, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twelvebits_3, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twentysixbits_sqrt2_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentyeightbits_d_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentysevenbits_sqrt2_d_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_half_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_near_zero_angle_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_p_over_v_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_equation_threshold_t, mp_scaled_type);
+ math->md_precision_default.data.dval = 16 * unity;
+ math->md_precision_max.data.dval = 16 * unity;
+ math->md_precision_min.data.dval = 16 * unity;
+ math->md_epsilon_t.data.dval = epsilon;
+ math->md_inf_t.data.dval = EL_GORDO;
+ math->md_negative_inf_t.data.dval = negative_EL_GORDO;
+ math->md_one_third_inf_t.data.dval = one_third_EL_GORDO;
+ math->md_warning_limit_t.data.dval = warning_limit;
+ math->md_unity_t.data.dval = unity;
+ math->md_two_t.data.dval = two;
+ math->md_three_t.data.dval = three;
+ math->md_half_unit_t.data.dval = half_unit;
+ math->md_three_quarter_unit_t.data.dval = three_quarter_unit;
+ math->md_arc_tol_k.data.dval = (unity/4096);
+ math->md_fraction_one_t.data.dval = fraction_one;
+ math->md_fraction_half_t.data.dval = fraction_half;
+ math->md_fraction_three_t.data.dval = fraction_three;
+ math->md_fraction_four_t.data.dval = fraction_four;
+ math->md_three_sixty_deg_t.data.dval = three_sixty_deg;
+ math->md_one_eighty_deg_t.data.dval = one_eighty_deg;
+ math->md_negative_one_eighty_deg_t.data.dval = negative_one_eighty_deg;
+ math->md_one_k.data.dval = 1.0/64 ;
+ math->md_sqrt_8_e_k.data.dval = 1.71552776992141359295;
+ math->md_twelve_ln_2_k.data.dval = 8.31776616671934371292 *256;
+ math->md_coef_bound_k.data.dval = coef_bound;
+ math->md_coef_bound_minus_1.data.dval = coef_bound - 1/65536.0;
+ math->md_twelvebits_3.data.dval = 1365 / 65536.0;
+ math->md_twentysixbits_sqrt2_t.data.dval = 94906266 / 65536.0;
+ math->md_twentyeightbits_d_t.data.dval = 35596755 / 65536.0;
+ math->md_twentysevenbits_sqrt2_d_t.data.dval = 25170707 / 65536.0;
+ math->md_fraction_threshold_t.data.dval = fraction_threshold;
+ math->md_half_fraction_threshold_t.data.dval = half_fraction_threshold;
+ math->md_scaled_threshold_t.data.dval = scaled_threshold;
+ math->md_half_scaled_threshold_t.data.dval = half_scaled_threshold;
+ math->md_near_zero_angle_t.data.dval = near_zero_angle;
+ math->md_p_over_v_threshold_t.data.dval = p_over_v_threshold;
+ math->md_equation_threshold_t.data.dval = equation_threshold;
+ math->md_from_int = mp_set_double_from_int;
+ math->md_from_boolean = mp_set_double_from_boolean;
+ math->md_from_scaled = mp_set_double_from_scaled;
+ math->md_from_double = mp_set_double_from_double;
+ math->md_from_addition = mp_set_double_from_addition;
+ math->md_half_from_addition = mp_set_double_half_from_addition;
+ math->md_from_subtraction = mp_set_double_from_subtraction;
+ math->md_half_from_subtraction = mp_set_double_half_from_subtraction;
+ math->md_from_oftheway = mp_set_double_from_of_the_way;
+ math->md_from_div = mp_set_double_from_div;
+ math->md_from_mul = mp_set_double_from_mul;
+ math->md_from_int_div = mp_set_double_from_int_div;
+ math->md_from_int_mul = mp_set_double_from_int_mul;
+ math->md_negate = mp_number_negate;
+ math->md_add = mp_number_add;
+ math->md_subtract = mp_number_subtract;
+ math->md_half = mp_number_half;
+ math->md_do_double = mp_number_double;
+ math->md_abs = mp_double_abs;
+ math->md_clone = mp_number_clone;
+ math->md_negated_clone = mp_number_negated_clone;
+ math->md_abs_clone = mp_number_abs_clone;
+ math->md_swap = mp_number_swap;
+ math->md_add_scaled = mp_number_add_scaled;
+ math->md_multiply_int = mp_number_multiply_int;
+ math->md_divide_int = mp_number_divide_int;
+ math->md_to_boolean = mp_number_to_boolean;
+ math->md_to_scaled = mp_number_to_scaled;
+ math->md_to_double = mp_number_to_double;
+ math->md_to_int = mp_number_to_int;
+ math->md_odd = mp_number_odd;
+ math->md_equal = mp_number_equal;
+ math->md_less = mp_number_less;
+ math->md_greater = mp_number_greater;
+ math->md_nonequalabs = mp_number_nonequalabs;
+ math->md_round_unscaled = mp_round_unscaled;
+ math->md_floor_scaled = mp_number_floor;
+ math->md_fraction_to_round_scaled = mp_double_fraction_to_round_scaled;
+ math->md_make_scaled = mp_double_number_make_scaled;
+ math->md_make_fraction = mp_double_number_make_fraction;
+ math->md_take_fraction = mp_double_number_take_fraction;
+ math->md_take_scaled = mp_double_number_take_scaled;
+ math->md_velocity = mp_double_velocity;
+ math->md_n_arg = mp_double_n_arg;
+ math->md_m_log = mp_double_m_log;
+ math->md_m_exp = mp_double_m_exp;
+ math->md_m_unif_rand = mp_double_m_unif_rand;
+ math->md_m_norm_rand = mp_double_m_norm_rand;
+ math->md_pyth_add = mp_double_pyth_add;
+ math->md_pyth_sub = mp_double_pyth_sub;
+ math->md_power_of = mp_double_power_of;
+ math->md_fraction_to_scaled = mp_number_fraction_to_scaled;
+ math->md_scaled_to_fraction = mp_number_scaled_to_fraction;
+ math->md_scaled_to_angle = mp_number_scaled_to_angle;
+ math->md_angle_to_scaled = mp_number_angle_to_scaled;
+ math->md_init_randoms = mp_init_randoms;
+ math->md_sin_cos = mp_double_sin_cos;
+ math->md_slow_add = mp_double_slow_add;
+ math->md_sqrt = mp_double_square_rt;
+ math->md_print = mp_double_print_number;
+ math->md_tostring = mp_double_number_tostring;
+ math->md_modulo = mp_number_modulo;
+ math->md_ab_vs_cd = mp_ab_vs_cd;
+ math->md_crossing_point = mp_double_crossing_point;
+ math->md_scan_numeric = mp_double_scan_numeric_token;
+ math->md_scan_fractional = mp_double_scan_fractional_token;
+ math->md_free_math = mp_free_double_math;
+ math->md_set_precision = mp_double_set_precision;
+ return math;
+}
+
+void mp_double_set_precision (MP mp)
+{
+ (void) mp;
+}
+
+void mp_free_double_math (MP mp)
+{
+ mp_free_number(mp, &(mp->math->md_three_sixty_deg_t));
+ mp_free_number(mp, &(mp->math->md_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_negative_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_fraction_one_t));
+ mp_free_number(mp, &(mp->math->md_zero_t));
+ mp_free_number(mp, &(mp->math->md_half_unit_t));
+ mp_free_number(mp, &(mp->math->md_three_quarter_unit_t));
+ mp_free_number(mp, &(mp->math->md_unity_t));
+ mp_free_number(mp, &(mp->math->md_two_t));
+ mp_free_number(mp, &(mp->math->md_three_t));
+ mp_free_number(mp, &(mp->math->md_one_third_inf_t));
+ mp_free_number(mp, &(mp->math->md_inf_t));
+ mp_free_number(mp, &(mp->math->md_negative_inf_t));
+ mp_free_number(mp, &(mp->math->md_warning_limit_t));
+ mp_free_number(mp, &(mp->math->md_one_k));
+ mp_free_number(mp, &(mp->math->md_sqrt_8_e_k));
+ mp_free_number(mp, &(mp->math->md_twelve_ln_2_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_minus_1));
+ mp_free_number(mp, &(mp->math->md_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_near_zero_angle_t));
+ mp_free_number(mp, &(mp->math->md_p_over_v_threshold_t));
+ mp_free_number(mp, &(mp->math->md_equation_threshold_t));
+ mp_memory_free(mp->math);
+}
+
+void mp_allocate_number (MP mp, mp_number *n, mp_number_type t)
+{
+ (void) mp;
+ n->data.dval = 0.0;
+ n->type = t;
+}
+
+void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.dval = v->data.dval;
+}
+
+void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.dval = fabs(v->data.dval);
+}
+
+void mp_allocate_double (MP mp, mp_number *n, double v)
+{
+ (void) mp;
+ n->type = mp_scaled_type;
+ n->data.dval = v;
+}
+
+void mp_free_number (MP mp, mp_number *n)
+{
+ (void) mp;
+ n->type = mp_nan_type;
+}
+
+void mp_set_double_from_int(mp_number *A, int B)
+{
+ A->data.dval = B;
+}
+
+void mp_set_double_from_boolean(mp_number *A, int B)
+{
+ A->data.dval = B;
+}
+
+void mp_set_double_from_scaled(mp_number *A, int B)
+{
+ A->data.dval = B / 65536.0;
+}
+
+void mp_set_double_from_double(mp_number *A, double B)
+{
+ A->data.dval = B;
+}
+
+void mp_set_double_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval + C->data.dval;
+}
+
+void mp_set_double_half_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = (B->data.dval + C->data.dval) / 2.0;
+}
+
+void mp_set_double_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval - C->data.dval;
+}
+
+void mp_set_double_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = (B->data.dval - C->data.dval) / 2.0;
+}
+
+void mp_set_double_from_div(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval / C->data.dval;
+}
+
+void mp_set_double_from_mul(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval * C->data.dval;
+}
+
+void mp_set_double_from_int_div(mp_number *A, mp_number *B, int C)
+{
+ A->data.dval = B->data.dval / C;
+}
+
+void mp_set_double_from_int_mul(mp_number *A, mp_number *B, int C)
+{
+ A->data.dval = B->data.dval * C;
+}
+
+void mp_set_double_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C)
+{
+ (void) mp;
+ A->data.dval = B->data.dval - mp_double_take_fraction(B->data.dval - C->data.dval, t->data.dval);
+}
+
+void mp_number_negate(mp_number *A)
+{
+ A->data.dval = -A->data.dval;
+ if (A->data.dval == -0.0) {
+ A->data.dval = 0.0;
+ }
+}
+
+void mp_number_add(mp_number *A, mp_number *B)
+{
+ A->data.dval = A->data.dval + B->data.dval;
+}
+
+void mp_number_subtract(mp_number *A, mp_number *B)
+{
+ A->data.dval = A->data.dval - B->data.dval;
+}
+
+void mp_number_half(mp_number *A)
+{
+ A->data.dval = A->data.dval / 2.0;
+}
+
+void mp_number_double(mp_number *A)
+{
+ A->data.dval = A->data.dval * 2.0;
+}
+
+void mp_number_add_scaled(mp_number *A, int B)
+{
+ A->data.dval = A->data.dval + (B / 65536.0);
+}
+
+void mp_number_multiply_int(mp_number *A, int B)
+{
+ A->data.dval = (double)(A->data.dval * B);
+}
+
+void mp_number_divide_int(mp_number *A, int B)
+{
+ A->data.dval = A->data.dval / (double)B;
+}
+
+void mp_double_abs(mp_number *A)
+{
+ A->data.dval = fabs(A->data.dval);
+}
+
+void mp_number_clone(mp_number *A, mp_number *B)
+{
+ A->data.dval = B->data.dval;
+}
+
+void mp_number_negated_clone(mp_number *A, mp_number *B)
+{
+ A->data.dval = -B->data.dval;
+ if (A->data.dval == -0.0) {
+ A->data.dval = 0.0;
+ }
+}
+
+void mp_number_abs_clone(mp_number *A, mp_number *B)
+{
+ A->data.dval = fabs(B->data.dval);
+}
+
+void mp_number_swap(mp_number *A, mp_number *B)
+{
+ double swap_tmp = A->data.dval;
+ A->data.dval = B->data.dval;
+ B->data.dval = swap_tmp;
+}
+
+void mp_number_fraction_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ A->data.dval = A->data.dval / fraction_multiplier;
+}
+
+void mp_number_angle_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ A->data.dval = A->data.dval / angle_multiplier;
+}
+
+void mp_number_scaled_to_fraction(mp_number *A)
+{
+ A->type = mp_fraction_type;
+ A->data.dval = A->data.dval * fraction_multiplier;
+}
+
+void mp_number_scaled_to_angle(mp_number *A)
+{
+ A->type = mp_angle_type;
+ A->data.dval = A->data.dval * angle_multiplier;
+}
+
+int mp_number_to_scaled(mp_number *A)
+{
+ return (int) lround(A->data.dval * 65536.0);
+}
+
+int mp_number_to_int(mp_number *A)
+{
+ return (int) (A->data.dval);
+}
+
+int mp_number_to_boolean(mp_number *A)
+{
+ return (int) (A->data.dval);
+}
+
+double mp_number_to_double(mp_number *A)
+{
+ return A->data.dval;
+}
+
+int mp_number_odd(mp_number *A)
+{
+ return odd((int) lround(A->data.dval));
+}
+
+int mp_number_equal(mp_number *A, mp_number *B)
+{
+ return A->data.dval == B->data.dval;
+}
+
+int mp_number_greater(mp_number *A, mp_number *B)
+{
+ return A->data.dval > B->data.dval;
+}
+
+int mp_number_less(mp_number *A, mp_number *B)
+{
+ return A->data.dval < B->data.dval;
+}
+
+int mp_number_nonequalabs(mp_number *A, mp_number *B)
+{
+ return fabs(A->data.dval) != fabs(B->data.dval);
+}
+
+char *mp_double_number_tostring (MP mp, mp_number *n)
+{
+ static char set[64];
+ int l = 0;
+ char *ret = mp_memory_allocate(64);
+ (void) mp;
+ snprintf(set, 64, "%.17g", n->data.dval);
+ while (set[l] == ' ') {
+ l++;
+ }
+ strcpy(ret, set+l);
+ return ret;
+}
+
+void mp_double_print_number (MP mp, mp_number *n)
+{
+ char *str = mp_double_number_tostring(mp, n);
+ mp_print_e_str(mp, str);
+ mp_memory_free(str);
+}
+
+void mp_double_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ double x = x_orig->data.dval;
+ double y = y_orig->data.dval;
+ if (x >= 0.0) {
+ if (y <= EL_GORDO - x) {
+ ret->data.dval = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ }
+ } else if (-y <= EL_GORDO + x) {
+ ret->data.dval = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.dval = negative_EL_GORDO;
+ }
+}
+
+void mp_double_number_make_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q) {
+ (void) mp;
+ ret->data.dval = mp_double_make_fraction(p->data.dval, q->data.dval);
+}
+
+void mp_double_number_take_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q) {
+ (void) mp;
+ ret->data.dval = mp_double_take_fraction(p->data.dval, q->data.dval);
+}
+
+void mp_double_number_take_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ (void) mp;
+ ret->data.dval = p_orig->data.dval * q_orig->data.dval;
+}
+
+void mp_double_number_make_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ (void) mp;
+ ret->data.dval = p_orig->data.dval / q_orig->data.dval;
+}
+
+void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop)
+{
+ double result;
+ char *end = (char *) stop;
+ errno = 0;
+ result = strtod((char *) start, &end);
+ if (errno == 0) {
+ set_cur_mod(result);
+ if (result >= warning_limit) {
+ if (internal_value(mp_warning_check_internal).data.dval > 0 && (mp->scanner_status != mp_tex_flushing_state)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Number is too large (%g)", result);
+ mp_error(
+ mp,
+ msg,
+ "Continue and I'll try to cope with that big value; but it might be dangerous."
+ "(Set warningcheck := 0 to suppress this message.)"
+ );
+ }
+ }
+ } else if (mp->scanner_status != mp_tex_flushing_state) {
+ mp_error(
+ mp,
+ "Enormous number has been reduced.",
+ "I could not handle this number specification probably because it is out of"
+ "range."
+ );
+ set_cur_mod(EL_GORDO);
+ }
+ set_cur_cmd(mp_numeric_command);
+}
+
+static void mp_double_aux_find_exponent (MP mp)
+{
+ if (mp->buffer[mp->cur_input.loc_field] == 'e' || mp->buffer[mp->cur_input.loc_field] == 'E') {
+ mp->cur_input.loc_field++;
+ if (!(mp->buffer[mp->cur_input.loc_field] == '+'
+ || mp->buffer[mp->cur_input.loc_field] == '-'
+ || mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class)) {
+ mp->cur_input.loc_field--;
+ return;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '+'
+ || mp->buffer[mp->cur_input.loc_field] == '-') {
+ mp->cur_input.loc_field++;
+ }
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+}
+
+void mp_double_scan_fractional_token (MP mp, int n)
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ mp_double_aux_find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+void mp_double_scan_numeric_token (MP mp, int n)
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '.' && mp->buffer[mp->cur_input.loc_field+1] != '.') {
+ mp->cur_input.loc_field++;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+ mp_double_aux_find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+void mp_double_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t)
+{
+ double acc, num, denom;
+ (void) mp;
+ acc = mp_double_take_fraction(st->data.dval - (sf->data.dval / 16.0), sf->data.dval - (st->data.dval / 16.0));
+ acc = mp_double_take_fraction(acc, ct->data.dval - cf->data.dval);
+ num = fraction_two + mp_double_take_fraction(acc, sqrt(2)*fraction_one);
+ denom = fraction_three
+ + mp_double_take_fraction(ct->data.dval, 3*fraction_half*(sqrt(5.0)-1.0))
+ + mp_double_take_fraction(cf->data.dval, 3*fraction_half*(3.0-sqrt(5.0)));
+ if (t->data.dval != unity) {
+ num = mp_double_make_scaled(num, t->data.dval);
+ }
+ if (num / 4 >= denom) {
+ ret->data.dval = fraction_four;
+ } else {
+ ret->data.dval = mp_double_make_fraction(num, denom);
+ }
+}
+
+int mp_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ return mp_double_ab_vs_cd(a_orig, b_orig, c_orig, d_orig);
+}
+
+static void mp_double_crossing_point (MP mp, mp_number *ret, mp_number *aa, mp_number *bb, mp_number *cc)
+{
+ double d;
+ double xx, x0, x1, x2;
+ double a = aa->data.dval;
+ double b = bb->data.dval;
+ double c = cc->data.dval;
+ (void) mp;
+ if (a < 0.0) {
+ ret->data.dval = zero_crossing;
+ return;
+ }
+ if (c >= 0.0) {
+ if (b >= 0.0) {
+ if (c > 0.0) {
+ ret->data.dval = no_crossing;
+ } else if ((a == 0.0) && (b == 0.0)) {
+ ret->data.dval = no_crossing;
+ } else {
+ ret->data.dval = one_crossing;
+ }
+ return;
+ }
+ if (a == 0.0) {
+ ret->data.dval = zero_crossing;
+ return;
+ }
+ } else if ((a == 0.0) && (b <= 0.0)) {
+ ret->data.dval = zero_crossing;
+ return;
+ }
+ d = epsilon;
+ x0 = a;
+ x1 = a - b;
+ x2 = b - c;
+ do {
+ double x = (x1 + x2) / 2 + 1E-12;
+ if (x1 - x0 > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ xx = x1 + x - x0;
+ if (xx > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ x0 = x0 - xx;
+ if ((x <= x0) && (x + x2 <= x0)) {
+ ret->data.dval = no_crossing;
+ return;
+ }
+ x1 = x;
+ d = d + d + epsilon;
+ }
+ }
+ } while (d < fraction_one);
+ ret->data.dval = (d - fraction_one);
+}
+
+int mp_round_unscaled(mp_number *x_orig)
+{
+ return (int) lround(x_orig->data.dval);
+}
+
+void mp_number_floor(mp_number *i)
+{
+ i->data.dval = floor(i->data.dval);
+}
+
+void mp_double_fraction_to_round_scaled(mp_number *x_orig)
+{
+ double x = x_orig->data.dval;
+ x_orig->type = mp_scaled_type;
+ x_orig->data.dval = x/fraction_multiplier;
+}
+
+void mp_double_square_rt (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ double x = x_orig->data.dval;
+ if (x > 0) {
+ ret->data.dval = sqrt(x);
+ } else {
+ if (x < 0) {
+ char msg[256];
+ char *xstr = mp_double_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Square root of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ ret->data.dval = 0;
+ }
+}
+
+void mp_double_pyth_add (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ double a = fabs(a_orig->data.dval);
+ double b = fabs(b_orig->data.dval);
+ errno = 0;
+ ret->data.dval = sqrt(a*a + b*b);
+ if (errno) {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ }
+}
+
+void mp_double_pyth_sub (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ double a = fabs(a_orig->data.dval);
+ double b = fabs(b_orig->data.dval);
+ if (a > b) {
+ a = sqrt(a*a - b*b);
+ } else {
+ if (a < b) {
+ char msg[256];
+ char *astr = mp_double_number_tostring(mp, a_orig);
+ char *bstr = mp_double_number_tostring(mp, b_orig);
+ mp_snprintf(msg, 256, "Pythagorean subtraction %s+-+%s has been replaced by 0", astr, bstr);
+ mp_memory_free(astr);
+ mp_memory_free(bstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, Im zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ a = 0;
+ }
+ ret->data.dval = a;
+}
+
+void mp_double_power_of (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ errno = 0;
+ ret->data.dval = pow(a_orig->data.dval, b_orig->data.dval);
+ if (errno) {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ }
+}
+
+void mp_double_m_log (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ if (x_orig->data.dval > 0) {
+ ret->data.dval = log(x_orig->data.dval)*256.0;
+ } else {
+ char msg[256];
+ char *xstr = mp_double_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Logarithm of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take logs of non-positive numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.dval = 0;
+ }
+}
+
+void mp_double_m_exp (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ errno = 0;
+ ret->data.dval = exp(x_orig->data.dval/256.0);
+ if (errno) {
+ if (x_orig->data.dval > 0) {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ } else {
+ ret->data.dval = 0;
+ }
+ }
+}
+
+void mp_double_n_arg (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ if (x_orig->data.dval == 0.0 && y_orig->data.dval == 0.0) {
+ mp_error(
+ mp,
+ "angle(0,0) is taken as zero",
+ "The 'angle' between two identical points is undefined. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.dval = 0;
+ } else {
+ ret->type = mp_angle_type;
+ ret->data.dval = atan2(y_orig->data.dval, x_orig->data.dval) * (180.0 / PI) * angle_multiplier;
+ if (ret->data.dval == -0.0)
+ ret->data.dval = 0.0;
+ }
+}
+
+void mp_double_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin)
+{
+ double rad = (z_orig->data.dval / angle_multiplier);
+ (void) mp;
+ if ((rad == 90.0) || (rad == -270)){
+ n_cos->data.dval = 0.0;
+ n_sin->data.dval = fraction_multiplier;
+ } else if ((rad == -90.0) || (rad == 270.0)) {
+ n_cos->data.dval = 0.0;
+ n_sin->data.dval = -fraction_multiplier;
+ } else if ((rad == 180.0) || (rad == -180.0)) {
+ n_cos->data.dval = -fraction_multiplier;
+ n_sin->data.dval = 0.0;
+ } else {
+ rad = rad * PI/180.0;
+ n_cos->data.dval = cos(rad) * fraction_multiplier;
+ n_sin->data.dval = sin(rad) * fraction_multiplier;
+ }
+}
+
+# define KK 100
+# define LL 37
+# define MM (1L<<30)
+# define mod_diff(x,y) (((x)-(y))&(MM-1))
+# define TT 70
+# define is_odd(x) ((x)&1)
+# define QUALITY 1009
+
+
+typedef struct mp_double_random_info {
+ long x[KK];
+ long buf[QUALITY];
+ long dummy;
+ long started;
+ long *ptr;
+} mp_double_random_info;
+
+mp_double_random_info mp_double_random_data = {
+ .dummy = -1,
+ .started = -1,
+ .ptr = &mp_double_random_data.dummy
+};
+
+static void mp_double_aux_ran_array(long aa[], int n)
+{
+ int i, j;
+ for (j = 0; j < KK; j++) {
+ aa[j] = mp_double_random_data.x[j];
+ }
+ for (; j < n; j++) {
+ aa[j] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (i = 0; i < LL; i++, j++) {
+ mp_double_random_data.x[i] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (; i < KK; i++, j++) {
+ mp_double_random_data.x[i] = mod_diff(aa[j - KK], mp_double_random_data.x[i - LL]);
+ }
+}
+
+
+static void mp_double_aux_ran_start(long seed)
+{
+ int t, j;
+ long x[KK + KK - 1];
+ long ss = (seed+2) & (MM - 2);
+ for (j = 0; j < KK; j++) {
+ x[j] = ss;
+ ss <<= 1;
+ if (ss >= MM) {
+ ss -= MM - 2;
+ }
+ }
+ x[1]++;
+ for (ss = seed & (MM - 1), t = TT - 1; t;) {
+ for (j = KK - 1; j > 0; j--) {
+ x[j + j] = x[j];
+ x[j + j - 1] = 0;
+ }
+ for (j = KK + KK - 2; j >= KK; j--) {
+ x[j - (KK -LL)] = mod_diff(x[j - (KK - LL)], x[j]);
+ x[j - KK] = mod_diff(x[j - KK], x[j]);
+ }
+ if (is_odd(ss)) {
+ for (j = KK; j>0; j--) {
+ x[j] = x[j-1];
+ }
+ x[0] = x[KK];
+ x[LL] = mod_diff(x[LL], x[KK]);
+ }
+ if (ss) {
+ ss >>= 1;
+ } else {
+ t--;
+ }
+ }
+ for (j = 0; j < LL; j++) {
+ mp_double_random_data.x[j + KK - LL] = x[j];
+ }
+ for (;j < KK; j++) {
+ mp_double_random_data.x[j - LL] = x[j];
+ }
+ for (j = 0; j < 10; j++) {
+ mp_double_aux_ran_array(x, KK + KK - 1);
+ }
+ mp_double_random_data.ptr = &mp_double_random_data.started;
+}
+
+# define mp_double_aux_ran_arr_next() (*mp_double_random_data.ptr>=0? *mp_double_random_data.ptr++: mp_double_aux_ran_arr_cycle())
+
+static long mp_double_aux_ran_arr_cycle(void)
+{
+ if (mp_double_random_data.ptr == &mp_double_random_data.dummy) {
+ mp_double_aux_ran_start(314159L);
+ }
+ mp_double_aux_ran_array(mp_double_random_data.buf, QUALITY);
+ mp_double_random_data.buf[KK] = -1;
+ mp_double_random_data.ptr = mp_double_random_data.buf + 1;
+ return mp_double_random_data.buf[0];
+}
+
+void mp_init_randoms (MP mp, int seed)
+{
+ int k = 1;
+ int j = abs(seed);
+ int f = (int) fraction_one;
+ while (j >= f) {
+ j = j/2;
+ }
+ for (int i = 0; i <= 54; i++) {
+ int jj = k;
+ k = j - k;
+ j = jj;
+ if (k < 0) {
+ k += f;
+ }
+ mp->randoms[(i * 21) % 55].data.dval = j;
+ }
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_double_aux_ran_start((unsigned long) seed);
+}
+
+void mp_number_modulo(mp_number *a, mp_number *b)
+{
+ double tmp;
+ a->data.dval = modf((double) a->data.dval / (double) b->data.dval, &tmp) * (double) b->data.dval;
+}
+
+static void mp_next_unif_random (MP mp, mp_number *ret)
+{
+ unsigned long int op = (unsigned) mp_double_aux_ran_arr_next();
+ double a = op / (MM * 1.0);
+ (void) mp;
+ ret->data.dval = a;
+}
+
+static void mp_next_random (MP mp, mp_number *ret)
+{
+ if ( mp->j_random==0) {
+ mp_new_randoms(mp);
+ } else {
+ mp->j_random = mp->j_random-1;
+ }
+ mp_number_clone(ret, &(mp->randoms[mp->j_random]));
+}
+
+static void mp_double_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ mp_number x, abs_x, u, y;
+ mp_allocate_number(mp, &y, mp_fraction_type);
+ mp_allocate_clone(mp, &x, mp_scaled_type, x_orig);
+ mp_allocate_abs(mp, &abs_x, mp_scaled_type, &x);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_next_unif_random(mp, &u);
+ y.data.dval = abs_x.data.dval * u.data.dval;
+ mp_free_number(mp, &u);
+ if (mp_number_equal(&y, &abs_x)) {
+ mp_number_clone(ret, &((math_data *)mp->math)->md_zero_t);
+ } else if (mp_number_greater(&x, &((math_data *)mp->math)->md_zero_t)) {
+ mp_number_clone(ret, &y);
+ } else {
+ mp_number_negated_clone(ret, &y);
+ }
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &x);
+ mp_free_number(mp, &y);
+}
+
+static void mp_double_m_norm_rand (MP mp, mp_number *ret)
+{
+ mp_number abs_x, u, r, la, xa;
+ mp_allocate_number(mp, &la, mp_scaled_type);
+ mp_allocate_number(mp, &xa, mp_scaled_type);
+ mp_allocate_number(mp, &abs_x, mp_scaled_type);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_allocate_number(mp, &r, mp_scaled_type);
+ do {
+ do {
+ mp_number v;
+ mp_allocate_number(mp, &v, mp_scaled_type);
+ mp_next_random(mp, &v);
+ mp_number_subtract(&v, &((math_data *)mp->math)->md_fraction_half_t);
+ mp_double_number_take_fraction(mp, &xa, &((math_data *)mp->math)->md_sqrt_8_e_k, &v);
+ mp_free_number(mp, &v);
+ mp_next_random(mp, &u);
+ mp_number_clone(&abs_x, &xa);
+ mp_double_abs(&abs_x);
+ } while (! mp_number_less(&abs_x, &u));
+ mp_double_number_make_fraction(mp, &r, &xa, &u);
+ mp_number_clone(&xa, &r);
+ mp_double_m_log(mp, &la, &u);
+ mp_set_double_from_subtraction(&la, &((math_data *)mp->math)->md_twelve_ln_2_k, &la);
+ } while (mp_double_ab_vs_cd(&((math_data *)mp->math)->md_one_k, &la, &xa, &xa) < 0);
+ mp_number_clone(ret, &xa);
+ mp_free_number(mp, &r);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &la);
+ mp_free_number(mp, &xa);
+ mp_free_number(mp, &u);
+}
+
+int mp_double_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ double ab = a_orig->data.dval * b_orig->data.dval;
+ double cd = c_orig->data.dval * d_orig->data.dval;
+ if (ab > cd) {
+ return 1;
+ } else if (ab < cd) {
+ return -1;
+ } else {
+ return 0;
+ }
+}
diff --git a/source/luametatex/source/mp/mpc/mpmathdouble.h b/source/luametatex/source/mp/mpc/mpmathdouble.h
new file mode 100644
index 000000000..4c041164e
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpmathdouble.h
@@ -0,0 +1,12 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# ifndef MPMATHDOUBLE_H
+# define MPMATHDOUBLE_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_double_math (MP mp);
+
+# endif
+
diff --git a/source/luametatex/source/mp/mpc/mpstrings.c b/source/luametatex/source/mp/mpc/mpstrings.c
new file mode 100644
index 000000000..593985a68
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpstrings.c
@@ -0,0 +1,291 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# include "mpconfig.h"
+# include "mpstrings.h"
+
+# define STRCMP_RESULT(a) ((a) < 0 ? -1 : ((a) > 0 ? 1 : 0))
+
+static int mp_aux_comp_strings_entry(void *p, const void *pa, const void *pb)
+{
+ const mp_lstring *a = (const mp_lstring *) pa;
+ const mp_lstring *b = (const mp_lstring *) pb;
+ unsigned char *s = a->str;
+ unsigned char *t = b->str;
+ size_t l = a->len <= b->len ? a->len : b->len;
+ (void) p;
+ while (l-- > 0) {
+ if (*s != *t) {
+ return STRCMP_RESULT(*s - *t);
+ } else {
+ s++;
+ t++;
+ }
+ }
+ return STRCMP_RESULT((int)(a->len - b->len));
+}
+
+void *mp_aux_copy_strings_entry(const void *p)
+{
+ mp_string ff = mp_memory_allocate(sizeof(mp_lstring));
+ if (ff) {
+ const mp_lstring *fp = (const mp_lstring *) p;
+ ff->str = mp_memory_allocate((size_t) fp->len + 1);
+ if (ff->str) {
+ memcpy((char *) ff->str, (char *) fp->str, fp->len + 1);
+ ff->len = fp->len;
+ ff->refs = 0;
+ return ff;
+ }
+ }
+ return NULL;
+}
+
+static void *delete_strings_entry(void *p)
+{
+ mp_string ff = (mp_string) p;
+ mp_memory_free(ff->str);
+ mp_memory_free(ff);
+ return NULL;
+}
+
+static mp_string new_strings_entry(void)
+{
+ mp_string ff = mp_memory_allocate(sizeof(mp_lstring));
+ ff->str = NULL;
+ ff->len = 0;
+ ff->refs = 0;
+ return ff;
+}
+
+char *mp_strdup(const char *s)
+{
+ if (s) {
+ char *w = lmt_memory_strdup(s);
+ if (w) {
+ return w;
+ } else {
+ printf("mplib ran out of memory, case 3");
+ exit(EXIT_FAILURE);
+ }
+ }
+ return NULL;
+}
+
+
+char *mp_strndup(const char *p, size_t l)
+{
+ if (p) {
+ char *r = mp_memory_allocate(l * sizeof(char) + 1);
+ if (r) {
+ char *s = memcpy(r, p, l);
+ *(s + l) = '\0';
+ return s;
+ } else {
+ printf("mplib ran out of memory, case 4");
+ exit(EXIT_FAILURE);
+ }
+ }
+ return NULL;
+}
+
+
+int mp_strcmp(const char *a, const char *b)
+{
+ return a == NULL ? (b == NULL ? 0 : -1) : (b == NULL ? 1 : strcmp(a, b));
+}
+
+void mp_initialize_strings(MP mp)
+{
+ mp->strings = avl_create(mp_aux_comp_strings_entry, mp_aux_copy_strings_entry, delete_strings_entry, mp_memory_allocate, mp_memory_free, NULL);
+ mp->cur_string = NULL;
+ mp->cur_length = 0;
+ mp->cur_string_size = 0;
+}
+
+void mp_dealloc_strings(MP mp)
+{
+ if (mp->strings != NULL) {
+ avl_destroy(mp->strings);
+ } else {
+ mp->strings = NULL;
+ mp_memory_free(mp->cur_string);
+ mp->cur_string = NULL;
+ mp->cur_length = 0;
+ mp->cur_string_size = 0;
+ }
+}
+
+char *mp_str(MP mp, mp_string ss)
+{
+ (void) mp;
+ return (char *) ss->str;
+}
+
+mp_string mp_rtsl(MP mp, const char *s, size_t l)
+{
+ mp_string nstr;
+ mp_string str = new_strings_entry();
+ str->str = (unsigned char *) mp_strndup(s, l);
+ str->len = l;
+ nstr = (mp_string) avl_find(str, mp->strings);
+ if (nstr == NULL) {
+ avl_ins(str, mp->strings, avl_false);
+ nstr = (mp_string) avl_find(str, mp->strings);
+ }
+ delete_strings_entry(str);
+ add_str_ref(nstr);
+ return nstr;
+}
+
+mp_string mp_rts(MP mp, const char *s)
+{
+ return mp_rtsl(mp, s, strlen(s));
+}
+
+# define EXTRA_STRING 500
+
+void mp_str_room(MP mp, int wsize)
+{
+ if ((mp->cur_length + (size_t) wsize + 1) > mp->cur_string_size) {
+ size_t nsize = mp->cur_string_size + mp->cur_string_size / 5 + EXTRA_STRING;
+ if (nsize < (size_t) wsize) {
+ nsize = (size_t) wsize + EXTRA_STRING;
+ }
+ mp->cur_string = (unsigned char *) mp_memory_reallocate(mp->cur_string, (size_t) nsize * sizeof(unsigned char));
+ memset(mp->cur_string + mp->cur_length, 0, nsize-mp->cur_length);
+ mp->cur_string_size = nsize;
+ }
+}
+
+void mp_append_char(MP mp, unsigned char c)
+{
+ *(mp->cur_string + mp->cur_length) = c;
+ mp->cur_length++;
+}
+
+void mp_append_str(MP mp, const char *s)
+{
+ int j = 0;
+ while ((unsigned char) s[j]) {
+ *(mp->cur_string + mp->cur_length) = s[j++];
+ mp->cur_length++;
+ }
+}
+
+void mp_reset_cur_string(MP mp)
+{
+ mp_memory_free(mp->cur_string);
+ mp->cur_length = 0;
+ mp->cur_string_size = 63;
+ mp->cur_string = (unsigned char *) mp_memory_allocate(64 * sizeof(unsigned char));
+ memset(mp->cur_string, 0, 64);
+}
+
+void mp_flush_string(MP mp, mp_string s) {
+ if (s->refs == 0) {
+ mp->strs_in_use--;
+ mp->pool_in_use = mp->pool_in_use - (int) s->len;
+ avl_del(s, mp->strings, NULL);
+ }
+}
+
+mp_string mp_intern(MP mp, const char *s)
+{
+ mp_string r = mp_rts(mp, s);
+ r->refs = MAX_STR_REF;
+ return r;
+}
+
+mp_string mp_make_string(MP mp)
+{
+ mp_string str;
+ mp_lstring tmp;
+ tmp.str = mp->cur_string;
+ tmp.len = mp->cur_length;
+ str = (mp_string) avl_find(&tmp, mp->strings);
+ if (str == NULL) {
+ str = mp_memory_allocate(sizeof(mp_lstring));
+ str->str = mp->cur_string;
+ str->len = tmp.len;
+ avl_ins(str, mp->strings, avl_false);
+ str = (mp_string) avl_find(&tmp, mp->strings);
+ mp->pool_in_use = mp->pool_in_use + (int) str->len;
+ if (mp->pool_in_use > mp->max_pl_used) {
+ mp->max_pl_used = mp->pool_in_use;
+ }
+ mp->strs_in_use++;
+ if (mp->strs_in_use > mp->max_strs_used) {
+ mp->max_strs_used = mp->strs_in_use;
+ }
+ }
+ add_str_ref(str);
+ mp_reset_cur_string (mp);
+ return str;
+}
+
+int mp_str_vs_str(MP mp, mp_string s, mp_string t)
+{
+ (void) mp;
+ return mp_aux_comp_strings_entry(NULL, (const void *) s, (const void *) t);
+}
+
+mp_string mp_cat(MP mp, mp_string a, mp_string b)
+{
+ mp_string str;
+ size_t saved_cur_length = mp->cur_length;
+ unsigned char *saved_cur_string = mp->cur_string;
+ size_t saved_cur_string_size = mp->cur_string_size;
+ size_t needed = a->len + b->len;
+ mp->cur_length = 0;
+ mp->cur_string = (unsigned char *) mp_memory_allocate((size_t) (needed + 1) * sizeof(unsigned char));
+ mp->cur_string_size = 0;
+ mp_str_room(mp, (int) needed + 1);
+ memcpy(mp->cur_string, a->str, a->len);
+ memcpy(mp->cur_string + a->len, b->str, b->len);
+ mp->cur_length = needed;
+ mp->cur_string[needed] = '\0';
+ str = mp_make_string(mp);
+ mp_memory_free(mp->cur_string);
+ mp->cur_length = saved_cur_length;
+ mp->cur_string = saved_cur_string;
+ mp->cur_string_size = saved_cur_string_size;
+ return str;
+}
+
+mp_string mp_chop_string(MP mp, mp_string s, int a, int b)
+{
+ int l = (int) s->len;
+ int reversed;
+ if (a <= b) {
+ reversed = 0;
+ } else {
+ int k = a;
+ a = b;
+ b = k;
+ reversed = 1;
+ }
+ if (a < 0) {
+ a = 0;
+ if (b < 0) {
+ b = 0;
+ }
+ }
+ if (b > l) {
+ b = l;
+ if (a > l) {
+ a = l;
+ }
+ }
+ mp_str_room(mp, (size_t) (b - a));
+ if (reversed) {
+ for (int k = b - 1; k >= a; k--) {
+ mp_append_char(mp, *(s->str + k));
+ }
+ } else {
+ for (int k = a; k < b; k++) {
+ mp_append_char(mp, *(s->str + k));
+ }
+ }
+ return mp_make_string(mp);
+}
diff --git a/source/luametatex/source/mp/mpc/mpstrings.h b/source/luametatex/source/mp/mpc/mpstrings.h
new file mode 100644
index 000000000..ab7e2b042
--- /dev/null
+++ b/source/luametatex/source/mp/mpc/mpstrings.h
@@ -0,0 +1,42 @@
+/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */
+
+
+# ifndef MPSTRINGS_H
+# define MPSTRINGS_H 1
+
+# include "mp.h"
+
+void *mp_aux_copy_strings_entry (const void *p);
+extern char *mp_strdup (const char *s);
+extern char *mp_strndup (const char *s, size_t l);
+extern int mp_strcmp (const char *a, const char *b);
+extern void mp_initialize_strings (MP mp);
+extern void mp_dealloc_strings (MP mp);
+char *mp_str (MP mp, mp_string s);
+mp_string mp_rtsl (MP mp, const char *s, size_t l);
+mp_string mp_rts (MP mp, const char *s);
+mp_string mp_make_string (MP mp);
+extern void mp_append_char (MP mp, unsigned char c);
+extern void mp_append_str (MP mp, const char *s);
+extern void mp_str_room (MP mp, int wsize);
+void mp_reset_cur_string (MP mp);
+# define MAX_STR_REF 127
+# define add_str_ref(A) { if ( (A)->refs < MAX_STR_REF ) ((A)->refs)++; }
+# define delete_str_ref(A) do { \
+ if ((A)->refs < MAX_STR_REF) { \
+ if ((A)->refs > 1) \
+ ((A)->refs)--; \
+ else \
+ mp_flush_string(mp, (A)); \
+ } \
+ } while (0)
+void mp_flush_string (MP mp, mp_string s);
+mp_string mp_intern (MP mp, const char *s);
+mp_string mp_make_string (MP mp);
+int mp_str_vs_str (MP mp, mp_string s, mp_string t);
+mp_string mp_cat (MP mp, mp_string a, mp_string b);
+mp_string mp_chop_string (MP mp, mp_string s, int a, int b);
+
+
+# endif
+
diff --git a/source/luametatex/source/mp/mpw/mp.w b/source/luametatex/source/mp/mpw/mp.w
new file mode 100644
index 000000000..017cc0fd7
--- /dev/null
+++ b/source/luametatex/source/mp/mpw/mp.w
@@ -0,0 +1,31138 @@
+% This file is part of MetaPost. The MetaPost program is in the public domain.
+
+@* Nota bene.
+
+This is not the official reference library but a version meant for \LUAMETATEX\
+in combination with \METAFUN, which is integrated in \CONTEXT. When the original
+gets improved I will diff the progression of the original \CWEB\ files and merge
+improvements.
+
+I'm pretty sure that the \TEX part of this file doesn't process but I'll look into
+that later. The comments are kept as they were but there are occasional remakts
+because we changes some bits and pieces. The references to properties, variables,
+constants etc, are mostly kept. I due time I'll fix it and see if I can render
+the file, but for not it's okay to just read the comments. I admit that I check
+things in Visual Studio anyway, which is why there are now |enum| used.
+
+This split is needed because the original library is the one used for \METAPOST\
+the program which is used by DEK, and I don't want to mess up his workflow. At
+some point I might emulate \METAPOST\ but I might as well decide to remove the
+interaction completely from this variant. It al depends on the outcome of
+experiments that Alan and I conduct, and as it's done in free time, it will take
+while. Don't push us, don't nag, don't complain. The original library is where
+the support is concentrated and you can always use that with the \MKIV\ macros.
+
+Todo: check typecasts, the halfword and quarterwords are now integers.
+Todo: Move more variables into the scope that they're used.
+Todo: Remove some (int) cast that are left overs from quarterword.
+Todo: Remove unused variables ... postpone more padding till that is done.
+Todo: Support color in group objects
+
+Because we don't want macros to clash with fields in record, setters and getters
+are prefixed by |mp_|. In order not clash with typedefs and accessors, in some
+cases |mp_get_| and |mp_set_| are used (eventually that might be true for all
+these cases). The |mp_free_| functions are complemented by |mp_new_| functions.
+In \MPLIB\ 2 |mp_get_| is used instead so keep that in mind when comparing the
+sources. I might also pass |mp| to all macros, just for consistency.
+
+To be considered: use the same record for rgb and cmyk (less code eventually).
+
+In order to make extensions a bit easier (and also because of consistency in
+enumerations, some _token and _sym and similar specifiers have been made _command
+(it was already somewhat inconsistent anyway). When something gets compared to
+cur_cmd it makes sense to use _command anyway.
+
+% some (int) can go
+
+(Hans Hagen, 2019+)
+
+@* Comment.
+
+At some point Taco Hoekwater brilliantly converted \MP\ into a library. Since
+then usage and integration of \METAPOST\ in \CONTEXT\ went even further than
+before. There were some backends added for \SVG\ and \PNG, and several number
+systems could be used. This was quite an effort! The \MP\ program became a
+wrapper around this library.
+
+The library is also used in \LUATEX\ but there we don't need the backend code at
+all. Also, having the traditional \TFM\ generating code (inherited from \MF)
+makes not much sense because we now live in an \OPENTYPE\ universum and the hard
+coded 256 limitations were even for \TYPEONE\ not okay. The GUST font team use
+their own tools around \MP\ anyway.
+
+This variant (below) is therefore a stripped down library. Everything related to
+loading fonts is gone, and if a \PS\ backend is needed the functionality has to
+go into its own module (as with \SVG\ and \PNG). This means that code removed
+here has to go there. One problen then is that the output primitives have to be
+brought in too, but in good \CWEB\ practices, that then can be done via change
+files (basically extending the data structures and such).
+
+However, a more modern variant could be to just use the library with \LUA,
+produce \PDF\ and convert that to any format needed. This is what we do in
+\CONTEXT. After a decade of usage I like to change a few interface aspects so
+here this happens.
+
+So: this variant is {\em not} the official \MP\ library but one meant for usage
+in \LUAMETATEX\ and experiments by Alan Braslau and Hans Hagen for more advanced
+graphics, produced by cooperation between \LUA\ and \MP. This strategy permits
+experiments without interference with the full blown version. Of course we can
+retrofit interesting extensions into its larger version at some point. It's all a
+work of love, done in our own time, so don't push our agenda in this.
+
+Stripping is easier than adding and the things I added were not at the level of
+the language or processing but the interface to \LUA\ as well as some details of
+text processing. Some more of that might happen. For instance, all file \IO\ now
+goes via \LUA\ so we assume the callbacks being set.
+
+On my agenda are to delegate printing of messages and errors to the plugin. Also
+filenames might be done differently. Messages are already normalized.
+
+As a start the psout.w file was stripped and turned into a mpcommon.w file. This
+means that the old \PS\ output code is no longer there. Because that file got
+small it eventually got merged in here which (1) permits some reshuffling and (2)
+gives room for optimizing the interface to \LUA\ (do we need the indirectness?).
+
+Quite some code has been stripped because we assume that \LUA\ can provide these
+features: file io, logging, management, error handling, etc. This saves quite a
+bit of code and also detangles a bit the mixed program vs. library code. For now
+the \quote {terminal} approach is kept.
+
+In the process I reformatted the source a bit. Sorry. It is no big deal because
+it looks like \METAPOST\ is not evolving, but what does evolve is the code here:
+scanners and more access, to mention a few. I've added braces so that comments
+can go with single statements and there can be no doubt when \WEB\ macros are
+used (some braces could go there. More variables will become local (to branches
+for instance). Messages are done more directly, etc. etc. One of the reasons for
+doing that is that it looks nicer in Visual Studio. There it helps to move some
+variables to a more local scope. Of course a side effect is that backporting is
+now no longer an option. In some cases redundant braces were removed (when it's
+clear in the w file) and some else statements have been added where confusion
+takes place because that one doesn't return (so compilers can for instance warn
+about uninitialized pointers). I made sure that the resulting code is readable
+in visual studio.
+
+Work in progress: prefix with mp_ so that macros don't clash with fields and we
+can get rid of _ hackery.
+
+Maybe some day: zpair zpath zdraw ztransform: just add an extra z dimension
+to the existing data types which makes it compatible too.
+
+Todo: consider double only
+Todo: use documented c
+Todo: rework some (more) helpers
+
+Todo: center
+Todo: centerofmass
+Todo: ceiling x
+Todo: x div y
+Todo: x mod y
+Todo: dir x
+Todo: unitvector
+
+(Hans Hagen, 2019+)
+
+@* Introduction.
+
+This is \MP\ by John Hobby, a graphics-language processor based on D. E. Knuth's
+\MF.
+
+Much of the original Pascal version of this program was copied with permission
+from MF.web Version 1.9. It interprets a language very similar to D.E. Knuth's
+METAFONT, but with changes designed to make it more suitable for PostScript
+output.
+
+The main purpose of the following program is to explain the algorithms of \MP\ as
+clearly as possible. However, the program has been written so that it can be
+tuned to run efficiently in a wide variety of operating environments by making
+comparatively few changes. Such flexibility is possible because the documentation
+that follows is written in the |WEB| language, which is at a higher level than
+C.
+
+A large piece of software like \MP\ has inherent complexity that cannot be
+reduced below a certain level of difficulty, although each individual part is
+fairly simple by itself. The |WEB| language is intended to make the algorithms
+as readable as possible, by reflecting the way the individual program pieces fit
+together and by providing the cross-references that connect different parts.
+Detailed comments about what is going on, and about why things were done in
+certain ways, have been liberally sprinkled throughout the program. These
+comments explain features of the implementation, but they rarely attempt to
+explain the \MP\ language itself, since the reader is supposed to be familiar
+with {\em The \METAFONT\ book} as well as the manual @.WEB@> @:METAFONTbook}{\sl
+The {\logos METAFONT}book@> {\em A User's Manual for \METAPOST}, Computing
+Science Technical Report 162, AT\AM T Bell Laboratories.
+
+@ The present implementation is a preliminary version, but the possibilities for
+new features are limited by the desire to remain as nearly compatible with \MF\
+as possible.
+
+On the other hand, the |WEB| description can be extended without changing the
+core of the program, and it has been designed so that such extensions are not
+extremely difficult to make. The |banner| string defined here should be changed
+whenever \MP\ undergoes any modifications, so that it will be clear which version
+of \MP\ might be the guilty party when a problem arises. @^extensions to \MP@>
+@^system dependencies@>
+
+At some point I started adding features to the library (think of stacking) but
+the more interesting additions came when Mikael Sundqvist and we side tracked from
+extending math at the \TEX\ end to more \METAFUN: intersection lists, arctime
+lists, path iteration, a few more helpers, some fixes, a bit more control, access
+to previously hidden functionality, appended paths, etc. And there is undoubtly
+more to come. As with all \LUATEX\ and \LUAMETATEX\ development, most gets
+explained in the history documents in the \CONTEXT\ distribution and articles. It
+was around version 3.14 (end May 2022).
+
+@d default_banner "This is MPLIB for LuaMetaTeX, version 3.14"
+
+@<Metapost version header@>=
+# define metapost_version "3.14"
+
+@ We used to have three header files: common, mpmp and mplib, but there ws some
+(growing) dependency on the one hand and we decided to target just \LUAMETATEX\
+on the other. After all, this is a special version. So, we now have one header
+file only. The variables from |MP_options| are included inside the |MP_instance|
+wholesale. This also permits some further stripping. Actually we can probably
+get rid of the intermediate \POSTSCRIPT\ representation or add a little more
+abstraction.
+
+@(mp.h@>=
+# ifndef MP_H
+# define MP_H 1
+
+# include "avl.h"
+# include "auxmemory.h"
+# include <string.h>
+# include <setjmp.h>
+
+@<Metapost version header@>
+typedef struct MP_instance *MP;
+@<Exported types@>
+typedef struct MP_options {
+ @<Option variables@>
+} MP_options;
+@<Exported function headers@>
+@<MPlib header stuff@>
+@<Declare helpers@>
+@<Enumeration types@>
+@<Types in the outer block@>
+@<Constants in the outer block@>
+typedef struct MP_instance {
+ @<Option variables@>
+ @<Global variables@>
+} MP_instance;
+@<Internal library declarations@>
+@<MPlib internal header stuff@>
+@<MPlib export header stuff@>
+# endif
+
+@ @c
+# include "mpconfig.h"
+# include "mp.h"
+# include "mpmath.h"
+# include "mpmathdouble.h"
+# include "mpmathbinary.h"
+# include "mpmathdecimal.h"
+# include "mpstrings.h"
+
+@h @<Declarations@>
+@<Error handling procedures@>
+
+@ Here are the functions that set up the \MP\ instance.
+
+@<Declarations@>=
+MP_options *mp_options (void);
+MP mp_initialize (MP_options * opt);
+
+@ @c
+MP_options *mp_options (void)
+{
+ MP_options *opt = mp_memory_clear_allocate(sizeof(MP_options));
+ return opt;
+}
+
+@ The whole instance structure is initialized with zeroes, this greatly reduces
+the number of statements needed in the |Allocate or initialize variables| block.
+
+@c
+static MP mp_do_new (jmp_buf *buf)
+{
+ MP mp = mp_memory_clear_allocate(sizeof(MP_instance));
+ if (mp == NULL) {
+ mp_memory_free(buf);
+ return NULL;
+ } else {
+ mp->jump_buf = buf;
+ return mp;
+ }
+}
+
+static void mp_free (MP mp)
+{
+ @<Dealloc variables@>
+ @<Finish non-interactive use@>
+ mp_memory_free(mp->jump_buf);
+ @<Free table entries@>
+ free_math();
+ mp_memory_free(mp);
+}
+
+static void mp_do_initialize (MP mp)
+{
+ @<Set initial values of key variables@>
+}
+
+@ For the retargetable math library, we need to have a pointer, at least.
+
+@<Global variables@>=
+math_data *math;
+
+@ @<Exported types@>=
+typedef enum mp_number_type {
+ mp_nan_type,
+ mp_scaled_type,
+ mp_fraction_type,
+ mp_angle_type,
+ mp_double_type,
+ mp_binary_type,
+ mp_decimal_type
+} mp_number_type;
+
+typedef union mp_number_store {
+ void *num;
+ double dval;
+ int val;
+} mp_number_store;
+
+typedef struct mp_number_data {
+ mp_number_store data;
+ mp_number_type type;
+} mp_number_data;
+
+typedef struct mp_number_data mp_number;
+
+# define is_number(A) ((A).type != mp_nan_type)
+
+@ Switching to also passing pointers for the origins made the \LUAMETATEX\ binary
+go down from 3061799 bytes to 2960091 bytes (mid May 2022).
+
+We have a few more helpers for cloning: |negated| and |abs| because these happen
+often and it saves some lines of code in already long functions.
+
+@<Types in the outer block@>=
+typedef void (*convert_func) (mp_number *r);
+typedef void (*m_log_func) (MP mp, mp_number *r, mp_number *a);
+typedef void (*m_exp_func) (MP mp, mp_number *r, mp_number *a);
+typedef void (*m_unif_rand_func) (MP mp, mp_number *ret, mp_number *x_orig);
+typedef void (*m_norm_rand_func) (MP mp, mp_number *ret);
+typedef void (*pyth_add_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*pyth_sub_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*power_of_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*n_arg_func) (MP mp, mp_number *r, mp_number *a, mp_number *b);
+typedef void (*velocity_func) (MP mp, mp_number *r, mp_number *a, mp_number *b, mp_number *c, mp_number *d, mp_number *e);
+typedef int (*ab_vs_cd_func) (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+typedef void (*crossing_point_func) (MP mp, mp_number *r, mp_number *a, mp_number *b, mp_number *c);
+typedef void (*number_from_int_func) (mp_number *A, int B);
+typedef void (*number_from_boolean_func) (mp_number *A, int B);
+typedef void (*number_from_scaled_func) (mp_number *A, int B);
+typedef void (*number_from_double_func) (mp_number *A, double B);
+typedef void (*number_from_addition_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_half_from_addition_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_subtraction_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_half_from_subtraction_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_div_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_mul_func) (mp_number *A, mp_number *B, mp_number *C);
+typedef void (*number_from_int_div_func) (mp_number *A, mp_number *B, int C);
+typedef void (*number_from_int_mul_func) (mp_number *A, mp_number *B, int C);
+typedef void (*number_from_oftheway_func) (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+typedef void (*number_negate_func) (mp_number *A);
+typedef void (*number_add_func) (mp_number *A, mp_number *B);
+typedef void (*number_subtract_func) (mp_number *A, mp_number *B);
+typedef void (*number_modulo_func) (mp_number *A, mp_number *B);
+typedef void (*number_half_func) (mp_number *A);
+typedef void (*number_double_func) (mp_number *A);
+typedef void (*number_abs_func) (mp_number *A);
+typedef void (*number_clone_func) (mp_number *A, mp_number *B);
+typedef void (*number_negated_clone_func) (mp_number *A, mp_number *B);
+typedef void (*number_abs_clone_func) (mp_number *A, mp_number *B);
+typedef void (*number_swap_func) (mp_number *A, mp_number *B);
+typedef void (*number_add_scaled_func) (mp_number *A, int b);
+typedef void (*number_multiply_int_func) (mp_number *A, int b);
+typedef void (*number_divide_int_func) (mp_number *A, int b);
+typedef int (*number_to_int_func) (mp_number *A);
+typedef int (*number_to_boolean_func) (mp_number *A);
+typedef int (*number_to_scaled_func) (mp_number *A);
+typedef int (*number_round_func) (mp_number *A);
+typedef void (*number_floor_func) (mp_number *A);
+typedef double (*number_to_double_func) (mp_number *A);
+typedef int (*number_odd_func) (mp_number *A);
+typedef int (*number_equal_func) (mp_number *A, mp_number *B);
+typedef int (*number_less_func) (mp_number *A, mp_number *B);
+typedef int (*number_greater_func) (mp_number *A, mp_number *B);
+typedef int (*number_nonequalabs_func) (mp_number *A, mp_number *B);
+typedef void (*make_scaled_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*make_fraction_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*take_fraction_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*take_scaled_func) (MP mp, mp_number *ret, mp_number *A, mp_number *B);
+typedef void (*sin_cos_func) (MP mp, mp_number *A, mp_number *S, mp_number *C);
+typedef void (*slow_add_func) (MP mp, mp_number *A, mp_number *S, mp_number *C);
+typedef void (*sqrt_func) (MP mp, mp_number *ret, mp_number *A);
+typedef void (*init_randoms_func) (MP mp, int seed);
+typedef void (*allocate_number_func) (MP mp, mp_number *A, mp_number_type t);
+typedef void (*allocate_number_clone_func) (MP mp, mp_number *A, mp_number_type t, mp_number *B);
+typedef void (*allocate_number_abs_func) (MP mp, mp_number *A, mp_number_type t, mp_number *B);
+typedef void (*allocate_number_double_func) (MP mp, mp_number *A, double B);
+typedef void (*free_number_func) (MP mp, mp_number *n);
+typedef void (*fraction_to_round_scaled_func) (mp_number *n);
+typedef void (*print_func) (MP mp, mp_number *A);
+typedef char *(*tostring_func) (MP mp, mp_number *A);
+typedef void (*scan_func) (MP mp, int A);
+typedef void (*mp_free_func) (MP mp);
+typedef void (*set_precision_func) (MP mp);
+
+/*
+ We use a prefix |md_| so that we don't get complaints about recursive macro
+ definitions. This is cleaner than redefining the macros.
+*/
+
+typedef struct math_data {
+ mp_number md_precision_default;
+ mp_number md_precision_max;
+ mp_number md_precision_min;
+ mp_number md_epsilon_t;
+ mp_number md_inf_t;
+ mp_number md_negative_inf_t;
+ mp_number md_one_third_inf_t;
+ mp_number md_zero_t;
+ mp_number md_unity_t;
+ mp_number md_two_t;
+ mp_number md_three_t;
+ mp_number md_half_unit_t;
+ mp_number md_three_quarter_unit_t;
+ mp_number md_fraction_one_t;
+ mp_number md_fraction_half_t;
+ mp_number md_fraction_three_t;
+ mp_number md_fraction_four_t;
+ mp_number md_one_eighty_deg_t;
+ mp_number md_negative_one_eighty_deg_t;
+ mp_number md_three_sixty_deg_t;
+ mp_number md_one_k;
+ mp_number md_sqrt_8_e_k;
+ mp_number md_twelve_ln_2_k;
+ mp_number md_coef_bound_k;
+ mp_number md_coef_bound_minus_1;
+ mp_number md_twelvebits_3;
+ mp_number md_arc_tol_k;
+ mp_number md_twentysixbits_sqrt2_t;
+ mp_number md_twentyeightbits_d_t;
+ mp_number md_twentysevenbits_sqrt2_d_t;
+ mp_number md_fraction_threshold_t;
+ mp_number md_half_fraction_threshold_t;
+ mp_number md_scaled_threshold_t;
+ mp_number md_half_scaled_threshold_t;
+ mp_number md_near_zero_angle_t;
+ mp_number md_p_over_v_threshold_t;
+ mp_number md_equation_threshold_t;
+ mp_number md_warning_limit_t;
+ allocate_number_func md_allocate;
+ allocate_number_clone_func md_allocate_clone;
+ allocate_number_abs_func md_allocate_abs;
+ allocate_number_double_func md_allocate_double;
+ free_number_func md_free;
+ number_from_int_func md_from_int;
+ number_from_boolean_func md_from_boolean;
+ number_from_scaled_func md_from_scaled;
+ number_from_double_func md_from_double;
+ number_from_addition_func md_from_addition;
+ number_half_from_addition_func md_half_from_addition;
+ number_from_subtraction_func md_from_subtraction;
+ number_half_from_subtraction_func md_half_from_subtraction;
+ number_from_div_func md_from_div;
+ number_from_mul_func md_from_mul;
+ number_from_int_div_func md_from_int_div;
+ number_from_int_mul_func md_from_int_mul;
+ number_from_oftheway_func md_from_oftheway;
+ number_negate_func md_negate;
+ number_add_func md_add;
+ number_subtract_func md_subtract;
+ number_half_func md_half;
+ number_modulo_func md_modulo;
+ number_double_func md_do_double;
+ number_abs_func md_abs;
+ number_clone_func md_clone;
+ number_negated_clone_func md_negated_clone;
+ number_abs_clone_func md_abs_clone;
+ number_swap_func md_swap;
+ number_add_scaled_func md_add_scaled;
+ number_multiply_int_func md_multiply_int;
+ number_divide_int_func md_divide_int;
+ number_to_int_func md_to_int;
+ number_to_boolean_func md_to_boolean;
+ number_to_scaled_func md_to_scaled;
+ number_to_double_func md_to_double;
+ number_odd_func md_odd;
+ number_equal_func md_equal;
+ number_less_func md_less;
+ number_greater_func md_greater;
+ number_nonequalabs_func md_nonequalabs;
+ number_round_func md_round_unscaled;
+ number_floor_func md_floor_scaled;
+ make_scaled_func md_make_scaled;
+ make_fraction_func md_make_fraction;
+ take_fraction_func md_take_fraction;
+ take_scaled_func md_take_scaled;
+ velocity_func md_velocity;
+ ab_vs_cd_func md_ab_vs_cd;
+ crossing_point_func md_crossing_point;
+ n_arg_func md_n_arg;
+ m_log_func md_m_log;
+ m_exp_func md_m_exp;
+ m_unif_rand_func md_m_unif_rand;
+ m_norm_rand_func md_m_norm_rand;
+ pyth_add_func md_pyth_add;
+ pyth_sub_func md_pyth_sub;
+ power_of_func md_power_of;
+ fraction_to_round_scaled_func md_fraction_to_round_scaled;
+ convert_func md_fraction_to_scaled;
+ convert_func md_scaled_to_fraction;
+ convert_func md_scaled_to_angle;
+ convert_func md_angle_to_scaled;
+ init_randoms_func md_init_randoms;
+ sin_cos_func md_sin_cos;
+ sqrt_func md_sqrt;
+ slow_add_func md_slow_add;
+ print_func md_print;
+ tostring_func md_tostring;
+ scan_func md_scan_numeric;
+ scan_func md_scan_fractional;
+ mp_free_func md_free_math;
+ set_precision_func md_set_precision;
+} math_data;
+
+@ This procedure gets things started properly.
+
+@c
+MP mp_initialize (MP_options * opt)
+{
+ MP mp;
+ jmp_buf *buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (buf == NULL || setjmp(*buf) != 0) {
+ return NULL;
+ }
+ mp = mp_do_new(buf);
+ if (mp == NULL) {
+ return NULL;
+ }
+ if (opt->job_name == NULL || ! *(opt->job_name)) {
+ return NULL;
+ }
+ mp->job_name = mp_strdup(opt->job_name);
+ mp->userdata = opt->userdata;
+ mp->extensions = opt->extensions;
+ @<Set default function pointers@>
+
+ mp->find_file = opt->find_file ? opt->find_file : mp_find_file ;
+ mp->open_file = opt->open_file ? opt->open_file : mp_open_file ;
+ mp->read_file = opt->read_file ? opt->read_file : mp_read_file ;
+ mp->close_file = opt->close_file ? opt->close_file : mp_close_file ;
+ mp->write_file = opt->write_file ? opt->write_file : mp_write_file ;
+ mp->shipout_backend = opt->shipout_backend ? opt->shipout_backend : mp_shipout_backend;
+ mp->run_script = opt->run_script ? opt->run_script : mp_run_script ;
+ mp->run_internal = opt->run_internal ? opt->run_internal : mp_run_internal ;
+ mp->run_logger = opt->run_logger ? opt->run_logger : mp_run_logger ;
+ mp->run_overload = opt->run_overload ? opt->run_overload : mp_run_overload ;
+ mp->run_error = opt->run_error ? opt->run_error : mp_run_error ;
+ mp->run_warning = opt->run_warning ? opt->run_warning : mp_run_warning ;
+ mp->make_text = opt->make_text ? opt->make_text : mp_make_text ;
+
+ mp->find_file_id = opt->find_file_id;
+ mp->run_script_id = opt->run_script_id;
+ mp->run_internal_id = opt->run_internal_id;
+ mp->run_logger_id = opt->run_logger_id;
+ mp->run_overload_id = opt->run_overload_id;
+ mp->run_error_id = opt->run_error_id;
+ mp->run_warning_id = opt->run_warning_id;
+ mp->make_text_id = opt->make_text_id;
+ mp->open_file_id = opt->open_file_id;
+
+ if (opt->banner && *(opt->banner)) {
+ mp->banner = mp_strdup(opt->banner);
+ } else {
+ mp->banner = mp_strdup(default_banner);
+ }
+ switch (opt->math_mode) {
+ case mp_math_scaled_mode:
+ mp->math = mp_initialize_scaled_math(mp);
+ break;
+ case mp_math_decimal_mode:
+ mp->math = mp_initialize_decimal_math(mp);
+ break;
+ case mp_math_binary_mode:
+ mp->math = mp_initialize_binary_math(mp);
+ break;
+ default:
+ mp->math = mp_initialize_double_math(mp);
+ break;
+ }
+ @<Allocate or initialize variables@>
+ mp_reallocate_paths(mp, 1000);
+ /* in case we quit during initialization: */
+ mp->history = mp_fatal_error_stop;
+ mp_do_initialize(mp);
+ /* initialize the tables */
+ mp_init_tab(mp);
+ switch (opt->math_mode) {
+ case mp_math_scaled_mode:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "scaled"));
+ break;
+ case mp_math_decimal_mode:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "decimal"));
+ break;
+ case mp_math_binary_mode:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "binary"));
+ break;
+ default:
+ set_internal_string(mp_number_system_internal, mp_intern(mp, "double"));
+ break;
+ }
+ /* call |primitive| for each primitive */
+ mp_init_prim(mp);
+ mp_fix_date_and_time(mp);
+ mp->history = mp_spotless;
+ set_precision();
+ @<Fix up |job_name|@>
+ return mp;
+}
+
+@ @<Exported function headers@>=
+extern MP_options *mp_options (void);
+extern MP mp_initialize (MP_options * opt);
+extern int mp_status (MP mp);
+extern int mp_finished (MP mp);
+extern void *mp_userdata (MP mp);
+
+@ @c
+int mp_status (MP mp) { return mp->history; }
+int mp_finished (MP mp) { return mp->finished; }
+void *mp_userdata (MP mp) { return mp->userdata; }
+
+@ The overall \MP\ program begins with the heading just shown, after which comes
+a bunch of procedure declarations and function declarations. Finally we will get
+to the main program, which begins with the comment |start_here|. If you want to
+skip down to the main program now, you can look up |start_here| in the index. But
+the author suggests that the best way to understand this program is to follow
+pretty much the order of \MP's components as they appear in the \CWEB\
+description you are now reading, since the present ordering is intended to
+combine the advantages of the \quote {bottom up} and \quote {top down} approaches
+to the problem of understanding a somewhat complicated system.
+
+@ The following parameters can be changed at compile time to extend or reduce
+\MP's capacity. @^system dependencies@>
+
+@<Constants...@>=
+# define bistack_size 1500 /* size of stack for bisection algorithms; should
+ probably be left at this value */
+
+@ Like the preceding parameters, the following quantities can be changed to
+extend or reduce \MP's capacity.
+
+@ @<Glob...@>=
+int max_in_open; /* maximum number of input files and error insertions that can
+ be going on simultaneously */
+int param_size; /* maximum number of simultaneous macro parameters */
+int padding_size; /* so that the next array nicely sits in the cache */
+
+@ @<Option variables@>=
+int halt_on_error; /* do we quit at the first error? */
+void *userdata; /* this allows the calling application to setup local (e.g. L for Lua) */
+char *banner; /* the banner that is printed to the screen and log */
+int utf8_mode;
+int text_mode;
+int show_mode;
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->banner);
+
+@ @<Allocate or ...@>=
+mp->param_size = 4;
+mp->max_in_open = 0;
+mp->halt_on_error = opt->halt_on_error ? 1 : 0;
+mp->utf8_mode = opt->utf8_mode ? 1 : 0;
+mp->text_mode = opt->text_mode ? 1 : 0;
+mp->show_mode = opt->show_mode ? 1 : 0;
+
+@ Here are some macros for common programming idioms (incr and decr are now
+inlined).
+
+@d odd(A) (abs(A) % 2 == 1) /* replaced by proper number_odd calls, tex has: ((x) & 1) */
+
+@* The character set.
+
+@ We assume proper ASCII codes to be used and likely UTF-8 so we dropped the two
+way mapping from input to internal and from internal to to output (actually that
+mapping was not that robust because some strings bypassed the conversions).
+
+@* Input and output.
+
+The bane of portability is the fact that different operating systems treat input
+and output quite differently, perhaps because computer scientists have not given
+sufficient attention to this problem. People have felt somehow that input and
+output are not part of \quote {real} programming. Well, it is true that some kinds of
+programming are more fun than others. With existing input/output conventions
+being so diverse and so messy, the only sources of joy in such parts of the code
+are the rare occasions when one can find a way to make the program a little less
+bad than it might have been. We have two choices, either to attack I/O now and
+get it over with, or to postpone I/O until near the end. Neither prospect is very
+attractive, so let's get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of text, to
+or from a file or the user's terminal; (2)~inputting and outputting of eight-bit
+bytes, to or from a file; (3)~instructing the operating system to initiate \quote
+{open} or to terminate \quote {close} input or output from a specified file;
+(4)~testing whether the end of an input file has been reached; (5)~display of
+bits on the user's screen. The bit-display operation will be discussed in a later
+section; we shall deal here only with more traditional kinds of I/O.
+
+@ Finding files happens in a slightly roundabout fashion: the \MP\ instance
+object contains a field that holds a function pointer that finds a file, and
+returns its name, or NULL. For this, it receives three parameters: the
+non-qualified name |fname|, the intended |fopen| operation type |fmode|, and the
+type of the file |ftype|.
+
+The file types that are passed on in |ftype| can be used to differentiate file
+searches if a library like kpathsea is used, the fopen mode is passed along for
+the same reason.
+
+@ @<Exported types@>=
+enum mp_filetype {
+ mp_filetype_terminal, /* the terminal (input) */
+ mp_filetype_program, /* \MP\ language input */
+ mp_filetype_text /* first text file for readfrom and writeto primitives */
+};
+
+typedef char *(*mp_file_finder) (MP, const char *, const char *, int);
+typedef char *(*mp_script_runner) (MP, const char *m, size_t len, int n);
+typedef void (*mp_internal_runner) (MP, int action, int n, int type, const char *iname);
+typedef void (*mp_log_runner) (MP, int, const char *s, size_t l);
+typedef int (*mp_overload_runner) (MP, int, const char *, int);
+typedef void (*mp_error_runner) (MP, const char *, const char *, int);
+typedef void (*mp_warning_runner) (MP, const char *);
+typedef char *(*mp_text_maker) (MP, const char *, size_t, int);
+typedef void *(*mp_file_opener) (MP, const char *, const char *, int);
+typedef char *(*mp_file_reader) (MP, void *, size_t *);
+typedef void (*mp_file_closer) (MP, void *);
+typedef int (*mp_file_eoftest) (MP, void *);
+typedef void (*mp_file_flush) (MP, void *);
+typedef void (*mp_file_writer) (MP, void *, const char *);
+
+@ @<Option variables@>=
+mp_file_finder find_file;
+mp_script_runner run_script;
+mp_internal_runner run_internal;
+mp_log_runner run_logger;
+mp_overload_runner run_overload;
+mp_error_runner run_error;
+mp_warning_runner run_warning;
+mp_text_maker make_text;
+mp_file_opener open_file;
+mp_file_closer close_file;
+mp_file_reader read_file;
+mp_file_writer write_file;
+
+int find_file_id;
+int run_script_id;
+int run_internal_id;
+int run_logger_id;
+int run_overload_id;
+int run_error_id;
+int run_warning_id;
+int make_text_id;
+int open_file_id;
+
+@ The default function for finding files is |mp_find_file|. It is pretty stupid:
+it will only find files in the current directory.
+
+@c
+static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype)
+{
+ (void) mp; (void) fname; (void) fmode; (void) ftype;
+ mp_fatal_error(mp, "no 'find_file' callback set");
+ return NULL;
+}
+
+static char *mp_run_script (MP mp, const char *str, size_t len, int n)
+{
+ (void) mp; (void) str; (void) len; (void) n;
+ mp_fatal_error(mp, "no 'run_script' callback set");
+ return NULL;
+}
+
+void mp_run_internal (MP mp, int action, int n, int type, const char *iname)
+{
+ (void) mp; (void) action; (void) n; (void) type; (void) iname;
+ mp_fatal_error(mp, "no 'run_internal' callback set");
+}
+
+@ The logger has to deal with the console and the log file and gets information
+about the target.
+
+@c
+static void mp_run_logger (MP mp, int target, const char *s, size_t l)
+{
+ (void) mp; (void) target; (void) s; (void) l;
+ mp_fatal_error(mp, "no 'run_logger' callback set");
+}
+
+
+@ The overload catch is responsible for its own reporting and quitting
+if needed. The check only happens when the mode is set.
+
+@c
+static int mp_run_overload (MP mp, int property, const char *str, int mode)
+{
+ (void) mp; (void) property; (void) str; (void) mode;
+ mp_fatal_error(mp, "no 'run_overload' callback set");
+ return 0;
+}
+
+static void mp_check_overload (MP mp, mp_sym p)
+{
+ /* not the fastest check */
+ if (number_nonzero(internal_value(mp_overloadmode_internal))) {
+ if (mp->run_overload(mp, p->property, (const char *) p->text->str, number_to_int(internal_value(mp_overloadmode_internal)))) {
+ p->property = 0;
+ } else {
+ /* we keep the property */
+ }
+ } else {
+ /* we reset the mode */
+ p->property = 0;
+ }
+}
+
+@ Error and warning handling can be delegated too. Warnings are not really used yet
+but they might show up some day.
+
+@c
+static void mp_run_error (MP mp, const char *msg, const char *hlp, int interaction)
+{
+ (void) mp; (void) msg; (void) hlp; (void) interaction;
+ mp_fatal_error(mp, "no 'run_error' callback set");
+}
+
+static void mp_run_warning (MP mp, const char *msg)
+{
+ (void) mp; (void) msg;
+ mp_fatal_error(mp, "no 'run_warning' callback set");
+}
+
+@ The |btex ... etex| handling is still present and depends on a callback and
+some cooperation with the backend. In \CONTEXT\ we implements text objects as
+paths with properties (pre- and postscripts).
+
+@c
+static char *mp_make_text (MP mp, const char *str, size_t len, int mode)
+{
+ (void) mp; (void) mode; (void) str; (void) len;
+ mp_fatal_error(mp, "no 'make_text' callback set");
+ return NULL;
+}
+
+@ Watch out: at this moment we have |mp_find_file| as well as |open_file| and
+both need to be set.
+
+@<Declarations@>=
+static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype);
+static void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype);
+static char *mp_read_file (MP mp, void *f, size_t * size);
+static void mp_close_file (MP mp, void *f);
+static void mp_write_file (MP mp, void *f, const char *s);
+static char *mp_run_script (MP mp, const char *str, size_t len, int n);
+static void mp_run_internal (MP mp, int action, int n, int type, const char *iname);
+static void mp_run_logger (MP mp, int target, const char *s, size_t l);
+static int mp_run_overload (MP mp, int property, const char *, int);
+static void mp_run_error (MP mp, const char *, const char *, int);
+static void mp_run_warning (MP mp, const char *);
+static char *mp_make_text (MP mp, const char *str, size_t len, int mode);
+
+@ As with the other callbacks, once they are needed and not set an error is
+triggered. It made no sense to keep not used code around.
+
+@c
+static void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype)
+{
+ (void) mp; (void) fname; (void) fmode; (void) ftype;
+ mp_fatal_error(mp, "no 'open_file' callback set");
+ return NULL;
+}
+
+@ (Almost) all file names pass through |name_of_file|.
+
+@<Glob...@>=
+char *name_of_file; /* the name of a system file */
+
+@ If this parameter is true, the terminal and log will report the found file
+names for input files instead of the requested ones. It is off by default because
+it creates an extra filename lookup.
+
+@ \MP's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+The |do_open_file| function takes care of the |print_found_names| parameter. The
+file helpers are mandate callbacks. Not setting them triggers an error.
+
+@c
+static int mp_do_open_file (MP mp, void **f, int ftype, const char *mode)
+{
+ /*
+ For now we keep the two step find and open approach because we get back
+ the full (found) name but all logic is at the \LUA\ end. Maybe some day
+ we need the original name.
+ */
+ char *s = (mp->find_file)(mp, mp->name_of_file, mode, ftype);
+ if (s != NULL) {
+ mp_memory_free(mp->name_of_file);
+ mp->name_of_file = mp_strdup(s);
+ // lmt_generic_free(s);
+ lmt_memory_free(s);
+ *f = (mp->open_file)(mp, mp->name_of_file, mode, ftype);
+ } else {
+ *f = NULL;
+ }
+ return (*f ? 1 : 0);
+}
+
+static int mp_open_in (MP mp, void **f, int ftype)
+{
+ return mp_do_open_file(mp, f, ftype, "r");
+}
+
+static int mp_open_out (MP mp, void **f, int ftype)
+{
+ return mp_do_open_file(mp, f, ftype, "w");
+}
+
+static char *mp_read_file (MP mp, void *f, size_t *size)
+{
+ (void) mp; (void) f; (void) size;
+ mp_fatal_error(mp, "no 'read_file' callback set");
+ return NULL;
+}
+
+static void mp_write_file (MP mp, void *f, const char *s)
+{
+ (void) mp; (void) f; (void) s;
+ mp_fatal_error(mp, "no 'read_file' callback set");
+}
+
+static void mp_close_file (MP mp, void *f)
+{
+ (void) mp; (void) f;
+ mp_fatal_error(mp, "no 'close_file' callback set");
+}
+
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for now, it
+suffices for us to know that |buffer| is an array of |unsigned char| values, and
+that |first| and |last| are indices into this array representing the beginning
+and ending of a line of text.
+
+@<Glob...@>=
+size_t buf_size; /* maximum number of characters simultaneously present in current lines of open files */
+unsigned char *buffer; /* lines of characters being read */
+size_t first; /* the first unused position in |buffer| */
+size_t last; /* end of the line just input to |buffer| */
+size_t max_buf_stack; /* largest index used in |buffer| */
+
+@ @<Allocate or initialize ...@>=
+mp->buf_size = 200;
+mp->buffer = mp_memory_allocate((size_t) (mp->buf_size + 1) * sizeof(unsigned char));
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->buffer);
+
+@ @c
+static void mp_reallocate_buffer (MP mp, size_t l)
+{
+ if (l > max_halfword) {
+ mp_confusion(mp, "buffer size"); /* can't happen (I hope) */
+ } else {
+ unsigned char *buffer = mp_memory_allocate((size_t) (l + 1) * sizeof(unsigned char));
+ memcpy(buffer, mp->buffer, (mp->buf_size + 1));
+ mp_memory_free(mp->buffer);
+ mp->buffer = buffer;
+ mp->buf_size = l;
+ }
+}
+
+@ The |input_ln| function brings the next line of input from the specified field
+into available positions of the buffer array and returns the value |true|, unless
+the file has already been entirely read, in which case it returns |false| and
+sets |last := first|. In general, the |unsigned char| numbers that represent the
+next line of the file are input into |buffer [first]|, |buffer [first + 1]|,
+\dots, |buffer [last - 1]|; and the global variable |last| is set equal to
+|first| plus the length of the line. Trailing blanks are removed from the line;
+thus, either |last = first| (in which case the line was entirely blank) or
+|buffer [last - 1] <>" "|. @^inner loop@>
+
+The variable |max_buf_stack|, which is used to keep track of how large the
+|buf_size| parameter must be to accommodate the present job, is also kept up to
+date by |input_ln|.
+
+@c
+static int mp_input_ln (MP mp, void *f)
+{
+ /* inputs the next line or returns |false| */
+ char *s;
+ size_t size = 0;
+ mp->last = mp->first; /* cf.\ Matthew 19\thinspace:\thinspace30 */
+ s = (mp->read_file)(mp, f, &size);
+ if (s == NULL) {
+ return 0;
+ } else if (size > 0) {
+ mp->last = mp->first + size;
+ if (mp->last >= mp->max_buf_stack) {
+ mp->max_buf_stack = mp->last + 1;
+ while (mp->max_buf_stack > mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size >> 2)));
+ }
+ }
+ memcpy((mp->buffer + mp->first), s, size);
+ }
+ // lmt_generic_free(s);
+ lmt_memory_free(s);
+ return 1;
+}
+
+@ The user's terminal acts essentially like other files of text, except that it
+is used both for input and for output. When the terminal is considered an input
+file, the file variable is called |term_in|, and when it is considered an output
+file the file variable is |term_out|. @^system dependencies@>
+
+@<Glob...@>=
+void *term_in; /* the terminal as an input file */
+
+@ Sometimes it is necessary to synchronize the input/output mixture that happens
+on the user's terminal, and three system-dependent procedures are used for this
+purpose. The first of these, |update_terminal|, is called when we want to make
+sure that everything we have output to the terminal so far has actually left the
+computer's internal buffers and been sent. The second, |clear_terminal|, is
+called when we wish to cancel any input that the user may have typed ahead (since
+we are about to issue an unexpected error message). The third,
+|wake_up_terminal|, is supposed to revive the terminal if the user has disabled
+it by some instruction to the operating system. The following macros show how
+these operations can be specified: @^system dependencies@>
+
+@<MPlib internal header stuff@>=
+# define update_terminal() mp_print_nl_only(mp); /* empty the terminal output buffer */
+# define clear_terminal() /* clear the terminal input buffer */
+# define wake_up_terminal() mp_print_nl_only(mp); /* cancel the user's cancellation of output */
+
+@ The global variable |loc| should be set so that the character to be read next
+by \MP\ is in |buffer [loc]|. This character should not be blank, and we should
+have |loc < last|.
+
+@d loc mp->cur_input.loc_field /* location of first unread character in |buffer| */
+
+@* Globals for strings.
+
+@ Symbolic token names and diagnostic messages are variable-length strings of
+eight-bit characters. Many strings \MP\ uses are simply literals in the compiled
+source, like the error messages and the names of the internal parameters. Other
+strings are used or defined from the \MP\ input language, and these have to be
+interned.
+
+\MP\ uses strings more extensively than \MF\ does, but the necessary operations
+can still be handled with a fairly simple data structure. The avl tree |strings|
+contains all of the known string structures.
+
+Each structure contains an |unsigned char| pointer containing the eight-bit data,
+a |size_t| that holds the length of that data, and an |int| that indicates how
+often this string is referenced (this will be explained below). Such strings are
+referred to by structure pointers called |mp_string|.
+
+Besides the avl tree, there is a set of three variables called |cur_string|,
+|cur_length| and |cur_string_size| that are used for strings while they are being
+built.
+
+@<Exported types...@>=
+typedef struct mp_lstring {
+ unsigned char *str; /* the string value */
+ size_t len; /* its length */
+ int refs; /* number of references */
+} mp_lstring;
+
+typedef mp_lstring *mp_string; /* for pointers to string values */
+
+@ The string handling functions are in |mpstrings.w|, but strings need a bunch
+of globals and those are defined here in the main file.
+
+@<Glob...@>=
+avl_tree strings; /* string avl tree */
+unsigned char *cur_string; /* current string buffer */
+size_t cur_length; /* current index in that buffer */
+size_t cur_string_size; /* malloced size of |cur_string| */
+
+@ @<Allocate or initialize ...@>=
+mp_initialize_strings(mp);
+
+@ @<Dealloc variables@>=
+mp_dealloc_strings(mp);
+
+@ The next four variables are for keeping track of string memory usage.
+
+@<Glob...@>=
+int pool_in_use; /* total number of string bytes actually in use */
+int max_pl_used; /* maximum |pool_in_use| so far */
+int strs_in_use; /* total number of strings actually in use */
+int max_strs_used; /* maximum |strs_in_use| so far */
+
+@* On-line and off-line printing.
+
+Messages that are sent to a user's terminal and to the transcript-log file are
+produced by several |print| procedures. These procedures will direct their
+output to a variety of places, based on the setting of the global variable
+|selector|, which has the following possible values:
+
+\yskip
+
+\hang |term_and_log|, the normal setting, prints on the terminal and on the
+transcript file.
+
+\hang |log_only|, prints only on the transcript file.
+
+\hang |term_only|, prints only on the terminal.
+
+\hang |no_print|, doesn't print at all. This is used only in rare cases before
+the transcript file is open.
+
+\hang |pseudo|, puts output into a cyclic buffer that is used by the
+|show_context| routine; when we get to that routine we shall discuss the
+reasoning behind this curious mode.
+
+\hang |new_string|, appends the output to the current string in the string pool.
+
+\hang |>= first_file| prints on one of the files used for the |write|
+@:write_}{|write| primitive@> command.
+
+\yskip
+
+\noindent The symbolic names |term_and_log|, etc., have been assigned numeric
+codes that satisfy the convenient relations |no_print + 1 = term_only|, |no_print
++ 2 = log_only|, |term_only + 2 = log_only + 1 = term_and_log|. These relations
+are not used when |selector| could be |pseudo|, or |new_string|. We need not
+check for unprintable characters when |selector < pseudo|. We no longer use that
+magic and just test the constants.
+
+Two additional global variables, |term_offset| and |file_offset| record if
+characters have been printed since they were most recently cleared. We use
+|term_offset|, and |file_offset|, on the other hand, keep track of how many
+characters have appeared so far on the current line that has been output to the
+terminal, the transcript file, or piped into \LUA.
+
+@<MPlib internal header stuff@>=
+typedef enum mp_selectors {
+ mp_new_string_selector, /* printing is deflected to the string pool */
+ mp_no_print_selector, /* |selector| setting that makes data disappear */
+ mp_term_only_selector, /* printing is destined for the terminal only */
+ mp_log_only_selector, /* printing is destined for the transcript file only */
+ mp_term_and_log_selector, /* normal |selector| setting */
+ mp_first_file_selector, /* first write file selector */
+} mp_selectors;
+
+typedef enum mp_logging_targets {
+ mp_void_logging_target,
+ mp_term_logging_target,
+ mp_file_logging_target,
+ mp_both_logging_target,
+ mp_error_logging_target,
+} mp_logging_targets;
+
+@ @<Glob...@>=
+unsigned int selector; /* where to print a message */
+unsigned int term_offset; /* the number of characters on the current terminal line */
+unsigned int file_offset; /* the number of characters on the current file line */
+
+@ @<Initialize the output routines@>=
+mp->term_offset = 0;
+mp->file_offset = 0;
+
+@ Macro abbreviations for output to the terminal and to the log file are defined
+here for convenience. Some systems need special conventions for terminal output,
+and it is possible to adhere to those conventions by changing |wterm|,
+|wterm_ln|, and |wterm_cr| here. @^system dependencies@>
+
+@<MPlib internal header stuff@>=
+# define mp_fputs(b,f) (mp->write_file)(mp, f, b)
+
+# define mp_log_string(target,s) (mp->run_logger)(mp, target, s, strlen(s))
+# define mp_log_mpstr(target,s,l) (mp->run_logger)(mp, target, s, l)
+# define mp_log_cr(target) (mp->run_logger)(mp, target, "\n", 1)
+# define mp_log_chr(target,s) { unsigned char ss[2] = { s, 0 }; (mp->run_logger)(mp, target, (const char *) ss, 1); }
+# define mp_log_error(s) (mp->run_logger)(mp, mp_error_logging_target, s, strlen(s))
+
+@ To end a line of text output, we call |print_ln|. Cases |0..max_write_files|
+use an array |wr_file| that will be declared later.
+
+The names of the print functions are more or less in sync with the ones used
+in the \LUAMETATEX\ source code.
+
+@<Declarations@>=
+static void mp_print_str (MP mp, const char *s);
+static void mp_print_nl (MP mp, const char *s);
+static void mp_print_fmt (MP mp, const char *s, ...);
+static void mp_print_ln (MP mp);
+static void mp_print_chr (MP mp, unsigned char k);
+static void mp_print_mp_str (MP mp, mp_string s);
+static void mp_print_nl (MP mp, const char *s);
+static void mp_print_two (MP mp, mp_number *x, mp_number *y);
+
+@ @<Exported function headers@>=
+extern void mp_print_e_str (MP mp, const char *s);
+extern void mp_print_e_chr (MP mp, unsigned char k);
+
+@ @c
+static void mp_print_ln (MP mp)
+{
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ mp_log_cr(mp_both_logging_target);
+ mp->term_offset = 0;
+ mp->file_offset = 0;
+ break;
+ case mp_log_only_selector:
+ mp_log_cr(mp_file_logging_target);
+ mp->file_offset = 0;
+ break;
+ case mp_term_only_selector:
+ mp_log_cr(mp_term_logging_target);
+ mp->term_offset = 0;
+ break;
+ case mp_no_print_selector:
+ case mp_new_string_selector:
+ break;
+ default:
+ mp_fputs("\n", mp->wr_file[mp->selector - mp_first_file_selector]);
+ }
+}
+
+@ The |print_char| procedure sends one character to the desired destination. All
+printing comes through |print_ln| or |print_char|, hence these routines are the
+ones that limit lines to at most |max_print_line| characters. But we must make an
+exception for the \POSTSCRIPT\ output file since it is not safe to cut up lines
+arbitrarily in \POSTSCRIPT. Anyway, we don't have a backend other than \LUA\ so
+we just flush all without checking, so the nicely cleaned up offset code is
+now gone too (just a boolean) so we lost |max_print_line|, |error_line| etc.
+
+@c
+static void mp_print_chr (MP mp, unsigned char s)
+{
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ mp_log_chr(mp_both_logging_target, s);
+ mp->term_offset = 1;
+ mp->file_offset = 1;
+ break;
+ case mp_log_only_selector:
+ mp_log_chr(mp_file_logging_target, s);
+ mp->file_offset = 1;
+ break;
+ case mp_term_only_selector:
+ mp_log_chr(mp_term_logging_target, s);
+ mp->term_offset = 1;
+ break;
+ case mp_no_print_selector:
+ break;
+ case mp_new_string_selector:
+ mp_str_room(mp, 1);
+ mp_append_char(mp, s);
+ break;
+ default:
+ {
+ unsigned char ss[2] = { s, 0 };
+ mp_fputs((char *) ss, mp->wr_file[mp->selector - mp_first_file_selector]);
+ }
+ }
+}
+
+void mp_print_e_chr (MP mp, unsigned char s)
+{
+ mp_print_chr(mp, s);
+}
+
+static void mp_do_print (MP mp, const char *s, size_t len)
+{
+ if (len == 0) {
+ return;
+ } else if (mp->selector == mp_new_string_selector) {
+ mp_str_room(mp, (int) len);
+ memcpy((mp->cur_string + mp->cur_length), s, len);
+ mp->cur_length += len;
+ } else {
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ mp_log_mpstr(mp_both_logging_target, s, (int) len);
+ mp->term_offset = 1;
+ mp->file_offset = 1;
+ break;
+ case mp_log_only_selector:
+ mp_log_mpstr(mp_file_logging_target, s, (int) len);
+ mp->file_offset = 1;
+ break;
+ case mp_term_only_selector:
+ mp_log_mpstr(mp_term_logging_target, s, (int) len);
+ mp->term_offset = 1;
+ break;
+ case mp_no_print_selector:
+ break;
+ case mp_new_string_selector:
+ mp_str_room(mp, (int) len);
+ mp_append_str(mp, s);
+ break;
+ default:
+ mp_fputs(s, mp->wr_file[mp->selector - mp_first_file_selector]);
+ break;
+ }
+ }
+}
+
+static void mp_print_str (MP mp, const char *s)
+{
+ mp_do_print(mp, s, strlen(s));
+}
+
+void mp_print_e_str (MP mp, const char *s)
+{
+ mp_print_str(mp,s);
+}
+
+static void mp_print_fmt (MP mp, const char *s, ...)
+{
+ va_list ap;
+ char pval[256];
+ va_start(ap, s);
+ vsnprintf(pval, 256, s, ap);
+ mp_do_print(mp, pval, strlen(pval));
+ va_end(ap);
+}
+
+static void mp_print_mp_str (MP mp, mp_string s)
+{
+ mp_do_print(mp, (const char *) s->str, s->len);
+}
+
+@ Here is the very first thing that \MP\ prints: a headline that identifies the
+version number and base name.
+
+@<Initialize the output...@>=
+mp_log_string(mp_term_logging_target, mp->banner);
+mp_log_string(mp_term_logging_target, ", running in ");
+mp_log_string(mp_term_logging_target, mp_str(mp, internal_string(mp_number_system_internal)));
+mp_log_string(mp_term_logging_target, " mode.");
+mp_print_ln(mp);
+update_terminal();
+
+@ @<Declarations@>=
+static void mp_print_nl_only (MP mp);
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the string
+appears at the beginning of a new line.
+
+@c
+static void mp_print_nl_only (MP mp)
+{
+ switch (mp->selector) {
+ case mp_term_and_log_selector:
+ if (mp->file_offset > 0) {
+ mp_log_cr(mp_file_logging_target);
+ mp->file_offset = 0;
+ }
+ if (mp->term_offset > 0) {
+ mp_log_cr(mp_term_logging_target);
+ mp->term_offset = 0;
+ }
+ break;
+ case mp_log_only_selector:
+ if (mp->file_offset > 0) {
+ mp_log_cr(mp_file_logging_target);
+ mp->file_offset = 0;
+ }
+ break;
+ case mp_term_only_selector:
+ if (mp->term_offset > 0) {
+ mp_log_cr(mp_term_logging_target);
+ mp->term_offset = 0;
+ }
+ break;
+ case mp_no_print_selector:
+ case mp_new_string_selector:
+ break;
+ }
+}
+
+static void mp_print_nl (MP mp, const char *s)
+{
+ mp_print_nl_only(mp);
+ mp_print_str(mp, s);
+}
+
+@ The following procedure, which prints out the decimal representation of a given
+integer |n|, assumes that all integers fit nicely into a |int|. @^system
+dependencies@>
+
+@c
+static void mp_print_int (MP mp, int n)
+{
+ char s[12];
+ mp_snprintf(s, 12, "%d", (int) n);
+ mp_print_str(mp, s);
+}
+
+@ @<Declarations@>=
+static void mp_print_int (MP mp, int n);
+
+@* Reporting errors.
+
+@ The global variable |interaction| has four settings, representing increasing
+amounts of user interaction:
+
+@<Exported types@>=
+enum mp_interaction_mode {
+ mp_unspecified_mode, /* extra value for command-line switch */
+ mp_batch_mode, /* omits all stops and omits terminal output */
+ mp_nonstop_mode, /* omits all stops */
+ mp_scroll_mode, /* omits error stops */
+ mp_error_stop_mode, /* stops at every opportunity to interact */
+ mp_silent_mode /* stops at every opportunity to interact but not always*/
+};
+
+@ @<Option variables@>=
+int interaction; /* current level of interaction */
+int extensions;
+
+@ Set it here so it can be overwritten by the commandline
+
+@<Allocate or initialize ...@>=
+mp->interaction = opt->interaction;
+if (mp->interaction == mp_unspecified_mode || mp->interaction > mp_silent_mode) {
+ mp->interaction = mp_error_stop_mode;
+}
+if (mp->interaction < mp_unspecified_mode) {
+ mp->interaction = mp_batch_mode;
+}
+
+@ \MP\ is careful not to call |error| when the print |selector| setting might be
+unusual. The only possible values of |selector| at the time of error messages are
+
+\yskip
+
+\hang|no_print| (when |interaction=mp_batch_mode| and |log_file| not yet open);
+
+\hang|term_only| (when |interaction>mp_batch_mode| and |log_file| not yet open);
+
+\hang|log_only| (when |interaction=mp_batch_mode| and |log_file| is open);
+
+\hang|term_and_log| (when |interaction>mp_batch_mode| and |log_file| is open).
+
+@ The global variable |history| records the worst level of error that has been
+detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+
+Another global variable, |error_count|, is increased by one when an |error|
+occurs without an interactive dialog, and it is reset to zero at the end of every
+statement. If |error_count| reaches 100, \MP\ decides that there is no point in
+continuing further.
+
+@<Exported types@>=
+enum mp_history_state {
+ mp_spotless, /* |history| value when nothing has been amiss yet */
+ mp_warning_issued, /* |history| value when |begin_diagnostic| has been called */
+ mp_error_message_issued, /* |history| value when |error| has been called */
+ mp_fatal_error_stop, /* |history| value when termination was premature */
+ mp_system_error_stop /* |history| value when termination was due to disaster */
+};
+
+@ @<Glob...@>=
+int history; /* has the source input been clean so far? */
+int error_count; /* the number of scrolled errors since the last statement ended */
+
+@ The value of |history| is initially |fatal_error_stop|, but it will be changed
+to |spotless| if \MP\ survives the initialization process.
+
+@ Since errors can be detected almost anywhere in \MP, we want to declare the
+error procedures near the beginning of the program. But the error procedures in
+turn use some other procedures, which need to be declared |forward| before we get
+to |error| itself.
+
+It is possible for |error| to be called recursively if some error arises when
+|get_next| is being used to delete a token, and/or if some fatal error occurs
+while \MP\ is trying to fix a non-fatal one. But such recursion @^recursion@> is
+never more than two levels deep.
+
+@<Declarations@>=
+static void mp_get_next (MP mp);
+static void mp_begin_file_reading (MP mp);
+
+@ @<Exported function ...@>=
+extern void mp_show_context (MP mp);
+
+@ @<Internal ...@>=
+void mp_normalize_selector (MP mp);
+
+@ @<Glob...@>=
+int use_err_help; /* should the |err_help| string be shown? */
+int padding_help; /* well ... why not. */
+mp_string err_help; /* a string set up by |errhelp| */
+
+@ @<Allocate or ...@>=
+mp->use_err_help = 0;
+
+@ The |jump_out| procedure just cuts across all active procedure levels and goes
+to |end_of_MP|. This is the only nonlocal |goto| statement in the whole program.
+It is used when there is no recovery from a particular error.
+
+The program uses a |jump_buf| to handle this, this is initialized at three spots:
+the start of |mp_new|, the start of |mp_initialize|, and the start of |mp_run|.
+Those are the only library entry points. @^system dependencies@>
+
+@<Glob...@>=
+jmp_buf *jump_buf;
+
+@ If the array of internals is still |NULL| when |jump_out| is called, a crash
+occured during initialization, and it is not safe to run the normal cleanup
+routine.
+
+@<Error hand...@>=
+void mp_jump_out (MP mp)
+{
+ if (mp->internal != NULL && mp->history < mp_system_error_stop) {
+ mp_close_files_and_terminate(mp);
+ }
+ longjmp(*(mp->jump_buf), 1);
+}
+
+@ @<Internal ...@>=
+void mp_jump_out (MP mp);
+
+@ @<Error hand...@>=
+void mp_warn (MP mp, const char *msg)
+{
+ int selector = mp->selector;
+ mp_normalize_selector(mp);
+ mp_print_nl(mp, "Warning: ");
+ mp_print_str(mp, msg);
+ mp_print_ln(mp);
+ mp->selector = selector;
+}
+
+@ Here now is the general |error| routine.
+
+Individual lines of help are recorded in the array |help_line|, which contains
+entries in positions |0 .. (help_ptr - 1)|. They should be printed in reverse
+order, i.e., with |help_line [0]| appearing last.
+
+@c
+void mp_error (MP mp, const char *msg, const char *hlp)
+{
+ int selector = mp->selector;
+ mp_normalize_selector(mp);
+ mp->run_error(mp, msg, hlp, mp->interaction);
+ if (mp->history < mp_error_message_issued) {
+ mp->history = mp_error_message_issued;
+ }
+ if (mp->halt_on_error) {
+ mp->history = mp_fatal_error_stop;
+ mp_jump_out(mp);
+ }
+ ++mp->error_count;
+ if (mp->error_count == 100) {
+ mp_print_nl(mp, "(That makes 100 errors; please try again.)");
+ @.That makes 100 errors...@>
+ mp->history = mp_fatal_error_stop;
+ mp_jump_out(mp);
+ }
+ mp->selector = selector;
+}
+
+@ @<Exported function ...@>=
+extern void mp_error (MP mp, const char *msg, const char *hlp);
+extern void mp_warn (MP mp, const char *msg);
+
+@ In anomalous cases, the print selector might be in an unknown state; the
+following subroutine is called to fix things just enough to keep running a bit
+longer.
+
+@c
+void mp_normalize_selector (MP mp)
+{
+ mp->selector = mp->interaction == mp_batch_mode ? mp_log_only_selector : mp_term_and_log_selector;
+}
+
+@ The following procedure prints \MP's last words before dying.
+
+@<Error hand...@>=
+void mp_fatal_error (MP mp, const char *s)
+{
+ /* prints |s|, and that's it */
+ mp_normalize_selector(mp);
+ if (mp->interaction == mp_error_stop_mode) {
+ /* no more interaction */
+ mp->interaction = mp_scroll_mode;
+ }
+ mp_error(mp, "Emergency stop", s);
+ mp->history = mp_fatal_error_stop;
+ /* irrecoverable error */
+ mp_jump_out(mp);
+@.Emergency stop@>
+}
+
+@ @<Exported function ...@>=
+extern void mp_fatal_error (MP mp, const char *s);
+
+@ The program might sometime run completely amok, at which point there is no
+choice but to stop. If no previous error has been detected, that's bad news; a
+message is printed that is really intended for the \MP\ maintenance person
+instead of the user (unless the user has been particularly diabolical). The index
+entries for \quote {this can't happen} may help to pinpoint the problem. @^dry
+rot@>
+
+@<Internal library ...@>=
+void mp_confusion (MP mp, const char *s);
+
+@ Consistency check violated; |s| tells where.
+
+@<Error hand...@>=
+void mp_confusion (MP mp, const char *s)
+{
+ char msg[256];
+ const char *hlp = NULL;
+ mp_normalize_selector(mp);
+ if (mp->history < mp_error_message_issued) {
+ mp_snprintf(msg, 256, "This can't happen (%s)", s);
+ hlp =
+ "I'm broken. Please show this to someone who can fix can fix it and try\n"
+ "again";
+ @.This can't happen@>
+ } else {
+ hlp =
+ "One of your faux pas seems to have wounded me deeply ... in fact, I'm barely\n"
+ "conscious. Please fix it and try again.";
+ mp_snprintf(msg, 256, "I can't go on meeting you like this");
+ @.I can't go on...@>
+ }
+ if (mp->interaction == mp_error_stop_mode) {
+ /* no more interaction */
+ mp->interaction = mp_scroll_mode;
+ }
+ mp_error(mp, msg, hlp);
+ mp->history=mp_fatal_error_stop;
+ /* irrecoverable error */
+ mp_jump_out(mp);
+}
+
+@ A couple of state variables:
+
+@<Global...@>=
+int run_state; /* are we processing input ? */
+int finished; /* set true by |close_files_and_terminate| */
+
+@ @<Allocate or ...@>=
+mp->finished = 0;
+
+@* Arithmetic with scaled numbers.
+
+The principal computations performed by \MP\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones. @^small computers@>
+
+But C does not rigidly define the |/| operation in the case of negative
+dividends; for example, the result of |(-2 * n - 1) / 2| is |- ( n + 1)| on some
+computers and |-n| on others (is this true ?). There are two principal types of
+arithmetic: \quotation {translation-preserving,} in which the identity |(a + q *
+b) / b = (a / b) + q| is valid; and \quotation {negation-preserving,} in which
+|(-a) / b = -(a/b)|. This leads to two \MP s, which can produce different
+results, although the differences should be negligible when the language is being
+used properly. The \TEX\ processor has been defined carefully so that both
+varieties of arithmetic will produce identical output, but it would be too
+inefficient to constrain \MP\ in a similar way.
+
+@d inf_t mp->math->md_inf_t
+@d negative_inf_t mp->math->md_negative_inf_t
+
+@ A single computation might use several subroutine calls, and it is desirable to
+avoid producing multiple error messages in case of arithmetic overflow. So the
+routines below set the global variable |arith_error| to |true| instead of
+reporting errors directly to the user. @^overflow in arithmetic@>
+
+@<Glob...@>=
+int arith_error;
+
+@ @<Allocate or ...@>=
+mp->arith_error = 0;
+
+@ At crucial points the program will say |check_arith|, to test if an arithmetic
+error has been detected.
+
+@d check_arith()
+ if (mp->arith_error) {
+ mp_clear_arith(mp);
+ }
+
+@c
+static void mp_clear_arith (MP mp) {
+ mp_error(
+ mp,
+ "Arithmetic overflow",
+ "Uh, oh. A little while ago one of the quantities that I was computing got too\n"
+ "large, so I'm afraid your answers will be somewhat askew. You'll probably have to\n"
+ "adopt different tactics next time. But I shall try to carry on anyway."
+ );
+ @.Arithmetic overflow@>
+ mp->arith_error = 0;
+}
+
+@ The definitions of these are set up by the math initialization. Here
+|arc_tol_k| is the criterium to quit when change in arc length
+estimate reaches it.
+
+@d arc_tol_k mp->math->md_arc_tol_k
+@d coef_bound_k mp->math->md_coef_bound_k
+@d coef_bound_minus_1 mp->math->md_coef_bound_minus_1
+@d sqrt_8_e_k mp->math->md_sqrt_8_e_k
+@d twelve_ln_2_k mp->math->md_twelve_ln_2_k
+@d twelvebits_3 mp->math->md_twelvebits_3
+@d one_k mp->math->md_one_k
+@d epsilon_t mp->math->md_epsilon_t
+@d unity_t mp->math->md_unity_t
+@d zero_t mp->math->md_zero_t
+@d two_t mp->math->md_two_t
+@d three_t mp->math->md_three_t
+@d half_unit_t mp->math->md_half_unit_t
+@d three_quarter_unit_t mp->math->md_three_quarter_unit_t
+@d twentysixbits_sqrt2_t mp->math->md_twentysixbits_sqrt2_t
+@d twentyeightbits_d_t mp->math->md_twentyeightbits_d_t
+@d twentysevenbits_sqrt2_d_t mp->math->md_twentysevenbits_sqrt2_d_t
+@d warning_limit_t mp->math->md_warning_limit_t
+@d precision_default mp->math->md_precision_default
+@d precision_min mp->math->md_precision_min
+@d precision_max mp->math->md_precision_max
+
+@ In fact, the two sorts of scaling discussed above aren't quite sufficient; \MP\
+has yet another, used internally to keep track of angles.
+
+@ We often want to print two scaled quantities in parentheses, separated by a
+comma.
+
+@c
+static void mp_print_two (MP mp, mp_number *x, mp_number *y)
+{
+ mp_print_chr(mp, '(');
+ print_number(*x);
+ mp_print_chr(mp, ',');
+ print_number(*y);
+ mp_print_chr(mp, ')');
+}
+
+@d fraction_one_t mp->math->md_fraction_one_t
+@d fraction_half_t mp->math->md_fraction_half_t
+@d fraction_three_t mp->math->md_fraction_three_t
+@d fraction_four_t mp->math->md_fraction_four_t
+@d one_eighty_deg_t mp->math->md_one_eighty_deg_t
+@d negative_one_eighty_deg_t mp->math->md_negative_one_eighty_deg_t
+@d three_sixty_deg_t mp->math->md_three_sixty_deg_t
+
+@ And now let's complete our collection of numeric utility routines by
+considering random number generation. \MP\ generates pseudo-random numbers with
+the additive scheme recommended in Section 3.6 of {\em The Art of Computer
+Programming}; however, the results are random fractions between 0 and
+|fraction_one-1|, inclusive.
+
+There's an auxiliary array |randoms| that contains 55 pseudo-random fractions.
+Using the recurrence $x_n = (x_{n - 55} - x_{n - 31}) \bmod 2^{28}$, we generate
+batches of 55 new $x_n$'s at a time by calling |new_randoms|. The global variable
+|j_random| tells which element has most recently been consumed. The global
+variable |random_seed| was introduced in version 0.9, for the sole reason of
+stressing the fact that the initial value of the random seed is system-dependant.
+The initialization code below will initialize this variable to |(internal
+[mp_time] div unity) + internal [mp_day]|, but this is not good enough on modern
+fast machines that are capable of running multiple \METAPOST\ processes within
+the same second. @^system dependencies@>
+
+@<Glob...@>=
+mp_number randoms[55]; /* the last 55 random values generated */
+int j_random; /* the number of unused |randoms| */
+int j_padding; /* the number of unused |randoms| */
+
+@ @<Option variables@>=
+int random_seed; /* the default random seed */
+
+@ @<Allocate or initialize ...@>=
+mp->random_seed = opt->random_seed;
+for (int i = 0; i < 55; i++) {
+ new_fraction(mp->randoms[i]);
+}
+
+@ @<Dealloc...@>=
+for (int i = 0; i < 55; i++) {
+ free_number(mp->randoms[i]);
+}
+
+@ @<Internal library ...@>=
+void mp_new_randoms (MP mp);
+
+@ @c
+void mp_new_randoms (MP mp)
+{
+ mp_number x; /* accumulator */
+ new_number(x);
+ for (int k = 0; k <= 23; k++) {
+ set_number_from_subtraction(x, mp->randoms[k], mp->randoms[k + 31]);
+ if (number_negative(x)) {
+ number_add(x, fraction_one_t);
+ }
+ number_clone(mp->randoms[k], x);
+ }
+ for (int k = 24; k <= 54; k++) {
+ set_number_from_subtraction(x, mp->randoms[k], mp->randoms[k - 24]);
+ if (number_negative(x)) {
+ number_add(x, fraction_one_t);
+ }
+ number_clone(mp->randoms[k], x);
+ }
+ free_number(x);
+ mp->j_random = 54;
+}
+
+@ To consume a random fraction, the program below will say |next_random|. Now
+each number system has its own implementation, true to the original as much as
+possibile.
+
+@ To produce a uniform random number in the range |0 <= u < x| or |0 >= u > x| or
+|0 = u = x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x| with
+about half the probability that it will produce any other particular values
+between 0 and~|x|, because it rounds its answers. This is the original one, that
+stays as reference: As said before, now each number system has its own
+implementation.
+
+@ Finally, a normal deviate with mean zero and unit standard deviation can
+readily be obtained with the ratio method (Algorithm 3.4.1R in {\em The Art of
+Computer Programming}). This is the original one, that stays as reference: Now
+each number system has its own implementation, true to the original as much as
+possibile.
+
+@ The random related code is in the number system modules.
+
+@* Packed data.
+
+@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
+@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */
+
+@ The reader should study the following definitions closely: @^system
+dependencies@>
+
+@<Types...@>=
+typedef struct mp_value_node_data *mp_value_node;
+typedef struct mp_node_data *mp_node;
+typedef struct mp_symbol_entry *mp_sym;
+
+typedef unsigned short quarterword; /* 1/4 of a 64 bit word */
+typedef int halfword; /* 1/2 of a 64 bit word */
+
+typedef struct mp_independent_data {
+ int scale; /* only for |indep_scale|, used together with |serial| */
+ int serial; /* only for |indep_value|, used together with |scale| */
+} mp_independent_data;
+
+typedef struct mp_value_data {
+ mp_independent_data indep;
+ mp_number n;
+ mp_string str;
+ mp_sym sym;
+ mp_node node;
+ mp_knot p;
+} mp_value_data;
+
+typedef struct mp_value {
+ mp_variable_type type;
+ int padding;
+ mp_value_data data;
+} mp_value;
+
+@ The global variable |math_mode| has four settings, representing the math value
+type that will be used in this run.
+
+The typedef for |mp_number| is here because it has to come very early.
+
+@<Exported types@>=
+typedef enum mp_math_mode {
+ mp_math_scaled_mode,
+ mp_math_double_mode,
+ mp_math_binary_mode,
+ mp_math_decimal_mode
+} mp_math_mode;
+
+@ @<Option variables@>=
+int math_mode; /* math mode */
+
+@ @<Allocate or initialize ...@>=
+mp->math_mode = opt->math_mode;
+
+@ Most important memory is kept in a chain so we don't need to allocate that
+often. We could (at some point) decide to use mimalloc.
+
+@<Declare helpers@>=
+extern void *mp_memory_allocate (size_t size);
+extern void *mp_memory_clear_allocate (size_t size);
+extern void *mp_memory_reallocate (void *p, size_t size);
+extern void mp_memory_free (void *p);
+
+extern void *mp_allocate_node (MP mp, size_t size);
+extern void *mp_allocate_dash (MP mp);
+
+@ This is an attempt to spend less time in |malloc()|:
+
+@d max_num_token_nodes 8000 /* maybe make this configureable */
+@d max_num_pair_nodes 1000
+@d max_num_knot_nodes 1000
+@d max_num_value_nodes 1000
+@d max_num_symbolic_nodes 1000
+
+@<Global ...@>=
+mp_node token_nodes;
+mp_node pair_nodes;
+int num_token_nodes;
+int num_pair_nodes;
+mp_knot knot_nodes;
+mp_node value_nodes;
+int max_knot_nodes;
+int num_knot_nodes;
+int num_value_nodes;
+mp_node symbolic_nodes;
+int num_symbolic_nodes;
+
+@ @<Allocate or initialize ...@>=
+mp->token_nodes = NULL;
+mp->num_token_nodes = 0;
+mp->pair_nodes = NULL;
+mp->num_pair_nodes = 0;
+mp->knot_nodes = NULL;
+mp->max_knot_nodes = max_num_knot_nodes;
+mp->num_knot_nodes = 0;
+mp->value_nodes = NULL;
+mp->num_value_nodes = 0;
+mp->symbolic_nodes = NULL;
+mp->num_symbolic_nodes = 0;
+
+@ @<Dealloc ...@>=
+while (mp->value_nodes) {
+ mp_node p = mp->value_nodes;
+ mp->value_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_value_node_data));
+}
+while (mp->symbolic_nodes) {
+ mp_node p = mp->symbolic_nodes;
+ mp->symbolic_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_node_data));
+}
+while (mp->pair_nodes) {
+ mp_node p = mp->pair_nodes;
+ mp->pair_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_pair_node_data));
+}
+while (mp->token_nodes) {
+ mp_node p = mp->token_nodes;
+ mp->token_nodes = p->link;
+ mp_free_node(mp, p, sizeof(mp_node_data));
+}
+while (mp->knot_nodes) {
+ mp_knot p = mp->knot_nodes;
+ mp->knot_nodes = p->next;
+ mp_free_knot(mp, p);
+}
+
+@ This is a nicer way of allocating nodes. Users who wish to study the memory
+requirements of particular applications can can use the special features that
+keep track of current and maximum memory usage. All kind of statistics are
+available on request but we no longer display them in the library.
+
+@ @<Glob...@>=
+size_t var_used; /* how much memory is in use */
+size_t var_used_max; /* how much memory was in use max */
+
+@ @c
+void *mp_allocate_node (MP mp, size_t size)
+{
+ void *p = mp_memory_allocate(size);
+ ((mp_node) p)->link = NULL;
+ ((mp_node) p)->hasnumber = 0;
+ mp->var_used += size;
+ if (mp->var_used > mp->var_used_max) {
+ mp->var_used_max = mp->var_used;
+ }
+ return p;
+}
+
+void *mp_allocate_dash (MP mp)
+{
+ void *p = mp_memory_allocate(sizeof(mp_dash_object));
+ mp->var_used += sizeof(mp_dash_object);
+ if (mp->var_used > mp->var_used_max) {
+ mp->var_used_max = mp->var_used;
+ }
+ return p;
+}
+
+@ We want to be able to overload the allocator but then we also need to
+pass to the avl handler and that one doesn't take the |mp| pointer so
+we just do a hard exit.
+
+@c
+void *mp_memory_allocate (size_t size)
+{
+ void *w = lmt_memory_malloc(size);
+ if (! w) {
+ printf("mplib ran out of memory, case 1");
+ exit(EXIT_FAILURE);
+ }
+ return w;
+}
+
+void *mp_memory_clear_allocate (size_t size)
+{
+ void *w = lmt_memory_calloc(1, size);
+ if (! w) {
+ printf("mplib ran out of memory, case 2");
+ exit(EXIT_FAILURE);
+ }
+ return w;
+}
+
+void *mp_memory_reallocate (void *p, size_t size)
+{
+ void *w = lmt_memory_realloc(p, size);
+ if (! w) {
+ printf("mplib ran out of memory, case 3");
+ exit(EXIT_FAILURE);
+ }
+ return w;
+}
+
+void mp_memory_free (void *p)
+{
+ lmt_memory_free(p);
+}
+
+@ @<Internal library declarations@>=
+# define mp_snprintf snprintf
+
+@* Dynamic memory allocation.
+
+The \MP\ system does nearly all of its own memory allocation, so that it can
+readily be transported into environments that do not have automatic facilities
+for strings, garbage collection, etc., and so that it can be in control of what
+error messages the user receives.
+
+@d mp_link(A) (A)->link /* the |link| field of a node */
+@d mp_type(A) (A)->type /* identifies what kind of value this is */
+@d mp_name_type(A) (A)->name_type /* a clue to the name of this value */
+
+@d mp_set_link(A,B) (A)->link = (mp_node) (B)
+
+@ @<MPlib internal header stuff@>=
+typedef struct mp_node_data {
+ union {
+ mp_command_code command;
+ mp_variable_type type;
+ };
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ mp_value_data data;
+} mp_node_data;
+
+typedef struct mp_node_data *mp_symbolic_node;
+
+@ These will become inline:
+
+@c
+# define mp_get_sym_info(A) mp_get_indep_value(A)
+# define mp_set_sym_info(A,B) mp_set_indep_value(A, (B))
+# define mp_get_sym_sym(A) (A)->data.sym
+# define mp_set_sym_sym(A,B) (A)->data.sym = (mp_sym)(B)
+
+@ The function |get_symbolic_node| returns a pointer to a new symbolic node whose
+|link| field is null. @^inner loop@>
+
+@c
+static mp_node mp_new_symbolic_node (MP mp)
+{
+ mp_symbolic_node p;
+ if (mp->symbolic_nodes) {
+ p = (mp_symbolic_node) mp->symbolic_nodes;
+ mp->symbolic_nodes = p->link;
+ mp->num_symbolic_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_node_data));
+ new_number(p->data.n);
+ p->hasnumber = 1;
+ }
+ p->type = mp_symbol_node_type;
+ p->name_type = mp_normal_operation;
+ return (mp_node) p;
+}
+
+@ Conversely, when some node |p| of size |s| is no longer needed, the operation
+|free_node(p,s)| will make its words available, by inserting |p| as a new empty
+node just before where |rover| now points.
+
+A symbolic node is recycled by calling |free_symbolic_node|.
+
+@c
+static void mp_free_node (MP mp, mp_node p, size_t siz)
+{
+ /* node liberation */
+ if (p) {
+ mp->var_used -= siz;
+ if (mp->math_mode > mp_math_double_mode) {
+ if (p->hasnumber >= 1 && is_number(((mp_symbolic_node) p)->data.n)) {
+ free_number(((mp_symbolic_node) p)->data.n);
+ }
+ if (p->hasnumber == 2 && is_number(((mp_value_node) p)->subscript)) {
+ free_number(((mp_value_node) p)->subscript);
+ }
+ /*
+ There was a quite large |switch| here first, but the |mp_dash_node|
+ case was the only one that did anything ...
+ */
+ if (mp_type(p) == mp_dash_node_type) {
+ free_number(((mp_dash_node) p)->start_x);
+ free_number(((mp_dash_node) p)->stop_x);
+ free_number(((mp_dash_node) p)->dash_y);
+ }
+ }
+ mp_memory_free(p);
+ }
+}
+
+static void mp_free_symbolic_node (MP mp, mp_node p)
+{
+ /* node liberation */
+ if (p) {
+ if (mp->num_symbolic_nodes < max_num_symbolic_nodes) {
+ p->link = mp->symbolic_nodes;
+ mp->symbolic_nodes = p;
+ mp->num_symbolic_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_node_data);
+ mp_memory_free(p);
+ }
+ }
+}
+
+static void mp_free_value_node (MP mp, mp_node p)
+{
+ /* node liberation */
+ if (p) {
+ if (mp->num_value_nodes < max_num_value_nodes) {
+ p->link = mp->value_nodes;
+ mp->value_nodes = p;
+ mp->num_value_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_value_node_data);
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(((mp_value_node) p)->data.n);
+ free_number(((mp_value_node) p)->subscript);
+ }
+ mp_memory_free(p);
+ }
+ }
+}
+
+@ @<declarations@>=
+static void mp_free_node (MP mp, mp_node p, size_t siz);
+static void mp_free_symbolic_node (MP mp, mp_node p);
+static void mp_free_value_node (MP mp, mp_node p);
+
+@* Memory layout.
+
+Some nodes are created statically, since static allocation is more efficient than
+dynamic allocation when we can get away with it.
+
+@<Glob...@>=
+mp_dash_node null_dash;
+mp_value_node dep_head;
+mp_node inf_val;
+mp_node zero_val;
+mp_node temp_val;
+mp_node end_attr;
+mp_node bad_vardef;
+mp_node temp_head;
+mp_node hold_head;
+mp_node spec_head;
+
+@ The following code gets the memory off to a good start.
+
+@<Initialize table entries@>=
+mp->spec_head = mp_new_symbolic_node(mp);
+mp->temp_head = mp_new_symbolic_node(mp);
+mp->hold_head = mp_new_symbolic_node(mp);
+
+@ @<Free table entries@>=
+mp_free_symbolic_node(mp, mp->spec_head);
+mp_free_symbolic_node(mp, mp->temp_head);
+mp_free_symbolic_node(mp, mp->hold_head);
+
+@ The procedure |flush_node_list(p)| frees an entire linked list of nodes that
+starts at a given position, until coming to a |NULL| pointer. @^inner loop@>
+
+@c
+static void mp_flush_node_list (MP mp, mp_node p)
+{
+ while (p != NULL) {
+ mp_node q = p;
+ p = p->link;
+ if (q->type != mp_symbol_node_type) {
+ mp_free_token_node(mp, q);
+ } else {
+ mp_free_symbolic_node(mp, q);
+ }
+ }
+}
+
+@* The command codes.
+
+Before we can go much further, we need to define symbolic names for the internal
+code numbers that represent the various commands obeyed by \MP. These codes are
+somewhat arbitrary, but not completely so. For example, some codes have been made
+adjacent so that |case| statements in the program need not consider cases that
+are widely spaced, or so that |case| statements can be replaced by |if|
+statements. A command can begin an expression if and only if its code lies
+between |min_primary_command| and |max_primary_command|, inclusive. The first
+token of a statement that doesn't begin with an expression has a command code
+between |min_command| and |max_statement_command|, inclusive. Anything less than
+|min_command| is eliminated during macro expansions, and anything no more than
+|max_pre_command| is eliminated when expanding \TEX\ material. Ranges such as
+|min_secondary_command..max_secondary_command| are used when parsing expressions,
+but the relative ordering within such a range is generally not critical.
+
+The ordering of the highest-numbered commands (|comma<semicolon<end_group<stop|)
+is crucial for the parsing and error-recovery methods of this program as is the
+ordering |if_test<fi_or_else| for the smallest two commands. The ordering is also
+important in the ranges |numeric_token..plus_or_minus| and
+|left_brace..ampersand|.
+
+At any rate, here is the list, for future reference.
+
+@d mp_max_command_code mp_stop
+@d mp_max_pre_command mp_etex_command
+@d mp_min_command (mp_defined_macro_command+1)
+@d mp_max_statement_command mp_type_name_command
+@d mp_min_primary_command mp_type_name_command
+@d mp_min_suffix_token mp_internal_command
+@d mp_max_suffix_token mp_numeric_command
+@d mp_max_primary_command mp_plus_or_minus_command /* should also be |numeric_token+1| */
+@d mp_min_tertiary_command mp_plus_or_minus_command
+@d mp_max_tertiary_command mp_tertiary_binary_command
+@d mp_min_expression_command mp_left_brace_command
+@d mp_max_expression_command mp_equals_command
+@d mp_min_secondary_command mp_and_command
+@d mp_max_secondary_command mp_secondary_binary_command
+@d mp_end_of_statement (cur_cmd>mp_comma_command)
+
+@<Enumeration types@>=
+typedef enum mp_command_code {
+ mp_undefined_command,
+ mp_btex_command, /* begin \TeX\ material (|btex|, |verbatimtex|) */
+ mp_etex_command, /* end \TeX\ material (|etex|) */
+ mp_if_test_command, /* conditional text (|if|) */
+ mp_fi_or_else_command, /* delimiters for conditionals (|elseif|, |else|, |fi|) */
+ mp_input_command, /* input a source file (|input|, |endinput|) */
+ mp_iteration_command, /* iterate (|for|, |forsuffixes|, |forever|, |endfor|) */
+ mp_repeat_loop_command, /* special command substituted for |endfor| */
+ mp_exit_test_command, /* premature exit from a loop (|exitif|) */
+ mp_relax_command, /* do nothing (|\char`\\|) */
+ mp_scan_tokens_command, /* put a string into the input buffer */
+ mp_runscript_command, /* put a script result string into the input buffer */
+ mp_maketext_command, /* make a text (typesetting) */
+ mp_expand_after_command, /* look ahead one token */
+ mp_defined_macro_command, /* a macro defined by the user */
+ mp_save_command, /* save a list of tokens (|save|) */
+ mp_interim_command, /* save an internal quantity (|interim|) */
+ mp_let_command, /* redefine a symbolic token (|let|) */
+ mp_new_internal_command, /* define a new internal quantity (|newinternal|) */
+ mp_macro_def_command, /* define a macro (|def|, |vardef|, etc.) */
+ mp_ship_out_command, /* output a character (|shipout|) */
+ mp_add_to_command, /* add to edges (|addto|) */
+ mp_bounds_command, /* add bounding path to edges (|setbounds|, |clip|) */
+ mp_protection_command, /* set protection flag (|outer|, |inner|) */
+ mp_property_command,
+ mp_show_command, /* diagnostic output (|show|, |showvariable|, etc.) */
+ mp_mode_command, /* set interaction level (|batchmode|, etc.) */
+ mp_only_set_command, /* initialize random number generator (|randomseed|) */
+ mp_message_command, /* communicate to user (|message|, |errmessage|) */
+ mp_every_job_command, /* designate a starting token (|everyjob|) */
+ mp_delimiters_command, /* define a pair of delimiters (|delimiters|) */
+ mp_write_command, /* write text to a file (|write|) */
+ mp_type_name_command, /* declare a type (|numeric|, |pair|, etc.) */
+ mp_left_delimiter_command, /* the left delimiter of a matching pair */
+ mp_begin_group_command, /* beginning of a group (|begingroup|) */
+ mp_nullary_command, /* an operator without arguments (e.g., |normaldeviate|) */
+ mp_unary_command, /* an operator with one argument (e.g., |sqrt|) */
+ mp_str_command, /* convert a suffix to a string (|str|) */
+ mp_void_command, /* convert a suffix to a boolean (|void|) */
+ mp_cycle_command, /* close a cyclic path (|cycle|) */
+ mp_of_binary_command, /* binary operation taking |of| (e.g., |point|) */
+ mp_capsule_command, /* a value that has been put into a token list */
+ mp_string_command, /* a string constant (e.g., |"hello"|) */
+ mp_internal_command, /* internal numeric parameter (e.g., |pausing|) */
+ mp_tag_command, /* a symbolic token without a primitive meaning */
+ mp_numeric_command, /* a numeric constant (e.g., |3.14159|) */
+ mp_plus_or_minus_command, /* either |+| or |-| */
+ mp_secondary_def_command, /* a macro defined by |secondarydef| */
+ mp_tertiary_binary_command, /* an operator at the tertiary level (e.g., |++|) */
+ mp_left_brace_command, /* the operator `|\char||| */
+ mp_path_join_command, /* the operator |..| */
+ mp_ampersand_command, /* the operator `\.\&' */
+ mp_tertiary_def_command, /* a macro defined by |tertiarydef| */
+ mp_primary_binary_command, /* an operator at the expression level (e.g., |<|) */
+ mp_equals_command, /* the operator |=| */
+ mp_and_command, /* the operator |and| */
+ mp_primary_def_command, /* a macro defined by |primarydef| */
+ mp_slash_command, /* the operator |/| */
+ mp_secondary_binary_command, /* an operator at the binary level (e.g., |shifted|) */
+ mp_parameter_commmand, /* type of parameter (|primary|, |expr|, |suffix|, etc.) */
+ mp_controls_command, /* specify control points explicitly (|controls|) */
+ mp_tension_command, /* specify tension between knots (|tension|) */
+ mp_at_least_command, /* bounded tension value (|atleast|) */
+ mp_curl_command, /* specify curl at an end knot (|curl|) */
+ mp_macro_special_command, /* special macro operators (|quote|, |\#\AT!|, etc.) */
+ mp_right_delimiter_command, /* the right delimiter of a matching pair */
+ mp_left_bracket_command, /* the operator |[| */
+ mp_right_bracket_command, /* the operator |]| */
+ mp_right_brace_command, /* the operator `|\char|}| */
+ mp_with_option_command, /* option for filling (|withpen|, |withweight|, etc.) */
+ mp_thing_to_add_command, /* variant of |addto| (|contour|, |doublepath|, |also|) */
+ mp_of_command, /* the operator |of| */
+ mp_to_command, /* the operator |to| */
+ mp_step_command, /* the operator |step| */
+ mp_until_command, /* the operator |until| */
+ mp_within_command, /* the operator |within| */
+ mp_assignment_command, /* the operator |:=| */
+ mp_colon_command, /* the operator |:| */
+ mp_comma_command, /* the operator |,|, must be |colon+1| */
+ mp_semicolon_command, /* the operator |;|, must be |comma+1| */
+ mp_end_group_command, /* end a group (|endgroup|), must be |semicolon+1| */
+ mp_stop_command, /* end a job (|end|, |dump|), must be |end_group+1| */
+ // mp_outer_tag_command, /* protection code added to command code */
+ mp_undefined_cs_command, /* protection code added to command code */
+} mp_command_code;
+
+@ Variables and capsules in \MP\ have a variety of \quote {types,} distinguished by
+the code numbers defined here. These numbers are also not completely arbitrary.
+Things that get expanded must have types |> mp_independent|; a type remaining
+after expansion is numeric if and only if its code number is at least
+|numeric_type|; objects containing numeric parts must have types between
+|transform_type| and |pair_type|; all other types must be smaller than
+|transform_type|; and among the types that are not unknown or vacuous, the
+smallest two must be |boolean_type| and |string_type| in that order.
+
+@d unknown_tag 1 /* this constant is added to certain type codes below */
+
+@<Enumeration types@>=
+typedef enum mp_variable_type {
+ mp_undefined_type, /* no type has been declared */
+ mp_vacuous_type, /* no expression was present */
+ mp_boolean_type, /* |boolean| with a known value */
+ mp_unknown_boolean_type,
+ mp_string_type, /* |string| with a known value */
+ mp_unknown_string_type,
+ mp_pen_type, /* |pen| with a known value */
+ mp_unknown_pen_type,
+ mp_nep_type, /* |pen| with a known value */
+ mp_unknown_nep_type,
+ mp_path_type, /* |path| with a known value */
+ mp_unknown_path_type,
+ mp_picture_type, /* |picture| with a known value */
+ mp_unknown_picture_type,
+ mp_transform_type, /* |transform| variable or capsule */
+ mp_color_type, /* |color| variable or capsule */
+ mp_cmykcolor_type, /* |cmykcolor| variable or capsule */
+ mp_pair_type, /* |pair| variable or capsule */
+ mp_numeric_type, /* variable that has been declared |numeric| but not used */
+ mp_known_type, /* |numeric| with a known value */
+ mp_dependent_type, /* a linear combination with |fraction| coefficients */
+ mp_proto_dependent_type, /* a linear combination with |scaled| coefficients */
+ mp_independent_type, /* |numeric| with unknown value */
+ mp_token_list_type, /* variable name or suffix argument or text argument */
+ mp_structured_type, /* variable with subscripts and attributes */
+ mp_unsuffixed_macro_type, /* variable defined with |vardef| but no |\AT!\#| */
+ mp_suffixed_macro_type, /* variable defined with |vardef| and |\AT!\#| */
+
+ mp_symbol_node_type,
+ mp_token_node_type,
+ mp_value_node_type,
+ mp_attribute_node_type,
+ mp_subscript_node_type,
+ mp_pair_node_type,
+ mp_transform_node_type,
+ mp_color_node_type,
+ mp_cmykcolor_node_type,
+
+ /*
+ It is important that the next 7 items remain in this order, for export as
+ well as switch/case offsets.
+ */
+
+ mp_fill_node_type,
+ mp_stroked_node_type,
+ mp_start_clip_node_type,
+ mp_start_group_node_type,
+ mp_start_bounds_node_type,
+
+ mp_stop_clip_node_type,
+ mp_stop_group_node_type,
+ mp_stop_bounds_node_type,
+
+ mp_dash_node_type,
+ mp_dep_node_type,
+ mp_if_node_type,
+ mp_edge_header_node_type,
+} mp_variable_type;
+
+@ @<Declarations@>=
+static void mp_print_type (MP mp, int t);
+
+@ @c
+static const char *mp_type_string(int t)
+{
+ const char *s = NULL;
+ switch (t) {
+ case mp_undefined_type: s = "undefined"; break;
+ case mp_vacuous_type: s = "vacuous"; break;
+ case mp_boolean_type: s = "boolean"; break;
+ case mp_unknown_boolean_type: s = "unknown boolean"; break;
+ case mp_string_type: s = "string"; break;
+ case mp_unknown_string_type: s = "unknown string"; break;
+ case mp_pen_type: s = "pen"; break;
+ case mp_unknown_pen_type: s = "unknown pen"; break;
+ case mp_nep_type: s = "pen"; break;
+ case mp_unknown_nep_type: s = "unknown pen"; break;
+ case mp_path_type: s = "path"; break;
+ case mp_unknown_path_type: s = "unknown path"; break;
+ case mp_picture_type: s = "picture"; break;
+ case mp_unknown_picture_type: s = "unknown picture"; break;
+ case mp_transform_type: s = "transform"; break;
+ case mp_color_type: s = "color"; break;
+ case mp_cmykcolor_type: s = "cmykcolor"; break;
+ case mp_pair_type: s = "pair"; break;
+ case mp_known_type: s = "known numeric"; break;
+ case mp_dependent_type: s = "dependent"; break;
+ case mp_proto_dependent_type: s = "proto-dependent"; break;
+ case mp_numeric_type: s = "numeric"; break;
+ case mp_independent_type: s = "independent"; break;
+ case mp_token_list_type: s = "token list"; break;
+ case mp_structured_type: s = "mp_structured"; break;
+ case mp_unsuffixed_macro_type: s = "unsuffixed macro"; break;
+ case mp_suffixed_macro_type: s = "suffixed macro"; break;
+ case mp_symbol_node_type: s = "symbol node"; break;
+ case mp_token_node_type: s = "token node"; break;
+ case mp_value_node_type: s = "value node"; break;
+ case mp_attribute_node_type: s = "attribute node"; break;
+ case mp_subscript_node_type: s = "subscript node"; break;
+ case mp_pair_node_type: s = "pair node"; break;
+ case mp_transform_node_type: s = "transform node"; break;
+ case mp_color_node_type: s = "color node"; break;
+ case mp_cmykcolor_node_type: s = "cmykcolor node"; break;
+ case mp_fill_node_type: s = "fill node"; break;
+ case mp_stroked_node_type: s = "stroked node"; break;
+ case mp_start_clip_node_type: s = "start clip node"; break;
+ case mp_start_group_node_type: s = "start group node"; break;
+ case mp_start_bounds_node_type: s = "start bounds node"; break;
+ case mp_stop_clip_node_type: s = "stop clip node"; break;
+ case mp_stop_group_node_type: s = "stop group node"; break;
+ case mp_stop_bounds_node_type: s = "stop bounds node"; break;
+ case mp_dash_node_type: s = "dash node"; break;
+ case mp_dep_node_type: s = "dependency node"; break;
+ case mp_if_node_type: s = "if node"; break;
+ case mp_edge_header_node_type: s = "edge header node"; break;
+ default:
+ {
+ char ss[256];
+ mp_snprintf(ss, 256, "<unknown type %d>", t);
+ s = mp_strdup(ss);
+ }
+ break;
+ }
+ return s;
+}
+
+void mp_print_type (MP mp, int t)
+{
+ if (t >= 0 && t <= mp_edge_header_node_type) {
+ mp_print_str(mp, mp_type_string(t));
+ } else {
+ mp_print_str(mp, "unknown");
+ }
+}
+
+@ Values inside \MP\ are stored in non-symbolic nodes that have a |name_type| as
+well as a |type|. The possibilities for |name_type| are defined here; they will
+be explained in more detail later.
+
+@<Enumeration types...@>=
+typedef enum mp_name_type_type {
+ mp_root_operation, /* |name_type| at the top level of a variable */
+ mp_saved_root_operation, /* same, when the variable has been saved */
+ mp_structured_root_operation, /* |name_type| where a |mp_structured| branch occurs */
+ mp_subscript_operation, /* |name_type| in a subscript node */
+ mp_attribute_operation, /* |name_type| in an attribute node */
+ mp_x_part_operation, /* |name_type| in the |xpart| of a node */
+ mp_y_part_operation, /* |name_type| in the |ypart| of a node */
+ mp_xx_part_operation, /* |name_type| in the |xxpart| of a node */
+ mp_xy_part_operation, /* |name_type| in the |xypart| of a node */
+ mp_yx_part_operation, /* |name_type| in the |yxpart| of a node */
+ mp_yy_part_operation, /* |name_type| in the |yypart| of a node */
+ mp_red_part_operation, /* |name_type| in the |redpart| of a node */
+ mp_green_part_operation, /* |name_type| in the |greenpart| of a node */
+ mp_blue_part_operation, /* |name_type| in the |bluepart| of a node */
+ mp_cyan_part_operation, /* |name_type| in the |redpart| of a node */
+ mp_magenta_part_operation, /* |name_type| in the |greenpart| of a node */
+ mp_yellow_part_operation, /* |name_type| in the |bluepart| of a node */
+ mp_black_part_operation, /* |name_type| in the |greenpart| of a node */
+ mp_grey_part_operation, /* |name_type| in the |greypart| of a node */
+ mp_capsule_operation, /* |name_type| in stashed-away subexpressions */
+ mp_token_operation, /* |name_type| in a numeric token or string token */
+
+ mp_boolean_type_operation, /* the order needs to match the types (as we use deltas) ! */
+ mp_string_type_operation,
+ mp_pen_type_operation,
+ mp_nep_type_operation,
+ mp_path_type_operation,
+ mp_picture_type_operation,
+ mp_transform_type_operation,
+ mp_color_type_operation,
+ mp_cmykcolor_type_operation,
+ mp_pair_type_operation,
+ mp_numeric_type_operation,
+
+ /* Symbolic nodes also have |name_type|, which is a different enumeration */
+
+ mp_normal_operation,
+ mp_internal_operation, /* for values of internals */
+ mp_macro_operation, /* for macro names */
+ mp_expr_operation, /* for macro parameters if type |expr| */
+ mp_suffix_operation, /* for macro parameters if type |suffix| */
+ mp_text_operation, /* for macro parameters if type |text| */
+ @<Operation codes@>
+} mp_name_type_type;
+
+@ Primitive operations that produce values have a secondary identification code
+in addition to their command code; it's something like genera and species. For
+example, |*| has the command code |primary_binary|, and its secondary
+identification is |times|. The secondary codes start such that they don't overlap
+with the type codes; some type codes (e.g., |mp_string_type|) are used as
+operators as well as type identifications. The relative values are not critical,
+except for |true_code..false_code|, |or_op..and_op|, and |filled_op..bounded_op|.
+The restrictions are that |and_op-false_code=or_op-true_code|, that the ordering
+of |x_part...blue_part| must match that of |x_part_operation..mp_blue_part_operation|,
+and the ordering of |filled_op..bounded_op| must match that of the code values
+they test for.
+
+Beware! The operation and type unumerations in some places run in parallel (with
+an offset. That makes it possible the handle types with common code using a
+delta. In some cases the delta is multiplied by 2 because we have knowns and
+unknowns. A less sensitive to patches would be to just duplicate the code (or to
+use a function call),
+
+@d mp_min_of_operation mp_substring_operation
+
+@<Operation codes@>=
+mp_true_operation, /* operation code for |true| */
+mp_false_operation, /* operation code for |false| */
+mp_null_picture_operation, /* operation code for |nullpicture| */
+mp_null_pen_operation, /* operation code for |nullpen| */
+mp_read_string_operation, /* operation code for |readstring| */
+mp_pen_circle_operation, /* operation code for |pencircle| */
+mp_normal_deviate_operation, /* operation code for |normaldeviate| */
+mp_read_from_operation, /* operation code for |readfrom| */
+mp_close_from_operation, /* operation code for |closefrom| */
+mp_odd_operation, /* operation code for |odd| */
+mp_known_operation, /* operation code for |known| */
+mp_unknown_operation, /* operation code for |unknown| */
+mp_not_operation, /* operation code for |not| */
+mp_decimal_operation, /* operation code for |decimal| */
+mp_reverse_operation, /* operation code for |reverse| */
+mp_uncycle_operation, /* operation code for |uncycle| */
+mp_make_path_operation, /* operation code for |makepath| */
+mp_make_pen_operation, /* operation code for |makepen| */
+mp_make_nep_operation, /* operation code for |makenep| */
+mp_convexed_operation, /* operation code for |convexed| */
+mp_uncontrolled_operation, /* operation code for |uncontrolled| */
+mp_oct_operation, /* operation code for |oct| */
+mp_hex_operation, /* operation code for |hex| */
+mp_ASCII_operation, /* operation code for |ASCII| */
+mp_char_operation, /* operation code for |char| */
+mp_length_operation, /* operation code for |length| */
+mp_turning_operation, /* operation code for |turningnumber| */
+mp_color_model_operation, /* operation code for |colormodel| */
+mp_path_part_operation, /* operation code for |pathpart| */
+mp_pen_part_operation, /* operation code for |penpart| */
+mp_dash_part_operation, /* operation code for |dashpart| */
+mp_prescript_part_operation, /* operation code for |prescriptpart| */
+mp_postscript_part_operation, /* operation code for |postscriptpart| */
+mp_stacking_part_operation, /* operation code for |stackingpart| */
+mp_sqrt_operation, /* operation code for |sqrt| */
+mp_m_exp_operation, /* operation code for |mexp| */
+mp_m_log_operation, /* operation code for |mlog| */
+mp_sin_d_operation, /* operation code for |sind| */
+mp_cos_d_operation, /* operation code for |cosd| */
+mp_floor_operation, /* operation code for |floor| */
+mp_uniform_deviate_operation, /* operation code for |uniformdeviate| */
+mp_ll_corner_operation, /* operation code for |llcorner| */
+mp_lr_corner_operation, /* operation code for |lrcorner| */
+mp_ul_corner_operation, /* operation code for |ulcorner| */
+mp_ur_corner_operation, /* operation code for |urcorner| */
+mp_center_of_operation, /* operation code for |centerof| */
+mp_center_of_mass_operation, /* operation code for |centerofmass| */
+mp_corners_operation, /* operation code for |corners| */
+mp_x_range_operation, /* operation code for |xrange| */
+mp_y_range_operation, /* operation code for |yrange| */
+mp_delta_point_operation, /* operation code for |deltapoint| */
+mp_delta_precontrol_operation, /* operation code for |deltaprecontrol| */
+mp_delta_postcontrol_operation,/* operation code for |deltapostcontrol| */
+mp_delta_direction_operation, /* operation code for |deltadirection| */
+mp_arc_length_operation, /* operation code for |arclength| */
+mp_angle_operation, /* operation code for |angle| */
+mp_cycle_operation, /* operation code for |cycle| */
+mp_no_cycle_operation, /* operation code for |nocycle| */
+mp_filled_operation, /* operation code for |filled| */
+mp_stroked_operation, /* operation code for |stroked| */
+mp_clipped_operation, /* operation code for |clipped| */
+mp_grouped_operation, /* operation code for |bounded| */
+mp_bounded_operation, /* operation code for |grouped| */
+mp_plus_operation, /* operation code for \.+ */
+mp_minus_operation, /* operation code for \.- */
+mp_times_operation, /* operation code for \.* */
+mp_over_operation, /* operation code for \./ */
+mp_power_operation, /* operation code for \.^ */
+mp_pythag_add_operation, /* operation code for |++| */
+mp_pythag_sub_operation, /* operation code for |+-+| */
+mp_or_operation, /* operation code for |or| */
+mp_and_operation, /* operation code for |and| */
+mp_less_than_operation, /* operation code for \.< */
+mp_less_or_equal_operation, /* operation code for |<=| */
+mp_greater_than_operation, /* operation code for \.> */
+mp_greater_or_equal_operation, /* operation code for |>=| */
+mp_equal_operation, /* operation code for \.= */
+mp_unequal_operation, /* operation code for |<>| */
+mp_concatenate_operation, /* operation code for \.\& */
+mp_just_append_operation, /* operation code for \.\&\& */
+mp_rotated_operation, /* operation code for |rotated| */
+mp_slanted_operation, /* operation code for |slanted| */
+mp_scaled_operation, /* operation code for |scaled| */
+mp_shifted_operation, /* operation code for |shifted| */
+mp_transformed_operation, /* operation code for |transformed| */
+mp_uncycled_operation, /* operation code for |uncycled| */
+mp_x_scaled_operation, /* operation code for |xscaled| */
+mp_y_scaled_operation, /* operation code for |yscaled| */
+mp_z_scaled_operation, /* operation code for |zscaled| */
+mp_intertimes_operation, /* operation code for |intersectiontimes| */
+mp_intertimes_list_operation, /* operation code for |intersectiontimeslist| */
+mp_double_dot_operation, /* operation code for improper |..| */
+mp_substring_operation, /* operation code for |substring| */
+mp_subpath_operation, /* operation code for |subpath| */
+mp_direction_time_operation, /* operation code for |directiontime| */
+mp_point_operation, /* operation code for |point| */
+mp_precontrol_operation, /* operation code for |precontrol| */
+mp_postcontrol_operation, /* operation code for |postcontrol| */
+mp_direction_operation, /* operation code for |direction| */
+mp_path_point_operation, /* operation code for |pathpoint| */
+mp_path_precontrol_operation, /* operation code for |pathprecontrol| */
+mp_path_postcontrol_operation, /* operation code for |pathpostcontrol| */
+mp_path_direction_operation, /* operation code for |pathdirection| */
+mp_pen_offset_operation, /* operation code for |penoffset| */
+mp_arc_time_operation, /* operation code for |arctime| */
+mp_arc_point_operation, /* operation code for |arcpoint| */
+mp_arc_point_list_operation, /* operation code for |arcpointlist| */
+mp_subarc_length_operation, /* operation code for |subarclength| */
+mp_version_operation, /* operation code for |mpversion| */
+mp_envelope_operation, /* operation code for |envelope| */
+mp_boundingpath_operation, /* operation code for |boundingpath| */
+
+@ @c
+static const char *mp_op_string (int c)
+{
+ if (c <= mp_numeric_type) {
+ return mp_type_string(c);
+ } else {
+ switch (c) {
+ case mp_true_operation : return "true";
+ case mp_false_operation : return "false";
+ case mp_null_picture_operation : return "nullpicture";
+ case mp_null_pen_operation : return "nullpen";
+ case mp_read_string_operation : return "readstring";
+ case mp_pen_circle_operation : return "pencircle";
+ case mp_normal_deviate_operation : return "normaldeviate";
+ case mp_read_from_operation : return "readfrom";
+ case mp_close_from_operation : return "closefrom";
+ case mp_odd_operation : return "odd";
+ case mp_known_operation : return "known";
+ case mp_unknown_operation : return "unknown";
+ case mp_not_operation : return "not";
+ case mp_decimal_operation : return "decimal";
+ case mp_reverse_operation : return "reverse";
+ case mp_uncycle_operation : return "uncycle";
+ case mp_make_path_operation : return "makepath";
+ case mp_make_pen_operation : return "makepen";
+ case mp_make_nep_operation : return "makenep";
+ case mp_convexed_operation : return "convexed";
+ case mp_uncontrolled_operation : return "uncontrolled";
+ case mp_oct_operation : return "oct";
+ case mp_hex_operation : return "hex";
+ case mp_ASCII_operation : return "ASCII";
+ case mp_char_operation : return "char";
+ case mp_length_operation : return "length";
+ case mp_turning_operation : return "turningnumber";
+ case mp_x_part_operation : return "xpart";
+ case mp_y_part_operation : return "ypart";
+ case mp_xx_part_operation : return "xxpart";
+ case mp_xy_part_operation : return "xypart";
+ case mp_yx_part_operation : return "yxpart";
+ case mp_yy_part_operation : return "yypart";
+ case mp_red_part_operation : return "redpart";
+ case mp_green_part_operation : return "greenpart";
+ case mp_blue_part_operation : return "bluepart";
+ case mp_cyan_part_operation : return "cyanpart";
+ case mp_magenta_part_operation : return "magentapart";
+ case mp_yellow_part_operation : return "yellowpart";
+ case mp_black_part_operation : return "blackpart";
+ case mp_grey_part_operation : return "greypart";
+ case mp_color_model_operation : return "colormodel";
+ case mp_prescript_part_operation : return "prescriptpart";
+ case mp_postscript_part_operation : return "postscriptpart";
+ case mp_stacking_part_operation : return "stackingpart";
+ case mp_path_part_operation : return "pathpart";
+ case mp_pen_part_operation : return "penpart";
+ case mp_dash_part_operation : return "dashpart";
+ case mp_sqrt_operation : return "sqrt";
+ case mp_m_exp_operation : return "mexp";
+ case mp_m_log_operation : return "mlog";
+ case mp_sin_d_operation : return "sind";
+ case mp_cos_d_operation : return "cosd";
+ case mp_floor_operation : return "floor";
+ case mp_uniform_deviate_operation : return "uniformdeviate";
+ case mp_ll_corner_operation : return "llcorner";
+ case mp_lr_corner_operation : return "lrcorner";
+ case mp_ul_corner_operation : return "ulcorner";
+ case mp_ur_corner_operation : return "urcorner";
+ case mp_center_of_operation : return "centerof";
+ case mp_center_of_mass_operation : return "centerofmass";
+ case mp_corners_operation : return "corners";
+ case mp_x_range_operation : return "xrange";
+ case mp_y_range_operation : return "yrange";
+ case mp_delta_point_operation : return "deltapoint";
+ case mp_delta_precontrol_operation : return "deltaprecontrol";
+ case mp_delta_postcontrol_operation: return "deltapostcontrol";
+ case mp_delta_direction_operation : return "deltadirection";
+ case mp_arc_length_operation : return "arclength";
+ case mp_angle_operation : return "angle";
+ case mp_cycle_operation : return "cycle";
+ case mp_no_cycle_operation : return "nocycle";
+ case mp_filled_operation : return "filled";
+ case mp_stroked_operation : return "stroked";
+ case mp_clipped_operation : return "clipped";
+ case mp_grouped_operation : return "grouped";
+ case mp_bounded_operation : return "bounded";
+ case mp_plus_operation : return "+";
+ case mp_minus_operation : return "-";
+ case mp_times_operation : return "*";
+ case mp_over_operation : return "/";
+ case mp_power_operation : return "^";
+ case mp_pythag_add_operation : return "++";
+ case mp_pythag_sub_operation : return "+-+";
+ case mp_or_operation : return "or";
+ case mp_and_operation : return "and";
+ case mp_less_than_operation : return "<";
+ case mp_less_or_equal_operation : return "<=";
+ case mp_greater_than_operation : return ">";
+ case mp_greater_or_equal_operation : return ">=";
+ case mp_equal_operation : return "=";
+ case mp_unequal_operation : return "<>";
+ case mp_concatenate_operation : return "&";
+ case mp_just_append_operation : return "&&";
+ case mp_rotated_operation : return "rotated";
+ case mp_slanted_operation : return "slanted";
+ case mp_scaled_operation : return "scaled";
+ case mp_shifted_operation : return "shifted";
+ case mp_transformed_operation : return "transformed";
+ case mp_x_scaled_operation : return "xscaled";
+ case mp_y_scaled_operation : return "yscaled";
+ case mp_z_scaled_operation : return "zscaled";
+ case mp_intertimes_operation : return "intersectiontimes";
+ case mp_intertimes_list_operation : return "intersectiontimeslist";
+ case mp_substring_operation : return "substring";
+ case mp_subpath_operation : return "subpath";
+ case mp_direction_time_operation : return "directiontime";
+ case mp_point_operation : return "point";
+ case mp_precontrol_operation : return "precontrol";
+ case mp_postcontrol_operation : return "postcontrol";
+ case mp_direction_operation : return "direction";
+ case mp_path_point_operation : return "pathpoint";
+ case mp_path_precontrol_operation : return "pathprecontrol";
+ case mp_path_postcontrol_operation : return "pathpostcontrol";
+ case mp_path_direction_operation : return "pathdirection";
+ case mp_pen_offset_operation : return "penoffset";
+ case mp_arc_time_operation : return "arctime";
+ case mp_arc_point_operation : return "arcpoint";
+ case mp_arc_point_list_operation : return "arcpointlist";
+ case mp_subarc_length_operation : return "subarclength";
+ case mp_version_operation : return "mpversion";
+ case mp_envelope_operation : return "envelope";
+ case mp_boundingpath_operation : return "boundingpath";
+
+ case mp_pen_type_operation : return "pen";
+ case mp_nep_type_operation : return "nep";
+ case mp_path_type_operation : return "path";
+ case mp_picture_type_operation : return "picture";
+ case mp_transform_type_operation : return "transform";
+ case mp_color_type_operation : return "color";
+ case mp_cmykcolor_type_operation : return "cmykcolor";
+ case mp_pair_type_operation : return "pair";
+ case mp_numeric_type_operation : return "numeric";
+
+ default : return "..";
+ }
+ }
+}
+static void mp_print_op (MP mp, int c)
+{
+ mp_print_str(mp, mp_op_string(c));
+}
+
+@ \MP\ also has a bunch of internal parameters that a user might want to fuss
+with. Every such parameter has an identifying code number, defined here.
+
+@<Types...@>=
+typedef enum mp_given_internal {
+ mp_number_system_internal = 1, /* the number system as set up by |numbersystem| */
+ mp_number_precision_internal, /* the number system precision as set up by |numberprecision| */
+ mp_job_name_internal, /* the jobname as set up from the options stucture */
+ mp_tracing_titles_internal, /* show titles online when they appear */
+ mp_tracing_equations_internal, /* show each variable when it becomes known */
+ mp_tracing_capsules_internal, /* show capsules too */
+ mp_tracing_choices_internal, /* show the control points chosen for paths */
+ mp_tracing_specs_internal, /* show path subdivision prior to filling with polygonal a pen */
+ mp_tracing_commands_internal, /* show commands and operations before they are performed */
+ mp_tracing_restores_internal, /* show when a variable or internal is restored */
+ mp_tracing_macros_internal, /* show macros before they are expanded */
+ mp_tracing_output_internal, /* dummy */
+ mp_tracing_stats_internal, /* show memory usage at end of job */ /* now a dummy */
+ mp_tracing_online_internal, /* show long diagnostics on terminal and in the log file */
+ mp_year_internal, /* the current year (e.g., 1984) */
+ mp_month_internal, /* the current month (e.g., 3 $\equiv$ March) */
+ mp_day_internal, /* the current day of the month */
+ mp_time_internal, /* the number of minutes past midnight when this job started */
+ mp_hour_internal, /* the number of hours past midnight when this job started */
+ mp_minute_internal, /* the number of minutes in that hour when this job started */
+ mp_char_code_internal, /* the number of the next character to be output */
+ mp_char_wd_internal, /* the width of the next character to be output */
+ mp_char_ht_internal, /* the height of the next character to be output */
+ mp_char_dp_internal, /* the depth of the next character to be output */
+ mp_char_ic_internal, /* the italic correction of the next character to be output */
+ mp_pausing_internal, /* dummy */
+ mp_showstopping_internal, /* positive to stop after each |show| command */
+ mp_texscriptmode_internal, /* controls spacing in texmode */
+ mp_overloadmode_internal,
+ mp_linejoin_internal, /* as in \ps: 0 for mitered, 1 for round, 2 for beveled */
+ mp_linecap_internal, /* as in \ps: 0 for butt, 1 for round, 2 for square */
+ mp_stacking_internal,
+ mp_miterlimit_internal, /* controls miter length as in \ps */
+ mp_warning_check_internal, /* controls error message when variable value is large */
+ mp_true_corners_internal, /* positive to make |llcorner| etc. ignore |setbounds| */
+ mp_default_color_model_internal, /* the default color model for unspecified items */
+ mp_restore_clip_color_internal,
+} mp_given_internal;
+
+typedef struct mp_internal {
+ mp_value v;
+ char *intname;
+ int run;
+ int padding;
+} mp_internal;
+
+@ @<MPlib internal header stuff@>=
+typedef enum mp_linecap_codes {
+ mp_butt_linecap_code,
+ mp_rounded_linecap_code,
+ mp_squared_linecap_code,
+ /* see below */
+ mp_weird_linecap_code,
+} mp_linecap_codes;
+
+typedef enum mp_linejoin_codes {
+ mp_mitered_linejoin_code,
+ mp_rounded_linejoin_code,
+ mp_beveled_linejoin_code,
+ /* we see this value being used */
+ mp_weird_linejoin_code,
+} mp_linejoin_codes;
+
+@ @<MPlib internal header stuff@>=
+# define internal_value(A) mp->internal[(A)].v.data.n
+# define internal_string(A) mp->internal[A].v.data.str
+# define set_internal_string(A,B) mp->internal[(A)].v.data.str=(B)
+# define internal_name(A) mp->internal[(A)].intname
+# define set_internal_name(A,B) mp->internal[(A)].intname=(B)
+# define internal_type(A) mp->internal[A].v.type
+# define set_internal_type(A,B) mp->internal[(A)].v.type=(B)
+# define internal_run(A) mp->internal[(A)].run
+# define set_internal_run(A,B) mp->internal[(A)].run=(B)
+
+@ @d max_given_internal mp_restore_clip_color_internal
+
+@<Glob...@>=
+mp_internal *internal; /* the values of internal quantities */
+int int_ptr; /* the maximum internal quantity defined so far */
+int max_internal; /* current maximum number of internal quantities */
+
+@ @<Allocate or initialize ...@>=
+//mp->max_internal = 2 * max_given_internal;
+mp->max_internal = 1000 + max_given_internal;
+mp->internal = mp_memory_allocate((size_t) (mp->max_internal + 1) * sizeof(mp_internal));
+
+memset(mp->internal, 0, (size_t) (mp->max_internal + 1) * sizeof(mp_internal));
+for (int i = 1; i <= mp->max_internal; i++) {
+ new_number(mp->internal[i].v.data.n);
+}
+for (int i = 1; i <= max_given_internal; i++) {
+ set_internal_type(i, mp_known_type);
+}
+
+set_internal_type(mp_number_system_internal, mp_string_type);
+set_internal_type(mp_job_name_internal, mp_string_type);
+
+@ @<Set initial ...@>=
+mp->int_ptr = max_given_internal;
+
+@ The symbolic names for internal quantities are put into \MP's hash table by
+using a routine called |primitive|, which will be defined later. Let us enter
+them now, so that we don't have to list all those names again anywhere else.
+
+@<Put each of \MP's primitives into the hash table@>=
+mp_primitive(mp, "tracingtitles", mp_internal_command, mp_tracing_titles_internal);
+@:tracingtitles_}{|tracingtitles| primitive@>
+mp_primitive(mp, "tracingequations", mp_internal_command, mp_tracing_equations_internal);
+@:mp_tracing_equations_}{|tracingequations| primitive@>
+mp_primitive(mp, "tracingcapsules", mp_internal_command, mp_tracing_capsules_internal);
+@:mp_tracing_capsules_}{|tracingcapsules| primitive@>
+mp_primitive(mp, "tracingchoices", mp_internal_command, mp_tracing_choices_internal);
+@:mp_tracing_choices_}{|tracingchoices| primitive@>
+mp_primitive(mp, "tracingspecs", mp_internal_command, mp_tracing_specs_internal);
+@:mp_tracing_specs_}{|tracingspecs| primitive@>
+mp_primitive(mp, "tracingcommands", mp_internal_command, mp_tracing_commands_internal);
+@:mp_tracing_commands_}{|tracingcommands| primitive@>
+mp_primitive(mp, "tracingrestores", mp_internal_command, mp_tracing_restores_internal);
+@:mp_tracing_restores_}{|tracingrestores| primitive@>
+mp_primitive(mp, "tracingmacros", mp_internal_command, mp_tracing_macros_internal);
+@:mp_tracing_macros_}{|tracingmacros| primitive@>
+mp_primitive(mp, "tracingoutput", mp_internal_command, mp_tracing_output_internal);
+@:mp_tracing_output_}{|tracingoutput| primitive@>
+mp_primitive(mp, "tracingstats", mp_internal_command, mp_tracing_stats_internal);
+@:mp_tracing_stats_}{|tracingstats| primitive@>
+mp_primitive(mp, "tracingonline", mp_internal_command, mp_tracing_online_internal);
+@:mp_tracing_online_}{|tracingonline| primitive@>
+mp_primitive(mp, "year", mp_internal_command, mp_year_internal);
+@:mp_year_}{|year| primitive@>
+mp_primitive(mp, "month", mp_internal_command, mp_month_internal);
+@:mp_month_}{|month| primitive@>
+mp_primitive(mp, "day", mp_internal_command, mp_day_internal);
+@:mp_day_}{|day| primitive@>
+mp_primitive(mp, "time", mp_internal_command, mp_time_internal);
+@:time_}{|time| primitive@>
+mp_primitive(mp, "hour", mp_internal_command, mp_hour_internal);
+@:hour_}{|hour| primitive@>
+mp_primitive(mp, "minute", mp_internal_command, mp_minute_internal);
+@:minute_}{|minute| primitive@>
+mp_primitive(mp, "charcode", mp_internal_command, mp_char_code_internal);
+@:mp_char_code_}{|charcode| primitive@>
+mp_primitive(mp, "charwd", mp_internal_command, mp_char_wd_internal);
+@:mp_char_wd_}{|charwd| primitive@>
+mp_primitive(mp, "charht", mp_internal_command, mp_char_ht_internal);
+@:mp_char_ht_}{|charht| primitive@>
+mp_primitive(mp, "chardp", mp_internal_command, mp_char_dp_internal);
+@:mp_char_dp_}{|chardp| primitive@>
+mp_primitive(mp, "charic", mp_internal_command, mp_char_ic_internal);
+@:mp_char_ic_}{|charic| primitive@>
+mp_primitive(mp, "pausing", mp_internal_command, mp_pausing_internal);
+@:mp_pausing_}{|pausing| primitive@>
+mp_primitive(mp, "showstopping", mp_internal_command, mp_showstopping_internal);
+@:mp_showstopping_}{|showstopping| primitive@>
+mp_primitive(mp, "texscriptmode", mp_internal_command, mp_texscriptmode_internal);
+@:mp_texscriptmode_}{|texscriptmode| primitive@>
+mp_primitive(mp, "overloadmode", mp_internal_command, mp_overloadmode_internal);
+@:mp_overloadmode_}{|overloadmode| primitive@>
+mp_primitive(mp, "linejoin", mp_internal_command, mp_linejoin_internal);
+@:mp_linejoin_}{|linejoin| primitive@>
+mp_primitive(mp, "linecap", mp_internal_command, mp_linecap_internal);
+@:mp_linecap_}{|linecap| primitive@>
+mp_primitive(mp, "stacking", mp_internal_command, mp_stacking_internal);
+@:mp_stacking_}{|stacking| primitive@>
+mp_primitive(mp, "miterlimit", mp_internal_command, mp_miterlimit_internal);
+@:mp_miterlimit_}{|miterlimit| primitive@>
+mp_primitive(mp, "warningcheck", mp_internal_command, mp_warning_check_internal);
+@:mp_warning_check_}{|warningcheck| primitive@>
+mp_primitive(mp, "truecorners", mp_internal_command, mp_true_corners_internal);
+@:mp_true_corners_}{|truecorners| primitive@>
+mp_primitive(mp, "defaultcolormodel", mp_internal_command, mp_default_color_model_internal);
+@:mp_default_color_model_}{|defaultcolormodel| primitive@>
+mp_primitive(mp, "restoreclipcolor", mp_internal_command, mp_restore_clip_color_internal);
+@:mp_restore_clip_color_}{|restoreclipcolor| primitive@>
+mp_primitive(mp, "numbersystem", mp_internal_command, mp_number_system_internal);
+@:mp_number_system_}{|numbersystem| primitive@>
+mp_primitive(mp, "numberprecision", mp_internal_command, mp_number_precision_internal);
+@:mp_number_precision_}{|numberprecision| primitive@>
+mp_primitive(mp, "jobname", mp_internal_command, mp_job_name_internal);
+@:mp_job_name_}{|jobname| primitive@>
+
+@ Colors can be specified in four color models. In the special case of
+|no_model|, MetaPost does not output any color operator to the postscript output.
+
+Note: these values are passed directly on to |with_option|. This only works
+because the other possible values passed to |with_option| are 8 and 10
+respectively (from |with_pen| and |with_picture|).
+
+There is a first state, that is only used for |gs_colormodel|. It flags the fact
+that there has not been any kind of color specification by the user so far in the
+game.
+
+@<MPlib header stuff@>=
+typedef enum mp_color_model {
+ mp_no_model,
+ mp_grey_model,
+ mp_rgb_model,
+ mp_cmyk_model,
+ mp_uninitialized_model,
+} mp_color_model;
+
+@ @<Initialize table entries@>=
+number_clone(internal_value(mp_default_color_model_internal),unity_t);
+number_multiply_int(internal_value(mp_default_color_model_internal), mp_rgb_model);
+number_clone(internal_value(mp_restore_clip_color_internal), unity_t);
+set_internal_string(mp_number_system_internal, mp_intern (mp, "scaled"));
+number_clone(internal_value(mp_number_precision_internal), precision_default);
+number_clone(internal_value(mp_texscriptmode_internal), unity_t);
+number_clone(internal_value(mp_overloadmode_internal), zero_t);
+
+@ Well, we do have to list the names one more time, for use in symbolic
+printouts.
+
+@<Initialize table...@>=
+set_internal_name(mp_tracing_titles_internal, mp_strdup("tracingtitles"));
+set_internal_name(mp_tracing_equations_internal, mp_strdup("tracingequations"));
+set_internal_name(mp_tracing_capsules_internal, mp_strdup("tracingcapsules"));
+set_internal_name(mp_tracing_choices_internal, mp_strdup("tracingchoices"));
+set_internal_name(mp_tracing_specs_internal, mp_strdup("tracingspecs"));
+set_internal_name(mp_tracing_commands_internal, mp_strdup("tracingcommands"));
+set_internal_name(mp_tracing_restores_internal, mp_strdup("tracingrestores"));
+set_internal_name(mp_tracing_macros_internal, mp_strdup("tracingmacros"));
+set_internal_name(mp_tracing_output_internal, mp_strdup("tracingoutput"));
+set_internal_name(mp_tracing_stats_internal, mp_strdup("tracingstats"));
+set_internal_name(mp_tracing_online_internal, mp_strdup("tracingonline"));
+set_internal_name(mp_year_internal, mp_strdup("year"));
+set_internal_name(mp_month_internal, mp_strdup("month"));
+set_internal_name(mp_day_internal, mp_strdup("day"));
+set_internal_name(mp_time_internal, mp_strdup("time"));
+set_internal_name(mp_hour_internal, mp_strdup("hour"));
+set_internal_name(mp_minute_internal, mp_strdup("minute"));
+set_internal_name(mp_char_code_internal, mp_strdup("charcode"));
+set_internal_name(mp_char_wd_internal, mp_strdup("charwd"));
+set_internal_name(mp_char_ht_internal, mp_strdup("charht"));
+set_internal_name(mp_char_dp_internal, mp_strdup("chardp"));
+set_internal_name(mp_char_ic_internal, mp_strdup("charic"));
+set_internal_name(mp_pausing_internal, mp_strdup("pausing")); /* dummy */
+set_internal_name(mp_showstopping_internal, mp_strdup("showstopping"));
+set_internal_name(mp_texscriptmode_internal, mp_strdup("texscriptmode"));
+set_internal_name(mp_overloadmode_internal, mp_strdup("overloadmode"));
+set_internal_name(mp_linejoin_internal, mp_strdup("linejoin"));
+set_internal_name(mp_linecap_internal, mp_strdup("linecap"));
+set_internal_name(mp_stacking_internal, mp_strdup("stacking"));
+set_internal_name(mp_miterlimit_internal, mp_strdup("miterlimit"));
+set_internal_name(mp_warning_check_internal, mp_strdup("warningcheck"));
+set_internal_name(mp_true_corners_internal, mp_strdup("truecorners"));
+set_internal_name(mp_default_color_model_internal, mp_strdup("defaultcolormodel"));
+set_internal_name(mp_restore_clip_color_internal, mp_strdup("restoreclipcolor"));
+set_internal_name(mp_job_name_internal, mp_strdup("jobname"));
+set_internal_name(mp_number_system_internal, mp_strdup("numbersystem"));
+set_internal_name(mp_number_precision_internal, mp_strdup("numberprecision"));
+
+@ The following procedure, which is called just before \MP\ initializes its input
+and output, establishes the initial values of the date and time. @^system
+dependencies@>
+
+Note that the values are |scaled| integers. Hence \MP\ can no longer be used
+after the year 32767.
+
+@c
+static void mp_fix_date_and_time (MP mp)
+{
+ time_t aclock = time ((time_t *) 0);
+ struct tm *tmptr = localtime (&aclock);
+ number_clone(internal_value(mp_time_internal), unity_t);
+ number_multiply_int(internal_value(mp_time_internal), (tmptr->tm_hour * 60 + tmptr->tm_min));
+ number_clone(internal_value(mp_hour_internal), unity_t);
+ number_multiply_int(internal_value(mp_hour_internal), (tmptr->tm_hour));
+ number_clone(internal_value(mp_minute_internal), unity_t);
+ number_multiply_int(internal_value(mp_minute_internal), (tmptr->tm_min));
+ number_clone(internal_value(mp_day_internal), unity_t);
+ number_multiply_int(internal_value(mp_day_internal), (tmptr->tm_mday));
+ number_clone(internal_value(mp_month_internal), unity_t);
+ number_multiply_int(internal_value(mp_month_internal), (tmptr->tm_mon + 1));
+ number_clone(internal_value(mp_year_internal), unity_t);
+ number_multiply_int(internal_value(mp_year_internal), (tmptr->tm_year + 1900));
+}
+
+@ @<Declarations@>=
+static void mp_fix_date_and_time (MP mp);
+
+@ \MP\ is occasionally supposed to print diagnostic information that goes only
+into the transcript file, unless |mp_tracing_online| is positive. Now that we
+have defined |mp_tracing_online| we can define two routines that adjust the
+destination of print commands:
+
+@<Declarations@>=
+static void mp_begin_diagnostic (MP mp);
+static void mp_end_diagnostic (MP mp, int blank_line);
+static void mp_print_diagnostic (MP mp, const char *s, const char *t, int nuline);
+
+@ @c
+static void mp_begin_diagnostic (MP mp)
+{
+ /* prepare to do some tracing */
+ mp->old_selector = mp->selector;
+ if (number_nonpositive(internal_value(mp_tracing_online_internal)) && (mp->selector == mp_term_and_log_selector)) {
+ mp->selector = mp_log_only_selector;
+ if (mp->history == mp_spotless) {
+ mp->history = mp_warning_issued;
+ }
+ }
+}
+
+void mp_end_diagnostic (MP mp, int blank_line)
+{
+ /* restore proper conditions after tracing */
+ mp_print_nl(mp, "");
+ if (blank_line) {
+ mp_print_ln(mp);
+ }
+ mp->selector = mp->old_selector;
+}
+
+@ @<Glob...@>=
+unsigned int old_selector;
+
+@ We will occasionally use |begin_diagnostic| in connection with line-number
+printing, as follows. (The parameter |s| is typically |"Path"| or |"Cycle spec"|,
+etc.)
+
+@c
+static void mp_print_diagnostic (MP mp, const char *s, const char *t, int nuline)
+{
+ mp_begin_diagnostic(mp);
+ if (nuline) {
+ mp_print_nl(mp, s);
+ } else {
+ mp_print_str(mp, s);
+ }
+ mp_print_str(mp, " at line ");
+ mp_print_int(mp, mp_true_line(mp));
+ mp_print_str(mp, t);
+ mp_print_chr(mp, ':');
+}
+
+@ The 256 |unsigned char| characters are grouped into classes by means of the
+|char_class| table. Individual class numbers have no semantic or syntactic
+significance, except in a few instances defined here. There's also |max_class|,
+which can be used as a basis for additional class numbers in nonstandard
+extensions of \MP.
+
+@<Enumeration types@>=
+typedef enum mp_class_codes {
+ mp_digit_class = 0, /* the class number of |0123456789| */
+ mp_period_class = 1, /* the class number of |.| */
+ mp_space_class = 2, /* the class number of spaces and nonstandard characters */
+ mp_percent_class = 3, /* the class number of `\.\%' */
+ mp_string_class = 4, /* the class number of |"| */
+ mp_comma_class = 5, /* the , */
+ mp_semicolon_class = 6, /* the ; */
+ mp_left_parenthesis_class = 7, /* the class number of |(| */
+ mp_right_parenthesis_class = 8, /* the class number of |)| */
+ mp_letter_class = 9, /* letters and the underline character */
+ mp_suffix_class = 15,
+ mp_left_bracket_class = 17, /* |[| */
+ mp_right_bracket_class = 18, /* |]| */
+ mp_brace_class = 19,
+ mp_invalid_class = 20, /* bad character in the input */
+ mp_max_class = 20, /* the largest class number */
+} mp_class_codes;
+
+@ The class numbers:
+
+@<Glob...@>=
+int char_class[256];
+
+@ If changes are made to accommodate non-ASCII character sets, they should follow
+the guidelines in Appendix~C of {\sl The {\logos METAFONT}book}.
+@:METAFONTbook}{\sl The {\logos METAFONT}book@> @^system dependencies@>
+
+@<Set initial ...@>=
+for (int k = '0'; k <= '9'; k++) {
+ mp->char_class[k] = mp_digit_class;
+}
+for (int k = 'A'; k <= 'Z'; k++) {
+ mp->char_class[k] = mp_letter_class;
+}
+for (int k = 'a'; k <= 'z'; k++) {
+ mp->char_class[k] = mp_letter_class;
+}
+
+mp->char_class['.'] = mp_period_class;
+mp->char_class[' '] = mp_space_class;
+mp->char_class['%'] = mp_percent_class;
+mp->char_class['"'] = mp_string_class;
+mp->char_class[','] = mp_comma_class;
+mp->char_class[';'] = mp_semicolon_class;
+mp->char_class['('] = mp_left_parenthesis_class;
+mp->char_class[')'] = mp_right_parenthesis_class;
+
+mp->char_class['_'] = mp_letter_class;
+mp->char_class['<'] = 10;
+mp->char_class['='] = 10;
+mp->char_class['>'] = 10;
+mp->char_class[':'] = 10;
+mp->char_class['|'] = 10;
+mp->char_class['`'] = 11;
+mp->char_class['\''] = 11;
+mp->char_class['+'] = 12;
+mp->char_class['-'] = 12;
+mp->char_class['/'] = 13;
+mp->char_class['*'] = 13;
+mp->char_class['\\'] = 13;
+mp->char_class['^'] = 13;
+mp->char_class['!'] = 14;
+mp->char_class['?'] = 14;
+mp->char_class['#'] = mp_suffix_class;
+mp->char_class['&'] = mp_suffix_class;
+mp->char_class['@@'] = mp_suffix_class; /* will become one after cwebbing */
+mp->char_class['$'] = mp_suffix_class;
+mp->char_class['^'] = 16;
+mp->char_class['~'] = 16;
+mp->char_class['['] = mp_left_bracket_class;
+mp->char_class[']'] = mp_right_bracket_class;
+mp->char_class['{'] = mp_brace_class;
+mp->char_class['}'] = mp_brace_class;
+
+for (int k = 0; k < ' '; k++) {
+ mp->char_class[k] = mp_invalid_class;
+}
+
+mp->char_class['\r'] = mp_space_class;
+mp->char_class['\n'] = mp_space_class;
+mp->char_class['\t'] = mp_space_class;
+mp->char_class['\f'] = mp_space_class;
+
+for (int k = 127; k <= 255; k++) {
+ mp->char_class[k] = mp->utf8_mode ? mp_letter_class : mp_invalid_class;
+}
+
+if (mp->text_mode) {
+ mp->char_class[2] = mp_string_class; /* ascii 2 STX*/
+ /* mp->char_class[3] = mp_string_class; */ /* ascii 3 ETX */
+}
+
+@* The hash table.
+
+Symbolic tokens are stored in and retrieved from an AVL tree. This is not as fast
+as an actual hash table, but it is easily extensible.
+
+A symbolic token contains a pointer to the |mp_string| that contains the string
+representation of the symbol, a |halfword| that holds the current command value
+of the token, and an |mp_value| for the associated equivalent.
+
+@d set_text(A) {
+ (A)->text = (B) ;
+}
+
+@d set_eq_type(A,B) {
+ (A)->type = (B) ;
+}
+
+@d set_eq_property(A,B) {
+ (A)->property = (B) ;
+}
+
+@d set_equiv(A,B) {
+ (A)->v.data.node = NULL ;
+ (A)->v.data.indep.serial = (B);
+}
+
+@d set_equiv_node(A,B) {
+ (A)->v.data.node = (B) ;
+ (A)->v.data.indep.serial = 0;
+}
+
+@d set_equiv_sym(A,B) {
+ (A)->v.data.node = (mp_node) (B);
+ (A)->v.data.indep.serial = 0;
+}
+
+@ @c
+# define text(A) (A)->text
+# define eq_type(A) (A)->type
+# define eq_property(A) (A)->property
+# define equiv(A) (A)->v.data.indep.serial
+# define equiv_node(A) (A)->v.data.node
+# define equiv_sym(A) (mp_sym)(A)->v.data.node
+
+@ @<Types...@>=
+typedef struct mp_symbol_entry {
+ int type;
+ int property; /* we had padding room anyway */
+ mp_value v;
+ mp_string text;
+ void *parent;
+} mp_symbol_entry;
+
+@ @<Glob...@>=
+int st_count; /* total number of known identifiers */
+avl_tree symbols; /* avl tree of symbolic tokens */
+avl_tree frozen_symbols; /* avl tree of frozen symbolic tokens */
+avl_iterator symbol_iterator;
+
+mp_sym frozen_bad_vardef;
+mp_sym frozen_colon;
+mp_sym frozen_end_def;
+mp_sym frozen_end_for;
+mp_sym frozen_end_group;
+mp_sym frozen_etex;
+mp_sym frozen_fi;
+mp_sym frozen_inaccessible;
+mp_sym frozen_left_bracket;
+mp_sym frozen_repeat_loop;
+mp_sym frozen_right_delimiter;
+mp_sym frozen_semicolon;
+mp_sym frozen_slash;
+mp_sym frozen_undefined;
+mp_sym frozen_dump;
+
+@ Here are the functions needed for the avl construction.
+
+@<Declarations@>=
+static int mp_compare_symbols_entry (void *p, const void *pa, const void *pb);
+static void *mp_copy_symbols_entry (const void *p);
+static void *mp_delete_symbols_entry (void *p);
+
+@ The avl comparison function is a straightword version of |strcmp|,
+except that checks for the string lengths first.
+
+@c
+static int mp_compare_symbols_entry (void *p, const void *pa, const void *pb)
+{
+ const mp_symbol_entry *a = (const mp_symbol_entry *) pa;
+ const mp_symbol_entry *b = (const mp_symbol_entry *) pb;
+ (void) p;
+ if (a->text->len != b->text->len) {
+ return (a->text->len > b->text->len ? 1 : -1);
+ }
+ return strncmp ((const char *) a->text->str, (const char *) b->text->str, a->text->len);
+}
+
+@ Copying a symbol happens when an item is inserted into an AVL tree. The |text|
+and |mp_number| needs to be deep copied, every thing else can be reassigned.
+
+@c
+static void *mp_copy_symbols_entry (const void *p)
+{
+ // const mp_symbol_entry *fp = (const mp_symbol_entry *) p;
+ mp_symbol_entry *fp = (mp_symbol_entry *) p;
+ MP mp = (MP)fp->parent;
+ mp_sym ff = mp_memory_allocate(sizeof(mp_symbol_entry));
+ if (ff == NULL) {
+ return NULL;
+ }
+ ff->text = mp_aux_copy_strings_entry(fp->text);
+ if (ff->text == NULL) {
+ return NULL;
+ }
+ ff->v = fp->v;
+ ff->type = fp->type;
+ ff->property = fp->property;
+ ff->parent = mp;
+ new_number_clone(ff->v.data.n, fp->v.data.n);
+ return ff;
+}
+
+@ In the current implementation, symbols are not freed until the end of the run.
+
+@c
+static void *mp_delete_symbols_entry (void *p)
+{
+ mp_sym ff = (mp_sym) p;
+ MP mp = (MP) ff->parent;
+ free_number(ff->v.data.n);
+ mp_memory_free(ff->text->str);
+ mp_memory_free(ff->text);
+ mp_memory_free(ff);
+ return NULL;
+}
+
+@ @<Allocate or initialize ...@>=
+mp->symbols = avl_create(mp_compare_symbols_entry, mp_copy_symbols_entry, mp_delete_symbols_entry, mp_memory_allocate, mp_memory_free, NULL);
+mp->frozen_symbols = avl_create(mp_compare_symbols_entry, mp_copy_symbols_entry, mp_delete_symbols_entry, mp_memory_allocate, mp_memory_free, NULL);
+
+@ @<Dealloc variables@>=
+if (mp->symbols != NULL) {
+ avl_destroy (mp->symbols);
+}
+if (mp->frozen_symbols != NULL) {
+ avl_destroy (mp->frozen_symbols);
+}
+
+@ Actually creating symbols is done by |id_lookup|, but in order to do so it
+needs a way to create a new, empty symbol structure.
+
+@<Declarations@>=
+static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len);
+
+@ @c
+static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len)
+{
+ mp_sym ff = mp_memory_clear_allocate(sizeof(mp_symbol_entry));
+ ff->parent = mp;
+ ff->text = mp_memory_allocate(sizeof(mp_lstring));
+ ff->text->str = nam;
+ ff->text->len = len;
+ ff->type = mp_tag_command;
+ ff->v.type = mp_known_type;
+ new_number(ff->v.data.n);
+ return ff;
+}
+
+@ There is one global variable so that |id_lookup| does not always have to create
+a new entry just for testing. This is not freed because it creates a double-free
+thanks to the |NULL| init.
+
+@<Global ...@>=
+mp_sym id_lookup_test;
+
+@ @<Initialize table entries@>=
+mp->id_lookup_test = new_symbols_entry(mp, NULL, 0);
+
+@ Certain symbols are \quote {frozen} and not redefinable, since they are used in
+error recovery.
+
+@<Initialize table entries@>=
+mp->st_count = 0;
+mp->frozen_bad_vardef = mp_frozen_primitive(mp, "a bad variable", mp_tag_command, 0);
+mp->frozen_right_delimiter = mp_frozen_primitive(mp, ")", mp_right_delimiter_command, 0);
+mp->frozen_inaccessible = mp_frozen_primitive(mp, " INACCESSIBLE", mp_tag_command, 0);
+mp->frozen_undefined = mp_frozen_primitive(mp, " UNDEFINED", mp_tag_command, 0);
+
+@ Here is the subroutine that searches the avl tree for an identifier that
+matches a given string of length~|l| appearing in |buffer[j.. (j+l-1)]|. If the
+identifier is not found, it is inserted if |insert_new| is |true|, and the
+corresponding symbol will be returned.
+
+There are two variations on the lookup function: one for the normal symbol table,
+and one for the table of error recovery symbols.
+
+Note: simple symbols like |+|, |-|, |*| and |/| are also looked up. One can argue
+that a user can redefine them but colons etc. are interpreted direct. Maybe
+there's room for some optimization here. We could just put references (to
+|mp_sym|) in the |mp| instance object for the handful. Okay, we also have |:=| so
+maybe only for single character ones ... not worth the trouble.
+
+@d mp_id_lookup(A,B,C,D) mp_do_id_lookup((A), mp->symbols, (B), (C), (D))
+
+@c
+static mp_sym mp_do_id_lookup (MP mp, avl_tree symbols, char *j, size_t l, int insert_new)
+{
+ mp_sym str;
+ mp->id_lookup_test->text->str = (unsigned char *) j;
+ mp->id_lookup_test->text->len = l;
+ str = (mp_sym) avl_find(mp->id_lookup_test, symbols);
+ if (str == NULL && insert_new) {
+ unsigned char *nam = (unsigned char *) mp_strndup(j, l);
+ mp_sym s = new_symbols_entry(mp, nam, l);
+ mp->st_count++;
+ avl_ins(s, symbols, avl_false);
+ str = (mp_sym) avl_find(s, symbols);
+ mp_delete_symbols_entry(s);
+ }
+ return str;
+}
+
+@ @<Exported function headers@>=
+extern int mp_initialize_symbol_traverse (MP mp);
+extern void mp_kill_symbol_traverse (MP mp);
+extern void *mp_fetch_symbol_traverse (MP mp);
+extern void *mp_fetch_symbol (MP mp, char *s);
+
+@ @c
+int mp_initialize_symbol_traverse (MP mp)
+{
+ mp->symbol_iterator = avl_iterator_new(mp->symbols, AVL_ITERATOR_INI_PRE);
+ return (mp->symbol_iterator != NULL);
+}
+
+void mp_kill_symbol_traverse (MP mp)
+{
+ avl_iterator_kill(mp->symbol_iterator);
+}
+
+void *mp_fetch_symbol_traverse (MP mp)
+{
+ return avl_iterator_next(mp->symbol_iterator);
+}
+
+void *mp_fetch_symbol (MP mp, char *s)
+{
+ return mp_id_lookup(mp, s, strlen(s), 0);
+}
+
+@ We need to put \MP's \quote {primitive} symbolic tokens into the hash table,
+together with their command code (which will be the |eq_type|) and an operand
+(which will be the |equiv|). The |primitive| procedure does this, in a way that
+no \MP\ user can. The global value |cur_sym| contains the new |eqtb| pointer
+after |primitive| has acted.
+
+@c
+static void mp_primitive (MP mp, const char *ss, int c, int o)
+{
+// char *s = mp_strdup(ss);
+// set_cur_sym(mp_id_lookup(mp, s, strlen(s), 1));
+// mp_memory_free(s);
+ set_cur_sym(mp_id_lookup(mp, (char *) ss, strlen(ss), 1));
+ set_eq_type(cur_sym, c);
+ set_eq_property(cur_sym, 0x1); /* todo: enumeration values */
+ set_equiv(cur_sym, o);
+}
+
+@ Some other symbolic tokens only exist for error recovery.
+
+@c
+static mp_sym mp_frozen_primitive (MP mp, const char *ss, int c, int o)
+{
+// char *s = mp_strdup(ss);
+// mp_sym str = mp_do_id_lookup(mp, mp->frozen_symbols, s, strlen(s), 1);
+// mp_memory_free(s);
+ mp_sym str = mp_do_id_lookup(mp, mp->frozen_symbols, (char *) ss, strlen(ss), 1);
+ str->type = c;
+ str->property = 0x1; /* todo: enumeration values */
+ str->v.data.indep.serial = o;
+ return str;
+}
+
+@ This routine returns |true| if the argument is an un-redefinable symbol because
+it is one of the error recovery tokens (as explained elsewhere,
+|frozen_inaccessible| actuall is redefinable).
+
+@c
+static int mp_is_frozen (MP mp, mp_sym sym)
+{
+ mp_sym temp = mp_do_id_lookup(mp, mp->frozen_symbols, (char *) sym->text->str, sym->text->len, 0);
+ if (temp == mp->frozen_inaccessible) {
+ return 0;
+ } else {
+ return (temp == sym);
+ }
+}
+
+@ Many of \MP's primitives need no |equiv|, since they are identifiable by their
+|eq_type| alone. These primitives are loaded into the hash table as follows:
+
+@<Put each of \MP's primitives into the hash table@>=
+mp_primitive(mp, "..", mp_path_join_command, 0);
+@:.._}{|..| primitive@>
+mp_primitive(mp, "[", mp_left_bracket_command, 0);
+mp->frozen_left_bracket = mp_frozen_primitive (mp, "[", mp_left_bracket_command, 0);
+@:[ }{|[| primitive@>
+mp_primitive(mp, "]", mp_right_bracket_command, 0);
+@:] }{|]| primitive@>
+mp_primitive(mp, "}", mp_right_brace_command, 0);
+@:]]}{|\char`\|} primitive@>
+mp_primitive(mp, "{", mp_left_brace_command, 0);
+@:][}{|\char`\{| primitive@>
+mp_primitive(mp, ":", mp_colon_command, 0);
+mp->frozen_colon = mp_frozen_primitive (mp, ":", mp_colon_command, 0);
+@:: }{|:| primitive@>
+mp_primitive(mp, ":=", mp_assignment_command, 0);
+@::=_}{|:=| primitive@>
+mp_primitive(mp, ",", mp_comma_command, 0);
+@:, }{\., primitive@>
+mp_primitive(mp, ";", mp_semicolon_command, 0);
+mp->frozen_semicolon = mp_frozen_primitive (mp, ";", mp_semicolon_command, 0);
+@:; }{\.; primitive@>
+mp_primitive(mp, "\\", mp_relax_command, 0);
+@:]]\||\char`\\| primitive@>
+mp_primitive(mp, "addto", mp_add_to_command, 0);
+@:add_to_|{|addto| primitive@>
+mp_primitive(mp, "atleast", mp_at_least_command, 0);
+@:at_least_}{|atleast| primitive@>
+mp_primitive(mp, "begingroup", mp_begin_group_command, 0);
+mp->bg_loc = cur_sym;
+@:begin_group_}{|begingroup| primitive@>
+mp_primitive(mp, "controls", mp_controls_command, 0);
+@:controls_}{|controls| primitive@>
+mp_primitive(mp, "curl", mp_curl_command, 0);
+@:curl_}{|curl| primitive@>
+mp_primitive(mp, "delimiters", mp_delimiters_command, 0);
+@:delimiters_}{|delimiters| primitive@>
+mp_primitive(mp, "endgroup", mp_end_group_command, 0);
+
+mp->eg_loc = cur_sym;
+mp->frozen_end_group = mp_frozen_primitive (mp, "endgroup", mp_end_group_command, 0);
+
+@:endgroup_}{|endgroup| primitive@>
+mp_primitive(mp, "everyjob", mp_every_job_command, 0);
+@:every_job_}{|everyjob| primitive@>
+mp_primitive(mp, "exitif", mp_exit_test_command, 0);
+@:exit_if_}{|exitif| primitive@>
+mp_primitive(mp, "expandafter", mp_expand_after_command, 0);
+@:expand_after_}{|expandafter| primitive@>
+mp_primitive(mp, "interim", mp_interim_command, 0);
+@:interim_}{|interim| primitive@>
+mp_primitive(mp, "let", mp_let_command, 0);
+@:let_}{|let| primitive@>
+mp_primitive(mp, "newinternal", mp_new_internal_command, 0);
+@:new_internal_}{|newinternal| primitive@>
+mp_primitive(mp, "of", mp_of_command, 0);
+@:of_}{|of| primitive@>
+mp_primitive(mp, "randomseed", mp_only_set_command, mp_random_seed_code);
+@:mp_random_seed_}{|randomseed| primitive@>
+mp_primitive(mp, "maxknotpool", mp_only_set_command, mp_max_knot_pool_code);
+@:mp_max_knot_pool_}{|maxknotpool| primitive@>
+mp_primitive(mp, "save", mp_save_command, 0);
+@:save_}{|save| primitive@>
+mp_primitive(mp, "scantokens", mp_scan_tokens_command, 0);
+@:scan_tokens_}{|scantokens| primitive@>
+mp_primitive(mp, "runscript", mp_runscript_command, 0);
+@:run_script_}{|runscript| primitive@>
+mp_primitive(mp, "maketext", mp_maketext_command, 0);
+@:make_text_}{|maketext| primitive@>
+mp_primitive(mp, "shipout", mp_ship_out_command, 0);
+@:ship_out_}{|shipout| primitive@>
+mp_primitive(mp, "step", mp_step_command, 0);
+@:step_}{|step| primitive@>
+mp_primitive(mp, "str", mp_str_command, 0);
+@:str_}{|str| primitive@>
+mp_primitive(mp, "void", mp_void_command, 0);
+@:void_}{|void| primitive@>
+mp_primitive(mp, "tension", mp_tension_command, 0);
+@:tension_}{|tension| primitive@>
+mp_primitive(mp, "to", mp_to_command, 0);
+@:to_}{|to| primitive@>
+mp_primitive(mp, "until", mp_until_command, 0);
+@:until_}{|until| primitive@>
+mp_primitive(mp, "within", mp_within_command, 0);
+@:within_}{|within| primitive@>
+mp_primitive(mp, "write", mp_write_command, 0);
+@:write_}{|write| primitive@>
+
+@ Each primitive has a corresponding inverse, so that it is possible to display
+the cryptic numeric contents of |eqtb| in symbolic form. Every call of
+|primitive| in this program is therefore accompanied by some straightforward code
+that forms part of the |print_cmd_mod| routine explained below.
+
+@<Cases of |print_cmd_mod| for symbolic printing of primitives@>=
+case mp_add_to_command: return "addto";
+case mp_assignment_command: return ":=";
+case mp_at_least_command: return "atleast";
+case mp_begin_group_command: return "begingroup";
+case mp_colon_command: return ":";
+case mp_comma_command: return ",";
+case mp_controls_command: return "controls";
+case mp_curl_command: return "curl";
+case mp_delimiters_command: return "delimiters";
+case mp_end_group_command: return "endgroup";
+case mp_every_job_command: return "everyjob";
+case mp_exit_test_command: return "exitif";
+case mp_expand_after_command: return "expandafter";
+case mp_interim_command: return "interim";
+case mp_left_brace_command: return "{";
+case mp_left_bracket_command: return "[";
+case mp_let_command: return "let";
+case mp_new_internal_command: return "newinternal";
+case mp_of_command: return "of";
+case mp_path_join_command: return "..";
+case mp_relax_command: return "\\";
+case mp_right_brace_command: return "}";
+case mp_right_bracket_command: return "]";
+case mp_save_command: return "save";
+case mp_scan_tokens_command: return "scantokens";
+case mp_runscript_command: return "runscript";
+case mp_maketext_command: return "maketext";
+case mp_semicolon_command: return ";";
+case mp_ship_out_command: return "shipout";
+case mp_step_command: return "step";
+case mp_str_command: return "str";
+case mp_void_command: return "void";
+case mp_tension_command: return "tension";
+case mp_to_command: return "to";
+case mp_until_command: return "until";
+case mp_within_command: return "within";
+case mp_write_command: return "write";
+
+@ We will deal with the other primitives later, at some point in the program
+where their |eq_type| and |equiv| values are more meaningful. For example, the
+primitives for macro definitions will be loaded when we consider the routines
+that define macros. It is easy to find where each particular primitive was
+treated by looking in the index at the end; for example, the section where
+|"def"| entered |eqtb| is listed under `|def| primitive'.
+
+@* Token lists.
+
+A \MP\ token is either symbolic or numeric or a string, or it denotes a macro
+parameter or capsule or an internal; so there are six corresponding ways to
+encode it internally: @^token@>
+
+(1)~A symbolic token for symbol |p| is represented by the pointer |p|, in the
+|sym_sym| field of a symbolic node in~|mem|. The |type| field is |symbol_node|;
+and it has a |name_type| to differentiate various subtypes of symbolic tokens,
+which is usually |normal_sym|, but |macro_sym| for macro names.
+
+(2)~A numeric token whose |scaled| value is~|v| is represented in a non-symbolic
+node of~|mem|; the |type| field is |known|, the |name_type| field is |token|, and
+the |value| field holds~|v|.
+
+(3)~A string token is also represented in a non-symbolic node; the |type| field
+is |mp_string_type|, the |name_type| field is |token|, and the |value| field
+holds the corresponding |mp_string|.
+
+(4)~Capsules have |name_type=capsule|, and their |type| and |value| fields
+represent arbitrary values, with |type| different from |symbol_node| (in ways to
+be explained later).
+
+(5)~Macro parameters appear in |sym_info| fields of symbolic nodes. The |type|
+field is |symbol_node|; the $k$th parameter is represented by |k| in |sym_info|;
+and |expr_sym| in |name_type|, if it is of type |expr|, or |suffix_sym| if it
+is of type |suffix|, or by |text_sym| if it is of type |text|.
+
+(6)~The $k$th internal is also represented by |k| in |sym_info|; the |type| field
+is |symbol_node| as for the other symbolic tokens; and |internal_sym| is its
+|name_type|;
+
+Actual values of the parameters and internals are kept in a separate stack, as we
+will see later.
+
+Note that the |type| field of a node has nothing to do with \quote {type} in a
+printer's sense. It's curious that the same word is used in such different ways.
+
+@d mp_set_value_sym(A,B) do_set_value_sym (mp, (mp_token_node) (A), (B))
+@d mp_set_value_number(A,B) do_set_value_number(mp, (mp_token_node) (A), &(B))
+@d mp_set_value_node(A,B) do_set_value_node (mp, (mp_token_node) (A), (B))
+@d mp_set_value_str(A,B) do_set_value_str (mp, (mp_token_node) (A), (B))
+@d mp_set_value_knot(A,B) do_set_value_knot (mp, (mp_token_node) (A), (B))
+
+@<MPlib internal header stuff@>=
+typedef struct mp_node_data *mp_token_node;
+
+@ @c
+# define mp_get_value_sym(A) ((mp_token_node) (A))->data.sym
+# define mp_get_value_number(A) ((mp_token_node) (A))->data.n
+# define mp_get_value_node(A) ((mp_token_node) (A))->data.node
+# define mp_get_value_str(A) ((mp_token_node) (A))->data.str
+# define mp_get_value_knot(A) ((mp_token_node) (A))->data.p
+
+inline static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B)
+{
+ (void) mp;
+ A->data.sym=(B);
+}
+
+inline static void do_set_value_number (MP mp, mp_token_node A, mp_number *B)
+{
+ (void) mp;
+ A->data.p = NULL;
+ A->data.str = NULL;
+ A->data.node = NULL;
+ number_clone(A->data.n, *B);
+}
+
+inline static void do_set_value_str (MP mp, mp_token_node A, mp_string B)
+{
+ (void) mp;
+ A->data.p = NULL;
+ A->data.str = (B);
+ add_str_ref((B));
+ A->data.node = NULL;
+ number_clone(A->data.n, zero_t);
+}
+
+inline static void do_set_value_node (MP mp, mp_token_node A, mp_node B)
+{
+ (void) mp;
+ /* store the value in a large token node */
+ A->data.p = NULL;
+ A->data.str = NULL;
+ A->data.node = B;
+ number_clone(A->data.n, zero_t);
+}
+
+inline static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B)
+{
+ (void) mp;
+ A->data.p = (B);
+ A->data.str = NULL;
+ A->data.node = NULL;
+ number_clone(A->data.n, zero_t);
+}
+
+@ @<Declarations@>=
+inline static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B);
+inline static void do_set_value_number (MP mp, mp_token_node A, mp_number *B);
+inline static void do_set_value_str (MP mp, mp_token_node A, mp_string B);
+inline static void do_set_value_node (MP mp, mp_token_node A, mp_node B);
+inline static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B);
+
+@ @c
+static mp_node mp_new_token_node (MP mp)
+{
+ mp_node p;
+ if (mp->token_nodes) {
+ p = mp->token_nodes;
+ mp->token_nodes = p->link;
+ mp->num_token_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_node_data));
+ new_number(p->data.n);
+ p->hasnumber = 1;
+ }
+ p->type = mp_token_node_type;
+ return (mp_node) p;
+}
+
+@ @c
+static void mp_free_token_node (MP mp, mp_node p)
+{
+ if (p) {
+ if (mp->num_token_nodes < max_num_token_nodes) {
+ p->link = mp->token_nodes;
+ mp->token_nodes = p;
+ mp->num_token_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_node_data);
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(((mp_value_node) p)->data.n);
+ }
+ mp_memory_free(p);
+ }
+ }
+}
+
+@ @<Declarations@>=
+static void mp_free_token_node (MP mp, mp_node p);
+
+@ A numeric token is created by the following trivial routine.
+
+@c
+static mp_node mp_new_num_tok (MP mp, mp_number *v)
+{
+ mp_node p = mp_new_token_node(mp);
+ mp_set_value_number(p, *v);
+ p->type = mp_known_type;
+ p->name_type = mp_token_operation;
+ return p;
+}
+
+@ @<Declarations@>=
+static void mp_flush_token_list (MP mp, mp_node p);
+
+@ A token list is a singly linked list of nodes in |mem|, where each node
+contains a token and a link. Here's a subroutine that gets rid of a token list
+when it is no longer needed.
+
+@c
+static void mp_flush_token_list (MP mp, mp_node p)
+{
+ while (p != NULL) {
+ mp_node q = p; /* the node being recycled */
+ p = mp_link(p);
+ switch (mp_type(q)) {
+ case mp_symbol_node_type:
+ mp_free_symbolic_node(mp, q);
+ continue;
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_known_type:
+ break;
+ case mp_string_type:
+ delete_str_ref(mp_get_value_str(q));
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ case mp_pair_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_transform_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ mp_recycle_value(mp, q);
+ break;
+ default:
+ mp_confusion(mp, "token");
+ @:this can't happen token}{\quad token@>
+ }
+ mp_free_token_node(mp, q);
+ }
+}
+
+@ The procedure |show_token_list|, which prints a symbolic form of the token list
+that starts at a given node |p|, illustrates these conventions. The token list
+being displayed should not begin with a reference count.
+
+An additional parameter |q| is also given; this parameter is either NULL or it
+points to a node in the token list where a certain magic computation takes place
+that will be explained later. (Basically, |q| is non-NULL when we are printing
+the two-line context information at the time of an error message; |q| marks the
+place corresponding to where the second line should begin.)
+
+@^recursion@>
+
+Unusual entries are printed in the form of all-caps tokens preceded by a space,
+e.g., |\char`\ BAD|.
+
+@<Declarations@>=
+static void mp_show_token_list (MP mp, mp_node p, mp_node q);
+static void mp_show_token_list_space (MP mp, mp_node p, mp_node q);
+
+@ We go for a spacy layout because we have more screen estate today.
+@c
+
+void mp_show_token_list (MP mp, mp_node p, mp_node q)
+{
+ int cclass = mp_percent_class;
+ (void) q;
+ while (p != NULL) {
+ int c = mp_letter_class;
+ if (mp_type(p) != mp_symbol_node_type) {
+ if (mp_name_type(p) == mp_token_operation) {
+ if (mp_type(p) == mp_known_type) {
+ if (cclass == mp_digit_class) {
+ mp_print_chr(mp, ' ');
+ }
+ if (number_negative(mp_get_value_number(p))) {
+ if (cclass == mp_left_bracket_class) {
+ mp_print_chr(mp, ' ');
+ }
+ mp_print_chr(mp, '[');
+ print_number(mp_get_value_number(p));
+ mp_print_chr(mp, ']');
+ c = mp_right_bracket_class;
+ } else {
+ print_number(mp_get_value_number(p));
+ c = mp_digit_class;
+ }
+ } else if (mp_type(p) == mp_string_type) {
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, mp_get_value_str(p));
+ mp_print_chr(mp, '"');
+ c = mp_string_class;
+ } else {
+ mp_print_str(mp, " BAD");
+ }
+ } else if ((mp_name_type(p) != mp_capsule_operation) || (mp_type(p) < mp_vacuous_type) || (mp_type(p) > mp_independent_type)) {
+ mp_print_str(mp, " BAD");
+ } else {
+ mp_print_capsule(mp, p);
+ c = mp_right_parenthesis_class;
+ }
+ } else if (mp_name_type(p) == mp_expr_operation || mp_name_type(p) == mp_suffix_operation || mp_name_type(p) == mp_text_operation) {
+ int r = mp_get_sym_info(p);
+ if (mp_name_type(p) == mp_expr_operation) {
+ mp_print_str(mp, "(EXPR");
+ } else if (mp_name_type(p) == mp_suffix_operation) {
+ mp_print_str(mp, "(SUFFIX");
+ } else {
+ mp_print_str(mp, "(TEXT");
+ }
+ mp_print_int(mp, r);
+ mp_print_chr(mp, ')');
+ c = mp_right_parenthesis_class;
+ } else {
+ mp_sym sr = mp_get_sym_sym(p);
+ if (sr == mp_collective_subscript) {
+ if (cclass == mp_left_bracket_class) {
+ mp_print_chr(mp, ' ');
+ }
+ mp_print_str(mp, "[]");
+ c = mp_right_bracket_class;
+ } else {
+ mp_string rr = text(sr);
+ if (rr == NULL || rr->str == NULL) {
+ mp_print_str(mp, " NONEXISTENT");
+ } else {
+ c = mp->char_class[(rr->str[0])];
+ if (c == cclass) {
+ switch (c) {
+ case mp_letter_class:
+ mp_print_chr(mp, '.');
+ break;
+ case mp_comma_class:
+ case mp_semicolon_class:
+ case mp_left_parenthesis_class:
+ case mp_right_parenthesis_class:
+ break;
+ default:
+ mp_print_chr(mp, ' ');
+ break;
+ }
+ }
+ mp_print_mp_str(mp, rr);
+ }
+ }
+ }
+ cclass = c;
+ p = mp_link(p);
+ }
+ return;
+}
+
+void mp_show_token_list_space (MP mp, mp_node p, mp_node q)
+{
+ (void) q;
+ while (p != NULL) {
+ if (mp_type(p) != mp_symbol_node_type) {
+ if (mp_name_type(p) == mp_token_operation) {
+ if (mp_type(p) == mp_known_type) {
+ if (number_negative(mp_get_value_number(p))) {
+ mp_print_str(mp, "[ ");
+ print_number(mp_get_value_number(p));
+ mp_print_str(mp, " ]");
+ } else {
+ print_number(mp_get_value_number(p));
+ }
+ } else if (mp_type(p) == mp_string_type) {
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, mp_get_value_str(p));
+ mp_print_chr(mp, '"');
+ } else {
+ mp_print_str(mp, "BAD");
+ }
+ } else if ((mp_name_type(p) != mp_capsule_operation) || (mp_type(p) < mp_vacuous_type) || (mp_type(p) > mp_independent_type)) {
+ mp_print_str(mp, "BAD");
+ } else {
+ mp_print_capsule(mp, p);
+ }
+ } else if (mp_name_type(p) == mp_expr_operation || mp_name_type(p) == mp_suffix_operation || mp_name_type(p) == mp_text_operation) {
+ int r = mp_get_sym_info(p);
+ if (mp_name_type(p) == mp_expr_operation) {
+ mp_print_str(mp, "(EXPR ");
+ } else if (mp_name_type(p) == mp_suffix_operation) {
+ mp_print_str(mp, "(SUFFIX ");
+ } else {
+ mp_print_str(mp, "(TEXT ");
+ }
+ mp_print_int(mp, r);
+ mp_print_chr(mp, ')');
+ } else {
+ mp_sym sr = mp_get_sym_sym(p);
+ if (sr == mp_collective_subscript) {
+ mp_print_str(mp, "[]");
+ } else {
+ mp_string rr = text(sr);
+ if (rr == NULL || rr->str == NULL) {
+ mp_print_str(mp, "NONEXISTENT");
+ } else {
+ mp_print_mp_str(mp, rr);
+ }
+ }
+ }
+ p = mp_link(p);
+ if (p) {
+ mp_print_chr(mp, ' ');
+ }
+ }
+ return;
+}
+
+@ @<Declarations@>=
+static void mp_print_capsule (MP mp, mp_node p);
+
+@ @<Declare miscellaneous procedures that were declared |forward|@>=
+void mp_print_capsule (MP mp, mp_node p)
+{
+ mp_print_chr(mp, '(');
+ mp_print_exp(mp, p, 0);
+ mp_print_chr(mp, ')');
+}
+
+@ Macro definitions are kept in \MP's memory in the form of token lists that have
+a few extra symbolic nodes at the beginning.
+
+The first node contains a reference count that is used to tell when the list is
+no longer needed. To emphasize the fact that a reference count is present, we
+shall refer to the |sym_info| field of this special node as the |ref_count|
+field. @^reference counts@>
+
+The next node or nodes after the reference count serve to describe the formal
+parameters. They consist of zero or more parameter tokens followed by a code for
+the type of macro.
+
+/* reference count preceding a macro definition or picture header */
+
+@d mp_get_ref_count(A) mp_get_indep_value(A)
+@d mp_set_ref_count(A,B) mp_set_indep_value(A,B)
+@d mp_add_mac_ref(A) mp_set_ref_count((A), mp_get_ref_count((A))+1) /* make a new reference to a macro list */
+@d mp_decr_mac_ref(A) mp_set_ref_count((A), mp_get_ref_count((A))-1) /* remove a reference to a macro list */
+
+@<Types...@>=
+typedef enum mp_macro_info {
+ mp_general_macro, /* preface to a macro defined with a parameter list */
+ mp_primary_macro, /* preface to a macro with a |primary| parameter */
+ mp_secondary_macro, /* preface to a macro with a |secondary| parameter */
+ mp_tertiary_macro, /* preface to a macro with a |tertiary| parameter */
+ mp_expr_macro, /* preface to a macro with an undelimited |expr| parameter */
+ mp_of_macro, /* preface to a macro with undelimited `|expr| |x| |of|~|y|' parameters */
+ mp_suffix_macro, /* preface to a macro with an undelimited |suffix| parameter */
+ mp_text_macro, /* preface to a macro with an undelimited |text| parameter */
+ mp_expr_parameter, /* used by |expr| primitive */
+ mp_suffix_parameter, /* used by |suffix| primitive */
+ mp_text_parameter /* used by |text| primitive */
+} mp_macro_info;
+
+@ @c
+static void mp_delete_mac_ref (MP mp, mp_node p)
+{
+ /* |p| points to the reference count of a macro list that is losing one reference */
+ if (mp_get_ref_count(p) == 0) {
+ mp_flush_token_list(mp, p);
+ } else {
+ mp_decr_mac_ref(p);
+ }
+}
+
+@ The following subroutine displays a macro, given a pointer to its reference
+count.
+
+@c
+static void mp_show_macro (MP mp, mp_node p, mp_node q)
+{
+ p = mp_link(p); /* bypass the reference count */
+ while (mp_name_type(p) != mp_macro_operation) {
+ mp_node r = mp_link(p);
+ mp_link(p) = NULL;
+ mp_show_token_list(mp, p, NULL);
+ mp_link(p) = r;
+ p = r;
+ }
+ switch (mp_get_sym_info(p)) {
+ case mp_general_macro:
+ mp_print_str(mp, "-> ");
+ break;
+ @.->@>
+ case mp_primary_macro:
+ case mp_secondary_macro:
+ case mp_tertiary_macro:
+ mp_print_str(mp, "<");
+ mp_print_cmd_mod(mp, mp_parameter_commmand, mp_get_sym_info(p));
+ mp_print_str(mp, "> -> ");
+ break;
+ case mp_expr_macro:
+ mp_print_str(mp, "<expr> -> ");
+ break;
+ case mp_of_macro:
+ mp_print_str(mp, "<expr> of <primary> -> ");
+ break;
+ case mp_suffix_macro:
+ mp_print_str(mp, "<suffix> -> ");
+ break;
+ case mp_text_macro:
+ mp_print_str(mp, "<text> -> ");
+ break;
+ }
+ mp_show_token_list(mp, mp_link(p), q);
+}
+
+@* Data structures for variables.
+
+The variables of \MP\ programs can be simple, like |x|, or they can combine the
+structural property of arrays and records, like |x20a.b|. A \MP\ user assigns a
+type to a variable like |x20a.b| by saying, for example, `|boolean| |x[]a.b|'.
+It's time for us to study how such things are represented inside of the computer.
+
+Each variable value occupies two consecutive words, either in a non-symbolic node
+called a value node, or as a non-symbolic subfield of a larger node. One of those
+two words is called the |value| field; it is an integer, containing either a
+|scaled| numeric value or the representation of some other type of quantity. (It
+might also be subdivided into halfwords, in which case it is referred to by other
+names instead of |value|.) The other word is broken into subfields called |type|,
+|name_type|, and |link|. The |type| field is a quarterword that specifies the
+variable's type, and |name_type| is a quarterword from which \MP\ can reconstruct
+the variable's name (sometimes by using the |link| field as well). Thus, only
+1.25 words are actually devoted to the value itself; the other three-quarters of
+a word are overhead, but they aren't wasted because they allow \MP\ to deal with
+sparse arrays and to provide meaningful diagnostics.
+
+In this section we shall be concerned only with the structural aspects of
+variables, not their values. Later parts of the program will change the |type|
+and |value| fields, but we shall treat those fields as black boxes whose contents
+should not be touched.
+
+However, if the |type| field is |mp_structured|, there is no |value| field, and
+the second word is broken into two pointer fields called |attr_head| and
+|subscr_head|. Those fields point to additional nodes that contain structural
+information, as we shall see.
+
+TH Note: DEK and JDH had a nice theoretical split between |value|, |attr| and
+|subscr| nodes, as documented above and further below. However, all three types
+had a bad habit of transmuting into each other in practice while pointers to them
+still lived on elsewhere, so using three different C structures is simply not
+workable. All three are now represented as a single C structure called
+|mp_value_node|.
+
+There is a potential union in this structure in the interest of space saving:
+|subscript| and |hashloc| are mutually exclusive.
+
+Actually, so are |attr_head| + |subscr_head| on one side and and |value_| on the
+other, but because of all the access macros that are used in the code base to get
+at values, those cannot be folded into a union (yet); this would have required
+creating a similar union in |mp_token_node| where it would only serve to confuse
+things.
+
+Finally, |parent| only applies in |attr| nodes (the ones that have |hashloc|),
+but creating an extra substructure inside the union just for that does not save
+space and the extra complication in the structure is not worth the minimal extra
+code clarification.
+
+@d mp_get_attribute_head(A) mp_do_get_attribute_head(mp, (mp_value_node) (A))
+@d mp_set_attribute_head(A,B) mp_do_set_attribute_head(mp, (mp_value_node) (A),(mp_node) (B))
+
+@d mp_get_subscr_head(A) mp_do_get_subscr_head(mp,(mp_value_node) (A))
+@d mp_set_subscr_head(A,B) mp_do_set_subscr_head(mp,(mp_value_node) (A),(mp_node) (B))
+
+@<MPlib internal header stuff@>=
+typedef struct mp_value_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ mp_value_data data;
+ mp_number subscript;
+ mp_sym hashloc_;
+ mp_node parent;
+ mp_node attr_head;
+ mp_node subscr_head;
+} mp_value_node_data;
+
+@ @c
+static mp_node mp_do_get_attribute_head (MP mp, mp_value_node A)
+{
+ (void) mp;
+ return A->attr_head;
+}
+
+static mp_node mp_do_get_subscr_head (MP mp, mp_value_node A)
+{
+ return A->subscr_head;
+ (void) mp;
+}
+
+static void mp_do_set_attribute_head (MP mp, mp_value_node A, mp_node d)
+{
+ (void) mp;
+ A->attr_head = d;
+}
+
+static void mp_do_set_subscr_head (MP mp, mp_value_node A, mp_node d)
+{
+ (void) mp;
+ A->subscr_head = d;
+}
+
+@ @<Declarations@>=
+static mp_node mp_do_get_subscr_head (MP mp, mp_value_node A);
+static mp_node mp_do_get_attribute_head (MP mp, mp_value_node A);
+static void mp_do_set_attribute_head (MP mp, mp_value_node A, mp_node d);
+static void mp_do_set_subscr_head (MP mp, mp_value_node A, mp_node d);
+
+@ It would have been nicer to make |mp_new_value_node| return |mp_value_node|
+variables, but with |eqtb| as it stands that became messy: lots of typecasts. So,
+it returns a simple |mp_node| for now.
+
+@c
+static mp_node mp_new_value_node (MP mp)
+{
+ mp_value_node p;
+ if (mp->value_nodes) {
+ p = (mp_value_node) mp->value_nodes;
+ mp->value_nodes = p->link;
+ mp->num_value_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_value_node_data));
+ new_number(p->data.n);
+ new_number(p->subscript);
+ p->hasnumber = 2;
+ }
+ mp_type(p) = mp_value_node_type;
+ return (mp_node) p;
+}
+
+@ @<Declarations@>=
+static mp_node mp_new_value_node (MP mp);
+
+@ An attribute node is three words long. Two of these words contain |type| and
+|value| fields as described above, and the third word contains additional
+information: There is an |hashloc| field, which contains the hash address of the
+token that names this attribute; and there's also a |parent| field, which points
+to the value node of |mp_structured| type at the next higher level (i.e., at the
+level to which this attribute is subsidiary). The |name_type| in an attribute
+node is |attr|. The |link| field points to the next attribute with the same
+parent; these are arranged in increasing order, so that |mp_get_hashloc
+(mp_link(p)) > mp_get_hashloc (p)|. The final attribute node links to the
+constant |end_attr|, whose |hashloc| field is greater than any legal hash
+address. The |attr_head| in the parent points to a node whose |name_type| is
+|mp_structured_root_operation|; this node represents the NULL attribute, i.e.,
+the variable that is relevant when no attributes are attached to the parent. The
+|attr_head| node has the fields of either a value node, a subscript node, or an
+attribute node, depending on what the parent would be if it were not structured;
+but the subscript and attribute fields are ignored, so it effectively contains
+only the data of a value node. The |link| field in this special node points to an
+attribute node whose |hashloc| field is zero; the latter node represents a
+collective subscript |[]| attached to the parent, and its |link| field points to
+the first non-special attribute node (or to |end_attr| if there are none).
+
+A subscript node likewise occupies three words, with |type| and |value| fields
+plus extra information; its |name_type| is |subscr|. In this case the third word
+is called the |subscript| field, which is a |scaled| integer. The |link| field
+points to the subscript node with the next larger subscript, if any; otherwise
+the |link| points to the attribute node for collective subscripts at this level.
+We have seen that the latter node contains an upward pointer, so that the parent
+can be deduced.
+
+The |name_type| in a parent-less value node is |root|, and the |link| is the hash
+address of the token that names this value.
+
+In other words, variables have a hierarchical structure that includes enough
+threads running around so that the program is able to move easily between
+siblings, parents, and children. An example should be helpful: (The reader is
+advised to draw a picture while reading the following description, since that
+will help to firm up the ideas.) Suppose that |x| and |x.a| and |x[]b| and |x5|
+and |x20b| have been mentioned in a user's program, where |x[]b| has been
+declared to be of |boolean| type. Let |h(x)|, |h(a)|, and |h(b)| be the hash
+addresses of \.x, \.a, and~\.b. Then |eq_type(h(x)) = name| and |equiv(h(x)) =
+p|, where |p|~is a non-symbolic value node with |mp_name_type(p) = root| and
+|mp_link(p)=h(x)|. We have |type(p) = mp_structured|, |mp_get_attribute_head(p) =
+q|, and |mp_get_subscr_head(p) = r|, where |q| points to a value node and |r| to
+a subscript node. (Are you still following this? Use a pencil to draw a diagram.)
+The lone variable |x| is represented by |type(q)| and |value(q)|; furthermore
+|mp_name_type(q) = mp_structured_root_operation| and |mp_link(q) = q1|, where
+|q1| points to an attribute node representing |x[]|. Thus |mp_name_type(q1) =
+attr|, |mp_get_hashloc(q1) = mp_collective_subscript = 0|, |mp_get_parent(q1) =
+p|, |type(q1) = mp_structured|, |mp_get_attribute_head(q1) = qq|, and
+|mp_get_subscr_head(q1) = qq1|; |qq| is a three-word \quote {attribute-as-value}
+node with |type(qq) = numeric_type| (assuming that |x5| is numeric, because |qq|
+represents |x[]| with no further attributes), |mp_name_type(qq) =
+structured_root|, |mp_get_hashloc(qq)=0|, |mp_get_parent(qq) = p|, and
+|mp_link(qq) = qq1|. (Now pay attention to the next part.) Node |qq1| is an
+attribute node representing |x[][]|, which has never yet occurred; its |type|
+field is |undefined|, and its |value| field is undefined. We have
+|mp_name_type(qq1) = attr|, |mp_get_hashloc(qq1)=mp_collective_subscript|,
+|mp_get_parent(qq1) = q1|, and |mp_link(qq1) = qq2|. Since |qq2| represents
+|x[]b|, |type(qq2) = mp_unknown_boolean|; also |mp_get_hashloc(qq2) = h(b)|,
+|mp_get_parent(qq2) = q1|, |mp_name_type(qq2) = attr|, |mp_link(qq2) = end_attr|.
+(Maybe colored lines will help untangle your picture.) Node |r| is a subscript
+node with |type| and |value| representing |x5|; |mp_name_type(r) = subscr|,
+|subscript(r) = 5.0|, and |mp_link(r) = r1| is another subscript node. To
+complete the picture, see if you can guess what |mp_link(r1)| is; give up?
+It's~|q1|. Furthermore |subscript(r1) = 20.0|, |mp_name_type(r1) = subscr|,
+|type(r1)=mp_structured|, |mp_get_attribute_head(r1) = qqq|,
+|mp_get_subscr_head(r1) = qqq1|, and we finish things off with three more nodes
+|qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again with a
+larger sheet of paper.) The value of variable |x20b| appears in node~|qqq2|, as
+you can well imagine.
+
+If the example in the previous paragraph doesn't make things crystal clear, a
+glance at some of the simpler subroutines below will reveal how things work out
+in practice.
+
+The only really unusual thing about these conventions is the use of collective
+subscript attributes. The idea is to avoid repeating a lot of type information
+when many elements of an array are identical macros (for which distinct values
+need not be stored) or when they don't have all of the possible attributes.
+Branches of the structure below collective subscript attributes do not carry
+actual values except for macro identifiers; branches of the structure below
+subscript nodes do not carry significant information in their collective
+subscript attributes.
+
+@c
+# define mp_get_hashloc(A) ((mp_value_node)(A))->hashloc_
+# define mp_set_hashloc(A,B) ((mp_value_node)(A))->hashloc_ = B
+# define mp_get_parent(A) ((mp_value_node)(A))->parent
+# define mp_set_parent(A,B) ((mp_value_node)(A))->parent = B
+
+@ @c
+static mp_value_node mp_get_attribute_node (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_new_value_node(mp);
+ mp_type(p) = mp_attribute_node_type;
+ return p;
+}
+
+@ Setting the |hashloc| field of |end_attr| to a value greater than any legal
+hash address is done by assigning $-1$ typecasted to |mp_sym|, hopefully
+resulting in all bits being set. On systems that support negative pointer values
+or where typecasting $-1$ does not result in all bits in a pointer being set,
+something else needs to be done. @^system dependencies@>
+
+@<Initialize table...@>=
+mp->end_attr = (mp_node) mp_get_attribute_node(mp);
+mp_set_hashloc(mp->end_attr, (mp_sym)-1);
+mp_set_parent((mp_value_node) mp->end_attr, NULL);
+
+@ @<Free table...@>=
+mp_free_value_node(mp, mp->end_attr);
+
+@d mp_collective_subscript (void *)0 /* code for the attribute |[]| */
+@d mp_subscript(A) ((mp_value_node)(A))->subscript
+
+@ @c
+static mp_value_node mp_get_subscr_node (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_new_value_node(mp);
+ mp_type(p) = mp_subscript_node_type;
+ return p;
+}
+
+@ Variables of type |pair| will have values that point to four-word nodes
+containing two numeric values. The first of these values has |name_type =
+mp_x_part_operation| and the second has |name_type = mp_y_part_operation|; the
+|link| in the first points back to the node whose |value| points to this
+four-word node.
+
+@d mp_x_part(A) ((mp_pair_node) (A))->x_part /* where the |xpart| is found in a pair node */
+@d mp_y_part(A) ((mp_pair_node) (A))->y_part /* where the |ypart| is found in a pair node */
+
+@<MPlib internal header stuff@>=
+typedef struct mp_pair_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ mp_node x_part;
+ mp_node y_part;
+} mp_pair_node_data;
+
+typedef struct mp_pair_node_data *mp_pair_node;
+
+@ @c
+static mp_node mp_get_pair_node (MP mp)
+{
+ mp_node p;
+ if (mp->pair_nodes) {
+ p = mp->pair_nodes;
+ mp->pair_nodes = p->link;
+ mp->num_pair_nodes--;
+ p->link = NULL;
+ } else {
+ p = mp_allocate_node(mp, sizeof(mp_pair_node_data));
+ }
+ mp_type(p) = mp_pair_node_type;
+ return (mp_node) p;
+}
+
+@ @c
+static void mp_free_pair_node (MP mp, mp_node p)
+{
+ if (p) {
+ if (mp->num_pair_nodes < max_num_pair_nodes) {
+ p->link = mp->pair_nodes;
+ mp->pair_nodes = p;
+ mp->num_pair_nodes++;
+ } else {
+ mp->var_used -= sizeof(mp_pair_node_data);
+ mp_memory_free(p);
+ }
+ }
+}
+
+@ If |type(p) = mp_pair_type| or if |value(p) = NULL|, the procedure call
+|init_pair_node(p)| will allocate a pair node for~|p|. The individual parts of
+such nodes are initially of type |mp_independent|.
+
+@c
+static void mp_init_pair_node (MP mp, mp_node p)
+{
+ mp_node q; /* the new node */
+ mp_type(p) = mp_pair_type;
+ q = mp_get_pair_node(mp);
+ mp_y_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_y_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_y_part(q)) = mp_y_part_operation;
+ mp_link(mp_y_part(q)) = p;
+ mp_x_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_x_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_x_part(q)) = mp_x_part_operation;
+ mp_link(mp_x_part(q)) = p;
+ mp_set_value_node(p, q);
+}
+
+@ Variables of type |transform| are similar, but in this case their |value|
+points to a 12-word node containing six values, identified by |x_part_operation|,
+|y_part_operation|, |mp_xx_part_operation|, |mp_xy_part_operation|,
+|mp_yx_part_operation|, and |mp_yy_part_operation|.
+
+@d mp_tx_part(A) ((mp_transform_node) (A))->tx_part /* where the |xpart| is found in a transform node */
+@d mp_ty_part(A) ((mp_transform_node) (A))->ty_part /* where the |ypart| is found in a transform node */
+@d mp_xx_part(A) ((mp_transform_node) (A))->xx_part /* where the |xxpart| is found in a transform node */
+@d mp_xy_part(A) ((mp_transform_node) (A))->xy_part /* where the |xypart| is found in a transform node */
+@d mp_yx_part(A) ((mp_transform_node) (A))->yx_part /* where the |yxpart| is found in a transform node */
+@d mp_yy_part(A) ((mp_transform_node) (A))->yy_part /* where the |yypart| is found in a transform node */
+
+@<MPlib internal header stuff@>=
+typedef struct mp_transform_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ mp_node tx_part;
+ mp_node ty_part;
+ mp_node xx_part;
+ mp_node yx_part;
+ mp_node xy_part;
+ mp_node yy_part;
+} mp_transform_node_data;
+
+typedef struct mp_transform_node_data *mp_transform_node;
+
+@ @c
+static mp_node mp_get_transform_node (MP mp)
+{
+ mp_transform_node p = (mp_transform_node) mp_allocate_node(mp, sizeof(mp_transform_node_data));
+ mp_type(p) = mp_transform_node_type;
+ return (mp_node) p;
+}
+
+@ @c
+static void mp_init_transform_node (MP mp, mp_node p)
+{
+ mp_node q; /* the new node */
+ mp_type(p) = mp_transform_type;
+ q = mp_get_transform_node(mp); /* big node */
+ mp_yy_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_yy_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_yy_part(q)) = mp_yy_part_operation;
+ mp_link(mp_yy_part(q)) = p;
+ mp_yx_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_yx_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_yx_part(q)) = mp_yx_part_operation;
+ mp_link(mp_yx_part(q)) = p;
+ mp_xy_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_xy_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_xy_part(q)) = mp_xy_part_operation;
+ mp_link(mp_xy_part(q)) = p;
+ mp_xx_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_xx_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_xx_part(q)) = mp_xx_part_operation;
+ mp_link(mp_xx_part(q)) = p;
+ mp_ty_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_ty_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_ty_part(q)) = mp_y_part_operation;
+ mp_link(mp_ty_part(q)) = p;
+ mp_tx_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_tx_part(q)); /* sets |type(q)| and |value(q)| */
+ mp_name_type(mp_tx_part(q)) = mp_x_part_operation;
+ mp_link(mp_tx_part(q)) = p;
+ mp_set_value_node(p, q);
+}
+
+@ Variables of type |color| have 3~values in 6~words identified by
+|mp_red_part_operation|, |mp_green_part_operation|, and |mp_blue_part_operation|.
+
+@d mp_red_part(A) ((mp_color_node) (A))->red_part /* where the |redpart| is found in a color node */
+@d mp_green_part(A) ((mp_color_node) (A))->green_part /* where the |greenpart| is found in a color node */
+@d mp_blue_part(A) ((mp_color_node) (A))->blue_part /* where the |bluepart| is found in a color node */
+@d mp_grey_part(A) ((mp_color_node) (A))->grey_part /* where the |greypart| is found in a color node */
+@d mp_cyan_part(A) ((mp_color_node) (A))->cyan_part /* where the |cyanpart| is found in a color node */
+@d mp_magenta_part(A) ((mp_color_node) (A))->magenta_part /* where the |magentapart| is found in a color node */
+@d mp_yellow_part(A) ((mp_color_node) (A))->yellow_part /* where the |yellowpart| is found in a color node */
+@d mp_black_part(A) ((mp_color_node) (A))->black_part /* where the |blackpart| is found in a color node */
+
+@<MPlib internal header stuff@>=
+typedef struct mp_color_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ union {
+ mp_node red_part;
+ mp_node cyan_part;
+ };
+ union {
+ mp_node green_part;
+ mp_node magenta_part;
+ };
+ union {
+ mp_node blue_part;
+ mp_node yellow_part;
+ };
+ union {
+ mp_node grey_part;
+ mp_node black_part;
+ };
+} mp_color_node_data;
+
+typedef struct mp_color_node_data *mp_color_node;
+
+@ @c
+static void mp_init_color_node (MP mp, mp_node p, int type)
+{
+ mp_node q = (mp_node) mp_allocate_node(mp, sizeof(mp_color_node_data));
+ q->link = NULL;
+ mp_type(p) = type;
+ switch (type) {
+ case mp_color_type:
+ mp_type(q) = mp_color_node_type;
+ /* */
+ mp_red_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_red_part(q));
+ mp_name_type(mp_red_part(q)) = mp_red_part_operation;
+ mp_link(mp_red_part(q)) = p;
+ /* */
+ mp_green_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_green_part(q));
+ mp_name_type(mp_green_part(q)) = mp_green_part_operation;
+ mp_link(mp_green_part(q)) = p;
+ /* */
+ mp_blue_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_blue_part(q));
+ mp_name_type(mp_blue_part(q)) = mp_blue_part_operation;
+ mp_link(mp_blue_part(q)) = p;
+ break;
+ case mp_cmykcolor_type:
+ mp_type(q) = mp_cmykcolor_node_type;
+ /* */
+ mp_cyan_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_cyan_part(q));
+ mp_name_type(mp_cyan_part(q)) = mp_cyan_part_operation;
+ mp_link(mp_cyan_part(q)) = p;
+ /* */
+ mp_magenta_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_magenta_part(q));
+ mp_name_type(mp_magenta_part(q)) = mp_magenta_part_operation;
+ mp_link(mp_magenta_part(q)) = p;
+ /* */
+ mp_yellow_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_yellow_part(q));
+ mp_name_type(mp_yellow_part(q)) = mp_yellow_part_operation;
+ mp_link(mp_yellow_part(q)) = p;
+ /* */
+ mp_black_part(q) = mp_new_value_node(mp);
+ mp_new_indep(mp, mp_black_part(q));
+ mp_name_type(mp_black_part(q)) = mp_black_part_operation;
+ mp_link(mp_black_part(q)) = p;
+ break;
+ }
+ mp_set_value_node(p, q);
+}
+
+@ When an entire structured variable is saved, the |root| indication is
+temporarily replaced by |saved_root|. Some variables have no name; they just are
+used for temporary storage while expressions are being evaluated. We call them
+{\sl capsules}.
+
+@ The |id_transform| function creates a capsule for the identity transformation.
+
+@c
+static mp_node mp_id_transform (MP mp)
+{
+ mp_node q;
+ mp_node p = mp_new_value_node(mp);
+ mp_name_type(p) = mp_capsule_operation;
+ mp_set_value_number(p, zero_t); /* todo: this was |null| */
+ mp_init_transform_node(mp, p);
+ q = mp_get_value_node(p);
+ mp_type(mp_tx_part(q)) = mp_known_type;
+ mp_set_value_number(mp_tx_part(q), zero_t);
+ mp_type(mp_ty_part(q)) = mp_known_type;
+ mp_set_value_number(mp_ty_part(q), zero_t);
+ mp_type(mp_xy_part(q)) = mp_known_type;
+ mp_set_value_number(mp_xy_part(q), zero_t);
+ mp_type(mp_yx_part(q)) = mp_known_type;
+ mp_set_value_number(mp_yx_part(q), zero_t);
+ mp_type(mp_xx_part(q)) = mp_known_type;
+ mp_set_value_number(mp_xx_part(q), unity_t);
+ mp_type(mp_yy_part(q)) = mp_known_type;
+ mp_set_value_number(mp_yy_part(q), unity_t);
+ return p;
+}
+
+@ Tokens are of type |tag_token| when they first appear, but they point to |NULL|
+until they are first used as the root of a variable. The following subroutine
+establishes the root node on such grand occasions.
+
+@c
+static void mp_new_root (MP mp, mp_sym x)
+{
+ mp_node p = mp_new_value_node(mp);
+ mp_type(p) = mp_undefined_type;
+ mp_name_type(p) = mp_root_operation;
+ mp_set_value_sym(p, x);
+ set_equiv_node(x, p);
+}
+
+@ These conventions for variable representation are illustrated by the
+|print_variable_name| routine, which displays the full name of a variable given
+only a pointer to its value.
+
+@<Declarations@>=
+static void mp_print_variable_name (MP mp, mp_node p);
+
+@ @c
+void mp_print_variable_name (MP mp, mp_node p)
+{
+ mp_node q = NULL; /* a token list that will name the variable's suffix */
+ mp_node r = NULL; /* temporary for token list creation */
+ while (mp_name_type(p) >= mp_x_part_operation) {
+ switch (mp_name_type(p)) {
+ case mp_x_part_operation : mp_print_str(mp, "xpart "); break;
+ case mp_y_part_operation : mp_print_str(mp, "ypart "); break;
+ case mp_xx_part_operation : mp_print_str(mp, "xxpart "); break;
+ case mp_xy_part_operation : mp_print_str(mp, "xypart "); break;
+ case mp_yx_part_operation : mp_print_str(mp, "yxpart "); break;
+ case mp_yy_part_operation : mp_print_str(mp, "yypart "); break;
+ case mp_red_part_operation : mp_print_str(mp, "redpart "); break;
+ case mp_green_part_operation : mp_print_str(mp, "greenpart "); break;
+ case mp_blue_part_operation : mp_print_str(mp, "bluepart "); break;
+ case mp_cyan_part_operation : mp_print_str(mp, "cyanpart "); break;
+ case mp_magenta_part_operation: mp_print_str(mp, "magentapart "); break;
+ case mp_yellow_part_operation : mp_print_str(mp, "yellowpart "); break;
+ case mp_black_part_operation : mp_print_str(mp, "blackpart "); break;
+ case mp_grey_part_operation : mp_print_str(mp, "greypart "); break;
+ case mp_capsule_operation : mp_print_fmt(mp, "%%CAPSULE%p", p); return;
+ default : break;
+ }
+ p = mp_link(p);
+ }
+ while (mp_name_type(p) > mp_saved_root_operation) {
+ /*
+ Ascend one level, pushing a token onto list |q| and replacing |p| by
+ its parent
+ */
+ if (mp_name_type(p) == mp_subscript_operation) {
+ r = mp_new_num_tok(mp, &(mp_subscript(p)));
+ do {
+ p = mp_link(p);
+ } while (mp_name_type(p) != mp_attribute_operation);
+ } else if (mp_name_type(p) == mp_structured_root_operation) {
+ p = mp_link(p);
+ goto FOUND;
+ } else if (mp_name_type(p) != mp_attribute_operation) {
+ mp_confusion(mp, "variable");
+ } else {
+ r = mp_new_symbolic_node(mp);
+ /* the hash address */
+ mp_set_sym_sym(r, mp_get_hashloc(p));
+ }
+ mp_set_link(r, q);
+ q = r;
+ FOUND:
+ p = mp_get_parent((mp_value_node) p);
+
+ }
+ /*
+ now |link(p)| is the hash address of |p|, and |name_type(p)| is either
+ |root| or |saved_root|. Have to prepend a token to |q| for
+ |show_token_list|.
+ */
+ r = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(r, mp_get_value_sym(p));
+ mp_link(r) = q;
+ if (mp_name_type(p) == mp_saved_root_operation) {
+ mp_print_str(mp, "(SAVED)");
+ }
+ mp_show_token_list(mp, r, NULL);
+ mp_flush_token_list(mp, r);
+}
+
+@ The |interesting| function returns |true| if a given variable is not in a
+capsule, or if the user wants to trace capsules.
+
+@c
+static int mp_interesting (MP mp, mp_node p)
+{
+ if (number_positive(internal_value(mp_tracing_capsules_internal))) {
+ return 1;
+ } else {
+ mp_name_type_type t = mp_name_type(p);
+ if (t >= mp_x_part_operation && t != mp_capsule_operation) {
+ mp_node tt = mp_get_value_node(mp_link(p));
+ switch (t) {
+ case mp_x_part_operation: t = mp_name_type(mp_x_part (tt)); break;
+ case mp_y_part_operation: t = mp_name_type(mp_y_part (tt)); break;
+ case mp_xx_part_operation: t = mp_name_type(mp_xx_part (tt)); break;
+ case mp_xy_part_operation: t = mp_name_type(mp_xy_part (tt)); break;
+ case mp_yx_part_operation: t = mp_name_type(mp_yx_part (tt)); break;
+ case mp_yy_part_operation: t = mp_name_type(mp_yy_part (tt)); break;
+ case mp_red_part_operation: t = mp_name_type(mp_red_part (tt)); break;
+ case mp_green_part_operation: t = mp_name_type(mp_green_part (tt)); break;
+ case mp_blue_part_operation: t = mp_name_type(mp_blue_part (tt)); break;
+ case mp_cyan_part_operation: t = mp_name_type(mp_cyan_part (tt)); break;
+ case mp_magenta_part_operation: t = mp_name_type(mp_magenta_part(tt)); break;
+ case mp_yellow_part_operation: t = mp_name_type(mp_yellow_part (tt)); break;
+ case mp_black_part_operation: t = mp_name_type(mp_black_part (tt)); break;
+ case mp_grey_part_operation: t = mp_name_type(mp_grey_part (tt)); break;
+ default: break;
+ }
+ }
+ return (t != mp_capsule_operation);
+ }
+}
+
+@ Now here is a subroutine that converts an unstructured type into an equivalent
+structured type, by inserting a |mp_structured| node that is capable of growing.
+This operation is done only when |mp_name_type(p)=root|, |subscr|, or |attr|.
+
+The procedure returns a pointer to the new node that has taken node~|p|'s place
+in the structure. Node~|p| itself does not move, nor are its |value| or |type|
+fields changed in any way.
+
+@c
+static mp_node mp_new_structure (MP mp, mp_node p)
+{
+ mp_node r = NULL;
+ switch (mp_name_type(p)) {
+ case mp_root_operation:
+ {
+ mp_sym q = mp_get_value_sym(p);
+ r = mp_new_value_node(mp);
+ set_equiv_node(q, r);
+ }
+ break;
+ case mp_subscript_operation:
+ /* Link a new subscript node |r| in place of node |p| */
+ {
+ mp_node q_new;
+ mp_node q = p;
+ do {
+ q = mp_link(q);
+ } while (mp_name_type(q) != mp_attribute_operation);
+ q = mp_get_parent((mp_value_node) q);
+ r = mp->temp_head;
+ mp_set_link(r, mp_get_subscr_head(q));
+ do {
+ q_new = r;
+ r = mp_link(r);
+ } while (r != p);
+ r = (mp_node) mp_get_subscr_node(mp);
+ if (q_new == mp->temp_head) {
+ mp_set_subscr_head(q, r);
+ } else {
+ mp_set_link(q_new, r);
+ }
+ number_clone(mp_subscript(r), mp_subscript(p));
+ }
+ break;
+ case mp_attribute_operation:
+ /*
+ Link a new attribute node |r| in place of node |p| If the
+ attribute is |collective_subscript|, there are two pointers to
+ node~|p|, so we must change both of them.
+ */
+ {
+ mp_value_node rr;
+ mp_node q = mp_get_parent((mp_value_node) p);
+ r = mp_get_attribute_head(q);
+ do {
+ q = r;
+ r = mp_link(r);
+ } while (r != p);
+ rr = mp_get_attribute_node(mp);
+ r = (mp_node) rr;
+ mp_set_link(q, rr);
+ mp_set_hashloc(rr, mp_get_hashloc(p));
+ mp_set_parent(rr, mp_get_parent((mp_value_node) p));
+ if (mp_get_hashloc(p) == mp_collective_subscript) {
+ q = mp->temp_head;
+ mp_set_link(q, mp_get_subscr_head(mp_get_parent((mp_value_node) p)));
+ while (mp_link(q) != p) {
+ q = mp_link(q);
+ }
+ if (q == mp->temp_head) {
+ mp_set_subscr_head(mp_get_parent((mp_value_node) p), (mp_node) rr);
+ } else {
+ mp_set_link(q, rr);
+ }
+ }
+ }
+ break;
+ default:
+ mp_confusion(mp, "structure");
+ break;
+ }
+ if (r) {
+ mp_value_node q;
+ mp_set_link(r, mp_link(p));
+ mp_set_value_sym(r, mp_get_value_sym(p));
+ mp_type(r) = mp_structured_type;
+ mp_name_type(r) = mp_name_type(p);
+ mp_set_attribute_head(r, p);
+ mp_name_type(p) = mp_structured_root_operation;
+ q = mp_get_attribute_node(mp);
+ mp_set_link(p, q);
+ mp_set_subscr_head(r, (mp_node) q);
+ mp_set_parent(q, r);
+ mp_type(q) = mp_undefined_type;
+ mp_name_type(q) = mp_attribute_operation;
+ mp_set_link(q, mp->end_attr);
+ mp_set_hashloc(q, mp_collective_subscript);
+ }
+ return r;
+}
+
+@ The |find_variable| routine is given a pointer~|t| to a nonempty token list of
+suffixes; it returns a pointer to the corresponding non-symbolic value. For
+example, if |t| points to token |x| followed by a numeric token containing the
+value~7, |find_variable| finds where the value of |x7| is stored in memory. This
+may seem a simple task, and it usually is, except when |x7| has never been
+referenced before. Indeed, |x| may never have even been subscripted before;
+complexities arise with respect to updating the collective subscript information.
+
+If a macro type is detected anywhere along path~|t|, or if the first item on |t|
+isn't a |tag_token|, the value |NULL| is returned. Otherwise |p| will be a
+non-NULL pointer to a node such that |undefined < type(p) < mp_structured|.
+
+@c
+static mp_node mp_find_variable (MP mp, mp_node t)
+{
+ mp_sym p_sym = mp_get_sym_sym(t);
+ @^inner loop@>
+ // if ((eq_type(p_sym) % mp_outer_tag_command) != mp_tag_command) {
+ if (eq_type(p_sym) != mp_tag_command) {
+ return NULL;
+ } else {
+ mp_node p, q, r, s; /* nodes in the \quote {value} line */
+ mp_node pp, qq, rr, ss; /* nodes in the \quote {collective} line */
+ t = mp_link(t);
+ if (equiv_node(p_sym) == NULL) {
+ mp_new_root (mp, p_sym);
+ }
+ p = equiv_node(p_sym);
+ pp = p;
+ while (t != NULL) {
+ /*
+ Make sure that both nodes |p| and |pp| are of |mp_structured| type
+ Although |pp| and |p| begin together, they diverge when a subscript
+ occurs; |pp|~stays in the collective line while |p|~goes through
+ actual subscript values.
+ */
+ if (mp_type(pp) != mp_structured_type) {
+ if (mp_type(pp) > mp_structured_type) {
+ return NULL;
+ } else {
+ ss = mp_new_structure(mp, pp);
+ if (p == pp) {
+ p = ss;
+ }
+ pp = ss;
+ }
+ }
+ /* now |type(pp)=mp_structured| */
+ if (mp_type(p) != mp_structured_type) {
+ /* it cannot be |>mp_structured| */
+ p = mp_new_structure(mp, p);
+ /* now |type(p)=mp_structured| */
+ }
+ if (mp_type(t) != mp_symbol_node_type) {
+ /*
+ Descend one level for the subscript |value (t)| We want this part
+ of the program to be reasonably fast, in case there are lots of
+ subscripts at the same level of the data structure. Therefore we
+ store an \quote {infinite} value in the word that appears at the end
+ of the subscript list, even though that word isn't part of a
+ subscript node.
+ */
+ mp_number nn, save_subscript; /* temporary storage */
+ new_number_clone(nn, mp_get_value_number(t));
+ pp = mp_link(mp_get_attribute_head(pp));
+ /* now |mp_get_hashloc(pp)=mp_collective_subscript| */
+ q = mp_link(mp_get_attribute_head(p));
+ new_number_clone(save_subscript, mp_subscript(q));
+ set_number_to_inf(mp_subscript(q));
+ s = mp->temp_head;
+ mp_set_link(s, mp_get_subscr_head(p));
+ do {
+ r = s;
+ s = mp_link(s);
+ } while (number_greater(nn, mp_subscript(s)));
+ if (number_equal(nn, mp_subscript(s))) {
+ p = s;
+ } else {
+ mp_value_node p1 = mp_get_subscr_node(mp);
+ if (r == mp->temp_head) {
+ mp_set_subscr_head(p, (mp_node) p1);
+ } else {
+ mp_set_link(r, p1);
+ }
+ mp_set_link(p1, s);
+ number_clone(mp_subscript(p1), nn);
+ mp_name_type(p1) = mp_subscript_operation;
+ mp_type(p1) = mp_undefined_type;
+ p = (mp_node) p1;
+ }
+ number_clone(mp_subscript(q), save_subscript);
+ free_number(save_subscript);
+ free_number(nn);
+ } else {
+ /* Descend one level for the attribute |mp_get_sym_info(t)| */
+ mp_sym nn1 = mp_get_sym_sym(t);
+ ss = mp_get_attribute_head(pp);
+ do {
+ rr = ss;
+ ss = mp_link(ss);
+ } while (nn1 > mp_get_hashloc(ss));
+ if (nn1 < mp_get_hashloc(ss)) {
+ qq = (mp_node) mp_get_attribute_node(mp);
+ mp_set_link(rr, qq);
+ mp_set_link(qq, ss);
+ mp_set_hashloc(qq, nn1);
+ mp_name_type(qq) = mp_attribute_operation;
+ mp_type(qq) = mp_undefined_type;
+ mp_set_parent((mp_value_node) qq, pp);
+ ss = qq;
+ }
+ if (p == pp) {
+ p = ss;
+ pp = ss;
+ } else {
+ pp = ss;
+ s = mp_get_attribute_head(p);
+ do {
+ r = s;
+ s = mp_link(s);
+ } while (nn1 > mp_get_hashloc(s));
+ if (nn1 == mp_get_hashloc(s)) {
+ p = s;
+ } else {
+ q = (mp_node) mp_get_attribute_node(mp);
+ mp_set_link(r, q);
+ mp_set_link(q, s);
+ mp_set_hashloc(q, nn1);
+ mp_name_type(q) = mp_attribute_operation;
+ mp_type(q) = mp_undefined_type;
+ mp_set_parent((mp_value_node) q, p);
+ p = q;
+ }
+ }
+ }
+ t = mp_link(t);
+ }
+ if (mp_type(pp) >= mp_structured_type) {
+ if (mp_type(pp) == mp_structured_type) {
+ pp = mp_get_attribute_head(pp);
+ } else {
+ return NULL;
+ }
+ }
+ if (mp_type(p) == mp_structured_type) {
+ p = mp_get_attribute_head(p);
+ }
+ if (mp_type(p) == mp_undefined_type) {
+ if (mp_type(pp) == mp_undefined_type) {
+ mp_type(pp) = mp_numeric_type;
+ mp_set_value_number(pp, zero_t);
+ }
+ mp_type(p) = mp_type(pp);
+ mp_set_value_number(p, zero_t);
+ }
+ return p;
+ }
+}
+
+@ Variables lose their former values when they appear in a type declaration, or
+when they are defined to be macros or |let| equal to something else. A
+subroutine will be defined later that recycles the storage associated with any
+particular |type| or |value|; our goal now is to study a higher level process
+called |flush_variable|, which selectively frees parts of a variable structure.
+
+This routine has some complexity because of examples such as |numeric x[]a[]b|
+which recycles all variables of the form |x[i]a[j]b| (and no others), while
+|vardef x[]a[] = ...| discards all variables of the form |x[i]a[j]| followed by
+an arbitrary suffix, except for the collective node |x[]a[]| itself. The obvious
+way to handle such examples is to use recursion; so that's what we~do.
+@^recursion@>
+
+Parameter |p| points to the root information of the variable; parameter |t|
+points to a list of symbolic nodes that represent suffixes, with |info =
+mp_collective_subscript| for subscripts.
+
+@<Declarations@>=
+static void mp_flush_cur_exp (MP mp, mp_value v);
+
+@ @c
+static void mp_flush_variable (MP mp, mp_node p, mp_node t, int discard_suffixes)
+{
+ while (t != NULL) {
+ if (mp_type(p) != mp_structured_type) {
+ return;
+ } else {
+ /* attribute to match */
+ mp_sym n = mp_get_sym_sym(t);
+ t = mp_link(t);
+ if (n == mp_collective_subscript) {
+ mp_node q = mp_get_subscr_head(p);
+ mp_node r = NULL;
+ while (mp_name_type(q) == mp_subscript_operation) {
+ mp_flush_variable(mp, q, t, discard_suffixes);
+ if (t != NULL) {
+ r = q;
+ } else if (mp_type(q) == mp_structured_type) {
+ r = q;
+ } else {
+ if (r == NULL) {
+ mp_set_subscr_head(p, mp_link(q));
+ } else {
+ mp_set_link(r, mp_link(q));
+ }
+ mp_free_value_node(mp, q);
+ }
+ q = r == NULL ? mp_get_subscr_head(p) : mp_link(r);
+ }
+ }
+ p = mp_get_attribute_head(p);
+ do {
+ p = mp_link(p);
+ } while (mp_get_hashloc(p) < n);
+ if (mp_get_hashloc(p) != n) {
+ return;
+ }
+ }
+ }
+ if (discard_suffixes) {
+ mp_flush_below_variable(mp, p);
+ } else {
+ if (mp_type(p) == mp_structured_type) {
+ p = mp_get_attribute_head(p);
+ }
+ mp_recycle_value(mp, p);
+ }
+}
+
+@ The next procedure is simpler; it wipes out everything but |p| itself, which
+becomes undefined.
+
+@<Declarations@>=
+static void mp_flush_below_variable (MP mp, mp_node p);
+
+@ @c
+void mp_flush_below_variable (MP mp, mp_node p)
+{
+ if (mp_type(p) != mp_structured_type) {
+ mp_recycle_value(mp, p); /* this sets |type(p)=undefined| */
+ } else {
+ mp_node r;
+ mp_node q = mp_get_subscr_head(p);
+ while (mp_name_type(q) == mp_subscript_operation) {
+ mp_flush_below_variable(mp, q);
+ r = q;
+ q = mp_link(q);
+ mp_free_value_node(mp, r);
+ }
+ r = mp_get_attribute_head(p);
+ q = mp_link(r);
+ mp_recycle_value(mp, r);
+ mp_free_value_node(mp, r);
+ do {
+ mp_flush_below_variable(mp, q);
+ r = q;
+ q = mp_link(q);
+ mp_free_value_node(mp, r);
+ } while (q != mp->end_attr);
+ mp_type(p) = mp_undefined_type;
+ }
+}
+
+@ Just before assigning a new value to a variable, we will recycle the old value
+and make the old value undefined. The |und_type| routine determines what type of
+undefined value should be given, based on the current type before recycling.
+
+@c
+static int mp_und_type (MP mp, mp_node p)
+{
+ (void) mp;
+ switch (mp_type(p)) {
+ case mp_vacuous_type:
+ return mp_undefined_type;
+ case mp_boolean_type:
+ case mp_unknown_boolean_type:
+ return mp_unknown_boolean_type;
+ case mp_string_type:
+ case mp_unknown_string_type:
+ return mp_unknown_string_type;
+ case mp_pen_type:
+ case mp_unknown_pen_type:
+ return mp_unknown_pen_type;
+ case mp_nep_type:
+ case mp_unknown_nep_type:
+ return mp_unknown_nep_type;
+ case mp_path_type:
+ case mp_unknown_path_type:
+ return mp_unknown_path_type;
+ case mp_picture_type:
+ case mp_unknown_picture_type:
+ return mp_unknown_picture_type;
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ case mp_numeric_type:
+ return mp_type(p);
+ case mp_known_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ return mp_numeric_type;
+ default:
+ return 0;
+ }
+}
+
+@ The |clear_symbol| routine is used when we want to redefine the equivalent of a
+symbolic token. It must remove any variable structure or macro definition that is
+currently attached to that symbol. If the |saving| parameter is true, a
+subsidiary structure is saved instead of destroyed.
+
+@c
+static void mp_clear_symbol (MP mp, mp_sym p, int saving)
+{
+ mp_node q = equiv_node(p);
+ if (eq_property(p) > 0) {
+ mp_check_overload(mp, p);
+ }
+ // switch (eq_type(p) % mp_outer_tag_command) {
+ switch (eq_type(p)) {
+ case mp_defined_macro_command:
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ if (!saving) {
+ mp_delete_mac_ref(mp, q);
+ }
+ break;
+ case mp_tag_command:
+ if (q != NULL) {
+ if (saving) {
+ mp_name_type(q) = mp_saved_root_operation;
+ } else {
+ mp_flush_below_variable(mp, q);
+ mp_free_value_node(mp, q);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ set_equiv(p, mp->frozen_undefined->v.data.indep.serial);
+ set_eq_type(p, mp->frozen_undefined->type);
+}
+
+@* Saving and restoring equivalents.
+
+The nested structure given by |begingroup| and |endgroup| allows |eqtb| entries
+to be saved and restored, so that temporary changes can be made without
+difficulty. When the user requests a current value to be saved, \MP\ puts that
+value into its \quote {save stack.} An appearance of |endgroup| ultimately causes
+the old values to be removed from the save stack and put back in their former
+places.
+
+The save stack is a linked list containing three kinds of entries, distinguished
+by their |type| fields. If |p| points to a saved item, then
+
+\smallskip \hang |p->type = 0| stands for a group boundary; each |begingroup|
+contributes such an item to the save stack and each |endgroup| cuts back the
+stack until the most recent such entry has been removed.
+
+\smallskip \hang |p->type = mp_normal_operation| means that |p->value| holds the
+former contents of |eqtb[q]| (saved in the |knot| field of the value, which is
+otherwise unused for variables). Such save stack entries are generated by |save|
+commands.
+
+\smallskip \hang |p->type = mp_internal_operation| means that |p->value| is a
+|mp_internal| to be restored to internal parameter number~|q| (saved in the
+|serial| field of the value, which is otherwise unused for internals). Such
+entries are generated by |interim| commands.
+
+\smallskip \noindent The global variable |save_ptr| points to the top item on the
+save stack.
+
+@<Types...@>=
+typedef struct mp_save_data {
+ int type;
+ int padding;
+ mp_internal value;
+ struct mp_save_data *link;
+} mp_save_data;
+
+@ @<Glob...@>=
+mp_save_data *save_ptr; /* the most recently saved item */
+
+@ @<Set init...@>=
+mp->save_ptr = NULL;
+
+@ Saving a boundary item
+@c
+static void mp_save_boundary (MP mp)
+{
+ mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data));
+ p->type = 0;
+ p->link = mp->save_ptr;
+ mp->save_ptr = p;
+}
+
+@ The |save_variable| routine is given a hash address |q|; it salts this address
+in the save stack, together with its current equivalent, then makes token~|q|
+behave as though it were brand new.
+
+Nothing is stacked when |save_ptr = NULL|, however; there's no way to remove
+things from the stack when the program is not inside a group, so there's no point
+in wasting the space.
+
+@c
+static void mp_save_variable (MP mp, mp_sym q)
+{
+ if (mp->save_ptr != NULL) {
+ mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data));
+ p->type = mp_normal_operation;
+ p->link = mp->save_ptr;
+ p->value.v.data.indep.scale = eq_type(q);
+ p->value.v.data.indep.serial = equiv(q);
+ p->value.v.data.node = equiv_node(q);
+ p->value.v.data.p = (mp_knot)q;
+ mp->save_ptr = p;
+ }
+ mp_clear_symbol(mp, q, (mp->save_ptr != NULL));
+}
+
+static void mp_unsave_variable (MP mp)
+{
+ mp_sym q = (mp_sym)mp->save_ptr->value.v.data.p;
+ if (number_positive(internal_value(mp_tracing_restores_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{restoring ");
+ mp_print_mp_str(mp,text(q));
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+ }
+ mp_clear_symbol(mp, q, 0);
+ set_eq_type(q, mp->save_ptr->value.v.data.indep.scale);
+ set_equiv(q,mp->save_ptr->value.v.data.indep.serial);
+ q->v.data.node = mp->save_ptr->value.v.data.node;
+ // if (eq_type(q) % mp_outer_tag_command == mp_tag_command) {
+ if (eq_type(q) == mp_tag_command) {
+ mp_node pp = q->v.data.node;
+ if (pp != NULL) {
+ mp_name_type(pp) = mp_root_operation;
+ }
+ }
+}
+
+@ Similarly, |save_internal| is given the location |q| of an internal quantity
+like |mp_tracing_pens|. It creates a save stack entry of the third kind.
+
+Todo: check what happens with strings! We need to mess with the ref counter and
+there is no need to copy a number when we have a string.
+
+@c
+static void mp_save_internal (MP mp, int q)
+{
+ if (mp->save_ptr != NULL) {
+ mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data));
+ p->type = mp_internal_operation;
+ p->link = mp->save_ptr;
+ p->value = mp->internal[q];
+ p->value.v.data.indep.serial = q;
+ if (internal_run(q) == 1) {
+ mp->run_internal(mp, 1, q, internal_type(q), internal_name(q));
+ }
+ new_number_clone(p->value.v.data.n, mp->internal[q].v.data.n);
+ mp->save_ptr = p;
+ }
+}
+
+static void mp_unsave_internal (MP mp)
+{
+ int q = mp->save_ptr->value.v.data.indep.serial;
+ mp_internal saved = mp->save_ptr->value;
+ if (number_positive(internal_value(mp_tracing_restores_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{restoring ");
+ mp_print_str(mp, internal_name(q));
+ mp_print_chr(mp, '=');
+ switch (internal_type(q)) {
+ case mp_known_type:
+ case mp_numeric_type:
+ print_number(saved.v.data.n);
+ break;
+ case mp_boolean_type:
+ mp_print_str(mp, number_to_boolean(saved.v.data.n) == mp_true_operation ? "true" : "false");
+ break;
+ case mp_string_type:
+ {
+ char *s = mp_str(mp, saved.v.data.str);
+ mp_print_str(mp, s);
+ break;
+ }
+ default:
+ mp_confusion(mp, "internal restore");
+ break;
+ }
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+ }
+ free_number(mp->internal[q].v.data.n);
+ if (internal_run(q) == 1) {
+ mp->run_internal(mp, 2, q, internal_type(q), internal_name(q));
+ }
+ mp->internal[q] = saved;
+}
+
+@ At the end of a group, the |unsave| routine restores all of the saved
+equivalents in reverse order. This routine will be called only when there is at
+least one boundary item on the save stack.
+
+@c
+static void mp_unsave (MP mp)
+{
+ mp_save_data *p; /* saved item */
+ while (mp->save_ptr->type != 0) {
+ if (mp->save_ptr->type == mp_internal_operation) {
+ mp_unsave_internal(mp);
+ } else {
+ mp_unsave_variable(mp);
+ }
+ p = mp->save_ptr->link;
+ mp_memory_free(mp->save_ptr);
+ mp->save_ptr = p;
+ }
+ p = mp->save_ptr->link;
+ mp_memory_free(mp->save_ptr);
+ mp->save_ptr = p;
+}
+
+@* Data structures for paths.
+
+When a \MP\ user specifies a path, \MP\ will create a list of knots and control
+points for the associated cubic spline curves. If the knots are $z_0$, $z_1$,
+\dots, $z_n$, there are control points $z_k^+$ and $z_{k+1}^-$ such that the
+cubic splines between knots $z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
+@:Bezier}{B\'ezier, Pierre Etienne@>
+
+$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
+&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
+
+for |0<=t<=1|.
+
+There is a 8-word node for each knot $z_k$, containing one word of control
+information and six words for the |x| and |y| coordinates of $z_k^-$ and $z_k$
+and~$z_k^+$. The control information appears in the |mp_left_type| and
+|mp_right_type| fields, which each occupy a quarter of the first word in the
+node; they specify properties of the curve as it enters and leaves the knot.
+There's also a halfword |link| field, which points to the following knot, and a
+final supplementary word (of which only a quarter is used).
+
+If the path is a closed contour, knots 0 and |n| are identical; i.e., the |link|
+in knot |n-1| points to knot~0. But if the path is not closed, the |mp_left_type|
+of knot~0 and the |mp_right_type| of knot~|n| are equal to |endpoint|. In the
+latter case the |link| in knot~|n| points to knot~0, and the control points
+$z_0^-$ and $z_n^+$ are not used.
+
+@d mp_next_knot(A) (A)->next /* the next knot in this list */
+@d mp_left_type(A) (A)->left_type /* characterizes the path entering this knot */
+@d mp_right_type(A) (A)->right_type /* characterizes the path leaving this knot */
+@d mp_prev_knot(A) (A)->prev /* the previous knot in this list (only for pens) */
+@d mp_knot_info(A) (A)->info /* temporary info, used during splitting */
+
+@<Exported types...@>=
+typedef struct mp_knot_data *mp_knot;
+
+typedef struct mp_knot_data {
+ mp_number x_coord; /* the |x| coordinate of this knot */
+ mp_number y_coord; /* the |y| coordinate of this knot */
+ union {
+ mp_number left_x; /* the |x| coordinate of previous control point */
+ mp_number left_curl; /* curl information when entering this knot */
+ mp_number left_given; /* given direction when entering this knot */
+ };
+ union {
+ mp_number left_y; /* the |y| coordinate of previous control point */
+ mp_number left_tension; /* tension information when entering this knot */
+ };
+ union {
+ mp_number right_x; /* the |x| coordinate of next control point */
+ mp_number right_curl; /* curl information when leaving this knot */
+ mp_number right_given; /* given direction when leaving this knot */
+ };
+ union {
+ mp_number right_y; /* the |y| coordinate of next control point */
+ mp_number right_tension; /* tension information when leaving this knot */
+ };
+ mp_knot next;
+ mp_knot prev;
+ unsigned char left_type;
+ unsigned char right_type;
+ unsigned char originator;
+ unsigned char state;
+ signed int info;
+ /* we now have some 3 bytes slack that we can use */
+} mp_knot_data;
+
+@ @<Exported types...@>=
+typedef struct mp_gr_knot_data *mp_gr_knot;
+
+typedef struct mp_gr_knot_data {
+ double x_coord;
+ double y_coord;
+ double left_x;
+ double left_y;
+ double right_x;
+ double right_y;
+ mp_gr_knot next;
+ mp_gr_knot prev;
+ unsigned char left_type;
+ unsigned char right_type;
+ unsigned char originator;
+ unsigned char state;
+ signed int info;
+} mp_gr_knot_data;
+
+@ @<MPlib header stuff@>=
+typedef enum mp_knot_type {
+ mp_endpoint_knot, /* |mp_left_type| at path beginning and |mp_right_type| at path end */
+ mp_explicit_knot, /* |mp_left_type| or |mp_right_type| when control points are known */
+ mp_given_knot, /* |mp_left_type| or |mp_right_type| when a direction is given */
+ mp_curl_knot, /* |mp_left_type| or |mp_right_type| when a curl is desired */
+ mp_open_knot, /* |mp_left_type| or |mp_right_type| when \MP\ should choose the direction */
+ mp_end_cycle_knot
+} mp_knot_type;
+
+@ Before the B\'ezier control points have been calculated, the memory space they
+will ultimately occupy is taken up by information that can be used to compute
+them. There are four cases:
+
+\yskip \textindent{$\bullet$} If |mp_right_type=mp_open|, the curve should leave
+the knot in the same direction it entered; \MP\ will figure out a suitable
+direction.
+
+\yskip \textindent{$\bullet$} If |mp_right_type=mp_curl|, the curve should leave
+the knot in a direction depending on the angle at which it enters the next knot
+and on the curl parameter stored in |right_curl|.
+
+\yskip \textindent{$\bullet$} If |mp_right_type=mp_given|, the curve should leave
+the knot in a nonzero direction stored as an |angle| in |right_given|.
+
+\yskip \textindent{$\bullet$} If |mp_right_type=mp_explicit|, the B\'ezier
+control point for leaving this knot has already been computed; it is in the
+|mp_right_x| and |mp_right_y| fields.
+
+\yskip\noindent The rules for |mp_left_type| are similar, but they refer to the
+curve entering the knot, and to |left| fields instead of |right| fields.
+
+Non-|explicit| control points will be chosen based on \quote {tension} parameters
+in the |left_tension| and |right_tension| fields. The |atleast| option is
+represented by negative tension values. @:at_least_}{|atleast| primitive@>
+
+For example, the \MP\ path specification
+
+$$|z0..z1..tension atleast 1..\{curl 2\|z2..z3\{-1,-2\}..tension 3 and 4..p},$$
+
+where \.p is the path |z4..controls z45 and z54..z5|, will be represented by
+the six knots \def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
+
+$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr |mp_left_type|&|left|
+info&|x_coord,y_coord|&|mp_right_type|&|right| info\cr \noalign{\yskip}
+|endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr
+|open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr
+|curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr
+|given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr
+|open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr
+|explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$
+
+Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|. Of course, this
+example is more complicated than anything a normal user would ever write.
+
+These types must satisfy certain restrictions because of the form of \MP's path
+syntax: (i)~|open| type never appears in the same node together with |endpoint|,
+|given|, or |curl|. (ii)~The |mp_right_type| of a node is |explicit| if and only
+if the |mp_left_type| of the following node is |explicit|. (iii)~|endpoint| types
+occur only at the ends, as mentioned above.
+
+@ Knots can be user-supplied, or they can be created by program code, like the
+|split_cubic| function, or |copy_path|. The distinction is needed for the cleanup
+routine that runs after |split_cubic|, because it should only delete knots it has
+previously inserted, and never anything that was user-supplied. In order to be
+able to differentiate one knot from another, we will set |originator(p) :=
+mp_metapost_user| when it appeared in the actual metapost program, and
+|originator(p) := mp_program_code| in all other cases.
+
+@d mp_originator(A) (A)->originator /* the creator of this knot */
+@d mp_knotstate(A) (A)->state
+
+@<Exported types@>=
+enum mp_knot_originator {
+ mp_program_code, /* not created by a user */
+ mp_metapost_user /* created by a user */
+};
+enum mp_knot_states {
+ mp_regular_knot,
+ mp_begin_knot,
+ mp_end_knot,
+ mp_single_knot,
+};
+
+@ Here is a routine that prints a given knot list in symbolic form. It
+illustrates the conventions discussed above, and checks for anomalies that might
+arise while \MP\ is being debugged.
+
+@<Declarations@>=
+static void mp_pr_path (MP mp, mp_knot h);
+
+@ @c
+void mp_pr_path (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ do {
+ mp_knot q = mp_next_knot(p);
+ if ((p == NULL) || (q == NULL)) {
+ mp_print_nl(mp, "???");
+ return; /* this won't happen */
+ @.???@>
+ } else {
+ @<Print information for adjacent knots |p| and |q|@>
+ DONE1:
+ p = q;
+ if (p && ((p != h) || (mp_left_type(h) != mp_endpoint_knot))) {
+ @<Print two dots, followed by |given| or |curl| if present@>
+ }
+ }
+ } while (p != h);
+ if (mp_left_type(h) != mp_endpoint_knot) {
+ mp_print_str(mp, " cycle");
+ }
+}
+
+@ @<Print information for adjacent knots...@>=
+mp_print_two(mp, &(p->x_coord), &(p->y_coord));
+switch (mp_knotstate(p)) {
+ case mp_begin_knot:
+ mp_print_str(mp, " {begin}");
+ break;
+ case mp_end_knot:
+ mp_print_str(mp, " {end}");
+ break;
+}
+switch (mp_right_type(p)) {
+ case mp_endpoint_knot:
+ {
+ if (mp_left_type(p) == mp_open_knot) {
+ mp_print_str(mp, " {open?}"); /* can't happen */
+ @.open?@>
+ }
+ if ((mp_left_type(q) != mp_endpoint_knot) || (q != h)) {
+ q = NULL; /* force an error */
+ }
+ goto DONE1;
+ }
+ break;
+ case mp_explicit_knot:
+ {
+ @<Print control points between |p| and |q|, then |goto done1|@>
+ }
+ break;
+ case mp_open_knot:
+ {
+ @<Print information for a curve that begins |open|@>
+ }
+ break;
+ case mp_curl_knot:
+ case mp_given_knot:
+ {
+ @<Print information for a curve that begins |curl| or |given|@>
+ }
+ break;
+ default:
+ {
+ mp_print_str(mp, "???"); /* can't happen */
+ @.???@>
+ }
+ break;
+}
+if (mp_left_type(q) <= mp_explicit_knot) {
+ mp_print_str(mp, " .. control ?"); /* can't happen */
+ @.control?@>
+} else if ((! number_equal(p->right_tension, unity_t)) || (! number_equal(q->left_tension, unity_t))) {
+ @<Print tension between |p| and |q|@>
+}
+
+@ Since |n_sin_cos| produces |fraction| results, which we will print as if they
+were |scaled|, the magnitude of a |given| direction vector will be~4096.
+
+@<Print two dots...@>=
+mp_number n_sin, n_cos;
+new_fraction(n_sin);
+new_fraction(n_cos);
+mp_print_nl(mp, " .. ");
+if (mp_left_type(p) == mp_given_knot) {
+ n_sin_cos(p->left_given, n_cos, n_sin);
+ mp_print_str(mp, "{");
+ print_number(n_cos);
+ mp_print_chr(mp, ',');
+ print_number(n_sin);
+ mp_print_chr(mp, '}');
+} else if (mp_left_type(p) == mp_curl_knot) {
+ mp_print_str(mp, "{curl ");
+ print_number(p->left_curl);
+ mp_print_chr(mp, '}');
+}
+free_number(n_sin);
+free_number(n_cos);
+
+@ @<Print tension between |p| and |q|@>=
+mp_number v1;
+mp_print_str(mp, " .. tension");
+if (number_negative(p->right_tension)) {
+ mp_print_str(mp, " atleast");
+}
+new_number_abs(v1, p->right_tension);
+print_number(v1);
+if (! number_equal(p->right_tension, q->left_tension)) {
+ mp_print_str(mp, " and");
+ if (number_negative(q->left_tension)) {
+ mp_print_str(mp, " atleast");
+ }
+ number_abs_clone(v1, p->left_tension);
+ print_number(v1);
+}
+free_number(v1);
+
+@ @<Print control points between |p| and |q|, then |goto done1|@>=
+mp_print_str(mp, " .. controls ");
+mp_print_two(mp, &(p->right_x), &(p->right_y));
+mp_print_str(mp, " and ");
+if (mp_left_type(q) != mp_explicit_knot) {
+ mp_print_str(mp, "??"); /* can't happen */
+ @.??@>
+} else {
+ mp_print_two(mp, &(q->left_x), &(q->left_y));
+}
+goto DONE1;
+
+@ @<Print information for a curve that begins |open|@>=
+if ((mp_left_type(p) != mp_explicit_knot) && (mp_left_type(p) != mp_open_knot)) {
+ mp_print_str(mp, " {open?}"); /* can't happen */
+ @.open?@>
+}
+
+@ A curl of 1 is shown explicitly, so that the user sees clearly that \MP's
+default curl is present.
+
+@<Print information for a curve that begins |curl|...@>=
+if (mp_left_type(p) == mp_open_knot) {
+ mp_print_str(mp, " ??"); /* can't happen */
+ @.??@>
+}
+if (mp_right_type(p) == mp_curl_knot) {
+ mp_print_str(mp, " {curl");
+ print_number(p->right_curl);
+} else {
+ mp_number n_sin, n_cos;
+ new_fraction(n_sin);
+ new_fraction(n_cos);
+ n_sin_cos(p->right_given, n_cos, n_sin);
+ mp_print_str(mp, " {");
+ print_number(n_cos);
+ mp_print_chr(mp, ',');
+ print_number(n_sin);
+ free_number(n_sin);
+ free_number(n_cos);
+}
+mp_print_str(mp, "} ");
+
+@ It is convenient to have another version of |pr_path| that prints the path as a
+diagnostic message.
+
+@<Declarations@>=
+static void mp_print_path (MP mp, mp_knot h, const char *s, int nuline);
+
+@ @c
+void mp_print_path (MP mp, mp_knot h, const char *s, int nuline)
+{
+ mp_print_diagnostic(mp, "Path", s, nuline);
+ mp_print_ln(mp);
+ @.Path at line...@>
+ mp_pr_path(mp, h);
+ mp_end_diagnostic(mp, 1);
+}
+
+@ @<Declarations@>=
+static mp_knot mp_new_knot (MP mp);
+
+@ @c
+static mp_knot mp_new_knot (MP mp)
+{
+ mp_knot q;
+ if (mp->knot_nodes) {
+ q = mp->knot_nodes;
+ mp->knot_nodes = q->next;
+ mp->num_knot_nodes--;
+ } else {
+ q = mp_memory_clear_allocate(sizeof(struct mp_knot_data));
+ }
+ new_number(q->x_coord);
+ new_number(q->y_coord);
+ new_number(q->left_x);
+ new_number(q->left_y);
+ new_number(q->right_x);
+ new_number(q->right_y);
+ return q;
+}
+
+@ @<Declarations@>=
+static mp_gr_knot mp_gr_new_knot (MP mp);
+
+@ @c
+static mp_gr_knot mp_gr_new_knot (MP mp)
+{
+ mp_gr_knot q = mp_memory_allocate(sizeof(struct mp_gr_knot_data));
+ (void) mp;
+ return q;
+}
+
+@ If we want to duplicate a knot node, we can say |copy_knot|:
+
+@c
+static mp_knot mp_copy_knot (MP mp, mp_knot p)
+{
+ mp_knot q;
+ if (mp->knot_nodes) {
+ q = mp->knot_nodes;
+ mp->knot_nodes = q->next;
+ mp->num_knot_nodes--;
+ } else {
+ q = mp_memory_allocate(sizeof(struct mp_knot_data));
+ }
+ memcpy(q, p, sizeof(struct mp_knot_data));
+ if (mp->math_mode > mp_math_double_mode) {
+ new_number_clone(q->x_coord, p->x_coord);
+ new_number_clone(q->y_coord, p->y_coord);
+ new_number_clone(q->left_x, p->left_x);
+ new_number_clone(q->left_y, p->left_y);
+ new_number_clone(q->right_x, p->right_x);
+ new_number_clone(q->right_y, p->right_y);
+ }
+ mp_prev_knot(q) = NULL;
+ mp_next_knot(q) = NULL;
+ return q;
+}
+
+@ If we want to export a knot node, we can say |export_knot|:
+
+@c
+static mp_gr_knot mp_export_knot (MP mp, mp_knot p)
+{
+ mp_gr_knot q = mp_gr_new_knot(mp);
+ q->x_coord = number_to_double(p->x_coord);
+ q->y_coord = number_to_double(p->y_coord);
+ q->left_x = number_to_double(p->left_x);
+ q->left_y = number_to_double(p->left_y);
+ q->right_x = number_to_double(p->right_x);
+ q->right_y = number_to_double(p->right_y);
+ q->left_type = p->left_type;
+ q->right_type = p->right_type;
+ q->info = p->info;
+ q->originator = p->originator;
+ q->state = p->state;
+ q->prev = NULL;
+ q->next = NULL;
+ return q;
+}
+
+@ The |copy_path| routine makes a clone of a given path.
+
+@c
+static mp_knot mp_copy_path (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return NULL;
+ } else {
+ mp_knot q = mp_copy_knot(mp, p);
+ mp_knot qq = q;
+ mp_knot pp = mp_next_knot(p);
+ while (pp != p) {
+ mp_knot k = mp_copy_knot(mp, pp);
+ mp_next_knot(qq) = k;
+ mp_prev_knot(k) = qq;
+ qq = mp_next_knot(qq);
+ pp = mp_next_knot(pp);
+ }
+ mp_next_knot(qq) = q;
+ mp_prev_knot(q) = qq;
+ return q;
+ }
+}
+
+@ The |export_path| routine makes a clone of a given path
+and converts the |value|s therein to |double|s.
+
+@c
+static mp_gr_knot mp_export_path (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return NULL;
+ } else {
+ mp_gr_knot q = mp_export_knot(mp, p);
+ mp_gr_knot qq = q;
+ mp_knot pp = mp_next_knot(p);
+ while (pp != p) {
+ mp_gr_knot k = mp_export_knot(mp, pp);
+ mp_prev_knot(k) = qq;
+ mp_next_knot(qq) = k;
+ qq = k;
+ pp = mp_next_knot(pp);
+ }
+ mp_prev_knot(q) = qq;
+ mp_next_knot(qq) = q;
+ return q;
+ }
+}
+
+@ Just before |ship_out|, knot lists are exported for printing.
+
+@ The |export_knot_list| routine therefore also makes a clone of a given path.
+
+@c
+static mp_gr_knot mp_export_knot_list (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return NULL;
+ } else {
+ mp_gr_knot q = mp_export_path(mp, p);
+ return q;
+ }
+}
+
+@ Similarly, there's a way to copy the {\em reverse} of a path. This procedure
+returns a pointer to the first node of the copy, if the path is a cycle, but to
+the final node of a non-cyclic copy. The global variable |path_tail| will point
+to the final node of the original path; this trick makes it easier to implement
+|doublepath|.
+
+All node types are assumed to be |endpoint| or |explicit| only.
+
+@c
+static mp_knot mp_htap_ypoc (MP mp, mp_knot p)
+{
+ mp_knot q = mp_new_knot(mp); /* this will correspond to |p| */
+ mp_knot qq = q;
+ mp_knot pp = p;
+ while (1) {
+ mp_right_type(qq) = mp_left_type(pp);
+ mp_left_type(qq) = mp_right_type(pp);
+ number_clone(qq->x_coord, pp->x_coord);
+ number_clone(qq->y_coord, pp->y_coord);
+ number_clone(qq->right_x, pp->left_x);
+ number_clone(qq->right_y, pp->left_y);
+ number_clone(qq->left_x, pp->right_x);
+ number_clone(qq->left_y, pp->right_y);
+ mp_originator(qq) = mp_originator(pp);
+ mp_knotstate(qq) = mp_knotstate(pp);
+ if (mp_next_knot(pp) == p) {
+ mp_prev_knot(qq) = q;
+ mp_next_knot(q) = qq;
+ mp->path_tail = pp;
+ return q;
+ } else {
+ mp_knot rr = mp_new_knot(mp);
+ mp_prev_knot(qq) = rr;
+ mp_next_knot(rr) = qq;
+ qq = rr;
+ pp = mp_next_knot(pp);
+ }
+ }
+}
+
+@ @<Glob...@>=
+mp_knot path_tail; /* the node that links to the beginning of a path */
+
+@ When a cyclic list of knot nodes is no longer needed, it can be recycled by
+calling the following subroutine.
+
+@<Declarations@>=
+static void mp_toss_knot_list (MP mp, mp_knot p);
+static void mp_toss_knot (MP mp, mp_knot p);
+static void mp_free_knot (MP mp, mp_knot p);
+
+@ Numbers are unions of a scaled (integer), double or pointer. The pointer is
+used for e.g.\ decimal numbers. These are structs with a size that is set at
+compile time. A decimal number struct is allocated in the new_number function and
+all the \METAPOST\ data structures that have number handle clean up and renewal.
+Keeping the numbers in the free know list entries is just not worth the effort so
+in decimal mode quite a bit of (de/re)allocation goes on.
+
+@c
+static void mp_free_knot (MP mp, mp_knot q)
+{
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(q->x_coord);
+ free_number(q->y_coord);
+ free_number(q->left_x);
+ free_number(q->left_y);
+ free_number(q->right_x);
+ free_number(q->right_y);
+ }
+ mp_memory_free(q);
+}
+
+static void mp_toss_knot (MP mp, mp_knot q)
+{
+ if (mp->num_knot_nodes < mp->max_knot_nodes) {
+ mp_next_knot(q) = mp->knot_nodes;
+ mp->knot_nodes = q;
+ mp->num_knot_nodes++;
+ if (mp->math_mode > mp_math_double_mode) {
+ free_number(q->x_coord);
+ free_number(q->y_coord);
+ free_number(q->left_x);
+ free_number(q->left_y);
+ free_number(q->right_x);
+ free_number(q->right_y);
+ }
+ } else {
+ mp_free_knot(mp, q);
+ }
+}
+
+static void mp_toss_knot_list (MP mp, mp_knot p)
+{
+ if (p == NULL) {
+ return;
+ } else {
+ mp_knot q = p;
+ do {
+ mp_knot r = mp_next_knot(q);
+ mp_toss_knot(mp, q);
+ q = r;
+ } while (q != p);
+ }
+}
+
+@* Choosing control points.
+
+Now we must actually delve into one of \MP's more difficult routines, the
+|make_choices| procedure that chooses angles and control points for the splines
+of a curve when the user has not specified them explicitly. The parameter to
+|make_choices| points to a list of knots and path information, as described
+above.
+
+A path decomposes into independent segments at \quote {breakpoint} knots, which are
+knots whose left and right angles are both prespecified in some way (i.e., their
+|mp_left_type| and |mp_right_type| aren't both open).
+
+@c
+void mp_make_choices (MP mp, mp_knot knots)
+{
+ mp_knot h; /* the first breakpoint */
+ mp_knot p, q; /* consecutive breakpoints being processed */
+ @<Other local variables for |make_choices|@>
+ /* make sure that |arith_error=false| */
+ check_arith();
+ if (number_positive(internal_value(mp_tracing_choices_internal))) {
+ mp_print_path(mp, knots, ", before choices", 1);
+ }
+ @<If consecutive knots are equal, join them explicitly@>
+ @<Find the first breakpoint, |h|, on the path; insert an artificial breakpoint if the path is an unbroken cycle@>
+ p = h;
+ do {
+ @<Fill in the control points between |p| and the next breakpoint, thenadvance |p| to that breakpoint@>
+ } while (p != h);
+ if (number_positive(internal_value(mp_tracing_choices_internal))) {
+ mp_print_path(mp, knots, ", after choices", 1);
+ }
+ if (mp->arith_error) {
+ @<Report an unexpected problem during the choice-making@>
+ }
+}
+
+@ @<Internal ...@>=
+void mp_make_choices (MP mp, mp_knot knots);
+
+@ @<Report an unexpected problem during the choice...@>=
+mp_back_error(
+ mp,
+ "Some number got too big",
+ "The path that I just computed is out of range. So it will probably look funny.\n"
+ "Proceed, for a laugh."
+);
+@.Some number got too big@>
+mp_get_x_next(mp);
+mp->arith_error = 0;
+
+@ Two knots in a row with the same coordinates will always be joined by an
+explicit \quote {curve} whose control points are identical with the knots.
+
+@<If consecutive knots are equal, join them explicitly@>=
+p = knots;
+do {
+ q = mp_next_knot(p);
+ if (number_equal(p->x_coord, q->x_coord) && number_equal(p->y_coord, q->y_coord) && mp_right_type(p) > mp_explicit_knot) {
+ mp_right_type(p) = mp_explicit_knot;
+ if (mp_left_type(p) == mp_open_knot) {
+ mp_left_type(p) = mp_curl_knot;
+ set_number_to_unity(p->left_curl);
+ }
+ mp_left_type(q) = mp_explicit_knot;
+ if (mp_right_type(q) == mp_open_knot) {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_to_unity(q->right_curl);
+ }
+ number_clone(p->right_x, p->x_coord);
+ number_clone(q->left_x, p->x_coord);
+ number_clone(p->right_y, p->y_coord);
+ number_clone(q->left_y, p->y_coord);
+ }
+ p = q;
+} while (p != knots);
+
+@ If there are no breakpoints, it is necessary to compute the direction angles
+around an entire cycle. In this case the |mp_left_type| of the first node is
+temporarily changed to |end_cycle|.
+
+@<Find the first breakpoint, |h|, on the path...@>=
+h = knots;
+while (1) {
+ if (mp_left_type(h) != mp_open_knot) {
+ break;
+ } else if (mp_right_type(h) != mp_open_knot) {
+ break;
+ } else {
+ h = mp_next_knot(h);
+ if (h == knots) {
+ mp_left_type(h) = mp_end_cycle_knot;
+ break;
+ }
+ }
+}
+
+@ If |mp_right_type(p) < given| and |q = mp_link(p)|, we must have
+|mp_right_type(p) = mp_left_type(q) = mp_explicit| or |endpoint|.
+
+@<Fill in the control points between |p| and the next breakpoint...@>=
+q = mp_next_knot(p);
+if (mp_right_type(p) >= mp_given_knot) {
+ while ((mp_left_type(q) == mp_open_knot) && (mp_right_type(q) == mp_open_knot)) {
+ q = mp_next_knot(q);
+ }
+ @<Fill in the control information between consecutive breakpoints |p| and |q|@>
+} else if (mp_right_type(p) == mp_endpoint_knot) {
+ @<Give reasonable values for the unused control points between |p| and~|q|@>
+}
+p = q;
+
+@ This step makes it possible to transform an explicitly computed path without
+checking the |mp_left_type| and |mp_right_type| fields.
+
+@<Give reasonable values for the unused control points between |p| and~|q|@>=
+number_clone(p->right_x, p->x_coord);
+number_clone(p->right_y, p->y_coord);
+number_clone(q->left_x, q->x_coord);
+number_clone(q->left_y, q->y_coord);
+
+@ Before we can go further into the way choices are made, we need to consider the
+underlying theory. The basic ideas implemented in |make_choices| are due to John
+Hobby, who introduced the notion of \quote {mock curvature} @^Hobby, John
+Douglas@> at a knot. Angles are chosen so that they preserve mock curvature when
+a knot is passed, and this has been found to produce excellent results.
+
+It is convenient to introduce some notations that simplify the necessary
+formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance between
+knots |k| and |k+1|; and let
+
+$${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$
+
+so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left through an
+angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$. The control
+points for the spline from $z_k$ to $z\k$ will be denoted by
+
+$$\eqalign{z_k^+&=z_k+ \textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr
+z\k^-&=z\k- \textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$
+
+where $\rho_k$ and $\sigma\k$ are nonnegative \quote {velocity ratios} at the
+beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the
+corresponding \quote {offset angles.} These angles satisfy the condition
+
+$$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$
+
+whenever the curve leaves an intermediate knot~|k| in the direction that it
+enters.
+
+@ Let $\alpha_k$ and $\beta\k$ be the reciprocals of the \quote {tension} of the curve
+at its beginning and ending points. This means that $\rho_k=\alpha_k
+f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$, where
+$f(\theta,\phi)$ is \MP's standard velocity function defined in the |velocity|
+subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+, z\k^-,z\k^{\phantom+};t)$
+has curvature @^curvature@>
+
+$${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}} \qquad{\rm
+and}\qquad {2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$
+
+at |t=0| and |t=1|, respectively. The mock curvature is the linear @^mock
+curvature@> approximation to this true curvature that arises in the limit for
+small $\theta_k$ and~$\phi\k$, if second-order terms are discarded. The standard
+velocity function satisfies $$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$
+hence the mock curvatures are respectively
+
+$${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}} \qquad{\rm
+and}\qquad
+{2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$
+
+@ The turning angles $\psi_k$ are given, and equation $(*)$ above determines
+$\phi_k$ when $\theta_k$ is known, so the task of angle selection is essentially
+to choose appropriate values for each $\theta_k$. When equation~$(*)$ is used to
+eliminate $\phi$~variables from $(**)$, we obtain a system of linear equations of
+the form
+
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+
+where
+
+$$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}}, \qquad
+B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}}, \qquad
+C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}}, \qquad
+D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$
+
+The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$ will
+be at most $4\over3$. It follows that $B_k|5\over4|A_k$ and
+$C_k|5\over4|D_k$; hence the equations are diagonally dominant; hence they have
+a unique solution. Moreover, in most cases the tensions are equal to~1, so that
+$B_k=2A_k$ and $C_k=2D_k$. This makes the solution numerically stable, and there
+is an exponential damping effect: The data at knot $k\pm j$ affects the angle at
+knot~$k$ by a factor of~$O(2^{-j})$.
+
+@ However, we still must consider the angles at the starting and ending knots of
+a non-cyclic path. These angles might be given explicitly, or they might be
+specified implicitly in terms of an amount of \quote {curl.}
+
+Let's assume that angles need to be determined for a non-cyclic path starting at
+$z_0$ and ending at~$z_n$. Then equations of the form
+
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$
+
+have been given for
+$0<k<n$, and it will be convenient to introduce equations of the same form for
+$k=0$ and $k=n$, where
+
+$$A_0=B_0=C_n=D_n=0.$$
+
+If $\theta_0$ is supposed to have a given value $E_0$, we simply define $C_0=1$,
+$D_0=0$, and $R_0=E_0$. Otherwise a curl parameter, $\gamma_0$, has been
+specified at~$z_0$; this means that the mock curvature at $z_0$ should be
+$\gamma_0$ times the mock curvature at $z_1$; i.e.,
+
+$${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}}
+=\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$
+
+This equation simplifies to
+
+$$(\alpha_0\chi_0+3-\beta_1)\theta_0+
+\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1=
+-\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$
+
+where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0=
+\chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$. It
+can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$, hence the
+linear equations remain nonsingular.
+
+Similar considerations apply at the right end, when the final angle $\phi_n$ may
+or may not need to be determined. It is convenient to let $\psi_n=0$, hence
+$\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$, or we
+have
+
+$$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+
+(\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad
+\chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$
+
+When |make_choices| chooses angles, it must compute the coefficients of these
+linear equations, then solve the equations. To compute the coefficients, it is
+necessary to compute arctangents of the given turning angles~$\psi_k$. When the
+equations are solved, the chosen directions $\theta_k$ are put back into the form
+of control points by essentially computing sines and cosines.
+
+@ OK, we are ready to make the hard choices of |make_choices|. Most of the work
+is relegated to an auxiliary procedure called |solve_choices|, which has been
+introduced to keep |make_choices| from being extremely long.
+
+@<Fill in the control information between...@>=
+@<FillInAllocate@>
+@<Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$; set $n$ to the length of the path@>
+@<Remove |open| types at the breakpoints@>
+@<FillInDeallocate@>
+mp_solve_choices(mp, p, q, n);
+
+@ It's convenient to precompute quantities that will be needed several times
+later. The values of |delta_x[k]| and |delta_y[k]| will be the coordinates of
+$z\k-z_k$, and the magnitude of this vector will be |delta[k]=@t$d_{k,k+1}$@>|.
+The path angle $\psi_k$ between $z_k-z_{k-1}$ and $z\k-z_k$ will be stored in
+|psi[k]|.
+
+@<Glob...@>=
+int path_size; /* maximum number of knots between breakpoints of a path */
+int path_padding; /* be nice */
+
+mp_number *delta_x;
+mp_number *delta_y;
+mp_number *delta; /* knot differences */
+mp_number *psi; /* turning angles */
+
+@ @<Dealloc variables@>=
+for (int k = 0; k<mp->path_size; k++) {
+ free_number(mp->delta_x[k]);
+ free_number(mp->delta_y[k]);
+ free_number(mp->delta[k]);
+ free_number(mp->psi[k]);
+}
+mp_memory_free(mp->delta_x);
+mp_memory_free(mp->delta_y);
+mp_memory_free(mp->delta);
+mp_memory_free(mp->psi);
+
+@ @<Other local variables for |make_choices|@>=
+int k, n; /* current and final knot numbers */
+mp_knot s, t; /* registers for list traversal */
+
+@ @<FillInAllocate@>=
+mp_number sine, cosine; /* trig functions of various angles */
+mp_number arg1, arg2, r1, r2;
+mp_number delx, dely; /* directions where |open| meets |explicit| */
+new_fraction(sine);
+new_fraction(cosine);
+new_number(arg1);
+new_number(arg2);
+new_fraction(r1);
+new_fraction(r2);
+new_number(delx);
+new_number(dely);
+
+@ @<FillInDeallocate@>=
+free_number(sine);
+free_number(cosine);
+free_number(arg1);
+free_number(arg2);
+free_number(r1);
+free_number(r2);
+free_number(delx);
+free_number(dely);
+
+@ @<Calculate the turning angles...@>=
+{
+ RESTART:
+ k = 0;
+ s = p;
+ n = mp->path_size;
+ do {
+ t = mp_next_knot(s);
+ set_number_from_subtraction(mp->delta_x[k], t->x_coord, s->x_coord);
+ set_number_from_subtraction(mp->delta_y[k], t->y_coord, s->y_coord);
+ pyth_add(mp->delta[k], mp->delta_x[k], mp->delta_y[k]);
+ if (k > 0) {
+ make_fraction(r1, mp->delta_y[k - 1], mp->delta[k - 1]);
+ number_clone(sine, r1);
+ make_fraction(r2, mp->delta_x[k - 1], mp->delta[k - 1]);
+ number_clone(cosine, r2);
+ take_fraction(r1, mp->delta_x[k], cosine);
+ take_fraction(r2, mp->delta_y[k], sine);
+ set_number_from_addition(arg1, r1, r2);
+ take_fraction(r1, mp->delta_y[k], cosine);
+ take_fraction(r2, mp->delta_x[k], sine);
+ set_number_from_subtraction(arg2, r1, r2);
+ n_arg(mp->psi[k], arg1, arg2 );
+ }
+ ++k;
+ s = t;
+ if (k == mp->path_size) {
+ mp_reallocate_paths(mp, mp->path_size + (mp->path_size / 4));
+ goto RESTART; /* retry, loop size has changed */
+ } else if (s == q) {
+ n = k;
+ }
+ } while (! ((k >= n) && (mp_left_type(s) != mp_end_cycle_knot)));
+ if (k == n) {
+ set_number_to_zero(mp->psi[k]);
+ } else {
+ number_clone(mp->psi[k], mp->psi[1]);
+ }
+}
+
+@ When we get to this point of the code, |mp_right_type(p)| is either |given| or
+|curl| or |open|. If it is |open|, we must have |mp_left_type(p)=mp_end_cycle| or
+|mp_left_type(p)=mp_explicit|. In the latter case, the |open| type is converted
+to |given|; however, if the velocity coming into this knot is zero, the |open|
+type is converted to a |curl|, since we don't know the incoming direction.
+
+Similarly, |mp_left_type(q)| is either |given| or |curl| or |open| or
+|mp_end_cycle|. The |open| possibility is reduced either to |given| or to |curl|.
+
+@<Remove |open| types at the breakpoints@>=
+{
+ if (mp_left_type(q) == mp_open_knot) {
+ set_number_from_subtraction(delx, q->right_x, q->x_coord);
+ set_number_from_subtraction(dely, q->right_y, q->y_coord);
+ if (number_zero(delx) && number_zero(dely)) {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_to_unity(q->left_curl);
+ } else {
+ mp_left_type(q) = mp_given_knot;
+ n_arg(q->left_given, delx, dely);
+ }
+ }
+ if ((mp_right_type(p) == mp_open_knot) && (mp_left_type(p) == mp_explicit_knot)) {
+ set_number_from_subtraction(delx, p->x_coord, p->left_x);
+ set_number_from_subtraction(dely, p->y_coord, p->left_y);
+ if (number_zero(delx) && number_zero(dely)) {
+ mp_right_type(p) = mp_curl_knot;
+ set_number_to_unity(p->right_curl);
+ } else {
+ mp_right_type(p) = mp_given_knot;
+ n_arg(p->right_given, delx, dely);
+ }
+ }
+}
+
+@ Linear equations need to be solved whenever |n>1|; and also when |n=1| and
+exactly one of the breakpoints involves a curl. The simplest case occurs when
+|n=1| and there is a curl at both breakpoints; then we simply draw a straight
+line.
+
+But before coding up the simple cases, we might as well face the general case,
+since we must deal with it sooner or later, and since the general case is likely
+to give some insight into the way simple cases can be handled best.
+
+When there is no cycle, the linear equations to be solved form a tridiagonal
+system, and we can apply the standard technique of Gaussian elimination to
+convert that system to a sequence of equations of the form
+
+$$\theta_0+u_0\theta_1=v_0,\quad \theta_1+u_1\theta_2=v_1,\quad\ldots,\quad
+\theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad \theta_n=v_n.$$
+
+It is possible to do this diagonalization while generating the equations. Once
+$\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots, $\theta_1$,
+$\theta_0$; thus, the equations will be solved.
+
+The procedure is slightly more complex when there is a cycle, but the basic idea
+will be nearly the same. In the cyclic case the right-hand sides will be
+$v_k+w_k\theta_0$ instead of simply $v_k$, and we will start the process off with
+$u_0=v_0=0$, $w_0=1$. The final equation will be not $\theta_n=v_n$ but
+$\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate ending routine will take
+account of the fact that $\theta_n=\theta_0$ and eliminate the $w$'s from the
+system, after which the solution can be obtained as before.
+
+When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer variables |r|,
+|s|,~|t| will point respectively to knots |k-1|, |k|, and~|k+1|. The $u$'s and
+$w$'s are scaled by $2^{28}$, i.e., they are of type |fraction|; the $\theta$'s
+and $v$'s are of type |angle|.
+
+@<Glob...@>=
+mp_number *theta; /* values of $\theta_k$ */
+mp_number *uu; /* values of $u_k$ */
+mp_number *vv; /* values of $v_k$ */
+mp_number *ww; /* values of $w_k$ */
+
+@ @<Dealloc variables@>=
+for (int k = 0; k < mp->path_size; k++) {
+ free_number(mp->theta[k]);
+ free_number(mp->uu[k]);
+ free_number(mp->vv[k]);
+ free_number(mp->ww[k]);
+}
+mp_memory_free(mp->theta);
+mp_memory_free(mp->uu);
+mp_memory_free(mp->vv);
+mp_memory_free(mp->ww);
+
+@ @<Declarations@>=
+static void mp_reallocate_paths (MP mp, int l);
+
+@ @c
+void mp_reallocate_paths (MP mp, int l)
+{
+ mp->delta_x = mp_memory_reallocate(mp->delta_x, (size_t) (l + 1) * sizeof(mp_number));
+ mp->delta_y = mp_memory_reallocate(mp->delta_y, (size_t) (l + 1) * sizeof(mp_number));
+ mp->delta = mp_memory_reallocate(mp->delta, (size_t) (l + 1) * sizeof(mp_number));
+ mp->psi = mp_memory_reallocate(mp->psi, (size_t) (l + 1) * sizeof(mp_number));
+ mp->theta = mp_memory_reallocate(mp->theta, (size_t) (l + 1) * sizeof(mp_number));
+ mp->uu = mp_memory_reallocate(mp->uu, (size_t) (l + 1) * sizeof(mp_number));
+ mp->vv = mp_memory_reallocate(mp->vv, (size_t) (l + 1) * sizeof(mp_number));
+ mp->ww = mp_memory_reallocate(mp->ww, (size_t) (l + 1) * sizeof(mp_number));
+ for (int k = mp->path_size; k<l; k++) {
+ new_number(mp->delta_x[k]);
+ new_number(mp->delta_y[k]);
+ new_number(mp->delta[k]);
+ new_angle(mp->psi[k]);
+ new_angle(mp->theta[k]);
+ new_fraction(mp->uu[k]);
+ new_angle(mp->vv[k]);
+ new_fraction(mp->ww[k]);
+ }
+ mp->path_size = l;
+}
+
+@ Our immediate problem is to get the ball rolling by setting up the first
+equation or by realizing that no equations are needed, and to fit this
+initialization into a framework suitable for the overall computation.
+
+@<Declarations@>=
+static void mp_solve_choices (MP mp, mp_knot p, mp_knot q, int n);
+
+@ @c
+void mp_solve_choices (MP mp, mp_knot p, mp_knot q, int n)
+{
+ int k = 0; /* current knot number */
+ mp_knot r = 0;
+ mp_knot s = p;
+ mp_number ff;
+ new_fraction(ff);
+ while (1) {
+ mp_knot t = mp_next_knot(s);
+ if (k == 0) {
+ @<Get the linear equations started; or |return| with the control points in place, if linear equations needn't be solved@>
+ } else {
+ switch (mp_left_type(s)) {
+ case mp_end_cycle_knot:
+ case mp_open_knot:
+ @<Set up the equation to match mock curvatures at $z_k$; then |goto found| with $\theta_n$ adjusted to equal $\theta_0$, if a cycle has ended@>
+ break;
+ case mp_curl_knot:
+ @<Set up the equation for a curl at $\theta_n$ and |goto found|@>
+ break;
+ case mp_given_knot:
+ @<Calculate the given value of $\theta_n$ and |goto found|@>
+ break;
+ }
+ }
+ r = s;
+ s = t;
+ ++k;
+ }
+FOUND:
+ @<Finish choosing angles and assigning control points@>
+ free_number(ff);
+}
+
+@ On the first time through the loop, we have |k=0| and |r| is not yet defined.
+The first linear equation, if any, will have $A_0=B_0=0$.
+
+@<Get the linear equations started...@>=
+switch (mp_right_type(s)) {
+ case mp_given_knot:
+ if (mp_left_type(t) == mp_given_knot) {
+ @<Reduce to simple case of two givens and |return|@>
+ } else {
+ @<Set up the equation for a given value of $\theta_0$@>
+ }
+ break;
+ case mp_curl_knot:
+ if (mp_left_type(t) == mp_curl_knot) {
+ @<Reduce to simple case of straight line and |return|@>
+ } else {
+ @<Set up the equation for a curl at $\theta_0$@>
+ }
+ break;
+ case mp_open_knot:
+ set_number_to_zero(mp->uu[0]);
+ set_number_to_zero(mp->vv[0]);
+ number_clone(mp->ww[0], fraction_one_t);
+ /* this begins a cycle */
+ break;
+}
+
+@ The general equation that specifies equality of mock curvature at $z_k$ is
+
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+
+as derived above. We want to combine this with the already-derived equation
+$\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain a new
+equation $\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the
+equation
+
+$$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1}
+-A_kw_{k-1}\theta_0$$
+
+by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with fixed-point
+arithmetic, avoiding the chance of overflow while retaining suitable precision.
+
+The calculations will be performed in several registers that provide temporary
+storage for intermediate quantities.
+
+@ @<Set up the equation to match mock curvatures...@>=
+{
+ mp_number aa, bb, cc, acc; /* temporary registers */
+ mp_number dd, ee; /* likewise, but |scaled| */
+ new_fraction(aa);
+ new_fraction(bb);
+ new_fraction(cc);
+ new_fraction(acc);
+ new_number(dd);
+ new_number(ee);
+ @<Calculate the values $|aa|=A_k/B_k$, $|bb|=D_k/C_k$, $|dd|=(3-\alpha_{k-1})d_{k,k+1}$, $|ee|=(3-\beta\k)d_{k-1,k}$, and $|cc|=(B_k-u_{k-1}A_k)/B_k$@>
+ @<Calculate the ratio $|ff|=C_k/(C_k+B_k-u_{k-1}A_k)$@>
+ take_fraction(mp->uu[k], ff, bb);
+ @<Calculate the values of $v_k$ and $w_k$@>
+ if (mp_left_type(s) == mp_end_cycle_knot) {
+ @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>
+ }
+ free_number(aa);
+ free_number(bb);
+ free_number(cc);
+ free_number(acc);
+ free_number(dd);
+ free_number(ee);
+}
+
+@ Since tension values are never less than 3/4, the values |aa| and |bb| computed
+here are never more than 4/5.
+
+@<Calculate the values $|aa|=...@>=
+{
+ mp_number absval;
+ new_number_abs(absval, r->right_tension);
+ if (number_equal(absval, unity_t)) {
+ number_clone(aa, fraction_half_t);
+ number_clone(dd, mp->delta[k]);
+ number_double(dd);
+ } else {
+ mp_number arg1, arg2, ret;
+ new_number(arg1);
+ new_number_abs(arg2, r->right_tension);
+ number_multiply_int(arg2, 3);
+ number_subtract(arg2, unity_t);
+ make_fraction(aa, unity_t, arg2);
+ number_abs_clone(arg2, r->right_tension);
+ new_fraction(ret);
+ make_fraction(ret, unity_t, arg2);
+ set_number_from_subtraction(arg1, fraction_three_t, ret);
+ take_fraction(arg2, mp->delta[k], arg1);
+ number_clone(dd, arg2);
+ free_number(ret);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ number_abs_clone(absval, t->left_tension);
+ if (number_equal(absval, unity_t)) {
+ number_clone(bb, fraction_half_t);
+ number_clone(ee, mp->delta[k - 1]);
+ number_double(ee);
+ } else {
+ mp_number arg1, arg2, ret;
+ new_number(arg1);
+ new_number_abs(arg2, t->left_tension);
+ number_multiply_int(arg2, 3);
+ number_subtract(arg2, unity_t);
+ make_fraction(bb, unity_t, arg2);
+ number_abs_clone(arg2, t->left_tension);
+ new_fraction(ret);
+ make_fraction(ret, unity_t, arg2);
+ set_number_from_subtraction(arg1, fraction_three_t, ret);
+ take_fraction(ee, mp->delta[k - 1], arg1);
+ free_number(ret);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ free_number(absval);
+}
+{
+ mp_number r1;
+ new_number(r1);
+ take_fraction(r1, mp->uu[k - 1], aa);
+ set_number_from_subtraction(cc, fraction_one_t, r1);
+ free_number(r1);
+}
+
+@ The ratio to be calculated in this step can be written in the form
+
+$$\beta_k^2\cdot|ee|\over\beta_k^2\cdot|ee|+\alpha_k^2\cdot
+|cc|\cdot|dd|,$$
+
+because of the quantities just calculated. The values of |dd| and |ee| will not
+be needed after this step has been performed.
+
+@<Calculate the ratio $|ff|=C_k/(C_k+B_k-u_{k-1}A_k)$@>=
+{
+ mp_number rt, lt;
+ mp_number arg2;
+ new_number_clone(arg2, dd);
+ take_fraction(dd, arg2, cc);
+ new_number_abs(lt, s->left_tension);
+ new_number_abs(rt, s->right_tension);
+ if (! number_equal(lt, rt)) {
+ /* $\beta_k^{-1}\ne\alpha_k^{-1}$ */
+ mp_number r1;
+ new_number(r1);
+ if (number_less(lt, rt)) {
+ /* $\alpha_k^2/\beta_k^2$ */
+ make_fraction(r1, lt, rt);
+ take_fraction(ff, r1, r1);
+ number_clone(r1, dd);
+ take_fraction(dd, r1, ff);
+ } else {
+ /* $\beta_k^2/\alpha_k^2$ */
+ make_fraction(r1, rt, lt);
+ take_fraction(ff, r1, r1);
+ number_clone(r1, ee);
+ take_fraction(ee, r1, ff);
+ }
+ free_number(r1);
+ }
+ free_number(rt);
+ free_number(lt);
+ set_number_from_addition(arg2, dd, ee);
+ make_fraction(ff, ee, arg2);
+ free_number(arg2);
+}
+
+@ The value of $u_{k-1}$ will be |<=1| except when $k=1$ and the previous
+equation was specified by a curl. In that case we must use a special method of
+computation to prevent overflow.
+
+Fortunately, the calculations turn out to be even simpler in this \quote {hard} case.
+The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence
+$-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-|cc|\cdot B_1\psi_1$.
+
+@<Calculate the values of $v_k$ and $w_k$@>=
+take_fraction(acc, mp->psi[k + 1], mp->uu[k]);
+number_negate(acc);
+if (mp_right_type(r) == mp_curl_knot) {
+ mp_number r1, arg2;
+ new_fraction(r1);
+ new_number(arg2);
+ set_number_from_subtraction(arg2, fraction_one_t, ff);
+ take_fraction(r1, mp->psi[1], arg2);
+ set_number_to_zero(mp->ww[k]);
+ set_number_from_subtraction(mp->vv[k], acc, r1);
+ free_number(r1);
+ free_number(arg2);
+} else {
+ mp_number arg1, r1;
+ new_fraction(r1);
+ new_number(arg1);
+ set_number_from_subtraction(arg1, fraction_one_t, ff);
+ /* this is $B_k/(C_k+B_k-u_{k-1}A_k)<5$ */
+ make_fraction(ff, arg1, cc);
+ free_number(arg1);
+ take_fraction(r1, mp->psi[k], ff);
+ number_subtract(acc, r1);
+ number_clone(r1, ff);
+ /* this is $A_k/(C_k+B_k-u_{k-1}A_k)$ */
+ take_fraction(ff, r1, aa);
+ take_fraction(r1, mp->vv[k - 1], ff);
+ set_number_from_subtraction(mp->vv[k], acc, r1 );
+ if (number_zero(mp->ww[k - 1])) {
+ set_number_to_zero(mp->ww[k]);
+ } else {
+ take_fraction(mp->ww[k], mp->ww[k - 1], ff);
+ number_negate(mp->ww[k]);
+ }
+ free_number(r1);
+}
+
+@ When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k=
+v_k+w_k\theta_0$, for |1<=k<=n|. We would like to determine the value of
+$\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$ for
+|0<=k<n|, so that the cyclic case can be finished up just as if there were no
+cycle.
+
+The idea in the following code is to observe that
+
+$$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr
+&=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots
+-u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0))\bigr),\cr}$$
+
+so we can solve for $\theta_n=\theta_0$.
+
+@<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>=
+mp_number arg2, r1;
+new_number(arg2);
+new_number(r1);
+set_number_to_zero(aa);
+number_clone(bb, fraction_one_t); /* we have |k=n| */
+do {
+ --k;
+ if (k == 0) {
+ k = n;
+ }
+ take_fraction(r1, aa, mp->uu[k]);
+ set_number_from_subtraction(aa, mp->vv[k], r1);
+ take_fraction(r1, bb, mp->uu[k]);
+ set_number_from_subtraction(bb, mp->ww[k], r1);
+} while (k != n);
+/* now $\theta_n=|aa|+|bb|\cdot\theta_n$ */
+set_number_from_subtraction(arg2, fraction_one_t, bb);
+make_fraction(r1, aa, arg2);
+number_clone(aa, r1);
+number_clone(mp->theta[n], aa);
+number_clone(mp->vv[0], aa);
+for (k = 1; k < n; k++) {
+ take_fraction(r1, aa, mp->ww[k]);
+ number_add(mp->vv[k], r1);
+}
+free_number(arg2);
+free_number(r1);
+free_number(aa);
+free_number(bb);
+free_number(cc);
+free_number(acc);
+free_number(dd);
+free_number(ee);
+goto FOUND;
+
+@ @c
+static void mp_reduce_angle (MP mp, mp_number *a)
+{
+ mp_number abs_a;
+ new_number_abs(abs_a, *a);
+ if (number_greater(abs_a, one_eighty_deg_t)) {
+ if (number_positive(*a)) {
+ number_subtract(*a, three_sixty_deg_t);
+ } else {
+ number_add(*a, three_sixty_deg_t);
+ }
+ }
+ free_number(abs_a);
+}
+
+@ @<Declarations@>=
+static void mp_reduce_angle (MP mp, mp_number *a);
+
+@ @<Calculate the given value of $\theta_n$...@>=
+{
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->delta_x[n - 1], mp->delta_y[n - 1]);
+ set_number_from_subtraction(mp->theta[n], s->left_given, narg);
+ free_number(narg);
+ mp_reduce_angle(mp, &mp->theta[n]);
+ goto FOUND;
+}
+
+@ @<Set up the equation for a given value of $\theta_0$@>=
+{
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->delta_x[0], mp->delta_y[0]);
+ set_number_from_subtraction(mp->vv[0], s->right_given, narg);
+ free_number(narg);
+ mp_reduce_angle(mp, &mp->vv[0]);
+ set_number_to_zero(mp->uu[0]);
+ set_number_to_zero(mp->ww[0]);
+}
+
+@ @<Set up the equation for a curl at $\theta_0$@>=
+{
+ mp_number lt, rt, cc; /* tension values */
+ new_number_clone(cc, s->right_curl);
+ new_number_abs(lt, t->left_tension);
+ new_number_abs(rt, s->right_tension);
+ if (number_unity(rt) && number_unity(lt)) {
+ mp_number arg1, arg2;
+ new_number_clone(arg1, cc);
+ new_number_clone(arg2, cc);
+ number_double(arg1);
+ number_add(arg1, unity_t);
+ number_add(arg2, two_t);
+ make_fraction(mp->uu[0], arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ } else {
+ mp_curl_ratio(mp, &mp->uu[0], &cc, &rt, &lt);
+ }
+ take_fraction(mp->vv[0], mp->psi[1], mp->uu[0]);
+ number_negate(mp->vv[0]);
+ set_number_to_zero(mp->ww[0]);
+ free_number(rt);
+ free_number(lt);
+ free_number(cc);
+}
+
+@ @<Set up the equation for a curl at $\theta_n$...@>=
+{
+ mp_number lt, rt, cc; /* tension values */
+ new_number_clone(cc, s->left_curl);
+ new_number_abs(lt, s->left_tension);
+ new_number_abs(rt, r->right_tension);
+ if (number_unity(rt) && number_unity(lt)) {
+ mp_number arg1, arg2;
+ new_number_clone(arg1, cc);
+ new_number_clone(arg2, cc);
+ number_double(arg1);
+ number_add(arg1, unity_t);
+ number_add(arg2, two_t);
+ make_fraction(ff, arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ } else {
+ mp_curl_ratio(mp, &ff, &cc, &lt, &rt);
+ }
+ {
+ mp_number arg1, arg2, r1;
+ new_fraction(r1);
+ new_fraction(arg1);
+ new_number(arg2);
+ take_fraction(arg1, mp->vv[n - 1], ff);
+ take_fraction(r1, ff, mp->uu[n - 1]);
+ set_number_from_subtraction(arg2, fraction_one_t, r1);
+ make_fraction(mp->theta[n], arg1, arg2);
+ number_negate(mp->theta[n]);
+ free_number(r1);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ free_number(rt);
+ free_number(lt);
+ free_number(cc);
+ goto FOUND;
+}
+
+@ The |curl_ratio| subroutine has three arguments, which our previous notation
+encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is a somewhat
+tedious program to calculate
+
+$${(3-\alpha)\alpha^2\gamma+\beta^3\over \alpha^3\gamma+(3-\beta)\beta^2},$$
+
+with the result reduced to 4 if it exceeds 4. (This reduction of curl is
+necessary only if the curl and tension are both large.) The values of $\alpha$
+and $\beta$ will be at most~4/3.
+
+@<Declarations@>=
+static void mp_curl_ratio (MP mp, mp_number *ret, mp_number *gamma, mp_number *a_tension, mp_number *b_tension);
+
+@ @c
+void mp_curl_ratio (MP mp, mp_number *ret, mp_number *gamma_orig, mp_number *a_tension, mp_number *b_tension)
+{
+ mp_number alpha, beta, gamma, num, denom, ff; /* registers */
+ mp_number arg1;
+ new_number(arg1);
+ new_fraction(alpha);
+ new_fraction(beta);
+ new_fraction(gamma);
+ new_fraction(ff);
+ new_fraction(denom);
+ new_fraction(num);
+ make_fraction(alpha, unity_t, *a_tension);
+ make_fraction(beta, unity_t, *b_tension);
+ number_clone(gamma, *gamma_orig);
+ if (number_lessequal(alpha, beta)) {
+ make_fraction(ff, alpha, beta);
+ number_clone(arg1, ff);
+ take_fraction(ff, arg1, arg1);
+ number_clone(arg1, gamma);
+ take_fraction(gamma, arg1, ff);
+ convert_fraction_to_scaled(beta);
+ take_fraction(denom, gamma, alpha);
+ number_add(denom, three_t);
+ } else {
+ make_fraction(ff, beta, alpha);
+ number_clone(arg1, ff);
+ take_fraction(ff, arg1, arg1);
+ take_fraction(arg1, beta, ff);
+ convert_fraction_to_scaled(arg1);
+ number_clone(beta, arg1);
+ take_fraction(denom, gamma, alpha);
+ set_number_from_div(arg1, ff, twelvebits_3);
+ number_add(denom, arg1);
+ }
+ number_subtract(denom, beta);
+ set_number_from_subtraction(arg1, fraction_three_t, alpha);
+ take_fraction(num, gamma, arg1);
+ number_add(num, beta);
+ number_clone(arg1, denom);
+ number_double(arg1);
+ number_double(arg1); /* arg1 = 4*denom */
+ if (number_greaterequal(num, arg1)) {
+ number_clone(*ret, fraction_four_t);
+ } else {
+ make_fraction(*ret, num, denom);
+ }
+ free_number(alpha);
+ free_number(beta);
+ free_number(gamma);
+ free_number(num);
+ free_number(denom);
+ free_number(ff);
+ free_number(arg1);
+}
+
+@ We're in the home stretch now.
+
+@<Finish choosing angles and assigning control points@>=
+{
+ mp_number r1;
+ new_number(r1);
+ for (k = n - 1; k >= 0; k--) {
+ take_fraction(r1, mp->theta[k + 1], mp->uu[k]);
+ set_number_from_subtraction(mp->theta[k], mp->vv[k], r1);
+ }
+ free_number(r1);
+}
+s = p;
+k = 0;
+{
+ mp_number arg;
+ new_number(arg);
+ do {
+ mp_knot t = mp_next_knot(s);
+ n_sin_cos(mp->theta[k], mp->ct, mp->st);
+ number_negated_clone(arg, mp->psi[k + 1]);
+ number_subtract(arg, mp->theta[k + 1]);
+ n_sin_cos(arg, mp->cf, mp->sf);
+ mp_set_controls (mp, s, t, k);
+ ++k;
+ s = t;
+ } while (k != n);
+ free_number(arg);
+}
+
+@ The |set_controls| routine actually puts the control points into a pair of
+consecutive nodes |p| and~|q|. Global variables are used to record the values of
+$\sin\theta$, $\cos\theta$, $\sin\phi$, and $\cos\phi$ needed in this
+calculation.
+
+@<Glob...@>=
+mp_number st;
+mp_number ct;
+mp_number sf;
+mp_number cf; /* sines and cosines */
+
+@ @<Initialize table...@>=
+new_fraction(mp->st);
+new_fraction(mp->ct);
+new_fraction(mp->sf);
+new_fraction(mp->cf);
+
+@ @<Dealloc ...@>=
+free_number(mp->st);
+free_number(mp->ct);
+free_number(mp->sf);
+free_number(mp->cf);
+
+@ @<Declarations@>=
+static void mp_set_controls (MP mp, mp_knot p, mp_knot q, int k);
+
+@ @c
+void mp_set_controls (MP mp, mp_knot p, mp_knot q, int k)
+{
+ mp_number rr, ss; /* velocities, divided by thrice the tension */
+ mp_number lt, rt; /* tensions */
+ mp_number sine; /* $\sin(\theta+\phi)$ */
+ mp_number tmp;
+ mp_number r1, r2;
+ new_number(tmp);
+ new_number(r1);
+ new_number(r2);
+ new_number_abs(lt, q->left_tension);
+ new_number_abs(rt, p->right_tension);
+ new_fraction(sine);
+ new_fraction(rr);
+ new_fraction(ss);
+ velocity(rr, mp->st, mp->ct, mp->sf, mp->cf, rt);
+ velocity(ss, mp->sf, mp->cf, mp->st, mp->ct, lt);
+ if (number_negative(p->right_tension) || number_negative(q->left_tension)) {
+ @<Decrease the velocities, if necessary, to stay inside the bounding triangle@>
+ }
+ take_fraction(r1, mp->delta_x [k], mp->ct);
+ take_fraction(r2, mp->delta_y [k], mp->st);
+ number_subtract(r1, r2);
+ take_fraction(tmp, r1, rr);
+ set_number_from_addition(p->right_x, p->x_coord, tmp);
+ take_fraction(r1, mp->delta_y[k], mp->ct);
+ take_fraction(r2, mp->delta_x[k], mp->st);
+ number_add(r1, r2);
+ take_fraction(tmp, r1, rr);
+ set_number_from_addition(p->right_y, p->y_coord, tmp);
+ take_fraction(r1, mp->delta_x[k], mp->cf);
+ take_fraction(r2, mp->delta_y[k], mp->sf);
+ number_add(r1, r2);
+ take_fraction(tmp, r1, ss);
+ set_number_from_subtraction(q->left_x, q->x_coord, tmp);
+ take_fraction(r1, mp->delta_y[k], mp->cf);
+ take_fraction(r2, mp->delta_x[k], mp->sf);
+ number_subtract(r1, r2);
+ take_fraction(tmp, r1, ss);
+ set_number_from_subtraction(q->left_y, q->y_coord, tmp);
+ mp_right_type(p) = mp_explicit_knot;
+ mp_left_type(q) = mp_explicit_knot;
+ free_number(tmp);
+ free_number(r1);
+ free_number(r2);
+ free_number(lt);
+ free_number(rt);
+ free_number(rr);
+ free_number(ss);
+ free_number(sine);
+}
+
+@ The boundedness conditions $|rr|\L\sin\phi\,/\sin(\theta+\phi)$ and
+$|ss|\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$,
+$\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise there is no
+\quote {bounding triangle.}
+
+@<Decrease the velocities, if necessary...@>=
+if ((number_nonnegative(mp->st) && number_nonnegative(mp->sf)) || (number_nonpositive(mp->st) && number_nonpositive(mp->sf))) {
+ mp_number r1, r2, arg1;
+ new_fraction(r1);
+ new_fraction(r2);
+ new_number_abs(arg1, mp->st);
+ take_fraction(r1, arg1, mp->cf);
+ number_abs_clone(arg1, mp->sf);
+ take_fraction(r2, arg1, mp->ct);
+ set_number_from_addition(sine, r1, r2);
+ if (number_positive(sine)) {
+ set_number_from_addition(arg1, fraction_one_t, unity_t); /* safety factor */
+ number_clone(r1, sine);
+ take_fraction(sine, r1, arg1);
+ if (number_negative(p->right_tension)) {
+ number_abs_clone(arg1, mp->sf);
+ if (ab_vs_cd(arg1, fraction_one_t, rr, sine) < 0) {
+ number_abs_clone(arg1, mp->sf);
+ make_fraction(rr, arg1, sine);
+ }
+ }
+ if (number_negative(q->left_tension)) {
+ number_abs_clone(arg1, mp->st);
+ if (ab_vs_cd(arg1, fraction_one_t, ss, sine) < 0) {
+ number_abs_clone(arg1, mp->st);
+ make_fraction(ss, arg1, sine);
+ }
+ }
+ }
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+}
+
+@ Only the simple cases remain to be handled.
+
+@<Reduce to simple case of two givens and |return|@>=
+{
+ mp_number arg1;
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->delta_x[0], mp->delta_y[0]);
+ new_number(arg1);
+ set_number_from_subtraction(arg1, p->right_given, narg);
+ n_sin_cos(arg1, mp->ct, mp->st);
+ set_number_from_subtraction(arg1, q->left_given, narg);
+ n_sin_cos(arg1, mp->cf, mp->sf);
+ number_negate(mp->sf);
+ mp_set_controls (mp, p, q, 0);
+ free_number(narg);
+ free_number(arg1);
+ free_number(ff);
+ return;
+}
+
+@ @<Reduce to simple case of straight line and |return|@>=
+{
+ mp_number lt, rt; /* tension values */
+ mp_right_type(p) = mp_explicit_knot;
+ mp_left_type(q) = mp_explicit_knot;
+ new_number_abs(lt, q->left_tension);
+ new_number_abs(rt, p->right_tension);
+ if (number_unity(rt)) {
+ mp_number arg2;
+ new_number(arg2);
+ if (number_nonnegative(mp->delta_x[0])) {
+ set_number_from_addition(arg2, mp->delta_x[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_x[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_addition(p->right_x, p->x_coord, arg2);
+ if (number_nonnegative(mp->delta_y[0])) {
+ set_number_from_addition(arg2, mp->delta_y[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_y[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_addition(p->right_y, p->y_coord, arg2);
+ free_number(arg2);
+ } else {
+ mp_number arg2, r1;
+ new_fraction(r1);
+ new_number_clone(arg2, rt);
+ number_multiply_int(arg2, 3);
+ make_fraction(ff, unity_t, arg2); /* $\alpha/3$ */
+ free_number(arg2);
+ take_fraction(r1, mp->delta_x[0], ff);
+ set_number_from_addition(p->right_x, p->x_coord, r1);
+ take_fraction(r1, mp->delta_y[0], ff);
+ set_number_from_addition(p->right_y, p->y_coord, r1);
+ }
+ if (number_unity(lt)) {
+ mp_number arg2;
+ new_number(arg2);
+ if (number_nonnegative(mp->delta_x[0])) {
+ set_number_from_addition(arg2, mp->delta_x[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_x[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_subtraction(q->left_x, q->x_coord, arg2);
+ if (number_nonnegative(mp->delta_y[0])) {
+ set_number_from_addition(arg2, mp->delta_y[0], epsilon_t);
+ } else {
+ set_number_from_subtraction(arg2, mp->delta_y[0], epsilon_t);
+ }
+ number_int_div(arg2, 3);
+ set_number_from_subtraction(q->left_y, q->y_coord, arg2);
+ free_number(arg2);
+ } else {
+ mp_number arg2, r1;
+ new_fraction(r1);
+ new_number_clone(arg2, lt);
+ number_multiply_int(arg2, 3);
+ make_fraction(ff, unity_t, arg2); /* $\beta/3$ */
+ free_number(arg2);
+ take_fraction(r1, mp->delta_x[0], ff);
+ set_number_from_subtraction(q->left_x, q->x_coord, r1);
+ take_fraction(r1, mp->delta_y[0], ff);
+ set_number_from_subtraction(q->left_y, q->y_coord, r1);
+ free_number(r1);
+ }
+ free_number(ff);
+ free_number(lt);
+ free_number(rt);
+ return;
+}
+
+@ Various subroutines that are useful for the new (1.770) exported api for
+solving path choices
+
+@c
+# define TOO_LARGE(a) (fabs((a))>4096.0)
+# define PI 3.1415926535897932384626433832795028841971
+
+static int out_of_range (MP mp, double a)
+{
+ (void) mp;
+ mp_number t;
+ new_number_from_double(mp, t, fabs(a));
+ if (number_greaterequal(t, inf_t)) {
+ free_number(t);
+ return 1;
+ } else {
+ free_number(t);
+ return 0;
+ }
+}
+
+static int mp_link_knotpair (MP mp, mp_knot p, mp_knot q)
+{
+ (void) mp;
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else {
+ mp_prev_knot(q) = p;
+ mp_next_knot(p) = q;
+ set_number_from_double(p->right_tension, 1.0);
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ mp_right_type(p) = mp_open_knot;
+ }
+ set_number_from_double(q->left_tension, 1.0);
+ if (mp_left_type(q) == mp_endpoint_knot) {
+ mp_left_type(q) = mp_open_knot;
+ }
+ return 1;
+ }
+}
+
+static int mp_link_knotpair_xy (MP mp, mp_knot p, mp_knot q)
+{
+ (void) mp;
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else {
+ mp_prev_knot(q) = p;
+ mp_next_knot(p) = q;
+ return 1;
+ }
+}
+
+int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q)
+{
+ return mp_link_knotpair(mp, p, q);
+}
+
+int mp_close_path (MP mp, mp_knot q, mp_knot first)
+{
+ if (q == NULL || first == NULL) {
+ return 0;
+ } else {
+ mp_prev_knot(first) = q;
+ mp_next_knot(q) = first;
+ mp_right_type(q) = mp_endpoint_knot;
+ set_number_from_double(q->right_tension, 1.0);
+ mp_left_type(first) = mp_endpoint_knot;
+ set_number_from_double(first->left_tension, 1.0);
+ return 1;
+ }
+}
+
+mp_knot mp_create_knot (MP mp)
+{
+ mp_knot q = mp_new_knot(mp);
+ mp_left_type(q) = mp_endpoint_knot;
+ mp_right_type(q) = mp_endpoint_knot;
+ return q;
+}
+
+int mp_set_knot (MP mp, mp_knot p, double x, double y)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x)) {
+ return 0;
+ } else if (out_of_range(mp, y)) {
+ return 0;
+ } else {
+ set_number_from_double(p->x_coord, x);
+ set_number_from_double(p->y_coord, y);
+ return 1;
+ }
+}
+
+mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y)
+{
+ mp_knot q = mp_create_knot(mp);
+ if (q == NULL) {
+ return NULL;
+ } else if (! mp_set_knot(mp, q, x, y)) {
+ mp_memory_free(q);
+ return NULL;
+ } else if (p == NULL) {
+ return q;
+ } else if (mp_link_knotpair(mp, p, q)) {
+ return q;
+ } else {
+ mp_memory_free(q);
+ return NULL;
+ }
+}
+
+mp_knot mp_append_knot_xy (MP mp, mp_knot p, double x, double y)
+{
+ mp_knot q = mp_create_knot(mp);
+ if (q == NULL) {
+ return NULL;
+ } else if (! mp_set_knot(mp, q, x, y)) {
+ mp_memory_free(q);
+ return NULL;
+ } else if (p == NULL) {
+ return q;
+ } else if (mp_link_knotpair_xy(mp, p, q)) {
+ mp_right_type(p) = mp_explicit_knot;
+ mp_left_type(p) = mp_explicit_knot;
+ return q;
+ } else {
+ mp_memory_free(q);
+ return NULL;
+ }
+}
+
+int mp_set_knot_curl (MP mp, mp_knot q, double value) /* same as mp_set_knot_right_curl */
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(value)) {
+ return 0;
+ } else {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, value);
+ if (mp_left_type(q) == mp_open_knot) {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knot_left_curl (MP mp, mp_knot q, double value)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(value)) {
+ return 0;
+ } else {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, value);
+ if (mp_right_type(q) == mp_open_knot) {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knot_right_curl (MP mp, mp_knot q, double value)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(value)) {
+ return 0;
+ } else {
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, value);
+ if (mp_left_type(q) == mp_open_knot) {
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knot_simple_curl (MP mp, mp_knot q)
+{
+ if (q == NULL) {
+ return 0;
+ } else {
+ /* no need for double */
+ mp_right_type(q) = mp_curl_knot;
+ set_number_from_double(q->right_curl, 1.0);
+ mp_left_type(q) = mp_curl_knot;
+ set_number_from_double(q->left_curl, 1.0);
+ return 1;
+ }
+}
+
+int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (mp_set_knot_curl(mp, p, t1)) {
+ return mp_set_knot_curl(mp, q, t2);
+ } else {
+ return 0;
+ }
+}
+
+int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(t1)) {
+ return 0;
+ } else if (TOO_LARGE(t2)) {
+ return 0;
+ } else if ((fabs(t1) < 0.75)) {
+ return 0;
+ } else if ((fabs(t2) < 0.75)) {
+ return 0;
+ } else {
+ set_number_from_double(p->right_tension, t1);
+ set_number_from_double(q->left_tension, t2);
+ return 1;
+ }
+}
+
+int mp_set_knot_left_tension (MP mp, mp_knot p, double t1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (TOO_LARGE(t1)) {
+ return 0;
+ } else if ((fabs(t1) < 0.75)) {
+ return 0;
+ } else {
+ set_number_from_double(p->left_tension, t1);
+ return 1;
+ }
+}
+
+int mp_set_knot_right_tension (MP mp, mp_knot p, double t1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (TOO_LARGE(t1)) {
+ return 0;
+ } else if ((fabs(t1) < 0.75)) {
+ return 0;
+ } else {
+ set_number_from_double(p->right_tension, t1);
+ return 1;
+ }
+}
+
+int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x1)) {
+ return 0;
+ } else if (out_of_range(mp, y1)) {
+ return 0;
+ } else if (out_of_range(mp, x2)) {
+ return 0;
+ } else if (out_of_range(mp, y2)) {
+ return 0;
+ } else {
+ mp_right_type(p) = mp_explicit_knot;
+ set_number_from_double(p->right_x, x1);
+ set_number_from_double(p->right_y, y1);
+ mp_left_type(q) = mp_explicit_knot;
+ set_number_from_double(q->left_x, x2);
+ set_number_from_double(q->left_y, y2);
+ return 1;
+ }
+}
+
+int mp_set_knot_left_control (MP mp, mp_knot p, double x1, double y1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x1)) {
+ return 0;
+ } else if (out_of_range(mp, y1)) {
+ return 0;
+ } else {
+ mp_left_type(p) = mp_explicit_knot;
+ set_number_from_double(p->left_x, x1);
+ set_number_from_double(p->left_y, y1);
+ return 1;
+ }
+}
+
+int mp_set_knot_right_control (MP mp, mp_knot p, double x1, double y1)
+{
+ if (p == NULL) {
+ return 0;
+ } else if (out_of_range(mp, x1)) {
+ return 0;
+ } else if (out_of_range(mp, y1)) {
+ return 0;
+ } else {
+ mp_right_type(p) = mp_explicit_knot;
+ set_number_from_double(p->right_x, x1);
+ set_number_from_double(p->right_y, y1);
+ return 1;
+ }
+}
+
+int mp_set_knot_direction (MP mp, mp_knot q, double x, double y)
+{
+ if (q == NULL) {
+ return 0;
+ } else if (TOO_LARGE(x)) {
+ return 0;
+ } else if (TOO_LARGE(y)) {
+ return 0;
+ } else {
+ double value = 0;
+ if (!(x == 0 && y == 0)) {
+ value = atan2(y, x) * (180.0 / PI) * 16.0;
+ }
+ mp_right_type(q) = mp_given_knot;
+ set_number_from_double(q->right_curl, value);
+ if (mp_left_type(q) == mp_open_knot) {
+ mp_left_type(q) = mp_given_knot;
+ set_number_from_double(q->left_curl, value);
+ }
+ return 1;
+ }
+}
+
+int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2)
+{
+ if (p == NULL || q == NULL) {
+ return 0;
+ } else if (mp_set_knot_direction(mp,p, x1, y1)) {
+ return mp_set_knot_direction(mp,q, x2, y2);
+ } else {
+ return 0;
+ }
+}
+
+@ @c
+static int path_needs_fixing(mp_knot source)
+{
+ mp_knot sourcehead = source;
+ do {
+ source = source->next;
+ } while (source && source != sourcehead);
+ if (! source) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+int mp_solve_path (MP mp, mp_knot first)
+{
+ if (first == NULL) {
+ return 0;
+ } else if (path_needs_fixing(first)) {
+ return 0;
+ } else {
+ int saved_arith_error = mp->arith_error;
+ int retval = 1;
+ jmp_buf *saved_jump_buf = mp->jump_buf;
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) {
+ return 0;
+ } else {
+ mp->arith_error = 0;
+ mp_make_choices(mp, first);
+ if (mp->arith_error) {
+ retval = 0;
+ }
+ mp->arith_error = saved_arith_error;
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = saved_jump_buf;
+ return retval;
+ }
+ }
+}
+
+void mp_free_path (MP mp, mp_knot p)
+{
+ mp_toss_knot_list(mp, p);
+}
+
+@ @<Exported function headers@>=
+int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q);
+int mp_close_path (MP mp, mp_knot q, mp_knot first);
+mp_knot mp_create_knot (MP mp);
+int mp_set_knot (MP mp, mp_knot p, double x, double y);
+mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y);
+mp_knot mp_append_knot_xy (MP mp, mp_knot p, double x, double y);
+int mp_set_knot_curl (MP mp, mp_knot q, double value);
+int mp_set_knot_left_curl (MP mp, mp_knot q, double value);
+int mp_set_knot_right_curl (MP mp, mp_knot q, double value);
+int mp_set_knot_simple_curl (MP mp, mp_knot q);
+int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2) ;
+int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2) ;
+int mp_set_knot_left_tension (MP mp, mp_knot p, double t1);
+int mp_set_knot_right_tension (MP mp, mp_knot p, double t1);
+int mp_set_knot_left_control (MP mp, mp_knot p, double t1, double t2);
+int mp_set_knot_right_control (MP mp, mp_knot p, double t1, double t2);
+int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) ;
+int mp_set_knot_direction (MP mp, mp_knot q, double x, double y) ;
+int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) ;
+int mp_solve_path (MP mp, mp_knot first);
+void mp_free_path (MP mp, mp_knot p);
+
+@ Simple accessors for |mp_knot|.
+
+@c
+double mp_number_as_double (MP mp, mp_number n) {
+ (void) mp;
+ return number_to_double(n);
+}
+
+@ @<Exported function headers@>=
+double mp_number_as_double (MP mp, mp_number n);
+
+@* Measuring paths.
+
+\MP's |llcorner|, |lrcorner|, |ulcorner|, and |urcorner| operators allow
+the user to measure the bounding box of anything that can go into a picture. It's
+easy to get rough bounds on the $x$ and $y$ extent of a path by just finding the
+bounding box of the knots and the control points. We need a more accurate version
+of the bounding box, but we can still use the easy estimate to save time by
+focusing on the interesting parts of the path.
+
+@ Computing an accurate bounding box involves a theme that will come up again and
+again. Given a Bernshte{\u\i}n polynomial @^Bernshte{\u\i}n, Serge{\u\i}
+Natanovich@>
+
+$$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$
+
+we can conveniently bisect its range as follows:
+
+\smallskip \textindent{1)} Let $z_k^{(0)}=z_k$, for |0<=k<=n|.
+
+\smallskip \textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for
+|0<=k<n-j|, for |0<=j<n|.
+
+\smallskip\noindent Then
+
+$$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t)
+=B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$
+
+This formula gives us the coefficients of polynomials to use over the ranges $0\L
+t|1\over2|$ and ${1\over2}\L t\L1$.
+
+@ Here is a routine that computes the $x$ or $y$ coordinate of the point on a
+cubic corresponding to the |fraction| value~|t|.
+
+@c
+static void mp_eval_cubic (MP mp, mp_number *r, mp_knot p, mp_knot q, int c, mp_number *t)
+{
+ mp_number x1, x2, x3; /* intermediate values */
+ new_number(x1);
+ new_number(x2);
+ new_number(x3);
+ if (c == mp_x_code) {
+ set_number_from_of_the_way(x1, *t, p->x_coord, p->right_x);
+ set_number_from_of_the_way(x2, *t, p->right_x, q->left_x);
+ set_number_from_of_the_way(x3, *t, q->left_x, q->x_coord);
+ } else {
+ set_number_from_of_the_way(x1, *t, p->y_coord, p->right_y);
+ set_number_from_of_the_way(x2, *t, p->right_y, q->left_y);
+ set_number_from_of_the_way(x3, *t, q->left_y, q->y_coord);
+ }
+ set_number_from_of_the_way(x1, *t, x1, x2);
+ set_number_from_of_the_way(x2, *t, x2, x3);
+ set_number_from_of_the_way(*r, *t, x1, x2);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+}
+
+@ The actual bounding box information is stored in global variables. Since it is
+convenient to address the $x$ and $y$ information separately, we define arrays
+indexed by |x_code..y_code| and use macros to give them more convenient names.
+
+@<Types...@>=
+enum mp_bb_code {
+ mp_x_code, /* index for |minx| and |maxx| */
+ mp_y_code /* index for |miny| and |maxy| */
+};
+
+@
+@d mp_minx mp->bbmin[mp_x_code]
+@d mp_maxx mp->bbmax[mp_x_code]
+@d mp_miny mp->bbmin[mp_y_code]
+@d mp_maxy mp->bbmax[mp_y_code]
+
+@<Glob...@>=
+/* the result of procedures that compute bounding box information */
+mp_number bbmin[mp_y_code + 1];
+mp_number bbmax[mp_y_code + 1];
+
+@ @<Initialize table ...@>=
+for (int i = 0; i <= mp_y_code; i++) {
+ new_number(mp->bbmin[i]);
+ new_number(mp->bbmax[i]);
+}
+
+@ @<Dealloc...@>=
+for (int i = 0; i <= mp_y_code; i++) {
+ free_number(mp->bbmin[i]);
+ free_number(mp->bbmax[i]);
+}
+
+@ Now we're ready for the key part of the bounding box computation. The
+|bound_cubic| procedure updates |bbmin[c]| and |bbmax[c]| based on
+
+$$B(\hbox{|knot_coord(p)|}, \hbox{|right_coord(p)|}, \hbox{|left_coord(q)|},
+\hbox{|knot_coord(q)|};t) $$
+
+for $0<t\le1$. In other words, the procedure adjusts the bounds to accommodate
+|knot_coord(q)| and any extremes over the range $0<t<1$. The |c| parameter is
+|x_code| or |y_code|.
+
+@c
+static void mp_bound_cubic (MP mp, mp_knot p, mp_knot q, int c)
+{
+ int wavy; /* whether we need to look for extremes */
+ mp_number del1, del2, del3, del, dmax; /* proportional to the control points of a quadratic derived from a cubic */
+ mp_number t, tt; /* where a quadratic crosses zero */
+ mp_number x; /* a value that |bbmin[c]| and |bbmax[c]| must accommodate */
+ new_fraction(t);
+ new_fraction(tt);
+ if (c == mp_x_code) {
+ new_number_clone(x, q->x_coord);
+ } else {
+ new_number_clone(x, q->y_coord);
+ }
+ new_number(del1);
+ new_number(del2);
+ new_number(del3);
+ new_number(del);
+ new_number(dmax);
+ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>
+ @<Check the control points against the bounding box and set |wavy:=1| if any of them lie outside@>
+ if (wavy) {
+ if (c == mp_x_code) {
+ set_number_from_subtraction(del1, p->right_x, p->x_coord);
+ set_number_from_subtraction(del2, q->left_x, p->right_x);
+ set_number_from_subtraction(del3, q->x_coord, q->left_x);
+ } else {
+ set_number_from_subtraction(del1, p->right_y, p->y_coord);
+ set_number_from_subtraction(del2, q->left_y, p->right_y);
+ set_number_from_subtraction(del3, q->y_coord, q->left_y);
+ }
+ @<Scale up |del1|, |del2|, and |del3| for greater accuracy; also set |del| to the first nonzero element of |(del1,del2,del3)|@>
+ if (number_negative(del)) {
+ number_negate(del1);
+ number_negate(del2);
+ number_negate(del3);
+ }
+ crossing_point(t, del1, del2, del3);
+ if (number_less(t, fraction_one_t)) {
+ @<Test the extremes of the cubic against the bounding box@>
+ }
+ }
+ free_number(del3);
+ free_number(del2);
+ free_number(del1);
+ free_number(del);
+ free_number(dmax);
+ free_number(x);
+ free_number(t);
+ free_number(tt);
+}
+
+@ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>=
+if (number_less(x, mp->bbmin[c])) {
+ number_clone(mp->bbmin[c], x);
+}
+if (number_greater(x, mp->bbmax[c])) {
+ number_clone(mp->bbmax[c], x);
+}
+
+@ @<Check the control points against the bounding box and set...@>=
+wavy = 1;
+if (c == mp_x_code) {
+ if (number_lessequal(mp->bbmin[c], p->right_x) && number_lessequal(p->right_x, mp->bbmax[c])) {
+ if (number_lessequal(mp->bbmin[c], q->left_x) && number_lessequal(q->left_x, mp->bbmax[c])) {
+ wavy = 0;
+ }
+ }
+} else {
+ if (number_lessequal(mp->bbmin[c], p->right_y) && number_lessequal(p->right_y, mp->bbmax[c])) {
+ if (number_lessequal(mp->bbmin[c], q->left_y) && number_lessequal(q->left_y, mp->bbmax[c])) {
+ wavy = 0;
+ }
+ }
+}
+
+@ If |del1=del2=del3=0|, it's impossible to obey the title of this section. We
+just set |del=0| in that case.
+
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy...@>=
+if (number_nonzero(del1)) {
+ number_clone(del, del1);
+} else if (number_nonzero(del2)) {
+ number_clone(del, del2);
+} else {
+ number_clone(del, del3);
+}
+if (number_nonzero(del)) {
+ mp_number absval1;
+ new_number(absval1);
+ number_abs_clone(dmax, del1);
+ number_abs_clone(absval1, del2);
+ if (number_greater(absval1, dmax)) {
+ number_clone(dmax, absval1);
+ }
+ number_abs_clone(absval1, del3);
+ if (number_greater(absval1, dmax)) {
+ number_clone(dmax, absval1);
+ }
+ while (number_less(dmax, fraction_half_t)) {
+ number_double(dmax);
+ number_double(del1);
+ number_double(del2);
+ number_double(del3);
+ }
+ free_number(absval1);
+}
+
+@ Since |crossing_point| has tried to choose |t| so that $B(|del1|, |del2|,
+|del3|; \tau)$ crosses zero at $\tau = |t|$ with negative slope, the value of
+|del2| computed below should not be positive. But rounding error could make it
+slightly positive in which case we must cut it to zero to avoid confusion.
+
+@<Test the extremes of the cubic against the bounding box@>=
+{
+ mp_eval_cubic(mp, &x, p, q, c, &t);
+ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>
+ set_number_from_of_the_way(del2, t, del2, del3);
+ /* now |0,del2,del3| represent the derivative on the remaining interval */
+ if (number_positive(del2)) {
+ set_number_to_zero(del2);
+ }
+ {
+ mp_number arg2, arg3;
+ new_number(arg2);
+ new_number(arg3);
+ number_negated_clone(arg2, del2);
+ number_negated_clone(arg3, del3);
+ crossing_point(tt, zero_t, arg2, arg3);
+ free_number(arg2);
+ free_number(arg3);
+ }
+ if (number_less(tt, fraction_one_t)) {
+ /* Test the second extreme against the bounding box. */
+ mp_number arg;
+ new_number(arg);
+ set_number_from_of_the_way(arg, t, tt, fraction_one_t);
+ mp_eval_cubic(mp, &x, p, q, c, &arg);
+ free_number(arg);
+ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>
+ }
+}
+
+@ Finding the bounding box of a path is basically a matter of applying
+|bound_cubic| twice for each pair of adjacent knots.
+
+@c
+static void mp_path_bbox (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ number_clone(mp_minx, h->x_coord);
+ number_clone(mp_miny, h->y_coord);
+ number_clone(mp_maxx, mp_minx);
+ number_clone(mp_maxy, mp_miny);
+ do {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ return;
+ } else {
+ mp_knot q = mp_next_knot(p);
+ mp_bound_cubic(mp, p, q, mp_x_code);
+ mp_bound_cubic(mp, p, q, mp_y_code);
+ p = q;
+ }
+ } while (p != h);
+}
+
+static void mp_path_xbox (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ number_clone(mp_minx, h->x_coord);
+ number_clone(mp_maxx, mp_minx);
+ set_number_to_zero(mp_miny);
+ set_number_to_zero(mp_maxy);
+ do {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ return;
+ } else {
+ mp_knot q = mp_next_knot(p);
+ mp_bound_cubic(mp, p, q, mp_x_code);
+ p = q;
+ }
+ } while (p != h);
+}
+
+static void mp_path_ybox (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ set_number_to_zero(mp_minx);
+ set_number_to_zero(mp_maxx);
+ number_clone(mp_miny, h->y_coord);
+ number_clone(mp_maxy, mp_miny);
+ do {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ return;
+ } else {
+ mp_knot q = mp_next_knot(p);
+ mp_bound_cubic(mp, p, q, mp_y_code);
+ p = q;
+ }
+ } while (p != h);
+}
+
+@ Another important way to measure a path is to find its arc length. This is best
+done by using the general bisection algorithm to subdivide the path until
+obtaining \quote {well behaved} subpaths whose arc lengths can be approximated by
+simple means.
+
+Since the arc length is the integral with respect to time of the magnitude of the
+velocity, it is natural to use Simpson's rule for the approximation. @^Simpson's
+rule@> If $\dot B(t)$ is the spline velocity, Simpson's rule gives
+
+$$ \vb\dot B(0)\vb + 4\vb\dot B({1\over2})\vb + \vb\dot B(1)\vb \over 6 $$
+
+for the arc length of a path of length~1. For a cubic spline
+$B(z_0,z_1,z_2,z_3;t)$, the time derivative $\dot B(t)$ is
+$3B(dz_0,dz_1,dz_2;t)$, where $dz_i=z_{i+1}-z_i$. Hence the arc length
+approximation is
+
+$$ {\vb dz_0\vb \over 2} + 2\vb dz_{02}\vb + {\vb dz_2\vb \over 2}, $$
+
+where
+
+$$ dz_{02}={1\over2}\left({dz_0+dz_1\over 2}+{dz_1+dz_2\over 2}\right)$$
+
+is the result of the bisection algorithm.
+
+@ The remaining problem is how to decide when a subpath is \quote {well behaved.} This
+could be done via the theoretical error bound for Simpson's rule, @^Simpson's
+rule@> but this is impractical because it requires an estimate of the fourth
+derivative of the quantity being integrated. It is much easier to just perform a
+bisection step and see how much the arc length estimate changes. Since the error
+for Simpson's rule is proportional to the fourth power of the sample spacing, the
+remaining error is typically about $1\over16$ of the amount of the change. We say
+\quote {typically} because the error has a pseudo-random behavior that could cause the
+two estimates to agree when each contain large errors.
+
+To protect against disasters such as undetected cusps, the bisection process
+should always continue until all the $dz_i$ vectors belong to a single $90^\circ$
+sector. This ensures that no point on the spline can have velocity less than 70\%
+of the minimum of $\vb dz_0\vb$, $\vb dz_1\vb$ and $\vb dz_2\vb$. If such a
+spline happens to produce an erroneous arc length estimate that is little changed
+by bisection, the amount of the error is likely to be fairly small. We will try
+to arrange things so that freak accidents of this type do not destroy the inverse
+relationship between the |arclength| and |arctime| operations.
+@:arclength_}{|arclength| primitive@> @:arctime_}{|arctime| primitive@>
+
+@ The |arclength| and |arctime| operations are both based on a recursive
+@^recursion@> function that finds the arc length of a cubic spline given $dz_0$,
+$dz_1$, $dz_2$. This |arc_test| routine also takes an arc length goal |a_goal|
+and returns the time when the arc length reaches |a_goal| if there is such a
+time. Thus the return value is either an arc length less than |a_goal| or, if the
+arc length would be at least |a_goal|, it returns a time value decreased by
+|two|. This allows the caller to use the sign of the result to distinguish
+between arc lengths and time values. On certain types of overflow, it is possible
+for |a_goal| and the result of |arc_test| both to be |EL_GORDO|. Otherwise, the
+result is always less than |a_goal|.
+
+Rather than halving the control point coordinates on each recursive call to
+|arc_test|, it is better to keep them proportional to velocity on the original
+curve and halve the results instead. This means that recursive calls can
+potentially use larger error tolerances in their arc length estimates. How much
+larger depends on to what extent the errors behave as though they are independent
+of each other. To save computing time, we use optimistic assumptions and increase
+the tolerance by a factor of about $\sqrt2$ for each recursive call.
+
+In addition to the tolerance parameter, |arc_test| should also have parameters
+for ${1\over3}\vb\dot B(0)\vb$, ${2\over3}\vb\dot B({1\over2})\vb$, and
+${1\over3}\vb\dot B(1)\vb$. These quantities are relatively expensive to compute
+and they are needed in different instances of |arc_test|.
+
+@c
+static void mp_arc_test (MP mp,
+ mp_number *ret, mp_number *dx0, mp_number *dy0, mp_number *dx1,
+ mp_number *dy1, mp_number *dx2, mp_number *dy2, mp_number *v0,
+ mp_number *v02, mp_number *v2, mp_number *a_goal, mp_number *tol_orig
+)
+{
+ int simple; /* are the control points confined to a $90^\circ$ sector? */
+ mp_number dx01, dy01, dx12, dy12, dx02, dy02; /* bisection results */
+ mp_number v002, v022; /* twice the velocity magnitudes at $t={1\over4}$ and $t={3\over4}$ */
+ mp_number arc; /* best arc length estimate before recursion */
+ mp_number arc1; /* arc length estimate for the first half */
+ mp_number simply;
+ mp_number tol;
+ new_number(arc );
+ new_number(arc1);
+ new_number(dx01);
+ new_number(dy01);
+ new_number(dx12);
+ new_number(dy12);
+ new_number(dx02);
+ new_number(dy02);
+ new_number(v002);
+ new_number(v022);
+ new_number(simply);
+ new_number_clone(tol, *tol_orig);
+ @<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|, |dx2|, |dy2|@>
+ @<Initialize |v002|, |v022|, and the arc length estimate |arc|; if it overflows set |arc_test| and |return|@>
+ @<Test if the control points are confined to one quadrant or rotating them $45^\circ$ would put them in one quadrant. Then set |simple| appropriately@>
+ set_number_half_from_addition(simply, *v0, *v2);
+ number_negate(simply);
+ number_add(simply, arc);
+ number_subtract(simply, *v02);
+ number_abs(simply);
+ if (simple && number_lessequal(simply, tol)) {
+ if (number_less(arc, *a_goal)){
+ number_clone(*ret, arc);
+ } else {
+ @<Estimate when the arc length reaches |a_goal| and set |arc_test| to that time minus |two|@>
+ }
+ } else {
+ @<Use one or two recursive calls to compute the |arc_test| function@>
+ }
+ DONE:
+ free_number(arc);
+ free_number(arc1);
+ free_number(dx01);
+ free_number(dy01);
+ free_number(dx12);
+ free_number(dy12);
+ free_number(dx02);
+ free_number(dy02);
+ free_number(v002);
+ free_number(v022);
+ free_number(simply);
+ free_number(tol);
+}
+
+@ The |tol| value should by multiplied by $\sqrt 2$ before making recursive
+calls, but $1.5$ is an adequate approximation. It is best to avoid using
+|make_fraction| in this inner loop. @^inner loop@>
+
+@<Use one or two recursive calls to compute the |arc_test| function@>=
+mp_number a_new, a_aux; /* the sum of these gives the |a_goal| */
+mp_number a, b; /* results of recursive calls */
+mp_number half_v02; /* |half(v02)|, a recursion argument */
+new_number(a_new);
+new_number(a_aux);
+new_number(half_v02);
+@<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is as large as possible@>
+{
+ mp_number half_tol;
+ new_number_clone(half_tol, tol);
+ number_half(half_tol);
+ number_add(tol, half_tol);
+ free_number(half_tol);
+}
+number_clone(half_v02, *v02);
+number_half(half_v02);
+new_number(a);
+mp_arc_test(mp, &a, dx0, dy0, &dx01, &dy01, &dx02, &dy02, v0, &v002, &half_v02, &a_new, &tol);
+if (number_negative(a)) {
+ set_number_to_unity(*ret);
+ number_double(*ret); /* two */
+ number_subtract(*ret, a); /* two - a */
+ number_half(*ret);
+ number_negate(*ret); /* -half(two - a) */
+} else {
+ @<Update |a_new| to reduce |a_new+a_aux| by |a|@>
+ new_number(b);
+ mp_arc_test(mp, &b, &dx02, &dy02, &dx12, &dy12, dx2, dy2, &half_v02, &v022, v2, &a_new, &tol);
+ if (number_negative(b)) {
+ mp_number tmp ;
+ new_number(tmp);
+ number_negated_clone(tmp, b);
+ number_half(tmp);
+ number_negate(tmp);
+ number_clone(*ret, tmp);
+ set_number_to_unity(tmp);
+ number_half(tmp);
+ number_subtract(*ret, tmp); /* (-(half(-b)) - 1/2) */
+ free_number(tmp);
+ } else {
+ set_number_from_subtraction(*ret, b, a);
+ number_half(*ret);
+ set_number_from_addition(*ret, a, *ret); /* (a + half(b - a)) */
+ }
+ free_number(b);
+}
+free_number(half_v02);
+free_number(a_aux);
+free_number(a_new);
+free_number(a);
+
+@ @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is...@>=
+set_number_to_inf(a_aux);
+number_subtract(a_aux, *a_goal);
+if (number_greater(*a_goal, a_aux)) {
+ set_number_from_subtraction(a_aux, *a_goal, a_aux);
+ set_number_to_inf(a_new);
+} else {
+ set_number_from_addition(a_new, *a_goal, *a_goal);
+ set_number_to_zero(a_aux);
+}
+
+@ There is no need to maintain |a_aux| at this point so we use it as a temporary
+to force the additions and subtractions to be done in an order that avoids
+overflow.
+
+@<Update |a_new| to reduce |a_new+a_aux| by |a|@>=
+if (number_greater(a, a_aux)) {
+ number_subtract(a_aux, a);
+ number_add(a_new, a_aux);
+}
+
+@ This code assumes all {\it dx} and {\it dy} variables have magnitude less than
+|fraction_four|. To simplify the rest of the |arc_test| routine, we strengthen
+this assumption by requiring the norm of each $({\it dx},{\it dy})$ pair to obey
+this bound. Note that recursive calls will maintain this invariant.
+
+@<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,...@>=
+set_number_half_from_addition(dx01, *dx0, *dx1);
+set_number_half_from_addition(dx12, *dx1, *dx2);
+set_number_half_from_addition(dx02, dx01, dx12);
+set_number_half_from_addition(dy01, *dy0, *dy1);
+set_number_half_from_addition(dy12, *dy1, *dy2);
+set_number_half_from_addition(dy02, dy01, dy12);
+
+@ We should be careful to keep |arc<EL_GORDO| so that calling |arc_test| with
+|a_goal=EL_GORDO| is guaranteed to yield the arc length.
+
+@<Initialize |v002|, |v022|, and the arc length estimate |arc|;...@>=
+{
+ mp_number tmp, arg1, arg2 ;
+ new_number(tmp);
+ new_number(arg1);
+ new_number(arg2);
+ set_number_half_from_addition(arg1, *dx0, dx02);
+ number_add(arg1, dx01);
+ set_number_half_from_addition(arg2, *dy0, dy02);
+ number_add(arg2, dy01);
+ pyth_add(v002, arg1, arg2);
+
+ set_number_half_from_addition(arg1, dx02, *dx2);
+ number_add(arg1, dx12);
+ set_number_half_from_addition(arg2, dy02, *dy2);
+ number_add(arg2, dy12);
+ pyth_add(v022, arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+
+ number_clone(tmp, *v02);
+ number_add_scaled(tmp, 2);
+ number_half(tmp);
+
+ set_number_half_from_addition(arc1, *v0, tmp);
+ number_subtract(arc1, v002);
+ number_half(arc1);
+ set_number_from_addition(arc1, v002, arc1);
+
+ set_number_half_from_addition(arc, *v2, tmp);
+ number_subtract(arc, v022);
+ number_half(arc);
+ set_number_from_addition(arc, v022, arc);
+
+ /* reuse |tmp| for the next |if| test: */
+ set_number_to_inf(tmp);
+ number_subtract(tmp,arc1);
+ if (number_less(arc, tmp)) {
+ free_number(tmp);
+ number_add(arc, arc1);
+ } else {
+ free_number(tmp);
+ mp->arith_error = 1;
+ if (number_infinite(*a_goal)) {
+ set_number_to_inf(*ret);
+ } else {
+ set_number_to_unity(*ret);
+ number_double(*ret);
+ number_negate(*ret); /* -two */
+ }
+ goto DONE;
+ }
+}
+
+@ @<Test if the control points are confined to one quadrant or rotating...@>=
+simple = (number_nonnegative(*dx0) && number_nonnegative(*dx1) && number_nonnegative(*dx2))
+ || (number_nonpositive(*dx0) && number_nonpositive(*dx1) && number_nonpositive(*dx2));
+if (simple) {
+ simple = (number_nonnegative(*dy0) && number_nonnegative(*dy1) && number_nonnegative(*dy2))
+ || (number_nonpositive(*dy0) && number_nonpositive(*dy1) && number_nonpositive(*dy2));
+}
+if (!simple) {
+ simple = (number_greaterequal(*dx0, *dy0) && number_greaterequal(*dx1, *dy1) && number_greaterequal(*dx2, *dy2))
+ || (number_lessequal (*dx0, *dy0) && number_lessequal (*dx1, *dy1) && number_lessequal (*dx2, *dy2));
+ if (simple) {
+ mp_number neg_dx0, neg_dx1, neg_dx2;
+ new_number(neg_dx0);
+ new_number(neg_dx1);
+ new_number(neg_dx2);
+ number_negated_clone(neg_dx0, *dx0);
+ number_negated_clone(neg_dx1, *dx1);
+ number_negated_clone(neg_dx2, *dx2);
+ simple = (number_greaterequal(neg_dx0, *dy0) && number_greaterequal(neg_dx1, *dy1) && number_greaterequal(neg_dx2, *dy2))
+ || (number_lessequal (neg_dx0, *dy0) && number_lessequal (neg_dx1, *dy1) && number_lessequal (neg_dx2, *dy2));
+ free_number(neg_dx0);
+ free_number(neg_dx1);
+ free_number(neg_dx2);
+ }
+}
+
+@ Since Simpson's rule is based on approximating the integrand by a parabola,
+@^Simpson's rule@> it is appropriate to use the same approximation to decide when
+the integral reaches the intermediate value |a_goal|. At this point
+
+$$\eqalign{
+ {\vb\dot B(0)\vb\over 3} &= \hbox{|v0|}, \qquad
+ {\vb\dot B({1\over4})\vb\over 3} = {\hbox{|v002|}\over 2}, \qquad
+ {\vb\dot B({1\over2})\vb\over 3} = {\hbox{|v02|}\over 2}, \cr
+ {\vb\dot B({3\over4})\vb\over 3} &= {\hbox{|v022|}\over 2}, \qquad
+ {\vb\dot B(1)\vb\over 3} = \hbox{|v2|} \cr
+}
+$$
+
+and
+
+$$ {\vb\dot B(t)\vb\over 3} \approx
+ \cases{B\left(\hbox{|v0|},
+ \hbox{|v002|}-{1\over 2}\hbox{|v0|}-{1\over 4}\hbox{|v02|},
+ {1\over 2}\hbox{|v02|}; 2t \right)&
+ if $t\le{1\over 2}$\cr
+ B\left({1\over 2}\hbox{|v02|},
+ \hbox{|v022|}-{1\over 4}\hbox{|v02|}-{1\over 2}\hbox{|v2|},
+ \hbox{|v2|}; 2t-1 \right)&
+ if $t\ge{1\over 2}$.\cr}
+ \eqno (*)
+$$
+
+We can integrate $\vb\dot B(t)\vb$ by using
+
+$$\int 3B(a,b,c;\tau)\,dt =
+ {B(0,a,a+b,a+b+c;\tau) + {\rm constant} \over {d\tau\over dt}}.
+$$
+
+This construction allows us to find the time when the arc length reaches |a_goal|
+by solving a cubic equation of the form $$ B(0,a,a+b,a+b+c;\tau) = x, $$ where
+$\tau$ is $2t$ or $2t+1$, $x$ is |a_goal| or |a_goal-arc1|, and $a$, $b$, and $c$
+are the Bernshte{\u\i}n coefficients from $(*)$ divided by @^Bernshte{\u\i}n,
+Serge{\u\i} Natanovich@> $d\tau\over dt$. We shall define a function
+|solve_rising_cubic| that finds $\tau$ given $a$, $b$, $c$, and $x$.
+
+@<Estimate when the arc length reaches |a_goal| and set |arc_test| to...@>=
+mp_number tmp;
+mp_number tmp2;
+mp_number tmp3;
+mp_number tmp4;
+mp_number tmp5;
+new_number_clone(tmp, *v02);
+new_number(tmp2);
+new_number(tmp3);
+new_number(tmp4);
+new_number(tmp5);
+number_add_scaled(tmp, 2);
+number_half(tmp);
+number_half(tmp); /* (v02+2) / 4 */
+if (number_lessequal(*a_goal, arc1)) {
+ number_clone(tmp2, *v0);
+ number_half(tmp2);
+ set_number_from_subtraction(tmp3, arc1, tmp2);
+ number_subtract(tmp3, tmp);
+ mp_solve_rising_cubic(mp, &tmp5, &tmp2, &tmp3, &tmp, a_goal);
+ number_half(tmp5);
+ set_number_to_unity(tmp3);
+ number_subtract(tmp5, tmp3);
+ number_subtract(tmp5, tmp3);
+ number_clone(*ret, tmp5);
+} else {
+ number_clone(tmp2, *v2);
+ number_half(tmp2);
+ set_number_from_subtraction(tmp3, arc, arc1);
+ number_subtract(tmp3, tmp);
+ number_subtract(tmp3, tmp2);
+ set_number_from_subtraction(tmp4, *a_goal, arc1);
+ mp_solve_rising_cubic(mp, &tmp5, &tmp, &tmp3, &tmp2, &tmp4);
+ number_half(tmp5);
+ set_number_to_unity(tmp2);
+ set_number_to_unity(tmp3);
+ number_half(tmp2);
+ number_subtract(tmp2, tmp3);
+ number_subtract(tmp2, tmp3);
+ set_number_from_addition(*ret, tmp2, tmp5);
+}
+free_number(tmp);
+free_number(tmp2);
+free_number(tmp3);
+free_number(tmp4);
+free_number(tmp5);
+
+@ Here is the |solve_rising_cubic| routine that finds the time~$t$ when $$ B(0,
+a, a+b, a+b+c; t) = x. $$ This routine is based on |crossing_point| but is
+simplified by the assumptions that $B(a,b,c;t)\ge0$ for $0\le t\le1$ and that
+|0<=x<=a+b+c|. If rounding error causes this condition to be violated slightly,
+we just ignore it and proceed with binary search. This finds a time when the
+function value reaches |x| and the slope is positive.
+
+@<Declarations@>=
+static void mp_solve_rising_cubic (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *x_orig);
+
+@ @c
+void mp_solve_rising_cubic (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *x_orig)
+{
+ mp_number abc;
+ mp_number a, b, c, x; /* local versions of arguments */
+ mp_number ab, bc, ac; /* bisection results */
+ mp_number t; /* $2^k+q$ where unscaled answer is in $[q2^{-k},(q+1)2^{-k})$ */
+ mp_number xx; /* temporary for updating |x| */
+ mp_number neg_x; /* temporary for an |if| */
+ if (number_negative(*a_orig) || number_negative(*c_orig)) {
+ mp_confusion(mp, "rising cubic");
+ @:this can't happen rising?}{\quad rising?@>
+ }
+ new_number(t);
+ new_number(abc);
+ new_number_clone(a, *a_orig);
+ new_number_clone(b, *b_orig);
+ new_number_clone(c, *c_orig);
+ new_number_clone(x, *x_orig);
+ new_number(ab);
+ new_number(bc);
+ new_number(ac);
+ new_number(xx);
+ new_number(neg_x);
+ set_number_from_addition(abc, a, b);
+ number_add(abc, c);
+ if (number_nonpositive(x)) {
+ set_number_to_zero(*ret);
+ } else if (number_greaterequal(x, abc)) {
+ set_number_to_unity(*ret);
+ } else {
+ number_clone(t, epsilon_t);
+ @<Rescale if necessary to make sure |a|, |b|, and |c| are all less than |EL_GORDO div 3|@>
+ do {
+ number_add(t, t);
+ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>
+ number_clone(xx,x);
+ number_subtract(xx, a);
+ number_subtract(xx, ab);
+ number_subtract(xx, ac);
+ number_negated_clone(neg_x, x);
+ if (number_less(xx, neg_x)) {
+ number_double(x);
+ number_clone(b, ab);
+ number_clone(c, ac);
+ } else {
+ number_add(x, xx);
+ number_clone(a, ac);
+ number_clone(b, bc);
+ number_add(t, epsilon_t);
+ }
+ } while (number_less(t, unity_t));
+ set_number_from_subtraction(*ret, t, unity_t);
+ }
+ free_number(abc);
+ free_number(t);
+ free_number(a);
+ free_number(b);
+ free_number(c);
+ free_number(ab);
+ free_number(bc);
+ free_number(ac);
+ free_number(xx);
+ free_number(x);
+ free_number(neg_x);
+}
+
+@ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>=
+set_number_half_from_addition(ab, a, b);
+set_number_half_from_addition(bc, b, c);
+set_number_half_from_addition(ac, ab, bc);
+
+@ The upper bound on |a|, |b|, and |c|:
+
+@d one_third_inf_t mp->math->md_one_third_inf_t
+
+@<Rescale if necessary to make sure |a|, |b|, and |c| are all less than...@>=
+while (number_greater(a, one_third_inf_t) || number_greater(b, one_third_inf_t) || number_greater(c, one_third_inf_t)) {
+ number_half(a);
+ number_half(b);
+ number_half(c);
+ number_half(x);
+}
+
+@ It is convenient to have a simpler interface to |arc_test| that requires no
+unnecessary arguments and ensures that each $({\it dx},{\it dy})$ pair has
+length less than |fraction_four|.
+
+@c
+static void mp_do_arc_test (MP mp,
+ mp_number *ret, mp_number *dx0, mp_number *dy0, mp_number *dx1,
+ mp_number *dy1, mp_number *dx2, mp_number *dy2, mp_number *a_goal
+)
+{
+ mp_number v0, v1, v2; /* length of each $({\it dx},{\it dy})$ pair */
+ mp_number v02; /* twice the norm of the quadratic at $t={1\over2}$ */
+ new_number(v0);
+ new_number(v1);
+ new_number(v2);
+ pyth_add(v0, *dx0, *dy0);
+ pyth_add(v1, *dx1, *dy1);
+ pyth_add(v2, *dx2, *dy2);
+ if ((number_greaterequal(v0, fraction_four_t)) || (number_greaterequal(v1, fraction_four_t)) || (number_greaterequal(v2, fraction_four_t))) {
+ mp->arith_error = 1;
+ if (number_infinite(*a_goal)) {
+ set_number_to_inf(*ret);
+ } else {
+ set_number_to_unity(*ret);
+ number_double(*ret);
+ number_negate(*ret);
+ }
+ } else {
+ mp_number arg1, arg2;
+ new_number(v02);
+ new_number(arg1);
+ new_number(arg2);
+ set_number_half_from_addition(arg1, *dx0, *dx2);
+ number_add(arg1, *dx1);
+ set_number_half_from_addition(arg2, *dy0, *dy2);
+ number_add(arg2, *dy1);
+ pyth_add(v02, arg1, arg2);
+ free_number(arg1);
+ free_number(arg2);
+ mp_arc_test(mp, ret, dx0, dy0, dx1, dy1, dx2, dy2, &v0, &v02, &v2, a_goal, &arc_tol_k);
+ free_number(v02);
+ }
+ free_number(v0);
+ free_number(v1);
+ free_number(v2);
+}
+
+@ Now it is easy to find the arc length of an entire path.
+
+@c
+static void mp_get_arc_length (MP mp, mp_number *ret, mp_knot h)
+{
+ mp_number a; /* current arc length */
+ mp_number a_tot; /* total arc length */
+ mp_number arg1, arg2, arg3, arg4, arg5, arg6;
+ mp_number arcgoal;
+ mp_knot p = h; /* for traversing the path */
+ new_number(a_tot);
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ new_number(arg4);
+ new_number(arg5);
+ new_number(arg6);
+ new_number(a);
+ new_number(arcgoal);
+ set_number_to_inf(arcgoal);
+ while (mp_right_type(p) != mp_endpoint_knot) {
+ mp_knot q = mp_next_knot(p);
+ @<Add arclength of path segment@>
+ if (q == h) {
+ break;
+ } else {
+ p = q;
+ }
+ }
+ free_number(arcgoal);
+ free_number(a);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ free_number(arg4);
+ free_number(arg5);
+ free_number(arg6);
+ check_arith();
+ number_clone(*ret, a_tot);
+ free_number(a_tot);
+}
+
+static void mp_get_subarc_length (MP mp, mp_number *ret, mp_knot h, mp_number *first, mp_number *last)
+{
+ mp_number a;
+ mp_number a_tot, a_cnt;
+ mp_number arg1, arg2, arg3, arg4, arg5, arg6;
+ mp_number arcgoal;
+ mp_knot p = h;
+ new_number(a_tot);
+ new_number(a_cnt);
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ new_number(arg4);
+ new_number(arg5);
+ new_number(arg6);
+ new_number(a);
+ new_number(arcgoal);
+ set_number_to_inf(arcgoal);
+ while (mp_right_type(p) != mp_endpoint_knot) {
+ mp_knot q = mp_next_knot(p);
+ if (number_greaterequal(a_cnt, *last)) {
+ break;
+ } else if (number_greaterequal(a_cnt, *first)) {
+ @<Add arclength of path segment@>
+ }
+ if (q == h) {
+ break;
+ } else {
+ p = q;
+ number_add(a_cnt, unity_t);
+ }
+ }
+ free_number(arcgoal);
+ free_number(a);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ free_number(arg4);
+ free_number(arg5);
+ free_number(arg6);
+ check_arith();
+ number_clone(*ret, a_tot);
+ free_number(a_cnt);
+ free_number(a_tot);
+}
+
+@<Add arclength of path segment@>=
+set_number_from_subtraction(arg1, p->right_x, p->x_coord);
+set_number_from_subtraction(arg2, p->right_y, p->y_coord);
+set_number_from_subtraction(arg3, q->left_x, p->right_x);
+set_number_from_subtraction(arg4, q->left_y, p->right_y);
+set_number_from_subtraction(arg5, q->x_coord, q->left_x);
+set_number_from_subtraction(arg6, q->y_coord, q->left_y);
+mp_do_arc_test(mp, &a, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arcgoal);
+slow_add(a_tot, a, a_tot);
+
+@ The inverse operation of finding the time on a path~|h| when the arc length
+reaches some value |arc0| can also be accomplished via |do_arc_test|. Some care
+is required to handle very large times or negative times on cyclic paths. For
+non-cyclic paths, |arc0| values that are negative or too large cause
+|get_arc_time| to return 0 or the length of path~|h|.
+
+If |arc0| is greater than the arc length of a cyclic path~|h|, the result is a
+time value greater than the length of the path. Since it could be much greater,
+we must be prepared to compute the arc length of path~|h| and divide this into
+|arc0| to find how many multiples of the length of path~|h| to add.
+
+@c
+static mp_knot mp_get_arc_time(MP mp, mp_number *ret, mp_knot h, mp_number *arc0_orig, int local)
+{
+ if (number_negative(*arc0_orig)) {
+ @<Deal with a negative |arc0_orig| value and |return|@>
+ } else {
+ mp_knot p, q, k; /* for traversing the path */
+ mp_number t_tot; /* accumulator for the result */
+ mp_number t; /* the result of |do_arc_test| */
+ mp_number arc, arc0; /* portion of |arc0| not used up so far */
+ mp_number arg1, arg2, arg3, arg4, arg5, arg6; /* |do_arc_test| arguments */
+ new_number(t_tot);
+ new_number_clone(arc0, *arc0_orig);
+ if (number_infinite(arc0)) {
+ number_add_scaled(arc0, -1);
+ }
+ new_number_clone(arc, arc0);
+ p = h;
+ k = h;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ new_number(arg4);
+ new_number(arg5);
+ new_number(arg6);
+ new_number(t);
+ while ((mp_right_type(p) != mp_endpoint_knot) && number_positive(arc)) {
+ k = p;
+ q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->right_x, p->x_coord);
+ set_number_from_subtraction(arg2, p->right_y, p->y_coord);
+ set_number_from_subtraction(arg3, q->left_x, p->right_x);
+ set_number_from_subtraction(arg4, q->left_y, p->right_y);
+ set_number_from_subtraction(arg5, q->x_coord, q->left_x);
+ set_number_from_subtraction(arg6, q->y_coord, q->left_y);
+ mp_do_arc_test(mp, &t, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arc);
+ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>
+ if (q == h) {
+ @<Update |t_tot| and |arc| to avoid going around the cyclic path too many times but set |arith_error:=1| and |goto done| on overflow@>
+ }
+ p = q;
+ }
+ check_arith();
+ if (local) {
+ number_add(t, two_t);
+ number_clone(*ret, t);
+ } else {
+ number_clone(*ret, t_tot);
+ }
+ h = k;
+ RETURN:
+ free_number(t_tot);
+ free_number(t);
+ free_number(arc);
+ free_number(arc0);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ free_number(arg4);
+ free_number(arg5);
+ free_number(arg6);
+ }
+ return h;
+}
+
+@ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>=
+if (number_negative(t)) {
+ number_add(t_tot, t);
+ number_add(t_tot, two_t);
+ set_number_to_zero(arc);
+} else {
+ number_add(t_tot, unity_t);
+ number_subtract(arc, t);
+}
+
+@ @<Deal with a negative |arc0_orig| value and |return|@>=
+if (mp_left_type(h) == mp_endpoint_knot) {
+ set_number_to_zero(*ret);
+} else {
+ mp_number neg_arc0;
+ mp_knot p = mp_htap_ypoc(mp, h);
+ new_number(neg_arc0);
+ number_negated_clone(neg_arc0, *arc0_orig);
+ mp_get_arc_time(mp, ret, p, &neg_arc0, 0);
+ number_negate(*ret);
+ mp_toss_knot_list(mp, p);
+ free_number(neg_arc0);
+}
+check_arith();
+
+@ @<Update |t_tot| and |arc| to avoid going around the cyclic...@>=
+if (number_positive(arc)) {
+ mp_number n, n1, d1, v1;
+ new_number(n);
+ new_number(n1);
+ new_number(d1);
+ new_number(v1);
+
+ set_number_from_subtraction(d1, arc0, arc); /* d1 = arc0 - arc */
+ set_number_from_div(n1, arc, d1); /* n1 = (arc / d1) */
+ number_clone(n, n1);
+ set_number_from_mul(n1, n1, d1); /* n1 = (n1 * d1) */
+ number_subtract(arc, n1); /* arc = arc - n1 */
+
+ number_clone(d1, inf_t); /* reuse d1 */
+ number_clone(v1, n); /* v1 = n */
+ number_add(v1, epsilon_t); /* v1 = n1+1 */
+ set_number_from_div(d1, d1, v1); /* |d1 = EL_GORDO / v1| */
+ if (number_greater(t_tot, d1)) {
+ mp->arith_error = 1;
+ check_arith();
+ set_number_to_inf(*ret);
+ free_number(n);
+ free_number(n1);
+ free_number(d1);
+ free_number(v1);
+ goto RETURN;
+ }
+ set_number_from_mul(t_tot, t_tot, v1);
+ free_number(n);
+ free_number(n1);
+ free_number(d1);
+ free_number(v1);
+}
+
+@* Data structures for pens.
+
+A Pen in \MP\ can be either elliptical or polygonal. Elliptical pens result in
+\ps\ |stroke| commands, while anything drawn with a polygonal pen is
+@:stroke}{|stroke| command@> converted into an area fill as described in the
+next part of this program. The mathematics behind this process is based on simple
+aspects of the theory of tracings developed by Leo Guibas, Lyle Ramshaw, and
+Jorge Stolfi [\quote {A kinematic framework for computational geometry,} Proc.\ IEEE
+Symp.\ Foundations of Computer Science {\bf 24} (1983), 100--111].
+
+Polygonal pens are created from paths via \MP's |makepen| primitive.
+@:makepen_}{|makepen| primitive@> This path representation is almost sufficient
+for our purposes except that a pen path should always be a convex polygon with
+the vertices in counter-clockwise order. Since we will need to scan pen polygons
+both forward and backward, a pen should be represented as a doubly linked ring of
+knot nodes. There is room for the extra back pointer because we do not need the
+|mp_left_type| or |mp_right_type| fields. In fact, we don't need the |left_x|,
+|left_y|, |right_x|, or |right_y| fields either but we leave these alone so that
+certain procedures can operate on both pens and paths. In particular, pens can be
+copied using |copy_path| and recycled using |toss_knot_list|.
+
+@ The |make_pen| procedure turns a path into a pen by initializing the
+|prev_knot| pointers and making sure the knots form a convex polygon. Thus each
+cubic in the given path becomes a straight line and the control points are
+ignored. If the path is not cyclic, the ends are connected by a straight line.
+
+@d mp_copy_pen(mp,A) mp_make_pen(mp, mp_copy_path(mp, (A)),0)
+
+@c
+static mp_knot mp_make_pen (MP mp, mp_knot h, int need_hull)
+{
+ mp_knot q = h;
+ /* this can go ... we are already double linked */
+ do {
+ mp_knot p = q;
+ q = mp_next_knot(q);
+ mp_prev_knot(q) = p;
+ } while (q != h);
+ if (need_hull) {
+ h = mp_convex_hull(mp, h);
+ @<Make sure |h| isn't confused with an elliptical pen@>
+ }
+ return h;
+}
+
+@ The only information required about an elliptical pen is the overall
+transformation that has been applied to the original |pencircle|.
+@:pencircle_}{|pencircle| primitive@> Since it suffices to keep track of how
+the three points $(0,0)$, $(1,0)$, and $(0,1)$ are transformed, an elliptical pen
+can be stored in a single knot node and transformed as if it were a path.
+
+@d mp_pen_is_elliptical(A) ((A)==mp_next_knot((A)))
+
+@ @c
+static mp_knot mp_get_pen_circle (MP mp, mp_number *diam)
+{
+ mp_knot h = mp_new_knot(mp); /* the knot node to return */
+ mp_next_knot(h) = h;
+ mp_prev_knot(h) = h;
+ mp_originator(h) = mp_program_code;
+ mp_knotstate(h) = mp_regular_knot;
+ set_number_to_zero(h->x_coord);
+ set_number_to_zero(h->y_coord);
+ number_clone(h->left_x, *diam);
+ set_number_to_zero(h->left_y);
+ set_number_to_zero(h->right_x);
+ number_clone(h->right_y, *diam);
+ return h;
+}
+
+@ If the polygon being returned by |make_pen| has only one vertex, it will be
+interpreted as an elliptical pen. This is no problem since a degenerate polygon
+can equally well be thought of as a degenerate ellipse. We need only initialize
+the |left_x|, |left_y|, |right_x|, and |right_y| fields.
+
+
+@<Make sure |h| isn't confused with an elliptical pen@>=
+if (mp_pen_is_elliptical(h)) {
+ number_clone(h->left_x, h->x_coord);
+ number_clone(h->left_y, h->y_coord);
+ number_clone(h->right_x, h->x_coord);
+ number_clone(h->right_y, h->y_coord);
+}
+
+@ Printing a polygonal pen is very much like printing a path
+
+@<Declarations@>=
+static void mp_pr_pen (MP mp, mp_knot h);
+
+@ @c
+void mp_pr_pen (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ @<Print the elliptical pen |h|@>
+ } else {
+ mp_knot p = h;
+ do {
+ /* Advance |p| making sure the links are OK and |return| if there is a problem. */
+ mp_knot q = mp_next_knot(p);
+ mp_print_two(mp, &(p->x_coord), &(p->y_coord));
+ mp_print_nl(mp, " .. ");
+ if ((q == NULL) || (mp_prev_knot(q) != p)) {
+ mp_print_nl(mp, "???");
+ return; /* this won't happen */
+ @.???@>
+ }
+ p = q;
+ } while (p != h);
+ mp_print_str(mp, "cycle");
+ }
+}
+
+@ @<Print the elliptical pen |h|@>=
+{
+ mp_number v1;
+ new_number(v1);
+ mp_print_str(mp, "pencircle transformed (");
+ print_number(h->x_coord);
+ mp_print_chr(mp, ',');
+ print_number(h->y_coord);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->left_x, h->x_coord);
+ print_number(v1);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->right_x, h->x_coord);
+ print_number(v1);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->left_y, h->y_coord);
+ print_number(v1);
+ mp_print_chr(mp, ',');
+ set_number_from_subtraction(v1, h->right_y, h->y_coord);
+ print_number(v1);
+ mp_print_chr(mp, ')');
+ free_number(v1);
+}
+
+@ Here us another version of |pr_pen| that prints the pen as a diagnostic
+message.
+
+@<Declarations@>=
+static void mp_print_pen (MP mp, mp_knot h, const char *s, int nuline);
+
+@ @c
+void mp_print_pen (MP mp, mp_knot h, const char *s, int nuline) {
+ mp_print_diagnostic(mp, "Pen", s, nuline);
+ mp_print_ln(mp);
+ @.Pen at line...@>
+ mp_pr_pen(mp, h);
+ mp_end_diagnostic(mp, 1);
+}
+
+@ Making a polygonal pen into a path involves restoring the |mp_left_type| and
+|mp_right_type| fields and setting the control points so as to make a polygonal
+path.
+
+@c
+static void mp_make_path (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ @<Make the elliptical pen |h| into a path@>
+ } else {
+ mp_knot p = h;
+ do {
+ mp_left_type(p) = mp_explicit_knot;
+ mp_right_type(p) = mp_explicit_knot;
+ number_clone(p->left_x, p->x_coord);
+ number_clone(p->left_y, p->y_coord);
+ number_clone(p->right_x, p->x_coord);
+ number_clone(p->right_y, p->y_coord);
+ p = mp_next_knot(p);
+ } while (p != h);
+ }
+}
+
+@ We need an eight knot path to get a good approximation to an ellipse.
+
+@<Make the elliptical pen |h| into a path@>=
+mp_knot p; /* for traversing the knot list */
+mp_number center_x, center_y; /* translation parameters for an elliptical pen */
+mp_number width_x, width_y; /* the effect of a unit change in $x$ */
+mp_number height_x, height_y; /* the effect of a unit change in $y$ */
+mp_number dx, dy; /* the vector from knot |p| to its right control point */
+new_number(width_x);
+new_number(width_y);
+new_number(height_x);
+new_number(height_y);
+new_number(dx);
+new_number(dy);
+new_number_clone(center_x, h->x_coord);
+new_number_clone(center_y, h->y_coord);
+set_number_from_subtraction(width_x, h->left_x, center_x);
+set_number_from_subtraction(width_y, h->left_y, center_y);
+set_number_from_subtraction(height_x, h->right_x, center_x);
+set_number_from_subtraction(height_y, h->right_y, center_y);
+p = h;
+for (int k = 0; k <= 7; k++) {
+ @<Initialize |p| as the |k|th knot of a circle of unit diameter, transforming it appropriately@>
+ if (k == 7) {
+ mp_prev_knot(h) = p;
+ mp_next_knot(p) = h;
+ } else {
+ mp_knot k = mp_new_knot(mp);
+ mp_prev_knot(k) = p;
+ mp_next_knot(p) = k;
+ }
+ p = mp_next_knot(p);
+}
+free_number(dx);
+free_number(dy);
+free_number(center_x);
+free_number(center_y);
+free_number(width_x);
+free_number(width_y);
+free_number(height_x);
+free_number(height_y);
+
+@ The only tricky thing here are the tables |half_cos| and |d_cos| used to find
+the point $k/8$ of the way around the circle and the direction vector to use
+there. With |kk| we track |k| advancing $270^\circ$ around the ring (cf. $\sin
+\theta = \cos (\theta+270)$).
+
+@<Initialize |p| as the |k|th knot of a circle of unit diameter,...@>=
+/* This is the body of a loop with variable k: */
+int kk = (k + 6) % 8;
+mp_number r1, r2;
+new_fraction(r1);
+new_fraction(r2);
+take_fraction(r1, mp->half_cos[k], width_x);
+take_fraction(r2, mp->half_cos[kk], height_x);
+number_add(r1, r2);
+set_number_from_addition(p->x_coord, center_x, r1);
+take_fraction(r1, mp->half_cos[k], width_y);
+take_fraction(r2, mp->half_cos[kk], height_y);
+number_add(r1, r2);
+set_number_from_addition(p->y_coord, center_y, r1);
+take_fraction(r1, mp->d_cos[kk], width_x);
+take_fraction(r2, mp->d_cos[k], height_x);
+number_negated_clone(dx, r1);
+number_add(dx, r2);
+take_fraction(r1, mp->d_cos[kk], width_y);
+take_fraction(r2, mp->d_cos[k], height_y);
+number_negated_clone(dy, r1);
+number_add(dy, r2);
+set_number_from_addition(p->right_x, p->x_coord, dx);
+set_number_from_addition(p->right_y, p->y_coord, dy);
+set_number_from_subtraction(p->left_x, p->x_coord, dx);
+set_number_from_subtraction(p->left_y, p->y_coord, dy);
+free_number(r1);
+free_number(r2);
+mp_left_type(p) = mp_explicit_knot;
+mp_right_type(p) = mp_explicit_knot;
+mp_originator(p) = mp_program_code;
+mp_knotstate(p) = mp_regular_knot;
+
+@ @<Glob...@>=
+mp_number half_cos[8]; /* ${1\over2}\cos(45k)$ */
+mp_number d_cos[8]; /* a magic constant times $\cos(45k)$ */
+
+@ The magic constant for |d_cos| is the distance between $({1\over2},0)$ and
+$({1\over4}\sqrt2,{1\over4}\sqrt2)$ times the result of the |velocity| function
+for $\theta=\phi=22.5^\circ$. This comes out to be
+
+$$ d = {\sqrt{2-\sqrt2}\over 3+3\cos22.5^\circ} \approx 0.132608244919772. $$
+
+@<Set init...@>=
+for (int k = 0; k <= 7; k++) {
+ new_fraction(mp->half_cos[k]);
+ new_fraction(mp->d_cos[k]);
+}
+
+number_clone(mp->half_cos[0], fraction_half_t);
+number_clone(mp->half_cos[1], twentysixbits_sqrt2_t);
+number_clone(mp->half_cos[2], zero_t);
+number_clone(mp->d_cos[0], twentyeightbits_d_t);
+number_clone(mp->d_cos[1], twentysevenbits_sqrt2_d_t);
+number_clone(mp->d_cos[2], zero_t);
+
+for (int k = 3; k <= 4; k++) {
+ number_negated_clone(mp->half_cos[k], mp->half_cos[4 - k]);
+ number_negated_clone(mp->d_cos[k], mp->d_cos[4 - k]);
+}
+
+for (int k = 5; k <= 7; k++) {
+ number_clone(mp->half_cos[k], mp->half_cos[8 - k]);
+ number_clone(mp->d_cos[k], mp->d_cos[8 - k]);
+}
+
+@ @<Dealloc...@>=
+for (int k = 0; k <= 7; k++) {
+ free_number(mp->half_cos[k]);
+ free_number(mp->d_cos[k]);
+}
+
+@ The |convex_hull| function forces a pen polygon to be convex when it is
+returned by |make_pen| and after any subsequent transformation where rounding
+error might allow the convexity to be lost. The convex hull algorithm used here
+is described by F.~P. Preparata and M.~I. Shamos [{\sl Computational Geometry},
+Springer-Verlag, 1985].
+
+@<Declarations@>=
+static mp_knot mp_convex_hull (MP mp, mp_knot h);
+
+@ @c
+mp_knot mp_convex_hull (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ return h;
+ } else {
+ /* Make a polygonal pen convex */
+ mp_knot l, r; /* the leftmost and rightmost knots */
+ mp_knot p, q; /* knots being scanned */
+ mp_knot s; /* the starting point for an upcoming scan */
+ mp_number dx, dy; /* a temporary pointer */
+ new_number(dx);
+ new_number(dy);
+ @<Set |l| to the leftmost knot in polygon~|h|@>
+ @<Set |r| to the rightmost knot in polygon~|h|@>
+ if (l != r) {
+ mp_knot s = mp_next_knot(r);
+ @<Find any knots on the path from |l| to |r| above the |l|-|r| line and move them past~|r|@>
+ @<Find any knots on the path from |s| to |l| below the |l|-|r| line and move them past~|l|@>
+ @<Sort the path from |l| to |r| by increasing $x$@>
+ @<Sort the path from |r| to |l| by decreasing $x$@>
+ }
+ if (l != mp_next_knot(l)) {
+ @<Do a Gramm scan and remove vertices where there is no left turn@>
+ }
+ free_number(dx);
+ free_number(dy);
+ return l;
+ }
+}
+
+@<Declarations@>=
+void mp_simplify_path (MP mp, mp_knot h);
+
+@ @c
+void mp_simplify_path (MP mp, mp_knot h)
+{
+ mp_knot p = h;
+ (void) mp;
+ do {
+ p->left_x = p->x_coord;
+ p->left_y = p->y_coord;
+ p->right_x = p->x_coord;
+ p->right_y = p->y_coord;
+ p = mp_next_knot(p);
+ } while (p != h);
+}
+
+@ All comparisons are done primarily on $x$ and secondarily on $y$.
+
+@<Set |l| to the leftmost knot in polygon~|h|@>=
+l = h;
+p = mp_next_knot(h);
+while (p != h) {
+ if (number_lessequal(p->x_coord, l->x_coord) && (number_less(p->x_coord, l->x_coord) || number_less(p->y_coord, l->y_coord))) {
+ l = p;
+ }
+ p = mp_next_knot(p);
+}
+
+@ @<Set |r| to the rightmost knot in polygon~|h|@>=
+r = h;
+p = mp_next_knot(h);
+while (p != h) {
+ if (number_greaterequal(p->x_coord, r->x_coord) && (number_greater(p->x_coord, r->x_coord) || number_greater(p->y_coord, r->y_coord))) {
+ r = p;
+ }
+ p = mp_next_knot(p);
+}
+
+@ @<Find any knots on the path from |l| to |r| above the |l|-|r| line...@>=
+{
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ set_number_from_subtraction(dx, r->x_coord, l->x_coord);
+ set_number_from_subtraction(dy, r->y_coord, l->y_coord);
+ p = mp_next_knot(l);
+ while (p != r) {
+ q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->y_coord, l->y_coord);
+ set_number_from_subtraction(arg2, p->x_coord, l->x_coord);
+ if (ab_vs_cd(dx, arg1, dy, arg2) > 0) {
+ mp_move_knot(mp, p, r);
+ }
+ p = q;
+ }
+ free_number(arg1);
+ free_number(arg2);
+}
+
+@ The |move_knot| procedure removes |p| from a doubly linked list and inserts
+it after |q|.
+
+@ @<Declarations@>=
+static void mp_move_knot (MP mp, mp_knot p, mp_knot q);
+
+@ @c
+void mp_move_knot (MP mp, mp_knot p, mp_knot q)
+{
+ (void) mp;
+ mp_next_knot(mp_prev_knot(p)) = mp_next_knot(p);
+ mp_prev_knot(mp_next_knot(p)) = mp_prev_knot(p);
+ mp_prev_knot(p) = q;
+ mp_next_knot(p) = mp_next_knot(q);
+ mp_next_knot(q) = p;
+ mp_prev_knot(mp_next_knot(p)) = p;
+}
+
+@ @<Find any knots on the path from |s| to |l| below the |l|-|r| line...@>=
+{
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ p = s;
+ while (p != l) {
+ q = mp_next_knot(p);
+ set_number_from_subtraction(arg1, p->y_coord, l->y_coord);
+ set_number_from_subtraction(arg2, p->x_coord, l->x_coord);
+ if (ab_vs_cd(dx, arg1, dy, arg2) < 0) {
+ mp_move_knot(mp, p, l);
+ }
+ p = q;
+ }
+ free_number(arg1);
+ free_number(arg2);
+}
+
+@ The list is likely to be in order already so we just do linear insertions.
+Secondary comparisons on $y$ ensure that the sort is consistent with the choice
+of |l| and |r|.
+
+@<Sort the path from |l| to |r| by increasing $x$@>=
+p = mp_next_knot(l);
+while (p != r) {
+ q = mp_prev_knot(p);
+ while (number_greater(q->x_coord, p->x_coord)) {
+ q = mp_prev_knot(q);
+ }
+ while (number_equal(q->x_coord, p->x_coord)) {
+ if (number_greater(q->y_coord, p->y_coord)) {
+ q = mp_prev_knot(q);
+ } else {
+ break;
+ }
+ }
+ if (q == mp_prev_knot(p)) {
+ p = mp_next_knot(p);
+ } else {
+ p = mp_next_knot(p);
+ mp_move_knot(mp, mp_prev_knot(p), q);
+ }
+}
+
+@ @<Sort the path from |r| to |l| by decreasing $x$@>=
+p = mp_next_knot(r);
+while (p != l) {
+ q = mp_prev_knot(p);
+ while (number_less(q->x_coord, p->x_coord)) {
+ q = mp_prev_knot(q);
+ }
+ while (number_equal(q->x_coord, p->x_coord)) {
+ if (number_less(q->y_coord, p->y_coord)) {
+ q = mp_prev_knot(q);
+ } else {
+ break;
+ }
+ }
+ if (q == mp_prev_knot(p)) {
+ p = mp_next_knot(p);
+ } else {
+ p = mp_next_knot(p);
+ mp_move_knot(mp, mp_prev_knot(p), q);
+ }
+}
+
+@ The condition involving |ab_vs_cd| tests if there is not a left turn at knot
+|q|. There usually will be a left turn so we streamline the case where the |then|
+clause is not executed.
+
+@<Do a Gramm scan and remove vertices where there...@>=
+mp_number arg1, arg2;
+new_number(arg1);
+new_number(arg2);
+p = l;
+q = mp_next_knot(l);
+while (1) {
+ set_number_from_subtraction(dx, q->x_coord, p->x_coord);
+ set_number_from_subtraction(dy, q->y_coord, p->y_coord);
+ p = q;
+ q = mp_next_knot(q);
+ if (p == l) {
+ break;
+ } else if (p != r) {
+ set_number_from_subtraction(arg1, q->y_coord, p->y_coord);
+ set_number_from_subtraction(arg2, q->x_coord, p->x_coord);
+ if (ab_vs_cd(dx, arg1, dy, arg2) <= 0) {
+ /* Remove knot |p| and back up |p| and |q| but don't go past |l|. */
+ s = mp_prev_knot(p);
+ mp_memory_free(p);
+ mp_next_knot(s) = q;
+ mp_prev_knot(q) = s;
+ if (s == l) {
+ p = s;
+ } else {
+ p = mp_prev_knot(s);
+ q = s;
+ }
+ }
+ }
+}
+free_number(arg1);
+free_number(arg2);
+
+@ The |find_offset| procedure sets global variables |(cur_x,cur_y)| to the offset
+associated with the given direction |(x,y)|. If two different offsets apply, it
+chooses one of them.
+
+@c
+static void mp_find_offset (MP mp, mp_number *x_orig, mp_number *y_orig, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ mp_fraction xx, yy; /* untransformed offset for an elliptical pen */
+ mp_number wx, wy, hx, hy; /* the transformation matrix for an elliptical pen */
+ mp_fraction d; /* a temporary register */
+ new_fraction(xx);
+ new_fraction(yy);
+ new_number(wx);
+ new_number(wy);
+ new_number(hx);
+ new_number(hy);
+ new_fraction(d);
+ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>
+ free_number(xx);
+ free_number(yy);
+ free_number(wx);
+ free_number(wy);
+ free_number(hx);
+ free_number(hy);
+ free_number(d);
+ } else {
+ mp_knot p, q; /* consecutive knots */
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ q = h;
+ do {
+ p = q;
+ q = mp_next_knot(q);
+ set_number_from_subtraction(arg1, q->x_coord, p->x_coord);
+ set_number_from_subtraction(arg2, q->y_coord, p->y_coord);
+ } while (ab_vs_cd(arg1, *y_orig, arg2, *x_orig) < 0);
+ do {
+ p = q;
+ q = mp_next_knot(q);
+ set_number_from_subtraction(arg1, q->x_coord, p->x_coord);
+ set_number_from_subtraction(arg2, q->y_coord, p->y_coord);
+ } while (ab_vs_cd(arg1, *y_orig, arg2, *x_orig) > 0);
+ number_clone(mp->cur_x, p->x_coord);
+ number_clone(mp->cur_y, p->y_coord);
+ free_number(arg1);
+ free_number(arg2);
+ }
+}
+
+@ @<Glob...@>=
+mp_number cur_x;
+mp_number cur_y; /* all-purpose return value registers */
+
+@ @<Initialize table entries@>=
+new_number(mp->cur_x);
+new_number(mp->cur_y);
+
+@ @<Dealloc...@>=
+free_number(mp->cur_x);
+free_number(mp->cur_y);
+
+@ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>=
+if (number_zero(*x_orig) && number_zero(*y_orig)) {
+ number_clone(mp->cur_x, h->x_coord);
+ number_clone(mp->cur_y, h->y_coord);
+} else {
+ mp_number x, y, abs_x, abs_y;
+ new_number_clone(x, *x_orig);
+ new_number_clone(y, *y_orig);
+ @<Find the non-constant part of the transformation for |h|@>
+ new_number_abs(abs_x, x);
+ new_number_abs(abs_y, y);
+ while (number_less(abs_x, fraction_half_t) && number_less(abs_y, fraction_half_t)) {
+ number_double(x);
+ number_double(y);
+ number_abs_clone(abs_x, x);
+ number_abs_clone(abs_y, y);
+ }
+ @<Make |(xx,yy)| the offset on the untransformed |pencircle| for the untransformed version of |(x,y)|@>
+ {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, xx, wx);
+ take_fraction(r2, yy, hx);
+ number_add(r1, r2);
+ set_number_from_addition(mp->cur_x, h->x_coord, r1);
+ take_fraction(r1, xx, wy);
+ take_fraction(r2, yy, hy);
+ number_add(r1, r2);
+ set_number_from_addition(mp->cur_y, h->y_coord, r1);
+ free_number(r1);
+ free_number(r2);
+ }
+ free_number(abs_x);
+ free_number(abs_y);
+ free_number(x);
+ free_number(y);
+}
+
+@ @<Find the non-constant part of the transformation for |h|@>=
+set_number_from_subtraction(wx, h->left_x, h->x_coord);
+set_number_from_subtraction(wy, h->left_y, h->y_coord);
+set_number_from_subtraction(hx, h->right_x, h->x_coord);
+set_number_from_subtraction(hy, h->right_y, h->y_coord);
+
+@ @<Make |(xx,yy)| the offset on the untransformed |pencircle| for the...@>=
+{
+ mp_number r1, r2, arg1;
+ new_number(arg1);
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, x, hy);
+ number_negated_clone(arg1, hx);
+ take_fraction(r2, y, arg1);
+ number_add(r1, r2);
+ number_negate(r1);
+ number_clone(yy, r1);
+ number_negated_clone(arg1, wy);
+ take_fraction(r1, x, arg1);
+ take_fraction(r2, y, wx);
+ number_add(r1, r2);
+ number_clone(xx, r1);
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+}
+pyth_add(d, xx, yy);
+if (number_positive(d)) {
+ mp_number ret;
+ new_fraction(ret);
+ make_fraction(ret, xx, d);
+ number_half(ret);
+ number_clone(xx, ret);
+ make_fraction(ret, yy, d);
+ number_half(ret);
+ number_clone(yy, ret);
+ free_number(ret);
+}
+
+@ Finding the bounding box of a pen is easy except if the pen is elliptical. But
+we can handle that case by just calling |find_offset| twice. The answer is stored
+in the global variables |minx|, |maxx|, |miny|, and |maxy|.
+
+@c
+static void mp_pen_bbox (MP mp, mp_knot h)
+{
+ if (mp_pen_is_elliptical(h)) {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_fraction(arg2);
+ number_clone(arg2, fraction_one_t);
+ mp_find_offset(mp, &arg1, &arg2, h);
+ number_clone(mp_maxx, mp->cur_x);
+ number_clone(mp_minx, h->x_coord);
+ number_double(mp_minx);
+ number_subtract(mp_minx, mp->cur_x);
+ number_negate(arg2);
+ mp_find_offset(mp, &arg2, &arg1, h);
+ number_clone(mp_maxy, mp->cur_y);
+ number_clone(mp_miny, h->y_coord);
+ number_double(mp_miny);
+ number_subtract(mp_miny, mp->cur_y);
+ free_number(arg1);
+ free_number(arg2);
+ } else {
+ mp_knot p = mp_next_knot(h); /* for scanning the knot list */
+ number_clone(mp_minx, h->x_coord);
+ number_clone(mp_maxx, mp_minx);
+ number_clone(mp_miny, h->y_coord);
+ number_clone(mp_maxy, mp_miny);
+ while (p != h) {
+ if (number_less(p->x_coord, mp_minx)) {
+ number_clone(mp_minx, p->x_coord);
+ }
+ if (number_less(p->y_coord, mp_miny)) {
+ number_clone(mp_miny, p->y_coord);
+ }
+ if (number_greater(p->x_coord, mp_maxx)) {
+ number_clone(mp_maxx, p->x_coord);
+ }
+ if (number_greater(p->y_coord, mp_maxy)) {
+ number_clone(mp_maxy, p->y_coord);
+ }
+ p = mp_next_knot(p);
+ }
+ }
+}
+
+@* Numerical values.
+
+This first set goes into the header
+
+@<MPlib internal header stuff@>=
+@d mp_fraction mp_number
+@d mp_angle mp_number
+
+@d new_number(A) mp->math->md_allocate(mp, &(A), mp_scaled_type)
+@d new_fraction(A) mp->math->md_allocate(mp, &(A), mp_fraction_type)
+@d new_angle(A) mp->math->md_allocate(mp, &(A), mp_angle_type)
+
+@d new_number_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_scaled_type, &(B))
+@d new_fraction_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_fraction_type, &(B))
+@d new_angle_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_angle_type, &(B))
+
+@d new_number_from_double(mp,A,B) mp->math->md_allocate_double(mp, &(A), B)
+@d new_number_abs(A,B) mp->math->md_allocate_abs(mp, &(A), mp_scaled_type, &(B))
+
+@d free_number(A) mp->math->md_free(mp, &(A))
+
+@d set_precision() mp->math->md_set_precision(mp)
+@d free_math() mp->math->md_free_math(mp)
+@d scan_numeric_token(A) mp->math->md_scan_numeric(mp,A)
+@d scan_fractional_token(A) mp->math->md_scan_fractional(mp,A)
+@d set_number_from_of_the_way(A,t,B,C) mp->math->md_from_oftheway(mp,&(A),&(t),&(B),&(C))
+@d set_number_from_int(A,B) mp->math->md_from_int(&(A),B)
+@d set_number_from_scaled(A,B) mp->math->md_from_scaled(&(A),B)
+@d set_number_from_boolean(A,B) mp->math->md_from_boolean(&(A),B)
+@d set_number_from_double(A,B) mp->math->md_from_double(&(A),B)
+@d set_number_from_addition(A,B,C) mp->math->md_from_addition(&(A),&(B),&(C))
+@d set_number_half_from_addition(A,B,C) mp->math->md_half_from_addition(&(A),&(B),&(C))
+@d set_number_from_subtraction(A,B,C) mp->math->md_from_subtraction(&(A),&(B),&(C))
+@d set_number_half_from_subtraction(A,B,C) mp->math->md_half_from_subtraction(&(A),&(B),&(C))
+@d set_number_from_div(A,B,C) mp->math->md_from_div(&(A),&(B),&(C))
+@d set_number_from_mul(A,B,C) mp->math->md_from_mul(&(A),&(B),&(C))
+@d number_int_div(A,C) mp->math->md_from_int_div(&(A),&(A),C)
+@d set_number_from_int_mul(A,B,C) mp->math->md_from_int_mul(&(A),&(B),C)
+
+@d set_number_to_unity(A) mp->math->md_clone(&(A), &unity_t)
+@d set_number_to_zero(A) mp->math->md_clone(&(A), &zero_t)
+@d set_number_to_inf(A) mp->math->md_clone(&(A), &inf_t)
+@d set_number_to_negative_inf(A) mp->math->md_clone(&(A), &negative_inf_t)
+@d old_set_number_to_neg_inf(A) do { set_number_to_inf(A); number_negate(A); } while (0)
+
+@d init_randoms(A) mp->math->md_init_randoms(mp,A)
+@d print_number(A) mp->math->md_print(mp,&(A))
+@d number_tostring(A) mp->math->md_tostring(mp,&(A))
+@d make_scaled(R,A,B) mp->math->md_make_scaled(mp,&(R),&(A),&(B))
+@d take_scaled(R,A,B) mp->math->md_take_scaled(mp,&(R),&(A),&(B))
+@d make_fraction(R,A,B) mp->math->md_make_fraction(mp,&(R),&(A),&(B))
+@d take_fraction(R,A,B) mp->math->md_take_fraction(mp,&(R),&(A),&(B))
+@d pyth_add(R,A,B) mp->math->md_pyth_add(mp,&(R),&(A),&(B))
+@d pyth_sub(R,A,B) mp->math->md_pyth_sub(mp,&(R),&(A),&(B))
+@d power_of(R,A,B) mp->math->md_power_of(mp,&(R),&(A),&(B))
+@d n_arg(R,A,B) mp->math->md_n_arg(mp,&(R),&(A),&(B))
+@d m_log(R,A) mp->math->md_m_log(mp,&(R),&(A))
+@d m_exp(R,A) mp->math->md_m_exp(mp,&(R),&(A))
+@d m_unif_rand(R,A) mp->math->md_m_unif_rand(mp,&(R),&(A))
+@d m_norm_rand(R) mp->math->md_m_norm_rand(mp,&(R))
+@d velocity(R,A,B,C,D,E) mp->math->md_velocity(mp,&(R),&(A),&(B),&(C),&(D),&(E))
+@d ab_vs_cd(A,B,C,D) mp->math->md_ab_vs_cd(&(A),&(B),&(C),&(D))
+@d crossing_point(R,A,B,C) mp->math->md_crossing_point(mp,&(R),&(A),&(B),&(C))
+@d n_sin_cos(A,S,C) mp->math->md_sin_cos(mp,&(A),&(S),&(C))
+@d square_rt(A,S) mp->math->md_sqrt(mp,&(A),&(S))
+@d slow_add(R,A,B) mp->math->md_slow_add(mp,&(R),&(A),&(B))
+@d round_unscaled(A) mp->math->md_round_unscaled(&(A))
+@d floor_scaled(A) mp->math->md_floor_scaled(&(A))
+@d fraction_to_round_scaled(A) mp->math->md_fraction_to_round_scaled(&(A))
+@d number_to_int(A) mp->math->md_to_int(&(A))
+@d number_to_boolean(A) mp->math->md_to_boolean(&(A))
+@d number_to_scaled(A) mp->math->md_to_scaled(&(A))
+@d number_to_double(A) mp->math->md_to_double(&(A))
+@d number_negate(A) mp->math->md_negate(&(A))
+@d number_add(A,B) mp->math->md_add(&(A),&(B))
+@d number_subtract(A,B) mp->math->md_subtract(&(A),&(B))
+@d number_half(A) mp->math->md_half(&(A))
+@d number_double(A) mp->math->md_do_double(&(A))
+@d number_add_scaled(A,B) mp->math->md_add_scaled(&(A),B)
+@d number_multiply_int(A,B) mp->math->md_multiply_int(&(A),B)
+@d number_divide_int(A,B) mp->math->md_divide_int(&(A),B)
+@d number_abs(A) mp->math->md_abs(&(A))
+@d number_modulo(A,B) mp->math->md_modulo(&(A),&(B))
+@d number_nonequalabs(A,B) mp->math->md_nonequalabs(&(A),&(B))
+@d number_odd(A) mp->math->md_odd(&(A))
+@d number_equal(A,B) mp->math->md_equal(&(A),&(B))
+@d number_greater(A,B) mp->math->md_greater(&(A),&(B))
+@d number_less(A,B) mp->math->md_less(&(A),&(B))
+@d number_clone(A,B) mp->math->md_clone(&(A),&(B))
+@d number_negated_clone(A,B) mp->math->md_negated_clone(&(A),&(B))
+@d number_abs_clone(A,B) mp->math->md_abs_clone(&(A),&(B))
+@d number_swap(A,B) mp->math->md_swap(&(A),&(B));
+@d convert_scaled_to_angle(A) mp->math->md_scaled_to_angle(&(A));
+@d convert_angle_to_scaled(A) mp->math->md_angle_to_scaled(&(A));
+@d convert_fraction_to_scaled(A) mp->math->md_fraction_to_scaled(&(A));
+@d convert_scaled_to_fraction(A) mp->math->md_scaled_to_fraction(&(A));
+
+@d number_zero(A) number_equal(A, zero_t)
+@d number_infinite(A) number_equal(A, inf_t)
+@d number_unity(A) number_equal(A, unity_t)
+@d number_negative(A) number_less(A, zero_t)
+@d number_nonnegative(A) (! number_negative(A))
+@d number_positive(A) number_greater(A, zero_t)
+@d number_nonpositive(A) (! number_positive(A))
+@d number_nonzero(A) (! number_zero(A))
+@d number_greaterequal(A,B) (! number_less(A,B))
+@d number_lessequal(A,B) (! number_greater(A,B))
+
+@* Edge structures.
+
+Now we come to \MP's internal scheme for representing pictures. The
+representation is very different from \MF's edge structures because \MP\ pictures
+contain \ps\ graphics objects instead of pixel images. However, the basic idea is
+somewhat similar in that shapes are represented via their boundaries.
+
+The main purpose of edge structures is to keep track of graphical objects until
+it is time to translate them into \ps. Since \MP\ does not need to know anything
+about an edge structure other than how to translate it into \ps\ and how to find
+its bounding box, edge structures can be just linked lists of graphical objects.
+\MP\ has no easy way to determine whether two such objects overlap, but it
+suffices to draw the first one first and let the second one overwrite it if
+necessary.
+
+@<MPlib header stuff@>=
+enum mp_graphical_object_code {
+ mp_unset_code,
+ mp_fill_code,
+ mp_stroked_code,
+ mp_start_clip_code, /* |type| of a node that starts clipping */
+ mp_start_group_code, /* |type| of a node that gives a |setgroup| path */
+ mp_start_bounds_code, /* |type| of a node that gives a |setbounds| path */
+ mp_stop_clip_code, /* |type| of a node that stops clipping */
+ mp_stop_group_code, /* |type| of a node that stops grouping */
+ mp_stop_bounds_code, /* |type| of a node that stops |setbounds| */
+ mp_final_graphic
+};
+
+@ Let's consider the types of graphical objects one at a time. First of all, a
+filled contour is represented by a eight-word node. The first word contains
+|type| and |link| fields, and the next six words contain a pointer to a cyclic
+path and the value to use for \ps' |currentrgbcolor| parameter. If a pen is
+used for filling |pen_p|, |linejoin| and |miterlimit| give the relevant information.
+
+We can actually be more sparse: |color_model|, |line_join| and |pen_type| can be
+chars: a todo.
+
+We don't save that much by distinguishing between a stroke and a fill object and
+we can save some code when we make then the same. Todo: use char for some.
+
+@<MPlib internal header stuff@>=
+typedef struct mp_shape_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int stacking;
+ struct mp_node_data *link;
+ /*common */
+ mp_string pre_script;
+ mp_string post_script;
+ union {
+ mp_number red;
+ mp_number cyan;
+ };
+ union {
+ mp_number green;
+ mp_number magenta;
+ };
+ union {
+ mp_number blue;
+ mp_number yellow;
+ };
+ union {
+ mp_number black;
+ mp_number grey;
+ };
+ /*specific to paths */
+ mp_knot path;
+ mp_knot pen;
+ mp_node dash;
+ mp_number dashscale;
+ mp_number miterlimit;
+ unsigned char color_model;
+ unsigned char linejoin;
+ unsigned char linecap;
+ unsigned char pen_type;
+} mp_shape_node_data;
+
+typedef struct mp_shape_node_data *mp_shape_node;
+
+@d mp_path_ptr(A) (A)->path
+@d mp_pen_ptr(A) (A)->pen
+@d mp_dash_ptr(A) ((mp_shape_node) (A))->dash
+@d mp_line_cap(A) ((mp_shape_node) (A))->linecap
+@d mp_line_join(A) ((mp_shape_node) (A))->linejoin
+@d mp_miterlimit(A) ((mp_shape_node) (A))->miterlimit
+
+@d mp_set_linecap(A,B) ((mp_shape_node) (A))->linecap = (short) (B)
+@d mp_set_linejoin(A,B) ((mp_shape_node) (A))->linejoin = (short) (B)
+
+@d mp_pre_script(A) ((mp_shape_node) (A))->pre_script
+@d mp_post_script(A) ((mp_shape_node) (A))->post_script
+@d mp_color_model(A) ((mp_shape_node) (A))->color_model
+@d mp_stacking(A) ((mp_shape_node) (A))->stacking
+@d mp_pen_type(A) ((mp_shape_node) (A))->pen_type
+
+@d mp_cyan_color(A) ((mp_shape_node) (A))->cyan
+@d mp_magenta_color(A) ((mp_shape_node) (A))->magenta
+@d mp_yellow_color(A) ((mp_shape_node) (A))->yellow
+@d mp_black_color(A) ((mp_shape_node) (A))->black
+@d mp_red_color(A) ((mp_shape_node) (A))->red
+@d mp_green_color(A) ((mp_shape_node) (A))->green
+@d mp_blue_color(A) ((mp_shape_node) (A))->blue
+@d mp_gray_color(A) ((mp_shape_node) (A))->grey
+@d mp_grey_color(A) ((mp_shape_node) (A))->grey
+
+@ Make a shape node. A fill node is a cyclic path |p|. A stroked path is a node
+that is like a filled contour node except that it contains the current |linecap|
+value, a scale factor for the dash pattern, and a pointer that is non-NULL if the
+stroke is to be dashed. The purpose of the scale factor is to allow a picture to
+be transformed without touching the picture that |dash_p| points to.
+
+@c
+static mp_node mp_new_shape_node (MP mp, mp_knot p, int type)
+{
+ mp_shape_node t = mp_allocate_node(mp, sizeof(mp_shape_node_data));
+ mp_type(t) = type;
+ mp_path_ptr(t) = p;
+ mp_pen_ptr(t) = NULL; /* |NULL| means don't use a pen */
+ mp_dash_ptr(t) = NULL;
+ new_number(t->red);
+ new_number(t->green);
+ new_number(t->blue);
+ new_number(t->black);
+ new_number(t->miterlimit);
+ new_number(t->dashscale);
+ set_number_to_unity(t->dashscale);
+ mp_color_model(t) = mp_uninitialized_model;
+ mp_pen_type(t) = 0;
+ mp_pre_script(t) = NULL;
+ mp_post_script(t) = NULL;
+ /* Set the |linejoin| and |miterlimit| fields in object |t| */
+ if (number_greater(internal_value(mp_linejoin_internal), unity_t)) {
+ t->linejoin = mp_beveled_linejoin_code;
+ } else if (number_positive(internal_value(mp_linejoin_internal))) {
+ t->linejoin = mp_rounded_linejoin_code;
+ } else {
+ t->linejoin = mp_mitered_linejoin_code;
+ }
+ t->stacking = round_unscaled(internal_value(mp_stacking_internal));
+ if (number_less(internal_value(mp_miterlimit_internal), unity_t)) {
+ set_number_to_unity(t->miterlimit);
+ } else {
+ number_clone(t->miterlimit, internal_value(mp_miterlimit_internal));
+ }
+ if (number_greater(internal_value(mp_linecap_internal), unity_t)) {
+ t->linecap = mp_squared_linecap_code;
+ } else if (number_positive(internal_value(mp_linecap_internal))) {
+ t->linecap = mp_rounded_linecap_code;
+ } else {
+ t->linecap = mp_butt_linecap_code;
+ }
+ return (mp_node) t;
+}
+
+@ @c
+static mp_edge_header_node mp_free_shape_node (MP mp, mp_shape_node p)
+{
+ mp_edge_header_node e = NULL;
+ mp_toss_knot_list(mp, mp_path_ptr(p));
+ if (mp_pen_ptr(p) != NULL) {
+ mp_toss_knot_list(mp, mp_pen_ptr(p));
+ }
+ if (mp_pre_script(p) != NULL) {
+ delete_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ delete_str_ref(mp_post_script(p));
+ }
+ e = (mp_edge_header_node) mp_dash_ptr(p);
+ free_number(p->red);
+ free_number(p->green);
+ free_number(p->blue);
+ free_number(p->black);
+ free_number(p->miterlimit);
+ free_number(p->dashscale);
+ mp_free_node(mp, (mp_node) p, sizeof(mp_shape_node_data));
+ return e ;
+}
+
+@ When a dashed line is computed in a transformed coordinate system, the dash
+lengths get scaled like the pen shape and we need to compensate for this. Since
+there is no unique scale factor for an arbitrary transformation, we use the the
+square root of the determinant. The properties of the determinant make it easier
+to maintain the |dashscale|. The computation is fairly straight-forward except
+for the initialization of the scale factor |s|. The factor of 64 is needed
+because |square_rt| scales its result by $2^8$ while we need $2^{14}$ to
+counteract the effect of |take_fraction|.
+
+@c
+void mp_sqrt_det (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ mp_number a, b, c, d;
+ mp_number maxabs; /* $max(|a|,|b|,|c|,|d|)$ */
+ unsigned s = 64; /* amount by which the result of |square_rt| needs to be scaled */
+ mp_number tmp;
+ new_number_clone(a, *a_orig);
+ new_number_clone(b, *b_orig);
+ new_number_clone(c, *c_orig);
+ new_number_clone(d, *d_orig);
+ /* Initialize |maxabs| */
+ new_number_abs(maxabs, a);
+ new_number_abs(tmp, b);
+ if (number_greater(tmp, maxabs)) {
+ number_clone(maxabs, tmp);
+ }
+ number_abs_clone(tmp, c);
+ if (number_greater(tmp, maxabs)) {
+ number_clone(maxabs, tmp);
+ }
+ number_abs_clone(tmp, d);
+ if (number_greater(tmp, maxabs)) {
+ number_clone(maxabs, tmp);
+ }
+ free_number(tmp);
+ while ((number_less(maxabs, fraction_one_t)) && (s > 1)) {
+ number_double(a);
+ number_double(b);
+ number_double(c);
+ number_double(d);
+ number_double(maxabs);
+ s = s/2;
+ }
+ {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, a, d);
+ take_fraction(r2, b, c);
+ number_subtract(r1, r2);
+ number_abs(r1);
+ square_rt(*ret, r1);
+ number_multiply_int(*ret, s);
+ free_number(r1);
+ free_number(r2);
+ }
+ free_number(a);
+ free_number(b);
+ free_number(c);
+ free_number(d);
+ free_number(maxabs);
+}
+
+static void mp_get_pen_scale (MP mp, mp_number *ret, mp_knot p)
+{
+ if (p == NULL) {
+ set_number_to_zero(*ret);
+ } else {
+ mp_number a, b, c, d;
+ new_number(a);
+ new_number(b);
+ new_number(c);
+ new_number(d);
+ set_number_from_subtraction(a, p->left_x, p->x_coord);
+ set_number_from_subtraction(b, p->right_x, p->x_coord);
+ set_number_from_subtraction(c, p->left_y, p->y_coord);
+ set_number_from_subtraction(d, p->right_y, p->y_coord);
+ mp_sqrt_det(mp, ret, &a, &b, &c, &d);
+ free_number(a);
+ free_number(b);
+ free_number(c);
+ free_number(d);
+ }
+}
+
+@ @<Declarations@>=
+static void mp_sqrt_det (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig);
+
+@ The last two types of graphical objects that can occur in an edge structure are
+clipping paths and |setbounds| paths. These are slightly more difficult
+@:set_bounds_}{|setbounds| primitive@> to implement because we must keep track
+of exactly what is being clipped or bounded when pictures get merged together.
+For this reason, each clipping or |setbounds| operation is represented by a
+pair of nodes: first comes a node whose |path_ptr| gives the relevant path, then
+there is the list of objects to clip or bound followed by a closing node.
+
+@d mp_has_color(A) (mp_type((A))<mp_start_clip_node_type) /* does a graphical object have color fields? */
+@d mp_has_script(A) (mp_type((A))<=mp_start_bounds_node_type) /* does a graphical object have color fields? */
+@d mp_has_pen(A) (mp_type((A))<=mp_stroked_node_type) /* does a graphical object have a |mp_pen_ptr| field? */
+
+@d mp_is_start_or_stop(A) (mp_type((A))>=mp_start_clip_node_type)
+@d mp_is_stop(A) (mp_type((A))>=mp_stop_clip_node_type)
+
+@<MPlib internal header stuff@>=
+typedef struct mp_start_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int stacking;
+ struct mp_node_data *link;
+ /*specific */
+ mp_string pre_script;
+ mp_string post_script;
+ mp_knot path;
+} mp_start_node_data;
+
+typedef struct mp_start_node_data *mp_start_node;
+
+typedef struct mp_stop_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int stacking;
+ struct mp_node_data *link;
+ /*specific */
+} mp_stop_node_data;
+
+typedef struct mp_stop_node_data *mp_stop_node;
+
+@ Make a node of type |c| where |p| is the clipping or |setbounds| path.
+
+@c
+static mp_node mp_new_bounds_node (MP mp, mp_knot p, int c)
+{
+ switch (c) {
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ {
+ mp_start_node t = (mp_start_node) mp_allocate_node(mp, sizeof(mp_start_node_data));
+ mp_type(t) = c;
+ t->path = p;
+ t->link = NULL;
+ t->stacking = round_unscaled(internal_value(mp_stacking_internal));
+ mp_pre_script(t) = NULL;
+ mp_post_script(t) = NULL;
+ return (mp_node) t;
+ }
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ {
+ mp_stop_node t = (mp_stop_node) mp_allocate_node(mp, sizeof(mp_stop_node_data));
+ mp_type(t) = c;
+ t->link = NULL;
+ t->stacking = round_unscaled(internal_value(mp_stacking_internal));
+ return (mp_node) t;
+ }
+ break;
+ default:
+ /* maybe some message */
+ break;
+ }
+ return NULL;
+}
+
+@ @c
+static void mp_free_start_node (MP mp, mp_start_node p)
+{
+ mp_toss_knot_list(mp, mp_path_ptr(p));
+ if (mp_pre_script(p) != NULL) {
+ delete_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ delete_str_ref(mp_post_script(p));
+ }
+ mp_free_node(mp, (mp_node) p, sizeof(mp_start_node_data));
+}
+
+static void mp_free_stop_node (MP mp, mp_stop_node p)
+{
+ mp_free_node(mp, (mp_node) p, sizeof(mp_stop_node_data));
+}
+
+@ All the essential information in an edge structure is encoded as a linked list
+of graphical objects as we have just seen, but it is helpful to add some
+redundant information. A single edge structure might be used as a dash pattern
+many times, and it would be nice to avoid scanning the same structure repeatedly.
+Thus, an edge structure known to be a suitable dash pattern has a header that
+gives a list of dashes in a sorted order designed for rapid translation into \ps.
+
+Each dash is represented by a three-word node containing the initial and final
+$x$~coordinates as well as the usual |link| field. The |link| fields points to
+the dash node with the next higher $x$-coordinates and the final link points to a
+special location called |null_dash|. (There should be no overlap between dashes).
+Since the $y$~coordinate of the dash pattern is needed to determine the period of
+repetition, this needs to be stored in the edge header along with a pointer to
+the list of dash nodes.
+
+The |dash_info| is explained below.
+
+@d mp_get_dash_list(A) (mp_dash_node) (((mp_dash_node) (A))->link) /* in an edge header this points to the first dash node */
+@d mp_set_dash_list(A,B) ((mp_dash_node) (A))->link = (mp_node) ((B)) /* in an edge header this points to the first dash node */
+
+@<MPlib internal header stuff@>=
+typedef struct mp_dash_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ mp_number start_x; /* the starting $x$~coordinate in a dash node */
+ mp_number stop_x; /* the ending $x$~coordinate in a dash node */
+ mp_number dash_y; /* $y$ value for the dash list in an edge header */
+ mp_node dash_info;
+} mp_dash_node_data;
+
+@ @<Types...@>=
+typedef struct mp_dash_node_data *mp_dash_node;
+
+@ @<Initialize table entries@>=
+mp->null_dash = mp_get_dash_node(mp);
+
+@ @<Free table entries@>=
+mp_free_node(mp, (mp_node) mp->null_dash, sizeof(mp_dash_node_data));
+
+@c
+static mp_dash_node mp_get_dash_node (MP mp)
+{
+ mp_dash_node p = (mp_dash_node) mp_allocate_node(mp, sizeof(mp_dash_node_data));
+ p->hasnumber = 0;
+ new_number(p->start_x);
+ new_number(p->stop_x);
+ new_number(p->dash_y);
+ mp_type(p) = mp_dash_node_type;
+ return p;
+}
+
+@ It is also convenient for an edge header to contain the bounding box
+information needed by the |llcorner| and |urcorner| operators so that this
+does not have to be recomputed unnecessarily. This is done by adding fields for
+the $x$~and $y$ extremes as well as a pointer that indicates how far the bounding
+box computation has gotten. Thus if the user asks for the bounding box and then
+adds some more text to the picture before asking for more bounding box
+information, the second computation need only look at the additional text.
+
+When the bounding box has not been computed, the |bblast| pointer points to a
+dummy link at the head of the graphical object list while the |minx_val| and
+|miny_val| fields contain |EL_GORDO| and the |maxx_val| and |maxy_val| fields
+contain |-EL_GORDO|.
+
+Since the bounding box of pictures containing objects of type
+|mp_start_bounds_node| depends on the value of |truecorners|, the bounding box
+@:mp_true_corners_}{|truecorners| primitive@> data might not be valid for all
+values of this parameter. Hence, the |bbtype| field is needed to keep track of
+this.
+
+@d mp_bblast(A) ((mp_edge_header_node) (A))->bblast /* last item considered in bounding box computation */
+@d mp_edge_list(A) ((mp_edge_header_node) (A))->list /* where the object list begins in an edge header */
+
+@<MPlib internal header stuff@>=
+typedef struct mp_edge_header_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int padding;
+ struct mp_node_data *link;
+ /*specific */
+ mp_number start_x;
+ mp_number stop_x;
+ mp_number dash_y;
+ mp_node dash_info;
+ mp_number minx;
+ mp_number miny;
+ mp_number maxx;
+ mp_number maxy;
+ mp_node bblast;
+ int bbtype; /* tells how bounding box data depends on |truecorners| */
+ int ref_count; /* explained below */
+ mp_node list;
+ mp_node obj_tail; /* explained below */
+} mp_edge_header_node_data;
+
+typedef struct mp_edge_header_node_data *mp_edge_header_node;
+
+typedef enum mp_bound_codes {
+ mp_no_bounds_code, /* |bbtype| value when bounding box data is valid for all |truecorners| values */
+ mp_bounds_set_code, /* |bbtype| value when bounding box data is for |truecorners|${}\le 0$ */
+ mp_bounds_unset_code, /* |bbtype| value when bounding box data is for |truecorners|${}>0$ */
+} mp_bound_codes;
+
+@ @c
+static void mp_init_bbox (MP mp, mp_edge_header_node h)
+{
+ /* Initialize the bounding box information in edge structure |h| */
+ (void) mp;
+ mp_bblast(h) = mp_edge_list(h);
+ h->bbtype = mp_no_bounds_code;
+ set_number_to_inf(h->minx);
+ set_number_to_inf(h->miny);
+ set_number_to_negative_inf(h->maxx);
+ set_number_to_negative_inf(h->maxy);
+}
+
+@ The only other entries in an edge header are a reference count in the first
+word and a pointer to the tail of the object list in the last word.
+
+@d mp_obj_tail(A) ((mp_edge_header_node) (A))->obj_tail /* points to the last entry in the object list */
+@d mp_edge_ref_count(A) ((mp_edge_header_node) (A))->ref_count
+
+@ @c
+static mp_edge_header_node mp_get_edge_header_node (MP mp)
+{
+ mp_edge_header_node p = (mp_edge_header_node) mp_allocate_node(mp, sizeof(mp_edge_header_node_data));
+ mp_type(p) = mp_edge_header_node_type;
+ new_number(p->start_x);
+ new_number(p->stop_x);
+ new_number(p->dash_y);
+ new_number(p->minx);
+ new_number(p->miny);
+ new_number(p->maxx);
+ new_number(p->maxy);
+ p->list = mp_new_token_node(mp); /* or whatever, just a need a link handle */
+ return p;
+}
+
+static void mp_init_edges (MP mp, mp_edge_header_node h)
+{
+ /* initialize an edge header to NULL values */
+ mp_set_dash_list(h, mp->null_dash);
+ mp_obj_tail(h) = mp_edge_list(h);
+ mp_link(mp_edge_list(h)) = NULL;
+ mp_edge_ref_count(h) = 0;
+ mp_init_bbox(mp, h);
+}
+
+@ Here is how edge structures are deleted. The process can be recursive because
+of the need to dereference edge structures that are used as dash patterns.
+@^recursion@>
+
+@d mp_add_edge_ref(mp,A) mp_edge_ref_count((A)) += 1
+
+@d mp_delete_edge_ref(mp,A) {
+ if (mp_edge_ref_count((A)) == 0) {
+ mp_toss_edges(mp, (mp_edge_header_node) (A));
+ } else {
+ mp_edge_ref_count((A)) -= 1;
+ }
+}
+
+@<Declarations@>=
+static void mp_flush_dash_list (MP mp, mp_edge_header_node h);
+static mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p);
+static void mp_toss_edges (MP mp, mp_edge_header_node h);
+
+@ @c
+void mp_toss_edges (MP mp, mp_edge_header_node h)
+{
+ mp_node q; /* pointers that scan the list being recycled */
+ mp_edge_header_node r; /* an edge structure that object |p| refers to */
+ mp_flush_dash_list(mp, h);
+ q = mp_link(mp_edge_list(h));
+ while (q != NULL) {
+ mp_node p = q;
+ q = mp_link(q);
+ r = mp_toss_gr_object(mp, p);
+ if (r != NULL) {
+ mp_delete_edge_ref(mp, r);
+ }
+ }
+ free_number(h->start_x);
+ free_number(h->stop_x);
+ free_number(h->dash_y);
+ free_number(h->minx);
+ free_number(h->miny);
+ free_number(h->maxx);
+ free_number(h->maxy);
+ mp_free_token_node(mp, h->list);
+ mp_free_node(mp, (mp_node) h, sizeof(mp_edge_header_node_data));
+}
+
+void mp_flush_dash_list (MP mp, mp_edge_header_node h)
+{
+ mp_dash_node q = mp_get_dash_list(h);
+ while (q != mp->null_dash) {
+ mp_dash_node p = q;
+ q = (mp_dash_node) mp_link(q);
+ mp_free_node(mp, (mp_node) p, sizeof(mp_dash_node_data));
+ }
+ mp_set_dash_list(h, mp->null_dash);
+}
+
+mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p)
+{
+ /* returns an edge structure that needs to be dereferenced */
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ return mp_free_shape_node(mp, (mp_shape_node) p);
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ mp_free_start_node(mp, (mp_start_node) p);
+ return NULL;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ mp_free_stop_node(mp, (mp_stop_node) p);
+ return NULL;
+ default:
+ return NULL;
+ }
+}
+
+@ If we use |add_edge_ref| to \quote {copy} edge structures, the real copying needs to
+be done before making a significant change to an edge structure. Much of the work
+is done in a separate routine |copy_objects| that copies a list of graphical
+objects into a new edge header.
+
+@c
+static mp_edge_header_node mp_private_edges (MP mp, mp_edge_header_node h)
+{
+ /* make a private copy of the edge structure headed by |h| */
+ if (mp_edge_ref_count(h) == 0) {
+ return h;
+ } else {
+ mp_edge_header_node hh; /* the edge header for the new copy */
+ mp_dash_node p, pp; /* pointers for copying the dash list */
+ mp_edge_ref_count(h) -= 1;
+ hh = (mp_edge_header_node) mp_copy_objects (mp, mp_link(mp_edge_list(h)), NULL);
+ @<Copy the dash list from |h| to |hh|@>
+ @<Copy the bounding box information from |h| to |hh| and make |mp_bblast(hh)| point into the new object list@>
+ return hh;
+ }
+}
+
+@ Here we use the fact that |mp_get_dash_list(hh)=mp_link(hh)|. @^data structure
+assumptions@>
+
+@<Copy the dash list from |h| to |hh|@>=
+pp = (mp_dash_node) hh;
+p = mp_get_dash_list(h);
+while ((p != mp->null_dash)) {
+ mp_link(pp) = (mp_node) mp_get_dash_node(mp);
+ pp = (mp_dash_node) mp_link(pp);
+ number_clone(pp->start_x, p->start_x);
+ number_clone(pp->stop_x, p->stop_x);
+ p = (mp_dash_node) mp_link(p);
+}
+mp_link(pp) = (mp_node) mp->null_dash;
+number_clone(hh->dash_y, h->dash_y);
+
+@ |h| is an edge structure
+
+@c
+static mp_dash_object *mp_export_dashes (MP mp, mp_shape_node q, mp_number *w)
+{
+ mp_dash_node h = (mp_dash_node) mp_dash_ptr(q);
+ if (h == NULL || mp_get_dash_list(h) == mp->null_dash) {
+ return NULL;
+ } else {
+ mp_dash_object *d;
+ mp_dash_node p;
+ mp_number scf; /* scale factor */
+ mp_number dashoff;
+ double *dashes = NULL;
+ int num_dashes = 1;
+ new_number(scf);
+ p = mp_get_dash_list(h);
+ mp_get_pen_scale(mp, &scf, mp_pen_ptr(q));
+ if (number_zero(scf)) {
+ if (number_zero(*w)) {
+ number_clone(scf, q->dashscale);
+ } else {
+ free_number(scf);
+ return NULL;
+ }
+ } else {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, *w, scf);
+ take_scaled(scf, ret, q->dashscale);
+ free_number(ret);
+ }
+ number_clone(*w, scf);
+ d = mp_allocate_dash(mp);
+ set_number_from_addition(mp->null_dash->start_x, p->start_x, h->dash_y);
+ {
+ mp_number ret, arg1;
+ new_number(ret);
+ new_number(arg1);
+ new_number(dashoff);
+ while (p != mp->null_dash) {
+ dashes = mp_memory_reallocate(dashes, (size_t) (num_dashes + 2) * sizeof(double));
+ set_number_from_subtraction(arg1, p->stop_x, p->start_x);
+ take_scaled(ret, arg1, scf);
+ dashes[(num_dashes - 1)] = number_to_double(ret);
+ set_number_from_subtraction(arg1, ((mp_dash_node) mp_link(p))->start_x, p->stop_x);
+ take_scaled(ret, arg1, scf);
+ dashes[(num_dashes)] = number_to_double(ret);
+ dashes[(num_dashes + 1)] = -1.0; /* terminus */
+ num_dashes += 2;
+ p = (mp_dash_node) mp_link(p);
+ }
+ d->array = dashes;
+ mp_dash_offset(mp, &dashoff, h);
+ take_scaled(ret, dashoff, scf);
+ d->offset = number_to_double(ret);
+ free_number(ret);
+ free_number(arg1);
+ }
+ free_number(dashoff);
+ free_number(scf);
+ return d;
+ }
+}
+
+@ @<Copy the bounding box information from |h| to |hh|...@>=
+number_clone(hh->minx, h->minx);
+number_clone(hh->miny, h->miny);
+number_clone(hh->maxx, h->maxx);
+number_clone(hh->maxy, h->maxy);
+hh->bbtype = h->bbtype;
+p = (mp_dash_node) mp_edge_list(h);
+pp = (mp_dash_node) mp_edge_list(hh);
+while ((p != (mp_dash_node) mp_bblast(h))) {
+ if (p == NULL) {
+ mp_confusion(mp, "boundingbox last");
+ @:this can't happen bblast}{\quad bblast@>
+ } else {
+ p = (mp_dash_node) mp_link(p);
+ pp = (mp_dash_node) mp_link(pp);
+ }
+}
+mp_bblast(hh) = (mp_node) pp;
+
+@ Here is the promised routine for copying graphical objects into a new edge
+structure. It starts copying at object~|p| and stops just before object~|q|. If
+|q| is NULL, it copies the entire sublist headed at |p|. The resulting edge
+structure requires further initialization by |init_bbox|.
+
+@<Declarations@>=
+static mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q);
+
+@ @c
+mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q) {
+ mp_node pp; /* the last newly copied object */
+ int k = 0; /* temporary register */
+ mp_edge_header_node hh = mp_get_edge_header_node(mp); /* the new edge header */
+ mp_set_dash_list(hh, mp->null_dash);
+ mp_edge_ref_count(hh) = 0;
+ pp = mp_edge_list(hh);
+ while (p != q) {
+ @<Make |mp_link(pp)| point to a copy of object |p|, and update |p| and |pp|@>
+ }
+ mp_obj_tail(hh) = pp;
+ mp_link(pp) = NULL;
+ return hh;
+}
+
+@ @<Make |mp_link(pp)| point to a copy of object |p|, and update |p| and |pp|@>=
+{
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ k = sizeof(mp_shape_node_data);
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ k = sizeof(mp_start_node_data);
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ k = sizeof(mp_stop_node_data);
+ break;
+ default:
+ break;
+ }
+ mp_link(pp) = mp_allocate_node(mp, (size_t) k); /* |gr_object| */
+ pp = mp_link(pp);
+ memcpy(pp, p, (size_t) k);
+ pp->link = NULL;
+ @<Fix anything in graphical object |pp| that should differ from the corresponding field in |p|@>
+ p = mp_link(p);
+}
+
+@ @<Fix anything in graphical object |pp| that should differ from the...@>=
+switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ {
+ mp_shape_node tt = (mp_shape_node) pp;
+ mp_shape_node t = (mp_shape_node) p;
+ new_number_clone(tt->red, t->red);
+ new_number_clone(tt->green, t->green);
+ new_number_clone(tt->blue, t->blue);
+ new_number_clone(tt->black, t->black);
+ new_number_clone(tt->miterlimit, t->miterlimit);
+ new_number_clone(tt->dashscale, t->dashscale);
+ mp_path_ptr(tt) = mp_copy_path(mp, mp_path_ptr(t));
+ if (mp_pre_script(p) != NULL) {
+ add_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ add_str_ref(mp_post_script(p));
+ }
+ if (mp_pen_ptr(t) != NULL) {
+ mp_pen_ptr(tt) = mp_copy_pen(mp, mp_pen_ptr(t));
+ }
+ if (mp_dash_ptr(p) != NULL) {
+ mp_add_edge_ref(mp, mp_dash_ptr(pp));
+ }
+ }
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ {
+ mp_start_node tt = (mp_start_node) pp;
+ mp_start_node t = (mp_start_node) p;
+ mp_path_ptr(tt) = mp_copy_path(mp, mp_path_ptr(t));
+ if (mp_pre_script(p) != NULL) {
+ add_str_ref(mp_pre_script(p));
+ }
+ if (mp_post_script(p) != NULL) {
+ add_str_ref(mp_post_script(p));
+ }
+ }
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ break;
+ default:
+ break;
+}
+
+@ Here is one way to find an acceptable value for the second argument to
+|copy_objects|. Given a non-NULL graphical object list, |skip_1component| skips
+past one picture component, where a \quote {picture component} is a single graphical
+object, or a start bounds or start clip object and everything up through the
+matching stop bounds or stop clip object.
+
+@c
+static mp_node mp_skip_1component (MP mp, mp_node p)
+{
+ int lev = 0; /* current nesting level */
+ (void) mp;
+ do {
+ if (mp_is_start_or_stop (p)) {
+ if (mp_is_stop(p)) {
+ --lev;
+ } else {
+ ++lev;
+ }
+ }
+ p = mp_link(p);
+ } while (lev != 0);
+ return p;
+}
+
+@ Here is a diagnostic routine for printing an edge structure in symbolic form.
+
+@<Declarations@>=
+static void mp_print_edges (MP mp, mp_node h, const char *s, int nuline);
+
+@ @c
+void mp_print_edges (MP mp, mp_node h, const char *s, int nuline)
+{
+ mp_node p = mp_edge_list(h); /* a graphical object to be printed */
+ mp_number scf; /* a scale factor for the dash pattern */
+ new_number(scf);
+ mp_print_diagnostic(mp, "Edge structure", s, nuline);
+ while (mp_link(p) != NULL) {
+ p = mp_link(p);
+ mp_print_ln(mp);
+ switch (mp_type(p)) {
+ @<Cases for printing graphical object node |p|@>
+ default:
+ mp_print_str(mp, "[unknown object type!]");
+ break;
+ }
+ }
+ mp_print_nl(mp, "End edges");
+ if (p != mp_obj_tail(h)) {
+ mp_print_str(mp, "?");
+ @.End edges?@>
+ }
+ mp_end_diagnostic(mp, 1);
+ free_number(scf);
+}
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_fill_node_type:
+ mp_print_str(mp, "Filled contour ");
+ mp_print_obj_color (mp, p);
+ mp_print_chr(mp, ':');
+ mp_print_ln(mp);
+ mp_pr_path(mp, mp_path_ptr((mp_shape_node) p));
+ mp_print_ln(mp);
+ if ((mp_pen_ptr((mp_shape_node) p) != NULL)) {
+ @<Print join type for graphical object |p|@>
+ mp_print_str(mp, " with pen");
+ mp_print_ln(mp);
+ mp_pr_pen(mp, mp_pen_ptr((mp_shape_node) p));
+ }
+ break;
+
+@ @<Print join type for graphical object |p|@>=
+switch (((mp_shape_node) p)->linejoin) {
+ case mp_mitered_linejoin_code:
+ mp_print_str(mp, "mitered joins limited ");
+ print_number(((mp_shape_node) p)->miterlimit);
+ break;
+ case mp_rounded_linejoin_code:
+ mp_print_str(mp, "round joins");
+ break;
+ case mp_beveled_linejoin_code:
+ mp_print_str(mp, "beveled joins");
+ break;
+ default:
+ mp_print_str(mp, "?? joins");
+ break;
+ @.??@>
+}
+
+@ For stroked nodes, we need to print |linecap_val(p)| as well.
+
+@<Print join and cap types for stroked node |p|@>=
+switch (((mp_shape_node) p)->linecap) {
+ case mp_butt_linecap_code:
+ mp_print_str(mp, "butt");
+ break;
+ case mp_rounded_linecap_code:
+ mp_print_str(mp, "round");
+ break;
+ case mp_squared_linecap_code:
+ mp_print_str(mp, "square");
+ break;
+ default:
+ mp_print_str(mp, "??");
+ break;
+ @.??@>
+}
+mp_print_str(mp, " ends, ");
+@<Print join type for graphical object |p|@>
+
+@ Here is a routine that prints the color of a graphical object if it isn't black
+(the default color).
+
+@<Declarations@>=
+static void mp_print_obj_color (MP mp, mp_node p);
+
+@ @c
+void mp_print_obj_color (MP mp, mp_node p)
+{
+ mp_shape_node p0 = (mp_shape_node) p;
+ switch (mp_color_model(p)) {
+ case mp_grey_model:
+ if (number_positive(p0->grey)) {
+ mp_print_str(mp, "greyed ");
+ mp_print_chr(mp, '(');
+ print_number(p0->grey);
+ mp_print_chr(mp, ')');
+ };
+ break;
+ case mp_cmyk_model:
+ if (number_positive(p0->cyan) || number_positive(p0->magenta)
+ || number_positive(p0->yellow) || number_positive(p0->black)) {
+ mp_print_str(mp, "processcolored ");
+ mp_print_chr(mp, '(');
+ print_number(p0->cyan);
+ mp_print_chr(mp, ',');
+ print_number(p0->magenta);
+ mp_print_chr(mp, ',');
+ print_number(p0->yellow);
+ mp_print_chr(mp, ',');
+ print_number(p0->black);
+ mp_print_chr(mp, ')');
+ };
+ break;
+ case mp_rgb_model:
+ if (number_positive(p0->red) || number_positive(p0->green) || number_positive(p0->blue)) {
+ mp_print_str(mp, "colored ");
+ mp_print_chr(mp, '(');
+ print_number(p0->red);
+ mp_print_chr(mp, ',');
+ print_number(p0->green);
+ mp_print_chr(mp, ',');
+ print_number(p0->blue);
+ mp_print_chr(mp, ')');
+ }
+ break;
+ default:
+ break;
+ }
+}
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_stroked_node_type:
+ mp_print_str(mp, "Filled pen stroke ");
+ mp_print_obj_color (mp, p);
+ mp_print_chr(mp, ':');
+ mp_print_ln(mp);
+ mp_pr_path(mp, mp_path_ptr((mp_shape_node) p));
+ if (mp_dash_ptr(p) != NULL) {
+ @<Finish printing the dash pattern that |p| refers to@>
+ }
+ mp_print_ln(mp);
+ @<Print join and cap types for stroked node |p|@>
+ mp_print_str(mp, " with pen");
+ mp_print_ln(mp);
+ if (mp_pen_ptr((mp_shape_node) p) == NULL) {
+ mp_print_str(mp, "???"); /* shouldn't happen */
+ @.???@>
+ } else {
+ mp_pr_pen(mp, mp_pen_ptr((mp_shape_node) p));
+ }
+ break;
+
+@ Normally, the |dash_list| field in an edge header is set to |null_dash| when it
+is not known to define a suitable dash pattern. This is disallowed here because
+the |mp_dash_ptr| field should never point to such an edge header. Note that memory
+is allocated for |start_x(null_dash)| and we are free to give it any convenient
+value.
+
+@<Finish printing the dash pattern that |p| refers to@>=
+mp_dash_node ppd, hhd;
+int ok_to_dash = mp_pen_is_elliptical(mp_pen_ptr((mp_shape_node) p));
+mp_print_nl(mp, "dashed (");
+if (! ok_to_dash) {
+ set_number_to_unity(scf);
+} else {
+ number_clone(scf, ((mp_shape_node) p)->dashscale);
+}
+hhd = (mp_dash_node) mp_dash_ptr(p);
+ppd = mp_get_dash_list(hhd);
+if ((ppd == mp->null_dash) || number_negative(hhd->dash_y)) {
+ mp_print_str(mp, " ??");
+} else {
+ mp_number dashoff;
+ mp_number ret, arg1;
+ new_number(ret);
+ new_number(arg1);
+ new_number(dashoff);
+ set_number_from_addition(mp->null_dash->start_x, ppd->start_x, hhd->dash_y );
+ while (ppd != mp->null_dash) {
+ mp_print_str(mp, "on ");
+ set_number_from_subtraction(arg1, ppd->stop_x, ppd->start_x);
+ take_scaled(ret, arg1, scf);
+ print_number( ret);
+ mp_print_str(mp, " off ");
+ set_number_from_subtraction(arg1, ((mp_dash_node) mp_link(ppd))->start_x, ppd->stop_x);
+ take_scaled(ret, arg1, scf);
+ print_number(ret);
+ ppd = (mp_dash_node) mp_link(ppd);
+ if (ppd != mp->null_dash) {
+ mp_print_chr(mp, ' ');
+ }
+ }
+ mp_print_str(mp, ") shifted ");
+ mp_dash_offset(mp, &dashoff, hhd);
+ take_scaled(ret, dashoff, scf);
+ number_negate(ret);
+ print_number(ret);
+ free_number(dashoff);
+ free_number(ret);
+ free_number(arg1);
+ if (!ok_to_dash || number_zero(hhd->dash_y)) {
+ mp_print_str(mp, " (this will be ignored)");
+ }
+}
+
+@ @<Declarations@>=
+static void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h);
+
+@ @c
+void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h)
+{
+ if (mp_get_dash_list(h) == mp->null_dash || number_negative(h->dash_y)) {
+ mp_confusion(mp, "dash offset");
+ @:this can't happen dash0}{\quad dash0@>
+ } else if (number_zero(h->dash_y)) {
+ set_number_to_zero(*x);
+ } else {
+ number_clone(*x, (mp_get_dash_list(h))->start_x);
+ number_modulo(*x, h->dash_y);
+ number_negate(*x);
+ if (number_negative(*x)) {
+ number_add(*x, h->dash_y);
+ }
+ }
+}
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_start_clip_node_type:
+ mp_print_str(mp, "clipping path:");
+ goto COMMONSTART;
+case mp_start_group_node_type:
+ mp_print_str(mp, "setgroup path:");
+ goto COMMONSTART;
+case mp_start_bounds_node_type:
+ mp_print_str(mp, "setbounds path:");
+ COMMONSTART:
+ mp_print_ln(mp);
+ mp_pr_path(mp, mp_path_ptr((mp_start_node) p));
+ break;
+case mp_stop_clip_node_type:
+ mp_print_str(mp, "stop clipping");
+ break;
+case mp_stop_group_node_type:
+ mp_print_str(mp, "stop group");
+ break;
+case mp_stop_bounds_node_type:
+ mp_print_str(mp, "end of setbounds");
+ break;
+
+@ To initialize the |dash_list| field in an edge header~|h|, we need a subroutine
+that scans an edge structure and tries to interpret it as a dash pattern. This
+can only be done when there are no filled regions or clipping paths and all the
+pen strokes have the same color. The first step is to let $y_0$ be the initial
+$y$~coordinate of the first pen stroke. Then we implicitly project all the pen
+stroke paths onto the line $y=y_0$ and require that there be no retracing. If the
+resulting paths cover a range of $x$~coordinates of length $\Delta x$, we set
+|dash_y(h)| to the length of the dash pattern by finding the maximum of $\Delta
+x$ and the absolute value of~$y_0$.
+
+@c
+static mp_edge_header_node mp_make_dashes (MP mp, mp_edge_header_node h)
+{
+ if (mp_get_dash_list(h) != mp->null_dash) {
+ return h;
+ } else {
+ /* returns |h| or |NULL| */
+ mp_node p; /* this scans the stroked nodes in the object list */
+ mp_node p0; /* if not |NULL| this points to the first stroked node */
+ mp_knot pp, qq, rr; /* pointers into |mp_path_ptr(p)| */
+ mp_dash_node d, dd; /* pointers used to create the dash list */
+ mp_number y0;
+ @<Other local variables in |make_dashes|@>
+ new_number(y0); /* the initial $y$ coordinate */
+ p0 = NULL;
+ p = mp_link(mp_edge_list(h));
+ while (p != NULL) {
+ if (mp_type(p) != mp_stroked_node_type) {
+ @<Complain that the edge structure contains a node of the wrong type and |goto not_found|@>
+ }
+ pp = mp_path_ptr((mp_shape_node) p);
+ if (p0 == NULL) {
+ p0 = p;
+ number_clone(y0, pp->y_coord);
+ }
+ @<Make |d| point to a new dash node created from stroke |p| and path |pp| or |goto not_found| if there is an error@>
+ @<Insert |d| into the dash list and |goto not_found| if there is an error@>
+ p = mp_link(p);
+ }
+ if (mp_get_dash_list(h) == mp->null_dash) {
+ goto NOT_FOUND; /* No error message */
+ } else {
+ @<Scan |mp_get_dash_list(h)| and deal with any dashes that are themselves dashed@>
+ @<Set |dash_y(h)| and merge the first and last dashes if necessary@>
+ free_number(y0);
+ return h;
+ }
+ NOT_FOUND:
+ free_number(y0);
+ @<Flush the dash list, recycle |h| and return |NULL|@>
+ }
+}
+
+@ @<Complain that the edge structure contains a node of the wrong type...@>=
+mp_back_error(
+ mp,
+ "Picture is too complicated to use as a dash pattern",
+ "When you say 'dashed p', picture p should not contain any text, filled regions,\n"
+ "or clipping paths. This time it did so I'll just make it a solid line instead."
+);
+mp_get_x_next(mp);
+goto NOT_FOUND;
+
+@ A similar error occurs when monotonicity fails.
+
+@<Declarations@>=
+static void mp_x_retrace_error (MP mp);
+
+@ @c
+void mp_x_retrace_error (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Picture is too complicated to use as a dash pattern",
+ "When you say 'dashed p', every path in p should be monotone in x and there must\n"
+ "be no overlapping. This failed so I'll just make it a solid line instead."
+ );
+ mp_get_x_next(mp);
+}
+
+@ We stash |p| in |dash_info(d)| if |mp_dash_ptr(p)<>0| so that subsequent
+processing can handle the case where the pen stroke |p| is itself dashed.
+
+@d mp_dash_info(A) ((mp_dash_node) (A))->dash_info /* in an edge header this points to the first dash node */
+
+@<Make |d| point to a new dash node created from stroke |p| and path...@>=
+@<Make sure |p| and |p0| are the same color and |goto not_found| if there is an error@>
+rr = pp;
+if (mp_next_knot(pp) != pp) {
+ do {
+ qq = rr;
+ rr = mp_next_knot(rr);
+ @<Check for retracing between knots |qq| and |rr| and |goto not_found| if there is a problem@>
+ } while (mp_right_type(rr) != mp_endpoint_knot);
+}
+d = (mp_dash_node) mp_get_dash_node(mp);
+if (mp_dash_ptr(p) == NULL) {
+ mp_dash_info(d) = NULL;
+} else {
+ mp_dash_info(d) = p;
+}
+if (number_less(pp->x_coord, rr->x_coord)) {
+ number_clone(d->start_x, pp->x_coord);
+ number_clone(d->stop_x, rr->x_coord);
+} else {
+ number_clone(d->start_x, rr->x_coord);
+ number_clone(d->stop_x, pp->x_coord);
+}
+
+@ We also need to check for the case where the segment from |qq| to |rr| is
+monotone in $x$ but is reversed relative to the path from |pp| to |qq|.
+
+@<Check for retracing between knots |qq| and |rr| and |goto not_found|...@>=
+{
+ mp_number x0, x1, x2, x3; /* $x$ coordinates of the segment from |qq| to |rr| */
+ new_number_clone(x0, qq->x_coord);
+ new_number_clone(x1, qq->right_x);
+ new_number_clone(x2, rr->left_x);
+ new_number_clone(x3, rr->x_coord);
+ if (number_greater(x0, x1) || number_greater(x1, x2) || number_greater(x2, x3)) {
+ if (number_less(x0, x1) || number_less(x1, x2) || number_less(x2, x3)) {
+ mp_number a1, a2, a3, a4;
+ int test;
+ new_number(a1);
+ new_number(a2);
+ new_number(a3);
+ new_number(a4);
+ set_number_from_subtraction(a1, x2, x1);
+ set_number_from_subtraction(a2, x2, x1);
+ set_number_from_subtraction(a3, x1, x0);
+ set_number_from_subtraction(a4, x3, x2);
+ test = ab_vs_cd(a1, a2, a3, a4);
+ free_number(a1);
+ free_number(a2);
+ free_number(a3);
+ free_number(a4);
+ if (test > 0) {
+ mp_x_retrace_error(mp);
+ free_number(x0);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ goto NOT_FOUND;
+ }
+ }
+ }
+ if (number_greater(pp->x_coord, x0) || number_greater(x0, x3)) {
+ if (number_less(pp->x_coord, x0) || number_less(x0, x3)) {
+ mp_x_retrace_error(mp);
+ free_number(x0);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ goto NOT_FOUND;
+ }
+ }
+ free_number(x0);
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+}
+
+@ @<Make sure |p| and |p0| are the same color and |goto not_found|...@>=
+if (! number_equal(((mp_shape_node) p)->red, ((mp_shape_node) p0)->red)
+ || ! number_equal(((mp_shape_node) p)->black, ((mp_shape_node) p0)->black)
+ || ! number_equal(((mp_shape_node) p)->green, ((mp_shape_node) p0)->green)
+ || ! number_equal(((mp_shape_node) p)->blue, ((mp_shape_node) p0)->blue)
+ ) {
+ mp_back_error(
+ mp,
+ "Picture is too complicated to use as a dash pattern",
+ "When you say 'dashed p', everything in picture p should be the same color. I\n"
+ "can't handle your color changes so I'll just make it a solid line instead."
+ );
+ mp_get_x_next(mp);
+ goto NOT_FOUND;
+}
+
+@ @<Insert |d| into the dash list and |goto not_found| if there is an error@>=
+number_clone(mp->null_dash->start_x, d->stop_x);
+dd = (mp_dash_node) h; /* this makes |mp_link(dd)=mp_get_dash_list(h)| */
+while (number_less(((mp_dash_node) mp_link(dd))->start_x, d->stop_x)) {
+ dd = (mp_dash_node) mp_link(dd);
+}
+if ((dd != (mp_dash_node) h) && number_greater(dd->stop_x, d->start_x)) {
+ mp_x_retrace_error(mp);
+ goto NOT_FOUND;
+}
+mp_link(d) = mp_link(dd);
+mp_link(dd) = (mp_node) d;
+
+@ @<Set |dash_y(h)| and merge the first and last dashes if necessary@>=
+d = mp_get_dash_list(h);
+while (mp_link(d) != (mp_node) mp->null_dash) {
+ d = (mp_dash_node) mp_link(d);
+}
+dd = mp_get_dash_list(h);
+set_number_from_subtraction(h->dash_y, d->stop_x, dd->start_x);
+{
+ mp_number absval;
+ new_number(absval);
+ number_abs_clone(absval, y0);
+ if (number_greater(absval, h->dash_y) ) {
+ number_clone(h->dash_y, absval);
+ } else if (d != dd) {
+ mp_set_dash_list(h, mp_link(dd));
+ set_number_from_addition(d->stop_x, dd->stop_x, h->dash_y);
+ mp_free_node(mp, (mp_node) dd, sizeof(mp_dash_node_data));
+ }
+ free_number(absval);
+}
+
+@ We get here when the argument is a NULL picture or when there is an error.
+Recovering from an error involves making |mp_get_dash_list(h)| empty to indicate that
+|h| is not known to be a valid dash pattern. We also dereference |h| since it is
+not being used for the return value.
+
+@<Flush the dash list, recycle |h| and return |NULL|@>=
+mp_flush_dash_list(mp, h);
+mp_delete_edge_ref(mp, h);
+return NULL;
+
+@ Having carefully saved the dashed stroked nodes in the corresponding dash
+nodes, we must be prepared to break up these dashes into smaller dashes.
+
+@<Scan |mp_get_dash_list(h)| and deal with any dashes that are themselves dashed@>=
+{
+mp_number hsf; /* the dash pattern from |hh| gets scaled by this */
+new_number(hsf);
+d = (mp_dash_node) h; /* now |mp_link(d)=mp_get_dash_list(h)| */
+while (mp_link(d) != (mp_node) mp->null_dash) {
+ ds = mp_dash_info(mp_link(d));
+ if (ds == NULL) {
+ d = (mp_dash_node) mp_link(d);
+ } else {
+ hh = (mp_edge_header_node) mp_dash_ptr(ds);
+ number_clone(hsf, ((mp_shape_node) ds)->dashscale);
+ if (hh == NULL) {
+ mp_confusion(mp, "dash pattern");
+ @:this can't happen dash0}{\quad dash1@>
+ return NULL;
+ } else if (number_zero(((mp_dash_node) hh)->dash_y )) {
+ d = (mp_dash_node) mp_link(d);
+ } else if (mp_get_dash_list (hh) == NULL) {
+ mp_confusion(mp, "dash list");
+ @:this can't happen dash1}{\quad dash1@>
+ return NULL;
+ } else {
+ @<Replace |mp_link(d)| by a dashed version as determined by edge header |hh| and scale factor |ds|@>
+ }
+ }
+}
+free_number(hsf);
+}
+
+@ @<Other local variables in |make_dashes|@>=
+mp_dash_node dln; /* |mp_link(d)| */
+mp_edge_header_node hh; /* an edge header that tells how to break up |dln| */
+mp_node ds; /* the stroked node from which |hh| and |hsf| are derived */
+
+@ @<Replace |mp_link(d)| by a dashed version as determined by edge header...@>=
+mp_number xoff; /* added to $x$ values in |mp_get_dash_list(hh)| to match |dln| */
+mp_number dashoff;
+mp_number r1, r2;
+new_number(r1);
+new_number(r2);
+dln = (mp_dash_node) mp_link(d);
+dd = mp_get_dash_list(hh);
+new_number(xoff);
+new_number(dashoff);
+mp_dash_offset(mp, &dashoff, (mp_dash_node) hh);
+take_scaled(r1, hsf, dd->start_x);
+take_scaled(r2, hsf, dashoff);
+number_add(r1, r2);
+set_number_from_subtraction(xoff, dln->start_x, r1);
+free_number(dashoff);
+take_scaled(r1, hsf, dd->start_x);
+take_scaled(r2, hsf, hh->dash_y);
+set_number_from_addition(mp->null_dash->start_x, r1, r2);
+number_clone(mp->null_dash->stop_x, mp->null_dash->start_x);
+@<Advance |dd| until finding the first dash that overlaps |dln| when offset by |xoff|@>
+while (number_lessequal(dln->start_x, dln->stop_x)) {
+ @<If |dd| has `fallen off the end', back up to the beginning and fix |xoff|@>
+ @<Insert a dash between |d| and |dln| for the overlap with the offset version of |dd|@>
+ dd = (mp_dash_node) mp_link(dd);
+ take_scaled(r1, hsf, dd->start_x);
+ set_number_from_addition(dln->start_x , xoff, r1);
+}
+free_number(xoff);
+free_number(r1);
+free_number(r2);
+mp_link(d) = mp_link(dln);
+mp_free_node(mp, (mp_node) dln, sizeof(mp_dash_node_data));
+
+@ The name of this module is a bit of a lie because we just find the first |dd|
+where |take_scaled(hsf, stop_x(dd))| is large enough to make an overlap
+possible. It could be that the unoffset version of dash |dln| falls in the gap
+between |dd| and its predecessor.
+
+@<Advance |dd| until finding the first dash that overlaps |dln| when...@>=
+{
+ mp_number r1;
+ new_number(r1);
+ take_scaled(r1, hsf, dd->stop_x);
+ number_add(r1, xoff);
+ while (number_less(r1, dln->start_x)) {
+ dd = (mp_dash_node) mp_link(dd);
+ take_scaled(r1, hsf, dd->stop_x);
+ number_add(r1, xoff);
+ }
+ free_number(r1);
+}
+
+@ @<If |dd| has `fallen off the end', back up to the beginning and fix...@>=
+if (dd == mp->null_dash) {
+ mp_number ret;
+ new_number(ret);
+ dd = mp_get_dash_list(hh);
+ take_scaled(ret, hsf, hh->dash_y);
+ number_add(xoff, ret);
+ free_number(ret);
+}
+
+@ At this point we already know that |start_x(dln)<=xoff+take_scaled(hsf,stop_x(dd))|.
+
+@<Insert a dash between |d| and |dln| for the overlap with the offset...@>=
+{
+ mp_number r1;
+ new_number(r1);
+ take_scaled(r1, hsf, dd->start_x);
+ number_add(r1, xoff);
+ if (number_lessequal(r1, dln->stop_x)) {
+ mp_link(d) = (mp_node) mp_get_dash_node(mp);
+ d = (mp_dash_node) mp_link(d);
+ mp_link(d) = (mp_node) dln;
+ take_scaled(r1, hsf, dd->start_x );
+ number_add(r1, xoff);
+ if (number_greater(dln->start_x, r1)) {
+ number_clone(d->start_x, dln->start_x);
+ } else {
+ number_clone(d->start_x, r1);
+ }
+ take_scaled(r1, hsf, dd->stop_x);
+ number_add(r1, xoff);
+ if (number_less(dln->stop_x, r1)) {
+ number_clone(d->stop_x, dln->stop_x );
+ } else {
+ number_clone(d->stop_x, r1);
+ }
+ }
+ free_number(r1);
+}
+
+@ The next major task is to update the bounding box information in an edge
+header~|h|. This is done via a procedure |adjust_bbox| that enlarges an edge
+header's bounding box to accommodate the box computed by |path_bbox| or
+|pen_bbox|. (This is stored in global variables |minx|, |miny|, |maxx|, and
+|maxy|.)
+
+@c
+static void mp_adjust_bbox (MP mp, mp_edge_header_node h)
+{
+ if (number_less(mp_minx, h->minx)) {
+ number_clone(h->minx, mp_minx);
+ }
+ if (number_less(mp_miny, h->miny)) {
+ number_clone(h->miny, mp_miny);
+ }
+ if (number_greater(mp_maxx, h->maxx)) {
+ number_clone(h->maxx, mp_maxx);
+ }
+ if (number_greater(mp_maxy, h->maxy)) {
+ number_clone(h->maxy, mp_maxy);
+ }
+}
+
+@ Here is a special routine for updating the bounding box information in edge
+header~|h| to account for the squared-off ends of a non-cyclic path~|p| that is
+to be stroked with the pen~|pp|.
+
+@c
+static void mp_box_ends (MP mp, mp_knot p, mp_knot pp, mp_edge_header_node h)
+{
+ if (mp_right_type(p) != mp_endpoint_knot) {
+ mp_fraction dx, dy; /* a unit vector in the direction out of the path at~|p| */
+ mp_number d; /* a factor for adjusting the length of |(dx,dy)| */
+ mp_number z; /* a coordinate being tested against the bounding box */
+ mp_number xx, yy; /* the extreme pen vertex in the |(dx,dy)| direction */
+ new_fraction(dx);
+ new_fraction(dy);
+ new_number(xx);
+ new_number(yy);
+ new_number(z);
+ new_number(d);
+ mp_knot q = mp_next_knot(p); /* a knot node adjacent to knot |p| */
+ while (1) {
+ @<Make |(dx,dy)| the final direction for the path segment from |q| to~|p|; set~|d|@>
+ pyth_add(d, dx, dy);
+ if (number_positive(d)) {
+ @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>
+ for (int i = 1; i <= 2; i++) {
+ @<Use |(dx,dy)| to generate a vertex of the square end cap and update the bounding box to accommodate it@>
+ number_negate(dx);
+ number_negate(dy);
+ }
+ }
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ goto DONE;
+ } else {
+ @<Advance |p| to the end of the path and make |q| the previous knot@>
+ }
+ }
+ DONE:
+ free_number(dx);
+ free_number(dy);
+ free_number(xx);
+ free_number(yy);
+ free_number(z);
+ free_number(d);
+ }
+}
+
+@ @<Make |(dx,dy)| the final direction for the path segment from...@>=
+if (q == mp_next_knot(p)) {
+ set_number_from_subtraction(dx, p->x_coord, p->right_x);
+ set_number_from_subtraction(dy, p->y_coord, p->right_y);
+ if (number_zero(dx) && number_zero(dy)) {
+ set_number_from_subtraction(dx, p->x_coord, q->left_x);
+ set_number_from_subtraction(dy, p->y_coord, q->left_y);
+ }
+} else {
+ set_number_from_subtraction(dx, p->x_coord, p->left_x);
+ set_number_from_subtraction(dy, p->y_coord, p->left_y);
+ if (number_zero(dx) && number_zero(dy)) {
+ set_number_from_subtraction(dx, p->x_coord, q->right_x);
+ set_number_from_subtraction(dy, p->y_coord, q->right_y);
+ }
+}
+set_number_from_subtraction(dx, p->x_coord, q->x_coord);
+set_number_from_subtraction(dy, p->y_coord, q->y_coord);
+
+@ @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>=
+mp_number arg1, r;
+new_fraction(r);
+new_number(arg1);
+make_fraction(r, dx, d);
+number_clone(dx, r);
+make_fraction(r, dy, d);
+number_clone(dy, r);
+free_number(r);
+number_negated_clone(arg1, dy);
+mp_find_offset(mp, &arg1, &dx, pp);
+free_number(arg1);
+number_clone(xx, mp->cur_x);
+number_clone(yy, mp->cur_y);
+
+@ @<Use |(dx,dy)| to generate a vertex of the square end cap and...@>=
+mp_number r1, r2, arg1;
+new_number(arg1);
+new_fraction(r1);
+new_fraction(r2);
+mp_find_offset(mp, &dx, &dy, pp);
+set_number_from_subtraction(arg1, xx, mp->cur_x);
+take_fraction(r1, arg1, dx);
+set_number_from_subtraction(arg1, yy, mp->cur_y);
+take_fraction(r2, arg1, dy);
+set_number_from_addition(d, r1, r2);
+if ((number_negative(d) && (i == 1)) || (number_positive(d) && (i == 2))) {
+ mp_confusion(mp, "box ends");
+ @:this can't happen box ends}{\quad|box\_ends|@>
+}
+take_fraction(r1, d, dx);
+set_number_from_addition(z, p->x_coord, mp->cur_x);
+number_add(z, r1);
+if (number_less(z, h->minx)) {
+ number_clone(h->minx, z);
+}
+if (number_greater(z, h->maxx)) {
+ number_clone(h->maxx, z);
+}
+take_fraction(r1, d, dy);
+set_number_from_addition(z, p->y_coord, mp->cur_y);
+number_add(z, r1);
+if (number_less(z, h->miny)) {
+ number_clone(h->miny, z);
+}
+if (number_greater(z, h->maxy)) {
+ number_clone(h->maxy, z);
+}
+free_number(r1);
+free_number(r2);
+free_number(arg1);
+
+@ @<Advance |p| to the end of the path and make |q| the previous knot@>=
+do {
+ q = p;
+ p = mp_next_knot(p);
+} while (mp_right_type(p) != mp_endpoint_knot);
+
+@ The major difficulty in finding the bounding box of an edge structure is the
+effect of clipping paths. We treat them conservatively by only clipping to the
+clipping path's bounding box, but this still requires recursive calls to
+|set_bbox| in order to find the bounding box of @^recursion@> the objects to be
+clipped. Such calls are distinguished by the fact that the boolean parameter
+|top_level| is false.
+
+@c
+void mp_set_bbox (MP mp, mp_edge_header_node h, int top_level)
+{
+ /*
+ Wipe out any existing bounding box information if |bbtype(h)| is
+ incompatible with |internal[mp_true_corners]|
+ */
+ switch (h->bbtype ) {
+ case mp_no_bounds_code:
+ break;
+ case mp_bounds_set_code:
+ if (number_positive(internal_value(mp_true_corners_internal))) {
+ mp_init_bbox(mp, h);
+ }
+ break;
+ case mp_bounds_unset_code:
+ if (number_nonpositive(internal_value(mp_true_corners_internal))) {
+ mp_init_bbox(mp, h);
+ }
+ break;
+ }
+
+ while (mp_link(mp_bblast(h)) != NULL) {
+ mp_node p = mp_link(mp_bblast(h)); /* a graphical object being considered */
+ mp_bblast(h) = p;
+ switch (mp_type(p)) {
+ case mp_stop_clip_node_type:
+ if (top_level) {
+ mp_confusion(mp, "clip");
+ break;
+ } else {
+ return;
+ @:this can't happen bbox}{\quad bbox@>
+ }
+ @<Other cases for updating the bounding box based on the type of object |p|@>
+ default:
+ break;
+ }
+ }
+ if (! top_level) {
+ mp_confusion(mp, "boundingbox");
+ }
+}
+
+@ @<Declarations@>=
+static void mp_set_bbox (MP mp, mp_edge_header_node h, int top_level);
+
+@ @<Other cases for updating the bounding box...@>=
+case mp_start_bounds_node_type:
+ if (number_positive(internal_value(mp_true_corners_internal))) {
+ h->bbtype = mp_bounds_unset_code;
+ } else {
+ h->bbtype = mp_bounds_set_code;
+ mp_path_bbox(mp, mp_path_ptr((mp_start_node) p));
+ mp_adjust_bbox(mp, h);
+ @<Scan to the matching |mp_stop_bounds_node| node and update |p| and |mp_bblast(h)|@>
+ }
+ break;
+case mp_stop_bounds_node_type:
+ if (number_nonpositive (internal_value(mp_true_corners_internal))) {
+ mp_confusion(mp, "bounds");
+ @:this can't happen bbox2}{\quad bbox2@>
+ }
+ break;
+
+@ @<Scan to the matching |mp_stop_bounds_node| node and update |p| and...@>=
+{
+ int lev = 1;
+ while (lev != 0) {
+ if (mp_link(p) == NULL) {
+ mp_confusion(mp, "bounds");
+ @:this can't happen bbox2}{\quad bbox2@>
+ } else {
+ p = mp_link(p);
+ if (mp_type(p) == mp_start_bounds_node_type) {
+ ++lev;
+ } else if (mp_type(p) == mp_stop_bounds_node_type) {
+ --lev;
+ }
+ }
+ }
+ mp_bblast(h) = p;
+}
+
+@ It saves a lot of grief here to be slightly conservative and not account for
+omitted parts of dashed lines. We also don't worry about the material omitted
+when using butt end caps. The basic computation is for round end caps and
+|box_ends| augments it for square end caps.
+
+@<Other cases for updating the bounding box...@>=
+case mp_fill_node_type:
+case mp_stroked_node_type:
+ {
+ mp_number x0a, y0a, x1a, y1a;
+ mp_path_bbox(mp, mp_path_ptr((mp_shape_node) p));
+ /* Stroked paths always have a pen */
+ if (mp_pen_ptr((mp_shape_node) p) != NULL) {
+ new_number_clone(x0a, mp_minx);
+ new_number_clone(y0a, mp_miny);
+ new_number_clone(x1a, mp_maxx);
+ new_number_clone(y1a, mp_maxy);
+ mp_pen_bbox(mp, mp_pen_ptr((mp_shape_node) p));
+ number_add(mp_minx, x0a);
+ number_add(mp_miny, y0a);
+ number_add(mp_maxx, x1a);
+ number_add(mp_maxy, y1a);
+ free_number(x0a);
+ free_number(y0a);
+ free_number(x1a);
+ free_number(y1a);
+ }
+ mp_adjust_bbox(mp, h);
+ /* Stroked paths can be open, so: */
+ if ((mp_left_type(mp_path_ptr((mp_shape_node) p)) == mp_endpoint_knot) && (((mp_shape_node) p)->linecap == 2)) {
+ mp_box_ends(mp, mp_path_ptr((mp_shape_node) p), mp_pen_ptr((mp_shape_node) p), h);
+ }
+ }
+ break;
+
+@ This case involves a recursive call that advances |mp_bblast(h)| to the node of
+type |mp_stop_clip_node| that matches |p|.
+
+@<Other cases for updating the bounding box...@>=
+case mp_start_clip_node_type:
+ {
+ mp_number sminx, sminy, smaxx, smaxy;
+ /* for saving the bounding box during recursive calls */
+ mp_number x0a, y0a, x1a, y1a;
+ mp_path_bbox(mp, mp_path_ptr((mp_start_node) p));
+ new_number_clone(x0a, mp_minx);
+ new_number_clone(y0a, mp_miny);
+ new_number_clone(x1a, mp_maxx);
+ new_number_clone(y1a, mp_maxy);
+ new_number_clone(sminx, h->minx);
+ new_number_clone(sminy, h->miny);
+ new_number_clone(smaxx, h->maxx);
+ new_number_clone(smaxy, h->maxy);
+ @<Reinitialize the bounding box in header |h| and call |set_bbox| recursively starting at |mp_link(p)|@>
+ @<Clip the bounding box in |h| to the rectangle given by |x0a|, |x1a|, |y0a|, |y1a|@>
+ number_clone(mp_minx, sminx);
+ number_clone(mp_miny, sminy);
+ number_clone(mp_maxx, smaxx);
+ number_clone(mp_maxy, smaxy);
+ mp_adjust_bbox(mp, h);
+ free_number(sminx);
+ free_number(sminy);
+ free_number(smaxx);
+ free_number(smaxy);
+ free_number(x0a);
+ free_number(y0a);
+ free_number(x1a);
+ free_number(y1a);
+ }
+ break;
+
+@ @<Reinitialize the bounding box in header |h| and call |set_bbox|...@>=
+set_number_to_inf(h->minx);
+set_number_to_inf(h->miny);
+set_number_to_negative_inf(h->maxx);
+set_number_to_negative_inf(h->maxy);
+mp_set_bbox(mp, h, 0);
+
+@ @<Clip the bounding box in |h| to the rectangle given by |x0a|, |x1a|,...@>=
+if (number_less(h->minx, x0a)) {
+ number_clone(h->minx, x0a);
+}
+if (number_less(h->miny, y0a)) {
+ number_clone(h->miny, y0a);
+}
+if (number_greater(h->maxx, x1a)) {
+ number_clone(h->maxx, x1a);
+}
+if (number_greater(h->maxy, y1a)) {
+ number_clone(h->maxy, y1a);
+}
+
+@* Finding an envelope.
+
+When \MP\ has a path and a polygonal pen, it needs to express the desired shape
+in terms of things \ps\ can understand. The present task is to compute a new path
+that describes the region to be filled. It is convenient to define this as a two
+step process where the first step is determining what offset to use for each
+segment of the path.
+
+@ Given a pointer |c| to a cyclic path, and a pointer~|h| to the first knot of a
+pen polygon, the |offset_prep| routine changes the path into cubics that are
+associated with particular pen offsets. Thus if the cubic between |p| and~|q| is
+associated with the |k|th offset and the cubic between |q| and~|r| has offset |l|
+then |mp_info(q) = zero_off + l - k|. (The constant |zero_off| is added to
+because |l - k| could be negative.)
+
+After overwriting the type information with offset differences, we no longer have
+a true path so we refer to the knot list returned by |offset_prep| as an
+\quote {envelope spec.} @^envelope spec@> Since an envelope spec only determines
+relative changes in pen offsets, |offset_prep| sets a global variable
+|spec_offset| to the relative change from |h| to the first offset.
+
+@d zero_off 0 /* 16384 */ /* added to offset changes to make them positive */
+
+@<Glob...@>=
+int spec_offset; /* number of pen edges between |h| and the initial offset */
+int spec_padding; /* be nice */
+
+@ The next function calculates $1/3 B'(t) = (-p + (3c_1 + (-3c_2 + q)))*t^2 + (2p
++ (-4c_1 + 2*c_2))t + (-p + c_1)$, for cubic curve |B(t)| given by
+|p|,|c1|,|c2|,|q| and it's used for |t| near 0 and |t| near 1. We use double
+mode, otherwise we have to take care of overflow.
+
+@ @c
+static mp_knot mp_offset_prep (MP mp, mp_knot c, mp_knot h)
+{
+ int n; /* the number of vertices in the pen polygon */
+ mp_knot c0, p, q, q0, r, w, ww; /* for list manipulation */
+ int k_needed; /* amount to be added to |mp_info(p)| when it is computed */
+ mp_knot w0; /* a pointer to pen offset to use just before |p| */
+ mp_number dxin, dyin; /* the direction into knot |p| */
+ int turn_amt; /* change in pen offsets for the current cubic */
+ mp_number max_coef; /* used while scaling */
+ mp_number ss;
+ mp_number x0, x1, x2, y0, y1, y2; /* representatives of derivatives */
+ mp_number t0, t1, t2; /* coefficients of polynomial for slope testing */
+ mp_number du, dv, dx, dy; /* for directions of the pen and the curve */
+ mp_number dx0, dy0; /* initial direction for the first cubic in the curve */
+ mp_number x0a, x1a,x2a, y0a, y1a, y2a; /* intermediate values */
+ mp_number t; /* where the derivative passes through zero */
+ mp_number s; /* a temporary value */
+ mp_number dx_m; /* signal a pertubation of dx */
+ mp_number dy_m; /* signal a pertubation of dx */
+ mp_number dxin_m; /* signal a pertubation of dxin */
+ mp_number u0, u1, v0, v1; /* intermediate values for $d(t)$ calculation */
+ int d_sign; /* sign of overall change in direction for this cubic */
+ new_number(max_coef);
+ new_number(dxin);
+ new_number(dyin);
+ new_number(dx0);
+ new_number(dy0);
+ new_number(x0);
+ new_number(y0);
+ new_number(x1);
+ new_number(y1);
+ new_number(x2);
+ new_number(y2);
+ new_number(du);
+ new_number(dv);
+ new_number(dx);
+ new_number(dy);
+ new_number(x0a);
+ new_number(y0a);
+ new_number(x1a);
+ new_number(y1a);
+ new_number(x2a);
+ new_number(y2a);
+ new_number(t0);
+ new_number(t1);
+ new_number(t2);
+ new_number(u0);
+ new_number(u1);
+ new_number(v0);
+ new_number(v1);
+ new_number(dx_m);
+ new_number(dy_m);
+ new_number(dxin_m);
+ new_fraction(ss);
+ new_fraction(s);
+ new_fraction(t);
+ @<Initialize the pen size~|n|@>
+ @<Initialize the incoming direction and pen offset at |c|@>
+ p = c;
+ c0 = c;
+ k_needed = 0;
+ do {
+ q = mp_next_knot(p);
+ @<Split the cubic between |p| and |q|, if necessary, into cubics associated with single offsets, after which |q| should point to the end of the final such cubic@>
+ NOT_FOUND:
+ @<Advance |p| to node |q|, removing any \quote {dead} cubics that might have been introduced by the splitting process@>
+ } while (q != c);
+ @<Fix the offset change in |mp_knot_info(c)| and set |c| to the return value of |offset_prep|@>
+ free_number(ss);
+ free_number(s);
+ free_number(dxin);
+ free_number(dyin);
+ free_number(dx0);
+ free_number(dy0);
+ free_number(x0);
+ free_number(y0);
+ free_number(x1);
+ free_number(y1);
+ free_number(x2);
+ free_number(y2);
+ free_number(max_coef);
+ free_number(du);
+ free_number(dv);
+ free_number(dx);
+ free_number(dy);
+ free_number(x0a);
+ free_number(y0a);
+ free_number(x1a);
+ free_number(y1a);
+ free_number(x2a);
+ free_number(y2a);
+ free_number(t0);
+ free_number(t1);
+ free_number(t2);
+ free_number(u0);
+ free_number(u1);
+ free_number(v0);
+ free_number(v1);
+ free_number(dx_m);
+ free_number(dy_m);
+ free_number(dxin_m);
+ free_number(t);
+ return c;
+}
+
+@ We shall want to keep track of where certain knots on the cyclic path wind up
+in the envelope spec. It doesn't suffice just to keep pointers to knot nodes
+because some nodes are deleted while removing dead cubics. Thus |offset_prep|
+updates the following pointers
+
+@<Glob...@>=
+mp_knot spec_p1;
+mp_knot spec_p2; /* pointers to distinguished knots */
+
+@ @<Set init...@>=
+mp->spec_p1 = NULL;
+mp->spec_p2 = NULL;
+
+@ @<Initialize the pen size~|n|@>=
+n = 0;
+p = h;
+do {
+ ++n;
+ p = mp_next_knot(p);
+} while (p != h);
+
+@ Since the true incoming direction isn't known yet, we just pick a direction
+consistent with the pen offset~|h|. If this is wrong, it can be corrected later.
+
+@<Initialize the incoming direction and pen offset at |c|@>=
+{
+ mp_knot hn = mp_next_knot(h);
+ mp_knot hp = mp_prev_knot(h);
+ set_number_from_subtraction(dxin, hn->x_coord, hp->x_coord);
+ set_number_from_subtraction(dyin, hn->y_coord, hp->y_coord);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ set_number_from_subtraction(dxin, hp->y_coord, h->y_coord);
+ set_number_from_subtraction(dyin, h->x_coord, hp->x_coord);
+ }
+}
+w0 = h;
+
+@ We must be careful not to remove the only cubic in a cycle.
+
+But we must also be careful for another reason. If the user-supplied path starts
+with a set of degenerate cubics, the target node |q| can be collapsed to the
+initial node |p| which might be the same as the initial node |c| of the curve.
+This would cause the |offset_prep| routine to bail out too early, causing
+distress later on. (See for example the testcase reported by Bogus||aw
+Jackowski in tracker id 267, case 52c on Sarovar.)
+
+@<Advance |p| to node |q|, removing any \quote {dead} cubics...@>=
+q0 = q;
+do {
+ r = mp_next_knot(p);
+ if (r != p && r != q
+ && number_equal(p->x_coord, p->right_x)
+ && number_equal(p->y_coord, p->right_y)
+ && number_equal(p->x_coord, r->left_x)
+ && number_equal(p->y_coord, r->left_y)
+ && number_equal(p->x_coord, r->x_coord)
+ && number_equal(p->y_coord, r->y_coord)) {
+ @<Remove the cubic following |p| and update the data structures to merge |r| into |p|@>
+ }
+ p = r;
+} while (p != q);
+/* Check if we removed too much */
+if ((q != q0) && (q != c || c == c0)) {
+ q = mp_next_knot(q);
+}
+
+@ @<Remove the cubic following |p| and update the data structures...@>=
+{
+ k_needed = mp_knot_info(p) - zero_off;
+ if (r == q) {
+ q = p;
+ } else {
+ mp_knot_info(p) = k_needed + mp_knot_info(r);
+ k_needed = 0;
+ }
+ if (r == c) {
+ mp_knot_info(p) = mp_knot_info(c);
+ c = p;
+ }
+ if (r == mp->spec_p1) {
+ mp->spec_p1 = p;
+ }
+ if (r == mp->spec_p2) {
+ mp->spec_p2 = p;
+ }
+ r = p;
+ mp_remove_cubic(mp, p);
+}
+
+@ Not setting the |info| field of the newly created knot allows the splitting
+routine to work for paths.
+
+@<Declarations@>=
+static void mp_split_cubic (MP mp, mp_knot p, mp_number *t);
+static mp_knot mp_split_cubic_knot (MP mp, mp_knot p, mp_number *t);
+
+@ @c
+void mp_split_cubic (MP mp, mp_knot p, mp_number *t)
+{
+ /* splits the cubic after |p| */
+ mp_number v; /* an intermediate value */
+ mp_knot q = mp_next_knot(p);
+ mp_knot r = mp_new_knot(mp);
+ mp_prev_knot(r) = p;
+ mp_next_knot(p) = r;
+ mp_prev_knot(q) = r;
+ mp_next_knot(r) = q;
+ mp_originator(r) = mp_program_code;
+ mp_knotstate(r) = mp_regular_knot;
+ mp_left_type(r) = mp_explicit_knot;
+ mp_right_type(r) = mp_explicit_knot;
+ new_number(v);
+ set_number_from_of_the_way(v, *t, p->right_x, q->left_x);
+ set_number_from_of_the_way(p->right_x, *t, p->x_coord, p->right_x);
+ set_number_from_of_the_way(q->left_x, *t, q->left_x, q->x_coord);
+ set_number_from_of_the_way(r->left_x, *t, p->right_x, v);
+ set_number_from_of_the_way(r->right_x, *t, v, q->left_x);
+ set_number_from_of_the_way(r->x_coord, *t, r->left_x, r->right_x);
+ set_number_from_of_the_way(v, *t, p->right_y, q->left_y);
+ set_number_from_of_the_way(p->right_y, *t, p->y_coord, p->right_y);
+ set_number_from_of_the_way(q->left_y, *t, q->left_y, q->y_coord);
+ set_number_from_of_the_way(r->left_y, *t, p->right_y, v);
+ set_number_from_of_the_way(r->right_y, *t, v, q->left_y);
+ set_number_from_of_the_way(r->y_coord, *t, r->left_y, r->right_y);
+ free_number(v);
+}
+
+static mp_knot mp_split_cubic_knot (MP mp, mp_knot p, mp_number *t) /* can be less as we only need x y */
+{
+ mp_number v;
+ mp_knot k = mp_new_knot(mp);
+ mp_knot r = mp_copy_knot(mp, mp_next_knot(p));
+ mp_knot l = mp_copy_knot(mp, p);
+ mp_originator(k) = mp_program_code;
+ mp_knotstate(k) = mp_regular_knot;
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ new_number(v);
+ set_number_from_of_the_way(v, *t, l->right_x, r->left_x);
+ set_number_from_of_the_way(l->right_x, *t, l->x_coord, l->right_x);
+ set_number_from_of_the_way(r->left_x, *t, r->left_x, r->x_coord);
+ set_number_from_of_the_way(k->left_x, *t, l->right_x, v);
+ set_number_from_of_the_way(k->right_x, *t, v, r->left_x);
+ set_number_from_of_the_way(k->x_coord, *t, k->left_x, k->right_x);
+ set_number_from_of_the_way(v, *t, l->right_y, r->left_y);
+ set_number_from_of_the_way(l->right_y, *t, l->y_coord, l->right_y);
+ set_number_from_of_the_way(r->left_y, *t, r->left_y, r->y_coord);
+ set_number_from_of_the_way(k->left_y, *t, l->right_y, v);
+ set_number_from_of_the_way(k->right_y, *t, v, r->left_y);
+ set_number_from_of_the_way(k->y_coord, *t, k->left_y, k->right_y);
+ free_number(v);
+ mp_toss_knot(mp, l);
+ mp_toss_knot(mp, r);
+ return k;
+}
+
+@ This does not set |mp_knot_info(p)| or |mp_right_type(p)|.
+
+@<Declarations@>=
+static void mp_remove_cubic (MP mp, mp_knot p);
+
+@ @c
+void mp_remove_cubic (MP mp, mp_knot p)
+{
+ /* removes the dead cubic following~|p| */
+ mp_knot q = mp_next_knot(p); /* the node that disappears */
+ mp_prev_knot(q) = mp_next_knot(p);
+ mp_next_knot(p) = mp_next_knot(q);
+ number_clone(p->right_x, q->right_x);
+ number_clone(p->right_y, q->right_y);
+ /* was: mp_memory_free(q); */
+ mp_toss_knot(mp, q);
+}
+
+@ Let $d\prec d'$ mean that the counter-clockwise angle from $d$ to~$d'$ is
+strictly between zero and $180^\circ$. Then we can define $d\preceq d'$ to mean
+that the angle could be zero or $180^\circ$. If $w_k=(u_k,v_k)$ is the $k$th pen
+offset, the $k$th pen edge direction is defined by the formula
+$$d_k=(u\k-u_k,\,v\k-v_k).$$ When listed by increasing $k$, these directions
+occur in counter-clockwise order so that $d_k\preceq d\k$ for all~$k$. The goal
+of |offset_prep| is to find an offset index~|k| to associate with each cubic,
+such that the direction $d(t)$ of the cubic satisfies $$d_{k-1}\preceq
+d(t)\preceq d_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$ We may have to split a
+cubic into many pieces before each piece corresponds to a unique offset.
+
+@<Split the cubic between |p| and |q|, if necessary, into cubics...@>=
+mp_knot_info(p) = zero_off + k_needed;
+k_needed = 0;
+@<Prepare for derivative computations; |goto not_found| if the current cubic is dead@>
+@<Find the initial direction |(dx,dy)|@>
+@<Update |mp_knot_info(p)| and find the offset $w_k$ such that $d_{k-1}\preceq(|dx|,|dy|)\prec d_k$; also advance |w0| for the direction change at |p|@>
+@<Find the final direction |(dxin,dyin)|@>
+@<Decide on the net change in pen offsets and set |turn_amt|@>
+@<Complete the offset splitting process@>
+w0 = mp_pen_walk (mp, w0, turn_amt);
+
+@ @<Declarations@>=
+static mp_knot mp_pen_walk (MP mp, mp_knot w, int k);
+
+@ @c
+mp_knot mp_pen_walk (MP mp, mp_knot w, int k)
+{
+ /* walk |k| steps around a pen from |w| */
+ (void) mp;
+ while (k > 0) {
+ w = mp_next_knot(w);
+ --k;
+ }
+ while (k < 0) {
+ w = mp_prev_knot(w);
+ ++k;
+ }
+ return w;
+}
+
+@ The direction of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be
+calculated from the quadratic polynomials
+${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and
+${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$.
+Since we may be calculating directions from several cubics
+split from the current one, it is desirable to do these calculations
+without losing too much precision. \quote {Scaled up} values of the
+derivatives, which will be less tainted by accumulated errors than
+derivatives found from the cubics themselves, are maintained in
+local variables |x0|, |x1|, and |x2|, representing $X_0=2^l(x_1-x_0)$,
+$X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly |y0|, |y1|, and~|y2|
+represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$.
+
+@ @<Prepare for derivative computations...@>=
+set_number_from_subtraction(x0, p->right_x, p->x_coord);
+set_number_from_subtraction(x2, q->x_coord, q->left_x);
+set_number_from_subtraction(x1, q->left_x, p->right_x);
+set_number_from_subtraction(y0, p->right_y, p->y_coord);
+set_number_from_subtraction(y2, q->y_coord, q->left_y);
+set_number_from_subtraction(y1, q->left_y, p->right_y);
+{
+ /* somewhat weird: these copies to absval */
+ mp_number absval;
+ new_number_abs(absval, x1);
+ number_abs_clone(max_coef, x0);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, x2);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, y0);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, y1);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ number_abs_clone(absval, y2);
+ if (number_greater(absval, max_coef)) {
+ number_clone(max_coef, absval);
+ }
+ free_number(absval);
+ if (number_zero(max_coef)) {
+ goto NOT_FOUND;
+ }
+}
+while (number_less(max_coef, fraction_half_t)) {
+ number_double(max_coef);
+ number_double(x0);
+ number_double(x1);
+ number_double(x2);
+ number_double(y0);
+ number_double(y1);
+ number_double(y2);
+}
+
+@ Let us first solve a special case of the problem: Suppose we know an index~$k$
+such that either (i)~$d(t)\succeq d_{k-1}$ for all~$t$ and $d(0)\prec d_k$, or
+(ii)~$d(t)\preceq d_k$ for all~$t$ and $d(0)\succ d_{k-1}$. Then, in a sense,
+we're halfway done, since one of the two relations in $(*)$ is satisfied, and the
+other couldn't be satisfied for any other value of~|k|. Actually, the conditions
+can be relaxed somewhat since a relation such as
+
+$d(t)\succeq d_{k-1}$ restricts $d(t)$ to a half plane when all that really
+matters is whether $d(t)$ crosses the ray in the $d_{k-1}$ direction from the
+origin. The condition for case~(i) becomes $d_{k-1}\preceq d(0)\prec d_k$ and
+$d(t)$ never crosses the $d_{k-1}$ ray in the clockwise direction. Case~(ii) is
+similar except $d(t)$ cannot cross the $d_k$ ray in the counterclockwise
+direction.
+
+The |fin_offset_prep| subroutine solves the stated subproblem. It has a parameter
+called |rise| that is |1| in case~(i), |-1| in case~(ii). Parameters |x0| through
+|y2| represent the derivative of the cubic following |p|. The |w| parameter
+should point to offset~$w_k$ and |mp_info(p)| should already be set properly. The
+|turn_amt| parameter gives the absolute value of the overall net change in pen
+offsets.
+
+@<Declarations@>=
+static void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number *x0, mp_number *x1, mp_number *x2, mp_number *y0, mp_number *y1, mp_number *y2, int rise, int turn_amt);
+
+@ @c
+void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number *x0, mp_number *x1, mp_number *x2, mp_number *y0, mp_number *y1, mp_number *y2, int rise, int turn_amt)
+{
+ mp_number du, dv; /* for slope calculation */
+ mp_number t0, t1, t2; /* test coefficients */
+ mp_number t; /* place where the derivative passes a critical slope */
+ mp_number s; /* slope or reciprocal slope */
+ mp_number v; /* intermediate value for updating |x0..y2| */
+ mp_knot q = mp_next_knot(p);
+ new_number(du);
+ new_number(dv);
+ new_number(v);
+ new_number(t0);
+ new_number(t1);
+ new_number(t2);
+ new_fraction(s);
+ new_fraction(t);
+ while (1) {
+ mp_knot ww = rise > 0 ? mp_next_knot(w) : mp_prev_knot(w);
+ @<Compute (case 1) test coefficients |(t0,t1,t2)| for $d(t)$ versus $d_k$ or $d_{k-1}$@>
+ crossing_point(t, t0, t1, t2);
+ if (number_greaterequal(t, fraction_one_t)) {
+ if (turn_amt > 0) {
+ number_clone(t, fraction_one_t);
+ } else {
+ goto RETURN;
+ }
+ }
+ @<Split the cubic at $t$, and split off another cubic if the derivative crosses back@>
+ w = ww;
+ }
+ RETURN:
+ free_number(s);
+ free_number(t);
+ free_number(du);
+ free_number(dv);
+ free_number(v);
+ free_number(t0);
+ free_number(t1);
+ free_number(t2);
+}
+
+@ We want $B(|t0|,|t1|,|t2|;t)$ to be the dot product of $d(t)$ with a
+$-90^\circ$ rotation of the vector from |w| to |ww|. This makes the resulting
+function cross from positive to negative when $d_{k-1}\preceq d(t)\preceq d_k$
+begins to fail.
+
+@<Compute (case 1) test coefficients |(t0,t1,t2)| for $d(t)$ versus $d_k$ or $d_{k-1}$...@>=
+{
+ mp_number abs_du, abs_dv;
+ new_number(abs_du);
+ new_number(abs_dv);
+ set_number_from_subtraction(du, ww->x_coord, w->x_coord);
+ set_number_from_subtraction(dv, ww->y_coord, w->y_coord);
+ number_abs_clone(abs_du, du);
+ number_abs_clone(abs_dv, dv);
+ if (number_greaterequal(abs_du, abs_dv)) {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, dv, du);
+ take_fraction(r1, *x0, s);
+ set_number_from_subtraction(t0, r1, *y0);
+ take_fraction(r1, *x1, s);
+ set_number_from_subtraction(t1, r1, *y1);
+ take_fraction(r1, *x2, s);
+ set_number_from_subtraction(t2, r1, *y2);
+ if (number_negative(du)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, du, dv);
+ take_fraction(r1, *y0, s);
+ set_number_from_subtraction(t0, *x0, r1);
+ take_fraction(r1, *y1, s);
+ set_number_from_subtraction(t1, *x1, r1);
+ take_fraction(r1, *y2, s);
+ set_number_from_subtraction(t2, *x2, r1);
+ if (number_negative(dv)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ }
+ free_number(abs_du);
+ free_number(abs_dv);
+ if (number_negative(t0)) {
+ set_number_to_zero(t0); /* should be positive without rounding error */
+ }
+}
+
+@ @<Compute (case 2) test coefficients |(t0,t1,t2)| for $d(t)$ versus $d_k$ or $d_{k-1}$...@>=
+{
+ mp_number abs_du, abs_dv;
+ new_number(abs_du);
+ new_number(abs_dv);
+ set_number_from_subtraction(du, ww->x_coord, w->x_coord);
+ set_number_from_subtraction(dv, ww->y_coord, w->y_coord);
+ number_abs_clone(abs_du, du);
+ number_abs_clone(abs_dv, dv);
+ if (number_greaterequal(abs_du, abs_dv)) {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, dv, du);
+ take_fraction(r1, x0, s);
+ set_number_from_subtraction(t0, r1, y0);
+ take_fraction(r1, x1, s);
+ set_number_from_subtraction(t1, r1, y1);
+ take_fraction(r1, x2, s);
+ set_number_from_subtraction(t2, r1, y2);
+ if (number_negative(du)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(s, du, dv);
+ take_fraction(r1, y0, s);
+ set_number_from_subtraction(t0, x0, r1);
+ take_fraction(r1, y1, s);
+ set_number_from_subtraction(t1, x1, r1);
+ take_fraction(r1, y2, s);
+ set_number_from_subtraction(t2, x2, r1);
+ if (number_negative(dv)) {
+ number_negate(t0);
+ number_negate(t1);
+ number_negate(t2);
+ }
+ free_number(r1);
+ }
+ free_number(abs_du);
+ free_number(abs_dv);
+ if (number_negative(t0)) {
+ set_number_to_zero(t0); /* should be positive without rounding error */
+ }
+}
+
+@ The curve has crossed $d_k$ or $d_{k-1}$; its initial segment satisfies $(*)$,
+and it might cross again and return towards $s_{k-1}$ or $s_k$, respectively,
+yielding another solution of $(*)$.
+
+@<Split the cubic at $t$, and split off another...@>=
+{
+ mp_split_cubic(mp, p, &t);
+ p = mp_next_knot(p);
+ mp_knot_info(p) = zero_off + rise;
+ --turn_amt;
+ set_number_from_of_the_way(v, t, *x0, *x1);
+ set_number_from_of_the_way(*x1, t, *x1, *x2);
+ set_number_from_of_the_way(*x0, t, v, *x1);
+ set_number_from_of_the_way(v, t, *y0, *y1);
+ set_number_from_of_the_way(*y1, t, *y1, *y2);
+ set_number_from_of_the_way(*y0, t, v, *y1);
+ if (turn_amt < 0) {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ set_number_from_of_the_way(t1, t, t1, t2);
+ if (number_positive(t1)) {
+ set_number_to_zero(t1); /* without rounding error, |t1| would be |<=0| */
+ }
+ number_negated_clone(arg2, t1);
+ number_negated_clone(arg3, t2);
+ crossing_point(t, arg1, arg2, arg3); /* arg1 is zero */
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ if (number_greater(t, fraction_one_t)) {
+ number_clone(t, fraction_one_t);
+ }
+ ++turn_amt;
+ if (number_equal(t,fraction_one_t) && (mp_next_knot(p) != q)) {
+ mp_knot_info(mp_next_knot(p)) = mp_knot_info(mp_next_knot(p)) - rise;
+ } else {
+ mp_split_cubic(mp, p, &t);
+ mp_knot_info(mp_next_knot(p)) = zero_off - rise;
+ set_number_from_of_the_way(v, t, *x1, *x2);
+ set_number_from_of_the_way(*x1, t, *x0, *x1);
+ set_number_from_of_the_way(*x2, t, *x1, v);
+ set_number_from_of_the_way(v, t, *y1, *y2);
+ set_number_from_of_the_way(*y1, t, *y0, *y1);
+ set_number_from_of_the_way(*y2, t, *y1, v);
+ }
+ }
+}
+
+@ Now we must consider the general problem of |offset_prep|, when nothing is
+known about a given cubic. We start by finding its direction in the vicinity of
+|t=0|.
+
+If $z'(t)=0$, the given cubic is numerically unstable but |offset_prep| has not
+yet introduced any more numerical errors. Thus we can compute the true initial
+direction for the given cubic, even if it is almost degenerate.
+
+@<Find the initial direction |(dx,dy)|@>=
+number_clone(dx_m, zero_t);
+number_clone(dy_m, zero_t);
+/* todo: just if else and test before assignment */
+number_clone(dx, x0);
+number_clone(dy, y0);
+if (number_zero(dx) && number_zero(dy)) {
+ number_clone(dx, x1);
+ number_clone(dy, y1);
+ if (number_zero(dx) && number_zero(dy)) {
+ number_clone(dx, x2);
+ number_clone(dy, y2);
+ }
+}
+if (p == c) {
+ number_clone(dx0, dx);
+ number_clone(dy0, dy);
+}
+
+@ @<Find the final direction |(dxin,dyin)|@>=
+number_clone(dxin, x2);
+number_clone(dyin, y2);
+if (number_zero(dxin) && number_zero(dyin)) {
+ number_clone(dxin, x1);
+ number_clone(dyin, y1);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ number_clone(dxin, x0);
+ number_clone(dyin, y0);
+ }
+}
+
+@ The next step is to bracket the initial direction between consecutive edges of
+the pen polygon. We must be careful to turn clockwise only if this makes the turn
+less than $180^\circ$. (A $180^\circ$ turn must be counter-clockwise in order to
+make |doublepath| envelopes come out @:double_path_}{|doublepath| primitive@>
+right.) This code depends on |w0| being the offset for |(dxin,dyin)|.
+
+@<Update |mp_knot_info(p)| and find the offset $w_k$ such that...@>=
+{
+ turn_amt = mp_get_turn_amt(mp, w0, &dx, &dy, ab_vs_cd(dy, dxin, dx, dyin) >= 0);
+ w = mp_pen_walk(mp, w0, turn_amt);
+ w0 = w;
+ mp_knot_info(p) = mp_knot_info(p) + turn_amt;
+}
+
+@ Decide how many pen offsets to go away from |w| in order to find the offset for
+|(dx,dy)|, going counterclockwise if |ccw| is |true|. This assumes that |w| is
+the offset for some direction $(x',y')$ from which the angle to |(dx,dy)| in the
+sense determined by |ccw| is less than or equal to $180^\circ$.
+
+If the pen polygon has only two edges, they could both be parallel to |(dx,dy)|.
+In this case, we must be careful to stop after crossing the first such edge in
+order to avoid an infinite loop.
+
+@<Declarations@>=
+static int mp_get_turn_amt (MP mp, mp_knot w, mp_number *dx, mp_number *dy, int ccw);
+
+@ @c
+int mp_get_turn_amt (MP mp, mp_knot w, mp_number *dx, mp_number *dy, int ccw)
+{
+ int s = 0; /* turn amount so far */
+ mp_number arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ if (ccw) {
+ int t;
+ mp_knot ww = mp_next_knot(w);
+ do {
+ set_number_from_subtraction(arg1, ww->x_coord, w->x_coord);
+ set_number_from_subtraction(arg2, ww->y_coord, w->y_coord);
+ t = ab_vs_cd(*dy, arg1, *dx, arg2);
+ if (t < 0) {
+ break;
+ } else {
+ ++s;
+ w = ww;
+ ww = mp_next_knot(ww);
+ }
+ } while (t > 0);
+ } else {
+ mp_knot ww = mp_prev_knot(w);
+ set_number_from_subtraction(arg1, w->x_coord, ww->x_coord);
+ set_number_from_subtraction(arg2, w->y_coord, ww->y_coord);
+ while (ab_vs_cd(*dy, arg1, *dx, arg2) < 0) {
+ --s;
+ w = ww;
+ ww = mp_prev_knot(ww);
+ set_number_from_subtraction(arg1, w->x_coord, ww->x_coord);
+ set_number_from_subtraction(arg2, w->y_coord, ww->y_coord);
+ }
+ }
+ free_number(arg1);
+ free_number(arg2);
+ return s;
+}
+
+@ When we're all done, the final offset is |w0| and the final curve direction is
+|(dxin,dyin)|. With this knowledge of the incoming direction at |c|, we can
+correct |mp_info(c)| which was erroneously based on an incoming offset of~|h|.
+
+@<Fix the offset change in |mp_knot_info(c)| and set |c| to the return value of...@>=
+mp->spec_offset = mp_knot_info(c) - zero_off;
+if (mp_next_knot(c) == c) {
+ mp_knot_info(c) = zero_off + n;
+} else {
+ mp_knot_info(c) += k_needed;
+ while (w0 != h) {
+ mp_knot_info(c) += 1;
+ w0 = mp_next_knot(w0);
+ }
+ while (mp_knot_info(c) <= zero_off - n) {
+ mp_knot_info(c) += n;
+ }
+ while (mp_knot_info(c) > zero_off) {
+ mp_knot_info(c) -= n;
+ }
+ ;
+ if ((mp_knot_info(c) != zero_off) && ab_vs_cd(dy0, dxin, dx0, dyin) >= 0) {
+ mp_knot_info(c) += n;
+ }
+}
+
+@ Finally we want to reduce the general problem to situations that
+|fin_offset_prep| can handle. We split the cubic into at most three parts with
+respect to $d_{k-1}$, and apply |fin_offset_prep| to each part.
+
+@<Complete the offset splitting process@>=
+ww = mp_prev_knot(w);
+@<Compute (case 2) test coefficients |(t0,t1,t2)| for $d(t)$ versus $d_k$ or $d_{k-1}$@>
+@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set |t:=fraction_one+1|@>
+if (number_greater(t, fraction_one_t)) {
+ mp_fin_offset_prep(mp, p, w, &x0, &x1, &x2, &y0, &y1, &y2, 1, turn_amt);
+} else {
+ mp_split_cubic(mp, p, &t);
+ r = mp_next_knot(p);
+ set_number_from_of_the_way(x1a, t, x0, x1);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2a, t, x1a, x1);
+ set_number_from_of_the_way(y1a, t, y0, y1);
+ set_number_from_of_the_way(y1, t, y1, y2);
+ set_number_from_of_the_way(y2a, t, y1a, y1);
+ mp_fin_offset_prep (mp, p, w, &x0, &x1a, &x2a, &y0, &y1a, &y2a, 1, 0);
+ number_clone(x0, x2a);
+ number_clone(y0, y2a);
+ mp_knot_info(r) = zero_off - 1;
+ if (turn_amt >= 0) {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ set_number_from_of_the_way(t1, t, t1, t2);
+ if (number_positive(t1)) {
+ set_number_to_zero(t1);
+ }
+ number_negated_clone(arg2, t1);
+ number_negated_clone(arg3, t2);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ if (number_greater(t, fraction_one_t)) {
+ number_clone(t, fraction_one_t);
+ }
+ @<Split off another rising cubic for |fin_offset_prep|@>
+ mp_fin_offset_prep(mp, r, ww, &x0, &x1, &x2, &y0, &y1, &y2, -1, 0);
+ } else {
+ mp_fin_offset_prep(mp, r, ww, &x0, &x1, &x2, &y0, &y1, &y2, -1, (-1 - turn_amt));
+ }
+}
+
+@ @<Split off another rising cubic for |fin_offset_prep|@>=
+mp_split_cubic(mp, r, &t);
+mp_knot_info(mp_next_knot(r)) = zero_off + 1;
+set_number_from_of_the_way(x1a, t, x1, x2);
+set_number_from_of_the_way(x1, t, x0, x1);
+set_number_from_of_the_way(x0a, t, x1, x1a);
+set_number_from_of_the_way(y1a, t, y1, y2);
+set_number_from_of_the_way(y1, t, y0, y1);
+set_number_from_of_the_way(y0a, t, y1, y1a);
+mp_fin_offset_prep (mp, mp_next_knot(r), w, &x0a, &x1a, &x2, &y0a, &y1a, &y2, 1, turn_amt);
+number_clone(x2, x0a);
+number_clone(y2, y0a);
+
+@ At this point, the direction of the incoming pen edge is |(-du,-dv)|. When the
+component of $d(t)$ perpendicular to |(-du,-dv)| crosses zero, we need to decide
+whether the directions are parallel or antiparallel. We can test this by finding
+the dot product of $d(t)$ and |(-du,-dv)|, but this should be avoided when the
+value of |turn_amt| already determines the answer. If |t2<0|, there is one
+crossing and it is antiparallel only if |turn_amt>=0|. If |turn_amt<0|, there
+should always be at least one crossing and the first crossing cannot be
+antiparallel.
+
+@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set...@>=
+crossing_point(t, t0, t1, t2);
+if (turn_amt >= 0) {
+ if (number_negative(t2)) {
+ number_clone(t, fraction_one_t);
+ number_add_scaled(t, 1);
+ } else {
+ mp_number tmp, arg1, r1;
+ new_fraction(r1);
+ new_number(tmp);
+ new_number(arg1);
+ set_number_from_of_the_way(u0, t, x0, x1);
+ set_number_from_of_the_way(u1, t, x1, x2);
+ set_number_from_of_the_way(tmp, t, u0, u1);
+ number_negated_clone(arg1, du);
+ take_fraction(ss, arg1, tmp);
+ set_number_from_of_the_way(v0, t, y0, y1);
+ set_number_from_of_the_way(v1, t, y1, y2);
+ set_number_from_of_the_way(tmp, t, v0, v1);
+ number_negated_clone(arg1, dv);
+ take_fraction(r1, arg1, tmp);
+ number_add(ss, r1);
+ free_number(tmp);
+ if (number_negative(ss)) {
+ number_clone(t, fraction_one_t);
+ number_add_scaled(t, 1);
+ }
+ free_number(arg1);
+ free_number(r1);
+ }
+} else if (number_greater(t, fraction_one_t)) {
+ number_clone(t, fraction_one_t);
+}
+
+@ If the cubic almost has a cusp, it is a numerically ill-conditioned problem to
+decide which way it loops around but that's OK as long we're consistent. To make
+|doublepath| envelopes work properly, reversing the path should always change
+the sign of |turn_amt|.
+
+@<Decide on the net change in pen offsets and set |turn_amt|@>=
+{
+ int sign = ab_vs_cd(dx, dyin, dxin, dy);
+ if (sign < 0) {
+ d_sign = -1;
+ } else if (sign == 0) {
+ d_sign = 0;
+ } else {
+ d_sign = 1;
+ }
+}
+if (d_sign == 0) {
+ @<Check rotation direction based on node position@>
+}
+if (d_sign == 0) {
+ if (number_zero(dx)) {
+ d_sign = number_positive(dy) ? 1 : -1;
+ } else {
+ d_sign = number_positive(dx) ? 1 : -1;
+ }
+}
+@<Make |ss| negative if and only if the total change in direction is more than $180^\circ$@>
+turn_amt = mp_get_turn_amt(mp, w, &dxin, &dyin, (d_sign > 0));
+if (number_negative(ss)) {
+ turn_amt = turn_amt - d_sign * n;
+}
+
+@ We check rotation direction by looking at the vector connecting the current
+node with the next. If its angle with incoming and outgoing tangents has the same
+sign, we pick this as |d_sign|, since it means we have a flex, not a cusp.
+Otherwise we proceed to the cusp code.
+
+@<Check rotation direction based on node position@>=
+{
+ int t;
+ set_number_from_subtraction(u0, q->x_coord, p->x_coord);
+ set_number_from_subtraction(u1, q->y_coord, p->y_coord);
+ t = ab_vs_cd(dx, u1, u0, dy) + ab_vs_cd(u0, dyin, dxin, u1);
+ // number_half(t);
+ if (t < 0) {
+ d_sign = -1;
+ } else if (t == 0) {
+ d_sign = 0;
+ } else {
+ d_sign = 1;
+ }
+}
+
+@ In order to be invariant under path reversal, the result of this computation
+should not change when |x0|, |y0|, $\ldots$ are all negated and |(x0,y0)| is then
+swapped with |(x2,y2)|. We make use of the identities |take_fraction(-a,-b) =
+take_fraction(a,b)| and |t_of_the_way(-a,-b) = - (t_of_the_way(a,b))|.
+
+@<Make |ss| negative if and only if the total change in direction is...@>=
+{
+ mp_number r1, r2, arg1;
+ new_number(arg1);
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, x0, y2);
+ take_fraction(r2, x2, y0);
+ number_half(r1);
+ number_half(r2);
+ set_number_from_subtraction(t0, r1, r2);
+ set_number_from_addition(arg1, y0, y2);
+ take_fraction(r1, x1, arg1);
+ set_number_from_addition(arg1, x0, x2);
+ /*|take_fraction(r1, y1, arg1);|*//* The old one, is it correct ?*/
+ take_fraction(r2, y1, arg1);
+ number_half(r1);
+ number_half(r2);
+ set_number_from_subtraction(t1, r1, r2);
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+}
+if (number_zero(t0)) {
+ set_number_from_scaled(t0, d_sign); /* path reversal always negates |d_sign| */
+}
+if (number_positive(t0)) {
+ mp_number arg3;
+ new_number(arg3);
+ number_negated_clone(arg3, t0);
+ crossing_point(t, t0, t1, arg3);
+ free_number(arg3);
+ set_number_from_of_the_way(u0, t, x0, x1);
+ set_number_from_of_the_way(u1, t, x1, x2);
+ set_number_from_of_the_way(v0, t, y0, y1);
+ set_number_from_of_the_way(v1, t, y1, y2);
+} else {
+ mp_number arg1;
+ new_number(arg1);
+ number_negated_clone(arg1, t0);
+ crossing_point(t, arg1, t1, t0);
+ free_number(arg1);
+ set_number_from_of_the_way(u0, t, x2, x1);
+ set_number_from_of_the_way(u1, t, x1, x0);
+ set_number_from_of_the_way(v0, t, y2, y1);
+ set_number_from_of_the_way(v1, t, y1, y0);
+}
+{
+ mp_number tmp1, tmp2, r1, r2, arg1;
+ new_fraction(r1);
+ new_fraction(r2);
+ new_number(arg1);
+ new_number(tmp1);
+ new_number(tmp2);
+ set_number_from_of_the_way(tmp1, t, u0, u1);
+ set_number_from_of_the_way(tmp2, t, v0, v1);
+ set_number_from_addition(arg1, x0, x2);
+ take_fraction(r1, arg1, tmp1);
+ set_number_from_addition(arg1, y0, y2);
+ take_fraction(r2, arg1, tmp2);
+ set_number_from_addition(ss, r1, r2);
+ free_number(arg1);
+ free_number(r1);
+ free_number(r2);
+ free_number(tmp1);
+ free_number(tmp2);
+}
+
+@ Here's a routine that prints an envelope spec in symbolic form. It assumes that
+the |cur_pen| has not been walked around to the first offset.
+
+@c
+static void mp_print_spec (MP mp, mp_knot cur_spec, mp_knot cur_pen, const char *s)
+{
+ mp_knot w; /* the current pen offset */
+ mp_knot p = cur_spec; /* list traversal */
+ mp_print_diagnostic(mp, "Envelope spec", s, 1);
+ w = mp_pen_walk(mp, cur_pen, mp->spec_offset);
+ mp_print_ln(mp);
+ mp_print_two(mp, &(cur_spec->x_coord), &(cur_spec->y_coord));
+ mp_print_str(mp, " % beginning with offset ");
+ mp_print_two(mp, &(w->x_coord), &(w->y_coord));
+ do {
+ while (1) {
+ mp_knot q = mp_next_knot(p);
+ @<Print the cubic between |p| and |q|@>
+ p = q;
+ if ((p == cur_spec) || (mp_knot_info(p) != zero_off)) {
+ break;
+ }
+ }
+ if (mp_knot_info(p) != zero_off) {
+ @<Update |w| as indicated by |mp_knot_info(p)| and print an explanation@>
+ }
+ } while (p != cur_spec);
+ mp_print_nl(mp, " & cycle");
+ mp_end_diagnostic(mp, 1);
+}
+
+@ @<Update |w| as indicated by |mp_knot_info(p)| and print an explanation@>=
+w = mp_pen_walk (mp, w, (mp_knot_info(p) - zero_off));
+mp_print_str(mp, " % ");
+if (mp_knot_info(p) > zero_off) {
+ mp_print_str(mp, "counter");
+}
+mp_print_str(mp, "clockwise to offset ");
+mp_print_two(mp, &(w->x_coord), &(w->y_coord));
+
+@ @<Print the cubic between |p| and |q|@>=
+mp_print_nl(mp, " .. controls ");
+mp_print_two(mp, &(p->right_x), &(p->right_y));
+mp_print_str(mp, " and ");
+mp_print_two(mp, &(q->left_x), &(q->left_y));
+mp_print_nl(mp, " .. ");
+mp_print_two(mp, &(q->x_coord), &(q->y_coord));
+
+@ Once we have an envelope spec, the remaining task to construct the actual
+envelope by offsetting each cubic as determined by the |info| fields in the
+knots. First we use |offset_prep| to convert the |c| into an envelope spec. Then
+we add the offsets so that |c| becomes a cyclic path that represents the
+envelope.
+
+The |linejoin| and |miterlimit| parameters control the treatment of points where the
+pen offset changes, and |linecap| controls the endpoints of a |doublepath|. The
+endpoints are easily located because |c| is given in undoubled form and then
+doubled in this procedure. We use |spec_p1| and |spec_p2| to keep track of the
+endpoints and treat them like very sharp corners. Butt end caps are treated like
+beveled joins; round end caps are treated like round joins; and square end caps
+are achieved by setting |join_type:=3|.
+
+None of these parameters apply to inside joins where the convolution tracing has
+retrograde lines. In such cases we use a simple connect-the-endpoints approach
+that is achieved by setting |join_type:=2|.
+
+@c
+static mp_knot mp_make_envelope (MP mp, mp_knot c, mp_knot h, int linejoin, int linecap, mp_number *miterlimit)
+{
+ mp_knot p, q, r, q0; /* for manipulating the path */
+ mp_knot w, w0; /* the pen knot for the current offset */
+ int k, k0; /* controls pen edge insertion */
+ mp_number qx, qy; /* unshifted coordinates of |q| */
+ mp_fraction dxin, dyin, dxout, dyout; /* directions at |q| when square or mitered */
+ int join_type = 0; /* codes |0..3| for mitered, round, beveled, or square */
+ @<Other local variables for |make_envelope|@>
+ new_number(max_ht);
+ new_number(tmp);
+ new_fraction(dxin);
+ new_fraction(dyin);
+ new_fraction(dxout);
+ new_fraction(dyout);
+ mp->spec_p1 = NULL;
+ mp->spec_p2 = NULL;
+ new_number(qx);
+ new_number(qy);
+ @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>
+ @<Use |offset_prep| to compute the envelope spec then walk |h| around to the initial offset@>
+ w = h;
+ p = c;
+ do {
+ q = mp_next_knot(p);
+ q0 = q;
+ number_clone(qx, q->x_coord);
+ number_clone(qy, q->y_coord);
+ k = mp_knot_info(q);
+ k0 = k;
+ w0 = w;
+ if (k != zero_off) {
+ @<Set |join_type| to indicate how to handle offset changes at~|q|@>
+ }
+ @<Add offset |w| to the cubic from |p| to |q|@>
+ while (k != zero_off) {
+ @<Step |w| and move |k| one step closer to |zero_off|@>
+ if ((join_type == 1) || (k == zero_off)) {
+ mp_number xtot, ytot;
+ new_number(xtot);
+ new_number(ytot);
+ set_number_from_addition(xtot, qx, w->x_coord);
+ set_number_from_addition(ytot, qy, w->y_coord);
+ q = mp_insert_knot(mp, q, &xtot, &ytot);
+ free_number(xtot);
+ free_number(ytot);
+ }
+ }
+ if (q != mp_next_knot(p)) {
+ @<Set |p=mp_link(p)| and add knots between |p| and |q| as required by |join_type|@>
+ }
+ p = q;
+ } while (q0 != c);
+ free_number(max_ht);
+ free_number(tmp);
+ free_number(qx);
+ free_number(qy);
+ free_number(dxin);
+ free_number(dyin);
+ free_number(dxout);
+ free_number(dyout);
+ return c;
+}
+
+@ @<Use |offset_prep| to compute the envelope spec then walk |h| around to...@>=
+c = mp_offset_prep (mp, c, h);
+if (number_positive(internal_value(mp_tracing_specs_internal))) {
+ mp_print_spec(mp, c, h, "");
+}
+h = mp_pen_walk (mp, h, mp->spec_offset);
+
+@ Mitered and squared-off joins depend on path directions that are difficult to
+compute for degenerate cubics. The envelope spec computed by |offset_prep| can
+have degenerate cubics only if the entire cycle collapses to a single degenerate
+cubic. Setting |join_type:=2| in this case makes the computed envelope degenerate
+as well.
+
+@<Set |join_type| to indicate how to handle offset changes at~|q|@>=
+if (k < zero_off) {
+ join_type = 2; /* mp_beveled_linejoin_code */
+} else {
+ if ((q != mp->spec_p1) && (q != mp->spec_p2)) {
+ join_type = linejoin;
+ } else if (linecap == mp_squared_linecap_code) {
+ join_type = 3; /* mp_weird_linejoin_code */
+ } else {
+ join_type = 2 - linecap; /* mp_beveled_linejoin_code - linecap */
+ }
+ if ((join_type == 0) || (join_type == 3)) { /* mp_mitered_linejoin_code || mp_weird_linejoin_code */
+ @<Set the incoming and outgoing directions at |q|; in case of degeneracy set |join_type:=2|@>
+ if (join_type == 0) { /* mp_mitered_linejoin_code */
+ @<If |miterlimit| is less than the secant of half the angle at |q| then set |join_type:=2|@>
+ }
+ }
+}
+
+@ @<If |miterlimit| is less than the secant of half the angle at |q|...@>=
+mp_number r1, r2;
+new_fraction(r1);
+new_fraction(r2);
+take_fraction(r1, dxin, dxout);
+take_fraction(r2, dyin, dyout);
+number_add(r1, r2);
+number_half(r1);
+number_add(r1, fraction_half_t);
+take_fraction(tmp, *miterlimit, r1);
+if (number_less(tmp, unity_t)) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, *miterlimit, tmp);
+ if (number_less(ret, unity_t)) {
+ join_type = 2;
+ }
+ free_number(ret);
+}
+free_number(r1);
+free_number(r2);
+
+@ @<Other local variables for |make_envelope|@>=
+mp_number tmp; /* a temporary value */
+
+@ The coordinates of |p| have already been shifted unless |p| is the first knot
+in which case they get shifted at the very end.
+
+@<Add offset |w| to the cubic from |p| to |q|@>=
+number_add(p->right_x, w->x_coord);
+number_add(p->right_y, w->y_coord);
+number_add(q->left_x, w->x_coord);
+number_add(q->left_y, w->y_coord);
+number_add(q->x_coord, w->x_coord);
+number_add(q->y_coord, w->y_coord);
+mp_left_type(q) = mp_explicit_knot;
+mp_right_type(q) = mp_explicit_knot;
+
+@ @<Step |w| and move |k| one step closer to |zero_off|@>=
+if (k > zero_off) {
+ w = mp_next_knot(w);
+ --k;
+} else {
+ w = mp_prev_knot(w);
+ ++k;
+}
+
+@ The cubic from |q| to the new knot at |(x,y)| becomes a line segment and the
+|mp_right_x| and |mp_right_y| fields of |r| are set from |q|. This is done in
+case the cubic containing these control points is \quote {yet to be examined.}
+
+@<Declarations@>=
+static mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number *x, mp_number *y);
+
+@ @c
+mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number *x, mp_number *y)
+{
+ /* returns the inserted knot */
+ mp_knot r = mp_new_knot(mp);
+ mp_knot n = mp_next_knot(q);
+ mp_next_knot(r) = n;
+ mp_prev_knot(n) = r;
+ mp_prev_knot(r) = q;
+ mp_next_knot(q) = r;
+ number_clone(r->right_x, q->right_x);
+ number_clone(r->right_y, q->right_y);
+ number_clone(r->x_coord, *x);
+ number_clone(r->y_coord, *y);
+ number_clone(q->right_x, q->x_coord);
+ number_clone(q->right_y, q->y_coord);
+ number_clone(r->left_x, r->x_coord);
+ number_clone(r->left_y, r->y_coord);
+ mp_left_type(r) = mp_explicit_knot;
+ mp_right_type(r) = mp_explicit_knot;
+ mp_originator(r) = mp_program_code;
+ mp_knotstate(r) = mp_regular_knot;
+ return r;
+}
+
+@ After setting |p:=mp_link(p)|, either |join_type=1| or |q=mp_link(p)|.
+
+@<Set |p=mp_link(p)| and add knots between |p| and |q| as...@>=
+p = mp_next_knot(p);
+if ((join_type == 0) || (join_type == 3)) {
+ if (join_type == 0) {
+ @<Insert a new knot |r| between |p| and |q| as required for a mitered join@>
+ } else {
+ @<Make |r| the last of two knots inserted between |p| and |q| to form a squared join@>
+ }
+ if (r != NULL) {
+ number_clone(r->right_x, r->x_coord);
+ number_clone(r->right_y, r->y_coord);
+ }
+}
+
+@ For very small angles, adding a knot is unnecessary and would cause numerical
+problems, so we just set |r:=NULL| in that case.
+
+@d near_zero_angle_k mp->math->md_near_zero_angle_t
+
+@<Insert a new knot |r| between |p| and |q| as required for a mitered join@>=
+mp_number det; /* a determinant used for mitered join calculations */
+mp_number absdet;
+mp_number r1, r2;
+new_fraction(r1);
+new_fraction(r2);
+new_fraction(det);
+new_fraction(absdet);
+take_fraction(r1, dyout, dxin);
+take_fraction(r2, dxout, dyin);
+set_number_from_subtraction(det, r1, r2);
+number_abs_clone(absdet, det);
+if (number_less(absdet, near_zero_angle_k)) {
+ r = NULL; /* sine $<10^{-4}$ */
+} else {
+ mp_number xtot, ytot, xsub, ysub;
+ new_fraction(xsub);
+ new_fraction(ysub);
+ new_number(xtot);
+ new_number(ytot);
+ set_number_from_subtraction(tmp, q->x_coord, p->x_coord);
+ take_fraction(r1, tmp, dyout);
+ set_number_from_subtraction(tmp, q->y_coord, p->y_coord);
+ take_fraction(r2, tmp, dxout);
+ set_number_from_subtraction(tmp, r1, r2);
+ make_fraction(r1, tmp, det);
+ number_clone(tmp, r1);
+ take_fraction(xsub, tmp, dxin);
+ take_fraction(ysub, tmp, dyin);
+ set_number_from_addition(xtot, p->x_coord, xsub);
+ set_number_from_addition(ytot, p->y_coord, ysub);
+ r = mp_insert_knot(mp, p, &xtot, &ytot);
+ free_number(xtot);
+ free_number(ytot);
+ free_number(xsub);
+ free_number(ysub);
+}
+free_number(r1);
+free_number(r2);
+free_number(det);
+free_number(absdet);
+
+@ @<Make |r| the last of two knots inserted between |p| and |q| to form a...@>=
+mp_number ht_x, ht_y; /* perpendicular to the segment from |p| to |q| */
+mp_number ht_x_abs, ht_y_abs; /* absolutes */
+mp_number xtot, ytot, xsub, ysub;
+new_fraction(xsub);
+new_fraction(ysub);
+new_number(xtot);
+new_number(ytot);
+new_fraction(ht_x);
+new_fraction(ht_y);
+new_fraction(ht_x_abs);
+new_fraction(ht_y_abs);
+set_number_from_subtraction(ht_x, w->y_coord, w0->y_coord);
+set_number_from_subtraction(ht_y, w0->x_coord, w->x_coord);
+number_abs_clone(ht_x_abs, ht_x);
+number_abs_clone(ht_y_abs, ht_y);
+while (number_less(ht_x_abs, fraction_half_t) && number_less(ht_y_abs, fraction_half_t)) {
+ number_double(ht_x);
+ number_double(ht_y);
+ number_abs_clone(ht_x_abs, ht_x);
+ number_abs_clone(ht_y_abs, ht_y);
+}
+@<Scan the pen polygon between |w0| and |w| and make |max_ht| the range dot product with |(ht_x,ht_y)|@>
+{
+ mp_number r1 ,r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, dxin, ht_x);
+ take_fraction(r2, dyin, ht_y);
+ number_add(r1, r2);
+ make_fraction(tmp, max_ht, r1);
+ free_number(r1);
+ free_number(r2);
+}
+take_fraction(xsub, tmp, dxin);
+take_fraction(ysub, tmp, dyin);
+set_number_from_addition(xtot, p->x_coord, xsub);
+set_number_from_addition(ytot, p->y_coord, ysub);
+r = mp_insert_knot(mp, p, &xtot, &ytot);
+{
+ mp_number r1 ,r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, dxout, ht_x);
+ take_fraction(r2, dyout, ht_y);
+ number_add(r1, r2);
+ make_fraction(tmp, max_ht, r1);
+ free_number(r1);
+ free_number(r2);
+}
+take_fraction(xsub, tmp, dxout);
+take_fraction(ysub, tmp, dyout);
+set_number_from_addition(xtot, q->x_coord, xsub);
+set_number_from_addition(ytot, q->y_coord, ysub);
+r = mp_insert_knot(mp, r, &xtot, &ytot);
+free_number(xsub);
+free_number(ysub);
+free_number(xtot);
+free_number(ytot);
+free_number(ht_x);
+free_number(ht_y);
+free_number(ht_x_abs);
+free_number(ht_y_abs);
+
+@ @<Other local variables for |make_envelope|@>=
+mp_number max_ht; /* maximum height of the pen polygon above the |w0|-|w| line */
+int kk; /* keeps track of the pen vertices being scanned */
+mp_knot ww; /* the pen vertex being tested */
+
+@ The dot product of the vector from |w0| to |ww| with |(ht_x,ht_y)| ranges
+from zero to |max_ht|.
+
+@<Scan the pen polygon between |w0| and |w| and make |max_ht| the range...@>=
+set_number_to_zero(max_ht);
+kk = zero_off;
+ww = w;
+while (1) {
+ @<Step |ww| and move |kk| one step closer to |k0|@>
+ if (kk == k0) {
+ break;
+ } else {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ set_number_from_subtraction(tmp, ww->x_coord, w0->x_coord);
+ take_fraction(r1, tmp, ht_x);
+ set_number_from_subtraction(tmp, ww->y_coord, w0->y_coord);
+ take_fraction(r2, tmp, ht_y);
+ set_number_from_addition(tmp, r1, r2);
+ free_number(r1);
+ free_number(r2);
+ if (number_greater(tmp, max_ht)) {
+ number_clone(max_ht, tmp);
+ }
+ }
+}
+
+@ @<Step |ww| and move |kk| one step closer to |k0|@>=
+if (kk > k0) {
+ ww = mp_next_knot(ww);
+ --kk;
+} else {
+ ww = mp_prev_knot(ww);
+ ++kk;
+}
+
+@ @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>=
+if (mp_left_type(c) == mp_endpoint_knot) {
+ mp->spec_p1 = mp_htap_ypoc(mp, c);
+ mp->spec_p2 = mp->path_tail;
+ mp_originator(mp->spec_p1) = mp_program_code;
+ mp_knotstate(mp->spec_p1) = mp_regular_knot;
+ mp_prev_knot(mp->spec_p1) = mp_next_knot(mp->spec_p2);
+ mp_next_knot(mp->spec_p2) = mp_next_knot(mp->spec_p1);
+ mp_prev_knot(c) = mp->spec_p1;
+ mp_next_knot(mp->spec_p1) = c;
+ mp_remove_cubic(mp, mp->spec_p1);
+ c = mp->spec_p1;
+ if (c != mp_next_knot(c)) {
+ mp_originator(mp->spec_p2) = mp_program_code;
+ mp_knotstate(mp->spec_p2) = mp_regular_knot;
+ mp_remove_cubic(mp, mp->spec_p2);
+ } else {
+ @<Make |c| look like a cycle of length one@>
+ }
+}
+
+@ @<Make |c| look like a cycle of length one@>=
+mp_left_type(c) = mp_explicit_knot;
+mp_right_type(c) = mp_explicit_knot;
+number_clone(c->left_x, c->x_coord);
+number_clone(c->left_y, c->y_coord);
+number_clone(c->right_x, c->x_coord);
+number_clone(c->right_y, c->y_coord);
+
+@ In degenerate situations we might have to look at the knot preceding~|q|. That
+knot is |p| but if |p<>c|, its coordinates have already been offset by |w|.
+
+@<Set the incoming and outgoing directions at |q|; in case of...@>=
+set_number_from_subtraction(dxin, q->x_coord, q->left_x);
+set_number_from_subtraction(dyin, q->y_coord, q->left_y);
+if (number_zero(dxin) && number_zero(dyin)) {
+ set_number_from_subtraction(dxin, q->x_coord, p->right_x);
+ set_number_from_subtraction(dyin, q->y_coord, p->right_y);
+ if (number_zero(dxin) && number_zero(dyin)) {
+ set_number_from_subtraction(dxin, q->x_coord, p->x_coord);
+ set_number_from_subtraction(dyin, q->y_coord, p->y_coord);
+ if (p != c) {
+ /* the coordinates of |p| have been offset by |w| */
+ number_add(dxin, w->x_coord);
+ number_add(dyin, w->y_coord);
+ }
+ }
+}
+pyth_add(tmp, dxin, dyin);
+if (number_zero(tmp)) {
+ join_type = 2;
+} else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, dxin, tmp);
+ number_clone(dxin, r1);
+ make_fraction(r1, dyin, tmp);
+ number_clone(dyin, r1);
+ free_number(r1);
+ @<Set the outgoing direction at |q|@>
+}
+
+@ If |q=c| then the coordinates of |r| and the control points between |q| and~|r|
+have already been offset by |h|.
+
+@<Set the outgoing direction at |q|@>=
+set_number_from_subtraction(dxout, q->right_x, q->x_coord);
+set_number_from_subtraction(dyout, q->right_y, q->y_coord);
+if (number_zero(dxout) && number_zero(dyout)) {
+ r = mp_next_knot(q);
+ set_number_from_subtraction(dxout, r->left_x, q->x_coord);
+ set_number_from_subtraction(dyout, r->left_y, q->y_coord);
+ if (number_zero(dxout) && number_zero(dyout)) {
+ set_number_from_subtraction(dxout, r->x_coord, q->x_coord);
+ set_number_from_subtraction(dyout, r->y_coord, q->y_coord);
+ }
+}
+if (q == c) {
+ number_subtract(dxout, h->x_coord);
+ number_subtract(dyout, h->y_coord);
+}
+pyth_add(tmp, dxout, dyout);
+if (number_zero(tmp)) {
+ /* |mp_confusion(mp, "degenerate spec");| */
+ @:this can't happen degerate spec}{\quad degenerate spec@>
+ /*
+
+ But apparently, it actually can happen. The test case is this:
+
+ path p;
+ linejoin := mitered;
+ p:= (10,0)..(0,10)..(-10,0)..(0,-10)..cycle;
+ addto currentpicture contour p withpen pensquare;
+
+ The reason for failure here is the addition of |r != q| in revision
+ 1757 in \quote {Advance |p| to node |q|, removing any ``dead} cubics'',
+ which itself was needed to fix a bug with disappearing knots in a
+ path that was rotated exactly 45 degrees (luatex.org bug 530).
+ */
+} else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, dxout, tmp);
+ number_clone(dxout, r1);
+ make_fraction(r1, dyout, tmp);
+ number_clone(dyout, r1);
+ free_number(r1);
+}
+
+@* Direction and intersection times.
+
+A path of length $n$ is defined parametrically by functions $x(t)$ and $y(t)$,
+for |0<=t<=n|; we can regard $t$ as the \quote {time} at which the path reaches the
+point $\bigl(x(t),y(t)\bigr)$. In this section of the program we shall consider
+operations that determine special times associated with given paths: the first
+time that a path travels in a given direction, and a pair of times at which two
+paths cross each other.
+
+@ Let's start with the easier task. The function |find_direction_time| is given a
+direction |(x,y)| and a path starting at~|h|. If the path never travels in
+direction |(x,y)|, the direction time will be~|-1|; otherwise it will be
+nonnegative.
+
+Certain anomalous cases can arise: If |(x,y)=(0,0)|, so that the given direction
+is undefined, the direction time will be~0. If $\bigl(x'(t), y'(t)\bigr)=(0,0)$,
+so that the path direction is undefined, it will be assumed to match any given
+direction at time~|t|.
+
+The routine solves this problem in nondegenerate cases by rotating the path and
+the given direction so that |(x,y)=(1,0)|; i.e., the main task will be to find
+when a given path first travels \quote {due east.}
+
+@c
+static void mp_find_direction_time (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig, mp_knot h)
+{
+ mp_number max; /* $\max\bigl(\vert x\vert,\vert y\vert\bigr)$ */
+ mp_knot p, q; /* for list traversal */
+ mp_number n; /* the direction time at knot |p| */
+ mp_number tt; /* the direction time within a cubic */
+ mp_number abs_x, abs_y; /* Other local variables for |find_direction_time| */
+ mp_number x1, x2, x3, y1, y2, y3; /* multiples of rotated derivatives */
+ mp_number phi; /* angles of exit and entry at a knot */
+ mp_number t; /* temp storage */
+ mp_number x, y;
+ new_number(max);
+ new_number(x1);
+ new_number(x2);
+ new_number(x3);
+ new_number(y1);
+ new_number(y2);
+ new_number(y3);
+ new_fraction(t);
+ new_angle(phi);
+ set_number_to_zero(*ret); /* just in case */
+ new_number(x);
+ new_number(y);
+ new_number(abs_x);
+ new_number(abs_y);
+ new_number(n);
+ new_fraction(tt);
+ number_clone(x, *x_orig);
+ number_clone(y, *y_orig);
+ number_abs_clone(abs_x, *x_orig);
+ number_abs_clone(abs_y, *y_orig);
+ /*
+ Normalize the given direction for better accuracy; but |return| with zero
+ result if it's zero
+ */
+ if (number_less(abs_x, abs_y)) {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, x, abs_y);
+ number_clone(x, r1);
+ free_number(r1);
+ if (number_positive(y)) {
+ number_clone(y, fraction_one_t);
+ } else {
+ number_negated_clone(y, fraction_one_t);
+ }
+ } else if (number_zero(x)) {
+ goto FREE;
+ } else {
+ mp_number r1;
+ new_fraction(r1);
+ make_fraction(r1, y, abs_x);
+ number_clone(y, r1);
+ free_number(r1);
+ if (number_positive(x)) {
+ number_clone(x, fraction_one_t);
+ } else {
+ number_negated_clone(x, fraction_one_t);
+ }
+ }
+ p = h;
+ while (1) {
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ break;
+ } else {
+ q = mp_next_knot(p);
+ @<Rotate the cubic between |p| and |q|; then |goto found| if the rotated cubic travels due east at some time |tt|; but |break| if an entire cyclic path has been traversed@>
+ p = q;
+ number_add(n, unity_t);
+ }
+ }
+ set_number_to_unity(*ret);
+ number_negate(*ret);
+ goto FREE;
+ FOUND:
+ set_number_from_addition(*ret, n, tt);
+ goto FREE;
+ FREE:
+ free_number(x);
+ free_number(y);
+ free_number(abs_x);
+ free_number(abs_y);
+ /* Free local variables for |find_direction_time| */
+ free_number(x1);
+ free_number(x2);
+ free_number(x3);
+ free_number(y1);
+ free_number(y2);
+ free_number(y3);
+ free_number(t);
+ free_number(phi);
+ free_number(n);
+ free_number(max);
+ free_number(tt);
+}
+
+@ Since we're interested in the tangent directions, we work with the derivative
+$${1\over3}B'(x_0,x_1,x_2,x_3;t)= B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of
+$B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scale-d up in
+order to achieve better accuracy.
+
+The given path may turn abruptly at a knot, and it might pass the critical
+tangent direction at such a time. Therefore we remember the direction |phi| in
+which the previous rotated cubic was traveling. (The value of |phi| will be
+undefined on the first cubic, i.e., when |n=0|.)
+
+@<Rotate the cubic between |p| and |q|; then...@>=
+set_number_to_zero(tt);
+/*
+ Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples of the control
+ points of the rotated derivatives.
+*/
+{
+ mp_number absval;
+ new_number(absval);
+ set_number_from_subtraction(x1, p->right_x, p->x_coord);
+ set_number_from_subtraction(x2, q->left_x, p->right_x);
+ set_number_from_subtraction(x3, q->x_coord, q->left_x);
+ set_number_from_subtraction(y1, p->right_y, p->y_coord);
+ set_number_from_subtraction(y2, q->left_y, p->right_y);
+ set_number_from_subtraction(y3, q->y_coord, q->left_y);
+ number_abs_clone(absval, x2);
+ number_abs_clone(max, x1);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, x3);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, y1);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, y2);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ number_abs_clone(absval, y3);
+ if (number_greater(absval, max)) {
+ number_clone(max, absval);
+ }
+ free_number(absval);
+ if (number_zero(max)) {
+ goto FOUND;
+ }
+ while (number_less(max, fraction_half_t)) {
+ number_double(max);
+ number_double(x1);
+ number_double(x2);
+ number_double(x3);
+ number_double(y1);
+ number_double(y2);
+ number_double(y3);
+ }
+ number_clone(t, x1);
+ {
+ mp_number r1, r2;
+ new_fraction(r1);
+ new_fraction(r2);
+ take_fraction(r1, x1, x);
+ take_fraction(r2, y1, y);
+ set_number_from_addition(x1, r1, r2);
+ take_fraction(r1, y1, x);
+ take_fraction(r2, t, y);
+ set_number_from_subtraction(y1, r1, r2);
+ number_clone(t, x2);
+ take_fraction(r1, x2, x);
+ take_fraction(r2, y2, y);
+ set_number_from_addition(x2, r1, r2);
+ take_fraction(r1, y2, x);
+ take_fraction(r2, t, y);
+ set_number_from_subtraction(y2, r1, r2);
+ number_clone(t, x3);
+ take_fraction(r1, x3 ,x);
+ take_fraction(r2, y3, y);
+ set_number_from_addition(x3, r1, r2);
+ take_fraction(r1, y3, x);
+ take_fraction(r2, t, y);
+ set_number_from_subtraction(y3, r1, r2);
+ free_number(r1);
+ free_number(r2);
+ }
+}
+if (number_zero(y1) && (number_zero(x1) || number_positive(x1))) {
+ goto FOUND;
+}
+if (number_positive(n)) {
+ /* Exit to |found| if an eastward direction occurs at knot |p| */
+ mp_number theta;
+ mp_number tmp;
+ new_angle(theta);
+ n_arg(theta, x1, y1);
+ new_angle(tmp);
+ set_number_from_subtraction(tmp, theta, one_eighty_deg_t);
+ if (number_nonnegative(theta) && number_nonpositive(phi) && number_greaterequal(phi, tmp)) {
+ free_number(tmp);
+ free_number(theta);
+ goto FOUND;
+ }
+ set_number_from_addition(tmp, theta, one_eighty_deg_t);
+ if (number_nonpositive(theta) && number_nonnegative(phi) && number_lessequal(phi, tmp)) {
+ free_number(tmp);
+ free_number(theta);
+ goto FOUND;
+ }
+ free_number(tmp);
+ free_number(theta);
+ if (p == h) {
+ break;
+ }
+}
+if (number_nonzero(x3) || number_nonzero(y3)) {
+ n_arg(phi, x3, y3);
+}
+/*
+ Exit to |found| if the curve whose derivatives are specified by
+ |x1,x2,x3,y1,y2,y3| travels eastward at some time~|tt|. In this step we
+ want to use the |crossing_point| routine to find the roots of the
+ quadratic equation $B(y_1,y_2,y_3;t)=0$. Several complications arise: If
+ the quadratic equation has a double root, the curve never crosses zero,
+ and |crossing_point| will find nothing; this case occurs iff
+ $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic equation has simple
+ roots, or only one root, we may have to negate it so that
+ $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root.
+ And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is
+ identically zero.
+*/
+if (number_negative(x1) && number_negative(x2) && number_negative(x3)) {
+ goto DONE;
+}
+{
+ if (ab_vs_cd(y1, y3, y2, y2) == 0) {
+ /*
+ Handle the test for eastward directions when $y_1y_3=y_2^2$; either |goto
+ found| or |goto done|.
+ */
+ {
+ if (ab_vs_cd(y1, y2, zero_t, zero_t) < 0) {
+ mp_number tmp, arg2;
+ new_number(tmp);
+ new_number(arg2);
+ set_number_from_subtraction(arg2, y1, y2);
+ make_fraction(t, y1, arg2);
+ free_number(arg2);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2, t, x2, x3);
+ set_number_from_of_the_way(tmp, t, x1, x2);
+ if (number_zero(tmp) || number_positive(tmp)) {
+ free_number(tmp);
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ } else {
+ free_number(tmp);
+ }
+ } else if (number_zero(y3)) {
+ if (number_zero(y1)) {
+ /*
+ Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0| At
+ this point we know that the derivative of |y(t)| is identically zero,
+ and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of
+ traveling east.
+ */
+ {
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ number_negated_clone(arg1, x1);
+ number_negated_clone(arg2, x2);
+ number_negated_clone(arg3, x3);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+ if (number_lessequal(t, fraction_one_t)) {
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ } else if (ab_vs_cd(x1, x3, x2, x2) <= 0) {
+ mp_number arg2;
+ new_number(arg2);
+ set_number_from_subtraction(arg2, x1, x2);
+ make_fraction(t, x1, arg2);
+ free_number(arg2);
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ }
+ }
+ } else if (number_zero(x3) || number_positive(x3)) {
+ set_number_to_unity(tt);
+ goto FOUND;
+ }
+ }
+ goto DONE;
+ }
+ }
+}
+if (number_zero(y1) || number_negative(y1)) {
+ if (number_negative(y1)) {
+ number_negate(y1);
+ number_negate(y2);
+ number_negate(y3);
+ } else if (number_positive(y2)) {
+ number_negate(y2);
+ number_negate(y3);
+ }
+}
+/*
+ Check the places where $B(y_1,y_2,y_3;t)=0$ to see if $B(x_1,x_2,x_3;t)\ge0$
+ The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins |>=0| and has at most two
+ roots, because we know that it isn't identically zero.
+
+ It must be admitted that the |crossing_point| routine is not perfectly
+ accurate; rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or
+ to miss the roots when $y_1y_3<y_2^2$. The rotation process is itself subject
+ to rounding errors. Yet this code optimistically tries to do the right thing.
+*/
+crossing_point(t, y1, y2, y3);
+if (number_greater(t, fraction_one_t)) {
+ goto DONE;
+}
+set_number_from_of_the_way(y2, t, y2, y3);
+set_number_from_of_the_way(x1, t, x1, x2);
+set_number_from_of_the_way(x2, t, x2, x3);
+set_number_from_of_the_way(x1, t, x1, x2);
+if (number_zero(x1) || number_positive(x1)) {
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+}
+if (number_positive(y2)) {
+ set_number_to_zero(y2);
+}
+number_clone(tt, t);
+{
+ mp_number arg1, arg2, arg3;
+ new_number(arg1);
+ new_number(arg2);
+ new_number(arg3);
+ number_negated_clone(arg2, y2);
+ number_negated_clone(arg3, y3);
+ crossing_point(t, arg1, arg2, arg3);
+ free_number(arg1);
+ free_number(arg2);
+ free_number(arg3);
+}
+if (number_greater(t, fraction_one_t)) {
+ goto DONE;
+} else {
+ mp_number tmp;
+ new_number(tmp);
+ set_number_from_of_the_way(x1, t, x1, x2);
+ set_number_from_of_the_way(x2, t, x2, x3);
+ set_number_from_of_the_way(tmp, t, x1, x2);
+ if (number_nonnegative(tmp)) {
+ free_number(tmp);
+ set_number_from_of_the_way(t, t, tt, fraction_one_t);
+ number_clone(tt, t);
+ fraction_to_round_scaled(tt);
+ goto FOUND;
+ }
+ free_number(tmp);
+}
+DONE:
+
+@ The intersection of two cubics can be found by an interesting variant of the
+general bisection scheme described in the introduction to |crossing_point|.\
+Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$, we wish to
+find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$, if an intersection
+exists. First we find the smallest rectangle that encloses the points
+$\{w_0,w_1,w_2,w_3\}$ and check that it overlaps the smallest rectangle that
+encloses $\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect. But
+if the rectangles do overlap, we bisect the intervals, getting new cubics $w'$
+and~$w''$, $z'$~and~$z''$; the intersection routine first tries for an
+intersection between $w'$ and~$z'$, then (if unsuccessful) between $w'$
+and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$, finally (if
+thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful levels of
+bisection we will have determined the intersection times $t_1$ and~$t_2$ to
+$l$~bits of accuracy.
+
+\def\submin{_{\rm min}} \def\submax{_{\rm max}}
+
+As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$ and
+$Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$ themselves.
+We also need one other quantity, $\Delta=2^l(w_0-z_0)$, to determine when the
+enclosing rectangles overlap. Here's why: The $x$~coordinates of~$w(t)$ are
+between $u\submin$ and $u\submax$, and the $x$~coordinates of~$z(t)$ are between
+$x\submin$ and $x\submax$, if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and
+$u\submin= \min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates
+overlap if and only if $u\submin\L x\submax$ and $x\submin\L u\submax$. Letting
+
+$$
+ U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\;
+ U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),
+$$
+
+we have $2^lu\submin=2^lu_0+U\submin$, etc.; the condition for overlap reduces to
+
+$$
+ X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.
+$$
+
+Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly, the quantity
+$2^l(v_0-y_0)$ accounts for the $y$~coordinates. The coordinates of
+$\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases, because of the overlap
+condition; i.e., we know that $X\submin$, $X\submax$, and their relatives are
+bounded, hence $X\submax- U\submin$ and $X\submin-U\submax$ are bounded.
+
+@ Incidentally, if the given cubics intersect more than once, the process just
+sketched will not necessarily find the lexicographically smallest pair
+$(t_1,t_2)$. The solution actually obtained will be smallest in \quote {shuffled
+order}; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and $t_2=(.b_1b_2\ldots
+b_{16})_2$, then we will minimize $a_1b_1a_2b_2\ldots a_{16}b_{16}$, not
+$a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$. Shuffled order agrees with
+lexicographic order if all pairs of solutions $(t_1,t_2)$ and $(t_1',t_2')$ have
+the property that $t_1<t_1'$ iff $t_2<t_2'$; but in general, lexicographic order
+can be quite different, and the bisection algorithm would be substantially less
+efficient if it were constrained by lexicographic order.
+
+For example, suppose that an overlap has been found for $l=3$ and $(t_1,t_2)=
+(.101,.011)$ in binary, but that no overlap is produced by either of the
+alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4. Then there is probably
+an intersection in one of the subintervals $(.1011,.011x)$; but lexicographic
+order would require us to explore $(.1010,.1xxx)$ and $(.1011,.00xx)$ and
+$(.1011,.010x)$ first. We wouldn't want to store all of the subdivision data for
+the second path, so the subdivisions would have to be regenerated many times.
+Such inefficiencies would be associated with every `1' in the binary
+representation of~$t_1$.
+
+@ The subdivision process introduces rounding errors, hence we need to make a
+more liberal test for overlap. It is not hard to show that the computed values of
+$U_i$ differ from the truth by at most~$l$, on level~$l$, hence $U\submin$ and
+$U\submax$ will be at most $3l$ in error. If $\beta$ is an upper bound on the
+absolute error in the computed components of $\Delta=(|delx|,|dely|)$ on
+level~$l$, we will replace the test `$X\submin-U\submax\L|delx|$' by the more
+liberal test `$X\submin-U\submax\L|delx|+|tol|$', where $|tol|=6l+\beta$.
+
+More accuracy is obtained if we try the algorithm first with |tol=0|; the more
+liberal tolerance is used only if an exact approach fails. It is convenient to do
+this double-take by letting `3' in the preceding paragraph be a parameter, which
+is first 0, then 3.
+
+@<Glob...@>=
+unsigned int tol_step; /* either 0 or 3, usually */
+
+@ We shall use an explicit stack to implement the recursive bisection
+method described above. The |bisect_stack| array will contain numerous 5-word
+packets like $(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets
+comprising the 5-word packets for $U$, $V$, $X$, and~$Y$.
+
+The following macros define the allocation of stack positions to
+the quantities needed for bisection-intersection.
+
+@d stack_1(A) mp->bisect_stack[(A)] /* $U_1$, $V_1$, $X_1$, or $Y_1$ */
+@d stack_2(A) mp->bisect_stack[(A)+1] /* $U_2$, $V_2$, $X_2$, or $Y_2$ */
+@d stack_3(A) mp->bisect_stack[(A)+2] /* $U_3$, $V_3$, $X_3$, or $Y_3$ */
+@d stack_min(A) mp->bisect_stack[(A)+3] /* $U\submin$, $V\submin$, $X\submin$, or $Y\submin$ */
+@d stack_max(A) mp->bisect_stack[(A)+4] /* $U\submax$, $V\submax$, $X\submax$, or $Y\submax$ */
+
+@d int_packets 20 /* number of words to represent $U_k$, $V_k$, $X_k$, and $Y_k$ */
+
+@d u_packet(A) ((A)- 5)
+@d v_packet(A) ((A)-10)
+@d x_packet(A) ((A)-15)
+@d y_packet(A) ((A)-20)
+
+@d l_packets (mp->bisect_ptr-int_packets)
+@d r_packets mp->bisect_ptr
+
+@d ul_packet u_packet(l_packets) /* base of $U'_k$ variables */
+@d vl_packet v_packet(l_packets) /* base of $V'_k$ variables */
+@d xl_packet x_packet(l_packets) /* base of $X'_k$ variables */
+@d yl_packet y_packet(l_packets) /* base of $Y'_k$ variables */
+@d ur_packet u_packet(r_packets) /* base of $U''_k$ variables */
+@d vr_packet v_packet(r_packets) /* base of $V''_k$ variables */
+@d xr_packet x_packet(r_packets) /* base of $X''_k$ variables */
+@d yr_packet y_packet(r_packets) /* base of $Y''_k$ variables */
+
+@d u1l stack_1(ul_packet) /* $U'_1$ */
+@d u2l stack_2(ul_packet) /* $U'_2$ */
+@d u3l stack_3(ul_packet) /* $U'_3$ */
+@d v1l stack_1(vl_packet) /* $V'_1$ */
+@d v2l stack_2(vl_packet) /* $V'_2$ */
+@d v3l stack_3(vl_packet) /* $V'_3$ */
+@d x1l stack_1(xl_packet) /* $X'_1$ */
+@d x2l stack_2(xl_packet) /* $X'_2$ */
+@d x3l stack_3(xl_packet) /* $X'_3$ */
+@d y1l stack_1(yl_packet) /* $Y'_1$ */
+@d y2l stack_2(yl_packet) /* $Y'_2$ */
+@d y3l stack_3(yl_packet) /* $Y'_3$ */
+@d u1r stack_1(ur_packet) /* $U''_1$ */
+@d u2r stack_2(ur_packet) /* $U''_2$ */
+@d u3r stack_3(ur_packet) /* $U''_3$ */
+@d v1r stack_1(vr_packet) /* $V''_1$ */
+@d v2r stack_2(vr_packet) /* $V''_2$ */
+@d v3r stack_3(vr_packet) /* $V''_3$ */
+@d x1r stack_1(xr_packet) /* $X''_1$ */
+@d x2r stack_2(xr_packet) /* $X''_2$ */
+@d x3r stack_3(xr_packet) /* $X''_3$ */
+@d y1r stack_1(yr_packet) /* $Y''_1$ */
+@d y2r stack_2(yr_packet) /* $Y''_2$ */
+@d y3r stack_3(yr_packet) /* $Y''_3$ */
+
+@d stack_dx mp->bisect_stack[mp->bisect_ptr] /* stacked value of |delx| */
+@d stack_dy mp->bisect_stack[mp->bisect_ptr+1] /* stacked value of |dely| */
+@d stack_tol mp->bisect_stack[mp->bisect_ptr+2] /* stacked value of |tol| */
+@d stack_uv mp->bisect_stack[mp->bisect_ptr+3] /* stacked value of |uv| */
+@d stack_xy mp->bisect_stack[mp->bisect_ptr+4] /* stacked value of |xy| */
+
+@d int_increment (int_packets+int_packets+5) /* number of stack words per level */
+
+@<Glob...@>=
+mp_number *bisect_stack;
+int bisect_ptr;
+
+@ @<Allocate or initialize ...@>=
+mp->bisect_stack = mp_memory_allocate((size_t) (bistack_size + 1) * sizeof(mp_number));
+for (int i=0; i<bistack_size + 1; i++) {
+ new_number(mp->bisect_stack[i]);
+}
+
+@ @<Dealloc variables@>=
+for (int i=0; i<bistack_size + 1; i++) {
+ free_number(mp->bisect_stack[i]);
+}
+mp_memory_free(mp->bisect_stack);
+
+@ Computation of the min and max is a tedious but fairly fast sequence of
+instructions; exactly four comparisons are made in each branch.
+
+@<Declarations...@>=
+static void mp_set_min_max (MP mp, int v);
+
+@ This was a macro but a function is way more efficient here. @c
+void mp_set_min_max (MP mp, int v)
+{
+ if (number_negative(stack_1(v))) {
+ if (number_nonnegative (stack_3(v))) {
+ if (number_negative(stack_2(v))) {
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ } else {
+ number_clone(stack_min(v), stack_1(v));
+ }
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ number_add(stack_max(v), stack_3(v));
+ if (number_negative(stack_max(v))) {
+ set_number_to_zero(stack_max(v));
+ }
+ } else {
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ number_add(stack_min(v), stack_3(v));
+ if (number_greater(stack_min(v), stack_1(v))) {
+ number_clone(stack_min(v), stack_1(v));
+ }
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ if (number_negative(stack_max(v))) {
+ set_number_to_zero(stack_max(v));
+ }
+ }
+ } else if (number_nonpositive(stack_3(v))) {
+ if (number_positive(stack_2(v))) {
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ } else {
+ number_clone(stack_max(v), stack_1(v));
+ }
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ number_add(stack_min(v), stack_3(v));
+ if (number_positive(stack_min(v))) {
+ set_number_to_zero(stack_min(v));
+ }
+ } else {
+ set_number_from_addition(stack_max(v), stack_1(v), stack_2(v));
+ number_add(stack_max(v), stack_3(v));
+ if (number_less(stack_max(v), stack_1(v))) {
+ number_clone(stack_max(v), stack_1(v));
+ }
+ set_number_from_addition(stack_min(v), stack_1(v), stack_2(v));
+ if (number_positive(stack_min(v))) {
+ set_number_to_zero(stack_min(v));
+ }
+ }
+}
+
+@ It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in the
+integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The |cubic_intersection| routine uses
+global variables |cur_t| and |cur_tt| for this purpose; after successful
+completion, |cur_t| and |cur_tt| will contain |unity| plus the |scaled| values of
+$t_1$ and~$t_2$.
+
+The values of |cur_t| and |cur_tt| will be set to zero if |cubic_intersection|
+finds no intersection. The routine gives up and gives an approximate answer if it
+has backtracked more than 5000 times (otherwise there are cases where several
+minutes of fruitless computation would be possible).
+
+@d max_patience 5000
+
+@<Glob...@>=
+mp_number cur_t;
+mp_number cur_tt; /* controls and results of |cubic_intersection| */
+int time_to_go; /* this many backtracks before giving up */
+mp_number max_t; /* maximum of $2^{l+1}$ so far achieved */
+
+@ @<Initialize table ...@>=
+new_number(mp->cur_t);
+new_number(mp->cur_tt);
+new_number(mp->max_t);
+
+@ @<Dealloc ...@>=
+free_number(mp->cur_t);
+free_number(mp->cur_tt);
+free_number(mp->max_t);
+
+@ The given cubics $B(w_0,w_1,w_2,w_3;t)$ and
+$B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes |(p,mp_link(p))|
+and |(pp,mp_link(pp))|, respectively.
+
+@d half(A) ((A)/2)
+
+@c
+static int mp_cubic_intersection(MP mp, mp_knot p, mp_knot pp, int run)
+{
+ mp_knot q, qq; /* |mp_link(p)|, |mp_link(pp)| */
+ mp_number x_two_t; /* increment bit precision */
+ mp_number x_two_t_low_precision; /* check for low precision */
+ mp->time_to_go = max_patience;
+ set_number_from_scaled(mp->max_t, 2);
+ new_number_clone(x_two_t, two_t);
+ new_number(x_two_t_low_precision);
+ /* added 2 bit of precision */
+ number_double(x_two_t);
+ number_double(x_two_t);
+ set_number_from_double(x_two_t_low_precision, -0.5);
+ number_add(x_two_t_low_precision, x_two_t);
+ @<Initialize for intersections at level zero@>
+ CONTINUE:
+ while (1) {
+ /*
+ When we are in arbitrary precision math, low precisions can lead to
+ acces locations beyond the |stack_size|: in this case we say that
+ there is no intersection.
+ */
+ if (((x_packet (mp->xy))+4)>bistack_size
+ || ((u_packet (mp->uv))+4)>bistack_size
+ || ((y_packet (mp->xy))+4)>bistack_size
+ || ((v_packet (mp->uv))+4)>bistack_size){
+ set_number_from_scaled(mp->cur_t,1);
+ set_number_from_scaled(mp->cur_tt,1);
+ goto NOT_FOUND;
+ }
+ /*
+ Also, low precision can lead to wrong result in comparing so we check
+ that the level of bisection stay low, and later we will also check
+ that the bisection level are safe from approximations.
+ */
+ if (number_greater(mp->max_t, x_two_t)){
+ set_number_from_scaled(mp->cur_t,1);
+ set_number_from_scaled(mp->cur_tt,1);
+ goto NOT_FOUND;
+ }
+ if (number_to_scaled(mp->delx) - mp->tol <= number_to_scaled(stack_max (x_packet (mp->xy))) - number_to_scaled(stack_min (u_packet (mp->uv)))) {
+ if (number_to_scaled(mp->delx) + mp->tol >= number_to_scaled(stack_min (x_packet (mp->xy))) - number_to_scaled(stack_max (u_packet (mp->uv)))) {
+ if (number_to_scaled(mp->dely) - mp->tol <= number_to_scaled(stack_max (y_packet (mp->xy))) - number_to_scaled(stack_min (v_packet (mp->uv)))) {
+ if (number_to_scaled(mp->dely) + mp->tol >= number_to_scaled(stack_min (y_packet (mp->xy))) - number_to_scaled(stack_max (v_packet (mp->uv)))) {
+ if (number_to_scaled(mp->cur_t) >= number_to_scaled(mp->max_t)) {
+ if (number_equal(mp->max_t, x_two_t) || number_greater(mp->max_t, x_two_t_low_precision)) {
+ if (run == 1) {
+ /* we've done 17+2 bisections, first restore values due bit precision */
+ number_divide_int(mp->cur_t,1<<2);
+ number_divide_int(mp->cur_tt,1<<2);
+ set_number_from_scaled(mp->cur_t, ((number_to_scaled(mp->cur_t) + 1)/2));
+ set_number_from_scaled(mp->cur_tt, ((number_to_scaled(mp->cur_tt) + 1)/2));
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+ return 1;
+ } else {
+ run--;
+ goto NOT_FOUND;
+ }
+ }
+ number_double(mp->max_t);
+ number_clone(mp->appr_t, mp->cur_t);
+ number_clone(mp->appr_tt, mp->cur_tt);
+ }
+ @<Subdivide for a new level of intersection@>
+ goto CONTINUE;
+ }
+ }
+ }
+ }
+ if (mp->time_to_go > 0) {
+ --mp->time_to_go;
+ } else {
+ /* we have added 2 bit of precision */
+ number_divide_int(mp->appr_t, 1<<2);
+ number_divide_int(mp->appr_tt, 1<<2);
+ while (number_less(mp->appr_t, unity_t)) {
+ number_double(mp->appr_t);
+ number_double(mp->appr_tt);
+ }
+ number_clone(mp->cur_t, mp->appr_t);
+ number_clone(mp->cur_tt, mp->appr_tt);
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+ return 2;
+ }
+ NOT_FOUND:
+ /* Advance to the next pair |(cur_t,cur_tt)| */
+ if (odd(number_to_scaled(mp->cur_tt))) {
+ // if (number_odd(mp->cur_tt)) {
+ if (odd(number_to_scaled(mp->cur_t))) {
+ // if (number_odd(mp->cur_t)) {
+ /* Descend to the previous level and |goto not_found| */
+ set_number_from_scaled(mp->cur_t, half (number_to_scaled(mp->cur_t)));
+ set_number_from_scaled(mp->cur_tt, half (number_to_scaled(mp->cur_tt)));
+ if (number_to_scaled(mp->cur_t) == 0) {
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+ return 3;
+ } else {
+ mp->bisect_ptr -= int_increment;
+ mp->three_l -= (int) mp->tol_step;
+ number_clone(mp->delx, stack_dx);
+ number_clone(mp->dely, stack_dy);
+ mp->tol = number_to_scaled(stack_tol);
+ mp->uv = number_to_scaled(stack_uv);
+ mp->xy = number_to_scaled(stack_xy);
+ goto NOT_FOUND;
+ }
+ } else {
+ set_number_from_scaled(mp->cur_t, number_to_scaled(mp->cur_t) + 1);
+ number_add(mp->delx, stack_1(u_packet (mp->uv)));
+ number_add(mp->delx, stack_2(u_packet (mp->uv)));
+ number_add(mp->delx, stack_3(u_packet (mp->uv)));
+ number_add(mp->dely, stack_1(v_packet (mp->uv)));
+ number_add(mp->dely, stack_2(v_packet (mp->uv)));
+ number_add(mp->dely, stack_3(v_packet (mp->uv)));
+ mp->uv = mp->uv + int_packets; /* switch from |l_packets| to |r_packets| */
+ set_number_from_scaled(mp->cur_tt, number_to_scaled(mp->cur_tt) - 1);
+ mp->xy = mp->xy - int_packets;
+ number_add(mp->delx, stack_1(x_packet (mp->xy)));
+ number_add(mp->delx, stack_2(x_packet (mp->xy)));
+ number_add(mp->delx, stack_3(x_packet (mp->xy)));
+ number_add(mp->dely, stack_1(y_packet (mp->xy)));
+ number_add(mp->dely, stack_2(y_packet (mp->xy)));
+ number_add(mp->dely, stack_3(y_packet (mp->xy)));
+ }
+ } else {
+ set_number_from_scaled(mp->cur_tt, number_to_scaled(mp->cur_tt) + 1);
+ mp->tol = mp->tol + mp->three_l;
+ number_subtract(mp->delx, stack_1(x_packet (mp->xy)));
+ number_subtract(mp->delx, stack_2(x_packet (mp->xy)));
+ number_subtract(mp->delx, stack_3(x_packet (mp->xy)));
+ number_subtract(mp->dely, stack_1(y_packet (mp->xy)));
+ number_subtract(mp->dely, stack_2(y_packet (mp->xy)));
+ number_subtract(mp->dely, stack_3(y_packet (mp->xy)));
+ mp->xy = mp->xy + int_packets; /* switch from |l_packets| to |r_packets| */
+ }
+ }
+free_number(x_two_t);
+free_number(x_two_t_low_precision);
+}
+
+@ The following variables are global, although they are used only by
+|cubic_intersection|, because it is necessary on some machines to split
+|cubic_intersection| up into two procedures.
+
+@<Glob...@>=
+mp_number delx;
+mp_number dely; /* the components of $\Delta=2^l(w_0-z_0)$ */
+int tol; /* bound on the uncertainty in the overlap test */
+int uv;
+int xy; /* pointers to the current packets of interest */
+int three_l; /* |tol_step| times the bisection level */
+mp_number appr_t;
+mp_number appr_tt; /* best approximations known to the answers */
+
+@ @<Initialize table ...@>=
+new_number(mp->delx);
+new_number(mp->dely);
+new_number(mp->appr_t);
+new_number(mp->appr_tt);
+
+@ @<Dealloc...@>=
+free_number(mp->delx);
+free_number(mp->dely);
+free_number(mp->appr_t);
+free_number(mp->appr_tt);
+
+@ We shall assume that the coordinates are sufficiently non-extreme that
+integer overflow will not occur.
+@^overflow in arithmetic@>
+
+@<Initialize for intersections at level zero@>=
+q = mp_next_knot(p);
+qq = mp_next_knot(pp);
+mp->bisect_ptr = int_packets;
+set_number_from_subtraction(u1r, p->right_x, p->x_coord);
+set_number_from_subtraction(u2r, q->left_x, p->right_x);
+set_number_from_subtraction(u3r, q->x_coord, q->left_x);
+mp_set_min_max(mp, ur_packet);
+set_number_from_subtraction(v1r, p->right_y, p->y_coord);
+set_number_from_subtraction(v2r, q->left_y, p->right_y);
+set_number_from_subtraction(v3r, q->y_coord, q->left_y);
+mp_set_min_max(mp, vr_packet);
+set_number_from_subtraction(x1r, pp->right_x, pp->x_coord);
+set_number_from_subtraction(x2r, qq->left_x, pp->right_x);
+set_number_from_subtraction(x3r, qq->x_coord, qq->left_x);
+mp_set_min_max(mp, xr_packet);
+set_number_from_subtraction(y1r, pp->right_y, pp->y_coord);
+set_number_from_subtraction(y2r, qq->left_y, pp->right_y);
+set_number_from_subtraction(y3r, qq->y_coord, qq->left_y);
+mp_set_min_max(mp, yr_packet);
+set_number_from_subtraction(mp->delx, p->x_coord, pp->x_coord);
+set_number_from_subtraction(mp->dely, p->y_coord, pp->y_coord);
+mp->tol = 0;
+mp->uv = r_packets;
+mp->xy = r_packets;
+mp->three_l = 0;
+set_number_from_scaled(mp->cur_t, 1);
+set_number_from_scaled(mp->cur_tt, 1);
+
+@ @<Subdivide for a new level of intersection@>=
+number_clone(stack_dx, mp->delx);
+number_clone(stack_dy, mp->dely);
+set_number_from_scaled(stack_tol, mp->tol);
+set_number_from_scaled(stack_uv, mp->uv);
+set_number_from_scaled(stack_xy, mp->xy);
+mp->bisect_ptr = mp->bisect_ptr + int_increment;
+number_double(mp->cur_t);
+number_double(mp->cur_tt);
+number_clone(u1l, stack_1(u_packet (mp->uv)));
+number_clone(u3r, stack_3(u_packet (mp->uv)));
+set_number_half_from_addition(u2l, u1l, stack_2(u_packet(mp->uv)));
+set_number_half_from_addition(u2r, u3r, stack_2(u_packet(mp->uv)));
+set_number_half_from_addition(u3l, u2l, u2r);
+number_clone(u1r, u3l);
+mp_set_min_max(mp, ul_packet);
+mp_set_min_max(mp, ur_packet);
+number_clone(v1l, stack_1(v_packet (mp->uv)));
+number_clone(v3r, stack_3(v_packet (mp->uv)));
+set_number_half_from_addition(v2l, v1l, stack_2(v_packet(mp->uv)));
+set_number_half_from_addition(v2r, v3r, stack_2(v_packet(mp->uv)));
+set_number_half_from_addition(v3l, v2l, v2r);
+number_clone(v1r, v3l);
+mp_set_min_max(mp, vl_packet);
+mp_set_min_max(mp, vr_packet);
+number_clone(x1l, stack_1(x_packet (mp->xy)));
+number_clone(x3r, stack_3(x_packet (mp->xy)));
+set_number_half_from_addition(x2l, x1l, stack_2(x_packet(mp->xy)));
+set_number_half_from_addition(x2r, x3r, stack_2(x_packet(mp->xy)));
+set_number_half_from_addition(x3l, x2l, x2r);
+number_clone(x1r, x3l);
+mp_set_min_max(mp, xl_packet);
+mp_set_min_max(mp, xr_packet);
+number_clone(y1l, stack_1(y_packet (mp->xy)));
+number_clone(y3r, stack_3(y_packet (mp->xy)));
+set_number_half_from_addition(y2l, y1l, stack_2(y_packet(mp->xy)));
+set_number_half_from_addition(y2r, y3r, stack_2(y_packet(mp->xy)));
+set_number_half_from_addition(y3l, y2l, y2r);
+number_clone(y1r, y3l);
+mp_set_min_max(mp, yl_packet);
+mp_set_min_max(mp, yr_packet);
+mp->uv = l_packets;
+mp->xy = l_packets;
+number_double(mp->delx);
+number_double(mp->dely);
+mp->tol = mp->tol - mp->three_l + (int) mp->tol_step;
+mp->tol += mp->tol;
+mp->three_l = mp->three_l + (int) mp->tol_step;
+
+@ The |path_intersection| procedure is much simpler. It invokes
+|cubic_intersection| in lexicographic order until finding a pair of cubics that
+intersect. The final intersection times are placed in |cur_t| and~|cur_tt|.
+
+@d intersection_run_shift 8
+
+@c
+static mp_knot mp_path_intersection_add(MP mp, mp_knot list, mp_knot *last, mp_number *t, mp_number *tt)
+{
+ int a = number_to_scaled(*t) >> intersection_run_shift;
+ int aa = number_to_scaled(*tt) >> intersection_run_shift;
+ int b = (list ? number_to_scaled((*last)->x_coord) : -1) >> intersection_run_shift ;
+ int bb = (list ? number_to_scaled((*last)->y_coord) : -1) >> intersection_run_shift ;
+ if (a == b && aa == bb) {
+ /* ignore */
+ } else {
+ /* todo: just the point as we have it */
+ mp_knot k = mp_new_knot(mp);
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ number_clone(k->x_coord, *t);
+ number_clone(k->y_coord, *tt);
+ if (list) {
+ mp_prev_knot(k) = *last;
+ mp_next_knot(*last) = k;
+ mp_prev_knot(list) = k;
+ mp_next_knot(k) = list;
+ } else {
+ list = k;
+ mp_prev_knot(k) = k;
+ mp_next_knot(k) = k;
+ }
+ *last = k;
+ }
+ return list;
+}
+
+@c
+static mp_knot mp_path_intersection(MP mp, mp_knot h, mp_knot hh, int path, mp_knot *last)
+{
+ mp_number n, nn; /* integer parts of intersection times, minus |unity| */
+ int done = 0;
+ mp_knot list = NULL;
+ mp_knot l = NULL;
+ mp_knot ll = NULL;
+ if (last) {
+ *last = NULL;
+ }
+ @<Change one-point paths into dead cycles@>
+ new_number(n);
+ new_number(nn);
+ mp->tol_step = 0;
+ do {
+ mp_knot p, pp; /* link registers that traverse the given paths */
+ int t = -1;
+ int tt = -1;
+ // set_number_to_unity(n);
+ // number_negate(n);
+ number_negated_clone(n, unity_t);
+ p = h;
+ do {
+ if (mp_right_type(p) != mp_endpoint_knot) {
+ // set_number_to_unity(nn);
+ // number_negate(nn);
+ number_negated_clone(nn, unity_t);
+ pp = hh;
+ do {
+ if (mp_right_type(pp) != mp_endpoint_knot) {
+ int run = 0;
+ int retrials = 0;
+ RETRY:
+ ++run;
+ mp_cubic_intersection(mp, p, pp, run);
+ if (number_positive(mp->cur_t)) {
+ number_add(mp->cur_t, n);
+ number_add(mp->cur_tt, nn);
+ done = 1;
+ if (path) {
+ list = mp_path_intersection_add(mp, list, last, &(mp->cur_t), &(mp->cur_tt));
+ if (t == number_to_scaled(mp->cur_t) && tt == number_to_scaled(mp->cur_tt)) {
+ if (retrials == 8) { /* is 8 okay? */
+ break;
+ } else {
+ retrials += 1;
+ goto RETRY;
+ }
+ } else {
+ retrials = 0;
+ t = number_to_scaled(mp->cur_t);
+ tt = number_to_scaled(mp->cur_tt);
+ goto RETRY;
+ }
+ } else {
+ goto DONE;
+ }
+ }
+ }
+ number_add(nn, unity_t);
+ ll = pp;
+ pp = mp_next_knot(pp);
+ } while (pp != hh);
+ }
+ number_add(n, unity_t);
+ l = p;
+ p = mp_next_knot(p);
+ } while (p != h);
+ mp->tol_step = mp->tol_step + 3;
+ if (done) {
+ goto DONE; /* when we do all points */
+ }
+ } while (mp->tol_step <= 3);
+ DONE:
+ if (path && l && ll && number_equal(l->x_coord, ll->x_coord) && number_equal(l->y_coord, ll->y_coord)) {
+ list = mp_path_intersection_add(mp, list, last, &n, &nn);
+ }
+ if (! done) {
+ number_negated_clone(mp->cur_t, unity_t);
+ number_negated_clone(mp->cur_tt, unity_t);
+ if (path && ! list) {
+ mp_knot k = mp_new_knot(mp);
+ number_clone(k->x_coord, mp->cur_t);
+ number_clone(k->y_coord, mp->cur_tt);
+ mp_prev_knot(k) = k;
+ mp_next_knot(k) = k;
+ list = k;
+ if (last) {
+ *last = k;
+ }
+ }
+ }
+ free_number(n);
+ free_number(nn);
+ return list;
+}
+
+@ @<Change one-point paths...@>=
+if (mp_right_type(h) == mp_endpoint_knot) {
+ number_clone(h->right_x, h->x_coord);
+ number_clone(h->left_x, h->x_coord);
+ number_clone(h->right_y, h->y_coord);
+ number_clone(h->left_y, h->y_coord);
+ mp_right_type(h) = mp_explicit_knot;
+}
+if (mp_right_type(hh) == mp_endpoint_knot) {
+ number_clone(hh->right_x, hh->x_coord);
+ number_clone(hh->left_x, hh->x_coord);
+ number_clone(hh->right_y, hh->y_coord);
+ number_clone(hh->left_y, hh->y_coord);
+ mp_right_type(hh) = mp_explicit_knot;
+}
+
+@* Dynamic linear equations.
+
+\MP\ users define variables implicitly by stating equations that should be
+satisfied; the computer is supposed to be smart enough to solve those equations.
+And indeed, the computer tries valiantly to do so, by distinguishing five
+different types of numeric values:
+
+\smallskip\hang |type(p)=mp_known| is the nice case, when |value(p)| is the
+|scaled| value of the variable whose address is~|p|.
+
+\smallskip\hang |type(p)=mp_dependent| means that |value(p)| is not present, but
+|mp_get_dep_list(p)| points to a {\sl dependency list} that expresses the value of
+variable~|p| as a |scaled| number plus a sum of independent variables with
+|fraction| coefficients.
+
+\smallskip\hang |type(p)=mp_independent| means that |mp_get_indep_value(p)=s|, where
+|s>0| is a \quote {serial number} reflecting the time this variable was first used in
+an equation; and there is an extra field |mp_get_indep_scale(p)=m|, with |0<=m<64|, each
+dependent variable that refers to this one is actually referring to the future
+value of this variable times~$2^m$. (Usually |m=0|, but higher degrees of scaling
+are sometimes needed to keep the coefficients in dependency lists from getting
+too large. The value of~|m| will always be even.)
+
+\smallskip\hang |type(p)=mp_numeric_type| means that variable |p| hasn't appeared
+in an equation before, but it has been explicitly declared to be numeric.
+
+\smallskip\hang |type(p)=undefined| means that variable |p| hasn't appeared
+before.
+
+\smallskip\noindent We have actually discussed these five types in the reverse
+order of their history during a computation: Once |known|, a variable never again
+becomes |dependent|; once |dependent|, it almost never again becomes
+|mp_independent|; once |mp_independent|, it never again becomes
+|mp_numeric_type|; and once |mp_numeric_type|, it never again becomes |undefined|
+(except of course when the user specifically decides to scrap the old value and
+start again). A backward step may, however, take place: Sometimes a |dependent|
+variable becomes |mp_independent| again, when one of the independent variables it
+depends on is reverting to |undefined|.
+
+@d mp_get_indep_scale(A) ((mp_value_node) (A))->data.indep.scale
+@d mp_set_indep_scale(A,B) ((mp_value_node) (A))->data.indep.scale = (B)
+@d mp_get_indep_value(A) ((mp_value_node) (A))->data.indep.serial
+@d mp_set_indep_value(A,B) ((mp_value_node) (A))->data.indep.serial = (B)
+
+@c
+static void mp_new_indep (MP mp, mp_node p)
+{
+ (void) mp;
+ /* create a new independent variable */
+ if (mp->serial_no >= max_integer) {
+ mp_fatal_error(mp, "Variable instance identifiers exhausted");
+ }
+ mp_type(p) = mp_independent_type;
+ mp->serial_no = mp->serial_no + 1;
+ mp_set_indep_scale(p, 0);
+ mp_set_indep_value(p, mp->serial_no);
+}
+
+@ @<Declarations@>=
+static void mp_new_indep (MP mp, mp_node p);
+
+@ @<Glob...@>=
+int serial_no; /* the most recent serial number */
+
+@ But how are dependency lists represented? It's simple: The linear combination
+$\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in |k+1| value nodes. If
+|q=mp_get_dep_list(p)| points to this list, and if |k>0|, then |mp_get_dep_value(q)=
+@t$\alpha_1$@>| (which is a |fraction|); |mp_get_dep_info(q)| points to the location of
+$\alpha_1$; and |mp_link(p)| points to the dependency list
+$\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if |k=0|, then
+|mp_get_dep_value(q)=@t$\beta$@>| (which is |scaled|) and |mp_get_dep_info(q)=NULL|. The
+independent variables $v_1$, \dots,~$v_k$ have been sorted so that they appear in
+decreasing order of their |value| fields (i.e., of their serial numbers). \ (It
+is convenient to use decreasing order, since |value(NULL)=0|. If the independent
+variables were not sorted by serial number but by some other criterion, such as
+their location in |mem|, the equation-solving mechanism would be too
+system-dependent, because the ordering can affect the computed results.)
+
+The |link| field in the node that contains the constant term $\beta$ is called
+the {\sl final link} of the dependency list. \MP\ maintains a doubly-linked
+master list of all dependency lists, in terms of a permanently allocated node in
+|mem| called |dep_head|. If there are no dependencies, we have
+|mp_link(dep_head)=dep_head| and |mp_get_prev_dep(dep_head)=dep_head|; otherwise
+|mp_link(dep_head)| points to the first dependent variable, say~|p|, and
+|mp_get_prev_dep(p)=dep_head|. We have |type(p)=mp_dependent|, and |mp_get_dep_list(p)| points
+to its dependency list. If the final link of that dependency list occurs in
+location~|q|, then |mp_link(q)| points to the next dependent variable (say~|r|);
+and we have |mp_get_prev_dep(r)=q|, etc.
+
+Dependency nodes sometimes mutate into value nodes and vice versa, so their
+structures have to match.
+
+@d mp_get_dep_value(A) ((mp_value_node) (A))->data.n
+@d mp_get_dep_list(A) ((mp_value_node) (A))->attr_head /* half of the |value| field in a |dependent| variable */
+@d mp_get_prev_dep(A) ((mp_value_node) (A))->subscr_head /* the other half; makes a doubly linked list */
+@d mp_get_dep_info(A) do_get_dep_info(mp, (A))
+
+@d mp_set_dep_value(A,B) do_set_dep_value(mp,(A),&(B))
+@d mp_set_dep_list(A,B) ((mp_value_node) (A))->attr_head = (mp_node) (B)
+@d mp_set_prev_dep(A,B) ((mp_value_node) (A))->subscr_head = (mp_node) (B)
+@d mp_set_dep_info(A,B) ((mp_value_node) (A))->parent = (mp_node) (B)
+
+@c
+inline static mp_node do_get_dep_info (MP mp, mp_value_node p)
+{
+ (void) mp;
+ mp_node d;
+ d = p->parent; /* half of the |value| field in a |dependent| variable */
+ return d;
+}
+
+inline static void do_set_dep_value (MP mp, mp_value_node p, mp_number *q)
+{
+ number_clone(p->data.n, *q); /* half of the |value| field in a |dependent| variable */
+ p->attr_head = NULL;
+ p->subscr_head = NULL;
+}
+
+@ @<Declarations...@>=
+inline static mp_node do_get_dep_info (MP mp, mp_value_node p);
+inline static void do_set_dep_value (MP mp, mp_value_node p, mp_number *q);
+
+@ @c
+static mp_value_node mp_get_dep_node (MP mp)
+{
+ mp_value_node p = (mp_value_node) mp_new_value_node(mp);
+ mp_type(p) = mp_dep_node_type;
+ return p;
+}
+
+static void mp_free_dep_node (MP mp, mp_value_node p)
+{
+ mp_free_value_node(mp, (mp_node) p);
+}
+
+@ @<Declarations...@>=
+static void mp_free_dep_node (MP mp, mp_value_node p);
+
+@ @<Initialize table entries@>=
+mp->serial_no = 0;
+mp->dep_head = mp_get_dep_node(mp);
+
+mp_set_link(mp->dep_head, mp->dep_head);
+mp_set_prev_dep(mp->dep_head, mp->dep_head);
+mp_set_dep_info(mp->dep_head, NULL);
+mp_set_dep_list(mp->dep_head, NULL);
+
+@ @<Free table entries@>=
+mp_free_dep_node(mp, mp->dep_head);
+
+@ Actually the description above contains a little white lie. There's another
+kind of variable called |mp_proto_dependent|, which is just like a |dependent|
+one except that the $\alpha$ coefficients in its dependency list are |scaled|
+instead of being fractions. Proto-dependency lists are mixed with dependency
+lists in the nodes reachable from |dep_head|.
+
+@ Here is a procedure that prints a dependency list in symbolic form. The second
+parameter should be either |dependent| or |mp_proto_dependent|, to indicate the
+scaling of the coefficients.
+
+@<Declarations@>=
+static void mp_print_dependency (MP mp, mp_value_node p, int t);
+
+@ @c
+void mp_print_dependency (MP mp, mp_value_node p, int t)
+{
+ mp_number v; /* a coefficient */
+ mp_node q;
+ mp_value_node pp = p;
+ new_number(v);
+ while (1) {
+ number_abs_clone(v, mp_get_dep_value(p));
+ q = mp_get_dep_info(p);
+ if (q == NULL) {
+ /* the constant term */
+ if (number_nonzero(v) || (p == pp)) {
+ if (number_positive(mp_get_dep_value(p)) && p != pp) {
+ mp_print_chr(mp, '+');
+ }
+ print_number(mp_get_dep_value(p));
+ }
+ return;
+ }
+ /* Print the coefficient, unless it's $\pm1.0$ */
+ if (number_negative(mp_get_dep_value(p))) {
+ mp_print_chr(mp, '-');
+ } else if (p != pp) {
+ mp_print_chr(mp, '+');
+ }
+ if (t == mp_dependent_type) {
+ fraction_to_round_scaled(v);
+ }
+ if (! number_equal(v, unity_t)) {
+ print_number(v);
+ }
+ if (mp_type(q) != mp_independent_type) {
+ mp_confusion(mp, "dependency");
+ } else {
+ mp_print_variable_name(mp, q);
+ set_number_from_scaled(v, mp_get_indep_scale(q));
+ while (number_positive(v)) {
+ mp_print_str(mp, "*4");
+ number_add_scaled(v, -2);
+ }
+ p = (mp_value_node) mp_link(p);
+ }
+ }
+}
+
+@ The maximum absolute value of a coefficient in a given dependency list is
+returned by the following simple function.
+
+@c
+static void mp_max_coef (MP mp, mp_number *x, mp_value_node p)
+{
+ mp_number(absv);
+ new_number(absv);
+ set_number_to_zero(*x);
+ while (mp_get_dep_info(p) != NULL) {
+ number_abs_clone(absv, mp_get_dep_value(p));
+ if (number_greater(absv, *x)) {
+ number_clone(*x, absv);
+ }
+ p = (mp_value_node) mp_link(p);
+ }
+ free_number(absv);
+}
+
+@ One of the main operations needed on dependency lists is to add a multiple of
+one list to the other; we call this |p_plus_fq|, where |p| and~|q| point to
+dependency lists and |f| is a fraction.
+
+If the coefficient of any independent variable becomes |coef_bound| or more, in
+absolute value, this procedure changes the type of that variable to
+|independent_needing_fix|, and sets the global variable |fix_needed| to~|true|.
+The value of $|coef_bound|=\mu$ is chosen so that $\mu^2+\mu<8$; this means that
+the numbers we deal with won't get too large. (Instead of the \quote {optimum}
+$\mu=(\sqrt{33}-1)/2\approx 2.3723$, the safer value 7/3 is taken as the
+threshold.)
+
+The changes mentioned in the preceding paragraph are actually done only if the
+global variable |watch_coefs| is |true|. But it usually is; in fact, it is
+|false| only when \MP\ is making a dependency list that will soon be equated to
+zero.
+
+Several procedures that act on dependency lists, including |p_plus_fq|, set the
+global variable |dep_final| to the final (constant term) node of the dependency
+list that they produce.
+
+@d independent_needing_fix 0
+
+@<Glob...@>=
+int fix_needed; /* does at least one |independent| variable need scaling? */
+int watch_coefs; /* should we scale coefficients that exceed |coef_bound|? */
+mp_value_node dep_final; /* location of the constant term and final link */
+
+@ @<Set init...@>=
+mp->fix_needed = 0;
+mp->watch_coefs = 1;
+
+@ The |p_plus_fq| procedure has a fourth parameter, |t|, that should be set to
+|mp_proto_dependent| if |p| is a proto-dependency list. In this case |f| will be
+|scaled|, not a |fraction|. Similarly, the fifth parameter~|tt| should be
+|mp_proto_dependent| if |q| is a proto-dependency list.
+
+List |q| is unchanged by the operation; but list |p| is totally destroyed.
+
+The final link of the dependency list or proto-dependency list returned by
+|p_plus_fq| is the same as the original final link of~|p|. Indeed, the constant
+term of the result will be located in the same |mem| location as the original
+constant term of~|p|.
+
+Coefficients of the result are assumed to be zero if they are less than a certain
+threshold. This compensates for inevitable rounding errors, and tends to make
+more variables |known|. The threshold is approximately $10^{-5}$ in the case of
+normal dependency lists, $10^{-4}$ for proto-dependencies.
+
+@d fraction_threshold_k mp->math->md_fraction_threshold_t
+@d half_fraction_threshold_k mp->math->md_half_fraction_threshold_t
+@d scaled_threshold_k mp->math->md_scaled_threshold_t
+@d half_scaled_threshold_k mp->math->md_half_scaled_threshold_t
+
+@<Declarations@>=
+static mp_value_node mp_p_plus_fq (MP mp, mp_value_node p, mp_number *f, mp_value_node q, mp_variable_type t, mp_variable_type tt);
+
+@ @c
+static mp_value_node mp_p_plus_fq (MP mp,
+ mp_value_node p, mp_number *f,
+ mp_value_node q, mp_variable_type t,
+ mp_variable_type tt
+)
+{
+ mp_node pp, qq; /* |mp_get_dep_info(p)| and |mp_get_dep_info(q)|, respectively */
+ mp_value_node r, s; /* for list manipulation */
+ mp_number threshold; /* defines a neighborhood of zero */
+ mp_number half_threshold;
+ mp_number v, vv; /* temporary registers */
+ new_number(v);
+ new_number(vv);
+ if (t == mp_dependent_type) {
+ new_number_clone(threshold, fraction_threshold_k);
+ new_number_clone(half_threshold, half_fraction_threshold_k);
+ } else {
+ new_number_clone(threshold, scaled_threshold_k);
+ new_number_clone(half_threshold, half_scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ pp = mp_get_dep_info(p);
+ qq = mp_get_dep_info(q);
+ while (1) {
+ if (pp == qq) {
+ if (pp == NULL) {
+ break;
+ } else {
+ /*
+ Contribute a term from |p|, plus |f| times the corresponding
+ term from |q|
+ */
+ mp_number r1;
+ mp_number absv;
+ new_fraction(r1);
+ new_number(absv);
+ if (tt == mp_dependent_type) {
+ take_fraction(r1, *f, mp_get_dep_value(q));
+ } else {
+ take_scaled(r1, *f, mp_get_dep_value(q));
+ }
+ set_number_from_addition(v, mp_get_dep_value(p), r1);
+ free_number(r1);
+ mp_set_dep_value(p, v);
+ s = p;
+ p = (mp_value_node) mp_link(p);
+ number_abs_clone(absv, v);
+ if (number_less(absv, threshold)) {
+ mp_free_dep_node(mp, s);
+ } else {
+ if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) {
+ mp_type(qq) = independent_needing_fix;
+ /*
+ If we set this , then we can drop |(mp_type(pp) ==
+ independent_needing_fix && mp->fix_needed)| later
+ |set_number_from_scaled(mp_get_value_number(qq),
+ mp_get_indep_value(qq));|
+ */
+ mp->fix_needed = 1;
+ }
+ mp_set_link(r, s);
+ r = s;
+ }
+ free_number(absv);
+ pp = mp_get_dep_info(p);
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ }
+ } else {
+ if (pp == NULL) {
+ set_number_to_negative_inf(v);
+ } else if (mp_type(pp) == mp_independent_type || (mp_type(pp) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(v, mp_get_indep_value(pp));
+ } else {
+ number_clone(v, mp_get_value_number(pp));
+ }
+ if (qq == NULL) {
+ set_number_to_negative_inf(vv);
+ } else if (mp_type(qq) == mp_independent_type || (mp_type(qq) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(vv, mp_get_indep_value(qq));
+ } else {
+ number_clone(vv, mp_get_value_number(qq));
+ }
+ if (number_less(v, vv)) {
+ /* Contribute a term from |q|, multiplied by~|f| */
+ mp_number absv;
+ {
+ mp_number r1;
+ mp_number arg1, arg2;
+ new_fraction(r1);
+ new_number_clone(arg1, *f);
+ new_number_clone(arg2, mp_get_dep_value(q));
+ if (tt == mp_dependent_type) {
+ take_fraction(r1, arg1, arg2);
+ } else {
+ take_scaled(r1, arg1, arg2);
+ }
+ number_clone(v, r1);
+ free_number(r1);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ new_number_abs(absv, v);
+ if (number_greater(absv, half_threshold)) {
+ s = mp_get_dep_node(mp);
+ mp_set_dep_info(s, qq);
+ mp_set_dep_value(s, v);
+ if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) {
+ mp_type(qq) = independent_needing_fix;
+ mp->fix_needed = 1;
+ }
+ mp_set_link(r, s);
+ r = s;
+ }
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ free_number(absv);
+ } else {
+ mp_set_link(r, p);
+ r = p;
+ p = (mp_value_node) mp_link(p);
+ pp = mp_get_dep_info(p);
+ }
+ }
+ }
+ {
+ mp_number r1;
+ mp_number arg1, arg2;
+ new_fraction(r1);
+ new_number(arg1);
+ new_number(arg2);
+ number_clone(arg1, mp_get_dep_value(q));
+ number_clone(arg2, *f);
+ if (t == mp_dependent_type) {
+ take_fraction(r1, arg1, arg2);
+ } else {
+ take_scaled(r1, arg1, arg2);
+ }
+ slow_add(arg1, mp_get_dep_value(p), r1);
+ mp_set_dep_value(p, arg1);
+ free_number(r1);
+ free_number(arg1);
+ free_number(arg2);
+ }
+ mp_set_link(r, p);
+ mp->dep_final = p;
+ free_number(threshold);
+ free_number(half_threshold);
+ free_number(v);
+ free_number(vv);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+@ It is convenient to have another subroutine for the special case of |p_plus_fq|
+when |f=1.0|. In this routine lists |p| and |q| are both of the same type~|t|
+(either |dependent| or |mp_proto_dependent|).
+
+@c
+static mp_value_node mp_p_plus_q (MP mp, mp_value_node p, mp_value_node q, mp_variable_type t)
+{
+ mp_node pp, qq; /* |mp_get_dep_info(p)| and |mp_get_dep_info(q)|, respectively */
+ mp_value_node s; /* for list manipulation */
+ mp_value_node r; /* for list manipulation */
+ mp_number threshold; /* defines a neighborhood of zero */
+ mp_number v, vv; /* temporary register */
+ new_number(v);
+ new_number(vv);
+ new_number(threshold);
+ if (t == mp_dependent_type) {
+ number_clone(threshold, fraction_threshold_k);
+ } else {
+ number_clone(threshold, scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ pp = mp_get_dep_info(p);
+ qq = mp_get_dep_info(q);
+ while (1) {
+ if (pp == qq) {
+ if (pp == NULL) {
+ break;
+ } else {
+ /* Contribute a term from |p|, plus the corresponding term from |q| */
+ mp_number test;
+ new_number(test);
+ set_number_from_addition(v, mp_get_dep_value(p), mp_get_dep_value(q));
+ mp_set_dep_value(p, v);
+ s = p;
+ p = (mp_value_node) mp_link(p);
+ pp = mp_get_dep_info(p);
+ number_abs_clone(test, v);
+ if (number_less(test, threshold)) {
+ mp_free_dep_node(mp, s);
+ } else {
+ if (number_greaterequal(test, coef_bound_k) && mp->watch_coefs) {
+ mp_type(qq) = independent_needing_fix;
+ /*
+ If we set this , then we can drop |(mp_type(pp) ==
+ independent_needing_fix && mp->fix_needed)| later
+ |set_number_from_scaled(mp_get_value_number(qq),
+ mp_get_indep_value(qq));|
+ */
+ mp->fix_needed = 1;
+ }
+ mp_set_link(r, s);
+ r = s;
+ }
+ free_number(test);
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ }
+
+ } else {
+ if (pp == NULL) {
+ set_number_to_zero(v);
+ } else if (mp_type(pp) == mp_independent_type || (mp_type(pp) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(v, mp_get_indep_value(pp));
+ } else {
+ number_clone(v, mp_get_value_number(pp));
+ }
+ if (qq == NULL) {
+ set_number_to_zero(vv);
+ } else if (mp_type(qq) == mp_independent_type || (mp_type(qq) == independent_needing_fix && mp->fix_needed)) {
+ set_number_from_scaled(vv, mp_get_indep_value(qq));
+ } else {
+ number_clone(vv, mp_get_value_number(qq));
+ }
+ if (number_less(v, vv)) {
+ s = mp_get_dep_node(mp);
+ mp_set_dep_info(s, qq);
+ mp_set_dep_value(s, mp_get_dep_value(q));
+ q = (mp_value_node) mp_link(q);
+ qq = mp_get_dep_info(q);
+ mp_set_link(r, s);
+ r = s;
+ } else {
+ mp_set_link(r, p);
+ r = p;
+ p = (mp_value_node) mp_link(p);
+ pp = mp_get_dep_info(p);
+ }
+ }
+ }
+ {
+ mp_number r1;
+ new_number(r1);
+ slow_add(r1, mp_get_dep_value(p), mp_get_dep_value(q));
+ mp_set_dep_value(p, r1);
+ free_number(r1);
+ }
+ mp_set_link(r, p);
+ mp->dep_final = p;
+ free_number(v);
+ free_number(vv);
+ free_number(threshold);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+@ A somewhat simpler routine will multiply a dependency list by a given
+constant~|v|. The constant is either a |fraction| less than |fraction_one|, or it
+is |scaled|. In the latter case we might be forced to convert a dependency list
+to a proto-dependency list. Parameters |t0| and |t1| are the list types before
+and after; they should agree unless |t0=mp_dependent| and |t1=mp_proto_dependent|
+and |v_is_scaled=true|.
+
+@c
+static mp_value_node mp_p_times_v (MP mp, mp_value_node p, mp_number *v, int t0, int t1, int v_is_scaled)
+{
+ mp_value_node r, s; /* for list manipulation */
+ mp_number w; /* tentative coefficient */
+ mp_number threshold;
+ int scaling_down = (t0 != t1) ? 1 : (! v_is_scaled);
+ new_number(threshold);
+ new_number(w);
+ if (t1 == mp_dependent_type) {
+ number_clone(threshold, half_fraction_threshold_k);
+ } else {
+ number_clone(threshold, half_scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ while (mp_get_dep_info(p) != NULL) {
+ mp_number test;
+ new_number(test);
+ if (scaling_down) {
+ take_fraction(w, *v, mp_get_dep_value(p));
+ } else {
+ take_scaled(w, *v, mp_get_dep_value(p));
+ }
+ number_abs_clone(test, w);
+ if (number_lessequal(test, threshold)) {
+ s = (mp_value_node) mp_link(p);
+ mp_free_dep_node(mp, p);
+ p = s;
+ } else {
+ if (number_greaterequal(test, coef_bound_k)) {
+ mp->fix_needed = 1;
+ mp_type(mp_get_dep_info(p)) = independent_needing_fix;
+ }
+ mp_set_link(r, p);
+ r = p;
+ mp_set_dep_value(p, w);
+ p = (mp_value_node) mp_link(p);
+ }
+ free_number(test);
+ }
+ mp_set_link(r, p);
+ {
+ mp_number r1;
+ new_number(r1);
+ if (v_is_scaled) {
+ take_scaled(r1, mp_get_dep_value(p), *v);
+ } else {
+ take_fraction(r1, mp_get_dep_value(p), *v);
+ }
+ mp_set_dep_value(p, r1);
+ free_number(r1);
+ }
+ free_number(w);
+ free_number(threshold);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+@ Similarly, we sometimes need to divide a dependency list by a given |scaled|
+constant.
+
+@<Declarations@>=
+static mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number *v, int t0, int t1);
+
+@ @d p_over_v_threshold_k mp->math->md_p_over_v_threshold_t
+
+@ @c
+mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number *v_orig, int t0, int t1)
+{
+ mp_value_node r, s; /* for list manipulation */
+ mp_number w; /* tentative coefficient */
+ mp_number threshold;
+ mp_number v;
+ int scaling_down = (t0 != t1);
+ new_number(w);
+ new_number(threshold);
+ new_number_clone(v, *v_orig);
+ if (t1 == mp_dependent_type) {
+ number_clone(threshold, half_fraction_threshold_k);
+ } else {
+ number_clone(threshold, half_scaled_threshold_k);
+ }
+ r = (mp_value_node) mp->temp_head;
+ while (mp_get_dep_info(p) != NULL) {
+ if (scaling_down) {
+ mp_number x, absv;
+ new_number_abs(absv, v);
+ if (number_less(absv, p_over_v_threshold_k)) {
+ new_number_clone(x, v);
+ convert_scaled_to_fraction(x);
+ make_scaled(w, mp_get_dep_value(p), x);
+ } else {
+ new_number_clone(x, mp_get_dep_value(p));
+ fraction_to_round_scaled(x);
+ make_scaled(w, x, v);
+ }
+ free_number(x);
+ free_number(absv);
+ } else {
+ make_scaled(w, mp_get_dep_value(p), v);
+ }
+ {
+ mp_number test;
+ new_number(test);
+ number_abs_clone(test, w);
+ if (number_lessequal(test, threshold)) {
+ s = (mp_value_node) mp_link(p);
+ mp_free_dep_node(mp, p);
+ p = s;
+ } else {
+ if (number_greaterequal(test, coef_bound_k)) {
+ mp->fix_needed = 1;
+ mp_type(mp_get_dep_info(p)) = independent_needing_fix;
+ }
+ mp_set_link(r, p);
+ r = p;
+ mp_set_dep_value(p, w);
+ p = (mp_value_node) mp_link(p);
+ }
+ free_number(test);
+ }
+ }
+ mp_set_link(r, p);
+ {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, mp_get_dep_value(p), v);
+ mp_set_dep_value(p, ret);
+ free_number(ret);
+ }
+ free_number(v);
+ free_number(w);
+ free_number(threshold);
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+@ Here's another utility routine for dependency lists. When an independent
+variable becomes dependent, we want to remove it from all existing dependencies.
+The |p_with_x_becoming_q| function computes the dependency list of~|p| after
+variable~|x| has been replaced by~|q|.
+
+This procedure has basically the same calling conventions as |p_plus_fq|:
+List~|q| is unchanged; list~|p| is destroyed; the constant node and the final
+link are inherited from~|p|; and the fourth parameter tells whether or not |p| is
+|mp_proto_dependent|. However, the global variable |dep_final| is not altered if
+|x| does not occur in list~|p|.
+
+@c
+static mp_value_node mp_p_with_x_becoming_q (MP mp, mp_value_node p, mp_node x, mp_node q, int t)
+{
+ mp_value_node s = p;
+ mp_value_node r = (mp_value_node) mp->temp_head;
+ int sx = mp_get_indep_value(x); /* serial number of |x| */
+ while (mp_get_dep_info(s) != NULL && mp_get_indep_value(mp_get_dep_info(s)) > sx) {
+ r = s;
+ s = (mp_value_node) mp_link(s);
+ }
+ if (mp_get_dep_info(s) == NULL || mp_get_dep_info(s) != x) {
+ return p;
+ } else {
+ mp_value_node ret;
+ mp_number v1;
+ mp_set_link(mp->temp_head, p);
+ mp_set_link(r, mp_link(s));
+ new_number_clone(v1, mp_get_dep_value(s));
+ mp_free_dep_node(mp, s);
+ ret = mp_p_plus_fq(mp, (mp_value_node) mp_link(mp->temp_head), &v1, (mp_value_node) q, t, mp_dependent_type);
+ free_number(v1);
+ return ret;
+ }
+}
+
+@ Here's a simple procedure that reports an error when a variable has just
+received a known value that's out of the required range.
+
+@<Declarations@>=
+static void mp_val_too_big (MP mp, mp_number *x);
+
+@ @c
+static void mp_val_too_big (MP mp, mp_number *x)
+{
+ if (number_positive(internal_value(mp_warning_check_internal))) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Value is too large (%s)", number_tostring(*x));
+ mp_error(
+ mp,
+ msg,
+ "The equation I just processed has given some variable a value outside of the\n"
+ "safetyp range. Continue and I'll try to cope with that big value; but it might be\n"
+ "dangerous. (Set 'warningcheck := 0' to suppress this message.)"
+ );
+ }
+}
+
+@ When a dependent variable becomes known, the following routine removes its
+dependency list. Here |p| points to the variable, and |q| points to the
+dependency list (which is one node long).
+
+@<Declarations@>=
+static void mp_make_known (MP mp, mp_value_node p, mp_value_node q);
+
+@ @c
+void mp_make_known (MP mp, mp_value_node p, mp_value_node q)
+{
+ mp_variable_type t = mp_type(p); /* the previous type */
+ mp_number absp;
+ new_number(absp);
+ mp_set_prev_dep(mp_link(q), mp_get_prev_dep(p));
+ mp_set_link(mp_get_prev_dep(p), mp_link(q));
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, mp_get_dep_value(q));
+ mp_free_dep_node(mp, q);
+ number_abs_clone(absp, mp_get_value_number(p));
+ if (number_greaterequal(absp, warning_limit_t)) {
+ mp_val_too_big (mp, &(mp_get_value_number(p)));
+ }
+ if ((number_positive(internal_value(mp_tracing_equations_internal))) && mp_interesting(mp, (mp_node) p)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "#### ");
+ mp_print_variable_name(mp, (mp_node) p);
+ mp_print_chr(mp, '=');
+ print_number(mp_get_value_number(p));
+ mp_end_diagnostic(mp, 0);
+ }
+ if (cur_exp_node == (mp_node) p && mp->cur_exp.type == t) {
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ mp_free_value_node(mp, (mp_node) p);
+ }
+ free_number(absp);
+}
+
+@ The |fix_dependencies| routine is called into action when |fix_needed|
+has been triggered. The program keeps a list~|s| of independent variables
+whose coefficients must be divided by~4.
+
+In unusual cases, this fixup process might reduce one or more coefficients
+to zero, so that a variable will become known more or less by default.
+
+@<Declarations@>=
+static void mp_fix_dependencies (MP mp);
+
+@ @d independent_being_fixed 1 /* this variable already appears in |s| */
+
+@ @c
+static void mp_fix_dependencies (MP mp)
+{
+ mp_value_node r = (mp_value_node) mp_link(mp->dep_head);
+ mp_value_node s = NULL;
+ while (r != mp->dep_head) {
+ /*
+ Run through the dependency list for variable |t|, fixing all nodes,
+ and ending with final link~|q|
+ */
+ mp_value_node t = r;
+ mp_value_node q;
+ while (1) {
+ mp_node x;
+ if (t == r) {
+ q = (mp_value_node) mp_get_dep_list(t);
+ } else {
+ q = (mp_value_node) mp_link(r);
+ }
+ x = mp_get_dep_info(q);
+ if (x == NULL) {
+ break;
+ } else if (mp_type(x) <= independent_being_fixed) {
+ if (mp_type(x) < independent_being_fixed) {
+ mp_value_node p = mp_get_dep_node(mp);
+ mp_set_link(p, s);
+ s = p;
+ mp_set_dep_info(s, x);
+ mp_type(x) = independent_being_fixed;
+ }
+ mp_set_dep_value(q, mp_get_dep_value(q));
+ number_divide_int(mp_get_dep_value(q), 4);
+ if (number_zero(mp_get_dep_value(q))) {
+ mp_set_link(r, mp_link(q));
+ mp_free_dep_node(mp, q);
+ q = r;
+ }
+ }
+ r = q;
+ }
+ r = (mp_value_node) mp_link(q);
+ if (q == (mp_value_node) mp_get_dep_list(t)) {
+ mp_make_known(mp, t, q);
+ }
+ }
+ while (s != NULL) {
+ mp_value_node p = (mp_value_node) mp_link(s);
+ mp_node x = mp_get_dep_info(s);
+ mp_free_dep_node(mp, s);
+ s = p;
+ mp_type(x) = mp_independent_type;
+ mp_set_indep_scale(x, mp_get_indep_scale(x) + 2);
+ }
+ mp->fix_needed = 0;
+}
+
+@ The |new_dep| routine installs a dependency list~|p| based on the value
+node~|q|, linking it into the list of all known dependencies. It replaces |q|
+with the new dependency node. We assume that |dep_final| points to the final node
+of list~|p|.
+
+@c
+static void mp_new_dep (MP mp, mp_node q, mp_variable_type newtype, mp_value_node p)
+{
+ mp_node r; /* what used to be the first dependency */
+ mp_type(q) = newtype;
+ mp_set_dep_list(q, p);
+ mp_set_prev_dep(q, (mp_node) mp->dep_head);
+ r = mp_link(mp->dep_head);
+ mp_set_link(mp->dep_final, r);
+ mp_set_prev_dep(r, (mp_node) mp->dep_final);
+ mp_set_link(mp->dep_head, q);
+}
+
+@ Here is one of the ways a dependency list gets started.
+The |const_dependency| routine produces a list that has nothing but
+a constant term.
+
+@c
+static mp_value_node mp_const_dependency (MP mp, mp_number *v)
+{
+ mp->dep_final = mp_get_dep_node(mp);
+ mp_set_dep_value(mp->dep_final, *v);
+ mp_set_dep_info(mp->dep_final, NULL);
+ return mp->dep_final;
+}
+
+@ And here's a more interesting way to start a dependency list from scratch: The
+parameter to |single_dependency| is the location of an independent variable~|x|,
+and the result is the simple dependency list |x+0|.
+
+In the unlikely event that the given independent variable has been doubled so
+often that we can't refer to it with a nonzero coefficient, |single_dependency|
+returns the simple list `0'. This case can be recognized by testing that the
+returned list pointer is equal to |dep_final|.
+
+@d two_to_the(A) (1<<(unsigned)(A))
+
+@ @c
+static mp_value_node mp_single_dependency (MP mp, mp_node p)
+{
+ mp_value_node q; /* the new dependency list */
+ int m = mp_get_indep_scale(p); /* the number of doublings */
+ if (m > 28) {
+ q = mp_const_dependency(mp, &zero_t);
+ } else {
+ mp_value_node rr;
+ q = mp_get_dep_node(mp);
+ mp_set_dep_value(q, zero_t);
+ set_number_from_scaled(mp_get_dep_value(q), (int) two_to_the(28 - m));
+ mp_set_dep_info(q, p);
+ rr = mp_const_dependency(mp, &zero_t);
+ mp_set_link(q, rr);
+ }
+ return q;
+}
+
+@ We sometimes need to make an exact copy of a dependency list.
+
+@c
+static mp_value_node mp_copy_dep_list (MP mp, mp_value_node p)
+{
+ mp_value_node q = mp_get_dep_node(mp); /* the new dependency list */
+ mp->dep_final = q;
+ while (1) {
+ mp_set_dep_info(mp->dep_final, mp_get_dep_info(p));
+ mp_set_dep_value(mp->dep_final, mp_get_dep_value(p));
+ if (mp_get_dep_info(mp->dep_final) == NULL) {
+ break;
+ } else {
+ mp_set_link(mp->dep_final, mp_get_dep_node(mp));
+ mp->dep_final = (mp_value_node) mp_link(mp->dep_final);
+ p = (mp_value_node) mp_link(p);
+ }
+ }
+ return q;
+}
+
+@ But how do variables normally become known? Ah, now we get to the heart of the
+equation-solving mechanism. The |linear_eq| procedure is given a |dependent| or
+|mp_proto_dependent| list,~|p|, in which at least one independent variable
+appears. It equates this list to zero, by choosing an independent variable with
+the largest coefficient and making it dependent on the others. The newly
+dependent variable is eliminated from all current dependencies, thereby possibly
+making other dependent variables known.
+
+The given list |p| is, of course, totally destroyed by all this processing.
+
+@c
+static mp_value_node find_node_with_largest_coefficient (MP mp, mp_value_node p, mp_number *v);
+
+static void display_new_dependency (MP mp, mp_value_node p, mp_node x, int n);
+
+static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, int n);
+
+static mp_value_node divide_p_by_minusv_removing_q (MP mp,
+ mp_value_node p, mp_value_node q,
+ mp_value_node *final_node, mp_number *v, int t
+);
+
+static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, int n);
+
+static void mp_linear_eq (MP mp, mp_value_node p, int t)
+{
+ mp_value_node r; /* for link manipulation */
+ mp_node x; /* the variable that loses its independence */
+ int n; /* the number of times |x| had been halved */
+ mp_number v; /* the coefficient of |x| in list |p| */
+ mp_value_node prev_r; /* lags one step behind |r| */
+ mp_value_node final_node; /* the constant term of the new dependency list */
+ mp_value_node qq;
+ new_number(v);
+ qq = find_node_with_largest_coefficient(mp, p, &v);
+ x = mp_get_dep_info(qq);
+ n = mp_get_indep_scale(x);
+ p = divide_p_by_minusv_removing_q(mp, p, qq, &final_node, &v, t);
+ if (number_positive(internal_value(mp_tracing_equations_internal))) {
+ display_new_dependency(mp, p, (mp_node) x, n);
+ }
+ prev_r = (mp_value_node) mp->dep_head;
+ r = (mp_value_node) mp_link(mp->dep_head);
+ while (r != mp->dep_head) {
+ mp_value_node s = (mp_value_node) mp_get_dep_list(r);
+ mp_value_node q = mp_p_with_x_becoming_q(mp, s, x, (mp_node) p, mp_type(r));
+ if (mp_get_dep_info(q) == NULL) {
+ mp_make_known(mp, r, q);
+ } else {
+ mp_set_dep_list(r, q);
+ do {
+ q = (mp_value_node) mp_link(q);
+ } while (mp_get_dep_info(q) != NULL);
+ prev_r = q;
+ }
+ r = (mp_value_node) mp_link(prev_r);
+ }
+ if (n > 0) {
+ p = divide_p_by_2_n(mp, p, n);
+ }
+ change_to_known(mp, p, (mp_node) x, final_node, n);
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ free_number(v);
+}
+
+@ @c
+static mp_value_node find_node_with_largest_coefficient (MP mp, mp_value_node p, mp_number *v)
+{
+ mp_number vabs; /* its absolute value of v*/
+ mp_number rabs; /* the absolute value of |mp_get_dep_value(r)| */
+ mp_value_node q = p;
+ mp_value_node r = (mp_value_node) mp_link(p);
+ new_number(vabs);
+ new_number(rabs);
+ number_clone(*v, mp_get_dep_value(q));
+ while (mp_get_dep_info(r) != NULL) {
+ number_abs_clone(vabs, *v);
+ number_abs_clone(rabs, mp_get_dep_value(r));
+ if (number_greater(rabs, vabs)) {
+ q = r;
+ number_clone(*v, mp_get_dep_value(r));
+ }
+ r = (mp_value_node) mp_link(r);
+ }
+ free_number(vabs);
+ free_number(rabs);
+ return q;
+}
+
+@ Here we want to change the coefficients from |scaled| to |fraction|, except in
+the constant term. In the common case of a trivial equation like |x=3.14|, we
+will have |v=-fraction_one|, |q=p|, and |t=mp_dependent|.
+
+@c
+static mp_value_node divide_p_by_minusv_removing_q (MP mp,
+ mp_value_node p, mp_value_node q,
+ mp_value_node *final_node, mp_number *v, int t
+)
+{
+ mp_value_node r = p; /* for link manipulation */
+ mp_value_node s = (mp_value_node) mp->temp_head;
+ mp_set_link(s, p);
+ do {
+ if (r == q) {
+ mp_set_link(s, mp_link(r));
+ mp_free_dep_node(mp, r);
+ } else {
+ mp_number w; /* a tentative coefficient */
+ mp_number absw;
+ new_number(w);
+ new_number(absw);
+ make_fraction(w, mp_get_dep_value(r), *v);
+ number_abs_clone(absw, w);
+ if (number_lessequal(absw, half_fraction_threshold_k)) {
+ mp_set_link(s, mp_link(r));
+ mp_free_dep_node(mp, r);
+ } else {
+ number_negate(w);
+ mp_set_dep_value(r, w);
+ s = r;
+ }
+ free_number(w);
+ free_number(absw);
+ }
+ r = (mp_value_node) mp_link(s);
+ } while (mp_get_dep_info(r) != NULL);
+ if (t == mp_proto_dependent_type) {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, mp_get_dep_value(r), *v);
+ number_negate(ret);
+ mp_set_dep_value(r, ret);
+ free_number(ret);
+ } else if (number_to_scaled(*v) != -number_to_scaled(fraction_one_t)) {
+ mp_number ret;
+ new_fraction(ret);
+ make_fraction(ret, mp_get_dep_value(r), *v);
+ number_negate(ret);
+ mp_set_dep_value(r, ret);
+ free_number(ret);
+ }
+ *final_node = r;
+ return (mp_value_node) mp_link(mp->temp_head);
+}
+
+@ @c
+static void display_new_dependency (MP mp, mp_value_node p, mp_node x, int n)
+{
+ if (mp_interesting(mp, x)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "## ");
+ mp_print_variable_name(mp, x);
+ while (n > 0) {
+ mp_print_str(mp, "*4");
+ n = n - 2;
+ }
+ mp_print_chr(mp, '=');
+ mp_print_dependency(mp, p, mp_dependent_type);
+ mp_end_diagnostic(mp, 0);
+ }
+}
+
+@ The |n > 0| test is repeated here because it is of vital importance to the
+function's functioning.
+
+@c
+static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, int n)
+{
+ mp_value_node pp = NULL;
+ if (n > 0) {
+ /* Divide list |p| by $2^n$ */
+ mp_value_node r;
+ mp_value_node s;
+ mp_number absw;
+ mp_number w; /* a tentative coefficient */
+ new_number(w);
+ new_number(absw);
+ s = (mp_value_node) mp->temp_head;
+ mp_set_link(mp->temp_head, p);
+ r = p;
+ do {
+ if (n > 30) {
+ set_number_to_zero(w);
+ } else {
+ number_clone(w, mp_get_dep_value(r));
+ number_divide_int(w, two_to_the(n));
+ }
+ number_abs_clone(absw, w);
+ if (number_lessequal(absw, half_fraction_threshold_k) && (mp_get_dep_info(r) != NULL)) {
+ mp_set_link(s, mp_link(r));
+ mp_free_dep_node(mp, r);
+ } else {
+ mp_set_dep_value(r, w);
+ s = r;
+ }
+ r = (mp_value_node) mp_link(s);
+ } while (mp_get_dep_info(s) != NULL);
+ pp = (mp_value_node) mp_link(mp->temp_head);
+ free_number(absw);
+ free_number(w);
+ }
+ return pp;
+}
+
+@ @c
+static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, int n)
+{
+ (void) n;
+ if (mp_get_dep_info(p) == NULL) {
+ mp_number absx;
+ mp_type(x) = mp_known_type;
+ mp_set_value_number(x, mp_get_dep_value(p));
+ new_number_abs(absx, mp_get_value_number(x));
+ if (number_greaterequal(absx, warning_limit_t)) {
+ mp_val_too_big(mp, &(mp_get_value_number(x)));
+ }
+ free_number(absx);
+ mp_free_dep_node(mp, p);
+ if (cur_exp_node == x && mp->cur_exp.type == mp_independent_type) {
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(x)));
+ mp->cur_exp.type = mp_known_type;
+ mp_free_value_node(mp, x);
+ }
+ } else {
+ mp->dep_final = final_node;
+ mp_new_dep(mp, x, mp_dependent_type, p);
+ if (cur_exp_node == x && mp->cur_exp.type == mp_independent_type) {
+ mp->cur_exp.type = mp_dependent_type;
+ }
+ }
+}
+
+@* Dynamic nonlinear equations.
+
+Variables of numeric type are maintained by the general scheme of independent,
+dependent, and known values that we have just studied; and the components of pair
+and transform variables are handled in the same way. But \MP\ also has five other
+types of values: |boolean|, |string|, |pen|, |path|, and |picture|;
+what about them?
+
+Equations are allowed between nonlinear quantities, but only in a simple form.
+Two variables that haven't yet been assigned values are either equal to each
+other, or they're not.
+
+Before a boolean variable has received a value, its type is |mp_unknown_boolean|;
+similarly, there are variables whose type is |mp_unknown_string|,
+|mp_unknown_pen|, |mp_unknown_path|, and |mp_unknown_picture|. In such cases the
+value is either |NULL| (which means that no other variables are equivalent to
+this one), or it points to another variable of the same undefined type. The
+pointers in the latter case form a cycle of nodes, which we shall call a
+\quote {ring.} Rings of undefined variables may include capsules, which arise as
+intermediate results within expressions or as |expr| parameters to macros.
+
+When one member of a ring receives a value, the same value is given to all the
+other members. In the case of paths and pictures, this implies making separate
+copies of a potentially large data structure; users should restrain their
+enthusiasm for such generality, unless they have lots and lots of memory space.
+
+@ The following procedure is called when a capsule node is being added to a ring
+(e.g., when an unknown variable is mentioned in an expression).
+
+@c
+static mp_node mp_new_ring_entry (MP mp, mp_node p)
+{
+ mp_node q = mp_new_value_node(mp); /* the new capsule node */
+ mp_name_type(q) = mp_capsule_operation;
+ mp_type(q) = mp_type(p);
+ if (mp_get_value_node(p) == NULL) {
+ mp_set_value_node(q, p);
+ } else {
+ mp_set_value_node(q, mp_get_value_node(p));
+ }
+ mp_set_value_node(p, q);
+ return q;
+}
+
+@ Conversely, we might delete a capsule or a variable before it becomes known.
+The following procedure simply detaches a quantity from its ring, without
+recycling the storage.
+
+@<Declarations@>=
+static void mp_ring_delete (MP mp, mp_node p);
+
+@ @c
+void mp_ring_delete (MP mp, mp_node p)
+{
+ (void) mp;
+ mp_node q = mp_get_value_node(p);
+ if (q != NULL && q != p) {
+ while (mp_get_value_node(q) != p) {
+ q = mp_get_value_node(q);
+ }
+ mp_set_value_node(q, mp_get_value_node(p));
+ }
+}
+
+@ Eventually there might be an equation that assigns values to all of the
+variables in a ring. The |nonlinear_eq| subroutine does the necessary propagation
+of values.
+
+If the parameter |flush_p| is |true|, node |p| itself needn't receive a value, it
+will soon be recycled.
+
+@c
+static void mp_nonlinear_eq (MP mp, mp_value v, mp_node p, int flush_p)
+{
+ mp_variable_type t = mp_type(p) - unknown_tag; /* the type of ring |p| */
+ mp_node q = mp_get_value_node(p);
+ if (flush_p) {
+ mp_type(p) = mp_vacuous_type;
+ } else {
+ p = q;
+ }
+ do {
+ mp_node r = mp_get_value_node(q);
+ mp_type(q) = t;
+ switch (t) {
+ case mp_boolean_type:
+ mp_set_value_number(q, v.data.n);
+ break;
+ case mp_string_type:
+ mp_set_value_str(q, v.data.str);
+ add_str_ref(v.data.str);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_set_value_knot(q, mp_copy_pen(mp, v.data.p));
+ break;
+ case mp_path_type:
+ mp_set_value_knot(q, mp_copy_path(mp, v.data.p));
+ break;
+ case mp_picture_type:
+ mp_set_value_node(q, v.data.node);
+ mp_add_edge_ref(mp, v.data.node);
+ break;
+ default:
+ break;
+ }
+ /* there ain't no more cases */
+ q = r;
+ } while (q != p);
+}
+
+@ If two members of rings are equated, and if they have the same type, the
+|ring_merge| procedure is called on to make them equivalent.
+
+@c
+static void mp_ring_merge (MP mp, mp_node p, mp_node q)
+{
+ mp_node r = mp_get_value_node(p); /* traverses one list */
+ while (r != p) {
+ if (r == q) {
+ mp_exclaim_redundant_equation(mp);
+ return;
+ } else {
+ r = mp_get_value_node(r);
+ }
+ }
+ r = mp_get_value_node(p);
+ mp_set_value_node(p, mp_get_value_node(q));
+ mp_set_value_node(q, r);
+}
+
+@ @c
+static void mp_exclaim_redundant_equation (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Redundant equation",
+ "I already knew that this equation was true. But perhaps no harm has been done;\n"
+ "let's continue."
+ );
+ mp_get_x_next(mp);
+}
+
+@ @<Declarations@>=
+static void mp_exclaim_redundant_equation (MP mp);
+
+@* Introduction to the syntactic routines.
+
+Let's pause a moment now and try to look at the Big Picture. The \MP\ program
+consists of three main parts: syntactic routines, semantic routines, and output
+routines. The chief purpose of the syntactic routines is to deliver the user's
+input to the semantic routines, while parsing expressions and locating operators
+and operands. The semantic routines act as an interpreter responding to these
+operators, which may be regarded as commands. And the output routines are
+periodically called on to produce compact font descriptions that can be used for
+typesetting or for making interim proof drawings. We have discussed the basic
+data structures and many of the details of semantic operations, so we are good
+and ready to plunge into the part of \MP\ that actually controls the activities.
+
+Our current goal is to come to grips with the |get_next| procedure, which is the
+keystone of \MP's input mechanism. Each call of |get_next| sets the value of
+three variables |cur_cmd|, |cur_mod|, and |cur_sym|, representing the next input
+token.
+
+$$
+\vbox{\halign{#\hfil\cr
+ \hbox{|cur_cmd| denotes a command code from the long list of codes given
+ earlier;}\cr
+ \hbox{|cur_mod| denotes a modifier or operand of the command code;}\cr
+ \hbox{|cur_sym| is the hash address of the symbolic token that was just
+ scanned,}\cr
+ \hbox{\qquad or zero in the case of a numeric or string or capsule
+ token.}\cr}}
+$$
+
+Underlying this external behavior of |get_next| is all the machinery necessary to
+convert from character files to tokens. At a given time we may be only partially
+finished with the reading of several files (for which |input| was specified),
+and partially finished with the expansion of some user-defined macros and/or some
+macro parameters, and partially finished reading some text that the user has
+inserted online, and so on. When reading a character file, the characters must be
+converted to tokens; comments and blank spaces must be removed, numeric and
+string tokens must be evaluated.
+
+To handle these situations, which might all be present simultaneously, \MP\ uses
+various stacks that hold information about the incomplete activities, and there
+is a finite state control for each level of the input mechanism. These stacks
+record the current state of an implicitly recursive process, but the |get_next|
+procedure is not recursive.
+
+@d cur_cmd mp->cur_mod_->command
+@d cur_mod number_to_scaled(mp->cur_mod_->data.n)
+@d cur_mod_number mp->cur_mod_->data.n
+@d cur_mod_node mp->cur_mod_->data.node
+@d cur_mod_str mp->cur_mod_->data.str
+@d cur_sym mp->cur_mod_->data.sym
+@d cur_sym_mod mp->cur_mod_->name_type
+
+@d set_cur_cmd(A) mp->cur_mod_->command = (A)
+@d set_cur_mod(A) set_number_from_scaled(mp->cur_mod_->data.n, (A))
+@d set_cur_mod_number(A) number_clone(mp->cur_mod_->data.n, (A))
+@d set_cur_mod_node(A) mp->cur_mod_->data.node = (A)
+@d set_cur_mod_str(A) mp->cur_mod_->data.str = (A)
+@d set_cur_sym(A) mp->cur_mod_->data.sym = (A)
+@d set_cur_sym_mod(A) mp->cur_mod_->name_type = (A)
+
+@<Glob...@>=
+mp_node cur_mod_; /* current command, symbol, and its operands */
+
+@ @<Initialize table...@>=
+mp->cur_mod_ = mp_new_symbolic_node(mp);
+
+@ @<Free table...@>=
+mp_free_symbolic_node(mp, mp->cur_mod_);
+
+@ The |print_cmd_mod| routine prints a symbolic interpretation of a command code
+and its modifier. It consists of a rather tedious sequence of print commands, and
+most of it is essentially an inverse to the |primitive| routine that enters a
+\MP\ primitive into |hash| and |eqtb|. Therefore almost all of this procedure
+appears elsewhere in the program, together with the corresponding |primitive|
+calls.
+
+@<Declarations@>=
+static const char *mp_cmd_mod_string (MP mp, int c, int m);
+static void mp_print_cmd_mod (MP mp, int c, int m);
+
+@ @c
+const char *mp_cmd_mod_string (MP mp, int c, int m)
+{
+ switch (c) {
+ @<Cases of |print_cmd_mod| for symbolic printing of primitives@>
+ }
+ return "[unknown command code!]";
+}
+
+void mp_print_cmd_mod (MP mp, int c, int m)
+{
+ mp_print_str(mp, mp_cmd_mod_string(mp, c, m));
+}
+
+@ Here is a procedure that displays a given command in braces, in the
+user's transcript file.
+
+@c
+static void mp_show_cmd_mod (MP mp, int c, int m)
+{
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{");
+ switch (c) {
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ mp_print_cmd_mod(mp, mp_macro_def_command, c);
+ mp_print_str(mp, "'d macro:");
+ mp_print_ln(mp);
+ mp_show_token_list(mp, mp_link(mp_link(cur_mod_node)),0);
+ break;
+ default:
+ mp_print_cmd_mod(mp, c, m);
+ break;
+ }
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+}
+
+@* Input stacks and states.
+
+The state of \MP's input mechanism appears in the input stack, whose entries are
+records with five fields, called |index|, |start|, |loc|, |limit|, and |name|.
+The top element of this stack is maintained in a global variable for which no
+subscripting needs to be done; the other elements of the stack appear in an
+array. Hence the stack is declared thus:
+
+@<Types...@>=
+typedef struct mp_in_state_record {
+ int start_field;
+ int loc_field;
+ int limit_field;
+ int index_field;
+ mp_node nstart_field;
+ mp_node nloc_field;
+ mp_string name_field;
+} mp_in_state_record;
+
+@ @<Glob...@>=
+mp_in_state_record *input_stack;
+int input_ptr; /* first unused location of |input_stack| */
+int max_in_stack; /* largest value of |input_ptr| when pushing */
+mp_in_state_record cur_input; /* the \quote {top} input state */
+int stack_size; /* maximum number of simultaneous input sources */
+
+@ @<Allocate or initialize ...@>=
+mp->stack_size = 16;
+mp->input_stack = mp_memory_allocate((size_t) (mp->stack_size + 1) * sizeof(mp_in_state_record));
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->input_stack);
+
+@ We've already defined the special variable |loc==cur_input.loc_field| in our
+discussion of basic input-output routines. The other components of |cur_input|
+are defined in the same way:
+
+@d iindex mp->cur_input.index_field /* reference for buffer information */
+@d start mp->cur_input.start_field /* starting position in |buffer| */
+@d limit mp->cur_input.limit_field /* end of current line in |buffer| */
+@d name mp->cur_input.name_field /* name of the current file */
+
+@ Let's look more closely now at the five control variables
+(|index|,~|start|,~|loc|,~|limit|,~|name|), assuming that \MP\ is reading a line
+of characters that have been input from some file or from the user's terminal.
+There is an array called |buffer| that acts as a stack of all lines of characters
+that are currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \MP\ will return to the
+other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it would be
+appropriate to combine |buffer| with the |str_pool| array, letting the buffer
+entries grow downward from the top of the string pool and checking that these two
+tables don't bump into each other.)
+
+The line we are currently working on begins in position |start| of the buffer;
+the next character we are about to read is |buffer[loc]|; and |limit| is the
+location of the last character present. We always have |loc<=limit|. For
+convenience, |buffer[limit]| has been set to |"%"|, so that the end of a line is
+easily sensed.
+
+The |name| variable is a string number that designates the name of the current
+file, if we are reading an ordinary text file. Special codes
+|is_term..max_spec_src| indicate other sources of input text.
+
+@d is_term (mp_string) 0 /* |name| value when reading from the terminal for normal input */
+@d is_read (mp_string) 1 /* |name| value when executing a |readstring| or |readfrom| */
+@d is_scantok (mp_string) 2 /* |name| value when reading text generated by |scantokens| */
+
+@d max_spec_src is_scantok
+
+@ Additional information about the current line is available via the |index|
+variable, which counts how many lines of characters are present in the buffer
+below the current level. We have |index=0| when reading from the terminal and
+prompting the user for each line; then if the user types, e.g., |input figs|,
+we will have |index=1| while reading the file |figs.mp|. However, it does not
+follow that |index| is the same as the input stack pointer, since many of the
+levels on the input stack may come from token lists.
+
+The global variable |in_open| is equal to the highest |index| value excluding
+token-list input levels. Thus, the number of partially read lines in the buffer
+is |in_open+1| and we have |in_open>=index| when we are not reading a token list.
+
+If we are not currently reading from the terminal, we are reading from the file
+variable |input_file[index]|. We use the notation |terminal_input| as a
+convenient abbreviation for |name=is_term|, and |cur_file| as an abbreviation for
+|input_file[index]|.
+
+When \MP\ is not reading from the terminal, the global variable |line| contains
+the line number in the current file, for use in error messages. More precisely,
+|line| is a macro for |line_stack[index]| and the |line_stack| array gives the
+line number for each file in the |input_file| array.
+
+If more information about the input state is needed, it can be included in small
+arrays like those shown here. For example, the current page or segment number in
+the input file might be put into a variable |page|, that is really a macro for
+the current entry in `\ignorespaces|page_stack:array[0..max_in_open] of
+integer|\unskip' by analogy with |line_stack|. @^system dependencies@>
+
+@d terminal_input (name == is_term) /* are we reading from the terminal? */
+@d cur_file mp->input_file[iindex] /* the current |void *| variable */
+@d line mp->line_stack[iindex] /* current line number in the current source file */
+
+@<Glob...@>=
+int in_open; /* the number of lines in the buffer, less one */
+int in_open_max; /* highest value of |in_open| ever seen */
+unsigned int open_parens; /* the number of open text files */
+void **input_file;
+int *line_stack; /* the line number for each file */
+
+@ @<Declarations@>=
+static void mp_reallocate_input_stack (MP mp, int newsize);
+
+@ @c
+static void mp_reallocate_input_stack (MP mp, int newsize)
+{
+ int n = newsize + 1;
+ mp->input_file = mp_memory_reallocate(mp->input_file, (size_t) (n + 1) * sizeof(void *));
+ mp->line_stack = mp_memory_reallocate(mp->line_stack, (size_t) (n + 1) * sizeof(int));
+ for (int k = mp->max_in_open; k <= n; k++) {
+ mp->input_file[k] = NULL;
+ mp->line_stack[k] = 0;
+ }
+ mp->max_in_open = newsize;
+}
+
+@ This has to be more than |file_bottom|, so:
+@<Allocate or ...@>=
+mp_reallocate_input_stack(mp, mp_file_bottom_text + 4);
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->input_file);
+mp_memory_free(mp->line_stack);
+
+@ However, all this discussion about input state really applies only to the case
+that we are inputting from a file. There is another important case, namely when
+we are currently getting input from a token list. In this case
+|iindex>max_in_open|, and the conventions about the other state variables are
+different:
+
+\yskip\hang|nloc| is a pointer to the current node in the token list, i.e., the
+node that will be read next. If |nloc=NULL|, the token list has been fully read.
+
+\yskip\hang|start| points to the first node of the token list; this node may or
+may not contain a reference count, depending on the type of token list involved.
+
+\yskip\hang|token_type|, which takes the place of |iindex| in the discussion
+above, is a code number that explains what kind of token list is being scanned.
+
+\yskip\hang|name| points to the |eqtb| address of the control sequence being
+expanded, if the current token list is a macro not defined by |vardef|. Macros
+defined by |vardef| have |name=NULL|; their name can be deduced by looking at
+their first two parameters.
+
+\yskip\hang|param_start|, which takes the place of |limit|, tells where the
+parameters of the current macro or loop text begin in the |param_stack|.
+
+\yskip\noindent The |token_type| can take several values, depending on where the
+current token list came from:
+
+\yskip \indent|forever_text|, if the token list being scanned is the body of a
+|forever| loop;
+
+\indent|loop_text|, if the token list being scanned is the body of a |for| or
+|forsuffixes| loop;
+
+\indent|parameter|, if a |text| or |suffix| parameter is being scanned;
+
+\indent|backed_up|, if the token list being scanned has been inserted as `to be
+read again'.
+
+\indent|inserted|, if the token list being scanned has been inserted as part of
+error recovery;
+
+\indent|macro|, if the expansion of a user-defined symbolic token is being
+scanned.
+
+\yskip\noindent The token list begins with a reference count if and only if
+|token_type= macro|. @^reference counts@>
+
+@d nloc mp->cur_input.nloc_field /* location of next node node */
+@d nstart mp->cur_input.nstart_field /* location of next node node */
+
+@d token_type iindex /* type of current token list */
+@d token_state (iindex<=mp_macro_text) /* are we scanning a token list? */
+@d file_state (iindex>mp_macro_text) /* are we scanning a file line? */
+@d param_start limit /* base of macro parameters in |param_stack| */
+
+
+@ @<Enumeration types@>=
+typedef enum mp_text_codes {
+ mp_forever_text, /* |token_type| code for loop texts */
+ mp_loop_text, /* |token_type| code for loop texts */
+ mp_parameter_text, /* |token_type| code for parameter texts */
+ mp_backed_up_text, /* |token_type| code for texts to be reread */
+ mp_inserted_text, /* |token_type| code for inserted texts */
+ mp_macro_text, /* |token_type| code for macro replacement texts */
+ mp_file_bottom_text, /* lowest file code */
+} mp_text_codes;
+
+@ The |param_stack| is an auxiliary array used to hold pointers to the token
+lists for parameters at the current level and subsidiary levels of input. This
+stack grows at a different rate from the others, and is dynamically reallocated
+when needed.
+
+@<Glob...@>=
+mp_node *param_stack; /* token list pointers for parameters */
+int param_ptr; /* first unused entry in |param_stack| */
+int max_param_stack; /* largest value of |param_ptr| */
+
+@ @<Allocate or initialize ...@>=
+mp->param_stack = mp_memory_allocate((size_t) (mp->param_size + 1) * sizeof(mp_node));
+
+@ @c
+static void mp_check_param_size (MP mp, int k)
+{
+ while (k >= mp->param_size) {
+ mp->param_stack = mp_memory_reallocate(mp->param_stack, (size_t) ((k + k / 4) + 1) * sizeof(mp_node));
+ mp->param_size = k + k / 4;
+ }
+}
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->param_stack);
+
+@ Notice that the |line| isn't valid when |token_state| is true because it
+depends on |iindex|. If we really need to know the line number for the topmost
+file in the iindex stack we use the following function. If a page number or other
+information is needed, this routine should be modified to compute it as well.
+@^system dependencies@>
+
+@<Declarations@>=
+static int mp_true_line (MP mp);
+
+@ @c
+int mp_true_line (MP mp)
+{
+ int k; /* an index into the input stack */
+ if (file_state && (name > max_spec_src)) {
+ return line;
+ } else {
+ k = mp->input_ptr;
+ while ((k > 0) && ((mp->input_stack[(k - 1)].index_field < mp_file_bottom_text)
+ || (mp->input_stack[(k - 1)].name_field <= max_spec_src))) {
+ --k;
+ }
+ return (k > 0 ? mp->line_stack[(k - 1) + mp_file_bottom_text] : 0);
+ }
+}
+
+@ Thus, the \quote {current input state} can be very complicated indeed; there can be
+many levels and each level can arise in a variety of ways. The |show_context|
+procedure, which is used by \MP's error-reporting routine to print out the
+current input state on all levels down to the most recent line of characters from
+an input file, illustrates most of these conventions. The global variable
+|file_ptr| contains the lowest level that was displayed by this procedure.
+
+@<Glob...@>=
+int file_ptr; /* shallowest level shown by |show_context| */
+
+@ The status at each level is indicated by printing two lines, where the first
+line indicates what was read so far and the second line shows what remains to be
+read. Non-current input levels whose |token_type| is |backed_up| are shown only if
+they have not been fully read.
+
+@c
+void mp_show_context (MP mp)
+{
+ /* prints where the scanner is */
+ mp->file_ptr = mp->input_ptr;
+ mp->input_stack[mp->file_ptr] = mp->cur_input;
+ /* store current state */
+ while (1) {
+ /* enter into the context */
+ mp->cur_input = mp->input_stack[mp->file_ptr];
+ @<Display the current context@>
+ if (file_state && (name > max_spec_src || mp->file_ptr == 0)) {
+ break;
+ } else {
+ --mp->file_ptr;
+ }
+ }
+ /* restore original state */
+ mp->cur_input = mp->input_stack[mp->input_ptr];
+}
+
+@ @<Display the current context@>=
+/* we omit backed-up token lists that have already been read */
+if ((mp->file_ptr == mp->input_ptr) || file_state || (token_type != mp_backed_up_text) || (nloc != NULL)) {
+ if (file_state) {
+ @<Print location of current line@>
+ if (limit > 0) {
+ for (int i = start; i <= limit - 1; i++) {
+ mp_print_chr(mp, mp->buffer[i]);
+ }
+ }
+ } else {
+ @<Print type of token list@>
+ if (token_type == mp_macro_text) {
+ mp_show_macro(mp, nstart, nloc);
+ } else if (mp->show_mode) {
+ mp_show_token_list_space(mp, nstart, nloc);
+ } else {
+ mp_show_token_list(mp, nstart, nloc);
+ }
+ }
+}
+
+@ This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file. For example, on
+some systems it is best to print both a page and line number. @^system
+dependencies@>
+
+@<Print location of current line@>=
+if (name > max_spec_src) {
+ /* mp_print_nl(mp, "l."); */
+ mp_print_nl(mp, "<line ");
+ mp_print_int(mp, mp_true_line(mp));
+ mp_print_chr(mp, '>');
+} else if (terminal_input) {
+ if (mp->file_ptr == 0) {
+ mp_print_nl(mp, "<direct>");
+ } else {
+ mp_print_nl(mp, "<insert>");
+ }
+} else if (name == is_scantok) {
+ mp_print_nl(mp, "<scantokens>");
+} else {
+ mp_print_nl(mp, "<read>");
+}
+mp_print_chr(mp, ' ');
+
+@ Can't use case statement here because the |token_type| is not a constant
+expression.
+
+@<Print type of token list@>=
+{
+ switch (token_type) {
+ case mp_forever_text:
+ mp_print_nl(mp, "<forever> ");
+ break;
+ case mp_loop_text:
+ @<Print the current loop value@>
+ break;
+ case mp_parameter_text:
+ mp_print_nl(mp, "<argument> ");
+ break;
+ case mp_backed_up_text:
+ mp_print_nl(mp, nloc == NULL ? "<recently read> " : "<to be read again> ");
+ break;
+ case mp_inserted_text:
+ mp_print_nl(mp, "<inserted text> ");
+ break;
+ case mp_macro_text:
+ mp_print_nl(mp, "<macro> ");
+ // mp_print_ln(mp);
+ if (name != NULL) {
+ mp_print_mp_str(mp, name);
+ } else {
+ @<Print the name of a |vardef|'d macro@>
+ }
+ // mp_print_str(mp, "->");
+ mp_print_str(mp, " -> ");
+ break;
+ default:
+ mp_print_nl(mp, "?"); /* this should never happen */
+ @.?\relax@>
+ break;
+ }
+}
+
+@ The parameter that corresponds to a loop text is either a token list (in the
+case of |forsuffixes|) or a \quote {capsule} (in the case of |for|). We'll discuss
+capsules later; for now, all we need to know is that the |link| field in a
+capsule parameter is |void| and that |print_exp(p,0)| displays the value of
+capsule~|p| in abbreviated form.
+
+@<Print the current loop value@>=
+{
+ mp_node pp = mp->param_stack[param_start];
+ mp_print_nl(mp, "<for(");
+ if (pp != NULL) {
+ if (mp_link(pp) == MP_VOID) {
+ mp_print_exp(mp, pp, 0); /* we're in a |for| loop */
+ } else {
+ mp_show_token_list(mp, pp, NULL);
+ }
+ }
+ mp_print_str(mp, ")> ");
+}
+
+@ The first two parameters of a macro defined by |vardef| will be token
+lists representing the macro's prefix and \quote {at point.} By putting these
+together, we get the macro's full name.
+
+@<Print the name of a |vardef|'d macro@>=
+{
+ mp_node pp = mp->param_stack[param_start];
+ if (pp == NULL) {
+ mp_show_token_list(mp, mp->param_stack[param_start + 1], NULL);
+ } else {
+ mp_node qq = pp;
+ while (mp_link(qq) != NULL) {
+ qq = mp_link(qq);
+ }
+ mp_link(qq) = mp->param_stack[param_start + 1];
+ mp_show_token_list(mp, pp, NULL);
+ mp_link(qq) = NULL;
+ }
+}
+
+@* Maintaining the input stacks.
+
+The following subroutines change the input status in commonly needed ways.
+
+First comes |mp_push_input|, which stores the current state and creates a
+new level (having, initially, the same properties as the old). We could have
+a maximum depth here.
+
+@<Declarations@>=
+static void mp_push_input (MP mp);
+
+@ @c
+void mp_push_input (MP mp)
+{
+ if (mp->input_ptr > mp->max_in_stack) {
+ mp->max_in_stack = mp->input_ptr;
+ if (mp->input_ptr == mp->stack_size) {
+ int l = (mp->stack_size + (mp->stack_size/4));
+ if (l > 1000) {
+ mp_fatal_error(mp, "job aborted, more than 1000 input levels");
+ } else {
+ mp_in_state_record *s = mp_memory_reallocate(mp->input_stack, (size_t) (l + 1) * sizeof(mp_in_state_record));
+ if (s) {
+ mp->input_stack = s;
+ mp->stack_size = l;
+ } else {
+ mp_fatal_error(mp, "job aborted, out of memory");
+ }
+ }
+ }
+ }
+ mp->input_stack[mp->input_ptr] = mp->cur_input;
+ ++mp->input_ptr;
+}
+
+@ And of course what goes up must come down.
+
+@<Declarations@>=
+static void mp_pop_input (MP mp);
+
+@ @c
+
+void mp_pop_input (MP mp)
+{
+ --mp->input_ptr;
+ mp->cur_input = mp->input_stack[mp->input_ptr];
+}
+
+@ Here is a procedure that starts a new level of token-list input, given a token
+list |p| and its type |t|. If |t=macro|, the calling routine should set |name|,
+reset~|loc|, and increase the macro's reference count.
+
+@c
+static void mp_begin_token_list (MP mp, mp_node p, int t)
+{
+ mp_push_input(mp);
+ nstart = p;
+ token_type = t;
+ param_start = mp->param_ptr;
+ nloc = p;
+}
+
+@ When a token list has been fully scanned, the following computations should be
+done as we leave that level of input. @^inner loop@>
+
+@c
+static void mp_end_token_list (MP mp)
+{
+ /* leave a token-list input level */
+ if (token_type >= mp_backed_up_text) {
+ /* token list to be deleted */
+ if (token_type <= mp_inserted_text) {
+ mp_flush_token_list(mp, nstart);
+ goto DONE;
+ } else {
+ /* update reference count */
+ mp_delete_mac_ref(mp, nstart);
+ }
+ }
+ while (mp->param_ptr > param_start) {
+ /* parameters must be flushed */
+ mp_node p; /* temporary register */
+ --mp->param_ptr;
+ p = mp->param_stack[mp->param_ptr];
+ if (p != NULL) {
+ if (mp_link(p) == MP_VOID) {
+ /* it's an |expr| parameter */
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ } else {
+ /* it's a |suffix| or |text| parameter */
+ mp_flush_token_list(mp, p);
+ }
+ }
+ }
+ DONE:
+ mp_pop_input(mp);
+}
+
+@ The contents of |cur_cmd, cur_mod, cur_sym| are placed into an equivalent
+token by the |cur_tok| routine.
+@^inner loop@>
+
+@c
+@<Declare the procedure called |make_exp_copy|@>
+static mp_node mp_cur_tok (MP mp)
+{
+ mp_node p; /* a new token node */
+ if (cur_sym == NULL && (cur_sym_mod == 0 || cur_sym_mod == mp_normal_operation)) {
+ if (cur_cmd == mp_capsule_command) {
+ mp_number save_exp_num; /* possible |cur_exp| numerical to be restored */
+ mp_value save_exp = mp->cur_exp; /* |cur_exp| to be restored */
+ new_number(save_exp_num);
+ number_clone(save_exp_num, cur_exp_value_number);
+ mp_make_exp_copy(mp, cur_mod_node);
+ p = mp_stash_cur_exp(mp);
+ mp_link(p) = NULL;
+ mp->cur_exp = save_exp;
+ number_clone(mp->cur_exp.data.n, save_exp_num);
+ free_number(save_exp_num);
+ } else {
+ p = mp_new_token_node(mp);
+ mp_name_type(p) = mp_token_operation;
+ if (cur_cmd == mp_numeric_command) {
+ mp_set_value_number(p, cur_mod_number);
+ mp_type(p) = mp_known_type;
+ } else {
+ mp_set_value_str(p, cur_mod_str);
+ mp_type(p) = mp_string_type;
+ }
+ }
+ } else {
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, cur_sym);
+ mp_name_type(p) = cur_sym_mod;
+ }
+ return p;
+}
+
+@ Sometimes \MP\ has read too far and wants to \quote {unscan} what it has seen. The
+|back_input| procedure takes care of this by putting the token just scanned back
+into the input stream, ready to be read again. If |cur_sym<>0|, the values of
+|cur_cmd| and |cur_mod| are irrelevant.
+
+@<Declarations@>=
+static void mp_back_input (MP mp);
+
+@ @c
+void mp_back_input (MP mp)
+{
+ /* undoes one token of input */
+ mp_node p = mp_cur_tok(mp); /* a token list of length one */
+ /* conserve stack space */
+ while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp);
+ }
+ mp_begin_token_list(mp, p, mp_backed_up_text);
+}
+
+@ The |back_error| routine is used when we want to restore or replace an
+offending token just before issuing an error message.
+
+@<Declarations@>=
+static void mp_back_error (MP mp, const char *msg, const char *hlp) ;
+
+@ @c
+static void mp_back_error (MP mp, const char *msg, const char *hlp)
+{
+ /* back up one token and call |error| */
+ mp_back_input(mp);
+ mp_error(mp, msg, hlp);
+}
+
+static void mp_ins_error (MP mp, const char *msg, const char *hlp)
+{
+ /* back up one inserted token and call |error| */
+ mp_back_input(mp);
+ token_type = mp_inserted_text;
+ mp_error(mp, msg, hlp);
+}
+
+@ The |begin_file_reading| procedure starts a new level of input for lines of
+characters to be read from a file, or as an insertion from the terminal. It does
+not take care of opening the file, nor does it set |loc| or |limit| or |line|.
+@^system dependencies@>
+
+@c
+void mp_begin_file_reading (MP mp)
+{
+ if (mp->in_open == (mp->max_in_open-1)) {
+ mp_reallocate_input_stack (mp, (mp->max_in_open + mp->max_in_open / 4));
+ }
+ if (mp->first == mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + mp->buf_size / 4));
+ }
+ mp->in_open++;
+ mp_push_input(mp);
+ iindex = (int) mp->in_open;
+ if (mp->in_open_max < mp->in_open) {
+ mp->in_open_max = mp->in_open;
+ }
+ start = (int) mp->first;
+ name = is_term; /* |terminal_input| is now |true| */
+}
+
+@ Conversely, the variables must be downdated when such a level of input is
+finished. While finishing preloading, it is possible that the file does not
+actually end with 'dump', so we capture that case here as well.
+
+@c
+static void mp_end_file_reading (MP mp)
+{
+ if (mp->in_open > iindex) {
+ if ((name <= max_spec_src)) {
+ mp_confusion(mp, "endinput");
+ @:this can't happen endinput}{\quad endinput@>
+ } else {
+ (mp->close_file) (mp, mp->input_file[mp->in_open]);
+ --mp->in_open;
+ }
+ }
+ mp->first = (size_t) start;
+ if (iindex != mp->in_open) {
+ mp_confusion(mp, "endinput");
+ } else {
+ if (name > max_spec_src) {
+ (mp->close_file) (mp, cur_file);
+ }
+ mp_pop_input(mp);
+ --mp->in_open;
+ }
+}
+
+@* Getting the next token.
+
+The heart of \MP's input mechanism is the |get_next| procedure, which we shall
+develop in the next few sections of the program. Perhaps we shouldn't actually
+call it the \quote {heart,} however; it really acts as \MP's eyes and mouth, reading
+the source files and gobbling them up. And it also helps \MP\ to regurgitate
+stored token lists that are to be processed again.
+
+The main duty of |get_next| is to input one token and to set |cur_cmd| and
+|cur_mod| to that token's command code and modifier. Furthermore, if the input
+token is a symbolic token, that token's |hash| address is stored in |cur_sym|;
+otherwise |cur_sym| is set to zero.
+
+Underlying this simple description is a certain amount of complexity because of
+all the cases that need to be handled. However, the inner loop of |get_next| is
+reasonably short and fast.
+
+@ Before getting into |get_next|, we need to consider a mechanism by which \MP\
+helps keep errors from propagating too far. Whenever the program goes into a mode
+where it keeps calling |get_next| repeatedly until a certain condition is met, it
+sets |scanner_status| to some value other than |normal|. Then if an input file
+ends, or if an |outer| symbol appears, an appropriate error recovery will be
+possible.
+
+The global variable |warning_info| helps in this error recovery by providing
+additional information. For example, |warning_info| might indicate the name of a
+macro whose replacement text is being scanned.
+
+@ @<Enumeration types@>=
+typedef enum mp_scanner_states {
+ mp_normal_state, /* |scanner_status| at \quote {quiet times} */
+ mp_skipping_state, /* |scanner_status| when false conditional text is being skipped */
+ mp_flushing_state, /* |scanner_status| when junk after a statement is being ignored */
+ mp_absorbing_state, /* |scanner_status| when a |text| parameter is being scanned */
+ mp_var_defining_state, /* |scanner_status| when a |vardef| is being scanned */
+ mp_op_defining_state, /* |scanner_status| when a macro |def| is being scanned */
+ mp_loop_defining_state, /* |scanner_status| when a |for| loop is being scanned */
+ mp_tex_flushing_state,
+} mp_scanner_states;
+
+@ @<Glob...@>=
+int scanner_status; /* are we scanning at high speed? */
+mp_sym warning_info; /* if so, what else do we need to know, in case an error occurs? */
+int warning_line;
+mp_node warning_info_node;
+
+@ The following subroutine is called when an |outer| symbolic token has been
+scanned or when the end of a file has been reached. These two cases are
+distinguished by |cur_sym|, which is zero at the end of a file.
+
+@c
+static int mp_check_outer_validity (MP mp)
+{
+ if (mp->scanner_status == mp_normal_state) {
+ return 1;
+ } else if (mp->scanner_status == mp_tex_flushing_state) {
+ @<Check if the file has ended while flushing \TeX\ material and set the result value for |check_outer_validity|@>
+ } else {
+ @<Back up an outer symbolic token so that it can be reread@>
+ if (mp->scanner_status > mp_skipping_state) {
+ @<Tell the user what has run away and try to recover@>
+ } else {
+ char msg[256];
+ const char *hlp = NULL;
+ mp_snprintf(msg, 256, "Incomplete if; all text was ignored after line %d", (int) mp->warning_line);
+ @.Incomplete if...@>
+ if (cur_sym == NULL) {
+ hlp =
+ "The file ended while I was skipping conditional text. This kind of error happens\n"
+ "when you say 'if ...' and forget the matching 'fi'. I've inserted a 'fi'; this\n"
+ "might work.";
+ } else {
+ hlp =
+ "A forbidden 'outer' token occurred in skipped text. This kind of error happens\n"
+ "when you say 'if ...' and forget the matching 'fi'. I've inserted a 'fi'; this\n"
+ "might work.";
+ }
+ set_cur_sym(mp->frozen_fi);
+ mp_ins_error(mp, msg, hlp);
+ }
+ return 0;
+ }
+}
+
+@ @<Check if the file has ended while flushing \TeX\ material and set...@>=
+if (cur_sym != NULL) {
+ return 1;
+} else {
+ char msg[256];
+ mp_snprintf(msg, 256, "TeX mode didn't end; all text was ignored after line %d", (int) mp->warning_line);
+ set_cur_sym(mp->frozen_etex);
+ mp_ins_error(
+ mp,
+ msg,
+ "The file ended while I was looking for the 'etex' to finish this TeX material.\n"
+ "I've inserted 'etex' now."
+ );
+ return 0;
+}
+
+@ @<Back up an outer symbolic token so that it can be reread@>=
+// if (cur_sym != NULL) {
+// mp_node p = mp_new_symbolic_node(mp);
+// mp_set_sym_sym(p, cur_sym);
+// mp_name_type(p) = cur_sym_mod;
+// /* prepare to read the symbolic token again */
+// mp_begin_token_list(mp, p, mp_backed_up_text);
+// }
+
+@ @<Tell the user what has run away...@>=
+{
+ char msg[256];
+ const char *mst = NULL;
+ const char *hlp =
+ "I suspect you have forgotten an 'enddef', causing me to read past where you\n"
+ "wanted me to stop. I'll try to recover.";
+ mp_runaway(mp);
+ /* print the definition-so-far */
+ if (cur_sym == NULL) {
+ mst = "File ended while scanning";
+ @.File ended while scanning...@>
+ } else {
+ mst = "Forbidden token found while scanning";
+ @.Forbidden token found...@>
+ }
+ switch (mp->scanner_status) {
+ case mp_flushing_state:
+ {
+ mp_snprintf(msg, 256, "%s to the end of the statement", mst);
+ hlp =
+ "A previous error seems to have propagated, causing me to read past where\n"
+ "you wanted me to stop. I'll try to recover.";
+ set_cur_sym(mp->frozen_semicolon);
+ }
+ break;
+ case mp_absorbing_state:
+ {
+ mp_snprintf(msg, 256, "%s a text argument", mst);
+ hlp =
+ "It seems that a right delimiter was left out, causing me to read past where\n"
+ "you wanted me to stop. I'll try to recover.";
+ if (mp->warning_info == NULL) {
+ set_cur_sym(mp->frozen_end_group);
+ } else {
+ set_cur_sym(mp->frozen_right_delimiter);
+ /*
+ The next line makes sure that the inserted delimiter will match the
+ delimiter that already was read.
+ */
+ set_equiv_sym(cur_sym, mp->warning_info);
+ }
+ }
+ break;
+ case mp_var_defining_state:
+ {
+ mp_string s;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_variable_name(mp, mp->warning_info_node);
+ s = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "%s the definition of %s", mst, s->str);
+ delete_str_ref(s);
+ set_cur_sym(mp->frozen_end_def);
+ }
+ break;
+ case mp_op_defining_state:
+ {
+ char *s = mp_str(mp, text(mp->warning_info));
+ mp_snprintf(msg, 256, "%s the definition of %s", mst, s);
+ set_cur_sym(mp->frozen_end_def);
+ }
+ break;
+ case mp_loop_defining_state:
+ {
+ char *s = mp_str(mp, text(mp->warning_info));
+ mp_snprintf(msg, 256, "%s the text of a %s loop", mst, s);
+ hlp =
+ "I suspect you have forgotten an 'endfor', causing me to read past where\n"
+ "you wanted me to stop. I'll try to recover.";
+ set_cur_sym(mp->frozen_end_for);
+ }
+ break;
+ }
+ mp_ins_error(mp, msg, hlp);
+}
+
+@ The |runaway| procedure displays the first part of the text that occurred when
+\MP\ began its special |scanner_status|, if that text has been saved.
+
+@<Declarations@>=
+static void mp_runaway (MP mp);
+
+@ @c
+void mp_runaway (MP mp)
+{
+ if (mp->scanner_status > mp_flushing_state) {
+ mp_print_nl(mp, "Runaway ");
+ switch (mp->scanner_status) {
+ case mp_absorbing_state:
+ mp_print_str(mp, "text?");
+ break;
+ case mp_var_defining_state:
+ case mp_op_defining_state:
+ mp_print_str(mp, "definition?");
+ break;
+ case mp_loop_defining_state:
+ mp_print_str(mp, "loop?");
+ break;
+ }
+ mp_print_ln(mp);
+ mp_show_token_list(mp, mp_link(mp->hold_head), NULL);
+ }
+}
+
+@ We need to mention a procedure that may be called by |get_next|.
+
+@<Declarations@>=
+static void mp_firm_up_the_line (MP mp);
+
+@ And now we're ready to take the plunge into |get_next| itself. Note that the
+behavior depends on the |scanner_status| because percent signs and double quotes
+need to be passed over when skipping TeX material.
+
+@c
+void mp_get_next (MP mp)
+{
+ /* sets |cur_cmd|, |cur_mod|, |cur_sym| to next token */
+ mp_sym cur_sym_; /* speed up access */
+ RESTART:
+ set_cur_sym(NULL);
+ set_cur_sym_mod(0);
+ if (file_state) {
+ int k; /* an index into |buffer| */
+ unsigned char c; /* the current character in the buffer */
+ int cclass; /* its class number */
+ /*
+ Input from external file; |goto restart| if no input found, or
+ |return| if a non-symbolic token is found. A percent sign appears in
+ |buffer[limit]|; this makes it unnecessary to have a special test for
+ end-of-line.
+ */
+ SWITCH:
+ c = mp->buffer[loc];
+ ++loc;
+ cclass = mp->char_class[c];
+ switch (cclass) {
+ case mp_digit_class:
+ scan_numeric_token((c - '0'));
+ return;
+ case mp_period_class:
+ cclass = mp->char_class[mp->buffer[loc]];
+ if (cclass > mp_period_class) {
+ goto SWITCH;
+ } else if (cclass < mp_period_class) {
+ /* |class=digit_class| */
+ scan_fractional_token(0);
+ return;
+ } else {
+ break;
+ }
+ case mp_space_class:
+ goto SWITCH;
+ case mp_percent_class:
+ if (mp->scanner_status == mp_tex_flushing_state && loc < limit) {
+ /* btex .. etex */
+ goto SWITCH;
+ }
+ /*
+ Move to next line of file, or |goto restart| if there is no
+ next line.
+ */
+ if (mp_move_to_next_line(mp)) {
+ goto RESTART;
+ } else {
+ goto SWITCH;
+ }
+ case mp_string_class:
+ if (mp->scanner_status == mp_tex_flushing_state) {
+ goto SWITCH;
+ } else {
+ unsigned char cend = c == '"' ? '"' : 3 ; /* ASCII BTX ... ETX */
+ if (mp->buffer[loc] == cend) {
+ set_cur_mod_str(mp_rts(mp,""));
+ } else {
+ k = loc;
+ mp->buffer[limit + 1] = cend;
+ do {
+ ++loc;
+ } while (mp->buffer[loc] != cend);
+ if (loc > limit) {
+ /*
+ Decry the missing string delimiter and |goto restart|. We go to
+ |restart| after this error message, not to |SWITCH|, because the
+ |clear_for_error_prompt| routine might have reinstated
+ |token_state| after |error| has finished.
+ */
+ loc = limit;
+ /* the next character to be read on this line will be |"%"| */
+ mp_error(
+ mp,
+ "Incomplete string token has been flushed",
+ "Strings should finish on the same line as they began. I've deleted the partial\n"
+ "string."
+ );
+ goto RESTART;
+ }
+ mp_str_room(mp, (size_t) (loc - k));
+ do {
+ mp_append_char(mp, mp->buffer[k]);
+ ++k;
+ } while (k != loc);
+ set_cur_mod_str(mp_make_string(mp));
+ }
+ ++loc;
+ set_cur_cmd(mp_string_command);
+ return;
+ }
+ case mp_comma_class:
+ case mp_semicolon_class:
+ case mp_left_parenthesis_class:
+ case mp_right_parenthesis_class:
+ k = loc - 1;
+ goto FOUND;
+ case mp_invalid_class:
+ if (mp->scanner_status == mp_tex_flushing_state) {
+ goto SWITCH;
+ } else {
+ /*
+ Decry the invalid character and |goto restart|. We go to
+ |restart| instead of to |SWITCH|, because we might enter
+ |token_state| after the error has been dealt with (cf.\
+ |clear_for_error_prompt|).
+ */
+ mp_error(
+ mp,
+ "Text line contains an invalid character",
+ "A funny symbol that I can\'t read has just been input. Continue, and I'll forget\n"
+ "that it ever happened."
+ );
+ goto RESTART;
+ }
+ default:
+ /* letters, etc. */
+ break;
+ }
+ k = loc - 1;
+ while (mp->char_class[mp->buffer[loc]] == cclass) {
+ ++loc;
+ }
+ FOUND:
+ set_cur_sym(mp_id_lookup(mp, (char *) (mp->buffer + k), (size_t) (loc - k), 1));
+ } else {
+ /*
+ Input from token list; |goto restart| if end of list or if a parameter
+ needs to be expanded, or |return| if a non-symbolic token is found.
+ */
+ if (nloc != NULL && mp_type(nloc) == mp_symbol_node_type) {
+ /* symbolic token */
+ int cur_sym_mod_ = mp_name_type(nloc);
+ int cur_info = mp_get_sym_info(nloc);
+ set_cur_sym(mp_get_sym_sym(nloc));
+ set_cur_sym_mod(cur_sym_mod_);
+ /* move to next */
+ nloc = mp_link(nloc);
+ if (cur_sym_mod_ == mp_expr_operation) {
+ set_cur_cmd(mp_capsule_command);
+ set_cur_mod_node(mp->param_stack[param_start + cur_info]);
+ set_cur_sym_mod(0);
+ set_cur_sym(NULL);
+ return;
+ } else if (cur_sym_mod_ == mp_suffix_operation || cur_sym_mod_ == mp_text_operation) {
+ mp_begin_token_list(mp, mp->param_stack[param_start + cur_info], (int) mp_parameter_text);
+ goto RESTART;
+ }
+ } else if (nloc != NULL) {
+ /* Get a stored numeric or string or capsule token and |return| */
+ if (mp_name_type(nloc) == mp_token_operation) {
+ if (mp_type(nloc) == mp_known_type) {
+ set_cur_mod_number(mp_get_value_number(nloc));
+ set_cur_cmd(mp_numeric_command);
+ } else {
+ set_cur_mod_str(mp_get_value_str(nloc));
+ set_cur_cmd(mp_string_command);
+ add_str_ref(cur_mod_str);
+ }
+ } else {
+ set_cur_mod_node(nloc);
+ set_cur_cmd(mp_capsule_command);
+ }
+ nloc = mp_link(nloc);
+ return;
+ } else {
+ /* we are done with this token list */
+ mp_end_token_list(mp);
+ /* resume previous level */
+ goto RESTART;
+ }
+ }
+ /*
+ When a symbolic token is declared to be |outer|, its command code is
+ increased by |outer_tag|.
+ */
+ cur_sym_ = cur_sym;
+ set_cur_cmd(eq_type(cur_sym_));
+ set_cur_mod(equiv(cur_sym_));
+ set_cur_mod_node(equiv_node(cur_sym_));
+ // if (cur_cmd >= mp_outer_tag_command) {
+ // if (mp_check_outer_validity(mp)) {
+ // set_cur_cmd(cur_cmd - mp_outer_tag_command);
+ // } else {
+ // goto RESTART;
+ // }
+ // }
+}
+
+@ The global variable |force_eof| is normally |false|; it is set |true| by an
+|endinput| command.
+
+@<Glob...@>=
+int force_eof; /* should the next |input| be aborted early? */
+
+@ @<Declarations@>=
+static int mp_move_to_next_line (MP mp);
+
+@ @c
+static int mp_move_to_next_line (MP mp)
+{
+ if (name > max_spec_src) {
+ /*
+ Read next line of file into |buffer|, or return 1 (|goto restart|) if
+ the file has ended. We must decrement |loc| in order to leave the
+ buffer in a valid state when an error condition causes us to |goto
+ restart| without calling |end_file_reading|.
+ */
+ ++line;
+ mp->first = (size_t) start;
+ if (! mp->force_eof) {
+ if (mp_input_ln(mp, cur_file)) { /* not end of file */
+ mp_firm_up_the_line(mp); /* this sets |limit| */
+ } else {
+ mp->force_eof = 1;
+ }
+ };
+ if (mp->force_eof) {
+ mp->force_eof = 0;
+ --loc;
+ if (mp->interaction < mp_silent_mode) {
+ mp_print_chr(mp, ')');
+ --mp->open_parens;
+ /* show user that file has been read */
+ update_terminal();
+ }
+ /* resume previous level */
+ mp_end_file_reading(mp);
+ mp_check_outer_validity(mp);
+ return 1;
+ } else {
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start; /* ready to read */
+ }
+ } else if (mp->input_ptr > 0) {
+ /* text was inserted during error recovery or by |scantokens| */
+ mp_end_file_reading(mp);
+ /* goto RESTART */
+ return 1; /* resume previous level */
+ } else if (mp->interaction > mp_nonstop_mode) {
+ if (limit == start && mp->interaction < mp_silent_mode) {
+ /* previous line was empty */
+ mp_print_nl(mp, "(Please type a command or say `end')");
+ }
+ mp_print_ln(mp);
+ mp->first = (size_t) start;
+ /* get a line from the terminal, prompt delegated */
+ if (! mp_input_ln(mp, mp->term_in)) {
+ longjmp(*(mp->jump_buf), 1);
+ }
+ mp->buffer[mp->last] = '%';
+ /* done */
+ limit = (int) mp->last;
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ } else {
+ mp_fatal_error(mp, "job aborted, no legal end found");
+ }
+ return 0;
+}
+
+@ If the user has set the |mp_pausing| parameter to some positive value, and if
+nonstop mode has not been selected, each line of input is displayed on the
+terminal and the transcript file, followed by |=>|. \MP\ waits for a
+response. If the response is NULL (i.e., if nothing is typed except perhaps a few
+blank spaces), the original line is accepted as it stands; otherwise the line
+typed is used instead of the line in the file.
+
+@c
+void mp_firm_up_the_line (MP mp)
+{
+ limit = (int) mp->last;
+}
+
+@* Dealing with \TeX\ material.
+
+The |btex|$\,\ldots\,$|etex| and |verbatimtex|$\,\ldots\,$|etex| features
+need to be implemented at a low level in the scanning process so that \MP\ can
+stay in synch with the a preprocessor that treats blocks of \TeX\ material as
+they occur in the input file without trying to expand \MP\ macros. Thus we need a
+special version of |get_next| that does not expand macros and such but does
+handle |btex|, |verbatimtex|, etc.
+
+@ @<Enumeration types@>=
+typedef enum mp_verbatim_codes {
+ mp_btex_code,
+ mp_verbatim_code,
+} mp_verbatim_codes;
+
+@ @<Put each...@>=
+mp_primitive(mp, "btex", mp_btex_command, mp_btex_code);
+@:btex_}{|btex| primitive@>
+mp_primitive(mp, "verbatimtex", mp_btex_command, mp_verbatim_code);
+@:verbatimtex_}{|verbatimtex| primitive@>
+mp_primitive(mp, "etex", mp_etex_command, 0);
+mp->frozen_etex = mp_frozen_primitive (mp, "etex", mp_etex_command, 0);
+@:etex_}{|etex| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_btex_command: return m == mp_btex_code ? "btex" : "verbatimtex";
+case mp_etex_command: return "etex";
+
+@ Actually, |get_t_next| is a macro that avoids procedure overhead except in the
+unusual case where |btex|, |verbatimtex| or |etex| is encountered. Nowadays
+the compiler deals with this so it might become a function.
+
+@d get_t_next(mp) do {
+ mp_get_next(mp);
+ if (cur_cmd <= mp_max_pre_command) {
+ mp_t_next(mp); /* will probably get inlined anyway */
+ }
+} while (0)
+
+@c
+@ @<Declarations@>=
+static void mp_t_next (MP mp);
+
+@ @c
+static void mp_t_next (MP mp)
+{
+ if ((mp->extensions == 1) && (cur_cmd == mp_btex_command)) {
+ @<Pass btex ... etex to script@>
+ } else {
+ @<Complain about a misplaced |btex|@>
+ }
+}
+
+@ @<Complain about a misplaced |btex|@>=
+{
+ mp_error(
+ mp,
+ "A 'btex/verbatimtex ... etex' definition needs an extension",
+ "This file contains picture expressions for 'btex ... etex' blocks. Such files\n"
+ "need an extension (plugin) that seems to be absent."
+ );
+}
+
+@* Scanning macro definitions.
+
+\MP\ has a variety of ways to tuck tokens away into token lists for later use:
+Macros can be defined with |def|, |vardef|, |primarydef|, etc.; repeatable
+code can be defined with |for|, |forever|, |forsuffixes|. All such
+operations are handled by the routines in this part of the program.
+
+The modifier part of each command code is zero for the \quote {ending delimiters} like
+|enddef| and |endfor|.
+
+@ @<Enumeration types@>=
+typedef enum mp_def_codes {
+ mp_end_def_code, /* command modifier for |enddef| */
+ mp_def_code, /* command modifier for |def| */
+ mp_var_def_code, /* command modifier for |vardef| */
+ mp_primary_def_code, /* command modifier for |primarydef| */
+ mp_secondary_def_code, /* command modifier for |secondarydef| */
+ mp_tertiary_def_code, /* command modifier for |tertiarydef| */
+} mp_def_codes;
+
+@ @<Enumeration types@>=
+typedef enum mp_only_set_codes {
+ mp_random_seed_code,
+ mp_max_knot_pool_code,
+} mp_only_set_codes;
+
+@ @<Enumeration types@>=
+typedef enum mp_for_codes {
+ mp_end_for_code, /* command modifier for |endfor| */
+ mp_start_forever_code, /* command modifier for |forever| */
+ mp_start_for_code, /* command modifier for |for| */
+ mp_start_forsuffixes_code, /* command modifier for |forsuffixes| */
+} mp_for_codes;
+
+@ @<Put each...@>=
+mp_primitive(mp, "def", mp_macro_def_command, mp_def_code);
+@:def_}{|def| primitive@>
+mp_primitive(mp, "vardef", mp_macro_def_command, mp_var_def_code);
+@:var_def_}{|vardef| primitive@>
+mp_primitive(mp, "primarydef", mp_macro_def_command, mp_primary_def_code);
+@:primary_def_}{|primarydef| primitive@>
+mp_primitive(mp, "secondarydef", mp_macro_def_command, mp_secondary_def_code);
+@:secondary_def_}{|secondarydef| primitive@>
+mp_primitive(mp, "tertiarydef", mp_macro_def_command, mp_tertiary_def_code);
+@:tertiary_def_}{|tertiarydef| primitive@>
+mp_primitive(mp, "enddef", mp_macro_def_command, mp_end_def_code);
+mp->frozen_end_def = mp_frozen_primitive(mp, "enddef", mp_macro_def_command, mp_end_def_code);
+@:end_def_}{|enddef| primitive@>
+mp_primitive(mp, "for", mp_iteration_command, mp_start_for_code);
+@:for_}{|for| primitive@>
+mp_primitive(mp, "forsuffixes", mp_iteration_command, mp_start_forsuffixes_code);
+@:for_suffixes_}{|forsuffixes| primitive@>
+mp_primitive(mp, "forever", mp_iteration_command, mp_start_forever_code);
+@:forever_}{|forever| primitive@>
+mp_primitive(mp, "endfor", mp_iteration_command, mp_end_for_code);
+mp->frozen_end_for = mp_frozen_primitive (mp, "endfor", mp_iteration_command, mp_end_for_code);
+@:end_for_}{|endfor| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_macro_def_command:
+ switch (m) {
+ /* low numbers, command specifiers */
+ case mp_end_def_code : return "enddef";
+ case mp_def_code : return "def";
+ case mp_var_def_code : return "vardef";
+ case mp_primary_def_code : return "primarydef";
+ case mp_secondary_def_code: return "secondarydef";
+ case mp_tertiary_def_code : return "tertiarydef";
+ default: return "?def";
+ }
+ break;
+
+case mp_iteration_command:
+ switch (m) {
+ case mp_end_for_code : return "endfor";
+ case mp_start_forever_code : return "forever";
+ case mp_start_for_code : return "for";
+ case mp_start_forsuffixes_code: return "forsuffixes";
+ }
+ break;
+
+case mp_only_set_command:
+ switch (m) {
+ case mp_random_seed_code : return"randomseed";
+ case mp_max_knot_pool_code: return"maxknotpool";
+ }
+ break;
+
+@ Different macro-absorbing operations have different syntaxes, but they also
+have a lot in common. There is a list of special symbols that are to be replaced
+by parameter tokens; there is a special command code that ends the definition;
+the quotation conventions are identical. Therefore it makes sense to have most of
+the work done by a single subroutine. That subroutine is called |scan_toks|.
+
+The first parameter to |scan_toks| is the command code that will terminate
+scanning (either |macro_def| or |iteration|).
+
+The second parameter, |subst_list|, points to a (possibly empty) list of
+non-symbolic nodes whose |info| and |value| fields specify symbol tokens before
+and after replacement. The list will be returned to free storage by |scan_toks|.
+
+The third parameter is simply appended to the token list that is built. And the
+final parameter tells how many of the special operations |\#\AT!|, |\AT!|,
+and |\AT!\#| are to be replaced by suffix parameters. When such parameters are
+present, they are called |(SUFFIX0)|, |(SUFFIX1)|, and |(SUFFIX2)|.
+
+@<Types...@>=
+typedef struct mp_subst_list_item {
+ mp_name_type_type info_mod;
+ int value_mod;
+ int value_data;
+ int padding;
+ mp_sym info;
+ struct mp_subst_list_item *link;
+} mp_subst_list_item;
+
+@ @c
+static mp_node mp_scan_toks (MP mp, mp_command_code terminator, mp_subst_list_item * subst_list, mp_node tail_end, int suffix_count)
+{
+ int cur_data;
+ int cur_data_mod = 0;
+ mp_node p = mp->hold_head; /* tail of the token list being built */
+ int balance = 1; /* left delimiters minus right delimiters */
+ mp_link(mp->hold_head) = NULL;
+ while (1) {
+ get_t_next(mp);
+ cur_data = -1;
+ if (cur_sym != NULL) {
+ @<Substitute for |cur_sym|, if it's on the |subst_list|@>
+ if (cur_cmd == terminator) {
+ @<Adjust the balance; |break| if it's zero@>
+ } else if (cur_cmd == mp_macro_special_command) {
+ /* Handle quoted symbols, |\#\AT!|, |\AT!|, or |\AT!\#| */
+ if (cur_mod == mp_macro_quote_code) {
+ get_t_next(mp);
+ } else if (cur_mod <= suffix_count) {
+ cur_data = cur_mod - 1;
+ cur_data_mod = mp_suffix_operation;
+ }
+ }
+ }
+ if (cur_data != -1) {
+ mp_node pp = mp_new_symbolic_node(mp);
+ mp_set_sym_info(pp, cur_data);
+ mp_name_type(pp) = cur_data_mod;
+ mp_link(p) = pp;
+ } else {
+ mp_link(p) = mp_cur_tok(mp);
+ }
+ p = mp_link(p);
+ }
+ mp_link(p) = tail_end;
+ while (subst_list) {
+ mp_subst_list_item *q = subst_list->link;
+ mp_memory_free(subst_list);
+ subst_list = q;
+ }
+ return mp_link(mp->hold_head);
+}
+
+@ @<Substitute for |cur_sym|...@>=
+{
+ mp_subst_list_item *q = subst_list;
+ while (q != NULL) {
+ if (q->info == cur_sym && q->info_mod == cur_sym_mod) {
+ cur_data = q->value_data;
+ cur_data_mod = q->value_mod;
+ set_cur_cmd(mp_relax_command);
+ break;
+ }
+ q = q->link;
+ }
+}
+
+@ @<Adjust the balance; |break| if it's zero@>=
+if (cur_mod > 0) {
+ ++balance;
+} else {
+ --balance;
+ if (balance == 0)
+ break;
+}
+
+@ Four commands are intended to be used only within macro texts: |quote|,
+|\#\AT!|, |\AT!|, and |\AT!\#|. They are variants of a single command code
+called |macro_special|.
+
+@ @<Enumeration types@>=
+typedef enum mp_macro_fix_codes {
+ mp_macro_quote_code, /* |macro_special| modifier for |quote| */
+ mp_macro_prefix_code, /* |macro_special| modifier for |\#\AT!| */
+ mp_macro_at_code, /* |macro_special| modifier for |\AT!| */
+ mp_macro_suffix_code, /* |macro_special| modifier for |\AT!\#| */
+} mp_macro_fix_codes;
+
+@ @<Put each...@>=
+mp_primitive(mp, "quote", mp_macro_special_command, mp_macro_quote_code);
+@:quote_}{|quote| primitive@>
+mp_primitive(mp, "#@@", mp_macro_special_command, mp_macro_prefix_code);
+@:]]]\#\AT!_}{|\#\AT!| primitive@>
+mp_primitive(mp, "@@", mp_macro_special_command, mp_macro_at_code);
+@:]]]\AT!_}{|\AT!| primitive@>
+mp_primitive(mp, "@@#", mp_macro_special_command, mp_macro_suffix_code);
+@:]]]\AT!\#_}{|\AT!\#| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_macro_special_command:
+ switch (m) {
+ case mp_macro_prefix_code: return "#@@";
+ case mp_macro_at_code : return "@@";
+ case mp_macro_suffix_code: return "@@#";
+ case mp_macro_quote_code : return "quote";
+ }
+ break;
+
+@ Here is a routine that's used whenever a token will be redefined. If the user's
+token is unredefinable, the |mp->frozen_inaccessible| token is substituted; the
+latter is redefinable but essentially impossible to use, hence \MP's tables won't
+get fouled up.
+
+@c
+static void mp_get_symbol (MP mp)
+{
+ /* sets |cur_sym| to a safe symbol */
+ RESTART:
+ get_t_next(mp);
+ if ((cur_sym == NULL) || mp_is_frozen(mp, cur_sym)) {
+ const char *hlp = NULL;
+ if (cur_sym != NULL) {
+ hlp =
+ "Sorry: You can't redefine my error-recovery tokens. I've inserted an\n"
+ "inaccessible symbol so that your definition will be completed without\n"
+ "mixing me up too badly.";
+ } else {
+ hlp =
+ "Sorry: You can't redefine a number, string, or expr. I've inserted an\n"
+ "inaccessible symbol so that your definition will be completed without\n"
+ "mixing me up too badly.";
+ if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+ }
+ }
+ set_cur_sym(mp->frozen_inaccessible);
+ mp_ins_error(mp, "Missing symbolic token inserted", hlp);
+ @.Missing symbolic token...@>
+ goto RESTART;
+ }
+}
+
+
+@ Before we actually redefine a symbolic token, we need to clear away its former
+value, if it was a variable. The following stronger version of |get_symbol| does
+that.
+
+@c
+static void mp_get_clear_symbol (MP mp)
+{
+ mp_get_symbol(mp);
+ mp_clear_symbol(mp, cur_sym, 0);
+}
+
+@ Here's another little subroutine; it checks that an equals sign or assignment
+sign comes along at the proper place in a macro definition.
+
+@c
+static void mp_check_equals (MP mp)
+{
+ if (cur_cmd != mp_equals_command && cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing '=' has been inserted",
+ "The next thing in this 'def' should have been '=', because I've already looked at\n"
+ "the definition heading. But don't worry; I'll pretend that an equals sign was\n"
+ "present. Everything from here to 'enddef' will be the replacement text of this\n"
+ "macro."
+ );
+ @.Missing `='@>
+ }
+}
+
+@ A |primarydef|, |secondarydef|, or |tertiarydef| is rather easily handled
+now that we have |scan_toks|. In this case there are two parameters, which will
+be |EXPR0| and |EXPR1|.
+
+@c
+static void mp_make_op_def (MP mp, int code)
+{
+ mp_node q, r;
+ mp_command_code m = (code == mp_primary_def_code) ? mp_primary_def_command : (code == mp_secondary_def_code ? mp_secondary_def_command : mp_tertiary_def_command);
+ mp_subst_list_item *qm = NULL;
+ mp_subst_list_item *qn = NULL;
+ mp_get_symbol(mp);
+ qm = mp_memory_allocate(sizeof(mp_subst_list_item));
+ qm->link = NULL;
+ qm->info = cur_sym;
+ qm->info_mod = cur_sym_mod;
+ qm->value_data = 0;
+ qm->value_mod = mp_expr_operation;
+ mp_get_clear_symbol(mp);
+ mp->warning_info = cur_sym;
+ mp_get_symbol(mp);
+ qn = mp_memory_allocate(sizeof(mp_subst_list_item));
+ qn->link = qm;
+ qn->info = cur_sym;
+ qn->info_mod = cur_sym_mod;
+ qn->value_data = 1;
+ qn->value_mod = mp_expr_operation;
+ get_t_next(mp);
+ mp_check_equals(mp);
+ mp->scanner_status = mp_op_defining_state;
+ q = mp_new_symbolic_node(mp);
+ mp_set_ref_count(q, 0);
+ r = mp_new_symbolic_node(mp);
+ mp_link(q) = r;
+ mp_set_sym_info(r, mp_general_macro);
+ mp_name_type(r) = mp_macro_operation;
+ mp_link(r) = mp_scan_toks(mp, mp_macro_def_command, qn, NULL, 0);
+ mp->scanner_status = mp_normal_state;
+ set_eq_type(mp->warning_info, m);
+ set_equiv_node(mp->warning_info, q);
+ mp_get_x_next(mp);
+}
+
+@ Parameters to macros are introduced by the keywords |expr|, |suffix|,
+|text|, |primary|, |secondary|, and |tertiary|.
+
+@<Put each...@>=
+mp_primitive(mp, "expr", mp_parameter_commmand, mp_expr_parameter);
+@:expr_}{|expr| primitive@>
+mp_primitive(mp, "suffix", mp_parameter_commmand, mp_suffix_parameter);
+@:suffix_}{|suffix| primitive@>
+mp_primitive(mp, "text", mp_parameter_commmand, mp_text_parameter);
+@:text_}{|text| primitive@>
+mp_primitive(mp, "primary", mp_parameter_commmand, mp_primary_macro);
+@:primary_}{|primary| primitive@>
+mp_primitive(mp, "secondary", mp_parameter_commmand, mp_secondary_macro);
+@:secondary_}{|secondary| primitive@>
+mp_primitive(mp, "tertiary", mp_parameter_commmand, mp_tertiary_macro);
+@:tertiary_}{|tertiary| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_parameter_commmand:
+ switch (m) {
+ case mp_expr_parameter : return "expr";
+ case mp_suffix_parameter: return "suffix";
+ case mp_text_parameter : return "text";
+ case mp_primary_macro : return "primary";
+ case mp_secondary_macro : return "secondary";
+ default : return "tertiary";
+ }
+ break;
+
+@ Let's turn next to the more complex processing associated with |def| and
+|vardef|. When the following procedure is called, |cur_mod| should be either
+|start_def| or |var_def|.
+
+Note that although the macro scanner allows |def = := enddef| and |def := =
+enddef|; |def = = enddef| and |def := := enddef| will generate an error because
+by the time the second of the two identical tokens is seen, its meaning has
+already become undefined.
+
+@c
+static void mp_scan_def (MP mp, int code)
+{
+ int n; /* the number of special suffix parameters */
+ int k; /* the total number of parameters */
+ mp_subst_list_item *r = NULL; /* parameter-substitution list */
+ mp_subst_list_item *rp = NULL; /* parameter-substitution list */
+ mp_node q; /* tail of the macro token list */
+ mp_node p; /* temporary storage */
+ int sym_type; /* |expr_sym|, |suffix_sym|, or |text_sym| */
+ mp_sym l_delim, r_delim; /* matching delimiters */
+ int c = mp_general_macro; /* the kind of macro we're defining */
+ mp_link(mp->hold_head) = NULL;
+ q = mp_new_symbolic_node(mp);
+ mp_set_ref_count(q, 0);
+ r = NULL;
+ /*
+ Scan the token or variable to be defined; set |n|, |scanner_status|, and
+ |warning_info|
+ */
+ if (code == mp_def_code) {
+ mp_get_clear_symbol(mp);
+ mp->warning_info = cur_sym;
+ get_t_next(mp);
+ mp->scanner_status = mp_op_defining_state;
+ n = 0;
+ set_eq_type(mp->warning_info, mp_defined_macro_command);
+ set_equiv_node(mp->warning_info, q);
+ } else {
+ /* |var_def| */
+ p = mp_scan_declared_variable(mp);
+ mp_flush_variable(mp, equiv_node(mp_get_sym_sym(p)), mp_link(p), 1);
+ mp->warning_info_node = mp_find_variable(mp, p);
+ mp_flush_node_list(mp, p);
+ if (mp->warning_info_node == NULL) {
+ mp_error(
+ mp,
+ "This variable already starts with a macro",
+ "After 'vardef a' you can't say 'vardef a.b'. So I'll have to discard this\n"
+ "definition."
+ );
+ mp->warning_info_node = mp->bad_vardef;
+ }
+ mp->scanner_status = mp_var_defining_state;
+ n = 2;
+ if (cur_cmd == mp_macro_special_command && cur_mod == mp_macro_suffix_code) {
+ /* |\AT!\#| */
+ n = 3;
+ get_t_next(mp);
+ }
+ mp_type(mp->warning_info_node) = mp_unsuffixed_macro_type - 2 + n;
+ /* |mp_suffixed_macro=mp_unsuffixed_macro+1| */
+ mp_set_value_node(mp->warning_info_node, q);
+ }
+ k = n;
+ if (cur_cmd == mp_left_delimiter_command) {
+ /* Absorb delimited parameters, putting them into lists |q| and |r| */
+ do {
+ l_delim = cur_sym;
+ r_delim = equiv_sym(cur_sym);
+ get_t_next(mp);
+ if (cur_cmd == mp_parameter_commmand) {
+ switch (cur_mod) {
+ case mp_expr_parameter:
+ sym_type = mp_expr_operation;
+ goto OKAY;
+ break;
+ case mp_suffix_parameter:
+ sym_type = mp_suffix_operation;
+ goto OKAY;
+ break;
+ case mp_text_parameter:
+ sym_type = mp_text_operation;
+ goto OKAY;
+ break;
+ default:
+ break;
+ }
+ }
+ mp_back_error(
+ mp,
+ "Missing parameter type; 'expr' will be assumed",
+ "You should've had 'expr' or 'suffix' or 'text' here."
+ );
+ sym_type = mp_expr_operation;
+ OKAY:
+ /* Absorb parameter tokens for type |sym_type| */
+ do {
+ mp_link(q) = mp_new_symbolic_node(mp);
+ q = mp_link(q);
+ mp_name_type(q) = sym_type;
+ mp_set_sym_info(q, k);
+ mp_get_symbol(mp);
+ rp = mp_memory_allocate(sizeof(mp_subst_list_item));
+ rp->link = NULL;
+ rp->value_data = k;
+ rp->value_mod = sym_type;
+ rp->info = cur_sym;
+ rp->info_mod = cur_sym_mod;
+ mp_check_param_size(mp, k);
+ ++k;
+ rp->link = r;
+ r = rp;
+ get_t_next(mp);
+ } while (cur_cmd == mp_comma_command);
+
+ mp_check_delimiter(mp, l_delim, r_delim);
+ get_t_next(mp);
+ } while (cur_cmd == mp_left_delimiter_command);
+
+ }
+ if (cur_cmd == mp_parameter_commmand) {
+ /* Absorb undelimited parameters, putting them into list |r| */
+ rp = mp_memory_allocate(sizeof(mp_subst_list_item));
+ rp->link = NULL;
+ rp->value_data = k;
+ switch (cur_mod) {
+ case mp_expr_parameter:
+ rp->value_mod = mp_expr_operation;
+ c = mp_expr_macro;
+ break;
+ case mp_suffix_parameter:
+ rp->value_mod = mp_suffix_operation;
+ c = mp_suffix_macro;
+ break;
+ case mp_text_parameter:
+ rp->value_mod = mp_text_operation;
+ c = mp_text_macro;
+ break;
+ default:
+ c = cur_mod;
+ rp->value_mod = mp_expr_operation;
+ break;
+ }
+ mp_check_param_size(mp, k);
+ ++k;
+ mp_get_symbol(mp);
+ rp->info = cur_sym;
+ rp->info_mod = cur_sym_mod;
+ rp->link = r;
+ r = rp;
+ get_t_next(mp);
+ if (c == mp_expr_macro && cur_cmd == mp_of_command) {
+ c = mp_of_macro;
+ rp = mp_memory_allocate(sizeof(mp_subst_list_item));
+ rp->link = NULL;
+ mp_check_param_size(mp, k);
+ rp->value_data = k;
+ rp->value_mod = mp_expr_operation;
+ mp_get_symbol(mp);
+ rp->info = cur_sym;
+ rp->info_mod = cur_sym_mod;
+ rp->link = r;
+ r = rp;
+ get_t_next(mp);
+ }
+ }
+ mp_check_equals(mp);
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_info(p, c);
+ mp_name_type(p) = mp_macro_operation;
+ mp_link(q) = p;
+ /*
+ Attach the replacement text to the tail of node |p|. We don't put
+ |mp->frozen_end_group| into the replacement text of a |vardef|,
+ because the user may want to redefine |endgroup|.
+ */
+ if (code == mp_def_code) {
+ mp_link(p) = mp_scan_toks(mp, mp_macro_def_command, r, NULL, (int) n);
+ } else {
+ mp_node qq = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(qq, mp->bg_loc);
+ mp_link(p) = qq;
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, mp->eg_loc);
+ mp_link(qq) = mp_scan_toks(mp, mp_macro_def_command, r, p, (int) n);
+ }
+ if (mp->warning_info_node == mp->bad_vardef) {
+ mp_flush_token_list(mp, mp_get_value_node(mp->bad_vardef));
+ }
+ mp->scanner_status = mp_normal_state;
+ mp_get_x_next(mp);
+}
+
+@ @<Glob...@>=
+mp_sym bg_loc;
+mp_sym eg_loc; /* hash addresses of |begingroup| and |endgroup| */
+
+@ @<Initialize table entries@>=
+mp->bad_vardef = mp_new_value_node(mp);
+mp_name_type(mp->bad_vardef) = mp_root_operation;
+mp_set_value_sym(mp->bad_vardef, mp->frozen_bad_vardef);
+
+@ @<Free table entries@>=
+mp_free_value_node(mp, mp->bad_vardef);
+
+@* Expanding the next token.
+
+Only a few command codes |<min_command| can possibly be returned by |get_t_next|;
+in increasing order, they are |if_test|, |fi_or_else|, |input|, |iteration|,
+|repeat_loop|, |exit_test|, |relax|, |scan_tokens|, |run_script|, |expand_after|,
+and |defined_macro|.
+
+\MP\ usually gets the next token of input by saying |get_x_next|. This is like
+|get_t_next| except that it keeps getting more tokens until finding
+|cur_cmd>=min_command|. In other words, |get_x_next| expands macros and removes
+conditionals or iterations or input instructions that might be present.
+
+It follows that |get_x_next| might invoke itself recursively. In fact, there is
+massive recursion, since macro expansion can involve the scanning of arbitrarily
+complex expressions, which in turn involve macro expansion and conditionals, etc.
+@^recursion@>
+
+Therefore it's necessary to declare a whole bunch of |forward| procedures at this
+point, and to insert some other procedures that will be invoked by |get_x_next|.
+
+@<Declarations@>=
+static void mp_scan_primary (MP mp);
+static void mp_scan_secondary (MP mp);
+static void mp_scan_tertiary (MP mp);
+static void mp_scan_expression (MP mp);
+static void mp_scan_suffix (MP mp);
+static void mp_pass_text (MP mp);
+static void mp_conditional (MP mp);
+static void mp_start_input (MP mp);
+static void mp_begin_iteration (MP mp);
+static void mp_resume_iteration (MP mp);
+static void mp_stop_iteration (MP mp);
+
+@ A recursion depth counter is used to discover infinite recursions. (Near)
+infinite recursion is a problem because it translates into C function calls that
+eat up the available call stack. A better solution would be to depend on signal
+trapping, but that is problematic when Metapost is used as a library.
+
+@<Global...@>=
+int expand_depth_count; /* current expansion depth */
+int expand_depth; /* current expansion depth */
+
+@ The limit is set at |10000|, which should be enough to allow normal usages of
+metapost while preventing the most obvious crashes on most all operating systems,
+but the value can be raised if the runtime system allows a larger C stack.
+@^system dependencies@>
+
+@<Set initial...@>=
+mp->expand_depth = 10000;
+
+@ Even better would be if the system allows discovery of the amount of space
+available on the call stack. @^system dependencies@>
+
+In any case, when the limit is crossed, that is a fatal error.
+
+@c
+static void mp_check_expansion_depth (MP mp)
+{
+ if (++mp->expand_depth_count >= mp->expand_depth) {
+ if (mp->interaction >= mp_error_stop_mode) {
+ mp->interaction=mp_scroll_mode; /* no more interaction */
+ }
+ mp_error(
+ mp,
+ "Maximum expansion depth reached",
+ "Recursive macro expansion cannot be unlimited because of runtime stack\n"
+ "constraints. The limit is 10000 recursion levels in total."
+ );
+ mp->history=mp_fatal_error_stop;
+ mp_jump_out(mp);
+ }
+}
+
+@ An auxiliary subroutine called |expand| is used by |get_x_next|
+when it has to do exotic expansion commands.
+
+@c
+static void mp_expand (MP mp)
+{
+ mp_check_expansion_depth(mp);
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t) && cur_cmd != mp_defined_macro_command) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ switch (cur_cmd) {
+ case mp_if_test_command:
+ mp_conditional(mp); /* this procedure is discussed in Part 36 below */
+ break;
+ case mp_fi_or_else_command:
+ @<Terminate the current conditional and skip to |fi|@>
+ break;
+ case mp_input_command:
+ @<Initiate or terminate input from a file@>
+ break;
+ case mp_iteration_command:
+ if (cur_mod == mp_end_for_code) {
+ @<Scold the user for having an extra |endfor|@>
+ } else {
+ mp_begin_iteration(mp); /* this procedure is discussed in Part 37 below */
+ }
+ break;
+ case mp_repeat_loop_command:
+ @<Repeat a loop@>
+ break;
+ case mp_exit_test_command:
+ @<Exit a loop if the proper time has come@>
+ break;
+ case mp_relax_command:
+ break;
+ case mp_expand_after_command:
+ @<Expand the token after the next token@>
+ break;
+ case mp_scan_tokens_command:
+ @<Put a string into the input buffer@>
+ break;
+ case mp_runscript_command:
+ @<Put a script result string into the input buffer@>
+ break;
+ case mp_maketext_command:
+ @<Put a maketext result string into the input buffer@>
+ break;
+ case mp_defined_macro_command:
+ mp_macro_call(mp, cur_mod_node, NULL, cur_sym);
+ break;
+ default:
+ break;
+ };
+ mp->expand_depth_count--;
+}
+
+@ @<Scold the user...@>=
+{
+ mp_error(
+ mp,
+ "Extra 'endfor'",
+ "I'm not currently working on a for loop, so I had better not try to end anything."
+ );
+ @.Extra `endfor'@>
+}
+
+@ The processing of |input| involves the |start_input| subroutine, which will
+be declared later; the processing of |endinput| is trivial.
+
+@<Put each...@>=
+mp_primitive(mp, "input", mp_input_command, 0);
+@:input_}{|input| primitive@>
+mp_primitive(mp, "endinput", mp_input_command, 1);
+@:end_input_}{|endinput| primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+case mp_input_command:
+ return m == 0 ? "input" : "endinput";
+
+@ @<Initiate or terminate input...@>=
+if (cur_mod > 0) {
+ mp->force_eof = 1;
+} else {
+ mp_start_input(mp);
+}
+
+@ We'll discuss the complicated parts of loop operations later. For now it
+suffices to know that there's a global variable called |loop_ptr| that will be
+|NULL| if no loop is in progress.
+
+@<Repeat a loop@>=
+{
+ while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp); /* conserve stack space */
+ }
+ if (mp->loop_ptr == NULL) {
+ mp_error(
+ mp,
+ "Lost loop",
+ "I'm confused; after exiting from a loop, I still seem to want to repeat it. I'll\n"
+ "try to forget the problem."
+ );
+ @.Lost loop@>
+ } else {
+ mp_resume_iteration(mp); /* this procedure is in Part 37 below */
+ }
+}
+
+@ @<Exit a loop if the proper time has come@>=
+{
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_boolean_type) {
+ do_boolean_error(mp);
+ }
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ mp_show_cmd_mod(mp, mp_nullary_command, cur_exp_value_boolean);
+ }
+ if (cur_exp_value_boolean == mp_true_operation) {
+ if (mp->loop_ptr != NULL) {
+ @<Exit prematurely from an iteration@>
+ } else if (cur_cmd == mp_semicolon_command) {
+ mp_error(
+ mp,
+ "No loop is in progress",
+ "Why say 'exitif' when there's nothing to exit from?"
+ );
+ } else {
+ mp_back_error(
+ mp,
+ "No loop is in progress",
+ "Why say 'exitif' when there's nothing to exit from?"
+ );
+ @.No loop is in progress@>
+ }
+ } else if (cur_cmd != mp_semicolon_command) {
+ mp_back_error(
+ mp,
+ "Missing ';' has been inserted",
+ "After 'exitif <boolean exp>' I expect to see a semicolon. I shall pretend that\n"
+ "one was there."
+ );
+ @.Missing `;'@>
+ }
+}
+
+@ Here we use the fact that |forever_text| is the only |token_type| that is less
+than |loop_text|.
+
+@<Exit prematurely...@>=
+mp_node p = NULL;
+do {
+ if (file_state) {
+ mp_end_file_reading(mp);
+ } else {
+ if (token_type <= mp_loop_text) {
+ p = nstart;
+ }
+ mp_end_token_list(mp);
+ }
+} while (p == NULL);
+if (p != mp->loop_ptr->info) {
+ mp_fatal_error(mp, "*** (loop confusion)");
+ @.loop confusion@>
+}
+mp_stop_iteration(mp); /* this procedure is in Part 34 below */
+
+@ @<Expand the token after the next token@>=
+{
+ mp_node p;
+ get_t_next(mp);
+ p = mp_cur_tok(mp);
+ get_t_next(mp);
+ if (cur_cmd < mp_min_command) {
+ mp_expand(mp);
+ } else {
+ mp_back_input(mp);
+ }
+ mp_begin_token_list(mp, p, mp_backed_up_text);
+}
+
+@ @<Put a string into the input buffer@>=
+{
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a string",
+ "I'm going to flush this expression, since scantokens should be followed by a\n"
+ "known string."
+ );
+ @.Not a string@>
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_back_input(mp);
+ if (cur_exp_str->len > 0) {
+ @<Pretend we're reading a new one-line file@>
+ }
+ }
+}
+
+@ @<Declarations@>=
+static void check_script_result (MP mp, char *s);
+
+@c
+void check_script_result (MP mp, char *s)
+{
+ if (s) {
+ size_t size = strlen(s);
+ if (size > 0) {
+ size_t k ;
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_begin_file_reading(mp);
+ name = is_scantok;
+ mp->last = mp->first;
+ k = mp->first + size;
+ if (k >= mp->max_buf_stack) {
+ while (k >= mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size / 4)));
+ }
+ mp->max_buf_stack = k + 1;
+ }
+ limit = (int) k;
+ memcpy((mp->buffer + mp->first), s, size);
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ lmt_memory_free(s);
+ }
+}
+
+@ @<Put a script result string into the input buffer@>=
+{
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ switch (mp->cur_exp.type) {
+ case mp_string_type:
+ {
+ mp_back_input(mp);
+ if (cur_exp_str->len > 0) {
+ check_script_result(mp, mp->run_script(mp, (const char*) cur_exp_str->str, cur_exp_str->len, 0));
+ }
+ }
+ break;
+ case mp_numeric_type:
+ case mp_known_type:
+ {
+ int n = 0 ;
+ mp_back_input(mp);
+ n = (int) number_to_scaled (cur_exp_value_number) / 65536;
+ if (n > 0) {
+ check_script_result(mp, mp->run_script(mp, NULL, 0, n));
+ }
+ }
+ break;
+ default:
+ {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a string",
+ "I'm going to flush this expression, since runscript should be followed by a known\n"
+ "string or number."
+ );
+ @.Not a string@>
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ }
+ }
+}
+
+@ The |texscriptmode| parameter controls how spaces and newlines get honoured in
+|btex| or |verbatimtex| ... |etex|. The default value is~1. Possible values are:
+0: no newlines, 1: newlines in |verbatimtex|, 2: newlines in |verbatimtex| and
+|etex|, 3: no leading and trailing strip in |verbatimtex|, 4: no leading and
+trailing strip in |verbatimtex| and |btex|. That way the Lua handler can do what
+it likes. An |etex| has to be followed by a space or |;| or be at the end of a
+line and preceded by a space or at the beginning of a line.
+
+@<Pass btex ... etex to script@>=
+char *txt = NULL;
+char *ptr = NULL;
+int slin = line;
+int size = 0;
+int done = 0;
+int mode = round_unscaled(internal_value(mp_texscriptmode_internal)) ; /* default: 1 */
+int verb = cur_mod == mp_verbatim_code;
+int first;
+/* we had a (mandate) trailing space */
+if (loc <= limit && mp->char_class[mp->buffer[loc]] == mp_space_class) {
+ ++loc;
+} else {
+ /* maybe issue an error message and quit */
+}
+/* we loop over lines */
+first = loc;
+while (1) {
+ /* we don't need to check when we have less than 4 characters left */
+ if (loc < limit - 4) {
+ if (mp->buffer[loc] == 'e') {
+ ++loc;
+ if (mp->buffer[loc] == 't') {
+ ++loc;
+ if (mp->buffer[loc] == 'e') {
+ ++loc;
+ if (mp->buffer[loc] == 'x') {
+ /* let's see if we have the right boundary */
+ if (first == (loc - 3)) {
+ /* when we're at the start of a line no leading space is required */
+ done = 1;
+ } else if (mp->char_class[mp->buffer[loc - 4]] == mp_space_class) {
+ /* when we're beyond the start of a line a leading space is required */
+ done = 2;
+ }
+ if (done) {
+ if ((loc + 1) <= limit) {
+ int c = mp->char_class[mp->buffer[loc + 1]] ;
+ if (c != mp_letter_class) {
+ ++loc;
+ /* we're past the 'x' */
+ break;
+ } else {
+ /* this is no valid etex */
+ done = 0;
+ }
+ } else {
+ /* when we're at the end of a line we're ok */
+ ++loc;
+ /* we're past the 'x' */
+ break;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ /* no etex seen (yet) */
+ if (loc >= limit) {
+ if (size) {
+ txt = mp_memory_reallocate(txt, (size_t) (size + limit - first + 1));
+ } else {
+ txt = mp_memory_allocate((size_t) (limit - first + 1));
+ }
+ memcpy(txt + size, mp->buffer + first, limit - first);
+ size += limit - first + 1;
+ if (mode <= 0) {
+ txt[size - 1] = ' ';
+ } else if (verb) {
+ /* modes $\geq 1$ permit a newline in verbatimtex */
+ txt[size - 1] = '\n';
+ } else if (mode >= 2) {
+ /* modes $\geq 2$ permit a newline in btex */
+ txt[size - 1] = '\n';
+ } else {
+ txt[size - 1] = ' ';
+ }
+ if (mp_move_to_next_line(mp)) {
+ /* we abort the scanning */
+ goto FATAL_ERROR;
+ }
+ first = loc;
+ } else {
+ ++loc;
+ }
+}
+if (done) {
+ /* we're past the 'x' */
+ int l = loc - 5 ; // 4
+ int n = l - first + 1 ;
+ /* we're before the 'etex' */
+ if (done == 2) {
+ /* we had ' etex' */
+ l -= 1;
+ n -= 1;
+ /* we're before the ' etex' */
+ }
+ if (size) {
+ txt = mp_memory_reallocate(txt, (size_t) (size + n + 1));
+ } else {
+ txt = mp_memory_allocate((size_t) (n + 1));
+ }
+ memcpy(txt + size, mp->buffer + first, n); /* 0 */
+ size += n;
+ if (verb && mode >= 3) {
+ /* don't strip verbatimtex */
+ txt[size] = '\0';
+ ptr = txt;
+ } else if (mode >= 4) {
+ /* don't strip btex */
+ txt[size] = '\0';
+ ptr = txt;
+ } else {
+ /* strip trailing whitespace, we have a |'\0'| so we are off by one */
+ while ((size > 1) && (mp->char_class[(unsigned char) txt[size-1]] == mp_space_class || txt[size-1] == '\n')) {
+ --size;
+ }
+ /* prune the string */
+ txt[size] = '\0';
+ /* strip leading whitespace */
+ ptr = txt;
+ while ((size > 1) && (mp->char_class[(unsigned char) ptr[0]] == mp_space_class || ptr[0] == '\n')) {
+ ++ptr;
+ --size;
+ }
+ }
+ /* action */
+ check_script_result(mp, mp->make_text(mp, ptr, size, verb));
+ mp_memory_free(txt);
+ /* really needed */
+ mp_get_next(mp);
+ return;
+}
+/*
+ We don't recover because in practice the graphic will be broken anyway and
+ we're not really interacting in mplib .. just fix the input.
+*/
+FATAL_ERROR:
+{
+ /* line numbers are not always meaningfull so we can get a 0 reported */
+ char msg[256];
+ if (slin > 0) {
+ mp_snprintf(msg, 256, "No matching 'etex' for '%stex'.", verb ? "verbatim" : "b");
+ } else {
+ mp_snprintf(msg, 256, "No matching 'etex' for '%stex' in line %d.", verb ? "verbatim" : "b",slin);
+ }
+ mp_error(mp, msg, "An 'etex' is missing at this input level, nothing gets done.");
+ mp_memory_free(txt);
+}
+
+@ @<Put a maketext result string into the input buffer@>=
+{
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ if (mp->cur_exp.type == mp_string_type) {
+ mp_back_input(mp);
+ if (cur_exp_str->len > 0) {
+ check_script_result(mp, mp->make_text(mp, (const char*) cur_exp_str->str, cur_exp_str->len, 0));
+ }
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a string",
+ "I'm going to flush this expression, since 'maketext' should be followed by a\n"
+ "known string."
+ );
+ @.Not a string@>
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ }
+}
+
+@ @<Pretend we're reading a new one-line file@>=
+size_t k; /* something that we hope is |<=buf_size| */
+size_t j; /* index into |str_pool| */
+mp_value new_expr;
+memset(&new_expr, 0, sizeof(mp_value));
+new_number(new_expr.data.n);
+mp_begin_file_reading(mp);
+name = is_scantok;
+k = mp->first + (size_t) cur_exp_str->len;
+if (k >= mp->max_buf_stack) {
+ while (k >= mp->buf_size) {
+ mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size / 4)));
+ }
+ mp->max_buf_stack = k + 1;
+}
+j = 0;
+limit = (int) k;
+while (mp->first < (size_t) limit) {
+ mp->buffer[mp->first] = *(cur_exp_str->str + j);
+ j++;
+ ++mp->first;
+}
+mp->buffer[limit] = '%';
+mp->first = (size_t) (limit + 1);
+loc = start;
+mp_flush_cur_exp(mp, new_expr);
+
+@ Here finally is |get_x_next|.
+
+The expression scanning routines to be considered later communicate via the
+global quantities |cur_type| and |cur_exp|; we must be very careful to save and
+restore these quantities while macros are being expanded. @^inner loop@>
+
+@<Declarations@>=
+static void mp_get_x_next (MP mp);
+
+@ @c
+static void mp_get_x_next (MP mp)
+{
+ get_t_next(mp);
+ if (cur_cmd < mp_min_command) {
+ /* the capsule to save |cur_type| and |cur_exp| */
+ mp_node save_exp = mp_stash_cur_exp(mp);
+ do {
+ if (cur_cmd == mp_defined_macro_command) {
+ mp_macro_call(mp, cur_mod_node, NULL, cur_sym);
+ } else {
+ mp_expand(mp);
+ }
+ get_t_next(mp);
+ } while (cur_cmd < mp_min_command);
+ /* that restores |cur_type| and |cur_exp| */
+ mp_unstash_cur_exp(mp, save_exp);
+ }
+}
+
+@ Now let's consider the |macro_call| procedure, which is used to start up all
+user-defined macros. Since the arguments to a macro might be expressions,
+|macro_call| is recursive. @^recursion@>
+
+The first parameter to |macro_call| points to the reference count of the token
+list that defines the macro. The second parameter contains any arguments that
+have already been parsed (see below). The third parameter points to the symbolic
+token that names the macro. If the third parameter is |NULL|, the macro was
+defined by |vardef|, so its name can be reconstructed from the prefix and
+\quote {at} arguments found within the second parameter.
+
+What is this second parameter? It's simply a linked list of symbolic items, whose
+|info| fields point to the arguments. In other words, if |arg_list=NULL|, no
+arguments have been scanned yet; otherwise |mp_info(arg_list)| points to the
+first scanned argument, and |mp_link(arg_list)| points to the list of further
+arguments (if any).
+
+Arguments of type |expr| are so-called capsules, which we will discuss later
+when we concentrate on expressions; they can be recognized easily because their
+|link| field is |void|. Arguments of type |suffix| and |text| are token lists
+without reference counts.
+
+@ After argument scanning is complete, the arguments are moved to the
+|param_stack|. (They can't be put on that stack any sooner, because the stack is
+growing and shrinking in unpredictable ways as more arguments are being
+acquired.) Then the macro body is fed to the scanner; i.e., the replacement text
+of the macro is placed at the top of the \MP's input stack, so that |get_t_next|
+will proceed to read it next.
+
+@<Declarations@>=
+static void mp_macro_call (MP mp, mp_node def_ref, mp_node arg_list, mp_sym macro_name);
+
+@ This invokes a user-defined control sequence.
+
+@c
+static void mp_macro_call (MP mp, mp_node def_ref, mp_node arg_list, mp_sym macro_name)
+{
+ int n; /* the number of arguments */
+ mp_node tail = 0; /* tail of the argument list */
+ mp_sym l_delim = NULL; /* a delimiter pair */
+ mp_sym r_delim = NULL; /* a delimiter pair */
+ mp_node r = mp_link(def_ref); /* current node in the macro's token list */
+ mp_add_mac_ref(def_ref);
+ if (arg_list == NULL) {
+ n = 0;
+ } else {
+ @<Determine the number |n| of arguments already supplied, and set |tail| to the tail of |arg_list|@>
+ }
+ if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ @<Show the text of the macro being expanded, and the existing arguments@>
+ }
+ @<Scan the remaining arguments, if any; set |r| to the first token of the replacement text@>
+ @<Feed the arguments and replacement text to the scanner@>
+}
+
+@ @<Show the text of the macro...@>=
+mp_begin_diagnostic(mp);
+mp_print_ln(mp);
+mp_print_macro_name(mp, arg_list, macro_name);
+if (n == 3) {
+ mp_print_str(mp, "@@#"); /* indicate a suffixed macro */
+}
+mp_show_macro (mp, def_ref, NULL);
+if (arg_list != NULL) {
+ mp_node p = arg_list;
+ n = 0;
+ do {
+ mp_node q = (mp_node) mp_get_sym_sym(p);
+ mp_print_arg(mp, q, n, 0, 0);
+ ++n;
+ p = mp_link(p);
+ } while (p != NULL);
+}
+mp_end_diagnostic(mp, 0);
+
+@ @<Declarations@>=
+static void mp_print_macro_name (MP mp, mp_node a, mp_sym n);
+
+@ @c
+static void mp_print_macro_name (MP mp, mp_node a, mp_sym n)
+{
+ if (n) {
+ mp_print_mp_str(mp,text(n));
+ } else {
+ mp_node p = (mp_node) mp_get_sym_sym(a);
+ if (p) {
+ mp_node q = p; /* they traverse the first part of |a| */
+ while (mp_link(q) != NULL) {
+ q = mp_link(q);
+ }
+ mp_link(q) = (mp_node) mp_get_sym_sym(mp_link(a));
+ mp_show_token_list(mp, p, NULL);
+ mp_link(q) = NULL;
+ } else {
+ mp_print_mp_str(mp,text(mp_get_sym_sym((mp_node) mp_get_sym_sym(mp_link(a)))));
+ }
+ }
+}
+
+@ @<Declarations@>=
+static void mp_print_arg (MP mp, mp_node q, int n, int b, int bb);
+
+@ @c
+static void mp_print_arg (MP mp, mp_node q, int n, int b, int bb)
+{
+ if (q && mp_link(q) == MP_VOID) {
+ mp_print_nl(mp, "(EXPR");
+ } else if ((bb < mp_text_operation) && (b != mp_text_macro)) {
+ mp_print_nl(mp, "(SUFFIX");
+ } else {
+ mp_print_nl(mp, "(TEXT");
+ }
+ mp_print_int(mp, n);
+ mp_print_str(mp, ")<-");
+ if (q && mp_link(q) == MP_VOID) {
+ mp_print_exp(mp, q, 1);
+ } else {
+ mp_show_token_list(mp, q, NULL);
+ }
+}
+
+@ @<Determine the number |n| of arguments already supplied...@>=
+n = 1;
+tail = arg_list;
+while (mp_link(tail) != NULL) {
+ ++n;
+ tail = mp_link(tail);
+}
+
+@ @<Scan the remaining arguments, if any; set |r|...@>=
+set_cur_cmd(mp_comma_command + 1); /* anything |<>comma| will do */
+while (mp_name_type(r) == mp_expr_operation || mp_name_type(r) == mp_suffix_operation || mp_name_type(r) == mp_text_operation) {
+ @<Scan the delimited argument represented by |mp_get_sym_info(r)|@>
+ r = mp_link(r);
+}
+if (cur_cmd == mp_comma_command) {
+ char msg[256];
+ mp_string rname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_macro_name(mp, arg_list, macro_name);
+ rname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Too many arguments to %s; Missing '%s' has been inserted",
+ mp_str(mp, rname), mp_str(mp, text(r_delim)));
+ delete_str_ref(rname);
+ @.Too many arguments...@>
+ @.Missing `)'...@>
+ mp_error(
+ mp,
+ msg,
+ "I'm going to assume that the comma I just read was a right delimiter, and then:\n"
+ "I'll begin expanding the macro."
+ );
+}
+if (mp_get_sym_info(r) != mp_general_macro) {
+ @<Scan undelimited argument(s)@>
+}
+r = mp_link(r);
+
+@ At this point, the reader will find it advisable to review the explanation of
+token list format that was presented earlier, paying special attention to the
+conventions that apply only at the beginning of a macro's token list.
+
+On the other hand, the reader will have to take the expression-parsing aspects of
+the following program on faith; we will explain |cur_type| and |cur_exp| later.
+(Several things in this program depend on each other, and it's necessary to jump
+into the circle somewhere.)
+
+@<Scan the delimited argument represented by |mp_get_sym_info(r)|@>=
+if (cur_cmd != mp_comma_command) {
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_left_delimiter_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_macro_name(mp, arg_list, macro_name);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Missing argument to %s", mp_str(mp, sname));
+ @.Missing argument...@>
+ delete_str_ref(sname);
+ if (mp_name_type(r) == mp_suffix_operation || mp_name_type(r) == mp_text_operation) {
+ mp_set_cur_exp_value_number(mp, &zero_t); /* todo: this was |null| */
+ mp->cur_exp.type = mp_token_list_type;
+ } else {
+ mp_set_cur_exp_value_number(mp, &zero_t);
+ mp->cur_exp.type = mp_known_type;
+ }
+ mp_back_error(
+ mp,
+ msg,
+ "That macro has more parameters than you thought. I'll continue by pretending that\n"
+ "each missing argument is either zero or null."
+ );
+ set_cur_cmd(mp_right_delimiter_command);
+ goto FOUND;
+ }
+ l_delim = cur_sym;
+ r_delim = equiv_sym(cur_sym);
+}
+@<Scan the argument represented by |mp_get_sym_info(r)|@>
+if ((cur_cmd != mp_comma_command) && ((cur_cmd != mp_right_delimiter_command) || (equiv_sym(cur_sym) != l_delim))) {
+ switch (mp_name_type(mp_link(r))) {
+ case mp_expr_operation:
+ case mp_suffix_operation:
+ case mp_text_operation:
+ {
+ mp_back_error(
+ mp,
+ "Missing ',' has been inserted",
+ "I've finished reading a macro argument and am about to read another; the\n"
+ "arguments weren't delimited correctly."
+ );
+ @.Missing `,'@>
+ set_cur_cmd(mp_comma_command);
+ }
+ break;
+ default:
+ {
+ char msg[256];
+ mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim)));
+ @.Missing `)'@>
+ mp_back_error(mp, msg, "I've gotten to the end of the macro parameter list.");
+ }
+ break;
+ }
+}
+FOUND:
+@<Append the current expression to |arg_list|@>
+
+@ A |suffix| or |text| parameter will have been scanned as a token list
+pointed to by |cur_exp|, in which case we will have |cur_type=token_list|.
+
+@<Append the current expression to |arg_list|@>=
+{
+ mp_node p = mp_new_symbolic_node(mp);
+ if (mp->cur_exp.type == mp_token_list_type) {
+ mp_set_sym_sym(p, mp->cur_exp.data.node);
+ } else {
+ mp_set_sym_sym(p, mp_stash_cur_exp(mp));
+ }
+ if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, mp_get_sym_info(r), mp_name_type(r));
+ mp_end_diagnostic(mp, 0);
+ }
+ if (arg_list == NULL) {
+ arg_list = p;
+ } else {
+ mp_link(tail) = p;
+ }
+ tail = p;
+ ++n;
+}
+
+@ @<Scan the argument represented by |mp_get_sym_info(r)|@>=
+if (mp_name_type(r) == mp_text_operation) {
+ mp_scan_text_arg(mp, l_delim, r_delim);
+} else {
+ mp_get_x_next(mp);
+ if (mp_name_type(r) == mp_suffix_operation) {
+ mp_scan_suffix(mp);
+ } else {
+ mp_scan_expression(mp);
+ }
+}
+
+@ The parameters to |scan_text_arg| are either a pair of delimiters or zero; the
+latter case is for undelimited text arguments, which end with the first semicolon
+or |endgroup| or |end| that is not contained in a group.
+
+@<Declarations@>=
+static void mp_scan_text_arg (MP mp, mp_sym l_delim, mp_sym r_delim);
+
+@ @c
+void mp_scan_text_arg (MP mp, mp_sym l_delim, mp_sym r_delim)
+{
+ int balance = 1; /* excess of |l_delim| over |r_delim| */
+ mp->warning_info = l_delim;
+ mp->scanner_status = mp_absorbing_state;
+ mp_node p = mp->hold_head; /* list tail */
+ mp_link(mp->hold_head) = NULL;
+ while (1) {
+ get_t_next(mp);
+ if (l_delim == NULL) {
+ @<Adjust the balance for an undelimited argument; |break| if done@>
+ } else {
+ @<Adjust the balance for a delimited argument; |break| if done@>
+ }
+ mp_link(p) = mp_cur_tok(mp);
+ p = mp_link(p);
+ }
+ mp_set_cur_exp_node(mp, mp_link(mp->hold_head));
+ mp->cur_exp.type = mp_token_list_type;
+ mp->scanner_status = mp_normal_state;
+}
+
+@ @<Adjust the balance for a delimited argument...@>=
+if (cur_cmd == mp_right_delimiter_command) {
+ if (equiv_sym(cur_sym) == l_delim) {
+ --balance;
+ if (balance == 0) {
+ break;
+ }
+ }
+} else if (cur_cmd == mp_left_delimiter_command) {
+ if (equiv_sym(cur_sym) == r_delim) {
+ ++balance;
+ }
+}
+
+@ @<Adjust the balance for an undelimited...@>=
+if (mp_end_of_statement) {
+ /* |cur_cmd=semicolon|, |end_group|, or |stop| */
+ if (balance == 1) {
+ break;
+ } else if (cur_cmd == mp_end_group_command) {
+ --balance;
+ }
+} else if (cur_cmd == mp_begin_group_command) {
+ ++balance;
+}
+
+@ @<Scan undelimited argument(s)@>=
+if (mp_get_sym_info(r) < mp_text_macro) {
+ mp_get_x_next(mp);
+ if (mp_get_sym_info(r) != mp_suffix_macro) {
+ if ((cur_cmd == mp_equals_command) || (cur_cmd == mp_assignment_command)) {
+ mp_get_x_next(mp);
+ }
+ }
+}
+switch (mp_get_sym_info(r)) {
+ case mp_primary_macro:
+ mp_scan_primary(mp);
+ break;
+ case mp_secondary_macro:
+ mp_scan_secondary(mp);
+ break;
+ case mp_tertiary_macro:
+ mp_scan_tertiary(mp);
+ break;
+ case mp_expr_macro:
+ mp_scan_expression(mp);
+ break;
+ case mp_of_macro:
+ {
+ @<Scan an expression followed by |of| $\langle$primary$\rangle$@>
+ }
+ break;
+ case mp_suffix_macro:
+ {
+ @<Scan a suffix with optional delimiters@>
+ }
+ break;
+ case mp_text_macro:
+ mp_scan_text_arg(mp, NULL, NULL);
+ break;
+}
+mp_back_input(mp);
+@<Append the current expression to |arg_list|@>
+
+@ @<Scan an expression followed by |of| $\langle$primary$\rangle$@>=
+mp_node p;
+mp_scan_expression(mp);
+p = mp_new_symbolic_node(mp);
+mp_set_sym_sym(p, mp_stash_cur_exp(mp));
+if (number_positive(internal_value(mp_tracing_macros_internal))) {
+ mp_begin_diagnostic(mp);
+ mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, 0, 0);
+ mp_end_diagnostic(mp, 0);
+}
+if (arg_list == NULL) {
+ arg_list = p;
+} else {
+ mp_link(tail) = p;
+}
+tail = p;
+++n;
+if (cur_cmd != mp_of_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_macro_name(mp, arg_list, macro_name);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Missing 'of' has been inserted for %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ @.Missing `of'@>
+ mp_back_error(mp, msg, "I've got the first argument; will look now for the other.");
+}
+mp_get_x_next(mp);
+mp_scan_primary(mp);
+
+@ @<Scan a suffix with optional delimiters@>=
+if (cur_cmd != mp_left_delimiter_command) {
+ l_delim = NULL;
+} else {
+ l_delim = cur_sym;
+ r_delim = equiv_sym(cur_sym);
+ mp_get_x_next(mp);
+}
+mp_scan_suffix(mp);
+if (l_delim != NULL) {
+ if ((cur_cmd != mp_right_delimiter_command) || (equiv_sym(cur_sym) != l_delim)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim)));
+ @.Missing `)'@>
+ mp_back_error(mp, msg, "I've gotten to the end of the macro parameter list.");
+ }
+ mp_get_x_next(mp);
+}
+
+@ Before we put a new token list on the input stack, it is wise to clean off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+@<Feed the arguments and replacement text to the scanner@>=
+while (token_state && (nloc == NULL)) {
+ /* conserve stack space */
+ mp_end_token_list(mp);
+}
+if (mp->param_ptr + n > mp->max_param_stack) {
+ mp->max_param_stack = mp->param_ptr + n;
+ mp_check_param_size(mp, mp->max_param_stack);
+ @:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+}
+mp_begin_token_list(mp, def_ref, mp_macro_text);
+name = macro_name ? text(macro_name) : NULL;
+nloc = r;
+if (n > 0) {
+ mp_node p = arg_list;
+ do {
+ mp->param_stack[mp->param_ptr] = (mp_node) mp_get_sym_sym(p);
+ ++mp->param_ptr;
+ p = mp_link(p);
+ } while (p != NULL);
+ mp_flush_node_list(mp, arg_list);
+}
+
+@ It's sometimes necessary to put a single argument onto |param_stack|. The
+|stack_argument| subroutine does this.
+
+@c
+static void mp_stack_argument (MP mp, mp_node p)
+{
+ if (mp->param_ptr == mp->max_param_stack) {
+ ++mp->max_param_stack;
+ mp_check_param_size(mp, mp->max_param_stack);
+ }
+ mp->param_stack[mp->param_ptr] = p;
+ ++mp->param_ptr;
+}
+
+@* Conditional processing.
+
+Let's consider now the way |if| commands are handled.
+
+Conditions can be inside conditions, and this nesting has a stack that is
+independent of other stacks. Four global variables represent the top of the
+condition stack: |cond_ptr| points to pushed-down entries, if~any; |cur_if| tells
+whether we are processing |if| or |elseif|; |if_limit| specifies the largest
+code of a |fi_or_else| command that is syntactically legal; and |if_line| is the
+line number at which the current conditional began.
+
+If no conditions are currently in progress, the condition stack has the special
+state |cond_ptr=NULL|, |if_limit=normal|, |cur_if=0|, |if_line=0|. Otherwise
+|cond_ptr| points to a non-symbolic node; the |type|, |name_type|, and |link|
+fields of the first word contain |if_limit|, |cur_if|, and |cond_ptr| at the next
+level, and the second word contains the corresponding |if_line|.
+
+@ @d mp_if_line_field(A) ((mp_if_node) (A))->if_line_field
+
+@ @<Enumeration types@>=
+typedef enum mp_if_codes {
+ mp_no_if_code,
+ mp_if_code, /* code for |if| being evaluated */
+ mp_fi_code, /* code for |fi| */
+ mp_else_code, /* code for |else| */
+ mp_else_if_code, /* code for |elseif| */
+} mp_if_codes;
+
+@ @<MPlib internal header stuff@>=
+typedef struct mp_if_node_data {
+ mp_variable_type type;
+ mp_name_type_type name_type;
+ int hasnumber;
+ int if_line_field;
+ struct mp_node_data *link;
+} mp_if_node_data;
+
+typedef struct mp_if_node_data *mp_if_node;
+
+@c
+static mp_node mp_get_if_node (MP mp) {
+ mp_if_node p = (mp_if_node) mp_allocate_node(mp, sizeof(mp_if_node_data));
+ mp_type(p) = mp_if_node_type;
+ return (mp_node) p;
+}
+
+@ @<Glob...@>=
+mp_node cond_ptr; /* top of the condition stack */
+int if_limit; /* upper bound on |fi_or_else| codes */
+int cur_if; /* type of conditional being worked on */
+int if_line; /* line where that conditional began */
+
+@ @<Set init...@>=
+mp->cond_ptr = NULL;
+mp->if_limit = mp_no_if_code;
+mp->cur_if = 0;
+mp->if_line = 0;
+
+@ @<Put each...@>=
+mp_primitive(mp, "if", mp_if_test_command, mp_if_code);
+@:if_}{|if| primitive@>
+mp_primitive(mp, "fi", mp_fi_or_else_command, mp_fi_code);
+mp->frozen_fi = mp_frozen_primitive (mp, "fi", mp_fi_or_else_command, mp_fi_code);
+@:fi_}{|fi| primitive@>
+mp_primitive(mp, "else", mp_fi_or_else_command, mp_else_code);
+@:else_}{|else| primitive@>
+mp_primitive(mp, "elseif", mp_fi_or_else_command, mp_else_if_code);
+@:else_if_}{|elseif| primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+case mp_if_test_command:
+case mp_fi_or_else_command:
+ switch (m) {
+ case mp_if_code : return "if";
+ case mp_fi_code : return "fi";
+ case mp_else_code : return "else";
+ case mp_else_if_code: return "elseif";
+ }
+ break;
+
+@ Here is a procedure that ignores text until coming to an |elseif|, |else|,
+or |fi| at level zero of $|if|\ldots|fi|$ nesting. After it has acted,
+|cur_mod| will indicate the token that was found.
+
+\MP's smallest two command codes are |if_test| and |fi_or_else|; this makes the
+skipping process a bit simpler.
+
+@c
+void mp_pass_text (MP mp)
+{
+ int level = 0;
+ mp->scanner_status = mp_skipping_state;
+ mp->warning_line = mp_true_line(mp);
+ while (1) {
+ get_t_next(mp);
+ if (cur_cmd <= mp_fi_or_else_command) {
+ if (cur_cmd < mp_fi_or_else_command) {
+ ++level;
+ } else if (level == 0) {
+ break;
+ } else if (cur_mod == mp_fi_code) {
+ --level;
+ }
+ } else {
+ @<Decrease the string reference count, if the current token is a string@>
+ }
+ }
+ mp->scanner_status = mp_normal_state;
+}
+
+@ @<Decrease the string reference count...@>=
+if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+}
+
+@ When we begin to process a new |if|, we set |if_limit:=mp_if_code|; then if
+|elseif| or |else| or |fi| occurs before the current |if| condition has
+been evaluated, a colon will be inserted. A construction like |if fi| would
+otherwise get \MP\ confused.
+
+@<Declarations@>=
+static void mp_push_condition_stack (MP mp);
+static void mp_pop_condition_stack (MP mp);
+
+@ Push and pop the condition stack:
+
+@c
+static void mp_push_condition_stack (MP mp)
+{
+ mp_node p = mp_get_if_node(mp);
+ mp_link(p) = mp->cond_ptr;
+ mp_type(p) = (int) mp->if_limit;
+ mp_name_type(p) = mp->cur_if;
+ mp_if_line_field(p) = mp->if_line;
+ mp->cond_ptr = p;
+ mp->if_limit = mp_if_code;
+ mp->if_line = mp_true_line(mp);
+ mp->cur_if = mp_if_code;
+}
+
+static void mp_pop_condition_stack (MP mp)
+{
+ mp_node p = mp->cond_ptr;
+ mp->if_line = mp_if_line_field(p);
+ mp->cur_if = mp_name_type(p);
+ mp->if_limit = mp_type(p);
+ mp->cond_ptr = mp_link(p);
+ mp_free_node(mp, p, sizeof(mp_if_node_data));
+}
+@ Here's a procedure that changes the |if_limit| code corresponding to
+a given value of |cond_ptr|.
+
+@c
+static void mp_change_if_limit (MP mp, int l, mp_node p)
+{
+ if (p == mp->cond_ptr) {
+ /* that's the easy case */
+ mp->if_limit = l;
+ } else {
+ mp_node q = mp->cond_ptr;
+ while (1) {
+ if (q == NULL) {
+ mp_confusion(mp, "if");
+ @:this can't happen if}{\quad if@>
+ return;
+ } else if (mp_link(q) == p) {
+ mp_type(q) = l;
+ return;
+ } else {
+ q = mp_link(q);
+ }
+ }
+ }
+}
+
+@ The user is supposed to put colons into the proper parts of conditional
+statements. Therefore, \MP\ has to check for their presence.
+
+@c
+static void mp_check_colon (MP mp)
+{
+ if (cur_cmd != mp_colon_command) {
+ mp_back_error(
+ mp,
+ "Missing ':' has been inserted",
+ "There should've been a colon after the condition. I shall pretend that one was\n"
+ "there."
+ );
+ @.Missing `:'@>
+ }
+}
+
+@ A condition is started when the |get_x_next| procedure encounters an |if_test|
+command; in that case |get_x_next| calls |conditional|, which is a recursive
+procedure. @^recursion@>
+
+@c
+void mp_conditional (MP mp)
+{
+ mp_node save_cond_ptr; /* |cond_ptr| corresponding to this conditional */
+ int new_if_limit; /* future value of |if_limit| */
+ mp_push_condition_stack(mp);
+ save_cond_ptr = mp->cond_ptr;
+ RESWITCH:
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_boolean_type) {
+ do_boolean_error(mp);
+ }
+ new_if_limit = mp_else_if_code;
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ @<Display the boolean value of |cur_exp|@>
+ }
+ FOUND:
+ mp_check_colon(mp);
+ if (cur_exp_value_boolean == mp_true_operation) {
+ mp_change_if_limit (mp, (int) new_if_limit, save_cond_ptr);
+ /* wait for |elseif|, |else|, or |fi| */
+ return;
+ }
+ @<Skip to |elseif| or |else| or |fi|, then |goto done|@>
+ DONE:
+ mp->cur_if = (int) cur_mod;
+ mp->if_line = mp_true_line(mp);
+ if (cur_mod == mp_fi_code) {
+ mp_pop_condition_stack(mp);
+ } else if (cur_mod == mp_else_if_code) {
+ goto RESWITCH;
+ } else {
+ mp_set_cur_exp_value_boolean(mp, mp_true_operation);
+ new_if_limit = mp_fi_code;
+ mp_get_x_next(mp);
+ goto FOUND;
+ }
+}
+
+@ In a construction like `|if| |if| |true|: $0=1$: |foo| |else|:
+|bar| |fi|', the first |else| that we come to after learning that the
+|if| is false is not the |else| we're looking for. Hence the following
+curious logic is needed.
+
+@<Skip to |elseif|...@>=
+while (1) {
+ mp_pass_text(mp);
+ if (mp->cond_ptr == save_cond_ptr) {
+ goto DONE;
+ } else if (cur_mod == mp_fi_code) {
+ mp_pop_condition_stack(mp);
+ }
+}
+
+@ @<Display the boolean value...@>=
+mp_begin_diagnostic(mp);
+mp_print_str(mp, cur_exp_value_boolean == mp_true_operation ? "{true}" : "{false}");
+mp_end_diagnostic(mp, 0);
+
+@ The processing of conditionals is complete except for the following code, which
+is actually part of |get_x_next|. It comes into play when |elseif|, |else|,
+or |fi| is scanned.
+
+@<Terminate the current conditional and skip to |fi|@>=
+if (cur_mod > mp->if_limit) {
+ if (mp->if_limit == mp_if_code) {
+ /* condition not yet evaluated */
+ mp_back_input(mp);
+ set_cur_sym(mp->frozen_colon);
+ mp_ins_error(mp, "Missing ':' has been inserted", "Something was missing here");
+ @.Missing `:'@>
+ } else {
+ const char *hlp = "I'm ignoring this; it doesn't match any if.";
+ switch (cur_mod) {
+ case mp_fi_code:
+ mp_error(mp, "Extra 'fi'", hlp);
+ @.Extra fi@>
+ break;
+ case mp_else_code:
+ mp_error(mp, "Extra 'else'", hlp);
+ @.Extra else@>
+ break;
+ default:
+ mp_error(mp, "Extra 'elseif'", hlp);
+ @.Extra elseif@>
+ break;
+ }
+ }
+} else {
+ while (cur_mod != mp_fi_code) {
+ /* skip to |fi| */
+ mp_pass_text(mp);
+ }
+ mp_pop_condition_stack(mp);
+}
+
+@* Iterations.
+
+To bring our treatment of |get_x_next| to a close, we need to consider what \MP\
+does when it sees |for|, |forsuffixes|, and |forever|.
+
+There's a global variable |loop_ptr| that keeps track of the |for| loops that
+are currently active. If |loop_ptr=NULL|, no loops are in progress; otherwise
+|loop_ptr.info| points to the iterative text of the current (innermost) loop, and
+|loop_ptr.link| points to the data for any other loops that enclose the current
+one.
+
+A loop-control node also has two other fields, called |type| and |list|, whose
+contents depend on the type of loop:
+
+\yskip\indent|loop_ptr.type=NULL| means that the link of |loop_ptr.list| points
+to a list of symbolic nodes whose |info| fields point to the remaining argument
+values of a suffix list and expression list. In this case, an extra field
+|loop_ptr.start_list| is needed to make sure that |resume_operation| skips ahead.
+
+\yskip\indent|loop_ptr.type=MP_VOID| means that the current loop is
+|forever|.
+
+\yskip\indent|loop_ptr.type=MP_PROGRESSION_FLAG| means that |loop_ptr.value|,
+|loop_ptr.step_size|, and |loop_ptr.final_value| contain the data for an
+arithmetic progression.
+
+\yskip\indent|loop_ptr.type=p>MP_PROGRESSION_FLAG| means that |p| points to an edge
+header and |loop_ptr.list| points into the graphical object list for that edge
+header.
+
+@d MP_VOID (mp_node) (1) /* |NULL+1|, a |NULL| pointer different from |NULL| */
+@d MP_PROGRESSION_FLAG (mp_node) (2) /* |NULL+2| */
+
+/* |loop_type| value when |loop_list| points to a progression node */
+
+@<Types...@>=
+typedef struct mp_loop_data {
+ mp_sym var ; /* the var of the loop */
+ mp_node info; /* iterative text of this loop */
+ mp_node type; /* the special type of this loop, or a pointer into mem */
+ mp_node list; /* the remaining list elements */
+ mp_node list_start; /* head fo the list of elements */
+ mp_number old_value; /* previous value of current arithmetic value */
+ mp_number value; /* current arithmetic value */
+ mp_number step_size; /* arithmetic step size */
+ mp_number final_value; /* end arithmetic value */
+ struct mp_loop_data *link; /* the enclosing loop, if any */
+ mp_knot point;
+} mp_loop_data;
+
+@ @<Glob...@>=
+mp_loop_data *loop_ptr; /* top of the loop-control-node stack */
+
+@ @<Set init...@>=
+mp->loop_ptr = NULL;
+
+@ If the expressions that define an arithmetic progression in a |for| loop
+don't have known numeric values, the |bad_for| subroutine screams at the user.
+
+@c
+static void mp_bad_for (MP mp, const char *s)
+{
+ char msg[256];
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ /* show the bad expression above the message */
+ mp_snprintf(msg, 256, "Improper %s has been replaced by 0", s);
+ @.Improper...replaced by 0@>
+ mp_back_error(
+ mp,
+ msg,
+ "When you say 'for x=a step b until c', the initial value 'a' and the step size\n"
+ "'b' and the final value 'c' must have known numeric values. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+@ Here's what \MP\ does when |for|, |forsuffixes|, or |forever| has just
+been scanned. (This code requires slight familiarity with expression-parsing
+routines that we have not yet discussed; but it seems to belong in the present
+part of the program, even though the original author didn't write it until later.
+The reader may wish to come back to it.)
+
+@c
+void mp_begin_iteration (MP mp)
+{
+ mp_node q; /* link manipulation register */
+ mp_sym n = cur_sym; /* hash address of the current symbol */
+ mp_subst_list_item *p = NULL; /* substitution list for |scan_toks| */
+ int m = cur_mod; /* |start_for| (|for|) or |start_forsuffixes| (|forsuffixes|) */
+ mp_loop_data *s = mp_memory_allocate(sizeof(mp_loop_data)); /* the new loop-control node */
+ s->type = NULL;
+ s->list = NULL;
+ s->info = NULL;
+ s->list_start = NULL;
+ s->link = NULL;
+ s->var = NULL;
+ s->point = NULL;
+ new_number(s->value);
+ new_number(s->old_value);
+ new_number(s->step_size);
+ new_number(s->final_value);
+ if (m == mp_start_forever_code) {
+ s->type = MP_VOID;
+ mp_get_x_next(mp);
+ } else {
+ mp_get_symbol(mp);
+ p = mp_memory_allocate(sizeof(mp_subst_list_item));
+ p->link = NULL;
+ p->info = cur_sym;
+ s->var = cur_sym;
+ p->info_mod = cur_sym_mod;
+ p->value_data = 0;
+ if (m == mp_start_for_code) {
+ p->value_mod = mp_expr_operation;
+ } else {
+ /* |start_forsuffixes| */
+ p->value_mod = mp_suffix_operation;
+ }
+ mp_get_x_next(mp);
+ if (p->value_mod == mp_expr_operation && cur_cmd == mp_within_command) {
+ @<Set up a picture iteration@>
+ } else {
+ @<Check for the assignment in a loop header@>
+ @<Scan the values to be used in the loop@>
+ }
+ }
+ @<Check for the presence of a colon@>
+ @<Scan the loop text and put it on the loop control stack@>
+ mp_resume_iteration(mp);
+}
+
+
+@ @<Check for the assignment in a loop header@>=
+if ((cur_cmd != mp_equals_command) && (cur_cmd != mp_assignment_command)) {
+ mp_back_error(
+ mp,
+ "Missing '=' has been inserted",
+ "The next thing in this loop should have been '=' or ':='. But don't worry; I'll\n"
+ "pretend that an equals sign was present, and I'll look for the values next."
+ );
+ @.Missing `='@>
+}
+
+@ @<Check for the presence of a colon@>=
+if (cur_cmd != mp_colon_command) {
+ mp_back_error(
+ mp,
+ "Missing ':' has been inserted",
+ "The next thing in this loop should have been a ':'. So I'll pretend that a colon\n"
+ "was present; everything from here to 'endfor' will be iterated."
+ );
+ @.Missing `:'@>
+}
+
+@ We append a special |mp->frozen_repeat_loop| token in place of the |endfor|
+at the end of the loop. This will come through \MP's scanner at the proper time
+to cause the loop to be repeated.
+
+(If the user tries some shenanigan like `|for| $\ldots$ |let| |endfor|', he
+will be foiled by the |get_symbol| routine, which keeps frozen tokens unchanged.
+Furthermore the |mp->frozen_repeat_loop| is an |outer| token, so it won't be
+lost accidentally.)
+
+@ @<Scan the loop text...@>=
+q = mp_new_symbolic_node(mp);
+mp_set_sym_sym(q, mp->frozen_repeat_loop);
+mp->scanner_status = mp_loop_defining_state;
+mp->warning_info = n;
+s->info = mp_scan_toks(mp, mp_iteration_command, p, q, 0);
+mp->scanner_status = mp_normal_state;
+s->link = mp->loop_ptr;
+mp->loop_ptr = s;
+
+@ @<Initialize table...@>=
+mp->frozen_repeat_loop =
+//mp_frozen_primitive (mp, " ENDFOR", mp_repeat_loop_command + mp_outer_tag_command, 0);
+mp_frozen_primitive (mp, " ENDFOR", mp_repeat_loop_command, 0);
+
+@ The loop text is inserted into \MP's scanning apparatus by the
+|resume_iteration| routine.
+
+@c
+void mp_resume_iteration (MP mp)
+{
+ mp_node p, q; /* link registers */
+ p = mp->loop_ptr->type;
+ if (p == MP_PROGRESSION_FLAG) {
+ mp_set_cur_exp_value_number(mp, &(mp->loop_ptr->value));
+ if ((number_positive(mp->loop_ptr->step_size) && number_greater(cur_exp_value_number, mp->loop_ptr->final_value))
+ || (number_negative(mp->loop_ptr->step_size) && number_less (cur_exp_value_number, mp->loop_ptr->final_value))) {
+ mp_stop_iteration(mp);
+ return;
+ }
+ mp->cur_exp.type = mp_known_type;
+ /* make |q| an |expr| argument */
+ q = mp_stash_cur_exp(mp);
+ number_clone(mp->loop_ptr->old_value, cur_exp_value_number);
+ set_number_from_addition(mp->loop_ptr->value, cur_exp_value_number, mp->loop_ptr->step_size);
+ /* Set |value(p)| for the next iteration and detect numeric overflow */
+ if (number_positive(mp->loop_ptr->step_size) && number_less(mp->loop_ptr->value, cur_exp_value_number)) {
+ if (number_positive(mp->loop_ptr->final_value)) {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->final_value, -1);
+ } else {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->value, 1);
+ }
+ } else if (number_negative(mp->loop_ptr->step_size) && number_greater(mp->loop_ptr->value, cur_exp_value_number)) {
+ if (number_negative(mp->loop_ptr->final_value)) {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->final_value, 1);
+ } else {
+ number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value);
+ number_add_scaled(mp->loop_ptr->value, -1);
+ }
+ }
+ if (mp->loop_ptr->point != NULL) {
+ mp->loop_ptr->point = mp_next_knot(mp->loop_ptr->point);
+ }
+ } else if (p == NULL) {
+ p = mp->loop_ptr->list;
+ if (p != NULL && p == mp->loop_ptr->list_start) {
+ q = p;
+ p = mp_link(p);
+ mp_free_symbolic_node(mp, q);
+ mp->loop_ptr->list = p;
+ }
+ if (p == NULL) {
+ mp_stop_iteration(mp);
+ return;
+ }
+ mp->loop_ptr->list = mp_link(p);
+ q = (mp_node) mp_get_sym_sym(p);
+ if (q) {
+ number_clone(mp->loop_ptr->old_value, q->data.n);
+ }
+ mp_free_symbolic_node(mp, p);
+ } else if (p == MP_VOID) {
+ mp_begin_token_list(mp, mp->loop_ptr->info, mp_forever_text);
+ return;
+ } else {
+ @<Make |q| a capsule containing the next picture component from |loop_list(loop_ptr)| or |goto not_found|@>
+ }
+ mp_begin_token_list(mp, mp->loop_ptr->info, mp_loop_text);
+ mp_stack_argument(mp, q);
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ @<Trace the start of a loop@>
+ }
+ return;
+ NOT_FOUND:
+ mp_stop_iteration(mp);
+}
+
+@ @<Trace the start of a loop@>=
+mp_begin_diagnostic(mp);
+mp_print_nl(mp, "{loop value=");
+@.loop value=n@>
+if ((q != NULL) && (mp_link(q) == MP_VOID)) {
+ mp_print_exp(mp, q, 1);
+} else {
+ mp_show_token_list(mp, q, NULL);
+}
+mp_print_chr(mp, '}');
+mp_end_diagnostic(mp, 0);
+
+@ @<Make |q| a capsule containing the next picture component from...@>=
+q = mp->loop_ptr->list;
+if (q == NULL) {
+ goto NOT_FOUND;
+} else if (! mp_is_start_or_stop(q)) {
+ q = mp_link(q);
+} else if (! mp_is_stop(q)) {
+ q = mp_skip_1component(mp, q);
+} else {
+ goto NOT_FOUND;
+}
+mp_set_cur_exp_node(mp, (mp_node) mp_copy_objects (mp, mp->loop_ptr->list, q));
+mp_init_bbox(mp, (mp_edge_header_node) cur_exp_node);
+mp->cur_exp.type = mp_picture_type;
+mp->loop_ptr->list = q;
+q = mp_stash_cur_exp(mp);
+
+@ A level of loop control disappears when |resume_iteration| has decided not to
+resume, or when an |exitif| construction has removed the loop text from the
+input stack.
+
+@c
+void mp_stop_iteration (MP mp)
+{
+ mp_node p = mp->loop_ptr->type;
+ if (p == MP_PROGRESSION_FLAG) {
+ mp_free_symbolic_node(mp, mp->loop_ptr->list);
+ if (mp->loop_ptr->point) {
+ mp_toss_knot_list(mp, mp->loop_ptr->point);
+ }
+ } else if (p == NULL) {
+ mp_node q = mp->loop_ptr->list;
+ while (q != NULL) {
+ p = (mp_node) mp_get_sym_sym(q);
+ if (p != NULL) {
+ if (mp_link(p) == MP_VOID) {
+ /* it's an |expr| parameter */
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ } else {
+ /* it's a |suffix| or |text| parameter */
+ mp_flush_token_list(mp, p);
+ }
+ }
+ p = q;
+ q = mp_link(q);
+ mp_free_symbolic_node(mp, p);
+ }
+ } else if (p > MP_PROGRESSION_FLAG) {
+ mp_delete_edge_ref(mp, p);
+ }
+ {
+ mp_loop_data *tmp = mp->loop_ptr;
+ mp->loop_ptr = tmp->link;
+ mp_flush_token_list(mp, tmp->info);
+ free_number(tmp->value);
+ free_number(tmp->step_size);
+ free_number(tmp->final_value);
+ mp_memory_free(tmp);
+ }
+}
+
+@ Now that we know all about loop control, we can finish up the missing portion
+of |begin_iteration| and we'll be done.
+
+The following code is performed after the |=| has been scanned in a |for|
+construction (if |m=start_for|) or a |forsuffixes| construction (if
+|m=start_forsuffixes|).
+
+@<Scan the values to be used in the loop@>=
+s->type = NULL;
+s->list = mp_new_symbolic_node(mp);
+s->list_start = s->list;
+q = s->list;
+do {
+ mp_get_x_next(mp);
+ if (m != mp_start_for_code) {
+ mp_scan_suffix(mp);
+ } else {
+ if (cur_cmd >= mp_colon_command && cur_cmd <= mp_comma_command) {
+ goto CONTINUE;
+ }
+ mp_scan_expression(mp);
+ if (cur_cmd == mp_step_command && q == s->list) {
+ @<Prepare for step-until construction and |break|@>
+ }
+ mp_set_cur_exp_node(mp, mp_stash_cur_exp(mp));
+ }
+ mp_link(q) = mp_new_symbolic_node(mp);
+ q = mp_link(q);
+ mp_set_sym_sym(q, mp->cur_exp.data.node);
+ if (m == mp_start_for_code) {
+ mp_name_type(q) = mp_expr_operation;
+ } else if (m == mp_start_forsuffixes_code) {
+ mp_name_type(q) = mp_suffix_operation;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ CONTINUE:
+ ; /* needed */
+} while (cur_cmd == mp_comma_command);
+
+@ @<Prepare for step-until construction and |break|@>=
+{
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_for (mp, "initial value");
+ }
+ number_clone(s->value, cur_exp_value_number);
+ number_clone(s->old_value, cur_exp_value_number);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_for (mp, "step size");
+ }
+ number_clone(s->step_size, cur_exp_value_number);
+ if (cur_cmd != mp_until_command) {
+ mp_back_error(
+ mp,
+ "Missing 'until' has been inserted",
+ "I assume you meant to say 'until' after 'step'. So I'll look for the final value\n"
+ "and colon next."
+ );
+ @.Missing `until'@>
+ }
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_for (mp, "final value");
+ }
+ number_clone(s->final_value, cur_exp_value_number);
+ s->type = MP_PROGRESSION_FLAG;
+ break;
+}
+
+@ The last case is when we have just seen |within|, and we need to parse a
+picture expression and prepare to iterate over it.
+
+@<Set up a picture iteration@>=
+mp_get_x_next(mp);
+mp_scan_expression(mp);
+if (mp->cur_exp.type == mp_path_type) {
+ number_clone(s->value, zero_t);
+ number_clone(s->old_value, zero_t);
+ number_clone(s->step_size, unity_t);
+ /* */
+ {
+ mp_knot p = cur_exp_knot;
+ // int l = mp_left_type(p) == mp_endpoint_knot ? -1 : 0;
+ int l = 0;
+ while (1) {
+ mp_knot n = mp_next_knot(p);
+ if (n == cur_exp_knot) {
+ /* So we actually start at the end because we next first. */
+ s->point = p;
+ set_number_from_int(s->final_value, l);
+ break;
+ } else {
+ p = n;
+ ++l;
+ }
+ }
+ }
+ /* */
+ s->type = MP_PROGRESSION_FLAG;
+ s->list = mp_new_symbolic_node(mp);
+ s->list_start = s->list;
+ q = s->list;
+} else {
+ @<Make sure the current expression is a known picture@>
+ s->type = mp->cur_exp.data.node;
+ mp->cur_exp.type = mp_vacuous_type;
+ q = mp_link(mp_edge_list(mp->cur_exp.data.node));
+ if (q != NULL && mp_is_start_or_stop (q) && mp_skip_1component(mp, q) == NULL) {
+ q = mp_link(q);
+ }
+ s->list = q;
+}
+
+@ @<Make sure the current expression is a known picture@>=
+if (mp->cur_exp.type != mp_picture_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ new_expr.data.node = (mp_node) mp_get_edge_header_node(mp);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper iteration spec has been replaced by nullpicture",
+ "When you say 'for x in p', p must be a known picture."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp_init_edges(mp, (mp_edge_header_node) mp->cur_exp.data.node);
+ mp->cur_exp.type = mp_picture_type;
+}
+
+@* File names.
+
+It's time now to fret about file names. Besides the fact that different operating
+systems treat files in different ways, we must cope with the fact that completely
+different naming conventions are used by different groups of people. The
+following programs show what is required for one particular operating system;
+similar routines for other systems are not difficult to devise. @^system
+dependencies@>
+
+\MP\ assumes that a file name has three parts: the name proper; its
+\quote {extension}; and a \quote {file area} where it is found in an external file system.
+The extension of an input file is assumed to be |.mp| unless otherwise
+specified; it is |.log| on the transcript file that records each run of \MP;
+it is |.tfm| on the font metric files that describe characters in any fonts
+created by \MP; it is |.ps| or `.{\it nnn}' for some number {\it nnn} on the
+\ps\ output files. The file area can be arbitrary on input files, but files are
+usually output to the user's current area. If an input file cannot be found on
+the specified area, \MP\ will look for it on a special system area; this special
+area is intended for commonly used input files.
+
+Simple uses of \MP\ refer only to file names that have no explicit extension or
+area. For example, a person usually says `|input| |cmr10|' instead of
+`|input| |cmr10.new|'. Simple file names are best, because they make the \MP\
+source files portable; whenever a file name consists entirely of letters and
+digits, it should be treated in the same way by all implementations of \MP.
+However, users need the ability to refer to other files in their environment,
+especially when responding to error messages concerning unopenable files;
+therefore we want to let them use the syntax that appears in their favorite
+operating system.
+
+@ \MP\ uses the same conventions that have proved to be satisfactory for \TeX\
+and \MF. In order to isolate the system-dependent aspects of file names, @^system
+dependencies@> the system-independent parts of \MP\ are expressed in terms of
+three system-dependent procedures called |begin_name|, |more_name|, and
+|end_name|. In essence, if the user-specified characters of the file name are
+$c_1\ldots c_n$, the system-independent driver program does the operations
+$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;\,|more_name|(c_n); \,|end_name|.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as |cur_name|.
+
+Actually the situation is slightly more complicated, because \MP\ needs to know
+when the file name ends. The |more_name| routine is a function (with side
+effects) that returns |true| on the calls |more_name|$(c_1)$, \dots,
+|more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$ returns |false|; or, it
+returns |true| and $c_n$ is the last character on the current input line. In
+other words, |more_name| is supposed to return |true| unless it is sure that the
+file name has been completely scanned; and |end_name| is supposed to be able to
+finish the assembly of |cur_name| regardless of whether $|more_name|(c_n)$ returned
+|true| or |false|.
+
+@<Glob...@>=
+char *cur_name; /* name of file just scanned */
+
+@ It is easier to maintain reference counts if we assign initial values.
+
+@<Set init...@>=
+mp->cur_name = mp_strdup("");
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->cur_name);
+
+@ The file names we shall deal with for illustrative purposes have the following
+structure: If the name contains |>| or |:|, the file area consists of all
+characters up to and including the final such character; otherwise the file area
+is null. If the remaining file name contains |.|, the file extension consists
+of all such characters from the first remaining |.| to the end, otherwise the
+file extension is null. @^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters.
+
+@<Glob...@>=
+int quoted_filename; /* whether the filename is wrapped in " markers */
+
+@ Here are the routines for file name scanning.
+
+@<Declarations@>=
+static void mp_begin_name (MP mp);
+static int mp_more_name (MP mp, unsigned char c);
+static void mp_end_name (MP mp);
+
+@ @c
+void mp_begin_name (MP mp)
+{
+ mp_memory_free(mp->cur_name);
+ mp->cur_name = NULL;
+ mp->quoted_filename = 0;
+}
+
+int mp_more_name (MP mp, unsigned char c)
+{
+ if (c == '"') {
+ mp->quoted_filename = ! mp->quoted_filename;
+ } else if ((c == ' ' || c == '\t') && (mp->quoted_filename == 0)) {
+ return 0;
+ } else {
+ mp_str_room(mp, 1);
+ mp_append_char(mp, c);
+ }
+ return 1;
+}
+
+void mp_end_name (MP mp)
+{
+ mp->cur_name = mp_memory_allocate((size_t) (mp->cur_length + 1) * sizeof(char));
+ (void) memcpy(mp->cur_name, (char *) (mp->cur_string), mp->cur_length);
+ mp->cur_name[mp->cur_length] = 0;
+ mp_reset_cur_string(mp);
+}
+
+void mp_pack_file_name (MP mp, const char *n)
+{
+ mp_memory_free(mp->name_of_file);
+ mp->name_of_file = mp_strdup(n);
+}
+
+@ @<Internal library declarations@>=
+void mp_pack_file_name (MP mp, const char *n);
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \MP\ string from the value of |name_of_file|, should ideally
+be changed to deduce the full name of file~|f|, which is the file most recently
+opened, if it is possible to do this. @^system dependencies@>
+
+@ @c
+static mp_string mp_make_name_string (MP mp)
+{
+ int name_length = (int) strlen(mp->name_of_file);
+ mp_str_room(mp, name_length);
+ for (int k = 0; k < name_length; k++) {
+ mp_append_char(mp, (unsigned char) mp->name_of_file[k]);
+ }
+ return mp_make_string(mp);
+}
+
+@ Now let's consider the \quote {driver} routines by which \MP\ deals with file names
+in a system-independent manner. First comes a procedure that looks for a file
+name in the input by taking the information from the input buffer. (We can't use
+|get_next|, because the conversion to tokens would destroy necessary
+information.)
+
+This procedure doesn't allow semicolons or percent signs to be part of file
+names, because of other conventions of \MP. {\sl The {\logos METAFONT}book}
+doesn't use semicolons or percents immediately after file names, but some users
+no doubt will find it natural to do so; therefore system-dependent changes to
+allow such characters in file names should probably be made with reluctance, and
+only when an entire file name that includes special characters is \quote {quoted}
+somehow. @^system dependencies@>
+
+@c
+static void mp_scan_file_name (MP mp)
+{
+ mp_begin_name(mp);
+ while (mp->buffer[loc] == ' ') {
+ ++loc;
+ }
+ while (1) {
+ if ((mp->buffer[loc] == ';') || (mp->buffer[loc] == '%')) {
+ break;
+ } else if (! mp_more_name(mp, mp->buffer[loc])) {
+ break;
+ } else {
+ ++loc;
+ }
+ }
+ mp_end_name(mp);
+}
+
+static void mp_ptr_scan_file (MP mp, char *s)
+{
+ char *p = s;
+ char *q = p + strlen(s);
+ mp_begin_name(mp);
+ while (p < q) {
+ if (! mp_more_name(mp, (unsigned char) (*p))) {
+ break;
+ } else {
+ p++;
+ }
+ }
+ mp_end_name(mp);
+}
+
+@ The option variable |job_name| has no real meaning and is dealt with by the caller, but
+it is available in a variable in \MP.
+
+@ @<Option variables@>=
+char *job_name;
+
+@ Initially |job_name = NULL| and when it is not set the initializer will quit. Setting
+it happens elsewhere.
+
+@ @<Dealloc variables@>=
+mp_memory_free(mp->job_name);
+
+@ Cannot do this earlier because at the |<Allocate or ...>|, the string pool is
+not yet initialized.
+
+@<Fix up |job_name|@>=
+if (mp->job_name != NULL) {
+ if (internal_string(mp_job_name_internal) != 0) {
+ delete_str_ref(internal_string(mp_job_name_internal));
+ }
+ set_internal_string(mp_job_name_internal, mp_rts(mp, mp->job_name));
+}
+
+@ Let's turn now to the procedure that is used to initiate file reading when an
+|input| command is being processed.
+
+@c
+void mp_start_input (MP mp)
+{
+ @<Put the desired file name in |cur_name|@>
+ mp_begin_file_reading(mp); /* set up |cur_file| and new level of input */
+ mp_pack_file_name(mp, mp->cur_name);
+ if (mp_open_in(mp, &cur_file, mp_filetype_program)) {
+ char *fname = NULL;
+ name = mp_make_name_string(mp);
+ fname = mp_strdup(mp->name_of_file);
+ if (mp->interaction < mp_silent_mode) {
+ /* This needs a cleanup! */
+ if ((mp->term_offset > 0) || (mp->file_offset > 0)) {
+ mp_print_chr(mp, ' ');
+ }
+ mp_print_chr(mp, '(');
+ ++mp->open_parens;
+ mp_print_str(mp, fname);
+ }
+ mp_memory_free(fname);
+ update_terminal();
+ @<Flush |name| and replace it with |cur_name| if it won't be needed@>
+ @<Read the first line of the new file@>
+ } else {
+ mp_fatal_error(mp, "invalid input file");
+ mp_end_file_reading(mp);
+ }
+}
+
+@<Flush |name| and replace it with |cur_name| if it won't be needed@>=
+mp_flush_string(mp, name);
+name = mp_rts(mp, mp->cur_name);
+mp_memory_free(mp->cur_name);
+mp->cur_name = NULL;
+
+@ If the file is empty, it is considered to contain a single blank line, so there
+is no need to test the return value.
+
+@<Read the first line...@>=
+line = 1;
+mp_input_ln(mp, cur_file);
+mp_firm_up_the_line(mp);
+mp->buffer[limit] = '%';
+mp->first = (size_t) (limit + 1);
+loc = start;
+
+@ @<Put the desired file name in |cur_name|@>=
+while (token_state && (nloc == NULL)) {
+ mp_end_token_list(mp);
+}
+if (token_state) {
+ mp_error(
+ mp,
+ "File names can't appear within macros",
+ "Sorry ... I've converted what follows to tokens, possibly garbaging the name you\n"
+ "gave. Please delete the tokens and insert the name again."
+ );
+ @.File names can't...@>
+}
+if (file_state) {
+ mp_scan_file_name(mp);
+} else {
+ mp_memory_free(mp->cur_name);
+ mp->cur_name = mp_strdup("");
+}
+
+@ The last file-opening commands are for files accessed via the |readfrom|
+@:read_from_}{|readfrom| primitive@> operator and the |write| command. Such
+files are stored in separate arrays. @:write_}{|write| primitive@>
+
+
+@ @<Glob...@>=
+int max_read_files; /* maximum number of simultaneously open |readfrom| files */
+void **rd_file; /* |readfrom| files */
+char **rd_fname; /* corresponding file name or 0 if file not open */
+int read_files; /* number of valid entries in the above arrays */
+int max_write_files; /* maximum number of simultaneously open |write| */
+void **wr_file; /* |write| files */
+char **wr_fname; /* corresponding file name or 0 if file not open */
+int write_files; /* number of valid entries in the above arrays */
+
+@ @<Allocate or initialize ...@>=
+mp->max_read_files = 8;
+mp->rd_file = mp_memory_allocate((size_t) (mp->max_read_files + 1) * sizeof(void *));
+mp->rd_fname = mp_memory_allocate((size_t) (mp->max_read_files + 1) * sizeof(char *));
+mp->max_write_files = 8;
+mp->wr_file = mp_memory_allocate((size_t) (mp->max_write_files + 1) * sizeof(void *));
+mp->wr_fname = mp_memory_allocate((size_t) (mp->max_write_files + 1) * sizeof(char *));
+
+memset(mp->rd_fname, 0, sizeof(char *) * (mp->max_read_files + 1));
+memset(mp->wr_fname, 0, sizeof(char *) * (mp->max_write_files + 1));
+
+@ This routine starts reading the file named by string~|s| without setting
+|loc|, |limit|, or |name|. It returns |false| if the file is empty or cannot
+be opened. Otherwise it updates |rd_file[n]| and |rd_fname[n]|.
+
+@c
+static int mp_start_read_input (MP mp, char *s, int n)
+{
+ mp_ptr_scan_file(mp, s);
+ mp_pack_file_name(mp, mp->cur_name);
+ mp_begin_file_reading(mp);
+ if (! mp_open_in(mp, &mp->rd_file[n], mp_filetype_text + n)) {
+ mp_end_file_reading(mp);
+ return 0;
+ } else if (! mp_input_ln(mp, mp->rd_file[n])) {
+ (mp->close_file)(mp, mp->rd_file[n]);
+ mp_end_file_reading(mp);
+ return 0;
+ } else {
+ mp->rd_fname[n] = mp_strdup(s);
+ return 1;
+ }
+}
+
+@ Open |wr_file[n]| using file name~|s| and update |wr_fname[n]|.
+
+@<Declarations@>=
+static void mp_open_write_file (MP mp, char *s, int n);
+
+@ @c
+void mp_open_write_file (MP mp, char *s, int n)
+{
+ mp_ptr_scan_file(mp, s);
+ mp_pack_file_name(mp, mp->cur_name);
+ if (mp_open_out(mp, &mp->wr_file[n], mp_filetype_text + n)) {
+ mp->wr_fname[n] = mp_strdup(s);
+ } else {
+ mp_fatal_error(mp, "invalid write file");
+ }
+}
+
+@* Introduction to the parsing routines.
+
+We come now to the central nervous system that sparks many of \MP's activities.
+By evaluating expressions, from their primary constituents to ever larger
+subexpressions, \MP\ builds the structures that ultimately define complete
+pictures or fonts of type.
+
+Four mutually recursive subroutines are involved in this process: We call them
+
+$$\hbox{|scan_primary|, |scan_secondary|, |scan_tertiary|, and
+|scan_expression|.}$$
+
+@^recursion@> Each of them is parameterless and begins with the first token to be
+scanned already represented in |cur_cmd|, |cur_mod|, and |cur_sym|. After
+execution, the value of the primary or secondary or tertiary or expression that
+was found will appear in the global variables |cur_type| and |cur_exp|. The token
+following the expression will be represented in |cur_cmd|, |cur_mod|, and
+|cur_sym|.
+
+Technically speaking, the parsing algorithms are \quote {LL(1),} more or less; backup
+mechanisms have been added in order to provide reasonable error recovery.
+
+@d cur_exp_value_boolean number_to_int(mp->cur_exp.data.n)
+@d cur_exp_value_number mp->cur_exp.data.n
+@d cur_exp_node mp->cur_exp.data.node
+@d cur_exp_str mp->cur_exp.data.str
+@d cur_exp_knot mp->cur_exp.data.p
+
+@<Declarations@>=
+static void mp_set_cur_exp_knot (MP mp, mp_knot n);
+static void mp_set_cur_exp_node (MP mp, mp_node n);
+static void mp_set_cur_exp_value_boolean (MP mp, int b);
+static void mp_set_cur_exp_value_scaled (MP mp, int s);
+static void mp_set_cur_exp_value_number (MP mp, mp_number *n);
+static void mp_set_cur_exp_str (MP mp, mp_string s);
+
+@ @c
+void mp_set_cur_exp_node (MP mp, mp_node n)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ cur_exp_node = n;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+ set_number_to_zero(mp->cur_exp.data.n);
+}
+
+void mp_set_cur_exp_knot (MP mp, mp_knot n)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ cur_exp_knot = n;
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ set_number_to_zero(mp->cur_exp.data.n);
+}
+
+void mp_set_cur_exp_value_boolean (MP mp, int b)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ set_number_from_boolean(mp->cur_exp.data.n, b);
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+}
+
+void mp_set_cur_exp_value_scaled (MP mp, int s)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ set_number_from_scaled(mp->cur_exp.data.n, s);
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+}
+
+void mp_set_cur_exp_value_number (MP mp, mp_number *n)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ number_clone(mp->cur_exp.data.n, *n);
+ cur_exp_node = NULL;
+ cur_exp_str = NULL;
+ cur_exp_knot = NULL;
+}
+
+void mp_set_cur_exp_str (MP mp, mp_string s)
+{
+ if (cur_exp_str) {
+ delete_str_ref(cur_exp_str);
+ }
+ cur_exp_str = s;
+ add_str_ref(cur_exp_str);
+ cur_exp_node = NULL;
+ cur_exp_knot = NULL;
+ set_number_to_zero(mp->cur_exp.data.n);
+}
+
+@ @<Glob...@>=
+mp_value cur_exp; /* the value of the expression just found */
+
+@ @<Set init...@>=
+memset(&mp->cur_exp.data, 0, sizeof(mp_value));
+new_number(mp->cur_exp.data.n);
+
+@ @<Free table ...@>=
+free_number(mp->cur_exp.data.n);
+
+@ Many different kinds of expressions are possible, so it is wise to have precise
+descriptions of what |cur_type| and |cur_exp| mean in all cases:
+
+\smallskip\hang |cur_type=mp_vacuous| means that this expression didn't turn out
+to have a value at all, because it arose from a
+|begingroup|$\,\ldots\,$|endgroup| construction in which there was no
+expression before the |endgroup|. In this case |cur_exp| has some irrelevant
+value.
+
+\smallskip\hang |cur_type = mp_boolean_type| means that |cur_exp| is either
+|true_code| or |false_code|.
+
+\smallskip\hang |cur_type = mp_unknown_boolean| means that |cur_exp| points to a
+capsule node that is in a ring of equivalent booleans whose value has not yet
+been defined.
+
+\smallskip\hang |cur_type = mp_string_type| means that |cur_exp| is a string number
+(i.e., an integer in the range |0<=cur_exp<str_ptr|). That string's reference
+count includes this particular reference.
+
+\smallskip\hang |cur_type = mp_unknown_string| means that |cur_exp| points to a
+capsule node that is in a ring of equivalent strings whose value has not yet been
+defined.
+
+\smallskip\hang |cur_type = mp_pen_type| means that |cur_exp| points to a node in a
+pen. Nobody else points to any of the nodes in this pen. The pen may be polygonal
+or elliptical.
+
+\smallskip\hang |cur_type=mp_unknown_pen| means that |cur_exp| points to a
+capsule node that is in a ring of equivalent pens whose value has not yet been
+defined.
+
+\smallskip\hang |cur_type = mp_path_type| means that |cur_exp| points to a the
+first node of a path; nobody else points to this particular path. The control
+points of the path will have been chosen.
+
+\smallskip\hang
+|cur_type = mp_unknown_path| means that |cur_exp| points to a capsule
+node that is in
+a ring of equivalent paths whose value has not yet been defined.
+
+\smallskip\hang
+|cur_type = mp_picture_type| means that |cur_exp| points to an edge header node.
+There may be other pointers to this particular set of edges. The header node
+contains a reference count that includes this particular reference.
+
+\smallskip\hang |cur_type = mp_unknown_picture| means that |cur_exp| points to a
+capsule node that is in a ring of equivalent pictures whose value has not yet
+been defined.
+
+\smallskip\hang |cur_type = mp_transform_type| means that |cur_exp| points to a
+|mp_transform_type| capsule node. The |value| part of this capsule points to a
+transform node that contains six numeric values, each of which is |independent|,
+|dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang |cur_type = mp_color_type| means that |cur_exp| points to a
+|color_type| capsule node. The |value| part of this capsule points to a color
+node that contains three numeric values, each of which is |independent|,
+|dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang |cur_type = mp_cmykcolor_type| means that |cur_exp| points to a
+|mp_cmykcolor_type| capsule node. The |value| part of this capsule points to a
+color node that contains four numeric values, each of which is |independent|,
+|dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang |cur_type = mp_pair_type| means that |cur_exp| points to a capsule
+node whose type is |mp_pair_type|. The |value| part of this capsule points to a
+pair node that contains two numeric values, each of which is |independent|,
+|dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang |cur_type = mp_known| means that |cur_exp| is a |scaled| value.
+
+\smallskip\hang |cur_type = mp_dependent| means that |cur_exp| points to a capsule
+node whose type is |dependent|. The |dep_list| field in this capsule points to
+the associated dependency list.
+
+\smallskip\hang |cur_type = mp_proto_dependent| means that |cur_exp| points to a
+|mp_proto_dependent| capsule node. The |dep_list| field in this capsule points to
+the associated dependency list.
+
+\smallskip\hang |cur_type = independent| means that |cur_exp| points to a capsule
+node whose type is |independent|. This somewhat unusual case can arise, for
+example, in the expression `$x+|begingroup|\penalty0\,|string|\,x;
+0\,|endgroup|$'.
+
+\smallskip\hang |cur_type = mp_token_list| means that |cur_exp| points to a linked
+list of tokens.
+
+\smallskip\noindent The possible settings of |cur_type| have been listed here in
+increasing numerical order. Notice that |cur_type| will never be
+|mp_numeric_type| or |suffixed_macro| or |mp_unsuffixed_macro|, although
+variables of those types are allowed. Conversely, \MP\ has no variables of type
+|mp_vacuous| or |token_list|.
+
+@ Capsules are non-symbolic nodes that have a similar meaning to |cur_type| and
+|cur_exp|. Such nodes have |name_type=capsule|, and their |type| field is one of
+the possibilities for |cur_type| listed above. Also |link<=void| in capsules that
+aren't part of a token list.
+
+The |value| field of a capsule is, in most cases, the value that corresponds to
+its |type|, as |cur_exp| corresponds to |cur_type|. However, when |cur_exp| would
+point to a capsule, no extra layer of indirection is present; the |value| field
+is what would have been called |value(cur_exp)| if it had not been encapsulated.
+Furthermore, if the type is |dependent| or |mp_proto_dependent|, the |value|
+field of a capsule is replaced by |dep_list| and |prev_dep| fields, since
+dependency lists in capsules are always part of the general |dep_list| structure.
+
+The |get_x_next| routine is careful not to change the values of |cur_type| and
+|cur_exp| when it gets an expanded token. However, |get_x_next| might call a
+macro, which might parse an expression, which might execute lots of commands in a
+group; hence it's possible that |cur_type| might change from, say,
+|mp_unknown_boolean| to |mp_boolean_type|, or from |dependent| to |known| or
+|independent|, during the time |get_x_next| is called. The programs below are
+careful to stash sensitive intermediate results in capsules, so that \MP's
+generality doesn't cause trouble.
+
+Here's a procedure that illustrates these conventions. It takes the contents of
+$(|cur_type|\kern-.3pt,|cur_exp|\kern-.3pt)$ and stashes them away in a capsule.
+It is not used when |cur_type=mp_token_list|. After the operation,
+|cur_type=mp_vacuous|; hence there is no need to copy path lists or to update
+reference counts, etc.
+
+The special link |MP_VOID| is put on the capsule returned by |stash_cur_exp|,
+because this procedure is used to store macro parameters that must be easily
+distinguishable from token lists.
+
+@<Declarations@>=
+static mp_node mp_stash_cur_exp (MP mp);
+
+@ @c
+static mp_node mp_stash_cur_exp (MP mp)
+{
+ mp_node p; /* the capsule that will be returned */
+ mp_variable_type exp_type = mp->cur_exp.type;
+ switch (exp_type) {
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_pair_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ case mp_cmykcolor_type:
+ p = cur_exp_node;
+ break;
+ default: /* |case mp_path_type: case mp_pen_type: case mp_string_type:| */
+ p = mp_new_value_node(mp);
+ mp_name_type(p) = mp_capsule_operation;
+ mp_type(p) = mp->cur_exp.type;
+ mp_set_value_number(p, cur_exp_value_number); /* this also resets the rest to 0/NULL */
+ if (cur_exp_str) {
+ mp_set_value_str(p, cur_exp_str);
+ } else if (cur_exp_knot) {
+ mp_set_value_knot(p, cur_exp_knot);
+ } else if (cur_exp_node) {
+ mp_set_value_node(p, cur_exp_node);
+ }
+ break;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_link(p) = MP_VOID;
+ return p;
+}
+
+@ The inverse of |stash_cur_exp| is the following procedure, which deletes an
+unnecessary capsule and puts its contents into |cur_type| and |cur_exp|.
+
+The program steps of \MP\ can be divided into two categories: those in which
+|cur_type| and |cur_exp| are \quote {alive} and those in which they are \quote {dead,} in
+the sense that |cur_type| and |cur_exp| contain relevant information or not. It's
+important not to ignore them when they're alive, and it's important not to pay
+attention to them when they're dead.
+
+There's also an intermediate category: If |cur_type=mp_vacuous|, then |cur_exp|
+is irrelevant, hence we can proceed without caring if |cur_type| and |cur_exp|
+are alive or dead. In such cases we say that |cur_type| and |cur_exp| are {\sl
+dormant}. It is permissible to call |get_x_next| only when they are alive or
+dormant.
+
+The |stash| procedure above assumes that |cur_type| and |cur_exp| are alive or
+dormant. The |unstash| procedure assumes that they are dead or dormant; it
+resuscitates them.
+
+@ @c
+void mp_unstash_cur_exp (MP mp, mp_node p)
+{
+ mp->cur_exp.type = mp_type(p);
+ switch (mp->cur_exp.type) {
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_pair_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ case mp_cmykcolor_type:
+ mp_set_cur_exp_node(mp, p);
+ break;
+ case mp_token_list_type: /* this is how symbols are stashed */
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_path_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_set_cur_exp_knot(mp, mp_get_value_knot(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_string_type:
+ mp_set_cur_exp_str(mp, mp_get_value_str(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_picture_type:
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ mp_free_value_node(mp, p);
+ break;
+ case mp_boolean_type:
+ case mp_known_type:
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ mp_free_value_node(mp, p);
+ break;
+ default:
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ if (mp_get_value_knot(p)) {
+ mp_set_cur_exp_knot(mp, mp_get_value_knot(p));
+ } else if (mp_get_value_node(p)) {
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ } else if (mp_get_value_str(p)) {
+ mp_set_cur_exp_str(mp, mp_get_value_str(p));
+ }
+ mp_free_value_node(mp, p);
+ break;
+ }
+}
+
+@ The following procedure prints the values of expressions in an abbreviated
+format. If its first parameter |p| is NULL, the value of |(cur_type,cur_exp)| is
+displayed; otherwise |p| should be a capsule containing the desired value. The
+second parameter controls the amount of output. If it is~0, dependency lists will
+be abbreviated to |linearform| unless they consist of a single term. If it is
+greater than~1, complicated structures (pens, pictures, and paths) will be
+displayed in full. @.linearform@>
+
+@<Declarations@>=
+static void mp_print_dp (MP mp, int t, mp_value_node p, int verbosity);
+static void mp_unstash_cur_exp (MP mp, mp_node p);
+static void mp_print_exp (MP mp, mp_node p, int verbosity);
+static void mp_print_big_node (MP mp, mp_node p, int verbosity);
+
+@ @c
+void mp_print_exp (MP mp, mp_node p, int verbosity)
+{
+ int restore_cur_exp; /* should |cur_exp| be restored? */
+ mp_variable_type t; /* the type of the expression */
+ mp_number vv; /* the value of the expression */
+ mp_node v = NULL;
+ new_number(vv);
+ if (p != NULL) {
+ restore_cur_exp = 0;
+ } else {
+ p = mp_stash_cur_exp(mp);
+ restore_cur_exp = 1;
+ }
+ t = mp_type(p);
+ if (t < mp_dependent_type) {
+ /* no dep list, could be a capsule */
+ if (t != mp_vacuous_type && t != mp_known_type && mp_get_value_node(p) != NULL) {
+ v = mp_get_value_node(p);
+ } else {
+ number_clone(vv, mp_get_value_number(p));
+ }
+ } else if (t < mp_independent_type) {
+ v = (mp_node) mp_get_dep_list((mp_value_node) p);
+ }
+ @<Print an abbreviated value of |v| or |vv| with format depending on |t|@>
+ if (restore_cur_exp) {
+ mp_unstash_cur_exp(mp, p);
+ }
+ free_number(vv);
+}
+
+void mp_print_big_node (MP mp, mp_node v, int verbosity)
+{
+ switch (mp_type(v)) {
+ case mp_known_type:
+ print_number(mp_get_value_number(v));
+ break;
+ case mp_independent_type:
+ mp_print_variable_name(mp, v);
+ break;
+ default:
+ mp_print_dp(mp, mp_type(v), (mp_value_node) mp_get_dep_list((mp_value_node) v), verbosity);
+ break;
+ }
+}
+
+@ @<Print an abbreviated value of |v| or |vv| with format depending on |t|@>=
+switch (t) {
+ case mp_vacuous_type:
+ mp_print_str(mp, "vacuous");
+ break;
+ case mp_boolean_type:
+ mp_print_str(mp, number_to_boolean(vv) == mp_true_operation ? "true": "false");
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_numeric_type:
+ {
+ @<Display a variable that's been declared but not defined@>
+ }
+ break;
+ case mp_string_type:
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, mp_get_value_str(p));
+ mp_print_chr(mp, '"');
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ {
+ @<Display a complex type@>
+ }
+ break;
+ case mp_transform_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ @<Display a transform node@>
+ }
+ break;
+ case mp_color_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ @<Display a color node@>
+ }
+ break;
+ case mp_pair_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ @<Display a pair node@>
+ }
+ break;
+ case mp_cmykcolor_type:
+ if (number_zero(vv) && v == NULL) {
+ mp_print_type(mp, t);
+ } else {
+ @<Display a cmykcolor node@>
+ }
+ break;
+ case mp_known_type:
+ print_number(vv);
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ mp_print_dp(mp, t, (mp_value_node) v, verbosity);
+ break;
+ case mp_independent_type:
+ mp_print_variable_name(mp, p);
+ break;
+ default:
+ mp_confusion(mp, "expression");
+ break;
+ @:this can't happen exp}{\quad exp@>
+}
+
+@ In these cases, |v| starts as the big node.
+
+@<Display a pair node@>=
+mp_print_chr(mp, '(');
+mp_print_big_node(mp, mp_x_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_y_part(v), verbosity);
+mp_print_chr(mp, ')');
+
+@ @<Display a transform node@>=
+mp_print_chr(mp, '(');
+mp_print_big_node(mp, mp_tx_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_ty_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_xx_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_xy_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_yx_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_yy_part(v), verbosity);
+mp_print_chr(mp, ')');
+
+@ @<Display a color node@>=
+mp_print_chr(mp, '(');
+mp_print_big_node(mp, mp_red_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_green_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_blue_part(v), verbosity);
+mp_print_chr(mp, ')');
+
+@ @<Display a cmykcolor node@>=
+mp_print_chr(mp, '(');
+mp_print_big_node(mp, mp_cyan_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_magenta_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_yellow_part(v), verbosity);
+mp_print_chr(mp, ',');
+mp_print_big_node(mp, mp_black_part(v), verbosity);
+mp_print_chr(mp, ')');
+
+@ Values of type |picture|, |path|, and |pen| are displayed verbosely in
+the log file only, unless the user has given a positive value to
+|tracingonline|.
+
+@<Display a complex type@>=
+if (verbosity <= 1) {
+ mp_print_type(mp, t);
+} else {
+ if (mp->selector == mp_term_and_log_selector)
+ if (number_nonpositive(internal_value(mp_tracing_online_internal))) {
+ mp->selector = mp_term_only_selector;
+ mp_print_type(mp, t);
+ mp_print_str(mp, " (see the transcript file)");
+ mp->selector = mp_term_and_log_selector;
+ };
+ switch (t) {
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_print_pen(mp, mp_get_value_knot(p), "", 0);
+ break;
+ case mp_path_type:
+ mp_print_path(mp, mp_get_value_knot(p), "", 0);
+ break;
+ case mp_picture_type:
+ mp_print_edges(mp, v, "", 0);
+ break;
+ default:
+ break;
+ }
+}
+
+@ @c
+static void mp_print_dp (MP mp, int t, mp_value_node p, int verbosity)
+{
+ mp_value_node q = (mp_value_node) mp_link(p); /* the node following |p| */
+ if ((mp_get_dep_info(q) == NULL) || (verbosity > 0)) {
+ mp_print_dependency(mp, p, t);
+ } else {
+ mp_print_str(mp, "linearform");
+ }
+}
+
+@ The displayed name of a variable in a ring will not be a capsule unless
+the ring consists entirely of capsules.
+
+@<Display a variable that's been declared but not defined@>=
+{
+ mp_print_type(mp, t);
+ if (v != NULL) {
+ mp_print_chr(mp, ' ');
+ while ((mp_name_type(v) == mp_capsule_operation) && (v != p)) {
+ v = mp_get_value_node(v);
+ }
+ mp_print_variable_name(mp, v);
+ };
+}
+
+@ When errors are detected during parsing, it is often helpful to display an
+expression just above the error message, using |disp_err| just before |mp_error|.
+
+@<Declarations@>=
+static void mp_disp_err (MP mp, mp_node p);
+
+@ @c
+void mp_disp_err (MP mp, mp_node p)
+{
+ if (mp->interaction >= mp_error_stop_mode) {
+ wake_up_terminal();
+ }
+ /* mp_print_nl(mp, ">> "); */
+ mp_print_nl(mp, "<error> ");
+ @.>>@>
+ mp_print_exp(mp, p, 1);
+}
+
+@ If |cur_type| and |cur_exp| contain relevant information that should be
+recycled, we will use the following procedure, which changes |cur_type| to
+|known| and stores a given value in |cur_exp|. We can think of |cur_type| and
+|cur_exp| as either alive or dormant after this has been done, because |cur_exp|
+will not contain a pointer value.
+
+@ @c
+void mp_flush_cur_exp (MP mp, mp_value v)
+{
+ if (is_number(mp->cur_exp.data.n)) {
+ free_number(mp->cur_exp.data.n);
+ }
+ switch (mp->cur_exp.type) {
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_pair_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ case mp_cmykcolor_type:
+ mp_recycle_value(mp, cur_exp_node);
+ mp_free_value_node(mp, cur_exp_node);
+ break;
+ case mp_string_type:
+ delete_str_ref(cur_exp_str);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ mp_toss_knot_list(mp, cur_exp_knot);
+ break;
+ case mp_picture_type:
+ mp_delete_edge_ref(mp, cur_exp_node);
+ break;
+ default:
+ break;
+ }
+ mp->cur_exp = v;
+ mp->cur_exp.type = mp_known_type;
+}
+
+@ There's a much more general procedure that is capable of releasing the storage
+associated with any non-symbolic value packet.
+
+@<Declarations@>=
+static void mp_recycle_value (MP mp, mp_node p);
+
+@ @c
+static void mp_recycle_value (MP mp, mp_node p)
+{
+ if (p != NULL && p != MP_VOID) {
+ mp_variable_type t = mp_type(p);
+ switch (t) {
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_known_type:
+ case mp_numeric_type:
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ mp_ring_delete (mp, p);
+ break;
+ case mp_string_type:
+ delete_str_ref(mp_get_value_str(p));
+ break;
+ case mp_path_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_toss_knot_list(mp, mp_get_value_knot(p));
+ break;
+ case mp_picture_type:
+ mp_delete_edge_ref(mp, mp_get_value_node(p));
+ break;
+ case mp_cmykcolor_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_cyan_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_magenta_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_yellow_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_black_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_cyan_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_magenta_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_black_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_yellow_part(mp_get_value_node(p)));
+ mp_free_node(mp, mp_get_value_node(p), sizeof(mp_color_node_data));
+ }
+ break;
+ case mp_pair_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_x_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_y_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_x_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_y_part(mp_get_value_node(p)));
+ mp_free_pair_node(mp, mp_get_value_node(p));
+ }
+ break;
+ case mp_color_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_red_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_green_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_blue_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_red_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_green_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_blue_part(mp_get_value_node(p)));
+ mp_free_node(mp, mp_get_value_node(p), sizeof(mp_color_node_data));
+ }
+ break;
+ case mp_transform_type:
+ if (mp_get_value_node(p) != NULL) {
+ mp_recycle_value(mp, mp_tx_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_ty_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_xx_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_xy_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_yx_part(mp_get_value_node(p)));
+ mp_recycle_value(mp, mp_yy_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_tx_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_ty_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_xx_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_xy_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_yx_part(mp_get_value_node(p)));
+ mp_free_value_node(mp, mp_yy_part(mp_get_value_node(p)));
+ mp_free_node(mp, mp_get_value_node(p), sizeof(mp_transform_node_data));
+ }
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ /* Recycle a dependency list */
+ {
+ mp_value_node qq = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ while (mp_get_dep_info(qq) != NULL) {
+ qq = (mp_value_node) mp_link(qq);
+ }
+ mp_set_link(mp_get_prev_dep((mp_value_node) p), mp_link(qq));
+ mp_set_prev_dep(mp_link(qq), mp_get_prev_dep((mp_value_node) p));
+ mp_set_link(qq, NULL);
+ mp_flush_node_list(mp, (mp_node) mp_get_dep_list((mp_value_node) p));
+ }
+ break;
+ case mp_independent_type:
+ mp_recycle_independent_value(mp, p);
+ break;
+ case mp_token_list_type:
+ case mp_structured_type:
+ mp_confusion(mp, "recycle");
+ break;
+ case mp_unsuffixed_macro_type:
+ case mp_suffixed_macro_type:
+ mp_delete_mac_ref(mp, mp_get_value_node(p));
+ break;
+ default:
+ break;
+ }
+ mp_type(p) = mp_undefined_type;
+ }
+}
+
+@ When an independent variable disappears, it simply fades away, unless something
+depends on it. In the latter case, a dependent variable whose coefficient of
+dependence is maximal will take its place. The relevant algorithm is due to
+Ignacio~A. Zabala, who implemented it as part of his Ph.n->data. thesis (Stanford
+University, December 1982). @^Zabala Salelles, Ignacio Andr\'es@>
+
+For example, suppose that variable $x$ is being recycled, and that the only
+variables depending on~$x$ are $y=2x+a$ and $z=x+b$. In this case we want to make
+$y$ independent and $z=.5y-.5a+b$; no other variables will depend on~$y$. If
+$|tracingequations|>0$ in this situation, we will print |\#\#\# -2x=-y+a|.
+
+There's a slight complication, however: An independent variable $x$ can occur
+both in dependency lists and in proto-dependency lists. This makes it necessary
+to be careful when deciding which coefficient is maximal.
+
+Furthermore, this complication is not so slight when a proto-dependent variable
+is chosen to become independent. For example, suppose that $y=2x+100a$ is
+proto-dependent while $z=x+b$ is dependent; then we must change $z=.5y-50a+b$ to
+a proto-dependency, because of the large coefficient `50'.
+
+In order to deal with these complications without wasting too much time, we shall
+link together the occurrences of~$x$ among all the linear dependencies,
+maintaining separate lists for the dependent and proto-dependent cases.
+
+@<Declarations@>=
+static void mp_recycle_independent_value (MP mp, mp_node p);
+
+@ @c
+static void mp_recycle_independent_value (MP mp, mp_node p)
+{
+ mp_value_node q, r, s;
+ mp_node pp; /* link manipulation register */
+ mp_number v ; /* a value */
+ mp_number test; /* a temporary value */
+ mp_variable_type t = mp_type(p);
+ new_number(test);
+ new_number(v);
+ if (t < mp_dependent_type) {
+ number_clone(v, mp_get_value_number(p));
+ }
+ set_number_to_zero(mp->max_c[mp_dependent_type]);
+ set_number_to_zero(mp->max_c[mp_proto_dependent_type]);
+ mp->max_link[mp_dependent_type] = NULL;
+ mp->max_link[mp_proto_dependent_type] = NULL;
+ q = (mp_value_node) mp_link(mp->dep_head);
+ while (q != mp->dep_head) {
+ s = (mp_value_node) mp->temp_head;
+ mp_set_link(s, mp_get_dep_list(q));
+ while (1) {
+ r = (mp_value_node) mp_link(s);
+ if (mp_get_dep_info(r) == NULL) {
+ break;
+ } else if (mp_get_dep_info(r) != p) {
+ s = r;
+ } else {
+ t = mp_type(q);
+ if (mp_link(s) == mp_get_dep_list(q)) {
+ /* reset the |dep_list| */
+ mp_set_dep_list(q, mp_link(r));
+ }
+ mp_set_link(s, mp_link(r));
+ mp_set_dep_info(r, (mp_node) q);
+ number_abs_clone(test, mp_get_dep_value(r));
+ if (number_greater(test, mp->max_c[t])) {
+ /* Record a new maximum coefficient of type |t| */
+ if (number_positive(mp->max_c[t])) {
+ mp_set_link(mp->max_ptr[t], (mp_node) mp->max_link[t]);
+ mp->max_link[t] = mp->max_ptr[t];
+ }
+ number_clone(mp->max_c[t], test);
+ mp->max_ptr[t] = r;
+ } else {
+ mp_set_link(r, mp->max_link[t]);
+ mp->max_link[t] = r;
+ }
+ }
+ }
+ q = (mp_value_node) mp_link(r);
+ }
+ if (number_positive(mp->max_c[mp_dependent_type]) || number_positive(mp->max_c[mp_proto_dependent_type])) {
+ /*
+ Choose a dependent variable to take the place of the disappearing
+ independent variable, and change all remaining dependencies
+ accordingly
+ */
+ mp_number test, ret; /* temporary use */
+ new_number(ret);
+ new_number_clone(test, mp->max_c[mp_dependent_type]);
+ number_divide_int(test, 4096);
+ if (number_greaterequal(test, mp->max_c[mp_proto_dependent_type])) {
+ t = mp_dependent_type;
+ } else {
+ t = mp_proto_dependent_type;
+ }
+ /*
+ Let |s=max_ptr[t]|. At this point we have
+ $|value|(s)=\pm|max_c|[t]$, and |mp_get_dep_info(s)| points to the
+ dependent variable~|pp| of type~|t| from whose dependency list we
+ have removed node~|s|. We must reinsert node~|s| into the dependency
+ list, with coefficient $-1.0$, and with |pp| as the new independent
+ variable. Since |pp| will have a larger serial number than any other
+ variable, we can put node |s| at the head of the list.
+
+ Determine the dependency list |s| to substitute for the independent
+ variable~|p|
+ */
+ s = mp->max_ptr[t];
+ pp = (mp_node) mp_get_dep_info(s);
+ number_clone(v, mp_get_dep_value(s));
+ if (t == mp_dependent_type) {
+ mp_set_dep_value(s, fraction_one_t);
+ } else {
+ mp_set_dep_value(s, unity_t);
+ }
+ number_negate(mp_get_dep_value(s));
+ r = (mp_value_node) mp_get_dep_list((mp_value_node) pp);
+ mp_set_link(s, r);
+ while (mp_get_dep_info(r) != NULL) {
+ r = (mp_value_node) mp_link(r);
+ }
+ q = (mp_value_node) mp_link(r);
+ mp_set_link(r, NULL);
+ mp_set_prev_dep(q, mp_get_prev_dep((mp_value_node) pp));
+ mp_set_link(mp_get_prev_dep((mp_value_node) pp), (mp_node) q);
+ mp_new_indep(mp, pp);
+ if (cur_exp_node == pp && mp->cur_exp.type == t) {
+ mp->cur_exp.type = mp_independent_type;
+ }
+ if (number_positive(internal_value(mp_tracing_equations_internal)) && mp_interesting(mp, p)) {
+ mp_begin_diagnostic(mp);
+ mp_show_transformed_dependency(mp, &v, t, p);
+ mp_print_dependency(mp, s, t);
+ mp_end_diagnostic(mp, 0);
+ }
+ /* complement |t| */
+ t = mp_dependent_type + mp_proto_dependent_type - t;
+ if (number_positive(mp->max_c[t])) {
+ /* we need to pick up an unchosen dependency */
+ mp_set_link(mp->max_ptr[t], (mp_node) mp->max_link[t]);
+ mp->max_link[t] = mp->max_ptr[t];
+ }
+ /*
+ Finally, there are dependent and proto-dependent variables whose
+ dependency lists must be brought up to date.
+ */
+ if (t != mp_dependent_type) {
+ /* Substitute new dependencies in place of |p| */
+ for (t = mp_dependent_type; t <= mp_proto_dependent_type; t=t+1) {
+ r = mp->max_link[t];
+ while (r != NULL) {
+ q = (mp_value_node) mp_get_dep_info(r);
+ number_negated_clone(test, v);
+ make_fraction(ret, mp_get_dep_value(r), test);
+ mp_set_dep_list(q, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(q), &ret, s, t, mp_dependent_type));
+ if (mp_get_dep_list(q) == (mp_node) mp->dep_final) {
+ mp_make_known(mp, q, mp->dep_final);
+ }
+ q = r;
+ r = (mp_value_node) mp_link(r);
+ mp_free_dep_node(mp, q);
+ }
+ }
+ } else {
+ /* Substitute new proto-dependencies in place of |p| */
+ for (t = mp_dependent_type; t <= mp_proto_dependent_type; t++) {
+ r = mp->max_link[t];
+ while (r != NULL) {
+ q = (mp_value_node) mp_get_dep_info(r);
+ if (t == mp_dependent_type) {
+ /* for safety's sake, we change |q| to |mp_proto_dependent| */
+ if (cur_exp_node == (mp_node) q && mp->cur_exp.type == mp_dependent_type) {
+ mp->cur_exp.type = mp_proto_dependent_type;
+ }
+ mp_set_dep_list(q, mp_p_over_v(mp, (mp_value_node) mp_get_dep_list(q), &unity_t, mp_dependent_type, mp_proto_dependent_type));
+ mp_type(q) = mp_proto_dependent_type;
+ fraction_to_round_scaled(mp_get_dep_value(r));
+ }
+ number_negated_clone(test, v);
+ make_scaled(ret, mp_get_dep_value(r), test);
+ mp_set_dep_list(q, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(q), &ret, s, mp_proto_dependent_type, mp_proto_dependent_type));
+ if (mp_get_dep_list(q) == (mp_node) mp->dep_final) {
+ mp_make_known(mp, q, mp->dep_final);
+ }
+ q = r;
+ r = (mp_value_node) mp_link(r);
+ mp_free_dep_node(mp, q);
+ }
+ }
+ }
+ mp_flush_node_list(mp, (mp_node) s);
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ check_arith();
+ free_number(ret);
+ }
+ free_number(v);
+ free_number(test);
+}
+
+@ @<Declarations@>=
+static void mp_show_transformed_dependency (MP mp, mp_number *v, mp_variable_type t, mp_node p);
+
+@ @c
+static void mp_show_transformed_dependency (MP mp, mp_number *v, mp_variable_type t, mp_node p)
+{
+ mp_number vv; /* for temp use */
+ mp_print_nl(mp, "### ");
+ if (number_positive(*v)) {
+ mp_print_chr(mp, '-');
+ }
+ if (t == mp_dependent_type) {
+ new_number_clone(vv, mp->max_c[mp_dependent_type]);
+ fraction_to_round_scaled(vv);
+ } else {
+ new_number_clone(vv, mp->max_c[mp_proto_dependent_type]);
+ }
+ if (! number_equal(vv, unity_t)) {
+ print_number(vv);
+ }
+ mp_print_variable_name(mp, p);
+ while (mp_get_indep_scale(p) > 0) {
+ mp_print_str(mp, "*4");
+ mp_set_indep_scale(p, mp_get_indep_scale(p)-2);
+ }
+ if (t == mp_dependent_type) {
+ mp_print_chr(mp, '=');
+ } else {
+ mp_print_str(mp, " = ");
+ }
+ free_number(vv);
+}
+
+@ The code for independency removal makes use of three non-symbolic arrays.
+
+@<Glob...@>=
+mp_number max_c[mp_proto_dependent_type + 1]; /* max coefficient magnitude */
+mp_value_node max_ptr[mp_proto_dependent_type + 1]; /* where |p| occurs with |max_c| */
+mp_value_node max_link[mp_proto_dependent_type + 1]; /* other occurrences of |p| */
+
+
+@ @<Initialize table ... @>=
+for (int i = 0; i < mp_proto_dependent_type + 1; i++) {
+ new_number(mp->max_c[i]);
+}
+
+@ @<Dealloc...@>=
+for (int i = 0; i < mp_proto_dependent_type + 1; i++) {
+ free_number(mp->max_c[i]);
+}
+
+@ A global variable |var_flag| is set to a special command code just before \MP\
+calls |scan_expression|, if the expression should be treated as a variable when
+this command code immediately follows. For example, |var_flag| is set to
+|assignment| at the beginning of a statement, because we want to know the {\sl
+location} of a variable at the left of |:=|, not the {\sl value} of that
+variable.
+
+The |scan_expression| subroutine calls |scan_tertiary|, which calls
+|scan_secondary|, which calls |scan_primary|, which sets |var_flag:=0|. In this
+way each of the scanning routines \quote {knows} when it has been called with a
+special |var_flag|, but |var_flag| is usually zero.
+
+A variable preceding a command that equals |var_flag| is converted to a token
+list rather than a value. Furthermore, an |=| sign following an expression
+with |var_flag=assignment| is not considered to be a relation that produces
+boolean expressions.
+
+@<Glob...@>=
+int var_flag; /* command that wants a variable */
+
+@ @<Set init...@>=
+mp->var_flag = 0;
+
+@* Parsing primary expressions.
+
+The first parsing routine, |scan_primary|, is also the most complicated one,
+since it involves so many different cases. But each case---with one
+exception---is fairly simple by itself.
+
+When |scan_primary| begins, the first token of the primary to be scanned should
+already appear in |cur_cmd|, |cur_mod|, and |cur_sym|. The values of |cur_type|
+and |cur_exp| should be either dead or dormant, as explained earlier. If
+|cur_cmd| is not between |min_primary_command| and |max_primary_command|,
+inclusive, a syntax error will be signaled.
+
+Later we'll come to procedures that perform actual operations like addition,
+square root, and so on; our purpose now is to do the parsing. But we might as
+well mention those future procedures now, so that the suspense won't be too bad:
+
+\smallskip |do_nullary(c)| does primitive operations that have no operands (e.g.,
+|true| or |pencircle|);
+
+\smallskip |do_unary(c)| applies a primitive operation to the current expression;
+
+\smallskip |do_binary(p,c)| applies a primitive operation to the capsule~|p| and
+the current expression.
+
+@<Declare the basic parsing subroutines@>=
+static void check_for_mediation (MP mp);
+
+static void mp_primary_error(MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ mp_disp_err(mp, NULL);
+ new_number(new_expr.data.n);
+ mp_back_error(
+ mp,
+ "Nonnumeric part has been replaced by 0",
+ "I've started to scan a pair (x,y), color (r,g,b), cmykcolor (c,m,y,k) or\n"
+ "transform (tx,ty,xx,xy,yx,yy) but ran into a non-numeric type. I'll recover\n"
+ "as good as possible."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+void mp_scan_primary (MP mp)
+{
+ mp_command_code my_var_flag = mp->var_flag;
+ mp->var_flag = 0;
+ RESTART:
+ check_arith();
+ /* Supply diagnostic information, if requested */
+ switch (cur_cmd) {
+ case mp_left_delimiter_command:
+ {
+ /* Scan a delimited primary */
+ mp_sym l_delim = cur_sym;
+ mp_sym r_delim = equiv_sym(cur_sym);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if ((cur_cmd == mp_comma_command) && (mp->cur_exp.type >= mp_known_type)) {
+ /* Scan the rest of a delimited set of numerics. */
+ mp_node q = mp_new_value_node(mp);
+ mp_node p1 = mp_stash_cur_exp(mp);
+ mp_node r; /* temporary node */
+ mp_name_type(q) = mp_capsule_operation;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ /* Make sure the second part of a pair or color has a numeric type */
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ if (cur_cmd != mp_comma_command) {
+ /* Package the pair. */
+ mp_init_pair_node(mp, q);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_y_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_x_part(r));
+ } else {
+ mp_node p2 = mp_stash_cur_exp(mp);
+ /* Scan the last of a triplet of numerics */
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ if (cur_cmd != mp_comma_command) {
+ /* Package the rgb color. */
+ mp_init_color_node(mp, q, mp_color_type);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_blue_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_red_part(r));
+ mp_unstash_cur_exp(mp, p2);
+ mp_stash_in(mp, mp_green_part(r));
+ } else {
+ mp_node p3 = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ if (cur_cmd != mp_comma_command) {
+ /* Package the cmyk color. */
+ mp_init_color_node(mp, q, mp_cmykcolor_type);
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_black_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_cyan_part(r));
+ mp_unstash_cur_exp(mp, p2);
+ mp_stash_in(mp, mp_magenta_part(r));
+ mp_unstash_cur_exp(mp, p3);
+ mp_stash_in(mp, mp_yellow_part(r));
+ } else {
+ mp_node p4 = mp_stash_cur_exp(mp);
+ mp_node p5;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ p5 = mp_stash_cur_exp(mp);
+ goto HERE;
+ }
+ if (cur_cmd != mp_comma_command) {
+ mp_primary_error(mp);
+ p5 = mp_stash_cur_exp(mp);
+ goto HERE;
+ }
+ p5 = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_primary_error(mp);
+ }
+ HERE:
+ mp_init_transform_node(mp, q);
+ /* Package the transform: xx xy yx yy tx ty */
+ r = mp_get_value_node(q);
+ mp_stash_in(mp, mp_ty_part(r));
+ mp_unstash_cur_exp(mp, p5);
+ mp_stash_in(mp, mp_tx_part(r));
+ mp_unstash_cur_exp(mp, p4);
+ mp_stash_in(mp, mp_yy_part(r));
+ mp_unstash_cur_exp(mp, p3);
+ mp_stash_in(mp, mp_yx_part(r));
+ mp_unstash_cur_exp(mp, p2);
+ mp_stash_in(mp, mp_xy_part(r));
+ mp_unstash_cur_exp(mp, p1);
+ mp_stash_in(mp, mp_xx_part(r));
+ }
+ }
+ }
+ mp_check_delimiter(mp, l_delim, r_delim);
+ mp->cur_exp.type = mp_type(q);
+ mp_set_cur_exp_node(mp, q);
+ } else {
+ mp_check_delimiter(mp, l_delim, r_delim);
+ }
+ }
+ break;
+ case mp_begin_group_command:
+ /* Scan a grouped primary. The local variable |group_line| keeps
+ track of the line where a |begingroup| command occurred; this
+ will be useful in an error message if the group doesn't actually
+ end.
+ */
+ {
+ int group_line = mp_true_line(mp); /* where a group began */
+ if (number_positive(internal_value(mp_tracing_commands_internal))) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ mp_save_boundary(mp);
+ do {
+ mp_do_statement(mp); /* ends with |cur_cmd>=semicolon| */
+ } while (cur_cmd == mp_semicolon_command);
+ if (cur_cmd != mp_end_group_command) {
+ char msg[256];
+ mp_snprintf(msg, 256, "A group begun on line %d never ended", (int) group_line);
+ mp_back_error(
+ mp,
+ msg,
+ "I saw a 'begingroup' back there that hasn't been matched by 'endgroup'. So I've\n"
+ "inserted 'endgroup' now."
+ );
+ set_cur_cmd(mp_end_group_command);
+ }
+ mp_unsave(mp);
+ /* this might change |cur_type|, if independent variables are recycled */
+ if (number_positive(internal_value(mp_tracing_commands_internal))) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ }
+ break;
+ case mp_string_command:
+ /* Scan a string constant */
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, cur_mod_str);
+ break;
+ case mp_numeric_command:
+ {
+ /*
+ Scan a primary that starts with a numeric token. A numeric token
+ might be a primary by itself, or it might be the numerator of a
+ fraction composed solely of numeric tokens, or it might multiply
+ the primary that follows (provided that the primary doesn't begin
+ with a plus sign or a minus sign). The code here uses the facts
+ that |max_primary_command=plus_or_minus| and
+ |max_primary_command-1=numeric_token|. If a fraction is found
+ that is less than unity, we try to retain higher precision when
+ we use it in scalar multiplication.
+ */
+ mp_number num, denom; /* for primaries that are fractions, like `1/2' */
+ mp_set_cur_exp_value_number(mp, &cur_mod_number);
+ mp->cur_exp.type = mp_known_type;
+ mp_get_x_next(mp);
+//new_number(num);
+//new_number(denom);
+ if (cur_cmd != mp_slash_command) {
+ new_number(num);
+ new_number(denom);
+ } else {
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_numeric_command) {
+ mp_back_input(mp);
+ set_cur_cmd(mp_slash_command);
+ set_cur_mod(mp_over_operation);
+ set_cur_sym(mp->frozen_slash);
+// goto DONOTHING;
+ goto DONE;
+ } else {
+ new_number_clone(num, cur_exp_value_number);
+ new_number_clone(denom, cur_mod_number);
+//number_clone(num, cur_exp_value_number);
+//number_clone(denom, cur_mod_number);
+ if (number_zero(denom)) {
+ mp_error(mp, "Division by zero", "I'll pretend that you meant to divide by 1.");
+ } else {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, num, denom);
+ mp_set_cur_exp_value_number(mp, &ret);
+ free_number(ret);
+ }
+ check_arith();
+ mp_get_x_next(mp);
+ }
+ }
+ if (cur_cmd >= mp_min_primary_command && cur_cmd < mp_numeric_command) {
+ /* in particular, |cur_cmd<>plus_or_minus| */
+ mp_number absnum, absdenom;
+ mp_node p = mp_stash_cur_exp(mp);
+ mp_scan_primary(mp);
+ new_number_abs(absnum, num);
+ new_number_abs(absdenom, denom);
+ if (number_greaterequal(absnum, absdenom) || (mp->cur_exp.type < mp_color_type)) {
+ mp_do_binary(mp, p, mp_times_operation);
+ } else {
+ mp_frac_mult(mp, &num, &denom);
+ mp_free_value_node(mp, p);
+ }
+ free_number(absnum);
+ free_number(absdenom);
+ }
+// DONOTHING:
+ free_number(num);
+ free_number(denom);
+ goto DONE;
+ }
+ case mp_nullary_command:
+ /* Scan a nullary operation */
+ mp_do_nullary(mp, (int) cur_mod);
+ break;
+ case mp_unary_command:
+ case mp_type_name_command:
+ case mp_cycle_command:
+ case mp_plus_or_minus_command:
+ {
+ /* Scan a unary operation */
+ int c = (int) cur_mod; /* a primitive operation code */
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_do_unary(mp, c);
+ goto DONE;
+ }
+ case mp_of_binary_command:
+ {
+ /* Scan a binary operation with |of| between its operands */
+ mp_node p; /* for list manipulation */
+ int c = (int) cur_mod; /* a primitive operation code */
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_of_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_cmd_mod(mp, mp_of_binary_command, c);
+ mp->selector = selector;
+ sname = mp_make_string(mp);
+ mp_snprintf(msg, 256, "Missing 'of' has been inserted for %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_back_error(mp, msg, "I've got the first argument; will look now for the other.");
+ }
+ p = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_do_binary(mp, p, c);
+ goto DONE;
+ }
+ case mp_str_command:
+ {
+ /* Convert a suffix to a string */
+ int selector = mp->selector;
+ mp_get_x_next(mp);
+ mp_scan_suffix(mp);
+ mp->selector = mp_new_string_selector;
+ /* Here the periods creep in, we could have a simple one. */
+ mp_show_token_list(mp, cur_exp_node, NULL);
+ /* */
+ mp_flush_token_list(mp, cur_exp_node);
+ mp_set_cur_exp_str(mp, mp_make_string(mp));
+ mp->selector = selector;
+ mp->cur_exp.type = mp_string_type;
+ goto DONE;
+ }
+ case mp_void_command:
+ {
+ /* Convert a suffix to a boolean */
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_suffix(mp);
+ if (cur_exp_node == NULL) {
+ set_number_from_boolean(new_expr.data.n, mp_true_operation);
+ } else {
+ set_number_from_boolean(new_expr.data.n, mp_false_operation);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ cur_exp_node = NULL; /* !! do not replace with |mp_set_cur_exp_node(mp, )| !! */
+ mp->cur_exp.type = mp_boolean_type;
+ goto DONE;
+ }
+ case mp_internal_command:
+ /*
+ Scan an internal numeric quantity. If an internal quantity appears
+ all by itself on the left of an assignment, we return a token
+ list of length one, containing the address of the internal
+ quantity, with |name_type| equal to |mp_internal_operation|. (This
+ accords with the conventions of the save stack, as described
+ earlier.)
+ */
+ {
+ int qq = cur_mod;
+ if (my_var_flag == mp_assignment_command) {
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_assignment_command) {
+ mp_set_cur_exp_node(mp, mp_new_symbolic_node(mp));
+ mp_set_sym_info(cur_exp_node, qq);
+ mp_name_type(cur_exp_node) = mp_internal_operation;
+ mp->cur_exp.type = mp_token_list_type;
+ goto DONE;
+ }
+ mp_back_input(mp);
+ }
+ if (internal_type(qq) == mp_string_type) {
+ mp_set_cur_exp_str(mp, internal_string(qq));
+ } else {
+ mp_set_cur_exp_value_number(mp, &(internal_value(qq)));
+ // if (qq == mp_tracing_online_internal) {
+ // mp->run_internal(mp, 3, qq, number_to_int(internal_value(qq)), internal_name(qq));
+ // }
+ }
+ mp->cur_exp.type = internal_type(qq);
+ }
+ break;
+ case mp_capsule_command:
+ mp_make_exp_copy(mp, cur_mod_node);
+ break;
+ case mp_tag_command:
+ @<Scan a variable primary; |goto restart| if it turns out to be a macro@>
+ break;
+ default:
+ mp_bad_exp(mp, "A primary");
+ goto RESTART;
+ break;
+ }
+ mp_get_x_next(mp); /* the routines |goto done| if they don't want this */
+ DONE:
+ check_for_mediation(mp);
+}
+
+@ Expressions of the form |a[b,c]| are converted into |b+a*(c-b)|,
+without checking the types of \.b~or~\.c, provided that \.a is numeric.
+
+@<Declare the basic parsing subroutines@>=
+static void check_for_mediation (MP mp)
+{
+ if (cur_cmd == mp_left_bracket_command && mp->cur_exp.type >= mp_known_type) {
+ /* Scan a mediation construction */
+ mp_node p = mp_stash_cur_exp(mp);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_comma_command) {
+ /*
+ Put the left bracket and the expression back to be rescanned.
+ The left bracket that we thought was introducing a subscript
+ might have actually been the left bracket in a mediation
+ construction like |x[a,b]|. So we don't issue an error
+ message at this point; but we do want to back up so as to
+ avoid any embarrassment about our incorrect assumption.
+ */
+ mp_back_input(mp);
+ /* that was the token following the current expression */
+ mp_back_expr(mp);
+ set_cur_cmd(mp_left_bracket_command);
+ set_cur_mod_number(zero_t);
+ set_cur_sym(mp->frozen_left_bracket);
+ mp_unstash_cur_exp(mp, p);
+ } else {
+ mp_node q = mp_stash_cur_exp(mp);
+ mp_node r;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_right_bracket_command) {
+ mp_back_error(
+ mp,
+ "Missing ']' has been inserted",
+ "I've scanned an expression of the form 'a[b,c', so a right bracket should have\n"
+ "come next. I shall pretend that one was there."
+ );
+ }
+ r = mp_stash_cur_exp(mp);
+ mp_make_exp_copy(mp, q);
+ mp_do_binary(mp, r, mp_minus_operation);
+ mp_do_binary(mp, p, mp_times_operation);
+ mp_do_binary(mp, q, mp_plus_operation);
+ mp_get_x_next(mp);
+ }
+ }
+}
+
+@ Errors at the beginning of expressions are flagged by |bad_exp|.
+
+@c
+static void mp_bad_exp (MP mp, const char *s)
+{
+ char msg[256];
+ int save_flag;
+ @:METAFONTbook}{\sl The {\logos METAFONT}book@>
+ {
+ mp_string cm;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_cmd_mod(mp, cur_cmd, cur_mod);
+ mp->selector = selector;
+ cm = mp_make_string(mp);
+ mp_snprintf(msg, 256, "%s expression can't begin with '%s'", s, mp_str(mp, cm));
+ delete_str_ref(cm);
+ }
+ mp_back_input(mp);
+ set_cur_sym(NULL);
+ set_cur_cmd(mp_numeric_command);
+ set_cur_mod_number(zero_t);
+ mp_ins_error(
+ mp,
+ msg,
+ "I'm afraid I need some sort of value in order to continue, so I've tentatively\n"
+ "inserted '0'."
+ );
+ save_flag = mp->var_flag;
+ mp->var_flag = 0;
+ mp_get_x_next(mp);
+ mp->var_flag = save_flag;
+}
+
+
+@ The |stash_in| subroutine puts the current (numeric) expression into a field
+within a \quote {big node.}
+
+@c
+static void mp_stash_in (MP mp, mp_node p)
+{
+ mp_type(p) = mp->cur_exp.type;
+ if (mp->cur_exp.type == mp_known_type) {
+ mp_set_value_number(p, cur_exp_value_number);
+ } else if (mp->cur_exp.type == mp_independent_type) {
+ /*
+ Stash an independent |cur_exp| into a big node. In rare cases the current
+ expression can become |independent|. There may be many dependency lists
+ pointing to such an independent capsule, so we can't simply move it into
+ place within a big node. Instead, we copy it, then recycle it.
+ */
+ mp_value_node q = mp_single_dependency(mp, cur_exp_node);
+ if (q == mp->dep_final) {
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, zero_t);
+ mp_free_dep_node(mp, q);
+ } else {
+ mp_new_dep(mp, p, mp_dependent_type, q);
+ }
+ mp_recycle_value(mp, cur_exp_node);
+ mp_free_value_node(mp, cur_exp_node);
+ } else {
+ mp_set_dep_list((mp_value_node) p, mp_get_dep_list((mp_value_node) cur_exp_node));
+ mp_set_prev_dep((mp_value_node) p, mp_get_prev_dep((mp_value_node) cur_exp_node));
+ mp_set_link(mp_get_prev_dep((mp_value_node) p), p);
+ mp_free_dep_node(mp, (mp_value_node) cur_exp_node);
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+}
+
+@ The most difficult part of |scan_primary| has been saved for last, since it was
+necessary to build up some confidence first. We can now face the task of scanning
+a variable.
+
+As we scan a variable, we build a token list containing the relevant names and
+subscript values, simultaneously following along in the \quote {collective} structure
+to see if we are actually dealing with a macro instead of a value.
+
+The local variables |pre_head| and |post_head| will point to the beginning of the
+prefix and suffix lists; |tail| will point to the end of the list that is
+currently growing.
+
+Another local variable, |tt|, contains partial information about the declared
+type of the variable-so-far. If |tt>=mp_unsuffixed_macro|, the relation
+|tt=mp_type(q)| will always hold. If |tt=undefined|, the routine doesn't bother
+to update its information about type. And if |undefined<tt<mp_unsuffixed_macro|,
+the precise value of |tt| isn't critical.
+
+@ @<Scan a variable primary...@>=
+{
+ mp_node p = 0; /* for list manipulation */
+ mp_node q = 0; /* for list manipulation */
+ mp_node t = 0;
+ mp_node macro_ref = 0; /* reference count for a suffixed macro */
+ int tt = mp_vacuous_type; /* approximation to the type of the variable-so-far */
+ mp_node pre_head = mp_new_symbolic_node(mp);
+ mp_node tail = pre_head;
+ mp_node post_head = NULL;
+ while (1) {
+ t = mp_cur_tok(mp);
+ mp_link(tail) = t;
+ if (tt != mp_undefined_type) {
+ /*
+ Find the approximate type |tt| and corresponding~|q|. Every time we call
+ |get_x_next|, there's a chance that the variable we've been looking at
+ will disappear. Thus, we cannot safely keep |q| pointing into the
+ variable structure; we need to start searching from the root each time.
+ */
+ mp_sym qq;
+ p = mp_link(pre_head);
+ qq = mp_get_sym_sym(p);
+ tt = mp_undefined_type;
+ // if (eq_type(qq) % mp_outer_tag_command == mp_tag_command) {
+ if (eq_type(qq) == mp_tag_command) {
+ q = equiv_node(qq);
+ if (q == NULL) {
+ goto DONE2;
+ }
+ while (1) {
+ p = mp_link(p);
+ if (p == NULL) {
+ tt = mp_type(q);
+ goto DONE2;
+ }
+ if (mp_type(q) != mp_structured_type) {
+ goto DONE2;
+ }
+ q = mp_link(mp_get_attribute_head(q)); /* the |mp_collective_subscript| attribute */
+ if (mp_type(p) == mp_symbol_node_type) {
+ /* it's not a subscript */
+ do {
+ q = mp_link(q);
+ } while (! (mp_get_hashloc(q) >= mp_get_sym_sym(p)));
+ if (mp_get_hashloc(q) > mp_get_sym_sym(p)) {
+ goto DONE2;
+ }
+ }
+ }
+ }
+ DONE2:
+ if (tt >= mp_unsuffixed_macro_type) {
+ /* Either begin an unsuffixed macro call or prepare for a suffixed one */
+ mp_link(tail) = NULL;
+ if (tt > mp_unsuffixed_macro_type) {
+ /* |tt=mp_suffixed_macro| */
+ post_head = mp_new_symbolic_node(mp);
+ tail = post_head;
+ mp_link(tail) = t;
+ tt = mp_undefined_type;
+ macro_ref = mp_get_value_node(q);
+ mp_add_mac_ref(macro_ref);
+ } else {
+ /*
+ Set up unsuffixed macro call and |goto restart|. The only
+ complication associated with macro calling is that the
+ prefix and \quote {at} parameters must be packaged in an
+ appropriate list of lists.
+ */
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(pre_head, mp_link(pre_head));
+ mp_link(pre_head) = p;
+ mp_set_sym_sym(p, t);
+ mp_macro_call(mp, mp_get_value_node(q), pre_head, NULL);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ }
+ }
+ mp_get_x_next(mp);
+ tail = t;
+ if (cur_cmd == mp_left_bracket_command) {
+ /* Scan for a subscript; replace |cur_cmd| by |numeric_token| if found */
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (cur_cmd != mp_right_bracket_command) {
+ /*
+ Put the left bracket and the expression back to be rescanned.
+ The left bracket that we thought was introducing a subscript
+ might have actually been the left bracket in a mediation
+ construction like |x[a,b]|. So we don't issue an error
+ message at this point; but we do want to back up so as to
+ avoid any embarrassment about our incorrect assumption.
+ */
+ mp_back_input(mp); /* that was the token following the current expression */
+ mp_back_expr(mp);
+ set_cur_cmd(mp_left_bracket_command);
+ set_cur_mod_number(zero_t);
+ set_cur_sym(mp->frozen_left_bracket);
+ } else {
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_subscript(mp);
+ }
+ set_cur_cmd(mp_numeric_command);
+ set_cur_mod_number(cur_exp_value_number);
+ set_cur_sym(NULL);
+ }
+ }
+ if (cur_cmd > mp_max_suffix_token) {
+ break;
+ } else if (cur_cmd < mp_min_suffix_token) {
+ break;
+ }
+ }
+ /*
+ Now |cur_cmd| is |internal_quantity|, |tag_token|, or |numeric_token|.
+ Handle unusual cases that masquerade as variables, and |goto restart| or
+ |goto done| if appropriate; otherwise make a copy of the variable and
+ |goto done| If the variable does exist, we also need to check for a few
+ other special cases before deciding that a plain old ordinary variable
+ has, indeed, been scanned.
+ */
+ if (post_head != NULL) {
+ /*
+ Set up suffixed macro call and |goto restart|. If the \quote {variable}
+ that turned out to be a suffixed macro no longer exists, we don't
+ care, because we have reserved a pointer (|macro_ref|) to its token
+ list.
+ */
+ mp_back_input(mp);
+ p = mp_new_symbolic_node(mp);
+ q = mp_link(post_head);
+ mp_set_sym_sym(pre_head, mp_link(pre_head));
+ mp_link(pre_head) = post_head;
+ mp_set_sym_sym(post_head, q);
+ mp_link(post_head) = p;
+ mp_set_sym_sym(p, mp_link(q));
+ mp_link(q) = NULL;
+ mp_macro_call(mp, macro_ref, pre_head, NULL);
+ mp_decr_mac_ref(macro_ref);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ q = mp_link(pre_head);
+ mp_free_symbolic_node(mp, pre_head);
+ if (cur_cmd == my_var_flag) {
+ mp->cur_exp.type = mp_token_list_type;
+ mp_set_cur_exp_node(mp, q);
+ goto DONE;
+ }
+ p = mp_find_variable(mp, q);
+ if (p != NULL) {
+ mp_make_exp_copy(mp, p);
+ } else {
+ mp_value new_expr;
+ char *msg = mp_obliterated (mp, q);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_back_error(
+ mp,
+ msg,
+ "While I was evaluating the suffix of this variable, something was redefined, and\n"
+ "it's no longer a variable! In order to get back on my feet, I've inserted '0'\n"
+ "instead."
+ );
+ mp_memory_free(msg);
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ mp_flush_node_list(mp, q);
+ goto DONE;
+}
+
+@ Here's a routine that puts the current expression back to be read again.
+
+@c
+static void mp_back_expr (MP mp)
+{
+ mp_node p = mp_stash_cur_exp(mp); /* capsule token */
+ mp_link(p) = NULL;
+ mp_begin_token_list(mp, p, mp_backed_up_text);
+}
+
+@ Unknown subscripts lead to the following error message.
+
+@c
+static void mp_bad_subscript (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_error(
+ mp,
+ "Improper subscript has been replaced by zero",
+ "A bracketed subscript must have a known numeric value; unfortunately, what I\n"
+ "found was the value that appears just above this error message. So I'll try a\n"
+ "zero subscript."
+ );
+ @.Improper subscript...@>
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+@ How do things stand now? Well, we have scanned an entire variable name,
+including possible subscripts and/or attributes; |cur_cmd|, |cur_mod|, and
+|cur_sym| represent the token that follows. If |post_head=NULL|, a token list for
+this variable name starts at |mp_link(pre_head)|, with all subscripts evaluated.
+But if |post_head<>NULL|, the variable turned out to be a suffixed macro;
+|pre_head| is the head of the prefix list, while |post_head| is the head of a
+token list containing both |\AT!| and the suffix.
+
+Our immediate problem is to see if this variable still exists. (Variable
+structures can change drastically whenever we call |get_x_next|; users aren't
+supposed to do this, but the fact that it is possible means that we must be
+cautious.)
+
+The following procedure creates an error message for when a variable unexpectedly
+disappears.
+
+@c
+static char *mp_obliterated (MP mp, mp_node q)
+{
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_show_token_list(mp, q, NULL);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Variable %s has been obliterated", mp_str(mp, sname));
+ @.Variable...obliterated@>
+ delete_str_ref(sname);
+ return mp_strdup(msg);
+}
+
+@ Our remaining job is simply to make a copy of the value that has been found.
+Some cases are harder than others, but complexity arises solely because of the
+multiplicity of possible cases.
+
+@<Declare the procedure called |make_exp_copy|@>=
+@<Declare subroutines needed by |make_exp_copy|@>
+static void mp_make_exp_copy (MP mp, mp_node p)
+{
+ RESTART:
+ mp->cur_exp.type = mp_type(p);
+ switch (mp->cur_exp.type) {
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_known_type:
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p)));
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ {
+ mp_node t = mp_new_ring_entry(mp, p);
+ mp_set_cur_exp_node(mp, t);
+ }
+ break;
+ case mp_string_type:
+ mp_set_cur_exp_str(mp, mp_get_value_str(p));
+ break;
+ case mp_picture_type:
+ mp_set_cur_exp_node(mp, mp_get_value_node(p));
+ mp_add_edge_ref(mp, cur_exp_node);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_set_cur_exp_knot(mp, mp_copy_pen(mp, mp_get_value_knot(p)));
+ break;
+ case mp_path_type:
+ mp_set_cur_exp_knot(mp, mp_copy_path(mp, mp_get_value_knot(p)));
+ break;
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ {
+ /*
+ Copy the big node |p|. The most tedious case arises when the user
+ refers to a |pair|, |color|, or |transform| variable; we must
+ copy several fields, each of which can be |independent|, |dependent|,
+ |mp_proto_dependent|, or |known|.
+ */
+ mp_node t;
+ mp_value_node q;
+ if (mp_get_value_node(p) == NULL) {
+ switch (mp_type(p)) {
+ case mp_pair_type:
+ mp_init_pair_node(mp, p);
+ break;
+ case mp_color_type:
+ mp_init_color_node(mp, p, mp_color_type);
+ break;
+ case mp_cmykcolor_type:
+ mp_init_color_node(mp, p, mp_cmykcolor_type);
+ break;
+ case mp_transform_type:
+ mp_init_transform_node(mp, p);
+ break;
+ default:
+ break;
+ }
+ }
+ t = mp_new_value_node(mp);
+ mp_name_type(t) = mp_capsule_operation;
+ q = (mp_value_node) mp_get_value_node(p);
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ mp_init_pair_node(mp, t);
+ mp_install(mp, mp_y_part(mp_get_value_node(t)), mp_y_part(q));
+ mp_install(mp, mp_x_part(mp_get_value_node(t)), mp_x_part(q));
+ break;
+ case mp_color_type:
+ mp_init_color_node(mp, t, mp_color_type);
+ mp_install(mp, mp_blue_part(mp_get_value_node(t)), mp_blue_part(q));
+ mp_install(mp, mp_green_part(mp_get_value_node(t)), mp_green_part(q));
+ mp_install(mp, mp_red_part(mp_get_value_node(t)), mp_red_part(q));
+ break;
+ case mp_cmykcolor_type:
+ mp_init_color_node(mp, t, mp_cmykcolor_type);
+ mp_install(mp, mp_black_part(mp_get_value_node(t)), mp_black_part(q));
+ mp_install(mp, mp_yellow_part(mp_get_value_node(t)), mp_yellow_part(q));
+ mp_install(mp, mp_magenta_part(mp_get_value_node(t)), mp_magenta_part(q));
+ mp_install(mp, mp_cyan_part(mp_get_value_node(t)), mp_cyan_part(q));
+ break;
+ case mp_transform_type:
+ mp_init_transform_node(mp, t);
+ mp_install(mp, mp_yy_part(mp_get_value_node(t)), mp_yy_part(q));
+ mp_install(mp, mp_yx_part(mp_get_value_node(t)), mp_yx_part(q));
+ mp_install(mp, mp_xy_part(mp_get_value_node(t)), mp_xy_part(q));
+ mp_install(mp, mp_xx_part(mp_get_value_node(t)), mp_xx_part(q));
+ mp_install(mp, mp_ty_part(mp_get_value_node(t)), mp_ty_part(q));
+ mp_install(mp, mp_tx_part(mp_get_value_node(t)), mp_tx_part(q));
+ break;
+ default:
+ break;
+ }
+ mp_set_cur_exp_node(mp, t);
+ }
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ mp_encapsulate (mp, mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) p)));
+ break;
+ case mp_numeric_type:
+ mp_new_indep(mp, p);
+ goto RESTART;
+ case mp_independent_type:
+ {
+ mp_value_node q = mp_single_dependency(mp, p);
+ if (q == mp->dep_final) {
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &zero_t);
+ mp_free_dep_node(mp, q);
+ } else {
+ mp->cur_exp.type = mp_dependent_type;
+ mp_encapsulate (mp, q);
+ }
+ }
+ break;
+ case mp_undefined_type:
+ mp_confusion(mp, "undefined copy");
+ break;
+ default:
+ mp_confusion(mp, "copy");
+ @:this can't happen copy}{\quad copy@>
+ break;
+ }
+}
+
+@ The |encapsulate| subroutine assumes that |dep_final| is the tail of dependency
+list~|p|.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+static void mp_encapsulate (MP mp, mp_value_node p)
+{
+ mp_node q = mp_new_value_node(mp);
+ mp_name_type(q) = mp_capsule_operation;
+ mp_new_dep(mp, q, mp->cur_exp.type, p);
+ mp_set_cur_exp_node(mp, q);
+}
+
+@ The |install| procedure copies a numeric field~|q| into field~|r| of
+a big node that will be part of a capsule.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+static void mp_install (MP mp, mp_node r, mp_node q)
+{
+ if (mp_type(q) == mp_known_type) {
+ mp_type(r) = mp_known_type;
+ mp_set_value_number(r, mp_get_value_number(q));
+ } else if (mp_type(q) == mp_independent_type) {
+ mp_value_node p = mp_single_dependency(mp, q);
+ if (p == mp->dep_final) {
+ mp_type(r) = mp_known_type;
+ mp_set_value_number(r, zero_t);
+ mp_free_dep_node(mp, p);
+ } else {
+ mp_new_dep(mp, r, mp_dependent_type, p);
+ }
+ } else {
+ mp_new_dep(mp, r, mp_type(q), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) q)));
+ }
+}
+
+@ Here is a comparatively simple routine that is used to scan the |suffix|
+parameters of a macro.
+
+@<Declare the basic parsing subroutines@>=
+static void mp_scan_suffix (MP mp)
+{
+ mp_node h = mp_new_symbolic_node(mp); /* head of the list being built */
+ mp_node t = h; /* tail of the list being built */
+ while (1) {
+ mp_node p;
+ if (cur_cmd == mp_left_bracket_command) {
+ /* Scan a bracketed subscript and set |cur_cmd:=numeric_token| */
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_subscript(mp);
+ }
+ if (cur_cmd != mp_right_bracket_command) {
+ mp_back_error(
+ mp,
+ "Missing ']' has been inserted",
+ "I've seen a '[' and a subscript value, in a suffix, so a right bracket should\n"
+ "have come next. I shall pretend that one was there."
+ );
+ }
+ set_cur_cmd(mp_numeric_command);
+ set_cur_mod_number(cur_exp_value_number);
+ }
+ if (cur_cmd == mp_numeric_command) {
+ mp_number arg1;
+ new_number_clone(arg1, cur_mod_number);
+ p = mp_new_num_tok(mp, &arg1);
+ free_number(arg1);
+ } else if ((cur_cmd == mp_tag_command) || (cur_cmd == mp_internal_command)) {
+ p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, cur_sym);
+ mp_name_type(p) = cur_sym_mod;
+ } else {
+ break;
+ }
+ mp_link(t) = p;
+ t = p;
+ mp_get_x_next(mp);
+ }
+ mp_set_cur_exp_node(mp, mp_link(h));
+ mp_free_symbolic_node(mp, h);
+ mp->cur_exp.type = mp_token_list_type;
+}
+
+@* Parsing secondary and higher expressions.
+
+After the intricacies of |scan_primary|\kern-1pt, the |scan_secondary| routine is
+refreshingly simple. It's not trivial, but the operations are relatively
+straightforward; the main difficulty is, again, that expressions and data
+structures might change drastically every time we call |get_x_next|, so a
+cautious approach is mandatory. For example, a macro defined by |primarydef|
+might have disappeared by the time its second argument has been scanned; we solve
+this by increasing the reference count of its token list, so that the macro can
+be called even after it has been clobbered.
+
+@<Declare the basic parsing subroutines@>=
+static void mp_scan_secondary (MP mp)
+{
+ mp_node cc = NULL;
+ mp_sym mac_name = NULL; /* token defined with |primarydef| */
+ RESTART:
+ if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) {
+ mp_bad_exp(mp, "A secondary");
+ }
+ @.A secondary expression...@>
+ mp_scan_primary(mp);
+ CONTINUE:
+ if (cur_cmd <= mp_max_secondary_command && cur_cmd >= mp_min_secondary_command) {
+ mp_node p = mp_stash_cur_exp(mp);
+ int d = cur_cmd;
+ int c = cur_mod;
+ if (d == mp_primary_def_command) {
+ cc = cur_mod_node;
+ mac_name = cur_sym;
+ mp_add_mac_ref(cc);
+ }
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ if (d != mp_primary_def_command) {
+ mp_do_binary(mp, p, c);
+ } else {
+ mp_back_input(mp);
+ mp_binary_mac(mp, p, cc, mac_name);
+ mp_decr_mac_ref(cc);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ goto CONTINUE;
+ }
+}
+
+@ The following procedure calls a macro that has two parameters, |p| and
+|cur_exp|.
+
+@c
+static void mp_binary_mac (MP mp, mp_node p, mp_node c, mp_sym n)
+{
+ mp_node q = mp_new_symbolic_node(mp);
+ mp_node r = mp_new_symbolic_node(mp);
+ mp_link(q) = r;
+ mp_set_sym_sym(q, p);
+ mp_set_sym_sym(r, mp_stash_cur_exp(mp));
+ mp_macro_call(mp, c, q, n);
+}
+
+@ The next procedure, |scan_tertiary|, is pretty much the same deal.
+
+@<Declare the basic parsing subroutines@>=
+static void mp_scan_tertiary (MP mp)
+{
+ mp_node cc = NULL;
+ mp_sym mac_name = NULL; /* token defined with |secondarydef| */
+ RESTART:
+ if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) {
+ mp_bad_exp(mp, "A tertiary");
+ }
+ @.A tertiary expression...@>
+ mp_scan_secondary(mp);
+ CONTINUE:
+ if (cur_cmd <= mp_max_tertiary_command && cur_cmd >= mp_min_tertiary_command) {
+ mp_node p = mp_stash_cur_exp(mp);
+ int c = cur_mod;
+ int d = cur_cmd;
+ if (d == mp_secondary_def_command) {
+ cc = cur_mod_node;
+ mac_name = cur_sym;
+ mp_add_mac_ref(cc);
+ }
+ mp_get_x_next(mp);
+ mp_scan_secondary(mp);
+ if (d != mp_secondary_def_command) {
+ mp_do_binary(mp, p, c);
+ } else {
+ mp_back_input(mp);
+ mp_binary_mac(mp, p, cc, mac_name);
+ mp_decr_mac_ref(cc);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ goto CONTINUE;
+ }
+}
+
+@ Finally we reach the deepest level in our quartet of parsing routines.
+This one is much like the others; but it has an extra complication from
+paths, which materialize here.
+
+@<Declare the basic parsing subroutines@>=
+
+static int mp_scan_path (MP mp);
+
+static void mp_scan_expression (MP mp)
+{
+ int my_var_flag = mp->var_flag;
+ mp_check_expansion_depth(mp);
+ RESTART:
+ if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) {
+ mp_bad_exp(mp, "An");
+ }
+ @.An expression...@>
+ mp_scan_tertiary(mp);
+ CONTINUE:
+ if (cur_cmd <= mp_max_expression_command) {
+ if (cur_cmd >= mp_min_expression_command) {
+ if ((cur_cmd != mp_equals_command) || (my_var_flag != mp_assignment_command)) {
+ mp_node cc = NULL;
+ mp_sym mac_name; /* token defined with |tertiarydef| */
+ mac_name = NULL;
+ mp_node p = mp_stash_cur_exp(mp);
+ int d = cur_cmd;
+ int c = cur_mod;
+ if (d == mp_tertiary_def_command) {
+ cc = cur_mod_node;
+ mac_name = cur_sym;
+ mp_add_mac_ref(cc);
+ }
+ if ((d < mp_ampersand_command) || ((d == mp_ampersand_command) && ((mp_type(p) == mp_pair_type) || (mp_type(p) == mp_path_type)))) {
+ /* Scan a path construction operation; but |return| if |p| has the wrong type */
+ mp_unstash_cur_exp(mp, p);
+ if (! mp_scan_path(mp)) {
+ mp->expand_depth_count--;
+ return;
+ }
+ } else {
+ mp_get_x_next(mp);
+ mp_scan_tertiary(mp);
+ if (d != mp_tertiary_def_command) {
+ mp_do_binary(mp, p, c);
+ } else {
+ mp_back_input(mp);
+ mp_binary_mac(mp, p, cc, mac_name);
+ mp_decr_mac_ref(cc);
+ mp_get_x_next(mp);
+ goto RESTART;
+ }
+ }
+ goto CONTINUE;
+ }
+ }
+ }
+ mp->expand_depth_count--;
+}
+
+@ The reader should review the data structure conventions for paths before hoping
+to understand the next part of this code.
+
+@d min_tension three_quarter_unit_t
+
+@<Declare the basic parsing subroutines@>=
+static void force_valid_tension_setting (MP mp)
+{
+ if ((mp->cur_exp.type != mp_known_type) || number_less(cur_exp_value_number, min_tension)) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ number_clone(new_expr.data.n, unity_t);
+ mp_back_error(
+ mp,
+ "Improper tension has been set to 1",
+ "The expression above should have been a number >= 3/4."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+
+static int mp_scan_path (MP mp)
+{
+ mp_knot path_p, path_q, r;
+ mp_knot pp = NULL;
+ mp_knot qq = NULL;
+ int d, dd; /* operation code or modifier */
+ int cycle_hit = 0; /* did a path expression just end with |cycle|? */
+ mp_number x, y; /* explicit coordinates or tension at a path join */
+ int t = mp_endpoint_knot; /* knot type following a path join */
+ /*
+ Convert the left operand, |p|, into a partial path ending at~|q|; but
+ |return| if |p| doesn't have a suitable type
+ */
+ if (mp->cur_exp.type == mp_pair_type) {
+ path_p = mp_pair_to_knot(mp);
+ } else if (mp->cur_exp.type == mp_path_type) {
+ path_p = cur_exp_knot;
+ } else {
+ return 0;
+ }
+ path_q = path_p;
+ while (mp_next_knot(path_q) != path_p) {
+ path_q = mp_next_knot(path_q);
+ }
+ if (mp_left_type(path_p) != mp_endpoint_knot) {
+ /* open up a cycle */
+ r = mp_copy_knot(mp, path_p);
+ mp_prev_knot(r) = path_q;
+ mp_next_knot(path_q) = r;
+ path_q = r;
+ }
+ mp_left_type(path_p) = mp_open_knot;
+ mp_right_type(path_q) = mp_open_knot;
+ new_number(y);
+ new_number(x);
+ CONTINUE_PATH:
+ /*
+ Determine the path join parameters; but |goto finish_path| if there's only a
+ direction specifier At this point |cur_cmd| is either |ampersand|,
+ |left_brace|, or |path_join|.
+ */
+ if (cur_cmd == mp_left_brace_command) {
+ /*
+ Put the pre-join direction information into node |q|. At this point
+ |mp_right_type(q)| is usually |open|, but it may have been set to some
+ other value by a previous operation. We must maintain the value of
+ |mp_right_type(q)| in cases such as `|..\{curl2\|z\{0,0\}..}'.
+ */
+ t = mp_scan_direction(mp);
+ if (t != mp_open_knot) {
+ mp_right_type(path_q) = (unsigned char) t;
+ number_clone(path_q->right_given, cur_exp_value_number);
+ if (mp_left_type(path_q) == mp_open_knot) {
+ mp_left_type(path_q) = (unsigned char) t;
+ number_clone(path_q->left_given, cur_exp_value_number);
+ } /* note that |left_given(q)=left_curl(q)| */
+ }
+ }
+ d = cur_cmd;
+ dd = cur_mod;
+ if (d == mp_path_join_command) {
+ /* Determine the tension and/or control points */
+ mp_get_x_next(mp);
+ switch (cur_cmd) {
+ case mp_tension_command:
+ /* Set explicit tensions */
+ mp_get_x_next(mp);
+ set_number_from_scaled(y, cur_cmd);
+ if (cur_cmd == mp_at_least_command) {
+ mp_get_x_next(mp);
+ }
+ mp_scan_primary(mp);
+ force_valid_tension_setting(mp);
+ if (number_to_scaled(y) == mp_at_least_command && is_number(cur_exp_value_number)) {
+ number_negate(cur_exp_value_number);
+ }
+ number_clone(path_q->right_tension, cur_exp_value_number);
+ if (cur_cmd == mp_and_command) {
+ mp_get_x_next(mp);
+ set_number_from_scaled(y, cur_cmd);
+ if (cur_cmd == mp_at_least_command) {
+ mp_get_x_next(mp);
+ }
+ mp_scan_primary(mp);
+ force_valid_tension_setting(mp);
+ if (number_to_scaled(y) == mp_at_least_command && is_number(cur_exp_value_number)) {
+ number_negate(cur_exp_value_number);
+ }
+ }
+ number_clone(y, cur_exp_value_number);
+ break;
+ case mp_controls_command:
+ /* Set explicit control points */
+ mp_right_type(path_q) = mp_explicit_knot;
+ t = mp_explicit_knot;
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_known_pair(mp);
+ number_clone(path_q->right_x, mp->cur_x);
+ number_clone(path_q->right_y, mp->cur_y);
+ if (cur_cmd != mp_and_command) {
+ number_clone(x, path_q->right_x);
+ number_clone(y, path_q->right_y);
+ } else {
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ mp_known_pair(mp);
+ number_clone(x, mp->cur_x);
+ number_clone(y, mp->cur_y);
+ }
+ break;
+ default:
+ set_number_to_unity(path_q->right_tension);
+ set_number_to_unity(y);
+ /* default tension */
+ mp_back_input(mp);
+ goto DONE;
+ break;
+ }
+ if (cur_cmd != mp_path_join_command) {
+ mp_back_error(
+ mp,
+ "Missing '..' has been inserted",
+ "A path join command should end with two dots."
+ );
+ }
+ DONE:
+ ; /* needed */
+ } else if (d != mp_ampersand_command) {
+ goto FINISH_PATH;
+ }
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_left_brace_command) {
+ /*
+ Put the post-join direction information into |x| and |t|. Since
+ |left_tension| and |mp_left_y| share the same position in knot nodes,
+ and since |left_given| is similarly equivalent to |left_x|, we use
+ |x| and |y| to hold the given direction and tension information when
+ there are no explicit control points.
+ */
+ t = mp_scan_direction(mp);
+ if (mp_right_type(path_q) != mp_explicit_knot) {
+ number_clone(x, cur_exp_value_number);
+ } else {
+ /* the direction information is superfluous */
+ t = mp_explicit_knot;
+ }
+ } else if (mp_right_type(path_q) != mp_explicit_knot) {
+ t = mp_open_knot;
+ set_number_to_zero(x);
+ }
+ if (cur_cmd == mp_cycle_command) {
+ /*
+ Get ready to close a cycle. If a person tries to define an entire
+ path by saying |(x,y)\&cycle|, we silently change the
+ specification to |(x,y)..cycle|, since a cycle shouldn't have
+ length zero.
+ */
+ if (cur_mod == mp_cycle_operation) {
+ cycle_hit = 1;
+ mp_get_x_next(mp);
+ pp = path_p;
+ qq = path_p;
+ if (d == mp_ampersand_command && path_p == path_q) {
+ d = mp_path_join_command;
+ set_number_to_unity(path_q->right_tension);
+ set_number_to_unity(y);
+ }
+ } else {
+ mp_get_x_next(mp);
+ qq = pp;
+ goto FINISH_PATH;
+ }
+ } else {
+ mp_scan_tertiary(mp);
+ /*
+ Convert the right operand, |cur_exp|, into a partial path from |pp|
+ to~|qq|
+ */
+ if (mp->cur_exp.type != mp_path_type) {
+ pp = mp_pair_to_knot(mp);
+ } else {
+ pp = cur_exp_knot;
+ }
+ qq = pp;
+ while (mp_next_knot(qq) != pp) {
+ qq = mp_next_knot(qq);
+ }
+ if (mp_left_type(pp) != mp_endpoint_knot) { /* open up a cycle */
+ r = mp_copy_knot(mp, pp);
+ mp_prev_knot(r) = qq;
+ mp_next_knot(qq) = r;
+ qq = r;
+ }
+ mp_left_type(pp) = mp_open_knot;
+ mp_right_type(qq) = mp_open_knot;
+ }
+ /*
+ Join the partial paths and reset |p| and |q| to the head and tail of the
+ result
+ */
+ if (d == mp_ampersand_command && dd != mp_just_append_operation) {
+ if (! (number_equal(path_q->x_coord, pp->x_coord)) || ! (number_equal(path_q->y_coord, pp->y_coord))) {
+ mp_back_error(
+ mp,
+ "Paths don't touch; '&' will be changed to '..'",
+ "When you join paths 'p & q', the ending point of p must be exactly equal to the\n"
+ "starting point of q. So I'm going to pretend that you said 'p .. q' instead."
+ );
+ @.Paths don't touch@>
+ mp_get_x_next(mp);
+ d = mp_path_join_command;
+ set_number_to_unity(path_q->right_tension);
+ set_number_to_unity(y);
+ }
+ }
+ /* Plug an opening in |mp_right_type(pp)|, if possible */
+ if (mp_right_type(pp) == mp_open_knot && ((t == mp_curl_knot) || (t == mp_given_knot))) {
+ mp_right_type(pp) = (unsigned char) t;
+ number_clone(pp->right_given, x);
+ }
+ if (d == mp_ampersand_command) {
+ /* Splice independent paths together */
+ if (dd == mp_just_append_operation) {
+ mp_left_type(pp) = mp_explicit_knot;
+ mp_right_type(path_q) = mp_explicit_knot;
+ mp_prev_knot(pp) = path_q;
+ mp_next_knot(path_q) = pp;
+ number_clone(pp->left_x, path_q->x_coord);
+ number_clone(pp->left_y, path_q->y_coord);
+ number_clone(path_q->right_x, pp->x_coord);
+ number_clone(path_q->right_y, pp->y_coord);
+ mp_knotstate(pp) = mp_begin_knot;
+ mp_knotstate(path_q) = mp_end_knot;
+ path_q = pp;
+ } else {
+ if (mp_left_type(path_q) == mp_open_knot && mp_right_type(path_q) == mp_open_knot) {
+ mp_left_type(path_q) = mp_curl_knot;
+ set_number_to_unity(path_q->left_curl);
+ }
+ if (mp_right_type(pp) == mp_open_knot && t == mp_open_knot) {
+ mp_right_type(pp) = mp_curl_knot;
+ set_number_to_unity(pp->right_curl);
+ }
+ mp_right_type(path_q) = mp_right_type(pp);
+ mp_prev_knot(pp) = mp_next_knot(path_q);
+ mp_next_knot(path_q) = mp_next_knot(pp);
+ number_clone(path_q->right_x, pp->right_x);
+ number_clone(path_q->right_y, pp->right_y);
+ mp_memory_free(pp);
+ }
+ if (qq == pp) {
+ qq = path_q;
+ }
+ } else {
+ /* Plug an opening in |mp_right_type(q)|, if possible */
+ if (mp_right_type(path_q) == mp_open_knot && ((mp_left_type(path_q) == mp_curl_knot) || (mp_left_type(path_q) == mp_given_knot))) {
+ mp_right_type(path_q) = mp_left_type(path_q);
+ number_clone(path_q->right_given, path_q->left_given);
+ }
+ mp_prev_knot(pp) = path_q;
+ mp_next_knot(path_q) = pp;
+ number_clone(pp->left_y, y);
+ if (t != mp_open_knot) {
+ number_clone(pp->left_x, x);
+ mp_left_type(pp) = (unsigned char) t;
+ };
+ }
+ path_q = qq;
+ if (cur_cmd >= mp_min_expression_command && cur_cmd <= mp_ampersand_command && ! cycle_hit) {
+ goto CONTINUE_PATH;
+ }
+ FINISH_PATH:
+ /*
+ Choose control points for the path and put the result into |cur_exp|
+ */
+ if (cycle_hit) {
+ if (d == mp_ampersand_command) {
+ path_p = path_q;
+ }
+ } else {
+ mp_left_type(path_p) = mp_endpoint_knot;
+ if (mp_right_type(path_p) == mp_open_knot) {
+ mp_right_type(path_p) = mp_curl_knot;
+ set_number_to_unity(path_p->right_curl);
+ }
+ mp_right_type(path_q) = mp_endpoint_knot;
+ if (mp_left_type(path_q) == mp_open_knot) {
+ mp_left_type(path_q) = mp_curl_knot;
+ set_number_to_unity(path_q->left_curl);
+ }
+ mp_prev_knot(path_p) = path_q;
+ mp_next_knot(path_q) = path_p;
+ }
+ mp_make_choices(mp, path_p);
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, path_p);
+ free_number(x);
+ free_number(y);
+ return 1;
+}
+
+@ A pair of numeric values is changed into a knot node for a one-point path when
+\MP\ discovers that the pair is part of a path.
+
+@c
+static mp_knot mp_pair_to_knot (MP mp)
+{
+ /* convert a pair to a knot with two endpoints */
+ mp_knot q = mp_new_knot(mp);
+ mp_left_type(q) = mp_endpoint_knot;
+ mp_right_type(q) = mp_endpoint_knot;
+ mp_originator(q) = mp_metapost_user;
+ mp_knotstate(q) = mp_regular_knot;
+ mp_prev_knot(q) = q;
+ mp_next_knot(q) = q;
+ mp_known_pair(mp);
+ number_clone(q->x_coord, mp->cur_x);
+ number_clone(q->y_coord, mp->cur_y);
+ return q;
+}
+
+@ The |known_pair| subroutine sets |cur_x| and |cur_y| to the components of the
+current expression, assuming that the current expression is a pair of known
+numerics. Unknown components are zeroed, and the current expression is flushed.
+
+@<Declarations@>=
+static void mp_known_pair (MP mp);
+
+@ @c
+void mp_known_pair (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (mp->cur_exp.type != mp_pair_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Undefined coordinates have been replaced by (0,0)",
+ "I need x and y numbers for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ set_number_to_zero(mp->cur_x);
+ set_number_to_zero(mp->cur_y);
+ } else {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ /*
+ Make sure that both |x| and |y| parts of |p| are known; copy them into
+ |cur_x| and |cur_y|
+ */
+ if (mp_type(mp_x_part(p)) == mp_known_type) {
+ number_clone(mp->cur_x, mp_get_value_number(mp_x_part(p)));
+ } else {
+ mp_disp_err(mp, mp_x_part(p));
+ mp_back_error(
+ mp,
+ "Undefined x coordinate has been replaced by 0",
+ "I need a 'known' x value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_recycle_value(mp, mp_x_part(p));
+ set_number_to_zero(mp->cur_x);
+ }
+ if (mp_type(mp_y_part(p)) == mp_known_type) {
+ number_clone(mp->cur_y, mp_get_value_number(mp_y_part(p)));
+ } else {
+ mp_disp_err(mp, mp_y_part(p));
+ mp_back_error(
+ mp,
+ "Undefined y coordinate has been replaced by 0",
+ "I need a 'known' y value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_recycle_value(mp, mp_y_part(p));
+ set_number_to_zero(mp->cur_y);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+
+@ The |scan_direction| subroutine looks at the directional information that is
+enclosed in braces, and also scans ahead to the following character. A type code
+is returned, either |open| (if the direction was $(0,0)$), or |curl| (if the
+direction was a curl of known value |cur_exp|), or |given| (if the direction is
+given by the |angle| value that now appears in |cur_exp|).
+
+There's nothing difficult about this subroutine, but the program is rather
+lengthy because a variety of potential errors need to be nipped in the bud.
+
+@c
+static int mp_scan_direction (MP mp)
+{
+ int t; /* the type of information found */
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_curl_command) {
+ /* Scan a curl specification */
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if ((mp->cur_exp.type != mp_known_type) || (number_negative(cur_exp_value_number))) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_to_unity(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper curl has been replaced by 1",
+ "A curl must be a known, nonnegative number."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ t = mp_curl_knot;
+ } else {
+ /* Scan a given direction */
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type > mp_pair_type) {
+ /* Get given directions separated by commas */
+ mp_number xx;
+ new_number(xx);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Undefined x coordinate has been replaced by 0",
+ "I need a 'known' x value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ number_clone(xx, cur_exp_value_number);
+ if (cur_cmd != mp_comma_command) {
+ mp_back_error(
+ mp,
+ "Missing ',' has been inserted",
+ "I've got the x coordinate of a path direction; will look for the y coordinate\n"
+ "next."
+ );
+ }
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Undefined y coordinate has been replaced by 0",
+ "I need a 'known' y value for this part of the path. The value I found (see above)\n"
+ "was no good; so I'll try to keep going by using zero instead."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ number_clone(mp->cur_y, cur_exp_value_number);
+ number_clone(mp->cur_x, xx);
+ free_number(xx);
+ } else {
+ mp_known_pair(mp);
+ }
+ if (number_zero(mp->cur_x) && number_zero(mp->cur_y)) {
+ t = mp_open_knot;
+ } else {
+ mp_number narg;
+ new_angle(narg);
+ n_arg(narg, mp->cur_x, mp->cur_y);
+ t = mp_given_knot;
+ mp_set_cur_exp_value_number(mp, &narg);
+ free_number(narg);
+ }
+ }
+ if (cur_cmd != mp_right_brace_command) {
+ mp_back_error(
+ mp,
+ "Missing '}' has been inserted",
+ "I've scanned a direction spec for part of a path, so a right brace should have\n"
+ "come next. I shall pretend that one was there."
+ );
+ }
+ mp_get_x_next(mp);
+ return t;
+}
+
+@<Declare the basic parsing subroutines@>=
+static void do_boolean_error (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ set_number_from_boolean(new_expr.data.n, mp_false_operation);
+ mp_back_error(
+ mp,
+ "Undefined condition will be treated as 'false'",
+ "The expression shown above should have had a definite true-or-false value. I'm\n"
+ "changing it to 'false'."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_boolean_type;
+}
+
+@ @<Declarations@>=
+static void do_boolean_error (MP mp);
+
+@* Doing the operations.
+
+The purpose of parsing is primarily to permit people to avoid piles of
+parentheses. But the real work is done after the structure of an expression has
+been recognized; that's when new expressions are generated. We turn now to the
+guts of \MP, which handles individual operators that have come through the
+parsing mechanism.
+
+We'll start with the easy ones that take no operands, then work our way up to
+operators with one and ultimately two arguments. In other words, we will write
+the three procedures |do_nullary|, |do_unary|, and |do_binary| that are invoked
+periodically by the expression scanners.
+
+First let's make sure that all of the primitive operators are in the hash table.
+Although |scan_primary| and its relatives made use of the |cmd| code for these
+operators, the |do| routines base everything on the |mod| code. For example,
+|do_binary| doesn't care whether the operation it performs is a |primary_binary|
+or |secondary_binary|, etc.
+
+@<Put each...@>=
+mp_primitive(mp, "true", mp_nullary_command, mp_true_operation);
+@:true_}{|true| primitive@>
+mp_primitive(mp, "false", mp_nullary_command, mp_false_operation);
+@:false_}{|false| primitive@>
+mp_primitive(mp, "nullpicture", mp_nullary_command, mp_null_picture_operation);
+@:null_picture_}{|nullpicture| primitive@>
+mp_primitive(mp, "nullpen", mp_nullary_command, mp_null_pen_operation);
+@:null_pen_}{|nullpen| primitive@>
+mp_primitive(mp, "readstring", mp_nullary_command, mp_read_string_operation);
+@:read_string_}{|readstring| primitive@>
+mp_primitive(mp, "pencircle", mp_nullary_command, mp_pen_circle_operation);
+@:pen_circle_}{|pencircle| primitive@>
+mp_primitive(mp, "normaldeviate", mp_nullary_command, mp_normal_deviate_operation);
+@:normal_deviate_}{|normaldeviate| primitive@>
+mp_primitive(mp, "readfrom", mp_unary_command, mp_read_from_operation);
+@:read_from_}{|readfrom| primitive@>
+mp_primitive(mp, "closefrom", mp_unary_command, mp_close_from_operation);
+@:close_from_}{|closefrom| primitive@>
+mp_primitive(mp, "odd", mp_unary_command, mp_odd_operation);
+@:odd_}{|odd| primitive@>
+mp_primitive(mp, "known", mp_unary_command, mp_known_operation);
+@:known_}{|known| primitive@>
+mp_primitive(mp, "unknown", mp_unary_command, mp_unknown_operation);
+@:unknown_}{|unknown| primitive@>
+mp_primitive(mp, "not", mp_unary_command, mp_not_operation);
+@:not_}{|not| primitive@>
+mp_primitive(mp, "decimal", mp_unary_command, mp_decimal_operation);
+@:decimal_}{|decimal| primitive@>
+mp_primitive(mp, "reverse", mp_unary_command, mp_reverse_operation);
+@:reverse_}{|reverse| primitive@>
+mp_primitive(mp, "uncycle", mp_unary_command, mp_uncycle_operation);
+@:uncycle_}{|uncycle| primitive@>
+mp_primitive(mp, "makepath", mp_unary_command, mp_make_path_operation);
+@:make_path_}{|makepath| primitive@>
+mp_primitive(mp, "makepen", mp_unary_command, mp_make_pen_operation);
+@:make_pen_}{|makepen| primitive@>
+mp_primitive(mp, "makenep", mp_unary_command, mp_make_nep_operation);
+@:make_nep_}{|makenep| primitive@>
+mp_primitive(mp, "convexed", mp_unary_command, mp_convexed_operation);
+@:convexed_}{|convexed| primitive@>
+mp_primitive(mp, "uncontrolled", mp_unary_command, mp_uncontrolled_operation);
+@:convexed_}{|uncontrolled| primitive@>
+mp_primitive(mp, "oct", mp_unary_command, mp_oct_operation);
+@:oct_}{|oct| primitive@>
+mp_primitive(mp, "hex", mp_unary_command, mp_hex_operation);
+@:hex_}{|hex| primitive@>
+mp_primitive(mp, "ASCII", mp_unary_command, mp_ASCII_operation);
+@:ASCII_}{|ASCII| primitive@>
+mp_primitive(mp, "char", mp_unary_command, mp_char_operation);
+@:char_}{|char| primitive@>
+mp_primitive(mp, "length", mp_unary_command, mp_length_operation);
+@:length_}{|length| primitive@>
+mp_primitive(mp, "turningnumber", mp_unary_command, mp_turning_operation);
+@:turning_number_}{|turningnumber| primitive@>
+mp_primitive(mp, "xpart", mp_unary_command, mp_x_part_operation);
+@:x_part_}{|xpart| primitive@>
+mp_primitive(mp, "ypart", mp_unary_command, mp_y_part_operation);
+@:y_part_}{|ypart| primitive@>
+mp_primitive(mp, "xxpart", mp_unary_command, mp_xx_part_operation);
+@:xx_part_}{|xxpart| primitive@>
+mp_primitive(mp, "xypart", mp_unary_command, mp_xy_part_operation);
+@:xy_part_}{|xypart| primitive@>
+mp_primitive(mp, "yxpart", mp_unary_command, mp_yx_part_operation);
+@:yx_part_}{|yxpart| primitive@>
+mp_primitive(mp, "yypart", mp_unary_command, mp_yy_part_operation);
+@:yy_part_}{|yypart| primitive@>
+mp_primitive(mp, "redpart", mp_unary_command, mp_red_part_operation);
+@:red_part_}{|redpart| primitive@>
+mp_primitive(mp, "greenpart", mp_unary_command, mp_green_part_operation);
+@:green_part_}{|greenpart| primitive@>
+mp_primitive(mp, "bluepart", mp_unary_command, mp_blue_part_operation);
+@:blue_part_}{|bluepart| primitive@>
+mp_primitive(mp, "cyanpart", mp_unary_command, mp_cyan_part_operation);
+@:cyan_part_}{|cyanpart| primitive@>
+mp_primitive(mp, "magentapart", mp_unary_command, mp_magenta_part_operation);
+@:magenta_part_}{|magentapart| primitive@>
+mp_primitive(mp, "yellowpart", mp_unary_command, mp_yellow_part_operation);
+@:yellow_part_}{|yellowpart| primitive@>
+mp_primitive(mp, "blackpart", mp_unary_command, mp_black_part_operation);
+@:black_part_}{|blackpart| primitive@>
+mp_primitive(mp, "greypart", mp_unary_command, mp_grey_part_operation);
+@:grey_part_}{|greypart| primitive@>
+mp_primitive(mp, "colormodel", mp_unary_command, mp_color_model_operation);
+@:color_model_part_}{|colormodel| primitive@>
+mp_primitive(mp, "prescriptpart", mp_unary_command, mp_prescript_part_operation);
+@:prescript_part_}{|prescriptpart| primitive@>
+mp_primitive(mp, "postscriptpart", mp_unary_command, mp_postscript_part_operation);
+@:postscript_part_}{|postscriptpart| primitive@>
+mp_primitive(mp, "stackingpart", mp_unary_command, mp_stacking_part_operation);
+@:stacking_part_}{|stackingpart| primitive@>
+mp_primitive(mp, "pathpart", mp_unary_command, mp_path_part_operation);
+@:path_part_}{|pathpart| primitive@>
+mp_primitive(mp, "penpart", mp_unary_command, mp_pen_part_operation);
+@:pen_part_}{|penpart| primitive@>
+mp_primitive(mp, "dashpart", mp_unary_command, mp_dash_part_operation);
+@:dash_part_}{|dashpart| primitive@>
+mp_primitive(mp, "sqrt", mp_unary_command, mp_sqrt_operation);
+@:sqrt_}{|sqrt| primitive@>
+mp_primitive(mp, "mexp", mp_unary_command, mp_m_exp_operation);
+@:m_exp_}{|mexp| primitive@>
+mp_primitive(mp, "mlog", mp_unary_command, mp_m_log_operation);
+@:m_log_}{|mlog| primitive@>
+mp_primitive(mp, "sind", mp_unary_command, mp_sin_d_operation);
+@:sin_d_}{|sind| primitive@>
+mp_primitive(mp, "cosd", mp_unary_command, mp_cos_d_operation);
+@:cos_d_}{|cosd| primitive@>
+mp_primitive(mp, "floor", mp_unary_command, mp_floor_operation);
+@:floor_}{|floor| primitive@>
+mp_primitive(mp, "uniformdeviate", mp_unary_command, mp_uniform_deviate_operation);
+@:uniform_deviate_}{|uniformdeviate| primitive@>
+mp_primitive(mp, "llcorner", mp_unary_command, mp_ll_corner_operation);
+@:ll_corner_}{|llcorner| primitive@>
+mp_primitive(mp, "lrcorner", mp_unary_command, mp_lr_corner_operation);
+@:lr_corner_}{|lrcorner| primitive@>
+mp_primitive(mp, "ulcorner", mp_unary_command, mp_ul_corner_operation);
+@:ul_corner_}{|ulcorner| primitive@>
+mp_primitive(mp, "urcorner", mp_unary_command, mp_ur_corner_operation);
+@:ur_corner_}{|urcorner| primitive@>
+mp_primitive(mp, "centerof", mp_unary_command, mp_center_of_operation);
+@:center_}{|center| primitive@>
+mp_primitive(mp, "centerofmass", mp_unary_command, mp_center_of_mass_operation);
+@:center_}{|centerofmass| primitive@>
+mp_primitive(mp, "corners", mp_unary_command, mp_corners_operation);
+@:corners_}{|corners| primitive@>
+mp_primitive(mp, "xrange", mp_unary_command, mp_x_range_operation);
+@:xrange_}{|xrange| primitive@>
+mp_primitive(mp, "yrange", mp_unary_command, mp_y_range_operation);
+@:yrange_}{|xrange| primitive@>
+mp_primitive(mp, "deltapoint", mp_unary_command, mp_delta_point_operation);
+@:deltapoint_}{|deltapoint| primitive@>
+mp_primitive(mp, "deltaprecontrol", mp_unary_command, mp_delta_precontrol_operation);
+@:deltaprecontrol_}{|deltaprecontrol| primitive@>
+mp_primitive(mp, "deltapostcontrol", mp_unary_command, mp_delta_postcontrol_operation);
+@:deltapostcontrol_}{|deltapostcontrol| primitive@>
+mp_primitive(mp, "deltadirection", mp_unary_command, mp_delta_direction_operation);
+@:deltadirection_}{|deltadirection| primitive@>
+mp_primitive(mp, "arclength", mp_unary_command, mp_arc_length_operation);
+@:arc_length_}{|arclength| primitive@>
+mp_primitive(mp, "angle", mp_unary_command, mp_angle_operation);
+@:angle_}{|angle| primitive@>
+mp_primitive(mp, "cycle", mp_cycle_command, mp_cycle_operation);
+@:cycle_}{|cycle| primitive@>
+mp_primitive(mp, "nocycle", mp_cycle_command, mp_no_cycle_operation);
+@:nocycle_}{|nocycle| primitive@>
+mp_primitive(mp, "stroked", mp_unary_command, mp_stroked_operation);
+@:stroked_}{|stroked| primitive@>
+mp_primitive(mp, "filled", mp_unary_command, mp_filled_operation);
+@:filled_}{|filled| primitive@>
+mp_primitive(mp, "clipped", mp_unary_command, mp_clipped_operation);
+@:clipped_}{|clipped| primitive@>
+mp_primitive(mp, "grouped", mp_unary_command, mp_grouped_operation);
+@:clipped_}{|grouped| primitive@>
+mp_primitive(mp, "bounded", mp_unary_command, mp_bounded_operation);
+@:bounded_}{|bounded| primitive@>
+mp_primitive(mp, "+", mp_plus_or_minus_command, mp_plus_operation);
+@:+ }{|+| primitive@>
+mp_primitive(mp, "-", mp_plus_or_minus_command, mp_minus_operation);
+@:- }{|-| primitive@>
+mp_primitive(mp, "*", mp_secondary_binary_command, mp_times_operation);
+@:* }{|*| primitive@>
+mp_primitive(mp, "/", mp_slash_command, mp_over_operation);
+mp->frozen_slash = mp_frozen_primitive (mp, "/", mp_slash_command, mp_over_operation);
+@:/ }{|/| primitive@>
+mp_primitive(mp, "^", mp_secondary_binary_command, mp_power_operation);
+@:^ }{|^| primitive@>
+mp_primitive(mp, "++", mp_tertiary_binary_command, mp_pythag_add_operation);
+@:++_}{|++| primitive@>
+mp_primitive(mp, "+-+", mp_tertiary_binary_command, mp_pythag_sub_operation);
+@:+-+_}{|+-+| primitive@>
+mp_primitive(mp, "or", mp_tertiary_binary_command, mp_or_operation);
+@:or_}{|or| primitive@>
+mp_primitive(mp, "and", mp_and_command, mp_and_operation);
+@:and_}{|and| primitive@>
+mp_primitive(mp, "<", mp_primary_binary_command, mp_less_than_operation);
+@:< }{|<| primitive@>
+mp_primitive(mp, "<=", mp_primary_binary_command, mp_less_or_equal_operation);
+@:<=_}{|<=| primitive@>
+mp_primitive(mp, ">", mp_primary_binary_command, mp_greater_than_operation);
+@:> }{|>| primitive@>
+mp_primitive(mp, ">=", mp_primary_binary_command, mp_greater_or_equal_operation);
+@:>=_}{|>=| primitive@>
+mp_primitive(mp, "=", mp_equals_command, mp_equal_operation);
+@:= }{|=| primitive@>
+mp_primitive(mp, "<>", mp_primary_binary_command, mp_unequal_operation);
+@:<>_}{|<>| primitive@>
+mp_primitive(mp, "substring", mp_of_binary_command, mp_substring_operation);
+@:substring_}{|substring| primitive@>
+mp_primitive(mp, "subpath", mp_of_binary_command, mp_subpath_operation);
+@:subpath_}{|subpath| primitive@>
+mp_primitive(mp, "directiontime", mp_of_binary_command, mp_direction_time_operation);
+@:direction_time_}{|directiontime| primitive@>
+mp_primitive(mp, "point", mp_of_binary_command, mp_point_operation);
+@:point_}{|point| primitive@>
+mp_primitive(mp, "precontrol", mp_of_binary_command, mp_precontrol_operation);
+@:precontrol_}{|precontrol| primitive@>
+mp_primitive(mp, "postcontrol", mp_of_binary_command, mp_postcontrol_operation);
+@:direction_}{|direction| primitive@>
+mp_primitive(mp, "direction", mp_of_binary_command, mp_direction_operation);
+@:postcontrol_}{|postcontrol| primitive@>
+mp_primitive(mp, "pathpoint", mp_nullary_command, mp_path_point_operation);
+@:pathpoint_}{|pathpoint| primitive@>
+mp_primitive(mp, "pathprecontrol", mp_nullary_command, mp_path_precontrol_operation);
+@:pathprecontrol_}{|pathprecontrol| primitive@>
+mp_primitive(mp, "pathpostcontrol", mp_nullary_command, mp_path_postcontrol_operation);
+@:pathpostcontrol_}{|pathpostcontrol| primitive@>
+mp_primitive(mp, "pathdirection", mp_nullary_command, mp_path_direction_operation);
+@:pathdirection_}{|pathdirection| primitive@>
+mp_primitive(mp, "penoffset", mp_of_binary_command, mp_pen_offset_operation);
+@:pen_offset_}{|penoffset| primitive@>
+mp_primitive(mp, "arctime", mp_of_binary_command, mp_arc_time_operation);
+@:arc_time_of_}{|arctime| primitive@>
+mp_primitive(mp, "arcpoint", mp_of_binary_command, mp_arc_point_operation);
+@:arc_point_of_}{|arcpoint| primitive@>
+mp_primitive(mp, "arcpointlist", mp_of_binary_command, mp_arc_point_list_operation);
+@:arc_point_list_of_}{|arcpointlist| primitive@>
+mp_primitive(mp, "subarclength", mp_of_binary_command, mp_subarc_length_operation);
+@:subarc_length_of_}{|subarclength| primitive@>
+mp_primitive(mp, "mpversion", mp_nullary_command, mp_version_operation);
+@:mp_version_}{|mpversion| primitive@>
+mp_primitive(mp, "&", mp_ampersand_command, mp_concatenate_operation);
+@:!!!}{|\&| primitive@>
+mp_primitive(mp, "&&", mp_ampersand_command, mp_just_append_operation);
+@:!!!!!!}{|\&\&| primitive@>
+mp_primitive(mp, "rotated", mp_secondary_binary_command, mp_rotated_operation);
+@:rotated_}{|rotated| primitive@>
+mp_primitive(mp, "slanted", mp_secondary_binary_command, mp_slanted_operation);
+@:slanted_}{|slanted| primitive@>
+mp_primitive(mp, "scaled", mp_secondary_binary_command, mp_scaled_operation);
+@:scaled_}{|scaled| primitive@>
+mp_primitive(mp, "shifted", mp_secondary_binary_command, mp_shifted_operation);
+@:shifted_}{|shifted| primitive@>
+mp_primitive(mp, "transformed", mp_secondary_binary_command, mp_transformed_operation);
+@:transformed_}{|transformed| primitive@>
+mp_primitive(mp, "xscaled", mp_secondary_binary_command, mp_x_scaled_operation);
+@:x_scaled_}{|xscaled| primitive@>
+mp_primitive(mp, "yscaled", mp_secondary_binary_command, mp_y_scaled_operation);
+@:y_scaled_}{|yscaled| primitive@>
+mp_primitive(mp, "zscaled", mp_secondary_binary_command, mp_z_scaled_operation);
+@:z_scaled_}{|zscaled| primitive@>
+mp_primitive(mp, "intersectiontimes", mp_tertiary_binary_command, mp_intertimes_operation);
+@:intersection_times_}{|intersectiontimes| primitive@>
+mp_primitive(mp, "intersectiontimeslist", mp_tertiary_binary_command, mp_intertimes_list_operation);
+@:intersection_times_list_}{|intersectiontimeslist| primitive@>
+mp_primitive(mp, "envelope", mp_of_binary_command, mp_envelope_operation);
+@:envelope_}{|envelope| primitive@>
+mp_primitive(mp, "boundingpath", mp_of_binary_command, mp_boundingpath_operation);
+@:boundingpath_}{|boundingpath| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_nullary_command:
+case mp_unary_command:
+case mp_of_binary_command:
+case mp_secondary_binary_command:
+case mp_tertiary_binary_command:
+case mp_primary_binary_command:
+case mp_cycle_command:
+case mp_plus_or_minus_command:
+case mp_slash_command:
+case mp_ampersand_command:
+case mp_equals_command:
+case mp_and_command:
+ return mp_op_string((int) m);
+
+@ @<Declarations@>=
+static void push_of_path_result (MP mp, int what, mp_knot p);
+
+@ @c
+static void push_of_path_result (MP mp, int what, mp_knot p)
+{
+ switch (what) {
+ case 0:
+ mp_pair_value(mp, &(p->x_coord), &(p->y_coord));
+ break;
+ case 1:
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ mp_pair_value(mp, &(p->x_coord), &(p->y_coord));
+ } else {
+ mp_pair_value(mp, &(p->left_x), &(p->left_y));
+ }
+ break;
+ case 2:
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ mp_pair_value(mp, &(p->x_coord), &(p->y_coord));
+ } else {
+ mp_pair_value(mp, &(p->right_x), &(p->right_y));
+ }
+ break;
+ case 3:
+ {
+ mp_number x, y;
+ if (mp_right_type(p) == mp_endpoint_knot) {
+ new_number_clone(x, p->x_coord);
+ new_number_clone(y, p->y_coord);
+ } else {
+ new_number_clone(x, p->right_x);
+ new_number_clone(y, p->right_y);
+ }
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ number_subtract(x, p->x_coord);
+ number_subtract(y, p->y_coord);
+ } else {
+ number_subtract(x, p->left_x);
+ number_subtract(y, p->left_y);
+ }
+ mp_pair_value(mp, &x, &y);
+ free_number(x);
+ free_number(y);
+ }
+ break;
+ }
+}
+
+@ OK, let's look at the simplest |do| procedure first.
+
+@c
+@<Declare nullary action procedure@>
+static void mp_do_nullary (MP mp, int c)
+{
+ check_arith();
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ mp_show_cmd_mod(mp, mp_nullary_command, c);
+ }
+ switch (c) {
+ case mp_true_operation:
+ case mp_false_operation:
+ mp->cur_exp.type = mp_boolean_type;
+ mp_set_cur_exp_value_boolean(mp, c);
+ break;
+ case mp_null_picture_operation:
+ mp->cur_exp.type = mp_picture_type;
+ mp_set_cur_exp_node(mp, (mp_node) mp_get_edge_header_node(mp));
+ mp_init_edges(mp, (mp_edge_header_node) cur_exp_node);
+ break;
+ case mp_null_pen_operation:
+ mp->cur_exp.type = mp_pen_type;
+ mp_set_cur_exp_knot(mp, mp_get_pen_circle(mp, &zero_t));
+ break;
+ case mp_normal_deviate_operation:
+ {
+ mp_number r;
+ new_number(r);
+ /*|mp_norm_rand (mp, &r)|;*/
+ m_norm_rand(r);
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &r);
+ free_number(r);
+ }
+ break;
+ case mp_pen_circle_operation:
+ mp->cur_exp.type = mp_pen_type;
+ mp_set_cur_exp_knot(mp, mp_get_pen_circle(mp, &unity_t));
+ break;
+ case mp_version_operation:
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, mp_intern(mp, metapost_version));
+ break;
+ /* these are new */
+ case mp_path_point_operation:
+ case mp_path_precontrol_operation:
+ case mp_path_postcontrol_operation:
+ case mp_path_direction_operation:
+ if (mp->loop_ptr && mp->loop_ptr->point != NULL) {
+ push_of_path_result(mp, c - mp_path_point_operation, mp->loop_ptr->point);
+ } else {
+ mp_pair_value(mp, &zero_t, &zero_t);
+ }
+ break;
+ }
+ check_arith();
+}
+
+@ @<Declare nullary action procedure@>=
+static void mp_finish_read (MP mp)
+{
+ /* copy |buffer| line to |cur_exp| */
+ mp_str_room(mp, (int) mp->last - (int) start);
+ for (size_t k = (size_t) start; k < mp->last; k++) {
+ mp_append_char(mp, mp->buffer[k]);
+ }
+ mp_end_file_reading(mp);
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, mp_make_string(mp));
+ }
+
+@ Things get a bit more interesting when there's an operand. The operand to
+|do_unary| appears in |cur_type| and |cur_exp|.
+
+This complicated if test makes sure that any |bounds| or |clip| picture objects
+that get passed into |within| do not raise an error when queried using the
+color part primitives (this is needed for backward compatibility) .
+
+@c
+static int mp_pict_color_type (MP mp, int c)
+{
+ /* cur_pic_item = mp_link(mp_edge_list(cur_exp_node)) */
+ return (
+ (mp_link(mp_edge_list(cur_exp_node)) != NULL)
+ &&
+ (
+ (! mp_has_color(mp_link(mp_edge_list(cur_exp_node))))
+ ||
+ ((
+ (mp_color_model(mp_link(mp_edge_list(cur_exp_node))) == c)
+ ||
+ (
+ (mp_color_model(mp_link(mp_edge_list(cur_exp_node))) == mp_uninitialized_model)
+ &&
+ (number_to_scaled(internal_value(mp_default_color_model_internal))/number_to_scaled(unity_t)) == c
+ )
+ ))
+ )
+ );
+}
+
+@<Declarations@>=
+static mp_knot mp_simple_knot(MP mp, mp_number *x, mp_number *y);
+static mp_knot mp_complex_knot(MP mp, mp_knot o);
+
+@ @c
+static mp_knot mp_simple_knot(MP mp, mp_number *x, mp_number *y)
+{
+ mp_knot k = mp_new_knot(mp);
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ mp_originator(k) = mp_program_code;
+ mp_knotstate(k) = mp_regular_knot;
+ number_clone(k->x_coord, *x);
+ number_clone(k->y_coord, *y);
+ number_clone(k->left_x, *x);
+ number_clone(k->left_y, *y);
+ number_clone(k->right_x, *x);
+ number_clone(k->right_y, *y);
+ return k;
+}
+
+static mp_knot mp_complex_knot(MP mp, mp_knot o)
+{
+ mp_knot k = mp_new_knot(mp);
+ mp_left_type(k) = mp_explicit_knot;
+ mp_right_type(k) = mp_explicit_knot;
+ mp_originator(k) = mp_program_code;
+ mp_knotstate(k) = mp_regular_knot;
+ number_clone(k->x_coord, o->x_coord);
+ number_clone(k->y_coord, o->y_coord);
+ number_clone(k->left_x, o->left_x);
+ number_clone(k->left_y, o->left_y);
+ number_clone(k->right_x, o->right_x);
+ number_clone(k->right_y, o->right_y);
+ return k;
+}
+
+@<Declarations@>=
+static int mp_pict_color_type (MP mp, int c);
+
+@c
+@<Declare unary action procedures@>
+
+static void mp_do_unary (MP mp, int c)
+{
+ check_arith();
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ /* Trace the current unary operation */
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{");
+ mp_print_op(mp, c);
+ mp_print_chr(mp, '(');
+ mp_print_exp(mp, NULL, 0); /* show the operand, but not verbosely */
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+ }
+ /*
+ This is a mix of combined and not combined. We could combine more or less
+ and let the compiler deal with it.
+ */
+ switch (c) {
+ case mp_plus_operation:
+ if (mp->cur_exp.type < mp_color_type) {
+ mp_bad_unary(mp, mp_plus_operation);
+ }
+ break;
+ case mp_minus_operation:
+ negate_cur_expr(mp);
+ break;
+ case mp_not_operation:
+ if (mp->cur_exp.type != mp_boolean_type) {
+ mp_bad_unary(mp, mp_not_operation);
+ } else {
+ mp_set_cur_exp_value_boolean(mp, (cur_exp_value_boolean == mp_true_operation) ? mp_false_operation : mp_true_operation);
+ }
+ break;
+ /* We could use something function[mp_sqrt_operation] here: */
+ case mp_sqrt_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ square_rt(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_m_exp_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ m_exp(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_m_log_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ m_log(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_sin_d_operation:
+ case mp_cos_d_operation:
+ /*
+ This is rather inefficient, esp decimal, to calculate both each time. We could
+ pass NULL as signal to do only one.
+ */
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n_sin, n_cos, arg1, arg2;
+ new_number(arg1);
+ new_number(arg2);
+ new_fraction(n_sin);
+ new_fraction(n_cos);
+ number_clone(arg1, cur_exp_value_number);
+ number_clone(arg2, unity_t);
+ number_multiply_int(arg2, 360);
+ number_modulo(arg1, arg2);
+ convert_scaled_to_angle(arg1);
+ n_sin_cos(arg1, n_cos, n_sin);
+ if (c == mp_sin_d_operation) {
+ fraction_to_round_scaled(n_sin);
+ mp_set_cur_exp_value_number(mp, &n_sin);
+ } else {
+ fraction_to_round_scaled(n_cos);
+ mp_set_cur_exp_value_number(mp, &n_cos);
+ }
+ free_number(arg1);
+ free_number(arg2);
+ free_number(n_sin);
+ free_number(n_cos);
+ }
+ break;
+ case mp_floor_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ number_clone(n, cur_exp_value_number);
+ floor_scaled(n);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_uniform_deviate_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_number n;
+ new_number(n);
+ m_unif_rand(n, cur_exp_value_number);
+ mp_set_cur_exp_value_number(mp, &n);
+ free_number(n);
+ }
+ break;
+ case mp_odd_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_set_cur_exp_value_boolean(mp, number_odd(cur_exp_value_number) ? mp_true_operation : mp_false_operation);
+ mp->cur_exp.type = mp_boolean_type;
+ }
+ break;
+ case mp_angle_operation:
+ if (mp_nice_pair (mp, cur_exp_node, mp->cur_exp.type)) {
+ mp_value expr;
+ mp_node p; /* for list manipulation */
+ mp_number narg;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ new_angle(narg);
+ p = mp_get_value_node(cur_exp_node);
+ n_arg(narg, mp_get_value_number(mp_x_part(p)), mp_get_value_number(mp_y_part(p)));
+ number_clone(expr.data.n, narg);
+ convert_angle_to_scaled(expr.data.n);
+ free_number(narg);
+ mp_flush_cur_exp(mp, expr);
+ } else {
+ mp_bad_unary(mp, mp_angle_operation);
+ }
+ break;
+ case mp_x_part_operation:
+ case mp_y_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ case mp_transform_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ mp_take_pict_part(mp, c);
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_xx_part_operation:
+ case mp_xy_part_operation:
+ case mp_yx_part_operation:
+ case mp_yy_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_transform_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ mp_take_pict_part(mp, c);
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_red_part_operation:
+ case mp_green_part_operation:
+ case mp_blue_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_color_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ if (mp_pict_color_type(mp, mp_rgb_model)) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_color_part(mp, c);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_cyan_part_operation:
+ case mp_magenta_part_operation:
+ case mp_yellow_part_operation:
+ case mp_black_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_cmykcolor_type:
+ mp_take_part(mp, c);
+ break;
+ case mp_picture_type:
+ if (mp_pict_color_type(mp, mp_cmyk_model)) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_color_part(mp, c);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_grey_part_operation:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ break;
+ case mp_picture_type:
+ if (mp_pict_color_type(mp, mp_grey_model)) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_color_part(mp, c);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, c);
+ break;
+ }
+ break;
+ case mp_color_model_operation:
+ case mp_path_part_operation:
+ case mp_pen_part_operation:
+ case mp_dash_part_operation:
+ case mp_prescript_part_operation:
+ case mp_postscript_part_operation:
+ case mp_stacking_part_operation:
+ if (mp->cur_exp.type == mp_picture_type) {
+ mp_take_pict_part(mp, c);
+ } else {
+ mp_bad_unary(mp, c);
+ }
+ break;
+ case mp_char_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, mp_char_operation);
+ } else {
+ int n = round_unscaled(cur_exp_value_number) % 256;
+ unsigned char s[2];
+ mp_set_cur_exp_value_scaled(mp, n);
+ mp->cur_exp.type = mp_string_type;
+ if (number_negative(cur_exp_value_number)) {
+ n = number_to_scaled(cur_exp_value_number) + 256;
+ mp_set_cur_exp_value_scaled(mp, n);
+ }
+ s[0] = (unsigned char) number_to_scaled(cur_exp_value_number);
+ s[1] = '\0';
+ mp_set_cur_exp_str(mp, mp_rtsl (mp, (char *) s, 1));
+ }
+ break;
+ case mp_decimal_operation:
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_bad_unary(mp, mp_decimal_operation);
+ } else {
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ print_number(cur_exp_value_number);
+ mp_set_cur_exp_str(mp, mp_make_string(mp));
+ mp->selector = selector;
+ mp->cur_exp.type = mp_string_type;
+ }
+ break;
+ case mp_oct_operation:
+ case mp_hex_operation:
+ case mp_ASCII_operation:
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_str_to_num(mp);
+ }
+ break;
+ case mp_length_operation:
+ /*
+ The length operation is somewhat unusual in that it applies to a variety of
+ different types of operands. *
+ */
+ switch (mp->cur_exp.type) {
+ case mp_string_type:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ number_clone(expr.data.n, unity_t);
+ number_multiply_int(expr.data.n, (int) cur_exp_str->len);
+ mp_flush_cur_exp(mp, expr);
+ break;
+ }
+ case mp_path_type:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_path_length(mp, &expr.data.n);
+ mp_flush_cur_exp(mp, expr);
+ break;
+ }
+ case mp_known_type:
+ {
+ mp_set_cur_exp_value_number(mp, &cur_exp_value_number);
+ number_abs(cur_exp_value_number);
+ break;
+ }
+ case mp_picture_type:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_picture_length(mp, &expr.data.n);
+ mp_flush_cur_exp(mp, expr);
+ break;
+ }
+ default:
+ if (mp_nice_pair (mp, cur_exp_node, mp->cur_exp.type)) {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ pyth_add(expr.data.n,
+ mp_get_value_number(mp_x_part(mp_get_value_node(cur_exp_node))),
+ mp_get_value_number(mp_y_part(mp_get_value_node(cur_exp_node)))
+ );
+ mp_flush_cur_exp(mp, expr);
+ } else {
+ mp_bad_unary(mp, c);
+ }
+ break;
+ }
+ break;
+ case mp_turning_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_flush_cur_exp(mp, expr);
+ } else if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_turning_operation);
+ } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ expr.data.p = NULL;
+ mp_flush_cur_exp(mp, expr); /* not a cyclic path */
+ } else {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_turn_cycles_wrapper(mp, &expr.data.n, cur_exp_knot);
+ mp_flush_cur_exp(mp, expr);
+ }
+ break;
+ /* Here we could do some delta(operation,type) trickery as with filled. */
+
+ case mp_boolean_type_operation:
+ case mp_string_type_operation:
+ case mp_pen_type_operation:
+ case mp_nep_type_operation:
+ case mp_path_type_operation:
+ case mp_picture_type_operation:
+ {
+ mp_value expr;
+ /*they are parallel but with 2 increments (known and unknown): */
+ int type = (c - mp_boolean_type_operation) * 2 + mp_boolean_type ;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, (mp->cur_exp.type == type || mp->cur_exp.type == (type + 1)) ? mp_true_operation : mp_false_operation);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_transform_type_operation:
+ case mp_color_type_operation:
+ case mp_cmykcolor_type_operation:
+ case mp_pair_type_operation:
+ {
+ mp_value expr;
+ /* they are parallel: */
+ int type = (c - mp_transform_type_operation) + mp_transform_type;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, mp->cur_exp.type == type ? mp_true_operation : mp_false_operation);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_numeric_type_operation:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, (mp->cur_exp.type >= mp_known_type && mp->cur_exp.type <= mp_independent_type) ? mp_true_operation : mp_false_operation);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_known_operation:
+ case mp_unknown_operation:
+ {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ set_number_from_boolean(expr.data.n, mp_test_known(mp, c));
+ mp_flush_cur_exp(mp, expr);
+ /* !! do not replace with |mp_set_cur_exp_node(mp, )| !! */
+ cur_exp_node = NULL;
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_cycle_operation:
+ case mp_no_cycle_operation:
+ {
+ mp_value expr;
+ int b = 0;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ if (mp->cur_exp.type != mp_path_type) {
+ b = (c == mp_cycle_operation) ? mp_false_operation : mp_true_operation;
+ } else if (mp_left_type(cur_exp_knot) != mp_endpoint_knot) {
+ b = (c == mp_cycle_operation) ? mp_true_operation : mp_false_operation;
+ } else {
+ b = (c == mp_cycle_operation) ? mp_false_operation : mp_true_operation;
+ }
+ set_number_from_boolean(expr.data.n, b);
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_arc_length_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_arc_length_operation);
+ } else {
+ mp_value expr;
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ mp_get_arc_length(mp, &expr.data.n, cur_exp_knot);
+ mp_flush_cur_exp(mp, expr);
+ }
+ break;
+ case mp_filled_operation:
+ case mp_stroked_operation:
+ case mp_clipped_operation:
+ case mp_grouped_operation:
+ case mp_bounded_operation:
+ {
+ mp_value expr;
+ @^data structure assumptions@>
+ memset(&expr, 0, sizeof(mp_value));
+ new_number(expr.data.n);
+ if (mp->cur_exp.type != mp_picture_type) {
+ set_number_from_boolean(expr.data.n, mp_false_operation);
+ } else if (mp_link(mp_edge_list(cur_exp_node)) == NULL) {
+ set_number_from_boolean(expr.data.n, mp_false_operation);
+ } else {
+ /* they are parallel: */
+ int type = c - mp_filled_operation + mp_fill_node_type;
+ set_number_from_boolean(expr.data.n, mp_type(mp_link(mp_edge_list(cur_exp_node))) == type ? mp_true_operation: mp_false_operation);
+ }
+ mp_flush_cur_exp(mp, expr);
+ mp->cur_exp.type = mp_boolean_type;
+ break;
+ }
+ case mp_make_pen_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_make_pen_operation);
+ } else {
+ mp->cur_exp.type = mp_pen_type;
+ mp_set_cur_exp_knot(mp, mp_make_pen(mp, cur_exp_knot, 1));
+ }
+ break;
+ case mp_make_nep_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp->cur_exp.type = mp_nep_type;
+ mp_set_cur_exp_knot(mp, cur_exp_knot);
+ }
+ break;
+ case mp_convexed_operation:
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_convexed_operation);
+ } else {
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, mp_convex_hull(mp, cur_exp_knot));
+ mp_simplify_path(mp, cur_exp_knot);
+ }
+ break;
+ case mp_uncontrolled_operation:
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_bad_unary(mp, mp_uncontrolled_operation);
+ } else {
+ mp->cur_exp.type = mp_path_type;
+ mp_simplify_path(mp, cur_exp_knot);
+ }
+ break;
+ case mp_make_path_operation:
+ if (mp->cur_exp.type != mp_pen_type && mp->cur_exp.type != mp_nep_type) {
+ mp_bad_unary(mp, mp_make_path_operation);
+ } else {
+ mp->cur_exp.type = mp_path_type;
+ mp_make_path(mp, cur_exp_knot);
+ }
+ break;
+ case mp_reverse_operation:
+ switch (mp->cur_exp.type) {
+ case mp_path_type:
+ {
+ mp_knot pk = mp_htap_ypoc(mp, cur_exp_knot);
+ if (mp_right_type(pk) == mp_endpoint_knot) {
+ pk = mp_next_knot(pk);
+ }
+ mp_toss_knot_list(mp, cur_exp_knot);
+ mp_set_cur_exp_knot(mp, pk);
+ }
+ break;
+ case mp_pair_type:
+ mp_pair_to_path(mp);
+ break;
+ default:
+ mp_bad_unary(mp, mp_reverse_operation);
+ break;
+ }
+ break;
+ case mp_uncycle_operation:
+ switch (mp->cur_exp.type) {
+ case mp_path_type:
+ mp_right_type(mp_prev_knot(cur_exp_knot)) = mp_endpoint_knot;
+ mp_left_type(cur_exp_knot) = mp_endpoint_knot;
+ break;
+ case mp_pair_type:
+ mp_pair_to_path(mp);
+ break;
+ default:
+ mp_bad_unary(mp, mp_uncycle_operation);
+ break;
+ }
+ break;
+ case mp_ll_corner_operation:
+ if (mp_get_cur_bbox(mp)) {
+ mp_pair_value(mp, &mp_minx, &mp_miny);
+ } else {
+ mp_bad_unary(mp, mp_ll_corner_operation);
+ }
+ break;
+ case mp_lr_corner_operation:
+ if (mp_get_cur_bbox(mp)) {
+ mp_pair_value(mp, &mp_maxx, &mp_miny);
+ } else {
+ mp_bad_unary(mp, mp_lr_corner_operation);
+ }
+ break;
+ case mp_ul_corner_operation:
+ if (mp_get_cur_bbox(mp)) {
+ mp_pair_value(mp, &mp_minx, &mp_maxy);
+ } else {
+ mp_bad_unary(mp, mp_ul_corner_operation);
+ }
+ break;
+ case mp_ur_corner_operation:
+ if (! mp_get_cur_bbox(mp)) {
+ mp_bad_unary(mp, mp_ur_corner_operation);
+ } else {
+ mp_pair_value(mp, &mp_maxx, &mp_maxy);
+ }
+ break;
+ case mp_center_of_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ /* keep the pair */
+ } else if (mp_get_cur_bbox(mp)) {
+ /* todo: make this a function call */
+ mp_number x, y;
+ new_number(x);
+ new_number(y);
+ set_number_half_from_subtraction(x, mp_maxx, mp_minx);
+ set_number_half_from_subtraction(y, mp_maxy, mp_miny);
+ number_add(x, mp_minx);
+ number_add(y, mp_miny);
+ mp_pair_value(mp, &x, &y);
+ } else {
+ mp_bad_unary(mp, mp_center_of_operation);
+ }
+ break;
+ case mp_center_of_mass_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ /* keep the pair */
+ } else if (mp->cur_exp.type == mp_path_type) {
+ /* no overflow detection here .. todo: make this a function call */
+ mp_knot p = cur_exp_knot;
+ int l = 0;
+ mp_number x, y;
+ new_number(x);
+ new_number(y);
+ do {
+ ++l;
+ p = mp_next_knot(p);
+ number_add(x, p->x_coord);
+ number_add(y, p->y_coord);
+ } while (p != cur_exp_knot);
+ number_divide_int(x, l);
+ number_divide_int(y, l);
+ mp_pair_value(mp, &x, &y);
+ free_number(x);
+ free_number(y);
+ } else {
+ mp_bad_unary(mp, mp_center_of_mass_operation);
+ }
+ break;
+ case mp_corners_operation:
+ if (! mp_get_cur_bbox(mp)) {
+ mp_bad_unary(mp, mp_corners_operation);
+ } else {
+ mp_knot ll = mp_simple_knot(mp, &mp_minx, &mp_miny);
+ mp_knot lr = mp_simple_knot(mp, &mp_maxx, &mp_miny);
+ mp_knot ur = mp_simple_knot(mp, &mp_maxx, &mp_maxy);
+ mp_knot ul = mp_simple_knot(mp, &mp_minx, &mp_maxy);
+ mp_prev_knot(lr) = ll;
+ mp_next_knot(ll) = lr;
+ mp_prev_knot(ur) = lr;
+ mp_next_knot(lr) = ur;
+ mp_prev_knot(ul) = ur;
+ mp_next_knot(ur) = ul;
+ mp_prev_knot(ll) = ul;
+ mp_next_knot(ul) = ll;
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, ll);
+ }
+ break;
+ case mp_x_range_operation:
+ if (mp_get_cur_xbox(mp)) {
+ mp_pair_value(mp, &mp_minx, &mp_maxx);
+ } else {
+ mp_bad_unary(mp, mp_x_range_operation);
+ }
+ break;
+ case mp_y_range_operation:
+ if (mp_get_cur_ybox(mp)) {
+ mp_pair_value(mp, &mp_miny, &mp_maxy);
+ } else {
+ mp_bad_unary(mp, mp_y_range_operation);
+ }
+ break;
+ case mp_delta_point_operation:
+ case mp_delta_precontrol_operation:
+ case mp_delta_postcontrol_operation:
+ case mp_delta_direction_operation:
+ if (mp->cur_exp.type == mp_known_type) {
+ mp_set_cur_exp_value_number(mp, &cur_exp_value_number);
+ if (mp->loop_ptr && mp->loop_ptr->point != NULL) {
+ mp_knot p = mp->loop_ptr->point;
+ int n = round_unscaled(cur_exp_value_number);
+ if (n > 0) {
+ while (n--) {
+ p = mp_next_knot(p);
+ }
+ } else if (n < 0) {
+ while (n++) {
+ p = mp_prev_knot(p);
+ }
+ }
+ push_of_path_result(mp, c - mp_delta_point_operation, p);
+ }
+ } else {
+ mp_bad_unary(mp, c);
+ }
+ break;
+ case mp_read_from_operation:
+ case mp_close_from_operation:
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_bad_unary(mp, c);
+ } else {
+ mp_do_read_or_close(mp, c);
+ }
+ break;
+ }
+ check_arith();
+}
+
+@ The |nice_pair| function returns |true| if both components of a pair are known.
+
+@<Declare unary action procedures@>=
+static int mp_nice_pair (MP mp, mp_node p, int t)
+{
+ (void) mp;
+ if (t == mp_pair_type) {
+ p = mp_get_value_node(p);
+ if (mp_type(mp_x_part(p)) == mp_known_type && mp_type(mp_y_part(p)) == mp_known_type)
+ return 1;
+ }
+ return 0;
+}
+
+@ The |nice_color_or_pair| function is analogous except that it also accepts
+fully known colors.
+
+@<Declare unary action procedures@>=
+static int mp_nice_color_or_pair (MP mp, mp_node p, int t)
+{
+ mp_node q;
+ (void) mp;
+ switch (t) {
+ case mp_pair_type:
+ q = mp_get_value_node(p);
+ if (mp_type(mp_x_part(q)) == mp_known_type
+ && mp_type(mp_y_part(q)) == mp_known_type)
+ return 1;
+ break;
+ case mp_color_type:
+ q = mp_get_value_node(p);
+ if (mp_type(mp_red_part (q)) == mp_known_type
+ && mp_type(mp_green_part(q)) == mp_known_type
+ && mp_type(mp_blue_part (q)) == mp_known_type)
+ return 1;
+ break;
+ case mp_cmykcolor_type:
+ q = mp_get_value_node(p);
+ if (mp_type(mp_cyan_part (q)) == mp_known_type
+ && mp_type(mp_magenta_part(q)) == mp_known_type
+ && mp_type(mp_yellow_part (q)) == mp_known_type
+ && mp_type(mp_black_part (q)) == mp_known_type)
+ return 1;
+ break;
+ }
+ return 0;
+}
+
+@ @<Declare unary action...@>=
+static void mp_print_known_or_unknown_type (MP mp, int t, mp_node v)
+{
+ mp_print_chr(mp, '(');
+ if (t > mp_known_type) {
+ mp_print_str(mp, "unknown numeric");
+ } else {
+ switch (t) {
+ case mp_pair_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ if (! mp_nice_color_or_pair (mp, v, t)) {
+ mp_print_str(mp, "unknown ");
+ }
+ break;
+ }
+ mp_print_type(mp, t);
+ }
+ mp_print_chr(mp, ')');
+}
+
+@ @<Declare unary action...@>=
+static void mp_bad_unary (MP mp, int c)
+{
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_op(mp, c);
+ mp_print_known_or_unknown_type(mp, mp->cur_exp.type, cur_exp_node);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Not implemented: %s", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ msg,
+ "I'm afraid I don't know how to apply that operation to that particular type.\n"
+ "Continue, and I'll simply return the argument (shown above) as the result of the\n"
+ "operation."
+ );
+ @.Not implemented...@>
+ mp_get_x_next(mp);
+}
+
+@ Negation is easy except when the current expression is of type |independent|,
+or when it is a pair with one or more |independent| components.
+
+@<Declare unary action...@>=
+static void mp_negate_dep_list (MP mp, mp_value_node p)
+{
+ (void) mp;
+ while (1) {
+ number_negate(mp_get_dep_value(p));
+ if (mp_get_dep_info(p) == NULL)
+ return;
+ p = (mp_value_node) mp_link(p);
+ }
+}
+
+@ It is tempting to argue that the negative of an independent variable is an
+independent variable, hence we don't have to do anything when negating it. The
+fallacy is that other dependent variables pointing to the current expression must
+change the sign of their coefficients if we make no change to the current
+expression.
+
+Instead, we work around the problem by copying the current expression and
+recycling it afterwards (cf.~the |stash_in| routine).
+
+@<Declare unary action...@>=
+
+static void mp_negate_value(MP mp, mp_node r)
+{
+ if (mp_type(r) == mp_known_type) {
+ mp_set_value_number(r, mp_get_value_number(r)); /* to clear the rest */
+ number_negate(mp_get_value_number(r));
+ } else {
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) r));
+ }
+}
+
+static void negate_cur_expr (MP mp)
+{
+ switch (mp->cur_exp.type) {
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ case mp_independent_type:
+ {
+ mp_node q = cur_exp_node;
+ mp_make_exp_copy(mp, q);
+ if (mp->cur_exp.type == mp_dependent_type) {
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node));
+ } else if (mp->cur_exp.type <= mp_pair_type) {
+ /* |mp_color_type| |mp_cmykcolor_type|, or |mp_pair_type| */
+ mp_node p = mp_get_value_node(cur_exp_node);
+ // mp_node r; /* for list manipulation */
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ mp_negate_value(mp, mp_x_part(p));
+ mp_negate_value(mp, mp_y_part(p));
+ break;
+ case mp_color_type:
+ mp_negate_value(mp, mp_red_part(p));
+ mp_negate_value(mp, mp_green_part(p));
+ mp_negate_value(mp, mp_blue_part(p));
+ break;
+ case mp_cmykcolor_type:
+ mp_negate_value(mp, mp_cyan_part(p));
+ mp_negate_value(mp, mp_magenta_part(p));
+ mp_negate_value(mp, mp_yellow_part(p));
+ mp_negate_value(mp, mp_black_part(p));
+ break;
+ default:
+ break;
+ }
+ }
+ /* if |cur_type=mp_known| then |cur_exp=0| */
+ mp_recycle_value(mp, q);
+ mp_free_value_node(mp, q);
+ }
+ break;
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node));
+ break;
+ case mp_known_type:
+ if (is_number(cur_exp_value_number)) {
+ number_negate(cur_exp_value_number);
+ }
+ break;
+ default:
+ mp_bad_unary(mp, mp_minus_operation);
+ break;
+ }
+}
+
+@ If the current expression is a pair, but the context wants it to be a path, we
+call |pair_to_path|.
+
+@<Declare unary action...@>=
+static void mp_pair_to_path (MP mp) {
+ mp_set_cur_exp_knot(mp, mp_pair_to_knot(mp));
+ mp->cur_exp.type = mp_path_type;
+}
+
+@ @<Declarations@>=
+static void mp_bad_color_part (MP mp, int c);
+
+@ @c
+static void mp_bad_color_part (MP mp, int c)
+{
+ mp_node p; /* the big node */
+ mp_value new_expr;
+ char msg[256];
+ int selector;
+ mp_string sname;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ p = mp_link(mp_edge_list(cur_exp_node));
+ mp_disp_err(mp, NULL);
+ selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_op(mp, c);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ @.Wrong picture color model...@>
+ switch (mp_color_model(p)) {
+ case mp_grey_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of grey object", mp_str(mp, sname)); break;
+ case mp_cmyk_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of cmyk object", mp_str(mp, sname)); break;
+ case mp_rgb_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of rgb object", mp_str(mp, sname)); break;
+ case mp_no_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of marking object", mp_str(mp, sname)); break;
+ default: mp_snprintf(msg, 256, "Wrong picture color model: %s of defaulted object", mp_str(mp, sname)); break;
+ }
+ delete_str_ref(sname);
+ mp_error(
+ mp,
+ msg,
+ "You can only ask for the redpart, greenpart, bluepart of a rgb object, the\n"
+ "cyanpart, magentapart, yellowpart or blackpart of a cmyk object, or the greypart\n"
+ "of a grey object. No mixing and matching, please."
+ );
+ if (c == mp_black_part_operation) {
+ number_clone(new_expr.data.n, unity_t);
+ } else {
+ set_number_to_zero(new_expr.data.n);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+@ In the following procedure, |cur_exp| points to a capsule, which points to a
+big node. We want to delete all but one part of the big node.
+
+@<Declare unary action...@>=
+static void mp_take_part (MP mp, int c)
+{
+ mp_node p = mp_get_value_node(cur_exp_node); /* the big node */
+ mp_set_value_node(mp->temp_val, p);
+ mp_type(mp->temp_val) = mp->cur_exp.type;
+ mp_link(p) = mp->temp_val;
+ mp_free_value_node(mp, cur_exp_node);
+ switch (c) {
+ case mp_x_part_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_make_exp_copy(mp, mp_x_part(p));
+ } else {
+ mp_make_exp_copy(mp, mp_tx_part(p));
+ }
+ break;
+ case mp_y_part_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_make_exp_copy(mp, mp_y_part(p));
+ } else {
+ mp_make_exp_copy(mp, mp_ty_part(p));
+ }
+ break;
+ case mp_xx_part_operation:
+ mp_make_exp_copy(mp, mp_xx_part(p));
+ break;
+ case mp_xy_part_operation:
+ mp_make_exp_copy(mp, mp_xy_part(p));
+ break;
+ case mp_yx_part_operation:
+ mp_make_exp_copy(mp, mp_yx_part(p));
+ break;
+ case mp_yy_part_operation:
+ mp_make_exp_copy(mp, mp_yy_part(p));
+ break;
+ case mp_red_part_operation:
+ mp_make_exp_copy(mp, mp_red_part(p));
+ break;
+ case mp_green_part_operation:
+ mp_make_exp_copy(mp, mp_green_part(p));
+ break;
+ case mp_blue_part_operation:
+ mp_make_exp_copy(mp, mp_blue_part(p));
+ break;
+ case mp_cyan_part_operation:
+ mp_make_exp_copy(mp, mp_cyan_part(p));
+ break;
+ case mp_magenta_part_operation:
+ mp_make_exp_copy(mp, mp_magenta_part(p));
+ break;
+ case mp_yellow_part_operation:
+ mp_make_exp_copy(mp, mp_yellow_part(p));
+ break;
+ case mp_black_part_operation:
+ mp_make_exp_copy(mp, mp_black_part(p));
+ break;
+ case mp_grey_part_operation:
+ mp_make_exp_copy(mp, mp_grey_part(p));
+ break;
+ }
+ mp_recycle_value(mp, mp->temp_val);
+}
+
+@ @<Initialize table entries@>=
+mp->temp_val = mp_new_value_node(mp);
+mp_name_type(mp->temp_val) = mp_capsule_operation;
+
+@ @<Free table entries@>=
+mp_free_value_node(mp, mp->temp_val);
+
+@ @<Declarations@>=
+static mp_edge_header_node mp_scale_edges (MP mp, mp_number *se_sf, mp_edge_header_node se_pic);
+
+@ @<Declare unary action...@>=
+static void mp_take_pict_part (MP mp, int c)
+{
+ mp_node p; /* first graphical object in |cur_exp| */
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ p = mp_link(mp_edge_list(cur_exp_node));
+ if (p != NULL) {
+ switch (c) {
+ case mp_x_part_operation:
+ case mp_y_part_operation:
+ case mp_xx_part_operation:
+ case mp_xy_part_operation:
+ case mp_yx_part_operation:
+ case mp_yy_part_operation:
+ goto NOT_FOUND;
+ case mp_red_part_operation:
+ case mp_green_part_operation:
+ case mp_blue_part_operation:
+ if (mp_has_color(p)) {
+ switch (c) {
+ case mp_red_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->red);
+ break;
+ case mp_green_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->green);
+ break;
+ case mp_blue_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->blue);
+ break;
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_cyan_part_operation:
+ case mp_magenta_part_operation:
+ case mp_yellow_part_operation:
+ case mp_black_part_operation:
+ if (mp_has_color(p)) {
+ if (mp_color_model(p) == mp_uninitialized_model && c == mp_black_part_operation) {
+ set_number_to_unity(new_expr.data.n);
+ } else {
+ switch (c) {
+ case mp_cyan_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->cyan);
+ break;
+ case mp_magenta_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->magenta);
+ break;
+ case mp_yellow_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->yellow);
+ break;
+ case mp_black_part_operation:
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->black);
+ break;
+ }
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_grey_part_operation:
+ if (mp_has_color(p)) {
+ number_clone(new_expr.data.n, ((mp_shape_node) p)->grey);
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_color_model_operation:
+ if (mp_has_color(p)) {
+ if (mp_color_model(p) == mp_uninitialized_model) {
+ /* could use the else branch with int variant */
+ number_clone(new_expr.data.n, internal_value(mp_default_color_model_internal));
+ } else {
+ number_clone(new_expr.data.n, unity_t);
+ number_multiply_int(new_expr.data.n, mp_color_model(p));
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ } else
+ goto NOT_FOUND;
+ break;
+ case mp_prescript_part_operation:
+ if (! mp_has_script(p)) {
+ goto NOT_FOUND;
+ } else {
+ if (mp_pre_script(p)) {
+ new_expr.data.str = mp_pre_script(p);
+ add_str_ref(new_expr.data.str);
+ } else {
+ new_expr.data.str = mp_rts(mp,"");
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ };
+ break;
+ case mp_postscript_part_operation:
+ if (! mp_has_script(p)) {
+ goto NOT_FOUND;
+ } else {
+ if (mp_post_script(p)) {
+ new_expr.data.str = mp_post_script(p);
+ add_str_ref(new_expr.data.str);
+ } else {
+ new_expr.data.str = mp_rts(mp,"");
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ };
+ break;
+ case mp_stacking_part_operation:
+ number_clone(new_expr.data.n, unity_t);
+ number_multiply_int(new_expr.data.n, mp_stacking(p));
+ mp_flush_cur_exp(mp, new_expr);
+ break;
+ case mp_path_part_operation:
+ if (mp_is_stop(p)) {
+ mp_confusion(mp, "picture");
+ } else {
+ new_expr.data.node = NULL;
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ new_expr.data.p = mp_copy_path(mp, mp_path_ptr((mp_shape_node) p));
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ new_expr.data.p = mp_copy_path(mp, mp_path_ptr((mp_start_node) p));
+ break;
+ default:
+ break;
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_path_type;
+ }
+ break;
+ case mp_pen_part_operation:
+ if (! mp_has_pen(p)) {
+ goto NOT_FOUND;
+ } else {
+ switch (mp_type(p)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ if (mp_pen_ptr((mp_shape_node) p) == NULL) {
+ goto NOT_FOUND;
+ } else {
+ new_expr.data.p = mp_copy_pen(mp, mp_pen_ptr((mp_shape_node) p));
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pen_type((mp_shape_node) p) ? mp_nep_type : mp_pen_type ;
+ }
+ break;
+ default:
+ break;
+ }
+ }
+ break;
+ case mp_dash_part_operation:
+ if (mp_type(p) != mp_stroked_node_type) {
+ goto NOT_FOUND;
+ } else if (mp_dash_ptr(p) == NULL) {
+ goto NOT_FOUND;
+ } else {
+ mp_add_edge_ref(mp, mp_dash_ptr(p));
+ new_expr.data.node = (mp_node) mp_scale_edges(mp,
+ &(((mp_shape_node) p)->dashscale), (mp_edge_header_node) mp_dash_ptr(p));
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_picture_type;
+ }
+ break;
+ }
+ return;
+ };
+ NOT_FOUND:
+ /* Convert the current expression to a NULL value appropriate for |c| */
+ switch (c) {
+ case mp_prescript_part_operation:
+ case mp_postscript_part_operation:
+ new_expr.data.str = mp_rts(mp,"");
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ break;
+ case mp_path_part_operation:
+ new_expr.data.p = mp_new_knot(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp_left_type(cur_exp_knot) = mp_endpoint_knot;
+ mp_right_type(cur_exp_knot) = mp_endpoint_knot;
+ mp_prev_knot(cur_exp_knot) = cur_exp_knot;
+ mp_next_knot(cur_exp_knot) = cur_exp_knot;
+ set_number_to_zero(cur_exp_knot->x_coord);
+ set_number_to_zero(cur_exp_knot->y_coord);
+ mp_originator(cur_exp_knot) = mp_metapost_user;
+ mp_knotstate(cur_exp_knot) = mp_regular_knot;
+ mp->cur_exp.type = mp_path_type;
+ break;
+ case mp_pen_part_operation:
+ new_expr.data.p = mp_get_pen_circle(mp, &zero_t);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pen_type; /* todo: mp_nep_type */
+ break;
+ case mp_dash_part_operation:
+ new_expr.data.node = (mp_node) mp_get_edge_header_node(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ mp_init_edges(mp, (mp_edge_header_node) cur_exp_node);
+ mp->cur_exp.type = mp_picture_type;
+ break;
+ default:
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ break;
+ }
+}
+
+@ This one is stripped because it only handles |ASCII|. Watch out, the |ASCII|
+operator only looks at the first character and then just interprets the character
+as byte. One can implement a \UTF\ interpreter in \LUA.
+
+@<Declare unary action...@>=
+static void mp_str_to_num (MP mp)
+{
+ /* converts a string to a number */
+ int n; /* accumulator */
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cur_exp_str->len == 0) {
+ n = -1;
+ } else {
+ n = cur_exp_str->str[0];
+ }
+ number_clone(new_expr.data.n, unity_t);
+ number_multiply_int(new_expr.data.n, n);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+@ This computes the length of the current path or picture. The only benefit from
+not using the numbers but a temporary |int| instead is .5K smaller which is due
+to less interfacing. But it also demonstrates that on the one hand the number
+system indirectness adds quite some bytes but on the other hand todays compilers
+do a pretty good job at optimizing (for performance). Which of course doesn't
+mean that scaled outperforms double manyfold while decimal is always way slower.
+
+@<Declarations@>=
+static void mp_path_length (MP mp, mp_number *n);
+
+@ @<Declare unary action...@>=
+static void mp_path_length (MP mp, mp_number *n)
+{
+ mp_knot p = cur_exp_knot;
+ int l = mp_left_type(p) == mp_endpoint_knot ? -1 : 0;
+ do {
+ p = mp_next_knot(p);
+ ++l;
+ } while (p != cur_exp_knot);
+ set_number_from_int(*n, l);
+}
+
+static void mp_picture_length (MP mp, mp_number *n)
+{
+ /* counts interior components in picture |cur_exp| */
+ mp_node p = mp_link(mp_edge_list(cur_exp_node));
+ int l = 0;
+ if (p != NULL) {
+ if (mp_is_start_or_stop(p) && mp_skip_1component(mp, p) == NULL) {
+ p = mp_link(p);
+ }
+ while (p != NULL) {
+ if (! mp_is_start_or_stop(p)) {
+ p = mp_link(p);
+ } else if (! mp_is_stop(p)) {
+ p = mp_skip_1component(mp, p);
+ } else {
+ break;
+ }
+ ++l;
+ }
+ }
+ set_number_from_int(*n, l);
+}
+
+@ The function |an_angle| returns the value of the |angle| primitive, or $0$ if
+the argument is |origin|.
+
+@<Declare unary action...@>=
+static void mp_an_angle (MP mp, mp_number *ret, mp_number *xpar, mp_number *ypar)
+{
+ set_number_to_zero(*ret);
+ if (! (number_zero(*xpar) && number_zero(*ypar))) {
+ n_arg(*ret, *xpar, *ypar);
+ }
+}
+
+@ The actual turning number is (for the moment) computed in a C function that
+receives eight integers corresponding to the four controlling points, and returns
+a single angle. Besides those, we have to account for discrete moves at the
+actual points.
+
+@d mp_floor(a) ((a) >= 0 ? (int) (a) : -(int) (-(a)))
+@d bezier_error (720*(256*256*16))+1
+@d mp_sign(v) ((v) > 0 ? 1 : ((v)<0 ? -1 : 0 ))
+@d mp_out(A) (double)((A)/16)
+
+@<Declare unary action...@>=
+static void mp_bezier_slope (MP mp,
+ mp_number *ret, mp_number *AX, mp_number *AY, mp_number *BX,
+ mp_number *BY, mp_number *CX, mp_number *CY, mp_number *DX,
+ mp_number *DY
+);
+
+@ @c
+static void mp_bezier_slope (MP mp,
+ mp_number *ret, mp_number *AX, mp_number *AY, mp_number *BX,
+ mp_number *BY, mp_number *CX, mp_number *CY, mp_number *DX,
+ mp_number *DY
+)
+{
+ double a, b, c;
+ mp_number deltax, deltay;
+ mp_number xi, xo, xm;
+ double res = 0.0;
+ double ax = number_to_double(*AX);
+ double ay = number_to_double(*AY);
+ double bx = number_to_double(*BX);
+ double by = number_to_double(*BY);
+ double cx = number_to_double(*CX);
+ double cy = number_to_double(*CY);
+ double dx = number_to_double(*DX);
+ double dy = number_to_double(*DY);
+ new_number(deltax);
+ new_number(deltay);
+ set_number_from_subtraction(deltax, *BX, *AX);
+ set_number_from_subtraction(deltay, *BY, *AY);
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *CX, *AX);
+ set_number_from_subtraction(deltay, *CY, *AY);
+ }
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *DX, *AX);
+ set_number_from_subtraction(deltay, *DY, *AY);
+ }
+ new_number(xi);
+ new_number(xm);
+ new_number(xo);
+ mp_an_angle(mp, &xi, &deltax, &deltay);
+ set_number_from_subtraction(deltax, *CX, *BX);
+ set_number_from_subtraction(deltay, *CY, *BY);
+ mp_an_angle(mp, &xm, &deltax, &deltay); /* !!! never used? */
+ set_number_from_subtraction(deltax, *DX, *CX);
+ set_number_from_subtraction(deltay, *DY, *CY);
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *DX, *BX);
+ set_number_from_subtraction(deltay, *DY, *BY);
+ }
+ if (number_zero(deltax) && number_zero(deltay)) {
+ set_number_from_subtraction(deltax, *DX, *AX);
+ set_number_from_subtraction(deltay, *DY, *AY);
+ }
+ mp_an_angle(mp, &xo, &deltax, &deltay);
+ a = (bx - ax) * (cy - by) - (cx - bx) * (by - ay); /* a = (bp-ap)x(cp-bp); */
+ b = (bx - ax) * (dy - cy) - (by - ay) * (dx - cx); /* b = (bp-ap)x(dp-cp); */
+ c = (cx - bx) * (dy - cy) - (dx - cx) * (cy - by); /* c = (cp-bp)x(dp-cp); */
+ if ((a == 0.0) && (c == 0.0)) {
+ res = (b == 0.0 ? 0.0 : (mp_out(number_to_double(xo)) - mp_out(number_to_double(xi))));
+ } else if ((a == 0.0) || (c == 0.0)) {
+ if ((mp_sign (b) == mp_sign (a)) || (mp_sign (b) == mp_sign (c))) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); /* ? */
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ } else {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); /* ? */
+ }
+ } else if ((mp_sign (a) * mp_sign (c)) < 0.0) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ } else if (mp_sign (a) == mp_sign (b)) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ } else if ((b * b) == (4.0 * a * c)) {
+ res = (double) bezier_error;
+ } else if ((b * b) < (4.0 * a * c)) {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res <= 0.0 && res > -180.0) {
+ res += 360.0;
+ } else if (res >= 0.0 && res < 180.0) {
+ res -= 360.0;
+ }
+ } else {
+ res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi));
+ if (res < -180.0) {
+ res += 360.0;
+ } else if (res > 180.0) {
+ res -= 360.0;
+ }
+ }
+ free_number(deltax);
+ free_number(deltay);
+ free_number(xi);
+ free_number(xo);
+ free_number(xm);
+ set_number_from_double(*ret, res);
+ convert_scaled_to_angle(*ret);
+}
+
+@d p_nextnext mp_next_knot(mp_next_knot(p))
+@d p_next mp_next_knot(p)
+
+@<Declare unary action...@>=
+static void mp_turn_cycles (MP mp, mp_number *turns, mp_knot c)
+{
+ int selector; /* saved |selector| setting */
+ mp_angle res, ang; /* the angles of intermediate results */
+ mp_knot p; /* for running around the path */
+ mp_number xp, yp; /* coordinates of next point */
+ mp_number x, y; /* helper coordinates */
+ mp_number arg1, arg2;
+ mp_angle in_angle, out_angle; /* helper angles */
+ mp_angle seven_twenty_deg_t;
+ set_number_to_zero(*turns);
+ new_number(arg1);
+ new_number(arg2);
+ new_number(xp);
+ new_number(yp);
+ new_number(x);
+ new_number(y);
+ new_angle(in_angle);
+ new_angle(out_angle);
+ new_angle(ang);
+ new_angle(res);
+ new_angle(seven_twenty_deg_t);
+ number_clone(seven_twenty_deg_t, three_sixty_deg_t);
+ number_double(seven_twenty_deg_t);
+ p = c;
+ selector = mp->selector;
+ mp->selector = mp_term_only_selector;
+ if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) {
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "");
+ mp_end_diagnostic(mp, 0);
+ }
+ do {
+ number_clone(xp, p_next->x_coord);
+ number_clone(yp, p_next->y_coord);
+ mp_bezier_slope(mp, &ang, &(p->x_coord), &(p->y_coord), &(p->right_x), &(p->right_y), &(p_next->left_x), &(p_next->left_y), &xp, &yp);
+ if (number_greater(ang, seven_twenty_deg_t)) {
+ mp_error(mp, "Strange path", NULL);
+ mp->selector = selector;
+ set_number_to_zero(*turns);
+ goto DONE;
+ }
+ number_add(res, ang);
+ if (number_greater(res, one_eighty_deg_t)) {
+ number_subtract(res, three_sixty_deg_t);
+ number_add(*turns, unity_t);
+ }
+ if (number_lessequal(res, negative_one_eighty_deg_t)) {
+ number_add(res, three_sixty_deg_t);
+ number_subtract(*turns, unity_t);
+ }
+ /* incoming angle at next point */
+ number_clone(x, p_next->left_x);
+ number_clone(y, p_next->left_y);
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p->right_x);
+ number_clone(y, p->right_y);
+ }
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p->x_coord);
+ number_clone(y, p->y_coord);
+ }
+ set_number_from_subtraction(arg1, xp, x);
+ set_number_from_subtraction(arg2, yp, y);
+ mp_an_angle(mp, &in_angle, &arg1, &arg2);
+ /* outgoing angle at next point */
+ number_clone(x, p_next->right_x);
+ number_clone(y, p_next->right_y);
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p_nextnext->left_x);
+ number_clone(y, p_nextnext->left_y);
+ }
+ if (number_equal(xp, x) && number_equal(yp, y)) {
+ number_clone(x, p_nextnext->x_coord);
+ number_clone(y, p_nextnext->y_coord);
+ }
+ set_number_from_subtraction(arg1, x, xp);
+ set_number_from_subtraction(arg2, y, yp);
+ mp_an_angle(mp, &out_angle, &arg1, &arg2);
+ set_number_from_subtraction(ang, out_angle, in_angle);
+ mp_reduce_angle(mp, &ang);
+ if (number_nonzero(ang)) {
+ number_add(res, ang);
+ if (number_greaterequal(res, one_eighty_deg_t)) {
+ number_subtract(res, three_sixty_deg_t);
+ number_add(*turns, unity_t);
+ }
+ if (number_lessequal(res, negative_one_eighty_deg_t)) {
+ number_add(res, three_sixty_deg_t);
+ number_subtract(*turns, unity_t);
+ }
+ }
+ p = mp_next_knot(p);
+ } while (p != c);
+ mp->selector = selector;
+ DONE:
+ free_number(xp);
+ free_number(yp);
+ free_number(x);
+ free_number(y);
+ free_number(seven_twenty_deg_t);
+ free_number(in_angle);
+ free_number(out_angle);
+ free_number(ang);
+ free_number(res);
+ free_number(arg1);
+ free_number(arg2);
+}
+
+@ @<Declare unary action...@>=
+static void mp_turn_cycles_wrapper (MP mp, mp_number *ret, mp_knot c)
+{
+ if (mp_next_knot(c) == c) {
+ /* one-knot paths always have a turning number of 1 */
+ set_number_to_unity(*ret);
+ } else {
+ mp_turn_cycles (mp, ret, c);
+ }
+}
+
+@ @<Declare unary action procedures@>=
+static int mp_test_known (MP mp, int c)
+{
+ int b = mp_false_operation; /* is the current expression known? */
+ switch (mp->cur_exp.type) {
+ case mp_vacuous_type:
+ case mp_boolean_type:
+ case mp_string_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ case mp_known_type:
+ b = mp_true_operation;
+ break;
+ case mp_transform_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_tx_part(p)) == mp_known_type) &&
+ (mp_type(mp_ty_part(p)) == mp_known_type) &&
+ (mp_type(mp_xx_part(p)) == mp_known_type) &&
+ (mp_type(mp_xy_part(p)) == mp_known_type) &&
+ (mp_type(mp_yx_part(p)) == mp_known_type) &&
+ (mp_type(mp_yy_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_red_part(p)) == mp_known_type) &&
+ (mp_type(mp_green_part(p)) == mp_known_type) &&
+ (mp_type(mp_blue_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_cyan_part(p)) == mp_known_type) &&
+ (mp_type(mp_magenta_part(p)) == mp_known_type) &&
+ (mp_type(mp_yellow_part(p)) == mp_known_type) &&
+ (mp_type(mp_black_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_node p = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_x_part(p)) == mp_known_type) &&
+ (mp_type(mp_y_part(p)) == mp_known_type) ) {
+ b = mp_true_operation;
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ if (c == mp_known_operation) {
+ return b;
+ } else {
+ return b == mp_true_operation ? mp_false_operation : mp_true_operation;
+ }
+}
+
+@ The |pair_value| routine changes the current expression to a given ordered pair
+of values.
+
+@<Declarations@>=
+static void mp_pair_value (MP mp, mp_number *x, mp_number *y);
+
+@ @<Declare unary action procedures@>=
+static void mp_pair_value (MP mp, mp_number *x, mp_number *y)
+{
+ mp_node p; /* a pair node */
+ mp_value new_expr;
+ mp_number x1, y1;
+ new_number_clone(x1, *x);
+ new_number_clone(y1, *y);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ p = mp_new_value_node(mp);
+ new_expr.type = mp_type(p);
+ new_expr.data.node = p;
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pair_type;
+ mp_name_type(p) = mp_capsule_operation;
+ mp_init_pair_node(mp, p);
+ p = mp_get_value_node(p);
+ mp_type(mp_x_part(p)) = mp_known_type;
+ mp_set_value_number(mp_x_part(p), x1);
+ mp_type(mp_y_part(p)) = mp_known_type;
+ mp_set_value_number(mp_y_part(p), y1);
+ free_number(x1);
+ free_number(y1);
+}
+
+@ Here is a function that sets |minx|, |maxx|, |miny|, |maxy| to the bounding
+box of the current expression. The boolean result is |false| if the expression
+has the wrong type.
+
+@<Declare unary action procedures@>=
+static int mp_get_cur_bbox (MP mp)
+{
+ switch (mp->cur_exp.type) {
+ case mp_picture_type:
+ {
+ mp_edge_header_node p = (mp_edge_header_node) cur_exp_node;
+ mp_set_bbox(mp, p, 1);
+ if (number_greater(p->minx, p->maxx)) {
+ set_number_to_zero(mp_minx);
+ set_number_to_zero(mp_maxx);
+ set_number_to_zero(mp_miny);
+ set_number_to_zero(mp_maxy);
+ } else {
+ number_clone(mp_minx, p->minx);
+ number_clone(mp_maxx, p->maxx);
+ number_clone(mp_miny, p->miny);
+ number_clone(mp_maxy, p->maxy);
+ }
+ }
+ break;
+ case mp_path_type:
+ mp_path_bbox(mp, cur_exp_knot);
+ break;
+ case mp_pen_type:
+ case mp_nep_type:
+ mp_pen_bbox(mp, cur_exp_knot);
+ break;
+ default:
+ return 0;
+ }
+ return 1;
+}
+
+static int mp_get_cur_xbox (MP mp)
+{
+ if (mp->cur_exp.type == mp_path_type) {
+ mp_path_xbox(mp, cur_exp_knot);
+ return 1;
+ } else {
+ return mp_get_cur_bbox(mp);
+ }
+}
+
+static int mp_get_cur_ybox (MP mp)
+{
+ if (mp->cur_exp.type == mp_path_type) {
+ mp_path_ybox(mp, cur_exp_knot);
+ return 1;
+ } else {
+ return mp_get_cur_bbox(mp);
+ }
+}
+
+@ Here is a routine that interprets |cur_exp| as a file name and tries to read a
+line from the file or to close the file.
+
+@<Declare unary action procedures@>=
+static void mp_do_read_or_close (MP mp, int c)
+{
+ int n = mp->read_files;
+ int n0 = mp->read_files;
+ char *fn = mp_strdup(mp_str(mp, cur_exp_str));
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ /*
+ Find the |n| where |rd_fname[n]=cur_exp|; if |cur_exp| must be inserted,
+ call |start_read_input| and |goto found| or |not_found|. Free slots in
+ the |rd_file| and |rd_fname| arrays are marked with NULL's in |rd_fname|.
+ */
+ while (mp_strcmp(fn, mp->rd_fname[n]) != 0) {
+ if (n > 0) {
+ --n;
+ } else if (c == mp_close_from_operation) {
+ goto CLOSE_FILE;
+ } else {
+ if (n0 == mp->read_files) {
+ if (mp->read_files < mp->max_read_files) {
+ ++mp->read_files;
+ } else {
+ void **rd_file;
+ char **rd_fname;
+ int l;
+ l = mp->max_read_files + (mp->max_read_files / 4);
+ rd_file = mp_memory_allocate((size_t) (l + 1) * sizeof(void *));
+ rd_fname = mp_memory_allocate((size_t) (l + 1) * sizeof(char *));
+ for (int k = 0; k <= l; k++) {
+ if (k <= mp->max_read_files) {
+ rd_file[k] = mp->rd_file[k];
+ rd_fname[k] = mp->rd_fname[k];
+ } else {
+ rd_file[k] = 0;
+ rd_fname[k] = NULL;
+ }
+ }
+ mp_memory_free(mp->rd_file);
+ mp_memory_free(mp->rd_fname);
+ mp->max_read_files = l;
+ mp->rd_file = rd_file;
+ mp->rd_fname = rd_fname;
+ }
+ }
+ n = n0;
+ if (mp_start_read_input(mp, fn, n)) {
+ goto FOUND;
+ } else {
+ goto NOT_FOUND;
+ }
+ }
+ if (mp->rd_fname[n] == NULL) {
+ n0 = n;
+ }
+ }
+ if (c == mp_close_from_operation) {
+ (mp->close_file) (mp, mp->rd_file[n]);
+ goto NOT_FOUND;
+ }
+ mp_begin_file_reading(mp);
+ name = is_read;
+ if (mp_input_ln(mp, mp->rd_file[n])) {
+ goto FOUND;
+ }
+ mp_end_file_reading(mp);
+ NOT_FOUND:
+ /* Record the end of file and set |cur_exp| to a dummy value */
+ mp_memory_free(mp->rd_fname[n]);
+ mp->rd_fname[n] = NULL;
+ if (n == mp->read_files - 1) {
+ mp->read_files = n;
+ }
+ if (c == mp_close_from_operation) {
+ goto CLOSE_FILE;
+ }
+ // new_expr.data.str = mp->eof_line;
+ new_expr.data.str = mp->eof_file;
+ add_str_ref(new_expr.data.str);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_string_type;
+ return;
+ CLOSE_FILE:
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_vacuous_type;
+ return;
+ FOUND:
+ mp_flush_cur_exp(mp, new_expr);
+ mp_finish_read(mp);
+}
+
+@ The string denoting end-of-file is a one-byte string at position zero, by
+definition. I have to cheat a little here because
+
+@<Glob...@>=
+mp_string eof_line;
+mp_string eof_file;
+
+@ @<Set init...@>=
+mp->eof_line = mp_rtsl (mp, "\0", 1);
+mp->eof_line->refs = MAX_STR_REF;
+mp->eof_file = mp_rtsl (mp, "%", 1);
+mp->eof_file->refs = MAX_STR_REF;
+
+@ Finally, we have the operations that combine a capsule~|p| with the current
+expression.
+
+Several of the binary operations are potentially complicated by the fact that
+|independent| values can sneak into capsules. For example, we've seen an instance
+of this difficulty in the unary operation of negation. In order to reduce the
+number of cases that need to be handled, we first change the two operands (if
+necessary) to rid them of |independent| components. The original operands are put
+into capsules called |old_p| and |old_exp|, which will be recycled after the
+binary operation has been safely carried out.
+
+@c
+@<Declare binary action procedures@>
+static void mp_finish_binary (MP mp, mp_node old_p, mp_node old_exp)
+{
+ check_arith();
+ /* Recycle any sidestepped |independent| capsules */
+ if (old_p != NULL) {
+ mp_recycle_value(mp, old_p);
+ mp_free_value_node(mp, old_p);
+ }
+ if (old_exp != NULL) {
+ mp_recycle_value(mp, old_exp);
+ mp_free_value_node(mp, old_exp);
+ }
+}
+
+static void mp_do_binary (MP mp, mp_node p, int c)
+{
+ mp_node old_p, old_exp; /* capsules to recycle */
+ mp_value new_expr;
+ check_arith();
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ /* Trace the current binary operation */
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{(");
+ /* show the operand, but not verbosely */
+ mp_print_exp(mp, p, 0);
+ mp_print_chr(mp, ')');
+ mp_print_op(mp, (int) c);
+ mp_print_chr(mp, '(');
+ mp_print_exp(mp, NULL, 0);
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+ }
+ /*
+ Sidestep |independent| cases in capsule |p|. A big node is considered to be
+ \quote {tarnished} if it contains at least one independent component. We will
+ define a simple function called |tarnished| that returns |NULL| if and only
+ if its argument is not tarnished.
+ */
+ switch (mp_type(p)) {
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ old_p = mp_tarnished(mp, p);
+ break;
+ case mp_independent_type:
+ old_p = MP_VOID;
+ break;
+ default:
+ old_p = NULL;
+ break;
+ }
+ if (old_p != NULL) {
+ mp_node q = mp_stash_cur_exp(mp);
+ old_p = p;
+ mp_make_exp_copy(mp, old_p);
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, q);
+ }
+ /* Sidestep |independent| cases in the current expression */
+ switch (mp->cur_exp.type) {
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ old_exp = mp_tarnished(mp, cur_exp_node);
+ break;
+ case mp_independent_type:
+ old_exp = MP_VOID;
+ break;
+ default:
+ old_exp = NULL;
+ break;
+ }
+ if (old_exp != NULL) {
+ old_exp = cur_exp_node;
+ mp_make_exp_copy(mp, old_exp);
+ }
+ switch (c) {
+ case mp_plus_operation:
+ case mp_minus_operation:
+ /* Add or subtract the current expression from |p| */
+ if ((mp->cur_exp.type < mp_color_type) || (mp_type(p) < mp_color_type)) {
+ mp_bad_binary(mp, p, c);
+ } else {
+ if ((mp->cur_exp.type > mp_pair_type) && (mp_type(p) > mp_pair_type)) {
+ mp_add_or_subtract(mp, p, NULL, c);
+ } else if (mp->cur_exp.type != mp_type(p)) {
+ /*
+ We catch a mismatch, so we can handle intermediates (assuming a flexible withcolor);
+ if we would go double only live would be easier ... I might eventually make a more
+ generic color type.
+ */
+ /*
+ if (mp->cur_exp.type == mp_color_type && mp_type(p) == mp_cmykcolor_type) {
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ number_negate((mp_cyan_part(q))->data.n);
+ number_negate((mp_magenta_part(q))->data.n);
+ number_negate((mp_yellow_part(q))->data.n);
+ number_add((mp_cyan_part(q))->data.n, unity_t);
+ number_add((mp_magenta_part(q))->data.n, unity_t);
+ number_add((mp_yellow_part(q))->data.n, unity_t);
+ mp_add_or_subtract(mp, mp_cyan_part(q), mp_red_part(r), c);
+ mp_add_or_subtract(mp, mp_magenta_part(q), mp_green_part(r), c);
+ mp_add_or_subtract(mp, mp_yellow_part(q), mp_blue_part(r), c);
+ } else if (mp->cur_exp.type == mp_cmykcolor_type && mp_type(p) == mp_color_type) {
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ number_negate((mp_red_part(q))->data.n);
+ number_negate((mp_green_part(q))->data.n);
+ number_negate((mp_blue_part(q))->data.n);
+ number_add((mp_red_part(q))->data.n, unity_t);
+ number_add((mp_green_part(q))->data.n, unity_t);
+ number_add((mp_blue_part(q))->data.n, unity_t);
+ mp_add_or_subtract(mp, mp_red_part(q), mp_cyan_part(r), c);
+ mp_add_or_subtract(mp, mp_green_part(q), mp_magenta_part(r), c);
+ mp_add_or_subtract(mp, mp_blue_part(q), mp_yellow_part(r), c);
+ } else {
+ */
+ mp_bad_binary(mp, p, c);
+ /* } */
+ } else {
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ mp_add_or_subtract(mp, mp_x_part(q), mp_x_part(r), c);
+ mp_add_or_subtract(mp, mp_y_part(q), mp_y_part(r), c);
+ break;
+ case mp_color_type:
+ mp_add_or_subtract(mp, mp_red_part(q), mp_red_part(r), c);
+ mp_add_or_subtract(mp, mp_green_part(q), mp_green_part(r), c);
+ mp_add_or_subtract(mp, mp_blue_part(q), mp_blue_part(r), c);
+ break;
+ case mp_cmykcolor_type:
+ mp_add_or_subtract(mp, mp_cyan_part(q), mp_cyan_part(r), c);
+ mp_add_or_subtract(mp, mp_magenta_part(q), mp_magenta_part(r), c);
+ mp_add_or_subtract(mp, mp_yellow_part(q), mp_yellow_part(r), c);
+ mp_add_or_subtract(mp, mp_black_part(q), mp_black_part(r), c);
+ break;
+ case mp_transform_type:
+ mp_add_or_subtract(mp, mp_tx_part(q), mp_tx_part(r), c);
+ mp_add_or_subtract(mp, mp_ty_part(q), mp_ty_part(r), c);
+ mp_add_or_subtract(mp, mp_xx_part(q), mp_xx_part(r), c);
+ mp_add_or_subtract(mp, mp_xy_part(q), mp_xy_part(r), c);
+ mp_add_or_subtract(mp, mp_yx_part(q), mp_yx_part(r), c);
+ mp_add_or_subtract(mp, mp_yy_part(q), mp_yy_part(r), c);
+ break;
+ default:
+ break;
+ }
+ }
+ }
+ break;
+ case mp_less_than_operation:
+ case mp_less_or_equal_operation:
+ case mp_greater_than_operation:
+ case mp_greater_or_equal_operation:
+ case mp_equal_operation:
+ case mp_unequal_operation:
+ check_arith();
+ /* at this point |arith_error| should be |false|? */
+ if ((mp->cur_exp.type > mp_pair_type) && (mp_type(p) > mp_pair_type)) {
+ /* |cur_exp:=(p)-cur_exp| */
+ mp_add_or_subtract(mp, p, NULL, mp_minus_operation);
+ } else if (mp->cur_exp.type != mp_type(p)) {
+ mp_bad_binary(mp, p, (int) c);
+ goto DONE;
+ } else {
+ /*
+ Reduce comparison of big nodes to comparison of scalars. In the
+ following, the |while| loops exist just so that |break| can be
+ used, each loop runs exactly once.
+ */
+ switch (mp->cur_exp.type) {
+ case mp_string_type:
+ {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_from_scaled(new_expr.data.n, mp_str_vs_str(mp, mp_get_value_str(p), cur_exp_str));
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_unknown_string_type:
+ case mp_unknown_boolean_type:
+ {
+ /*
+ Check if unknowns have been equated. When two unknown strings are
+ in the same ring, we know that they are equal. Otherwise, we
+ don't know whether they are equal or not, so we make no change.
+ */
+ mp_node q = mp_get_value_node(cur_exp_node);
+ while ((q != cur_exp_node) && (q != p)) {
+ q = mp_get_value_node(q);
+ }
+ if (q == p) {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_set_cur_exp_node(mp, NULL);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ }
+ break;
+ case mp_pair_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_x_part(r);
+ part_type = mp_x_part_operation;
+ mp_add_or_subtract(mp, mp_x_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_y_part(r);
+ part_type = mp_y_part_operation;
+ mp_add_or_subtract(mp, mp_y_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_color_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_red_part(r);
+ part_type = mp_red_part_operation;
+ mp_add_or_subtract(mp, mp_red_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_green_part(r);
+ part_type = mp_green_part_operation;
+ mp_add_or_subtract(mp, mp_green_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_blue_part(r);
+ part_type = mp_blue_part_operation;
+ mp_add_or_subtract(mp, mp_blue_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_cyan_part(r);
+ part_type = mp_cyan_part_operation;
+ mp_add_or_subtract(mp, mp_cyan_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_magenta_part(r);
+ part_type = mp_magenta_part_operation;
+ mp_add_or_subtract(mp, mp_magenta_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_yellow_part(r);
+ part_type = mp_yellow_part_operation;
+ mp_add_or_subtract(mp, mp_yellow_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_black_part(r);
+ part_type = mp_black_part_operation;
+ mp_add_or_subtract(mp, mp_black_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_transform_type:
+ {
+ int part_type = 0;
+ mp_node q = mp_get_value_node(p);
+ mp_node r = mp_get_value_node(cur_exp_node);
+ while (part_type == 0) {
+ mp_node rr = mp_tx_part(r);
+ part_type = mp_x_part_operation;
+ mp_add_or_subtract(mp, mp_tx_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_ty_part(r);
+ part_type = mp_y_part_operation;
+ mp_add_or_subtract(mp, mp_ty_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_xx_part(r);
+ part_type = mp_xx_part_operation;
+ mp_add_or_subtract(mp, mp_xx_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_xy_part(r);
+ part_type = mp_xy_part_operation;
+ mp_add_or_subtract(mp, mp_xy_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_yx_part(r);
+ part_type = mp_yx_part_operation;
+ mp_add_or_subtract(mp, mp_yx_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ rr = mp_yy_part(r);
+ part_type = mp_yy_part_operation;
+ mp_add_or_subtract(mp, mp_yy_part(q), rr, mp_minus_operation);
+ if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) {
+ break;
+ }
+ }
+ mp_take_part(mp, part_type);
+ }
+ break;
+ case mp_boolean_type:
+ {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_from_boolean(new_expr.data.n, number_to_scaled(cur_exp_value_number) - number_to_scaled(mp_get_value_number(p)));
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ default:
+ mp_bad_binary(mp, p, (int) c);
+ goto DONE;
+ break;
+ }
+ }
+ /* Compare the current expression with zero */
+ if (mp->cur_exp.type != mp_known_type) {
+ const char *hlp = NULL;
+ if (mp->cur_exp.type < mp_known_type) {
+ mp_disp_err(mp, p);
+ hlp = "The quantities shown above have not been equated.";
+ } else {
+ hlp =
+ "Oh dear. I can't decide if the expression above is positive, negative, or zero.\n"
+ "So this comparison test won't be 'true'.";
+ }
+ mp_disp_err(mp, NULL);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ set_number_from_boolean(new_expr.data.n, mp_false_operation);
+ mp_back_error(mp, "Unknown relation will be considered false", hlp);
+ @.Unknown relation...@>
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ int b = 0;
+ switch (c) {
+ case mp_less_than_operation:
+ b = number_negative(cur_exp_value_number);
+ break;
+ case mp_less_or_equal_operation:
+ b = number_nonpositive(cur_exp_value_number);
+ break;
+ case mp_greater_than_operation:
+ b = number_positive(cur_exp_value_number);
+ break;
+ case mp_greater_or_equal_operation:
+ b = number_nonnegative(cur_exp_value_number);
+ break;
+ case mp_equal_operation:
+ b = number_zero(cur_exp_value_number);
+ break;
+ case mp_unequal_operation:
+ b = number_nonzero(cur_exp_value_number);
+ break;
+ };
+ mp_set_cur_exp_value_boolean(mp, b ? mp_true_operation : mp_false_operation);
+ }
+ mp->cur_exp.type = mp_boolean_type;
+ DONE:
+ /* ignore overflow in comparisons */
+ mp->arith_error = 0;
+ break;
+ case mp_and_operation:
+ case mp_or_operation:
+ /* Here we use the sneaky fact that |and_op-false_code=or_op-true_code| */
+ if ((mp_type(p) != mp_boolean_type) || (mp->cur_exp.type != mp_boolean_type)) {
+ mp_bad_binary(mp, p, (int) c);
+ } else if (number_to_boolean(p->data.n) == c + mp_false_operation - mp_and_operation) {
+ mp_set_cur_exp_value_boolean(mp, number_to_boolean(p->data.n));
+ }
+ break;
+ case mp_times_operation:
+ if ((mp->cur_exp.type < mp_color_type) || (mp_type(p) < mp_color_type)) {
+ mp_bad_binary(mp, p, mp_times_operation);
+ } else if ((mp->cur_exp.type == mp_known_type) || (mp_type(p) == mp_known_type)) {
+ /* Multiply when at least one operand is known */
+ mp_number vv;
+ new_fraction(vv);
+ if (mp_type(p) == mp_known_type) {
+ number_clone(vv, mp_get_value_number(p));
+ mp_free_value_node(mp, p);
+ } else {
+ number_clone(vv, cur_exp_value_number);
+ mp_unstash_cur_exp(mp, p);
+ }
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, cur_exp_value_number, vv);
+ mp_set_cur_exp_value_number(mp, &ret);
+ free_number(ret);
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ mp_dep_mult(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &vv, 1);
+ }
+ break;
+ default:
+ {
+ mp_dep_mult(mp, NULL, &vv, 1);
+ }
+ break;
+ }
+ free_number(vv);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ } else if ((mp_nice_color_or_pair(mp, p, mp_type(p)) && (mp->cur_exp.type > mp_pair_type))
+ || (mp_nice_color_or_pair(mp, cur_exp_node, mp->cur_exp.type) && (mp_type(p) > mp_pair_type))) {
+ mp_hard_times(mp, p);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ } else {
+ mp_bad_binary(mp, p, mp_times_operation);
+ }
+ break;
+ case mp_over_operation:
+ if ((mp->cur_exp.type != mp_known_type) || (mp_type(p) < mp_color_type)) {
+ mp_bad_binary(mp, p, mp_over_operation);
+ } else {
+ mp_number v_n;
+ new_number_clone(v_n, cur_exp_value_number);
+ mp_unstash_cur_exp(mp, p);
+ if (number_zero(v_n)) {
+ /* Squeal about division by zero */
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Division by zero",
+ "You're trying to divide the quantity shown above the error message by zero. I'm\n"
+ "going to divide it by one instead."
+ );
+ mp_get_x_next(mp);
+ } else {
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, cur_exp_value_number, v_n);
+ mp_set_cur_exp_value_number(mp, &ret);
+ free_number(ret);
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_dep_div(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &v_n);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_dep_div(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &v_n);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_dep_div(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &v_n);
+ mp_dep_div(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &v_n);
+ }
+ break;
+ default:
+ {
+ mp_dep_div(mp, NULL, &v_n);
+ }
+ break;
+ }
+ }
+ free_number(v_n);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ }
+ break;
+ case mp_power_operation:
+ if ((mp->cur_exp.type == mp_known_type) && (mp_type(p) == mp_known_type)) {
+ mp_number r;
+ new_number(r);
+ power_of(r, mp_get_value_number(p), cur_exp_value_number);
+ check_arith();
+ mp_set_cur_exp_value_number(mp, &r);
+ free_number(r);
+ } else
+ mp_bad_binary(mp, p, (int) c);
+ break;
+ case mp_pythag_add_operation:
+ case mp_pythag_sub_operation:
+ if ((mp->cur_exp.type == mp_known_type) && (mp_type(p) == mp_known_type)) {
+ mp_number r;
+ new_number(r);
+ if (c == mp_pythag_add_operation) {
+ pyth_add(r, mp_get_value_number(p), cur_exp_value_number);
+ } else {
+ pyth_sub(r, mp_get_value_number(p), cur_exp_value_number);
+ }
+ mp_set_cur_exp_value_number(mp, &r);
+ free_number(r);
+ } else
+ mp_bad_binary(mp, p, (int) c);
+ break;
+ case mp_rotated_operation:
+ case mp_slanted_operation:
+ case mp_scaled_operation:
+ case mp_shifted_operation:
+ case mp_transformed_operation:
+ case mp_x_scaled_operation:
+ case mp_y_scaled_operation:
+ case mp_z_scaled_operation:
+ /*
+ The next few sections of the program deal with affine transformations
+ of coordinate data.
+ */
+ switch (mp_type(p)) {
+ case mp_path_type:
+ mp_set_up_known_trans(mp, (int) c);
+ mp_unstash_cur_exp(mp, p);
+ mp_do_path_trans(mp, cur_exp_knot);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ case mp_pen_type:
+ mp_set_up_known_trans(mp, (int) c);
+ mp_unstash_cur_exp(mp, p);
+ mp_do_pen_trans(mp, cur_exp_knot);
+ /* rounding error could destroy convexity */
+ mp_set_cur_exp_knot(mp, mp_convex_hull(mp, cur_exp_knot));
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ case mp_nep_type:
+ mp_set_up_known_trans(mp, (int) c);
+ mp_unstash_cur_exp(mp, p);
+ mp_do_pen_trans(mp, cur_exp_knot);
+ mp_set_cur_exp_knot(mp, cur_exp_knot);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ case mp_pair_type:
+ case mp_transform_type:
+ mp_big_trans(mp, p, (int) c);
+ break;
+ case mp_picture_type:
+ mp_do_edges_trans(mp, p, (int) c);
+ mp_finish_binary(mp, old_p, old_exp);
+ return;
+ default:
+ mp_bad_binary(mp, p, (int) c);
+ break;
+ }
+ break;
+ case mp_concatenate_operation:
+ case mp_just_append_operation:
+ if ((mp->cur_exp.type == mp_string_type) && (mp_type(p) == mp_string_type)) {
+ mp_string str = mp_cat(mp, mp_get_value_str(p), cur_exp_str);
+ delete_str_ref(cur_exp_str) ;
+ mp_set_cur_exp_str(mp, str);
+ } else {
+ mp_bad_binary(mp, p, c);
+ }
+ break;
+ case mp_substring_operation:
+ if (mp_nice_pair(mp, p, mp_type(p)) && (mp->cur_exp.type == mp_string_type)) {
+ mp_string str = mp_chop_string (mp,
+ cur_exp_str,
+ round_unscaled(mp_get_value_number(mp_x_part(mp_get_value_node(p)))),
+ round_unscaled(mp_get_value_number(mp_y_part(mp_get_value_node(p))))
+ );
+ delete_str_ref(cur_exp_str) ;
+ mp_set_cur_exp_str(mp, str);
+ } else {
+ mp_bad_binary(mp, p, mp_substring_operation);
+ }
+ break;
+ case mp_subpath_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp_nice_pair(mp, p, mp_type(p)) && (mp->cur_exp.type == mp_path_type)) {
+ mp_chop_path(mp, mp_get_value_node(p));
+ } else {
+ mp_bad_binary(mp, p, mp_subpath_operation);
+ }
+ break;
+ case mp_point_operation:
+ case mp_precontrol_operation:
+ case mp_postcontrol_operation:
+ case mp_direction_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type)) {
+ mp_find_point(mp, &(mp_get_value_number(p)), (int) c);
+ } else {
+ mp_bad_binary(mp, p, c);
+ }
+ break;
+ case mp_pen_offset_operation:
+ if ((mp->cur_exp.type == mp_pen_type || mp->cur_exp.type == mp_nep_type) && mp_nice_pair(mp, p, mp_type(p))) {
+ mp_set_up_offset(mp, mp_get_value_node(p));
+ } else {
+ mp_bad_binary(mp, p, mp_pen_offset_operation);
+ }
+ break;
+ case mp_direction_time_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && mp_nice_pair(mp, p, mp_type(p))) {
+ mp_set_up_direction_time(mp, mp_get_value_node(p));
+ } else {
+ mp_bad_binary(mp, p, mp_direction_time_operation);
+ }
+ break;
+ case mp_envelope_operation:
+ if ((mp_type(p) != mp_pen_type && mp_type(p) != mp_nep_type) || (mp->cur_exp.type != mp_path_type)) {
+ mp_bad_binary(mp, p, mp_envelope_operation);
+ } else {
+ mp_set_up_envelope(mp, p);
+ }
+ break;
+ case mp_boundingpath_operation:
+ if ((mp_type(p) != mp_pen_type && mp_type(p) != mp_nep_type) || (mp->cur_exp.type != mp_path_type)) {
+ mp_bad_binary(mp, p, mp_boundingpath_operation);
+ } else {
+ mp_set_up_boundingpath(mp, p);
+ }
+ break;
+ case mp_arc_time_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type)) {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_arc_time(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(p)), 0);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_bad_binary(mp, p, (int) c);
+ }
+ break;
+ case mp_arc_point_operation:
+ /* todo: make a function */
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type || mp_type(p) == mp_pair_type)) {
+ mp_knot k;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (mp_type(p) == mp_pair_type) {
+ mp_knot f = cur_exp_knot;
+ mp_node q = mp_get_value_node(p);
+ mp_number x;
+ new_number_clone(x, mp_get_value_number(mp_x_part(q)));
+ if (number_greater(x, zero_t)) {
+ while (number_greater(x, zero_t)) {
+ f = mp_next_knot(f);
+ number_subtract(x, unity_t);
+ }
+ } else {
+ while (number_less(x, zero_t)) {
+ f = mp_next_knot(f);
+ number_add(x, unity_t);
+ }
+ }
+ k = mp_get_arc_time(mp, &new_expr.data.n, f, &(mp_get_value_number(mp_y_part(q))), 1);
+ free_number(x);
+ } else {
+ k = mp_get_arc_time(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(p)), 1);
+ }
+ if (k) {
+ int toss = 0;
+ if (number_equal(new_expr.data.n, unity_t)) {
+ k = mp_next_knot(k);
+ } else if (! number_equal(new_expr.data.n, zero_t)) {
+ convert_scaled_to_fraction(new_expr.data.n);
+ k = mp_split_cubic_knot(mp, k, &new_expr.data.n);
+ toss = 1;
+ }
+ mp_pair_value(mp, &(k->x_coord), &(k->y_coord));
+ if (toss) {
+ mp_toss_knot(mp, k);
+ }
+ } else {
+ mp_bad_unary(mp, mp_arc_point_operation);
+ }
+ } else {
+ mp_bad_unary(mp, mp_arc_point_operation);
+ }
+ break;
+ case mp_arc_point_list_operation:
+ /* todo: make a function */
+ /*
+ vardef arcpoints_a(expr thepath, cnt) =
+ numeric len ; len := length thepath ;
+ numeric aln ; aln := arclength thepath ;
+ numeric seg ; seg := 0 ;
+ numeric tot ; tot := 0 ;
+ numeric tim ; tim := 0 ;
+ numeric stp ; stp := aln / cnt;
+ numeric acc ; acc := subarclength (0,1) of thepath ;
+ point 0 of thepath
+ for tot = stp step stp until aln :
+ hide(
+ forever :
+ exitif tot < acc ;
+ seg := seg + 1 ;
+ tim := acc ;
+ acc := acc + subarclength (seg,seg+1) of thepath ;
+ endfor ;
+ )
+ -- (arcpoint (seg,tot-tim) of thepath)
+ endfor if cycle thepath : -- cycle fi
+ enddef ;
+ */
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && mp_type(p) == mp_known_type) {
+ // we can consider using ints as we have discrete points
+ mp_knot cur = cur_exp_knot;
+ mp_number len, aln, seg, tot, tim, stp, acc, tmp;
+ mp_knot last = NULL;
+ mp_knot list = NULL;
+ int iscycle = mp_left_type(cur_exp_knot) == mp_explicit_knot;
+ new_number(len);
+ mp_path_length(mp, &len);
+ new_number(aln);
+ mp_get_arc_length(mp, &aln, cur_exp_knot);
+ new_number(seg);
+ new_number(tot);
+ new_number(tim);
+ new_number(stp);
+ set_number_from_div(stp, aln, mp_get_value_number(p));
+ new_number(acc);
+ mp_get_subarc_length(mp, &acc, cur_exp_knot, &zero_t, &unity_t);
+ /* */
+ new_number(tmp);
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ /* first point */
+ list = mp_complex_knot(mp, cur_exp_knot);
+ mp_prev_knot(list) = list;
+ mp_next_knot(list) = list;
+ last = list;
+ /* second and following points */
+ number_clone(tot, stp);
+ while (number_lessequal(tot, aln)) {
+ mp_knot k;
+ while (1) {
+ if (number_lessequal(tot, acc)) {
+ break;
+ } else {
+ number_add(seg, unity_t);
+ number_clone(tim, acc);
+ cur = mp_next_knot(cur);
+ mp_get_subarc_length(mp, &tmp, cur, &zero_t, &unity_t);
+ number_add(acc, tmp) ;
+ }
+ }
+ /* still from the start, can be improved with offset */
+ number_clone(tmp, tot);
+ number_subtract(tmp, tim);
+ k = mp_get_arc_time(mp, &new_expr.data.n, cur, &tmp, 1);
+ /* */
+ if (k) {
+ int toss = 0;
+ mp_knot kk;
+ if (number_equal(new_expr.data.n, unity_t)) {
+ k = mp_next_knot(k);
+ } else if (! number_equal(new_expr.data.n, zero_t)) {
+ convert_scaled_to_fraction(new_expr.data.n);
+ k = mp_split_cubic_knot(mp, k, &new_expr.data.n);
+ toss = 1;
+ }
+ kk = mp_complex_knot(mp, k);
+ mp_prev_knot(list) = kk;
+ mp_next_knot(kk) = list;
+ mp_prev_knot(kk) = last;
+ mp_next_knot(last) = kk;
+ last = kk;
+ if (toss) {
+ mp_toss_knot(mp, k);
+ }
+ number_add(tot, stp);
+ } else {
+ break;
+ }
+ }
+
+ free_number(len);
+ free_number(aln);
+ free_number(seg);
+ free_number(tot);
+ free_number(tim);
+ free_number(stp);
+ free_number(acc);
+ free_number(tmp);
+ if (list) {
+ if (iscycle) {
+ mp_left_type(list) = mp_explicit_knot;
+ mp_right_type(last) = mp_explicit_knot;
+ } else {
+ mp_left_type(list) = mp_endpoint_knot;
+ mp_right_type(last) = mp_endpoint_knot;
+ }
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, list);
+ } else {
+ mp_bad_unary(mp, mp_arc_point_list_operation);
+ }
+ } else {
+ mp_bad_unary(mp, mp_arc_point_list_operation);
+ }
+ break;
+ case mp_subarc_length_operation:
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && mp_type(p) == mp_pair_type) {
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_node q = mp_get_value_node(p);
+ mp_get_subarc_length(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(mp_x_part(q))), &(mp_get_value_number(mp_y_part(q))));
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_bad_unary(mp, mp_subarc_length_operation);
+ }
+ break;
+ case mp_intertimes_operation:
+ case mp_intertimes_list_operation:
+ if (mp_type(p) == mp_pair_type) {
+ mp_node q = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, p);
+ mp_pair_to_path(mp);
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, q);
+ }
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_path_type)) {
+ if (c == mp_intertimes_operation) {
+ // mp_number arg1, arg2;
+ // mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 0, NULL);
+ // new_number_clone(arg1, mp->cur_t);
+ // new_number_clone(arg2, mp->cur_tt);
+ // mp_pair_value(mp, &arg1, &arg2);
+ // free_number(arg1);
+ // free_number(arg2);
+ mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 0, NULL);
+ mp_pair_value(mp, &mp->cur_t, &mp->cur_tt);
+ } else {
+ mp_knot last = NULL;
+ mp_knot list = mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 1, &last);
+ mp_left_type(list) = mp_endpoint_knot;
+ mp_right_type(last) = mp_endpoint_knot;
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, list);
+ }
+ } else {
+ mp_bad_binary(mp, p, c);
+ }
+ break;
+ }
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p); /* |return| to avoid this */
+ mp_finish_binary(mp, old_p, old_exp);
+}
+
+@ @<Declare binary action...@>=
+static void mp_bad_binary (MP mp, mp_node p, int c)
+{
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ if (c >= mp_min_of_operation) {
+ mp_print_op(mp, c);
+ }
+ mp_print_known_or_unknown_type(mp, mp_type(p), p);
+ if (c >= mp_min_of_operation) {
+ mp_print_str(mp, "of");
+ } else {
+ mp_print_op(mp, c);
+ }
+ mp_print_known_or_unknown_type(mp, mp->cur_exp.type, cur_exp_node);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Not implemented: %s", mp_str(mp, sname));
+ @.Not implemented...@>
+ delete_str_ref(sname);
+ mp_disp_err(mp, p);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ msg,
+ "I'm afraid I don't know how to apply that operation to that combination of types.\n"
+ "Continue, and I'll return the second argument (see above) as the result of the"
+ "operation."
+ );
+ mp_get_x_next(mp);
+}
+
+static void mp_bad_envelope_pen (MP mp)
+{
+ mp_disp_err(mp, NULL);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not implemented: 'envelope(elliptical pen) of (path)'",
+ "I'm afraid I don't know how to apply that operation to that combination of types.\n"
+ "Continue, and I'll return the second argument (see above) as the result of the\n"
+ "operation."
+ );
+ @.Not implemented...@>
+ mp_get_x_next(mp);
+}
+
+@ @<Declare binary action...@>=
+static mp_node mp_tarnished (MP mp, mp_node p)
+{
+ mp_node q = mp_get_value_node(p);
+ (void) mp;
+ switch (mp_type(p)) {
+ case mp_pair_type:
+ return (
+ (mp_type(mp_x_part(q)) == mp_independent_type) ||
+ (mp_type(mp_y_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ case mp_color_type:
+ return (
+ (mp_type(mp_red_part(q)) == mp_independent_type) ||
+ (mp_type(mp_green_part(q)) == mp_independent_type) ||
+ (mp_type(mp_blue_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ case mp_cmykcolor_type:
+ return (
+ (mp_type(mp_cyan_part(q)) == mp_independent_type) ||
+ (mp_type(mp_magenta_part(q)) == mp_independent_type) ||
+ (mp_type(mp_yellow_part(q)) == mp_independent_type) ||
+ (mp_type(mp_black_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ case mp_transform_type:
+ return (
+ (mp_type(mp_tx_part(q)) == mp_independent_type) ||
+ (mp_type(mp_ty_part(q)) == mp_independent_type) ||
+ (mp_type(mp_xx_part(q)) == mp_independent_type) ||
+ (mp_type(mp_xy_part(q)) == mp_independent_type) ||
+ (mp_type(mp_yx_part(q)) == mp_independent_type) ||
+ (mp_type(mp_yy_part(q)) == mp_independent_type)
+ ) ? MP_VOID : NULL;
+ default:
+ return NULL;
+ }
+}
+
+@ The first argument to |add_or_subtract| is the location of a value node in a
+capsule or pair node that will soon be recycled. The second argument is either a
+location within a pair or transform node of |cur_exp|, or it is NULL (which means
+that |cur_exp| itself should be the second argument). The third argument is
+either |plus| or |minus|.
+
+The sum or difference of the numeric quantities will replace the second operand.
+Arithmetic overflow may go undetected; users aren't supposed to be monkeying
+around with really big values. @^overflow in arithmetic@>
+
+@<Declare binary action...@>=
+@<Declare the procedure called |dep_finish|@>
+static void mp_add_or_subtract (MP mp, mp_node p, mp_node q, int c)
+{
+ mp_variable_type s, t; /* operand types */
+ mp_value_node r; /* dependency list traverser */
+ mp_value_node v = NULL; /* second operand value for dep lists */
+ mp_number vv; /* second operand value for known values */
+ new_number(vv);
+ if (q == NULL) {
+ t = mp->cur_exp.type;
+ if (t < mp_dependent_type) {
+ number_clone(vv, cur_exp_value_number);
+ } else {
+ v = (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node);
+ }
+ } else {
+ t = mp_type(q);
+ if (t < mp_dependent_type) {
+ number_clone(vv, mp_get_value_number(q));
+ } else {
+ v = (mp_value_node) mp_get_dep_list((mp_value_node) q);
+ }
+ }
+ if (t == mp_known_type) {
+ mp_value_node qq = (mp_value_node) q;
+ if (c == mp_minus_operation) {
+ number_negate(vv);
+ }
+ if (mp_type(p) == mp_known_type) {
+ slow_add(vv, mp_get_value_number(p), vv);
+ if (q == NULL) {
+ mp_set_cur_exp_value_number(mp, &vv);
+ } else {
+ mp_set_value_number(q, vv);
+ }
+ free_number(vv);
+ return;
+ } else {
+ /* Add a known value to the constant term of |mp_get_dep_list(p)| */
+ r = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ while (mp_get_dep_info(r) != NULL) {
+ r = (mp_value_node) mp_link(r);
+ }
+ slow_add(vv, mp_get_dep_value(r), vv);
+ mp_set_dep_value(r, vv);
+ if (qq == NULL) {
+ qq = mp_get_dep_node(mp);
+ mp_set_cur_exp_node(mp, (mp_node) qq);
+ mp->cur_exp.type = mp_type(p);
+ mp_name_type(qq) = mp_capsule_operation;
+ /* clang: never read: |q = (mp_node) qq;| */
+ }
+ mp_set_dep_list(qq, mp_get_dep_list((mp_value_node) p));
+ mp_type(qq) = mp_type(p);
+ mp_set_prev_dep(qq, mp_get_prev_dep((mp_value_node) p));
+ mp_link(mp_get_prev_dep((mp_value_node) p)) = (mp_node) qq;
+ mp_type(p) = mp_known_type; /* this will keep the recycler from collecting non-garbage */
+ }
+ } else {
+ if (c == mp_minus_operation) {
+ mp_negate_dep_list(mp, v);
+ }
+ /*
+ Add operand |p| to the dependency list |v|. We prefer |dependent| lists to
+ |mp_proto_dependent| ones, because it is nice to retain the extra accuracy
+ of |fraction| coefficients. But we have to handle both kinds, and mixtures
+ too.
+ */
+ if (mp_type(p) == mp_known_type) {
+ /* Add the known |value(p)| to the constant term of |v| */
+ while (mp_get_dep_info(v) != NULL) {
+ v = (mp_value_node) mp_link(v);
+ }
+ slow_add(vv, mp_get_value_number(p), mp_get_dep_value(v));
+ mp_set_dep_value(v, vv);
+ } else {
+ s = mp_type(p);
+ r = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ if (t == mp_dependent_type) {
+ if (s == mp_dependent_type) {
+ int b;
+ mp_number ret1, ret2;
+ new_fraction(ret1);
+ new_fraction(ret2);
+ mp_max_coef(mp, &ret1, r);
+ mp_max_coef(mp, &ret2, v);
+ number_add(ret1, ret2);
+ b = number_less(ret1, coef_bound_k);
+ free_number(ret1);
+ free_number(ret2);
+ if (b) {
+ v = mp_p_plus_q(mp, v, r, mp_dependent_type);
+ goto DONE;
+ }
+ } /* |fix_needed| will necessarily be false */
+ t = mp_proto_dependent_type;
+ v = mp_p_over_v(mp, v, &unity_t, mp_dependent_type, mp_proto_dependent_type);
+ }
+ if (s == mp_proto_dependent_type) {
+ v = mp_p_plus_q(mp, v, r, mp_proto_dependent_type);
+ } else {
+ v = mp_p_plus_fq(mp, v, &unity_t, r, mp_proto_dependent_type, mp_dependent_type);
+ }
+ DONE:
+ /* Output the answer, |v| (which might have become |known|) */
+ if (q != NULL) {
+ mp_dep_finish(mp, v, (mp_value_node) q, t);
+ } else {
+ mp->cur_exp.type = t;
+ mp_dep_finish(mp, v, NULL, t);
+ }
+ }
+ }
+ free_number(vv);
+}
+
+@ Here's the current situation: The dependency list |v| of type |t| should either
+be put into the current expression (if |q=NULL|) or into location |q| within a
+pair node (otherwise). The destination (|cur_exp| or |q|) formerly held a
+dependency list with the same final pointer as the list |v|.
+
+@<Declare the procedure called |dep_finish|@>=
+static void mp_dep_finish (MP mp, mp_value_node v, mp_value_node q, int t)
+{
+ mp_value_node p = (q == NULL) ? (mp_value_node) cur_exp_node : q; /* the destination */
+ mp_set_dep_list(p, v);
+ mp_type(p) = t;
+ if (mp_get_dep_info(v) == NULL) {
+ mp_number vv; /* the value, if it is |known| */
+ new_number_clone(vv, mp_get_value_number(v));
+ if (q == NULL) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number_clone(new_expr.data.n, vv);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_recycle_value(mp, (mp_node) p);
+ mp_type(q) = mp_known_type;
+ mp_set_value_number(q, vv);
+ }
+ free_number(vv);
+ } else if (q == NULL) {
+ mp->cur_exp.type = t;
+ }
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+}
+
+@ @<Declare binary action...@>=
+static void mp_dep_mult (MP mp, mp_value_node p, mp_number *v, int v_is_scaled)
+{
+ mp_value_node q; /* the dependency list being multiplied by |v| */
+ int s, t; /* its type, before and after */
+ if (p == NULL) {
+ q = (mp_value_node) cur_exp_node;
+ } else if (mp_type(p) != mp_known_type) {
+ q = p;
+ } else {
+ mp_number r1, arg1;
+ new_number_clone(arg1, mp_get_dep_value(p));
+ if (v_is_scaled) {
+ new_number(r1);
+ take_scaled(r1, arg1, *v);
+ } else {
+ new_fraction(r1);
+ take_fraction(r1, arg1, *v);
+ }
+ mp_set_dep_value(p, r1);
+ free_number(r1);
+ free_number(arg1);
+ return;
+ }
+ t = mp_type(q);
+ q = (mp_value_node) mp_get_dep_list(q);
+ s = t;
+ if (t == mp_dependent_type && v_is_scaled) {
+ mp_number arg1, arg2;
+ new_fraction(arg1);
+ mp_max_coef(mp, &arg1, q);
+ new_number_abs(arg2, *v);
+ if (ab_vs_cd(arg1, arg2, coef_bound_minus_1, unity_t) >= 0) {
+ t = mp_proto_dependent_type;
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ q = mp_p_times_v(mp, q, v, s, t, v_is_scaled);
+ mp_dep_finish(mp, q, p, t);
+}
+
+@ Here is a routine that is similar to |times|; but it is invoked only
+internally, when |v| is a |fraction| whose magnitude is at most~1, and when
+|cur_type >= mp_color_type|.
+
+@c
+static void mp_frac_mult (MP mp, mp_number *n, mp_number *d)
+{
+ /* multiplies |cur_exp| by |n/d| */
+ mp_node old_exp; /* a capsule to recycle */
+ mp_number v; /* |n/d| */
+ new_fraction(v);
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ @<Trace the fraction multiplication@>
+ }
+ switch (mp->cur_exp.type) {
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ old_exp = mp_tarnished(mp, cur_exp_node);
+ break;
+ case mp_independent_type:
+ old_exp = MP_VOID;
+ break;
+ default:
+ old_exp = NULL;
+ break;
+ }
+ if (old_exp != NULL) {
+ old_exp = cur_exp_node;
+ mp_make_exp_copy(mp, old_exp);
+ }
+ make_fraction(v, *n, *d);
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ mp_number r1, arg1;
+ new_fraction(r1);
+ new_number_clone(arg1, cur_exp_value_number);
+ take_fraction(r1, arg1, v);
+ mp_set_cur_exp_value_number(mp, &r1);
+ free_number(r1);
+ free_number(arg1);
+ }
+ break;
+ case mp_pair_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_dep_mult(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ mp_dep_mult(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &v, 0);
+ }
+ break;
+ default:
+ {
+ mp_dep_mult(mp, NULL, &v, 0);
+ }
+ break;
+ }
+ if (old_exp != NULL) {
+ mp_recycle_value(mp, old_exp);
+ mp_free_value_node(mp, old_exp);
+ }
+ free_number(v);
+}
+
+@ @<Trace the fraction multiplication@>=
+mp_begin_diagnostic(mp);
+mp_print_nl(mp, "{(");
+print_number(*n);
+mp_print_chr(mp, '/');
+print_number(*d);
+mp_print_str(mp, ")*(");
+mp_print_exp(mp, NULL, 0);
+mp_print_str(mp, ")}");
+mp_end_diagnostic(mp, 0);
+
+@ The |hard_times| routine multiplies a nice color or pair by a dependency list.
+
+@<Declare binary action procedures@>=
+static void mp_hard_times (MP mp, mp_node p)
+{
+ mp_value_node q; /* a copy of the dependent variable |p| */
+ mp_value_node pp; /* for typecasting p */
+ mp_number v; /* the known value for |r| */
+ new_number(v);
+ if (mp_type(p) <= mp_pair_type) {
+ q = (mp_value_node) mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, p);
+ p = (mp_node) q;
+ }
+ /* now |cur_type=mp_pair_type| or |cur_type=mp_color_type| or |cur_type=mp_cmykcolor_type| */
+ pp = (mp_value_node) p;
+ switch (mp->cur_exp.type) {
+ case mp_pair_type:
+ {
+ mp_node r = mp_x_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_y_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ }
+ break;
+ case mp_color_type:
+ {
+ mp_node r = mp_red_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_green_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_blue_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ mp_node r = mp_cyan_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_yellow_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_magenta_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ r = mp_black_part(mp_get_value_node(cur_exp_node));
+ number_clone(v, mp_get_value_number(r));
+ mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp)));
+ mp_dep_mult(mp, (mp_value_node) r, &v, 1);
+ }
+ break;
+ default:
+ break;
+ }
+ free_number(v);
+}
+
+@ @<Declare binary action...@>=
+static void mp_dep_div (MP mp, mp_value_node p, mp_number *v)
+{
+ mp_value_node q; /* the dependency list being divided by |v| */
+ int s, t; /* its type, before and after */
+ if (p == NULL) {
+ q = (mp_value_node) cur_exp_node;
+ } else if (mp_type(p) != mp_known_type) {
+ q = p;
+ } else {
+ mp_number ret;
+ new_number(ret);
+ make_scaled(ret, mp_get_value_number(p), *v);
+ mp_set_value_number(p, ret);
+ free_number(ret);
+ return;
+ }
+ t = mp_type(q);
+ q = (mp_value_node) mp_get_dep_list(q);
+ s = t;
+ if (t == mp_dependent_type) {
+ mp_number arg1, arg2;
+ new_number(arg2);
+ new_fraction(arg1);
+ mp_max_coef(mp, &arg1, q);
+ number_abs_clone(arg2, *v);
+ if (ab_vs_cd(arg1, unity_t, coef_bound_minus_1, arg2) >= 0) {
+ t = mp_proto_dependent_type;
+ }
+ free_number(arg1);
+ free_number(arg2);
+ }
+ q = mp_p_over_v(mp, q, v, s, t);
+ mp_dep_finish(mp, q, p, t);
+}
+
+@ Let |c| be one of the eight transform operators. The procedure call
+|set_up_trans(c)| first changes |cur_exp| to a transform that corresponds to |c|
+and the original value of |cur_exp|. (In particular, |cur_exp| doesn't change at
+all if |c=transformed_by|.)
+
+Then, if all components of the resulting transform are |known|, they are moved to
+the global variables |txx|, |txy|, |tyx|, |tyy|, |tx|, |ty|; and |cur_exp| is
+changed to the known value zero.
+
+@<Declare binary action...@>=
+static void mp_set_up_trans (MP mp, int c)
+{
+ mp_node p, q, r; /* list manipulation registers */
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ if ((c != mp_transformed_operation) || (mp->cur_exp.type != mp_transform_type)) {
+ /* Put the current transform into |cur_exp| */
+ p = mp_stash_cur_exp(mp);
+ mp_set_cur_exp_node(mp, mp_id_transform(mp));
+ mp->cur_exp.type = mp_transform_type;
+ q = mp_get_value_node(cur_exp_node);
+ @<For each of the eight cases, change the relevant fields of |cur_exp| and |goto done|; but do nothing if capsule |p| doesn't have the appropriate type@>
+ mp_disp_err(mp, p);
+ mp_back_error(
+ mp,
+ "Improper transformation argument",
+ "The expression shown above has the wrong type, so I can't transform anything\n"
+ "using it. Proceed, and I'll omit the transformation."
+ );
+ mp_get_x_next(mp);
+ DONE:
+ mp_recycle_value(mp, p);
+ mp_free_value_node(mp, p);
+ }
+ /*
+ If the current transform is entirely known, stash it in global variables;
+ otherwise |return|
+ */
+ q = mp_get_value_node(cur_exp_node);
+ if ( (mp_type(mp_tx_part(q)) == mp_known_type) &&
+ (mp_type(mp_ty_part(q)) == mp_known_type) &&
+ (mp_type(mp_xx_part(q)) == mp_known_type) &&
+ (mp_type(mp_xy_part(q)) == mp_known_type) &&
+ (mp_type(mp_yx_part(q)) == mp_known_type) &&
+ (mp_type(mp_yy_part(q)) == mp_known_type) ) {
+ number_clone(mp->txx, mp_get_value_number(mp_xx_part(q)));
+ number_clone(mp->txy, mp_get_value_number(mp_xy_part(q)));
+ number_clone(mp->tyx, mp_get_value_number(mp_yx_part(q)));
+ number_clone(mp->tyy, mp_get_value_number(mp_yy_part(q)));
+ number_clone(mp->tx, mp_get_value_number(mp_tx_part(q)));
+ number_clone(mp->ty, mp_get_value_number(mp_ty_part(q)));
+ new_number(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+
+@ @<Glob...@>=
+mp_number txx;
+mp_number txy;
+mp_number tyx;
+mp_number tyy;
+mp_number tx;
+mp_number ty; /* current transform coefficients */
+
+@ @<Initialize table...@>=
+new_number(mp->txx);
+new_number(mp->txy);
+new_number(mp->tyx);
+new_number(mp->tyy);
+new_number(mp->tx);
+new_number(mp->ty);
+
+@ @<Free table...@>=
+free_number(mp->txx);
+free_number(mp->txy);
+free_number(mp->tyx);
+free_number(mp->tyy);
+free_number(mp->tx);
+free_number(mp->ty);
+
+@ @<For each of the eight cases...@>=
+switch (c) {
+ case mp_rotated_operation:
+ if (mp_type(p) == mp_known_type) {
+ @<Install sines and cosines, then |goto done|@>
+ }
+ break;
+ case mp_slanted_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_xy_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_scaled_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_xx_part(q), p);
+ mp_install(mp, mp_yy_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_shifted_operation:
+ if (mp_type(p) == mp_pair_type) {
+ r = mp_get_value_node(p);
+ mp_install(mp, mp_tx_part(q), mp_x_part(r));
+ mp_install(mp, mp_ty_part(q), mp_y_part(r));
+ goto DONE;
+ }
+ break;
+ case mp_x_scaled_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_xx_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_y_scaled_operation:
+ if (mp_type(p) > mp_pair_type) {
+ mp_install(mp, mp_yy_part(q), p);
+ goto DONE;
+ }
+ break;
+ case mp_z_scaled_operation:
+ if (mp_type(p) == mp_pair_type) {
+ @<Install a complex multiplier, then |goto done|@>
+ }
+ break;
+ case mp_transformed_operation:
+ break;
+}
+
+@ @<Install sines and cosines, then |goto done|@>=
+mp_number n_sin, n_cos, arg1, arg2;
+new_fraction(n_sin);
+new_fraction(n_cos); /* results computed by |n_sin_cos| */
+new_number_clone(arg2, unity_t);
+new_number_clone(arg1, mp_get_value_number(p));
+number_multiply_int(arg2, 360);
+number_modulo(arg1, arg2);
+convert_scaled_to_angle(arg1);
+n_sin_cos(arg1, n_cos, n_sin);
+fraction_to_round_scaled(n_sin);
+fraction_to_round_scaled(n_cos);
+mp_set_value_number(mp_xx_part(q), n_cos);
+mp_set_value_number(mp_yx_part(q), n_sin);
+mp_set_value_number(mp_xy_part(q), mp_get_value_number(mp_yx_part(q)));
+number_negate(mp_get_value_number(mp_xy_part(q)));
+mp_set_value_number(mp_yy_part(q), mp_get_value_number(mp_xx_part(q)));
+free_number(arg1);
+free_number(arg2);
+free_number(n_sin);
+free_number(n_cos);
+goto DONE;
+
+@ @<Install a complex multiplier, then |goto done|@>=
+{
+ r = mp_get_value_node(p);
+ mp_install(mp, mp_xx_part(q), mp_x_part(r));
+ mp_install(mp, mp_yy_part(q), mp_x_part(r));
+ mp_install(mp, mp_yx_part(q), mp_y_part(r));
+ if (mp_type(mp_y_part(r)) == mp_known_type) {
+ mp_set_value_number(mp_y_part(r), mp_get_value_number(mp_y_part(r)));
+ number_negate(mp_get_value_number(mp_y_part(r)));
+ } else {
+ mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) mp_y_part(r)));
+ }
+ mp_install(mp, mp_xy_part(q), mp_y_part(r));
+ goto DONE;
+}
+
+@ Procedure |set_up_known_trans| is like |set_up_trans|, but it
+insists that the transformation be entirely known.
+
+@<Declare binary action...@>=
+static void mp_set_up_known_trans (MP mp, int c)
+{
+ mp_set_up_trans(mp, c);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Transform components aren't all known",
+ "I'm unable to apply a partially specified transformation except to a fully known\n"
+ "pair or transform. Proceed, and I'll omit the transformation."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ set_number_to_unity(mp->txx);
+ set_number_to_zero(mp->txy);
+ set_number_to_zero(mp->tyx);
+ set_number_to_unity(mp->tyy);
+ set_number_to_zero(mp->tx);
+ set_number_to_zero(mp->ty);
+ }
+}
+
+@ Here's a procedure that applies the transform |txx..ty| to a pair of
+coordinates in locations |p| and~|q|.
+
+@<Declare binary action...@>=
+static void mp_number_trans (MP mp, mp_number *p, mp_number *q)
+{
+ mp_number r1, r2, v;
+ new_number(r1);
+ new_number(r2);
+ new_number(v);
+ take_scaled(r1, *p, mp->txx);
+ take_scaled(r2, *q, mp->txy);
+ number_add(r1, r2);
+ set_number_from_addition(v, r1, mp->tx);
+ take_scaled(r1, *p, mp->tyx);
+ take_scaled(r2, *q, mp->tyy);
+ number_add(r1, r2);
+ set_number_from_addition(*q, r1, mp->ty);
+ number_clone(*p,v);
+ free_number(r1);
+ free_number(r2);
+ free_number(v);
+}
+
+@ The simplest transformation procedure applies a transform to all
+coordinates of a path. The |path_trans(c)(p)| macro applies
+a transformation defined by |cur_exp| and the transform operator |c|
+to the path~|p|. The macro was used only once and has been inlined.
+
+@<Declare binary action...@>=
+static void mp_do_path_trans (MP mp, mp_knot p)
+{
+ mp_knot q = p;
+ do {
+ if (mp_left_type(q) != mp_endpoint_knot) {
+ mp_number_trans(mp, &q->left_x, &q->left_y);
+ }
+ mp_number_trans(mp, &q->x_coord, &q->y_coord);
+ if (mp_right_type(q) != mp_endpoint_knot) {
+ mp_number_trans(mp, &q->right_x, &q->right_y);
+ }
+ q = mp_next_knot(q);
+ } while (q != p);
+}
+
+@ Transforming a pen is very similar, except that there are no |mp_left_type|
+and |mp_right_type| fields.
+
+@<Declare binary action...@>=
+static void mp_do_pen_trans (MP mp, mp_knot p)
+{
+ mp_knot q = p; /* list traverser */
+ if (mp_pen_is_elliptical(p)) {
+ mp_number_trans(mp, &p->left_x, &p->left_y);
+ mp_number_trans(mp, &p->right_x, &p->right_y);
+ }
+ do {
+ mp_number_trans(mp, &q->x_coord, &q->y_coord);
+ q = mp_next_knot(q);
+ } while (q != p);
+}
+
+@ Note that the shift parameters |(tx,ty)| apply only to the path being stroked.
+The |dashscale| has to be adjusted to scale the dash lengths in |mp_dash_ptr(q)|
+since the \ps\ output procedures will try to compensate for the transformation we
+are applying to |mp_pen_ptr(q)|. Since this compensation is based on the square
+root of the determinant, |sqdet| is the appropriate factor.
+
+@<Declare binary action...@>=
+static void mp_do_path_pen_trans (MP mp, mp_shape_node p, mp_number *sqdet, int sgndet)
+{
+ mp_number sx, sy;
+ if (mp_pen_ptr(p) != NULL) {
+ new_number_clone(sx, mp->tx);
+ new_number_clone(sy, mp->ty);
+ set_number_to_zero(mp->tx);
+ set_number_to_zero(mp->ty);
+ mp_do_pen_trans(mp, mp_pen_ptr(p));
+ if (number_nonzero(*sqdet) && ((mp_type(p) == mp_stroked_node_type) && (mp_dash_ptr(p) != NULL))) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, ((mp_shape_node) p)->dashscale, *sqdet);
+ number_clone(((mp_shape_node) p)->dashscale, ret);
+ free_number(ret);
+ }
+ if (! mp_pen_is_elliptical(mp_pen_ptr(p)) && sgndet < 0) {
+ mp_pen_ptr(p) = mp_make_pen(mp, mp_copy_path(mp, mp_pen_ptr(p)), 1);
+ }
+ number_clone(mp->tx, sx);
+ number_clone(mp->ty, sy);
+ free_number(sx);
+ free_number(sy);
+ }
+}
+
+@ The next transformation procedure applies to edge structures. It will do any
+transformation, but the results may be substandard if the picture contains text
+that uses downloaded bitmap fonts. The binary action procedure is
+|do_edges_trans|, but we also need a function that just scales a picture. That
+routine is |scale_edges|. Both it and the underlying routine |edges_trans| should
+be thought of as procedures that update an edge structure |h|, except that they
+have to return a (possibly new) structure because of the need to call
+|private_edges|.
+
+@<Declare binary action...@>=
+static mp_edge_header_node mp_edges_trans (MP mp, mp_edge_header_node h)
+{
+ mp_node q; /* the object being transformed */
+ mp_dash_node r, s; /* for list manipulation */
+ mp_number sqdet; /* square root of determinant for |dashscale| */
+ int sgndet; /* sign of the determinant */
+ h = mp_private_edges(mp, h);
+ new_number(sqdet);
+ mp_sqrt_det(mp, &sqdet, &(mp->txx), &(mp->txy), &(mp->tyx), &(mp->tyy));
+ sgndet = ab_vs_cd(mp->txx, mp->tyy, mp->txy, mp->tyx);
+ if (mp_get_dash_list(h) != mp->null_dash) {
+ @<Try to transform the dash list of |h|@>
+ }
+ @<Make the bounding box of |h| unknown if it can't be updated properly without scanning the whole structure@>
+ q = mp_link(mp_edge_list(h));
+ while (q != NULL) {
+ @<Transform graphical object |q|@>
+ q = mp_link(q);
+ }
+ free_number(sqdet);
+ return h;
+}
+
+static void mp_do_edges_trans (MP mp, mp_node p, int c)
+{
+ mp_set_up_known_trans (mp, c);
+ mp_set_value_node(p, (mp_node) mp_edges_trans(mp, (mp_edge_header_node) mp_get_value_node(p)));
+ mp_unstash_cur_exp(mp, p);
+}
+
+static mp_edge_header_node mp_scale_edges (MP mp, mp_number *se_sf, mp_edge_header_node se_pic)
+{
+ number_clone(mp->txx, *se_sf);
+ number_clone(mp->tyy, *se_sf);
+ set_number_to_zero(mp->txy);
+ set_number_to_zero(mp->tyx);
+ set_number_to_zero(mp->tx);
+ set_number_to_zero(mp->ty);
+ return mp_edges_trans(mp, se_pic);
+}
+
+@ @<Try to transform the dash list of |h|@>=
+if (number_nonzero(mp->txy) || number_nonzero(mp->tyx) || number_nonzero(mp->ty) || number_nonequalabs(mp->txx, mp->tyy)) {
+ mp_flush_dash_list(mp, h);
+} else {
+ mp_number abs_tyy, ret;
+ new_number(abs_tyy);
+ if (number_negative(mp->txx)) {
+ @<Reverse the dash list of |h|@>
+ }
+ @<Scale the dash list by |txx| and shift it by |tx|@>
+ number_abs_clone(abs_tyy, mp->tyy);
+ new_number(ret);
+ take_scaled(ret, h->dash_y, abs_tyy);
+ number_clone(h->dash_y, ret);
+ free_number(ret);
+ free_number(abs_tyy);
+}
+
+@ @<Reverse the dash list of |h|@>=
+{
+ r = mp_get_dash_list(h);
+ mp_set_dash_list(h, mp->null_dash);
+ while (r != mp->null_dash) {
+ s = r;
+ r = (mp_dash_node) mp_link(r);
+ number_swap(s->start_x, s->stop_x );
+ mp_link(s) = (mp_node) mp_get_dash_list(h);
+ mp_set_dash_list(h, s);
+ }
+}
+
+@ @<Scale the dash list by |txx| and shift it by |tx|@>=
+r = mp_get_dash_list(h);
+{
+ mp_number arg1;
+ new_number(arg1);
+ while (r != mp->null_dash) {
+ take_scaled(arg1, r->start_x, mp->txx);
+ set_number_from_addition(r->start_x, arg1, mp->tx);
+ take_scaled(arg1, r->stop_x, mp->txx);
+ set_number_from_addition(r->stop_x, arg1, mp->tx);
+ r = (mp_dash_node) mp_link(r);
+ }
+ free_number(arg1);
+}
+
+@ @<Make the bounding box of |h| unknown if it can't be updated properly...@>=
+if (number_zero(mp->txx) && number_zero(mp->tyy)) {
+ @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>
+} else if (number_nonzero(mp->txy) || number_nonzero(mp->tyx)) {
+ mp_init_bbox(mp, h);
+ goto DONE1;
+}
+if (number_lessequal(h->minx, h->maxx)) {
+ @<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift by |(tx,ty)|@>
+}
+DONE1:
+
+@ @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>=
+number_swap(h->minx, h->miny);
+number_swap(h->maxx, h->maxy);
+
+@ The sum |txx+txy| is whichever of |txx| or |txy| is nonzero. The other sum
+is similar.
+
+@<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift...@>=
+mp_number tot, ret;
+new_number(tot);
+new_number(ret);
+set_number_from_addition(tot,mp->txx,mp->txy);
+take_scaled(ret, h->minx, tot);
+set_number_from_addition(h->minx,ret, mp->tx);
+take_scaled(ret, h->maxx, tot);
+set_number_from_addition(h->maxx,ret, mp->tx);
+
+set_number_from_addition(tot,mp->tyx,mp->tyy);
+take_scaled(ret, h->miny, tot);
+set_number_from_addition(h->miny, ret, mp->ty);
+take_scaled(ret, h->maxy, tot);
+set_number_from_addition(h->maxy, ret, mp->ty);
+set_number_from_addition(tot, mp->txx, mp->txy);
+if (number_negative(tot)) {
+ number_swap(h->minx, h->maxx);
+}
+set_number_from_addition(tot, mp->tyx, mp->tyy);
+if (number_negative(tot)) {
+ number_swap(h->miny, h->maxy);
+}
+free_number(ret);
+free_number(tot);
+
+@ Now we ready for the main task of transforming the graphical objects in edge
+structure~|h|.
+
+@<Transform graphical object |q|@>=
+switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ mp_do_path_trans(mp, mp_path_ptr((mp_shape_node) q));
+ mp_do_path_pen_trans(mp, (mp_shape_node) q, &sqdet, sgndet);
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ mp_do_path_trans(mp, mp_path_ptr((mp_start_node) q));
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ break;
+ default:
+ break;
+}
+
+@ The hard cases of transformation occur when big nodes are involved, and when
+some of their components are unknown.
+
+@<Declare binary action...@>=
+@<Declare subroutines needed by |big_trans|@>
+static void mp_big_trans (MP mp, mp_node p, int c)
+{
+ mp_node q = mp_get_value_node(p);
+ if (mp_type(q) == mp_pair_node_type) {
+ if (mp_type(mp_x_part(q)) != mp_known_type || mp_type(mp_y_part(q)) != mp_known_type) {
+ goto UNKNOWN;
+ }
+ } else if (mp_type(mp_tx_part(q)) != mp_known_type || mp_type(mp_ty_part(q)) != mp_known_type ||
+ mp_type(mp_xx_part(q)) != mp_known_type || mp_type(mp_xy_part(q)) != mp_known_type ||
+ mp_type(mp_yx_part(q)) != mp_known_type || mp_type(mp_yy_part(q)) != mp_known_type) {
+ goto UNKNOWN;
+ }
+ {
+ @<Transform a known big node@>
+ return;
+ }
+ UNKNOWN:
+ {
+ @<Transform an unknown big node and |return|@>
+ return;
+ }
+}
+
+@ @<Transform an unknown big node and |return|@>=
+mp_node r;
+mp_set_up_known_trans(mp, c);
+mp_make_exp_copy(mp, p);
+r = mp_get_value_node(cur_exp_node);
+if (mp->cur_exp.type == mp_transform_type) {
+ mp_bilin1(mp, mp_yy_part(r), &(mp->tyy), mp_xy_part(q), &(mp->tyx), &zero_t);
+ mp_bilin1(mp, mp_yx_part(r), &(mp->tyy), mp_xx_part(q), &(mp->tyx), &zero_t);
+ mp_bilin1(mp, mp_xy_part(r), &(mp->txx), mp_yy_part(q), &(mp->txy), &zero_t);
+ mp_bilin1(mp, mp_xx_part(r), &(mp->txx), mp_yx_part(q), &(mp->txy), &zero_t);
+}
+mp_bilin1(mp, mp_y_part(r), &(mp->tyy), mp_x_part(q), &(mp->tyx), &(mp->ty));
+mp_bilin1(mp, mp_x_part(r), &(mp->txx), mp_y_part(q), &(mp->txy), &(mp->tx));
+
+@ Let |p| point to a value field inside a big node of |cur_exp|, and let |q|
+point to a another value field. The |bilin1| procedure replaces |p| by $p\cdot
+t+q\cdot u+\delta$.
+
+@<Declare subroutines needed by |big_trans|@>=
+static void mp_bilin1 (MP mp, mp_node p, mp_number *t, mp_node q, mp_number *u, mp_number *delta_orig)
+{
+ mp_number delta;
+ new_number_clone(delta, *delta_orig);
+ if (! number_equal(*t, unity_t)) {
+ mp_dep_mult(mp, (mp_value_node) p, t, 1);
+ }
+ if (number_nonzero(*u)) {
+ if (mp_type(q) == mp_known_type) {
+ mp_number tmp;
+ new_number(tmp);
+ take_scaled(tmp, mp_get_value_number(q), *u);
+ number_add(delta, tmp);
+ free_number(tmp);
+ } else {
+ /* Ensure that |type(p)=mp_proto_dependent| */
+ if (mp_type(p) != mp_proto_dependent_type) {
+ if (mp_type(p) == mp_known_type) {
+ mp_new_dep(mp, p, mp_type(p), mp_const_dependency(mp, &(mp_get_value_number(p))));
+ } else {
+ mp_set_dep_list((mp_value_node) p,
+ mp_p_times_v(mp,
+ (mp_value_node) mp_get_dep_list((mp_value_node) p), &unity_t,
+ mp_dependent_type, mp_proto_dependent_type, 1));
+ }
+ mp_type(p) = mp_proto_dependent_type;
+ }
+ mp_set_dep_list((mp_value_node) p,
+ mp_p_plus_fq(mp,
+ (mp_value_node) mp_get_dep_list((mp_value_node) p), u,
+ (mp_value_node) mp_get_dep_list((mp_value_node) q),
+ mp_proto_dependent_type, mp_type(q)));
+ }
+ }
+ if (mp_type(p) == mp_known_type) {
+ mp_set_value_number(p, mp_get_value_number(p));
+ number_add(mp_get_value_number(p), delta);
+ } else {
+ mp_number tmp;
+ mp_value_node r = (mp_value_node) mp_get_dep_list((mp_value_node) p);
+ while (mp_get_dep_info(r) != NULL) {
+ r = (mp_value_node) mp_link(r);
+ }
+ new_number_clone(tmp, mp_get_value_number(r));
+ number_add(delta, tmp);
+ // number_add(delta, mp_get_value_number(r));
+ if (r != (mp_value_node) mp_get_dep_list((mp_value_node) p)) {
+ mp_set_value_number(r, delta);
+ } else {
+ mp_recycle_value(mp, p);
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, delta);
+ }
+ free_number(tmp);
+ }
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ free_number(delta);
+}
+
+@ @<Transform a known big node@>=
+mp_node r, pp, qq; /* list manipulation registers */
+mp_set_up_trans(mp, c);
+if (mp->cur_exp.type == mp_known_type) {
+ /* Transform known by known */
+ mp_make_exp_copy(mp, p);
+ r = mp_get_value_node(cur_exp_node);
+ if (mp->cur_exp.type == mp_transform_type) {
+ mp_bilin3(mp, mp_yy_part(r), &(mp->tyy), &(mp_get_value_number(mp_xy_part(q))), &(mp->tyx), &zero_t);
+ mp_bilin3(mp, mp_yx_part(r), &(mp->tyy), &(mp_get_value_number(mp_xx_part(q))), &(mp->tyx), &zero_t);
+ mp_bilin3(mp, mp_xy_part(r), &(mp->txx), &(mp_get_value_number(mp_yy_part(q))), &(mp->txy), &zero_t);
+ mp_bilin3(mp, mp_xx_part(r), &(mp->txx), &(mp_get_value_number(mp_yx_part(q))), &(mp->txy), &zero_t);
+ }
+ mp_bilin3(mp, mp_y_part(r), &(mp->tyy), &(mp_get_value_number(mp_x_part(q))), &(mp->tyx), &(mp->ty));
+ mp_bilin3(mp, mp_x_part(r), &(mp->txx), &(mp_get_value_number(mp_y_part(q))), &(mp->txy), &(mp->tx));
+} else {
+ pp = mp_stash_cur_exp(mp);
+ qq = mp_get_value_node(pp);
+ mp_make_exp_copy(mp, p);
+ r = mp_get_value_node(cur_exp_node);
+ if (mp->cur_exp.type == mp_transform_type) {
+ mp_bilin2(mp, mp_yy_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_xy_part(q))), mp_yx_part(qq), NULL);
+ mp_bilin2(mp, mp_yx_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_xx_part(q))), mp_yx_part(qq), NULL);
+ mp_bilin2(mp, mp_xy_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_yy_part(q))), mp_xy_part(qq), NULL);
+ mp_bilin2(mp, mp_xx_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_yx_part(q))), mp_xy_part(qq), NULL);
+ }
+ mp_bilin2(mp, mp_y_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_x_part(q))), mp_yx_part(qq), mp_y_part(qq));
+ mp_bilin2(mp, mp_x_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_y_part(q))), mp_xy_part(qq), mp_x_part(qq));
+ mp_recycle_value(mp, pp);
+ mp_free_value_node(mp, pp);
+}
+
+@ Let |p| be a |mp_proto_dependent| value whose dependency list ends at
+|dep_final|. The following procedure adds |v| times another numeric quantity
+to~|p|.
+
+@<Declare subroutines needed by |big_trans|@>=
+static void mp_add_mult_dep (MP mp, mp_value_node p, mp_number *v, mp_node r)
+{
+ if (mp_type(r) == mp_known_type) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, mp_get_value_number(r), *v);
+ mp_set_dep_value(mp->dep_final, mp_get_dep_value(mp->dep_final));
+ number_add(mp_get_dep_value(mp->dep_final), ret);
+ free_number(ret);
+ } else {
+ mp_set_dep_list(p, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(p), v, (mp_value_node) mp_get_dep_list((mp_value_node) r), mp_proto_dependent_type, mp_type(r)));
+ if (mp->fix_needed) {
+ mp_fix_dependencies(mp);
+ }
+ }
+}
+
+@ The |bilin2| procedure is something like |bilin1|, but with known and unknown
+quantities reversed. Parameter |p| points to a value field within the big node
+for |cur_exp|; and |type(p)=mp_known|. Parameters |t| and~|u| point to value
+fields elsewhere; so does parameter~|q|, unless it is |NULL| (which stands for
+zero). Location~|p| will be replaced by $p\cdot t+v\cdot u+q$.
+
+@<Declare subroutines needed by |big_trans|@>=
+static void mp_bilin2 (MP mp, mp_node p, mp_node t, mp_number *v, mp_node u, mp_node q)
+{
+ mp_number vv; /* temporary storage for |value(p)| */
+ new_number_clone(vv, mp_get_value_number(p));
+ mp_new_dep(mp, p, mp_proto_dependent_type, mp_const_dependency(mp, &zero_t)); /* this sets |dep_final| */
+ if (number_nonzero(vv)) {
+ mp_add_mult_dep(mp, (mp_value_node) p, &vv, t); /* |dep_final| doesn't change */
+ }
+ if (number_nonzero(*v)) {
+ mp_number arg1;
+ new_number_clone(arg1, *v);
+ mp_add_mult_dep(mp, (mp_value_node) p, &arg1, u);
+ free_number(arg1);
+ }
+ if (q != NULL) {
+ mp_add_mult_dep(mp, (mp_value_node) p, &unity_t, q);
+ }
+ if (mp_get_dep_list((mp_value_node) p) == (mp_node) mp->dep_final) {
+ number_clone(vv, mp_get_dep_value(mp->dep_final));
+ mp_recycle_value(mp, p);
+ mp_type(p) = mp_known_type;
+ mp_set_value_number(p, vv);
+ }
+ free_number(vv);
+}
+
+@ Finally, in |bilin3| everything is |known|.
+
+@<Declare subroutines needed by |big_trans|@>=
+static void mp_bilin3 (MP mp, mp_node p, mp_number *t, mp_number *v, mp_number *u, mp_number *delta_orig)
+{
+ mp_number delta;
+ mp_number tmp;
+ new_number(tmp);
+ new_number_clone(delta, *delta_orig);
+ if (! number_equal(*t, unity_t)) {
+ take_scaled(tmp, mp_get_value_number(p), *t);
+ } else {
+ number_clone(tmp, mp_get_value_number(p));
+ }
+ number_add(delta, tmp);
+ if (number_nonzero(*u)) {
+ mp_number ret;
+ new_number(ret);
+ take_scaled(ret, *v, *u);
+ mp_set_value_number(p, delta);
+ number_add(mp_get_value_number(p), ret);
+ free_number(ret);
+ } else {
+ mp_set_value_number(p, delta);
+ }
+ free_number(tmp);
+ free_number(delta);
+}
+
+@ @<Declare binary action...@>=
+static void mp_chop_path (MP mp, mp_node p)
+{
+ mp_knot q; /* a knot in the original path */
+ mp_knot pp, qq; /* link variables for copies of path nodes */
+ mp_number a, b; /* indices for chopping */
+ mp_number l;
+ int reversed; /* was |a>b|? */
+ new_number(l);
+ mp_path_length(mp, &l);
+ new_number_clone(a, mp_get_value_number(mp_x_part(p)));
+ new_number_clone(b, mp_get_value_number(mp_y_part(p)));
+ if (number_lessequal(a, b)) {
+ reversed = 0;
+ } else {
+ reversed = 1;
+ number_swap (a, b);
+ }
+ /* Dispense with the cases |a<0| and/or |b>l| */
+ if (number_negative(a)) {
+ if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ set_number_to_zero(a);
+ if (number_negative(b)) {
+ set_number_to_zero(b);
+ }
+ } else {
+ do {
+ number_add(a, l);
+ number_add(b, l);
+ } while (number_negative(a)); /* a cycle always has length |l>0| */
+ }
+ }
+ if (number_greater(b, l)) {
+ if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ number_clone(b, l);
+ if (number_greater(a, l)) {
+ number_clone(a, l);
+ }
+ } else {
+ while (number_greaterequal(a, l)) {
+ number_subtract(a, l);
+ number_subtract(b, l);
+ }
+ }
+ }
+ q = cur_exp_knot;
+ while (number_greaterequal(a, unity_t)) {
+ q = mp_next_knot(q);
+ number_subtract(a, unity_t);
+ number_subtract(b, unity_t);
+ }
+ if (number_equal(b, a)) {
+ /* Construct a path from |pp| to |qq| of length zero */
+ if (number_positive(a)) {
+ mp_number arg1;
+ new_number_clone(arg1, a);
+ convert_scaled_to_fraction(arg1);
+ mp_split_cubic(mp, q, &arg1);
+ free_number(arg1);
+ q = mp_next_knot(q);
+ }
+ pp = mp_copy_knot(mp, q);
+ qq = pp;
+ } else {
+ /* Construct a path from |pp| to |qq| of length $\lceil b\rceil$ */
+ mp_knot rr;
+ pp = mp_copy_knot(mp, q);
+ qq = pp;
+ do {
+ q = mp_next_knot(q);
+ rr = qq;
+ qq = mp_copy_knot(mp, q);
+ mp_prev_knot(qq) = rr;
+ mp_next_knot(rr) = qq;
+ number_subtract(b, unity_t);
+ } while (number_positive(b));
+ if (number_positive(a)) {
+ mp_knot ss = pp;
+ mp_number arg1;
+ new_number_clone(arg1, a);
+ convert_scaled_to_fraction(arg1);
+ mp_split_cubic(mp, ss, &arg1);
+ free_number(arg1);
+ pp = mp_next_knot(ss);
+ mp_toss_knot(mp, ss);
+ if (rr == ss) {
+ mp_number arg1, arg2;
+ new_number(arg1);
+ set_number_from_subtraction(arg1, unity_t, a);
+ new_number_clone(arg2, b);
+ make_scaled(b, arg2, arg1);
+ free_number(arg1);
+ free_number(arg2);
+ rr = pp;
+ }
+ }
+ if (number_negative(b)) {
+ mp_number arg1;
+ new_number(arg1);
+ set_number_from_addition(arg1, b, unity_t);
+ convert_scaled_to_fraction(arg1);
+ mp_split_cubic(mp, rr, &arg1);
+ free_number(arg1);
+ mp_toss_knot(mp, qq);
+ qq = mp_next_knot(rr);
+ }
+ }
+ mp_left_type(pp) = mp_endpoint_knot;
+ mp_right_type(qq) = mp_endpoint_knot;
+ mp_prev_knot(pp) = qq;
+ mp_next_knot(qq) = pp;
+ mp_toss_knot_list(mp, cur_exp_knot);
+ if (reversed) {
+ mp_set_cur_exp_knot(mp, mp_next_knot(mp_htap_ypoc(mp, pp)));
+ mp_toss_knot_list(mp, pp);
+ } else {
+ mp_set_cur_exp_knot(mp, pp);
+ }
+ free_number(l);
+ free_number(a);
+ free_number(b);
+}
+
+@ @<Declare binary action...@>=
+static void mp_set_up_offset (MP mp, mp_node p)
+{
+ mp_find_offset(mp, &(mp_get_value_number(mp_x_part(p))), &(mp_get_value_number(mp_y_part(p))), cur_exp_knot);
+ mp_pair_value(mp, &(mp->cur_x), &(mp->cur_y));
+}
+
+static void mp_set_up_direction_time (MP mp, mp_node p)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_find_direction_time(mp, &new_expr.data.n, &(mp_get_value_number(mp_x_part(p))), &(mp_get_value_number(mp_y_part(p))), cur_exp_knot);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static void mp_set_up_envelope (MP mp, mp_node p)
+{
+ mp_knot q = mp_copy_path(mp, cur_exp_knot); /* the original path */
+ /* TODO: accept elliptical pens for straight paths */
+ /* TODO: quite some duplicate code here: maybe make some helpers */
+ if (mp_pen_is_elliptical(mp_get_value_knot(p))) {
+ mp_bad_envelope_pen(mp);
+ mp_set_cur_exp_knot(mp, q);
+ mp->cur_exp.type = mp_path_type;
+ } else {
+ int linejoin = mp_mitered_linejoin_code;
+ int linecap = mp_butt_linecap_code;
+ mp_number miterlimit;
+ new_number(miterlimit);
+ if (number_greater(internal_value(mp_linejoin_internal), unity_t)) {
+ linejoin = mp_beveled_linejoin_code;
+ } else if (number_positive(internal_value(mp_linejoin_internal))) {
+ linejoin = mp_rounded_linejoin_code;
+ }
+ if (number_greater(internal_value(mp_linecap_internal), unity_t)) {
+ linecap = mp_squared_linecap_code;
+ } else if (number_positive(internal_value(mp_linecap_internal))) {
+ linecap = mp_rounded_linecap_code;
+ }
+ if (number_less(internal_value(mp_miterlimit_internal), unity_t)) {
+ set_number_to_unity(miterlimit);
+ } else {
+ number_clone(miterlimit, internal_value(mp_miterlimit_internal));
+ }
+ mp_set_cur_exp_knot(mp, mp_make_envelope(mp, q, mp_get_value_knot(p), linejoin, linecap, &miterlimit));
+ mp->cur_exp.type = mp_path_type;
+ }
+}
+
+static void mp_set_up_boundingpath (MP mp, mp_node p)
+{
+ mp_number miterlimit;
+ mp_knot q = mp_copy_path(mp, cur_exp_knot); /* the original path */
+ mp_knot qq;
+ int linejoin = mp_mitered_linejoin_code;
+ int linecap = mp_butt_linecap_code;
+ mp_knot pen = mp_get_value_knot(p);
+ new_number(miterlimit);
+ /*
+ Accept elliptical pens for s paths using |mp_make_path| to convert an
+ elliptical pen to a polygonal one. The approximation of 8 knots should be
+ good enough.
+ */
+ if (mp_pen_is_elliptical(mp_get_value_knot(p))) {
+ mp_knot kp, kq;
+ pen = mp_copy_pen(mp, mp_get_value_knot(p));
+ mp_make_path(mp, pen);
+ kq = pen;
+ do {
+ kp = kq;
+ kq = mp_next_knot(kq);
+ mp_prev_knot(kq) = kp;
+ } while (kq != pen);
+ mp_close_path_cycle(mp, kp, pen);
+ }
+ if (number_greater(internal_value(mp_linejoin_internal), unity_t)) {
+ linejoin = mp_beveled_linejoin_code;
+ } else if (number_positive(internal_value(mp_linejoin_internal))) {
+ linejoin = mp_rounded_linejoin_code;
+ }
+ if (number_greater(internal_value(mp_linecap_internal), unity_t)) {
+ linecap = mp_squared_linecap_code;
+ } else if (number_positive(internal_value(mp_linecap_internal))) {
+ linecap = mp_rounded_linecap_code;
+ }
+ if (number_less(internal_value(mp_miterlimit_internal), unity_t)) {
+ set_number_to_unity(miterlimit);
+ } else {
+ number_clone(miterlimit, internal_value(mp_miterlimit_internal));
+ }
+ qq = mp_make_envelope(mp, q, pen, linejoin, linecap, &miterlimit);
+ mp_set_cur_exp_knot(mp, qq);
+ mp->cur_exp.type = mp_path_type;
+ if (! mp_get_cur_bbox(mp)) {
+ mp_bad_binary(mp, p, mp_boundingpath_operation);
+ mp_set_cur_exp_knot(mp, q);
+ mp->cur_exp.type = mp_path_type;
+ return;
+ } else {
+ mp_knot ll = mp_new_knot(mp);
+ mp_knot lr = mp_new_knot(mp);
+ mp_knot ur = mp_new_knot(mp);
+ mp_knot ul = mp_new_knot(mp);
+ if (ll == NULL || lr == NULL || ur == NULL || ul == NULL){
+ mp_bad_binary(mp, p, mp_boundingpath_operation);
+ mp_set_cur_exp_knot(mp, q);
+ mp->cur_exp.type = mp_path_type;
+ return;
+ } else {
+ mp_left_type(ll) = mp_endpoint_knot;
+ mp_right_type(ll) = mp_endpoint_knot;
+ mp_originator(ll) = mp_program_code;
+ mp_knotstate(ll) = mp_regular_knot;
+ number_clone(ll->x_coord, mp_minx);
+ number_clone(ll->y_coord, mp_miny);
+ mp_originator(lr) = mp_program_code;
+ mp_knotstate(lr) = mp_regular_knot;
+ number_clone(lr->x_coord, mp_maxx);
+ number_clone(lr->y_coord, mp_miny);
+ mp_originator(ur) = mp_program_code;
+ mp_knotstate(ur) = mp_regular_knot;
+ number_clone(ur->x_coord, mp_maxx);
+ number_clone(ur->y_coord, mp_maxy);
+ mp_originator(ul) = mp_program_code;
+ mp_knotstate(ul) = mp_regular_knot;
+ number_clone(ul->x_coord, mp_minx);
+ number_clone(ul->y_coord, mp_maxy);
+ mp_prev_knot(lr) = ll;
+ mp_next_knot(ll) = lr;
+ mp_prev_knot(ur) = lr;
+ mp_next_knot(lr) = ur;
+ mp_prev_knot(ul) = ur;
+ mp_next_knot(ur) = ul;
+ mp_close_path_cycle(mp, ul, ll);
+ mp_make_path(mp,ll);
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, ll);
+ mp_free_path(mp,qq);
+ }
+ }
+}
+
+@ @<Declare binary action...@>=
+static void mp_find_point (MP mp, mp_number *v_orig, int c)
+{
+ mp_knot p; /* the path */
+ mp_number n; /* its length */
+ mp_number v;
+ new_number(n);
+ new_number_clone(v, *v_orig);
+ p = cur_exp_knot;
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ set_number_to_unity(n);
+ number_negate(n);
+ }
+ do {
+ p = mp_next_knot(p);
+ number_add(n, unity_t);
+ } while (p != cur_exp_knot);
+ if (number_zero(n)) {
+ set_number_to_zero(v);
+ } else if (number_negative(v)) {
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ set_number_to_zero(v);
+ } else {
+ /* |v = n - 1 - ((-v - 1) % n) == - ((-v - 1) % n) - 1 + n| */
+ number_negate(v);
+ number_add_scaled(v, -1);
+ number_modulo(v, n);
+ number_negate(v);
+ number_add_scaled(v, -1);
+ number_add(v, n);
+ }
+ } else if (number_greater(v, n)) {
+ if (mp_left_type(p) == mp_endpoint_knot) {
+ number_clone(v, n);
+ } else {
+ number_modulo(v, n);
+ }
+ }
+ p = cur_exp_knot;
+ while (number_greaterequal(v, unity_t)) {
+ p = mp_next_knot(p);
+ number_subtract(v, unity_t);
+ }
+ if (number_nonzero(v)) {
+ /* Insert a fractional node by splitting the cubic */
+ convert_scaled_to_fraction(v);
+ mp_split_cubic(mp, p, &v);
+ p = mp_next_knot(p);
+ }
+ /* Set the current expression to the desired path coordinates */
+ push_of_path_result(mp, c - mp_point_operation, p);
+ free_number(v);
+ free_number(n);
+}
+
+@* Statements and commands.
+
+The chief executive of \MP\ is the |do_statement| routine, which contains the
+master switch that causes all the various pieces of \MP\ 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 structure of |do_statement| itself is quite simple. The first token of the
+statement is fetched using |get_x_next|. If it can be the first token of an
+expression, we look for an equation, an assignment, or a title. Otherwise we use
+a |case| construction to branch at high speed to the appropriate routine for
+various and sundry other types of commands, each of which has an \quote {action
+procedure} that does the necessary work.
+
+The program uses the fact that
+
+$$\hbox{|min_primary_command=max_statement_command=type_name|}$$
+
+to interpret a statement that starts with, e.g., |string|, as a type
+declaration rather than a boolean expression.
+
+@c
+static void worry_about_bad_statement (MP mp);
+
+static void flush_unparsable_junk_after_statement (MP mp);
+
+void mp_do_statement (MP mp)
+{
+ /* governs \MP's activities */
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ if (cur_cmd > mp_max_primary_command) {
+ worry_about_bad_statement(mp);
+ } else if (cur_cmd > mp_max_statement_command) {
+ /*
+ Do an equation, assignment, title, or
+ `$\langle\,$expression$\,\rangle\,$|endgroup|'; The most important
+ statements begin with expressions
+ */
+ mp_value new_expr;
+ mp->var_flag = mp_assignment_command;
+ mp_scan_expression(mp);
+ if (cur_cmd < mp_end_group_command) {
+ if (cur_cmd == mp_equals_command) {
+ mp_do_equation(mp);
+ } else if (cur_cmd == mp_assignment_command) {
+ mp_do_assignment(mp);
+ } else if (mp->cur_exp.type == mp_string_type) {
+ /* Do a title */
+ if (number_positive(internal_value(mp_tracing_titles_internal))) {
+ mp_print_nl(mp, "");
+ mp_print_mp_str(mp, cur_exp_str);
+ update_terminal();
+ }
+ } else if (mp->cur_exp.type != mp_vacuous_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Isolated expression",
+ "I couldn't find an '=' or ':=' after the expression that is shown above this\n"
+ "error message, so I guess I'll just ignore it and carry on."
+ );
+ mp_get_x_next(mp);
+ }
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ } else {
+ /*
+ Do a statement that doesn't begin with an expression. If |do_statement|
+ ends with |cur_cmd=end_group|, we should have |cur_type=mp_vacuous| unless
+ the statement was simply an expression; in the latter case, |cur_type| and
+ |cur_exp| should represent that expression.
+ */
+ if (number_positive(internal_value(mp_tracing_commands_internal))) {
+ mp_show_cmd_mod(mp, cur_cmd, cur_mod);
+ }
+ switch (cur_cmd) {
+ case mp_type_name_command:
+ mp_do_type_declaration(mp);
+ break;
+ case mp_macro_def_command:
+ switch (cur_mod) {
+ case mp_def_code:
+ case mp_var_def_code:
+ mp_scan_def(mp, cur_mod);
+ break;
+ case mp_primary_def_code:
+ case mp_secondary_def_code:
+ case mp_tertiary_def_code:
+ mp_make_op_def(mp, cur_mod);
+ break;
+ }
+ break;
+ case mp_only_set_command:
+ switch (cur_mod) {
+ case mp_random_seed_code:
+ mp_do_random_seed(mp);
+ break;
+ case mp_max_knot_pool_code:
+ mp_do_max_knot_pool(mp);
+ break;
+ }
+ break;
+ case mp_mode_command:
+ mp_print_ln(mp);
+ mp->interaction = cur_mod;
+ mp->selector = mp->interaction == mp_batch_mode ? mp_log_only_selector : mp_term_and_log_selector;
+ mp_get_x_next(mp);
+ break;
+ case mp_protection_command:
+ mp_do_protection(mp);
+ break;
+ case mp_property_command:
+ mp_do_property(mp);
+ break;
+ case mp_delimiters_command:
+ mp_def_delims(mp);
+ break;
+ case mp_save_command:
+ do {
+ mp_get_symbol(mp);
+ mp_save_variable(mp, cur_sym);
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+ break;
+ case mp_interim_command:
+ mp_do_interim(mp);
+ break;
+ case mp_let_command:
+ mp_do_let(mp);
+ break;
+ case mp_new_internal_command:
+ mp_do_new_internal(mp);
+ break;
+ case mp_show_command:
+ mp_do_show_whatever(mp);
+ break;
+ case mp_add_to_command:
+ mp_do_add_to(mp);
+ break;
+ case mp_bounds_command:
+ mp_do_bounds(mp);
+ break;
+ case mp_ship_out_command:
+ mp_do_ship_out(mp);
+ break;
+ case mp_every_job_command:
+ mp_get_symbol(mp);
+ mp->every_job_sym = cur_sym;
+ mp_get_x_next(mp);
+ break;
+ case mp_message_command:
+ mp_do_message(mp);
+ break;
+ case mp_write_command:
+ mp_do_write(mp);
+ break;
+ default:
+ break;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ if (cur_cmd < mp_semicolon_command) {
+ flush_unparsable_junk_after_statement(mp);
+ }
+ mp->error_count = 0;
+}
+
+@ @<Declarations@>=
+@<Declare action procedures for use by |do_statement|@>
+
+@ The only command codes |>max_primary_command| that can be present at the
+beginning of a statement are |semicolon| and higher; these occur when the
+statement is null.
+
+@c
+static void worry_about_bad_statement (MP mp)
+{
+ if (cur_cmd < mp_semicolon_command) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_print_cmd_mod(mp, cur_cmd, cur_mod);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "A statement can't begin with '%s'", mp_str(mp, sname));
+ delete_str_ref(sname);
+ mp_back_error(
+ mp,
+ msg,
+ "I was looking for the beginning of a new statement. If you just proceed without\n"
+ "changing anything, I'll ignore everything up to the next ';'."
+ );
+ mp_get_x_next(mp);
+ }
+}
+
+@ The help message printed here says that everything is flushed up to
+a semicolon, but actually the commands |end_group| and |stop| will
+also terminate a statement.
+
+@c
+static void flush_unparsable_junk_after_statement (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Extra tokens will be flushed",
+ "I've just read as much of that statement as I could fathom, so a semicolon should\n"
+ "have been next. It's very puzzling ... but I'll try to get myself back together,\n"
+ "by ignoring everything up to the next ';'."
+ );
+ mp->scanner_status = mp_flushing_state;
+ do {
+ get_t_next(mp);
+ if (cur_cmd == mp_string_command) {
+ delete_str_ref(cur_mod_str);
+ }
+ } while (! mp_end_of_statement); /* |cur_cmd=semicolon|, |end_group|, or |stop| */
+ mp->scanner_status = mp_normal_state;
+}
+
+@ Equations and assignments are performed by the pair of mutually recursive
+@^recursion@> routines |do_equation| and |do_assignment|. These routines are
+called when |cur_cmd=equals| and when |cur_cmd=assignment|, respectively; the
+left-hand side is in |cur_type| and |cur_exp|, while the right-hand side is yet
+to be scanned. After the routines are finished, |cur_type| and |cur_exp| will be
+equal to the right-hand side (which will normally be equal to the left-hand
+side).
+
+@<Declarations@>=
+@<Declare the procedure called |make_eq|@>
+static void mp_do_equation (MP mp);
+
+@ @c
+static void trace_equation (MP mp, mp_node lhs)
+{
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{(");
+ mp_print_exp(mp, lhs, 0);
+ mp_print_str(mp, ")=(");
+ mp_print_exp(mp, NULL, 0);
+ mp_print_str(mp, ")}");
+ mp_end_diagnostic(mp, 0);
+}
+
+void mp_do_equation (MP mp)
+{
+ mp_node lhs = mp_stash_cur_exp(mp); /* capsule for the left-hand side */
+ mp_get_x_next(mp);
+ mp->var_flag = mp_assignment_command;
+ mp_scan_expression(mp);
+ if (cur_cmd == mp_equals_command) {
+ mp_do_equation(mp);
+ } else if (cur_cmd == mp_assignment_command) {
+ mp_do_assignment(mp);
+ }
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ trace_equation(mp, lhs);
+ }
+ if (mp->cur_exp.type == mp_unknown_path_type) {
+ if (mp_type(lhs) == mp_pair_type) {
+ mp_node p; /* temporary register */
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, lhs);
+ lhs = p;
+ }
+ /* in this case |make_eq| will change the pair to a path */
+ }
+ mp_make_eq(mp, lhs); /* equate |lhs| to |(cur_type,cur_exp)| */
+}
+
+@ And |do_assignment| is similar to |do_equation|:
+
+@<Declarations@>=
+static void mp_do_assignment (MP mp);
+
+@ @c
+static void bad_lhs (MP mp)
+{
+ mp_disp_err(mp, NULL);
+ mp_error(
+ mp,
+ "Improper ':=' will be changed to '='",
+ "I didn't find a variable name at the left of the ':=', so I'm going to pretend\n"
+ "that you said '=' instead."
+ );
+ mp_do_equation(mp);
+}
+
+static void bad_internal_assignment (MP mp, mp_node lhs)
+{
+ char msg[256];
+ mp_disp_err(mp, NULL);
+ if (internal_type(mp_get_sym_info(lhs)) == mp_known_type) {
+ mp_snprintf(msg, 256,
+ "Internal quantity '%s' must receive a known numeric value",
+ internal_name(mp_get_sym_info(lhs))
+ );
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything but a known numeric value, so I'll\n"
+ "have to ignore this assignment."
+ );
+ } else if (internal_type(mp_get_sym_info(lhs)) == mp_boolean_type) {
+ mp_snprintf(msg, 256,
+ "Internal quantity '%s' must receive a known boolean value",
+ internal_name(mp_get_sym_info(lhs))
+ );
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything but a known boolean value, so I'll\n"
+ "have to ignore this assignment."
+ );
+ } else {
+ mp_snprintf(msg, 256,
+ "Internal quantity '%s' must receive a known string",
+ internal_name(mp_get_sym_info(lhs))
+ );
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything but a known string value, so I'll\n"
+ "have to ignore this assignment."
+ );
+ }
+ mp_get_x_next(mp);
+}
+
+static void forbidden_internal_assignment (MP mp, mp_node lhs)
+{
+ char msg[256];
+ mp_snprintf(msg, 256,"Internal quantity '%s' is read-only", internal_name(mp_get_sym_info(lhs)));
+ mp_back_error(
+ mp,
+ msg,
+ "I can't set this internal quantity to anything just yet (it is read-only), so\n"
+ "I'll have to ignore this assignment."
+ );
+ mp_get_x_next(mp);
+}
+
+static void bad_internal_assignment_precision (MP mp, mp_node lhs, mp_number *min, mp_number *max)
+{
+ char msg[256];
+ char hlp[256];
+ mp_snprintf(msg, 256,
+ "Bad '%s' has been ignored",
+ internal_name(mp_get_sym_info(lhs)));
+ mp_snprintf(hlp, 256,
+ "Precision values are limited by the current numbersystem.\n"
+ "Currently I am using '%s'; the allowed precision range is [%s,%s].",
+ mp_str(mp, internal_string(mp_number_system_internal)), number_tostring(*min), number_tostring(*max));
+ mp_back_error(mp, msg, hlp);
+ mp_get_x_next(mp);
+}
+
+static void bad_expression_assignment (MP mp, mp_node lhs)
+{
+ char *msg = mp_obliterated(mp, lhs);
+ mp_back_error(
+ mp,
+ msg,
+ "It seems you did a nasty thing --- probably by accident, but nevertheless you\n"
+ "nearly hornswoggled me ... While I was evaluating the right-hand side of this\n"
+ "command, something happened, and the left-hand side is no longer a variable! So I\n"
+ "won't change anything."
+ );
+ mp_memory_free(msg);
+ mp_get_x_next(mp);
+}
+
+static void trace_assignment (MP mp, mp_node lhs)
+{
+ mp_begin_diagnostic(mp);
+ mp_print_nl(mp, "{");
+ if (mp_name_type(lhs) == mp_internal_operation) {
+ mp_print_str(mp, internal_name(mp_get_sym_info(lhs)));
+ } else {
+ mp_show_token_list(mp, lhs, NULL);
+ }
+ mp_print_str(mp, ":=");
+ mp_print_exp(mp, NULL, 0);
+ mp_print_chr(mp, '}');
+ mp_end_diagnostic(mp, 0);
+}
+
+void mp_do_assignment (MP mp)
+{
+ if (mp->cur_exp.type != mp_token_list_type) {
+ bad_lhs(mp);
+ } else {
+ mp_node lhs = cur_exp_node; /* token list for the left-hand side */
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ mp->var_flag = mp_assignment_command;
+ mp_scan_expression(mp);
+ if (cur_cmd == mp_equals_command) {
+ mp_do_equation(mp);
+ } else if (cur_cmd == mp_assignment_command) {
+ mp_do_assignment(mp);
+ }
+ if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) {
+ trace_assignment (mp, lhs);
+ }
+ if (mp_name_type(lhs) == mp_internal_operation) {
+ /* Assign the current expression to an internal variable */
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ case mp_string_type:
+ case mp_boolean_type:
+ if (internal_type(mp_get_sym_info(lhs)) == mp->cur_exp.type) {
+ switch (mp_get_sym_info(lhs)) {
+ case mp_number_system_internal:
+ forbidden_internal_assignment(mp, lhs);
+ break;
+ // case mp_tracing_online_internal:
+ // number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number);
+ // mp->run_internal(mp, 3, mp->int_ptr, number_to_int(internal_value(mp_get_sym_info(lhs))), internal_name(mp_get_sym_info(lhs)));
+ // break;
+ case mp_number_precision_internal:
+ if (mp->cur_exp.type == mp_known_type
+ && (! number_less (cur_exp_value_number, precision_min))
+ && (! number_greater(cur_exp_value_number, precision_max))
+ ) {
+ if (internal_type(mp_get_sym_info(lhs)) == mp_string_type) {
+ add_str_ref(cur_exp_str);
+ set_internal_string(mp_get_sym_info(lhs), cur_exp_str);
+ } else {
+ number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number);
+ }
+ set_precision();
+ } else {
+ bad_internal_assignment_precision(mp, lhs, &precision_min, &precision_max);
+ }
+ default:
+ if (internal_type(mp_get_sym_info(lhs)) == mp_string_type) {
+ add_str_ref(cur_exp_str);
+ set_internal_string(mp_get_sym_info(lhs), cur_exp_str);
+ } else {
+ number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number);
+ }
+ break;
+ }
+ } else {
+ bad_internal_assignment(mp, lhs);
+ }
+ break;
+ default:
+ bad_internal_assignment(mp, lhs);
+ }
+ } else {
+ /* Assign the current expression to the variable |lhs| */
+ mp_node p = mp_find_variable(mp, lhs); /* where the left-hand value is stored */
+ if (p != NULL) {
+ mp_node q = mp_stash_cur_exp(mp); /* temporary capsule for the right-hand value */
+ mp->cur_exp.type = mp_und_type(mp, p);
+ mp_recycle_value(mp, p);
+ mp_type(p) = mp->cur_exp.type;
+ mp_set_value_number(p, zero_t);
+ mp_make_exp_copy(mp, p);
+ p = mp_stash_cur_exp(mp);
+ mp_unstash_cur_exp(mp, q);
+ mp_make_eq(mp, p);
+ } else {
+ bad_expression_assignment(mp, lhs);
+ }
+ }
+ mp_flush_node_list(mp, lhs);
+ }
+}
+
+@ And now we get to the nitty-gritty. The |make_eq| procedure is given a pointer
+to a capsule that is to be equated to the current expression.
+
+@<Declare the procedure called |make_eq|@>=
+static void mp_make_eq (MP mp, mp_node lhs);
+
+@ @c
+static void announce_bad_equation (MP mp, mp_node lhs)
+{
+ char msg[256];
+ mp_snprintf(msg, 256,
+ "Equation cannot be performed (%s=%s)",
+ (mp_type(lhs) <= mp_pair_type ? mp_type_string(mp_type(lhs)) : "numeric"),
+ (mp->cur_exp.type <= mp_pair_type ? mp_type_string(mp->cur_exp.type) : "numeric"));
+ mp_disp_err(mp, lhs);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ msg,
+ "I'm sorry, but I don't know how to make such things equal. (See the two\n"
+ "expressions just above the error message.)"
+ );
+ mp_get_x_next(mp);
+}
+
+static void mp_exclaim_inconsistent_equation (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Inconsistent equation",
+ "The equation I just read contradicts what was said before. But don't worry;\n"
+ "continue and I'll just ignore it."
+ );
+ mp_get_x_next(mp);
+}
+
+static void mp_exclaim_redundant_or_inconsistent_equation (MP mp)
+{
+ mp_back_error(
+ mp,
+ "Redundant or inconsistent equation",
+ "An equation between already-known quantities can't help. But don't worry;\n"
+ "continue and I'll just ignore it."
+ );
+ mp_get_x_next(mp);
+}
+
+static void report_redundant_or_inconsistent_equation (MP mp, mp_node lhs, mp_number *v)
+{
+ if (mp->cur_exp.type <= mp_string_type) {
+ if (mp->cur_exp.type == mp_string_type) {
+ if (mp_str_vs_str(mp, mp_get_value_str(lhs), cur_exp_str) != 0) {
+ mp_exclaim_inconsistent_equation(mp);
+ } else {
+ mp_exclaim_redundant_equation(mp);
+ }
+ } else if (number_equal(*v, cur_exp_value_number)) {
+ mp_exclaim_redundant_equation(mp);
+ } else {
+ mp_exclaim_inconsistent_equation(mp);
+ }
+ } else {
+ mp_exclaim_redundant_or_inconsistent_equation(mp);
+ }
+}
+
+void mp_make_eq (MP mp, mp_node lhs)
+{
+ mp_value new_expr;
+ mp_variable_type t; /* type of the left-hand side */
+ mp_number v; /* value of the left-hand side */
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(v);
+ RESTART:
+ t = mp_type(lhs);
+ if (t <= mp_pair_type) {
+ number_clone(v, mp_get_value_number(lhs));
+ }
+ /*
+ For each type |t|, make an equation or complain if |cur_type| is
+ incompatible with~|t|
+ */
+ switch (t) {
+ case mp_boolean_type:
+ case mp_string_type:
+ case mp_pen_type:
+ case mp_nep_type:
+ case mp_path_type:
+ case mp_picture_type:
+ if (mp->cur_exp.type == t + unknown_tag) {
+ new_number(new_expr.data.n);
+ switch (t) {
+ case mp_boolean_type:
+ number_clone(new_expr.data.n, v);
+ break;
+ case mp_string_type:
+ new_expr.data.str = mp_get_value_str(lhs);
+ break;
+ case mp_picture_type:
+ new_expr.data.node = mp_get_value_node(lhs);
+ break;
+ default:
+ /* pen or path */
+ new_expr.data.p = mp_get_value_knot(lhs);
+ break;
+ }
+ mp_nonlinear_eq(mp, new_expr, cur_exp_node, 0);
+ mp_unstash_cur_exp(mp, cur_exp_node);
+ } else if (mp->cur_exp.type == t) {
+ report_redundant_or_inconsistent_equation(mp, lhs, &v);
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_unknown_boolean_type:
+ case mp_unknown_string_type:
+ case mp_unknown_pen_type:
+ case mp_unknown_nep_type:
+ case mp_unknown_path_type:
+ case mp_unknown_picture_type:
+ if (mp->cur_exp.type == t - unknown_tag) {
+ mp_nonlinear_eq(mp, mp->cur_exp, lhs, 1);
+ } else if (mp->cur_exp.type == t) {
+ mp_ring_merge (mp, lhs, cur_exp_node);
+ } else if (mp->cur_exp.type == mp_pair_type) {
+ if (t == mp_unknown_path_type) {
+ mp_pair_to_path(mp);
+ goto RESTART;
+ }
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_transform_type:
+ case mp_color_type:
+ case mp_cmykcolor_type:
+ case mp_pair_type:
+ if (mp->cur_exp.type == t) {
+ /* Do multiple equations */
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_node p = mp_get_value_node(lhs);
+ switch (t) {
+ case mp_transform_type:
+ mp_try_eq(mp, mp_yy_part(p), mp_yy_part(q));
+ mp_try_eq(mp, mp_yx_part(p), mp_yx_part(q));
+ mp_try_eq(mp, mp_xy_part(p), mp_xy_part(q));
+ mp_try_eq(mp, mp_xx_part(p), mp_xx_part(q));
+ mp_try_eq(mp, mp_ty_part(p), mp_ty_part(q));
+ mp_try_eq(mp, mp_tx_part(p), mp_tx_part(q));
+ break;
+ case mp_color_type:
+ mp_try_eq(mp, mp_blue_part(p), mp_blue_part(q));
+ mp_try_eq(mp, mp_green_part(p), mp_green_part(q));
+ mp_try_eq(mp, mp_red_part(p), mp_red_part(q));
+ break;
+ case mp_cmykcolor_type:
+ mp_try_eq(mp, mp_black_part(p), mp_black_part(q));
+ mp_try_eq(mp, mp_yellow_part(p), mp_yellow_part(q));
+ mp_try_eq(mp, mp_magenta_part(p), mp_magenta_part(q));
+ mp_try_eq(mp, mp_cyan_part(p), mp_cyan_part(q));
+ break;
+ case mp_pair_type:
+ mp_try_eq(mp, mp_y_part(p), mp_y_part(q));
+ mp_try_eq(mp, mp_x_part(p), mp_x_part(q));
+ break;
+ default:
+ break;
+ }
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_known_type:
+ case mp_dependent_type:
+ case mp_proto_dependent_type:
+ case mp_independent_type:
+ if (mp->cur_exp.type >= mp_known_type) {
+ mp_try_eq(mp, lhs, NULL);
+ } else {
+ announce_bad_equation(mp, lhs);
+ }
+ break;
+ case mp_vacuous_type:
+ announce_bad_equation(mp, lhs);
+ break;
+ default:
+ announce_bad_equation(mp, lhs);
+ break;
+ }
+ check_arith();
+ mp_recycle_value(mp, lhs);
+ free_number(v);
+ mp_free_value_node(mp, lhs);
+}
+
+@ The first argument to |try_eq| is the location of a value node in a capsule
+that will soon be recycled. The second argument is either a location within a
+pair or transform node pointed to by |cur_exp|, or it is |NULL| (which means that
+|cur_exp| itself serves as the second argument). The idea is to leave |cur_exp|
+unchanged, but to equate the two operands.
+
+
+@<Declarations@>=
+static void mp_try_eq (MP mp, mp_node l, mp_node r);
+
+@d equation_threshold_k mp->math->md_equation_threshold_t
+
+@ @c
+static void deal_with_redundant_or_inconsistent_equation (MP mp, mp_value_node p, mp_node r)
+{
+ mp_number absp;
+ new_number_abs(absp, mp_get_value_number(p));
+ if (number_greater(absp, equation_threshold_k)) { /* off by .001 or more */
+ char msg[256];
+ mp_snprintf(msg, 256, "Inconsistent equation (off by %s)", number_tostring (mp_get_value_number(p)));
+ mp_back_error(
+ mp,
+ msg,
+ "The equation I just read contradicts what was said before. But don't worry;\n"
+ "continue and I'll just ignore it."
+ );
+ mp_get_x_next(mp);
+ } else if (r == NULL) {
+ mp_exclaim_redundant_equation(mp);
+ }
+ free_number(absp);
+ mp_free_dep_node(mp, p);
+}
+
+void mp_try_eq (MP mp, mp_node l, mp_node r)
+{
+ mp_value_node p; /* dependency list for right operand minus left operand */
+ mp_value_node q; /* the constant term of |p| is here */
+ mp_value_node pp; /* dependency list for right operand */
+ mp_variable_type tt; /* the type of list |pp| */
+ int copied; /* have we copied a list that ought to be recycled? */
+ /*
+ Remove the left operand from its container, negate it, and put it into
+ dependency list~|p| with constant term~|q|
+ */
+ mp_variable_type t = mp_type(l); /* the type of list |p| */
+ switch (t) {
+ case mp_known_type:
+ {
+ mp_number arg1;
+ new_number(arg1);
+ number_negated_clone(arg1, mp_get_value_number(l));
+ t = mp_dependent_type;
+ p = mp_const_dependency(mp, &arg1);
+ q = p;
+ free_number(arg1);
+ }
+ break;
+ case mp_independent_type:
+ {
+ t = mp_dependent_type;
+ p = mp_single_dependency(mp, l);
+ number_negate(mp_get_dep_value(p));
+ q = mp->dep_final;
+ }
+ break;
+ default:
+ {
+ mp_value_node ll = (mp_value_node) l;
+ p = (mp_value_node) mp_get_dep_list(ll);
+ q = p;
+ while (1) {
+ number_negate(mp_get_dep_value(q));
+ if (mp_get_dep_info(q) == NULL) {
+ break;
+ } else {
+ q = (mp_value_node) mp_link(q);
+ }
+ }
+ mp_link(mp_get_prev_dep(ll)) = mp_link(q);
+ mp_set_prev_dep((mp_value_node) mp_link(q), mp_get_prev_dep(ll));
+ mp_type(ll) = mp_known_type;
+ }
+ break;
+ }
+ /* Add the right operand to list |p| */
+ if (r == NULL) {
+ if (mp->cur_exp.type == mp_known_type) {
+ number_add(mp_get_value_number(q), cur_exp_value_number);
+ goto DONE1;
+ } else {
+ tt = mp->cur_exp.type;
+ if (tt == mp_independent_type) {
+ pp = mp_single_dependency(mp, cur_exp_node);
+ } else {
+ pp = (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node);
+ }
+ }
+ } else if (mp_type(r) == mp_known_type) {
+ number_add(mp_get_dep_value(q), mp_get_value_number(r));
+ goto DONE1;
+ } else {
+ tt = mp_type(r);
+ if (tt == mp_independent_type) {
+ pp = mp_single_dependency(mp, r);
+ } else {
+ pp = (mp_value_node) mp_get_dep_list((mp_value_node) r);
+ }
+ }
+ if (tt != mp_independent_type) {
+ copied = 0;
+ } else {
+ copied = 1;
+ tt = mp_dependent_type;
+ }
+ /* Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t| */
+ mp->watch_coefs = 0;
+ if (t == tt) {
+ p = mp_p_plus_q(mp, p, pp, (int) t);
+ } else if (t == mp_proto_dependent_type) {
+ p = mp_p_plus_fq(mp, p, &unity_t, pp, mp_proto_dependent_type, mp_dependent_type);
+ } else {
+ mp_number x;
+ new_number(x);
+ q = p;
+ while (mp_get_dep_info(q) != NULL) {
+ number_clone(x, mp_get_dep_value(q));
+ fraction_to_round_scaled(x);
+ mp_set_dep_value(q, x);
+ q = (mp_value_node) mp_link(q);
+ }
+ free_number(x);
+ t = mp_proto_dependent_type;
+ p = mp_p_plus_q(mp, p, pp, (int) t);
+ }
+ mp->watch_coefs = 1;
+ if (copied) {
+ mp_flush_node_list(mp, (mp_node) pp);
+ }
+ DONE1:
+ if (mp_get_dep_info(p) == NULL) {
+ deal_with_redundant_or_inconsistent_equation(mp, p, r);
+ } else {
+ mp_linear_eq(mp, p, (int) t);
+ if (r == NULL && mp->cur_exp.type != mp_known_type && mp_type(cur_exp_node) == mp_known_type) {
+ mp_node pp = cur_exp_node;
+ mp_set_cur_exp_value_number(mp, &(mp_get_value_number(pp)));
+ mp->cur_exp.type = mp_known_type;
+ mp_free_value_node(mp, pp);
+ }
+ }
+}
+
+@ Our next goal is to process type declarations. For this purpose it's convenient
+to have a procedure that scans a $\langle\,$declared variable$\,\rangle$ and
+returns the corresponding token list. After the following procedure has acted,
+the token after the declared variable will have been scanned, so it will appear
+in |cur_cmd|, |cur_mod|, and~|cur_sym|.
+
+@<Declarations@>=
+static mp_node mp_scan_declared_variable (MP mp);
+
+@ @c
+mp_node mp_scan_declared_variable (MP mp)
+{
+ mp_sym x; /* hash address of the variable's root */
+ mp_node h, t; /* head and tail of the token list to be returned */
+ mp_get_symbol(mp);
+ x = cur_sym;
+ if (cur_cmd != mp_tag_command) {
+ mp_clear_symbol(mp, x, 0);
+ }
+ h = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(h, x);
+ t = h;
+ while (1) {
+ mp_get_x_next(mp);
+ if (cur_sym == NULL) {
+ break;
+ } else if (cur_cmd != mp_tag_command) {
+ /* could be smarter: */
+ if (cur_cmd != mp_internal_command) {
+ if (cur_cmd == mp_left_bracket_command) {
+ /*
+ Descend past a collective subscript If the subscript
+ isn't collective, we don't accept it as part of the
+ declared variable.
+ */
+ mp_sym ll = cur_sym; /* hash address of left bracket */
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_right_bracket_command) {
+ set_cur_sym(mp_collective_subscript);
+ } else {
+ mp_back_input(mp);
+ set_cur_sym(ll);
+ set_cur_cmd(mp_left_bracket_command);
+ break;
+ }
+ } else {
+ break;
+ }
+ }
+ }
+ mp_link(t) = mp_new_symbolic_node(mp);
+ t = mp_link(t);
+ mp_set_sym_sym(t, cur_sym);
+ mp_name_type(t) = cur_sym_mod;
+ }
+ if (eq_property(x) != 0) {
+ mp_check_overload(mp, x);
+ }
+ // if ((eq_type(x) % mp_outer_tag_command) != mp_tag_command) {
+ if (eq_type(x) != mp_tag_command) {
+ mp_clear_symbol(mp, x, 0);
+ }
+ if (equiv_node(x) == NULL) {
+ mp_new_root (mp, x);
+ }
+ return h;
+}
+
+@ Type declarations are introduced by the following primitive operations.
+
+@ @<Put each...@>=
+mp_primitive(mp, "numeric", mp_type_name_command, mp_numeric_type_operation);
+@:numeric_}{|numeric| primitive@>
+mp_primitive(mp, "string", mp_type_name_command, mp_string_type_operation);
+@:string_}{|string| primitive@>
+mp_primitive(mp, "boolean", mp_type_name_command, mp_boolean_type_operation);
+@:boolean_}{|boolean| primitive@>
+mp_primitive(mp, "path", mp_type_name_command, mp_path_type_operation);
+@:path_}{|path| primitive@>
+mp_primitive(mp, "pen", mp_type_name_command, mp_pen_type_operation);
+@:pen_}{|pen| primitive@>
+mp_primitive(mp, "nep", mp_type_name_command, mp_nep_type_operation);
+@:nep_}{|nep| primitive@>
+mp_primitive(mp, "picture", mp_type_name_command, mp_picture_type_operation);
+@:picture_}{|picture| primitive@>
+mp_primitive(mp, "transform", mp_type_name_command, mp_transform_type_operation);
+@:transform_}{|transform| primitive@>
+mp_primitive(mp, "color", mp_type_name_command, mp_color_type_operation);
+@:color_}{|color| primitive@>
+mp_primitive(mp, "rgbcolor", mp_type_name_command, mp_color_type_operation);
+@:color_}{|rgbcolor| primitive@>
+mp_primitive(mp, "cmykcolor", mp_type_name_command, mp_cmykcolor_type_operation);
+@:color_}{|cmykcolor| primitive@>
+mp_primitive(mp, "pair", mp_type_name_command, mp_pair_type_operation);
+@:pair_}{|pair| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_type_name_command:
+ /* return mp_type_string(mp, m): */
+ return "";
+
+@ Now we are ready to handle type declarations, assuming that a |type_name| has
+just been scanned. We don't use the type to operation mix here, we just have
+am extra set of operations and a switch that maps on type.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_do_type_declaration (MP mp);
+
+@ @c
+static void flush_spurious_symbols_after_declared_variable (MP mp);
+
+void mp_do_type_declaration (MP mp)
+{
+ int t = mp_numeric_type; /* cur_mod >= mp_transform_type ? cur_mod : cur_mod + unknown_tag; */ /* the type being declared */
+ switch (cur_mod) {
+ case mp_string_type_operation: t = mp_unknown_string_type; break;
+ case mp_boolean_type_operation: t = mp_unknown_boolean_type; break;
+ case mp_path_type_operation: t = mp_unknown_path_type; break;
+ case mp_pen_type_operation: t = mp_unknown_pen_type; break;
+ case mp_nep_type_operation: t = mp_unknown_nep_type; break;
+ case mp_picture_type_operation: t = mp_unknown_picture_type; break;
+ case mp_transform_type_operation: t = mp_transform_type; break;
+ case mp_color_type_operation: t = mp_color_type; break;
+ case mp_cmykcolor_type_operation: t = mp_cmykcolor_type; break;
+ case mp_pair_type_operation: t = mp_pair_type; break;
+ case mp_numeric_type_operation: t = mp_numeric_type; break;
+ }
+
+ do {
+ mp_node p = mp_scan_declared_variable(mp); /* token list for a declared variable */
+ mp_node q; /* value node for the variable */
+ mp_flush_variable(mp, equiv_node(mp_get_sym_sym(p)), mp_link(p), 0);
+ q = mp_find_variable(mp, p);
+ if (q != NULL) {
+ mp_type(q) = t;
+ mp_set_value_number(q, zero_t); /* todo: this was |null| */
+ } else {
+ mp_back_error(
+ mp,
+ "Declared variable conflicts with previous vardef",
+ "You can't use, e.g., 'numeric foo[]' after 'vardef foo'. Proceed, and I'll ignore\n"
+ "the illegal redeclaration."
+ );
+ mp_get_x_next(mp);
+ }
+ mp_flush_node_list(mp, p);
+ if (cur_cmd < mp_comma_command) {
+ flush_spurious_symbols_after_declared_variable(mp);
+ }
+ } while (! mp_end_of_statement);
+}
+
+@
+@c
+static void flush_spurious_symbols_after_declared_variable (MP mp)
+{
+ const char *hlp = NULL;
+ if (cur_cmd == mp_numeric_command) {
+ hlp =
+ "Variables in declarations must consist entirely of names and explicit subscripts\n"
+ "like 'x15a' aren't permitted. I'm going to discard the junk I found here, up to the\n"
+ "next comma or the end of the declaration.";
+ } else {
+ hlp =
+ "Variables in declarations must consist entirely of names and collective\n"
+ "subscripts, e.g., 'x[]a'. Are you trying to use a reserved word in a variable\n"
+ "name? I'm going to discard the junk I found here, up to the next comma or the end\n"
+ "of the declaration.";
+ }
+ mp_back_error(
+ mp,
+ "Illegal suffix of declared variable will be flushed",
+ hlp
+ );
+ mp_get_x_next(mp);
+ mp->scanner_status = mp_flushing_state;
+ do {
+ get_t_next(mp);
+ @<Decrease the string reference count...@>
+ } while (cur_cmd < mp_comma_command); /* break on either |end_of_statement| or |comma| */
+ mp->scanner_status = mp_normal_state;
+}
+
+@ \MP's |main_control| procedure just calls |do_statement| repeatedly until
+coming to the end of the user's program. Each execution of |do_statement|
+concludes with |cur_cmd=semicolon|, |end_group|, or |stop|.
+
+@c
+static void mp_main_control (MP mp) {
+ do {
+ mp_do_statement(mp);
+ if (cur_cmd == mp_end_group_command) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_error(
+ mp,
+ "Extra 'endgroup'",
+ "I'm not currently working on a 'begingroup', so I had better not try to end\n"
+ "anything."
+ );
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ } while (cur_cmd != mp_stop_command);
+}
+
+int mp_run (MP mp)
+{
+ if (mp->history < mp_fatal_error_stop) {
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) {
+ return mp->history;
+ }
+ mp_main_control(mp); /* come to life */
+ mp_final_cleanup(mp); /* prepare for death */
+ mp_close_files_and_terminate(mp);
+ }
+ return mp->history;
+}
+
+@ This function allows setting of internals from an external source (like the
+command line or a controlling application).
+
+It accepts two |char *|'s, even for numeric assignments when it calls |atoi| to
+get an integer from the start of the string.
+
+@c
+void mp_set_internal (MP mp, char *n, char *v, int isstring)
+{
+ size_t l = strlen(n);
+ char err[256];
+ const char *errid = NULL;
+ if (l > 0) {
+ mp_sym p = mp_id_lookup(mp, n, l, 0);
+ if (p == NULL) {
+ errid = "variable does not exist";
+ } else if (eq_type(p) != mp_internal_command) {
+ errid = "variable is not an internal";
+ } else if ((internal_type(equiv(p)) == mp_string_type) && (isstring)) {
+ set_internal_string(equiv(p), mp_rts(mp, v));
+ } else if ((internal_type(equiv(p)) == mp_known_type) && (! isstring)) {
+ int test = atoi(v);
+ if (test > 16383 && mp->math_mode == mp_math_scaled_mode) {
+ errid = "value is too large";
+ } else if (test < -16383 && mp->math_mode == mp_math_scaled_mode) {
+ errid = "value is too small";
+ } else {
+ number_clone(internal_value(equiv(p)), unity_t);
+ number_multiply_int(internal_value(equiv(p)), test);
+ }
+ } else {
+ errid = "value has the wrong type";
+ }
+ }
+ if (errid != NULL) {
+ if (isstring) {
+ mp_snprintf(err, 256, "%s=\"%s\": %s, assignment ignored.", n, v, errid);
+ } else {
+ mp_snprintf(err, 256, "%s=%d: %s, assignment ignored.", n, atoi (v), errid);
+ }
+ mp_warn(mp, err);
+ }
+}
+
+@ @<Exported function headers@>=
+void mp_set_internal (MP mp, char *n, char *v, int isstring);
+
+@ For |mp_execute|, we need to define a structure to store the redirected input
+and output. This structure holds the five relevant streams: the three
+informational output streams, the PostScript generation stream, and the input
+stream. These streams have many things in common, so it makes sense to give them
+their own structure definition.
+
+\item{fptr} is a virtual file pointer
+\item{data} is the data this stream holds
+\item{cur} is a cursor pointing into |data|
+\item{size} is the allocated length of the data stream
+\item{used} is the actual length of the data stream
+
+There are small differences between input and output: |term_in| never uses
+|used|, whereas the other four never use |cur|.
+
+@<Exported types@>=
+# undef term_in
+# undef term_out
+
+typedef struct mp_run_data
+{
+ void *term_in; /* dummy pointer */
+ struct mp_edge_object *edges;
+} mp_run_data;
+
+@ We need a function to clear an output stream, this is called at the beginning
+of |mp_execute|. We also need one for destroying an output stream, this is called
+just before a stream is (re)opened.
+
+@ The global instance contains a pointer instead of the actual structure even
+though it is essentially static, because that makes it is easier to move the
+object around.
+
+@<Global ...@>=
+mp_run_data run_data;
+
+@ Another type is needed: the indirection will overload some of the file pointer
+objects in the instance (but not all). For clarity, an indirect object is used
+that wraps a |FILE *|.
+
+@<Types ... @>=
+typedef struct File {
+ FILE *f;
+} File;
+
+@ Here are all of the functions that need to be overloaded for |mp_execute|.
+
+@<Exported function headers@>=
+void mplib_shipout_backend (MP mp, void *h);
+
+@ This is where we fill them all in.
+
+@<Set default function pointers@>=
+mp->find_file = mp_find_file;
+mp->open_file = mp_open_file;
+mp->close_file = mp_close_file;
+mp->write_file = mp_write_file;
+mp->read_file = mp_read_file;
+mp->run_script = mp_run_script;
+mp->run_internal = mp_run_internal;
+mp->run_logger = mp_run_logger;
+mp->run_overload = mp_run_overload;
+mp->run_error = mp_run_error;
+mp->run_warning = mp_run_warning;
+mp->make_text = mp_make_text;
+mp->shipout_backend = mp_shipout_backend;
+
+mp->find_file_id = 0;
+mp->run_script_id = 0;
+mp->run_logger_id = 0;
+mp->run_error_id = 0;
+mp->run_warning_id = 0;
+mp->run_overload_id = 0;
+mp->make_text_id = 0;
+mp->open_file_id = 0;
+
+@ This might change too.
+
+@c
+void mplib_shipout_backend (MP mp, void *voidh)
+{
+ mp_edge_header_node h = (mp_edge_header_node) voidh;
+ mp_edge_object *hh = mp_gr_export (mp, h);
+ if (hh) {
+ mp_run_data *run = mp_rundata(mp);
+ if (run->edges == NULL) {
+ run->edges = hh;
+ } else {
+ mp_edge_object *p = run->edges;
+ while (p->next != NULL) {
+ p = p->next;
+ }
+ p->next = hh;
+ }
+ }
+}
+
+@ Perhaps this is the most important API function in the library.
+
+@<Exported function ...@>=
+extern mp_run_data *mp_rundata (MP mp);
+
+@ @c
+mp_run_data *mp_rundata (MP mp) {
+ return &(mp->run_data);
+}
+
+@ @<Finish non-interactive use@>=
+mp_memory_free(mp->term_in);
+mp->term_in = NULL;
+
+@ @<Start non-interactive work@>=
+@<Initialize the output routines@>
+mp->input_ptr = 0;
+mp->max_in_stack = mp_file_bottom_text;
+mp->in_open = mp_file_bottom_text;
+mp->open_parens = 0;
+mp->max_buf_stack = 0;
+mp->param_ptr = 0;
+mp->max_param_stack = 0;
+start = loc = 0;
+iindex = mp_file_bottom_text;
+nloc = nstart = NULL;
+mp->first = 0;
+line = 0;
+name = is_term;
+mp->force_eof = 0;
+if (mp->term_in == NULL) {
+ mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal);
+}
+mp->last = 0;
+mp->scanner_status = mp_normal_state;
+mp_fix_date_and_time(mp);
+if (mp->random_seed == 0) {
+ mp->random_seed = (number_to_scaled(internal_value(mp_time_internal))/number_to_scaled(unity_t))
+ + number_to_scaled(internal_value(mp_day_internal));
+}
+init_randoms(mp->random_seed);
+mp->selector = mp->interaction == mp_batch_mode ? mp_no_print_selector : mp_term_only_selector;
+mp->history = mp_spotless;
+if (mp->every_job_sym != NULL) {
+ set_cur_sym(mp->every_job_sym);
+ mp_back_input(mp);
+}
+
+@ @c
+int mp_execute (MP mp, const char *s, size_t l)
+{
+ (void) l;
+ if (mp->finished) {
+ return mp->history;
+ } else if (mp->history < mp_fatal_error_stop) {
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) {
+ return mp->history;
+ } else {
+ mp->term_offset = 0;
+ mp->file_offset = 0;
+ if (mp->term_in == NULL) {
+ mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal);
+ mp->last = 0;
+ }
+ if (s && l > 0) {
+ (mp->write_file)(mp, mp->term_in, s);
+ } else {
+ /* we already filled the terminal buffer, so no longer: */
+ /*
+ mp_final_cleanup(mp);
+ mp_close_files_and_terminate(mp);
+ return mp->history;
+ */
+ }
+ if (mp->run_state == 0) {
+ /* mp->selector = mp_term_only_selector; */
+ @<Start non-interactive work@>
+ }
+ mp->run_state = 1;
+ /* we grab one line */
+ mp_input_ln(mp, mp->term_in);
+ mp_firm_up_the_line(mp);
+ mp->buffer[limit] = '%';
+ mp->first = (size_t) (limit + 1);
+ loc = start;
+ do {
+ mp_do_statement(mp);
+ } while (cur_cmd != mp_stop_command);
+ mp_final_cleanup(mp);
+ mp_close_files_and_terminate(mp);
+ }
+ }
+ return mp->history;
+}
+
+@ This function cleans up
+
+@c
+int mp_finish (MP mp)
+{
+ int history = 0;
+ if (mp->finished || mp->history >= mp_fatal_error_stop) {
+ history = mp->history;
+ mp_free(mp);
+ } else {
+ mp_memory_free(mp->jump_buf);
+ mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf));
+ if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) {
+ history = mp->history;
+ } else {
+ history = mp->history;
+ mp_final_cleanup(mp); /* prepare for death */
+ }
+ mp_close_files_and_terminate(mp);
+ mp_free(mp);
+ }
+ return history;
+}
+
+@ People may want to know the library version
+@c
+char *mp_metapost_version(void) {
+ return mp_strdup(metapost_version);
+}
+
+@ @<Exported function headers@>=
+int mp_run (MP mp);
+int mp_execute (MP mp, const char *s, size_t l);
+int mp_finish (MP mp);
+char *mp_metapost_version (void);
+
+@ @<Put each...@>=
+mp_primitive(mp, "end", mp_stop_command, 0);
+@:end_}{|end| primitive@>
+mp_primitive(mp, "dump", mp_stop_command, 1);
+mp->frozen_dump = mp_frozen_primitive (mp, "dump", mp_stop_command, 1);
+@:dump_}{|dump| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_stop_command:
+ return cur_mod == 0 ? "end" : "dump";
+
+@* Commands.
+
+Let's turn now to statements that are classified as \quote {commands} because of their
+imperative nature. We'll begin with simple ones, so that it will be clear how to
+hook command processing into the |do_statement| routine; then we'll tackle the
+tougher commands.
+
+Here's one of the simplest (when we have more seters thsi will change into one
+function and a genericmessage).
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_max_knot_pool (MP mp);
+
+@ @c
+void mp_do_max_knot_pool (MP mp)
+{
+ /* similar to the random seed setter */
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing ':=' has been inserted",
+ "Always say 'maxknotpool := <numeric expression>'."
+ );
+ @.Missing `:='@>
+ };
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Unknown value will be ignored",
+ "Your expression was too random for me to handle, so I won't change the maximum\n"
+ "seed just now."
+ );
+ @.Unknown value...ignored@>
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ /* the action */
+ int p = (int) number_to_scaled (cur_exp_value_number) / 65536;
+ if (p > mp->max_knot_nodes) {
+ mp->max_knot_nodes = p;
+ } else if (p > max_num_knot_nodes) {
+ /* not now: flush excess nodes */
+ } else {
+ /* we always keep the minimum */
+ }
+ }
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_random_seed (MP mp);
+
+@ @c
+void mp_do_random_seed (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing ':=' has been inserted",
+ "Always say 'randomseed := <numeric expression>'."
+ );
+ @.Missing `:='@>
+ };
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Unknown value will be ignored",
+ "Your expression was too random for me to handle, so I won't change the random\n"
+ "seed just now."
+ );
+ @.Unknown value...ignored@>
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ @<Initialize the random seed to |cur_exp|@>
+ }
+}
+
+@ @<Initialize the random seed to |cur_exp|@>=
+init_randoms(number_to_scaled(cur_exp_value_number));
+if (mp->interaction < mp_silent_mode && (mp->selector == mp_log_only_selector || mp->selector == mp_term_and_log_selector)) {
+ int selector = mp->selector;
+ mp->selector = mp_log_only_selector;
+ mp_print_nl(mp, "{randomseed:=");
+ print_number(cur_exp_value_number);
+ mp_print_chr(mp, '}');
+ mp_print_nl(mp, "");
+ mp->selector = selector;
+}
+
+@ And here's another simple one (somewhat different in flavor):
+
+@ @<Put each...@>=
+mp_primitive(mp, "batchmode", mp_mode_command, mp_batch_mode);
+@:mp_batch_mode_}{|batchmode| primitive@>
+mp_primitive(mp, "nonstopmode", mp_mode_command, mp_nonstop_mode);
+@:mp_nonstop_mode_}{|nonstopmode| primitive@>
+mp_primitive(mp, "scrollmode", mp_mode_command, mp_scroll_mode);
+@:mp_scroll_mode_}{|scrollmode| primitive@>
+mp_primitive(mp, "errorstopmode", mp_mode_command, mp_error_stop_mode);
+@:mp_error_stop_mode_}{|errorstopmode| primitive@>
+mp_primitive(mp, "silentmode", mp_mode_command, mp_silent_mode);
+@:mp_silent_mode_}{|silentmode| primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+case mp_mode_command:
+ switch (m) {
+ case mp_batch_mode : return "batchmode";
+ case mp_nonstop_mode : return "nonstopmode";
+ case mp_scroll_mode : return "scrollmode";
+ case mp_error_stop_mode: return "errorstopmode";
+ default : return "silentmode";
+ }
+break;
+
+@ The |inner| and |outer| commands are only slightly harder.
+
+@ @<Put each...@>=
+mp_primitive(mp, "inner", mp_protection_command, 0);
+@:inner_}{|inner| primitive@>
+mp_primitive(mp, "outer", mp_protection_command, 1);
+@:outer_}{|outer| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_protection_command:
+ switch (m) {
+ case 0: return "inner";
+ case 1: return "outer";
+ }
+ break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_protection (MP mp);
+
+@ @c
+void mp_do_protection (MP mp)
+{
+// int m = cur_mod; /* 0 to unprotect, 1 to protect */
+ do {
+// int t; /* the |eq_type| before we change it */
+ mp_get_symbol(mp);
+// t = eq_type(cur_sym);
+// switch(m) {
+// case 0:
+// if (t >= mp_outer_tag_command) {
+// set_eq_type(cur_sym, (t - mp_outer_tag_command));
+// }
+// break;
+// case 1:
+// if (t < mp_outer_tag_command) {
+// set_eq_type(cur_sym, (t + mp_outer_tag_command));
+// }
+// break;
+// }
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+@ The |setproperty| command expects a numeric, followed by a color and then
+a list of symbols (names) that get that numeric value as property value. We use
+a plural because one can use bitsets. This property, when larger than zero, can
+trigger a callback when |overloadmode| is other than zero. This mechanism is
+quite experimental and used in \CONTEXT\ for protecting definitions.
+
+@ @<Put each...@>=
+mp_primitive(mp, "setproperty", mp_property_command, 1);
+@:setproperty_}{|setproperty| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_property_command:
+ return "setproperty";
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_property (MP mp);
+
+@ @c
+// mp_scan_numeric_value(mp, 0, &p);
+
+void mp_do_property (MP mp)
+{
+ int p = 0;
+ mp_get_x_next(mp);
+ mp_scan_primary(mp);
+ switch (mp->cur_exp.type) {
+ case mp_numeric_type:
+ case mp_known_type:
+ {
+ mp_back_input(mp);
+ p = (int) number_to_scaled (cur_exp_value_number) / 65536; // hm
+ }
+ break;
+ default:
+ mp_back_error(mp, "Bad property value", NULL);
+ break;
+ }
+ mp_get_x_next(mp);
+ if (cur_cmd == mp_colon_command) {
+ do {
+ mp_get_symbol(mp);
+ set_eq_property(cur_sym, p);
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+ } else {
+ mp_back_error(mp, "Bad property specification, colon expected", NULL);
+ }
+}
+
+@ \MP\ never defines the tokens |(| and |)| to be primitives, but plain \MP\
+begins with the declaration `|delimiters| |()|'. Such a declaration assigns
+the command code |left_delimiter| to |(| and |right_delimiter| to |)|;
+the |equiv| of each delimiter is the hash address of its mate.
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_def_delims (MP mp);
+
+@ @c
+void mp_def_delims (MP mp)
+{
+ mp_sym l_delim, r_delim; /* the new delimiter pair */
+ mp_get_clear_symbol(mp);
+ l_delim = cur_sym;
+ mp_get_clear_symbol(mp);
+ r_delim = cur_sym;
+ set_eq_type(l_delim, mp_left_delimiter_command);
+ set_equiv_sym(l_delim, r_delim);
+ set_eq_type(r_delim, mp_right_delimiter_command);
+ set_equiv_sym(r_delim, l_delim);
+ mp_get_x_next(mp);
+}
+
+@ Here is a procedure that is called when \MP\ has reached a point where some
+right delimiter is mandatory.
+
+@<Declarations@>=
+static void mp_check_delimiter (MP mp, mp_sym l_delim, mp_sym r_delim);
+
+@ @c
+void mp_check_delimiter (MP mp, mp_sym l_delim, mp_sym r_delim)
+{
+ if (cur_cmd == mp_right_delimiter_command && equiv_sym(cur_sym) == l_delim) {
+ return;
+ } else if (cur_sym != r_delim) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim)));
+ @.Missing `)'@>
+ mp_back_error(
+ mp,
+ msg,
+ "I found no right delimiter to match a left one. So I've put one in, behind the\n"
+ "scenes; this may fix the problem."
+ );
+ } else {
+ char msg[256];
+ mp_snprintf(msg, 256, "The token '%s' is no longer a right delimiter", mp_str(mp, text(r_delim)));
+ @.The token...delimiter@>
+ mp_error(
+ mp,
+ msg,
+ "Strange: This token has lost its former meaning! I'll read it as a right\n"
+ "delimiter this time; but watch out, I'll probably miss it later."
+ );
+ }
+}
+
+@ The next four commands save or change the values associated with tokens.
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_statement (MP mp);
+static void mp_do_interim (MP mp);
+
+@ @c
+void mp_do_interim (MP mp) {
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_internal_command) {
+ char msg[256];
+ mp_snprintf(msg, 256,
+ "The token '%s' isn't an internal quantity",
+ (cur_sym == NULL ? "(%CAPSULE)" : mp_str(mp, text(cur_sym)))
+ );
+ @.The token...quantity@>
+ mp_back_error(mp, msg, "Something like 'tracingonline' should follow 'interim'.");
+ } else {
+ mp_save_internal(mp, cur_mod);
+ mp_back_input(mp);
+ }
+ mp_do_statement(mp);
+}
+
+@ The following procedure is careful not to undefine the left-hand symbol too
+soon, lest commands like `{\tt let x=x}' have a surprising effect.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_do_let (MP mp);
+
+@ @c
+void mp_do_let (MP mp)
+{
+ mp_sym l; /* hash location of the left-hand symbol */
+ mp_get_symbol(mp);
+ l = cur_sym;
+ mp_get_x_next(mp);
+ if (cur_cmd != mp_equals_command && cur_cmd != mp_assignment_command) {
+ mp_back_error(
+ mp,
+ "Missing '=' has been inserted",
+ "You should have said 'let symbol = something'. But don't worry; I'll pretend that\n"
+ "an equals sign was present. The next token I read will be 'something'."
+ );
+ @.Missing `='@>
+ }
+ mp_get_symbol(mp);
+ switch (cur_cmd) {
+ case mp_defined_macro_command:
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ mp_add_mac_ref(cur_mod_node);
+ break;
+ default:
+ break;
+ }
+ mp_clear_symbol(mp, l, 0);
+ set_eq_type(l, cur_cmd);
+ switch (cur_cmd) {
+ case mp_tag_command:
+ set_equiv(l, 0); /* todo: this was |null| */
+ break;
+ case mp_defined_macro_command:
+ case mp_primary_def_command:
+ case mp_secondary_def_command:
+ case mp_tertiary_def_command:
+ set_equiv_node(l, cur_mod_node);
+ break;
+ case mp_left_delimiter_command:
+ case mp_right_delimiter_command:
+ set_equiv_sym(l, equiv_sym(cur_sym));
+ break;
+ default:
+ set_equiv(l, cur_mod);
+ break;
+ }
+ mp_get_x_next(mp);
+}
+
+@ @<Declarations@>=
+static void mp_do_new_internal (MP mp);
+
+@ @<Internal library ...@>=
+void mp_grow_internals (MP mp, int l);
+
+@ @c
+void mp_grow_internals (MP mp, int l)
+{
+ if (l > max_halfword) {
+ mp_confusion(mp, "out of memory"); /* can't be reached */
+ } else {
+ mp_internal *internal = mp_memory_allocate((size_t) (l + 1) * sizeof(mp_internal));
+ for (int k = 0; k <= l; k++) {
+ if (k <= mp->max_internal) {
+ memcpy(internal + k, mp->internal + k, sizeof(mp_internal));
+ } else {
+ memset(internal + k, 0, sizeof(mp_internal));
+ new_number(((mp_internal *)(internal + k))->v.data.n);
+ }
+ }
+ mp_memory_free(mp->internal);
+ mp->internal = internal;
+ mp->max_internal = l;
+ }
+}
+
+
+/* newinternal [numeric|string|boolean] [runscript] | [runscript] */
+
+/* 0:allocate 1:push 2:pop 3:pushlogging 4:poplogging */
+
+void mp_do_new_internal (MP mp)
+{
+ int the_type = mp_known_type;
+ int run_script = 0;
+ mp_get_next(mp); /* not mp_get_next(mp) because we don't want to expand runscript */
+ if (cur_cmd == mp_type_name_command && cur_mod == mp_string_type_operation) {
+ the_type = mp_string_type;
+ } else if (cur_cmd == mp_type_name_command && cur_mod == mp_boolean_type_operation) {
+ the_type = mp_boolean_type;
+ } else if (cur_cmd == mp_type_name_command && cur_mod == mp_numeric_type_operation) {
+ the_type = mp_numeric_type;
+ } else if (! (cur_cmd == mp_type_name_command && cur_mod == mp_numeric_type_operation)) {
+ mp_back_input(mp);
+ }
+ if (mp_numeric_type == mp_known_type) {
+ /* We do as traditional MP does. */
+ } else {
+ /* We have an explicit type and check for run_internal. */
+ if (the_type == mp_numeric_type) {
+ the_type = mp_known_type;
+ }
+ mp_get_next(mp); /* not mp_get_next(mp) because we don't want to expand runscript */
+ if (cur_cmd == mp_runscript_command) {
+ run_script = 1; /* run_internal */
+ } else {
+ mp_back_input(mp);
+ }
+ }
+ do {
+ if (mp->int_ptr == mp->max_internal) {
+ mp_grow_internals(mp, (mp->max_internal + (mp->max_internal / 4)));
+ }
+ mp_get_clear_symbol(mp);
+ ++mp->int_ptr;
+ set_eq_type(cur_sym, mp_internal_command);
+ set_equiv(cur_sym, mp->int_ptr);
+ mp_memory_free(internal_name(mp->int_ptr));
+ set_internal_name(mp->int_ptr, mp_strdup(mp_str(mp, text(cur_sym))));
+ if (the_type == mp_string_type) {
+ set_internal_string(mp->int_ptr, mp_rts(mp,""));
+ } else {
+ set_number_to_zero(internal_value(mp->int_ptr));
+ }
+ set_internal_type(mp->int_ptr, the_type);
+ set_internal_run(mp->int_ptr, run_script);
+ if (run_script) {
+ mp->run_internal(mp, 0, mp->int_ptr, the_type, internal_name(mp->int_ptr));
+ }
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+@ @<Dealloc variables@>=
+for (int k = 0; k <= mp->max_internal; k++) {
+ free_number(mp->internal[k].v.data.n);
+ mp_memory_free(internal_name(k));
+}
+mp_memory_free(mp->internal);
+
+@ The various |show| commands are distinguished by modifier fields in the
+usual way.
+
+@<Enumeration types@>=
+typedef enum mp_show_codes {
+ mp_show_token_code, /* show the meaning of a single token */
+ mp_show_stats_code, /* show current memory and string usage */
+ mp_show_code, /* show a list of expressions */
+ mp_show_var_code, /* show a variable and its descendents */
+ mp_show_dependencies_code, /* show dependent variables in terms of independents */
+} mp_show_codes;
+
+@ @<Put each...@>=
+mp_primitive(mp, "showtoken", mp_show_command, mp_show_token_code);
+@:show_token_}{|showtoken| primitive@>
+mp_primitive(mp, "showstats", mp_show_command, mp_show_stats_code);
+@:show_stats_}{|showstats| primitive@>
+mp_primitive(mp, "show", mp_show_command, mp_show_code);
+@:show_}{|show| primitive@>
+mp_primitive(mp, "showvariable", mp_show_command, mp_show_var_code);
+@:show_var_}{|showvariable| primitive@>
+mp_primitive(mp, "showdependencies", mp_show_command, mp_show_dependencies_code);
+@:show_dependencies_}{|showdependencies| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_show_command:
+ switch (m) {
+ case mp_show_token_code : return "showtoken";
+ case mp_show_stats_code : return "showstats";
+ case mp_show_code : return "show";
+ case mp_show_var_code : return "showvariable";
+ case mp_show_dependencies_code: return "showdependencies";
+ }
+ break;
+
+@ The value of |cur_mod| controls the |verbosity| in the |print_exp| routine: if
+it's |show_code|, complicated structures are abbreviated, otherwise they aren't.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_do_show (MP mp);
+
+@ @c
+void mp_do_show (MP mp)
+{
+ do {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ mp_print_nl(mp, ">> ");
+ @.>>@>
+ mp_print_exp(mp, NULL, 2);
+ mp_flush_cur_exp(mp, new_expr);
+ } while (cur_cmd == mp_comma_command);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_disp_token (MP mp);
+
+@ @c
+void mp_disp_token (MP mp)
+{
+ mp_print_nl(mp, "> ");
+ @.>\relax@>
+ if (cur_sym == NULL) {
+ /* Show a numeric or string or capsule token */
+ switch (cur_cmd) {
+ case mp_numeric_command:
+ print_number(cur_mod_number);
+ break;
+ case mp_capsule_command:
+ mp_print_capsule(mp, cur_mod_node);
+ break;
+ default:
+ mp_print_chr(mp, '"');
+ mp_print_mp_str(mp, cur_mod_str);
+ mp_print_chr(mp, '"');
+ delete_str_ref(cur_mod_str);
+ break;
+ }
+ } else {
+ mp_print_mp_str(mp,text(cur_sym));
+ mp_print_chr(mp, '=');
+ // if (eq_type(cur_sym) >= mp_outer_tag_command) {
+ // mp_print_str(mp, "(outer) ");
+ // }
+ mp_print_cmd_mod(mp, cur_cmd, cur_mod);
+ if (cur_cmd == mp_defined_macro_command) {
+ mp_print_ln(mp);
+ mp_show_macro (mp, cur_mod_node, NULL);
+ }
+ /* this avoids recursion between |show_macro| and |print_cmd_mod| */
+ @^recursion@>
+ }
+}
+
+@ The following cases of |print_cmd_mod| might arise in connection with
+|disp_token|, although they don't necessarily correspond to primitive tokens.
+
+@<Cases of |print_cmd_...@>=
+case mp_left_delimiter_command:
+case mp_right_delimiter_command:
+ return c == mp_left_delimiter_command ? "left delimiter" : "right delimiter";
+case mp_tag_command:
+ return m == 0 ? "tag" : "variable";
+case mp_defined_macro_command:
+ return "macro:";
+case mp_primary_def_command:
+ return "primarydef";
+case mp_secondary_def_command:
+ return "secondarydef";
+case mp_tertiary_def_command:
+ return "tertiarydef";
+case mp_repeat_loop_command:
+ return "[repeat the loop]";
+case mp_internal_command:
+ return internal_name(m);
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_show_token (MP mp);
+
+@ @c
+void mp_do_show_token (MP mp)
+{
+ do {
+ get_t_next(mp);
+ mp_disp_token(mp);
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_show_stats (MP mp);
+
+@ @c
+void mp_do_show_stats (MP mp)
+{
+ mp_print_nl(mp, "Memory usage ");
+ @.Memory usage...@>
+ mp_print_int(mp, (int) mp->var_used);
+ mp_print_ln(mp);
+ mp_print_nl(mp, "String usage ");
+ mp_print_int(mp, (int) mp->strs_in_use);
+ mp_print_chr(mp, '&');
+ mp_print_int(mp, (int) mp->pool_in_use);
+ mp_print_ln(mp);
+ mp_get_x_next(mp);
+}
+
+@ Here's a recursive procedure that gives an abbreviated account of a variable,
+for use by |do_show_var|.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_disp_var (MP mp, mp_node p);
+
+@ @c
+void mp_disp_var (MP mp, mp_node p)
+{
+ if (mp_type(p) == mp_structured_type) {
+ /* Descend the structure */
+ mp_node q = mp_get_attribute_head(p);
+ do {
+ mp_disp_var(mp, q);
+ q = mp_link(q);
+ } while (q != mp->end_attr);
+ q = mp_get_subscr_head(p);
+ while (mp_name_type(q) == mp_subscript_operation) {
+ mp_disp_var(mp, q);
+ q = mp_link(q);
+ }
+ } else if (mp_type(p) >= mp_unsuffixed_macro_type) {
+ /* Display a variable macro */
+ mp_print_nl(mp, "");
+ mp_print_variable_name(mp, p);
+ if (mp_type(p) > mp_unsuffixed_macro_type) {
+ mp_print_str(mp, "@@#"); /* |suffixed_macro| */
+ }
+ mp_print_str(mp, "=macro:");
+ mp_show_macro(mp, mp_get_value_node(p), NULL);
+ } else if (mp_type(p) != mp_undefined_type) {
+ mp_print_nl(mp, "");
+ mp_print_variable_name(mp, p);
+ mp_print_chr(mp, '=');
+ mp_print_exp(mp, p, 0);
+ }
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_show_var (MP mp);
+
+@ @c
+void mp_do_show_var (MP mp)
+{
+ do {
+ get_t_next(mp);
+ if (cur_sym != NULL && cur_sym_mod == 0 && cur_cmd == mp_tag_command) {
+ if (cur_mod != 0 || cur_mod_node != NULL) {
+ mp_disp_var(mp, cur_mod_node);
+ goto DONE;
+ }
+ }
+ mp_disp_token(mp);
+ DONE:
+ mp_get_x_next(mp);
+ } while (cur_cmd == mp_comma_command);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_show_dependencies (MP mp);
+
+@ @c
+void mp_do_show_dependencies (MP mp)
+{
+ /* link that runs through all dependencies */
+ mp_value_node p = (mp_value_node) mp_link(mp->dep_head);
+ while (p != mp->dep_head) {
+ if (mp_interesting(mp, (mp_node) p)) {
+ mp_print_nl(mp, "");
+ mp_print_variable_name(mp, (mp_node) p);
+ if (mp_type(p) == mp_dependent_type) {
+ mp_print_chr(mp, '=');
+ } else {
+ mp_print_str(mp, " = "); /* extra spaces imply proto-dependency */
+ }
+ mp_print_dependency(mp, (mp_value_node) mp_get_dep_list(p), mp_type(p));
+ }
+ p = (mp_value_node) mp_get_dep_list(p);
+ while (mp_get_dep_info(p) != NULL)
+ p = (mp_value_node) mp_link(p);
+ p = (mp_value_node) mp_link(p);
+ }
+ mp_get_x_next(mp);
+}
+
+@ Finally we are ready for the procedure that governs all of the show commands.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_do_show_whatever (MP mp);
+
+@ @c
+void mp_do_show_whatever (MP mp)
+{
+ if (mp->interaction == mp_error_stop_mode) {
+ wake_up_terminal();
+ }
+ switch (cur_mod) {
+ case mp_show_token_code:
+ mp_do_show_token(mp);
+ break;
+ case mp_show_stats_code:
+ mp_do_show_stats(mp);
+ break;
+ case mp_show_code:
+ mp_do_show(mp);
+ break;
+ case mp_show_var_code:
+ mp_do_show_var(mp);
+ break;
+ case mp_show_dependencies_code:
+ mp_do_show_dependencies(mp);
+ break;
+ }
+ if (number_positive(internal_value(mp_showstopping_internal))) {
+ const char *hlp = NULL;
+ if (mp->interaction < mp_error_stop_mode) {
+ --mp->error_count;
+ } else {
+ hlp = "This isn't an error message; I'm just showing something.";
+ }
+ if (cur_cmd == mp_semicolon_command) {
+ mp_error(mp, "OK", hlp);
+ } else {
+ mp_back_error(mp, "OK", hlp);
+ mp_get_x_next(mp);
+ }
+ @.OK@>
+ }
+}
+
+@ We have all kind of with variants.
+
+@<Enumeration types@>=
+typedef enum mp_with_codes {
+ mp_with_pen_code,
+ mp_with_dashed_code,
+ mp_with_pre_script_code,
+ mp_with_post_script_code,
+ mp_with_stacking_code,
+ mp_with_no_model_code,
+ mp_with_grey_model_code,
+ mp_with_uninitialized_model_code,
+ mp_with_rgb_model_code,
+ mp_with_cmyk_model_code,
+ mp_with_linecap_code,
+ mp_with_linejoin_code,
+ mp_with_miterlimit_code,
+} mp_with_codes;
+
+@ We use enums so that it looks better in the editor:
+
+@<Enumeration types@>=
+typedef enum mp_add_codes {
+ mp_add_double_path_code, /* command modifier for |doublepath| */
+ mp_add_contour_code, /* command modifier for |contour| */
+ mp_add_also_code, /* command modifier for |also| */
+} mp_add_codes ;
+
+@ The |addto| command needs the following additional primitives:
+
+@<Put each...@>=
+mp_primitive(mp, "doublepath", mp_thing_to_add_command, mp_add_double_path_code);
+@:double_path_}{|doublepath| primitive@>
+mp_primitive(mp, "contour", mp_thing_to_add_command, mp_add_contour_code);
+@:contour_}{|contour| primitive@>
+mp_primitive(mp, "also", mp_thing_to_add_command, mp_add_also_code);
+@:also_}{|also| primitive@>
+mp_primitive(mp, "withpen", mp_with_option_command, mp_with_pen_code);
+@:with_pen_}{|withpen| primitive@>
+mp_primitive(mp, "dashed", mp_with_option_command, mp_with_dashed_code);
+@:dashed_}{|dashed| primitive@>
+mp_primitive(mp, "withprescript", mp_with_option_command, mp_with_pre_script_code);
+@:with_mp_pre_script_}{|withprescript| primitive@>
+mp_primitive(mp, "withpostscript", mp_with_option_command, mp_with_post_script_code);
+@:with_mp_post_script_}{|withpostscript| primitive@>
+mp_primitive(mp, "withstacking", mp_with_option_command, mp_with_stacking_code);
+@:with_mp_stacking_}{|withstacking| primitive@>
+mp_primitive(mp, "withlinecap", mp_with_option_command, mp_with_linecap_code);
+@:with_mp_linecap_}{|withlinecap| primitive@>
+mp_primitive(mp, "withlinejoin", mp_with_option_command, mp_with_linejoin_code);
+@:with_mp_linejoin_}{|withlinejoin| primitive@>
+mp_primitive(mp, "withmiterlimit", mp_with_option_command, mp_with_miterlimit_code);
+@:with_mp_miterlimit_}{|withmiterlimit| primitive@>
+mp_primitive(mp, "withoutcolor", mp_with_option_command, mp_with_no_model_code);
+@:with_color_}{|withoutcolor| primitive@>
+mp_primitive(mp, "withgreyscale", mp_with_option_command, mp_with_grey_model_code);
+@:with_color_}{|withgreyscale| primitive@>
+mp_primitive(mp, "withcolor", mp_with_option_command, mp_with_uninitialized_model_code);
+@:with_color_}{|withcolor| primitive@>
+mp_primitive(mp, "withrgbcolor", mp_with_option_command, mp_with_rgb_model_code);
+@:with_color_}{|withrgbcolor| primitive@>
+mp_primitive(mp, "withcmykcolor", mp_with_option_command, mp_with_cmyk_model_code);
+@:with_color_}{|withcmykcolor| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_thing_to_add_command:
+ switch (m) {
+ case mp_add_contour_code : return "contour";
+ case mp_add_double_path_code: return "doublepath";
+ case mp_add_also_code : return "also";
+ }
+ break;
+
+case mp_with_option_command:
+ switch (m) {
+ case mp_with_pen_code : return "withpen";
+ case mp_with_pre_script_code : return "withprescript";
+ case mp_with_post_script_code : return "withpostscript";
+ case mp_with_stacking_code : return "withstacking";
+ case mp_with_no_model_code : return "withoutcolor";
+ case mp_with_rgb_model_code : return "withrgbcolor";
+ case mp_with_uninitialized_model_code: return "withcolor";
+ case mp_with_cmyk_model_code : return "withcmykcolor";
+ case mp_with_grey_model_code : return "withgreyscale";
+ case mp_with_linecap_code : return "withlinecap";
+ case mp_with_linejoin_code : return "withlinejoin";
+ case mp_with_miterlimit_code : return "withmiterlimit";
+ default : return "dashed";
+ }
+ break;
+
+@ The |scan_with_list| procedure parses a $\langle$with list$\rangle$ and updates
+the list of graphical objects starting at |p|. Each $\langle$with clause$\rangle$
+updates all graphical objects whose |type| is compatible. Other objects are
+ignored.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_scan_with_list (MP mp, mp_node p, mp_node pp);
+
+@ Forcing the color to be between |0| and |unity| here guarantees that no picture
+will ever contain a color outside the legal range for \ps\ graphics.
+
+@d make_cp_a_colored_object(cp,p) do {
+ cp = p;
+ while (cp != NULL) {
+ if (mp_has_color(cp)) {
+ break;
+ } else {
+ cp = mp_link(cp);
+ }
+ }
+} while (0)
+
+@d set_color_val(A,B) do {
+ if (number_negative(A)) {
+ set_number_to_zero(A);
+ } else if (number_greater(A,unity_t)) {
+ set_number_to_unity(A);
+ } else {
+ number_clone(A, (B));
+ }
+} while (0)
+
+@ @<Declarations@>=
+/* void mp_clear_color (MP mp, void *n); */
+
+@ @c
+/* void mp_clear_color (MP mp, void *n)
+{
+ set_number_to_zero(((mp_shape_node) n)->cyan);
+ set_number_to_zero(((mp_shape_node) n)->magenta);
+ set_number_to_zero(((mp_shape_node) n)->yellow);
+ set_number_to_zero(((mp_shape_node) n)->black);
+ mp_color_model(n) = mp_uninitialized_model;
+} */
+
+@ @c
+static void complain_invalid_with_list (MP mp, mp_variable_type t)
+{
+ /* Complain about improper type */
+ mp_value new_expr;
+ const char *hlp = NULL;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ switch (t) {
+ case mp_with_pre_script_code:
+ hlp =
+ "Next time say 'withprescript <known string expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_post_script_code:
+ hlp =
+ "Next time say 'withpostscript <known string expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_stacking_code:
+ hlp =
+ "Next time say 'withstacking <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_dashed_code:
+ hlp =
+ "Next time say 'dashed <known picture expression>'; I'll ignore the bad 'with'\n"
+ "clause and look for another.";
+ break;
+ case mp_with_uninitialized_model_code:
+ hlp =
+ "Next time say 'withcolor <known color expression>'; I'll ignore the bad 'with'\n"
+ "clause and look for another.";
+ break;
+ case mp_with_rgb_model_code:
+ hlp =
+ "Next time say 'withrgbcolor <known color expression>'; I'll ignore the bad 'with'\n"
+ "clause and look for another.";
+ break;
+ case mp_with_cmyk_model_code:
+ hlp =
+ "Next time say 'withcmykcolor <known cmykcolor expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_grey_model_code:
+ hlp =
+ "Next time say 'withgreyscale <known numeric expression>'; I'll ignore the bad\n"
+ " with' clause and look for another.";
+ break;
+ case mp_with_linecap_code:
+ hlp =
+ "Next time say 'withlinecap <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_linejoin_code:
+ hlp =
+ "Next time say 'withlinejoin <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ case mp_with_miterlimit_code:
+ hlp =
+ "Next time say 'miterlimit <known numeric expression>'; I'll ignore the bad\n"
+ "'with' clause and look for another.";
+ break;
+ default:
+ hlp =
+ "Next time say 'withpen <known pen expression>'; I'll ignore the bad 'with' clause\n"
+ "and look for another.";
+ break;
+ }
+ mp_back_error(mp, "Improper type", hlp);
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+void mp_scan_with_list (MP mp, mp_node p, mp_node pstop)
+{
+ mp_node cp = MP_VOID; /* can't we reuse some? */
+ mp_node pp = MP_VOID;
+ mp_node dp = MP_VOID;
+ mp_node ap = MP_VOID;
+ mp_node bp = MP_VOID;
+ mp_node sp = MP_VOID;
+ mp_node spstop = MP_VOID;
+ mp_number ml;
+ int miterlimit = 0;
+ int linecap = -1;
+ int linejoin = -1;
+ while (cur_cmd == mp_with_option_command) {
+ /* |cur_mod| of the |with_option| (should match |cur_type|) */
+ int t;
+ CONTINUE:
+ t = cur_mod;
+ mp_get_x_next(mp);
+ if (t != mp_with_no_model_code) {
+ mp_scan_expression(mp);
+ }
+ switch (t) {
+ case mp_with_uninitialized_model_code :
+ switch (mp->cur_exp.type) {
+ case mp_cmykcolor_type:
+ case mp_color_type:
+ case mp_known_type:
+ case mp_boolean_type:
+ {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ /* Transfer a color from the current expression to object~|cp| */
+ switch (mp->cur_exp.type) {
+ case mp_color_type:
+ {
+ /* Transfer a rgbcolor from the current expression to object~|cp| */
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_rgb_model;
+ set_color_val(mp_red_color(cp), mp_get_value_number(mp_red_part(q)));
+ set_color_val(mp_green_color(cp), mp_get_value_number(mp_green_part(q)));
+ set_color_val(mp_blue_color(cp), mp_get_value_number(mp_blue_part(q)));
+ set_number_to_zero(mp_black_color(cp));
+ }
+ break;
+ case mp_cmykcolor_type:
+ {
+ /* Transfer a cmykcolor from the current expression to object~|cp| */
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_cmyk_model;
+ set_color_val(mp_cyan_color(cp), mp_get_value_number(mp_cyan_part(q)));
+ set_color_val(mp_magenta_color(cp), mp_get_value_number(mp_magenta_part(q)));
+ set_color_val(mp_yellow_color(cp), mp_get_value_number(mp_yellow_part(q)));
+ set_color_val(mp_black_color(cp), mp_get_value_number(mp_black_part(q)));
+ }
+ break;
+ case mp_known_type:
+ {
+ /* Transfer a greyscale from the current expression to object~|cp| */
+ // mp_number qq;
+ // new_number_clone(qq, cur_exp_value_number);
+ mp_color_model(cp) = mp_grey_model;
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_color_val(mp_grey_color(cp), cur_exp_value_number);
+ // set_color_val(mp_grey_color(cp), qq);
+ // free_number(qq);
+ }
+ break;
+ default:
+ switch (cur_exp_value_boolean) {
+ case mp_false_operation:
+ /* Transfer a noncolor from the current expression to object~|cp| */
+ mp_color_model(cp) = mp_no_model;
+ break;
+ case mp_true_operation:
+ /* Transfer no color from the current expression to object~|cp| */
+ mp_color_model(cp) = mp_uninitialized_model;
+ break;
+ default:
+ break;
+ }
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_number_to_zero(mp_black_color(cp));
+ break;
+ }
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ default:
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ break;
+ case mp_with_rgb_model_code:
+ if (mp->cur_exp.type != mp_color_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ /* Transfer a rgbcolor from the current expression to ob ject~|cp| */
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_rgb_model;
+ set_color_val(mp_red_color(cp), mp_get_value_number(mp_red_part(q)));
+ set_color_val(mp_green_color(cp), mp_get_value_number(mp_green_part(q)));
+ set_color_val(mp_blue_color(cp), mp_get_value_number(mp_blue_part(q)));
+ set_number_to_zero(mp_black_color(cp));
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_with_cmyk_model_code:
+ if (mp->cur_exp.type != mp_cmykcolor_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ /* Transfer a cmykcolor from the current expression to object~|cp| */
+ mp_node q = mp_get_value_node(cur_exp_node);
+ mp_color_model(cp) = mp_cmyk_model;
+ set_color_val(mp_cyan_color(cp), mp_get_value_number(mp_cyan_part(q)));
+ set_color_val(mp_magenta_color(cp), mp_get_value_number(mp_magenta_part(q)));
+ set_color_val(mp_yellow_color(cp), mp_get_value_number(mp_yellow_part(q)));
+ set_color_val(mp_black_color(cp), mp_get_value_number(mp_black_part(q)));
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_with_grey_model_code:
+ if (mp->cur_exp.type != mp_known_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ /* Transfer a greyscale from the current expression to object~|cp| */
+ // mp_number qq;
+ // new_number_clone(qq, cur_exp_value_number);
+ mp_color_model(cp) = mp_grey_model;
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_color_val(mp_grey_color(cp), cur_exp_value_number);
+ // set_color_val(mp_grey_color(cp), qq);
+ // free_number(qq);
+ }
+ mp_flush_cur_exp(mp, new_expr);
+ }
+ break;
+ case mp_with_no_model_code:
+ if (cp == MP_VOID) {
+ make_cp_a_colored_object(cp, p);
+ }
+ if (cp != NULL) {
+ /* Transfer a noncolor from the current expression to object~|cp| */
+ mp_color_model(cp) = mp_no_model;
+ set_number_to_zero(mp_cyan_color(cp));
+ set_number_to_zero(mp_magenta_color(cp));
+ set_number_to_zero(mp_yellow_color(cp));
+ set_number_to_zero(mp_grey_color(cp));
+ }
+ break;
+ case mp_with_pen_code:
+ if (mp->cur_exp.type != mp_pen_type && mp->cur_exp.type != mp_nep_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else {
+ if (pp == MP_VOID) {
+ /* Make |pp| an object in list~|p| that needs a pen */
+ pp = p;
+ while (pp != NULL) {
+ if (mp_has_pen(pp)) {
+ break;
+ } else {
+ pp = mp_link(pp);
+ }
+ }
+ }
+ if (pp != NULL) {
+ switch (mp_type(pp)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ if (mp_pen_ptr((mp_shape_node) pp) != NULL) {
+ mp_toss_knot_list(mp, mp_pen_ptr((mp_shape_node) pp));
+ }
+ mp_pen_ptr((mp_shape_node) pp) = cur_exp_knot;
+ mp_pen_type((mp_shape_node) pp) = mp->cur_exp.type == mp_nep_type;
+ break;
+ default:
+ break;
+ }
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ break;
+ case mp_with_pre_script_code:
+ if (mp->cur_exp.type != mp_string_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else if (cur_exp_str->len) {
+ if (ap == MP_VOID) {
+ ap = p;
+ }
+ while ((ap != NULL) && (! mp_has_script(ap))) {
+ ap = mp_link(ap);
+ }
+ if (ap != NULL) {
+ if (mp_pre_script(ap) != NULL) {
+ int selector = mp->selector;
+ mp_string s = mp_pre_script(ap); /* for string cleanup after combining */
+ mp->selector = mp_new_string_selector;
+ mp_str_room(mp, (int) (mp_pre_script(ap)->len + cur_exp_str->len + 2));
+ mp_print_mp_str(mp, cur_exp_str);
+ mp_str_room(mp, 1);
+ mp_append_char(mp, 13);
+ mp_print_mp_str(mp, mp_pre_script(ap));
+ mp_pre_script(ap) = mp_make_string(mp);
+ delete_str_ref(s);
+ mp->selector = selector;
+ } else {
+ mp_pre_script(ap) = cur_exp_str;
+ }
+ add_str_ref(mp_pre_script(ap));
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ break;
+ case mp_with_post_script_code:
+ if (mp->cur_exp.type != mp_string_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ } else if (cur_exp_str->len) {
+ if (bp == MP_VOID) {
+ bp = p;
+ }
+ while ((bp != NULL) && (! mp_has_script(bp))) {
+ bp = mp_link(bp);
+ }
+ if (bp != NULL) {
+ if (mp_post_script(bp) != NULL) {
+ int selector = mp->selector;
+ mp_string s = mp_post_script(bp); /* for string cleanup after combining */
+ mp->selector = mp_new_string_selector;
+ mp_str_room(mp, (int) (mp_post_script(bp)->len + cur_exp_str->len + 2));
+ mp_print_mp_str(mp, mp_post_script(bp));
+ mp_str_room(mp, 1);
+ mp_append_char(mp, 13);
+ mp_print_mp_str(mp, cur_exp_str);
+ mp_post_script(bp) = mp_make_string(mp);
+ delete_str_ref(s);
+ mp->selector = selector;
+ } else {
+ mp_post_script(bp) = cur_exp_str;
+ }
+ add_str_ref(mp_post_script(bp));
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ break;
+ case mp_with_stacking_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ if (sp == MP_VOID) {
+ sp = p;
+ }
+ if (pp && spstop == MP_VOID) {
+ spstop = pstop;
+ }
+ if (sp != NULL) {
+ mp_stacking(sp) = round_unscaled(cur_exp_value_number);
+ }
+ if (pp && spstop != NULL) {
+ mp_stacking(spstop) = round_unscaled(cur_exp_value_number);
+ }
+ /* free ? */
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ break;
+ case mp_pair_type:
+ {
+ if (pp && mp_nice_pair(mp, cur_exp_node, mp->cur_exp.type)) {
+ if (sp == MP_VOID) {
+ sp = p;
+ }
+ if (spstop == MP_VOID) {
+ spstop = pstop;
+ }
+ if (sp != NULL) {
+ mp_stacking(sp) = round_unscaled(mp_get_value_number(mp_x_part(mp_get_value_node(cur_exp_node))));
+ }
+ if (spstop != NULL) {
+ mp_stacking(spstop) = round_unscaled(mp_get_value_number(mp_y_part(mp_get_value_node(cur_exp_node))));
+ }
+ /* free ? */
+ mp->cur_exp.type = mp_vacuous_type;
+ } else {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_linecap_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ linecap = round_unscaled(cur_exp_value_number);
+ mp->cur_exp.type = mp_vacuous_type;
+ break;
+ }
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_linejoin_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ linejoin = round_unscaled(cur_exp_value_number);
+ mp->cur_exp.type = mp_vacuous_type;
+ break;
+ }
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_miterlimit_code:
+ switch (mp->cur_exp.type) {
+ case mp_known_type:
+ {
+ miterlimit = 1;
+ new_number_clone(ml, cur_exp_value_number);
+ mp->cur_exp.type = mp_vacuous_type;
+ break;
+ }
+ default:
+ {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ }
+ break;
+ case mp_with_dashed_code:
+ if (mp->cur_exp.type != mp_picture_type) {
+ complain_invalid_with_list(mp, t);
+ goto CONTINUE;
+ }
+ // fall through
+ default:
+ if (dp == MP_VOID) {
+ /* Make |dp| a stroked node in list~|p| */
+ dp = p;
+ while (dp != NULL) {
+ if (mp_type(dp) == mp_stroked_node_type) {
+ break;
+ } else {
+ dp = mp_link(dp);
+ }
+ }
+ }
+ if (dp != NULL) {
+ if (mp_dash_ptr(dp) != NULL) {
+ mp_delete_edge_ref(mp, mp_dash_ptr(dp));
+ }
+ mp_dash_ptr(dp) = (mp_node) mp_make_dashes(mp, (mp_edge_header_node) cur_exp_node);
+ set_number_to_unity(((mp_shape_node) dp)->dashscale);
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ break;
+ }
+ }
+ /*
+ Copy the information from objects |cp|, |pp|, and |dp| into the rest of
+ the list. These were > MP_VOID tests but can we rely on that one being
+ |1| which is hopefully not some used address.
+ */
+ if (cp > MP_VOID) {
+ /* Copy |cp|'s color into the colored objects linked to~|cp| */
+ mp_node q = mp_link(cp);
+ while (q != NULL) {
+ if (mp_has_color(q)) {
+ mp_shape_node q0 = (mp_shape_node) q;
+ mp_shape_node cp0 = (mp_shape_node) cp;
+ number_clone(q0->red, cp0->red);
+ number_clone(q0->green, cp0->green);
+ number_clone(q0->blue, cp0->blue);
+ number_clone(q0->black, cp0->black);
+ mp_color_model(q) = mp_color_model(cp);
+ }
+ q = mp_link(q);
+ }
+ }
+ if (pp > MP_VOID) {
+ /* Copy |mp_pen_ptr(pp)| into stroked and filled nodes linked to |pp| */
+ mp_node q = mp_link(pp);
+ while (q != NULL) {
+ if (mp_has_pen(q)) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ if (mp_pen_ptr((mp_shape_node) q) != NULL) {
+ mp_toss_knot_list(mp, mp_pen_ptr((mp_shape_node) q));
+ }
+ mp_pen_ptr((mp_shape_node) q) = mp_copy_pen(mp, mp_pen_ptr((mp_shape_node) pp));
+ break;
+ default:
+ break;
+ }
+ }
+ q = mp_link(q);
+ }
+ }
+ if (dp > MP_VOID) {
+ /* Make stroked nodes linked to |dp| refer to |mp_dash_ptr(dp)| */
+ mp_node q = mp_link(dp);
+ while (q != NULL) {
+ if (mp_type(q) == mp_stroked_node_type) {
+ if (mp_dash_ptr(q) != NULL) {
+ mp_delete_edge_ref(mp, mp_dash_ptr(q));
+ }
+ mp_dash_ptr(q) = mp_dash_ptr(dp);
+ set_number_to_unity(((mp_shape_node) q)->dashscale);
+ if (mp_dash_ptr(q) != NULL) {
+ mp_add_edge_ref(mp, mp_dash_ptr(q));
+ }
+ }
+ q = mp_link(q);
+ }
+ }
+ if (linecap >= 0 && linecap < mp_weird_linecap_code) {
+ mp_node q = p;
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ mp_set_linecap(q, linecap);
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ }
+ if (linejoin >= 0 && linejoin < mp_weird_linejoin_code) {
+ mp_node q = p;
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ mp_set_linejoin(q, linejoin);
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ }
+ if (miterlimit) {
+ mp_node q = p;
+ while (q != NULL) {
+ switch (mp_type(q)) {
+ case mp_fill_node_type:
+ case mp_stroked_node_type:
+ number_clone(mp_miterlimit(q), ml);
+ break;
+ default:
+ break;
+ }
+ q = mp_link(q);
+ }
+ free_number(ml);
+ }
+ if (! pp && sp > MP_VOID) {
+ mp_node q = mp_link(sp);
+ while (q != NULL) {
+ mp_stacking(q) = mp_stacking(sp);
+ q = mp_link(q);
+ }
+ }
+}
+
+@ One of the things we need to do when we've parsed an |addto| or similar
+command is find the header of a supposed |picture| variable, given a token list
+for that variable. Since the edge structure is about to be updated, we use
+|private_edges| to make sure that this is possible.
+
+@<Declare action procedures for use by |do_statement|@>=
+static mp_edge_header_node mp_find_edges_var (MP mp, mp_node t);
+
+@ @c
+mp_edge_header_node mp_find_edges_var (MP mp, mp_node t)
+{
+ mp_edge_header_node cur_edges = NULL;
+ mp_node p = mp_find_variable(mp, t);
+ if (p == NULL) {
+ char *msg = mp_obliterated(mp, t);
+ mp_back_error(
+ mp,
+ msg,
+ "It seems you did a nasty thing --- probably by accident, but nevertheless you\n"
+ "nearly hornswoggled me ... While I was evaluating the right-hand side of thisn"
+ "command, something happened, and the left-hand side is no longer a variable! So In"
+ "won't change anything."
+ );
+ mp_memory_free(msg);
+ mp_get_x_next(mp);
+ } else if (mp_type(p) != mp_picture_type) {
+ char msg[256];
+ mp_string sname;
+ int selector = mp->selector;
+ mp->selector = mp_new_string_selector;
+ mp_show_token_list(mp, t, NULL);
+ sname = mp_make_string(mp);
+ mp->selector = selector;
+ mp_snprintf(msg, 256, "Variable %s is the wrong type(%s)", mp_str(mp, sname), mp_type_string(mp_type(p)));
+ @.Variable x is the wrong type@>
+ delete_str_ref(sname);
+ mp_back_error(
+ mp,
+ msg,
+ "I was looking for a 'known' picture variable. So I'll not change anything just\n"
+ "now."
+ );
+ mp_get_x_next(mp);
+ } else {
+ mp_set_value_node(p, (mp_node) mp_private_edges(mp, (mp_edge_header_node) mp_get_value_node(p)));
+ cur_edges = (mp_edge_header_node) mp_get_value_node(p);
+ }
+ mp_flush_node_list(mp, t);
+ return cur_edges;
+}
+
+@ @<Put each...@>=
+mp_primitive(mp, "clip", mp_bounds_command, mp_start_clip_node_type);
+@:clip_}{|clip| primitive@>
+mp_primitive(mp, "setgroup", mp_bounds_command, mp_start_group_node_type);
+@:group_}{|group| primitive@>
+mp_primitive(mp, "setbounds", mp_bounds_command, mp_start_bounds_node_type);
+@:set_bounds_}{|setbounds| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_bounds_command:
+ switch (m) {
+ case mp_start_clip_node_type : return "clip";
+ case mp_start_group_node_type : return "setgroup";
+ case mp_start_bounds_node_type: return "setbounds";
+ }
+ break;
+
+@ The following function parses the beginning of an |addto| or |clip|
+command: it expects a variable name followed by a token with |cur_cmd = sep| and
+then an expression. The function returns the token list for the variable and
+stores the command modifier for the separator token in the global variable
+|last_add_type|. We must be careful because this variable might get overwritten
+any time we call |get_x_next|.
+
+@<Glob...@>=
+int last_add_type; /* command modifier that identifies the last |addto| command */
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static mp_node mp_start_draw_cmd (MP mp, int sep);
+
+@ @c
+mp_node mp_start_draw_cmd (MP mp, int sep)
+{
+ mp_node lhv = NULL; /* variable to add to left */
+ int add_type = 0; /* value to be returned in |last_add_type| */
+ mp_get_x_next(mp);
+ mp->var_flag = sep;
+ mp_scan_primary(mp);
+ if (mp->cur_exp.type != mp_token_list_type) {
+ /* Abandon edges command because there's no variable */
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Not a suitable variable",
+ "At this point I needed to see the name of a picture variable. (Or perhaps you\n"
+ "have indeed presented me with one; I might have missed it, if it wasn't followed\n"
+ "by the proper token.) So I'll not change anything just now.\n"
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ lhv = cur_exp_node;
+ add_type = (int) cur_mod;
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ }
+ mp->last_add_type = add_type;
+ return lhv;
+}
+
+@ Here is an example of how to use |start_draw_cmd|.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_do_bounds (MP mp);
+
+@ @c
+void mp_do_bounds (MP mp)
+{
+ mp_edge_header_node lhe;
+ /* initial value of |cur_mod| */
+ int c = cur_cmd;
+ int m = cur_mod;
+ /* variable on left, the corresponding edge structure */
+ mp_node lhv = mp_start_draw_cmd(mp, mp_to_command);
+ if (lhv != NULL) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ lhe = mp_find_edges_var(mp, lhv);
+ if (lhe == NULL) {
+ new_number(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ } else if (mp->cur_exp.type != mp_path_type) {
+ char msg[256];
+ mp_disp_err(mp, NULL);
+ new_number(new_expr.data.n);
+ mp_snprintf(msg, 256, "Improper '%s'", mp_cmd_mod_string(mp, c, m));
+ mp_back_error(
+ mp,
+ msg,
+ "This expression should have specified a known path. So I'll not change anything\n"
+ "just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ /* Complain about a non-cycle */
+ mp_back_error(
+ mp,
+ "Not a cycle",
+ "That contour should have ended with '..cycle' or '&cycle'. So I'll not change\n"
+ "anything just now."
+ );
+ mp_get_x_next(mp);
+ } else {
+ /* Make |cur_exp| into a |setbounds| or clipping path and add it to |lhe| */
+ mp_node p = mp_new_bounds_node(mp, cur_exp_knot, (int) m);
+ mp_node pp;
+ int mm = 0;
+ switch (m) {
+ case mp_start_clip_node_type : mm = mp_stop_clip_node_type; break;
+ case mp_start_group_node_type : mm = mp_stop_group_node_type; break;
+ case mp_start_bounds_node_type: mm = mp_stop_bounds_node_type; break;
+ }
+ pp = mp_new_bounds_node(mp, NULL, mm);
+ mp_scan_with_list(mp, p, pp);
+ mp_link(p) = mp_link(mp_edge_list(lhe));
+ mp_link(mp_edge_list(lhe)) = p;
+ if (mp_obj_tail(lhe) == mp_edge_list(lhe)) {
+ mp_obj_tail(lhe) = p;
+ }
+ mp_link(mp_obj_tail(lhe)) = pp;
+ mp_obj_tail(lhe) = pp;
+ mp_init_bbox(mp, lhe);
+ }
+ }
+}
+
+@ The |do_add_to| procedure is a little like |do_clip| but there are a lot more
+cases to deal with.
+
+@<Declare action procedures for use by |do_statement|@>=
+static void mp_do_add_to (MP mp);
+
+@ @c
+void mp_do_add_to (MP mp)
+{
+ mp_node lhv = mp_start_draw_cmd(mp, mp_thing_to_add_command);
+ if (lhv != NULL) {
+ mp_edge_header_node lhe; /* variable on left, the corresponding edge structure */
+ mp_node p; /* the graphical object or list for |scan_with_list| to update */
+ mp_edge_header_node e; /* an edge structure to be merged */
+ int add_type = mp->last_add_type; /* |also_code|, |contour_code|, or |double_path_code| */
+ if (add_type == mp_add_also_code) {
+ /*
+ Make sure the current expression is a suitable picture and set
+ |e| and |p| appropriately. Setting |p:=NULL| causes the
+ $\langle$with list$\rangle$ to be ignored; setting |e:=NULL|
+ prevents anything from being added to |lhe|.
+ */
+ p = NULL;
+ e = NULL;
+ if (mp->cur_exp.type != mp_picture_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper 'addto'",
+ "This expression should have specified a known picture. So I'll not change\n"
+ "anything just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ e = mp_private_edges(mp, (mp_edge_header_node) cur_exp_node);
+ mp->cur_exp.type = mp_vacuous_type;
+ p = mp_link(mp_edge_list(e));
+ }
+ } else {
+ /*
+ Create a graphical object |p| based on |add_type| and the current
+ expression. In this case |add_type<>also_code| so setting
+ |p:=NULL| suppresses future attempts to add to the edge
+ structure.
+ */
+ e = NULL;
+ p = NULL;
+ if (mp->cur_exp.type == mp_pair_type) {
+ mp_pair_to_path(mp);
+ }
+ if (mp->cur_exp.type != mp_path_type) {
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_disp_err(mp, NULL);
+ mp_back_error(
+ mp,
+ "Improper 'addto'",
+ "This expression should have specified a known path. So I'll not change anything\n"
+ "just now."
+ );
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else if (add_type != mp_add_contour_code) {
+ p = mp_new_shape_node(mp, cur_exp_knot, mp_stroked_node_type);
+ mp->cur_exp.type = mp_vacuous_type;
+ } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) {
+ /* Complain about a non-cycle */
+ mp_back_error(
+ mp,
+ "Not a cycle",
+ "That contour should have ended with '.. cycle' or '& cycle'. So I'll not change\n"
+ "anything just now."
+ );
+ mp_get_x_next(mp);
+ } else {
+ p = mp_new_shape_node(mp, cur_exp_knot, mp_fill_node_type);
+ mp->cur_exp.type = mp_vacuous_type;
+ }
+ }
+ mp_scan_with_list(mp, p, NULL);
+ /* Use |p|, |e|, and |add_type| to augment |lhv| as requested */
+ lhe = mp_find_edges_var(mp, lhv);
+ if (lhe == NULL) {
+ if ((e == NULL) && (p != NULL)) {
+ e = mp_toss_gr_object(mp, p);
+ }
+ if (e != NULL) {
+ mp_delete_edge_ref(mp, e);
+ }
+ } else if (add_type == mp_add_also_code) {
+ if (e != NULL) {
+ /* Merge |e| into |lhe| and delete |e| */
+ if (mp_link(mp_edge_list(e)) != NULL) {
+ mp_link(mp_obj_tail(lhe)) = mp_link(mp_edge_list(e));
+ mp_obj_tail(lhe) = mp_obj_tail(e);
+ mp_obj_tail(e) = mp_edge_list(e);
+ mp_link(mp_edge_list(e)) = NULL;
+ mp_flush_dash_list(mp, lhe);
+ }
+ mp_toss_edges(mp, e);
+ }
+ } else if (p != NULL) {
+ mp_link(mp_obj_tail(lhe)) = p;
+ mp_obj_tail(lhe) = p;
+ if (add_type == mp_add_double_path_code) {
+ if (mp_pen_ptr((mp_shape_node) p) == NULL) {
+ mp_pen_ptr((mp_shape_node) p) = mp_get_pen_circle(mp, &zero_t);
+ }
+ }
+ }
+ }
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+@<Declare the output procedures@>
+static void mp_do_ship_out (MP mp);
+
+@ @c
+void mp_do_ship_out (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_picture_type) {
+ mp_disp_err(mp, NULL);
+ set_number_to_zero(new_expr.data.n);
+ mp_back_error(mp, "Not a known picture", "I can only output known pictures.");
+ mp_get_x_next(mp);
+ mp_flush_cur_exp(mp, new_expr);
+ } else {
+ mp_ship_out(mp, cur_exp_node);
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+ }
+}
+
+@ The |everyjob| command simply assigns a nonzero value to the global variable
+|every_job_sym|.
+
+@ @<Glob...@>=
+mp_sym every_job_sym;
+
+@ @<Set init...@>=
+mp->every_job_sym = NULL;
+
+@ Finally, we have only the \quote {message} commands remaining.
+
+@d message_code 0
+@d err_message_code 1
+@d err_help_code 2
+
+@<Put each...@>=
+mp_primitive(mp, "message", mp_message_command, message_code);
+@:message_}{|message| primitive@>
+mp_primitive(mp, "errmessage", mp_message_command, err_message_code);
+@:err_message_}{|errmessage| primitive@>
+mp_primitive(mp, "errhelp", mp_message_command, err_help_code);
+@:err_help_}{|errhelp| primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case mp_message_command:
+ if (m < err_message_code) {
+ return "message";
+ } else if (m == err_message_code) {
+ return "errmessage";
+ } else {
+ return "errhelp";
+ }
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_message (MP mp);
+static void mp_no_string_err (MP mp, const char *s);
+
+@ @c
+void mp_do_message (MP mp)
+{
+ mp_value new_expr;
+ int m = cur_mod; /* the type of message */
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_no_string_err(mp, "A message should be a known string expression.");
+ } else {
+ switch (m) {
+ case message_code:
+ mp_print_nl(mp, "");
+ mp_print_mp_str(mp, cur_exp_str);
+ break;
+ case err_message_code:
+ @<Print string |cur_exp| as an error message@>
+ break;
+ case err_help_code:
+ @<Save string |cur_exp| as the |err_help|@>
+ break;
+ }
+ }
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static void mp_no_string_err (MP mp, const char *s)
+{
+ mp_disp_err(mp, NULL);
+ mp_back_error(mp, "Not a string", s);
+ @.Not a string@>
+ mp_get_x_next(mp);
+}
+
+@ The global variable |err_help| is zero when the user has most recently given an
+empty help string, or if none has ever been given.
+
+@<Save string |cur_exp| as the |err_help|@>=
+{
+ if (mp->err_help != NULL) {
+ delete_str_ref(mp->err_help);
+ } if (cur_exp_str->len == 0) {
+ mp->err_help = NULL;
+ } else {
+ mp->err_help = cur_exp_str;
+ add_str_ref(mp->err_help);
+ }
+}
+
+@ If |errmessage| occurs often in |mp_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.
+
+@<Glob...@>=
+int long_help_seen; /* has the long |\\errmessage| help been used? */
+
+@ @<Set init...@>=
+mp->long_help_seen = 0;
+
+@ @<Print string |cur_exp| as an error message@>=
+{
+ char msg[256];
+ mp_snprintf(msg, 256, "%s", mp_str(mp, cur_exp_str));
+ if (mp->err_help != NULL) {
+ mp->use_err_help = 1;
+ mp_back_error(mp, msg, NULL);
+ } else if (mp->long_help_seen) {
+ mp_back_error(mp, msg, "(That was another 'errmessage'.)");
+ } else {
+ @^Marple, Jane@>
+ if (mp->interaction < mp_error_stop_mode) {
+ mp->long_help_seen = 1;
+ }
+ mp_back_error(
+ mp,
+ msg,
+ "This error message was generated by an 'errmessage' command, so I can't give any\n"
+ "explicit help. Pretend that you're Miss Marple: Examine all clues, and deduce the\n"
+ "truth by inspired guesses."
+ );
+ }
+ mp_get_x_next(mp);
+ mp->use_err_help = 0;
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+static void mp_do_write (MP mp);
+static void mp_do_write_string (MP mp, mp_string t);
+
+@ @c
+void mp_do_write (MP mp)
+{
+ mp_value new_expr;
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_no_string_err(mp, "The text to be written should be a known string expression");
+ } else if (cur_cmd != mp_to_command) {
+ mp_back_error(mp, "Missing 'to' clause", "A write command should end with 'to <filename>'");
+ mp_get_x_next(mp);
+ } else {
+ mp_string t = cur_exp_str; /* the line of text to be written */
+ mp->cur_exp.type = mp_vacuous_type;
+ mp_get_x_next(mp);
+ mp_scan_expression(mp);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_no_string_err(mp, "I can\'t write to that file name. It isn't a known string");
+ } else {
+ mp_do_write_string(mp, t);
+ }
+ }
+ set_number_to_zero(new_expr.data.n);
+ mp_flush_cur_exp(mp, new_expr);
+}
+
+static void mp_do_write_string (MP mp, mp_string t)
+{
+ char *fn = mp_str(mp, cur_exp_str);
+ int n = mp->write_files;
+ int n0 = mp->write_files;
+ while (mp_strcmp(fn, mp->wr_fname[n]) != 0) {
+ if (n == 0) {
+ /* bottom reached */
+ if (n0 == mp->write_files) {
+ if (mp->write_files < mp->max_write_files) {
+ ++mp->write_files;
+ } else {
+ int l = mp->max_write_files + (mp->max_write_files / 4);
+ void **wr_file = mp_memory_allocate((size_t) (l + 1) * sizeof(void *));
+ char **wr_fname = mp_memory_allocate((size_t) (l + 1) * sizeof(char *));
+ for (int k = 0; k <= l; k++) {
+ if (k <= mp->max_write_files) {
+ wr_file[k] = mp->wr_file[k];
+ wr_fname[k] = mp->wr_fname[k];
+ } else {
+ wr_file[k] = 0;
+ wr_fname[k] = NULL;
+ }
+ }
+ mp_memory_free(mp->wr_file);
+ mp_memory_free(mp->wr_fname);
+ mp->max_write_files = l;
+ mp->wr_file = wr_file;
+ mp->wr_fname = wr_fname;
+ }
+ }
+ n = n0;
+ mp_open_write_file(mp, fn, n);
+ } else {
+ --n;
+ if (mp->wr_fname[n] == NULL) {
+ n0 = n;
+ }
+ }
+ }
+ if (mp_str_vs_str(mp, t, mp->eof_line) == 0) {
+ (mp->close_file)(mp, mp->wr_file[n]);
+ mp_memory_free(mp->wr_fname[n]);
+ mp->wr_fname[n] = NULL;
+ if (n == mp->write_files - 1) {
+ mp->write_files = n;
+ }
+ } else {
+ int selector = mp->selector;
+ mp->selector = n + mp_first_file_selector;
+ mp_print_mp_str(mp, t);
+ mp_print_ln(mp);
+ mp->selector = selector;
+ }
+}
+
+@ @<Initialize table entries@>=
+mp->inf_val = mp_new_value_node(mp);
+mp_set_value_number(mp->inf_val, fraction_four_t);
+
+@ @<Free table entries@>=
+mp_free_value_node(mp, mp->inf_val);
+
+@ The smallest |d| such that a given list can be covered with |m| intervals is
+determined by the |threshold| routine, which is sort of an inverse to
+|min_cover|. The idea is to increase the interval size rapidly until finding the
+range, then to go sequentially until the exact borderline has been discovered.
+
+@ Heights, depths, and italic corrections are different from widths not only
+because their list length is more severely restricted, but also because zero
+values do not need to be put into the list
+
+@ @<Initialize table entries@>=
+mp->zero_val = mp_new_value_node(mp);
+mp_set_value_number(mp->zero_val, zero_t);
+
+@ @<Free table entries@>=
+mp_free_value_node(mp, mp->zero_val);
+
+@ To print |scaled| value to PDF output we need some subroutines to ensure
+accurary.
+
+@d max_integer 0x7FFFFFFF /* $2^{31}-1$ */
+
+@<Glob...@>=
+int ten_pow[10]; /* $10^0..10^9$ */
+int scaled_out; /* amount of |scaled| that was taken out in |divide_scaled| */
+
+@ @<Set init...@>=
+mp->ten_pow[0] = 1;
+for (int i = 1; i <= 9; i++) {
+ mp->ten_pow[i] = 10 * mp->ten_pow[i - 1];
+}
+
+@* Shipping pictures out.
+
+The |ship_out| procedure, to be described below, is given a pointer to an edge
+structure. Originally teh output was targeted at \POSTSCRIPT\ but the library
+has no backend. It privides the result as a structure that reflects the original
+\POSTSCRIPT\ backend. We could use more direct methods but for now we follow the
+route with an intermediate. Actually, it's that intermediate that is kind of
+the standard output \API. We no longer report the shipped outfigure because the
+backend can do that, but we keep the number.
+
+@<Declare the output procedures@>=
+static void mp_ship_out (MP mp, mp_node h);
+
+@ Some of these types are already used earlier.
+
+@<Exported types@>=
+typedef struct mp_color {
+ double a_val; /* r or c */
+ double b_val; /* g or m */
+ double c_val; /* b or y */
+ double d_val; /* k */
+} mp_color;
+
+typedef struct mp_dash_object {
+ double offset;
+ double *array;
+} mp_dash_object;
+
+/*
+ This mp_graphic_object gets cast onto the fill and stroke. For some reason
+ we don't distinguish between start and stop here.
+*/
+
+typedef struct mp_graphic_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+} mp_graphic_object;
+
+typedef struct mp_shape_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+ char *pre_script;
+ char *post_script;
+ size_t pre_length;
+ size_t post_length;
+ mp_color color;
+ mp_gr_knot path;
+ mp_gr_knot htap;
+ mp_gr_knot pen;
+ double miterlimit;
+ mp_dash_object *dash;
+ unsigned char color_model;
+ unsigned char linejoin;
+ unsigned char linecap;
+ unsigned char padding; /* pen_type */
+} mp_shape_object;
+
+typedef struct mp_start_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+ char *pre_script;
+ char *post_script;
+ size_t pre_length;
+ size_t post_length;
+ mp_gr_knot path;
+} mp_start_object;
+
+typedef struct mp_stop_object {
+ int type;
+ int stacking;
+ struct mp_graphic_object *next;
+ char *pre_script;
+ char *post_script;
+ size_t pre_length;
+ size_t post_length;
+ mp_gr_knot path;
+} mp_stop_object;
+
+typedef struct mp_edge_object {
+ struct mp_graphic_object *body;
+ struct mp_edge_object *next;
+ MP parent;
+ double minx;
+ double miny;
+ double maxx;
+ double maxy;
+ double width;
+ double height;
+ double depth;
+ double italic;
+ int charcode;
+ int padding;
+} mp_edge_object;
+
+@d gr_next_knot(A) (A)->next
+@d gr_originator(A) (A)->originator
+@d mp_knotstate(A) (A)->state
+@d gr_type(A) (A)->type
+@d gr_link(A) (A)->next
+@d gr_color_model(A) (A)->color_model
+@d gr_red_val(A) (A)->color.a_val
+@d gr_green_val(A) (A)->color.b_val
+@d gr_blue_val(A) (A)->color.c_val
+@d gr_cyan_val(A) (A)->color.a_val
+@d gr_magenta_val(A) (A)->color.b_val
+@d gr_yellow_val(A) (A)->color.c_val
+@d gr_black_val(A) (A)->color.d_val
+@d gr_grey_val(A) (A)->color.d_val
+@d gr_path_ptr(A) (A)->path
+@d gr_htap_ptr(A) (A)->htap
+@d gr_pen_ptr(A) (A)->pen
+@d gr_linejoin_val(A) (A)->linejoin
+@d gr_linecap_val(A) (A)->linecap
+@d gr_stacking_val(A) (A)->stacking
+@d gr_miterlimit_val(A) (A)->miterlimit
+@d gr_pre_script(A) (A)->pre_script
+@d gr_post_script(A) (A)->post_script
+@d gr_pre_length(A) (A)->pre_length
+@d gr_post_length(A) (A)->post_length
+@d gr_dash_ptr(A) (A)->dash
+
+@d mp_gr_export_color(q,p)
+if (mp_color_model(p) == mp_uninitialized_model) {
+ gr_color_model(q) = number_to_scaled(internal_value(mp_default_color_model_internal))/65536;
+ gr_cyan_val(q) = 0;
+ gr_magenta_val(q) = 0;
+ gr_yellow_val(q) = 0;
+ gr_black_val(q) = gr_color_model(q) == mp_cmyk_model ? (number_to_scaled(unity_t)/65536.0) : 0;
+} else {
+ gr_color_model(q) = mp_color_model(p);
+ gr_cyan_val(q) = number_to_double(p->cyan);
+ gr_magenta_val(q) = number_to_double(p->magenta);
+ gr_yellow_val(q) = number_to_double(p->yellow);
+ gr_black_val(q) = number_to_double(p->black);
+}
+
+@d mp_gr_export_scripts(q,p)
+if (mp_pre_script (p)) {
+ gr_pre_script(q) = mp_strndup((const char *) mp_pre_script(p)->str, mp_pre_script(p)->len);
+ gr_pre_length(q) = mp_pre_script(p)->len;
+}
+if (mp_post_script(p)) {
+ gr_post_script(q) = mp_strndup((const char *) mp_post_script(p)->str, mp_post_script(p)->len);
+ gr_post_length(q) = mp_post_script(p)->len;
+}
+
+@ @c
+struct mp_edge_object *mp_gr_export (MP mp, mp_edge_header_node h)
+{
+ mp_node p; /* the current graphical object */
+ mp_edge_object *hh = mp_memory_allocate(sizeof(mp_edge_object)); /* the first graphical object */
+ mp_graphic_object *hp = NULL; /* the current graphical object */
+ mp_set_bbox(mp, h, 1);
+ hh->parent = mp;
+ hh->body = NULL;
+ hh->next = NULL;
+ hh->minx = number_to_double(h->minx);
+ hh->minx = fabs(hh->minx) < 0.00001 ? 0 : hh->minx;
+ hh->miny = number_to_double(h->miny);
+ hh->miny = fabs(hh->miny) < 0.00001 ? 0 : hh->miny;
+ hh->maxx = number_to_double(h->maxx);
+ hh->maxx = fabs(hh->maxx) < 0.00001 ? 0 : hh->maxx;
+ hh->maxy = number_to_double(h->maxy);
+ hh->maxy = fabs(hh->maxy) < 0.00001 ? 0 : hh->maxy;
+ hh->charcode = round_unscaled(internal_value(mp_char_code_internal));
+ hh->width = number_to_double(internal_value(mp_char_wd_internal));
+ hh->height = number_to_double(internal_value(mp_char_ht_internal));
+ hh->depth = number_to_double(internal_value(mp_char_dp_internal));
+ hh->italic = number_to_double(internal_value(mp_char_ic_internal));
+ p = mp_link(mp_edge_list(h));
+ while (p != NULL) {
+ mp_graphic_object *hq = mp_new_graphic_object(mp, (int) ((mp_type(p) - mp_fill_node_type) + 1));
+ switch (mp_type(p)) {
+ /* todo: share code between fill and stroked */
+ case mp_fill_node_type:
+ {
+ mp_number d_width; /* the current pen width */
+ mp_shape_node p0 = (mp_shape_node) p;
+ mp_shape_object *tf = (mp_shape_object *) hq;
+ gr_pen_ptr(tf) = mp_export_knot_list(mp, mp_pen_ptr(p0));
+ new_number(d_width);
+ mp_get_pen_scale(mp, &d_width, mp_pen_ptr(p0)); /* whats the point ? */
+ free_number(d_width);
+ if ((mp_pen_ptr(p0) == NULL) || mp_pen_is_elliptical(mp_pen_ptr(p0))) {
+ gr_path_ptr(tf) = mp_export_knot_list(mp, mp_path_ptr(p0));
+ } else {
+ mp_knot pc = mp_copy_path(mp, mp_path_ptr(p0));
+ mp_knot pp = mp_make_envelope(mp, pc, mp_pen_ptr(p0), p0->linejoin, 0, &(p0->miterlimit));
+ gr_path_ptr(tf) = mp_export_knot_list(mp, pp);
+ mp_toss_knot_list(mp, pp);
+ pc = mp_htap_ypoc(mp, mp_path_ptr(p0));
+ pp = mp_make_envelope(mp, pc, mp_pen_ptr((mp_shape_node) p), p0->linejoin, 0, &(p0->miterlimit));
+ gr_htap_ptr(tf) = mp_export_knot_list(mp, pp);
+ mp_toss_knot_list(mp, pp);
+ }
+ mp_gr_export_color(tf, p0);
+ mp_gr_export_scripts(tf, p);
+ gr_linejoin_val(tf) = p0->linejoin;
+ gr_stacking_val(tf) = p0->stacking;
+ gr_miterlimit_val(tf) = number_to_double(p0->miterlimit);
+ }
+ break;
+ case mp_stroked_node_type:
+ {
+ mp_number d_width; /* the current pen width */
+ mp_shape_node p0 = (mp_shape_node) p;
+ mp_shape_object *ts = (mp_shape_object *) hq;
+ gr_pen_ptr(ts) = mp_export_knot_list(mp, mp_pen_ptr(p0));
+ new_number(d_width);
+ mp_get_pen_scale(mp, &d_width, mp_pen_ptr(p0));
+ if (mp_pen_is_elliptical(mp_pen_ptr(p0))) {
+ gr_path_ptr(ts) = mp_export_knot_list(mp, mp_path_ptr(p0));
+ } else {
+ mp_knot pc = mp_copy_path(mp, mp_path_ptr(p0));
+ int t = p0->linecap;
+ if (mp_left_type(pc) != mp_endpoint_knot) {
+ mp_left_type(mp_insert_knot(mp, pc, &(pc->x_coord), &(pc->y_coord))) = mp_endpoint_knot;
+ mp_right_type(pc) = mp_endpoint_knot;
+ pc = mp_next_knot(pc);
+ t = 1;
+ }
+ pc = mp_make_envelope(mp, pc, mp_pen_ptr(p0), p0->linejoin, (int) t, &(p0->miterlimit));
+ gr_path_ptr(ts) = mp_export_knot_list(mp, pc);
+ mp_toss_knot_list(mp, pc);
+ }
+ mp_gr_export_color(ts, p0);
+ mp_gr_export_scripts(ts, p);
+ gr_linejoin_val(ts) = p0->linejoin;
+ gr_miterlimit_val(ts) = number_to_double(p0->miterlimit);
+ gr_linecap_val(ts) = p0->linecap;
+ gr_stacking_val(ts) = p0->stacking;
+ gr_dash_ptr(ts) = mp_export_dashes(mp, p0, &d_width);
+ free_number(d_width);
+ }
+ break;
+ case mp_start_clip_node_type:
+ case mp_start_group_node_type:
+ case mp_start_bounds_node_type:
+ {
+ mp_start_node p0 = (mp_start_node) p;
+ mp_start_object *tb = (mp_start_object *) hq;
+ gr_path_ptr(tb) = mp_export_knot_list(mp, mp_path_ptr((mp_start_node) p));
+ gr_stacking_val(tb) = p0->stacking;
+ mp_gr_export_scripts(tb, p);
+ }
+ break;
+ case mp_stop_clip_node_type:
+ case mp_stop_group_node_type:
+ case mp_stop_bounds_node_type:
+ {
+ mp_stop_node p0 = (mp_stop_node) p;
+ mp_stop_object *tb = (mp_stop_object *) hq;
+ gr_stacking_val(tb) = p0->stacking;
+ }
+ break;
+ default:
+ break;
+ }
+ if (hh->body == NULL) {
+ hh->body = hq;
+ } else {
+ gr_link(hp) = hq;
+ }
+ hp = hq;
+ p = mp_link(p);
+ }
+ return hh;
+}
+
+@ The code here comes from the psout.w file and is part of the stipped down
+library for \LUAMETATEX. There is no backend code in this subset. For that you
+need the official \METAPOST\ distribution. One way of making a stand alone image
+is to wrap the code in a small \CONTEXT\ file and process it to \PDF, which then
+can be converted to another image format. You can blame me for errors.
+
+@<MPlib export header stuff@>=
+struct mp_edge_object *mp_gr_export (MP mp, mp_edge_header_node h);
+mp_graphic_object *mp_new_graphic_object (MP mp, int type);
+void mp_gr_toss_objects (mp_edge_object *hh);
+void mp_gr_toss_object (mp_graphic_object *p);
+
+@ @c
+static void mp_do_gr_toss_dashes (mp_dash_object *dl) {
+ if (dl) {
+ mp_memory_free(dl->array);
+ mp_memory_free(dl);
+ }
+}
+
+@ @c
+static void mp_do_gr_toss_knot_list (mp_gr_knot p)
+{
+ if (p) {
+ mp_gr_knot q = p;
+ do {
+ mp_gr_knot r = gr_next_knot(q);
+ mp_memory_free(q);
+ q = r;
+ } while (q != p);
+ }
+}
+
+@ @c
+mp_graphic_object *mp_new_graphic_object (MP mp, int type)
+{
+ mp_graphic_object *p;
+ size_t size;
+ (void) mp;
+ switch (type) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ size = sizeof(mp_shape_object);
+ break;
+ case mp_start_clip_code:
+ case mp_start_group_code:
+ case mp_start_bounds_code:
+ size = sizeof(mp_start_object);
+ break;
+ default:
+ size = sizeof(mp_graphic_object);
+ break;
+ }
+ p = (mp_graphic_object *) mp_memory_allocate(size);
+ memset(p, 0, size);
+ gr_type(p) = type;
+ return p;
+}
+
+@ @c
+void mp_gr_toss_object (mp_graphic_object *p)
+{
+ switch (gr_type(p)) {
+ case mp_fill_code:
+ case mp_stroked_code:
+ {
+ mp_shape_object *o = (mp_shape_object *) p;
+ mp_memory_free(gr_pre_script(o));
+ mp_memory_free(gr_post_script(o));
+ mp_do_gr_toss_knot_list(gr_pen_ptr(o));
+ mp_do_gr_toss_knot_list(gr_path_ptr(o));
+ if (gr_htap_ptr(o)) {
+ mp_do_gr_toss_knot_list(gr_htap_ptr(o));
+ }
+ if (gr_dash_ptr(o)) {
+ mp_do_gr_toss_dashes(gr_dash_ptr(o));
+ }
+ }
+ break;
+ case mp_start_clip_code:
+ case mp_start_group_code:
+ case mp_start_bounds_code:
+ {
+ mp_start_object *o = (mp_start_object *) p;
+ mp_memory_free(gr_pre_script(o));
+ mp_memory_free(gr_post_script(o));
+ mp_do_gr_toss_knot_list(gr_path_ptr(o));
+ }
+ break;
+ case mp_stop_clip_code:
+ case mp_stop_group_code:
+ case mp_stop_bounds_code:
+ break;
+ }
+ mp_memory_free(p);
+}
+
+@ @c
+void mp_gr_toss_objects (mp_edge_object *hh)
+{
+ mp_graphic_object *p = hh->body;
+ while (p) {
+ mp_graphic_object *q = gr_link(p);
+ mp_gr_toss_object(p);
+ p = q;
+ }
+ mp_memory_free(hh);
+}
+
+@ This function is now nearly trivial.
+
+@c
+void mp_ship_out (MP mp, mp_node h) {
+ (mp->shipout_backend)(mp, h);
+}
+
+@ @<Declarations@>=
+static void mp_shipout_backend (MP mp, void *h);
+
+@ We keep the template as comment:
+
+@c
+static void mp_shipout_backend (MP mp, void *voidh)
+{
+ (void) mp;
+ (void) voidh;
+}
+
+@ @<Exported types@>=
+typedef void (*mp_backend_writer) (MP, void *);
+
+@ @<Option variables@>=
+mp_backend_writer shipout_backend;
+
+@* Some extensions.
+
+Get a numeric value from \MP\ is not easy. We have to consider the macro and the
+loops, as also the internal type (this is a first attempt, and more work is
+needed). If we are inside a |for| loop, then the global |loop_ptr| is not null
+and the other loops eventually nested are available by mean of |loop_ptr->link|.
+The current numeric value is stored in |old_value|.
+
+@ @<Exported function headers@>=
+void mp_scan_next_value (MP mp, int keep, int *token, int *mode, int *kind);
+void mp_scan_expr_value (MP mp, int keep, int *kind);
+void mp_scan_token_value (MP mp, int keep, int *token, int *mode, int *kind);
+void mp_scan_symbol_value (MP mp, int keep, char **s, int expand);
+void mp_scan_property_value (MP mp, int keep, int *kind, char **s, int *property, int *detail);
+
+int mp_skip_token_value (MP mp, int token);
+
+void mp_scan_numeric_value (MP mp, int primary, double *d);
+void mp_scan_boolean_value (MP mp, int primary, int *b);
+void mp_scan_string_value (MP mp, int primary, char **s, size_t *l);
+void mp_scan_pair_value (MP mp, int primary, double *x, double *y);
+void mp_scan_color_value (MP mp, int primary, double *r, double *g, double *b);
+void mp_scan_cmykcolor_value (MP mp, int primary, double *c, double *m, double *y, double *k);
+void mp_scan_transform_value (MP mp, int primary, double *x, double *y, double *xx, double *xy, double *yx, double *yy);
+void mp_scan_path_value (MP mp, int primary, mp_knot *k);
+
+void mp_push_numeric_value (MP mp, double n);
+void mp_push_integer_value (MP mp, int i);
+void mp_push_boolean_value (MP mp, int b);
+void mp_push_string_value (MP mp, const char *s, int l);
+void mp_push_pair_value (MP mp, double x, double y);
+void mp_push_color_value (MP mp, double r, double g, double b);
+void mp_push_cmykcolor_value (MP mp, double c, double m, double y, double k);
+void mp_push_transform_value (MP mp, double x, double y, double xx, double xy, double yx, double yy);
+void mp_push_path_value (MP mp, mp_knot k);
+
+@ This is a lightweight version, one that also omits the quotes around strings.
+When we scan we check the type anyway. We don't really have a list either. So we
+only serialize symbolic names, strings and single tokens.
+
+@c
+// void mp_scan_symbol_value (MP mp, int keep, char **s, int expand)
+// {
+// if (mp->extensions) {
+// mp_node p;
+// unsigned char *r = NULL;
+// if (expand) {
+// mp_get_x_next(mp);
+// } else {
+// mp_get_next(mp);
+// }
+// if (keep) {
+// mp_back_input(mp);
+// }
+// *s = NULL;
+// p = mp_cur_tok(mp);
+// if (p) {
+// /* simplified mp_show_token_list */
+// if (mp_type(p) == mp_symbol_node_type) {
+// // if (mp_name_type(p) != mp_expr_operation && mp_name_type(p) != mp_suffix_operation && mp_name_type(p) != mp_text_operation) {
+// mp_sym sr = mp_get_sym_sym(p);
+// // if (sr != mp_collective_subscript) {
+// mp_string rr = text(sr);
+// if (rr && rr->str) {
+// r = rr->str;
+// }
+// // }
+// // }
+// } else if (mp_name_type(p) == mp_token_operation) {
+// if (mp_type(p) == mp_string_type) {
+// r = mp_get_value_str(p)->str;
+// }
+// }
+// }
+// if (r) {
+// *s = (char *) mp_strdup((char *) r);
+// } else {
+// *s = NULL;
+// }
+// }
+// }
+
+void mp_scan_symbol_value (MP mp, int keep, char **s, int expand)
+{
+ if (mp->extensions) {
+ if (expand) {
+ mp_get_x_next(mp);
+ } else {
+ mp_get_next(mp);
+ }
+ if (keep) {
+ mp_back_input(mp);
+ }
+ if (cur_sym == NULL && (cur_sym_mod == 0 || cur_sym_mod == mp_normal_operation)) {
+ *s = NULL;
+ } else {
+ unsigned char *r = NULL;
+ mp_node p = mp_new_symbolic_node(mp);
+ mp_set_sym_sym(p, cur_sym);
+ mp_name_type(p) = cur_sym_mod;
+ if (mp_type(p) == mp_symbol_node_type) {
+ mp_sym sr = mp_get_sym_sym(p);
+ mp_string rr = text(sr);
+ if (rr && rr->str) {
+ r = rr->str;
+ }
+ } else if (mp_name_type(p) == mp_token_operation) {
+ if (mp_type(p) == mp_string_type) {
+ r = mp_get_value_str(p)->str;
+ }
+ }
+ mp_free_symbolic_node(mp, p);
+ if (r) {
+ *s = (char *) mp_strdup((char *) r);
+ } else {
+ *s = NULL;
+ }
+ }
+ }
+}
+
+void mp_scan_property_value (MP mp, int keep, int *kind, char **str, int *property, int *detail)
+{
+ if (mp->extensions) {
+ mp_symbol_entry *entry;
+ mp_get_symbol(mp);
+ entry = cur_sym;
+ if (entry) {
+ mp_node node = entry->type == mp_tag_command ? entry->v.data.node : NULL;
+ *kind = entry->type;
+ *str = (char *) mp_strdup((char *) entry->text->str);
+ *property = entry->property;
+ if (node) {
+ *detail = node->type;
+ }
+ if (keep) {
+ mp_back_input(mp);
+ }
+ }
+ }
+}
+
+void mp_scan_next_value (MP mp, int keep, int *token, int *mode, int *kind)
+{
+ if (mp->extensions) {
+ mp_get_next(mp);
+ if (keep) {
+ mp_back_input(mp);
+ }
+ *token = cur_cmd;
+ *mode = cur_mod;
+ *kind = mp->cur_exp.type;
+ }
+}
+
+void mp_scan_expr_value (MP mp, int keep, int *kind)
+{
+ if (mp->extensions) {
+ mp_get_next(mp);
+ mp_scan_primary(mp);
+ *kind = mp->cur_exp.type;
+ if (keep) {
+ mp_back_input(mp);
+ mp_back_expr(mp);
+ }
+ }
+}
+
+void mp_scan_token_value (MP mp, int keep, int *token, int *mode, int *kind)
+{
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ if (keep) {
+ mp_back_input(mp);
+ }
+ *token = cur_cmd;
+ *mode = cur_mod;
+ *kind = mp->cur_exp.type;
+ }
+}
+
+int mp_skip_token_value (MP mp, int token)
+{
+ if (mp->extensions) {
+ mp_get_x_next(mp);
+ if (token == cur_cmd) {
+ return 1;
+ } else {
+ mp_back_input(mp);
+ }
+ }
+ return 0;
+}
+
+static void mp_scan_something (MP mp, int primary)
+{
+ mp_get_x_next(mp);
+ switch (primary) {
+ case 0: mp_scan_expression(mp); break;
+ case 1: mp_scan_primary(mp); break;
+ case 2: mp_scan_secondary(mp); break;
+ case 3: mp_scan_tertiary(mp); break;
+ default: mp_scan_expression(mp); break;
+ }
+}
+
+void mp_scan_numeric_value (MP mp, int primary, double *d)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_known_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_back_input(mp); /* hm */
+ *d = number_to_double(cur_exp_value_number);
+ }
+ }
+}
+
+# define mp_set_double_value(mp,target,what) \
+if (mp_type(what) == mp_known_type) { \
+ *target = number_to_double(mp_get_value_number(what)); \
+}
+
+void mp_scan_pair_value (MP mp, int primary, double *x, double *y)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_pair_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_node p ;
+ mp_back_input(mp); /* hm */
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, x, mp_x_part(p));
+ mp_set_double_value(mp, y, mp_y_part(p));
+ }
+ }
+}
+
+void mp_scan_color_value (MP mp, int primary, double *r, double *g, double *b)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_color_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_node p ;
+ mp_back_input(mp); /* hm */
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, r, mp_red_part(p));
+ mp_set_double_value(mp, g, mp_green_part(p));
+ mp_set_double_value(mp, b, mp_blue_part(p));
+ }
+ }
+}
+
+void mp_scan_cmykcolor_value (MP mp, int primary, double *c, double *m, double *y, double *k)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_cmykcolor_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_node p ;
+ mp_back_input(mp); /* hm */
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, c, mp_cyan_part(p));
+ mp_set_double_value(mp, m, mp_magenta_part(p));
+ mp_set_double_value(mp, y, mp_yellow_part(p));
+ mp_set_double_value(mp, k, mp_black_part(p));
+ }
+ }
+}
+
+void mp_scan_transform_value (MP mp, int primary, double *x, double *y, double *xx, double *xy, double *yx, double *yy)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_transform_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_node p ;
+ mp_back_input(mp); /* hm */
+ p = mp_get_value_node(cur_exp_node);
+ mp_set_double_value(mp, x, mp_x_part(p));
+ mp_set_double_value(mp, y, mp_y_part(p));
+ mp_set_double_value(mp, xx, mp_xx_part(p));
+ mp_set_double_value(mp, xy, mp_xy_part(p));
+ mp_set_double_value(mp, yx, mp_yx_part(p));
+ mp_set_double_value(mp, yy, mp_yy_part(p));
+ }
+ }
+}
+
+void mp_scan_path_value (MP mp, int primary, mp_knot *k)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_path_type && mp->cur_exp.type != mp_pen_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_back_input(mp); /* hm */
+ *k = cur_exp_knot;
+ }
+ }
+}
+
+void mp_scan_boolean_value (MP mp, int primary, int *b)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_boolean_type) {
+ mp_back_input(mp); /* hm */
+ } else {
+ mp_back_input(mp); /* hm */
+ *b = cur_exp_value_boolean == mp_true_operation ? 1 : 0 ;
+ }
+ }
+}
+
+void mp_scan_string_value (MP mp, int primary, char **s, size_t *l)
+{
+ if (mp->extensions) {
+ mp_scan_something(mp, primary);
+ if (mp->cur_exp.type != mp_string_type) {
+ mp_back_input(mp); /* hm */
+ *s = NULL ;
+ *l = 0;
+ } else {
+ mp_back_input(mp); /* hm */
+ *s = (char *) cur_exp_str->str ;
+ *l = cur_exp_str->len;
+ }
+ }
+}
+
+void mp_push_numeric_value (MP mp, double n)
+{
+ mp_number m;
+ new_number_from_double(mp, m, n);
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &m);
+ mp_back_expr(mp);
+}
+
+void mp_push_integer_value (MP mp, int i)
+{
+ mp_number m;
+ new_number(m);
+ set_number_from_int(m, i);
+ mp->cur_exp.type = mp_known_type;
+ mp_set_cur_exp_value_number(mp, &m);
+ mp_back_expr(mp);
+}
+
+void mp_push_boolean_value (MP mp, int b)
+{
+ mp->cur_exp.type = mp_boolean_type;
+ mp_set_cur_exp_value_boolean(mp, b ? mp_true_operation : mp_false_operation);
+ mp_back_expr(mp);
+}
+
+void mp_push_string_value (MP mp, const char *s, int l)
+{
+ mp->cur_exp.type = mp_string_type;
+ mp_set_cur_exp_str(mp, mp_rtsl(mp, (char *) s, l));
+ mp_back_expr(mp);
+}
+
+void mp_push_pair_value (MP mp, double x, double y)
+{
+ /*
+ mp_value new_expr;
+ */
+ mp_number px, py;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_pair_node(mp, p);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, px, x);
+ new_number_from_double(mp, py, y);
+ mp_type(mp_x_part(v)) = mp_known_type;
+ mp_type(mp_y_part(v)) = mp_known_type;
+ mp_set_value_number(mp_x_part(v), px);
+ mp_set_value_number(mp_y_part(v), py);
+ free_number(px);
+ free_number(py);
+ /*
+ memset(&new_expr, 0, sizeof(mp_value));
+ new_number(new_expr.data.n);
+ new_expr.type = mp_type(p);
+ new_expr.data.node = p;
+ mp_flush_cur_exp(mp, new_expr);
+ mp->cur_exp.type = mp_pair_type;
+ mp_name_type(p) = mp_capsule_operation;
+ */
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_pair_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_color_value (MP mp, double r, double g, double b)
+{
+ mp_number pr, pg, pb;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_color_node(mp, p, mp_color_type);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, pr, r);
+ new_number_from_double(mp, pg, g);
+ new_number_from_double(mp, pb, b);
+ mp_type(mp_red_part (v)) = mp_known_type;
+ mp_type(mp_green_part(v)) = mp_known_type;
+ mp_type(mp_blue_part (v)) = mp_known_type;
+ mp_set_value_number(mp_red_part (v), pr);
+ mp_set_value_number(mp_green_part(v), pg);
+ mp_set_value_number(mp_blue_part (v), pb);
+ free_number(pr);
+ free_number(pg);
+ free_number(pb);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_color_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_cmykcolor_value (MP mp, double c, double m, double y, double k)
+{
+ mp_number pc, pm, py, pk;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_color_node(mp, p, mp_cmykcolor_type);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, pc, c);
+ new_number_from_double(mp, pm, m);
+ new_number_from_double(mp, py, y);
+ new_number_from_double(mp, pk, k);
+ mp_type(mp_cyan_part (v)) = mp_known_type;
+ mp_type(mp_magenta_part(v)) = mp_known_type;
+ mp_type(mp_yellow_part (v)) = mp_known_type;
+ mp_type(mp_black_part (v)) = mp_known_type;
+ mp_set_value_number(mp_cyan_part (v), pc);
+ mp_set_value_number(mp_magenta_part(v), pm);
+ mp_set_value_number(mp_yellow_part (v), py);
+ mp_set_value_number(mp_black_part (v), pk);
+ free_number(pc);
+ free_number(pm);
+ free_number(py);
+ free_number(pk);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_cmykcolor_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_transform_value (MP mp, double x, double y, double xx, double xy, double yx, double yy)
+{
+ mp_number px, py, pxx, pxy, pyx, pyy ;
+ mp_node p = mp_new_value_node(mp);
+ mp_node v;
+ mp_init_transform_node(mp, p);
+ v = mp_get_value_node(p);
+ new_number_from_double(mp, px, x);
+ new_number_from_double(mp, py, y);
+ new_number_from_double(mp, pxx, xx);
+ new_number_from_double(mp, pxy, xy);
+ new_number_from_double(mp, pyx, yx);
+ new_number_from_double(mp, pyy, yy);
+ mp_type(mp_x_part (v)) = mp_known_type;
+ mp_type(mp_y_part (v)) = mp_known_type;
+ mp_type(mp_xx_part(v)) = mp_known_type;
+ mp_type(mp_xy_part(v)) = mp_known_type;
+ mp_type(mp_yx_part(v)) = mp_known_type;
+ mp_type(mp_yy_part(v)) = mp_known_type;
+ mp_set_value_number(mp_x_part (v), px);
+ mp_set_value_number(mp_y_part (v), py);
+ mp_set_value_number(mp_xx_part(v), pxx);
+ mp_set_value_number(mp_xy_part(v), pxy);
+ mp_set_value_number(mp_yx_part(v), pyx);
+ mp_set_value_number(mp_yy_part(v), pyy);
+ free_number(px);
+ free_number(py);
+ free_number(pxx);
+ free_number(pxy);
+ free_number(pyx);
+ free_number(pyy);
+ mp_name_type(p) = mp_capsule_operation;
+ mp->cur_exp.type = mp_transform_type;
+ mp_set_cur_exp_node(mp, p);
+ mp_back_expr(mp);
+}
+
+void mp_push_path_value (MP mp, mp_knot k)
+{
+ mp->cur_exp.type = mp_path_type;
+ mp_set_cur_exp_knot(mp, k);
+ mp_back_expr(mp);
+}
+
+@* The main program.
+
+This is it: the part of \MP\ that executes all those procedures we have written.
+
+Well---almost. We haven't put the parsing subroutines into the program yet; and
+we'd better leave space for a few more routines that may have been forgotten.
+
+@c
+@<Declare the basic parsing subroutines@>
+@<Declare miscellaneous procedures that were declared |forward|@>
+
+@ Here we do whatever is needed to complete \MP's job gracefully on the local
+operating system. The code here might come into play after a fatal error; it must
+therefore consist entirely of \quote {safe} operations that cannot produce error
+messages. For example, it would be a mistake to call |str_room| or |make_string|
+at this time, because a call on |overflow| might lead to an infinite loop.
+@^system dependencies@>
+
+Watch out: we also close all files when we do a subrun (execute) so that's why
+we have this static closer.
+
+@ @<Declarations@>=
+static void mp_close_files (MP mp);
+static void mp_close_files_and_terminate (MP mp);
+
+@ @c
+static void mp_close_files (MP mp)
+{
+ if (mp->rd_fname != NULL) {
+ for (int k = 0; k < (int) mp->read_files; k++) {
+ if (mp->rd_fname[k] != NULL) {
+ (mp->close_file)(mp, mp->rd_file[k]);
+ mp_memory_free(mp->rd_fname[k]);
+ mp->rd_fname[k] = NULL;
+ }
+ }
+ }
+ if (mp->wr_fname != NULL) {
+ for (int k = 0; k < (int) mp->write_files; k++) {
+ if (mp->wr_fname[k] != NULL) {
+ (mp->close_file)(mp, mp->wr_file[k]);
+ mp_memory_free(mp->wr_fname[k]);
+ mp->wr_fname[k] = NULL;
+ }
+ }
+ }
+}
+
+void mp_close_files_and_terminate (MP mp)
+{
+ if (mp->finished) {
+ return;
+ } else {
+ mp_close_files(mp);
+ wake_up_terminal();
+ mp_print_ln(mp);
+ mp->finished = 1;
+ }
+}
+
+@ @<Dealloc ...@>=
+mp_close_files(mp);
+if (mp->rd_fname != NULL) {
+ mp_memory_free(mp->rd_file);
+ mp_memory_free(mp->rd_fname);
+ mp->rd_file = NULL;
+ mp->rd_fname = NULL;
+}
+if (mp->wr_fname != NULL) {
+ mp_memory_free(mp->wr_file);
+ mp_memory_free(mp->wr_fname);
+ mp->wr_file = NULL;
+ mp->wr_fname = NULL;
+}
+
+@ We get to the |final_cleanup| routine when |end| or |dump| has been
+scanned.
+
+@c
+void mp_final_cleanup (MP mp)
+{
+ while (mp->input_ptr > 0) {
+ if (token_state) {
+ mp_end_token_list(mp);
+ } else {
+ mp_end_file_reading(mp);
+ }
+ }
+ while (mp->loop_ptr != NULL) {
+ mp_stop_iteration(mp);
+ }
+ if (mp->interaction < mp_silent_mode) {
+ while (mp->open_parens > 0) {
+ mp_print_str(mp, " )");
+ --mp->open_parens;
+ }
+ }
+ while (mp->cond_ptr != NULL) {
+ mp_print_nl(mp, "(end occurred when ");
+ @.end occurred...@>
+ mp_print_cmd_mod(mp, mp_fi_or_else_command, mp->cur_if);
+ /* |if| or |elseif| or |else| */
+ if (mp->if_line != 0) {
+ mp_print_str(mp, " on line ");
+ mp_print_int(mp, mp->if_line);
+ }
+ mp_print_str(mp, " was incomplete)");
+ mp->if_line = mp_if_line_field(mp->cond_ptr);
+ mp->cur_if = mp_name_type(mp->cond_ptr);
+ mp->cond_ptr = mp_link(mp->cond_ptr);
+ }
+ if (mp->history != mp_spotless) {
+ if (((mp->history == mp_warning_issued) || (mp->interaction < mp_error_stop_mode))) {
+ if (mp->selector == mp_term_and_log_selector) {
+ mp->selector = mp_term_only_selector;
+ mp_print_nl(mp, "(see the transcript file for additional information)");
+ @.see the transcript file...@>
+ mp->selector = mp_term_and_log_selector;
+ }
+ }
+ }
+}
+
+@ @<Declarations@>=
+static void mp_final_cleanup (MP mp);
+static void mp_init_prim (MP mp);
+static void mp_init_tab (MP mp);
+
+@ Initialize all the primitives.
+
+@c void mp_init_prim (MP mp)
+{
+ @<Put each...@>
+}
+
+@ Initialize other tables:
+
+@c void mp_init_tab (MP mp)
+{
+ @<Initialize table entries@>
+}
+
+@* Index.
+
+Here is where you can find all uses of each identifier in the program, with
+underlined entries pointing to where the identifier was defined. If the
+identifier is only one letter long, however, you get to see only the underlined
+entries. {\sl All references are to section numbers instead of page numbers.}
+
+This index also lists error messages and other aspects of the program that you
+might want to look up some day. For example, the entry for \quote {system
+dependencies} lists all sections that should receive special attention from
+people who are installing \MP\ in a new operating environment. A list of various
+things that can't happen appears under ``this can't happen''. Approximately 25
+sections are listed under \quote {inner loop}; these account for more than 60\pct! of
+\MP's running time, exclusive of input and output.
diff --git a/source/luametatex/source/mp/mpw/mpmath.w b/source/luametatex/source/mp/mpw/mpmath.w
new file mode 100644
index 000000000..b9001a61b
--- /dev/null
+++ b/source/luametatex/source/mp/mpw/mpmath.w
@@ -0,0 +1,1949 @@
+% This file is part of MetaPost. The MetaPost program is in the public domain.
+
+@ Introduction.
+
+@c
+# include "mpconfig.h"
+# include "mpmath.h"
+# include "mpstrings.h"
+@h
+
+@ @c
+@<Declarations@>
+
+@ @(mpmath.h@>=
+# ifndef MPMATH_H
+# define MPMATH_H 1
+
+# include "mp.h" /* internal header */
+
+math_data *mp_initialize_scaled_math (MP mp);
+
+# endif
+
+@* Math initialization.
+
+@ Here are the functions that are static as they are not used elsewhere
+
+@<Declarations@>=
+static int mp_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *B);
+static void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *B);
+static void mp_allocate_double (MP mp, mp_number *n, double v);
+static void mp_allocate_number (MP mp, mp_number *n, mp_number_type t);
+static void mp_crossing_point (MP mp, mp_number *ret, mp_number *a, mp_number *b, mp_number *c);
+static void mp_fraction_to_round_scaled (mp_number *x);
+static void mp_free_number (MP mp, mp_number *n);
+static void mp_free_scaled_math (MP mp);
+static void mp_init_randoms (MP mp, int seed);
+static void mp_m_exp (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_m_log (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_m_norm_rand (MP mp, mp_number *ret);
+static void mp_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig);
+static int mp_make_scaled (MP mp, int p, int q);
+static void mp_n_arg (MP mp, mp_number *ret, mp_number *x, mp_number *y);
+static void mp_n_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin);
+static void mp_number_abs (mp_number *A);
+static void mp_number_abs_clone (mp_number *A, mp_number *B);
+static void mp_number_add (mp_number *A, mp_number *B);
+static void mp_number_add_scaled (mp_number *A, int B); /* also for negative B */
+static void mp_number_angle_to_scaled (mp_number *A);
+static void mp_number_clone (mp_number *A, mp_number *B);
+static void mp_number_divide_int (mp_number *A, int B);
+static void mp_number_double (mp_number *A);
+static int mp_number_equal (mp_number *A, mp_number *B);
+static void mp_number_floor (mp_number *i);
+static void mp_number_fraction_to_scaled (mp_number *A);
+static int mp_number_greater (mp_number *A, mp_number *B);
+static void mp_number_half (mp_number *A);
+static int mp_number_less (mp_number *A, mp_number *B);
+static void mp_number_make_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_number_make_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_number_modulo (mp_number *a, mp_number *b);
+static void mp_number_multiply_int (mp_number *A, int B);
+static void mp_number_negate (mp_number *A);
+static void mp_number_negated_clone (mp_number *A, mp_number *B);
+static int mp_number_nonequalabs (mp_number *A, mp_number *B);
+static int mp_number_odd (mp_number *A);
+static void mp_number_scaled_to_angle (mp_number *A);
+static void mp_number_scaled_to_fraction (mp_number *A);
+static void mp_number_subtract (mp_number *A, mp_number *B);
+static void mp_number_swap (mp_number *A, mp_number *B);
+static void mp_number_take_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_number_take_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static int mp_number_to_boolean (mp_number *A);
+static double mp_number_to_double (mp_number *A);
+static int mp_number_to_int (mp_number *A);
+static int mp_number_to_scaled (mp_number *A);
+static void mp_power_of (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_print_number (MP mp, mp_number *n);
+static void mp_pyth_add (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_pyth_sub (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static int mp_round_decimals (MP mp, unsigned char *b, int k);
+static int mp_round_unscaled (mp_number *x_orig);
+static void mp_scaled_set_precision (MP mp);
+static void mp_scan_fractional_token (MP mp, int n);
+static void mp_scan_numeric_token (MP mp, int n);
+static void mp_set_number_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_from_boolean (mp_number *A, int B);
+static void mp_set_number_from_div (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_from_double (mp_number *A, double B);
+static void mp_set_number_from_int (mp_number *A, int B);
+static void mp_set_number_from_int_div (mp_number *A, mp_number *B, int C);
+static void mp_set_number_from_int_mul (mp_number *A, mp_number *B, int C);
+static void mp_set_number_from_mul (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+static void mp_set_number_from_scaled (mp_number *A, int B);
+static void mp_set_number_from_subtraction (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_half_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_number_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C);
+static void mp_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig);
+static void mp_square_rt (MP mp, mp_number *ret, mp_number *x_orig);
+static int mp_take_fraction (MP mp, int q, int f);
+static int mp_take_scaled (MP mp, int q, int f);
+static void mp_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t);
+static void mp_wrapup_numeric_token (MP mp, int n, int f);
+static char *mp_number_tostring (MP mp, mp_number *n);
+static char *mp_string_scaled (MP mp, int s);
+
+@
+@d coef_bound 04525252525 /* |fraction| approximation to 7/3 */
+@d fraction_threshold 2685 /* a |fraction| coefficient less than this is zeroed */
+@d half_fraction_threshold 1342 /* half of |fraction_threshold| */
+@d scaled_threshold 8 /* a |scaled| coefficient less than this is zeroed */
+@d half_scaled_threshold 4 /* half of |scaled_threshold| */
+@d near_zero_angle 26844
+@d p_over_v_threshold 0x80000
+@d equation_threshold 64
+
+@ Fixed-point arithmetic is done on {\sl scaled integers} that are multiples of
+$2^{-16}$. In other words, a binary point is assumed to be sixteen bit positions
+from the right end of a binary computer word.
+
+@d unity 0x10000 /* $2^{16}$, represents 1.00000 */
+@d two (2*unity) /* $2^{17}$, represents 2.00000 */
+@d three (3*unity) /* $2^{17}+2^{16}$, represents 3.00000 */
+@d half_unit (unity/2) /* $2^{15}$, represents 0.50000 */
+@d three_quarter_unit (3*(unity/4)) /* $3\cdot2^{14}$, represents 0.75000 */
+@d EL_GORDO 0x7fffffff /* $2^{31}-1$, the largest value that \MP\ likes */
+@d negative_EL_GORDO (-EL_GORDO)
+@d one_third_EL_GORDO 05252525252
+
+@ We need these preprocessor values
+
+@d TWEXP31 2147483648.0
+@d TWEXP28 268435456.0
+@d TWEXP16 65536.0
+@d TWEXP_16 (1.0/65536.0)
+@d TWEXP_28 (1.0/268435456.0)
+
+@d no_crossing (fraction_one + 1)
+@d one_crossing fraction_one
+@d zero_crossing 0
+
+@ The |scaled| quantities in \MP\ programs are generally supposed to be less than
+$2^{12}$ in absolute value, so \MP\ does much of its internal arithmetic with
+28~significant bits of precision. A |fraction| denotes a scaled integer whose
+binary point is assumed to be 28 bit positions from the right.
+
+@d fraction_half 0x08000000 /* $2^{27}$, represents 0.50000000 01000000000 */
+@d fraction_one 0x10000000 /* $2^{28}$, represents 1.00000000 02000000000 */
+@d fraction_two 0x20000000 /* $2^{29}$, represents 2.00000000 04000000000 */
+@d fraction_three 0x30000000 /* $3\cdot2^{28}$, represents 3.00000000 06000000000 */
+@d fraction_four 0x40000000 /* $2^{30}$, represents 4.00000000 010000000000 */
+
+@ Octants are represented in a \quote {Gray code,} since that turns out to be
+computationally simplest.
+
+@d negate_x 1
+@d negate_y 2
+@d switch_x_and_y 4
+@d first_octant 1
+@d second_octant (first_octant + switch_x_and_y)
+@d third_octant (first_octant + switch_x_and_y + negate_x)
+@d fourth_octant (first_octant + negate_x)
+@d fifth_octant (first_octant + negate_x + negate_y)
+@d sixth_octant (first_octant + switch_x_and_y + negate_x + negate_y)
+@d seventh_octant (first_octant + switch_x_and_y + negate_y)
+@d eighth_octant (first_octant + negate_y)
+
+@d forty_five_deg 0x02D00000 /* $ 45\cdot2^{20}$, represents $ 45^\circ$ 0264000000 */
+@d ninety_deg 0x05A00000 /* $ 90\cdot2^{20}$, represents $ 90^\circ$ 0550000000 */
+@d one_eighty_deg 0x0B400000 /* $180\cdot2^{20}$, represents $180^\circ$ 01320000000 */
+@d negative_one_eighty_deg -0x0B400000 /* $180\cdot2^{20}$, represents $180^\circ$ */
+@d three_sixty_deg 0x16800000 /* $360\cdot2^{20}$, represents $360^\circ$ 02640000000 */
+
+@d odd(A) (abs(A)%2==1)
+@d two_to_the(A) (1<<(unsigned)(A))
+
+@d set_cur_cmd(A) mp->cur_mod_->command = (A)
+@d set_cur_mod(A) mp->cur_mod_->data.n.data.val = (A)
+
+@ @c
+math_data *mp_initialize_scaled_math(MP mp)
+{
+ math_data *math = (math_data *) mp_memory_allocate(sizeof(math_data));
+ /* alloc */
+ math->md_allocate = mp_allocate_number;
+ math->md_free = mp_free_number;
+ math->md_allocate_clone = mp_allocate_clone;
+ math->md_allocate_abs = mp_allocate_abs;
+ math->md_allocate_double = mp_allocate_double;
+ /* precission */
+ mp_allocate_number(mp, &math->md_precision_default, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_max, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_min, mp_scaled_type);
+ /* here are the constants for |scaled| objects */
+ mp_allocate_number(mp, &math->md_epsilon_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_negative_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_warning_limit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_one_third_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_unity_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_two_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_quarter_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_zero_t, mp_scaled_type);
+ /* |fractions| */
+ mp_allocate_number(mp, &math->md_arc_tol_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_one_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_half_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_three_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_four_t, mp_fraction_type);
+ /* |angles| */
+ mp_allocate_number(mp, &math->md_three_sixty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_one_eighty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_negative_one_eighty_deg_t, mp_angle_type);
+ /* various approximations */
+ mp_allocate_number(mp, &math->md_one_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_sqrt_8_e_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twelve_ln_2_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_minus_1, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twelvebits_3, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twentysixbits_sqrt2_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentyeightbits_d_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentysevenbits_sqrt2_d_t, mp_fraction_type);
+ /* thresholds */
+ mp_allocate_number(mp, &math->md_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_half_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_near_zero_angle_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_p_over_v_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_equation_threshold_t, mp_scaled_type);
+ /* initializations */
+ math->md_precision_default.data.val = unity * 10;
+ math->md_precision_max.data.val = unity * 10;
+ math->md_precision_min.data.val = unity * 10;
+ math->md_epsilon_t.data.val = 1;
+ math->md_inf_t.data.val = EL_GORDO;
+ math->md_negative_inf_t.data.val = negative_EL_GORDO;
+ math->md_one_third_inf_t.data.val = one_third_EL_GORDO;
+ math->md_warning_limit_t.data.val = fraction_one;
+ math->md_unity_t.data.val = unity;
+ math->md_two_t.data.val = two;
+ math->md_three_t.data.val = three;
+ math->md_half_unit_t.data.val = half_unit;
+ math->md_three_quarter_unit_t.data.val = three_quarter_unit;
+ math->md_arc_tol_k.data.val = (unity/4096);
+ math->md_fraction_one_t.data.val = fraction_one;
+ math->md_fraction_half_t.data.val = fraction_half;
+ math->md_fraction_three_t.data.val = fraction_three;
+ math->md_fraction_four_t.data.val = fraction_four;
+ math->md_three_sixty_deg_t.data.val = three_sixty_deg;
+ math->md_one_eighty_deg_t.data.val = one_eighty_deg;
+ math->md_negative_one_eighty_deg_t.data.val = negative_one_eighty_deg;
+ math->md_one_k.data.val = 1024;
+ math->md_sqrt_8_e_k.data.val = 112429; /* $2^{16}\sqrt{8/e}\approx 112428.82793$ */
+ math->md_twelve_ln_2_k.data.val = 139548960; /* $2^{24}\cdot12\ln2\approx139548959.6165$ */
+ math->md_coef_bound_k.data.val = coef_bound;
+ math->md_coef_bound_minus_1.data.val = coef_bound - 1;
+ math->md_twelvebits_3.data.val = 1365; /* $1365\approx 2^{12}/3$ */
+ math->md_twentysixbits_sqrt2_t.data.val = 94906266; /* $2^{26}\sqrt2\approx94906265.62$ */
+ math->md_twentyeightbits_d_t.data.val = 35596755; /* $2^{28}d\approx35596754.69$ */
+ math->md_twentysevenbits_sqrt2_d_t.data.val = 25170707; /* $2^{27}\sqrt2\,d\approx25170706.63$ */
+ math->md_fraction_threshold_t.data.val = fraction_threshold;
+ math->md_half_fraction_threshold_t.data.val = half_fraction_threshold;
+ math->md_scaled_threshold_t.data.val = scaled_threshold;
+ math->md_half_scaled_threshold_t.data.val = half_scaled_threshold;
+ math->md_near_zero_angle_t.data.val = near_zero_angle;
+ math->md_p_over_v_threshold_t.data.val = p_over_v_threshold;
+ math->md_equation_threshold_t.data.val = equation_threshold;
+ /* functions */
+ math->md_from_int = mp_set_number_from_int;
+ math->md_from_boolean = mp_set_number_from_boolean;
+ math->md_from_scaled = mp_set_number_from_scaled;
+ math->md_from_double = mp_set_number_from_double;
+ math->md_from_addition = mp_set_number_from_addition;
+ math->md_half_from_addition = mp_set_number_half_from_addition;
+ math->md_from_subtraction = mp_set_number_from_subtraction;
+ math->md_half_from_subtraction = mp_set_number_half_from_subtraction;
+ math->md_from_oftheway = mp_set_number_from_of_the_way;
+ math->md_from_div = mp_set_number_from_div;
+ math->md_from_mul = mp_set_number_from_mul;
+ math->md_from_int_div = mp_set_number_from_int_div;
+ math->md_from_int_mul = mp_set_number_from_int_mul;
+ math->md_negate = mp_number_negate;
+ math->md_add = mp_number_add;
+ math->md_subtract = mp_number_subtract;
+ math->md_half = mp_number_half;
+ math->md_do_double = mp_number_double;
+ math->md_abs = mp_number_abs;
+ math->md_clone = mp_number_clone;
+ math->md_negated_clone = mp_number_negated_clone;
+ math->md_abs_clone = mp_number_abs_clone;
+ math->md_swap = mp_number_swap;
+ math->md_add_scaled = mp_number_add_scaled;
+ math->md_multiply_int = mp_number_multiply_int;
+ math->md_divide_int = mp_number_divide_int;
+ math->md_to_int = mp_number_to_int;
+ math->md_to_boolean = mp_number_to_boolean;
+ math->md_to_scaled = mp_number_to_scaled;
+ math->md_to_double = mp_number_to_double;
+ math->md_odd = mp_number_odd;
+ math->md_equal = mp_number_equal;
+ math->md_less = mp_number_less;
+ math->md_greater = mp_number_greater;
+ math->md_nonequalabs = mp_number_nonequalabs;
+ math->md_round_unscaled = mp_round_unscaled;
+ math->md_floor_scaled = mp_number_floor;
+ math->md_fraction_to_round_scaled = mp_fraction_to_round_scaled;
+ math->md_make_scaled = mp_number_make_scaled;
+ math->md_make_fraction = mp_number_make_fraction;
+ math->md_take_fraction = mp_number_take_fraction;
+ math->md_take_scaled = mp_number_take_scaled;
+ math->md_velocity = mp_velocity;
+ math->md_n_arg = mp_n_arg;
+ math->md_m_log = mp_m_log;
+ math->md_m_exp = mp_m_exp;
+ math->md_m_unif_rand = mp_m_unif_rand;
+ math->md_m_norm_rand = mp_m_norm_rand;
+ math->md_pyth_add = mp_pyth_add;
+ math->md_pyth_sub = mp_pyth_sub;
+ math->md_power_of = mp_power_of;
+ math->md_fraction_to_scaled = mp_number_fraction_to_scaled;
+ math->md_scaled_to_fraction = mp_number_scaled_to_fraction;
+ math->md_scaled_to_angle = mp_number_scaled_to_angle;
+ math->md_angle_to_scaled = mp_number_angle_to_scaled;
+ math->md_init_randoms = mp_init_randoms;
+ math->md_sin_cos = mp_n_sin_cos;
+ math->md_slow_add = mp_slow_add;
+ math->md_sqrt = mp_square_rt;
+ math->md_print = mp_print_number;
+ math->md_tostring = mp_number_tostring;
+ math->md_modulo = mp_number_modulo;
+ math->md_ab_vs_cd = mp_ab_vs_cd;
+ math->md_crossing_point = mp_crossing_point;
+ math->md_scan_numeric = mp_scan_numeric_token;
+ math->md_scan_fractional = mp_scan_fractional_token;
+ math->md_free_math = mp_free_scaled_math;
+ math->md_set_precision = mp_scaled_set_precision;
+ return math;
+}
+
+void mp_scaled_set_precision (MP mp)
+{
+ (void) mp;
+}
+
+void mp_free_scaled_math (MP mp)
+{
+ mp_free_number(mp, &(mp->math->md_epsilon_t));
+ mp_free_number(mp, &(mp->math->md_inf_t));
+ mp_free_number(mp, &(mp->math->md_negative_inf_t));
+ mp_free_number(mp, &(mp->math->md_arc_tol_k));
+ mp_free_number(mp, &(mp->math->md_three_sixty_deg_t));
+ mp_free_number(mp, &(mp->math->md_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_negative_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_fraction_one_t));
+ mp_free_number(mp, &(mp->math->md_fraction_half_t));
+ mp_free_number(mp, &(mp->math->md_fraction_three_t));
+ mp_free_number(mp, &(mp->math->md_fraction_four_t));
+ mp_free_number(mp, &(mp->math->md_zero_t));
+ mp_free_number(mp, &(mp->math->md_half_unit_t));
+ mp_free_number(mp, &(mp->math->md_three_quarter_unit_t));
+ mp_free_number(mp, &(mp->math->md_unity_t));
+ mp_free_number(mp, &(mp->math->md_two_t));
+ mp_free_number(mp, &(mp->math->md_three_t));
+ mp_free_number(mp, &(mp->math->md_one_third_inf_t));
+ mp_free_number(mp, &(mp->math->md_warning_limit_t));
+ mp_free_number(mp, &(mp->math->md_one_k));
+ mp_free_number(mp, &(mp->math->md_sqrt_8_e_k));
+ mp_free_number(mp, &(mp->math->md_twelve_ln_2_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_minus_1));
+ mp_free_number(mp, &(mp->math->md_twelvebits_3));
+ mp_free_number(mp, &(mp->math->md_twentysixbits_sqrt2_t));
+ mp_free_number(mp, &(mp->math->md_twentyeightbits_d_t));
+ mp_free_number(mp, &(mp->math->md_twentysevenbits_sqrt2_d_t));
+ mp_free_number(mp, &(mp->math->md_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_near_zero_angle_t));
+ mp_free_number(mp, &(mp->math->md_p_over_v_threshold_t));
+ mp_free_number(mp, &(mp->math->md_equation_threshold_t));
+ mp_memory_free(mp->math);
+}
+
+@ Creating an destroying |mp_number| objects
+
+@ @c
+void mp_allocate_number (MP mp, mp_number *n, mp_number_type t)
+{
+ (void) mp;
+ n->data.val = 0;
+ n->type = t;
+}
+
+void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.val = v->data.val;
+}
+
+void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.val = abs(v->data.val);
+}
+
+void mp_allocate_double (MP mp, mp_number *n, double v)
+{
+ (void) mp;
+ n->type = mp_scaled_type;
+ n->data.val = (int) (v * 65536.0);
+}
+
+void mp_free_number (MP mp, mp_number *n)
+{
+ (void) mp;
+ n->type = mp_nan_type;
+}
+
+@ Here are the low-level functions on |mp_number| items, setters first.
+
+@ @c
+void mp_set_number_from_int(mp_number *A, int B)
+{
+ A->data.val = B * 65536;
+}
+
+void mp_set_number_from_boolean(mp_number *A, int B)
+{
+ A->data.val = B;
+}
+
+void mp_set_number_from_scaled(mp_number *A, int B)
+{
+ A->data.val = B;
+}
+
+void mp_set_number_from_double(mp_number *A, double B)
+{
+ A->data.val = (int) (B * 65536.0);
+}
+
+void mp_set_number_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val + C->data.val;
+}
+
+void mp_set_number_half_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = (B->data.val + C->data.val) / 2;
+}
+
+void mp_set_number_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val - C->data.val;
+}
+
+void mp_set_number_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = (B->data.val - C->data.val) / 2;
+}
+
+void mp_set_number_from_div(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val / C->data.val;
+}
+
+void mp_set_number_from_mul(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.val = B->data.val * C->data.val;
+}
+
+void mp_set_number_from_int_div(mp_number *A, mp_number *B, int C)
+{
+ A->data.val = B->data.val / C;
+}
+
+void mp_set_number_from_int_mul(mp_number *A, mp_number *B, int C)
+{
+ A->data.val = B->data.val * C;
+}
+
+void mp_set_number_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C)
+{
+ (void) mp;
+ A->data.val = B->data.val - mp_take_fraction(mp, (B->data.val - C->data.val), t->data.val);
+}
+
+void mp_number_negate(mp_number *A)
+{
+ A->data.val = -A->data.val;
+}
+
+void mp_number_add(mp_number *A, mp_number *B)
+{
+ A->data.val = A->data.val + B->data.val;
+}
+
+void mp_number_subtract(mp_number *A, mp_number *B)
+{
+ A->data.val = A->data.val - B->data.val;
+}
+
+void mp_number_half(mp_number *A)
+{
+ A->data.val = A->data.val / 2;
+}
+
+void mp_number_double(mp_number *A)
+{
+ A->data.val = A->data.val + A->data.val;
+}
+
+void mp_number_add_scaled(mp_number *A, int B)
+{
+ /* also for negative B */
+ A->data.val = A->data.val + B;
+}
+
+void mp_number_multiply_int(mp_number *A, int B)
+{
+ A->data.val = B * A->data.val;
+}
+
+void mp_number_divide_int(mp_number *A, int B)
+{
+ A->data.val = A->data.val / B;
+}
+
+void mp_number_abs(mp_number *A)
+{
+ A->data.val = abs(A->data.val);
+}
+
+void mp_number_clone(mp_number *A, mp_number *B)
+{
+ A->data.val = B->data.val;
+}
+
+void mp_number_negated_clone(mp_number *A, mp_number *B)
+{
+ A->data.val = -B->data.val;
+}
+
+void mp_number_abs_clone(mp_number *A, mp_number *B)
+{
+ A->data.val = abs(B->data.val);
+}
+
+void mp_number_swap(mp_number *A, mp_number *B)
+{
+ int swap_tmp = A->data.val;
+ A->data.val = B->data.val;
+ B->data.val = swap_tmp;
+}
+
+void mp_number_fraction_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ A->data.val = A->data.val / 4096;
+}
+
+void mp_number_angle_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ if (A->data.val >= 0) {
+ A->data.val = (A->data.val + 8) / 16;
+ } else {
+ A->data.val = -((-A->data.val + 8) / 16);
+ }
+}
+
+void mp_number_scaled_to_fraction(mp_number *A)
+{
+ A->type = mp_fraction_type;
+ A->data.val = A->data.val * 4096;
+}
+
+void mp_number_scaled_to_angle(mp_number *A)
+{
+ A->type = mp_angle_type;
+ A->data.val = A->data.val * 16;
+}
+
+@ Query functions
+
+@c
+int mp_number_to_int(mp_number *A)
+{
+ return A->data.val;
+}
+
+int mp_number_to_scaled(mp_number *A)
+{
+ return A->data.val;
+}
+
+int mp_number_to_boolean(mp_number *A)
+{
+ return A->data.val;
+}
+
+double mp_number_to_double(mp_number *A)
+{
+ return A->data.val / 65536.0;
+}
+
+int mp_number_odd(mp_number *A)
+{
+ return odd(mp_round_unscaled(A));
+}
+
+int mp_number_equal(mp_number *A, mp_number *B) {
+ return A->data.val == B->data.val;
+}
+
+int mp_number_greater(mp_number *A, mp_number *B)
+{
+ return A->data.val > B->data.val;
+}
+
+int mp_number_less(mp_number *A, mp_number *B)
+{
+ return A->data.val < B->data.val;
+}
+
+int mp_number_nonequalabs(mp_number *A, mp_number *B)
+{
+ return abs(A->data.val) != abs(B->data.val);
+}
+
+@ One of \MP's most common operations is the calculation of $\lfloor {a+b\over2}
+\rfloor$, the midpoint of two given integers |a| and~|b|. The most decent way to
+do this is to write |(a+b)/2|; but on many machines it is more efficient to
+calculate |(a+b)>>1|.
+
+Therefore the midpoint operation will always be denoted by |half(a+b)| in this
+program. If \MP\ is being implemented with languages that permit binary shifting,
+the |half| macro should be changed to make this operation as efficient as
+possible. Since some systems have shift operators that can only be trusted to
+work on positive numbers, there is also a macro |halfp| that is used only when
+the quantity being halved is known to be positive or zero.
+
+@ Here is a procedure analogous to |print_int|. If the output of this procedure
+is subsequently read by \MP\ and converted by the |round_decimals| routine above,
+it turns out that the original value will be reproduced exactly. A decimal point
+is printed only if the value is not an integer. If there is more than one way to
+print the result with the optimum number of digits following the decimal point,
+the closest possible value is given.
+
+The invariant relation in the |repeat| loop is that a sequence of decimal
+digits yet to be printed will yield the original number if and only if they form
+a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$. We can stop if and only
+if $f=0$ satisfies this condition; the loop will terminate before $s$ can
+possibly become zero. We round to five digits
+
+@ @c
+static char *mp_string_scaled (MP mp, int s)
+{
+ (void) mp;
+ static char scaled_string[32];
+ int i = 0;
+ if (s < 0) {
+ scaled_string[i++] = '-';
+ s = -s;
+ }
+ /* print the integer part */
+ mp_snprintf ((scaled_string+i), 12, "%d", (int) (s / unity));
+ while (*(scaled_string+i)) {
+ i++;
+ }
+ s = 10 * (s % unity) + 5;
+ if (s != 5) {
+ /* amount of allowable inaccuracy, scaled */
+ int delta = 10;
+ scaled_string[i++] = '.';
+ do {
+ /* round the final digit */
+ if (delta > unity) {
+ s = s + 0100000 - (delta / 2);
+ }
+ scaled_string[i++] = '0' + (s / unity);
+ s = 10 * (s % unity);
+ delta = delta * 10;
+ } while (s > delta);
+ }
+ scaled_string[i] = '\0';
+ return scaled_string;
+}
+
+@ Addition is not always checked to make sure that it doesn't overflow, but in
+places where overflow isn't too unlikely the |slow_add| routine is used.
+
+@c
+void mp_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ int x = x_orig->data.val;
+ int y = y_orig->data.val;
+ if (x >= 0) {
+ if (y <= EL_GORDO - x) {
+ ret->data.val = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.val = EL_GORDO;
+ }
+ } else if (-y <= EL_GORDO + x) {
+ ret->data.val = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.val = negative_EL_GORDO;
+ }
+}
+
+@ The |make_fraction| routine produces the |fraction| equivalent of |p/q|, given
+integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are positive. If |p| and
+|q| are both of the same scaled type |t|, the \quote {type relation}
+|make_fraction(t,t)=fraction| is valid; and it's also possible to use the
+subroutine \quote {backwards,} using the relation |make_fraction(t,fraction)=t|
+between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_fraction| sets
+|arith_error:=true|. Most of \MP's internal computations have been designed to
+avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical machine, we
+could simply compute |(@t$2^{28}$@>*p)div q|, since a double-precision product
+can often be input to a fixed-point division instruction. But when we are
+restricted to int-eger arithmetic it is necessary either to resort to
+multiple-precision maneuvering or to use a simple but slow iteration. The
+multiple-precision technique would be about three times faster than the code
+adopted here, but it would be comparatively long and tricky, involving about
+sixteen additional multiplications and divisions.
+
+This operation is part of \MP's \quote {inner loop}; indeed, it will consume nearly
+10\pct! of the running time (exclusive of input and output) if the code below is
+left unchanged. A machine-dependent recoding will therefore make \MP\ run faster.
+The present implementation is highly portable, but slow; it avoids multiplication
+and division except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical results in all
+cases. @^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the \quote {inner loop,}
+such changes aren't advisable; simplicity and robustness are preferable to
+trickery, unless the cost is too high. @^inner loop@>
+
+@ @c
+static int mp_make_fraction (MP mp, int p, int q)
+{
+ if (q == 0) {
+ mp_confusion (mp, "division by zero");
+ @:this can't happen /}{\quad \./@>
+ return 0;
+ } else {
+ double d = TWEXP28 * (double) p / (double) q;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ mp->arith_error = 1;
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? -q : q) & 077777) * (((i & 037777) << 1) - 1) & 04000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ mp->arith_error = 1;
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? q : -q) & 077777) * (((i & 037777) << 1) + 1) & 04000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+ }
+}
+
+void mp_number_make_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q)
+{
+ ret->data.val = mp_make_fraction (mp, p->data.val, q->data.val);
+}
+
+@ The dual of |make_fraction| is |take_fraction|, which multiplies a given
+integer~|q| by a fraction~|f|. When the operands are positive, it computes
+$p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function of |q| and~|f|.
+
+This routine is even more \quote {inner loopy} than |make_fraction|; the present
+implementation consumes almost 20\pct! of \MP's computation time during typical
+jobs, so a machine-language substitute is advisable. @^inner loop@> @^system
+dependencies@>
+
+@ Here |q| is the fraction. @c
+int mp_take_fraction (MP mp, int p, int q)
+{
+ double d = (double) p *(double) q *TWEXP_28;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ if (d != TWEXP31 || (((p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((p & 077777) * (q & 077777)) & 040000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ if (d != -TWEXP31 || ((-(p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && ((-(p & 077777) * (q & 077777)) & 040000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+}
+
+void mp_number_take_fraction (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ ret->data.val = mp_take_fraction (mp, p_orig->data.val, q_orig->data.val);
+}
+
+@ When we want to multiply something by a |scaled| quantity, we use a scheme
+analogous to |take_fraction| but with a different scaling. Given positive
+operands, |take_scaled| computes the quantity $p=\lfloor
+qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use a machine-language replacement if possible;
+otherwise |take_scaled| will use more than 2\pct! of the running time when the
+Computer Modern fonts are being generated. @^inner loop@>
+
+@ @c
+static int mp_take_scaled (MP mp, int p, int q)
+{ /* q = scaled */
+ double d = (double) p *(double) q *TWEXP_16;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ if (d != TWEXP31 || (((p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((p & 077777) * (q & 077777)) & 040000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ if (d != -TWEXP31 || ((-(p & 077777) * (q & 077777)) & 040000) == 0) {
+ mp->arith_error = 1;
+ }
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && ((-(p & 077777) * (q & 077777)) & 040000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+}
+
+void mp_number_take_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ ret->data.val = mp_take_scaled(mp, p_orig->data.val, q_orig->data.val);
+}
+
+@ For completeness, there's also |make_scaled|, which computes a quotient as a
+|scaled| number instead of as a |fraction|. In other words, the result is
+$\lfloor2^{16}p/q+{1\over2}\rfloor$, if the operands are positive. \ (This
+procedure is not used especially often, so it is not part of \MP's inner loop.)
+
+@ @c
+int mp_make_scaled (MP mp, int p, int q)
+{
+ if (q == 0) {
+ mp_confusion (mp, "division by zero");
+ @:this can't happen /}{\quad \./@>
+ return 0;
+ } else {
+ double d = TWEXP16 * (double) p / (double) q;
+ if ((p ^ q) >= 0) {
+ d += 0.5;
+ if (d >= TWEXP31) {
+ mp->arith_error = 1;
+ return EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? -q : q) & 077777) * (((i & 037777) << 1) - 1) & 04000) != 0) {
+ --i;
+ }
+ return i;
+ }
+ } else {
+ d -= 0.5;
+ if (d <= -TWEXP31) {
+ mp->arith_error = 1;
+ return -negative_EL_GORDO;
+ } else {
+ int i = (int) d;
+ if (d == (double) i && (((q > 0 ? q : -q) & 077777) * (((i & 037777) << 1) + 1) & 04000) != 0) {
+ ++i;
+ }
+ return i;
+ }
+ }
+ }
+}
+
+void mp_number_make_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ ret->data.val = mp_make_scaled(mp, p_orig->data.val, q_orig->data.val);
+}
+
+@ The following function is used to create a scaled integer from a given decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|.
+
+@ This converts a decimal fraction.
+@c
+static int mp_round_decimals (MP mp, unsigned char *b, int k)
+{
+ unsigned a = 0; /* the accumulator */
+ int l = 0;
+ (void) mp; /* Will be needed later */
+ for (l = k-1; l >= 0; l-- ) {
+ if (l<16) {
+ /* digits for |k>=17| cannot affect the result */
+ a = (a + (unsigned) (*(b+l) - '0') * two) / 10;
+ }
+ }
+ return (int) (a + 1)/2;
+}
+
+@ @* Scanning numbers in the input.
+
+@ We no longer have these character mapping so we can just as well do the next
+without class checking. Also because signs are hard checked.
+
+@ @c
+static void mp_wrapup_numeric_token (MP mp, int n, int f)
+{
+ if (n < 32768) {
+ int mod = (n * unity + f); /* scaled */
+ set_cur_mod(mod);
+ if (mod >= fraction_one) {
+ if (internal_value(mp_warning_check_internal).data.val > 0 && (mp->scanner_status != mp_tex_flushing_state)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Number is too large (%s)", mp_string_scaled(mp,mod));
+ @.Number is too large@>
+ mp_error(
+ mp,
+ msg,
+ "It is at least 4096. Continue and I'll try to cope with that big value;\n"
+ "but it might be dangerous. (Set warningcheck:=0 to suppress this message.)"
+ );
+ }
+ }
+ } else if (mp->scanner_status != mp_tex_flushing_state) {
+ mp_error(
+ mp,
+ "Enormous number has been reduced",
+ "I can\'t handle numbers bigger than 32767.99998; so I've changed your constant\n"
+ "to that maximum amount."
+ );
+ @.Enormous number...@>
+ set_cur_mod(EL_GORDO);
+ }
+ set_cur_cmd(mp_numeric_command);
+}
+
+@ @c
+void mp_scan_fractional_token (MP mp, int n)
+{ /* n: scaled */
+ int f; /* scaled */
+ int k = 0;
+ do {
+ k++;
+ mp->cur_input.loc_field++;
+ } while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class);
+ f = mp_round_decimals(mp, (unsigned char *)(mp->buffer+mp->cur_input.loc_field-k), (int) k);
+ if (f == unity) {
+ n++;
+ f = 0;
+ }
+ mp_wrapup_numeric_token(mp, n, f);
+}
+
+
+@ @c
+void mp_scan_numeric_token (MP mp, int n)
+{
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ if (n < 32768) {
+ n = 10 * n + mp->buffer[mp->cur_input.loc_field] - '0';
+ }
+ mp->cur_input.loc_field++;
+ }
+ if (! (mp->buffer[mp->cur_input.loc_field] == '.' && mp->char_class[mp->buffer[mp->cur_input.loc_field + 1]] == mp_digit_class)) {
+ mp_wrapup_numeric_token(mp, n, 0);
+ } else {
+ mp->cur_input.loc_field++;
+ mp_scan_fractional_token(mp, n);
+ }
+}
+
+@ Here is a typical example of how the routines above can be used. It computes
+the function $${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+(\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$
+where $\tau$ is a |scaled| \quote {tension} parameter. This is \MP's magic fudge
+factor for placing the first control point of a curve that starts at an angle
+$\theta$ and ends at an angle $\phi$ from the straight path. (Actually, if the
+stated quantity exceeds 4, \MP\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using relations
+such as $\sin\theta\cos\theta|1\over2|$.) Thus the numerator is positive; and
+since the tension $\tau$ is constrained to be at least $3\over4$, the numerator
+is less than $16\over3$. The denominator is nonnegative and at most~6. Hence the
+fixed-point calculations below are guaranteed to stay within the bounds of a
+32-bit computer word.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction|
+arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+@c
+void mp_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t)
+{
+ int acc, num, denom; /* registers for intermediate calculations */
+ acc = mp_take_fraction(mp, st->data.val - (sf->data.val / 16), sf->data.val - (st->data.val / 16));
+ acc = mp_take_fraction(mp, acc, ct->data.val - cf->data.val);
+ num = fraction_two + mp_take_fraction(mp, acc, 379625062);
+ /*
+ $2^{28}\sqrt2\approx379625062.497$
+ */
+ denom = fraction_three + mp_take_fraction(mp, ct->data.val, 497706707) + mp_take_fraction (mp, cf->data.val, 307599661);
+ /*
+ $3\cdot2^{27}\cdot(\sqrt5-1)\approx497706706.78$ and
+ $3\cdot2^{27}\cdot(3-\sqrt5\,)\approx307599661.22$
+ */
+ if (t->data.val != unity) {
+ /* |make_scaled(fraction,scaled)=fraction| */
+ num = mp_make_scaled (mp, num, t->data.val);
+ }
+ if (num / 4 >= denom) {
+ ret->data.val = fraction_four;
+ } else {
+ ret->data.val = mp_make_fraction(mp, num, denom);
+ }
+ /* |printf ("num,denom=%f,%f -=> %f\n", num/65536.0, denom/65536.0, ret.data.val/65536.0);| */
+}
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is greater
+than, equal to, or less than~$cd$, given integers $(a,b,c,d)$. In most cases a
+quick decision is reached. The result is $+1$, 0, or~$-1$ in the three respective
+cases.
+
+@c
+static int mp_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ int a = a_orig->data.val;
+ int b = b_orig->data.val;
+ int c = c_orig->data.val;
+ int d = d_orig->data.val;
+ if (a < 0) {
+ a = -a;
+ b = -b;
+ }
+ if (c < 0) {
+ c = -c;
+ d = -d;
+ }
+ if (d <= 0) {
+ if (b >= 0) {
+ if ((a == 0 || b == 0) && (c == 0 || d == 0)) {
+ return 0;
+ } else {
+ return 1;
+ }
+ } else if (d == 0) {
+ return a == 0 ? 0 : -1;
+ } else {
+ int q = a;
+ a = c;
+ c = q;
+ q = -b;
+ b = -d;
+ d = q;
+ }
+ } else if (b <= 0) {
+ if (b < 0 && a > 0) {
+ return -1;
+ } else {
+ return c == 0 ? 0 : -1;
+ }
+ }
+ while (1) {
+ int q = a / d;
+ int r = c / b;
+ if (q != r) {
+ return q > r ? 1 : -1;
+ } else {
+ q = a % d;
+ r = c % b;
+ if (r == 0) {
+ return q ? 1 : 0;
+ } else if (q == 0) {
+ return -1;
+ } else {
+ a = b;
+ b = q;
+ c = d;
+ d = r;
+ }
+ }
+ }
+ /* now |a>d>0| and |c>b>0| */
+}
+
+@ Now here's a subroutine that's handy for all sorts of path computations: Given
+a quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function returns the
+unique |fraction| value |t| between 0 and~1 at which $B(a,b,c;t)$ changes from
+positive to negative, or returns |t=fraction_one+1| if no such value exists. If
+|a<0| (so that $B(a,b,c;t)$ is already negative at |t=0|), |crossing_point|
+returns the value zero.
+
+The general bisection method is quite simple when $n=2$, hence |crossing_point|
+does not take much time. At each stage in the recursion we have a subinterval
+defined by |l| and~|j| such that $B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we
+want to \quote {zero in} on the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values of |l| and~|j|
+in a single variable $d=2^l+j$, because the operation of bisection then
+corresponds simply to doubling $d$ and possibly adding~1. Furthermore it proves
+to be convenient to modify our previous conventions for bisection slightly,
+maintaining the variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and
+$X_2=2^l(x_1-x_2)$. With these variables the conditions $x_0\ge0$ and
+$\min(x_1,x_2)<0$ are equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L|x0|<\max(|x1|,|x1|+|x2|)$, $\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow will occur if
+the inputs satisfy $a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert
+b-c\vert<2^{30}$.
+
+@c
+static void mp_crossing_point (MP mp, mp_number *ret, mp_number *aa, mp_number *bb, mp_number *cc)
+{
+ int x, xx, x0, x1, x2; /* temporary registers for bisection */
+ int a = aa->data.val;
+ int b = bb->data.val;
+ int c = cc->data.val;
+ int d; /* recursive counter */
+ (void) mp;
+ if (a < 0) {
+ ret->data.val = zero_crossing;
+ return;
+ } else if (c >= 0) {
+ if (b >= 0) {
+ if (c > 0) {
+ ret->data.val = no_crossing;
+ } else if ((a == 0) && (b == 0)) {
+ ret->data.val = no_crossing;
+ } else {
+ ret->data.val = one_crossing;
+ }
+ return;
+ } else if (a == 0) {
+ ret->data.val = zero_crossing;
+ return;
+ }
+ } else if (a == 0) {
+ if (b <= 0) {
+ ret->data.val = zero_crossing;
+ return;
+ }
+ }
+ /* Use bisection to find the crossing point... */
+ d = 1;
+ x0 = a;
+ x1 = a - b;
+ x2 = b - c;
+ do {
+ x = (x1 + x2) / 2;
+ if (x1 - x0 > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ xx = x1 + x - x0;
+ if (xx > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ x0 = x0 - xx;
+ if ((x <= x0) && (x + x2 <= x0)) {
+ ret->data.val = no_crossing;
+ return;
+ } else {
+ x1 = x;
+ d = d + d + 1;
+ }
+ }
+ }
+ } while (d < fraction_one);
+ ret->data.val = d - fraction_one;
+}
+
+@ We conclude this set of elementary routines with some simple rounding and
+truncation operations.
+
+@ |round_unscaled| rounds a |scaled| and converts it to |int|
+@c
+int mp_round_unscaled(mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ if (x >= 32768) {
+ return 1 + ((x-32768) / 65536);
+ } else if (x >= -32768) {
+ return 0;
+ } else {
+ return -(1+((-(x+1)-32768) / 65536));
+ }
+}
+
+@ |number_floor| floors a |scaled|
+
+@c
+void mp_number_floor(mp_number *i)
+{
+ i->data.val = i->data.val&-65536;
+}
+
+@ |fraction_to_scaled| rounds a |fraction| and converts it to |scaled|
+@c
+void mp_fraction_to_round_scaled(mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ x_orig->type = mp_scaled_type;
+ x_orig->data.val = (x>=2048 ? 1+((x-2048) / 4096) : ( x>=-2048 ? 0 : -(1+((-(x+1)-2048) / 4096))));
+}
+
+@* Algebraic and transcendental functions. \MP\ computes all of the necessary
+special functions from scratch, without relying on |real| arithmetic or system
+subroutines for sines, cosines, etc.
+
+@ To get the square root of a |scaled| number |x|, we want to calculate
+$s=\lfloor 2^8\!\sqrt x +{1\over2}\rfloor$. If $x>0$, this is the unique integer
+such that $2^{16}x-s\L s^2<2^{16}x+s$. The following subroutine determines $s$ by
+an iterative method that maintains the invariant relations $x=2^{46-2k}x_0\bmod
+2^{30}$, $0<y=\lfloor 2^{16-2k}x_0\rfloor -s^2+s\L q=2s$, where $x_0$ is the
+initial value of $x$. The value of~$y$ might, however, be zero at the start of
+the first iteration.
+
+@c
+void mp_square_rt (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ if (x <= 0) {
+ if (x < 0) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Square root of %s has been replaced by 0", mp_string_scaled(mp, x));
+ @.Square root...replaced by 0@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ ret->data.val = 0;
+ } else {
+ int k = 23; /* iteration control counter */
+ int y;
+ int q = 2;
+ while (x < fraction_two) { /* i.e., |while x<@t$2^{29}$@>|\unskip */
+ k--;
+ x = x + x + x + x;
+ }
+ if (x < fraction_four)
+ y = 0;
+ else {
+ x = x - fraction_four;
+ y = 1;
+ }
+ do {
+ @<Decrease |k| by 1, maintaining the invariant relations between |x|, |y|, and~|q|@>
+ } while (k != 0);
+ ret->data.val = (int) (q/2);
+ }
+}
+
+@ @<Decrease |k| by 1, maintaining...@>=
+x += x;
+y += y;
+if (x >= fraction_four) {
+ /* note that |fraction_four=@t$2^{30}$@>| */
+ x = x - fraction_four;
+ y++;
+};
+x += x;
+y = y + y - q;
+q += q;
+if (x >= fraction_four) {
+ x = x - fraction_four;
+ y++;
+};
+if (y > (int) q) {
+ y -= q;
+ q += 2;
+} else if (y <= 0) {
+ q -= 2;
+ y += q;
+};
+k--;
+
+@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by an elegant iterative
+scheme due to Cleve Moler and Donald Morrison [{\sl IBM Journal @^Moler, Cleve
+Barry@> @^Morrison, Donald Ross@> of Research and Development \bf27} (1983),
+577--581]. It modifies |a| and~|b| in such a way that their Pythagorean sum
+remains invariant, while the smaller argument decreases.
+
+@c
+void mp_pyth_add (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ int a = abs(a_orig->data.val);
+ int b = abs(b_orig->data.val);
+ if (a < b) {
+ int r = b;
+ b = a;
+ a = r;
+ }
+ /* now |0<=b<=a| */
+ if (b > 0) {
+ int big; /* is the result dangerously near $2^{31}$? */
+ if (a < fraction_two) {
+ big = 0;
+ } else {
+ a = a / 4;
+ b = b / 4;
+ big = 1;
+ }
+ /* we reduced the precision to avoid arithmetic overflow */
+ @<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>
+ if (big) {
+ if (a < fraction_two) {
+ a = a + a + a + a;
+ } else {
+ mp->arith_error = 1;
+ a = EL_GORDO;
+ }
+ }
+ }
+ ret->data.val = a;
+}
+
+@ The key idea here is to reflect the vector $(a,b)$ about the line through
+$(a,b/2)$.
+
+@<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>=
+while (1) {
+ int r = mp_make_fraction(mp, b, a);
+ r = mp_take_fraction(mp, r, r);
+ /* now $r\approx b^2/a^2$ */
+ if (r == 0) {
+ break;
+ } else {
+ r = mp_make_fraction(mp, r, fraction_four + r);
+ a = a + mp_take_fraction(mp, a + a, r);
+ b = mp_take_fraction(mp, b, r);
+ }
+}
+
+@ Here is a similar algorithm for $\psqrt{a^2-b^2}$. It converges slowly when $b$
+is near $a$, but otherwise it works fine.
+
+@c
+void mp_pyth_sub (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ int a = abs(a_orig->data.val);
+ int b = abs(b_orig->data.val);
+ if (a <= b) {
+ @<Handle erroneous |pyth_sub| and set |a:=0|@>
+ } else {
+ int big; /* is the result dangerously near $2^{31}$? */
+ if (a < fraction_four) {
+ big = 0;
+ } else {
+ a = (int) a/2;
+ b = (int) b/2;
+ big = 1;
+ }
+ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>
+ if (big) {
+ a *= 2;
+ }
+ }
+ ret->data.val = a;
+}
+
+@ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>=
+while (1) {
+ int r = mp_make_fraction(mp, b, a);
+ r = mp_take_fraction(mp, r, r);
+ /* now $r\approx b^2/a^2$ */
+ if (r == 0) {
+ break;
+ } else {
+ r = mp_make_fraction(mp, r, fraction_four - r);
+ a = a - mp_take_fraction(mp, a + a, r);
+ b = mp_take_fraction(mp, b, r);
+ }
+}
+
+@ @<Handle erroneous |pyth_sub| and set |a:=0|@>=
+if (a < b) {
+ char msg[256];
+ char *astr = mp_strdup(mp_string_scaled(mp, a));
+ mp_snprintf(msg, 256, "Pythagorean subtraction %s+-+%s has been replaced by 0", astr, mp_string_scaled(mp, b));
+ mp_memory_free(astr);
+ @.Pythagorean...@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+}
+a = 0;
+
+@ For the moment we just abuse doubles here.
+
+@c
+void mp_power_of (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ double p = pow(mp_number_to_double(a_orig), mp_number_to_double(b_orig));
+ long r = lround(p * 65536.0);
+ if (r > 0) {
+ if (r >= EL_GORDO) {
+ mp->arith_error = 1;
+ r = EL_GORDO;
+ }
+ } else if (r < 0) {
+ if (r <= - EL_GORDO) {
+ mp->arith_error = 1;
+ r = - EL_GORDO;
+ }
+ }
+ ret->data.val = r;
+}
+
+@ The subroutines for logarithm and exponential involve two tables. The first is
+simple: |two_to_the[k]| equals $2^k$. The second involves a bit more calculation,
+which the author claims to have done correctly: |mp_m_spec_log[k]| is $2^{27}$ times
+$\ln\bigl(1/(1-2^{-k})\bigr)= 2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$,
+rounded to the nearest integer.
+
+@<Declarations@>=
+static const int mp_m_spec_log[29] = {
+ 0, 93032640, 38612034, 17922280, 8662214, 4261238, 2113709, 1052693, 525315,
+ 262400, 131136, 65552, 32772, 16385, 8192, 4096, 2048, 1024, 512, 256, 128,
+ 64, 32, 16, 8, 4, 2, 1, 1
+};
+
+@ Here is the routine that calculates $2^8$ times the natural logarithm of a
+|scaled| quantity; it is an integer approximation to $2^{24}\ln(x/2^{16})$, when
+|x| is a given positive integer.
+
+The method is based on exercise 1.2.2--25 in {\sl The Art of Computer
+Programming}: During the main iteration we have $1\L 2^{-30}x<1/(1-2^{1-k})$,
+and the logarithm of $2^{30}x$ remains to be added to an accumulator register
+called~$y$. Three auxiliary bits of accuracy are retained in~$y$ during the
+calculation, and sixteen auxiliary bits to extend |y| are kept in~|z| during the
+initial argument reduction. (We add $100\cdot2^{16}=6553600$ to~|z| and subtract
+100 from~|y| so that |z| will not become negative; also, the actual amount
+subtracted from~|y| is~96, not~100, because we want to add~4 for rounding before
+the final division by~8.)
+
+@c
+void mp_m_log (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ int x = x_orig->data.val;
+ if (x <= 0) {
+ @<Handle non-positive logarithm@>
+ } else {
+ int k = 2; /* iteration counter, starts at 2 */
+ int y = 1302456956 + 4 - 100; /* $14\times2^{27}\ln2\approx1302456956.421063$ */
+ int z = 27595 + 6553600; /* and $2^{16}\times .421063\approx 27595$ */
+ /* $2^{27}\ln2\approx 93032639.74436163$ and $2^{16}\times.74436163\approx 48782$ */
+ while (x < fraction_four) {
+ x = 2*x;
+ y -= 93032639;
+ z -= 48782;
+ }
+ y = y + (z / unity);
+ while (x > fraction_four + 4) {
+ @<Increase |k| until |x| can be multiplied by a factor of $2^{-k}$, and adjust $y$ accordingly@>
+ }
+ ret->data.val = (y / 8);
+ }
+}
+
+@ @<Increase |k| until |x| can...@>=
+{
+ z = ((x - 1) / two_to_the (k)) + 1; /* $z=\lceil x/2^k\rceil$ */
+ while (x < fraction_four + z) {
+ z = (z + 1)/2;
+ k++;
+ };
+ y += mp_m_spec_log[k];
+ x -= z;
+}
+
+@ @<Handle non-positive logarithm@>=
+{
+ char msg[256];
+ mp_snprintf(msg, 256, "Logarithm of %s has been replaced by 0", mp_string_scaled(mp, x));
+ @.Logarithm...replaced by 0@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take logs of non-positive numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.val = 0;
+}
+
+@ Conversely, the exponential routine calculates $\exp(x/2^8)$, when |x| is
+|scaled|. The result is an integer approximation to $2^{16}\exp(x/2^{24})$, when
+|x| is regarded as an integer.
+
+@c
+void mp_m_exp (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ int y, z; /* auxiliary registers */
+ int x = x_orig->data.val;
+ if (x > 174436200) {
+ /* $2^{24}\ln((2^{31}-1)/2^{16})\approx 174436199.51$ */
+ mp->arith_error = 1;
+ ret->data.val = EL_GORDO;
+ } else if (x < -197694359) {
+ /* $2^{24}\ln(2^{-1}/2^{16})\approx-197694359.45$ */
+ ret->data.val = 0;
+ } else {
+ if (x <= 0) {
+ z = -8 * x;
+ y = 04000000; /* $y=2^{20}$ */
+ } else {
+ if (x <= 127919879) {
+ z = 1023359037 - 8 * x;
+ /* $2^{27}\ln((2^{31}-1)/2^{20})\approx 1023359037.125$ */
+ } else {
+ /* |z| is always nonnegative */
+ z = 8 * (174436200 - x);
+ }
+ y = EL_GORDO;
+ }
+ @<Multiply |y| by $\exp(-z/2^{27})$@>
+ if (x <= 127919879) {
+ ret->data.val = ((y + 8) / 16);
+ } else {
+ ret->data.val = y;
+ }
+ }
+}
+
+@ The idea here is that subtracting |mp_m_spec_log[k]| from |z| corresponds to
+multiplying |y| by $1-2^{-k}$.
+
+A subtle point (which had to be checked) was that if $x=127919879$, the value
+of~|y| will decrease so that |y+8| doesn't overflow. In fact, $z$ will be 5 in
+this case, and |y| will decrease by~64 when |k=25| and by~16 when |k=27|.
+
+@<Multiply |y| by...@>=
+{
+ int k = 1; /* loop control index */
+ while (z > 0) {
+ while (z >= mp_m_spec_log[k]) {
+ z -= mp_m_spec_log[k];
+ y = y - 1 - ((y - two_to_the(k - 1)) / two_to_the(k));
+ }
+ k++;
+ }
+}
+
+@ The trigonometric subroutines use an auxiliary table such that |spec_atan[k]|
+contains an approximation to the |angle| whose tangent is~$1/2^k$.
+$\arctan2^{-k}$ times $2^{20}\cdot180/\pi$
+
+@<Declarations@>=
+static const int mp_m_spec_atan[27] = {
+ 0, 27855475, 14718068, 7471121, 3750058, 1876857, 938658, 469357, 234682,
+ 117342, 58671, 29335, 14668, 7334, 3667, 1833, 917, 458, 229, 115, 57, 29,
+ 14, 7, 4, 2, 1
+};
+
+
+@ Given integers |x| and |y|, not both zero, the |n_arg| function returns the
+|angle| whose tangent points in the direction $(x,y)$. This subroutine first
+determines the correct octant, then solves the problem for |0<=y<=x|, then
+converts the result appropriately to return an answer in the range
+|-one_eighty_deg<=@t$\theta$@><=one_eighty_deg|. (The answer is |+one_eighty_deg|
+if |y=0| and |x<0|, but an answer of |-one_eighty_deg| is possible if, for
+example, |y=-1| and $x=-2^{30}$.)
+
+@c
+void mp_n_arg (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ int z; /* auxiliary register */
+ int t; /* temporary storage */
+ int k; /* loop counter */
+ int octant; /* octant code */
+ int x = x_orig->data.val;
+ int y = y_orig->data.val;
+ if (x >= 0) {
+ octant = first_octant;
+ } else {
+ x = -x;
+ octant = first_octant + negate_x;
+ }
+ if (y < 0) {
+ y = -y;
+ octant = octant + negate_y;
+ }
+ if (x < y) {
+ t = y;
+ y = x;
+ x = t;
+ octant = octant + switch_x_and_y;
+ }
+ if (x == 0) {
+ mp_error(
+ mp,
+ "angle(0,0) is taken as zero",
+ "The 'angle' between two identical points is undefined. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ @.angle(0,0)...zero@>
+ ret->data.val = 0;
+ } else {
+ ret->type = mp_angle_type;
+ @<Set variable |z| to the arg of $(x,y)$@>
+ @<Return an appropriate answer based on |z| and |octant|@>
+ }
+}
+
+@ @<Return an appropriate answer...@>=
+switch (octant) {
+ case first_octant: ret->data.val = z; break;
+ case second_octant: ret->data.val = -z + ninety_deg; break;
+ case third_octant: ret->data.val = z + ninety_deg; break;
+ case fourth_octant: ret->data.val = -z + one_eighty_deg; break;
+ case fifth_octant: ret->data.val = z - one_eighty_deg; break;
+ case sixth_octant: ret->data.val = -z - ninety_deg; break;
+ case seventh_octant: ret->data.val = z - ninety_deg; break;
+ case eighth_octant: ret->data.val = -z; break;
+}
+
+@ At this point we have |x>=y>=0|, and |x>0|. The numbers are scaled up or down
+until $2^{28}\L x<2^{29}$, so that accurate fixed-point calculations will be
+made.
+
+@<Set variable |z| to the arg...@>=
+while (x >= fraction_two) {
+ x = x/2;
+ y = y/2;
+}
+z = 0;
+if (y > 0) {
+ while (x < fraction_one) {
+ x += x;
+ y += y;
+ };
+ @<Increase |z| to the arg of $(x,y)$@>
+}
+
+@ During the calculations of this section, variables |x| and~|y| represent actual
+coordinates $(x,2^{-k}y)$. We will maintain the condition |x>=y|, so that the
+tangent will be at most $2^{-k}$. If $x<2y$, the tangent is greater than
+$2^{-k-1}$. The transformation $(a,b)\mapsto(a+b\tan\phi,b-a\tan\phi)$ replaces
+$(a,b)$ by coordinates whose angle has decreased by~$\phi$; in the special case
+$a=x$, $b=2^{-k}y$, and $\tan\phi=2^{-k-1}$, this operation reduces to the
+particularly simple iteration shown here. [Cf.~John E. Meggitt, @^Meggitt, John
+E.@> {\sl IBM Journal of Research and Development \bf6} (1962), 210--226.]
+
+The initial value of |x| will be multiplied by at most
+$(1+{1\over2})(1+{1\over8})(1+{1\over32})\cdots\approx 1.7584$; hence there is no
+chance of integer overflow.
+
+@<Increase |z|...@>=
+k = 0;
+do {
+ y += y;
+ k++;
+ if (y > x) {
+ z = z + mp_m_spec_atan[k];
+ t = x;
+ x = x + (y / two_to_the(k + k));
+ y = y - t;
+ };
+} while (k != 15);
+do {
+ y += y;
+ k++;
+ if (y > x) {
+ z = z + mp_m_spec_atan[k];
+ y = y - x;
+ };
+} while (k != 26);
+
+@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine and
+cosine of that angle. The results of this routine are stored in global integer
+variables |n_sin| and |n_cos|.
+
+@ Given an integer |z| that is $2^{20}$ times an angle $\theta$ in degrees, the
+purpose of |n_sin_cos(z)| is to set |x=@t$r\cos\theta$@>| and
+|y=@t$r\sin\theta$@>| (approximately), for some rather large number~|r|. The
+maximum of |x| and |y| will be between $2^{28}$ and $2^{30}$, so that there will
+be hardly any loss of accuracy. Then |x| and~|y| are divided by~|r|.
+
+@ Compute a multiple of the sine and cosine
+
+@c
+void mp_n_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin)
+{
+ int k; /* loop control variable */
+ int q; /* specifies the quadrant */
+ int x, y, t; /* temporary registers */
+ int z = z_orig->data.val; /* scaled */
+ mp_number x_n, y_n, ret;
+ mp_allocate_number(mp, &ret, mp_scaled_type);
+ mp_allocate_number(mp, &x_n, mp_scaled_type);
+ mp_allocate_number(mp, &y_n, mp_scaled_type);
+ while (z < 0) {
+ z = z + three_sixty_deg;
+ }
+ z = z % three_sixty_deg;
+ /* now |0<=z<three_sixty_deg| */
+ q = z / forty_five_deg;
+ z = z % forty_five_deg;
+ x = fraction_one;
+ y = x;
+ if (! odd(q)) {
+ z = forty_five_deg - z;
+ }
+ @<Subtract angle |z| from |(x,y)|@>
+ @<Convert |(x,y)| to the octant determined by~|q|@>
+ x_n.data.val = x;
+ y_n.data.val = y;
+ mp_pyth_add(mp, &ret, &x_n, &y_n);
+ n_cos->data.val = mp_make_fraction(mp, x, ret.data.val);
+ n_sin->data.val = mp_make_fraction(mp, y, ret.data.val);
+ mp_free_number(mp, &ret);
+ mp_free_number(mp, &x_n);
+ mp_free_number(mp, &y_n);
+}
+
+@ In this case the octants are numbered sequentially.
+
+@<Convert |(x,...@>=
+switch (q) {
+ case 0: break;
+ case 1: t = x; x = y; y = t; break;
+ case 2: t = x; x = -y; y = t; break;
+ case 3: x = -x; break;
+ case 4: x = -x; y = -y; break;
+ case 5: t = x; x = -y; y = -t; break;
+ case 6: t = x; x = y; y = -t; break;
+ case 7: y = -y; break;
+}
+
+@ The main iteration of |n_sin_cos| is similar to that of |n_arg| but
+applied in reverse. The values of |mp_m_spec_atan[k]| decrease slowly enough
+that this loop is guaranteed to terminate before the (nonexistent) value
+|mp_m_spec_atan[27]| would be required.
+
+@<Subtract angle |z|...@>=
+k = 1;
+while (z > 0) {
+ if (z >= mp_m_spec_atan[k]) {
+ z = z - mp_m_spec_atan[k];
+ t = x;
+ x = t + y / two_to_the(k);
+ y = y - t / two_to_the(k);
+ }
+ k++;
+}
+if (y < 0) {
+ /* this precaution may never be needed */
+ y = 0;
+}
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@c
+void mp_init_randoms (MP mp, int seed)
+{
+ int k = 1; /* more or less random integers */
+ int j = abs(seed);
+ while (j >= fraction_one) {
+ j = j/2;
+ }
+ for (int i = 0; i <= 54; i++) {
+ int jj = k;
+ k = j - k;
+ j = jj;
+ if (k < 0) {
+ k += fraction_one;
+ }
+ mp->randoms[(i * 21) % 55].data.val = j;
+ }
+ /* \quote {warm up} the array */
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+}
+
+@ @c
+void mp_print_number (MP mp, mp_number *n)
+{
+ mp_print_e_str(mp, mp_string_scaled(mp, n->data.val));
+}
+
+@ @c
+char *mp_number_tostring (MP mp, mp_number *n)
+{
+ return mp_string_scaled(mp, n->data.val);
+}
+
+@ @c
+void mp_number_modulo(mp_number *a, mp_number *b)
+{
+ a->data.val = a->data.val % b->data.val;
+}
+
+@ To consume a random fraction, the program below will say |next_random|.
+
+@c
+static void mp_next_random (MP mp, mp_number *ret)
+{
+ if ( mp->j_random == 0) {
+ mp_new_randoms(mp);
+ } else {
+ mp->j_random = mp->j_random-1;
+ }
+ mp_number_clone(ret, &(mp->randoms[mp->j_random]));
+}
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x| or
+|0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x| with
+about half the probability that it will produce any other particular values
+between 0 and~|x|, because it rounds its answers.
+
+@c
+static void mp_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ mp_number x, abs_x, u, y; /* |y| is trial value */
+ mp_allocate_number(mp, &y, mp_fraction_type);
+ mp_allocate_clone(mp, &x, mp_scaled_type, x_orig);
+ mp_allocate_abs(mp, &abs_x, mp_scaled_type, &x);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_next_random(mp, &u);
+ /*|take_fraction (y, abs_x, u);|*/
+ mp_number_take_fraction(mp, &y, &abs_x, &u);
+ if (mp_number_equal(&y, &abs_x)) {
+ /*|set_number_to_zero(*ret);|*/
+ mp_number_clone(ret, &((math_data *)mp->math)->md_zero_t);
+ } else if (mp_number_greater(&x, &((math_data *)mp->math)->md_zero_t)) {
+ mp_number_clone(ret, &y);
+ } else {
+ mp_number_clone(ret, &y);
+ mp_number_negate(ret);
+ }
+ mp_free_number(mp, &y);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &x);
+ mp_free_number(mp, &u);
+}
+
+@ Finally, a normal deviate with mean zero and unit standard deviation can
+readily be obtained with the ratio method (Algorithm 3.4.1R in {\sl The Art of
+Computer Programming}).
+
+@c
+static void mp_m_norm_rand (MP mp, mp_number *ret)
+{
+ mp_number abs_x, u, r, la, xa;
+ mp_allocate_number(mp, &la, mp_scaled_type);
+ mp_allocate_number(mp, &xa, mp_scaled_type);
+ mp_allocate_number(mp, &abs_x, mp_scaled_type);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_allocate_number(mp, &r, mp_scaled_type);
+ do {
+ do {
+ mp_number v;
+ mp_allocate_number(mp, &v, mp_scaled_type);
+ mp_next_random(mp, &v);
+ mp_number_subtract(&v, &((math_data *)mp->math)->md_fraction_half_t);
+ mp_number_take_fraction(mp, &xa, &((math_data *)mp->math)->md_sqrt_8_e_k, &v);
+ mp_free_number(mp, &v);
+ mp_next_random(mp, &u);
+ mp_number_clone(&abs_x, &xa);
+ mp_number_abs(&abs_x);
+ } while (! mp_number_less(&abs_x, &u));
+ mp_number_make_fraction(mp, &r, &xa, &u);
+ mp_number_clone(&xa, &r);
+ mp_m_log(mp, &la, &u);
+ mp_set_number_from_subtraction(&la, &((math_data *)mp->math)->md_twelve_ln_2_k, &la);
+ } while (mp_ab_vs_cd(&((math_data *)mp->math)->md_one_k, &la, &xa, &xa) < 0);
+ mp_number_clone(ret, &xa);
+ mp_free_number(mp, &r);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &la);
+ mp_free_number(mp, &xa);
+ mp_free_number(mp, &u);
+}
diff --git a/source/luametatex/source/mp/mpw/mpmathbinary.w b/source/luametatex/source/mp/mpw/mpmathbinary.w
new file mode 100644
index 000000000..0fb3c0a5d
--- /dev/null
+++ b/source/luametatex/source/mp/mpw/mpmathbinary.w
@@ -0,0 +1,27 @@
+% This file is part of MetaPost. The MetaPost program is in the public domain.
+
+@ @(mpmathbinary.h@>=
+# ifndef MPMATHBINARY_H
+# define MPMATHBINARY_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_binary_math (MP mp);
+
+# endif
+
+@ @c
+# include <stdio.h>
+
+@ @c
+# include "mpconfig.h"
+# include "mpmathbinary.h"
+
+extern void tex_normal_warning (const char *t, const char *p);
+
+math_data *mp_initialize_binary_math (MP mp)
+{
+ (void) (mp);
+ tex_normal_warning("mplib", "binary mode is not available.");
+ return NULL;
+}
diff --git a/source/luametatex/source/mp/mpw/mpmathdecimal.w b/source/luametatex/source/mp/mpw/mpmathdecimal.w
new file mode 100644
index 000000000..7854a4ff5
--- /dev/null
+++ b/source/luametatex/source/mp/mpw/mpmathdecimal.w
@@ -0,0 +1,1971 @@
+% This file is part of MetaPost. The MetaPost program is in the public domain.
+
+@ Introduction.
+
+@c
+# include "mpconfig.h"
+# include "mpmathdecimal.h"
+
+# define DECNUMDIGITS 1000
+# include "decNumber.h"
+
+@h
+
+@ @c
+@<Declarations@>
+
+@ @(mpmathdecimal.h@>=
+# ifndef MPMATHDECIMAL_H
+# define MPMATHDECIMAL_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_decimal_math (MP mp);
+
+# endif
+
+@* Math initialization.
+
+First, here are some very important constants.
+
+@d E_STRING "2.7182818284590452353602874713526624977572470936999595749669676277240766303535"
+@d PI_STRING "3.1415926535897932384626433832795028841971693993751058209749445923078164062862"
+@d fraction_multiplier 4096
+@d angle_multiplier 16
+
+@d unity 1
+@d two 2
+@d three 3
+@d four 4
+@d half_unit 0.5
+@d three_quarter_unit 0.75
+@d coef_bound ((7.0/3.0)*fraction_multiplier) /* |fraction| approximation to 7/3 */
+@d fraction_threshold 0.04096 /* a |fraction| coefficient less than this is zeroed */
+@d half_fraction_threshold (fraction_threshold/2) /* half of |fraction_threshold| */
+@d scaled_threshold 0.000122 /* a |scaled| coefficient less than this is zeroed */
+@d half_scaled_threshold (scaled_threshold/2) /* half of |scaled_threshold| */
+@d near_zero_angle (0.0256*angle_multiplier) /* an angle of about 0.0256 */
+@d p_over_v_threshold 0x80000 /* TODO */
+@d equation_threshold 0.001
+@d epsilon pow(2.0,-173.0) /* almost "1E-52" */
+@d epsilonf pow(2.0,-52.0)
+@d EL_GORDO "1E1000000" /* the largest value that \MP\ likes. */
+@d negative_EL_GORDO "-1E1000000" /* the largest value that \MP\ likes. */
+@d warning_limit "1E1000000" /* this is a large value that can just be expressed without loss of precision */
+
+@d DECPRECISION_DEFAULT 34
+@d FACTORIALS_CACHESIZE 50
+
+@d too_precise(a) (a == (DEC_Inexact+DEC_Rounded))
+@d too_large(a) (a & DEC_Overflow)
+
+@d fraction_half (fraction_multiplier/2)
+@d fraction_one (1*fraction_multiplier)
+@d fraction_two (2*fraction_multiplier)
+@d fraction_three (3*fraction_multiplier)
+@d fraction_four (4*fraction_multiplier)
+
+@d no_crossing mp_decimal_data.fraction_one_plus_decNumber
+@d one_crossing mp_decimal_data.fraction_one_decNumber
+@d zero_crossing mp_decimal_data.zero
+
+@d odd(A) (abs(A) % 2 == 1)
+@d set_cur_cmd(A) mp->cur_mod_->type = (A)
+@d set_cur_mod(A) decNumberCopy((decNumber *) (mp->cur_mod_->data.n.data.num), A)
+
+@ This one saves some typing and also looks better:
+
+@d decNumberIsPositive(A) (! (decNumberIsZero(A) || decNumberIsNegative(A)))
+
+@ Here are the functions that are static as they are not used elsewhere.
+
+@<Declarations@>=
+static int mp_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_double (MP mp, mp_number *n, double v);
+static void mp_allocate_number (MP mp, mp_number *n, mp_number_type t);
+static void mp_decnumber_check (MP mp, decNumber *dec, decContext *context);
+static void mp_decimal_abs (mp_number *A);
+static void mp_decimal_crossing_point (MP mp, mp_number *ret, mp_number *a, mp_number *b, mp_number *c);
+static void mp_decimal_fraction_to_round_scaled (mp_number *x);
+static void mp_decimal_m_exp (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_decimal_m_log (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_decimal_m_norm_rand (MP mp, mp_number *ret);
+static void mp_decimal_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig);
+void mp_decimal_make_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q);
+static void mp_decimal_n_arg (MP mp, mp_number *ret, mp_number *x, mp_number *y);
+static void mp_decimal_number_make_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_number_make_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_number_modulo (mp_number *a, mp_number *b);
+static void mp_decimal_number_take_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_number_take_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_decimal_power_of (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_decimal_print_number (MP mp, mp_number *n);
+static void mp_decimal_pyth_add (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_decimal_pyth_sub (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_decimal_scan_fractional_token (MP mp, int n);
+static void mp_decimal_scan_numeric_token (MP mp, int n);
+static void mp_decimal_set_precision (MP mp);
+static void mp_decimal_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin);
+static void mp_decimal_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig);
+static void mp_decimal_square_rt (MP mp, mp_number *ret, mp_number *x_orig);
+void mp_decimal_take_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q);
+static void mp_decimal_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t);
+static void mp_free_decimal_math (MP mp);
+static void mp_free_number (MP mp, mp_number *n);
+static void mp_init_randoms (MP mp, int seed);
+static void mp_number_abs_clone (mp_number *A, mp_number *B);
+static void mp_number_add (mp_number *A, mp_number *B);
+static void mp_number_add_scaled (mp_number *A, int B); /* also for negative B */
+static void mp_number_angle_to_scaled (mp_number *A);
+static void mp_number_clone (mp_number *A, mp_number *B);
+static void mp_number_divide_int (mp_number *A, int B);
+static void mp_number_double (mp_number *A);
+static int mp_number_equal (mp_number *A, mp_number *B);
+static void mp_number_floor (mp_number *i);
+static void mp_number_fraction_to_scaled (mp_number *A);
+static int mp_number_greater (mp_number *A, mp_number *B);
+static void mp_number_half (mp_number *A);
+static int mp_number_less (mp_number *A, mp_number *B);
+static void mp_number_multiply_int (mp_number *A, int B);
+static void mp_number_negate (mp_number *A);
+static void mp_number_negated_clone (mp_number *A, mp_number *B);
+static int mp_number_nonequalabs (mp_number *A, mp_number *B);
+static int mp_number_odd (mp_number *A);
+static void mp_number_scaled_to_angle (mp_number *A);
+static void mp_number_scaled_to_fraction (mp_number *A);
+static void mp_number_subtract (mp_number *A, mp_number *B);
+static void mp_number_swap (mp_number *A, mp_number *B);
+static int mp_number_to_boolean (mp_number *A);
+static double mp_number_to_double (mp_number *A);
+static int mp_number_to_int (mp_number *A);
+static int mp_number_to_scaled (mp_number *A);
+static int mp_round_unscaled (mp_number *x_orig);
+static void mp_set_decimal_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_boolean (mp_number *A, int B);
+static void mp_set_decimal_from_div (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_double (mp_number *A, double B);
+static void mp_set_decimal_from_int (mp_number *A, int B);
+static void mp_set_decimal_from_int_div (mp_number *A, mp_number *B, int C);
+static void mp_set_decimal_from_int_mul (mp_number *A, mp_number *B, int C);
+static void mp_set_decimal_from_mul (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+static void mp_set_decimal_from_scaled (mp_number *A, int B);
+static void mp_set_decimal_from_subtraction (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_half_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_decimal_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C);
+static void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop);
+static char *mp_decimal_number_tostring (MP mp, mp_number *n);
+static char *mp_decnumber_tostring (decNumber *n);
+
+@ We do not want special numbers as return values for functions, so:
+
+@c
+void mp_decnumber_check(MP mp, decNumber *dec, decContext *context)
+{
+ int test = 0;
+ (void) mp;
+ if (context->status & DEC_Overflow) {
+ test = 1;
+ context->status &= ~DEC_Overflow;
+ }
+ if (context->status & DEC_Underflow) {
+ test = 1;
+ context->status &= ~DEC_Underflow;
+ }
+ if (context->status & DEC_Errors) {
+ test = 1;
+ decNumberZero(dec);
+ }
+ context->status = 0;
+ if (decNumberIsSpecial(dec)) {
+ test = 1;
+ if (decNumberIsInfinite(dec)) {
+ if (decNumberIsNegative(dec)) {
+ decNumberCopyNegate(dec, &mp_decimal_data.EL_GORDO_decNumber);
+ } else {
+ decNumberCopy(dec, &mp_decimal_data.EL_GORDO_decNumber);
+ }
+ } else {
+ /* Nan */
+ decNumberZero(dec);
+ }
+ }
+ if (decNumberIsZero(dec) && decNumberIsNegative(dec)) {
+ decNumberZero(dec);
+ }
+ mp->arith_error = test;
+}
+
+@<Declarations@>=
+typedef struct mp_decimal_info {
+ decContext set;
+ decContext limitedset;
+ decNumber zero;
+ decNumber one;
+ decNumber minusone;
+ decNumber two_decNumber;
+ decNumber three_decNumber;
+ decNumber four_decNumber;
+ decNumber fraction_multiplier_decNumber;
+ decNumber angle_multiplier_decNumber;
+ decNumber fraction_one_decNumber;
+ decNumber fraction_one_plus_decNumber;
+ decNumber PI_decNumber;
+ decNumber epsilon_decNumber;
+ decNumber EL_GORDO_decNumber;
+ decNumber negative_EL_GORDO_decNumber;
+ decNumber **factorials;
+ int last_cached_factorial;
+ int initialized;
+} mp_decimal_info;
+
+mp_decimal_info mp_decimal_data = {
+ .factorials = NULL,
+ .last_cached_factorial = 0,
+ .initialized = 0,
+};
+
+static void checkZero(decNumber *ret)
+{
+ if (decNumberIsZero(ret) && decNumberIsNegative(ret)) {
+ decNumberZero(ret);
+ }
+}
+
+static int decNumberLess(decNumber *a, decNumber *b)
+{
+ decNumber comp;
+ decNumberCompare(&comp, a, b, &mp_decimal_data.set);
+ return decNumberIsNegative(&comp);
+}
+
+static int decNumberGreater(decNumber *a, decNumber *b)
+{
+ decNumber comp;
+ decNumberCompare(&comp, a, b, &mp_decimal_data.set);
+ return decNumberIsPositive(&comp);
+}
+
+static void decNumberFromDouble(decNumber *A, double B)
+{
+ char buffer[1000];
+ char *c = buffer;
+ snprintf(buffer, 1000, "%-650.325lf", B);
+ while (*c++) {
+ if (*c == ' ') {
+ *c = '\0';
+ break;
+ }
+ }
+ decNumberFromString(A, buffer, &mp_decimal_data.set);
+}
+
+static double decNumberToDouble(decNumber *A)
+{
+ char *buffer = mp_memory_allocate(A->digits + 14);
+ double res = 0.0;
+ decNumberToString(A, buffer);
+ if (sscanf(buffer, "%lf", &res)) {
+ mp_memory_free(buffer);
+ return res;
+ } else {
+ mp_memory_free(buffer);
+ /* |mp->arith_error = 1;| */
+ return 0.0;
+ }
+}
+
+@ Borrowed code from libdfp:
+
+$$ \arctan(x) = x - \frac {x^3}{3} + \frac {x^5{5} - \frac {x^7}{7} + \ldots$$
+
+This power series works well, if $x$ is close to zero ($|x|<0.5$). If x is
+larger, the series converges too slowly, so in order to get a smaller x, we apply
+the identity
+
+$$ \arctan(x) = 2 \arctan \left (\frac {\sqrt{1 + x^2}-1} {x} \right) $$
+
+twice. The first application gives us a new $x$ with $x < 1$. The second
+application gives us a new x with $x < 0.4142136$. For that $x$, we use the power
+series and multiply the result by four.
+
+@c
+static void decNumberAtan(decNumber *result, decNumber *x_orig, decContext *localset)
+{
+ decNumber x;
+ decNumberCopy(&x, x_orig);
+ if (decNumberIsZero(&x)) {
+ decNumberCopy(result, &x);
+ } else {
+ decNumber f, g, mx2, term;
+ for (int i = 0; i<2; i++) {
+ decNumber y;
+ decNumberMultiply(&y, &x, &x, localset); /* $ y = x^2 $ */
+ decNumberAdd(&y, &y, &mp_decimal_data.one, localset); /* $ y = y + 1 $ */
+ decNumberSquareRoot(&y, &y, localset); /* $ y = sqrt(y) $ */
+ decNumberSubtract(&y, &y, &mp_decimal_data.one, localset); /* $ y = y - 1 $ */
+ decNumberDivide(&x, &y, &x, localset); /* $ x = y / x $ */
+ if (decNumberIsZero(&x)) {
+ decNumberCopy(result, &x);
+ return;
+ }
+ }
+ decNumberCopy(&f, &x); /* $ f(0) = x $ */
+ decNumberCopy(&g, &mp_decimal_data.one); /* $ g(0) = 1 $ */
+ decNumberCopy(&term, &x); /* $ term = x $ */
+ decNumberCopy(result, &x); /* $ sum = x $ */
+ decNumberMultiply(&mx2, &x, &x, localset); /* $ mx2 = x^2 $ */
+ decNumberMinus (&mx2, &mx2, localset); /* $ mx2 = -x^2 $ */
+ for (int i = 0; i < 2 * localset->digits; i++) {
+ decNumberMultiply(&f, &f, &mx2, localset);
+ decNumberAdd(&g, &g, &mp_decimal_data.two_decNumber, localset);
+ decNumberDivide(&term, &f, &g, localset);
+ decNumberAdd(result, result, &term, localset);
+ }
+ decNumberAdd(result, result, result, localset);
+ decNumberAdd(result, result, result, localset);
+ }
+}
+
+static void decNumberAtan2(decNumber *result, decNumber *y, decNumber *x, decContext *localset)
+{
+ if (! decNumberIsInfinite(x) && ! decNumberIsZero(y) && ! decNumberIsInfinite(y) && ! decNumberIsZero(x)) {
+ decNumber temp;
+ decNumberDivide(&temp, y, x, localset);
+ decNumberAtan(result, &temp, localset);
+ /*
+ decNumberAtan doesn't quite return the values in the ranges we
+ want for x < 0. So we need to do some correction
+ */
+ if (decNumberIsNegative(x)) {
+ if (decNumberIsNegative(y)) {
+ decNumberSubtract(result, result, &mp_decimal_data.PI_decNumber, localset);
+ } else {
+ decNumberAdd(result, result, &mp_decimal_data.PI_decNumber, localset);
+ }
+ }
+ } else {
+ if (decNumberIsInfinite(y) && decNumberIsInfinite(x)) {
+ /* If x and y are both inf, the result depends on the sign of x */
+ decNumberDivide(result, &mp_decimal_data.PI_decNumber, &mp_decimal_data.four_decNumber, localset);
+ if (decNumberIsNegative(x) ) {
+ decNumber a;
+ decNumberFromDouble(&a, 3.0);
+ decNumberMultiply(result, result, &a, localset);
+ }
+ } else if (!decNumberIsZero(y) && !decNumberIsInfinite(x) ) {
+ /* If y is non-zero and x is non-inf, the result is +-pi/2 */
+ decNumberDivide(result, &mp_decimal_data.PI_decNumber, &mp_decimal_data.two_decNumber, localset);
+ } else {
+ /* Otherwise it is +0 if x is positive, +pi if x is neg */
+ if (decNumberIsNegative(x)) {
+ decNumberCopy(result, &mp_decimal_data.PI_decNumber);
+ } else {
+ decNumberZero(result);
+ }
+ }
+ /* Atan2 will be negative if y < 0 */
+ if (decNumberIsNegative(y)) {
+ decNumberMinus(result, result, localset);
+ }
+ }
+}
+
+@ @c
+math_data *mp_initialize_decimal_math (MP mp)
+{
+ math_data *math = (math_data *) mp_memory_allocate(sizeof(math_data));
+ decContextDefault(&mp_decimal_data.set, DEC_INIT_BASE); /* initialize */
+ mp_decimal_data.set.traps = 0; /* no traps, thank you */
+ decContextDefault(&mp_decimal_data.limitedset, DEC_INIT_BASE); /* initialize */
+ mp_decimal_data.limitedset.traps = 0; /* no traps, thank you */
+ mp_decimal_data.limitedset.emax = 999999;
+ mp_decimal_data.limitedset.emin = -999999;
+ mp_decimal_data.set.digits = DECPRECISION_DEFAULT;
+ mp_decimal_data.limitedset.digits = DECPRECISION_DEFAULT;
+ if (! mp_decimal_data.initialized) {
+ mp_decimal_data.initialized = 1 ;
+ decNumberFromInt32(&mp_decimal_data.one, 1);
+ decNumberFromInt32(&mp_decimal_data.minusone, -1);
+ decNumberFromInt32(&mp_decimal_data.zero, 0);
+ decNumberFromInt32(&mp_decimal_data.two_decNumber, two);
+ decNumberFromInt32(&mp_decimal_data.three_decNumber, three);
+ decNumberFromInt32(&mp_decimal_data.four_decNumber, four);
+ decNumberFromInt32(&mp_decimal_data.fraction_multiplier_decNumber, fraction_multiplier);
+ decNumberFromInt32(&mp_decimal_data.fraction_one_decNumber, fraction_one);
+ decNumberFromInt32(&mp_decimal_data.fraction_one_plus_decNumber, (fraction_one+1));
+ decNumberFromInt32(&mp_decimal_data.angle_multiplier_decNumber, angle_multiplier);
+ decNumberFromString(&mp_decimal_data.PI_decNumber, PI_STRING, &mp_decimal_data.set);
+ decNumberFromDouble(&mp_decimal_data.epsilon_decNumber, epsilon);
+ decNumberFromString(&mp_decimal_data.EL_GORDO_decNumber, EL_GORDO, &mp_decimal_data.set);
+ decNumberFromString(&mp_decimal_data.negative_EL_GORDO_decNumber, negative_EL_GORDO, &mp_decimal_data.set);
+ mp_decimal_data.factorials = (decNumber **) mp_memory_allocate(FACTORIALS_CACHESIZE * sizeof(decNumber *));
+ mp_decimal_data.factorials[0] = (decNumber *) mp_memory_allocate(sizeof(decNumber));
+ decNumberCopy(mp_decimal_data.factorials[0], &mp_decimal_data.one);
+ }
+ math->md_allocate = mp_allocate_number;
+ math->md_free = mp_free_number;
+ math->md_allocate_clone = mp_allocate_clone;
+ math->md_allocate_abs = mp_allocate_abs;
+ math->md_allocate_double = mp_allocate_double;
+ mp_allocate_number(mp, &math->md_precision_default, mp_scaled_type);
+ decNumberFromInt32( math->md_precision_default.data.num, DECPRECISION_DEFAULT);
+ mp_allocate_number(mp, &math->md_precision_max, mp_scaled_type);
+ decNumberFromInt32( math->md_precision_max.data.num, DECNUMDIGITS);
+ mp_allocate_number(mp, &math->md_precision_min, mp_scaled_type);
+ decNumberFromInt32( math->md_precision_min.data.num, 2);
+ /* here are the constants for scaled objects */
+ mp_allocate_number(mp, &math->md_epsilon_t, mp_scaled_type);
+ decNumberCopy( math->md_epsilon_t.data.num, &mp_decimal_data.epsilon_decNumber);
+ mp_allocate_number(mp, &math->md_inf_t, mp_scaled_type);
+ decNumberCopy( math->md_inf_t.data.num, &mp_decimal_data.EL_GORDO_decNumber);
+ mp_allocate_number(mp, &math->md_negative_inf_t, mp_scaled_type);
+ decNumberCopy( math->md_negative_inf_t.data.num, &mp_decimal_data.negative_EL_GORDO_decNumber);
+ mp_allocate_number(mp, &math->md_warning_limit_t, mp_scaled_type);
+ decNumberFromString( math->md_warning_limit_t.data.num, warning_limit, &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_one_third_inf_t, mp_scaled_type);
+ decNumberDivide( math->md_one_third_inf_t.data.num, math->md_inf_t.data.num, &mp_decimal_data.three_decNumber, &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_unity_t, mp_scaled_type);
+ decNumberCopy( math->md_unity_t.data.num, &mp_decimal_data.one);
+ mp_allocate_number(mp, &math->md_two_t, mp_scaled_type);
+ decNumberFromInt32( math->md_two_t.data.num, two);
+ mp_allocate_number(mp, &math->md_three_t, mp_scaled_type);
+ decNumberFromInt32( math->md_three_t.data.num, three);
+ mp_allocate_number(mp, &math->md_half_unit_t, mp_scaled_type);
+ decNumberFromString( math->md_half_unit_t.data.num, "0.5", &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_three_quarter_unit_t, mp_scaled_type);
+ decNumberFromString( math->md_three_quarter_unit_t.data.num, "0.75", &mp_decimal_data.set);
+ mp_allocate_number(mp, &math->md_zero_t, mp_scaled_type);
+ decNumberZero( math->md_zero_t.data.num);
+ /* fractions */
+ {
+ decNumber fourzeroninesix;
+ decNumberFromInt32(&fourzeroninesix, 4096);
+ mp_allocate_number(mp, &math->md_arc_tol_k, mp_fraction_type);
+ decNumberDivide( math->md_arc_tol_k.data.num, &mp_decimal_data.one, &fourzeroninesix, &mp_decimal_data.set); /* quit when change in arc length estimate reaches this */
+ }
+ mp_allocate_number(mp, &math->md_fraction_one_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_one_t.data.num, fraction_one);
+ mp_allocate_number(mp, &math->md_fraction_half_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_half_t.data.num, fraction_half);
+ mp_allocate_number(mp, &math->md_fraction_three_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_three_t.data.num, fraction_three);
+ mp_allocate_number(mp, &math->md_fraction_four_t, mp_fraction_type);
+ decNumberFromInt32( math->md_fraction_four_t.data.num, fraction_four);
+ /* angles */
+ mp_allocate_number(mp, &math->md_three_sixty_deg_t, mp_angle_type);
+ decNumberFromInt32( math->md_three_sixty_deg_t.data.num, 360 * angle_multiplier);
+ mp_allocate_number(mp, &math->md_one_eighty_deg_t, mp_angle_type);
+ decNumberFromInt32( math->md_one_eighty_deg_t.data.num, 180 * angle_multiplier);
+ mp_allocate_number(mp, &math->md_negative_one_eighty_deg_t, mp_angle_type);
+ decNumberFromInt32( math->md_negative_one_eighty_deg_t.data.num, -180 * angle_multiplier);
+ /* various approximations */
+ mp_allocate_number(mp, &math->md_one_k, mp_scaled_type);
+ decNumberFromDouble( math->md_one_k.data.num, 1.0/64);
+ mp_allocate_number(mp, &math->md_sqrt_8_e_k, mp_scaled_type);
+ decNumberFromDouble( math->md_sqrt_8_e_k.data.num, 112428.82793 / 65536.0); /* $2^{16}\sqrt{8/e}\approx 112428.82793$ */
+ mp_allocate_number(mp, &math->md_twelve_ln_2_k, mp_fraction_type);
+ decNumberFromDouble( math->md_twelve_ln_2_k.data.num, 139548959.6165 / 65536.0); /* $2^{24}\cdot12\ln2\approx139548959.6165$ */
+ mp_allocate_number(mp, &math->md_coef_bound_k, mp_fraction_type);
+ decNumberFromDouble( math->md_coef_bound_k.data.num,coef_bound);
+ mp_allocate_number(mp, &math->md_coef_bound_minus_1, mp_fraction_type);
+ decNumberFromDouble( math->md_coef_bound_minus_1.data.num,coef_bound - 1 / 65536.0);
+ mp_allocate_number(mp, &math->md_twelvebits_3, mp_scaled_type);
+ decNumberFromDouble( math->md_twelvebits_3.data.num, 1365 / 65536.0); /* $1365\approx 2^{12}/3$ */
+ mp_allocate_number(mp, &math->md_twentysixbits_sqrt2_t, mp_fraction_type);
+ decNumberFromDouble( math->md_twentysixbits_sqrt2_t.data.num, 94906265.62 / 65536.0); /* $2^{26}\sqrt2\approx94906265.62$ */
+ mp_allocate_number(mp, &math->md_twentyeightbits_d_t, mp_fraction_type);
+ decNumberFromDouble( math->md_twentyeightbits_d_t.data.num, 35596754.69 / 65536.0); /* $2^{28}d\approx35596754.69$ */
+ mp_allocate_number(mp, &math->md_twentysevenbits_sqrt2_d_t, mp_fraction_type);
+ decNumberFromDouble( math->md_twentysevenbits_sqrt2_d_t.data.num, 25170706.63 / 65536.0); /* $2^{27}\sqrt2\,d\approx25170706.63$ */
+ /* thresholds */
+ mp_allocate_number(mp, &math->md_fraction_threshold_t, mp_fraction_type);
+ decNumberFromDouble( math->md_fraction_threshold_t.data.num, fraction_threshold);
+ mp_allocate_number(mp, &math->md_half_fraction_threshold_t, mp_fraction_type);
+ decNumberFromDouble( math->md_half_fraction_threshold_t.data.num, half_fraction_threshold);
+ mp_allocate_number(mp, &math->md_scaled_threshold_t, mp_scaled_type);
+ decNumberFromDouble( math->md_scaled_threshold_t.data.num, scaled_threshold);
+ mp_allocate_number(mp, &math->md_half_scaled_threshold_t, mp_scaled_type);
+ decNumberFromDouble( math->md_half_scaled_threshold_t.data.num, half_scaled_threshold);
+ mp_allocate_number(mp, &math->md_near_zero_angle_t, mp_angle_type);
+ decNumberFromDouble( math->md_near_zero_angle_t.data.num, near_zero_angle);
+ mp_allocate_number(mp, &math->md_p_over_v_threshold_t, mp_fraction_type);
+ decNumberFromDouble( math->md_p_over_v_threshold_t.data.num, p_over_v_threshold);
+ mp_allocate_number(mp, &math->md_equation_threshold_t, mp_scaled_type);
+ decNumberFromDouble( math->md_equation_threshold_t.data.num, equation_threshold);
+ /* functions */
+ math->md_from_int = mp_set_decimal_from_int;
+ math->md_from_boolean = mp_set_decimal_from_boolean;
+ math->md_from_scaled = mp_set_decimal_from_scaled;
+ math->md_from_double = mp_set_decimal_from_double;
+ math->md_from_addition = mp_set_decimal_from_addition;
+ math->md_half_from_addition = mp_set_decimal_half_from_addition;
+ math->md_from_subtraction = mp_set_decimal_from_subtraction;
+ math->md_half_from_subtraction = mp_set_decimal_half_from_subtraction;
+ math->md_from_oftheway = mp_set_decimal_from_of_the_way;
+ math->md_from_div = mp_set_decimal_from_div;
+ math->md_from_mul = mp_set_decimal_from_mul;
+ math->md_from_int_div = mp_set_decimal_from_int_div;
+ math->md_from_int_mul = mp_set_decimal_from_int_mul;
+ math->md_negate = mp_number_negate;
+ math->md_add = mp_number_add;
+ math->md_subtract = mp_number_subtract;
+ math->md_half = mp_number_half;
+ math->md_do_double = mp_number_double;
+ math->md_abs = mp_decimal_abs;
+ math->md_clone = mp_number_clone;
+ math->md_negated_clone = mp_number_negated_clone;
+ math->md_abs_clone = mp_number_abs_clone;
+ math->md_swap = mp_number_swap;
+ math->md_add_scaled = mp_number_add_scaled;
+ math->md_multiply_int = mp_number_multiply_int;
+ math->md_divide_int = mp_number_divide_int;
+ math->md_to_boolean = mp_number_to_boolean;
+ math->md_to_scaled = mp_number_to_scaled;
+ math->md_to_double = mp_number_to_double;
+ math->md_to_int = mp_number_to_int;
+ math->md_odd = mp_number_odd;
+ math->md_equal = mp_number_equal;
+ math->md_less = mp_number_less;
+ math->md_greater = mp_number_greater;
+ math->md_nonequalabs = mp_number_nonequalabs;
+ math->md_round_unscaled = mp_round_unscaled;
+ math->md_floor_scaled = mp_number_floor;
+ math->md_fraction_to_round_scaled = mp_decimal_fraction_to_round_scaled;
+ math->md_make_scaled = mp_decimal_number_make_scaled;
+ math->md_make_fraction = mp_decimal_number_make_fraction;
+ math->md_take_fraction = mp_decimal_number_take_fraction;
+ math->md_take_scaled = mp_decimal_number_take_scaled;
+ math->md_velocity = mp_decimal_velocity;
+ math->md_n_arg = mp_decimal_n_arg;
+ math->md_m_log = mp_decimal_m_log;
+ math->md_m_exp = mp_decimal_m_exp;
+ math->md_m_unif_rand = mp_decimal_m_unif_rand;
+ math->md_m_norm_rand = mp_decimal_m_norm_rand;
+ math->md_pyth_add = mp_decimal_pyth_add;
+ math->md_pyth_sub = mp_decimal_pyth_sub;
+ math->md_power_of = mp_decimal_power_of;
+ math->md_fraction_to_scaled = mp_number_fraction_to_scaled;
+ math->md_scaled_to_fraction = mp_number_scaled_to_fraction;
+ math->md_scaled_to_angle = mp_number_scaled_to_angle;
+ math->md_angle_to_scaled = mp_number_angle_to_scaled;
+ math->md_init_randoms = mp_init_randoms;
+ math->md_sin_cos = mp_decimal_sin_cos;
+ math->md_slow_add = mp_decimal_slow_add;
+ math->md_sqrt = mp_decimal_square_rt;
+ math->md_print = mp_decimal_print_number;
+ math->md_tostring = mp_decimal_number_tostring;
+ math->md_modulo = mp_decimal_number_modulo;
+ math->md_ab_vs_cd = mp_ab_vs_cd;
+ math->md_crossing_point = mp_decimal_crossing_point;
+ math->md_scan_numeric = mp_decimal_scan_numeric_token;
+ math->md_scan_fractional = mp_decimal_scan_fractional_token;
+ math->md_free_math = mp_free_decimal_math;
+ math->md_set_precision = mp_decimal_set_precision;
+ return math;
+}
+
+void mp_decimal_set_precision (MP mp)
+{
+ int i = decNumberToInt32((decNumber *) internal_value(mp_number_precision_internal).data.num, &mp_decimal_data.set);
+ mp_decimal_data.set.digits = i;
+ mp_decimal_data.limitedset.digits = i;
+}
+
+void mp_free_decimal_math (MP mp)
+{
+ mp_free_number(mp, &(mp->math->md_three_sixty_deg_t));
+ mp_free_number(mp, &(mp->math->md_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_negative_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_fraction_one_t));
+ mp_free_number(mp, &(mp->math->md_zero_t));
+ mp_free_number(mp, &(mp->math->md_half_unit_t));
+ mp_free_number(mp, &(mp->math->md_three_quarter_unit_t));
+ mp_free_number(mp, &(mp->math->md_unity_t));
+ mp_free_number(mp, &(mp->math->md_two_t));
+ mp_free_number(mp, &(mp->math->md_three_t));
+ mp_free_number(mp, &(mp->math->md_one_third_inf_t));
+ mp_free_number(mp, &(mp->math->md_inf_t));
+ mp_free_number(mp, &(mp->math->md_negative_inf_t));
+ mp_free_number(mp, &(mp->math->md_warning_limit_t));
+ mp_free_number(mp, &(mp->math->md_one_k));
+ mp_free_number(mp, &(mp->math->md_sqrt_8_e_k));
+ mp_free_number(mp, &(mp->math->md_twelve_ln_2_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_minus_1));
+ mp_free_number(mp, &(mp->math->md_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_near_zero_angle_t));
+ mp_free_number(mp, &(mp->math->md_p_over_v_threshold_t));
+ mp_free_number(mp, &(mp->math->md_equation_threshold_t));
+ /*
+ For sake of speed, we accept this memory leak:
+
+ for (i = 0; i <= mp_decimal_data.last_cached_factorial; i++) {
+ mp_memory_free(mp_decimal_data.factorials[i]);
+ }
+ mp_memory_free(mp_decimal_data.factorials);
+ */
+ mp_memory_free(mp->math);
+}
+
+@ Creating and destruction of |mp_number| objects. Let's hope that mimalloc keeps
+a pool for these.
+
+@ @c
+void mp_allocate_number (MP mp, mp_number *n, mp_number_type t)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = t;
+ decNumberZero(n->data.num);
+}
+
+@ @c
+void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = t;
+ decNumberZero(n->data.num);
+ decNumberCopy(n->data.num, v->data.num);
+}
+
+@ @c
+void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = t;
+ decNumberZero(n->data.num); /* not needed */
+ decNumberAbs(n->data.num, v->data.num, &mp_decimal_data.set);
+}
+
+void mp_allocate_double (MP mp, mp_number *n, double v)
+{
+ (void) mp;
+ n->data.num = mp_memory_allocate(sizeof(decNumber));
+ n->type = mp_scaled_type;
+ decNumberZero(n->data.num); /* not needed */
+ decNumberFromDouble(n->data.num, v);
+}
+
+@ @c
+void mp_free_number (MP mp, mp_number *n)
+{
+ (void) mp;
+ if (n->data.num) {
+ mp_memory_free(n->data.num);
+ n->data.num = NULL;
+ n->type = mp_nan_type;
+ }
+}
+
+@ Here are the low-level functions on |mp_number| items, setters first.
+
+@c
+void mp_set_decimal_from_int(mp_number *A, int B)
+{
+ decNumberFromInt32(A->data.num, B);
+}
+
+void mp_set_decimal_from_boolean(mp_number *A, int B)
+{
+ decNumberFromInt32(A->data.num, B);
+}
+
+void mp_set_decimal_from_scaled(mp_number *A, int B)
+{
+ decNumber c;
+ decNumberFromInt32(&c, 65536);
+ decNumberFromInt32(A->data.num,B);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_double(mp_number *A, double B)
+{
+ decNumberFromDouble(A->data.num, B);
+}
+
+void mp_set_decimal_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberAdd(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_half_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumber c;
+ decNumberAdd(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+ decNumberFromInt32(&c, 2);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberSubtract(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumber c;
+ decNumberSubtract(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+ decNumberFromInt32(&c, 2);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_div(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberDivide(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_mul(mp_number *A, mp_number *B, mp_number *C)
+{
+ decNumberMultiply(A->data.num, B->data.num, C->data.num, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_int_div(mp_number *A, mp_number *B, int C)
+{
+ decNumber c;
+ decNumberFromInt32(&c, C);
+ decNumberDivide(A->data.num, B->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_int_mul(mp_number *A, mp_number *B, int C)
+{
+ decNumber c;
+ decNumberFromInt32(&c, C);
+ decNumberMultiply(A->data.num, B->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_set_decimal_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C)
+{
+ decNumber c;
+ decNumber r1;
+ decNumberSubtract(&c, B->data.num, C->data.num, &mp_decimal_data.set);
+ mp_decimal_take_fraction(mp, &r1, &c, t->data.num);
+ decNumberSubtract(A->data.num, B->data.num, &r1, &mp_decimal_data.set);
+ mp_decnumber_check(mp, A->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_negate(mp_number *A)
+{
+ decNumberCopyNegate(A->data.num, A->data.num);
+ checkZero(A->data.num);
+}
+
+void mp_number_add(mp_number *A, mp_number *B)
+{
+ decNumberAdd(A->data.num, A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_subtract(mp_number *A, mp_number *B)
+{
+ decNumberSubtract(A->data.num, A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_half(mp_number *A)
+{
+ decNumber c;
+ decNumberFromInt32(&c, 2);
+ decNumberDivide(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_number_double(mp_number *A)
+{
+ decNumber c;
+ decNumberFromInt32(&c, 2);
+ decNumberMultiply(A->data.num, A->data.num, &c, &mp_decimal_data.set);
+}
+
+void mp_number_add_scaled(mp_number *A, int B)
+{
+ decNumber b, c;
+ decNumberFromInt32(&c, 65536);
+ decNumberFromInt32(&b, B);
+ decNumberDivide(&b, &b, &c, &mp_decimal_data.set);
+ decNumberAdd(A->data.num, A->data.num, &b, &mp_decimal_data.set);
+}
+
+void mp_number_multiply_int(mp_number *A, int B)
+{
+ decNumber b;
+ decNumberFromInt32(&b, B);
+ decNumberMultiply(A->data.num, A->data.num, &b, &mp_decimal_data.set);
+}
+
+void mp_number_divide_int(mp_number *A, int B)
+{
+ decNumber b;
+ decNumberFromInt32(&b, B);
+ decNumberDivide(A->data.num, A->data.num, &b, &mp_decimal_data.set);
+}
+
+void mp_decimal_abs(mp_number *A)
+{
+ decNumberAbs(A->data.num, A->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_clone(mp_number *A, mp_number *B)
+{
+ decNumberCopy(A->data.num, B->data.num);
+}
+
+void mp_number_negated_clone(mp_number *A, mp_number *B)
+{
+ decNumberCopyNegate(A->data.num, B->data.num);
+ checkZero(A->data.num);
+}
+
+void mp_number_abs_clone(mp_number *A, mp_number *B)
+{
+ decNumberAbs(A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+void mp_number_swap(mp_number *A, mp_number *B)
+{
+ decNumber swap_tmp;
+ decNumberCopy(&swap_tmp, A->data.num);
+ decNumberCopy(A->data.num, B->data.num);
+ decNumberCopy(B->data.num, &swap_tmp);
+}
+
+void mp_number_fraction_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ decNumberDivide(A->data.num, A->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_number_angle_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ decNumberDivide(A->data.num, A->data.num, &mp_decimal_data.angle_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_number_scaled_to_fraction(mp_number *A)
+{
+ A->type = mp_fraction_type;
+ decNumberMultiply(A->data.num, A->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_number_scaled_to_angle(mp_number *A)
+{
+ A->type = mp_angle_type;
+ decNumberMultiply(A->data.num, A->data.num, &mp_decimal_data.angle_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+@* Query functions.
+
+@ Convert a number to a scaled value. |decNumberToInt32| is not able to make this
+conversion properly, so instead we are using |decNumberToDouble| and a typecast.
+Bad!
+
+@c
+int mp_number_to_scaled(mp_number *A)
+{
+ int32_t result;
+ decNumber corrected;
+ decNumberFromInt32(&corrected, 65536);
+ decNumberMultiply(&corrected, &corrected, A->data.num, &mp_decimal_data.set);
+ decNumberReduce(&corrected, &corrected, &mp_decimal_data.set);
+ result = (int) floor(decNumberToDouble(&corrected) + 0.5);
+ return result;
+}
+
+@ @c
+int mp_number_to_int(mp_number *A)
+{
+ int32_t result;
+ mp_decimal_data.set.status = 0;
+ result = decNumberToInt32(A->data.num, &mp_decimal_data.set);
+ if (mp_decimal_data.set.status == DEC_Invalid_operation) {
+ mp_decimal_data.set.status = 0;
+ /* |mp->arith_error = 1;| */
+ return 0;
+ } else {
+ return result;
+ }
+}
+
+int mp_number_to_boolean(mp_number *A)
+{
+ uint32_t result;
+ mp_decimal_data.set.status = 0;
+ result = decNumberToUInt32(A->data.num, &mp_decimal_data.set);
+ if (mp_decimal_data.set.status == DEC_Invalid_operation) {
+ mp_decimal_data.set.status = 0;
+ /* |mp->arith_error = 1;| */
+ return mp_false_operation;
+ } else {
+ return result ;
+ }
+}
+
+double mp_number_to_double(mp_number *A)
+{
+ char *buffer = mp_memory_allocate((size_t) ((decNumber *) A->data.num)->digits + 14);
+ double res = 0.0;
+ decNumberToString(A->data.num, buffer);
+ if (sscanf(buffer, "%lf", &res)) {
+ mp_memory_free(buffer);
+ return res;
+ } else {
+ mp_memory_free(buffer);
+ /* |mp->arith_error = 1;| */
+ return 0.0;
+ }
+}
+
+int mp_number_odd(mp_number *A)
+{
+ decNumber r1, r2;
+ decNumberAbs(&r1, A->data.num, &mp_decimal_data.set);
+ decNumberRemainder(&r2, &r1, &mp_decimal_data.two_decNumber, &mp_decimal_data.set);
+ decNumberCompare(&r1, &r2, &mp_decimal_data.one, &mp_decimal_data.set);
+ return decNumberIsZero(&r1);
+}
+
+int mp_number_equal(mp_number *A, mp_number *B)
+{
+ decNumber res;
+ decNumberCompare(&res, A->data.num, B->data.num, &mp_decimal_data.set);
+ return decNumberIsZero(&res);
+}
+
+int mp_number_greater(mp_number *A, mp_number *B)
+{
+ decNumber res;
+ decNumberCompare(&res, A->data.num, B->data.num, &mp_decimal_data.set);
+ return decNumberIsPositive(&res);
+}
+
+int mp_number_less(mp_number *A, mp_number *B)
+{
+ decNumber res;
+ decNumberCompare(&res, A->data.num, B->data.num, &mp_decimal_data.set);
+ return decNumberIsNegative(&res);
+}
+
+int mp_number_nonequalabs(mp_number *A, mp_number *B)
+{
+ decNumber res, a, b;
+ decNumberCopyAbs(&a, A->data.num);
+ decNumberCopyAbs(&b, B->data.num);
+ decNumberCompare(&res, &a, &b, &mp_decimal_data.set);
+ return ! decNumberIsZero(&res);
+}
+
+@ Fixed-point arithmetic is done on {\sl scaled integers} that are multiples of
+$2^{-16}$. In other words, a binary point is assumed to be sixteen bit positions
+from the right end of a binary computer word.
+
+@ One of \MP's most common operations is the calculation of
+$\lfloor{a+b\over2}\rfloor$, the midpoint of two given integers |a| and~|b|. The
+most decent way to do this is to write |(a+b)/2|; but on many machines it is
+more efficient to calculate |(a+b)>>1|.
+
+Therefore the midpoint operation will always be denoted by |half(a+b)| in this
+program. If \MP\ is being implemented with languages that permit binary shifting,
+the |half| macro should be changed to make this operation as efficient as
+possible. Since some systems have shift operators that can only be trusted to
+work on positive numbers, there is also a macro |halfp| that is used only when
+the quantity being halved is known to be positive or zero.
+
+@ Here is a procedure analogous to |print_int|. The current version is fairly
+stupid, and it is not round-trip safe, but this is good enough for a beta test.
+
+@c
+char *mp_decnumber_tostring(decNumber *n)
+{
+ decNumber corrected;
+ char *buffer = mp_memory_allocate((size_t) ((decNumber *) n)->digits + 14);
+ decNumberCopy(&corrected, n);
+ decNumberTrim(&corrected);
+ decNumberToString(&corrected, buffer);
+ return buffer;
+}
+
+char *mp_decimal_number_tostring (MP mp, mp_number *n)
+{
+ (void) mp;
+ return mp_decnumber_tostring(n->data.num);
+}
+
+@ @c
+void mp_decimal_print_number (MP mp, mp_number *n)
+{
+ char *str = mp_decnumber_tostring(n->data.num);
+ mp_print_e_str(mp, str);
+ mp_memory_free(str);
+}
+
+@ Addition is not always checked to make sure that it doesn't overflow, but in
+places where overflow isn't too unlikely the |slow_add| routine is used.
+
+@c
+void mp_decimal_slow_add (MP mp, mp_number *ret, mp_number *A, mp_number *B)
+{
+ (void) mp;
+ decNumberAdd(ret->data.num, A->data.num, B->data.num, &mp_decimal_data.set);
+}
+
+@ The |make_fraction| routine produces the |fraction| equivalent of |p/q|, given
+integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are positive. If |p| and
+|q| are both of the same scaled type |t|, the \quote {type relation}
+|make_fraction(t,t)=fraction| is valid; and it's also possible to use the
+subroutine \quote {backwards,} using the relation |make_fraction(t,fraction)=t|
+between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_fraction| sets
+|arith_error:=true|. Most of \MP's internal computations have been designed to
+avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical machine, we
+could simply compute |(@t$2^{28}$@>*p)div q|, since a double-precision product
+can often be input to a fixed-point division instruction. But when we are
+restricted to int-eger arithmetic it is necessary either to resort to
+multiple-precision maneuvering or to use a simple but slow iteration. The
+multiple-precision technique would be about three times faster than the code
+adopted here, but it would be comparatively long and tricky, involving about
+sixteen additional multiplications and divisions.
+
+This operation is part of \MP's \quote {inner loop}; indeed, it will consume nearly
+10\pct! of the running time (exclusive of input and output) if the code below is
+left unchanged. A machine-dependent recoding will therefore make \MP\ run faster.
+The present implementation is highly portable, but slow; it avoids multiplication
+and division except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical results in all
+cases. @^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the \quote {inner loop,}
+such changes aren't advisable; simplicity and robustness are preferable to
+trickery, unless the cost is too high. @^inner loop@>
+
+@c
+void mp_decimal_make_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q)
+{
+ decNumberDivide(ret, p, q, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret, &mp_decimal_data.set);
+ decNumberMultiply(ret, ret, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_decimal_number_make_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q)
+{
+ mp_decimal_make_fraction(mp, ret->data.num, p->data.num, q->data.num);
+}
+
+@ The dual of |make_fraction| is |take_fraction|, which multiplies a given
+integer~|q| by a fraction~|f|. When the operands are positive, it computes
+$p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function of |q| and~|f|.
+
+This routine is even more \quote {inner loopy} than |make_fraction|; the present
+implementation consumes almost 20\pct! of \MP's computation time during typical
+jobs, so a machine-language substitute is advisable. @^inner loop@> @^system
+dependencies@>
+
+@c
+void mp_decimal_take_fraction (MP mp, decNumber *ret, decNumber *p, decNumber *q)
+{
+ (void) mp;
+ decNumberMultiply(ret, p, q, &mp_decimal_data.set);
+ decNumberDivide(ret, ret, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+void mp_decimal_number_take_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q)
+{
+ mp_decimal_take_fraction(mp, ret->data.num, p->data.num, q->data.num);
+}
+
+@ When we want to multiply something by a |scaled| quantity, we use a scheme
+analogous to |take_fraction| but with a different scaling. Given positive
+operands, |take_scaled| computes the quantity $p=\lfloor
+qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use a machine-language replacement if possible;
+otherwise |take_scaled| will use more than 2\pct! of the running time when the
+Computer Modern fonts are being generated. @^inner loop@>
+
+@c
+void mp_decimal_number_take_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ (void) mp;
+ decNumberMultiply(ret->data.num, p_orig->data.num, q_orig->data.num, &mp_decimal_data.set);
+}
+
+@ For completeness, there's also |make_scaled|, which computes a quotient as a
+|scaled| number instead of as a |fraction|. In other words, the result is
+$\lfloor2^{16}p/q+{1\over2}\rfloor$, if the operands are positive. \ (This
+procedure is not used especially often, so it is not part of \MP's inner loop.)
+
+@c
+void mp_decimal_number_make_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ decNumberDivide(ret->data.num, p_orig->data.num, q_orig->data.num, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ @* Scanning numbers in the input.
+
+The definitions below are temporarily here
+
+@ @c
+void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop)
+{
+ decNumber result;
+ size_t l = stop-start+1;
+ char *buf = mp_memory_allocate(l + 1);
+ buf[l] = '\0';
+ (void) strncpy(buf, (const char *) start, l);
+ mp_decimal_data.set.status = 0;
+ decNumberFromString(&result,buf, &mp_decimal_data.set);
+ mp_memory_free(buf);
+ if (mp_decimal_data.set.status == 0) {
+ set_cur_mod(&result);
+ } else if (mp->scanner_status != mp_tex_flushing_state) {
+ if (too_large(mp_decimal_data.set.status)) {
+ mp_decnumber_check(mp, &result, &mp_decimal_data.set);
+ set_cur_mod(&result);
+ mp_error(
+ mp,
+ "Enormous number has been reduced",
+ "I could not handle this number specification because it is out of range."
+ );
+ } else if (too_precise(mp_decimal_data.set.status)) {
+ set_cur_mod(&result);
+ if (decNumberIsPositive((decNumber *) internal_value(mp_warning_check_internal).data.num) && (mp->scanner_status != mp_tex_flushing_state)) {
+ char msg[256];
+ mp_snprintf (msg, 256, "Number is too precise (numberprecision = %d)", mp_decimal_data.set.digits);
+ mp_error(
+ mp,
+ msg,
+ "Continue and I'll round the value until it fits the current numberprecision\n"
+ "(Set warningcheck:=0 to suppress this message.)"
+ );
+ }
+ } else {
+ /* this also captures underflow */
+ mp_error(
+ mp,
+ "Erroneous number specification changed to zero",
+ "I could not handle this number specification"
+ );
+ decNumberZero(&result);
+ set_cur_mod(&result);
+ }
+ }
+ set_cur_cmd((mp_variable_type) mp_numeric_command);
+}
+
+@ @c
+static void find_exponent (MP mp)
+{
+ if (mp->buffer[mp->cur_input.loc_field] == 'e'
+ || mp->buffer[mp->cur_input.loc_field] == 'E') {
+ mp->cur_input.loc_field++;
+ if (! (mp->buffer[mp->cur_input.loc_field] == '+'
+ || mp->buffer[mp->cur_input.loc_field] == '-'
+ || mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class)) {
+ mp->cur_input.loc_field--;
+ return;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '+' ||
+ mp->buffer[mp->cur_input.loc_field] == '-') {
+ mp->cur_input.loc_field++;
+ }
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+}
+
+void mp_decimal_scan_fractional_token (MP mp, int n)
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+@ We just have to collect bytes.
+
+@c
+void mp_decimal_scan_numeric_token (MP mp, int n)
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '.' && mp->buffer[mp->cur_input.loc_field+1] != '.') {
+ mp->cur_input.loc_field++;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+ find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+@ The |scaled| quantities in \MP\ programs are generally supposed to be less than
+$2^{12}$ in absolute value, so \MP\ does much of its internal arithmetic with
+28~significant bits of precision. A |fraction| denotes a scaled integer whose
+binary point is assumed to be 28 bit positions from the right.
+
+@ Here is a typical example of how the routines above can be used. It computes
+the function $${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+(\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$
+where $\tau$ is a |scaled| \quote {tension} parameter. This is \MP's magic fudge
+factor for placing the first control point of a curve that starts at an angle
+$\theta$ and ends at an angle $\phi$ from the straight path. (Actually, if the
+stated quantity exceeds 4, \MP\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using relations
+such as $\sin\theta\cos\theta|1\over2|$.) Thus the numerator is positive; and
+since the tension $\tau$ is constrained to be at least $3\over4$, the numerator
+is less than $16\over3$. The denominator is nonnegative and at most~6.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction|
+arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+@c
+void mp_decimal_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t)
+{
+ decNumber acc, num, denom; /* registers for intermediate calculations */
+ decNumber r1, r2;
+ decNumber arg1, arg2;
+ decNumber i16, fone, fhalf, ftwo, sqrtfive;
+ decNumberFromInt32(&i16, 16);
+ decNumberFromInt32(&fone, fraction_one);
+ decNumberFromInt32(&fhalf, fraction_half);
+ decNumberFromInt32(&ftwo, fraction_two);
+ decNumberFromInt32(&sqrtfive, 5);
+ decNumberSquareRoot(&sqrtfive, &sqrtfive, &mp_decimal_data.set);
+
+ decNumberDivide(&arg1, sf->data.num, &i16, &mp_decimal_data.set); /* arg1 = sf / 16*/
+ decNumberSubtract(&arg1, st->data.num,&arg1, &mp_decimal_data.set); /* arg1 = st - arg1*/
+ decNumberDivide(&arg2, st->data.num, &i16, &mp_decimal_data.set); /* arg2 = st / 16*/
+ decNumberSubtract(&arg2, sf->data.num,&arg2, &mp_decimal_data.set); /* arg2 = sf - arg2*/
+ mp_decimal_take_fraction(mp, &acc, &arg1, &arg2); /* acc = (arg1 * arg2) / fmul*/
+
+ decNumberCopy(&arg1, &acc);
+ decNumberSubtract(&arg2, ct->data.num, cf->data.num, &mp_decimal_data.set); /* arg2 = ct - cf*/
+ mp_decimal_take_fraction(mp, &acc, &arg1, &arg2); /* acc = (arg1 * arg2 ) / fmul*/
+
+ decNumberSquareRoot(&arg1, &mp_decimal_data.two_decNumber, &mp_decimal_data.set); /* arg1 = $\sqrt{2}$*/
+ decNumberMultiply(&arg1, &arg1, &fone, &mp_decimal_data.set); /* arg1 = arg1 * fmul*/
+ mp_decimal_take_fraction(mp, &r1, &acc, &arg1); /* r1 = (acc * arg1) / fmul*/
+ decNumberAdd(&num, &ftwo, &r1, &mp_decimal_data.set); /* num = ftwo + r1*/
+
+ decNumberSubtract(&arg1,&sqrtfive, &mp_decimal_data.one, &mp_decimal_data.set); /* arg1 = $\sqrt{5}$ - 1*/
+ decNumberMultiply(&arg1,&arg1,&fhalf, &mp_decimal_data.set); /* arg1 = arg1 * fmul/2*/
+ decNumberMultiply(&arg1,&arg1,&mp_decimal_data.three_decNumber, &mp_decimal_data.set); /* arg1 = arg1 * 3*/
+
+ decNumberSubtract(&arg2,&mp_decimal_data.three_decNumber, &sqrtfive, &mp_decimal_data.set); /* arg2 = 3 - $\sqrt{5}$*/
+ decNumberMultiply(&arg2,&arg2, &fhalf, &mp_decimal_data.set); /* arg2 = arg2 * fmul/2*/
+ decNumberMultiply(&arg2,&arg2, &mp_decimal_data.three_decNumber, &mp_decimal_data.set); /* arg2 = arg2 * 3*/
+ mp_decimal_take_fraction(mp, &r1, ct->data.num, &arg1) ; /* r1 = (ct * arg1) / fmul*/
+ mp_decimal_take_fraction(mp, &r2, cf->data.num, &arg2); /* r2 = (cf * arg2) / fmul*/
+
+ decNumberFromInt32(&denom, fraction_three); /* denom = 3fmul*/
+ decNumberAdd(&denom, &denom, &r1, &mp_decimal_data.set); /* denom = denom + r1*/
+ decNumberAdd(&denom, &denom, &r2, &mp_decimal_data.set); /* denom = denom + r1*/
+
+ decNumberCompare(&arg1, t->data.num, &mp_decimal_data.one, &mp_decimal_data.set);
+ if (! decNumberIsZero(&arg1)) { /* t != r1*/
+ decNumberDivide(&num, &num, t->data.num, &mp_decimal_data.set); /* num = num / t */
+ }
+ decNumberCopy(&r2, &num); /* r2 = num / 4*/
+ decNumberDivide(&r2, &r2, &mp_decimal_data.four_decNumber, &mp_decimal_data.set);
+ if (decNumberLess(&denom, &r2)) {
+ decNumberFromInt32(ret->data.num, fraction_four); /* num/4 >= denom => denom < num/4*/
+ } else {
+ mp_decimal_make_fraction(mp, ret->data.num, &num, &denom);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is greater
+than, equal to, or less than~$cd$, given integers $(a,b,c,d)$. In most cases a
+quick decision is reached. The result is $+1$, 0, or~$-1$ in the three respective
+cases.
+
+@c
+int mp_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ decNumber a, b, c, d;
+ decNumber ab, cd;
+ decNumberCopy(&a, (decNumber *) a_orig->data.num);
+ decNumberCopy(&b, (decNumber *) b_orig->data.num);
+ decNumberCopy(&c, (decNumber *) c_orig->data.num);
+ decNumberCopy(&d, (decNumber *) d_orig->data.num);
+ decNumberMultiply(&ab, (decNumber *) a_orig->data.num, (decNumber *)b_orig->data.num, &mp_decimal_data.set);
+ decNumberMultiply(&cd, (decNumber *) c_orig->data.num, (decNumber *)d_orig->data.num, &mp_decimal_data.set);
+ if (decNumberLess(&ab, &cd)) {
+ return -1;
+ } else if (decNumberGreater(&ab, &cd)) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+@ Now here's a subroutine that's handy for all sorts of path computations: Given
+a quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function returns the
+unique |fraction| value |t| between 0 and~1 at which $B(a,b,c;t)$ changes from
+positive to negative, or returns |t=fraction_one+1| if no such value exists. If
+|a<0| (so that $B(a,b,c;t)$ is already negative at |t=0|), |crossing_point|
+returns the value zero.
+
+The general bisection method is quite simple when $n=2$, hence |crossing_point|
+does not take much time. At each stage in the recursion we have a subinterval
+defined by |l| and~|j| such that $B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we
+want to \quote {zero in} on the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values of |l| and~|j|
+in a single variable $d=2^l+j$, because the operation of bisection then
+corresponds simply to doubling $d$ and possibly adding~1. Furthermore it proves
+to be convenient to modify our previous conventions for bisection slightly,
+maintaining the variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and
+$X_2=2^l(x_1-x_2)$. With these variables the conditions $x_0\ge0$ and
+$\min(x_1,x_2)<0$ are equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L|x0|<\max(|x1|,|x1|+|x2|)$, $\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow will occur if
+the inputs satisfy $a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert
+b-c\vert<2^{30}$.
+
+@c
+static void mp_decimal_crossing_point (MP mp, mp_number *ret, mp_number *aa, mp_number *bb, mp_number *cc)
+{
+ decNumber a, b, c;
+ double d; /* recursive counter */
+ decNumber x, xx, x0, x1, x2; /* temporary registers for bisection */
+ decNumber scratch, scratch2;
+ decNumberCopy(&a, (decNumber *) aa->data.num);
+ decNumberCopy(&b, (decNumber *) bb->data.num);
+ decNumberCopy(&c, (decNumber *) cc->data.num);
+ if (decNumberIsNegative(&a)) {
+ decNumberCopy(ret->data.num, &zero_crossing);
+ goto RETURN;
+ }
+ if (! decNumberIsNegative(&c)) {
+ if (! decNumberIsNegative(&b)) {
+ if (decNumberIsPositive(&c)) {
+ decNumberCopy(ret->data.num, &no_crossing);
+ } else if (decNumberIsZero(&a) && decNumberIsZero(&b)) {
+ decNumberCopy(ret->data.num, &no_crossing);
+ } else {
+ decNumberCopy(ret->data.num, &one_crossing);
+ }
+ goto RETURN;
+ }
+ if (decNumberIsZero(&a)) {
+ decNumberCopy(ret->data.num, &zero_crossing);
+ goto RETURN;
+ }
+ } else if (decNumberIsZero(&a) && ! decNumberIsPositive(&b)) {
+ decNumberCopy(ret->data.num, &zero_crossing);
+ goto RETURN;
+ }
+ /* Use bisection to find the crossing point... */
+ d = epsilonf;
+ decNumberCopy(&x0, &a);
+ decNumberSubtract(&x1, &a, &b, &mp_decimal_data.set);
+ decNumberSubtract(&x2, &b, &c, &mp_decimal_data.set);
+ /* not sure why the error correction has to be >= 1E-12 */
+ decNumberFromDouble(&scratch2, 1E-12);
+ do {
+ decNumberAdd(&x, &x1, &x2, &mp_decimal_data.set);
+ decNumberDivide(&x, &x, &mp_decimal_data.two_decNumber, &mp_decimal_data.set);
+ decNumberAdd(&x, &x, &scratch2, &mp_decimal_data.set);
+ decNumberSubtract(&scratch, &x1, &x0, &mp_decimal_data.set);
+ if (decNumberGreater(&scratch, &x0)) {
+ decNumberCopy(&x2, &x);
+ decNumberAdd(&x0, &x0, &x0, &mp_decimal_data.set);
+ d += d;
+ } else {
+ decNumberAdd(&xx, &scratch, &x, &mp_decimal_data.set);
+ if (decNumberGreater(&xx,&x0)) {
+ decNumberCopy(&x2,&x);
+ decNumberAdd(&x0, &x0, &x0, &mp_decimal_data.set);
+ d += d;
+ } else {
+ decNumberSubtract(&x0, &x0, &xx, &mp_decimal_data.set);
+ if (! decNumberGreater(&x,&x0)) {
+ decNumberAdd(&scratch, &x, &x2, &mp_decimal_data.set);
+ if (! decNumberGreater(&scratch, &x0)) {
+ decNumberCopy(ret->data.num, &no_crossing);
+ goto RETURN;
+ }
+ }
+ decNumberCopy(&x1,&x);
+ d = d + d + epsilonf;
+ }
+ }
+ } while (d < fraction_one);
+ decNumberFromDouble(&scratch, d);
+ decNumberSubtract(ret->data.num,&scratch, &mp_decimal_data.fraction_one_decNumber, &mp_decimal_data.set);
+ RETURN:
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ We conclude this set of elementary routines with some simple rounding and
+truncation operations.
+
+@ |round_unscaled| rounds a |scaled| and converts it to |int|
+
+@c
+int mp_round_unscaled(mp_number *x_orig)
+{
+ return (int) lround(mp_number_to_double(x_orig));
+}
+
+@ |number_floor| floors a number
+
+@c
+void mp_number_floor(mp_number *i)
+{
+ int round = mp_decimal_data.set.round;
+ mp_decimal_data.set.round = DEC_ROUND_FLOOR;
+ decNumberToIntegralValue(i->data.num, i->data.num, &mp_decimal_data.set);
+ mp_decimal_data.set.round = round;
+}
+
+@ |fraction_to_scaled| rounds a |fraction| and converts it to |scaled|
+
+@c
+void mp_decimal_fraction_to_round_scaled(mp_number *x_orig)
+{
+ x_orig->type = mp_scaled_type;
+ decNumberDivide(x_orig->data.num, x_orig->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+}
+
+@* Algebraic and transcendental functions. \MP\ computes all of the necessary
+special functions from scratch, without relying on |real| arithmetic or system
+subroutines for sines, cosines, etc.
+
+@ @c
+void mp_decimal_square_rt (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ decNumber x;
+ decNumberCopy(&x, x_orig->data.num);
+ if (! decNumberIsPositive(&x)) {
+ if (decNumberIsNegative(&x)) {
+ char msg[256];
+ char *xstr = mp_decimal_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Square root of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ @.Square root...replaced by 0@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ decNumberZero(ret->data.num);
+ } else {
+ decNumberSquareRoot(ret->data.num, &x, &mp_decimal_data.set);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by a quick hack
+
+@c
+void mp_decimal_pyth_add (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ decNumber a, b;
+ decNumber asq, bsq;
+ decNumberCopyAbs(&a, a_orig->data.num);
+ decNumberCopyAbs(&b, b_orig->data.num);
+ decNumberMultiply(&asq, &a, &a, &mp_decimal_data.set);
+ decNumberMultiply(&bsq, &b, &b, &mp_decimal_data.set);
+ decNumberAdd(&a, &asq, &bsq, &mp_decimal_data.set);
+ decNumberSquareRoot(ret->data.num, &a, &mp_decimal_data.set);
+ /*
+ if (set.status != 0) {
+ mp->arith_error = 1;
+ decNumberCopy(ret->data.num, &mp_decimal_data.EL_GORDO_decNumber);
+ }
+ */
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ Here is a similar algorithm for $\psqrt{a^2-b^2}$. Same quick hack, also.
+
+@c
+void mp_decimal_pyth_sub (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ decNumber a, b;
+ decNumberCopyAbs(&a, a_orig->data.num);
+ decNumberCopyAbs(&b, b_orig->data.num);
+ if (! decNumberGreater(&a, &b)) {
+ if (decNumberLess(&a, &b)) {
+ char msg[256];
+ char *astr = mp_decimal_number_tostring(mp, a_orig);
+ char *bstr = mp_decimal_number_tostring(mp, b_orig);
+ mp_snprintf(msg, 256, "Pythagorean subtraction %s+-+%s has been replaced by 0", astr, bstr);
+ mp_memory_free(astr);
+ mp_memory_free(bstr);
+ @.Pythagorean...@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ decNumberZero(&a);
+ } else {
+ decNumber asq, bsq;
+ decNumberMultiply(&asq, &a, &a, &mp_decimal_data.set);
+ decNumberMultiply(&bsq, &b, &b, &mp_decimal_data.set);
+ decNumberSubtract(&a, &asq, &bsq, &mp_decimal_data.set);
+ decNumberSquareRoot(&a, &a, &mp_decimal_data.set);
+ }
+ decNumberCopy(ret->data.num, &a);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ Power $a^b}$:
+
+@c
+void mp_decimal_power_of (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ decNumberPower(ret->data.num, a_orig->data.num, b_orig->data.num, &mp_decimal_data.set);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ Here is the routine that calculates $2^8$ times the natural logarithm of a
+|scaled| quantity;
+
+@c
+void mp_decimal_m_log (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ if (! decNumberIsPositive((decNumber *) x_orig->data.num)) {
+ char msg[256];
+ char *xstr = mp_decimal_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Logarithm of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ @.Logarithm...replaced by 0@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take logs of non-positive numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ decNumberZero(ret->data.num);
+ } else {
+ decNumber twofivesix;
+ decNumberFromInt32(&twofivesix, 256);
+ decNumberLn(ret->data.num, x_orig->data.num, &mp_decimal_data.limitedset);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.limitedset);
+ decNumberMultiply(ret->data.num, ret->data.num, &twofivesix, &mp_decimal_data.set);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ Conversely, the exponential routine calculates $\exp(x/2^8)$, when |x| is
+|scaled|.
+
+@c
+void mp_decimal_m_exp (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ decNumber temp, twofivesix;
+ decNumberFromInt32(&twofivesix, 256);
+ decNumberDivide(&temp, x_orig->data.num, &twofivesix, &mp_decimal_data.set);
+ mp_decimal_data.limitedset.status = 0;
+ decNumberExp(ret->data.num, &temp, &mp_decimal_data.limitedset);
+ if (mp_decimal_data.limitedset.status & DEC_Clamped) {
+ if (decNumberIsPositive((decNumber *) x_orig->data.num)) {
+ mp->arith_error = 1;
+ decNumberCopy(ret->data.num, &mp_decimal_data.EL_GORDO_decNumber);
+ } else {
+ decNumberZero(ret->data.num);
+ }
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.limitedset);
+ mp_decimal_data.limitedset.status = 0;
+}
+
+@ Given integers |x| and |y|, not both zero, the |n_arg| function returns the
+|angle| whose tangent points in the direction $(x,y)$.
+
+@c
+void mp_decimal_n_arg (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ if (decNumberIsZero((decNumber *) x_orig->data.num) && decNumberIsZero((decNumber *) y_orig->data.num)) {
+ mp_error(
+ mp,
+ "angle(0,0) is taken as zero",
+ "The 'angle' between two identical points is undefined. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ @.angle(0,0)...zero@>
+ decNumberZero(ret->data.num);
+ } else {
+ decNumber atan2val, oneeighty_angle;
+ ret->type = mp_angle_type;
+ decNumberFromInt32(&oneeighty_angle, 180 * angle_multiplier);
+ decNumberDivide(&oneeighty_angle, &oneeighty_angle, &mp_decimal_data.PI_decNumber, &mp_decimal_data.set);
+ checkZero(y_orig->data.num);
+ checkZero(x_orig->data.num);
+ decNumberAtan2(&atan2val, y_orig->data.num, x_orig->data.num, &mp_decimal_data.set);
+ decNumberMultiply(ret->data.num,&atan2val, &oneeighty_angle, &mp_decimal_data.set);
+ checkZero(ret->data.num);
+ }
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine and
+cosine of that angle. The results of this routine are stored in global integer
+variables |n_sin| and |n_cos|.
+
+First, we need a decNumber function that calculates sines and cosines using the
+Taylor series. This function is fairly optimized.
+
+@c
+static void sinecosine(decNumber *theangle, decNumber *c, decNumber *s)
+{
+ int prec = mp_decimal_data.set.digits/2;
+ decNumber p, pxa, fac, cc;
+ decNumber n1, n2, p1;
+ decNumberZero(c);
+ decNumberZero(s);
+ if (prec < DECPRECISION_DEFAULT) {
+ prec = DECPRECISION_DEFAULT;
+ }
+ for (int n = 0; n < prec; n++) {
+ decNumberFromInt32(&p1, n);
+ decNumberFromInt32(&n1, 2*n);
+ decNumberPower(&p, &mp_decimal_data.minusone, &p1, &mp_decimal_data.limitedset);
+ if (n == 0) {
+ decNumberCopy(&pxa, &mp_decimal_data.one);
+ } else {
+ decNumberPower(&pxa, theangle, &n1, &mp_decimal_data.limitedset);
+ }
+ if (2*n < mp_decimal_data.last_cached_factorial) {
+ decNumberCopy(&fac,mp_decimal_data.factorials[2*n]);
+ } else {
+ decNumberCopy(&fac,mp_decimal_data.factorials[mp_decimal_data.last_cached_factorial]);
+ for (int i = mp_decimal_data.last_cached_factorial+1; i <= 2*n; i++) {
+ decNumberFromInt32(&cc, i);
+ decNumberMultiply (&fac, &fac, &cc, &mp_decimal_data.set);
+ if (i < FACTORIALS_CACHESIZE) {
+ mp_decimal_data.factorials[i] = mp_memory_allocate(sizeof(decNumber));
+ decNumberCopy(mp_decimal_data.factorials[i], &fac);
+ mp_decimal_data.last_cached_factorial = i;
+ }
+ }
+ }
+ decNumberDivide(&pxa, &pxa, &fac, &mp_decimal_data.set);
+ decNumberMultiply(&pxa, &pxa, &p, &mp_decimal_data.set);
+ decNumberAdd(s, s, &pxa, &mp_decimal_data.set);
+ decNumberFromInt32(&n2, 2*n+1);
+ decNumberMultiply(&fac, &fac, &n2, &mp_decimal_data.set); /* fac = fac * (2*n+1)*/
+ decNumberPower(&pxa, theangle, &n2, &mp_decimal_data.limitedset);
+ decNumberDivide(&pxa, &pxa, &fac, &mp_decimal_data.set);
+ decNumberMultiply(&pxa, &pxa, &p, &mp_decimal_data.set);
+ decNumberAdd(c, c, &pxa, &mp_decimal_data.set);
+ }
+}
+
+@ Calculate sines and cosines.
+
+@c
+void mp_decimal_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin)
+{
+ decNumber rad;
+ decNumber one_eighty;
+ double tmp = mp_number_to_double(z_orig)/16.0;
+ if ((tmp == 90.0)||(tmp == -270)){
+ decNumberZero(n_cos->data.num);
+ decNumberCopy(n_sin->data.num, &mp_decimal_data.fraction_multiplier_decNumber);
+ } else if ((tmp == -90.0)||(tmp == 270.0)) {
+ decNumberZero(n_cos->data.num);
+ decNumberCopyNegate(n_sin->data.num, &mp_decimal_data.fraction_multiplier_decNumber);
+ } else if ((tmp == 180.0) || (tmp == -180.0)) {
+ decNumberCopyNegate(n_cos->data.num, &mp_decimal_data.fraction_multiplier_decNumber);
+ decNumberZero(n_sin->data.num);
+ } else {
+ decNumberFromInt32(&one_eighty, 180 * 16);
+ decNumberMultiply(&rad, z_orig->data.num, &mp_decimal_data.PI_decNumber, &mp_decimal_data.set);
+ decNumberDivide(&rad, &rad, &one_eighty, &mp_decimal_data.set);
+ sinecosine(&rad, n_sin->data.num, n_cos->data.num);
+ decNumberMultiply(n_cos->data.num, n_cos->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+ decNumberMultiply(n_sin->data.num, n_sin->data.num, &mp_decimal_data.fraction_multiplier_decNumber, &mp_decimal_data.set);
+ }
+ mp_decnumber_check(mp, n_cos->data.num, &mp_decimal_data.set);
+ mp_decnumber_check(mp, n_sin->data.num, &mp_decimal_data.set);
+}
+
+@ This is the {\tt http://www-cs-faculty.stanford.edu/~uno/programs/rng.c}
+with small cosmetic modifications.
+
+@c
+# define KK 100 /* the long lag */
+# define LL 37 /* the short lag */
+# define MM (1L<<30) /* the modulus */
+# define mod_diff(x,y) (((x)-(y))&(MM-1)) /* subtraction mod MM */
+# define QUALITY 1009 /* recommended quality level for high-res use */
+# define TT 70 /* guaranteed separation between streams */
+# define is_odd(x) ((x)&1) /* units bit of x */
+
+typedef struct mp_decimal_random_info {
+ long x[KK];
+ long buf[QUALITY];
+ long dummy;
+ long started;
+ long *ptr;
+} mp_decimal_random_info;
+
+mp_decimal_random_info mp_decimal_random_data = {
+ .dummy = -1,
+ .started = -1,
+ .ptr = &mp_decimal_random_data.dummy
+};
+
+/* put n new random numbers in aa */
+/* long aa[] destination */
+/* int n array length (must be at least KK) */
+
+static void ran_array(long aa[],int n)
+{
+ int i, j;
+ for (j = 0; j < KK;j++) {
+ aa[j] = mp_decimal_random_data.x[j];
+ }
+ for (; j < n; j++) {
+ aa[j] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (i = 0; i < LL ; i++, j++) {
+ mp_decimal_random_data.x[i] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (;i < KK; i++, j++) {
+ mp_decimal_random_data.x[i] = mod_diff(aa[j - KK], mp_decimal_random_data.x[i - LL]);
+ }
+}
+
+/*
+ the following routines are from exercise 3.6--15L after calling |ran_start|,
+ get new randoms by, e.g., "|x=ran_arr_next()|"
+
+ Do this before using |ran_array|, |long seed| selector for different
+ streams.
+*/
+
+static void ran_start(long seed)
+{
+ int t, j;
+ long x[KK+KK-1]; /* the preparation buffer */
+ long ss=(seed+2)&(MM-2);
+ for (j = 0; j < KK; j++) {
+ /* bootstrap the buffer */
+ x[j] = ss;
+ ss <<= 1;
+ if (ss >= MM) {
+ /* cyclic shift 29 bits */
+ ss -= MM - 2;
+ }
+ }
+ /* make x[1] (and only x[1]) odd */
+ x[1]++;
+ for (ss = seed & (MM-1), t = TT - 1; t;) {
+ for (j = KK - 1; j > 0; j--) {
+ /* square */
+ x[j + j] = x[j];
+ x[j + j - 1] = 0;
+ }
+ for (j = KK + KK - 2; j >= KK; j--) {
+ x[j - (KK - LL)] = mod_diff(x[j - (KK - LL)], x[j]);
+ x[j - KK] = mod_diff(x[j - KK], x[j]);
+ }
+ if (is_odd(ss)) {
+ /* "multiply by z" */
+ for (j = KK; j > 0; j--) {
+ x[j] = x[j-1];
+ }
+ x[0] = x[KK];
+ /* shift the buffer cyclically */
+ x[LL] = mod_diff(x[LL], x[KK]);
+ }
+ if (ss) {
+ ss >>= 1;
+ } else {
+ t--;
+ }
+ }
+ for (j = 0; j < LL; j++) {
+ mp_decimal_random_data.x[j + KK -LL] = x[j];
+ }
+ for (; j < KK; j++) {
+ mp_decimal_random_data.x[j - LL] = x[j];
+ }
+ for (j = 0; j < 10; j++) {
+ /* warm things up */
+ ran_array(x, KK + KK - 1);
+ }
+ mp_decimal_random_data.ptr = &mp_decimal_random_data.started;
+}
+
+# define ran_arr_next() (*mp_decimal_random_data.ptr>=0? *mp_decimal_random_data.ptr++: ran_arr_cycle())
+
+static long ran_arr_cycle(void)
+{
+ if (mp_decimal_random_data.ptr == &mp_decimal_random_data.dummy) {
+ /* the user forgot to initialize */
+ ran_start(314159L);
+ }
+ ran_array(mp_decimal_random_data.buf, QUALITY);
+ mp_decimal_random_data.buf[KK] = -1;
+ mp_decimal_random_data.ptr = mp_decimal_random_data.buf + 1;
+ return mp_decimal_random_data.buf[0];
+}
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@c
+void mp_init_randoms (MP mp, int seed)
+{
+ int k = 1; /* more or less random integers */
+ int j = abs(seed);
+ while (j >= fraction_one) {
+ j = j/2;
+ }
+ for (int i = 0; i <= 54; i++) {
+ int jj = k;
+ k = j - k;
+ j = jj;
+ if (k < 0) {
+ k += fraction_one;
+ }
+ decNumberFromInt32(mp->randoms[(i * 21) % 55].data.num, j);
+ }
+ /* \quote {warm up} the array */
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ ran_start((unsigned long) seed);
+}
+
+@ @c
+void mp_decimal_number_modulo(mp_number *a, mp_number *b)
+{
+ decNumberRemainder(a->data.num, a->data.num, b->data.num, &mp_decimal_data.set);
+}
+
+@ To consume a random integer for the uniform generator, the program below will
+say |next_unif_random|.
+
+@c
+static void mp_next_unif_random (MP mp, mp_number *ret)
+{
+ decNumber a;
+ decNumber b;
+ unsigned long int op = (unsigned)ran_arr_next();
+ (void) mp;
+ decNumberFromInt32(&a, op);
+ decNumberFromInt32(&b, MM);
+ decNumberDivide(&a, &a, &b, &mp_decimal_data.set); /* a = a/b */
+ decNumberCopy(ret->data.num, &a);
+ mp_decnumber_check(mp, ret->data.num, &mp_decimal_data.set);
+}
+
+@ To consume a random fraction, the program below will say |next_random|.
+
+@c
+static void mp_next_random (MP mp, mp_number *ret)
+{
+ if (mp->j_random == 0) {
+ mp_new_randoms(mp);
+ } else {
+ mp->j_random = mp->j_random-1;
+ }
+ mp_number_clone(ret, &(mp->randoms[mp->j_random]));
+}
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x| or
+|0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x| with
+about half the probability that it will produce any other particular values
+between 0 and~|x|, because it rounds its answers.
+
+@c
+static void mp_decimal_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ mp_number x, abs_x, u, y; /* |y| is trial value */
+ mp_allocate_number(mp, &y, mp_fraction_type);
+ mp_allocate_clone(mp, &x, mp_scaled_type, x_orig);
+ mp_allocate_abs(mp, &abs_x, mp_scaled_type, &x);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_next_unif_random(mp, &u);
+ decNumberMultiply(y.data.num, abs_x.data.num, u.data.num, &mp_decimal_data.set);
+ if (mp_number_equal(&y, &abs_x)) {
+ mp_number_clone(ret, &((math_data *)mp->math)->md_zero_t);
+ } else if (mp_number_greater(&x, &((math_data *)mp->math)->md_zero_t)) {
+ mp_number_clone(ret, &y);
+ } else {
+ mp_number_negated_clone(ret, &y);
+ }
+ mp_free_number(mp, &x);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &y);
+ mp_free_number(mp, &u);
+}
+
+@ Finally, a normal deviate with mean zero and unit standard deviation can
+readily be obtained with the ratio method (Algorithm 3.4.1R in {\sl The Art of
+Computer Programming}).
+
+@c
+static void mp_decimal_m_norm_rand (MP mp, mp_number *ret)
+{
+ mp_number abs_x, u, r, la, xa;
+ mp_allocate_number(mp, &la, mp_scaled_type);
+ mp_allocate_number(mp, &xa, mp_scaled_type);
+ mp_allocate_number(mp, &abs_x, mp_scaled_type);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_allocate_number(mp, &r, mp_scaled_type);
+ do {
+ do {
+ mp_number v; /* maybe move outside loop */
+ mp_allocate_number(mp, &v, mp_scaled_type);
+ mp_next_random(mp, &v);
+ mp_number_subtract(&v, &((math_data *)mp->math)->md_fraction_half_t);
+ mp_decimal_number_take_fraction(mp, &xa, &((math_data *)mp->math)->md_sqrt_8_e_k, &v);
+ mp_free_number(mp, &v);
+ mp_next_random(mp, &u);
+ mp_number_clone(&abs_x, &xa);
+ mp_decimal_abs(&abs_x);
+ } while (! mp_number_less(&abs_x, &u));
+ mp_decimal_number_make_fraction(mp, &r, &xa, &u);
+ mp_number_clone(&xa, &r);
+ mp_decimal_m_log(mp, &la, &u);
+ mp_set_decimal_from_subtraction(&la, &((math_data *)mp->math)->md_twelve_ln_2_k, &la);
+ } while (mp_ab_vs_cd(&((math_data *)mp->math)->md_one_k, &la, &xa, &xa) < 0);
+ mp_number_clone(ret, &xa);
+ mp_free_number(mp, &r);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &la);
+ mp_free_number(mp, &xa);
+ mp_free_number(mp, &u);
+}
diff --git a/source/luametatex/source/mp/mpw/mpmathdouble.w b/source/luametatex/source/mp/mpw/mpmathdouble.w
new file mode 100644
index 000000000..83741794b
--- /dev/null
+++ b/source/luametatex/source/mp/mpw/mpmathdouble.w
@@ -0,0 +1,1523 @@
+% This file is part of MetaPost. The MetaPost program is in the public domain.
+
+@ Introduction.
+
+@c
+# include "mpconfig.h"
+# include "mpmathdouble.h"
+
+@h
+
+@ @c
+@<Declarations@>
+
+@ @(mpmathdouble.h@>=
+# ifndef MPMATHDOUBLE_H
+# define MPMATHDOUBLE_H 1
+
+# include "mp.h"
+
+math_data *mp_initialize_double_math (MP mp);
+
+# endif
+
+@* Math initialization.
+
+First, here are some very important constants.
+
+@d PI 3.1415926535897932384626433832795028841971
+@d fraction_multiplier 4096.0
+@d angle_multiplier 16.0
+
+@d coef_bound ((7.0/3.0)*fraction_multiplier) /* |fraction| approximation to 7/3 */
+@d fraction_threshold 0.04096 /* a |fraction| coefficient less than this is zeroed */
+@d half_fraction_threshold (fraction_threshold/2) /* half of |fraction_threshold| */
+@d scaled_threshold 0.000122 /* a |scaled| coefficient less than this is zeroed */
+@d half_scaled_threshold (scaled_threshold/2) /* half of |scaled_threshold| */
+@d near_zero_angle (0.0256*angle_multiplier) /* an angle of about 0.0256 */
+@d p_over_v_threshold 0x80000 /* TODO */
+@d equation_threshold 0.001
+@d warning_limit pow(2.0,52.0) /* this is a large value that can just be expressed without loss of precision */
+@d epsilon pow(2.0,-52.0)
+
+@d unity 1.0
+@d two 2.0
+@d three 3.0
+@d half_unit 0.5
+@d three_quarter_unit 0.75
+@d EL_GORDO (DBL_MAX/2.0-1.0) /* the largest value that \MP\ likes. */
+@d negative_EL_GORDO (-EL_GORDO)
+@d one_third_EL_GORDO (EL_GORDO/3.0)
+
+@d fraction_half (0.5*fraction_multiplier)
+@d fraction_one (1.0*fraction_multiplier)
+@d fraction_two (2.0*fraction_multiplier)
+@d fraction_three (3.0*fraction_multiplier)
+@d fraction_four (4.0*fraction_multiplier)
+
+@d no_crossing (fraction_one + 1)
+@d one_crossing fraction_one
+@d zero_crossing 0
+
+@d one_eighty_deg (180.0*angle_multiplier)
+@d negative_one_eighty_deg (-180.0*angle_multiplier)
+@d three_sixty_deg (360.0*angle_multiplier)
+@d odd(A) (abs(A)%2==1)
+
+@d two_to_the(A) (1<<(unsigned)(A))
+@d set_cur_cmd(A) mp->cur_mod_->command = (A)
+@d set_cur_mod(A) mp->cur_mod_->data.n.data.dval = (A)
+
+@ Here are the functions that are static as they are not used elsewhere.
+
+@<Declarations@>=
+static int mp_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v);
+static void mp_allocate_double (MP mp, mp_number *n, double v);
+static void mp_allocate_number (MP mp, mp_number *n, mp_number_type t);
+static int mp_double_ab_vs_cd (mp_number *a, mp_number *b, mp_number *c, mp_number *d);
+static void mp_double_abs (mp_number *A);
+static void mp_double_crossing_point (MP mp, mp_number *ret, mp_number *a, mp_number *b, mp_number *c);
+static void mp_double_fraction_to_round_scaled (mp_number *x);
+static void mp_double_m_exp (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_m_log (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_m_norm_rand (MP mp, mp_number *ret);
+static void mp_double_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_n_arg (MP mp, mp_number *ret, mp_number *x, mp_number *y);
+static void mp_double_number_make_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_number_make_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_number_take_fraction (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_number_take_scaled (MP mp, mp_number *r, mp_number *p, mp_number *q);
+static void mp_double_power_of (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_double_print_number (MP mp, mp_number *n);
+static void mp_double_pyth_add (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_double_pyth_sub (MP mp, mp_number *r, mp_number *a, mp_number *b);
+static void mp_double_scan_fractional_token (MP mp, int n);
+static void mp_double_scan_numeric_token (MP mp, int n);
+static void mp_double_set_precision (MP mp);
+static void mp_double_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin);
+static void mp_double_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig);
+static void mp_double_square_rt (MP mp, mp_number *ret, mp_number *x_orig);
+static void mp_double_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t);
+static void mp_free_double_math (MP mp);
+static void mp_free_number (MP mp, mp_number *n);
+static void mp_init_randoms (MP mp, int seed);
+static void mp_number_abs_clone (mp_number *A, mp_number *B);
+static void mp_number_add (mp_number *A, mp_number *B);
+static void mp_number_add_scaled (mp_number *A, int B); /* also for negative B */
+static void mp_number_angle_to_scaled (mp_number *A);
+static void mp_number_clone (mp_number *A, mp_number *B);
+static void mp_number_divide_int (mp_number *A, int B);
+static void mp_number_double (mp_number *A);
+static int mp_number_equal (mp_number *A, mp_number *B);
+static void mp_number_floor (mp_number *i);
+static void mp_number_fraction_to_scaled (mp_number *A);
+static int mp_number_greater (mp_number *A, mp_number *B);
+static void mp_number_half (mp_number *A);
+static int mp_number_less (mp_number *A, mp_number *B);
+static void mp_number_modulo (mp_number *a, mp_number *b);
+static void mp_number_multiply_int (mp_number *A, int B);
+static void mp_number_negate (mp_number *A);
+static void mp_number_negated_clone (mp_number *A, mp_number *B);
+static int mp_number_nonequalabs (mp_number *A, mp_number *B);
+static int mp_number_odd (mp_number *A);
+static void mp_number_scaled_to_angle (mp_number *A);
+static void mp_number_scaled_to_fraction (mp_number *A);
+static void mp_number_subtract (mp_number *A, mp_number *B);
+static void mp_number_swap (mp_number *A, mp_number *B);
+static int mp_number_to_boolean (mp_number *A);
+static double mp_number_to_double (mp_number *A);
+static int mp_number_to_int (mp_number *A);
+static int mp_number_to_scaled (mp_number *A);
+static int mp_round_unscaled (mp_number *x_orig);
+static void mp_set_double_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_from_boolean (mp_number *A, int B);
+static void mp_set_double_from_div (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_from_double (mp_number *A, double B);
+static void mp_set_double_from_int (mp_number *A, int B);
+static void mp_set_double_from_int_div (mp_number *A, mp_number *B, int C);
+static void mp_set_double_from_int_mul (mp_number *A, mp_number *B, int C);
+static void mp_set_double_from_mul (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C);
+static void mp_set_double_from_scaled (mp_number *A, int B);
+static void mp_set_double_from_subtraction (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_half_from_addition (mp_number *A, mp_number *B, mp_number *C);
+static void mp_set_double_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C);
+static void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop);
+static char *mp_double_number_tostring (MP mp, mp_number *n);
+
+inline double mp_double_make_fraction (double p, double q) { return (p / q) * fraction_multiplier; }
+inline double mp_double_take_fraction (double p, double q) { return (p * q) / fraction_multiplier; }
+inline double mp_double_make_scaled (double p, double q) { return p / q; }
+
+@c
+math_data *mp_initialize_double_math(MP mp)
+{
+ math_data *math = (math_data *) mp_memory_allocate(sizeof(math_data));
+ /* alloc */
+ math->md_allocate = mp_allocate_number;
+ math->md_free = mp_free_number;
+ math->md_allocate_clone = mp_allocate_clone;
+ math->md_allocate_abs = mp_allocate_abs;
+ math->md_allocate_double = mp_allocate_double;
+ /* precission */
+ mp_allocate_number(mp, &math->md_precision_default, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_max, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_precision_min, mp_scaled_type);
+ /* here are the constants for |scaled| objects */
+ mp_allocate_number(mp, &math->md_epsilon_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_negative_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_warning_limit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_one_third_inf_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_unity_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_two_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_three_quarter_unit_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_zero_t, mp_scaled_type);
+ /* |fractions| */
+ mp_allocate_number(mp, &math->md_arc_tol_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_one_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_half_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_three_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_fraction_four_t, mp_fraction_type);
+ /* |angles| */
+ mp_allocate_number(mp, &math->md_three_sixty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_one_eighty_deg_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_negative_one_eighty_deg_t, mp_angle_type);
+ /* various approximations */
+ mp_allocate_number(mp, &math->md_one_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_sqrt_8_e_k, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twelve_ln_2_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_k, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_coef_bound_minus_1, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twelvebits_3, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_twentysixbits_sqrt2_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentyeightbits_d_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_twentysevenbits_sqrt2_d_t, mp_fraction_type);
+ /* thresholds */
+ mp_allocate_number(mp, &math->md_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_half_fraction_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_half_scaled_threshold_t, mp_scaled_type);
+ mp_allocate_number(mp, &math->md_near_zero_angle_t, mp_angle_type);
+ mp_allocate_number(mp, &math->md_p_over_v_threshold_t, mp_fraction_type);
+ mp_allocate_number(mp, &math->md_equation_threshold_t, mp_scaled_type);
+ /* initializations */
+ math->md_precision_default.data.dval = 16 * unity;
+ math->md_precision_max.data.dval = 16 * unity;
+ math->md_precision_min.data.dval = 16 * unity;
+ math->md_epsilon_t.data.dval = epsilon;
+ math->md_inf_t.data.dval = EL_GORDO;
+ math->md_negative_inf_t.data.dval = negative_EL_GORDO;
+ math->md_one_third_inf_t.data.dval = one_third_EL_GORDO;
+ math->md_warning_limit_t.data.dval = warning_limit;
+ math->md_unity_t.data.dval = unity;
+ math->md_two_t.data.dval = two;
+ math->md_three_t.data.dval = three;
+ math->md_half_unit_t.data.dval = half_unit;
+ math->md_three_quarter_unit_t.data.dval = three_quarter_unit;
+ math->md_arc_tol_k.data.dval = (unity/4096); /* quit when change in arc length estimate reaches this */
+ math->md_fraction_one_t.data.dval = fraction_one;
+ math->md_fraction_half_t.data.dval = fraction_half;
+ math->md_fraction_three_t.data.dval = fraction_three;
+ math->md_fraction_four_t.data.dval = fraction_four;
+ math->md_three_sixty_deg_t.data.dval = three_sixty_deg;
+ math->md_one_eighty_deg_t.data.dval = one_eighty_deg;
+ math->md_negative_one_eighty_deg_t.data.dval = negative_one_eighty_deg;
+ math->md_one_k.data.dval = 1.0/64 ;
+ math->md_sqrt_8_e_k.data.dval = 1.71552776992141359295; /* $2^{16}\sqrt{8/e}\approx 112428.82793$ */
+ math->md_twelve_ln_2_k.data.dval = 8.31776616671934371292 *256; /* $2^{24}\cdot12\ln2\approx139548959.6165$ */
+ math->md_coef_bound_k.data.dval = coef_bound;
+ math->md_coef_bound_minus_1.data.dval = coef_bound - 1/65536.0;
+ math->md_twelvebits_3.data.dval = 1365 / 65536.0; /* $1365\approx 2^{12}/3$ */
+ math->md_twentysixbits_sqrt2_t.data.dval = 94906266 / 65536.0; /* $2^{26}\sqrt2\approx94906265.62$ */
+ math->md_twentyeightbits_d_t.data.dval = 35596755 / 65536.0; /* $2^{28}d\approx35596754.69$ */
+ math->md_twentysevenbits_sqrt2_d_t.data.dval = 25170707 / 65536.0; /* $2^{27}\sqrt2\,d\approx25170706.63$ */
+ math->md_fraction_threshold_t.data.dval = fraction_threshold;
+ math->md_half_fraction_threshold_t.data.dval = half_fraction_threshold;
+ math->md_scaled_threshold_t.data.dval = scaled_threshold;
+ math->md_half_scaled_threshold_t.data.dval = half_scaled_threshold;
+ math->md_near_zero_angle_t.data.dval = near_zero_angle;
+ math->md_p_over_v_threshold_t.data.dval = p_over_v_threshold;
+ math->md_equation_threshold_t.data.dval = equation_threshold;
+ /* functions */
+ math->md_from_int = mp_set_double_from_int;
+ math->md_from_boolean = mp_set_double_from_boolean;
+ math->md_from_scaled = mp_set_double_from_scaled;
+ math->md_from_double = mp_set_double_from_double;
+ math->md_from_addition = mp_set_double_from_addition;
+ math->md_half_from_addition = mp_set_double_half_from_addition;
+ math->md_from_subtraction = mp_set_double_from_subtraction;
+ math->md_half_from_subtraction = mp_set_double_half_from_subtraction;
+ math->md_from_oftheway = mp_set_double_from_of_the_way;
+ math->md_from_div = mp_set_double_from_div;
+ math->md_from_mul = mp_set_double_from_mul;
+ math->md_from_int_div = mp_set_double_from_int_div;
+ math->md_from_int_mul = mp_set_double_from_int_mul;
+ math->md_negate = mp_number_negate;
+ math->md_add = mp_number_add;
+ math->md_subtract = mp_number_subtract;
+ math->md_half = mp_number_half;
+ math->md_do_double = mp_number_double;
+ math->md_abs = mp_double_abs;
+ math->md_clone = mp_number_clone;
+ math->md_negated_clone = mp_number_negated_clone;
+ math->md_abs_clone = mp_number_abs_clone;
+ math->md_swap = mp_number_swap;
+ math->md_add_scaled = mp_number_add_scaled;
+ math->md_multiply_int = mp_number_multiply_int;
+ math->md_divide_int = mp_number_divide_int;
+ math->md_to_boolean = mp_number_to_boolean;
+ math->md_to_scaled = mp_number_to_scaled;
+ math->md_to_double = mp_number_to_double;
+ math->md_to_int = mp_number_to_int;
+ math->md_odd = mp_number_odd;
+ math->md_equal = mp_number_equal;
+ math->md_less = mp_number_less;
+ math->md_greater = mp_number_greater;
+ math->md_nonequalabs = mp_number_nonequalabs;
+ math->md_round_unscaled = mp_round_unscaled;
+ math->md_floor_scaled = mp_number_floor;
+ math->md_fraction_to_round_scaled = mp_double_fraction_to_round_scaled;
+ math->md_make_scaled = mp_double_number_make_scaled;
+ math->md_make_fraction = mp_double_number_make_fraction;
+ math->md_take_fraction = mp_double_number_take_fraction;
+ math->md_take_scaled = mp_double_number_take_scaled;
+ math->md_velocity = mp_double_velocity;
+ math->md_n_arg = mp_double_n_arg;
+ math->md_m_log = mp_double_m_log;
+ math->md_m_exp = mp_double_m_exp;
+ math->md_m_unif_rand = mp_double_m_unif_rand;
+ math->md_m_norm_rand = mp_double_m_norm_rand;
+ math->md_pyth_add = mp_double_pyth_add;
+ math->md_pyth_sub = mp_double_pyth_sub;
+ math->md_power_of = mp_double_power_of;
+ math->md_fraction_to_scaled = mp_number_fraction_to_scaled;
+ math->md_scaled_to_fraction = mp_number_scaled_to_fraction;
+ math->md_scaled_to_angle = mp_number_scaled_to_angle;
+ math->md_angle_to_scaled = mp_number_angle_to_scaled;
+ math->md_init_randoms = mp_init_randoms;
+ math->md_sin_cos = mp_double_sin_cos;
+ math->md_slow_add = mp_double_slow_add;
+ math->md_sqrt = mp_double_square_rt;
+ math->md_print = mp_double_print_number;
+ math->md_tostring = mp_double_number_tostring;
+ math->md_modulo = mp_number_modulo;
+ math->md_ab_vs_cd = mp_ab_vs_cd;
+ math->md_crossing_point = mp_double_crossing_point;
+ math->md_scan_numeric = mp_double_scan_numeric_token;
+ math->md_scan_fractional = mp_double_scan_fractional_token;
+ math->md_free_math = mp_free_double_math;
+ math->md_set_precision = mp_double_set_precision;
+ return math;
+}
+
+void mp_double_set_precision (MP mp)
+{
+ (void) mp;
+}
+
+void mp_free_double_math (MP mp)
+{
+ mp_free_number(mp, &(mp->math->md_three_sixty_deg_t));
+ mp_free_number(mp, &(mp->math->md_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_negative_one_eighty_deg_t));
+ mp_free_number(mp, &(mp->math->md_fraction_one_t));
+ mp_free_number(mp, &(mp->math->md_zero_t));
+ mp_free_number(mp, &(mp->math->md_half_unit_t));
+ mp_free_number(mp, &(mp->math->md_three_quarter_unit_t));
+ mp_free_number(mp, &(mp->math->md_unity_t));
+ mp_free_number(mp, &(mp->math->md_two_t));
+ mp_free_number(mp, &(mp->math->md_three_t));
+ mp_free_number(mp, &(mp->math->md_one_third_inf_t));
+ mp_free_number(mp, &(mp->math->md_inf_t));
+ mp_free_number(mp, &(mp->math->md_negative_inf_t));
+ mp_free_number(mp, &(mp->math->md_warning_limit_t));
+ mp_free_number(mp, &(mp->math->md_one_k));
+ mp_free_number(mp, &(mp->math->md_sqrt_8_e_k));
+ mp_free_number(mp, &(mp->math->md_twelve_ln_2_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_k));
+ mp_free_number(mp, &(mp->math->md_coef_bound_minus_1));
+ mp_free_number(mp, &(mp->math->md_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_fraction_threshold_t));
+ mp_free_number(mp, &(mp->math->md_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_half_scaled_threshold_t));
+ mp_free_number(mp, &(mp->math->md_near_zero_angle_t));
+ mp_free_number(mp, &(mp->math->md_p_over_v_threshold_t));
+ mp_free_number(mp, &(mp->math->md_equation_threshold_t));
+ mp_memory_free(mp->math);
+}
+
+@ Creating an destroying |mp_number| objects
+
+@ @c
+void mp_allocate_number (MP mp, mp_number *n, mp_number_type t)
+{
+ (void) mp;
+ n->data.dval = 0.0;
+ n->type = t;
+}
+
+@ @c
+void mp_allocate_clone (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.dval = v->data.dval;
+}
+
+@ @c
+void mp_allocate_abs (MP mp, mp_number *n, mp_number_type t, mp_number *v)
+{
+ (void) mp;
+ n->type = t;
+ n->data.dval = fabs(v->data.dval);
+}
+
+@ @c
+void mp_allocate_double (MP mp, mp_number *n, double v)
+{
+ (void) mp;
+ n->type = mp_scaled_type;
+ n->data.dval = v;
+}
+
+@ @c
+void mp_free_number (MP mp, mp_number *n)
+{
+ (void) mp;
+ n->type = mp_nan_type;
+}
+
+@ Here are the low-level functions on |mp_number| items, setters first.
+
+@c
+void mp_set_double_from_int(mp_number *A, int B)
+{
+ A->data.dval = B;
+}
+
+void mp_set_double_from_boolean(mp_number *A, int B)
+{
+ A->data.dval = B;
+}
+
+void mp_set_double_from_scaled(mp_number *A, int B)
+{
+ A->data.dval = B / 65536.0;
+}
+
+void mp_set_double_from_double(mp_number *A, double B)
+{
+ A->data.dval = B;
+}
+
+void mp_set_double_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval + C->data.dval;
+}
+
+void mp_set_double_half_from_addition(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = (B->data.dval + C->data.dval) / 2.0;
+}
+
+void mp_set_double_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval - C->data.dval;
+}
+
+void mp_set_double_half_from_subtraction(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = (B->data.dval - C->data.dval) / 2.0;
+}
+
+void mp_set_double_from_div(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval / C->data.dval;
+}
+
+void mp_set_double_from_mul(mp_number *A, mp_number *B, mp_number *C)
+{
+ A->data.dval = B->data.dval * C->data.dval;
+}
+
+void mp_set_double_from_int_div(mp_number *A, mp_number *B, int C)
+{
+ A->data.dval = B->data.dval / C;
+}
+
+void mp_set_double_from_int_mul(mp_number *A, mp_number *B, int C)
+{
+ A->data.dval = B->data.dval * C;
+}
+
+void mp_set_double_from_of_the_way (MP mp, mp_number *A, mp_number *t, mp_number *B, mp_number *C)
+{
+ (void) mp;
+ A->data.dval = B->data.dval - mp_double_take_fraction(B->data.dval - C->data.dval, t->data.dval);
+}
+
+void mp_number_negate(mp_number *A)
+{
+ A->data.dval = -A->data.dval;
+ if (A->data.dval == -0.0) {
+ A->data.dval = 0.0;
+ }
+}
+
+void mp_number_add(mp_number *A, mp_number *B)
+{
+ A->data.dval = A->data.dval + B->data.dval;
+}
+
+void mp_number_subtract(mp_number *A, mp_number *B)
+{
+ A->data.dval = A->data.dval - B->data.dval;
+}
+
+void mp_number_half(mp_number *A)
+{
+ A->data.dval = A->data.dval / 2.0;
+}
+
+void mp_number_double(mp_number *A)
+{
+ A->data.dval = A->data.dval * 2.0;
+}
+
+void mp_number_add_scaled(mp_number *A, int B)
+{
+ /* also for negative B */
+ A->data.dval = A->data.dval + (B / 65536.0);
+}
+
+void mp_number_multiply_int(mp_number *A, int B)
+{
+ A->data.dval = (double)(A->data.dval * B);
+}
+
+void mp_number_divide_int(mp_number *A, int B)
+{
+ A->data.dval = A->data.dval / (double)B;
+}
+
+void mp_double_abs(mp_number *A)
+{
+ A->data.dval = fabs(A->data.dval);
+}
+
+void mp_number_clone(mp_number *A, mp_number *B)
+{
+ A->data.dval = B->data.dval;
+}
+
+void mp_number_negated_clone(mp_number *A, mp_number *B)
+{
+ A->data.dval = -B->data.dval;
+ if (A->data.dval == -0.0) {
+ A->data.dval = 0.0;
+ }
+}
+
+void mp_number_abs_clone(mp_number *A, mp_number *B)
+{
+ A->data.dval = fabs(B->data.dval);
+}
+
+void mp_number_swap(mp_number *A, mp_number *B)
+{
+ double swap_tmp = A->data.dval;
+ A->data.dval = B->data.dval;
+ B->data.dval = swap_tmp;
+}
+
+void mp_number_fraction_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ A->data.dval = A->data.dval / fraction_multiplier;
+}
+
+void mp_number_angle_to_scaled(mp_number *A)
+{
+ A->type = mp_scaled_type;
+ A->data.dval = A->data.dval / angle_multiplier;
+}
+
+void mp_number_scaled_to_fraction(mp_number *A)
+{
+ A->type = mp_fraction_type;
+ A->data.dval = A->data.dval * fraction_multiplier;
+}
+
+void mp_number_scaled_to_angle(mp_number *A)
+{
+ A->type = mp_angle_type;
+ A->data.dval = A->data.dval * angle_multiplier;
+}
+
+@ Query functions
+@c
+int mp_number_to_scaled(mp_number *A)
+{
+ return (int) lround(A->data.dval * 65536.0);
+}
+
+int mp_number_to_int(mp_number *A)
+{
+ return (int) (A->data.dval);
+}
+
+int mp_number_to_boolean(mp_number *A)
+{
+ return (int) (A->data.dval);
+}
+
+double mp_number_to_double(mp_number *A)
+{
+ return A->data.dval;
+}
+
+int mp_number_odd(mp_number *A)
+{
+ return odd((int) lround(A->data.dval));
+}
+
+int mp_number_equal(mp_number *A, mp_number *B)
+{
+ return A->data.dval == B->data.dval;
+}
+
+int mp_number_greater(mp_number *A, mp_number *B)
+{
+ return A->data.dval > B->data.dval;
+}
+
+int mp_number_less(mp_number *A, mp_number *B)
+{
+ return A->data.dval < B->data.dval;
+}
+
+int mp_number_nonequalabs(mp_number *A, mp_number *B)
+{
+ return fabs(A->data.dval) != fabs(B->data.dval);
+}
+
+@ Fixed-point arithmetic is done on {\sl scaled integers} that are multiples of
+$2^{-16}$. In other words, a binary point is assumed to be sixteen bit positions
+from the right end of a binary computer word.
+
+@ One of \MP's most common operations is the calculation of $\lfloor {a+b\over2}
+\rfloor$, the midpoint of two given integers |a| and~|b|. The most decent way to
+do this is to write |(a+b)/2|; but on many machines it is more efficient to
+calculate |(a+b)>>1|.
+
+Therefore the midpoint operation will always be denoted by |half(a+b)| in this
+program. If \MP\ is being implemented with languages that permit binary shifting,
+the |half| macro should be changed to make this operation as efficient as
+possible. Since some systems have shift operators that can only be trusted to
+work on positive numbers, there is also a macro |halfp| that is used only when
+the quantity being halved is known to be positive or zero.
+
+@ Here is a procedure analogous to |print_int|. The current version is fairly
+stupid, and it is not round-trip safe, but this is good enough for a beta test.
+
+@c
+char *mp_double_number_tostring (MP mp, mp_number *n)
+{
+ static char set[64];
+ int l = 0;
+ char *ret = mp_memory_allocate(64);
+ (void) mp;
+ snprintf(set, 64, "%.17g", n->data.dval);
+ while (set[l] == ' ') {
+ l++;
+ }
+ strcpy(ret, set+l);
+ return ret;
+}
+
+@ @c
+void mp_double_print_number (MP mp, mp_number *n)
+{
+ char *str = mp_double_number_tostring(mp, n);
+ mp_print_e_str(mp, str);
+ mp_memory_free(str);
+}
+
+@ Addition is not always checked to make sure that it doesn't overflow, but in
+places where overflow isn't too unlikely the |slow_add| routine is used.
+
+@c
+void mp_double_slow_add (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ double x = x_orig->data.dval;
+ double y = y_orig->data.dval;
+ if (x >= 0.0) {
+ if (y <= EL_GORDO - x) {
+ ret->data.dval = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ }
+ } else if (-y <= EL_GORDO + x) {
+ ret->data.dval = x + y;
+ } else {
+ mp->arith_error = 1;
+ ret->data.dval = negative_EL_GORDO;
+ }
+}
+
+@ The |make_fraction| routine produces the |fraction| equivalent of |p/q|, given
+integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are positive. If |p| and
+|q| are both of the same scaled type |t|, the \quote {type relation}
+|make_fraction(t,t)=fraction| is valid; and it's also possible to use the
+subroutine \quote {backwards,} using the relation |make_fraction(t,fraction)=t|
+between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_fraction| sets
+|arith_error:=true|. Most of \MP's internal computations have been designed to
+avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical machine, we
+could simply compute |(@t$2^{28}$@>*p)div q|, since a double-precision product
+can often be input to a fixed-point division instruction. But when we are
+restricted to int-eger arithmetic it is necessary either to resort to
+multiple-precision maneuvering or to use a simple but slow iteration. The
+multiple-precision technique would be about three times faster than the code
+adopted here, but it would be comparatively long and tricky, involving about
+sixteen additional multiplications and divisions.
+
+This operation is part of \MP's \quote {inner loop}; indeed, it will consume nearly
+10\pct! of the running time (exclusive of input and output) if the code below is
+left unchanged. A machine-dependent recoding will therefore make \MP\ run faster.
+The present implementation is highly portable, but slow; it avoids multiplication
+and division except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical results in all
+cases. @^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the \quote {inner loop,}
+such changes aren't advisable; simplicity and robustness are preferable to
+trickery, unless the cost is too high. @^inner loop@>
+
+@c
+void mp_double_number_make_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q) {
+ (void) mp;
+ ret->data.dval = mp_double_make_fraction(p->data.dval, q->data.dval);
+}
+
+@ The dual of |make_fraction| is |take_fraction|, which multiplies a given
+integer~|q| by a fraction~|f|. When the operands are positive, it computes
+$p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function of |q| and~|f|.
+
+This routine is even more \quote {inner loopy} than |make_fraction|; the present
+implementation consumes almost 20\pct! of \MP's computation time during typical
+jobs, so a machine-language substitute is advisable. @^inner loop@> @^system
+dependencies@>
+
+@c
+void mp_double_number_take_fraction (MP mp, mp_number *ret, mp_number *p, mp_number *q) {
+ (void) mp;
+ ret->data.dval = mp_double_take_fraction(p->data.dval, q->data.dval);
+}
+
+@ When we want to multiply something by a |scaled| quantity, we use a scheme
+analogous to |take_fraction| but with a different scaling. Given positive
+operands, |take_scaled| computes the quantity $p=\lfloor
+qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use a machine-language replacement if possible;
+otherwise |take_scaled| will use more than 2\pct! of the running time when the
+Computer Modern fonts are being generated. @^inner loop@>
+
+@c
+void mp_double_number_take_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ (void) mp;
+ ret->data.dval = p_orig->data.dval * q_orig->data.dval;
+}
+
+@ For completeness, there's also |make_scaled|, which computes a quotient as a
+|scaled| number instead of as a |fraction|. In other words, the result is
+$\lfloor2^{16}p/q+{1\over2}\rfloor$, if the operands are positive. \ (This
+procedure is not used especially often, so it is not part of \MP's inner loop.)
+
+@c
+void mp_double_number_make_scaled (MP mp, mp_number *ret, mp_number *p_orig, mp_number *q_orig)
+{
+ (void) mp;
+ ret->data.dval = p_orig->data.dval / q_orig->data.dval;
+}
+
+@ @* Scanning numbers in the input.
+
+@ @c
+void mp_wrapup_numeric_token (MP mp, unsigned char *start, unsigned char *stop)
+{
+ double result;
+ char *end = (char *) stop;
+ errno = 0;
+ result = strtod((char *) start, &end);
+ if (errno == 0) {
+ set_cur_mod(result);
+ if (result >= warning_limit) {
+ if (internal_value(mp_warning_check_internal).data.dval > 0 && (mp->scanner_status != mp_tex_flushing_state)) {
+ char msg[256];
+ mp_snprintf(msg, 256, "Number is too large (%g)", result);
+ @.Number is too large@>
+ mp_error(
+ mp,
+ msg,
+ "Continue and I'll try to cope with that big value; but it might be dangerous."
+ "(Set warningcheck := 0 to suppress this message.)"
+ );
+ }
+ }
+ } else if (mp->scanner_status != mp_tex_flushing_state) {
+ mp_error(
+ mp,
+ "Enormous number has been reduced.",
+ "I could not handle this number specification probably because it is out of"
+ "range."
+ );
+ @.Enormous number...@>
+ set_cur_mod(EL_GORDO);
+ }
+ set_cur_cmd(mp_numeric_command);
+}
+
+@ @c
+static void mp_double_aux_find_exponent (MP mp)
+{
+ if (mp->buffer[mp->cur_input.loc_field] == 'e' || mp->buffer[mp->cur_input.loc_field] == 'E') {
+ mp->cur_input.loc_field++;
+ if (!(mp->buffer[mp->cur_input.loc_field] == '+'
+ || mp->buffer[mp->cur_input.loc_field] == '-'
+ || mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class)) {
+ mp->cur_input.loc_field--;
+ return;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '+'
+ || mp->buffer[mp->cur_input.loc_field] == '-') {
+ mp->cur_input.loc_field++;
+ }
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+}
+
+void mp_double_scan_fractional_token (MP mp, int n) /* n is scaled */
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ mp_double_aux_find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+@ Input format is the same as for the C language, so we just collect valid bytes
+in the buffer, then call |strtod()|. It looks like we have no buffer overflow
+check here. (Needs checking!)
+
+@c
+void mp_double_scan_numeric_token (MP mp, int n) /* n is scaled */
+{
+ unsigned char *start = &mp->buffer[mp->cur_input.loc_field -1];
+ unsigned char *stop;
+ (void) n;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ if (mp->buffer[mp->cur_input.loc_field] == '.' && mp->buffer[mp->cur_input.loc_field+1] != '.') {
+ mp->cur_input.loc_field++;
+ while (mp->char_class[mp->buffer[mp->cur_input.loc_field]] == mp_digit_class) {
+ mp->cur_input.loc_field++;
+ }
+ }
+ mp_double_aux_find_exponent(mp);
+ stop = &mp->buffer[mp->cur_input.loc_field-1];
+ mp_wrapup_numeric_token(mp, start, stop);
+}
+
+@ The |scaled| quantities in \MP\ programs are generally supposed to be less than
+$2^{12}$ in absolute value, so \MP\ does much of its internal arithmetic with
+28~significant bits of precision. A |fraction| denotes a scaled integer whose
+binary point is assumed to be 28 bit positions from the right.
+
+@ Here is a typical example of how the routines above can be used. It computes
+the function $${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+(\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$
+where $\tau$ is a |scaled| \quote {tension} parameter. This is \MP's magic fudge
+factor for placing the first control point of a curve that starts at an angle
+$\theta$ and ends at an angle $\phi$ from the straight path. (Actually, if the
+stated quantity exceeds 4, \MP\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using relations
+such as $\sin\theta\cos\theta|1\over2|$.) Thus the numerator is positive; and
+since the tension $\tau$ is constrained to be at least $3\over4$, the numerator
+is less than $16\over3$. The denominator is nonnegative and at most~6.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction|
+arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+@c
+void mp_double_velocity (MP mp, mp_number *ret, mp_number *st, mp_number *ct, mp_number *sf, mp_number *cf, mp_number *t)
+{
+ double acc, num, denom; /* registers for intermediate calculations */
+ (void) mp;
+ acc = mp_double_take_fraction(st->data.dval - (sf->data.dval / 16.0), sf->data.dval - (st->data.dval / 16.0));
+ acc = mp_double_take_fraction(acc, ct->data.dval - cf->data.dval);
+ num = fraction_two + mp_double_take_fraction(acc, sqrt(2)*fraction_one);
+ denom = fraction_three
+ + mp_double_take_fraction(ct->data.dval, 3*fraction_half*(sqrt(5.0)-1.0))
+ + mp_double_take_fraction(cf->data.dval, 3*fraction_half*(3.0-sqrt(5.0)));
+ if (t->data.dval != unity) {
+ num = mp_double_make_scaled(num, t->data.dval);
+ }
+ if (num / 4 >= denom) {
+ ret->data.dval = fraction_four;
+ } else {
+ ret->data.dval = mp_double_make_fraction(num, denom);
+ }
+}
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is greater
+than, equal to, or less than~$cd$, given integers $(a,b,c,d)$. In most cases a
+quick decision is reached. The result is $+1$, 0, or~$-1$ in the three respective
+cases.
+
+@c
+int mp_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ return mp_double_ab_vs_cd(a_orig, b_orig, c_orig, d_orig);
+}
+
+@ @<Reduce to the case that |a...@>=
+if (a < 0) {
+ a = -a;
+ b = -b;
+}
+if (c < 0) {
+ c = -c;
+ d = -d;
+}
+if (d <= 0) {
+ if (b >= 0) {
+ if ((a == 0 || b == 0) && (c == 0 || d == 0)) {
+ ret->data.dval = 0;
+ } else {
+ ret->data.dval = 1;
+ }
+ goto RETURN;
+ } if (d == 0) {
+ ret->data.dval = (a == 0 ? 0 : -1);
+ goto RETURN;
+ } else
+ q = a;
+ a = c;
+ c = q;
+ q = -b;
+ b = -d;
+ d = q;
+ }
+} else if (b <= 0) {
+ if (b < 0 && a > 0) {
+ ret->data.dval = -1;
+ return;
+ } else
+ ret->data.dval = (c == 0 ? 0 : -1);
+ goto RETURN;
+ }
+}
+
+@ Now here's a subroutine that's handy for all sorts of path computations: Given
+a quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function returns the
+unique |fraction| value |t| between 0 and~1 at which $B(a,b,c;t)$ changes from
+positive to negative, or returns |t=fraction_one+1| if no such value exists. If
+|a<0| (so that $B(a,b,c;t)$ is already negative at |t=0|), |crossing_point|
+returns the value zero.
+
+The general bisection method is quite simple when $n=2$, hence |crossing_point|
+does not take much time. At each stage in the recursion we have a subinterval
+defined by |l| and~|j| such that $B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we
+want to \quote {zero in} on the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values of |l| and~|j|
+in a single variable $d=2^l+j$, because the operation of bisection then
+corresponds simply to doubling $d$ and possibly adding~1. Furthermore it proves
+to be convenient to modify our previous conventions for bisection slightly,
+maintaining the variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and
+$X_2=2^l(x_1-x_2)$. With these variables the conditions $x_0\ge0$ and
+$\min(x_1,x_2)<0$ are equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L|x0|<\max(|x1|,|x1|+|x2|)$, $\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow will occur if
+the inputs satisfy $a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert
+b-c\vert<2^{30}$.
+
+@c
+static void mp_double_crossing_point (MP mp, mp_number *ret, mp_number *aa, mp_number *bb, mp_number *cc)
+{
+ double d; /* recursive counter */
+ double xx, x0, x1, x2; /* temporary registers for bisection */
+ double a = aa->data.dval;
+ double b = bb->data.dval;
+ double c = cc->data.dval;
+ (void) mp;
+ if (a < 0.0) {
+ ret->data.dval = zero_crossing;
+ return;
+ }
+ if (c >= 0.0) {
+ if (b >= 0.0) {
+ if (c > 0.0) {
+ ret->data.dval = no_crossing;
+ } else if ((a == 0.0) && (b == 0.0)) {
+ ret->data.dval = no_crossing;
+ } else {
+ ret->data.dval = one_crossing;
+ }
+ return;
+ }
+ if (a == 0.0) {
+ ret->data.dval = zero_crossing;
+ return;
+ }
+ } else if ((a == 0.0) && (b <= 0.0)) {
+ ret->data.dval = zero_crossing;
+ return;
+ }
+ /* Use bisection to find the crossing point... */
+ d = epsilon;
+ x0 = a;
+ x1 = a - b;
+ x2 = b - c;
+ do {
+ /* not sure why the error correction has to be >= 1E-12 */
+ double x = (x1 + x2) / 2 + 1E-12;
+ if (x1 - x0 > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ xx = x1 + x - x0;
+ if (xx > x0) {
+ x2 = x;
+ x0 += x0;
+ d += d;
+ } else {
+ x0 = x0 - xx;
+ if ((x <= x0) && (x + x2 <= x0)) {
+ ret->data.dval = no_crossing;
+ return;
+ }
+ x1 = x;
+ d = d + d + epsilon;
+ }
+ }
+ } while (d < fraction_one);
+ ret->data.dval = (d - fraction_one);
+}
+
+@ We conclude this set of elementary routines with some simple rounding and
+truncation operations.
+
+@ |round_unscaled| rounds a |scaled| and converts it to |int|
+@c
+int mp_round_unscaled(mp_number *x_orig)
+{
+ return (int) lround(x_orig->data.dval);
+}
+
+@ |number_floor| floors a number
+
+@c
+void mp_number_floor(mp_number *i)
+{
+ i->data.dval = floor(i->data.dval);
+}
+
+@ |fraction_to_scaled| rounds a |fraction| and converts it to |scaled|
+
+@c
+void mp_double_fraction_to_round_scaled(mp_number *x_orig)
+{
+ double x = x_orig->data.dval;
+ x_orig->type = mp_scaled_type;
+ x_orig->data.dval = x/fraction_multiplier;
+}
+
+@* Algebraic and transcendental functions. \MP\ computes all of the necessary
+special functions from scratch, without relying on |real| arithmetic or system
+subroutines for sines, cosines, etc.
+
+@ @c
+void mp_double_square_rt (MP mp, mp_number *ret, mp_number *x_orig) /* return, x: scaled */
+{
+ double x = x_orig->data.dval;
+ if (x > 0) {
+ ret->data.dval = sqrt(x);
+ } else {
+ if (x < 0) {
+ char msg[256];
+ char *xstr = mp_double_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Square root of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ @.Square root...replaced by 0@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ ret->data.dval = 0;
+ }
+}
+
+@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by a quick hack
+
+@c
+void mp_double_pyth_add (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ double a = fabs(a_orig->data.dval);
+ double b = fabs(b_orig->data.dval);
+ errno = 0;
+ ret->data.dval = sqrt(a*a + b*b);
+ if (errno) {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ }
+}
+
+@ Here is a similar algorithm for $\psqrt{a^2-b^2}$. Same quick hack, also.
+
+@c
+void mp_double_pyth_sub (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ double a = fabs(a_orig->data.dval);
+ double b = fabs(b_orig->data.dval);
+ if (a > b) {
+ a = sqrt(a*a - b*b);
+ } else {
+ if (a < b) {
+ char msg[256];
+ char *astr = mp_double_number_tostring(mp, a_orig);
+ char *bstr = mp_double_number_tostring(mp, b_orig);
+ mp_snprintf(msg, 256, "Pythagorean subtraction %s+-+%s has been replaced by 0", astr, bstr);
+ mp_memory_free(astr);
+ mp_memory_free(bstr);
+ @.Pythagorean...@>
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take square roots of negative numbers, Im zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ }
+ a = 0;
+ }
+ ret->data.dval = a;
+}
+
+@ This power one is simple:
+
+@c
+void mp_double_power_of (MP mp, mp_number *ret, mp_number *a_orig, mp_number *b_orig)
+{
+ errno = 0;
+ ret->data.dval = pow(a_orig->data.dval, b_orig->data.dval);
+ if (errno) {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ }
+}
+
+@ The subroutines for logarithm and exponential involve two tables. The first is
+simple: |two_to_the[k]| equals $2^k$.
+
+@ Here is the routine that calculates $2^8$ times the natural logarithm of a
+|scaled| quantity; it is an integer approximation to $2^{24}\ln(x/2^{16})$, when
+|x| is a given positive integer.
+
+@c
+void mp_double_m_log (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ if (x_orig->data.dval > 0) {
+ ret->data.dval = log(x_orig->data.dval)*256.0;
+ } else {
+ char msg[256];
+ char *xstr = mp_double_number_tostring(mp, x_orig);
+ mp_snprintf(msg, 256, "Logarithm of %s has been replaced by 0", xstr);
+ mp_memory_free(xstr);
+ mp_error(
+ mp,
+ msg,
+ "Since I don't take logs of non-positive numbers, I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.dval = 0;
+ }
+}
+
+@ Conversely, the exponential routine calculates $\exp(x/2^8)$, when |x| is
+|scaled|.
+
+@c
+void mp_double_m_exp (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ errno = 0;
+ ret->data.dval = exp(x_orig->data.dval/256.0);
+ if (errno) {
+ if (x_orig->data.dval > 0) {
+ mp->arith_error = 1;
+ ret->data.dval = EL_GORDO;
+ } else {
+ ret->data.dval = 0;
+ }
+ }
+}
+
+@ Given integers |x| and |y|, not both zero, the |n_arg| function returns the
+|angle| whose tangent points in the direction $(x,y)$.
+
+@c
+void mp_double_n_arg (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig)
+{
+ if (x_orig->data.dval == 0.0 && y_orig->data.dval == 0.0) {
+ mp_error(
+ mp,
+ "angle(0,0) is taken as zero",
+ "The 'angle' between two identical points is undefined. I'm zeroing this one.\n"
+ "Proceed, with fingers crossed."
+ );
+ ret->data.dval = 0;
+ } else {
+ ret->type = mp_angle_type;
+ ret->data.dval = atan2(y_orig->data.dval, x_orig->data.dval) * (180.0 / PI) * angle_multiplier;
+ if (ret->data.dval == -0.0)
+ ret->data.dval = 0.0;
+ }
+}
+
+@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine and
+cosine of that angle. The results of this routine are stored in global integer
+variables |n_sin| and |n_cos|.
+
+@ Given an integer |z| that is $2^{20}$ times an angle $\theta$ in degrees, the
+purpose of |n_sin_cos(z)| is to set |x=@t$r\cos\theta$@>| and
+|y=@t$r\sin\theta$@>| (approximately), for some rather large number~|r|. The
+maximum of |x| and |y| will be between $2^{28}$ and $2^{30}$, so that there will
+be hardly any loss of accuracy. Then |x| and~|y| are divided by~|r|.
+
+@ Compute a multiple of the sine and cosine
+
+@c
+void mp_double_sin_cos (MP mp, mp_number *z_orig, mp_number *n_cos, mp_number *n_sin)
+{
+ double rad = (z_orig->data.dval / angle_multiplier); /* still degrees */
+ (void) mp;
+ if ((rad == 90.0) || (rad == -270)){
+ n_cos->data.dval = 0.0;
+ n_sin->data.dval = fraction_multiplier;
+ } else if ((rad == -90.0) || (rad == 270.0)) {
+ n_cos->data.dval = 0.0;
+ n_sin->data.dval = -fraction_multiplier;
+ } else if ((rad == 180.0) || (rad == -180.0)) {
+ n_cos->data.dval = -fraction_multiplier;
+ n_sin->data.dval = 0.0;
+ } else {
+ rad = rad * PI/180.0;
+ n_cos->data.dval = cos(rad) * fraction_multiplier;
+ n_sin->data.dval = sin(rad) * fraction_multiplier;
+ }
+}
+
+@ This is the http://www-cs-faculty.stanford.edu/~uno/programs/rng.c with small
+cosmetic modifications.
+
+@c
+# define KK 100 /* the long lag */
+# define LL 37 /* the short lag */
+# define MM (1L<<30) /* the modulus */
+# define mod_diff(x,y) (((x)-(y))&(MM-1)) /* subtraction mod MM */
+# define TT 70 /* guaranteed separation between streams */
+# define is_odd(x) ((x)&1) /* units bit of x */
+# define QUALITY 1009 /* recommended quality level for high-res use */
+
+/* destination, array length (must be at least KK) */
+
+typedef struct mp_double_random_info {
+ long x[KK];
+ long buf[QUALITY];
+ long dummy;
+ long started;
+ long *ptr;
+} mp_double_random_info;
+
+mp_double_random_info mp_double_random_data = {
+ .dummy = -1,
+ .started = -1,
+ .ptr = &mp_double_random_data.dummy
+};
+
+/* the following routines are from exercise 3.6--15 */
+/* after calling |mp_aux_ran_start|, get new randoms by, e.g., |x=mp_aux_ran_arr_next()| */
+
+static void mp_double_aux_ran_array(long aa[], int n)
+{
+ int i, j;
+ for (j = 0; j < KK; j++) {
+ aa[j] = mp_double_random_data.x[j];
+ }
+ for (; j < n; j++) {
+ aa[j] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (i = 0; i < LL; i++, j++) {
+ mp_double_random_data.x[i] = mod_diff(aa[j - KK], aa[j - LL]);
+ }
+ for (; i < KK; i++, j++) {
+ mp_double_random_data.x[i] = mod_diff(aa[j - KK], mp_double_random_data.x[i - LL]);
+ }
+}
+
+/* Do this before using |mp_aux_ran_array|, long seed selector for different streams. */
+
+static void mp_double_aux_ran_start(long seed)
+{
+ int t, j;
+ long x[KK + KK - 1]; /* the preparation buffer */
+ long ss = (seed+2) & (MM - 2);
+ for (j = 0; j < KK; j++) {
+ /* bootstrap the buffer */
+ x[j] = ss;
+ /* cyclic shift 29 bits */
+ ss <<= 1;
+ if (ss >= MM) {
+ ss -= MM - 2;
+ }
+ }
+ /* make x[1] (and only x[1]) odd */
+ x[1]++;
+ for (ss = seed & (MM - 1), t = TT - 1; t;) {
+ for (j = KK - 1; j > 0; j--) {
+ /* "square" */
+ x[j + j] = x[j];
+ x[j + j - 1] = 0;
+ }
+ for (j = KK + KK - 2; j >= KK; j--) {
+ x[j - (KK -LL)] = mod_diff(x[j - (KK - LL)], x[j]);
+ x[j - KK] = mod_diff(x[j - KK], x[j]);
+ }
+ if (is_odd(ss)) {
+ /* "multiply by z" */
+ for (j = KK; j>0; j--) {
+ x[j] = x[j-1];
+ }
+ x[0] = x[KK];
+ /* shift the buffer cyclically */
+ x[LL] = mod_diff(x[LL], x[KK]);
+ }
+ if (ss) {
+ ss >>= 1;
+ } else {
+ t--;
+ }
+ }
+ for (j = 0; j < LL; j++) {
+ mp_double_random_data.x[j + KK - LL] = x[j];
+ }
+ for (;j < KK; j++) {
+ mp_double_random_data.x[j - LL] = x[j];
+ }
+ for (j = 0; j < 10; j++) {
+ /* warm things up */
+ mp_double_aux_ran_array(x, KK + KK - 1);
+ }
+ mp_double_random_data.ptr = &mp_double_random_data.started;
+}
+
+# define mp_double_aux_ran_arr_next() (*mp_double_random_data.ptr>=0? *mp_double_random_data.ptr++: mp_double_aux_ran_arr_cycle())
+
+static long mp_double_aux_ran_arr_cycle(void)
+{
+ if (mp_double_random_data.ptr == &mp_double_random_data.dummy) {
+ /* the user forgot to initialize */
+ mp_double_aux_ran_start(314159L);
+ }
+ mp_double_aux_ran_array(mp_double_random_data.buf, QUALITY);
+ mp_double_random_data.buf[KK] = -1;
+ mp_double_random_data.ptr = mp_double_random_data.buf + 1;
+ return mp_double_random_data.buf[0];
+}
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@c
+void mp_init_randoms (MP mp, int seed)
+{
+ int k = 1;
+ int j = abs(seed);
+ int f = (int) fraction_one; /* avoid warnings */
+ while (j >= f) {
+ j = j/2;
+ }
+ for (int i = 0; i <= 54; i++) {
+ int jj = k;
+ k = j - k;
+ j = jj;
+ if (k < 0) {
+ k += f;
+ }
+ mp->randoms[(i * 21) % 55].data.dval = j;
+ }
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ mp_new_randoms(mp);
+ /* warm up the array */
+ mp_double_aux_ran_start((unsigned long) seed);
+}
+
+@ Here |frac| contains what's beyond the |.|. @c
+/*
+static double modulus(double left, double right)
+{
+ double quota = left / right;
+ double tmp;
+ double frac = modf(quota, &tmp);
+ frac *= right;
+ return frac;
+}
+*/
+
+void mp_number_modulo(mp_number *a, mp_number *b)
+{
+ double tmp;
+ a->data.dval = modf((double) a->data.dval / (double) b->data.dval, &tmp) * (double) b->data.dval;
+}
+
+@ To consume a random integer for the uniform generator, the program below will
+say |next_unif_random|.
+
+@c
+static void mp_next_unif_random (MP mp, mp_number *ret)
+{
+ unsigned long int op = (unsigned) mp_double_aux_ran_arr_next();
+ double a = op / (MM * 1.0);
+ (void) mp;
+ ret->data.dval = a;
+}
+
+@ To consume a random fraction, the program below will say |next_random|.
+
+@c
+static void mp_next_random (MP mp, mp_number *ret)
+{
+ if ( mp->j_random==0) {
+ mp_new_randoms(mp);
+ } else {
+ mp->j_random = mp->j_random-1;
+ }
+ mp_number_clone(ret, &(mp->randoms[mp->j_random]));
+}
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x| or
+|0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x| with
+about half the probability that it will produce any other particular values
+between 0 and~|x|, because it rounds its answers.
+
+@c
+static void mp_double_m_unif_rand (MP mp, mp_number *ret, mp_number *x_orig)
+{
+ mp_number x, abs_x, u, y; /* |y| is trial value */
+ mp_allocate_number(mp, &y, mp_fraction_type);
+ mp_allocate_clone(mp, &x, mp_scaled_type, x_orig);
+ mp_allocate_abs(mp, &abs_x, mp_scaled_type, &x);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_next_unif_random(mp, &u);
+ y.data.dval = abs_x.data.dval * u.data.dval;
+ mp_free_number(mp, &u);
+ if (mp_number_equal(&y, &abs_x)) {
+ mp_number_clone(ret, &((math_data *)mp->math)->md_zero_t);
+ } else if (mp_number_greater(&x, &((math_data *)mp->math)->md_zero_t)) {
+ mp_number_clone(ret, &y);
+ } else {
+ mp_number_negated_clone(ret, &y);
+ }
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &x);
+ mp_free_number(mp, &y);
+}
+
+@ Finally, a normal deviate with mean zero and unit standard deviation can
+readily be obtained with the ratio method (Algorithm 3.4.1R in {\sl The Art of
+Computer Programming}).
+
+@c
+static void mp_double_m_norm_rand (MP mp, mp_number *ret)
+{
+ mp_number abs_x, u, r, la, xa;
+ mp_allocate_number(mp, &la, mp_scaled_type);
+ mp_allocate_number(mp, &xa, mp_scaled_type);
+ mp_allocate_number(mp, &abs_x, mp_scaled_type);
+ mp_allocate_number(mp, &u, mp_scaled_type);
+ mp_allocate_number(mp, &r, mp_scaled_type);
+ do {
+ do {
+ mp_number v;
+ mp_allocate_number(mp, &v, mp_scaled_type);
+ mp_next_random(mp, &v);
+ mp_number_subtract(&v, &((math_data *)mp->math)->md_fraction_half_t);
+ mp_double_number_take_fraction(mp, &xa, &((math_data *)mp->math)->md_sqrt_8_e_k, &v);
+ mp_free_number(mp, &v);
+ mp_next_random(mp, &u);
+ mp_number_clone(&abs_x, &xa);
+ mp_double_abs(&abs_x);
+ } while (! mp_number_less(&abs_x, &u));
+ mp_double_number_make_fraction(mp, &r, &xa, &u);
+ mp_number_clone(&xa, &r);
+ mp_double_m_log(mp, &la, &u);
+ mp_set_double_from_subtraction(&la, &((math_data *)mp->math)->md_twelve_ln_2_k, &la);
+ } while (mp_double_ab_vs_cd(&((math_data *)mp->math)->md_one_k, &la, &xa, &xa) < 0);
+ mp_number_clone(ret, &xa);
+ mp_free_number(mp, &r);
+ mp_free_number(mp, &abs_x);
+ mp_free_number(mp, &la);
+ mp_free_number(mp, &xa);
+ mp_free_number(mp, &u);
+}
+
+@ The following subroutine is used only in |norm_rand| and tests if $ab$ is
+greater than, equal to, or less than~$cd$. The result is $+1$, 0, or~$-1$ in the
+three respective cases.
+
+@c
+int mp_double_ab_vs_cd (mp_number *a_orig, mp_number *b_orig, mp_number *c_orig, mp_number *d_orig)
+{
+ double ab = a_orig->data.dval * b_orig->data.dval;
+ double cd = c_orig->data.dval * d_orig->data.dval;
+ if (ab > cd) {
+ return 1;
+ } else if (ab < cd) {
+ return -1;
+ } else {
+ return 0;
+ }
+}
diff --git a/source/luametatex/source/mp/mpw/mpstrings.w b/source/luametatex/source/mp/mpw/mpstrings.w
new file mode 100644
index 000000000..07236bd9c
--- /dev/null
+++ b/source/luametatex/source/mp/mpw/mpstrings.w
@@ -0,0 +1,452 @@
+% This file is part of MetaPost. The MetaPost program is in the public domain.
+
+@* String handling.
+
+@ First, we will need some stuff from other files.
+@c
+# include "mpconfig.h"
+# include "mpstrings.h"
+
+@ Then there is some stuff we need to prepare ourselves.
+
+@(mpstrings.h@>=
+# ifndef MPSTRINGS_H
+# define MPSTRINGS_H 1
+
+# include "mp.h"
+
+@<Definitions@>
+
+# endif
+
+@ Here are the functions needed for the avl construction.
+
+@<Definitions@>=
+void *mp_aux_copy_strings_entry (const void *p);
+
+@ An earlier version of this function used |strncmp|, but that produces wrong
+results in some cases.
+
+@c
+# define STRCMP_RESULT(a) ((a) < 0 ? -1 : ((a) > 0 ? 1 : 0))
+
+static int mp_aux_comp_strings_entry(void *p, const void *pa, const void *pb)
+{
+ const mp_lstring *a = (const mp_lstring *) pa;
+ const mp_lstring *b = (const mp_lstring *) pb;
+ unsigned char *s = a->str;
+ unsigned char *t = b->str;
+ size_t l = a->len <= b->len ? a->len : b->len;
+ (void) p;
+ while (l-- > 0) {
+ if (*s != *t) {
+ return STRCMP_RESULT(*s - *t);
+ } else {
+ s++;
+ t++;
+ }
+ }
+ return STRCMP_RESULT((int)(a->len - b->len));
+}
+
+void *mp_aux_copy_strings_entry(const void *p)
+{
+ mp_string ff = mp_memory_allocate(sizeof(mp_lstring));
+ if (ff) {
+ const mp_lstring *fp = (const mp_lstring *) p;
+ ff->str = mp_memory_allocate((size_t) fp->len + 1);
+ if (ff->str) {
+ memcpy((char *) ff->str, (char *) fp->str, fp->len + 1);
+ ff->len = fp->len;
+ ff->refs = 0;
+ return ff;
+ }
+ }
+ return NULL;
+}
+
+static void *delete_strings_entry(void *p)
+{
+ mp_string ff = (mp_string) p;
+ mp_memory_free(ff->str);
+ mp_memory_free(ff);
+ return NULL;
+}
+
+@ Actually creating strings is done by |make_string|, but in order to do so it
+needs a way to create a new, empty string structure.
+
+@ @c
+static mp_string new_strings_entry(void)
+{
+ mp_string ff = mp_memory_allocate(sizeof(mp_lstring));
+ ff->str = NULL;
+ ff->len = 0;
+ ff->refs = 0;
+ return ff;
+}
+
+@ Some even more low-level functions are these:
+
+@<Definitions@>=
+extern char *mp_strdup (const char *s);
+extern char *mp_strndup (const char *s, size_t l);
+extern int mp_strcmp (const char *a, const char *b);
+
+@ @c
+char *mp_strdup(const char *s)
+{
+ if (s) {
+ char *w = lmt_memory_strdup(s);
+ if (w) {
+ return w;
+ } else {
+ printf("mplib ran out of memory, case 3");
+ exit(EXIT_FAILURE);
+ }
+ }
+ return NULL;
+}
+
+
+char *mp_strndup(const char *p, size_t l)
+{
+ if (p) {
+ char *r = mp_memory_allocate(l * sizeof(char) + 1);
+ if (r) {
+ char *s = memcpy(r, p, l);
+ *(s + l) = '\0';
+ return s;
+ } else {
+ printf("mplib ran out of memory, case 4");
+ exit(EXIT_FAILURE);
+ }
+ }
+ return NULL;
+}
+
+/*
+char *mp_strndup(const char *p, size_t l)
+{
+ if (p) {
+ char *w = strndup(p, l);
+ if (w) {
+ return w;
+ } else {
+ printf("mplib ran out of memory, case 4");
+ exit(EXIT_FAILURE);
+ }
+ }
+ return NULL;
+}
+*/
+
+int mp_strcmp(const char *a, const char *b)
+{
+ return a == NULL ? (b == NULL ? 0 : -1) : (b == NULL ? 1 : strcmp(a, b));
+}
+
+@ @c
+void mp_initialize_strings(MP mp)
+{
+ mp->strings = avl_create(mp_aux_comp_strings_entry, mp_aux_copy_strings_entry, delete_strings_entry, mp_memory_allocate, mp_memory_free, NULL);
+ mp->cur_string = NULL;
+ mp->cur_length = 0;
+ mp->cur_string_size = 0;
+}
+
+@ @c
+void mp_dealloc_strings(MP mp)
+{
+ if (mp->strings != NULL) {
+ avl_destroy(mp->strings);
+ } else {
+ mp->strings = NULL;
+ mp_memory_free(mp->cur_string);
+ mp->cur_string = NULL;
+ mp->cur_length = 0;
+ mp->cur_string_size = 0;
+ }
+}
+
+@ Here are the definitions:
+
+@<Definitions@>=
+extern void mp_initialize_strings (MP mp);
+extern void mp_dealloc_strings (MP mp);
+
+@ Most printing is done from |char *|s, but sometimes not. Here are functions
+that convert an internal string into a |char *| for use by the printing routines,
+and vice versa.
+
+@<Definitions@>=
+char *mp_str (MP mp, mp_string s);
+mp_string mp_rtsl (MP mp, const char *s, size_t l);
+mp_string mp_rts (MP mp, const char *s);
+mp_string mp_make_string (MP mp);
+
+@ @c
+char *mp_str(MP mp, mp_string ss)
+{
+ (void) mp;
+ return (char *) ss->str;
+}
+
+@ @c
+mp_string mp_rtsl(MP mp, const char *s, size_t l)
+{
+ mp_string nstr;
+ mp_string str = new_strings_entry();
+ str->str = (unsigned char *) mp_strndup(s, l);
+ str->len = l;
+ nstr = (mp_string) avl_find(str, mp->strings);
+ if (nstr == NULL) {
+ avl_ins(str, mp->strings, avl_false);
+ nstr = (mp_string) avl_find(str, mp->strings);
+ }
+ delete_strings_entry(str);
+ add_str_ref(nstr);
+ return nstr;
+}
+
+@ @c
+mp_string mp_rts(MP mp, const char *s)
+{
+ return mp_rtsl(mp, s, strlen(s));
+}
+
+@ Strings are created by appending character codes to |cur_string|. The
+|mp_append_char| function, defined here, does not check to see if the buffer overflows;
+this test is supposed to be made before |mp_append_char| is used.
+
+To test if there is room to append |l| more characters to |cur_string|, we shall
+write |str_room(l)|, which tries to make sure there is enough room in the
+|cur_string|.
+
+@<Definitions@>=
+extern void mp_append_char (MP mp, unsigned char c);
+extern void mp_append_str (MP mp, const char *s);
+extern void mp_str_room (MP mp, int wsize);
+
+@ @c
+# define EXTRA_STRING 500
+
+void mp_str_room(MP mp, int wsize)
+{
+ /* we always add one more */
+ if ((mp->cur_length + (size_t) wsize + 1) > mp->cur_string_size) {
+ size_t nsize = mp->cur_string_size + mp->cur_string_size / 5 + EXTRA_STRING;
+ if (nsize < (size_t) wsize) {
+ nsize = (size_t) wsize + EXTRA_STRING;
+ }
+ mp->cur_string = (unsigned char *) mp_memory_reallocate(mp->cur_string, (size_t) nsize * sizeof(unsigned char));
+ memset(mp->cur_string + mp->cur_length, 0, nsize-mp->cur_length);
+ mp->cur_string_size = nsize;
+ }
+}
+
+void mp_append_char(MP mp, unsigned char c)
+{
+ *(mp->cur_string + mp->cur_length) = c;
+ mp->cur_length++;
+}
+
+void mp_append_str(MP mp, const char *s)
+{
+ int j = 0;
+ while ((unsigned char) s[j]) {
+ *(mp->cur_string + mp->cur_length) = s[j++];
+ mp->cur_length++;
+ }
+}
+
+@ At the very start of the metapost run and each time after |make_string| has
+stored a new string in the avl tree, the |cur_string| variable has to be prepared
+so that it will be ready to start creating a new string. The initial size is
+fairly arbitrary, but setting it a little higher than expected helps prevent
+|reallocs|.
+
+@<Definitions@>=
+void mp_reset_cur_string (MP mp);
+
+@ @c
+void mp_reset_cur_string(MP mp)
+{
+ mp_memory_free(mp->cur_string);
+ mp->cur_length = 0;
+ mp->cur_string_size = 63;
+ mp->cur_string = (unsigned char *) mp_memory_allocate(64 * sizeof(unsigned char));
+ memset(mp->cur_string, 0, 64);
+}
+
+@ \MP's string expressions are implemented in a brute-force way: Every new string
+or substring that is needed is simply stored into the string pool. Space is
+eventually reclaimed using the aid of a simple system system of reference counts.
+@^reference counts@>
+
+The number of references to string number |s| will be |s->refs|. The special
+value |s->refs=MAX_STR_REF=127| is used to denote an unknown positive number of
+references; such strings will never be recycled. If a string is ever referred to
+more than 126 times, simultaneously, we put it in this category.
+
+@<Definitions@>=
+# define MAX_STR_REF 127 /* \quote {infinite} number of references */
+# define add_str_ref(A) { if ( (A)->refs < MAX_STR_REF ) ((A)->refs)++; }
+
+@ Here's what we do when a string reference disappears:
+
+@<Definitions@>=
+# define delete_str_ref(A) do { \
+ if ((A)->refs < MAX_STR_REF) { \
+ if ((A)->refs > 1) \
+ ((A)->refs)--; \
+ else \
+ mp_flush_string(mp, (A)); \
+ } \
+ } while (0)
+
+@ @<Definitions@>=
+void mp_flush_string (MP mp, mp_string s);
+
+@ @c
+void mp_flush_string(MP mp, mp_string s) {
+ if (s->refs == 0) {
+ mp->strs_in_use--;
+ mp->pool_in_use = mp->pool_in_use - (int) s->len;
+ avl_del(s, mp->strings, NULL);
+ }
+}
+
+@ Some C literals that are used as values cannot be simply added, their reference
+count has to be set such that they can not be flushed.
+
+@c
+mp_string mp_intern(MP mp, const char *s)
+{
+ mp_string r = mp_rts(mp, s);
+ r->refs = MAX_STR_REF;
+ return r;
+}
+
+@ @<Definitions@>=
+mp_string mp_intern (MP mp, const char *s);
+
+@ Once a sequence of characters has been appended to |cur_string|, it officially
+becomes a string when the function |make_string| is called. This function returns
+a pointer to the new string as its value.
+
+@<Definitions@>=
+mp_string mp_make_string (MP mp);
+
+@ @c
+mp_string mp_make_string(MP mp)
+{
+ /* current string enters the pool */
+ mp_string str;
+ mp_lstring tmp;
+ tmp.str = mp->cur_string;
+ tmp.len = mp->cur_length;
+ str = (mp_string) avl_find(&tmp, mp->strings);
+ if (str == NULL) {
+ str = mp_memory_allocate(sizeof(mp_lstring));
+ str->str = mp->cur_string;
+ str->len = tmp.len;
+ avl_ins(str, mp->strings, avl_false);
+ str = (mp_string) avl_find(&tmp, mp->strings);
+ mp->pool_in_use = mp->pool_in_use + (int) str->len;
+ if (mp->pool_in_use > mp->max_pl_used) {
+ mp->max_pl_used = mp->pool_in_use;
+ }
+ mp->strs_in_use++;
+ if (mp->strs_in_use > mp->max_strs_used) {
+ mp->max_strs_used = mp->strs_in_use;
+ }
+ }
+ add_str_ref(str);
+ mp_reset_cur_string (mp);
+ return str;
+}
+
+@ Here is a routine that compares two strings in the string pool, and it does not
+assume that they have the same length. If the first string is lexicographically
+greater than, less than, or equal to the second, the result is respectively
+positive, negative, or zero.
+
+@<Definitions@>=
+int mp_str_vs_str (MP mp, mp_string s, mp_string t);
+
+@ @c
+int mp_str_vs_str(MP mp, mp_string s, mp_string t)
+{
+ (void) mp;
+ return mp_aux_comp_strings_entry(NULL, (const void *) s, (const void *) t);
+}
+
+@ @<Definitions@>=
+mp_string mp_cat (MP mp, mp_string a, mp_string b);
+
+@ @c
+mp_string mp_cat(MP mp, mp_string a, mp_string b)
+{
+ mp_string str;
+ size_t saved_cur_length = mp->cur_length;
+ unsigned char *saved_cur_string = mp->cur_string;
+ size_t saved_cur_string_size = mp->cur_string_size;
+ size_t needed = a->len + b->len;
+ mp->cur_length = 0;
+ /* |mp->cur_string = NULL;| needs malloc, spotted by clang */
+ mp->cur_string = (unsigned char *) mp_memory_allocate((size_t) (needed + 1) * sizeof(unsigned char));
+ mp->cur_string_size = 0;
+ mp_str_room(mp, (int) needed + 1);
+ memcpy(mp->cur_string, a->str, a->len);
+ memcpy(mp->cur_string + a->len, b->str, b->len);
+ mp->cur_length = needed;
+ mp->cur_string[needed] = '\0';
+ str = mp_make_string(mp);
+ mp_memory_free(mp->cur_string); /* created by |mp_make_string| */
+ mp->cur_length = saved_cur_length;
+ mp->cur_string = saved_cur_string;
+ mp->cur_string_size = saved_cur_string_size;
+ return str;
+}
+
+@ @<Definitions@>=
+mp_string mp_chop_string (MP mp, mp_string s, int a, int b);
+
+@ @c
+mp_string mp_chop_string(MP mp, mp_string s, int a, int b)
+{
+ int l = (int) s->len;
+ int reversed;
+ if (a <= b) {
+ reversed = 0;
+ } else {
+ int k = a;
+ a = b;
+ b = k;
+ reversed = 1;
+ }
+ if (a < 0) {
+ a = 0;
+ if (b < 0) {
+ b = 0;
+ }
+ }
+ if (b > l) {
+ b = l;
+ if (a > l) {
+ a = l;
+ }
+ }
+ mp_str_room(mp, (size_t) (b - a));
+ if (reversed) {
+ for (int k = b - 1; k >= a; k--) {
+ mp_append_char(mp, *(s->str + k));
+ }
+ } else {
+ for (int k = a; k < b; k++) {
+ mp_append_char(mp, *(s->str + k));
+ }
+ }
+ return mp_make_string(mp);
+}
diff --git a/source/luametatex/source/mp/readme.txt b/source/luametatex/source/mp/readme.txt
new file mode 100644
index 000000000..c48e19a89
--- /dev/null
+++ b/source/luametatex/source/mp/readme.txt
@@ -0,0 +1,14 @@
+Remark
+
+When a CWEB file is adapted we need to convert to C. This is normally done with the tangle
+program but as we want to be independent of other tools (which themselves can result in a
+chain of dependencies) we use a Lua script which happens to be run with LuaMetaTeX.
+
+Of course there is a chicken egg issue here but at some point we started with C files so
+now we only need to update.
+
+The script is located in the "tools" path alongside the "source" path and it is run in its
+own directory (which for me means: hit the run key when the document is open). As we always
+ship the C files, there is no need for a user to run the script.
+
+Hans Hagen \ No newline at end of file
diff --git a/source/luametatex/source/readme.txt b/source/luametatex/source/readme.txt
new file mode 100644
index 000000000..2471f32b3
--- /dev/null
+++ b/source/luametatex/source/readme.txt
@@ -0,0 +1,563 @@
+--------------------------------------------------------------------------------
+welcome
+--------------------------------------------------------------------------------
+
+There is not much information here. I normally keep track of developments in
+articles or chapters in the history documents. These can (sometimes with a delay
+when it's an article) be found in the ConTeXt distribution. The history and
+development of LuaTeX is also documented there, often with examples or usage.
+
+The ideas behind this project are discussed in documents in the regular ConTeXt
+distribution. A short summary is: in order to make sure ConTeXt will work as
+intended, we distribute an engine with it. That way we can control stability,
+performance and features. It also permits experiments without the danger of
+interference with the engines used in other macro packages. Also, we don't want
+dependencies on large subsystems so we have a well defined set of libraries: we
+want to stay lean and mean. Eventually the same applies as to original TeX: we
+fix bugs and don't add all kind of stuff we don't (want or) need. Just that.
+
+--------------------------------------------------------------------------------
+codebase
+--------------------------------------------------------------------------------
+
+This codebase is a follow up on LuaTeX. It all started with a merge of files
+that came from the Pascal to C converter (CWEB) plus some C libraries. That code
+base evolved over time and there were the usual side effects of the translation
+and merge of (also other engine) code, plus successive extensions as well as Lua
+interfaces. In LuaMetaTeX I tried to smooth things a bit. The idea was to stay
+close to the original (which in the end is TeX itself) so that is why many
+variables, functions etc are named the way they are. Of course I reshuffled, and
+renamed but I also tried to stay close to the original naming. More work needs
+to be done to get it all right but it happens stepwise as I don't want to
+introduce bugs. In the meantime the LuaTeX and LuaMetaTeX code bases differ
+substantially but apart from some new features and stripping away backend and
+font code, the core should work the same.
+
+tex etex pdftex aleph:
+
+Of course the main body of code comes from its ancestors. We started with pdfTeX
+which has its frontend taken from standard TeX, later extended with the eTeX
+additions. Some additional features from pdfTeX were rewritten to become core
+functionality. We also took some from Aleph (Omega) but only some (in the
+meantime adapted) r2l code is left (so we're not compatible).
+
+mp:
+
+The maintainance of MetaPost was delegated to the same people who do luaTeX and
+as a step indevelopment a library was written. This library is used in
+LuaMetaTeX but has been adapted a bit for it. In principle some of the additions
+can be backported, but that is yet undecided.
+
+lua:
+
+This is the third major component of LuaMetaTeX. In LuaTeX a slightly patched
+version has been used but here we use an unchanged version, although the version
+number of the bytecode blob is adapted so that we can use intermediate versions
+of lua 5.4 that expect different bytecode without crashing on existing bytecode;
+this trick has been dropped but I hope at some point Lua will add a define for
+this.
+
+For the record: when we started with LuaTeX I'd gone through a pascal, modula 2,
+perl, ruby with respect to the management helpers for ConTeXt, like dealing with
+indexes, managing metapost subruns, and all kind of goodies that evolved over time.
+I ran into Lua in the SciTE editor and the language and the concept of a small and
+efficient embedded language. The language orginates in academia and is not under
+the influence of (company and commercial driven) marketing. A lot of effort goes
+into stepwise evolution. The authors are clear about the way they work on the
+language:
+
+ http://lua-users.org/lists/lua-l/2008-06/msg00407.html
+
+which fits nicely in our philosophy. Just in case one wonders if other scripting
+languages were considered the answer is: no, they were not. The alternatives all
+are large and growing and come with large ecosystems (read: dependencies) and some
+had (seemingly) drastic changes in the design over time. Of course Lua also evolves
+but that is easy to deal with. And in the meantime also the performance of Lua made
+it clear that it was the right choice.
+
+avl:
+
+This library has been in use in the backend code of LuaTeX but is currently only
+used in the MP library. I'm not sure to what extend this (originally meant for
+Python) module has been adapted for pdfTeX/LuaTeX but afaiks it has been stable
+for a long time. It won't be updated but I might adapt it for instance wrt error
+messages so that it fits in.
+
+decnumber:
+
+This is used in one of the additional number models that the mp library supports.
+In LuaMetaTeX there is no support for the binary model. No one uses it and it
+would add quite a bit to the codebase.
+
+hnj:
+
+This GPL licensed module is used in the hyphenation machinery. It has been
+slightly adapted so that error messages and such fit in. I don't expect it to
+change much in the future.
+
+pplib:
+
+This library is made for Lua(Meta)TeX and provides an efficient PDF parser in
+pure C. In LuaTeX it was introduced a replacement for a larger library that
+was overkill for our purpose, depended on C++ and kept changing. This library
+itself uses libraries but that code is shipped with it. We use some of that
+for additional Lua modules (like md5, sha2 and decoding).
+
+lz4 | lzo | zstd:
+
+For years this library was in the code base and even interfaced but not enabled
+by default. When I played with zstd support as optional libary I decided that
+these two should move out of the code base and also be done the optional way. The
+amount of code was not that large, but the binary grew by some 10%. I also played
+with the foreign module and zstd and there is no real difference in peformance. The
+optionals are actually always enabled, but foreign is controlled by the command
+line option that enables loading libraries, and it al;so depends on libffi.
+
+zlib | miniz:
+
+I started with the code taken from LuaTeX, which itself was a copy that saw some
+adaptions over time (irr there were border case issues, like dealing with zero
+length streams and so). It doesn't change so in due time I might strip away some
+unused code. For a while libdeflate was used but because pplib also depends on
+zlib and because libdeflate doesn't do streams that was abandoned (it might come
+back as it is very nice and clean code.). One issue with (de)compression libraries
+is that they use tricks that can be architecture dependent and we stay away from
+that. I try to stay away from those and prefer to let the compiler sort things out.
+
+Early 2021 we switched to miniz. One reason is that the codebase is smaller because
+it doesn't deal with very old or rare platforms and architectures. Its performance
+is comparable, definitely for our purpose, and sometimes even a bit better. I looked
+at other alternatives but as soon as processor specific tricks are used, we end up
+with architecture specific header files and code so it's a no-go for a presumed
+long term stable and easy to compile program like luametatex. There is no gain in it
+anyway.
+
+complex:
+
+There is a complex number interface inspired by the complex number lua module by
+lhf. It also wraps libcerf usage.
+
+lfs:
+
+In LuaTeX we use a patched version of this library. In LuaMetaTeX I rewrote the
+code because too many patches were needed to deal with mswindows properly.
+
+socket:
+
+The core library is used. The library is seldom adapted but I keep an eye on it.
+We used to have a patched version in LuaTeX, but here we stay closer. I might
+eventually do some rewrite (less code) or decide to make it an external library.
+The related Lua code is not in the binary and context uses its own (derived)
+variant so that it uses our helpers as well as fits in the reporting system. I
+need to keep an eye on improvements upstream. We also need to keep an eye on
+copas as we use that code in context.
+
+luasec:
+
+This is not used but here as a reference for a possible future use (maybe as
+library).
+
+curl, ghostscript, graphicmagick, zint, mujs, mysql, postgress, sqlite, ...:
+
+The optional module mechamism supports some external libraries but we don't keep
+their code in the luametatex codebase. We might come up with a separate source
+tree for that, but only for some smaller ones. The large ones, those depending
+on other libraries, or c++, or whatever resources, will just be taken from the
+system.
+
+libcerf:
+
+This library might become external but is now in use as a plug into the complex
+number support that itself is meant for MetaPost use. The code here has been
+adapted to support the Microsoft compiler. I will keep an eye on what happens
+upstream and I reconsider matters later. (There is no real need to bloat the
+LuaMetaTeX binary with something that is rarely used.)
+
+kpse:
+
+There is optional library support for the KPSE library used in WEB2C. Although
+it does provide the methods that make sense, it is not meant for usage in
+ConTeXt, but more as a toolkit to identify issues and conflicts with parallel
+installations like TeXLive.
+
+hb:
+
+I have a module that works the same as the ffi variant from a couple of years
+ago and I might add it when it's needed (for oriental tex font development
+checking purposes, but then I also need to cleanup and add some test styles for
+that purpose). Looking at the many LuaTeX subversion checkins it looks a bit
+like a moving target. It's also written in C++ which we don't (want to) use in
+LuaMetaTeX. But the library comes with other programs so it's likely you can
+find it on you system someplace.
+
+general:
+
+It's really nice to see all these libraries popping up on the web but in the
+perspective of something like TeX one should be careful. Quite often what is hip
+today is old fashioned tomorrow. And quite often the selling point of the new
+thing comes with bashing the old, which can be a sign of something being a
+temporary thing or itself something ot be superseded soon. Now, get me right:
+TeX in itself is great, and so are successors. In that sense LuaMetaTeX is just
+a follow up with no claims made for it being better. It just makes things easier
+for ConTeXt. You can kick in libraries but be aware of the fact that they can
+change, so if you have long running projects, make sure you save them. Or run a
+virtual machine that can last forever. TeX systems can run for ages that way. We
+might eventually add support for generating libs to the compile farm. The older
+a library gets, the bigger the change that its api is stable. Compression
+libraries are great examples, while libraries that deal with images, conversion
+and rendering are more moving (and have way more dependencies too). Actually,
+for the later category, in ConTeXt we prefer to call the command line variants
+instead of using libraries, also because it seldom influences performance.
+
+licenses:
+
+Most files contain some notice about a the license and most are quite liberal.
+I had to add some (notes) that were missing from LuaTeX. There is an occasional
+readme file that tells a bit more.
+
+explanations:
+
+The TeX derived source code contains many comments that came with the code when
+it was moved from "Pascal Web" to "C Web" (with web2c) to "C plus comments" (by
+Taco). These comments are mostly from Don Knuth as they were part of TeX The
+Program. However, some comments were added (or changed) in the perspective of
+eTeX, pdfTeX, Aleph, etc. We also added some in LuaTeX and LuaMetaTeX. So, in
+the meantime it's a mix. It us who made the mess, not Don! In due time I hope
+to go over all the comments and let them fit the (extended) code.
+
+dependencies:
+
+Often the files here include more h files than needed but given the speed of
+compilation that is no problem. It also helps to identify potential name clashes
+and such.
+
+legacy:
+
+Occasionally there is a file texlegacy.c that has some older (maybe reworked)
+code but I move it to another place when It gets too large and its code no
+longer can be retrofit. For me is shows a bit what got done in the (many)
+intermediate steps.
+
+--------------------------------------------------------------------------------
+documentation
+--------------------------------------------------------------------------------
+
+The code will be stepwise cleaned up a it (removing the web2c side effects),
+making the many branches stand out etc so that some aspects can be documented
+a bit better (in due time). All this will take time (and already quite some time
+went into it.) The official interface of LuaMetaTeX is described in the manual
+and examples of usage can be seen in ConTeXt. Of course TeX behaves as such.
+
+The organization of files, names of functions can change as we progress but when
+possible the knuthian naming is followed so that the documentation of "TeX The
+Program" still (mostly) applies. Some of the improvements in LuaMetaTeX can
+eventually trickle back into LuaTeX although we need to guard stability. The
+files here can *not* be dropped into the LuaTeX source tree!
+
+--------------------------------------------------------------------------------
+reboot
+--------------------------------------------------------------------------------
+
+I'll experiment with a reboot engine option but for sure that also interferes
+with a macro package initialization so it's a long term experiment. Quite
+certainly it will not pay off anyway so it might never happen. But there are
+some pending ideas so ...
+
+--------------------------------------------------------------------------------
+libraries | ffi | luajit
+--------------------------------------------------------------------------------
+
+We use optional libraries instead of ffi which is not supported because it is
+cpu and platform bound and the project that the code was taken from seems to
+be orphaned. Also luajit is not supported as that projects is stalled and uses
+an old lua.
+
+--------------------------------------------------------------------------------
+cmake
+--------------------------------------------------------------------------------
+
+We (Mojca and Hans) try to make the build as simple as possible with a minimum
+of depencies. There are some differences with respect to unix and windows (we
+support msvc, crosscompiled mingw and clang). The code of libraries that we use
+is included, apart from optional libraries. It can only get better.
+
+We really try to make all compilers happy and minimize the number of messages,
+even if that makes the code a bit less nice. It's a bit unfortunate that over
+time the demands and default change a bit (what was needed before triggers a
+warning later).
+
+--------------------------------------------------------------------------------
+experiments
+--------------------------------------------------------------------------------
+
+I've done quite some experiments but those that in the end didn't make sense, or
+complicated the code, or where nice but not that useful after all were simply
+deleted so that no traces are left that can clutter the codebase. I'll probably
+for get (and for sure already have forgotten) about most of them so maybe some
+day they will show up as (different) experiments. We'll see how that goes.
+
+-- miniz : smaller pdf files, less code, similar performance
+-- mimalloc : especially faster for the lua subsystem
+
+--------------------------------------------------------------------------------
+performance
+--------------------------------------------------------------------------------
+
+By now the codebase is different from the LuaTeX one and as a consequence the
+performance can also differ. But it's hard to measure in ConTeXt because much
+more has to be done in Lua and that comes at a price. The native LuaTeX backend
+is for instance much faster (last time meausred the penalty can be up to 20%).
+On the Internet one can run into complaints about performance of LuaTeX with
+other macro packages, so one might wonder why we made this move but speed is
+not everything. On the average ConTeXt has not become less efficient, or
+at least I don't see its users complain much about it, so we just moved on.
+
+The memory footprint at the engine end is somewhat smaller but of course that
+gets compensated by memory consumption at the Lua end. We also sacrifice the
+significate gain of the faster LuaJIT virtual machine (although at some point
+supporting that variant makes not much sense any more as it lacks some Lua
+features). Because, contrary to other TeX's the Lua(Meta)TeX frontend code
+is split up in separate units, compilers can probably do less optimization,
+although we use large compilations units that are mostly independent of each
+other.
+
+Eventually, in a next stage, I might be able to compentate it but don't expect
+miracles: I already explored all kind of variations. Buying a faster machine is
+always an option. Multiple cores don't help, faster memory and caching of files
+does. Already early in the LuaTeX development we found that a CPU cache matters
+but (definitely on server with many a virtual machines) there LuaMetaTeX has to
+compete.
+
+So, at this point my objective is not so much to make LuaMetaTeX run faster but
+more to make sure that it keeps the same performance, even if more functionality
+gets added to the TeX, MetaPost and/or Lua parts. Also keep in mind that in the
+end inefficient macros and styles play a bigger role that the already pretty
+fast engine.
+
+--------------------------------------------------------------------------------
+rapid development cycle
+--------------------------------------------------------------------------------
+
+Because I don't want to divert too much (and fast) from the way traditional TeX
+is coded, the transition is a stepwise process. This also means that much code
+that first has been abstracted and cleaned up, later goes. The extra work that
+is involved, combined with a fast test cycle with the help of ConTeXt users
+ensures that we keep a working ConTeXt although there occasionally are periods
+with issues, especially when fundamentals change or are extended. However, the
+number of temporary bugs is small compared to the number of changes and
+extensions and worth the risk. The alternative is to have long periods where we
+don't update the engine, but that makes testing the related changes in ConTeXt
+rather cumbersome. After all, the engine targets at ConTeXt. But of course it is
+kind of a pity that no one sees what steps were used to get there.
+
+--------------------------------------------------------------------------------
+api
+--------------------------------------------------------------------------------
+
+Although some symbols can be visible due to the fact that we maek them extern as
+past of a code splitup, there is no api at all. Don't expect the names of the
+functions and variables that this applies to to remain the same. Blame yourself
+for abusing this partial exposure. The abstraction is in the \LUA\ interface and
+when possible that one stays the same. Adding more and more access (callbacks)
+won't happen because it has an impact on performance.
+
+Because we want to stay close to original TeX in many aspects, the names of
+functions try to match those in ttp. However, because we're now in pure C, we
+have more functions (and less macros). The compiler will inline many of them,
+but plenty will show up in the symbols table, when exposed. For that reason we
+prefix all functions in categories so that they at least show up in groups. It
+is also the reason why in for instance the optional modules code we collect all
+visible locals in structs. It's all a stepwise process.
+
+The split in tex* modules is mostly for convenience. The original program is
+monolithic (you can get an idea when you look at mp.c) so in a sense they should
+all be seen as a whole. As a consequence we have tex_run_* as externals as well
+as locals. It's just an on-purpose side effect, not a matter of inconsistency:
+there is no tex api.
+
+--------------------------------------------------------------------------------
+todo (ongoing)
+--------------------------------------------------------------------------------
+
+- All errors and warnings (lua|tex|fatal) have to be checked; what is critital
+ and what not.
+- I need to figure out why filetime differs between msvc and mingw (daylight
+ correction probably).
+- Nested runtime measurement is currently not working on unix (but it works ok
+ on microsoft windows).
+- I will check the manual for obsolete, removed and added functionality. This
+ is an ongoing effort.
+- Eventually I might do some more cleanup of the mp*.w code. For now we keep
+ w files, but who knows ...
+- A bit more reshuffling of functions to functional units is possible but that
+ happens stepwise as it's easy to introduce bug(let)s. I will occasionally go
+ over all code.
+- I might turn some more macros into functions (needs some reshuffling too)
+ because it's nicer wrt tracing issues. When we started with LuaTeX macros
+ made more sense but compilers got better. In the meantime whole program
+ optimization works okay, but we cannot do that when one also wants to load
+ modules.
+- A side track of the lack of stripping (see previous note) is that we need to
+ namespace locals more agressive ... most is done.
+- We can clean up the dependency chain i.e. header files and such but this is
+ a long term activity. It's also not that important.
+- Maybe nodememoryword vs tokenmemoryword so that the compiler can warn for a
+ mixup.
+- Remove some more (also cosmetic) side effects of mp library conversion.
+- Replace some more of the print* chains by the more compact print_format call
+ (no hurry with that one).
+- The naming between modules (token, tex, node) of functions is (historically)
+ a bit inconsistent (getfoo, get_foo etc) so I might make that better. It does
+ have some impact on compatibility but one can alias (we can provide a file).
+- Some more interface related code might get abstracted (much already done).
+- I don't mention other (either or not already rejected) ideas and experiments
+ here (like pushing/popping pagebuilder states which is messy and also demands
+ too much from the macro package end.)
+- Stepwise I'll make the complete split of command codes (chr) and subtypes.
+ This is mostly done but there are some leftovers. It also means that we no
+ longer are completely in sync with the internal original \TEX\ naming but I'll
+ try to remain close.
+- The glyph and math scale features do not yet check for overflow of maxdimen
+ but I'll add some more checks and/or impose some limitations on the scale
+ values. We have to keep in mind that TeX itself also hapilly accepts some
+ wrap around because it doesn't really crash the engine; it just can have side
+ effects.
+
+--------------------------------------------------------------------------------
+todo (second phase)
+--------------------------------------------------------------------------------
+
+Ideally we'd like to see more local variables (like some cur_val and such) but
+it's kind of tricky because these globals are all over the place and sometimes
+get saved and restored (so that needs careful checking), and sometimes such a
+variable is expected to be set in a nested call. It also spoils the (still
+mostly original) documentation. So, some will happen, some won't. I actually
+tested some rather drastic localization and even with tripple checking there
+were side effects, so I reverted that. (We probably end up with a mix that
+shows the intention.)
+
+Anyway, there are (and will be) some changes (return values instead of accessing
+global) that give a bit less code on the one hand (and therefore look somewhat
+cleaner) but are not always more efficient. It's all a matter of taste.
+
+I'm on and off looking at the files and their internal documentation and in the
+process rename some variables, do some extra checking, and remove unused code.
+This is a bit random activity that I started doing pending the first official
+release.
+
+Now that the math engine has been partly redone the question is: should we keep
+the font related control options? They might go away at some point and even
+support for traditional eight bit fonts might be dropped. We'll see about that.
+
+That is: we saw about it. End 2021 and beginning of 2022 Mikael Sundqvist and I
+spent quite a few months on playing around with new features: more classes, inter
+atom spacing, inter atom penalties, atom rules, a few more FontParameters, a bit
+more control on top of what we already had, etc. In the end some of the control
+already present became standardized in a way that now prefers OpenType fonts.
+Persistent issues with fonts are now dealt with on a per font basis in ConteXt
+using existing as well as new tweaking features. We started talking micro math
+typography. Old fonts are still supported but one has to configure the engine
+with respecty to the used technology. Another side effect is that we now store
+math character specifications in nodes instead of a number.
+
+It makes sense to simplify delimiters (just make them a mathchar) and get rid of
+the large family and char. These next in size and extensibles are to be related
+anyway so one can always make a (runtime) virtual font. The main problem is that
+we then need to refactor some tex (format) code too becuase we no longer have
+delimiters there too.
+
+--------------------------------------------------------------------------------
+dependencies
+--------------------------------------------------------------------------------
+
+There are no depencies on code outside this tree and we keep it that way. If you
+follow the TeXLive (LuaTeX) source update you'll notice that there are quite
+often updates of libraries and sometimes they give (initial) issues when being
+compiled, also because there can be further dependencies on compilers as well as
+libraries specific to a (version of) an operating system. This is not something
+that users should be bothered with.
+
+Optional libraries are really optional and although an API can change we will
+not include related code in the formal LuaMetaTeX code base. We might offer some
+in the build farm (for building libraries) but that is not a formal dependency.
+We will of course adapt code to changes in API's but also never provide more
+than a minimal interface: use Lua when more is needed.
+
+We keep in sync with Lua development, also because we consider LuaMetaTeX to be
+a nice test case. We never really have issues with Lua anyway. Maybe at some
+point I will replace the socket related code. The mimalloc libraries used gives
+a performance boost but we could do without. The build cerf library might be
+replaced by an optional but it also depends on the complex datatype being more
+mature: there is now a fundamental difference between compilers so we have a
+patched version; the code doesn't change anyway, so maybe it can be stripped.
+
+In practice there have been hardly any updates to the libraries that we do use:
+most changes are in auxiliary programs and make files anyway. When there is an
+update (most are on github) this is what happens:
+
+-- check out code
+-- compare used subset (like /src) with working copy
+-- merge with working copy if it makes sense (otherwise delay)
+-- test for a while (local compilation etc.)
+-- compare used subset again, this time with local repository
+-- merge with local repository
+-- push update to the build farm
+
+So, each change is checked twice which in practice doesn't take much time but
+gives a good idea of the kind of changes. So far we never had to roll back.
+
+We still use CWEB formatting for MetaPost which then involves a conversion to C
+code but the C code is included. This removes a depedency on the WEB toolchain.
+The Lua based converter that is part of this source tree works quite well for
+our purpose (and also gives nicer code).
+
+We don't do any architecture (CPU) or operating system specific optimizations,
+simply because there is no real gain for LuaMetaTeX. It would only introduce
+issues, a more complex build, dependencies on assembly generators, etc. which
+is a no-go.
+
+--------------------------------------------------------------------------------
+team / responsibilities
+--------------------------------------------------------------------------------
+
+The LuaTeX code base is part of the ConTeXt code base. That way we can guarantee
+its working with the ConTeXt macro package and also experiment as much as we
+like without harming this package. The ConTeXt code is maintained by Hans Hagen
+and Wolfgang Schuster with of course help and input from others (those who are
+on the mailing list will have no problem identifying who). Because we see the
+LuaMetaTeX code as part of that effort, starting with its more or less official
+release (version 2.05, early 2020), Hans and Wolfgang will be responsible for
+the code (knowing that we can always fall back on Taco) and explore further
+possibilities. Mojca Miklavec handles the compile farm, coordinates the
+distributions, deals with integration in TeXLive, etc. Alan Braslau is the first
+line tester so that in an early stage we can identify issues with for TeX,
+MetaPost, Lua and compilation on the different platforms that users have.
+
+If you run into problems with LuaMetaTeX, the ConTeXt mailing list is the place
+to go to: ntg-context@ntg.nl. Of course you can also communicate LuaTeX problems
+there, especially when you suspect that both engines share it, but for specific
+LuaTeX issues there is dev-luatex@ntg.nl where the LuaTeX team can help you
+further.
+
+This (mid 2018 - begin 2020) is the first stage of the development. Before we
+move on, we (read: users) will first test the current implementation more
+extensively over a longer period of time, something that is really needed because
+there are lots of accumulated changes, and I would not be surprised if subtle
+issues have been introduced. In the meantime we will discuss how to follow up.
+
+The version in the distribution is always tested with the ConteXt test suite,
+which hopefully uncovers issues before users notice.
+
+Stay tuned!
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+ConTeXt websites : http://contextgarden.net http://www.pragma-ade.nl
+Development list : dev-context@ntg.nl
+Support list : context@ntg.nl
+User groups : http://ntg.nl http://tug.org etc
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+Hans Hagen : j.hagen@xs4all.nl
+--------------------------------------------------------------------------------
diff --git a/source/luametatex/source/tex/texadjust.c b/source/luametatex/source/tex/texadjust.c
new file mode 100644
index 000000000..279af8950
--- /dev/null
+++ b/source/luametatex/source/tex/texadjust.c
@@ -0,0 +1,393 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+static void tex_scan_adjust_keys(halfword *options, halfword *code, halfword *index, scaled *depthbefore, scaled *depthafter, halfword *attrlist)
+{
+ *code = post_adjust_code;
+ *options = adjust_option_none;
+ *index = 0;
+ *depthbefore = 0;
+ *depthafter = 0;
+ *attrlist = null;
+ while (1) {
+ switch (tex_scan_character("abdipABDIP", 0, 1, 0)) {
+ case 'p': case 'P':
+ switch (tex_scan_character("roRO", 0, 0, 0)) {
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("pre", 2)) {
+ *code = pre_adjust_code;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("post", 2)) {
+ *code = post_adjust_code;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("pre|post");
+ goto DONE;
+ }
+ break;
+ case 'b': case 'B':
+ switch (tex_scan_character("aeAE", 0, 0, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("baseline", 2)) {
+ *options |= adjust_option_baseline;
+ }
+ break;
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("before", 2)) {
+ *options |= adjust_option_before;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("baseline|before");
+ goto DONE;
+ }
+ break;
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("index", 1)) {
+ *index = tex_scan_int(0, NULL);
+ if (! tex_valid_adjust_index(*index)) {
+ *index = 0; /* for now no error */
+ }
+ }
+ break;
+ case 'a': case 'A':
+ switch (tex_scan_character("ftFT", 0, 0, 0)) {
+ case 'f': case 'F':
+ if (tex_scan_mandate_keyword("after", 2)) {
+ *options &= ~(adjust_option_before | *options);
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("attr", 2)) {
+ halfword i = tex_scan_attribute_register_number();
+ halfword v = tex_scan_int(1, NULL);
+ if (eq_value(register_attribute_location(i)) != v) {
+ if (*attrlist) {
+ *attrlist = tex_patch_attribute_list(*attrlist, i, v);
+ } else {
+ *attrlist = tex_copy_attribute_list_set(tex_current_attribute_list(), i, v);
+ }
+ }
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("after|attr");
+ goto DONE;
+ }
+ break;
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("depth", 1)) {
+ switch (tex_scan_character("abclABCL", 0, 1, 0)) { /* so a space is permitted */
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("after", 1)) {
+ *options |= adjust_option_depth_after;
+ *depthafter = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'b': case 'B':
+ if (tex_scan_mandate_keyword("before", 1)) {
+ *options |= adjust_option_depth_before;
+ *depthbefore = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("check", 1)) {
+ *options |= adjust_option_depth_check;
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("last", 1)) {
+ *options |= adjust_option_depth_last;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("after|before|check|last");
+ goto DONE;
+ }
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ return;
+}
+
+int tex_valid_adjust_index(halfword n)
+{
+ return n >= 0;
+}
+
+void tex_run_vadjust(void)
+{
+ halfword code = post_adjust_code;
+ halfword options = adjust_option_none;
+ halfword index = 0;
+ scaled depthbefore = 0;
+ scaled depthafter = 0;
+ halfword attrlist = null;
+ tex_scan_adjust_keys(&options, &code, &index, &depthbefore, &depthafter, &attrlist);
+ tex_set_saved_record(saved_adjust_item_location, saved_adjust_location, 0, code);
+ tex_set_saved_record(saved_adjust_item_options, saved_adjust_options, 0, options);
+ tex_set_saved_record(saved_adjust_item_index, saved_adjust_index, 0, index);
+ tex_set_saved_record(saved_adjust_item_attr_list, saved_adjust_attr_list, 0, attrlist);
+ tex_set_saved_record(saved_adjust_item_depth_before, saved_adjust_depth_before, 0, depthbefore);
+ tex_set_saved_record(saved_adjust_item_depth_after, saved_adjust_depth_after, 0, depthafter);
+ lmt_save_state.save_stack_data.ptr += saved_adjust_n_of_items;
+ tex_new_save_level(vadjust_group);
+ tex_scan_left_brace();
+ tex_normal_paragraph(vadjust_par_context);
+ tex_push_nest();
+ cur_list.mode = -vmode;
+ cur_list.prev_depth = ignore_depth;
+}
+
+void tex_finish_vadjust_group(void)
+{
+ if (! tex_wrapped_up_paragraph(vadjust_par_context)) {
+ halfword box, topskip, adjust; /*tex for short-term use */
+ tex_end_paragraph(vadjust_group, vadjust_par_context);
+ topskip = tex_new_glue_node(split_top_skip_par, top_skip_code); /* cheat */
+ tex_unsave();
+ lmt_save_state.save_stack_data.ptr -= saved_adjust_n_of_items;
+ box = tex_vpack(node_next(cur_list.head), 0, packing_additional, max_dimen, direction_unknown, holding_none_option);
+ tex_pop_nest();
+ adjust = tex_new_node(adjust_node, (quarterword) saved_value(saved_adjust_item_location));
+ tex_tail_append(adjust);
+ adjust_list(adjust) = box_list(box);
+ adjust_options(adjust) = (halfword) saved_value(saved_adjust_item_options);
+ adjust_index(adjust) = (halfword) saved_value(saved_adjust_item_index);
+ adjust_depth_before(adjust) = (halfword) saved_value(saved_adjust_item_depth_before);
+ adjust_depth_after(adjust) = (halfword) saved_value(saved_adjust_item_depth_after);
+ tex_attach_attribute_list_attribute(adjust, (halfword) saved_value(saved_adjust_item_attr_list));
+ tex_flush_node(topskip);
+ box_list(box) = null;
+ tex_flush_node(box);
+ /* we never do the callback ... maybe move it outside */
+ if (lmt_nest_state.nest_data.ptr == 0) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(vadjust_page_context, 0);
+ }
+ tex_build_page();
+ }
+ }
+}
+
+/*tex Append or prepend vadjust nodes. Here head is a temp node! */
+
+halfword tex_append_adjust_list(halfword head, halfword tail, halfword adjust)
+{
+ while (adjust && node_type(adjust) == adjust_node) {
+ halfword next = node_next(adjust);
+ if (tail == head) {
+ node_next(head) = adjust;
+ } else {
+ tex_couple_nodes(tail, adjust);
+ }
+ if (tracing_adjusts_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[adjust: index %i, location %s, append]", adjust_index(adjust), tex_aux_subtype_str(adjust));
+ tex_print_node_list(adjust_list(adjust), "adjust",show_box_depth_par, show_box_breadth_par);
+ tex_end_diagnostic();
+ }
+ tail = adjust;
+ adjust = next;
+ }
+ return tail;
+}
+
+halfword tex_prepend_adjust_list(halfword head, halfword tail, halfword adjust)
+{
+ while (adjust && node_type(adjust) == adjust_node) {
+ halfword next = node_next(adjust);
+ if (tail == head) {
+ node_next(head) = adjust;
+ tail = adjust;
+ } else {
+ tex_try_couple_nodes(adjust, node_next(node_next(head)));
+ tex_couple_nodes(node_next(head), adjust);
+ }
+ if (tracing_adjusts_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[adjust: index %i, location %s, prepend]", adjust_index(adjust), tex_aux_subtype_str(adjust));
+ tex_print_node_list(adjust_list(adjust), "adjust", show_box_depth_par, show_box_breadth_par);
+ tex_end_diagnostic();
+ }
+ adjust = next;
+ }
+ return tail;
+}
+
+void tex_inject_adjust_list(halfword adjust, int obeyoptions, halfword nextnode, const line_break_properties *properties)
+{
+ adjust = node_next(adjust);
+ if (adjust) {
+ while (adjust && node_type(adjust) == adjust_node) {
+ halfword list = adjust_list(adjust);
+ halfword next = node_next(adjust);
+ if (list) {
+ halfword prevnode = cur_list.tail;
+ if (tracing_adjusts_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[adjust: index %i, location %s, inject]", adjust_index(adjust), tex_aux_subtype_str(adjust));
+ tex_print_node_list(adjust_list(adjust), "adjust", show_box_depth_par, show_box_breadth_par);
+ tex_end_diagnostic();
+ }
+ if (obeyoptions && has_adjust_option(adjust, adjust_option_baseline)) {
+ /*tex
+ Here we attach data to a line. On the todo is to prepend and append to
+ the lines (nicer when we number lines).
+ */
+ if (node_type(list) == hlist_node || node_type(list) == vlist_node) {
+ if (nextnode) {
+ /*tex
+ This is the |pre| case where |nextnode| is the line to be appended
+ after the adjust box |list|.
+ */
+ if (node_type(nextnode) == hlist_node || node_type(nextnode) == vlist_node) {
+ if (box_height(nextnode) > box_height(list)) {
+ box_height(list) = box_height(nextnode);
+ }
+ if (box_depth(list) > box_depth(nextnode)) {
+ box_depth(nextnode) = box_depth(list);
+ }
+ /* not ok yet */
+ box_y_offset(nextnode) += box_height(nextnode);
+ tex_check_box_geometry(nextnode);
+ /* till here */
+ box_height(nextnode) = 0;
+ box_depth(list) = 0;
+ }
+ } else {
+ /*tex
+ Here we have the |post| case where the line will end up before the
+ adjusted content.
+ */
+ if (node_type(prevnode) == hlist_node || node_type(prevnode) == vlist_node) {
+ if (box_height(prevnode) < box_height(list)) {
+ box_height(prevnode) = box_height(list);
+ }
+ if (box_depth(list) < box_depth(prevnode)) {
+ box_depth(list) = box_depth(prevnode);
+ }
+ box_height(list) = 0;
+ box_depth(prevnode) = 0;
+ }
+ }
+ }
+ }
+ if (obeyoptions && has_adjust_option(adjust, adjust_option_depth_before)) {
+ cur_list.prev_depth = adjust_depth_before(adjust);
+ }
+ if (obeyoptions && has_adjust_option(adjust, adjust_option_depth_check)) {
+ tex_append_to_vlist(list, -1, properties);
+ } else {
+ tex_couple_nodes(prevnode, list);
+ }
+ if (obeyoptions && has_adjust_option(adjust, adjust_option_depth_after)) {
+ cur_list.prev_depth = adjust_depth_after(adjust);
+ } else if (obeyoptions && has_adjust_option(adjust, adjust_option_depth_last)) {
+ cur_list.prev_depth = box_depth(list);
+ }
+ cur_list.tail = tex_tail_of_node_list(cur_list.tail);
+ if (! lmt_page_builder_state.output_active) {
+ lmt_append_line_filter_callback(post_adjust_append_line_context, adjust_index(adjust));
+ }
+ }
+ adjust_list(adjust) = null;
+ tex_flush_node(adjust);
+ adjust = next;
+ }
+ }
+}
+
+void tex_adjust_attach(halfword box, halfword adjust)
+{
+ if (adjust_list(adjust)) {
+ node_prev(adjust) = null;
+ node_next(adjust) = null;
+ switch (node_subtype(adjust)) {
+ case pre_adjust_code:
+ if (! box_pre_adjusted(box)) {
+ box_pre_adjusted(box) = adjust;
+ } else if (has_adjust_option(adjust, adjust_option_before)) {
+ tex_couple_nodes(adjust, box_pre_adjusted(box));
+ box_pre_adjusted(box) = adjust;
+ } else {
+ tex_couple_nodes(tex_tail_of_node_list(box_pre_adjusted(box)), adjust);
+ }
+ node_subtype(adjust) = local_adjust_code;
+ break;
+ case post_adjust_code:
+ if (! box_post_adjusted(box)) {
+ box_post_adjusted(box) = adjust;
+ } else if (has_adjust_option(adjust, adjust_option_before)) {
+ tex_couple_nodes(adjust, box_post_adjusted(box));
+ box_post_adjusted(box) = adjust;
+ } else {
+ tex_couple_nodes(tex_tail_of_node_list(box_post_adjusted(box)), adjust);
+ }
+ node_subtype(adjust) = local_adjust_code;
+ break;
+ case local_adjust_code:
+ tex_normal_error("vadjust post", "unexpected local attach");
+ break;
+ }
+ } else {
+ tex_flush_node(adjust);
+ }
+}
+
+void tex_adjust_passon(halfword box, halfword adjust)
+{
+ halfword head = adjust ? adjust_list(adjust) : null;
+ (void) box;
+ if (head) {
+ node_prev(adjust) = null;
+ node_next(adjust) = null;
+ switch (node_subtype(adjust)) {
+ case pre_adjust_code:
+ if (lmt_packaging_state.pre_adjust_tail) {
+ if (lmt_packaging_state.pre_adjust_tail != pre_adjust_head && has_adjust_option(adjust, adjust_option_before)) {
+ lmt_packaging_state.pre_adjust_tail = tex_prepend_adjust_list(pre_adjust_head, lmt_packaging_state.pre_adjust_tail, adjust);
+ } else {
+ lmt_packaging_state.pre_adjust_tail = tex_append_adjust_list(pre_adjust_head, lmt_packaging_state.pre_adjust_tail, adjust);
+ }
+ } else {
+ tex_normal_error("vadjust pre", "invalid list");
+ }
+ break;
+ case post_adjust_code:
+ if (lmt_packaging_state.post_adjust_tail) {
+ if (lmt_packaging_state.post_adjust_tail != post_adjust_head && has_adjust_option(adjust, adjust_option_before)) {
+ lmt_packaging_state.post_adjust_tail = tex_prepend_adjust_list(post_adjust_head, lmt_packaging_state.post_adjust_tail, adjust);
+ } else {
+ lmt_packaging_state.post_adjust_tail = tex_append_adjust_list(post_adjust_head, lmt_packaging_state.post_adjust_tail, adjust);
+ }
+ } else {
+ tex_normal_error("vadjust post", "invalid list");
+ }
+ break;
+ case local_adjust_code:
+ tex_normal_error("vadjust post", "unexpected local passon");
+ break;
+ }
+ } else {
+ tex_flush_node(adjust);
+ }
+}
+
+void tex_initialize_adjust(void)
+{
+}
+
+void tex_cleanup_adjust(void)
+{
+}
diff --git a/source/luametatex/source/tex/texadjust.h b/source/luametatex/source/tex/texadjust.h
new file mode 100644
index 000000000..19c116f26
--- /dev/null
+++ b/source/luametatex/source/tex/texadjust.h
@@ -0,0 +1,36 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex More will move here. */
+
+# ifndef LMT_ADJUST_H
+# define LMT_ADJUST_H
+
+typedef enum saved_adjust_items {
+ saved_adjust_item_location = 0,
+ saved_adjust_item_options = 1,
+ saved_adjust_item_index = 2,
+ saved_adjust_item_attr_list = 3,
+ saved_adjust_item_depth_before = 4,
+ saved_adjust_item_depth_after = 5,
+ saved_adjust_n_of_items = 6,
+} saved_adjust_items;
+
+extern void tex_initialize_adjust (void);
+extern void tex_cleanup_adjust (void);
+
+extern void tex_run_vadjust (void);
+extern void tex_finish_vadjust_group (void);
+
+extern int tex_valid_adjust_index (halfword n);
+
+extern void tex_inject_adjust_list (halfword list, int obeyoptions, halfword nextnode, const line_break_properties *properties);
+
+extern void tex_adjust_passon (halfword box, halfword adjust);
+extern void tex_adjust_attach (halfword box, halfword adjust);
+
+extern halfword tex_prepend_adjust_list (halfword head, halfword tail, halfword adjust);
+extern halfword tex_append_adjust_list (halfword head, halfword tail, halfword adjust);
+
+# endif \ No newline at end of file
diff --git a/source/luametatex/source/tex/texalign.c b/source/luametatex/source/tex/texalign.c
new file mode 100644
index 000000000..207895a6d
--- /dev/null
+++ b/source/luametatex/source/tex/texalign.c
@@ -0,0 +1,1854 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ It's sort of a miracle whenever |halign and |valign| work, because they cut across so many of
+ the control structures of \TEX. Therefore the present page is probably not the best place for
+ a beginner to start reading this program; it is better to master everything else first.
+
+ Let us focus our thoughts on an example of what the input might be, in order to get some idea
+ about how the alignment miracle happens. The example doesn't do anything useful, but it is
+ sufficiently general to indicate all of the special cases that must be dealt with; please do
+ not be disturbed by its apparent complexity and meaninglessness.
+
+ \starttyping
+ \tabskip 2pt plus 3pt
+ \halign to 300pt{u1#v1&
+ \hskip 50pt \tabskip 1pt plus 1fil u2#v2&
+ \hskip 50pt u3#v3\cr
+ \hskip 25pt a1&\omit a2&\vrule\cr
+ \hskip 25pt \noalign\{\vskip 3pt}
+ \hskip 25pt b1\span b2\cr
+ \hskip 25pt \omit&c2\span\omit\cr}
+ \stoptyping
+
+ Here's what happens:
+
+ \startitemize
+
+ \startitem
+ When |\halign to 300pt {}| is scanned, the |scan_align_spec| routine places the 300pt
+ dimension onto the |save_stack|, and an |align_group| code is placed above it. This
+ will make it possible to complete the alignment when the matching right brace is found.
+ \stopitem
+
+ \startitem
+ The preamble is scanned next. Macros in the preamble are not expanded, except as part
+ of a tabskip specification. For example, if |u2| had been a macro in the preamble above,
+ it would have been expanded, since \TEX\ must look for |minus ...| as part of the
+ tabskip glue. A preamble list is constructed based on the user's preamble; in our case
+ it contains the following seven items:
+
+ \starttabulate
+ \NC \type{\glue 2pt plus 3pt} \NC the tabskip preceding column 1 \NC \NR
+ \NC \type{\alignrecord} of width $-\infty$ \NC preamble info for column 1 \NC \NR
+ \NC \type{\glue 2pt plus 3pt} \NC the tabskip between columns 1 and 2 \NC \NR
+ \NC \type{\alignrecord} of width $-\infty$ \NC preamble info for column 2 \NC \NR
+ \NC \type{\glue 1pt plus 1fil} \NC the tabskip between columns 2 and 3 \NC \NR
+ \NC \type{\alignrecord} of width $-\infty$ \NC preamble info for column 3 \NC \NR
+ \NC \type{\glue 1pt plus 1fil} \NC the tabskip following column 3 \NC \NR
+ \stoptabulate
+
+ These \quote {alignrecord} entries have the same size as an |unset_node|, since they
+ will later be converted into such nodes. These alignrecord nodes have no |depth| field;
+ this is split into |u_part| and |v_part|, and they point to token lists for the
+ templates of the alignment. For example, the |u_part| field in the first alignrecord
+ points to the token list |u1|, i.e., the template preceding the \type {#} for column~1.
+ Furthermore, They have a |span_ptr| instead of a |node_attr| field, and these |span_ptr|
+ fields are initially set to the value |end_span|, for reasons explained below.
+ \stopitem
+
+ \startitem
+ \TEX\ now looks at what follows the |\cr| that ended the preamble. It is not |\noalign|
+ or |\omit|, so this input is put back to be read again, and the template |u1| is fed to
+ the scanner. Just before reading |u1|, \TeX\ goes into restricted horizontal mode. Just
+ after reading |u1|, \TEX\ will see |a1|, and then (when the |&| is sensed) \TEX\ will
+ see |v1|. Then \TEX\ scans an |end_template| token, indicating the end of a column. At
+ this point an |unset_node| is created, containing the contents of the current hlist
+ (i.e., |u1a1v1|). The natural width of this unset node replaces the |width| field of
+ the alignrecord for column~1; in general, the alignrecords will record the maximum
+ natural width that has occurred so far in a given column.
+ \stopitem
+
+ \startitem
+ Since |\omit| follows the |&|, the templates for column~2 are now bypassed. Again \TEX\
+ goes into restricted horizontal mode and makes an |unset_node| from the resulting hlist;
+ but this time the hlist contains simply |a2|. The natural width of the new unset box is
+ remembered in the |width| field of the alignrecord for column~2.
+ \stopitem
+
+ \startitem
+ A third |unset_node| is created for column 3, using essentially the mechanism that
+ worked for column~1; this unset box contains |u3\vrule v3|. The vertical rule in this
+ case has running dimensions that will later extend to the height and depth of the whole
+ first row, since each |unset_node| in a row will eventually inherit the height and depth
+ of its enclosing box.
+ \stopitem
+
+ \startitem
+ The first row has now ended; it is made into a single unset box comprising the following
+ seven items:
+
+ \starttyping
+ \glue 2pt plus 3pt
+ \unsetbox for 1 column: u1a1v1
+ \glue 2pt plus 3pt
+ \unsetbox for 1 column: a2
+ \glue 1pt plus 1fil
+ \unsetbox for 1 column: u3\vrule v3
+ \glue 1pt plus 1fil
+ \stoptyping
+
+ The width of this unset row is unimportant, but it has the correct height and depth, so
+ the correct baselineskip glue will be computed as the row is inserted into a vertical
+ list.
+ \stopitem
+
+ \startitem
+ Since |\noalign| follows the current |\cr|, \TEX\ appends additional material (in this
+ case |\vskip 3pt|) to the vertical list. While processing this material, \TeX\ will be
+ in internal vertical mode, and |no_align_group| will be on |save_stack|.
+ \stopitem
+
+ \startitem
+ The next row produces an unset box that looks like this:
+
+ \starttyping
+ \glue 2pt plus 3pt
+ \unsetbox for 2 columns: u1b1v1u2b2v2
+ \glue 1pt plus 1fil
+ \unsetbox for 1 column: {(empty)}
+ \glue 1pt plus 1fil
+ \stoptyping
+
+ The natural width of the unset box that spans columns 1~and~2 is stored in a \quote
+ {span node}, which we will explain later; the |span_ptr| field of the alignrecord for
+ column~1 now points to the new span node, and the |span_ptr| of the span node points to
+ |end_span|.
+ \stopitem
+
+ \startitem
+
+ The final row produces the unset box
+
+ \starttyping
+ \glue 2pt plus 3pt
+ \unsetbox for 1 column: (empty)
+ \glue 2pt plus 3pt
+ \unsetbox for 2 columns: u2c2v2
+ \glue 1pt plus 1fil
+ \stoptyping
+
+ A new span node is attached to the align record for column 2.
+ \stopitem
+
+ \startitem
+ The last step is to compute the true column widths and to change all the unset boxes to
+ hboxes, appending the whole works to the vertical list that encloses the |\halign|. The
+ rules for deciding on the final widths of each unset column box will be explained below.
+ \stopitem
+
+ \stopitemize
+
+ Note that as |\halign| is being processed, we fearlessly give up control to the rest of \TEX. At
+ critical junctures, an alignment routine is called upon to step in and do some little action, but
+ most of the time these routines just lurk in the background. It's something like post-hypnotic
+ suggestion.
+
+ We have mentioned that alignrecords contain no |height| or |depth| fields. Their |glue_sign| and
+ |glue_order| are pre-empted as well, since it is necessary to store information about what to do
+ when a template ends. This information is called the |extra_info| field.
+
+ Alignments can occur within alignments, so a small stack is used to access the alignrecord
+ information. At each level we have a |preamble| pointer, indicating the beginning of the
+ preamble list; a |cur_align| pointer, indicating the current position in the preamble list; a
+ |cur_span| pointer, indicating the value of |cur_align| at the beginning of a sequence of
+ spanned columns; a |cur_loop| pointer, indicating the tabskip glue before an alignrecord that
+ should be copied next if the current list is extended; and the |align_state| variable, which
+ indicates the nesting of braces so that |\cr| and |\span| and tab marks are properly
+ intercepted. There also are pointers |cur_head| and |cur_tail| to the head and tail of a list
+ of adjustments being moved out from horizontal mode to vertical~mode, and alike |cur_pre_head|
+ and |cur_pre_tail| for pre-adjust lists.
+
+ The current values of these nine quantities appear in global variables; when they have to be
+ pushed down, they are stored in 6-word nodes, and |align_ptr| points to the topmost such node.
+
+*/
+
+/*tex
+
+ So far, hardly anything has been added to the alignment code so the above, original \TEX\
+ the program documentation still applies. Of course we have callbacks. Attributes are a bit
+ complicating here. I experimented with some row and cell specific ones but grouping will always
+ make it messy. One never knows what a preamble injects. So leaving it as-is is better than a
+ subtoptimal solution with side effects. To mention one aspect: we have unset nodes that use the
+ attribute fields for other purposes and get adapted later on anyway. I'll look into it again
+ at some point.
+
+ Contrary to other mechanisms, there are not that many extensions. One is that we can nest
+ |\noalign| (so we don't need kludges at the macro level). The look ahead trickery has not been
+ changed but we might get some variants (we have protected macros so it's not as sensitive as
+ it was in the past.
+
+ The |\tabsize| feature is experimental and possibly a prelude to more. I played with that
+ when a test file (korean font table) was allocating so many nodes that I wondered if we could
+ limit that (and redundant boxes and glue are the only things we can do here). It actually
+ also saves a bit of runtime. This feature has not been tested yet with |\span| and |\omit|.
+
+*/
+
+/*
+ Todo: lefttabskip righttabskip middletabskip
+*/
+
+typedef struct alignment_state_info {
+ halfword cur_align; /*tex The current position in the preamble list. */
+ halfword cur_span; /*tex The start of the currently spanned columns in the preamble list. */
+ halfword cur_loop; /*tex A place to copy when extending a periodic preamble. */
+ halfword align_ptr; /*tex The most recently pushed-down alignment stack node. */
+ halfword cur_post_adjust_head; /*tex Adjustment list head pointer. */
+ halfword cur_post_adjust_tail; /*tex Adjustment list tail pointer. */
+ halfword cur_pre_adjust_head; /*tex Pre-adjustment list head pointer. */
+ halfword cur_pre_adjust_tail; /*tex Pre-adjustment list tail pointer. */
+ halfword cur_post_migrate_head;
+ halfword cur_post_migrate_tail;
+ halfword cur_pre_migrate_head;
+ halfword cur_pre_migrate_tail;
+ halfword hold_token_head; /*tex head of a temporary list of another kind */
+ halfword omit_template; /*tex a constant token list */
+ halfword no_align_level;
+ halfword no_tab_skips;
+ halfword attr_list;
+ halfword cell_source;
+ halfword wrap_source;
+ halfword callback;
+ // halfword reverse; // todo
+ // halfword discard_skips; // todo
+} alignment_state_info ;
+
+static alignment_state_info lmt_alignment_state = {
+ .cur_align = null,
+ .cur_span = null,
+ .cur_loop = null,
+ .align_ptr = null,
+ .cur_post_adjust_head = null,
+ .cur_post_adjust_tail = null,
+ .cur_pre_adjust_head = null,
+ .cur_pre_adjust_tail = null,
+ .cur_post_migrate_head = null,
+ .cur_post_migrate_tail = null,
+ .cur_pre_migrate_head = null,
+ .cur_pre_migrate_tail = null,
+ .hold_token_head = null, /*tex head of a temporary list of another kind */
+ .omit_template = null, /*tex a constant token list */
+ .no_align_level = 0,
+ .no_tab_skips = 0,
+ .attr_list = null,
+ .cell_source = 0,
+ .wrap_source = 0,
+ .callback = 0,
+ // .reverse = 0,
+ // .discard_skips = 0,
+};
+
+/*tex We could as well save these in the alignment stack. */
+
+typedef enum saved_align_items {
+ saved_align_specification,
+ saved_align_reverse,
+ saved_align_discard,
+ saved_align_noskips, /*tex Saving is not needed but it doesn't hurt either */
+ saved_align_callback,
+ saved_align_n_of_items,
+} saved_align_items;
+
+/*tex The current preamble list: */
+
+# define preamble node_next(align_head)
+
+/*tex We use them before we define them: */
+
+static void tex_aux_initialize_row (void);
+static void tex_aux_initialize_column (void);
+static void tex_aux_finish_row (void);
+static int tex_aux_finish_column (void);
+static void tex_aux_finish_align (void);
+
+/*tex
+ We get |alignment_record| into |unset_node| and |unset_node| into |[hv]list_node|. And because
+ we can access the fields later on w emake sure that we wipe them. The box orientation field kind
+ of protects reading them but still it's nicer this way. In general in \LUATEX\ and \LUAMETATEX\
+ we need to be more careful because we expose fields.
+*/
+
+inline static void tex_aux_change_list_type(halfword n, quarterword type)
+{
+ node_type(n) = type;
+ box_w_offset(n) = 0; /* box_glue_stretch align_record_span_ptr */
+ box_h_offset(n) = 0; /* box_glue_shrink align_record_extra_info */
+ box_d_offset(n) = 0; /* box_span_count */
+ box_x_offset(n) = 0; /* align_record_u_part */
+ box_y_offset(n) = 0; /* align_record_v_part */
+ // box_geometry(n) = 0; /* box_size */
+ box_orientation(n) = 0; /* box_size */
+}
+
+/*tex
+
+ The |align_state| and |preamble| variables are initialized elsewhere. Alignment stack
+ maintenance is handled by a pair of trivial routines called |push_alignment| and |pop_alignment|.
+
+ It makes not much sense to add support for an |attr| keyword to |\halign| and |\valign| because
+ then we need to decide if we tag rows or cells or both or come up with |cellattr| and |rowattr|
+ and such. But then it even makes sense to have explicit commands (in addition to the seperator)
+ to tags individual cells. It's too much hassle for now and the advantages are not that large.
+
+*/
+
+static void tex_aux_push_alignment(void)
+{
+ /*tex The new alignment stack node: */
+ halfword p = tex_new_node(align_stack_node, 0);
+ align_stack_align_ptr(p) = lmt_alignment_state.align_ptr;
+ align_stack_cur_align(p) = lmt_alignment_state.cur_align;
+ align_stack_preamble(p) = preamble;
+ align_stack_cur_span(p) = lmt_alignment_state.cur_span;
+ align_stack_cur_loop(p) = lmt_alignment_state.cur_loop;
+ align_stack_align_state(p) = lmt_input_state.align_state;
+ align_stack_wrap_source(p) = lmt_alignment_state.wrap_source;
+ align_stack_no_align_level(p) = lmt_alignment_state.no_align_level;
+ align_stack_cur_post_adjust_head(p) = lmt_alignment_state.cur_post_adjust_head;
+ align_stack_cur_post_adjust_tail(p) = lmt_alignment_state.cur_post_adjust_tail;
+ align_stack_cur_pre_adjust_head(p) = lmt_alignment_state.cur_pre_adjust_head;
+ align_stack_cur_pre_adjust_tail(p) = lmt_alignment_state.cur_pre_adjust_tail;
+ align_stack_cur_post_migrate_head(p) = lmt_alignment_state.cur_post_migrate_head;
+ align_stack_cur_post_migrate_tail(p) = lmt_alignment_state.cur_post_migrate_tail;
+ align_stack_cur_pre_migrate_head(p) = lmt_alignment_state.cur_pre_migrate_head;
+ align_stack_cur_pre_migrate_tail(p) = lmt_alignment_state.cur_pre_migrate_tail;
+ align_stack_no_tab_skips(p) = lmt_alignment_state.no_tab_skips;
+ align_stack_attr_list(p) = lmt_alignment_state.attr_list;
+ lmt_alignment_state.align_ptr = p;
+ lmt_alignment_state.cur_post_adjust_head = tex_new_temp_node();
+ lmt_alignment_state.cur_pre_adjust_head = tex_new_temp_node();
+ lmt_alignment_state.cur_post_migrate_head = tex_new_temp_node();
+ lmt_alignment_state.cur_pre_migrate_head = tex_new_temp_node();
+ /* */
+ lmt_alignment_state.cell_source = 0;
+ lmt_alignment_state.wrap_source = 0;
+}
+
+static void tex_aux_pop_alignment(void)
+{
+ /*tex The top alignment stack node: */
+ halfword p = lmt_alignment_state.align_ptr;
+ tex_flush_node(lmt_alignment_state.cur_post_adjust_head);
+ tex_flush_node(lmt_alignment_state.cur_pre_adjust_head);
+ tex_flush_node(lmt_alignment_state.cur_post_migrate_head);
+ tex_flush_node(lmt_alignment_state.cur_pre_migrate_head);
+ lmt_alignment_state.align_ptr = align_stack_align_ptr(p);
+ lmt_alignment_state.cur_align = align_stack_cur_align(p);
+ preamble = align_stack_preamble(p);
+ lmt_alignment_state.cur_span = align_stack_cur_span(p);
+ lmt_alignment_state.cur_loop = align_stack_cur_loop(p);
+ lmt_input_state.align_state = align_stack_align_state(p);
+ lmt_alignment_state.wrap_source = align_stack_wrap_source(p);
+ lmt_alignment_state.no_align_level = align_stack_no_align_level(p);
+ lmt_alignment_state.cur_post_adjust_head = align_stack_cur_post_adjust_head(p);
+ lmt_alignment_state.cur_post_adjust_tail = align_stack_cur_post_adjust_tail(p);
+ lmt_alignment_state.cur_pre_adjust_head = align_stack_cur_pre_adjust_head(p);
+ lmt_alignment_state.cur_pre_adjust_tail = align_stack_cur_pre_adjust_tail(p);
+ lmt_alignment_state.cur_post_migrate_head = align_stack_cur_post_migrate_head(p);
+ lmt_alignment_state.cur_post_migrate_tail = align_stack_cur_post_migrate_tail(p);
+ lmt_alignment_state.cur_pre_migrate_head = align_stack_cur_pre_migrate_head(p);
+ lmt_alignment_state.cur_pre_migrate_tail = align_stack_cur_pre_migrate_tail(p);
+ lmt_alignment_state.no_tab_skips = align_stack_no_tab_skips(p);
+ lmt_alignment_state.attr_list = align_stack_attr_list(p);
+ tex_flush_node(p);
+}
+
+/*tex
+
+ \TEX\ has eight procedures that govern alignments: |initialize_align| and |finish_align| are
+ used at the very beginning and the very end; |initialize_row| and |finish_row| are used at
+ the beginning and end of individual rows; |initialize_span| is used at the beginning of a
+ sequence of spanned columns (possibly involving only one column); |initialize_column| and
+ |finish_column| are used at the beginning and end of individual columns; and |align_peek| is
+ used after |\cr| to see whether the next item is |\noalign|.
+
+ We shall consider these routines in the order they are first used during the course of a
+ complete |\halign|, namely |initialize_align|, |align_peek|, |initialize_row|,
+ |initialize_span|, |initialize_column|, |finish_column|, |finish_row|, |finish_align|.
+
+ The preamble is copied directly, except that |\tabskip| causes a change to the tabskip glue,
+ thereby possibly expanding macros that immediately follow it. An appearance of |\span| also
+ causes such an expansion.
+
+ Note that if the preamble contains |\global\tabskip|, the |\global| token survives in the
+ preamble and the |\tabskip| defines new tabskip glue (locally).
+
+ We enter |\span| into |eqtb| with |tab_mark| as its command code, and with |span_code| as the
+ command modifier. This makes \TEX\ interpret it essentially the same as an alignment delimiter
+ like |&|, yet it is recognizably different when we need to distinguish it from a normal
+ delimiter. It also turns out to be useful to give a special |cr_code| to |\cr|, and an even
+ larger |cr_cr_code| to |\crcr|.
+
+ The end of a template is represented by two frozen control sequences called |\endtemplate|. The
+ first has the command code |end_template|, which is |> outer_call|, so it will not easily
+ disappear in the presence of errors. The |get_x_token| routine converts the first into the
+ second, which has |endv| as its command code.
+
+ The |cr_code| is distinct from |span_code| and from any character and |\crcr| differs from
+ |\cr|.
+*/
+
+/*
+ In \LUAMETATEX\ the code has been adapted a bit. Because we have some access to alignment
+ related properties (commands, lists, etc.) The command codes have been reshuffled and
+ combined. Instead of dedicated cmd codes, we have a shared cmd with subtypes. The logic
+ hasn't changed, just the triggering of actions. In theory there can be a performance penalty
+ (due to extra checking) but in practice that will not be noticed becasue this seldom happens.
+ The advange is that we have a uniform token interface. It also makes it possible to extend
+ the code.
+
+*/
+
+static void tex_aux_get_preamble_token(void)
+{
+ RESTART:
+ tex_get_token();
+ while (cur_cmd == alignment_cmd && cur_chr == span_code) {
+ /*tex This token will be expanded once. */
+ tex_get_token();
+ if (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ tex_get_token();
+ }
+ }
+ switch (cur_cmd) {
+ case end_template_cmd:
+ tex_alignment_interwoven_error(5);
+ break;
+ case internal_glue_cmd:
+ if (cur_chr == internal_glue_location(tab_skip_code)) {
+ halfword v = tex_scan_glue(glue_val_level, 1);
+ if (global_defs_par > 0) {
+ update_tex_tab_skip_global(v);
+ } else {
+ update_tex_tab_skip_local(v);
+ }
+ goto RESTART;
+ } else {
+ break;
+ }
+ case internal_dimen_cmd:
+ if (cur_chr == internal_dimen_location(tab_size_code)) {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ tex_word_define(global_defs_par > 0 ? global_flag_bit : 0, internal_dimen_location(tab_size_code), v);
+ goto RESTART;
+ } else {
+ break;
+ }
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ if (has_eq_flag_bits(cur_cs, noaligned_flag_bit)) {
+ tex_expand_current_token();
+ goto RESTART;
+ } else {
+ break;
+ }
+ }
+}
+
+/*tex
+
+ When |\halign| or |\valign| has been scanned in an appropriate mode, \TEX\ calls
+ |initialize_align|, whose task is to get everything off to a good start. This mostly involves
+ scanning the preamble and putting its information into the preamble list.
+
+*/
+
+static void tex_aux_scan_align_spec(quarterword c)
+{
+ quarterword mode = packing_additional;
+ quarterword reverse = 0;
+ quarterword discard = 0;
+ quarterword noskips = 0;
+ quarterword callback = 0;
+ scaled amount = 0;
+ halfword attrlist = null;
+ int brace = 0;
+ while (1) {
+ cur_val = 0; /* why */
+ switch (tex_scan_character("acdnrtsACDNRTS", 1, 1, 1)) {
+ case 0:
+ goto DONE;
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("attr", 1)) {
+ halfword i = tex_scan_attribute_register_number();
+ halfword v = tex_scan_int(1, NULL);
+ if (eq_value(register_attribute_location(i)) != v) {
+ if (attrlist) {
+ attrlist = tex_patch_attribute_list(attrlist, i, v);
+ } else {
+ attrlist = tex_copy_attribute_list_set(tex_current_attribute_list(), i, v);
+ }
+ }
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("callback", 1)) {
+ callback = 1;
+ }
+ break;
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("discard", 1)) {
+ discard = 1;
+ }
+ break;
+ case 'n': case 'N':
+ if (tex_scan_mandate_keyword("noskips", 1)) {
+ noskips = 1;
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("reverse", 1)) {
+ reverse = 1;
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("to", 1)) {
+ mode = packing_exactly;
+ amount = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("spread", 1)) {
+ mode = packing_additional;
+ amount = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case '{':
+ brace = 1;
+ goto DONE;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ if (! attrlist) {
+ /* this alse sets the reference when not yet set */
+ attrlist = tex_current_attribute_list();
+ }
+ /*tex Now we're referenced. We need to preserve this over the group. */
+ add_attribute_reference(attrlist);
+ tex_set_saved_record(saved_align_specification, saved_box_spec, mode, amount);
+ /* We save them but could put them in the state as we do for some anyway. */
+ tex_set_saved_record(saved_align_reverse, saved_box_reverse, reverse, 0);
+ tex_set_saved_record(saved_align_discard, saved_box_discard, noskips ? 0 : discard, 0);
+ tex_set_saved_record(saved_align_noskips, saved_box_noskips, noskips, 0);
+ tex_set_saved_record(saved_align_callback, saved_box_callback, callback, 0);
+ lmt_save_state.save_stack_data.ptr += saved_align_n_of_items;
+ tex_new_save_level(c);
+ if (! brace) {
+ tex_scan_left_brace();
+ }
+ lmt_alignment_state.no_tab_skips = noskips;
+ lmt_alignment_state.attr_list = attrlist;
+ lmt_alignment_state.callback = callback;
+}
+
+/*tex
+
+ The tricky part about alignments is getting the templates into the scanner at the right time,
+ and recovering control when a row or column is finished.
+
+ We usually begin a row after each |\cr| has been sensed, unless that |\cr| is followed by
+ |\noalign| or by the right brace that terminates the alignment. The |align_peek| routine is
+ used to look ahead and do the right thing; it either gets a new row started, or gets a
+ |\noalign} started, or finishes off the alignment.
+
+*/
+
+static void tex_aux_align_peek(void);
+
+static void tex_aux_trace_no_align(const char *s)
+{
+ if (tracing_alignments_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_format("[alignment: %s noalign, level %i]", s, lmt_alignment_state.no_align_level);
+ tex_end_diagnostic();
+ }
+}
+
+static void tex_aux_run_no_align(void)
+{
+ tex_scan_left_brace();
+ tex_new_save_level(no_align_group);
+ ++lmt_alignment_state.no_align_level;
+ tex_aux_trace_no_align("entering");
+ if (cur_list.mode == -vmode) {
+ tex_normal_paragraph(no_align_par_context);
+ }
+}
+static int tex_aux_nested_no_align(void)
+{
+ int state = lmt_alignment_state.no_align_level > 0;
+ if (state) {
+ tex_scan_left_brace();
+ tex_new_save_level(no_align_group);
+ ++lmt_alignment_state.no_align_level;
+ tex_aux_trace_no_align("entering");
+ if (cur_list.mode == -vmode) {
+ tex_normal_paragraph(no_align_par_context);
+ }
+ }
+ return state;
+}
+
+void tex_finish_no_alignment_group(void)
+{
+ if (! tex_wrapped_up_paragraph(no_align_par_context)) { /* needs testing */
+ tex_end_paragraph(no_align_group, no_align_par_context);
+ tex_aux_trace_no_align("leaving");
+ --lmt_alignment_state.no_align_level;
+ tex_unsave();
+ if (lmt_alignment_state.no_align_level == 0) {
+ tex_aux_align_peek();
+ }
+ }
+}
+
+static void tex_aux_align_peek(void)
+{
+ RESTART:
+ lmt_input_state.align_state = 1000000;
+ AGAIN:
+ tex_get_x_or_protected();
+ switch (cur_cmd) {
+ case spacer_cmd:
+ goto AGAIN;
+ case right_brace_cmd:
+ tex_aux_finish_align();
+ break;
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ if (has_eq_flag_bits(cur_cs, noaligned_flag_bit)) {
+ tex_expand_current_token();
+ goto RESTART;
+ } else {
+ goto NEXTROW;
+ }
+ case alignment_cmd:
+ switch (cur_chr) {
+ case cr_cr_code:
+ /*tex Ignore |\crcr|. */
+ goto RESTART;
+ case no_align_code:
+ tex_aux_run_no_align();
+ return;
+ }
+ // fall through
+ default:
+ NEXTROW:
+ /*tex Start a new row. */
+ tex_aux_initialize_row();
+ /*tex Start a new column and replace what we peeked at. */
+ tex_aux_initialize_column();
+ break;
+ }
+}
+
+/*tex
+*
+ Magick numbers are used to indicate the level of alignment. However, keep in mind that in
+ \LUANETATEX\ the fundamental parts of the rendering are separated. Contrary to traditional
+ \TEX\ we don't have the interwoven hyphenation, ligature building, kerning, etc.\ code.
+
+ In the end we have a list starting and ending with tabskips and align records seperated by
+ such skips.
+
+*/
+
+void tex_run_alignment_initialize(void)
+{
+ halfword saved_cs = cur_cs;
+ tex_aux_push_alignment();
+ lmt_input_state.align_state = -1000000;
+ /*tex
+ When |\halign| is used as a displayed formula, there should be no other pieces of mlists
+ present.
+ */
+ if (cur_list.mode == mmode && ((cur_list.tail != cur_list.head) || cur_list.incomplete_noad)) {
+ tex_handle_error(
+ normal_error_type,
+ "Improper \\halign inside math mode",
+ "Displays can use special alignments (like \\eqalignno) only if nothing but the\n"
+ "alignment itself is in math mode. So I've deleted the formulas that preceded this\n"
+ "alignment."
+ );
+ tex_flush_math();
+ }
+ /*tex We enter a new semantic level. */
+ tex_push_nest();
+ /*tex
+ In vertical modes, |prev_depth| already has the correct value. But if we are in |mmode|
+ (displayed formula mode), we reach out to the enclosing vertical mode for the |prev_depth|
+ value that produces the correct baseline calculations.
+ */
+ if (cur_list.mode == mmode) {
+ cur_list.mode = -vmode;
+ cur_list.prev_depth = lmt_nest_state.nest[lmt_nest_state.nest_data.ptr - 2].prev_depth;
+ } else if (cur_list.mode > 0) {
+ cur_list.mode = -cur_list.mode;
+ }
+ /*tex This one also saves some in the state. */
+ tex_aux_scan_align_spec(align_group);
+ /*tex
+ Scan the preamble. Even when we ignore zero tabskips, we do store them in the list because
+ the machinery later on steps over them and checking for present glue makes the code
+ horrible. The overhead is small because it's only the preamble where we waste glues then.
+ */
+ preamble = null;
+ lmt_alignment_state.cur_align = align_head;
+ lmt_alignment_state.cur_loop = null;
+ lmt_input_state.scanner_status = scanner_is_aligning;
+ lmt_input_state.warning_index = saved_cs;
+ lmt_input_state.align_state = -1000000;
+ /*tex At this point, |cur_cmd = left_brace|. */
+ while (1) {
+ /*tex Append the current tabskip glue to the preamble list. */
+ halfword glue = tex_new_param_glue_node(tab_skip_code, tab_skip_glue);
+ if (lmt_alignment_state.no_tab_skips && tex_glue_is_zero(glue)) {
+ node_subtype(glue) = ignored_glue;
+ }
+ tex_couple_nodes(lmt_alignment_state.cur_align, glue);
+ lmt_alignment_state.cur_align = glue;
+ if (cur_cmd == alignment_cmd && (cur_chr == cr_code || cur_chr == cr_cr_code)) { /* Also cr_cr here? */
+ /*tex A |\cr| ends the preamble. */
+ break;
+ } else {
+ /*tex
+ Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret| and then scan the
+ template |u_j|, putting the resulting token list in |hold_token_head|. Spaces are
+ eliminated from the beginning of a template.
+ */
+ halfword record = null;
+ halfword current = lmt_alignment_state.hold_token_head;
+ token_link(current) = null;
+ while (1) {
+ tex_aux_get_preamble_token();
+ if (cur_cmd == parameter_cmd || (cur_cmd == alignment_cmd && cur_chr == align_content_code)) {
+ break;
+ } else if ((cur_cmd == alignment_cmd || cur_cmd == alignment_tab_cmd) && (lmt_input_state.align_state == -1000000)) {
+ if ((current == lmt_alignment_state.hold_token_head) && (! lmt_alignment_state.cur_loop) && (cur_cmd == alignment_tab_cmd)) {
+ lmt_alignment_state.cur_loop = lmt_alignment_state.cur_align;
+ } else {
+ tex_back_input(cur_tok);
+ tex_handle_error(
+ normal_error_type,
+ "Missing # inserted in alignment preamble",
+ "There should be exactly one # between &'s, when an \\halign or \\valign is being\n"
+ "set up. In this case you had none, so I've put one in; maybe that will work."
+ );
+ break;
+ }
+ } else if (cur_cmd != spacer_cmd || current != lmt_alignment_state.hold_token_head) {
+ current = tex_store_new_token(current, cur_tok);
+ }
+ }
+ /*tex A new align record: */
+ record = tex_new_node(align_record_node, 0);
+ tex_couple_nodes(lmt_alignment_state.cur_align, record);
+ lmt_alignment_state.cur_align = record;
+ align_record_span_ptr(record) = end_span;
+ box_width(record) = null_flag;
+ align_record_pre_part(record) = token_link(lmt_alignment_state.hold_token_head);
+ /*tex Scan the template |v_j|, putting the resulting token list in |hold_token_head|. */
+ current = lmt_alignment_state.hold_token_head;
+ token_link(current) = null;
+ while (1) {
+ tex_aux_get_preamble_token();
+ if ((cur_cmd == alignment_cmd || cur_cmd == alignment_tab_cmd) && (lmt_input_state.align_state == -1000000)) {
+ break;
+ } else if (cur_cmd == parameter_cmd || (cur_cmd == alignment_cmd && cur_chr == align_content_code)) {
+ tex_handle_error(
+ normal_error_type,
+ "Only one # is allowed per tab",
+ "There should be exactly one # between &'s, when an \\halign or \\valign is being\n"
+ "set up. In this case you had more than one, so I'm ignoring all but the first."
+ );
+ } else {
+ current = tex_store_new_token(current, cur_tok);
+ }
+ }
+ if (tab_size_par > 0) {
+ box_size(record) = tab_size_par;
+ set_box_package_state(record, package_dimension_size_set);
+ } else {
+ box_width(record) = null_flag;
+ }
+ /*tex Put |\endtemplate| at the end: */
+ current = tex_store_new_token(current, deep_frozen_end_template_1_token);
+ align_record_post_part(lmt_alignment_state.cur_align) = token_link(lmt_alignment_state.hold_token_head);
+ }
+ }
+ if (tracing_alignments_par > 1) {
+ tex_print_levels();
+ tex_print_str("<alignment preamble>");
+ tex_show_node_list(preamble, max_integer, max_integer);
+ }
+ if (lmt_alignment_state.callback) {
+ lmt_alignment_callback(cur_list.head, preamble_pass_alignment_context, lmt_alignment_state.attr_list, preamble);
+ }
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_new_save_level(align_group);
+ if (every_cr_par) {
+ tex_begin_token_list(every_cr_par, every_cr_text);
+ }
+ /*tex Look for |\noalign| or |\omit|. */
+ tex_aux_align_peek();
+}
+
+void tex_finish_alignment_group(void)
+{
+ tex_back_input(cur_tok);
+ cur_tok = deep_frozen_cr_token;
+ tex_handle_error(
+ insert_error_type,
+ "Missing \\cr inserted",
+ "I'm guessing that you meant to end an alignment here."
+ );
+}
+
+/*tex
+
+ The parameter to |initialize_span| is a pointer to the alignrecord where the next column or group
+ of columns will begin. A new semantic level is entered, so that the columns will generate a list
+ for subsequent packaging.
+
+*/
+
+static void tex_aux_initialize_span(halfword p)
+{
+ tex_push_nest();
+ if (cur_list.mode == -hmode) {
+ cur_list.space_factor = 1000;
+ } else {
+ cur_list.prev_depth = ignore_depth;
+ tex_normal_paragraph(span_par_context);
+ }
+ lmt_alignment_state.cur_span = p;
+}
+
+/*tex
+
+ To start a row (i.e., a \quote {row} that rhymes with \quote {dough} but not with \quote
+ {bough}), we enter a new semantic level, copy the first tabskip glue, and change from internal
+ vertical mode to restricted horizontal mode or vice versa. The |space_factor| and |prev_depth|
+ are not used on this semantic level, but we clear them to zero just to be tidy.
+
+*/
+
+static void tex_aux_initialize_row(void)
+{
+ tex_push_nest();
+ cur_list.mode = (- hmode - vmode) - cur_list.mode; /* weird code */
+ if (cur_list.mode == -hmode) {
+ cur_list.space_factor = 0;
+ } else {
+ cur_list.prev_depth = 0;
+ }
+ lmt_alignment_state.cur_align = preamble;
+ if (node_subtype(preamble) != ignored_glue) {
+ halfword glue = tex_new_glue_node(preamble, tab_skip_glue);
+ tex_tail_append(glue);
+ tex_attach_attribute_list_attribute(glue, lmt_alignment_state.attr_list);
+ }
+ lmt_alignment_state.cur_align = node_next(preamble);
+ lmt_alignment_state.cur_post_adjust_tail = lmt_alignment_state.cur_post_adjust_head;
+ lmt_alignment_state.cur_pre_adjust_tail = lmt_alignment_state.cur_pre_adjust_head;
+ lmt_alignment_state.cur_post_migrate_tail = lmt_alignment_state.cur_post_migrate_head;
+ lmt_alignment_state.cur_pre_migrate_tail = lmt_alignment_state.cur_pre_migrate_head;
+ tex_aux_initialize_span(lmt_alignment_state.cur_align);
+}
+
+/*tex
+
+ When a column begins, we assume that |cur_cmd| is either |omit| or else the current token should
+ be put back into the input until the \<u_j> template has been scanned. Note that |cur_cmd| might
+ be |tab_mark| or |car_ret|. We also assume that |align_state| is approximately 1000000 at this
+ time. We remain in the same mode, and start the template if it is called for.
+
+*/
+
+static void tex_aux_initialize_column(void)
+{
+ align_record_cmd(lmt_alignment_state.cur_align) = cur_cmd;
+ align_record_chr(lmt_alignment_state.cur_align) = cur_chr;
+ if (cur_cmd == alignment_cmd && cur_chr == omit_code) {
+ lmt_input_state.align_state = 0;
+ } else {
+ tex_back_input(cur_tok);
+ if (every_tab_par) {
+ tex_begin_token_list(every_tab_par, every_tab_text);
+ }
+ tex_begin_token_list(align_record_pre_part(lmt_alignment_state.cur_align), template_pre_text);
+ }
+ /*tex Now |align_state = 1000000|, one of these magic numbers. */
+}
+
+/*tex
+
+ The scanner sets |align_state| to zero when the |u_j| template ends. When a subsequent |\cr|
+ or |\span| or tab mark occurs with |align_state=0|, the scanner activates the following code,
+ which fires up the |v_j| template. We need to remember the |cur_chr|, which is either
+ |cr_cr_code|, |cr_code|, |span_code|, or a character code, depending on how the column text has
+ ended.
+
+ This part of the program had better not be activated when the preamble to another alignment is
+ being scanned, or when no alignment preamble is active.
+
+*/
+
+void tex_insert_alignment_template(void)
+{
+ if (lmt_input_state.scanner_status == scanner_is_aligning || ! lmt_alignment_state.cur_align) {
+ tex_alignment_interwoven_error(6);
+ } else {
+ /*tex in case of an |\omit| the gets discarded and is nowhere else referenced. */
+ halfword cmd = align_record_cmd(lmt_alignment_state.cur_align);
+ halfword chr = align_record_chr(lmt_alignment_state.cur_align);
+ halfword tok = (cmd == alignment_cmd && chr == omit_code) ? lmt_alignment_state.omit_template : align_record_post_part(lmt_alignment_state.cur_align);
+ align_record_cmd(lmt_alignment_state.cur_align) = cur_cmd;
+ align_record_chr(lmt_alignment_state.cur_align) = cur_chr;
+ tex_begin_token_list(tok, template_post_text);
+ lmt_input_state.align_state = 1000000;
+ lmt_alignment_state.cell_source = alignment_cell_source_par;
+ if (alignment_wrap_source_par) {
+ lmt_alignment_state.wrap_source = alignment_wrap_source_par;
+ }
+ }
+}
+
+/*tex Determine the stretch or shrink order */
+
+inline static halfword tex_aux_determine_order(scaled *total)
+{
+ if (total[filll_glue_order]) return filll_glue_order;
+ else if (total[fill_glue_order]) return fill_glue_order;
+ else if (total[fil_glue_order]) return fil_glue_order;
+ else if (total[fi_glue_order]) return fi_glue_order;
+ else return normal_glue_order;
+}
+
+/*tex
+
+ A span node is a 3-word record containing |width|, |span_span|, and |span_ptr| fields. The
+ |span_span| field indicates the number of spanned columns; the |span_ptr| field points to a
+ span node for the same starting column, having a greater extent of spanning, or to |end_span|,
+ which has the largest possible |span_span| field; the |width| field holds the largest natural
+ width corresponding to a particular set of spanned columns.
+
+ A list of the maximum widths so far, for spanned columns starting at a given column, begins
+ with the |span_ptr| field of the alignrecord for that column. The code has to make sure that
+ there is room for |span_ptr| in both the align record and the span nodes, which is why
+ |span_ptr| replaces |node_attr|.
+
+*/
+
+static halfword tex_aux_new_span_node(halfword n, int s, scaled w)
+{
+ halfword p = tex_new_node(span_node, 0);
+ span_ptr(p) = n; /*tex This one overlaps with |alignment_record_ptr|. */
+ span_span(p) = s;
+ span_width(p) = w;
+ return p;
+}
+
+/*tex
+
+ When the |end_template| command at the end of a |v_j| template comes through the scanner,
+ things really start to happen; and it is the |finialize_column| routine that makes them happen.
+ This routine returns |true| if a row as well as a column has been finished.
+
+*/
+
+void tex_alignment_interwoven_error(int n)
+{
+ tex_formatted_error("alignment", "interwoven preambles are not allowed, case %d", n);
+}
+
+halfword tex_alignment_hold_token_head(void)
+{
+ return lmt_alignment_state.hold_token_head;
+}
+
+static int tex_aux_finish_column(void)
+{
+ if (! lmt_alignment_state.cur_align) {
+ tex_confusion("end template, case 1");
+ } else {
+ halfword q = node_next(lmt_alignment_state.cur_align);
+ if (! q) {
+ tex_confusion("end template, case 2");
+ } else if (lmt_input_state.align_state < 500000) {
+ tex_alignment_interwoven_error(1);
+ } else {
+ /*tex A few state variables. */
+ halfword cmd = align_record_cmd(lmt_alignment_state.cur_align);
+ halfword chr = align_record_chr(lmt_alignment_state.cur_align);
+ /*tex
+ We check the alignrecord after the current one. If the preamble list has been
+ traversed, check that the row has ended.
+ */
+ halfword record = node_next(q);
+ if (alignment_wrap_source_par) {
+ lmt_alignment_state.wrap_source = alignment_wrap_source_par;
+ }
+ if (! record && ! ((cmd == alignment_cmd) && (chr == cr_code || chr == cr_cr_code))) {
+ if (lmt_alignment_state.cur_loop) {
+ /*tex Lengthen the preamble periodically. A new align record: */
+ record = tex_new_node(align_record_node, 0);
+ tex_couple_nodes(q, record);
+ align_record_span_ptr(record) = end_span;
+ box_width(record) = null_flag;
+ lmt_alignment_state.cur_loop = node_next(lmt_alignment_state.cur_loop);
+ /*tex Copy the templates from node |cur_loop| into node |p|. */
+ {
+ halfword q = lmt_alignment_state.hold_token_head;
+ halfword r = align_record_pre_part(lmt_alignment_state.cur_loop);
+ while (r) {
+ q = tex_store_new_token(q, token_info(r));
+ r = token_link(r);
+ }
+ token_link(q) = null;
+ align_record_pre_part(record) = token_link(lmt_alignment_state.hold_token_head);
+ }
+ {
+ halfword q = lmt_alignment_state.hold_token_head;
+ halfword r = align_record_post_part(lmt_alignment_state.cur_loop);
+ while (r) {
+ q = tex_store_new_token(q, token_info(r));
+ r = token_link(r);
+ }
+ token_link(q) = null;
+ align_record_post_part(record) = token_link(lmt_alignment_state.hold_token_head);
+ }
+ lmt_alignment_state.cur_loop = node_next(lmt_alignment_state.cur_loop);
+ {
+ halfword glue = tex_new_glue_node(lmt_alignment_state.cur_loop, tab_skip_glue);
+ if (lmt_alignment_state.no_tab_skips && tex_glue_is_zero(glue)) {
+ node_subtype(glue) = ignored_glue;
+ }
+ tex_couple_nodes(record, glue);
+ }
+ } else {
+ chr = cr_code;
+ align_record_chr(lmt_alignment_state.cur_align) = chr;
+ tex_handle_error(
+ normal_error_type,
+ "Extra alignment tab has been changed to \\cr",
+ "You have given more \\span or & marks than there were in the preamble to the\n"
+ "\\halign or \\valign now in progress. So I'll assume that you meant to type \\cr\n"
+ "instead."
+ );
+ }
+ }
+ if (! (cmd == alignment_cmd && chr == span_code)) {
+ /*tex a new unset box */
+ halfword cell = null;
+ /*tex natural width */
+ scaled width = 0;
+ scaled size = 0;
+ int state = 0;
+ int packing = packing_additional;
+ /*tex The span counter. */
+ halfword spans = 0;
+ tex_unsave();
+ tex_new_save_level(align_group);
+ /*tex Package an unset box for the current column and record its width. */
+ state = has_box_package_state(lmt_alignment_state.cur_align, package_dimension_size_set);
+ if (state) {
+ size = box_size(lmt_alignment_state.cur_align);
+ packing = packing_exactly;
+ }
+ if (cur_list.mode == -hmode) {
+ lmt_packaging_state.post_adjust_tail = lmt_alignment_state.cur_post_adjust_tail;
+ lmt_packaging_state.pre_adjust_tail = lmt_alignment_state.cur_pre_adjust_tail;
+ lmt_packaging_state.post_migrate_tail = lmt_alignment_state.cur_post_migrate_tail;
+ lmt_packaging_state.pre_migrate_tail = lmt_alignment_state.cur_pre_migrate_tail;
+ cell = tex_filtered_hpack(cur_list.head, cur_list.tail, size, packing, align_set_group, direction_unknown, 0, null, 0, 0);
+ width = box_width(cell);
+ lmt_alignment_state.cur_post_adjust_tail = lmt_packaging_state.post_adjust_tail;
+ lmt_alignment_state.cur_pre_adjust_tail = lmt_packaging_state.pre_adjust_tail;
+ lmt_alignment_state.cur_post_migrate_tail = lmt_packaging_state.post_migrate_tail;
+ lmt_alignment_state.cur_pre_migrate_tail = lmt_packaging_state.pre_migrate_tail;
+ lmt_packaging_state.post_adjust_tail = null;
+ lmt_packaging_state.pre_adjust_tail = null;
+ lmt_packaging_state.post_migrate_tail = null;
+ lmt_packaging_state.pre_migrate_tail = null;
+ } else {
+ cell = tex_filtered_vpack(node_next(cur_list.head), size, packing, 0, align_set_group, direction_unknown, 0, null, 0, 0);
+ width = box_height(cell);
+ }
+ if (lmt_alignment_state.cell_source) {
+ box_source_anchor(cell) = lmt_alignment_state.cell_source;
+ tex_set_box_geometry(cell, anchor_geometry);
+ }
+ tex_attach_attribute_list_attribute(cell, lmt_alignment_state.attr_list);
+ if (lmt_alignment_state.cur_span != lmt_alignment_state.cur_align) {
+ /*tex Update width entry for spanned columns. */
+ halfword ptr = lmt_alignment_state.cur_span;
+ do {
+ ++spans;
+ ptr = node_next(node_next(ptr));
+ } while (ptr != lmt_alignment_state.cur_align);
+ if (spans > max_quarterword) {
+ /*tex This can happen, but won't. */
+ tex_confusion("too many spans");
+ }
+ ptr = lmt_alignment_state.cur_span;
+ while (span_span(align_record_span_ptr(ptr)) < spans) {
+ ptr = align_record_span_ptr(ptr);
+ }
+ if (span_span(align_record_span_ptr(ptr)) > spans) {
+ halfword span = tex_aux_new_span_node(align_record_span_ptr(ptr), spans, width);
+ align_record_span_ptr(ptr) = span;
+ } else if (span_width(align_record_span_ptr(ptr)) < width) {
+ span_width(align_record_span_ptr(ptr)) = width;
+ }
+ } else if (width > box_width(lmt_alignment_state.cur_align)) {
+ box_width(lmt_alignment_state.cur_align) = width;
+ }
+ tex_aux_change_list_type(cell, unset_node);
+ box_span_count(cell) = spans;
+ if (! state) {
+ halfword order = tex_aux_determine_order(lmt_packaging_state.total_stretch);
+ box_glue_order(cell) = order;
+ box_glue_stretch(cell) = lmt_packaging_state.total_stretch[order];
+ order = tex_aux_determine_order(lmt_packaging_state.total_shrink);
+ box_glue_sign(cell) = order; /* hm, sign */
+ box_glue_shrink(cell) = lmt_packaging_state.total_shrink[order];
+ }
+ tex_pop_nest();
+ tex_tail_append(cell);
+ /*tex Copy the tabskip glue between columns. */
+ if (node_subtype(node_next(lmt_alignment_state.cur_align)) != ignored_glue) {
+ halfword glue = tex_new_glue_node(node_next(lmt_alignment_state.cur_align), tab_skip_glue);
+ tex_attach_attribute_list_attribute(cell, lmt_alignment_state.attr_list);
+ tex_tail_append(glue);
+ }
+ if (cmd == alignment_cmd && (chr == cr_code || chr == cr_cr_code)) {
+ return 1;
+ } else {
+ tex_aux_initialize_span(record);
+ }
+ }
+ lmt_input_state.align_state = 1000000;
+ do {
+ tex_get_x_or_protected();
+ } while (cur_cmd == spacer_cmd);
+ lmt_alignment_state.cur_align = record;
+ tex_aux_initialize_column();
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ At the end of a row, we append an unset box to the current vlist (for |\halign|) or the current
+ hlist (for |\valign|). This unset box contains the unset boxes for the columns, separated by
+ the tabskip glue. Everything will be set later.
+
+*/
+
+static void tex_aux_finish_row(void)
+{
+ halfword row;
+ if (cur_list.mode == -hmode) {
+ row = tex_filtered_hpack(cur_list.head, cur_list.tail, 0, packing_additional, finish_row_group, direction_unknown, 0, null, 0, 0);
+ tex_pop_nest();
+ if (lmt_alignment_state.cur_pre_adjust_head != lmt_alignment_state.cur_pre_adjust_tail) {
+ tex_inject_adjust_list(lmt_alignment_state.cur_pre_adjust_head, 0, null, NULL);
+ }
+ if (lmt_alignment_state.cur_pre_migrate_head != lmt_alignment_state.cur_pre_migrate_tail) {
+ tex_append_list(lmt_alignment_state.cur_pre_migrate_head, lmt_alignment_state.cur_pre_migrate_tail);
+ }
+ tex_append_to_vlist(row, lua_key_index(alignment), NULL);
+ if (lmt_alignment_state.cur_post_migrate_head != lmt_alignment_state.cur_post_migrate_tail) {
+ tex_append_list(lmt_alignment_state.cur_post_migrate_head, lmt_alignment_state.cur_post_migrate_tail);
+ }
+ if (lmt_alignment_state.cur_post_adjust_head != lmt_alignment_state.cur_post_adjust_tail) {
+ tex_inject_adjust_list(lmt_alignment_state.cur_post_adjust_head, 0, null, NULL);
+ }
+ } else {
+ row = tex_filtered_vpack(node_next(cur_list.head), 0, packing_additional, max_depth_par, finish_row_group, direction_unknown, 0, null, 0, 0);
+ tex_pop_nest();
+ tex_tail_append(row);
+ cur_list.space_factor = 1000;
+ }
+ if (lmt_alignment_state.wrap_source) {
+ box_source_anchor(row) = lmt_alignment_state.wrap_source;
+ tex_set_box_geometry(row, anchor_geometry);
+ }
+ tex_aux_change_list_type(row, unset_node);
+ tex_attach_attribute_list_attribute(row, lmt_alignment_state.attr_list);
+ if (every_cr_par) {
+ tex_begin_token_list(every_cr_par, every_cr_text);
+ }
+ tex_aux_align_peek();
+ /*tex Note that |glue_shrink(p) = 0| since |glue_shrink == shift_amount|. */
+}
+
+/*tex
+
+ Finally, we will reach the end of the alignment, and we can breathe a sigh of relief that
+ memory hasn't overflowed. All the unset boxes will now be set so that the columns line up,
+ taking due account of spanned columns.
+
+ Normalizing by stripping zero tabskips makes the lists a little smaller which then is easier
+ on later processing. But is is an option. We could actually not inject zero skips at all but
+ then the code starts deviating too much. In some cases it can save a lot of zero glue nodes
+ but we allocate them initially anyway. We don't save runtime here. (Some day I'll play a bit
+ more with this and then probably also implement some pending extensions.)
+
+*/
+
+static void tex_aux_strip_zero_tab_skips(halfword q)
+{
+ halfword h = box_list(q);
+ halfword t = h;
+ while (t) {
+ halfword n = node_next(t);
+ if (node_type(t) == glue_node && node_subtype(t) == tab_skip_glue && tex_glue_is_zero(t)) {
+ tex_try_couple_nodes(node_prev(t),n);
+ if (t == h) {
+ /*tex We only come here once. */
+ h = n;
+ box_list(q) = h;
+ }
+ tex_flush_node(t);
+ }
+ t = n;
+ }
+}
+
+static void tex_aux_finish_align(void)
+{
+ /*tex a shared register for the list operations (others are localized) */
+ halfword preroll;
+ /*tex shift offset for unset boxes */
+ scaled offset = 0;
+ /*tex something new */
+ halfword reverse = 0;
+ halfword callback = lmt_alignment_state.callback;
+ halfword discard = normalize_line_mode_permitted(normalize_line_mode_par, discard_zero_tab_skips_mode);
+ /*tex The |align_group| was for individual entries: */
+ if (cur_group != align_group) {
+ tex_confusion("align, case 1");
+ }
+ tex_unsave();
+ /*tex The |align_group| was for the whole alignment: */
+ if (cur_group != align_group) {
+ tex_confusion("align, case 2");
+ }
+ tex_unsave();
+ if (lmt_nest_state.nest[lmt_nest_state.nest_data.ptr - 1].mode == mmode) {
+ offset = display_indent_par;
+ }
+ lmt_save_state.save_stack_data.ptr -= saved_align_n_of_items;
+ lmt_packaging_state.pack_begin_line = -cur_list.mode_line;
+ reverse = saved_level(saved_align_reverse); /* we can as well save these in the state */
+ discard = discard || saved_level(saved_align_discard); /* we can as well save these in the state */
+ /*tex
+ All content is available now so this is a perfect spot for some processing. However, we
+ cannot mess with the unset boxes (as these can have special properties). The main reason
+ for some postprocessing can be to align (vertically) at a specific location in a cell
+ but then we also need to process twice (and adapt the width in the preamble record).
+
+ We flush the tokenlists so that in principle we can access the align record nodes as normal
+ lists.
+ */
+ {
+ halfword q = node_next(preamble);
+ do {
+ tex_flush_token_list(align_record_pre_part(q));
+ tex_flush_token_list(align_record_post_part(q));
+ align_record_pre_part(q) = null;
+ align_record_post_part(q) = null;
+ q = node_next(node_next(q));
+ } while (q);
+ }
+ if (callback) {
+ lmt_alignment_callback(cur_list.head, preroll_pass_alignment_context, lmt_alignment_state.attr_list, preamble);
+ }
+ /*tex
+
+ Go through the preamble list, determining the column widths and changing the alignrecords
+ to dummy unset boxes.
+
+ It's time now to dismantle the preamble list and to compute the column widths. Let $w_{ij}$
+ be the maximum of the natural widths of all entries that span columns $i$ through $j$,
+ inclusive. The alignrecord for column~$i$ contains $w_{ii}$ in its |width| field, and there
+ is also a linked list of the nonzero $w_{ij}$ for increasing $j$, accessible via the |info|
+ field; these span nodes contain the value $j-i+|min_quarterword|$ in their |link| fields.
+ The values of $w_{ii}$ were initialized to |null_flag|, which we regard as $-\infty$.
+
+ The final column widths are defined by the formula $$ w_j = \max_{1\L i\L j} \biggl( w_{ij}
+ - \sum_{i\L k < j}(t_k + w_k) \biggr), $$ where $t_k$ is the natural width of the tabskip
+ glue between columns $k$ and~$k + 1$. However, if $w_{ij} = -\infty$ for all $i$ in the
+ range $1 <= i <= j$ (i.e., if every entry that involved column~$j$ also involved column~$j
+ + 1$), we let $w_j = 0$, and we zero out the tabskip glue after column~$j$.
+
+ \TEX\ computes these values by using the following scheme: First $w_1 = w_{11}$. Then
+ replace $w_{2j}$ by $\max(w_{2j}, w_{1j} - t_1 - w_1)$, for all $j > 1$. Then $w_2 =
+ w_{22}$. Then replace $w_{3j}$ by $\max(w_{3j}, w_{2j} - t_2 - w_2)$ for all $j > 2$; and
+ so on. If any $w_j$ turns out to be $-\infty$, its value is changed to zero and so is the
+ next tabskip.
+
+ */
+ {
+ halfword q = node_next(preamble);
+ do {
+ /* So |q| and |p| point to alignment nodes that become unset ones. */
+ halfword p = node_next(node_next(q));
+ if (box_width(q) == null_flag) {
+ /*tex Nullify |width(q)| and the tabskip glue following this column. */
+ box_width(q) = 0;
+ tex_reset_glue_to_zero(node_next(q));
+ }
+ if (align_record_span_ptr(q) != end_span) {
+ /*tex
+
+ Merge the widths in the span nodes of |q| with those of |p|, destroying the
+ span nodes of |q|.
+
+ Merging of two span-node lists is a typical exercise in the manipulation of
+ linearly linked data structures. The essential invariant in the following
+ |repeat| loop is that we want to dispense with node |r|, in |q|'s list, and
+ |u| is its successor; all nodes of |p|'s list up to and including |s| have
+ been processed, and the successor of |s| matches |r| or precedes |r| or follows
+ |r|, according as |link(r) = n| or |link(r) > n| or |link(r) < n|.
+
+ */
+ halfword t = box_width(q) + glue_amount(node_next(q));
+ halfword n = 1;
+ halfword r = align_record_span_ptr(q);
+ halfword s = end_span;
+ align_record_span_ptr(s) = p;
+ do {
+ halfword u = align_record_span_ptr(r);
+ span_width(r) -= t;
+ while (span_span(r) > n) {
+ s = align_record_span_ptr(s);
+ n = span_span(align_record_span_ptr(s)) + 1;
+ }
+ if (span_span(r) < n) {
+ align_record_span_ptr(r) = align_record_span_ptr(s);
+ align_record_span_ptr(s) = r;
+ --span_span(r);
+ s = r;
+ } else {
+ if (span_width(r) > span_width(align_record_span_ptr(s))) {
+ span_width(align_record_span_ptr(s)) = span_width(r);
+ }
+ tex_flush_node(r);
+ }
+ r = u;
+ } while (r != end_span);
+ }
+ tex_aux_change_list_type(q, unset_node);
+ box_glue_order(q) = normal_glue_order;
+ box_glue_sign(q) = normal_glue_sign;
+ box_height(q) = 0;
+ box_depth(q) = 0;
+ q = p;
+ } while (q);
+ }
+ if (callback) {
+ lmt_alignment_callback(cur_list.head, package_pass_alignment_context, lmt_alignment_state.attr_list, preamble);
+ }
+ /*tex
+
+ Package the preamble list, to determine the actual tabskip glue amounts, and let |p| point
+ to this prototype box.
+
+ Now the preamble list has been converted to a list of alternating unset boxes and tabskip
+ glue, where the box widths are equal to the final column sizes. In case of |\valign|, we
+ change the widths to heights, so that a correct error message will be produced if the
+ alignment is overfull or underfull.
+
+ */
+ if (cur_list.mode == -vmode) {
+ halfword rule_save = overfull_rule_par;
+ /*tex Prevent the rule from being packaged. */
+ overfull_rule_par = 0;
+ preroll = tex_hpack(preamble, saved_value(saved_align_specification), saved_extra(saved_align_specification), direction_unknown, holding_none_option);
+ overfull_rule_par = rule_save;
+ } else {
+ halfword unset = node_next(preamble);
+ do {
+ box_height(unset) = box_width(unset);
+ box_width(unset) = 0;
+ unset = node_next(node_next(unset));
+ } while (unset);
+ /* why filtered here ... */
+ preroll = tex_filtered_vpack(preamble, saved_value(saved_align_specification), saved_extra(saved_align_specification), max_depth_par, preamble_group, direction_unknown, 0, 0, 0, holding_none_option);
+ /* ... so we'll do this soon instead: */
+ /* preroll = tex_vpack(preamble, saved_value(saved_align_specification), saved_extra(saved_align_specification), max_depth_par, direction_unknown, migrate_all_option); */
+ unset = node_next(preamble);
+ do {
+ box_width(unset) = box_height(unset);
+ box_height(unset) = 0;
+ unset = node_next(node_next(unset));
+ } while (unset);
+ }
+ lmt_packaging_state.pack_begin_line = 0;
+ /*tex
+ Here we set the glue in all the unset boxes of the current list based on the prerolled
+ preamble.
+ */
+ {
+ halfword rowptr = node_next(cur_list.head);
+ while (rowptr) {
+ switch (node_type(rowptr)) {
+ case unset_node:
+ {
+ /*tex
+ We set the unset box |q| and the unset boxes in it. The unset box |q|
+ represents a row that contains one or more unset boxes, depending on
+ how soon |\cr| occurred in that row.
+
+ We also reset some fields but this needs checking because we never set
+ set them in these unset boxes but in the preamble ones.
+ */
+ halfword preptr;
+ halfword colptr;
+ if (cur_list.mode == -vmode) {
+ tex_aux_change_list_type(rowptr, hlist_node);
+ box_width(rowptr) = box_width(preroll);
+ } else {
+ tex_aux_change_list_type(rowptr, vlist_node);
+ box_height(rowptr) = box_height(preroll);
+ }
+ node_subtype(rowptr) = align_row_list;
+ box_glue_order(rowptr) = box_glue_order(preroll);
+ box_glue_sign(rowptr) = box_glue_sign(preroll);
+ box_glue_set(rowptr) = box_glue_set(preroll);
+ box_shift_amount(rowptr) = offset;
+ colptr = box_list(rowptr);
+ preptr = box_list(preroll);
+ if (node_type(colptr) == glue_node) {
+ colptr = node_next(colptr);
+ }
+ if (node_type(preptr) == glue_node) {
+ preptr = node_next(preptr);
+ }
+ if (node_type(colptr) != unset_node) {
+ tex_formatted_error("alignment", "bad box");
+ }
+ do {
+ /*tex
+ We set the glue in node |r| and change it from an unset node. A box
+ made from spanned columns will be followed by tabskip glue nodes
+ and by empty boxes as if there were no spanning. This permits
+ perfect alignment of subsequent entries, and it prevents values
+ that depend on floating point arithmetic from entering into the
+ dimensions of any boxes.
+ */
+ halfword spans = box_span_count(colptr);
+ scaled total = box_width(preptr);
+ scaled width = total; /*tex The width of a column. */
+ halfword tail = hold_head;
+ int state = has_box_package_state(preptr, package_dimension_size_set);
+ /*tex
+ When we have a span we need to add dummies. We append tabskip glue
+ and an empty box to list |u|, and update |s| and |t| as the
+ prototype nodes are passed. We could shortcut some code when we
+ have zero skips but we seldom end up in this branch anyway.
+ */
+ while (spans > 0) {
+ --spans;
+ preptr = node_next(preptr);
+ if (node_subtype(preptr) != ignored_glue) {
+ /* halfword glue = tex_new_glue_node(preptr, tab_skip_glue); */
+ halfword glue = tex_new_glue_node(preptr, node_subtype(preptr));
+ tex_try_couple_nodes(tail, glue);
+ tex_attach_attribute_list_attribute(glue, lmt_alignment_state.attr_list);
+ total += glue_amount(preptr);
+ /*tex The |glueratio| case is redundant, anyway ... */
+ switch (box_glue_sign(preroll)) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(preptr) == box_glue_order(preroll)) {
+ total += glueround((glueratio) (box_glue_set(preroll)) * (glueratio) (glue_stretch(preptr)));
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(preptr) == box_glue_order(preroll)) {
+ total -= glueround((glueratio) (box_glue_set(preroll)) * (glueratio) (glue_shrink(preptr)));
+ }
+ break;
+ }
+ tail = glue;
+ /*tex Move on to the box. */
+ }
+ preptr = node_next(preptr);
+ {
+ halfword box = tex_new_null_box_node(cur_list.mode == -vmode ? hlist_node : vlist_node, align_cell_list);
+ tex_couple_nodes(tail, box);
+ tex_attach_attribute_list_attribute(box, lmt_alignment_state.attr_list);
+ total += box_width(preptr);
+ if (cur_list.mode == -vmode) {
+ box_width(box) = box_width(preptr);
+ } else {
+ box_height(box) = box_width(preptr);
+ }
+ tail = box;
+ }
+ }
+ if (cur_list.mode == -vmode) {
+ /*tex
+ Make the unset node |r| into an |hlist_node| of width |w|,
+ setting the glue as if the width were |t|.
+ */
+ box_height(colptr) = box_height(rowptr);
+ box_depth(colptr) = box_depth(rowptr);
+ if (! state) {
+ if (total == box_width(colptr)) {
+ box_glue_sign(colptr) = normal_glue_sign;
+ box_glue_order(colptr) = normal_glue_order;
+ box_glue_set(colptr) = 0.0;
+ } else if (total > box_width(colptr)) {
+ box_glue_sign(colptr) = stretching_glue_sign;
+ if (box_glue_stretch(colptr) == 0) {
+ box_glue_set(colptr) = 0.0;
+ } else {
+ box_glue_set(colptr) = (glueratio) ( ( (glueratio) total - (glueratio) box_width(colptr) ) / ( (glueratio) box_glue_stretch(colptr) ) );
+ }
+ } else {
+ box_glue_order(colptr) = box_glue_sign(colptr);
+ box_glue_sign(colptr) = shrinking_glue_sign;
+ if (box_glue_shrink(colptr) == 0) {
+ box_glue_set(colptr) = 0.0;
+ } else if ((box_glue_order(colptr) == normal_glue_order) && (box_width(colptr) - total > box_glue_shrink(colptr))) {
+ box_glue_set(colptr) = 1.0;
+ } else {
+ box_glue_set(colptr) = (glueratio) ( ( (glueratio) box_width(colptr) - (glueratio) total ) / ( (glueratio) box_glue_shrink(colptr) ) );
+ }
+ }
+ }
+ box_width(colptr) = width;
+ tex_aux_change_list_type(colptr, hlist_node);
+ node_subtype(colptr) = align_cell_list;
+ } else {
+ /*tex
+ Make the unset node |r| into a |vlist_node| of height |w|,
+ setting the glue as if the height were |t|.
+ */
+ box_width(colptr) = box_width(rowptr);
+ if (! state) {
+ if (total == box_height(colptr)) {
+ box_glue_sign(colptr) = normal_glue_sign;
+ box_glue_order(colptr) = normal_glue_order;
+ box_glue_set(colptr) = 0.0;
+ } else if (total > box_height(colptr)) {
+ box_glue_sign(colptr) = stretching_glue_sign;
+ if (box_glue_stretch(colptr) == 0) {
+ box_glue_set(colptr) = 0.0;
+ } else {
+ box_glue_set(colptr) = (glueratio) ( ( (glueratio) total - (glueratio) box_height(colptr) ) / ( (glueratio) box_glue_stretch(colptr) ) );
+ }
+ } else {
+ box_glue_order(colptr) = box_glue_sign(colptr);
+ box_glue_sign(colptr) = shrinking_glue_sign;
+ if (box_glue_shrink(colptr) == 0) {
+ box_glue_set(colptr) = 0.0;
+ } else if ((box_glue_order(colptr) == normal_glue_order) && (box_height(colptr) - total > box_glue_shrink(colptr))) {
+ box_glue_set(colptr) = 1.0;
+ } else {
+ box_glue_set(colptr) = (glueratio) ( ( (glueratio) box_height(colptr) - (glueratio) total) / ( (glueratio) box_glue_shrink(colptr) ) );
+ }
+ }
+ }
+ box_height(colptr) = width;
+ tex_aux_change_list_type(colptr, vlist_node);
+ node_subtype(colptr) = align_cell_list;
+ }
+ box_shift_amount(colptr) = 0;
+ if (tail != hold_head) {
+ /*tex Append blank boxes to account for spanned nodes. */
+ tex_try_couple_nodes(tail, node_next(colptr));
+ tex_try_couple_nodes(colptr, node_next(hold_head));
+ colptr = tail;
+ }
+ colptr = node_next(colptr);
+ preptr = node_next(preptr);
+ if (node_type(colptr) == glue_node) {
+ colptr = node_next(colptr);
+ }
+ if (node_type(preptr) == glue_node) {
+ preptr = node_next(preptr);
+ }
+ } while (colptr);
+ if (discard) {
+ tex_aux_strip_zero_tab_skips(rowptr);
+ }
+ if (reverse) {
+ box_list(rowptr) = tex_reversed_node_list(box_list(rowptr));
+ }
+ }
+ break;
+ case rule_node:
+ {
+ /*tex
+ Make the running dimensions in rule |q| extend to the boundaries of the
+ alignment.
+ */
+ if (rule_width(rowptr) == null_flag) {
+ rule_width(rowptr) = box_width(preroll);
+ }
+ if (rule_height(rowptr) == null_flag) {
+ rule_height(rowptr) = box_height(preroll);
+ }
+ if (rule_depth(rowptr) == null_flag) {
+ rule_depth(rowptr) = box_depth(preroll);
+ }
+ /*tex We could use offset fields in rule instead. */
+ if (offset) {
+ halfword prv = node_prev(rowptr);
+ halfword nxt = node_next(rowptr);
+ halfword box = null;
+ node_prev(rowptr) = null;
+ node_next(rowptr) = null;
+ box = tex_hpack(rowptr, 0, packing_additional, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_attribute(box, rowptr);
+ box_shift_amount(box) = offset;
+ node_subtype(box) = align_cell_list; /*tex This is not really a cell. */
+ // node_subtype(box) = unknown_list; /*tex So maybe we will do this. */
+ tex_try_couple_nodes(prv, box);
+ tex_try_couple_nodes(box, nxt);
+ rowptr = box;
+ }
+ }
+ break;
+ default:
+ /*tex
+ When we're in a |\halign| we get the rows (the |unset_node|s) while the
+ rules are horizontal ones. Furthermore we can get (vertical) glues and
+ whatever else got kicked in between the rows, but all that is (currently)
+ not processed.
+ */
+ break;
+ }
+ rowptr = node_next(rowptr);
+ }
+ }
+ if (callback) {
+ lmt_alignment_callback(cur_list.head, wrapup_pass_alignment_context, lmt_alignment_state.attr_list, preamble);
+ }
+ tex_flush_node_list(preroll);
+ delete_attribute_reference(lmt_alignment_state.attr_list);
+ tex_aux_pop_alignment();
+ /*tex
+ We now have a completed alignment, in the list that starts at |cur_list.head| and ends at
+ |cur_list.tail|. This list will be merged with the one that encloses it. (In case the
+ enclosing mode is |mmode|, for displayed formulas, we will need to insert glue before and
+ after the display; that part of the program will be deferred until we're more familiar with
+ such operations.)
+ */
+ {
+ scaled prevdepth = cur_list.prev_depth;
+ halfword head = node_next(cur_list.head);
+ halfword tail = cur_list.tail;
+ tex_pop_nest();
+ if (cur_list.mode == mmode) {
+ tex_finish_display_alignment(head, tail, prevdepth);
+ } else {
+ cur_list.prev_depth = prevdepth;
+ if (head) {
+ tex_tail_append(head);
+ cur_list.tail = tail;
+ }
+ if (cur_list.mode == vmode) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(alignment_page_context, 0);
+ }
+ tex_build_page();
+ }
+ }
+ }
+}
+
+/*tex
+
+ The token list |omit_template| just referred to is a constant token list that contains the
+ special control sequence |\endtemplate| only.
+
+*/
+
+void tex_initialize_alignments(void)
+{
+ lmt_alignment_state.hold_token_head = tex_get_available_token(null);
+ lmt_alignment_state.omit_template = tex_get_available_token(deep_frozen_end_template_1_token);
+ span_span(end_span) = max_quarterword + 1;
+ align_record_span_ptr(end_span) = null;
+}
+
+/*tex
+*
+ We no longer store |hold_token_head| and |omit_template| in the format file. It is a bit
+ cleaner to just initialize them. So we free them.
+
+*/
+
+void tex_cleanup_alignments(void)
+{
+ tex_put_available_token(lmt_alignment_state.hold_token_head);
+ tex_put_available_token(lmt_alignment_state.omit_template);
+ lmt_alignment_state.hold_token_head = null;
+ lmt_alignment_state.omit_template = null;
+}
+
+/*tex
+
+ 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 |finish_align| removes it.
+
+ A devious user might force an |end_template| command to occur just about anywhere; we must
+ defeat such hacks.
+
+*/
+
+void tex_run_alignment_end_template(void)
+{
+ lmt_input_state.base_ptr = lmt_input_state.input_stack_data.ptr;
+ lmt_input_state.input_stack[lmt_input_state.base_ptr] = lmt_input_state.cur_input;
+ while (( lmt_input_state.input_stack[lmt_input_state.base_ptr].index != template_post_text )
+ && (! lmt_input_state.input_stack[lmt_input_state.base_ptr].loc)
+ && ( lmt_input_state.input_stack[lmt_input_state.base_ptr].state == token_list_state)) {
+ --lmt_input_state.base_ptr;
+ }
+ if (lmt_input_state.input_stack[lmt_input_state.base_ptr].index != template_post_text ) {
+ tex_alignment_interwoven_error(2);
+ } else if (lmt_input_state.input_stack[lmt_input_state.base_ptr].loc) {
+ tex_alignment_interwoven_error(3);
+ } else if (lmt_input_state.input_stack[lmt_input_state.base_ptr].state != token_list_state) {
+ tex_alignment_interwoven_error(4);
+ } else if (cur_group == align_group) {
+ if (! tex_wrapped_up_paragraph(align_par_context)) { /* needs testing */
+ tex_end_paragraph(align_group, align_par_context);
+ if (tex_aux_finish_column()) {
+ tex_aux_finish_row();
+ }
+ }
+ } else {
+ tex_off_save();
+ }
+}
+
+/*tex
+
+ 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.
+
+ As an experiment we support nested |\noalign| usage but we do keep the braces so there is still
+ grouping. We don't flag these groups as |no_align_group| because then we need to do more work
+ and it's not worth the trouble. One can actually argue for not doing that anyway.
+
+ I might now rename the next one to |run_alignment| (and then also a companion as we have two
+ cases of usage).
+
+*/
+
+void tex_run_alignment_error(void)
+{
+ int cmd = cur_cmd;
+ int chr = cur_chr;
+ if (cmd == alignment_cmd && chr == no_align_code) {
+ if (! tex_aux_nested_no_align()) {
+ tex_handle_error(
+ normal_error_type,
+ "Misplaced \\noalign",
+ "I expect to see \\noalign only after the \\cr of an alignment. Proceed, and I'll\n"
+ "ignore this case."
+ );
+ }
+ } else if (abs(lmt_input_state.align_state) > 2) {
+ /*tex
+ Express consternation over the fact that no alignment is in progress. In traditional
+ \TEX\ the ampersand case will show a specific tab help, while in case of another
+ character a more generic message is shown.
+
+ We go for consistency here, so a little patch:
+ */
+ switch (cmd) {
+ case alignment_tab_cmd:
+ tex_handle_error(normal_error_type, "Misplaced %C", cmd, chr,
+ "I can't figure out why you would want to use a tab mark here. If some right brace\n"
+ "up above has ended a previous alignment prematurely, you're probably due for more\n"
+ "error messages."
+ );
+ break;
+ default:
+ tex_handle_error(normal_error_type, "Misplaced %C", cmd, chr,
+ "I can't figure out why you would want to use a tab mark or \\cr or \\span just\n"
+ "now. If something like a right brace up above has ended a previous alignment\n"
+ "prematurely, you're probably due for more error messages."
+ );
+ break;
+ }
+ } else {
+ const char * helpinfo =
+ "I've put in what seems to be necessary to fix the current column of the current\n"
+ "alignment. Try to go on, since this might almost work.";
+ tex_back_input(cur_tok);
+ if (lmt_input_state.align_state < 0) {
+ ++lmt_input_state.align_state;
+ cur_tok = left_brace_token + '{';
+ tex_handle_error(
+ insert_error_type,
+ "Missing { inserted",
+ helpinfo
+ );
+ } else {
+ --lmt_input_state.align_state;
+ cur_tok = right_brace_token + '}';
+ switch (cmd) {
+ case alignment_cmd:
+ tex_handle_error(
+ insert_error_type,
+ "Missing } inserted, unexpected ",
+ cmd, chr,
+ helpinfo
+ );
+ break;
+ case alignment_tab_cmd:
+ tex_handle_error(
+ insert_error_type,
+ "Missing } inserted, unexpected tab character (normally &)",
+ helpinfo
+ );
+ break;
+ }
+ }
+ }
+}
diff --git a/source/luametatex/source/tex/texalign.h b/source/luametatex/source/tex/texalign.h
new file mode 100644
index 000000000..b2ecba445
--- /dev/null
+++ b/source/luametatex/source/tex/texalign.h
@@ -0,0 +1,24 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_ALIGN_H
+# define LMT_ALIGN_H
+
+/* todo : rename */
+
+extern void tex_initialize_alignments (void);
+extern void tex_cleanup_alignments (void);
+
+extern void tex_insert_alignment_template (void);
+extern void tex_run_alignment_initialize (void);
+extern void tex_run_alignment_end_template (void);
+extern void tex_run_alignment_error (void);
+
+extern void tex_finish_alignment_group (void);
+extern void tex_finish_no_alignment_group (void);
+
+extern void tex_alignment_interwoven_error (int n);
+extern halfword tex_alignment_hold_token_head (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texarithmetic.c b/source/luametatex/source/tex/texarithmetic.c
new file mode 100644
index 000000000..d9cf9859d
--- /dev/null
+++ b/source/luametatex/source/tex/texarithmetic.c
@@ -0,0 +1,433 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ The principal computations performed by \TEX\ are done entirely in terms of integers less than
+ $2^{31}$ in magnitude; and divisions are done only when both dividend and divisor are
+ nonnegative. Thus, the arithmetic specified in this program can be carried out in exactly the
+ same way on a wide variety of computers, including some small ones. Why? Because the arithmetic
+ calculations need to be spelled out precisely in order to guarantee that \TEX\ will produce
+ identical output on different machines.
+
+ If some quantities were rounded differently in different implementations, we would find that
+ line breaks and even page breaks might occur in different places. Hence the arithmetic of \TEX\
+ has been designed with care, and systems that claim to be implementations of \TEX82 should
+ follow precisely the \TEX82\ calculations as they appear in the present program.
+
+ Actually there are three places where \TEX\ uses |div| with a possibly negative numerator.
+ These are harmless; see |div| in the index. Also if the user sets the |\time| or the |\year| to
+ a negative value, some diagnostic information will involve negative|-|numerator division. The
+ same remarks apply for |mod| as well as for |div|.
+
+ The |half| routine, defined in the header file, calculates half of an integer, using an
+ unambiguous convention with respect to signed odd numbers.
+
+ The |round_decimals| function, defined in the header file, is used to create a scaled integer
+ from a given decimal fraction $(.d_0d_1 \ldots d_{k-1})$, where |0 <= k <= 17|. The digit $d_i$
+ is given in |dig[i]|, and the calculation produces a correctly rounded result.
+
+ Keep in mind that in spite of these precautions results can be different over time. For
+ instance, fonts and hyphenation patterns do evolve over, and actually did in the many decades
+ that \TEX\ has been around. Also, delegating work to \LUA, which uses doubles, can have
+ consequences.
+
+*/
+
+/*tex
+
+ Physical sizes that a \TEX\ user specifies for portions of documents are represented internally
+ as scaled points. Thus, if we define an |sp| (scaled point) as a unit equal to $2^{-16}$
+ printer's points, every dimension inside of \TEX\ is an integer number of sp. There are exactly
+ 4,736,286.72 sp per inch. Users are not allowed to specify dimensions larger than $2^{30} - 1$
+ sp, which is a distance of about 18.892 feet (5.7583 meters); two such quantities can be added
+ without overflow on a 32-bit computer.
+
+ The present implementation of \TEX\ does not check for overflow when dimensions are added or
+ subtracted. This could be done by inserting a few dozen tests of the form |if x >= 010000000000|
+ then |report_overflow|, but the chance of overflow is so remote that such tests do not seem
+ worthwhile.
+
+ \TEX\ needs to do only a few arithmetic operations on scaled quantities, other than addition and
+ subtraction, and the following subroutines do most of the work. A single computation might use
+ several subroutine calls, and it is desirable to avoid producing multiple error messages in case
+ of arithmetic overflow; so the routines set the global variable |arith_error| to |true| instead
+ of reporting errors directly to the user. Another global variable, |tex_remainder|, holds the
+ remainder after a division.
+
+ The first arithmetical subroutine we need computes $nx+y$, where |x| and~|y| are |scaled| and
+ |n| is an integer. We will also use it to multiply integers.
+
+*/
+
+inline static scaled tex_aux_m_and_a(int n, scaled x, scaled y, scaled max_answer)
+{
+ if (n == 0) {
+ return y;
+ } else {
+ if (n < 0) {
+ x = -x;
+ n = -n;
+ }
+ if (((x <= (max_answer - y) / n) && (-x <= (max_answer + y) / n))) {
+ return n * x + y;
+ } else {
+ lmt_scanner_state.arithmic_error = 1;
+ return 0;
+ }
+ }
+}
+
+scaled tex_multiply_and_add (int n, scaled x, scaled y, scaled max_answer) { return tex_aux_m_and_a(n, x, y, max_answer); }
+scaled tex_nx_plus_y (int n, scaled x, scaled y) { return tex_aux_m_and_a(n, x, y, 07777777777); }
+scaled tex_multiply_integers (int n, scaled x) { return tex_aux_m_and_a(n, x, 0, 017777777777); }
+
+/*tex We also need to divide scaled dimensions by integers. */
+
+/*
+scaled tex_x_over_n_r(scaled x, int n, int *remainder)
+{
+ if (n == 0) {
+ lmt_scanner_state.arithmic_error = 1;
+ if (remainder) {
+ *remainder = x;
+ }
+ return 0;
+ } else {
+ int negative = 0;
+ if (n < 0) {
+ x = -x;
+ n = -n;
+ negative = 1;
+ }
+ if (x >= 0) {
+ int r = x % n;
+ if (remainder) {
+ if (negative) {
+ r = -r;
+ }
+ *remainder = r;
+ }
+ return (x / n);
+ } else {
+ int r = -((-x) % n);
+ if (remainder) {
+ if (negative) {
+ r = -r;
+ }
+ *remainder = r;
+ }
+ return -((-x) / n);
+ }
+ }
+}
+*/
+
+scaled tex_x_over_n_r(scaled x, int n, int *remainder)
+{
+ /*tex Should |tex_remainder| be negated? */
+ if (n == 0) {
+ lmt_scanner_state.arithmic_error = 1;
+ *remainder = x;
+ return 0;
+ } else {
+ *remainder = x % n;
+ return x/n;
+ }
+}
+
+/*
+scaled tex_x_over_n(scaled x, int n)
+{
+ if (n == 0) {
+ lmt_scanner_state.arithmic_error = 1;
+ return 0;
+ } else {
+ if (n < 0) {
+ x = -x;
+ n = -n;
+ }
+ if (x >= 0) {
+ return (x / n);
+ } else {
+ return -((-x) / n);
+ }
+ }
+}
+*/
+
+scaled tex_x_over_n(scaled x, int n)
+{
+ if (n == 0) {
+ lmt_scanner_state.arithmic_error = 1;
+ return 0;
+ } else {
+ return x/n;
+ }
+}
+
+/*tex
+
+ Then comes the multiplication of a scaled number by a fraction |n/d|, where |n| and |d| are
+ nonnegative integers |<= 2^16| and |d| is positive. It would be too dangerous to multiply by~|n|
+ and then divide by~|d|, in separate operations, since overflow might well occur; and it would
+ be too inaccurate to divide by |d| and then multiply by |n|. Hence this subroutine simulates
+ 1.5-precision arithmetic.
+
+*/
+
+/*
+scaled tex_xn_over_d_r(scaled x, int n, int d, int *remainder)
+{
+ if (x == 0) {
+ if (remainder) {
+ *remainder = 0;
+ }
+ return 0;
+ } else {
+ int positive = 1;
+ unsigned int t, u, v, xx, dd;
+ if (x < 0) {
+ x = -x;
+ positive = 0;
+ }
+ xx = (unsigned int) x;
+ dd = (unsigned int) d;
+ t = ((xx % 0100000) * (unsigned int) n);
+ u = ((xx / 0100000) * (unsigned int) n + (t / 0100000));
+ v = (u % dd) * 0100000 + (t % 0100000);
+ if (u / dd >= 0100000) {
+ lmt_scanner_state.arithmic_error = 1;
+ } else {
+ u = 0100000 * (u / dd) + (v / dd);
+ }
+ if (positive) {
+ if (remainder) {
+ *remainder = (int) (v % dd);
+ }
+ return (scaled) u;
+ } else {
+ if (remainder) {
+ *remainder = - (int) (v % dd);
+ }
+ return - (scaled) u;
+ }
+ }
+}
+*/
+
+scaled tex_xn_over_d_r(scaled x, int n, int d, int *remainder)
+{
+ if (x == 0) {
+ *remainder = 0;
+ return 0;
+ } else {
+ long long v = (long long) x * (long long) n;
+ *remainder = (scaled) (v % d);
+ return (scaled) (v / d);
+ }
+}
+
+/*
+scaled tex_xn_over_d(scaled x, int n, int d)
+{
+ if (x == 0) {
+ return 0;
+ } else {
+ int positive = 1;
+ unsigned int t, u, v, xx, dd;
+ if (x < 0) {
+ x = -x;
+ positive = 0;
+ }
+ xx = (unsigned int) x;
+ dd = (unsigned int) d;
+ t = ((xx % 0100000) * (unsigned int) n);
+ u = ((xx / 0100000) * (unsigned int) n + (t / 0100000));
+ v = (u % dd) * 0100000 + (t % 0100000);
+ if (u / dd >= 0100000) {
+ lmt_scanner_state.arithmic_error = 1;
+ } else {
+ u = 0100000 * (u / dd) + (v / dd);
+ }
+ if (positive) {
+ return (scaled) u;
+ } else {
+ return - (scaled) u;
+ }
+ }
+}
+*/
+
+scaled tex_xn_over_d(scaled x, int n, int d)
+{
+ if (x == 0) {
+ return 0;
+ } else {
+ long long v = (long long) x * (long long) n;
+ return (scaled) (v / d);
+ }
+}
+
+/*tex
+
+ When \TEX\ packages a list into a box, it needs to calculate the proportionality ratio by which
+ the glue inside the box should stretch or shrink. This calculation does not affect \TEX's
+ decision making, so the precise details of rounding, etc., in the glue calculation are not of
+ critical importance for the consistency of results on different computers.
+
+ We shall use the type |glue_ratio| for such proportionality ratios. A glue ratio should take the
+ same amount of memory as an |integer| (usually 32 bits) if it is to blend smoothly with \TEX's
+ other data structures. Thus |glue_ratio| should be equivalent to |short_real| in some
+ implementations of \PASCAL. Alternatively, it is possible to deal with glue ratios using nothing
+ but fixed-point arithmetic; see {\em TUGboat \bf3},1 (March 1982), 10--27. (But the routines
+ cited there must be modified to allow negative glue ratios.)
+
+*/
+
+/*
+scaled tex_round_xn_over_d(scaled x, int n, unsigned int d)
+{
+ if (x == 0) {
+ return 0;
+ } else if (n == d) {
+ return x;
+ } else {
+ int positive = 1;
+ unsigned t, u, v;
+ if (x < 0) {
+ positive = ! positive;
+ x = -x;
+ }
+ if (n < 0) {
+ positive = ! positive;
+ n = -n;
+ }
+ t = (unsigned) ((x % 0100000) * n);
+ u = (unsigned) (((unsigned) (x) / 0100000) * (unsigned) n + (t / 0100000));
+ v = (u % d) * 0100000 + (t % 0100000);
+ if (u / d >= 0100000) {
+ scanner_state.arithmic_error = 1;
+ } else {
+ u = 0100000 * (u / d) + (v / d);
+ }
+ v = v % d;
+ if (2 * v >= d) {
+ u++;
+ }
+ return positive ? (scaled) u : - (scaled) u;
+ }
+}
+*/
+
+/*
+scaled tex_round_xn_over_d(scaled x, int n, unsigned int d)
+{
+ if (x == 0|| n == d) {
+ return x;
+ } else {
+ double v = (1.0 / d) * n * x;
+ return (v < 0.0) ? (int) (v - 0.5) : (int) (v + 0.5);
+ }
+}
+*/
+
+scaled tex_round_xn_over_d(scaled x, int n, unsigned int d)
+{
+ if (x == 0 || (unsigned int) n == d) {
+ return x;
+ } else {
+ return scaledround((1.0 / d) * n * x);
+ }
+}
+
+/*tex
+
+ The return value is a decimal number with the point |dd| places from the back, |scaled_out| is
+ the number of scaled points corresponding to that.
+
+*/
+
+/* not used:
+
+scaled tex_divide_scaled(scaled s, scaled m, int dd)
+{
+ if (s == 0) {
+ return 0;
+ } else {
+ scaled q, r;
+ int sign = 1;
+ if (s < 0) {
+ sign = -sign;
+ s = -s;
+ }
+ if (m < 0) {
+ sign = -sign;
+ m = -m;
+ }
+ if (m == 0) {
+ normal_error("arithmetic", "divided by zero");
+ } else if (m >= (max_integer / 10)) {
+ normal_error("arithmetic", "number too big");
+ }
+ q = s / m;
+ r = s % m;
+ for (int i = 1; i <= (int) dd; i++) {
+ q = 10 * q + (10 * r) / m;
+ r = (10 * r) % m;
+ }
+ if (2 * r >= m) {
+ q++; // rounding
+ }
+ return sign * q;
+ }
+}
+*/
+
+/*
+scaled divide_scaled_n(double sd, double md, double n)
+{
+ scaled di = 0;
+ double dd = sd / md * n;
+ if (dd > 0.0) {
+ di = ifloor( dd + 0.5);
+ } else if (dd < 0.0) {
+ di = -ifloor((-dd) + 0.5);
+ }
+ return di;
+}
+*/
+
+scaled tex_divide_scaled_n(double sd, double md, double n)
+{
+ return scaledround(sd / md * n);
+}
+
+/*
+scaled tex_ext_xn_over_d(scaled x, scaled n, scaled d)
+{
+ double r = (((double) x) * ((double) n)) / ((double) d);
+ if (r > DBL_EPSILON) {
+ r += 0.5;
+ } else {
+ r -= 0.5;
+ }
+ if (r >= (double) max_integer || r <= -(double) max_integer) {
+ tex_normal_warning("internal", "arithmetic number too big");
+ }
+ return (scaled) r;
+}
+*/
+
+scaled tex_ext_xn_over_d(scaled x, scaled n, scaled d)
+{
+ double r = (((double) x) * ((double) n)) / ((double) d);
+ if (r >= (double) max_integer || r <= -(double) max_integer) {
+ /* can we really run into this? */
+ tex_normal_warning("internal", "arithmetic number too big");
+ }
+ return scaledround(r);
+}
diff --git a/source/luametatex/source/tex/texarithmetic.h b/source/luametatex/source/tex/texarithmetic.h
new file mode 100644
index 000000000..53deca36b
--- /dev/null
+++ b/source/luametatex/source/tex/texarithmetic.h
@@ -0,0 +1,42 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_ARITHMETIC_H
+# define LMT_ARITHMETIC_H
+
+/*tex
+
+ Fixed-point arithmetic is done on {\em scaled integers} that are multiples of $2^{-16}$. In
+ other words, a binary point is assumed to be sixteen bit positions from the right end of a
+ binary computer word.
+
+*/
+
+extern scaled tex_multiply_and_add (int n, scaled x, scaled y, scaled max_answer);
+extern scaled tex_nx_plus_y (int n, scaled x, scaled y);
+extern scaled tex_multiply_integers (int n, scaled x);
+extern scaled tex_x_over_n_r (scaled x, int n, int *remainder);
+extern scaled tex_x_over_n (scaled x, int n);
+extern scaled tex_xn_over_d (scaled x, int n, int d);
+extern scaled tex_xn_over_d_r (scaled x, int n, int d, int *remainder);
+/* scaled tex_divide_scaled (scaled s, scaled m, int dd); */
+extern scaled tex_divide_scaled_n (double s, double m, double d);
+extern scaled tex_ext_xn_over_d (scaled, scaled, scaled);
+extern scaled tex_round_xn_over_d (scaled x, int n, unsigned int d);
+
+inline static scaled tex_round_decimals_digits(const unsigned char *digits, unsigned k)
+{
+ int a = 0;
+ while (k-- > 0) {
+ a = (a + digits[k] * two) / 10;
+ }
+ return (a + 1) / 2;
+}
+
+inline static int tex_half_scaled(int x)
+{
+ return odd(x) ? ((x + 1) / 2) : (x / 2);
+}
+
+# endif
diff --git a/source/luametatex/source/tex/texbuildpage.c b/source/luametatex/source/tex/texbuildpage.c
new file mode 100644
index 000000000..a0b5882dd
--- /dev/null
+++ b/source/luametatex/source/tex/texbuildpage.c
@@ -0,0 +1,1271 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ When \TEX\ appends new material to its main vlist in vertical mode, it uses a method something
+ like |vsplit| to decide where a page ends, except that the calculations are done \quote {on
+ line} as new items come in. The main complication in this process is that insertions must be
+ put into their boxes and removed from the vlist, in a more-or-less optimum manner.
+
+ We shall use the term \quote {current page} for that part of the main vlist that is being
+ considered as a candidate for being broken off and sent to the user's output routine. The
+ current page starts at |node_next(page_head)|, and it ends at |page_tail|. We have |page_head =
+ page_tail| if this list is empty.
+
+ Utter chaos would reign if the user kept changing page specifications while a page is being
+ constructed, so the page builder keeps the pertinent specifications frozen as soon as the page
+ receives its first box or insertion. The global variable |page_contents| is |empty| when the
+ current page contains only mark nodes and content-less whatsit nodes; it is |inserts_only|
+ if the page contains only insertion nodes in addition to marks and whatsits. Glue nodes, kern
+ nodes, and penalty nodes are discarded until a box or rule node appears, at which time
+ |page_contents| changes to |box_there|. As soon as |page_contents| becomes non-|empty|, the
+ current |vsize| and |max_depth| are squirreled away into |page_goal| and |page_max_depth|; the
+ latter values will be used until the page has been forwarded to the user's output routine. The
+ |\topskip| adjustment is made when |page_contents| changes to |box_there|.
+
+ Although |page_goal| starts out equal to |vsize|, it is decreased by the scaled natural
+ height-plus-depth of the insertions considered so far, and by the |\skip| corrections for
+ those insertions. Therefore it represents the size into which the non-inserted material
+ should fit, assuming that all insertions in the current page have been made.
+
+ The global variables |best_page_break| and |least_page_cost| correspond respectively to the
+ local variables |best_place| and |least_cost| in the |vert_break| routine that we have already
+ studied; i.e., they record the location and value of the best place currently known for
+ breaking the current page. The value of |page_goal| at the time of the best break is stored in
+ |best_size|.
+
+*/
+
+page_builder_state_info lmt_page_builder_state = {
+ .page_tail = null,
+ .contents = 0,
+ .max_depth = 0,
+ .best_break = null,
+ .least_cost = 0,
+ .best_size = 0,
+ .goal = 0,
+ .vsize = 0,
+ .total = 0,
+ .depth = 0,
+ .page_so_far = { 0 },
+ .insert_penalties = 0,
+ .insert_heights = 0,
+ .last_glue = max_halfword,
+ .last_penalty = 0,
+ .last_kern = 0,
+ .last_node_type = unknown_node_type,
+ .last_node_subtype= unknown_node_subtype,
+ .last_extra_used = 0,
+ .last_boundary = 0,
+ .output_active = 0,
+ .dead_cycles = 0,
+ .current_state = 0
+};
+
+# define page_stretch_1(order) lmt_page_builder_state.page_so_far[page_initial_state + order] /* was [1 + order] */
+# define page_stretch_2(order) lmt_page_builder_state.page_so_far[page_stretch_state + order] /* was [2 + order] */
+
+static void tex_aux_fire_up (halfword c);
+
+/*tex
+
+ The page builder has another data structure to keep track of insertions. This is a list of
+ four-word nodes, starting and ending at |page_insert_head|. That is, the first element of the
+ list is node |t$_1$ = node_next(page_insert_head)|; node $r_j$ is followed by |t$_{j+1}$ =
+ node_next(t$_j$)|; and if there are |n| items we have |$_{n+1}$ >= page_insert_head|. The
+ |subtype| field of each node in this list refers to an insertion number; for example, |\insert
+ 250| would correspond to a node whose |subtype| is |qi(250)| (the same as the |subtype| field
+ of the relevant |insert_node|). These |subtype| fields are in increasing order, and |subtype
+ (page_insert_head) = 65535|, so |page_insert_head| serves as a convenient sentinel at the end
+ of the list. A record is present for each insertion number that appears in the current page.
+
+ The |type| field in these nodes distinguishes two possibilities that might occur as we look
+ ahead before deciding on the optimum page break. If |type(r) = inserting_node|, then |height(r)|
+ contains the total of the height-plus-depth dimensions of the box and all its inserts seen so
+ far. If |type(r) = split_up_node|, then no more insertions will be made into this box, because at
+ least one previous insertion was too big to fit on the current page; |broken_ptr(r)| points to
+ the node where that insertion will be split, if \TEX\ decides to split it, |broken_insert(r)|
+ points to the insertion node that was tentatively split, and |height(r)| includes also the
+ natural height plus depth of the part that would be split off.
+
+ In both cases, |last_insert(r)| points to the last |insert_node| encountered for box
+ |qo(subtype(r))| that would be at least partially inserted on the next page; and
+ |best_insert(r)| points to the last such |insert_node| that should actually be inserted, to get
+ the page with minimum badness among all page breaks considered so far. We have |best_insert
+ (r) = null| if and only if no insertion for this box should be made to produce this optimum page.
+
+ Pages are built by appending nodes to the current list in \TEX's vertical mode, which is at the
+ outermost level of the semantic nest. This vlist is split into two parts; the \quote {current
+ page} that we have been talking so much about already, and the |quote {contribution list} that
+ receives new nodes as they are created. The current page contains everything that the page
+ builder has accounted for in its data structures, as described above, while the contribution
+ list contains other things that have been generated by other parts of \TEX\ but have not yet
+ been seen by the page builder. The contribution list starts at |vlink (contribute_head)|, and it
+ ends at the current node in \TEX's vertical mode.
+
+ When \TEX\ has appended new material in vertical mode, it calls the procedure |build_page|,
+ which tries to catch up by moving nodes from the contribution list to the current page. This
+ procedure will succeed in its goal of emptying the contribution list, unless a page break is
+ discovered, i.e., unless the current page has grown to the point where the optimum next page
+ break has been determined. In the latter case, the nodes after the optimum break will go back
+ onto the contribution list, and control will effectively pass to the user's output routine.
+
+ We make |type (page_head) = glue_node|, so that an initial glue node on the current page will
+ not be considered a valid breakpoint. We keep this old tex trickery of cheating with node types
+ but have to make sure that the size is valid to do so (and we have different sizes!).
+
+*/
+
+void tex_initialize_pagestate(void)
+{
+ lmt_page_builder_state.page_tail = page_head;
+ lmt_page_builder_state.contents = contribute_nothing;
+ lmt_page_builder_state.max_depth = 0;
+ lmt_page_builder_state.best_break = null;
+ lmt_page_builder_state.least_cost = 0;
+ lmt_page_builder_state.best_size = 0;
+ lmt_page_builder_state.goal = 0;
+ lmt_page_builder_state.vsize = 0;
+ lmt_page_builder_state.total = 0;
+ lmt_page_builder_state.depth = 0;
+ for (int i = page_stretch_state; i <= page_shrink_state; i++) {
+ lmt_page_builder_state.page_so_far[i] = 0;
+ }
+ lmt_page_builder_state.insert_penalties = 0;
+ lmt_page_builder_state.insert_heights = 0;
+ lmt_page_builder_state.last_glue = max_halfword;
+ lmt_page_builder_state.last_penalty = 0;
+ lmt_page_builder_state.last_kern = 0;
+ lmt_page_builder_state.last_extra_used = 0;
+ lmt_page_builder_state.last_boundary = 0;
+ lmt_page_builder_state.last_node_type = unknown_node_type;
+ lmt_page_builder_state.last_node_subtype = unknown_node_subtype;
+ lmt_page_builder_state.output_active = 0;
+ lmt_page_builder_state.dead_cycles = 0;
+ lmt_page_builder_state.current_state = 0;
+}
+
+void tex_initialize_buildpage(void)
+{
+ node_type(page_insert_head) = split_node;
+ node_subtype(page_insert_head) = insert_split_subtype;
+ insert_index(page_insert_head) = 65535; /*tex some signal */
+ node_next(page_insert_head) = page_insert_head;
+ node_type(page_head) = glue_node; /*tex brr, a temp node has a different size than a glue node */
+ node_subtype(page_head) = page_glue; /*tex basically: unset */
+}
+
+/*tex
+
+ An array |page_so_far| records the heights and depths of everything on the current page. This
+ array contains six |scaled| numbers, like the similar arrays already considered in |line_break|
+ and |vert_break|; and it also contains |page_goal| and |page_depth|, since these values are all
+ accessible to the user via |set_page_dimen| commands. The value of |page_so_far[1]| is also
+ called |page_total|. The stretch and shrink components of the |\skip| corrections for each
+ insertion are included in |page_so_far|, but the natural space components of these corrections
+ are not, since they have been subtracted from |page_goal|.
+
+ The variable |page_depth| records the depth of the current page; it has been adjusted so that it
+ is at most |page_max_depth|. The variable |last_glue| points to the glue specification of the
+ most recent node contributed from the contribution list, if this was a glue node; otherwise
+ |last_glue = max_halfword|. (If the contribution list is nonempty, however, the value of
+ |last_glue| is not necessarily accurate.) The variables |last_penalty|, |last_kern|, and
+ |last_node_type| are similar. And finally, |insert_penalties| holds the sum of the penalties
+ associated with all split and floating insertions.
+
+*/
+
+void tex_print_page_totals(void)
+{
+ tex_print_format("%P", page_total, page_stretch, page_filstretch, page_fillstretch, page_filllstretch, page_shrink);
+}
+
+/*tex
+
+ Here is a procedure that is called when the |page_contents| is changing from |empty| to
+ |inserts_only| or |box_there|.
+
+*/
+
+static void tex_aux_freeze_page_specs(int s)
+{
+ lmt_page_builder_state.contents = s;
+ lmt_page_builder_state.max_depth = max_depth_par;
+ lmt_page_builder_state.least_cost = awful_bad;
+ /* page_builder_state.insert_heights = 0; */ /* up to the user */
+ for (int i = page_stretch_state; i <= page_shrink_state; i++) {
+ lmt_page_builder_state.page_so_far[i] = 0;
+ }
+ page_goal = vsize_par;
+ page_vsize = vsize_par;
+ page_depth = 0;
+ page_total = 0;
+ if (tracing_pages_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_format(
+ "[page: frozen state, goal=%D, maxdepth=%D, contribution=%s, insertheights=%D]",
+ page_goal, pt_unit,
+ lmt_page_builder_state.max_depth, pt_unit,
+ lmt_interface.page_contribute_values[s].name,
+ lmt_page_builder_state.insert_heights, pt_unit
+ );
+ tex_end_diagnostic();
+ }
+}
+
+static void update_page_goal(halfword index, scaled total, scaled delta)
+{
+ page_goal -= delta;
+ lmt_page_builder_state.insert_heights += total;
+ if (lmt_page_builder_state.insert_heights > max_dimen) {
+ lmt_page_builder_state.insert_heights = max_dimen;
+ }
+ if (tracing_inserts_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_format(
+ "[page: update page goal for insert, index=%i, total=%D, insertheights=%D, vsize=%D, delta=%D, goal=%D]",
+ index, total, pt_unit, lmt_page_builder_state.insert_heights, pt_unit,
+ page_vsize, pt_unit, delta, pt_unit, page_goal, pt_unit
+ );
+ tex_end_diagnostic();
+ }
+}
+
+/*tex
+
+ The global variable |output_active| is true during the time the user's output routine is
+ driving \TEX. The page builder is ready to start a fresh page if we initialize the following
+ state variables. (However, the page insertion list is initialized elsewhere.)
+
+*/
+
+static void tex_aux_start_new_page(void)
+{
+ lmt_page_builder_state.contents = contribute_nothing;
+ lmt_page_builder_state.page_tail = page_head;
+ node_next(page_head) = null;
+ lmt_page_builder_state.last_glue = max_halfword;
+ lmt_page_builder_state.last_penalty = 0;
+ lmt_page_builder_state.last_kern = 0;
+ lmt_page_builder_state.last_boundary = 0;
+ lmt_page_builder_state.last_node_type = unknown_node_type;
+ lmt_page_builder_state.last_node_subtype = unknown_node_subtype;
+ page_depth = 0;
+ lmt_page_builder_state.max_depth = 0;
+}
+
+/*tex
+
+ At certain times box |\outputbox| is supposed to be void (i.e., |null|), or an insertion box is
+ supposed to be ready to accept a vertical list. If not, an error message is printed, and the
+ following subroutine flushes the unwanted contents, reporting them to the user.
+
+*/
+
+static halfword tex_aux_delete_box_content(int n)
+{
+ tex_begin_diagnostic();
+ tex_print_format("[page: deleting box]");
+ tex_show_box(n);
+ tex_end_diagnostic();
+ tex_flush_node_list(n);
+ return null;
+}
+
+/*tex
+
+ The following procedure guarantees that an insert box is not an |\hbox|. A user can actually
+ mess with this box, unless we decide to come up with a dedicated data structure for it.
+
+*/
+
+static int tex_aux_valid_insert_content(halfword content)
+{
+ if (content && node_type(content) == hlist_node) {
+ /*tex It's not always a box so we need to adapt this message some day. */
+ tex_handle_error(
+ normal_error_type,
+ "Insertions can only be added to a vbox",
+ "Tut tut: You're trying to \\insert into a \\box register that now contains an\n"
+ "\\hbox. Proceed, and I'll discard its present contents."
+ );
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+/*tex
+
+ \TEX\ is not always in vertical mode at the time |build_page| is called; the current mode
+ reflects what \TEX\ should return to, after the contribution list has been emptied. A call on
+ |build_page| should be immediately followed by |goto big_switch|, which is \TEX's central
+ control point.
+
+ Append contributions to the current page.
+
+*/
+
+static void tex_aux_display_page_break_cost(halfword badness, halfword penalty, halfword cost, int moveon, int fireup)
+{
+ tex_begin_diagnostic();
+ tex_print_format("[page: break, total %P, goal %D, badness %B, penalty %i, cost %B%s, moveon %s, fireup %s]",
+ page_total, page_stretch, page_filstretch, page_fillstretch, page_filllstretch, page_shrink,
+ page_goal, pt_unit, badness, penalty, cost, cost < lmt_page_builder_state.least_cost ? "#" : "",
+ moveon ? "yes" : "no", fireup ? "yes" : "no"
+ );
+ tex_end_diagnostic();
+}
+
+static void tex_aux_display_insertion_split_cost(halfword index, scaled height, halfword penalty)
+{
+ /*tex Display the insertion split cost. */
+ tex_begin_diagnostic();
+ tex_print_format("[page: split insert %i: height %D, depth %D, penalty %i]",
+ index, height, pt_unit, lmt_packaging_state.best_height_plus_depth, pt_unit, penalty
+ );
+ tex_end_diagnostic();
+}
+
+static halfword tex_aux_page_badness(scaled goal)
+{
+ if (page_total < goal) {
+ if (page_filstretch || page_fillstretch || page_filllstretch) {
+ return 0;
+ } else {
+ return tex_badness(goal - page_total, page_stretch);
+ }
+ } else if (page_total - goal > page_shrink) {
+ return awful_bad;
+ } else {
+ return tex_badness(page_total - goal, page_shrink);
+ }
+}
+
+void tex_build_page(void)
+{
+ if (node_next(contribute_head) && ! lmt_page_builder_state.output_active) {
+ /*tex The (upcoming) penalty to be added to the badness: */
+ int pi = 0;
+ do {
+ halfword p = node_next(contribute_head);
+ halfword last_type = node_type(p);
+ /*tex Update the values of |last_glue|, |last_penalty|, and |last_kern|. */
+ if (lmt_page_builder_state.last_glue != max_halfword) {
+ tex_flush_node(lmt_page_builder_state.last_glue);
+ lmt_page_builder_state.last_glue = max_halfword;
+ }
+ lmt_page_builder_state.last_penalty = 0;
+ lmt_page_builder_state.last_kern = 0;
+ lmt_page_builder_state.last_boundary = 0;
+ lmt_page_builder_state.last_node_type = last_type;
+ lmt_page_builder_state.last_node_subtype = node_subtype(p);
+ lmt_page_builder_state.last_extra_used = 0;
+ switch (last_type) {
+ case glue_node:
+ lmt_page_builder_state.last_glue = tex_new_glue_node(p, node_subtype(p));
+ break;
+ case penalty_node:
+ lmt_page_builder_state.last_penalty = penalty_amount(p);
+ break;
+ case kern_node:
+ lmt_page_builder_state.last_kern = kern_amount(p);
+ break;
+ case boundary_node:
+ lmt_page_builder_state.last_boundary = boundary_data(p);
+ break;
+ }
+ /*tex
+
+ Move node |p| to the current page; if it is time for a page break, put the nodes
+ following the break back onto the contribution list, and |return| to the users
+ output routine if there is one.
+
+ The code here is an example of a many-way switch into routines that merge together
+ in different places. Some people call this unstructured programming, but the author
+ doesn't see much wrong with it, as long as the various labels have a well-understood
+ meaning.
+
+ If the current page is empty and node |p| is to be deleted, |goto done1|; otherwise
+ use node |p| to update the state of the current page; if this node is an insertion,
+ |goto contribute|; otherwise if this node is not a legal breakpoint,
+ |goto contribute| or |update_heights|; otherwise set |pi| to the penalty associated
+ with this breakpoint.
+
+ The title of this section is already so long, it seems best to avoid making it more
+ accurate but still longer, by mentioning the fact that a kern node at the end of
+ the contribution list will not be contributed until we know its successor.
+
+ */
+ switch (last_type) {
+ case hlist_node:
+ case vlist_node:
+ if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_post)) {
+ halfword h = box_post_migrated(p);
+ if (h) {
+ halfword t = tex_tail_of_node_list(h);
+ if (node_next(p)) {
+ tex_couple_nodes(t, node_next(p));
+ } else {
+ contribute_tail = t;
+ }
+ tex_couple_nodes(p, h);
+ box_post_migrated(p) = null;
+ }
+ }
+ if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_pre)) {
+ halfword h = box_pre_migrated(p);
+ if (h) {
+ halfword t = tex_tail_of_node_list(h);
+ tex_couple_nodes(t, p);
+ tex_couple_nodes(contribute_head, h);
+ box_pre_migrated(p) = null;
+ continue;
+ }
+ }
+ /* common with rule */
+ if (lmt_page_builder_state.contents < contribute_box) { // nothing or insert
+ /*tex
+ Initialize the current page, insert the |\topskip| glue ahead of |p|,
+ and |goto continue|.
+ */
+ halfword q;
+ if (lmt_page_builder_state.contents != contribute_nothing) {
+ lmt_page_builder_state.contents = contribute_box;
+ } else {
+ tex_aux_freeze_page_specs(contribute_box);
+ }
+ q = tex_new_param_glue_node(top_skip_code, top_skip_glue);
+ if (glue_amount(q) > box_height(p)) {
+ glue_amount(q) -= box_height(p);
+ } else {
+ glue_amount(q) = 0;
+ }
+ tex_couple_nodes(q, p);
+ tex_couple_nodes(contribute_head, q);
+ continue;
+ } else {
+ /*tex Move a box to the current page, then |goto contribute|. */
+ page_total += page_depth + box_height(p);
+ page_depth = box_depth(p);
+ goto CONTRIBUTE;
+ }
+ case rule_node:
+ /* common with box */
+ if (lmt_page_builder_state.contents < contribute_box) {
+ halfword q;
+ if (lmt_page_builder_state.contents != contribute_nothing) {
+ lmt_page_builder_state.contents = contribute_rule;
+ } else {
+ tex_aux_freeze_page_specs(contribute_rule);
+ }
+ q = tex_new_param_glue_node(top_skip_code, top_skip_glue);
+ if (glue_amount(q) > rule_height(p)) {
+ glue_amount(q) -= rule_height(p);
+ } else {
+ glue_amount(q) = 0;
+ }
+ tex_couple_nodes(q, p);
+ tex_couple_nodes(contribute_head, q);
+ continue;
+ } else {
+ page_total += page_depth + rule_height(p);
+ page_depth = rule_depth(p);
+ goto CONTRIBUTE;
+ }
+ case boundary_node:
+ if (lmt_page_builder_state.contents < contribute_box) {
+ goto DISCARD;
+ } else if (node_subtype(p) == page_boundary) {
+ /*tex
+ We just triggered the pagebuilder for which we needed a contribution. We fake
+ a zero penalty so that all gets processed. The main rationale is that we get
+ a better indication of what we do. Of course a callback can remove this node
+ so that it is never seen. Triggering from the callback is not doable.
+ */
+ halfword n = tex_new_node(penalty_node, user_penalty_subtype);
+ /* todo: copy attributes */
+ tex_page_boundary_message("processed as penalty", 0);
+ tex_try_couple_nodes(node_prev(p), n);
+ tex_try_couple_nodes(n, node_next(p));
+ tex_flush_node(p);
+ penalty_amount(n) = boundary_data(p);
+ p = n;
+ node_next(contribute_head) = p;
+ pi = 0;
+ break;
+ } else {
+ goto DISCARD;
+ }
+ case whatsit_node:
+ goto CONTRIBUTE;
+ case glue_node:
+ if (lmt_page_builder_state.contents < contribute_box) {
+ goto DISCARD;
+ } else if (precedes_break(lmt_page_builder_state.page_tail)) {
+ pi = 0;
+ break;
+ } else {
+ goto UPDATEHEIGHTS;
+ }
+ case kern_node:
+ if (lmt_page_builder_state.contents < contribute_box) {
+ goto DISCARD;
+ } else if (! node_next(p)) {
+ return;
+ } else if (node_type(node_next(p)) == glue_node) {
+ pi = 0;
+ break;
+ } else {
+ goto UPDATEHEIGHTS;
+ }
+ case penalty_node:
+ if (lmt_page_builder_state.contents < contribute_box) {
+ goto DISCARD;
+ } else {
+ pi = penalty_amount(p);
+ break;
+ }
+ case mark_node:
+ goto CONTRIBUTE;
+ case insert_node:
+ {
+ /*tex
+ Append an insertion to the current page and |goto contribute|. The insertion
+ number (index) is registered in the subtype (not any more for a while).
+ */
+ halfword index = insert_index(p); /* initially 65K */
+ halfword location = page_insert_head;
+ halfword multiplier = tex_get_insert_multiplier(index);
+ halfword content = tex_get_insert_content(index);
+ scaled limit = tex_get_insert_limit(index);
+ int slot = 1;
+ if (lmt_page_builder_state.contents == contribute_nothing) {
+ tex_aux_freeze_page_specs(contribute_insert);
+ }
+ while (index >= insert_index(node_next(location))) {
+ location = node_next(location);
+ slot += 1 ;
+ }
+ if (insert_index(location) != index) {
+ /*tex
+
+ Create a page insertion node with |subtype(r) = qi(n)|, and include
+ the glue correction for box |n| in the current page state.
+
+ We take note of the value of |\skip| |n| and the height plus depth
+ of |\box| |n| only when the first |\insert n| node is encountered
+ for a new page. A user who changes the contents of |\box| |n| after
+ that first |\insert n| had better be either extremely careful or
+ extremely lucky, or both.
+
+ We need to handle this too:
+
+ [content]
+ [max(space shared,space n)]
+ [class n]
+ .........
+ [space m]
+ [class m]
+
+ For now a callback can deal with this but maybe we need to have a
+ more advanced mechanism for this (and more control over inserts in
+ general).
+
+ */
+ halfword q = tex_new_node(split_node, normal_split_subtype);
+ scaled advance = 0;
+ halfword distance = lmt_get_insert_distance(index, slot); /*tex Callback: we get a copy! */
+ split_insert_index(q) = index;
+ tex_try_couple_nodes(q, node_next(location));
+ tex_couple_nodes(location, q);
+ location = q;
+ if (! tex_aux_valid_insert_content(content)) {
+ content = tex_aux_delete_box_content(content);
+ tex_set_insert_content(index, content);
+ };
+ if (content) {
+ box_height(location) = box_total(content);
+ } else {
+ box_height(location) = 0;
+ }
+ split_best_insert(location) = null;
+ if (multiplier == 1000) {
+ advance = box_height(location);
+ } else {
+ advance = tex_x_over_n(box_height(location), 1000) * multiplier;
+ }
+ advance += glue_amount(distance);
+ update_page_goal(index, 0, advance); /*tex Here gets no height added! */
+ if (glue_stretch_order(distance) > 1) {
+ page_stretch_1(glue_stretch_order(distance)) += glue_stretch(distance);
+ } else {
+ page_stretch_2(glue_stretch_order(distance)) += glue_stretch(distance);
+ }
+ page_shrink += glue_shrink(distance);
+ if (glue_shrink_order(distance) != normal_glue_order && glue_shrink(distance)) {
+ tex_handle_error(
+ normal_error_type,
+ "Infinite glue shrinkage inserted from \\skip%i",
+ index,
+ "The correction glue for page breaking with insertions must have finite\n"
+ "shrinkability. But you may proceed, since the offensive shrinkability has been\n"
+ "made finite."
+ );
+ }
+ tex_flush_node(distance);
+ }
+ /*tex I really need to check this logic with the original \LUATEX\ code. */
+ if (node_type(location) == split_node && node_subtype(location) == insert_split_subtype) {
+ lmt_page_builder_state.insert_penalties += insert_float_cost(p);
+ } else {
+ scaled delta = page_goal - page_total - page_depth + page_shrink;
+ scaled needed = insert_total_height(p);
+ split_last_insert(location) = p;
+ /*tex This much room is left if we shrink the maximum. */
+ if (multiplier != 1000) {
+ /*tex This much room is needed. */
+ needed = tex_x_over_n(needed, 1000) * multiplier;
+ }
+ if ((needed <= 0 || needed <= delta) && (insert_total_height(p) + box_height(location) <= limit)) {
+ update_page_goal(index, insert_total_height(p), needed);
+ box_height(location) += insert_total_height(p);
+ } else {
+ /*tex
+
+ Find the best way to split the insertion, and change |subtype(r)|
+ to |split_up_inserting_code|.
+
+ Here is the code that will split a long footnote between pages,
+ in an emergency. The current situation deserves to be
+ recapitulated: Node |p| is an insertion into box |n|; the
+ insertion will not fit, in its entirety, either because it
+ would make the total contents of box |n| greater than |\dimen|
+ |n|, or because it would make the incremental amount of growth
+ |h| greater than the available space |delta|, or both. (This
+ amount |h| has been weighted by the insertion scaling factor,
+ i.e., by |\count| |n| over 1000.) Now we will choose the best
+ way to break the vlist of the insertion, using the same criteria
+ as in the |\vsplit| operation.
+
+ */
+ scaled height;
+ halfword brk, penalty;
+ if (multiplier <= 0) {
+ height = max_dimen;
+ } else {
+ height = page_goal - page_total - page_depth;
+ if (multiplier != 1000) {
+ height = tex_x_over_n(height, multiplier) * 1000;
+ }
+ }
+ if (height > limit - box_height(location)) {
+ height = limit - box_height(location);
+ }
+ brk = tex_vert_break(insert_list(p), height, insert_max_depth(p));
+ box_height(location) += lmt_packaging_state.best_height_plus_depth;
+ penalty = brk ? (node_type(brk) == penalty_node ? penalty_amount(brk) : 0) : eject_penalty;
+ if (tracing_pages_par > 0) {
+ tex_aux_display_insertion_split_cost(index, height, penalty);
+ }
+ if (multiplier != 1000) {
+ lmt_packaging_state.best_height_plus_depth = tex_x_over_n(lmt_packaging_state.best_height_plus_depth, 1000) * multiplier;
+ }
+ update_page_goal(index, lmt_packaging_state.best_height_plus_depth, lmt_packaging_state.best_height_plus_depth);
+ node_subtype(location) = insert_split_subtype;
+ split_broken(location) = brk;
+ split_broken_insert(location) = p;
+ lmt_page_builder_state.insert_penalties += penalty;
+ }
+ }
+ goto CONTRIBUTE;
+ }
+ default:
+ tex_formatted_error("pagebuilder", "invalid node of type %d in vertical mode", node_type(p));
+ break;
+ }
+ /*tex
+ Check if node |p| is a new champion breakpoint; then if it is time for a page break,
+ prepare for output, and either fire up the users output routine and |return| or
+ ship out the page and |goto done|.
+ */
+ if (pi < infinite_penalty) {
+ /*tex
+ Compute the badness, |b|, of the current page, using |awful_bad| if the box is
+ too full. The |c| variable holds the costs.
+ */
+ halfword badness, criterium;
+ /*tex
+ This could actually be a callback but not now. First we will experiment a lot
+ with this yet undocumented trick.
+ */
+ lmt_page_builder_state.last_extra_used = 0;
+ badness = tex_aux_page_badness(page_goal);
+ if (page_extra_goal_par) {
+ if (badness >= awful_bad && page_total >= (page_goal + page_extra_goal_par)) {
+ halfword extrabadness = tex_aux_page_badness(page_goal + page_extra_goal_par);
+ if (tracing_pages_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_format(
+ "[page: extra check, total=%P, goal=%D, extragoal=%D, badness=%B, extrabadness=%B]",
+ page_total, page_stretch, page_filstretch, page_fillstretch, page_filllstretch, page_shrink,
+ page_goal, pt_unit, page_extra_goal_par, pt_unit, badness, extrabadness
+ );
+ tex_end_diagnostic();
+ }
+ lmt_page_builder_state.last_extra_used = 1;
+ badness = extrabadness;
+ }
+ }
+ if (badness >= awful_bad) {
+ criterium = badness;
+ } else if (pi <= eject_penalty) {
+ criterium = pi;
+ } else if (badness < infinite_bad) {
+ criterium = badness + pi + lmt_page_builder_state.insert_penalties;
+ } else {
+ criterium = deplorable;
+ }
+ if (lmt_page_builder_state.insert_penalties >= 10000) {
+ criterium = awful_bad;
+ }
+ {
+ int moveon = criterium <= lmt_page_builder_state.least_cost;
+ int fireup = criterium == awful_bad || pi <= eject_penalty;
+ if (tracing_pages_par > 0) {
+ tex_aux_display_page_break_cost(badness, pi, criterium, moveon, fireup);
+ }
+ if (moveon) {
+ halfword r = node_next(page_insert_head);
+ lmt_page_builder_state.best_break = p;
+ lmt_page_builder_state.best_size = page_goal;
+ lmt_page_builder_state.insert_penalties = 0;
+ lmt_page_builder_state.least_cost = criterium;
+ while (r != page_insert_head) {
+ split_best_insert(r) = split_last_insert(r);
+ r = node_next(r);
+ }
+ }
+ if (fireup) {
+ /*tex Output the current page at the best place. */
+ tex_aux_fire_up(p);
+ if (lmt_page_builder_state.output_active) {
+ /*tex User's output routine will act. */
+ return;
+ } else {
+ /*tex The page has been shipped out by default output routine. */
+ continue;
+ }
+ }
+ }
+ }
+ UPDATEHEIGHTS:
+ /*tex
+ Go here to record glue in the |active_height| table. Update the current page
+ measurements with respect to the glue or kern specified by node~|p|.
+ */
+ switch(node_type(p)) {
+ case kern_node:
+ page_total += page_depth + kern_amount(p);
+ page_depth = 0;
+ goto APPEND;
+ case glue_node:
+ if (glue_stretch_order(p) > 1) {
+ page_stretch_1(glue_stretch_order(p)) += glue_stretch(p);
+ } else {
+ page_stretch_2(glue_stretch_order(p)) += glue_stretch(p);
+ }
+ page_shrink += glue_shrink(p);
+ if (glue_shrink_order(p) != normal_glue_order && glue_shrink(p)) {
+ tex_handle_error(
+ normal_error_type,
+ "Infinite glue shrinkage found on current page",
+ "The page about to be output contains some infinitely shrinkable glue, e.g.,\n"
+ "'\\vss' or '\\vskip 0pt minus 1fil'. Such glue doesn't belong there; but you can\n"
+ "safely proceed, since the offensive shrinkability has been made finite."
+ );
+ tex_reset_glue_to_zero(p);
+ glue_shrink_order(p) = normal_glue_order;
+ }
+ page_total += page_depth + glue_amount(p);
+ page_depth = 0;
+ goto APPEND;
+ }
+ CONTRIBUTE:
+ /*tex
+ Go here to link a node into the current page. Make sure that |page_max_depth| is
+ not exceeded.
+ */
+ if (page_depth > lmt_page_builder_state.max_depth) {
+ page_total += page_depth - lmt_page_builder_state.max_depth;
+ page_depth = lmt_page_builder_state.max_depth;
+ }
+ APPEND:
+ /*tex Link node |p| into the current page and |goto done|. We assume a positive depth. */
+ tex_couple_nodes(lmt_page_builder_state.page_tail, p);
+ lmt_page_builder_state.page_tail = p;
+ tex_try_couple_nodes(contribute_head, node_next(p));
+ node_next(p) = null;
+ continue;
+ DISCARD:
+ /*tex Recycle node |p|. */
+ tex_try_couple_nodes(contribute_head, node_next(p));
+ node_next(p) = null;
+ if (saving_vdiscards_par > 0) {
+ if (lmt_packaging_state.page_discards_head) {
+ tex_couple_nodes(lmt_packaging_state.page_discards_tail, p);
+ } else {
+ lmt_packaging_state.page_discards_head = p;
+ }
+ lmt_packaging_state.page_discards_tail = p;
+ } else {
+ tex_flush_node_list(p);
+ }
+ } while (node_next(contribute_head));
+ /*tex Make the contribution list empty by setting its tail to |contribute_head|. */
+ contribute_tail = contribute_head;
+ }
+}
+
+/*tex
+
+ When the page builder has looked at as much material as could appear before the next page break,
+ it makes its decision. The break that gave minimum badness will be used to put a completed page
+ into box |\outputbox|, with insertions appended to their other boxes.
+
+ We also set the values of |top_mark|, |first_mark|, and |bot_mark|. The program uses the fact
+ that |bot_mark(x) <> null| implies |first_mark(x) <> null|; it also knows that |bot_mark(x) =
+ null| implies |top_mark(x) = first_mark(x) = null|.
+
+ The |fire_up| subroutine prepares to output the current page at the best place; then it fires
+ up the user's output routine, if there is one, or it simply ships out the page. There is one
+ parameter, |c|, which represents the node that was being contributed to the page when the
+ decision to force an output was made.
+
+*/
+
+static void tex_aux_fire_up(halfword c)
+{
+ /*tex nodes being examined and/or changed */
+ halfword p, q;
+ /*tex predecessor of |p|, we could just use node_prev(p) instead */
+ halfword prev_p;
+ /*tex Set the value of |output_penalty|. */
+ if (node_type(lmt_page_builder_state.best_break) == penalty_node) {
+ update_tex_output_penalty(penalty_amount(lmt_page_builder_state.best_break));
+ penalty_amount(lmt_page_builder_state.best_break) = infinite_penalty;
+ } else {
+ update_tex_output_penalty(infinite_penalty);
+ }
+ tex_update_top_marks();
+ /*tex
+ Put the optimal current page into box |output_box|, update |first_mark| and |bot_mark|,
+ append insertions to their boxes, and put the remaining nodes back on the contribution
+ list.
+
+ As the page is finally being prepared for output, pointer |p| runs through the vlist, with
+ |prev_p| trailing behind; pointer |q| is the tail of a list of insertions that are being
+ held over for a subsequent page.
+ */
+ if (c == lmt_page_builder_state.best_break) {
+ /*tex |c| not yet linked in */
+ lmt_page_builder_state.best_break = null;
+ }
+ /*tex Ensure that box |output_box| is empty before output. */
+ if (box_register(output_box_par)) {
+ tex_handle_error(
+ normal_error_type,
+ "\\box%i is not void",
+ output_box_par,
+ "You shouldn't use \\box\\outputbox except in \\output routines. Proceed, and I'll\n"
+ "discard its present contents."
+ );
+ box_register(output_box_par) = tex_aux_delete_box_content(box_register(output_box_par));
+ }
+ /*
+ {
+ int callback_id = lmt_callback_defined(fire_up_output_callback);
+ if (callback_id != 0) {
+ halfword insert = node_next(page_insert_head);
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ }
+ }
+ */
+ /*tex This will count the number of insertions held over. */
+ {
+ halfword save_split_top_skip = split_top_skip_par;
+ lmt_page_builder_state.insert_penalties = 0;
+ if (holding_inserts_par <= 0) {
+ /*tex
+ Prepare all the boxes involved in insertions to act as queues. If many insertions are
+ supposed to go into the same box, we want to know the position of the last node in that
+ box, so that we don't need to waste time when linking further information into it. The
+ |last_insert| fields of the page insertion nodes are therefore used for this purpose
+ during the packaging phase.
+
+ This is tricky: |last_insert| directly points to a \quote {address} in the node list,
+ that is: the row where |list_ptr| sits. The |raw_list_ptr| macro is just an offset to
+ the base index of the node. Then |node_next| will start out there and follow the list.
+ So, |last_insert| kind of points to a subnode (as in disc nodes) of size 1.
+
+ last_insert => [shift][list]
+
+ which fakes:
+
+ last_insert => [type|subtype][next] => [real node with next]
+
+ and with shift being zero this (when it would be queried) will be seen as a hlist node
+ of type zero with subtype zero, but ... it is not really such a node which means that
+ other properties are not valid! Normally this is ok, because \TEX\ only follows this
+ list and never looks at the parent. But, when accessing from \LUA\ this is asking for
+ troubles. However, as all happens in the page builder, we don't really expose this and
+ if we would (somehow, e.g. via a callback) then for sure we would need to make sure
+ that the node |last_insert(r)| points to is made into a new kind of node: one with
+ size 1 and type |fake_node| or so, just to be sure (so that at the \LUA\ end no
+ properties can be asked).
+
+ Of course I can be wrong here and changing the approach would involve patching some
+ code that I don't want to touch. I need a test case for \quote {following the chain}.
+ */
+ halfword r = node_next(page_insert_head);
+ while (r != page_insert_head) {
+ if (split_best_insert(r)) {
+ halfword index = insert_index(r);
+ halfword content = tex_get_insert_content(index);
+ if (! tex_aux_valid_insert_content(content)) {
+ content = tex_aux_delete_box_content(content);
+ }
+ if (! content) {
+ /*tex
+ So we package the content in a box. Originally this is a hlist which
+ is somewhat strange because we're operating in vmode. The box is still
+ empty!
+ */
+ content = tex_new_null_box_node(vlist_node, insert_result_list);
+ tex_set_insert_content(index, content);
+ }
+ /*tex
+ We locate the place where we can add. We have an (unpackaged) list here so we
+ need to go to the end. Here we have this sort of hackery |box(n) + 5 == row of
+ list ptr, a fake node of size 1| trick.
+ */
+ p = insert_first_box(content);
+ /*tex
+ From here on we access the regular |list_ptr == node_next| chain.
+ */
+ while (node_next(p)) {
+ p = node_next(p);
+ }
+ /*
+ This is now a pointer into the node array (a fake - list_ptr row - or follow up).
+ */
+ split_last_insert(r) = p;
+ }
+ r = node_next(r);
+ }
+ }
+ q = hold_head;
+ node_next(q) = null;
+ prev_p = page_head;
+ p = node_next(prev_p);
+ while (p != lmt_page_builder_state.best_break) {
+ switch (node_type(p)) {
+ case insert_node:
+ if (holding_inserts_par <= 0) {
+ /*tex
+ Either insert the material specified by node |p| into the appropriate box, or
+ hold it for the next page; also delete node |p| from the current page.
+
+ We will set |best_insert := null| and package the box corresponding to
+ insertion node |r|, just after making the final insertion into that box. If
+ this final insertion is |split_up_node|, the remainder after splitting and
+ pruning (if any) will be carried over to the next page.
+ */
+ /*tex should the present insertion be held over? */
+ int wait = 0;
+ halfword r = node_next(page_insert_head);
+ while (insert_index(r) != insert_index(p)) {
+ r = node_next(r);
+ }
+ if (split_best_insert(r)) {
+ halfword s = split_last_insert(r);
+ // node_next(s) = insert_list(p);
+ tex_try_couple_nodes(s, insert_list(p));
+ if (split_best_insert(r) == p) {
+ /*tex
+ Wrap up the box specified by node |r|, splitting node |p| if called
+ for and set |wait| if node |p| holds a remainder after splitting.
+ */
+ if (node_type(r) == split_node && node_subtype(r) == insert_split_subtype && (split_broken_insert(r) == p) && split_broken(r)) {
+ while (node_next(s) != split_broken(r)) {
+ s = node_next(s);
+ }
+ node_next(s) = null;
+ split_top_skip_par = insert_split_top(p);
+ insert_list(p) = tex_prune_page_top(split_broken(r), 0);
+ if (insert_list(p)) {
+ /*tex
+ We only determine the total height of the list stored in
+ the insert node.
+ */
+ halfword list = insert_list(p);
+ halfword result = tex_vpack(list, 0, packing_additional, max_dimen, direction_unknown, holding_none_option);
+ insert_total_height(p) = box_total(result);
+ box_list(result) = null;
+ tex_flush_node(result);
+ wait = 1;
+ }
+ }
+ {
+ split_best_insert(r) = null;
+ /*tex
+ We need this juggling in order to also set the old school box
+ when we're in traditional mode.
+ */
+ halfword index = insert_index(r);
+ halfword content = tex_get_insert_content(index);
+ halfword list = box_list(content);
+ halfword result = tex_vpack(list, 0, packing_additional, max_dimen, dir_lefttoright, holding_none_option);
+ tex_set_insert_content(index, result);
+ box_list(content) = null;
+ tex_flush_node(content);
+ }
+ } else {
+ split_last_insert(r) = tex_tail_of_node_list(s);
+ }
+ } else {
+ wait = 1;
+ }
+ /*tex
+ Either append the insertion node |p| after node |q|, and remove it from the
+ current page, or delete |node(p)|.
+ */
+ tex_try_couple_nodes(prev_p, node_next(p));
+ node_next(p) = null;
+ if (wait) {
+ tex_couple_nodes(q, p);
+ q = p;
+ ++lmt_page_builder_state.insert_penalties;
+ } else {
+ insert_list(p) = null;
+ tex_flush_node(p);
+ }
+ p = prev_p;
+ }
+ break;
+ case mark_node:
+ tex_update_first_and_bot_mark(p);
+ break;
+ }
+ prev_p = p;
+ p = node_next(p);
+ }
+ split_top_skip_par = save_split_top_skip;
+ }
+ /*tex
+ Break the current page at node |p|, put it in box~|output_box|, and put the remaining nodes
+ on the contribution list.
+
+ When the following code is executed, the current page runs from node |vlink (page_head)| to
+ node |prev_p|, and the nodes from |p| to |page_tail| are to be placed back at the front of
+ the contribution list. Furthermore the heldover insertions appear in a list from |vlink
+ (hold_head)| to |q|; we will put them into the current page list for safekeeping while the
+ user's output routine is active. We might have |q = hold_head|; and |p = null| if and only
+ if |prev_p = page_tail|. Error messages are suppressed within |vpackage|, since the box
+ might appear to be overfull or underfull simply because the stretch and shrink from the
+ |\skip| registers for inserts are not actually present in the box.
+ */
+ if (p) {
+ if (! node_next(contribute_head)) {
+ contribute_tail = lmt_page_builder_state.page_tail;
+ }
+ tex_couple_nodes(lmt_page_builder_state.page_tail, node_next(contribute_head));
+ tex_couple_nodes(contribute_head, p);
+ node_next(prev_p) = null;
+ }
+ /*tex When we pack the box we inhibit error messages. */
+ {
+ halfword save_vbadness = vbadness_par;
+ halfword save_vfuzz = vfuzz_par;
+ vbadness_par = infinite_bad;
+ vfuzz_par = max_dimen;
+ tex_show_marks();
+ // if (1) {
+ box_register(output_box_par) = tex_filtered_vpack(node_next(page_head), lmt_page_builder_state.best_size, packing_exactly, lmt_page_builder_state.max_depth, output_group, dir_lefttoright, 0, 0, 0, holding_none_option);
+ // } else {
+ // /* maybe an option one day */
+ // box_register(output_box_par) = tex_filtered_vpack(node_next(page_head), 0, packing_additional, lmt_page_builder_state.max_depth, output_group, dir_lefttoright, 0, 0, 0);
+ // }
+ vbadness_par = save_vbadness;
+ vfuzz_par = save_vfuzz;
+ }
+ if (lmt_page_builder_state.last_glue != max_halfword) {
+ tex_flush_node(lmt_page_builder_state.last_glue);
+ }
+ /*tex Start a new current page. This sets |last_glue := max_halfword|. */
+ tex_aux_start_new_page();
+ if (q != hold_head) {
+ node_next(page_head) = node_next(hold_head);
+ lmt_page_builder_state.page_tail = q;
+ }
+ /*tex Delete the page-insertion nodes. */
+ {
+ halfword r = node_next(page_insert_head);
+ while (r != page_insert_head) {
+ q = node_next(r);
+ tex_flush_node(r);
+ r = q;
+ }
+ }
+ node_next(page_insert_head) = page_insert_head;
+ tex_update_first_marks();
+ if (output_routine_par) {
+ if (lmt_page_builder_state.dead_cycles >= max_dead_cycles_par) {
+ /*tex Explain that too many dead cycles have occurred in a row. */
+ tex_handle_error(
+ normal_error_type,
+ "Output loop --- %i consecutive dead cycles",
+ lmt_page_builder_state.dead_cycles,
+ "I've concluded that your \\output is awry; it never does a \\shipout, so I'm\n"
+ "shipping \\box\\outputbox out myself. Next time increase \\maxdeadcycles if you\n"
+ "want me to be more patient!"
+ );
+ } else {
+ /*tex Fire up the users output routine and |return|. */
+ lmt_page_builder_state.output_active = 1;
+ ++lmt_page_builder_state.dead_cycles;
+ tex_push_nest();
+ cur_list.mode = -vmode;
+ cur_list.prev_depth = ignore_depth;
+ cur_list.mode_line = -lmt_input_state.input_line;
+ tex_begin_token_list(output_routine_par, output_text);
+ tex_new_save_level(output_group);
+ tex_normal_paragraph(output_par_context);
+ tex_scan_left_brace();
+ return;
+ }
+ }
+ /*tex
+ Perform the default output routine. The list of heldover insertions, running from |vlink
+ (page_head)| to |page_tail|, must be moved to the contribution list when the user has
+ specified no output routine.
+ */
+
+ /* todo: double link */
+
+ if (node_next(page_head)) {
+ if (node_next(contribute_head)) {
+ node_next(lmt_page_builder_state.page_tail) = node_next(contribute_head);
+ }
+ else {
+ contribute_tail = lmt_page_builder_state.page_tail;
+ }
+ node_next(contribute_head) = node_next(page_head);
+ node_next(page_head) = null;
+ lmt_page_builder_state.page_tail = page_head;
+ }
+ if (lmt_packaging_state.page_discards_head) {
+ tex_flush_node_list(lmt_packaging_state.page_discards_head);
+ lmt_packaging_state.page_discards_head = null;
+ }
+ if (box_register(output_box_par)) {
+ tex_flush_node_list(box_register(output_box_par));
+ box_register(output_box_par) = null;
+ }
+}
+
+/*tex
+
+ When the user's output routine finishes, it has constructed a vlist in internal vertical mode,
+ and \TEX\ will do the following:
+
+*/
+
+void tex_resume_after_output(void)
+{
+ if (lmt_input_state.cur_input.loc || ((lmt_input_state.cur_input.token_type != output_text) && (lmt_input_state.cur_input.token_type != backed_up_text))) {
+ /*tex Recover from an unbalanced output routine */
+ tex_handle_error(
+ normal_error_type,
+ "Unbalanced output routine",
+ "Your sneaky output routine has problematic {'s and/or }'s. I can't handle that\n"
+ "very well; good luck."
+ );
+ /*tex Loops forever if reading from a file, since |null = min_halfword <= 0|. */
+ do {
+ tex_get_token();
+ } while (lmt_input_state.cur_input.loc);
+ }
+ /*tex Conserve stack space in case more outputs are triggered. */
+ tex_end_token_list();
+ tex_end_paragraph(bottom_level_group, output_par_context); /*tex No |wrapped_up_paragraph| here. */
+ tex_unsave();
+ lmt_page_builder_state.output_active = 0;
+ lmt_page_builder_state.insert_penalties = 0;
+ /*tex Ensure that box |output_box| is empty after output. */
+ if (box_register(output_box_par)) {
+ tex_handle_error(
+ normal_error_type,
+ "Output routine didn't use all of \\box%i", output_box_par,
+ "Your \\output commands should empty \\box\\outputbox, e.g., by saying\n"
+ "'\\shipout\\box\\outputbox'. Proceed; I'll discard its present contents."
+ );
+ box_register(output_box_par) = tex_aux_delete_box_content(box_register(output_box_par));;
+ }
+ if (lmt_insert_state.storing == insert_storage_delay && tex_insert_stored()) {
+ if (tracing_inserts_par > 0) {
+ tex_print_levels();
+ tex_print_str(lmt_insert_state.head ? "<delaying inserts>" : "<no inserts to delay>");
+ if (lmt_insert_state.head && tracing_inserts_par > 1) {
+ tex_show_node_list(lmt_insert_state.head, max_integer, max_integer);
+ }
+ }
+ tex_try_couple_nodes(lmt_page_builder_state.page_tail, lmt_insert_state.head);
+ lmt_page_builder_state.page_tail = lmt_insert_state.tail;
+ lmt_insert_state.head = null;
+ lmt_insert_state.tail = null;
+ }
+ if (cur_list.tail != cur_list.head) {
+ /*tex Current list goes after heldover insertions. */
+ tex_try_couple_nodes(lmt_page_builder_state.page_tail, node_next(cur_list.head));
+ lmt_page_builder_state.page_tail = cur_list.tail;
+ }
+ if (node_next(page_head)) {
+ /* Both go before heldover contributions. */
+ if (! node_next(contribute_head)) {
+ contribute_tail = lmt_page_builder_state.page_tail;
+ }
+ tex_try_couple_nodes(lmt_page_builder_state.page_tail, node_next(contribute_head));
+ tex_try_couple_nodes(contribute_head, node_next(page_head));
+ node_next(page_head) = null;
+ lmt_page_builder_state.page_tail = page_head;
+ }
+ if (lmt_insert_state.storing == insert_storage_inject) {
+ halfword h = node_next(contribute_head);
+ while (h) {
+ halfword n = node_next(h);
+ if (node_type(h) == insert_node) {
+ tex_try_couple_nodes(node_prev(h), n);
+ tex_insert_restore(h);
+ }
+ h = n;
+ }
+ if (tracing_inserts_par > 0) {
+ tex_print_levels();
+ tex_print_str(lmt_insert_state.head ? "<storing inserts>" : "<no inserts to store>");
+ if (lmt_insert_state.head && tracing_inserts_par > 1) {
+ tex_show_node_list(lmt_insert_state.head, max_integer, max_integer);
+ }
+ }
+ }
+ lmt_insert_state.storing = insert_storage_ignore;
+ tex_flush_node_list(lmt_packaging_state.page_discards_head);
+ lmt_packaging_state.page_discards_head = null;
+ tex_pop_nest();
+ lmt_page_filter_callback(after_output_page_context, 0);
+ tex_build_page();
+}
diff --git a/source/luametatex/source/tex/texbuildpage.h b/source/luametatex/source/tex/texbuildpage.h
new file mode 100644
index 000000000..328bed2a1
--- /dev/null
+++ b/source/luametatex/source/tex/texbuildpage.h
@@ -0,0 +1,104 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_BUILDPAGE_H
+# define LMT_BUILDPAGE_H
+
+/*tex
+
+ The state of |page_contents| is indicated by two special values.
+
+*/
+
+typedef enum contribution_codes {
+ contribute_nothing,
+ contribute_insert, /*tex An insert node has been contributed, but no boxes. */
+ contribute_box, /*tex A box has been contributed. */
+ contribute_rule, /*tex A rule has been contributed. */
+} contribution_codes;
+
+typedef struct page_builder_state_info {
+ halfword page_tail; /*tex The final node on the current page. */
+ int contents; /*tex What is on the current page so far? */
+ scaled max_depth; /*tex The maximum box depth on page being built. */
+ halfword best_break; /*tex Break here to get the best page known so far. */
+ int least_cost; /*tex The score for this currently best page. */
+ scaled best_size; /*tex Its |page_goal| so it can go away. */
+ scaled goal;
+ scaled vsize;
+ scaled total;
+ scaled depth;
+ union {
+ scaled page_so_far[6]; /*tex The height and glue of the current page. */
+ struct {
+ scaled initial;
+ scaled stretch;
+ scaled filstretch;
+ scaled fillstretch;
+ scaled filllstretch;
+ scaled shrink;
+ };
+ };
+ int insert_penalties; /*tex The sum of the penalties for held-over insertions. */
+ halfword insert_heights;
+ halfword last_glue; /*tex Used to implement |\lastskip|. */
+ halfword last_penalty; /*tex Used to implement |\lastpenalty|. */
+ scaled last_kern; /*tex Used to implement |\lastkern|. */
+ int last_extra_used;
+ halfword last_boundary;
+ int last_node_type; /*tex Used to implement |\lastnodetype|. */
+ int last_node_subtype; /*tex Used to implement |\lastnodesubtype|. */
+ int output_active;
+ int dead_cycles;
+ int current_state;
+} page_builder_state_info;
+
+extern page_builder_state_info lmt_page_builder_state;
+
+typedef enum page_property_states {
+ page_initial_state, /* we need an offset and are aligned anyway */
+ page_stretch_state,
+ page_filstretch_state,
+ page_fillstretch_state,
+ page_filllstretch_state,
+ page_shrink_state,
+} page_property_states;
+
+# define page_state_offset(c) (c - page_stretch_code + page_stretch_state)
+
+/*tex
+
+ The data structure definitions here use the fact that the |height| field
+ appears in the fourth word of a box node.
+
+*/
+
+extern void tex_initialize_buildpage (void);
+extern void tex_initialize_pagestate (void);
+extern void tex_build_page (void);
+extern void tex_resume_after_output (void);
+extern void tex_print_page_totals (void);
+
+/*tex The tail of the contribution list: */
+
+# define contribute_tail lmt_nest_state.nest[0].tail
+
+# define page_goal lmt_page_builder_state.goal /*tex The desired height of information on page being built. */
+# define page_vsize lmt_page_builder_state.vsize
+# define page_total lmt_page_builder_state.total /*tex The height of the current page. */
+# define page_depth lmt_page_builder_state.depth /*tex The depth of the current page. */
+
+//# define page_stretch lmt_page_builder_state.page_so_far[page_stretch_state]
+//# define page_filstretch lmt_page_builder_state.page_so_far[page_filstretch_state]
+//# define page_fillstretch lmt_page_builder_state.page_so_far[page_fillstretch_state]
+//# define page_filllstretch lmt_page_builder_state.page_so_far[page_filllstretch_state]
+//# define page_shrink lmt_page_builder_state.page_so_far[page_shrink_state]
+
+# define page_stretch lmt_page_builder_state.stretch
+# define page_filstretch lmt_page_builder_state.filstretch
+# define page_fillstretch lmt_page_builder_state.fillstretch
+# define page_filllstretch lmt_page_builder_state.filllstretch
+# define page_shrink lmt_page_builder_state.shrink
+
+# endif
diff --git a/source/luametatex/source/tex/texcommands.c b/source/luametatex/source/tex/texcommands.c
new file mode 100644
index 000000000..3ac1a7b23
--- /dev/null
+++ b/source/luametatex/source/tex/texcommands.c
@@ -0,0 +1,1318 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ We start with a couple of \ETEX\ related comments:
+
+ The |\showtokens| command displays a token list. The |\showifs| command displays all currently
+ active conditionals.
+
+ 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.
+
+ 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|.
+
+ 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|.
+
+ The |\interlinepenalties|, |\clubpenalties|, |\widowpenalties|, and |\displaywidowpenalties|
+ commands allow to define arrays of penalty values to be used instead of the corresponding single
+ values.
+
+*/
+
+/*tex
+
+ 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.
+
+ 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.
+
+ The processing of |\input| involves the |start_input| subroutine, which will be declared later;
+ the processing of |\endinput| is trivial.
+
+ 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|.
+
+ Because in \LUATEX\ and \LUAMETATEX\ we have more primitives, and use a lookup table, we combine
+ commands, for instance the |\aftergroup| and |\afterassignment| are just simple runners and
+ instead of the old two single cases, we now have one case that handles the four variants. This
+ keeps similar code close and also saves lookups. So, we have a few |cmd| less than normally in
+ a \TEX\ engine, but also a few more. Some have been renamed because they do more now (already
+ in \ETEX).
+
+*/
+
+static void tex_aux_copy_deep_frozen_from_primitive(halfword code, const char *s)
+{
+ halfword p = tex_prim_lookup(tex_located_string(s));
+ cs_text(code) = cs_text(p);
+ copy_eqtb_entry(code, p);
+}
+
+void tex_initialize_commands(void)
+{
+
+ if (lmt_main_state.run_state == initializing_state) {
+
+ lmt_hash_state.no_new_cs = 0;
+ lmt_fileio_state.io_first = 0;
+
+ /*tex glue */
+
+ tex_primitive(tex_command, "lineskip", internal_glue_cmd, line_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "baselineskip", internal_glue_cmd, baseline_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "parskip", internal_glue_cmd, par_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "abovedisplayskip", internal_glue_cmd, above_display_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "belowdisplayskip", internal_glue_cmd, below_display_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "abovedisplayshortskip", internal_glue_cmd, above_display_short_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "belowdisplayshortskip", internal_glue_cmd, below_display_short_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "leftskip", internal_glue_cmd, left_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "rightskip", internal_glue_cmd, right_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "topskip", internal_glue_cmd, top_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "splittopskip", internal_glue_cmd, split_top_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "tabskip", internal_glue_cmd, tab_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "spaceskip", internal_glue_cmd, space_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "xspaceskip", internal_glue_cmd, xspace_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "parfillleftskip", internal_glue_cmd, par_fill_left_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "parfillskip", internal_glue_cmd, par_fill_right_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "parinitleftskip", internal_glue_cmd, par_init_left_skip_code, internal_glue_base);
+ tex_primitive(tex_command, "parinitrightskip", internal_glue_cmd, par_init_right_skip_code, internal_glue_base);
+ tex_primitive(luatex_command, "mathsurroundskip", internal_glue_cmd, math_skip_code, internal_glue_base);
+ tex_primitive(luatex_command, "maththreshold", internal_glue_cmd, math_threshold_code, internal_glue_base);
+
+ /*tex math glue */
+
+ tex_primitive(luatex_command, "pettymuskip", internal_mu_glue_cmd, petty_mu_skip_code, internal_mu_glue_base);
+ tex_primitive(luatex_command, "tinymuskip", internal_mu_glue_cmd, tiny_mu_skip_code, internal_mu_glue_base);
+ tex_primitive(tex_command, "thinmuskip", internal_mu_glue_cmd, thin_mu_skip_code, internal_mu_glue_base);
+ tex_primitive(tex_command, "medmuskip", internal_mu_glue_cmd, med_mu_skip_code, internal_mu_glue_base);
+ tex_primitive(tex_command, "thickmuskip", internal_mu_glue_cmd, thick_mu_skip_code, internal_mu_glue_base);
+
+ /*tex tokens */
+
+ tex_primitive(tex_command, "output", internal_toks_cmd, output_routine_code, internal_toks_base);
+ tex_primitive(tex_command, "everypar", internal_toks_cmd, every_par_code, internal_toks_base);
+ tex_primitive(tex_command, "everymath", internal_toks_cmd, every_math_code, internal_toks_base);
+ tex_primitive(tex_command, "everydisplay", internal_toks_cmd, every_display_code, internal_toks_base);
+ tex_primitive(tex_command, "everyhbox", internal_toks_cmd, every_hbox_code, internal_toks_base);
+ tex_primitive(tex_command, "everyvbox", internal_toks_cmd, every_vbox_code, internal_toks_base);
+ tex_primitive(luatex_command, "everymathatom", internal_toks_cmd, every_math_atom_code, internal_toks_base);
+ tex_primitive(tex_command, "everyjob", internal_toks_cmd, every_job_code, internal_toks_base);
+ tex_primitive(tex_command, "everycr", internal_toks_cmd, every_cr_code, internal_toks_base);
+ tex_primitive(luatex_command, "everytab", internal_toks_cmd, every_tab_code, internal_toks_base);
+ /* tex_primitive(luatex_command, "endofpar", internal_toks_cmd, end_of_par_code, internal_toks_base); */
+ tex_primitive(tex_command, "errhelp", internal_toks_cmd, error_help_code, internal_toks_base);
+ tex_primitive(etex_command, "everyeof", internal_toks_cmd, every_eof_code, internal_toks_base);
+ tex_primitive(luatex_command, "everybeforepar", internal_toks_cmd, every_before_par_code, internal_toks_base);
+ tex_primitive(no_command, "endofgroup", internal_toks_cmd, end_of_group_code, internal_toks_base);
+
+ /*tex counters (we could omit the int_base here as effectively it is subtracted) */
+
+ tex_primitive(tex_command, "adjdemerits", internal_int_cmd, adj_demerits_code, internal_int_base);
+ tex_primitive(tex_command, "binoppenalty", internal_int_cmd, post_binary_penalty_code, internal_int_base); /*tex For old times sake. */
+ tex_primitive(tex_command, "brokenpenalty", internal_int_cmd, broken_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "clubpenalty", internal_int_cmd, club_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "day", internal_int_cmd, day_code, internal_int_base);
+ tex_primitive(tex_command, "defaulthyphenchar", internal_int_cmd, default_hyphen_char_code, internal_int_base);
+ tex_primitive(tex_command, "defaultskewchar", internal_int_cmd, default_skew_char_code, internal_int_base);
+ tex_primitive(tex_command, "delimiterfactor", internal_int_cmd, delimiter_factor_code, internal_int_base);
+ tex_primitive(tex_command, "displaywidowpenalty", internal_int_cmd, display_widow_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "doublehyphendemerits", internal_int_cmd, double_hyphen_demerits_code, internal_int_base);
+ tex_primitive(tex_command, "endlinechar", internal_int_cmd, end_line_char_code, internal_int_base);
+ tex_primitive(tex_command, "errorcontextlines", internal_int_cmd, error_context_lines_code, internal_int_base);
+ tex_primitive(tex_command, "escapechar", internal_int_cmd, escape_char_code, internal_int_base);
+ tex_primitive(tex_command, "exhyphenchar", internal_int_cmd, ex_hyphen_char_code, internal_int_base);
+ tex_primitive(tex_command, "exhyphenpenalty", internal_int_cmd, ex_hyphen_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "fam", internal_int_cmd, family_code, internal_int_base);
+ tex_primitive(tex_command, "finalhyphendemerits", internal_int_cmd, final_hyphen_demerits_code, internal_int_base);
+ tex_primitive(tex_command, "floatingpenalty", internal_int_cmd, floating_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "globaldefs", internal_int_cmd, global_defs_code, internal_int_base);
+ tex_primitive(tex_command, "hangafter", internal_int_cmd, hang_after_code, internal_int_base);
+ tex_primitive(tex_command, "hbadness", internal_int_cmd, hbadness_code, internal_int_base);
+ tex_primitive(tex_command, "holdinginserts", internal_int_cmd, holding_inserts_code, internal_int_base);
+ tex_primitive(luatex_command, "holdingmigrations", internal_int_cmd, holding_migrations_code, internal_int_base);
+ tex_primitive(tex_command, "hyphenpenalty", internal_int_cmd, hyphen_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "interlinepenalty", internal_int_cmd, inter_line_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "language", internal_int_cmd, language_code, internal_int_base);
+ tex_primitive(tex_command, "setlanguage", internal_int_cmd, language_code, internal_int_base); /* compatibility */
+ tex_primitive(luatex_command, "setfontid", internal_int_cmd, font_code, internal_int_base);
+ tex_primitive(luatex_command, "hyphenationmode", internal_int_cmd, hyphenation_mode_code, internal_int_base);
+ tex_primitive(tex_command, "lefthyphenmin", internal_int_cmd, left_hyphen_min_code, internal_int_base);
+ tex_primitive(tex_command, "linepenalty", internal_int_cmd, line_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "looseness", internal_int_cmd, looseness_code, internal_int_base);
+ /* tex_primitive(tex_command, "mag", internal_int_cmd, mag_code, internal_int_base); */ /* backend */
+ tex_primitive(tex_command, "maxdeadcycles", internal_int_cmd, max_dead_cycles_code, internal_int_base);
+ tex_primitive(tex_command, "month", internal_int_cmd, month_code, internal_int_base);
+ tex_primitive(tex_command, "newlinechar", internal_int_cmd, new_line_char_code, internal_int_base);
+ tex_primitive(tex_command, "outputpenalty", internal_int_cmd, output_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "pausing", internal_int_cmd, pausing_code, internal_int_base);
+ tex_primitive(tex_command, "postdisplaypenalty", internal_int_cmd, post_display_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "predisplaypenalty", internal_int_cmd, pre_display_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "postinlinepenalty", internal_int_cmd, post_inline_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "preinlinepenalty", internal_int_cmd, pre_inline_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "pretolerance", internal_int_cmd, pre_tolerance_code, internal_int_base);
+ tex_primitive(tex_command, "relpenalty", internal_int_cmd, post_relation_penalty_code, internal_int_base); /*tex For old times sake. */
+ tex_primitive(tex_command, "righthyphenmin", internal_int_cmd, right_hyphen_min_code, internal_int_base);
+ tex_primitive(tex_command, "showboxbreadth", internal_int_cmd, show_box_breadth_code, internal_int_base);
+ tex_primitive(tex_command, "showboxdepth", internal_int_cmd, show_box_depth_code, internal_int_base);
+ tex_primitive(tex_command, "shownodedetails", internal_int_cmd, show_node_details_code, internal_int_base);
+ tex_primitive(tex_command, "time", internal_int_cmd, time_code, internal_int_base);
+ tex_primitive(tex_command, "tolerance", internal_int_cmd, tolerance_code, internal_int_base);
+ tex_primitive(tex_command, "tracingonline", internal_int_cmd, tracing_online_code, internal_int_base);
+ tex_primitive(tex_command, "tracingmacros", internal_int_cmd, tracing_macros_code, internal_int_base);
+ tex_primitive(tex_command, "tracingstats", internal_int_cmd, tracing_stats_code, internal_int_base); /* obsolete */
+ tex_primitive(tex_command, "tracingparagraphs", internal_int_cmd, tracing_paragraphs_code, internal_int_base);
+ tex_primitive(tex_command, "tracingpages", internal_int_cmd, tracing_pages_code, internal_int_base);
+ tex_primitive(tex_command, "tracingoutput", internal_int_cmd, tracing_output_code, internal_int_base);
+ tex_primitive(tex_command, "tracinglostchars", internal_int_cmd, tracing_lost_chars_code, internal_int_base);
+ tex_primitive(tex_command, "tracingcommands", internal_int_cmd, tracing_commands_code, internal_int_base);
+ tex_primitive(tex_command, "tracingrestores", internal_int_cmd, tracing_restores_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingfonts", internal_int_cmd, tracing_fonts_code, internal_int_base);
+ tex_primitive(etex_command, "tracingassigns", internal_int_cmd, tracing_assigns_code, internal_int_base);
+ tex_primitive(etex_command, "tracinggroups", internal_int_cmd, tracing_groups_code, internal_int_base);
+ tex_primitive(etex_command, "tracingifs", internal_int_cmd, tracing_ifs_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingmath", internal_int_cmd, tracing_math_code, internal_int_base);
+ tex_primitive(luatex_command, "tracinglevels", internal_int_cmd, tracing_levels_code, internal_int_base);
+ tex_primitive(etex_command, "tracingnesting", internal_int_cmd, tracing_nesting_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingalignments", internal_int_cmd, tracing_alignments_code, internal_int_base);
+ tex_primitive(luatex_command, "tracinginserts", internal_int_cmd, tracing_inserts_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingmarks", internal_int_cmd, tracing_marks_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingadjusts", internal_int_cmd, tracing_adjusts_code, internal_int_base);
+ tex_primitive(luatex_command, "tracinghyphenation", internal_int_cmd, tracing_hyphenation_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingexpressions", internal_int_cmd, tracing_expressions_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingnodes", internal_int_cmd, tracing_nodes_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingfullboxes", internal_int_cmd, tracing_full_boxes_code, internal_int_base);
+ tex_primitive(luatex_command, "tracingpenalties", internal_int_cmd, tracing_penalties_code, internal_int_base);
+ tex_primitive(tex_command, "uchyph", internal_int_cmd, uc_hyph_code, internal_int_base); /* obsolete */
+ tex_primitive(tex_command, "vbadness", internal_int_cmd, vbadness_code, internal_int_base);
+ tex_primitive(tex_command, "widowpenalty", internal_int_cmd, widow_penalty_code, internal_int_base);
+ tex_primitive(tex_command, "year", internal_int_cmd, year_code, internal_int_base);
+ tex_primitive(no_command, "internalparstate", internal_int_cmd, internal_par_state_code, internal_int_base);
+ tex_primitive(no_command, "internaldirstate", internal_int_cmd, internal_dir_state_code, internal_int_base);
+ tex_primitive(no_command, "internalmathstyle", internal_int_cmd, internal_math_style_code, internal_int_base);
+ tex_primitive(no_command, "internalmathscale", internal_int_cmd, internal_math_scale_code, internal_int_base);
+ tex_primitive(etex_command, "predisplaydirection", internal_int_cmd, pre_display_direction_code, internal_int_base);
+ tex_primitive(etex_command, "lastlinefit", internal_int_cmd, last_line_fit_code, internal_int_base);
+ tex_primitive(etex_command, "savingvdiscards", internal_int_cmd, saving_vdiscards_code, internal_int_base);
+ tex_primitive(etex_command, "savinghyphcodes", internal_int_cmd, saving_hyph_codes_code, internal_int_base);
+ tex_primitive(luatex_command, "adjustspacing", internal_int_cmd, adjust_spacing_code, internal_int_base);
+ tex_primitive(luatex_command, "adjustspacingstep", internal_int_cmd, adjust_spacing_step_code, internal_int_base);
+ tex_primitive(luatex_command, "adjustspacingstretch", internal_int_cmd, adjust_spacing_stretch_code, internal_int_base);
+ tex_primitive(luatex_command, "adjustspacingshrink", internal_int_cmd, adjust_spacing_shrink_code, internal_int_base);
+ tex_primitive(luatex_command, "automatichyphenpenalty", internal_int_cmd, automatic_hyphen_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "catcodetable", internal_int_cmd, cat_code_table_code, internal_int_base);
+ tex_primitive(luatex_command, "exceptionpenalty", internal_int_cmd, exception_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "explicithyphenpenalty", internal_int_cmd, explicit_hyphen_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "firstvalidlanguage", internal_int_cmd, first_valid_language_code, internal_int_base);
+ tex_primitive(luatex_command, "automigrationmode", internal_int_cmd, auto_migration_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "normalizelinemode", internal_int_cmd, normalize_line_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "normalizeparmode", internal_int_cmd, normalize_par_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphdatafield", internal_int_cmd, glyph_data_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphstatefield", internal_int_cmd, glyph_state_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphscriptfield", internal_int_cmd, glyph_script_code, internal_int_base);
+ /* tex_primitive(luatex_command, "gluedatafield", internal_int_cmd, glue_data_code, internal_int_base); */
+ tex_primitive(luatex_command, "localbrokenpenalty", internal_int_cmd, local_broken_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "localinterlinepenalty", internal_int_cmd, local_interline_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "luacopyinputnodes", internal_int_cmd, copy_lua_input_nodes_code, internal_int_base);
+ tex_primitive(luatex_command, "mathcheckfencesmode", internal_int_cmd, math_check_fences_mode_code, internal_int_base);
+ /* tex_primitive(luatex_command, "mathdelimitersmode", internal_int_cmd, math_delimiters_mode_code, internal_int_base); */
+ /* tex_primitive(luatex_command, "mathfencesmode", internal_int_cmd, math_fences_mode_code, internal_int_base); */
+ tex_primitive(luatex_command, "mathslackmode", internal_int_cmd, math_slack_mode_code, internal_int_base);
+ /* tex_primitive(luatex_command, "mathflattenmode", internal_int_cmd, math_flatten_mode_code, internal_int_base); */
+ tex_primitive(luatex_command, "mathpenaltiesmode", internal_int_cmd, math_penalties_mode_code, internal_int_base);
+ /* tex_primitive(luatex_command, "mathrulethicknessmode", internal_int_cmd, math_rule_thickness_mode_code, internal_int_base); */
+ tex_primitive(luatex_command, "mathscriptsmode", internal_int_cmd, math_scripts_mode_code, internal_int_base);
+ /* tex_primitive(luatex_command, "mathscriptboxmode", internal_int_cmd, math_script_box_mode_code, internal_int_base); */
+ /* tex_primitive(luatex_command, "mathscriptcharmode", internal_int_cmd, math_script_char_mode_code, internal_int_base); */
+ tex_primitive(luatex_command, "mathsurroundmode", internal_int_cmd, math_skip_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathdoublescriptmode", internal_int_cmd, math_double_script_mode_code, internal_int_base);
+ /* tex_primitive(luatex_command, "mathcontrolmode", internal_int_cmd, math_control_mode_code, internal_int_base); */
+ tex_primitive(luatex_command, "mathfontcontrol", internal_int_cmd, math_font_control_code, internal_int_base);
+ tex_primitive(luatex_command, "mathdisplaymode", internal_int_cmd, math_display_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathdictgroup", internal_int_cmd, math_dict_group_code, internal_int_base);
+ tex_primitive(luatex_command, "mathdictproperties", internal_int_cmd, math_dict_properties_code, internal_int_base);
+ tex_primitive(luatex_command, "nospaces", internal_int_cmd, disable_spaces_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphoptions", internal_int_cmd, glyph_options_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphscale", internal_int_cmd, glyph_scale_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphtextscale", internal_int_cmd, glyph_text_scale_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphscriptscale", internal_int_cmd, glyph_script_scale_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphscriptscriptscale", internal_int_cmd, glyph_scriptscript_scale_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphxscale", internal_int_cmd, glyph_x_scale_code, internal_int_base);
+ tex_primitive(luatex_command, "glyphyscale", internal_int_cmd, glyph_y_scale_code, internal_int_base);
+ tex_primitive(luatex_command, "outputbox", internal_int_cmd, output_box_code, internal_int_base);
+ tex_primitive(luatex_command, "prebinoppenalty", internal_int_cmd, pre_binary_penalty_code, internal_int_base); /*tex For old times sake. */
+ tex_primitive(luatex_command, "predisplaygapfactor", internal_int_cmd, math_pre_display_gap_factor_code, internal_int_base);
+ tex_primitive(luatex_command, "prerelpenalty", internal_int_cmd, pre_relation_penalty_code, internal_int_base); /*tex For old times sake. */
+ tex_primitive(luatex_command, "protrudechars", internal_int_cmd, protrude_chars_code, internal_int_base);
+ tex_primitive(luatex_command, "matheqnogapstep", internal_int_cmd, math_eqno_gap_step_code, internal_int_base);
+ tex_primitive(luatex_command, "mathdisplayskipmode", internal_int_cmd, math_display_skip_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathnolimitsmode", internal_int_cmd, math_nolimits_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathlimitsmode", internal_int_cmd, math_limits_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathrulesmode", internal_int_cmd, math_rules_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathrulesfam", internal_int_cmd, math_rules_fam_code, internal_int_base);
+ tex_primitive(luatex_command, "mathspacingmode", internal_int_cmd, math_spacing_mode_code, internal_int_base); /*tex Inject zero spaces, for tracing */
+ tex_primitive(luatex_command, "mathgroupingmode", internal_int_cmd, math_grouping_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathgluemode", internal_int_cmd, math_glue_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "mathbeginclass", internal_int_cmd, math_begin_class_code, internal_int_base);
+ tex_primitive(luatex_command, "mathendclass", internal_int_cmd, math_end_class_code, internal_int_base);
+ tex_primitive(luatex_command, "mathleftclass", internal_int_cmd, math_left_class_code, internal_int_base);
+ tex_primitive(luatex_command, "mathrightclass", internal_int_cmd, math_right_class_code, internal_int_base);
+ tex_primitive(luatex_command, "supmarkmode", internal_int_cmd, sup_mark_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "overloadmode", internal_int_cmd, overload_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "autoparagraphmode", internal_int_cmd, auto_paragraph_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "shapingpenaltiesmode", internal_int_cmd, shaping_penalties_mode_code, internal_int_base);
+ tex_primitive(luatex_command, "shapingpenalty", internal_int_cmd, shaping_penalty_code, internal_int_base);
+ tex_primitive(luatex_command, "orphanpenalty", internal_int_cmd, orphan_penalty_code, internal_int_base);
+ /* tex_primitive(luatex_command, "alignmentcellattr", internal_int_cmd, alignment_cell_attribute_code, internal_int_base); */ /* todo */
+ tex_primitive(luatex_command, "alignmentcellsource", internal_int_cmd, alignment_cell_source_code, internal_int_base);
+ tex_primitive(luatex_command, "alignmentwrapsource", internal_int_cmd, alignment_wrap_source_code, internal_int_base);
+ /* tex_primitive(luatex_command, "pageboundarypenalty", internal_int_cmd, page_boundary_penalty_code, internal_int_base); */
+ tex_primitive(luatex_command, "linebreakcriterium", internal_int_cmd, line_break_criterium_code, internal_int_base);
+
+ /*tex dimensions */
+
+ tex_primitive(tex_command, "boxmaxdepth", internal_dimen_cmd, box_max_depth_code, internal_dimen_base);
+ tex_primitive(tex_command, "delimitershortfall", internal_dimen_cmd, delimiter_shortfall_code, internal_dimen_base);
+ tex_primitive(tex_command, "displayindent", internal_dimen_cmd, display_indent_code, internal_dimen_base);
+ tex_primitive(tex_command, "displaywidth", internal_dimen_cmd, display_width_code, internal_dimen_base);
+ tex_primitive(tex_command, "emergencystretch", internal_dimen_cmd, emergency_stretch_code, internal_dimen_base);
+ tex_primitive(tex_command, "hangindent", internal_dimen_cmd, hang_indent_code, internal_dimen_base);
+ tex_primitive(tex_command, "hfuzz", internal_dimen_cmd, hfuzz_code, internal_dimen_base);
+ /* tex_primitive(tex_command, "hoffset", internal_dimen_cmd, h_offset_code, internal_dimen_base); */ /* backend */
+ tex_primitive(tex_command, "hsize", internal_dimen_cmd, hsize_code, internal_dimen_base);
+ tex_primitive(tex_command, "lineskiplimit", internal_dimen_cmd, line_skip_limit_code, internal_dimen_base);
+ tex_primitive(tex_command, "mathsurround", internal_dimen_cmd, math_surround_code, internal_dimen_base);
+ tex_primitive(tex_command, "maxdepth", internal_dimen_cmd, max_depth_code, internal_dimen_base);
+ tex_primitive(tex_command, "nulldelimiterspace", internal_dimen_cmd, null_delimiter_space_code, internal_dimen_base);
+ tex_primitive(tex_command, "overfullrule", internal_dimen_cmd, overfull_rule_code, internal_dimen_base);
+ tex_primitive(tex_command, "parindent", internal_dimen_cmd, par_indent_code, internal_dimen_base);
+ tex_primitive(tex_command, "predisplaysize", internal_dimen_cmd, pre_display_size_code, internal_dimen_base);
+ tex_primitive(tex_command, "scriptspace", internal_dimen_cmd, script_space_code, internal_dimen_base);
+ tex_primitive(tex_command, "splitmaxdepth", internal_dimen_cmd, split_max_depth_code, internal_dimen_base);
+ tex_primitive(tex_command, "vfuzz", internal_dimen_cmd, vfuzz_code, internal_dimen_base);
+ /* tex_primitive(tex_command, "voffset", internal_dimen_cmd, v_offset_code, internal_dimen_base); */ /* backend */
+ tex_primitive(tex_command, "vsize", internal_dimen_cmd, vsize_code, internal_dimen_base);
+ tex_primitive(luatex_command, "glyphxoffset", internal_dimen_cmd, glyph_x_offset_code, internal_dimen_base);
+ tex_primitive(luatex_command, "glyphyoffset", internal_dimen_cmd, glyph_y_offset_code, internal_dimen_base);
+ tex_primitive(luatex_command, "pxdimen", internal_dimen_cmd, px_dimen_code, internal_dimen_base);
+ tex_primitive(luatex_command, "tabsize", internal_dimen_cmd, tab_size_code, internal_dimen_base);
+ tex_primitive(luatex_command, "pageextragoal", internal_dimen_cmd, page_extra_goal_code, internal_dimen_base);
+
+ /*tex Probably never used with \UNICODE\ omnipresent now: */
+
+ tex_primitive(tex_command, "accent", accent_cmd, normal_code, 0);
+
+ /*tex These three can go in one cmd: */
+
+ tex_primitive(tex_command, "advance", arithmic_cmd, advance_code, 0);
+ tex_primitive(tex_command, "divide", arithmic_cmd, divide_code, 0);
+ tex_primitive(tex_command, "multiply", arithmic_cmd, multiply_code, 0);
+
+ /*tex We combined the after thingies into one category:*/
+
+ tex_primitive(tex_command, "afterassignment", after_something_cmd, after_assignment_code, 0);
+ tex_primitive(luatex_command, "afterassigned", after_something_cmd, after_assigned_code, 0);
+ tex_primitive(tex_command, "aftergroup", after_something_cmd, after_group_code, 0);
+ tex_primitive(luatex_command, "aftergrouped", after_something_cmd, after_grouped_code, 0);
+ tex_primitive(luatex_command, "atendofgroup", after_something_cmd, at_end_of_group_code, 0);
+ tex_primitive(luatex_command, "atendofgrouped", after_something_cmd, at_end_of_grouped_code, 0);
+
+ tex_primitive(tex_command, "begingroup", begin_group_cmd, semi_simple_group_code, 0);
+ tex_primitive(luatex_command, "beginsimplegroup", begin_group_cmd, also_simple_group_code, 0);
+ tex_primitive(luatex_command, "beginmathgroup", begin_group_cmd, math_simple_group_code, 0);
+
+ tex_primitive(luatex_command, "noboundary", boundary_cmd, cancel_boundary, 0);
+ tex_primitive(luatex_command, "boundary", boundary_cmd, user_boundary, 0);
+ tex_primitive(luatex_command, "protrusionboundary", boundary_cmd, protrusion_boundary, 0);
+ tex_primitive(luatex_command, "wordboundary", boundary_cmd, word_boundary, 0);
+ tex_primitive(luatex_command, "pageboundary", boundary_cmd, page_boundary, 0);
+ /* tex_primitive(luatex_command, "parboundary", boundary_cmd, par_boundary, 0); */
+
+ tex_primitive(tex_command, "penalty", penalty_cmd, normal_code, 0);
+
+ tex_primitive(tex_command, "char", char_number_cmd, char_number_code, 0);
+ tex_primitive(luatex_command, "glyph", char_number_cmd, glyph_number_code, 0);
+
+ tex_primitive(luatex_command, "etoks", combine_toks_cmd, expanded_toks_code, 0);
+ tex_primitive(luatex_command, "toksapp", combine_toks_cmd, append_toks_code, 0);
+ tex_primitive(luatex_command, "etoksapp", combine_toks_cmd, append_expanded_toks_code, 0);
+ tex_primitive(luatex_command, "tokspre", combine_toks_cmd, prepend_toks_code, 0);
+ tex_primitive(luatex_command, "etokspre", combine_toks_cmd, prepend_expanded_toks_code, 0);
+ tex_primitive(luatex_command, "xtoks", combine_toks_cmd, global_expanded_toks_code, 0);
+ tex_primitive(luatex_command, "gtoksapp", combine_toks_cmd, global_append_toks_code, 0);
+ tex_primitive(luatex_command, "xtoksapp", combine_toks_cmd, global_append_expanded_toks_code, 0);
+ tex_primitive(luatex_command, "gtokspre", combine_toks_cmd, global_prepend_toks_code, 0);
+ tex_primitive(luatex_command, "xtokspre", combine_toks_cmd, global_prepend_expanded_toks_code, 0);
+
+ tex_primitive(tex_command, "csname", cs_name_cmd, cs_name_code, 0);
+ tex_primitive(luatex_command, "lastnamedcs", cs_name_cmd, last_named_cs_code, 0);
+ tex_primitive(luatex_command, "begincsname", cs_name_cmd, begin_cs_name_code, 0);
+ tex_primitive(luatex_command, "futurecsname", cs_name_cmd, future_cs_name_code, 0); /* Okay but rare applications (less tracing). */
+
+ tex_primitive(tex_command, "endcsname", end_cs_name_cmd, normal_code, 0);
+
+ /* set_font_id could use def_font_cmd */
+
+ tex_primitive(tex_command, "font", define_font_cmd, normal_code, 0);
+ /* tex_primitive(tex_command, "nullfont", set_font_cmd, null_font, 0); */ /* See later. */
+
+ tex_primitive(tex_command, "delimiter", delimiter_number_cmd, math_delimiter_code, 0);
+ tex_primitive(luatex_command, "Udelimiter", delimiter_number_cmd, math_udelimiter_code, 0);
+
+ /* tex_primitive(tex_command, "endgroup", end_group_cmd, normal_code, 0); */ /* See later. */
+
+ /*tex We don't combine these because they have different runners and mode handling. */
+
+ tex_primitive(tex_command, " ", explicit_space_cmd, normal_code, 0); /* These will get verbose equivalents: \explicitspace (and maybe a sfless variant too) */
+ tex_primitive(tex_command, "/", italic_correction_cmd, normal_code, 0); /* These will get verbose equivalents: \italiccorrection */
+
+ tex_primitive(tex_command, "expandafter", expand_after_cmd, expand_after_code, 0);
+ tex_primitive(etex_command, "unless", expand_after_cmd, expand_unless_code, 0);
+ tex_primitive(luatex_command, "futureexpand", expand_after_cmd, future_expand_code, 0);
+ tex_primitive(luatex_command, "futureexpandis", expand_after_cmd, future_expand_is_code, 0);
+ tex_primitive(luatex_command, "futureexpandisap", expand_after_cmd, future_expand_is_ap_code, 0);
+ /* tex_primitive(luatex_command, "expandaftertwo", expand_after_cmd, expand_after_2_code, 0); */ /* Yes or no. */
+ /* tex_primitive(luatex_command, "expandafterthree", expand_after_cmd, expand_after_3_code, 0); */ /* Yes or no. */
+ tex_primitive(luatex_command, "expandafterspaces", expand_after_cmd, expand_after_spaces_code, 0);
+ tex_primitive(luatex_command, "expandafterpars", expand_after_cmd, expand_after_pars_code, 0);
+ tex_primitive(luatex_command, "expandtoken", expand_after_cmd, expand_token_code, 0);
+ tex_primitive(luatex_command, "expandcstoken", expand_after_cmd, expand_cs_token_code, 0);
+ tex_primitive(luatex_command, "expand", expand_after_cmd, expand_code, 0);
+ tex_primitive(luatex_command, "semiexpand", expand_after_cmd, semi_expand_code, 0);
+ tex_primitive(luatex_command, "expandedafter", expand_after_cmd, expand_after_toks_code, 0);
+ /* tex_primitive(luatex_command, "expandafterfi", expand_after_cmd, expand_after_fi, 0); */
+
+ tex_primitive(tex_command, "ignorespaces", ignore_something_cmd, ignore_space_code, 0);
+ tex_primitive(luatex_command, "ignorepars", ignore_something_cmd, ignore_par_code, 0);
+ tex_primitive(luatex_command, "ignorearguments", ignore_something_cmd, ignore_argument_code, 0);
+
+ tex_primitive(tex_command, "input", input_cmd, normal_input_code, 0);
+ tex_primitive(tex_command, "endinput", input_cmd, end_of_input_code, 0);
+ tex_primitive(etex_command, "scantokens", input_cmd, token_input_code, 0);
+ tex_primitive(luatex_command, "scantextokens", input_cmd, tex_token_input_code, 0);
+ tex_primitive(luatex_command, "tokenized", input_cmd, tokenized_code, 0);
+ tex_primitive(luatex_command, "retokenized", input_cmd, retokenized_code, 0);
+ tex_primitive(luatex_command, "quitloop", input_cmd, quit_loop_code, 0);
+
+ tex_primitive(tex_command, "insert", insert_cmd, normal_code, 0);
+
+ tex_primitive(luatex_command, "luafunctioncall", lua_function_call_cmd, lua_function_call_code, 0);
+ tex_primitive(luatex_command, "luabytecodecall", lua_function_call_cmd, lua_bytecode_call_code, 0);
+
+ tex_primitive(tex_command, "mark", set_mark_cmd, set_mark_code, 0);
+ tex_primitive(etex_command, "marks", set_mark_cmd, set_marks_code, 0);
+ tex_primitive(luatex_command, "clearmarks", set_mark_cmd, clear_marks_code, 0);
+ tex_primitive(luatex_command, "flushmarks", set_mark_cmd, flush_marks_code, 0);
+
+ tex_primitive(tex_command, "mathaccent", math_accent_cmd, math_accent_code, 0);
+ tex_primitive(luatex_command, "Umathaccent", math_accent_cmd, math_uaccent_code, 0);
+
+ tex_primitive(tex_command, "mathchar", math_char_number_cmd, math_char_number_code, 0);
+ tex_primitive(luatex_command, "Umathchar", math_char_number_cmd, math_xchar_number_code, 0);
+ tex_primitive(luatex_command, "Umathdict", math_char_number_cmd, math_dchar_number_code, 0);
+ /* tex_primitive(luatex_command, "Umathcharnum", math_char_number_cmd, math_uchar_number_code, 0); */
+ tex_primitive(luatex_command, "Umathclass", math_char_number_cmd, math_class_number_code, 0);
+
+ tex_primitive(tex_command, "mathchoice", math_choice_cmd, math_choice_code, 0);
+ tex_primitive(luatex_command, "Umathdiscretionary", math_choice_cmd, math_discretionary_code, 0);
+ tex_primitive(luatex_command, "Ustack", math_choice_cmd, math_ustack_code, 0);
+
+ tex_primitive(tex_command, "noexpand", no_expand_cmd, normal_code, 0);
+
+ /* tex_primitive(tex_command, "par", end_paragraph_cmd, too_big_char, too_big_char); */ /* See later. */
+
+ tex_primitive(tex_command, "radical", math_radical_cmd, normal_radical_subtype, 0);
+ tex_primitive(luatex_command, "Uradical", math_radical_cmd, radical_radical_subtype, 0);
+ tex_primitive(luatex_command, "Uroot", math_radical_cmd, root_radical_subtype, 0);
+ tex_primitive(luatex_command, "Urooted", math_radical_cmd, rooted_radical_subtype, 0);
+ tex_primitive(luatex_command, "Uunderdelimiter", math_radical_cmd, under_delimiter_radical_subtype, 0);
+ tex_primitive(luatex_command, "Uoverdelimiter", math_radical_cmd, over_delimiter_radical_subtype, 0);
+ tex_primitive(luatex_command, "Udelimiterunder", math_radical_cmd, delimiter_under_radical_subtype, 0);
+ tex_primitive(luatex_command, "Udelimiterover", math_radical_cmd, delimiter_over_radical_subtype, 0);
+ tex_primitive(luatex_command, "Udelimited", math_radical_cmd, delimited_radical_subtype, 0);
+ tex_primitive(luatex_command, "Uhextensible", math_radical_cmd, h_extensible_radical_subtype, 0);
+
+ /* TEX_primitive(tex_command, "relax", relax_cmd, too_big_char, too_big_char); */ /* See later. */
+
+ tex_primitive(tex_command, "setbox", set_box_cmd, normal_code, 0);
+
+ /*tex
+ Instead of |set_(e)tex_shape_cmd| we use |set_specification_cmd| because since \ETEX\
+ it no longer relates to par shapes only. ALso, because there are nodes involved, that
+ themselves have a different implementation, it is less confusing.
+ */
+
+ tex_primitive(tex_command, "parshape", set_specification_cmd, par_shape_code, internal_specification_base);
+ tex_primitive(etex_command, "interlinepenalties", set_specification_cmd, inter_line_penalties_code, internal_specification_base);
+ tex_primitive(etex_command, "clubpenalties", set_specification_cmd, club_penalties_code, internal_specification_base);
+ tex_primitive(etex_command, "widowpenalties", set_specification_cmd, widow_penalties_code, internal_specification_base);
+ tex_primitive(etex_command, "displaywidowpenalties", set_specification_cmd, display_widow_penalties_code, internal_specification_base);
+ tex_primitive(luatex_command, "orphanpenalties", set_specification_cmd, orphan_penalties_code, internal_specification_base);
+ tex_primitive(luatex_command, "mathforwardpenalties", set_specification_cmd, math_forward_penalties_code, internal_specification_base);
+ tex_primitive(luatex_command, "mathbackwardpenalties", set_specification_cmd, math_backward_penalties_code, internal_specification_base);
+
+ tex_primitive(tex_command, "the", the_cmd, the_code, 0);
+ tex_primitive(luatex_command, "thewithoutunit", the_cmd, the_without_unit_code, 0);
+ /* tex_primitive(luatex_command, "thewithproperty", the_cmd, the_with_property_code, 0); */ /* replaced by value functions */
+ tex_primitive(etex_command, "unexpanded", the_cmd, unexpanded_code, 0); /* maybe convert_cmd */
+ tex_primitive(etex_command, "detokenize", the_cmd, detokenize_code, 0); /* maybe convert_cmd */
+
+ tex_primitive(tex_command, "botmark", get_mark_cmd, bot_mark_code, 0); /* \botmarks 0 */
+ tex_primitive(tex_command, "firstmark", get_mark_cmd, first_mark_code, 0); /* \firstmarks 0 */
+ tex_primitive(tex_command, "splitbotmark", get_mark_cmd, split_bot_mark_code, 0); /* \splitbotmarks 0 */
+ tex_primitive(tex_command, "splitfirstmark", get_mark_cmd, split_first_mark_code, 0); /* \splitfirstmarks 0 */
+ tex_primitive(tex_command, "topmark", get_mark_cmd, top_mark_code, 0); /* \topmarks 0 */
+ tex_primitive(etex_command, "botmarks", get_mark_cmd, bot_marks_code, 0);
+ tex_primitive(etex_command, "firstmarks", get_mark_cmd, first_marks_code, 0);
+ tex_primitive(etex_command, "splitbotmarks", get_mark_cmd, split_bot_marks_code, 0);
+ tex_primitive(etex_command, "splitfirstmarks", get_mark_cmd, split_first_marks_code, 0);
+ tex_primitive(etex_command, "topmarks", get_mark_cmd, top_marks_code, 0);
+ tex_primitive(luatex_command, "currentmarks", get_mark_cmd, current_marks_code, 0);
+
+ tex_primitive(tex_command, "vadjust", vadjust_cmd, normal_code, 0);
+
+ tex_primitive(tex_command, "halign", halign_cmd, normal_code, 0);
+ tex_primitive(tex_command, "valign", valign_cmd, normal_code, 0);
+
+ tex_primitive(tex_command, "vcenter", vcenter_cmd, normal_code, 0);
+
+ /* todo rule codes of nodes, so empty will move */
+
+ tex_primitive(tex_command, "vrule", vrule_cmd, normal_rule_code, 0);
+ tex_primitive(luatex_command, "novrule", vrule_cmd, empty_rule_code, 0);
+ tex_primitive(luatex_command, "srule", vrule_cmd, strut_rule_code, 0);
+
+ tex_primitive(tex_command, "hrule", hrule_cmd, normal_rule_code, 0);
+ tex_primitive(luatex_command, "nohrule", hrule_cmd, empty_rule_code, 0);
+
+ tex_primitive(tex_command, "count", register_cmd, int_val_level, 0);
+ tex_primitive(luatex_command, "attribute", register_cmd, attr_val_level, 0);
+ tex_primitive(tex_command, "dimen", register_cmd, dimen_val_level, 0);
+ tex_primitive(tex_command, "skip", register_cmd, glue_val_level, 0);
+ tex_primitive(tex_command, "muskip", register_cmd, mu_val_level, 0);
+ tex_primitive(tex_command, "toks", register_cmd, tok_val_level, 0);
+
+ tex_primitive(tex_command, "spacefactor", set_auxiliary_cmd, space_factor_code, 0);
+ tex_primitive(tex_command, "prevdepth", set_auxiliary_cmd, prev_depth_code, 0);
+ tex_primitive(tex_command, "prevgraf", set_auxiliary_cmd, prev_graf_code, 0);
+ tex_primitive(etex_command, "interactionmode", set_auxiliary_cmd, interaction_mode_code, 0);
+ tex_primitive(luatex_command, "insertmode", set_auxiliary_cmd, insert_mode_code, 0);
+
+ tex_primitive(tex_command, "pagegoal", set_page_property_cmd, page_goal_code, 0);
+ tex_primitive(tex_command, "pagetotal", set_page_property_cmd, page_total_code, 0);
+ tex_primitive(tex_command, "pagestretch", set_page_property_cmd, page_stretch_code, 0);
+ tex_primitive(tex_command, "pagefilstretch", set_page_property_cmd, page_filstretch_code, 0);
+ tex_primitive(tex_command, "pagefillstretch", set_page_property_cmd, page_fillstretch_code, 0);
+ tex_primitive(tex_command, "pagefilllstretch", set_page_property_cmd, page_filllstretch_code, 0);
+ tex_primitive(tex_command, "pageshrink", set_page_property_cmd, page_shrink_code, 0);
+ tex_primitive(tex_command, "pagedepth", set_page_property_cmd, page_depth_code, 0);
+ tex_primitive(luatex_command, "pagevsize", set_page_property_cmd, page_vsize_code, 0);
+
+ tex_primitive(tex_command, "deadcycles", set_page_property_cmd, dead_cycles_code, 0);
+
+ tex_primitive(tex_command, "insertpenalties", set_page_property_cmd, insert_penalties_code, 0);
+ tex_primitive(luatex_command, "insertheights", set_page_property_cmd, insert_heights_code, 0);
+ tex_primitive(luatex_command, "insertstoring", set_page_property_cmd, insert_storing_code, 0);
+
+ tex_primitive(luatex_command, "insertdistance", set_page_property_cmd, insert_distance_code, 0);
+ tex_primitive(luatex_command, "insertmultiplier", set_page_property_cmd, insert_multiplier_code, 0);
+ tex_primitive(luatex_command, "insertlimit", set_page_property_cmd, insert_limit_code, 0);
+ tex_primitive(luatex_command, "insertstorage", set_page_property_cmd, insert_storage_code, 0);
+ tex_primitive(luatex_command, "insertpenalty", set_page_property_cmd, insert_penalty_code, 0);
+ tex_primitive(luatex_command, "insertmaxdepth", set_page_property_cmd, insert_maxdepth_code, 0);
+ tex_primitive(luatex_command, "insertheight", set_page_property_cmd, insert_height_code, 0);
+ tex_primitive(luatex_command, "insertdepth", set_page_property_cmd, insert_depth_code, 0);
+ tex_primitive(luatex_command, "insertwidth", set_page_property_cmd, insert_width_code, 0);
+
+ tex_primitive(tex_command, "wd", set_box_property_cmd, box_width_code, 0);
+ tex_primitive(tex_command, "ht", set_box_property_cmd, box_height_code, 0);
+ tex_primitive(tex_command, "dp", set_box_property_cmd, box_depth_code, 0);
+ tex_primitive(luatex_command, "boxdirection", set_box_property_cmd, box_direction_code, 0);
+ tex_primitive(luatex_command, "boxgeometry", set_box_property_cmd, box_geometry_code, 0);
+ tex_primitive(luatex_command, "boxorientation", set_box_property_cmd, box_orientation_code, 0);
+ tex_primitive(luatex_command, "boxanchor", set_box_property_cmd, box_anchor_code, 0);
+ tex_primitive(luatex_command, "boxanchors", set_box_property_cmd, box_anchors_code, 0);
+ tex_primitive(luatex_command, "boxsource", set_box_property_cmd, box_source_code, 0);
+ tex_primitive(luatex_command, "boxtarget", set_box_property_cmd, box_target_code, 0);
+ tex_primitive(luatex_command, "boxxoffset", set_box_property_cmd, box_xoffset_code, 0);
+ tex_primitive(luatex_command, "boxyoffset", set_box_property_cmd, box_yoffset_code, 0);
+ tex_primitive(luatex_command, "boxxmove", set_box_property_cmd, box_xmove_code, 0);
+ tex_primitive(luatex_command, "boxymove", set_box_property_cmd, box_ymove_code, 0);
+ tex_primitive(luatex_command, "boxtotal", set_box_property_cmd, box_total_code, 0);
+ tex_primitive(luatex_command, "boxshift", set_box_property_cmd, box_shift_code, 0);
+ tex_primitive(luatex_command, "boxadapt", set_box_property_cmd, box_adapt_code, 0);
+ tex_primitive(luatex_command, "boxrepack", set_box_property_cmd, box_repack_code, 0);
+ tex_primitive(luatex_command, "boxfreeze", set_box_property_cmd, box_freeze_code, 0);
+ tex_primitive(luatex_command, "boxattribute", set_box_property_cmd, box_attribute_code, 0);
+
+ tex_primitive(tex_command, "lastpenalty", some_item_cmd, lastpenalty_code, 0);
+ tex_primitive(tex_command, "lastkern", some_item_cmd, lastkern_code, 0);
+ tex_primitive(tex_command, "lastskip", some_item_cmd, lastskip_code, 0);
+ tex_primitive(luatex_command, "lastboundary", some_item_cmd, lastboundary_code, 0);
+ tex_primitive(etex_command, "lastnodetype", some_item_cmd, last_node_type_code, 0);
+ tex_primitive(luatex_command, "lastnodesubtype", some_item_cmd, last_node_subtype_code, 0);
+ tex_primitive(tex_command, "inputlineno", some_item_cmd, input_line_no_code, 0);
+ tex_primitive(tex_command, "badness", some_item_cmd, badness_code, 0);
+ tex_primitive(luatex_command, "overshoot", some_item_cmd, overshoot_code, 0);
+ tex_primitive(luatex_command, "luatexversion", some_item_cmd, luatex_version_code, 0);
+ tex_primitive(luatex_command, "luatexrevision", some_item_cmd, luatex_revision_code, 0);
+ tex_primitive(etex_command, "currentgrouplevel", some_item_cmd, current_group_level_code, 0);
+ tex_primitive(etex_command, "currentgrouptype", some_item_cmd, current_group_type_code, 0);
+ tex_primitive(etex_command, "currentiflevel", some_item_cmd, current_if_level_code, 0);
+ tex_primitive(etex_command, "currentiftype", some_item_cmd, current_if_type_code, 0);
+ tex_primitive(etex_command, "currentifbranch", some_item_cmd, current_if_branch_code, 0);
+ tex_primitive(etex_command, "gluestretchorder", some_item_cmd, glue_stretch_order_code, 0);
+ tex_primitive(etex_command, "glueshrinkorder", some_item_cmd, glue_shrink_order_code, 0);
+ tex_primitive(luatex_command, "fontid", some_item_cmd, font_id_code, 0);
+ tex_primitive(luatex_command, "glyphxscaled", some_item_cmd, glyph_x_scaled_code, 0);
+ tex_primitive(luatex_command, "glyphyscaled", some_item_cmd, glyph_y_scaled_code, 0);
+ tex_primitive(etex_command, "fontcharwd", some_item_cmd, font_char_wd_code, 0);
+ tex_primitive(etex_command, "fontcharht", some_item_cmd, font_char_ht_code, 0);
+ tex_primitive(etex_command, "fontchardp", some_item_cmd, font_char_dp_code, 0);
+ tex_primitive(etex_command, "fontcharic", some_item_cmd, font_char_ic_code, 0);
+ tex_primitive(luatex_command, "fontcharta", some_item_cmd, font_char_ta_code, 0);
+ tex_primitive(luatex_command, "fontspecid", some_item_cmd, font_spec_id_code, 0);
+ tex_primitive(luatex_command, "fontspecscale", some_item_cmd, font_spec_scale_code, 0);
+ tex_primitive(luatex_command, "fontspecxscale", some_item_cmd, font_spec_xscale_code, 0);
+ tex_primitive(luatex_command, "fontspecyscale", some_item_cmd, font_spec_yscale_code, 0);
+ tex_primitive(luatex_command, "fontspecifiedsize", some_item_cmd, font_size_code, 0);
+ tex_primitive(luatex_command, "fontmathcontrol", some_item_cmd, font_math_control_code, 0);
+ tex_primitive(luatex_command, "fonttextcontrol", some_item_cmd, font_text_control_code, 0);
+ tex_primitive(luatex_command, "mathscale", some_item_cmd, math_scale_code, 0);
+ tex_primitive(luatex_command, "mathstyle", some_item_cmd, math_style_code, 0);
+ tex_primitive(luatex_command, "mathmainstyle", some_item_cmd, math_main_style_code, 0);
+ tex_primitive(luatex_command, "mathstylefontid", some_item_cmd, math_style_font_id_code, 0);
+ tex_primitive(luatex_command, "mathstackstyle", some_item_cmd, math_stack_style_code, 0);
+ tex_primitive(luatex_command, "Umathcharclass", some_item_cmd, math_char_class_code, 0);
+ tex_primitive(luatex_command, "Umathcharfam", some_item_cmd, math_char_fam_code, 0);
+ tex_primitive(luatex_command, "Umathcharslot", some_item_cmd, math_char_slot_code, 0);
+ tex_primitive(luatex_command, "lastarguments", some_item_cmd, last_arguments_code, 0);
+ tex_primitive(luatex_command, "parametercount", some_item_cmd, parameter_count_code, 0);
+ /* tex_primitive(luatex_command, "luavaluefunction", some_item_cmd, lua_value_function_code, 0); */
+ tex_primitive(luatex_command, "insertprogress", some_item_cmd, insert_progress_code, 0);
+ tex_primitive(luatex_command, "leftmarginkern", some_item_cmd, left_margin_kern_code, 0);
+ tex_primitive(luatex_command, "rightmarginkern", some_item_cmd, right_margin_kern_code, 0);
+ tex_primitive(etex_command, "parshapelength", some_item_cmd, par_shape_length_code, 0);
+ tex_primitive(etex_command, "parshapeindent", some_item_cmd, par_shape_indent_code, 0);
+ tex_primitive(etex_command, "parshapedimen", some_item_cmd, par_shape_dimen_code, 0);
+ tex_primitive(etex_command, "gluestretch", some_item_cmd, glue_stretch_code, 0);
+ tex_primitive(etex_command, "glueshrink", some_item_cmd, glue_shrink_code, 0);
+ tex_primitive(etex_command, "mutoglue", some_item_cmd, mu_to_glue_code, 0);
+ tex_primitive(etex_command, "gluetomu", some_item_cmd, glue_to_mu_code, 0);
+ tex_primitive(etex_command, "numexpr", some_item_cmd, numexpr_code, 0);
+ tex_primitive(etex_command, "dimexpr", some_item_cmd, dimexpr_code, 0);
+ tex_primitive(etex_command, "glueexpr", some_item_cmd, glueexpr_code, 0);
+ tex_primitive(etex_command, "muexpr", some_item_cmd, muexpr_code, 0);
+ tex_primitive(luatex_command, "numexpression", some_item_cmd, numexpression_code, 0); /* experiment */
+ tex_primitive(luatex_command, "dimexpression", some_item_cmd, dimexpression_code, 0); /* experiment */
+ // tex_primitive(luatex_command, "dimentoscale", some_item_cmd, dimen_to_scale_code, 0);
+ tex_primitive(luatex_command, "lastchknum", some_item_cmd, last_chk_num_code, 0);
+ tex_primitive(luatex_command, "lastchkdim", some_item_cmd, last_chk_dim_code, 0);
+ tex_primitive(luatex_command, "numericscale", some_item_cmd, numeric_scale_code, 0);
+ tex_primitive(luatex_command, "indexofregister", some_item_cmd, index_of_register_code, 0);
+ tex_primitive(luatex_command, "indexofcharacter", some_item_cmd, index_of_character_code, 0);
+ tex_primitive(luatex_command, "currentloopiterator", some_item_cmd, current_loop_iterator_code, 0);
+ tex_primitive(luatex_command, "currentloopnesting", some_item_cmd, current_loop_nesting_code, 0);
+ tex_primitive(luatex_command, "lastloopiterator", some_item_cmd, last_loop_iterator_code, 0);
+ tex_primitive(luatex_command, "lastparcontext", some_item_cmd, last_par_context_code, 0);
+ tex_primitive(luatex_command, "lastpageextra", some_item_cmd, last_page_extra_code, 0);
+ tex_primitive(luatex_command, "scaledslantperpoint", some_item_cmd, scaled_slant_per_point_code, 0);
+ tex_primitive(luatex_command, "scaledinterwordspace", some_item_cmd, scaled_interword_space_code, 0);
+ tex_primitive(luatex_command, "scaledinterwordstretch", some_item_cmd, scaled_interword_stretch_code, 0);
+ tex_primitive(luatex_command, "scaledinterwordshrink", some_item_cmd, scaled_interword_shrink_code, 0);
+ tex_primitive(luatex_command, "scaledexheight", some_item_cmd, scaled_ex_height_code, 0);
+ tex_primitive(luatex_command, "scaledemwidth", some_item_cmd, scaled_em_width_code, 0);
+ tex_primitive(luatex_command, "scaledextraspace", some_item_cmd, scaled_extra_space_code, 0);
+ tex_primitive(luatex_command, "mathatomglue", some_item_cmd, math_atom_glue_code, 0);
+ tex_primitive(luatex_command, "lastleftclass", some_item_cmd, last_left_class_code, 0);
+ tex_primitive(luatex_command, "lastrightclass", some_item_cmd, last_right_class_code, 0);
+ tex_primitive(luatex_command, "lastatomclass", some_item_cmd, last_atom_class_code, 0);
+
+ tex_primitive(tex_command, "fontname", convert_cmd, font_name_code, 0);
+ tex_primitive(luatex_command, "fontspecifiedname", convert_cmd, font_specification_code, 0);
+ tex_primitive(tex_command, "jobname", convert_cmd, job_name_code, 0);
+ tex_primitive(tex_command, "meaning", convert_cmd, meaning_code, 0);
+ tex_primitive(luatex_command, "meaningfull", convert_cmd, meaning_full_code, 0);
+ tex_primitive(luatex_command, "meaningless", convert_cmd, meaning_less_code, 0);
+ tex_primitive(luatex_command, "meaningasis", convert_cmd, meaning_asis_code, 0); /* for manuals and articles */
+ /*tex Maybe some day also |meaningonly| (no macro: in front). */
+ tex_primitive(tex_command, "number", convert_cmd, number_code, 0);
+ tex_primitive(luatex_command, "tointeger", convert_cmd, to_integer_code, 0);
+ tex_primitive(luatex_command, "tohexadecimal", convert_cmd, to_hexadecimal_code, 0);
+ tex_primitive(luatex_command, "toscaled", convert_cmd, to_scaled_code, 0);
+ tex_primitive(luatex_command, "tosparsescaled", convert_cmd, to_sparse_scaled_code, 0);
+ tex_primitive(luatex_command, "todimension", convert_cmd, to_dimension_code, 0);
+ tex_primitive(luatex_command, "tosparsedimension", convert_cmd, to_sparse_dimension_code, 0);
+ tex_primitive(luatex_command, "tomathstyle", convert_cmd, to_mathstyle_code, 0);
+ tex_primitive(tex_command, "romannumeral", convert_cmd, roman_numeral_code, 0);
+ tex_primitive(tex_command, "string", convert_cmd, string_code, 0);
+ tex_primitive(luatex_command, "directlua", convert_cmd, lua_code, 0);
+ tex_primitive(luatex_command, "csstring", convert_cmd, cs_string_code, 0);
+ tex_primitive(luatex_command, "detokenized", convert_cmd, detokenized_code, 0);
+ tex_primitive(luatex_command, "expanded", convert_cmd, expanded_code, 0);
+ tex_primitive(luatex_command, "semiexpanded", convert_cmd, semi_expanded_code, 0);
+ tex_primitive(luatex_command, "formatname", convert_cmd, format_name_code, 0);
+ tex_primitive(luatex_command, "luabytecode", convert_cmd, lua_bytecode_code, 0);
+ tex_primitive(luatex_command, "luaescapestring", convert_cmd, lua_escape_string_code, 0);
+ tex_primitive(luatex_command, "luafunction", convert_cmd, lua_function_code, 0);
+ tex_primitive(luatex_command, "luatexbanner", convert_cmd, luatex_banner_code, 0);
+ tex_primitive(luatex_command, "Uchar", convert_cmd, uchar_code, 0);
+
+ /* tex_primitive(tex_command, "fi", if_test_cmd, fi_code, 0); */ /* See later. */
+ tex_primitive(tex_command, "or", if_test_cmd, or_code, 0);
+ tex_primitive(tex_command, "else", if_test_cmd, else_code, 0);
+ tex_primitive(luatex_command, "orelse", if_test_cmd, or_else_code, 0);
+ tex_primitive(luatex_command, "orunless", if_test_cmd, or_unless_code, 0);
+
+ tex_primitive(tex_command, "if", if_test_cmd, if_char_code, 0);
+ tex_primitive(tex_command, "ifcat", if_test_cmd, if_cat_code, 0);
+ tex_primitive(tex_command, "ifnum", if_test_cmd, if_int_code, 0);
+ tex_primitive(tex_command, "ifdim", if_test_cmd, if_dim_code, 0);
+ tex_primitive(tex_command, "ifodd", if_test_cmd, if_odd_code, 0);
+ tex_primitive(tex_command, "ifvmode", if_test_cmd, if_vmode_code, 0);
+ tex_primitive(tex_command, "ifhmode", if_test_cmd, if_hmode_code, 0);
+ tex_primitive(tex_command, "ifmmode", if_test_cmd, if_mmode_code, 0);
+ tex_primitive(tex_command, "ifinner", if_test_cmd, if_inner_code, 0);
+ tex_primitive(tex_command, "ifvoid", if_test_cmd, if_void_code, 0);
+ tex_primitive(tex_command, "ifhbox", if_test_cmd, if_hbox_code, 0);
+ tex_primitive(tex_command, "ifvbox", if_test_cmd, if_vbox_code, 0);
+ tex_primitive(tex_command, "ifx", if_test_cmd, if_x_code, 0);
+ tex_primitive(tex_command, "iftrue", if_test_cmd, if_true_code, 0);
+ tex_primitive(tex_command, "iffalse", if_test_cmd, if_false_code, 0);
+ tex_primitive(tex_command, "ifcase", if_test_cmd, if_case_code, 0);
+ tex_primitive(etex_command, "ifdefined", if_test_cmd, if_def_code, 0);
+ tex_primitive(etex_command, "ifcsname", if_test_cmd, if_cs_code, 0);
+ tex_primitive(etex_command, "iffontchar", if_test_cmd, if_font_char_code, 0);
+ tex_primitive(luatex_command, "ifincsname", if_test_cmd, if_in_csname_code, 0); /* This is obsolete and might be dropped. */
+ tex_primitive(luatex_command, "ifabsnum", if_test_cmd, if_abs_int_code, 0);
+ tex_primitive(luatex_command, "ifabsdim", if_test_cmd, if_abs_dim_code, 0);
+ tex_primitive(luatex_command, "ifchknum", if_test_cmd, if_chk_int_code, 0);
+ tex_primitive(luatex_command, "ifchkdim", if_test_cmd, if_chk_dim_code, 0);
+ tex_primitive(luatex_command, "ifcmpnum", if_test_cmd, if_cmp_int_code, 0);
+ tex_primitive(luatex_command, "ifcmpdim", if_test_cmd, if_cmp_dim_code, 0);
+ tex_primitive(luatex_command, "ifnumval", if_test_cmd, if_val_int_code, 0);
+ tex_primitive(luatex_command, "ifdimval", if_test_cmd, if_val_dim_code, 0);
+ tex_primitive(luatex_command, "iftok", if_test_cmd, if_tok_code, 0);
+ tex_primitive(luatex_command, "ifcstok", if_test_cmd, if_cstok_code, 0);
+ tex_primitive(luatex_command, "ifcondition", if_test_cmd, if_condition_code, 0);
+ tex_primitive(luatex_command, "ifflags", if_test_cmd, if_flags_code, 0);
+ tex_primitive(luatex_command, "ifempty", if_test_cmd, if_empty_cmd_code, 0);
+ tex_primitive(luatex_command, "ifrelax", if_test_cmd, if_relax_cmd_code, 0);
+ tex_primitive(luatex_command, "ifboolean", if_test_cmd, if_boolean_code, 0);
+ tex_primitive(luatex_command, "ifnumexpression", if_test_cmd, if_numexpression_code, 0);
+ tex_primitive(luatex_command, "ifdimexpression", if_test_cmd, if_dimexpression_code, 0);
+ tex_primitive(luatex_command, "ifmathparameter", if_test_cmd, if_math_parameter_code, 0);
+ tex_primitive(luatex_command, "ifmathstyle", if_test_cmd, if_math_style_code, 0);
+ tex_primitive(luatex_command, "ifarguments", if_test_cmd, if_arguments_code, 0);
+ tex_primitive(luatex_command, "ifparameters", if_test_cmd, if_parameters_code, 0);
+ tex_primitive(luatex_command, "ifparameter", if_test_cmd, if_parameter_code, 0);
+ tex_primitive(luatex_command, "ifhastok", if_test_cmd, if_has_tok_code, 0);
+ tex_primitive(luatex_command, "ifhastoks", if_test_cmd, if_has_toks_code, 0);
+ tex_primitive(luatex_command, "ifhasxtoks", if_test_cmd, if_has_xtoks_code, 0);
+ tex_primitive(luatex_command, "ifhaschar", if_test_cmd, if_has_char_code, 0);
+ tex_primitive(luatex_command, "ifinsert", if_test_cmd, if_insert_code, 0);
+ /* tex_primitive(luatex_command, "ifbitwiseand", if_test_cmd, if_bitwise_and_code, 0); */
+
+ tex_primitive(tex_command, "above", math_fraction_cmd, math_above_code, 0);
+ tex_primitive(tex_command, "abovewithdelims", math_fraction_cmd, math_above_delimited_code, 0);
+ tex_primitive(tex_command, "atop", math_fraction_cmd, math_atop_code, 0);
+ tex_primitive(tex_command, "atopwithdelims", math_fraction_cmd, math_atop_delimited_code, 0);
+ tex_primitive(tex_command, "over", math_fraction_cmd, math_over_code, 0);
+ tex_primitive(tex_command, "overwithdelims", math_fraction_cmd, math_over_delimited_code, 0);
+ /* tex_primitive(luatex_command, "skewed", math_fraction_cmd, math_skewed_code, 0); */ /* makes no sense */
+ /* tex_primitive(luatex_command, "skewedwithdelims", math_fraction_cmd, math_skewed_delimited_code, 0); */ /* makes no sense */
+ /* tex_primitive(luatex_command, "stretched", math_fraction_cmd, math_stretched_code, 0); */ /* makes no sense */
+ /* tex_primitive(luatex_command, "stretchedwithdelims", math_fraction_cmd, math_stretched_delimited_code, 0); */ /* makes no sense */
+
+ tex_primitive(luatex_command, "Uabove", math_fraction_cmd, math_u_above_code, 0);
+ tex_primitive(luatex_command, "Uabovewithdelims", math_fraction_cmd, math_u_above_delimited_code, 0);
+ tex_primitive(luatex_command, "Uatop", math_fraction_cmd, math_u_atop_code, 0);
+ tex_primitive(luatex_command, "Uatopwithdelims", math_fraction_cmd, math_u_atop_delimited_code, 0);
+ tex_primitive(luatex_command, "Uover", math_fraction_cmd, math_u_over_code, 0);
+ tex_primitive(luatex_command, "Uoverwithdelims", math_fraction_cmd, math_u_over_delimited_code, 0);
+ tex_primitive(luatex_command, "Uskewed", math_fraction_cmd, math_u_skewed_code, 0);
+ tex_primitive(luatex_command, "Uskewedwithdelims", math_fraction_cmd, math_u_skewed_delimited_code, 0);
+ tex_primitive(luatex_command, "Ustretched", math_fraction_cmd, math_u_stretched_code, 0);
+ tex_primitive(luatex_command, "Ustretchedwithdelims", math_fraction_cmd, math_u_stretched_delimited_code, 0);
+
+ tex_primitive(tex_command, "hyphenchar", set_font_property_cmd, font_hyphen_code, 0);
+ tex_primitive(tex_command, "skewchar", set_font_property_cmd, font_skew_code, 0);
+ tex_primitive(luatex_command, "efcode", set_font_property_cmd, font_ef_code, 0);
+ tex_primitive(luatex_command, "lpcode", set_font_property_cmd, font_lp_code, 0);
+ tex_primitive(luatex_command, "rpcode", set_font_property_cmd, font_rp_code, 0);
+ tex_primitive(tex_command, "fontdimen", set_font_property_cmd, font_dimen_code, 0);
+ tex_primitive(luatex_command, "scaledfontdimen", set_font_property_cmd, scaled_font_dimen_code, 0);
+
+ tex_primitive(tex_command, "lowercase", case_shift_cmd, lower_case_code, 0);
+ tex_primitive(tex_command, "uppercase", case_shift_cmd, upper_case_code, 0);
+
+ tex_primitive(tex_command, "catcode", define_char_code_cmd, catcode_charcode, 0);
+ tex_primitive(tex_command, "lccode", define_char_code_cmd, lccode_charcode, 0);
+ tex_primitive(tex_command, "uccode", define_char_code_cmd, uccode_charcode, 0);
+ tex_primitive(tex_command, "sfcode", define_char_code_cmd, sfcode_charcode, 0);
+ tex_primitive(luatex_command, "hccode", define_char_code_cmd, hccode_charcode, 0);
+ tex_primitive(luatex_command, "hmcode", define_char_code_cmd, hmcode_charcode, 0);
+ tex_primitive(tex_command, "mathcode", define_char_code_cmd, mathcode_charcode, 0);
+ tex_primitive(tex_command, "delcode", define_char_code_cmd, delcode_charcode, 0);
+
+ tex_primitive(luatex_command, "Umathcode", define_char_code_cmd, extmathcode_charcode, 0);
+ /* tex_primitive(luatex_command, "Umathcodenum", define_char_code_cmd, extmathcodenum_charcode, 0); */
+ tex_primitive(luatex_command, "Udelcode", define_char_code_cmd, extdelcode_charcode, 0);
+ /* tex_primitive(luatex_command, "Udelcodenum", define_char_code_cmd, extdelcodenum_charcode, 0); */
+
+ tex_primitive(tex_command, "edef", def_cmd, expanded_def_code, 0);
+ tex_primitive(tex_command, "def", def_cmd, def_code, 0);
+ tex_primitive(tex_command, "xdef", def_cmd, global_expanded_def_code, 0);
+ tex_primitive(tex_command, "gdef", def_cmd, global_def_code, 0);
+ tex_primitive(luatex_command, "edefcsname", def_cmd, expanded_def_csname_code, 0);
+ tex_primitive(luatex_command, "defcsname", def_cmd, def_csname_code, 0);
+ tex_primitive(luatex_command, "xdefcsname", def_cmd, global_expanded_def_csname_code, 0);
+ tex_primitive(luatex_command, "gdefcsname", def_cmd, global_def_csname_code, 0);
+
+ tex_primitive(tex_command, "scriptfont", define_family_cmd, script_size, 0);
+ tex_primitive(tex_command, "scriptscriptfont", define_family_cmd, script_script_size, 0);
+ tex_primitive(tex_command, "textfont", define_family_cmd, text_size, 0);
+
+ tex_primitive(tex_command, "discretionary", discretionary_cmd, normal_discretionary_code, 0);
+ tex_primitive(tex_command, "-", discretionary_cmd, explicit_discretionary_code, 0);
+ tex_primitive(luatex_command, "explicitdiscretionary", discretionary_cmd, explicit_discretionary_code, 0);
+ tex_primitive(luatex_command, "automaticdiscretionary", discretionary_cmd, automatic_discretionary_code, 0);
+
+ tex_primitive(tex_command, "leqno", equation_number_cmd, left_location_code, 0);
+ tex_primitive(tex_command, "eqno", equation_number_cmd, right_location_code, 0);
+
+ tex_primitive(tex_command, "moveright", hmove_cmd, move_forward_code, 0);
+ tex_primitive(tex_command, "moveleft", hmove_cmd, move_backward_code, 0);
+
+ tex_primitive(tex_command, "hfil", hskip_cmd, fil_code, 0);
+ tex_primitive(tex_command, "hfill", hskip_cmd, fill_code, 0);
+ tex_primitive(tex_command, "hss", hskip_cmd, filll_code, 0);
+ tex_primitive(tex_command, "hfilneg", hskip_cmd, fil_neg_code, 0);
+ tex_primitive(tex_command, "hskip", hskip_cmd, skip_code, 0);
+
+ tex_primitive(tex_command, "hyphenation", hyphenation_cmd, hyphenation_code, 0);
+ tex_primitive(tex_command, "patterns", hyphenation_cmd, patterns_code, 0);
+ tex_primitive(luatex_command, "prehyphenchar", hyphenation_cmd, prehyphenchar_code, 0);
+ tex_primitive(luatex_command, "posthyphenchar", hyphenation_cmd, posthyphenchar_code, 0);
+ tex_primitive(luatex_command, "preexhyphenchar", hyphenation_cmd, preexhyphenchar_code, 0);
+ tex_primitive(luatex_command, "postexhyphenchar", hyphenation_cmd, postexhyphenchar_code, 0);
+ tex_primitive(luatex_command, "hyphenationmin", hyphenation_cmd, hyphenationmin_code, 0);
+ tex_primitive(luatex_command, "hjcode", hyphenation_cmd, hjcode_code, 0);
+
+ tex_primitive(tex_command, "kern", kern_cmd, normal_kern_code, 0);
+ /* tex_primitive(tex_command, "hkern", kern_cmd, h_kern_code, 0); */
+ /* tex_primitive(tex_command, "vkern", kern_cmd, v_kern_code, 0); */
+ /* tex_primitive(tex_command, "nonzerowidthkern", kern_cmd, non_zero_width_kern_code, 0); */ /* maybe */
+
+ tex_primitive(luatex_command, "localleftbox", local_box_cmd, local_left_box_code, 0);
+ tex_primitive(luatex_command, "localrightbox", local_box_cmd, local_right_box_code, 0);
+ tex_primitive(luatex_command, "localmiddlebox", local_box_cmd, local_middle_box_code, 0);
+
+ tex_primitive(tex_command, "shipout", legacy_cmd, shipout_code, 0);
+
+ tex_primitive(tex_command, "leaders", leader_cmd, a_leaders_code, 0);
+ tex_primitive(tex_command, "cleaders", leader_cmd, c_leaders_code, 0);
+ tex_primitive(tex_command, "xleaders", leader_cmd, x_leaders_code, 0);
+ tex_primitive(luatex_command, "gleaders", leader_cmd, g_leaders_code, 0);
+ tex_primitive(luatex_command, "uleaders", leader_cmd, u_leaders_code, 0);
+
+ tex_primitive(tex_command, "left", math_fence_cmd, left_fence_side, 0);
+ tex_primitive(tex_command, "middle", math_fence_cmd, middle_fence_side, 0);
+ tex_primitive(tex_command, "right", math_fence_cmd, right_fence_side, 0);
+ tex_primitive(luatex_command, "Uvextensible", math_fence_cmd, no_fence_side, 0);
+ tex_primitive(luatex_command, "Uleft", math_fence_cmd, extended_left_fence_side, 0);
+ tex_primitive(luatex_command, "Umiddle", math_fence_cmd, extended_middle_fence_side, 0);
+ tex_primitive(luatex_command, "Uright", math_fence_cmd, extended_right_fence_side, 0);
+ tex_primitive(luatex_command, "Uoperator", math_fence_cmd, left_operator_side, 0);
+
+ tex_primitive(luatex_command, "glet", let_cmd, global_let_code, 0);
+ tex_primitive(tex_command, "let", let_cmd, let_code, 0);
+ tex_primitive(tex_command, "futurelet", let_cmd, future_let_code, 0);
+ tex_primitive(luatex_command, "futuredef", let_cmd, future_def_code, 0);
+ tex_primitive(luatex_command, "letcharcode", let_cmd, let_charcode_code, 0);
+ tex_primitive(luatex_command, "swapcsvalues", let_cmd, swap_cs_values_code, 0);
+ tex_primitive(luatex_command, "letprotected", let_cmd, let_protected_code, 0);
+ tex_primitive(luatex_command, "unletprotected", let_cmd, unlet_protected_code, 0);
+ tex_primitive(luatex_command, "letfrozen", let_cmd, let_frozen_code, 0);
+ tex_primitive(luatex_command, "unletfrozen", let_cmd, unlet_frozen_code, 0);
+ tex_primitive(luatex_command, "letcsname", let_cmd, let_csname_code, 0);
+ tex_primitive(luatex_command, "gletcsname", let_cmd, global_let_csname_code, 0);
+ tex_primitive(luatex_command, "lettonothing", let_cmd, let_to_nothing_code, 0); /* more a def but a let is nicer */
+ tex_primitive(luatex_command, "glettonothing", let_cmd, global_let_to_nothing_code, 0); /* more a def but a let is nicer */
+
+ tex_primitive(tex_command, "displaylimits", math_modifier_cmd, display_limits_modifier_code, 0); /*tex so |math_limits_cmd| became |math_modifier_cmd| */
+ tex_primitive(tex_command, "limits", math_modifier_cmd, limits_modifier_code, 0);
+ tex_primitive(tex_command, "nolimits", math_modifier_cmd, no_limits_modifier_code, 0);
+
+ /* beware, Umathaxis is overloaded ... maybe only a generic modifier with keywords */
+
+ tex_primitive(luatex_command, "Umathadapttoleft", math_modifier_cmd, adapt_to_left_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathadapttoright", math_modifier_cmd, adapt_to_right_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathuseaxis", math_modifier_cmd, axis_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathnoaxis", math_modifier_cmd, no_axis_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathphantom", math_modifier_cmd, phantom_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathvoid", math_modifier_cmd, void_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathsource", math_modifier_cmd, source_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathopenupheight", math_modifier_cmd, openup_height_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathopenupdepth", math_modifier_cmd, openup_depth_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathlimits", math_modifier_cmd, limits_modifier_code, 0);
+ tex_primitive(luatex_command, "Umathnolimits", math_modifier_cmd, no_limits_modifier_code, 0);
+
+ tex_primitive(tex_command, "box", make_box_cmd, box_code, 0);
+ tex_primitive(tex_command, "copy", make_box_cmd, copy_code, 0);
+ tex_primitive(tex_command, "lastbox", make_box_cmd, last_box_code, 0);
+ tex_primitive(tex_command, "vsplit", make_box_cmd, vsplit_code, 0);
+ tex_primitive(luatex_command, "tpack", make_box_cmd, tpack_code, 0);
+ tex_primitive(luatex_command, "vpack", make_box_cmd, vpack_code, 0);
+ tex_primitive(luatex_command, "hpack", make_box_cmd, hpack_code, 0);
+ tex_primitive(tex_command, "vtop", make_box_cmd, vtop_code, 0);
+ tex_primitive(tex_command, "vbox", make_box_cmd, vbox_code, 0);
+ tex_primitive(tex_command, "hbox", make_box_cmd, hbox_code, 0);
+ tex_primitive(luatex_command, "insertbox", make_box_cmd, insert_box_code, 0);
+ tex_primitive(luatex_command, "insertcopy", make_box_cmd, insert_copy_code, 0);
+ tex_primitive(luatex_command, "localleftboxbox", make_box_cmd, local_left_box_box_code, 0);
+ tex_primitive(luatex_command, "localrightboxbox", make_box_cmd, local_right_box_box_code, 0);
+ tex_primitive(luatex_command, "localmiddleboxbox", make_box_cmd, local_middle_box_box_code, 0);
+
+ tex_primitive(tex_command, "mathord", math_component_cmd, math_component_ordinary_code, 0);
+ tex_primitive(tex_command, "mathop", math_component_cmd, math_component_operator_code, 0);
+ tex_primitive(tex_command, "mathbin", math_component_cmd, math_component_binary_code, 0);
+ tex_primitive(tex_command, "mathrel", math_component_cmd, math_component_relation_code, 0);
+ tex_primitive(tex_command, "mathopen", math_component_cmd, math_component_open_code, 0);
+ tex_primitive(tex_command, "mathclose", math_component_cmd, math_component_close_code, 0);
+ tex_primitive(tex_command, "mathpunct", math_component_cmd, math_component_punctuation_code, 0);
+ tex_primitive(tex_command, "mathinner", math_component_cmd, math_component_inner_code, 0);
+ tex_primitive(luatex_command, "mathfrac", math_component_cmd, math_component_fraction_code, 0);
+ tex_primitive(luatex_command, "mathrad", math_component_cmd, math_component_radical_code, 0);
+ tex_primitive(luatex_command, "mathmiddle", math_component_cmd, math_component_middle_code, 0);
+ tex_primitive(luatex_command, "mathaccent", math_component_cmd, math_component_accent_code, 0);
+ tex_primitive(luatex_command, "mathfenced", math_component_cmd, math_component_fenced_code, 0);
+ tex_primitive(tex_command, "underline", math_component_cmd, math_component_under_code, 0);
+ tex_primitive(tex_command, "overline", math_component_cmd, math_component_over_code, 0);
+ tex_primitive(luatex_command, "mathghost", math_component_cmd, math_component_ghost_code, 0);
+ tex_primitive(luatex_command, "mathatom", math_component_cmd, math_component_atom_code, 0);
+
+ tex_primitive(luatex_command, "Ustartmath", math_shift_cs_cmd, begin_inline_math_code, 0);
+ tex_primitive(luatex_command, "Ustopmath", math_shift_cs_cmd, end_inline_math_code, 0);
+ tex_primitive(luatex_command, "Ustartdisplaymath", math_shift_cs_cmd, begin_display_math_code, 0);
+ tex_primitive(luatex_command, "Ustopdisplaymath", math_shift_cs_cmd, end_display_math_code, 0);
+ tex_primitive(luatex_command, "Ustartmathmode", math_shift_cs_cmd, begin_math_mode_code, 0);
+ tex_primitive(luatex_command, "Ustopmathmode", math_shift_cs_cmd, end_math_mode_code, 0);
+
+ tex_primitive(tex_command, "displaystyle", math_style_cmd, display_style, 0);
+ tex_primitive(tex_command, "textstyle", math_style_cmd, text_style, 0);
+ tex_primitive(tex_command, "scriptstyle", math_style_cmd, script_style, 0);
+ tex_primitive(tex_command, "scriptscriptstyle", math_style_cmd, script_script_style, 0);
+ tex_primitive(luatex_command, "crampeddisplaystyle", math_style_cmd, cramped_display_style, 0);
+ tex_primitive(luatex_command, "crampedtextstyle", math_style_cmd, cramped_text_style, 0);
+ tex_primitive(luatex_command, "crampedscriptstyle", math_style_cmd, cramped_script_style, 0);
+ tex_primitive(luatex_command, "crampedscriptscriptstyle", math_style_cmd, cramped_script_script_style, 0);
+ tex_primitive(luatex_command, "Ustyle", math_style_cmd, yet_unset_math_style, 0);
+ tex_primitive(luatex_command, "scaledmathstyle", math_style_cmd, scaled_math_style, 0);
+ tex_primitive(luatex_command, "alldisplaystyles", math_style_cmd, all_display_styles, 0);
+ tex_primitive(luatex_command, "alltextstyles", math_style_cmd, all_text_styles, 0);
+ tex_primitive(luatex_command, "allscriptstyles", math_style_cmd, all_script_styles, 0);
+ tex_primitive(luatex_command, "allscriptscriptstyles", math_style_cmd, all_script_script_styles, 0);
+ tex_primitive(luatex_command, "allmathstyles", math_style_cmd, all_math_styles, 0);
+ tex_primitive(luatex_command, "allsplitstyles", math_style_cmd, all_split_styles, 0);
+ tex_primitive(luatex_command, "alluncrampedstyles", math_style_cmd, all_uncramped_styles, 0);
+ tex_primitive(luatex_command, "allcrampedstyles", math_style_cmd, all_cramped_styles, 0);
+
+ tex_primitive(tex_command, "message", message_cmd, message_code, 0);
+ tex_primitive(tex_command, "errmessage", message_cmd, error_message_code, 0);
+
+ tex_primitive(tex_command, "mkern", mkern_cmd, normal_code, 0);
+
+ tex_primitive(tex_command, "mskip", mskip_cmd, normal_mskip_code, 0);
+ tex_primitive(luatex_command, "mathatomskip", mskip_cmd, atom_mskip_code, 0);
+
+ /*tex
+ We keep |\long| and |\outer| as dummies, while |\protected| is promoted to a real cmd
+ and |\frozen| can provide a mild form of protection against overloads. We still intercept
+ the commands.
+ */
+
+ tex_primitive(luatex_command, "frozen", prefix_cmd, frozen_code, 0);
+ tex_primitive(luatex_command, "permanent", prefix_cmd, permanent_code, 0);
+ tex_primitive(luatex_command, "immutable", prefix_cmd, immutable_code, 0);
+ tex_primitive(luatex_command, "mutable", prefix_cmd, mutable_code, 0);
+ /* tex_primitive(luatex_command, "primitive", prefix_cmd, primitive_code, 0); */
+ tex_primitive(luatex_command, "noaligned", prefix_cmd, noaligned_code, 0);
+ tex_primitive(luatex_command, "instance", prefix_cmd, instance_code, 0);
+ tex_primitive(luatex_command, "untraced", prefix_cmd, untraced_code, 0);
+ tex_primitive(tex_command, "global", prefix_cmd, global_code, 0);
+ tex_primitive(luatex_command, "tolerant", prefix_cmd, tolerant_code, 0);
+ tex_primitive(etex_command, "protected", prefix_cmd, protected_code, 0);
+ tex_primitive(luatex_command, "overloaded", prefix_cmd, overloaded_code, 0);
+ tex_primitive(luatex_command, "aliased", prefix_cmd, aliased_code, 0);
+ tex_primitive(luatex_command, "immediate", prefix_cmd, immediate_code, 0);
+ tex_primitive(luatex_command, "semiprotected", prefix_cmd, semiprotected_code, 0);
+ tex_primitive(luatex_command, "enforced", prefix_cmd, enforced_code, 0);
+ tex_primitive(luatex_command, "inherited", prefix_cmd, inherited_code, 0);
+
+ tex_primitive(tex_command, "long", prefix_cmd, long_code, 0);
+ tex_primitive(tex_command, "outer", prefix_cmd, outer_code, 0);
+
+ tex_primitive(tex_command, "unkern", remove_item_cmd, kern_item_code, 0);
+ tex_primitive(tex_command, "unpenalty", remove_item_cmd, penalty_item_code, 0);
+ tex_primitive(tex_command, "unskip", remove_item_cmd, skip_item_code, 0);
+ tex_primitive(tex_command, "unboundary", remove_item_cmd, boundary_item_code, 0);
+
+ tex_primitive(tex_command, "batchmode", set_interaction_cmd, batch_mode, 0);
+ tex_primitive(tex_command, "errorstopmode", set_interaction_cmd, error_stop_mode, 0);
+ tex_primitive(tex_command, "nonstopmode", set_interaction_cmd, nonstop_mode, 0);
+ tex_primitive(tex_command, "scrollmode", set_interaction_cmd, scroll_mode, 0);
+
+ tex_primitive(tex_command, "chardef", shorthand_def_cmd, char_def_code, 0);
+ tex_primitive(tex_command, "countdef", shorthand_def_cmd, count_def_code, 0);
+ tex_primitive(tex_command, "dimendef", shorthand_def_cmd, dimen_def_code, 0);
+ tex_primitive(tex_command, "mathchardef", shorthand_def_cmd, math_char_def_code, 0);
+ tex_primitive(tex_command, "muskipdef", shorthand_def_cmd, mu_skip_def_code, 0);
+ tex_primitive(tex_command, "skipdef", shorthand_def_cmd, skip_def_code, 0);
+ tex_primitive(tex_command, "toksdef", shorthand_def_cmd, toks_def_code, 0);
+ /* tex_primitive(tex_command, "stringdef", shorthand_def_cmd, string_def_code, 0); */
+ tex_primitive(luatex_command, "Umathchardef", shorthand_def_cmd, math_xchar_def_code, 0);
+ tex_primitive(luatex_command, "Umathdictdef", shorthand_def_cmd, math_dchar_def_code, 0);
+ /* tex_primitive(luatex_command, "Umathcharnumdef", shorthand_def_cmd, math_uchar_def_code, 0); */
+ tex_primitive(luatex_command, "attributedef", shorthand_def_cmd, attribute_def_code, 0);
+ tex_primitive(luatex_command, "luadef", shorthand_def_cmd, lua_def_code, 0);
+ tex_primitive(luatex_command, "integerdef", shorthand_def_cmd, integer_def_code, 0);
+ tex_primitive(luatex_command, "dimensiondef", shorthand_def_cmd, dimension_def_code, 0);
+ tex_primitive(luatex_command, "gluespecdef", shorthand_def_cmd, gluespec_def_code, 0);
+ tex_primitive(luatex_command, "mugluespecdef", shorthand_def_cmd, mugluespec_def_code, 0);
+ /* tex_primitive(luatex_command, "mathspecdef", shorthand_def_cmd, mathspec_def_code, 0); */
+ tex_primitive(luatex_command, "fontspecdef", shorthand_def_cmd, fontspec_def_code, 0);
+
+ tex_primitive(tex_command, "noindent", begin_paragraph_cmd, noindent_par_code, 0);
+ tex_primitive(tex_command, "indent", begin_paragraph_cmd, indent_par_code, 0);
+ tex_primitive(luatex_command, "quitvmode", begin_paragraph_cmd, quitvmode_par_code, 0);
+ tex_primitive(luatex_command, "undent", begin_paragraph_cmd, undent_par_code, 0);
+ tex_primitive(luatex_command, "snapshotpar", begin_paragraph_cmd, snapshot_par_code, 0);
+ tex_primitive(luatex_command, "parattribute", begin_paragraph_cmd, attribute_par_code, 0);
+ tex_primitive(luatex_command, "wrapuppar", begin_paragraph_cmd, wrapup_par_code, 0);
+
+ tex_primitive(tex_command, "end", end_job_cmd, end_code, 0);
+ tex_primitive(tex_command, "dump", end_job_cmd, dump_code, 0);
+
+ tex_primitive(luatex_command, "beginlocalcontrol", begin_local_cmd, local_control_begin_code, 0);
+ tex_primitive(luatex_command, "localcontrol", begin_local_cmd, local_control_token_code, 0);
+ tex_primitive(luatex_command, "localcontrolled", begin_local_cmd, local_control_list_code, 0);
+ tex_primitive(luatex_command, "localcontrolledloop", begin_local_cmd, local_control_loop_code, 0);
+ tex_primitive(luatex_command, "expandedloop", begin_local_cmd, expanded_loop_code, 0);
+ tex_primitive(luatex_command, "unexpandedloop", begin_local_cmd, unexpanded_loop_code, 0);
+
+ tex_primitive(luatex_command, "endlocalcontrol", end_local_cmd, normal_code, 0);
+
+ tex_primitive(tex_command, "unhbox", un_hbox_cmd, box_code, 0);
+ tex_primitive(tex_command, "unhcopy", un_hbox_cmd, copy_code, 0);
+ tex_primitive(luatex_command, "unhpack", un_hbox_cmd, unpack_code, 0);
+ tex_primitive(tex_command, "unvbox", un_vbox_cmd, box_code, 0);
+ tex_primitive(tex_command, "unvcopy", un_vbox_cmd, copy_code, 0);
+ tex_primitive(luatex_command, "unvpack", un_vbox_cmd, unpack_code, 0);
+
+ tex_primitive(etex_command, "pagediscards", un_vbox_cmd, last_box_code, 0);
+ tex_primitive(etex_command, "splitdiscards", un_vbox_cmd, vsplit_code, 0);
+
+ tex_primitive(luatex_command, "insertunbox", un_vbox_cmd, insert_box_code, 0);
+ tex_primitive(luatex_command, "insertuncopy", un_vbox_cmd, insert_copy_code, 0);
+
+ tex_primitive(tex_command, "raise", vmove_cmd, move_backward_code, 0);
+ tex_primitive(tex_command, "lower", vmove_cmd, move_forward_code, 0);
+
+ tex_primitive(tex_command, "vfil", vskip_cmd, fil_code, 0);
+ tex_primitive(tex_command, "vfill", vskip_cmd, fill_code, 0);
+ tex_primitive(tex_command, "vfilneg", vskip_cmd, fil_neg_code, 0);
+ tex_primitive(tex_command, "vskip", vskip_cmd, skip_code, 0);
+ tex_primitive(tex_command, "vss", vskip_cmd, filll_code, 0);
+
+ tex_primitive(tex_command, "show", xray_cmd, show_code, 0);
+ tex_primitive(tex_command, "showbox", xray_cmd, show_box_code, 0);
+ tex_primitive(tex_command, "showthe", xray_cmd, show_the_code, 0);
+ tex_primitive(tex_command, "showlists", xray_cmd, show_lists_code, 0);
+ tex_primitive(etex_command, "showgroups", xray_cmd, show_groups_code, 0);
+ tex_primitive(etex_command, "showtokens", xray_cmd, show_tokens_code, 0);
+ tex_primitive(etex_command, "showifs", xray_cmd, show_ifs_code, 0);
+
+ tex_primitive(luatex_command, "savecatcodetable", catcode_table_cmd, save_cat_code_table_code, 0);
+ tex_primitive(luatex_command, "initcatcodetable", catcode_table_cmd, init_cat_code_table_code, 0);
+ /* tex_primitive(luatex_command, "setcatcodetabledefault", catcode_table_cmd, dflt_cat_code_table_code, 0); */ /* This was an experiment. */
+
+ tex_primitive(luatex_command, "pardirection", internal_int_cmd, par_direction_code, internal_int_base);
+ tex_primitive(luatex_command, "textdirection", internal_int_cmd, text_direction_code, internal_int_base);
+ tex_primitive(luatex_command, "mathdirection", internal_int_cmd, math_direction_code, internal_int_base);
+ tex_primitive(luatex_command, "linedirection", internal_int_cmd, line_direction_code, internal_int_base);
+
+ tex_primitive(luatex_command, "alignmark", parameter_cmd, normal_code, 0);
+ tex_primitive(luatex_command, "parametermark", parameter_cmd, normal_code, 0); /* proper primitive for syntax highlighting */
+
+ tex_primitive(luatex_command, "aligntab", alignment_tab_cmd, tab_mark_code, 0);
+
+ tex_primitive(tex_command, "span", alignment_cmd, span_code, 0);
+ tex_primitive(tex_command, "omit", alignment_cmd, omit_code, 0);
+ tex_primitive(tex_command, "noalign", alignment_cmd, no_align_code, 0);
+ tex_primitive(luatex_command, "aligncontent", alignment_cmd, align_content_code, 0);
+ /* tex_primitive(tex_command, "cr", alignment_cmd, cr_code, 0); */
+ /* tex_primitive(tex_command, "crcr", alignment_cmd, cr_cr_code, 0); */
+
+ tex_primitive(tex_command, "nonscript", math_script_cmd, math_no_script_code, 0);
+ tex_primitive(luatex_command, "noatomruling", math_script_cmd, math_no_ruling_code, 0);
+ tex_primitive(luatex_command, "Usuperscript", math_script_cmd, math_super_script_code, 0);
+ tex_primitive(luatex_command, "Usubscript", math_script_cmd, math_sub_script_code, 0);
+ tex_primitive(luatex_command, "Usuperprescript", math_script_cmd, math_super_pre_script_code, 0);
+ tex_primitive(luatex_command, "Usubprescript", math_script_cmd, math_sub_pre_script_code, 0);
+ tex_primitive(luatex_command, "Unosuperscript", math_script_cmd, math_no_super_script_code, 0);
+ tex_primitive(luatex_command, "Unosubscript", math_script_cmd, math_no_sub_script_code, 0);
+ tex_primitive(luatex_command, "Unosuperprescript", math_script_cmd, math_no_super_pre_script_code, 0);
+ tex_primitive(luatex_command, "Unosubprescript", math_script_cmd, math_no_sub_pre_script_code, 0);
+ tex_primitive(luatex_command, "Ushiftedsubscript", math_script_cmd, math_shifted_sub_script_code, 0);
+ tex_primitive(luatex_command, "Ushiftedsuperscript", math_script_cmd, math_shifted_super_script_code, 0);
+ tex_primitive(luatex_command, "Ushiftedsubprescript", math_script_cmd, math_shifted_sub_pre_script_code, 0);
+ tex_primitive(luatex_command, "Ushiftedsuperprescript", math_script_cmd, math_shifted_super_pre_script_code, 0);
+ tex_primitive(luatex_command, "Uprimescript", math_script_cmd, math_prime_script_code, 0);
+
+ /* tex_primitive(luatex_command, "Umathbinbinspacing", set_math_parameter_cmd, math_parameter_binary_binary_spacing, 0); */ /* Gone, as are more of these! */
+
+ tex_primitive(luatex_command, "Umathaxis", set_math_parameter_cmd, math_parameter_axis, 0);
+ tex_primitive(luatex_command, "Umathaccentbaseheight", set_math_parameter_cmd, math_parameter_accent_base_height, 0);
+ tex_primitive(luatex_command, "Umathaccentbasedepth", set_math_parameter_cmd, math_parameter_accent_base_depth, 0);
+ tex_primitive(luatex_command, "Umathflattenedaccentbaseheight", set_math_parameter_cmd, math_parameter_flattened_accent_base_height, 0);
+ tex_primitive(luatex_command, "Umathflattenedaccentbasedepth", set_math_parameter_cmd, math_parameter_flattened_accent_base_depth, 0);
+ tex_primitive(luatex_command, "Umathconnectoroverlapmin", set_math_parameter_cmd, math_parameter_connector_overlap_min, 0);
+ tex_primitive(luatex_command, "Umathfractiondelsize", set_math_parameter_cmd, math_parameter_fraction_del_size, 0);
+ tex_primitive(luatex_command, "Umathfractiondenomdown", set_math_parameter_cmd, math_parameter_fraction_denom_down, 0);
+ tex_primitive(luatex_command, "Umathfractiondenomvgap", set_math_parameter_cmd, math_parameter_fraction_denom_vgap, 0);
+ tex_primitive(luatex_command, "Umathfractionnumup", set_math_parameter_cmd, math_parameter_fraction_num_up, 0);
+ tex_primitive(luatex_command, "Umathfractionnumvgap", set_math_parameter_cmd, math_parameter_fraction_num_vgap, 0);
+ tex_primitive(luatex_command, "Umathfractionrule", set_math_parameter_cmd, math_parameter_fraction_rule, 0);
+ tex_primitive(luatex_command, "Umathlimitabovebgap", set_math_parameter_cmd, math_parameter_limit_above_bgap, 0);
+ tex_primitive(luatex_command, "Umathlimitabovekern", set_math_parameter_cmd, math_parameter_limit_above_kern, 0);
+ tex_primitive(luatex_command, "Umathlimitabovevgap", set_math_parameter_cmd, math_parameter_limit_above_vgap, 0);
+ tex_primitive(luatex_command, "Umathlimitbelowbgap", set_math_parameter_cmd, math_parameter_limit_below_bgap, 0);
+ tex_primitive(luatex_command, "Umathlimitbelowkern", set_math_parameter_cmd, math_parameter_limit_below_kern, 0);
+ tex_primitive(luatex_command, "Umathlimitbelowvgap", set_math_parameter_cmd, math_parameter_limit_below_vgap, 0);
+ tex_primitive(luatex_command, "Umathnolimitsubfactor", set_math_parameter_cmd, math_parameter_nolimit_sub_factor, 0); /* These are bonus parameters. */
+ tex_primitive(luatex_command, "Umathnolimitsupfactor", set_math_parameter_cmd, math_parameter_nolimit_sup_factor, 0); /* These are bonus parameters. */
+ tex_primitive(luatex_command, "Umathoperatorsize", set_math_parameter_cmd, math_parameter_operator_size, 0);
+ tex_primitive(luatex_command, "Umathoverbarkern", set_math_parameter_cmd, math_parameter_overbar_kern, 0);
+ tex_primitive(luatex_command, "Umathoverbarrule", set_math_parameter_cmd, math_parameter_overbar_rule, 0);
+ tex_primitive(luatex_command, "Umathoverbarvgap", set_math_parameter_cmd, math_parameter_overbar_vgap, 0);
+ tex_primitive(luatex_command, "Umathoverdelimiterbgap", set_math_parameter_cmd, math_parameter_over_delimiter_bgap, 0);
+ tex_primitive(luatex_command, "Umathoverdelimitervgap", set_math_parameter_cmd, math_parameter_over_delimiter_vgap, 0);
+ tex_primitive(luatex_command, "Umathquad", set_math_parameter_cmd, math_parameter_quad, 0);
+ tex_primitive(luatex_command, "Umathradicaldegreeafter", set_math_parameter_cmd, math_parameter_radical_degree_after, 0);
+ tex_primitive(luatex_command, "Umathradicaldegreebefore", set_math_parameter_cmd, math_parameter_radical_degree_before, 0);
+ tex_primitive(luatex_command, "Umathradicaldegreeraise", set_math_parameter_cmd, math_parameter_radical_degree_raise, 0);
+ tex_primitive(luatex_command, "Umathradicalextensibleafter", set_math_parameter_cmd, math_parameter_radical_extensible_after, 0);
+ tex_primitive(luatex_command, "Umathradicalextensiblebefore", set_math_parameter_cmd, math_parameter_radical_extensible_before, 0);
+ tex_primitive(luatex_command, "Umathradicalkern", set_math_parameter_cmd, math_parameter_radical_kern, 0);
+ tex_primitive(luatex_command, "Umathradicalrule", set_math_parameter_cmd, math_parameter_radical_rule, 0);
+ tex_primitive(luatex_command, "Umathradicalvgap", set_math_parameter_cmd, math_parameter_radical_vgap, 0);
+ tex_primitive(luatex_command, "Umathskewedfractionhgap", set_math_parameter_cmd, math_parameter_skewed_fraction_hgap, 0);
+ tex_primitive(luatex_command, "Umathskewedfractionvgap", set_math_parameter_cmd, math_parameter_skewed_fraction_vgap, 0);
+ tex_primitive(luatex_command, "Umathspacebeforescript", set_math_parameter_cmd, math_parameter_space_before_script, 0);
+ tex_primitive(luatex_command, "Umathspaceafterscript", set_math_parameter_cmd, math_parameter_space_after_script, 0);
+ tex_primitive(luatex_command, "Umathstackdenomdown", set_math_parameter_cmd, math_parameter_stack_denom_down, 0);
+ tex_primitive(luatex_command, "Umathstacknumup", set_math_parameter_cmd, math_parameter_stack_num_up, 0);
+ tex_primitive(luatex_command, "Umathstackvgap", set_math_parameter_cmd, math_parameter_stack_vgap, 0);
+ tex_primitive(luatex_command, "Umathsubshiftdown", set_math_parameter_cmd, math_parameter_subscript_shift_down, 0);
+ tex_primitive(luatex_command, "Umathsubshiftdrop", set_math_parameter_cmd, math_parameter_subscript_shift_drop, 0);
+ tex_primitive(luatex_command, "Umathsubsupshiftdown", set_math_parameter_cmd, math_parameter_subscript_superscript_shift_down, 0);
+ tex_primitive(luatex_command, "Umathsubsupvgap", set_math_parameter_cmd, math_parameter_subscript_superscript_vgap, 0);
+ tex_primitive(luatex_command, "Umathsubtopmax", set_math_parameter_cmd, math_parameter_subscript_top_max, 0);
+ tex_primitive(luatex_command, "Umathsupbottommin", set_math_parameter_cmd, math_parameter_superscript_bottom_min, 0);
+ tex_primitive(luatex_command, "Umathsupshiftdrop", set_math_parameter_cmd, math_parameter_superscript_shift_drop, 0);
+ tex_primitive(luatex_command, "Umathsupshiftup", set_math_parameter_cmd, math_parameter_superscript_shift_up, 0);
+ tex_primitive(luatex_command, "Umathsupsubbottommax", set_math_parameter_cmd, math_parameter_superscript_subscript_bottom_max, 0);
+ tex_primitive(luatex_command, "Umathunderbarkern", set_math_parameter_cmd, math_parameter_underbar_kern, 0);
+ tex_primitive(luatex_command, "Umathunderbarrule", set_math_parameter_cmd, math_parameter_underbar_rule, 0);
+ tex_primitive(luatex_command, "Umathunderbarvgap", set_math_parameter_cmd, math_parameter_underbar_vgap, 0);
+ tex_primitive(luatex_command, "Umathunderdelimiterbgap", set_math_parameter_cmd, math_parameter_under_delimiter_bgap, 0);
+ tex_primitive(luatex_command, "Umathunderdelimitervgap", set_math_parameter_cmd, math_parameter_under_delimiter_vgap, 0);
+ tex_primitive(luatex_command, "Umathxscale", set_math_parameter_cmd, math_parameter_x_scale, 0);
+ tex_primitive(luatex_command, "Umathyscale", set_math_parameter_cmd, math_parameter_y_scale, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathextrasupshift", set_math_parameter_cmd, math_parameter_extra_superscript_shift, 0);
+ tex_primitive(luatex_command, "Umathextrasubshift", set_math_parameter_cmd, math_parameter_extra_subscript_shift, 0);
+ tex_primitive(luatex_command, "Umathextrasuppreshift", set_math_parameter_cmd, math_parameter_extra_superprescript_shift, 0);
+ tex_primitive(luatex_command, "Umathextrasubpreshift", set_math_parameter_cmd, math_parameter_extra_subprescript_shift, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathprimeraise", set_math_parameter_cmd, math_parameter_prime_raise, 0);
+ tex_primitive(luatex_command, "Umathprimeraisecomposed", set_math_parameter_cmd, math_parameter_prime_raise_composed, 0);
+ tex_primitive(luatex_command, "Umathprimeshiftup", set_math_parameter_cmd, math_parameter_prime_shift_up, 0);
+ tex_primitive(luatex_command, "Umathprimeshiftdrop", set_math_parameter_cmd, math_parameter_prime_shift_drop, 0);
+ tex_primitive(luatex_command, "Umathprimespaceafter", set_math_parameter_cmd, math_parameter_prime_space_after, 0);
+ tex_primitive(luatex_command, "Umathprimewidth", set_math_parameter_cmd, math_parameter_prime_width, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathruleheight", set_math_parameter_cmd, math_parameter_rule_height, 0);
+ tex_primitive(luatex_command, "Umathruledepth", set_math_parameter_cmd, math_parameter_rule_depth, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathsupshiftdistance", set_math_parameter_cmd, math_parameter_superscript_shift_distance, 0);
+ tex_primitive(luatex_command, "Umathsubshiftdistance", set_math_parameter_cmd, math_parameter_subscript_shift_distance, 0);
+ tex_primitive(luatex_command, "Umathpresupshiftdistance", set_math_parameter_cmd, math_parameter_superprescript_shift_distance, 0);
+ tex_primitive(luatex_command, "Umathpresubshiftdistance", set_math_parameter_cmd, math_parameter_subprescript_shift_distance, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathextrasupspace", set_math_parameter_cmd, math_parameter_extra_superscript_space, 0);
+ tex_primitive(luatex_command, "Umathextrasubspace", set_math_parameter_cmd, math_parameter_extra_subscript_space, 0);
+ tex_primitive(luatex_command, "Umathextrasupprespace", set_math_parameter_cmd, math_parameter_extra_superprescript_space, 0);
+ tex_primitive(luatex_command, "Umathextrasubprespace", set_math_parameter_cmd, math_parameter_extra_subprescript_space, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathskeweddelimitertolerance", set_math_parameter_cmd, math_parameter_skewed_delimiter_tolerance, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathaccenttopshiftup", set_math_parameter_cmd, math_parameter_accent_top_shift_up, 0);
+ tex_primitive(luatex_command, "Umathaccentbottomshiftdown", set_math_parameter_cmd, math_parameter_accent_bottom_shift_down, 0);
+ tex_primitive(luatex_command, "Umathflattenedaccenttopshiftup", set_math_parameter_cmd, math_parameter_flattened_accent_top_shift_up, 0);
+ tex_primitive(luatex_command, "Umathflattenedaccentbottomshiftdown", set_math_parameter_cmd, math_parameter_flattened_accent_bottom_shift_down, 0);
+ tex_primitive(luatex_command, "Umathaccenttopovershoot", set_math_parameter_cmd, math_parameter_accent_top_overshoot, 0);
+ tex_primitive(luatex_command, "Umathaccentbottomovershoot", set_math_parameter_cmd, math_parameter_accent_bottom_overshoot, 0);
+ tex_primitive(luatex_command, "Umathaccentsuperscriptdrop", set_math_parameter_cmd, math_parameter_accent_superscript_drop, 0);
+ tex_primitive(luatex_command, "Umathaccentsuperscriptpercent", set_math_parameter_cmd, math_parameter_accent_superscript_percent, 0);
+ tex_primitive(luatex_command, "Umathaccentextendmargin", set_math_parameter_cmd, math_parameter_accent_extend_margin, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathdelimiterpercent", set_math_parameter_cmd, math_parameter_delimiter_percent, 0);
+ tex_primitive(luatex_command, "Umathdelimitershortfall", set_math_parameter_cmd, math_parameter_delimiter_shortfall, 0);
+ /* */
+ tex_primitive(luatex_command, "Umathoverlinevariant", set_math_parameter_cmd, math_parameter_over_line_variant, 0);
+ tex_primitive(luatex_command, "Umathunderlinevariant", set_math_parameter_cmd, math_parameter_under_line_variant, 0);
+ tex_primitive(luatex_command, "Umathoverdelimitervariant", set_math_parameter_cmd, math_parameter_over_delimiter_variant, 0);
+ tex_primitive(luatex_command, "Umathunderdelimitervariant", set_math_parameter_cmd, math_parameter_under_delimiter_variant, 0);
+ tex_primitive(luatex_command, "Umathdelimiterovervariant", set_math_parameter_cmd, math_parameter_delimiter_over_variant, 0);
+ tex_primitive(luatex_command, "Umathdelimiterundervariant", set_math_parameter_cmd, math_parameter_delimiter_under_variant, 0);
+ tex_primitive(luatex_command, "Umathhextensiblevariant", set_math_parameter_cmd, math_parameter_h_extensible_variant, 0);
+ tex_primitive(luatex_command, "Umathvextensiblevariant", set_math_parameter_cmd, math_parameter_v_extensible_variant, 0);
+ tex_primitive(luatex_command, "Umathfractionvariant", set_math_parameter_cmd, math_parameter_fraction_variant, 0);
+ tex_primitive(luatex_command, "Umathradicalvariant", set_math_parameter_cmd, math_parameter_radical_variant, 0);
+ tex_primitive(luatex_command, "Umathdegreevariant", set_math_parameter_cmd, math_parameter_accent_variant, 0);
+ tex_primitive(luatex_command, "Umathaccentvariant", set_math_parameter_cmd, math_parameter_degree_variant, 0);
+ tex_primitive(luatex_command, "Umathtopaccentvariant", set_math_parameter_cmd, math_parameter_top_accent_variant, 0);
+ tex_primitive(luatex_command, "Umathbottomaccentvariant", set_math_parameter_cmd, math_parameter_bottom_accent_variant, 0);
+ tex_primitive(luatex_command, "Umathoverlayaccentvariant", set_math_parameter_cmd, math_parameter_overlay_accent_variant, 0);
+ tex_primitive(luatex_command, "Umathnumeratorvariant", set_math_parameter_cmd, math_parameter_numerator_variant, 0);
+ tex_primitive(luatex_command, "Umathdenominatorvariant", set_math_parameter_cmd, math_parameter_denominator_variant, 0);
+ tex_primitive(luatex_command, "Umathsuperscriptvariant", set_math_parameter_cmd, math_parameter_superscript_variant, 0);
+ tex_primitive(luatex_command, "Umathsubscriptvariant", set_math_parameter_cmd, math_parameter_subscript_variant, 0);
+ tex_primitive(luatex_command, "Umathprimevariant", set_math_parameter_cmd, math_parameter_prime_variant, 0);
+ tex_primitive(luatex_command, "Umathstackvariant", set_math_parameter_cmd, math_parameter_stack_variant, 0);
+
+ tex_primitive(luatex_command, "resetmathspacing", set_math_parameter_cmd, math_parameter_reset_spacing, 0);
+ tex_primitive(luatex_command, "setmathspacing", set_math_parameter_cmd, math_parameter_set_spacing, 0);
+ tex_primitive(luatex_command, "letmathspacing", set_math_parameter_cmd, math_parameter_let_spacing, 0);
+ tex_primitive(luatex_command, "copymathspacing", set_math_parameter_cmd, math_parameter_copy_spacing, 0);
+ tex_primitive(luatex_command, "letmathparent", set_math_parameter_cmd, math_parameter_let_parent, 0);
+ tex_primitive(luatex_command, "copymathparent", set_math_parameter_cmd, math_parameter_copy_parent, 0);
+ tex_primitive(luatex_command, "setmathprepenalty", set_math_parameter_cmd, math_parameter_set_pre_penalty, 0);
+ tex_primitive(luatex_command, "setmathpostpenalty", set_math_parameter_cmd, math_parameter_set_post_penalty, 0);
+ tex_primitive(luatex_command, "setmathatomrule", set_math_parameter_cmd, math_parameter_set_atom_rule, 0);
+ tex_primitive(luatex_command, "setmathdisplayprepenalty", set_math_parameter_cmd, math_parameter_set_display_pre_penalty, 0);
+ tex_primitive(luatex_command, "setmathdisplaypostpenalty", set_math_parameter_cmd, math_parameter_set_display_post_penalty, 0);
+ tex_primitive(luatex_command, "letmathatomrule", set_math_parameter_cmd, math_parameter_let_atom_rule, 0);
+ tex_primitive(luatex_command, "copymathatomrule", set_math_parameter_cmd, math_parameter_copy_atom_rule, 0);
+ tex_primitive(luatex_command, "setmathignore", set_math_parameter_cmd, math_parameter_ignore, 0);
+ tex_primitive(luatex_command, "setmathoptions", set_math_parameter_cmd, math_parameter_options, 0);
+ tex_primitive(luatex_command, "setdefaultmathcodes", set_math_parameter_cmd, math_parameter_set_defaults, 0);
+
+ /*tex
+
+ A bunch of commands that need a special treatment, so we delayed their initialization.
+ They are in the above list but commented. We start with those that alias to (already
+ defined) primitives. Actually we can say something like:
+
+ \starttyping
+ primitive(tex_command, "fi", if_test_cmd, fi_code, 0);
+ cs_text(deep_frozen_cs_fi_code) = maketexstring("fi");
+ copy_eqtb_entry(deep_frozen_cs_fi_code, cur_val);
+ \stoptyping
+
+ but we use a helper that does a primitive lookup and shares the already allocated
+ string. The effect is the same but it adds a little abstraction and saves a few
+ redundant strings.
+
+ */
+
+ tex_primitive(tex_command, "par", end_paragraph_cmd, normal_end_paragraph_code, 0); /* |too_big_char| */
+ tex_primitive(no_command, "insertedpar", end_paragraph_cmd, inserted_end_paragraph_code, 0);
+ tex_primitive(no_command, "newlinepar", end_paragraph_cmd, new_line_end_paragraph_code, 0);
+
+ /* tex_primitive(luatex_command, "linepar", undefined_cs_cmd, 0, 0); */ /*tex A user can define this one.*/
+
+ tex_primitive(tex_command, "endgroup", end_group_cmd, semi_simple_group_code, 0);
+ tex_primitive(luatex_command, "endsimplegroup", end_group_cmd, also_simple_group_code, 0);
+ tex_primitive(luatex_command, "endmathgroup", end_group_cmd, math_simple_group_code, 0);
+
+ tex_primitive(tex_command, "relax", relax_cmd, relax_code, 0);
+ tex_primitive(luatex_command, "norelax", relax_cmd, no_relax_code, 0);
+ tex_primitive(no_command, "noexpandrelax", relax_cmd, no_expand_relax_code, 0);
+
+ tex_primitive(tex_command, "fi", if_test_cmd, fi_code, 0);
+ tex_primitive(no_command, "noif", if_test_cmd, no_if_code, 0);
+
+ tex_primitive(no_command, "always", prefix_cmd, always_code, 0);
+
+ tex_primitive(tex_command, "nullfont", set_font_cmd, null_font, 0);
+
+ tex_primitive(tex_command, "crcr", alignment_cmd, cr_cr_code, 0);
+ tex_primitive(tex_command, "cr", alignment_cmd, cr_code, 0);
+
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_end_group_code, "endgroup");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_relax_code, "relax");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_fi_code, "fi");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_no_if_code, "noif");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_always_code, "always");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_right_code, "right");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_null_font_code, "nullfont");
+ tex_aux_copy_deep_frozen_from_primitive(deep_frozen_cs_cr_code, "cr");
+
+ lmt_token_state.par_loc = tex_prim_lookup(tex_located_string("par"));
+ lmt_token_state.par_token = cs_token_flag + lmt_token_state.par_loc;
+
+ /* lmt_token_state.line_par_loc = tex_prim_lookup(tex_located_string("linepar")); */
+ /* lmt_token_state.line_par_token = cs_token_flag + lmt_token_state.line_par_loc; */
+
+ /*tex
+ These don't alias to existing commands. They are all inaccessible but might show up in
+ error messages and tracing. We could set the flags to resticted values. We need to
+ intercept them in the function that prints the |chr| because they can be out of range.
+ */
+
+ cs_text(deep_frozen_cs_end_template_1_code) = tex_maketexstring("endtemplate");
+ set_eq_type(deep_frozen_cs_end_template_1_code, deep_frozen_end_template_cmd);
+ set_eq_flag(deep_frozen_cs_end_template_1_code, 0);
+ set_eq_value(deep_frozen_cs_end_template_1_code, lmt_token_state.null_list);
+ set_eq_level(deep_frozen_cs_end_template_1_code, level_one);
+
+ cs_text(deep_frozen_cs_end_template_2_code) = tex_maketexstring("endtemplate");
+ set_eq_type(deep_frozen_cs_end_template_2_code, end_template_cmd);
+ set_eq_flag(deep_frozen_cs_end_template_2_code, 0);
+ set_eq_value(deep_frozen_cs_end_template_2_code, lmt_token_state.null_list);
+ set_eq_level(deep_frozen_cs_end_template_2_code, level_one);
+
+ cs_text(deep_frozen_cs_dont_expand_code) = tex_maketexstring("notexpanded");
+ set_eq_type(deep_frozen_cs_dont_expand_code, deep_frozen_dont_expand_cmd);
+ set_eq_flag(deep_frozen_cs_dont_expand_code, 0);
+
+ cs_text(deep_frozen_cs_protection_code) = tex_maketexstring("inaccessible");
+
+ cs_text(deep_frozen_cs_end_write_code) = tex_maketexstring("endwrite");
+ set_eq_level(deep_frozen_cs_end_write_code, level_one);
+ set_eq_type(deep_frozen_cs_end_write_code, call_cmd);
+ set_eq_flag(deep_frozen_cs_end_write_code, 0);
+ set_eq_value(deep_frozen_cs_end_write_code, null);
+
+ lmt_string_pool_state.reserved = lmt_string_pool_state.string_pool_data.ptr;
+ lmt_hash_state.no_new_cs = 1;
+
+ }
+}
diff --git a/source/luametatex/source/tex/texcommands.h b/source/luametatex/source/tex/texcommands.h
new file mode 100644
index 000000000..66fabb47e
--- /dev/null
+++ b/source/luametatex/source/tex/texcommands.h
@@ -0,0 +1,1184 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_COMMANDS_H
+# define LMT_COMMANDS_H
+
+/*tex
+
+ Before we can go any further, we need to define symbolic names for the internal code numbers
+ that represent the various commands obeyed by \TEX. These codes are somewhat arbitrary, but
+ not completely so. For example, the command codes for character types are fixed by the
+ language, since a user says, e.g., |\catcode `\$ = 3| to make |\char'44| a math delimiter,
+ and the command code |math_shift| is equal to~3. Some other codes have been made adjacent so
+ that |case| statements in the program need not consider cases that are widely spaced, or so
+ that |case| statements can be replaced by |if| statements.
+
+ At any rate, here is the list, for future reference. First come the catcode commands, several
+ of which share their numeric codes with ordinary commands when the catcode cannot emerge from
+ \TEX's scanning routine.
+
+ Next are the ordinary run-of-the-mill command codes. Codes that are |min_internal| or more
+ represent internal quantities that might be expanded by |\the|.
+
+ The next codes are special; they all relate to mode-independent assignment of values to \TEX's
+ internal registers or tables. Codes that are |max_internal| or less represent internal
+ quantities that might be expanded by |\the|.
+
+ There is no matching primitive to go with |assign_attr|, but even if there was no
+ |\attributedef|, a reserved number would still be needed because there is an implied
+ correspondence between the |assign_xxx| commands and |xxx_val| expression values. That would
+ break down otherwise.
+
+ The remaining command codes are extra special, since they cannot get through \TEX's scanner to
+ the main control routine. They have been given values higher than |max_command| so that their
+ special nature is easily discernible. The expandable commands come first.
+
+ The extensions on top of standard \TEX\ came with extra |cmd| categories so at some point it
+ make sense to normalize soms of that. Similar commands became one category. Some more could be
+ combined, like rules and move etc.\ but for now it makes no sense. We could also move the mode
+ tests to the runners and make the main lookup simpler. Some commands need their own category
+ because they also can bind to characters (like super and subscript).
+
+ Because much now uses |last_item_cmd| this one has been renamed to the more neutral
+ |some_item_cmd|.
+
+ Watch out: check |command_names| in |lmttokenlib.c| after adding cmd's as these need to be in
+ sync.
+
+ Maybe we should use |box_property|, |font property| and |page property| instead if the now
+ split ones. Actually we should drop setting font dimensions.
+
+ todo: some codes -> subtypes (when not related to commands)
+
+*/
+
+/*tex
+ Some commands are shared, for instance |car_ret_cmd| is never seen in a token list so it can be
+ used for signaling a parameter: |out_param_cmd| in a macro body. These constants relate to the
+ 21 bit shifting in token properties!
+
+ These two are for nicer syntax highlighting in visual studio code or any IDE that is clever
+ enough to recognize enumerations. Otherwise they would get the color of a macro.
+
+ \starttyping
+ # define escape_cmd relax_cmd
+ # define out_param_cmd car_ret_cmd
+ # define end_template_cmd ignore_cmd
+ # define active_char_cmd par_end_cmd
+ # define match_cmd par_end_cmd
+ # define comment_cmd stop_cmd
+ # define end_match_cmd stop_cmd
+ # define invalid_char_cmd delimiter_num_cmd
+ \stoptyping
+
+ In the end sharing these command codes (as regular \TEX\ does) with character codes is not worth
+ the trouble because it gives fuzzy cmd codes in the \LUA\ token interface (and related tracing)
+ so at the cost of some extra slots they now are unique. The |foo_token| macros have to match the
+ cmd codes! Be aware that you need to map the new cmd names onto the original ones when you
+ consult the \TEX\ program source.
+
+ As a consequence of having more commands, the need to be distinctive in the \LUA\ token interface,
+ some commands have been combined (at the cost of a little overhead in testing chr codes). Some
+ names have been made more generic as a side effect but the principles remain the same. Sorry for
+ any introduced confusion.
+
+ An example of where some cmd codes were collapsed is alignments: |\omit|, |\span|, |\noalign|,
+ |\cr| and |\crcr| are now all handled by one cmd/chr code combination. This might make it a bit
+ easier to extend alignments when we're at it because it brings some code and logic together (of
+ course the principles are the same, but there can be slight differences in the way errors are
+ reported).
+*/
+
+
+typedef enum tex_command_code {
+ /*tex
+ The first 16 command codes are used for characters with a special meaning. In traditional
+ \TEX\ some have different names and also aliases. because we have a public token interface
+ they now are uniquely used for characters and the aliases have their own cmd/chr codes.
+ */
+ escape_cmd, /*tex 0: escape delimiter*/
+ left_brace_cmd, /*tex 1: beginning of a group */
+ right_brace_cmd, /*tex 2: ending of a group */
+ math_shift_cmd, /*tex 3: mathematics shift character */
+ alignment_tab_cmd, /*tex 4: alignment delimiter */
+ end_line_cmd, /*tex 5: end of line */
+ parameter_cmd, /*tex 6: macro parameter symbol */
+ superscript_cmd, /*tex 7: superscript */
+ subscript_cmd, /*tex 8: subscript */
+ ignore_cmd, /*tex 9: characters to ignore */
+ spacer_cmd, /*tex 10: characters equivalent to blank space */
+ letter_cmd, /*tex 11: characters regarded as letters */
+ other_char_cmd, /*tex 12: none of the special character types */
+ active_char_cmd, /*tex 13: characters that invoke macros */
+ comment_cmd, /*tex 14: characters that introduce comments */
+ invalid_char_cmd, /*tex 15: characters that shouldn't appear (|^^|) */
+ /*tex
+ The next set of commands is handled in the big switch where interpretation depends
+ on the current mode. It is a chicken or egg choice: either we have one runner per
+ command in which the mode is chosen, or we have a runner for each mode. The later is
+ used in \TEX.
+ */
+ relax_cmd, /*tex do nothing (|\relax|) */
+ end_template_cmd, /*tex end of |v_j| list in alignment template */
+ alignment_cmd, /*tex |\cr|, |\crcr| and |\span| */
+ match_cmd, /*tex match a macro parameter */
+ end_match_cmd, /*tex end of parameters to macro */
+ parameter_reference_cmd, /*tex the value passed as parameter */
+ end_paragraph_cmd, /*tex end of paragraph (|\par|) */
+ end_job_cmd, /*tex end of job (|\end|, |\dump|) */
+ delimiter_number_cmd, /*tex specify delimiter numerically (|\delimiter|) */
+ char_number_cmd, /*tex character specified numerically (|\char|) */
+ math_char_number_cmd, /*tex explicit math code (|mathchar} ) */
+ set_mark_cmd, /*tex mark definition (|mark|) */
+ node_cmd, /*tex a node injected via \LUA */
+ xray_cmd, /*tex peek inside of \TEX\ (|\show|, |\showbox|, etc.) */
+ make_box_cmd, /*tex make a box (|\box|, |\copy|, |\hbox|, etc.) */
+ hmove_cmd, /*tex horizontal motion (|\moveleft|, |\moveright|) */
+ vmove_cmd, /*tex vertical motion (|\raise|, |\lower|) */
+ un_hbox_cmd, /*tex unglue a box (|\unhbox|, |\unhcopy|) */
+ un_vbox_cmd, /*tex unglue a box (|\unvbox|, |\unvcopy|, |\pagediscards|, |\splitdiscards|) */
+ remove_item_cmd, /*tex nullify last item (|\unpenalty|, |\unkern|, |\unskip|) */
+ hskip_cmd, /*tex horizontal glue (|\hskip|, |\hfil|, etc.) */
+ vskip_cmd, /*tex vertical glue (|\vskip|, |\vfil|, etc.) */
+ mskip_cmd, /*tex math glue (|\mskip|) */
+ kern_cmd, /*tex fixed space (|\kern|) */
+ mkern_cmd, /*tex math kern (|\mkern|) */
+ leader_cmd, /*tex all these |\leaders| */
+ legacy_cmd, /*tex obsolete |\shipout|,etc.) */
+ local_box_cmd, /*tex use a box (|\localleftbox|, etc.) */
+ halign_cmd, /*tex horizontal table alignment (|\halign|) */
+ valign_cmd, /*tex vertical table alignment (|\valign|) */
+ vrule_cmd, /*tex vertical rule (|\vrule|, etc.) */
+ hrule_cmd, /*tex horizontal rule (|\hrule|. etc.) */
+ insert_cmd, /*tex vlist inserted in box (|\insert|) */
+ vadjust_cmd, /*tex vlist inserted in enclosing paragraph (|\vadjust|) */
+ ignore_something_cmd, /*tex gobble |spacer| tokens (|\ignorespaces|) */
+ after_something_cmd, /*tex save till assignment or group is done (|\after*|) */
+ penalty_cmd, /*tex additional badness (|\penalty|) */
+ begin_paragraph_cmd, /*tex (begin) paragraph (|\indent|, |\noindent|) */
+ italic_correction_cmd, /*tex italic correction (|/|) */
+ accent_cmd, /*tex attach accent in text (|\accent|) */
+ math_accent_cmd, /*tex attach accent in math (|\mathaccent|) */
+ discretionary_cmd, /*tex discretionary texts (|-|, |\discretionary|) */
+ equation_number_cmd, /*tex equation number (|\eqno|, |\leqno|) */
+ math_fence_cmd, /*tex variable delimiter (|\left|, |\right| or |\middle|) part of a fence */
+ math_component_cmd, /*tex component of formula (|\mathbin|, etc.) */
+ math_modifier_cmd, /*tex limit conventions (|\displaylimits|, etc.) */
+ math_fraction_cmd, /*tex generalized fraction (|\above|, |\atop|, etc.) */
+ math_style_cmd, /*tex style specification (|\displaystyle|, etc.) */
+ math_choice_cmd, /*tex choice specification (|\mathchoice|) */
+ vcenter_cmd, /*tex vertically center a vbox (|\vcenter|) */
+ case_shift_cmd, /*tex force specific case (|\lowercase|, |\uppercase|) */
+ message_cmd, /*tex send to user (|\message|, |\errmessage|) */
+ catcode_table_cmd, /*tex manipulators for catcode tables */
+ end_local_cmd, /*tex finishes a |local_cmd| */
+ lua_function_call_cmd, /*tex an expandable function call */
+ lua_protected_call_cmd, /*tex a function call that doesn's expand in edef like situations */
+ begin_group_cmd, /*tex begin local grouping (|\begingroup|) */
+ end_group_cmd, /*tex end local grouping (|\endgroup|) */
+ explicit_space_cmd, /*tex explicit space (|\ |) */
+ boundary_cmd, /*tex insert boundry node with value (|\*boundary|) */
+ math_radical_cmd, /*tex square root and similar signs (|\radical|) */
+ math_script_cmd, /*tex explicit super- or subscript */
+ math_shift_cs_cmd, /*tex start- and endmath */
+ end_cs_name_cmd, /*tex end control sequence (|\endcsname|) */
+ /*tex
+ The next set can come after |\the| so they are either handled in the big switch or
+ during expansion of this serializer prefix.
+ */
+ char_given_cmd, /*tex character code defined by |\chardef| */
+ // math_char_given_cmd, /*tex math code defined by |\mathchardef| */
+ // math_char_xgiven_cmd, /*tex math code defined by |\Umathchardef| or |\Umathcharnumdef| */
+ some_item_cmd, /*tex most recent item (|\lastpenalty|, |\lastkern|, |\lastskip| and more) */
+ /*tex
+ The previous command was described as \quotation {the last that cannot be prefixed by
+ |\global|} which is not entirely true any more. Actually more accurate is that the next
+ bunch can be prefixed and that's a mixed bag. It is used in |handle_assignments| which
+ deals with assignments in some special cases.
+ */
+ internal_toks_cmd, /*tex special token list (|\output|, |\everypar|, etc.) */
+ register_toks_cmd, /*tex user defined token lists */
+ internal_int_cmd, /*tex integer (|\tolerance|, |\day|, etc.) */
+ register_int_cmd, /*tex user-defined integers */
+ internal_attribute_cmd, /*tex */
+ register_attribute_cmd, /*tex user-defined attributes */
+ internal_dimen_cmd, /*tex length (|\hsize|, etc.) */
+ register_dimen_cmd, /*tex user-defined dimensions */
+ internal_glue_cmd, /*tex glue (|\baselineskip|, etc.) */
+ register_glue_cmd, /*tex user-defined glue */
+ internal_mu_glue_cmd, /*tex */
+ register_mu_glue_cmd, /*tex user-defined math glue */
+ lua_value_cmd, /*tex reference to a regular lua function */
+ iterator_value_cmd,
+ set_font_property_cmd, /*tex user-defined font integer (|\hyphenchar|, |\skewchar|) or (|\fontdimen|) */
+ set_auxiliary_cmd, /*tex state info (|\spacefactor|, |\prevdepth|) */
+ set_page_property_cmd, /*tex page info (|\pagegoal|, etc.) */
+ set_box_property_cmd, /*tex change property of box (|\wd|, |\ht|, |\dp|) */
+ set_specification_cmd, /*tex specifications (|\parshape|, |\interlinepenalties|, etc.) */
+ define_char_code_cmd, /*tex define a character code (|\catcode|, etc.) */
+ define_family_cmd, /*tex declare math fonts (|\textfont|, etc.) */
+ set_math_parameter_cmd, /*tex set math parameters (|\mathquad|, etc.) */
+ set_font_cmd, /*tex set current font (font identifiers) */
+ define_font_cmd, /*tex define a font file (|\font|) */
+ integer_cmd, /*tex the equivalent is a halfword number */
+ dimension_cmd, /*tex the equivalent is a halfword number representing a dimension */
+ gluespec_cmd, /*tex the equivalent is a halfword reference to glue */
+ mugluespec_cmd, /*tex the equivalent is a halfword reference to glue with math units */
+ mathspec_cmd,
+ fontspec_cmd,
+ register_cmd, /*tex internal register (|\count|, |\dimen|, etc.) */
+ /* string_cmd, */ /*tex discarded experiment but maybe ... */
+ combine_toks_cmd, /*tex the |toksapp| and similar token (list) combiners */
+ /*tex
+ That was the last command that could follow |\the|.
+ */
+ arithmic_cmd, /*tex |\advance|, |\multiply|, |\divide|, ... */
+ prefix_cmd, /*tex qualify a definition (|\global|, |\long|, |\outer|) */
+ let_cmd, /*tex assign a command code (|\let|, |\futurelet|) */
+ shorthand_def_cmd, /*tex code definition (|\chardef|, |\countdef|, etc.) */
+ def_cmd, /*tex macro definition (|\def|, |\gdef|, |\xdef|, |\edef|) */
+ set_box_cmd, /*tex set a box (|\setbox|) */
+ hyphenation_cmd, /*tex hyphenation data (|\hyphenation|, |\patterns|) */
+ set_interaction_cmd, /*tex define level of interaction (|\batchmode|, etc.) */
+ /*tex
+ Here ends the section that is part of the big switch. What follows are commands that are
+ intercepted when expanding tokens. The strint one came from a todo list and moved to a
+ maybe list.
+ */
+ undefined_cs_cmd, /*tex initial state of most |eq_type| fields */
+ expand_after_cmd, /*tex special expansion (|\expandafter|) */
+ no_expand_cmd, /*tex special nonexpansion (|\noexpand|) */
+ input_cmd, /*tex input a source file (|\input|, |\endinput| or |\scantokens| or |\scantextokens|) */
+ lua_call_cmd, /*tex a reference to a \LUA\ function */
+ lua_local_call_cmd, /*tex idem, but in a nested main loop */
+ begin_local_cmd, /*tex enter a a nested main loop */
+ if_test_cmd, /*tex conditional text (|\if|, |\ifcase|, etc.) */
+ cs_name_cmd, /*tex make a control sequence from tokens (|\csname|) */
+ convert_cmd, /*tex convert to text (|\number|, |\string|, etc.) */
+ the_cmd, /*tex expand an internal quantity (|\the| or |\unexpanded|, |\detokenize|) */
+ get_mark_cmd, /*tex inserted mark (|\topmark|, etc.) */
+ /* string_cmd, */
+ /*tex
+ These refer to macros. We might at some point promote the tolerant ones to have their own
+ cmd codes. Protected macros were done with an initial token signaling that property but
+ they became |protected_call_cmd|. After that we also got two frozen variants and later four
+ tolerant so we ended up with eight. When I wanted some more, a different solution was
+ chosen, so now we have just one again instead of |[tolerant_][frozen_][protected_]call_cmd|.
+ But ... in the end I setteled again for four basic call commands because it's nicer in
+ the token interface.
+
+ The todo cmds come from a todo list and relate to |\expand| but then like \expand{...} even
+ when normally it's protected. But it adds overhead we don't want right now an din the end I
+ didn't need it. I keep it as reference so that I won't recycle it.
+
+ */
+ call_cmd, /*tex regular control sequence */
+ protected_call_cmd, /*tex idem but doesn't expand in edef like situations */
+ semi_protected_call_cmd,
+ tolerant_call_cmd, /*tex control sequence with tolerant arguments */
+ tolerant_protected_call_cmd, /*tex idem but doesn't expand in edef like situations */
+ tolerant_semi_protected_call_cmd,
+ /*tex
+ These are special and are inserted in token streams. They cannot end up in macros.
+ */
+ deep_frozen_end_template_cmd, /*tex end of an alignment template */
+ deep_frozen_dont_expand_cmd, /*tex the following token was marked by |\noexpand|) */
+ /*tex
+ The next bunch is never seen directly as they are shortcuts to registers and special data
+ strutures. They are the internal register (pseudo) commands and are also needed for
+ token and node memory management.
+ */
+ internal_glue_reference_cmd, /*tex the equivalent points to internal glue specification */
+ register_glue_reference_cmd, /*tex the equivalent points to register glue specification */
+ internal_mu_glue_reference_cmd, /*tex the equivalent points to internal muglue specification */
+ register_mu_glue_reference_cmd, /*tex the equivalent points to egister muglue specification */
+ internal_box_reference_cmd, /*tex the equivalent points to internal box node, or is |null| */
+ register_box_reference_cmd, /*tex the equivalent points to register box node, or is |null| */
+ internal_toks_reference_cmd, /*tex the equivalent points to internal token list */
+ register_toks_reference_cmd, /*tex the equivalent points to register token list */
+ specification_reference_cmd, /*tex the equivalent points to parshape or penalties specification */
+ /*
+ We don't really need these but they are used to flag the registers eq entries properly. They
+ are not really references because the values are included but we want to be consistent here.
+ */
+ internal_int_reference_cmd,
+ register_int_reference_cmd,
+ internal_attribute_reference_cmd,
+ register_attribute_reference_cmd,
+ internal_dimen_reference_cmd,
+ register_dimen_reference_cmd,
+ /*tex
+ This is how many commands we have:
+ */
+ number_tex_commands,
+} tex_command_code;
+
+# define max_char_code_cmd invalid_char_cmd /*tex largest catcode for individual characters */
+# define min_internal_cmd char_given_cmd /*tex the smallest code that can follow |the| */
+# define max_non_prefixed_cmd some_item_cmd /*tex largest command code that can't be |global| */
+# define max_internal_cmd register_cmd /*tex the largest code that can follow |the| */
+# define max_command_cmd set_interaction_cmd /*tex the largest command code seen at |big_switch| */
+
+# define first_cmd escape_cmd
+# define last_cmd register_dimen_reference_cmd
+
+# define first_call_cmd call_cmd
+# define last_call_cmd tolerant_semi_protected_call_cmd
+
+# define last_visible_cmd tolerant_semi_protected_call_cmd
+
+# define is_call_cmd(cmd) (cmd >= first_call_cmd && cmd <= last_call_cmd)
+# define is_protected_cmd(cmd) (cmd == protected_call_cmd || cmd == tolerant_protected_call_cmd)
+# define is_semi_protected_cmd(cmd) (cmd == semi_protected_call_cmd || cmd == tolerant_semi_protected_call_cmd)
+# define is_tolerant_cmd(cmd) (cmd == tolerant_call_cmd || cmd == tolerant_protected_call_cmd || cmd == tolerant_semi_protected_call_cmd)
+
+# define is_referenced_cmd(cmd) (cmd >= call_cmd)
+# define is_nodebased_cmd(cmd) (cmd >= gluespec_cmd && cmd <= fontspec_cmd)
+
+
+# if (main_control_mode == 1)
+
+/*tex Once these were different numbers, no series: */
+
+typedef enum tex_modes {
+ nomode,
+ vmode,
+ hmode,
+ mmode,
+} tex_modes;
+
+# else
+
+typedef enum tex_modes {
+ nomode = 0,
+ vmode = 1, /*tex vertical mode */
+ hmode = 1 + max_command_cmd + 1, /*tex horizontal mode */
+ mmode = 1 + 2*(max_command_cmd + 1), /*tex math mode */
+} tex_modes;
+
+# endif
+
+typedef enum arithmic_codes {
+ advance_code,
+ multiply_code,
+ divide_code,
+ /* bitwise_and_code, */
+ /* bitwise_xor_code, */
+ /* bitwise_or_code, */
+ /* bitwise_not_code, */
+} arithmic_codes;
+
+# define last_arithmic_code divide_code
+
+typedef enum math_script_codes {
+ math_no_script_code,
+ math_no_ruling_code,
+ math_sub_script_code,
+ math_super_script_code,
+ math_super_pre_script_code,
+ math_sub_pre_script_code,
+ math_no_sub_script_code,
+ math_no_super_script_code,
+ math_no_sub_pre_script_code,
+ math_no_super_pre_script_code,
+ math_shifted_sub_script_code,
+ math_shifted_super_script_code,
+ math_shifted_sub_pre_script_code,
+ math_shifted_super_pre_script_code,
+ math_prime_script_code,
+} math_script_codes;
+
+# define last_math_script_code math_prime_script_code
+
+typedef enum math_fraction_codes {
+ math_above_code,
+ math_above_delimited_code,
+ math_over_code,
+ math_over_delimited_code,
+ math_atop_code,
+ math_atop_delimited_code,
+ math_u_above_code,
+ math_u_above_delimited_code,
+ math_u_over_code,
+ math_u_over_delimited_code,
+ math_u_atop_code,
+ math_u_atop_delimited_code,
+ math_u_skewed_code,
+ math_u_skewed_delimited_code,
+ math_u_stretched_code,
+ math_u_stretched_delimited_code,
+} math_fraction_codes;
+
+# define last_math_fraction_code math_u_skewed_code
+
+/*tex
+ These don't fit into the internal register model because they are for instance global or
+ bound to the current list.
+*/
+
+typedef enum auxiliary_codes {
+ space_factor_code,
+ prev_depth_code,
+ prev_graf_code,
+ interaction_mode_code,
+ insert_mode_code,
+} auxiliary_codes;
+
+# define last_auxiliary_code insert_mode_code
+
+typedef enum convert_codes {
+ number_code, /*tex command code for |\number| */
+ to_integer_code, /*tex command code for |\tointeger| (also gobbles |\relax|) */
+ to_hexadecimal_code, /*tex command code for |\tohexadecimal| */
+ to_scaled_code, /*tex command code for |\toscaled| (also gobbles |\relax|) */
+ to_sparse_scaled_code, /*tex command code for |\tosparsescaled| (also gobbles |\relax|) */
+ to_dimension_code, /*tex command code for |\todimension| (also gobbles |\relax|) */
+ to_sparse_dimension_code, /*tex command code for |\tosparsedimension| */
+ to_mathstyle_code, /*tex command code for |\tomathstyle| */
+ lua_code, /*tex command code for |\directlua| */
+ lua_function_code, /*tex command code for |\luafunction| */
+ lua_bytecode_code, /*tex command code for |\luabytecode| */
+ expanded_code, /*tex command code for |\expanded| */
+ semi_expanded_code, /*tex command code for |\constantexpanded| */
+ string_code, /*tex command code for |\string| */
+ cs_string_code, /*tex command code for |\csstring| */
+ detokenized_code, /*tex command code for |\detokenized| */
+ roman_numeral_code, /*tex command code for |\romannumeral| */
+ meaning_code, /*tex command code for |\meaning| */
+ meaning_full_code, /*tex command code for |\meaningfull| */
+ meaning_less_code, /*tex command code for |\meaningless| */
+ meaning_asis_code, /*tex command code for |\meaningasis| */
+ uchar_code, /*tex command code for |\Uchar| */
+ lua_escape_string_code, /*tex command code for |\luaescapestring| */
+ font_name_code, /*tex command code for |\fontname| */
+ font_specification_code, /*tex command code for |\fontspecification| */
+ job_name_code, /*tex command code for |\jobname| */
+ format_name_code, /*tex command code for |\AlephVersion| */
+ luatex_banner_code, /*tex command code for |\luatexbanner| */
+ font_identifier_code, /*tex command code for |tex.fontidentifier| (virtual) */
+} convert_codes;
+
+# define first_convert_code number_code
+# define last_convert_code luatex_banner_code
+
+typedef enum input_codes {
+ normal_input_code,
+ end_of_input_code,
+ token_input_code,
+ tex_token_input_code,
+ /* for now private */
+ tokenized_code,
+ retokenized_code,
+ quit_loop_code,
+} input_codes;
+
+# define last_input_code tex_token_input_code
+
+typedef enum some_item_codes {
+ lastpenalty_code, /*tex |\lastpenalty| */
+ lastkern_code, /*tex |\lastkern| */
+ lastskip_code, /*tex |\lastskip| */
+ lastboundary_code, /*tex |\lastboundary| */
+ last_node_type_code, /*tex |\lastnodetype| */
+ last_node_subtype_code, /*tex |\lastnodesubtype| */
+ input_line_no_code, /*tex |\inputlineno| */
+ badness_code, /*tex |\badness| */
+ overshoot_code, /*tex |\overshoot| */
+ luatex_version_code, /*tex |\luatexversion| */
+ luatex_revision_code, /*tex |\luatexrevision| */
+ current_group_level_code, /*tex |\currentgrouplevel| */
+ current_group_type_code, /*tex |\currentgrouptype| */
+ current_if_level_code, /*tex |\currentiflevel| */
+ current_if_type_code, /*tex |\currentiftype| */
+ current_if_branch_code, /*tex |\currentifbranch| */
+ glue_stretch_order_code, /*tex |\gluestretchorder| */
+ glue_shrink_order_code, /*tex |\glueshrinkorder| */
+ font_id_code, /*tex |\fontid| */
+ glyph_x_scaled_code, /*tex |\glyphxscaled| */
+ glyph_y_scaled_code, /*tex |\glyphyscaled| */
+ font_char_wd_code, /*tex |\fontcharwd| */
+ font_char_ht_code, /*tex |\fontcharht| */
+ font_char_dp_code, /*tex |\fontchardp| */
+ font_char_ic_code, /*tex |\fontcharic| */
+ font_char_ta_code, /*tex |\fontcharta| */
+ font_spec_id_code, /*tex |\fontspecid| */
+ font_spec_scale_code, /*tex |\fontspecscale| */
+ font_spec_xscale_code, /*tex |\fontspecxscale| */
+ font_spec_yscale_code, /*tex |\fontspecyscale| */
+ font_size_code, /*tex |\fontsize| */
+ font_math_control_code, /*tex |\fontmathcontrol| */
+ font_text_control_code, /*tex |\fonttextcontrol| */
+ math_scale_code, /*tex |\mathscale| */
+ math_style_code, /*tex |\mathstyle| */
+ math_main_style_code, /*tex |\mathmainstyle| */
+ math_style_font_id_code, /*tex |\mathstylefontid| */
+ math_stack_style_code, /*tex |\mathstackstyle| */
+ math_char_class_code, /*tex |\Umathcharclass| */
+ math_char_fam_code, /*tex |\Umathcharfam| */
+ math_char_slot_code, /*tex |\Umathcharslot| */
+ scaled_slant_per_point_code,
+ scaled_interword_space_code,
+ scaled_interword_stretch_code,
+ scaled_interword_shrink_code,
+ scaled_ex_height_code,
+ scaled_em_width_code,
+ scaled_extra_space_code,
+ last_arguments_code, /*tex |\lastarguments| */
+ parameter_count_code, /*tex |\parametercount| */
+ /* lua_value_function_code, */ /*tex |\luavaluefunction| */
+ insert_progress_code, /*tex |\insertprogress| */
+ left_margin_kern_code, /*tex |\leftmarginkern| */
+ right_margin_kern_code, /*tex |\rightmarginkern| */
+ par_shape_length_code, /*tex |\parshapelength| */
+ par_shape_indent_code, /*tex |\parshapeindent| */
+ par_shape_dimen_code, /*tex |\parshapedimen| */
+ glue_stretch_code, /*tex |\gluestretch| */
+ glue_shrink_code, /*tex |\glueshrink| */
+ mu_to_glue_code, /*tex |\mutoglue| */
+ glue_to_mu_code, /*tex |\gluetomu| */
+ numexpr_code, /*tex |\numexpr| */
+ /* attrexpr_code, */ /*tex not used */
+ dimexpr_code, /*tex |\dimexpr| */
+ glueexpr_code, /*tex |\glueexpr| */
+ muexpr_code, /*tex |\muexpr| */
+ numexpression_code, /*tex |\numexpression| */
+ dimexpression_code, /*tex |\dimexpression| */
+ last_chk_num_code, /*tex |\ifchknum| */
+ last_chk_dim_code, /*tex |\ifchkdim| */
+ // dimen_to_scale_code, /*tex |\dimentoscale| */
+ numeric_scale_code, /*tex |\numericscale| */
+ index_of_register_code,
+ index_of_character_code,
+ math_atom_glue_code,
+ last_left_class_code,
+ last_right_class_code,
+ last_atom_class_code,
+ current_loop_iterator_code,
+ current_loop_nesting_code,
+ last_loop_iterator_code,
+ last_par_context_code,
+ last_page_extra_code,
+} some_item_codes;
+
+# define last_some_item_code last_page_extra_code
+
+typedef enum catcode_table_codes {
+ save_cat_code_table_code,
+ init_cat_code_table_code,
+ /* dflt_cat_code_table_code, */
+} catcode_table_codes;
+
+# define last_catcode_table_code init_cat_code_table_code
+
+typedef enum font_property_codes {
+ font_hyphen_code,
+ font_skew_code,
+ font_lp_code,
+ font_rp_code,
+ font_ef_code,
+ font_dimen_code,
+ scaled_font_dimen_code,
+} font_property_codes;
+
+# define last_font_property_code scaled_font_dimen_code
+
+typedef enum box_property_codes {
+ box_width_code,
+ box_height_code,
+ box_depth_code,
+ box_direction_code,
+ box_geometry_code,
+ box_orientation_code,
+ box_anchor_code,
+ box_anchors_code,
+ box_source_code,
+ box_target_code,
+ box_xoffset_code,
+ box_yoffset_code,
+ box_xmove_code,
+ box_ymove_code,
+ box_total_code,
+ box_shift_code,
+ box_adapt_code,
+ box_repack_code,
+ box_freeze_code,
+ /* we actually need set_box_int_cmd, or set_box_property */
+ box_attribute_code,
+} box_property_codes;
+
+# define last_box_property_code box_attribute_code
+
+typedef enum hyphenation_codes {
+ hyphenation_code,
+ patterns_code,
+ prehyphenchar_code,
+ posthyphenchar_code,
+ preexhyphenchar_code,
+ postexhyphenchar_code,
+ hyphenationmin_code,
+ hjcode_code,
+} hyphenation_codes;
+
+# define last_hyphenation_code hjcode_code
+
+typedef enum begin_paragraph_codes {
+ noindent_par_code,
+ indent_par_code,
+ quitvmode_par_code,
+ undent_par_code,
+ snapshot_par_code,
+ attribute_par_code,
+ wrapup_par_code,
+} begin_paragraph_codes;
+
+# define last_begin_paragraph_code wrapup_par_code
+
+extern void tex_initialize_commands (void);
+
+/*tex
+
+ A |\chardef| creates a control sequence whose |cmd| is |char_given|; a |\mathchardef| creates a
+ control sequence whose |cmd| is |math_given|; and the corresponding |chr| is the character code
+ or math code. A |\countdef| or |\dimendef| or |\skipdef| or |\muskipdef| creates a control
+ sequence whose |cmd| is |assign_int| or \dots\ or |assign_mu_glue|, and the corresponding |chr|
+ is the |eqtb| location of the internal register in question.
+
+ We have the following codes for |shorthand_def|:
+
+*/
+
+typedef enum relax_codes {
+ relax_code,
+ no_relax_code,
+ no_expand_relax_code,
+} relax_codes;
+
+# define last_relax_code no_relax_code
+
+typedef enum end_paragraph_codes {
+ normal_end_paragraph_code,
+ inserted_end_paragraph_code,
+ new_line_end_paragraph_code,
+} end_paragraph_codes;
+
+# define last_end_paragraph_code new_line_end_paragraph_code
+
+typedef enum shorthand_def_codes {
+ char_def_code, /*tex |\chardef| */
+ math_char_def_code, /*tex |\mathchardef| */
+ math_xchar_def_code, /*tex |\Umathchardef| */
+ math_dchar_def_code, /*tex |\Umathdictdef| */
+ /* math_uchar_def_code, */ /* |\Umathcharnumdef| */
+ count_def_code, /*tex |\countdef| */
+ attribute_def_code, /*tex |\attributedef| */
+ dimen_def_code, /*tex |\dimendef| */
+ skip_def_code, /*tex |\skipdef| */
+ mu_skip_def_code, /*tex |\muskipdef| */
+ toks_def_code, /*tex |\toksdef| */
+ /* string_def_code, */
+ lua_def_code, /*tex |\luadef| */
+ integer_def_code,
+ dimension_def_code,
+ gluespec_def_code,
+ mugluespec_def_code,
+ /* mathspec_def_code, */
+ fontspec_def_code,
+} shorthand_def_codes;
+
+# define last_shorthand_def_code fontspec_def_code
+
+typedef enum char_number_codes {
+ char_number_code, /*tex |\char| */
+ glyph_number_code, /*tex |\glyph| */
+} char_number_codes;
+
+# define last_char_number_code glyph_number_code
+
+typedef enum math_char_number_codes {
+ math_char_number_code, /*tex |\mathchar| */
+ math_xchar_number_code, /*tex |\Umathchar| */
+ math_dchar_number_code, /*tex |\Umathdict| */
+ /* math_uchar_number_code, */ /* |\Umathcharnum| */
+ math_class_number_code, /*tex |\Umathclass| */
+} math_char_number_codes;
+
+# define last_math_char_number_code math_class_number_code
+
+typedef enum xray_codes {
+ show_code, /*tex |\show| */
+ show_box_code, /*tex |\showbox| */
+ show_the_code, /*tex |\showthe| */
+ show_lists_code, /*tex |\showlists| */
+ show_groups_code, /*tex |\showgroups| */
+ show_tokens_code, /*tex |\showtokens|, must be odd! */
+ show_ifs_code, /*tex |\showifs| */
+} xray_codes;
+
+# define last_xray_code show_ifs_code
+
+typedef enum the_codes {
+ the_code,
+ the_without_unit_code,
+ /* the_with_property_code, */ /* replaced by value functions */
+ detokenize_code,
+ unexpanded_code,
+} the_codes;
+
+# define last_the_code unexpanded_code
+
+typedef enum expand_after_codes {
+ expand_after_code,
+ expand_unless_code,
+ future_expand_code,
+ future_expand_is_code, /*tex nicer than: future_expand_ignore_spaces_code */
+ future_expand_is_ap_code, /*tex nicer than: future_expand_ignore_spaces_and_pars_code */
+ /* expand_after_2_code, */
+ /* expand_after_3_code, */
+ expand_after_spaces_code,
+ expand_after_pars_code,
+ expand_token_code,
+ expand_cs_token_code,
+ expand_code,
+ semi_expand_code,
+ expand_after_toks_code,
+ /* expand_after_fi, */
+} expand_after_codes;
+
+# define last_expand_after_code expand_after_toks_code
+
+typedef enum after_something_codes {
+ after_group_code,
+ after_assignment_code,
+ at_end_of_group_code,
+ after_grouped_code,
+ after_assigned_code,
+ at_end_of_grouped_code,
+} after_something_codes;
+
+# define last_after_something_code at_end_of_grouped_code
+
+typedef enum begin_group_codes {
+ semi_simple_group_code,
+ also_simple_group_code,
+ math_simple_group_code,
+} begin_group_codes;
+
+# define last_begin_group_code also_simple_group_code
+
+typedef enum end_job_codes {
+ end_code,
+ dump_code,
+} end_job_codes;
+
+# define last_end_job_code dump_code
+
+typedef enum local_control_codes {
+ local_control_begin_code,
+ local_control_token_code,
+ local_control_list_code,
+ local_control_loop_code,
+ expanded_loop_code,
+ unexpanded_loop_code,
+} local_control_codes;
+
+# define last_local_control_code unexpanded_loop_code
+
+/*tex
+
+ Maybe also a prefix |\unfrozen| that avoids the warning or have a variant that only issues a
+ warning but then we get 8 more cmd codes and we don't want that. An alternative is to have some
+ bits for this but we don't have enough. Now, because frozen macros can be unfrozen we can
+ indeed have a prefix that bypasses the check. Explicit (re)definitions are then up to the user.
+
+*/
+
+typedef enum prefix_codes {
+ frozen_code,
+ permanent_code,
+ immutable_code,
+ /* primitive_code, */
+ mutable_code,
+ noaligned_code,
+ instance_code,
+ untraced_code,
+ global_code,
+ tolerant_code,
+ protected_code,
+ overloaded_code,
+ aliased_code,
+ immediate_code,
+ /* conditional_code */
+ /* value_code */
+ semiprotected_code,
+ enforced_code,
+ always_code,
+ inherited_code,
+ long_code,
+ outer_code,
+} prefix_codes;
+
+# define last_prefix_code enforced_code
+
+typedef enum combine_toks_codes {
+ expanded_toks_code,
+ append_toks_code,
+ append_expanded_toks_code,
+ prepend_toks_code,
+ prepend_expanded_toks_code,
+ global_expanded_toks_code,
+ global_append_toks_code,
+ global_append_expanded_toks_code,
+ global_prepend_toks_code,
+ global_prepend_expanded_toks_code,
+} combine_toks_codes;
+
+# define last_combine_toks_code global_prepend_expanded_toks_code
+
+typedef enum cs_name_codes {
+ cs_name_code,
+ last_named_cs_code,
+ begin_cs_name_code,
+ future_cs_name_code,
+} cs_name_codes;
+
+# define last_cs_name_code begin_cs_name_code
+
+typedef enum def_codes {
+ expanded_def_code,
+ def_code,
+ global_expanded_def_code,
+ global_def_code,
+ expanded_def_csname_code,
+ def_csname_code,
+ global_expanded_def_csname_code,
+ global_def_csname_code,
+} def_codes;
+
+# define last_def_code global_def_csname_code
+
+typedef enum let_codes {
+ global_let_code,
+ let_code,
+ future_let_code,
+ future_def_code,
+ let_charcode_code,
+ swap_cs_values_code,
+ let_protected_code,
+ unlet_protected_code,
+ let_frozen_code,
+ unlet_frozen_code,
+ let_csname_code,
+ global_let_csname_code,
+ let_to_nothing_code,
+ global_let_to_nothing_code,
+} let_codes;
+
+# define last_let_code global_let_csname_code
+
+typedef enum message_codes {
+ message_code,
+ error_message_code,
+} message_codes;
+
+# define last_message_code error_message_code
+
+/*tex
+
+ These are no longer needed, but we keep them as reference:
+
+ \starttyping
+ typedef enum in_stream_codes {
+ close_stream_code,
+ open_stream_code,
+ } in_stream_codes;
+
+ # define last_in_stream_code open_stream_code
+
+ typedef enum read_to_cs_codes {
+ read_code,
+ read_line_code,
+ } read_to_cs_codes;
+
+ # define last_read_to_cs_code read_line_code
+ \stoptyping
+
+*/
+
+typedef enum lua_call_codes {
+ lua_function_call_code,
+ lua_bytecode_call_code,
+} lua_codes;
+
+typedef enum math_delimiter_codes {
+ math_delimiter_code,
+ math_udelimiter_code,
+} math_delimiter_codes;
+
+# define last_math_delimiter_code math_udelimiter_code
+
+typedef enum math_choice_codes {
+ math_choice_code,
+ math_discretionary_code,
+ math_ustack_code,
+} math_choice_codes;
+
+# define last_math_choice_code math_ustack_code
+
+typedef enum math_accent_codes {
+ math_accent_code,
+ math_uaccent_code,
+} math_accent_codes;
+
+# define last_math_accent_code math_uaccent_code
+
+typedef enum lua_value_codes {
+ lua_value_none_code,
+ lua_value_integer_code,
+ lua_value_cardinal_code,
+ lua_value_dimension_code,
+ lua_value_skip_code,
+ lua_value_boolean_code,
+ lua_value_float_code,
+ lua_value_string_code,
+ lua_value_node_code,
+ lua_value_direct_code,
+ /*tex total number of lua values */
+ number_lua_values,
+} lua_value_codes;
+
+typedef enum math_shift_cs_codes {
+ begin_inline_math_code,
+ end_inline_math_code,
+ begin_display_math_code,
+ end_display_math_code,
+ begin_math_mode_code,
+ end_math_mode_code,
+} math_shift_cs_codes;
+
+# define first_math_shift_cs_code begin_inline_math_code
+# define last_math_shift_cs_code end_math_mode_code
+
+/*tex
+ The next base and offset are what we always had so we keep it but we do use a proper zero based
+ chr code that we adapt to the old value in the runner, so from then on we're in old mode again.
+
+ \starttyping
+ # define leader_ship_base (a_leaders - 1)
+ # define leader_ship_offset (leader_flag - a_leaders)
+ \stoptyping
+
+ Internal boxes are kind of special as they can have different scanners and as such they don't
+ really fit in the rest of the internals. Now, for consistency we treat local boxes as internal
+ ones but if we ever need more (which is unlikely) we can have a dedicated local_box_base. If
+ we ever extend the repertoire of interal boxes we havbe to keep the local ones at the start.
+
+*/
+
+typedef enum legacy_codes {
+ shipout_code,
+} legacy_codes;
+
+# define first_legacy_code shipout_code
+# define last_legacy_code shipout_code
+
+typedef enum leader_codes {
+ a_leaders_code,
+ c_leaders_code,
+ x_leaders_code,
+ g_leaders_code,
+ u_leaders_code,
+} leader_codes;
+
+# define first_leader_code a_leaders_code
+# define last_leader_code u_leaders_code
+
+typedef enum local_box_codes {
+ local_left_box_code,
+ local_right_box_code,
+ local_middle_box_code,
+ /* room for more but then we go internal_box_codes */
+ number_box_pars,
+} local_box_codes;
+
+# define first_local_box_code local_left_box_code
+# define last_local_box_code local_middle_box_code
+
+typedef enum local_box_options {
+ local_box_par_option = 0x1,
+ local_box_local_option = 0x2,
+ local_box_keep_option = 0x4,
+} local_box_options;
+
+typedef enum skip_codes {
+ fil_code, /*tex |\hfil| and |\vfil| */
+ fill_code, /*tex |\hfill| and |\vfill| */
+ filll_code, /*tex |\hss| and |\vss|, aka |ss_code| */
+ fil_neg_code, /*tex |\hfilneg| and |\vfilneg| */
+ skip_code, /*tex |\hskip| and |\vskip| */
+ mskip_code, /*tex |\mskip| */
+} skip_codes;
+
+# define first_skip_code fil_code
+# define last_skip_code skip_code
+
+/*tex All kind of character related codes: */
+
+typedef enum charcode_codes {
+ catcode_charcode,
+ lccode_charcode,
+ uccode_charcode,
+ sfcode_charcode,
+ hccode_charcode,
+ hmcode_charcode,
+ mathcode_charcode,
+ extmathcode_charcode,
+ /* extmathcodenum_charcode, */
+ delcode_charcode,
+ extdelcode_charcode,
+ /* extdelcodenum_charcode, */
+} charcode_codes;
+
+# define first_charcode_code catcode_charcode
+/*define last_charcode_code extdelcodenum_charcode */
+# define last_charcode_code extdelcode_charcode
+
+typedef enum math_styles {
+ display_style, /*tex |\displaystyle| */
+ cramped_display_style, /*tex |\crampeddisplaystyle| */
+ text_style, /*tex |\textstyle| */
+ cramped_text_style, /*tex |\crampedtextstyle| */
+ script_style, /*tex |\scriptstyle| */
+ cramped_script_style, /*tex |\crampedscriptstyle| */
+ script_script_style, /*tex |\scriptscriptstyle| */
+ cramped_script_script_style, /*tex |\crampedscriptscriptstyle| */
+ /* hidden */
+ yet_unset_math_style,
+ former_choice_math_style,
+ scaled_math_style,
+ /* even more hidden */ /*tex These can be used to emulate the defaults. */
+ all_display_styles,
+ all_text_styles,
+ all_script_styles,
+ all_script_script_styles,
+ all_math_styles,
+ all_split_styles,
+ all_uncramped_styles,
+ all_cramped_styles,
+} math_styles;
+
+# define first_math_style display_style
+# define last_math_style all_cramped_styles
+
+# define is_valid_math_style(n) (n >= display_style && n <= cramped_script_script_style)
+# define are_valid_math_styles(n) (n >= all_display_styles && n <= all_cramped_styles)
+
+inline static halfword tex_math_style_to_size(halfword s)
+{
+ if (s == script_style || s == cramped_script_style) {
+ return script_size;
+ } else if (s == script_style || s == cramped_script_style) {
+ return script_script_size;
+ } else {
+ return text_size;
+ }
+}
+
+typedef enum math_choices {
+ math_display_choice,
+ math_text_choice,
+ math_script_choice,
+ math_script_script_choice,
+} math_choices;
+
+typedef enum math_discretionary_choices {
+ math_pre_break_choice,
+ math_post_break_choice,
+ math_no_break_choice,
+} math_discretionary_choices;
+
+typedef enum math_aboves {
+ math_numerator_above,
+ math_denominator_above,
+} math_aboves;
+
+typedef enum math_limits {
+ math_limits_top,
+ math_limits_bottom,
+} math_limits;
+
+typedef enum dir_codes {
+ dir_lefttoright,
+ dir_righttoleft
+} dir_codes;
+
+typedef enum quantitity_levels {
+ level_zero, /*tex level for undefined quantities */
+ level_one, /*tex outermost level for defined quantities */
+} quantitity_levels;
+
+typedef enum move_codes {
+ move_forward_code,
+ move_backward_code,
+} move_codes;
+
+# define last_move_code move_backward_code
+
+typedef enum ignore_something_codes {
+ ignore_space_code,
+ ignore_par_code,
+ ignore_argument_code,
+} ignore_something_codes;
+
+# define last_ignore_something_code ignore_argument_code
+
+typedef enum case_shift_codes {
+ lower_case_code,
+ upper_case_code,
+} case_shift_codes;
+
+# define last_case_shift_code upper_case_code
+
+typedef enum location_codes {
+ left_location_code,
+ right_location_code,
+ top_location_code,
+ bottom_location_code,
+} location_codes;
+
+# define first_location_code left_location_code
+# define last_location_code right_location_code
+
+typedef enum remove_item_codes {
+ kern_item_code,
+ penalty_item_code,
+ skip_item_code,
+ boundary_item_code,
+} remove_item_codes;
+
+# define last_remove_item_code boundary_item_code
+
+typedef enum kern_codes {
+ normal_kern_code,
+ h_kern_code, /* maybe */
+ v_kern_code, /* maybe */
+ non_zero_width_kern_code, /* maybe */
+} kern_codes;
+
+# define last_kern_code normal_kern_code
+
+typedef enum tex_mskip_codes {
+ normal_mskip_code,
+ atom_mskip_code,
+} tex_mskip_codes;
+
+# define last_mskip_code atom_mskip_code
+
+/*tex
+ All the other cases are zero but we use an indicator for that.
+*/
+
+# define normal_code 0
+
+# endif
diff --git a/source/luametatex/source/tex/texconditional.c b/source/luametatex/source/tex/texconditional.c
new file mode 100644
index 000000000..95035f43e
--- /dev/null
+++ b/source/luametatex/source/tex/texconditional.c
@@ -0,0 +1,1386 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ In \LUAMETATEX\ The condition code has been upgraded. Bits and pieces have been optimized and
+ on top of the extra checks in \LUATEX|\ we have a few more here. In order to get nicer looking
+ nested conditions |\orelse| has been introduced. Some conditionals are not really needed but
+ they give less noise when tracing macros. It's also possible to let \LUA\ code behave like
+ a test.
+
+*/
+
+/*tex
+
+ We consider now the way \TEX\ handles various kinds of |\if| commands. Conditions can be inside
+ conditions, and this nesting has a stack that is independent of the |save_stack|.
+
+ Four global variables represent the top of the condition stack: |cond_ptr| points to
+ pushed-down entries, if any; |if_limit| specifies the largest code of a |fi_or_else| command
+ that is syntactically legal; |cur_if| is the name of the current type of conditional; and
+ |if_line| is the line number at which it began.
+
+ If no conditions are currently in progress, the condition stack has the special state
+ |cond_ptr = null|, |if_limit = normal|, |cur_if = 0|, |if_line = 0|. Otherwise |cond_ptr|
+ points to a two-word node; the |type|, |subtype|, and |link| fields of the first word contain
+ |if_limit|, |cur_if|, and |cond_ptr| at the next level, and the second word contains the
+ corresponding |if_line|.
+
+ In |cond_ptr| we keep track of the top of the condition stack while |if_limit| holds the upper
+ bound on |fi_or_else| codes. The type of conditional being worked on is stored in cur_if and
+ |if_line| keeps track of the line where that conditional began. When we skip conditional text,
+ |skip_line| keeps track of the line number where skipping began, for use in error messages.
+
+ All these variables are collected in:
+
+*/
+
+condition_state_info lmt_condition_state = {
+ .cond_ptr = null,
+ .if_limit = 0,
+ .cur_if = 0,
+ .if_line = 0,
+ .skip_line = 0,
+ .chk_num = 0,
+ .chk_dim = 0,
+ .if_nesting = 0,
+};
+
+/*tex
+
+ Here is a procedure that ignores text until coming to an |\or|, |\else|, or |\fi| at level zero
+ of |\if| \unknown |\fi| nesting. After it has acted, |cur_chr| will indicate the token that was
+ found, but |cur_tok| will not be set (because this makes the procedure run faster).
+
+ With |l| we keep track of the level of |\if|\unknown|\fi| nesting and |scanner_status| let us
+ return to the entry status. The |pass_text| function only returns when we have a |fi_or_else|.
+
+*/
+
+static void tex_aux_pass_text(void)
+{
+ int level = 0;
+ int status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_skipping;
+ lmt_condition_state.skip_line = lmt_input_state.input_line;
+ while (1) {
+ tex_get_next();
+ if (cur_cmd == if_test_cmd) {
+ switch (cur_chr) {
+ case fi_code:
+ if (level == 0) {
+ lmt_input_state.scanner_status = status;
+ return;
+ } else {
+ --level;
+ break;
+ }
+ case else_code:
+ case or_code:
+ if (level == 0) {
+ lmt_input_state.scanner_status = status;
+ return;
+ } else {
+ break;
+ }
+ case or_else_code:
+ case or_unless_code:
+ do {
+ tex_get_next();
+ } while (cur_cmd == spacer_cmd);
+ break;
+ default:
+ ++level;
+ break;
+ }
+ }
+ }
+}
+
+/*tex
+ We return when we have a |fi_or_else| or when we have a valid |or_else| followed by an
+ |if_test_cmd|.
+*/
+
+static int tex_aux_pass_text_x(int tracing_ifs, int tracing_commands)
+{
+ int level = 0;
+ int status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_skipping;
+ lmt_condition_state.skip_line = lmt_input_state.input_line;
+ while (1) {
+ tex_get_next();
+ if (cur_cmd == if_test_cmd) {
+ switch (cur_chr) {
+ case fi_code:
+ if (level == 0) {
+ lmt_input_state.scanner_status = status;
+ return 0;
+ } else {
+ --level;
+ break;
+ }
+ case else_code:
+ case or_code:
+ if (level == 0) {
+ lmt_input_state.scanner_status = status;
+ return 0;
+ } else {
+ break;
+ }
+ case or_else_code:
+ case or_unless_code:
+ if (level == 0) {
+ int unless = cur_chr == or_unless_code;
+ if (tracing_commands > 1) {
+ tex_begin_diagnostic();
+ tex_print_str(unless ? "{orunless}" : "{orelse}");
+ tex_end_diagnostic();
+ } else if (tracing_ifs) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ do {
+ tex_get_next();
+ } while (cur_cmd == spacer_cmd);
+ if (lmt_condition_state.if_limit == if_code) {
+ if (cur_cmd == if_test_cmd && cur_chr >= first_real_if_test_code) {
+ goto OKAY;
+ }
+ tex_handle_error(
+ normal_error_type,
+ unless ? "No condition after \\orunless" : "No condition after \\orelse",
+ "I'd expected a proper if test command."
+ );
+ OKAY:
+ lmt_input_state.scanner_status = status;
+ return unless;
+ }
+ } else {
+ --level;
+ }
+ break;
+ default:
+ ++level;
+ break;
+ }
+ }
+ }
+}
+
+/*tex
+
+ When we begin to process a new |\if|, we set |if_limit = if_code|; then, if |\or| or |\else| or
+ |\fi| occurs before the current |\if| condition has been evaluated, |\relax| will be inserted.
+ For example, a sequence of commands like |\ifvoid 1 \else ... \fi| would otherwise require
+ something after the |1|.
+
+ When a conditional ends that was apparently started in a different input file, the |if_warning|
+ procedure is invoked in order to update the |if_stack|. If moreover |\tracingnesting| is
+ positive we want to give a warning message (with the same complications as above).
+
+*/
+
+static void tex_aux_if_warning(void)
+{
+ /*tex Do we need a warning? */
+ int warning = 0;
+ int index = lmt_input_state.in_stack_data.ptr;
+ lmt_input_state.base_ptr = lmt_input_state.input_stack_data.ptr;
+ /*tex Store current state. */
+ lmt_input_state.input_stack[lmt_input_state.base_ptr] = lmt_input_state.cur_input;
+ while (lmt_input_state.in_stack[index].if_ptr == lmt_condition_state.cond_ptr) {
+ /*tex Set variable |w| to. */
+ if (tracing_nesting_par > 0) {
+ while ((lmt_input_state.input_stack[lmt_input_state.base_ptr].state == token_list_state) || (lmt_input_state.input_stack[lmt_input_state.base_ptr].index > index)) {
+ --lmt_input_state.base_ptr;
+ }
+ if (lmt_input_state.input_stack[lmt_input_state.base_ptr].name > 17) {
+ warning = 1;
+ }
+ }
+ lmt_input_state.in_stack[index].if_ptr = node_next(lmt_condition_state.cond_ptr);
+ --index;
+ }
+ if (warning) {
+ tex_begin_diagnostic();
+ tex_print_format("[conditional: end of %C%L of a different file]", if_test_cmd, lmt_condition_state.cur_if, lmt_condition_state.if_line);
+ tex_end_diagnostic();
+ if (tracing_nesting_par > 1) {
+ tex_show_context();
+ }
+ if (lmt_error_state.history == spotless) {
+ lmt_error_state.history = warning_issued;
+ }
+ }
+}
+
+static void tex_aux_push_condition_stack(int code, int unless)
+{
+ halfword p = tex_get_node(if_node_size);
+ node_type(p) = if_node;
+ node_subtype(p) = 0;
+ node_next(p) = lmt_condition_state.cond_ptr;
+ if_limit_type(p) = (quarterword) lmt_condition_state.if_limit;
+ if_limit_subtype(p) = (quarterword) lmt_condition_state.cur_if;
+ if_limit_step(p) = (singleword) lmt_condition_state.cur_unless;
+ if_limit_unless(p) = (singleword) lmt_condition_state.if_unless;
+ if_limit_stepunless(p) = (singleword) lmt_condition_state.if_unless;
+ if_limit_line(p) = lmt_condition_state.if_line;
+ lmt_condition_state.cond_ptr = p;
+ lmt_condition_state.cur_if = cur_chr;
+ lmt_condition_state.cur_unless = unless;
+ lmt_condition_state.if_step = code;
+ lmt_condition_state.if_limit = if_code;
+ lmt_condition_state.if_line = lmt_input_state.input_line;
+ ++lmt_condition_state.if_nesting;
+}
+
+static void tex_aux_pop_condition_stack(void)
+{
+ halfword p;
+ if (lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].if_ptr == lmt_condition_state.cond_ptr) {
+ /*tex
+ Conditionals are possibly not properly nested with files. This test can become an
+ option.
+ */
+ tex_aux_if_warning();
+ }
+ p = lmt_condition_state.cond_ptr;
+ --lmt_condition_state.if_nesting;
+ lmt_condition_state.if_line = if_limit_line(p);
+ lmt_condition_state.cur_if = if_limit_subtype(p);
+ lmt_condition_state.cur_unless = if_limit_unless(p);
+ lmt_condition_state.if_step = if_limit_step(p);
+ lmt_condition_state.if_unless = if_limit_stepunless(p);
+ lmt_condition_state.if_limit = if_limit_type(p);
+ lmt_condition_state.cond_ptr = node_next(p);
+ tex_free_node(p, if_node_size);
+}
+
+/*tex
+ Here's a procedure that changes the |if_limit| code corresponding to a given value of
+ |cond_ptr|.
+*/
+
+inline static void tex_aux_change_if_limit(int l, halfword p)
+{
+ if (p == lmt_condition_state.cond_ptr) {
+ lmt_condition_state.if_limit = l;
+ } else {
+ halfword q = lmt_condition_state.cond_ptr;
+ while (q) {
+ if (node_next(q) == p) {
+ if_limit_type(q) = (quarterword) l;
+ return;
+ } else {
+ q = node_next(q);
+ }
+ }
+ tex_confusion("if");
+ }
+}
+
+/*tex
+
+ The conditional|\ifcsname| is equivalent to |\expandafter| |\expandafter| |\ifdefined|
+ |\csname|, except that no new control sequence will be entered into the hash table (once all
+ tokens preceding the mandatory |\endcsname| have been expanded). Because we have \UTF 8, we
+ find plenty of small helpers that are used in conversion.
+
+ A csname resolve can itself have nested csname resolving. We keep track of the nesting level
+ and also remember the last match.
+
+*/
+
+/* moved to texexpand */
+
+/*tex
+
+ An active character will be treated as category 13 following |\if \noexpand| or following
+ |\ifcat \noexpand|.
+
+*/
+
+static void tex_aux_get_x_token_or_active_char(void)
+{
+ tex_get_x_token();
+ // if (cur_cmd == relax_cmd && cur_chr == no_expand_flag && tex_is_active_cs(cs_text(cur_cs))) {
+ if (cur_cmd == relax_cmd && cur_chr == no_expand_relax_code && tex_is_active_cs(cs_text(cur_cs))) {
+ cur_cmd = active_char_cmd;
+ cur_chr = active_cs_value(cs_text(cur_tok - cs_token_flag));
+ }
+}
+
+/*tex
+
+ A condition is started when the |expand| procedure encounters an |if_test| command; in that
+ case |expand| reduces to |conditional|, which is a recursive procedure.
+
+*/
+
+static void tex_aux_missing_equal_error(int code)
+{
+ tex_handle_error(back_error_type, "Missing = inserted for %C", if_test_cmd, code,
+ "I was expecting to see '<', '=', or '>'. Didn't."
+ );
+}
+
+/*tex
+
+ This is an important function because a bit larger macro package does lots of testing. Compared
+ to regular \TEX\ there is of course the penalty of larger data structures but there's not much
+ we can do about that. Then there are more variants, which in turn can lead to a performance hit
+ as there is more to test and more code involved, which might influence cache hits and such.
+ However, I already optimized the \LUATEX\ code a bit and here there are some more tiny potential
+ speedups. But \unknown\ they are hard to measure and especially their impact on a normal run:
+ \TEX\ is already pretty fast and often these tests themselves are not biggest bottleneck, at
+ least not in \CONTEXT. My guess is that the speedups compensate the extra if tests so in the end
+ we're still okay. Expansion, pushing back tokens, accessing memory all over the place, excessive
+ use of \LUA\ \unknown\ all that has probably way more impact on a run. But I keep an eye on the
+ next one anyway.
+
+*/
+
+static void tex_aux_show_if_state(halfword code, halfword case_value)
+{
+ tex_begin_diagnostic();
+ switch (code) {
+ case if_chk_int_code : tex_print_format("{chknum %i}", case_value); break;
+ case if_val_int_code : tex_print_format("{numval %i}", case_value); break;
+ case if_cmp_int_code : tex_print_format("{cmpnum %i}", case_value); break;
+ case if_chk_dim_code : tex_print_format("{chkdim %i}", case_value); break;
+ case if_val_dim_code : tex_print_format("{dimval %i}", case_value); break;
+ case if_cmp_dim_code : tex_print_format("{cmpdim %i}", case_value); break;
+ case if_case_code : tex_print_format("{case %i}", case_value); break;
+ case if_math_style_code: tex_print_format("{mathstyle %i}", case_value); break;
+ case if_arguments_code : tex_print_format("{arguments %i}", case_value); break;
+ default : tex_print_format("{todo %i}", case_value); break;
+ }
+ tex_end_diagnostic();
+}
+
+/*tex Why do we skip over relax? */
+
+inline static halfword tex_aux_grab_toks(int expand, int expandlist, int *head)
+{
+ halfword p = null;
+ if (expand) {
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ } else {
+ do {
+ tex_get_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ }
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ p = expandlist ? tex_scan_toks_expand(1, NULL, 0) : tex_scan_toks_normal(1, NULL);
+ *head = p;
+ break;
+ case register_cmd:
+ /* is this okay? probably not as cur_val can be way to large */
+ if (cur_chr == tok_val_level) {
+ halfword n = tex_scan_toks_register_number();
+ p = eq_value(register_toks_location(n));
+ break;
+ } else {
+ goto DEFAULT;
+ }
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ p = eq_value(cur_chr);
+ break;
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ p = eq_value(cur_cs);
+ break;
+ default:
+ DEFAULT:
+ {
+ halfword n;
+ tex_back_input(cur_tok);
+ n = tex_scan_toks_register_number();
+ p = eq_value(register_toks_location(n));
+ break;
+ }
+ }
+ /* skip over the ref count */
+ return p ? token_link(p) : null;
+}
+
+inline static halfword tex_aux_scan_comparison(int code)
+{
+ halfword r;
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ r = cur_tok - other_token;
+ if ((r < '<') || (r > '>')) {
+ tex_aux_missing_equal_error(code);
+ return '=';
+ } else {
+ return r;
+ }
+}
+
+void tex_conditional_if(halfword code, int unless)
+{
+ /*tex The result or case value. */
+ int result = 0;
+ /*tex The |cond_ptr| corresponding to this conditional: */
+ halfword save_cond_ptr;
+ /*tex Tracing options */
+ int tracing_ifs = tracing_ifs_par > 0;
+ int tracing_commands = tracing_commands_par;
+ int tracing_both = tracing_ifs && (tracing_commands <= 1);
+ if (tracing_both) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ tex_aux_push_condition_stack(code, unless);
+ save_cond_ptr = lmt_condition_state.cond_ptr;
+ /*tex Either process |\ifcase| or set |b| to the value of a boolean condition. */
+ HERE:
+ /*tex We can get back here so we need to make sure result is always set! */
+ lmt_condition_state.if_step = code;
+ lmt_condition_state.if_unless = unless;
+ switch (code) {
+ case if_char_code:
+ case if_cat_code:
+ /*tex Test if two characters match. Seldom used, this one. */
+ {
+ halfword n, m;
+ tex_aux_get_x_token_or_active_char();
+ if ((cur_cmd > active_char_cmd) || (cur_chr > max_character_code)) {
+ /*tex It's not a character. */
+ m = relax_cmd;
+ n = relax_code;
+ } else {
+ m = cur_cmd;
+ n = cur_chr;
+ }
+ tex_aux_get_x_token_or_active_char();
+ if ((cur_cmd > active_char_cmd) || (cur_chr > max_character_code)) {
+ cur_cmd = relax_cmd;
+ cur_chr = relax_code;
+ }
+ if (code == if_char_code) {
+ result = (n == cur_chr);
+ } else {
+ result = (m == cur_cmd);
+ }
+ }
+ goto RESULT;
+ case if_abs_int_code:
+ case if_int_code:
+ /*tex
+ Test the relation between integers or dimensions. Here we use the fact that |<|,
+ |=|, and |>| are consecutive ASCII codes.
+ */
+ {
+ halfword n1 = tex_scan_int(0, NULL);
+ halfword cp = tex_aux_scan_comparison(code);
+ halfword n2 = tex_scan_int(0, NULL);
+ if (code == if_abs_int_code) {
+ if (n1 < 0) {
+ n1 = -n1;
+ }
+ if (n2 < 0) {
+ n2 = -n2;
+ }
+ }
+ switch (cp) {
+ case '<': result = (n1 < n2); break;
+ /* case '=': result = (n1 == n2); break; */
+ case '>': result = (n1 > n2); break;
+ /* default: break; */
+ default : result = (n1 == n2); break;
+ }
+ }
+ goto RESULT;
+ case if_abs_dim_code:
+ case if_dim_code:
+ /*tex
+ Test the relation between integers or dimensions. Here we use the fact that |<|,
+ |=|, and |>| are consecutive ASCII codes.
+ */
+ {
+ scaled n1 = tex_scan_dimen(0, 0, 0, 0, NULL);
+ halfword cp = tex_aux_scan_comparison(code);
+ scaled n2 = tex_scan_dimen(0, 0, 0, 0, NULL);
+ if (code == if_abs_dim_code) {
+ if (n1 < 0) {
+ n1 = -n1;
+ }
+ if (n2 < 0) {
+ n2 = -n2;
+ }
+ }
+ switch (cp) {
+ case '<': result = (n1 < n2); break;
+ /* case '=': result = (n1 == n2); break; */
+ case '>': result = (n1 > n2); break;
+ /* default: break; */
+ default : result = (n1 == n2); break;
+ }
+ }
+ goto RESULT;
+ case if_odd_code:
+ /*tex Test if an integer is odd. */
+ {
+ halfword v = tex_scan_int(0, NULL);
+ result = odd(v);
+ }
+ goto RESULT;
+ case if_vmode_code:
+ result = abs(cur_list.mode) == vmode;
+ goto RESULT;
+ case if_hmode_code:
+ result = abs(cur_list.mode) == hmode;
+ goto RESULT;
+ case if_mmode_code:
+ result = abs(cur_list.mode) == mmode;
+ goto RESULT;
+ case if_inner_code:
+ result = cur_list.mode < nomode;
+ goto RESULT;
+ case if_void_code:
+ {
+ halfword n = tex_scan_box_register_number();
+ result = box_register(n) == null;
+ }
+ goto RESULT;
+ case if_hbox_code:
+ {
+ halfword n = tex_scan_box_register_number();
+ halfword p = box_register(n);
+ result = p && (node_type(p) == hlist_node);
+ }
+ goto RESULT;
+ case if_vbox_code:
+ {
+ halfword n = tex_scan_box_register_number();
+ halfword p = box_register(n);
+ result = p && (node_type(p) == vlist_node);
+ }
+ goto RESULT;
+ case if_tok_code:
+ case if_cstok_code:
+ {
+ halfword pp = null;
+ halfword qq = null;
+ halfword p, q;
+ int expand = code == if_tok_code;
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ p = tex_aux_grab_toks(expand, 1, &pp);
+ q = tex_aux_grab_toks(expand, 1, &qq);
+ if (p == q) {
+ /* this is sneaky, a list always is different */
+ result = 1;
+ } else {
+ while (p && q) {
+ if (token_info(p) != token_info(q)) {
+ p = null;
+ break;
+ } else {
+ p = token_link(p);
+ q = token_link(q);
+ }
+ }
+ result = (! p) && (! q);
+ }
+ if (pp) {
+ tex_flush_token_list(pp);
+ }
+ if (qq) {
+ tex_flush_token_list(qq);
+ }
+ lmt_input_state.scanner_status = save_scanner_status;
+ }
+ goto RESULT;
+ case if_x_code:
+ {
+ /*tex
+ Test if two tokens match. Note that |\ifx| will declare two macros different
+ if one is |\long| or |\outer| and the other isn't, even though the texts of
+ the macros are the same.
+
+ We need to reset |scanner_status|, since |\outer| control sequences are
+ allowed, but we might be scanning a macro definition or preamble.
+
+ This is no longer true as we dropped these properties but it does apply to
+ protected macros and such.
+ */
+ halfword p, q, n;
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_get_next();
+ n = cur_cs;
+ p = cur_cmd;
+ q = cur_chr;
+ tex_get_next();
+ if (cur_cmd != p) {
+ result = 0;
+ } else if (cur_cmd < call_cmd) {
+ result = cur_chr == q;
+ } else {
+ /*tex
+ Test if two macro texts match. Note also that |\ifx| decides that macros
+ |\a| and |\b| are different in examples like this:
+
+ \starttyping
+ \def\a{\c} \def\c{}
+ \def\b{\d} \def\d{}
+ \stoptyping
+ */
+ p = token_link(cur_chr);
+ /*tex Omit reference counts. */
+ q = token_link(eq_value(n));
+ // is: q = token_link(q);
+ if (p == q) {
+ result = 1;
+ /*
+ } else if (! q) {
+ result = 0;
+ */
+ } else {
+ while (p && q) {
+ if (token_info(p) != token_info(q)) {
+ p = null;
+ break;
+ } else {
+ p = token_link(p);
+ q = token_link(q);
+ }
+ }
+ result = (! p) && (! q);
+ }
+ }
+ lmt_input_state.scanner_status = save_scanner_status;
+ }
+ goto RESULT;
+ case if_true_code:
+ result = 1;
+ goto RESULT;
+ case if_false_code:
+ result = 0;
+ goto RESULT;
+ case if_chk_int_code:
+ {
+ lmt_error_state.intercept = 1; /* maybe ++ and -- so that we can nest */
+ lmt_error_state.last_intercept = 0;
+ lmt_condition_state.chk_num = tex_scan_int(0, NULL); /* value is ignored */
+ result = lmt_error_state.last_intercept ? 2 : 1;
+ lmt_error_state.intercept = 0;
+ lmt_error_state.last_intercept = 0;
+ goto CASE;
+ }
+ case if_val_int_code:
+ {
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ lmt_condition_state.chk_num = tex_scan_int(0, NULL);
+ result = lmt_error_state.last_intercept ? 4 : (lmt_condition_state.chk_num < 0) ? 1 : (lmt_condition_state.chk_num > 0) ? 3 : 2;
+ lmt_error_state.intercept = 0;
+ lmt_error_state.last_intercept = 0;
+ goto CASE;
+ }
+ case if_cmp_int_code:
+ {
+ halfword n1 = tex_scan_int(0, NULL);
+ halfword n2 = tex_scan_int(0, NULL);
+ result = (n1 < n2) ? 0 : (n1 > n2) ? 2 : 1;
+ goto CASE;
+ }
+ case if_chk_dim_code:
+ {
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ lmt_condition_state.chk_dim = tex_scan_dimen(0, 0, 0, 0, NULL); /* value is ignored */
+ result = lmt_error_state.last_intercept ? 2 : 1;
+ lmt_error_state.intercept = 0;
+ lmt_error_state.last_intercept = 0;
+ goto CASE;
+ }
+ case if_val_dim_code:
+ {
+ lmt_error_state.intercept = 1;
+ lmt_error_state.last_intercept = 0;
+ lmt_condition_state.chk_dim = tex_scan_dimen(0, 0, 0, 0, NULL);
+ result = lmt_error_state.last_intercept ? 4 : (lmt_condition_state.chk_dim < 0) ? 1 : (lmt_condition_state.chk_dim > 0) ? 3 : 2;
+ lmt_error_state.intercept = 0;
+ lmt_error_state.last_intercept = 0;
+ goto CASE;
+ }
+ case if_cmp_dim_code:
+ {
+ scaled n1 = tex_scan_dimen(0, 0, 0, 0, NULL);
+ scaled n2 = tex_scan_dimen(0, 0, 0, 0, NULL);
+ result = (n1 < n2) ? 0 : (n1 > n2) ? 2 : 1;
+ goto CASE;
+ }
+ case if_case_code:
+ /*tex Select the appropriate case and |return| or |goto common_ending|. */
+ result = tex_scan_int(0, NULL);
+ goto CASE;
+ case if_def_code:
+ /*tex
+ The conditional |\ifdefined| tests if a control sequence is defined. We need to
+ reset |scanner_status|, since |\outer| control sequences are allowed, but we
+ might be scanning a macro definition or preamble.
+ */
+ {
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_get_next();
+ result = cur_cmd != undefined_cs_cmd;
+ lmt_input_state.scanner_status = save_scanner_status;
+ goto RESULT;
+ }
+ case if_cs_code:
+ result = tex_is_valid_csname();
+ goto RESULT;
+ case if_in_csname_code:
+ /*tex This one will go away. */
+ result = lmt_expand_state.cs_name_level;
+ goto RESULT;
+ case if_font_char_code:
+ /*tex The conditional |\iffontchar| tests the existence of a character in a font. */
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ result = tex_char_exists(fnt, chr);
+ }
+ goto RESULT;
+ case if_condition_code:
+ /*tex This can't happen! */
+ goto RESULT;
+ case if_flags_code:
+ {
+ singleword flag, fl;
+ tex_get_r_token();
+ flag = eq_flag(cur_cs);
+ /* todo: each prefix */
+ tex_get_token();
+ if (cur_cmd == prefix_cmd) {
+ switch (cur_chr) {
+ case permanent_code : result = is_permanent (flag); break;
+ case immutable_code : result = is_immutable (flag); break;
+ case mutable_code : result = is_mutable (flag); break;
+ case noaligned_code : result = is_noaligned (flag); break;
+ case instance_code : result = is_instance (flag); break;
+ case untraced_code : result = is_untraced (flag); break;
+ case global_code : result = is_global (flag); break;
+ case tolerant_code : result = is_tolerant (flag); break;
+ case protected_code : result = is_protected (flag); break;
+ case overloaded_code : result = is_overloaded (flag); break;
+ case aliased_code : result = is_aliased (flag); break;
+ case immediate_code : result = is_immediate (flag); break;
+ case semiprotected_code : result = is_semiprotected(flag); break;
+ }
+ } else {
+ tex_back_input(cur_tok);
+ fl = (singleword) tex_scan_int(1, NULL); /* maybe some checking or masking is needed here */
+ result = (flag & fl) == fl;
+ if (! result) {
+ if (is_protected(fl)) {
+ result = is_protected_cmd(eq_type(cur_cs));
+ } else if (is_tolerant(fl)) {
+ result = is_tolerant_cmd(eq_type(cur_cs));
+ } else if (is_global(fl)) {
+ result = eq_level(cur_cs) == level_one;
+ }
+ }
+ }
+ goto RESULT;
+ }
+ case if_empty_cmd_code:
+ {
+ tex_get_token();
+ EMPTY_CHECK_AGAIN:
+ switch (cur_cmd) {
+ case call_cmd:
+ result = ! token_link(cur_chr);
+ break;
+ case internal_toks_reference_cmd:
+ case register_toks_reference_cmd:
+ result = ! token_link(cur_chr);
+ break;
+ case register_cmd:
+ /*tex See |tex_aux_grab_toks|. */
+ if (cur_chr == tok_val_level) {
+ halfword n = tex_scan_toks_register_number();
+ halfword p = eq_value(register_toks_location(n));
+ result = ! p || ! token_link(p);
+ } else {
+ result = 0;
+ }
+ break;
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ {
+ halfword p = eq_value(cur_chr);
+ result = ! p || ! token_link(p);
+ }
+ break;
+ case cs_name_cmd:
+ if (cur_chr == last_named_cs_code && lmt_scanner_state.last_cs_name != null_cs) {
+ cur_cmd = eq_type(lmt_scanner_state.last_cs_name);
+ cur_chr = eq_value(lmt_scanner_state.last_cs_name);
+ goto EMPTY_CHECK_AGAIN;
+ }
+ /* fall through */
+ default:
+ result = 0;
+ }
+ goto RESULT;
+ }
+ case if_relax_cmd_code:
+ {
+ tex_get_token();
+ result = cur_cmd == relax_cmd;
+ goto RESULT;
+ }
+ case if_boolean_code:
+ result = tex_scan_int(0, NULL) ? 1 : 0;
+ goto RESULT;
+ case if_numexpression_code:
+ result = tex_scanned_expression(int_val_level) ? 1 : 0;
+ goto RESULT;
+ case if_dimexpression_code:
+ result = tex_scanned_expression(dimen_val_level) ? 1 : 0;
+ goto RESULT;
+ case if_math_parameter_code:
+ /*tex
+ A value of |1| means that the parameter is set to a non-zero value, while |2| means
+ that it is unset.
+ */
+ {
+ // result = 0;
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == set_math_parameter_cmd) {
+ int code = cur_chr;
+ int style = tex_scan_math_style_identifier(0, 0);
+ if (tex_get_math_parameter(style, code, NULL) == max_dimen) {
+ result = 2;
+ } else if (result) {
+ result = 1;
+ }
+ } else {
+ tex_normal_error("mathparameter", "a valid parameter expected");
+ result = 0;
+ }
+ goto CASE;
+ }
+ case if_math_style_code:
+ result = tex_current_math_style();
+ goto CASE;
+ case if_arguments_code:
+ result = lmt_expand_state.arguments;
+ goto CASE;
+ case if_parameters_code:
+ /*tex
+ The result has the last non-null count. We could have the test in the for but let's
+ keep it readable.
+ */
+ result = tex_get_parameter_count();
+ goto CASE;
+ case if_parameter_code:
+ {
+ /*tex
+ We need to pick up the next token but avoid replacement by the parameter which
+ happens in the getters: 0 = no parameter, 1 = okay, 2 = empty. This permits
+ usage like |\ifparameter#2\or yes\else no\fi| as with the other checkers.
+ */
+ if (lmt_input_state.cur_input.loc) {
+ halfword t = token_info(lmt_input_state.cur_input.loc);
+ lmt_input_state.cur_input.loc = token_link(lmt_input_state.cur_input.loc);
+ if (t < cs_token_flag && token_cmd(t) == parameter_reference_cmd) {
+ // result = token_info(input_state.parameter_stack[input_state.cur_input.parameter_start + token_chr(t) - 1]) != null ? 1 : 2;
+ result = lmt_input_state.parameter_stack[lmt_input_state.cur_input.parameter_start + token_chr(t) - 1] != null ? 1 : 2;
+ }
+ }
+ goto CASE;
+ }
+ case if_has_tok_code:
+ {
+ halfword qq = null;
+ halfword p, q;
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ p = tex_get_token();
+ q = tex_aux_grab_toks(0, 0, &qq);
+ if (p == q) {
+ result = 1;
+ } else {
+ result = 0;
+ while (q) {
+ if (p == token_info(q)) {
+ result = 1;
+ break;
+ } else {
+ q = token_link(q);
+ }
+ }
+ }
+ if (qq) {
+ tex_flush_token_list(qq);
+ }
+ lmt_input_state.scanner_status = save_scanner_status;
+ goto RESULT;
+ }
+ case if_has_toks_code:
+ case if_has_xtoks_code:
+ {
+ halfword pp = null;
+ halfword p;
+ int expand = code == if_has_xtoks_code;
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ p = tex_aux_grab_toks(expand, expand, &pp);
+ if (p) {
+ halfword qq = null;
+ halfword q = tex_aux_grab_toks(expand, expand, &qq);
+ if (p == q) {
+ result = 1;
+ } else {
+ int qh = q;
+ int ph = p;
+ result = 0;
+ while (p && q) {
+ halfword pt = token_info(p);
+ halfword qt = token_info(q);
+ AGAIN:
+ if (pt == qt) {
+ p = token_link(p);
+ q = token_link(q);
+ } else if (token_cmd(pt) == ignore_cmd
+ && token_cmd(qt) >= ignore_cmd && token_cmd(qt) <= other_char_cmd) {
+ p = token_link(p);
+ if (token_chr(pt) == token_chr(qt)) {
+ q = token_link(q);
+ } else {
+ pt = token_info(p);
+ goto AGAIN;
+ }
+ } else {
+ p = ph;
+ q = token_link(qh);
+ qh = q;
+ }
+ if (! p) {
+ result = 1;
+ break;
+ }
+ }
+ }
+ if (qq) {
+ tex_flush_token_list(qq);
+ }
+ }
+ if (pp) {
+ tex_flush_token_list(pp);
+ }
+ lmt_input_state.scanner_status = save_scanner_status;
+ goto RESULT;
+ }
+ case if_has_char_code:
+ {
+ halfword tok;
+ halfword qq = null;
+ halfword q;
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tok = tex_get_token();
+ q = tex_aux_grab_toks(0, 0, &qq);
+ if (q) {
+ int nesting = 0;
+ result = 0;
+ while (q) {
+ if (! nesting && token_info(q) == tok) {
+ result = 1;
+ break;
+ } else if (token_cmd(token_info(q)) == left_brace_cmd) {
+ nesting += 1;
+ } else if (token_cmd(token_info(q)) == right_brace_cmd) {
+ nesting -= 1;
+ }
+ q = token_link(q);
+ }
+ }
+ if (qq) {
+ tex_flush_token_list(qq);
+ }
+ lmt_input_state.scanner_status = save_scanner_status;
+ goto RESULT;
+ }
+ case if_insert_code:
+ {
+ /* beware: it tests */
+ result = ! tex_insert_is_void(tex_scan_int(0, NULL));
+ goto RESULT;
+ }
+ // case if_bitwise_and_code:
+ // {
+ // halfword n1 = scan_int(0, NULL);
+ // halfword n2 = scan_int(0, NULL);
+ // result = n1 & n2 ? 1 : 0;
+ // goto RESULT;
+ // }
+ default:
+ {
+ int class;
+ strnumber u = tex_save_cur_string();
+ int save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ lmt_token_state.luacstrings = 0;
+ class = lmt_function_call_by_class(code - last_if_test_code, 0, &result);
+ tex_restore_cur_string(u);
+ lmt_input_state.scanner_status = save_scanner_status;
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ /* bad */
+ }
+ switch (class) {
+ case lua_value_integer_code:
+ case lua_value_cardinal_code:
+ case lua_value_dimension_code:
+ goto CASE;
+ case lua_value_boolean_code:
+ goto RESULT;
+ default:
+ result = 0;
+ goto RESULT;
+ }
+ }
+ }
+ CASE:
+ /*tex
+ To be considered: |if (unless) { result = max_integer - result; }| so that we hit |\else|
+ and can do |\unless \ifcase \zero... \else \fi|.
+ */
+ if (tracing_commands > 1) {
+ tex_aux_show_if_state(code, result);
+ }
+ while (result) {
+ unless = tex_aux_pass_text_x(tracing_ifs, tracing_commands);
+ if (tracing_both) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ if (lmt_condition_state.cond_ptr == save_cond_ptr) {
+ if (cur_chr >= first_real_if_test_code) {
+ /*tex
+ We have an |or_else_cmd| here, but keep in mind that |\expandafter \ifx| and
+ |\unless \ifx| and |\ifcondition| don't work in such cases! We stay in this
+ function call.
+ */
+ if (cur_chr == if_condition_code) {
+ // goto COMMON_ENDING;
+ tex_aux_pop_condition_stack();
+ return;
+ } else {
+ code = cur_chr;
+ goto HERE;
+ }
+ } else if (cur_chr == or_code) {
+ --result;
+ } else {
+ goto COMMON_ENDING;
+ }
+ } else if (cur_chr == fi_code) {
+ tex_aux_pop_condition_stack();
+ }
+ }
+ tex_aux_change_if_limit(or_code, save_cond_ptr);
+ /*tex Wait for |\or|, |\else|, or |\fi|. */
+ return;
+ RESULT:
+ if (unless) {
+ result = ! result;
+ }
+ if (tracing_commands > 1) {
+ /*tex Display the value of |b|. */
+ tex_begin_diagnostic();
+ tex_print_str(result ? "{true}" : "{false}");
+ tex_end_diagnostic();
+ }
+ if (result) {
+ tex_aux_change_if_limit(else_code, save_cond_ptr);
+ /*tex Wait for |\else| or |\fi|. */
+ return;
+ } else {
+ /*tex
+ Skip to |\else| or |\fi|, then |goto common_ending|. In a construction like |\if \iftrue
+ abc\else d\fi|, the first |\else| that we come to after learning that the |\if| is false
+ is not the |\else| we're looking for. Hence the following curious logic is needed.
+ */
+ while (1) {
+ unless = tex_aux_pass_text_x(tracing_ifs, tracing_commands);
+ if (tracing_both) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ if (lmt_condition_state.cond_ptr == save_cond_ptr) {
+ /* still fragile for |\unless| and |\expandafter| etc. */
+ if (cur_chr >= first_real_if_test_code) {
+ if (cur_chr == if_condition_code) {
+ // goto COMMON_ENDING;
+ tex_aux_pop_condition_stack();
+ return;
+ } else {
+ code = cur_chr;
+ goto HERE;
+ }
+ } else if (cur_chr != or_code) {
+ goto COMMON_ENDING;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Extra \\or",
+ "I'm ignoring this; it doesn't match any \\if."
+ );
+ }
+ } else if (cur_chr == fi_code) {
+ tex_aux_pop_condition_stack();
+ }
+ }
+ }
+ COMMON_ENDING:
+ if (cur_chr == fi_code) {
+ tex_aux_pop_condition_stack();
+ } else {
+ /*tex Wait for |\fi|. */
+//lmt_condition_state.if_step = code;
+
+ lmt_condition_state.if_limit = fi_code;
+ }
+}
+
+/*tex
+ Terminate the current conditional and skip to |\fi| The processing of conditionals is complete
+ except for the following code, which is actually part of |expand|. It comes into play when
+ |\or|, |\else|, or |\fi| is scanned.
+*/
+
+void tex_conditional_fi_or_else(void)
+{
+ int tracing_ifs = tracing_ifs_par > 0;
+ if (tracing_ifs && tracing_commands_par <= 1) {
+ tex_show_cmd_chr(if_test_cmd, cur_chr);
+ }
+ if (cur_chr == or_else_code || cur_chr == or_unless_code) {
+ do {
+ tex_get_next();
+ } while (cur_cmd == spacer_cmd);
+ } else if (cur_chr > lmt_condition_state.if_limit) {
+ if (lmt_condition_state.if_limit == if_code) {
+ /*tex
+ The condition is not yet evaluated.
+ */
+ tex_insert_relax_and_cur_cs();
+ } else {
+ tex_handle_error(normal_error_type,
+ "Extra %C",
+ if_test_cmd, cur_chr,
+ "I'm ignoring this; it doesn't match any \\if."
+ );
+ }
+ /*tex We don't pop the stack! */
+ return;
+ }
+ /*tex Skip to |\fi|. */
+ while (! (cur_cmd == if_test_cmd && cur_chr == fi_code)) {
+ tex_aux_pass_text();
+ if (tracing_ifs) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ }
+ /*tex Inline variant: */
+ /*
+ if (! (cur_cmd == if_test_cmd && cur_chr == fi_code)) {
+ int level = 0;
+ int status = input_state.scanner_status;
+ input_state.scanner_status = scanner_is_skipping;
+ while (1) {
+ RESTART:
+ condition_state.skip_line = input_state.input_line;
+ while (1) {
+ get_next();
+ if (cur_cmd == if_test_cmd) {
+ switch (cur_chr) {
+ case fi_code:
+ if (level == 0) {
+ goto DONE;
+ } else {
+ --level;
+ break;
+ }
+ case else_code:
+ case or_code:
+ if (level == 0) {
+ if (tracing_ifs) {
+ show_cmd_chr(cur_cmd, cur_chr);
+ }
+ goto RESTART;
+ } else {
+ break;
+ }
+ case or_else_code:
+ do {
+ get_next();
+ } while (cur_cmd == spacer_cmd);
+ break;
+ default:
+ ++level;
+ break;
+ }
+ }
+ }
+ }
+ DONE:
+ if (tracing_ifs) {
+ show_cmd_chr(cur_cmd, cur_chr);
+ }
+ input_state.scanner_status = status;
+ }
+ */
+ tex_aux_pop_condition_stack();
+}
+
+/*tex
+
+ Negate a boolean conditional and |goto reswitch|. The result of a boolean condition is reversed
+ when the conditional is preceded by |\unless|. We silently ignore |\unless| for those tests that
+ act like an |\ifcase|. In \ETEX\ there was an error message.
+
+*/
+
+void tex_conditional_unless(void)
+{
+ tex_get_token();
+ if (cur_cmd == if_test_cmd) {
+ if (tracing_commands_par > 1) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ if (cur_chr != if_condition_code) {;
+ tex_conditional_if(cur_chr, 1);
+ }
+ } else {
+ tex_handle_error(back_error_type,
+ "You can't use '\\unless' before '%C'",
+ cur_cmd, cur_chr,
+ "Continue, and I'll forget that it ever happened."
+ );
+ }
+}
+
+void tex_show_ifs(void)
+{
+ if (lmt_condition_state.cond_ptr) {
+ /*tex First we determine the of |\if ... \fi| nesting. */
+ int n = 0;
+ {
+ /*tex We start at the tail of a token list to show. */
+ halfword p = lmt_condition_state.cond_ptr;
+ do {
+ ++n;
+ p = node_next(p);
+ } while (p);
+ }
+ /*tex Now reporting can start. */
+ {
+ halfword cond_ptr = lmt_condition_state.cond_ptr;
+ int cur_if = lmt_condition_state.cur_if;
+ int cur_unless = lmt_condition_state.cur_unless;
+ int if_step = lmt_condition_state.if_step;
+ int if_unless = lmt_condition_state.if_unless;
+ int if_line = lmt_condition_state.if_line;
+ int if_limit = lmt_condition_state.if_limit;
+ do {
+ if (cur_unless) {
+ if (if_line) {
+ tex_print_format("[conditional: level %i, current %C %C, limit %C, %sstep %C, line %i]",
+ n,
+ expand_after_cmd, expand_unless_code,
+ if_test_cmd, cur_if,
+ if_test_cmd, if_limit,
+ if_unless ? "unless " : "",
+ if_test_cmd, if_step,
+ if_line
+ );
+ } else {
+ tex_print_format("[conditional: level %i, current %C %C, limit %C, %sstep %C]",
+ n,
+ expand_after_cmd, expand_unless_code,
+ if_test_cmd, cur_if,
+ if_test_cmd, if_limit,
+ if_unless ? "unless " : "",
+ if_test_cmd, if_step
+ );
+ }
+ } else {
+ if (if_line) {
+ tex_print_format("[conditional: level %i, current %C, limit %C, %sstep %C, line %i]",
+ n,
+ if_test_cmd, cur_if,
+ if_test_cmd, if_limit,
+ if_unless ? "unless " : "",
+ if_test_cmd, if_step,
+ if_line
+ );
+ } else {
+ tex_print_format("[conditional: level %i, current %C, limit %C, %sstep %C]",
+ n,
+ if_test_cmd, cur_if,
+ if_test_cmd, if_limit,
+ if_unless ? "unless " : "",
+ if_test_cmd, if_step
+ );
+ }
+ }
+ --n;
+ cur_if = if_limit_subtype(cond_ptr);
+ cur_unless = if_limit_unless(cond_ptr);;
+ if_step = if_limit_step(cond_ptr);;
+ if_unless = if_limit_stepunless(cond_ptr);;
+ if_line = if_limit_line(cond_ptr);;
+ if_limit = if_limit_type(cond_ptr);;
+ cond_ptr = node_next(cond_ptr);
+ if (cond_ptr) {
+ tex_print_levels();
+ }
+ } while (cond_ptr);
+ }
+ } else {
+ tex_print_str("[conditional: none active]");
+ }
+}
+
+/*
+void tex_conditional_after_fi(void)
+{
+ halfword t = get_token();
+ int tracing_ifs = tracing_ifs_par > 0;
+ int tracing_commands = tracing_commands_par > 0;
+ while (1) {
+ pass_text_x(tracing_ifs, tracing_commands);
+ if (cur_chr == fi_code) {
+ pop_condition_stack();
+ break;
+ } else {
+ // some error
+ }
+ }
+ back_input(t);
+}
+*/ \ No newline at end of file
diff --git a/source/luametatex/source/tex/texconditional.h b/source/luametatex/source/tex/texconditional.h
new file mode 100644
index 000000000..f3de5dcdb
--- /dev/null
+++ b/source/luametatex/source/tex/texconditional.h
@@ -0,0 +1,131 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_CONDITIONAL_H
+# define LMT_CONDITIONAL_H
+
+/*tex
+
+ The next list should be in sync with |if_branch_mapping| at the top of the |c| file with the
+ same name. The next ones also go on the condition stack so we need to retain this order and
+ organization.
+
+ There is a catch here: the codes of the |if_test_cmd|, |fi_or_else_cmd| and |or_else_cmd| are
+ all in this enumeration. This has to do with the history of not always checking for the cmd
+ code in the fast skipping branches. We could change that but not now.
+
+ Well, in the end I combined |if_test_cmd|, |fi_or_else_cmd| and |or_else_cmd| because they use
+ the same chr range anyway and it also simplifies some of the testing (especially after some
+ more robust cmd/chr checking was added, and after that the |fi_or_else_cmd| and |or_else_cmd|
+ were combined. The main motivation is that we can have a more consistent \LUA\ token interface
+ end. It is debatable as we divert from the original, but we already did that by introducing
+ more conditionals, |\orelse| and the generic |\ifconditional| that also demandeed all kind of
+ adaptations. Sorry. The comments are mostly the same, including references to the older cmd
+ codes (pre 2.07 there used to be some switch/case statements in places but these were flattened).
+
+ Btw, the |\unless| prefix is kept out of this because it relates to expansion and prefixes are
+ separate anyway. It would make the code less pretty.
+
+ One reason for a split in cmd codes is performance but we didn't loose on the change.
+
+*/
+
+typedef enum if_test_codes {
+ /*tex These are private chr codes: */
+
+ no_if_code, /*tex We're not in a condition. */
+ if_code, /*tex We have a condition. */
+
+ /*tex These are public chr codes: */
+
+ fi_code, /*tex |\fi| */
+ else_code, /*tex |\else| */
+ or_code, /*tex |\or| */
+ or_else_code, /*tex |\orelse| */
+ or_unless_code, /*tex |\orunless| */
+
+ /*tex Here come the \if... codes: */
+
+ if_char_code, /*tex |\if| */
+ if_cat_code, /*tex |\ifcat| */
+ if_abs_int_code, /*tex |\ifabsnum| */
+ if_int_code, /*tex |\ifnum| */
+ if_abs_dim_code, /*tex |\ifabsdim| */
+ if_dim_code, /*tex |\ifdim| */
+ if_odd_code, /*tex |\ifodd| */
+ if_vmode_code, /*tex |\ifvmode| */
+ if_hmode_code, /*tex |\ifhmode| */
+ if_mmode_code, /*tex |\ifmmode| */
+ if_inner_code, /*tex |\ifinner| */
+ if_void_code, /*tex |\ifvoid| */
+ if_hbox_code, /*tex |\ifhbox| */
+ if_vbox_code, /*tex |\ifvbox| */
+ if_tok_code, /*tex |\iftok| */
+ if_cstok_code, /*tex |\ifcstok| */
+ if_x_code, /*tex |\ifx| */
+ if_true_code, /*tex |\iftrue| */
+ if_false_code, /*tex |\iffalse| */
+ if_chk_int_code, /*tex |\ifchknum| */
+ if_val_int_code, /*tex |\ifcmpnum| */
+ if_cmp_int_code, /*tex |\ifcmpnum| */
+ if_chk_dim_code, /*tex |\ifchkdim| */
+ if_val_dim_code, /*tex |\ifchkdim| */
+ if_cmp_dim_code, /*tex |\ifcmpdim| */
+ if_case_code, /*tex |\ifcase| */
+ if_def_code, /*tex |\ifdefined| */
+ if_cs_code, /*tex |\ifcsname| */
+ if_in_csname_code, /*tex |\ifincsname| */
+ if_font_char_code, /*tex |\iffontchar| */
+ if_condition_code, /*tex |\ifcondition| */
+ if_flags_code, /*tex |\ifflags| */
+ if_empty_cmd_code, /*tex |\ifempty| */
+ if_relax_cmd_code, /*tex |\ifrelax| */
+ if_boolean_code, /*tex |\ifboolean| */
+ if_numexpression_code, /*tex |\ifnumexpression| */
+ if_dimexpression_code, /*tex |\ifdimexpression| */
+ if_math_parameter_code, /*tex |\ifmathparameter| */
+ if_math_style_code, /*tex |\ifmathstyle| */
+ if_arguments_code, /*tex |\ifarguments| */
+ if_parameters_code, /*tex |\ifparameters| */
+ if_parameter_code, /*tex |\ifparameter| */
+ if_has_tok_code, /*tex |\ifhastok| */
+ if_has_toks_code, /*tex |\ifhastoks| */
+ if_has_xtoks_code, /*tex |\ifhasxtoks| */
+ if_has_char_code, /*tex |\ifhaschar| */
+ if_insert_code /*tex |\ifinsert| */
+ // if_bitwise_and_code, /*tex |\ifbitwiseand| */
+} if_test_codes;
+
+# define first_if_test_code fi_code
+# define last_if_test_code if_insert_code
+//define last_if_test_code if_bitwise_and_code
+
+# define first_real_if_test_code if_char_code
+# define last_real_if_test_code if_insert_code
+//define last_real_if_test_code if_bitwise_and_code
+
+typedef struct condition_state_info {
+ halfword cond_ptr; /*tex top of the condition stack */
+ int cur_if; /*tex type of conditional being worked on */
+ int cur_unless;
+ int if_step;
+ int if_unless;
+ int if_limit; /*tex upper bound on |fi_or_else| codes */
+ int if_line; /*tex line where that conditional began */
+ int skip_line; /*tex skipping began here */
+ halfword chk_num;
+ scaled chk_dim;
+ halfword if_nesting;
+ halfword padding;
+} condition_state_info ;
+
+extern condition_state_info lmt_condition_state;
+
+extern void tex_conditional_if (halfword code, int unless);
+extern void tex_conditional_fi_or_else (void);
+extern void tex_conditional_unless (void);
+extern void tex_show_ifs (void);
+/* void tex_conditional_after_fi (void); */
+
+# endif
diff --git a/source/luametatex/source/tex/texdirections.c b/source/luametatex/source/tex/texdirections.c
new file mode 100644
index 000000000..400b4c00d
--- /dev/null
+++ b/source/luametatex/source/tex/texdirections.c
@@ -0,0 +1,172 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ In \LUATEX\ we started with the \OMEGA\ direction model, although only a handful of directions
+ is supported there (four to be precise). For l2r and r2l typesetting the frontend can basically
+ ignore directions. Only the font handler needs to be direction aware. The vertical directions in
+ \LUATEX\ demand swapping height and width occasionally when doing calculations. In the end it is
+ the backend code that does the hard work.
+
+ In the end, in \LUAMETATEX\ we only kept the horizontal directions. The vertical ones were not
+ really useful and didn't even work well. It's up to the macro package to cook up proper
+ solutions. The simplification (and rewrite) of the code also resulted in a more advanced box
+ model (with rotation and offsets) that can help implementing vertical rendering, but that code
+ is not here.
+
+*/
+
+# include "luametatex.h"
+
+dir_state_info lmt_dir_state = {
+ .text_dir_ptr = null,
+ .padding = 0,
+};
+
+/*tex The next two are used by the linebreak routine; they could be macros. */
+
+inline static halfword tex_aux_push_dir_node(halfword p, halfword d)
+{
+ halfword n = tex_copy_node(d);
+ node_next(n) = p;
+ return n;
+}
+
+inline static halfword tex_aux_pop_dir_node(halfword p)
+{
+ halfword n = node_next(p);
+ tex_flush_node(p);
+ return n;
+}
+
+halfword tex_update_dir_state(halfword p, halfword initial)
+{
+ if (node_subtype(p) == normal_dir_subtype) {
+ lmt_linebreak_state.dir_ptr = tex_aux_push_dir_node(lmt_linebreak_state.dir_ptr, p);
+ return dir_direction(p);
+ } else {
+ lmt_linebreak_state.dir_ptr = tex_aux_pop_dir_node(lmt_linebreak_state.dir_ptr);
+ if (lmt_linebreak_state.dir_ptr) {
+ return dir_direction(lmt_linebreak_state.dir_ptr);
+ } else {
+ return initial;
+ }
+ }
+}
+
+halfword tex_sanitize_dir_state(halfword first, halfword last, halfword initial)
+{
+ for (halfword e = first; e && e != last; e = node_next(e)) {
+ if (node_type(e) == dir_node) {
+ if (node_subtype(e) == normal_dir_subtype) {
+ lmt_linebreak_state.dir_ptr = tex_aux_push_dir_node(lmt_linebreak_state.dir_ptr, e);
+ } else if (lmt_linebreak_state.dir_ptr && dir_direction(lmt_linebreak_state.dir_ptr) == dir_direction(e)) {
+ /*tex A bit strange test. */
+ lmt_linebreak_state.dir_ptr = tex_aux_pop_dir_node(lmt_linebreak_state.dir_ptr);
+ }
+ }
+ }
+ if (lmt_linebreak_state.dir_ptr) {
+ return dir_direction(lmt_linebreak_state.dir_ptr);
+ } else {
+ return initial;
+ }
+}
+
+halfword tex_complement_dir_state(halfword tail)
+{
+ halfword e = node_next(tail);
+ for (halfword p = lmt_linebreak_state.dir_ptr; p ; p = node_next(p)) {
+ halfword s = tex_new_dir(cancel_dir_subtype, dir_direction(p));
+ tex_attach_attribute_list_copy(s, tail);
+ tex_couple_nodes(tail, s);
+ tex_try_couple_nodes(s, e);
+ tail = s;
+ }
+ return tail;
+}
+
+void tex_initialize_directions(void)
+{
+ lmt_dir_state.text_dir_ptr = tex_new_dir(normal_dir_subtype, direction_def_value);
+}
+
+void tex_cleanup_directions(void)
+{
+ tex_flush_node(lmt_dir_state.text_dir_ptr); /* tex_free_node(lmt_dir_state.text_dir_ptr, dir_node_size) */
+}
+
+halfword tex_new_dir(quarterword subtype, halfword direction)
+{
+ halfword p = tex_new_node(dir_node, subtype);
+ dir_direction(p) = direction;
+ dir_level(p) = cur_level;
+ return p;
+}
+
+/* todo: |\tracingdirections| */
+
+void tex_push_text_dir_ptr(halfword val)
+{
+ if (dir_level(lmt_dir_state.text_dir_ptr) == cur_level) {
+ /*tex update */
+ dir_direction(lmt_dir_state.text_dir_ptr) = val;
+ } else {
+ /*tex add */
+ halfword text_dir_tmp = tex_new_dir(normal_dir_subtype, val);
+ node_next(text_dir_tmp) = lmt_dir_state.text_dir_ptr;
+ lmt_dir_state.text_dir_ptr = text_dir_tmp;
+ }
+}
+
+void tex_pop_text_dir_ptr(void)
+{
+ halfword text_dir_ptr = lmt_dir_state.text_dir_ptr;
+ if (dir_level(text_dir_ptr) == cur_level) {
+ /*tex remove */
+ halfword text_dir_tmp = node_next(text_dir_ptr);
+ tex_flush_node(text_dir_ptr);
+ lmt_dir_state.text_dir_ptr = text_dir_tmp;
+ }
+}
+
+void tex_set_math_dir(halfword d)
+{
+ if (valid_direction(d)) {
+ update_tex_math_direction(d);
+ }
+}
+
+void tex_set_par_dir(halfword d)
+{
+ if (valid_direction(d)) {
+ update_tex_par_direction(d);
+ }
+}
+
+void tex_set_text_dir(halfword d)
+{
+ if (valid_direction(d)) {
+ tex_inject_text_or_line_dir(d, 0);
+ update_tex_text_direction(d);
+ update_tex_internal_dir_state(internal_dir_state_par + 1);
+ }
+}
+
+void tex_set_line_dir(halfword d)
+{
+ if (valid_direction(d)) {
+ tex_inject_text_or_line_dir(d, 1);
+ update_tex_text_direction(d);
+ update_tex_internal_dir_state(internal_dir_state_par + 1);
+ }
+}
+
+void tex_set_box_dir(halfword b, singleword d)
+{
+ if (valid_direction(d)) {
+ box_dir(box_register(b)) = (singleword) d;
+ }
+}
diff --git a/source/luametatex/source/tex/texdirections.h b/source/luametatex/source/tex/texdirections.h
new file mode 100644
index 000000000..cb85c2485
--- /dev/null
+++ b/source/luametatex/source/tex/texdirections.h
@@ -0,0 +1,123 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_DIRECTIONS_H
+# define LMT_DIRECTIONS_H
+
+/*tex
+
+ Originally we had quarterwords but some compiler versions then keep complaining about
+ comparisons always being true (something enumeration not being integer or so). Interesting it
+ all worked well and suddenly gcc on openbsd complained. So, in the end I decided to just make
+ these fields halfwords too. It leaves room for growth ... who knows what is needed some day.
+
+ Actually, as we have only two subtypes now, I have considered:
+
+ \starttyping
+ 0 = begin l2r 2 = end l2r
+ 1 = begin r2l 3 = end r2l
+ \stoptyping
+
+ in which case a regular direction node becomes smaller (no dir_dir any more). But, it come with
+ a change at the \LUA\ end too, so it's a no-go in the end.
+
+ For the moment we keep some geometry values here but these might move to their own file when
+ there is more to it.
+
+*/
+
+# include "luametatex.h"
+
+typedef struct dir_state_info {
+ halfword text_dir_ptr;
+ /* alignment */
+ int padding;
+} dir_state_info;
+
+extern dir_state_info lmt_dir_state;
+
+typedef enum direction_codes {
+ direction_unknown = 0xFF,
+ direction_l2r = 0,
+ direction_r2l = 1
+} direction_codes;
+
+# define direction_def_value direction_l2r
+# define direction_min_value direction_l2r
+# define direction_max_value direction_r2l
+
+# define geometry_def_value 0
+# define geometry_min_value 0
+# define geometry_max_value 0xFF
+
+# define orientation_def_value 0
+# define orientation_min_value 0
+# define orientation_max_value 0x0FFF
+
+# define anchor_def_value 0
+# define anchor_min_value 0
+# define anchor_max_value 0x0FFF
+
+# define orientationonly(t) (t & 0x000F)
+
+# define valid_direction(d) ((d >= direction_min_value) && (d <= direction_max_value))
+# define valid_geometry(g) ((g >= geometry_min_value) && (g <= geometry_max_value))
+# define valid_orientation(o) ((o >= orientation_min_value) && (o <= orientation_max_value))
+# define valid_anchor(a) ((a >= anchor_min_value) && (a <= anchor_max_value))
+
+# define checked_direction_value(d) (valid_direction(d) ? d : direction_def_value)
+# define checked_geometry_value(g) (valid_geometry(g) ? g : geometry_def_value)
+# define checked_orientation_value(o) (valid_orientation(o) ? o : orientation_def_value)
+# define checked_anchor_value(a) (valid_anchor(a) ? a : anchor_def_value)
+
+# define check_direction_value(d) \
+ if (! valid_direction(d)) { \
+ d = direction_def_value; \
+ }
+
+/* will become texgeometry.h|c and dir also in geometry */
+
+inline static void tex_check_box_geometry(halfword n)
+{
+ if (box_x_offset(n) || box_y_offset(n)) {
+ tex_set_box_geometry(n, offset_geometry);
+ } else {
+ tex_unset_box_geometry(n, offset_geometry);
+ }
+ if (box_w_offset(n) || box_h_offset(n) || box_d_offset(n) || box_orientation(n)) {
+ tex_set_box_geometry(n, orientation_geometry);
+ } else {
+ tex_unset_box_geometry(n, orientation_geometry);
+ }
+ if (box_anchor(n) || box_source_anchor(n) || box_target_anchor(n)) {
+ tex_set_box_geometry(n, anchor_geometry);
+ } else {
+ tex_unset_box_geometry(n, anchor_geometry);
+ }
+}
+
+inline static void tex_set_box_direction(halfword b, halfword v)
+{
+ box_dir(b) = (singleword) checked_direction_value(v);
+}
+
+extern void tex_initialize_directions (void);
+extern void tex_cleanup_directions (void);
+extern halfword tex_new_dir (quarterword subtype, halfword direction);
+extern void tex_push_text_dir_ptr (halfword val);
+extern void tex_pop_text_dir_ptr (void);
+extern void tex_set_text_dir (halfword d);
+extern void tex_set_math_dir (halfword d);
+extern void tex_set_line_dir (halfword d);
+extern void tex_set_par_dir (halfword d);
+extern void tex_set_box_dir (halfword b, singleword d);
+
+# define swap_hang_indent(dir,indentation) (dir == dir_righttoleft && normalize_line_mode_permitted(normalize_line_mode_par, swap_hangindent_mode) ? ( - indentation) : indentation)
+# define swap_parshape_indent(dir,indentation,width) (dir == dir_righttoleft && normalize_line_mode_permitted(normalize_line_mode_par, swap_parshape_mode) ? (hsize_par - width - indentation) : indentation)
+
+extern halfword tex_update_dir_state (halfword p, halfword initial);
+extern halfword tex_sanitize_dir_state (halfword first, halfword last, halfword initial);
+extern halfword tex_complement_dir_state (halfword tail);
+
+# endif
diff --git a/source/luametatex/source/tex/texdumpdata.c b/source/luametatex/source/tex/texdumpdata.c
new file mode 100644
index 000000000..58f9e4442
--- /dev/null
+++ b/source/luametatex/source/tex/texdumpdata.c
@@ -0,0 +1,331 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+dump_state_info lmt_dump_state = {
+ .format_identifier = 0,
+ .format_name = 0
+};
+
+/*tex
+
+ 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.
+
+ 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.
+
+ Because most used processors are little endian, we flush that way, but after that we just stick
+ to the architecture. This also lets it come out as a readable 12 character (not nul terminated)
+ string on a little endian machine. By using integers we can be sure that when it's generated on
+ a different architecture the format is not seen as valid.
+
+*/
+
+/*
+
+ In \LUAMETATEX\ the code has been overhauled. The sections are better separated and we write
+ less to the file because we try to be sparse. Also, a more dynamic approach is used. In the
+ \CONTEXT\ macro package most of what goes into the format is \LUA\ bytecode.
+
+ We no longer hand endian related code here which saves swapping bytes on the most popular
+ architectures. We also maintain some statistics and have several points where we check if
+ we're still okay.
+
+ Here we only have the main chunk. The specific data sections are implemented where it makes
+ most sense.
+
+*/
+
+# define MAGIC_FORMAT_NUMBER_LE_1 0x58544D4C // 0x4C4D5458 // LMTX
+# define MAGIC_FORMAT_NUMBER_LE_2 0x5845542D // 0x2D544558 // -TEX
+# define MAGIC_FORMAT_NUMBER_LE_3 0x544D462D // 0x2D464D54 // -FMT
+
+static int tex_aux_report_dump_state(dumpstream f, int pos, const char *what)
+{
+ int tmp = ftell(f);
+ tex_print_int(tmp - pos);
+ tex_print_char(' ');
+ tex_print_str(what);
+ fflush(stdout);
+ return tmp;
+}
+
+/* todo: move more dumping to other files, then also the sizes. */
+
+static void tex_aux_dump_fingerprint(dumpstream f)
+{
+ dump_via_int(f, MAGIC_FORMAT_NUMBER_LE_1);
+ dump_via_int(f, MAGIC_FORMAT_NUMBER_LE_2);
+ dump_via_int(f, MAGIC_FORMAT_NUMBER_LE_3);
+ dump_via_int(f, luametatex_format_fingerprint);
+}
+
+static void tex_aux_undump_fingerprint(dumpstream f)
+{
+ int x;
+ undump_int(f, x);
+ if (x == MAGIC_FORMAT_NUMBER_LE_1) {
+ undump_int(f, x);
+ if (x == MAGIC_FORMAT_NUMBER_LE_2) {
+ undump_int(f, x);
+ if (x == MAGIC_FORMAT_NUMBER_LE_3) {
+ undump_int(f, x);
+ if (x == luametatex_format_fingerprint) {
+ return;
+ } else {
+ tex_fatal_undump_error("version id");
+ }
+ }
+ }
+ }
+ tex_fatal_undump_error("initial fingerprint");
+}
+
+static void tex_aux_dump_final_check(dumpstream f)
+{
+ dump_int(f, lmt_dump_state.format_identifier);
+ dump_int(f, lmt_dump_state.format_name);
+ dump_via_int(f, luametatex_format_fingerprint);
+}
+
+static void tex_aux_undump_final_check(dumpstream f)
+{
+ int x;
+ undump_int(f, lmt_dump_state.format_identifier);
+ if (lmt_dump_state.format_identifier < 0 || lmt_dump_state.format_identifier > lmt_string_pool_state.string_pool_data.ptr) {
+ goto BAD;
+ }
+ undump_int(f, lmt_dump_state.format_name);
+ if (lmt_dump_state.format_name < 0 || lmt_dump_state.format_name > lmt_string_pool_state.string_pool_data.ptr) {
+ goto BAD;
+ }
+ undump_int(f, x);
+ if (x == luametatex_format_fingerprint) {
+ return;
+ }
+ BAD:
+ tex_fatal_undump_error("final fingerprint");
+}
+
+static void tex_aux_create_fmt_name(void)
+{
+ lmt_print_state.selector = new_string_selector_code;
+ tex_print_format("%s %i.%i.%i",lmt_fileio_state.fmt_name, year_par, month_par, day_par);
+ lmt_dump_state.format_identifier = tex_make_string();
+ tex_print_str(lmt_fileio_state.job_name);
+ lmt_dump_state.format_name = tex_make_string();
+ lmt_print_state.selector = terminal_and_logfile_selector_code;
+}
+
+static void tex_aux_dump_preamble(dumpstream f)
+{
+ dump_via_int(f, hash_size);
+ dump_via_int(f, hash_prime);
+ dump_via_int(f, prim_size);
+ dump_via_int(f, prim_prime);
+ dump_int(f, lmt_hash_state.hash_data.allocated);
+ dump_int(f, lmt_hash_state.hash_data.ptr);
+ dump_int(f, lmt_hash_state.hash_data.top);
+}
+
+static void tex_aux_undump_preamble(dumpstream f)
+{
+ int x;
+ undump_int(f, x);
+ if (x != hash_size) {
+ goto BAD;
+ }
+ undump_int(f, x);
+ if (x != hash_prime) {
+ goto BAD;
+ }
+ undump_int(f, x);
+ if (x != prim_size) {
+ goto BAD;
+ }
+ undump_int(f, x);
+ if (x != prim_prime) {
+ goto BAD;
+ }
+ undump_int(f, lmt_hash_state.hash_data.allocated);
+ undump_int(f, lmt_hash_state.hash_data.ptr);
+ undump_int(f, lmt_hash_state.hash_data.top);
+ /*tex
+ We can consider moving all these allocaters to the start instead of this exception.
+ */
+ tex_initialize_hash_mem();
+ return;
+ BAD:
+ tex_fatal_undump_error("preamble");
+}
+
+void tex_store_fmt_file(void)
+{
+ int pos = 0;
+ dumpstream f = NULL;
+
+ /*tex
+ 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 (lmt_save_state.save_stack_data.ptr != 0) {
+ tex_handle_error(
+ succumb_error_type,
+ "You can't dump inside a group",
+ "'{...\\dump}' is a no-no."
+ );
+ }
+
+ /*tex
+ We don't store some things.
+ */
+
+ tex_dispose_specification_nodes();
+
+ /*tex
+ Create the |format_ident|, open the format file, and inform the user that dumping has begun.
+ */
+
+ {
+ int callback_id = lmt_callback_defined(pre_dump_callback);
+ if (callback_id > 0) {
+ (void) lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ }
+ }
+
+ /*tex
+ We report the usual plus some more statistics. When something is wrong the machine just
+ quits, hopefully with some meaningful error. We always create the format in normal log and
+ terminal mode. We create a format name first because we also use that in error reporting.
+ */
+
+ tex_aux_create_fmt_name();
+
+ f = tex_open_fmt_file(1);
+ if (! f) {
+ tex_formatted_error("system", "format file '%s' cannot be opened for writing", lmt_fileio_state.fmt_name);
+ return;
+ }
+
+ tex_print_nlp();
+ tex_print_format("Dumping format '%T' in file '%s': ", lmt_dump_state.format_identifier, lmt_fileio_state.fmt_name);
+ fflush(stdout);
+
+ tex_compact_tokens();
+ tex_compact_string_pool();
+
+ tex_aux_dump_fingerprint(f); pos = tex_aux_report_dump_state(f, pos, "fingerprint + ");
+ lmt_dump_engine_info(f); pos = tex_aux_report_dump_state(f, pos, "engine + ");
+ tex_aux_dump_preamble(f); pos = tex_aux_report_dump_state(f, pos, "preamble + ");
+ tex_dump_constants(f); pos = tex_aux_report_dump_state(f, pos, "constants + ");
+ tex_dump_string_pool(f); pos = tex_aux_report_dump_state(f, pos, "stringpool + ");
+ tex_dump_node_mem(f); pos = tex_aux_report_dump_state(f, pos, "nodes + ");
+ tex_dump_token_mem(f); pos = tex_aux_report_dump_state(f, pos, "tokens + ");
+ tex_dump_equivalents_mem(f); pos = tex_aux_report_dump_state(f, pos, "equivalents + ");
+ tex_dump_math_codes(f); pos = tex_aux_report_dump_state(f, pos, "math codes + ");
+ tex_dump_text_codes(f); pos = tex_aux_report_dump_state(f, pos, "text codes + ");
+ tex_dump_primitives(f); pos = tex_aux_report_dump_state(f, pos, "primitives + ");
+ tex_dump_hashtable(f); pos = tex_aux_report_dump_state(f, pos, "hashtable + ");
+ tex_dump_font_data(f); pos = tex_aux_report_dump_state(f, pos, "fonts + ");
+ tex_dump_math_data(f); pos = tex_aux_report_dump_state(f, pos, "math + ");
+ tex_dump_language_data(f); pos = tex_aux_report_dump_state(f, pos, "language + ");
+ tex_dump_insert_data(f); pos = tex_aux_report_dump_state(f, pos, "insert + ");
+ lmt_dump_registers(f); pos = tex_aux_report_dump_state(f, pos, "bytecodes + ");
+ tex_aux_dump_final_check(f); pos = tex_aux_report_dump_state(f, pos, "housekeeping = ");
+
+ tex_aux_report_dump_state(f, 0, "total.");
+ tex_close_fmt_file(f);
+ tex_print_ln();
+
+}
+
+/*tex
+
+ 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.
+
+ 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|.
+
+*/
+
+int tex_fatal_undump_error(const char *s)
+{
+ tex_emergency_message("system", "fatal format error, loading file '%s' failed with bad '%s' data, remake the format", emergency_fmt_name, s);
+ return tex_emergency_exit();
+}
+
+//define undumping(s) printf("undumping: %s\n",s); fflush(stdout);
+# define undumping(s)
+
+static void tex_aux_undump_fmt_data(dumpstream f)
+{
+ undumping("warmingup")
+
+ undumping("fingerprint") tex_aux_undump_fingerprint(f);
+ undumping("engineinfo") lmt_undump_engine_info(f);
+ undumping("preamble") tex_aux_undump_preamble(f);
+ undumping("constants") tex_undump_constants(f);
+ undumping("strings") tex_undump_string_pool(f);
+ undumping("nodes") tex_undump_node_mem(f);
+ undumping("tokens") tex_undump_token_mem(f);
+ undumping("equivalents") tex_undump_equivalents_mem(f);
+ undumping("mathcodes") tex_undump_math_codes(f);
+ undumping("textcodes") tex_undump_text_codes(f);
+ undumping("primitives") tex_undump_primitives(f);
+ undumping("hashtable") tex_undump_hashtable(f);
+ undumping("fonts") tex_undump_font_data(f);
+ undumping("math") tex_undump_math_data(f);
+ undumping("languages") tex_undump_language_data(f);
+ undumping("inserts") tex_undump_insert_data(f);
+ undumping("bytecodes") lmt_undump_registers(f);
+ undumping("finalcheck") tex_aux_undump_final_check(f);
+
+ undumping("done")
+
+ /*tex This should go elsewhere. */
+
+ cur_list.prev_depth = ignore_depth;
+}
+
+/*
+ The next code plays nice but on an error we exit anyway so some code is never reached in that
+ case.
+*/
+
+int tex_load_fmt_file(void)
+{
+ dumpstream f = tex_open_fmt_file(0);
+ if (f) {
+ tex_aux_undump_fmt_data(f);
+ tex_close_fmt_file(f);
+ return 1;
+ } else {
+ return tex_fatal_undump_error("filehandle");
+ }
+}
+
+void tex_initialize_dump_state(void)
+{
+ lmt_dump_state.format_name = get_nullstr();
+ if (lmt_main_state.run_state == initializing_state) {
+ lmt_dump_state.format_identifier = tex_maketexstring(" (INITEX)");
+ } else {
+ lmt_dump_state.format_identifier = 0;
+ }
+}
diff --git a/source/luametatex/source/tex/texdumpdata.h b/source/luametatex/source/tex/texdumpdata.h
new file mode 100644
index 000000000..6a9e11a7d
--- /dev/null
+++ b/source/luametatex/source/tex/texdumpdata.h
@@ -0,0 +1,105 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_DUMPDATA_H
+# define LMT_DUMPDATA_H
+
+/*tex
+
+ Originally the dump file was a memory dump, in \TEX\ called a format and in \NETAFONT\ a base
+ and in \METAPOST\ a mem file. The \TEX\ program could reload that dump file and have a fast
+ start. In addition a pool file was used to store strings. Because it was a memory dump. It was
+ also pretty system dependent.
+
+ When \WEBC\ showed up, \TEX\ installations got distributed on \CDROM\ and later \DVD, and
+ because one could run them from that medium, format files were shared. In order to do that the
+ file had to be endian neutral. Unfortunately the choice was such that for the most commonly
+ architecture (intel) the dump items had to be swapped. This could slow down a startup, depending
+ on how rigourous a compiler of operating system was in testing (it is a reason why startup on
+ \MSWINDOWS\ was somewhat slower).
+
+ Because in \LUATEX\ we can also store \LUA\ bytecodes it made no sense to take that portability
+ aspect into account. The format file also got gzipped which at that time sped up loading. Later
+ in the project the endian swappign was removed so we gained a bit more.
+
+ Because a format file that doesn't match an engine can actually result in a crash, we decided to
+ come up with amore robust approach: we use a magic number to register the version of the format!
+ Normally this number only increments when we add a new primitive of change command codes. At
+ some point in \LUATEX\ development we started with 907 which is the sum of the values of the
+ bytes of \quote {don knuth}.
+
+ We sometimes also bump when the binary format (bytecode) of \LUA\ has changed in such a way that
+ the loader doesn't detect it. But that doesn't always help either because the cache is still
+ problematic then. There we actually hard code a different number then (a simple patch of a \LUA\
+ file).
+
+ By the time that the \LUAMETATEX\ code as in a state to be released, it became time to think
+ about a number that was definitely different from \LUATEX\ so here it is:
+
+ \starttyping
+ initial = 2020//4 - 2020//100 + 2020//400 = 490
+ \stoptyping
+
+ Although \LUAMETATEX\ is already a bit older, we sort of released in leapyear 2020 so we take
+ the number of leapyears since zero (which is kind of \type {\undefined} as starting point). This
+ number actually jumps whenever something affects the format file (which can be an extra command or
+ some reshuffling of codes) so it is not always an indication of something really need.
+
+ So to summarize: we don't share formats across architectures and operating systems, we use the
+ native endian property of an architecture, we don't compress, and we bump a magic number so that
+ we can intercept a potential crash. So much for a bit of history.
+
+ We also bump the fingerprint when we have a new version of \LUA, just to play safe in case some
+ bytecodes have changed.
+
+*/
+
+# define luametatex_format_fingerprint 670
+
+/* These end up in the string pool. */
+
+typedef struct dump_state_info {
+ strnumber format_identifier;
+ strnumber format_name;
+} dump_state_info;
+
+extern dump_state_info lmt_dump_state;
+
+extern void tex_store_fmt_file (void);
+extern int tex_load_fmt_file (void);
+extern int tex_fatal_undump_error (const char *s);
+extern void tex_initialize_dump_state (void);
+
+# define dump_items(f,p,item_size,nitems) fwrite((void *) p, (size_t) item_size, (size_t) nitems, f)
+# define undump_items(f,p,item_size,nitems) { if (fread ((void *) p, (size_t) item_size, (size_t) nitems, f)) { } }
+
+# define dump_things(f,base,len) dump_items(f, (char *) &(base), sizeof (base), (int) (len))
+# define undump_things(f,base,len) undump_items(f, (char *) &(base), sizeof (base), (int) (len))
+
+# define dump_int(f,x) dump_things(f,x,1)
+# define undump_int(f,x) undump_things(f,x,1)
+
+/*tex
+
+ Because sometimes we dump constants or the result of a function call we have |dump_via_int|
+ that puts the number into a variable first. Most integers come from structs and arrays.
+ Performance wise there is not that much gain.
+
+*/
+
+# define dump_via_int(f,x) do { \
+ int x_val = (x); \
+ dump_int(f,x_val); \
+} while (0)
+
+# define dump_string(f,a) \
+ if (a) { \
+ int x = (int)strlen(a) + 1; \
+ dump_int(f,x); \
+ dump_things(f,*a, x); \
+ } else { \
+ dump_via_int(f,0); \
+ }
+
+# endif
diff --git a/source/luametatex/source/tex/texequivalents.c b/source/luametatex/source/tex/texequivalents.c
new file mode 100644
index 000000000..7cc249a2e
--- /dev/null
+++ b/source/luametatex/source/tex/texequivalents.c
@@ -0,0 +1,1964 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ The nested structure provided by |\char'173| \unknown\ |\char'175| groups in \TEX\ means that
+ |eqtb| entries valid in outer groups should be saved and restored later if they are overridden
+ inside the braces. When a new |eqtb| value is being assigned, the program therefore checks to
+ see if the previous entry belongs to an outer level. In such a case, the old value is placed on
+ the |save_stack| just before the new value enters |eqtb|. At the end of a grouping level, i.e.,
+ when the right brace is sensed, the |save_stack| is used to restore the outer values, and the
+ inner ones are destroyed.
+
+ Entries on the |save_stack| are of type |save_record|. The top item on this stack is
+ |save_stack[p]|, where |p=save_ptr-1|; it contains three fields called |save_type|, |save_level|,
+ and |save_value|, and it is interpreted in one of four ways:
+
+ \startitemize[n]
+
+ \startitem
+ If |save_type(p) = restore_old_value|, then |save_value(p)| is a location in |eqtb| whose
+ current value should be destroyed at the end of the current group and replaced by
+ |save_word(p-1)| (|save_type(p-1) == saved_eqtb|). Furthermore if |save_value(p) >= int_base|,
+ then |save_level(p)| should replace the corresponding entry in |xeq_level| (if |save_value(p)
+ < int_base|, then the level is part of |save_word(p-1)|).
+ \stopitem
+
+ \startitem
+ If |save_type(p) = restore_zero|, then |save_value(p)| is a location in |eqtb| whose current
+ value should be destroyed at the end of the current group, when it should be replaced by the
+ current value of |eqtb[undefined_control_sequence]|.
+ \stopitem
+
+ \startitem
+ If |save_type(p) = insert_token|, then |save_value(p)| is a token that should be inserted
+ into \TeX's input when the current group ends.
+ \stopitem
+
+ \startitem
+ If |save_type(p) = level_boundary|, then |save_level(p)| is a code explaining what kind of
+ group we were previously in, and |save_value(p)| points to the level boundary word at the
+ bottom of the entries for that group. Furthermore, |save_value(p-1)| contains the source
+ line number at which the current level of grouping was entered, this field has itself a
+ type: |save_type(p-1) == saved_line|.
+ \stopitem
+
+ \stopitemize
+
+ Besides this \quote {official} use, various subroutines push temporary variables on the save
+ stack when it is handy to do so. These all have an explicit |save_type|, and they are:
+
+ \starttabulate
+ \NC |saved_adjust| \NC signifies an adjustment is beging scanned \NC\NR
+ \NC |saved_insert| \NC an insertion is being scanned \NC\NR
+ \NC |saved_disc| \NC the |\discretionary| sublist we are working on right now \NC\NR
+ \NC |saved_boxtype| \NC whether a |\localbox| is |\left| or |\right| \NC\NR
+ \NC |saved_textdir| \NC a text direction to be restored \NC\NR
+ \NC |saved_eqno| \NC diffentiates between |\eqno| and |\leqno| \NC\NR
+ \NC |saved_choices| \NC the |\mathchoices| sublist we are working on right now \NC\NR
+ \NC |saved_above| \NC used for the \LUAMETATEX\ above variants \NC\NR
+ \NC |saved_math| \NC and interrupted math list \NC\NR
+ \NC |saved_boxcontext| \NC the box context value \NC\NR
+ \NC |saved_boxspec| \NC the box |to| or |spread| specification \NC\NR
+ \NC |saved_boxdir| \NC the box |dir| specification \NC\NR
+ \NC |saved_boxattr| \NC the box |attr| specification \NC\NR
+ \NC |saved_boxpack| \NC the box |pack| specification \NC\NR
+ \NC |...| \NC some more in \LUATEX\ and \LUAMETATEX \NC\NR
+ \stoptabulate
+
+ The global variable |cur_group| keeps track of what sort of group we are currently in. Another
+ global variable, |cur_boundary|, points to the topmost |level_boundary| word. And |cur_level|
+ is the current depth of nesting. The routines are designed to preserve the condition that no
+ entry in the |save_stack| or in |eqtb| ever has a level greater than |cur_level|.
+
+*/
+
+save_state_info lmt_save_state = {
+ .save_stack = NULL,
+ .save_stack_data = {
+ .minimum = min_save_size,
+ .maximum = max_save_size,
+ .size = siz_save_size,
+ .step = stp_save_size,
+ .allocated = 0,
+ .itemsize = sizeof(save_record),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .current_level = 0,
+ .current_group = 0,
+ .current_boundary = 0,
+ .padding = 0,
+};
+
+/*tex
+
+ The comments below are (of course) coming from \LUATEX's ancestor and are still valid! However,
+ in \LUATEX\ we use \UTF\ instead of \ASCII, have attributes, have more primites, etc. But the
+ principles remain the same. We are not 100\% compatible in output and will never be.
+
+*/
+
+static void tex_aux_show_eqtb(halfword n);
+
+static void tex_aux_diagnostic_trace(halfword p, const char *s)
+{
+ tex_begin_diagnostic();
+ /* print_format ... */
+ tex_print_char('{');
+ tex_print_str(s);
+ tex_print_char(' ');
+ tex_aux_show_eqtb(p);
+ tex_print_char('}');
+ tex_end_diagnostic();
+}
+
+/*tex
+
+ Now that we have studied the data structures for \TEX's semantic routines (in other modules),
+ we ought to consider the data structures used by its syntactic routines. In other words, our
+ next concern will be the tables that \TEX\ looks at when it is scanning what the user has
+ written.
+
+ The biggest and most important such table is called |eqtb|. It holds the current \quote
+ {equivalents} of things; i.e., it explains what things mean or what their current values are,
+ for all quantities that are subject to the nesting structure provided by \TEX's grouping
+ mechanism. There are six parts to |eqtb|:
+
+ \startitemize[n]
+
+ \startitem
+ |eqtb[null_cs]| holds the current equivalent of the zero-length control sequence.
+ \stopitem
+
+ \startitem
+ |eqtb[hash_base..(glue_base-1)]| holds the current equivalents of single- and multiletter
+ control sequences.
+ \stopitem
+
+ \startitem
+ |eqtb[glue_base..(local_base-1)]| holds the current equivalents of glue parameters like
+ the current baselineskip.
+ \stopitem
+
+ \startitem
+ |eqtb[local_base..(int_base-1)]| holds the current equivalents of local halfword
+ quantities like the current box registers, the current \quote {catcodes}, the current font,
+ and a pointer to the current paragraph shape.
+ \stopitem
+
+ \startitem
+ |eqtb[int_base .. (dimen_base-1)]| holds the current equivalents of fullword integer
+ parameters like the current hyphenation penalty.
+ \stopitem
+
+ \startitem
+ |eqtb[dimen_base .. eqtb_size]| holds the current equivalents of fullword dimension
+ parameters like the current hsize or amount of hanging indentation.
+ \stopitem
+
+ \stopitemize
+
+ Note that, for example, the current amount of baselineskip glue is determined by the setting of
+ a particular location in region~3 of |eqtb|, while the current meaning of the control sequence
+ |\baselineskip| (which might have been changed by |\def| or |\let|) appears in region~2.
+
+ The last two regions of |eqtb| have fullword values instead of the three fields |eq_level|,
+ |eq_type|, and |equiv|. An |eq_type| is unnecessary, but \TEX\ needs to store the |eq_level|
+ information in another array called |xeq_level|.
+
+ The last statement is no longer true. We have plenty of room in the 64 bit memory words now so
+ we no longer need the parallel |x| array. For the moment we keep the commented code.
+
+*/
+
+// equivalents_state_info lmt_equivalents_state = {
+// };
+
+void tex_initialize_levels(void)
+{
+ cur_level = level_one;
+ cur_group = bottom_level_group;
+ lmt_scanner_state.last_cs_name = null_cs;
+}
+
+void tex_initialize_undefined_cs(void)
+{
+ set_eq_type(undefined_control_sequence, undefined_cs_cmd);
+ set_eq_flag(undefined_control_sequence, 0);
+ set_eq_value(undefined_control_sequence, null);
+ set_eq_level(undefined_control_sequence, level_zero);
+}
+
+void tex_dump_equivalents_mem(dumpstream f)
+{
+ /*tex
+ Dump regions 1 to 4 of |eqtb|, the table of equivalents: glue muglue toks boxes. 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)$.
+ */
+ int index = null_cs;
+ do {
+ int different = 1;
+ int equivalent = 0;
+ int j = index;
+ while (j < eqtb_size - 1) {
+ if (equal_eqtb_entries(j, j + 1)) {
+ ++equivalent;
+ goto FOUND1;
+ } else {
+ ++different;
+ }
+ ++j;
+ }
+ /*tex |j = int_base-1| */
+ goto DONE1;
+ FOUND1:
+ j++;
+ while (j < eqtb_size - 1) {
+ if (equal_eqtb_entries(j, j + 1)) {
+ ++equivalent;
+ } else {
+ goto DONE1;
+ }
+ ++j;
+ }
+ DONE1:
+ // printf("index %i, different %i, equivalent %i\n",index,different,equivalent);
+ dump_int(f, different);
+ dump_things(f, lmt_hash_state.eqtb[index], different);
+ dump_int(f, equivalent);
+ index = index + different + equivalent;
+ } while (index <= eqtb_size);
+ /*tex Dump the |hash_extra| part: */
+ dump_int(f, lmt_hash_state.hash_data.ptr);
+ if (lmt_hash_state.hash_data.ptr > 0) {
+ dump_things(f, lmt_hash_state.eqtb[eqtb_size + 1], lmt_hash_state.hash_data.ptr);
+ }
+ /*tex A special register. */
+ dump_int(f, lmt_token_state.par_loc);
+ /* dump_int(f, lmt_token_state.line_par_loc); */ /*tex See note in textoken.c|. */
+}
+
+void tex_undump_equivalents_mem(dumpstream f)
+{
+ /*tex Undump regions 1 to 6 of the table of equivalents |eqtb|. */
+ int index = null_cs;
+ do {
+ int different;
+ int equivalent;
+ undump_int(f, different);
+ if (different > 0) {
+ undump_things(f, lmt_hash_state.eqtb[index], different);
+ }
+ undump_int(f, equivalent);
+ // printf("index %i, different %i, equivalent %i\n",index,different,equivalent);
+ if (equivalent > 0) {
+ int last = index + different - 1;
+ for (int i = 1; i <= equivalent; i++) {
+ lmt_hash_state.eqtb[last + i] = lmt_hash_state.eqtb[last];
+ }
+ }
+ index = index + different + equivalent;
+ } while (index <= eqtb_size);
+ /*tex Undump |hash_extra| part. */
+ undump_int(f, lmt_hash_state.hash_data.ptr);
+ if (lmt_hash_state.hash_data.ptr > 0) {
+ /* we get a warning on possible overrun here */
+ undump_things(f, lmt_hash_state.eqtb[eqtb_size + 1], lmt_hash_state.hash_data.ptr);
+ }
+ undump_int(f, lmt_token_state.par_loc);
+ if (lmt_token_state.par_loc >= hash_base && lmt_token_state.par_loc <= lmt_hash_state.hash_data.top) {
+ lmt_token_state.par_token = cs_token_flag + lmt_token_state.par_loc;
+ } else {
+ tex_fatal_undump_error("parloc");
+ }
+ /* undump_int(f, lmt_token_state.line_par_loc); */
+ /* if (lmt_token_state.line_par_loc >= hash_base && lmt_token_state.line_par_loc <= lmt_hash_state.hash_data.top) { */
+ /* lmt_token_state.line_par_token = cs_token_flag + lmt_token_state.line_par_loc; */
+ /* } else { */
+ /* tex_fatal_undump_error("lineparloc"); */
+ /* } */
+ return;
+}
+
+/*tex
+
+ At this time it might be a good idea for the reader to review the introduction to |eqtb| that
+ was given above just before the long lists of parameter names. Recall that the \quote {outer
+ level} of the program is |level_one|, since undefined control sequences are assumed to be \quote
+ {defined} at |level_zero|.
+
+ The following function is used to test if there is room for up to eight more entries on
+ |save_stack|. By making a conservative test like this, we can get by with testing for overflow
+ in only a few places.
+
+ We now let the save stack dynamically grow. In practice the stack is small but when a large one
+ is needed, the overhead is probably neglectable compared to what the macro need.
+
+*/
+
+# define reserved_save_stack_slots 32 /* We need quite some for boxes so we bump it. */
+
+void tex_initialize_save_stack(void)
+{
+ int size = lmt_save_state.save_stack_data.minimum;
+ lmt_save_state.save_stack = aux_allocate_clear_array(sizeof(save_record), lmt_save_state.save_stack_data.step, reserved_save_stack_slots);
+ if (lmt_save_state.save_stack) {
+ lmt_save_state.save_stack_data.allocated = lmt_save_state.save_stack_data.step;
+ } else {
+ tex_overflow_error("save", size);
+ }
+}
+
+static int tex_room_on_save_stack(void)
+{
+ int top = lmt_save_state.save_stack_data.ptr;
+ if (top > lmt_save_state.save_stack_data.top) {
+ lmt_save_state.save_stack_data.top = top;
+ if (top > lmt_save_state.save_stack_data.allocated) {
+ save_record *tmp = NULL;
+ top = lmt_save_state.save_stack_data.allocated + lmt_save_state.save_stack_data.step;
+ if (top > lmt_save_state.save_stack_data.size) {
+ top = lmt_save_state.save_stack_data.size;
+ }
+ if (top > lmt_save_state.save_stack_data.allocated) {
+ top = lmt_save_state.save_stack_data.allocated + lmt_save_state.save_stack_data.step;
+ lmt_save_state.save_stack_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_save_state.save_stack, sizeof(save_record), top, reserved_save_stack_slots);
+ lmt_save_state.save_stack = tmp;
+ }
+ lmt_run_memory_callback("save", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("save", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+void tex_save_halfword_on_stack(quarterword t, halfword v)
+{
+ if (tex_room_on_save_stack()) {
+ tex_set_saved_record(0, t, 0, v);
+ ++lmt_save_state.save_stack_data.ptr;
+ }
+}
+
+/*tex
+
+ Procedure |new_save_level| is called when a group begins. The argument is a group identification
+ code like |hbox_group|. After calling this routine, it is safe to put six more entries on
+ |save_stack|.
+
+ In some cases integer-valued items are placed onto the |save_stack| just below a |level_boundary|
+ word, because this is a convenient place to keep information that is supposed to \quote {pop up}
+ just when the group has finished. For example, when |\hbox to 100pt| is being treated, the 100pt
+ dimension is stored on |save_stack| just before |new_save_level| is called.
+
+ The |group_trace| procedure is called when a new level of grouping begins (|e=false|) or ends
+ (|e = true|) with |saved_value (-1)| containing the line number.
+
+*/
+
+static void tex_aux_group_trace(int g)
+{
+ tex_begin_diagnostic();
+ tex_print_format(g ? "{leaving %G}" : "{entering %G}", g);
+ tex_end_diagnostic();
+}
+
+/*tex
+
+ A group entered (or a conditional started) in one file may end in a different file. Such
+ slight anomalies, although perfectly legitimate, may cause errors that are difficult to
+ locate. In order to be able to give a warning message when such anomalies occur, \ETEX\
+ uses the |grp_stack| and |if_stack| arrays to record the initial |cur_boundary| and
+ |condition_ptr| values for each input file.
+
+ When a group ends that was apparently entered in a different input file, the |group_warning|
+ procedure is invoked in order to update the |grp_stack|. If moreover |\tracingnesting| is
+ positive we want to give a warning message. The situation is, however, somewhat complicated
+ by two facts:
+
+ \startitemize[n,packed]
+ \startitem
+ There may be |grp_stack| elements without a corresponding |\input| file or
+ |\scantokens| pseudo file (e.g., error insertions from the terminal); and
+ \stopitem
+ \startitem
+ the relevant information is recorded in the |name_field| of the |input_stack| only
+ loosely synchronized with the |in_open| variable indexing |grp_stack|.
+ \stopitem
+ \stopitemize
+
+*/
+
+static void tex_aux_group_warning(void)
+{
+ /*tex do we need a warning? */
+ int w = 0;
+ /*tex index into |grp_stack| */
+ int i = lmt_input_state.in_stack_data.ptr;
+ lmt_input_state.base_ptr = lmt_input_state.input_stack_data.ptr;
+ /*tex store current state */
+ lmt_input_state.input_stack[lmt_input_state.base_ptr] = lmt_input_state.cur_input;
+ while ((lmt_input_state.in_stack[i].group == cur_boundary) && (i > 0)) {
+ /*tex
+
+ Set variable |w| to indicate if this case should be reported. This code scans the input
+ stack in order to determine the type of the current input file.
+
+ */
+ if (tracing_nesting_par > 0) {
+ while ((lmt_input_state.input_stack[lmt_input_state.base_ptr].state == token_list_state) || (lmt_input_state.input_stack[lmt_input_state.base_ptr].index > i)) {
+ --lmt_input_state.base_ptr;
+ }
+ if (lmt_input_state.input_stack[lmt_input_state.base_ptr].name > 17) {
+ /*tex |> max_file_input_code| .. hm */
+ w = 1;
+ }
+ }
+ lmt_input_state.in_stack[i].group = save_value(lmt_save_state.save_stack_data.ptr);
+ --i;
+ }
+ if (w) {
+ tex_begin_diagnostic();
+ tex_print_format("[warning: end of %G of a different file]", 1);
+ tex_end_diagnostic();
+ if (tracing_nesting_par > 1) {
+ tex_show_context();
+ }
+ if (lmt_error_state.history == spotless) {
+ lmt_error_state.history = warning_issued;
+ }
+ }
+}
+
+void tex_new_save_level(quarterword c)
+{
+ /*tex We begin a new level of grouping. */
+ if (tex_room_on_save_stack()) {
+ save_attribute_state_before();
+ tex_set_saved_record(saved_group_line_number, saved_line_number, 0, lmt_input_state.input_line);
+ tex_set_saved_record(saved_group_level_boundary, level_boundary, cur_group, cur_boundary);
+ /*tex eventually we will have bumped |lmt_save_state.save_stack_data.ptr| by |saved_group_n_of_items|! */
+ ++lmt_save_state.save_stack_data.ptr;
+ if (cur_level == max_quarterword) {
+ tex_overflow_error("grouping levels", max_quarterword - min_quarterword);
+ }
+ /*tex We quit if |(cur_level+1)| is too big to be stored in |eqtb|. */
+ cur_boundary = lmt_save_state.save_stack_data.ptr;
+ cur_group = c;
+ if (tracing_groups_par > 0) {
+ tex_aux_group_trace(0);
+ }
+ ++cur_level;
+ ++lmt_save_state.save_stack_data.ptr;
+ save_attribute_state_after();
+ if (end_of_group_par) {
+ update_tex_end_of_group(null);
+ }
+ /* no_end_group_par = null; */
+ }
+}
+
+int tex_saved_line_at_level(void)
+{
+ return lmt_save_state.save_stack_data.ptr > 0 ? (saved_value(-1) > 0 ? saved_value(-1) : 0) : 0;
+}
+
+/*tex
+
+ The |\showgroups| command displays all currently active grouping levels. The modifications of
+ \TEX\ required for the display produced by the |show_save_groups| procedure were first discussed
+ by Donald~E. Knuth in {\em TUGboat} {\bf 11}, 165--170 and 499--511, 1990.
+
+ In order to understand a group type we also have to know its mode. Since unrestricted horizontal
+ modes are not associated with grouping, they are skipped when traversing the semantic nest.
+
+ I have to admit that I never used (or needed) this so we might as well drop it from \LUAMETATEX\
+ and given the already extensive tracing we can decide to drop it.
+
+ The output is not (entirely) downward compatible which is no big deal because we output some more
+ details anyway.
+*/
+
+static int tex_aux_found_save_type(int id)
+{
+ int i = -1;
+ while (saved_valid(i) && saved_type(i) != id) {
+ i--;
+ }
+ return i;
+}
+
+static int tex_aux_save_value(int id)
+{
+ int i = tex_aux_found_save_type(id);
+ return i ? saved_value(i) : 0;
+}
+
+static int tex_aux_saved_box_spec(halfword *packing, halfword *amount)
+{
+ int i = tex_aux_found_save_type(saved_box_spec);
+ if (i) {
+ *packing = saved_level(i);
+ *amount = saved_value(i);
+ } else {
+ *packing = 0;
+ *amount = 0;
+ }
+ return (*amount != 0);
+}
+
+static void tex_aux_show_group_count(int n)
+{
+ for (int i = 1; i <= n; i++) {
+ tex_print_str("{}");
+ }
+}
+
+void tex_show_save_groups(void)
+{
+ int pointer = lmt_nest_state.nest_data.ptr;
+ int saved_pointer = lmt_save_state.save_stack_data.ptr;
+ quarterword saved_level = cur_level;
+ quarterword saved_group = cur_group;
+ halfword saved_tracing = tracing_levels_par;
+ int alignmentstate = 1; /* to keep track of alignments */
+ const char *package = NULL;
+ lmt_save_state.save_stack_data.ptr = cur_boundary;
+ --cur_level;
+ tracing_levels_par |= tracing_levels_group;
+ while (1) {
+ int mode;
+ tex_print_levels();
+ tex_print_group(1);
+ if (cur_group == bottom_level_group) {
+ goto DONE;
+ }
+ do {
+ mode = lmt_nest_state.nest[pointer].mode;
+ if (pointer > 0) {
+ --pointer;
+ } else {
+ mode = vmode;
+ }
+ } while (mode == hmode);
+ tex_print_str(": ");
+ switch (cur_group) {
+ case simple_group:
+ ++pointer;
+ goto FOUND2;
+ case hbox_group:
+ case adjusted_hbox_group:
+ package = "hbox";
+ break;
+ case vbox_group:
+ package = "vbox";
+ break;
+ case vtop_group:
+ package = "vtop";
+ break;
+ case align_group:
+ if (alignmentstate == 0) {
+ package = (mode == -vmode) ? "halign" : "valign";
+ alignmentstate = 1;
+ goto FOUND1;
+ } else {
+ if (alignmentstate == 1) {
+ tex_print_str("align entry");
+ } else {
+ tex_print_str_esc("cr");
+ }
+ if (pointer >= alignmentstate) {
+ pointer -= alignmentstate;
+ }
+ alignmentstate = 0;
+ goto FOUND2;
+ }
+ case no_align_group:
+ ++pointer;
+ alignmentstate = -1;
+ tex_print_str_esc("noalign");
+ goto FOUND2;
+ case output_group:
+ tex_print_str_esc("output");
+ goto FOUND2;
+ case math_group:
+ goto FOUND2;
+ case discretionary_group:
+ tex_print_str_esc("discretionary");
+ tex_aux_show_group_count(tex_aux_save_value(saved_discretionary_item_component));
+ goto FOUND2;
+ case math_fraction_group:
+ tex_print_str_esc("fraction");
+ tex_aux_show_group_count(tex_aux_save_value(saved_fraction_item_variant));
+ goto FOUND2;
+ case math_operator_group:
+ tex_print_str_esc("operator");
+ tex_aux_show_group_count(tex_aux_save_value(saved_operator_item_variant));
+ goto FOUND2;
+ case math_choice_group:
+ tex_print_str_esc("mathchoice");
+ tex_aux_show_group_count(tex_aux_save_value(saved_choice_item_count));
+ goto FOUND2;
+ case insert_group:
+ tex_print_str_esc("insert");
+ tex_print_int(tex_aux_save_value(saved_insert_item_index));
+ goto FOUND2;
+ case vadjust_group:
+ tex_print_str_esc("vadjust");
+ if (tex_aux_save_value(saved_adjust_item_location) == pre_adjust_code) {
+ tex_print_str(" pre");
+ }
+ if (tex_aux_save_value(saved_adjust_item_options) & adjust_option_before) {
+ tex_print_str(" before");
+ }
+ goto FOUND2;
+ case vcenter_group:
+ package = "vcenter";
+ goto FOUND1;
+ case also_simple_group:
+ case semi_simple_group:
+ ++pointer;
+ tex_print_str_esc("begingroup");
+ goto FOUND2;
+//case math_simple_group:
+// ++pointer;
+// tex_print_str_esc("beginmathgroup");
+// goto FOUND2;
+ case math_shift_group:
+ if (mode == mmode) {
+ tex_print_char('$');
+ } else if (lmt_nest_state.nest[pointer].mode == mmode) {
+ tex_print_cmd_chr(equation_number_cmd, tex_aux_save_value(saved_equation_number_item_location));
+ goto FOUND2;
+ }
+ tex_print_char('$');
+ goto FOUND2;
+ case math_fence_group:
+ /* kind of ugly ... maybe also save that one */ /* todo: operator */
+ tex_print_str_esc((node_subtype(lmt_nest_state.nest[pointer + 1].delim) == left_fence_side) ? "left" : "middle");
+ goto FOUND2;
+ default:
+ tex_confusion("show groups");
+ break;
+ }
+ /*tex Show the box context */
+ {
+ int i = tex_aux_save_value(saved_full_spec_item_context);;
+ if (i) {
+ if (i < box_flag) {
+ /* this is pretty horrible and likely wrong */
+ singleword cmd = (abs(lmt_nest_state.nest[pointer].mode) == vmode) ? hmove_cmd : vmove_cmd;
+ tex_print_cmd_chr(cmd, (i > 0) ? move_forward_code : move_backward_code);
+ tex_print_dimension(abs(i), pt_unit);
+ } else if (i <= max_global_box_flag) {
+ if (i >= global_box_flag) {
+ tex_print_str_esc("global");
+ i -= (global_box_flag - box_flag);
+ }
+ tex_print_str_esc("setbox");
+ tex_print_int(i - box_flag);
+ tex_print_char('=');
+ } else {
+ switch (i) {
+ case a_leaders_flag:
+ tex_print_cmd_chr(leader_cmd, a_leaders);
+ break;
+ case c_leaders_flag:
+ tex_print_cmd_chr(leader_cmd, c_leaders);
+ break;
+ case x_leaders_flag:
+ tex_print_cmd_chr(leader_cmd, x_leaders);
+ break;
+ case g_leaders_flag:
+ tex_print_cmd_chr(leader_cmd, g_leaders);
+ break;
+ case u_leaders_flag:
+ tex_print_cmd_chr(leader_cmd, u_leaders);
+ break;
+ }
+ }
+ }
+ }
+ FOUND1:
+ {
+ /*tex Show the box packaging info. */
+ tex_print_str_esc(package);
+ halfword packing, amount;
+ if (tex_aux_saved_box_spec(&packing, &amount)) {
+ tex_print_str(packing == packing_exactly ? " to " : " spread ");
+ tex_print_dimension(amount, pt_unit);
+ }
+ }
+ FOUND2:
+ --cur_level;
+ cur_group = save_level(lmt_save_state.save_stack_data.ptr);
+ lmt_save_state.save_stack_data.ptr = save_value(lmt_save_state.save_stack_data.ptr);
+ }
+ DONE:
+ lmt_save_state.save_stack_data.ptr = saved_pointer;
+ cur_level = saved_level;
+ cur_group = saved_group;
+ tracing_levels_par = saved_tracing;
+}
+
+/*tex
+ This is an experiment. The |handle_overload| function can either go on or quit, depending on
+ how strong one wants to check for overloads.
+
+ \starttabulate[||||||||]
+ \NC \NC \NC immutable \NC permanent \NC primitive \NC frozen \NC instance \NC \NR
+ \NC 1 \NC warning \NC + \NC + \NC + \NC \NC \NC \NR
+ \NC 2 \NC error \NC + \NC + \NC + \NC \NC \NC \NR
+ \NC 3 \NC warning \NC + \NC + \NC + \NC + \NC \NC \NR
+ \NC 4 \NC error \NC + \NC + \NC + \NC + \NC \NC \NR
+ \NC 5 \NC warning \NC + \NC + \NC + \NC + \NC + \NC \NR
+ \NC 6 \NC error \NC + \NC + \NC + \NC + \NC + \NC \NR
+ \stoptabulate
+
+ The overload callback gets passed:
+ (boolean) error,
+ (integer) overload,
+ (string) csname,
+ (integer) flags.
+
+ See January 2020 files for an alternative implementation.
+*/
+
+static void tex_aux_handle_overload(const char *s, halfword cs, int overload, int error_type)
+{
+ int callback_id = lmt_callback_defined(handle_overload_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "bdsd->", error_type == normal_error_type, overload, cs_text(cs), eq_flag(cs));
+ } else {
+ tex_handle_error(
+ error_type,
+ "You can't redefine %s %S.",
+ s, cs,
+ NULL
+ );
+ }
+}
+
+static int tex_aux_report_overload(halfword cs, int overload)
+{
+ int error_type = overload & 1 ? warning_error_type : normal_error_type;
+ if (has_eq_flag_bits(cs, immutable_flag_bit)) {
+ tex_aux_handle_overload("immutable", cs, overload, error_type);
+ } else if (has_eq_flag_bits(cs, primitive_flag_bit)) {
+ tex_aux_handle_overload("primitive", cs, overload, error_type);
+ } else if (has_eq_flag_bits(cs, permanent_flag_bit)) {
+ tex_aux_handle_overload("permanent", cs, overload, error_type);
+ } else if (has_eq_flag_bits(cs, frozen_flag_bit)) {
+ tex_aux_handle_overload("frozen", cs, overload, error_type);
+ } else if (has_eq_flag_bits(cs, instance_flag_bit)) {
+ tex_aux_handle_overload("instance", cs, overload, warning_error_type);
+ return 1;
+ }
+ return error_type == warning_error_type;
+}
+
+# define overload_error_type(overload) (overload & 1 ? warning_error_type : normal_error_type)
+
+int tex_define_permitted(halfword cs, halfword prefixes)
+{
+ halfword overload = overload_mode_par;
+ if (! cs || ! overload || has_eq_flag_bits(cs, mutable_flag_bit)) {
+ return 1;
+ } else if (is_overloaded(prefixes)) {
+ if (overload > 2 && has_eq_flag_bits(cs, immutable_flag_bit | permanent_flag_bit | primitive_flag_bit)) {
+ return tex_aux_report_overload(cs, overload);
+ }
+ } else if (overload > 4) {
+ if (has_eq_flag_bits(cs, immutable_flag_bit | permanent_flag_bit | primitive_flag_bit | frozen_flag_bit | instance_flag_bit)) {
+ return tex_aux_report_overload(cs, overload);
+ }
+ } else if (overload > 2) {
+ if (has_eq_flag_bits(cs, immutable_flag_bit | permanent_flag_bit | primitive_flag_bit | frozen_flag_bit)) {
+ return tex_aux_report_overload(cs, overload);
+ }
+ } else if (has_eq_flag_bits(cs, immutable_flag_bit)) {
+ return tex_aux_report_overload(cs, overload);
+ }
+ return 1;
+}
+
+static int tex_aux_mutation_permitted(halfword cs)
+{
+ halfword overload = overload_mode_par;
+ if (cs && overload && has_eq_flag_bits(cs, immutable_flag_bit)) {
+ return tex_aux_report_overload(cs, overload);
+ } else {
+ return 1;
+ }
+}
+
+/*tex
+
+ Just before an entry of |eqtb| is changed, the following procedure should be called to update
+ the other data structures properly. It is important to keep in mind that reference counts in
+ |mem| include references from within |save_stack|, so these counts must be handled carefully.
+
+ We don't need to destroy when an assignment has the same node:
+
+*/
+
+static void tex_aux_eq_destroy(memoryword w)
+{
+ switch (eq_type_field(w)) {
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ case register_toks_reference_cmd:
+ case internal_toks_reference_cmd:
+ tex_delete_token_reference(eq_value_field(w));
+ break;
+ case internal_glue_reference_cmd:
+ case register_glue_reference_cmd:
+ case internal_mu_glue_reference_cmd:
+ case register_mu_glue_reference_cmd:
+ case gluespec_cmd:
+ case mugluespec_cmd:
+ case mathspec_cmd:
+ case fontspec_cmd:
+ tex_flush_node(eq_value_field(w));
+ break;
+ case internal_box_reference_cmd:
+ case register_box_reference_cmd:
+ tex_flush_node_list(eq_value_field(w));
+ break;
+ case specification_reference_cmd:
+ {
+ halfword q = eq_value_field(w);
+ if (q) {
+ /*tex
+ We need to free a |\parshape| block. Such a block is |2n + 1| words long,
+ where |n = vinfo(q)|. It happens in the
+ flush function.
+ */
+ tex_flush_node(q);
+ }
+ }
+ break;
+ default:
+ break;
+ }
+}
+
+/*tex
+
+ To save a value of |eqtb[p]| that was established at level |l|, we can use the following
+ subroutine. This code could be simplified after the xeq cleanup so we actually use one slot
+ less per saved value.
+
+*/
+
+static void tex_aux_eq_save(halfword p, quarterword l)
+{
+ if (tex_room_on_save_stack()) {
+ if (l == level_zero) {
+ save_type(lmt_save_state.save_stack_data.ptr) = restore_zero;
+ } else {
+ save_type(lmt_save_state.save_stack_data.ptr) = restore_old_value;
+ save_word(lmt_save_state.save_stack_data.ptr) = lmt_hash_state.eqtb[p];
+ }
+ save_level(lmt_save_state.save_stack_data.ptr) = l;
+ save_value(lmt_save_state.save_stack_data.ptr) = p;
+ ++lmt_save_state.save_stack_data.ptr;
+ }
+}
+
+/*tex
+
+ The procedure |eq_define| defines an |eqtb| entry having specified |eq_type| and |equiv| fields,
+ and saves the former value if appropriate. This procedure is used only for entries in the first
+ four regions of |eqtb|, i.e., only for entries that have |eq_type| and |equiv| fields. After
+ calling this routine, it is safe to put four more entries on |save_stack|, provided that there
+ was room for four more entries before the call, since |eq_save| makes the necessary test.
+
+ The destroy if same branch comes from \ETEX\ but is it really right to destroy here if we
+ actually want to keep the value? In practice we only come here with zero cases but even then,
+ it looks like we can destroy the token list or node (list). Not, that might actually work ok in
+ the case of glue refs that have work by ref count and token lists and node (lists) are always
+ different so there we do no harm.
+
+*/
+
+inline static int tex_aux_equal_eq(halfword p, singleword cmd, singleword flag, halfword chr)
+{
+ /* maybe keep flag test at call end and then only flip flags */
+ if (eq_flag(p) == flag) {
+ // printf("eqtest> %03i %03i\n",eq_type(p),cmd);
+ switch (eq_type(p)) {
+ case internal_glue_reference_cmd:
+ case register_glue_reference_cmd:
+ case internal_mu_glue_reference_cmd:
+ case register_mu_glue_reference_cmd:
+ case gluespec_cmd:
+ case mugluespec_cmd:
+ /*tex We compare the pointer as well as the record. */
+ if (tex_same_glue(eq_value(p), chr)) {
+ if (chr) {
+ tex_flush_node(chr);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+ case mathspec_cmd:
+ /*tex Idem here. */
+ if (tex_same_mathspec(eq_value(p), chr)) {
+ if (chr) {
+ tex_flush_node(chr);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+ case fontspec_cmd:
+ /*tex And here. */
+ if (tex_same_fontspec(eq_value(p), chr)) {
+ if (chr) {
+ tex_flush_node(chr);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ /*tex The initial token reference will do as it is unique. */
+// if (eq_value(p) == chr) {
+ if (eq_value(p) == chr && eq_level(p) == cur_level) {
+ tex_delete_token_reference(eq_value(p));
+ return 1;
+ } else {
+ return 0;
+ }
+ case specification_reference_cmd:
+ case internal_box_reference_cmd:
+ case register_box_reference_cmd:
+ /*tex These are also references. */
+ if (eq_type(p) == cmd && eq_value(p) == chr && ! chr) {
+// if (eq_type(p) == cmd && eq_value(p) == chr && ! chr && eq_level(p) == cur_level) {
+ return 1;
+ } else {
+ /* play safe */
+ return 0;
+ }
+ case internal_toks_reference_cmd:
+ case register_toks_reference_cmd:
+ /*tex As are these. */
+ if (p && chr && eq_value(p) == chr) {
+ tex_delete_token_reference(eq_value(p));
+ return 1;
+ } else {
+ return 0;
+ }
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ /*tex Again we have references. */
+ if (eq_value(p) == chr) {
+// if (eq_value(p) == chr && eq_level(p) == cur_level) {
+ return 1;
+ } else {
+ return 0;
+ }
+ // case dimension_cmd:
+ // case integer_cmd:
+ // if (eq_type(p) == cmd && eq_value(p) == chr && eq_level(p) == cur_level) {
+ // return 1;
+ // }
+ default:
+ /*tex
+ We can best also check the level because for integer defs etc we run into
+ issues otherwise (see testcase tests/luametatex/eqtest.tex based on MS's
+ math file).
+ */
+ if (eq_type(p) == cmd && eq_value(p) == chr) {
+// if (eq_type(p) == cmd && eq_value(p) == chr && eq_level(p) == cur_level) {
+ return 1;
+ }
+ return 0;
+ }
+ } else {
+ return 0;
+ }
+}
+
+/*tex Used to define a not yet defined cs or box or ... */
+
+void tex_eq_define(halfword p, singleword cmd, halfword chr)
+{
+ int trace = tracing_assigns_par > 0;
+ if (tex_aux_equal_eq(p, cmd, 0, chr)) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "reassigning");
+ }
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) == cur_level) {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ } else if (cur_level > level_one) {
+ tex_aux_eq_save(p, eq_level(p));
+ }
+ set_eq_level(p, cur_level);
+ set_eq_type(p, cmd);
+ set_eq_flag(p, 0);
+ set_eq_value(p, chr);
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+ }
+}
+
+/*tex
+
+ The counterpart of |eq_define| for the remaining (fullword) positions in |eqtb| is called
+ |eq_word_define|. Since |xeq_level[p] >= level_one| for all |p|, a |restore_zero| will never
+ be used in this case.
+
+*/
+
+void tex_eq_word_define(halfword p, int w)
+{
+ int trace = tracing_assigns_par > 0;
+ if (eq_value(p) == w) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "reassigning");
+ }
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) != cur_level) {
+ tex_aux_eq_save(p, eq_level(p));
+ set_eq_level(p, cur_level);
+ }
+ eq_value(p) = w;
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+ }
+}
+
+/*tex
+
+ The |eq_define| and |eq_word_define| routines take care of local definitions. Global definitions
+ are done in almost the same way, but there is no need to save old values, and the new value is
+ associated with |level_one|.
+
+*/
+
+void tex_geq_define(halfword p, singleword cmd, halfword chr)
+{
+ int trace = tracing_assigns_par > 0;
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ set_eq_level(p, level_one);
+ set_eq_type(p, cmd);
+ set_eq_flag(p, 0);
+ set_eq_value(p, chr);
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+}
+
+void tex_geq_word_define(halfword p, int w)
+{
+ int trace = tracing_assigns_par > 0;
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ eq_value(p) = w;
+ set_eq_level(p, level_one);
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+}
+
+/*tex
+ Instead of a macro that distinguishes between global or not we now use a few normal functions.
+ That way we don't need to define a bogus variable |a| in some cases. This is typically one of
+ those changes that happened after other bits and pieces got redone. (One can also consider it
+ a side effect of looking at the code through a visual studio lense.)
+*/
+
+static inline void tex_aux_set_eq_data(halfword p, singleword t, halfword e, singleword f, quarterword l)
+{
+ singleword flag = eq_flag(p);
+ set_eq_level(p, l);
+ set_eq_type(p, t);
+ set_eq_value(p, e);
+ if (is_mutable(f) || is_mutable(flag)) {
+ set_eq_flag(p, (f | flag) & ~(noaligned_flag_bit | permanent_flag_bit | primitive_flag_bit | immutable_flag_bit));
+ } else {
+ set_eq_flag(p, f);
+ }
+}
+
+void tex_define(int g, halfword p, singleword t, halfword e) /* int g -> singleword g */
+{
+ int trace = tracing_assigns_par > 0;
+ singleword f = make_eq_flag_bits(g);
+ if (is_global(g)) {
+ /* what if already global */
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ // if (tex_aux_equal_eq(p, t, f, e) && (eq_level(p) == level_one)) {
+ // return; /* we can save some stack */
+ // }
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ tex_aux_set_eq_data(p, t, e, f, level_one);
+ } else if (tex_aux_equal_eq(p, t, f, e)) {
+ /* hm, we tweak the ref ! */
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "reassigning");
+ return;
+ }
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) == cur_level) {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ } else if (cur_level > level_one) {
+ tex_aux_eq_save(p, eq_level(p));
+ }
+ tex_aux_set_eq_data(p, t, e, f, cur_level);
+ }
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+}
+
+void tex_define_inherit(int g, halfword p, singleword f, singleword t, halfword e)
+{
+ int trace = tracing_assigns_par > 0;
+ if (is_global(g)) {
+ /* what if already global */
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ // if (equal_eq(p, t, f, e) && (eq_level(p) == level_one)) {
+ // return; /* we can save some stack */
+ // }
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ tex_aux_set_eq_data(p, t, e, f, level_one);
+ } else if (tex_aux_equal_eq(p, t, f, e)) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "reassigning");
+ return;
+ }
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) == cur_level) {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ } else if (cur_level > level_one) {
+ tex_aux_eq_save(p, eq_level(p));
+ }
+ tex_aux_set_eq_data(p, t, e, f, cur_level);
+ }
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+}
+
+/* beware: when we swap a global vsize with a local ... we can get side effect. */
+
+static void tex_aux_just_define(int g, halfword p, halfword e)
+{
+ int trace = tracing_assigns_par > 0;
+ if (is_global(g)) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ set_eq_value(p, e);
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) == cur_level) {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ } else if (cur_level > level_one) {
+ tex_aux_eq_save(p, eq_level(p));
+ }
+ set_eq_level(p, cur_level);
+ set_eq_value(p, e);
+ }
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+}
+
+/* We can have a variant that doesn't save/restore so we just have to swap back then. */
+
+void tex_define_swapped(int g, halfword p1, halfword p2, int force)
+{
+ halfword t1 = eq_type(p1);
+ halfword t2 = eq_type(p2);
+ halfword l1 = eq_level(p1);
+ halfword l2 = eq_level(p2);
+ singleword f1 = eq_flag(p1);
+ singleword f2 = eq_flag(p2);
+ halfword v1 = eq_value(p1);
+ halfword v2 = eq_value(p2);
+ if (t1 == t2 && l1 == l2) {
+ halfword overload = force ? 0 : overload_mode_par;
+ if (overload) {
+ if (f1 != f2) {
+ goto NOTDONE;
+ } else if (is_immutable(f1)) {
+ goto NOTDONE;
+ }
+ }
+ {
+ switch (t1) {
+ case register_int_cmd:
+ case register_attribute_cmd:
+ case register_dimen_cmd:
+ case register_glue_cmd: /* unchecked */
+ case register_mu_glue_cmd: /* unchecked */
+ case internal_mu_glue_cmd: /* unchecked */
+ case integer_cmd:
+ case dimension_cmd:
+ tex_aux_just_define(g, p1, v2);
+ tex_aux_just_define(g, p2, v1);
+ return;
+ case register_toks_cmd:
+ case internal_toks_cmd:
+ if (v1) tex_add_token_reference(v1);
+ if (v2) tex_add_token_reference(v2);
+ tex_aux_just_define(g, p1, v2);
+ tex_aux_just_define(g, p2, v1);
+ if (v1) tex_delete_token_reference(v1);
+ if (v2) tex_delete_token_reference(v2);
+ return;
+ case internal_int_cmd:
+ tex_assign_internal_int_value(g, p1, v2);
+ tex_assign_internal_int_value(g, p2, v1);
+ return;
+ case internal_attribute_cmd:
+ tex_assign_internal_attribute_value(g, p1, v2);
+ tex_assign_internal_attribute_value(g, p2, v1);
+ return;
+ case internal_dimen_cmd:
+ tex_assign_internal_dimen_value(g, p1, v2);
+ tex_assign_internal_dimen_value(g, p2, v1);
+ return;
+ case internal_glue_cmd:
+ /* todo */
+ tex_assign_internal_skip_value(g, p1, v2);
+ tex_assign_internal_skip_value(g, p2, v1);
+ return;
+ default:
+ if (overload > 2) {
+ if (has_flag_bits(f1, immutable_flag_bit | permanent_flag_bit | primitive_flag_bit)) {
+ if (overload > 3) {
+ goto NOTDONE;
+ }
+ }
+ }
+ if (is_call_cmd(t1)) {
+ if (v1) tex_add_token_reference(v1);
+ if (v2) tex_add_token_reference(v2);
+ tex_aux_just_define(g, p1, v2);
+ tex_aux_just_define(g, p2, v1);
+ /* no delete here .. hm */
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "\\swapcsvalues not (yet) implemented for commands (%C, %C)",
+ t1, v1, t2, v2, NULL
+ );
+
+ }
+ return;
+ }
+ }
+ }
+ NOTDONE:
+ tex_handle_error(
+ normal_error_type,
+ "\\swapcsvalues requires equal commands (%C, %C), levels (%i, %i) and flags (%i, %i)",
+ t1, v1, t2, v2, l1, l2, f1, f2, NULL
+ );
+}
+
+void tex_forced_define(int g, halfword p, singleword f, singleword t, halfword e)
+{
+ int trace = tracing_assigns_par > 0;
+ if (is_global(g)) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ set_eq_level(p, level_one);
+ set_eq_type(p, t);
+ set_eq_flag(p, f);
+ set_eq_value(p, e);
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) == cur_level) {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ } else if (cur_level > level_one) {
+ tex_aux_eq_save(p, eq_level(p));
+ }
+ set_eq_level(p, cur_level);
+ set_eq_type(p, t);
+ set_eq_flag(p, f);
+ set_eq_value(p, e);
+ }
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+}
+
+// void forced_define(int l, halfword p, singleword f, singleword t, halfword e)
+// {
+// eq_destroy(hash_state.eqtb[p]);
+// set_eq_level(p, l);
+// set_eq_type(p, t);
+// set_eq_flag(p, f);
+// set_eq_value(p, e);
+// }
+
+void tex_word_define(int g, halfword p, halfword w)
+{
+ if (tex_aux_mutation_permitted(p)) {
+ int trace = tracing_assigns_par > 0;
+ if (is_global(g)) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ eq_value(p) = w;
+ set_eq_level(p, level_one);
+ } else if (eq_value(p) == w) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "reassigning");
+ return;
+ }
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) != cur_level) {
+ tex_aux_eq_save(p, eq_level(p));
+ set_eq_level(p, cur_level);
+ }
+ eq_value(p) = w;
+ }
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+ if (is_immutable(g)) {
+ eq_flag(p) |= immutable_flag_bit;
+ } else if (is_mutable(g)) {
+ eq_flag(p) |= mutable_flag_bit;
+ }
+ }
+}
+
+void tex_forced_word_define(int g, halfword p, singleword f, halfword w)
+{
+ if (tex_aux_mutation_permitted(p)) {
+ int trace = tracing_assigns_par > 0;
+ if (is_global(g)) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "globally changing");
+ }
+ eq_value(p) = w;
+ set_eq_level(p, level_one);
+ } else if (eq_value(p) == w) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "reassigning");
+ return;
+ }
+ } else {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "changing");
+ }
+ if (eq_level(p) != cur_level) {
+ tex_aux_eq_save(p, eq_level(p));
+ set_eq_level(p, cur_level);
+ }
+ eq_value(p) = w;
+ }
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "into");
+ }
+ eq_flag(p) = f;
+ }
+}
+
+/*tex
+
+ Subroutine |save_for_after_group| puts a token on the stack for save-keeping.
+
+*/
+
+void tex_save_for_after_group(halfword t)
+{
+ if (cur_level > level_one && tex_room_on_save_stack()) {
+ save_type(lmt_save_state.save_stack_data.ptr) = insert_tokens;
+ save_level(lmt_save_state.save_stack_data.ptr) = level_zero;
+ save_value(lmt_save_state.save_stack_data.ptr) = t;
+ ++lmt_save_state.save_stack_data.ptr;
+ }
+}
+
+/*tex
+
+ The |unsave| routine goes the other way, taking items off of |save_stack|. This routine takes
+ care of restoration when a level ends. Here, everything belonging to the topmost group is
+ cleared off of the save stack.
+
+ In \TEX\ there are a few |\after...| commands, like |\aftergroup| and |\afterassignment| while
+ |\futurelet| also has this property of postponed actions. The |\every...| token registers do
+ the opposite and do stuff up front. In addition to |\aftergrouped| we have a variant that
+ accepts a token list, as does |\afterassigned|. These items are saved on the stack.
+
+ In \LUAMETATEX\ we can also do things just before a group ends as well as just before the
+ paragraph finishes. In the end it was not that hard to implement in the \LUATEX\ concept,
+ although it adds a little overhead, but the benefits compensate that. Because we can use some
+ mechanisms used in other extensions only a few extra lines are needed. All are accumulative
+ but the paragraph bound one is special in the sense that is is bound to the current paragraph,
+ so the actual implementation of that one happens elsewhere and differently.
+
+ Side note: when |\par| overloading was introduced in \PDFTEX\ and per request also added to
+ |\LUATEX| it made no sense to add that to \LUAMETATEX\ too. We already have callbacks, and
+ there is information available about what triggered a |\par|. Another argument against
+ supporting this is that overloading |\par| is messy and unreliable (macro package and user
+ demand and actions can badly interfere). The mentioned hooks already give more than enough
+ opportunities. One doesn't expect users to overload |\relax| either.
+
+ Side note: at some point I will look into |\after| hooks in for instance alignments and maybe
+ something nicer that |\afterassignment| can be used for pushing stuff into boxes (|\everybox|
+ is not that helpful). But again avoiding extra overhead might is a very good be a reason to
+ not do that at all.
+
+*/
+
+void tex_unsave(void)
+{
+ if (end_of_group_par) {
+ tex_begin_inserted_list(tex_get_available_token(token_val(end_local_cmd, 0)));
+ tex_begin_token_list(end_of_group_par, end_of_group_text);
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering token scanner via endgroup");
+ }
+ tex_local_control(1);
+ }
+
+ unsave_attribute_state_before();
+
+ tex_unsave_math_codes(cur_level);
+ tex_unsave_cat_codes(cat_code_table_par, cur_level);
+ tex_unsave_text_codes(cur_level);
+ tex_unsave_math_data(cur_level);
+ if (cur_level > level_one) {
+ /*tex
+ Variable |a| registers if we already have processed an |\aftergroup|. We append when
+ >= 1.
+ */
+ int a = 0;
+ int trace = tracing_restores_par > 0;
+ --cur_level;
+ /*tex Clear off top level from |save_stack|. */
+ while (1) {
+ --lmt_save_state.save_stack_data.ptr;
+ switch (save_type(lmt_save_state.save_stack_data.ptr)) {
+ case level_boundary:
+ goto DONE;
+ case restore_old_value:
+ {
+ halfword p = save_value(lmt_save_state.save_stack_data.ptr);
+ /*tex
+ Store |save_stack[save_ptr]| in |eqtb[p]|, unless |eqtb[p]| holds a global
+ value A global definition, which sets the level to |level_one|, will not be
+ undone by |unsave|. If at least one global definition of |eqtb[p]| has been
+ carried out within the group that just ended, the last such definition will
+ therefore survive.
+ */
+ if (p < internal_int_base || p > eqtb_size) {
+ if (eq_level(p) == level_one) {
+ tex_aux_eq_destroy(save_word(lmt_save_state.save_stack_data.ptr));
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "retaining");
+ }
+ } else {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ lmt_hash_state.eqtb[p] = save_word(lmt_save_state.save_stack_data.ptr);
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "restoring");
+ }
+ }
+ } else if (eq_level(p) == level_one) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "retaining");
+ }
+ } else {
+ lmt_hash_state.eqtb[p] = save_word(lmt_save_state.save_stack_data.ptr);
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "restoring");
+ }
+ }
+ break;
+ }
+ case insert_tokens:
+ {
+ /*tex A list starts a new input level (for now). */
+ halfword p = save_value(lmt_save_state.save_stack_data.ptr);
+ if (a) {
+ /*tex We stay at the same input level (an \ETEX\ feature). */
+ tex_append_input(p);
+ } else {
+ tex_insert_input(p);
+ a = 1;
+ }
+ break;
+ }
+ case restore_lua:
+ {
+ /* The same as lua_function_code in |textoken.c|. */
+ halfword p = save_value(lmt_save_state.save_stack_data.ptr);
+ if (p > 0) {
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ lmt_function_call(p, 0);
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ } else {
+ tex_normal_error("lua restore", "invalid number");
+ }
+ a = 1;
+ break;
+ }
+ case restore_zero:
+ {
+ halfword p = save_value(lmt_save_state.save_stack_data.ptr);
+ if (eq_level(p) == level_one) {
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "retaining");
+ }
+ } else {
+ if (p < internal_int_base || p > eqtb_size) {
+ tex_aux_eq_destroy(lmt_hash_state.eqtb[p]);
+ }
+ lmt_hash_state.eqtb[p] = lmt_hash_state.eqtb[undefined_control_sequence];
+ if (trace) {
+ tex_aux_diagnostic_trace(p, "restoring");
+ }
+ }
+ break;
+ }
+ default:
+ /* we have a messed up save pointer */
+ tex_formatted_error("tex unsave", "bad save type case %d, probably a stack pointer issue", save_type(lmt_save_state.save_stack_data.ptr));
+ break;
+ }
+ }
+ DONE:
+ if (tracing_groups_par > 0) {
+ tex_aux_group_trace(1);
+ }
+ if (lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].group == cur_boundary) {
+ /*tex Groups are possibly not properly nested with files. */
+ tex_aux_group_warning();
+ }
+ cur_group = save_level(lmt_save_state.save_stack_data.ptr);
+ cur_boundary = save_value(lmt_save_state.save_stack_data.ptr);
+ --lmt_save_state.save_stack_data.ptr;
+ } else {
+ /*tex |unsave| is not used when |cur_group=bottom_level| */
+ tex_confusion("current level");
+ }
+ unsave_attribute_state_after();
+}
+
+/*tex
+
+ Most of the parameters kept in |eqtb| can be changed freely, but there's an exception: The
+ magnification should not be used with two different values during any \TEX\ job, since a
+ single magnification is applied to an entire run. The global variable |mag_set| is set to the
+ current magnification whenever it becomes necessary to \quote {freeze} it at a particular value.
+
+ The |prepare_mag| subroutine is called whenever \TEX\ wants to use |mag| for magnification. If
+ nonzero, this magnification should be used henceforth. We might drop magnifaction at some point.
+
+ {\em NB: As we delegate the backend to \LUA\ we have no mag.}
+
+ Let's pause a moment now and try to look at the Big Picture. The \TEX\ program consists of three
+ main parts: syntactic routines, semantic routines, and output routines. The chief purpose of the
+ syntactic routines is to deliver the user's input to the semantic routines, one token at a time.
+ The semantic routines act as an interpreter responding to these tokens, which may be regarded as
+ commands. And the output routines are periodically called on to convert box-and-glue lists into a
+ compact set of instructions that will be sent to a typesetter. We have discussed the basic data
+ structures and utility routines of \TEX, so we are good and ready to plunge into the real activity
+ by considering the syntactic routines.
+
+ Our current goal is to come to grips with the |get_next| procedure, which is the keystone of
+ \TEX's input mechanism. Each call of |get_next| sets the value of three variables |cur_cmd|,
+ |cur_chr|, and |cur_cs|, representing the next input token.
+
+ \startitemize
+ \startitem
+ |cur_cmd| denotes a command code from the long list of codes given above;
+ \stopitem
+ \startitem
+ |cur_chr| denotes a character code or other modifier of the command code;
+ \stopitem
+ \startitem
+ |cur_cs| is the |eqtb| location of the current control sequence, if the current token
+ was a control sequence, otherwise it's zero.
+ \stopitem
+ \stopitemize
+
+ Underlying this external behavior of |get_next| is all the machinery necessary to convert from
+ character files to tokens. At a given time we may be only partially finished with the reading of
+ several files (for which |\input| was specified), and partially finished with the expansion of
+ some user-defined macros and/or some macro parameters, and partially finished with the generation
+ of some text in a template for |\halign|, and so on. When reading a character file, special
+ characters must be classified as math delimiters, etc.; comments and extra blank spaces must be
+ removed, paragraphs must be recognized, and control sequences must be found in the hash table.
+ Furthermore there are occasions in which the scanning routines have looked ahead for a word like
+ |plus| but only part of that word was found, hence a few characters must be put back into the input
+ and scanned again.
+
+ To handle these situations, which might all be present simultaneously, \TEX\ uses various stacks
+ that hold information about the incomplete activities, and there is a finite state control for each
+ level of the input mechanism. These stacks record the current state of an implicitly recursive
+ process, but the |get_next| procedure is not recursive. Therefore it will not be difficult to
+ translate these algorithms into low-level languages that do not support recursion.
+
+ In general, |cur_cmd| is the current command as set by |get_next|, while |cur_chr| is the operand
+ of the current command. The control sequence found here is registsred in |cur_cs| and is zero if
+ none found. The |cur_tok| variable contains the packed representative of |cur_cmd| and |cur_chr|
+ and like the other ones is global.
+
+ Here is a procedure that displays the current command. The variable |n| holds the level of |\if ...
+ \fi| nesting and |l| the line where |\if| started.
+
+*/
+
+void tex_show_cmd_chr(halfword cmd, halfword chr)
+{
+ tex_begin_diagnostic();
+ if (cur_list.mode != lmt_nest_state.shown_mode) {
+ if (tracing_commands_par >= 4) {
+ /*tex So, larger than \ETEX's extra info 3 value. We might just always do this. */
+ tex_print_format("[mode: entering %M]", cur_list.mode);
+ tex_print_nlp();
+ tex_print_levels();
+ tex_print_str("{");
+ } else {
+ tex_print_format("{%M: ", cur_list.mode);
+ }
+ lmt_nest_state.shown_mode = cur_list.mode;
+ } else {
+ tex_print_str("{");
+ }
+ tex_print_cmd_chr((singleword) cmd, chr);
+ if (cmd == if_test_cmd && tracing_ifs_par > 0) {
+ halfword p;
+ int n, l;
+ if (tracing_commands_par >= 4) {
+ tex_print_str(": ");
+ } else {
+ tex_print_char(' ');
+ }
+ if (cur_chr >= first_real_if_test_code || cur_chr == or_else_code || cur_chr == or_unless_code) { /* can be other >= test */
+ n = 1;
+ l = lmt_input_state.input_line;
+ } else {
+ tex_print_cmd_chr(if_test_cmd, lmt_condition_state.cur_if);
+ tex_print_char(' ');
+ n = 0;
+ l = lmt_condition_state.if_line;
+ }
+ /*tex
+ We now also have a proper counter but this is a check for a potential mess up. If
+ als is right, |lmt_condition_state.if_nesting| often should match |n|.
+ */
+ p = lmt_condition_state.cond_ptr;
+ while (p) {
+ ++n;
+ p = node_next(p);
+ }
+ if (l) {
+ if (tracing_commands_par >= 4) {
+ tex_print_format("(level %i, line %i, nesting %i)", n, l, lmt_condition_state.if_nesting);
+ } else {
+ // tex_print_format("(level %i) entered on line %i", n, l);
+ tex_print_format("(level %i, line %i)", n, l);
+ }
+ } else {
+ tex_print_format("(level %i)", n);
+ }
+ }
+ tex_print_char('}');
+ tex_end_diagnostic();
+}
+
+/*tex
+
+ Here is a procedure that displays the contents of |eqtb[n]| symbolically.
+
+ We're now at equivalent |n| in region 4. First we initialize most things to null or undefined
+ values. An undefined font is represented by the internal code |font_base|.
+
+ However, the character code tables are given initial values based on the conventional
+ interpretation of \ASCII\ code. These initial values should not be changed when \TEX\ is
+ adapted for use with non-English languages; all changes to the initialization conventions
+ should be made in format packages, not in \TEX\ itself, so that global interchange of formats
+ is possible.
+
+ The reorganization was done because I wanted a cleaner token interface at the \LUA\ end. So
+ we also do some more checking. The order differs from traditional \TEX\ but of course the
+ approach is similar.
+
+ The regions in \LUAMETATEX\ are a bit adapted as a side effect of the \ETEX\ extensions as
+ well as our own. For instance, we tag all regions because we also need a consistent token
+ interface to \LUA. We also dropped fonts and some more from the table.
+
+ A previous, efficient, still range based variant can be found in the my archive but it makes
+ no sense to keep it commented here (apart from sentimental reasons) so one now only can see
+ the range agnostic version here.
+
+*/
+
+void tex_aux_show_eqtb(halfword n)
+{
+ if (n < null_cs) {
+ tex_print_format("bad token %i, case 1", n);
+ } else if (eqtb_indirect_range(n)) {
+ tex_print_cs(n);
+ tex_print_char('=');
+ tex_print_cmd_chr(eq_type(n), eq_value(n));
+ if (eq_type(n) >= call_cmd) {
+ tex_print_char(':');
+ tex_token_show(eq_value(n), default_token_show_min);
+ }
+ } else {
+ switch (eq_type(n)) {
+ case internal_toks_reference_cmd:
+ tex_print_cmd_chr(internal_toks_cmd, n);
+ goto TOKS;
+ case register_toks_reference_cmd:
+ tex_print_str_esc("toks");
+ tex_print_int(register_toks_number(n));
+ TOKS:
+ tex_print_char('=');
+ tex_token_show(eq_value(n), default_token_show_min);
+ break;
+ case internal_box_reference_cmd:
+ tex_print_cmd_chr(eq_type(n), n);
+ goto BOX;
+ case register_box_reference_cmd:
+ tex_print_str_esc("box");
+ tex_print_int(register_box_number(n));
+ BOX:
+ tex_print_char('=');
+ if (eq_value(n)) {
+ tex_show_node_list(eq_value(n), 0, 1);
+ tex_print_levels();
+ } else {
+ tex_print_str("void");
+ }
+ break;
+ case internal_glue_reference_cmd:
+ tex_print_cmd_chr(internal_glue_cmd, n);
+ goto SKIP;
+ case register_glue_reference_cmd:
+ tex_print_str_esc("skip");
+ tex_print_int(register_glue_number(n));
+ SKIP:
+ tex_print_char('=');
+ if (tracing_nodes_par > 2) {
+ tex_print_format("<%i>", eq_value(n));
+ }
+ tex_print_spec(eq_value(n), pt_unit);
+ break;
+ case internal_mu_glue_reference_cmd:
+ tex_print_cmd_chr(internal_mu_glue_cmd, n);
+ goto MUSKIP;
+ case register_mu_glue_reference_cmd:
+ tex_print_str_esc("muskip");
+ tex_print_int(register_mu_glue_number(n));
+ MUSKIP:
+ if (tracing_nodes_par > 2) {
+ tex_print_format("<%i>", eq_value(n));
+ }
+ tex_print_char('=');
+ tex_print_spec(eq_value(n), mu_unit);
+ break;
+ case internal_int_reference_cmd:
+ tex_print_cmd_chr(internal_int_cmd, n);
+ goto COUNT;
+ case register_int_reference_cmd:
+ tex_print_str_esc("count");
+ tex_print_int(register_int_number(n));
+ COUNT:
+ tex_print_char('=');
+ tex_print_int(eq_value(n));
+ break;
+ case internal_attribute_reference_cmd:
+ tex_print_cmd_chr(internal_attribute_cmd, n);
+ goto ATTRIBUTE;
+ case register_attribute_reference_cmd:
+ tex_print_str_esc("attribute");
+ tex_print_int(register_attribute_number(n));
+ ATTRIBUTE:
+ tex_print_char('=');
+ tex_print_int(eq_value(n));
+ break;
+ case internal_dimen_reference_cmd:
+ tex_print_cmd_chr(internal_dimen_cmd, n);
+ goto DIMEN;
+ case register_dimen_reference_cmd:
+ tex_print_str_esc("dimen");
+ tex_print_int(register_dimen_number(n));
+ DIMEN:
+ tex_print_char('=');
+ tex_print_dimension(eq_value(n), pt_unit);
+ break;
+ case specification_reference_cmd:
+ tex_print_cmd_chr(set_specification_cmd, n);
+ tex_print_char('=');
+ if (eq_value(n)) {
+ // if (tracing_nodes_par > 2) {
+ // tex_print_format("<%i>", eq_value(n));
+ // }
+ tex_print_int(specification_count(eq_value(n)));
+ } else {
+ tex_print_char('0');
+ }
+ break;
+ default:
+ tex_print_format("bad token %i, case 2", n);
+ break;
+ }
+ }
+}
+
+/*tex
+
+ A couple of (self documenting) convenient helpers. They do what we do in \LUATEX, but we now
+ have collapsed all the options in one mode parameter that also gets stored in the glyph so
+ the older functions are gone. Progress.
+
+*/
+
+halfword tex_automatic_disc_penalty(halfword mode)
+{
+ return hyphenation_permitted(mode, automatic_penalty_hyphenation_mode) ? automatic_hyphen_penalty_par : ex_hyphen_penalty_par;
+}
+
+halfword tex_explicit_disc_penalty(halfword mode)
+{
+ return hyphenation_permitted(mode, explicit_penalty_hyphenation_mode) ? explicit_hyphen_penalty_par : ex_hyphen_penalty_par;
+}
+
+/*tex
+
+ The table of equivalents needs to get (pre)populated by the right commands and references, so
+ that happens here (called in maincontrol at ini time).
+
+ For diagnostic purposes we now have the type set for registers. As a consequence we not have
+ four |glue_ref| variants, which is a trivial extension.
+
+*/
+
+inline static void tex_aux_set_eq(halfword base, quarterword level, singleword cmd, halfword value, halfword count)
+{
+ if (count > 0) {
+ set_eq_level(base, level);
+ set_eq_type(base, cmd);
+ set_eq_flag(base, 0);
+ set_eq_value(base, value);
+ for (int k = base + 1; k <= base + count; k++){
+ copy_eqtb_entry(k, base);
+ }
+ }
+}
+
+void tex_synchronize_equivalents(void)
+{
+ tex_aux_set_eq(null_cs, level_zero, undefined_cs_cmd, null, lmt_hash_state.hash_data.top - 1);
+}
+
+void tex_initialize_equivalents(void)
+{
+ /*tex Order matters here! */
+ tex_aux_set_eq(null_cs, level_zero, undefined_cs_cmd, null, lmt_hash_state.hash_data.top - 1);
+ tex_aux_set_eq(internal_glue_base, level_one, internal_glue_reference_cmd, zero_glue, number_glue_pars);
+ tex_aux_set_eq(register_glue_base, level_one, register_glue_reference_cmd, zero_glue, max_glue_register_index);
+ tex_aux_set_eq(internal_mu_glue_base, level_one, internal_mu_glue_reference_cmd, zero_glue, number_mu_glue_pars);
+ tex_aux_set_eq(register_mu_glue_base, level_one, register_mu_glue_reference_cmd, zero_glue, max_mu_glue_register_index);
+ tex_aux_set_eq(internal_toks_base, level_one, internal_toks_reference_cmd, null, number_tok_pars);
+ tex_aux_set_eq(register_toks_base, level_one, register_toks_reference_cmd, null, max_toks_register_index);
+ tex_aux_set_eq(internal_box_base, level_one, internal_box_reference_cmd, null, number_box_pars);
+ tex_aux_set_eq(register_box_base, level_one, register_box_reference_cmd, null, max_box_register_index);
+ tex_aux_set_eq(internal_int_base, level_one, internal_int_reference_cmd, 0, number_int_pars);
+ tex_aux_set_eq(register_int_base, level_one, register_int_reference_cmd, 0, max_int_register_index);
+ tex_aux_set_eq(internal_attribute_base, level_one, internal_attribute_reference_cmd, unused_attribute_value, number_attribute_pars);
+ tex_aux_set_eq(register_attribute_base, level_one, register_attribute_reference_cmd, unused_attribute_value, max_attribute_register_index);
+ tex_aux_set_eq(internal_dimen_base, level_one, internal_dimen_reference_cmd, 0, number_dimen_pars);
+ tex_aux_set_eq(register_dimen_base, level_one, register_dimen_reference_cmd, 0, max_dimen_register_index);
+ tex_aux_set_eq(internal_specification_base, level_one, specification_reference_cmd, null, number_specification_pars);
+ tex_aux_set_eq(undefined_control_sequence, level_zero, undefined_cs_cmd, null, 0);
+ /*tex why here? */
+ cat_code_table_par = 0;
+}
+
+int tex_located_save_value(int id)
+{
+ int i = lmt_save_state.save_stack_data.ptr - 1;
+ while (save_type(i) != level_boundary) {
+ i--;
+ }
+ while (i < lmt_save_state.save_stack_data.ptr) {
+ if (save_type(i) == restore_old_value && save_value(i) == id) {
+ /*
+ if (math_direction_par != save_value(i - 1)) {
+ return 1;
+ }
+ */
+ return save_value(i - 1);
+ }
+ i++;
+ }
+ return 0;
+}
diff --git a/source/luametatex/source/tex/texequivalents.h b/source/luametatex/source/tex/texequivalents.h
new file mode 100644
index 000000000..aaf45d0c1
--- /dev/null
+++ b/source/luametatex/source/tex/texequivalents.h
@@ -0,0 +1,1776 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_EQUIVALENTS_H
+# define LMT_EQUIVALENTS_H
+
+# include "tex/textypes.h"
+
+/*tex
+
+ Like the preceding parameters, the following quantities can be changed at compile time to extend
+ or reduce \TEX's capacity. But if they are changed, it is necessary to rerun the initialization
+ program |INITEX| to generate new tables for the production \TEX\ program. One can't simply make
+ helter-skelter changes to the following constants, since certain rather complex initialization
+ numbers are computed from them. They are defined here using \WEB\ macros, instead of being put
+ into \PASCAL's |const| list, in order to emphasize this distinction.
+
+ The original token interface at the \LUA\ end used the \quote {real} chr values that are offsets
+ into the table of equivalents. However, that is sort of fragile when one also provides ways to
+ construct tokens. For that reason the \LUAMETATEX\ interface is a bit more abstract and therefore
+ can do some testing. After all, the real numbers don't matter. This means that registers for
+ instance run from |0..65535| (without the region offsets).
+
+ In order to make this easier the token registers are now more consistent with the other registers
+ in the sense that there is no longer a special cmd for those registers. This was not that hard to
+ do because most code already was sort of prepared for that move.
+
+ Now, there is one \quote {complication}: integers, dimensions etc references can be registers but
+ also internal variables. This means that we cannot simply remap the eq slots they refer to. When
+ we offset by some base (the first register) we end up with negative indices for the internal ones
+ because they come before this 64K range. So, this is why the \LUA\ interface works with negative
+ numbers for internal variables.
+
+ Another side effect is that we now have the mu glue internals in the muglue region. This is
+ possible because we have separated the subtypes from the chr codes. I might also relocate the
+ special things (like penalties) some day.
+
+ In a couple of cases a specific chr was used that made it possible to share for instance setters.
+ Examples are |\mkern| and |\mskip|. This resulted is (sort of) funny single numbers in the token
+ interface, so we have that now normalized as well (at the cost of a few split functions). Of course
+ that doesn't change the concept, unless one considers the fact that we have more granularity in
+ node subtypes (no longer parallel to the codes, as there are more) an issue. (Actually we can now
+ easily introduce hkern and vkern if we want.)
+
+*/
+
+/*tex
+
+ Each entry in |eqtb| is a |memoryword|. Most of these words are of type |two_halves|, and
+ subdivided into three fields:
+
+ \startitemize
+
+ \startitem
+ The |eq_level| (a quarterword) is the level of grouping at which this equivalent was
+ defined. If the level is |level_zero|, the equivalent has never been defined;
+ |level_one| refers to the outer level (outside of all groups), and this level is also
+ used for global definitions that never go away. Higher levels are for equivalents that
+ will disappear at the end of their group.
+ \stopitem
+
+ \startitem
+ The |eq_type| (another quarterword) specifies what kind of entry this is. There are many
+ types, since each \TEX\ primitive like |\hbox|, |\def|, etc., has its own special code.
+ The list of command codes above includes all possible settings of the |eq_type| field.
+ \stopitem
+
+ \startitem
+ The |equiv| (a halfword) is the current equivalent value. This may be a font number, a
+ pointer into |mem|, or a variety of other things.
+ \stopitem
+
+ \stopitemize
+
+ Many locations in |eqtb| have symbolic names. The purpose of the next paragraphs is to define
+ these names, and to set up the initial values of the equivalents.
+
+ In the first region we have a single entry for the \quote {null csname} of length zero. In
+ \LUATEX, the active characters and and single-letter control sequence names are part of the
+ next region.
+
+ Then comes region 2, which corresponds to the hash table that we will define later. The maximum
+ address in this region is used for a dummy control sequence that is perpetually undefined.
+ There also are several locations for control sequences that are perpetually defined (since they
+ are used in error recovery).
+
+ Region 3 of |eqtb| contains the |number_regs| |\skip| registers, as well as the glue parameters
+ defined here. It is important that the \quote {muskip} parameters have larger numbers than the
+ others.
+
+ Region 4 of |eqtb| contains the local quantities defined here. The bulk of this region is taken
+ up by five tables that are indexed by eight-bit characters; these tables are important to both
+ the syntactic and semantic portions of \TEX. There are also a bunch of special things like font
+ and token parameters, as well as the tables of |\toks| and |\box| registers.
+
+ Region 5 of |eqtb| contains the integer parameters and registers defined here, as well as the
+ |del_code| table. The latter table differs from the |cat_code..math_code| tables that precede it,
+ since delimiter codes are fullword integers while the other kinds of codes occupy at most a
+ halfword. This is what makes region~5 different from region~4. We will store the |eq_level|
+ information in an auxiliary array of quarterwords that will be defined later.
+
+ The integer parameters should really be initialized by a macro package; the following
+ initialization does the minimum to keep \TEX\ from complete failure.
+
+ The final region of |eqtb| contains the dimension parameters defined here, and the |number_regs|
+ |\dimen| registers.
+
+ Beware: in \LUATEX\ we have so many characters (\UNICODE) that we use a dedicated hash system
+ for special codes, math properties etc. This means that we have less in the regions than mentioned
+ here. On the other hand, we do have more registers (attributes) so that makes it a bit larger again.
+
+ The registers get marked as being \quote {undefined} commands. We could actually gove them a the
+ right commmand code etc.\ bur for now we just use the ranges as traditional \TEX\ does.
+
+ Most of the symbolic names and hard codes numbers are not enumerations. There is still room for
+ improvement and occasionally I enter a new round of doing that. However, it talkes a lot of time
+ and checking (more than writing from scratch) as we need to make sure it all behaves like \TEX\
+ does. Quite some code went through several stages of reaching this abstraction, just to make sure
+ that it kept working. These intermediate versions ended up in the \CONTEXT\ distribution to that
+ any issue would show up soon. A rather major step was splitting the |assign_*_cmd|s into
+ internal and register commands and ranges. This was a side effect of getting the token interface
+ at the \LUA\ end a bit nicer; there is really no need to expose the user to codes that demand
+ catching up with the \TEX\ internals when we can just provide a nice interface.
+
+ The font location is kind of special as it holds a halfword data field that points to a font
+ accessor and as such doesn't fit into a counter concept. Otherwise we could have made it a
+ counter. We could probably just use a font id and do a lookup elsewhere because this engine is
+ already doing it differently. So, eventually this needs checking.
+
+*/
+
+/*
+ For practical reasons we have the regions a bit different. For instance, we also have attributes, local
+ boxes, no math characters here, etc. Maybe specification codes sould get their own region.
+
+ HASH FROZEN
+ [I|R]FONTS
+ UNDEFINED
+ [I|R]GLUE
+ [I|R]MUGLUE
+ [I|R]TOKS
+ [I|R]BOXES
+ [I|R]INT
+ [I|R]ATTR
+ [I|R]DIMEN
+ SPECIFICATIONS
+ EQUIVPLUS
+
+ When I'd done a bit of clean up and abstraction (actually it took quite some time because the only
+ reliable way to do it is stepwise with lots of testing) I wondered why there is a difference in
+ the way the level is kept track of. For those entries that store a value directly, a separate
+ |xeq_level| array is used. So, after \quote {following the code}, taking a look at the original
+ implementation, and a walk, I came to the conclusion that because \LUATEX\ uses 64 memory words,
+ we actually don't need that parallel array: we have plenty of room and, the level fields are not
+ shared. In traditional \TEX\ we have a memory word with two faces:
+
+ [level] [type]
+ [ value ]
+
+ but in \LUATEX\ it's wider. There is no overlap.
+
+ [level] [type] [value]
+
+ So, we can get rid of that extra array. Actually, in the \PASCAL\ source we see that this
+ parallel array is smaller because it only covers the value ranges (the first index starts at
+ the start of the first relevant register range). Keep in mind that the middle part of the hash
+ is registers and when we have a frozen hash size, that part is not present which is why there
+ was that parallel array needed; a side effect of the |extra_hash| extension.
+
+ Another side effect of this simplification is that we can store and use the type which can be
+ handy too.
+
+ For the changes, look for |xeq simplification| comments in the files and for the cleaned up
+ precursor in the archives of luametatex (in case there is doubt). When the save stack was made
+ more efficient the old commented |xeq| code has been removed.
+
+ -----------------------------------
+ null control sequence
+ hash entries (hash_size)
+ multiple frozen control sequences
+ special sequences (font, undefined)
+ -----------------------------------
+ glue registers
+ mu glue registers
+ token registers
+ box registers
+ integer registers
+ attribute registers
+ dimension registers
+ specifications
+ ---------- eqtb size --------------
+ extra hash entries
+ -----------------------------------
+
+ eqtb_top = eqtb_size + hash_extra
+ hash_top = hash_extra == 0 ? undefined_control_sequence : eqtb_top;
+
+ There used to be a large font area but I moved that to the font record so that we don't waste
+ space (it saves some 500K on the format file and plenty of memory).
+
+ Todo: split the eqtb and make the register arrays dynamic. We need to change the save/restore
+ code then and it might have a slight impact on performance (checking what table to use).
+
+*/
+
+/*tex
+ Maybe we should multiply the following by 2 but there is no real gain. Many entries end up in the extended
+ area anyway.
+
+ \starttyping
+ # define hash_size 65536
+ # define hash_prime 55711
+ \stoptyping
+
+ Here |hash_size| is the maximum number of control sequences; it should be at most about
+ |(fix_mem_max - fix_mem_min)/10|. The value of |hash_prime| is a prime number equal to about
+ 85 percent of |hash_size|.
+
+ The hash runs in parallel to the eqtb and a large hash table makes for many holes and that
+ compresses badly. For instance:
+
+ 590023 => down to 1024 * 512 == 524288 ==> 85% = 445644 => prime 445633/445649
+
+ will make a much larger format and we gain nothing. Actually, because we have extra hash
+ anyway, this whole 85\% criterium is irrelevant: we only need to make sure that we have
+ enough room for the frozen sequences (assuming we stay within the concept).
+
+ primes:
+
+ \starttyping
+ 65447 65449 65479 65497 65519 65521 => 65536 (85% == 55711)
+ 131009 131011 131023 131041 131059 131063 => 131072 (85% == 111409)
+ \stoptyping
+
+ lookups:
+
+ \starttyping
+ n=131040 cs=46426 indirect= 9173
+ n= 65496 cs=46426 indirect=14512
+ \stoptyping
+
+*/
+
+// # define hash_size 65536
+// # define hash_prime 65497
+
+# define hash_size 131072 /*tex 128K */
+# define hash_prime 131041 /*tex Plenty of room for the frozen. */
+
+# define null_cs 1 /*tex equivalent of |\csname\| |\endcsname| */
+# define hash_base (null_cs + 1) /*tex beginning of region 2, for the hash table */
+# define frozen_control_sequence (hash_base + hash_size) /*tex for error recovery */
+
+typedef enum deep_frozen_cs_codes {
+ deep_frozen_cs_protection_code = frozen_control_sequence, /*tex inaccessible but definable */
+ deep_frozen_cs_cr_code, /*tex permanent |\cr| */
+ deep_frozen_cs_end_group_code, /*tex permanent |\endgroup| */
+ deep_frozen_cs_right_code, /*tex permanent |\right| */
+ deep_frozen_cs_fi_code, /*tex permanent |\fi| */
+ deep_frozen_cs_no_if_code, /*tex hidden |\noif| */
+ deep_frozen_cs_always_code, /*tex hidden internalized |\enforces| */
+ deep_frozen_cs_end_template_1_code, /*tex permanent |\endtemplate| */
+ deep_frozen_cs_end_template_2_code, /*tex second permanent |\endtemplate| */
+ deep_frozen_cs_relax_code, /*tex permanent |\relax| */
+ deep_frozen_cs_end_write_code, /*tex permanent |\endwrite| */
+ deep_frozen_cs_dont_expand_code, /*tex permanent |\notexpanded:| */
+ deep_frozen_cs_null_font_code, /*tex permanent |\nullfont| */
+ deep_frozen_cs_undefined_code,
+} deep_frozen_cs_codes;
+
+# define first_deep_frozen_cs_location deep_frozen_cs_protection_code
+# define last_deep_frozen_cs_location deep_frozen_cs_undefined_code
+
+typedef enum glue_codes {
+ line_skip_code, /*tex interline glue if |baseline_skip| is infeasible */
+ baseline_skip_code, /*tex desired glue between baselines */
+ par_skip_code, /*tex extra glue just above a paragraph */
+ above_display_skip_code, /*tex extra glue just above displayed math */
+ below_display_skip_code, /*tex extra glue just below displayed math */
+ above_display_short_skip_code, /*tex glue above displayed math following short lines */
+ below_display_short_skip_code, /*tex glue below displayed math following short lines */
+ left_skip_code, /*tex glue at left of justified lines */
+ right_skip_code, /*tex glue at right of justified lines */
+ top_skip_code, /*tex glue at top of main pages */
+ split_top_skip_code, /*tex glue at top of split pages */
+ tab_skip_code, /*tex glue between aligned entries */
+ space_skip_code, /*tex glue between words (if not |zero_glue|) */
+ xspace_skip_code, /*tex glue after sentences (if not |zero_glue|) */
+ par_fill_left_skip_code, /*tex glue at the start of the last line of paragraph */
+ par_fill_right_skip_code, /*tex glue on last line of paragraph */
+ par_init_left_skip_code,
+ par_init_right_skip_code,
+ /* indent_skip_code, */ /*tex internal, might go away here */
+ /* left_hang_skip_code, */ /*tex internal, might go away here */
+ /* right_hang_skip_code, */ /*tex internal, might go away here */
+ /* correction_skip_code, */ /*tex internal, might go away here */
+ /* inter_math_skip_code, */ /*tex internal, might go away here */
+ math_skip_code, /*tex glue before and after inline math */
+ math_threshold_code,
+ /*tex total number of glue parameters */
+ number_glue_pars,
+} glue_codes;
+
+# define first_glue_code line_skip_code
+# define last_glue_code math_threshold_code
+
+/*tex
+
+ In addition to the three original predefined muskip registers we have two more. These muskips
+ are used in a symbolic way: by using a reference we can change their values on the fly and the
+ engine will pick up the value set at the end of the formula (and use it in the second pass).
+ In the other engines the threesome are hard coded into the atom pair spacing.
+
+ In \LUAMETATEX\ we have a configurable system so these three registers are only used in the
+ initialization, can be overloaded in the macro package, and are saved in the format file (as
+ any other register). But there can be more than these. Before we had a way to link spacing to
+ arbitrary registers (in the user's register space) we added |\tinymuskip| because we needed it.
+ It is not used in initializations in the engine but is applied in the \CONTEXT\ format. We
+ could throw it out and use just a user register now but we consider it part of the (updated)
+ concept so it will stick around. Even more: we decided that a smaller one makes sense so end
+ June 2022 Mikael and I decided to also provide |\pettymuskip| for which Mikael saw a good use
+ case in the spacing in scripts between ordinary symbols and binary as well as relational ones.
+
+ The Cambridge dictionary describes \quote {petty} as \quotation {not important and not worth
+ giving attention to}, but of course we do! It's just that till not we never saw any request
+ for an upgrade of the math (sub) engine, let alone that \TEX\ users bothered about the tiny
+ and petty spacing artifacts (and posibilities) of the engine. Both internal registers are
+ dedicated to Don Knuth who {\em does} pay a lot attentions to details but who of course will
+ not use this engine and thereby not spoiled. So, they are there and at the same time they
+ are not. But: in \CONTEXT\ they {\em are} definitely used!
+
+*/
+
+typedef enum mu_glue_codes {
+ zero_mu_skip_code,
+ petty_mu_skip_code, /*tex petty space in math formula */
+ tiny_mu_skip_code, /*tex tiny space in math formula */
+ thin_mu_skip_code, /*tex thin space in math formula */
+ med_mu_skip_code, /*tex medium space in math formula */
+ thick_mu_skip_code, /*tex thick space in math formula */
+ /*tex total number of mu glue parameters */
+ number_mu_glue_pars,
+} mu_glue_codes;
+
+# define first_mu_glue_code petty_mu_skip_code
+# define last_mu_glue_code thick_mu_skip_code
+
+typedef enum tok_codes {
+ output_routine_code, /*tex points to token list for |\output| */
+ every_par_code, /*tex points to token list for |\everypar| */
+ every_math_code, /*tex points to token list for |\everymath| */
+ every_display_code, /*tex points to token list for |\everydisplay| */
+ every_hbox_code, /*tex points to token list for |\everyhbox| */
+ every_vbox_code, /*tex points to token list for |\everyvbox| */
+ every_math_atom_code, /*tex points to token list for |\everymathatom| */
+ every_job_code, /*tex points to token list for |\everyjob|*/
+ every_cr_code, /*tex points to token list for |\everycr| */
+ every_tab_code, /*tex points to token list for |\everytab| */
+ error_help_code, /*tex points to token list for |\errhelp|*/
+ every_before_par_code, /*tex points to token list for |\everybeforepar| */
+ every_eof_code, /*tex points to token list for |\everyeof| */
+ end_of_group_code, /*tex collects end-of-group tokens, internal register */
+ // end_of_par_code,
+ /*tex total number of token parameters */
+ number_tok_pars,
+} tok_codes;
+
+# define first_toks_code output_routine_code
+# define last_toks_code every_eof_code
+
+typedef enum specification_codes {
+ par_shape_code, /*tex specifies paragraph shape, internal register */
+ inter_line_penalties_code, /*tex additional penalties between lines */
+ club_penalties_code, /*tex penalties for creating club lines */
+ widow_penalties_code, /*tex penalties for creating widow lines */
+ display_widow_penalties_code, /*tex ditto, just before a display */
+ orphan_penalties_code,
+ math_forward_penalties_code,
+ math_backward_penalties_code,
+ number_specification_pars,
+} specification_codes;
+
+# define first_specification_code par_shape_code
+# define last_specification_code math_backward_penalties_code
+
+/*tex Beware: these are indices into |page_builder_state.page_so_far| array! */
+
+typedef enum page_property_codes {
+ page_goal_code,
+ page_vsize_code,
+ page_total_code,
+ page_depth_code,
+ dead_cycles_code,
+ insert_penalties_code,
+ insert_heights_code,
+ insert_storing_code, /* page */
+ insert_distance_code,
+ insert_multiplier_code,
+ insert_limit_code,
+ insert_storage_code, /* per insert */
+ insert_penalty_code,
+ insert_maxdepth_code,
+ insert_height_code,
+ insert_depth_code,
+ insert_width_code,
+ page_stretch_code,
+ page_filstretch_code,
+ page_fillstretch_code,
+ page_filllstretch_code,
+ page_shrink_code,
+} page_property_codes;
+
+# define first_page_property_code page_goal_code
+# define last_page_property_code insert_width_code
+
+/*tex
+ We cheat: these previous bases are to really bases which is why math and del get separated by
+ one. See usage! Todo: group them better (also elsewhere in switches).
+*/
+
+typedef enum int_codes {
+ pre_tolerance_code, /*tex badness tolerance before hyphenation */
+ tolerance_code, /*tex badness tolerance after hyphenation */
+ line_penalty_code, /*tex added to the badness of every line */
+ hyphen_penalty_code, /*tex penalty for break after discretionary hyphen */
+ ex_hyphen_penalty_code, /*tex penalty for break after explicit hyphen */
+ club_penalty_code, /*tex penalty for creating a club line */
+ widow_penalty_code, /*tex penalty for creating a widow line */
+ display_widow_penalty_code, /*tex ditto, just before a display */
+ broken_penalty_code, /*tex penalty for breaking a page at a broken line */
+ post_binary_penalty_code, /*tex penalty for breaking after a binary operation */
+ post_relation_penalty_code, /*tex penalty for breaking after a relation */
+ pre_display_penalty_code, /*tex penalty for breaking just before a displayed formula */
+ post_display_penalty_code, /*tex penalty for breaking just after a displayed formula */
+ pre_inline_penalty_code, /*tex penalty for breaking just before an inlined formula */
+ post_inline_penalty_code, /*tex penalty for breaking just after an inlined formula */
+ inter_line_penalty_code, /*tex additional penalty between lines */
+ double_hyphen_demerits_code, /*tex demerits for double hyphen break */
+ final_hyphen_demerits_code, /*tex demerits for final hyphen break */
+ adj_demerits_code, /*tex demerits for adjacent incompatible lines */
+ /* mag_code, */ /*tex magnification ratio */
+ delimiter_factor_code, /*tex ratio for variable-size delimiters */
+ looseness_code, /*tex change in number of lines for a paragraph */
+ time_code, /*tex current time of day */
+ day_code, /*tex current day of the month */
+ month_code, /*tex current month of the year */
+ year_code, /*tex current year of our Lord */
+ show_box_breadth_code, /*tex nodes per level in |show_box| */
+ show_box_depth_code, /*tex maximum level in |show_box| */
+ show_node_details_code, /*tex controls subtype and attribute details */
+ hbadness_code, /*tex hboxes exceeding this badness will be shown by |hpack| */
+ vbadness_code, /*tex vboxes exceeding this badness will be shown by |vpack| */
+ pausing_code, /*tex pause after each line is read from a file */
+ tracing_online_code, /*tex show diagnostic output on terminal */
+ tracing_macros_code, /*tex show macros as they are being expanded */
+ tracing_stats_code, /*tex show memory usage if \TeX\ knows it */
+ tracing_paragraphs_code, /*tex show line-break calculations */
+ tracing_pages_code, /*tex show page-break calculations */
+ tracing_output_code, /*tex show boxes when they are shipped out */
+ tracing_lost_chars_code, /*tex show characters that aren't in the font */
+ tracing_commands_code, /*tex show command codes at |big_switch| */
+ tracing_restores_code, /*tex show equivalents when they are restored */
+ tracing_fonts_code,
+ tracing_assigns_code, /*tex show assignments */
+ tracing_groups_code, /*tex show save/restore groups */
+ tracing_ifs_code, /*tex show conditionals */
+ tracing_math_code,
+ tracing_levels_code, /*tex show levels when tracing */
+ tracing_nesting_code, /*tex show incomplete groups and ifs within files */
+ tracing_alignments_code, /*tex show nesting of noalign and preambles */
+ tracing_inserts_code, /*tex show some info about insert processing */
+ tracing_marks_code, /*tex show state of marks */
+ tracing_adjusts_code, /*tex show state of marks */
+ tracing_hyphenation_code, /*tex show some info regarding hyphenation */
+ tracing_expressions_code, /*tex show some info regarding expressions */
+ tracing_nodes_code, /*tex show node numbers too */
+ tracing_full_boxes_code, /*tex show [over/under]full boxes in the log */
+ tracing_penalties_code,
+ uc_hyph_code, /*tex hyphenate words beginning with a capital letter */
+ output_penalty_code, /*tex penalty found at current page break */
+ max_dead_cycles_code, /*tex bound on consecutive dead cycles of output */
+ hang_after_code, /*tex hanging indentation changes after this many lines */
+ floating_penalty_code, /*tex penalty for insertions heldover after a split */
+ global_defs_code, /*tex override |\global| specifications */
+ family_code, /*tex current family */
+ escape_char_code, /*tex escape character for token output */
+ default_hyphen_char_code, /*tex value of |\hyphenchar| when a font is loaded */
+ default_skew_char_code, /*tex value of |\skewchar| when a font is loaded */
+ end_line_char_code, /*tex character placed at the right end of the buffer */
+ new_line_char_code, /*tex character that prints as |print_ln| */
+ language_code, /*tex current language */
+ font_code, /*tex current font */
+ hyphenation_mode_code,
+ left_hyphen_min_code, /*tex minimum left hyphenation fragment size */
+ right_hyphen_min_code, /*tex minimum right hyphenation fragment size */
+ holding_inserts_code, /*tex do not remove insertion nodes from |\box255| */
+ holding_migrations_code,
+ error_context_lines_code, /*tex maximum intermediate line pairs shown */
+ local_interline_penalty_code, /*tex local |\interlinepenalty| */
+ local_broken_penalty_code, /*tex local |\brokenpenalty| */
+ disable_spaces_code,
+ glyph_scale_code,
+ glyph_x_scale_code,
+ glyph_y_scale_code,
+ glyph_data_code,
+ glyph_state_code,
+ glyph_script_code,
+ glyph_options_code,
+ glyph_text_scale_code,
+ glyph_script_scale_code,
+ glyph_scriptscript_scale_code,
+ /* glue_data_code, */
+ cat_code_table_code,
+ output_box_code,
+ ex_hyphen_char_code,
+ adjust_spacing_code, /*tex level of spacing adjusting */
+ adjust_spacing_step_code, /*tex level of spacing adjusting step */
+ adjust_spacing_stretch_code, /*tex level of spacing adjusting stretch */
+ adjust_spacing_shrink_code, /*tex level of spacing adjusting shrink */
+ protrude_chars_code, /*tex protrude chars at left/right edge of paragraphs */
+ pre_display_direction_code, /*tex text direction preceding a display */
+ last_line_fit_code, /*tex adjustment for last line of paragraph */
+ saving_vdiscards_code, /*tex save items discarded from vlists */
+ saving_hyph_codes_code, /*tex save hyphenation codes for languages */
+ math_eqno_gap_step_code, /*tex factor/1000 used for distance between eq and eqno */
+ math_display_skip_mode_code,
+ math_scripts_mode_code,
+ /* math_script_box_mode_code, */
+ /* math_script_char_mode_code, */
+ math_limits_mode_code,
+ math_nolimits_mode_code,
+ math_rules_mode_code,
+ math_rules_fam_code,
+ math_penalties_mode_code,
+ math_check_fences_mode_code,
+ /* math_delimiters_mode_code, */
+ /* math_fences_mode_code, */
+ /* math_rule_thickness_mode_code, */
+ math_slack_mode_code,
+ /* math_flatten_mode_code, */
+ math_skip_mode_code,
+ math_double_script_mode_code,
+ /* math_control_mode_code, */
+ math_font_control_code,
+ math_display_mode_code,
+ math_dict_group_code,
+ math_dict_properties_code,
+ math_pre_display_gap_factor_code,
+ pre_binary_penalty_code,
+ pre_relation_penalty_code,
+ first_valid_language_code,
+ automatic_hyphen_penalty_code,
+ explicit_hyphen_penalty_code,
+ exception_penalty_code,
+ copy_lua_input_nodes_code,
+ auto_migration_mode_code,
+ normalize_line_mode_code,
+ normalize_par_mode_code,
+ math_spacing_mode_code,
+ math_grouping_mode_code,
+ math_glue_mode_code,
+ math_begin_class_code,
+ math_end_class_code,
+ math_left_class_code,
+ math_right_class_code,
+ sup_mark_mode_code,
+ par_direction_code,
+ text_direction_code,
+ math_direction_code,
+ line_direction_code, /*tex gets remapped so is no real register */
+ overload_mode_code,
+ auto_paragraph_mode_code,
+ shaping_penalties_mode_code,
+ shaping_penalty_code,
+ orphan_penalty_code,
+ alignment_cell_source_code,
+ alignment_wrap_source_code,
+ /* page_boundary_penalty_code, */
+ line_break_criterium_code,
+ /* those below these are not interfaced via primitives */
+ internal_par_state_code,
+ internal_dir_state_code,
+ internal_math_style_code,
+ internal_math_scale_code,
+ /*tex total number of integer parameters */
+ first_math_class_code,
+ last_math_class_code = first_math_class_code + max_n_of_math_classes,
+ first_math_atom_code,
+ last_math_atom_code = first_math_atom_code + max_n_of_math_classes,
+ first_math_options_code,
+ last_math_options_code = first_math_options_code + max_n_of_math_classes,
+ first_math_parent_code,
+ last_math_parent_code = first_math_parent_code + max_n_of_math_classes,
+ first_math_pre_penalty_code,
+ last_math_pre_penalty_code = first_math_pre_penalty_code + max_n_of_math_classes,
+ first_math_post_penalty_code,
+ last_math_post_penalty_code = first_math_post_penalty_code + max_n_of_math_classes,
+ first_math_display_pre_penalty_code,
+ last_math_display_pre_penalty_code = first_math_display_pre_penalty_code + max_n_of_math_classes,
+ first_math_display_post_penalty_code,
+ last_math_display_post_penalty_code = first_math_display_post_penalty_code + max_n_of_math_classes,
+ first_math_ignore_code,
+ last_math_ignore_code = first_math_ignore_code + math_parameter_last,
+ /* */
+ number_int_pars,
+} int_codes;
+
+# define first_int_code pre_tolerance_code
+# define last_int_code line_break_criterium_code
+
+typedef enum dimen_codes {
+ par_indent_code, /*tex indentation of paragraphs */
+ math_surround_code, /*tex space around math in text */
+ line_skip_limit_code, /*tex threshold for |line_skip| instead of |baseline_skip| */
+ hsize_code, /*tex line width in horizontal mode */
+ vsize_code, /*tex page height in vertical mode */
+ max_depth_code, /*tex maximum depth of boxes on main pages */
+ split_max_depth_code, /*tex maximum depth of boxes on split pages */
+ box_max_depth_code, /*tex maximum depth of explicit vboxes */
+ hfuzz_code, /*tex tolerance for overfull hbox messages */
+ vfuzz_code, /*tex tolerance for overfull vbox messages */
+ delimiter_shortfall_code, /*tex maximum amount uncovered by variable delimiters */
+ null_delimiter_space_code, /*tex blank space in null delimiters */
+ script_space_code, /*tex extra space after subscript or superscript */
+ pre_display_size_code, /*tex length of text preceding a display */
+ display_width_code, /*tex length of line for displayed equation */
+ display_indent_code, /*tex indentation of line for displayed equation */
+ overfull_rule_code, /*tex width of rule that identifies overfull hboxes */
+ hang_indent_code, /*tex amount of hanging indentation */
+ /* h_offset_code, */ /*tex amount of horizontal offset when shipping pages out */
+ /* v_offset_code, */ /*tex amount of vertical offset when shipping pages out */
+ emergency_stretch_code, /*tex reduces badnesses on final pass of line-breaking */
+ glyph_x_offset_code,
+ glyph_y_offset_code,
+ px_dimen_code,
+ tab_size_code,
+ page_extra_goal_code,
+ /*tex total number of dimension parameters */
+ number_dimen_pars,
+} dimen_codes;
+
+# define first_dimen_code par_indent_code
+# define last_dimen_code tab_size_code
+
+typedef enum attribute_codes {
+ /*tex total number of attribute parameters */
+ number_attribute_pars,
+} attribute_codes;
+
+// typedef enum special_sequence_codes {
+// // current_font_sequence_code,
+// undefined_control_sequence_code,
+// n_of_special_sequences,
+// } special_sequence_codes;
+//
+// /* The last one is frozen_null_font. */
+//
+// # define special_sequence_base (last_frozen_cs_loc + 1)
+// # define current_font_sequence (special_sequence_base + current_font_sequence_code)
+// # define undefined_control_sequence (special_sequence_base + undefined_control_sequence_code)
+// # define first_register_base (special_sequence_base + n_of_special_sequences)
+
+# define undefined_control_sequence deep_frozen_cs_undefined_code
+
+# define special_sequence_base (last_deep_frozen_cs_location + 1)
+# define first_register_base (last_deep_frozen_cs_location + 1)
+
+# define internal_glue_base (first_register_base)
+# define register_glue_base (internal_glue_base + number_glue_pars + 1)
+# define internal_glue_location(a) (internal_glue_base + (a))
+# define register_glue_location(a) (register_glue_base + (a))
+# define internal_glue_number(a) ((a) - internal_glue_base)
+# define register_glue_number(a) ((a) - register_glue_base)
+
+# define internal_mu_glue_base (register_glue_base + max_n_of_glue_registers)
+# define register_mu_glue_base (internal_mu_glue_base + number_mu_glue_pars + 1)
+# define internal_mu_glue_location(a) (internal_mu_glue_base + (a))
+# define register_mu_glue_location(a) (register_mu_glue_base + (a))
+# define internal_mu_glue_number(a) ((a) - internal_mu_glue_base)
+# define register_mu_glue_number(a) ((a) - register_mu_glue_base)
+
+# define internal_toks_base (register_mu_glue_base + max_n_of_mu_glue_registers)
+# define register_toks_base (internal_toks_base + number_tok_pars + 1)
+# define internal_toks_location(a) (internal_toks_base + (a))
+# define register_toks_location(a) (register_toks_base + (a))
+# define internal_toks_number(a) ((a) - internal_toks_base)
+# define register_toks_number(a) ((a) - register_toks_base)
+
+# define internal_box_base (register_toks_base + max_n_of_toks_registers)
+# define register_box_base (internal_box_base + number_box_pars + 1)
+# define internal_box_location(a) (internal_box_base + (a))
+# define register_box_location(a) (register_box_base + (a))
+# define internal_box_number(a) ((a) - internal_box_base)
+# define register_box_number(a) ((a) - register_box_base)
+
+# define internal_int_base (register_box_base + max_n_of_box_registers)
+# define register_int_base (internal_int_base + number_int_pars + 1)
+# define internal_int_location(a) (internal_int_base + (a))
+# define register_int_location(a) (register_int_base + (a))
+# define internal_int_number(a) ((a) - internal_int_base)
+# define register_int_number(a) ((a) - register_int_base)
+
+# define internal_attribute_base (register_int_base + max_n_of_int_registers)
+# define register_attribute_base (internal_attribute_base + number_attribute_pars + 1)
+# define internal_attribute_location(a) (internal_attribute_base + (a))
+# define register_attribute_location(a) (register_attribute_base + (a))
+# define internal_attribute_number(a) ((a) - internal_attribute_base)
+# define register_attribute_number(a) ((a) - register_attribute_base)
+
+# define internal_dimen_base (register_attribute_base + max_n_of_attribute_registers)
+# define register_dimen_base (internal_dimen_base + number_dimen_pars + 1)
+# define internal_dimen_location(a) (internal_dimen_base + (a))
+# define register_dimen_location(a) (register_dimen_base + (a))
+# define internal_dimen_number(a) ((a) - internal_dimen_base)
+# define register_dimen_number(a) ((a) - register_dimen_base)
+
+# define internal_specification_base (register_dimen_base + max_n_of_dimen_registers)
+# define internal_specification_location(a) (internal_specification_base + (a))
+# define internal_specification_number(a) ((a) - internal_specification_base)
+
+# define eqtb_size (internal_specification_base + number_specification_pars)
+
+# define eqtb_indirect_range(n) ((n < internal_glue_base) || ((n > eqtb_size) && (n <= lmt_hash_state.hash_data.top)))
+# define eqtb_out_of_range(n) ((n >= undefined_control_sequence) && ((n <= eqtb_size) || n > lmt_hash_state.hash_data.top))
+# define eqtb_valid_cs(n) ((n == 0) || (n > lmt_hash_state.hash_data.top) || ((n > frozen_control_sequence) && (n <= eqtb_size)))
+
+# define character_in_range(i) (i >= 0 && i <= max_character_code)
+# define catcode_in_range(i) (i >= 0 && i <= max_category_code)
+# define family_in_range(i) (i >= 0 && i <= max_math_family_index)
+# define class_in_range(i) (i >= 0 && i <= max_math_class_code)
+# define half_in_range(i) (i >= 0 && i <= max_half_value)
+# define box_index_in_range(i) (i >= 0 && i <= max_box_index)
+
+/* These also have funny offsets: */
+
+typedef enum align_codes {
+ tab_mark_code,
+ span_code,
+ omit_code,
+ align_content_code,
+ no_align_code,
+ cr_code,
+ cr_cr_code,
+} align_codes;
+
+/*
+ typedef struct equivalents_state_info {
+ } equivalents_state_info ;
+
+ extern equivalents_state_info lmt_equivalents_state;
+*/
+
+extern void tex_initialize_levels (void);
+extern void tex_initialize_equivalents (void);
+extern void tex_synchronize_equivalents (void);
+extern void tex_initialize_undefined_cs (void);
+extern void tex_dump_equivalents_mem (dumpstream f);
+extern void tex_undump_equivalents_mem (dumpstream f);
+
+/*tex
+ The more low level |_field| shortcuts are used when we (for instance) work with copies, as done
+ in the save stack entries. In most cases we use the second triplet of shortcuts. We replaced
+ |equiv(A)| and |equiv_value(A)| by |eq_value(A)}|.
+*/
+
+# define eq_level_field(A) (A).quart01
+# define eq_full_field(A) (A).quart00
+# define eq_type_field(A) (A).single00
+# define eq_flag_field(A) (A).single01
+# define eq_value_field(A) (A).half1
+
+# define eq_level(A) lmt_hash_state.eqtb[(A)].quart01 /*tex level of definition */
+# define eq_full(A) lmt_hash_state.eqtb[(A)].quart00 /*tex command code for equivalent */
+# define eq_type(A) lmt_hash_state.eqtb[(A)].single00 /*tex command code for equivalent */
+# define eq_flag(A) lmt_hash_state.eqtb[(A)].single01
+# define eq_value(A) lmt_hash_state.eqtb[(A)].half1
+
+# define set_eq_level(A,B) lmt_hash_state.eqtb[(A)].quart01 = (quarterword) (B)
+# define set_eq_type(A,B) lmt_hash_state.eqtb[(A)].single00 = (singleword) (B)
+# define set_eq_flag(A,B) lmt_hash_state.eqtb[(A)].single01 = (singleword) (B)
+# define set_eq_value(A,B) lmt_hash_state.eqtb[(A)].half1 = (B)
+
+# define copy_eqtb_entry(target,source) lmt_hash_state.eqtb[target] = lmt_hash_state.eqtb[source]
+
+# define equal_eqtb_entries(A,B) ( \
+ (lmt_hash_state.eqtb[(A)].half0 == lmt_hash_state.eqtb[(B)].half0) \
+ && (lmt_hash_state.eqtb[(A)].half1 == lmt_hash_state.eqtb[(B)].half1) \
+)
+
+/*tex
+
+ Because we operate in 64 bit we padd with a halfword, and because if that we have an extra field. Now,
+ because we already no longer need the parallel eqtb level table, we can use this field to store the
+ value alongside which makes that we can turn the dual slot |restore_old_value| and |saved_eqtb| into
+ one which in turn makes stack usage shrink. The performance gain is probably neglectable.
+
+*/
+
+typedef struct save_record {
+ quarterword saved_level;
+ quarterword saved_type; /*tex We need less so we can actually decide to store the offset as check. */
+ halfword saved_value; /*tex Started out as padding, is now actually used for value. */
+ memoryword saved_word;
+} save_record;
+
+typedef struct save_state_info {
+ save_record *save_stack;
+ memory_data save_stack_data;
+ quarterword current_level; /*tex current nesting level for groups */
+ quarterword current_group; /*tex current group type */
+ int current_boundary; /*tex where the current level begins */
+ int padding;
+} save_state_info;
+
+extern save_state_info lmt_save_state;
+
+# define cur_level lmt_save_state.current_level
+# define cur_group lmt_save_state.current_group
+# define cur_boundary lmt_save_state.current_boundary
+
+/*tex
+
+ We use the notation |saved(k)| to stand for an item that appears in location |save_ptr + k| of
+ the save stack.
+
+ The level field is also available for other purposes, so maybe we need an alias that is more
+ generic.
+
+*/
+
+# define save_type(A) lmt_save_state.save_stack[(A)].saved_type /*tex classifies a |save_stack| entry */
+# define save_extra(A) lmt_save_state.save_stack[(A)].saved_level /*tex a more generic alias: to be used */
+# define save_level(A) lmt_save_state.save_stack[(A)].saved_level /*tex saved level for regions 5 and 6, or group code, or ... */
+# define save_value(A) lmt_save_state.save_stack[(A)].saved_value /*tex |eqtb| location or token or |save_stack| location or ... */
+# define save_word(A) lmt_save_state.save_stack[(A)].saved_word /*tex |eqtb| entry */
+
+# define saved_valid(A) (lmt_save_state.save_stack_data.ptr + (A) >= 0)
+# define saved_type(A) lmt_save_state.save_stack[lmt_save_state.save_stack_data.ptr + (A)].saved_type
+# define saved_extra(A) lmt_save_state.save_stack[lmt_save_state.save_stack_data.ptr + (A)].saved_level
+# define saved_level(A) lmt_save_state.save_stack[lmt_save_state.save_stack_data.ptr + (A)].saved_level
+# define saved_value(A) lmt_save_state.save_stack[lmt_save_state.save_stack_data.ptr + (A)].saved_value
+# define saved_word(A) lmt_save_state.save_stack[lmt_save_state.save_stack_data.ptr + (A)].saved_word
+
+inline void tex_set_saved_record(halfword ptr, quarterword type, quarterword level, halfword value)
+{
+ saved_type(ptr) = type;
+ saved_level(ptr) = level;
+ saved_value(ptr) = value;
+}
+
+# define reserved_save_stack_slots 32 /* was 8 */
+
+/*tex
+
+ The rather explicit |save_| items indicate a type. They are sometimes used to lookup a specific
+ field (when tracing).
+*/
+
+typedef enum save_types {
+ restore_old_value, /*tex a value should be restored later */
+ restore_zero, /*tex an undefined entry should be restored */
+ insert_tokens,
+ restore_lua,
+ level_boundary, /*tex the beginning of a group */
+ /* */
+ saved_line_number,
+ /* */
+ saved_insert_index,
+ /* */
+ saved_discretionary_count,
+ /* */
+ saved_text_direction,
+ /* */
+ saved_equation_number_location,
+ /* */
+ saved_choices_count,
+ /* */
+ saved_fraction_variant,
+ saved_fraction_auto_style,
+ saved_fraction_user_style,
+ saved_operator_variant,
+ /* */
+ saved_attribute_list,
+ /* */
+ saved_math_pointer,
+ saved_math_class,
+ /* */
+ saved_box_type,
+ saved_box_context,
+ saved_box_spec,
+ saved_box_direction,
+ saved_box_attr_list,
+ saved_box_pack,
+ saved_box_orientation,
+ saved_box_anchor,
+ saved_box_geometry,
+ saved_box_xoffset,
+ saved_box_yoffset,
+ saved_box_xmove,
+ saved_box_ymove,
+ saved_box_reverse,
+ saved_box_discard,
+ saved_box_noskips,
+ saved_box_callback,
+ saved_box_container,
+ saved_box_shift,
+ saved_box_source,
+ saved_box_target,
+ saved_box_axis,
+ saved_box_class,
+ saved_box_state,
+ saved_box_retain,
+ /* */
+ saved_local_box_location,
+ saved_local_box_index,
+ saved_local_box_options,
+ /* */
+ saved_adjust_location,
+ saved_adjust_options,
+ saved_adjust_index,
+ saved_adjust_attr_list,
+ saved_adjust_depth_before,
+ saved_adjust_depth_after,
+} save_types;
+
+/*tex Nota bena: |equiv_value| is the same as |equiv| but sometimes we use that name instead. */
+
+// int_par(A) hash_state.eqtb_i_i[(A)].half1
+
+# define int_parameter(A) eq_value(internal_int_location(A))
+# define count_parameter(A) eq_value(internal_int_location(A))
+# define attribute_parameter(A) eq_value(internal_attribute_location(A))
+# define dimen_parameter(A) eq_value(internal_dimen_location(A))
+# define toks_parameter(A) eq_value(internal_toks_location(A))
+# define glue_parameter(A) eq_value(internal_glue_location(A))
+# define mu_glue_parameter(A) eq_value(internal_mu_glue_location(A))
+# define box_parameter(A) eq_value(internal_box_location(A))
+# define specification_parameter(A) eq_value(internal_specification_location(A))
+
+/*tex These come from |\ALEPH| aka |\OMEGA|: */
+
+
+# define is_valid_local_box_code(c) (c >= first_local_box_code && c <= last_local_box_code)
+
+/*tex
+
+ Here are the group codes that are used to discriminate between different kinds of groups. They
+ allow \TEX\ to decide what special actions, if any, should be performed when a group ends.
+
+ Some groups are not supposed to be ended by right braces. For example, the |$| that begins a
+ math formula causes a |math_shift_group| to be started, and this should be terminated by a
+ matching |$|. Similarly, a group that starts with |\left| should end with |\right|, and one
+ that starts with |\begingroup| should end with |\endgroup|.
+
+*/
+
+typedef enum tex_group_codes {
+ bottom_level_group, /*tex group code for the outside world */
+ simple_group, /*tex group code for local structure only */
+ hbox_group, /*tex code for |\hbox| */
+ adjusted_hbox_group, /*tex code for |\hbox| in vertical mode */
+ vbox_group, /*tex code for |\vbox| */
+ vtop_group, /*tex code for |\vtop| */
+ align_group, /*tex code for |\halign|, |\valign| */
+ no_align_group, /*tex code for |\noalign| */
+ output_group, /*tex code for output routine */
+ math_group, /*tex code for, e.g., |\char'136| */
+ discretionary_group, /*tex code for |\discretionary|' */
+ insert_group, /*tex code for |\insert| */
+ vadjust_group, /*tex code for |\vadjust| */
+ vcenter_group, /*tex code for |\vcenter| */
+ math_fraction_group, /*tex code for |\over| and friends */
+ math_operator_group,
+ math_choice_group, /*tex code for |\mathchoice| */
+ also_simple_group, /*tex code for |\begingroup|\unknown|\egroup| */
+ semi_simple_group, /*tex code for |\begingroup|\unknown|\endgroup| */
+ math_simple_group, /*tex code for |\beginmathgroup|\unknown|\endmathgroup| */
+ math_shift_group, /*tex code for |$|\unknown\|$| */
+ math_fence_group, /*tex code for fences |\left|\unknown|\right| */
+ local_box_group, /*tex code for |\localleftbox|\unknown|localrightbox| */
+ split_off_group, /*tex box code for the top part of a |\vsplit| */
+ split_keep_group, /*tex box code for the bottom part of a |\vsplit| */
+ preamble_group, /*tex box code for the preamble processing in an alignment */
+ align_set_group, /*tex box code for the final item pass in an alignment */
+ finish_row_group, /*tex box code for a provisory line in an alignment */
+ lua_group,
+} tex_group_codes;
+
+typedef enum saved_group_items {
+ saved_group_line_number = 0,
+ saved_group_level_boundary = 1,
+ saved_group_n_of_items = 2,
+} saved_group_items;
+
+/*
+ In the end I decided to split them into context and begin, but maybe some day
+ they all merge into one (easier on tracing and reporting in shared helpers).
+*/
+
+typedef enum tex_par_context_codes {
+ normal_par_context,
+ vmode_par_context,
+ vbox_par_context,
+ vtop_par_context,
+ vcenter_par_context,
+ vadjust_par_context,
+ insert_par_context,
+ output_par_context,
+ align_par_context,
+ no_align_par_context,
+ span_par_context,
+ reset_par_context,
+} tex_par_context_codes;
+
+typedef enum tex_alignment_context_codes {
+ preamble_pass_alignment_context,
+ preroll_pass_alignment_context,
+ package_pass_alignment_context,
+ wrapup_pass_alignment_context,
+} tex_alignment_context_codes;
+
+typedef enum tex_page_context_codes {
+ box_page_context,
+ end_page_context,
+ vadjust_page_context,
+ penalty_page_context,
+ boundary_page_context,
+ insert_page_context,
+ hmode_par_page_context,
+ vmode_par_page_context,
+ begin_paragraph_page_context,
+ before_display_page_context,
+ after_display_page_context,
+ after_output_page_context,
+ alignment_page_context,
+} tex_page_context_codes;
+
+typedef enum tex_append_line_context_codes {
+ box_append_line_context,
+ pre_box_append_line_context,
+ pre_adjust_append_line_context,
+ post_adjust_append_line_context,
+ pre_migrate_append_line_context,
+ post_migrate_append_line_context,
+} tex_append_line_context_codes;
+
+typedef enum tex_par_begin_codes {
+ normal_par_begin,
+ force_par_begin,
+ indent_par_begin,
+ no_indent_par_begin,
+ math_char_par_begin,
+ char_par_begin,
+ boundary_par_begin,
+ space_par_begin,
+ math_par_begin,
+ kern_par_begin,
+ hskip_par_begin,
+ un_hbox_char_par_begin,
+ valign_char_par_begin,
+ vrule_char_par_begin,
+} tex_par_begin_codes;
+
+typedef enum tex_tracing_levels_codes {
+ tracing_levels_group = 0x01,
+ tracing_levels_input = 0x02,
+ tracing_levels_catcodes = 0x04,
+} tex_tracing_levels_codes;
+
+extern void tex_initialize_save_stack (void);
+/* int tex_room_on_save_stack (void); */
+extern void tex_save_halfword_on_stack (quarterword t, halfword v);
+extern void tex_show_cmd_chr (halfword cmd, halfword chr);
+extern void tex_new_save_level (quarterword c); /*tex begin a new level of grouping */
+extern int tex_saved_line_at_level (void);
+extern void tex_eq_define (halfword p, singleword cmd, halfword chr); /*tex new data for |eqtb| */
+extern void tex_eq_word_define (halfword p, int w);
+extern void tex_geq_define (halfword p, singleword cmd, halfword chr); /*tex global |eq_define| */
+extern void tex_geq_word_define (halfword p, int w); /*tex global |eq_word_define| */
+extern void tex_save_for_after_group (halfword t);
+extern void tex_unsave (void); /*tex pops the top level off the save stack */
+extern void tex_show_save_groups (void);
+extern int tex_located_save_value (int id);
+
+/*tex
+
+ The |prefixed_command| does not have to adjust |a| so that |a mod 4 = 0|, since the following
+ routines test for the |\global| prefix as follows. Anyway, in the meantime we reshuffled the
+ bits and changed a lot.
+
+ When we need more bits, we will do this:
+
+ One one of these:
+
+ \starttyping
+ primitive_flag = 00000001 : cannot be changed system set
+ permanent_flag = 00000010 : cannot be changed \permanent
+ immutable_flag = 00000011 : cannot be changed \immutable
+ frozen_flag = 00000100 : can be overloaded \frozen and \overloaded
+ mutable_flag = 00000101 : never checked \mutable
+ reserved_1_flag = 00000110
+ \stoptyping
+
+ Independent, not used combined:
+
+ \starttyping
+ noaligned_flag = 00001000 : valid align peek \noaligned (can be more generic: \alignpeekable or \alignable, also span and omit?)
+ reserved_3_flag = 00010000 : maybe obsolete indicator
+ \stoptyping
+
+ Informative:
+
+ \starttyping
+ instance_flag = 00100000 : just a tag \instance
+ symbol_flag = 01000000 : just a tag \symbolic (or character)
+ c_quantity_flag = 01100000
+ d_quantity-flag = 10000000
+ reserved_4_flag = 10100000
+ reserved_5_flag = 11100000
+ \stoptyping
+
+ Maybe names like \flaginstance \flagpermanent etc are better? Now we run out of meaningful
+ prefixes. Also testing the prefix then becomes more work.
+
+*/
+
+typedef enum flag_bit {
+ /* properties and prefixes */
+ frozen_flag_bit = 0x00001,
+ permanent_flag_bit = 0x00002,
+ immutable_flag_bit = 0x00004,
+ primitive_flag_bit = 0x00008,
+ mutable_flag_bit = 0x00010,
+ noaligned_flag_bit = 0x00020,
+ instance_flag_bit = 0x00040,
+ untraced_flag_bit = 0x00080,
+ /* prefixes */
+ global_flag_bit = 0x00100,
+ tolerant_flag_bit = 0x00200,
+ protected_flag_bit = 0x00400,
+ overloaded_flag_bit = 0x00800,
+ aliased_flag_bit = 0x01000,
+ immediate_flag_bit = 0x02000,
+ conditional_flag_bit = 0x04000,
+ value_flag_bit = 0x08000,
+ semiprotected_flag_bit = 0x10000,
+ inherited_flag_bit = 0x20000,
+} flag_bits;
+
+/*tex Flags: */
+
+# define add_flag(a,b) ((a) | (b))
+
+# define add_frozen_flag(a) ((a) | frozen_flag_bit)
+# define add_permanent_flag(a) ((a) | permanent_flag_bit)
+# define add_immutable_flag(a) ((a) | immutable_flag_bit)
+# define add_primitive_flag(a) ((a) | primitive_flag_bit)
+# define add_mutable_flag(a) ((a) | mutable_flag_bit)
+# define add_noaligned_flag(a) ((a) | noaligned_flag_bit)
+# define add_instance_flag(a) ((a) | instance_flag_bit)
+# define add_untraced_flag(a) ((a) | untraced_flag_bit)
+
+# define add_global_flag(a) ((a) | global_flag_bit)
+# define add_tolerant_flag(a) ((a) | tolerant_flag_bit)
+# define add_protected_flag(a) ((a) | protected_flag_bit)
+# define add_semiprotected_flag(a) ((a) | semiprotected_flag_bit)
+# define add_overloaded_flag(a) ((a) | overloaded_flag_bit)
+# define add_aliased_flag(a) ((a) | aliased_flag_bit)
+# define add_immediate_flag(a) ((a) | immediate_flag_bit)
+# define add_conditional_flag(a) ((a) | conditional_flag_bit)
+# define add_value_flag(a) ((a) | value_flag_bit)
+# define add_inherited_flag(a) ((a) | inherited_flag_bit)
+
+# define remove_flag(a,b) ((a) & ~(b))
+
+# define remove_frozen_flag(a) ((a) & ~frozen_flag_bit)
+# define remove_permanent_flag(a) ((a) & ~permanent_flag_bit)
+# define remove_immutable_flag(a) ((a) & ~immutable_flag_bit)
+# define remove_primitive_flag(a) ((a) & ~primitive_flag_bit)
+# define remove_mutable_flag(a) ((a) & ~mutable_flag_bit)
+# define remove_noaligned_flag(a) ((a) & ~noaligned_flag_bit)
+# define remove_instance_flag(a) ((a) & ~instance_flag_bit)
+# define remove_untraced_flag(a) ((a) & ~untraced_flag_bit)
+
+# define remove_global_flag(a) ((a) & ~global_flag_bit)
+# define remove_tolerant_flag(a) ((a) & ~tolerant_flag_bit)
+# define remove_protected_flag(a) ((a) & ~protected_flag_bit)
+# define remove_overloaded_flag(a) ((a) & ~overloaded_flag_bit)
+# define remove_aliased_flag(a) ((a) & ~aliased_flag_bit)
+# define remove_immediate_flag(a) ((a) & ~immediate_flag_bit)
+# define remove_conditional_flag(a) ((a) & ~conditional_flag_bit)
+# define remove_value_flag(a) ((a) & ~value_flag_bit)
+
+# define is_frozen(a) (((a) & frozen_flag_bit) == frozen_flag_bit)
+# define is_permanent(a) (((a) & permanent_flag_bit) == permanent_flag_bit)
+# define is_immutable(a) (((a) & immutable_flag_bit) == immutable_flag_bit)
+# define is_primitive(a) (((a) & primitive_flag_bit) == primitive_flag_bit)
+# define is_mutable(a) (((a) & mutable_flag_bit) == mutable_flag_bit)
+# define is_noaligned(a) (((a) & noaligned_flag_bit) == noaligned_flag_bit)
+# define is_instance(a) (((a) & instance_flag_bit) == instance_flag_bit)
+# define is_untraced(a) (((a) & untraced_flag_bit) == untraced_flag_bit)
+
+# define is_global(a) (((a) & global_flag_bit) == global_flag_bit)
+# define is_tolerant(a) (((a) & tolerant_flag_bit) == tolerant_flag_bit)
+# define is_protected(a) (((a) & protected_flag_bit) == protected_flag_bit)
+# define is_semiprotected(a) (((a) & semiprotected_flag_bit) == semiprotected_flag_bit)
+# define is_overloaded(a) (((a) & overloaded_flag_bit) == overloaded_flag_bit)
+# define is_aliased(a) (((a) & aliased_flag_bit) == aliased_flag_bit)
+# define is_immediate(a) (((a) & immediate_flag_bit) == immediate_flag_bit)
+# define is_conditional(a) (((a) & conditional_flag_bit) == conditional_flag_bit)
+# define is_value(a) (((a) & value_flag_bit) == value_flag_bit)
+# define is_inherited(a) (((a) & inherited_flag_bit) == inherited_flag_bit)
+
+# define is_expandable(cmd) (cmd > max_command_cmd)
+
+# define global_or_local(a) (is_global(a) ? level_one : cur_level)
+
+# define has_flag_bits(p,a) ((p) & (a))
+
+# define remove_overload_flags(a) ((a) & ~(permanent_flag_bit | immutable_flag_bit | primitive_flag_bit))
+
+# define make_eq_flag_bits(a) ((singleword) ((a) & 0xFF))
+# define has_eq_flag_bits(p,a) (eq_flag(p) & (a))
+# define set_eq_flag_bits(p,a) set_eq_flag(p, make_eq_flag_bits(a))
+
+inline static singleword tex_flags_to_cmd(int flags)
+{
+ if (is_tolerant(flags)) {
+ return is_protected (flags) ? tolerant_protected_call_cmd :
+ (is_semiprotected(flags) ? tolerant_semi_protected_call_cmd : tolerant_call_cmd);
+ } else {
+ return is_protected (flags) ? protected_call_cmd :
+ (is_semiprotected(flags) ? semi_protected_call_cmd : call_cmd);
+ }
+}
+
+/*tex
+ The macros and functions for the frozen, tolerant, protected cmd codes are gone but
+ can be found in the archive. We now have just one |call_cmd| with properties stored
+ elsewhere.
+
+ int g -> singleword g
+*/
+
+extern int tex_define_permitted (halfword cs, halfword prefixes);
+extern void tex_define (int g, halfword p, singleword cmd, halfword chr);
+extern void tex_define_inherit (int g, halfword p, singleword flag, singleword cmd, halfword chr);
+extern void tex_define_swapped (int g, halfword p1, halfword p2, int force);
+extern void tex_forced_define (int g, halfword p, singleword flag, singleword cmd, halfword chr);
+extern void tex_word_define (int g, halfword p, halfword w);
+extern void tex_forced_word_define (int g, halfword p, singleword flag, halfword w);
+
+/*tex
+
+ The |*_par| macros expand to the variables that are (in most cases) also accessible at the users
+ end. Most are registers but some are in the (stack) lists. More |*_par| will move here: there is
+ no real need for these macros but because there were already a bunch and because they were defined
+ all over the place we moved them here.
+
+*/
+
+# define space_skip_par glue_parameter(space_skip_code)
+# define xspace_skip_par glue_parameter(xspace_skip_code)
+# define math_skip_par glue_parameter(math_skip_code)
+# define math_skip_mode_par count_parameter(math_skip_mode_code)
+# define math_double_script_mode_par count_parameter(math_double_script_mode_code)
+/*define math_control_mode_par count_parameter(math_control_mode_code) */
+# define math_font_control_par count_parameter(math_font_control_code)
+# define math_display_mode_par count_parameter(math_display_mode_code)
+# define math_dict_group_par count_parameter(math_dict_group_code)
+# define math_dict_properties_par count_parameter(math_dict_properties_code)
+# define math_threshold_par glue_parameter(math_threshold_code)
+# define page_extra_goal_par dimen_parameter(page_extra_goal_code)
+
+# define pre_display_size_par dimen_parameter(pre_display_size_code)
+# define display_width_par dimen_parameter(display_width_code)
+# define display_indent_par dimen_parameter(display_indent_code)
+# define math_surround_par dimen_parameter(math_surround_code)
+
+# define display_skip_mode_par count_parameter(math_display_skip_mode_code)
+# define math_eqno_gap_step_par count_parameter(math_eqno_gap_step_code)
+
+# define par_direction_par count_parameter(par_direction_code)
+# define text_direction_par count_parameter(text_direction_code)
+# define math_direction_par count_parameter(math_direction_code)
+
+# define first_valid_language_par count_parameter(first_valid_language_code)
+
+# define hsize_par dimen_parameter(hsize_code)
+# define vsize_par dimen_parameter(vsize_code)
+# define hfuzz_par dimen_parameter(hfuzz_code)
+# define vfuzz_par dimen_parameter(vfuzz_code)
+# define hbadness_par count_parameter(hbadness_code)
+# define vbadness_par count_parameter(vbadness_code)
+
+# define baseline_skip_par glue_parameter(baseline_skip_code)
+# define line_skip_par glue_parameter(line_skip_code)
+# define par_indent_par dimen_parameter(par_indent_code)
+# define hang_indent_par dimen_parameter(hang_indent_code)
+# define hang_after_par count_parameter(hang_after_code)
+# define left_skip_par glue_parameter(left_skip_code)
+# define right_skip_par glue_parameter(right_skip_code)
+# define par_fill_left_skip_par glue_parameter(par_fill_left_skip_code)
+# define par_fill_right_skip_par glue_parameter(par_fill_right_skip_code)
+# define par_init_left_skip_par glue_parameter(par_init_left_skip_code)
+# define par_init_right_skip_par glue_parameter(par_init_right_skip_code)
+# define tab_skip_par glue_parameter(tab_skip_code)
+
+# define emergency_stretch_par dimen_parameter(emergency_stretch_code)
+# define pre_tolerance_par count_parameter(pre_tolerance_code)
+# define tolerance_par count_parameter(tolerance_code)
+# define looseness_par count_parameter(looseness_code)
+# define adjust_spacing_par count_parameter(adjust_spacing_code)
+# define adjust_spacing_step_par count_parameter(adjust_spacing_step_code)
+# define adjust_spacing_stretch_par count_parameter(adjust_spacing_stretch_code)
+# define adjust_spacing_shrink_par count_parameter(adjust_spacing_shrink_code)
+# define adj_demerits_par count_parameter(adj_demerits_code)
+# define protrude_chars_par count_parameter(protrude_chars_code)
+# define line_penalty_par count_parameter(line_penalty_code)
+# define last_line_fit_par count_parameter(last_line_fit_code)
+# define double_hyphen_demerits_par count_parameter(double_hyphen_demerits_code)
+# define final_hyphen_demerits_par count_parameter(final_hyphen_demerits_code)
+# define inter_line_penalty_par count_parameter(inter_line_penalty_code)
+# define club_penalty_par count_parameter(club_penalty_code)
+# define widow_penalty_par count_parameter(widow_penalty_code)
+# define display_widow_penalty_par count_parameter(display_widow_penalty_code)
+# define orphan_penalty_par count_parameter(orphan_penalty_code)
+/*define page_boundary_penalty_par count_parameter(page_boundary_penalty_code) */ /* now in |\pageboundary| */
+# define line_break_criterium_par count_parameter(line_break_criterium_code)
+# define broken_penalty_par count_parameter(broken_penalty_code)
+# define line_skip_limit_par dimen_parameter(line_skip_limit_code)
+
+# define alignment_cell_source_par count_parameter(alignment_cell_source_code)
+# define alignment_wrap_source_par count_parameter(alignment_wrap_source_code)
+
+# define delimiter_shortfall_par dimen_parameter(delimiter_shortfall_code)
+# define null_delimiter_space_par dimen_parameter(null_delimiter_space_code)
+# define script_space_par dimen_parameter(script_space_code)
+# define max_depth_par dimen_parameter(max_depth_code)
+# define box_max_depth_par dimen_parameter(box_max_depth_code)
+# define split_max_depth_par dimen_parameter(split_max_depth_code)
+# define overfull_rule_par dimen_parameter(overfull_rule_code)
+# define box_max_depth_par dimen_parameter(box_max_depth_code)
+# define top_skip_par glue_parameter(top_skip_code)
+# define split_top_skip_par glue_parameter(split_top_skip_code)
+
+# define cur_fam_par count_parameter(family_code)
+# define pre_display_direction_par count_parameter(pre_display_direction_code)
+# define pre_display_penalty_par count_parameter(pre_display_penalty_code)
+# define post_display_penalty_par count_parameter(post_display_penalty_code)
+# define pre_inline_penalty_par count_parameter(pre_inline_penalty_code)
+# define post_inline_penalty_par count_parameter(post_inline_penalty_code)
+
+# define local_interline_penalty_par count_parameter(local_interline_penalty_code)
+# define local_broken_penalty_par count_parameter(local_broken_penalty_code)
+# define local_left_box_par box_parameter(local_left_box_code)
+# define local_right_box_par box_parameter(local_right_box_code)
+# define local_middle_box_par box_parameter(local_middle_box_code)
+
+# define end_line_char_par count_parameter(end_line_char_code)
+# define new_line_char_par count_parameter(new_line_char_code)
+# define escape_char_par count_parameter(escape_char_code)
+
+# define end_line_char_inactive ((end_line_char_par < 0) || (end_line_char_par > 127))
+
+# define delimiter_factor_par count_parameter(delimiter_factor_code)
+/*define post_binary_penalty_par count_parameter(post_binary_penalty_code) */
+/*define post_relation_penalty_par count_parameter(post_relation_penalty_code) */
+/*define pre_binary_penalty_par count_parameter(pre_binary_penalty_code) */
+/*define pre_relation_penalty_par count_parameter(pre_relation_penalty_code) */
+# define math_penalties_mode_par count_parameter(math_penalties_mode_code)
+# define math_check_fences_par count_parameter(math_check_fences_mode_code)
+/*define math_delimiters_mode_par count_parameter(math_delimiters_mode_code) */
+/*define math_fences_mode_par count_parameter(math_fences_mode_code) */
+/*define math_rule_thickness_mode_par count_parameter(math_rule_thickness_mode_code) */
+# define math_slack_mode_par count_parameter(math_slack_mode_code)
+/*define math_flatten_mode_par count_parameter(math_flatten_mode_code) */
+# define null_delimiter_space_par dimen_parameter(null_delimiter_space_code)
+# define disable_spaces_par count_parameter(disable_spaces_code)
+# define glyph_options_par count_parameter(glyph_options_code)
+# define glyph_scale_par count_parameter(glyph_scale_code)
+# define glyph_text_scale_par count_parameter(glyph_text_scale_code)
+# define glyph_script_scale_par count_parameter(glyph_script_scale_code)
+# define glyph_scriptscript_scale_par count_parameter(glyph_scriptscript_scale_code)
+# define glyph_x_scale_par count_parameter(glyph_x_scale_code)
+# define glyph_y_scale_par count_parameter(glyph_y_scale_code)
+# define glyph_x_offset_par dimen_parameter(glyph_x_offset_code)
+# define glyph_y_offset_par dimen_parameter(glyph_y_offset_code)
+# define math_scripts_mode_par count_parameter(math_scripts_mode_code)
+/*define math_script_box_mode_par count_parameter(math_script_box_mode_code) */
+/*define math_script_char_mode_par count_parameter(math_script_char_mode_code) */
+# define math_limits_mode_par count_parameter(math_limits_mode_code)
+# define math_nolimits_mode_par count_parameter(math_nolimits_mode_code)
+# define math_rules_mode_par count_parameter(math_rules_mode_code)
+# define math_rules_fam_par count_parameter(math_rules_fam_code)
+# define math_glue_mode_par count_parameter(math_glue_mode_code)
+
+typedef enum math_glue_modes {
+ math_glue_stretch_code = 0x01,
+ math_glue_shrink_code = 0x02,
+} math_glue_modes;
+
+# define math_glue_stretch_enabled ((math_glue_mode_par & math_glue_stretch_code) == math_glue_stretch_code)
+# define math_glue_shrink_enabled ((math_glue_mode_par & math_glue_shrink_code) == math_glue_shrink_code)
+# define default_math_glue_mode (math_glue_stretch_code | math_glue_shrink_code)
+
+# define petty_mu_skip_par mu_glue_parameter(petty_mu_skip_code)
+# define tiny_mu_skip_par mu_glue_parameter(tiny_mu_skip_code)
+# define thin_mu_skip_par mu_glue_parameter(thin_mu_skip_code)
+# define med_mu_skip_par mu_glue_parameter(med_mu_skip_code)
+# define thick_mu_skip_par mu_glue_parameter(thick_mu_skip_code)
+
+# define every_math_par toks_parameter(every_math_code)
+# define every_display_par toks_parameter(every_display_code)
+# define every_cr_par toks_parameter(every_cr_code)
+# define every_tab_par toks_parameter(every_tab_code)
+# define every_hbox_par toks_parameter(every_hbox_code)
+# define every_vbox_par toks_parameter(every_vbox_code)
+# define every_math_atom_par toks_parameter(every_math_atom_code)
+# define every_eof_par toks_parameter(every_eof_code)
+# define every_par_par toks_parameter(every_par_code)
+# define every_before_par_par toks_parameter(every_before_par_code)
+# define every_job_par toks_parameter(every_job_code)
+# define error_help_par toks_parameter(error_help_code)
+# define end_of_group_par toks_parameter(end_of_group_code)
+/*define end_of_par_par toks_parameter(end_of_par_code) */
+
+# define internal_par_state_par count_parameter(internal_par_state_code)
+# define internal_dir_state_par count_parameter(internal_dir_state_code)
+# define internal_math_style_par count_parameter(internal_math_style_code)
+# define internal_math_scale_par count_parameter(internal_math_scale_code)
+
+# define overload_mode_par count_parameter(overload_mode_code)
+
+# define auto_paragraph_mode_par count_parameter(auto_paragraph_mode_code)
+
+typedef enum auto_paragraph_modes {
+ auto_paragraph_text = 0x01,
+ auto_paragraph_macro = 0x02,
+ auto_paragraph_go_on = 0x04,
+} auto_paragraph_modes;
+
+# define auto_paragraph_mode(flag) ((auto_paragraph_mode_par) & (flag))
+
+# define shaping_penalties_mode_par count_parameter(shaping_penalties_mode_code)
+# define shaping_penalty_par count_parameter(shaping_penalty_code)
+
+typedef enum shaping_penalties_mode_bits {
+ inter_line_penalty_shaping = 0x01,
+ widow_penalty_shaping = 0x02,
+ club_penalty_shaping = 0x04,
+ broken_penalty_shaping = 0x08,
+} shaping_penalties_mode_bits;
+
+# define is_shaping_penalties_mode(what,flag) ((what) & (flag))
+
+# define tab_size_par dimen_parameter(tab_size_code)
+
+/*define prev_graf_par cur_list.prev_graf */
+/*define prev_depth_par cur_list.prev_depth */
+/*define space_factor_par cur_list.space_factor */
+
+/*define tail_par cur_list.tail */
+/*define head_par cur_list.head */
+/*define mode_par cur_list.mode */
+/*define dirs_par cur_list.dirs */
+
+/*define incompleat_noad_par cur_list.incompleat_noad */
+/*define mode_line_par cur_list.mode_line */
+/*define delim_par cur_list.delim */
+
+# define par_shape_par specification_parameter(par_shape_code)
+# define inter_line_penalties_par specification_parameter(inter_line_penalties_code)
+# define club_penalties_par specification_parameter(club_penalties_code)
+# define widow_penalties_par specification_parameter(widow_penalties_code)
+# define display_widow_penalties_par specification_parameter(display_widow_penalties_code)
+# define orphan_penalties_par specification_parameter(orphan_penalties_code)
+# define math_forward_penalties_par specification_parameter(math_forward_penalties_code)
+# define math_backward_penalties_par specification_parameter(math_backward_penalties_code)
+
+/*define h_offset_par dimen_parameter(h_offset_code) */
+/*define v_offset_par dimen_parameter(v_offset_code) */
+# define px_dimen_par dimen_parameter(px_dimen_code)
+/*define mag_par count_parameter(mag_code) */
+
+# define max_dead_cycles_par count_parameter(max_dead_cycles_code)
+# define output_box_par count_parameter(output_box_code)
+# define holding_inserts_par count_parameter(holding_inserts_code)
+# define holding_migrations_par count_parameter(holding_migrations_code)
+# define output_routine_par toks_parameter(output_routine_code)
+# define floating_penalty_par count_parameter(floating_penalty_code)
+
+# define global_defs_par count_parameter(global_defs_code)
+# define cat_code_table_par count_parameter(cat_code_table_code)
+# define saving_vdiscards_par count_parameter(saving_vdiscards_code)
+
+# define tracing_output_par count_parameter(tracing_output_code)
+# define tracing_stats_par count_parameter(tracing_stats_code)
+# define tracing_online_par count_parameter(tracing_online_code)
+# define tracing_paragraphs_par count_parameter(tracing_paragraphs_code)
+# define tracing_levels_par count_parameter(tracing_levels_code)
+# define tracing_nesting_par count_parameter(tracing_nesting_code)
+# define tracing_alignments_par count_parameter(tracing_alignments_code)
+# define tracing_inserts_par count_parameter(tracing_inserts_code)
+# define tracing_marks_par count_parameter(tracing_marks_code)
+# define tracing_adjusts_par count_parameter(tracing_adjusts_code)
+# define tracing_lost_chars_par count_parameter(tracing_lost_chars_code)
+# define tracing_ifs_par count_parameter(tracing_ifs_code)
+# define tracing_commands_par count_parameter(tracing_commands_code)
+# define tracing_macros_par count_parameter(tracing_macros_code)
+# define tracing_assigns_par count_parameter(tracing_assigns_code)
+# define tracing_fonts_par count_parameter(tracing_fonts_code)
+# define tracing_pages_par count_parameter(tracing_pages_code)
+# define tracing_restores_par count_parameter(tracing_restores_code)
+# define tracing_groups_par count_parameter(tracing_groups_code)
+# define tracing_math_par count_parameter(tracing_math_code)
+# define tracing_hyphenation_par count_parameter(tracing_hyphenation_code)
+# define tracing_expressions_par count_parameter(tracing_expressions_code)
+# define tracing_nodes_par count_parameter(tracing_nodes_code)
+# define tracing_full_boxes_par count_parameter(tracing_full_boxes_code)
+# define tracing_penalties_par count_parameter(tracing_penalties_code)
+
+# define show_box_depth_par count_parameter(show_box_depth_code)
+# define show_box_breadth_par count_parameter(show_box_breadth_code)
+# define show_node_details_par count_parameter(show_node_details_code)
+
+# define pausing_par count_parameter(pausing_code)
+
+# define error_context_lines_par count_parameter(error_context_lines_code)
+# define copy_lua_input_nodes_par count_parameter(copy_lua_input_nodes_code)
+
+# define math_pre_display_gap_factor_par count_parameter(math_pre_display_gap_factor_code)
+
+# define time_par count_parameter(time_code)
+# define day_par count_parameter(day_code)
+# define month_par count_parameter(month_code)
+# define year_par count_parameter(year_code)
+
+typedef enum hyphenation_mode_bits {
+ normal_hyphenation_mode = 0x00001,
+ automatic_hyphenation_mode = 0x00002,
+ explicit_hyphenation_mode = 0x00004,
+ syllable_hyphenation_mode = 0x00008,
+ uppercase_hyphenation_mode = 0x00010,
+ compound_hyphenation_mode = 0x00020,
+ strict_start_hyphenation_mode = 0x00040,
+ strict_end_hyphenation_mode = 0x00080,
+ automatic_penalty_hyphenation_mode = 0x00100,
+ explicit_penalty_hyphenation_mode = 0x00200,
+ permit_glue_hyphenation_mode = 0x00400,
+ permit_all_hyphenation_mode = 0x00800,
+ permit_math_replace_hyphenation_mode = 0x01000,
+ force_check_hyphenation_mode = 0x02000,
+ lazy_ligatures_hyphenation_mode = 0x04000,
+ force_handler_hyphenation_mode = 0x08000,
+ feedback_compound_hyphenation_mode = 0x10000,
+ ignore_bounds_hyphenation_mode = 0x20000,
+ collapse_hyphenation_mode = 0x40000,
+} hyphenation_mode_bits;
+
+# define hyphenation_permitted(a,b) (((a) & (b)) == (b))
+# define set_hyphenation_mode(a,b) ((a) | (b))
+# define unset_hyphenation_mode(a,b) ((a) & ~(b))
+# define flip_hyphenation_mode(a,b) ((b) ? set_hyphenation_mode(a,b) : unset_hyphenation_mode(a,b))
+# define default_hyphenation_mode (normal_hyphenation_mode | automatic_hyphenation_mode | explicit_hyphenation_mode | syllable_hyphenation_mode | compound_hyphenation_mode | force_handler_hyphenation_mode | feedback_compound_hyphenation_mode)
+
+# define language_par count_parameter(language_code)
+# define hyphenation_mode_par count_parameter(hyphenation_mode_code)
+# define uc_hyph_par count_parameter(uc_hyph_code)
+# define left_hyphen_min_par count_parameter(left_hyphen_min_code)
+# define right_hyphen_min_par count_parameter(right_hyphen_min_code)
+# define ex_hyphen_char_par count_parameter(ex_hyphen_char_code)
+# define hyphen_penalty_par count_parameter(hyphen_penalty_code)
+# define ex_hyphen_penalty_par count_parameter(ex_hyphen_penalty_code)
+# define default_hyphen_char_par count_parameter(default_hyphen_char_code)
+# define default_skew_char_par count_parameter(default_skew_char_code)
+# define saving_hyph_codes_par count_parameter(saving_hyph_codes_code)
+
+# define automatic_hyphen_penalty_par count_parameter(automatic_hyphen_penalty_code)
+# define explicit_hyphen_penalty_par count_parameter(explicit_hyphen_penalty_code)
+# define exception_penalty_par count_parameter(exception_penalty_code)
+
+# define math_spacing_mode_par count_parameter(math_spacing_mode_code)
+# define math_grouping_mode_par count_parameter(math_grouping_mode_code)
+# define math_begin_class_par count_parameter(math_begin_class_code)
+# define math_end_class_par count_parameter(math_end_class_code)
+# define math_left_class_par count_parameter(math_left_class_code)
+# define math_right_class_par count_parameter(math_right_class_code)
+# define sup_mark_mode_par count_parameter(sup_mark_mode_code)
+
+# define glyph_data_par count_parameter(glyph_data_code)
+# define glyph_state_par count_parameter(glyph_state_code)
+# define glyph_script_par count_parameter(glyph_script_code)
+
+/*define glue_data_par count_parameter(glue_data_code) */
+
+# define cur_lang_par count_parameter(language_code)
+/*define cur_font_par eq_value(current_font_sequence) */
+# define cur_font_par count_parameter(font_code)
+
+typedef enum normalize_line_mode_bits {
+ normalize_line_mode = 0x0001,
+ parindent_skip_mode = 0x0002,
+ swap_hangindent_mode = 0x0004,
+ swap_parshape_mode = 0x0008,
+ break_after_dir_mode = 0x0010,
+ remove_margin_kerns_mode = 0x0020, /*tex When unpacking an hbox \unknown\ a \PDFTEX\ leftover. */
+ clip_width_mode = 0x0040,
+ flatten_discretionaries_mode = 0x0080,
+ discard_zero_tab_skips_mode = 0x0100,
+ flatten_h_leaders_mode = 0x0200,
+} normalize_line_mode_bits;
+
+typedef enum normalize_par_mode_bits {
+ normalize_par_mode = 0x0001,
+ flatten_v_leaders_mode = 0x0002, /* used to be 0x200 */
+} normalize_par_mode_bits;
+
+# define normalize_line_mode_permitted(a,b) ((a & b) == b)
+# define normalize_par_mode_permitted(a,b) ((a & b) == b)
+
+# define normalize_line_mode_par count_parameter(normalize_line_mode_code)
+# define normalize_par_mode_par count_parameter(normalize_par_mode_code)
+# define auto_migration_mode_par count_parameter(auto_migration_mode_code)
+
+typedef enum auto_migration_mode_bits {
+ auto_migrate_mark = 0x01,
+ auto_migrate_insert = 0x02,
+ auto_migrate_adjust = 0x04,
+ auto_migrate_pre = 0x08,
+ auto_migrate_post = 0x10,
+} auto_migration_mode_bits;
+
+# define auto_migrating_mode_permitted(what,flag) ((what & flag) == flag)
+
+# define attribute_register(j) eq_value(register_attribute_location(j))
+# define box_register(j) eq_value(register_box_location(j))
+# define count_register(j) eq_value(register_int_location(j))
+# define dimen_register(j) eq_value(register_dimen_location(j))
+# define mu_skip_register(j) eq_value(register_mu_glue_location(j))
+# define skip_register(j) eq_value(register_glue_location(j))
+# define toks_register(j) eq_value(register_toks_location(j))
+
+/*
+ Injecting these frozen tokens can for instance happen when we scan for an integer or dimension
+ and run into an |\else| or |\fi| because (guess what) these scanners gobble trailing spaces! In
+ that case the |deep_frozen_relax_token| gets pushed back and can for instance end up in an
+ expansion (macro, write, etc) because we only look ahead. However, we can catch this side effect
+ in the scanners (that we redefined anyway). Removing those |\relax|'s was on the todo list and
+ now happens in the scanners. Actually it's one reason why we often use constants in tests
+ because these don't have that side effect because the scanner then quite earlier.) Another place
+ where that happens is in the |\input| command but there we can use braces. It is a typical
+ example of a more cosmetic adaptation that got a bit more priority when we converted the
+ \CONTEXT\ codebase from \MKIV\ to \LMTX, where testing involved checking the results. I also have
+ to check the other frozen tokens that can get reported when we have for instance alignments. It
+ is also why some of these tokens have an associated (private but serialized) |\csname|.
+
+ For the record: we can these tokens deep_frozen because we don't want them to be confused with
+ the |\frozen| user macros and the ones below are really deeply hidden, although sometimes they
+ do surface.
+
+*/
+
+typedef enum deep_frozen_cs_tokens {
+ deep_frozen_protection_token = cs_token_flag + deep_frozen_cs_protection_code,
+ deep_frozen_cr_token = cs_token_flag + deep_frozen_cs_cr_code,
+ deep_frozen_end_group_token = cs_token_flag + deep_frozen_cs_end_group_code,
+ deep_frozen_right_token = cs_token_flag + deep_frozen_cs_right_code,
+ deep_frozen_fi_token = cs_token_flag + deep_frozen_cs_fi_code,
+ deep_frozen_end_template_1_token = cs_token_flag + deep_frozen_cs_end_template_1_code,
+ deep_frozen_end_template_2_token = cs_token_flag + deep_frozen_cs_end_template_2_code,
+ deep_frozen_relax_token = cs_token_flag + deep_frozen_cs_relax_code,
+ deep_frozen_end_write_token = cs_token_flag + deep_frozen_cs_end_write_code,
+ deep_frozen_dont_expand_token = cs_token_flag + deep_frozen_cs_dont_expand_code,
+ deep_frozen_null_font_token = cs_token_flag + deep_frozen_cs_null_font_code,
+ deep_frozen_undefined_token = cs_token_flag + deep_frozen_cs_undefined_code,
+} deep_frozen_cs_tokens;
+
+/*tex
+
+ The next has been simplified and replaced by |\hyphenatiomode| but we keep it as reminder:
+
+ \starttabulate[|T|T|T|]
+ \NC hyphen_penalty_mode_par \NC automatic_disc (-) \NC explicit_disc (\-) \NC \NR
+ \HL
+ \NC 0 (default) \NC ex_hyphen_penalty_par \NC ex_hyphen_penalty_par \NC \NR
+ \NC 1 \NC hyphen_penalty_par \NC hyphen_penalty_par \NC \NR
+ \NC 2 \NC ex_hyphen_penalty_par \NC hyphen_penalty_par \NC \NR
+ \NC 3 \NC hyphen_penalty_par \NC ex_hyphen_penalty_par \NC \NR
+ \NC 4 \NC automatic_hyphen_penalty_par \NC explicit_disc_penalty_par \NC \NR
+ \NC 5 \NC ex_hyphen_penalty_par \NC explicit_disc_penalty_par \NC \NR
+ \NC 6 \NC hyphen_penalty_par \NC explicit_disc_penalty_par \NC \NR
+ \NC 7 \NC automatic_hyphen_penalty_par \NC ex_hyphen_penalty_par \NC \NR
+ \NC 8 \NC automatic_hyphen_penalty_par \NC hyphen_penalty_par \NC \NR
+ \stoptabulate
+
+*/
+
+extern halfword tex_automatic_disc_penalty (halfword mode);
+extern halfword tex_explicit_disc_penalty (halfword mode);
+
+/*tex
+
+ We add a bit more abstraction when setting the system parameters. This is not really
+ needed but it move all the |eq_| assignments to a place where we can keep an eye on
+ them.
+
+*/
+
+# define update_tex_glyph_data(a,v) tex_word_define(a, internal_int_location(glyph_data_code), v)
+# define update_tex_glyph_state(a,v) tex_word_define(a, internal_int_location(glyph_state_code), v)
+# define update_tex_glyph_script(a,v) tex_word_define(a, internal_int_location(glyph_script_code), v)
+# define update_tex_family(a,v) tex_word_define(a, internal_int_location(family_code), v)
+# define update_tex_language(a,v) tex_word_define(a, internal_int_location(language_code), v)
+# define update_tex_font(a,v) tex_word_define(a, internal_int_location(font_code), v)
+
+/*define update_tex_glue_data(a,v) tex_word_define(a, internal_int_location(glue_data_code), v) */
+
+# define update_tex_display_indent(v) tex_eq_word_define(internal_dimen_location(display_indent_code), v)
+# define update_tex_display_width(v) tex_eq_word_define(internal_dimen_location(display_width_code), v)
+# define update_tex_hang_after(v) tex_eq_word_define(internal_int_location(hang_after_code), v)
+# define update_tex_hang_indent(v) tex_eq_word_define(internal_dimen_location(hang_indent_code), v)
+# define update_tex_looseness(v) tex_eq_word_define(internal_int_location(looseness_code), v)
+# define update_tex_math_direction(v) tex_eq_word_define(internal_int_location(math_direction_code), v)
+# define update_tex_internal_par_state(v) tex_eq_word_define(internal_int_location(internal_par_state_code), v)
+# define update_tex_internal_dir_state(v) tex_eq_word_define(internal_int_location(internal_dir_state_code), v)
+# define update_tex_internal_math_style(v) tex_eq_word_define(internal_int_location(internal_math_style_code), v)
+# define update_tex_internal_math_scale(v) tex_eq_word_define(internal_int_location(internal_math_scale_code), v)
+# define update_tex_output_penalty(v) tex_geq_word_define(internal_int_location(output_penalty_code), v)
+# define update_tex_par_direction(v) tex_eq_word_define(internal_int_location(par_direction_code), v)
+# define update_tex_pre_display_direction(v) tex_eq_word_define(internal_int_location(pre_display_direction_code), v)
+# define update_tex_pre_display_size(v) tex_eq_word_define(internal_dimen_location(pre_display_size_code), v)
+# define update_tex_text_direction(v) tex_eq_word_define(internal_int_location(text_direction_code), v)
+
+# define update_tex_font_identifier(v) tex_eq_word_define(internal_int_location(font_code), v)
+# define update_tex_glyph_scale(v) tex_eq_word_define(internal_int_location(glyph_scale_code), v)
+# define update_tex_glyph_x_scale(v) tex_eq_word_define(internal_int_location(glyph_x_scale_code), v)
+# define update_tex_glyph_y_scale(v) tex_eq_word_define(internal_int_location(glyph_y_scale_code), v)
+
+# define update_tex_math_left_class(v) tex_eq_word_define(internal_int_location(math_left_class_code), v)
+# define update_tex_math_right_class(v) tex_eq_word_define(internal_int_location(math_right_class_code), v)
+
+# define update_tex_par_shape(v) tex_eq_define(internal_specification_location(par_shape_code), specification_reference_cmd, v)
+# define update_tex_inter_line_penalties(v) tex_eq_define(internal_specification_location(inter_line_penalties_code), specification_reference_cmd, v)
+/*define update_tex_club_penalties(v) eq_define(internal_specification_location(club_penalties_code), specification_reference_cmd, v) */
+/*define update_tex_widow_penalties(v) eq_define(internal_specification_location(widow_penalties_code), specification_reference_cmd, v) */
+/*define update_tex_display_widow_penalties(v) eq_define(internal_specification_location(display_widow_penalties_code), specification_reference_cmd, v) */
+/*define update_tex_orphan_penalties(v) eq_define(internal_specification_location(orphan_penalties_code), specification_reference_cmd, v) */
+
+# define update_tex_end_of_group(v) tex_eq_define(internal_toks_location(end_of_group_code), internal_toks_reference_cmd, v)
+/*define update_tex_end_of_par(v) eq_define(internal_toks_location(end_of_par_code), internal_toks_cmd, v) */
+
+# define update_tex_local_left_box(v) tex_eq_define(internal_box_location(local_left_box_code), internal_box_reference_cmd, v);
+# define update_tex_local_right_box(v) tex_eq_define(internal_box_location(local_right_box_code), internal_box_reference_cmd, v);
+# define update_tex_local_middle_box(v) tex_eq_define(internal_box_location(local_middle_box_code), internal_box_reference_cmd, v);
+
+# define update_tex_font_local(f,v) tex_eq_define(f, set_font_cmd, v); /* Here |f| already has the right offset. */
+# define update_tex_font_global(f,v) tex_geq_define(f, set_font_cmd, v); /* Here |f| already has the right offset. */
+
+# define update_tex_tab_skip_local(v) tex_eq_define(internal_glue_location(tab_skip_code), internal_glue_reference_cmd, v);
+# define update_tex_tab_skip_global(v) tex_geq_define(internal_glue_location(tab_skip_code), internal_glue_reference_cmd, v);
+
+# define update_tex_box_local(n,v) tex_eq_define(register_box_location(n) - box_flag, register_box_reference_cmd, v);
+# define update_tex_box_global(n,v) tex_geq_define(register_box_location(n) - global_box_flag, register_box_reference_cmd, v);
+
+# define update_tex_insert_mode(a,v) tex_word_define(a, internal_int_location(insert_mode_code), v)
+
+/*tex For the moment here; a preparation for a dedicated insert structure. */
+
+# define insert_content(A) box_register(A)
+# define insert_multiplier(A) count_register(A)
+# define insert_maxheight(A) dimen_register(A)
+# define insert_distance(A) skip_register(A)
+
+# endif
diff --git a/source/luametatex/source/tex/texerrors.c b/source/luametatex/source/tex/texerrors.c
new file mode 100644
index 000000000..3252d2c50
--- /dev/null
+++ b/source/luametatex/source/tex/texerrors.c
@@ -0,0 +1,704 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+# include <string.h>
+
+/*tex
+
+ When something anomalous is detected, \TEX\ typically does something like this (in \PASCAL\
+ lingua):
+
+ \starttyping
+ print_err("Something anomalous has been detected");
+ help(
+ "This is the first line of my offer to help.\n"
+ "This is the second line. I'm trying to\n"
+ "explain the best way for you to proceed."
+ );
+ error();
+ \stoptyping
+
+ A two-line help message would be given using |help2|, etc.; these informal helps should use
+ simple vocabulary that complements the words used in the official error message that was
+ printed. (Outside the U.S.A., the help messages should preferably be translated into the local
+ vernacular. Each line of help is at most 60 characters long, in the present implementation, so
+ that |max_print_line| will not be exceeded.)
+
+ The |print_err| procedure supplies a |!| before the official message, and makes sure that the
+ terminal is awake if a stop is going to occur. The |error| procedure supplies a |.| after the
+ official message, then it shows the location of the error; and if |interaction =
+ error_stop_mode|, it also enters into a dialog with the user, during which time the help message
+ may be printed.
+
+*/
+
+error_state_info lmt_error_state = {
+ .last_error = NULL,
+ .last_lua_error = NULL,
+ .last_warning_tag = NULL,
+ .last_warning = NULL,
+ .last_error_context = NULL,
+ .help_text = NULL,
+ .print_buffer = "",
+ .intercept = 0,
+ .last_intercept = 0,
+ .interaction = 0,
+ .default_exit_code = 0,
+ .set_box_allowed = 0,
+ .history = 0,
+ .error_count = 0,
+ .err_old_setting = 0,
+ .in_error = 0,
+ .long_help_seen = 0,
+ .context_indent = 4,
+ .padding = 0,
+ .line_limits = {
+ .maximum = max_error_line,
+ .minimum = min_error_line,
+ .size = min_error_line,
+ .top = 0,
+ },
+ .half_line_limits = {
+ .maximum = max_half_error_line,
+ .minimum = min_half_error_line,
+ .size = min_half_error_line,
+ .top = 0,
+ },
+} ;
+
+/*tex
+ Because a |text_can| can be assembled we make a copy. There are not many cases where this is
+ really needed but there are seldom errors anyway so we can neglect this duplication of data.
+*/
+
+inline static void tex_aux_update_help_text(const char* str)
+{
+ if (lmt_error_state.help_text) {
+ lmt_memory_free(lmt_error_state.help_text);
+ lmt_error_state.help_text = NULL;
+ }
+ if (str) {
+ lmt_error_state.help_text = lmt_memory_strdup(str);
+ }
+}
+
+/*tex
+
+ The previously defines structure collects all relevant variables: the current level of
+ interaction: |interaction|, states like |last_error|, |last_lua_error|, |last_warning_tag|,
+ |last_warning_str| and |last_error_context|, and temporary variables like |err_old_setting| and
+ |in_error|.
+
+ This is a variant on |show_runaway| that is used when we delegate error handling to a \LUA\
+ callback. (Maybe some day that will be default.)
+
+*/
+
+static void tex_aux_set_last_error_context(void)
+{
+ int saved_selector = lmt_print_state.selector;
+ int saved_new_line_char = new_line_char_par;
+ int saved_new_string_line = lmt_print_state.new_string_line;
+ lmt_print_state.selector = new_string_selector_code;
+ new_line_char_par = 10;
+ lmt_print_state.new_string_line = 10;
+ tex_show_validity();
+ tex_show_context();
+ lmt_memory_free(lmt_error_state.last_error_context);
+ lmt_error_state.last_error_context = tex_take_string(NULL);
+ lmt_print_state.selector = saved_selector;
+ new_line_char_par = saved_new_line_char;
+ lmt_print_state.new_string_line = saved_new_string_line;
+}
+
+static void tex_aux_flush_error(void)
+{
+ if (lmt_error_state.in_error) {
+ lmt_print_state.selector = lmt_error_state.err_old_setting;
+ lmt_memory_free(lmt_error_state.last_error);
+ lmt_error_state.last_error = tex_take_string(NULL);
+ if (lmt_error_state.last_error) {
+ int callback_id = lmt_callback_defined(show_error_message_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ } else {
+ tex_print_str(lmt_error_state.last_error);
+ }
+ }
+ lmt_error_state.in_error = 0;
+ }
+}
+
+static int tex_aux_error_callback_set(void)
+{
+ int callback_id = lmt_callback_defined(show_error_message_callback);
+ return lmt_lua_state.lua_instance && callback_id > 0 ? callback_id : 0;
+}
+
+static void tex_aux_start_error(void)
+{
+ if (tex_aux_error_callback_set()) {
+ lmt_error_state.err_old_setting = lmt_print_state.selector;
+ lmt_print_state.selector = new_string_selector_code;
+ lmt_error_state.in_error = 1 ;
+ lmt_memory_free(lmt_error_state.last_error);
+ lmt_error_state.last_error = NULL;
+ } else {
+ tex_print_nlp();
+ tex_print_str("! ");
+ }
+}
+
+/*tex
+
+ \TEX\ is careful not to call |error| when the print |selector| setting might be unusual. The
+ only possible values of |selector| at the time of error messages are:
+
+ \startitemize
+ \startitem |no_print|: |interaction=batch_mode| and |log_file| not yet open; \stopitem
+ \startitem |term_only|: |interaction>batch_mode| and |log_file| not yet open; \stopitem
+ \startitem |log_only|: |interaction=batch_mode| and |log_file| is open; \stopitem
+ \startitem |term_and_log|: |interaction>batch_mode| and |log_file| is open. \stopitem
+ \stopitemize
+
+*/
+
+void tex_fixup_selector(int logopened)
+{
+ if (lmt_error_state.interaction == batch_mode) {
+ lmt_print_state.selector = logopened ? logfile_selector_code : no_print_selector_code ;
+ } else {
+ lmt_print_state.selector = logopened ? terminal_and_logfile_selector_code : terminal_selector_code;
+ }
+}
+
+/*tex
+
+ The variable |history| records the worst level of error that has been detected. It has four
+ possible values: |spotless|, |warning_issued|, |error_message_issued|, and |fatal_error_stop|.
+
+ Another variable, |error_count|, is increased by one when an |error| occurs without an
+ interactive dialog, and it is reset to zero at the end of every paragraph. If |error_count|
+ reaches 100, \TEX\ decides that there is no point in continuing further.
+
+ The value of |history| is initially |fatal_error_stop|, but it will be changed to |spotless|
+ if \TEX\ survives the initialization process.
+
+*/
+
+void tex_initialize_errors(void)
+{
+ lmt_error_state.interaction = error_stop_mode;
+ lmt_error_state.set_box_allowed = 1;
+ if (lmt_error_state.half_line_limits.size > lmt_error_state.line_limits.size) {
+ lmt_error_state.half_line_limits.size = lmt_error_state.line_limits.size/2;
+ }
+ if (lmt_error_state.half_line_limits.size <= 30) {
+ lmt_error_state.half_line_limits.size = 31;
+ } else if (lmt_error_state.half_line_limits.size >= (lmt_error_state.line_limits.size - 15)) {
+ lmt_error_state.half_line_limits.size = lmt_error_state.line_limits.size - 16;
+ }
+}
+
+/*tex
+
+ It is possible for |error| to be called recursively if some error arises when |get_token| is
+ being used to delete a token, and/or if some fatal error occurs while \TEX\ is trying to fix
+ a non-fatal one. But such recursion is never more than two levels deep.
+
+ Individual lines of help are recorded in the string |help_text|. There can be embedded
+ newlines.
+
+ The |jump_out| procedure just cuts across all active procedure levels and exits the program.
+ It is used when there is no recovery from a particular error. The exit code can be overloaded.
+
+ We don't close the lua state because we then have to collect lots of garbage and it really
+ slows doen the run. It's not needed anyway, as we exit.
+
+*/
+
+static int tex_aux_final_exit(int code)
+{
+ exit(code);
+ return 0; /* unreachable */
+}
+
+int tex_normal_exit(void)
+{
+ tex_terminal_update();
+ /* lua_close(lua_state.lua_instance); */
+ lmt_main_state.ready_already = output_disabled_state;
+ if (lmt_error_state.history != spotless && lmt_error_state.history != warning_issued) {
+ return tex_aux_final_exit(EXIT_FAILURE);
+ } else {
+ return tex_aux_final_exit(lmt_error_state.default_exit_code);
+ }
+}
+
+static void tex_aux_jump_out(void)
+{
+ tex_close_files_and_terminate(1);
+ tex_normal_exit();
+}
+
+/*tex
+
+ This completes the job of error reporting, that is, in good old \TEX. But in \LUATEX\ it
+ doesn't make sense to suport this model of error handling, also because one cannot backtrack
+ over \LUA\ actions, so it would be a cheat. But we can keep the modes.
+
+*/
+
+static void tex_aux_error(int type)
+{
+ int callback_id = lmt_callback_defined(intercept_tex_error_callback);
+ tex_aux_flush_error();
+ if (lmt_error_state.history < error_message_issued && type != warning_error_type) {
+ lmt_error_state.history = error_message_issued;
+ }
+ if (lmt_lua_state.lua_instance && callback_id > 0) {
+ tex_aux_set_last_error_context();
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "dd->d", lmt_error_state.interaction, type, &lmt_error_state.interaction);
+ lmt_error_state.error_count = 0;
+ tex_terminal_update();
+ switch (lmt_error_state.interaction) {
+ case batch_mode: /* Q */
+ --lmt_print_state.selector;
+ return;
+ case nonstop_mode: /* R */
+ return;
+ case scroll_mode: /* S */
+ return;
+ case error_stop_mode: /* carry on */
+ break;
+ default: /* exit */
+ lmt_error_state.interaction = scroll_mode;
+ if (type != warning_error_type) {
+ tex_aux_jump_out();
+ }
+ break;
+ }
+ } else {
+ tex_print_char('.');
+ tex_show_context();
+ }
+ if (type != warning_error_type) {
+ ++lmt_error_state.error_count;
+ if (lmt_error_state.error_count == 100) {
+ tex_print_message("That makes 100 errors; please try again.");
+ lmt_error_state.history = fatal_error_stop;
+ tex_aux_jump_out();
+ }
+ }
+ /*tex
+ We assume that the callback handles the log file too. Otherwise we put the help message in
+ the log file.
+ */
+ if (callback_id == 0) {
+ if (lmt_error_state.interaction > batch_mode) {
+ /*tex Avoid terminal output: */
+ --lmt_print_state.selector;
+ }
+ tex_print_nlp();
+ if (lmt_error_state.help_text) {
+ tex_print_str(lmt_error_state.help_text);
+ tex_print_nlp();
+ }
+ if (lmt_error_state.interaction > batch_mode) {
+ /*tex Re-enable terminal output: */
+ ++lmt_print_state.selector;
+ }
+ }
+ tex_print_ln();
+}
+
+/*tex
+
+ In anomalous cases, the print selector might be in an unknown state; the following subroutine
+ is called to fix things just enough to keep running a bit longer.
+
+*/
+
+static void tex_aux_normalize_selector(void)
+{
+ if (lmt_fileio_state.log_opened) {
+ lmt_print_state.selector = terminal_and_logfile_selector_code;
+ } else {
+ lmt_print_state.selector = terminal_selector_code;
+ }
+ if (! lmt_fileio_state.job_name) {
+ tex_open_log_file();
+ }
+ if (lmt_error_state.interaction == batch_mode) {
+ /*tex It becomes no or terminal. */
+ --lmt_print_state.selector;
+ }
+}
+
+/*tex The following procedure prints \TEX's last words before dying: */
+
+static void tex_aux_succumb_error(void)
+{
+ if (lmt_error_state.interaction == error_stop_mode) {
+ /*tex No more interaction: */
+ lmt_error_state.interaction = scroll_mode;
+ }
+ if (lmt_fileio_state.log_opened) {
+ tex_aux_error(succumb_error_type);
+ }
+ lmt_error_state.history = fatal_error_stop;
+ /*tex Irrecoverable error: */
+ tex_aux_jump_out();
+}
+
+/*tex This prints |s|, and that's it. */
+
+void tex_fatal_error(const char *helpinfo)
+{
+ tex_aux_normalize_selector();
+ tex_handle_error(
+ succumb_error_type,
+ "Emergency stop",
+ helpinfo
+ );
+}
+
+/*tex Here is the most dreaded error message. We stop due to finiteness. */
+
+void tex_overflow_error(const char *s, int n)
+{
+ tex_aux_normalize_selector();
+ tex_handle_error(
+ succumb_error_type,
+ "TeX capacity exceeded, sorry [%s=%i]",
+ s, n,
+ "If you really absolutely need more capacity, you can ask a wizard to enlarge me."
+ );
+}
+
+/*tex
+
+ The program might sometime run completely amok, at which point there is no choice but to stop.
+ If no previous error has been detected, that's bad news; a message is printed that is really
+ intended for the \TEX\ maintenance person instead of the user (unless the user has been
+ particularly diabolical). The index entries for \quotation {this can't happen} may help to
+ pinpoint the problem.
+
+*/
+
+int tex_confusion(const char *s)
+{
+ /*tex A consistency check violated; |s| tells where: */
+ tex_aux_normalize_selector();
+ if (lmt_error_state.history < error_message_issued) {
+ tex_handle_error(
+ succumb_error_type,
+ "This can't happen (%s)",
+ s,
+ "I'm broken. Please show this to someone who can fix me."
+ );
+ } else {
+ tex_handle_error(
+ succumb_error_type,
+ "I can't go on meeting you like this",
+ "One of your faux pas seems to have wounded me deeply ... in fact, I'm barely\n"
+ "conscious. Please fix it and try again."
+ );
+ }
+ return 0;
+}
+
+/*tex
+
+ When the program is interrupted we just quit. Here is the hook to deal with it.
+
+*/
+
+void aux_quit_the_program(void) /*tex No |tex_| prefix here! */
+{
+ tex_handle_error(
+ succumb_error_type,
+ "Forced stop",
+ NULL
+ );
+}
+
+/*tex
+
+ The |back_error| routine is used when we want to replace an offending token just before issuing
+ an error message. This routine, like |back_input|, requires that |cur_tok| has been set. We
+ disable interrupts during the call of |back_input| so that the help message won't be lost.
+
+*/
+
+static void tex_aux_back_error(void)
+{
+ tex_back_input(cur_tok);
+ tex_aux_error(back_error_type);
+}
+
+/*tex Back up one inserted token and call |error|. */
+
+static void tex_aux_insert_error(void)
+{
+ tex_back_input(cur_tok);
+ lmt_input_state.cur_input.token_type = inserted_text;
+ tex_aux_error(insert_error_type);
+}
+
+int tex_normal_error(const char *t, const char *p)
+{
+ if (lmt_engine_state.lua_only) {
+ /*tex Normally ending up here means that we call the wrong error function. */
+ tex_emergency_message(t, p);
+ } else {
+ tex_aux_normalize_selector();
+ if (! tex_aux_error_callback_set()) {
+ tex_print_nlp();
+ tex_print_str("! ");
+ }
+ tex_print_str("error");
+ if (t) {
+ tex_print_format(" (%s)", t);
+ }
+ tex_print_str(": ");
+ if (p) {
+ tex_print_str(p);
+ }
+ lmt_error_state.history = fatal_error_stop;
+ tex_print_str("\n");
+ }
+ return tex_aux_final_exit(EXIT_FAILURE);
+}
+
+void tex_normal_warning(const char *t, const char *p)
+{
+ if (strcmp(t, "lua") == 0) {
+ int callback_id = lmt_callback_defined(intercept_lua_error_callback);
+ int saved_new_line_char = new_line_char_par;
+ new_line_char_par = 10;
+ if (lmt_lua_state.lua_instance && callback_id) {
+ (void) lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ /* error(); */
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ p ? p : "unspecified lua error",
+ "The lua interpreter ran into a problem, so the remainder of this lua chunk will\n"
+ "be ignored."
+ );
+ }
+ new_line_char_par = saved_new_line_char;
+ } else {
+ int callback_id = lmt_callback_defined(show_warning_message_callback);
+ if (callback_id > 0) {
+ /*tex Free the last ones, */
+ lmt_memory_free(lmt_error_state.last_warning);
+ lmt_memory_free(lmt_error_state.last_warning_tag);
+ lmt_error_state.last_warning = lmt_memory_strdup(p);
+ lmt_error_state.last_warning_tag = lmt_memory_strdup(t);
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ } else {
+ tex_print_ln();
+ tex_print_str("warning");
+ if (t) {
+ tex_print_format(" (%s)", t);
+ }
+ tex_print_str(": ");
+ if (p) {
+ tex_print_str(p);
+ }
+ tex_print_ln();
+ }
+ if (lmt_error_state.history == spotless) {
+ lmt_error_state.history = warning_issued;
+ }
+ }
+}
+
+int tex_formatted_error(const char *t, const char *fmt, ...)
+{
+ va_list args;
+ va_start(args, fmt);
+ vsnprintf(lmt_error_state.print_buffer, print_buffer_size, fmt, args);
+ return tex_normal_error(t, lmt_error_state.print_buffer);
+ /*
+ va_end(args);
+ return 0;
+ */
+}
+
+void tex_formatted_warning(const char *t, const char *fmt, ...)
+{
+ va_list args;
+ va_start(args, fmt);
+ vsnprintf(lmt_error_state.print_buffer, print_buffer_size, fmt, args);
+ tex_normal_warning(t, lmt_error_state.print_buffer);
+ va_end(args);
+}
+
+void tex_emergency_message(const char *t, const char *fmt, ...)
+{
+ va_list args;
+ va_start(args, fmt);
+ vsnprintf(lmt_error_state.print_buffer, print_buffer_size, fmt, args);
+ fprintf(stdout,"%s : %s\n",t,lmt_error_state.print_buffer);
+ va_end(args);
+}
+
+int tex_emergency_exit(void)
+{
+ return tex_aux_final_exit(EXIT_FAILURE);
+}
+
+/*tex A prelude to more abstraction and maybe using sprint etc.*/
+
+static void tex_aux_do_handle_error_type(
+ int type
+) {
+ switch (type) {
+ case normal_error_type:
+ case eof_error_type:
+ case condition_error_type:
+ case runaway_error_type:
+ case warning_error_type:
+ tex_aux_error(type);
+ break;
+ case back_error_type:
+ tex_aux_back_error();
+ break;
+ case insert_error_type:
+ tex_aux_insert_error();
+ break;
+ case succumb_error_type:
+ tex_aux_succumb_error();
+ break;
+ }
+}
+
+void tex_handle_error_message_only(
+ const char *message
+)
+{
+ tex_aux_start_error();
+ tex_print_str(message);
+ if (tex_aux_error_callback_set()) {
+ lmt_error_state.in_error = 0;
+ lmt_memory_free(lmt_error_state.last_error);
+ lmt_error_state.last_error = lmt_memory_strdup(message);
+ }
+}
+
+/*tex
+
+ We had about 15 specific tuned message handlers as a prelude to a general template based one
+ and that one has arrived (we also have a print one, beginning 2021 only partially applied as
+ I'm undecided). We can now call a translation callback where we remap similar to how we do it
+ in ConTeXt but I;'m nor that sure if users really need it. The english is probably the least
+ problematic part of an error so first I will perfect the tracing bit.
+
+*/
+
+/*
+ %c int char
+ %s *char string
+ %q *char 'string'
+ %i int integer
+ %e backslash (tex escape)
+ %C int int symbolic representation of cmd chr
+ %E *char \cs
+ %S int tex cs string
+ %M int mode
+ %T int tex string
+ %% percent
+
+*/
+
+extern void tex_handle_error(error_types type, const char *format, ...)
+{
+ va_list args;
+ va_start(args, format); /* hm, weird, no number */
+ /*tex Todo: a translation callback: |str, 1 => str|. */
+ tex_aux_start_error();
+ while (1) {
+ int chr = *format++;
+ switch (chr) {
+ case '\0':
+ goto DONE;
+ case '%':
+ {
+ chr = *format++;
+ switch (chr) {
+ case '\0':
+ goto DONE;
+ case 'c':
+ tex_print_char(va_arg(args, int));
+ break;
+ case 's':
+ tex_print_str(va_arg(args, char *));
+ break;
+ case 'q':
+ tex_print_char('\'');
+ tex_print_str(va_arg(args, char *));
+ tex_print_char('\'');
+ break;
+ case 'm':
+ tex_print_cs_checked(va_arg(args, int));
+ break;
+ case 'i':
+ tex_print_int(va_arg(args, int));
+ break;
+ case 'e':
+ tex_print_str_esc(NULL);
+ break;
+ case 'C':
+ {
+ int cmd = va_arg(args, int);
+ int val = va_arg(args, int);
+ tex_print_cmd_chr((singleword) cmd, val); /* inlining doesn't work */
+ break;
+ }
+ case 'E':
+ tex_print_str_esc(va_arg(args, char *));
+ break;
+ case 'S':
+ {
+ halfword cs = va_arg(args, int);
+ tex_print_cs(cs);
+ break;
+ }
+ case 'M':
+ {
+ halfword mode = va_arg(args, int);
+ tex_print_str(tex_string_mode(mode));
+ break;
+ }
+ case 'T':
+ {
+ strnumber s = va_arg(args, int);
+ tex_print_tex_str(s);
+ break;
+ }
+ case '%':
+ tex_print_char('%');
+ break;
+ default:
+ /* ignore bad one */
+ break;
+ }
+ }
+ break;
+ default:
+ tex_print_char(chr); /* todo: utf */
+ break;
+ }
+ }
+ DONE:
+ /*tex Todo: a translation callback: |str, 2 => str|. */
+ tex_aux_update_help_text(va_arg(args, char *));
+ tex_aux_do_handle_error_type(type);
+ va_end(args);
+}
diff --git a/source/luametatex/source/tex/texerrors.h b/source/luametatex/source/tex/texerrors.h
new file mode 100644
index 000000000..8c67b9a45
--- /dev/null
+++ b/source/luametatex/source/tex/texerrors.h
@@ -0,0 +1,117 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_ERRORS_H
+# define LMT_ERRORS_H
+
+/*tex
+
+ The global variable |interaction| has four settings, representing increasing amounts of user
+ interaction:
+
+*/
+
+# define print_buffer_size 512 /*tex Watch out for alignment! Only used here. */
+
+typedef enum interaction_levels {
+ batch_mode, /*tex omits all stops and omits terminal output */
+ nonstop_mode, /*tex omits all stops */
+ scroll_mode, /*tex omits error stops */
+ error_stop_mode, /*tex stops at every opportunity to interact */
+} interaction_levels;
+
+# define last_interaction_level error_stop_mode
+
+typedef struct error_state_info {
+ char *last_error;
+ char *last_lua_error;
+ char *last_warning_tag;
+ char *last_warning;
+ char *last_error_context;
+ char *help_text; /*tex helps for the next |error| */
+ char print_buffer[print_buffer_size];
+ int intercept; /*tex intercept error state */
+ int last_intercept; /*tex error state number / dimen scanner */
+ int interaction; /*tex current level of interaction */
+ int default_exit_code; /*tex the exit code can be overloaded */
+ int set_box_allowed;
+ int history;
+ int error_count;
+ int err_old_setting;
+ int in_error;
+ int long_help_seen;
+ int context_indent;
+ int padding;
+ limits_data line_limits;
+ limits_data half_line_limits;
+} error_state_info;
+
+extern error_state_info lmt_error_state;
+
+typedef enum error_states {
+ spotless, /*tex |history| value when nothing has been amiss yet */
+ warning_issued, /*tex |history| value when |begin_diagnostic| has been called */
+ error_message_issued, /*tex |history| value when |error| has been called */
+ fatal_error_stop, /*tex |history| value when termination was premature */
+} error_states;
+
+extern void tex_initialize_errors (void);
+extern void tex_fixup_selector (int log_opened);
+extern void tex_fatal_error (const char *helpinfo);
+extern void tex_overflow_error (const char *s, int n);
+extern int tex_confusion (const char *s);
+extern int tex_normal_error (const char *t, const char *p);
+extern void tex_normal_warning (const char *t, const char *p);
+extern int tex_formatted_error (const char *t, const char *fmt, ...);
+extern void tex_formatted_warning (const char *t, const char *fmt, ...);
+extern void tex_emergency_message (const char *t, const char *fmt, ...);
+extern int tex_emergency_exit (void);
+extern int tex_normal_exit (void);
+
+/*tex A bit more detail. */
+
+# define error_string_clobbered(n) "[clobbered " LMT_TOSTRING(n) "]"
+# define error_string_bad(n) "[bad " LMT_TOSTRING(n) "]"
+# define error_string_impossible(n) "[impossible " LMT_TOSTRING(n) "]"
+# define error_string_nonexistent(n) "[nonexistent " LMT_TOSTRING(n) "]"
+
+/*tex
+*
+ We now have a template based error handler instead of more dan a dozen specific ones that took
+ an error type, a different set of variables, and the helptext. The template uses the (usual)
+ percent driven directives:
+
+ \starttabulate
+ \NC \type {s} \NC string \NC \NR
+ \NC \type {c} \NC char \NC \NR
+ \NC \type {q} \NC 'string' \NC \NR
+ \NC \type {i} \NC integer \NC \NR
+ \NC \type {e} \NC escape char \NC \NR
+ \NC \type {C} \NC cmd chr \NC \NR
+ \NC \type {E} \NC escaped string \NC \NR
+ \NC \type {S} \NC cs \NC \NR
+ \NC \type {T} \NC texstring \NC \NR
+ \stoptabulate
+
+ A placeholder starts with a percent sign. A double percent sign will print one. The last very
+ argument is the error message (or |NULL|). We flush on a per character basis but that happens
+ anyway and error messages are not really a bottleneck.
+
+ */
+
+typedef enum error_types {
+ normal_error_type,
+ back_error_type,
+ insert_error_type,
+ succumb_error_type, /* fatal error_type */
+ eof_error_type,
+ condition_error_type,
+ runaway_error_type,
+ warning_error_type,
+} error_types;
+
+extern void tex_handle_error (error_types type, const char *format, ...);
+extern void tex_handle_error_message_only (const char *message);
+
+# endif
diff --git a/source/luametatex/source/tex/texexpand.c b/source/luametatex/source/tex/texexpand.c
new file mode 100644
index 000000000..25dcccdf3
--- /dev/null
+++ b/source/luametatex/source/tex/texexpand.c
@@ -0,0 +1,1411 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Only a dozen or so command codes |> max_command| can possibly be returned by |get_next|; in
+ increasing order, they are |undefined_cs|, |expand_after|, |no_expand|, |input|, |if_test|,
+ |fi_or_else|, |cs_name|, |convert|, |the|, |get_mark|, |call|, |long_call|, |outer_call|,
+ |long_outer_call|, and |end_template|.
+
+ Sometimes, recursive calls to the following |expand| routine may cause exhaustion of the
+ run-time calling stack, resulting in forced execution stops by the operating system. To
+ diminish the chance of this happening, a counter is used to keep track of the recursion depth,
+ in conjunction with a constant called |expand_depth|.
+
+ Note that this does not catch all possible infinite recursion loops, just the ones that
+ exhaust the application calling stack. The actual maximum value of |expand_depth| is outside
+ of our control, but the initial setting of |100| should be enough to prevent problems.
+
+*/
+
+expand_state_info lmt_expand_state = {
+ .limits = {
+ .minimum = min_expand_depth,
+ .maximum = max_expand_depth,
+ .size = min_expand_depth,
+ .top = 0,
+ },
+ .depth = 0,
+ .cs_name_level = 0,
+ .arguments = 0,
+ .match_token_head = null,
+ .padding = 0,
+};
+
+ static void tex_aux_macro_call (halfword cs, halfword cmd, halfword chr);
+inline static void tex_aux_manufacture_csname (void);
+inline static void tex_aux_manufacture_csname_use (void);
+inline static void tex_aux_manufacture_csname_future (void);
+inline static void tex_aux_inject_last_tested_cs (void);
+
+/*tex
+
+ We no longer store |match_token_head| in the format file. It is a bit cleaner to just
+ initialize them. So we free them.
+
+*/
+
+void tex_initialize_expansion(void)
+{
+ lmt_expand_state.match_token_head = tex_get_available_token(null);
+}
+
+void tex_cleanup_expansion(void)
+{
+ tex_put_available_token(lmt_expand_state.match_token_head);
+}
+
+halfword tex_expand_match_token_head(void)
+{
+ return lmt_expand_state.match_token_head;
+}
+
+/*tex
+
+ The |expand| subroutine is used when |cur_cmd > max_command|. It removes a \quote {call} or a
+ conditional or one of the other special operations just listed. It follows that |expand| might
+ invoke itself recursively. In all cases, |expand| destroys the current token, but it sets things
+ up so that the next |get_next| will deliver the appropriate next token. The value of |cur_tok|
+ need not be known when |expand| is called.
+
+ Since several of the basic scanning routines communicate via global variables, their values are
+ saved as local variables of |expand| so that recursive calls don't invalidate them.
+
+*/
+
+inline static void tex_aux_expand_after(void)
+{
+ /*tex
+ Expand the token after the next token. It takes only a little shuffling to do what \TEX\
+ calls |\expandafter|.
+ */
+ halfword t1 = tex_get_token();
+ halfword t2 = tex_get_token();
+ if (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ } else {
+ tex_back_input(t2);
+ }
+ tex_back_input(t1);
+}
+
+inline static void tex_aux_expand_toks_after(void)
+{
+ halfword t1 = tex_scan_toks_normal(0, NULL);
+ halfword t2 = tex_get_token();
+ if (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ } else {
+ tex_back_input(t2);
+ }
+ tex_begin_backed_up_list(token_link(t1));
+ tex_put_available_token(t1);
+}
+
+/*tex
+ Here we deal with stuff not in the big switch. Where that is discussed there is mentioning of
+ it all being a bit messy, also due to the fact that that switch (or actually a lookup table)
+ also uses the mode for determining what to do. We see no reason to change this model.
+*/
+
+void tex_expand_current_token(void)
+{
+ ++lmt_expand_state.depth;
+ if (lmt_expand_state.depth > lmt_expand_state.limits.top) {
+ if (lmt_expand_state.depth >= lmt_expand_state.limits.size) {
+ tex_overflow_error("expansion depth", lmt_expand_state.limits.size);
+ } else {
+ lmt_expand_state.limits.top += 1;
+ }
+ }
+ /*tex We're okay. */
+ {
+ halfword saved_cur_val = cur_val;
+ halfword saved_cur_val_level = cur_val_level;
+ // halfword saved_head = token_link(token_data.backup_head);
+ if (cur_cmd < first_call_cmd) {
+ /*tex Expand a nonmacro. */
+ if (tracing_commands_par > 1) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ switch (cur_cmd) {
+ case expand_after_cmd:
+ {
+ int mode = cur_chr;
+ switch (mode) {
+ case expand_after_code:
+ tex_aux_expand_after();
+ break;
+ /*
+ case expand_after_3_code:
+ tex_aux_expand_after();
+ // fall-through
+ case expand_after_2_code:
+ tex_aux_expand_after();
+ tex_aux_expand_after();
+ break;
+ */
+ case expand_unless_code:
+ tex_conditional_unless();
+ break;
+ case future_expand_code:
+ /*tex
+ This is an experiment: |\futureexpand| (2) which takes |\check \yes
+ \nop| as arguments. It's not faster, but gives less tracing noise
+ than a macro. The variant |\futureexpandis| (3) alternative doesn't
+ inject the gobbles space(s).
+ */
+ tex_get_token();
+ {
+ halfword spa = null;
+ halfword chr = cur_chr;
+ halfword cmd = cur_cmd;
+ halfword yes = tex_get_token(); /* when match */
+ halfword nop = tex_get_token(); /* when no match */
+ while (1) {
+ halfword t = tex_get_token();
+ if (cur_cmd == spacer_cmd) {
+ spa = t;
+ } else {
+ tex_back_input(t);
+ break;
+ }
+ }
+ /*tex The value 1 means: same input level. */
+ if (cur_cmd == cmd && cur_chr == chr) {
+ tex_reinsert_token(yes);
+ } else {
+ if (spa) {
+ tex_reinsert_token(space_token);
+ }
+ tex_reinsert_token(nop);
+ }
+ }
+ break;
+ case future_expand_is_code:
+ tex_get_token();
+ {
+ halfword chr = cur_chr;
+ halfword cmd = cur_cmd;
+ halfword yes = tex_get_token(); /* when match */
+ halfword nop = tex_get_token(); /* when no match */
+ while (1) {
+ halfword t = tex_get_token();
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(t);
+ break;
+ }
+ }
+ tex_reinsert_token((cur_cmd == cmd && cur_chr == chr) ? yes : nop);
+ }
+ break;
+ case future_expand_is_ap_code:
+ tex_get_token();
+ {
+ halfword chr = cur_chr;
+ halfword cmd = cur_cmd;
+ halfword yes = tex_get_token(); /* when match */
+ halfword nop = tex_get_token(); /* when no match */
+ while (1) {
+ halfword t = tex_get_token();
+ if (cur_cmd != spacer_cmd && cur_cmd != end_paragraph_cmd) {
+ tex_back_input(t);
+ break;
+ }
+ }
+ /*tex We stay at the same input level. */
+ tex_reinsert_token((cur_cmd == cmd && cur_chr == chr) ? yes : nop);
+ }
+ break;
+ case expand_after_spaces_code:
+ {
+ /* maybe two variants: after_spaces and after_par like in the ignores */
+ halfword t1 = tex_get_token();
+ while (1) {
+ halfword t2 = tex_get_token();
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(t2);
+ break;
+ }
+ }
+ tex_reinsert_token(t1);
+ break;
+ }
+ case expand_after_pars_code:
+ {
+ halfword t1 = tex_get_token();
+ while (1) {
+ halfword t2 = tex_get_token();
+ if (cur_cmd != spacer_cmd && cur_cmd != end_paragraph_cmd) {
+ tex_back_input(t2);
+ break;
+ }
+ }
+ tex_reinsert_token(t1);
+ break;
+ }
+ case expand_token_code:
+ {
+ /* we can share code with lmtokenlib .. todo */
+ halfword cat = tex_scan_category_code();
+ halfword chr = tex_scan_char_number(0);
+ /* too fragile:
+ halfword tok = null;
+ switch (cat) {
+ case letter_cmd:
+ case other_char_cmd:
+ case ignore_cmd:
+ case spacer_cmd:
+ tok = token_val(cat, chr);
+ break;
+ case active_char_cmd:
+ {
+ halfword cs = tex_active_to_cs(chr, ! lmt_hash_state.no_new_cs);
+ if (cs) {
+ chr = eq_value(cs);
+ tok = cs_token_flag + cs;
+ break;
+ }
+ }
+ default:
+ tok = token_val(other_char_cmd, chr);
+ break;
+ }
+ */
+ switch (cat) {
+ case letter_cmd:
+ case other_char_cmd:
+ case ignore_cmd:
+ case spacer_cmd:
+ break;
+ default:
+ cat = other_char_cmd;
+ break;
+ }
+ tex_back_input(token_val(cat, chr));
+ break;
+ }
+ case expand_cs_token_code:
+ {
+ tex_get_token();
+ if (cur_tok >= cs_token_flag) {
+ halfword cmd = eq_type(cur_cs);
+ switch (cmd) {
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case alignment_tab_cmd:
+ case superscript_cmd:
+ case subscript_cmd:
+ case spacer_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ cur_tok = token_val(cmd, eq_value(cur_cs));
+ break;
+ }
+ }
+ tex_back_input(cur_tok);
+ break;
+ }
+ case expand_code:
+ {
+ tex_get_token();
+ if (cur_cmd >= first_call_cmd && cur_cmd <= last_call_cmd) {
+ tex_aux_macro_call(cur_cs, cur_cmd, cur_chr);
+ } else {
+ /* Use expand_current_token so that protected lua call are dealt with too? */
+ tex_back_input(cur_tok);
+ }
+ break;
+ }
+ case semi_expand_code:
+ {
+ tex_get_token();
+ if (is_semi_protected_cmd(cur_cmd)) {
+ tex_aux_macro_call(cur_cs, cur_cmd, cur_chr);
+ } else {
+ /* Use expand_current_token so that protected lua call are dealt with too? */
+ tex_back_input(cur_tok);
+ }
+ break;
+ }
+ case expand_after_toks_code:
+ {
+ tex_aux_expand_toks_after();
+ break;
+ }
+ /*
+ case expand_after_fi:
+ {
+ conditional_after_fi();
+ break;
+ }
+ */
+ }
+ }
+ break;
+ case cs_name_cmd:
+ /*tex Manufacture a control sequence name. */
+ switch (cur_chr) {
+ case cs_name_code:
+ tex_aux_manufacture_csname();
+ break;
+ case last_named_cs_code:
+ tex_aux_inject_last_tested_cs();
+ break;
+ case begin_cs_name_code:
+ tex_aux_manufacture_csname_use();
+ break;
+ case future_cs_name_code:
+ tex_aux_manufacture_csname_future();
+ break;
+ }
+ break;
+ case no_expand_cmd:
+ {
+ /*tex
+ Suppress expansion of the next token. The implementation of |\noexpand|
+ is a bit trickier, because it is necessary to insert a special
+ |dont_expand| marker into \TEX's reading mechanism. This special marker
+ is processed by |get_next|, but it does not slow down the inner loop.
+
+ Since |\outer| macros might arise here, we must also clear the
+ |scanner_status| temporarily.
+ */
+ halfword t;
+ halfword save_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ t = tex_get_token();
+ lmt_input_state.scanner_status = save_scanner_status;
+ tex_back_input(t);
+ /*tex Now |start| and |loc| point to the backed-up token |t|. */
+ if (t >= cs_token_flag) {
+ halfword p = tex_get_available_token(deep_frozen_dont_expand_token);
+ set_token_link(p, lmt_input_state.cur_input.loc);
+ lmt_input_state.cur_input.start = p;
+ lmt_input_state.cur_input.loc = p;
+ }
+ }
+ break;
+ case if_test_cmd:
+ if (cur_chr < first_real_if_test_code) {
+ tex_conditional_fi_or_else();
+ } else if (cur_chr != if_condition_code) {
+ tex_conditional_if(cur_chr, 0);
+ } else {
+ /*tex The |\ifcondition| primitive is a no-op unless we're in skipping mode. */
+ }
+ break;
+ case the_cmd:
+ {
+ halfword h = tex_the_toks(cur_chr, NULL);
+ tex_begin_inserted_list(h);
+ break;
+ }
+ case lua_call_cmd:
+ if (cur_chr > 0) {
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ lmt_function_call(cur_chr, 0);
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ } else {
+ tex_normal_error("luacall", "invalid number");
+ }
+ break;
+ case lua_local_call_cmd:
+ if (cur_chr > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ /* todo: use a private table as we can overflow, unless we register early */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, cur_chr);
+ if (lua_pcall(L, 0, 0, 0)) {
+ tex_formatted_warning("luacall", "local call error: %s", lua_tostring(L, -1));
+ } else {
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ }
+ } else {
+ tex_normal_error("luacall", "invalid number");
+ }
+ break;
+ case begin_local_cmd:
+ tex_begin_local_control();
+ break;
+ case convert_cmd:
+ tex_run_convert_tokens(cur_chr);
+ break;
+ case input_cmd:
+ /*tex Initiate or terminate input from a file */
+ switch (cur_chr) {
+ case normal_input_code:
+ if (lmt_fileio_state.name_in_progress) {
+ tex_insert_relax_and_cur_cs();
+ } else {
+ tex_start_input(tex_read_file_name(0, NULL, texinput_extension));
+ }
+ break;
+ case end_of_input_code:
+ lmt_token_state.force_eof = 1;
+ break;
+ case quit_loop_code:
+ lmt_main_control_state.quit_loop = 1;
+ break;
+ case token_input_code:
+ tex_tex_string_start(io_token_eof_input_code, cat_code_table_par);
+ break;
+ case tex_token_input_code:
+ tex_tex_string_start(io_token_input_code, cat_code_table_par);
+ break;
+ case tokenized_code:
+ case retokenized_code:
+ {
+ /*tex
+ This variant complements the other expandable primitives but
+ also supports an optional keyword, who knows when that comes in
+ handy; what goes in is detokenized anyway. For now it is an
+ undocumented feature. It is likely that there is a |cct| passed
+ so we don't need to optimize. If needed we can make a version
+ where this is mandate.
+ */
+ int cattable = (cur_chr == retokenized_code || tex_scan_optional_keyword("catcodetable")) ? tex_scan_int(0, NULL) : cat_code_table_par;
+ full_scanner_status saved_full_status = tex_save_full_scanner_status();
+ strnumber u = tex_save_cur_string();
+ halfword s = tex_scan_toks_expand(0, NULL, 0);
+ tex_unsave_full_scanner_status(saved_full_status);
+ if (token_link(s)) {
+ tex_begin_inserted_list(tex_wrapped_token_list(s));
+ tex_tex_string_start(io_token_input_code, cattable);
+ }
+ tex_put_available_token(s);
+ tex_restore_cur_string(u);
+ }
+ break;
+ default:
+ break;
+ }
+ break;
+ case get_mark_cmd:
+ {
+ /*tex Insert the appropriate mark text into the scanner. */
+ halfword num = 0;
+ halfword code = cur_chr;
+ switch (code) {
+ case top_marks_code:
+ case first_marks_code:
+ case bot_marks_code:
+ case split_first_marks_code:
+ case split_bot_marks_code:
+ case current_marks_code:
+ num = tex_scan_mark_number();
+ break;
+ }
+ if (tex_valid_mark(num)) {
+ halfword ptr = tex_get_some_mark(code, num);
+ if (ptr) {
+ tex_begin_token_list(ptr, mark_text);
+ }
+ }
+ break;
+ }
+ /*
+ case string_cmd:
+ {
+ halfword head = str_toks(str_lstring(cs_offset_value + cur_chr), NULL);
+ begin_inserted_list(head);
+ break;
+ }
+ */
+ default:
+ /* Maybe ... or maybe an option */
+ // if (lmt_expand_state.cs_name_level == 0) {
+ /*tex Complain about an undefined macro */
+ tex_handle_error(
+ normal_error_type,
+ "Undefined control sequence %m", cur_cs,
+ "The control sequence at the end of the top line of your error message was never\n"
+ "\\def'ed. You can just continue as I'll forget about whatever was undefined."
+ );
+ // }
+ break;
+ }
+ } else if (cur_cmd <= last_call_cmd) {
+ tex_aux_macro_call(cur_cs, cur_cmd, cur_chr);
+ } else {
+ /*tex
+ Insert a token containing |frozen_endv|. An |end_template| command is effectively
+ changed to an |endv| command by the following code. (The reason for this is discussed
+ below; the |frozen_end_template| at the end of the template has passed the
+ |check_outer_validity| test, so its mission of error detection has been accomplished.)
+ */
+ tex_back_input(deep_frozen_end_template_2_token);
+ }
+ cur_val = saved_cur_val;
+ cur_val_level = saved_cur_val_level;
+ // set_token_link(token_data.backup_head, saved_head);
+ }
+ --lmt_expand_state.depth;
+}
+
+static void tex_aux_complain_missing_csname(void)
+{
+ tex_handle_error(
+ back_error_type,
+ "Missing \\endcsname inserted",
+ "The control sequence marked <to be read again> should not appear between \\csname\n"
+ "and \\endcsname."
+ );
+}
+
+inline static int tex_aux_uni_to_buffer(unsigned char *b, int m, int c)
+{
+ if (c <= 0x7F) {
+ b[m++] = (unsigned char) c;
+ } else if (c <= 0x7FF) {
+ b[m++] = (unsigned char) (0xC0 + c / 0x40);
+ b[m++] = (unsigned char) (0x80 + c % 0x40);
+ } else if (c <= 0xFFFF) {
+ b[m++] = (unsigned char) (0xE0 + c / 0x1000);
+ b[m++] = (unsigned char) (0x80 + (c % 0x1000) / 0x40);
+ b[m++] = (unsigned char) (0x80 + (c % 0x1000) % 0x40);
+ } else {
+ b[m++] = (unsigned char) (0xF0 + c / 0x40000);
+ b[m++] = (unsigned char) (0x80 + ( c % 0x40000) / 0x1000);
+ b[m++] = (unsigned char) (0x80 + ((c % 0x40000) % 0x1000) / 0x40);
+ b[m++] = (unsigned char) (0x80 + ((c % 0x40000) % 0x1000) % 0x40);
+ }
+ return m;
+}
+
+/*tex
+ We also quit on a protected macro call, which is different from \LUATEX\ (and \PDFTEX) but makes
+ much sense. It also long token lists that never (should) match anyway.
+*/
+
+
+static int tex_aux_collect_cs_tokens(halfword *p, int *n)
+{
+ while (1) {
+ tex_get_next();
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case alignment_tab_cmd:
+ /* case end_line_cmd: */
+ case parameter_cmd:
+ case superscript_cmd:
+ case subscript_cmd:
+ /* case ignore_cmd: */
+ case spacer_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ // cur_tok = token_val(cur_cmd, cur_chr);
+ // *p = tex_store_new_token(*p, cur_tok);
+ *p = tex_store_new_token(*p, token_val(cur_cmd, cur_chr));
+ *n += 1;
+ break;
+ /* case active_char_cmd: */
+ /* case comment_cmd: */
+ /* case invalid_char_cmd: */
+ /*
+ case string_cmd:
+ cur_tok = token_val(cur_cmd, cur_chr);
+ *p = store_new_token(*p, cur_tok);
+ *n += str_length(cs_offset_value + cur_chr);
+ break;
+ */
+ case call_cmd:
+ case tolerant_call_cmd:
+ tex_aux_macro_call(cur_cs, cur_cmd, cur_chr);
+ break;
+ case end_cs_name_cmd:
+ return 1;
+ default:
+ if (cur_cmd > max_command_cmd && cur_cmd < first_call_cmd) {
+ tex_expand_current_token();
+ } else {
+ return 0;
+ }
+ }
+ }
+}
+
+int tex_is_valid_csname(void)
+{
+ halfword cs = null_cs;
+ int b = 0;
+ int n = 0;
+ halfword h = tex_get_available_token(null);
+ halfword p = h;
+ lmt_expand_state.cs_name_level += 1;
+ if (! tex_aux_collect_cs_tokens(&p, &n)) {
+ do {
+ tex_get_x_or_protected(); /* we skip unprotected ! */
+ } while (cur_cmd != end_cs_name_cmd);
+ goto FINISH;
+ } else if (n) {
+ /*tex Look up the characters of list |n| in the hash table, and set |cur_cs|. */
+ int f = lmt_fileio_state.io_first;
+ if (tex_room_in_buffer(f + n * 4)) {
+ int m = f;
+ halfword l = token_link(h);
+ while (l) {
+ m = tex_aux_uni_to_buffer(lmt_fileio_state.io_buffer, m, token_chr(token_info(l)));
+ l = token_link(l);
+ }
+ cs = tex_id_locate(f, m - f, 0); /*tex Don't create a new cs! */
+ b = (cs != undefined_control_sequence) && (eq_type(cs) != undefined_cs_cmd);
+ }
+ }
+ FINISH:
+ tex_flush_token_list_head_tail(h, p, n + 1);
+ lmt_scanner_state.last_cs_name = cs;
+ lmt_expand_state.cs_name_level -= 1;
+ cur_cs = cs;
+ return b;
+}
+
+inline static halfword tex_aux_get_cs_name(void)
+{
+ halfword h = tex_get_available_token(null); /* hm */
+ halfword p = h;
+ int n = 0;
+ lmt_expand_state.cs_name_level += 1;
+ if (tex_aux_collect_cs_tokens(&p, &n)) {
+ /*tex Look up the characters of list |r| in the hash table, and set |cur_cs|. */
+ int siz;
+ char *s = tex_tokenlist_to_tstring(h, 1, &siz, 0, 0, 0);
+ cur_cs = (siz > 0) ? tex_string_locate((char *) s, siz, 1) : null_cs;
+ } else {
+ tex_aux_complain_missing_csname();
+ }
+ lmt_scanner_state.last_cs_name = cur_cs;
+ lmt_expand_state.cs_name_level -= 1;
+ tex_flush_token_list_head_tail(h, p, n);
+ return cur_cs;
+}
+
+inline static void tex_aux_manufacture_csname(void)
+{
+ halfword cs = tex_aux_get_cs_name();
+ if (eq_type(cs) == undefined_cs_cmd) {
+ /*tex The |save_stack| might change! */
+ tex_eq_define(cs, relax_cmd, relax_code);
+ }
+ /*tex The control sequence will now match |\relax| */
+ tex_back_input(cs + cs_token_flag);
+}
+
+inline static void tex_aux_manufacture_csname_use(void)
+{
+ if (tex_is_valid_csname()) {
+ tex_back_input(cur_cs + cs_token_flag);
+ } else {
+ lmt_scanner_state.last_cs_name = deep_frozen_relax_token;
+ }
+}
+
+inline static void tex_aux_manufacture_csname_future(void)
+{
+ halfword t = tex_get_token();
+ if (tex_is_valid_csname()) {
+ tex_back_input(cur_cs + cs_token_flag);
+ } else {
+ lmt_scanner_state.last_cs_name = deep_frozen_relax_token;
+ tex_back_input(t);
+ }
+}
+
+halfword tex_create_csname(void)
+{
+ halfword cs = tex_aux_get_cs_name();
+ if (eq_type(cs) == undefined_cs_cmd) {
+ tex_eq_define(cs, relax_cmd, relax_code);
+ }
+ return cs; // cs + cs_token_flag;
+}
+
+inline static void tex_aux_inject_last_tested_cs(void)
+{
+ if (lmt_scanner_state.last_cs_name != null_cs) {
+ tex_back_input(lmt_scanner_state.last_cs_name + cs_token_flag);
+ }
+}
+
+/*tex
+
+ Sometimes the expansion looks too far ahead, so we want to insert a harmless |\relax| into the
+ user's input.
+*/
+
+void tex_insert_relax_and_cur_cs(void)
+{
+ tex_back_input(cs_token_flag + cur_cs);
+ tex_reinsert_token(deep_frozen_relax_token);
+ lmt_input_state.cur_input.token_type = inserted_text;
+}
+
+/*tex
+
+ Here is a recursive procedure that is \TEX's usual way to get the next token of input. It has
+ been slightly optimized to take account of common cases.
+
+*/
+
+halfword tex_get_x_token(void)
+{
+ /*tex This code sets |cur_cmd|, |cur_chr|, |cur_tok|, and expands macros. */
+ while (1) {
+ tex_get_next();
+ if (cur_cmd <= max_command_cmd) {
+ break;
+ } else if (cur_cmd < first_call_cmd) {
+ tex_expand_current_token();
+ } else if (cur_cmd <= last_call_cmd) {
+ tex_aux_macro_call(cur_cs, cur_cmd, cur_chr);
+ } else {
+ cur_cs = deep_frozen_cs_end_template_2_code;
+ cur_cmd = end_template_cmd;
+ /*tex Now |cur_chr = token_state.null_list|. */
+ break;
+ }
+ }
+ if (cur_cs) {
+ cur_tok = cs_token_flag + cur_cs;
+ } else {
+ cur_tok = token_val(cur_cmd, cur_chr);
+ }
+ return cur_tok;
+}
+
+/*tex
+
+ The |get_x_token| procedure is equivalent to two consecutive procedure calls: |get_next; x_token|.
+ It's |get_x_token| without the initial |get_next|.
+
+*/
+
+void tex_x_token(void)
+{
+ while (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ tex_get_next();
+ }
+ if (cur_cs) {
+ cur_tok = cs_token_flag + cur_cs;
+ } else {
+ cur_tok = token_val(cur_cmd, cur_chr);
+ }
+}
+
+/*tex
+
+ A control sequence that has been |\def|'ed by the user is expanded by \TEX's |macro_call|
+ procedure. Here we also need to deal with marks, but these are discussed elsewhere.
+
+ So let's consider |macro_call| itself, which is invoked when \TEX\ is scanning a control
+ sequence whose |cur_cmd| is either |call|, |long_call|, |outer_call|, or |long_outer_call|. The
+ control sequence definition appears in the token list whose reference count is in location
+ |cur_chr| of |mem|.
+
+ The global variable |long_state| will be set to |call| or to |long_call|, depending on whether
+ or not the control sequence disallows |\par| in its parameters. The |get_next| routine will set
+ |long_state| to |outer_call| and emit |\par|, if a file ends or if an |\outer| control sequence
+ occurs in the midst of an argument.
+
+ The parameters, if any, must be scanned before the macro is expanded. Parameters are token
+ lists without reference counts. They are placed on an auxiliary stack called |pstack| while
+ they are being scanned, since the |param_stack| may be losing entries during the matching
+ process. (Note that |param_stack| can't be gaining entries, since |macro_call| is the only
+ routine that puts anything onto |param_stack|, and it is not recursive.)
+
+ After parameter scanning is complete, the parameters are moved to the |param_stack|. Then the
+ macro body is fed to the scanner; in other words, |macro_call| places the defined text of the
+ control sequence at the top of \TEX's input stack, so that |get_next| will proceed to read it
+ next.
+
+ The global variable |cur_cs| contains the |eqtb| address of the control sequence being expanded,
+ when |macro_call| begins. If this control sequence has not been declared |\long|, i.e., if its
+ command code in the |eq_type| field is not |long_call| or |long_outer_call|, its parameters are
+ not allowed to contain the control sequence |\par|. If an illegal |\par| appears, the macro call
+ is aborted, and the |\par| will be rescanned.
+
+ Beware: we cannot use |cur_cmd| here because for instance |\bgroup| can be part of an argument
+ without there being an |\egroup|. We really need to check raw brace tokens (|{}|) here when we
+ pick up an argument!
+
+ */
+
+/*tex
+
+ In \LUAMETATEX| we have an extended argument definition system. The approach is still the same
+ and the additional code kind of fits in. There is a bit more testing going on but the overhead
+ is kept at a minimum so performance is not hit. Macro packages like \CONTEXT\ spend a lot of
+ time expanding and the extra overhead of the extensions is compensated by some gain in using
+ them. However, the most important motive is in readability of macro code on the one hand and
+ the wish for less tracing (due to all this multi-step processing) on the other. It suits me
+ well. This is definitely a case of |goto| abuse.
+
+*/
+
+static halfword tex_aux_prune_list(halfword h)
+{
+ halfword t = h;
+ halfword p = null;
+ int done = 0;
+ int last = null;
+ while (t) {
+ halfword l = token_link(t);
+ halfword i = token_info(t);
+ halfword c = token_cmd(i);
+ if (c != spacer_cmd && c != end_paragraph_cmd && i != lmt_token_state.par_token) { // c != 0xFF
+ done = 1;
+ last = null;
+ } else if (done) {
+ if (! last) {
+ last = p; /* before space */
+ }
+ } else {
+ h = l;
+ tex_put_available_token(t);
+ }
+ p = t;
+ t = l;
+ }
+ if (last) {
+ halfword l = token_link(last);
+ token_link(last) = null;
+ tex_flush_token_list(l);
+ }
+ return h;
+}
+
+int tex_get_parameter_count(void)
+{
+ int n = 0;
+ for (int i = lmt_input_state.cur_input.parameter_start; i < lmt_input_state.parameter_stack_data.ptr; i++) {
+ if (lmt_input_state.parameter_stack[i]) {
+ ++n;
+ } else {
+ break;
+ }
+ }
+ return n;
+}
+
+static void tex_aux_macro_call(halfword cs, halfword cmd, halfword chr)
+{
+ int tracing = tracing_macros_par > 0;
+ if (tracing) {
+ /*tex
+ Setting |\tracingmacros| to 2 means that elsewhere marks etc are shown so in fact a bit
+ more detail. However, as we turn that on anyway, using a value of 3 is not that weird
+ for less info here. Introducing an extra parameter makes no sense.
+ */
+ tex_begin_diagnostic();
+ tex_print_cs_checked(cs);
+ if (is_untraced(eq_flag(cs))) {
+ tracing = 0;
+ } else {
+ if (! get_token_parameters(chr)) {
+ tex_print_str("->");
+ } else {
+ /* maybe move the preamble scanner to here */
+ }
+ tex_token_show(chr, default_token_show_max);
+ }
+ tex_end_diagnostic();
+ }
+ if (get_token_parameters(chr)) {
+ halfword matchpointer = token_link(chr);
+ halfword matchtoken = token_info(matchpointer);
+ int save_scanner_status = lmt_input_state.scanner_status;
+ halfword save_warning_index = lmt_input_state.warning_index;
+ int nofscanned = 0;
+ int nofarguments = 0;
+ halfword pstack[9]; /* We could go for 15 if we accept |#A-#F|. */
+ /*tex
+ Scan the parameters and make |link(r)| point to the macro body; but |return| if an
+ illegal |\par| is detected.
+
+ At this point, the reader will find it advisable to review the explanation of token
+ list format that was presented earlier, since many aspects of that format are of
+ importance chiefly in the |macro_call| routine.
+
+ The token list might begin with a string of compulsory tokens before the first
+ |match| or |end_match|. In that case the macro name is supposed to be followed by
+ those tokens; the following program will set |s=null| to represent this restriction.
+ Otherwise |s| will be set to the first token of a string that will delimit the next
+ parameter.
+ */
+ int tolerant = is_tolerant_cmd(cmd);
+ /*tex the number of tokens or groups (usually) */
+ halfword count = 0;
+ /*tex one step before the last |right_brace| token */
+ halfword rightbrace = null;
+ /*tex the state, currently the character used in parameter */
+ int match = 0;
+ int thrash = 0;
+ int quitting = 0;
+ int last = 0;
+ /*tex current node in parameter token list being built */
+ halfword p = null;
+ /*tex backup pointer for parameter matching */
+ halfword s = null;
+ int spacer = 0;
+ /*tex
+ One day I will check the next code for too many tests, no that much branching that it.
+ The numbers in |#n| are match tokens except the last one, which is has a different
+ token info.
+ */
+ lmt_input_state.warning_index = cs;
+ lmt_input_state.scanner_status = tolerant ? scanner_is_tolerant : scanner_is_matching;
+ /* */
+ do {
+ /*tex
+ So, can we use a local head here? After all, there is no expansion going on here,
+ so no need to access |temp_token_head|. On the other hand, it's also used as a
+ signal, so not now.
+ */
+ RESTART:
+ set_token_link(lmt_expand_state.match_token_head, null);
+ AGAIN:
+ spacer = 0;
+ LATER:
+ if (matchtoken < match_token || matchtoken >= end_match_token) {
+ s = null;
+ } else {
+ switch (matchtoken) {
+ case spacer_match_token:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ do {
+ tex_get_token();
+ } while (cur_cmd == spacer_cmd);
+ last = 1;
+ goto AGAIN;
+ case mandate_match_token:
+ match = match_mandate;
+ goto MANDATE;
+ case mandate_keep_match_token:
+ match = match_bracekeeper;
+ MANDATE:
+ if (last) {
+ last = 0;
+ } else {
+ tex_get_token();
+ last = 1;
+ }
+ if (cur_tok < left_brace_limit) {
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ s = matchpointer;
+ p = lmt_expand_state.match_token_head;
+ count = 0;
+ last = 0;
+ goto GROUPED;
+ } else {
+ if (tolerant) {
+ last = 0;
+ nofarguments = nofscanned;
+ tex_back_input(cur_tok);
+ goto QUITTING;
+ } else {
+ last = 0;
+ tex_back_input(cur_tok);
+ }
+ s = null;
+ goto BAD;
+ }
+ break;
+ case thrash_match_token:
+ match = 0;
+ thrash = 1;
+ break;
+ case leading_match_token:
+ match = match_spacekeeper;
+ break;
+ case prune_match_token:
+ match = match_pruner;
+ break;
+ case continue_match_token:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ goto AGAIN;
+ case quit_match_token:
+ match = match_quitter;
+ if (tolerant) {
+ last = 0;
+ nofarguments = nofscanned;
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ goto QUITTING;
+ } else {
+ break;
+ }
+ case par_spacer_match_token:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ do {
+ /* discard as we go */
+ tex_get_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == end_paragraph_cmd);
+ last = 1;
+ goto AGAIN;
+ case keep_spacer_match_token:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ do {
+ tex_get_token();
+ if (cur_cmd == spacer_cmd) {
+ spacer = 1;
+ } else {
+ break;
+ }
+ } while (1);
+ last = 1;
+ goto LATER;
+ case par_command_match_token:
+ /* this discards till the next par token */
+ do {
+ tex_get_token();
+ } while (cur_cmd != end_paragraph_cmd);
+ goto DELIMITER;
+ default:
+ match = matchtoken - match_token;
+ break;
+ }
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ s = matchpointer;
+ p = lmt_expand_state.match_token_head;
+ count = 0;
+ }
+ /*tex
+ Scan a parameter until its delimiter string has been found; or, if |s = null|,
+ simply scan the delimiter string. If |info(r)| is a |match| or |end_match|
+ command, it cannot be equal to any token found by |get_token|. Therefore an
+ undelimited parameter --- i.e., a |match| that is immediately followed by
+ |match| or |end_match| --- will always fail the test |cur_tok=info(r)| in the
+ following algorithm.
+ */
+ CONTINUE:
+ /*tex Set |cur_tok| to the next token of input. */
+ if (last) {
+ last = 0;
+ } else {
+ tex_get_token();
+ }
+ /* is token_cmd reliable here? */
+ if (! count && token_cmd(matchtoken) == ignore_cmd) {
+ if (cur_cmd < ignore_cmd || cur_cmd > other_char_cmd || cur_chr != token_chr(matchtoken)) {
+ /*tex We could optimize this but it doesn't pay off now. */
+ tex_back_input(cur_tok);
+ }
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ if (s) {
+ s = matchpointer;
+ }
+ goto AGAIN;
+ }
+ if (cur_tok == matchtoken) {
+ /*tex
+ When we end up here we have a match on a delimiter. Advance |r|; |goto found|
+ if the parameter delimiter has been fully matched, otherwise |goto continue|.
+ A slightly subtle point arises here: When the parameter delimiter ends with
+ |#|, the token list will have a left brace both before and after the
+ |end_match|. Only one of these should affect the |align_state|, but both will
+ be scanned, so we must make a correction.
+ */
+ DELIMITER:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ if (matchtoken >= match_token && matchtoken <= end_match_token) {
+ if (cur_tok < left_brace_limit) {
+ --lmt_input_state.align_state;
+ }
+ goto FOUND;
+ } else {
+ goto CONTINUE;
+ }
+ } else if (cur_cmd == ignore_something_cmd && cur_chr == ignore_argument_code) {
+ quitting = count ? 1 : count ? 2 : 3;
+ goto FOUND;
+ }
+ /*tex
+ Contribute the recently matched tokens to the current parameter, and |goto continue|
+ if a partial match is still in effect; but abort if |s = null|.
+
+ When the following code becomes active, we have matched tokens from |s| to the
+ predecessor of |r|, and we have found that |cur_tok <> info(r)|. An interesting
+ situation now presents itself: If the parameter is to be delimited by a string such
+ as |ab|, and if we have scanned |aa|, we want to contribute one |a| to the current
+ parameter and resume looking for a |b|. The program must account for such partial
+ matches and for others that can be quite complex. But most of the time we have
+ |s = r| and nothing needs to be done.
+
+ Incidentally, it is possible for |\par| tokens to sneak in to certain parameters of
+ non-|\long| macros. For example, consider a case like |\def\a#1\par!{...}| where
+ the first |\par| is not followed by an exclamation point. In such situations it
+ does not seem appropriate to prohibit the |\par|, so \TEX\ keeps quiet about this
+ bending of the rules.
+ */
+ if (s != matchpointer) {
+ BAD:
+ if (tolerant) {
+ quitting = nofscanned ? 1 : count ? 2 : 3;
+ tex_back_input(cur_tok);
+ // last = 0;
+ goto FOUND;
+ } else if (s) {
+ /*tex cycle pointer for backup recovery */
+ halfword t = s;
+ do {
+ halfword u, v;
+ if (match) {
+ p = tex_store_new_token(p, token_info(t));
+ }
+ ++count;
+ u = token_link(t);
+ v = s;
+ while (1) {
+ if (u == matchpointer) {
+ if (cur_tok != token_info(v)) {
+ break;
+ } else {
+ matchpointer = token_link(v);
+ matchtoken = token_info(matchpointer);
+ goto CONTINUE;
+ }
+ }
+ if (token_info(u) != token_info(v)) {
+ break;
+ } else {
+ u = token_link(u);
+ v = token_link(v);
+ }
+ }
+ t = token_link(t);
+ } while (t != matchpointer);
+ matchpointer = s;
+ matchtoken = token_info(matchpointer);
+ /*tex At this point, no tokens are recently matched. */
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Use of %S doesn't match its definition",
+ lmt_input_state.warning_index,
+ "If you say, e.g., '\\def\\a1{...}', then you must always put '1' after '\\a',\n"
+ "since control sequence names are made up of letters only. The macro here has not\n"
+ "been followed by the required stuff, so I'm ignoring it."
+ );
+ goto EXIT;
+ }
+ }
+ GROUPED:
+ if (cur_tok < left_brace_limit) {
+ /*tex Contribute an entire group to the current parameter. */
+ int unbalance = 0;
+ while (1) {
+ if (match) {
+ p = tex_store_new_token(p, cur_tok);
+ }
+ if (last) {
+ last = 0;
+ } else {
+ tex_get_token();
+ }
+ if (cur_tok < right_brace_limit) {
+ if (cur_tok < left_brace_limit) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ break;
+ }
+ }
+ }
+ rightbrace = p;
+ if (match) {
+ p = tex_store_new_token(p, cur_tok);
+ }
+ } else if (cur_tok < right_brace_limit) {
+ /*tex Report an extra right brace and |goto continue|. */
+ tex_back_input(cur_tok);
+ /* moved up: */
+ ++lmt_input_state.align_state;
+ tex_insert_paragraph_token();
+ /* till here */
+ tex_handle_error(
+ insert_error_type,
+ "Argument of %S has an extra }",
+ lmt_input_state.warning_index,
+ "I've run across a '}' that doesn't seem to match anything. For example,\n"
+ "'\\def\\a#1{...}' and '\\a}' would produce this error. The '\\par' that I've just\n"
+ "inserted will cause me to report a runaway argument that might be the root of the\n"
+ "problem." );
+ goto CONTINUE;
+ /*tex A white lie; the |\par| won't always trigger a runaway. */
+ } else {
+ /*tex
+ Store the current token, but |goto continue| if it is a blank space that would
+ become an undelimited parameter.
+ */
+ if (cur_tok == space_token && matchtoken <= end_match_token && matchtoken >= match_token && matchtoken != leading_match_token) {
+ goto CONTINUE;
+ }
+ if (match) {
+ p = tex_store_new_token(p, cur_tok);
+ }
+ }
+ ++count;
+ if (matchtoken > end_match_token || matchtoken < match_token) {
+ goto CONTINUE;
+ }
+ FOUND:
+ if (s) {
+ /*
+ Tidy up the parameter just scanned, and tuck it away. If the parameter consists
+ of a single group enclosed in braces, we must strip off the enclosing braces.
+ That's why |rightbrace| was introduced. Actually, in most cases |m == 1|.
+ */
+ if (! thrash) {
+ if (token_info(p) < right_brace_limit && count == 1 && p != lmt_expand_state.match_token_head && match != match_bracekeeper) {
+ set_token_link(rightbrace, null);
+ tex_put_available_token(p);
+ p = token_link(lmt_expand_state.match_token_head);
+ pstack[nofscanned] = token_link(p);
+ tex_put_available_token(p);
+ } else {
+ pstack[nofscanned] = token_link(lmt_expand_state.match_token_head);
+ }
+ if (match == match_pruner) {
+ pstack[nofscanned] = tex_aux_prune_list(pstack[nofscanned]);
+ }
+ ++nofscanned;
+ if (tracing) {
+ tex_begin_diagnostic();
+ tex_print_format("%c%i<-", match_visualizer, nofscanned);
+ tex_show_token_list(pstack[nofscanned - 1], null, default_token_show_max, 0);
+ tex_end_diagnostic();
+ }
+ } else {
+ thrash = 0;
+ }
+ }
+ /*tex
+ Now |info(r)| is a token whose command code is either |match| or |end_match|.
+ */
+ if (quitting) {
+ nofarguments = quitting == 3 ? 0 : quitting == 2 && count == 0 ? 0 : nofscanned;
+ QUITTING:
+ if (spacer) {
+ tex_back_input(space_token); /* experiment */
+ }
+ while (1) {
+ switch (matchtoken) {
+ case end_match_token:
+ goto QUITDONE;
+ case spacer_match_token:
+ case thrash_match_token:
+ case par_spacer_match_token:
+ case keep_spacer_match_token:
+ goto NEXTMATCH;
+ case mandate_match_token:
+ case leading_match_token:
+ pstack[nofscanned] = null;
+ break;
+ case mandate_keep_match_token:
+ p = tex_store_new_token(null, left_brace_token);
+ pstack[nofscanned] = p;
+ p = tex_store_new_token(p, right_brace_token);
+ break;
+ case continue_match_token:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ quitting = 0;
+ goto RESTART;
+ case quit_match_token:
+ if (quitting) {
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ quitting = 0;
+ goto RESTART;
+ } else {
+ goto NEXTMATCH;
+ }
+ default:
+ if (matchtoken >= match_token && matchtoken < end_match_token) {
+ pstack[nofscanned] = null;
+ break;
+ } else {
+ goto NEXTMATCH;
+ }
+ }
+ nofscanned++;
+ if (tracing) {
+ tex_begin_diagnostic();
+ tex_print_format("%c%i--", match_visualizer, nofscanned);
+ tex_end_diagnostic();
+ }
+ NEXTMATCH:
+ matchpointer = token_link(matchpointer);
+ matchtoken = token_info(matchpointer);
+ }
+ }
+ } while (matchtoken != end_match_token);
+ nofarguments = nofscanned;
+ QUITDONE:
+ matchpointer = token_link(matchpointer);
+ /*tex
+ Feed the macro body and its parameters to the scanner Before we put a new token list on the
+ input stack, it is wise to clean off all token lists that have recently been depleted. Then
+ a user macro that ends with a call to itself will not require unbounded stack space.
+ */
+ tex_cleanup_input_state();
+ /*tex
+ We don't really start a list, it's more housekeeping. The starting point is the body and
+ the later set |loc| reflects that.
+ */
+ tex_begin_macro_list(chr);
+ /*tex
+ Beware: here the |name| is used for symbolic locations but also for macro indices but these
+ are way above the symbolic |token_types| that we use. Better would be to have a dedicated
+ variable but let's not open up a can of worms now. We can't use |warning_index| combined
+ with a symbolic name either. We're at |end_match_token| now so we need to advance.
+ */
+ lmt_input_state.cur_input.name = cs;
+ lmt_input_state.cur_input.loc = matchpointer;
+ /*tex
+ This comes last, after the cleanup and the start of the macro list.
+ */
+ if (nofscanned) {
+ tex_copy_pstack_to_param_stack(&pstack[0], nofscanned);
+ }
+ EXIT:
+ lmt_expand_state.arguments = nofarguments;
+ lmt_input_state.scanner_status = save_scanner_status;
+ lmt_input_state.warning_index = save_warning_index;
+ } else {
+ tex_cleanup_input_state();
+ if (token_link(chr)) {
+ tex_begin_macro_list(chr);
+ lmt_expand_state.arguments = 0;
+ lmt_input_state.cur_input.name = lmt_input_state.warning_index;
+ lmt_input_state.cur_input.loc = token_link(chr);
+ } else {
+ /* We ignore empty bodies but it doesn't gain us that much. */
+ }
+ }
+}
diff --git a/source/luametatex/source/tex/texexpand.h b/source/luametatex/source/tex/texexpand.h
new file mode 100644
index 000000000..1db266b20
--- /dev/null
+++ b/source/luametatex/source/tex/texexpand.h
@@ -0,0 +1,35 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_EXPAND_H
+# define LMT_EXPAND_H
+
+typedef struct expand_state_info {
+ limits_data limits;
+ int depth;
+ int cs_name_level;
+ int arguments;
+ halfword match_token_head;
+ int padding;
+} expand_state_info ;
+
+extern expand_state_info lmt_expand_state ;
+
+/* we can also have a get_x_token_ignore_spaces */
+
+extern void tex_initialize_expansion (void);
+extern void tex_cleanup_expansion (void);
+
+extern halfword tex_expand_match_token_head (void);
+extern void tex_expand_current_token (void);
+extern halfword tex_get_x_token (void); /* very texie names */
+extern void tex_x_token (void); /* very texie names */
+extern void tex_insert_relax_and_cur_cs (void);
+
+extern halfword tex_create_csname (void);
+extern int tex_is_valid_csname (void);
+
+extern int tex_get_parameter_count (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texfileio.c b/source/luametatex/source/tex/texfileio.c
new file mode 100644
index 000000000..4f712401b
--- /dev/null
+++ b/source/luametatex/source/tex/texfileio.c
@@ -0,0 +1,939 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+fileio_state_info lmt_fileio_state = {
+ .io_buffer = NULL,
+ .io_buffer_data = {
+ .minimum = min_buffer_size,
+ .maximum = max_buffer_size,
+ .size = siz_buffer_size,
+ .step = stp_buffer_size,
+ .allocated = 0,
+ .itemsize = sizeof(unsigned char),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .io_first = 0,
+ .io_last = 0,
+ .name_in_progress = 0,
+ .log_opened = 0,
+ .job_name = NULL,
+ .log_name = NULL,
+ .fmt_name = NULL
+};
+
+/*tex
+
+ Once \TEX\ is working, you should be able to diagnose most errors with the |\show| commands and
+ other diagnostic features. Because we have made some internal changes the optional debug interface
+ has been removed.
+
+*/
+
+# define reserved_io_buffer_slots 256
+
+void tex_initialize_fileio_state(void)
+{
+ int size = lmt_fileio_state.io_buffer_data.minimum;
+ lmt_fileio_state.io_buffer = aux_allocate_clear_array(sizeof(unsigned char), size, reserved_io_buffer_slots);
+ if (lmt_fileio_state.io_buffer) {
+ lmt_fileio_state.io_buffer_data.allocated = size;
+ } else {
+ tex_overflow_error("buffer", size);
+ }
+}
+
+int tex_room_in_buffer(int top)
+{
+ /*tex Beware: |top| can exceed the old size plus the step. */
+ if (top > lmt_fileio_state.io_buffer_data.top) {
+ lmt_fileio_state.io_buffer_data.top = top;
+ if (top > lmt_fileio_state.io_buffer_data.allocated) {
+ unsigned char *tmp = NULL;
+ if (top <= lmt_fileio_state.io_buffer_data.size) {
+ if (lmt_fileio_state.io_buffer_data.allocated + lmt_fileio_state.io_buffer_data.step > top) {
+ top = lmt_fileio_state.io_buffer_data.allocated + lmt_fileio_state.io_buffer_data.step;
+ if (top > lmt_fileio_state.io_buffer_data.size) {
+ top = lmt_fileio_state.io_buffer_data.size;
+ }
+ }
+ if (top > lmt_fileio_state.io_buffer_data.allocated) {
+ lmt_fileio_state.io_buffer_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_fileio_state.io_buffer, sizeof(unsigned char), top, reserved_io_buffer_slots);
+ lmt_fileio_state.io_buffer = tmp;
+ }
+ }
+ lmt_run_memory_callback("buffer", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("buffer", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+static int tex_aux_open_outfile(FILE **f, const char *name, const char *mode)
+{
+ FILE *res = aux_utf8_fopen(name, mode);
+ if (res) {
+ *f = res;
+ return 1;
+ }
+ return 0;
+}
+
+/*tex
+
+ We conform to the way \WEBC\ does handle trailing tabs and spaces. This decade old behaviour
+ was changed in September 2017 and can introduce compatibility issues in existing workflows.
+ Because we don't want too many differences with upstream \TEX live we just follow up on that
+ patch and it's up to macro packages to deal with possible issues (which can be done via the
+ usual callbacks. One can wonder why we then still prune spaces but we leave that to the reader.
+
+ Patched original comment:
+
+ Make last be one past the last non-space character in \quote {buffer}, ignoring line
+ terminators (but not, e.g., tabs). This is because we are supposed to treat this like a line of
+ TeX input. Although there are pathological cases (|SP CR SC CR|) where this differs from
+ input_line below, and from previous behavior of removing all whitespace, the simplicity of
+ removing all trailing line terminators seems more in keeping with actual command line
+ processing.
+
+ The |IS_SPC_OR_EOL| macro deals with space characters (|SPACE 32|) and newlines (|CR| and |LF|)
+ and no longer looks at tabs (|TAB 9|).
+
+*/
+
+/*
+ The terminal input code is gone as is the read related code (that had already been nicely
+ cleaned up and abstracted but that is the price we pay for stepwise progress. That code is
+ still in the git repository of course.
+
+ At some point I might do the same as we do in mplib: four callbacks for open, close, read
+ and write (in which case the log goes via write). Part of the management is them moved to
+ \LUA\ and we save a lookup.
+
+ When I adapted the code in this module and the one dealing with errors, I decided to delegate
+ all interaction to \LUA, also because the sometimes tight integration in the scanning and
+ expansion mechanisms. In the 2021 TeX tuneup there have been some patches in the interaction
+ code and some remarks ring a bell: especially the relation between offering feedback and
+ waiting for input. However, because we delegate to \LUA, the engine is no longer responsible
+ for what the macro package lets the user do in case of an error. For instance, in \CONTEXT\ we
+ just abort the run: it makes no sense to carry on the wrong way. Computers are fast enough for
+ a \quotation {Fix and run again.} approach. But we do offer the message and optional help as
+ cue. On the agenda is a further abstraction of error handling. This deviation is fine as we
+ obey Don's wish to not call it \TEX\ but instead add some more letters to the name.
+
+*/
+
+int tex_lua_a_open_in(const char *fn)
+{
+ int callback_id = lmt_callback_defined(open_data_file_callback);
+ if (callback_id > 0) {
+ int k = lmt_run_and_save_callback(lmt_lua_state.lua_instance, callback_id, "S->", fn);
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].input_file_callback_id = k;
+ return k > 0;
+ } else {
+ tex_emergency_message("startup error", "missing open_data_file callback");
+ tex_emergency_exit();
+ return 0;
+ }
+}
+
+void tex_lua_a_close_in()
+{
+ int k = lmt_input_state.in_stack[lmt_input_state.cur_input.index].input_file_callback_id;
+ if (k > 0) {
+ lmt_run_saved_callback_close(lmt_lua_state.lua_instance, k);
+ lmt_destroy_saved_callback(lmt_lua_state.lua_instance, k);
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].input_file_callback_id = 0;
+ }
+}
+
+/*tex
+
+ Binary input and output are done with \CCODE's ordinary procedures, so we don't have to make
+ any other special arrangements for binary \IO. Text output is also easy to do with standard
+ routines. The treatment of text input is more difficult, however, because of the necessary
+ translation to |unsigned char| values. \TEX's conventions should be efficient, and they should
+ blend nicely with the user's operating environment.
+
+ Input from text files is read one line at a time, using a routine called |lua_input_ln|. This
+ function is defined in terms of global variables called |buffer|, |first|, and |last| that will
+ be described in detail later; for now, it suffices for us to know that |buffer| is an array of
+ |unsigned char| values, and that |first| and |last| are indices into this array representing
+ the beginning and ending of a line of text.
+
+ The lines of characters being read: |buffer|, the first unused position in |first|, the end of
+ the line just input |last|, the largest index used in |buffer|: |max_buf_stack|.
+
+ The |lua_input_ln| function brings the next line of input from the specified file into available
+ positions of the buffer array and returns the value |true|, unless the file has already been
+ entirely read, in which case it returns |false| and sets |last:=first|. In general, the
+ |unsigned char| numbers that represent the next line of the file are input into |buffer[first]|,
+ |buffer[first + 1]|, \dots, |buffer[last - 1]|; and the global variable |last| is set equal to
+ |first| plus the length of the line. Trailing blanks are removed from the line; thus, either
+ |last = first| (in which case the line was entirely blank) or |buffer[last - 1] <> " "|.
+
+ An overflow error is given, however, if the normal actions of |lua_input_ln| would make |last
+ >= buf_size|; this is done so that other parts of \TEX\ can safely look at the contents of
+ |buffer[last+1]| without overstepping the bounds of the |buffer| array. Upon entry to
+ |lua_input_ln|, the condition |first < buf_size| will always hold, so that there is always room
+ for an \quote {empty} line.
+
+ The variable |max_buf_stack|, which is used to keep track of how large the |buf_size| parameter
+ must be to accommodate the present job, is also kept up to date by |lua_input_ln|.
+
+ If the |bypass_eoln| parameter is |true|, |lua_input_ln| will do a |get| before looking at the
+ first character of the line; this skips over an |eoln| that was in |f^|. The procedure does not
+ do a |get| when it reaches the end of the line; therefore it can be used to acquire input from
+ the user's terminal as well as from ordinary text files.
+
+ Since the inner loop of |lua_input_ln| is part of \TEX's \quote {inner loop} --- each character
+ of input comes in at this place --- it is wise to reduce system overhead by making use of
+ special routines that read in an entire array of characters at once, if such routines are
+ available.
+
+*/
+
+int tex_lua_input_ln(void) /*tex |bypass_eoln| was not used */
+{
+ int callback_id = lmt_input_state.in_stack[lmt_input_state.cur_input.index].input_file_callback_id;
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int last_ptr = 0;
+ lmt_fileio_state.io_last = lmt_fileio_state.io_first;
+ last_ptr = lmt_run_saved_callback_line(L, callback_id, lmt_fileio_state.io_first);
+ if (last_ptr < 0) {
+ return 0;
+ } else if (last_ptr > 0) {
+ lmt_fileio_state.io_last = last_ptr;
+ if (last_ptr > lmt_fileio_state.io_buffer_data.top) {
+ lmt_fileio_state.io_buffer_data.top = last_ptr;
+ }
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ We need a special routine to read the first line of \TEX\ input from the user's terminal.
+ This line is different because it is read before we have opened the transcript file; there is
+ sort of a \quote {chicken and egg} problem here. If the user types |\input paper| on the first
+ line, or if some macro invoked by that line does such an |\input|, the transcript file will be
+ named |paper.log|; but if no |\input| commands are performed during the first line of terminal
+ input, the transcript file will acquire its default name |texput.log|. (The transcript file
+ will not contain error messages generated by the first line before the first |\input| command.)
+
+ The first line is special also because it may be read before \TEX\ has input a format file. In
+ such cases, normal error messages cannot yet be given. The following code uses concepts that
+ will be explained later.
+
+ Different systems have different ways to get started. But regardless of what conventions are
+ adopted, the routine that initializes the terminal should satisfy the following specifications:
+
+ \startitemize[n]
+
+ \startitem
+ It should open file |term_in| for input from the terminal.
+ \stopitem
+
+ \startitem
+ If the user has given a command line, this line should be considered the first line of
+ terminal input. Otherwise the user should be prompted with |**|, and the first line of
+ input should be whatever is typed in response.
+ \stopitem
+
+ \startitem
+ The first line of input, which might or might not be a command line, should appear in
+ locations |first| to |last-1| of the |buffer| array.
+ \stopitem
+
+ \startitem
+ The global variable |loc| should be set so that the character to be read next by \TEX\
+ is in |buffer[loc]|. This character should not be blank, and we should have |loc < last|.
+ \stopitem
+
+ \stopitemize
+
+ It may be necessary to prompt the user several times before a non-blank line comes in. The
+ prompt is |**| instead of the later |*| because the meaning is slightly different: |\input|
+ need not be typed immediately after |**|.)
+
+ The following code does the required initialization. If anything has been specified on the
+ command line, then |t_open_in| will return with |last > first|.
+
+ This code has been adapted and we no longer ask for a name. It makes no sense because one needs
+ to initialize the primitives and backend anyway and no one is going to do that interactively.
+ Of course one can implement a session in \LUA. We keep the \TEX\ trick to push the name into
+ the input buffer and then exercise an |\input| which ensures proper housekeeping. There is a
+ bit overkill in the next function but for now we keep it (as reference).
+
+ For a while copying the argument to th ebuffer lived in the engine lib but it made no sense
+ to duplicate code, so now it's here. Anyway, the following does no longer apply:
+
+ \startquotation
+ This is supposed to open the terminal for input, but what we really do is copy command line
+ arguments into \TEX's buffer, so it can handle them. If nothing is available, or we've been
+ called already (and hence, |argc == 0|), we return with |last = first|.
+ \stopquotation
+
+ In \LUAMETATEX\ we don't really have a terminal. In the \LUATEX\ precursor we used to append
+ all the remaining arguments but now we just take the first one. If one wants filenames with
+ spaces \unknown\ use quotes. Keep in mind that original \TEX\ permits this:
+
+ \starttyping
+ tex ... filename \\hbox{!} \\end
+ \stoptyping
+
+ But we don't follow that route in the situation where \LUA\ is mostly in charge of passing
+ input from files and the console.
+
+ In the end I went for an easier solution: just pass the name to the file reader. But we keep
+ this as nostalgic reference to how \TEX\ originally kin dof did these things.
+
+ \starttyping
+ int input_file_name_pushed(void)
+ {
+ const char *ptr = engine_input_filename();
+ if (ptr) {
+ int len = strlen(ptr);
+ fileio_state.io_buffer[fileio_state.io_first] = 0;
+ if (len > 0 && room_in_buffer(len + 1)) {
+ // We cannot use strcat, because we have multibyte UTF-8 input. Hm, why not.
+ fileio_state.io_last= fileio_state.io_first;
+ while (*ptr) {
+ fileio_state.io_buffer[fileio_state.io_last++] = (unsigned char) * (ptr++);
+ }
+ // Backtrack over spaces and newlines.
+ for (
+ --fileio_state.io_last;
+ fileio_state.io_last >= fileio_state.io_first && IS_SPC_OR_EOL(fileio_state.io_buffer[fileio_state.io_last]);
+ --fileio_state.io_last
+ );
+ // Terminate the string.
+ fileio_state.io_buffer[++fileio_state.io_last] = 0;
+ // One more time, this time converting to \TEX's internal character representation.
+ if (fileio_state.io_last > fileio_state.io_first) {
+ input_state.cur_input.loc = fileio_state.io_first;
+ while ((input_state.cur_input.loc < fileio_state.io_last) && (fileio_state.io_buffer[input_state.cur_input.loc] == ' ')) {
+ ++input_state.cur_input.loc;
+ }
+ if (input_state.cur_input.loc < fileio_state.io_last) {
+ input_state.cur_input.limit = fileio_state.io_last;
+ fileio_state.io_first = fileio_state.io_last + 1;
+ }
+ if (input_state.cur_input.loc < input_state.cur_input.limit) {
+ return 1;
+ }
+ }
+ }
+ }
+ fileio_state.io_first = 1;
+ fileio_state.io_last = 1;
+ return 0;
+ }
+ \stopttyping
+
+ It's this kind of magic that can take lots of time to play with and figure out, also because
+ we cannot break expectations too much.
+
+*/
+
+/*tex
+
+ Per June 22 2020 the terminal code is gone. See |texlegacy.c| for the old, already adapted
+ long ago, code. It was already shedulded for removal a while. We only keep the update.
+
+*/
+
+void tex_terminal_update(void) /* renamed, else conflict in |lmplib|. */
+{
+ fflush(stdout);
+}
+
+/*tex
+
+ It's time now to fret about file names. Besides the fact that different operating systems treat
+ files in different ways, we must cope with the fact that completely different naming conventions
+ are used by different groups of people. The following programs show what is required for one
+ particular operating system; similar routines for other systems are not difficult to devise.
+
+ \TEX\ assumes that a file name has three parts: the name proper; its \quote {extension}; and a
+ \quote {file area} where it is found in an external file system. The extension of an input file
+ or a write file is assumed to be |.tex| unless otherwise specified; it is |transcript_extension|
+ on the transcript file that records each run of \TEX; it is |.tfm| on the font metric files that
+ describe characters in the fonts \TEX\ uses; it is |.dvi| on the output files that specify
+ typesetting information; and it is |format_extension| on the format files written by \INITEX\
+ to initialize \TEX. The file area can be arbitrary on input files, but files are usually output
+ to the user's current area.
+
+ Simple uses of \TEX\ refer only to file names that have no explicit extension or area. For
+ example, a person usually says |\input paper| or |\font \tenrm = helvetica| instead of |\input
+ {paper.new}| or |\font \tenrm = {test}|. Simple file names are best, because they make the \TEX\
+ source files portable; whenever a file name consists entirely of letters and digits, it should be
+ treated in the same way by all implementations of \TEX. However, users need the ability to refer
+ to other files in their environment, especially when responding to error messages concerning
+ unopenable files; therefore we want to let them use the syntax that appears in their favorite
+ operating system.
+
+ The following procedures don't allow spaces to be part of file names; but some users seem to like
+ names that are spaced-out. System-dependent changes to allow such things should probably be made
+ with reluctance, and only when an entire file name that includes spaces is \quote {quoted} somehow.
+
+ Here are the global values that file names will be scanned into.
+
+ \starttyping
+ strnumber cur_name;
+ strnumber cur_area;
+ strnumber cur_ext;
+ \stoptyping
+
+ The file names we shall deal with have the following structure: If the name contains |/| or |:|
+ (for Amiga only), the file area consists of all characters up to and including the final such
+ character; otherwise the file area is null. If the remaining file name contains |.|, the file
+ extension consists of all such characters from the last |.| to the end, otherwise the file
+ extension is null.
+
+ We can scan such file names easily by using two global variables that keep track of the
+ occurrences of area and extension delimiters:
+
+ Input files that can't be found in the user's area may appear in a standard system area called
+ |TEX_area|. Font metric files whose areas are not given explicitly are assumed to appear in a
+ standard system area called |TEX_font_area|. These system area names will, of course, vary from
+ place to place.
+
+ This whole model has been adapted a little but we do keep the |area|, |name|, |ext| distinction
+ for now although we don't use the string pool.
+
+*/
+
+static char *tex_aux_pack_file_name(char *s, int l, const char *name, const char *ext)
+{
+ const char *fn = (char *) s;
+ if ((! fn) || (l <= 0)) {
+ fn = name;
+ }
+ if (! fn) {
+ return NULL;
+ } else if (! ext) {
+ return lmt_memory_strdup(fn);
+ } else {
+ int e = -1;
+ for (int i = 0; i < l; i++) {
+ if (IS_DIR_SEP(fn[i])) {
+ e = -1;
+ } else if (fn[i] == '.') {
+ e = i;
+ }
+ }
+ if (e >= 0) {
+ return lmt_memory_strdup(fn);
+ } else {
+ char *f = lmt_memory_malloc(strlen(fn) + strlen(ext) + 1);
+ if (f) {
+ sprintf(f, "%s%s", fn, ext);
+ }
+ return f;
+ }
+ }
+}
+
+/*tex
+
+ Here is a routine that manufactures the output file names, assuming that |job_name <> 0|. It
+ ignores and changes the current settings of |cur_area| and |cur_ext|; |s = transcript_extension|,
+ |".dvi"|, or |format_extension|
+
+ The packer does split the basename every time but isn't called that often so we can use it in
+ the checker too.
+
+*/
+
+static char *tex_aux_pack_job_name(const char *e, int keeppath, int keepsuffix)
+{
+ char *n = lmt_fileio_state.job_name;
+ int ln = (n) ? (int) strlen(n) : 0;
+ if (! ln) {
+ tex_fatal_error("bad jobname");
+ return NULL;
+ } else {
+ int le = (e) ? (int) strlen(e) : 0;
+ int f = -1; /* first */
+ int l = -1; /* last */
+ char *fn = NULL;
+ int k = 0;
+ for (int i = 0; i < ln; i++) {
+ if (IS_DIR_SEP(n[i])) {
+ f = i;
+ l = -1;
+ } else if (n[i] == '.') {
+ l = i;
+ }
+ }
+ if (keeppath) {
+ f = 0;
+ } else if (f < 0) {
+ f = 0;
+ } else {
+ f += 1;
+ }
+ if (keepsuffix || l < 0) {
+ l = ln;
+ }
+ fn = (char*) lmt_memory_malloc((l - f) + le + 2); /* a bit too much */
+ if (fn) {
+ for (int i = f; i < l; i++) {
+ fn[k++] = n[i];
+ }
+ for (int i = 0; i < le; i++) {
+ fn[k++] = e[i];
+ }
+ fn[k] = 0;
+ }
+ return fn;
+ }
+}
+
+/*tex
+
+ The following comment is obsolete but we keep it as reference because it tells some history.
+
+ \startquotation
+ Because the format is zipped we read and write dump files through zlib. Earlier versions recast
+ |*f| from |FILE *| to |gzFile|, but there is no guarantee that these have the same size, so a
+ static variable is needed.
+
+ We no longer do byte-swapping so formats are generated for the system and not shared. It
+ actually slowed down loading of the format on the majority of used platforms (intel).
+
+ A \CONTEXT\ format is uncompressed some 16 MB but that used to be over 30MB due to more
+ (preallocated) memory usage. A compressed format is 11 MB so the saving is not that much. If
+ we were in lua I'd load the whole file in one go and use a fast decompression after which we
+ could access the bytes in memory. But it's not worth the trouble.
+
+ Tests has shown that a level 3 compression is the most optimal tradeoff between file size and
+ load time.
+
+ So, in principle we can undefine |FMT_COMPRESSION| below and experiment a bit with it. With
+ SSD's it makes no dent, but on a network it still might.
+
+ Per end May 2019 the |FMT_COMPRESSION| branch is gone so that we can simplify the opener and
+ closer.
+ \stopquotation
+
+*/
+
+void tex_check_fmt_name(void)
+{
+ if (lmt_engine_state.dump_name) {
+ char *tmp = lmt_fileio_state.job_name;
+ lmt_fileio_state.job_name = lmt_engine_state.dump_name;
+ lmt_fileio_state.fmt_name = tex_aux_pack_job_name(format_extension, 1, 0);
+ lmt_fileio_state.job_name = tmp;
+ } else if (lmt_main_state.run_state != initializing_state) {
+ /*tex For |dump_name| to be NULL is a bug. */
+ tex_emergency_message("startup error", "no format file given, quitting");
+ tex_emergency_exit();
+ }
+}
+
+void tex_check_job_name(char * fn)
+{
+ if (! lmt_fileio_state.job_name) {
+ if (lmt_engine_state.startup_jobname) {
+ lmt_fileio_state.job_name = lmt_engine_state.startup_jobname; /* not freed here */
+ lmt_fileio_state.job_name = tex_aux_pack_job_name(NULL, 0, 0);
+ } else if (fn) {
+ lmt_fileio_state.job_name = fn;
+ lmt_fileio_state.job_name = tex_aux_pack_job_name(NULL, 0, 0); /* not freed here */
+ } else {
+ tex_emergency_message("startup warning", "using fallback jobname 'texput', continuing");
+ lmt_fileio_state.job_name = lmt_memory_strdup("texput");
+ }
+ }
+ if (! lmt_fileio_state.log_name) {
+ lmt_fileio_state.log_name = tex_aux_pack_job_name(transcript_extension, 0, 1);
+ }
+ if (! lmt_fileio_state.fmt_name) {
+ lmt_fileio_state.fmt_name = tex_aux_pack_job_name(format_extension, 0, 1);
+ }
+}
+
+/*tex
+
+ A messier routine is also needed, since format file names must be scanned before \TEX's
+ string mechanism has been initialized. We shall use the global variable |TEX_format_default|
+ to supply the text for default system areas and extensions related to format files.
+
+ Under \UNIX\ we don't give the area part, instead depending on the path searching that will
+ happen during file opening. Also, the length will be set in the main program.
+
+ \starttyping
+ char *TEX_format_default;
+ \stoptyping
+
+ This part of the program becomes active when a \quote {virgin} \TEX\ is trying to get going,
+ just after the preliminary initialization, or when the user is substituting another format file
+ by typing |&| after the initial |**| prompt. The buffer contains the first line of input in
+ |buffer[loc .. (last - 1)]|, where |loc < last| and |buffer[loc] <> " "|.
+
+*/
+
+dumpstream tex_open_fmt_file(int writemode)
+{
+ dumpstream f = NULL;
+ if (! lmt_fileio_state.fmt_name) {
+ /* this can't happen */
+ tex_emergency_message("startup error", "no format output file '%s' given, quitting", emergency_fmt_name);
+ tex_emergency_exit();
+ } else if (writemode) {
+ f = aux_utf8_fopen(lmt_fileio_state.fmt_name, FOPEN_WBIN_MODE);
+ if (! f) {
+ tex_emergency_message("startup error", "invalid format output file '%s' given, quitting", lmt_fileio_state.fmt_name);
+ tex_emergency_exit();
+ }
+ } else {
+ int callbackid = lmt_callback_defined(find_format_file_callback);
+ if (callbackid > 0) {
+ char *fnam = NULL;
+ int test = lmt_run_callback(lmt_lua_state.lua_instance, callbackid, "S->R", lmt_fileio_state.fmt_name, &fnam);
+ if (test && fnam && strlen(fnam) > 0) {
+ lmt_memory_free(lmt_fileio_state.fmt_name);
+ lmt_fileio_state.fmt_name = fnam;
+ } else {
+ lmt_memory_free(fnam);
+ }
+ f = aux_utf8_fopen(lmt_fileio_state.fmt_name, FOPEN_RBIN_MODE);
+ if (! f) {
+ tex_emergency_message("startup error", "invalid format input file '%s' given, quitting", emergency_fmt_name);
+ tex_emergency_exit();
+ }
+ } else {
+ /*tex For the moment we make this mandate! */
+ tex_emergency_message("startup error", "missing find_format_file callback");
+ tex_emergency_exit();
+ }
+ }
+ return f;
+}
+
+void tex_close_fmt_file(dumpstream f)
+{
+ if (f) {
+ fclose(f);
+ }
+}
+
+/*tex
+
+ The variable |name_in_progress| is used to prevent recursive use of |scan_file_name|, since the
+ |begin_name| and other procedures communicate via global variables. Recursion would arise only
+ by devious tricks like |\input \input f|; such attempts at sabotage must be thwarted.
+ Furthermore, |name_in_progress| prevents |\input| from being initiated when a font size
+ specification is being scanned.
+
+ Another variable, |job_name|, contains the file name that was first |\input| by the user. This
+ name is extended by |transcript_extension| and |.dvi| and |format_extension| in the names of
+ \TEX's output files. The fact if the transcript file been opened is registered in
+ |log_opened_global|.
+
+ Initially |job_name = 0|; it becomes nonzero as soon as the true name is known. We have
+ |job_name = 0| if and only if the |log| file has not been opened, except of course for a short
+ time just after |job_name| has become nonzero.
+
+ The full name of the log file is stored in |log_name|. The |open_log_file| routine is used to
+ open the transcript file and to help it catch up to what has previously been printed on the
+ terminal.
+
+*/
+
+void tex_open_log_file(void)
+{
+ if (! lmt_fileio_state.log_opened) {
+ int callback_id = lmt_callback_defined(find_log_file_callback);
+ if (callback_id > 0) {
+ char *filename = NULL;
+ int okay = 0;
+ tex_check_job_name(NULL);
+ okay = lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "S->R", lmt_fileio_state.log_name, &filename);
+ if (okay && filename && (strlen(filename) > 0)) {
+ lmt_memory_free(lmt_fileio_state.log_name);
+ lmt_fileio_state.log_name = filename;
+ } else {
+ lmt_memory_free(filename);
+ }
+ } else {
+ /*tex For the moment we make this mandate! */
+ tex_emergency_message("startup error", "missing find_log_file callback");
+ tex_emergency_exit();
+ }
+ if (tex_aux_open_outfile(&lmt_print_state.logfile, lmt_fileio_state.log_name, FOPEN_W_MODE)) {
+ /*tex The previous |selector| setting is saved:*/
+ int saved_selector = lmt_print_state.selector;
+ lmt_print_state.selector = logfile_selector_code;
+ lmt_fileio_state.log_opened = 1;
+ /*tex Again we resolve a callback id: */
+ callback_id = lmt_callback_defined(start_run_callback);
+ /*tex There is no need to free |fn|! */
+ if (callback_id == 0) {
+ tex_print_banner();
+ /*tex Print the banner line, including current date and time. */
+ tex_print_log_banner();
+ /*tex Make sure bottom level is in memory. */
+ lmt_input_state.input_stack[lmt_input_state.input_stack_data.ptr] = lmt_input_state.cur_input;
+ /*tex We don't have a first line so that code is gone. */
+ tex_print_ln();
+ } else if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ } else {
+ tex_print_banner();
+ }
+ /*tex should be done always */
+ if (lmt_print_state.loggable_info) {
+ fprintf(lmt_print_state.logfile, "%s\n", lmt_print_state.loggable_info);
+ lmt_memory_free(lmt_print_state.loggable_info);
+ lmt_print_state.loggable_info = NULL;
+ }
+ switch (saved_selector) {
+ case no_print_selector_code : lmt_print_state.selector = logfile_selector_code; break;
+ case terminal_selector_code : lmt_print_state.selector = terminal_and_logfile_selector_code; break;
+ default : lmt_print_state.selector = saved_selector; break;
+ }
+ } else {
+ tex_emergency_message("startup error", "log file '%s' cannot be opened, quitting", emergency_log_name);
+ tex_emergency_exit();
+ }
+ }
+}
+
+void tex_close_log_file(void)
+{
+ fclose(lmt_print_state.logfile);
+ lmt_fileio_state.log_opened = 0;
+}
+
+/*tex
+
+ Let's turn now to the procedure that is used to initiate file reading when an |\input| command
+ is being processed. This function is used with |\\input| as well as in the start up.
+
+*/
+
+void tex_start_input(char *fn)
+{
+ /*tex Set up |cur_file| and new level of input. */
+ tex_begin_file_reading();
+ if (! tex_lua_a_open_in(fn)) {
+ /*tex
+ Normally this is catched earler, as we have lookup callbacks but the first file, the
+ one passed on the command line can fall though this checking.
+ */
+ tex_end_file_reading();
+ tex_emergency_message("runtime error", "input file '%s' is not found, quitting", fn);
+ tex_emergency_exit();
+ }
+ lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].full_source_filename = fn;
+ lmt_input_state.cur_input.name = io_file_input_code;
+ /*tex
+ |open_log_file| doesn't |show_context|, so |limit| and |loc| needn't be set to meaningful
+ values yet.
+ */
+ tex_report_start_file((unsigned char *) fn);
+ ++lmt_input_state.open_files;
+ tex_terminal_update();
+ lmt_input_state.cur_input.state = new_line_state;
+ /*tex
+
+ Read the first line of the new file. Here we have to remember to tell the |lua_input_ln|
+ routine not to start with a |get|. If the file is empty, it is considered to contain a
+ single blank line.
+
+ */
+ lmt_input_state.input_line = 1;
+ tex_lua_input_ln();
+ lmt_input_state.cur_input.limit = lmt_fileio_state.io_last; /*tex Was |firm_up_the_line();|. */
+ if (end_line_char_inactive) {
+ --lmt_input_state.cur_input.limit;
+ } else {
+ lmt_fileio_state.io_buffer[lmt_input_state.cur_input.limit] = (unsigned char) end_line_char_par;
+ }
+ lmt_fileio_state.io_first = lmt_input_state.cur_input.limit + 1;
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.start;
+}
+
+/*tex
+
+ In order to isolate the system-dependent aspects of file names, the system-independent parts of
+ \TEX\ are expressed in terms of three system-dependent procedures called |begin_name|,
+ |more_name|, and |end_name|. In essence, if the user-specified characters of the file name are
+ |c_1|\unknown|c_n|, the system-independent driver program does the operations
+
+ \starttyping
+ |begin_name|;
+ |more_name|(c_1);
+ .....
+ |more_name|(c_n);
+ |end_name|
+ \stoptyping
+
+ These three procedures communicate with each other via global variables. Afterwards the file
+ name will appear in the string pool as three strings called |cur_name|, |cur_area|, and
+ |cur_ext|; the latter two are null (i.e., |""|), unless they were explicitly specified by the
+ user.
+
+ Actually the situation is slightly more complicated, because \TEX\ needs to know when the file
+ name ends. The |more_name| routine is a function (with side effects) that returns |true| on the
+ calls |more_name (c_1)|, \dots, |more_name (c_{n - 1})|. The final call |more_name(c_n)| returns
+ |false|; or, it returns |true| and the token following |c_n| is something like |\hbox| (i.e.,
+ not a character). In other words, |more_name| is supposed to return |true| unless it is sure that
+ the file name has been completely scanned; and |end_name| is supposed to be able to finish the
+ assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of whether |more_name (c_n)|
+ returned |true| or |false|.
+
+ This code has been adapted and the string pool is no longer used. We also don't ask for another
+ name on the console.
+
+*/
+
+/*tex
+
+ And here's the second. The string pool might change as the file name is being scanned, since a
+ new |\csname| might be entered; therefore we keep |area_delimiter| and |ext_delimiter| relative
+ to the beginning of the current string, instead of assigning an absolute address like |pool_ptr|
+ to them.
+
+ Now let's consider the \quote {driver} routines by which \TEX\ deals with file names in a
+ system-independent manner. First comes a procedure that looks for a file name in the input by
+ calling |get_x_token| for the information.
+
+*/
+
+char *tex_read_file_name(int optionalequal, const char * name, const char* ext)
+{
+ char *fn = NULL;
+ int l = 0;
+ char *s = NULL;
+ halfword result;
+ if (optionalequal) {
+ tex_scan_optional_equals();
+ }
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ if (cur_cmd == left_brace_cmd) {
+ result = tex_scan_toks_expand(1, NULL, 0);
+ } else {
+ int quote = 0;
+ halfword p = get_reference_token();
+ result = p;
+ while (1) {
+ switch (cur_cmd) {
+ case escape_cmd:
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case alignment_tab_cmd:
+ case parameter_cmd:
+ case superscript_cmd:
+ case subscript_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ if (cur_chr == '"') {
+ if (quote) {
+ goto DONE;
+ } else {
+ quote = 1;
+ }
+ } else {
+ p = tex_store_new_token(p, cur_tok);
+ }
+ break;
+ case spacer_cmd:
+ case end_line_cmd:
+ if (quote) {
+ p = tex_store_new_token(p, token_val(spacer_cmd, ' '));
+ } else {
+ goto DONE;
+ }
+ case ignore_cmd:
+ break;
+ default:
+ tex_back_input(cur_tok);
+ goto DONE;
+ }
+ tex_get_x_token();
+ }
+ }
+ DONE:
+ s = tex_tokenlist_to_tstring(result, 1, &l, 0, 0, 0);
+ fn = s ? tex_aux_pack_file_name(s, l, name, ext) : NULL;
+ /*tex Shouldn't we also free |result| ? */
+ tex_flush_token_list(result);
+ return fn;
+}
+
+void tex_print_file_name(unsigned char *name)
+{
+ int must_quote = 0;
+ if (name) {
+ unsigned char *j = name;
+ while (*j) {
+ if (*j == ' ') {
+ must_quote = 1;
+ break;
+ } else {
+ j++;
+ }
+ }
+ }
+ if (must_quote) {
+ /* initial quote */
+ tex_print_char('"');
+ }
+ if (name) {
+ unsigned char *j = name;
+ while (*j) {
+ if (*j == '"') {
+ /* skip embedded quote, maybe escape */
+ } else {
+ tex_print_char(*j);
+ }
+ j++;
+ }
+ }
+ if (must_quote) {
+ /* final quote */
+ tex_print_char('"');
+ }
+}
+
+void tex_report_start_file(unsigned char *name)
+{
+ int callback_id = lmt_callback_defined(start_file_callback);
+ if (callback_id) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "S->", name);
+ } else {
+ tex_print_char('(');
+ tex_print_file_name((unsigned char *) name);
+ }
+}
+
+void tex_report_stop_file(void)
+{
+ int callback_id = lmt_callback_defined(stop_file_callback);
+ if (callback_id) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "->");
+ } else {
+ tex_print_char(')');
+ }
+}
diff --git a/source/luametatex/source/tex/texfileio.h b/source/luametatex/source/tex/texfileio.h
new file mode 100644
index 000000000..1f7005342
--- /dev/null
+++ b/source/luametatex/source/tex/texfileio.h
@@ -0,0 +1,81 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXFILEIO_H
+# define LMT_TEXFILEIO_H
+
+# include "textypes.h"
+
+# define FOPEN_R_MODE "r"
+# define FOPEN_W_MODE "wb"
+# define FOPEN_RBIN_MODE "rb"
+# define FOPEN_WBIN_MODE "wb"
+
+# define IS_SPC_OR_EOL(c) ((c) == ' ' || (c) == '\r' || (c) == '\n')
+
+extern void tex_initialize_fileio_state (void);
+extern int tex_room_in_buffer (int top);
+extern int tex_lua_a_open_in (const char *fn);
+extern void tex_lua_a_close_in (void);
+extern int tex_lua_input_ln (void);
+
+/*tex
+
+ The user's terminal acts essentially like other files of text, except that it is used both for
+ input and for output. In traditional \TEX, when the terminal is considered an input file, the
+ file variable is called |term_in|, and when it is considered an output file the file variable
+ is |term_out|.
+
+ However, in \LUATEX\ in addition to files we also have pseudo files (something \ETEX) and input
+ coming from \LUA, which makes for a much more complex system. In \LUAMETATEX\ the model has
+ been stepwise simplified: pseudo files are gone and use a mechanism simular to \LUA\ input, and
+ the terminal is left up to the (anyway kind of mandate) file related callbacks, with read file
+ id zero still being the console. Output to the console is part of a model that intercepts output
+ to the log file and/or the console and can delegate handling to callbacks as well.
+
+ So, in the end, the terminal code in \LUAMETATEX\ is gone as all goes through \LUA, which also
+ means that |terminal_update|, |clear_terminal| and |wake_up_terminal| are no longer needed.
+
+ It is important to notice that reading from files is split into two: the files explicitly opened
+ with |\openin| are managed independent from the files opened with |\input|. The first category
+ is not part of input file nesting management.
+
+*/
+
+# define format_extension ".fmt"
+# define transcript_extension ".log"
+# define texinput_extension ".tex"
+
+typedef struct fileio_state_info {
+ unsigned char *io_buffer; /*tex lines of characters being read */
+ memory_data io_buffer_data;
+ int io_first; /*tex the first unused position in |buffer| */
+ int io_last; /*tex end of the line just input to |buffer| */
+ int name_in_progress; /*tex Is a file name being scanned? */
+ int log_opened; /*tex the transcript file has been opened */
+ char *job_name; /*tex the principal file name */
+ char *log_name; /*tex full name of the log file */
+ char *fmt_name;
+} fileio_state_info ;
+
+extern fileio_state_info lmt_fileio_state;
+
+# define emergency_job_name (lmt_fileio_state.job_name ? lmt_fileio_state.job_name : "unknown job name")
+# define emergency_log_name (lmt_fileio_state.log_name ? lmt_fileio_state.log_name : "unknown log name")
+# define emergency_fmt_name (lmt_fileio_state.fmt_name ? lmt_fileio_state.fmt_name : "unknown fmt name")
+
+extern void tex_terminal_update (void);
+extern void tex_open_log_file (void);
+extern void tex_close_log_file (void);
+extern void tex_start_input (char *fn);
+extern void tex_check_fmt_name (void);
+extern void tex_check_job_name (char *fn);
+extern dumpstream tex_open_fmt_file (int writemode);
+extern void tex_close_fmt_file (dumpstream f);
+extern char *tex_read_file_name (int optionalequal, const char * name, const char* ext);
+extern void tex_print_file_name (unsigned char *name);
+extern void tex_report_start_file (unsigned char *name);
+extern void tex_report_stop_file (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texfont.c b/source/luametatex/source/tex/texfont.c
new file mode 100644
index 000000000..dd63044ec
--- /dev/null
+++ b/source/luametatex/source/tex/texfont.c
@@ -0,0 +1,2062 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ Here is the main font API implementation for the original pascal parts. Stuff to watch out for:
+
+ \startitemize
+
+ \startitem
+ Knuth had a |null_character| that was used when a character could not be found by the
+ |fetch()| routine, to signal an error. This has been deleted, but it may mean that the
+ output of luatex is incompatible with TeX after |fetch()| has detected an error
+ condition.
+ \stopitem
+
+ \startitem
+ Knuth also had a |font_glue()| optimization. This has been removed because it was a bit
+ of dirty programming and it also was problematic |if 0 != null|.
+ \stopitem
+
+ \stopitemize
+
+*/
+
+# include "luametatex.h"
+
+# define proper_char_index(f, c) (c >= font_first_character(f) && c <= font_last_character(f))
+
+inline static scaled tex_aux_font_x_scaled(scaled v)
+{
+ return v ? scaledround(0.000001 * (glyph_scale_par ? glyph_scale_par : 1000) * (glyph_x_scale_par ? glyph_x_scale_par : 1000) * v) : 0;
+}
+
+inline static scaled tex_aux_font_y_scaled(scaled v)
+{
+ return v ? scaledround(0.000001 * (glyph_scale_par ? glyph_scale_par : 1000) * (glyph_y_scale_par ? glyph_y_scale_par : 1000) * v) : 0;
+}
+
+inline static scaled tex_aux_glyph_x_scaled(halfword g, scaled v)
+{
+ return v ? scaledround(0.000001 * (glyph_scale(g) ? glyph_scale(g) : 1000) * (glyph_x_scale(g) ? glyph_x_scale(g) : 1000) * v) : 0;
+}
+
+inline static scaled tex_aux_glyph_y_scaled(halfword g, scaled v)
+{
+ return v ? scaledround(0.000001 * (glyph_scale(g) ? glyph_scale(g) : 1000) * (glyph_y_scale(g) ? glyph_y_scale(g) : 1000) * v) : 0;
+}
+
+font_state_info lmt_font_state = {
+ .fonts = NULL,
+ .adjust_stretch = 0,
+ .adjust_shrink = 0,
+ .adjust_step = 0,
+ .padding = 0,
+ .font_data = {
+ .minimum = min_font_size,
+ .maximum = max_font_size,
+ .size = memory_data_unset,
+ .step = stp_font_size,
+ .allocated = 0,
+ .itemsize = 1,
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+};
+
+/*tex
+ There can be holes in the font id range. And \unknown\ nullfont is special! Contrary
+ to other places, here we don't reallocate an array of records but one of pointers.
+*/
+
+void tex_initialize_fonts(void)
+{
+ texfont **tmp = aux_allocate_clear_array(sizeof(texfont *), lmt_font_state.font_data.minimum, 0);
+ if (tmp) {
+ for (int i = 0; i < lmt_font_state.font_data.minimum; i++) {
+ tmp[i] = NULL;
+ }
+ lmt_font_state.fonts = tmp;
+ lmt_font_state.font_data.allocated += lmt_font_state.font_data.minimum * sizeof(texfont *);
+ lmt_font_state.font_data.top = lmt_font_state.font_data.minimum;
+ lmt_font_state.font_data.ptr = -1; /* we need to end up with id zero first */
+ tex_create_null_font();
+ } else {
+ tex_overflow_error("fonts", lmt_font_state.font_data.minimum);
+ }
+}
+
+/*tex If a slot is not used .. so be it. We want sequential numbers. */
+
+int tex_new_font_id(void)
+{
+ if (lmt_font_state.font_data.ptr < lmt_font_state.font_data.top) {
+ ++lmt_font_state.font_data.ptr;
+ return lmt_font_state.font_data.ptr;
+ } else if (lmt_font_state.font_data.top < lmt_font_state.font_data.maximum) {
+ texfont **tmp ;
+ int top = lmt_font_state.font_data.top + lmt_font_state.font_data.step;
+ if (top > lmt_font_state.font_data.maximum) {
+ top = lmt_font_state.font_data.maximum;
+ }
+ tmp = aux_reallocate_array(lmt_font_state.fonts, sizeof(texfont *), top, 0);
+ if (tmp) {
+ for (int i = lmt_font_state.font_data.top + 1; i < top; i++) {
+ tmp[i] = NULL;
+ }
+ lmt_font_state.fonts = tmp;
+ lmt_font_state.font_data.allocated += ((size_t) top - lmt_font_state.font_data.top) * sizeof(texfont *);
+ lmt_font_state.font_data.top = top;
+ lmt_font_state.font_data.ptr += 1;
+ return lmt_font_state.font_data.ptr;
+ }
+ }
+ tex_overflow_error("fonts", lmt_font_state.font_data.maximum);
+ return 0;
+}
+
+int tex_get_font_max_id(void)
+{
+ return lmt_font_state.font_data.ptr;
+}
+
+void tex_dump_font_data(dumpstream f) {
+ dump_int(f, lmt_font_state.font_data.ptr);
+}
+
+void tex_undump_font_data(dumpstream f) {
+ int x;
+ undump_int(f, x);
+ lmt_font_state.font_data.ptr = 0;
+}
+
+void tex_set_charinfo_vertical_parts(charinfo *ci, extinfo *ext)
+{
+ if (ci->math) {
+ if (ci->math->vertical_parts) {
+ extinfo *lst = ci->math->vertical_parts;
+ while (lst) {
+ extinfo *c = lst->next;
+ lmt_memory_free(lst);
+ lst = c;
+ }
+ }
+ ci->math->vertical_parts = ext;
+ }
+}
+
+void tex_set_charinfo_horizontal_parts(charinfo *ci, extinfo *ext)
+{
+ if (ci->math) {
+ if (ci->math->horizontal_parts) {
+ extinfo *lst = ci->math->horizontal_parts;
+ while (lst) {
+ extinfo *c = lst->next;
+ lmt_memory_free(lst);
+ lst = c;
+ }
+ }
+ ci->math->horizontal_parts = ext;
+ }
+}
+
+void tex_set_font_parameters(halfword f, int b)
+{
+ int i = font_parameter_count(f);
+ if (b > i) {
+ /*tex If really needed this can be a calloc. */
+ int s = (b + 2) * (int) sizeof(int);
+ int *a = lmt_memory_realloc(font_parameter_base(f), (size_t) s);
+ if (a) {
+ lmt_font_state.font_data.allocated += (b - i + 1) * (int) sizeof(scaled);
+ font_parameter_base(f) = a;
+ font_parameter_count(f) = b;
+ while (i < b) {
+ font_parameter(f, ++i) = 0;
+ }
+ } else {
+ tex_overflow_error("font", s);
+ }
+ }
+}
+
+/*tex Most stuff is zero: */
+
+int tex_new_font(void)
+{
+ int size = sizeof(charinfo);
+ charinfo *ci = lmt_memory_calloc(1, (size_t) size);
+ if (ci) {
+ texfont *t = NULL;
+ size = sizeof(texfont);
+ t = lmt_memory_calloc(1, (size_t) size);
+ if (t) {
+ sa_tree_item sa_value = { 0 };
+ int id = tex_new_font_id();
+ lmt_font_state.font_data.allocated += size;
+ lmt_font_state.fonts[id] = t;
+ set_font_name(id, NULL);
+ set_font_original(id, NULL);
+ set_font_left_boundary(id, NULL);
+ set_font_right_boundary(id, NULL);
+ set_font_parameter_base(id, NULL);
+ set_font_math_parameter_base(id, NULL);
+ /*tex |ec = 0| */
+ set_font_first_character(id, 1);
+ set_font_hyphen_char(id, '-');
+ set_font_skew_char(id, -1);
+ /*tex allocate eight values including 0 */
+ tex_set_font_parameters(id, 7);
+ for (int k = 0; k <= 7; k++) {
+ tex_set_font_parameter(id, k, 0);
+ }
+ /*tex character info zero is reserved for |notdef|. The stack size 1, default item value 0. */
+ t->characters = sa_new_tree(1, 4, sa_value);
+ t->chardata = ci;
+ t->chardata_size = 1;
+ return id;
+ }
+ }
+ tex_overflow_error("font", size);
+ return 0;
+}
+
+void tex_font_malloc_charinfo(halfword f, int num)
+{
+ int glyph = lmt_font_state.fonts[f]->chardata_size;
+ int size = (glyph + num) * sizeof(charinfo);
+ charinfo *data = lmt_memory_realloc(lmt_font_state.fonts[f]->chardata , (size_t) size);
+ if (data) {
+ lmt_font_state.font_data.allocated += num * sizeof(charinfo);
+ lmt_font_state.fonts[f]->chardata = data;
+ memset(&data[glyph], 0, (size_t) num * sizeof(charinfo));
+ lmt_font_state.fonts[f]->chardata_size += num;
+ } else {
+ tex_overflow_error("font", size);
+ }
+}
+
+void tex_char_malloc_mathinfo(charinfo *ci)
+{
+ int size = sizeof(mathinfo);
+ mathinfo *mi = lmt_memory_calloc(1, (size_t) size);
+ if (mi) {
+ mi->horizontal_parts = NULL;
+ mi->vertical_parts = NULL;
+ mi->top_left_math_kern_array = NULL;
+ mi->top_right_math_kern_array = NULL;
+ mi->bottom_right_math_kern_array = NULL;
+ mi->bottom_left_math_kern_array = NULL;
+ mi->top_left_kern = 0;
+ mi->top_right_kern = 0;
+ mi->bottom_left_kern = 0;
+ mi->bottom_right_kern = 0;
+ mi->left_margin = 0;
+ mi->right_margin = 0;
+ mi->top_margin = 0;
+ mi->bottom_margin = 0;
+ if (ci->math) {
+ /*tex This seldom or probably never happens. */
+ tex_set_charinfo_vertical_parts(ci, NULL);
+ tex_set_charinfo_horizontal_parts(ci, NULL);
+ set_charinfo_top_left_math_kern_array(ci, NULL);
+ set_charinfo_top_right_math_kern_array(ci, NULL);
+ set_charinfo_bottom_right_math_kern_array(ci, NULL);
+ set_charinfo_bottom_left_math_kern_array(ci, NULL);
+ lmt_memory_free(ci->math);
+ } else {
+ lmt_font_state.font_data.allocated += size;
+ }
+ ci->math = mi;
+ } else {
+ tex_overflow_error("font", size);
+ }
+}
+
+# define find_charinfo_id(f,c) (sa_get_item_4(lmt_font_state.fonts[f]->characters,c).int_value)
+
+charinfo *tex_get_charinfo(halfword f, int c)
+{
+ if (proper_char_index(f, c)) {
+ int glyph = sa_get_item_4(lmt_font_state.fonts[f]->characters, c).int_value;
+ if (! glyph) {
+ sa_tree_item sa_value = { 0 };
+ int tglyph = ++lmt_font_state.fonts[f]->chardata_count;
+ if (tglyph >= lmt_font_state.fonts[f]->chardata_size) {
+ tex_font_malloc_charinfo(f, 256);
+ }
+ lmt_font_state.fonts[f]->chardata[tglyph].expansion = 1000;
+ sa_value.int_value = tglyph;
+ /*tex 1 means global */
+ sa_set_item_4(lmt_font_state.fonts[f]->characters, c, sa_value, 1);
+ glyph = tglyph;
+ }
+ return &(lmt_font_state.fonts[f]->chardata[glyph]);
+ } else if (c == left_boundary_char) {
+ if (! font_has_left_boundary(f)) {
+ int size = sizeof(charinfo);
+ charinfo *ci = lmt_memory_calloc(1, (size_t) size);
+ if (ci) {
+ lmt_font_state.font_data.allocated += size;
+ set_font_left_boundary(f, ci);
+ } else {
+ tex_overflow_error("font", size);
+ }
+ }
+ return font_left_boundary(f);
+ } else if (c == right_boundary_char) {
+ if (! font_has_right_boundary(f)) {
+ int size = sizeof(charinfo);
+ charinfo *ci = lmt_memory_calloc(1, (size_t) size);
+ if (ci) {
+ lmt_font_state.font_data.allocated += size;
+ set_font_right_boundary(f, ci);
+ } else {
+ tex_overflow_error("font", size);
+ }
+ }
+ return font_right_boundary(f);
+ } else {
+ return &(lmt_font_state.fonts[f]->chardata[0]);
+ }
+}
+
+static charinfo *tex_aux_char_info(halfword f, int c)
+{
+ if (f > lmt_font_state.font_data.ptr) {
+ return NULL;
+ } else if (proper_char_index(f, c)) {
+ return &(lmt_font_state.fonts[f]->chardata[(int) find_charinfo_id(f, c)]);
+ } else if (c == left_boundary_char) {
+ if (font_left_boundary(f)) {
+ return font_left_boundary(f);
+ }
+ } else if (c == right_boundary_char) {
+ if (font_right_boundary(f)) {
+ return font_right_boundary(f);
+ }
+ }
+ return &(lmt_font_state.fonts[f]->chardata[0]);
+}
+
+void tex_char_process(halfword f, int c)
+{
+ if (tex_char_has_tag_from_font(f, c, callback_tag)) {
+ int callback_id = lmt_callback_defined(process_character_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "dd->", f, c);
+ }
+ tex_char_reset_tag_from_font(f, c, callback_tag);
+ }
+}
+
+int tex_char_exists(halfword f, int c)
+{
+ if (f > lmt_font_state.font_data.ptr) {
+ return 0;
+ } else if (proper_char_index(f, c)) {
+ return (int) find_charinfo_id(f, c);
+ } else if (c == left_boundary_char) {
+ if (font_has_left_boundary(f)) {
+ return 1;
+ }
+ } else if (c == right_boundary_char) {
+ if (font_has_right_boundary(f)) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+
+static int check_math_char(halfword f, int c, int size)
+{
+ int callback_id = lmt_callback_defined(get_math_char_callback);
+ if (callback_id > 0) {
+ halfword s = c;
+ lmt_run_callback(lua_state.lua_instance, callback_id, "ddd->d", f, c, size, &s);
+ if (s && proper_char_index(f, s) && find_charinfo_id(f, s)) {
+ return s;
+ }
+ }
+ return c;
+}
+*/
+
+int tex_math_char_exists(halfword f, int c, int size)
+{
+ (void) size;
+ return (f > 0 && f <= lmt_font_state.font_data.ptr && proper_char_index(f, c));
+}
+
+/*tex
+ There is a bit overhead due to first fetching but we don't need to check again, so that saves
+ a little.
+*/
+
+int tex_get_math_char(halfword f, int c, int size, scaled *scale)
+{
+ int id = find_charinfo_id(f, c);
+ texfont *tf = lmt_font_state.fonts[f];
+ if (id && size && tf->compactmath) {
+ for (int i=1;i<=size;i++) {
+ charinfo *ci = &tf->chardata[id];
+ if (ci->math) {
+ int s = ci->math->smaller;
+ if (s && proper_char_index(f, s)) {
+ id = find_charinfo_id(f, s);
+ if (id) {
+ /* todo: trace */
+ c = s;
+ } else {
+ break;
+ }
+ } else {
+ break;
+ }
+ } else {
+ break;
+ }
+ }
+ }
+ if (scale) {
+ *scale = tex_get_math_font_scale(f, size);
+ if (! *scale) {
+ *scale = 1000;
+ }
+ }
+ /*
+ if (! id && ! tf->oldmath) {
+ c = check_math_char(f, c, size);
+ }
+ */
+ return c;
+}
+
+extinfo *tex_new_charinfo_part(int glyph, int startconnect, int endconnect, int advance, int extender)
+{
+ int size = sizeof(extinfo);
+ extinfo *ext = lmt_memory_malloc((size_t) size);
+ if (ext) {
+ ext->next = NULL;
+ ext->glyph = glyph;
+ ext->start_overlap = startconnect;
+ ext->end_overlap = endconnect;
+ ext->advance = advance;
+ ext->extender = extender;
+ } else {
+ tex_overflow_error("font", size);
+ }
+ return ext;
+}
+
+void tex_add_charinfo_vertical_part(charinfo *ci, extinfo *ext)
+{
+ if (ci->math) {
+ if (ci->math->vertical_parts) {
+ extinfo *lst = ci->math->vertical_parts;
+ while (lst->next)
+ lst = lst->next;
+ lst->next = ext;
+ } else {
+ ci->math->vertical_parts = ext;
+ }
+ }
+}
+
+void tex_add_charinfo_horizontal_part(charinfo *ci, extinfo *ext)
+{
+ if (ci->math) {
+ if (ci->math->horizontal_parts) {
+ extinfo *lst = ci->math->horizontal_parts;
+ while (lst->next) {
+ lst = lst->next;
+ }
+ lst->next = ext;
+ } else {
+ ci->math->horizontal_parts = ext;
+ }
+ }
+}
+
+/*tex
+
+ Note that many more small things like this are implemented as macros in the header file.
+
+*/
+
+int tex_get_charinfo_math_kerns(charinfo *ci, int id)
+{
+ /*tex All callers check for |result > 0|. */
+ if (ci->math) {
+ switch (id) {
+ case top_left_kern:
+ return ci->math->top_left_math_kerns;
+ case bottom_left_kern:
+ return ci->math->bottom_left_math_kerns;
+ case top_right_kern:
+ return ci->math->top_right_math_kerns;
+ case bottom_right_kern:
+ return ci->math->bottom_right_math_kerns;
+ default:
+ tex_confusion("weird math kern");
+ break;
+ }
+ }
+ return 0;
+}
+
+void tex_add_charinfo_math_kern(charinfo *ci, int id, scaled ht, scaled krn)
+{
+ if (ci->math) {
+ int k = 0;
+ int s = 0;
+ scaled *a = NULL;
+ switch (id) {
+ case top_right_kern:
+ {
+ k = ci->math->top_right_math_kerns;
+ s = 2 * (k + 1) * (int) sizeof(scaled);
+ a = lmt_memory_realloc(ci->math->top_right_math_kern_array, (size_t) s);
+ if (a) {
+ ci->math->top_right_math_kern_array = a;
+ ci->math->top_right_math_kerns++;
+ }
+ break;
+ }
+ case bottom_right_kern:
+ {
+ k = ci->math->bottom_right_math_kerns;
+ s = 2 * (k + 1) * (int) sizeof(scaled);
+ a = lmt_memory_realloc(ci->math->bottom_right_math_kern_array, (size_t) s);
+ if (a) {
+ ci->math->bottom_right_math_kern_array = a;
+ ci->math->bottom_right_math_kerns++;
+ }
+ break;
+ }
+ case bottom_left_kern:
+ {
+ k = ci->math->bottom_left_math_kerns;
+ s = 2 * (k + 1) * (int) sizeof(scaled);
+ a = lmt_memory_realloc(ci->math->bottom_left_math_kern_array, (size_t) s);
+ if (a) {
+ ci->math->bottom_left_math_kern_array = a;
+ ci->math->bottom_left_math_kerns++;
+ }
+ break;
+ }
+ case top_left_kern:
+ {
+ k = ci->math->top_left_math_kerns;
+ s = 2 * (k + 1) * (int) sizeof(scaled);
+ a = lmt_memory_realloc(ci->math->top_left_math_kern_array, (size_t) s);
+ if (a) {
+ ci->math->top_left_math_kern_array = a;
+ ci->math->top_left_math_kerns++;
+ }
+ break;
+ }
+ default:
+ tex_confusion("add math kern");
+ return;
+ }
+ if (a) {
+ a[2 * k] = ht;
+ a[(2 * k) + 1] = krn;
+ } else {
+ tex_overflow_error("font", s);
+ }
+ }
+}
+
+/*tex
+
+ In \TEX, extensibles were fairly simple things. This function squeezes a \TFM\ extensible into
+ the vertical extender structures. |advance == 0| is a special case for \TFM\ fonts, because
+ finding the proper advance width during \TFM\ reading can be tricky.
+
+ A small complication arises if |rep| is the only non-zero: it needs to be doubled as a
+ non-repeatable to avoid mayhem.
+
+*/
+
+void tex_set_charinfo_extensible(charinfo *ci, int top, int bottom, int middle, int extender)
+{
+ if (ci->math) {
+ extinfo *ext;
+ /*tex Clear old data: */
+ tex_set_charinfo_vertical_parts(ci, NULL);
+ if (bottom == 0 && top == 0 && middle == 0 && extender != 0) {
+ ext = tex_new_charinfo_part(extender, 0, 0, 0, math_extension_normal);
+ tex_add_charinfo_vertical_part(ci, ext);
+ ext = tex_new_charinfo_part(extender, 0, 0, 0, math_extension_repeat);
+ tex_add_charinfo_vertical_part(ci, ext);
+ } else {
+ if (bottom) {
+ ext = tex_new_charinfo_part(bottom, 0, 0, 0, math_extension_normal);
+ tex_add_charinfo_vertical_part(ci, ext);
+ }
+ if (extender) {
+ ext = tex_new_charinfo_part(extender, 0, 0, 0, math_extension_repeat);
+ tex_add_charinfo_vertical_part(ci, ext);
+ }
+ if (middle) {
+ ext = tex_new_charinfo_part(middle, 0, 0, 0, math_extension_normal);
+ tex_add_charinfo_vertical_part(ci, ext);
+ if (extender) {
+ ext = tex_new_charinfo_part(extender, 0, 0, 0, math_extension_repeat);
+ tex_add_charinfo_vertical_part(ci, ext);
+ }
+ }
+ if (top) {
+ ext = tex_new_charinfo_part(top, 0, 0, 0, math_extension_normal);
+ tex_add_charinfo_vertical_part(ci, ext);
+ }
+ }
+ }
+}
+
+/*tex why not just preallocate for all math otf parameters */
+
+void tex_set_font_math_parameters(halfword f, int b)
+{
+ int i = font_math_parameter_count(f);
+ if (i < b) {
+ size_t size = ((size_t) b + 2) * sizeof(scaled);
+ scaled *data = lmt_memory_realloc(font_math_parameter_base(f), size);
+ if (data) {
+ lmt_font_state.font_data.allocated += (int) (((size_t) b - i + 1) * sizeof(scaled));
+ font_math_parameter_base(f) = data;
+ font_math_parameter_count(f) = b;
+ while (i < b) {
+ ++i; /* in macro, make the next a function */
+ // set_font_math_parameter(f, i, undefined_math_parameter);
+ font_math_parameter(f, i) = undefined_math_parameter;
+ }
+ } else {
+ tex_overflow_error("font", (int) size);
+ }
+ }
+}
+
+void tex_delete_font(int f)
+{
+ if (lmt_font_state.fonts[f]) {
+ tex_set_font_name(f, NULL);
+ tex_set_font_original(f, NULL);
+ set_font_left_boundary(f, NULL);
+ set_font_right_boundary(f, NULL);
+ for (int i = font_first_character(f); i <= font_last_character(f); i++) {
+ if (quick_char_exists(f, i)) {
+ charinfo *co = tex_aux_char_info(f, i);
+ set_charinfo_kerns(co, NULL);
+ set_charinfo_ligatures(co, NULL);
+ if (co->math) {
+ tex_set_charinfo_vertical_parts(co, NULL);
+ tex_set_charinfo_horizontal_parts(co, NULL);
+ set_charinfo_top_left_math_kern_array(co, NULL);
+ set_charinfo_top_right_math_kern_array(co, NULL);
+ set_charinfo_bottom_right_math_kern_array(co, NULL);
+ set_charinfo_bottom_left_math_kern_array(co, NULL);
+ set_charinfo_math(co, NULL);
+ }
+ }
+ }
+ /*tex free |notdef| */
+ lmt_memory_free(lmt_font_state.fonts[f]->chardata);
+ sa_destroy_tree(lmt_font_state.fonts[f]->characters);
+ lmt_memory_free(font_parameter_base(f));
+ if (font_math_parameter_base(f)) {
+ lmt_memory_free(font_math_parameter_base(f));
+ }
+ lmt_memory_free(lmt_font_state.fonts[f]);
+ lmt_font_state.fonts[f] = NULL;
+ if (lmt_font_state.font_data.ptr == f) {
+ lmt_font_state.font_data.ptr--;
+ }
+ }
+}
+
+void tex_create_null_font(void)
+{
+ int id = tex_new_font();
+ tex_set_font_name(id, "nullfont");
+ tex_set_font_original(id, "nullfont");
+ /* set_font_touched(id, 1); */
+}
+
+int tex_is_valid_font(halfword f)
+{
+ return (f >= 0 && f <= lmt_font_state.font_data.ptr && lmt_font_state.fonts[f]);
+}
+
+int tex_checked_font(halfword f)
+{
+ return (f >= 0 && f <= lmt_font_state.font_data.ptr && lmt_font_state.fonts[f]) ? f : null_font;
+}
+
+halfword tex_get_font_identifier(halfword fontspec)
+{
+ if (fontspec) {
+ halfword fnt = font_spec_identifier(fontspec);
+ if ((fnt >= 0 && fnt <= lmt_font_state.font_data.ptr && lmt_font_state.fonts[fnt])) {
+ return fnt;
+ }
+ }
+ return null_font;
+}
+
+/*tex
+
+ Here come some subroutines to deal with expanded fonts. Returning 1 means that they are
+ identical.
+
+*/
+
+ligatureinfo tex_get_ligature(halfword f, int lc, int rc)
+{
+ ligatureinfo t = { 0, 0, 0, 0 };
+ if (lc != non_boundary_char && rc != non_boundary_char && tex_has_ligature(f, lc)) {
+ int k = 0;
+ charinfo *co = tex_aux_char_info(f, lc);
+ while (1) {
+ ligatureinfo u = charinfo_ligature(co, k);
+ if (ligature_end(u)) {
+ break;
+ } else if (ligature_char(u) == rc) {
+ return ligature_disabled(u) ? t : u;
+ }
+ k++;
+ }
+ }
+ return t;
+}
+
+int tex_raw_get_kern(halfword f, int lc, int rc)
+{
+ if (lc != non_boundary_char && rc != non_boundary_char) {
+ int k = 0;
+ charinfo *co = tex_aux_char_info(f, lc);
+ while (1) {
+ kerninfo u = charinfo_kern(co, k);
+ if (kern_end(u)) {
+ break;
+ } else if (kern_char(u) == rc) {
+ return kern_disabled(u) ? 0 : kern_kern(u);
+ }
+ k++;
+ }
+ }
+ return 0;
+}
+
+int tex_get_kern(halfword f, int lc, int rc)
+{
+ if (lc == non_boundary_char || rc == non_boundary_char || (! tex_has_kern(f, lc))) {
+ return 0;
+ } else {
+ return tex_raw_get_kern(f, lc, rc);
+ }
+}
+
+scaled tex_valid_kern(halfword left, halfword right)
+{
+ if (node_type(left) == glyph_node && node_type(right) == glyph_node) {
+ halfword fl = glyph_font(left);
+ halfword fr = glyph_font(right);
+ halfword cl = glyph_character(left);
+ halfword cr = glyph_character(right);
+ if (fl == fr && cl != non_boundary_char && cr != non_boundary_char && tex_has_kern(fl, cl) && ! tex_has_glyph_option(left, glyph_option_no_right_kern) && ! tex_has_glyph_option(right, glyph_option_no_left_kern)) {
+ return tex_raw_get_kern(fl, cl, cr);
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ Experiment:
+
+*/
+
+halfword tex_checked_font_adjust(halfword adjust_spacing, halfword adjust_spacing_step, halfword adjust_spacing_shrink, halfword adjust_spacing_stretch)
+{
+ if (adjust_spacing >= adjust_spacing_full) {
+ if (adjust_spacing_step > 0) {
+ lmt_font_state.adjust_step = adjust_spacing_step;
+ lmt_font_state.adjust_shrink = adjust_spacing_shrink;
+ lmt_font_state.adjust_stretch = adjust_spacing_stretch;
+ if (lmt_font_state.adjust_step > 100) {
+ lmt_font_state.adjust_step = 100;
+ }
+ if (lmt_font_state.adjust_shrink < 0) {
+ lmt_font_state.adjust_shrink = 0;
+ } else if (lmt_font_state.adjust_shrink > 500) {
+ lmt_font_state.adjust_shrink = 500;
+ }
+ if (lmt_font_state.adjust_stretch < 0) {
+ lmt_font_state.adjust_stretch = 0;
+ } else if (lmt_font_state.adjust_stretch > 1000) {
+ lmt_font_state.adjust_stretch = 1000;
+ }
+ return adjust_spacing;
+ }
+ } else {
+ adjust_spacing = adjust_spacing_off;
+ }
+ lmt_font_state.adjust_step = 0;
+ lmt_font_state.adjust_shrink = 0;
+ lmt_font_state.adjust_stretch = 0;
+ return adjust_spacing;
+}
+
+/*tex
+
+ This returns the multiple of |font_step(f)| that is nearest to |e|.
+
+*/
+
+int tex_fix_expand_value(halfword f, int e)
+{
+ int max_expand, neg;
+ if (e == 0) {
+ return 0;
+ } else if (e < 0) {
+ e = -e;
+ neg = 1;
+ max_expand = font_max_shrink(f);
+ } else {
+ neg = 0;
+ max_expand = font_max_stretch(f);
+ }
+ if (e > max_expand) {
+ e = max_expand;
+ } else {
+ int step = font_step(f);
+ if (e % step > 0) {
+ e = step * tex_round_xn_over_d(e, 1, step);
+ }
+ }
+ return neg ? -e : e;
+}
+
+int tex_read_font_info(char *cnom, scaled s)
+{
+ int callback_id = lmt_callback_defined(define_font_callback);
+ if (callback_id > 0) {
+ int f = 0;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "Sd->d", cnom, s, &f);
+ if (tex_is_valid_font(f)) {
+ tex_set_font_original(f, (char *) cnom);
+ return f;
+ } else {
+ return 0;
+ }
+ } else {
+ tex_normal_warning("fonts","no font has been read, you need to enable or fix the callback");
+ return 0;
+ }
+}
+
+/*tex Abstraction: */
+
+halfword tex_get_font_parameter(halfword f, halfword code) /* todo: math */
+{
+ if (font_parameter_count(f) < code) {
+ tex_set_font_parameters(f, code);
+ }
+ return font_parameter(f, code);
+}
+
+void tex_set_font_parameter(halfword f, halfword code, scaled v)
+{
+ if (font_parameter_count(f) < code) {
+ tex_set_font_parameters(f, code);
+ }
+ font_parameter(f, code) = v;
+}
+
+scaled tex_get_font_slant (halfword f) { return font_parameter(f, slant_code); }
+scaled tex_get_font_space (halfword f) { return font_parameter(f, space_code); }
+scaled tex_get_font_space_stretch (halfword f) { return font_parameter(f, space_stretch_code); }
+scaled tex_get_font_space_shrink (halfword f) { return font_parameter(f, space_shrink_code); }
+scaled tex_get_font_ex_height (halfword f) { return font_parameter(f, ex_height_code); }
+scaled tex_get_font_em_width (halfword f) { return font_parameter(f, em_width_code); }
+scaled tex_get_font_extra_space (halfword f) { return font_parameter(f, extra_space_code); }
+
+scaled tex_get_scaled_slant (halfword f) { return font_parameter(f, slant_code); }
+scaled tex_get_scaled_space (halfword f) { return tex_aux_font_x_scaled(font_parameter(f, space_code)); }
+scaled tex_get_scaled_space_stretch (halfword f) { return tex_aux_font_x_scaled(font_parameter(f, space_stretch_code)); }
+scaled tex_get_scaled_space_shrink (halfword f) { return tex_aux_font_x_scaled(font_parameter(f, space_shrink_code)); }
+scaled tex_get_scaled_ex_height (halfword f) { return tex_aux_font_y_scaled(font_parameter(f, ex_height_code)); }
+scaled tex_get_scaled_em_width (halfword f) { return tex_aux_font_x_scaled(font_parameter(f, em_width_code)); }
+scaled tex_get_scaled_extra_space (halfword f) { return tex_aux_font_x_scaled(font_parameter(f, extra_space_code)); }
+
+scaled tex_font_x_scaled (scaled v) { return tex_aux_font_x_scaled(v); }
+scaled tex_font_y_scaled (scaled v) { return tex_aux_font_y_scaled(v); }
+
+halfword tex_get_scaled_parameter(halfword f, halfword code) /* todo: math */
+{
+ if (font_parameter_count(f) < code) {
+ tex_set_font_parameters(f, code);
+ }
+ switch (code) {
+ case slant_code:
+ return font_parameter(f, code);
+ case ex_height_code:
+ return tex_aux_font_y_scaled(font_parameter(f, code));
+ default:
+ return tex_aux_font_x_scaled(font_parameter(f, code));
+ }
+}
+
+void tex_set_scaled_parameter(halfword f, halfword code, scaled v)
+{
+ if (font_parameter_count(f) < code) {
+ tex_set_font_parameters(f, code);
+ }
+ font_parameter(f, code) = tex_aux_font_x_scaled(v);
+}
+
+halfword tex_get_scaled_glue(halfword f)
+{
+ halfword p = tex_new_glue_node(zero_glue, space_skip_glue);
+ glue_amount(p) = tex_aux_font_x_scaled(font_parameter(f, space_code));
+ glue_stretch(p) = tex_aux_font_x_scaled(font_parameter(f, space_stretch_code));
+ glue_shrink(p) = tex_aux_font_x_scaled(font_parameter(f, space_shrink_code));
+ glue_font(p) = f;
+ return p;
+}
+
+halfword tex_get_scaled_parameter_glue(quarterword p, quarterword s)
+{
+ halfword n = tex_new_glue_node(zero_glue, s);
+ halfword g = glue_parameter(p);
+ // if (g) {
+ // memcpy((void *) (node_memory_state.nodes + n + 2), (void *) (node_memory_state.nodes + g + 2), (glue_spec_size - 2) * (sizeof(memoryword)));
+ // }
+ glue_amount(n) = tex_aux_font_x_scaled(glue_amount(g));
+ glue_stretch(n) = tex_aux_font_x_scaled(glue_stretch(g));
+ glue_shrink(n) = tex_aux_font_x_scaled(glue_shrink(g));
+ return n;
+}
+
+halfword tex_get_parameter_glue(quarterword p, quarterword s)
+{
+ halfword n = tex_new_glue_node(zero_glue, s);
+ halfword g = glue_parameter(p);
+ if (g) {
+ memcpy((void *) (lmt_node_memory_state.nodes + n + 2), (void *) (lmt_node_memory_state.nodes + g + 2), (glue_spec_size - 2) * (sizeof(memoryword)));
+ }
+ return n;
+}
+
+/*tex Ligaturing starts here */
+
+static void tex_aux_nesting_append(halfword nest1, halfword newn)
+{
+ halfword tail = node_tail(nest1);
+ tex_couple_nodes(tail ? tail : nest1, newn);
+ node_tail(nest1) = newn;
+}
+
+static void tex_aux_nesting_prepend(halfword nest1, halfword newn)
+{
+ halfword head = node_next(nest1);
+ tex_couple_nodes(nest1, newn);
+ if (head) {
+ tex_couple_nodes(newn, head);
+ } else {
+ node_tail(nest1) = newn;
+ }
+}
+
+static void tex_aux_nesting_prepend_list(halfword nest1, halfword newn)
+{
+ halfword head = node_next(nest1);
+ halfword tail = tex_tail_of_node_list(newn);
+ tex_couple_nodes(nest1, newn);
+ if (head) {
+ tex_couple_nodes(tail, head);
+ } else {
+ node_tail(nest1) = tail;
+ }
+}
+
+int tex_valid_ligature(halfword left, halfword right, int *slot)
+{
+ if (node_type(left) != glyph_node) {
+ return -1;
+ } else if (glyph_font(left) != glyph_font(right)) {
+ return -1;
+ } else if (tex_has_glyph_option(left, glyph_option_no_right_ligature) || tex_has_glyph_option(right, glyph_option_no_left_ligature)) {
+ return -1;
+ } else {
+ ligatureinfo lig = tex_get_ligature(glyph_font(left), glyph_character(left), glyph_character(right));
+ if (ligature_is_valid(lig)) {
+ *slot = ligature_replacement(lig);
+ return ligature_type(lig);
+ } else {
+ return -1;
+ }
+ }
+}
+
+static int tex_aux_found_ligature(halfword left, halfword right)
+{
+ if (node_type(left) != glyph_node) {
+ return 0;
+ } else if (glyph_font(left) != glyph_font(right)) {
+ return 0;
+ } else if (tex_has_glyph_option(left, glyph_option_no_right_ligature) || tex_has_glyph_option(right, glyph_option_no_left_ligature)) {
+ return 0;
+ } else {
+ return ligature_is_valid(tex_get_ligature(glyph_font(left), glyph_character(left), glyph_character(right)));
+ }
+}
+
+/*tex
+ We could be more efficient and reuse the possibly later removed node but it takes more code and
+ we don't have that many ligatures anyway.
+*/
+
+static int tex_aux_try_ligature(halfword *first, halfword forward)
+{
+ halfword cur = *first;
+ if (glyph_scale(cur) == glyph_scale(forward) && glyph_x_scale(cur) == glyph_x_scale(forward) && glyph_y_scale(cur) == glyph_y_scale(forward)) {
+ halfword slot;
+ halfword type = tex_valid_ligature(cur, forward, &slot);
+ if (type >= 0) {
+ int move_after = (type & 0x0C) >> 2;
+ int keep_right = (type & 0x01) != 0;
+ int keep_left = (type & 0x02) != 0;
+ halfword parent = (glyph_character(cur) >= 0) ? cur : ((glyph_character(forward) >= 0) ? forward : null);
+ halfword ligature = tex_new_glyph_node(glyph_ligature_subtype, glyph_font(cur), slot, parent);
+ if (keep_left) {
+ tex_couple_nodes(cur, ligature);
+ if (move_after) {
+ move_after--;
+ cur = ligature;
+ }
+ } else {
+ halfword prev = node_prev(cur);
+ tex_uncouple_node(cur);
+ tex_flush_node(cur);
+ tex_couple_nodes(prev, ligature);
+ cur = ligature;
+ }
+ if (keep_right) {
+ tex_couple_nodes(ligature, forward);
+ if (move_after) {
+ move_after--;
+ cur = forward;
+ }
+ } else {
+ halfword next = node_next(forward);
+ tex_uncouple_node(forward);
+ tex_flush_node(forward);
+ if (next) {
+ tex_couple_nodes(ligature, next);
+ }
+ }
+ *first = cur;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ 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|.
+
+*/
+
+static halfword tex_aux_handle_ligature_nesting(halfword root, halfword cur)
+{
+ if (cur) {
+ while (node_next(cur)) {
+ halfword fwd = node_next(cur);
+ if (node_type(cur) == glyph_node && node_type(fwd) == glyph_node && glyph_font(cur) == glyph_font(fwd) && tex_aux_try_ligature(&cur, fwd)) {
+ continue;
+ }
+ cur = node_next(cur);
+ }
+ node_tail(root) = cur;
+ }
+ return root;
+}
+
+/*tex
+
+ In \LUATEX\ we have a chained variant of discretionaries (init and select) but that never really
+ works out ok. It was there for basemode to be compatible with original \TEX\ but it was also means
+ for border cases that in practice never occur. A least no \CONTEXT\ user ever complained about
+ ligatures and hyphenation of these border cases. Keep in mind that in node mode (which we normally
+ use) the select discs never showed up anyway. Another reason for dropping these discretionaries is
+ that by not using them we get more predictable (or at least easier) handling of node lists that do
+ have (any kind of) discretionaries. It is still on my agenda to look into nested discretionaries
+ i.e. discs nodes in disc fields but it might never result in useable code.
+
+ Remark: there is now a patch for \LUATEX\ that fixes some long pending issue with select discs but
+ still it's kind of fuzzy. It also complicates the par builder in a way that I don't really want
+ (at least in \CONTEXT). It was anyway a good reason for removing traces of these special disc nodes
+ in \LUAMETATEX.
+
+*/
+
+static halfword tex_aux_handle_ligature_word(halfword cur)
+{
+ halfword right = null;
+ if (node_type(cur) == boundary_node) {
+ halfword prev = node_prev(cur);
+ halfword fwd = node_next(cur);
+ /*tex There is no need to uncouple |cur|, it is freed. */
+ tex_flush_node(cur);
+ if (fwd) {
+ tex_couple_nodes(prev, fwd);
+ if (node_type(fwd) != glyph_node) {
+ return prev;
+ } else {
+ cur = fwd;
+ }
+ } else {
+ node_next(prev) = fwd;
+ return prev;
+ }
+ } else if (font_has_left_boundary(glyph_font(cur))) {
+ halfword prev = node_prev(cur);
+ halfword p = tex_new_glyph_node(glyph_unset_subtype, glyph_font(cur), left_boundary_char, cur);
+ tex_couple_nodes(prev, p);
+ tex_couple_nodes(p, cur);
+ cur = p;
+ }
+ if (font_has_right_boundary(glyph_font(cur))) {
+ right = tex_new_glyph_node(glyph_unset_subtype, glyph_font(cur), right_boundary_char, cur);
+ }
+ /* todo: switch */
+ while (1) {
+ halfword t = node_type(cur);
+ /*tex A glyph followed by \unknown */
+ if (t == glyph_node) {
+ halfword fwd = node_next(cur);
+ if (fwd) {
+ t = node_type(fwd);
+ if (t == glyph_node) {
+ /*tex a glyph followed by a glyph */
+ if (glyph_font(cur) != glyph_font(fwd)) {
+ break;
+ } else if (tex_aux_try_ligature(&cur, fwd)) {
+ continue;
+ }
+ } else if (t == disc_node) {
+ /*tex a glyph followed by a disc */
+ halfword pre = disc_pre_break_head(fwd);
+ halfword nob = disc_no_break_head(fwd);
+ halfword next, tail;
+ /*tex Check on: |a{b?}{?}{?}| and |a+b=>B| : |{B?}{?}{a?}| */
+ /*tex Check on: |a{?}{?}{b?}| and |a+b=>B| : |{a?}{?}{B?}| */
+ if ((pre && node_type(pre) == glyph_node && tex_aux_found_ligature(cur, pre))
+ || (nob && node_type(nob) == glyph_node && tex_aux_found_ligature(cur, nob))) {
+ /*tex Move |cur| from before disc to skipped part */
+ halfword prev = node_prev(cur);
+ tex_uncouple_node(cur);
+ tex_couple_nodes(prev, fwd);
+ tex_aux_nesting_prepend(disc_no_break(fwd), cur);
+ /*tex Now ligature the |pre_break|. */
+ tex_aux_nesting_prepend(disc_pre_break(fwd), tex_copy_node(cur));
+ /*tex As we have removed cur, we need to start again. */
+ cur = prev;
+ }
+ /*tex Check on: |a{?}{?}{}b| and |a+b=>B| : |{a?}{?b}{B}|. */
+ next = node_next(fwd);
+ if ((! nob) && next && node_type(next) == glyph_node && tex_aux_found_ligature(cur, next)) {
+ /*tex Move |cur| from before |disc| to |no_break| part. */
+ halfword prev = node_prev(cur);
+ tex_uncouple_node(cur);
+ tex_couple_nodes(prev, fwd);
+ /*tex We {\em know} it's empty. */
+ tex_couple_nodes(disc_no_break(fwd), cur);
+ /*tex Now copy |cur| the |pre_break|. */
+ tex_aux_nesting_prepend(disc_pre_break(fwd), tex_copy_node(cur));
+ /*tex Move next from after disc to |no_break| part. */
+ tail = node_next(next);
+ tex_uncouple_node(next);
+ tex_try_couple_nodes(fwd, tail);
+ /*tex We {\em know} this works. */
+ tex_couple_nodes(cur, next);
+ /*tex Make sure the list is correct. */
+ disc_no_break_tail(fwd) = next;
+ /*tex Now copy next to the |post_break|. */
+ tex_aux_nesting_append(disc_post_break(fwd), tex_copy_node(next));
+ /*tex As we have removed cur, we need to start again. */
+ cur = prev;
+ }
+ /*tex We are finished with the |pre_break|. */
+ tex_aux_handle_ligature_nesting(disc_pre_break(fwd), disc_pre_break_head(fwd));
+ } else if (t == boundary_node) {
+ halfword next = node_next(fwd);
+ tex_try_couple_nodes(cur, next);
+ tex_flush_node(fwd);
+ if (right) {
+ /*tex Shame, didn't need it. */
+ tex_flush_node(right);
+ /*tex No need to reset |right|, we're going to leave the loop anyway. */
+ }
+ break;
+ } else if (right) {
+ tex_couple_nodes(cur, right);
+ tex_couple_nodes(right, fwd);
+ right = null;
+ continue;
+ } else {
+ break;
+ }
+ } else {
+ /*tex The last character of a paragraph. */
+ if (right) {
+ /*tex |par| prohibits the use of |couple_nodes| here. */
+ tex_try_couple_nodes(cur, right);
+ right = null;
+ continue;
+ } else {
+ break;
+ }
+ }
+ /*tex A discretionary followed by \unknown */
+ } else if (t == disc_node) {
+ /*tex If |{?}{x}{?}| or |{?}{?}{y}| then: */
+ if (disc_no_break_head(cur) || disc_post_break_head(cur)) {
+ halfword fwd;
+ if (disc_post_break_head(cur)) {
+ tex_aux_handle_ligature_nesting(disc_post_break(cur), disc_post_break_head(cur));
+ }
+ if (disc_no_break_head(cur)) {
+ tex_aux_handle_ligature_nesting(disc_no_break(cur), disc_no_break_head(cur));
+ }
+ fwd = node_next(cur);
+ while (fwd) {
+ if (node_type(fwd) == glyph_node) {
+ halfword nob = disc_no_break_tail(cur);
+ halfword pst = disc_post_break_tail(cur);
+ if ((! nob || ! tex_aux_found_ligature(nob, fwd)) && (! pst || ! tex_aux_found_ligature(pst, fwd))) {
+ break;
+ } else {
+ halfword next = node_next(fwd);
+ tex_aux_nesting_append(disc_no_break(cur), tex_copy_node(fwd));
+ tex_aux_handle_ligature_nesting(disc_no_break(cur), nob);
+ tex_uncouple_node(fwd);
+ tex_try_couple_nodes(cur, next);
+ tex_aux_nesting_append(disc_post_break(cur), fwd);
+ tex_aux_handle_ligature_nesting(disc_post_break(cur), pst);
+ fwd = node_next(cur);
+ }
+ } else {
+ break;
+ }
+ }
+ if (fwd && node_type(fwd) == disc_node) {
+ /*tex This only deals with simple pre-only discretionaries and a following glyph. */
+ halfword next = node_next(fwd);
+ if (next
+ && ! disc_no_break_head(fwd)
+ && ! disc_post_break_head(fwd)
+ && node_type(next) == glyph_node
+ && ((disc_post_break_tail(cur) && tex_aux_found_ligature(disc_post_break_tail(cur), next)) ||
+ (disc_no_break_tail (cur) && tex_aux_found_ligature(disc_no_break_tail (cur), next)))) {
+ halfword last = node_next(next);
+ tex_uncouple_node(next);
+ tex_try_couple_nodes(fwd, last);
+ /*tex Just a hidden flag, used for (base mode) experiments. */
+ if (hyphenation_permitted(hyphenation_mode_par, lazy_ligatures_hyphenation_mode)) {
+ /*tex f-f-i -> f-fi */
+ halfword tail = disc_no_break_tail(cur);
+ tex_aux_nesting_append(disc_no_break(cur), tex_copy_node(next));
+ tex_aux_handle_ligature_nesting(disc_no_break(cur), tail);
+ tail = disc_post_break_tail(cur);
+ tex_aux_nesting_append(disc_post_break(cur), next);
+ tex_aux_handle_ligature_nesting(disc_post_break(cur), tail);
+ tex_try_couple_nodes(node_prev(fwd), node_next(fwd));
+ tex_flush_node(fwd);
+ } else {
+ /*tex f-f-i -> ff-i : |{a-}{b}{AB} {-}{c}{}| => |{AB-}{c}{ABc}| */
+ tex_aux_nesting_append(disc_post_break(fwd), tex_copy_node(next));
+ if (disc_no_break_head(cur)) {
+ halfword tail;
+ tex_aux_nesting_prepend_list(disc_no_break(fwd), tex_copy_node_list(disc_no_break_head(cur), null));
+ tail = disc_no_break_tail(fwd);
+ tex_aux_nesting_append(disc_no_break(fwd), next);
+ tex_aux_handle_ligature_nesting(disc_no_break(fwd), tail);
+ tex_aux_nesting_prepend_list(disc_pre_break(fwd), tex_copy_node_list(disc_no_break_head(cur), null));
+ }
+ tex_try_couple_nodes(node_prev(cur), node_next(cur));
+ tex_flush_node(cur);
+ cur = fwd;
+ }
+ }
+ }
+ }
+ } else {
+ /*tex We have glyph nor disc. */
+ return cur;
+ }
+ /*tex Goto the next node, where |\par| allows |node_next(cur)| to be NULL. */
+ cur = node_next(cur);
+ }
+ return cur;
+}
+
+
+/*tex The return value is the new tail, head should be a dummy: */
+
+halfword tex_handle_ligaturing(halfword head, halfword tail)
+{
+ if (node_next(head)) {
+ /*tex A trick to allow explicit |node == null| tests. */
+ halfword save_tail = null;
+ halfword cur, prev;
+ if (tail) {
+ save_tail = node_next(tail);
+ node_next(tail) = null;
+ }
+ prev = head;
+ cur = node_next(prev);
+ while (cur) {
+ if (node_type(cur) == glyph_node || node_type(cur) == boundary_node) {
+ cur = tex_aux_handle_ligature_word(cur);
+ }
+ prev = cur;
+ cur = node_next(cur);
+ }
+ if (! prev) {
+ prev = tail;
+ }
+ tex_try_couple_nodes(prev, save_tail);
+ // if (tail) {
+ // }
+ return prev;
+ } else {
+ return tail;
+ }
+}
+
+/*tex Kerning starts here: */
+
+static void tex_aux_add_kern_before(halfword left, halfword right)
+{
+ if (
+ glyph_font(left) == glyph_font(right) &&
+ glyph_scale(left) == glyph_scale(right) &&
+ glyph_x_scale(left) == glyph_x_scale(right) &&
+ glyph_y_scale(left) == glyph_y_scale(right) &&
+ ! tex_has_glyph_option(left, glyph_option_no_right_kern) &&
+ ! tex_has_glyph_option(right, glyph_option_no_left_kern) &&
+ tex_has_kern(glyph_font(left), glyph_character(left))
+ ) {
+ scaled k = tex_raw_get_kern(glyph_font(left), glyph_character(left), glyph_character(right));
+ if (k) {
+ scaled kern = tex_new_kern_node(k, font_kern_subtype);
+ halfword prev = node_prev(right);
+ tex_couple_nodes(prev, kern);
+ tex_couple_nodes(kern, right);
+ tex_attach_attribute_list_copy(kern, left);
+ }
+ }
+}
+
+static void tex_aux_add_kern_after(halfword left, halfword right, halfword aft)
+{
+ if (
+ glyph_font(left) == glyph_font(right) &&
+ glyph_scale(left) == glyph_scale(right) &&
+ glyph_x_scale(left) == glyph_x_scale(right) &&
+ glyph_y_scale(left) == glyph_y_scale(right) &&
+ ! tex_has_glyph_option(left, glyph_option_no_right_kern) &&
+ ! tex_has_glyph_option(right, glyph_option_no_left_kern) &&
+ tex_has_kern(glyph_font(left), glyph_character(left))
+ ) {
+ scaled k = tex_raw_get_kern(glyph_font(left), glyph_character(left), glyph_character(right));
+ if (k) {
+ scaled kern = tex_new_kern_node(k, font_kern_subtype);
+ halfword next = node_next(aft);
+ tex_couple_nodes(aft, kern);
+ tex_try_couple_nodes(kern, next);
+ tex_attach_attribute_list_copy(kern, aft);
+ }
+ }
+}
+
+static void tex_aux_do_handle_kerning(halfword root, halfword init_left, halfword init_right)
+{
+ halfword cur = node_next(root);
+ if (cur) {
+ halfword left = null;
+ if (node_type(cur) == glyph_node) {
+ if (init_left) {
+ tex_aux_add_kern_before(init_left, cur);
+ }
+ left = cur;
+ }
+ cur = node_next(cur);
+ while (cur) {
+ halfword t = node_type(cur);
+ if (t == glyph_node) {
+ if (left) {
+ tex_aux_add_kern_before(left, cur);
+ if (glyph_character(left) < 0) {
+ halfword prev = node_prev(left);
+ tex_couple_nodes(prev, cur);
+ tex_flush_node(left);
+ }
+ }
+ left = cur;
+ } else {
+ if (t == disc_node) {
+ halfword right = node_type(node_next(cur)) == glyph_node ? node_next(cur) : null;
+ tex_aux_do_handle_kerning(disc_pre_break(cur), left, null);
+ if (disc_pre_break_head(cur)) {
+ disc_pre_break_tail(cur) = tex_tail_of_node_list(disc_pre_break_head(cur));
+ }
+ tex_aux_do_handle_kerning(disc_post_break(cur), null, right);
+ if (disc_post_break_head(cur)) {
+ disc_post_break_tail(cur) = tex_tail_of_node_list(disc_post_break_head(cur));
+ }
+ tex_aux_do_handle_kerning(disc_no_break(cur), left, right);
+ if (disc_no_break_head(cur)) {
+ disc_no_break_tail(cur) = tex_tail_of_node_list(disc_no_break_head(cur));
+ }
+ }
+ if (left) {
+ if (glyph_character(left) < 0) {
+ halfword prev = node_prev(left);
+ tex_couple_nodes(prev, cur);
+ tex_flush_node(left);
+ }
+ left = null;
+ }
+ }
+ cur = node_next(cur);
+ }
+ if (left) {
+ if (init_right) {
+ tex_aux_add_kern_after(left, init_right, left);
+ }
+ if (glyph_character(left) < 0) {
+ halfword prev = node_prev(left);
+ halfword next = node_next(left);
+ if (next) {
+ tex_couple_nodes(prev, next);
+ node_tail(root) = next;
+ } else if (prev != root) {
+ node_next(prev) = null;
+ node_tail(root) = prev;
+ } else {
+ node_next(root) = null;
+ node_tail(root) = null;
+ }
+ tex_flush_node(left);
+ }
+ }
+ } else if (init_left && init_right ) {
+ tex_aux_add_kern_after(init_left, init_right, root);
+ node_tail(root) = node_next(root);
+ }
+}
+
+halfword tex_handle_kerning(halfword head, halfword tail)
+{
+ halfword save_link = null;
+ if (tail) {
+ save_link = node_next(tail);
+ node_next(tail) = null;
+ node_tail(head) = tail;
+ tex_aux_do_handle_kerning(head, null, null);
+ tail = node_tail(head);
+ if (tex_valid_node(save_link)) {
+ /* no need for check */
+ tex_try_couple_nodes(tail, save_link);
+ }
+ } else {
+ node_tail(head) = null;
+ tex_aux_do_handle_kerning(head, null, null);
+ }
+ return tail;
+}
+
+/*tex The ligaturing and kerning \LUA\ interface: */
+
+static halfword tex_aux_run_lua_ligkern_callback(lua_State *L, halfword head, halfword group, halfword direction, int callback_id)
+{
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, head);
+ lmt_push_group_code(L, group);
+ lua_pushinteger(L, direction);
+ i = lmt_callback_call(L, 3, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ head = lmt_node_list_from_lua(L, -1);
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ return head;
+}
+
+halfword tex_handle_glyphrun(halfword head, halfword group, halfword direction)
+{
+ if (head) {
+ int callback_id = lmt_callback_defined(glyph_run_callback);
+ if (callback_id) {
+ return tex_aux_run_lua_ligkern_callback(lmt_lua_state.lua_instance, head, group, direction, callback_id);
+ } else {
+ callback_id = lmt_callback_defined(ligaturing_callback);
+ if (callback_id) {
+ head = tex_aux_run_lua_ligkern_callback(lmt_lua_state.lua_instance, head, group, direction, callback_id);
+ } else {
+ tex_handle_ligaturing(head, null);
+ }
+ callback_id = lmt_callback_defined(kerning_callback);
+ if (callback_id) {
+ head = tex_aux_run_lua_ligkern_callback(lmt_lua_state.lua_instance, head, group, direction, callback_id);
+ } else {
+ halfword nest = tex_new_node(nesting_node, unset_nesting_code);
+ tex_couple_nodes(nest, head);
+ tex_aux_do_handle_kerning(nest, null, null);
+ head = node_next(nest);
+ node_prev(head) = null;
+ node_next(nest) = null;
+ tex_flush_node(nest);
+ }
+ }
+ }
+ return head;
+}
+
+/*tex
+
+ When the user defines |\font\f|, say, \TEX\ assigns an internal number to the user's font |\f|.
+ Adding this number to |font_id_base| gives the |eqtb| location of a \quote {frozen} control
+ sequence that will always select the
+ font.
+
+ The variable |a| in the following code indicates the global nature of the value to be set. It's
+ used in the |define| macro. Here we're never global.
+
+ There's not much scanner code here because the other scanners are defined where they make most
+ sense.
+
+*/
+
+void tex_set_cur_font(halfword g, halfword f)
+{
+ update_tex_font(g, f);
+}
+
+/*tex This prints a scaled real, rounded to five digits. */
+
+static char *tex_aux_scaled_to_string(scaled s)
+{
+ static char result[16];
+ int k = 0;
+ /*tex The amount of allowable inaccuracy: */
+ scaled delta;
+ if (s < 0) {
+ /*tex Only print the sign, if negative */
+ result[k++] = '-';
+ s = -s;
+ }
+ {
+ int l = 0;
+ char digs[8] = { 0 };
+ int n = s / unity;
+ /*tex Process the integer part: */
+ do {
+ digs[l++] = (char) (n % 10);
+ n = n / 10;;
+ } while (n > 0);
+ while (l > 0) {
+ result[k++] = (char) (digs[--l] + '0');
+ }
+ }
+ result[k++] = '.';
+ s = 10 * (s % unity) + 5;
+ delta = 10;
+ do {
+ if (delta > unity) {
+ /*tex Round the last digit: */
+ s = s + 0100000 - 050000;
+ }
+ result[k++] = (char) ('0' + (s / unity));
+ s = 10 * (s % unity);
+ delta = delta * 10;
+ } while (s > delta);
+ result[k] = 0;
+ return (char *) result;
+}
+
+/*tex
+
+ Because we do fonts in \LUA\ we can decide to drop this one and assume a definition using the
+ token scanner. It also avoids the filename (split) mess.
+
+*/
+
+int tex_tex_def_font(int a)
+{
+ if (! lmt_fileio_state.job_name) {
+ /*tex Avoid confusing |texput| with the font name. */
+ tex_open_log_file();
+ }
+ tex_get_r_token();
+ if (tex_define_permitted(cur_cs, a)) {
+ /*tex The user's font identifier. */
+ halfword u = cur_cs;
+ /*tex This runs through existing fonts. */
+ halfword f;
+ /*tex Stated 'at' size, or negative of scaled magnification. */
+ scaled s = -1000;
+ char *fn;
+ /*tex Here |a| detemines if we define global or not. */
+ if (is_global(a)) {
+ update_tex_font_global(u, null_font);
+ } else {
+ update_tex_font_local(u, null_font);
+ }
+ fn = tex_read_file_name(1, NULL, NULL);
+ /*tex Scan the font size specification. */
+ lmt_fileio_state.name_in_progress = 1;
+ if (tex_scan_keyword("at")) {
+ /*tex Put the positive 'at' size into |s|. */
+ s = tex_scan_dimen(0, 0, 0, 0, NULL);
+ if ((s <= 0) || (s >= 01000000000)) {
+ char msg[256];
+ snprintf(msg, 255,
+ "Improper 'at' size (%spt), replaced by 10pt",
+ tex_aux_scaled_to_string(s)
+ );
+ tex_handle_error(
+ normal_error_type,
+ msg,
+ "I can only handle fonts at positive sizes that are less than 2048pt, so I've\n"
+ "changed what you said to 10pt." );
+ s = 10 * unity;
+ }
+ } else if (tex_scan_keyword("scaled")) {
+ s = tex_scan_int(0, NULL);
+ if ((s <= 0) || (s > 32768)) {
+ char msg[256];
+ snprintf(msg, 255,
+ "Illegal magnification has been changed to 1000 (%d)",
+ (int) s
+ );
+ tex_handle_error(
+ normal_error_type,
+ msg,
+ "The magnification ratio must be between 1 and 32768."
+ );
+ s = -1000;
+ } else {
+ s = -s;
+ }
+ }
+ lmt_fileio_state.name_in_progress = 0;
+ f = tex_read_font_info(fn, s);
+ eq_value(u) = f;
+ lmt_memory_free(fn);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*tex
+
+ When \TEX\ wants to typeset a character that doesn't exist, the character node is not created;
+ thus the output routine can assume that characters exist when it sees them. The following
+ procedure prints a warning message unless the user has suppressed it.
+
+*/
+
+void tex_char_warning(halfword f, int c)
+{
+ if (tracing_lost_chars_par > 0) {
+ /*tex saved value of |tracing_online| */
+ int old_setting = tracing_online_par;
+ /*tex index to current digit; we assume that $0\L n<16^{22}$ */
+ if (tracing_lost_chars_par > 1) {
+ tracing_online_par = 1;
+ }
+ tex_begin_diagnostic();
+ tex_print_format("[font: missing character, character %c (%U), font '%s']", c, c, font_name(f));
+ tex_end_diagnostic();
+ tracing_online_par = old_setting;
+ }
+}
+
+/* Getters. */
+
+scaled tex_char_width_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->width;
+}
+
+scaled tex_char_height_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->height;
+}
+
+scaled tex_char_depth_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->depth;
+}
+
+scaled tex_char_total_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->height + ci->depth;
+}
+
+scaled tex_char_italic_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->italic;
+}
+
+
+// scaled tex_char_options_from_font(halfword f, halfword c)
+// {
+// charinfo *ci = tex_aux_char_info(f, c);
+// return ci->math ? ci->math->options : 0;
+// }
+//
+// int tex_char_has_option_from_font(halfword f, halfword c, int option)
+// {
+// charinfo *ci = tex_aux_char_info(f, c);
+// return ci->math ? math_font_option(ci->math->options, option) : 0;
+// }
+
+scaledwhd tex_char_whd_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return (scaledwhd) {
+ .wd = ci->width,
+ .ht = ci->height,
+ .dp = ci->depth,
+ .ic = ci->italic
+ };
+}
+
+scaled tex_char_ef_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->expansion;
+}
+
+scaled tex_char_lp_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->leftprotrusion;
+}
+
+scaled tex_char_rp_from_font(halfword f, halfword c)
+{
+ return tex_aux_char_info(f, c)->rightprotrusion;
+}
+
+halfword tex_char_has_tag_from_font(halfword f, halfword c, halfword tag)
+{
+ return (charinfo_tag(tex_aux_char_info(f, c)->tagrem) & tag) == tag;
+}
+
+void tex_char_reset_tag_from_font(halfword f, halfword c, halfword tag)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ // tag = charinfo_tag(ci->tagrem) & ~(tag | charinfo_tag(ci->tagrem));
+ tag = charinfo_tag(ci->tagrem) & ~(tag);
+ ci->tagrem = charinfo_tagrem(tag,charinfo_rem(ci->tagrem));
+
+}
+
+halfword tex_char_tag_from_font(halfword f, halfword c)
+{
+ return charinfo_tag(tex_aux_char_info(f, c)->tagrem);
+}
+
+halfword tex_char_remainder_from_font(halfword f, halfword c)
+{
+ return charinfo_rem(tex_aux_char_info(f, c)->tagrem);
+}
+
+halfword tex_char_vertical_italic_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->vertical_italic : INT_MIN;
+}
+
+halfword tex_char_top_accent_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->top_accent : INT_MIN;
+}
+
+halfword tex_char_top_anchor_from_font(halfword f, halfword c)
+{
+ scaled n = tex_char_top_accent_from_font(f, c);
+ return n == INT_MIN ? 0 : n;
+}
+
+halfword tex_char_bot_accent_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->bottom_accent : INT_MIN;
+}
+
+halfword tex_char_bot_anchor_from_font(halfword f, halfword c)
+{
+ scaled n = tex_char_bot_accent_from_font(f, c);
+ return n == INT_MIN ? 0 : n;
+}
+
+halfword tex_char_flat_accent_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->flat_accent : INT_MIN;
+}
+
+scaled tex_char_top_left_kern_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->top_left_kern : 0;
+}
+
+scaled tex_char_top_right_kern_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->top_right_kern : 0;
+}
+
+scaled tex_char_bottom_left_kern_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->bottom_left_kern : 0;
+}
+
+scaled tex_char_bottom_right_kern_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->bottom_right_kern : 0;
+}
+
+extinfo *tex_char_vertical_parts_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->vertical_parts : NULL;
+}
+
+extinfo *tex_char_horizontal_parts_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->horizontal_parts : NULL;
+}
+
+scaled tex_char_left_margin_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->left_margin : 0;
+}
+
+scaled tex_char_right_margin_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->right_margin : 0;
+}
+
+scaled tex_char_top_margin_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->top_margin : 0;
+}
+
+scaled tex_char_bottom_margin_from_font(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci->math ? ci->math->bottom_margin : 0;
+}
+
+/* Nodes */
+
+scaled tex_char_width_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return tex_aux_glyph_x_scaled(g, ci->width);
+}
+
+scaled tex_char_height_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return tex_aux_glyph_y_scaled(g, ci->height);
+}
+
+scaled tex_char_depth_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return tex_aux_glyph_y_scaled(g, ci->depth);
+}
+
+scaled tex_char_total_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return tex_aux_glyph_y_scaled(g, ci->height + ci->depth);
+}
+
+scaled tex_char_italic_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return tex_aux_glyph_x_scaled(g, ci->italic);
+}
+
+// halfword tex_char_options_from_glyph(halfword g)
+// {
+// charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+// return ci->math ? ci->math->options : 0;
+// }
+
+// int tex_char_has_option_from_glyph(halfword g, int t)
+// {
+// if (node_type(g) == glyph_node) {
+// charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+// return ci->math ? math_font_option(ci->math->options, t) : 0;
+// } else {
+// return 0;
+// }
+// }
+
+scaledwhd tex_char_whd_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return (scaledwhd) {
+ .wd = tex_aux_glyph_x_scaled(g, ci->width),
+ .ht = tex_aux_glyph_y_scaled(g, ci->height),
+ .dp = tex_aux_glyph_y_scaled(g, ci->depth),
+ .ic = tex_aux_glyph_x_scaled(g, ci->italic)
+ };
+}
+
+scaled tex_char_width_italic_from_glyph(halfword g)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ return tex_aux_glyph_x_scaled(g, ci->width + ci->italic);
+}
+
+/* More */
+
+scaled tex_calculated_char_width(halfword f, halfword c, halfword ex)
+{
+ scaled wd = tex_aux_char_info(f, c)->width;
+ return ex ? tex_round_xn_over_d(wd, 1000 + ex, 1000) : wd;
+}
+
+scaled tex_calculated_glyph_width(halfword g, halfword ex)
+{
+ charinfo *ci = tex_aux_char_info(glyph_font(g), glyph_character(g));
+ scaled wd = tex_aux_glyph_x_scaled(g, ci->width);
+ return ex ? tex_round_xn_over_d(wd, 1000 + ex, 1000) : wd;
+}
+
+/* Checkers: */
+
+int tex_has_ligature(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci ? ci->ligatures != NULL : 0;
+}
+
+int tex_has_kern(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci ? ci->kerns != NULL : 0;
+}
+
+int tex_char_has_math(halfword f, halfword c)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ return ci ? ci->math != NULL : 0;
+}
+
+/* Setters: */
+
+void tex_set_lpcode_in_font(halfword f, halfword c, halfword i)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ if (ci) {
+ ci->leftprotrusion = i;
+ }
+}
+
+void tex_set_rpcode_in_font(halfword f, halfword c, halfword i)
+{
+ charinfo *ci = tex_aux_char_info(f, c);
+ if (ci) {
+ ci->rightprotrusion = i;
+ }
+}
+
+void tex_set_efcode_in_font(halfword f, halfword c, halfword i) {
+ charinfo *ci = tex_aux_char_info(f, c);
+ if (ci) {
+ ci->expansion = i;
+ }
+}
+
+void tex_set_font_name(halfword f, const char *s)
+{
+ if (font_name(f)) {
+ lmt_memory_free(font_name(f));
+ }
+ set_font_name(f, s ? lmt_memory_strdup(s) : NULL);
+}
+
+void tex_set_font_original(halfword f, const char *s)
+{
+ if (font_original(f)) {
+ lmt_memory_free(font_original(f));
+ }
+ set_font_original(f, s ? lmt_memory_strdup(s) : NULL);
+}
+
+scaled tex_get_math_font_scale(halfword f, halfword size)
+{
+ scaled scale = 1000;
+ switch (size) {
+ case 2: scale = lmt_font_state.fonts[f]->mathscales[2] ? lmt_font_state.fonts[f]->mathscales[2] : glyph_scriptscript_scale_par; break;
+ case 1: scale = lmt_font_state.fonts[f]->mathscales[1] ? lmt_font_state.fonts[f]->mathscales[1] : glyph_script_scale_par; break;
+ case 0: scale = lmt_font_state.fonts[f]->mathscales[0] ? lmt_font_state.fonts[f]->mathscales[0] : glyph_text_scale_par; break;
+ }
+ return scale ? scale : 1000;
+}
+
+/*tex
+ Experiment.
+*/
+
+void tex_run_font_spec(void)
+{
+ update_tex_font_identifier(font_spec_identifier(cur_chr));
+ if (font_spec_scale(cur_chr) != unused_scale_value) {
+ update_tex_glyph_scale(font_spec_scale(cur_chr));
+ }
+ if (font_spec_x_scale(cur_chr) != unused_scale_value) {
+ update_tex_glyph_x_scale(font_spec_x_scale(cur_chr));
+ }
+ if (font_spec_y_scale(cur_chr) != unused_scale_value) {
+ update_tex_glyph_y_scale(font_spec_y_scale(cur_chr));
+ }
+}
+
diff --git a/source/luametatex/source/tex/texfont.h b/source/luametatex/source/tex/texfont.h
new file mode 100644
index 000000000..a13c6e13d
--- /dev/null
+++ b/source/luametatex/source/tex/texfont.h
@@ -0,0 +1,667 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXFONT_H
+# define LMT_TEXFONT_H
+
+# include "tex/textypes.h"
+
+/*tex
+
+ In the \WEBC\ infrastructrure there is code that deals with endianness of the machine but in
+ \LUAMETATEX\ we don't need this. In \LUATEX\ sharing the format file was already dropped, simply
+ because we can also store \LUA\ bytecode in the format. In the other engines font data can end
+ up in the format file and that in turn then also can be endian dependent. But in \LUAMETATEX\
+ we no longer stored font data, and that is yet another reason why there is no endian related
+ code here.
+
+ The ligature and kern structures are for traditional \TEX\ fonts, thise that are handles by the
+ built in reference handlers. Although \OPENTYPE\ is more versatile, we should not forget that
+ for many (latin) scripts these so called base fonts are quite adequate and efficient. We could
+ of course implement base support in \LUA\ but although \LUAMETATEX\ can delegate a lot, we also
+ keep the reference implementation available: it is well documented, was for a long time the best
+ one could get and doesn't take that much code. So, here come the basic structures:
+
+*/
+
+typedef struct ligatureinfo {
+ int type;
+ int ligature;
+ int adjacent;
+ /* alignment */
+ int padding;
+} ligatureinfo;
+
+typedef struct kerninfo {
+ int kern;
+ int adjacent;
+} kerninfo;
+
+/*tex
+
+ In \LUAMETATEX, at runtime, after a font is loaded via a callback, we only store the little
+ information that is needed for basic ligature building and kerning, math rendering (like
+ extensibles), and par building which includes protrusion and expansion. We don't need anything
+ related to the backend because outpout is delegated to \LUA.
+
+ The most extensive data structures are those related to \OPENTYPE\ math. When passing a font we
+ can save memory by using the |hasmath| directive. In \LUAMETATEX\ we can then have a different
+ |struct| with 15 fields less than in \LUATEX\ which, combined with other savings, saves some 60
+ bytes. The disadvantage is that accessors of those fields also need to act upon that flag, which
+ involves more testing. However, because in practice math font access is not that prominent so
+ the gain outweights this potential performance hit. For an average \CJK\ font with 5000
+ characters we saves 300000 bytes. Because a complete Latin font with various features also can
+ have thousands of glyphs, it can save some memory there too. It's changes like this that give
+ \LUAMETATEX\ a much smaller memory footprint than its predecessor.
+
+ The next record relates to math extensibles. It is good to realize that traditional \TEX\ fonts
+ are handled differently in the math subengine than \OPENTYPE\ math fonts. However, we use the
+ more extensive \OPENTYPE\ structure for both type of fonts.
+
+*/
+
+typedef struct extinfo {
+ struct extinfo *next;
+ int glyph;
+ int start_overlap;
+ int end_overlap;
+ int advance;
+ int extender;
+ /* alignment */
+ int padding;
+} extinfo;
+
+// typedef enum math_font_options {
+// math_font_ignore_italic_option = 0x01,
+// } math_font_options;
+//
+// # define math_font_option(options,option) ((options & option) == option)
+
+typedef struct mathinfo {
+ scaled vertical_italic;
+ scaled top_accent;
+ scaled bottom_accent;
+ int smaller;
+ scaled scale;
+ int flat_accent;
+ int top_left_math_kerns;
+ int top_right_math_kerns;
+ int bottom_right_math_kerns;
+ int bottom_left_math_kerns;
+ extinfo *horizontal_parts;
+ extinfo *vertical_parts;
+ scaled *top_left_math_kern_array;
+ scaled *top_right_math_kern_array;
+ scaled *bottom_right_math_kern_array;
+ scaled *bottom_left_math_kern_array;
+ /* these are for specific (script) anchoring */
+ scaled top_left_kern;
+ scaled bottom_left_kern;
+ scaled top_right_kern;
+ scaled bottom_right_kern;
+ scaled left_margin;
+ scaled right_margin;
+ scaled top_margin;
+ scaled bottom_margin;
+} mathinfo;
+
+typedef struct charinfo {
+ /*tex
+ This is what \TEX\ uses when it calculates the dimensions needed for building boxes and
+ breaking paragraphs into lines. The italic correction is part of that as it has a primitive
+ that needs the value.
+ */
+ scaled width;
+ scaled height;
+ scaled depth;
+ scaled italic;
+ /*tex
+ The next three variables relate to expansion and protrusion, properties introduced in the
+ \PDFTEX\ engine. Handling of protrusion and expansion is the only features that we inherit
+ from this important extension to traditional \TEX.
+ */
+ scaled expansion;
+ scaled leftprotrusion;
+ scaled rightprotrusion;
+ /* halfword padding; */ /* when we pack |tag| and |remainder| we can safe 4 bytes */
+ /*tex
+ These two are used in a \TFM\ file for signaling ligatures. They are also used for math
+ extensions in traditional \TEX\ fonts, so we just keep them.
+ */
+ /* halfword tag; */ /* 2 bits is enough (flags) */
+ /* halfword remainder; */ /* 21 bits is enough (unicode) */
+ halfword tagrem; /* just an integer, less (arm) alignment hassle that way */
+ /*tex
+ Traditional \TEX\ fonts use these two lists for ligature building and inter-character
+ kerning and these are now optional (via pointers). By also using an indirect structure for
+ math data we save quite a bit of memory when we have no math font.
+ */
+ ligatureinfo *ligatures;
+ kerninfo *kerns;
+ mathinfo *math;
+} charinfo;
+
+/*tex
+ We can just abuse the token setters and getters here.
+*/
+
+# define charinfo_tag token_cmd
+# define charinfo_rem token_chr
+# define charinfo_tagrem token_val
+
+/*tex
+
+ For a font instance we only store the bits that are used by the engine itself. Of course more
+ data can (and normally will be) be kept at the \TEX\ cq.\ \LUA\ end.
+
+ We could store a scale (/1000) and avoid copying a font but then we also need to multiply
+ width, height, etc. when queried (extra overhead). A bit tricky is then dealing with (virtual)
+ commands. It is not that big a deal in \CONTEXT\ so I might actually add this feature but only
+ very few documents use many font instances so in the end the gain is neglectable (we only save
+ some memory). Also, we then need to adapt the math processing quite a bit which is always kind
+ of tricky.
+
+ Again, compared to \LUATEX\ there is less data stored here because we don't need to control the
+ backend. Of course in \CONTEXT\ we keep plenty of data at the \LUA\ end, but we did that already
+ anyway.
+
+*/
+
+typedef struct texfont {
+ /*tex the range of (allocated) characters */
+ int first_character;
+ int last_character;
+ /*tex the (sparse) character (glyph) array */
+ sa_tree characters;
+ charinfo *chardata;
+ int chardata_count;
+ int chardata_size;
+ /*tex properties used in messages */
+ int size;
+ int design_size;
+ char *name;
+ char *original;
+ /*tex for experimental new thingies */
+ int compactmath;
+ /*tex default to false when MathConstants not seen */
+ int oldmath;
+ /*tex this controls the engine */
+ int mathcontrol;
+ int textcontrol;
+ /*tex expansion */
+ int max_shrink;
+ int max_stretch;
+ int step;
+ /*tex special characters, see \TEX book */
+ int hyphen_char;
+ int skew_char;
+ /*tex all parameters, although only some are used */
+ int parameter_count;
+ scaled *parameter_base;
+ /* */
+ int padding;
+ /*tex also special */
+ charinfo *left_boundary;
+ charinfo *right_boundary;
+ /*tex all math parameters */
+ scaled *math_parameter_base;
+ int math_parameter_count;
+ /* zero is alignment */
+ int mathscales[3];
+} texfont;
+
+/*tex
+
+ Instead of global variables we store some properties that are shared between the different components
+ in a dedicated struct.
+
+*/
+
+typedef struct font_state_info {
+ texfont **fonts;
+ halfword adjust_stretch;
+ halfword adjust_shrink;
+ halfword adjust_step;
+ int padding;
+ memory_data font_data;
+} font_state_info ;
+
+extern font_state_info lmt_font_state;
+
+# define font_size(a) lmt_font_state.fonts[a]->size
+# define font_name(a) lmt_font_state.fonts[a]->name
+# define font_original(a) lmt_font_state.fonts[a]->original
+# define font_design_size(a) lmt_font_state.fonts[a]->design_size
+# define font_first_character(a) lmt_font_state.fonts[a]->first_character
+# define font_last_character(a) lmt_font_state.fonts[a]->last_character
+/*define font_touched(a) font_state.fonts[a]->touched */
+# define font_oldmath(a) lmt_font_state.fonts[a]->oldmath
+# define font_compactmath(a) lmt_font_state.fonts[a]->compactmath
+# define font_mathcontrol(a) lmt_font_state.fonts[a]->mathcontrol
+# define font_textcontrol(a) lmt_font_state.fonts[a]->textcontrol
+# define font_hyphen_char(a) lmt_font_state.fonts[a]->hyphen_char
+# define font_skew_char(a) lmt_font_state.fonts[a]->skew_char
+# define font_max_shrink(a) (lmt_font_state.adjust_step > 0 ? lmt_font_state.adjust_shrink : lmt_font_state.fonts[a]->max_shrink)
+# define font_max_stretch(a) (lmt_font_state.adjust_step > 0 ? lmt_font_state.adjust_stretch : lmt_font_state.fonts[a]->max_stretch)
+# define font_step(a) (lmt_font_state.adjust_step > 0 ? lmt_font_state.adjust_step : lmt_font_state.fonts[a]->step)
+# define font_mathscale(a,b) lmt_font_state.fonts[a]->mathscales[b]
+
+# define set_font_size(a,b) lmt_font_state.fonts[a]->size = b
+# define set_font_name(a,b) lmt_font_state.fonts[a]->name = b
+# define set_font_original(a,b) lmt_font_state.fonts[a]->original = b
+# define set_font_design_size(a,b) lmt_font_state.fonts[a]->design_size = b
+# define set_font_first_character(a,b) lmt_font_state.fonts[a]->first_character = b
+# define set_font_last_character(a,b) lmt_font_state.fonts[a]->last_character = b
+/*define set_font_touched(a,b) font_state.fonts[a]->touched = b */
+# define set_font_oldmath(a,b) lmt_font_state.fonts[a]->oldmath = b
+# define set_font_compactmath(a,b) lmt_font_state.fonts[a]->compactmath = b
+# define set_font_mathcontrol(a,b) lmt_font_state.fonts[a]->mathcontrol = b
+# define set_font_textcontrol(a,b) lmt_font_state.fonts[a]->textcontrol = b
+# define set_font_hyphen_char(a,b) lmt_font_state.fonts[a]->hyphen_char = b
+# define set_font_skew_char(a,b) lmt_font_state.fonts[a]->skew_char = b
+# define set_font_max_shrink(a,b) lmt_font_state.fonts[a]->max_shrink = b
+# define set_font_max_stretch(a,b) lmt_font_state.fonts[a]->max_stretch = b
+# define set_font_step(a,b) lmt_font_state.fonts[a]->step = b
+
+# define set_font_textsize(a,b) lmt_font_state.fonts[a]->mathscales[0] = b
+# define set_font_scriptsize(a,b) lmt_font_state.fonts[a]->mathscales[1] = b
+# define set_font_scriptscriptsize(a,b) lmt_font_state.fonts[a]->mathscales[2] = b
+
+/*tex
+ These are bound to a font. There might be a few more in the future. An example is collapsing
+ hyphens. One can do that using (in context speak) tlig feature but actually it is some very
+ \TEX\ thing, that happened to be implemented using ligatures. In \LUAMETATEX\ it's also a bit
+ special because, although it is not really dependent on a language, hyphen handling in \TEX\
+ is very present in the hyphenator (also sequences of them). So, naturally it moved there. But
+ users who don't want it can disable it per font.
+*/
+
+typedef enum text_control_codes {
+ text_control_collapse_hyphens = 0x00001,
+} text_control_codes;
+
+# define has_font_text_control(f,c) ((font_textcontrol(f) & c) == c)
+
+/*tex
+
+ These are special codes that are used in the traditional ligature builder. In \OPENTYPE\
+ fonts we don't see these.
+
+*/
+
+typedef enum boundarychar_codes {
+ left_boundary_char = -1,
+ right_boundary_char = -2,
+ non_boundary_char = -3,
+} boundarychar_codes;
+
+/*tex These are pointers, so: |NULL| */
+
+# define font_left_boundary(a) lmt_font_state.fonts[a]->left_boundary
+# define font_right_boundary(a) lmt_font_state.fonts[a]->right_boundary
+
+# define font_has_left_boundary(a) (font_left_boundary(a))
+# define font_has_right_boundary(a) (font_right_boundary(a))
+
+# define set_font_left_boundary(a,b) { if (font_left_boundary(a)) { lmt_memory_free(font_left_boundary(a)); } font_left_boundary(a) = b; }
+# define set_font_right_boundary(a,b) { if (font_right_boundary(a)) { lmt_memory_free(font_right_boundary(a)); } font_right_boundary(a) = b; }
+
+/*tex
+
+ In traditional \TEX\ there are just over a handful of font specific parameters for text fonts
+ and some more in math fonts. Actually, these parameters were stored in a way that permitted
+ adding more at runtime, something that made no real sense, but can be abused for creeating
+ more dimensions than the 256 that traditional \TEX\ provides.
+
+*/
+
+# define font_parameter_count(a) lmt_font_state.fonts[a]->parameter_count
+# define font_parameter_base(a) lmt_font_state.fonts[a]->parameter_base
+# define font_parameter(a,b) lmt_font_state.fonts[a]->parameter_base[b]
+
+# define font_math_parameter_count(a) lmt_font_state.fonts[a]->math_parameter_count
+# define font_math_parameter_base(a) lmt_font_state.fonts[a]->math_parameter_base
+# define font_math_parameter(a,b) lmt_font_state.fonts[a]->math_parameter_base[b]
+
+# define set_font_parameter_base(a,b) lmt_font_state.fonts[a]->parameter_base = b;
+# define set_font_math_parameter_base(a,b) lmt_font_state.fonts[a]->math_parameter_base = b;
+
+/*tex
+
+ These font parameters could be adapted at runtime but one should really wonder if that is such
+ a good idea nowadays.
+
+ */
+
+//define set_font_parameter(f,n,b) { if (font_parameter_count(f) < n) { tex_set_font_parameters(f, n); } font_parameter(f, n) = b; }
+// # define set_font_math_parameter(f,n,b) { if (font_math_parameter_count(f) < n) { tex_set_font_math_parameters(f, n); } font_math_parameter(f, n) = b; }
+
+extern void tex_set_font_parameters (halfword f, int b);
+extern void tex_set_font_math_parameters (halfword f, int b);
+extern int tex_get_font_max_id (void);
+extern int tex_get_font_max_id (void);
+
+extern halfword tex_checked_font_adjust (
+ halfword adjust_spacing,
+ halfword adjust_spacing_step,
+ halfword adjust_spacing_shrink,
+ halfword adjust_spacing_stretch
+);
+
+/*tex
+
+ Font parameters are sometimes referred to as |slant(f)|, |space(f)|, etc. These numbers are
+ also the font dimen numbers.
+
+*/
+
+typedef enum font_parameter_codes {
+ slant_code = 1,
+ space_code,
+ space_stretch_code,
+ space_shrink_code,
+ ex_height_code,
+ em_width_code,
+ extra_space_code,
+} font_parameter_codes;
+
+extern scaled tex_get_font_slant (halfword f);
+extern scaled tex_get_font_space (halfword f);
+extern scaled tex_get_font_space_stretch (halfword f);
+extern scaled tex_get_font_space_shrink (halfword f);
+extern scaled tex_get_font_ex_height (halfword f);
+extern scaled tex_get_font_em_width (halfword f);
+extern scaled tex_get_font_extra_space (halfword f);
+extern scaled tex_get_font_parameter (halfword f, halfword code);
+extern void tex_set_font_parameter (halfword f, halfword code, scaled v);
+
+extern scaled tex_get_scaled_space (halfword f);
+extern scaled tex_get_scaled_space_stretch (halfword f);
+extern scaled tex_get_scaled_space_shrink (halfword f);
+extern scaled tex_get_scaled_ex_height (halfword f);
+extern scaled tex_get_scaled_em_width (halfword f);
+extern scaled tex_get_scaled_extra_space (halfword f);
+extern scaled tex_get_scaled_parameter (halfword f, halfword code);
+extern void tex_set_scaled_parameter (halfword f, halfword code, scaled v);
+
+extern halfword tex_get_scaled_glue (halfword f);
+extern halfword tex_get_scaled_parameter_glue (quarterword p, quarterword s);
+extern halfword tex_get_parameter_glue (quarterword p, quarterword s);
+
+extern halfword tex_get_font_identifier (halfword fs);
+
+/*tex
+
+ The \OPENTYPE\ math fonts have four edges and reference points for kerns. Here we go:
+
+*/
+
+typedef enum font_math_kern_codes {
+ top_right_kern = 1,
+ bottom_right_kern,
+ bottom_left_kern,
+ top_left_kern,
+} font_math_kern_codes;
+
+extern charinfo *tex_get_charinfo (halfword f, int c);
+extern int tex_char_exists (halfword f, int c);
+extern void tex_char_process (halfword f, int c);
+extern int tex_math_char_exists (halfword f, int c, int size);
+extern int tex_get_math_char (halfword f, int c, int size, scaled *scale);
+
+/*tex
+
+ Here is a quick way to test if a glyph exists, when you are already certain the font |f| exists,
+ and that the |c| is a regular glyph id, not one of the two special boundary objects. Contrary
+ to traditional \TEX\ we store character information in a hash table instead of an array. Keep
+ in mind that we talk \UNICODE: plenty of characters in the code space, but less so in a font,
+ so we can best be sparse.
+
+*/
+
+# define quick_char_exists(f,c) (sa_get_item_4(lmt_font_state.fonts[f]->characters,c).int_value)
+
+/*tex
+ These low level setters are not publis and used in helpers. They might become functions
+ when I feel the need.
+*/
+
+# define set_charinfo_width(ci,val) ci->width = val;
+# define set_charinfo_height(ci,val) ci->height = val;
+# define set_charinfo_depth(ci,val) ci->depth = val;
+# define set_charinfo_italic(ci,val) ci->italic = val;
+# define set_charinfo_expansion(ci,val) ci->expansion = val;
+# define set_charinfo_leftprotrusion(ci,val) ci->leftprotrusion = val;
+# define set_charinfo_rightprotrusion(ci,val) ci->rightprotrusion = val;
+
+# define set_charinfo_tag(ci,tag) ci->tagrem = charinfo_tagrem(charinfo_tag(ci->tagrem) | tag,charinfo_rem(ci->tagrem));
+# define set_charinfo_remainder(ci,rem) ci->tagrem = charinfo_tagrem(charinfo_tag(ci->tagrem),rem);
+
+# define has_charinfo_tag(ci,p) (charinfo_tag(ci->tagrem) & (p) == (p))
+# define get_charinfo_tag(ci) charinfo_tag(ci->tagrem)
+
+# define set_charinfo_ligatures(ci,val) { lmt_memory_free(ci->ligatures); ci->ligatures = val; }
+# define set_charinfo_kerns(ci,val) { lmt_memory_free(ci->kerns); ci->kerns = val; }
+# define set_charinfo_math(ci,val) { lmt_memory_free(ci->math); ci->math = val; }
+
+# define set_charinfo_top_left_math_kern_array(ci,val) if (ci->math) { lmt_memory_free(ci->math->top_left_math_kern_array); ci->math->top_left_math_kern_array = val; }
+# define set_charinfo_top_right_math_kern_array(ci,val) if (ci->math) { lmt_memory_free(ci->math->top_right_math_kern_array); ci->math->top_left_math_kern_array = val; }
+# define set_charinfo_bottom_right_math_kern_array(ci,val) if (ci->math) { lmt_memory_free(ci->math->bottom_right_math_kern_array); ci->math->top_left_math_kern_array = val; }
+# define set_charinfo_bottom_left_math_kern_array(ci,val) if (ci->math) { lmt_memory_free(ci->math->bottom_left_math_kern_array); ci->math->top_left_math_kern_array = val; }
+
+//define set_charinfo_options(ci,val) if (ci->math) { ci->math->options = val; }
+
+# define set_ligature_item(f,b,c,d) { f.type = b; f.adjacent = c; f.ligature = d; }
+# define set_kern_item(f,b,c) { f.adjacent = b; f.kern = c; }
+
+# define set_charinfo_left_margin(ci,val) if (ci->math) { ci->math->left_margin = val; }
+# define set_charinfo_right_margin(ci,val) if (ci->math) { ci->math->right_margin = val; }
+# define set_charinfo_top_margin(ci,val) if (ci->math) { ci->math->top_margin = val; }
+# define set_charinfo_bottom_margin(ci,val) if (ci->math) { ci->math->bottom_margin = val; }
+
+# define set_charinfo_smaller(ci,val) if (ci->math) { ci->math->smaller = val; }
+# define set_charinfo_vertical_italic(ci,val) if (ci->math) { ci->math->vertical_italic = val; }
+# define set_charinfo_top_accent(ci,val) if (ci->math) { ci->math->top_accent = val; }
+# define set_charinfo_bottom_accent(ci,val) if (ci->math) { ci->math->bottom_accent = val; }
+# define set_charinfo_flat_accent(ci,val) if (ci->math) { ci->math->flat_accent = val; }
+
+# define set_charinfo_top_left_kern(ci,val) if (ci->math) { ci->math->top_left_kern = val; }
+# define set_charinfo_top_right_kern(ci,val) if (ci->math) { ci->math->top_right_kern = val; }
+# define set_charinfo_bottom_left_kern(ci,val) if (ci->math) { ci->math->bottom_left_kern = val; }
+# define set_charinfo_bottom_right_kern(ci,val) if (ci->math) { ci->math->bottom_right_kern = val; }
+
+/*tex Setters: */
+
+void tex_set_lpcode_in_font (halfword f, halfword c, halfword i);
+void tex_set_rpcode_in_font (halfword f, halfword c, halfword i);
+void tex_set_efcode_in_font (halfword f, halfword c, halfword i);
+
+extern void tex_set_charinfo_extensible (charinfo *ci, int top, int bottom, int middle, int extender);
+extern void tex_add_charinfo_math_kern (charinfo *ci, int type, scaled ht, scaled krn);
+extern int tex_get_charinfo_math_kerns (charinfo *ci, int id);
+extern void tex_set_charinfo_horizontal_parts (charinfo *ci, extinfo *ext);
+extern void tex_set_charinfo_vertical_parts (charinfo *ci, extinfo *ext);
+extern void tex_add_charinfo_vertical_part (charinfo *ci, extinfo *ext);
+extern void tex_add_charinfo_horizontal_part (charinfo *ci, extinfo *ext);
+extern extinfo *tex_new_charinfo_part (int glyph, int startconnect, int endconnect, int advance, int repeater);
+
+/*tex Checkers: */
+
+int tex_char_has_math (halfword f, halfword c);
+int tex_has_ligature (halfword f, halfword c);
+int tex_has_kern (halfword f, halfword c);
+
+/*tex Getters: */
+
+# define MATH_KERN_NOT_FOUND 0x7FFFFFFF
+
+extern scaled tex_char_width_from_font (halfword f, halfword c); /* math + maincontrol */
+extern scaled tex_char_height_from_font (halfword f, halfword c); /* math + maincontrol */
+extern scaled tex_char_depth_from_font (halfword f, halfword c); /* math + maincontrol */
+extern scaled tex_char_total_from_font (halfword f, halfword c); /* math */
+extern scaled tex_char_italic_from_font (halfword f, halfword c); /* math + maincontrol */
+// halfword tex_char_options_from_font (halfword f, halfword c);
+extern scaled tex_char_ef_from_font (halfword f, halfword c); /* packaging + maincontrol */
+extern scaled tex_char_lp_from_font (halfword f, halfword c); /* packaging + maincontrol */
+extern scaled tex_char_rp_from_font (halfword f, halfword c); /* packaging + maincontrol */
+extern halfword tex_char_tag_from_font (halfword f, halfword c); /* math */
+extern halfword tex_char_remainder_from_font (halfword f, halfword c); /* math */
+extern halfword tex_char_has_tag_from_font (halfword f, halfword c, halfword tag);
+extern void tex_char_reset_tag_from_font (halfword f, halfword c, halfword tag);
+// int tex_char_has_option_from_font (halfword g, halfword c, int option);
+
+extern scaled tex_char_top_left_kern_from_font (halfword f, halfword c); /* math */
+extern scaled tex_char_top_right_kern_from_font (halfword f, halfword c); /* math */
+extern scaled tex_char_bottom_left_kern_from_font (halfword f, halfword c); /* math */
+extern scaled tex_char_bottom_right_kern_from_font (halfword f, halfword c); /* math */
+
+extern scaledwhd tex_char_whd_from_font (halfword f, halfword c); /* math + maincontrol */
+
+extern scaled tex_font_x_scaled (scaled v);
+extern scaled tex_font_y_scaled (scaled v);
+
+extern scaled tex_char_width_from_glyph (halfword g); /* x/y scaled */
+extern scaled tex_char_height_from_glyph (halfword g); /* x/y scaled */
+extern scaled tex_char_depth_from_glyph (halfword g); /* x/y scaled */
+extern scaled tex_char_total_from_glyph (halfword g); /* x/y scaled */
+extern scaled tex_char_italic_from_glyph (halfword g); /* x/y scaled */
+// int tex_char_options_from_glyph (halfword g);
+extern scaled tex_char_width_italic_from_glyph (halfword g); /* x/y scaled */
+// int tex_char_has_option_from_glyph (halfword g, int option);
+
+extern scaledwhd tex_char_whd_from_glyph (halfword g); /* x/y scaled */
+
+extern halfword tex_char_vertical_italic_from_font (halfword f, halfword c);
+extern halfword tex_char_top_accent_from_font (halfword f, halfword c);
+extern halfword tex_char_bot_accent_from_font (halfword f, halfword c);
+extern halfword tex_char_flat_accent_from_font (halfword f, halfword c);
+
+extern halfword tex_char_top_anchor_from_font (halfword f, halfword c);
+extern halfword tex_char_bot_anchor_from_font (halfword f, halfword c);
+
+extern scaled tex_char_left_margin_from_font (halfword f, halfword c);
+extern scaled tex_char_right_margin_from_font (halfword f, halfword c);
+extern scaled tex_char_top_margin_from_font (halfword f, halfword c);
+extern scaled tex_char_bottom_margin_from_font (halfword f, halfword c);
+
+extern extinfo *tex_char_vertical_parts_from_font (halfword f, halfword c);
+extern extinfo *tex_char_horizontal_parts_from_font (halfword f, halfword c);
+
+/* scaled tex_math_kern_at (halfword f, int c, int side, int v); */
+/* scaled tex_find_math_kern (halfword l_f, int l_c, halfword r_f, int r_c, int cmd, scaled shift); */
+
+extern int tex_valid_kern (halfword left, halfword right); /* returns kern */
+extern int tex_valid_ligature (halfword left, halfword right, int *slot); /* returns type */
+
+extern scaled tex_calculated_char_width (halfword f, halfword c, halfword ex);
+extern scaled tex_calculated_glyph_width (halfword g, halfword ex); /* scale */
+
+/*
+ Kerns: the |otherchar| value signals \quote {stop}. These are not really public and only
+ to be used in the helpers. But we keep them as reference.
+*/
+
+# define end_kern 0x7FFFFF
+
+# define charinfo_kern(b,c) b->kerns[c]
+
+# define kern_char(b) (b).adjacent
+# define kern_kern(b) (b).kern
+# define kern_end(b) ((b).adjacent == end_kern)
+# define kern_disabled(b) ((b).adjacent > end_kern)
+
+/*
+ Ligatures: the |otherchar| value signals \quote {stop}. These are not really public and only
+ to be used in the helpers. But we keep them as reference.
+*/
+
+# define end_of_ligature_code 0x7FFFFF
+
+# define charinfo_ligature(b,c) b->ligatures[c]
+
+# define ligature_is_valid(a) ((a).type != 0)
+# define ligature_type(a) ((a).type >> 1)
+# define ligature_char(a) (a).adjacent
+# define ligature_replacement(a) (a).ligature
+# define ligature_end(a) ((a).adjacent == end_of_ligature_code)
+# define ligature_disabled(a) ((a).adjacent > end_of_ligature_code)
+
+/* Remainders and related flags: */
+
+typedef enum math_extension_modes {
+ math_extension_normal,
+ math_extension_repeat,
+} math_extension_modes;
+
+/* Expansion */
+
+typedef enum adjust_spacing_modes {
+ adjust_spacing_off,
+ adjust_spacing_unused,
+ adjust_spacing_full,
+ adjust_spacing_font,
+} adjust_spacing_modes;
+
+typedef enum protrude_chars_modes {
+ protrude_chars_off,
+ protrude_chars_unused,
+ protrude_chars_normal,
+ protrude_chars_advanced,
+} protrude_chars_modes;
+
+/*
+typedef enum math_extension_locations {
+ extension_top,
+ extension_bottom,
+ extension_middle,
+ extension_repeat,
+} math_extension_locations;
+*/
+
+/* Tags: */
+
+typedef enum tag_codes {
+ no_tag = 0x00, /*tex vanilla character */
+ ligature_tag = 0x01, /*tex character has a ligature/kerning program */
+ list_tag = 0x02, /*tex character has a successor in a charlist */
+ extension_tag = 0x04, /*tex character is extensible */
+ callback_tag = 0x08,
+ extend_last_tag = 0x10,
+} tag_codes;
+
+extern halfword tex_checked_font (halfword f);
+extern int tex_is_valid_font (halfword f);
+extern int tex_raw_get_kern (halfword f, int lc, int rc);
+extern int tex_get_kern (halfword f, int lc, int rc);
+extern ligatureinfo tex_get_ligature (halfword f, int lc, int rc);
+extern int tex_new_font (void);
+extern int tex_new_font_id (void);
+extern void tex_font_malloc_charinfo (halfword f, int num);
+extern void tex_char_malloc_mathinfo (charinfo * ci);
+extern void tex_dump_font_data (dumpstream f);
+extern void tex_undump_font_data (dumpstream f);
+extern void tex_create_null_font (void);
+extern void tex_delete_font (int id);
+extern int tex_read_font_info (char *cnom, scaled s);
+extern int tex_fix_expand_value (halfword f, int e);
+
+extern halfword tex_handle_glyphrun (halfword head, halfword group, halfword direction);
+extern halfword tex_handle_ligaturing (halfword head, halfword tail);
+extern halfword tex_handle_kerning (halfword head, halfword tail);
+
+extern void tex_set_cur_font (halfword g, halfword f);
+extern int tex_tex_def_font (int a);
+
+extern void tex_char_warning (halfword f, int c);
+
+extern void tex_initialize_fonts (void);
+
+extern void tex_set_font_name (halfword f, const char *s);
+extern void tex_set_font_original (halfword f, const char *s);
+
+extern scaled tex_get_math_font_scale (halfword f, halfword size);
+
+extern void tex_run_font_spec (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texinputstack.c b/source/luametatex/source/tex/texinputstack.c
new file mode 100644
index 000000000..9823fe137
--- /dev/null
+++ b/source/luametatex/source/tex/texinputstack.c
@@ -0,0 +1,1159 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+input_state_info lmt_input_state = {
+ .input_stack = NULL,
+ .input_stack_data = {
+ .minimum = min_stack_size,
+ .maximum = max_stack_size,
+ .size = siz_stack_size,
+ .step = stp_stack_size,
+ .allocated = 0,
+ .itemsize = sizeof(in_state_record),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .in_stack = NULL,
+ .in_stack_data = {
+ .minimum = min_in_open,
+ .maximum = max_in_open,
+ .size = siz_in_open,
+ .step = stp_in_open,
+ .allocated = 0,
+ .itemsize = sizeof(input_stack_record),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .parameter_stack = NULL,
+ .parameter_stack_data = {
+ .minimum = min_parameter_size,
+ .maximum = max_parameter_size,
+ .size = siz_parameter_size,
+ .step = stp_parameter_size,
+ .allocated = 0,
+ .itemsize = sizeof(halfword),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .cur_input = { 0 },
+ .input_line = 0,
+ .scanner_status = 0,
+ .def_ref = 0,
+ .align_state = 0,
+ .base_ptr = 0,
+ .warning_index = 0,
+ .open_files = 0,
+ .padding = 0,
+} ;
+
+input_file_state_info input_file_state = {
+ .forced_file = 0,
+ .forced_line = 0,
+ .mode = 0,
+ .line = 0,
+};
+
+#define reserved_input_stack_slots 2
+#define reserved_in_stack_slots 2
+#define reserved_param_stack_slots 10 /*tex We play safe and always keep 10 in reserve (we have 9 max anyway). */
+
+void tex_initialize_input_state(void)
+{
+ {
+ int size = lmt_input_state.input_stack_data.minimum;
+ lmt_input_state.input_stack = aux_allocate_clear_array(sizeof(in_state_record), size, reserved_input_stack_slots);
+ if (lmt_input_state.input_stack) {
+ lmt_input_state.input_stack_data.allocated = size;
+ } else {
+ tex_overflow_error("input", size);
+ }
+ }
+ {
+ int size = lmt_input_state.in_stack_data.minimum;
+ lmt_input_state.in_stack = aux_allocate_clear_array(sizeof(input_stack_record), size, reserved_in_stack_slots);
+ if (lmt_input_state.in_stack) {
+ lmt_input_state.in_stack_data.allocated = size;
+ } else {
+ tex_overflow_error("file", size);
+ }
+ }
+ {
+ int size = lmt_input_state.parameter_stack_data.minimum;
+ lmt_input_state.parameter_stack = aux_allocate_clear_array(sizeof(halfword), size, reserved_param_stack_slots);
+ if (lmt_input_state.parameter_stack) {
+ lmt_input_state.parameter_stack_data.allocated = size;
+ } else {
+ tex_overflow_error("parameter", size);
+ }
+ }
+}
+
+static int tex_aux_room_on_input_stack(void) /* quite similar to save_stack checker so maybe share */
+{
+ int top = lmt_input_state.input_stack_data.ptr;
+ if (top > lmt_input_state.input_stack_data.top) {
+ lmt_input_state.input_stack_data.top = top;
+ if (top > lmt_input_state.input_stack_data.allocated) {
+ in_state_record *tmp = NULL;
+ top = lmt_input_state.input_stack_data.allocated + lmt_input_state.input_stack_data.step;
+ if (top > lmt_input_state.input_stack_data.size) {
+ top = lmt_input_state.input_stack_data.size;
+ }
+ if (top > lmt_input_state.input_stack_data.allocated) {
+ lmt_input_state.input_stack_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_input_state.input_stack, sizeof(in_state_record), top, reserved_input_stack_slots);
+ lmt_input_state.input_stack = tmp;
+ }
+ lmt_run_memory_callback("input", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("input", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+static int tex_aux_room_on_in_stack(void) /* quite similar to save_stack checker so maybe share */
+{
+ int top = lmt_input_state.in_stack_data.ptr;
+ if (top > lmt_input_state.in_stack_data.top) {
+ lmt_input_state.in_stack_data.top = top;
+ if (top > lmt_input_state.in_stack_data.allocated) {
+ input_stack_record *tmp = NULL;
+ top = lmt_input_state.in_stack_data.allocated + lmt_input_state.in_stack_data.step;
+ if (top > lmt_input_state.in_stack_data.size) {
+ top = lmt_input_state.in_stack_data.size;
+ }
+ if (top > lmt_input_state.in_stack_data.allocated) {
+ lmt_input_state.in_stack_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_input_state.in_stack, sizeof(input_stack_record), top, reserved_in_stack_slots);
+ lmt_input_state.in_stack = tmp;
+ }
+ lmt_run_memory_callback("file", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("file", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+static int tex_aux_room_on_param_stack(void) /* quite similar to save_stack checker so maybe share */
+{
+ int top = lmt_input_state.parameter_stack_data.ptr;
+ if (top > lmt_input_state.parameter_stack_data.top) {
+ lmt_input_state.parameter_stack_data.top = top;
+ if (top > lmt_input_state.parameter_stack_data.allocated) {
+ halfword *tmp = NULL;
+ top = lmt_input_state.parameter_stack_data.allocated + lmt_input_state.parameter_stack_data.step;
+ if (top > lmt_input_state.parameter_stack_data.size) {
+ top = lmt_input_state.parameter_stack_data.size;
+ }
+ if (top > lmt_input_state.parameter_stack_data.allocated) {
+ lmt_input_state.parameter_stack_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_input_state.parameter_stack, sizeof(halfword), top, reserved_param_stack_slots);
+ lmt_input_state.parameter_stack = tmp;
+ }
+ lmt_run_memory_callback("parameter", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("parameter", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+void tex_copy_pstack_to_param_stack(halfword *pstack, int n)
+{
+ if (tex_aux_room_on_param_stack()) {
+ memcpy(&lmt_input_state.parameter_stack[lmt_input_state.parameter_stack_data.ptr], pstack, n * sizeof(halfword));
+ lmt_input_state.parameter_stack_data.ptr += n;
+ }
+}
+
+/*tex
+
+ As elsewhere we keep variables that belong together in a structure: |input_stack|, the first
+ unused location of |input_stack| being |input_ptr|, the largest value of |input_ptr| when
+ pushing |max_input_stack|, the the \quote {top} input state|cur_input|, the number of lines in
+ the buffer, less one, |in_open|, the number of open text files |open_files| (in regular \TEX\
+ called |open_parens| because it relates to the way files are reported), the |input_file| and
+ the current line number in the current source file |line|. Furthermore some stacks:
+ |line_stack|. |source_filename_stack| and |full_source_filename_stack|. The |scanner_status|
+ tells if we can a end a subfile now. There is an obscure identifier relevant to non-|normal|
+ scanner status |warning_index|. Then there is the often used reference count pointer of token
+ list being defined: |def_ref|.
+
+ Here is a procedure that uses |scanner_status| to print a warning message when a subfile has
+ ended, and at certain other crucial times. Actually it is only called when we run out of
+ token memory. Because memory errors can be of any kind, we normall will not use the \TEX\
+ error handler (but we do have a callback).
+
+ Similar code is is us in |texerrors.c| for use with the error callback. Maybe some day that
+ will be default.
+
+*/
+
+void tex_show_validity(void)
+{
+ halfword p = null;
+ switch (lmt_input_state.scanner_status) {
+ case scanner_is_defining:
+ p = lmt_input_state.def_ref;
+ break;
+ case scanner_is_matching:
+ case scanner_is_tolerant:
+ p = tex_expand_match_token_head();
+ break;
+ case scanner_is_aligning:
+ p = tex_alignment_hold_token_head();
+ break;
+ case scanner_is_absorbing:
+ p = lmt_input_state.def_ref;
+ break;
+ }
+ if (p) {
+ tex_print_ln();
+ tex_token_show(p, default_token_show_max > lmt_error_state.line_limits.size - 10 ? lmt_error_state.line_limits.size - 10 : default_token_show_max);
+ tex_print_ln();
+ }
+}
+
+void tex_show_runaway(void)
+{
+ if (lmt_input_state.scanner_status > scanner_is_skipping) {
+ tex_print_nlp();
+ switch (lmt_input_state.scanner_status) {
+ case scanner_is_defining:
+ tex_print_str("We ran into troubles when scanning a definition.");
+ break;
+ case scanner_is_matching:
+ tex_print_str("We ran into troubles scanning an argument.");
+ break;
+ case scanner_is_tolerant:
+ return;
+ case scanner_is_aligning:
+ tex_print_str("We ran into troubles scanning an alignment preamle.");
+ break;
+ case scanner_is_absorbing:
+ tex_print_str("We ran into troubles absorbing something.");
+ break;
+ default:
+ return;
+ }
+ tex_print_nlp();
+ tex_show_validity();
+ }
+}
+
+/*tex
+
+ The |param_stack| is an auxiliary array used to hold pointers to the token lists for parameters
+ at the current level and subsidiary levels of input. This stack is maintained with convention
+ (2), and it grows at a different rate from the others.
+
+ So, the token list pointers for parameters is |param_stack|, the first unused entry in
+ |param_stack| is |param_ptr| which is in the range |0 .. param_size + 9|.
+
+ The input routines must also interact with the processing of |\halign| and |\valign|, since the
+ appearance of tab marks and |\cr| in certain places is supposed to trigger the beginning of
+ special |v_j| template text in the scanner. This magic is accomplished by an |align_state|
+ variable that is increased by~1 when a |\char'173| is scanned and decreased by~1 when a |\char
+ '175| is scanned. The |align_state| is nonzero during the $u_j$ template, after which it is set
+ to zero; the |v_j| template begins when a tab mark or |\cr| occurs at a time that |align_state
+ = 0|.
+
+ Thus, the \quote {current input state} can be very complicated indeed; there can be many levels
+ and each level can arise in a variety of ways. The |show_context| procedure, which is used by
+ \TEX's error-reporting routine to print out the current input state on all levels down to the
+ most recent line of characters from an input file, illustrates most of these conventions. The
+ global variable |base_ptr| contains the lowest level that was displayed by this procedure.
+
+ The status at each level is indicated by printing two lines, where the first line indicates
+ what was read so far and the second line shows what remains to be read. The context is cropped,
+ if necessary, so that the first line contains at most |half_error_line| characters, and the
+ second contains at most |error_line|. Non-current input levels whose |token_type| is |backed_up|
+ are shown only if they have not been fully read.
+
+ When applicable, print the location of the current line. This routine should be changed, if
+ necessary, to give the best possible indication of where the current line resides in the input
+ file. For example, on some systems it is best to print both a page and line number.
+
+ Because we also have \LUA\ input en output and because error messages and contexts can go
+ through \LUA, reporting is a bit different in \LUAMETATEX.
+
+*/
+
+static void tex_aux_print_indent(void)
+{
+ for (int q = 1; q <= lmt_error_state.context_indent; q++) {
+ tex_print_char(' ');
+ }
+}
+
+static void tex_aux_print_current_input_state(void)
+{
+ int macro = 0;
+ tex_print_str("<");
+ if (lmt_input_state.cur_input.state == token_list_state) {
+ switch (lmt_input_state.cur_input.token_type) {
+ case parameter_text:
+ tex_print_str("argument");
+ break;
+ case template_pre_text:
+ tex_print_str("templatepre");
+ break;
+ case template_post_text:
+ tex_print_str("templatepost");
+ break;
+ case backed_up_text:
+ tex_print_str(lmt_input_state.cur_input.loc ? "to be read again" : "recently read");
+ break;
+ case inserted_text:
+ tex_print_str("inserted text");
+ break;
+ case macro_text:
+ tex_print_str("macro");
+ macro = lmt_input_state.cur_input.name;
+ break;
+ case output_text:
+ tex_print_str("output");
+ break;
+ case every_par_text:
+ tex_print_str("everypar");
+ break;
+ case every_math_text:
+ tex_print_str("everymath");
+ break;
+ case every_display_text:
+ tex_print_str("everydisplay");
+ break;
+ case every_hbox_text:
+ tex_print_str("everyhbox");
+ break;
+ case every_vbox_text:
+ tex_print_str("everyvbox");
+ break;
+ case every_math_atom_text:
+ tex_print_str("everymathatom");
+ break;
+ case every_job_text:
+ tex_print_str("everyjob");
+ break;
+ case every_cr_text:
+ tex_print_str("everycr");
+ break;
+ case every_tab_text:
+ tex_print_str("everytab");
+ break;
+ case end_of_group_text:
+ tex_print_str("endofgroup");
+ break;
+ case mark_text:
+ tex_print_str("mark");
+ break;
+ case loop_text:
+ tex_print_str("loop");
+ break;
+ case every_eof_text:
+ tex_print_str("everyeof");
+ break;
+ case every_before_par_text:
+ tex_print_str("everybeforepar");
+ break;
+ case end_paragraph_text:
+ tex_print_str("endpar");
+ break;
+ case write_text:
+ tex_print_str("write");
+ break;
+ case local_text:
+ tex_print_str("local");
+ break;
+ case local_loop_text:
+ tex_print_str("localloop");
+ break;
+ default:
+ tex_print_str("unknown");
+ break;
+ }
+ } else {
+ switch (lmt_input_state.cur_input.name) {
+ case io_initial_input_code:
+ tex_print_str("initial");
+ break;
+ case io_lua_input_code:
+ tex_print_str("lua output");
+ break;
+ case io_token_input_code:
+ case io_token_eof_input_code:
+ tex_print_str("scantokens");
+ break;
+ case io_tex_macro_code:
+ case io_file_input_code:
+ default:
+ {
+ /* Todo : figure out what the weird line is when we have a premature file end. */
+ tex_print_str("line ");
+ tex_print_int(lmt_input_state.cur_input.index);
+ tex_print_char('.');
+ tex_print_int(lmt_input_state.cur_input.index == lmt_input_state.in_stack_data.ptr ? lmt_input_state.input_line : lmt_input_state.in_stack[lmt_input_state.cur_input.index + 1].line);
+ }
+ break;
+ }
+ }
+ tex_print_str("> ");
+ if (macro) {
+ tex_print_cs_checked(macro);
+ }
+}
+
+/*tex
+
+ Here it is necessary to explain a little trick. We don't want to store a long string that
+ corresponds to a token list, because that string might take up lots of memory; and we are
+ printing during a time when an error message is being given, so we dare not do anything that
+ might overflow one of \TEX's tables. So \quote {pseudoprinting} is the answer: We enter a mode
+ of printing that stores characters into a buffer of length |error_line|, where character $k +
+ 1$ is placed into |trick_buf [k mod error_line]| if |k < trick_count|, otherwise character |k|
+ is dropped. Initially we set |tally := 0| and |trick_count := 1000000|; then when we reach the
+ point where transition from line 1 to line 2 should occur, we set |first_count := tally| and
+ |trick_count := tmax > (error_line, tally + 1 + error_line - half_error_line)|. At the end
+ of the pseudoprinting, the values of |first_count|, |tally|, and |trick_count| give us all the
+ information we need to print the two lines, and all of the necessary text is in |trick_buf|.
+
+ Namely, let |l| be the length of the descriptive information that appears on the first line.
+ The length of the context information gathered for that line is |k = first_count|, and the
+ length of the context information gathered for line~2 is $m=\min(|tally|, |trick_count|) - k$.
+ If |l + k <= h|, where |h = half_error_line|, we print |trick_buf[0 .. k-1]| after the
+ descriptive information on line~1, and set |n := l + k|; here |n| is the length of line~1. If
+ |l + k > h|, some cropping is necessary, so we set |n := h| and print |...| followed by
+ |trick_buf[(l + k - h + 3) .. k - 1]| where subscripts of |trick_buf| are circular modulo
+ |error_line|. The second line consists of |n|~spaces followed by |trick_buf[k .. (k + m - 1)]|,
+ unless |n + m > error_line|; in the latter case, further cropping is done. This is easier to
+ program than to explain.
+
+ The following code sets up the print routines so that they will gather the desired information.
+
+*/
+
+void tex_set_trick_count(void)
+{
+ lmt_print_state.first_count = lmt_print_state.tally;
+ lmt_print_state.trick_count = lmt_print_state.tally + 1 + lmt_error_state.line_limits.size - lmt_error_state.half_line_limits.size;
+ if (lmt_print_state.trick_count < lmt_error_state.line_limits.size) {
+ lmt_print_state.trick_count = lmt_error_state.line_limits.size;
+ }
+}
+
+/*tex
+
+ We don't care too much if we stay a bit too much below the max error_line even if we have more
+ room on the line. If length is really an issue then any length is. After all one can set the
+ length larger.
+
+*/
+
+static void tex_aux_print_valid_utf8(int q)
+{
+ int l = lmt_error_state.line_limits.size;
+ int c = (int) lmt_print_state.trick_buffer[q % l];
+ if (c < 128) {
+ tex_print_char(c);
+ } else if (c < 194) {
+ /* invalid */
+ } else if (c < 224) {
+ tex_print_char(c);
+ tex_print_char(lmt_print_state.trick_buffer[(q + 1) % l]);
+ } else if (c < 240) {
+ tex_print_char(c);
+ tex_print_char(lmt_print_state.trick_buffer[(q + 1) % l]);
+ tex_print_char(lmt_print_state.trick_buffer[(q + 2) % l]);
+ } else if (c < 245) {
+ tex_print_char(c);
+ tex_print_char(lmt_print_state.trick_buffer[(q + 1) % l]);
+ tex_print_char(lmt_print_state.trick_buffer[(q + 2) % l]);
+ tex_print_char(lmt_print_state.trick_buffer[(q + 3) % l]);
+ } else {
+ /*tex Invalid character! */
+ }
+}
+
+void tex_show_context(void)
+{
+ int context_lines = -1; /*tex Number of contexts shown so far, less one: */
+ int bottom_line = 0; /*tex Have we reached the final context to be shown? */
+ lmt_input_state.base_ptr = lmt_input_state.input_stack_data.ptr;
+ lmt_input_state.input_stack[lmt_input_state.base_ptr] = lmt_input_state.cur_input;
+ while (1) {
+ /*tex Enter into the context. */
+ lmt_input_state.cur_input = lmt_input_state.input_stack[lmt_input_state.base_ptr];
+ if ((lmt_input_state.cur_input.state != token_list_state) && (io_file_input(lmt_input_state.cur_input.name) || (lmt_input_state.base_ptr == 0))) {
+ bottom_line = 1;
+ }
+ if ((lmt_input_state.base_ptr == lmt_input_state.input_stack_data.ptr) || bottom_line || (context_lines < error_context_lines_par)) {
+ /*tex Display the current context. */
+ if ((lmt_input_state.base_ptr == lmt_input_state.input_stack_data.ptr) || (lmt_input_state.cur_input.state != token_list_state) || (lmt_input_state.cur_input.token_type != backed_up_text) || (lmt_input_state.cur_input.loc)) {
+ /*tex
+ We omit backed-up token lists that have already been read. Get ready to count
+ characters. We start pseudo printing.
+
+ This is complex code. When we display a context, we loop over context lines, but
+ actually we're talking of two lines: the discriptive line and the token list or
+ something from the buffer. Then there is that trick buffer stuff. In order to
+ get a better picture I expanded some variable names. Also, the length of the
+ input state line never got registered as there was no pseudo printing used.
+
+ Because in \LUAMETATEX\ the content can come from \LUA\ we display the state
+ somewhat differently: we also show the input level for line numbers and we tag
+ for instance a macro, just for consistency. The contexts are separated by
+ newlines.
+ */
+ int skip = 0;
+ tex_print_nlp();
+ tex_aux_print_current_input_state();
+ /*
+ The |pseudo_selector_code| selector value is only set in this context. It makes
+ sure that we end up at the place where the problem happens.
+ */
+ {
+ int saved_selector = lmt_print_state.selector;
+ lmt_print_state.tally = 0;
+ lmt_print_state.selector = pseudo_selector_code;
+ lmt_print_state.trick_count = 1000000;
+ if (lmt_input_state.cur_input.state == token_list_state) {
+ halfword head = lmt_input_state.cur_input.token_type < macro_text ? lmt_input_state.cur_input.start : token_link(lmt_input_state.cur_input.start);
+ tex_show_token_list(head, lmt_input_state.cur_input.loc, default_token_show_max, 0);
+ } else if (lmt_input_state.cur_input.name == io_lua_input_code) {
+ skip = 1;
+ } else {
+ /*tex Before we pseudo print the line we determine the effective end. */
+ int j = lmt_input_state.cur_input.limit;
+ if (lmt_fileio_state.io_buffer[lmt_input_state.cur_input.limit] != end_line_char_par) {
+ ++j;
+ }
+ if (j > 0) {
+ for (int i = lmt_input_state.cur_input.start; i <= j - 1; i++) {
+ if (i == lmt_input_state.cur_input.loc) {
+ tex_set_trick_count();
+ }
+ tex_print_char(lmt_fileio_state.io_buffer[i]);
+ }
+ }
+ }
+ lmt_print_state.selector = saved_selector;
+ }
+ /*tex Print two lines using the tricky pseudoprinted information. */
+ if (! skip) {
+ int p; /*tex Starting or ending place in |trick_buf|. */
+ int m; /*tex Context information gathered for line 2. */
+ int n; /*tex Length of line 1. */
+ tex_print_nlp();
+ tex_aux_print_indent();
+ if (lmt_print_state.trick_count == 1000000) {
+ tex_set_trick_count();
+ }
+ /*tex The |set_trick_count| must be performed. */
+ if (lmt_print_state.tally < lmt_print_state.trick_count) {
+ m = lmt_print_state.tally - lmt_print_state.first_count;
+ } else {
+ m = lmt_print_state.trick_count - lmt_print_state.first_count;
+ }
+ if (lmt_print_state.first_count <= lmt_error_state.half_line_limits.size) {
+ p = 0;
+ n = lmt_print_state.first_count;
+ } else {
+ tex_print_str("...");
+ p = lmt_print_state.first_count - lmt_error_state.half_line_limits.size + 3;
+ n = lmt_error_state.half_line_limits.size;
+ }
+ for (int q = p; q <= lmt_print_state.first_count - 1; q++) {
+ tex_aux_print_valid_utf8(q);
+ }
+ /*tex
+ Print |n| spaces to begin line 2. Instead of |n| we use a fixed value of
+ |error_context_indent|.
+ */
+ if (m + n > lmt_error_state.line_limits.size) {
+ p = lmt_print_state.first_count + (lmt_error_state.line_limits.size - n - 3);
+ } else {
+ p = lmt_print_state.first_count + m;
+ }
+ if (lmt_print_state.first_count <= p - 1) {
+ tex_print_nlp();
+ tex_aux_print_indent();
+ for (int q = lmt_print_state.first_count; q <= p - 1; q++) {
+ tex_aux_print_valid_utf8(q);
+ }
+ if (m + n > lmt_error_state.line_limits.size) {
+ tex_print_str(" ...");
+ }
+ }
+ }
+ ++context_lines;
+ }
+ } else if (context_lines == error_context_lines_par) {
+ tex_print_nlp();
+ tex_print_str(" ...");
+ tex_print_nlp();
+ ++context_lines;
+ /*tex Omitted if |error_context_lines_par < 0|. */
+ }
+ if (bottom_line) {
+ break;
+ } else {
+ --lmt_input_state.base_ptr;
+ }
+ }
+ /*tex Restore the original state. */
+ lmt_input_state.cur_input = lmt_input_state.input_stack[lmt_input_state.input_stack_data.ptr];
+ tex_print_ln();
+ tex_print_nlp();
+}
+
+/*tex
+
+ The following subroutines change the input status in commonly needed ways. First comes
+ |push_input|, which stores the current state and creates a new level (having, initially, the
+ same properties as the old). Enter a new input level, save the old:
+
+*/
+
+inline static void tex_aux_push_input(void)
+{
+ if (tex_aux_room_on_input_stack()) {
+ lmt_input_state.input_stack[lmt_input_state.input_stack_data.ptr] = lmt_input_state.cur_input;
+ ++lmt_input_state.input_stack_data.ptr;
+ } else {
+ tex_overflow_error("input stack size", lmt_input_state.input_stack_data.size);
+ }
+}
+
+inline static void tex_aux_pop_input(void)
+{
+ lmt_input_state.cur_input = lmt_input_state.input_stack[--lmt_input_state.input_stack_data.ptr];
+}
+
+/*tex
+
+ Here is a procedure that starts a new level of token-list input, given a token list |p| and its
+ type |t|. If |t=macro|, the calling routine should set |name| and |loc|.
+
+ I added a few few simple variants because the compiler will then inline the little code involved
+ and these are used often.
+
+*/
+
+void tex_begin_token_list(halfword t, quarterword kind)
+{
+ tex_aux_push_input();
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.start = t;
+ lmt_input_state.cur_input.token_type = kind;
+ if (kind < macro_text) {
+ lmt_input_state.cur_input.loc = t;
+ } else if (kind == macro_text) {
+ /*tex More frequently when processing a document: */
+ tex_add_token_reference(t);
+ lmt_input_state.cur_input.parameter_start = lmt_input_state.parameter_stack_data.ptr;
+ } else {
+ /*tex More frequently when making a format: */
+ tex_add_token_reference(t);
+ /*tex The token list started with a reference count. */
+ lmt_input_state.cur_input.loc = token_link(t);
+ if (tracing_macros_par > 0) {
+ tex_begin_diagnostic();
+ switch (kind) {
+ case mark_text:
+ tex_print_str("mark");
+ break;
+ case loop_text:
+ tex_print_str("loop");
+ break;
+ case write_text:
+ tex_print_str("write");
+ break;
+ case local_text:
+ tex_print_str("local");
+ break;
+ case local_loop_text:
+ tex_print_str("localloop");
+ break;
+ case end_paragraph_text:
+ tex_print_str("endpar");
+ break;
+ default:
+ /* messy offsets */
+ tex_print_cmd_chr(internal_toks_cmd, kind - output_text + internal_toks_location(output_routine_code));
+ break;
+ }
+ tex_print_str("->");
+ tex_token_show(t, default_token_show_max);
+ tex_end_diagnostic();
+ }
+ }
+}
+
+void tex_begin_parameter_list(halfword t)
+{
+ if (t) {
+ tex_aux_push_input();
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.start = t;
+ lmt_input_state.cur_input.loc = t;
+ lmt_input_state.cur_input.token_type = parameter_text;
+ } else {
+ // can happen
+ }
+}
+
+void tex_begin_backed_up_list(halfword t)
+{
+ if (t) {
+ tex_aux_push_input();
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.start = t;
+ lmt_input_state.cur_input.loc = t;
+ lmt_input_state.cur_input.token_type = backed_up_text;
+ } else {
+ // can happen
+ }
+}
+
+void tex_begin_inserted_list(halfword t)
+{
+ // if (t) {
+ tex_aux_push_input();
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.start = t;
+ lmt_input_state.cur_input.loc = t;
+ lmt_input_state.cur_input.token_type = inserted_text;
+ // } else {
+ // // never happens
+ // }
+}
+
+void tex_begin_macro_list(halfword t)
+{
+ // if (t) {
+ tex_aux_push_input();
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.start = t;
+ tex_add_token_reference(t);
+ lmt_input_state.cur_input.token_type = macro_text;
+ lmt_input_state.cur_input.parameter_start = lmt_input_state.parameter_stack_data.ptr;
+ // } else {
+ // // never happens
+ // }
+}
+
+/*tex
+
+ When a token list has been fully scanned, the following computations should be done as we leave
+ that level of input. The |token_type| tends to be equal to either |backed_up| or |inserted|
+ about 2/3 of the time.
+
+*/
+
+void tex_end_token_list(void)
+{
+ /*tex Leave a token-list input level: */
+ switch (lmt_input_state.cur_input.token_type) {
+ case parameter_text:
+ break;
+ case template_pre_text:
+ if (lmt_input_state.align_state > 500000) {
+ lmt_input_state.align_state = 0;
+ } else {
+ tex_alignment_interwoven_error(7);
+ }
+ break;
+ case template_post_text:
+ break;
+ case backed_up_text:
+ case inserted_text:
+ case end_of_group_text:
+ /* case local_text: */
+ tex_flush_token_list(lmt_input_state.cur_input.start);
+ break;
+ case macro_text:
+ {
+ tex_delete_token_reference(lmt_input_state.cur_input.start);
+ if (get_token_parameters(lmt_input_state.cur_input.start)) {
+ /*tex Parameters must be flushed: */
+ int ptr = lmt_input_state.parameter_stack_data.ptr;
+ int start = lmt_input_state.cur_input.parameter_start;
+ while (ptr > start) {
+ --ptr;
+ if (lmt_input_state.parameter_stack[ptr]) {
+ tex_flush_token_list(lmt_input_state.parameter_stack[ptr]);
+ }
+ }
+ lmt_input_state.parameter_stack_data.ptr = start;
+ } else {
+ /*tex We have no arguments but we save very little runtime here. */
+ }
+ break;
+ }
+ default:
+ /*tex Update the reference count: */
+ tex_delete_token_reference(lmt_input_state.cur_input.start);
+ break;
+ }
+ tex_aux_pop_input();
+ /* check_interrupt(); */
+}
+
+/*tex A special version used in macro expansion. Maybe some day I'll optimize it. */
+
+void tex_cleanup_input_state(void)
+{
+ while (! lmt_input_state.cur_input.loc && lmt_input_state.cur_input.state == token_list_state) {
+ switch (lmt_input_state.cur_input.token_type) {
+ case parameter_text:
+ break;
+ case template_pre_text:
+ if (lmt_input_state.align_state > 500000) {
+ lmt_input_state.align_state = 0;
+ } else {
+ tex_alignment_interwoven_error(7);
+ }
+ break;
+ case template_post_text:
+ break;
+ case backed_up_text:
+ case inserted_text:
+ case end_of_group_text:
+ /* case local_text: */
+ tex_flush_token_list(lmt_input_state.cur_input.start);
+ break;
+ case macro_text:
+ {
+ /*tex Using a simple version for no arguments has no gain. */
+ tex_delete_token_reference(lmt_input_state.cur_input.start);
+ /*tex Parameters must be flushed: */
+ int ptr = lmt_input_state.parameter_stack_data.ptr;
+ int start = lmt_input_state.cur_input.parameter_start;
+ while (ptr > start) {
+ --ptr;
+ if (lmt_input_state.parameter_stack[ptr]) {
+ tex_flush_token_list(lmt_input_state.parameter_stack[ptr]);
+ }
+ }
+ lmt_input_state.parameter_stack_data.ptr = start;
+ break;
+ }
+ default:
+ /*tex Update the reference count: */
+ tex_delete_token_reference(lmt_input_state.cur_input.start);
+ break;
+ }
+ tex_aux_pop_input();
+ }
+}
+
+/*tex
+
+ Sometimes \TEX\ has read too far and wants to \quote {unscan} what it has seen. The |back_input|
+ procedure takes care of this by putting the token just scanned back into the input stream, ready
+ to be read again. This procedure can be used only if |cur_tok| represents the token to be
+ replaced. Some applications of \TEX\ use this procedure a lot, so it has been slightly optimized
+ for speed.
+
+*/
+
+/*tex Undo one token of input: */
+
+void tex_back_input(halfword t)
+{
+ while ((lmt_input_state.cur_input.state == token_list_state) && (! lmt_input_state.cur_input.loc) && (lmt_input_state.cur_input.token_type != template_post_text)) {
+ tex_end_token_list();
+ }
+ {
+ /*tex A token list of length one: */
+ halfword p = tex_get_available_token(t);
+ if (t < right_brace_limit) {
+ if (t < left_brace_limit) {
+ --lmt_input_state.align_state;
+ } else {
+ ++lmt_input_state.align_state;
+ }
+ }
+ /*
+ if (token_type == backed_up_text && istate == token_list_state && istart == iloc) {
+ token_link(p) = istart;
+ istart = p;
+ iloc = p;
+ } else {
+ */
+ tex_aux_push_input();
+ /*tex This is |back_list(p)|, without procedure overhead: */
+ lmt_input_state.cur_input.start = p;
+ lmt_input_state.cur_input.loc = p;
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.token_type = backed_up_text;
+ /* } */
+ }
+}
+
+/*tex Insert token |p| into \TEX's input: */
+
+void tex_reinsert_token(halfword t)
+{
+ halfword p = tex_get_available_token(t);
+ set_token_link(p, lmt_input_state.cur_input.loc);
+ lmt_input_state.cur_input.start = p;
+ lmt_input_state.cur_input.loc = p;
+ if (t < right_brace_limit) {
+ if (t < left_brace_limit) {
+ --lmt_input_state.align_state;
+ } else {
+ ++lmt_input_state.align_state;
+ }
+ }
+}
+
+/*tex Some aftergroup related code: */
+
+void tex_insert_input(halfword h)
+{
+ if (h) {
+ while ((lmt_input_state.cur_input.state == token_list_state) && (! lmt_input_state.cur_input.loc) && (lmt_input_state.cur_input.token_type != template_post_text)) {
+ tex_end_token_list();
+ }
+ if (token_info(h) < right_brace_limit) {
+ if (token_info(h) < left_brace_limit) {
+ --lmt_input_state.align_state;
+ } else {
+ ++lmt_input_state.align_state;
+ }
+ }
+ tex_aux_push_input();
+ lmt_input_state.cur_input.start = h;
+ lmt_input_state.cur_input.loc = h;
+ lmt_input_state.cur_input.state = token_list_state;
+ lmt_input_state.cur_input.token_type = inserted_text;
+ }
+}
+
+void tex_append_input(halfword h)
+{
+ if (h) {
+ halfword n = h;
+ if (n) {
+ while (token_link(n)) {
+ n = token_link(n);
+ }
+ set_token_link(n, lmt_input_state.cur_input.loc);
+ } else {
+ set_token_link(h, lmt_input_state.cur_input.loc);
+ }
+ lmt_input_state.cur_input.start = h;
+ lmt_input_state.cur_input.loc = h;
+ }
+}
+
+/*tex
+
+ The |begin_file_reading| procedure starts a new level of input for lines of characters to be
+ read from a file, or as an insertion from the terminal. It does not take care of opening the
+ file, nor does it set |loc| or |limit| or |line|.
+
+*/
+
+void tex_begin_file_reading(void)
+{
+ ++lmt_input_state.in_stack_data.ptr;
+ if (tex_aux_room_on_in_stack() && tex_room_in_buffer(lmt_fileio_state.io_first)) {
+ tex_aux_push_input();
+ lmt_input_state.cur_input.index = (short) lmt_input_state.in_stack_data.ptr;
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].full_source_filename = NULL;
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].end_of_file_seen = 0;
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].group = cur_boundary;
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].line = lmt_input_state.input_line;
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].if_ptr = lmt_condition_state.cond_ptr;
+ lmt_input_state.cur_input.start = lmt_fileio_state.io_first;
+ lmt_input_state.cur_input.state = mid_line_state;
+ lmt_input_state.cur_input.name = io_initial_input_code;
+ lmt_input_state.cur_input.cattable = default_catcode_table_preset;
+ lmt_input_state.cur_input.partial = 0;
+ /*tex Prepare terminal input \SYNCTEX\ information. */
+ lmt_input_state.cur_input.state_file = 0;
+ lmt_input_state.cur_input.state_line = 0;
+ }
+}
+
+/*tex
+
+ Conversely, the variables must be downdated when such a level of input is finished. What needs
+ to be closed depends on what was opened.
+
+*/
+
+void tex_end_file_reading(void)
+{
+ lmt_fileio_state.io_first = lmt_input_state.cur_input.start;
+ lmt_input_state.input_line = lmt_input_state.in_stack[lmt_input_state.cur_input.index].line;
+ switch (lmt_input_state.cur_input.name) {
+ case io_initial_input_code:
+ break;
+ case io_lua_input_code:
+ case io_token_input_code:
+ case io_token_eof_input_code:
+ /*tex happens more frequently than reading from file */
+ lmt_cstring_close();
+ break;
+ case io_tex_macro_code:
+ break;
+ default:
+ /*tex A file opened with |\input|, |\read...| is handled by \LUA. */
+ tex_lua_a_close_in();
+ if (lmt_input_state.in_stack[lmt_input_state.cur_input.index].full_source_filename) {
+ lmt_memory_free(lmt_input_state.in_stack[lmt_input_state.cur_input.index].full_source_filename);
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].full_source_filename = NULL;
+ }
+ break;
+ }
+ tex_aux_pop_input();
+ --lmt_input_state.in_stack_data.ptr;
+}
+
+/*tex
+
+ To get \TEX's whole input mechanism going, we perform the following actions.
+
+*/
+
+void tex_initialize_inputstack(void)
+{
+ lmt_input_state.input_stack_data.ptr = 0;
+ lmt_input_state.input_stack_data.top = 0;
+ lmt_input_state.in_stack[0].full_source_filename = NULL;
+ lmt_input_state.in_stack_data.ptr = 0;
+ lmt_input_state.open_files = 0;
+ lmt_fileio_state.io_buffer_data.top = 0;
+ lmt_input_state.in_stack[0].group = 0;
+ lmt_input_state.in_stack[0].if_ptr = null;
+ lmt_input_state.parameter_stack_data.ptr = 0;
+ lmt_input_state.parameter_stack_data.top = 0;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ lmt_input_state.warning_index = null;
+ lmt_fileio_state.io_first = 1;
+ lmt_input_state.cur_input.state = new_line_state;
+ lmt_input_state.cur_input.start = 1;
+ lmt_input_state.cur_input.index = 0;
+ lmt_input_state.input_line = 0;
+ lmt_input_state.cur_input.name = io_initial_input_code;
+ lmt_token_state.force_eof = 0;
+ lmt_token_state.luacstrings = 0;
+ lmt_input_state.cur_input.cattable = default_catcode_table_preset;
+ lmt_input_state.cur_input.partial = 0;
+ lmt_input_state.align_state = 1000000;
+}
+
+void tex_tex_string_start(int iotype, int cattable)
+{
+ (void) iotype;
+ {
+ halfword head = tex_scan_general_text(NULL);
+ int saved_selector = lmt_print_state.selector;
+ lmt_print_state.selector = new_string_selector_code;
+ tex_show_token_list(head, null, extreme_token_show_max, 0);
+ lmt_print_state.selector = saved_selector;
+ tex_flush_token_list(head);
+ }
+ {
+ int len;
+ char *str = tex_take_string(&len);
+ lmt_cstring_store(str, len, tex_valid_catcode_table(cattable) ? cattable : cat_code_table_par);
+ tex_begin_file_reading();
+ lmt_input_state.input_line = 0;
+ lmt_input_state.cur_input.limit = lmt_input_state.cur_input.start;
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ lmt_input_state.cur_input.name = io_token_input_code;
+ lmt_cstring_start();
+ }
+}
+
+
+void tex_lua_string_start(void)
+{
+ /*tex Set up |cur_file| and a new level of input: */
+ tex_begin_file_reading();
+ lmt_input_state.input_line = 0;
+ lmt_input_state.cur_input.limit = lmt_input_state.cur_input.start;
+ /*tex Force line read: */
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ lmt_input_state.cur_input.name = io_lua_input_code;
+ lmt_cstring_start();
+}
+
+void tex_any_string_start(char* s)
+{
+ /* via terminal emulator */
+ /*
+ int len = strlen(s);
+ if (len > 0 && room_in_buffer(len + 1)) {
+ fileio_state.io_last = fileio_state.io_first;
+ strcpy((char *) &fileio_state.io_buffer[fileio_state.io_first], s);
+ fileio_state.io_last += len;
+ input_state.cur_input.loc = fileio_state.io_first;
+ input_state.cur_input.limit = fileio_state.io_last;
+ fileio_state.io_first = fileio_state.io_last + 1;
+ }
+ */
+ /* via token input emulator */
+ lmt_cstring_store(s, (int) strlen(s), cat_code_table_par);
+ tex_begin_file_reading();
+ lmt_input_state.input_line = 0;
+ lmt_input_state.cur_input.limit = lmt_input_state.cur_input.start;
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ lmt_input_state.cur_input.name = io_token_input_code;
+ lmt_cstring_start();
+}
+
+/*tex a list without ref count*/
+
+halfword tex_wrapped_token_list(halfword list)
+{
+ halfword head = tex_store_new_token(null, left_brace_token + '{');
+ halfword tail = head;
+ token_link(tail) = token_link(list);
+ while (token_link(tail)) {
+ tail = token_link(tail);
+ }
+ tail = tex_store_new_token(tail, right_brace_token + '}');
+ return head;
+}
+
+const char *tex_current_input_file_name(void)
+{
+ int level = lmt_input_state.in_stack_data.ptr;
+ while (level > 0) {
+ const char *s = lmt_input_state.in_stack[level--].full_source_filename;
+ if (s) {
+ return s;
+ }
+ }
+ /*tex old method */
+ level = lmt_input_state.in_stack_data.ptr;
+ while (level > 0) {
+ int t = lmt_input_state.input_stack[level--].name;
+ if (t >= cs_offset_value) {
+ return (const char *) str_string(t);
+ }
+ }
+ return NULL;
+}
diff --git a/source/luametatex/source/tex/texinputstack.h b/source/luametatex/source/tex/texinputstack.h
new file mode 100644
index 000000000..7ae677d56
--- /dev/null
+++ b/source/luametatex/source/tex/texinputstack.h
@@ -0,0 +1,452 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_INPUTSTACK_H
+# define LMT_INPUTSTACK_H
+
+/*tex
+
+ The state of \TEX's input mechanism appears in the input stack, whose entries are records with
+ six fields, called |state|, |index|, |start|, |loc|, |limit|, and |name|.
+
+*/
+
+/* todo: there is no need to be sparse here */
+
+typedef struct in_state_record {
+ halfword start;
+ halfword loc;
+ unsigned short state;
+ union { unsigned short index; unsigned short token_type; }; /*tex: So, no macro but name. */
+ union { halfword limit; halfword parameter_start; }; /*tex: So, no macro but name. */
+ halfword name;
+ signed short cattable; /*tex The category table used by the current line (see |textoken.c|). */
+ unsigned short partial; /*tex Is the current line partial (see |textoken.c|)? */
+ int state_file; /*tex Here we stack the tag of the current file. */
+ int state_line; /*tex Not used. */
+} in_state_record;
+
+typedef struct input_stack_record {
+ halfword input_file_callback_id;
+ halfword line;
+ halfword end_of_file_seen;
+ halfword group;
+ halfword if_ptr;
+ halfword padding;
+ char *full_source_filename;
+} input_stack_record;
+
+// todo: better names for in_state_record and input_stack_record ... now mixed up
+
+typedef struct input_state_info {
+ in_state_record *input_stack;
+ memory_data input_stack_data;
+ input_stack_record *in_stack;
+ memory_data in_stack_data;
+ halfword *parameter_stack;
+ memory_data parameter_stack_data;
+ in_state_record cur_input; /*tex The \quote {top} input state. Why not just pointing. */
+ int input_line;
+ int scanner_status;
+ halfword def_ref; /*tex Has to be set for error recovery etc. */
+ int align_state;
+ int base_ptr;
+ halfword warning_index;
+ int open_files;
+ int padding;
+} input_state_info;
+
+extern input_state_info lmt_input_state;
+
+typedef struct input_file_state_info {
+ int forced_file;
+ int forced_line;
+ halfword mode;
+ halfword line;
+} input_file_state_info;
+
+extern input_file_state_info input_file_state;
+
+static inline int input_file_value(void)
+{
+ return input_file_state.forced_file ? input_file_state.forced_file : lmt_input_state.cur_input.state_file;
+}
+
+static inline int input_line_value(void)
+{
+ return input_file_state.forced_line ? input_file_state.forced_line : (input_file_state.line ? input_file_state.line : lmt_input_state.input_line);
+}
+
+/*tex
+
+ In \LUAMETATEX\ the io model was stepwise changed a bit, mostly in the \LUA\ feedback area.
+ Support for nodes, tokens, short and long string were improved. Around 2.06.17 specification
+ nodes became dynamic and that left the pseudo files as only variable node type. By removing
+ variable nodes we can avoid some code in node management so getting rid of pseudo files made
+ sense. The token scan macros used these but now use a lightweight varian tof the \LUA\ scanner,
+ which we had anyway. The only complication is the |\everyeof| of |\scantokens|. Also, tracing
+ (if at all) is now different but these three scanners are seldom used and were introduced in
+ \ETEX\ (|scantokens|), \LUATEX\ (|\scantextokens|) and \LUAMETATEX\ (|tokenized|). The new
+ approach also gives more room for future extensions.
+
+ All this has been a very stepwise process, because we know that there are users who use \LMTX\
+ in production and small steps are easier to test. Experiments mostly happen in parts of the
+ code that is less critital ... after all \LUAMETATEX\ is also an experimental engine ... but
+ io related code changes are kind of critital.
+
+ Just to remember wahat we came from: the first 15 were reserved read channels but that is now
+ delegated to \LUA, so we had an offset of 16 in:
+
+*/
+
+typedef enum io_codes {
+ io_initial_input_code,
+ io_lua_input_code,
+ io_token_input_code,
+ io_token_eof_input_code,
+ io_tex_macro_code,
+ io_file_input_code,
+} io_codes;
+
+/*
+*
+ Now, these |io_codes| are used in the name field but that field can also be a way larger number,
+ i.e.\ the string index of the file. That also assumes that the first used index is above the last
+ io_code. It can be the warning index too, just for the sake of an error context message. So:
+ symbolic (small) number, tex string being the filename, and macro name. But, because we also
+ have that information in other places (partly as side effect of luafication) a simpler model is
+ used now where we use a few dedicates codes. It also means that we no longer store the filename
+ in the string pool.
+
+*/
+
+# define io_token_input(c) (c >= io_lua_input_code && c <= io_token_eof_input_code)
+# define io_file_input(c) (c >= io_file_input_code)
+
+/*tex
+
+ Let's look more closely now at the control variables (|state|, |index|, |start|, |loc|, |limit|,
+ |name|), assuming that \TEX\ is reading a line of characters that have been input from some file
+ or from the user's terminal. There is an array called |buffer| that acts as a stack of all lines
+ of characters that are currently being read from files, including all lines on subsidiary levels
+ of the input stack that are not yet completed. \TEX\ will return to the other lines when it is
+ finished with the present input file.
+
+ (Incidentally, on a machine with byte-oriented addressing, it might be appropriate to combine
+ |buffer| with the |str_pool| array, letting the buffer entries grow downward from the top of the
+ string pool and checking that these two tables don't bump into each other.)
+
+ The line we are currently working on begins in position |start| of the buffer; the next character
+ we are about to read is |buffer[loc]|; and |limit| is the location of the last character present.
+ If |loc > limit|, the line has been completely read. Usually |buffer[limit]| is the
+ |end_line_char|, denoting the end of a line, but this is not true if the current line is an
+ insertion that was entered on the user's terminal in response to an error message.
+
+ The |name| variable is a string number that designates the name of the current file, if we are
+ reading a text file. It is zero if we are reading from the terminal; it is |n+1| if we are reading
+ from input stream |n|, where |0 <= n <= 16|. (Input stream 16 stands for an invalid stream number;
+ in such cases the input is actually from the terminal, under control of the procedure |read_toks|.)
+ Finally |18 <= name <=20| indicates that we are reading a pseudo file created by the |\scantokens|
+ or |\scantextokens| command. A larger value is reserved for input coming from \LUA.
+
+ The |state| variable has one of three values, when we are scanning such files:
+
+ \startitemize
+ \startitem
+ |mid_line| is the normal state.
+ \stopitem
+ \startitem
+ |skip_blanks| is like |mid_line|, but blanks are ignored.
+ \stopitem
+ \startitem
+ |new_line| is the state at the beginning of a line.
+ \stopitem
+ \stopitemize
+
+ These state values are assigned numeric codes so that if we add the state code to the next
+ character's command code, we get distinct values. For example, |mid_line + spacer| stands for the
+ case that a blank space character occurs in the middle of a line when it is not being ignored;
+ after this case is processed, the next value of |state| will be |skip_blanks|.
+
+ As with other constants, we only add some prefix or suffix but keep the normal name as much as
+ possible, so that the original documentation still applies.
+
+*/
+
+typedef enum state_codes {
+ token_list_state = 0,
+ /*tex when scanning a line of characters */
+ mid_line_state = 1,
+ /*tex when ignoring blanks */
+ skip_blanks_state = 2 + max_char_code,
+ /*tex at the start of a line */
+ new_line_state = 3 + max_char_code + max_char_code,
+} state_codes;
+
+/*tex
+
+ Additional information about the current line is available via the |index| variable, which
+ counts how many lines of characters are present in the buffer below the current level. We
+ have |index = 0| when reading from the terminal and prompting the user for each line; then if
+ the user types, e.g., |\input paper|, we will have |index = 1| while reading the file
+ |paper.tex|. However, it does not follow that |index| is the same as the input stack pointer,
+ since many of the levels on the input stack may come from token lists. For example, the
+ instruction |\input paper| might occur in a token list.
+
+ The global variable |in_open| is equal to the |index| value of the highest \quote {non token
+ list} level. Thus, the number of partially read lines in the buffer is |in_open + 1|, and we
+ have |in_open = index| when we are not reading a token list.
+
+ If we are not currently reading from the terminal, or from an input stream, we are reading from
+ the file variable |input_file [index]|. We use the notation |terminal_input| as a convenient
+ abbreviation for |name = 0|, and |cur_file| as an abbreviation for |input_file [index]|.
+
+ The global variable |line| contains the line number in the topmost open file, for use in error
+ messages. If we are not reading from the terminal, |line_stack [index]| holds the line number
+ or the enclosing level, so that |line| can be restored when the current file has been read.
+ Line numbers should never be negative, since the negative of the current line number is used to
+ identify the user's output routine in the |mode_line| field of the semantic nest entries.
+
+ If more information about the input state is needed, it can be included in small arrays like
+ those shown here. For example, the current page or segment number in the input file might be
+ put into a variable |page|, maintained for enclosing levels in ||page_stack:array [1 ..
+ max_input_open] of integer| by analogy with |line_stack|.
+
+ Users of \TEX\ sometimes forget to balance left and right braces properly, and one of the ways
+ \TEX\ tries to spot such errors is by considering an input file as broken into subfiles by
+ control sequences that are declared to be |\outer|.
+
+ A variable called |scanner_status| tells \TEX\ whether or not to complain when a subfile ends.
+ This variable has six possible values:
+
+ \startitemize
+
+ \startitem
+ |normal|, means that a subfile can safely end here without incident.
+ \stopitem
+
+ \startitem
+ |skipping|, means that a subfile can safely end here, but not a file, because we're reading
+ past some conditional text that was not selected.
+ \stopitem
+
+ \startitem
+ |defining|, means that a subfile shouldn't end now because a macro is being defined.
+ \stopitem
+
+ \startitem
+ |matching|, means that a subfile shouldn't end now because a macro is being used and we are
+ searching for the end of its arguments.
+ \stopitem
+
+ \startitem
+ |aligning|, means that a subfile shouldn't end now because we are not finished with the
+ preamble of an |\halign| or |\valign|.
+ \stopitem
+
+ \startitem
+ |absorbing|, means that a subfile shouldn't end now because we are reading a balanced token
+ list for |\message|, |\write|, etc.
+ \stopitem
+
+ \stopitemize
+
+ If the |scanner_status| is not |normal|, the variable |warning_index| points to the |eqtb|
+ location for the relevant control sequence name to print in an error message.
+
+*/
+
+typedef enum scanner_states {
+ scanner_is_normal, /*tex passing conditional text */
+ scanner_is_skipping, /*tex passing conditional text */
+ scanner_is_defining, /*tex reading a macro definition */
+ scanner_is_matching, /*tex reading macro arguments */
+ scanner_is_tolerant, /*tex reading tolerant macro arguments */
+ scanner_is_aligning, /*tex reading an alignment preamble */
+ scanner_is_absorbing, /*tex reading a balanced text */
+} scanner_states;
+
+extern void tex_show_runaway(void); /*tex This is only used when running out of token memory. */
+
+/*tex
+
+ However, the discussion about input state really applies only to the case that we are inputting
+ from a file. There is another important case, namely when we are currently getting input from a
+ token list. In this case |state = token_list|, and the conventions about the other state
+ variables are
+ different:
+
+ \startitemize
+
+ \startitem
+ |loc| is a pointer to the current node in the token list, i.e., the node that will be read
+ next. If |loc=null|, the token list has been fully read.
+ \stopitem
+
+ \startitem
+ |start| points to the first node of the token list; this node may or may not contain a
+ reference count, depending on the type of token list involved.
+ \stopitem
+
+ \startitem
+ |token_type|, which takes the place of |index| in the discussion above, is a code number
+ that explains what kind of token list is being scanned.
+ \stopitem
+
+ \startitem
+ |name| points to the |eqtb| address of the control sequence being expanded, if the current
+ token list is a macro.
+ \stopitem
+
+ \startitem
+ |param_start|, which takes the place of |limit|, tells where the parameters of the current
+ macro begin in the |param_stack|, if the current token list is a macro.
+ \stopitem
+
+ \stopitemize
+
+ The |token_type| can take several values, depending on where the current token list came from:
+
+ \startitemize
+
+ \startitem
+ |parameter|, if a parameter is being scanned;
+ \stopitem
+
+ \startitem
+ |u_template|, if the |u_j| part of an alignment template is being scanned;
+ \stopitem
+
+ \startitem
+ |v_template|, if the |v_j| part of an alignment template is being scanned;
+ \stopitem
+
+ \startitem
+ |backed_up|, if the token list being scanned has been inserted as \quotation {to be read
+ again}.
+ \stopitem
+
+ \startitem
+ |inserted|, if the token list being scanned has been inserted as the text expansion of a
+ |\count| or similar variable;
+ \stopitem
+
+ \startitem
+ |macro|, if a user-defined control sequence is being scanned;
+ \stopitem
+
+ \startitem
+ |output_text|, if an |\output| routine is being scanned;
+ \stopitem
+
+ \startitem
+ |every_par_text|, if the text of |\everypar| is being scanned;
+ \stopitem
+
+ \startitem
+ |every_math_text|, if the text of |\everymath| is being scanned;
+ \stopitem
+
+ \startitem
+ |every_display_text|, if the text of \everydisplay| is being scanned;
+ \stopitem
+
+ \startitem
+ |every_hbox_text|, if the text of |\everyhbox| is being scanned;
+ \stopitem
+
+ \startitem
+ |every_vbox_text|, if the text of |\everyvbox| is being scanned;
+ \stopitem
+
+ \startitem
+ |every_job_text|, if the text of |\everyjob| is being scanned;
+ \stopitem
+
+ \startitem
+ |every_cr_text|, if the text of |\everycr| is being scanned;
+ \stopitem
+
+ \startitem
+ |mark_text|, if the text of a |\mark| is being scanned;
+ \stopitem
+
+ \startitem
+ |write_text|, if the text of a |\write| is being scanned.
+ \stopitem
+
+ \stopitemize
+
+ The codes for |output_text|, |every_par_text|, etc., are equal to a constant plus the
+ corresponding codes for token list parameters |output_routine_loc|, |every_par_loc|, etc.
+
+ The token list begins with a reference count if and only if |token_type >= macro|.
+
+ Since \ETEX's additional token list parameters precede |toks_base|, the corresponding token
+ types must precede |write_text|. However, in \LUAMETATEX\ we delegate all the read and write
+ primitives to \LUA\ so that model has been simplified.
+
+*/
+
+/* #define token_type input_state.cur_input.token_type */ /*tex type of current token list */
+/* #define param_start input_state.cur_input.param_start */ /*tex base of macro parameters in |param_stack| */
+
+typedef enum token_types {
+ parameter_text, /*tex parameter */
+ template_pre_text, /*tex |u_j| template */
+ template_post_text, /*tex |v_j| template */
+ backed_up_text, /*tex text to be reread */
+ inserted_text, /*tex inserted texts */
+ macro_text, /*tex defined control sequences */
+ output_text, /*tex output routines */
+ every_par_text, /*tex |\everypar| */
+ every_math_text, /*tex |\everymath| */
+ every_display_text, /*tex |\everydisplay| */
+ every_hbox_text, /*tex |\everyhbox| */
+ every_vbox_text, /*tex |\everyvbox| */
+ every_math_atom_text, /*tex |\everymathatom| */
+ every_job_text, /*tex |\everyjob| */
+ every_cr_text, /*tex |\everycr| */
+ every_tab_text, /*tex |\everytab| */
+ error_help_text,
+ every_before_par_text, /*tex |\everybeforeeof| */
+ every_eof_text, /*tex |\everyeof| */
+ end_of_group_text,
+ mark_text, /*tex |\topmark|, etc. */
+ loop_text,
+ end_paragraph_text, /*tex |\everyendpar| */
+ write_text, /*tex |\write| */
+ local_text,
+ local_loop_text,
+} token_types;
+
+extern void tex_initialize_input_state (void);
+/* int tex_room_on_param_stack (void); */
+/* int tex_room_on_in_stack (void); */
+/* int tex_room_on_input_stack (void); */
+extern void tex_copy_pstack_to_param_stack (halfword *pstack, int n);
+extern void tex_show_context (void);
+extern void tex_show_validity (void);
+extern void tex_set_trick_count (void);
+extern void tex_begin_token_list (halfword t, quarterword kind); /* include some tracing */
+extern void tex_begin_parameter_list (halfword t); /* less inlining code */
+extern void tex_begin_backed_up_list (halfword t); /* less inlining code */
+extern void tex_begin_inserted_list (halfword t); /* less inlining code */
+extern void tex_begin_macro_list (halfword t); /* less inlining code */
+extern void tex_end_token_list (void);
+extern void tex_cleanup_input_state (void);
+extern void tex_back_input (halfword t);
+extern void tex_reinsert_token (halfword t);
+extern void tex_insert_input (halfword h);
+extern void tex_append_input (halfword h);
+extern void tex_begin_file_reading (void);
+extern void tex_end_file_reading (void);
+extern void tex_initialize_inputstack (void);
+extern void tex_lua_string_start (void);
+extern void tex_tex_string_start (int iotype, int cattable);
+extern void tex_any_string_start (char *s);
+extern halfword tex_wrapped_token_list (halfword h);
+extern const char *tex_current_input_file_name (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texinserts.c b/source/luametatex/source/tex/texinserts.c
new file mode 100644
index 000000000..874dcf24d
--- /dev/null
+++ b/source/luametatex/source/tex/texinserts.c
@@ -0,0 +1,517 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ In traditional \TEX\ inserts are implemented using a quadruple of box, dimen, count and skip
+ registers. This means that the allocate macro |\newinsert| as well as the other allocators
+ have to keep a range of registers free. In \CONTEXT\ (\MKII\ and \MKIV) for instance the
+ indices 132 upto 254 are reserved for that.
+
+ When pondering about improvements this implementation detail always puts some strains on
+ the possible solutions and it is for that reason that an alternative code path is present,
+ one that keep the relevant data in dedicated data structures. When that got implemented all
+ accessors ended up here. Most were already abstracted anyway. For now it means that the old
+ interface still works (and is default). By setting the |\insertmode| to 2 the alternative
+ path is chosen. For practical reasons the first time an insert is used that value gets
+ frozen; a mixed approach was too messy.
+
+ Actually the new variant, which is tagged |class| instead of |index|, also better suits the
+ extended box model. There is access to the basic three dimension but that's all. One can wrap
+ in a box and mess with others but doing that with the boxes inserts makes no sense because
+ the output routine expects simple boxes.
+
+ A side effect is of course that we now have more primitives, starting with |\insert...| and
+ also helpers at the \LUA\ end. A few more will follow and likely some enhancements will show
+ up too.
+
+ In this new mode we also store the floatingpenalty and maxdepth so these can now differ per
+ class. They were already stored in the node, but this way we don't need to set the shared
+ variable every time we do an insert.
+
+*/
+
+insert_state_info lmt_insert_state = {
+ .inserts = NULL,
+ .insert_data = {
+ .minimum = min_insert_size,
+ .maximum = max_insert_size,
+ .size = memory_data_unset,
+ .step = stp_insert_size,
+ .allocated = 0,
+ .itemsize = sizeof(insert_record),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .mode = unset_insert_mode,
+ .storing = 0,
+};
+
+void tex_initialize_inserts(void)
+{
+ insert_record *tmp = aux_allocate_clear_array(sizeof(insert_record), lmt_insert_state.insert_data.minimum, 1);
+ if (tmp) {
+ lmt_insert_state.inserts = tmp;
+ lmt_insert_state.insert_data.allocated = lmt_insert_state.insert_data.minimum * sizeof(insert_record);
+ lmt_insert_state.insert_data.top = lmt_insert_state.insert_data.minimum;
+ lmt_insert_state.insert_data.ptr = 0;
+ } else {
+ tex_overflow_error("inserts", lmt_insert_state.insert_data.minimum);
+ }
+}
+
+/*tex
+ This one is not sparse but we don't have many inserts so we're okay. I need to check the 0/1
+ offsets here.
+*/
+
+int tex_valid_insert_id(halfword n)
+{
+ switch (lmt_insert_state.mode) {
+ case index_insert_mode:
+ return (n >= 0 && n <= max_box_register_index);
+ case class_insert_mode:
+ if (n <= 0) {
+ tex_handle_error(
+ normal_error_type,
+ "In \\insertmode 2 you can't use zero as index.",
+ NULL
+ );
+ } else if (n <= lmt_insert_state.insert_data.ptr) {
+ return 1;
+ } else if (n < lmt_insert_state.insert_data.top) {
+ lmt_insert_state.insert_data.ptr = n;
+ return 1;
+ } else if (n < lmt_insert_state.insert_data.maximum && lmt_insert_state.insert_data.top < lmt_insert_state.insert_data.maximum) {
+ insert_record *tmp ;
+ int top = n + lmt_insert_state.insert_data.step;
+ if (top > lmt_insert_state.insert_data.maximum) {
+ top = lmt_insert_state.insert_data.maximum;
+ }
+ tmp = aux_reallocate_array(lmt_insert_state.inserts, sizeof(insert_record), top, 1); // 1 slack
+ if (tmp) {
+ size_t extra = ((size_t) top - lmt_insert_state.insert_data.top) * sizeof(insert_record);
+ memset(&tmp[lmt_insert_state.insert_data.top + 1], 0, extra);
+ // memset(&tmp[lmt_insert_state.insert_data.top], 0, extra);
+ lmt_insert_state.inserts = tmp;
+ lmt_insert_state.insert_data.allocated += (int) extra;
+ lmt_insert_state.insert_data.top = top;
+ lmt_insert_state.insert_data.ptr = n;
+ return 1;
+ }
+ }
+ tex_overflow_error("inserts", lmt_insert_state.insert_data.maximum);
+ }
+ return 0;
+}
+
+scaled tex_get_insert_limit(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ return lmt_insert_state.mode == index_insert_mode ? insert_maxheight(i) : lmt_insert_state.inserts[i].limit;
+ } else {
+ return 0;
+ }
+}
+
+halfword tex_get_insert_multiplier(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ return lmt_insert_state.mode == index_insert_mode ? insert_multiplier(i) : lmt_insert_state.inserts[i].multiplier;
+ } else {
+ return 0;
+ }
+}
+
+halfword tex_get_insert_penalty(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ return lmt_insert_state.mode == index_insert_mode ? floating_penalty_par : lmt_insert_state.inserts[i].penalty;
+ } else {
+ return 0;
+ }
+}
+
+halfword tex_get_insert_maxdepth(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ return lmt_insert_state.mode == index_insert_mode ? split_max_depth_par : lmt_insert_state.inserts[i].maxdepth;
+ } else {
+ return 0;
+ }
+}
+
+halfword tex_get_insert_distance(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ return lmt_insert_state.mode == index_insert_mode ? insert_distance(i) : lmt_insert_state.inserts[i].distance;
+ } else {
+ return 0;
+ }
+}
+
+static inline halfword tex_aux_insert_box(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ return lmt_insert_state.mode == index_insert_mode ? insert_content(i) : lmt_insert_state.inserts[i].content;
+ } else {
+ return null;
+ }
+}
+
+scaled tex_get_insert_height(halfword i)
+{
+ halfword b = tex_aux_insert_box(i);
+ return b ? box_height(b) : 0;
+}
+
+scaled tex_get_insert_depth(halfword i)
+{
+ halfword b = tex_aux_insert_box(i);
+ return b ? box_depth(b) : 0;
+}
+
+scaled tex_get_insert_width(halfword i)
+{
+ halfword b = tex_aux_insert_box(i);
+ return b ? box_width(b) : 0;
+}
+
+halfword tex_get_insert_content(halfword i)
+{
+ return tex_aux_insert_box(i);
+}
+
+halfword tex_get_insert_storage(halfword i)
+{
+ if (lmt_insert_state.mode == class_insert_mode && tex_valid_insert_id(i)) {
+ return has_insert_option(i, insert_option_storing);
+ } else {
+ return 0;
+ }
+}
+
+void tex_set_insert_limit(halfword i, scaled v)
+{
+ if (tex_valid_insert_id(i)) {
+ switch (lmt_insert_state.mode) {
+ case index_insert_mode: insert_maxheight(i) = v; break;
+ case class_insert_mode: lmt_insert_state.inserts[i].limit = v; break;
+ }
+ }
+}
+
+void tex_set_insert_multiplier(halfword i, halfword v) {
+ if (tex_valid_insert_id(i)) {
+ switch (lmt_insert_state.mode) {
+ case index_insert_mode: insert_multiplier(i) = v; break;
+ case class_insert_mode: lmt_insert_state.inserts[i].multiplier = v; break;
+ }
+ }
+}
+
+void tex_set_insert_penalty(halfword i, halfword v) {
+ if (tex_valid_insert_id(i) && lmt_insert_state.mode == class_insert_mode) {
+ lmt_insert_state.inserts[i].options = set_insert_option(lmt_insert_state.inserts[i].options, insert_option_penalty);
+ lmt_insert_state.inserts[i].penalty = v;
+ }
+}
+
+void tex_set_insert_maxdepth(halfword i, halfword v) {
+ if (tex_valid_insert_id(i) && lmt_insert_state.mode == class_insert_mode) {
+ lmt_insert_state.inserts[i].options = set_insert_option(lmt_insert_state.inserts[i].options, insert_option_maxdepth);
+ lmt_insert_state.inserts[i].maxdepth = v;
+ }
+}
+
+void tex_set_insert_distance(halfword i, halfword v) {
+ if (tex_valid_insert_id(i)) {
+ int d = null;
+ switch (lmt_insert_state.mode) {
+ case index_insert_mode:
+ d = insert_distance(i);
+ insert_distance(i) = v;
+ break;
+ case class_insert_mode:
+ d = lmt_insert_state.inserts[i].distance;
+ lmt_insert_state.inserts[i].distance = v;
+ break;
+ }
+ tex_flush_node(d);
+ }
+}
+
+void tex_set_insert_height(halfword i, scaled v) {
+ halfword b = tex_aux_insert_box(i);
+ if (b) {
+ box_height(b) = v;
+ }
+}
+
+void tex_set_insert_depth(halfword i, scaled v) {
+ halfword b = tex_aux_insert_box(i);
+ if (b) {
+ box_depth(b) = v;
+ }
+}
+
+void tex_set_insert_width(halfword i, scaled v) {
+ halfword b = tex_aux_insert_box(i);
+ if (b) {
+ box_width(b) = v;
+ }
+}
+
+void tex_set_insert_content(halfword i, halfword v) {
+ switch (lmt_insert_state.mode) {
+ case index_insert_mode: insert_content(i) = v; break;
+ case class_insert_mode: if (tex_valid_insert_id(i)) { lmt_insert_state.inserts[i].content = v; } break;
+ }
+}
+
+void tex_set_insert_storage(halfword i, halfword v)
+{
+ if (lmt_insert_state.mode == class_insert_mode && tex_valid_insert_id(i)) {
+ lmt_insert_state.inserts[i].options = v
+ ? set_insert_option(lmt_insert_state.inserts[i].options, insert_option_storing)
+ : unset_insert_option(lmt_insert_state.inserts[i].options, insert_option_storing);
+ }
+}
+
+void tex_wipe_insert(halfword i) {
+ if (lmt_insert_state.mode == class_insert_mode && i >= 0 && i <= lmt_insert_state.insert_data.ptr) {
+// if (lmt_insert_state.mode == class_insert_mode && tex_valid_insert_id(i)) {
+ halfword b = lmt_insert_state.inserts[i].content;
+ if (b) {
+ tex_flush_node(b);
+ lmt_insert_state.inserts[i].content = null;
+ }
+ }
+}
+
+halfword lmt_get_insert_distance(halfword i, int slot)
+{
+ int callback_id = lmt_callback_defined(build_page_insert_callback);
+ if (callback_id != 0) {
+ halfword replacement = null;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "dd->N", i, slot, &replacement);
+ if (replacement) {
+ return replacement;
+ } else {
+ halfword distance = null;
+ switch (lmt_insert_state.mode) {
+ case index_insert_mode:
+ distance = insert_distance(i);
+ break;
+ case class_insert_mode:
+ if (tex_valid_insert_id(i)) {
+ distance = lmt_insert_state.inserts[i].distance;
+ }
+ break;
+ }
+ if (distance) {
+ return tex_copy_node(distance);
+ }
+ }
+ }
+ return tex_new_glue_spec_node(null);
+}
+
+halfword tex_get_insert_progress(halfword i)
+{
+ if (tex_valid_insert_id(i)) {
+ halfword p = page_insert_head;
+ while (p && i >= insert_index(node_next(p))) {
+ p = node_next(p);
+ if (p == page_insert_head) {
+ break;
+ }
+ }
+ return insert_index(p) == i ? insert_total_height(p) : 0;
+ } else {
+ return 0;
+ }
+}
+
+/*tex The |class_insert| zero serves as a garbage bin. */
+
+halfword tex_scan_insert_index(void)
+{
+ halfword index = 0;
+ switch (lmt_insert_state.mode) {
+ case unset_insert_mode:
+ lmt_insert_state.mode = index_insert_mode;
+ // fall-through
+ case index_insert_mode:
+ index = tex_scan_box_register_number();
+ if (index == output_box_par) {
+ tex_handle_error(
+ normal_error_type,
+ "You can't \\insert%i",
+ output_box_par,
+ "I'm changing to \\insert0; box \\outputbox is special."
+ );
+ index = 0;
+ }
+ break;
+ case class_insert_mode:
+ index = tex_scan_int(0, NULL);
+ if (! tex_valid_insert_id(index)) {
+ index = 0;
+ }
+ break;
+ }
+ return index;
+}
+
+void tex_set_insert_mode(halfword mode)
+{
+ if (lmt_insert_state.mode == unset_insert_mode && (mode == index_insert_mode || mode == class_insert_mode)) {
+ lmt_insert_state.mode = mode;
+ } else if (mode != lmt_insert_state.mode) {
+ tex_handle_error(
+ normal_error_type,
+ "Bad \\insertmode (%i)",
+ mode,
+ "This mode can be set once and has value 1 or 2. It will be automatically\n"
+ "set when \\insert is used."
+ );
+ }
+}
+
+int tex_insert_is_void(halfword i)
+{
+ halfword b = tex_aux_insert_box(i);
+ return (! b) || box_list(b) == null; /*tex So also an empty box test! */
+}
+
+/* playground */
+
+int tex_insert_stored(void)
+{
+ return lmt_insert_state.head != null;
+}
+
+void tex_insert_restore(halfword n)
+{
+ if (lmt_insert_state.tail) {
+ tex_couple_nodes(lmt_insert_state.tail, n);
+ } else {
+ lmt_insert_state.head = n;
+ }
+ lmt_insert_state.tail = n;
+}
+
+void tex_insert_store(halfword i, halfword n)
+{
+ if (tex_get_insert_storage(i)) {
+ tex_insert_restore(n);
+ }
+}
+
+/* not sparse (yet) ... makes no sense (unless we make the list pointers) */
+
+void tex_dump_insert_data(dumpstream f) {
+ dump_int(f, lmt_insert_state.mode);
+ dump_int(f, lmt_insert_state.insert_data.ptr);
+ dump_int(f, lmt_insert_state.insert_data.top);
+ dump_things(f, lmt_insert_state.inserts[0], lmt_insert_state.insert_data.ptr);
+}
+
+void tex_undump_insert_data(dumpstream f) {
+ undump_int(f, lmt_insert_state.mode);
+ undump_int(f, lmt_insert_state.insert_data.ptr);
+ undump_int(f, lmt_insert_state.insert_data.top);
+ insert_record *tmp = aux_allocate_clear_array(sizeof(insert_record), lmt_insert_state.insert_data.top, 1);
+ if (tmp) {
+ lmt_insert_state.inserts = tmp;
+ lmt_insert_state.insert_data.allocated = lmt_insert_state.insert_data.top * sizeof(insert_record);
+ undump_things(f, lmt_insert_state.inserts[0], lmt_insert_state.insert_data.ptr);
+ } else {
+ tex_overflow_error("inserts", lmt_insert_state.insert_data.top);
+ }
+}
+
+/*tex
+ Inserts, not the easiest mechanism and a candicate for more opening up.
+*/
+
+void tex_run_insert(void)
+{
+ tex_set_saved_record(saved_insert_item_index, saved_insert_index, 0, tex_scan_insert_index());
+ lmt_save_state.save_stack_data.ptr += saved_insert_n_of_items;
+ tex_new_save_level(insert_group);
+ tex_scan_left_brace();
+ tex_normal_paragraph(insert_par_context);
+ tex_push_nest();
+ cur_list.mode = -vmode;
+ cur_list.prev_depth = ignore_depth;
+}
+
+void tex_finish_insert_group(void)
+{
+ if (! tex_wrapped_up_paragraph(insert_par_context)) {
+ halfword p, q; /*tex for short-term use */
+ scaled d; /*tex holds |split_max_depth| in |insert_group| */
+ halfword f; /*tex holds |floating_penalty| in |insert_group| */
+ tex_end_paragraph(insert_group, insert_par_context);
+ q = tex_new_glue_node(split_top_skip_par, top_skip_code);
+ d = split_max_depth_par;
+ f = floating_penalty_par;
+ tex_unsave();
+ lmt_save_state.save_stack_data.ptr -= saved_insert_n_of_items;
+ // p = tex_vpack(node_next(cur_list.head), 0, packing_additional, max_dimen, direction_unknown);
+ // /* we don't do this: */
+ // /* p = tex_filtered_vpack(node_next(cur_list.head), 0, packing_additional, max_dimen, insert_group, direction_unknown, 0, 0); */
+ // /* because it can induce loops. */
+ // tex_pop_nest();
+ p = node_next(cur_list.head);
+ tex_pop_nest();
+ p = tex_vpack(p, 0, packing_additional, max_dimen, direction_unknown, holding_none_option);
+ {
+ halfword index = saved_value(saved_insert_item_index);
+ halfword insert = tex_new_node(insert_node, 0);
+ halfword maxdepth = tex_get_insert_maxdepth(index);
+ halfword floating = tex_get_insert_penalty(index);
+ if (tex_get_insert_storage(index)) {
+ tex_insert_store(index, insert);
+ } else {
+ tex_tail_append(insert);
+ }
+ /*tex
+ An |\insert| is just a list. We package it because we want to know the height but
+ then discard the wrapper |vlist| node. So the |insert_list| is not packaged.
+ */
+ insert_index(insert) = index;
+ insert_total_height(insert) = box_total(p);
+ insert_list(insert) = box_list(p);
+ insert_split_top(insert) = q;
+ insert_max_depth(insert) = has_insert_option(index, insert_option_maxdepth) ? d : maxdepth;
+ insert_float_cost(insert) = has_insert_option(index, insert_option_penalty) ? f : floating;
+ box_list(p) = null;
+ tex_flush_node(p);
+ if (tracing_inserts_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_levels();
+ tex_print_format("[insert: setting, index %i, height %D, penalty %i]",
+ index, insert_total_height(insert), pt_unit, insert_float_cost(insert));
+ if (tracing_inserts_par > 1) {
+ tex_print_node_list(insert_list(insert), "insert", show_box_depth_par, show_box_breadth_par);
+ }
+ tex_end_diagnostic();
+ }
+ }
+ /* we never do the callback ... maybe move it outside */
+ if (lmt_nest_state.nest_data.ptr == 0) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(insert_page_context, 0);
+ }
+ tex_build_page();
+ }
+ }
+}
diff --git a/source/luametatex/source/tex/texinserts.h b/source/luametatex/source/tex/texinserts.h
new file mode 100644
index 000000000..e91965e6f
--- /dev/null
+++ b/source/luametatex/source/tex/texinserts.h
@@ -0,0 +1,101 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_INSERTS_H
+# define LMT_INSERTS_H
+
+typedef struct insert_record {
+ halfword limit;
+ halfword multiplier;
+ halfword distance;
+ halfword content;
+ halfword initialized;
+ halfword options;
+ halfword penalty;
+ halfword maxdepth;
+} insert_record;
+
+typedef enum insert_modes {
+ unset_insert_mode,
+ index_insert_mode,
+ class_insert_mode,
+} insert_modes;
+
+typedef enum insert_class_options {
+ insert_option_storing = 0x1,
+ insert_option_penalty = 0x2,
+ insert_option_maxdepth = 0x4,
+} insert_class_options;
+
+typedef enum insert_storage_actions {
+ insert_storage_ignore,
+ insert_storage_delay,
+ insert_storage_inject,
+} insert_storage_actions;
+
+typedef enum saved_insert_items {
+ saved_insert_item_index = 0,
+ saved_insert_n_of_items = 1,
+} saved_insert_items;
+
+typedef struct insert_state_info {
+ insert_record *inserts;
+ memory_data insert_data;
+ int mode;
+ halfword storing;
+ halfword head;
+ halfword tail;
+} insert_state_info;
+
+extern insert_state_info lmt_insert_state;
+
+# define has_insert_option(a,b) (lmt_insert_state.mode == class_insert_mode && (lmt_insert_state.inserts[a].options & b) == b)
+# define set_insert_option(a,b) (lmt_insert_state.inserts[a].options |= b)
+# define unset_insert_option(a,b) (lmt_insert_state.inserts[a].options & ~(b))
+
+extern scaled tex_get_insert_limit (halfword i);
+extern halfword tex_get_insert_multiplier (halfword i);
+extern halfword tex_get_insert_penalty (halfword i);
+extern halfword tex_get_insert_distance (halfword i);
+extern halfword tex_get_insert_maxdepth (halfword i);
+extern scaled tex_get_insert_height (halfword i);
+extern scaled tex_get_insert_depth (halfword i);
+extern scaled tex_get_insert_width (halfword i);
+extern halfword tex_get_insert_content (halfword i);
+extern halfword tex_get_insert_storage (halfword i);
+
+extern void tex_set_insert_limit (halfword i, scaled v);
+extern void tex_set_insert_multiplier (halfword i, halfword v);
+extern void tex_set_insert_penalty (halfword i, halfword v);
+extern void tex_set_insert_distance (halfword i, halfword v);
+extern void tex_set_insert_maxdepth (halfword i, halfword v);
+extern void tex_set_insert_height (halfword i, scaled v);
+extern void tex_set_insert_depth (halfword i, scaled v);
+extern void tex_set_insert_width (halfword i, scaled v);
+extern void tex_set_insert_content (halfword i, halfword v);
+extern void tex_set_insert_storage (halfword i, halfword v);
+
+extern void tex_wipe_insert (halfword i);
+
+extern void tex_initialize_inserts (void);
+extern int tex_valid_insert_id (halfword n);
+extern void tex_dump_insert_data (dumpstream f);
+extern void tex_undump_insert_data (dumpstream f);
+
+extern halfword lmt_get_insert_distance (halfword i, int slot); /* callback */
+
+extern halfword tex_get_insert_progress (halfword i);
+
+extern void tex_insert_store (halfword i, halfword n);
+extern void tex_insert_restore (halfword n);
+extern int tex_insert_stored (void);
+
+extern halfword tex_scan_insert_index (void);
+extern void tex_set_insert_mode (halfword mode);
+extern int tex_insert_is_void (halfword i);
+
+extern void tex_run_insert (void);
+extern void tex_finish_insert_group (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texlanguage.c b/source/luametatex/source/tex/texlanguage.c
new file mode 100644
index 000000000..6f3460c22
--- /dev/null
+++ b/source/luametatex/source/tex/texlanguage.c
@@ -0,0 +1,1774 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ We no longer dump the patterns and exeptions as they as supposed to be loaded runtime. There is
+ no gain getting them from the format. But we do dump some of the properties.
+
+ There were all kind of checks for simple characters i.e. not ligatures but there is no need for
+ that in \LUAMETATEX. We have separated stages and the hyphenator sees just glyphs. And when a
+ traditional font has glyphs we can assume that the old school font encoding matches the patterns
+ i.e. that ligatures are not in the normal character slots.
+
+ Exceptions are stored at the \LUA\ end. We cannot easilly go dynamic because fonts are stored
+ in the eqtb so we would have to use some more indirect mechanism (doable as we do it for other
+ items) too.
+
+*/
+
+language_state_info lmt_language_state = {
+ .languages = NULL,
+ .language_data = {
+ .minimum = min_language_size,
+ .maximum = max_language_size,
+ .size = memory_data_unset,
+ .step = stp_language_size,
+ .allocated = 0,
+ .itemsize = 1,
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .handler_table_id = 0,
+ .handler_count = 0,
+};
+
+/*tex
+ We can enforce a language id but we want to be sequential so we accept holes! So one
+ has to define bottom-up. As with fonts, we have a zero language but that one normally
+ is not set.
+*/
+
+static void tex_aux_reset_language(halfword id)
+{
+ tex_language *lang = lmt_language_state.languages[id];
+ lang->id = id;
+ lang->exceptions = 0;
+ lang->patterns = NULL;
+ lang->wordhandler = 0;
+ lang->pre_hyphen_char = '-';
+ lang->post_hyphen_char = 0;
+ lang->pre_exhyphen_char = 0;
+ lang->post_exhyphen_char = 0;
+ lang->hyphenation_min = -1;
+ lang->hjcode_head = NULL;
+}
+
+/*tex
+ A value below zero will bump the language id. Because we have a rather limited number of
+ languages there is no configuration, size is just maximum.
+*/
+
+static halfword tex_aux_new_language_id(halfword id)
+{
+ int top;
+ if (id >= 0) {
+ if (id <= lmt_language_state.language_data.top) {
+ if (lmt_language_state.languages[id]) {
+ return tex_formatted_error("languages", "the language with id %d is already created", id);
+ } else {
+ return id;
+ }
+ } else if (id > lmt_language_state.language_data.maximum) {
+ goto OVERFLOWERROR;
+ } else {
+ top = id;
+ }
+ } else if (lmt_language_state.language_data.ptr < lmt_language_state.language_data.top) {
+ ++lmt_language_state.language_data.ptr;
+ return lmt_language_state.language_data.ptr;
+ } else if (lmt_language_state.language_data.top >= lmt_language_state.language_data.maximum) {
+ goto OVERFLOWERROR;
+ } else if (lmt_language_state.language_data.top + lmt_language_state.language_data.step > lmt_language_state.language_data.maximum) {
+ top = lmt_language_state.language_data.maximum;
+ } else {
+ top = lmt_language_state.language_data.top + lmt_language_state.language_data.step;
+ }
+ /*tex Finally we can bump memory. */
+ {
+ tex_language **tmp = aux_reallocate_array(lmt_language_state.languages, sizeof(tex_language *), top, 0);
+ if (tmp) {
+ for (int i = lmt_language_state.language_data.top + 1; i <= top; i++) {
+ tmp[i] = NULL;
+ }
+ lmt_language_state.languages = tmp;
+ lmt_language_state.language_data.allocated += ((size_t) top - lmt_language_state.language_data.top) * sizeof(tex_language *);
+ lmt_language_state.language_data.top = top;
+ lmt_language_state.language_data.ptr += 1;
+ return lmt_language_state.language_data.ptr;
+ }
+ }
+ OVERFLOWERROR:
+ tex_overflow_error("languages", lmt_language_state.language_data.maximum);
+ return 0;
+}
+
+void tex_initialize_languages(void)
+{
+ tex_language **tmp = aux_allocate_clear_array(sizeof(tex_language *), lmt_language_state.language_data.minimum, 0);
+ if (tmp) {
+ for (int i = 0; i < lmt_language_state.language_data.minimum; i++) {
+ tmp[i] = NULL;
+ }
+ lmt_language_state.languages = tmp;
+ lmt_language_state.language_data.allocated += lmt_language_state.language_data.minimum * sizeof(tex_language *);
+ lmt_language_state.language_data.top = lmt_language_state.language_data.minimum;
+ } else {
+ tex_overflow_error("languages", lmt_language_state.language_data.minimum);
+ }
+}
+
+/*
+halfword tex_aux_maximum_language_id(void)
+{
+ return language_state.language_data.maximum;
+}
+*/
+
+int tex_is_valid_language(halfword n)
+{
+ if (n == 0) {
+ return 1;
+ } else if (n > 0 && n <= lmt_language_state.language_data.top) {
+ return lmt_language_state.languages[n] ? 1 : 0;
+ } else {
+ return 0;
+ }
+}
+
+tex_language *tex_new_language(halfword n)
+{
+ halfword id = tex_aux_new_language_id(n);
+ if (id >= 0) {
+ tex_language *lang = lmt_memory_malloc(sizeof(struct tex_language));
+ if (lang) {
+ lmt_language_state.languages[id] = lang;
+ lmt_language_state.language_data.allocated += sizeof(struct tex_language);
+ tex_aux_reset_language(id);
+ if (saving_hyph_codes_par) {
+ /*tex
+ For now, we might just use specific value for whatever task. This will become
+ obsolete.
+ */
+ tex_hj_codes_from_lc_codes(id);
+ }
+ } else {
+ tex_overflow_error("language", sizeof(struct tex_language));
+ }
+ return lang;
+ } else {
+ return NULL;
+ }
+}
+
+tex_language *tex_get_language(halfword n)
+{
+ if (n >= 0) {
+ if (n <= lmt_language_state.language_data.top && lmt_language_state.languages[n]) {
+ return lmt_language_state.languages[n];
+ }
+ if (n <= lmt_language_state.language_data.maximum) {
+ return tex_new_language(n);
+ }
+ }
+ return NULL;
+}
+
+/*tex
+ Freeing, dumping, undumping languages:
+*/
+
+/*
+void free_languages(void)
+{
+ for (int i = 0; i < language_state.language_data.top; i++) {
+ if (language_state.languages[i]) {
+ lmt_memory_free(language_state.languages[i]);
+ language_state.languages[i] = NULL;
+ }
+ }
+}
+*/
+
+void tex_dump_language_data(dumpstream f)
+{
+ dump_int(f, lmt_language_state.language_data.top);
+ dump_int(f, lmt_language_state.language_data.ptr);
+ if (lmt_language_state.language_data.top > 0) {
+ for (int i = 0; i < lmt_language_state.language_data.top; i++) {
+ tex_language *lang = lmt_language_state.languages[i];
+ if (lang) {
+ dump_via_int(f, 1);
+ dump_int(f, lang->id);
+ dump_int(f, lang->pre_hyphen_char);
+ dump_int(f, lang->post_hyphen_char);
+ dump_int(f, lang->pre_exhyphen_char);
+ dump_int(f, lang->post_exhyphen_char);
+ dump_int(f, lang->hyphenation_min);
+ tex_dump_language_hj_codes(f, i);
+ } else {
+ dump_via_int(f, 0);
+ }
+ }
+ }
+}
+
+void tex_undump_language_data(dumpstream f)
+{
+ int top, ptr;
+ undump_int(f, top);
+ undump_int(f, ptr);
+ if (top > 0) {
+ tex_language **tmp = aux_allocate_clear_array(sizeof(tex_language *), top, 0);
+ if (tmp) {
+ lmt_language_state.language_data.top = top;
+ lmt_language_state.language_data.ptr = ptr;
+ lmt_language_state.languages = tmp;
+ for (int i = 0; i < top; i++) {
+ int x;
+ undump_int(f, x);
+ if (x == 1) {
+ tex_language *lang = lmt_memory_malloc(sizeof(struct tex_language));
+ if (lang) {
+ lmt_language_state.languages[i] = lang;
+ lmt_language_state.language_data.allocated += sizeof(struct tex_language);
+ lang->exceptions = 0;
+ lang->patterns = NULL;
+ lang->wordhandler = 0;
+ lang->hjcode_head = NULL;
+ undump_int(f, lang->id);
+ undump_int(f, lang->pre_hyphen_char);
+ undump_int(f, lang->post_hyphen_char);
+ undump_int(f, lang->pre_exhyphen_char);
+ undump_int(f, lang->post_exhyphen_char);
+ undump_int(f, lang->hyphenation_min);
+ tex_undump_language_hj_codes(f, i);
+ if (lang->id != i) {
+ tex_formatted_warning("languages", "undumped language id mismatch: %d <> %d", lang->id, i);
+ lang->id = i;
+ }
+ } else {
+ tex_overflow_error("languages", i);
+ }
+ tmp[i] = lang;
+ } else {
+ tmp[i] = NULL;
+ }
+ }
+ lmt_language_state.language_data.initial = lmt_language_state.language_data.ptr;
+ } else {
+ tex_overflow_error("languages", top);
+ lmt_language_state.language_data.initial = 0;
+ }
+ } else {
+ /*tex Indeed we can have no languages stored. */
+ tex_initialize_languages();
+ }
+}
+
+/*tex All kind of accessors. */
+
+void tex_set_pre_hyphen_char(halfword n, halfword v)
+{
+ struct tex_language *l = tex_get_language(n);
+ if (l) {
+ l->pre_hyphen_char = v;
+ }
+}
+
+void tex_set_post_hyphen_char(halfword n, halfword v)
+{
+ struct tex_language *l = tex_get_language(n);
+ if (l) {
+ l->post_hyphen_char = v;
+ }
+}
+
+void tex_set_pre_exhyphen_char(halfword n, halfword v)
+{
+ struct tex_language *l = tex_get_language(n);
+ if (l) {
+ l->pre_exhyphen_char = v;
+ }
+}
+
+void tex_set_post_exhyphen_char(halfword n, halfword v)
+{
+ struct tex_language *l = tex_get_language(n);
+ if (l) {
+ l->post_exhyphen_char = v;
+ }
+}
+
+halfword tex_get_pre_hyphen_char(halfword n)
+{
+ struct tex_language *l = tex_get_language(n);
+ return l ? l->pre_hyphen_char : -1;
+}
+
+halfword tex_get_post_hyphen_char(halfword n)
+{
+ struct tex_language *l = tex_get_language(n);
+ return l ? l->post_hyphen_char : -1;
+}
+
+halfword tex_get_pre_exhyphen_char(halfword n)
+{
+ struct tex_language *l = tex_get_language(n);
+ return l ? l->pre_exhyphen_char : -1;
+}
+
+halfword tex_get_post_exhyphen_char(halfword n)
+{
+ struct tex_language *l = tex_get_language(n);
+ return (l) ? (int) l->post_exhyphen_char : -1;
+}
+
+void tex_set_hyphenation_min(halfword n, halfword v)
+{
+ struct tex_language *l = tex_get_language(n);
+ if (l) {
+ l->hyphenation_min = v;
+ }
+}
+
+halfword tex_get_hyphenation_min(halfword n)
+{
+ struct tex_language *l = tex_get_language((int) n);
+ return l ? l->hyphenation_min : -1;
+}
+
+void tex_load_patterns(struct tex_language *lang, const unsigned char *buff)
+{
+ if ((! lang) || (! buff) || strlen((const char *) buff) == 0) {
+ return;
+ } else {
+ if (! lang->patterns) {
+ lang->patterns = hnj_dictionary_new();
+ }
+ hnj_dictionary_load(lang->patterns, buff, tracing_hyphenation_par > 0);
+ }
+}
+
+void tex_clear_patterns(struct tex_language *lang)
+{
+ if (lang && lang->patterns) {
+ hnj_dictionary_clear(lang->patterns);
+ }
+}
+
+void tex_load_tex_patterns(halfword curlang, halfword head)
+{
+ char *s = tex_tokenlist_to_tstring(head, 1, NULL, 0, 0, 0);
+ if (s) {
+ tex_load_patterns(tex_get_language(curlang), (unsigned char *) s);
+ }
+}
+
+/*
+ This cleans one word which is returned in |cleaned|, returns the new offset into |buffer|.
+*/
+
+/* define tex_isspace(c) (c == ' ' || c == '\t') */
+# define tex_isspace(c) (c == ' ')
+
+const char *tex_clean_hyphenation(halfword id, const char *buff, char **cleaned)
+{
+ int items = 0;
+ /*tex Work buffer for bytes: */
+ unsigned char word[max_size_of_word + 1];
+ /*tex Work buffer for \UNICODE: */
+ unsigned uword[max_size_of_word + 1] = { 0 };
+ /*tex The \UNICODE\ buffer value: */
+ int i = 0;
+ char *uindex = (char *) word;
+ const char *s = buff;
+ while (*s && ! tex_isspace((unsigned char)*s)) {
+ word[i++] = (unsigned char) *s;
+ s++;
+ if ((s-buff) > max_size_of_word) {
+ /*tex Todo: this is too strict, should count \UNICODE, not bytes. */
+ *cleaned = NULL;
+ tex_handle_error(
+ normal_error_type,
+ "Exception too long",
+ NULL
+ );
+ return s;
+ }
+ }
+ /*tex Now convert the input to \UNICODE. */
+ word[i] = '\0';
+ aux_splitutf2uni(uword, (const char *)word);
+ /*tex
+ Build the new word string. The hjcode values < 32 indicate a length, so that
+ for instance \|hjcode`ܽ2| makes that ligature count okay.
+ */
+ i = 0;
+ while (uword[i] > 0) {
+ int u = uword[i++];
+ if (u == '-') {
+ /*tex Skip. */
+ } else if (u == '=') {
+ unsigned c = tex_get_hj_code(id, '-');
+ uindex = aux_uni2string(uindex, (! c || c <= 32) ? '-' : c);
+ } else if (u == '{') {
+ u = uword[i++];
+ items = 0;
+ while (u && u != '}') {
+ u = uword[i++];
+ }
+ if (u == '}') {
+ items++;
+ u = uword[i++];
+ }
+ while (u && u != '}') {
+ u = uword[i++];
+ }
+ if (u == '}') {
+ items++;
+ u = uword[i++];
+ }
+ if (u == '{') {
+ u = uword[i++];
+ }
+ while (u && u != '}') {
+ unsigned c = tex_get_hj_code(id, u);
+ uindex = aux_uni2string(uindex, (! c || c <= 32) ? u : c);
+ u = uword[i++];
+ }
+ if (u == '}') {
+ items++;
+ }
+ if (items != 3) {
+ /* hm, we intercept that elsewhere in a better way so why here? Best remove the test here or move the other one here. */
+ *cleaned = NULL;
+ tex_handle_error(
+ normal_error_type,
+ "Exception syntax error, a discretionary has three components: {}{}{}.",
+ NULL
+ );
+ return s;
+ } else {
+ /* skip replacement (chars) */
+ if (uword[i] == '(') {
+ while (uword[++i] && uword[i] != ')') { };
+ if (uword[i] != ')') {
+ tex_handle_error(
+ normal_error_type,
+ "Exception syntax error, an alternative replacement is defined as (text).",
+ NULL
+ );
+ return s;
+ } else if (uword[i]) {
+ i++;
+ }
+ }
+ /* skip penalty: [digit] but we intercept multiple digits */
+ if (uword[i] == '[') {
+ if (uword[i+1] && uword[i+1] >= '0' && uword[i+1] <= '9' && uword[i+2] && uword[i+2] == ']') {
+ i += 3;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Exception syntax error, a penalty is defined as [digit].",
+ NULL
+ );
+ return s;
+ }
+ }
+ }
+ } else {
+ unsigned c = tex_get_hj_code(id, u);
+ uindex = aux_uni2string(uindex, (! c || c <= 32) ? u : c);
+ }
+ }
+ *uindex = '\0';
+ *cleaned = lmt_memory_strdup((char *) word);
+ return s;
+}
+
+void tex_load_hyphenation(struct tex_language *lang, const unsigned char *buff)
+{
+ if (lang) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ const char *s = (const char *) buff;
+ char *cleaned = NULL;
+ int id = lang->id;
+ if (lang->exceptions == 0) {
+ lua_newtable(L);
+ lang->exceptions = luaL_ref(L, LUA_REGISTRYINDEX);
+ }
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lang->exceptions);
+ while (*s) {
+ while (tex_isspace((unsigned char) *s)) {
+ s++;
+ }
+ if (*s) {
+ const char *value = s;
+ s = tex_clean_hyphenation(id, s, &cleaned);
+ if (cleaned) {
+ size_t len = s - value;
+ if (len > 0) {
+ lua_pushstring(L, cleaned);
+ lua_pushlstring(L, value, len);
+ lua_rawset(L, -3);
+ }
+ lmt_memory_free(cleaned);
+ } else {
+ /* tex_formatted_warning("hyphenation","skipping invalid hyphenation exception: %s", value); */
+ }
+ }
+ }
+ }
+}
+
+void tex_clear_hyphenation(struct tex_language *lang)
+{
+ if (lang && lang->exceptions != 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ luaL_unref(L, LUA_REGISTRYINDEX, lang->exceptions);
+ lang->exceptions = 0;
+ }
+}
+
+void tex_load_tex_hyphenation(halfword curlang, halfword head)
+{
+ char *s = tex_tokenlist_to_tstring(head, 1, NULL, 0, 0, 0);
+ if (s) {
+ tex_load_hyphenation(tex_get_language(curlang), (unsigned char *) s);
+ }
+}
+
+static halfword tex_aux_insert_discretionary(halfword t, halfword pre, halfword post, halfword replace, quarterword subtype, int penalty)
+{
+ /*tex For compound words following explicit hyphens we take the current font. */
+ halfword d = tex_new_disc_node(subtype);
+ halfword a = node_attr(t) ;
+ disc_penalty(d) = penalty;
+ if (t == replace) {
+ /*tex We have |prev disc next-next|. */
+ tex_try_couple_nodes(d, node_next(t));
+ tex_try_couple_nodes(node_prev(t), d);
+ node_prev(t) = null;
+ node_next(t) = null;
+ replace = t;
+ } else {
+ /*tex We have |prev disc next|. */
+ tex_try_couple_nodes(d, node_next(t));
+ tex_couple_nodes(t, d);
+ }
+ if (a) {
+ tex_attach_attribute_list_attribute(d, a);
+ }
+ tex_set_disc_field(d, pre_break_code, pre);
+ tex_set_disc_field(d, post_break_code, post);
+ tex_set_disc_field(d, no_break_code, replace);
+ return d;
+}
+
+static halfword tex_aux_insert_syllable_discretionary(halfword t, lang_variables *lan)
+{
+ halfword n = tex_new_disc_node(syllable_discretionary_code);
+ disc_penalty(n) = hyphen_penalty_par;
+ tex_couple_nodes(n, node_next(t));
+ tex_couple_nodes(t, n);
+ tex_attach_attribute_list_attribute(n, get_attribute_list(t));
+ if (lan->pre_hyphen_char > 0) {
+ halfword g = tex_new_glyph_node(glyph_unset_subtype, glyph_font(t), lan->pre_hyphen_char, t);
+ tex_set_disc_field(n, pre_break_code, g);
+ }
+ if (lan->post_hyphen_char > 0) {
+ halfword g = tex_new_glyph_node(glyph_unset_subtype, glyph_font(t), lan->post_hyphen_char, t);
+ tex_set_disc_field(n, post_break_code, g);
+ }
+ return n;
+}
+
+static halfword tex_aux_compound_word_break(halfword t, halfword clang, halfword chr)
+{
+ halfword prechar, postchar, pre, post, disc;
+ if (chr == ex_hyphen_char_par) {
+ halfword pre_exhyphen_char = tex_get_pre_exhyphen_char(clang);
+ halfword post_exhyphen_char = tex_get_post_exhyphen_char(clang);
+ prechar = pre_exhyphen_char > 0 ? pre_exhyphen_char : ex_hyphen_char_par;
+ postchar = post_exhyphen_char > 0 ? post_exhyphen_char : null;
+ } else {
+ /* we need a flag : use pre/post cf language spec */
+ prechar = chr;
+ postchar = null;
+ }
+ pre = prechar > 0 ? tex_new_glyph_node(glyph_unset_subtype, glyph_font(t), prechar, t) : null;
+ post = postchar > 0 ? tex_new_glyph_node(glyph_unset_subtype, glyph_font(t), postchar, t) : null;
+ disc = tex_aux_insert_discretionary(t, pre, post, t, automatic_discretionary_code, tex_automatic_disc_penalty(glyph_hyphenate(t)));
+ return disc;
+}
+
+static char *tex_aux_hyphenation_exception(int exceptions, char *w)
+{
+ lua_State *L = lmt_lua_state.lua_instance;
+ char *ret = NULL;
+ if (lua_rawgeti(L, LUA_REGISTRYINDEX, exceptions) == LUA_TTABLE) {
+ /*tex Word table: */
+ lua_pushstring(L, w);
+ lua_rawget(L, -2);
+ if (lua_type(L, -1) == LUA_TSTRING) {
+ ret = lmt_memory_strdup(lua_tostring(L, -1));
+ }
+ lua_pop(L, 2);
+ } else {
+ lua_pop(L, 1);
+ }
+ return ret;
+}
+
+/*tex Kept as reference: */
+
+/*
+char *get_exception_strings(struct tex_language *lang)
+{
+ char *ret = NULL;
+ if (lang && lang->exceptions) {
+ lua_State *L = lua_state.lua_instance;
+ if (lua_rawgeti(L, LUA_REGISTRYINDEX, lang->exceptions) == LUA_TTABLE) {
+ size_t size = 0;
+ size_t current = 0;
+ lua_pushnil(L);
+ while (lua_next(L, -2)) {
+ size_t l = 0;
+ const char *value = lua_tolstring(L, -1, &l);
+ if (current + l + 2 > size) {
+ size_t new = (size + size/5) + current + l + 1024;
+ char *tmp = lmt_memory_realloc(ret, new);
+ if (tmp) {
+ ret = tmp;
+ size = new;
+ } else {
+ overflow_error("exceptions", (int) size);
+ }
+ }
+ if (ret) {
+ ret[current] = ' ';
+ strcpy(&ret[current + 1], value);
+ current += l + 1;
+ }
+ lua_pop(L, 1);
+ }
+ }
+ }
+ return ret;
+}
+*/
+
+/*tex
+
+ The sequence from |wordstart| to |r| can contain only normal characters it could be faster to
+ modify a halfword pointer and return an integer
+
+*/
+
+# define zws 0x200B /* zero width space makes no sense */
+# define zwnj 0x200C
+# define zwj 0x200D
+
+static halfword tex_aux_find_exception_part(unsigned int *j, unsigned int *uword, int len, halfword parent, char final)
+{
+ halfword head = null;
+ halfword tail = null;
+ unsigned i = *j;
+ int noligature = 0;
+ int nokerning = 0;
+ /*tex This puts uword[i] on the |{|. */
+ i++;
+ while (i < (unsigned) len && uword[i + 1] != (unsigned int) final) {
+ if (tail) {
+ switch (uword[i + 1]) {
+ case zwj:
+ noligature = 1;
+ nokerning = 0;
+ break;
+ case zwnj:
+ noligature = 1;
+ nokerning = 1;
+ break;
+ default:
+ {
+ halfword s = tex_new_glyph_node(glyph_unset_subtype, glyph_font(parent), (int) uword[i + 1], parent); /* todo: data */
+ tex_couple_nodes(tail, s);
+ if (noligature) {
+ tex_add_glyph_option(tail, glyph_option_no_right_ligature);
+ tex_add_glyph_option(s, glyph_option_no_left_ligature);
+ noligature = 0;
+ }
+ if (nokerning) {
+ tex_add_glyph_option(tail, glyph_option_no_right_kern);
+ tex_add_glyph_option(s, glyph_option_no_left_kern);
+ nokerning = 0;
+ }
+ tail = node_next(tail);
+ break;
+ }
+ }
+ } else {
+ head = tex_new_glyph_node(glyph_unset_subtype, glyph_font(parent), (int) uword[i + 1], parent); /* todo: data */
+ tail = head;
+ }
+ i++;
+ }
+ *j = ++i;
+ return head;
+}
+
+static int tex_aux_count_exception_part(unsigned int *j, unsigned int *uword, int len)
+{
+ int n = 0;
+ unsigned i = *j;
+ /*tex This puts uword[i] on the |{|. */
+ i++;
+ while (i < (unsigned) len && uword[i + 1] != '}') {
+ n++;
+ i++;
+ }
+ *j = ++i;
+ return n;
+}
+
+static void tex_aux_show_exception_error(const char *part)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Invalid %s part in exception",
+ part,
+ "Exception discretionaries should contain three pairs of braced items.\n"
+ "No intervening spaces are allowed."
+ );
+}
+
+/*tex
+
+ The exceptions are taken as-is: no min values are taken into account. One can add normal
+ patterns on-the-fly if needed.
+
+*/
+
+static void tex_aux_do_exception(halfword wordstart, halfword r, char *replacement)
+{
+ halfword t = wordstart;
+ lang_variables langdata;
+ unsigned uword[max_size_of_word + 1] = { 0 };
+ unsigned len = aux_splitutf2uni(uword, replacement);
+ int clang = get_glyph_language(wordstart);
+ langdata.pre_hyphen_char = tex_get_pre_hyphen_char(clang);
+ langdata.post_hyphen_char = tex_get_post_hyphen_char(clang);
+ for (unsigned i = 0; i < len; i++) {
+ if (uword[i + 1] == 0 ) {
+ /*tex We ran out of the exception pattern. */
+ break;
+ } else if (uword[i + 1] == '-') {
+ /*tex A hyphen follows. */
+ if (node_next(t) == r) {
+ break;
+ } else {
+ tex_aux_insert_syllable_discretionary(t, &langdata);
+ /*tex Skip the new disc */
+ t = node_next(t);
+ }
+ } else if (uword[i + 1] == '=') {
+ /*tex We skip a disc. */
+ t = node_next(t);
+ } else if (uword[i + 1] == '{') {
+ /*tex We ran into an exception |{}{}{}| or |{}{}{}[]|. */
+ halfword pre = null;
+ halfword post = null;
+ halfword replace = null;
+ int count = 0;
+ int alternative = null;
+ halfword penalty;
+ /*tex |pre| */
+ pre = tex_aux_find_exception_part(&i, uword, (int) len, wordstart, '}');
+ if (i == len || uword[i + 1] != '{') {
+ tex_aux_show_exception_error("pre");
+ }
+ /*tex |post| */
+ post = tex_aux_find_exception_part(&i, uword, (int) len, wordstart, '}');
+ if (i == len || uword[i + 1] != '{') {
+ tex_aux_show_exception_error("post");
+ }
+ /*tex |replace| */
+ count = tex_aux_count_exception_part(&i, uword, (int) len);
+ if (i == len) {
+ tex_aux_show_exception_error("replace");
+ } else if (uword[i] && uword[i + 1] == '(') {
+ alternative = tex_aux_find_exception_part(&i, uword, (int) len, wordstart, ')');;
+ }
+ /*tex Play safe. */
+ if (node_next(t) == r) {
+ break;
+ } else {
+ /*tex Let's deal with an (optional) replacement. */
+ if (count > 0) {
+ /*tex Assemble the replace stream. */
+ halfword q = t;
+ replace = node_next(q);
+ while (count > 0 && q) {
+ halfword t = node_type(q);
+ q = node_next(q);
+ if (t == glyph_node || t == disc_node) {
+ count--;
+ } else {
+ break ;
+ }
+ }
+ /*tex Remove it from the main stream */
+ tex_try_couple_nodes(t, node_next(q));
+ /*tex and finish it in the replace. */
+ node_next(q) = null;
+ if (alternative) {
+ tex_flush_node_list(replace);
+ replace = alternative;
+ } else {
+ /*tex Sanitize the replace stream (we could use the flattener instead). */
+ q = replace ;
+ while (q) {
+ halfword n = node_next(q);
+ if (node_type(q) == disc_node) {
+ /*tex Beware: the replacement starts after the no_break pointer. */
+ halfword nb = disc_no_break_head(q);
+ disc_no_break_head(q) = null;
+ node_prev(nb) = null ; /* used at all? */
+ /*tex Insert the replacement glyph. */
+ if (q == replace) {
+ replace = nb;
+ } else {
+ tex_try_couple_nodes(node_prev(q), nb);
+ }
+ /*tex Append the glyph (one). */
+ tex_try_couple_nodes(nb, n);
+ /*tex Flush the disc. */
+ tex_flush_node(q);
+ }
+ q = n ;
+ }
+ }
+ }
+ /*tex Let's check if we have a penalty spec. If we have more then we're toast, we just ignore them. */
+ if (uword[i] && uword[i + 1] == '[') {
+ i += 2;
+ if (uword[i] && uword[i] >= '0' && uword[i] <= '9') {
+ if (exception_penalty_par > 0) {
+ if (exception_penalty_par > infinite_penalty) {
+ penalty = exception_penalty_par;
+ } else {
+ penalty = (uword[i] - '0') * exception_penalty_par ;
+ }
+ } else {
+ penalty = hyphen_penalty_par;
+ }
+ ++i;
+ while (uword[i] && uword[i] != ']') {
+ ++i;
+ }
+ } else {
+ penalty = hyphen_penalty_par;
+ }
+ } else {
+ penalty = hyphen_penalty_par;
+ }
+ /*tex And now we insert a disc node (this was |syllable_discretionary_code|). */
+ t = tex_aux_insert_discretionary(t, pre, post, replace, normal_discretionary_code, penalty);
+ /*tex We skip the new disc node. */
+ t = node_next(t);
+ /*tex
+ We need to check if we have two discretionaries in a row, test case: |\hyphenation
+ {a{>}{<}{b}{>}{<}{c}de} \hsize 1pt abcde \par| which gives |a> <> <de|.
+ */
+ if (uword[i] && uword[i + 1] == '{') {
+ i--;
+ t = node_prev(t); /*tex Tricky! */
+ }
+ }
+ } else {
+ t = node_next(t);
+ }
+ /*tex Again we play safe. */
+ if (! t || node_next(t) == r) {
+ break;
+ }
+ }
+}
+
+/*tex
+
+ The following description is no longer valid for \LUATEX. Although we use the same algorithm
+ for hyphenation, it is not integrated in the par builder. Instead it is a separate run over
+ the node list, preceding the line-breaking routine, possibly replaced by a callback. We keep
+ the description here because the principles remain.
+
+ \startnarrower
+
+ When the line-breaking routine is unable to find a feasible sequence of breakpoints, it makes
+ a second pass over the paragraph, attempting to hyphenate the hyphenatable words. The goal of
+ hyphenation is to insert discretionary material into the paragraph so that there are more
+ potential places to break.
+
+ The general rules for hyphenation are somewhat complex and technical, because we want to be
+ able to hyphenate words that are preceded or followed by punctuation marks, and because we
+ want the rules to work for languages other than English. We also must contend with the fact
+ that hyphens might radically alter the ligature and kerning structure of a word.
+
+ A sequence of characters will be considered for hyphenation only if it belongs to a \quotation
+ {potentially hyphenatable part} of the current paragraph. This is a sequence of nodes $p_0p_1
+ \ldots p_m$ where $p_0$ is a glue node, $p_1\ldots p_{m-1}$ are either character or ligature
+ or whatsit or implicit kern nodes, and $p_m$ is a glue or penalty or insertion or adjust or
+ mark or whatsit or explicit kern node. (Therefore hyphenation is disabled by boxes, math
+ formulas, and discretionary nodes already inserted by the user.) The ligature nodes among $p_1
+ \ldots p_{m-1}$ are effectively expanded into the original non-ligature characters; the kern
+ nodes and whatsits are ignored. Each character |c| is now classified as either a nonletter (if
+ |lc_code(c)=0|), a lowercase letter (if |lc_code(c)=c|), or an uppercase letter (otherwise); an
+ uppercase letter is treated as if it were |lc_code(c)| for purposes of hyphenation. The
+ characters generated by $p_1\ldots p_{m-1}$ may begin with nonletters; let $c_1$ be the first
+ letter that is not in the middle of a ligature. Whatsit nodes preceding $c_1$ are ignored; a
+ whatsit found after $c_1$ will be the terminating node $p_m$. All characters that do not have
+ the same font as $c_1$ will be treated as nonletters. The |hyphen_char| for that font must be
+ between 0 and 255, otherwise hyphenation will not be attempted. \TeX\ looks ahead for as many
+ consecutive letters $c_1\ldots c_n$ as possible; however, |n| must be less than 64, so a
+ character that would otherwise be $c_{64}$ is effectively not a letter. Furthermore $c_n$ must
+ not be in the middle of a ligature. In this way we obtain a string of letters $c_1\ldots c_n$
+ that are generated by nodes $p_a\ldots p_b$, where |1<=a<=b+1<=m|. If |n>=l_hyf+r_hyf|, this
+ string qualifies for hyphenation; however, |uc_hyph| must be positive, if $c_1$ is uppercase.
+
+ The hyphenation process takes place in three stages. First, the candidate sequence $c_1 \ldots
+ c_n$ is found; then potential positions for hyphens are determined by referring to hyphenation
+ tables; and finally, the nodes $p_a\ldots p_b$ are replaced by a new sequence of nodes that
+ includes the discretionary breaks found.
+
+ Fortunately, we do not have to do all this calculation very often, because of the way it has
+ been taken out of \TEX's inner loop. For example, when the second edition of the author's
+ 700-page book {\sl Seminumerical Algorithms} was typeset by \TEX, only about 1.2 hyphenations
+ needed to be tried per paragraph, since the line breaking algorithm needed to use two passes on
+ only about 5 per cent of the paragraphs. (This is not true in \LUATEX: we always hyphenate the
+ whole list.)
+
+ When a word been set up to contain a candidate for hyphenation, \TEX\ first looks to see if it
+ is in the user's exception dictionary. If not, hyphens are inserted based on patterns that
+ appear within the given word, using an algorithm due to Frank~M. Liang.
+
+ \stopnarrower
+
+ This is incompatible with \TEX\ because the first word of a paragraph can be hyphenated, but
+ most European users seem to agree that prohibiting hyphenation there was not the best idea ever.
+
+ To be documented: |\hyphenationmode| (a bit set).
+
+ \startbuffer
+ \parindent0pt \hsize=1.1cm
+ 12-34-56 \par
+ 12-34-\hbox{56} \par
+ 12-34-\vrule width 1em height 1.5ex \par
+ 12-\hbox{34}-56 \par
+ 12-\vrule width 1em height 1.5ex-56 \par
+ \hjcode`\1=`\1 \hjcode`\2=`\2 \hjcode`\3=`\3 \hjcode`\4=`\4 \vskip.5cm
+ 12-34-56 \par
+ 12-34-\hbox{56} \par
+ 12-34-\vrule width 1em height 1.5ex \par
+ 12-\hbox{34}-56 \par
+ 12-\vrule width 1em height 1.5ex-56 \par
+ \stopbuffer
+
+ \typebuffer
+
+ \startpacked \getbuffer \stopbuffer
+
+ We only accept an explicit hyphen when there is a preceding glyph and we skip a sequence of
+ explicit hyphens as that normally indicates a \type {--} or \type {---} ligature in which case
+ we can in a worse case usage get bad node lists later on due to messed up ligature building as
+ these dashes are ligatures in base fonts. This is a side effect of the separating the
+ hyphenation, ligaturing and kerning steps. A test is cmr with \type {------}.
+
+ A font handler can collapse successive hyphens but it's not nice to put the burden there. A
+ somewhat messy border case is \type {----} but in \LUATEX\ we don't treat \type {--} and \type
+ {---} special. Also, traditional \TEX\ will break a line at \type {-foo} but this can be
+ disabled by setting the automatic mode to \type {1}.
+
+*/
+
+// # define is_hyphen_char(chr) (get_hc_code(chr) || chr == ex_hyphen_char_par)
+
+inline static halfword tex_aux_is_hyphen_char(halfword chr)
+{
+ if (tex_get_hc_code(chr)) {
+ return tex_get_hc_code(chr);
+ } else if (chr == ex_hyphen_char_par) {
+ return ex_hyphen_char_par;
+ } else {
+ return null;
+ }
+}
+
+static halfword tex_aux_find_next_wordstart(halfword r, halfword first_language)
+{
+ int start_ok = 1;
+ int mathlevel = 1;
+ halfword lastglyph = r;
+ while (r) {
+ switch (node_type(r)) {
+ case boundary_node:
+ if (node_subtype(r) == word_boundary) {
+ start_ok = 1;
+ }
+ break;
+ case disc_node:
+ start_ok = has_disc_option(r, disc_option_post_word);
+ break;
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ case dir_node:
+ case whatsit_node:
+ if (hyphenation_permitted(glyph_hyphenate(lastglyph), strict_start_hyphenation_mode)) {
+ start_ok = 0;
+ }
+ break;
+ case glue_node:
+ start_ok = 1;
+ break;
+ case math_node:
+ while (mathlevel > 0) {
+ r = node_next(r);
+ if (! r) {
+ return r;
+ } else if (node_type(r) == math_node) {
+ if (node_subtype(r) == begin_inline_math) {
+ mathlevel++;
+ } else {
+ mathlevel--;
+ }
+ }
+ }
+ break;
+ case glyph_node:
+ {
+ /*tex
+ When we have no word yet and meet a hyphen (equivalent) we should just
+ keep going. This is not compatible but it does make sense.
+ */
+ int chr = glyph_character(r);
+ int hyp = tex_aux_is_hyphen_char(chr);
+ lastglyph = r;
+ if (hyp) {
+ if (hyphenation_permitted(glyph_hyphenate(r), ignore_bounds_hyphenation_mode)) {
+ /* maybe some tracing */
+ } else {
+ /* todo: already check if we have hj chars left/right i.e. no digits and minus mess */
+ halfword t = node_next(r) ;
+ /*tex Kind of weird that we have the opposite flag test here. */
+ if (t && (node_type(t) == glyph_node) && (! tex_aux_is_hyphen_char(glyph_character(t))) && ! hyphenation_permitted(glyph_hyphenate(r), automatic_hyphenation_mode)) {
+ /*tex We have no word yet and the next character is a non hyphen. */
+ r = tex_aux_compound_word_break(r, get_glyph_language(r), hyp);
+ // test case: \automatichyphenmode0 10\high{-6-1-2-4}
+ start_ok = 1; // todo: also in luatex
+ } else {
+ /*tex We jump over the sequence of hyphens. */
+ while (t && (node_type(t) == glyph_node) && tex_aux_is_hyphen_char(glyph_character(t))) {
+ r = t ;
+ t = node_next(r) ;
+ }
+ if (t) {
+ /*tex We need a restart. */
+ start_ok = 0;
+ } else {
+ /*tex We reached the end of the list so we have no word start. */
+ return null;
+ }
+ }
+ }
+ } else if (start_ok && (get_glyph_language(r) >= first_language) && get_glyph_dohyph(r)) {
+ int l = tex_get_hj_code(get_glyph_language(r), chr);
+ if (l > 0) {
+ if (l == chr || l <= 32 || get_glyph_uchyph(r)) {
+ return r;
+ } else {
+ start_ok = 0;
+ }
+ } else {
+ /*tex We go on. */
+ }
+ } else {
+ /*tex We go on. */
+ }
+ }
+ break;
+ default:
+ start_ok = 0;
+ break;
+ }
+ r = node_next(r);
+ }
+ return r; /* null */
+}
+
+/*tex
+
+ This is the original test, extended with bounds, but still the complex expression turned into
+ a function. However, it actually is part of the old mechanism where hyphenation was mixed
+ with ligature building and kerning, so there was this skipping over a font kern whuch is no
+ longer needed as we have separate steps.
+
+ We keep this as reference:
+
+ \starttyping
+ static int valid_wordend(halfword s, halfword strict_bound)
+ {
+ if (s) {
+ halfword r = s;
+ int clang = get_glyph_language(s);
+ while ( (r) &&
+ ( (type(r) == glyph_node && clang == get_glyph_language(r))
+ || (type(r) == kern_node && (subtype(r) == font_kern))
+ )
+ ) {
+ r = node_next(r);
+ }
+ return (! r || (type(r) == glyph_node && clang != get_glyph_language(r))
+ || type(r) == glue_node
+ || type(r) == penalty_node
+ || (type(r) == kern_node && (subtype(r) == explicit_kern ||
+ subtype(r) == italic_kern ||
+ subtype(r) == accent_kern ))
+ || ((type(r) == hlist_node ||
+ type(r) == vlist_node ||
+ type(r) == rule_node ||
+ type(r) == dir_node ||
+ type(r) == whatsit_node ||
+ type(r) == insert_node ||
+ type(r) == adjust_node
+ ) && ! (strict_bound == 2 || strict_bound == 3))
+ || type(r) == boundary_node
+ );
+ } else {
+ return 1;
+ }
+ }
+ \stopttyping
+
+*/
+
+static int tex_aux_valid_wordend(halfword end_word, halfword r)
+{
+ if (r) {
+ switch (node_type(r)) {
+ // case glyph_node:
+ // case glue_node:
+ // case penalty_node:
+ // case kern_node:
+ // return 1;
+ case disc_node:
+ return has_disc_option(r, disc_option_pre_word);
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ case dir_node:
+ case whatsit_node:
+ case insert_node:
+ case adjust_node:
+ return ! hyphenation_permitted(glyph_hyphenate(end_word), strict_end_hyphenation_mode);
+ }
+ }
+ return 1;
+}
+
+void tex_handle_hyphenation(halfword head, halfword tail)
+{
+ if (head && node_next(head)) {
+ int callback_id = lmt_callback_defined(hyphenate_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, head);
+ lmt_node_list_to_lua(L, tail);
+ i = lmt_callback_call(L, 2, 0, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ } else if (callback_id == 0) {
+ tex_hyphenate_list(head, tail);
+ } else {
+ /* -1 : disabled */
+ }
+ }
+}
+
+static int tex_aux_hnj_hyphen_hyphenate(
+ hjn_dictionary *dict,
+ halfword first,
+ halfword last,
+ int length,
+ halfword left,
+ halfword right,
+ lang_variables *lan
+)
+{
+ /*tex +2 for dots at each end, +1 for points outside characters. */
+ int ext_word_len = length + 2;
+ int hyphen_len = ext_word_len + 1;
+ /*tex Because we have a limit of 64 characters we could just use a static array here: */
+ char *hyphens = lmt_memory_calloc(hyphen_len, sizeof(unsigned char));
+ if (hyphens) {
+ halfword here;
+ int state = 0;
+ int char_num = 0;
+ int done = 0;
+ /*tex Add a '.' to beginning and end to facilitate matching. */
+ node_next(begin_period) = first;
+ node_next(end_period) = node_next(last);
+ node_next(last) = end_period;
+
+ // for (int i = 0; i < hyphen_len; i++) {
+ // hyphens[i] = '0';
+ // }
+ // hyphens[hyphen_len] = 0;
+
+ /*tex Now, run the finite state machine. */
+ for (char_num = 0, here = begin_period; here != node_next(end_period); here = node_next(here)) {
+ int ch;
+ if (here == begin_period || here == end_period) {
+ ch = '.';
+ } else {
+ ch = tex_get_hj_code(get_glyph_language(here), glyph_character(here));
+ if (ch <= 32) {
+ ch = glyph_character(here);
+ }
+ }
+ while (state != -1) {
+ hjn_state *hstate = &dict->states[state];
+ for (int k = 0; k < hstate->num_trans; k++) {
+ if (hstate->trans[k].uni_ch == ch) {
+ char *match;
+ state = hstate->trans[k].new_state;
+ match = dict->states[state].match;
+ if (match) {
+ /*tex
+ We add +2 because 1 string length is one bigger than offset and 1
+ hyphenation starts before first character.
+
+ Why not store the length in states[state] instead of calculating
+ it each time? Okay, performance is okay but still ...
+ */
+ int offset = (int) (char_num + 2 - (int) strlen(match));
+ for (int m = 0; match[m]; m++) {
+ if (hyphens[offset + m] < match[m]) {
+ hyphens[offset + m] = match[m];
+ }
+ }
+ }
+ goto NEXTLETTER;
+ }
+ }
+ state = hstate->fallback_state;
+ }
+ /*tex Nothing worked, let's go to the next character. */
+ state = 0;
+ NEXTLETTER:;
+ char_num++;
+ }
+ /*tex Restore the correct pointers. */
+ node_next(last) = node_next(end_period);
+ /*tex
+ Pattern is |.word.| and |word_len| is 4, |ext_word_len| is 6 and |hyphens| is 7; drop first
+ two and stop after |word_len-1|.
+ */
+ for (here = first, char_num = 2; here != left; here = node_next(here)) {
+ char_num++;
+ }
+ for (; here != right; here = node_next(here)) {
+ if (hyphens[char_num] & 1) {
+ here = tex_aux_insert_syllable_discretionary(here, lan);
+ done += 1;
+ }
+ char_num++;
+ }
+ lmt_memory_free(hyphens);
+ return done;
+ } else {
+ tex_overflow_error("patterns", hyphen_len);
+ return 0;
+ }
+}
+
+/* we can also check the original */
+
+static int tex_aux_still_okay(halfword f, halfword l, halfword r, int n, const char *utf8original) {
+ if (_valid_node_(f) && _valid_node_(l) && node_next(l) == r) {
+ int i = 0;
+ while (f) {
+ ++i;
+ if (node_type(f) != glyph_node) {
+ tex_normal_warning("language", "the hyphenated word contains non-glyphs, skipping");
+ return 0;
+ } else {
+ halfword c = (halfword) aux_str2uni((const unsigned char *) utf8original);
+ utf8original += utf8_size(c);
+ if (! (c && c == glyph_character(f))) {
+ tex_normal_warning("language", "the hyphenated word contains different characters, skipping");
+ return 0;
+ } else if (f != l) {
+ f = node_next(f);
+ } else if (i == n) {
+ return 1;
+ } else {
+ tex_normal_warning("language", "the hyphenated word changed length, skipping");
+ return 0;
+ }
+ }
+ }
+ }
+ tex_normal_warning("language", "the hyphenation list is messed up, skipping");
+ return 0;
+}
+
+static void tex_aux_hyphenate_show(halfword beg, halfword end)
+{
+ if (_valid_node_(beg) && _valid_node_(end)) {
+ halfword nxt = node_next(end);
+ node_next(end) = null;
+ tex_show_node_list(beg, 100, 10000);
+ node_next(end) = nxt;
+ }
+}
+
+/* maybe split: first a processing run */
+
+inline static int is_traditional_hyphen(halfword n)
+{
+ return (
+ (glyph_character(n) == ex_hyphen_char_par) /*tex parameter */
+ && (has_font_text_control(glyph_font(n),text_control_collapse_hyphens)) /*tex font driven */
+ && (hyphenation_permitted(glyph_hyphenate(n), collapse_hyphenation_mode)) /*tex language driven */
+ );
+}
+
+int tex_collapse_list(halfword head, halfword c1, halfword c2, halfword c3) /* ex_hyphen_char_par 0x2013 0x2014 */
+{
+ /*tex Let's play safe: */
+ halfword found = 0;
+ if (head && c1 && c2 && c3) {
+ halfword n1 = head;
+ while (n1) {
+ halfword n2 = node_next(n1);
+ switch (node_type(n1)) {
+ case glyph_node:
+ if (is_traditional_hyphen(n1)) {
+ set_glyph_discpart(n1, glyph_discpart_always);
+ if (n2 && node_type(n2) == glyph_node && is_traditional_hyphen(n2) && glyph_font(n1) == glyph_font(n2)) {
+ halfword n3 = node_next(n2);
+ if (n3 && node_type(n3) == glyph_node && is_traditional_hyphen(n3) && glyph_font(n1) == glyph_font(n3)) {
+ halfword n4 = node_next(n3);
+ glyph_character(n1) = c3;
+ tex_try_couple_nodes(n1, n4);
+ tex_flush_node(n2);
+ tex_flush_node(n3);
+ n1 = n4;
+ } else {
+ glyph_character(n1) = c2;
+ tex_try_couple_nodes(n1, n3);
+ tex_flush_node(n2);
+ n1 = n3;
+ }
+ found = 1;
+ goto AGAIN;
+ } else {
+ glyph_character(n1) = c1; /* can become language dependent */
+ }
+ }
+ break;
+ case disc_node:
+ {
+ halfword done = 0;
+ if (disc_pre_break_head(n1) && tex_collapse_list(disc_pre_break_head(n1), c1, c2, c3)) {
+ ++done;
+ }
+ if (disc_post_break_head(n1) && tex_collapse_list(disc_post_break_head(n1), c1, c2, c3)) {
+ ++done;
+ }
+ if (disc_no_break_head(n1) && tex_collapse_list(disc_no_break_head(n1), c1, c2, c3)) {
+ ++done;
+ }
+ if (done) {
+ tex_check_disc_field(n1);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+ n1 = n2;
+ AGAIN:;
+ }
+ }
+ return found;
+}
+
+void tex_hyphenate_list(halfword head, halfword tail)
+{
+ /*tex Let's play safe: */
+ if (tail) {
+ halfword first_language = first_valid_language_par; /* combine with check below */
+ halfword trace = tracing_hyphenation_par;
+ halfword r = head;
+ /*tex
+ This first movement assures two things:
+
+ \startitemize
+ \startitem
+ That we won't waste lots of time on something that has been handled already (in
+ that case, none of the glyphs match |simple_character|).
+ \stopitem
+ \startitem
+ That the first word can be hyphenated. If the movement was not explicit, then
+ the indentation at the start of a paragraph list would make |find_next_wordstart()|
+ look too far ahead.
+ \stopitem
+ \stopitemize
+ */
+ while (r && node_type(r) != glyph_node) {
+ r = node_next(r);
+ }
+ if (r) {
+ r = tex_aux_find_next_wordstart(r, first_language);
+ if (r) {
+ lang_variables langdata;
+ char utf8word[(4 * max_size_of_word) + 1] = { 0 };
+ char utf8original[(4 * max_size_of_word) + 1] = { 0 };
+ char *utf8ptr = utf8word;
+ char *utf8ori = utf8original;
+ int word_length = 0;
+ int explicit_hyphen = 0;
+ int last_char = 0;
+ int valid = 0;
+ halfword explicit_start = null;
+ halfword saved_tail = node_next(tail);
+ halfword penalty = tex_new_penalty_node(0, word_penalty_subtype);
+ /* kind of curious hack, this addition that we later remove */
+ tex_attach_attribute_list_copy(penalty, r);
+ tex_couple_nodes(tail, penalty); /* todo: attrobute */
+ while (r) {
+ halfword word_start = r;
+ int word_language = get_glyph_language(word_start);
+ if (tex_is_valid_language(word_language)) {
+ halfword word_end = r;
+ int lhmin = get_glyph_lhmin(word_start);
+ int rhmin = get_glyph_rhmin(word_start);
+ int hmin = tex_get_hyphenation_min(word_language);
+ halfword word_font = glyph_font(word_start);
+ if (! tex_is_valid_font(word_font) || font_hyphen_char(word_font) < 0) {
+ /*tex For backward compatibility we set: */
+ word_font = 0;
+ }
+ langdata.pre_hyphen_char = tex_get_pre_hyphen_char(word_language);
+ langdata.post_hyphen_char = tex_get_post_hyphen_char(word_language);
+ while (r && node_type(r) == glyph_node && word_language == get_glyph_language(r)) {
+ halfword chr = glyph_character(r);
+ halfword hyp = tex_aux_is_hyphen_char(chr);
+ if (word_language >= first_language) {
+ last_char = tex_get_hj_code(word_language, chr);
+ if (last_char > 0) {
+ goto GOFORWARD;
+ }
+ }
+ if (hyp) {
+ last_char = hyp;
+ // if (last_char) {
+ // goto GOFORWARD;
+ // }
+ } else {
+ break;
+ }
+ GOFORWARD:
+ // explicit_hyphen = is_hyphen_char(chr);
+ explicit_hyphen = hyp;
+ if (explicit_hyphen && node_next(r) && node_type(node_next(r)) != glyph_node && hyphenation_permitted(glyph_hyphenate(r), ignore_bounds_hyphenation_mode)) {
+ /* maybe some tracing */
+ explicit_hyphen = 0;
+ }
+ if (explicit_hyphen) {
+ break;
+ } else {
+ word_length++;
+ if (word_length >= max_size_of_word) {
+ /* tex_normal_warning("language", "ignoring long word"); */
+ while (r && node_type(r) == glyph_node) {
+ r = node_next(r);
+ }
+ goto PICKUP;
+ } else {
+ if (last_char <= 32) {
+ if (last_char == 32) {
+ last_char = 0 ;
+ }
+ if (word_length <= lhmin) {
+ lhmin = lhmin - last_char + 1 ;
+ if (lhmin < 0) {
+ lhmin = 1;
+ }
+ }
+ if (word_length >= rhmin) {
+ rhmin = rhmin - last_char + 1 ;
+ if (rhmin < 0) {
+ rhmin = 1;
+ }
+ }
+ hmin = hmin - last_char + 1 ;
+ if (hmin < 0) {
+ rhmin = 1;
+ }
+ last_char = chr ;
+ }
+ utf8ori = aux_uni2string(utf8ori, (unsigned) chr);
+ utf8ptr = aux_uni2string(utf8ptr, (unsigned) last_char);
+ word_end = r;
+ r = node_next(r);
+ }
+ }
+ }
+ if (explicit_hyphen) {
+ /*tex We are not at the start, so we only need to look ahead. */
+ if ((get_glyph_discpart(r) == glyph_discpart_replace && ! hyphenation_permitted(glyph_hyphenate(r), syllable_hyphenation_mode))) {
+ /*tex
+ This can be the consequence of inhibition too, see |finish_discretionary|
+ in which case the replace got injected which can have a hyphen. And we want
+ to run the callback if set in order to replace.
+ */
+ valid = 1;
+ goto MESSYCODE;
+ } else {
+ /*tex Maybe we should get rid of this ----- stuff. */
+ halfword t = node_next(r);
+ if (t && node_type(t) == glyph_node && ! tex_aux_is_hyphen_char(glyph_character(t)) && hyphenation_permitted(glyph_hyphenate(t), automatic_hyphenation_mode)) {
+ /*tex we have a word already but the next character may not be a hyphen too */
+ halfword g = r;
+ r = tex_aux_compound_word_break(r, get_glyph_language(g), explicit_hyphen);
+ if (trace > 1) {
+ *utf8ori = 0;
+ tex_begin_diagnostic();
+ tex_print_format("[language: compound word break after %s]", utf8original);
+ tex_end_diagnostic();
+ }
+ if (hyphenation_permitted(glyph_hyphenate(g), compound_hyphenation_mode)) {
+ explicit_hyphen = 0;
+ if (hyphenation_permitted(glyph_hyphenate(g), force_handler_hyphenation_mode) || hyphenation_permitted(glyph_hyphenate(g), feedback_compound_hyphenation_mode)) {
+ set_disc_option(r, disc_option_pre_word | disc_option_post_word);
+ explicit_start = null;
+ valid = 1;
+ goto MESSYCODE;
+ } else {
+ if (! explicit_start) {
+ explicit_start = word_start;
+ }
+ /*tex For exceptions. */
+ utf8ptr = aux_uni2string(utf8ptr, '-');
+ r = t;
+ continue;
+ }
+ }
+ } else {
+ /*tex We jump over the sequence of hyphens ... traditional. */
+ while (t && node_type(t) == glyph_node && tex_aux_is_hyphen_char(glyph_character(t))) {
+ r = t;
+ t = node_next(r);
+ }
+ if (! t) {
+ /*tex we reached the end of the list and will quit the loop later */
+ r = null;
+ }
+ }
+ }
+ } else {
+ valid = tex_aux_valid_wordend(word_end, r);
+ MESSYCODE:
+ /*tex We have a word, r is at the next node. */
+ if (word_font && word_language >= first_language) {
+ /*tex We have a language, actually we already tested that. */
+ struct tex_language *lang = lmt_language_state.languages[word_language];
+ if (lang) {
+ char *replacement = NULL;
+ halfword start = explicit_start ? explicit_start : word_start;
+ int okay = word_length >= lhmin + rhmin && (hmin <= 0 || word_length >= hmin) && hyphenation_permitted(glyph_hyphenate(start), syllable_hyphenation_mode);
+ *utf8ptr = 0;
+ *utf8ori = 0;
+ if (lang->wordhandler && hyphenation_permitted(glyph_hyphenate(start), force_handler_hyphenation_mode)) {
+ halfword restart = node_prev(start); /*tex before the word. */
+ int done = lmt_handle_word(lang, utf8original, utf8word, word_length, start, word_end, &replacement);
+ if (replacement) {
+ if (tex_aux_still_okay(start, word_end, r, word_length, utf8original)) {
+ goto EXCEPTIONS2;
+ } else {
+ goto PICKUP;
+ }
+ } else {
+ /* 1: restart 2: exceptions+patterns 3: patterns *: next word */
+ switch (done) {
+ case 1:
+ if (_valid_node_(restart)) {
+ r = restart;
+ } else if (_valid_node_(start)) {
+ r = node_prev(start);
+ }
+ if (! r) {
+ if (_valid_node_(head)) {
+ tex_normal_warning("language", "the hyphenation list is messed up, recovering");
+ r = head;
+ } else {
+ tex_normal_error("language", "the hyphenated head is messed up, aborting");
+ return;
+ }
+ }
+ goto PICKUP;
+ case 2:
+ if (tex_aux_still_okay(start, word_end, r, word_length, utf8original)) {
+ goto EXCEPTIONS1;
+ } else {
+ goto PICKUP;
+ }
+ case 3:
+ if (tex_aux_still_okay(start, word_end, r, word_length, utf8original)) {
+ goto PATTERNS;
+ } else {
+ goto PICKUP;
+ }
+ default:
+ if (_valid_node_(r)) { /* or word_end */
+ goto PICKUP;
+ } else if (_valid_node_(tail)) {
+ tex_normal_warning("language", "the hyphenation list is messed up, quitting");
+ goto ABORT;
+ } else {
+ // tex_normal_error("language","the hyphenated tail is messed up, aborting");
+ return;
+ }
+ }
+ }
+ }
+ if (! okay || ! valid) {
+ goto PICKUP;
+ }
+ /*tex
+ This is messy and nasty: we can have a word with a - in it which is why
+ we have two branches. Also, every word that suits the length criteria
+ is checked via \LUA. Optimizing this because tests have demonstrated
+ that checking against the min and max lengths of exception strings has
+ no gain.
+ */
+ EXCEPTIONS1:
+ if (lang->exceptions) {
+ replacement = tex_aux_hyphenation_exception(lang->exceptions, utf8word);
+ }
+ EXCEPTIONS2:
+ if (replacement) {
+ /*tex handle the exception and go on to the next word */
+ halfword start = explicit_start ? explicit_start : word_start;
+ halfword beg = node_prev(start);
+ tex_aux_do_exception(start, r, replacement); // r == next_node(word_end)
+ if (trace > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[language: exception %s to %s]", utf8original, replacement);
+ if (trace > 2) {
+ tex_aux_hyphenate_show(node_next(beg), node_prev(r));
+ }
+ tex_end_diagnostic();
+ }
+ lmt_memory_free(replacement);
+ goto PICKUP;
+ }
+ PATTERNS:
+ if (lang->patterns) {
+ if (explicit_start) {
+ /*tex We're done already */
+ } else if (hyphenation_permitted(glyph_hyphenate(word_start), syllable_hyphenation_mode)) {
+ halfword left = word_start;
+ halfword right = r; /*tex We're one after |word_end|. */
+ for (int i = lhmin; i > 1; i--) {
+ left = node_next(left);
+ if (! left || left == right) {
+ goto PICKUP;
+ }
+ }
+ if (right != left) {
+ int done = 0;
+ for (int i = rhmin; i > 0; i--) {
+ right = node_prev(right);
+ if (! right || right == left) {
+ goto PICKUP;
+ }
+ }
+ done = tex_aux_hnj_hyphen_hyphenate(lang->patterns, word_start, word_end, word_length, left, right, &langdata);
+ if (trace > 1) {
+ tex_begin_diagnostic();
+ if (done) {
+ tex_print_format("[language: hyphenated %s at %i positions]", utf8original, done);
+ if (trace > 2) {
+ tex_aux_hyphenate_show(node_next(left), node_prev(right));
+ }
+ } else {
+ tex_print_format("[language: not hyphenated %s]", utf8original);
+ }
+ tex_end_diagnostic();
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ PICKUP:
+ explicit_start = null ;
+ explicit_hyphen = 0;
+ word_length = 0;
+ utf8ptr = utf8word;
+ utf8ori = utf8original;
+ if (r) {
+ r = tex_aux_find_next_wordstart(r, first_language);
+ } else {
+ break;
+ }
+ }
+ ABORT:
+ tex_flush_node(node_next(tail));
+ node_next(tail) = saved_tail;
+ }
+ }
+ }
+}
+
+halfword tex_glyph_to_discretionary(halfword glyph, quarterword code, int keepkern)
+{
+ halfword prev = node_prev(glyph);
+ halfword next = node_next(glyph);
+ halfword disc = tex_new_disc_node(code);
+ halfword kern = null;
+ if (keepkern && next && node_type(next) == kern_node && node_subtype(next) == italic_kern_subtype) {
+ kern = node_next(next);
+ next = node_next(kern);
+ node_next(kern) = null;
+ } else {
+ node_next(glyph) = null;
+ }
+ node_prev(glyph) = null;
+ tex_attach_attribute_list_copy(disc, glyph);
+ tex_set_disc_field(disc, pre_break_code, tex_copy_node_list(glyph, null));
+ tex_set_disc_field(disc, post_break_code, tex_copy_node_list(glyph, null));
+ tex_set_disc_field(disc, no_break_code, glyph);
+ tex_try_couple_nodes(prev, disc);
+ tex_try_couple_nodes(disc, next);
+ return disc;
+} \ No newline at end of file
diff --git a/source/luametatex/source/tex/texlanguage.h b/source/luametatex/source/tex/texlanguage.h
new file mode 100644
index 000000000..f00bf16c6
--- /dev/null
+++ b/source/luametatex/source/tex/texlanguage.h
@@ -0,0 +1,94 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXLANG_H
+# define LMT_TEXLANG_H
+
+/*tex We resolve the properties beforehand and store them in a struct. */
+
+typedef struct language_state_info {
+ struct tex_language **languages;
+ memory_data language_data;
+ lua_Integer handler_table_id;
+ int handler_count;
+} language_state_info;
+
+extern language_state_info lmt_language_state;
+
+typedef struct lang_variables {
+ halfword pre_hyphen_char;
+ halfword post_hyphen_char;
+ halfword pre_exhyphen_char;
+ halfword post_exhyphen_char;
+} lang_variables;
+
+/*tex This is used in: */
+
+typedef struct tex_language {
+ halfword pre_hyphen_char;
+ halfword post_hyphen_char;
+ halfword pre_exhyphen_char;
+ halfword post_exhyphen_char;
+ halfword hyphenation_min;
+ halfword id;
+ hjn_dictionary *patterns;
+ int exceptions;
+ int wordhandler;
+ sa_tree hjcode_head;
+} tex_language;
+
+extern tex_language *tex_new_language (halfword n);
+extern tex_language *tex_get_language (halfword n);
+/* void tex_free_languages (void); */
+
+extern void tex_load_patterns (struct tex_language *lang, const unsigned char *buf);
+extern void tex_load_hyphenation (struct tex_language *lang, const unsigned char *buf);
+
+extern void tex_handle_hyphenation (halfword h, halfword t);
+extern void tex_clear_patterns (struct tex_language *lang);
+extern void tex_clear_hyphenation (struct tex_language *lang);
+extern const char *tex_clean_hyphenation (halfword id, const char *buffer, char **cleaned);
+
+extern void tex_hyphenate_list (halfword head, halfword tail);
+extern int tex_collapse_list (halfword head, halfword c1, halfword c2, halfword c3);
+
+extern void tex_set_pre_hyphen_char (halfword lan, halfword val);
+extern void tex_set_post_hyphen_char (halfword lan, halfword val);
+extern halfword tex_get_pre_hyphen_char (halfword lan);
+extern halfword tex_get_post_hyphen_char (halfword lan);
+
+extern void tex_set_pre_exhyphen_char (halfword lan, halfword val);
+extern void tex_set_post_exhyphen_char (halfword lan, halfword val);
+extern halfword tex_get_pre_exhyphen_char (halfword lan);
+extern halfword tex_get_post_exhyphen_char (halfword lan);
+
+extern void tex_set_hyphenation_min (halfword lan, halfword val);
+extern halfword tex_get_hyphenation_min (halfword lan);
+
+extern void tex_dump_language_data (dumpstream f);
+extern void tex_undump_language_data (dumpstream f);
+
+/* char *tex_get_exception_strings (struct tex_language *lang); */
+
+extern void tex_load_tex_patterns (halfword curlang, halfword head);
+extern void tex_load_tex_hyphenation (halfword curlang, halfword head);
+
+extern void tex_initialize_languages (void);
+extern int tex_is_valid_language (halfword n);
+
+extern halfword tex_glyph_to_discretionary (halfword glyph, quarterword code, int keepkern);
+
+/*
+void tex_hnj_hyphen_hyphenate(
+ HyphenDict *dict,
+ halfword first,
+ halfword last,
+ int size,
+ halfword left,
+ halfword right,
+ lang_variables *lan
+);
+*/
+
+# endif
diff --git a/source/luametatex/source/tex/texlegacy.c b/source/luametatex/source/tex/texlegacy.c
new file mode 100644
index 000000000..78723a25a
--- /dev/null
+++ b/source/luametatex/source/tex/texlegacy.c
@@ -0,0 +1,11 @@
+/*tex
+
+ For a while I keep some recently changed code here. Just in case ... we can always look in
+ the GIT history if needed. Much more happened but that code has gone already. This is from
+ end januari 2021. Eventually all here goes (or already went) into the void, including code
+ that has been rewritten, pruned, upgraded but eventually got discarded. The fittest code
+ survives.
+
+*/
+
+/* pagebuilder state experiment in 2021-05-23 zip */ \ No newline at end of file
diff --git a/source/luametatex/source/tex/texlinebreak.c b/source/luametatex/source/tex/texlinebreak.c
new file mode 100644
index 000000000..2172277ec
--- /dev/null
+++ b/source/luametatex/source/tex/texlinebreak.c
@@ -0,0 +1,3531 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ We come now to what is probably the most interesting algorithm of \TEX: the mechanism for
+ choosing the \quote {best possible} breakpoints that yield the individual lines of a paragraph.
+ \TEX's line-breaking algorithm takes a given horizontal list and converts it to a sequence of
+ boxes that are appended to the current vertical list. In the course of doing this, it creates
+ a special data structure containing three kinds of records that are not used elsewhere in
+ \TEX. Such nodes are created while a paragraph is being processed, and they are destroyed
+ afterwards; thus, the other parts of \TEX\ do not need to know anything about how line-breaking
+ is done.
+
+ The method used here is based on an approach devised by Michael F. Plass and the author in 1977,
+ subsequently generalized and improved by the same two people in 1980. A detailed discussion
+ appears in {\sl SOFTWARE---Practice \AM\ Experience \bf11} (1981), 1119--1184, where it is
+ shown that the line-breaking problem can be regarded as a special case of the problem of
+ computing the shortest path in an acyclic network. The cited paper includes numerous examples
+ and describes the history of line breaking as it has been practiced by printers through the
+ ages. The present implementation adds two new ideas to the algorithm of 1980: Memory space
+ requirements are considerably reduced by using smaller records for inactive nodes than for
+ active ones, and arithmetic overflow is avoided by using \quote {delta distances} instead of
+ keeping track of the total distance from the beginning of the paragraph to the current point.
+
+ The |line_break| procedure should be invoked only in horizontal mode; it leaves that mode and
+ places its output into the current vlist of the enclosing vertical mode (or internal vertical
+ mode). There is one explicit parameter: |d| is true for partial paragraphs preceding display
+ math mode; in this case the amount of additional penalty inserted before the final line is
+ |display_widow_penalty| instead of |widow_penalty|.
+
+ There are also a number of implicit parameters: The hlist to be broken starts at |node_next
+ (head)|, and it is nonempty. The value of |prev_graf| in the enclosing semantic level tells
+ where the paragraph should begin in the sequence of line numbers, in case hanging indentation
+ or |\parshape| are in use; |prev_graf| is zero unless this paragraph is being continued after a
+ displayed formula. Other implicit parameters, such as the |par_shape_ptr| and various penalties
+ to use for hyphenation, etc., appear in |eqtb|.
+
+ After |line_break| has acted, it will have updated the current vlist and the value of
+ |prev_graf|. Furthermore, the global variable |just_box| will point to the final box created
+ by |line_break|, so that the width of this line can be ascertained when it is necessary to
+ decide whether to use |above_display_skip| or |above_display_short_skip| before a displayed
+ formula.
+
+ We have an additional parameter |\parfillleftskip| and below we cheat a bit. We add two glue
+ nodes so that the par builder will work the same and doesn't need to be adapted, but when we're
+ done we move the leftbound node to the beginning of the (last) line.
+
+ Todo: change some variable names to more meaningful ones so that the code is easier to
+ understand. (Remark for myself: the lua variant that i use for playing around occasionally is
+ not in sync with the code here!)
+
+*/
+
+linebreak_state_info lmt_linebreak_state = {
+ .just_box = 0,
+ .last_line_fill = 0,
+ .no_shrink_error_yet = 0,
+ .second_pass = 0,
+ .final_pass = 0,
+ .threshold = 0,
+ .adjust_spacing = 0,
+ .adjust_spacing_step = 0,
+ .adjust_spacing_shrink = 0,
+ .adjust_spacing_stretch = 0,
+ .max_stretch_ratio = 0,
+ .max_shrink_ratio = 0,
+ .current_font_step = 0,
+ .passive = 0,
+ .printed_node = 0,
+ .pass_number = 0,
+ .active_width = { 0 },
+ .background = { 0 },
+ .break_width = { 0 },
+ // .auto_breaking = 0,
+ // .math_level = 0,
+ .internal_penalty_interline = 0,
+ .internal_penalty_broken = 0,
+ .internal_left_box = null,
+ .internal_left_box_width = 0,
+ .init_internal_left_box = 0,
+ .init_internal_left_box_width = 0,
+ .internal_right_box = null,
+ .internal_right_box_width = 0,
+ .internal_middle_box = null,
+ .disc_width = { 0 },
+ .minimal_demerits = { 0 },
+ .minimum_demerits = 0,
+ .easy_line = 0,
+ .last_special_line = 0,
+ .first_width = 0,
+ .second_width = 0,
+ .first_indent = 0,
+ .second_indent = 0,
+ .best_bet = 0,
+ .fewest_demerits = 0,
+ .best_line = 0,
+ .actual_looseness = 0,
+ .line_difference = 0,
+ .do_last_line_fit = 0,
+ .fill_width = { 0 },
+ .dir_ptr = 0,
+ .warned = 0,
+ .calling_back = 0,
+};
+
+/*tex
+ We could use a bit larger array and glue_orders where normal starts at 0 so we then need a larger
+ array. Let's not do that now.
+*/
+
+typedef enum fill_orders {
+ fi_order = 0,
+ fil_order = 1,
+ fill_order = 2,
+ filll_order = 3,
+} fill_orders;
+
+/*tex
+
+ The |just_box| variable has the |hlist_node| for the last line of the new paragraph. In it's
+ complete form, |line_break| is a rather lengthy procedure --- sort of a small world unto itself
+ --- we must build it up little by little. Below you see only the general outline. The main task
+ performed here is to move the list from |head| to |temp_head| and go into the enclosing semantic
+ level. We also append the |\parfillskip| glue to the end of the paragraph, removing a space (or
+ other glue node) if it was there, since spaces usually precede blank lines and instances of
+ |$$|. The |par_fill_skip| is preceded by an infinite penalty, so it will never be considered as
+ a potential breakpoint.
+
+ */
+
+void tex_line_break_prepare(
+ halfword par,
+ halfword *tail,
+ halfword *parinit_left_skip_glue,
+ halfword *parinit_right_skip_glue,
+ halfword *parfill_left_skip_glue,
+ halfword *parfill_right_skip_glue,
+ halfword *final_penalty
+)
+{
+ /* too much testing of next */
+ if (node_type(par) == par_node) {
+ *tail = *tail ? *tail : tex_tail_of_node_list(par);
+ *final_penalty = tex_new_penalty_node(infinite_penalty, line_penalty_subtype);
+ *parfill_left_skip_glue = tex_new_glue_node(tex_get_par_par(par, par_par_fill_left_skip_code), par_fill_left_skip_glue);
+ *parfill_right_skip_glue = tex_new_glue_node(tex_get_par_par(par, par_par_fill_right_skip_code), par_fill_right_skip_glue);
+ *parinit_left_skip_glue = null;
+ *parinit_right_skip_glue = null;
+ if (par != *tail && node_type(*tail) == glue_node && ! tex_is_par_init_glue(*tail)) {
+ halfword prev = node_prev(*tail);
+ node_next(prev) = null;
+ tex_flush_node(*tail);
+ *tail = prev;
+ }
+ tex_attach_attribute_list_copy(*final_penalty, par);
+ tex_attach_attribute_list_copy(*parfill_left_skip_glue, par);
+ tex_attach_attribute_list_copy(*parfill_right_skip_glue, par);
+ tex_try_couple_nodes(*tail, *final_penalty);
+ tex_try_couple_nodes(*final_penalty, *parfill_left_skip_glue);
+ tex_try_couple_nodes(*parfill_left_skip_glue, *parfill_right_skip_glue);
+ *tail = *parfill_right_skip_glue;
+ if (node_next(par)) {
+ halfword n = node_next(par);
+ while (n) {
+ if (node_type(n) == glue_node && node_subtype(n) == indent_skip_glue) {
+ *parinit_left_skip_glue = tex_new_glue_node(tex_get_par_par(par, par_par_init_left_skip_code), par_init_left_skip_glue);
+ *parinit_right_skip_glue = tex_new_glue_node(tex_get_par_par(par, par_par_init_right_skip_code), par_init_right_skip_glue);
+ tex_attach_attribute_list_copy(*parinit_left_skip_glue, par);
+ tex_attach_attribute_list_copy(*parinit_right_skip_glue, par);
+ tex_try_couple_nodes(*parinit_right_skip_glue, n);
+ tex_try_couple_nodes(*parinit_left_skip_glue, *parinit_right_skip_glue);
+ tex_try_couple_nodes(par, *parinit_left_skip_glue);
+ break;
+ } else {
+ n = node_next(n);
+ }
+ }
+ }
+ }
+}
+
+void tex_line_break(int d, int line_break_context)
+{
+ halfword head = node_next(cur_list.head);
+ /*tex There should be a local par node at the beginning! */
+ if (node_type(head) == par_node) {
+ /*tex We need this for over- or underfull box messages. */
+ halfword tail = cur_list.tail;
+ lmt_packaging_state.pack_begin_line = cur_list.mode_line;
+ node_prev(head) = null;
+ /*tex Hyphenate, driven by callback or fallback to normal \TEX. */
+ if (tex_list_has_glyph(head)) {
+ tex_handle_hyphenation(head, tail);
+ head = tex_handle_glyphrun(head, line_break_context, par_dir(head));
+ tail = tex_tail_of_node_list(head);
+ tex_try_couple_nodes(cur_list.head, head);
+ cur_list.tail = tail;
+ }
+ /*tex We remove (only one) trailing glue node, when present. */
+ // if (head != tail && node_type(tail) == glue_node && ! tex_is_par_init_glue(tail)) {
+ // halfword prev = node_prev(tail);
+ // node_next(prev) = null;
+ // tex_flush_node(tail);
+ // cur_list.tail = prev;
+ // }
+ node_next(temp_head) = head;
+ /*tex There should be a local par node at the beginning! */
+ if (node_type(head) == par_node) {
+ /*tex
+ The tail thing is a bit weird here as it's not the tail. One day I will look into
+ this. One complication is that we have the normal break routing or a callback that
+ replaces it but that callback can call the normal routine itself with specific
+ parameters set.
+ */
+ halfword start_of_par;
+ halfword par = head;
+ halfword parinit_left_skip_glue = null;
+ halfword parinit_right_skip_glue = null;
+ halfword parfill_left_skip_glue = null;
+ halfword parfill_right_skip_glue = null;
+ halfword final_penalty = null;
+ tex_line_break_prepare(par, &tail, &parinit_left_skip_glue, &parinit_right_skip_glue, &parfill_left_skip_glue, &parfill_right_skip_glue, &final_penalty);
+ cur_list.tail = tail;
+ /*tex
+ We start with a prepared list. If you mess with that the linebreak routine might not
+ work well especially if the pointers are messed up. So be it.
+ */
+ lmt_node_filter_callback(pre_linebreak_filter_callback, line_break_context, temp_head, &(cur_list.tail));
+ /*tex
+ We assume that the list is still okay.
+ */
+ lmt_linebreak_state.last_line_fill = cur_list.tail;
+ tex_pop_nest();
+ start_of_par = cur_list.tail;
+ lmt_linebreak_state.calling_back = 1;
+ if (lmt_linebreak_callback(d, temp_head, &(cur_list.tail))) {
+ /*tex
+ When we end up here we have a prepared list so we need to make sure that when
+ the callback usaes that list with the built in break routine we don't do that
+ twice. One should work on copies! Afterwards we need to find the correct value
+ for the |just_box|.
+ */
+ halfword box_search = cur_list.tail;
+ lmt_linebreak_state.just_box = null;
+ if (box_search) {
+ do {
+ if (node_type(box_search) == hlist_node) {
+ lmt_linebreak_state.just_box = box_search;
+ }
+ box_search = node_next(box_search);
+ } while (box_search);
+ }
+ if (! lmt_linebreak_state.just_box) {
+ tex_handle_error(
+ succumb_error_type,
+ "Invalid linebreak_filter",
+ "A linebreaking routine should return a non-empty list of nodes and at least one\n"
+ "of those has to be a \\hbox. Sorry, I cannot recover from this."
+ );
+ }
+ } else {
+ line_break_properties properties = {
+ .initial_par = par,
+ .display_math = d,
+ .tracing_paragraphs = tracing_paragraphs_par,
+ .paragraph_dir = par_dir(par),
+ .parfill_left_skip = parfill_left_skip_glue,
+ .parfill_right_skip = parfill_right_skip_glue,
+ .parinit_left_skip = parinit_left_skip_glue,
+ .parinit_right_skip = parinit_right_skip_glue,
+ .pretolerance = tex_get_par_par(par, par_pre_tolerance_code),
+ .tolerance = tex_get_par_par(par, par_tolerance_code),
+ .emergency_stretch = tex_get_par_par(par, par_emergency_stretch_code),
+ .looseness = tex_get_par_par(par, par_looseness_code),
+ .adjust_spacing = tex_get_par_par(par, par_adjust_spacing_code),
+ .protrude_chars = tex_get_par_par(par, par_protrude_chars_code),
+ .adj_demerits = tex_get_par_par(par, par_adj_demerits_code),
+ .line_penalty = tex_get_par_par(par, par_line_penalty_code),
+ .last_line_fit = tex_get_par_par(par, par_last_line_fit_code),
+ .double_hyphen_demerits = tex_get_par_par(par, par_double_hyphen_demerits_code),
+ .final_hyphen_demerits = tex_get_par_par(par, par_final_hyphen_demerits_code),
+ .hsize = tex_get_par_par(par, par_hsize_code),
+ .left_skip = tex_get_par_par(par, par_left_skip_code),
+ .right_skip = tex_get_par_par(par, par_right_skip_code),
+ .hang_indent = tex_get_par_par(par, par_hang_indent_code),
+ .hang_after = tex_get_par_par(par, par_hang_after_code),
+ .par_shape = tex_get_par_par(par, par_par_shape_code),
+ .inter_line_penalty = tex_get_par_par(par, par_inter_line_penalty_code),
+ .inter_line_penalties = tex_get_par_par(par, par_inter_line_penalties_code),
+ .club_penalty = tex_get_par_par(par, par_club_penalty_code),
+ .club_penalties = tex_get_par_par(par, par_club_penalties_code),
+ .widow_penalty = tex_get_par_par(par, par_widow_penalty_code),
+ .widow_penalties = tex_get_par_par(par, par_widow_penalties_code),
+ .display_widow_penalty = tex_get_par_par(par, par_display_widow_penalty_code),
+ .display_widow_penalties = tex_get_par_par(par, par_display_widow_penalties_code),
+ .orphan_penalty = tex_get_par_par(par, par_orphan_penalty_code),
+ .orphan_penalties = tex_get_par_par(par, par_orphan_penalties_code),
+ .broken_penalty = tex_get_par_par(par, par_broken_penalty_code),
+ .baseline_skip = tex_get_par_par(par, par_baseline_skip_code),
+ .line_skip = tex_get_par_par(par, par_line_skip_code),
+ .line_skip_limit = tex_get_par_par(par, par_line_skip_limit_code),
+ .adjust_spacing_step = tex_get_par_par(par, par_adjust_spacing_step_code),
+ .adjust_spacing_shrink = tex_get_par_par(par, par_adjust_spacing_shrink_code),
+ .adjust_spacing_stretch = tex_get_par_par(par, par_adjust_spacing_stretch_code),
+ .hyphenation_mode = tex_get_par_par(par, par_hyphenation_mode_code),
+ .shaping_penalties_mode = tex_get_par_par(par, par_shaping_penalties_mode_code),
+ .shaping_penalty = tex_get_par_par(par, par_shaping_penalty_code),
+ };
+ tex_do_line_break(&properties);
+ /*tex
+ We assume that the list is still okay when we do some post line break stuff.
+ */
+ }
+ lmt_linebreak_state.calling_back = 0;
+ lmt_node_filter_callback(post_linebreak_filter_callback, line_break_context, start_of_par, &(cur_list.tail));
+ lmt_packaging_state.pack_begin_line = 0;
+ return;
+ }
+ }
+ tex_confusion("missing local par node");
+}
+
+/*tex
+
+ Glue nodes in a horizontal list that is being paragraphed are not supposed to include \quote
+ {infinite} shrinkability; that is why the algorithm maintains four registers for stretching but
+ only one for shrinking. If the user tries to introduce infinite shrinkability, the shrinkability
+ will be reset to finite and an error message will be issued. A boolean variable
+ |no_shrink_error_yet| prevents this error message from appearing more than once per paragraph.
+
+ Beware, this does an in-place fix to the glue (which can be a register!). As we store glues a
+ bit different we do a different fix here.
+
+*/
+
+static scaled tex_aux_checked_shrink(halfword p)
+{
+ if (glue_shrink(p) && glue_shrink_order(p) != normal_glue_order) {
+ if (lmt_linebreak_state.no_shrink_error_yet) {
+ lmt_linebreak_state.no_shrink_error_yet = 0;
+ tex_handle_error(
+ normal_error_type,
+ "Infinite glue shrinkage found in a paragraph",
+ "The paragraph just ended includes some glue that has infinite shrinkability,\n"
+ "e.g., '\\hskip 0pt minus 1fil'. Such glue doesn't belong there---it allows a\n"
+ "paragraph of any length to fit on one line. But it's safe to proceed, since the\n"
+ "offensive shrinkability has been made finite."
+ );
+ }
+ glue_shrink_order(p) = normal_glue_order;
+ }
+ return glue_shrink(p);
+}
+
+/*tex
+
+ A pointer variable |cur_p| runs through the given horizontal list as we look for breakpoints.
+ This variable is global, since it is used both by |line_break| and by its subprocedure
+ |try_break|.
+
+ Another global variable called |threshold| is used to determine the feasibility of individual
+ lines: breakpoints are feasible if there is a way to reach them without creating lines whose
+ badness exceeds |threshold|. (The badness is compared to |threshold| before penalties are
+ added, so that penalty values do not affect the feasibility of breakpoints, except that no
+ break is allowed when the penalty is 10000 or more.) If |threshold| is 10000 or more, all
+ legal breaks are considered feasible, since the |badness| function specified above never
+ returns a value greater than~10000.
+
+ Up to three passes might be made through the paragraph in an attempt to find at least one set
+ of feasible breakpoints. On the first pass, we have |threshold=pretolerance| and |second_pass
+ = final_pass = false|. If this pass fails to find a feasible solution, |threshold| is set to
+ |tolerance|, |second_pass| is set |true|, and an attempt is made to hyphenate as many words as
+ possible. If that fails too, we add |emergency_stretch| to the background stretchability and
+ set |final_pass = true|.
+
+ |second_pass| is this our second attempt to break this paragraph and |final_path| our final
+ attempt to break this paragraph while |threshold| is the maximum badness on feasible lines.
+
+ The maximum fill level for |hlist_stack|. Maybe good if larger than |2 * max_quarterword|, so
+ that box nesting level would overflow first. The stack for |find_protchar_left()| and
+ |find_protchar_right()|; |hlist_stack_level| is the fill level for |hlist_stack|
+
+*/
+
+# define max_hlist_stack 512
+
+/* We can optimize this when we have a global setting. */
+
+static void tex_aux_warn_expand_pars(void)
+{
+ if (! lmt_linebreak_state.warned) {
+ tex_normal_warning("font expansion", "using fonts with different limit of expansion in one paragraph is not allowed");
+ lmt_linebreak_state.warned = 1;
+ }
+}
+
+static int tex_aux_check_expand_pars(halfword adjust_spacing_step, halfword f)
+{
+ if (adjust_spacing_step > 0) {
+ return 1;
+ } else if ((font_step(f) == 0) || ((font_max_stretch(f) == 0) && (font_max_shrink(f) == 0))) {
+ return 0;
+ } else if (lmt_linebreak_state.current_font_step < 0) {
+ lmt_linebreak_state.current_font_step = font_step(f);
+ } else if (lmt_linebreak_state.current_font_step != font_step(f)) {
+ tex_normal_error("font expansion", "using fonts with different step of expansion in one paragraph is not allowed");
+ }
+ {
+ int m = font_max_stretch(f);
+ if (m) {
+ if (lmt_linebreak_state.max_stretch_ratio < 0) {
+ lmt_linebreak_state.max_stretch_ratio = m;
+ } else if (lmt_linebreak_state.max_stretch_ratio > m) {
+ lmt_linebreak_state.max_stretch_ratio = m;
+ tex_aux_warn_expand_pars();
+ }
+ }
+ }
+ {
+ int m = font_max_shrink(f);
+ if (m) {
+ if (lmt_linebreak_state.max_shrink_ratio < 0) {
+ lmt_linebreak_state.max_shrink_ratio = -m;
+ } else if (-lmt_linebreak_state.max_shrink_ratio > -m) {
+ lmt_linebreak_state.max_shrink_ratio = -m;
+ tex_aux_warn_expand_pars();
+ }
+ }
+ }
+ return 1;
+}
+
+/*tex
+
+ Search left to right from list head |l|, returns 1st non-skipable item:
+
+*/
+
+static halfword tex_aux_find_protchar_left(halfword l, int d)
+{
+ int done = 0 ;
+ halfword initial = l;
+ while (node_next(l) && node_type(l) == hlist_node && tex_zero_box_dimensions(l) && ! box_list(l)) {
+ /*tex For paragraph start with |\parindent = 0pt| or any empty hbox. */
+ l = node_next(l);
+ done = 1 ;
+ }
+ if (! done && node_type(l) == par_node) {
+ l = node_next(l);
+ done = 1 ;
+ }
+ if (! done && d) {
+ while (node_next(l) && ! (node_type(l) == glyph_node || non_discardable(l))) {
+ /*tex standard discardables at line break, \TEX book, p 95 */
+ l = node_next(l);
+ }
+ }
+ if (node_type(l) != glyph_node) {
+ halfword t;
+ int run = 1;
+ halfword hlist_stack[max_hlist_stack];
+ int hlist_stack_level = 0;
+ do {
+ t = l;
+ while (run && node_type(l) == hlist_node && box_list(l)) {
+ if (hlist_stack_level >= max_hlist_stack) {
+ /* return tex_normal_error("push_node", "stack overflow"); */
+ return initial;
+ } else {
+ hlist_stack[hlist_stack_level++] = l;
+ }
+ l = box_list(l);
+ }
+ while (run && tex_protrusion_skipable(l)) {
+ while (! node_next(l) && hlist_stack_level > 0) {
+ /*tex Don't visit this node again. */
+ if (hlist_stack_level <= 0) {
+ /*tex This can point to some bug. */
+ /* return tex_normal_error("pop_node", "stack underflow (internal error)"); */
+ return initial;
+ } else {
+ l = hlist_stack[--hlist_stack_level];
+ }
+ run = 0;
+ }
+ if (node_next(l) && node_type(l) == boundary_node && node_subtype(l) == protrusion_boundary && (boundary_data(l) == 1 || boundary_data(l) == 3)) {
+ /*tex Skip next node. */
+ l = node_next(l);
+ }
+ if (node_next(l)) {
+ l = node_next(l);
+ } else if (hlist_stack_level == 0) {
+ run = 0;
+ }
+ }
+ } while (t != l);
+ }
+ return l;
+}
+
+/*tex
+
+ Search right to left from list tail |r| to head |l|, returns 1st non-skipable item.
+
+*/
+
+static halfword tex_aux_find_protchar_right(halfword l, halfword r)
+{
+ if (r) {
+ halfword t;
+ int run = 1;
+ halfword initial = r;
+ halfword hlist_stack[max_hlist_stack];
+ int hlist_stack_level = 0;
+ do {
+ t = r;
+ while (run && node_type(r) == hlist_node && box_list(r)) {
+ if (hlist_stack_level >= max_hlist_stack) {
+ /* tex_normal_error("push_node", "stack overflow"); */
+ return initial;
+ } else {
+ hlist_stack[hlist_stack_level++] = l;
+ }
+ if (hlist_stack_level >= max_hlist_stack) {
+ /* tex_normal_error("push_node", "stack overflow"); */
+ return initial;
+ } else {
+ hlist_stack[hlist_stack_level++] = r;
+ }
+ l = box_list(r);
+ r = l;
+ while (node_next(r)) {
+ halfword s = r;
+ r = node_next(r);
+ node_prev(r) = s;
+ }
+ }
+ while (run && tex_protrusion_skipable(r)) {
+ while (r == l && hlist_stack_level > 0) {
+ /*tex Don't visit this node again. */
+ if (hlist_stack_level <= 0) {
+ /*tex This can point to some bug. */
+ /* return tex_normal_error("pop_node", "stack underflow (internal error)"); */
+ return initial;
+ } else {
+ r = hlist_stack[--hlist_stack_level];
+ }
+
+ if (hlist_stack_level <= 0) {
+ /*tex This can point to some bug. */
+ /* return tex_normal_error("pop_node", "stack underflow (internal error)"); */
+ return initial;
+ } else {
+ l = hlist_stack[--hlist_stack_level];
+ }
+ }
+ if ((r != l) && r) {
+ if (node_prev(r) && node_type(r) == boundary_node && node_subtype(r) == protrusion_boundary && (boundary_data(r) == 2 || boundary_data(r) == 3)) {
+ /*tex Skip next node. */
+ r = node_prev(r);
+ }
+ if (node_prev(r)) {
+ r = node_prev(r);
+ } else {
+ /*tex This is the input: |\leavevmode \penalty -10000 \penalty -10000| */
+ run = 0;
+ }
+ } else if (r == l && hlist_stack_level == 0) {
+ run = 0;
+ }
+ }
+ } while (t != r);
+ }
+ return r;
+}
+
+/*tex
+
+ The algorithm essentially determines the best possible way to achieve each feasible combination
+ of position, line, and fitness. Thus, it answers questions like, \quotation {What is the best
+ way to break the opening part of the paragraph so that the fourth line is a tight line ending at
+ such-and-such a place?} However, the fact that all lines are to be the same length after a
+ certain point makes it possible to regard all sufficiently large line numbers as equivalent, when
+ the looseness parameter is zero, and this makes it possible for the algorithm to save space and
+ time.
+
+ An \quote {active node} and a \quote {passive node} are created in |mem| for each feasible
+ breakpoint that needs to be considered. Active nodes are three words long and passive nodes
+ are two words long. We need active nodes only for breakpoints near the place in the
+ paragraph that is currently being examined, so they are recycled within a comparatively short
+ time after they are created.
+
+ An active node for a given breakpoint contains six fields:
+
+ \startitemize[n]
+
+ \startitem
+ |vlink| points to the next node in the list of active nodes; the last active node has
+ |vlink=active|.
+ \stopitem
+
+ \startitem
+ |break_node| points to the passive node associated with this breakpoint.
+ \stopitem
+
+ \startitem
+ |line_number| is the number of the line that follows this breakpoint.
+ \stopitem
+
+ \startitem
+ |fitness| is the fitness classification of the line ending at this breakpoint.
+ \stopitem
+
+ \startitem
+ |type| is either |hyphenated_node| or |unhyphenated_node|, depending on whether this
+ breakpoint is a |disc_node|.
+ \stopitem
+
+ \startitem
+ |total_demerits| is the minimum possible sum of demerits over all lines leading from
+ the beginning of the paragraph to this breakpoint.
+ \stopitem
+
+ \stopitemize
+
+ The value of |node_next(active)| points to the first active node on a vlinked list of all currently
+ active nodes. This list is in order by |line_number|, except that nodes with |line_number >
+ easy_line| may be in any order relative to each other.
+
+*/
+
+void tex_initialize_active(void)
+{
+ node_type(active_head) = hyphenated_node;
+ active_line_number(active_head) = max_halfword;
+ /*tex
+ The |subtype| is actually the |fitness|. It is set with |new_node| to one of the fitness
+ values.
+ */
+ active_fitness(active_head) = very_loose_fit;
+}
+
+/*tex
+
+ The passive node for a given breakpoint contains eight fields:
+
+ \startitemize
+
+ \startitem
+ |vlink| points to the passive node created just before this one, if any, otherwise it
+ is |null|.
+ \stopitem
+
+ \startitem
+ |cur_break| points to the position of this breakpoint in the horizontal list for the
+ paragraph being broken.
+ \stopitem
+
+ \startitem
+ |prev_break| points to the passive node that should precede this one in an optimal path
+ to this breakpoint.
+ \stopitem
+
+ \startitem
+ |serial| is equal to |n| if this passive node is the |n|th one created during the
+ current pass. (This field is used only when printing out detailed statistics about the
+ line-breaking calculations.)
+ \stopitem
+
+ \startitem
+ |passive_pen_inter| holds the current |localinterlinepenalty|
+ \stopitem
+
+ \startitem
+ |passive_pen_broken| holds the current |localbrokenpenalty|
+ \stopitem
+
+ \stopitemize
+
+ There is a global variable called |passive| that points to the most recently created passive
+ node. Another global variable, |printed_node|, is used to help print out the paragraph when
+ detailed information about the line-breaking computation is being displayed.
+
+ The most recent node on passive list, the most recent node that has been printed, and the number
+ of passive nodes allocated on this pass, is registered in the passive field.
+
+ The active list also contains \quote {delta} nodes that help the algorithm compute the badness
+ of individual lines. Such nodes appear only between two active nodes, and they have |type =
+ delta_node|. If |p| and |r| are active nodes and if |q| is a delta node between them, so that
+ |vlink (p) = q| and |vlink (q) = r|, then |q| tells the space difference between lines in the
+ horizontal list that start after breakpoint |p| and lines that start after breakpoint |r|. In
+ other words, if we know the length of the line that starts after |p| and ends at our current
+ position, then the corresponding length of the line that starts after |r| is obtained by adding
+ the amounts in node~|q|. A delta node contains seven scaled numbers, since it must record the
+ net change in glue stretchability with respect to all orders of infinity. The natural width
+ difference appears in |mem[q+1].sc|; the stretch differences in units of pt, sfi, fil, fill,
+ and filll appear in |mem[q + 2 .. q + 6].sc|; and the shrink difference appears in |mem[q +
+ 7].sc|. The |subtype| field of a delta node is not used.
+
+ {\em NB: Actually, we have more fields now.}
+
+ As the algorithm runs, it maintains a set of seven delta-like registers for the length of the
+ line following the first active breakpoint to the current position in the given hlist. When it
+ makes a pass through the active list, it also maintains a similar set of seven registers for
+ the length following the active breakpoint of current interest. A third set holds the length
+ of an empty line (namely, the sum of |\leftskip| and |\rightskip|); and a fourth set is used
+ to create new delta nodes.
+
+ When we pass a delta node we want to do operations like:
+
+ \starttyping
+ for k := 1 to 7 do
+ cur_active_width[k] := cur_active_width[k] + mem[q+k].sc|};
+ \stoptyping
+
+ and we want to do this without the overhead of |for| loops so we use update macros.
+
+ |active_width| is he distance from first active node to~|cur_p|, |background| the length of an
+ \quote {empty} line, and |break_width| the length being computed after current break.
+
+ We make |auto_breaking| accessible out of |line_break|.
+
+ Let's state the principles of the delta nodes more precisely and concisely, so that the
+ following programs will be less obscure. For each legal breakpoint~|p| in the paragraph, we
+ define two quantities $\alpha(p)$ and $\beta(p)$ such that the length of material in a line
+ from breakpoint~|p| to breakpoint~|q| is $\gamma+\beta(q)-\alpha(p)$, for some fixed $\gamma$.
+ Intuitively, $\alpha(p)$ and $\beta(q)$ are the total length of material from the beginning
+ of the paragraph to a point after a break at |p| and to a point before a break at |q|; and
+ $\gamma$ is the width of an empty line, namely the length contributed by |\leftskip| and
+ |\rightskip|.
+
+ Suppose, for example, that the paragraph consists entirely of alternating boxes and glue
+ skips; let the boxes have widths $x_1\ldots x_n$ and let the skips have widths $y_1\ldots
+ y_n$, so that the paragraph can be represented by $x_1y_1\ldots x_ny_n$. Let $p_i$ be the
+ legal breakpoint at $y_i$; then $\alpha(p_i) = x_1 + y_1 + \cdots + x_i + y_i$, and $\beta
+ (p_i) = x_1 + y_1 + \cdots + x_i$. To check this, note that the length of material from
+ $p_2$ to $p_5$, say, is $\gamma + x_3 + y_3 + x_4 + y_4 + x_5 = \gamma + \beta (p_5) -
+ \alpha (p_2)$.
+
+ The quantities $\alpha$, $\beta$, $\gamma$ involve glue stretchability and shrinkability as
+ well as a natural width. If we were to compute $\alpha(p)$ and $\beta(p)$ for each |p|, we
+ would need multiple precision arithmetic, and the multiprecise numbers would have to be kept
+ in the active nodes. \TeX\ avoids this problem by working entirely with relative differences
+ or \quote {deltas}. Suppose, for example, that the active list contains $a_1\,\delta_1\,a_2\,
+ \delta_2\,a_3$, where the |a|'s are active breakpoints and the $\delta$'s are delta nodes.
+ Then $\delta_1 = \alpha(a_1) - \alpha(a_2)$ and $\delta_2 = \alpha(a_2) - \alpha(a_3)$. If the
+ line breaking algorithm is currently positioned at some other breakpoint |p|, the |active_width|
+ array contains the value $\gamma +\beta(p) - \alpha(a_1)$. If we are scanning through the list
+ of active nodes and considering a tentative line that runs from $a_2$ to~|p|, say, the
+ |cur_active_width| array will contain the value $\gamma + \beta(p) - \alpha(a_2)$. Thus, when we
+ move from $a_2$ to $a_3$, we want to add $\alpha(a_2) - \alpha(a_3)$ to |cur_active_width|; and
+ this is just $\delta_2$, which appears in the active list between $a_2$ and $a_3$. The
+ |background| array contains $\gamma$. The |break_width| array will be used to calculate values
+ of new delta nodes when the active list is being updated.
+
+ The heart of the line-breaking procedure is |try_break|, a subroutine that tests if the current
+ breakpoint |cur_p| is feasible, by running through the active list to see what lines of text
+ can be made from active nodes to~|cur_p|. If feasible breaks are possible, new break nodes are
+ created. If |cur_p| is too far from an active node, that node is deactivated.
+
+ The parameter |pi| to |try_break| is the penalty associated with a break at |cur_p|; we have
+ |pi = eject_penalty| if the break is forced, and |pi=inf_penalty| if the break is illegal.
+
+ The other parameter, |break_type|, is set to |hyphenated_node| or |unhyphenated_node|, depending
+ on whether or not the current break is at a |disc_node|. The end of a paragraph is also regarded
+ as |hyphenated_node|; this case is distinguishable by the condition |cur_p = null|.
+
+ \startlines
+ |internal_pen_inter|: running |\localinterlinepenalty|
+ |internal_pen_broken|: running |\localbrokenpenalty|
+ |internal_left_box|: running |\localleftbox|
+ |internal_left_box_width|: running |\localleftbox|
+ |init_internal_left_box|: running |\localleftbox|
+ |init_internal_left_box_width|: running |\localleftbox| width
+ |internal_right_box|: running |\localrightbox|
+ |internal_right_box_width|: running |\localrightbox| width
+ |disc_width|: the length of discretionary material preceding a break
+ \stoplines
+
+ As we consider various ways to end a line at |cur_p|, in a given line number class, we keep
+ track of the best total demerits known, in an array with one entry for each of the fitness
+ classifications. For example, |minimal_demerits [tight_fit]| contains the fewest total
+ demerits of feasible line breaks ending at |cur_p| with a |tight_fit| line; |best_place
+ [tight_fit]| points to the passive node for the break before |cur_p| that achieves such an
+ optimum; and |best_pl_line[tight_fit]| is the |line_number| field in the active node
+ corresponding to |best_place [tight_fit]|. When no feasible break sequence is known, the
+ |minimal_demerits| entries will be equal to |awful_bad|, which is $2^{30}-1$. Another variable,
+ |minimum_demerits|, keeps track of the smallest value in the |minimal_demerits| array.
+
+ The length of lines depends on whether the user has specified |\parshape| or |\hangindent|. If
+ |par_shape_ptr| is not null, it points to a $(2n+1)$-word record in |mem|, where the |vinfo|
+ in the first word contains the value of |n|, and the other $2n$ words contain the left margins
+ and line lengths for the first |n| lines of the paragraph; the specifications for line |n|
+ apply to all subsequent lines. If |par_shape_ptr = null|, the shape of the paragraph depends on
+ the value of |n = hang_after|; if |n >= 0|, hanging indentation takes place on lines |n + 1|,
+ |n + 2|, \dots, otherwise it takes place on lines 1, \dots, $\vert n\vert$. When hanging
+ indentation is active, the left margin is |hang_indent|, if |hang_indent >= 0|, else it is 0;
+ the line length is $|hsize|-\vert|hang_indent|\vert$. The normal setting is |par_shape_ptr =
+ null|, |hang_after = 1|, and |hang_indent = 0|. Note that if |hang_indent = 0|, the value of
+ |hang_after| is irrelevant.
+
+ Some more variables and remarks:
+
+ line numbers |> easy_line| are equivalent in break nodes
+
+ line numbers |> last_special_line| all have the same width
+
+ |first_width| is the width of all lines |<= last_special_line|, if no |\parshape| has been
+ specified
+
+ |second_width| is the width of all lines |> last_special_line|
+
+ |first_indent| is the left margin to go with |first_width|
+
+ |second_indent| s the left margin to go with |second_width|
+
+ |best_bet| indicated the passive node and its predecessors
+
+ |fewest_demerits| are the demerits associated with |best_bet|
+
+ |best_line| is the line number following the last line of the new paragraph
+
+ |actual_looseness| is the difference between |line_number (best_bet)| and the optimum
+ |best_line|
+
+ |line_diff| is the difference between the current line number and the optimum |best_line|
+
+ \TEX\ makes use of the fact that |hlist_node|, |vlist_node|, |rule_node|, |insert_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.
+
+*/
+
+static halfword tex_aux_clean_up_the_memory(halfword p)
+{
+ halfword q = node_next(active_head);
+ while (q != active_head) {
+ p = node_next(q);
+ tex_flush_node(q);
+ q = p;
+ }
+ q = lmt_linebreak_state.passive;
+ while (q) {
+ p = node_next(q);
+ tex_flush_node(q);
+ q = p;
+ }
+ return p;
+}
+
+/*tex
+ Instead of macros we use inline functions. Nowadays compilers generate code that is quite
+ similar as when we use macros (and sometimes even better).
+*/
+
+inline static void tex_aux_add_disc_source_to_target(halfword adjust_spacing, scaled target[], const scaled source[])
+{
+ target[total_glue_amount] += source[total_glue_amount];
+ if (adjust_spacing) {
+ target[font_stretch_amount] += source[font_stretch_amount];
+ target[font_shrink_amount] += source[font_shrink_amount];
+ }
+}
+
+inline static void tex_aux_sub_disc_target_from_source(halfword adjust_spacing, scaled target[], const scaled source[])
+{
+ target[total_glue_amount] -= source[total_glue_amount];
+ if (adjust_spacing) {
+ target[font_stretch_amount] -= source[font_stretch_amount];
+ target[font_shrink_amount] -= source[font_shrink_amount];
+ }
+}
+
+inline static void tex_aux_reset_disc_target(halfword adjust_spacing, scaled *target)
+{
+ target[total_glue_amount] = 0;
+ if (adjust_spacing) {
+ target[font_stretch_amount] = 0;
+ target[font_shrink_amount] = 0;
+ }
+}
+
+/* A memcopy for the whole array is probably more efficient. */
+
+inline static void tex_aux_set_target_to_source(halfword adjust_spacing, scaled target[], const scaled source[])
+{
+ for (int i = total_glue_amount; i <= total_shrink_amount; i++) {
+ target[i] = source[i];
+ }
+ if (adjust_spacing) {
+ target[font_shrink_amount] = source[font_shrink_amount];
+ target[font_stretch_amount] = source[font_stretch_amount];
+ }
+}
+
+/*
+ These delta nodes use an offset and as a result we waste half of the memory words. So, by not
+ using an offset but just named fields, we can save 4 memory words (32 bytes) per delta node. So,
+ instead of this:
+
+ \starttyping
+ inline void add_to_target_from_delta(halfword adjust_spacing, scaled *target, halfword delta)
+ {
+ for (int i = total_glue_amount; i <= total_shrink_amount; i++) {
+ target[i] += delta_field(delta, i);
+ }
+ if (adjust_spacing) {
+ target[font_stretch_amount] += delta_field(delta, font_stretch_amount);
+ target[font_shrink_amount] += delta_field(delta, font_shrink_amount);
+ }
+ }
+ \stoptyping
+
+ We use the more verbose variants and let the compiler optimize the lot.
+
+*/
+
+inline static void tex_aux_add_to_target_from_delta(halfword adjust_spacing, scaled target[], halfword delta)
+{
+ target[total_glue_amount] += delta_field_total_glue(delta);
+ target[total_stretch_amount] += delta_field_total_stretch(delta);
+ target[total_fi_amount] += delta_field_total_fi_amount(delta);
+ target[total_fil_amount] += delta_field_total_fil_amount(delta);
+ target[total_fill_amount] += delta_field_total_fill_amount(delta);
+ target[total_filll_amount] += delta_field_total_filll_amount(delta);
+ target[total_shrink_amount] += delta_field_total_shrink(delta);
+ if (adjust_spacing) {
+ target[font_stretch_amount] += delta_field_font_stretch(delta);
+ target[font_shrink_amount] += delta_field_font_shrink(delta);
+ }
+}
+
+inline static void tex_aux_sub_delta_from_target(halfword adjust_spacing, scaled target[], halfword delta)
+{
+ target[total_glue_amount] -= delta_field_total_glue(delta);
+ target[total_stretch_amount] -= delta_field_total_stretch(delta);
+ target[total_fi_amount] -= delta_field_total_fi_amount(delta);
+ target[total_fil_amount] -= delta_field_total_fil_amount(delta);
+ target[total_fill_amount] -= delta_field_total_fill_amount(delta);
+ target[total_filll_amount] -= delta_field_total_filll_amount(delta);
+ target[total_shrink_amount] -= delta_field_total_shrink(delta);
+ if (adjust_spacing) {
+ target[font_stretch_amount] -= delta_field_font_stretch(delta);
+ target[font_shrink_amount] -= delta_field_font_shrink(delta);
+ }
+}
+
+inline static void tex_aux_add_to_delta_from_delta(halfword adjust_spacing, halfword target, halfword source)
+{
+ delta_field_total_glue(target) += delta_field_total_glue(source);
+ delta_field_total_stretch(target) += delta_field_total_stretch(source);
+ delta_field_total_fi_amount(target) += delta_field_total_fi_amount(source);
+ delta_field_total_fil_amount(target) += delta_field_total_fil_amount(source);
+ delta_field_total_fill_amount(target) += delta_field_total_fill_amount(source);
+ delta_field_total_filll_amount(target) += delta_field_total_filll_amount(source);
+ delta_field_total_shrink(target) += delta_field_total_shrink(source);
+ if (adjust_spacing) {
+ delta_field_font_stretch(target) += delta_field_font_stretch(source);
+ delta_field_font_shrink(target) += delta_field_font_shrink(source);
+ }
+}
+
+inline static void tex_aux_set_delta_from_difference(halfword adjust_spacing, halfword delta, const scaled source_1[], const scaled source_2[])
+{
+ delta_field_total_glue(delta) = (source_1[total_glue_amount] - source_2[total_glue_amount]);
+ delta_field_total_stretch(delta) = (source_1[total_stretch_amount] - source_2[total_stretch_amount]);
+ delta_field_total_fi_amount(delta) = (source_1[total_fi_amount] - source_2[total_fi_amount]);
+ delta_field_total_fil_amount(delta) = (source_1[total_fil_amount] - source_2[total_fil_amount]);
+ delta_field_total_fill_amount(delta) = (source_1[total_fill_amount] - source_2[total_fill_amount]);
+ delta_field_total_filll_amount(delta) = (source_1[total_filll_amount] - source_2[total_filll_amount]);
+ delta_field_total_shrink(delta) = (source_1[total_shrink_amount] - source_2[total_shrink_amount]);
+ if (adjust_spacing) {
+ delta_field_font_stretch(delta) = (source_1[font_stretch_amount] - source_2[font_stretch_amount]);
+ delta_field_font_shrink(delta) = (source_1[font_shrink_amount] - source_2[font_shrink_amount]);
+ }
+}
+
+inline static void tex_aux_add_delta_from_difference(halfword adjust_spacing, halfword delta, const scaled source_1[], const scaled source_2[])
+{
+ delta_field_total_glue(delta) += (source_1[total_glue_amount] - source_2[total_glue_amount]);
+ delta_field_total_stretch(delta) += (source_1[total_stretch_amount] - source_2[total_stretch_amount]);
+ delta_field_total_fi_amount(delta) += (source_1[total_fi_amount] - source_2[total_fi_amount]);
+ delta_field_total_fil_amount(delta) += (source_1[total_fil_amount] - source_2[total_fil_amount]);
+ delta_field_total_fill_amount(delta) += (source_1[total_fill_amount] - source_2[total_fill_amount]);
+ delta_field_total_filll_amount(delta) += (source_1[total_filll_amount] - source_2[total_filll_amount]);
+ delta_field_total_shrink(delta) += (source_1[total_shrink_amount] - source_2[total_shrink_amount]);
+ if (adjust_spacing) {
+ delta_field_font_stretch(delta) += (source_1[font_stretch_amount] - source_2[font_stretch_amount]);
+ delta_field_font_shrink(delta) += (source_1[font_shrink_amount] - source_2[font_shrink_amount]);
+ }
+}
+
+/*tex
+
+ This function is used to add the width of a list of nodes (from a discretionary) to one of the
+ width arrays. Replacement texts and discretionary texts are supposed to contain only character
+ nodes, kern nodes, and box or rule nodes.
+
+ From now on we just ignore \quite {invalid} nodes. If any such node influences the width, so be
+ it.
+
+ \starttyping
+ static void bad_node_in_disc_error(halfword p)
+ {
+ tex_formatted_error(
+ "linebreak",
+ "invalid node with type %s found in discretionary",
+ node_data[node_type(p)].name
+ );
+ }
+ \stoptyping
+*/
+
+static void tex_aux_add_to_widths(halfword s, int adjust_spacing, int adjust_spacing_step, scaled widths[])
+{
+ /* todo only check_expand_pars once per font (or don't check) */
+ while (s) {
+ switch (node_type(s)) {
+ case glyph_node:
+ widths[total_glue_amount] += tex_glyph_width(s);
+ if (adjust_spacing && ! tex_has_glyph_option(s, glyph_option_no_expansion) && tex_aux_check_expand_pars(adjust_spacing_step, glyph_font(s))) {
+ lmt_packaging_state.previous_char_ptr = s;
+ widths[font_stretch_amount] += tex_char_stretch(s);
+ widths[font_shrink_amount] += tex_char_shrink(s);
+ };
+ break;
+ case hlist_node:
+ case vlist_node:
+ widths[total_glue_amount] += box_width(s);
+ break;
+ case rule_node:
+ widths[total_glue_amount] += rule_width(s);
+ break;
+ case glue_node:
+ widths[total_glue_amount] += glue_amount(s);
+ widths[2 + glue_stretch_order(s)] += glue_stretch(s);
+ widths[total_shrink_amount] += glue_shrink(s);
+ break;
+ case kern_node:
+ widths[total_glue_amount] += kern_amount(s);
+ if (adjust_spacing == adjust_spacing_full && node_subtype(s) == font_kern_subtype) {
+ halfword n = node_prev(s);
+ if (n && node_type(n) == glyph_node && ! tex_has_glyph_option(node_next(s), glyph_option_no_expansion)) {
+ widths[font_stretch_amount] += tex_kern_stretch(s);
+ widths[font_shrink_amount] += tex_kern_shrink(s);
+ }
+ }
+ break;
+ case disc_node:
+ break;
+ default:
+ /* bad_node_in_disc_error(s); */
+ break;
+ }
+ s = node_next(s);
+ }
+}
+
+/*tex
+
+ This function is used to substract the width of a list of nodes (from a discretionary) from one
+ of the width arrays. It is used only once, but deserves it own function because of orthogonality
+ with the |add_to_widths| function.
+
+*/
+
+static void tex_aux_sub_from_widths(halfword s, int adjust_spacing, int adjust_spacing_step, scaled widths[])
+{
+ while (s) {
+ /*tex Subtract the width of node |s| from |break_width|; */
+ switch (node_type(s)) {
+ case glyph_node:
+ widths[total_glue_amount] -= tex_glyph_width(s);
+ if (adjust_spacing && ! tex_has_glyph_option(s, glyph_option_no_expansion) && tex_aux_check_expand_pars(adjust_spacing_step, glyph_font(s))) {
+ lmt_packaging_state.previous_char_ptr = s;
+ widths[font_stretch_amount] -= tex_char_stretch(s);
+ widths[font_shrink_amount] -= tex_char_shrink(s);
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ widths[total_glue_amount] -= box_width(s);
+ break;
+ case rule_node:
+ widths[total_glue_amount] -= rule_width(s);
+ break;
+ case glue_node:
+ widths[total_glue_amount] -= glue_amount(s);
+ widths[2 + glue_stretch_order(s)] -= glue_stretch(s);
+ widths[total_shrink_amount] -= glue_shrink(s);
+ break;
+ case kern_node:
+ widths[total_glue_amount] -= kern_amount(s);
+ if (adjust_spacing == adjust_spacing_full && node_subtype(s) == font_kern_subtype) {
+ halfword n = node_prev(s);
+ if (n && node_type(n) == glyph_node && ! tex_has_glyph_option(node_next(s), glyph_option_no_expansion)) {
+ widths[font_stretch_amount] -= tex_kern_stretch(s);
+ widths[font_shrink_amount] -= tex_kern_shrink(s);
+ }
+ }
+ break;
+ case disc_node:
+ break;
+ default:
+ /* bad_node_in_disc_error(s); */
+ break;
+ }
+ s = node_next(s);
+ }
+}
+
+/*tex
+
+ When we insert a new active node for a break at |cur_p|, suppose this new node is to be placed
+ just before active node |a|; then we essentially want to insert $\delta\,|cur_p|\,\delta ^
+ \prime$ before |a|, where $\delta = \alpha (a) - \alpha (|cur_p|)$ and $\delta ^ \prime =
+ \alpha (|cur_p|) - \alpha (a)$ in the notation explained above. The |cur_active_width| array
+ now holds $\gamma + \beta (|cur_p|) - \alpha (a)$; so $\delta$ can be obtained by subtracting
+ |cur_active_width| from the quantity $\gamma + \beta (|cur_p|) - \alpha (|cur_p|)$. The latter
+ quantity can be regarded as the length of a line from |cur_p| to |cur_p|; we call it the
+ |break_width| at |cur_p|.
+
+ The |break_width| is usually negative, since it consists of the background (which is normally
+ zero) minus the width of nodes following~|cur_p| that are eliminated after a break. If, for
+ example, node |cur_p| is a glue node, the width of this glue is subtracted from the background;
+ and we also look ahead to eliminate all subsequent glue and penalty and kern and math nodes,
+ subtracting their widths as well.
+
+ Kern nodes do not disappear at a line break unless they are |explicit|.
+
+*/
+
+static void tex_aux_compute_break_width(int break_type, int adjust_spacing, int adjust_spacing_step, halfword p)
+{
+ /*tex
+
+ Glue and other whitespace to be skipped after a break; used if unhyphenated, or |post_break
+ = null|.
+
+ */
+ halfword s = p;
+ if (p) {
+ switch (break_type) {
+ case hyphenated_node:
+ case delta_node:
+ case passive_node:
+ /*tex
+
+ Compute the discretionary |break_width| values. When |p| is a discretionary
+ break, the length of a line \quotation {from |p| to |p|} has to be defined
+ properly so that the other calculations work out. Suppose that the pre-break
+ text at |p| has length $l_0$, the post-break text has length $l_1$, and the
+ replacement text has length |l|. Suppose also that |q| is the node following
+ the replacement text. Then length of a line from |p| to |q| will be computed as
+ $\gamma + \beta (q) - \alpha (|p|)$, where $\beta (q) = \beta (|p|) - l_0 + l$.
+ The actual length will be the background plus $l_1$, so the length from |p| to
+ |p| should be $\gamma + l_0 + l_1 - l$. If the post-break text of the
+ discretionary is empty, a break may also discard~|q|; in that unusual case we
+ subtract the length of~|q| and any other nodes that will be discarded after the
+ discretionary break.
+
+ The value of $l_0$ need not be computed, since |line_break| will put it into the
+ global variable |disc_width| before calling |try_break|. In case of nested
+ discretionaries, we always follow the no-break path, as we are talking about the
+ breaking on {\it this} position.
+
+ */
+ tex_aux_sub_from_widths(disc_no_break_head(p), adjust_spacing, adjust_spacing_step, lmt_linebreak_state.break_width);
+ tex_aux_add_to_widths(disc_post_break_head(p), adjust_spacing, adjust_spacing_step, lmt_linebreak_state.break_width);
+ tex_aux_add_disc_source_to_target(adjust_spacing, lmt_linebreak_state.break_width, lmt_linebreak_state.disc_width);
+ if (disc_post_break_head(p)) {
+ s = null;
+ } else {
+ /*tex no |post_break|: skip any whitespace following */
+ s = node_next(p);
+ }
+ break;
+ }
+ }
+ while (s) {
+ switch (node_type(s)) {
+ case glue_node:
+ /*tex Subtract glue from |break_width|; */
+ lmt_linebreak_state.break_width[total_glue_amount] -= glue_amount(s);
+ lmt_linebreak_state.break_width[2 + glue_stretch_order(s)] -= glue_stretch(s);
+ lmt_linebreak_state.break_width[total_shrink_amount] -= glue_shrink(s);
+ break;
+ case penalty_node:
+ break;
+ case kern_node:
+ if (node_subtype(s) != explicit_kern_subtype && node_subtype(s) != italic_kern_subtype) {
+ return;
+ } else {
+ lmt_linebreak_state.break_width[total_glue_amount] -= kern_amount(s);
+ break;
+ }
+ case math_node:
+ if (tex_math_glue_is_zero(s)) {
+ lmt_linebreak_state.break_width[total_glue_amount] -= math_surround(s);
+ } else {
+ lmt_linebreak_state.break_width[total_glue_amount] -= math_amount(s);
+ lmt_linebreak_state.break_width[2 + math_stretch_order(s)] -= math_stretch(s);
+ lmt_linebreak_state.break_width[total_shrink_amount] -= math_shrink(s);
+ }
+ break;
+ default:
+ return;
+ };
+ s = node_next(s);
+ }
+}
+
+static void tex_aux_print_break_node(halfword q, halfword fit_class, halfword break_type, halfword cur_p, const line_break_properties *properties)
+{
+ (void) properties;
+ /*tex Print a symbolic description of the new break node. */
+ tex_print_format(
+ "%l[break: serial %i, line %i.%i,%s demerits %i, ",
+ passive_serial(lmt_linebreak_state.passive),
+ active_line_number(q) - 1,
+ fit_class,
+ break_type == hyphenated_node ? " hyphenated, " : "",
+ active_total_demerits(q)
+ );
+ if (lmt_linebreak_state.do_last_line_fit) {
+ /*tex Print additional data in the new active node. */
+ tex_print_format(
+ " short %D, %s %D, ",
+ active_short(q), pt_unit,
+ cur_p ? "glue" : "active",
+ active_glue(q), pt_unit
+ );
+ }
+ tex_print_format(
+ "previous %i]",
+ passive_prev_break(lmt_linebreak_state.passive) ? passive_serial(passive_prev_break(lmt_linebreak_state.passive)) : 0
+ );
+}
+
+static const char *tex_aux_node_name(halfword cur_p)
+{
+ if (cur_p) {
+ /*tex This could be more generic helper. */
+ switch (node_type(cur_p)) {
+ case penalty_node : return "penalty";
+ case disc_node : return "discretionary";
+ case kern_node : return "kern";
+ case glue_node : return "glue"; /* in traditional tex "" */
+ default : return "math";
+ }
+ } else {
+ return "par";
+ }
+}
+
+static void tex_aux_print_feasible_break(halfword cur_p, halfword r, halfword b, int pi, int d, int artificial_demerits, const line_break_properties *properties)
+{
+ (void) properties;
+ /*tex Print a symbolic description of this feasible break. */
+ if (lmt_linebreak_state.printed_node != cur_p) {
+ /*tex Print the list between |printed_node| and |cur_p|, then set |printed_node := cur_p|. */
+ tex_print_nlp();
+ if (cur_p) {
+ halfword save_link = node_next(cur_p);
+ node_next(cur_p) = null;
+ tex_short_display(node_next(lmt_linebreak_state.printed_node));
+ node_next(cur_p) = save_link;
+ } else {
+ tex_short_display(node_next(lmt_linebreak_state.printed_node));
+ }
+ lmt_linebreak_state.printed_node = cur_p;
+ }
+ tex_print_format(
+ "%l[break: feasible, trigger %s, serial %i, badness %B, penalty %i, demerits %B]",
+ tex_aux_node_name(cur_p),
+ active_break_node(r) ? passive_serial(active_break_node(r)) : 0,
+ b,
+ pi,
+ artificial_demerits ? awful_bad : d
+ );
+}
+
+# define total_font_stretch cur_active_width[font_stretch_amount]
+# define total_font_shrink cur_active_width[font_shrink_amount]
+
+/*tex We implement this one later on. */
+
+/*
+ The only reason why we still have line_break_dir is because we have some experimental protrusion
+ trickery depending on it.
+*/
+
+static void tex_aux_post_line_break(const line_break_properties *properties, halfword line_break_dir);
+
+/*tex
+
+ The next subroutine is used to compute the badness of glue, when a total |t| is supposed to be
+ made from amounts that sum to~|s|. According to {\em The \TEX book}, the badness of this
+ situation is $100(t/s)^3$; however, badness is simply a heuristic, so we need not squeeze out
+ the last drop of accuracy when computing it. All we really want is an approximation that has
+ similar properties.
+
+ The actual method used to compute the badness is easier to read from the program than to
+ describe in words. It produces an integer value that is a reasonably close approximation to
+ $100(t/s)^3$, and all implementations of \TEX\ should use precisely this method. Any badness of
+ $2^{13}$ or more is treated as infinitely bad, and represented by 10000.
+
+ It is not difficult to prove that |badness (t + 1, s) >= badness (t, s) >= badness (t, s + 1)|
+ The badness function defined here is capable of computing at most 1095 distinct values, but
+ that is plenty.
+
+ A core aspect of the linebreak algorithm is the calculation of badness. The formula currently
+ used has evolved with the tex versions before Don Knuth settled on this approach. And I (HH)
+ admit that I see no real reason to change something here. The only possible extension could
+ be changing the hardcoded |loose_criterium| of 99 and |decent_criterium| of 12. These could
+ become parameters instead. When looking at the code you will notice a loop that runs from
+ |very_loose_fit| to |tight_fit| with the following four steps:
+
+ \starttyping
+ very_loose_fit loose_fit decent_fit tight_fit
+ \stoptyping
+
+ where we have only |loose_fit| and |decent_fit| with associated criteria later on. So, as an
+ experiment I decided to add two steps in between.
+
+ \starttyping
+ very_loose_fit semi_loose_fit loose_fit decent_fit semi_tight_fit tight_fit
+ \stoptyping
+
+ Watch how we keep the assymetrical nature of this sequence: there is basicaly one tight
+ step less than loose steps. Adding these steps took hardly any code so it was a cheap
+ experiment. However, the result is not that spectacular: I'm pretty sure that users will
+ not be able to choose consistently what result looks better, but who knows. For the moment
+ I keep it, if only to be able to discuss it as useless extension. Configuring the value s
+ is done with |\linebreakcriterium| which gets split into 4 parts (2 bytes per criterium).
+
+ It is probably hard to explain to users what a different setting does and although one can
+ force different output in narrow raggedright text it would probbably enough to just make
+ the |decent_criterium| configureable. Anyway, because we're talking heuristics and pretty
+ good estimates from Don Knuth here, it would be pretentious to suggest that I really did
+ research this fuzzy topic (if it was worth the effort at all).
+
+*/
+
+halfword tex_badness(scaled t, scaled s)
+{
+ /*tex Approximation to $\alpha t/s$, where $\alpha^3\approx 100\cdot2^{18}$ */
+ if (t == 0) {
+ return 0;
+ } else if (s <= 0) {
+ return infinite_bad;
+ } else {
+ /*tex $297^3=99.94\times2^{18}$ */
+ if (t <= large_width_excess) {
+ t = (t * 297) / s;
+ } else if (s >= small_stretchability) {
+ t = t / (s / 297);
+ }
+ if (t > 1290) {
+ /*tex $1290^3<2^{31}<1291^3$ */
+ return infinite_bad;
+ } else {
+ /*tex This is $t^3/2^{18}$, rounded to the nearest integer. */
+ return ((t * t * t + 0400000) / 01000000);
+ }
+ }
+}
+
+static inline void tex_split_line_break_criterium(halfword criterium, halfword *semi_tight, halfword *decent, halfword *semi_loose, halfword *loose) {
+ *semi_tight = (criterium >> 24) & 0x7F;
+ *decent = (criterium >> 16) & 0x7F;
+ *semi_loose = (criterium >> 8) & 0x7F;
+ *loose = criterium & 0x7F;
+ if (! *semi_tight) {
+ *semi_tight = semi_tight_criterium;
+ }
+ if (! *decent) {
+ *decent = decent_criterium;
+ }
+ if (! *semi_loose) {
+ *semi_loose = semi_loose_criterium;
+ }
+ if (! *loose) {
+ *loose = loose_criterium;
+ }
+}
+
+static inline halfword tex_normalized_loose_badness(halfword b, halfword loose, halfword semi_loose, halfword decent)
+{
+ // if (b > loose_criterium) {
+ // return very_loose_fit;
+ // } else if (b > decent_criterium) {
+ // return loose_fit;
+ // } else {
+ // return decent_fit;
+ // }
+ if (b > loose) {
+ return very_loose_fit;
+ } else if (b > semi_loose) {
+ return semi_loose_fit;
+ } else if (b > decent) {
+ return loose_fit;
+ } else {
+ return decent_fit;
+ }
+}
+
+static inline halfword tex_normalized_tight_badness(halfword b, halfword decent, halfword semi_tight)
+{
+ // if (b > decent_criterium) {
+ // return tight_fit;
+ // } else {
+ // return decent_fit;
+ // }
+ if (b > semi_tight) {
+ return semi_tight_fit;
+ } else if (b > decent) {
+ return tight_fit;
+ } else {
+ return decent_fit;
+ }
+}
+
+static void tex_aux_try_break(
+ const line_break_properties *properties,
+ halfword pi, /* a penalty */
+ halfword break_type,
+ halfword first_p,
+ halfword cur_p
+)
+{
+ /*tex runs through the active list */
+ halfword r;
+ /*tex stays a step behind |r| */
+ halfword prev_r = active_head;
+ /*tex a step behind |prev_r|, if |type(prev_r) = delta_node| */
+ halfword prev_prev_r = null;
+ /*tex maximum line number in current equivalence class of lines */
+ halfword old_l = 0;
+ /*tex have we found a feasible break at |cur_p|? */
+ int no_break_yet = 1;
+ /*tex line number of current active node */
+ halfword l;
+ /*tex should node |r| remain in the active list? */
+ int node_r_stays_active;
+ /*tex the current line will be justified to this width */
+ scaled line_width = 0;
+ /*tex possible fitness class of test line */
+ halfword fit_class;
+ /*tex badness of test line */
+ halfword b;
+ /*tex demerits of test line */
+ int d;
+ /*tex has |d| been forced to zero? */
+ int artificial_demerits;
+ /*tex used in badness calculations */
+ scaled shortfall = 0;
+ /*tex glue stretch or shrink of test line, adjustment for last line */
+ scaled g = 0;
+ /*tex distance from current active node */
+ scaled cur_active_width[10] = { 0 };
+ halfword best_place[n_of_finess_values];
+ halfword best_place_line[n_of_finess_values];
+ scaled best_place_short[n_of_finess_values];
+ scaled best_place_glue[n_of_finess_values];
+ /*tex Experiment */
+ halfword semi_tight, decent, semi_loose, loose;
+ /* in par node */
+ tex_split_line_break_criterium(line_break_criterium_par, &semi_tight, &decent, &semi_loose, &loose);
+ /*tex Make sure that |pi| is in the proper range; */
+ if (pi >= infinite_penalty) {
+ /*tex this breakpoint is inhibited by infinite penalty */
+ return;
+ } else if (pi <= -infinite_penalty) {
+ /*tex this breakpoint will be forced */
+ pi = eject_penalty;
+ }
+ tex_aux_set_target_to_source(properties->adjust_spacing, cur_active_width, lmt_linebreak_state.active_width);
+ while (1) {
+ r = node_next(prev_r);
+ /*tex
+
+ If node |r| is of type |delta_node|, update |cur_active_width|, set |prev_r| and
+ |prev_prev_r|, then |goto continue|. The following code uses the fact that |type
+ (active) <> delta_node|.
+
+ Here we get: |unhyphenated_node|, |hyphenated_node, |delta_node|, |passive_node|
+
+ */
+ if (node_type(r) == delta_node) {
+ /*tex implicit */
+ tex_aux_add_to_target_from_delta(properties->adjust_spacing, cur_active_width, r);
+ prev_prev_r = prev_r;
+ prev_r = r;
+ continue;
+ }
+ /*tex
+
+ If a line number class has ended, create new active nodes for the best feasible breaks
+ in that class; then |return| if |r = active|, otherwise compute the new |line_width|.
+
+ The first part of the following code is part of \TEX's inner loop, so we don't want to
+ waste any time. The current active node, namely node |r|, contains the line number that
+ will be considered next. At the end of the list we have arranged the data structure so
+ that |r = active| and |line_number (active) > old_l|.
+
+ */
+ l = active_line_number(r);
+ if (l > old_l) {
+ /*tex now we are no longer in the inner loop */
+ if ((lmt_linebreak_state.minimum_demerits < awful_bad) && ((old_l != lmt_linebreak_state.easy_line) || (r == active_head))) {
+ /*tex
+
+ Create new active nodes for the best feasible breaks just found. It is not
+ necessary to create new active nodes having |minimal_demerits| greater than
+ |linebreak_state.minimum_demerits + abs (adj_demerits)|, since such active
+ nodes will never be chosen in the final paragraph breaks. This observation
+ allows us to omit a substantial number of feasible breakpoints from further
+ consideration.
+
+ */
+ if (no_break_yet) {
+ no_break_yet = 0;
+ tex_aux_set_target_to_source(properties->adjust_spacing, lmt_linebreak_state.break_width, lmt_linebreak_state.background);
+ tex_aux_compute_break_width(break_type, properties->adjust_spacing, properties->adjust_spacing_step, cur_p);
+ }
+ /*tex
+
+ Insert a delta node to prepare for breaks at |cur_p|. We use the fact that
+ |type (active) <> delta_node|.
+
+ */
+ if (node_type(prev_r) == delta_node) {
+ /*tex modify an existing delta node */
+ tex_aux_add_delta_from_difference(properties->adjust_spacing, prev_r, lmt_linebreak_state.break_width, cur_active_width);
+ } else if (prev_r == active_head) {
+ /*tex no delta node needed at the beginning */
+ tex_aux_set_target_to_source(properties->adjust_spacing, lmt_linebreak_state.active_width, lmt_linebreak_state.break_width);
+ } else {
+ halfword q = tex_new_node(delta_node, (quarterword) very_loose_fit);
+ node_next(q) = r;
+ tex_aux_set_delta_from_difference(properties->adjust_spacing, q, lmt_linebreak_state.break_width, cur_active_width);
+ node_next(prev_r) = q;
+ prev_prev_r = prev_r;
+ prev_r = q;
+ }
+ if (abs(properties->adj_demerits) >= awful_bad - lmt_linebreak_state.minimum_demerits) {
+ lmt_linebreak_state.minimum_demerits = awful_bad - 1;
+ } else {
+ lmt_linebreak_state.minimum_demerits += abs(properties->adj_demerits);
+ }
+ for (halfword fit_class = very_loose_fit; fit_class <= tight_fit; fit_class++) {
+ if (lmt_linebreak_state.minimal_demerits[fit_class] <= lmt_linebreak_state.minimum_demerits) {
+ /*tex
+
+ Insert a new active node from |best_place [fit_class]| to |cur_p|. When
+ we create an active node, we also create the corresponding passive node.
+
+ */
+ halfword q = tex_new_node(passive_node, (quarterword) very_loose_fit);
+ node_next(q) = lmt_linebreak_state.passive;
+ lmt_linebreak_state.passive = q;
+ passive_cur_break(q) = cur_p;
+ ++lmt_linebreak_state.pass_number;
+ passive_serial(q) = lmt_linebreak_state.pass_number;
+ passive_prev_break(q) = best_place[fit_class];
+ /*tex
+
+ Here we keep track of the subparagraph penalties in the break nodes.
+
+ */
+ passive_pen_inter(q) = lmt_linebreak_state.internal_penalty_interline;
+ passive_pen_broken(q) = lmt_linebreak_state.internal_penalty_broken;
+ passive_last_left_box(q) = lmt_linebreak_state.internal_left_box;
+ passive_last_left_box_width(q) = lmt_linebreak_state.internal_left_box_width;
+ if (passive_prev_break(q)) {
+ passive_left_box(q) = passive_last_left_box(passive_prev_break(q));
+ passive_left_box_width(q) = passive_last_left_box_width(passive_prev_break(q));
+ } else {
+ passive_left_box(q) = lmt_linebreak_state.init_internal_left_box;
+ passive_left_box_width(q) = lmt_linebreak_state.init_internal_left_box_width;
+ }
+ passive_right_box(q) = lmt_linebreak_state.internal_right_box;
+ passive_right_box_width(q) = lmt_linebreak_state.internal_right_box_width;
+ passive_middle_box(q) = lmt_linebreak_state.internal_middle_box;
+ q = tex_new_node((quarterword) break_type, (quarterword) fit_class);
+ active_break_node(q) = lmt_linebreak_state.passive;
+ active_line_number(q) = best_place_line[fit_class] + 1;
+ active_total_demerits(q) = lmt_linebreak_state.minimal_demerits[fit_class];
+ if (lmt_linebreak_state.do_last_line_fit) {
+ /*tex
+
+ Store additional data in the new active node. Here we save these
+ data in the active node representing a potential line break.
+
+ */
+ active_short(q) = best_place_short[fit_class];
+ active_glue(q) = best_place_glue[fit_class];
+ }
+ node_next(q) = r;
+ node_next(prev_r) = q;
+ prev_r = q;
+ if (properties->tracing_paragraphs > 0) {
+ tex_aux_print_break_node(q, fit_class, break_type, cur_p, properties);
+ }
+ }
+ lmt_linebreak_state.minimal_demerits[fit_class] = awful_bad;
+ }
+ lmt_linebreak_state.minimum_demerits = awful_bad;
+ /*tex
+
+ Insert a delta node to prepare for the next active node. When the following
+ code is performed, we will have just inserted at least one active node before
+ |r|, so |type (prev_r) <> delta_node|.
+
+ */
+ if (r != active_head) {
+ halfword q = tex_new_node(delta_node, (quarterword) very_loose_fit);
+ node_next(q) = r;
+ tex_aux_set_delta_from_difference(properties->adjust_spacing, q, cur_active_width, lmt_linebreak_state.break_width);
+ node_next(prev_r) = q;
+ prev_prev_r = prev_r;
+ prev_r = q;
+ }
+ }
+ /*tex
+
+ Quit on an active node, otherwise compute the new line width. When we come to the
+ following code, we have just encountered the first active node~|r| whose
+ |line_number| field contains |l|. Thus we want to compute the length of the
+ $l\mskip1mu$th line of the current paragraph. Furthermore, we want to set |old_l|
+ to the last number in the class of line numbers equivalent to~|l|.
+
+ */
+ if (r == active_head) {
+ return;
+ } else if (l > lmt_linebreak_state.easy_line) {
+ old_l = max_halfword - 1;
+ line_width = lmt_linebreak_state.second_width;
+ } else {
+ old_l = l;
+ /* if (properties->par_shape && specification_repeat(properties->par_shape)) {
+ line_width = get_specification_width(properties->par_shape, l);
+ } else */ if (l > lmt_linebreak_state.last_special_line) {
+ line_width = lmt_linebreak_state.second_width;
+ } else if (properties->par_shape) {
+ line_width = tex_get_specification_width(properties->par_shape, l);
+ } else {
+ line_width = lmt_linebreak_state.first_width;
+ }
+ }
+ }
+ /*tex
+
+ If a line number class has ended, create new active nodes for the best feasible breaks
+ in that class; then |return| if |r = active|, otherwise compute the new |line_width|.
+
+ Consider the demerits for a line from |r| to |cur_p|; deactivate node |r| if it should
+ no longer be active; then |goto continue| if a line from |r| to |cur_p| is infeasible,
+ otherwise record a new feasible break.
+
+ */
+ artificial_demerits = 0;
+ shortfall = line_width - cur_active_width[total_glue_amount];
+ if (active_break_node(r)) {
+ shortfall -= passive_last_left_box_width(active_break_node(r));
+ } else {
+ shortfall -= lmt_linebreak_state.init_internal_left_box_width;
+ }
+ shortfall -= lmt_linebreak_state.internal_right_box_width;
+ // halfword margin_kern_stretch = 0;
+ // halfword margin_kern_shrink = 0;
+ if (properties->protrude_chars) {
+ // if (line_break_dir == dir_righttoleft) {
+ // /*tex Not now, we need to keep more track. */
+ // } else {
+ halfword o = null;
+ halfword l1 = active_break_node(r) ? passive_cur_break(active_break_node(r)) : first_p;
+ if (cur_p) {
+ o = node_prev(cur_p);
+ if (node_next(o) != cur_p) {
+ tex_normal_error("linebreak", "the node list is messed up");
+ }
+ }
+ /*tex
+
+ The last characters (hyphenation character) if these two list should always be
+ the same anyway, so we just look at |pre_break|. Let's look at the right margin
+ first.
+
+ */
+ if (cur_p && node_type(cur_p) == disc_node && disc_pre_break_head(cur_p)) {
+ /*tex
+ A |disc_node| with non-empty |pre_break|, protrude the last char of
+ |pre_break|:
+ */
+ o = disc_pre_break_tail(cur_p);
+ } else {
+ o = tex_aux_find_protchar_right(l1, o);
+ }
+ if (o && node_type(o) == glyph_node) {
+ shortfall += tex_char_protrusion(o, right_margin_kern_subtype);
+ // char_pw_kern(o, right_margin_kern, &margin_kern_stretch, &margin_kern_shrink);
+ }
+ /*tex now the left margin */
+ if (l1 && (node_type(l1) == disc_node) && (disc_post_break_head(l1))) {
+ /*tex The first char could be a disc! Protrude the first char. */
+ o = disc_post_break_head(l1);
+ } else {
+ o = tex_aux_find_protchar_left(l1, 1);
+ }
+ if (o && node_type(o) == glyph_node) {
+ shortfall += tex_char_protrusion(o, left_margin_kern_subtype);
+ // char_pw_kern(o, left_margin_kern, &margin_kern_stretch, &margin_kern_shrink);
+ }
+ // }
+ }
+ /*tex
+ The only reason why we have a shared ratio is that we need to calculate the shortfall
+ for a line with mixed fonts. BTW, why do we divide by 2?
+ */
+ if (shortfall == 0) {
+ /*tex We're okay. */
+ } else if (shortfall > 0) {
+ halfword total_stretch = total_font_stretch;
+ // halfword total_stretch = total_font_stretch + margin_kern_stretch;
+ if (total_stretch > 0) {
+ if (total_stretch > shortfall) {
+ shortfall = (total_stretch / (lmt_linebreak_state.max_stretch_ratio / lmt_linebreak_state.current_font_step)) / 2;
+ } else {
+ shortfall -= total_stretch;
+ }
+ }
+ } else if (shortfall < 0) {
+ halfword total_shrink = total_font_shrink;
+ // halfword total_shrink = total_font_shrink + margin_kern_shrink;
+ if (total_shrink > 0) {
+ if (total_shrink > -shortfall) {
+ shortfall = - (total_shrink / (lmt_linebreak_state.max_shrink_ratio / lmt_linebreak_state.current_font_step)) / 2;
+ } else {
+ shortfall += total_shrink;
+ }
+ }
+ }
+ if (shortfall > 0) {
+ /*tex
+
+ Set the value of |b| to the badness for stretching the line, and compute the
+ corresponding |fit_class|. When a line must stretch, the available stretchability
+ can be found in the subarray |cur_active_width [2 .. 6]|, in units of points, sfi,
+ fil, fill and filll.
+
+ The present section is part of \TEX's inner loop, and it is most often performed
+ when the badness is infinite; therefore it is worth while to make a quick test for
+ large width excess and small stretchability, before calling the |badness| subroutine.
+
+ */
+ if (cur_active_width[total_fi_amount] || cur_active_width[total_fil_amount] ||
+ cur_active_width[total_fill_amount] || cur_active_width[total_filll_amount]) {
+ if (lmt_linebreak_state.do_last_line_fit) {
+ if (! cur_p) {
+ /*tex
+
+ The last line of a paragraph. Perform computations for last line and
+ |goto found|. Here we compute the adjustment |g| and badness |b| for a
+ line from |r| to the end of the paragraph. When any of the criteria for
+ adjustment is violated we fall through to the normal algorithm. The last
+ line must be too short, and have infinite stretch entirely due to
+ |par_fill_skip|.
+
+ */
+ if (active_short(r) == 0 || active_glue(r) <= 0) {
+ /*tex
+
+ Previous line was neither stretched nor shrunk, or was infinitely
+ bad.
+
+ */
+ goto NOT_FOUND;
+ }
+ if (cur_active_width[total_fi_amount] != lmt_linebreak_state.fill_width[fi_order] || cur_active_width[total_fil_amount] != lmt_linebreak_state.fill_width[fil_order] ||
+ cur_active_width[total_fill_amount] != lmt_linebreak_state.fill_width[fill_order] || cur_active_width[total_filll_amount] != lmt_linebreak_state.fill_width[filll_order]) {
+ /*tex
+ Infinite stretch of this line not entirely due to |par_fill_skip|.
+ */
+ goto NOT_FOUND;
+ }
+ if (active_short(r) > 0) {
+ g = cur_active_width[total_stretch_amount];
+ } else {
+ g = cur_active_width[total_shrink_amount];
+ }
+ if (g <= 0) {
+ /*tex No finite stretch resp.\ no shrink. */
+ goto NOT_FOUND;
+ }
+ lmt_scanner_state.arithmic_error = 0;
+ g = tex_fract(g, active_short(r), active_glue(r), max_dimen);
+ if (properties->last_line_fit < 1000) {
+ g = tex_fract(g, properties->last_line_fit, 1000, max_dimen);
+ }
+ if (lmt_scanner_state.arithmic_error) {
+ g = (active_short(r) > 0) ? max_dimen : -max_dimen;
+ }
+ if (g > 0) {
+ /*tex
+
+ Set the value of |b| to the badness of the last line for stretching,
+ compute the corresponding |fit_class, and |goto found|. These
+ badness computations are rather similar to those of the standard
+ algorithm, with the adjustment amount |g| replacing the |shortfall|.
+
+ */
+ if (g > shortfall) {
+ g = shortfall;
+ }
+ if (g > large_width_excess && (cur_active_width[total_stretch_amount] < small_stretchability)) {
+ b = infinite_bad;
+ fit_class = very_loose_fit;
+ goto FOUND;
+ }
+ b = tex_badness(g, cur_active_width[total_stretch_amount]);
+ fit_class = tex_normalized_loose_badness(b, loose, semi_loose, decent);
+ goto FOUND;
+ } else if (g < 0) {
+ /*tex
+
+ Set the value of |b| to the badness of the last line for shrinking,
+ compute the corresponding |fit_class, and |goto found||.
+
+ */
+ if (-g > cur_active_width[total_shrink_amount]) {
+ g = -cur_active_width[total_shrink_amount];
+ }
+ b = tex_badness(-g, cur_active_width[total_shrink_amount]);
+ fit_class = tex_normalized_tight_badness(b, decent, semi_tight);
+ goto FOUND;
+ }
+ }
+ NOT_FOUND:
+ shortfall = 0;
+ }
+ b = 0;
+ /*tex Infinite stretch. */
+ fit_class = decent_fit;
+ } else if (shortfall > large_width_excess && cur_active_width[total_stretch_amount] < small_stretchability) {
+ b = infinite_bad;
+ fit_class = very_loose_fit;
+ } else {
+ b = tex_badness(shortfall, cur_active_width[total_stretch_amount]);
+ fit_class = tex_normalized_loose_badness(b, loose, semi_loose, decent);
+ }
+ } else {
+ /*tex
+
+ Set the value of |b| to the badness for shrinking the line, and compute the
+ corresponding |fit_class|. Shrinkability is never infinite in a paragraph; we
+ can shrink the line from |r| to |cur_p| by at most |cur_active_width
+ [total_shrink_amount]|.
+
+ */
+ if (-shortfall > cur_active_width[total_shrink_amount]) {
+ b = infinite_bad + 1;
+ } else {
+ b = tex_badness(-shortfall, cur_active_width[total_shrink_amount]);
+ }
+ fit_class = tex_normalized_tight_badness(b, decent, semi_tight);
+ }
+ if (lmt_linebreak_state.do_last_line_fit) {
+ /*tex Adjust the additional data for last line; */
+ if (! cur_p) {
+ shortfall = 0;
+ g = 0;
+ } else if (shortfall > 0) {
+ g = cur_active_width[total_stretch_amount];
+ } else if (shortfall < 0) {
+ g = cur_active_width[total_shrink_amount];
+ } else {
+ g = 0;
+ }
+ }
+ FOUND:
+ if ((b > infinite_bad) || (pi == eject_penalty)) {
+ /*tex
+
+ Prepare to deactivate node~|r|, and |goto deactivate| unless there is a reason to
+ consider lines of text from |r| to |cur_p|. During the final pass, we dare not
+ lose all active nodes, lest we lose touch with the line breaks already found. The
+ code shown here makes sure that such a catastrophe does not happen, by permitting
+ overfull boxes as a last resort. This particular part of \TEX\ was a source of
+ several subtle bugs before the correct program logic was finally discovered; readers
+ who seek to improve \TEX\ should therefore think thrice before daring to make any
+ changes here.
+
+ */
+ if (lmt_linebreak_state.final_pass && (lmt_linebreak_state.minimum_demerits == awful_bad) &&
+ (node_next(r) == active_head) && (prev_r == active_head)) {
+ /*tex Set demerits zero, this break is forced. */
+ artificial_demerits = 1;
+ } else if (b > lmt_linebreak_state.threshold) {
+ goto DEACTIVATE;
+ }
+ node_r_stays_active = 0;
+ } else {
+ prev_r = r;
+ if (b > lmt_linebreak_state.threshold) {
+ continue;
+ } else {
+ node_r_stays_active = 1;
+ }
+ }
+ /*tex
+
+ Record a new feasible break. When we get to this part of the code, the line from |r| to
+ |cur_p| is feasible, its badness is~|b|, and its fitness classification is |fit_class|.
+ We don't want to make an active node for this break yet, but we will compute the total
+ demerits and record them in the |minimal_demerits| array, if such a break is the current
+ champion among all ways to get to |cur_p| in a given line-number class and fitness class.
+
+ */
+ if (artificial_demerits) {
+ d = 0;
+ } else {
+ /*tex Compute the demerits, |d|, from |r| to |cur_p|. */
+ d = properties->line_penalty + b;
+ if (abs(d) >= 10000) {
+ d = 100000000;
+ } else {
+ d = d * d;
+ }
+ if (pi != 0) {
+ if (pi > 0) {
+ d += (pi * pi);
+ } else if (pi > eject_penalty) {
+ d -= (pi * pi);
+ }
+ }
+ if (break_type == hyphenated_node && node_type(r) == hyphenated_node) {
+ if (cur_p) {
+ d += properties->double_hyphen_demerits;
+ } else {
+ d += properties->final_hyphen_demerits;
+ }
+ }
+ /*tex
+ Here |fitness| is just the subtype, so we could have put the cast in the macro
+ instead: |# define fitness (n) ((halfword) (subtype (n))|. We need to cast because
+ some compilers (versions or whatever) get confused by the type of (unsigned) integer
+ used.
+ */
+ if (abs(fit_class - (halfword) active_fitness(r)) > 1) {
+ d = d + properties->adj_demerits;
+ }
+ }
+ if (properties->tracing_paragraphs > 0) {
+ tex_aux_print_feasible_break(cur_p, r, b, pi, d, artificial_demerits, properties);
+ }
+ /*tex This is the minimum total demerits from the beginning to |cur_p| via |r|. */
+ d += active_total_demerits(r);
+ if (d <= lmt_linebreak_state.minimal_demerits[fit_class]) {
+ lmt_linebreak_state.minimal_demerits[fit_class] = d;
+ best_place[fit_class] = active_break_node(r);
+ best_place_line[fit_class] = l;
+ if (lmt_linebreak_state.do_last_line_fit) {
+ /*tex
+
+ Store additional data for this feasible break. For each feasible break we record
+ the shortfall and glue stretch or shrink (or adjustment).
+
+ */
+ best_place_short[fit_class] = shortfall;
+ best_place_glue[fit_class] = g;
+ }
+ if (d < lmt_linebreak_state.minimum_demerits) {
+ lmt_linebreak_state.minimum_demerits = d;
+ }
+ }
+ /*tex Record a new feasible break. */
+ if (node_r_stays_active) {
+ /*tex |prev_r| has been set to |r|. */
+ continue;
+ }
+ DEACTIVATE:
+ /*tex
+
+ Deactivate node |r|. When an active node disappears, we must delete an adjacent delta
+ node if the active node was at the beginning or the end of the active list, or if it
+ was surrounded by delta nodes. We also must preserve the property that |cur_active_width|
+ represents the length of material from |vlink (prev_r)| to~|cur_p|.
+
+ */
+ node_next(prev_r) = node_next(r);
+ tex_flush_node(r);
+ if (prev_r == active_head) {
+ /*tex
+
+ Update the active widths, since the first active node has been deleted. The following
+ code uses the fact that |type (active) <> delta_node|. If the active list has just
+ become empty, we do not need to update the |active_width| array, since it will be
+ initialized when an active node is next inserted.
+
+ */
+ r = node_next(active_head);
+ if (node_type(r) == delta_node) {
+ tex_aux_add_to_target_from_delta(properties->adjust_spacing, lmt_linebreak_state.active_width, r);
+ tex_aux_set_target_to_source(properties->adjust_spacing, cur_active_width, lmt_linebreak_state.active_width);
+ node_next(active_head) = node_next(r);
+ tex_flush_node(r);
+ }
+ } else if (node_type(prev_r) == delta_node) {
+ r = node_next(prev_r);
+ if (r == active_head) {
+ tex_aux_sub_delta_from_target(properties->adjust_spacing, cur_active_width, prev_r);
+ node_next(prev_prev_r) = active_head;
+ tex_flush_node(prev_r);
+ prev_r = prev_prev_r;
+ } else if (node_type(r) == delta_node) {
+ tex_aux_add_to_target_from_delta(properties->adjust_spacing, cur_active_width, r);
+ tex_aux_add_to_delta_from_delta(properties->adjust_spacing, prev_r, r);
+ node_next(prev_r) = node_next(r);
+ tex_flush_node(r);
+ }
+ }
+ }
+}
+
+static halfword tex_aux_inject_orphan_penalty(halfword current, halfword amount)
+{
+ halfword previous = node_prev(current);
+ if (previous && node_type(previous) != penalty_node) {
+ halfword penalty = tex_new_penalty_node(amount, orphan_penalty_subtype);
+ tex_couple_nodes(previous, penalty);
+ tex_couple_nodes(penalty, current);
+ current = previous;
+ }
+ return current;
+}
+
+inline static int tex_aux_valid_glue_break(halfword p)
+{
+ halfword prv = node_prev(p);
+ return (prv && prv != temp_head && (node_type(prv) == glyph_node || precedes_break(prv) || precedes_kern(prv) || precedes_dir(prv)));
+}
+
+void tex_do_line_break(line_break_properties *properties)
+{
+ /*tex Miscellaneous nodes of temporary interest. */
+ halfword cur_p, l, r;
+ int line_break_dir = properties->paragraph_dir;
+ int force_check_hyphenation = hyphenation_permitted(properties->hyphenation_mode, force_check_hyphenation_mode);
+ (void) (properties->inter_line_penalties); /* avoid not used message */
+ /*tex Get ready to start */
+ lmt_linebreak_state.fewest_demerits = 0;
+ lmt_linebreak_state.actual_looseness = 0;
+ lmt_linebreak_state.minimum_demerits = awful_bad;
+ for (int i = very_loose_fit; i <= tight_fit; i++) {
+ lmt_linebreak_state.minimal_demerits[i] = awful_bad;
+ }
+ /*tex
+ This has been moved here:
+ */
+ if (properties->adjust_spacing) {
+ lmt_linebreak_state.adjust_spacing = properties->adjust_spacing;
+ if (properties->adjust_spacing_step > 0) {
+ lmt_linebreak_state.adjust_spacing_step = properties->adjust_spacing_step;
+ lmt_linebreak_state.adjust_spacing_shrink = -properties->adjust_spacing_shrink; /* watch the sign */
+ lmt_linebreak_state.adjust_spacing_stretch = properties->adjust_spacing_stretch;
+ } else {
+ lmt_linebreak_state.adjust_spacing_step = 0;
+ lmt_linebreak_state.adjust_spacing_shrink = 0;
+ lmt_linebreak_state.adjust_spacing_stretch = 0;
+ }
+ properties->adjust_spacing = tex_checked_font_adjust(
+ properties->adjust_spacing,
+ lmt_linebreak_state.adjust_spacing_step,
+ lmt_linebreak_state.adjust_spacing_shrink,
+ lmt_linebreak_state.adjust_spacing_stretch
+ );
+ } else {
+ lmt_linebreak_state.adjust_spacing_step = 0;
+ lmt_linebreak_state.adjust_spacing_shrink = 0;
+ lmt_linebreak_state.adjust_spacing_stretch = 0;
+ properties->adjust_spacing = adjust_spacing_off;
+ }
+ lmt_linebreak_state.current_font_step = -1;
+ lmt_linebreak_state.max_shrink_ratio = -1;
+ lmt_linebreak_state.max_stretch_ratio = -1;
+ /*tex
+
+ We compute the values of |easy_line| and the other local variables relating to line length
+ when the |line_break| procedure is initializing itself.
+
+ The orphan penalty injection is something new. It works backward so the first penalty in
+ the list is injected first. If there is a penalty before a space we skip that space and
+ also skip a penalty in the list.
+
+ */
+ if (properties->orphan_penalties || properties->orphan_penalty) {
+ halfword current = node_prev(properties->parfill_right_skip);
+ if (current) {
+ /*tex Skip over trailing glue and penalties. */
+ while (current) {
+ switch (node_type(current)) {
+ case glue_node:
+ case penalty_node:
+ current = node_prev(current);
+ break;
+ default:
+ goto INJECT;
+ }
+ }
+ INJECT:
+ if (properties->orphan_penalties) {
+ /*tex Inject specified penalties before spaces. */
+ int n = specification_count(properties->orphan_penalties);
+ if (n > 0) {
+ halfword i = 0;
+ while (current) {
+ if (node_type(current) == glue_node) {
+ switch (node_subtype(current)) {
+ case space_skip_glue:
+ case xspace_skip_glue:
+ case zero_space_skip_glue:
+ current = tex_aux_inject_orphan_penalty(current, tex_get_specification_penalty(properties->orphan_penalties, ++i));
+ if (i == n) {
+ goto ALLDONE;
+ } else {
+ break;
+ }
+ }
+ }
+ current = node_prev(current);
+ }
+ }
+ } else {
+ while (current) {
+ if (node_type(current) == glue_node) {
+ switch (node_subtype(current)) {
+ case space_skip_glue:
+ case xspace_skip_glue:
+ case zero_space_skip_glue:
+ tex_aux_inject_orphan_penalty(current, properties->orphan_penalty);
+ goto ALLDONE;
+ }
+ }
+ current = node_prev(current);
+ }
+ }
+ }
+ ALLDONE: ;
+ }
+ if (properties->par_shape) {
+ int n = specification_count(properties->par_shape);
+ if (n > 0) {
+ if (specification_repeat(properties->par_shape)) {
+ lmt_linebreak_state.last_special_line = max_halfword;
+ } else {
+ lmt_linebreak_state.last_special_line = n - 1;
+ }
+ lmt_linebreak_state.second_indent = tex_get_specification_indent(properties->par_shape, n);
+ lmt_linebreak_state.second_width = tex_get_specification_width(properties->par_shape, n);
+ lmt_linebreak_state.second_indent = swap_parshape_indent(properties->paragraph_dir, lmt_linebreak_state.second_indent, lmt_linebreak_state.second_width);
+ } else {
+ lmt_linebreak_state.last_special_line = 0;
+ lmt_linebreak_state.second_width = properties->hsize;
+ lmt_linebreak_state.second_indent = 0;
+ }
+ } else if (properties->hang_indent == 0) {
+ lmt_linebreak_state.last_special_line = 0;
+ lmt_linebreak_state.second_width = properties->hsize;
+ lmt_linebreak_state.second_indent = 0;
+ } else {
+ halfword used_hang_indent = swap_hang_indent(properties->paragraph_dir, properties->hang_indent);
+ /*tex
+
+ Set line length parameters in preparation for hanging indentation. We compute the
+ values of |easy_line| and the other local variables relating to line length when the
+ |line_break| procedure is initializing itself.
+
+ */
+ lmt_linebreak_state.last_special_line = abs(properties->hang_after);
+ if (properties->hang_after < 0) {
+ lmt_linebreak_state.first_width = properties->hsize - abs(used_hang_indent);
+ if (used_hang_indent >= 0) {
+ lmt_linebreak_state.first_indent = used_hang_indent;
+ } else {
+ lmt_linebreak_state.first_indent = 0;
+ }
+ lmt_linebreak_state.second_width = properties->hsize;
+ lmt_linebreak_state.second_indent = 0;
+ } else {
+ lmt_linebreak_state.first_width = properties->hsize;
+ lmt_linebreak_state.first_indent = 0;
+ lmt_linebreak_state.second_width = properties->hsize - abs(used_hang_indent);
+ if (used_hang_indent >= 0) {
+ lmt_linebreak_state.second_indent = used_hang_indent;
+ } else {
+ lmt_linebreak_state.second_indent = 0;
+ }
+ }
+ }
+ if (properties->looseness == 0) {
+ lmt_linebreak_state.easy_line = lmt_linebreak_state.last_special_line;
+ } else {
+ lmt_linebreak_state.easy_line = max_halfword;
+ }
+ lmt_linebreak_state.no_shrink_error_yet = 1;
+ l = properties->left_skip;
+ r = properties->right_skip;
+ lmt_linebreak_state.background[total_glue_amount] = glue_amount(l) + glue_amount(r);
+ lmt_linebreak_state.background[total_stretch_amount] = 0;
+ lmt_linebreak_state.background[total_fi_amount] = 0;
+ lmt_linebreak_state.background[total_fil_amount] = 0;
+ lmt_linebreak_state.background[total_fill_amount] = 0;
+ lmt_linebreak_state.background[total_filll_amount] = 0;
+ lmt_linebreak_state.background[total_stretch_amount + glue_stretch_order(l)] = glue_stretch(l);
+ lmt_linebreak_state.background[total_stretch_amount + glue_stretch_order(r)] += glue_stretch(r);
+ lmt_linebreak_state.background[total_shrink_amount] = tex_aux_checked_shrink(l) + tex_aux_checked_shrink(r);
+ if (properties->adjust_spacing) {
+ lmt_linebreak_state.background[font_stretch_amount] = 0;
+ lmt_linebreak_state.background[font_shrink_amount] = 0;
+ lmt_linebreak_state.max_stretch_ratio = -1;
+ lmt_linebreak_state.max_shrink_ratio = -1;
+ lmt_linebreak_state.current_font_step = -1;
+ lmt_packaging_state.previous_char_ptr = null;
+ }
+ /*tex
+
+ Check for special treatment of last line of paragraph. The new algorithm for the last line
+ requires that the stretchability |par_fill_skip| is infinite and the stretchability of
+ |left_skip| plus |right_skip| is finite.
+
+ */
+ lmt_linebreak_state.do_last_line_fit = 0;
+ if (properties->last_line_fit > 0) {
+ halfword q = lmt_linebreak_state.last_line_fill;
+ if (glue_stretch(q) > 0 && glue_stretch_order(q) > normal_glue_order) {
+ if (lmt_linebreak_state.background[total_fi_amount] == 0 && lmt_linebreak_state.background[total_fil_amount] == 0 &&
+ lmt_linebreak_state.background[total_fill_amount] == 0 && lmt_linebreak_state.background[total_filll_amount] == 0) {
+ lmt_linebreak_state.do_last_line_fit = 1;
+ lmt_linebreak_state.fill_width[fi_order] = 0;
+ lmt_linebreak_state.fill_width[fil_order] = 0;
+ lmt_linebreak_state.fill_width[fill_order] = 0;
+ lmt_linebreak_state.fill_width[filll_order] = 0;
+ lmt_linebreak_state.fill_width[glue_stretch_order(q) - fi_glue_order] = glue_stretch(q);
+ }
+ }
+ }
+ /*tex Initialize |dir_ptr| for |line_break|. */
+ if (lmt_linebreak_state.dir_ptr) {
+ tex_flush_node_list(lmt_linebreak_state.dir_ptr);
+ lmt_linebreak_state.dir_ptr = null;
+ }
+ /*tex Find optimal breakpoints. */
+ lmt_linebreak_state.threshold = properties->pretolerance;
+
+ if (properties->tracing_paragraphs > 1) {
+ tex_begin_diagnostic();
+ tex_print_str("[linebreak: original]");
+ tex_short_display(node_next(temp_head));
+ tex_end_diagnostic();
+ }
+
+ if (lmt_linebreak_state.threshold >= 0) {
+ if (properties->tracing_paragraphs > 0) {
+ tex_begin_diagnostic();
+ tex_print_str("[linebreak: first pass]"); /* @firstpass */
+ }
+ lmt_linebreak_state.second_pass = 0;
+ lmt_linebreak_state.final_pass = 0;
+ } else {
+ lmt_linebreak_state.threshold = properties->tolerance;
+ lmt_linebreak_state.second_pass = 1;
+ lmt_linebreak_state.final_pass = (properties->emergency_stretch <= 0);
+ if (properties->tracing_paragraphs > 0) {
+ tex_begin_diagnostic();
+ }
+ }
+ while (1) {
+ halfword first_p, q;
+ halfword nest_stack[10];
+ int nest_index = 0;
+ if (lmt_linebreak_state.threshold > infinite_bad) {
+ lmt_linebreak_state.threshold = infinite_bad;
+ }
+ /*tex Create an active breakpoint representing the beginning of the paragraph. */
+ q = tex_new_node(unhyphenated_node, (quarterword) decent_fit);
+ node_next(q) = active_head;
+ active_break_node(q) = null;
+ active_line_number(q) = cur_list.prev_graf + 1;
+ active_total_demerits(q) = 0;
+ active_short(q) = 0;
+ active_glue(q) = 0;
+ node_next(active_head) = q; /* we create a cycle */
+ tex_aux_set_target_to_source(properties->adjust_spacing, lmt_linebreak_state.active_width, lmt_linebreak_state.background);
+ lmt_linebreak_state.passive = null;
+ lmt_linebreak_state.printed_node = temp_head;
+ lmt_linebreak_state.pass_number = 0;
+ lmt_print_state.font_in_short_display = null_font;
+ /*tex Create an active breakpoint representing the beginning of the paragraph. */
+ /* lmt_linebreak_state.auto_breaking = 1; */ /* gone */
+ cur_p = node_next(temp_head);
+ /*tex Initialize with first (or current) |par| node. */
+ if (cur_p && node_type(cur_p) == par_node) {
+ node_prev(cur_p) = temp_head;
+ lmt_linebreak_state.internal_penalty_interline = tex_get_local_interline_penalty(cur_p);
+ lmt_linebreak_state.internal_penalty_broken = tex_get_local_broken_penalty(cur_p);
+ lmt_linebreak_state.init_internal_left_box = par_box_left(cur_p);
+ lmt_linebreak_state.init_internal_left_box_width = tex_get_local_left_width(cur_p);
+ lmt_linebreak_state.internal_right_box = par_box_right(cur_p);
+ lmt_linebreak_state.internal_right_box_width = tex_get_local_right_width(cur_p);
+ lmt_linebreak_state.internal_middle_box = par_box_middle(cur_p);
+ } else {
+ lmt_linebreak_state.internal_penalty_interline = 0;
+ lmt_linebreak_state.internal_penalty_broken = 0;
+ lmt_linebreak_state.init_internal_left_box = null;
+ lmt_linebreak_state.init_internal_left_box_width = 0;
+ lmt_linebreak_state.internal_right_box = null;
+ lmt_linebreak_state.internal_right_box_width = 0;
+ lmt_linebreak_state.internal_middle_box = null;
+ }
+ lmt_linebreak_state.internal_left_box = lmt_linebreak_state.init_internal_left_box;
+ lmt_linebreak_state.internal_left_box_width = lmt_linebreak_state.init_internal_left_box_width;
+ lmt_packaging_state.previous_char_ptr = null;
+ first_p = cur_p;
+ /*tex
+
+ To access the first node of paragraph as the first active node has |break_node = null|.
+
+ Determine legal breaks: As we move through the hlist, we need to keep the |active_width|
+ array up to date, so that the badness of individual lines is readily calculated by
+ |try_break|. It is convenient to use the short name |active_width [1]| for the component
+ of active width that represents real width as opposed to glue.
+
+ Advance |cur_p| to the node following the present string of characters. The code that
+ passes over the characters of words in a paragraph is part of \TEX's inner loop, so it
+ has been streamlined for speed. We use the fact that |\parfillskip| glue appears at the
+ end of each paragraph; it is therefore unnecessary to check if |vlink (cur_p) = null|
+ when |cur_p| is a character node.
+
+ */
+ while (cur_p && (node_next(active_head) != active_head)) { /* we check the cycle */
+ switch (node_type(cur_p)) {
+ case glyph_node:
+ lmt_linebreak_state.active_width[total_glue_amount] += tex_glyph_width_ex(cur_p);
+ if (properties->adjust_spacing && tex_aux_check_expand_pars(properties->adjust_spacing_step, glyph_font(cur_p))) {
+ lmt_packaging_state.previous_char_ptr = cur_p;
+ lmt_linebreak_state.active_width[font_stretch_amount] += tex_char_stretch(cur_p);
+ lmt_linebreak_state.active_width[font_shrink_amount] += tex_char_shrink(cur_p);
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ lmt_linebreak_state.active_width[total_glue_amount] += box_width(cur_p);
+ break;
+ case rule_node:
+ lmt_linebreak_state.active_width[total_glue_amount] += rule_width(cur_p);
+ break;
+ case dir_node:
+ /*tex Adjust the dir stack for the |line_break| routine. */
+ line_break_dir = tex_update_dir_state(cur_p, properties->paragraph_dir);
+ break;
+ case par_node:
+ /*tex Advance past a |par| node. */
+ lmt_linebreak_state.internal_penalty_interline = tex_get_local_interline_penalty(cur_p);
+ lmt_linebreak_state.internal_penalty_broken = tex_get_local_broken_penalty(cur_p);
+ lmt_linebreak_state.internal_left_box = par_box_left(cur_p);
+ lmt_linebreak_state.internal_left_box_width = tex_get_local_left_width(cur_p);
+ lmt_linebreak_state.internal_right_box = par_box_right(cur_p);
+ lmt_linebreak_state.internal_right_box_width = tex_get_local_right_width(cur_p);
+ lmt_linebreak_state.internal_middle_box = par_box_middle(cur_p);
+ break;
+ case glue_node:
+ /*tex
+
+ If node |cur_p| is a legal breakpoint, call |try_break|; then update the
+ active widths by including the glue in |glue_ptr(cur_p)|.
+
+ When node |cur_p| is a glue node, we look at the previous to see whether or
+ not a breakpoint is legal at |cur_p|, as explained above.
+
+ We only break after certain nodes (see texnodes.h), a font related kern and
+ a dir node when |\breakafterdirmode = 1|.
+
+ */
+ if (tex_has_glue_option(cur_p, glue_option_no_auto_break)) {
+ /*tex Glue in math is not a valid breakpoint. */
+ } else if (tex_is_par_init_glue(cur_p)) {
+ /*tex Of course we don't break here. */
+ } else if (tex_aux_valid_glue_break(cur_p)) {
+ tex_aux_try_break(properties, 0, unhyphenated_node, first_p, cur_p);
+ }
+ lmt_linebreak_state.active_width[total_glue_amount] += glue_amount(cur_p);
+ lmt_linebreak_state.active_width[2 + glue_stretch_order(cur_p)] += glue_stretch(cur_p);
+ lmt_linebreak_state.active_width[total_shrink_amount] += tex_aux_checked_shrink(cur_p);
+ break;
+ case kern_node:
+ switch (node_subtype(cur_p)) {
+ case explicit_kern_subtype:
+ case italic_kern_subtype:
+ {
+ /* there used to a ! is_char_node(node_next(cur_p)) test */
+ halfword nxt = node_next(cur_p);
+ if (nxt && node_type(nxt) == glue_node && ! tex_has_glue_option(nxt, glue_option_no_auto_break)) {
+ tex_aux_try_break(properties, 0, unhyphenated_node, first_p, cur_p);
+ }
+ }
+ break;
+ case font_kern_subtype:
+ if (properties->adjust_spacing == adjust_spacing_full) {
+ lmt_linebreak_state.active_width[font_stretch_amount] += tex_kern_stretch(cur_p);
+ lmt_linebreak_state.active_width[font_shrink_amount] += tex_kern_shrink(cur_p);
+ }
+ break;
+ }
+ lmt_linebreak_state.active_width[total_glue_amount] += kern_amount(cur_p);
+ break;
+ case disc_node:
+ /*tex
+
+ Try to break after a discretionary fragment, then |goto done5|. The
+ following code knows that discretionary texts contain only character
+ nodes, kern nodes, box nodes, and rule nodes. This branch differs a bit
+ from older engines because in \LUATEX\ we already have hyphenated the list.
+ This means that we need to skip automatic disc nodes. Or better, we need
+ to treat discretionaries and explicit hyphens always, even in the first
+ pass.
+
+ We used to have |init_disc| followed by |select disc| variants where the
+ |select_disc|s were handled by the leading |init_disc|. The question is: should
+ we bother about select nodes? Knuth indicates in the original source that only
+ a very few cases need hyphenation so the exceptional case of >2 char ligatures
+ having hyphenation points in between is rare. We'd better have proper compound
+ word handling. Keep in mind that these (old) init and select subtypes always
+ came in isolated pairs and that they only were meant for the simple (enforced)
+ hyphenation discretionaries.
+
+ Therefore, this feature has been dropped from \LUAMETATEX. It not only makes
+ the code simpler, it also avoids having code on board for border cases that
+ even when dealt with are suboptimal. It's better to have nothing that something
+ fuzzy. It also makes dealing with (intermediate) node lists easier. If I want
+ something like this it should be okay for any situation.
+
+ */
+ if (force_check_hyphenation || lmt_linebreak_state.second_pass || (node_subtype(cur_p) != syllable_discretionary_code)) {
+ halfword actual_penalty = disc_penalty(cur_p);
+ halfword s = disc_pre_break_head(cur_p);
+ tex_aux_reset_disc_target(properties->adjust_spacing, lmt_linebreak_state.disc_width);
+ if (s) {
+ tex_aux_add_to_widths(s, properties->adjust_spacing, properties->adjust_spacing_step, lmt_linebreak_state.disc_width);
+ tex_aux_add_disc_source_to_target(properties->adjust_spacing, lmt_linebreak_state.active_width, lmt_linebreak_state.disc_width);
+ tex_aux_try_break(properties, actual_penalty, hyphenated_node, first_p, cur_p);
+ tex_aux_sub_disc_target_from_source(properties->adjust_spacing, lmt_linebreak_state.active_width, lmt_linebreak_state.disc_width);
+ } else {
+ /*tex trivial pre-break */
+ tex_aux_try_break(properties, actual_penalty, hyphenated_node, first_p, cur_p);
+ }
+ }
+ tex_aux_add_to_widths(disc_no_break_head(cur_p), properties->adjust_spacing, properties->adjust_spacing_step, lmt_linebreak_state.active_width);
+ break;
+ case penalty_node:
+ tex_aux_try_break(properties, penalty_amount(cur_p), unhyphenated_node, first_p, cur_p);
+ break;
+ case math_node:
+ {
+ /* there used to a ! is_char_node(node_next(cur_p)) test */
+ int finishing = node_subtype(cur_p) == end_inline_math;
+ // lmt_linebreak_state.auto_breaking = finishing;
+ if (tex_math_glue_is_zero(cur_p) || tex_ignore_math_skip(cur_p)) {
+ /*tex
+ When we end up here we assume |\mathsurround| but we only check for
+ a break when we're ending math. Maybe this is something we need to
+ open up. The math specific penalty only kicks in when we break.
+ */
+ if (finishing && node_type(node_next(cur_p)) == glue_node) {
+ tex_aux_try_break(properties, math_penalty(cur_p), unhyphenated_node, first_p, cur_p);
+ }
+ lmt_linebreak_state.active_width[total_glue_amount] += math_surround(cur_p);
+ } else {
+ /*tex
+ This one does quite some testing, is that still needed?
+ */
+ if (finishing && tex_aux_valid_glue_break(cur_p)) {
+ tex_aux_try_break(properties, math_penalty(cur_p), unhyphenated_node, first_p, cur_p);
+ }
+ lmt_linebreak_state.active_width[total_glue_amount] += math_amount(cur_p);
+ lmt_linebreak_state.active_width[2 + math_stretch_order(cur_p)] += math_stretch(cur_p);
+ lmt_linebreak_state.active_width[total_shrink_amount] += tex_aux_checked_shrink(cur_p);
+ }
+ }
+ break;
+ case boundary_node:
+ case whatsit_node:
+ case mark_node:
+ case insert_node:
+ case adjust_node:
+ /*tex Advance past these nodes in the |line_break| loop. */
+ break;
+ default:
+ tex_formatted_error("parbuilder", "weird node %d in paragraph", node_type(cur_p));
+ }
+ cur_p = node_next(cur_p);
+ while (! cur_p && nest_index > 0) {
+ cur_p = nest_stack[--nest_index];
+ }
+ }
+ if (! cur_p) {
+ /*tex
+
+ Try the final line break at the end of the paragraph, and |goto done| if the desired
+ breakpoints have been found.
+
+ The forced line break at the paragraph's end will reduce the list of breakpoints so
+ that all active nodes represent breaks at |cur_p = null|. On the first pass, we
+ insist on finding an active node that has the correct \quote {looseness.} On the
+ final pass, there will be at least one active node, and we will match the desired
+ looseness as well as we can.
+
+ The global variable |best_bet| will be set to the active node for the best way to
+ break the paragraph, and a few other variables are used to help determine what is
+ best.
+
+ */
+ tex_aux_try_break(properties, eject_penalty, hyphenated_node, first_p, cur_p);
+ if (node_next(active_head) != active_head) {
+ /*tex Find an active node with fewest demerits. */
+ r = node_next(active_head);
+ lmt_linebreak_state.fewest_demerits = awful_bad;
+ do {
+ if ((node_type(r) != delta_node) && (active_total_demerits(r) < lmt_linebreak_state.fewest_demerits)) {
+ lmt_linebreak_state.fewest_demerits = active_total_demerits(r);
+ lmt_linebreak_state.best_bet = r;
+ }
+ r = node_next(r);
+ } while (r != active_head);
+ lmt_linebreak_state.best_line = active_line_number(lmt_linebreak_state.best_bet);
+ /*tex Find an active node with fewest demerits. */
+ if (properties->looseness == 0) {
+ goto DONE;
+ } else {
+ /*tex
+
+ Find the best active node for the desired looseness. The adjustment for a
+ desired looseness is a slightly more complicated version of the loop just
+ considered. Note that if a paragraph is broken into segments by displayed
+ equations, each segment will be subject to the looseness calculation,
+ independently of the other segments.
+
+ */
+ r = node_next(active_head); // can be local
+ lmt_linebreak_state.actual_looseness = 0;
+ do {
+ if (node_type(r) != delta_node) {
+ lmt_linebreak_state.line_difference = active_line_number(r) - lmt_linebreak_state.best_line;
+ if (((lmt_linebreak_state.line_difference < lmt_linebreak_state.actual_looseness) && (properties->looseness <= lmt_linebreak_state.line_difference))
+ || ((lmt_linebreak_state.line_difference > lmt_linebreak_state.actual_looseness) && (properties->looseness >= lmt_linebreak_state.line_difference))) {
+ lmt_linebreak_state.best_bet = r;
+ lmt_linebreak_state.actual_looseness = lmt_linebreak_state.line_difference;
+ lmt_linebreak_state.fewest_demerits = active_total_demerits(r);
+ } else if ((lmt_linebreak_state.line_difference == lmt_linebreak_state.actual_looseness) && (active_total_demerits(r) < lmt_linebreak_state.fewest_demerits)) {
+ lmt_linebreak_state.best_bet = r;
+ lmt_linebreak_state.fewest_demerits = active_total_demerits(r);
+ }
+ }
+ r = node_next(r);
+ } while (r != active_head);
+ lmt_linebreak_state.best_line = active_line_number(lmt_linebreak_state.best_bet);
+ /*tex
+ Find the best active node for the desired looseness.
+ */
+ if ((lmt_linebreak_state.actual_looseness == properties->looseness) || lmt_linebreak_state.final_pass) {
+ goto DONE;
+ }
+ }
+ }
+ }
+ /*tex Clean up the memory by removing the break nodes. */
+ cur_p = tex_aux_clean_up_the_memory(cur_p);
+ if (! lmt_linebreak_state.second_pass) {
+ if (properties->tracing_paragraphs > 0) {
+ tex_print_str("%l[linebreak: second pass]"); /* @secondpass */;
+ }
+ lmt_linebreak_state.threshold = properties->tolerance;
+ lmt_linebreak_state.second_pass = 1;
+ lmt_linebreak_state.final_pass = (properties->emergency_stretch <= 0);
+ } else {
+ /*tex If at first you do not succeed, then: */
+ if (properties->tracing_paragraphs > 0) {
+ tex_print_str("%l[linebreak: emergency pass]"); /* @emergencypass */
+ }
+ lmt_linebreak_state.background[total_stretch_amount] += properties->emergency_stretch;
+ lmt_linebreak_state.final_pass = 1;
+ }
+ }
+ DONE:
+ if (properties->tracing_paragraphs > 0) {
+ tex_end_diagnostic();
+ /*tex
+ This is a bit weird, as only here: |normalize_selector()| while we have diagnostics
+ all over the place.
+ */
+ }
+ if (lmt_linebreak_state.do_last_line_fit) {
+ /*tex
+ Adjust the final line of the paragraph; here we either reset |do_last_line_fit| or
+ adjust the |par_fill_skip| glue.
+ */
+ if (active_short(lmt_linebreak_state.best_bet) == 0) {
+ lmt_linebreak_state.do_last_line_fit = 0;
+ } else {
+ glue_amount(lmt_linebreak_state.last_line_fill) += (active_short(lmt_linebreak_state.best_bet) - active_glue(lmt_linebreak_state.best_bet));
+ glue_stretch(lmt_linebreak_state.last_line_fill) = 0;
+ }
+ }
+ /*tex
+ Break the paragraph at the chosen. Once the best sequence of breakpoints has been found
+ (hurray), we call on the procedure |post_line_break| to finish the remainder of the work.
+ By introducing this subprocedure, we are able to keep |line_break| from getting extremely
+ long. The first thing |ext_post_line_break| does is reset |dir_ptr|.
+ */
+ tex_flush_node_list(lmt_linebreak_state.dir_ptr);
+ lmt_linebreak_state.dir_ptr = null;
+ /*tex Here we still have a temp node as head. */
+ tex_aux_post_line_break(properties, line_break_dir);
+ /*tex Clean up the memory by removing the break nodes. */
+ cur_p = tex_aux_clean_up_the_memory(cur_p);
+}
+
+void tex_get_linebreak_info(int *f, int *a)
+{
+ *f = lmt_linebreak_state.fewest_demerits;
+ *a = lmt_linebreak_state.actual_looseness;
+}
+
+/*tex
+
+ So far we have gotten a little way into the |line_break| routine, having covered its important
+ |try_break| subroutine. Now let's consider the rest of the process.
+
+ The main loop of |line_break| traverses the given hlist, starting at |vlink (temp_head)|, and
+ calls |try_break| at each legal breakpoint. A variable called |auto_breaking| is set to true
+ except within math formulas, since glue nodes are not legal breakpoints when they appear in
+ formulas.
+
+ The current node of interest in the hlist is pointed to by |cur_p|. Another variable, |prev_p|,
+ is usually one step behind |cur_p|, but the real meaning of |prev_p| is this: If |type (cur_p)
+ = glue_node| then |cur_p| is a legal breakpoint if and only if |auto_breaking| is true and
+ |prev_p| does not point to a glue node, penalty node, explicit kern node, or math node.
+
+ The total number of lines that will be set by |post_line_break| is |best_line - prev_graf - 1|.
+ The last breakpoint is specified by |break_node (best_bet)|, and this passive node points to
+ the other breakpoints via the |prev_break| links. The finishing-up phase starts by linking the
+ relevant passive nodes in forward order, changing |prev_break| to |next_break|. (The
+ |next_break| fields actually reside in the same memory space as the |prev_break| fields did,
+ but we give them a new name because of their new significance.) Then the lines are justified,
+ one by one.
+
+ The |post_line_break| must also keep an dir stack, so that it can output end direction
+ instructions at the ends of lines and begin direction instructions at the beginnings of lines.
+
+*/
+
+/*tex The new name for |prev_break| after links are reversed: */
+
+# define passive_next_break passive_prev_break
+
+/*tex The |int|s are actually |halfword|s or |scaled|s. */
+
+static void tex_aux_trace_penalty(const char *what, int line, int index, halfword penalty, halfword total)
+{
+ if (tracing_penalties_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_format("[linebreak: %s penalty, line %i, index %i, adding %i, total %i]", what, line, index, penalty, total);
+ tex_end_diagnostic();
+ }
+}
+
+static void tex_aux_post_line_break(const line_break_properties *properties, halfword line_break_dir)
+{
+ /*tex temporary registers for list manipulation */
+ halfword q, r;
+ halfword ls = null;
+ halfword rs = null;
+ /*tex was a break at glue? */
+ int glue_break;
+ /*tex are we in some shape */
+ int shaping = 0;
+ /*tex was the current break at a discretionary node? */
+ int disc_break;
+ /*tex and did it have a nonempty post-break part? */
+ int post_disc_break;
+ /*tex width of line number |cur_line| */
+ scaled cur_width;
+ /*tex left margin of line number |cur_line| */
+ scaled cur_indent;
+ /*tex |cur_p| will become the first breakpoint; */
+ halfword cur_p = null;
+ /*tex the current line number being justified */
+ halfword cur_line;
+ /*tex this saves calculations: */
+ int last_line = 0;
+ int first_line = 0;
+ /*tex the current direction: */
+ lmt_linebreak_state.dir_ptr = cur_list.direction_stack;
+ /*tex
+ Reverse the links of the relevant passive nodes, setting |cur_p| to the first breakpoint.
+ The job of reversing links in a list is conveniently regarded as the job of taking items
+ off one stack and putting them on another. In this case we take them off a stack pointed
+ to by |q| and having |prev_break| fields; we put them on a stack pointed to by |cur_p|
+ and having |next_break| fields. Node |r| is the passive node being moved from stack to
+ stack.
+ */
+ q = active_break_node(lmt_linebreak_state.best_bet);
+ do {
+ r = q;
+ q = passive_prev_break(q);
+ passive_next_break(r) = cur_p;
+ cur_p = r;
+ } while (q);
+ /*tex prevgraf + 1 */
+ cur_line = cur_list.prev_graf + 1;
+ do {
+ /*tex
+ Justify the line ending at breakpoint |cur_p|, and append it to the current vertical
+ list, together with associated penalties and other insertions.
+
+ The current line to be justified appears in a horizontal list starting at |vlink
+ (temp_head)| and ending at |cur_break (cur_p)|. If |cur_break (cur_p)| is a glue node,
+ we reset the glue to equal the |right_skip| glue; otherwise we append the |right_skip|
+ glue at the right. If |cur_break (cur_p)| is a discretionary node, we modify the list
+ so that the discretionary break is compulsory, and we set |disc_break| to |true|. We
+ also append the |left_skip| glue at the left of the line, unless it is zero.
+ */
+ /*tex
+ We want to get rid of it.
+ */
+ halfword cur_disc = null;
+ /*tex
+ Local left and right boxes come from \OMEGA\ but have been adapted and extended.
+ */
+ halfword leftbox = null;
+ halfword rightbox = null;
+ halfword middlebox = null;
+ if (lmt_linebreak_state.dir_ptr) {
+ /*tex Insert dir nodes at the beginning of the current line. */
+ for (halfword q = lmt_linebreak_state.dir_ptr; q; q = node_next(q)) {
+ halfword tmp = tex_new_dir(normal_dir_subtype, dir_direction(q));
+ halfword nxt = node_next(temp_head);
+ tex_attach_attribute_list_copy(tmp, nxt ? nxt : temp_head);
+ tex_couple_nodes(temp_head, tmp);
+ /*tex |\break\par| */
+ tex_try_couple_nodes(tmp, nxt);
+ }
+ tex_flush_node_list(lmt_linebreak_state.dir_ptr);
+ lmt_linebreak_state.dir_ptr = null;
+ }
+ /*tex
+ Modify the end of the line to reflect the nature of the break and to include
+ |\rightskip|; also set the proper value of |disc_break|. At the end of the following
+ code, |q| will point to the final node on the list about to be justified. In the
+ meanwhile |r| will point to the node we will use to insert end-of-line stuff after.
+ |q == null| means we use the final position of |r|.
+ */
+ /*tex begin mathskip code */
+ q = temp_head;
+ while (q) {
+ switch (node_type(q)) {
+ case glyph_node:
+ goto DONE;
+ case hlist_node:
+ if (node_subtype(q) == indent_list) {
+ break;
+ } else {
+ goto DONE;
+ }
+ case glue_node:
+ if (tex_is_par_init_glue(q)) {
+ break;
+ } else {
+ goto DONE;
+ }
+ case kern_node:
+ if (node_subtype(q) != explicit_kern_subtype && node_subtype(q) != italic_kern_subtype) {
+ goto DONE;
+ } else {
+ break;
+ }
+ case math_node:
+ math_surround(q) = 0;
+ tex_reset_math_glue_to_zero(q);
+ goto DONE;
+ default:
+ if (non_discardable(q)) {
+ goto DONE;
+ } else {
+ break;
+ }
+ }
+ q = node_next(q);
+ }
+ DONE:
+ /*tex end mathskip code */
+ r = passive_cur_break(cur_p);
+ q = null;
+ disc_break = 0;
+ post_disc_break = 0;
+ glue_break = 0;
+ if (r) {
+ switch (node_type(r)) {
+ case glue_node:
+ tex_copy_glue_values(r, properties->right_skip);
+ node_subtype(r) = right_skip_glue;
+ glue_break = 1;
+ /*tex |q| refers to the last node of the line */
+ q = r;
+ rs = q;
+ r = node_prev(r);
+ /*tex |r| refers to the node after which the dir nodes should be closed */
+ break;
+ case disc_node:
+ {
+ halfword prv = node_prev(r);
+ halfword nxt = node_next(r);
+ halfword h = disc_no_break_head(r);
+ if (h) {
+ tex_flush_node_list(h);
+ disc_no_break_head(r) = null;
+ disc_no_break_tail(r) = null;
+ }
+ h = disc_pre_break_head(r);
+ if (h) {
+ halfword t = disc_pre_break_tail(r);
+ tex_set_discpart(r, h, t, glyph_discpart_pre);
+ tex_couple_nodes(prv, h);
+ tex_couple_nodes(t, r);
+ disc_pre_break_head(r) = null;
+ disc_pre_break_tail(r) = null;
+ }
+ h = disc_post_break_head(r);
+ if (h) {
+ halfword t = disc_post_break_tail(r);
+ tex_set_discpart(r, h, t, glyph_discpart_post);
+ tex_couple_nodes(r, h);
+ tex_couple_nodes(t, nxt);
+ disc_post_break_head(r) = null;
+ disc_post_break_tail(r) = null;
+ post_disc_break = 1;
+ }
+ cur_disc = r;
+ disc_break = 1;
+ }
+ break;
+ case kern_node:
+ kern_amount(r) = 0;
+ break;
+ case math_node :
+ math_surround(r) = 0;
+ tex_reset_math_glue_to_zero(r);
+ break;
+ }
+ } else {
+ /*tex Again a tail run ... maybe combine. */
+ // for (r = temp_head; node_next(r); r = node_next(r));
+ r = tex_tail_of_node_list(temp_head);
+ /*tex Now we're at the end. */
+ if (r == properties->parfill_right_skip) {
+ /*tex This should almost always be true... */
+ q = r;
+ /*tex |q| refers to the last node of the line (and paragraph) */
+ r = node_prev(r);
+ }
+ /*tex |r| refers to the node after which the dir nodes should be closed */
+ }
+ /*tex Adjust the dir stack based on dir nodes in this line. */
+ line_break_dir = tex_sanitize_dir_state(node_next(temp_head), passive_cur_break(cur_p), properties->paragraph_dir);
+ /*tex Insert dir nodes at the end of the current line. */
+ r = tex_complement_dir_state(r);
+ /*tex
+ Modify the end of the line to reflect the nature of the break and to include |\rightskip|;
+ also set the proper value of |disc_break|; Also put the |\leftskip| glue at the left and
+ detach this line.
+
+ The following code begins with |q| at the end of the list to be justified. It ends with
+ |q| at the beginning of that list, and with |node_next(temp_head)| pointing to the remainder
+ of the paragraph, if any.
+
+ Now [q] refers to the last node on the line and therefore the rightmost breakpoint. The
+ only exception is the case of a discretionary break with non-empty |pre_break|, then
+ |q| s been changed to the last node of the |pre_break| list. If the par ends with a
+ |\break| command, the last line is utterly empty. That is the case of |q == temp_head|.
+
+ This code needs to be cleaned up as we now have protrusion and boxes at the edges to
+ deal with. Old hybrid code.
+ */
+ leftbox = tex_use_local_boxes(passive_left_box(cur_p), local_left_box_code);
+ rightbox = tex_use_local_boxes(passive_right_box(cur_p), local_right_box_code);
+ middlebox = tex_use_local_boxes(passive_middle_box(cur_p), local_middle_box_code);
+ /*tex
+ First we append the right box. It is part of the content so inside the skips.
+ */
+ if (rightbox) {
+ halfword nxt = node_next(r);
+ tex_couple_nodes(r, rightbox);
+ tex_try_couple_nodes(rightbox, nxt);
+ r = rightbox;
+ }
+ if (middlebox) {
+ /*tex
+ These middle boxes might become more advanced as we can process them by a pass over
+ the line so that we retain the spot but then, we also loose that with left and right,
+ so why bother. It would also complicate uniqueness.
+ */
+ halfword nxt = node_next(r);
+ tex_couple_nodes(r, middlebox);
+ tex_try_couple_nodes(middlebox, nxt);
+ r = middlebox;
+ }
+ if (! q) {
+ q = r;
+ }
+ if (q != temp_head && properties->protrude_chars) {
+ if (line_break_dir == dir_righttoleft && properties->protrude_chars == protrude_chars_advanced) {
+ halfword p = q;
+ halfword l = null;
+ /*tex Backtrack over the last zero glues and dirs. */
+ while (p) {
+ switch (node_type(p)) {
+ case dir_node:
+ if (node_subtype(p) != cancel_dir_subtype) {
+ goto DONE1;
+ } else {
+ break;
+ }
+ case glue_node:
+ if (glue_amount(p)) {
+ goto DONE3;
+ } else {
+ break;
+ }
+ case glyph_node:
+ goto DONE1;
+ default:
+ goto DONE3;
+ }
+ p = node_prev(p);
+ }
+ DONE1:
+ /*tex When |p| is non zero we have something. */
+ while (p) {
+ switch (node_type(p)) {
+ case glyph_node:
+ l = p ;
+ break;
+ case glue_node:
+ if (glue_amount(p)) {
+ l = null;
+ }
+ break;
+ case dir_node:
+ if (dir_direction(p) != dir_righttoleft) {
+ goto DONE3;
+ } else {
+ goto DONE2;
+ }
+ case par_node:
+ goto DONE2;
+ case temp_node:
+ /*tex Go on. */
+ break;
+ default:
+ l = null;
+ break;
+ }
+ p = node_prev(p);
+ }
+ DONE2:
+ /*tex Time for action. */
+ if (l && p) {
+ scaled w = tex_char_protrusion(l, right_margin_kern_subtype);
+ halfword k = tex_new_kern_node(-w, right_margin_kern_subtype);
+ tex_attach_attribute_list_copy(k, l);
+ tex_couple_nodes(p, k);
+ tex_couple_nodes(k, l);
+ }
+ } else {
+ scaled w = 0;
+ halfword p, ptmp;
+ if (disc_break && (node_type(q) == glyph_node || node_type(q) != disc_node)) {
+ /*tex |q| is reset to the last node of |pre_break| */
+ p = q;
+ } else {
+ /*tex get |node_next(p) = q| */
+ p = node_prev(q);
+ }
+ ptmp = p;
+ p = tex_aux_find_protchar_right(node_next(temp_head), p);
+ w = tex_char_protrusion(p, right_margin_kern_subtype);
+ if (w && lmt_packaging_state.last_rightmost_char) {
+ /*tex we have found a marginal kern, append it after |ptmp| */
+ halfword k = tex_new_kern_node(-w, right_margin_kern_subtype);
+ tex_attach_attribute_list_copy(k, p);
+ tex_try_couple_nodes(k, node_next(ptmp));
+ tex_couple_nodes(ptmp, k);
+ if (ptmp == q) {
+ q = node_next(q);
+ }
+ }
+ }
+ }
+ DONE3:
+ /*tex
+ If |q| was not a breakpoint at glue and has been reset to |rightskip| then we append
+ |rightskip| after |q| now?
+ */
+ if (glue_break) {
+ /*tex A rightskip has already been added. */
+ } else {
+ /*tex We add one, even when zero. */
+ halfword g = tex_new_glue_node(properties->right_skip ? properties->right_skip : zero_glue, right_skip_glue);
+ tex_attach_attribute_list_copy(g, q); /* or next of it? or q */
+ tex_try_couple_nodes(g, node_next(q));
+ tex_couple_nodes(q, g);
+ q = g;
+ }
+ rs = q;
+ /*tex
+ More preparations.
+ */
+ r = node_next(q);
+ node_next(q) = null;
+ q = node_next(temp_head);
+ tex_try_couple_nodes(temp_head, r);
+ /*tex
+ Now we prepend the left box. It is part of the content so inside the skips.
+ */
+ if (leftbox) {
+ halfword nxt = node_next(q);
+ tex_couple_nodes(leftbox, q);
+ q = leftbox;
+ if (nxt && (cur_line == cur_list.prev_graf + 1) && (node_type(nxt) == hlist_node) && ! box_list(nxt)) {
+ /* what is special about an empty hbox, needs checking */
+ q = node_next(q);
+ tex_try_couple_nodes(leftbox, node_next(nxt));
+ tex_try_couple_nodes(nxt, leftbox);
+ }
+ }
+ /*tex
+ At this point |q| is the leftmost node; all discardable nodes have been discarded.
+ */
+ if (properties->protrude_chars) {
+ if (line_break_dir == dir_righttoleft && properties->protrude_chars == protrude_chars_advanced) {
+ halfword p = tex_aux_find_protchar_left(q, 0);
+ halfword w = tex_char_protrusion(p, right_margin_kern_subtype);
+ if (w && lmt_packaging_state.last_leftmost_char) {
+ halfword k = tex_new_kern_node(-w, right_margin_kern_subtype);
+ tex_attach_attribute_list_copy(k, p);
+ tex_couple_nodes(k, q);
+ q = k;
+ }
+ } else {
+ halfword p = tex_aux_find_protchar_left(q, 0);
+ halfword w = tex_char_protrusion(p, left_margin_kern_subtype);
+ if (w && lmt_packaging_state.last_leftmost_char) {
+ halfword k = tex_new_kern_node(-w, left_margin_kern_subtype);
+ tex_attach_attribute_list_copy(k, p);
+ tex_couple_nodes(k, q);
+ q = k;
+ }
+ }
+ }
+ /*tex
+ Fix a possible mess up.
+ */
+ if (node_type(q) == par_node && ! tex_is_start_of_par_node(q)) {
+ node_subtype(q) = hmode_par_par_subtype ;
+ }
+ /*tex
+ Put the |\leftskip| glue at the left and detach this line. Call the packaging
+ subroutine, setting |just_box| to the justified box. Now|q| points to the hlist that
+ represents the current line of the paragraph. We need to compute the appropriate line
+ width, pack the line into a box of this size, and shift the box by the appropriate
+ amount of indentation. In \LUAMETATEX\ we always add the leftskip.
+ */
+ r = tex_new_glue_node(properties->left_skip, left_skip_glue);
+ tex_attach_attribute_list_copy(r, q);
+ tex_couple_nodes(r, q);
+ q = r;
+ ls = q;
+ /*tex
+ We have these |par| nodes that, when we have callbacks, kind of polute the list. Let's
+ get rid of them now. We could have done this in previous loops but for the sake of
+ clearity we do it here. That way we keep the existing code as it is in older engines.
+ Okay, I might collapse it eventually. This is code that has been prototyped using \LUA.
+ */
+ if (cur_line > lmt_linebreak_state.last_special_line) { // && (! (properties->par_shape && specification_repeat(properties->par_shape)))) {
+ cur_width = lmt_linebreak_state.second_width;
+ cur_indent = lmt_linebreak_state.second_indent;
+ } else if (properties->par_shape) {
+ if (specification_count(properties->par_shape)) {
+ cur_indent = tex_get_specification_indent(properties->par_shape, cur_line);
+ cur_width = tex_get_specification_width(properties->par_shape, cur_line);
+ cur_indent = swap_parshape_indent(properties->paragraph_dir, cur_indent, cur_width);
+ } else {
+ cur_width = lmt_linebreak_state.first_width;
+ cur_indent = lmt_linebreak_state.first_indent;
+ }
+ } else {
+ cur_width = lmt_linebreak_state.first_width;
+ cur_indent = lmt_linebreak_state.first_indent;
+ }
+ /*tex
+ When we have a left hang, the width is the (hsize-hang) and there is a shift if hang
+ applied. The overall linewidth is hsize. When we vbox the result, we get a box with
+ width hsize.
+
+ When we have a right hang, the width is the (hsize-hang) and therefore we end up with
+ a box that is less that the hsize. When we vbox the result, we get a box with width
+ hsize minus the hang, so definitely not consistent with the previous case.
+
+ In both cases we can consider the hang to be at the edge, simply because the whole lot
+ gets packaged and then shift gets applied. Although, for practical reasons we could
+ decide to put it after the left and before the right skips, which actually opens up
+ some options.
+
+ Anyway, after a period of nasty heuristics we can now do a better job because we still
+ have the information that we started with.
+
+ */
+ first_line = rs && (cur_line == 1) && properties->parinit_left_skip && properties->parinit_right_skip;
+ if (first_line) {
+ halfword n = node_next(properties->parinit_left_skip);
+ while (n) {
+ if (n == properties->parinit_right_skip) {
+ tex_couple_nodes(node_prev(n), node_next(n));
+ tex_couple_nodes(node_prev(rs), n);
+ tex_couple_nodes(n, rs);
+ break;
+ } else {
+ n = node_next(n);
+ }
+ }
+ if (! n) {
+ /*tex For the moment: */
+ tex_normal_warning("tex", "right parinit skip is gone");
+ }
+ }
+ last_line = ls && (cur_line + 1 == lmt_linebreak_state.best_line) && properties->parfill_left_skip && properties->parfill_right_skip;
+ if (last_line) {
+ halfword n = node_prev(properties->parfill_right_skip);
+ while (n) {
+ if (n == properties->parfill_left_skip) {
+ tex_couple_nodes(node_prev(n), node_next(n));
+ tex_couple_nodes(n, node_next(ls));
+ tex_couple_nodes(ls, n);
+ break;
+ } else {
+ n = node_prev(n);
+ }
+ }
+ if (! n) {
+ /*tex For the moment: */
+ tex_normal_warning("tex", "left parfill skip is gone");
+ }
+ }
+ /*tex Some housekeeping. */
+ lmt_packaging_state.post_adjust_tail = post_adjust_head;
+ lmt_packaging_state.pre_adjust_tail = pre_adjust_head;
+ lmt_packaging_state.post_migrate_tail = post_migrate_head;
+ lmt_packaging_state.pre_migrate_tail = pre_migrate_head;
+ /*tex A bonus feature. */
+ if (normalize_line_mode_permitted(normalize_line_mode_par, flatten_discretionaries_mode)) {
+ int count = 0;
+ q = tex_flatten_discretionaries(q, &count, 0); /* there is no need to nest */
+ cur_disc = null;
+ if (properties->tracing_paragraphs > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[linebreak: flatten, line %i, count %i]", cur_line, count);
+ tex_end_diagnostic();
+ }
+ }
+ /*tex Finally we pack the lot. */
+ shaping = 0;
+ if (normalize_line_mode_permitted(normalize_line_mode_par, normalize_line_mode)) {
+ halfword head = q;
+ halfword tail = rs ? rs : head;
+ halfword lefthang = 0;
+ halfword righthang = 0;
+ // we already have the tail somewhere
+ while (node_next(tail)) {
+ tail = node_next(tail);
+ }
+ if (properties->par_shape) {
+ int n = specification_count(properties->par_shape);
+ if (n > 0) {
+ if (specification_repeat(properties->par_shape)) {
+ n = cur_line;
+ } else {
+ n = cur_line > n ? n : cur_line;
+ }
+ lefthang = tex_get_specification_indent(properties->par_shape, n);
+ righthang = properties->hsize - lefthang - tex_get_specification_width(properties->par_shape, n);
+ // lefthang = swap_parshape_indent(paragraph_dir, lefthang, width); // or so
+ }
+ } else if (properties->hang_after) {
+ if (properties->hang_after > 0 && cur_line > properties->hang_after) {
+ if (properties->hang_indent < 0) {
+ righthang = -properties->hang_indent;
+ }
+ if (properties->hang_indent > 0) {
+ lefthang = properties->hang_indent;
+ }
+ } else if (properties->hang_after < 0 && cur_line <= -properties->hang_after) {
+ if (properties->hang_indent < 0) {
+ righthang = -properties->hang_indent;
+ }
+ if (properties->hang_indent > 0) {
+ lefthang = properties->hang_indent;
+ }
+ }
+ }
+ shaping = (lefthang || righthang);
+ lmt_linebreak_state.just_box = tex_hpack(head, cur_width, properties->adjust_spacing ? packing_linebreak : packing_exactly, (singleword) properties->paragraph_dir, holding_none_option);
+ // attach_attribute_list_copy(linebreak_state.just_box, properties->initial_par);
+ if (normalize_line_mode_permitted(normalize_line_mode_par, flatten_h_leaders_mode)) {
+ tex_flatten_leaders(lmt_linebreak_state.just_box, NULL);
+ }
+ if (node_type(tail) != glue_node || node_subtype(tail) != right_skip_glue) {
+ halfword rs = tex_new_glue_node((properties->right_skip ? properties->right_skip : zero_glue), right_skip_glue);
+ tex_attach_attribute_list_copy(rs, tail);
+ tex_try_couple_nodes(rs, node_next(q));
+ tex_couple_nodes(tail, rs);
+ tail = rs;
+ }
+ {
+ halfword lh = tex_new_glue_node(zero_glue, left_hang_skip_glue);
+ halfword rh = tex_new_glue_node(zero_glue, right_hang_skip_glue);
+ glue_amount(lh) = lefthang;
+ glue_amount(rh) = righthang;
+ tex_attach_attribute_list_copy(lh, head);
+ tex_attach_attribute_list_copy(rh, tail);
+ tex_try_couple_nodes(lh, head);
+ tex_try_couple_nodes(tail, rh);
+ head = lh;
+ tail = rh;
+ }
+ /*tex
+ This is kind of special. Instead of using |cur_width| also on an overfull box as well
+ as shifts, we want \quote {real} dimensions. A disadvantage is that we need to adapt
+ analyzers that assume this correction not being there (unpack and repack). So we have
+ a flag to control it.
+ */
+ if (normalize_line_mode_permitted(normalize_line_mode_par, clip_width_mode)) {
+ if (lmt_packaging_state.last_overshoot) {
+ halfword g = tex_new_glue_node(zero_glue, correction_skip_glue);
+ glue_amount(g) = -lmt_packaging_state.last_overshoot;
+ tex_attach_attribute_list_copy(g, rs);
+ tex_try_couple_nodes(node_prev(rs), g);
+ tex_try_couple_nodes(g, rs);
+ }
+ box_width(lmt_linebreak_state.just_box) = properties->hsize;
+ }
+ box_list(lmt_linebreak_state.just_box) = head;
+ q = head;
+ /*tex So only callback when we normalize. */
+ if (leftbox || rightbox || middlebox) {
+ halfword linebox = lmt_linebreak_state.just_box;
+ lmt_local_box_callback(
+ linebox, leftbox, rightbox, middlebox, cur_line,
+ tex_effective_glue(linebox, properties->left_skip),
+ tex_effective_glue(linebox, properties->right_skip),
+ lefthang, righthang, cur_indent,
+ (first_line && properties->parinit_left_skip) ? tex_effective_glue(linebox, properties->parinit_left_skip) : null,
+ (first_line && properties->parinit_right_skip) ? tex_effective_glue(linebox, properties->parinit_right_skip) : null,
+ (last_line && properties->parfill_left_skip) ? tex_effective_glue(linebox, properties->parfill_left_skip) : null,
+ (last_line && properties->parfill_right_skip) ? tex_effective_glue(linebox, properties->parfill_right_skip) : null,
+ lmt_packaging_state.last_overshoot
+ );
+ }
+ } else {
+ /*tex Here we can have a right skip way to the right due to an overshoot! */
+ lmt_linebreak_state.just_box = tex_hpack(q, cur_width, properties->adjust_spacing ? packing_linebreak : packing_exactly, (singleword) properties->paragraph_dir, holding_none_option);
+ // attach_attribute_list_copy(linebreak_state.just_box, properties->initial_par);
+ if (normalize_line_mode_permitted(normalize_line_mode_par, flatten_h_leaders_mode)) {
+ tex_flatten_leaders(lmt_linebreak_state.just_box, NULL);
+ }
+ box_shift_amount(lmt_linebreak_state.just_box) = cur_indent;
+ }
+ /*tex Call the packaging subroutine, setting |just_box| to the justified box. */
+ node_subtype(lmt_linebreak_state.just_box) = line_list;
+ /*tex Pending content (callback). */
+ if (node_next(contribute_head)) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_append_line_filter_callback(pre_box_append_line_context, 0);
+ }
+ }
+ /* Pre-adjust content (no callback). */
+ if (pre_adjust_head != lmt_packaging_state.pre_adjust_tail) {
+ tex_inject_adjust_list(pre_adjust_head, 1, lmt_linebreak_state.just_box, properties);
+ }
+ lmt_packaging_state.pre_adjust_tail = null;
+ /* Pre-migrate content (callback). */
+ if (pre_migrate_head != lmt_packaging_state.pre_migrate_tail) {
+ tex_append_list(pre_migrate_head, lmt_packaging_state.pre_migrate_tail);
+ if (! lmt_page_builder_state.output_active) {
+ lmt_append_line_filter_callback(pre_migrate_append_line_context, 0);
+ }
+ }
+ lmt_packaging_state.pre_migrate_tail = null;
+ /* Line content (callback). */
+ tex_append_to_vlist(lmt_linebreak_state.just_box, lua_key_index(post_linebreak), properties);
+ if (! lmt_page_builder_state.output_active) {
+ /* Here we could use the par specific baselineskip and lineskip. */
+ lmt_append_line_filter_callback(box_append_line_context, 0);
+ }
+ /* Post-migrate content (callback). */
+ if (post_migrate_head != lmt_packaging_state.post_migrate_tail) {
+ tex_append_list(post_migrate_head, lmt_packaging_state.post_migrate_tail);
+ if (! lmt_page_builder_state.output_active) {
+ lmt_append_line_filter_callback(post_migrate_append_line_context, 0);
+ }
+ }
+ lmt_packaging_state.post_migrate_tail = null;
+ /* Post-adjust content (callback). */
+ if (post_adjust_head != lmt_packaging_state.post_adjust_tail) {
+ tex_inject_adjust_list(post_adjust_head, 1, null, properties);
+ }
+ lmt_packaging_state.post_adjust_tail = null;
+ /*tex
+ Append the new box to the current vertical list, followed by the list of special nodes
+ taken out of the box by the packager. Append a penalty node, if a nonzero penalty is
+ appropriate. Penalties between the lines of a paragraph come from club and widow lines,
+ from the |inter_line_penalty| parameter, and from lines that end at discretionary breaks.
+ Breaking between lines of a two-line paragraph gets both club-line and widow-line
+ penalties. The local variable |pen| will be set to the sum of all relevant penalties for
+ the current line, except that the final line is never penalized.
+ */
+ if (cur_line + 1 != lmt_linebreak_state.best_line) {
+ /*tex
+ When we end up here we hale multiple lines so we need to add penalties between them
+ according to (several) specifications.
+ */
+ halfword pen = 0;
+ halfword spm = properties->shaping_penalties_mode;
+ if (! spm) {
+ shaping = 0;
+ }
+ if (tracing_penalties_par > 0) {
+ tex_begin_diagnostic();
+ tex_print_format("[linebreak: penalty, line %i, best line %i, prevgraf %i, mode %x (i=%i c=%i w=%i b=%i)]",
+ cur_line, lmt_linebreak_state.best_line, cur_list.prev_graf, spm,
+ is_shaping_penalties_mode(spm, inter_line_penalty_shaping),
+ is_shaping_penalties_mode(spm, club_penalty_shaping),
+ is_shaping_penalties_mode(spm, widow_penalty_shaping),
+ is_shaping_penalties_mode(spm, broken_penalty_shaping)
+ );
+ tex_end_diagnostic();
+ }
+ if (! (shaping && is_shaping_penalties_mode(spm, inter_line_penalty_shaping))) {
+ halfword p;
+ q = properties->inter_line_penalties;
+ if (q) {
+ r = cur_line;
+ if (r > specification_count(q)) {
+ r = specification_count(q);
+ } else if (r < 1) {
+ r = 1;
+ }
+ p = tex_get_specification_penalty(q, r);
+ } else if (passive_pen_inter(cur_p)) {
+ p = passive_pen_inter(cur_p);
+ } else {
+ p = properties->inter_line_penalty;
+ }
+ if (p) {
+ pen += p;
+ tex_aux_trace_penalty("interline", cur_line, r, p, pen);
+ }
+ }
+ if (! (shaping && is_shaping_penalties_mode(spm, club_penalty_shaping))) {
+ halfword p;
+ q = properties->club_penalties;
+ if (q) {
+ /*tex prevgraf */
+ r = cur_line - cur_list.prev_graf;
+ if (r > specification_count(q)) {
+ r = specification_count(q);
+ } else if (r < 1) {
+ r = 1;
+ }
+ p = tex_get_specification_penalty(q, r);
+ } else if (cur_line == cur_list.prev_graf + 1) {
+ /*tex prevgraf */
+ p = properties->club_penalty;
+ } else {
+ p = 0;
+ }
+ if (p) {
+ pen += p;
+ tex_aux_trace_penalty("club", cur_line, r, p, pen);
+ }
+ }
+ if (! (shaping && is_shaping_penalties_mode(spm, widow_penalty_shaping))) {
+ halfword p;
+ q = properties->display_math ? properties->display_widow_penalties : properties->widow_penalties;
+ if (q) {
+ r = lmt_linebreak_state.best_line - cur_line - 1;
+ if (r > specification_count(q)) {
+ r = specification_count(q);
+ } else if (r < 1) {
+ r = 1;
+ }
+ p = tex_get_specification_penalty(q, r);
+ } else if (cur_line + 2 == lmt_linebreak_state.best_line) {
+ p = properties->display_math ? properties->display_widow_penalty : properties->widow_penalty;
+ } else {
+ p = 0;
+ }
+ if (p) {
+ pen += p;
+ tex_aux_trace_penalty("widow", cur_line, r, p, pen);
+ }
+ }
+ if (disc_break && ! (shaping && is_shaping_penalties_mode(spm, broken_penalty_shaping))) {
+ halfword p;
+ if (passive_pen_broken(cur_p) != 0) {
+ p = passive_pen_broken(cur_p);
+ } else {
+ p = properties->broken_penalty;
+ }
+ if (p) {
+ pen += p;
+ tex_aux_trace_penalty("broken", cur_line, 0, p, pen);
+ }
+ }
+ if (shaping && ! pen) {
+ pen = properties->shaping_penalty;
+ if (pen) {
+ tex_aux_trace_penalty("shaping", cur_line, 0, pen, pen);
+ }
+ }
+ if (pen) {
+ r = tex_new_penalty_node(pen, linebreak_penalty_subtype);
+ tex_couple_nodes(cur_list.tail, r);
+ cur_list.tail = r;
+ }
+ } else {
+ // if (tracing_penalties_par > 0) {
+ // tex_begin_diagnostic();
+ // tex_print_format("[linebreak: no penalties injected]");
+ // tex_end_diagnostic();
+ // }
+ }
+ /*tex
+ Append a penalty node, if a nonzero penalty is appropriate. Justify the line ending at
+ breakpoint |cur_p|, and append it to the current vertical list, together with associated
+ penalties and other insertions.
+ */
+ ++cur_line;
+ cur_p = passive_next_break(cur_p);
+ if (cur_p && ! post_disc_break) {
+ /*tex
+ Prune unwanted nodes at the beginning of the next line. Glue and penalty and kern
+ and math nodes are deleted at the beginning of a line, except in the anomalous case
+ that the node to be deleted is actually one of the chosen breakpoints. Otherwise
+ the pruning done here is designed to match the lookahead computation in
+ |try_break|, where the |break_width| values are computed for non-discretionary
+ breakpoints.
+ */
+ r = temp_head;
+ /*tex
+ Normally we have a matching math open and math close node but when we cross a line
+ the open node is removed, including any glue or penalties following it. This is
+ however not that nice for callbacks that rely on symmetry. Of course this only
+ counts for one liners, as we can still have only a begin or end node on a line. The
+ end_of_math lua helper is made robust against this although there you should be
+ aware of the fact that one can end up in the middle of math in callbacks that don't
+ work on whole paragraphs, but at least this branch makes sure that some proper
+ analysis is possible. (todo: check if math glyphs have the subtype marked done).
+ */
+ /*tex Suboptimal but not critical. Todo.*/
+ while (1) {
+ q = node_next(r);
+ if (node_type(q) == math_node) {
+ /*tex begin mathskip code */
+ math_surround(q) = 0 ;
+ tex_reset_math_glue_to_zero(q);
+ /*tex end mathskip code */
+ }
+ if (q == passive_cur_break(cur_p)) {
+ break;
+ } else if (node_type(q) == glyph_node) {
+ break;
+ } else if (node_type(q) == glue_node && (node_subtype(q) == par_fill_left_skip_glue || node_subtype(q) == par_init_left_skip_glue)) {
+ /*tex Keep it. Can be tricky after a |\break| with no follow up (loops). */
+ break;
+ } else if (node_type(q) == par_node && node_subtype(q) == local_box_par_subtype) {
+ /*tex weird, in the middle somewhere .. these local penalties do this */
+ break; /* if not we leak, so maybe this needs more testing */
+ } else if (non_discardable(q)) {
+ break;
+ } else if (node_type(q) == kern_node && node_subtype(q) != explicit_kern_subtype && node_subtype(q) != italic_kern_subtype) {
+ break;
+ }
+ r = q;
+ }
+ if (r != temp_head) {
+ node_next(r) = null;
+ tex_flush_node_list(node_next(temp_head));
+ tex_try_couple_nodes(temp_head, q);
+ }
+ }
+ if (cur_disc) {
+ tex_try_couple_nodes(node_prev(cur_disc),node_next(cur_disc));
+ tex_flush_node(cur_disc);
+ }
+ /* We can clean up the par nodes. */
+ } while (cur_p);
+ if ((cur_line != lmt_linebreak_state.best_line) || (node_next(temp_head))) {
+ tex_confusion("line breaking");
+ }
+ /*tex |prevgraf| etc */
+ cur_list.prev_graf = lmt_linebreak_state.best_line - 1;
+ cur_list.direction_stack = lmt_linebreak_state.dir_ptr;
+ lmt_linebreak_state.dir_ptr = null;
+}
diff --git a/source/luametatex/source/tex/texlinebreak.h b/source/luametatex/source/tex/texlinebreak.h
new file mode 100644
index 000000000..27c8607e0
--- /dev/null
+++ b/source/luametatex/source/tex/texlinebreak.h
@@ -0,0 +1,206 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LINEBREAK_H
+# define LMT_LINEBREAK_H
+
+// # define max_hlist_stack 1024 /*tex This should be more than enough for sane usage. */
+
+
+/*tex
+
+ When looking for optimal line breaks, \TEX\ creates a \quote {break node} for each break that
+ is {\em feasible}, in the sense that there is a way to end a line at the given place without
+ requiring any line to stretch more than a given tolerance. A break node is characterized by
+ three things: the position of the break (which is a pointer to a |glue_node|, |math_node|,
+ |penalty_node|, or |disc_node|); the ordinal number of the line that will follow this breakpoint;
+ and the fitness classification of the line that has just ended, i.e., |tight_fit|, |decent_fit|,
+ |loose_fit|, or |very_loose_fit|.
+
+ Todo: 0..0.25 / 0.25-0.50 / 0.50-0.75 / 0.75-1.00
+
+ TeX by Topic gives a good explanation of the way lines are broken.
+
+ veryloose stretch badness >= 100
+ loose stretch badness >= 13
+ decent badness <= 12
+ tight shrink badness >= 13
+
+ adjacent delta two lines > 1 : visually incompatible
+
+ if badness of any line > pretolerance : second pass
+ if pretolerance < 0 : first pass is skipped
+ if badness of any line > tolerance : third pass (with emergencystretch)
+
+ in lua(meta)tex: always hypnehenated lists (in regular tex second pass+)
+
+ badness of 800 : stretch ratio 2
+
+ One day I will play with a pluggedin badness calculation but there os some performance impact
+ there as well as danger to overflow (unless we go double or very long integers).
+
+*/
+
+typedef enum fitness_value {
+ very_loose_fit, /*tex lines stretching more than their stretchability */
+ loose_fit, /*tex lines stretching 0.5 to 1.0 of their stretchability */
+ semi_loose_fit,
+ decent_fit, /*tex for all other lines */
+ semi_tight_fit,
+ tight_fit, /*tex lines shrinking 0.5 to 1.0 of their shrinkability */
+ n_of_finess_values
+} fitness_value;
+
+/*tex
+
+ Some of the next variables can now be local but I don't want to divert too much from the
+ orginal, so for now we keep them in the info variable.
+
+*/
+
+typedef struct linebreak_state_info {
+ /*tex the |hlist_node| for the last line of the new paragraph */
+ halfword just_box;
+ halfword last_line_fill;
+ int no_shrink_error_yet;
+ int second_pass;
+ int final_pass;
+ int threshold;
+ halfword adjust_spacing;
+ halfword adjust_spacing_step;
+ halfword adjust_spacing_shrink;
+ halfword adjust_spacing_stretch;
+ int max_stretch_ratio;
+ int max_shrink_ratio;
+ halfword current_font_step;
+ halfword passive;
+ halfword printed_node;
+ halfword pass_number;
+ /* int auto_breaking; */ /* is gone */
+ /* int math_level; */ /* was never used */
+ scaled active_width[10];
+ scaled background[10];
+ scaled break_width[10];
+ scaled disc_width[10];
+ scaled fill_width[4];
+ halfword internal_penalty_interline;
+ halfword internal_penalty_broken;
+ halfword internal_left_box;
+ scaled internal_left_box_width;
+ halfword init_internal_left_box;
+ scaled init_internal_left_box_width;
+ halfword internal_right_box;
+ scaled internal_right_box_width;
+ scaled internal_middle_box;
+ halfword minimal_demerits[n_of_finess_values];
+ halfword minimum_demerits;
+ halfword easy_line;
+ halfword last_special_line;
+ scaled first_width;
+ scaled second_width;
+ scaled first_indent;
+ scaled second_indent;
+ halfword best_bet;
+ halfword fewest_demerits;
+ halfword best_line;
+ halfword actual_looseness;
+ halfword line_difference;
+ int do_last_line_fit;
+ halfword dir_ptr;
+ halfword warned;
+ halfword calling_back;
+} linebreak_state_info;
+
+extern linebreak_state_info lmt_linebreak_state;
+
+void tex_line_break_prepare (
+ halfword par,
+ halfword *tail,
+ halfword *parinit_left_skip_glue,
+ halfword *parinit_right_skip_glue,
+ halfword *parfill_left_skip_glue,
+ halfword *parfill_right_skip_glue,
+ halfword *final_penalty
+);
+
+extern void tex_line_break (
+ int d,
+ int line_break_context
+);
+
+extern void tex_initialize_active (
+ void
+);
+
+extern void tex_get_linebreak_info (
+ int *f,
+ int *a
+);
+
+extern void tex_do_line_break (
+ line_break_properties *properties
+);
+
+
+/*tex
+
+ We can have skipable nodes at the margins during character protrusion. Two extra functions are
+ defined for usage in |cp_skippable|.
+
+*/
+
+inline static int tex_zero_box_dimensions(halfword a)
+{
+ return box_width(a) == 0 && box_height(a) == 0 && box_depth(a) == 0;
+}
+
+inline static int tex_zero_rule_dimensions(halfword a)
+{
+ return rule_width(a) == 0 && rule_height(a) == 0 && rule_depth(a) == 0;
+}
+
+inline static int tex_empty_disc(halfword a)
+{
+ return (! disc_pre_break_head(a)) && (! disc_post_break_head(a)) && (! disc_no_break_head(a));
+}
+
+inline static int tex_protrusion_skipable(halfword a)
+{
+ if (a) {
+ switch (node_type(a)) {
+ case glyph_node:
+ return 0;
+ case glue_node:
+ return tex_glue_is_zero(a);
+ case disc_node:
+ return tex_empty_disc(a);
+ case kern_node:
+ return (kern_amount(a) == 0) || (node_subtype(a) == font_kern_subtype);
+ case rule_node:
+ return tex_zero_rule_dimensions(a);
+ case math_node:
+ return (math_surround(a) == 0) || tex_math_glue_is_zero(a);
+ case hlist_node:
+ return (! box_list(a)) && tex_zero_box_dimensions(a);
+ case penalty_node:
+ case dir_node:
+ case par_node:
+ case insert_node:
+ case mark_node:
+ case adjust_node:
+ case boundary_node:
+ case whatsit_node:
+ return 1;
+ }
+ }
+ return 0;
+ }
+
+inline static void tex_append_list(halfword head, halfword tail)
+{
+ tex_couple_nodes(cur_list.tail, node_next(head));
+ cur_list.tail = tail;
+}
+
+# endif
diff --git a/source/luametatex/source/tex/texlocalboxes.c b/source/luametatex/source/tex/texlocalboxes.c
new file mode 100644
index 000000000..0def018d4
--- /dev/null
+++ b/source/luametatex/source/tex/texlocalboxes.c
@@ -0,0 +1,313 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+ The concept of local left and right boxes originates in \OMEGA\ but in \LUATEX\ it already was
+ adapted and made more robust. Here we use an upgraded version with more features. These boxes
+ are sort of a mix between marks (states) and inserts (with dimensions).
+
+ We have linked lists of left or right boxes. This permits selective updating and multiple usage
+ of these boxes. It also means that we need to do additional packing and width calculations.
+
+ When we were in transition local boxes were handled as special boxes (alongside leader and
+ shipout boxes but they got their own cmd again when we were done).
+*/
+
+/*tex
+ Here we set fields in a new par node. We could have an extra width |_par| hut it doesn't really
+ pay off (now).
+*/
+
+inline static scaled tex_aux_local_boxes_width(halfword n)
+{
+ scaled width = 0;
+ while (n) {
+ if (node_type(n) == hlist_node) {
+ width += box_width(n);
+ } else {
+ /*tex Actually this is an error. */
+ }
+ n = node_next(n);
+ }
+ return width;
+}
+
+void tex_add_local_boxes(halfword p)
+{
+ if (local_left_box_par) {
+ halfword copy = tex_copy_node_list(local_left_box_par, null);
+ tex_set_local_left_width(p, tex_aux_local_boxes_width(copy));
+ par_box_left(p) = copy;
+ }
+ if (local_right_box_par) {
+ halfword copy = tex_copy_node_list(local_right_box_par, null);
+ tex_set_local_right_width(p, tex_aux_local_boxes_width(copy));
+ par_box_right(p) = copy;
+ }
+ if (local_middle_box_par) {
+ halfword copy = tex_copy_node_list(local_middle_box_par, null);
+ par_box_middle(p) = copy;
+ }
+}
+
+/*tex
+ Pass on to Lua or inject in the current list. So, we still have a linked list here
+ with only boxes.
+*/
+
+halfword tex_get_local_boxes(halfword location)
+{
+ switch (location) {
+ case local_left_box_code : return tex_use_local_boxes(local_left_box_par, local_left_box_code);
+ case local_right_box_code : return tex_use_local_boxes(local_right_box_par, local_right_box_code);
+ case local_middle_box_code: return tex_use_local_boxes(local_middle_box_par, local_middle_box_code);
+ }
+ return null;
+}
+
+/*tex Set them from Lua, watch out; not an eq update */
+
+void tex_set_local_boxes(halfword b, halfword location)
+{
+ switch (location) {
+ case local_left_box_code : tex_flush_node_list(local_left_box_par); local_left_box_par = b; break;
+ case local_right_box_code : tex_flush_node_list(local_right_box_par); local_right_box_par = b; break;
+ case local_middle_box_code: tex_flush_node_list(local_middle_box_par); local_middle_box_par = b; break;
+ }
+}
+
+/*tex Set them from TeX, watch out; this is an eq update */
+
+static halfword tex_aux_reset_boxes(halfword head, halfword index)
+{
+ if (head && index) {
+ halfword current = head;
+ while (current) {
+ halfword next = node_next(current);
+ if (node_type(current) == hlist_node && box_index(current) == index) {
+ if (current == head) {
+ head = node_next(head);
+ node_prev(head) = null;
+ next = head;
+ } else {
+ tex_try_couple_nodes(node_prev(current), next);
+ }
+ tex_flush_node(current);
+ break;
+ } else {
+ current = next;
+ }
+ }
+ return head;
+ } else {
+ tex_flush_node_list(head);
+ return null;
+ }
+}
+
+void tex_reset_local_boxes(halfword index, halfword location)
+{
+ switch (location) {
+ case local_left_box_code : local_left_box_par = tex_aux_reset_boxes(local_left_box_par, index); break;
+ case local_right_box_code : local_right_box_par = tex_aux_reset_boxes(local_right_box_par, index); break;
+ case local_middle_box_code: local_right_box_par = tex_aux_reset_boxes(local_middle_box_par, index); break;
+ }
+}
+
+static halfword tex_aux_update_boxes(halfword head, halfword b, halfword index)
+{
+ if (head && index) {
+ halfword current = head;
+ while (current) {
+ halfword next = node_next(current);
+ if (node_type(current) == hlist_node && box_index(current) == index) {
+ tex_try_couple_nodes(b, node_next(current));
+ if (current == head) {
+ head = b;
+ } else {
+ tex_couple_nodes(node_prev(current), b);
+ }
+ tex_flush_node(current);
+ break;
+ } else if (next) {
+ current = next;
+ } else {
+ tex_couple_nodes(current, b);
+ break;
+ }
+ }
+ return head;
+ }
+ return b;
+}
+
+void tex_update_local_boxes(halfword b, halfword index, halfword location) /* todo: avoid copying */
+{
+ switch (location) {
+ case local_left_box_code:
+ if (b) {
+ halfword c = local_left_box_par ? tex_copy_node_list(local_left_box_par, null) : null;
+ b = tex_aux_update_boxes(c, b, index);
+ } else if (index) {
+ halfword c = local_left_box_par ? tex_copy_node_list(local_left_box_par, null) : null;
+ b = tex_aux_reset_boxes(c, index);
+ }
+ update_tex_local_left_box(b);
+ break;
+ case local_right_box_code:
+ if (b) {
+ halfword c = local_right_box_par ? tex_copy_node_list(local_right_box_par, null) : null;
+ b = tex_aux_update_boxes(c, b, index);
+ } else if (index) {
+ halfword c = local_right_box_par ? tex_copy_node_list(local_right_box_par, null) : null;
+ b = tex_aux_reset_boxes(c, index);
+ }
+ update_tex_local_right_box(b);
+ break;
+ default:
+ if (b) {
+ halfword c = local_middle_box_par ? tex_copy_node_list(local_middle_box_par, null) : null;
+ b = tex_aux_update_boxes(c, b, index);
+ } else if (index) {
+ halfword c = local_middle_box_par ? tex_copy_node_list(local_middle_box_par, null) : null;
+ b = tex_aux_reset_boxes(c, index);
+ }
+ update_tex_local_middle_box(b);
+ break;
+ }
+}
+
+/*tex The |par| option: */
+
+/* todo: use helper */
+
+static halfword tex_aux_replace_local_box(halfword b, halfword index, halfword par_box)
+{
+ if (b) {
+ halfword c = par_box ? tex_copy_node_list(par_box, null) : null;
+ b = tex_aux_update_boxes(c, b, index);
+ } else if (index) {
+ halfword c = par_box ? tex_copy_node_list(par_box, null) : null;
+ b = tex_aux_reset_boxes(c, index);
+ }
+ if (par_box) {
+ tex_flush_node_list(par_box);
+ }
+ return b;
+}
+
+void tex_replace_local_boxes(halfword par, halfword b, halfword index, halfword location) /* todo: avoid copying */
+{
+ switch (location) {
+ case local_left_box_code:
+ par_box_left(par) = tex_aux_replace_local_box(b, index, par_box_left(par));
+ par_box_left_width(par) = tex_aux_local_boxes_width(b);
+ break;
+ case local_right_box_code:
+ par_box_right(par) = tex_aux_replace_local_box(b, index, par_box_right(par));
+ par_box_right_width(par) = tex_aux_local_boxes_width(b);
+ break;
+ case local_middle_box_code:
+ par_box_middle(par) = tex_aux_replace_local_box(b, index, par_box_middle(par));
+ /*tex We keep the zero width! */
+ break;
+ }
+}
+
+/*tex Get them for line injection. */
+
+halfword tex_use_local_boxes(halfword p, halfword location)
+{
+ if (p) {
+ p = tex_hpack(tex_copy_node_list(p, null), 0, packing_additional, direction_unknown, holding_none_option);
+ switch (location) {
+ case local_left_box_code : node_subtype(p) = local_left_list ; break;
+ case local_right_box_code : node_subtype(p) = local_right_list ; break;
+ case local_middle_box_code: node_subtype(p) = local_middle_list; break;
+ }
+ }
+ return p;
+}
+
+/* */
+
+void tex_scan_local_boxes_keys(quarterword *options, halfword *index)
+{
+ *options = 0;
+ *index = 0;
+ while (1) {
+ switch (tex_scan_character("iklpIKLP", 0, 1, 0)) {
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("index", 1)) {
+ *index = tex_scan_box_index();
+ }
+ break;
+ case 'k': case 'K':
+ if (tex_scan_mandate_keyword("keep", 1)) {
+ *options |= local_box_keep_option;
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("local", 1)) {
+ *options |= local_box_local_option;
+ }
+ break;
+ case 'p': case 'P':
+ if (tex_scan_mandate_keyword("par", 1)) {
+ *options |= local_box_par_option;
+ }
+ break;
+ default:
+ return;
+ }
+ }
+}
+
+halfword tex_valid_box_index(halfword n)
+{
+ return box_index_in_range(n);
+}
+
+
+scaled tex_get_local_left_width(halfword p)
+{
+ return par_box_left_width(p);
+}
+
+scaled tex_get_local_right_width(halfword p)
+{
+ return par_box_right_width(p);
+}
+
+void tex_set_local_left_width(halfword p, scaled width)
+{
+ par_box_left_width(p) = width;
+}
+
+void tex_set_local_right_width(halfword p, scaled width)
+{
+ par_box_right_width(p) = width;
+}
+
+halfword tex_get_local_interline_penalty(halfword p)
+{
+ return par_penalty_interline(p);
+}
+
+halfword tex_get_local_broken_penalty(halfword p)
+{
+ return par_penalty_broken(p);
+}
+
+void tex_set_local_interline_penalty(halfword p, halfword penalty)
+{
+ par_penalty_interline(p) = penalty;
+}
+
+void tex_set_local_broken_penalty(halfword p, halfword penalty)
+{
+ par_penalty_broken(p) = penalty;
+}
diff --git a/source/luametatex/source/tex/texlocalboxes.h b/source/luametatex/source/tex/texlocalboxes.h
new file mode 100644
index 000000000..6c37ea1ae
--- /dev/null
+++ b/source/luametatex/source/tex/texlocalboxes.h
@@ -0,0 +1,35 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_LOCALBOXES_H
+# define LMT_LOCALBOXES_H
+
+/*tex Todo: determine when to update (grouping, copying) or when to replace. */
+
+extern halfword tex_get_local_boxes (halfword location);
+extern void tex_set_local_boxes (halfword b, halfword location);
+extern halfword tex_use_local_boxes (halfword p, halfword location);
+extern void tex_update_local_boxes (halfword b, halfword index, halfword location);
+extern void tex_replace_local_boxes (halfword par, halfword b, halfword index, halfword location);
+extern void tex_reset_local_boxes (halfword index, halfword location);
+
+extern void tex_add_local_boxes (halfword p);
+extern void tex_scan_local_boxes_keys (quarterword *options, halfword *index);
+extern halfword tex_valid_box_index (halfword n);
+
+/*tex Helpers, just in case we decide to be more sparse. */
+
+extern scaled tex_get_local_left_width (halfword p);
+extern scaled tex_get_local_right_width (halfword p);
+
+extern void tex_set_local_left_width (halfword p, scaled width);
+extern void tex_set_local_right_width (halfword p, scaled width);
+
+extern halfword tex_get_local_interline_penalty (halfword p);
+extern halfword tex_get_local_broken_penalty (halfword p);
+
+extern void tex_set_local_interline_penalty (halfword p, halfword penalty);
+extern void tex_set_local_broken_penalty (halfword p, halfword penalty);
+
+# endif \ No newline at end of file
diff --git a/source/luametatex/source/tex/texmainbody.c b/source/luametatex/source/tex/texmainbody.c
new file mode 100644
index 000000000..57b7d34be
--- /dev/null
+++ b/source/luametatex/source/tex/texmainbody.c
@@ -0,0 +1,590 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ This is where the action starts. We're speaking of \LUATEX, a continuation of \PDFTEX\ (which
+ included \ETEX) and \ALEPH. As \TEX, \LUATEX\ is a document compiler intended to simplify high
+ quality typesetting for many of the world's languages. It is an extension of D.E. Knuth's \TEX,
+ which was designed essentially for the typesetting of languages using the Latin alphabet.
+ Although it is a direct decendant of \TEX, and therefore mostly compatible, there are some
+ subtle differences that relate to \UNICODE\ support and \OPENTYPE\ math.
+
+ The \ALEPH\ subsystem loosens many of the restrictions imposed by~\TeX: register numbers are no
+ longer limited to 8~bits. Fonts may have more than 256~characters, more than 256~fonts may be
+ used, etc. We use a similar model. We also borrowed the directional model but have upgraded it a
+ bit as well as integrated it more tightly.
+
+ This program is directly derived from Donald E. Knuth's \TEX; the change history which follows
+ and the reward offered for finders of bugs refer specifically to \TEX; they should not be taken
+ as referring to \LUATEX, \PDFTEX, nor \ETEX, although the change history is relevant in that it
+ demonstrates the evolutionary path followed. This program is not \TEX; that name is reserved
+ strictly for the program which is the creation and sole responsibility of Professor Knuth.
+
+ \starttyping
+ % Version 0 was released in September 1982 after it passed a variety of tests.
+ % Version 1 was released in November 1983 after thorough testing.
+ % Version 1.1 fixed "disappearing font identifiers" et alia (July 1984).
+ % Version 1.2 allowed '0' in response to an error, et alia (October 1984).
+ % Version 1.3 made memory allocation more flexible and local (November 1984).
+ % Version 1.4 fixed accents right after line breaks, et alia (April 1985).
+ % Version 1.5 fixed \the\toks after other expansion in \edefs (August 1985).
+ % Version 2.0 (almost identical to 1.5) corresponds to "Volume B" (April 1986).
+ % Version 2.1 corrected anomalies in discretionary breaks (January 1987).
+ % Version 2.2 corrected "(Please type...)" with null \endlinechar (April 1987).
+ % Version 2.3 avoided incomplete page in premature termination (August 1987).
+ % Version 2.4 fixed \noaligned rules in indented displays (August 1987).
+ % Version 2.5 saved cur_order when expanding tokens (September 1987).
+ % Version 2.6 added 10sp slop when shipping leaders (November 1987).
+ % Version 2.7 improved rounding of negative-width characters (November 1987).
+ % Version 2.8 fixed weird bug if no \patterns are used (December 1987).
+ % Version 2.9 made \csname\endcsname's "relax" local (December 1987).
+ % Version 2.91 fixed \outer\def\a0{}\a\a bug (April 1988).
+ % Version 2.92 fixed \patterns, also file names with complex macros (May 1988).
+ % Version 2.93 fixed negative halving in allocator when mem_min<0 (June 1988).
+ % Version 2.94 kept open_log_file from calling fatal_error (November 1988).
+ % Version 2.95 solved that problem a better way (December 1988).
+ % Version 2.96 corrected bug in "Infinite shrinkage" recovery (January 1989).
+ % Version 2.97 corrected blunder in creating 2.95 (February 1989).
+ % Version 2.98 omitted save_for_after at outer level (March 1989).
+ % Version 2.99 caught $$\begingroup\halign..$$ (June 1989).
+ % Version 2.991 caught .5\ifdim.6... (June 1989).
+ % Version 2.992 introduced major changes for 8-bit extensions (September 1989).
+ % Version 2.993 fixed a save_stack synchronization bug et alia (December 1989).
+ % Version 3.0 fixed unusual displays; was more \output robust (March 1990).
+ % Version 3.1 fixed nullfont, disabled \write{\the\prevgraf} (September 1990).
+ % Version 3.14 fixed unprintable font names and corrected typos (March 1991).
+ % Version 3.141 more of same; reconstituted ligatures better (March 1992).
+ % Version 3.1415 preserved nonexplicit kerns, tidied up (February 1993).
+ % Version 3.14159 allowed fontmemsize to change; bulletproofing (March 1995).
+ % Version 3.141592 fixed \xleaders, glueset, weird alignments (December 2002).
+ % Version 3.1415926 was a general cleanup with minor fixes (February 2008).
+ % Succesive versions have been checked and if needed fixes havebeen applied.
+ \stoptyping
+
+ Although considerable effort has been expended to make the \LUATEX\ program correct and
+ reliable, no warranty is implied; the authors disclaim any obligation or liability for damages,
+ including but not limited to special, indirect, or consequential damages arising out of or in
+ connection with the use or performance of this software. This work has been a \quote {labor
+ of love| and the authors (Hartmut Henkel, Taco Hoekwater, Hans Hagen and Luigi Scarso) hope that
+ users enjoy it.
+
+ After a decade years of experimenting and reaching a more or less stable state, \LUATEX\ 1.0 was
+ released and a few years later end 2018 we were at version 1.1 which is a meant to be a stable
+ version. No more substantial additions will take place (that happens in \LUAMETATEX). As a
+ follow up we decided to experiment with a stripped down version, basically the \TEX\ core
+ without backend and with minimal font and file management. We'll see where that ends.
+
+ {\em You will find a lot of comments that originate in original \TEX. We kept them as a side
+ effect of the conversion from \WEB\ to \CWEB. Because there is not much webbing going on here
+ eventually the files became regular \CCODE\ files with still potentially typeset comments. As
+ we add our own comments, and also comments are there from \PDFTEX, \ALEPH\ and \ETEX, we get a
+ curious mix. The best comments are of course from Don Knuth. All bad comments are ours. All
+ errors are ours too!
+
+ Not all comments make sense, because some things are implemented differently, for instance some
+ memory management. But the principles of tokens and nodes stayed. It anyway means that you
+ sometimes need to keep in mind that the explanation is more geared to traditional \TEX. But that's
+ not a bad thing. Sorry Don for any confusion we introduced. The readers should have a copy of the
+ \TEX\ books at hand anyway.}
+
+ A large piece of software like \TEX\ has inherent complexity that cannot be reduced below a certain
+ level of difficulty, although each individual part is fairly simple by itself. The \WEB\ language
+ is intended to make the algorithms as readable as possible, by reflecting the way the individual
+ program pieces fit together and by providing the cross-references that connect different parts.
+ Detailed comments about what is going on, and about why things were done in certain ways, have been
+ liberally sprinkled throughout the program. These comments explain features of the implementation,
+ but they rarely attempt to explain the \TeX\ language itself, since the reader is supposed to be
+ familiar with {\em The \TeX book}.
+
+ The present implementation has a long ancestry, beginning in the summer of~1977, when Michael~F.
+ Plass and Frank~M. Liang designed and coded a prototype based on some specifications that the
+ author had made in May of that year. This original proto\TEX\ included macro definitions and
+ elementary manipulations on boxes and glue, but it did not have line-breaking, page-breaking,
+ mathematical formulas, alignment routines, error recovery, or the present semantic nest;
+ furthermore, it used character lists instead of token lists, so that a control sequence like |
+ \halign| was represented by a list of seven characters. A complete version of \TEX\ was designed
+ and coded by the author in late 1977 and early 1978; that program, like its prototype, was
+ written in the SAIL language, for which an excellent debugging system was available. Preliminary
+ plans to convert the SAIL code into a form somewhat like the present \quotation {web} were
+ developed by Luis Trabb~Pardo and the author at the beginning of 1979, and a complete
+ implementation was created by Ignacio~A. Zabala in 1979 and 1980. The \TEX82 program, which was
+ written by the author during the latter part of 1981 and the early part of 1982, also
+ incorporates ideas from the 1979 implementation of \TeX\ in {MESA} that was written by Leonidas
+ Guibas, Robert Sedgewick, and Douglas Wyatt at the Xerox Palo Alto Research Center. Several
+ hundred refinements were introduced into \TEX82 based on the experiences gained with the original
+ implementations, so that essentially every part of the system has been substantially improved.
+ After the appearance of Version 0 in September 1982, this program benefited greatly from the
+ comments of many other people, notably David~R. Fuchs and Howard~W. Trickey. A final revision in
+ September 1989 extended the input character set to eight-bit codes and introduced the ability to
+ hyphenate words from different languages, based on some ideas of Michael~J. Ferguson.
+
+ No doubt there still is plenty of room for improvement, but the author is firmly committed to
+ keeping \TEX82 frozen from now on; stability and reliability are to be its main virtues. On the
+ other hand, the \WEB\ description can be extended without changing the core of \TEX82 itself,
+ and the program has been designed so that such extensions are not extremely difficult to make.
+ The |banner| string defined here should be changed whenever \TEX\ undergoes any modifications,
+ so that it will be clear which version of \TEX\ might be the guilty party when a problem arises.
+
+ This program contains code for various features extending \TEX, therefore this program is called
+ \LUATEX\ and not \TEX; the official name \TEX\ by itself is reserved for software systems that
+ are fully compatible with each other. A special test suite called the \quote {TRIP test} is
+ available for helping to determine whether a particular implementation deserves to be known
+ as \TEX\ [cf.~Stanford Computer Science report CS1027, November 1984].
+
+ A similar test suite called the \quote {e-TRIP test} is available for helping to determine
+ whether a particular implementation deserves to be known as \ETEX.
+
+ {\em NB: Although \LUATEX\ can pass lots of the test it's not trip compatible: we use \UTF,
+ support different font models, have adapted the backend to todays demands, etc.}
+
+ This is the first of many sections of \TEX\ where global variables are defined.
+
+ The \LUAMETATEX\ source is an adaptation of the \LUATEX\ source and it took quite a bit of
+ work to get there. I tried to stay close to the original Knuthian names and code but there are
+ all kind of subtle differences with the \LUATEX\ code, which came from the \PASCAL\ code. And
+ yes, all errors are mine (Hans).
+
+*/
+
+/*tex
+
+ This program (we're talking of original \TEX\ here) has two important variations:
+
+ \startitemize[n]
+ \startitem
+ There is a long and slow version called \INITEX, which does the extra calculations
+ needed to initialize \TEX's internal tables; and
+ \stopitem
+ \startitem
+ there is a shorter and faster production version, which cuts the initialization to
+ a bare minimum.
+ \stopitem
+ \stopitemize
+
+ Remark: Due to faster processors and media, the difference is not as large as it used to be,
+ so \quote {long} and \quote {slow] no longer really apply. Making a \PDFTEX\ format takes 6
+ seconds because patterns are loaded in \UTF-8 format which demands interpretation, while
+ \XETEX\ which has native \UTF-8\ support takes just over 3 seconds. Making \CONTEXT\ \LMTX\
+ format with \LUAMETATEX taked 2.54 seconds, and it involves loading hundreds of files with
+ megabytes of code (much more than in \MKII). So it's not that bad. Loading a format file for
+ a production run takes less than half a second (which includes quite some \LUA\ initialization).
+ On a more modern machine these times are less of course.
+
+*/
+
+main_state_info lmt_main_state = {
+ .run_state = production_state,
+ .ready_already = output_disabled_state,
+ .start_time = 0.0,
+};
+
+/*tex
+
+ This state registers if are we are |INITEX| with |ini_version|, keeps the \TEX\ width of
+ context lines on terminal error messages in |error_line| and the width of first lines of
+ contexts in terminal error messages in |half_error_line| which should be between 30 and
+ |error_line - 15|. The width of longest text lines output, which should be at least 60,
+ is strored in |max_print_line| and the maximum number of strings, which must not exceed
+ |max_halfword| is kept in |max_strings|.
+
+ The number of strings available after format loaded is |strings_free|, the maximum number of
+ characters simultaneously present in current lines of open files and in control sequences
+ between |\csname| and |\endcsname|, which must not exceed |max_halfword|, is kept in
+ |buf_size|. The maximum number of simultaneous input sources is in |stack_size| and the
+ maximum number of input files and error insertions that can be going on simultaneously in
+ |max_in_open|. The maximum number of simultaneous macro parameters is in |param_size| and
+ the maximum number of semantic levels simultaneously active in |nest_size|. The space for
+ saving values outside of current group, which must be at most |max_halfword|, is in
+ |save_size| and the depth of recursive calls of the |expand| procedure is limited by
+ |expand_depth|.
+
+ The times recent outputs that didn't ship anything out is tracked with |dead_cycles|. All
+ these (formally single global) variables are collected in one state structure. (The error
+ reporting is to some extent an implementation detail. As errors can be intercepted by \LUA\
+ we keep things simple.)
+
+ We have noted that there are two versions of \TEX82. One, called \INITEX, has to be run
+ first; it initializes everything from scratch, without reading a format file, and it has the
+ capability of dumping a format file. The other one is called \VIRTEX; it is a \quote {virgin}
+ program that needs to input a format file in order to get started. (This model has been
+ adapted for a long time by the \TEX\ distributions, that ship multiple platforms and provide a
+ large infrastructure.)
+
+ For \LUATEX\ it is important to know that we still dump a format. But, in order to gain speed
+ and a smaller footprint, we gzip the format (level 3). We also store some information that
+ makes an abort possible in case of an incompatible engine version, which is important as
+ \LUATEX\ develops. It is possible to store \LUA\ code in the format but not the current
+ upvalues so you still need to initialize. Also, traditional fonts are stored, as are extended
+ fonts but any additional information needed for instance to deal with \OPENTYPE\ fonts is to
+ be handled by \LUA\ code and therefore not present in the format. (Actually, this version no
+ longer stores fonts at all.)
+
+*/
+
+static void final_cleanup(int code);
+
+void tex_main_body(void)
+{
+
+ tex_engine_set_limits_data("errorlinesize", &lmt_error_state.line_limits);
+ tex_engine_set_limits_data("halferrorlinesize", &lmt_error_state.half_line_limits);
+ tex_engine_set_limits_data("expandsize", &lmt_expand_state.limits);
+
+ tex_engine_set_memory_data("buffersize", &lmt_fileio_state.io_buffer_data);
+ tex_engine_set_memory_data("filesize", &lmt_input_state.in_stack_data);
+ tex_engine_set_memory_data("fontsize", &lmt_font_state.font_data);
+ tex_engine_set_memory_data("hashsize", &lmt_hash_state.hash_data);
+ tex_engine_set_memory_data("inputsize", &lmt_input_state.input_stack_data);
+ tex_engine_set_memory_data("languagesize", &lmt_language_state.language_data);
+ tex_engine_set_memory_data("marksize", &lmt_mark_state.mark_data);
+ tex_engine_set_memory_data("insertsize", &lmt_insert_state.insert_data);
+ tex_engine_set_memory_data("nestsize", &lmt_nest_state.nest_data);
+ tex_engine_set_memory_data("nodesize", &lmt_node_memory_state.nodes_data);
+ tex_engine_set_memory_data("parametersize", &lmt_input_state.parameter_stack_data);
+ tex_engine_set_memory_data("poolsize", &lmt_string_pool_state.string_body_data);
+ tex_engine_set_memory_data("savesize", &lmt_save_state.save_stack_data);
+ tex_engine_set_memory_data("stringsize", &lmt_string_pool_state.string_pool_data);
+ tex_engine_set_memory_data("tokensize", &lmt_token_memory_state.tokens_data);
+
+ tex_initialize_fileio_state();
+ tex_initialize_nest_state();
+ tex_initialize_save_stack();
+ tex_initialize_input_state();
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_string_mem();
+ }
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_string_pool();
+ }
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_token_mem();
+ tex_initialize_hash_mem();
+ }
+
+ tex_initialize_errors();
+ tex_initialize_nesting();
+ tex_initialize_pagestate();
+ tex_initialize_levels();
+ tex_initialize_primitives();
+ tex_initialize_marks();
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_inserts();
+ }
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_node_mem();
+ }
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_nodes();
+ tex_initialize_tokens();
+ tex_initialize_expansion();
+ tex_initialize_alignments();
+ tex_initialize_buildpage();
+ tex_initialize_active();
+ tex_initialize_equivalents();
+ tex_initialize_math_codes();
+ tex_initialize_text_codes();
+ tex_initialize_cat_codes(0);
+ tex_initialize_xx_codes();
+ }
+
+ tex_initialize_dump_state();
+ tex_initialize_variables();
+ tex_initialize_commands();
+ tex_initialize_fonts();
+
+ if (lmt_main_state.run_state == initializing_state) {
+ tex_initialize_languages();
+ }
+
+ lmt_main_state.ready_already = output_enabled_state;
+
+ /*tex in case we quit during initialization */
+
+ lmt_error_state.history = fatal_error_stop;
+
+ /*tex
+ Get the first line of input and prepare to start When we begin the following code, \TEX's
+ tables may still contain garbage; the strings might not even be present. Thus we must
+ proceed cautiously to get bootstrapped in.
+
+ But when we finish this part of the program, \TEX\ is ready to call on the |main_control|
+ routine to do its work.
+
+ This copies the command line:
+ */
+
+ tex_initialize_inputstack();
+
+ if (lmt_main_state.run_state == initializing_state) {
+ /* We start out fresh. */
+ } else if (tex_load_fmt_file()) {
+
+ tex_initialize_expansion();
+ tex_initialize_alignments();
+
+ aux_get_date_and_time(&time_par, &day_par, &month_par, &year_par, &lmt_engine_state.utc_time);
+
+ while ((lmt_input_state.cur_input.loc < lmt_input_state.cur_input.limit) && (lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc] == ' ')) {
+ ++lmt_input_state.cur_input.loc;
+ }
+ } else {
+ tex_normal_exit();
+ }
+
+ if (end_line_char_inactive) {
+ --lmt_input_state.cur_input.limit;
+ } else {
+ lmt_fileio_state.io_buffer[lmt_input_state.cur_input.limit] = (unsigned char) end_line_char_par;
+ }
+
+ aux_get_date_and_time(&time_par, &day_par, &month_par, &year_par, &lmt_engine_state.utc_time);
+
+ tex_initialize_math();
+
+ tex_fixup_selector(lmt_fileio_state.log_opened); /* hm, the log is not yet opened anyway */
+
+ tex_engine_check_configuration();
+
+ tex_initialize_directions();
+
+ {
+ char *ptr = tex_engine_input_filename();
+ char *fln = NULL;
+ tex_check_job_name(ptr);
+ tex_open_log_file();
+ tex_engine_get_config_string("firstline", &fln);
+ if (fln) {
+ tex_any_string_start(fln); /* experiment, see context lmtx */
+ }
+ if (ptr) {
+ tex_start_input(ptr);
+ } else if (! fln) {
+ tex_emergency_message("startup error", "no input found, quitting");
+ tex_emergency_exit();
+ }
+ }
+
+ /*tex Ready to go, so come to life. */
+
+ lmt_error_state.history = spotless;
+
+ {
+ int dump = tex_main_control();
+ if (dump && lmt_main_state.run_state != initializing_state) {
+ /*tex Maybe we need to issue a warning here. For now we just ignore it. */
+ dump = 0;
+ }
+ final_cleanup(dump);
+ }
+
+ tex_close_files_and_terminate(0);
+
+ tex_normal_exit();
+}
+
+/*tex
+
+ Here we do whatever is needed to complete \TEX's job gracefully on the local operating system.
+ The code here might come into play after a fatal error; it must therefore consist entirely of
+ \quote {safe} operations that cannot produce error messages. For example, it would be a mistake
+ to call |str_room| or |make_string| at this time, because a call on |overflow| might lead to an
+ infinite loop.
+
+ Actually there's one way to get error messages, via |prepare_mag|; but that can't cause infinite
+ recursion.
+
+ This program doesn't bother to close the input files that may still be open.
+
+ We can decide to remove the reporting code here as it can (and in \CONTEXT\ will) be done in a
+ callback anyway, so we never enter that branch.
+
+ The output statistics go directly to the log file instead of using |print| commands, because
+ there's no need for these strings to take up |string_pool| memory.
+
+ We now assume a callback being set, if wanted at all, but we keep this as a reference so that
+ we know what is of interest:
+
+ \starttyping
+ void close_files_and_terminate(int error)
+ {
+ int callback_id = lmt_callback_defined(stop_run_callback);
+ if (fileio_state.log_opened) {
+ if (callback_id == 0) {
+ fprintf(print_state.log_file,
+ "\n\nHere is how much memory " My_Name " used:\n"
+ );
+ fprintf(print_state.log_file,
+ " %d strings out of %d\n",
+ string_pool_state.string_pool_data.ptr - string_pool_state.reserved,
+ string_pool_state.string_pool_data.allocated - string_pool_state.reserved + STRING_OFFSET
+ );
+ fprintf(print_state.log_file,
+ " %d multiletter control sequences out of %d + %d extra\n",
+ hash_state.hash_data.real,
+ hash_size,
+ hash_state.hash_data.allocated
+ );
+ fprintf(print_state.log_file,
+ " %d words of node memory allocated out of %d",
+ node_memory_state.nodes_data.allocated,
+ node_memory_state.nodes_data.size
+ );
+ fprintf(print_state.log_file,
+ " %d words of token memory allocated out of %d",
+ token_memory_state.tokens_data.allocated,
+ token_memory_state.tokens_data.size
+ );
+ fprintf(print_state.log_file,
+ " %d font%s using %d bytes\n",
+ get_font_max_id(),
+ (get_font_max_id() == 1 ? "" : "s"),
+ font_state.font_bytes
+ );
+ fprintf(print_state.log_file,
+ " %d input stack positions out of %d\n",
+ input_state.input_stack_data.top,
+ input_state.input_stack_data.size
+ );
+ fprintf(print_state.log_file,
+ " %d nest stack positions out of %d\n",
+ nest_state.nest_data.top,
+ nest_state.nest_data.size
+ );
+ fprintf(print_state.log_file,
+ " %d parameter stack positions out of %d\n",
+ input_state.param_stack_data.top,
+ input_state.param_stack_data.size
+ );
+ fprintf(print_state.log_file,
+ " %d buffer stack positions out of %d\n",
+ fileio_state.io_buffer_data.top,
+ fileio_state.io_buffer_data.size
+ );
+ fprintf(print_state.log_file,
+ " %d save stack positions out of %d\n",
+ save_state.save_stack_data.top,
+ save_state.save_stack_data.size
+ );
+ }
+ print_state.selector = print_state.selector - 2;
+ if ((print_state.selector == term_only_selector_code) && (callback_id == 0)) {
+ print_str_nl("Transcript written on ");
+ print_file_name((unsigned char *) fileio_state.log_name);
+ print_char('.');
+ print_ln();
+ }
+ close_log_file();
+ }
+ callback_id = lmt_callback_defined(wrapup_run_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lua_state.lua_instance, callback_id, "b->", error);
+ }
+ free_text_codes();
+ free_math_codes();
+ free_languages();
+ }
+ \stoptyping
+*/
+
+void tex_close_files_and_terminate(int error)
+{
+ int callback_id = lmt_callback_defined(wrapup_run_callback);
+ if (lmt_fileio_state.log_opened) {
+ tex_close_log_file();
+ }
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "b->", error);
+ }
+}
+
+/*tex
+
+ We get to the |final_cleanup| routine when |\end| or |\dump| has been scanned and it's all
+ over now.
+
+*/
+
+static void final_cleanup(int dump)
+{
+ int badrun = 0;
+ if (! lmt_fileio_state.job_name) {
+ tex_open_log_file ();
+ }
+ tex_cleanup_directions();
+ while (lmt_input_state.input_stack_data.ptr > 0)
+ if (lmt_input_state.cur_input.state == token_list_state) {
+ tex_end_token_list();
+ } else {
+ tex_end_file_reading();
+ }
+ while (lmt_input_state.open_files > 0) {
+ tex_report_stop_file();
+ --lmt_input_state.open_files;
+ }
+ if (cur_level > level_one) {
+ tex_print_format("(\\end occurred inside a group at level %i)", cur_level - level_one);
+ tex_show_save_groups();
+ badrun = 1;
+ }
+ while (lmt_condition_state.cond_ptr) {
+ halfword t;
+ if (lmt_condition_state.if_line != 0) {
+ tex_print_format("(\\end occurred when %C on line %i was incomplete)", if_test_cmd, lmt_condition_state.cur_if, lmt_condition_state.if_line);
+ badrun = 2;
+ } else {
+ tex_print_format("(\\end occurred when %C was incomplete)");
+ badrun = 3;
+ }
+ lmt_condition_state.if_line = if_limit_line(lmt_condition_state.cond_ptr);
+ lmt_condition_state.cur_if = node_subtype(lmt_condition_state.cond_ptr);
+ t = lmt_condition_state.cond_ptr;
+ lmt_condition_state.cond_ptr = node_next(lmt_condition_state.cond_ptr);
+ tex_flush_node(t);
+ }
+ if (lmt_print_state.selector == terminal_and_logfile_selector_code && lmt_callback_defined(stop_run_callback) == 0) {
+ if ((lmt_error_state.history == warning_issued) || (lmt_error_state.history != spotless && lmt_error_state.interaction < error_stop_mode)) {
+ lmt_print_state.selector = terminal_selector_code;
+ tex_print_message("see the transcript file for additional information");
+ lmt_print_state.selector = terminal_and_logfile_selector_code;
+ }
+ }
+ if (dump) {
+ tex_cleanup_alignments();
+ tex_cleanup_expansion();
+ if (lmt_main_state.run_state == initializing_state) {
+ for (int i = 0; i <= lmt_mark_state.mark_data.ptr; i++) {
+ tex_wipe_mark(i);
+ }
+ tex_flush_node_list(lmt_packaging_state.page_discards_head);
+ tex_flush_node_list(lmt_packaging_state.split_discards_head);
+ if (lmt_page_builder_state.last_glue != max_halfword) {
+ tex_flush_node(lmt_page_builder_state.last_glue);
+ }
+ for (int i = 0; i <= lmt_insert_state.insert_data.ptr; i++) {
+ tex_wipe_insert(i);
+ }
+ tex_store_fmt_file();
+ } else {
+ tex_print_message("\\dump is performed only by INITEX");
+ badrun = 4;
+ }
+ }
+ if (lmt_callback_defined(stop_run_callback)) {
+ /*
+ We don't issue the error callback here (yet), mainly because we don't really know what
+ bad things happened. This might evolve as currently it is not seen as fatal error.
+ */
+ lmt_run_callback(lmt_lua_state.lua_instance, stop_run_callback, "d->", badrun);
+ }
+}
+
diff --git a/source/luametatex/source/tex/texmainbody.h b/source/luametatex/source/tex/texmainbody.h
new file mode 100644
index 000000000..d0d329e8a
--- /dev/null
+++ b/source/luametatex/source/tex/texmainbody.h
@@ -0,0 +1,43 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_MAINBODY_H
+# define LMT_MAINBODY_H
+
+/* Global variables */
+
+typedef enum run_states {
+ initializing_state,
+ updating_state,
+ production_state,
+} run_states;
+
+typedef enum ready_states {
+ output_disabled_state,
+ output_enabled_state,
+} ready_states;
+
+typedef struct main_state_info {
+ int run_state; /*tex Are we |INITEX|? */
+ int ready_already; /*tex A typical \TEX\ variable name. */
+ double start_time;
+} main_state_info ;
+
+extern main_state_info lmt_main_state ;
+
+/*tex
+
+ The following procedure, which is called just before \TEX\ initializes its input and output,
+ establishes the initial values of the date and time. It calls a macro-defined |dateandtime|
+ routine. |dateandtime| in turn is also a |CCODE\ macro, which calls |get_date_and_time|,
+ passing it the addresses of the day, month, etc., so they can be set by the routine.
+ |get_date_and_time| also sets up interrupt catching if that is conditionally compiled in the
+ \CCODE\ code.
+
+*/
+
+extern void tex_main_body (void);
+extern void tex_close_files_and_terminate (int error);
+
+# endif
diff --git a/source/luametatex/source/tex/texmaincontrol.c b/source/luametatex/source/tex/texmaincontrol.c
new file mode 100644
index 000000000..a1983ac4f
--- /dev/null
+++ b/source/luametatex/source/tex/texmaincontrol.c
@@ -0,0 +1,6412 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ 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.
+
+ 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.p
+
+ 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 \quote {action procedure} that does the work for that
+ case, and then they either |goto reswitch| or they \quote {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.
+
+ 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 \quote
+ {inner loop}; the whole program runs efficiently when its inner loop is fast, so this part
+ has been written with particular care. (This is no longer true in \LUATEX.)
+
+ 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.
+
+ All action is done via runners in the function table. Some runners are implemented here,
+ others are spread over modules. In due time I will use more prefixes to indicate where they
+ belong. Also, more runners will move to their respective modules, a stepwise process. This
+ split up is not always consistent which relates to the fact that \TEX\ is a monolothic program
+ which in turn means that we keep all the smaller (and more dependen) bits here. There are
+ subsystems but they hook into each other, take inserts and adjusts that hook into the builders
+ and packagers.
+
+*/
+
+main_control_state_info lmt_main_control_state = {
+ .control_state = goto_next_state,
+ .local_level = 0,
+ .after_token = null,
+ .after_tokens = null,
+ .last_par_context = 0,
+ .loop_iterator = 0,
+ .loop_nesting = 0,
+ .quit_loop = 0,
+};
+
+/*tex
+ A few helpers:
+*/
+
+inline scaled tex_aux_checked_dimen1(scaled v)
+{
+ if (v > max_dimen) {
+ return max_dimen;
+ } else if (v < -max_dimen) {
+ return -max_dimen;
+ } else {
+ return v;
+ }
+}
+
+inline scaled tex_aux_checked_dimen2(scaled v)
+{
+ if (v > max_dimen) {
+ return max_dimen;
+ } else if (v < 0) {
+ return 0;
+ } else {
+ return v;
+ }
+}
+
+/*tex
+ These two helpers, of which the second one is still experimental, actually belong in another
+ file so then might be moved. Watch how the first one has the |unsave| call!
+ */
+
+static void tex_aux_fixup_directions_and_unsave(void)
+{
+ int saved_par_state = internal_par_state_par;
+ int saved_dir_state = internal_dir_state_par;
+ int saved_direction = text_direction_par;
+ tex_pop_text_dir_ptr();
+ tex_unsave();
+ if (cur_mode == hmode) {
+ if (saved_dir_state) {
+ /* Add local dir node. */
+ tex_tail_append(tex_new_dir(cancel_dir_subtype, text_direction_par));
+ dir_direction(cur_list.tail) = saved_direction;
+ }
+ if (saved_par_state) {
+ /*tex Add local paragraph node. This resets after a group. */
+ tex_tail_append(tex_new_par_node(hmode_par_par_subtype));
+ }
+ }
+}
+
+static void tex_aux_fixup_directions_only(void)
+{
+ int saved_dir_state = internal_dir_state_par;
+ int saved_direction = text_direction_par;
+ tex_pop_text_dir_ptr();
+ if (saved_dir_state) {
+ /* Add local dir node. */
+ tex_tail_append(tex_new_dir(cancel_dir_subtype, saved_direction));
+ }
+}
+
+static void tex_aux_fixup_math_and_unsave(void)
+{
+ int saved_math_style = internal_math_style_par;
+ int saved_math_scale = internal_math_scale_par;
+ tex_unsave();
+ if (cur_mode == mmode) {
+ if (saved_math_style >= 0 && saved_math_style != cur_list.math_style) {
+ halfword noad = tex_new_node(style_node, (quarterword) saved_math_style);
+ cur_list.math_style = saved_math_style;
+ tex_tail_append(noad);
+ }
+ if (saved_math_scale != cur_list.math_scale) {
+ halfword noad = tex_new_node(style_node, scaled_math_style);
+ style_scale(noad) = saved_math_scale;
+ tex_tail_append(noad);
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_out_of_range_error(halfword val, halfword max)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Invalid code (%i), should be in the range %i..%i",
+ val, 0, max,
+ "I'm going to use 0 instead of that illegal code value."
+ );
+}
+
+/*tex
+
+ The |run_| functions hook in the main control handler. Some immediately do something, others
+ trigger a follow up scan, driven by the cmd code. Here come some forward declarations; there
+ are more that the following |run_| functions. Some runners are defined in other modules. Some
+ runners finish what another started, for instance when we see a left brace, depending on state
+ another runner can kick in.
+
+ */
+
+static void tex_aux_adjust_space_factor(halfword chr)
+{
+ halfword s = tex_get_sf_code(chr);
+ if (s == 1000) {
+ cur_list.space_factor = 1000;
+ } else if (s < 1000) {
+ if (s > 0) {
+ cur_list.space_factor = s;
+ } else {
+ /* s <= 0 */
+ }
+ } else if (cur_list.space_factor < 1000) {
+ cur_list.space_factor = 1000;
+ } else {
+ cur_list.space_factor = s;
+ }
+}
+
+static void tex_aux_run_text_char_number(void)
+{
+ switch (cur_chr) {
+ case char_number_code:
+ {
+ halfword chr = tex_scan_char_number(0);
+ tex_aux_adjust_space_factor(chr);
+ tex_tail_append(tex_new_char_node(glyph_unset_subtype, cur_font_par, chr, 1));
+ break;
+ }
+ case glyph_number_code:
+ {
+ scaled xoffset = glyph_x_offset_par;
+ scaled yoffset = glyph_y_offset_par;
+ halfword xscale = glyph_x_scale_par;
+ halfword yscale = glyph_y_scale_par;
+ halfword scale = glyph_scale_par;
+ halfword options = glyph_options_par;
+ halfword font = cur_font_par;
+ scaled left = 0;
+ scaled right = 0;
+ scaled raise = 0;
+ halfword chr = 0;
+ halfword glyph;
+ while (1) {
+ switch (tex_scan_character("xyofislrXYOFISLR", 0, 1, 0)) {
+ case 0:
+ goto DONE;
+ case 'x': case 'X':
+ switch (tex_scan_character("osOS", 0, 0, 0)) {
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("xoffset", 2)) {
+ xoffset = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("xscale", 2)) {
+ xscale = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("xoffset|xscale");
+ goto DONE;
+ }
+ break;
+ case 'y': case 'Y':
+ switch (tex_scan_character("osOS", 0, 0, 0)) {
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("yoffset", 2)) {
+ yoffset = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("yscale", 2)) {
+ yscale = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("yoffset|yscale");
+ goto DONE;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("options", 1)) {
+ options = tex_scan_int(0, NULL);
+ if (options < glyph_option_normal_glyph) {
+ options = glyph_option_normal_glyph;
+ } else if (options > glyph_option_all) {
+ options = glyph_option_all;
+ }
+ }
+ break;
+ case 'f': case 'F':
+ if (tex_scan_mandate_keyword("font", 1)) {
+ font = tex_scan_font_identifier(NULL);
+ }
+ break;
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("id", 1)) {
+ halfword f = tex_scan_int(0, NULL);
+ if (f > 0 && tex_is_valid_font(f)) {
+ font = f;
+ }
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("scale", 1)) {
+ yscale = tex_scan_int(0, NULL);
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("left", 1)) {
+ left = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'r': case 'R':
+ switch (tex_scan_character("aiAI", 0, 0, 0)) {
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("right", 2)) {
+ right = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("raise", 2)) {
+ raise = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("right|raise");
+ goto DONE;
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ chr = tex_scan_char_number(0);
+ tex_aux_adjust_space_factor(chr);
+ glyph = tex_new_char_node(glyph_unset_subtype, font, chr, 1);
+ set_glyph_x_offset(glyph, xoffset);
+ set_glyph_y_offset(glyph, yoffset);
+ set_glyph_scale(glyph, scale);
+ set_glyph_x_scale(glyph, xscale);
+ set_glyph_y_scale(glyph, yscale);
+ set_glyph_left(glyph, left);
+ set_glyph_right(glyph, right);
+ set_glyph_raise(glyph, raise);
+ set_glyph_options(glyph, options);
+ tex_tail_append(glyph);
+ break;
+ }
+ }
+}
+
+static void tex_aux_run_text_letter(void) {
+ tex_aux_adjust_space_factor(cur_chr);
+ tex_tail_append(tex_new_char_node(glyph_unset_subtype, cur_font_par, cur_chr, 1));
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_run_node(void) {
+ halfword n = cur_chr;
+ if (node_token_flagged(n)) {
+ tex_get_token();
+ n = node_token_sum(n,cur_chr);
+ }
+ if (copy_lua_input_nodes_par) {
+ n = tex_copy_node_list(n, null);
+ }
+ tex_tail_append(n);
+ if (tex_nodetype_has_attributes(node_type(n)) && ! node_attr(n)) {
+ attach_current_attribute_list(n);
+ }
+ while (node_next(n)) {
+ n = node_next(n);
+ tex_tail_append(n);
+ if (tex_nodetype_has_attributes(node_type(n)) && ! node_attr(n)) {
+ attach_current_attribute_list(n);
+ }
+ }
+}
+
+/* */
+
+inline static void lmt_bytecode_run(int index)
+{
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ lmt_bytecode_call(index);
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+}
+
+inline static void lmt_lua_run(int reference, int prefix)
+{
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ lmt_function_call(reference, prefix);
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+}
+
+static void tex_aux_run_lua_protected_call(void) {
+ if (cur_chr > 0) {
+ lmt_lua_run(cur_chr, 0);
+ } else {
+ tex_normal_error("luacall", "invalid number");
+ }
+}
+
+static void tex_aux_set_lua_value(int a) {
+ if (cur_chr > 0) {
+ lmt_lua_run(cur_chr, a);
+ } else {
+ tex_normal_error("luavalue", "invalid number");
+ }
+}
+
+/*tex
+
+ 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.
+
+ There is a special treatment for spaces when |space_factor <> 1000|.
+
+ */
+
+static void tex_aux_run_math_space(void) {
+ if (! disable_spaces_par) {
+ if (node_type(cur_list.tail) == simple_noad) {
+ noad_options(cur_list.tail) |= noad_option_followed_by_space;
+ }
+ }
+}
+
+static void tex_aux_run_space(void) {
+ switch (disable_spaces_par) {
+ case 1:
+ /*tex Don't inject anything, not even zero skip. */
+ return;
+ case 2:
+ /*tex Inject nothing but zero glue. */
+ tex_tail_append(tex_new_glue_node(zero_glue, zero_space_skip_glue)); /* todo: subtype, zero_space_glue? */
+ break;
+ default:
+ /*tex
+ The tradional treatment. A difference with other \TEX's is that we store the spacing
+ in the node instead of using the (end of) paragraph bound value.
+ */
+ {
+ halfword p;
+ if (cur_mode == hmode && cur_cmd == spacer_cmd && cur_list.space_factor != 1000) {
+ if ((cur_list.space_factor >= 2000) && (! tex_glue_is_zero(xspace_skip_par))) {
+ p = tex_get_scaled_parameter_glue(xspace_skip_code, xspace_skip_glue);
+ } else {
+ halfword cur_font = cur_font_par;
+ if (tex_glue_is_zero(space_skip_par)) {
+ p = tex_get_scaled_glue(cur_font);
+ } else {
+ p = tex_get_parameter_glue(space_skip_code, space_skip_glue); /* not scaled */
+ }
+ /* Modify the glue specification in |q| according to the space factor */
+ if (cur_list.space_factor >= 2000) {
+ glue_amount(p) += tex_get_scaled_extra_space(cur_font);
+ }
+ glue_stretch(p) = tex_xn_over_d(glue_stretch(p), cur_list.space_factor, 1000);
+ glue_shrink(p) = tex_xn_over_d(glue_shrink(p), 1000, cur_list.space_factor);
+ }
+ } else if (tex_glue_is_zero(space_skip_par)) {
+ /*tex Find the glue specification for text spaces in the current font. */
+ p = tex_get_scaled_glue(cur_font_par);
+ } else {
+ /*tex Append a normal inter-word space to the current list. */
+ p = tex_get_parameter_glue(space_skip_code, space_skip_glue); /* not scaled */
+ }
+ tex_tail_append(p);
+ }
+ }
+}
+
+/*tex A fast one, also used to silently ignore |\par|s in a math formula. */
+
+static void tex_aux_run_relax(void) {
+ return;
+}
+
+/*tex
+
+ |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.
+
+*/
+
+static void tex_aux_run_ignore_something(void) {
+ switch (cur_chr) {
+ case ignore_space_code:
+ /*tex Get the next non-blank call. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ lmt_main_control_state.control_state = goto_skip_token_state;
+ break;
+ case ignore_par_code:
+ /*tex Get the next non-blank/par call. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == end_paragraph_cmd);
+ lmt_main_control_state.control_state = goto_skip_token_state;
+ break;
+ case ignore_argument_code:
+ /*tex There is nothing to show here. */
+ break;
+ default:
+ break;
+ }
+}
+
+/* */
+
+static void tex_aux_run_math_non_math(void) {
+ if (tracing_commands_par >= 4) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: pushing back %C]", cur_cmd, cur_chr);
+ tex_end_diagnostic();
+ }
+ tex_back_input(cur_tok);
+ tex_begin_paragraph(1, math_char_par_begin);
+}
+
+/*tex
+
+ 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 \quote {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|.
+
+ First we define a procedure that returns a pointer to a rule node. This routine is called just
+ after \TEX\ has seen |\hrule| or |\vrule|; therefore |cur_cmd| will be either |hrule| or
+ |vrule|. The idea is to store the default rule dimensions in the node, then to override them if
+ |height| or |width| or |depth| specifications are found (in any order).
+
+ For a moment I considered this:
+
+ \starttyping
+ if (scan_keyword("to")) {
+ scan_dimen(0, 0, 0, 0); rule_width(q) = cur_val;
+ scan_dimen(0, 0, 0, 0); rule_height(q) = cur_val;
+ scan_dimen(0, 0, 0, 0); rule_depth(q) = cur_val;
+ return q;
+ }
+ \stoptyping
+
+*/
+
+
+/*tex
+
+ 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 {<hlist>}| 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.
+
+*/
+
+static void tex_aux_run_left_brace(void) {
+ tex_new_save_level(simple_group);
+ update_tex_internal_par_state(0);
+ update_tex_internal_dir_state(0);
+}
+
+/*tex
+
+ The |also_simple_group| variant is triggered by |\beginsimplegroup|. It permits a mixed group
+ ending model:
+
+ \starttyping
+ \def\foo{\beginsimplegroup\bf\let\next} \foo{text}
+ \stoptyping
+
+ So, such a group can end with |\endgroup| as well as |\egroup| or equivalents. This trick is
+ mostly meant for math where a complex group produces a list which in turn influences spacing.
+
+*/
+
+static void tex_aux_run_begin_group(void) {
+ switch (cur_chr) {
+ case semi_simple_group_code:
+ case also_simple_group_code:
+ tex_new_save_level(cur_chr ? also_simple_group : semi_simple_group);
+ update_tex_internal_par_state(0);
+ update_tex_internal_dir_state(0);
+ break;
+ case math_simple_group_code:
+ tex_new_save_level(math_simple_group);
+ update_tex_internal_math_style(cur_mode == mmode ? cur_list.math_style : -1);
+ update_tex_internal_math_scale(cur_mode == mmode ? cur_list.math_scale : 0);
+ break;
+ }
+}
+
+static void tex_aux_run_end_group(void) {
+// /* cur_chr can be 1 for a endsimplegroup but it's equivalent */
+// if (cur_group == semi_simple_group || cur_group == also_simple_group) {
+// tex_aux_fixup_directions_and_unsave(); /*tex Includes the |save()| call! */
+// } else {
+// tex_off_save(); /*tex Recover with error. */
+// }
+ switch (cur_group) {
+ case semi_simple_group:
+ case also_simple_group:
+ tex_aux_fixup_directions_and_unsave(); /*tex Includes the |save()| call! */
+ break;
+ case math_simple_group:
+ tex_aux_fixup_math_and_unsave(); /*tex Includes the |save()| call! */
+ break;
+ default:
+ tex_off_save(); /*tex Recover with error. */
+ break;
+ }
+}
+
+/*tex
+
+ 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|.
+
+ Maybe we should just have three variants as sharing this makes it messy: |cur_cmd| combined
+ with |cur_chr| and funny flags for leaders. Due to grouping we have a shared |box_end| so
+ it doesn't become much prettier anyway.
+
+ */
+
+static void tex_aux_scan_box(int boxcontext, int optional_equal, scaled shift)
+{
+ /*tex Get the next non-blank non-relax... and optionally skip an equal sign */
+ while (1) {
+ tex_get_x_token();
+ if (cur_cmd == spacer_cmd) {
+ /*tex Go on. */
+ } else if (cur_cmd == relax_cmd) {
+ optional_equal = 0;
+ } else if (optional_equal && cur_tok == equal_token) {
+ optional_equal = 0;
+ } else {
+ break;
+ }
+ }
+ switch (cur_cmd) {
+ case make_box_cmd:
+ {
+ tex_begin_box(boxcontext, shift);
+ return;
+ }
+ case vcenter_cmd:
+ {
+ tex_run_vcenter();
+ return;
+ }
+ case lua_call_cmd:
+ case lua_protected_call_cmd:
+ {
+ if (box_leaders_flag(boxcontext)) {
+ tex_aux_run_lua_protected_call();
+ tex_get_next();
+ if (cur_cmd == node_cmd) {
+ /*tex So we only fetch the tail; the rest can mess up in the current list! */
+ halfword boxnode = null;
+ tex_aux_run_node();
+ boxnode = tex_pop_tail();
+ if (boxnode) {
+ switch (node_type(boxnode)) {
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ case glyph_node:
+ tex_box_end(boxcontext, boxnode, shift, unset_noad_class);
+ return;
+ }
+ }
+ }
+ tex_formatted_error("lua", "invalid function call, proper leader content expected");
+ return;
+ }
+ break;
+ }
+ case lua_value_cmd:
+ {
+ halfword v = tex_scan_lua_value(cur_chr);
+ switch (v) {
+ case no_val_level:
+ tex_box_end(boxcontext, null, shift, unset_noad_class);
+ return;
+ case list_val_level:
+ if (box_leaders_flag(boxcontext)) {
+ switch (node_type(cur_val)) {
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ // case glyph_node:
+ tex_box_end(boxcontext, cur_val, shift, unset_noad_class);
+ return;
+ }
+ } else {
+ switch (node_type(cur_val)) {
+ case hlist_node:
+ case vlist_node:
+ tex_box_end(boxcontext, cur_val, shift, unset_noad_class);
+ return;
+ }
+ }
+ }
+ tex_formatted_error("lua", "invalid function call, return type %i instead of %i", v, list_val_level);
+ return;
+ }
+ case hrule_cmd:
+ case vrule_cmd:
+ {
+ if (box_leaders_flag(boxcontext)) {
+ halfword rulenode = tex_aux_scan_rule_spec(cur_cmd == hrule_cmd ? h_rule_type : (cur_cmd == vrule_cmd ? v_rule_type : m_rule_type), cur_chr);
+ tex_box_end(boxcontext, rulenode, shift, unset_noad_class);
+ return;
+ } else {
+ break;
+ }
+ }
+ case char_number_cmd:
+ {
+ if (cur_mode == hmode && box_leaders_flag(boxcontext)) {
+ /*tex We cheat by just appending to the current list. */
+ halfword boxnode = null;
+ tex_aux_run_text_char_number();
+ boxnode = tex_pop_tail();
+ tex_box_end(boxcontext, boxnode, shift, unset_noad_class);
+ return;
+ } else {
+ break;
+ }
+ }
+ }
+ tex_handle_error(
+ back_error_type,
+ "A <box> was supposed to be here",
+ "I was expecting to see \\hbox or \\vbox or \\copy or \\box or something like\n"
+ "that. So you might find something missing in your output. But keep trying; you\n"
+ "can fix this later."
+ );
+ if (boxcontext == lua_scan_flag) {
+ tex_box_end(boxcontext, null, shift, unset_noad_class);
+ }
+}
+
+/*tex
+ The |tex_aux_scan_box| call takes a |context| parameter and that is is somewhat weird: it
+ can be a box number, a flag signaling a special kind of box like a leader, or it can be the
+ shift in a move. It all relates to passing something in a way that make it possible to pick
+ it up later.
+*/
+
+static void tex_aux_run_move(void) {
+ int code = cur_chr;
+ halfword val = tex_scan_dimen(0, 0, 0, 0, NULL);
+ tex_aux_scan_box(0, 0, code == move_forward_code ? val : - val);
+}
+
+/*tex
+ Local boxes are something that comes from \OMEGA\ but we implement them somewhat differently.
+ When we finish, the test for |p != null| ensures that empty |\localleftbox| and |\localrightbox|
+ commands are not applied. But it is stull kind of a mess, this mechanism. Resetting these boxes
+ involves registering a state but now we also check if it has been set at all. When I need this
+ feature I will probably check it out and redo some of the code.
+
+ Options: \quote {par} will set the initial par node, when present.
+
+*/
+
+typedef enum saved_localbox_items {
+ saved_localbox_item_location = 0,
+ saved_localbox_item_index = 1,
+ saved_localbox_item_options = 2,
+ saved_localbox_n_of_items = 3,
+} saved_localbox_items;
+
+static void tex_aux_scan_local_box(int code) {
+ quarterword options = 0;
+ halfword class = 0;
+ tex_scan_local_boxes_keys(&options, &class);
+ tex_set_saved_record(saved_localbox_item_location, saved_local_box_location, 0, code);
+ tex_set_saved_record(saved_localbox_item_index, saved_local_box_index, 0, class);
+ tex_set_saved_record(saved_localbox_item_options, saved_local_box_options, 0, options);
+ lmt_save_state.save_stack_data.ptr += saved_localbox_n_of_items;
+ tex_new_save_level(local_box_group);
+ tex_scan_left_brace();
+ tex_push_nest();
+ cur_list.mode = -hmode;
+ cur_list.space_factor = 1000;
+}
+
+static void tex_aux_finish_local_box(void)
+{
+ tex_unsave();
+ if (saved_type(saved_localbox_item_location - saved_localbox_n_of_items) == saved_local_box_location) {
+ halfword p;
+ halfword location = saved_value(saved_localbox_item_location - saved_localbox_n_of_items);
+ quarterword options = (quarterword) saved_value(saved_localbox_item_options - saved_localbox_n_of_items);
+ halfword index = saved_value(saved_localbox_item_index - saved_localbox_n_of_items);
+ int islocal = (options & local_box_local_option) == local_box_local_option;
+ int keep = (options & local_box_keep_option) == local_box_keep_option;
+ int atpar = (options & local_box_par_option) == local_box_par_option;
+ lmt_save_state.save_stack_data.ptr -= saved_localbox_n_of_items;
+ p = node_next(cur_list.head);
+ tex_pop_nest();
+ if (p) {
+ /*tex Somehow |filtered_hpack| goes beyond the first node so we loose it. */
+ node_prev(p) = null;
+ if (tex_list_has_glyph(p)) {
+ tex_handle_hyphenation(p, null);
+ p = tex_handle_glyphrun(p, local_box_group, text_direction_par);
+ }
+ if (p) {
+ p = lmt_hpack_filter_callback(p, 0, packing_additional, local_box_group, direction_unknown, null);
+ }
+ /*tex
+ We really need something packed so we play safe! This feature is inherited but could
+ have been delegated to a callback anyway.
+ */
+ p = tex_hpack(p, 0, packing_additional, direction_unknown, holding_none_option);
+ // node_subtype(p) = location == local_left_box_code ? local_left_list : local_right_list;
+ node_subtype(p) = local_list;
+ box_index(p) = index;
+ // attach_current_attribute_list(p); // leaks
+ }
+ // what to do with reset
+ if (islocal) {
+ /*tex There no copy needed either! */
+ } else {
+ tex_update_local_boxes(p, index, location);
+ }
+ // if (cur_mode == hmode) {
+ if (cur_mode == hmode || cur_mode == mmode) {
+ if (atpar) {
+ halfword par = tex_find_par_par(cur_list.head);
+ if (par) {
+ if (p && ! islocal) {
+ p = tex_copy_node(p);
+ }
+ tex_replace_local_boxes(par, p, index, location);
+ }
+ } else {
+ /*tex
+ We had a null check here but we also want to be able to reset these boxes so we
+ no longer check.
+ */
+ tex_tail_append(tex_new_par_node(local_box_par_subtype));
+ if (! keep) {
+ /*tex So we can group and keep it. */
+ update_tex_internal_par_state(internal_par_state_par + 1);
+ }
+ }
+ }
+ } else {
+ tex_confusion("build local box");
+ }
+}
+
+// static void tex_aux_run_leader(void) {
+// switch (cur_chr) {
+// case a_leaders_code:
+// tex_aux_scan_box(a_leaders_flag, 0, 0);
+// break;
+// case c_leaders_code:
+// tex_aux_scan_box(c_leaders_flag, 0, 0);
+// break;
+// case x_leaders_code:
+// tex_aux_scan_box(x_leaders_flag, 0, 0);
+// break;
+// case g_leaders_code:
+// tex_aux_scan_box(g_leaders_flag, 0, 0);
+// break;
+// }
+// }
+
+static int leader_flags[] = {
+ a_leaders_flag,
+ c_leaders_flag,
+ x_leaders_flag,
+ g_leaders_flag,
+ u_leaders_flag,
+};
+
+static void tex_aux_run_leader(void) {
+ tex_aux_scan_box(leader_flags[cur_chr], 0, null_flag);
+}
+
+static void tex_aux_run_legacy(void) {
+ switch (cur_chr) {
+ case shipout_code:
+ tex_aux_scan_box(shipout_flag, 0, null_flag);
+ break;
+ default:
+ /* cant_happen */
+ break;
+ }
+}
+
+static void tex_aux_run_local_box(void) {
+ tex_aux_scan_local_box(cur_chr);
+}
+
+static void tex_aux_run_make_box(void) {
+ tex_begin_box(0, null_flag);
+}
+
+/*tex
+
+ 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|. We can revert this to zero
+ while at the same time keeping the node.
+
+ To be considered: delay (as with parfilskip), skip + boundary, pre/post anchor etc.
+
+*/
+
+static void tex_aux_insert_parindent(int indented)
+{
+ if (normalize_line_mode_permitted(normalize_line_mode_par, parindent_skip_mode)) {
+ /*tex We cannot use |new_param_glue| yet, because it's a dimen */
+ halfword p = tex_new_glue_node(zero_glue, indent_skip_glue);
+ if (indented) {
+ glue_amount(p) = par_indent_par;
+ }
+ tex_tail_append(p);
+ } else if (indented) {
+ halfword p = tex_new_null_box_node(hlist_node, indent_list);
+ box_dir(p) = (singleword) par_direction_par;
+ box_width(p) = par_indent_par;
+ tex_tail_append(p);
+ }
+}
+
+static void tex_aux_remove_parindent(void)
+{
+ halfword tail = cur_list.tail;
+ switch (node_type(tail)) {
+ case glue_node:
+ if (tex_is_par_init_glue(tail)) {
+ glue_amount(tail) = 0;
+ }
+ break;
+ case hlist_node:
+ if (node_subtype(tail) == indent_list) {
+ box_width(tail) = 0;
+ }
+ break;
+ }
+}
+
+static void tex_aux_run_begin_paragraph_vmode(void) {
+ switch (cur_chr) {
+ case noindent_par_code:
+ tex_begin_paragraph(0, no_indent_par_begin);
+ break;
+ case indent_par_code:
+ tex_begin_paragraph(1, indent_par_begin);
+ break;
+ case quitvmode_par_code:
+ tex_begin_paragraph(1, force_par_begin);
+ break;
+ case snapshot_par_code:
+ /* silently ignore */
+ tex_scan_int(0, NULL);
+ break;
+ case attribute_par_code:
+ /* silently ignore */
+ tex_scan_attribute_register_number();
+ tex_scan_int(1, NULL);
+ break;
+ case wrapup_par_code:
+ tex_you_cant_error(NULL);
+ break;
+ }
+}
+
+static void tex_aux_run_begin_paragraph_hmode(void) {
+ switch (cur_chr) {
+ case noindent_par_code:
+ /*tex We do as traditional \TEX, so no zero skip either when normalizing */
+ break;
+ case indent_par_code:
+ /*tex We can have |\hbox {\indent x\indent x\indent}| */
+ tex_aux_insert_parindent(1);
+ break;
+ case undent_par_code:
+ tex_aux_remove_parindent();
+ break;
+ case snapshot_par_code:
+ {
+ halfword tag = tex_scan_int(0, NULL);
+ halfword par = tex_find_par_par(cur_list.head);
+ if (par) {
+ tex_snapshot_par(par, tag);
+ }
+ break;
+ }
+ case attribute_par_code:
+ {
+ halfword att = tex_scan_attribute_register_number();
+ halfword val = tex_scan_int(1, NULL);
+ halfword par = tex_find_par_par(cur_list.head);
+ if (par) {
+ if (val == unused_attribute_value) {
+ tex_unset_attribute(par, att, val);
+ } else {
+ tex_set_attribute(par, att, val);
+ }
+ }
+ break;
+ }
+ case wrapup_par_code:
+ {
+ halfword par = tex_find_par_par(cur_list.head);
+ if (par) {
+ halfword eop = par_end_par_tokens(par);
+ int reverse = tex_scan_optional_keyword("reverse");
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == left_brace_cmd) {
+ halfword source = tex_scan_toks_normal(1, NULL);
+ if (source) {
+ if (eop) {
+ if (reverse) {
+ halfword p = token_link(source);
+ if (p) {
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ token_link(p) = token_link(par_end_par_tokens(par));
+ token_link(par_end_par_tokens(par)) = null;
+ tex_flush_token_list(par_end_par_tokens(par));
+ par_end_par_tokens(par) = source;
+ }
+ } else {
+ halfword p = eop;
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ token_link(p) = token_link(source);
+ token_link(source) = null;
+ tex_flush_token_list(source);
+ }
+ } else {
+ par_end_par_tokens(par) = source;
+ }
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "I expected a {",
+ "The '\\wrapuppar' command only accepts an explicit token list."
+ );
+ }
+ }
+ break;
+ }
+ }
+}
+
+static void tex_aux_run_begin_paragraph_mmode(void) {
+ switch (cur_chr) {
+ case indent_par_code:
+ {
+ halfword p = tex_new_null_box_node(hlist_node, indent_list);
+ box_width(p) = par_indent_par;
+ p = tex_new_sub_box(p);
+ tex_tail_append(p);
+ break;
+ }
+ case snapshot_par_code:
+ /* silently ignore */
+ tex_scan_int(0, NULL);
+ break;
+ case attribute_par_code:
+ /* silently ignore */
+ tex_scan_attribute_register_number();
+ tex_scan_int(1, NULL);
+ break;
+ case wrapup_par_code:
+ tex_you_cant_error(NULL);
+ break;
+ }
+}
+
+static void tex_aux_run_new_paragraph(void) {
+ int context;
+ switch (cur_cmd) {
+ case char_given_cmd:
+ case other_char_cmd:
+ case letter_cmd:
+ case accent_cmd:
+ case char_number_cmd:
+ case discretionary_cmd:
+ context = char_par_begin;
+ break;
+ case boundary_cmd:
+ context = boundary_par_begin;
+ break;
+ case explicit_space_cmd:
+ context = space_par_begin;
+ break;
+ case math_shift_cmd:
+ case math_shift_cs_cmd:
+ context = math_par_begin;
+ break;
+ case hskip_cmd:
+ context = hskip_par_begin;
+ break;
+ case kern_cmd:
+ context = kern_par_begin;
+ break;
+ case un_hbox_cmd:
+ context = un_hbox_char_par_begin;
+ break;
+ case valign_cmd:
+ context = valign_char_par_begin;
+ break;
+ case vrule_cmd:
+ context = vrule_char_par_begin;
+ break;
+ default:
+ context = normal_par_begin;
+ break;
+ }
+ if (tracing_commands_par >= 4) {
+ tex_begin_diagnostic();
+ tex_print_format("[text: pushing back %C]", cur_cmd, cur_chr);
+ tex_end_diagnostic();
+ }
+ tex_back_input(cur_tok);
+ tex_begin_paragraph(1, context);
+}
+
+/*tex
+ Append a |boundary_node|. The |page_boundary| case is kind of special. It adds a node node to
+ the list of contributions and triggers the page builder (that only kicks in when there is some
+ contribution). That itself can result in firing up the output routine if the page is filled up.
+ An alternative is to inject a penalty but we don't want anything to stay behind and using some
+ special penalty would be incompatible.
+
+ In order to really trigger a check we change the boundary node into zero penalty in the builder
+ when it still present (as the callback can decide to wipe it). It's a bit weird mechanism but
+ it closely relates to triggering something that gets logged in the core engine. Anyway, we
+ basically have a zero penalty equivalent (but one that doesn't register as last node).
+*/
+
+void tex_page_boundary_message(const char *s, halfword n)
+{
+ if (tracing_pages_par >= 0) {
+ tex_begin_diagnostic();
+ tex_print_format("[page: boundary, %s, trigger %i]", s, n);
+ tex_end_diagnostic();
+ }
+}
+
+static void tex_aux_run_par_boundary(void) {
+ switch (cur_chr) {
+ case page_boundary:
+ {
+ halfword n = tex_scan_int(0, NULL);
+ if (lmt_nest_state.nest_data.ptr == 0 && ! lmt_page_builder_state.output_active) {
+ halfword n = tex_new_node(boundary_node, (quarterword) cur_chr);
+ boundary_data(n) = n;
+ tex_tail_append(n);
+ if (cur_list.mode == vmode) {
+ if (! lmt_page_builder_state.output_active) {
+ tex_page_boundary_message("callback triggered", n);
+ lmt_page_filter_callback(boundary_page_context, n);
+ }
+ tex_page_boundary_message("build triggered", n);
+ tex_build_page();
+ } else {
+ tex_page_boundary_message("appended", n);
+ }
+ } else {
+ tex_page_boundary_message("ignored", n);
+ }
+ break;
+ }
+ /*tex Not yet, first I need a proper use case. */ /*
+ case par_boundary:
+ {
+ halfword n = tex_new_node(boundary_node, (quarterword) cur_chr);
+ boundary_data(n) = tex_scan_int(0, NULL);
+ tex_tail_append(n);
+ break;
+ }
+ */
+ default:
+ /*tex Go into horizontal mode and try again (was already the modus operandi). */
+ tex_aux_run_new_paragraph();
+ break;
+ }
+}
+
+static void tex_aux_run_text_boundary(void) {
+ halfword n = tex_new_node(boundary_node, (quarterword) cur_chr);
+ switch (cur_chr) {
+ case user_boundary:
+ case protrusion_boundary:
+ boundary_data(n) = tex_scan_int(0, NULL);
+ break;
+ default:
+ break;
+ }
+ tex_tail_append(n);
+}
+
+static void tex_aux_run_math_boundary(void) {
+ switch (cur_chr) {
+ case user_boundary:
+ {
+ halfword n = tex_new_node(boundary_node, user_boundary);
+ boundary_data(n) = tex_scan_int(0, NULL);
+ tex_tail_append(n);
+ break;
+ }
+ case protrusion_boundary:
+ tex_scan_int(0, NULL);
+ break;
+ }
+}
+
+/*tex
+
+ 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|.
+
+*/
+
+static void tex_aux_run_paragraph_end_vmode(void) {
+ // tex_normal_paragraph(normal_par_context);
+ tex_normal_paragraph(vmode_par_context);
+ if (cur_list.mode > nomode) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(vmode_par_page_context, 0);
+ }
+ tex_build_page();
+ }
+}
+
+/*tex We could pass the group and context here if needed and set some parameter. */
+
+int tex_wrapped_up_paragraph(int context) {
+ halfword par = tex_find_par_par(cur_list.head);
+ lmt_main_control_state.last_par_context = context;
+ if (par) {
+ int done = 0;
+ if (par_end_par_tokens(par)) {
+ halfword eop = par_end_par_tokens(par);
+ par_end_par_tokens(par) = null;
+ tex_back_input(cur_tok);
+ /*tex We inject the tokens, which increments the ref count; this one has tracing. */
+ tex_begin_token_list(eop, end_paragraph_text);
+ /*tex So we need to decrement the token ref here. */
+ tex_delete_token_reference(eop);
+ done = 1;
+ }
+ // if (end_of_par_par) {
+ // if (! done) {
+ // back_input(cur_tok);
+ // }
+ // begin_token_list(end_of_par_par, end_paragraph_text);
+ // update_tex_end_of_par(null);
+ // done = 1;
+ // }
+ return done;
+ } else {
+ return 0;
+ }
+}
+
+static void tex_aux_run_paragraph_end_hmode(void) {
+ if (! tex_wrapped_up_paragraph(normal_par_context)) {
+ if (lmt_input_state.align_state < 0) {
+ /*tex This tries to recover from an alignment that didn't end properly. */
+ tex_off_save();
+ }
+ /* This takes us to the enclosing mode, if |mode > 0|. */
+ tex_end_paragraph(bottom_level_group, normal_par_context);
+ if (cur_list.mode == vmode) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(hmode_par_page_context, 0);
+ }
+ tex_build_page();
+ }
+ }
+}
+
+/* */
+
+static void tex_aux_run_halign_mmode(void) {
+ if (tex_in_privileged_mode()) {
+ if (cur_group == math_shift_group) {
+ tex_run_alignment_initialize();
+ } else {
+ tex_off_save();
+ }
+ }
+}
+
+/*tex
+
+ The |\afterassignment| command puts a token into the global variable |after_token|. This global
+ variable is examined just after every assignment has been performed. It's value is zero, or a
+ saved token.
+
+ Todo: combine code in helper.
+
+*/
+
+static void tex_aux_run_after_something(void) {
+ switch (cur_chr) {
+ case after_group_code:
+ {
+ halfword t = tex_get_token(); /* avoid realloc issues */
+ t = tex_get_available_token(t);
+ tex_save_for_after_group(t);
+ break;
+ }
+ case after_assignment_code:
+ {
+ lmt_main_control_state.after_token = tex_get_token();
+ break;
+ }
+ case at_end_of_group_code:
+ {
+ halfword t = tex_get_token(); /* avoid realloc issues */
+ halfword r = tex_get_available_token(t);
+ if (end_of_group_par) {
+ halfword p = end_of_group_par;
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ token_link(p) = r;
+ } else {
+ halfword p = tex_get_available_token(null);
+ token_link(p) = r;
+ update_tex_end_of_group(p);
+ }
+ break;
+ }
+ case after_grouped_code:
+ {
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == left_brace_cmd) {
+ halfword source = tex_scan_toks_normal(1, NULL);
+ if (source) {
+ tex_save_for_after_group(token_link(source));
+ token_link(source) = null;
+ }
+ tex_flush_token_list(source);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "I expected a {",
+ "The '\\aftergrouped' command only accepts an explicit token list."
+ );
+ }
+ break;
+ }
+ case after_assigned_code:
+ {
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == left_brace_cmd) {
+ halfword source = tex_scan_toks_normal(1, NULL);
+ if (source) {
+ lmt_main_control_state.after_tokens = token_link(source);
+ token_link(source) = null;
+ }
+ tex_flush_token_list(source);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "I expected a {",
+ "The '\\afterassigned' command only accepts an explicit token list."
+ );
+ }
+ break;
+ }
+ case at_end_of_grouped_code:
+ {
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == left_brace_cmd) {
+ halfword source = tex_scan_toks_normal(1, NULL);
+ if (source) {
+ if (end_of_group_par) {
+ halfword p = end_of_group_par;
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ token_link(p) = token_link(source);
+ token_link(source) = null;
+ tex_flush_token_list(source);
+ } else {
+ update_tex_end_of_group(source);
+ }
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "I expected a {",
+ "The '\\endofgrouped' command only accepts an explicit token list."
+ );
+ }
+ break;
+ }
+ }
+}
+
+inline static void tex_aux_finish_after_assignment(void)
+{
+ if (lmt_main_control_state.after_token) {
+ tex_back_input(lmt_main_control_state.after_token);
+ lmt_main_control_state.after_token = null;
+ }
+ if (lmt_main_control_state.after_tokens) {
+ tex_begin_inserted_list(lmt_main_control_state.after_tokens);
+ lmt_main_control_state.after_tokens = null;
+ }
+}
+
+static void tex_aux_invalid_catcode_table_error(void) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\catcode table",
+ "All \\catcode table ids must be between 0 and " LMT_TOSTRING(max_n_of_catcode_tables-1)
+ );
+}
+
+static void tex_aux_overwrite_catcode_table_error(void) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\catcode table",
+ "You cannot overwrite the current \\catcode table"
+ );
+}
+
+static void tex_aux_run_catcode_table(void) {
+ switch (cur_chr) {
+ case save_cat_code_table_code:
+ {
+ halfword v = tex_scan_int(0, NULL);
+ if ((v < 0) || (v >= max_n_of_catcode_tables)) {
+ tex_aux_invalid_catcode_table_error();
+ } else if (v == cat_code_table_par) {
+ tex_aux_overwrite_catcode_table_error();
+ } else {
+ tex_copy_cat_codes(cat_code_table_par, v);
+ }
+ break;
+ }
+ case init_cat_code_table_code:
+ {
+ halfword v = tex_scan_int(0, NULL);
+ if ((v < 0) || (v >= max_n_of_catcode_tables)) {
+ tex_aux_invalid_catcode_table_error();
+ } else if (v == cat_code_table_par) {
+ tex_aux_overwrite_catcode_table_error();
+ } else {
+ tex_initialize_cat_codes(v);
+ }
+ break;
+ }
+ /*
+ case dflt_cat_code_table_code:
+ {
+ halfword v = scan_int(1);
+ if ((v < 0) || (v > CATCODE_MAX)) {
+ invalid_catcode_table_error();
+ } else {
+ set_cat_code_table_default(cat_code_table_par, v);
+ }
+ }
+ break;
+ */
+ default:
+ break;
+ }
+}
+
+static void tex_aux_run_end_local(void)
+{
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("leaving token scanner due to local end token");
+ }
+ tex_end_local_control();
+}
+
+static void tex_aux_run_lua_function_call(void)
+{
+ switch (cur_chr) {
+ case lua_function_call_code:
+ {
+ halfword v = tex_scan_function_reference(0);
+ lmt_lua_run(v, 0);
+ break;
+ }
+ case lua_bytecode_call_code:
+ {
+ halfword v = tex_scan_bytecode_reference(0);
+ lmt_bytecode_run(v);
+ break;
+ }
+ default:
+ break;
+ }
+}
+
+/*tex
+
+ The |main_control| uses a jump table, and |init_main_control| sets that table up. We need to
+ assign an entry for {\em each} of the three modes!
+
+ 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 to have a macro for that as well.
+
+*/
+
+# if (main_control_mode == 0)
+
+ typedef void (*main_control_function)(void);
+
+ static main_control_function *jump_table;
+
+# endif
+
+/*tex
+
+ Here is |main_control| itself. It is quite short nowadays. The initializer is at the end of
+ this file which saves a nunch of forward declarations.
+
+ */
+
+inline static void tex_aux_big_switch (int mode, int cmd);
+
+int tex_main_control(void)
+{
+ lmt_main_control_state.control_state = goto_next_state;
+ if (every_job_par) {
+ tex_begin_token_list(every_job_par, every_job_text);
+ }
+ while (1) {
+ if (lmt_main_control_state.control_state == goto_skip_token_state) {
+ lmt_main_control_state.control_state = goto_next_state;
+ } else {
+ tex_get_x_token();
+ }
+ /*tex
+ 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 (tracing_commands_par > 0) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ /*tex Run the command: */
+ tex_aux_big_switch(cur_mode, cur_cmd);
+ if (lmt_main_control_state.control_state == goto_return_state) {
+ return cur_chr == dump_code;
+ }
+ }
+ /*tex not reached */
+ return 0;
+}
+
+/*tex
+
+ We assume a trailing |\relax|: |{...}\relax|, so we don't need a |back_input ()| here.
+
+*/
+
+void tex_local_control_message(const char *s)
+{
+ tex_begin_diagnostic();
+ tex_print_format("[local control: level %i, %s]", lmt_main_control_state.local_level, s);
+ tex_end_diagnostic();
+}
+
+/*tex
+
+ We can save in two ways but when, for symmetry I want it to happen at the current level, we need
+ to use the save stack. It depends a bit on how this will evolve.
+
+ This one is used in the runlocal \LUA\ helper. This local control is in fact like the main loop,
+ so it can result in stuff being injected in for instance the main vertical list. I played with
+ control over the mode but that gave weird side effects, so I dropped that immediately.
+
+ The implementation of local control in \LUAMETATEX\ is a bit different from \LUATEX\ because we
+ use it in several ways.
+
+*/
+
+void tex_local_control(int obeymode)
+{
+ full_scanner_status saved_full_status = tex_save_full_scanner_status();
+ int old_mode = cur_list.mode;
+ int at_level = lmt_main_control_state.local_level;
+ lmt_main_control_state.local_level += 1;
+ lmt_main_control_state.control_state = goto_next_state;
+ if (! obeymode) {
+ cur_list.mode = -hmode;
+ }
+ while (1) {
+ if (lmt_main_control_state.control_state == goto_skip_token_state) {
+ lmt_main_control_state.control_state = goto_next_state;
+ } else {
+ tex_get_x_token();
+ }
+ if (tracing_commands_par > 0) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ tex_aux_big_switch(cur_mode, cur_cmd);
+ if (lmt_main_control_state.local_level <= at_level) {
+ lmt_main_control_state.control_state = goto_next_state;
+ if (tracing_nesting_par > 2) {
+ /*tex This is a kind of duplicate message, which can be confusing */
+ tex_local_control_message("leaving local control due to level change");
+ }
+ break;
+ } else if (lmt_main_control_state.control_state == goto_return_state) {
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("leaving local control due to triggering");
+ }
+ break;
+ }
+ }
+ if (! obeymode) {
+ cur_list.mode = old_mode;
+ }
+ tex_unsave_full_scanner_status(saved_full_status);
+}
+
+inline int tex_aux_is_iterator_value(halfword tokeninfo)
+{
+ if (tokeninfo >= cs_token_flag) {
+ halfword cs = tokeninfo - cs_token_flag;
+ return eq_type(cs) == some_item_cmd && eq_value(cs) == last_loop_iterator_code;
+ } else {
+ return 0;
+ }
+}
+
+void tex_begin_local_control(void)
+{
+ halfword code = cur_chr;
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering token scanner via primitive");
+ }
+ switch (code) {
+ case local_control_list_code:
+ {
+ halfword t;
+ halfword h = tex_scan_toks_normal(0, &t);
+ halfword r = tex_get_available_token(token_val(end_local_cmd, 0));
+ tex_begin_inserted_list(r);
+ tex_begin_token_list(h, local_text);
+ break;
+ }
+ case local_control_token_code:
+ {
+ halfword t = tex_get_token(); /* avoid realloc issues */
+ halfword h = get_reference_token();
+ halfword r = tex_get_available_token(token_val(end_local_cmd, 0));
+ tex_store_new_token(h, t);
+ tex_begin_inserted_list(r);
+ tex_begin_token_list(h, local_text);
+ break;
+ }
+ /*tex
+ For the moment al three are here because they share some code. At some point I might
+ move the last two to the |convert_cmd| which is more natural spot but this is easier
+ for debugging.
+
+ The align_state hack was tricky and took me a while to figure out because it only was
+ an issue with +10K loops (where 10K is this magic state number).
+
+ We support a leading optional equal sign because that can help make robust macros that
+ get |\the \dimexpr 1pt| etc fed which can lead to \TEX\ seeing one huge number.
+ */
+ case local_control_loop_code:
+ case expanded_loop_code:
+ case unexpanded_loop_code:
+ {
+ halfword tail;
+ halfword first = tex_scan_int(1, NULL);
+ halfword last = tex_scan_int(1, NULL);
+ halfword step = tex_scan_int(1, NULL);
+ halfword head = tex_scan_toks_normal(0, &tail);
+ if (token_link(head) && step) {
+ int savedloop = lmt_main_control_state.loop_iterator;
+ int savedquit = lmt_main_control_state.quit_loop;
+ ++lmt_main_control_state.loop_nesting;
+ switch (code) {
+ case local_control_loop_code:
+ {
+ /*tex:
+ Appending to tail gives issues at the outer level, for instance
+ |\dorecurse {3} {\startTEXpage \stopTEXpage}| without |\starttext
+ \stoptext| wrapping. So, no:
+ */
+ /* tex_store_new_token(tail, token_val(end_local_cmd, 0)); */
+ for (halfword i = first; step > 0 ? i <= last : i >= last; i += step) {
+ lmt_main_control_state.loop_iterator = i;
+ lmt_main_control_state.quit_loop = 0;
+ /*tex But this, so that we get a proper |\end message|: */
+ tex_begin_inserted_list(tex_get_available_token(token_val(end_local_cmd, 0)));
+ /*tex ... maybe we need to enforce a level > 0 instead. */
+ tex_begin_token_list(head, local_loop_text);
+ tex_local_control(1);
+ /*tex We need to avoid build-up. */
+ tex_cleanup_input_state();
+ if (lmt_main_control_state.quit_loop) {
+ break;
+ }
+ }
+ tex_flush_token_list(head);
+ break;
+ }
+ case expanded_loop_code:
+ {
+ halfword h = null;
+ halfword t = null;
+ full_scanner_status saved_full_status = tex_save_full_scanner_status();
+ strnumber u = tex_save_cur_string();
+ tex_store_new_token(tail, right_brace_token + '}');
+ for (halfword i = first; step > 0 ? i <= last : i >= last; i += step) {
+ halfword lt = null;
+ halfword lh = null;
+ ++lmt_input_state.align_state;
+ lmt_main_control_state.loop_iterator = i;
+ tex_begin_token_list(head, loop_text); /* ref counted */
+ lh = tex_scan_toks_expand(1, &lt, 0);
+ if (token_link(lh)) {
+ if (h) {
+ token_link(t) = token_link(lh);
+ } else {
+ h = token_link(lh);
+ }
+ t = lt;
+ }
+ tex_put_available_token(lh);
+ tex_cleanup_input_state();
+ if (lmt_main_control_state.quit_loop) {
+ break;
+ }
+ }
+ tex_unsave_full_scanner_status(saved_full_status);
+ tex_restore_cur_string(u);
+ tex_flush_token_list(head);
+ tex_begin_inserted_list(h);
+ break;
+ }
+ case unexpanded_loop_code:
+ {
+ /*
+ A |\currentloopiterator| will not adapt itself in this kind of
+ loop so we can as well replace it by the current one value which
+ is what we do here. There is some overhead but I can live with
+ that.
+ */
+
+ halfword h = token_link(head);
+ halfword tt = null;
+ halfword t = h;
+ halfword b = 0; /* we can count and then break out */
+ while (token_link(t)) {
+ t = token_link(t);
+ if (! b && tex_aux_is_iterator_value(token_info(t))) {
+ b = 1;
+ }
+ }
+ tt = t;
+ for (halfword i = first + step; step > 0 ? i <= last : i >= last; i += step) {
+ halfword hh = h;
+ while (1) {
+ t = tex_store_new_token(t, token_info(hh));
+ if (b && tex_aux_is_iterator_value(token_info(t))) {
+ halfword v = (i < min_iterator_value) ? min_iterator_value : (i > max_iterator_value ? max_iterator_value : i);
+ token_info(t) = token_val(iterator_value_cmd, v < 0 ? 0x100000 - v : v);
+ }
+ if (hh == tt) {
+ break;
+ } else {
+ hh = token_link(hh);
+ }
+ }
+ }
+ if (b) {
+ halfword hh = h;
+ while (1) {
+ if (tex_aux_is_iterator_value(token_info(hh))) {
+ halfword v = (first < min_iterator_value) ? min_iterator_value : (first > max_iterator_value ? max_iterator_value : first);
+ token_info(hh) = token_val(iterator_value_cmd, v < 0 ? 0x100000 - v : v);
+ }
+ if (hh == tt) {
+ break;
+ } else {
+ hh = token_link(hh);
+ }
+ }
+ }
+ tex_put_available_token(head);
+ tex_begin_inserted_list(h);
+ break;
+ }
+ }
+ --lmt_main_control_state.loop_nesting;
+ lmt_main_control_state.quit_loop = savedquit;
+ lmt_main_control_state.loop_iterator = savedloop;
+ return;
+ } else {
+ tex_flush_token_list(head);
+ }
+ return;
+ }
+ }
+ tex_local_control(1); /*tex In this case nicer than 0. */
+ // tex_cleanup_input_state(); /*tex Yes or no? */
+}
+
+void tex_end_local_control(void )
+{
+ if (lmt_main_control_state.local_level > 0) {
+ lmt_main_control_state.local_level -= 1;
+ } else {
+ tex_local_control_message("redundant end local control");
+ }
+}
+
+/*tex
+
+ We need to go back to the main loop. This is rather nasty and dirty and counterintuive code and
+ there might be a cleaner way. Basically we trigger the main control state from here.
+
+ \starttyping
+ 0 0 \directlua{token.scan_box()}\hbox{!}
+ -1 0 \setbox0\hbox{x}\directlua{token.scan_box()}\box0
+ 1 1 \toks0={\directlua{token.scan_box()}\hbox{x}}\directlua{tex.runtoks(0)}
+ 0 0 1 1 \directlua{tex.box[0]=token.scan_box()}\hbox{x\directlua{node.write(token.scan_box())}\hbox{x}}
+ 0 0 0 1 \setbox0\hbox{x}\directlua{tex.box[0]=token.scan_box()}\hbox{x\directlua{node.write(token.scan_box())}\box0}
+ \stoptyping
+
+ It's rather fragile code so we added some tracing options.
+
+*/
+
+halfword tex_local_scan_box(void)
+{
+ int old_mode = cur_list.mode;
+ int old_level = lmt_main_control_state.local_level;
+ cur_list.mode = -hmode;
+ tex_aux_scan_box(lua_scan_flag, 0, null_flag);
+ if (lmt_main_control_state.local_level == old_level) {
+ /*tex |\directlua{print(token.scan_list())}\hbox{!}| (n n) */
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering at end of box scanning");
+ }
+ tex_local_control(1);
+ } else {
+ /*tex |\directlua{print(token.scan_list())}\box0| (n-1 n) */
+ /*
+ if (tracing_nesting_par > 2) {
+ local_control_message("setting level after box scanning");
+ }
+ */
+ lmt_main_control_state.local_level = old_level;
+ }
+ cur_list.mode = old_mode;
+ return cur_box;
+}
+
+/*tex
+
+ We have an issue with modes when we quit here because we're coming from and still staying at
+ the \LUA\ end. So, unless we're already nested, we trigger an end_local_level token (an
+ extension code).
+
+*/
+
+static void tex_aux_wrapup_local_scan_box(void)
+{
+ /*
+ if (tracing_nesting_par > 2) {
+ local_control_message("leaving box scanner");
+ }
+ */
+ lmt_main_control_state.local_level -= 1;
+}
+
+static void tex_aux_run_insert_dollar_sign(void)
+{
+ tex_back_input(cur_tok);
+ cur_tok = math_shift_token + '$';
+ tex_handle_error(
+ insert_error_type,
+ "Missing $ inserted",
+ "I've inserted a begin-math/end-math symbol since I think you left one out.\n"
+ "Proceed, with fingers crossed."
+ );
+}
+
+/*tex
+
+ The |you_cant| procedure prints a line saying that the current command is illegal in the current
+ mode; it identifies these things symbolically.
+
+*/
+
+void tex_you_cant_error(const char *helpinfo)
+{
+ tex_handle_error(
+ normal_error_type,
+ "You can't use '%C' in %M", cur_cmd, cur_chr, cur_list.mode,
+ helpinfo
+ );
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_run_illegal_case(void)
+{
+ tex_you_cant_error(
+ "Sorry, but I'm not programmed to handle this case;\n"
+ "I'll just pretend that you didn''t ask for it.\n"
+ "If you're in the wrong mode, you might be able to\n"
+ "return to the right one by typing 'I}' or 'I$' or 'I\\par'."
+ );
+}
+
+/*tex
+
+ 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.
+
+*/
+
+int tex_in_privileged_mode(void)
+{
+ if (cur_list.mode > nomode) {
+ return 1;
+ } else {
+ tex_aux_run_illegal_case();
+ return 0;
+ }
+}
+
+/*tex
+
+ 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 \quote {dead cycle}. We do this when |\end| or |\dump|
+ occurs. This |stop| is a special case as we want |main_control| to return to its caller if there
+ is nothing left to do.
+
+*/
+
+static void tex_aux_run_end_job(void) {
+ if (tex_in_privileged_mode()) {
+ if ((page_head == lmt_page_builder_state.page_tail)
+ && (cur_list.head == cur_list.tail)
+ && (lmt_page_builder_state.dead_cycles == 0)) {
+ /*tex this is the only way out */
+ lmt_main_control_state.control_state = goto_return_state;
+ } else {
+ /*tex we will try to end again after ejecting residual material */
+ tex_back_input(cur_tok);
+ tex_tail_append(tex_new_null_box_node(hlist_node, unknown_list));
+ box_width(cur_list.tail) = hsize_par;
+ tex_tail_append(tex_new_glue_node(fill_glue, user_skip_glue)); /* todo: subtype, final_skip_glue? */
+ tex_tail_append(tex_new_penalty_node(-010000000000, final_penalty_subtype)); /* -0x40000000 */
+ lmt_page_filter_callback(end_page_context, 0);
+ /*tex append |\hbox to \hsize{}\vfill\penalty-'10000000000| */
+ tex_build_page();
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_run_glue(void)
+{
+ switch (cur_chr) {
+ case fil_code:
+ tex_tail_append(tex_new_glue_node(fil_glue, user_skip_glue));
+ break;
+ case fill_code:
+ tex_tail_append(tex_new_glue_node(fill_glue, user_skip_glue));
+ break;
+ case filll_code: /*tex aka |ss_code| */
+ tex_tail_append(tex_new_glue_node(filll_glue, user_skip_glue));
+ break;
+ case fil_neg_code:
+ tex_tail_append(tex_new_glue_node(fil_neg_glue, user_skip_glue));
+ break;
+ case skip_code:
+ {
+ halfword v = tex_scan_glue(glue_val_level, 0);
+ halfword g = tex_new_glue_node(v, user_skip_glue);
+ /* glue_data(g) = glue_data_par; */
+ tex_tail_append(g);
+ tex_flush_node(v);
+ break;
+ }
+ default:
+ break;
+ }
+}
+
+static void tex_aux_run_mglue(void)
+{
+ switch (cur_chr) {
+ case normal_mskip_code:
+ {
+ halfword v = tex_scan_glue(mu_val_level, 0);
+ tex_tail_append(tex_new_glue_node(v, mu_glue));
+ tex_flush_node(v);
+ break;
+ }
+ case atom_mskip_code:
+ {
+ halfword left = tex_scan_math_class_number(0);
+ halfword right = tex_scan_math_class_number(0);
+ halfword style = tex_scan_math_style_identifier(0, 0);
+ halfword node = tex_math_spacing_glue(left, right, style);
+ if (node) {
+ tex_tail_append(node);
+ } else {
+ /*tex This could be an option: */
+ tex_tail_append(tex_new_glue_node(zero_glue, mu_glue));
+ }
+ break;
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_off_save(void)
+{
+ if (cur_group == bottom_level_group) {
+ /*tex Drop current token and complain that it was unmatched */
+ tex_handle_error(normal_error_type, "Extra %C", cur_cmd, cur_chr,
+ "Things are pretty mixed up, but I think the worst is over."
+ );
+ } else {
+ const char * helpinfo =
+ "I've inserted something that you may have forgotten. (See the <inserted text>\n"
+ "above.) With luck, this will get me unwedged.";
+ halfword h = tex_get_available_token(null);
+ tex_back_input(cur_tok);
+ /*tex
+ 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 also_simple_group:
+ case semi_simple_group:
+ case math_simple_group:
+ {
+ set_token_info(h, deep_frozen_end_group_token);
+ tex_handle_error(
+ normal_error_type,
+ "Missing \\endgroup inserted",
+ helpinfo
+ );
+ break;
+ }
+ case math_shift_group:
+ {
+ set_token_info(h, math_shift_token + '$');
+ tex_handle_error(
+ normal_error_type,
+ "Missing $ inserted",
+ helpinfo
+ );
+ break;
+ }
+ case math_fence_group:
+ {
+ /* maybe nicer is just a zero delimiter one */
+ halfword q = tex_get_available_token(period_token);
+ halfword f = node_next(cur_list.head);
+ set_token_info(h, deep_frozen_right_token);
+ set_token_link(h, q);
+ if (! (f && node_type(f) == fence_noad && has_noad_option_nocheck(f))) {
+ tex_handle_error(
+ normal_error_type,
+ "Missing \\right. inserted",
+ helpinfo
+ );
+ }
+ break;
+ }
+ default:
+ {
+ set_token_info(h, right_brace_token + '}');
+ tex_handle_error(
+ normal_error_type,
+ "Missing } inserted",
+ helpinfo
+ );
+ break;
+ }
+ }
+ tex_begin_inserted_list(h);
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_run_discretionary(void)
+{
+ switch (cur_chr) {
+ case normal_discretionary_code:
+ /*tex |\discretionary| */
+ {
+ halfword d = tex_new_disc_node(normal_discretionary_code);
+ tex_tail_append(d);
+ while (1) {
+ switch (tex_scan_character("pocPOC", 0, 1, 0)) {
+ case 0:
+ goto DONE;
+ case 'p': case 'P':
+ switch (tex_scan_character("eorEOR", 0, 0, 0)) {
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("penalty", 2)) {
+ set_disc_penalty(d, tex_scan_int(0, NULL));
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("postword", 2)) {
+ set_disc_option(d, disc_option_post_word);
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("preword", 2)) {
+ set_disc_option(d, disc_option_pre_word);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("penalty|postword|preword");
+ goto DONE;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("options", 1)) {
+ set_disc_options(d, tex_scan_int(0, NULL));
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("class", 1)) {
+ set_disc_class(d, tex_scan_math_class_number(0));
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ tex_set_saved_record(saved_discretionary_item_component, saved_discretionary_count, 0, 0);
+ lmt_save_state.save_stack_data.ptr += saved_discretionary_n_of_items;
+ tex_new_save_level(discretionary_group);
+ tex_scan_left_brace();
+ tex_push_nest();
+ cur_list.mode = -hmode;
+ cur_list.space_factor = default_space_factor; /* hm, quite hard coded */
+ }
+ break;
+ case explicit_discretionary_code:
+ /*tex |\-| */
+ if (hyphenation_permitted(hyphenation_mode_par, explicit_hyphenation_mode)) {
+ halfword d = tex_new_disc_node(explicit_discretionary_code);
+ tex_tail_append(d);
+ int c = tex_get_pre_hyphen_char(cur_lang_par);
+ if (c > 0) {
+ tex_set_disc_field(d, pre_break_code, tex_new_char_node(glyph_unset_subtype, cur_font_par, c, 1));
+ }
+ c = tex_get_post_hyphen_char(cur_lang_par);
+ if (c > 0) {
+ tex_set_disc_field(d, post_break_code, tex_new_char_node(glyph_unset_subtype, cur_font_par, c, 1));
+ }
+ disc_penalty(d) = tex_explicit_disc_penalty(hyphenation_mode_par);
+ }
+ break;
+ case automatic_discretionary_code:
+ case mathematics_discretionary_code:
+ /*tex |-| */
+ if (hyphenation_permitted(hyphenation_mode_par, automatic_hyphenation_mode)) {
+ halfword d = tex_new_disc_node(automatic_discretionary_code);
+ tex_tail_append(d);
+ /*tex As done in hyphenator: */
+ halfword c = tex_get_pre_exhyphen_char(cur_lang_par);
+ if (c <= 0) {
+ c = ex_hyphen_char_par;
+ }
+ if (c > 0) {
+ tex_set_disc_field(d, pre_break_code, tex_new_char_node(glyph_unset_subtype, cur_font_par, c, 1));
+ }
+ c = tex_get_post_exhyphen_char(cur_lang_par);
+ if (c > 0) {
+ tex_set_disc_field(d, post_break_code, tex_new_char_node(glyph_unset_subtype, cur_font_par, c, 1));
+ }
+ c = ex_hyphen_char_par;
+ if (c > 0) {
+ tex_set_disc_field(d, no_break_code, tex_new_char_node(glyph_unset_subtype, cur_font_par, c, 1));
+ }
+ disc_penalty(d) = tex_automatic_disc_penalty(hyphenation_mode_par);
+ } else {
+ halfword c = ex_hyphen_char_par;
+ if (c > 0) {
+ c = tex_new_char_node(glyph_unset_subtype, cur_font_par, c, 1);
+ set_glyph_discpart(c, glyph_discpart_always);
+ tex_tail_append(c);
+ }
+ }
+ break;
+ }
+}
+
+/*tex
+
+ The three discretionary lists are constructed somewhat as if they were hboxes. A subroutine
+ called |finish_discretionary| handles the transitions. (This is sort of fun.)
+
+*/
+
+static void tex_aux_finish_discretionary(void)
+{
+ halfword p, q, d; /* for link manipulation */
+ int n = 0; /* length of discretionary list */
+ tex_unsave();
+ /*tex
+ 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 = node_next(q)| and there are |n| items
+ preceding |p|.
+ */
+ q = cur_list.head;
+ p = node_next(q);
+ while (p) {
+ switch (node_type(p)) {
+ case glyph_node:
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ case kern_node:
+ break;
+ case glue_node:
+ if (hyphenation_permitted(hyphenation_mode_par, permit_glue_hyphenation_mode)) {
+ if (glue_stretch_order(p)) {
+ glue_stretch(p) = 0;
+ glue_stretch_order(p) = 0;
+ }
+ if (glue_shrink_order(p)) {
+ glue_shrink(p) = 0;
+ glue_shrink_order(p) = 0;
+ }
+ break;
+ } else {
+ // fall through
+ }
+ default:
+ if (hyphenation_permitted(hyphenation_mode_par, permit_all_hyphenation_mode)) {
+ break;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Improper discretionary list",
+ "Discretionary lists must contain only glyphs, boxes, rules and kerns."
+ );
+ tex_begin_diagnostic();
+ tex_print_str("The following discretionary sublist has been deleted:");
+ tex_print_levels();
+ tex_show_box(p);
+ tex_end_diagnostic();
+ tex_flush_node_list(p);
+ node_next(q) = null;
+ goto DONE;
+ }
+ }
+ node_prev(p) = q;
+ q = p;
+ p = node_next(q);
+ ++n;
+ }
+ DONE:
+ p = node_next(cur_list.head);
+ tex_pop_nest();
+ d = cur_list.tail;
+ if (saved_type(saved_discretionary_item_component - saved_discretionary_n_of_items) == saved_discretionary_count) {
+ switch (saved_value(saved_discretionary_item_component - saved_discretionary_n_of_items)) {
+ case 0:
+ if (n > 0) {
+ tex_set_disc_field(d, pre_break_code, p);
+ }
+ break;
+ case 1:
+ if (n > 0) {
+ tex_set_disc_field(d, post_break_code, p);
+ }
+ break;
+ case 2:
+ /*tex
+ Attach list |p| to the current list, and record its length; then finish up and
+ |return|.
+ */
+ if (n > 0) {
+ if (cur_mode == mmode && ! hyphenation_permitted(hyphenation_mode_par, permit_math_replace_hyphenation_mode)) {
+ tex_handle_error(
+ normal_error_type,
+ "Illegal math \\discretionary",
+ "Sorry: The third part of a discretionary break must be empty, in math formulas. I\n"
+ "had to delete your third part."
+ );
+ tex_flush_node_list(p);
+ } else {
+ tex_set_disc_field(d, no_break_code, p);
+ }
+ }
+ if (! hyphenation_permitted(hyphenation_mode_par, normal_hyphenation_mode)) {
+ halfword n = disc_no_break_head(d);
+ cur_list.tail = node_prev(cur_list.tail);
+ node_next(cur_list.tail) = null;
+ if (n) {
+ tex_tail_append(n);
+ cur_list.tail = disc_no_break_tail(d);
+ tex_set_disc_field(d, no_break_code, null);
+ tex_set_discpart(d, n, disc_no_break_tail(d), glyph_discpart_replace);
+ }
+ tex_flush_node(d);
+ } else if (cur_mode == mmode && disc_class(d) != unset_disc_class) {
+ halfword n = null;
+ cur_list.tail = node_prev(d);
+ node_prev(d) = null;
+ node_next(d) = null;
+ n = tex_math_make_disc(d);
+ tex_tail_append(n);
+ }
+ /*tex There are no other cases. */
+ lmt_save_state.save_stack_data.ptr -= saved_discretionary_n_of_items;
+ return;
+ default:
+ break;
+ }
+ tex_set_saved_record(saved_discretionary_item_component - saved_discretionary_n_of_items, saved_discretionary_count, 0, saved_value(saved_discretionary_item_component - saved_discretionary_n_of_items) + 1);
+ tex_new_save_level(discretionary_group);
+ tex_scan_left_brace();
+ tex_push_nest();
+ cur_list.mode = -hmode;
+ cur_list.space_factor = default_space_factor;
+ } else {
+ tex_confusion("finish discretionary");
+ }
+}
+
+/*tex
+
+ 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.
+
+ 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.
+*/
+
+static void tex_aux_extra_right_brace_error(void)
+{
+ const char * helpinfo =
+ "I've deleted a group-closing symbol because it seems to be spurious, as in\n"
+ "'$x}$'. But perhaps the } is legitimate and you forgot something else, as in\n"
+ "'\\hbox{$x}'.";
+ switch (cur_group) {
+ case also_simple_group:
+ case semi_simple_group:
+ tex_handle_error(
+ normal_error_type,
+ "Extra }, or forgotten %eendgroup",
+ helpinfo
+ );
+ break;
+ case math_simple_group:
+ tex_handle_error(
+ normal_error_type,
+ "Extra }, or forgotten %eendmathgroup",
+ helpinfo
+ );
+ break;
+ case math_shift_group:
+ tex_handle_error(
+ normal_error_type,
+ "Extra }, or forgotten $",
+ helpinfo
+ );
+ break;
+ case math_fence_group:
+ tex_handle_error(
+ normal_error_type,
+ "Extra }, or forgotten %eright",
+ helpinfo
+ );
+ break;
+ }
+ ++lmt_input_state.align_state;
+}
+
+inline static void tex_aux_finish_hbox(void)
+{
+ tex_aux_fixup_directions_only();
+ tex_package(hpack_code);
+}
+
+inline static void tex_aux_finish_adjusted_hbox(void)
+{
+ lmt_packaging_state.post_adjust_tail = post_adjust_head;
+ lmt_packaging_state.pre_adjust_tail = pre_adjust_head;
+ lmt_packaging_state.post_migrate_tail = post_migrate_head;
+ lmt_packaging_state.pre_migrate_tail = pre_migrate_head;
+ tex_package(hpack_code);
+}
+
+inline static void tex_aux_finish_vbox(void)
+{
+ if (! tex_wrapped_up_paragraph(vbox_par_context)) {
+ tex_end_paragraph(vbox_group, vbox_par_context);
+ tex_package(vpack_code);
+ }
+}
+
+inline static void tex_aux_finish_vtop(void)
+{
+ if (! tex_wrapped_up_paragraph(vtop_par_context)) {
+ tex_end_paragraph(vtop_group, vtop_par_context);
+ tex_package(vtop_code);
+ }
+}
+
+inline static void tex_aux_finish_simple_group(void)
+{
+ tex_aux_fixup_directions_and_unsave();
+}
+
+static void tex_aux_finish_bottom_level_group(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Too many }'s",
+ "You've closed more groups than you opened. Such booboos are generally harmless,\n"
+ "so keep going."
+ );
+}
+
+inline static void tex_aux_finish_output(void)
+{
+ tex_pop_text_dir_ptr();
+ tex_resume_after_output();
+}
+
+static void tex_aux_run_right_brace(void)
+{
+ switch (cur_group) {
+ case bottom_level_group:
+ tex_aux_finish_bottom_level_group();
+ break;
+ case simple_group:
+ tex_aux_finish_simple_group();
+ break;
+ case hbox_group:
+ tex_aux_finish_hbox();
+ break;
+ case adjusted_hbox_group:
+ tex_aux_finish_adjusted_hbox();
+ break;
+ case vbox_group:
+ tex_aux_finish_vbox();
+ break;
+ case vtop_group:
+ tex_aux_finish_vtop();
+ break;
+ case align_group:
+ tex_finish_alignment_group();
+ break;
+ case no_align_group:
+ tex_finish_no_alignment_group();
+ break;
+ case output_group:
+ tex_aux_finish_output();
+ break;
+ case math_group:
+ tex_finish_math_group();
+ break;
+ case discretionary_group:
+ tex_aux_finish_discretionary();
+ break;
+ case insert_group:
+ tex_finish_insert_group();
+ break;
+ case vadjust_group:
+ tex_finish_vadjust_group();
+ break;
+ case vcenter_group:
+ tex_finish_vcenter_group();
+ break;
+ case math_fraction_group:
+ tex_finish_math_fraction();
+ break;
+ case math_operator_group:
+ tex_finish_math_operator();
+ break;
+ case math_choice_group:
+ tex_finish_math_choice();
+ break;
+ case also_simple_group:
+ case math_simple_group:
+ // cur_group = semi_simple_group; /* probably not needed */
+ tex_aux_run_end_group();
+ break;
+ case semi_simple_group:
+ case math_shift_group:
+ case math_fence_group: /*tex See above, let's see when we are supposed to end up here. */
+ tex_aux_extra_right_brace_error();
+ break;
+ case local_box_group:
+ tex_aux_finish_local_box();
+ break;
+ default:
+ tex_confusion("right brace");
+ break;
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_normal_paragraph(int context)
+{
+ int ignore = 0;
+ lmt_main_control_state.last_par_context = context;
+ lmt_paragraph_context_callback(context, &ignore);
+ if (! ignore) {
+ if (looseness_par) {
+ update_tex_looseness(0);
+ }
+ if (hang_indent_par) {
+ update_tex_hang_indent(0);
+ }
+ if (hang_after_par != 1) {
+ update_tex_hang_after(1);
+ }
+ if (par_shape_par) {
+ update_tex_par_shape(null);
+ }
+ if (inter_line_penalties_par) {
+ update_tex_inter_line_penalties(null);
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+ The |box_end| procedure does the right thing with |boxnode|, if |boxcontext| represents the
+ context as explained above. The |boxnode| variable is either a list node or a register index.
+ In some cases we communicate via a state variable.
+
+*/
+
+static void tex_aux_wrapup_leader_box(halfword boxcontext, halfword boxnode)
+{
+ /*tex Append a new leader node that uses |box| and get the next non-blank non-relax. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ if ((cur_cmd == hskip_cmd && cur_mode != vmode) || (cur_cmd == vskip_cmd && cur_mode == vmode)) {
+ tex_aux_run_glue(); /* uses cur_chr */
+ switch (boxcontext) {
+ case a_leaders_flag:
+ node_subtype(cur_list.tail) = a_leaders;
+ break;
+ case c_leaders_flag:
+ node_subtype(cur_list.tail) = c_leaders;
+ break;
+ case x_leaders_flag:
+ node_subtype(cur_list.tail) = x_leaders;
+ break;
+ case g_leaders_flag:
+ node_subtype(cur_list.tail) = g_leaders;
+ break;
+ case u_leaders_flag:
+ switch (node_type(boxnode)) {
+ case hlist_node:
+ if (cur_mode != vmode) {
+ node_subtype(cur_list.tail) = u_leaders;
+ glue_amount(cur_list.tail) += box_width(boxnode);
+ } else {
+ node_subtype(cur_list.tail) = a_leaders;
+ }
+ break;
+ case vlist_node:
+ if (cur_mode == vmode) {
+ node_subtype(cur_list.tail) = u_leaders;
+ glue_amount(cur_list.tail) += box_total(boxnode);
+ } else {
+ node_subtype(cur_list.tail) = a_leaders;
+ }
+ break;
+ default:
+ /* yet unsupported */
+ node_subtype(cur_list.tail) = a_leaders;
+ break;
+ }
+ break;
+ }
+ glue_leader_ptr(cur_list.tail) = boxnode;
+ } else {
+ tex_handle_error(
+ back_error_type,
+ "Leaders not followed by proper glue",
+ "You should say '\\leaders <box or rule><hskip or vskip>'. I found the <box or\n"
+ "rule>, but there's no suitable <hskip or vskip>, so I'm ignoring these leaders."
+ );
+ tex_flush_node_list(boxnode);
+ }
+}
+
+void tex_box_end(int boxcontext, halfword boxnode, scaled shift, halfword mainclass)
+{
+ cur_box = boxnode;
+ if (boxcontext < box_flag) {
+ /*tex
+
+ Append box |boxnode| to the current list, shifted by |boxcontext|. 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.
+
+ Having shift in the box context is kind of strange but as long as we stay below maxdimen
+ it works.
+
+ We now pass the shift directly, so no boxcontext trick here.
+
+ */
+
+ if (boxnode) {
+ // box_shift_amount(boxnode) = boxcontext;
+ if (shift != null_flag) {
+ box_shift_amount(boxnode) = shift;
+ }
+ switch (cur_mode) {
+ case vmode:
+ if (lmt_packaging_state.pre_adjust_tail) {
+ if (pre_adjust_head != lmt_packaging_state.pre_adjust_tail) {
+ tex_inject_adjust_list(pre_adjust_head, 1, boxnode, NULL);
+ }
+ lmt_packaging_state.pre_adjust_tail = null;
+ }
+ if (lmt_packaging_state.pre_migrate_tail) {
+ if (pre_migrate_head != lmt_packaging_state.pre_migrate_tail) {
+ tex_append_list(pre_migrate_head, lmt_packaging_state.pre_migrate_tail);
+ }
+ lmt_packaging_state.pre_migrate_tail = null;
+ }
+ tex_append_to_vlist(boxnode, lua_key_index(box), NULL);
+ if (lmt_packaging_state.post_migrate_tail) {
+ if (post_migrate_head != lmt_packaging_state.post_migrate_tail) {
+ tex_append_list(post_migrate_head, lmt_packaging_state.post_migrate_tail);
+ }
+ lmt_packaging_state.post_migrate_tail = null;
+ }
+ if (lmt_packaging_state.post_adjust_tail) {
+ if (post_adjust_head != lmt_packaging_state.post_adjust_tail) {
+ tex_inject_adjust_list(post_adjust_head, 1, null, NULL);
+ }
+ lmt_packaging_state.post_adjust_tail = null;
+ }
+ if (cur_list.mode > nomode) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(box_page_context, 0);
+ }
+ tex_build_page();
+ }
+ break;
+ case hmode:
+ cur_list.space_factor = default_space_factor;
+ tex_couple_nodes(cur_list.tail, boxnode);
+ cur_list.tail = boxnode;
+ break;
+ /* case mmode: */
+ default:
+ boxnode = tex_new_sub_box(boxnode);
+ tex_couple_nodes(cur_list.tail, boxnode);
+ cur_list.tail = boxnode;
+ if (mainclass != unset_noad_class) {
+ set_noad_classes(boxnode, mainclass);
+ }
+ break;
+ }
+ } else {
+ /* just scanning */
+ }
+ } else if (boxcontext < global_box_flag) {
+ /*tex Store |box| in a local box register */
+ update_tex_box_local(boxcontext, boxnode);
+ } else if (boxcontext <= max_global_box_flag) {
+ /*tex Store |box| in a global box register */
+ update_tex_box_global(boxcontext, boxnode);
+ } else {
+ switch (boxcontext) {
+ case shipout_flag:
+ /*tex This normally can't happen as some backend code needs to kick in. */
+ if (boxnode) {
+ /*tex We just show the box ... */
+ tex_begin_diagnostic();
+ tex_show_node_list(boxnode, max_integer, max_integer);
+ tex_end_diagnostic();
+ /*tex ... and wipe it when it's a register ... */
+ if (box_register(boxnode)) {
+ tex_flush_node_list(boxnode);
+ box_register(boxnode) = null;
+ }
+ /*tex ... so there is at least an indication that we flushed. */
+ }
+ break;
+ case left_box_flag:
+ case right_box_flag:
+ case middle_box_flag:
+ /*tex Actualy, this cannot happen ... will go away. */
+ tex_aux_finish_local_box();
+ break;
+ case lua_scan_flag:
+ /*tex We are done with scanning so let's return to the caller. */
+ tex_aux_wrapup_local_scan_box();
+ cur_box = boxnode;
+ break;
+ case a_leaders_flag:
+ case c_leaders_flag:
+ case x_leaders_flag:
+ case g_leaders_flag:
+ case u_leaders_flag:
+ tex_aux_wrapup_leader_box(boxcontext, boxnode);
+ break;
+ default:
+ /* fatal error */
+ break;
+ }
+ }
+}
+
+/*tex
+
+ The canonical \TEX\ engine(s) inject an indentation box, so there is always something at the beginning that
+ also acts as a boundary. However, when snapshotting was introduced it made also sense to turn the parindent
+ related hlist into a glue. We might need to adapt the parbuilder but it looks liek that is not needed. Of
+ course, an |\unskip| will now also unskip the parindent but there are ways to prevent this. I'll test it for
+ a while, which is why we have a way to enable it. The glue is {\em always} injected, also when it's zero.
+
+*/
+
+void tex_begin_paragraph(int doindent, int context)
+{
+ halfword q;
+ int indented = doindent;
+ int isvmode = cur_list.mode == vmode;
+ if (isvmode || cur_list.head != cur_list.tail) {
+ /*tex
+ Actually we could remove the callback and hook it into the |\everybeforepar| but that one
+ started out as a |tex.expandmacro| itself and we don't want the callback overhead every
+ time, so now we have both. However, in the end I decided to do this one {\em before} the
+ parskip is injected.
+ */
+ if (every_before_par_par) {
+ tex_begin_inserted_list(tex_get_available_token(token_val(end_local_cmd, 0)));
+ tex_begin_token_list(every_before_par_par, every_before_par_text);
+ if (tracing_nesting_par > 2) {
+ tex_local_control_message("entering local control via \\everybeforepar");
+ }
+ tex_local_control(1);
+ }
+ // if (type(cur_list.tail) == glue_node && subtype(cur_list.tail) == par_skip_glue) {
+ // /* ignore */
+ // } else {
+ tex_tail_append(tex_new_param_glue_node(par_skip_code, par_skip_glue));
+ // }
+ }
+ lmt_begin_paragraph_callback(isvmode, &indented, context);
+ /*tex We'd better not messed up things in the callback! */
+ cur_list.prev_graf = 0;
+ tex_push_nest();
+ cur_list.mode = hmode;
+ cur_list.space_factor = default_space_factor;
+ /*tex Add local paragraph node */
+ tex_tail_append(tex_new_par_node(vmode_par_par_subtype));
+ // if (end_of_par_par) {
+ // update_tex_end_of_par(null); /* option */
+ // }
+ q = cur_list.tail;
+ /*tex We will move this to after the dir nodes have been dealt with. */
+ tex_aux_insert_parindent(indented);
+ /*tex Dir nodes end up before the indent box. */
+ {
+ halfword dir_rover = lmt_dir_state.text_dir_ptr;
+ while (dir_rover) {
+ if ((node_next(dir_rover)) || (dir_direction(dir_rover) != par_direction_par)) {
+ halfword dir_graf_tmp = tex_new_dir(normal_dir_subtype, dir_direction(dir_rover));
+ tex_try_couple_nodes(dir_graf_tmp, node_next(q));
+ tex_couple_nodes(q, dir_graf_tmp);
+ }
+ dir_rover = node_next(dir_rover);
+ }
+ }
+ /*tex We might need to go to the last injected dir and/or indent node. */
+ while (node_next(q)) {
+ q = node_next(q);
+ }
+ cur_list.tail = q;
+ /*tex The |\everypar| tokens are injected after dir nodes have been added. */
+ if (every_par_par) {
+ tex_begin_token_list(every_par_par, every_par_text);
+ }
+ if (lmt_nest_state.nest_data.ptr == 1) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(begin_paragraph_page_context, 0);
+ }
+ /*tex put |par_skip| glue on current page */
+ tex_build_page();
+ }
+}
+
+void tex_insert_paragraph_token(void)
+{
+ if (auto_paragraph_mode_par > 0) {
+ cur_tok = token_val(end_paragraph_cmd, inserted_end_paragraph_code);
+ // cur_tok = token_val(end_paragraph_cmd, normal_end_paragraph_code);
+ // cur_cs = null;
+ } else {
+ cur_tok = lmt_token_state.par_token;
+ }
+}
+
+static void tex_aux_run_head_for_vmode(void)
+{
+ if (cur_list.mode >= nomode) {
+ tex_back_input(cur_tok);
+ /*tex
+ We could have a callback here but on the other hand, we really need to be in vmode
+ afterwards! Also, a macro package can just test for the mode at that spot which is
+ less hassle than making a callback identify what is needed. A return value would
+ indicate to not inject a par when we're in vmode and only very dirty \LUA\ code can
+ change modes here by messing with the list so far. So, unless I find a real use case
+ we just continue.
+ */
+ tex_insert_paragraph_token();
+ tex_back_input(cur_tok);
+ lmt_input_state.cur_input.token_type = inserted_text;
+ } else if (cur_cmd != hrule_cmd) {
+ tex_off_save();
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "You can't use '\\hrule' here except with leaders",
+ "To put a horizontal rule in an hbox or an alignment, you should use \\leaders or\n"
+ "\\hrulefill (see The TeXbook)."
+ );
+ }
+}
+
+/*tex
+
+ We don't have |hkern_cmd| and |vkern_cmd| and it makes no sense to introduce them now so instead
+ of handling modes in the big switch we do it here. Because we need to be compatible we would end
+ up with three |cmd| codes anyway. The rationale for |\hkern| and |\vkern| is consistency of
+ primitives, while |\nonzerowidthkern| can make node lists smaller which is nice for \LUA\ based
+ juggling.
+
+*/
+
+/*
+static void tex_aux_run_kern(void)
+{
+ halfword val = tex_scan_dimen(0, 0, 0, 0, NULL);
+ tex_tail_append(tex_new_kern_node(val, explicit_kern));
+}
+*/
+
+static void tex_aux_run_kern(void)
+{
+ halfword code = cur_chr;
+ halfword val = tex_scan_dimen(0, 0, 0, 0, NULL);
+ switch (code) {
+ case normal_kern_code:
+ break;
+ case h_kern_code:
+ if (cur_mode == mmode) {
+ break;
+ } else {
+ cur_tok = token_val(kern_cmd, normal_kern_code);
+ tex_aux_run_new_paragraph();
+ return;
+ }
+ break;
+ case v_kern_code:
+ if (cur_mode == mmode) {
+ break;
+ } else {
+ cur_tok = token_val(kern_cmd, normal_kern_code);
+ tex_aux_run_head_for_vmode();
+ return;
+ }
+ case non_zero_width_kern_code:
+ if (val) {
+ break;
+ } else {
+ return;
+ }
+ }
+ tex_tail_append(tex_new_kern_node(val, explicit_kern_subtype));
+}
+
+static void tex_aux_run_mkern(void)
+{
+ halfword val = tex_scan_dimen(1, 0, 0, 0, NULL);
+ tex_tail_append(tex_new_kern_node(val, explicit_math_kern_subtype));
+}
+
+/*tex
+
+ |cur_list.dirs| 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
+ might be wrong in some way that relates to in-paragraph displays.
+
+*/
+
+static int tex_aux_only_dirs(halfword n)
+{
+ while (n) {
+ switch (node_type(n)) {
+ case par_node:
+ case dir_node:
+ n = node_next(n);
+ break;
+ /*tex
+ This can become an option if realy needed but it kind of violates the enforced
+ hmode, so we stay compatible. But contrary to \LUATEX\ a |\noindent| is seen as
+ content trigger.
+ */
+ case glue_node:
+ if (tex_is_par_init_glue(n)) {
+ n = node_next(n);
+ break;
+ }
+ default:
+ return 0;
+ }
+ }
+ return 1;
+}
+
+void tex_end_paragraph(int group, int context)
+{
+ if (cur_list.mode == hmode) {
+ if (cur_list.head == cur_list.tail) {
+ /*tex |null| paragraphs are ignored, all contain a |par| node */
+ tex_pop_nest();
+ } else if (tex_aux_only_dirs(node_next(cur_list.head))) {
+ tex_flush_node(node_next(cur_list.head));
+ /* cur_list.tail = cur_list.head; */ /* probably needed */
+ tex_pop_nest();
+ // if (cur_list.head == cur_list.tail || node_next(cur_list.head) == cur_list.tail) {
+ // if (node_next(cur_list.head) == cur_list.tail) {
+ // tex_flush_node(node_next(cur_list.head));
+ // // cur_list.tail = cur_list.head;
+ // }
+ // tex_pop_nest();
+ } else {
+ tex_line_break(0, group);
+ }
+ if (cur_list.direction_stack) {
+ tex_flush_node_list(cur_list.direction_stack);
+ cur_list.direction_stack = null;
+ }
+ tex_normal_paragraph(context);
+ lmt_error_state.error_count = 0;
+ }
+}
+
+static void tex_aux_run_penalty(void)
+{
+ halfword value = tex_scan_int(0, NULL);
+ tex_tail_append(tex_new_penalty_node(value, user_penalty_subtype));
+ if (cur_list.mode == vmode) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(penalty_page_context, 0);
+ }
+ tex_build_page();
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_run_remove_item(void)
+{
+ halfword code = cur_chr;
+ halfword head = cur_list.head;
+ halfword tail = cur_list.tail;
+ if (cur_list.mode == vmode && tail == head) {
+ /*tex
+ Apologize for inability to do the operation now, unless |\unskip|
+ follows non-glue. It's a bit weird test.
+ */
+ if ((code != skip_item_code) || (lmt_page_builder_state.last_glue != max_halfword)) {
+ switch (code) {
+ case kern_item_code:
+ tex_you_cant_error(
+ "Sorry...I usually can't take things from the current page.\n"
+ "Try '\\kern-\\lastkern' instead."
+ );
+ break;
+ case penalty_item_code:
+ case boundary_item_code:
+ tex_you_cant_error(
+ "Sorry...I usually can't take things from the current page.\n"
+ "Perhaps you can make the output routine do it."
+ );
+ break;
+ case skip_item_code:
+ tex_you_cant_error(
+ "Sorry...I usually can't take things from the current page.\n"
+ "Try '\\vskip-\\lastskip' instead."
+ );
+ break;
+ }
+ }
+// } else if (node_type(tail) != glyph_node) {
+// /*tex
+// Officially we don't need to check what we remove because it can be only one of
+// three, unless one creates one indendently (in \LUA). So, we just do check and
+// silently ignore bad code.
+// */
+// halfword p;
+// switch (code) {
+// case kern_item_code : if (node_type(tail) != kern_node ) { return; } else { break; }
+// case penalty_item_code : if (node_type(tail) != penalty_node) { return; } else { break; }
+// case skip_item_code : if (node_type(tail) != glue_node ) { return; } else { break; }
+// }
+// /*tex
+// There is some magic testing here that makes sure we don't mess up any discretionary
+// nodes. But why do we care?
+// */
+// do {
+// p = head;
+// if (p == tail && node_type(head) == disc_node) {
+// return;
+// } else {
+// head = node_next(p);
+// }
+// } while (head != tail);
+// node_next(p) = null;
+// tex_flush_node_list(tail);
+// cur_list.tail = p;
+// }
+ } else {
+ /*tex
+ Officially we don't need to check what we remove because it can be only one of
+ three, unless one creates one indendently (in \LUA). So, we just do check and
+ silently ignore bad code.
+ */
+ switch (node_type(tail)) {
+ case kern_node :
+ if (code == kern_item_code) {
+ break;
+ } else {
+ return;
+ }
+ case penalty_node :
+ if (code == penalty_item_code) {
+ break;
+ } else {
+ return;
+ }
+ case glue_node :
+ if (code == skip_item_code) {
+ break;
+ } else {
+ return;
+ }
+ case boundary_node :
+ if (node_subtype(tail) == user_boundary && code == boundary_item_code) {
+ break;
+ } else {
+ return;
+ }
+ default:
+ return;
+ }
+ {
+ /*tex
+ There is some magic testing here that makes sure we don't mess up any discretionary
+ nodes. But why do we care?
+ */
+ halfword p;
+ do {
+ p = head;
+ if (p == tail && node_type(head) == disc_node) {
+ return;
+ } else {
+ head = node_next(p);
+ }
+ } while (head != tail);
+ node_next(p) = null;
+ tex_flush_node_list(tail);
+ cur_list.tail = p;
+ }
+ }
+
+}
+
+/*tex
+
+ Italic corrections are converted to kern nodes when the |italic_correction| 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.
+
+*/
+
+static void tex_aux_run_text_italic_correction(void)
+{
+ halfword tail = cur_list.tail;
+ if (tail != cur_list.head && node_type(tail) == glyph_node) {
+ // tex_tail_append(tex_new_kern_node(tex_char_italic_from_font(glyph_font(tail), glyph_character(tail)), italic_kern));
+ tex_tail_append(tex_new_kern_node(tex_char_italic_from_glyph(tail), italic_kern_subtype)); /* scaled */
+ }
+}
+
+/*tex
+
+ 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 \over 2} (w-a) + h \cdot t - x \cdot s$. If either character is
+ absent from the font, we will simply use the other, without shifting.
+
+ While much is delegated to builders this is one of the few places where the action happens
+ directly. Of course, in a \UNICODE\ engine this command is not really relevant but here we
+ even extended it with optional offsets!
+
+*/
+
+static void tex_aux_run_text_accent(void)
+{
+ halfword fnt = cur_font_par;
+ halfword accent = null;
+ halfword base = null;
+ scaled xoffset = 0;
+ scaled yoffset = 0;
+ while (1) {
+ switch (tex_scan_character("xyXY", 0, 1, 0)) {
+ case 'x': case 'X':
+ if (tex_scan_mandate_keyword("xoffset", 1)) {
+ xoffset = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'y': case 'Y':
+ if (tex_scan_mandate_keyword("yoffset", 1)) {
+ yoffset = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ accent = tex_new_char_node(glyph_unset_subtype, fnt, tex_scan_char_number(0), 1);
+ if (accent) {
+ /*tex
+ Create a character node |q| for the next character, but set |q := null| if problems
+ arise.
+ */
+ scaled x = tex_get_scaled_ex_height(fnt);
+ double s = (double) (tex_get_font_slant(fnt)) / (double) (65536);
+ scaled a = tex_glyph_width(accent);
+ /*tex
+ Here we had |handle_assignments| which is a bit confusing one so we inlined it, probably
+ at the cost of some error recovery compatibility, which we don't worry too much about.
+ It looks like skipping spaces and relax is okay. The (original \TEX\ idea is that one
+ can change a font in between which is why the |fnt| variable gets set again. Because in
+ practice switching a font can involve more than assignments wd could be more tolerant
+ and often wrapping in |\localcontrolled| is more robust then.
+ */
+ /* handle_assignments(); */
+ fnt = cur_font_par;
+ PICKUP:
+ switch (cur_cmd) {
+ case spacer_cmd:
+ case relax_cmd:
+ tex_get_x_token();
+ goto PICKUP;
+ case letter_cmd:
+ case other_char_cmd:
+ case char_given_cmd:
+ base = tex_new_glyph_node(glyph_unset_subtype, fnt, cur_chr, accent);
+ break;
+ case char_number_cmd:
+ /* We don't accept keywords for |\glyph|. */
+ base = tex_new_glyph_node(glyph_unset_subtype, fnt, tex_scan_char_number(0), accent);
+ break;
+ default:
+ /* compatibility hack, not that useful nowadays */
+ if (cur_cmd <= max_non_prefixed_cmd) {
+ tex_back_input(cur_tok);
+ break;
+ } else {
+ lmt_error_state.set_box_allowed = 0;
+ tex_run_prefixed_command();
+ lmt_error_state.set_box_allowed = 0;
+ goto PICKUP;
+ }
+ }
+ if (base) {
+ /*tex
+ 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|.
+
+ This goes away: not listening to scaled yet.
+
+ */
+ double t = (double) (tex_get_font_slant(fnt)) / (double) (65536); /* amount of slant */
+ scaled w = tex_glyph_width(base);
+ scaled h = tex_glyph_height(base);
+ scaled delta = glueround((double) (w - a) / (double) (2) + h * t - x * s);
+ halfword left = tex_new_kern_node(delta, accent_kern_subtype);
+ halfword right = tex_new_kern_node(- a - delta, accent_kern_subtype);
+ glyph_x_offset(accent) = xoffset;
+ glyph_y_offset(accent) = yoffset;
+ if (h != x) {
+ /*tex the accent must be shifted up or down */
+ // accent = hpack(accent, 0, packing_additional, direction_unknown);
+ // box_shift_amount(accent) = x - h;
+ glyph_y_offset(accent) += x - h;
+ }
+ tex_couple_nodes(cur_list.tail, left);
+ tex_couple_nodes(left, accent);
+ tex_couple_nodes(accent, right);
+ tex_couple_nodes(right,base);
+ cur_list.tail = base;
+ } else {
+ tex_couple_nodes(cur_list.tail, accent);
+ cur_list.tail = accent;
+ }
+ cur_list.space_factor = default_space_factor;
+ }
+}
+
+/*tex Finally, |\endcsname| is not supposed to get through to |main_control|. */
+
+static void tex_aux_run_cs_error(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Extra \\endcsname",
+ "I'm ignoring this, since I wasn't doing a \\csname."
+ );
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_inject_text_or_line_dir(int val, int check_glue)
+{
+ if (cur_mode == hmode && internal_dir_state_par > 0) {
+ /*tex |tail| is non zero but we test anyway. */
+ halfword dirn = tex_new_dir(cancel_dir_subtype, text_direction_par);
+ halfword tail = cur_list.tail;
+ if (check_glue && tail && node_type(tail) == glue_node) {
+ halfword prev = node_prev(tail);
+ tex_couple_nodes(prev, dirn);
+ tex_couple_nodes(dirn, tail);
+ } else {
+ tex_tail_append(dirn);
+ }
+ }
+ tex_push_text_dir_ptr(val);
+ if (cur_mode == hmode) {
+ halfword dir = tex_new_dir(normal_dir_subtype, val);
+ dir_level(dir) = cur_level;
+ tex_tail_append(dir);
+ }
+}
+
+static void tex_aux_show_frozen_error(halfword cs)
+{
+ if (cs) {
+ tex_handle_error(
+ normal_error_type,
+ "You can't redefine the frozen macro %S.", cs,
+ NULL
+ );
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "You can't redefine a frozen macro.",
+ NULL
+ );
+
+ }
+}
+
+/*tex
+
+ We use the fact that |register| $<$ |advance| $<$ |multiply| $<$ |divide| We 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.
+
+*/
+
+inline static halfword tex_aux_get_register_index(int level)
+{
+ switch (level) {
+ case int_val_level:
+ {
+ halfword index = tex_scan_int_register_number();
+ return register_int_location(index);
+ }
+ case dimen_val_level:
+ {
+ halfword index = tex_scan_dimen_register_number();
+ return register_dimen_location(index);
+ }
+ case attr_val_level:
+ {
+ halfword index = tex_scan_attribute_register_number();
+ return register_attribute_location(index);
+ }
+ case glue_val_level:
+ {
+ halfword index = tex_scan_glue_register_number();
+ return register_glue_location(index);
+ }
+ case mu_val_level:
+ {
+ halfword index = tex_scan_mu_glue_register_number();
+ return register_mu_glue_location(index);
+ }
+ case tok_val_level:
+ {
+ halfword index = tex_scan_toks_register_number();
+ return register_toks_location(index);
+ }
+ default:
+ return 0;
+ }
+}
+
+inline static halfword tex_aux_get_register_value(int level, int optionalequal)
+{
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ return tex_scan_int(optionalequal, NULL);
+ case dimen_val_level:
+ return tex_scan_dimen(0, 0, 0, optionalequal, NULL);
+ default:
+ return tex_scan_glue(level, optionalequal);
+ }
+}
+
+static int tex_aux_valid_arithmic(int cmd, int *index, int *level, int *varcmd)
+{
+ /*tex So: |\multiply|, |\divide| or |\advance|. */
+ tex_get_x_token();
+ *varcmd = cur_cmd;
+ switch (cur_cmd) {
+ case register_int_cmd:
+ case internal_int_cmd:
+ *index = cur_chr;
+ *level = int_val_level;
+ return 1;
+ case register_attribute_cmd:
+ case internal_attribute_cmd:
+ *index = cur_chr;
+ *level = attr_val_level;
+ return 1;
+ case register_dimen_cmd:
+ case internal_dimen_cmd:
+ *index = cur_chr;
+ *level = dimen_val_level;
+ return 1;
+ case register_glue_cmd:
+ case internal_glue_cmd:
+ *index = cur_chr;
+ *level = glue_val_level;
+ return 1;
+ case register_mu_glue_cmd:
+ case internal_mu_glue_cmd:
+ *index = cur_chr;
+ *level = mu_val_level;
+ return 1;
+ case register_cmd:
+ *level = cur_chr;
+ *index = tex_aux_get_register_index(*level);
+ return 1;
+ default:
+ tex_handle_error(
+ normal_error_type,
+ "You can't use '%C' after %C",
+ cur_cmd, cur_chr, cmd, 0,
+ "I'm forgetting what you said and not changing anything."
+ );
+ return 0;
+ }
+}
+
+static void tex_aux_arithmic_overflow_error(int level, halfword value)
+{
+ if (level >= glue_val_level) {
+ tex_flush_node(value);
+ }
+ tex_handle_error(
+ normal_error_type,
+ "Arithmetic overflow",
+ "I can't carry out that multiplication or division, since the result is out of\n"
+ "range."
+ );
+}
+
+inline static void tex_aux_update_register(int a, int level, halfword index, halfword value, halfword cmd)
+{
+ switch (level) {
+ case int_val_level:
+ tex_word_define(a, index, value);
+ if (is_frozen(a) && cmd == internal_int_cmd && cur_mode == hmode) {
+ tex_update_par_par(internal_int_cmd, index - lmt_primitive_state.prim_data[cmd].offset);
+ }
+ break;
+ case attr_val_level:
+ if ((register_attribute_number(index)) > lmt_node_memory_state.max_used_attribute) {
+ lmt_node_memory_state.max_used_attribute = register_attribute_number(index);
+ }
+ change_attribute_register(a, index, value);
+ tex_word_define(a, index, value);
+ break;
+ case dimen_val_level:
+ tex_word_define(a, index, value);
+ if (is_frozen(a) && cmd == internal_dimen_cmd && cur_mode == hmode) {
+ tex_update_par_par(internal_dimen_cmd, index - lmt_primitive_state.prim_data[cmd].offset);
+ }
+ break;
+ case glue_val_level:
+// tex_define(a, index, register_glue_reference_cmd, value);
+ tex_define(a, index, cmd == internal_glue_cmd ? internal_glue_reference_cmd : register_glue_reference_cmd, value);
+ if (is_frozen(a) && cmd == internal_glue_cmd && cur_mode == hmode) {
+ tex_update_par_par(internal_glue_cmd, index - lmt_primitive_state.prim_data[cmd].offset);
+ }
+ break;
+ case mu_val_level:
+// tex_define(a, index, register_glue_reference_cmd, value);
+ tex_define(a, index, cmd == internal_glue_cmd ? internal_mu_glue_reference_cmd : register_mu_glue_reference_cmd, value);
+ break;
+ default:
+ /* can't happen */
+ tex_word_define(a, index, value);
+ break;
+ }
+}
+
+static void tex_aux_set_register(int a)
+{
+ halfword level = cur_chr;
+ halfword varcmd = cur_cmd;
+ halfword index = tex_aux_get_register_index(level);
+ halfword value = tex_aux_get_register_value(level, 1);
+ tex_aux_update_register(a, level, index, value, varcmd);
+}
+
+static void tex_aux_arithmic_register(int a, int code)
+{
+ halfword cmd = cur_cmd;
+ halfword level = cur_chr;
+ halfword index = 0;
+ halfword varcmd = 0;
+ if (tex_aux_valid_arithmic(cmd, &index, &level, &varcmd)) {
+ halfword value = null;
+ tex_scan_optional_keyword("by");
+ lmt_scanner_state.arithmic_error = 0;
+ switch (code) {
+ case advance_code:
+ {
+ value = tex_aux_get_register_value(level, 0);
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ case dimen_val_level:
+ value += eq_value(index);
+ break;
+ case glue_val_level:
+ case mu_val_level:
+ {
+ /* Compute the sum of two glue specs */
+ halfword oldvalue = eq_value(index);
+ halfword newvalue = tex_new_glue_spec_node(value);
+ tex_flush_node(value);
+ glue_amount(newvalue) += glue_amount(oldvalue);
+ if (glue_stretch(newvalue) == 0) {
+ glue_stretch_order(newvalue) = normal_glue_order;
+ }
+ if (glue_stretch_order(newvalue) == glue_stretch_order(oldvalue)) {
+ glue_stretch(newvalue) += glue_stretch(oldvalue);
+ } else if ((glue_stretch_order(newvalue) < glue_stretch_order(oldvalue)) && (glue_stretch(oldvalue))) {
+ glue_stretch(newvalue) = glue_stretch(oldvalue);
+ glue_stretch_order(newvalue) = glue_stretch_order(oldvalue);
+ }
+ if (glue_shrink(newvalue) == 0) {
+ glue_shrink_order(newvalue) = normal_glue_order;
+ }
+ if (glue_shrink_order(newvalue) == glue_shrink_order(oldvalue)) {
+ glue_shrink(newvalue) += glue_shrink(oldvalue);
+ } else if ((glue_shrink_order(newvalue) < glue_shrink_order(oldvalue)) && (glue_shrink(oldvalue))) {
+ glue_shrink(newvalue) = glue_shrink(oldvalue);
+ glue_shrink_order(newvalue) = glue_shrink_order(oldvalue);
+ }
+ value = newvalue;
+ break;
+ }
+ default:
+ /* error */
+ break;
+ }
+ /*tex There is no overflow detection for addition, just wraparound. */
+ tex_aux_update_register(a, level, index, value, varcmd);
+ break;
+ }
+ case multiply_code:
+ {
+ halfword amount = tex_scan_int(0, NULL);
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ value = tex_multiply_integers(eq_value(index), amount);
+ break;
+ case dimen_val_level:
+ value = tex_nx_plus_y(eq_value(index), amount, 0);
+ break;
+ case glue_val_level:
+ case mu_val_level:
+ {
+ halfword s = eq_value(index);
+ halfword r = tex_new_glue_spec_node(s);
+ glue_amount(r) = tex_nx_plus_y(glue_amount(s), amount, 0);
+ glue_stretch(r) = tex_nx_plus_y(glue_stretch(s), amount, 0);
+ glue_shrink(r) = tex_nx_plus_y(glue_shrink(s), amount, 0);
+ value = r;
+ break;
+ }
+ default:
+ /* error */
+ break;
+ }
+ if (lmt_scanner_state.arithmic_error) {
+ tex_aux_arithmic_overflow_error(level, value);
+ } else {
+ tex_aux_update_register(a, level, index, value, varcmd);
+ }
+ break;
+ }
+ case divide_code:
+ {
+ halfword amount = tex_scan_int(0, NULL);
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ case dimen_val_level:
+ value = tex_x_over_n(eq_value(index), amount);
+ break;
+ case glue_val_level:
+ case mu_val_level:
+ {
+ halfword s = eq_value(index);
+ halfword r = tex_new_glue_spec_node(s);
+ glue_amount(r) = tex_x_over_n(glue_amount(s), amount);
+ glue_stretch(r) = tex_x_over_n(glue_stretch(s), amount);
+ glue_shrink(r) = tex_x_over_n(glue_shrink(s), amount);
+ value = r;
+ break;
+ }
+ default:
+ /* error */
+ break;
+ }
+ if (lmt_scanner_state.arithmic_error) {
+ tex_aux_arithmic_overflow_error(level, value);
+ } else {
+ tex_aux_update_register(a, level, index, value, varcmd);
+ }
+ break;
+ }
+ }
+ }
+}
+
+/*tex
+ The value of |c| is 0 for |\deadcycles|, 1 for |\insertpenalties|, etc. In traditional \TEX\
+ the interaction mode is set by primitives so no checking is needed. However, in \ETEX\ the
+ value can be set. As a consequence there is an error message for wrong values but here we
+ just clip the values. After all, we can also set values from \LUA\ so either we bark or we
+ just recover. So, gone is:
+
+ \starttyping
+ handle_error_int(
+ normal_error_type,
+ "Bad interaction mode (", val, ")",
+ "Modes are 0=batch, 1=nonstop, 2=scroll, and 3=errorstop. Proceed, and I'll ignore\n"
+ "this case."
+ );
+ \stoptyping
+
+ I could have decided to ignore bad values but clipping is probably better.
+
+*/
+
+inline static void tex_aux_set_interaction(halfword mode)
+{
+ tex_print_ln();
+ if (mode < batch_mode) {
+ lmt_error_state.interaction = batch_mode;
+ } else if (mode > error_stop_mode) {
+ lmt_error_state.interaction = error_stop_mode;
+ } else {
+ lmt_error_state.interaction = mode;
+ }
+ tex_fixup_selector(lmt_fileio_state.log_opened);
+}
+
+static void tex_aux_set_page_property(void)
+{
+ switch (cur_chr) {
+ case page_goal_code:
+ lmt_page_builder_state.goal = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ case page_vsize_code:
+ lmt_page_builder_state.vsize = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ case page_total_code:
+ lmt_page_builder_state.total = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ case page_depth_code:
+ lmt_page_builder_state.depth = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ case dead_cycles_code:
+ lmt_page_builder_state.dead_cycles = tex_scan_int(1, NULL);
+ break;
+ case insert_penalties_code:
+ lmt_page_builder_state.insert_penalties = tex_scan_int(1, NULL);
+ break;
+ case insert_heights_code:
+ lmt_page_builder_state.insert_heights = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ case insert_storing_code:
+ lmt_insert_state.storing = tex_scan_int(1, NULL);
+ break;
+ case insert_distance_code:
+ {
+ /*tex
+ We need to scan the index first because when we do that in the call we somehow
+ get an out-of-order issue (index too large). The same is true for teh rest.
+ */
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_distance(index, tex_scan_glue(glue_val_level, 1));
+ }
+ break;
+ case insert_multiplier_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_multiplier(index, tex_scan_int(1, NULL));
+ }
+ break;
+ case insert_limit_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_limit(index, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+ break;
+ case insert_storage_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_storage(index, tex_scan_int(1, NULL));
+ }
+ break;
+ case insert_penalty_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_penalty(index, tex_scan_int(1, NULL));
+ }
+ break;
+ case insert_maxdepth_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_maxdepth(index, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+ break;
+ case insert_height_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_height(index, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+ break;
+ case insert_depth_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_depth(index, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+ break;
+ case insert_width_code:
+ {
+ int index = tex_scan_int(0, NULL);
+ tex_set_insert_width(index, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+ break;
+ default:
+ lmt_page_builder_state.page_so_far[page_state_offset(cur_chr)] = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ }
+}
+
+/*tex
+ 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.
+*/
+
+static void tex_aux_set_auxiliary(int a)
+{
+ (void) a;
+ switch (cur_chr) {
+ case space_factor_code:
+ if (cur_mode == hmode) {
+ halfword v = tex_scan_int(1, NULL);
+ if ((v <= min_space_factor) || (v > max_space_factor)) {
+ tex_handle_error(
+ normal_error_type,
+ "Bad space factor (%i). I allow only values in the range %i..%i here.",
+ v, min_space_factor + 1, max_space_factor,
+ NULL
+ );
+ } else {
+ cur_list.space_factor = v;
+ }
+ } else {
+ tex_aux_run_illegal_case();
+ }
+ break;
+ case prev_depth_code:
+ if (cur_mode == vmode) {
+ cur_list.prev_depth = tex_scan_dimen(0, 0, 0, 1, NULL);
+ } else {
+ tex_aux_run_illegal_case();
+ }
+ break;
+ case prev_graf_code:
+ {
+ halfword v = tex_scan_int(1, NULL);
+ if (v >= 0) {
+ lmt_nest_state.nest[tex_vmode_nest_index()].prev_graf = v;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Bad \\prevgraf (%i)",
+ v,
+ "I allow only nonnegative values here."
+ );
+ }
+ break;
+ }
+ case interaction_mode_code:
+ {
+ tex_aux_set_interaction(tex_scan_int(1, NULL));
+ break;
+ }
+ case insert_mode_code:
+ {
+ tex_set_insert_mode(tex_scan_int(1, NULL));
+ break;
+ }
+ }
+}
+
+/*tex
+ When some dimension of a box register is changed, the change isn't exactly global; but \TEX\
+ does not look at the |\global| switch.
+*/
+
+static void tex_aux_set_box_property(void)
+{
+ halfword code = cur_chr;
+ halfword n = tex_scan_box_register_number();
+ halfword b = box_register(n);
+ switch (code) {
+ case box_width_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_width(b) = v;
+ }
+ break;
+ }
+ case box_height_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_height(b) = v;
+ }
+ break;
+ }
+ case box_depth_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_depth(b) = v;
+ }
+ break;
+ }
+ case box_direction_code:
+ {
+ halfword v = tex_scan_direction(1);
+ if (b) {
+ tex_set_box_direction(b, v);
+ }
+ break;
+ }
+ case box_geometry_code:
+ {
+ halfword v = tex_scan_geometry(1);
+ if (b) {
+ box_geometry(b) = (singleword) v;
+ }
+ break;
+ }
+ case box_orientation_code:
+ {
+ halfword v = tex_scan_orientation(1);
+ if (b) {
+ box_orientation(b) = v;
+ tex_set_box_geometry(b, orientation_geometry);
+ }
+ break;
+ }
+ case box_anchor_code:
+ case box_anchors_code:
+ {
+ halfword v = code == box_anchor_code ? tex_scan_anchor(1) : tex_scan_anchors(1);
+ if (b) {
+ box_anchor(b) = v;
+ tex_set_box_geometry(b, anchor_geometry);
+ }
+ break;
+ }
+ case box_source_code:
+ {
+ halfword v = tex_scan_int(1, NULL);
+ if (b) {
+ box_source_anchor(b) = v;
+ tex_set_box_geometry(b, anchor_geometry);
+ }
+ break;
+ }
+ case box_target_code:
+ {
+ halfword v = tex_scan_int(1, NULL);
+ if (b) {
+ box_target_anchor(b) = v;
+ tex_set_box_geometry(b, anchor_geometry);
+ }
+ break;
+ }
+ case box_xoffset_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_x_offset(b) = v;
+ tex_set_box_geometry(b, offset_geometry);
+ }
+ break;
+ }
+ case box_yoffset_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_y_offset(b) = v;
+ tex_set_box_geometry(b, offset_geometry);
+ }
+ break;
+ }
+ case box_xmove_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_x_offset(b) = tex_aux_checked_dimen1(box_x_offset(b) + v);
+ box_width(b) = tex_aux_checked_dimen2(box_width(b) + v);
+ tex_set_box_geometry(b, offset_geometry);
+ }
+ break;
+ }
+ case box_ymove_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_y_offset(b) = tex_aux_checked_dimen1(box_y_offset(b) + v);
+ box_height(b) = tex_aux_checked_dimen2(box_height(b) + v);
+ box_depth(b) = tex_aux_checked_dimen2(box_depth(b) - v);
+ tex_set_box_geometry(b, offset_geometry);
+ }
+ break;
+ }
+ case box_total_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_height(b) = v / 2;
+ box_depth(b) = v - (v / 2);
+ }
+ }
+ break;
+ case box_shift_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ box_shift_amount(b) = v;
+ }
+ }
+ break;
+ case box_adapt_code:
+ {
+ scaled v = tex_scan_limited_scale(1);
+ if (b) {
+ tex_repack(b, v, packing_adapted);
+ }
+ }
+ break;
+ case box_repack_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ if (b) {
+ tex_repack(b, v, packing_additional);
+ }
+ }
+ break;
+ case box_freeze_code:
+ {
+ scaled v = tex_scan_int(1, NULL);
+ if (b) {
+ tex_freeze(b, v);
+ }
+ }
+ break;
+ case box_attribute_code:
+ {
+ halfword att = tex_scan_box_register_number();
+ halfword val = tex_scan_int(1, NULL);
+ if (b) {
+ if (val == unused_attribute_value) {
+ tex_unset_attribute(b, att, val);
+ } else {
+ tex_set_attribute(b, att, val);
+ }
+ }
+ }
+ break;
+ default:
+ break;
+ }
+}
+
+/*tex
+ 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.
+*/
+
+static void tex_aux_set_box(int a)
+{
+ halfword n = tex_scan_box_register_number() + (is_global(a) ? global_box_flag : box_flag);
+ if (lmt_error_state.set_box_allowed) {
+ tex_aux_scan_box(n, 1, null_flag);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Improper \\setbox",
+ "Sorry, \\setbox is not allowed after \\halign in a display, between \\accent and\n"
+ "an accented character, or in immediate assignments."
+ );
+ }
+}
+
+/*tex
+ 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 \quote {undefined control
+ sequence} error or expanding the previous meaning. This allows, for instance, |\chardef
+ \foo = 123\foo|.
+*/
+
+static void tex_aux_set_shorthand_def(int a, int force)
+{
+ halfword code = cur_chr;
+ tex_get_r_token();
+ if (force || tex_define_permitted(cur_cs, a)) {
+ halfword p = cur_cs;
+ tex_define(a, p, relax_cmd, relax_code);
+ tex_scan_optional_equals();
+ switch (code) {
+ case char_def_code:
+ {
+ halfword chr = tex_scan_char_number(0); /* maybe 1 */
+ tex_define(a, p, char_given_cmd, chr);
+ break;
+ }
+ case math_char_def_code:
+ {
+ mathcodeval mval = tex_scan_mathchar(tex_mathcode);
+ tex_define(a, p, mathspec_cmd, tex_new_math_spec(mval, tex_mathcode));
+ // tex_define(a, p, math_char_given_cmd, math_old_packed_character(mval.class_value,mval.family_value,mval.character_value));
+ break;
+ }
+ case math_dchar_def_code:
+ {
+ mathdictval dval = tex_scan_mathdict();
+ mathcodeval mval = tex_scan_mathchar(umath_mathcode);
+ tex_define(a, p, mathspec_cmd, tex_new_math_dict_spec(dval, mval, umath_mathcode));
+ // tex_define(a, p, math_char_xgiven_cmd, math_packed_character(mval.class_value,mval.family_value,mval.character_value));
+ break;
+ }
+ case math_xchar_def_code:
+ {
+ mathcodeval mval = tex_scan_mathchar(umath_mathcode);
+ tex_define(a, p, mathspec_cmd, tex_new_math_spec(mval, umath_mathcode));
+ // tex_define(a, p, math_char_xgiven_cmd, math_packed_character(mval.class_value,mval.family_value,mval.character_value));
+ break;
+ }
+ /*
+ case math_uchar_def_code:
+ {
+ mathcodeval mval = tex_scan_mathchar(umathnum_mathcode);
+ tex_define(a, p, mathspec_cmd, tex_new_math_spec(mval, umathnum_mathcode));
+ // tex_define(a, p, math_char_xgiven_cmd, math_packed_character(mval.class_value,mval.family_value,mval.character_value));
+ break;
+ }
+ */
+ case count_def_code:
+ {
+ halfword n = tex_scan_int_register_number();
+ tex_define(a, p, register_int_cmd, register_int_location(n));
+ break;
+ }
+ case attribute_def_code:
+ {
+ halfword n = tex_scan_attribute_register_number();
+ tex_define(a, p, register_attribute_cmd, register_attribute_location(n));
+ break;
+ }
+ case dimen_def_code:
+ {
+ scaled n = tex_scan_dimen_register_number();
+ tex_define(a, p, register_dimen_cmd, register_dimen_location(n));
+ break;
+ }
+ case skip_def_code:
+ {
+ halfword n = tex_scan_glue_register_number();
+ tex_define(a, p, register_glue_cmd, register_glue_location(n));
+ break;
+ }
+ case mu_skip_def_code:
+ {
+ halfword n = tex_scan_mu_glue_register_number();
+ tex_define(a, p, register_mu_glue_cmd, register_mu_glue_location(n));
+ break;
+ }
+ case toks_def_code:
+ {
+ halfword n = tex_scan_toks_register_number();
+ tex_define(a, p, register_toks_cmd, register_toks_location(n));
+ break;
+ }
+ case lua_def_code:
+ {
+ halfword v = tex_scan_function_reference(1);
+ tex_define(a, p, is_protected(a) ? lua_protected_call_cmd : lua_call_cmd, v);
+ }
+ break;
+ case integer_def_code:
+ {
+ halfword v = tex_scan_int(1, NULL);
+ tex_define(a, p, integer_cmd, v);
+ }
+ break;
+ case dimension_def_code:
+ {
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ tex_define(a, p, dimension_cmd, v);
+ }
+ break;
+ case gluespec_def_code:
+ {
+ halfword v = tex_scan_glue(glue_val_level, 1);
+ tex_define(a, p, gluespec_cmd, v);
+ }
+ break;
+ case mugluespec_def_code:
+ {
+ halfword v = tex_scan_glue(mu_val_level, 1);
+ tex_define(a, p, mugluespec_cmd, v);
+ }
+ break;
+ /*
+ case mathspec_def_code:
+ {
+ halfword v = tex_scan_math_spec(1);
+ tex_define(a, p, mathspec_cmd, v);
+ }
+ break;
+ */
+ case fontspec_def_code:
+ {
+ halfword v = tex_scan_font(1);
+ tex_define(a, p, fontspec_cmd, v);
+ }
+ break;
+ /*
+ case string_def_code:
+ {
+ halfword t = scan_toks_expand(0, NULL);
+ halfword s = tokens_to_string(t);
+ define(a, p, string_cmd, s - cs_offset_value);
+ flush_list(t);
+ break;
+ }
+ */
+ default:
+ tex_confusion("shorthand definition");
+ break;
+ }
+ }
+}
+
+/*tex This deals with the shapes and penalty lists: */
+
+static void tex_aux_set_specification(int a)
+{
+ halfword loc = cur_chr;
+ quarterword num = (quarterword) internal_specification_number(loc);
+ halfword p = null;
+ halfword options = 0;
+ halfword count = tex_scan_int(1, NULL);
+ if (tex_scan_keyword("options")) {
+ options = tex_scan_int(0, NULL);
+ }
+ if (count > 0) {
+ p = tex_new_specification_node(count, num, options);
+ if (num == par_shape_code) {
+ for (int j = 1; j <= count; j++) {
+ tex_set_specification_indent(p, j, tex_scan_dimen(0, 0, 0, 0, NULL)); /*tex indentation */
+ tex_set_specification_width(p, j, tex_scan_dimen(0, 0, 0, 0, NULL)); /*tex width */
+ }
+ } else {
+ for (int j = 1; j <= count; j++) {
+ tex_set_specification_penalty(p, j, tex_scan_int(0, NULL)); /*tex penalty values */
+ }
+ }
+ }
+ tex_define(a, loc, specification_reference_cmd, p);
+ if (is_frozen(a) && cur_mode == hmode) {
+ tex_update_par_par(specification_reference_cmd, num);
+ }
+}
+
+/*tex
+ All of \TEX's parameters are kept in |eqtb| except the font and language information, including
+ the hyphenation tables; these are strictly global.
+*/
+
+static void tex_aux_set_hyph_data(void)
+{
+ switch (cur_chr) {
+ case hyphenation_code:
+ tex_scan_toks_expand(0, NULL, 0);
+ tex_load_tex_hyphenation(language_par, lmt_input_state.def_ref); /* hm, why not use return value */
+ tex_flush_token_list(lmt_input_state.def_ref);
+ break;
+ case patterns_code:
+ tex_scan_toks_expand(0, NULL, 0);
+ tex_load_tex_patterns(language_par, lmt_input_state.def_ref); /* hm, why not use return value */
+ tex_flush_token_list(lmt_input_state.def_ref);
+ break;
+ case prehyphenchar_code:
+ tex_set_pre_hyphen_char(language_par, tex_scan_int(1, NULL));
+ break;
+ case posthyphenchar_code:
+ tex_set_post_hyphen_char(language_par, tex_scan_int(1, NULL));
+ break;
+ case preexhyphenchar_code:
+ tex_set_pre_exhyphen_char(language_par, tex_scan_int(1, NULL));
+ break;
+ case postexhyphenchar_code:
+ tex_set_post_exhyphen_char(language_par, tex_scan_int(1, NULL));
+ break;
+ case hyphenationmin_code:
+ tex_set_hyphenation_min(language_par, tex_scan_int(1, NULL));
+ break;
+ case hjcode_code:
+ {
+ halfword lan = tex_scan_int(0, NULL);
+ halfword val = tex_scan_int(1, NULL);
+ tex_set_hj_code(language_par, lan, val, -1);
+ }
+ break;
+ default:
+ break;
+ }
+}
+
+/*tex move to font */
+
+static void tex_aux_set_font_property(void)
+{
+ halfword code = cur_chr;
+ switch (code) {
+ case font_hyphen_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword val = tex_scan_int(1, NULL);
+ set_font_hyphen_char(fnt, val);
+ break;
+ }
+ case font_skew_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword val = tex_scan_int(1, NULL);
+ set_font_skew_char(fnt, val);
+ break;
+ }
+ case font_lp_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_dimen(0, 0, 0, 1, NULL);
+ tex_set_lpcode_in_font(fnt, chr, val);
+ break;
+ }
+ case font_rp_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_dimen(0, 0, 0, 1, NULL);
+ tex_set_rpcode_in_font(fnt, chr, val);
+ break;
+ }
+ case font_ef_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_int(1, NULL);
+ tex_set_efcode_in_font(fnt, chr, val);
+ break;
+ }
+ case font_dimen_code:
+ {
+ tex_set_font_dimen();
+ break;
+ }
+ case scaled_font_dimen_code:
+ {
+ tex_set_scaled_font_dimen();
+ break;
+ }
+ default:
+ break;
+ }
+}
+
+/*tex
+ Here is where the information for a new font gets loaded. We start with fonts. Unfortunately,
+ they aren't all as simple as this.
+*/
+
+static void tex_aux_set_font(int a)
+{
+ tex_set_cur_font(a, cur_chr);
+}
+
+static void tex_aux_set_define_font(int a)
+{
+ if (! tex_tex_def_font(a)) {
+ tex_aux_show_frozen_error(cur_cs);
+ }
+}
+
+/*tex
+ 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. Remark: this is
+ different in \LUAMETATEX.
+*/
+
+static void tex_aux_set_def(int a, int force)
+{
+ halfword expand = 0;
+ switch (cur_chr) {
+ case expanded_def_code:
+ expand = 1;
+ break;
+ case def_code:
+ break;
+ case global_expanded_def_code:
+ expand = 1;
+ // fall through
+ case global_def_code:
+ a = add_global_flag(a);
+ break;
+ case expanded_def_csname_code:
+ expand = 1;
+ // fall through
+ case def_csname_code:
+ cur_cs = tex_create_csname();
+ goto DONE;
+ case global_expanded_def_csname_code:
+ expand = 1;
+ // fall through
+ case global_def_csname_code:
+ cur_cs = tex_create_csname();
+ a = add_global_flag(a);
+ goto DONE;
+ }
+ tex_get_r_token();
+ DONE:
+ if (global_defs_par > 0) {
+ a = add_global_flag(a);
+ }
+ if (force || tex_define_permitted(cur_cs, a)) {
+ halfword p = cur_cs;
+ halfword t = expand ? tex_scan_macro_expand() : tex_scan_macro_normal();
+ tex_define(a, p, tex_flags_to_cmd(a), t);
+ }
+}
+
+static void tex_aux_set_let(int a, int force)
+{
+ halfword code = cur_chr;
+ halfword p = null;
+ halfword q = null;
+ switch (code) {
+ case global_let_code:
+ /*tex |\glet| */
+ if (global_defs_par >= 0) {
+ a = add_global_flag(a);
+ }
+ // fall through
+ case let_code:
+ /*tex |\let| */
+ // LET:
+ tex_get_r_token();
+ LETINDEED:
+ if (force || tex_define_permitted(cur_cs, a)) {
+ p = cur_cs;
+ do {
+ tex_get_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok == equal_token) {
+ tex_get_token();
+ if (cur_cmd == spacer_cmd) {
+ tex_get_token();
+ }
+ }
+ }
+ break;
+ case future_let_code:
+ case future_def_code:
+ /*tex |\futurelet| */
+ tex_get_r_token();
+ /*tex
+ Checking for a frozen macro here is tricky but not doing it would be kind of weird.
+ */
+ if (force || tex_define_permitted(cur_cs, a)) {
+ p = cur_cs;
+ q = tex_get_token();
+ tex_back_input(tex_get_token());
+ /*tex
+ We look ahead and then back up. Note that |back_input| doesn't affect |cur_cmd|,
+ |cur_chr|.
+ */
+ tex_back_input(q);
+ if (code == future_def_code) {
+ halfword result = get_reference_token();
+ halfword r = result;
+ r = tex_store_new_token(r, cur_tok);
+ cur_cmd = tex_flags_to_cmd(a);
+ cur_chr = result;
+ }
+ }
+ break;
+ case let_charcode_code:
+ /*tex |\letcharcode| (todo: protection) */
+ {
+ halfword v = tex_scan_int(0, NULL);
+ if (v > 0) {
+ p = tex_active_to_cs(v, 1);
+ do {
+ tex_get_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok == equal_token) {
+ tex_get_token();
+ if (cur_cmd == spacer_cmd) {
+ tex_get_token();
+ }
+ }
+ } else {
+ p = null;
+ tex_handle_error(
+ normal_error_type,
+ "invalid number for \\letcharcode",
+ NULL
+ );
+ }
+ break;
+ }
+ case swap_cs_values_code:
+ {
+ /*tex
+ There is no real gain in performance but it looks nicer when tracing when we
+ just swap natively (like no save and restore of a temporary variable and
+ such). Maybe we should be more restrictive but it's a cheap experiment anyway.
+
+ Flags should match and should not contain permanent, primitive or immutable.
+ */
+ halfword s1, s2;
+ tex_get_r_token();
+ s1 = cur_cs;
+ tex_get_r_token();
+ s2 = cur_cs;
+ tex_define_swapped(a, s1, s2, force);
+ return;
+ }
+ case let_protected_code:
+ tex_get_r_token();
+ if (force || tex_define_permitted(cur_cs, a)) {
+ switch (cur_cmd) {
+ case call_cmd:
+ case semi_protected_call_cmd:
+ set_eq_type(cur_cs, protected_call_cmd);
+ break;
+ case tolerant_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ set_eq_type(cur_cs, tolerant_protected_call_cmd);
+ break;
+ }
+ }
+ return;
+ case unlet_protected_code:
+ tex_get_r_token();
+ if (force || tex_define_permitted(cur_cs, a)) {
+ switch (cur_cmd) {
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ set_eq_type(cur_cs, call_cmd);
+ break;
+ case tolerant_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ set_eq_type(cur_cs, tolerant_call_cmd);
+ break;
+ }
+ }
+ return;
+ case let_frozen_code:
+ tex_get_r_token();
+ if (is_call_cmd(cur_cmd) && (force || tex_define_permitted(cur_cs, a))) {
+ set_eq_flag(cur_cs, add_frozen_flag(eq_flag(cur_cs)));
+ }
+ return;
+ case unlet_frozen_code:
+ tex_get_r_token();
+ if (is_call_cmd(cur_cmd) && (force || tex_define_permitted(cur_cs, a))) {
+ set_eq_flag(cur_cs, remove_frozen_flag(eq_flag(cur_cs)));
+ }
+ return;
+ case global_let_csname_code:
+ if (global_defs_par >= 0) {
+ a = add_global_flag(a);
+ }
+ // fall through
+ case let_csname_code:
+ cur_cs = tex_create_csname();
+ goto LETINDEED;
+ case global_let_to_nothing_code:
+ a = add_global_flag(a);
+ // fall through
+ case let_to_nothing_code:
+ tex_get_r_token();
+ if (global_defs_par > 0) {
+ a = add_global_flag(a);
+ }
+ if (force || tex_define_permitted(cur_cs, a)) {
+ tex_define(a, cur_cs, tex_flags_to_cmd(a), get_reference_token());
+ }
+ return;
+ default:
+ /*tex We please the compiler. */
+ p = null;
+ tex_confusion("let");
+ break;
+ }
+ if (is_referenced_cmd(cur_cmd)) {
+ tex_add_token_reference(cur_chr);
+ } else if (is_nodebased_cmd(cur_cmd)) {
+ cur_chr = tex_copy_node(cur_chr);
+ }
+ // if (p && cur_cmd >= relax_cmd) {
+ if (p && cur_cmd >= 0) {
+ singleword oldf = eq_flag(cur_cs);
+ singleword newf = 0;
+ singleword cmd = (singleword) cur_cmd;
+ if (is_aliased(a)) {
+ newf = oldf;
+ } else {
+ oldf = remove_overload_flags(oldf);
+ newf = oldf | make_eq_flag_bits(a);
+ }
+ if (is_protected(a)) {
+ switch (cmd) {
+ case call_cmd:
+ cmd = protected_call_cmd;
+ break;
+ case tolerant_call_cmd:
+ cmd = tolerant_protected_call_cmd;
+ break;
+ }
+ }
+ tex_define_inherit(a, p, (singleword) newf, (singleword) cmd, cur_chr);
+ } else {
+ tex_define(a, p, (singleword) cur_cmd, cur_chr);
+ }
+}
+
+/*tex
+ 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.)
+*/
+
+static void tex_aux_set_assign_toks(int a) // better just pass cmd and chr
+{
+ halfword cs = cur_cs;
+ halfword cmd = cur_cmd;
+ halfword chr;
+ halfword loc;
+ halfword tail;
+ if (cmd == register_cmd) {
+ loc = register_toks_location(tex_scan_toks_register_number());
+ } else {
+ /*tex |every_par_loc| or |output_routine_loc| or \dots */
+ loc = cur_chr;
+ }
+ /*tex
+ Skip an optional equal sign and get the next non-blank non-relax non-call token.
+ */
+ {
+ int n = 1 ;
+ while (1) {
+ tex_get_x_token();
+ if (cur_cmd == spacer_cmd) {
+ /*tex Go on! */
+ } else if (cur_cmd == relax_cmd) {
+ n = 0;
+ } else if (n && cur_tok == equal_token) {
+ n = 0;
+ } else {
+ break;
+ }
+ }
+ }
+ if (cur_cmd != left_brace_cmd) {
+ /*tex
+ If the right-hand side is a token parameter or token register, finish
+ the assignment and |goto done|
+ */
+ if (cur_cmd == register_cmd && cur_chr == tok_val_level) {
+ chr = eq_value(register_toks_location(tex_scan_toks_register_number()));
+ if (chr) {
+ tex_add_token_reference(chr);
+ }
+ goto DEFINE;
+ } else if (cur_cmd == register_toks_cmd || cur_cmd == internal_toks_cmd) {
+ chr = eq_value(cur_chr);
+ if (chr) {
+ tex_add_token_reference(chr);
+ }
+ goto DEFINE;
+ } else {
+ /*tex Recover possibly with error message. */
+ tex_back_input(cur_tok);
+ cur_cs = cs;
+ chr = tex_scan_toks_normal(0, &tail);
+ }
+ } else {
+ cur_cs = cs;
+ chr = tex_scan_toks_normal(1, &tail);
+ }
+ if (! token_link(chr)) {
+ tex_put_available_token(chr);
+ chr = null;
+ } else if (loc == internal_toks_location(output_routine_code)) {
+ halfword head = token_link(chr);
+ halfword list = tex_store_new_token(null, left_brace_token + '{');
+ tex_store_new_token(tail, right_brace_token + '}');
+ set_token_link(list, head);
+ set_token_link(chr, list);
+ }
+ DEFINE:
+ tex_define(a, loc, cmd == internal_toks_cmd ? internal_toks_reference_cmd : register_toks_reference_cmd, chr);
+}
+
+/*tex Let |n| be the largest legal code value, based on |cur_chr| */
+
+static void tex_aux_set_define_char_code(int a) /* maybe make |a| already a boolean */
+{
+ switch (cur_chr) {
+ case catcode_charcode:
+ {
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_int(1, NULL);
+ if (val < 0 || val > max_char_code) {
+ tex_aux_out_of_range_error(val, max_char_code);
+ }
+ tex_set_cat_code(cat_code_table_par, chr, val, global_or_local(a));
+ }
+ break;
+ case lccode_charcode:
+ {
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_int(1, NULL);
+ if (val < 0 || val > max_character_code) {
+ tex_aux_out_of_range_error(val, max_character_code);
+ }
+ tex_set_lc_code(chr, val, global_or_local(a));
+ }
+ break;
+ case uccode_charcode:
+ {
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_int(1, NULL);
+ if (val < 0 || val > max_character_code) {
+ tex_aux_out_of_range_error(val, max_character_code);
+ }
+ tex_set_uc_code(chr, val, global_or_local(a));
+ }
+ break;
+ case sfcode_charcode:
+ {
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_int(1, NULL);
+ if (val < min_space_factor || val > max_space_factor) {
+ tex_aux_out_of_range_error(val, max_space_factor);
+ }
+ tex_set_sf_code(chr, val, global_or_local(a));
+ }
+ break;
+ case hccode_charcode:
+ {
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_char_number(1);
+ tex_set_hc_code(chr, val, global_or_local(a));
+ }
+ break;
+ case hmcode_charcode:
+ {
+ halfword chr = tex_scan_char_number(0);
+ halfword val = tex_scan_math_discretionary_number(1);
+ tex_set_hm_code(chr, val, global_or_local(a));
+ }
+ break;
+ case mathcode_charcode:
+ tex_scan_extdef_math_code((is_global(a)) ? level_one: cur_level, tex_mathcode);
+ break;
+ case extmathcode_charcode:
+ tex_scan_extdef_math_code((is_global(a)) ? level_one : cur_level, umath_mathcode);
+ break;
+ /*
+ case extmathcodenum_charcode:
+ tex_scan_extdef_math_code((is_global(a)) ? level_one : cur_level, umathnum_mathcode);
+ break;
+ */
+ case delcode_charcode:
+ tex_scan_extdef_del_code((is_global(a)) ? level_one : cur_level, tex_mathcode);
+ break;
+ case extdelcode_charcode:
+ tex_scan_extdef_del_code((is_global(a)) ? level_one : cur_level, umath_mathcode);
+ break;
+ /*
+ case extdelcodenum_charcode:
+ tex_scan_extdef_del_code((is_global(a)) ? level_one : cur_level, umathnum_mathcode);
+ break;
+ */
+ default:
+ break;
+ }
+}
+
+static void tex_aux_skip_optional_equal(void)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok == equal_token) {
+ tex_get_x_token();
+ }
+}
+
+static void tex_aux_set_math_parameter(int a)
+{
+ halfword code = cur_chr;
+ halfword value = null; /* can also be scaled */
+ switch (code) {
+ case math_parameter_reset_spacing:
+ {
+ tex_reset_all_styles(global_or_local(a));
+ return;
+ }
+ case math_parameter_set_spacing:
+ case math_parameter_set_atom_rule:
+ {
+ halfword left = tex_scan_math_class_number(0);
+ halfword right = tex_scan_math_class_number(0);
+ switch (code) {
+ case math_parameter_set_spacing:
+ code = tex_to_math_spacing_parameter(left, right);
+ break;
+ case math_parameter_set_atom_rule:
+ code = tex_to_math_rules_parameter(left, right);
+ break;
+ }
+ if (code < 0) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math class pair",
+ "I'm going to assume ordinary atoms."
+ );
+ switch (code) {
+ case math_parameter_set_spacing:
+ code = tex_to_math_spacing_parameter(ordinary_noad_subtype, ordinary_noad_subtype);
+ break;
+ case math_parameter_set_atom_rule:
+ code = tex_to_math_rules_parameter(ordinary_noad_subtype, ordinary_noad_subtype);
+ break;
+ }
+ }
+ break;
+ }
+ case math_parameter_let_spacing:
+ case math_parameter_let_atom_rule:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ halfword display = tex_scan_math_class_number(1);
+ halfword text = tex_scan_math_class_number(0);
+ halfword script = tex_scan_math_class_number(0);
+ halfword scriptscript = tex_scan_math_class_number(0);
+ if (valid_math_class_code(class)) {
+ switch (code) {
+ case math_parameter_let_spacing:
+ code = internal_int_location(first_math_class_code + class);
+ break;
+ case math_parameter_let_atom_rule:
+ code = internal_int_location(first_math_atom_code + class);
+ break;
+ }
+ value = (display << 24) + (text << 16) + (script << 8) + scriptscript;
+ // tex_assign_internal_int_value(a, code, value);
+ tex_word_define(a, code, value);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math class",
+ "I'm going to ignore this alias."
+ );
+ }
+ return;
+ }
+ case math_parameter_copy_spacing:
+ case math_parameter_copy_atom_rule:
+ case math_parameter_copy_parent:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ halfword parent = tex_scan_math_class_number(1);
+ if (valid_math_class_code(class) && valid_math_class_code(parent)) {
+ switch (code) {
+ case math_parameter_copy_spacing:
+ code = internal_int_location(first_math_class_code + class);
+ value = count_parameter(first_math_class_code + parent);
+ break;
+ case math_parameter_copy_atom_rule:
+ code = internal_int_location(first_math_atom_code + class);
+ value = count_parameter(first_math_atom_code + parent);
+ break;
+ case math_parameter_copy_parent:
+ code = internal_int_location(first_math_parent_code + class);
+ value = count_parameter(first_math_parent_code + parent);
+ break;
+ }
+ tex_word_define(a, code, value);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math class",
+ "I'm going to ignore this alias."
+ );
+ }
+ return;
+ }
+ case math_parameter_set_pre_penalty:
+ case math_parameter_set_post_penalty:
+ case math_parameter_set_display_pre_penalty:
+ case math_parameter_set_display_post_penalty:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ halfword penalty = tex_scan_int(1, NULL);
+ if (valid_math_class_code(class)) {
+ switch (code) {
+ case math_parameter_set_pre_penalty:
+ code = internal_int_location(first_math_pre_penalty_code + class);
+ break;
+ case math_parameter_set_post_penalty:
+ code = internal_int_location(first_math_post_penalty_code + class);
+ break;
+ case math_parameter_set_display_pre_penalty:
+ code = internal_int_location(first_math_display_pre_penalty_code + class);
+ break;
+ case math_parameter_set_display_post_penalty:
+ code = internal_int_location(first_math_display_post_penalty_code + class);
+ break;
+ }
+ tex_word_define(a, code, penalty);
+ // tex_assign_internal_int_value(a, code, penalty);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math class",
+ "I'm going to ignore this atom penalty."
+ );
+ }
+ return;
+ }
+ case math_parameter_let_parent:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ halfword pre = tex_scan_math_class_number(1);
+ halfword post = tex_scan_math_class_number(0);
+ halfword options = tex_scan_math_class_number(0);
+ halfword reserved = tex_scan_math_class_number(0);
+ if (valid_math_class_code(class)) {
+ code = internal_int_location(first_math_parent_code + class);
+ value = (reserved << 24) + (options << 16) + (pre << 8) + post;
+ tex_word_define(a, code, value);
+ // tex_assign_internal_int_value(a, code, value);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math class",
+ "I'm going to ignore this penalty alias."
+ );
+ }
+ return;
+ }
+ case math_parameter_ignore:
+ {
+ halfword param = tex_scan_math_parameter();
+ if (param >= 0) {
+ code = internal_int_location(first_math_ignore_code + param);
+ value = tex_scan_int(1, NULL);
+ tex_word_define(a, code, value);
+ }
+ return;
+ }
+ case math_parameter_options:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ if (valid_math_class_code(class)) {
+ code = internal_int_location(first_math_options_code + class);
+ value = tex_scan_int(1, NULL);
+ tex_word_define(a, code, value);
+ // tex_assign_internal_int_value(a, code, value);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math class",
+ "I'm going to ignore these options."
+ );
+ }
+ return;
+ }
+ case math_parameter_set_defaults:
+ tex_set_default_math_codes();
+ return;
+ }
+ {
+ halfword style = tex_scan_math_style_identifier(0, 1);
+ halfword indirect = indirect_math_regular;
+ int freeze = is_frozen(a) && cur_mode == mmode;
+ if (! freeze && is_inherited(a)) {
+ tex_aux_skip_optional_equal();
+ /* maybe also let inherit from another mathparam but that can become circular */
+ switch (math_parameter_value_type(code)) {
+ case math_int_parameter:
+ switch (cur_cmd) {
+ case integer_cmd:
+ value = cur_cs;
+ indirect = indirect_math_integer;
+ break;
+ case register_int_cmd:
+ value = cur_chr;
+ indirect = indirect_math_register_integer;
+ break;
+ }
+ break;
+ case math_dimen_parameter:
+ switch (cur_cmd) {
+ case dimension_cmd:
+ value = cur_cs;
+ indirect = indirect_math_dimension;
+ break;
+ case register_dimen_cmd:
+ value = cur_chr;
+ indirect = indirect_math_register_dimension;
+ break;
+ }
+ break;
+ case math_muglue_parameter:
+ switch (cur_cmd) {
+ case mugluespec_cmd:
+ value = cur_cs;
+ indirect = indirect_math_mugluespec;
+ break;
+ case register_mu_glue_cmd:
+ value = cur_chr;
+ indirect = indirect_math_register_mugluespec;
+ break;
+ case internal_mu_glue_cmd:
+ value = cur_chr;
+ indirect = indirect_math_internal_mugluespec;
+ break;
+ case dimension_cmd:
+ value = cur_cs;
+ indirect = indirect_math_dimension;
+ break;
+ case register_dimen_cmd:
+ value = cur_chr;
+ indirect = indirect_math_register_dimension;
+ break;
+ case gluespec_cmd:
+ value = cur_cs;
+ indirect = indirect_math_gluespec;
+ break;
+ case register_glue_cmd:
+ value = cur_chr;
+ indirect = indirect_math_register_gluespec;
+ break;
+ case internal_glue_cmd:
+ value = cur_chr;
+ indirect = indirect_math_internal_gluespec;
+ break;
+ }
+ break;
+ case math_pair_parameter:
+ {
+ halfword left = tex_scan_math_class_number(0);
+ halfword right = tex_scan_math_class_number(0);
+ value = (left << 16) + right;
+ }
+ break;
+ }
+ if (indirect == indirect_math_regular) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid inherited math parameter type",
+ "The inheritance type should match the math parameter type"
+ );
+ return;
+ }
+ } else {
+ switch (math_parameter_value_type(code)) {
+ case math_int_parameter:
+ value = tex_scan_int(1, NULL);
+ break;
+ case math_dimen_parameter:
+ value = tex_scan_dimen(0, 0, 0, 1, NULL);
+ break;
+ case math_muglue_parameter:
+ value = tex_scan_glue(mu_val_level, 1);
+ break;
+ case math_style_parameter:
+ value = tex_scan_int(1, NULL);
+ if (value < 0 || value > last_math_style_variant) {
+ /* maybe a warning */
+ value = math_normal_style_variant;
+ }
+ break;
+ case math_pair_parameter:
+ {
+ halfword left = tex_scan_math_class_number(0);
+ halfword right = tex_scan_math_class_number(0);
+ value = (left << 16) + right;
+ }
+ break;
+ default:
+ tex_confusion("math parameter type");
+ return;
+ }
+ }
+ if (freeze) {
+ halfword n = tex_new_node(parameter_node, (quarterword) style);
+ parameter_name(n) = code;
+ parameter_value(n) = value;
+ attach_current_attribute_list(n);
+ tex_tail_append(n);
+ } else {
+ switch (style) {
+ case all_display_styles:
+ tex_set_display_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_text_styles:
+ tex_set_text_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_script_styles:
+ tex_set_script_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_script_script_styles:
+ tex_set_script_script_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_math_styles:
+ tex_set_all_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_split_styles:
+ tex_set_split_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_uncramped_styles:
+ tex_set_uncramped_styles(code, value, global_or_local(a), indirect);
+ break;
+ case all_cramped_styles:
+ tex_set_cramped_styles(code, value, global_or_local(a), indirect);
+ break;
+ default:
+ tex_def_math_parameter(style, code, value, global_or_local(a), indirect);
+ break;
+ }
+
+ }
+ }
+}
+
+/* */
+
+static void tex_aux_set_define_family(int a)
+{
+ halfword p = cur_chr;
+ halfword fnt;
+ halfword fam = tex_scan_math_family_number();
+ tex_scan_optional_equals();
+ fnt = tex_scan_font_identifier(NULL);
+ tex_def_fam_fnt(fam, p, fnt, global_or_local(a));
+}
+
+/*tex Similar routines are used to assign values to the numeric parameters. */
+
+static void tex_aux_set_internal_int(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_int(1, NULL);
+ tex_assign_internal_int_value(a, p, v);
+}
+
+static void tex_aux_set_register_int(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_int(1, NULL);
+ tex_word_define(a, p, v);
+}
+
+static void tex_aux_set_internal_attr(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_int(1, NULL);
+ if (internal_attribute_number(p) > lmt_node_memory_state.max_used_attribute) {
+ lmt_node_memory_state.max_used_attribute = internal_attribute_number(p);
+ }
+ change_attribute_register(a, p, v);
+ tex_word_define(a, p, v);
+}
+
+static void tex_aux_set_register_attr(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_int(1, NULL);
+ if (register_attribute_number(p) > lmt_node_memory_state.max_used_attribute) {
+ lmt_node_memory_state.max_used_attribute = register_attribute_number(p);
+ }
+ change_attribute_register(a, p, v);
+ tex_word_define(a, p, v);
+}
+
+static void tex_aux_set_internal_dimen(int a)
+{
+ halfword p = cur_chr;
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ tex_assign_internal_dimen_value(a, p, v);
+}
+
+static void tex_aux_set_register_dimen(int a)
+{
+ halfword p = cur_chr;
+ scaled v = tex_scan_dimen(0, 0, 0, 1, NULL);
+ tex_word_define(a, p, v);
+}
+
+static void tex_aux_set_internal_glue(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_glue(glue_val_level, 1);
+ // define(a, p, internal_glue_ref_cmd, v);
+ tex_assign_internal_skip_value(a, p, v);
+}
+
+static void tex_aux_set_register_glue(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_glue(glue_val_level, 1);
+ tex_define(a, p, register_glue_reference_cmd, v);
+}
+
+static void tex_aux_set_internal_mu_glue(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_glue(mu_val_level, 1);
+ tex_define(a, p, internal_mu_glue_reference_cmd, v);
+}
+
+static void tex_aux_set_register_mu_glue(int a)
+{
+ halfword p = cur_chr;
+ halfword v = tex_scan_glue(mu_val_level, 1);
+ tex_define(a, p, register_mu_glue_reference_cmd, v);
+}
+
+/*tex
+ We ignore prefixes that don't apply as we might apply then in the future: just like |\immediate|
+ so it's not that alien. And maybe frozen can be applied some day in other cases as well. As
+ reference we keep the old code (long and outer code has been removed elsewhere.) Most of the
+ calls are the only call so the functions are likely to be inlined.
+
+*/
+
+static void tex_aux_set_combine_toks(halfword a)
+{
+ if (is_global(a)) {
+ switch (cur_chr) {
+ case expanded_toks_code: cur_chr = global_expanded_toks_code; break;
+ case append_toks_code: cur_chr = global_append_toks_code; break;
+ case append_expanded_toks_code: cur_chr = global_append_expanded_toks_code; break;
+ case prepend_toks_code: cur_chr = global_prepend_toks_code; break;
+ case prepend_expanded_toks_code: cur_chr = global_prepend_expanded_toks_code; break;
+ }
+ }
+ tex_run_combine_the_toks();
+}
+
+static int tex_aux_set_some_item(halfword a)
+{
+ (void) a;
+ switch (cur_chr) {
+ case lastpenalty_code:
+ lmt_page_builder_state.last_penalty = tex_scan_int(1, NULL);
+ return 1;
+ case lastkern_code:
+ lmt_page_builder_state.last_kern = tex_scan_int(1, NULL);
+ return 1;
+ case lastskip_code:
+ lmt_page_builder_state.last_glue = tex_scan_glue(glue_val_level, 1);
+ return 1;
+ case lastboundary_code:
+ lmt_page_builder_state.last_penalty = tex_scan_int(1, NULL);
+ return 1;
+ case last_node_type_code:
+ lmt_page_builder_state.last_node_type = tex_scan_int(1, NULL);
+ return 1;
+ case last_node_subtype_code:
+ lmt_page_builder_state.last_node_subtype = tex_scan_int(1, NULL);
+ return 1;
+ case last_left_class_code:
+ lmt_math_state.last_left = tex_scan_math_class_number(1);
+ return 1;
+ case last_right_class_code:
+ lmt_math_state.last_right = tex_scan_math_class_number(1);
+ return 1;
+ case last_atom_class_code:
+ lmt_math_state.last_atom = tex_scan_math_class_number(1);
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+void tex_run_prefixed_command(void)
+{
+ /*tex accumulated prefix codes so far */
+ int flags = 0;
+ int force = 0;
+ halfword lastprefix = -1;
+ while (cur_cmd == prefix_cmd) {
+ switch (cur_chr) {
+ case frozen_code: flags = add_frozen_flag (flags); break;
+ case tolerant_code: flags = add_tolerant_flag (flags); break;
+ case protected_code: flags = add_protected_flag (flags); break;
+ case permanent_code: flags = add_permanent_flag (flags); break;
+ case immutable_code: flags = add_immutable_flag (flags); break;
+ case mutable_code: flags = add_mutable_flag (flags); break;
+ case noaligned_code: flags = add_noaligned_flag (flags); break;
+ case instance_code: flags = add_instance_flag (flags); break;
+ case untraced_code: flags = add_untraced_flag (flags); break;
+ case global_code: flags = add_global_flag (flags); break;
+ case overloaded_code: flags = add_overloaded_flag (flags); break;
+ case aliased_code: flags = add_aliased_flag (flags); break;
+ case immediate_code: flags = add_immediate_flag (flags); break;
+ case semiprotected_code: flags = add_semiprotected_flag(flags); break;
+ /*tex This one is bound. */
+ case always_code: flags = add_aliased_flag (flags); force = 1; break;
+ /*tex This one is special */
+ case inherited_code: flags = add_inherited_flag (flags); break;
+ default:
+ goto PICKUP;
+ }
+ lastprefix = cur_chr;
+ PICKUP:
+ /*tex We no longer report prefixes. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ if (tracing_commands_par > 2) {
+ tex_show_cmd_chr(cur_cmd, cur_chr);
+ }
+ }
+
+ /*tex: Here we can quit when we have a constant! */
+
+ /*tex
+ Adjust for the setting of |\globaldefs|.
+ */
+ if (global_defs_par) {
+ flags = global_defs_par > 0 ? add_global_flag(flags) : remove_global_flag(flags);
+ }
+ /*tex
+ Now we arrived at all the def variants. We only apply the prefixes that make sense (for
+ now).
+ */
+ switch (cur_cmd) {
+ case set_font_cmd:
+ tex_aux_set_font(flags);
+ break;
+ case def_cmd:
+ tex_aux_set_def(flags, force);
+ break;
+ case let_cmd:
+ tex_aux_set_let(flags, force);
+ break;
+ case shorthand_def_cmd:
+ tex_aux_set_shorthand_def(flags, force);
+ break;
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ tex_aux_set_assign_toks(flags);
+ break;
+ case internal_int_cmd:
+ tex_aux_set_internal_int(flags);
+ break;
+ case register_int_cmd:
+ tex_aux_set_register_int(flags);
+ break;
+ case internal_attribute_cmd:
+ tex_aux_set_internal_attr(flags);
+ break;
+ case register_attribute_cmd:
+ tex_aux_set_register_attr(flags);
+ break;
+ case internal_dimen_cmd:
+ tex_aux_set_internal_dimen(flags);
+ break;
+ case register_dimen_cmd:
+ tex_aux_set_register_dimen(flags);
+ break;
+ case internal_glue_cmd:
+ tex_aux_set_internal_glue(flags);
+ break;
+ case register_glue_cmd:
+ tex_aux_set_register_glue(flags);
+ break;
+ case internal_mu_glue_cmd:
+ tex_aux_set_internal_mu_glue(flags);
+ break;
+ case register_mu_glue_cmd:
+ tex_aux_set_register_mu_glue(flags);
+ break;
+ case lua_value_cmd:
+ tex_aux_set_lua_value(flags);
+ break;
+ case define_char_code_cmd:
+ tex_aux_set_define_char_code(flags);
+ break;
+ case define_family_cmd:
+ tex_aux_set_define_family(flags);
+ break;
+ case set_math_parameter_cmd:
+ tex_aux_set_math_parameter(flags);
+ break;
+ case register_cmd:
+ if (cur_chr == tok_val_level) {
+ tex_aux_set_assign_toks(flags);
+ } else {
+ tex_aux_set_register(flags);
+ }
+ break;
+ case arithmic_cmd:
+ tex_aux_arithmic_register(flags, cur_chr);
+ break;
+ case set_box_cmd:
+ tex_aux_set_box(flags);
+ break;
+ case set_auxiliary_cmd:
+ tex_aux_set_auxiliary(flags);
+ break;
+ case set_page_property_cmd:
+ tex_aux_set_page_property();
+ break;
+ case set_box_property_cmd:
+ tex_aux_set_box_property();
+ break;
+ case set_specification_cmd:
+ tex_aux_set_specification(flags);
+ break;
+ case hyphenation_cmd:
+ tex_aux_set_hyph_data();
+ break;
+ case set_font_property_cmd:
+ tex_aux_set_font_property();
+ break;
+ case define_font_cmd:
+ tex_aux_set_define_font(flags);
+ break;
+ case set_interaction_cmd:
+ tex_aux_set_interaction(cur_chr);
+ break;
+ case combine_toks_cmd:
+ tex_aux_set_combine_toks(flags);
+ break;
+ case some_item_cmd:
+ if (! tex_aux_set_some_item(flags)) {
+ tex_aux_run_illegal_case();
+ }
+ break;
+ default:
+ if (lastprefix < 0) {
+ tex_confusion("prefixed command");
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "You can't use a prefix %C with %C",
+ prefix_cmd, lastprefix, cur_cmd, cur_chr,
+ "A prefix should be followed by a quantity that can be assigned to. Intermediate\n"
+ "spaces and \\relax tokens are gobbled in the process.\n"
+ );
+ break;
+ }
+ }
+ /*tex
+ End of assignments cases. We insert a token saved by |\afterassignment|, if any.
+ */
+ tex_aux_finish_after_assignment();
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_get_r_token(void)
+{
+ RESTART:
+ do {
+ tex_get_token();
+ } while (cur_tok == space_token);
+ if (eqtb_valid_cs(cur_cs)) {
+ if (cur_cs == 0) {
+ tex_back_input(cur_tok);
+ }
+ cur_tok = deep_frozen_protection_token;
+ /* moved down but this might interfere with input on the console */
+ tex_handle_error(
+ insert_error_type,
+ "Missing control sequence inserted",
+ "Please don't say '\\def cs{...}', say '\\def\\cs{...}'. I've inserted an\n"
+ "inaccessible control sequence so that your definition will be completed without\n"
+ "mixing me up too badly.\n"
+ );
+ goto RESTART;
+ }
+}
+
+/*tex
+ Some of the internal int values need a special treatment. This used to be a more complex
+ function, also dealing with other registers than didn't really need a check, also because we
+ now split into internals and registers.
+
+ Beware: the post binary and relation penalties are not synchronzed here because we assume a
+ proper overload of the primitive. They can still be set and their setting is reflected in the
+ atom panalties but that's all. No need for more code.
+*/
+
+void tex_assign_internal_int_value(int a, halfword p, int val)
+{
+ switch (internal_int_number(p)) {
+ case par_direction_code:
+ {
+ check_direction_value(val);
+ tex_word_define(a, p, val);
+ }
+ break;
+ case math_direction_code:
+ {
+ check_direction_value(val);
+ tex_word_define(a, p, val);
+ }
+ break;
+ case text_direction_code:
+ {
+ check_direction_value(val);
+ tex_inject_text_or_line_dir(val, 0);
+ tex_word_define(a, p, val);
+ /*tex Plus: */
+ update_tex_internal_dir_state(internal_dir_state_par + 1);
+ }
+ break;
+ case line_direction_code:
+ {
+ check_direction_value(val);
+ tex_inject_text_or_line_dir(val, 1);
+ p = internal_int_location(text_direction_code);
+ tex_word_define(a, p, val);
+ /*tex Plus: */
+ update_tex_internal_dir_state(internal_dir_state_par + 1);
+ }
+ break;
+ case cat_code_table_code:
+ if (tex_valid_catcode_table(val)) {
+ if (val != cat_code_table_par) {
+ tex_word_define(a, p, val);
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\catcode table",
+ "You can only switch to a \\catcode table that is initialized using\n"
+ "\\savecatcodetable or \\initcatcodetable, or to table 0"
+ );
+ }
+ break;
+ case glyph_scale_code:
+ case glyph_x_scale_code:
+ case glyph_y_scale_code:
+ if (! val) {
+ /* maybe an error message */
+ return;
+ } else {
+ /* todo: check for reasonable */
+ goto DEFINE;
+ }
+ case glyph_text_scale_code:
+ case glyph_script_scale_code:
+ case glyph_scriptscript_scale_code:
+ /* here zero is a signal */
+ if (val < min_limited_scale || val > max_limited_scale) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\glyph..scale",
+ "The value for \\glyph..scale has to be between 0 and 1000 where\n"
+ "a value of zero forces font percentage scaling to be used."
+ );
+ val = max_limited_scale;
+ }
+ goto DEFINE;
+ case math_begin_class_code:
+ case math_end_class_code:
+ case math_left_class_code:
+ case math_right_class_code:
+ if (! valid_math_class_code(val)) {
+ val = unset_noad_class;
+ }
+ tex_word_define(a, p, val);
+ break;
+ case output_box_code:
+ if (val < 0 || val > max_box_index) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\outputbox",
+ "The value for \\outputbox has to be between 0 and " LMT_TOSTRING(max_box_index) "."
+ );
+ } else {
+ tex_word_define(a, p, val);
+ }
+ break;
+ case new_line_char_code:
+ if (val > max_newline_character) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\newlinechar",
+ "The value for \\newlinechar has to be no higher than " LMT_TOSTRING(max_newline_character) ".\n"
+ "Your invalid assignment will be ignored."
+ );
+ }
+ else {
+ tex_word_define(a, p, val);
+ }
+ break;
+ case end_line_char_code:
+ if (val > 127) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\endlinechar",
+ "The value for \\endlinechar has to be no higher than 127."
+ );
+ }
+ else {
+ tex_word_define(a, p, val);
+ }
+ break;
+ case language_code:
+ /* this is |\language| */
+ if (val < 0) {
+ val = 0;
+ }
+ if (tex_is_valid_language(val)) {
+ update_tex_language(a, val);
+ }
+ else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\language",
+ "The value for \\language has to be defined and in the range 0 .. " LMT_TOSTRING(max_n_of_languages) "."
+ );
+ }
+ break;
+ case font_code:
+ if (val < 0) {
+ val = 0;
+ }
+ if (tex_is_valid_font(val)) {
+ tex_set_cur_font(a, val);
+ }
+ else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid \\fontid",
+ "The value for \\fontid has to be defined and in the range 0 .. " LMT_TOSTRING(max_n_of_fonts) "."
+ );
+ }
+ break;
+ case hyphenation_mode_code:
+ if (val < 0) {
+ val = 0;
+ }
+ /* We don't update |\uchyph| here. */
+ tex_word_define(a, p, val);
+ break;
+ case uc_hyph_code:
+ /*tex For old times sake. */
+ tex_word_define(a, p, val);
+ /*tex But we do use this instead. */
+ val = val ? set_hyphenation_mode(hyphenation_mode_par, uppercase_hyphenation_mode) : unset_hyphenation_mode(hyphenation_mode_par, uppercase_hyphenation_mode);
+ tex_word_define(a, internal_int_location(hyphenation_mode_code), val);
+ break;
+ case local_interline_penalty_code:
+ case local_broken_penalty_code:
+ /*tex
+ 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.
+ */
+ tex_word_define(a, p, val);
+ if (cur_mode == hmode) {
+ /*tex Add local paragraph node */
+ tex_tail_append(tex_new_par_node(penalty_par_subtype));
+ update_tex_internal_par_state(internal_par_state_par + 1);
+ }
+ break;
+ case adjust_spacing_code:
+ if (val < adjust_spacing_off) {
+ val = adjust_spacing_off;
+ }
+ else if (val > adjust_spacing_font) {
+ val = adjust_spacing_font;
+ }
+ goto DEFINE;
+ case protrude_chars_code:
+ if (val < protrude_chars_off) {
+ val = protrude_chars_off;
+ }
+ else if (val > protrude_chars_advanced) {
+ val = protrude_chars_advanced;
+ }
+ goto DEFINE;
+ case glyph_options_code:
+ if (val < glyph_option_normal_glyph) {
+ val = glyph_option_normal_glyph;
+ } else if (val > glyph_option_all) {
+ val = glyph_option_all;
+ }
+ goto DEFINE;
+ case overload_mode_code:
+ if (overload_mode_par == 255) {
+ return;
+ } else {
+ goto DEFINE;
+ }
+ /* We only synchronize these four one way. */
+ case post_binary_penalty_code:
+ tex_word_define(a, internal_int_location(first_math_post_penalty_code + binary_noad_subtype), val);
+ tex_word_define(a, internal_int_location(first_math_display_post_penalty_code + binary_noad_subtype), val);
+ break;
+ case post_relation_penalty_code:
+ tex_word_define(a, internal_int_location(first_math_post_penalty_code + relation_noad_subtype), val);
+ tex_word_define(a, internal_int_location(first_math_display_post_penalty_code + relation_noad_subtype), val);
+ break;
+ case pre_binary_penalty_code:
+ tex_word_define(a, internal_int_location(first_math_pre_penalty_code + binary_noad_subtype), val);
+ tex_word_define(a, internal_int_location(first_math_display_pre_penalty_code + binary_noad_subtype), val);
+ break;
+ case pre_relation_penalty_code:
+ tex_word_define(a, internal_int_location(first_math_pre_penalty_code + relation_noad_subtype), val);
+ tex_word_define(a, internal_int_location(first_math_display_pre_penalty_code + relation_noad_subtype), val);
+ break;
+ /* We could do this, but then we also need to do day and check it per month. */ /*
+ case month_code:
+ if (val < 1) {
+ val = 1;
+ } else if (val > 12) {
+ val = 12;
+ }
+ goto DEFINE;
+ */
+ default:
+ DEFINE:
+ tex_word_define(a, p, val);
+ if (is_frozen(a) && cur_mode == hmode) {
+ tex_update_par_par(internal_int_cmd, internal_int_number(p));
+ }
+ }
+}
+
+void tex_assign_internal_attribute_value(int a, halfword p, int val)
+{
+ if (register_attribute_number(p) > lmt_node_memory_state.max_used_attribute) {
+ lmt_node_memory_state.max_used_attribute = register_attribute_number(p);
+ }
+ change_attribute_register(a, p, val);
+ tex_word_define(a, p, val);
+}
+
+void tex_assign_internal_dimen_value(int a, halfword p, int val)
+{
+ tex_word_define(a, p, val);
+ if (is_frozen(a) && cur_mode == hmode) {
+ tex_update_par_par(internal_dimen_cmd, internal_dimen_number(p));
+ }
+}
+
+void tex_assign_internal_skip_value(int a, halfword p, int val)
+{
+ tex_define(a, p, internal_glue_reference_cmd, val);
+ if (is_frozen(a) && cur_mode == hmode) {
+ tex_update_par_par(internal_glue_cmd, internal_glue_number(p));
+ }
+}
+
+/*tex
+
+ Here is a procedure that might be called \quotation {Get the next non-blank non-relax non-call
+ non-assignment token}. It is a runner used in text accents and math alignments. It probably
+ has to be adapted to the additional command codes that we have.
+
+*/
+
+void tex_handle_assignments(void)
+{
+ while (1) {
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ if (cur_cmd <= max_non_prefixed_cmd) {
+ return;
+ } else {
+ lmt_error_state.set_box_allowed = 0;
+ tex_run_prefixed_command();
+ lmt_error_state.set_box_allowed = 1;
+ }
+ }
+}
+
+/*tex Has the long |\errmessage| help been used? */
+
+static strnumber tex_aux_scan_string(void)
+{
+ int saved_selector = lmt_print_state.selector; /*tex holds |selector| setting */
+ halfword result = tex_scan_toks_expand(0, NULL, 0);
+ // saved_selector = lmt_print_state.selector;
+ lmt_print_state.selector = new_string_selector_code;
+ tex_token_show(result, extreme_token_show_max);
+ tex_flush_token_list(result);
+ lmt_print_state.selector = saved_selector;
+ return tex_make_string(); /* todo: we can use take_string instead but happens only @ error */
+}
+
+static void tex_aux_run_message(void)
+{
+ switch (cur_chr) {
+ case message_code:
+ {
+ /*tex Print string |s| on the terminal */
+ strnumber s = tex_aux_scan_string();
+ if ((lmt_print_state.terminal_offset > 0) || (lmt_print_state.logfile_offset > 0)) {
+ tex_print_char(' ');
+ }
+ tex_print_tex_str(s);
+ tex_terminal_update();
+ tex_flush_str(s);
+ break;
+ }
+ case error_message_code:
+ {
+ /*tex
+ 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. These
+ help messages are not expanded because that could itself generate an error.
+ */
+ strnumber s = tex_aux_scan_string();
+ if (error_help_par) {
+ strnumber helpinfo = tex_tokens_to_string(error_help_par);
+ char *h = tex_makecstring(helpinfo);
+ tex_handle_error(
+ normal_error_type,
+ "%T",
+ s,
+ h
+ );
+ lmt_memory_free(h);
+ tex_flush_str(helpinfo);
+ } else if (lmt_error_state.long_help_seen) {
+ tex_handle_error(
+ normal_error_type,
+ "%T",
+ s,
+ "(That was another \\errmessage.)"
+ );
+ } else {
+ if (lmt_error_state.interaction < error_stop_mode) {
+ lmt_error_state.long_help_seen = 1;
+ }
+ tex_handle_error(
+ normal_error_type,
+ "%T",
+ s,
+ "This error message was generated by an \\errmessage command, so I can't give any\n"
+ "explicit help. Pretend that you're Hercule Poirot: Examine all clues, and deduce\n"
+ "the truth by order and method."
+ );
+ }
+ tex_flush_str(s);
+ break;
+ }
+ }
+}
+
+/*tex
+
+ The |\uppercase| and |\lowercase| commands are implemented by building a token list and then
+ changing the cases of the letters in it.
+
+ 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. (The last fact permits
+ trickery.)
+
+*/
+
+static void tex_aux_run_shift_case(void)
+{
+ int upper = cur_chr == upper_case_code;
+ halfword l = tex_scan_toks_normal(0, NULL);
+ halfword p = token_link(l);
+ while (p) {
+ halfword t = token_info(p);
+ if (t < cs_token_flag) {
+ halfword c = t % cs_offset_value;
+ halfword i = upper ? tex_get_uc_code(c) : tex_get_lc_code(c);
+ if (i) {
+ set_token_info(p, t - c + i);
+ }
+ } else if (tex_is_active_cs(cs_text(t - cs_token_flag))) {
+ halfword c = active_cs_value(cs_text(t - cs_token_flag));
+ halfword i = upper ? tex_get_uc_code(c) : tex_get_lc_code(c);
+ if (i) {
+ set_token_info(p, tex_active_to_cs(i, 1) + cs_token_flag);
+ }
+ }
+ p = token_link(p);
+ }
+ tex_begin_backed_up_list(token_link(l));
+ tex_put_available_token(l);
+}
+
+/*tex
+
+ We come finally to the last pieces missing from |main_control|, namely the |\show| commands that
+ are useful when debugging.
+
+*/
+
+static void tex_aux_run_show_whatever(void)
+{
+ int justshow = 1;
+ switch (cur_chr) {
+ case show_code:
+ /*tex Show the current meaning of a token, then |goto common_ending|. */
+ {
+ tex_get_token();
+ tex_print_nlp();
+ tex_print_str("> ");
+ if (cur_cs != 0) {
+ tex_print_cs(cur_cs);
+ tex_print_char('=');
+ }
+ tex_print_meaning(meaning_full_code);
+ goto COMMON_ENDING;
+ }
+ case show_box_code:
+ /*tex Show the current contents of a box. */
+ {
+ int nolevels = 0;
+ int diagnose = 0;
+ int content = 0;
+ int online = 0;
+ int max = 0;
+ while (1) {
+ switch (tex_scan_character("ocdnaOCDNA", 0, 0, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("all", 1)) {
+ max = 1;
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("content", 1)) {
+ content = 1;
+ }
+ break;
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("diagnose", 1)) {
+ diagnose = 1;
+ }
+ break;
+ case 'n': case 'N':
+ if (tex_scan_mandate_keyword("nolevels", 1)) {
+ nolevels = 1;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("online", 1)) {
+ online = 1;
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ /*tex This can become a general helper. */
+ {
+ halfword n = tex_scan_box_register_number();
+ halfword r = box_register(n);
+ halfword l = tracing_levels_par;
+ halfword o = tracing_online_par;
+ halfword d = show_box_depth_par;
+ halfword b = show_box_breadth_par;
+ if (nolevels) {
+ tracing_levels_par = 0;
+ }
+ if (online) {
+ tracing_online_par = 2;
+ }
+ if (max) {
+ show_box_depth_par = max_integer;
+ show_box_breadth_par = max_integer;
+ }
+ if (diagnose) {
+ tex_begin_diagnostic();
+ }
+ if (! content) {
+ tex_print_str("> \\box");
+ tex_print_int(n);
+ tex_print_char('=');
+ }
+ if (r) {
+ tex_show_box(r);
+ } else {
+ tex_print_str("void");
+ }
+ if (diagnose) {
+ tex_end_diagnostic();
+ }
+ tracing_levels_par = l;
+ tracing_online_par = o;
+ show_box_depth_par = d;
+ show_box_breadth_par = b;
+ }
+ break;
+ }
+ case show_the_code:
+ {
+ halfword head = tex_the_value_toks(1, NULL, 0);
+ tex_print_nlp();
+ tex_print_str("> ");
+ tex_show_token_list(head, null, default_token_show_max, 0);
+ tex_flush_token_list(head);
+ goto COMMON_ENDING;
+ }
+ case show_lists_code:
+ {
+ tex_begin_diagnostic();
+ tex_show_activities();
+ tex_end_diagnostic();
+ break;
+ }
+ case show_groups_code:
+ {
+ tex_begin_diagnostic();
+ tex_show_save_groups();
+ tex_end_diagnostic();
+ break;
+ }
+ case show_tokens_code:
+ {
+ halfword head = tex_the_detokenized_toks(NULL);
+ tex_print_nlp();
+ tex_print_str("> ");
+ tex_show_token_list(head, null, default_token_show_max, 0);
+ tex_flush_token_list(head);
+ goto COMMON_ENDING;
+ }
+ case show_ifs_code:
+ {
+ // if (! justshow) {
+ tex_begin_diagnostic();
+ // }
+ tex_show_ifs();
+ // if (! justshow) {
+ tex_end_diagnostic();
+ // }
+ break;
+ }
+ default:
+ /* can't happen */
+ break;
+ }
+ if (justshow) {
+ return;
+ } else {
+ /*tex By default we |justshow| now so the next is dead code. */
+ }
+ /*tex Complete a potentially long |\show| command: */
+ tex_handle_error_message_only("OK");
+ if (lmt_print_state.selector == terminal_and_logfile_selector_code && tracing_online_par <= 0) {
+ lmt_print_state.selector = terminal_selector_code;
+ tex_print_str(" (see the transcript file)"); /*tex Here |transcript| means |log|.*/
+ lmt_print_state.selector = terminal_and_logfile_selector_code;
+ }
+ COMMON_ENDING:
+ if (justshow) {
+ return;
+ } else if (lmt_error_state.interaction < error_stop_mode) {
+ tex_handle_error(
+ normal_error_type,
+ NULL, /* no message */
+ NULL /* no help */
+ );
+ --lmt_error_state.error_count;
+ /* } else if (tracing_online_par > 0) { */
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ NULL, /* no message */
+ "This isn't an error message; I'm just \\showing something.\n"
+ );
+ }
+}
+
+/*tex
+
+ These procedures get things started properly. The initializer sets up the function table. We
+ have a few aliases to run_functions that are also used otherwise.
+
+ We actually only have some 50 cases where there is a difference between the modes and it makes
+ sense now to combine the handling and move the mode checking to those combined functions. That
+ way we get a switch no longer a jump. Actually, some already share a function and check for the
+ mode. On the other hand, this is how \TEX\ does it.
+
+ When we have version 2.10 released I might move the mode tests to the runners so that we get a
+ smaller case cq. jump table and we might also go for mode 1 permanently. A side effect will be
+ that some commands codes will be collapsed (move and such).
+
+*/
+
+# if (main_control_mode == 0)
+
+# define register_runner(A,B,C,D) \
+ jump_table[vmode+(A)] = B; \
+ jump_table[hmode+(A)] = C; \
+ jump_table[mmode+(A)] = D
+
+# define register_simple(A,B) \
+ jump_table[vmode+(A)] = B; \
+ jump_table[hmode+(A)] = B; \
+ jump_table[mmode+(A)] = B
+
+# define register_asmath(A,B,C) \
+ jump_table[vmode+(A)] = B; \
+ jump_table[hmode+(A)] = B; \
+ jump_table[mmode+(A)] = C
+
+inline static void init_main_control(void)
+{
+
+ jump_table = lmt_memory_malloc((mmode + max_command_cmd + 1) * sizeof(main_control_function)) ;
+
+ if (jump_table) {
+
+# elif (main_control_mode == 1)
+
+# define register_runner(A,B,C,D) \
+ case A: \
+ switch (mode) { \
+ case vmode: B(); break; \
+ case hmode: C(); break; \
+ case mmode: D(); break; \
+ } \
+ break
+
+# define register_simple(A,B) \
+ case A: B(); break
+
+# define register_asmath(A,B,C) \
+ case A: if (mode == mmode) { C(); } else { B(); } break
+
+inline static void tex_aux_big_switch(int mode, int cmd)
+{
+
+ switch (cmd) {
+
+# else
+
+# define register_runner(A,B,C,D) \
+ case (vmode + A): B(); break; \
+ case (hmode + A): C(); break; \
+ case (mmode + A): D(); break;
+
+# define register_simple(A,B) \
+ case (vmode + A): B(); break; \
+ case (hmode + A): B(); break; \
+ case (mmode + A): B(); break;
+
+# define register_asmath(A,B,C) \
+ case (vmode + A): B(); break; \
+ case (hmode + A): B(); break; \
+ case (mmode + A): C(); break;
+
+inline static void tex_aux_big_switch(int mode, int cmd)
+{
+
+ switch (mode + cmd) {
+
+# endif
+
+ /*tex These have the same handler for each mode: */
+
+ register_simple(arithmic_cmd, tex_run_prefixed_command);
+ register_simple(register_attribute_cmd, tex_run_prefixed_command);
+ register_simple(internal_attribute_cmd, tex_run_prefixed_command);
+ register_simple(register_dimen_cmd, tex_run_prefixed_command);
+ register_simple(internal_dimen_cmd, tex_run_prefixed_command);
+ register_simple(set_font_property_cmd, tex_run_prefixed_command);
+ register_simple(register_glue_cmd, tex_run_prefixed_command);
+ register_simple(internal_glue_cmd, tex_run_prefixed_command);
+ register_simple(register_int_cmd, tex_run_prefixed_command);
+ register_simple(internal_int_cmd, tex_run_prefixed_command);
+ register_simple(register_mu_glue_cmd, tex_run_prefixed_command);
+ register_simple(internal_mu_glue_cmd, tex_run_prefixed_command);
+ register_simple(register_toks_cmd, tex_run_prefixed_command);
+ register_simple(internal_toks_cmd, tex_run_prefixed_command);
+ register_simple(define_char_code_cmd, tex_run_prefixed_command);
+ register_simple(def_cmd, tex_run_prefixed_command);
+ register_simple(define_family_cmd, tex_run_prefixed_command);
+ register_simple(define_font_cmd, tex_run_prefixed_command);
+ register_simple(hyphenation_cmd, tex_run_prefixed_command);
+ register_simple(let_cmd, tex_run_prefixed_command);
+ register_simple(prefix_cmd, tex_run_prefixed_command);
+ register_simple(register_cmd, tex_run_prefixed_command);
+ register_simple(set_auxiliary_cmd, tex_run_prefixed_command);
+ register_simple(set_box_cmd, tex_run_prefixed_command);
+ register_simple(set_box_property_cmd, tex_run_prefixed_command);
+ register_simple(set_font_cmd, tex_run_prefixed_command);
+ register_simple(set_interaction_cmd, tex_run_prefixed_command);
+ register_simple(set_math_parameter_cmd, tex_run_prefixed_command);
+ register_simple(set_page_property_cmd, tex_run_prefixed_command);
+ register_simple(set_specification_cmd, tex_run_prefixed_command);
+ register_simple(shorthand_def_cmd, tex_run_prefixed_command);
+ register_simple(lua_value_cmd, tex_run_prefixed_command);
+
+ register_simple(integer_cmd, tex_aux_run_illegal_case); /*tex This is better than |run_relax|. */
+ register_simple(dimension_cmd, tex_aux_run_illegal_case); /*tex This is better than |run_relax|. */
+ register_simple(gluespec_cmd, tex_aux_run_illegal_case); /*tex This is better than |run_relax|. */
+ register_simple(mugluespec_cmd, tex_aux_run_illegal_case); /*tex This is better than |run_relax|. */
+
+ register_simple(fontspec_cmd, tex_run_font_spec);
+
+ // register_simple(some_item_cmd, tex_aux_run_illegal_case);
+ register_simple(some_item_cmd, tex_run_prefixed_command);
+ register_simple(iterator_value_cmd, tex_aux_run_illegal_case);
+ register_simple(parameter_cmd, tex_aux_run_illegal_case);
+
+ register_simple(after_something_cmd, tex_aux_run_after_something);
+ register_simple(begin_group_cmd, tex_aux_run_begin_group);
+ register_simple(penalty_cmd, tex_aux_run_penalty);
+ register_simple(case_shift_cmd, tex_aux_run_shift_case);
+ register_simple(catcode_table_cmd, tex_aux_run_catcode_table);
+ register_simple(combine_toks_cmd, tex_run_prefixed_command);
+ // register_simple(combine_toks_cmd, tex_run_combine_the_toks);
+ register_simple(end_cs_name_cmd, tex_aux_run_cs_error);
+ register_simple(end_group_cmd, tex_aux_run_end_group);
+ register_simple(end_local_cmd, tex_aux_run_end_local);
+ register_simple(ignore_something_cmd, tex_aux_run_ignore_something);
+ register_simple(insert_cmd, tex_run_insert);
+ register_simple(kern_cmd, tex_aux_run_kern);
+ register_simple(leader_cmd, tex_aux_run_leader);
+ register_simple(legacy_cmd, tex_aux_run_legacy);
+ register_simple(local_box_cmd, tex_aux_run_local_box);
+ register_simple(lua_protected_call_cmd, tex_aux_run_lua_protected_call);
+ register_simple(lua_function_call_cmd, tex_aux_run_lua_function_call);
+ register_simple(make_box_cmd, tex_aux_run_make_box);
+ register_simple(set_mark_cmd, tex_run_mark);
+ register_simple(message_cmd, tex_aux_run_message);
+ register_simple(node_cmd, tex_aux_run_node);
+ register_simple(relax_cmd, tex_aux_run_relax);
+ register_simple(remove_item_cmd, tex_aux_run_remove_item);
+ register_simple(right_brace_cmd, tex_aux_run_right_brace);
+ register_simple(vcenter_cmd, tex_run_vcenter);
+ register_simple(xray_cmd, tex_aux_run_show_whatever);
+
+ register_simple(alignment_cmd, tex_run_alignment_error);
+ register_simple(end_template_cmd, tex_run_alignment_end_template);
+ register_simple(alignment_tab_cmd, tex_run_alignment_error);
+
+ /*tex These have different handlers but a common h/v mode: */
+
+ register_asmath(math_fraction_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_fraction);
+ register_asmath(delimiter_number_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_delimiter_number);
+ register_asmath(math_fence_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_fence);
+ register_asmath(math_modifier_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_modifier);
+ register_asmath(math_accent_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_accent);
+ register_asmath(math_choice_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_choice);
+ register_asmath(math_component_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_math_component);
+ register_asmath(math_style_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_style);
+ register_asmath(mkern_cmd, tex_aux_run_insert_dollar_sign, tex_aux_run_mkern);
+ register_asmath(mskip_cmd, tex_aux_run_insert_dollar_sign, tex_aux_run_mglue);
+ register_asmath(math_radical_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_radical);
+ register_asmath(subscript_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_script);
+ register_asmath(superscript_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_script);
+ register_asmath(math_script_cmd, tex_aux_run_insert_dollar_sign, tex_run_math_script);
+
+ register_asmath(equation_number_cmd, tex_aux_run_illegal_case, tex_run_math_equation_number);
+
+ register_asmath(left_brace_cmd, tex_aux_run_left_brace, tex_run_math_left_brace);
+
+ /*tex These have different handlers: */
+
+ register_runner(italic_correction_cmd, tex_aux_run_illegal_case, tex_aux_run_text_italic_correction, tex_run_math_italic_correction);
+ register_runner(math_char_number_cmd, tex_aux_run_math_non_math, tex_run_text_math_char_number, tex_run_math_math_char_number);
+ // register_runner(math_char_given_cmd, tex_aux_run_math_non_math, tex_run_text_math_char_given, tex_run_math_math_char_given);
+ // register_runner(math_char_xgiven_cmd, tex_aux_run_math_non_math, tex_run_text_math_char_xgiven, tex_run_math_math_char_xgiven);
+ register_runner(mathspec_cmd, tex_aux_run_math_non_math, tex_run_text_math_spec, tex_run_math_math_spec);
+ register_runner(vadjust_cmd, tex_aux_run_illegal_case, tex_run_vadjust, tex_run_vadjust);
+
+ register_runner(char_given_cmd, tex_aux_run_new_paragraph, tex_aux_run_text_letter, tex_run_math_letter);
+ register_runner(other_char_cmd, tex_aux_run_new_paragraph, tex_aux_run_text_letter, tex_run_math_letter);
+ register_runner(letter_cmd, tex_aux_run_new_paragraph, tex_aux_run_text_letter, tex_run_math_letter);
+
+ register_runner(accent_cmd, tex_aux_run_new_paragraph, tex_aux_run_text_accent, tex_run_math_accent);
+ register_runner(boundary_cmd, tex_aux_run_par_boundary, tex_aux_run_text_boundary, tex_aux_run_math_boundary);
+ register_runner(char_number_cmd, tex_aux_run_new_paragraph, tex_aux_run_text_char_number, tex_run_math_char_number);
+ register_runner(discretionary_cmd, tex_aux_run_new_paragraph, tex_aux_run_discretionary, tex_aux_run_discretionary);
+ register_runner(explicit_space_cmd, tex_aux_run_new_paragraph, tex_aux_run_space, tex_aux_run_space);
+ register_runner(math_shift_cmd, tex_aux_run_new_paragraph, tex_run_math_initialize, tex_run_math_shift);
+ register_runner(math_shift_cs_cmd, tex_aux_run_new_paragraph, tex_run_math_initialize, tex_run_math_shift);
+
+ register_runner(end_paragraph_cmd, tex_aux_run_paragraph_end_vmode, tex_aux_run_paragraph_end_hmode, tex_aux_run_relax);
+ register_runner(spacer_cmd, tex_aux_run_relax, tex_aux_run_space, tex_aux_run_math_space);
+ register_runner(begin_paragraph_cmd, tex_aux_run_begin_paragraph_vmode, tex_aux_run_begin_paragraph_hmode, tex_aux_run_begin_paragraph_mmode);
+ register_runner(end_job_cmd, tex_aux_run_end_job, tex_aux_run_head_for_vmode, tex_aux_run_insert_dollar_sign);
+
+ /*tex
+ These can share a handler if we move the mode test (we then also have 5 command codes
+ less) but it becomes less pretty for rules and so. When in the wrong more, a mode change
+ is enforced and the token is pushed back and ready for a new inspection.
+ */
+
+ register_runner(hmove_cmd, tex_aux_run_move, tex_aux_run_illegal_case, tex_aux_run_illegal_case);
+ register_runner(vmove_cmd, tex_aux_run_illegal_case, tex_aux_run_move, tex_aux_run_move);
+
+ register_runner(hskip_cmd, tex_aux_run_new_paragraph, tex_aux_run_glue, tex_aux_run_glue);
+ register_runner(vskip_cmd, tex_aux_run_glue, tex_aux_run_head_for_vmode, tex_aux_run_insert_dollar_sign);
+
+ register_runner(un_hbox_cmd, tex_aux_run_new_paragraph, tex_run_unpackage, tex_run_unpackage);
+ register_runner(un_vbox_cmd, tex_run_unpackage, tex_aux_run_head_for_vmode, tex_aux_run_insert_dollar_sign);
+
+ register_runner(halign_cmd, tex_run_alignment_initialize, tex_aux_run_head_for_vmode, tex_aux_run_halign_mmode);
+ register_runner(valign_cmd, tex_aux_run_new_paragraph, tex_run_alignment_initialize, tex_aux_run_insert_dollar_sign);
+
+ register_runner(hrule_cmd, tex_aux_run_hrule, tex_aux_run_head_for_vmode, tex_aux_run_insert_dollar_sign);
+ register_runner(vrule_cmd, tex_aux_run_new_paragraph, tex_aux_run_vrule, tex_aux_run_mrule);
+
+ /* Just in case: */
+
+ register_runner(ignore_cmd, tex_aux_run_relax, tex_aux_run_relax, tex_aux_run_relax);
+
+ /*tex The next is unlikely to happen but compilers like the check. */
+
+# if (main_control_mode == 0)
+ } else {
+# else
+ default:
+ printf("cmd code %i", cmd);
+ tex_confusion("unknown cmd code");
+ break;
+# endif
+ }
+
+}
+
+# if (main_control_mode == 0)
+
+inline static void tex_aux_big_switch(int mode, int cmd)
+{
+ (jump_table[mode + cmd])();
+}
+
+# endif
+
+/*tex
+ Some preset values no longer make sense, like family 1 for some math symbols but we keep them
+ for compatibility reasons. All settings are moved to the relevant modules.
+
+*/
+
+void tex_initialize_variables(void)
+{
+ if (lmt_main_state.run_state == initializing_state) {
+ /* mag_par = 1000; */
+ tolerance_par = default_tolerance;
+ hang_after_par = default_hangafter;
+ max_dead_cycles_par = default_deadcycles;
+ math_pre_display_gap_factor_par = default_pre_display_gap;
+ /* pre_binary_penalty_par = infinite_penalty; */
+ /* pre_relation_penalty_par = infinite_penalty; */
+ /* math_script_box_mode_par = 1; */
+ /* math_script_char_mode_par = 1; */
+ /* math_flatten_mode_par = 1; */ /*tex We default to ord */ /* obsolete */
+ math_font_control_par = assumed_math_control;
+ math_eqno_gap_step_par = default_eqno_gap_step;
+ px_dimen_par = one_bp;
+ show_node_details_par = 2; /*tex $>1$: |[subtype]| $>2$: |[attributes]| */
+ ex_hyphen_char_par = '-';
+ escape_char_par = '\\';
+ end_line_char_par = '\r';
+ output_box_par = default_output_box;
+ adjust_spacing_step_par = -1;
+ adjust_spacing_stretch_par = -1;
+ adjust_spacing_shrink_par = -1;
+ math_double_script_mode_par = -1,
+ math_glue_mode_par = default_math_glue_mode;
+ hyphenation_mode_par = default_hyphenation_mode;
+ glyph_scale_par = 1000;
+ glyph_x_scale_par = 1000;
+ glyph_y_scale_par = 1000;
+ glyph_x_offset_par = 0;
+ glyph_y_offset_par = 0;
+ math_begin_class_par = math_begin_class;
+ math_end_class_par = math_end_class;
+ math_left_class_par = unset_noad_class;
+ math_right_class_par = unset_noad_class;
+ aux_get_date_and_time(&time_par, &day_par, &month_par, &year_par, &lmt_engine_state.utc_time);
+ }
+}
diff --git a/source/luametatex/source/tex/texmaincontrol.h b/source/luametatex/source/tex/texmaincontrol.h
new file mode 100644
index 000000000..b71aaedac
--- /dev/null
+++ b/source/luametatex/source/tex/texmaincontrol.h
@@ -0,0 +1,76 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_MAINCONTROL_H
+# define LMT_MAINCONTROL_H
+
+/*tex
+
+ 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.
+
+*/
+
+typedef enum control_states {
+ goto_next_state,
+ goto_skip_token_state,
+ goto_return_state,
+} control_states;
+
+typedef struct main_control_state_info {
+ control_states control_state;
+ int local_level;
+ halfword after_token;
+ halfword after_tokens;
+ halfword last_par_context;
+ halfword loop_iterator;
+ halfword loop_nesting;
+ halfword quit_loop;
+} main_control_state_info;
+
+typedef enum saved_discretionary_items {
+ saved_discretionary_item_component = 0,
+ saved_discretionary_n_of_items = 1,
+} saved_discretionary_items;
+
+extern main_control_state_info lmt_main_control_state;
+
+extern void tex_initialize_variables (void);
+extern int tex_main_control (void);
+
+extern void tex_normal_paragraph (int context);
+extern void tex_begin_paragraph (int doindent, int context);
+extern void tex_end_paragraph (int group, int context);
+extern int tex_wrapped_up_paragraph (int context);
+
+extern void tex_insert_paragraph_token (void);
+
+extern int tex_in_privileged_mode (void);
+extern void tex_you_cant_error (const char *helpinfo);
+
+extern void tex_off_save (void);
+
+extern halfword tex_local_scan_box (void);
+extern void tex_box_end (int boxcontext, halfword boxnode, scaled shift, halfword mainclass);
+
+extern void tex_get_r_token (void);
+
+extern void tex_begin_local_control (void);
+extern void tex_end_local_control (void);
+extern void tex_local_control (int obeymode);
+extern void tex_local_control_message (const char *s);
+extern void tex_page_boundary_message (const char *s, halfword boundary);
+
+extern void tex_inject_text_or_line_dir (int d, int check_glue);
+
+extern void tex_run_prefixed_command (void);
+
+extern void tex_handle_assignments (void); /*tex Used in math. */
+
+extern void tex_assign_internal_int_value (int a, halfword p, int val);
+extern void tex_assign_internal_attribute_value (int a, halfword p, int val);
+extern void tex_assign_internal_dimen_value (int a, halfword p, int val);
+extern void tex_assign_internal_skip_value (int a, halfword p, int val);
+
+# endif
diff --git a/source/luametatex/source/tex/texmarks.c b/source/luametatex/source/tex/texmarks.c
new file mode 100644
index 000000000..060c5f579
--- /dev/null
+++ b/source/luametatex/source/tex/texmarks.c
@@ -0,0 +1,346 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ A control sequence that has been |\def|'ed by the user is expanded by \TEX's |macro_call|
+ procedure.
+
+ Before we get into the details of |macro_call|, however, let's consider the treatment of
+ primitives like |\topmark|, since they are essentially macros without parameters. The token
+ lists for such marks are kept in five global arrays of pointers; we refer to the individual
+ entries of these arrays by symbolic macros |top_mark|, etc. The value of |top_mark (x)|, etc.
+ is either |null| or a pointer to the reference count of a token list.
+
+ The variable |biggest_used_mark| is an aid to try and keep the code somehwat efficient without
+ too much extra work: it registers the highest mark class ever instantiated by the user, so the
+ loops in |fire_up| and |vsplit| do not have to traverse the full range |0 .. biggest_mark|.
+
+ Watch out: zero is always valid and the good old single mark!
+
+ Todo: class -> index
+
+*/
+
+mark_state_info lmt_mark_state = {
+ .data = NULL,
+ .min_used = -1,
+ .max_used = -1,
+ .mark_data = {
+ .minimum = min_mark_size,
+ .maximum = max_mark_size,
+ .size = memory_data_unset,
+ .step = stp_mark_size,
+ .allocated = 0,
+ .itemsize = sizeof(mark_record),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+};
+
+void tex_initialize_marks(void)
+{
+ /* allocated: minimum + 1 */
+ lmt_mark_state.data = aux_allocate_clear_array(sizeof(mark_record), lmt_mark_state.mark_data.minimum, 1);
+ if (lmt_mark_state.data) {
+ lmt_mark_state.mark_data.allocated = sizeof(mark_record) * lmt_mark_state.mark_data.minimum;
+ lmt_mark_state.mark_data.top = lmt_mark_state.mark_data.minimum;
+ }
+}
+
+void tex_reset_mark(halfword m)
+{
+ if (m >= lmt_mark_state.mark_data.top) {
+ int step = lmt_mark_state.mark_data.step;
+ int size = lmt_mark_state.mark_data.top;
+ /* regular stepwise bump */
+ while (m >= size) {
+ size += step;
+ }
+ /* last resort */
+ if (size > lmt_mark_state.mark_data.maximum) {
+ size = m;
+ }
+ if (size <= lmt_mark_state.mark_data.maximum) {
+ mark_record *tmp = aux_reallocate_array(lmt_mark_state.data, sizeof(mark_record), (size_t) size, 1);
+ if (tmp) {
+ lmt_mark_state.data = tmp;
+ memset(&lmt_mark_state.data[lmt_mark_state.mark_data.top], 0, sizeof(mark_record) * (size - lmt_mark_state.mark_data.top));
+ lmt_mark_state.mark_data.top = size;
+ lmt_mark_state.mark_data.allocated = sizeof(mark_record) * ((size_t) size);
+ } else {
+ tex_overflow_error("marks", size);
+ }
+ } else {
+ tex_overflow_error("marks", lmt_mark_state.mark_data.maximum);
+ }
+ }
+ if (m > lmt_mark_state.mark_data.ptr) {
+ lmt_mark_state.mark_data.ptr = m;
+ }
+ tex_wipe_mark(m);
+}
+
+halfword tex_get_mark(halfword m, halfword s)
+{
+ if (s >= 0 && s <= last_unique_mark_code) {
+ return lmt_mark_state.data[m][s];
+ } else {
+ return null;
+ }
+}
+
+void tex_set_mark(halfword m, halfword s, halfword v)
+{
+ if (s >= 0 && s <= last_unique_mark_code) {
+ if (lmt_mark_state.data[m][s]) {
+ tex_delete_token_reference(lmt_mark_state.data[m][s]);
+ }
+ if (v) {
+ tex_add_token_reference(v);
+ }
+ lmt_mark_state.data[m][s] = v;
+ }
+}
+
+int tex_valid_mark(halfword m) {
+ if (m >= lmt_mark_state.mark_data.top) {
+ tex_reset_mark(m);
+ }
+ return m < lmt_mark_state.mark_data.top;
+}
+
+halfword tex_new_mark(quarterword subtype, halfword class, halfword ptr)
+{
+ halfword mark = tex_new_node(mark_node, subtype);
+ mark_index(mark) = class;
+ mark_ptr(mark) = ptr;
+ if (lmt_mark_state.min_used < 0) {
+ lmt_mark_state.min_used = class;
+ lmt_mark_state.max_used = class;
+ } else {
+ if (class < lmt_mark_state.min_used) {
+ lmt_mark_state.min_used = class;
+ }
+ if (class > lmt_mark_state.max_used) {
+ lmt_mark_state.max_used = class;
+ }
+ }
+ tex_set_mark(class, current_marks_code, ptr);
+ return mark;
+}
+
+static void tex_aux_print_mark(const char *s, halfword t)
+{
+ if (t) {
+ tex_print_token_list(s, token_link(t));
+ }
+}
+
+void tex_show_marks()
+{
+ if (tracing_marks_par > 0 && lmt_mark_state.min_used >= 0) {
+ tex_begin_diagnostic();
+ for (halfword m = lmt_mark_state.min_used; m <= lmt_mark_state.max_used; m++) {
+ if (tex_has_mark(m)) {
+ tex_print_format("[mark: class %i, page state]",m);
+ tex_aux_print_mark("top", tex_get_mark(m, top_marks_code));
+ tex_aux_print_mark("first", tex_get_mark(m, first_marks_code));
+ tex_aux_print_mark("bot", tex_get_mark(m, bot_marks_code));
+ tex_aux_print_mark("split first", tex_get_mark(m, split_first_marks_code));
+ tex_aux_print_mark("split bot", tex_get_mark(m, split_bot_marks_code));
+ tex_aux_print_mark("current", tex_get_mark(m, current_marks_code));
+ }
+ }
+ tex_end_diagnostic();
+ }
+}
+
+void tex_update_top_marks()
+{
+ if (lmt_mark_state.min_used >= 0) {
+ for (halfword m = lmt_mark_state.min_used; m <= lmt_mark_state.max_used; m++) {
+ halfword bot = tex_get_mark(m, bot_marks_code);
+ if (bot) {
+ tex_set_mark(m, top_marks_code, bot);
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: class %i, top becomes bot]", m);
+ tex_aux_print_mark(NULL, bot);
+ tex_end_diagnostic();
+ }
+ tex_delete_mark(m, first_marks_code);
+ }
+ }
+ }
+}
+
+void tex_update_first_and_bot_mark(halfword n)
+{
+ halfword index = mark_index(n);
+ halfword ptr = mark_ptr(n);
+ if (node_subtype(n) == reset_mark_value_code) {
+ /*tex Work in progress. */
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: index %i, reset]", index);
+ tex_end_diagnostic();
+ }
+ tex_reset_mark(index);
+ } else {
+ /*tex Update the values of |first_mark| and |bot_mark|. */
+ halfword first = tex_get_mark(index, first_marks_code);
+ if (! first) {
+ tex_set_mark(index, first_marks_code, ptr);
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: index %i, first becomes mark]", index);
+ tex_aux_print_mark(NULL, ptr);
+ tex_end_diagnostic();
+ }
+ }
+ tex_set_mark(index, bot_marks_code, ptr);
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: index %i, bot becomes mark]", index);
+ tex_aux_print_mark(NULL, ptr);
+ tex_end_diagnostic();
+ }
+ }
+}
+
+void tex_update_first_marks(void)
+{
+ if (lmt_mark_state.min_used >= 0) {
+ for (halfword m = lmt_mark_state.min_used; m <= lmt_mark_state.max_used; m++) {
+ halfword top = tex_get_mark(m, top_marks_code);
+ halfword first = tex_get_mark(m, first_marks_code);
+ if (top && ! first) {
+ tex_set_mark(m, first_marks_code, top);
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: class %i, first becomes top]", m);
+ tex_aux_print_mark(NULL, top);
+ tex_end_diagnostic();
+ }
+ }
+ }
+ }
+}
+
+void tex_update_split_mark(halfword n)
+{
+ halfword index = mark_index(n);
+ halfword ptr = mark_ptr(n);
+ if (node_subtype(n) == reset_mark_value_code) {
+ tex_reset_mark(index);
+ } else {
+ if (tex_get_mark(index, split_first_marks_code)) {
+ tex_set_mark(index, split_bot_marks_code, ptr);
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: index %i, split bot becomes mark]", index);
+ tex_aux_print_mark(NULL, tex_get_mark(index, split_bot_marks_code));
+ tex_end_diagnostic();
+ }
+ } else {
+ tex_set_mark(index, split_first_marks_code, ptr);
+ tex_set_mark(index, split_bot_marks_code, ptr);
+ if (tracing_marks_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[mark: index %i, split first becomes mark]", index);
+ tex_aux_print_mark(NULL, tex_get_mark(index, split_first_marks_code));
+ tex_print_format("[mark: index %i, split bot becomes split first]", index);
+ tex_aux_print_mark(NULL, tex_get_mark(index, split_bot_marks_code));
+ tex_end_diagnostic();
+ }
+ }
+ }
+}
+
+
+void tex_delete_mark(halfword m, int what)
+{
+ switch (what) {
+ case top_mark_code : what = top_marks_code;
+ case first_mark_code : what = first_marks_code;
+ case bot_mark_code : what = bot_marks_code;
+ case split_first_mark_code: what = split_first_marks_code;
+ case split_bot_mark_code : what = split_bot_marks_code;
+ }
+ tex_set_mark(m, what, null);
+}
+
+halfword tex_get_some_mark(halfword chr, halfword val)
+{
+ switch (chr) {
+ case top_mark_code : val = top_marks_code;
+ case first_mark_code : val = first_marks_code;
+ case bot_mark_code : val = bot_marks_code;
+ case split_first_mark_code: val = split_first_marks_code;
+ case split_bot_mark_code : val = split_bot_marks_code;
+ }
+ return tex_get_mark(val, chr);
+}
+
+void tex_wipe_mark(halfword m)
+{
+ for (int what = 0; what <= last_unique_mark_code; what++) {
+ tex_set_mark(m, what, null);
+ }
+}
+
+int tex_has_mark(halfword m)
+{
+ for (int what = 0; what <= last_unique_mark_code; what++) {
+ if (lmt_mark_state.data[m][what]) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ The |make_mark| procedure has been renamed, because if the current chr code is 1, then the
+ actual command was |\clearmarks|, which did not generate a mark node but instead destroyed the
+ current mark related tokenlists. We now have proper reset nodes.
+
+*/
+
+void tex_run_mark(void)
+{
+ halfword class = 0;
+ halfword code = cur_chr;
+ switch (code) {
+ case set_marks_code:
+ case clear_marks_code:
+ case flush_marks_code:
+ class = tex_scan_mark_number();
+ break;
+ }
+ if (tex_valid_mark(class)) {
+ quarterword subtype = set_mark_value_code;
+ halfword ptr = null;
+ switch (code) {
+ case set_marks_code:
+ case set_mark_code:
+ ptr = tex_scan_toks_expand(0, NULL, 0);
+ break;
+ case clear_marks_code:
+ tex_wipe_mark(class);
+ return;
+ case flush_marks_code:
+ subtype = reset_mark_value_code;
+ break;
+ }
+ tex_tail_append(tex_new_mark(subtype, class, ptr));
+ } else {
+ /* error already issued */
+ }
+}
diff --git a/source/luametatex/source/tex/texmarks.h b/source/luametatex/source/tex/texmarks.h
new file mode 100644
index 000000000..e787fa9d0
--- /dev/null
+++ b/source/luametatex/source/tex/texmarks.h
@@ -0,0 +1,65 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_MARKS_H
+# define LMT_MARKS_H
+
+typedef enum get_mark_codes {
+ current_marks_code,
+ top_marks_code,
+ first_marks_code,
+ bot_marks_code,
+ split_first_marks_code,
+ split_bot_marks_code,
+ /* these map to zero */
+ top_mark_code, /*tex the mark in effect at the previous page break */
+ first_mark_code, /*tex the first mark between |top_mark| and |bot_mark| */
+ bot_mark_code, /*tex the mark in effect at the current page break */
+ split_first_mark_code, /*tex the first mark found by |\vsplit| */
+ split_bot_mark_code, /*tex the last mark found by |\vsplit| */
+} get_mark_codes;
+
+# define first_valid_mark_code top_marks_code
+# define last_unique_mark_code split_bot_marks_code
+# define last_get_mark_code split_bot_mark_code
+
+typedef enum set_mark_codes {
+ set_mark_code,
+ set_marks_code,
+ clear_marks_code,
+ flush_marks_code,
+} set_mark_codes;
+
+# define last_set_mark_code flush_marks_code
+
+typedef halfword mark_record[split_bot_marks_code+1];
+
+typedef struct mark_state_info {
+ mark_record *data;
+ int min_used;
+ int max_used;
+ memory_data mark_data;
+} mark_state_info;
+
+extern mark_state_info lmt_mark_state;
+
+extern void tex_initialize_marks (void);
+extern int tex_valid_mark (halfword m);
+extern void tex_reset_mark (halfword m);
+extern void tex_wipe_mark (halfword m);
+extern void tex_delete_mark (halfword m, int what);
+extern halfword tex_get_some_mark (halfword chr, halfword val);
+extern halfword tex_new_mark (quarterword subtype, halfword cls, halfword ptr);
+extern void tex_update_top_marks (void);
+extern void tex_update_first_and_bot_mark (halfword m);
+extern void tex_update_first_marks (void);
+extern void tex_update_split_mark (halfword m);
+extern void tex_show_marks (void);
+extern int tex_has_mark (halfword m);
+extern halfword tex_get_mark (halfword m, halfword s);
+extern void tex_set_mark (halfword m, halfword s, halfword v);
+
+extern void tex_run_mark (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texmath.c b/source/luametatex/source/tex/texmath.c
new file mode 100644
index 000000000..d38cbf182
--- /dev/null
+++ b/source/luametatex/source/tex/texmath.c
@@ -0,0 +1,5593 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ The code can be simplified a lot when we decide that traditional 8 bit fonts are virtualized in
+ a way that avoids the split delimiter definitions (small and large) and that the traditional
+ way to define characters is dropped in favor of the unicode variants. So, this might happen at
+ some point. After all it makes no sense to use this engine with traditional fonts because there
+ \PDFTEX\ is a better choice.
+
+ We might also benefit more from the fact that we have prev pointers. Occasionally I visit this
+ file and make some variables more verbose. I'm in no hurry with that.
+
+*/
+
+/*tex
+
+ When \TEX\ reads a formula that is enclosed between |$|'s, it constructs an \quote {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 \quote {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 \quote {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 \quote {noads}
+ (pronounced \quotation {no-adds}), to distinguish them from the somewhat similar \quote {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|.
+
+ \startitemize
+
+ \startitem
+ |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.
+ \stopitem
+
+ \startitem
+ |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.)
+ \stopitem
+
+ \startitem
+ |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.
+ \stopitem
+
+ \startitem
+ |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.
+ \stopitem
+
+ \startitem
+ 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 \quote {italic correction} added to the width of |P|, but the \quote {script
+ skip} will be added).
+ \stopitem
+
+ \startitemize
+
+ Concerning display skips, \TEX\ normally always inserts before and only after when larger than
+ zero. This can now be controlled with |\mathdisplayskipmode|:
+
+ \starttabulate
+ \NC 0 \NC normal \TEX \NC \NR
+ \NC 1 \NC always \NC \NR
+ \NC 2 \NC non-zero \NC \NR
+ \NC 3 \NC ignore \NC \NR
+ \stoptabulate
+
+*/
+
+math_state_info lmt_math_state = {
+ .size = 0,
+ .level = 0,
+ /* .opentype = 1, */
+ /* .padding = 0, */
+ .par_head = NULL,
+ .fam_head = NULL,
+ .last_left = 0,
+ .last_right = 0,
+ .last_atom = 0,
+ .scale = 1000,
+};
+
+static int tex_aux_scan_math (halfword p, halfword style, int usetextfont, halfword toks, halfword toks_text, int nocomponent, halfword cls, halfword all);
+static halfword tex_aux_finish_math_list (halfword p);
+static void tex_aux_math_math_component (halfword n, int append);
+
+# define cramped 1
+
+# define cramped_style(A) (2 * ((A) / 2) + cramped) /*tex cramp the style */
+# define sub_style(A) (2 * ((A) / 4) + script_style + cramped) /*tex smaller and cramped */
+# define sup_style(A) (2 * ((A) / 4) + script_style + ((A) % 2)) /*tex smaller */
+# define num_style(A) ((A) + 2 - 2 * ((A) / 6)) /*tex smaller unless already scriptscript */
+# define denom_style(A) (2 * ((A) / 2) + cramped + 2 - 2 * ((A) / 6)) /*tex smaller, cramped */
+# define sup_sup_style(A) sup_style(sup_style((A))) /*tex smaller */
+
+inline static mathdictval tex_fake_math_dict(halfword chr)
+{
+ mathdictval d = { 0, 0, 0 };
+ if (math_dict_properties_par || math_dict_group_par) {
+ d.properties = (unsigned short) math_dict_properties_par;
+ d.group = (unsigned short) math_dict_group_par;
+ d.index = (unsigned int) chr;
+ }
+ return d;
+}
+
+void tex_math_copy_char_data(halfword target, halfword source, int wipelist)
+{
+ if (node_type(source) == math_char_node) {
+ kernel_math_family(target) = kernel_math_family(source);
+ kernel_math_character(target) = kernel_math_character(source);
+ kernel_math_options(target) = kernel_math_options(source);
+ kernel_math_properties(target) = kernel_math_properties(source);
+ kernel_math_group(target) = kernel_math_group(source);
+ kernel_math_index(target) = kernel_math_index(source);
+ } else {
+ kernel_math_list(target) = kernel_math_list(source);
+ if (wipelist) {
+ kernel_math_list(source) = null;
+ }
+ }
+}
+
+// static const math_styles map_cramped_style[] = { /*tex cramp the style */
+// cramped_display_style,
+// cramped_display_style,
+// cramped_text_style,
+// cramped_text_style,
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// };
+//
+// static const math_styles map_subscript_style[] = { /*tex smaller and cramped */
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// };
+//
+// static const math_styles map_superscript_style[] = { /*tex smaller */
+// script_style,
+// script_style,
+// script_style,
+// script_style,
+// script_script_style,
+// script_script_style,
+// script_script_style,
+// script_script_style,
+// };
+//
+// static const math_styles map_numerator_style[] = {/*tex smaller unless already scriptscript */
+// script_style,
+// cramped_script_style,
+// script_style,
+// cramped_script_style,
+// script_script_style,
+// cramped_script_script_style,
+// script_script_style,
+// cramped_script_script_style,
+// };
+//
+// static const math_styles map_denominator_style[] = { /*tex smaller, all cramped */
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// cramped_script_script_style,
+// };
+//
+// static const math_styles map_double_superscript_style[] = { /*tex smaller, keep cramped */
+// script_style,
+// cramped_script_style,
+// script_style,
+// cramped_script_style,
+// script_script_style,
+// cramped_script_script_style,
+// script_script_style,
+// cramped_script_script_style,
+// };
+
+/*tex
+ This is very \TEX: a variable class influences the family being used.
+*/
+
+halfword tex_size_of_style(halfword style)
+{
+ switch (style) {
+ case script_style:
+ case cramped_script_style:
+ return script_size;
+ case script_script_style:
+ case cramped_script_script_style:
+ return script_script_size;
+ break;
+ default:
+ return text_size;
+ }
+}
+
+halfword tex_math_style_variant(halfword style, halfword param)
+{
+ switch (tex_get_math_parameter(style, param, NULL)) {
+ case math_normal_style_variant:
+ return style;
+ case math_cramped_style_variant:
+ // return map_cramped_style[s];
+ return cramped_style(style);
+ case math_subscript_style_variant:
+ // return map_subscript_style[s];
+ return sub_style(style);
+ case math_superscript_style_variant:
+ case math_small_style_variant:
+ // return map_superscript_style[s];
+ return sup_style(style);
+ case math_smaller_style_variant:
+ case math_numerator_style_variant:
+ // return map_numerator_style[s];
+ return num_style(style);
+ case math_denominator_style_variant:
+ // return map_denominator_style[s];
+ return denom_style(style);
+ case math_double_superscript_variant:
+ // return map_double_superscript_style[s];
+ return sup_sup_style(style);
+ default:
+ return style;
+ }
+}
+
+int tex_math_has_class_option(halfword cls, int option)
+{
+ halfword value = count_parameter(first_math_options_code + cls);
+ if (value == no_class_options) {
+ unsigned parent = (unsigned) count_parameter(first_math_parent_code + cls);
+ cls = (parent >> 16) & 0xFF;
+ if (! valid_math_class_code(cls)) {
+ return 0;
+ }
+ value = count_parameter(first_math_options_code + cls);
+ }
+ return (value & option) == option;
+}
+
+static void tex_aux_unsave_math(void)
+{
+ tex_unsave();
+ lmt_save_state.save_stack_data.ptr -= saved_math_n_of_items;
+ tex_flush_node_list(lmt_dir_state.text_dir_ptr);
+ if (saved_type(saved_math_item_direction) == saved_text_direction) {
+ lmt_dir_state.text_dir_ptr = saved_value(saved_math_item_direction);
+ } else {
+ tex_confusion("unsave math");
+ }
+}
+
+/*tex
+
+ Sometimes it is necessary to destroy an mlist. The following subroutine empties the current
+ list, assuming that |abs(mode) = mmode|.
+
+*/
+
+void tex_flush_math(void)
+{
+ halfword head = cur_list.head;
+ tex_flush_node_list(node_next(head));
+ tex_flush_node_list(cur_list.incomplete_noad);
+ node_next(head) = null;
+ cur_list.tail = head;
+ cur_list.incomplete_noad = null;
+}
+
+/*tex A printing helper. */
+
+static void tex_aux_print_parameter(const char *what, halfword style, halfword param, halfword indirect, halfword value)
+{
+ tex_begin_diagnostic();
+ tex_print_char('{');
+ tex_print_str(what);
+ tex_print_char(' ');
+ if (indirect >= 0 && indirect <= last_math_indirect) {
+ tex_print_str(lmt_interface.math_indirect_values[indirect].name);
+ tex_print_char(' ');
+ }
+ if (param < math_parameter_last) {
+ tex_print_cmd_chr(set_math_parameter_cmd, param);
+ } else {
+ tex_print_format("%x %x ", math_parameter_spacing_left(param), math_parameter_spacing_right(param));
+ }
+ tex_print_cmd_chr(math_style_cmd, style);
+ tex_print_char('=');
+ switch (math_parameter_value_type(param)) {
+ case math_int_parameter:
+ case math_style_parameter:
+ tex_print_int(value);
+ break;
+ case math_dimen_parameter:
+ tex_print_dimension(value, pt_unit);
+ break;
+ case math_muglue_parameter:
+ tex_print_spec(value, mu_unit);
+ break;
+ default:
+ tex_print_int(value);
+ break;
+ }
+ tex_print_char('}');
+ tex_end_diagnostic();
+}
+
+static void tex_aux_print_fam(const char *what, halfword size, halfword fam)
+{
+ tex_begin_diagnostic();
+ tex_print_format("{%s %C %i=%F}", what, define_family_cmd, size, tex_fam_fnt(fam, size));
+ tex_end_diagnostic();
+}
+
+/*tex
+ Before we can do anything in math mode, we need fonts. We can use |max_n_of_math_families|
+ instead of 256 but we need to pack in bytes anyway so there is no gain.
+*/
+
+int tex_fam_fnt(int fam, int size)
+{
+ return (int) sa_get_item_4(lmt_math_state.fam_head, fam + (256 * size)).int_value;
+}
+
+void tex_def_fam_fnt(int fam, int size, int fnt, int level)
+{
+ sa_tree_item item;
+ item.int_value = fnt;
+ sa_set_item_4(lmt_math_state.fam_head, fam + (256 * size), item, level);
+ tex_fixup_math_parameters(fam, size, fnt, level);
+ if (tracing_assigns_par > 1) {
+ tex_aux_print_fam("assigning", size, fam);
+ }
+}
+
+static void tex_aux_unsave_math_fam_data(int gl)
+{
+ if (lmt_math_state.fam_head->stack) {
+ while (lmt_math_state.fam_head->sa_stack_ptr > 0 && abs(lmt_math_state.fam_head->stack[lmt_math_state.fam_head->sa_stack_ptr].level) >= (int) gl) {
+ sa_stack_item item = lmt_math_state.fam_head->stack[lmt_math_state.fam_head->sa_stack_ptr];
+ if (item.level > 0) {
+ sa_rawset_item_4(lmt_math_state.fam_head, item.code, item.value_1);
+ /*tex Now do a trace message, if requested. */
+ if (tracing_restores_par > 1) {
+ int size = item.code / 256;
+ int fam = item.code % 256;
+ tex_aux_print_fam("restoring", size, fam);
+ }
+ }
+ (lmt_math_state.fam_head->sa_stack_ptr)--;
+ }
+ }
+}
+
+/*tex Math parameters, we have a lot of them! Todo: move the style into 2 */
+
+void tex_def_math_parameter(int style, int param, scaled value, int level, int indirect)
+{
+ sa_tree_item item1, item2;
+ if (level <= 1) {
+ if (math_parameter_value_type(param) == math_muglue_parameter) {
+ item1 = sa_get_item_8(lmt_math_state.par_head, (param + (math_parameter_max_range * style)), &item2);
+ if (item2.int_value == indirect_math_regular && item1.int_value > thick_mu_skip_code) {
+ if (lmt_node_memory_state.nodesizes[item1.int_value]) {
+ tex_free_node(item1.int_value, glue_spec_size);
+ }
+ }
+ }
+ }
+ item1.int_value = value;
+ item2.int_value = indirect;
+ sa_set_item_8(lmt_math_state.par_head, (param + (math_parameter_max_range * style)), item1, item2, level);
+ if (tracing_assigns_par > 1) {
+ tex_aux_print_parameter("assigning", style, param, indirect, value);
+ }
+}
+
+// mukern .. there is no mudimen
+
+scaled tex_get_math_parameter(int style, int param, halfword *type)
+{
+ halfword indirect, value;
+ sa_tree_item v2;
+ sa_tree_item v1 = sa_get_item_8(lmt_math_state.par_head, (param + (math_parameter_max_range * style)), &v2);
+ indirect = v2.int_value == lmt_math_state.par_head->dflt.int_value ? indirect_math_unset : v2.uint_value;
+ value = v1.int_value;
+ switch (indirect) {
+ case indirect_math_unset:
+ if (type) {
+ *type = no_val_level;
+ }
+ return MATHPARAMDEFAULT;
+ /* we stored nothing */
+ case indirect_math_regular:
+ switch (math_parameter_value_type(param)) {
+ case math_dimen_parameter:
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return value;
+ case math_muglue_parameter:
+ if (type) {
+ *type = mu_val_level;
+ }
+ return value <= thick_mu_skip_code ? mu_glue_parameter(value) : value;
+ // case math_int_parameter:
+ // case math_style_parameter:
+ default:
+ if (type) {
+ *type = int_val_level;
+ }
+ return value;
+ }
+ /* we stored cs */
+ case indirect_math_integer:
+ if (! value) {
+ if (type) {
+ *type = int_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == integer_cmd) {
+ if (type) {
+ *type = int_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_dimension:
+ if (! value) {
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == dimension_cmd) {
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_mugluespec:
+ if (! value) {
+ if (type) {
+ *type = mu_val_level;
+ }
+ return value;
+ } else {
+ switch (eq_type(value)) {
+ case mugluespec_cmd:
+ if (type) {
+ *type = mu_val_level;
+ }
+ return eq_value(value);
+ default:
+ goto MISMATCH;
+ }
+
+ }
+ case indirect_math_gluespec:
+ if (! value) {
+ if (type) {
+ *type = glue_val_level;
+ }
+ return value;
+ } else {
+ switch (eq_type(value)) {
+ case gluespec_cmd:
+ if (type) {
+ *type = glue_val_level;
+ }
+ return eq_value(value);
+ default:
+ goto MISMATCH;
+ }
+ }
+ /* we stored chr */
+ case indirect_math_register_integer:
+ if (! value) {
+ if (type) {
+ *type = int_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == register_int_reference_cmd) {
+ if (type) {
+ *type = int_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_register_dimension:
+ if (! value) {
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == register_dimen_reference_cmd) {
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_register_gluespec:
+ if (! value) {
+ if (type) {
+ *type = glue_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == register_glue_reference_cmd) {
+ if (type) {
+ *type = glue_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_register_mugluespec:
+ if (! value) {
+ if (type) {
+ *type = mu_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == register_mu_glue_reference_cmd) {
+ if (type) {
+ *type = mu_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_internal_integer:
+ if (! value) {
+ if (type) {
+ *type = int_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == internal_int_reference_cmd) {
+ if (type) {
+ *type = int_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_internal_dimension:
+ if (! value) {
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == internal_dimen_reference_cmd) {
+ if (type) {
+ *type = dimen_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_internal_gluespec:
+ if (! value) {
+ if (type) {
+ *type = glue_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == internal_glue_reference_cmd) {
+ if (type) {
+ *type = glue_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ case indirect_math_internal_mugluespec:
+ if (! value) {
+ if (type) {
+ *type = mu_val_level;
+ }
+ return value;
+ } else if (eq_type(value) == internal_mu_glue_reference_cmd) {
+ if (type) {
+ *type = mu_val_level;
+ }
+ return eq_value(value);
+ } else {
+ goto MISMATCH;
+ }
+ default:
+ MISMATCH:
+ tex_handle_error(
+ normal_error_type,
+ "Invalid inherited math parameter",
+ "You probably changed the type of the inherited math parameter, so I will "
+ "use zero instead."
+ );
+ return 0;
+ }
+}
+
+int tex_has_math_parameter(int style, int param)
+{
+ sa_tree_item v2;
+ sa_get_item_8(lmt_math_state.par_head, (param + (math_parameter_max_range * style)), &v2);
+ return v2.int_value == lmt_math_state.par_head->dflt.int_value ? indirect_math_unset : v2.uint_value;
+}
+
+static void tex_aux_unsave_math_parameter_data(int gl)
+{
+ if (lmt_math_state.par_head->stack) {
+ while (lmt_math_state.par_head->sa_stack_ptr > 0 && abs(lmt_math_state.par_head->stack[lmt_math_state.par_head->sa_stack_ptr].level) >= (int) gl) {
+ sa_stack_item item = lmt_math_state.par_head->stack[lmt_math_state.par_head->sa_stack_ptr];
+ if (item.level > 0) {
+ int param = item.code % math_parameter_max_range;
+ int style = item.code / math_parameter_max_range;
+ sa_tree_item item1, item2;
+ if (math_parameter_value_type(param) == math_muglue_parameter) {
+ item1 = sa_get_item_8(lmt_math_state.par_head, item.code, &item2);
+ if (item2.int_value == indirect_math_regular && item1.int_value > thick_mu_skip_code) {
+ /* if (tex_valid_node(item1.int_value)) { */
+ if (lmt_node_memory_state.nodesizes[item1.int_value]) {
+ // printf("HERE 2.1: %i %i / %i %i / %i\n",item2.int_value,item1.int_value, item.value_1.int_value, item.value_2.int_value, node_type(item1.int_value));
+ tex_free_node(item1.int_value, glue_spec_size);
+ } else {
+ // printf("HERE 2.2: %i %i / %i %i / %i\n",item2.int_value,item1.int_value, item.value_1.int_value, item.value_2.int_value, node_type(item1.int_value));
+ }
+ }
+ }
+ sa_rawset_item_8(lmt_math_state.par_head, item.code, item.value_1, item.value_2);
+ /*tex Do a trace message, if requested. */
+ if (tracing_restores_par > 1) {
+ int indirect = item.value_2.int_value;
+ tex_aux_print_parameter("restoring", style, param, indirect, tex_get_math_parameter(style, param, NULL));
+ }
+ }
+ lmt_math_state.par_head->sa_stack_ptr--;
+ }
+ }
+}
+
+/*tex Saving and unsaving of both: */
+
+void tex_unsave_math_data(int level)
+{
+ tex_aux_unsave_math_fam_data(level);
+ tex_aux_unsave_math_parameter_data(level);
+}
+
+/*tex Dumping and undumping: */
+
+void tex_dump_math_data(dumpstream f)
+{
+ if (! lmt_math_state.fam_head) {
+ lmt_math_state.fam_head = sa_new_tree(MATHFONTSTACK, 4, (sa_tree_item) { .int_value = MATHFONTDEFAULT });
+ }
+ sa_dump_tree(f, lmt_math_state.fam_head);
+ if (! lmt_math_state.par_head) {
+ lmt_math_state.par_head = sa_new_tree(MATHPARAMSTACK, 8, (sa_tree_item) { .int_value = MATHPARAMDEFAULT });
+ }
+ sa_dump_tree(f, lmt_math_state.par_head);
+}
+
+void tex_undump_math_data(dumpstream f)
+{
+ lmt_math_state.fam_head = sa_undump_tree(f);
+ lmt_math_state.par_head = sa_undump_tree(f);
+}
+
+void tex_initialize_math(void)
+{
+ if (! lmt_math_state.fam_head) {
+ lmt_math_state.fam_head = sa_new_tree(MATHFONTSTACK, 4, (sa_tree_item) { .int_value = MATHFONTDEFAULT });
+ }
+ if (! lmt_math_state.par_head) {
+ lmt_math_state.par_head = sa_new_tree(MATHPARAMSTACK, 8, (sa_tree_item) { .int_value = MATHPARAMDEFAULT });
+ tex_initialize_math_spacing();
+ }
+ return;
+}
+
+/*tex
+
+ 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 \quote {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 \quote {small} and \quote
+ {large} starting characters, as explained in Chapter~17 of {\em 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 |preset_rule_thickness| is used to stand for the |preset_rule_thickness| of the current
+ size. The |numerator| and |denominator| point to mlists that define a fraction; we always have
+ |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|.
+
+*/
+
+halfword tex_new_sub_box(halfword curbox)
+{
+ halfword noad = tex_new_node(simple_noad, ordinary_noad_subtype);
+ halfword sbox = tex_new_node(sub_box_node, 0);
+ noad_nucleus(noad) = sbox;
+ kernel_math_list(sbox) = curbox;
+ return noad;
+}
+
+quarterword tex_aux_set_math_char(halfword target, mathcodeval *mval, mathdictval *dval)
+{
+ halfword hmcode = tex_get_hm_code(mval->character_value);
+ kernel_math_character(target) = mval->character_value;
+ if (mval->class_value == math_use_current_family_code) {
+ kernel_math_family(target) = cur_fam_par_in_range ? cur_fam_par : 0;
+ node_subtype(target) = ordinary_noad_subtype;
+ } else {
+ kernel_math_family(target) = mval->family_value;
+ node_subtype(target) = mval->class_value;
+ }
+ if (dval) {
+ kernel_math_properties(target) = dval->properties;
+ kernel_math_group(target) = dval->group;
+ kernel_math_index(target) = dval->index;
+ }
+ if ((hmcode & auto_discretionary_normal) == auto_discretionary_normal) { // has_discretionary_normal
+ math_kernel_node_set_option(target, math_kernel_auto_discretionary);
+ }
+ if ((hmcode & auto_discretionary_italic) == auto_discretionary_italic) { // has_discretionary_italic
+ math_kernel_node_set_option(target, math_kernel_full_discretionary);
+ }
+ return node_subtype(target);
+}
+
+/*tex
+
+ 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 \quote {cramped} versions of these styles. This
+ gives a numerical order that is backwards from the convention of Appendix~G in {\em The \TEX
+ book}; i.e., a smaller style has a larger numerical value.
+
+*/
+
+void tex_run_math_style(void) {
+ switch (cur_chr) {
+ case yet_unset_math_style:
+ {
+ halfword style = tex_scan_math_style_identifier(1, 0);
+ if (is_valid_math_style(style)) {
+ halfword noad = tex_new_node(style_node, (quarterword) style);
+ cur_list.math_style = style;
+ tex_tail_append(noad);
+ }
+ }
+ break;
+ case scaled_math_style:
+ {
+ halfword noad = tex_new_node(style_node, scaled_math_style);
+ style_scale(noad) = tex_scan_int(0, NULL);
+ // style_scale(noad) = tex_scan_positive_scale(0);
+ tex_tail_append(noad);
+ }
+ break;
+ default:
+ if (is_valid_math_style(cur_chr)) {
+ halfword noad = tex_new_node(style_node, (quarterword) cur_chr);
+ cur_list.math_style = cur_chr;
+ tex_tail_append(noad);
+ } else {
+ /*tex For now silently ignored. */
+ }
+ }
+}
+
+/*tex
+
+ 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 \quote {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}}}}$|.
+
+*/
+
+static void tex_aux_display_choice_noad (halfword n, int threshold, int max);
+static void tex_aux_display_parameter_node (halfword n);
+static void tex_aux_display_simple_noad (halfword n, int threshold, int max);
+static void tex_aux_display_radical_noad (halfword n, int threshold, int max);
+static void tex_aux_display_accent_noad (halfword n, int threshold, int max);
+static void tex_aux_display_fence_noad (halfword n, int threshold, int max);
+static void tex_aux_display_fraction_noad (halfword n, int threshold, int max);
+
+static void tex_aux_print_fam_and_char(halfword n)
+{
+ tex_print_format(", family %x, character %x, original %x", kernel_math_family(n), kernel_math_character(n));
+ tex_aux_show_dictionary(n, kernel_math_properties(n), kernel_math_group(n), kernel_math_index(n), tex_fam_fnt(kernel_math_family(n), 0), kernel_math_character(n));
+}
+
+int tex_show_math_node(halfword n, int threshold, int max)
+{
+ switch (node_type(n)) {
+ case style_node:
+ /* why not shown? */
+ break;
+ case choice_node:
+ tex_aux_display_choice_noad(n, threshold, max);
+ break;
+ case parameter_node:
+ tex_aux_display_parameter_node(n);
+ break;
+ case simple_noad:
+ tex_aux_display_simple_noad(n, threshold, max);
+ break;
+ case radical_noad:
+ tex_aux_display_radical_noad(n, threshold, max);
+ break;
+ case accent_noad:
+ tex_aux_display_accent_noad(n, threshold, max);
+ break;
+ case fence_noad:
+ tex_aux_display_fence_noad(n, threshold, max);
+ break;
+ case fraction_noad:
+ tex_aux_display_fraction_noad(n, threshold, max);
+ break;
+ case math_text_char_node:
+ case math_char_node:
+ tex_aux_print_fam_and_char(n);
+ break;
+ case sub_box_node:
+ tex_print_node_list(kernel_math_list(n), NULL, threshold, max);
+ break;
+ case sub_mlist_node:
+ if (kernel_math_list(n)) {
+ tex_print_node_list(kernel_math_list(n), NULL, threshold, max);
+ } else {
+ tex_print_str(", empty");
+ }
+ break;
+ default:
+ return 0;
+ }
+ return 1;
+}
+
+inline halfword tex_aux_valid_delimiter(halfword d)
+{
+ return (d && (delimiter_small_family(d) || delimiter_small_character(d) || delimiter_large_family(d) || delimiter_large_character(d))) ? d : null;
+}
+
+static void tex_aux_print_delimiter(halfword d)
+{
+ if (delimiter_small_family(d) < 0) {
+ /*tex This should never happen. */
+ tex_print_int(-1);
+ } else if (delimiter_small_family(d) < 16 && delimiter_large_family(d) < 16 && delimiter_small_character(d) < 256 && delimiter_large_character(d) < 256) {
+ /*tex Traditional tex style. */
+ int a = delimiter_small_family(d) * 256 + delimiter_small_character(d);
+ a = a * 0x1000 + delimiter_large_family(d) * 256 + delimiter_large_character(d);
+ tex_print_format(", code %x", a);
+ } else if ((delimiter_large_family(d) == 0 && delimiter_large_character(d) == 0) || delimiter_small_character(d) > 65535 || delimiter_large_character(d) > 65535) {
+ /*tex \LUATEX\ style. */
+ tex_print_format(", family %x, character %x", delimiter_small_family(d), delimiter_small_character(d));
+ }
+}
+
+/*tex
+
+ 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).
+
+*/
+
+static void tex_aux_display_common_noad(halfword n, int threshold, int max)
+{
+ tex_print_node_list(noad_nucleus(n), "nucleus", threshold, max);
+ tex_print_node_list(noad_supscr(n), "superscript", threshold, max);
+ tex_print_node_list(noad_subscr(n), "subscript", threshold, max);
+ tex_print_node_list(noad_supprescr(n), "superprescript", threshold, max);
+ tex_print_node_list(noad_subprescr(n), "subprescript", threshold, max);
+ tex_print_node_list(noad_prime(n), "primescript", threshold, max);
+ tex_print_node_list(noad_new_hlist(n), "newhlist", threshold, max);
+}
+
+static void tex_aux_display_parameter_node(halfword n)
+{
+ tex_print_format(", id %i, style %i", parameter_name(n), parameter_style(n));
+}
+
+static void tex_aux_display_choice_noad(halfword n, int threshold, int max)
+{
+ switch (node_subtype(n)) {
+ case normal_choice_subtype:
+ tex_print_node_list(choice_display_mlist(n), "display", threshold, max);
+ tex_print_node_list(choice_text_mlist(n), "text", threshold, max);
+ tex_print_node_list(choice_script_mlist(n), "script", threshold, max);
+ tex_print_node_list(choice_script_script_mlist(n), "scriptscript", threshold, max);
+ break;
+ case discretionary_choice_subtype:
+ tex_print_format(", class %i", choice_class(n));
+ tex_print_node_list(choice_pre_break(n), "pre", threshold, max);
+ tex_print_node_list(choice_post_break(n), "post", threshold, max);
+ tex_print_node_list(choice_no_break(n), "replace", threshold, max);
+ break;
+ }
+}
+
+static void tex_aux_display_simple_noad(halfword n, int threshold, int max)
+{
+ if (noad_source(n)) {
+ tex_print_format(", source %i", noad_source(n));
+ }
+ tex_aux_display_common_noad(n, threshold, max);
+}
+
+static void tex_aux_display_radical_noad(halfword n, int threshold, int max)
+{
+ if (noad_width(n)) {
+ tex_print_format(", width %D", noad_width(n), pt_unit);
+ }
+ if (radical_height(n)) {
+ tex_print_format(", height %D", radical_height(n), pt_unit);
+ }
+ if (radical_depth(n)) {
+ tex_print_format(", depth %D", radical_depth(n), pt_unit);
+ }
+ if (noad_source(n) != 0) {
+ tex_print_format(", source %i", noad_source(n));
+ }
+ if (noad_options(n)) {
+ tex_print_format(", options %x", noad_options(n));
+ }
+ if (radical_left_delimiter(n)) {
+ tex_print_str(", left");
+ tex_aux_print_delimiter(radical_left_delimiter(n));
+ }
+ if (radical_right_delimiter(n)) {
+ tex_print_str(", right");
+ tex_aux_print_delimiter(radical_right_delimiter(n));
+ }
+ if (radical_degree(n)) {
+ tex_print_node_list(radical_degree(n), "degree", threshold, max);
+ }
+ tex_aux_display_common_noad(n, threshold, max);
+}
+
+static void tex_aux_display_accent_noad(halfword n, int threshold, int max)
+{
+ halfword top_char = accent_top_character(n);
+ halfword bottom_char = accent_bottom_character(n);
+ halfword fraction = accent_fraction(n);
+ if (fraction) {
+ tex_print_str(", fraction ");
+ tex_print_int(fraction);
+ }
+ switch (node_subtype(n)) {
+ case bothflexible_accent_subtype:
+ if (top_char) {
+ tex_print_str(", top ");
+ tex_aux_print_fam_and_char(top_char);
+ }
+ if (bottom_char) {
+ tex_print_str(", bottom ");
+ tex_aux_print_fam_and_char(bottom_char);
+ }
+ if (! (top_char || bottom_char)) {
+ tex_print_str(", overlay ");
+ tex_aux_print_fam_and_char(accent_middle_character(n));
+ }
+ break;
+ case fixedtop_accent_subtype:
+ if (top_char) {
+ tex_print_str(", fixed top ");
+ tex_aux_print_fam_and_char(top_char);
+ }
+ if (bottom_char) {
+ tex_print_str(", bottom ");
+ tex_aux_print_fam_and_char(bottom_char);
+ }
+ break;
+ case fixedbottom_accent_subtype:
+ if (top_char) {
+ tex_print_str(", top ");
+ tex_aux_print_fam_and_char(top_char);
+ }
+ if (bottom_char) {
+ tex_print_str(", fixed bottom ");
+ tex_aux_print_fam_and_char(bottom_char);
+ }
+ break;
+ case fixedboth_accent_subtype:
+ if (top_char) {
+ tex_print_str(", fixed top ");
+ tex_aux_print_fam_and_char(top_char);
+ }
+ if (bottom_char) {
+ tex_print_str(", fixed bottom ");
+ tex_aux_print_fam_and_char(bottom_char);
+ }
+ break;
+ }
+ tex_aux_display_common_noad(n, threshold, max);
+}
+
+static void tex_aux_display_fence_noad(halfword n, int threshold, int max)
+{
+ if (noad_height(n)) {
+ tex_print_format(", height %D", noad_height(n), pt_unit);
+ }
+ if (noad_depth(n)) {
+ tex_print_format(", depth %D", noad_depth(n), pt_unit);
+ }
+ if (get_noad_main_class(n) >= 0) {
+ tex_print_format(", class %i", get_noad_main_class(n));
+ }
+ if (get_noad_left_class(n) >= 0) {
+ tex_print_format(", leftclass %i", get_noad_left_class(n));
+ }
+ if (get_noad_right_class(n) >= 0) {
+ tex_print_format(", rightclass %i", get_noad_right_class(n));
+ }
+ if (noad_source(n) != 0) {
+ tex_print_format(", source %i", noad_source(n));
+ }
+ if (noad_options(n)) {
+ tex_print_format(", options %x", noad_options(n));
+ }
+ tex_aux_print_delimiter(fence_delimiter_list(n));
+ tex_print_node_list(fence_delimiter_top(n), "top", threshold, max);
+ tex_print_node_list(fence_delimiter_bottom(n), "bottom", threshold, max);
+}
+
+static void tex_aux_display_fraction_noad(halfword n, int threshold, int max)
+{
+ halfword leftdelimiter = tex_aux_valid_delimiter(fraction_left_delimiter(n));
+ halfword rightdelimiter = tex_aux_valid_delimiter(fraction_right_delimiter(n));
+ tex_print_str(", thickness ");
+ if (fraction_rule_thickness(n) == preset_rule_thickness) {
+ tex_print_str("default");
+ } else {
+ tex_print_dimension(fraction_rule_thickness(n), pt_unit);
+ }
+ if (leftdelimiter) {
+ tex_print_str(", leftdelimiter ");
+ tex_aux_print_delimiter(leftdelimiter);
+ }
+ if (rightdelimiter) {
+ tex_print_str(", rightdelimiter ");
+ tex_aux_print_delimiter(rightdelimiter);
+ }
+ if (noad_source(n) != 0) {
+ tex_print_str(", source ");
+ tex_print_int(noad_source(n));
+ }
+ if (noad_options(n)) {
+ tex_print_str(", options ");
+ tex_print_qhex(noad_options(n));
+ }
+ tex_print_node_list(fraction_numerator(n), "numerator", threshold, max);
+ tex_print_node_list(fraction_denominator(n), "denominator", threshold, max);
+}
+
+/*tex
+
+ 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 \quote {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|.
+
+*/
+
+static void tex_aux_new_save_level_math(quarterword group)
+{
+ halfword direction = math_direction_par;
+ tex_set_saved_record(saved_math_item_direction, saved_text_direction, 0, lmt_dir_state.text_dir_ptr);
+ lmt_save_state.save_stack_data.ptr += saved_math_n_of_items;
+ lmt_dir_state.text_dir_ptr = tex_new_dir(normal_dir_subtype, direction);
+ tex_new_save_level(group);
+ update_tex_par_direction(direction);
+ update_tex_text_direction(direction);
+}
+
+static void tex_aux_push_math(quarterword group, int style)
+{
+ if (math_direction_par != text_direction_par) {
+ cur_list.math_dir = 1;
+ }
+ cur_list.math_begin = math_begin_class_par;
+ cur_list.math_end = math_end_class_par;
+ cur_list.math_main_style = style;
+ tex_push_nest();
+ cur_list.mode = -mmode;
+ cur_list.incomplete_noad = null;
+ cur_list.math_style = style;
+ tex_aux_new_save_level_math(group);
+ update_tex_math_left_class(unset_noad_class);
+ update_tex_math_right_class(unset_noad_class);
+}
+
+static void tex_aux_enter_ordinary_math(int style)
+{
+ tex_aux_push_math(math_shift_group, style);
+ update_tex_family(0, unused_math_family);
+ if (every_math_par) {
+ tex_begin_token_list(every_math_par, every_math_text);
+ }
+}
+
+static void tex_aux_enter_display_math(halfword cmd);
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_run_math_initialize(void)
+{
+ switch(cur_cmd) {
+ case math_shift_cmd:
+ /*tex |get_x_token| would fail on |\ifmmode|! */
+ tex_get_token();
+ if (cur_cmd == math_shift_cmd && cur_list.mode > nomode) {
+ tex_aux_enter_display_math(math_shift_cmd);
+ } else {
+ tex_back_input(cur_tok);
+ tex_aux_enter_ordinary_math(text_style);
+ }
+ break;
+ case math_shift_cs_cmd:
+ if (cur_chr == begin_math_mode_code) {
+ tex_aux_enter_ordinary_math(tex_scan_math_style_identifier(0, 0));
+ } else if (cur_chr == begin_display_math_code && cur_list.mode > nomode) {
+ tex_aux_enter_display_math(begin_display_math_code);
+ } else if (cur_chr == begin_inline_math_code) {
+ tex_aux_enter_ordinary_math(text_style);
+ } else {
+ tex_you_cant_error("math shift 1");
+ }
+ break;
+ default:
+ tex_you_cant_error("math shift 2");
+ break;
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_run_math_equation_number(void) {
+ if (tex_in_privileged_mode()) {
+ if (cur_group == math_shift_group) {
+ tex_set_saved_record(saved_equation_number_item_location, saved_equation_number_location, 0, cur_chr);
+ lmt_save_state.save_stack_data.ptr += saved_equation_number_n_of_items;
+ tex_aux_enter_ordinary_math(text_style);
+ } else {
+ tex_off_save();
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_run_math_left_brace(void)
+{
+ if (math_grouping_mode_par) {
+ /*tex This is an experiment. Some tracing has to be adapted probably. */
+ tex_new_save_level(math_simple_group);
+ update_tex_internal_math_style(cur_mode == mmode ? cur_list.math_style : -1);
+ update_tex_internal_math_scale(cur_mode == mmode ? cur_list.math_scale : -1);
+ } else {
+ halfword q = tex_new_node(math_char_node, 0);
+ halfword n = tex_new_node(simple_noad, ordinary_noad_subtype);
+ tex_tail_append(n);
+ noad_nucleus(n) = q;
+ tex_back_input(cur_tok);
+ tex_aux_scan_math(q, cur_list.math_style, 0, 0, 0, 0, unset_noad_class, unset_noad_class);
+ }
+}
+
+/*tex
+
+ 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. We now just return the direction.
+
+*/
+
+static int tex_aux_pre_math_par_direction(void)
+{
+ return tex_located_save_value(internal_int_location(par_direction_code));
+}
+
+/*tex
+
+ 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|.
+
+*/
+
+static void tex_aux_enter_display_math(halfword cmd)
+{
+ if (math_display_mode_par) {
+ tex_aux_push_math(math_shift_group, display_style);
+ cur_list.math_mode = cmd;
+ update_tex_family(0, unused_math_family);
+ if (every_display_par) {
+ tex_begin_token_list(every_display_par, every_display_text);
+ }
+ } else {
+ /*tex new or partial |pre_display_size| */
+ scaled size;
+ /*tex new |display_width| */
+ scaled width;
+ /*tex new |display_indent| */
+ scaled indent;
+ /*tex
+ Deal with |\noindent$$| or |$${ }$$| or the 2nd of |$${ }$$| |$${ }$$|.
+ */
+ if (cur_list.head == cur_list.tail || (node_next(cur_list.head) == cur_list.tail && node_type(cur_list.tail) == par_node && ! node_next(cur_list.tail))) {
+ if (node_next(cur_list.head) == cur_list.tail) {
+ /*tex
+
+ |resume_after_display| inserts a |par_node|, but if there is another display
+ immediately following, we have to get rid of that node.
+
+ */
+ tex_flush_node(cur_list.tail);
+ /* cur_list.tail = cur_list.head; */ /* probably needed */
+ }
+ tex_pop_nest();
+ size = - max_dimen;
+ } else {
+ tex_line_break(1, math_shift_group);
+ // size = tex_actual_box_width(lmt_linebreak_state.just_box, tex_x_over_n(tex_get_font_em_width(cur_font_par), 1000) * math_pre_display_gap_factor_par);
+ size = tex_actual_box_width(lmt_linebreak_state.just_box, scaledround((tex_get_font_em_width(cur_font_par) / 1000.0) * math_pre_display_gap_factor_par));
+ }
+ /*tex
+
+ 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) {
+ /*tex scope of paragraph shape specification */
+ int n = tex_get_specification_count(par_shape_par);
+ if (n > 0) {
+ if (cur_list.prev_graf + 2 < n) {
+ n = cur_list.prev_graf + 2;
+ }
+ indent = tex_get_specification_indent(par_shape_par, n) ;
+ width = tex_get_specification_width(par_shape_par, n);
+ indent = swap_parshape_indent(pre_display_direction_par, indent, width);
+ } else {
+ width = hsize_par;
+ indent = 0;
+ }
+ } else if ((hang_indent_par != 0) && (((hang_after_par >= 0) && (cur_list.prev_graf + 2 > hang_after_par)) || (cur_list.prev_graf + 1 < -hang_after_par))) {
+ halfword hangindent = swap_hang_indent(pre_display_direction_par, hang_indent_par);
+ width = hsize_par - abs(hangindent);
+ indent = hangindent > 0 ? hangindent : 0;
+ } else {
+ width = hsize_par;
+ indent = 0;
+ }
+ tex_aux_push_math(math_shift_group, display_style);
+ cur_list.mode = mmode;
+ update_tex_family(0, unused_math_family);
+ update_tex_pre_display_size(size);
+ update_tex_display_width(width);
+ update_tex_display_indent(indent);
+ update_tex_pre_display_direction(tex_aux_pre_math_par_direction());
+ if (every_display_par) {
+ tex_begin_token_list(every_display_par, every_display_text);
+ }
+ if (lmt_nest_state.nest_data.ptr == 1) {
+ if (! lmt_page_builder_state.output_active) {
+ lmt_page_filter_callback(before_display_page_context, 0);
+ }
+ tex_build_page();
+ }
+ }
+}
+
+/*tex
+
+ The next routine parses all variations of a delimiter code. The |extcode| tells what syntax form
+ to use (\TEX\ or \LUATEX) , the |doclass| tells whether or not read a math class also (for
+ |\delimiter| c.s.). The class is passed on for conversion to |\mathchar|.
+
+*/
+
+static delcodeval tex_aux_scan_extdef_del_code(int extcode, int doclass)
+{
+ delcodeval d = tex_no_del_code();
+ switch (extcode) {
+ case tex_mathcode:
+ /*tex This is the easiest: |\delcode|,*/
+ {
+ halfword v = tex_scan_int(0, NULL);
+ /*tex |MFCCFCC| or |FCCFCC| */
+ if (doclass) {
+ d.small.class_value = (short) (v / 0x1000000);
+ v = (v & 0xFFFFFF);
+ }
+ if (v > 0xFFFFFF) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid delimiter code",
+ "I'm going to use 0 instead of that illegal code value."
+ );
+ v = 0;
+ }
+ d.small.family_value = (short) (v / 0x100000);
+ d.small.character_value = (v % 0x100000) / 0x1000;
+ d.large.family_value = (short) ((v & 0xFFF) / 0x100);
+ d.large.character_value = (v % 0x100);
+ /* */
+ d.small.character_value = math_character_part(d.small.character_value);
+ d.large.character_value = math_character_part(d.large.character_value);
+ }
+ break;
+ case umath_mathcode:
+ /*tex |\Udelcode|: |<0-7><0-0xFF><0-0x10FFFF>| or |<0-0xFF><0-0x10FFFF>| */
+ {
+ if (doclass) {
+ d.small.class_value = (short) tex_scan_math_class_number(0);
+ }
+ d.small.family_value = (short) tex_scan_math_family_number();
+ d.small.character_value = tex_scan_math_char_number();
+ if (d.small.family_value < 0 || d.small.family_value > max_math_family_index) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid delimiter family",
+ "I'm going to use family 0 instead."
+ );
+ d.small.family_value = 0;
+ d.small.character_value = 0;
+ }
+ }
+ break;
+ /*
+ case 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) {
+ tex_confusion("umathnum mathcode");
+ } else {
+ halfword v = tex_scan_int(0, NULL);
+ d.small.family_value = (short) math_family_part(v);
+ d.small.character_value = math_character_part(v);
+ if (d.small.family_value < 0 || d.small.family_value > max_math_family_index || d.small.character_value > max_math_character_code) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid delimiter code",
+ "I'm going to use 0 instead of that illegal code value."
+ );
+ d.small.family_value = 0;
+ d.small.character_value = 0;
+ }
+ }
+ break;
+ */
+ default:
+ /*tex Something's gone wrong! */
+ tex_confusion("unknown extcode, case 1");
+ break;
+ }
+ d.large.class_value = d.small.class_value;
+ return d;
+}
+
+void tex_scan_extdef_del_code(int level, int extcode)
+{
+ delcodeval d;
+ int chr = tex_scan_char_number(0);
+ tex_scan_optional_equals();
+ d = tex_aux_scan_extdef_del_code(extcode, 0);
+ tex_set_del_code(chr, d, (quarterword) level);
+}
+
+mathdictval tex_scan_mathdict(void)
+{
+ mathdictval d = { 0, 0, 0 }; /* use this one directly */
+ d.properties = (unsigned short) tex_scan_math_properties_number();
+ d.group = (unsigned short) tex_scan_math_group_number();
+ d.index = (unsigned int) tex_scan_math_index_number();
+ return d;
+}
+
+mathcodeval tex_scan_mathchar(int extcode)
+{
+ mathcodeval d = { 0, 0, 0 }; /* use this one directly */
+ switch (extcode) {
+ case tex_mathcode:
+ /*tex |"<4bits><4bits><8bits>| */
+ {
+ halfword v = tex_scan_int(0, NULL);
+ if (v >= 0) {
+ if (v > 0xFFFF) {
+ v = 0xFFFF;
+ }
+ d.class_value = (short) math_old_class_part(v);
+ d.family_value = (short) math_old_family_part(v);
+ d.character_value = math_old_character_part(v);
+ }
+ }
+ break;
+ case umath_mathcode:
+ /*tex |"<6bits>"<6bits>"<20bits>| */
+ {
+ d.class_value = (short) tex_scan_math_class_number(0);
+ d.family_value = (short) tex_scan_math_family_number();
+ d.character_value = tex_scan_math_char_number();
+ }
+ break;
+ /*
+ case umathnum_mathcode:
+ // |"<6bits><6bits><20bits>|: 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.
+ {
+ halfword v = tex_scan_int(0, NULL);
+ d.class_value = (short) math_class_part(v);
+ d.family_value = (short) math_family_part(v);
+ d.character_value = math_character_part(v);
+ }
+ break;
+ */
+ default:
+ /*tex Something's gone wrong. */
+ tex_confusion("unknown extcode, case 2");
+ break;
+ }
+ if (d.class_value < 0 || d.character_value > max_math_character_code || d.class_value > max_math_class_code || d.family_value > max_math_family_index) {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math code",
+ "I'm going to use 0 instead of that illegal code value."
+ );
+ d.class_value = 0;
+ d.family_value = 0;
+ d.character_value = 0;
+ }
+ return d;
+}
+
+halfword tex_new_math_spec(mathcodeval m, quarterword code)
+{
+ halfword s = tex_new_node(math_spec_node, code);
+ math_spec_class(s) = (singleword) m.class_value;
+ math_spec_family(s) = (singleword) m.family_value;
+ math_spec_character(s) = m.character_value;
+ return s;
+}
+
+halfword tex_new_math_dict_spec(mathdictval d, mathcodeval m, quarterword code)
+{
+ halfword s = tex_new_node(math_spec_node, code);
+ math_spec_class(s) = (singleword) m.class_value;
+ math_spec_family(s) = (singleword) m.family_value;
+ math_spec_character(s) = m.character_value;
+ math_spec_properties(s) = (quarterword) d.properties;
+ math_spec_group(s) = (quarterword) d.group;
+ math_spec_index(s) = d.index;
+ return s;
+}
+
+mathcodeval tex_get_math_spec(halfword s)
+{
+ mathcodeval m = { 0, 0, 0 };
+ if (s) {
+ m.class_value = math_spec_class(s);
+ m.family_value = math_spec_family(s);
+ m.character_value = math_spec_character(s);
+ }
+ return m;
+}
+
+mathdictval tex_get_math_dict(halfword s)
+{
+ mathdictval d = { 0, 0, 0 };
+ if (s) {
+ d.properties = math_spec_properties(s);
+ d.group = math_spec_group(s);
+ d.index = math_spec_index(s);
+ }
+ return d;
+}
+
+halfword tex_scan_math_spec(int optional_equal)
+{
+ mathcodeval m;
+ if (optional_equal) {
+ tex_scan_optional_equals();
+ }
+ m = tex_scan_mathchar(umath_mathcode);
+ return tex_new_math_spec(m, mathspec_mathcode);
+}
+
+void tex_scan_extdef_math_code(int level, int extcode)
+{
+ mathcodeval d;
+ int chr = tex_scan_char_number(0);
+ tex_scan_optional_equals();
+ d = tex_scan_mathchar(extcode);
+ tex_set_math_code(chr, d, (quarterword) level);
+}
+
+/*tex This reads in a delcode when actually a mathcode is needed. */
+
+mathcodeval tex_scan_delimiter_as_mathchar(int extcode)
+{
+ delcodeval dval = tex_aux_scan_extdef_del_code(extcode, 1);
+ return dval.small;
+}
+
+/*tex
+
+ 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|.
+
+ already prepared: every [component, degree, radical, over, under, accent, prime, subscript,
+ superscript]
+
+ toks : every_subscript_par
+ toks_text : every_subscipt_text or every_math_text (for tracing)
+
+*/
+
+/*tex
+ For some reason |$\char44$| gives an undefined |$| when we made that character active in math.
+*/
+
+static void tex_aux_scan_active_math_char(void)
+{
+ cur_cs = tex_active_to_cs(cur_chr, 1);
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = eq_value(cur_cs);
+ tex_x_token();
+ tex_back_input(cur_tok);
+}
+
+static int tex_aux_scan_math(halfword target, halfword style, int usetextfont, halfword toks, halfword toks_text, int nocomponent, halfword cls, halfword all)
+{
+ mathcodeval mval = { 0, 0, 0 };
+ mathdictval dval = { 0, 0, 0 };
+ lmt_math_state.last_atom = cls;
+ RESTART:
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+// RESWITCH:
+ switch (cur_cmd) {
+ case char_number_cmd:
+ /* The |\glyph| variant is accepted but no keywords here. */
+ cur_chr = tex_scan_char_number(0);
+ // fall through
+ case letter_cmd:
+ case other_char_cmd:
+ case char_given_cmd:
+ mval = tex_get_math_code(cur_chr);
+ if (mval.class_value == active_math_class_value) {
+ /*tex An active character is allowed here. */
+ tex_aux_scan_active_math_char();
+ goto RESTART;
+ }
+ dval = tex_fake_math_dict(mval.character_value);
+ break;
+ // case char_number_cmd:
+ // /* The |\glyph| variant is accepted but no keywords here. */
+ // cur_chr = tex_scan_char_number();
+ // cur_cmd = char_given_cmd;
+ // goto RESWITCH;
+ case math_char_number_cmd:
+ switch (cur_chr) {
+ case math_char_number_code:
+ mval = tex_scan_mathchar(tex_mathcode);
+ break;
+ case math_xchar_number_code:
+ mval = tex_scan_mathchar(umath_mathcode);
+ break;
+ /*
+ case math_uchar_number_code:
+ mval = tex_scan_mathchar(umathnum_mathcode);
+ break;
+ */
+ default:
+ tex_confusion("scan math char, case 1");
+ break;
+ }
+ dval = tex_fake_math_dict(mval.character_value);
+ break;
+ case mathspec_cmd:
+ mval = tex_get_math_spec(cur_chr);
+ dval = tex_get_math_dict(cur_chr);
+ break;
+ // case math_char_given_cmd:
+ // mval = tex_mathchar_from_integer(cur_chr, tex_mathcode);
+ // break;
+ // case math_char_xgiven_cmd:
+ // mval = tex_mathchar_from_integer(cur_chr, umath_mathcode);
+ // break;
+ case delimiter_number_cmd:
+ switch (cur_chr) {
+ case math_delimiter_code:
+ mval = tex_scan_delimiter_as_mathchar(tex_mathcode);
+ break;
+ case math_udelimiter_code:
+ mval = tex_scan_delimiter_as_mathchar(umath_mathcode);
+ break;
+ default:
+ tex_confusion("scan math char, case 2");
+ break;
+ }
+ break;
+ case math_component_cmd:
+ if (nocomponent) {
+ goto DEFAULT;
+ } else {
+ tex_set_saved_record(saved_math_group_item_pointer, saved_math_pointer, 0, target);
+ tex_set_saved_record(saved_math_group_all_class, saved_math_class, 0, unset_noad_class);
+ lmt_save_state.save_stack_data.ptr += saved_math_group_n_of_items;
+ tex_aux_push_math(math_group, style);
+ if (usetextfont) {
+ tex_set_math_text_font(style, usetextfont);
+ }
+ tex_aux_math_math_component(cur_list.tail, 0);
+ tex_finish_math_group();
+ return 1;
+ }
+ case left_brace_cmd:
+ goto SCAN_SUBFORMULA;
+ default:
+ /*tex
+ The pointer |p| is placed on |save_stack| while a complex subformula is being
+ scanned.
+ */
+ DEFAULT:
+ tex_back_input(cur_tok);
+ tex_scan_left_brace();
+ SCAN_SUBFORMULA:
+ tex_set_saved_record(saved_math_group_item_pointer, saved_math_pointer, 0, target);
+ tex_set_saved_record(saved_math_group_all_class, saved_math_class, 0, all);
+ lmt_save_state.save_stack_data.ptr += saved_math_group_n_of_items;
+ tex_aux_push_math(math_group, style);
+ toks = every_math_atom_par;
+ toks_text = every_math_atom_text;
+ if (toks) {
+ tex_begin_token_list(toks, (quarterword) toks_text);
+ }
+ if (usetextfont) {
+ tex_set_math_text_font(style, usetextfont);
+ }
+ return 1;
+ }
+ node_type(target) = math_char_node;
+ if (glyph_options_par & glyph_option_no_italic_correction) {
+ math_kernel_node_set_option(target, math_kernel_no_italic_correction);
+ }
+ if (glyph_options_par & glyph_option_no_left_kern) {
+ math_kernel_node_set_option(target, math_kernel_no_left_pair_kern);
+ }
+ if (glyph_options_par & glyph_option_no_right_kern) {
+ math_kernel_node_set_option(target, math_kernel_no_right_pair_kern);
+ }
+ tex_aux_set_math_char(target, &mval, &dval);
+ return 0;
+}
+
+/*tex
+
+ The |append_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.
+
+*/
+
+static void tex_aux_append_math_accent(mathcodeval mval, mathdictval dval)
+{
+ halfword accent = tex_new_node(accent_noad, bothflexible_accent_subtype);
+ quarterword subtype = ordinary_noad_subtype;
+ tex_tail_append(accent);
+ if (! (mval.character_value == 0 && mval.family_value == 0)) {
+ halfword q = tex_new_node(math_char_node, 0);
+ subtype = tex_aux_set_math_char(q, &mval, &dval);
+ accent_top_character(accent) = q;
+ }
+ {
+ halfword q = tex_new_node(math_char_node, subtype);
+ noad_nucleus(accent) = q;
+ tex_aux_scan_math(q, tex_math_style_variant(cur_list.math_style, math_parameter_accent_variant), 0, 0, 0, 0, unset_noad_class, unset_noad_class);
+ }
+}
+
+/*tex
+ Fences are actually constructs and middle sort of interferes here: we keep a sort of flat fence
+ sequence so middle ends a group and opens a new one.
+
+*/
+
+static void tex_aux_append_math_fence(halfword fence, quarterword class)
+{
+ switch (class) {
+ case open_noad_subtype:
+ {
+ tex_aux_push_math(math_fence_group, cur_list.math_style);
+ node_subtype(fence) = left_fence_side;
+ node_next(cur_list.head) = fence;
+ cur_list.tail = fence;
+ cur_list.delim = fence;
+ }
+ break;
+ case close_noad_subtype:
+ {
+ halfword q = tex_aux_finish_math_list(fence);
+ halfword n = tex_new_node(simple_noad, fenced_noad_subtype);
+ halfword l = tex_new_node(sub_mlist_node, 0);
+ tex_aux_unsave_math();
+ tex_tail_append(n);
+ node_subtype(fence) = right_fence_side;
+ noad_nucleus(n) = l;
+ noad_options(n) |= noad_option_unpack_list;
+ kernel_math_list(noad_nucleus(n)) = q;
+ }
+ break;
+ case middle_noad_subtype:
+ {
+ halfword q = tex_aux_finish_math_list(fence);
+ tex_aux_unsave_math();
+ tex_aux_push_math(math_fence_group, cur_list.math_style);
+ node_subtype(fence) = middle_fence_side;
+ node_next(cur_list.head) = q;
+ cur_list.tail = fence;
+ cur_list.delim = fence;
+ }
+ break;
+ }
+}
+
+static void tex_aux_append_math_fence_val(mathcodeval mval, mathdictval dval, quarterword class)
+{
+ halfword fence = tex_new_node(fence_noad, middle_fence_side);
+ halfword delimiter = tex_new_node(delimiter_node, mval.class_value);
+ (void) dval; /* maybe todo */
+ fence_delimiter_list(fence) = delimiter;
+ delimiter_small_family(delimiter) = mval.family_value;
+ delimiter_small_character(delimiter) = mval.character_value;
+ delimiter_large_family(delimiter) = mval.family_value;
+ delimiter_large_character(delimiter) = mval.character_value;
+ set_noad_classes(fence, mval.class_value);
+ /* todo : share the next three with the regular fences */
+ noad_options(fence) |= noad_option_no_check;
+ if (class == middle_noad_subtype && cur_group != math_fence_group) {
+ tex_aux_append_math_fence_val((mathcodeval) { 0, 0, 0 }, (mathdictval) { 0, 0, 0 }, open_noad_subtype);
+ }
+ tex_aux_append_math_fence(fence, class);
+}
+
+static void tex_aux_append_math_char(mathcodeval mval, mathdictval dval, int automatic)
+{
+ if (mval.class_value == active_math_class_value) {
+ /*tex An active character is allowed here */
+ tex_aux_scan_active_math_char();
+ return;
+ } else {
+ if (automatic && tex_math_has_class_option(mval.class_value, auto_inject_class_option)) {
+ switch (mval.class_value) {
+ case accent_noad_subtype:
+ tex_aux_append_math_accent(mval, dval);
+ return;
+ case open_noad_subtype:
+ case close_noad_subtype:
+ case middle_noad_subtype:
+ tex_aux_append_math_fence_val(mval, dval, mval.class_value);
+ return;
+ }
+ }
+ {
+ halfword p = tex_new_node(simple_noad, ordinary_noad_subtype);
+ halfword q = tex_new_node(math_char_node, 0);
+ noad_nucleus(p) = q;
+ if (glyph_options_par & glyph_option_no_italic_correction) {
+ math_kernel_node_set_option(q, math_kernel_no_italic_correction);
+ }
+ node_subtype(p) = tex_aux_set_math_char(q, &mval, &dval);
+ tex_tail_append(p);
+ }
+ }
+}
+
+/*tex
+
+ The |append_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.
+
+*/
+
+static void tex_aux_append_math_char_in_text(mathcodeval mval, mathdictval dval)
+{
+ (void) dval;
+ if (mval.class_value == active_math_class_value) {
+ /*tex An active character is allowed here. But why in text mode too. */
+ tex_aux_scan_active_math_char();
+ } else {
+ halfword p = tex_new_char_node(glyph_character_subtype, tex_fam_fnt(mval.family_value, text_size), mval.character_value, 1); /* todo: data */
+ tex_tail_append(p);
+ }
+}
+
+void tex_run_math_letter(void)
+{
+ tex_aux_append_math_char(tex_get_math_code(cur_chr), tex_fake_math_dict(cur_chr), 1);
+}
+
+void tex_run_math_char_number(void) {
+ /*tex
+ Both |\char| and |\glyph| get the same treatment. Scanning can change |cur_chr| so we do
+ that first. We no longer check for active here!
+ */
+ mathcodeval mval = { 0, 0, 0 };
+ mathdictval dval = { 0, 0, 0 };
+ cur_chr = tex_scan_char_number(0);
+ mval.character_value = cur_chr;
+ mval.family_value = (short) cur_fam_par;
+ // tex_aux_append_math_char(tex_get_math_code(cur_chr), tex_fake_math_dict(cur_chr));
+ tex_aux_append_math_char(mval, dval, 1);
+}
+
+void tex_run_math_math_spec(void)
+{
+ tex_aux_append_math_char(tex_get_math_spec(cur_chr), tex_get_math_dict(cur_chr), 1);
+}
+
+void tex_run_text_math_spec(void)
+{
+ tex_aux_append_math_char_in_text(tex_get_math_spec(cur_chr), tex_get_math_dict(cur_chr));
+}
+
+int tex_scan_math_cmd_val(mathcodeval *mval, mathdictval *dval)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ switch (cur_cmd) {
+ // case math_char_given_cmd:
+ // *mval = tex_mathchar_from_integer(cur_chr, tex_mathcode);
+ // break;
+ // case math_char_xgiven_cmd:
+ // *mval = tex_mathchar_from_integer(cur_chr, umath_mathcode);
+ // break;
+ case mathspec_cmd:
+ *mval = tex_get_math_spec(cur_chr);
+ break;
+ case math_char_number_cmd:
+ switch (cur_chr) {
+ case math_char_number_code:
+ *mval = tex_scan_mathchar(tex_mathcode);
+ break;
+ case math_xchar_number_code:
+ *mval = tex_scan_mathchar(umath_mathcode);
+ break;
+ case math_dchar_number_code:
+ *dval = tex_scan_mathdict();
+ *mval = tex_scan_mathchar(umath_mathcode);
+ break;
+ /*
+ case math_uchar_number_code:
+ *mval = tex_scan_mathchar(umathnum_mathcode);
+ break;
+ */
+ default:
+ /* no message yet */
+ return 0;
+ }
+ break;
+ case letter_cmd:
+ case other_char_cmd:
+ mval->character_value = cur_chr;
+ break;
+ default:
+ {
+ halfword n = 0;
+ tex_back_input(cur_tok);
+ n = tex_scan_int(0, NULL);
+ *mval = tex_mathchar_from_integer(n, umath_mathcode);
+ }
+ break;
+ }
+ return 1;
+}
+
+int tex_scan_math_code_val(halfword code, mathcodeval *mval, mathdictval *dval)
+{
+ switch (code) {
+ case math_char_number_code:
+ *mval = tex_scan_mathchar(tex_mathcode);
+ break;
+ case math_xchar_number_code:
+ *mval = tex_scan_mathchar(umath_mathcode);
+ break;
+ case math_dchar_number_code:
+ *dval = tex_scan_mathdict();
+ *mval = tex_scan_mathchar(umath_mathcode);
+ break;
+ /*
+ case math_uchar_number_code:
+ *mval = tex_scan_mathchar(umathnum_mathcode);
+ break;
+ */
+ case math_class_number_code:
+ {
+ halfword family = cur_fam_par;
+ halfword class = tex_scan_int(0, NULL);
+ tex_scan_math_cmd_val(mval, dval);
+ mval->class_value = (short) class;
+ mval->family_value = (short) family;
+ }
+ break;
+ default:
+ /* no message yet */
+ tex_back_input(cur_tok);
+ return 0;
+ }
+ return 1;
+}
+
+void tex_run_text_math_char_number(void) {
+ mathcodeval mval = { 0, 0, 0 };
+ mathdictval dval = { 0, 0, 0 };
+ if (tex_scan_math_code_val(cur_chr, &mval, &dval)) {
+ tex_aux_append_math_char_in_text(mval, dval);
+ }
+}
+
+void tex_run_math_math_char_number(void) {
+ mathcodeval mval = { 0, 0, 0 };
+ mathdictval dval = { 0, 0, 0 };
+ if (tex_scan_math_code_val(cur_chr, &mval, &dval)) {
+ tex_aux_append_math_char(mval, dval, 1);
+ }
+}
+
+/*tex We build up an argument to |append_math_char|: */
+
+// void tex_run_text_math_char_given(void) {
+// tex_aux_append_math_char_in_text(tex_mathchar_from_integer(cur_chr, tex_mathcode));
+// }
+//
+// void tex_run_math_math_char_given(void) {
+// tex_aux_append_math_char(tex_mathchar_from_integer(cur_chr, tex_mathcode));
+// }
+
+/*tex We build up an argument to |append_math_char| the \LUATEX\ way: */
+
+// void tex_run_text_math_char_xgiven(void) {
+// tex_aux_append_math_char_in_text(tex_mathchar_from_integer(cur_chr, umath_mathcode));
+// }
+//
+// void tex_run_math_math_char_xgiven(void) {
+// tex_aux_append_math_char(tex_mathchar_from_integer(cur_chr, umath_mathcode));
+// }
+
+void tex_run_math_delimiter_number(void) {
+ switch (cur_chr) {
+ case math_delimiter_code:
+ tex_aux_append_math_char(tex_scan_delimiter_as_mathchar(tex_mathcode), (mathdictval) { 0, 0, 0 }, 0);
+ break;
+ case math_udelimiter_code:
+ tex_aux_append_math_char(tex_scan_delimiter_as_mathchar(umath_mathcode), (mathdictval) { 0, 0, 0 }, 0);
+ break;
+ }
+}
+
+/*tex
+ In original \TEX\ the subtype overlaps the class. Here we are more strict: a subtype is the
+ main class as in original \TEX\ but we also have overloads: main, left and right. The subtype
+ drives the rendering, the others the spacing etc.
+*/
+
+static void tex_aux_math_math_component(halfword target, int append)
+{
+ quarterword subtype = unset_noad_class;
+ quarterword allclass = unset_noad_class;
+ halfword style = cur_list.math_style;
+ int usetextfont = math_atom_no_font_option;
+ reset_noad_classes(target);
+ switch (cur_chr) {
+ case math_component_ordinary_code:
+ subtype = ordinary_noad_subtype;
+ break;
+ case math_component_operator_code:
+ subtype = operator_noad_subtype;
+ break;
+ case math_component_binary_code:
+ subtype = binary_noad_subtype;
+ break;
+ case math_component_relation_code:
+ subtype = relation_noad_subtype;
+ break;
+ case math_component_open_code:
+ subtype = open_noad_subtype;
+ break;
+ case math_component_close_code:
+ subtype = close_noad_subtype;
+ break;
+ case math_component_punctuation_code:
+ subtype = punctuation_noad_subtype;
+ break;
+ case math_component_variable_code:
+ subtype = variable_noad_subtype;
+ break;
+ case math_component_inner_code:
+ subtype = inner_noad_subtype;
+ break;
+ case math_component_under_code:
+ subtype = under_noad_subtype;
+ style = tex_math_style_variant(style, math_parameter_under_line_variant);
+ break;
+ case math_component_over_code:
+ subtype = over_noad_subtype;
+ style = tex_math_style_variant(style, math_parameter_over_line_variant);
+ break;
+ case math_component_fraction_code:
+ subtype = fraction_noad_subtype;
+ break;
+ case math_component_radical_code:
+ subtype = radical_noad_subtype;
+ break;
+ case math_component_middle_code:
+ subtype = middle_noad_subtype;
+ break;
+ case math_component_accent_code:
+ subtype = accent_noad_subtype;
+ break;
+ case math_component_fenced_code:
+ subtype = fenced_noad_subtype;
+ break;
+ case math_component_ghost_code:
+ subtype = ghost_noad_subtype;
+ break;
+ case math_component_atom_code:
+ {
+ halfword attrlist = null;
+ while (1) {
+ switch (tex_scan_character("custnmaolprvCUSTNMAOLPRV", 0, 1, 0)) {
+ case 'a': case 'A':
+ switch (tex_scan_character("ltLT", 0, 0, 0)) {
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("attr", 2)) {
+ attrlist = tex_scan_attribute(attrlist);
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("all", 2)) {
+ allclass = (quarterword) tex_scan_math_class_number(0);
+ if (! valid_math_class_code(subtype)) {
+ allclass = unset_noad_class;
+ }
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("attr|all");
+ goto DONE;
+ }
+ break;
+ case 'l': case 'L':
+ switch (tex_scan_character("ieIE", 0, 0, 0)) {
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("leftclass", 2)) {
+ halfword c = tex_scan_math_class_number(0);
+ if (! valid_math_class_code(subtype)) {
+ c = ordinary_noad_subtype;
+ }
+ set_noad_left_class(target, c);
+ }
+ break;
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("limits", 2)) {
+ noad_options(target) |= noad_option_limits;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("leftclass|limits");
+ goto DONE;
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("rightclass", 1)) {
+ halfword c = tex_scan_math_class_number(0);
+ if (! valid_math_class_code(c)) {
+ c = ordinary_noad_subtype;
+ }
+ set_noad_right_class(target, c);
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("class", 1)) {
+ subtype = (quarterword) tex_scan_math_class_number(0);
+ if (! valid_math_class_code(subtype)) {
+ subtype = ordinary_noad_subtype;
+ }
+ set_noad_main_class(target, subtype);
+ }
+ break;
+ case 'u': case 'U':
+ /*tex A bit over the top, three steps but a push back is still worse. We can scan for 'un'. */
+ if (tex_scan_character("nN", 0, 0, 0)) {
+ switch (tex_scan_character("prPR", 0, 0, 0)) {
+ case 'p': case 'P':
+ if (tex_scan_mandate_keyword("unpack", 3)) {
+ noad_options(target) |= noad_option_unpack_list;
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("unroll", 3)) {
+ noad_options(target) |= noad_option_unroll_list;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("unpack|unroll");
+ goto DONE;
+ }
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("source", 1)) {
+ noad_source(target) = tex_scan_int(0, NULL);
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("textfont", 1)) {
+ usetextfont = math_atom_text_font_option;
+ }
+ break;
+ case 'm': case 'M':
+ if (tex_scan_mandate_keyword("mathfont", 1)) {
+ usetextfont = math_atom_math_font_option;
+ }
+ break;
+ case 'n': case 'N':
+ /*tex A bit over the top, three steps but a push back is still worse. We can scan for 'no'. */
+ if (tex_scan_character("oO", 0, 0, 0)) {
+ switch (tex_scan_character("loLO", 0, 0, 0)) {
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("nolimits", 3)) {
+ noad_options(target) |= noad_option_no_limits;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("nooverflow", 3)) {
+ noad_options(target) |= noad_option_no_overflow;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("nolimits|nooverflow");
+ goto DONE;
+ }
+ }
+ break;
+ case 'o': case 'O':
+ /* no names, just numbers, we might also do that with other noads */
+ if (tex_scan_mandate_keyword("options", 1)) {
+ noad_options(target) = tex_scan_int(0, NULL);
+ }
+ break;
+ case 'v': case 'V':
+ if (tex_scan_mandate_keyword("void", 1)) {
+ noad_options(target) |= noad_option_void;
+ }
+ break;
+ case 'p': case 'P':
+ if (tex_scan_mandate_keyword("phantom", 1)) {
+ noad_options(target) |= noad_option_phantom;
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ if (attrlist) {
+ tex_attach_attribute_list_attribute(target, attrlist);
+ }
+ if (subtype == unset_noad_class) {
+ if (get_noad_left_class(target) != unset_noad_class && get_noad_right_class(target) != unset_noad_class) {
+ subtype = ordinary_noad_subtype;
+ } else {
+ /* mandate, maybe we will just force a keyword */
+ subtype = (quarterword) tex_scan_math_class_number(0);
+ }
+ }
+ }
+ break;
+ }
+ if (! valid_math_class_code(subtype)) {
+ subtype = ordinary_noad_subtype;
+ }
+ /*tex
+ Now we can scan for the content:
+ */
+ {
+ halfword content = tex_new_node(math_char_node, 0);
+ noad_nucleus(target) = content;
+ node_subtype(target) = subtype;
+ if (append) {
+ tex_tail_append(target);
+ }
+ tex_aux_scan_math(content, style, usetextfont, 0, 0, 0, subtype, allclass);
+ }
+}
+
+void tex_run_math_math_component(void)
+{
+ halfword n = tex_new_node(simple_noad, ordinary_noad_subtype);
+ tex_aux_math_math_component(n, 1);
+}
+
+int tex_is_math_disc(halfword n)
+{
+ return
+ n && node_type(n) == hlist_node && box_list(n) && node_type(box_list(n)) == disc_node &&
+ disc_class(box_list(n)) != unset_disc_class && ! node_next(box_list(n));
+}
+
+halfword tex_math_make_disc(halfword d)
+{
+ halfword q = tex_new_node(sub_mlist_node, 0);
+ halfword n = tex_new_node(simple_noad, (quarterword) disc_class(d));
+ kernel_math_list(q) = d;
+ noad_nucleus(n) = q;
+ noad_options(n) = noad_option_unpack_list;
+ return n;
+}
+
+/*tex
+ Easiest is to permit all modifiers and just ignore those that make no sense. We then can
+ stepwise support whatever modifier we like later on.
+*/
+
+void tex_run_math_modifier(void)
+{
+ halfword tail = cur_list.tail;
+ if (cur_list.head != tail && node_type(tail) == simple_noad) { // maybe all
+ switch (cur_chr) {
+ case adapt_to_left_modifier_code:
+ noad_options(tail) = unset_option(noad_options(tail), noad_option_adapt_to_right_size);
+ noad_options(tail) |= noad_option_adapt_to_left_size;
+ break;
+ case adapt_to_right_modifier_code:
+ noad_options(tail) = unset_option(noad_options(tail), noad_option_adapt_to_left_size);
+ noad_options(tail) |= noad_option_adapt_to_right_size;
+ break;
+ /* todo: actually this one can also be used for other types */
+ case axis_modifier_code:
+ noad_options(tail) |= noad_option_axis;
+ break;
+ case no_axis_modifier_code:
+ noad_options(tail) |= noad_option_no_axis;
+ break;
+ case phantom_modifier_code:
+ noad_options(tail) |= noad_option_phantom;
+ break;
+ case void_modifier_code:
+ noad_options(tail) |= noad_option_void;
+ break;
+ case source_modifier_code:
+ noad_source(tail) = tex_scan_int(0, NULL);
+ break;
+ case openup_height_modifier_code:
+ noad_options(tail) |= noad_option_openup_height;
+ noad_height(tail) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ break;
+ case openup_depth_modifier_code:
+ noad_options(tail) |= noad_option_openup_depth;
+ noad_depth(tail) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ break;
+ case display_limits_modifier_code:
+ noad_options(tail) = unset_option(noad_options(tail), noad_option_limits | noad_option_no_limits);
+ break;
+ case limits_modifier_code:
+ noad_options(tail) = unset_option(noad_options(tail), noad_option_no_limits);
+ noad_options(tail) |= noad_option_limits;
+ break;
+ case no_limits_modifier_code:
+ noad_options(tail) = unset_option(noad_options(tail), noad_option_limits);
+ noad_options(tail) |= noad_option_no_limits;
+ break;
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+static void tex_aux_scan_delimiter(halfword target, int code, int class)
+{
+ delcodeval dval = tex_no_del_code();
+ mathcodeval mval = tex_no_math_code();
+ switch (code) {
+ case no_mathcode:
+ /* can be integrated */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd || cur_cmd == relax_cmd);
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ dval = tex_get_del_code(cur_chr);
+ if (tex_has_del_code(dval)) {
+ goto REALDELIMITER;
+ } else {
+ mval = tex_get_math_code(cur_chr);
+ goto FAKEDELIMITER;
+ }
+ case delimiter_number_cmd:
+ switch (cur_chr) {
+ case math_delimiter_code:
+ /*tex |\delimiter| */
+ dval = tex_aux_scan_extdef_del_code(tex_mathcode, 1);
+ break;
+ case math_udelimiter_code:
+ /*tex |\Udelimiter| */
+ dval = tex_aux_scan_extdef_del_code(umath_mathcode, 1);
+ break;
+ default:
+ tex_confusion("scan delimiter, case 1");
+ break;
+ }
+ goto REALDELIMITER;
+ case mathspec_cmd:
+ mval = tex_get_math_spec(cur_chr);
+ goto FAKEDELIMITER;
+ case math_char_number_cmd:
+ switch (cur_chr) {
+ case math_char_number_code:
+ mval = tex_scan_mathchar(tex_mathcode);
+ break;
+ case math_xchar_number_code:
+ mval = tex_scan_mathchar(umath_mathcode);
+ break;
+ /*
+ case math_uchar_number_code:
+ mval = tex_scan_mathchar(umathnum_mathcode);
+ break;
+ */
+ default:
+ tex_confusion("scan math char, case 1");
+ break;
+ }
+ goto FAKEDELIMITER;
+ }
+ break;
+ case tex_mathcode:
+ /*tex |\radical| */
+ dval = tex_aux_scan_extdef_del_code(tex_mathcode, 1);
+ goto REALDELIMITER;
+ case umath_mathcode:
+ /*tex |\Uradical| */
+ dval = tex_aux_scan_extdef_del_code(umath_mathcode, 0);
+ goto REALDELIMITER;
+ default:
+ tex_confusion("scan delimiter, case 2");
+ goto REALDELIMITER;
+ }
+ FAKEDELIMITER:
+ if (class != unset_noad_class) {
+ mval.class_value = (short) class;
+ }
+ dval.small = mval;
+ dval.large = mval;
+ REALDELIMITER:
+ if (! target) {
+ return;
+ } else if (tex_has_del_code(dval)) {
+ node_subtype(target) = dval.small.class_value;
+ delimiter_small_family(target) = dval.small.family_value;
+ delimiter_small_character(target) = dval.small.character_value;
+ delimiter_large_family(target) = dval.large.family_value;
+ delimiter_large_character(target) = dval.large.character_value;
+ } else {
+ tex_back_input(cur_tok);
+ tex_handle_error(
+ normal_error_type,
+ "Missing delimiter (. inserted)",
+ "I was expecting to see something like '(' or '\\{' or '\\}' here. Acceptable\n"
+ "delimiters are characters whose \\delcode is nonnegative, or you can use\n"
+ "'\\delimiter <delimiter code>'."
+ );
+ node_subtype(target) = unset_noad_class;
+ delimiter_small_family(target) = 0;
+ delimiter_small_character(target) = 0;
+ delimiter_large_family(target) = 0;
+ delimiter_large_character(target) = 0;
+ }
+ return;
+}
+
+void tex_run_math_radical(void)
+{
+ halfword code = cur_chr;
+ halfword options = 0;
+ halfword radical = tex_new_node(radical_noad, (quarterword) code);
+ halfword style = yet_unset_math_style;
+ halfword variant = 0; /* quad, harmless */
+ halfword attrlist = null;
+ tex_tail_append(radical);
+ /* only kewords to UI ones? */
+ while (1) {
+ switch (tex_scan_character("abeswlmrhndABESWLMRHDN", 0, 1, 0)) {
+ case 0:
+ goto DONE;
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("attr", 1)) {
+ attrlist = tex_scan_attribute(attrlist);
+ }
+ break;
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("exact", 1)) {
+ options = options | noad_option_exact;
+ }
+ break;
+ case 's': case 'S':
+ switch (tex_scan_character("toTO", 0, 0, 0)) {
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("style", 2)) {
+ switch (code) {
+ case normal_radical_subtype:
+ case radical_radical_subtype:
+ case root_radical_subtype:
+ case rooted_radical_subtype:
+ case delimited_radical_subtype:
+ style = tex_scan_math_style_identifier(1, 0);
+ break;
+ default:
+ /* ignore */
+ break;
+ }
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("source", 2)) {
+ noad_source(radical) = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("style|source");
+ goto DONE;
+ }
+ break;
+ case 'w': case 'W':
+ if (tex_scan_mandate_keyword("width", 1)) {
+ noad_width(radical) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("depth", 1)) {
+ radical_depth(radical) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'h': case 'H':
+ if (tex_scan_mandate_keyword("height", 1)) {
+ radical_height(radical) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("left", 1)) {
+ options = options | noad_option_left;
+ }
+ break;
+ case 'm': case 'M':
+ if (tex_scan_mandate_keyword("middle", 1)) {
+ options = options | noad_option_middle;
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("right", 1)) {
+ options = options | noad_option_right;
+ }
+ break;
+ case 'n': case 'N':
+ if (tex_scan_mandate_keyword("nooverflow", 1)) {
+ options |= noad_option_no_overflow;
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ if (style == yet_unset_math_style) {
+ switch (code) {
+ case normal_radical_subtype:
+ case radical_radical_subtype:
+ case root_radical_subtype:
+ variant = math_parameter_radical_variant;
+ break;
+ case under_delimiter_radical_subtype:
+ variant = math_parameter_under_delimiter_variant;
+ break;
+ case over_delimiter_radical_subtype:
+ variant = math_parameter_over_delimiter_variant;
+ break;
+ case delimiter_under_radical_subtype:
+ variant = math_parameter_delimiter_under_variant;
+ break;
+ case delimiter_over_radical_subtype:
+ variant = math_parameter_delimiter_over_variant;
+ break;
+ case delimited_radical_subtype:
+ variant = math_parameter_radical_variant; /* math_parameter_delimited_variant */
+ break;
+ case h_extensible_radical_subtype:
+ variant = math_parameter_h_extensible_variant;
+ break;
+ }
+ style = variant ? tex_math_style_variant(cur_list.math_style, variant) : cur_list.math_style;
+ }
+ if (attrlist) {
+ tex_attach_attribute_list_attribute(radical, attrlist);
+ }
+ noad_options(radical) = options;
+ set_noad_style(radical, style);
+ {
+ switch (code) {
+ case normal_radical_subtype:
+ {
+ halfword left = tex_new_node(delimiter_node, 0);
+ radical_left_delimiter(radical) = left;
+ tex_aux_scan_delimiter(left, tex_mathcode, unset_noad_class);
+ }
+ break;
+ case radical_radical_subtype:
+ case root_radical_subtype:
+ case rooted_radical_subtype:
+ case delimited_radical_subtype:
+ {
+ halfword left = tex_new_node(delimiter_node, 0);
+ radical_left_delimiter(radical) = left;
+ tex_aux_scan_delimiter(left, umath_mathcode, unset_noad_class);
+ }
+ switch (code) {
+ case rooted_radical_subtype:
+ case delimited_radical_subtype:
+ {
+ halfword right = tex_new_node(delimiter_node, 0);
+ radical_right_delimiter(radical) = right;
+ tex_aux_scan_delimiter(right, umath_mathcode, unset_noad_class);
+ }
+ }
+ break;
+ case under_delimiter_radical_subtype:
+ case over_delimiter_radical_subtype:
+ case delimiter_under_radical_subtype:
+ case delimiter_over_radical_subtype:
+ case h_extensible_radical_subtype:
+ {
+ halfword left = tex_new_node(delimiter_node, 0);
+ radical_left_delimiter(radical) = left;
+ tex_aux_scan_delimiter(left, umath_mathcode, unset_noad_class);
+ }
+ break;
+ default:
+ tex_confusion("scan math radical");
+ break;
+ }
+ }
+ switch (code) {
+ case h_extensible_radical_subtype:
+ /*tex type will change */
+ {
+ halfword q = tex_new_node(sub_box_node, 0);
+ noad_nucleus(radical) = q;
+ break;
+ }
+ case root_radical_subtype:
+ case rooted_radical_subtype:
+ /*tex
+ The trick with the |node_next(q)| is used by |scan_math| to decide whether it needs to
+ go on. This code looks a bit weird, is it okay? So, here we directly pick up the two
+ lists while in choices we go through the somewhat complex \quote {complete} group based
+ mechanism.
+ */
+ {
+ halfword q = tex_new_node(math_char_node, 0);
+ node_next(q) = radical; /* trick */
+ radical_degree(radical) = q;
+ if (! tex_aux_scan_math(radical_degree(radical), tex_math_style_variant(style, math_parameter_degree_variant), 0, 0, 0, 0, unset_noad_class, unset_noad_class)) {
+ /*tex Actually it's always scriptscript I guess. */
+ node_next(radical_degree(radical)) = null;
+ q = tex_new_node(math_char_node, 0);
+ noad_nucleus(radical) = q;
+ if (noad_style(radical) != style) {
+ /* We keep the style in the node for diagnostics. */
+ tex_back_input(token_val(math_style_cmd, noad_style(radical)));
+ }
+ tex_aux_scan_math(q, tex_math_style_variant(style, math_parameter_radical_variant), 0, 0, 0, 0, unset_noad_class, unset_noad_class);
+ }
+ break;
+ }
+ default :
+ {
+ halfword q = tex_new_node(math_char_node, 0);
+ noad_nucleus(radical) = q;
+ tex_aux_scan_math(q, tex_math_style_variant(style, variant ? variant : math_parameter_radical_variant), 0, 0, 0, 0, unset_noad_class, unset_noad_class);
+ break;
+ }
+ }
+}
+
+void tex_run_math_accent(void)
+{
+ mathcodeval t = tex_no_math_code();
+ mathcodeval b = tex_no_math_code();
+ mathcodeval o = tex_no_math_code();
+ halfword code = cur_chr;
+ halfword accent = tex_new_node(accent_noad, bothflexible_accent_subtype);
+ quarterword subtype = ordinary_noad_subtype;
+ halfword attrlist = null;
+ if (cur_cmd == accent_cmd) {
+ tex_handle_error(
+ normal_error_type,
+ "Please use \\mathaccent for accents in math mode",
+ "I'm changing \\accent to \\mathaccent here; wish me luck. (Accents are not the\n"
+ "same in formulas as they are in text.)" );
+ }
+ tex_tail_append(accent);
+ switch (code) {
+ case math_accent_code:
+ /*tex |\mathaccent| */
+ t = tex_scan_mathchar(tex_mathcode);
+ break;
+ case math_uaccent_code:
+ /*tex |\Umathaccent| */
+ while (1) {
+ switch (tex_scan_character("ansfASFN", 0, 0, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("attr", 1)) {
+ attrlist = tex_scan_attribute(attrlist);
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("source", 1)) {
+ noad_source(accent) = tex_scan_int(0, NULL);
+ }
+ break;
+ case 'f': case 'F':
+ if (tex_scan_mandate_keyword("fraction", 1)) {
+ accent_fraction(accent) = tex_scan_int(0, NULL);
+ }
+ break;
+ case 'n': case 'N':
+ if (tex_scan_mandate_keyword("nooverflow", 1)) {
+ /*tex
+ Actually there never is an overflow but for consistency we do
+ accept this key. Mayebe in the future it will be used.
+ */
+ noad_options(accent) |= noad_option_no_overflow;
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ /* todo: integrate in the above */
+ if (tex_scan_keyword("fixed")) {
+ /*tex top */
+ node_subtype(accent) = fixedtop_accent_subtype;
+ t = tex_scan_mathchar(umath_mathcode);
+ } else if (tex_scan_keyword("both")) {
+ /*tex top bottom */
+ if (tex_scan_keyword("fixed")) {
+ node_subtype(accent) = fixedtop_accent_subtype;
+ }
+ t = tex_scan_mathchar(umath_mathcode);
+ if (tex_scan_keyword("fixed")) {
+ node_subtype(accent) = fixedboth_accent_subtype;
+ }
+ b = tex_scan_mathchar(umath_mathcode);
+ } else if (tex_scan_keyword("bottom")) {
+ /*tex bottom */
+ if (tex_scan_keyword("fixed")) {
+ node_subtype(accent) = fixedbottom_accent_subtype;
+ }
+ b = tex_scan_mathchar(umath_mathcode);
+ } else if (tex_scan_keyword("top")) {
+ /*tex top */
+ if (tex_scan_keyword("fixed")) {
+ node_subtype(accent) = fixedtop_accent_subtype;
+ }
+ t = tex_scan_mathchar(umath_mathcode);
+ } else if (tex_scan_keyword("overlay")) {
+ /* overlay */
+ if (tex_scan_keyword("fixed")) {
+ node_subtype(accent) = fixedtop_accent_subtype;
+ }
+ o = tex_scan_mathchar(umath_mathcode);
+ } else {
+ /*tex top */
+ t = tex_scan_mathchar(umath_mathcode);
+ }
+ break;
+ default:
+ tex_confusion("scan math accent");
+ }
+ if (attrlist) {
+ tex_attach_attribute_list_attribute(accent, attrlist);
+ }
+ if (! (t.character_value == 0 && t.family_value == 0)) {
+ halfword n = tex_new_node(math_char_node, 0);
+ subtype = tex_aux_set_math_char(n, &t, NULL);
+ accent_top_character(accent) = n;
+ }
+ if (! (b.character_value == 0 && b.family_value == 0)) {
+ halfword n = tex_new_node(math_char_node, 0);
+ subtype = tex_aux_set_math_char(n, &b, NULL);
+ accent_bottom_character(accent) = n;
+ }
+ if (! (o.character_value == 0 && o.family_value == 0)) {
+ halfword n = tex_new_node(math_char_node, 0);
+ subtype = tex_aux_set_math_char(n, &o, NULL);
+ accent_middle_character(accent) = n;
+ }
+ {
+ halfword n = tex_new_node(math_char_node, subtype);
+ noad_nucleus(accent) = n;
+ tex_aux_scan_math(n, tex_math_style_variant(cur_list.math_style, math_parameter_accent_variant), 0, 0, 0, 0, unset_noad_class, unset_noad_class);
+ }
+}
+
+/*tex
+
+ The routine that scans the four mlists of a |\mathchoice| is very much like the routine that
+ builds discretionary nodes. 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.
+
+*/
+
+void tex_run_math_choice(void) {
+ switch (cur_chr) {
+ case math_discretionary_code:
+ {
+ halfword n = tex_new_node(choice_node, discretionary_choice_subtype);
+ choice_class(n) = unset_noad_class;
+ while (1) {
+ switch (tex_scan_character("cC", 0, 1, 0)) {
+ case 0:
+ goto DONE;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("class", 1)) {
+ choice_class(n) = tex_scan_math_class_number(0);
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ tex_tail_append(n);
+ tex_set_saved_record(saved_choice_item_count, saved_choices_count, 0, math_pre_break_choice);
+ lmt_save_state.save_stack_data.ptr += saved_choice_n_of_items;
+ tex_aux_push_math(math_choice_group, cur_list.math_style);
+ tex_scan_left_brace();
+ break;
+ }
+ case math_choice_code:
+ /*tex |\mathchoice| */
+ {
+ halfword n = tex_new_node(choice_node, normal_choice_subtype);
+ tex_tail_append(n);
+ tex_set_saved_record(saved_choice_item_count, saved_choices_count, 0, math_display_choice);
+ lmt_save_state.save_stack_data.ptr += saved_choice_n_of_items;
+ tex_aux_push_math(math_choice_group, display_style);
+ tex_scan_left_brace();
+ break;
+ }
+ case math_ustack_code:
+ /*tex |\Ustack| */
+ {
+ // halfword m = tex_new_node(sub_mlist_node, 0); /* was for some reason a math_char_node */
+ halfword m = tex_new_node(math_char_node, 0);
+ halfword n = tex_new_node(simple_noad, ordinary_noad_subtype);
+ halfword s = tex_math_style_variant(cur_list.math_style, math_parameter_stack_variant);
+ tex_tail_append(n);
+ noad_nucleus(n) = m;
+ tex_scan_left_brace();
+ tex_set_saved_record(0, saved_math_pointer, 0, m);
+ ++lmt_save_state.save_stack_data.ptr;
+ tex_aux_push_math(math_group, s);
+ break;
+ }
+ }
+}
+
+int tex_current_math_style(void)
+{
+ return (abs(cur_list.mode) == mmode) ? cur_list.math_style : -1;
+}
+
+int tex_current_math_main_style(void)
+{
+ return (abs(cur_list.mode) == mmode) ? cur_list.math_main_style : -1;
+}
+
+void tex_finish_math_choice(void)
+{
+ halfword content;
+ tex_aux_unsave_math();
+ content = tex_aux_finish_math_list(null);
+ /* We should just count and not rely on the next hackery test: */
+ if (saved_type(saved_choice_item_count - saved_choice_n_of_items) == saved_choices_count) {
+ int choice = saved_value(saved_choice_item_count - saved_choice_n_of_items);
+ int style = cur_list.math_style;
+ switch (node_subtype(cur_list.tail)) {
+ case normal_choice_subtype:
+ switch (choice) {
+ case math_display_choice:
+ choice_display_mlist(cur_list.tail) = content;
+ style = text_style;
+ break;
+ case math_text_choice:
+ choice_text_mlist(cur_list.tail) = content;
+ style = script_style;
+ break;
+ case math_script_choice:
+ choice_script_mlist(cur_list.tail) = content;
+ style = script_script_style;
+ break;
+ case math_script_script_choice:
+ choice_script_script_mlist(cur_list.tail) = content;
+ lmt_save_state.save_stack_data.ptr -= saved_choice_n_of_items;
+ return;
+ }
+ break;
+ case discretionary_choice_subtype:
+ switch (choice) {
+ case math_pre_break_choice:
+ choice_pre_break(cur_list.tail) = content;
+ style = display_style;
+ break;
+ case math_post_break_choice:
+ choice_post_break(cur_list.tail) = content;
+ style = text_style;
+ break;
+ case math_no_break_choice:
+ choice_no_break(cur_list.tail) = content;
+ style = script_style;
+ lmt_save_state.save_stack_data.ptr -= saved_choice_n_of_items;
+ return;
+ }
+ break;
+ }
+ tex_set_saved_record(saved_choice_item_count - saved_choice_n_of_items, saved_choices_count, 0, choice + 1);
+ tex_aux_push_math(math_choice_group, style);
+ tex_scan_left_brace();
+ } else {
+ tex_confusion("scan build choices");
+ }
+}
+
+void tex_finish_math_fraction(void)
+{
+ halfword content;
+ tex_aux_unsave_math();
+ content = tex_aux_finish_math_list(null);
+ if (saved_type(saved_fraction_item_variant - saved_fraction_n_of_items) == saved_fraction_variant) {
+ halfword over = saved_value(saved_fraction_item_variant - saved_fraction_n_of_items);
+ halfword autostyle = saved_value(saved_fraction_item_autostyle - saved_fraction_n_of_items);
+ halfword userstyle = saved_value(saved_fraction_item_userstyle - saved_fraction_n_of_items);
+ halfword fraction = cur_list.tail;
+ set_noad_style(fraction, userstyle);
+ switch (over) {
+ case math_numerator_above:
+ kernel_math_list(fraction_numerator(fraction)) = content;
+ break;
+ case math_denominator_above:
+ kernel_math_list(fraction_denominator(fraction)) = content;
+ lmt_save_state.save_stack_data.ptr -= saved_fraction_n_of_items;
+ return;
+ }
+ tex_set_saved_record(saved_fraction_item_variant - saved_fraction_n_of_items, saved_fraction_variant, 0, over + 1);
+ tex_aux_push_math(math_fraction_group, autostyle);
+ tex_scan_left_brace();
+ } else {
+ tex_confusion("scan build fraction");
+ }
+}
+
+void tex_finish_math_operator(void)
+{
+ halfword content;
+ tex_aux_unsave_math();
+ content = tex_aux_finish_math_list(null);
+ if (saved_type(saved_operator_item_variant - saved_operator_n_of_items) == saved_operator_variant) {
+ halfword over = saved_value(saved_operator_item_variant - saved_operator_n_of_items);
+ halfword fenced = cur_list.tail;
+ switch (over) {
+ case math_limits_top:
+ kernel_math_list(fence_delimiter_top(fenced)) = content;
+ break;
+ case math_limits_bottom:
+ kernel_math_list(fence_delimiter_bottom(fenced)) = content;
+ lmt_save_state.save_stack_data.ptr -= saved_operator_n_of_items;
+ return;
+ }
+ tex_set_saved_record(saved_operator_item_variant - saved_operator_n_of_items, saved_operator_variant, 0, over + 1);
+ tex_aux_push_math(math_operator_group, tex_math_style_variant(cur_list.math_style, math_parameter_subscript_variant));
+ tex_scan_left_brace();
+ } else {
+ tex_confusion("scan build operator");
+ }
+}
+
+/*tex
+
+ Subscripts and superscripts are attached to the previous nucleus by the action procedure called
+ |sub_sup|.
+
+*/
+
+# define scripts_allowed(A) ((node_type((A)) >= simple_noad) && (node_type((A)) < fence_noad))
+
+static halfword tex_math_double_atom(void)
+{
+ halfword tail = tex_new_node(simple_noad, ordinary_noad_subtype);
+ halfword list = tex_new_node(sub_mlist_node, 0);
+ tex_tail_append(tail);
+ if (math_double_script_mode_par >= 0) {
+ node_subtype(tail) = (math_double_script_mode_par >> 16) & 0xFF;
+ noad_class_left(tail) = (math_double_script_mode_par >> 8) & 0xFF;
+ noad_class_right(tail) = (math_double_script_mode_par >> 0) & 0xFF;
+ }
+ noad_nucleus(tail) = list;
+ return tail;
+}
+
+void tex_run_math_script(void)
+{
+ int code = cur_chr;
+ halfword tail = cur_list.tail;
+ switch (cur_cmd) {
+ case subscript_cmd:
+ code = math_sub_script_code;
+ break;
+ case superscript_cmd:
+ code = math_super_script_code;
+ break;
+ }
+ switch (code) {
+ case math_no_script_code:
+ {
+ halfword glue = tex_new_glue_node(zero_glue, conditional_math_glue);
+ tex_tail_append(glue);
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ }
+ return;
+ case math_no_ruling_code:
+ {
+ halfword glue = tex_new_glue_node(zero_glue, rulebased_math_glue);
+ tex_tail_append(glue);
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ }
+ return;
+ case math_sub_script_code:
+ tex_get_token();
+ if (cur_tok == underscore_token || cur_cmd == subscript_cmd) {
+ tex_get_token();
+ if (cur_tok == underscore_token || cur_cmd == subscript_cmd) {
+ tex_get_token();
+ if (cur_tok == underscore_token || cur_cmd == subscript_cmd) {
+ code = math_shifted_sub_pre_script_code;
+ } else {
+ tex_back_input(cur_tok);
+ code = math_shifted_sub_script_code;
+ }
+ } else {
+ tex_back_input(cur_tok);
+ code = math_sub_pre_script_code;
+ }
+ } else {
+ tex_back_input(cur_tok);
+ }
+ break;
+ case math_super_script_code:
+ tex_get_token();
+ if (cur_tok == circumflex_token || cur_cmd == superscript_cmd) {
+ tex_get_token();
+ if (cur_tok == circumflex_token || cur_cmd == superscript_cmd) {
+ tex_get_token();
+ if (cur_tok == circumflex_token || cur_cmd == superscript_cmd) {
+ code = math_shifted_super_pre_script_code;
+ } else {
+ tex_back_input(cur_tok);
+ code = math_shifted_super_script_code;
+ }
+ } else {
+ tex_back_input(cur_tok);
+ code = math_super_pre_script_code;
+ }
+ } else {
+ tex_back_input(cur_tok);
+ }
+ break;
+ }
+ if (tail == cur_list.head || (! scripts_allowed(tail))) {
+ halfword n = tex_new_node(sub_mlist_node, 0);
+ tail = tex_new_node(simple_noad, ordinary_noad_subtype);
+ tex_tail_append(tail);
+ noad_nucleus(tail) = n;
+ }
+ switch (code) {
+ case math_sub_script_code:
+ case math_no_sub_script_code:
+ case math_shifted_sub_script_code:
+ {
+ if (noad_subscr(tail)) {
+ tail = tex_math_double_atom();
+ if (math_double_script_mode_par < 0) {
+ tex_handle_error(
+ normal_error_type,
+ "Double subscript",
+ "I treat 'x_1_2' essentially like 'x_1{}_2'."
+ );
+ }
+ }
+ switch (code) {
+ case math_no_sub_script_code:
+ noad_options(tail) |= noad_option_no_sub_script;
+ break;
+ case math_shifted_sub_script_code:
+ noad_options(tail) |= noad_option_shifted_sub_script;
+ break;
+ }
+ {
+ halfword n = tex_new_node(math_char_node, 0);
+ noad_subscr(tail) = n;
+ tex_aux_scan_math(n, tex_math_style_variant(cur_list.math_style, math_parameter_subscript_variant), 0, 0, 0, 1, unset_noad_class, unset_noad_class);
+ if (! noad_script_order(tail)) {
+ noad_script_order(tail) = script_subscript_first;
+ }
+ }
+ break;
+ }
+ case math_sub_pre_script_code:
+ case math_no_sub_pre_script_code:
+ case math_shifted_sub_pre_script_code:
+ {
+ if (noad_subprescr(tail)) {
+ int limitation = node_type(tail) == fraction_noad; /*tex See remark at node definition. */
+ tail = tex_math_double_atom();
+ if (math_double_script_mode_par < 0) {
+ tex_handle_error(
+ normal_error_type,
+ limitation ? "Fractions take no pre subscript directly" : "Double pre subscript",
+ "I just ignore it; consider wrapping this element."
+ );
+ }
+ }
+ switch (code) {
+ case math_no_sub_pre_script_code:
+ noad_options(tail) |= noad_option_no_sub_pre_script;
+ break;
+ case math_shifted_sub_pre_script_code:
+ noad_options(tail) |= noad_option_shifted_sub_pre_script;
+ break;
+ }
+ {
+ halfword n = tex_new_node(math_char_node, 0);
+ noad_subprescr(tail) = n;
+ tex_aux_scan_math(n, tex_math_style_variant(cur_list.math_style, math_parameter_subscript_variant), 0, 0, 0, 1, unset_noad_class, unset_noad_class);
+ }
+ break;
+ }
+ case math_super_script_code:
+ case math_no_super_script_code:
+ case math_shifted_super_script_code:
+ {
+ if (noad_supscr(tail)) {
+ tail = tex_math_double_atom();
+ if (math_double_script_mode_par < 0) {
+ tex_handle_error(
+ normal_error_type,
+ "Double superscript",
+ "I treat 'x^1^2' essentially like 'x^1{}^2'."
+ );
+ }
+ }
+ switch (code) {
+ case math_no_super_script_code:
+ noad_options(tail) |= noad_option_no_super_script;
+ break;
+ case math_shifted_super_script_code:
+ noad_options(tail) |= noad_option_shifted_super_script;
+ break;
+ }
+ {
+ halfword n = tex_new_node(math_char_node, 0);
+ noad_supscr(tail) = n;
+ if (! noad_script_order(tail)) {
+ noad_script_order(tail) = script_superscript_first;
+ }
+ tex_aux_scan_math(n, tex_math_style_variant(cur_list.math_style, math_parameter_superscript_variant), 0, 0, 0, 1, unset_noad_class, unset_noad_class);
+ }
+ break;
+ }
+ case math_super_pre_script_code:
+ case math_no_super_pre_script_code:
+ case math_shifted_super_pre_script_code:
+ {
+ if (noad_supprescr(tail)) {
+ int limitation = node_type(tail) == fraction_noad; /*tex See remark at node definition. */
+ tail = tex_math_double_atom();
+ if (math_double_script_mode_par < 0) {
+ tex_handle_error(
+ normal_error_type,
+ limitation ? "Fractions take no pre superscript directly" : "Double pre superscript",
+ "I just ignore it; consider wrapping this element."
+ );
+ }
+ }
+ switch (code) {
+ case math_no_super_script_code:
+ noad_options(tail) |= noad_option_no_super_pre_script;
+ break;
+ case math_shifted_super_pre_script_code:
+ noad_options(tail) |= noad_option_shifted_super_pre_script;
+ break;
+ }
+ {
+ halfword n = tex_new_node(math_char_node, 0);
+ noad_supprescr(tail) = n;
+ tex_aux_scan_math(n, tex_math_style_variant(cur_list.math_style, math_parameter_superscript_variant), 0, 0, 0, 1, unset_noad_class, unset_noad_class);
+ }
+ break;
+ }
+ case math_prime_script_code:
+ {
+ if (noad_prime(tail)) {
+ tail = tex_math_double_atom();
+ if (math_double_script_mode_par < 0) {
+ tex_handle_error(
+ normal_error_type,
+ "Double prime script",
+ "I'll add a dummy nucleus."
+ );
+ }
+ }
+ {
+ halfword n = tex_new_node(math_char_node, 0);
+ noad_prime(tail) = n;
+ if (! noad_script_order(tail)) {
+ noad_script_order(tail) = script_primescript_first;
+ }
+ /* maybe it's own variant */
+ tex_aux_scan_math(n, tex_math_style_variant(cur_list.math_style, math_parameter_superscript_variant), 0, 0, 0, 1, unset_noad_class, unset_noad_class);
+ }
+ break;
+ }
+ }
+}
+
+/*tex
+
+ An operation like |\over| causes the current mlist to go into a state of suspended animation:
+ |incomplete_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 incomplete fraction noad, and that noad will become the whole formula, unless it is
+ surrounded by |\left| and |\right| delimiters.
+
+ We can probably replace the |incomplete_noad_par| trickery because we can now look back in the
+ list using the |alink| field. But not now.
+
+*/
+
+void tex_run_math_fraction(void)
+{
+ /*tex The type of generalized fraction we are scanning: */
+ halfword code = cur_chr;
+ if (cur_list.incomplete_noad) {
+ /*tex Recovery code. */
+ switch (code) {
+ case math_above_delimited_code:
+ case math_over_delimited_code:
+ case math_atop_delimited_code:
+ case math_u_above_delimited_code:
+ case math_u_over_delimited_code:
+ case math_u_atop_delimited_code:
+ case math_u_skewed_delimited_code:
+ case math_u_stretched_delimited_code:
+ tex_aux_scan_delimiter(null, no_mathcode, unset_noad_class);
+ tex_aux_scan_delimiter(null, no_mathcode, unset_noad_class);
+ break;
+ }
+ switch (code) {
+ case math_above_code:
+ case math_above_delimited_code:
+ case math_u_above_code:
+ case math_u_above_delimited_code:
+ tex_scan_dimen(0, 0, 0, 0, NULL);
+ break;
+ }
+ /*tex This is somewhat weird, this error here. */
+ tex_handle_error(
+ normal_error_type,
+ "Ambiguous; you need another { and }",
+ "I'm ignoring this fraction specification, since I don't know whether a\n"
+ "construction like 'x \\over y \\over z' means '{x \\over y} \\over z' or\n"
+ "'x \\over {y \\over z}'."
+ );
+ } else {
+ halfword fraction = tex_new_node(fraction_noad, 0);
+ halfword numerator = tex_new_node(sub_mlist_node, 0);
+ halfword denominator = null;
+ halfword autostyle = tex_math_style_variant(cur_list.math_style, math_parameter_fraction_variant);
+ halfword userstyle = -1;
+ halfword attrlist = null;
+ halfword options = 0;
+ halfword class = fraction_noad_subtype;
+ halfword rulethickness = preset_rule_thickness;
+ int ruledone = 0;
+ fraction_h_factor(fraction) = 1000;
+ fraction_v_factor(fraction) = 1000;
+ switch (code) {
+ case math_above_code:
+ case math_above_delimited_code:
+ node_subtype(fraction) = above_fraction_subtype;
+ goto NEXTSTEP1;
+ case math_over_code:
+ case math_over_delimited_code:
+ node_subtype(fraction) = over_fraction_subtype;
+ goto NEXTSTEP1;
+ case math_atop_code:
+ case math_atop_delimited_code:
+ node_subtype(fraction) = atop_fraction_subtype;
+ NEXTSTEP1:
+ {
+ cur_list.incomplete_noad = fraction;
+ fraction_numerator(fraction) = numerator;
+ kernel_math_list(numerator) = node_next(cur_list.head);
+ node_next(cur_list.head) = null;
+ cur_list.tail = cur_list.head;
+ cur_list.math_style = autostyle;
+ break;
+ }
+ case math_u_above_code:
+ case math_u_above_delimited_code:
+ node_subtype(fraction) = above_fraction_subtype;
+ goto NEXTSTEP2;
+ case math_u_over_code:
+ case math_u_over_delimited_code:
+ node_subtype(fraction) = over_fraction_subtype;
+ goto NEXTSTEP2;
+ case math_u_atop_code:
+ case math_u_atop_delimited_code:
+ node_subtype(fraction) = atop_fraction_subtype;
+ goto NEXTSTEP2;
+ case math_u_skewed_code:
+ case math_u_skewed_delimited_code:
+ node_subtype(fraction) = skewed_fraction_subtype;
+ goto NEXTSTEP2;
+ case math_u_stretched_code:
+ case math_u_stretched_delimited_code:
+ node_subtype(fraction) = stretched_fraction_subtype;
+ NEXTSTEP2:
+ {
+ cur_list.incomplete_noad = null;
+ denominator = tex_new_node(sub_mlist_node, 0);
+ tex_tail_append(fraction);
+ fraction_numerator(fraction) = numerator;
+ fraction_denominator(fraction) = denominator;
+ break;
+ }
+ }
+ switch (code) {
+ case math_u_skewed_code:
+ case math_u_skewed_delimited_code:
+ case math_u_stretched_code:
+ case math_u_stretched_delimited_code:
+ {
+ halfword q = tex_new_node(delimiter_node, 0);
+ fraction_middle_delimiter(fraction) = q;
+ tex_aux_scan_delimiter(q, no_mathcode, unset_noad_class);
+ break;
+ }
+ }
+ switch (code) {
+ case math_above_delimited_code:
+ case math_over_delimited_code:
+ case math_atop_delimited_code:
+ case math_u_above_delimited_code:
+ case math_u_over_delimited_code:
+ case math_u_atop_delimited_code:
+ case math_u_skewed_delimited_code:
+ case math_u_stretched_delimited_code:
+ {
+ halfword left = tex_new_node(delimiter_node, 0);
+ halfword right = tex_new_node(delimiter_node, 0);
+ fraction_left_delimiter(fraction) = left;
+ fraction_right_delimiter(fraction) = right;
+ tex_aux_scan_delimiter(left, no_mathcode, open_noad_subtype);
+ tex_aux_scan_delimiter(right, no_mathcode, close_noad_subtype);
+ break;
+ }
+ }
+ switch (code) {
+ /*tex We can't have keyword here because of compatibility reasons. */
+ case math_above_code:
+ case math_above_delimited_code:
+ rulethickness = tex_scan_dimen(0, 0, 0, 0, NULL);
+ break;
+ case math_over_code:
+ case math_over_delimited_code:
+ rulethickness = preset_rule_thickness;
+ break;
+ case math_atop_code:
+ case math_atop_delimited_code:
+ break;
+ /*tex
+ But here we can! For practical reasons we accept the rule related options
+ and in principle we cold do with one command.
+ */
+ case math_u_atop_code:
+ case math_u_atop_delimited_code:
+ case math_u_above_code:
+ case math_u_above_delimited_code:
+ goto OPTIONS;
+ case math_u_over_code:
+ case math_u_over_delimited_code:
+ ruledone = 1;
+ goto OPTIONS;
+ case math_u_stretched_code:
+ case math_u_stretched_delimited_code:
+ case math_u_skewed_code:
+ case math_u_skewed_delimited_code:
+ ruledone = 1;
+ OPTIONS:
+ while (1) {
+ switch (tex_scan_character("acefhnstvACEFHNSTV", 0, 1, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("attr", 1)) {
+ attrlist = tex_scan_attribute(attrlist);
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("class", 1)) {
+ halfword c = (quarterword) tex_scan_math_class_number(0);
+ if (valid_math_class_code(c)) {
+ class = c;
+ }
+ }
+ break;
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("exact", 1)) {
+ options |= noad_option_exact;
+ }
+ break;
+ case 'n': case 'N':
+ /*tex A bit over the top, three steps but a push back is still worse. */
+ if (tex_scan_character("oO", 0, 0, 0)) {
+ switch (tex_scan_character("aoAO", 0, 0, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("noaxis", 3)) {
+ options |= noad_option_no_axis;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("nooverflow", 3)) {
+ options |= noad_option_no_overflow;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("noaxis|nooverflow");
+ goto DONE;
+ }
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("thickness", 1)) {
+ ruledone = 1;
+ rulethickness = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'f': case 'F':
+ if (tex_scan_mandate_keyword("font", 1)) {
+ ruledone = 1;
+ options |= noad_option_prefer_font_thickness;
+ }
+ break;
+ case 's': case 'S':
+ switch (tex_scan_character("toTO", 0, 0, 0)) {
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("style", 2)) {
+ halfword style = tex_scan_math_style_identifier(1, 0);
+ if (denominator) {
+ userstyle = style;
+ } else {
+ /* just ignore */
+ }
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("source", 2)) {
+ noad_source(fraction) = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("style|source");
+ goto DONE;
+ }
+ break;
+ case 'h': case 'H':
+ if (tex_scan_mandate_keyword("hfactor", 1)) {
+ fraction_h_factor(fraction) = tex_scan_int(0, NULL);
+ }
+ break;
+ case 'v': case 'V':
+ if (tex_scan_mandate_keyword("vfactor", 1)) {
+ fraction_v_factor(fraction) = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ if (! ruledone) {
+ rulethickness = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ }
+ fraction_rule_thickness(fraction) = rulethickness;
+ noad_options(fraction) = options;
+ set_noad_main_class(fraction, class);
+ if (attrlist) {
+ tex_attach_attribute_list_attribute(fraction, attrlist);
+ }
+ if (denominator) {
+ /*tex
+ In this case we need to pick up two math groups, and after some playing around using
+ a variant of choices made most sense.
+ */
+ tex_set_saved_record(saved_fraction_item_variant, saved_fraction_variant, 0, math_numerator_above);
+ tex_set_saved_record(saved_fraction_item_autostyle, saved_fraction_auto_style, 0, autostyle);
+ tex_set_saved_record(saved_fraction_item_userstyle, saved_fraction_user_style, 0, userstyle);
+ lmt_save_state.save_stack_data.ptr += saved_fraction_n_of_items;
+ cur_list.math_flatten = 0;
+ tex_aux_push_math(math_fraction_group, autostyle);
+ tex_scan_left_brace();
+ } else {
+ /*tex
+ This is the pre/post variant. Actually, this variant is the reason why math scanning
+ code is somewhat complex, this |incomplete_noad| stuff.
+ */
+ }
+ }
+}
+
+/*tex
+
+ At the end of a math formula or subformula, the |finish_math_list| routine is called upon to
+ return a halfword to the newly completed mlist, and to pop the nest back to the enclosing
+ semantic level. The parameter to |finish_math_list|, if not null, points to a |fence_noad| that
+ ends the current mlist; this |fence_noad| has not yet been appended.
+
+*/
+
+static halfword tex_aux_finish_math_list(halfword p)
+{
+ halfword q;
+ if (cur_list.incomplete_noad) {
+ halfword denominator = fraction_denominator(cur_list.incomplete_noad);
+ if (denominator) {
+ node_type(denominator) = sub_mlist_node;
+ } else {
+ denominator = tex_new_node(sub_mlist_node, 0);
+ fraction_denominator(cur_list.incomplete_noad) = denominator;
+ q = denominator;
+ }
+ kernel_math_list(denominator) = node_next(cur_list.head);
+ if (p) {
+ halfword numerator = fraction_numerator(cur_list.incomplete_noad);
+ q = kernel_math_list(numerator);
+ if ((node_type(q) != fence_noad) || (node_subtype(q) != left_fence_side) || (! cur_list.delim)) {
+ tex_confusion("right fence");
+ }
+ kernel_math_list(numerator) = node_next(cur_list.delim);
+ node_next(cur_list.delim) = cur_list.incomplete_noad;
+ node_next(cur_list.incomplete_noad) = p;
+ } else {
+ q = cur_list.incomplete_noad;
+ }
+ } else {
+ node_next(cur_list.tail) = p;
+ q = node_next(cur_list.head);
+ }
+ tex_pop_nest();
+ return q;
+}
+
+/*tex
+ Here traditional \TEX\ does some flattening but it can interfrere. It is for instance needed
+ in order to find the skew of an accented character which happens at the outer level but that
+ bit of code now does that recursively. I need to check why the accent was flattened so we
+ keep the original code here for testing.
+
+ A \CONTEXT\ test case: |$\tilde{x}'$| i.e.\ primes!
+*/
+
+static void tex_aux_flatten_math_list(halfword parent)
+{
+ halfword p = kernel_math_list(parent);
+ if (p && ! node_next(p)) {
+ switch (node_type(p)) {
+ case simple_noad:
+ {
+ if (! noad_has_following_scripts(p) && tex_math_has_class_option(node_subtype(p), flatten_class_option)) {
+ halfword n = noad_nucleus(p);
+ halfword s = parent;
+ node_type(s) = node_type(n);
+ tex_math_copy_char_data(s, n, 1);
+ tex_attach_attribute_list_copy(s, n);
+ tex_flush_node(p);
+ }
+ break;
+ }
+ case accent_noad:
+ {
+ halfword tail = cur_list.tail;
+ if (saved_value(saved_math_group_item_pointer) == noad_nucleus(tail) && node_type(tail) == simple_noad) {
+ switch (node_subtype(tail)) {
+ case ordinary_noad_subtype:
+ tex_couple_nodes(node_prev(tail), p);
+ noad_nucleus(tail) = null;
+ noad_subscr(tail) = null;
+ noad_supscr(tail) = null;
+ noad_prime(tail) = null;
+ tex_attach_attribute_list_copy(p, tail);
+ tex_flush_node(tail);
+ cur_list.tail = p;
+ break;
+ }
+ }
+ break;
+ }
+ }
+ }
+}
+
+/*tex
+
+ 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- and/or superscripts, or when they surround an accent that is the nucleus of
+ an Ord atom.
+
+*/
+
+void tex_finish_math_group(void)
+{
+ int old_style = cur_list.math_style;
+ halfword p, parent;
+ quarterword allclass;
+ tex_aux_unsave_math();
+ lmt_save_state.save_stack_data.ptr -= saved_math_group_n_of_items;
+ parent = saved_value(saved_math_group_item_pointer);
+ allclass = (quarterword) saved_value(saved_math_group_all_class);
+ node_type(parent) = sub_mlist_node; /* can be math_char_node */
+ p = tex_aux_finish_math_list(null); /* this incomplete trickery */
+ kernel_math_list(parent) = p;
+ if (cur_list.math_flatten) {
+ tex_aux_flatten_math_list(parent);
+ }
+ /*tex
+ If needed, here we pickup a next \quote {argument}, so we sort of finish a group and reopen
+ a new one. It is somewhat curious that we use a character node here.
+ */
+ if (allclass != unset_noad_class) {
+ while (p) {
+ if (node_type(p) == simple_noad) {
+ // node_subtype(p) = allclass;
+ if (get_noad_main_class(p) == unset_noad_class) {
+ set_noad_main_class(p, allclass);
+ }
+ if (get_noad_left_class(p) == unset_noad_class) {
+ set_noad_left_class(p, allclass);
+ }
+ if (get_noad_right_class(p) == unset_noad_class) {
+ set_noad_right_class(p, allclass);
+ }
+ }
+ p = node_next(p);
+ }
+ /* */
+ }
+ if (node_next(saved_value(saved_math_group_item_pointer)) > 0) {
+ halfword q = tex_new_node(math_char_node, 0); /* hm */
+ noad_nucleus(node_next(saved_value(saved_math_group_item_pointer))) = q;
+ node_next(saved_value(saved_math_group_item_pointer)) = null;
+ saved_value(saved_math_group_item_pointer) = q;
+ tex_aux_scan_math(q, old_style, 0, 0, 0, 0, unset_noad_class, unset_noad_class);
+ /*tex restart */
+ }
+}
+
+/*tex
+
+ 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 or
+ several |\middle| delimiters to appear between |\left| and |\right|.
+
+*/
+
+void tex_run_math_fence(void)
+{
+ halfword ht = 0;
+ halfword dp = 0;
+ halfword options = 0;
+ halfword mainclass = unset_noad_class;
+ halfword leftclass = unset_noad_class;
+ halfword rightclass = unset_noad_class;
+ halfword source = 0;
+ halfword attrlist = null;
+ quarterword st = (quarterword) cur_chr;
+ halfword style = cur_list.math_style;
+ if (math_check_fences_par) {
+ options |= noad_option_no_check;
+ }
+ switch (st) {
+ case left_operator_side:
+ case no_fence_side:
+ break;
+ case extended_left_fence_side: /*tex |\Uleft| */
+ st = left_fence_side;
+ break;
+ case extended_middle_fence_side: /*tex |\Umiddle| */
+ st = middle_fence_side;
+ break;
+ case extended_right_fence_side: /*tex |\Uright| */
+ st = right_fence_side;
+ break;
+ default :
+ goto CHECK_PAIRING;
+ }
+ while (1) {
+ /* todo: break down */
+ switch (tex_scan_character("hdanlevpcrsuHDANLEVPCRSU", 0, 1, 0)) {
+ case 0:
+ goto CHECK_PAIRING;
+ case 'h': case 'H':
+ if (tex_scan_mandate_keyword("height", 1)) {
+ ht = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("depth", 1)) {
+ dp = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'a': case 'A':
+ switch (tex_scan_character("uxtUXT", 0, 0, 0)) {
+ case 'u': case 'U':
+ if (tex_scan_mandate_keyword("auto", 2)) {
+ options |= noad_option_auto;
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("attr", 2)) {
+ attrlist = tex_scan_attribute(attrlist);
+ }
+ break;
+ case 'x': case 'X':
+ if (tex_scan_mandate_keyword("axis", 2)) {
+ options |= noad_option_axis;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("auto|attr|axis");
+ goto CHECK_PAIRING;
+ }
+ break;
+ case 'n': case 'N':
+ switch (tex_scan_character("oO", 0, 0, 0)) {
+ case 'o': case 'O':
+ switch (tex_scan_character("alcoALCO", 0, 0, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("noaxis", 3)) {
+ options |= noad_option_no_axis;
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("nolimits", 3)) {
+ options = unset_option(options, noad_option_limits);
+ options |= noad_option_no_limits;
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("nocheck", 3)) {
+ options |= noad_option_no_check;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("nooverflow", 3)) {
+ options |= noad_option_no_overflow;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("noaxis|nolimits|nocheck|nooverflow");
+ goto CHECK_PAIRING;
+ }
+ break;
+ default:
+ goto CHECK_PAIRING;
+ }
+ break;
+ case 'l': case 'L':
+ switch (tex_scan_character("ieIE", 0, 0, 0)) {
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("leftclass", 2)) {
+ halfword c = tex_scan_math_class_number(0);
+ // if (! valid_math_class_code(c)) {
+ if (valid_math_class_code(c)) {
+ leftclass = c;
+ }
+ }
+ break;
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("limits", 2)) {
+ options = unset_option(options, noad_option_no_limits);
+ options |= noad_option_limits;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("leftclass|limits");
+ goto CHECK_PAIRING;
+ }
+ break;
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("exact", 1)) {
+ options |= noad_option_exact;
+ }
+ break;
+ case 'v': case 'V':
+ if (tex_scan_mandate_keyword("void", 1)) {
+ options |= noad_option_void;
+ }
+ break;
+ case 'p': case 'P':
+ if (tex_scan_mandate_keyword("phantom", 1)) {
+ options |= noad_option_phantom;
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("class", 1)) {
+ mainclass = tex_scan_math_class_number(0);
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("rightclass", 1)) {
+ halfword c = tex_scan_math_class_number(0);
+ // if (valid_math_class_code(c)) {
+ if (valid_math_class_code(c)) {
+ rightclass = c;
+ }
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("source", 1)) {
+ source = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ goto CHECK_PAIRING;
+ }
+ }
+ CHECK_PAIRING:
+ switch (st) {
+ case no_fence_side:
+ case left_fence_side:
+ break;
+ case left_operator_side:
+ {
+ /* becomes a class option */
+ int indisplay = style == display_style || style == cramped_display_style;
+ /* options |= noad_option_no_check; */ /*tex Best just expect a dummy right. */
+ if (! (has_option(options, noad_option_limits) || has_option(options, noad_option_no_limits))) {
+ /* otherwise we don't enter the placement function */
+ options |= indisplay ? noad_option_limits : noad_option_no_limits;
+ }
+ }
+ break;
+ default:
+ if (cur_group != math_fence_group) {
+ tex_aux_append_math_fence_val((mathcodeval) { 0, 0, 0 }, (mathdictval) { 0, 0, 0 }, open_noad_subtype);
+ }
+ switch (cur_group) {
+ case math_fence_group:
+ break;
+ case math_shift_group:
+ tex_aux_scan_delimiter(null, no_mathcode, unset_noad_class);
+ if (st == middle_fence_side) {
+ tex_handle_error(
+ normal_error_type,
+ "Extra \\middle",
+ "I'm ignoring a \\middle that had no matching \\left."
+ );
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Extra \\right",
+ "I'm ignoring a \\right that had no matching \\left."
+ );
+ }
+ break;
+ default:
+ tex_off_save();
+ }
+ }
+ /*tex
+ Now we only have a no, left, middle or right case left.
+ */
+ {
+ halfword fence = tex_new_node(fence_noad, st);
+ halfword delimiter = tex_new_node(delimiter_node, 0);
+ halfword autoclass = unset_noad_class;
+ fence_delimiter_list(fence) = delimiter;
+ noad_height(fence) = ht;
+ noad_depth(fence) = dp;
+ noad_options(fence) = options;
+ set_noad_classes(fence, mainclass);
+ if (leftclass != unset_noad_class) {
+ set_noad_left_class(fence, leftclass);
+ }
+ if (rightclass != unset_noad_class) {
+ set_noad_right_class(fence, rightclass);
+ }
+ noad_italic(fence) = 0;
+ noad_source(fence) = source;
+ /*tex
+ By setting this here, we can get rid of the hard coded values in |mlist_to_hlist| which
+ sort of interfere (or at least confuse) things there. When set, the |leftclass| and
+ |rightclass| settings win anyway.
+ */
+ if (mainclass == unset_noad_class) {
+ mainclass = node_subtype(delimiter);
+ if (mainclass == unset_noad_class || mainclass == ordinary_noad_subtype) {
+ switch (st) {
+ case left_fence_side:
+ mainclass = open_noad_subtype;
+ break;
+ case middle_fence_side:
+ mainclass = middle_noad_subtype;
+ break;
+ case right_fence_side:
+ mainclass = close_noad_subtype;
+ break;
+ }
+ }
+ set_noad_main_class(fence, mainclass);
+ }
+ /* */
+ switch (st) {
+ case left_fence_side:
+ autoclass = open_noad_subtype;
+ break;
+ case middle_fence_side:
+ autoclass = middle_noad_subtype; /* we need a way to overload this */
+ break;
+ case right_fence_side:
+ autoclass = close_noad_subtype;
+ break;
+ }
+ /* */
+ tex_aux_scan_delimiter(delimiter, no_mathcode, autoclass);
+ /* */
+ if (attrlist) {
+ tex_attach_attribute_list_attribute(fence, attrlist);
+ tex_attach_attribute_list_attribute(delimiter, attrlist);
+ }
+ switch (st) {
+ case left_fence_side:
+ tex_aux_append_math_fence(fence, open_noad_subtype);
+ break;
+ case middle_fence_side:
+ tex_aux_append_math_fence(fence, middle_noad_subtype);
+ break;
+ case right_fence_side:
+ tex_aux_append_math_fence(fence, close_noad_subtype);
+ break;
+ case left_operator_side:
+ {
+ halfword top = tex_new_node(sub_mlist_node, 0);
+ halfword bottom = tex_new_node(sub_mlist_node, 0);
+ fence_delimiter_top(fence) = top;
+ fence_delimiter_bottom(fence) = bottom;
+ tex_aux_push_math(math_fence_group, style);
+ node_next(cur_list.head) = fence;
+ cur_list.tail = fence;
+ cur_list.delim = fence;
+ tex_set_saved_record(saved_operator_item_variant, saved_operator_variant, 0, math_limits_top);
+ lmt_save_state.save_stack_data.ptr += saved_operator_n_of_items;
+ tex_aux_push_math(math_operator_group, tex_math_style_variant(style, math_parameter_superscript_variant));
+ tex_scan_left_brace();
+ }
+ break;
+ case no_fence_side:
+ {
+ /* halfword n = tex_new_node(simple_noad, math_fences_mode_par ? fenced_noad_subtype : inner_noad_subtype); */
+ halfword n = tex_new_node(simple_noad, fenced_noad_subtype);
+ halfword l = tex_new_node(sub_mlist_node, 0);
+ tex_tail_append(n);
+ set_noad_main_class(n, mainclass); /*tex Really needed here! */
+ noad_nucleus(n) = l;
+ kernel_math_list(noad_nucleus(n)) = fence;
+ }
+ break;
+ default:
+ tex_confusion("left right fence");
+ break;
+ }
+ }
+}
+
+/*tex
+
+ \TEX\ gets to the following part of the program when the first |$| ending a display has been
+ scanned.
+
+*/
+
+static void tex_aux_check_second_math_shift(void)
+{
+ tex_get_x_token();
+ if (cur_cmd != math_shift_cmd) {
+ tex_back_input(cur_tok);
+ tex_handle_error(
+ normal_error_type,
+ "Display math should end with $$",
+ "The '$' that I just saw supposedly matches a previous '$$'. So I shall assume\n"
+ "that you typed '$$' both times."
+ );
+ }
+}
+
+static void tex_aux_check_display_math_end(void)
+{
+ switch (cur_chr) {
+ case end_display_math_code:
+ case end_math_mode_code:
+ return;
+ }
+ tex_handle_error(
+ normal_error_type,
+ "Display math should end with \\Ustopdisplaymath or \\Ustopmathmode",
+ "I shall assume that you typed that."
+ );
+}
+
+static void tex_aux_check_inline_math_end(void)
+{
+ switch (cur_chr) {
+ case end_inline_math_code:
+ case end_math_mode_code:
+ return;
+ }
+ tex_handle_error(
+ normal_error_type,
+ "Inline math should end with \\Ustopmath or \\Ustopmathmode",
+ "I shall assume that you typed that."
+ );
+}
+
+static void tex_aux_resume_after_display(void)
+{
+ if (cur_group == math_shift_group) {
+ tex_aux_unsave_math();
+ cur_list.prev_graf += 3;
+ tex_push_nest();
+ cur_list.mode = hmode;
+ cur_list.space_factor = 1000;
+ /*tex This needs to be intercepted in the display math start! Todo! */
+ tex_tail_append(tex_new_par_node(penalty_par_subtype));
+ tex_get_x_token();
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(cur_tok);
+ }
+ if (lmt_nest_state.nest_data.ptr == 1) {
+ lmt_page_filter_callback(after_display_page_context, 0);
+ tex_build_page();
+ }
+ } else {
+ tex_confusion("finishing display math");
+ }
+}
+
+/*tex
+
+ The fuziest 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).
+
+ \starttabulate
+ \NC \type {p} \NC points to the mlist for the formula \NC \NR
+ \NC \type {a} \NC is either |null| or it points to a box containing the equation number \NC \NR
+ \NC \type {l} \NC is true if there was an |\leqno| (so |a| is a horizontal box) \NC \NR
+ \stoptabulate
+
+ Per 2022 we ditched display mode in \CONTEXT\ LMTX\ so the code related to display math is now
+ completely frozen, if only because testing has become unreasonable. There is anyway not much more
+ to do here.
+
+*/
+
+inline static void tex_aux_inject_display_skip_before(quarterword param, quarterword subtype)
+{
+ if (param > 0) {
+ switch (display_skip_mode_par) {
+ case display_skip_default :
+ case display_skip_always :
+ tex_tail_append(tex_new_param_glue_node(param, subtype));
+ break;
+ case display_skip_non_zero:
+ if (! tex_glue_is_zero(glue_parameter(param))) {
+ tex_tail_append(tex_new_param_glue_node(param, subtype));
+ }
+ break;
+ case display_skip_ignore:
+ break;
+ default:
+ /*tex > 3 reserved for future use */
+ tex_tail_append(tex_new_param_glue_node(param, subtype));
+ break;
+ }
+ }
+}
+
+inline static void tex_aux_inject_display_skip_after(quarterword param, quarterword subtype)
+{
+ if (param > 0) {
+ switch (display_skip_mode_par) {
+ case display_skip_default :
+ case display_skip_always :
+ tex_tail_append(tex_new_param_glue_node(param, subtype));
+ break;
+ case display_skip_non_zero:
+ if (! tex_glue_is_zero(glue_parameter(param))) {
+ tex_tail_append(tex_new_param_glue_node(param, subtype));
+ }
+ break;
+ case display_skip_ignore:
+ break;
+ default:
+ /*tex > 3 reserved for future use */
+ tex_tail_append(tex_new_param_glue_node(param, subtype));
+ break;
+ }
+ }
+}
+
+static void tex_aux_finish_displayed_math(int atleft, halfword eqnumber, halfword equation)
+{
+ /*tex box containing the equation */
+ halfword equation_box;
+ /*tex width of the equation */
+ scaled equation_width;
+ /*tex width of the line */
+ scaled line_width;
+ /*tex width of equation number */
+ scaled number_width;
+ /*tex width of equation number plus space to separate from equation */
+ scaled number_plus_gap_width;
+ /*tex move the line right this much */
+ scaled indent;
+ /*tex displacement of equation in the line */
+ scaled displacement;
+ /*tex glue parameter codes for before and after */
+ quarterword glue_above, glue_below;
+ /*tex glue parameter subtypes for before and after */
+ quarterword subtype_above, subtype_below;
+ /*tex tail of adjustment lists */
+ halfword post_adjust_tail, pre_adjust_tail;
+ /*tex tail of migration lists */
+ halfword post_migrate_tail, pre_migrate_tail;
+ /*tex for equation numbers */
+ scaled eqno_width;
+ /*tex true if the math and surrounding (par) dirs are different */
+ int swap_dir = math_direction_par != pre_display_direction_par;
+ if (eqnumber && swap_dir) {
+ atleft = ! atleft;
+ }
+ /* */
+ lmt_packaging_state.post_adjust_tail = post_adjust_head;
+ lmt_packaging_state.pre_adjust_tail = pre_adjust_head;
+ lmt_packaging_state.post_migrate_tail = post_migrate_head;
+ lmt_packaging_state.pre_migrate_tail = pre_migrate_head;
+ /* */
+ equation_box = tex_hpack(equation, 0, packing_additional, direction_unknown, holding_none_option);
+ node_subtype(equation_box) = equation_list;
+ attach_current_attribute_list(equation_box);
+ equation = box_list(equation_box);
+ /* */
+ post_adjust_tail = lmt_packaging_state.post_adjust_tail;
+ pre_adjust_tail = lmt_packaging_state.pre_adjust_tail;
+ post_migrate_tail = lmt_packaging_state.post_migrate_tail;
+ pre_migrate_tail = lmt_packaging_state.pre_migrate_tail;
+ lmt_packaging_state.post_adjust_tail = null;
+ lmt_packaging_state.pre_adjust_tail = null;
+ lmt_packaging_state.post_migrate_tail = null;
+ lmt_packaging_state.pre_migrate_tail = null;
+ /* */
+ equation_width = box_width(equation_box);
+ line_width = display_width_par;
+ indent = display_indent_par;
+ if (eqnumber) {
+ number_width = box_width(eqnumber);
+ eqno_width = number_width;
+ number_plus_gap_width = number_width + tex_round_xn_over_d(math_eqno_gap_step_par, tex_get_math_quad_style(text_style), 1000);
+ node_subtype(eqnumber) = equation_number_list;
+ /*tex attach_current_attribute_list(eqno_box); */
+ } else {
+ number_width = 0;
+ eqno_width = 0;
+ number_plus_gap_width = 0;
+ }
+ if (equation_width + number_plus_gap_width > line_width) {
+ /*tex
+
+ The user can force the equation number to go on a separate line by causing its width to
+ be zero.
+
+ */
+ if ((number_width != 0) && ((equation_width - lmt_packaging_state.total_shrink[normal_glue_order] + number_plus_gap_width <= line_width)
+ || (lmt_packaging_state.total_shrink[fi_glue_order] != 0)
+ || (lmt_packaging_state.total_shrink[fil_glue_order] != 0)
+ || (lmt_packaging_state.total_shrink[fill_glue_order] != 0)
+ || (lmt_packaging_state.total_shrink[filll_glue_order] != 0))) {
+ box_list(equation_box) = null;
+ tex_flush_node(equation_box);
+ equation_box = tex_hpack(equation, line_width - number_plus_gap_width, packing_exactly, direction_unknown, holding_none_option);
+ node_subtype(equation_box) = equation_list;
+ attach_current_attribute_list(equation_box);
+ } else {
+ number_width = 0;
+ if (equation_width > line_width) {
+ box_list(equation_box) = null;
+ tex_flush_node(equation_box);
+ equation_box = tex_hpack(equation, line_width, packing_exactly, direction_unknown, holding_none_option);
+ node_subtype(equation_box) = equation_list;
+ attach_current_attribute_list(equation_box);
+ }
+ }
+ equation_width = box_width(equation_box);
+ }
+ /*tex
+
+ We try first to center the display without regard to the existence of the equation number.
+ If that would make it too close (where \quote {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.
+
+ */
+ displacement = tex_half_scaled(line_width - equation_width);
+ if ((number_width > 0) && (displacement < 2 * number_width)) {
+ /*tex too close */
+ displacement = tex_half_scaled(line_width - equation_width - number_width);
+ /*
+ if (p && !is_char_node(p) && node_type(p) == glue_node)
+ d = 0;
+ */ /* kind of weird this, so why not just */
+ if (equation && node_type(equation) == glue_node) {
+ displacement = 0;
+ }
+ }
+ tex_tail_append(tex_new_penalty_node(pre_display_penalty_par, before_display_penalty_subtype));
+ if ((displacement + indent <= pre_display_size_par) || ((cur_list.math_dir == dir_lefttoright) && atleft)
+ || ((cur_list.math_dir == dir_righttoleft) && ! atleft)) {
+ /*tex not enough clearance */
+ glue_above = above_display_skip_code;
+ subtype_above = above_display_skip_glue;
+ glue_below = below_display_skip_code;
+ subtype_below = below_display_skip_glue;
+ } else {
+ glue_above = above_display_short_skip_code;
+ subtype_above = above_display_short_skip_glue;
+ glue_below = below_display_short_skip_code;
+ subtype_below = below_display_short_skip_glue;
+ }
+ /*tex
+
+ 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 (eqnumber && atleft && (number_width == 0)) {
+ /* if (math_direction_par == dir_lefttoright) { */
+ box_shift_amount(eqnumber) = 0;
+ /* } else { */
+ /* } */
+ tex_append_to_vlist(eqnumber, lua_key_index(equation_number), NULL);
+ tex_tail_append(tex_new_penalty_node(infinite_penalty, equation_number_penalty_subtype));
+ } else {
+ tex_aux_inject_display_skip_before(glue_above, subtype_above);
+ }
+ if (number_width != 0) {
+ scaled shift = line_width - equation_width - number_width - displacement;
+ halfword move = tex_new_kern_node(shift, explicit_kern_subtype);
+ if (atleft) {
+ if (swap_dir) {
+ if (math_direction_par == dir_lefttoright) {
+ /*tex TRT + TLT + \eqno: (swap_dir=true, math_direction_par=TLT, l=true) */
+ halfword kern = tex_new_kern_node(shift + number_width, explicit_kern_subtype);
+ tex_try_couple_nodes(eqnumber, move);
+ tex_try_couple_nodes(move, equation_box);
+ tex_try_couple_nodes(equation_box, kern);
+ } else {
+ /*tex TLT + TRT + \eqno: (swap_dir=true, math_direction_par=TRT, l=true) */
+ tex_try_couple_nodes(eqnumber, move);
+ tex_try_couple_nodes(move, equation_box);
+ }
+ } else {
+ halfword kern;
+ if (math_direction_par == dir_lefttoright) {
+ /*tex TLT + TLT + \leqno: (swap_dir=false, math_direction_par=TLT, l=true) */
+ kern = tex_new_kern_node(shift + number_width, explicit_kern_subtype);
+ } else {
+ /*tex TRT + TRT + \leqno: (swap_dir=false, math_direction_par=TRT, l=true) */
+ kern = tex_new_kern_node(shift, explicit_kern_subtype);
+ }
+ tex_try_couple_nodes(eqnumber, move);
+ tex_try_couple_nodes(move, equation_box);
+ tex_try_couple_nodes(equation_box, kern);
+ }
+ equation_box = eqnumber;
+ } else {
+ if (swap_dir) {
+ if (math_direction_par == dir_lefttoright) {
+ /*tex TRT + TLT + \leqno: (swap_dir=true, math_direction_par=TLT, l=false) */
+ } else {
+ /*tex TLT + TRT + \leqno: (swap_dir=true, math_direction_par=TRT, l=false) */
+ }
+ tex_try_couple_nodes(equation_box, move);
+ tex_try_couple_nodes(move, eqnumber);
+ } else {
+ halfword kern;
+ if (math_direction_par == dir_lefttoright) {
+ /*tex TLT + TLT + \eqno: (swap_dir=false, math_direction_par=TLT, l=false) */
+ kern = tex_new_kern_node(displacement, explicit_kern_subtype);
+ } else {
+ /*tex TRT + TRT + \eqno: (swap_dir=false, math_direction_par=TRT, l=false) */
+ kern = tex_new_kern_node(shift + number_width, explicit_kern_subtype);
+ }
+ tex_try_couple_nodes(kern, equation_box);
+ tex_try_couple_nodes(equation_box, move);
+ tex_try_couple_nodes(move, eqnumber);
+ equation_box = kern;
+ }
+ }
+ equation_box = tex_hpack(equation_box, 0, packing_additional, direction_unknown, holding_none_option);
+ node_subtype(equation_box) = equation_list; /* new */
+ attach_current_attribute_list(equation_box);
+ box_shift_amount(equation_box) = indent;
+ } else {
+ box_shift_amount(equation_box) = indent + displacement;
+ }
+ /*tex check for prev: */
+ tex_append_to_vlist(equation_box, lua_key_index(equation), NULL);
+ if (eqnumber && number_width == 0 && ! atleft) {
+ tex_tail_append(tex_new_penalty_node(infinite_penalty, equation_number_penalty_subtype));
+ /* if (math_direction_par == dir_lefttoright) { */
+ box_shift_amount(eqnumber) = indent + line_width - eqno_width ;
+ /* } else { */
+ /* } */
+ tex_append_to_vlist(eqnumber, lua_key_index(equation_number), NULL);
+ glue_below = 0; /* shouldn't this be an option */
+ }
+ /*tex Migrating material comes after equation number: is this ok? */
+ if (post_migrate_tail != post_migrate_head) {
+ node_next(cur_list.tail) = node_next(post_migrate_head);
+ node_prev(lmt_packaging_state.post_migrate_tail) = node_prev(cur_list.tail);
+ cur_list.tail = post_migrate_tail;
+ }
+ if (post_adjust_tail != post_adjust_head) {
+ node_next(cur_list.tail) = node_next(post_adjust_head);
+ node_prev(lmt_packaging_state.post_adjust_tail) = node_prev(cur_list.tail);
+ cur_list.tail = post_adjust_tail;
+ }
+ /*tex A weird place: is this ok? */
+ if (pre_adjust_tail != pre_adjust_head) {
+ node_next(cur_list.tail) = node_next(pre_adjust_head);
+ node_prev(lmt_packaging_state.pre_adjust_tail) = node_prev(cur_list.tail);
+ cur_list.tail = pre_adjust_tail;
+ }
+ if (pre_migrate_tail != pre_migrate_head) {
+ node_next(cur_list.tail) = node_next(pre_migrate_head);
+ node_prev(lmt_packaging_state.pre_migrate_tail) = node_prev(cur_list.tail);
+ cur_list.tail = pre_migrate_tail;
+ }
+ tex_tail_append(tex_new_penalty_node(post_display_penalty_par, after_display_penalty_subtype));
+ tex_aux_inject_display_skip_after(glue_below, subtype_below);
+ tex_aux_resume_after_display();
+}
+
+/*tex
+*
+ 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|.
+
+ As an outcome of the math upgrading sub project that Mikael Sundqvist and I undertook end 2021
+ and beginning 2022 Mikael suggested penalties surrounding inline formulas so there you have it:
+ |\preinlinepanelty| and |\postinlinepanelty|.
+
+*/
+
+void tex_run_math_shift(void) {
+ if (cur_group == math_shift_group) {
+ /*tex box containing equation number */
+ halfword eqnumber = null;
+ /*tex Use |\leqno| instead of |\eqno|, we default to right. */
+ int atleft = 0;
+ /*tex |mmode| or |-mmode| */
+ int mode = cur_list.mode;
+ int mathmode = cur_list.math_mode;
+ /*tex this pops the nest, the formula */
+ halfword p = tex_aux_finish_math_list(null);
+ int mathleft = cur_list.math_begin;
+ int mathright = cur_list.math_end;
+ if (cur_cmd == math_shift_cs_cmd) {
+ switch (cur_chr) {
+ case begin_inline_math_code:
+ case begin_display_math_code:
+ case begin_math_mode_code:
+ tex_you_cant_error(NULL);
+ break;
+ }
+ }
+ if (cur_list.mode == -mode) {
+ /*tex end of equation number */
+ AGAIN:
+ switch (cur_cmd) {
+ case math_shift_cmd:
+ tex_aux_check_second_math_shift();
+ break;
+ case end_paragraph_cmd:
+ tex_get_x_token();
+ goto AGAIN;
+ default:
+ tex_aux_check_display_math_end();
+ break;
+ }
+ tex_run_mlist_to_hlist(p, 0, text_style, unset_noad_class, unset_noad_class);
+ eqnumber = tex_hpack(node_next(temp_head), 0, packing_additional, direction_unknown, holding_none_option);
+ attach_current_attribute_list(eqnumber);
+ tex_aux_unsave_math();
+ /*tex now |cur_group = math_shift_group| */
+ lmt_save_state.save_stack_data.ptr -= saved_equation_number_n_of_items;
+ if (saved_type(saved_equation_number_item_location) == saved_equation_number_location) {
+ atleft = saved_value(saved_equation_number_item_location) == left_location_code;
+ mode = cur_list.mode;
+ p = tex_aux_finish_math_list(null);
+ } else {
+ tex_confusion("after math");
+ }
+ }
+ if (mode < 0) {
+ /*tex
+
+ 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.
+
+ */
+ halfword math = tex_new_node(math_node, begin_inline_math);
+ if (mathmode) {
+ switch (cur_cmd) {
+ case math_shift_cs_cmd:
+ if (cur_chr != end_display_math_code && cur_chr != end_math_mode_code) {
+ tex_aux_check_second_math_shift();
+ }
+ break;
+ case math_shift_cmd:
+ tex_aux_check_second_math_shift();
+ break;
+ }
+ } else if (cur_cmd == math_shift_cs_cmd) {
+ tex_aux_check_inline_math_end();
+ }
+ tex_tail_append(math);
+ math_penalty(math) = pre_inline_penalty_par;
+ /*tex begin mathskip code */
+ switch (math_skip_mode_par) {
+ case math_skip_surround_when_zero:
+ if (! tex_glue_is_zero(math_skip_par)) {
+ tex_copy_glue_values(math, math_skip_par);
+ } else {
+ math_surround(math) = math_surround_par;
+ }
+ break ;
+ case math_skip_always_left:
+ case math_skip_always_both:
+ case math_skip_only_when_skip:
+ tex_copy_glue_values(math, math_skip_par);
+ break ;
+ case math_skip_always_right:
+ case math_skip_ignore:
+ break ;
+ case math_skip_always_surround:
+ default:
+ math_surround(math) = math_surround_par;
+ break;
+ }
+ /*tex end mathskip code */
+ if (cur_list.math_dir) {
+ tex_tail_append(tex_new_dir(normal_dir_subtype, math_direction_par));
+ }
+ tex_run_mlist_to_hlist(p, cur_list.mode > nomode, is_valid_math_style(cur_list.math_main_style) ? cur_list.math_main_style : text_style, cur_list.math_begin, cur_list.math_end);
+ tex_try_couple_nodes(cur_list.tail, node_next(temp_head));
+ cur_list.tail = tex_tail_of_node_list(cur_list.tail);
+ if (cur_list.math_dir) {
+ tex_tail_append(tex_new_dir(cancel_dir_subtype, math_direction_par));
+ }
+ cur_list.math_dir = 0;
+ math = tex_new_node(math_node, end_inline_math);
+ tex_tail_append(math);
+ math_penalty(math) = post_inline_penalty_par;
+ /*tex begin mathskip code */
+ switch (math_skip_mode_par) {
+ case math_skip_surround_when_zero :
+ if (! tex_glue_is_zero(math_skip_par)) {
+ tex_copy_glue_values(math, math_skip_par);
+ math_surround(math) = 0;
+ } else {
+ math_surround(math) = math_surround_par;
+ }
+ break;
+ case math_skip_always_right:
+ case math_skip_always_both:
+ case math_skip_only_when_skip:
+ tex_copy_glue_values(math, math_skip_par);
+ break;
+ case math_skip_always_left:
+ case math_skip_ignore:
+ break;
+ case math_skip_always_surround:
+ default:
+ math_surround(math) = math_surround_par;
+ break;
+ }
+ /*tex end mathskip code */
+ cur_list.space_factor = 1000;
+ mathleft = cur_list.math_begin;
+ mathright = cur_list.math_end;
+ tex_aux_unsave_math();
+ } else {
+ if (! eqnumber) {
+ if (cur_cmd == math_shift_cmd) {
+ tex_aux_check_second_math_shift();
+ } else {
+ tex_aux_check_display_math_end();
+ }
+ }
+ tex_run_mlist_to_hlist(p, 0, display_style, cur_list.math_begin, cur_list.math_end);
+ mathleft = cur_list.math_begin;
+ mathright = cur_list.math_end;
+ tex_aux_finish_displayed_math(atleft, eqnumber, node_next(temp_head));
+ }
+ /* local */
+ update_tex_math_left_class(mathleft);
+ update_tex_math_right_class(mathright);
+ /* global */
+ lmt_math_state.last_left = mathleft;
+ lmt_math_state.last_right = mathright;
+ } else {
+ tex_off_save();
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_finish_display_alignment(halfword head, halfword tail, halfword prevdepth)
+{
+ tex_handle_assignments();
+ AGAIN:
+ switch (cur_cmd) {
+ case math_shift_cmd:
+ tex_aux_check_second_math_shift();
+ break;
+ case end_paragraph_cmd:
+ tex_get_x_token();
+ goto AGAIN;
+ default:
+ tex_aux_check_display_math_end();
+ break;
+ }
+ tex_pop_nest();
+ tex_tail_append(tex_new_penalty_node(pre_display_penalty_par, before_display_penalty_subtype));
+ tex_aux_inject_display_skip_before(above_display_skip_code, above_display_skip_glue);
+ node_next(cur_list.tail) = head;
+ if (head && tail) {
+ cur_list.tail = tail;
+ }
+ tex_tail_append(tex_new_penalty_node(post_display_penalty_par, after_display_penalty_subtype));
+ tex_aux_inject_display_skip_after(below_display_skip_code, below_display_skip_glue);
+ cur_list.prev_depth = prevdepth;
+ tex_aux_resume_after_display();
+}
+
+/*
+
+ Turning macros into functions brought the mingw64 bin down from 2548224 to 2511360 bytes but
+ not the linux one, so I guess mingw doesn't inline (yet, in 2020).
+
+*/
+
+static void tex_aux_define_inl_math_parameters(int size, int param, scaled value, int level)
+{
+ switch (size) {
+ case script_size:
+ tex_def_math_parameter(script_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_style, param, value, level, indirect_math_regular);
+ break;
+ case script_script_size:
+ tex_def_math_parameter(script_script_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_script_style, param, value, level, indirect_math_regular);
+ break;
+ default:
+ tex_def_math_parameter(text_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_text_style, param, value, level, indirect_math_regular);
+ break;
+ }
+}
+
+static void tex_aux_define_dis_math_parameters(int size, int param, scaled value, int level)
+{
+ if (size == text_size) {
+ tex_def_math_parameter(display_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_display_style, param, value, level, indirect_math_regular);
+ }
+}
+
+static void tex_aux_define_all_math_parameters(int size, int param, scaled value, int level)
+{
+ switch (size) {
+ case script_size:
+ tex_def_math_parameter(script_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_style, param, value, level, indirect_math_regular);
+ break;
+ case script_script_size:
+ tex_def_math_parameter(script_script_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_script_style, param, value, level, indirect_math_regular);
+ break;
+ default:
+ tex_def_math_parameter(text_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_text_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(display_style, param, value, level, indirect_math_regular);
+ tex_def_math_parameter(cramped_display_style, param, value, level, indirect_math_regular);
+ break;
+ }
+}
+
+/*tex
+
+ Here are the math parameters that are font-dependant. Before an mlist is converted to an hlist,
+ \TEX\ makes sure that the fonts in family~2 have enough parameters to be math symbol fonts, and
+ that the fonts in family~3 have enough parameters to be math extension fonts. The math-symbol
+ parameters are referred to by using the following macros, which take a size code as their
+ parameter; for example, |num1 (cur_size)| gives the value of the |num1| parameter for the
+ current size.
+
+ The math extension parameters have similar macros, but the size code is omitted (since it is
+ always |cur_size| when we refer to such parameters).
+
+*/
+
+# define total_mathsy_parameters 22
+# define total_mathex_parameters 13
+
+# define mathsy(A,B) font_parameter(tex_fam_fnt(2,A),B)
+# define mathex(A,B) font_parameter(tex_fam_fnt(3,A),B)
+
+# define math_x_height(A) mathsy(A,5) /*tex height of |x| */
+# define math_quad(A) mathsy(A,6) /*tex |18mu| */
+# define num1(A) mathsy(A,8) /*tex numerator shift-up in display styles */
+# define num2(A) mathsy(A,9) /*tex numerator shift-up in non-display, non-|\atop| */
+# define num3(A) mathsy(A,10) /*tex numerator shift-up in non-display |\atop| */
+# define denom1(A) mathsy(A,11) /*tex denominator shift-down in display styles */
+# define denom2(A) mathsy(A,12) /*tex denominator shift-down in non-display styles */
+# define sup1(A) mathsy(A,13) /*tex superscript shift-up in uncramped display style */
+# define sup2(A) mathsy(A,14) /*tex superscript shift-up in uncramped non-display */
+# define sup3(A) mathsy(A,15) /*tex superscript shift-up in cramped styles */
+# define sub1(A) mathsy(A,16) /*tex subscript shift-down if superscript is absent */
+# define sub2(A) mathsy(A,17) /*tex subscript shift-down if superscript is present */
+# define sup_drop(A) mathsy(A,18) /*tex superscript baseline below top of large box */
+# define sub_drop(A) mathsy(A,19) /*tex subscript baseline below bottom of large box */
+# define delim1(A) mathsy(A,20) /*tex size of |\atopwithdelims| delimiters in display styles */
+# define delim2(A) mathsy(A,21) /*tex size of |\atopwithdelims| delimiters in non-displays */
+# define axis_height(A) mathsy(A,22) /*tex height of fraction lines above the baseline */
+
+# define default_rule_thickness(A) mathex(A,8) /*tex thickness of |\over| bars */
+# define big_operator_spacing1(A) mathex(A,9) /*tex minimum clearance above a displayed op */
+# define big_operator_spacing2(A) mathex(A,10) /*tex minimum clearance below a displayed op */
+# define big_operator_spacing3(A) mathex(A,11) /*tex minimum baselineskip above displayed op */
+# define big_operator_spacing4(A) mathex(A,12) /*tex minimum baselineskip below displayed op */
+# define big_operator_spacing5(A) mathex(A,13) /*tex padding above and below displayed limits */
+
+/*tex
+ Somehow a scale > 1000 results in extreme values.
+*/
+
+/*
+inline static int tex_aux_get_font_math_parameter(scaled scale, halfword f, int id)
+{
+ scaled v = get_font_math_par(f, id);
+// return scale == 1000 ? v : round_xn_over_d(v, scale, 1000);
+ if (v) {
+ double d = 0.001 * scale * v;
+ return (d < 0.0) ? (int) (d - 0.5) : (int) (d + 0.5);
+ } else {
+ return 0;
+ }
+}
+
+inline static int tex_aux_get_font_math_quantity(scaled scale, halfword v)
+{
+// return scale == 1000 ? v : round_xn_over_d(v, scale, 1000);
+ if (v) {
+ double d = 0.001 * scale * v;
+ return (d < 0.0) ? (int) (d - 0.5) : (int) (d + 0.5);
+ } else {
+ return 0;
+ }
+}
+*/
+
+# define math_parameter(a,b) ((font_math_parameter_count(a) >= b) ? font_math_parameter(a,b) : undefined_math_parameter)
+
+inline static scaled tex_aux_get_font_math_parameter(scaled scale, halfword f, int id)
+{
+ scaled v = math_parameter(f, id);
+ if (v == undefined_math_parameter) {
+ return v;
+ } else {
+ return v ? scaledround(0.001 * scale * v) : 0;
+ }
+}
+
+inline static scaled tex_aux_get_font_math_quantity(scaled scale, halfword v)
+{
+ return v ? scaledround(0.001 * scale * v) : 0;
+}
+
+/*tex
+ The next function is called when we define a family, but first we define a few helpers
+ for identifying traditional math fonts. Watch the hard codes family check!
+*/
+
+void tex_fixup_math_parameters(int fam, int size, int f, int level)
+{
+ scaled scale = tex_get_math_font_scale(f, size);
+
+ if (tracing_math_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: fixing up font, family %i, size %i, font %i, level %i]", fam, size, f, level);
+ tex_end_diagnostic();
+ }
+
+ /*tex These apply to all: */
+
+ tex_aux_define_all_math_parameters(size, math_parameter_quad, tex_aux_get_font_math_quantity (scale, font_size(f)), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_axis, tex_aux_get_font_math_parameter(scale, f, AxisHeight), level);
+
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_base_height, tex_aux_get_font_math_parameter(scale, f, AccentBaseHeight), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_base_depth, tex_aux_get_font_math_parameter(scale, f, AccentBaseDepth), level); /* engine, reserved */
+ tex_aux_define_all_math_parameters(size, math_parameter_flattened_accent_base_height, tex_aux_get_font_math_parameter(scale, f, FlattenedAccentBaseHeight), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_flattened_accent_base_depth, tex_aux_get_font_math_parameter(scale, f, FlattenedAccentBaseDepth), level); /* engine, reserved */
+ tex_aux_define_all_math_parameters(size, math_parameter_overbar_kern, tex_aux_get_font_math_parameter(scale, f, OverbarExtraAscender), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_overbar_rule, tex_aux_get_font_math_parameter(scale, f, OverbarRuleThickness), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_overbar_vgap, tex_aux_get_font_math_parameter(scale, f, OverbarVerticalGap), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_underbar_kern, tex_aux_get_font_math_parameter(scale, f, UnderbarExtraDescender), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_underbar_rule, tex_aux_get_font_math_parameter(scale, f, UnderbarRuleThickness ), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_underbar_vgap, tex_aux_get_font_math_parameter(scale, f, UnderbarVerticalGap), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_under_delimiter_vgap, tex_aux_get_font_math_parameter(scale, f, StretchStackGapAboveMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_under_delimiter_bgap, tex_aux_get_font_math_parameter(scale, f, StretchStackBottomShiftDown), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_over_delimiter_vgap, tex_aux_get_font_math_parameter(scale, f, StretchStackGapBelowMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_over_delimiter_bgap, tex_aux_get_font_math_parameter(scale, f, StretchStackTopShiftUp), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_kern, tex_aux_get_font_math_parameter(scale, f, RadicalExtraAscender), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_rule, tex_aux_get_font_math_parameter(scale, f, RadicalRuleThickness), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_degree_before, tex_aux_get_font_math_parameter(scale, f, RadicalKernBeforeDegree), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_degree_after, tex_aux_get_font_math_parameter(scale, f, RadicalKernAfterDegree), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_shift_drop, tex_aux_get_font_math_parameter(scale, f, SubscriptBaselineDropMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_superscript_shift_drop, tex_aux_get_font_math_parameter(scale, f, SuperscriptBaselineDropMax), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_shift_down, tex_aux_get_font_math_parameter(scale, f, SubscriptShiftDown), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_prime_shift_drop, tex_aux_get_font_math_parameter(scale, f, PrimeBaselineDropMax), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_top_max, tex_aux_get_font_math_parameter(scale, f, SubscriptTopMax), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_superscript_bottom_min, tex_aux_get_font_math_parameter(scale, f, SuperscriptBottomMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_superscript_subscript_bottom_max, tex_aux_get_font_math_parameter(scale, f, SuperscriptBottomMaxWithSubscript), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_superscript_vgap, tex_aux_get_font_math_parameter(scale, f, SubSuperscriptGapMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_limit_above_vgap, tex_aux_get_font_math_parameter(scale, f, UpperLimitGapMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_limit_above_bgap, tex_aux_get_font_math_parameter(scale, f, UpperLimitBaselineRiseMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_limit_below_vgap, tex_aux_get_font_math_parameter(scale, f, LowerLimitGapMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_limit_below_bgap, tex_aux_get_font_math_parameter(scale, f, LowerLimitBaselineDropMin), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_nolimit_sub_factor, tex_aux_get_font_math_parameter(scale, f, NoLimitSubFactor), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_nolimit_sup_factor, tex_aux_get_font_math_parameter(scale, f, NoLimitSupFactor), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_skewed_fraction_hgap, tex_aux_get_font_math_parameter(scale, f, SkewedFractionHorizontalGap), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_skewed_fraction_vgap, tex_aux_get_font_math_parameter(scale, f, SkewedFractionVerticalGap), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_space_before_script, tex_aux_get_font_math_parameter(scale, f, SpaceBeforeScript), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_space_after_script, tex_aux_get_font_math_parameter(scale, f, SpaceAfterScript), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_connector_overlap_min, tex_aux_get_font_math_parameter(scale, f, MinConnectorOverlap), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_fraction_rule, tex_aux_get_font_math_parameter(scale, f, FractionRuleThickness), level);
+
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_degree_raise, math_parameter(f, RadicalDegreeBottomRaisePercent), level);
+ tex_aux_define_all_math_parameters(size, math_parameter_prime_raise, math_parameter(f, PrimeRaisePercent), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_prime_raise_composed, math_parameter(f, PrimeRaiseComposedPercent), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_prime_space_after, math_parameter(f, PrimeSpaceAfter), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_prime_width, math_parameter(f, PrimeWidthPercent), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_skewed_delimiter_tolerance, math_parameter(f, SkewedDelimiterTolerance), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_top_shift_up, math_parameter(f, AccentTopShiftUp), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_bottom_shift_down, math_parameter(f, AccentBottomShiftDown), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_top_overshoot, math_parameter(f, AccentTopOvershoot), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_bottom_overshoot, math_parameter(f, AccentBottomOvershoot), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_superscript_drop, math_parameter(f, AccentSuperscriptDrop), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_superscript_percent, math_parameter(f, AccentSuperscriptPercent), level); /* engine, default 0 */
+ tex_aux_define_all_math_parameters(size, math_parameter_accent_extend_margin, math_parameter(f, AccentExtendMargin), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_flattened_accent_top_shift_up, math_parameter(f, FlattenedAccentTopShiftUp), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_flattened_accent_bottom_shift_down, math_parameter(f, FlattenedAccentBottomShiftDown), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_delimiter_percent, math_parameter(f, DelimiterPercent), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_delimiter_shortfall, math_parameter(f, DelimiterShortfall), level); /* engine, undefined */
+
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_extensible_after, math_parameter(f, RadicalKernAfterExtensible), level); /* engine, undefined */
+ tex_aux_define_all_math_parameters(size, math_parameter_radical_extensible_before, math_parameter(f, RadicalKernBeforeExtensible), level); /* engine, undefined */
+
+ /*tex Not all are official \OPENTYPE: */
+
+ tex_aux_define_all_math_parameters(size, math_parameter_x_scale, 1000, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_y_scale, 1000, level);
+
+ /*tex Most are zero and have to be set at by the macro package (if at all):. */
+
+ tex_aux_define_all_math_parameters(size, math_parameter_limit_above_kern, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_limit_below_kern, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_superscript_shift, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_subscript_shift, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_superprescript_shift, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_subprescript_shift, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_rule_height, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_rule_depth, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_superscript_shift_distance, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_shift_distance, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_superprescript_shift_distance, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_subprescript_shift_distance, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_superscript_space, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_subscript_space, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_superprescript_space, 0, level);
+ tex_aux_define_all_math_parameters(size, math_parameter_extra_subprescript_space, 0, level);
+
+ /*tex A special one: */
+
+ if (math_parameter(f, SubscriptShiftDownWithSuperscript) != undefined_math_parameter) { /* engine */
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_superscript_shift_down, tex_aux_get_font_math_parameter(scale, f, SubscriptShiftDownWithSuperscript), level);
+ } else {
+ tex_aux_define_all_math_parameters(size, math_parameter_subscript_superscript_shift_down, tex_aux_get_font_math_parameter(scale, f, SubscriptShiftDown), level);
+ }
+
+ /*tex These differentiate between display and inline: */
+
+ tex_aux_define_dis_math_parameters(size, math_parameter_operator_size, tex_aux_get_font_math_parameter(scale, f, DisplayOperatorMinHeight), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_radical_vgap, tex_aux_get_font_math_parameter(scale, f, RadicalVerticalGap), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_radical_vgap, tex_aux_get_font_math_parameter(scale, f, RadicalDisplayStyleVerticalGap), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_stack_num_up, tex_aux_get_font_math_parameter(scale, f, StackTopShiftUp), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_stack_num_up, tex_aux_get_font_math_parameter(scale, f, StackTopDisplayStyleShiftUp), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_stack_denom_down, tex_aux_get_font_math_parameter(scale, f, StackBottomShiftDown), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_stack_denom_down, tex_aux_get_font_math_parameter(scale, f, StackBottomDisplayStyleShiftDown), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_stack_vgap, tex_aux_get_font_math_parameter(scale, f, StackGapMin), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_stack_vgap, tex_aux_get_font_math_parameter(scale, f, StackDisplayStyleGapMin), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_fraction_num_vgap, tex_aux_get_font_math_parameter(scale, f, FractionNumeratorGapMin), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_fraction_num_vgap, tex_aux_get_font_math_parameter(scale, f, FractionNumeratorDisplayStyleGapMin), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_fraction_num_up, tex_aux_get_font_math_parameter(scale, f, FractionNumeratorShiftUp), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_fraction_num_up, tex_aux_get_font_math_parameter(scale, f, FractionNumeratorDisplayStyleShiftUp), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_fraction_denom_vgap, tex_aux_get_font_math_parameter(scale, f, FractionDenominatorGapMin), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_fraction_denom_vgap, tex_aux_get_font_math_parameter(scale, f, FractionDenominatorDisplayStyleGapMin), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_fraction_denom_down, tex_aux_get_font_math_parameter(scale, f, FractionDenominatorShiftDown), level);
+ tex_aux_define_dis_math_parameters(size, math_parameter_fraction_denom_down, tex_aux_get_font_math_parameter(scale, f, FractionDenominatorDisplayStyleShiftDown), level);
+ tex_aux_define_inl_math_parameters(size, math_parameter_fraction_del_size, tex_aux_get_font_math_parameter(scale, f, FractionDelimiterSize), level); /* engine, undefined */
+ tex_aux_define_dis_math_parameters(size, math_parameter_fraction_del_size, tex_aux_get_font_math_parameter(scale, f, FractionDelimiterDisplayStyleSize), level); /* engine, undefined */
+
+ /*tex A few more specials: */
+
+ switch (size) {
+ case script_size:
+ tex_def_math_parameter(script_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUp), level, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUpCramped), level, indirect_math_regular);
+ tex_def_math_parameter(script_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUp), level, indirect_math_regular); /* engine, default 0 */
+ tex_def_math_parameter(cramped_script_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUpCramped), level, indirect_math_regular); /* engine, default 0 */
+ break;
+ case script_script_size:
+ tex_def_math_parameter(script_script_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUp), level, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_script_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUpCramped), level, indirect_math_regular);
+ tex_def_math_parameter(script_script_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUp), level, indirect_math_regular); /* engine, default 0 */
+ tex_def_math_parameter(cramped_script_script_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUpCramped), level, indirect_math_regular); /* engine, default 0 */
+ break;
+ default:
+ tex_def_math_parameter(display_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUp), level, indirect_math_regular);
+ tex_def_math_parameter(cramped_display_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUpCramped), level, indirect_math_regular);
+ tex_def_math_parameter(text_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUp), level, indirect_math_regular);
+ tex_def_math_parameter(cramped_text_style, math_parameter_superscript_shift_up, tex_aux_get_font_math_parameter(scale, f, SuperscriptShiftUpCramped), level, indirect_math_regular);
+ tex_def_math_parameter(display_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUp), level, indirect_math_regular); /* engine, default 0 */
+ tex_def_math_parameter(cramped_display_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUpCramped), level, indirect_math_regular); /* engine, default 0 */
+ tex_def_math_parameter(text_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUp), level, indirect_math_regular); /* engine, default 0 */
+ tex_def_math_parameter(cramped_text_style, math_parameter_prime_shift_up, tex_aux_get_font_math_parameter(scale, f, PrimeShiftUpCramped), level, indirect_math_regular); /* engine, default 0 */
+ break;
+ }
+
+}
+
+/*tex
+
+ There is some trickery here. The values are actually pointers and in \LUATEX\ the predefined
+ muglue ones are small numbers that are way below the normal node values. So, they are kind
+ of save signals. However, in \LUAMETATEX\ we use zero based internal codes (because that is
+ nicer for the interface.
+
+*/
+
+void tex_set_display_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ tex_def_math_parameter(display_style, code, value, level, indirect);
+ tex_def_math_parameter(cramped_display_style, code, value, level, indirect);
+}
+
+void tex_set_text_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ tex_def_math_parameter(text_style, code, value, level, indirect);
+ tex_def_math_parameter(cramped_text_style, code, value, level, indirect);
+}
+
+void tex_set_script_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ tex_def_math_parameter(script_style, code, value, level, indirect);
+ tex_def_math_parameter(cramped_script_style, code, value, level, indirect);
+}
+
+void tex_set_script_script_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ tex_def_math_parameter(script_script_style, code, value, level, indirect);
+ tex_def_math_parameter(cramped_script_script_style, code, value, level, indirect);
+}
+
+void tex_set_all_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ for (int style = display_style; style <= cramped_script_script_style; style++) {
+ tex_def_math_parameter(style, code, value, level, indirect);
+ }
+}
+
+void tex_set_uncramped_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ for (int style = display_style; style <= script_script_style; style += 2) {
+ tex_def_math_parameter(style, code, value, level, indirect);
+ }
+}
+
+void tex_set_cramped_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ for (int style = cramped_display_style; style <= cramped_script_script_style; style += 2) {
+ tex_def_math_parameter(style, code, value, level, indirect);
+ }
+}
+
+void tex_set_split_styles(halfword code, halfword value, halfword level, halfword indirect)
+{
+ tex_set_display_styles (code, value, level, indirect);
+ tex_set_text_styles (code, value, level, indirect);
+ tex_set_script_styles (code, 0, level, indirect);
+ tex_set_script_script_styles(code, 0, level, indirect);
+}
+
+void tex_reset_all_styles(halfword level)
+{
+ for (int code = math_parameter_atom_pairs_first; code <= math_parameter_atom_pairs_last; code++) {
+ tex_set_all_styles(code, zero_mu_skip_code, level, indirect_math_unset);
+ }
+}
+
+inline static halfword tex_aux_math_class_default(halfword class) {
+ return (class << 24) + (class << 16) + (class << 8) + class;
+}
+
+inline static void tex_set_math_class_default(halfword class, halfword parent, halfword options)
+{
+ tex_word_define(0, internal_int_location(first_math_class_code + class), tex_aux_math_class_default(parent));
+ tex_word_define(0, internal_int_location(first_math_atom_code + class), tex_aux_math_class_default(class));
+ tex_word_define(0, internal_int_location(first_math_options_code + class), options);
+ tex_word_define(0, internal_int_location(first_math_parent_code + class), tex_aux_math_class_default(class));
+}
+
+static void tex_aux_set_math_atom_rule(halfword left, halfword right, halfword newleft, halfword newright)
+{
+ tex_set_all_styles(math_parameter_rules_pair(left, right), (newleft << 16) + newright, level_one, indirect_math_regular);
+}
+
+void tex_initialize_math_spacing(void)
+{
+
+ for (int class = 0; class <= max_math_class_code; class++) {
+ tex_set_math_class_default(class, class, no_class_options);
+ /*tex We do this here as there is no real need for yet another initializer. */
+ tex_word_define(0, internal_int_location(first_math_pre_penalty_code + class), infinite_penalty);
+ tex_word_define(0, internal_int_location(first_math_post_penalty_code + class), infinite_penalty);
+ tex_word_define(0, internal_int_location(first_math_display_pre_penalty_code + class), infinite_penalty);
+ tex_word_define(0, internal_int_location(first_math_display_post_penalty_code + class), infinite_penalty);
+ }
+
+ tex_reset_all_styles(level_one);
+
+ tex_set_math_class_default(ordinary_noad_subtype, ordinary_noad_subtype, no_italic_correction_class_option |
+ check_ligature_class_option |
+ check_kern_pair_class_option |
+ flatten_class_option);
+ tex_set_math_class_default(operator_noad_subtype, operator_noad_subtype, check_ligature_class_option |
+ check_kern_pair_class_option);
+ tex_set_math_class_default(binary_noad_subtype, binary_noad_subtype, no_italic_correction_class_option |
+ check_ligature_class_option |
+ check_kern_pair_class_option |
+ flatten_class_option);
+ tex_set_math_class_default(relation_noad_subtype, relation_noad_subtype, no_italic_correction_class_option |
+ check_ligature_class_option |
+ check_kern_pair_class_option |
+ flatten_class_option |
+ omit_penalty_class_option);
+ tex_set_math_class_default(open_noad_subtype, open_noad_subtype, no_italic_correction_class_option |
+ /* open_fence_class_option | */
+ check_ligature_class_option |
+ check_kern_pair_class_option);
+ tex_set_math_class_default(close_noad_subtype, close_noad_subtype, no_italic_correction_class_option |
+ /* close_fence_class_option | */
+ check_ligature_class_option |
+ check_kern_pair_class_option);
+ tex_set_math_class_default(punctuation_noad_subtype, punctuation_noad_subtype, no_italic_correction_class_option |
+ check_ligature_class_option |
+ check_kern_pair_class_option |
+ flatten_class_option);
+ tex_set_math_class_default(variable_noad_subtype, ordinary_noad_subtype, no_italic_correction_class_option);
+ tex_set_math_class_default(active_noad_subtype, ordinary_noad_subtype, no_italic_correction_class_option);
+ tex_set_math_class_default(inner_noad_subtype, inner_noad_subtype, flatten_class_option);
+ tex_set_math_class_default(under_noad_subtype, ordinary_noad_subtype, no_class_options);
+ tex_set_math_class_default(over_noad_subtype, ordinary_noad_subtype, no_class_options);
+ tex_set_math_class_default(fraction_noad_subtype, ordinary_noad_subtype, no_class_options);
+ tex_set_math_class_default(radical_noad_subtype, ordinary_noad_subtype, no_class_options);
+ tex_set_math_class_default(middle_noad_subtype, open_noad_subtype, no_italic_correction_class_option); /* | middle_fence_class_option= */
+ tex_set_math_class_default(accent_noad_subtype, ordinary_noad_subtype, no_class_options);
+ tex_set_math_class_default(fenced_noad_subtype, inner_noad_subtype , no_class_options);
+ tex_set_math_class_default(ghost_noad_subtype, ordinary_noad_subtype, no_class_options);
+ tex_set_math_class_default(vcenter_noad_subtype, ordinary_noad_subtype, no_class_options);
+
+ tex_aux_set_math_atom_rule(math_begin_class, binary_noad_subtype, ordinary_noad_subtype, ordinary_noad_subtype);
+ tex_aux_set_math_atom_rule(binary_noad_subtype, math_end_class, ordinary_noad_subtype, ordinary_noad_subtype);
+
+ tex_aux_set_math_atom_rule(binary_noad_subtype, binary_noad_subtype, binary_noad_subtype, ordinary_noad_subtype);
+ tex_aux_set_math_atom_rule(operator_noad_subtype, binary_noad_subtype, operator_noad_subtype, ordinary_noad_subtype);
+ tex_aux_set_math_atom_rule(open_noad_subtype, binary_noad_subtype, open_noad_subtype, ordinary_noad_subtype);
+ tex_aux_set_math_atom_rule(punctuation_noad_subtype, binary_noad_subtype, punctuation_noad_subtype, ordinary_noad_subtype);
+ tex_aux_set_math_atom_rule(relation_noad_subtype, binary_noad_subtype, relation_noad_subtype, ordinary_noad_subtype);
+
+ tex_aux_set_math_atom_rule(binary_noad_subtype, close_noad_subtype, ordinary_noad_subtype, close_noad_subtype);
+ tex_aux_set_math_atom_rule(binary_noad_subtype, punctuation_noad_subtype, ordinary_noad_subtype, punctuation_noad_subtype);
+ tex_aux_set_math_atom_rule(binary_noad_subtype, relation_noad_subtype, ordinary_noad_subtype, relation_noad_subtype);
+
+ tex_aux_set_math_atom_rule(relation_noad_subtype, close_noad_subtype, ordinary_noad_subtype, close_noad_subtype);
+ tex_aux_set_math_atom_rule(relation_noad_subtype, punctuation_noad_subtype, ordinary_noad_subtype, punctuation_noad_subtype);
+
+ /* */
+
+// math_parameter_spacing_pair(ordinary_noad_subtype,ordinary_noad_subtype)
+
+ tex_set_all_styles (math_parameter_spacing_pair(ordinary_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(ordinary_noad_subtype, binary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(ordinary_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(ordinary_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_all_styles (math_parameter_spacing_pair(operator_noad_subtype, ordinary_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_spacing_pair(operator_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(operator_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(operator_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_all_styles (math_parameter_spacing_pair(operator_noad_subtype, fraction_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_spacing_pair(operator_noad_subtype, radical_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_spacing_pair(fraction_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_spacing_pair(radical_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, ordinary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, operator_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, open_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, inner_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, middle_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, fraction_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(binary_noad_subtype, radical_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(middle_noad_subtype, binary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(fraction_noad_subtype, binary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(radical_noad_subtype, binary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, ordinary_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, operator_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, open_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, inner_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, middle_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, fraction_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(relation_noad_subtype, radical_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(middle_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(fraction_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(radical_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_all_styles (math_parameter_spacing_pair(close_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(close_noad_subtype, binary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(close_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(close_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, ordinary_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, relation_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, open_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, close_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, punctuation_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, fraction_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, middle_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(punctuation_noad_subtype, radical_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(fraction_noad_subtype, punctuation_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(middle_noad_subtype, punctuation_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(radical_noad_subtype, punctuation_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, ordinary_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_spacing_pair(inner_noad_subtype, operator_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, binary_noad_subtype), med_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, relation_noad_subtype), thick_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, open_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, punctuation_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ tex_set_split_styles (math_parameter_spacing_pair(inner_noad_subtype, middle_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(fraction_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(radical_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(middle_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(fraction_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+ tex_set_split_styles (math_parameter_spacing_pair(radical_noad_subtype, inner_noad_subtype), thin_mu_skip_code, level_one, indirect_math_regular);
+
+ /* */
+
+ tex_set_all_styles (math_parameter_x_scale, 1000, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_y_scale, 1000, level_one, indirect_math_regular);
+
+ /* could be initialize_math_defaults */
+
+ tex_set_all_styles (math_parameter_over_line_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_under_line_variant, math_normal_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_over_delimiter_variant, math_small_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_under_delimiter_variant, math_small_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_delimiter_over_variant, math_normal_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_delimiter_under_variant, math_normal_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_h_extensible_variant, math_normal_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_v_extensible_variant, math_normal_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_fraction_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_radical_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_degree_variant, math_double_superscript_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_accent_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_top_accent_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_bottom_accent_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_overlay_accent_variant, math_cramped_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_numerator_variant, math_numerator_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_denominator_variant, math_denominator_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_superscript_variant, math_superscript_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_subscript_variant, math_subscript_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_prime_variant, math_superscript_style_variant, level_one, indirect_math_regular);
+ tex_set_all_styles (math_parameter_stack_variant, math_numerator_style_variant, level_one, indirect_math_regular);
+}
+
+/*tex
+
+ This needs to be called just at the start of |mlist_to_hlist|, for backward compatibility with
+ |\scriptspace|.
+
+*/
+
+void tex_finalize_math_parameters(void)
+{
+ int saved_trace = tracing_assigns_par;
+ tracing_assigns_par = 0;
+ if (tex_get_math_parameter(display_style, math_parameter_space_after_script, NULL) == undefined_math_parameter) {
+ tex_def_math_parameter(display_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(text_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(script_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(script_script_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(cramped_display_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(cramped_text_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ tex_def_math_parameter(cramped_script_script_style, math_parameter_space_after_script, script_space_par, level_one, indirect_math_regular);
+ }
+ tracing_assigns_par = saved_trace;
+}
+
+static void tex_aux_math_parameter_error(int style, int param, const char *name)
+{
+ char msg[256] = { 0 };
+ if (param >= 0) {
+ snprintf(msg, 256, "Math error: parameter '%s' with id %i in style %d is not set", name, param, style);
+ } else {
+ snprintf(msg, 256, "Math error: parameter '%s' style %d is not set", name, style);
+ }
+ tex_handle_error(
+ normal_error_type,
+ msg,
+ "Sorry, but I can't typeset math unless various parameters have been set. This is\n"
+ "normally done by loading special math fonts into the math family slots. Your font\n"
+ "set is lacking at least the parameter mentioned earlier."
+ );
+ return;
+}
+
+/*tex
+
+ For the moment this is experimental.
+
+*/
+
+inline static scaled tex_aux_max_scale(int style, int param)
+{
+ scaled scale = tex_get_math_parameter(style, param, NULL);
+ if (scale > 5000) {
+ return 5000;
+ } else if (scale < 0) {
+ return 0;
+ } else {
+ return scale;
+ }
+}
+
+/*tex
+
+ The non-staticness of this function is for the benefit of |texmath.w|. Watch out, this one
+ uses the style! The style and size numbers don't match because we have cramped styles.
+
+*/
+
+scaled tex_get_math_quad_style(int style)
+{
+ scaled scale = tex_aux_max_scale(style, math_parameter_x_scale);
+ scaled value = tex_get_math_parameter(style, math_parameter_quad, NULL);
+ if (value == undefined_math_parameter) {
+ tex_aux_math_parameter_error(style, -1, "quad");
+ return 0;
+ } else {
+ return scaledround(0.001 * value * scale);
+ }
+}
+
+/*tex
+
+ For this reason the next one is different because it is called with a size specifier instead
+ of a style specifier.
+
+*/
+
+scaled tex_math_axis_size(int size)
+{
+ scaled value;
+ switch (size) {
+ case script_size : size = script_style; break;
+ case script_script_size: size = script_script_style; break;
+ default : size = text_style; break;
+ }
+ value = tex_get_math_parameter(size, math_parameter_axis, NULL);
+ if (value == undefined_math_parameter) {
+ tex_aux_math_parameter_error(size, -1, "axis");
+ return 0;
+ } else {
+ return value;
+ }
+}
+
+scaled tex_get_math_quad_size(int size) /* used in degree before and after */
+{
+ switch (size) {
+ case script_size : size = script_style; break;
+ case script_script_size: size = script_script_style; break;
+ default : size = text_style; break;
+ }
+ return tex_get_math_parameter(size, math_parameter_quad, NULL);
+}
+
+scaled tex_get_math_quad_size_scaled(int size) /* used in cur_mu */
+{
+ scaled value, scale;
+ switch (size) {
+ case script_size : size = script_style; break;
+ case script_script_size: size = script_script_style; break;
+ default : size = text_style; break;
+ }
+ value = tex_get_math_parameter(size, math_parameter_quad, NULL);
+ scale = tex_aux_max_scale(size, math_parameter_x_scale);
+ /* return tex_x_over_n(scaledround(0.001 * value * scale), 18); */
+ return scaledround(0.001 * value * scale / 18.0);
+}
+
+static int tex_aux_math_parameter_okay(int param)
+{
+ if (ignore_math_parameter(param)) {
+ if (tracing_math_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: parameter, name %s, ignored]", lmt_name_of_math_parameter(param));
+ tex_end_diagnostic();
+ }
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+scaled tex_get_math_parameter_checked(int style, int param)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ tex_aux_math_parameter_error(style, param, lmt_name_of_math_parameter(param));
+ return 0;
+ } else {
+ return value;
+ }
+ } else {
+ return 0;
+ }
+}
+
+scaled tex_get_math_parameter_default(int style, int param, scaled dflt)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ return dflt;
+ } else {
+ return value;
+ }
+ } else {
+ return dflt;
+ }
+}
+
+void tex_run_math_italic_correction(void) {
+ tex_tail_append(tex_new_kern_node(0, explicit_kern_subtype)); /* maybe math_shape_kern */
+}
+
+/* */
+
+scaled tex_get_math_x_parameter(int style, int param)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled scale = tex_aux_max_scale(style, math_parameter_x_scale);
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ return value; // ?? scaledround(value * scale * 0.001);
+ } else {
+ return value ? scaledround(0.000000001 * glyph_scale_par * glyph_x_scale_par * value * scale) : 0;
+ }
+ } else {
+ return 0;
+ }
+}
+
+scaled tex_get_math_x_parameter_checked(int style, int param)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled scale = tex_aux_max_scale(style, math_parameter_x_scale);
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ tex_aux_math_parameter_error(style, param, lmt_name_of_math_parameter(param));
+ return 0;
+ } else {
+ return value ? scaledround(0.000000001 * glyph_scale_par * glyph_x_scale_par * value * scale) : 0;
+ }
+ } else {
+ return 0;
+ }
+}
+
+scaled tex_get_math_x_parameter_default(int style, int param, scaled dflt)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled scale = tex_aux_max_scale(style, math_parameter_x_scale);
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ return dflt;
+ } else{
+ return value ? scaledround(0.000000001 * glyph_scale_par * glyph_x_scale_par * value * scale) : 0;
+ }
+ } else {
+ return dflt;
+ }
+}
+
+scaled tex_get_math_y_parameter(int style, int param)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled scale = tex_aux_max_scale(style, math_parameter_y_scale);
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ return value;
+ } else{
+ return value ? scaledround(0.000000001 * glyph_scale_par * glyph_y_scale_par * value * scale) : 0;
+ }
+ } else {
+ return 0;
+ }
+}
+
+scaled tex_get_math_y_parameter_checked(int style, int param)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled scale = tex_aux_max_scale(style, math_parameter_y_scale);
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ tex_aux_math_parameter_error(style, param, lmt_name_of_math_parameter(param));
+ return 0;
+ } else {
+ return value ? scaledround(0.000000001 * glyph_scale_par * glyph_y_scale_par * value * scale) : 0;
+ }
+ } else {
+ return 0;
+ }
+}
+
+scaled tex_get_math_y_parameter_default(int style, int param, scaled dflt)
+{
+ if (tex_aux_math_parameter_okay(param)) {
+ scaled scale = tex_aux_max_scale(style, math_parameter_y_scale);
+ scaled value = tex_get_math_parameter(style, param, NULL);
+ if (value == undefined_math_parameter) {
+ return dflt;
+ } else{
+ return value ? scaledround(0.000000001 * glyph_scale_par * glyph_y_scale_par * value * scale) : 0;
+ }
+ } else {
+ return dflt;
+ }
+}
+
+scaled tex_get_font_math_parameter(int font, int size, int param)
+{
+ scaled scale = tex_get_math_font_scale(font, size);
+ scaled value = tex_aux_get_font_math_parameter(scale, font, param);
+ if (value == undefined_math_parameter) {
+ return undefined_math_parameter;
+ } else {
+ return value ? scaledround(0.001 * glyph_scale_par * value) : 0;
+ }
+}
+
+/* maybe more precission, so multiply all and divide by 0.000000001 */
+
+scaled tex_get_font_math_y_parameter(int font, int size, int param)
+{
+ scaled scale = tex_get_math_font_scale(font, size);
+ scaled value = tex_aux_get_font_math_parameter(scale, font, param);
+ if (value == undefined_math_parameter) {
+ return undefined_math_parameter;
+ } else {
+ return value ? scaledround(0.000001 * glyph_scale_par * glyph_y_scale_par * value) : 0;
+ }
+}
+
+scaled tex_get_font_math_x_parameter(int font, int size, int param)
+{
+ scaled scale = tex_get_math_font_scale(font, size);
+ scaled value = tex_aux_get_font_math_parameter(scale, font, param);
+ if (value == undefined_math_parameter) {
+ return undefined_math_parameter;
+ } else {
+ return value ? scaledround(0.000001 * glyph_scale_par * glyph_x_scale_par * value) : 0;
+ }
+}
+
+halfword tex_to_math_spacing_parameter(halfword left, halfword right)
+{
+ halfword param = math_parameter_spacing_pair(left,right);
+ return (param >= math_parameter_atom_pairs_first && param <= math_parameter_atom_pairs_last) ? param : -1;
+}
+
+halfword tex_to_math_rules_parameter(halfword left, halfword right)
+{
+ halfword param = math_parameter_rules_pair(left,right);
+ return (param >= math_parameter_atom_rules_first && param <= math_parameter_atom_rules_last) ? param : -1;
+}
+
+void tex_set_default_math_codes(void)
+{
+ mathcodeval mval = { 0, 0, 0 };
+ /*tex This will remap old font families at runtime. */
+ mval.class_value = math_use_current_family_code;
+ /*tex Upright math digts come from family 0. */
+ for (int d = '0'; d <= '9'; d++) {
+ mval.character_value = d;
+ tex_set_math_code(d, mval, level_one);
+ }
+ /* In traditional fonts math italic has family 1. */
+ mval.family_value = 1;
+ for (int u = 'A'; u <= 'Z'; u++) {
+ mval.character_value = u;
+ tex_set_math_code(u, mval, level_one);
+ }
+ for (int l = 'a'; l <= 'z'; l++) {
+ mval.character_value = l;
+ tex_set_math_code(l, mval, level_one);
+ }
+ /*tex This is kind of standard. */
+ tex_set_del_code('.', (delcodeval) { { 0, 0, 0, }, { 0, 0, 0 } }, level_one);
+}
+
+int tex_in_main_math_style(halfword style)
+{
+ switch (style) {
+ case display_style:
+ case text_style:
+ return 1;
+ /*
+ case cramped_display_style:
+ case cramped_text_style:
+ return 0; // could be parameter driven
+ */
+ default:
+ return 0;
+ }
+}
diff --git a/source/luametatex/source/tex/texmath.h b/source/luametatex/source/tex/texmath.h
new file mode 100644
index 000000000..7dbd62b2e
--- /dev/null
+++ b/source/luametatex/source/tex/texmath.h
@@ -0,0 +1,758 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXMATH_H
+# define LMT_TEXMATH_H
+
+/*tex
+ This module also deals with math parameters. That code has been cleaned up a lot, and it
+ worked out well, but at some point Mikael Sundqvist and I entered \quutation {alternative
+ spacing models mode} and a more generic model was implemented. As a consequence new code
+ showed up and already cleaned up code (the many parameters) could be thrown out. That's how
+ it goed and it is in retrospect good that we had not yet released.
+
+*/
+
+# define MATHPARAMSTACK 8
+# define MATHPARAMDEFAULT undefined_math_parameter
+
+# define MATHFONTSTACK 8
+# define MATHFONTDEFAULT 0
+
+typedef struct math_state_info {
+ int size; /*tex Size code corresponding to |cur_style|. */
+ int level; /*tex Maybe we should expose this one. */
+ /* int opentype; */ /*tex We just assume opentype now. */
+ /* int padding; */
+ sa_tree par_head;
+ sa_tree fam_head;
+ halfword last_left;
+ halfword last_right;
+ scaled last_atom;
+ scaled scale;
+} math_state_info;
+
+extern math_state_info lmt_math_state;
+
+typedef enum math_sizes {
+ text_size,
+ script_size,
+ script_script_size
+} math_sizes;
+
+# define last_math_size script_script_size
+
+# define undefined_math_parameter max_dimen
+
+typedef enum math_indirect_types {
+ indirect_math_unset,
+ indirect_math_regular,
+ indirect_math_integer,
+ indirect_math_dimension,
+ indirect_math_gluespec,
+ indirect_math_mugluespec,
+ indirect_math_register_integer,
+ indirect_math_register_dimension,
+ indirect_math_register_gluespec,
+ indirect_math_register_mugluespec,
+ indirect_math_internal_integer,
+ indirect_math_internal_dimension,
+ indirect_math_internal_gluespec,
+ indirect_math_internal_mugluespec,
+} math_indirect_types;
+
+# define last_math_indirect indirect_math_internal_mugluespec
+
+typedef enum math_parameter_types {
+ math_int_parameter,
+ math_dimen_parameter,
+ math_muglue_parameter,
+ math_style_parameter,
+ math_pair_parameter,
+} math_parameter_types;
+
+typedef enum math_parameters {
+ math_parameter_quad,
+ math_parameter_axis,
+ math_parameter_accent_base_height,
+ math_parameter_accent_base_depth,
+ math_parameter_flattened_accent_base_height,
+ math_parameter_flattened_accent_base_depth,
+ math_parameter_x_scale,
+ math_parameter_y_scale,
+ math_parameter_operator_size,
+ math_parameter_overbar_kern,
+ math_parameter_overbar_rule,
+ math_parameter_overbar_vgap,
+ math_parameter_underbar_kern,
+ math_parameter_underbar_rule,
+ math_parameter_underbar_vgap,
+ math_parameter_radical_kern,
+ math_parameter_radical_rule,
+ math_parameter_radical_vgap,
+ math_parameter_radical_degree_before,
+ math_parameter_radical_degree_after,
+ math_parameter_radical_degree_raise,
+ math_parameter_radical_extensible_after,
+ math_parameter_radical_extensible_before,
+ math_parameter_stack_vgap,
+ math_parameter_stack_num_up,
+ math_parameter_stack_denom_down,
+ math_parameter_fraction_rule,
+ math_parameter_fraction_num_vgap,
+ math_parameter_fraction_num_up,
+ math_parameter_fraction_denom_vgap,
+ math_parameter_fraction_denom_down,
+ math_parameter_fraction_del_size,
+ math_parameter_skewed_fraction_hgap,
+ math_parameter_skewed_fraction_vgap,
+ math_parameter_limit_above_vgap,
+ math_parameter_limit_above_bgap,
+ math_parameter_limit_above_kern,
+ math_parameter_limit_below_vgap,
+ math_parameter_limit_below_bgap,
+ math_parameter_limit_below_kern,
+ math_parameter_nolimit_sub_factor, /*tex bonus */
+ math_parameter_nolimit_sup_factor, /*tex bonus */
+ math_parameter_under_delimiter_vgap,
+ math_parameter_under_delimiter_bgap,
+ math_parameter_over_delimiter_vgap,
+ math_parameter_over_delimiter_bgap,
+ math_parameter_subscript_shift_drop,
+ math_parameter_superscript_shift_drop,
+ math_parameter_subscript_shift_down,
+ math_parameter_subscript_superscript_shift_down,
+ math_parameter_subscript_top_max,
+ math_parameter_superscript_shift_up,
+ math_parameter_superscript_bottom_min,
+ math_parameter_superscript_subscript_bottom_max,
+ math_parameter_subscript_superscript_vgap,
+ math_parameter_space_before_script,
+ math_parameter_space_after_script,
+ math_parameter_connector_overlap_min,
+ /* */
+ math_parameter_extra_superscript_shift,
+ math_parameter_extra_subscript_shift,
+ math_parameter_extra_superprescript_shift,
+ math_parameter_extra_subprescript_shift,
+ /* */
+ math_parameter_prime_raise,
+ math_parameter_prime_raise_composed,
+ math_parameter_prime_shift_up,
+ math_parameter_prime_shift_drop,
+ math_parameter_prime_space_after,
+ math_parameter_prime_width,
+ /* */
+ math_parameter_rule_height,
+ math_parameter_rule_depth,
+ /* */
+ math_parameter_superscript_shift_distance,
+ math_parameter_subscript_shift_distance,
+ math_parameter_superprescript_shift_distance,
+ math_parameter_subprescript_shift_distance,
+ /* */
+ math_parameter_extra_superscript_space,
+ math_parameter_extra_subscript_space,
+ math_parameter_extra_superprescript_space,
+ math_parameter_extra_subprescript_space,
+ /* */
+ math_parameter_skewed_delimiter_tolerance,
+ /* */
+ math_parameter_accent_top_shift_up,
+ math_parameter_accent_bottom_shift_down,
+ math_parameter_accent_top_overshoot,
+ math_parameter_accent_bottom_overshoot,
+ math_parameter_accent_superscript_drop,
+ math_parameter_accent_superscript_percent,
+ math_parameter_accent_extend_margin,
+ math_parameter_flattened_accent_top_shift_up,
+ math_parameter_flattened_accent_bottom_shift_down,
+ /* */
+ math_parameter_delimiter_percent,
+ math_parameter_delimiter_shortfall,
+ /* */
+ math_parameter_over_line_variant,
+ math_parameter_under_line_variant,
+ math_parameter_over_delimiter_variant,
+ math_parameter_under_delimiter_variant,
+ math_parameter_delimiter_over_variant,
+ math_parameter_delimiter_under_variant,
+ math_parameter_h_extensible_variant,
+ math_parameter_v_extensible_variant,
+ math_parameter_fraction_variant,
+ math_parameter_radical_variant,
+ math_parameter_accent_variant,
+ math_parameter_degree_variant,
+ math_parameter_top_accent_variant,
+ math_parameter_bottom_accent_variant,
+ math_parameter_overlay_accent_variant,
+ math_parameter_numerator_variant,
+ math_parameter_denominator_variant,
+ math_parameter_superscript_variant,
+ math_parameter_subscript_variant,
+ math_parameter_prime_variant,
+ math_parameter_stack_variant,
+ /* */
+ /*tex The growing list of |math_parameter_ATOM1_ATOM2_spacing| is gone. */
+ /* */
+ math_parameter_last = 255,
+ math_parameter_atom_pairs_first = math_parameter_last + 1,
+ math_parameter_atom_pairs_last = math_parameter_atom_pairs_first + (max_n_of_math_classes * max_n_of_math_classes),
+ math_parameter_atom_rules_first = math_parameter_atom_pairs_last + 1,
+ math_parameter_atom_rules_last = math_parameter_atom_rules_first + (max_n_of_math_classes * max_n_of_math_classes),
+ /* a special private one */
+ math_parameter_reset_spacing,
+ math_parameter_set_spacing,
+ math_parameter_let_spacing,
+ math_parameter_copy_spacing,
+ math_parameter_set_atom_rule,
+ math_parameter_let_atom_rule,
+ math_parameter_copy_atom_rule,
+ math_parameter_let_parent,
+ math_parameter_copy_parent,
+ math_parameter_set_pre_penalty,
+ math_parameter_set_post_penalty,
+ math_parameter_set_display_pre_penalty,
+ math_parameter_set_display_post_penalty,
+ math_parameter_ignore,
+ math_parameter_options,
+ math_parameter_set_defaults,
+} math_parameters;
+
+# define math_parameter_max_range (16 * 1024) // 4 * (max_n_of_math_classes * max_n_of_math_classes)
+
+# define math_parameter_spacing_pair(l,r) (math_parameter_atom_pairs_first + (l * max_n_of_math_classes) + r)
+# define math_parameter_rules_pair(l,r) (math_parameter_atom_rules_first + (l * max_n_of_math_classes) + r)
+
+# define math_parameter_spacing_left(n) ((n - math_parameter_atom_pairs_first) / max_n_of_math_classes)
+# define math_parameter_spacing_right(n) ((n - math_parameter_atom_pairs_first) % max_n_of_math_classes)
+
+# define math_parameter_rules_left(n) ((n - math_parameter_atom_rules_first) / max_n_of_math_classes)
+# define math_parameter_rules_right(n) ((n - math_parameter_atom_rules_first) % max_n_of_math_classes)
+
+# define ignore_math_parameter(n) (count_parameter(first_math_ignore_code + n))
+# define options_math_parameter(n) (count_parameter(first_math_options_code + n))
+
+# define math_all_class (max_n_of_math_classes - 3)
+# define math_begin_class (max_n_of_math_classes - 2)
+# define math_end_class (max_n_of_math_classes - 1)
+
+# define valid_math_class_code(n) (n >= 0 && n < max_n_of_math_classes)
+
+# define last_math_parameter math_parameter_stack_variant
+# define math_parameter_first_variant math_parameter_over_line_variant
+# define math_parameter_last_variant math_parameter_stack_variant
+# define math_default_spacing_parameter math_parameter_spacing_pair(ordinary_noad_subtype,ordinary_noad_subtype)
+# define math_default_rules_parameter 0
+
+typedef enum math_class_options {
+ no_pre_slack_class_option = 0x0000001,
+ no_post_slack_class_option = 0x0000002,
+ left_top_kern_class_option = 0x0000004,
+ right_top_kern_class_option = 0x0000008,
+ left_bottom_kern_class_option = 0x0000010,
+ right_bottom_kern_class_option = 0x0000020,
+ look_ahead_for_end_class_option = 0x0000040,
+ no_italic_correction_class_option = 0x0000080,
+ check_ligature_class_option = 0x0000100,
+ check_italic_correction_class_option = 0x0000200,
+ check_kern_pair_class_option = 0x0000400,
+ flatten_class_option = 0x0000800,
+ omit_penalty_class_option = 0x0001000,
+ unpack_class_option = 0x0002000,
+ raise_prime_option = 0x0004000,
+ // open_fence_class_option = 0x0000100,
+ // close_fence_class_option = 0x0000200,
+ // middle_fence_class_option = 0x0000400,
+ carry_over_left_top_kern_class_option = 0x0008000,
+ carry_over_right_top_kern_class_option = 0x0010000,
+ carry_over_left_bottom_kern_class_option = 0x0020000,
+ carry_over_right_bottom_kern_class_option = 0x0040000,
+ prefer_delimiter_dimensions_class_option = 0x0080000,
+ auto_inject_class_option = 0x0100000,
+ remove_italic_correction_class_option = 0x0200000,
+ no_class_options = 0xF000000,
+} math_class_options;
+
+extern int tex_math_has_class_option(halfword cls, int option);
+
+typedef enum math_atom_font_options {
+ math_atom_no_font_option = 0,
+ math_atom_text_font_option = 1,
+ math_atom_math_font_option = 2,
+} math_atom_font_options;
+
+inline int math_parameter_value_type(int n)
+{
+ if (n < last_math_parameter) {
+ return lmt_interface.math_parameter_values[n].type;
+ } else if (n >= math_parameter_atom_rules_first && n <= math_parameter_atom_rules_last) {
+ return math_pair_parameter;
+ } else {
+ return math_muglue_parameter;
+ }
+}
+
+/*tex
+ We used to have a lot of defines like:
+
+ \starttyping
+ # define math_parameter_A_B_spacing math_parameter_spacing_pair(A_noad_subtype,B_noad_subtype)
+ \stoptyping
+
+ but we now inline them as they are only used once.
+
+*/
+
+/*tex
+
+ We also need to compute the change in style between mlists and their subsidiaries. The following
+ macros define the subsidiary style for an overlined nucleus (|cramped_style|), for a subscript
+ or a superscript (|sub_style| or |sup_style|), or for a numerator or denominator (|num_style| or
+ |denom_style|). We now delegate that to a helper function so that eventually we can symbolic
+ presets.
+
+*/
+
+typedef enum math_style_variants {
+ math_normal_style_variant,
+ math_cramped_style_variant,
+ math_subscript_style_variant,
+ math_superscript_style_variant,
+ math_small_style_variant,
+ math_smaller_style_variant,
+ math_numerator_style_variant,
+ math_denominator_style_variant,
+ math_double_superscript_variant,
+} math_style_variants;
+
+# define last_math_style_variant math_double_superscript_variant
+
+/*
+
+These are the mandate font parameters per \url {https://docs.microsoft.com/en-us/typography/opentype/spec/math}:
+
+\starttabulate[|T|p|]
+\NC ScriptPercentScaleDown \NC Percentage of scaling down for level 1 superscripts and subscripts. Suggested value: 80 pct. \NC \NR
+\NC ScriptScriptPercentScaleDown \NC Percentage of scaling down for level 2 (scriptScript) superscripts and subscripts. Suggested value: 60 pct. \NC \NR
+\NC DelimitedSubFormulaMinHeight \NC Minimum height required for a delimited expression (contained within parentheses, etc.) to be treated as a sub-formula. Suggested value: normal line height × 1.5. \NC \NR
+\NC DisplayOperatorMinHeight \NC Minimum height of n-ary operators (such as integral and summation) for formulas in display mode (that is, appearing as standalone page elements, not embedded inline within text). \NC \NR
+\NC MathLeading \NC White space to be left between math formulas to ensure proper line spacing. For example, for applications that treat line gap as a part of line ascender, formulas with ink going above (os2.sTypoAscender + os2.sTypoLineGap - MathLeading) or with ink going below os2.sTypoDescender will result in increasing line height. \NC \NR
+\NC AxisHeight \NC Axis height of the font. In math typesetting, the term axis refers to a horizontal reference line used for positioning elements in a formula. The math axis is similar to but distinct from the baseline for regular text layout. For example, in a simple equation, a minus symbol or fraction rule would be on the axis, but a string for a variable name would be set on a baseline that is offset from the axis. The axisHeight value determines the amount of that offset. \NC \NR
+\NC AccentBaseHeight \NC Maximum (ink) height of accent base that does not require raising the accents. Suggested: x‑height of the font (os2.sxHeight) plus any possible overshots. \NC \NR
+\NC FlattenedAccentBaseHeight \NC Maximum (ink) height of accent base that does not require flattening the accents. Suggested: cap height of the font (os2.sCapHeight). \NC \NR
+\NC SubscriptShiftDown \NC The standard shift down applied to subscript elements. Positive for moving in the downward direction. Suggested: os2.ySubscriptYOffset. \NC \NR
+\NC SubscriptTopMax \NC Maximum allowed height of the (ink) top of subscripts that does not require moving subscripts further down. Suggested: 4/5 x- height. \NC \NR
+\NC SubscriptBaselineDropMin \NC Minimum allowed drop of the baseline of subscripts relative to the (ink) bottom of the base. Checked for bases that are treated as a box or extended shape. Positive for subscript baseline dropped below the base bottom. \NC \NR
+\NC SuperscriptShiftUp \NC Standard shift up applied to superscript elements. Suggested: os2.ySuperscriptYOffset. \NC \NR
+\NC SuperscriptShiftUpCramped \NC Standard shift of superscripts relative to the base, in cramped style. \NC \NR
+\NC SuperscriptBottomMin \NC Minimum allowed height of the (ink) bottom of superscripts that does not require moving subscripts further up. Suggested: ¼ x-height. \NC \NR
+\NC SuperscriptBaselineDropMax \NC Maximum allowed drop of the baseline of superscripts relative to the (ink) top of the base. Checked for bases that are treated as a box or extended shape. Positive for superscript baseline below the base top. \NC \NR
+\NC SubSuperscriptGapMin \NC Minimum gap between the superscript and subscript ink. Suggested: 4 × default rule thickness. \NC \NR
+\NC SuperscriptBottomMaxWithSubscript \NC The maximum level to which the (ink) bottom of superscript can be pushed to increase the gap between superscript and subscript, before subscript starts being moved down. Suggested: 4/5 x-height. \NC \NR
+\NC SpaceAfterScript \NC Extra white space to be added after each subscript and superscript. Suggested: 0.5 pt for a 12 pt font. (Note that, in some math layout implementations, a constant value, such as 0.5 pt, may be used for all text sizes. Some implementations may use a constant ratio of text size, such as 1/24 of em.) \NC \NR
+\NC UpperLimitGapMin \NC Minimum gap between the (ink) bottom of the upper limit, and the (ink) top of the base operator. \NC \NR
+\NC UpperLimitBaselineRiseMin \NC Minimum distance between baseline of upper limit and (ink) top of the base operator.
+\NC LowerLimitGapMin \NC Minimum gap between (ink) top of the lower limit, and (ink) bottom of the base operator. \NC \NR
+\NC LowerLimitBaselineDropMin \NC Minimum distance between baseline of the lower limit and (ink) bottom of the base operator. \NC \NR
+\NC StackTopShiftUp \NC Standard shift up applied to the top element of a stack.
+\NC StackTopDisplayStyleShiftUp \NC Standard shift up applied to the top element of a stack in display style. \NC \NR
+\NC StackBottomShiftDown \NC Standard shift down applied to the bottom element of a stack. Positive for moving in the downward direction. \NC \NR
+\NC StackBottomDisplayStyleShiftDown \NC Standard shift down applied to the bottom element of a stack in display style. Positive for moving in the downward direction. \NC \NR
+\NC StackGapMin \NC Minimum gap between (ink) bottom of the top element of a stack, and the (ink) top of the bottom element. Suggested: 3 × default rule thickness. \NC \NR
+\NC StackDisplayStyleGapMin \NC Minimum gap between (ink) bottom of the top element of a stack, and the (ink) top of the bottom element in display style. Suggested: 7 × default rule thickness. \NC \NR
+\NC StretchStackTopShiftUp \NC Standard shift up applied to the top element of the stretch stack. \NC \NR
+\NC StretchStackBottomShiftDown \NC Standard shift down applied to the bottom element of the stretch stack. Positive for moving in the downward direction. \NC \NR
+\NC StretchStackGapAboveMin \NC Minimum gap between the ink of the stretched element, and the (ink) bottom of the element above. Suggested: same value as upperLimitGapMin. \NC \NR
+\NC StretchStackGapBelowMin \NC Minimum gap between the ink of the stretched element, and the (ink) top of the element below. Suggested: same value as lowerLimitGapMin. \NC \NR
+\NC FractionNumeratorShiftUp \NC Standard shift up applied to the numerator. \NC \NR
+\NC FractionNumeratorDisplayStyleShiftUp \NC Standard shift up applied to the numerator in display style. Suggested: same value as stackTopDisplayStyleShiftUp. \NC \NR
+\NC FractionDenominatorShiftDown \NC Standard shift down applied to the denominator. Positive for moving in the downward direction. \NC \NR
+\NC FractionDenominatorDisplayStyleShiftDown \NC Standard shift down applied to the denominator in display style. Positive for moving in the downward direction. Suggested: same value as stackBottomDisplayStyleShiftDown. \NC \NR
+\NC FractionNumeratorGapMin \NC Minimum tolerated gap between the (ink) bottom of the numerator and the ink of the fraction bar. Suggested: default rule thickness. \NC \NR
+\NC FractionNumDisplayStyleGapMin \NC Minimum tolerated gap between the (ink) bottom of the numerator and the ink of the fraction bar in display style. Suggested: 3 × default rule thickness. \NC \NR
+\NC FractionRuleThickness \NC Thickness of the fraction bar. Suggested: default rule thickness. \NC \NR
+\NC FractionDenominatorGapMin \NC Minimum tolerated gap between the (ink) top of the denominator and the ink of the fraction bar. Suggested: default rule thickness. \NC \NR
+\NC FractionDenomDisplayStyleGapMin \NC Minimum tolerated gap between the (ink) top of the denominator and the ink of the fraction bar in display style. Suggested: 3 × default rule thickness. \NC \NR
+\NC SkewedFractionHorizontalGap \NC Horizontal distance between the top and bottom elements of a skewed fraction. \NC \NR
+\NC SkewedFractionVerticalGap \NC Vertical distance between the ink of the top and bottom elements of a skewed fraction. \NC \NR
+\NC OverbarVerticalGap \NC Distance between the overbar and the (ink) top of he base. Suggested: 3 × default rule thickness. \NC \NR
+\NC OverbarRuleThickness \NC Thickness of overbar. Suggested: default rule thickness. \NC \NR
+\NC OverbarExtraAscender \NC Extra white space reserved above the overbar. Suggested: default rule thickness. \NC \NR
+\NC UnderbarVerticalGap \NC Distance between underbar and (ink) bottom of the base. Suggested: 3 × default rule thickness. \NC \NR
+\NC UnderbarRuleThickness \NC Thickness of underbar. Suggested: default rule thickness. \NC \NR
+\NC UnderbarExtraDescender \NC Extra white space reserved below the underbar. Always positive. Suggested: default rule thickness. \NC \NR
+\NC RadicalVerticalGap \NC Space between the (ink) top of the expression and the bar over it. Suggested: 1¼ default rule thickness. \NC \NR
+\NC RadicalDisplayStyleVerticalGap \NC Space between the (ink) top of the expression and the bar over it. Suggested: default rule thickness + ¼ x-height. \NC \NR
+\NC RadicalRuleThickness \NC Thickness of the radical rule. This is the thickness of the rule in designed or constructed radical signs. Suggested: default rule thickness. \NC \NR
+\NC RadicalExtraAscender \NC Extra white space reserved above the radical. Suggested: same value as radicalRuleThickness. \NC \NR
+\NC RadicalKernBeforeDegree \NC Extra horizontal kern before the degree of a radical, if such is present. Suggested: 5/18 of em. \NC \NR
+\NC RadicalKernAfterDegree \NC Negative kern after the degree of a radical, if such is present. Suggested: −10/18 of em. \NC \NR
+\NC RadicalDegreeBottomRaisePercent \NC Height of the bottom of the radical degree, if such is present, in proportion to the ascender of the radical sign. Suggested: 60 pct. \NC \NR
+\stoptabulate
+
+And these are our own, some are a bit older already but most were introduced when we (Mikael and
+Hans) overhauled the math engine.
+
+\starttabulate[|T|c|p|]
+\NC MinConnectorOverlap \NC 0 \NC \NC \NR
+\NC SubscriptShiftDownWithSuperscript \NC inherited \NC \NC \NR
+\NC FractionDelimiterSize \NC undefined \NC \NC \NR
+\NC FractionDelimiterDisplayStyleSize \NC undefined \NC \NC \NR
+\NC NoLimitSubFactor \NC 0 \NC \NC \NR
+\NC NoLimitSupFactor \NC 0 \NC \NC \NR
+\NC AccentBaseDepth \NC reserved \NC \NC \NR
+\NC FlattenedAccentBaseDepth \NC reserved \NC \NC \NR
+\NC SpaceBeforeScript \NC 0 \NC \NC \NR
+\NC PrimeRaisePercent \NC 0 \NC \NC \NR
+\NC PrimeShiftUp \NC 0 \NC \NC \NR
+\NC PrimeShiftUpCramped \NC 0 \NC \NC \NR
+\NC PrimeSpaceAfter \NC 0 \NC \NC \NR
+\NC PrimeBaselineDropMax \NC 0 \NC \NC \NR
+\NC PrimeWidthPercent \NC 0 \NC \NC \NR
+\NC SkewedDelimiterTolerance \NC 0 \NC \NC \NR
+\NC AccentTopShiftUp \NC undefined \NC \NC \NR
+\NC AccentBottomShiftDown \NC undefined \NC \NC \NR
+\NC AccentTopOvershoot \NC 0 \NC \NC \NR
+\NC AccentBottomOvershoot \NC 0 \NC \NC \NR
+\NC AccentSuperscriptDrop \NC 0 \NC \NC \NR
+\NC AccentSuperscriptPercent \NC 0 \NC \NC \NR
+\NC FlattenedAccentTopShiftUp \NC undefined \NC \NC \NR
+\NC FlattenedAccentBottomShiftDown \NC undefined \NC \NC \NR
+\NC DelimiterPercent \NC \NC \NC \NR
+\NC DelimiterShortfall \NC \NC \NC \NR
+\stoptabulate
+
+*/
+
+typedef enum math_parameter_codes {
+ /* official */
+ ScriptPercentScaleDown = 1,
+ 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,
+ RadicalKernAfterExtensible,
+ RadicalKernBeforeExtensible,
+ /* unofficial */
+ MinConnectorOverlap,
+ SubscriptShiftDownWithSuperscript,
+ FractionDelimiterSize,
+ FractionDelimiterDisplayStyleSize,
+ NoLimitSubFactor,
+ NoLimitSupFactor,
+ AccentBaseDepth, /* reserved */
+ FlattenedAccentBaseDepth, /* reserved */
+ SpaceBeforeScript,
+ PrimeRaisePercent,
+ PrimeRaiseComposedPercent,
+ PrimeShiftUp,
+ PrimeShiftUpCramped,
+ PrimeBaselineDropMax,
+ PrimeSpaceAfter,
+ PrimeWidthPercent,
+ SkewedDelimiterTolerance,
+ AccentTopShiftUp,
+ AccentBottomShiftDown,
+ AccentTopOvershoot,
+ AccentBottomOvershoot,
+ AccentSuperscriptDrop,
+ AccentSuperscriptPercent,
+ AccentExtendMargin,
+ FlattenedAccentTopShiftUp,
+ FlattenedAccentBottomShiftDown,
+ DelimiterPercent,
+ DelimiterShortfall,
+ /* done */
+ math_parameter_last_code,
+} math_parameter_codes;
+
+# define math_parameter_last_font_code NoLimitSupFactor
+# define math_parameter_first_engine_code SpaceBeforeScript
+
+typedef enum display_skip_modes {
+ display_skip_default,
+ display_skip_always,
+ display_skip_non_zero,
+ display_skip_ignore,
+} display_skip_modes;
+
+typedef enum math_skip_modes {
+ math_skip_surround_when_zero = 0, /*tex obey mathsurround when zero glue */
+ math_skip_always_left = 1,
+ math_skip_always_right = 2,
+ math_skip_always_both = 3,
+ math_skip_always_surround = 4, /*tex ignore, obey marthsurround */
+ math_skip_ignore = 5, /*tex all spacing disabled */
+ math_skip_only_when_skip = 6,
+} math_skip_modes;
+
+/*tex All kind of helpers: */
+
+# define math_use_current_family_code math_component_variable_code
+# define fam_par_in_range(fam) ((fam >= 0) && (cur_fam_par < max_n_of_math_families))
+# define cur_fam_par_in_range ((cur_fam_par >= 0) && (cur_fam_par < max_n_of_math_families))
+
+extern halfword tex_size_of_style (halfword style);
+
+extern halfword tex_to_math_spacing_parameter (halfword left, halfword right);
+extern halfword tex_to_math_rules_parameter (halfword left, halfword right);
+
+extern halfword tex_math_style_variant (halfword style, halfword param);
+
+extern void tex_def_math_parameter (int style, int param, scaled value, int level, int indirect);
+extern scaled tex_get_math_parameter (int style, int param, halfword *type);
+extern int tex_has_math_parameter (int style, int param);
+extern scaled tex_get_math_parameter_checked (int style, int param);
+extern scaled tex_get_math_parameter_default (int style, int param, scaled dflt);
+
+extern scaled tex_get_math_x_parameter (int style, int param);
+extern scaled tex_get_math_x_parameter_checked (int style, int param);
+extern scaled tex_get_math_x_parameter_default (int style, int param, scaled dflt);
+
+extern scaled tex_get_math_y_parameter (int style, int param);
+extern scaled tex_get_math_y_parameter_checked (int style, int param);
+extern scaled tex_get_math_y_parameter_default (int style, int paramm, scaled dflt);
+
+extern scaled tex_get_font_math_parameter (int font, int size, int param);
+extern scaled tex_get_font_math_x_parameter (int font, int size, int param);
+extern scaled tex_get_font_math_y_parameter (int font, int size, int param);
+
+extern void tex_fixup_math_parameters (int fam, int size, int fnt, int level);
+extern void tex_finalize_math_parameters (void);
+extern scaled tex_get_math_quad_style (int style);
+extern scaled tex_math_axis_size (int size);
+extern scaled tex_get_math_quad_size (int size);
+extern scaled tex_get_math_quad_size_scaled (int size);
+
+extern void tex_initialize_math (void);
+extern void tex_initialize_math_spacing (void);
+
+extern void tex_set_display_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_text_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_script_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_script_script_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_all_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_split_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_uncramped_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_set_cramped_styles (halfword code, halfword value, halfword level, halfword indirect);
+extern void tex_reset_all_styles (halfword level);
+
+extern void tex_dump_math_data (dumpstream f);
+extern void tex_undump_math_data (dumpstream f);
+extern void tex_unsave_math_data (int level);
+
+extern void tex_math_copy_char_data (halfword target, halfword source, int wipelist);
+
+extern int tex_show_math_node (halfword n, int threshold, int max);
+extern void tex_flush_math (void);
+extern int tex_is_math_disc (halfword n);
+extern halfword tex_math_make_disc (halfword n);
+extern int tex_in_main_math_style (halfword style);
+
+extern halfword tex_new_sub_box (halfword n);
+// halfword tex_math_vcenter_group (halfword n);
+extern int tex_fam_fnt (int fam, int size);
+extern void tex_def_fam_fnt (int fam, int size, int fnt, int level);
+extern void tex_scan_extdef_del_code (int level, int extcode);
+extern void tex_scan_extdef_math_code (int level, int extcode);
+extern int tex_current_math_style (void);
+extern int tex_current_math_main_style (void);
+extern int tex_scan_math_code_val (halfword code, mathcodeval *mval, mathdictval *dval);
+extern int tex_scan_math_cmd_val (mathcodeval *mval, mathdictval *dval);
+
+extern halfword tex_scan_math_spec (int optional_equal);
+extern halfword tex_new_math_spec (mathcodeval m, quarterword code);
+extern halfword tex_new_math_dict_spec (mathdictval d, mathcodeval m, quarterword code);
+extern mathcodeval tex_get_math_spec (halfword s);
+extern mathdictval tex_get_math_dict (halfword s);
+extern void tex_run_math_math_spec (void);
+extern void tex_run_text_math_spec (void);
+
+extern void tex_set_default_math_codes (void);
+
+/*tex The runners in maincontrol: */
+
+extern void tex_run_math_left_brace (void);
+extern void tex_run_math_math_component (void);
+extern void tex_run_math_modifier (void);
+extern void tex_run_math_radical (void);
+extern void tex_run_math_accent (void);
+extern void tex_run_math_style (void);
+extern void tex_run_math_choice (void);
+extern void tex_run_math_script (void);
+extern void tex_run_math_fraction (void);
+extern void tex_run_math_fence (void);
+extern void tex_run_math_initialize (void);
+extern void tex_run_math_letter (void);
+extern void tex_run_math_math_char_number (void);
+extern void tex_run_text_math_char_number (void);
+extern void tex_run_math_char_number (void);
+extern void tex_run_math_delimiter_number (void);
+// void tex_run_math_math_char_given (void);
+// void tex_run_text_math_char_given (void);
+// void tex_run_math_math_char_xgiven (void);
+// void tex_run_text_math_char_xgiven (void);
+extern void tex_run_math_equation_number (void);
+extern void tex_run_math_shift (void);
+extern void tex_run_math_italic_correction (void);
+
+extern void tex_finish_math_group (void);
+extern void tex_finish_math_choice (void);
+extern void tex_finish_math_fraction (void);
+extern void tex_finish_math_operator (void);
+extern void tex_finish_display_alignment (halfword head, halfword tail, halfword prevdepth);
+
+typedef enum math_control_codes {
+ math_control_use_font_control = 0x000001, /* use the font flag, maybe for traditional, might go */
+ math_control_over_rule = 0x000002,
+ math_control_under_rule = 0x000004,
+ math_control_radical_rule = 0x000008,
+ math_control_fraction_rule = 0x000010,
+ math_control_accent_skew_half = 0x000020,
+ math_control_accent_skew_apply = 0x000040,
+ math_control_apply_ordinary_kern_pair = 0x000080,
+ math_control_apply_vertical_italic_kern = 0x000100,
+ math_control_apply_ordinary_italic_kern = 0x000200,
+ math_control_apply_char_italic_kern = 0x000400, /* traditional */
+ math_control_rebox_char_italic_kern = 0x000800, /* traditional */
+ math_control_apply_boxed_italic_kern = 0x001000,
+ math_control_staircase_kern = 0x002000,
+ math_control_apply_text_italic_kern = 0x004000,
+ math_control_check_text_italic_kern = 0x008000,
+ math_control_check_space_italic_kern = 0x010000,
+ math_control_apply_script_italic_kern = 0x020000,
+ math_control_analyze_script_nucleus_char = 0x040000,
+ math_control_analyze_script_nucleus_list = 0x080000,
+ math_control_analyze_script_nucleus_box = 0x100000,
+} math_control_codes;
+
+/*tex This is what we use for \OPENTYPE\ in \CONTEXT: */
+
+# define assumed_math_control ( \
+ math_control_over_rule \
+ | math_control_under_rule \
+ | math_control_radical_rule \
+ | math_control_fraction_rule \
+ | math_control_accent_skew_half \
+ | math_control_accent_skew_apply \
+ | math_control_apply_ordinary_kern_pair \
+ | math_control_apply_vertical_italic_kern \
+ | math_control_apply_ordinary_italic_kern \
+ | math_control_apply_boxed_italic_kern \
+ | math_control_staircase_kern \
+ | math_control_apply_text_italic_kern \
+ | math_control_check_text_italic_kern \
+ | math_control_apply_script_italic_kern \
+ | math_control_analyze_script_nucleus_char \
+ | math_control_analyze_script_nucleus_list \
+ | math_control_analyze_script_nucleus_box \
+)
+
+/*tex
+ In the process of improving the math engine several intermediate features have been
+ added that were removed later. They were mostly an aid for testing but in the end it
+ made no sense to keep them around. To some extend they could enforce compatibility
+ but with most fonts being opentype now that is no longer feasible.
+
+ \starttyping
+ typedef enum math_flatten_codes {
+ math_flatten_ordinary = 0x01,
+ math_flatten_binary = 0x02,
+ math_flatten_relation = 0x04,
+ math_flatten_punctuation = 0x08,
+ math_flatten_inner = 0x10,
+ } math_flatten_codes;
+ \stoptyping
+
+*/
+
+typedef enum saved_math_items {
+ saved_math_item_direction = 0,
+ /* saved_math_item_x_scale = 1, */ /* this was an experiment */
+ /* saved_math_item_y_scale = 2, */ /* this was an experiment */
+ /* saved_math_n_of_items = 3, */
+ saved_math_n_of_items = 1,
+} saved_math_items;
+
+typedef enum saved_equation_number_items {
+ saved_equation_number_item_location = 0,
+ saved_equation_number_n_of_items = 1,
+} saved_equation_number_items;
+
+typedef enum saved_choice_items {
+ saved_choice_item_count = 0,
+ saved_choice_n_of_items = 1,
+} saved_choice_items;
+
+typedef enum saved_fraction_items {
+ saved_fraction_item_userstyle = 0,
+ saved_fraction_item_autostyle = 1,
+ saved_fraction_item_variant = 2,
+ saved_fraction_n_of_items = 3,
+} saved_fraction_items;
+
+typedef enum saved_operator_items {
+ saved_operator_item_variant = 0,
+ saved_operator_n_of_items = 1,
+} saved_operator_items;
+
+typedef enum saved_math_group_items {
+ saved_math_group_item_pointer = 0,
+ saved_math_group_all_class = 1,
+ saved_math_group_n_of_items = 2,
+} saved_math_group_items;
+
+# endif
diff --git a/source/luametatex/source/tex/texmathcodes.c b/source/luametatex/source/tex/texmathcodes.c
new file mode 100644
index 000000000..7d80eac19
--- /dev/null
+++ b/source/luametatex/source/tex/texmathcodes.c
@@ -0,0 +1,347 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ We support the traditional math codes as well as larger ones suitable for \UNICODE\ input and
+ fonts.
+
+*/
+
+/*tex the |0xFFFFFFFF| is a flag value. */
+
+# define MATHCODESTACK 8
+# define MATHCODEDEFAULT 0xFFFFFFFF
+# define MATHCODEACTIVE 0xFFFFFFFE
+
+/*tex Delcodes are also went larger. */
+
+# define DELCODESTACK 4
+# define DELCODEDEFAULT 0xFFFFFFFF
+
+typedef struct mathcode_state_info {
+ sa_tree mathcode_head;
+ sa_tree delcode_head;
+} mathcode_state_info;
+
+static mathcode_state_info lmt_mathcode_state = {
+ .mathcode_head = NULL,
+ .delcode_head = NULL,
+};
+
+/*tex
+
+ We now get lots of helpers for definitions and printing. The storage model that we use is
+ different because we can have many more so we need to be sparse. Therefore we use trees.
+
+*/
+
+# define print_hex_digit_one(A) do { \
+ if ((A) >= 10) { \
+ tex_print_char('A' + (A) - 10); \
+ } else { \
+ tex_print_char('0' + (A)); \
+ } \
+} while (0)
+
+# define print_hex_digit_two(A) do { \
+ print_hex_digit_one((A) / 16); \
+ print_hex_digit_one((A) % 16); \
+} while (0)
+
+# define print_hex_digit_four(A) do { \
+ print_hex_digit_two((A) / 256); \
+ print_hex_digit_two((A) % 256); \
+} while (0)
+
+# define print_hex_digit_six(A) do { \
+ print_hex_digit_two( (A) / 65536); \
+ print_hex_digit_two(((A) % 65536) / 256); \
+ print_hex_digit_two( (A) % 256); \
+} while (0)
+
+/* 0xFFFFF is plenty for math */
+
+mathcodeval tex_mathchar_from_integer(int value, int extcode)
+{
+ mathcodeval mval;
+ if (extcode == tex_mathcode) {
+ mval.class_value = math_old_class_part(value);
+ mval.family_value = math_old_family_part(value);
+ mval.character_value = math_old_character_part(value);
+ } else {
+ mval.class_value = math_class_part(value);
+ mval.family_value = math_family_part(value);
+ mval.character_value = math_character_part(value);
+ }
+ return mval;
+}
+
+mathcodeval tex_mathchar_from_spec(int value)
+{
+ mathcodeval mval = { 0, 0, 0 };
+ if (value) {
+ mval.class_value = math_spec_class(value);
+ mval.family_value = math_spec_family(value);
+ mval.character_value = math_spec_character(value);
+ }
+ return mval;
+}
+
+void tex_show_mathcode_value(mathcodeval mval, int extcode)
+{
+ tex_print_char('"');
+ if (extcode == tex_mathcode) {
+ print_hex_digit_one(math_old_class_mask(mval.class_value));
+ print_hex_digit_one(math_old_family_mask(mval.family_value));
+ print_hex_digit_two(math_old_character_mask(mval.character_value));
+ } else {
+ print_hex_digit_two(mval.class_value);
+ tex_print_char('"');
+ print_hex_digit_two(mval.family_value);
+ tex_print_char('"');
+ print_hex_digit_six(mval.character_value);
+ }
+}
+
+static void tex_aux_show_mathcode(int n)
+{
+ mathcodeval mval = tex_get_math_code(n);
+ tex_print_str_esc("Umathcode");
+ tex_print_int(n);
+ tex_print_char('=');
+ tex_show_mathcode_value(mval, umath_mathcode);
+}
+
+static void tex_aux_unsave_mathcode(int level)
+{
+ if (lmt_mathcode_state.mathcode_head->stack) {
+ while (lmt_mathcode_state.mathcode_head->sa_stack_ptr > 0 && abs(lmt_mathcode_state.mathcode_head->stack[lmt_mathcode_state.mathcode_head->sa_stack_ptr].level) >= level) {
+ sa_stack_item item = lmt_mathcode_state.mathcode_head->stack[lmt_mathcode_state.mathcode_head->sa_stack_ptr];
+ if (item.level > 0) {
+ sa_rawset_item_4(lmt_mathcode_state.mathcode_head, item.code, item.value_1);
+ if (tracing_restores_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_str("{restoring ");
+ tex_aux_show_mathcode(item.code);
+ tex_print_char('}');
+ tex_end_diagnostic();
+ }
+ }
+ (lmt_mathcode_state.mathcode_head->sa_stack_ptr)--;
+ }
+ }
+}
+
+mathcodeval tex_no_math_code(void)
+{
+ return (mathcodeval) { 0, 0, 0 };
+}
+
+void tex_set_math_code(int n, mathcodeval v, int level)
+{
+ sa_tree_item item;
+ if (v.class_value == active_math_class_value && v.family_value == 0 && v.character_value == 0) {
+ item.uint_value = MATHCODEACTIVE;
+ } else if (v.class_value == 0 && v.family_value == 0) {
+ /*tex This is rather safe because we don't decide on it. */
+ item.uint_value = MATHCODEDEFAULT;
+ } else {
+ item.math_code_value.class_value = v.class_value;
+ item.math_code_value.family_value = v.family_value;
+ item.math_code_value.character_value = v.character_value;
+ }
+ sa_set_item_4(lmt_mathcode_state.mathcode_head, n, item, level);
+ if (tracing_assigns_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_str("{assigning ");
+ tex_aux_show_mathcode(n);
+ tex_print_char('}');
+ tex_end_diagnostic();
+ }
+}
+
+mathcodeval tex_get_math_code(int n)
+{
+ sa_tree_item item = sa_get_item_4(lmt_mathcode_state.mathcode_head, n);
+ mathcodeval m = { 0, 0, 0 };
+ if (item.uint_value == MATHCODEDEFAULT) {
+ m.character_value = n;
+ } else if (item.uint_value == MATHCODEACTIVE) {
+ m.class_value = active_math_class_value;
+ } else if (item.math_code_value.class_value == active_math_class_value) {
+ m.class_value = active_math_class_value;
+ m.character_value = n;
+ } else {
+ m.class_value = (short) item.math_code_value.class_value;
+ m.family_value = (short) item.math_code_value.family_value;
+ m.character_value = item.math_code_value.character_value;
+ }
+ return m;
+}
+
+int tex_get_math_code_number(int n) /* should be unsigned */
+{
+ mathcodeval d = tex_get_math_code(n);
+ return math_packed_character(d.class_value, d.family_value, d.character_value);
+}
+
+static void tex_aux_initialize_mathcode(void)
+{
+ lmt_mathcode_state.mathcode_head = sa_new_tree(MATHCODESTACK, 4, (sa_tree_item) { .uint_value = MATHCODEDEFAULT });
+}
+
+static void tex_aux_dump_mathcode(dumpstream f)
+{
+ sa_dump_tree(f, lmt_mathcode_state.mathcode_head);
+}
+
+static void tex_aux_undump_mathcode(dumpstream f)
+{
+ lmt_mathcode_state.mathcode_head = sa_undump_tree(f);
+}
+
+static void tex_aux_show_delcode(int n)
+{
+ delcodeval dval = tex_get_del_code(n);
+ tex_print_str_esc("Udelcode");
+ tex_print_int(n);
+ tex_print_char('=');
+ if (tex_has_del_code(dval)) {
+ tex_print_char('"');
+ print_hex_digit_two(dval.small.family_value);
+ print_hex_digit_six(dval.small.character_value);
+ } else {
+ tex_print_str("-1");
+ }
+}
+
+static void tex_aux_unsave_delcode(int level)
+{
+ if (lmt_mathcode_state.delcode_head->stack) {
+ while (lmt_mathcode_state.delcode_head->sa_stack_ptr > 0 && abs(lmt_mathcode_state.delcode_head->stack[lmt_mathcode_state.delcode_head->sa_stack_ptr].level) >= level) {
+ sa_stack_item item = lmt_mathcode_state.delcode_head->stack[lmt_mathcode_state.delcode_head->sa_stack_ptr];
+ if (item.level > 0) {
+ sa_rawset_item_8(lmt_mathcode_state.delcode_head, item.code, item.value_1, item.value_2);
+ if (tracing_restores_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_str("{restoring ");
+ tex_aux_show_delcode(item.code);
+ tex_print_char('}');
+ tex_end_diagnostic();
+ }
+ }
+ (lmt_mathcode_state.delcode_head->sa_stack_ptr)--;
+ }
+ }
+}
+
+void tex_set_del_code(int n, delcodeval v, int level)
+{
+ sa_tree_item v1, v2; /* seldom all zero */
+ v1.math_code_value.class_value = v.small.class_value;
+ v1.math_code_value.family_value = v.small.family_value;
+ v1.math_code_value.character_value = v.small.character_value;
+ v2.math_code_value.class_value = v.large.class_value;
+ v2.math_code_value.family_value = v.large.family_value;
+ v2.math_code_value.character_value = v.large.character_value;
+ /*tex Always global! */
+ sa_set_item_8(lmt_mathcode_state.delcode_head, n, v1, v2, level);
+ if (tracing_assigns_par > 1) {
+ tex_begin_diagnostic();
+ tex_print_str("{assigning ");
+ tex_aux_show_delcode(n);
+ tex_print_char('}');
+ tex_end_diagnostic();
+ }
+}
+
+int tex_has_del_code(delcodeval d)
+{
+ return d.small.family_value >= 0;
+}
+
+delcodeval tex_no_del_code(void)
+{
+ return (delcodeval) { { 0, -1, 0 }, { 0, 0, 0} };
+}
+
+delcodeval tex_get_del_code(int n)
+{
+ sa_tree_item v2;
+ sa_tree_item v1 = sa_get_item_8(lmt_mathcode_state.delcode_head, n, &v2);
+ delcodeval d = { { 0, -1, 0 }, { 0, 0, 0} };
+ if (v1.uint_value != DELCODEDEFAULT) {
+ d.small.class_value = (short) v1.math_code_value.class_value;
+ d.small.family_value = (short) v1.math_code_value.family_value;
+ d.small.character_value = v1.math_code_value.character_value;
+ d.large.class_value = (short) v2.math_code_value.class_value;
+ d.large.family_value = (short) v2.math_code_value.family_value;
+ d.large.character_value = v2.math_code_value.character_value;
+ }
+ return d;
+}
+
+/*tex This really only works for old-style delcodes! */
+
+int tex_get_del_code_number(int n)
+{
+ delcodeval d = tex_get_del_code(n);
+ if (tex_has_del_code(d)) {
+ return ((d.small.family_value * 256 + d.small.character_value) * 4096 +
+ (d.large.family_value * 256) + d.large.character_value);
+ } else {
+ return -1;
+ }
+}
+
+static void tex_aux_initialize_delcode(void)
+{
+ lmt_mathcode_state.delcode_head = sa_new_tree(DELCODESTACK, 8, (sa_tree_item) { .uint_value = DELCODEDEFAULT });
+}
+
+static void tex_aux_dump_delcode(dumpstream f)
+{
+ sa_dump_tree(f, lmt_mathcode_state.delcode_head);
+}
+
+static void tex_aux_undump_delcode(dumpstream f)
+{
+ lmt_mathcode_state.delcode_head = sa_undump_tree(f);
+}
+
+void tex_unsave_math_codes(int grouplevel)
+{
+ tex_aux_unsave_mathcode(grouplevel);
+ tex_aux_unsave_delcode(grouplevel);
+}
+
+void tex_initialize_math_codes(void)
+{
+ tex_aux_initialize_mathcode();
+ tex_aux_initialize_delcode();
+ /*tex This might become optional: */
+ tex_set_default_math_codes();
+ tex_set_del_code('.', (delcodeval) { { 0, 0, 0, }, { 0, 0, 0 } }, level_one);
+}
+
+void tex_free_math_codes(void)
+{
+ sa_destroy_tree(lmt_mathcode_state.mathcode_head);
+ sa_destroy_tree(lmt_mathcode_state.delcode_head);
+}
+
+void tex_dump_math_codes(dumpstream f)
+{
+ tex_aux_dump_mathcode(f);
+ tex_aux_dump_delcode(f);
+}
+
+void tex_undump_math_codes(dumpstream f)
+{
+ tex_aux_undump_mathcode(f);
+ tex_aux_undump_delcode(f);
+}
diff --git a/source/luametatex/source/tex/texmathcodes.h b/source/luametatex/source/tex/texmathcodes.h
new file mode 100644
index 000000000..a45132171
--- /dev/null
+++ b/source/luametatex/source/tex/texmathcodes.h
@@ -0,0 +1,77 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_MATHCODES_H
+# define LMT_MATHCODES_H
+
+/*tex
+ We keep this special value which is used in |0x8000| so we have no real problem with 8 being
+ some other class as well. The 8 here is not really a class.
+*/
+
+# define active_math_class_value 8
+
+typedef enum mathcode_codes {
+ no_mathcode,
+ tex_mathcode,
+ umath_mathcode,
+ /* umathnum_mathcode, */
+ mathspec_mathcode
+} mathcode_codes;
+
+typedef struct mathcodeval {
+ short class_value;
+ short family_value;
+ int character_value;
+} mathcodeval;
+
+typedef struct mathdictval {
+ unsigned short properties; // 1=char 2=open 4=close 8=middle 16=middle==class
+ unsigned short group;
+ unsigned int index;
+} mathdictval;
+
+# undef small /* defined in some microsoft library */
+
+/*tex
+ Until we drop 8 bit font support we keep the small and large distinction but it might
+ go away some day as it wastes memory.
+*/
+
+typedef struct delcodeval {
+ mathcodeval small;
+ mathcodeval large;
+} delcodeval;
+
+typedef struct mathspecval {
+ mathcodeval code;
+ mathdictval dict;
+} mathspecval;
+
+extern void tex_set_math_code (int n, mathcodeval v, int gl);
+extern mathcodeval tex_get_math_code (int n);
+extern int tex_get_math_code_number (int n);
+extern mathcodeval tex_no_math_code (void);
+
+extern void tex_set_del_code (int n, delcodeval v, int gl);
+extern delcodeval tex_get_del_code (int n);
+extern int tex_get_del_code_number (int n);
+extern int tex_has_del_code (delcodeval v);
+extern delcodeval tex_no_del_code (void);
+
+extern mathcodeval tex_scan_mathchar (int extcode);
+extern mathdictval tex_scan_mathdict (void);
+extern mathcodeval tex_scan_delimiter_as_mathchar (int extcode);
+extern mathcodeval tex_mathchar_from_integer (int value, int extcode);
+extern mathcodeval tex_mathchar_from_spec (int value);
+
+extern void tex_show_mathcode_value (mathcodeval d, int extcode);
+extern void tex_unsave_math_codes (int grouplevel);
+extern void tex_initialize_math_codes (void);
+extern void tex_dump_math_codes (dumpstream f);
+extern void tex_undump_math_codes (dumpstream f);
+
+extern void tex_free_math_codes (void);
+
+# endif
diff --git a/source/luametatex/source/tex/texmlist.c b/source/luametatex/source/tex/texmlist.c
new file mode 100644
index 000000000..ac51d2c35
--- /dev/null
+++ b/source/luametatex/source/tex/texmlist.c
@@ -0,0 +1,7668 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ The code here has to deal with traditional \TEX\ fonts as well as the more modern \OPENTYPE\
+ fonts. In \TEX\ fonts the spacing between and construction of glyphs is determined by font
+ parameters, kerns, italic correction and linked lists of glyphs that make extensibles. In
+ \OPENTYPE\ fonts kerns are replaced by so called staircase kerns, italics are used differently
+ and extensibles are made from other glyphs, as in traditional \TEX\ fonts.
+
+ In traditional \TEX\ the italic correction is added to the width of the glyph. This is part of
+ the engine design and this is also reflected in the widtn metric of the font. In \OPENTYPE\ math
+ this is different. There the italic correction had more explicit usage. The 1.7 spec says:
+
+ \startitemize
+
+ \startitem
+ {\em italic correction:} When a run of slanted characters is followed by a straight
+ character (such as an operator or a delimiter), the italics correction of the last glyph is
+ added to its advance width.
+
+ When positioning limits on an N-ary operator (e.g., integral sign), the horizontal position
+ of the upper limit is moved to the right by half the italics correction, while the position
+ of the lower limit is moved to the left by the same distance. Comment HH: this is is only
+ true when we have a real italic integral where the top part stick out right and the bottom
+ part left. So, that's only 'one' n-ary operator.
+
+ When positioning superscripts and subscripts, their default horizontal positions are also
+ different by the amount of the italics correction of the preceding glyph.
+ \stopitem
+
+ \startitem
+ {\em math kerning:} Set the default horizontal position for the superscript as shifted
+ relative to the position of the subscript by the italics correction of the base glyph.
+ \stopitem
+
+ \stopitemize
+
+ Before this was specified we had to gamble a bit and assume that cambria was the font
+ benchmark and trust our eyes (and msword) for the logic. I must admit that I have been
+ fighting these italics in fonts (and the heuristics that \LUAMETATEX\ provided) right from the
+ start (for instance by using \LUA\ based postprocessing) but by now we know more and have more
+ fonts to test with. More fonts are handy because not all fonts are alike when it comes to
+ italics. Axis are another area of concern, as it looks like \OPENTYPE\ math fonts often already
+ apply that shift.
+
+ Now, one can think of cheating. Say that we add the italic correction to the widths and then
+ make the italic correction zero for all these shapes except those that have a slope, in which
+ case we negate tot correction. Unfortunately that doesn't work well because the traditional
+ code path {\em assumes} the too narrow shape: it doesn't compensate subscripts. Also, keep in
+ mind that in for instance Pagella (etc), at least in the pre 2022 versions, even upright
+ characters have italic corrections! It looks like they are used as kerns in a way similar to
+ staircase kerns. So, here, when we add the correction we incorrectly flag it as italic but we
+ have no way to distinguish them from regular kerns. When the gyre fonts never get corrected
+ we're stick with the two code paths forever.
+
+ Blocking italic correction via the glyph options is supported (not yet for other constructs
+ but that might happen). All this italic stuff makes the source a bit messy. Maybe the other
+ things will be controlled via a noad option.
+
+ The above description is no longer accurate but we keep it for historic reasons. We now
+ follow a reverse approach: we just assume \OPENTYPE\ but also expect the needed features to
+ be enabled explicitly. That means that for instance \quote {out of the box} the engine will
+ not apply italic correction.
+
+ In 2021-2022 Mikael Sundqvist and I (Hans Hagen) spent about a year investigating how we could
+ improve the rendering of math. Quite a bit of research went into that and we decided to get rid
+ of some old font code and concentrate on the \OPENTYPE\ fonts, although we found some flaws and
+ inconsistencies in them. The solution was to assume a Cambria alike font and adapt the other
+ fonts runtime using so called goodie files that are part of the \CONTEXT\ font loading code.
+ That way we could enforce some consistency and compentate for e.g. problematic dimensions like
+ widths and italic corrections as well as bad top accents and values of font parameters that
+ interfered with what we had in mind. We added plenty extra ones as well as extra kern options.
+ Combined with a more rich model for inter atom spacing we could improve the look and feel a lot.
+
+ When the engine got updated a couple of options came and went. An example of this is delimiter
+ options. For instance we tracked if a delimiter was actually changes and could then react to that
+ wrt italic corrections. In the new approach we no longer handle that because assume decent fonts
+ or at least tweaked ones (read: \CONTEXT\ font goodies being applied). So in the end those extra
+ delimiter options got removed or were just handled by the noad options. The code is still in the
+ repository. Also some options related to tracing injected kerns became defaults because we had
+ them always turned on.
+
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ We have some more function calls and local so we have replace |cur_style| by |style| where that
+ makes sense. The same is true for some local variables. This makes it a bit easier to
+ distinguish with the more global variables stored in state structures.
+
+ It's a stepwise process ... occasionally I visit this file and change the short variable names
+ to more verbose. There is also relatively new scaling code that needs checking.
+
+*/
+
+static void tex_aux_append_hkern_to_box_list (halfword q, scaled delta, halfword subtype, const char *trace);
+static void tex_aux_prepend_hkern_to_box_list(halfword q, scaled delta, halfword subtype, const char *trace);
+
+/*tex
+
+ \LUAMETATEX\ makes a bunch of extensions cf.\ the |MATH| table in \OPENTYPE, but some of the
+ |MathConstants| values have no matching usage in \LUAMETATEX\ right now.
+
+ \startitemize
+
+ \startitem
+ |ScriptPercentScaleDown| |ScriptScriptPercentScaleDown|: These should be handled by the
+ macro package, on the engine side there are three separate fonts.
+ \stopitem
+
+ \startitem
+ |DelimitedSubFormulaMinHeight|: This is perhaps related to word's natural math input?
+ We have no idea what to do about it.
+ \stopitem
+
+ \startitem
+ |MathLeading|: \LUAMETATEX\ does not currently handle multi line displays, and the
+ parameter does not seem to make much sense elsewhere.
+ \stopitem
+
+ \startitem
+ |FlattenedAccentBaseHeight|: This is based on the |flac| |GSUB| feature. It would not
+ be hard to support that, but proper math accent placements cf.\ |MATH| needs support
+ for |MathTopAccentAttachment| table to be implemented first.
+ \stopitem
+
+ \stopitemize
+
+ Old-style fonts do not define the |radical_rule|. This allows |make_radical| to select the
+ backward compatibility code, but it also means that we can't raise an error here.
+
+ Occasionally I visit this file and make some variables more verbose.
+
+ In the meantime some experimental and in the meantime obsolete code has been removed but it can
+ be found in the development repository if really needed. It makes no sense to keep code around
+ that has been replaced or improved otherwise. Some code we keep commented for a while before it
+ is flushed out.
+
+*/
+
+typedef struct scriptdata {
+ halfword node;
+ halfword fnt;
+ halfword chr;
+ halfword box;
+ scaled kern;
+ scaled slack;
+ int shifted;
+ int padding;
+} scriptdata;
+
+typedef struct delimiterextremes {
+ scaled tfont;
+ scaled tchar;
+ scaled bfont;
+ scaled bchar;
+ scaled height;
+ scaled depth;
+} delimiterextremes;
+
+typedef enum limits_modes {
+ limits_unknown_mode,
+ limits_vertical_mode, // limits
+ limits_horizontal_mode, // no limits
+} limits_modes;
+
+inline void tex_math_wipe_kerns(kernset *kerns) {
+ if (kerns) {
+ kerns->topright = 0;
+ kerns->topleft = 0;
+ kerns->bottomright = 0;
+ kerns->bottomleft = 0;
+ kerns->height = 0;
+ kerns->depth = 0;
+ kerns->toptotal = 0;
+ kerns->bottomtotal = 0;
+ }
+}
+
+inline void tex_math_copy_kerns(kernset *kerns, kernset *parent) {
+ if (kerns && parent) {
+ kerns->topright = parent->topright;
+ kerns->topleft = parent->topleft;
+ kerns->bottomright = parent->bottomright;
+ kerns->bottomleft = parent->bottomleft;
+ kerns->height = parent->height;
+ kerns->depth = parent->depth;
+ kerns->toptotal = parent->toptotal;
+ kerns->bottomtotal = parent->bottomtotal;
+ }
+}
+
+/*tex
+
+ When the style changes, the following piece of program computes associated information:
+
+*/
+
+inline static halfword tex_aux_set_style_to_size(halfword style)
+{
+ switch (style) {
+ case script_style:
+ case cramped_script_style:
+ return script_size;
+ case script_script_style:
+ case cramped_script_script_style:
+ return script_script_size;
+ default:
+ return text_size;
+ }
+}
+
+inline static void tex_aux_set_current_math_scale(halfword scale)
+{
+ glyph_scale_par = scale;
+ lmt_math_state.scale = glyph_scale_par;
+}
+
+inline static void tex_aux_set_current_math_size(halfword style)
+{
+ lmt_math_state.size = tex_aux_set_style_to_size(style);
+}
+
+inline static void tex_aux_make_style(halfword current, halfword *current_style, halfword *current_mu)
+{
+ halfword style = node_subtype(current);
+ switch (style) {
+ case scaled_math_style:
+ tex_aux_set_current_math_scale(style_scale(current));
+ break;
+ default:
+ if (is_valid_math_style(style)) {
+ if (current_style) {
+ *current_style = style;
+ }
+ tex_aux_set_current_math_size(style);
+ if (current_mu) {
+ *current_mu = scaledround(tex_get_math_quad_style(style) / 18.0);
+ }
+ }
+ break;
+ }
+}
+
+void tex_set_math_text_font(halfword style, int usetextfont)
+{
+ halfword size = tex_aux_set_style_to_size(style);
+ halfword font = tex_fam_fnt(cur_fam_par, size);
+ halfword scale = tex_get_math_font_scale(font, size);
+ switch (usetextfont) {
+ case math_atom_text_font_option:
+ scale = scaledround((double) scale * lmt_font_state.fonts[font]->size / lmt_font_state.fonts[cur_font_par]->size);
+ break;
+ case math_atom_math_font_option:
+ update_tex_font(0, font);
+ break;
+ }
+ update_tex_glyph_scale(scale);
+}
+
+static halfword tex_aux_math_penalty_what(int pre, halfword cls, halfword pre_code, halfword post_code)
+{
+ halfword value = count_parameter(pre ? (pre_code + cls) : (post_code + cls));
+ if (value == infinite_penalty) {
+ unsigned parent = (unsigned) count_parameter(first_math_parent_code + cls);
+ cls = pre ? ((parent >> 8) & 0xFF) : (parent & 0xFF);
+ if (! valid_math_class_code(cls)) {
+ return infinite_penalty;
+ }
+ value = count_parameter(pre ? (pre_code + cls) : (post_code + cls));
+ }
+ return value;
+}
+
+static halfword tex_aux_math_penalty(int main_style, int pre, halfword cls)
+{
+ switch (main_style) {
+ case display_style:
+ case cramped_display_style:
+ {
+ halfword value = tex_aux_math_penalty_what(pre, cls, first_math_display_pre_penalty_code, first_math_display_post_penalty_code);
+ if (value != infinite_penalty) {
+ return value;
+ } else {
+ break;
+ }
+ }
+ }
+ return tex_aux_math_penalty_what(pre, cls, first_math_pre_penalty_code, first_math_post_penalty_code);
+}
+
+inline static scaled limited_scaled(long l) {
+ if (l > max_dimen) {
+ return max_dimen;
+ } else if (l < -max_dimen) {
+ return -max_dimen;
+ } else {
+ return (scaled) l;
+ }
+}
+
+inline static scaled limited_rounded(double d) {
+ long l = scaledround(d);
+ if (l > max_dimen) {
+ return max_dimen;
+ } else if (l < -max_dimen) {
+ return -max_dimen;
+ } else {
+ return (scaled) l;
+ }
+}
+
+// inline static int tex_aux_has_opentype_metrics(halfword f)
+// {
+// return font_math_parameter_count(f) > 0 && ! font_oldmath(f);
+// }
+
+inline static int tex_aux_math_engine_control(halfword fnt, halfword chr)
+{
+ if (fnt && (math_font_control_par & math_control_use_font_control) == math_control_use_font_control) {
+ /*tex
+ This is only for old fonts and it might go away eventually. Not all control options relate to
+ a font.
+ */
+ return (font_mathcontrol(fnt) & chr) == chr;
+ }
+ return (math_font_control_par & chr) == chr;
+}
+
+/*
+
+ Todo: When we pass explicit dimensions (keyword driven) we use a different helper so that, if
+ needed we can add debug messages. These values {\em are} scaled according to the glyph scaling
+ so basically they are relative measures. Maybe we need an extra parameter to control this.
+
+*/
+
+inline static scaled tex_aux_math_glyph_scale(scaled v)
+{
+ return v ? scaledround(0.001 * glyph_scale_par * v) : 0;
+}
+
+inline static scaled tex_aux_math_x_scaled(scaled v, int style)
+{
+ scaled scale = tex_get_math_parameter(style, math_parameter_x_scale, NULL);
+ return v ? limited_rounded(0.000000001 * glyph_scale_par * glyph_x_scale_par * v * scale) : 0;
+}
+
+inline static scaled tex_aux_math_given_x_scaled(scaled v)
+{
+ return v;
+}
+
+/* used for math_operator_size */
+
+inline static scaled tex_aux_math_y_scaled(scaled v, int style)
+{
+ scaled scale = tex_get_math_parameter(style, math_parameter_y_scale, NULL);
+ return v ? limited_rounded(0.000000001 * glyph_scale_par * glyph_y_scale_par * v * scale) : 0;
+}
+
+inline static scaled tex_aux_math_given_y_scaled(scaled v)
+{
+ return v;
+}
+
+inline static scaled tex_aux_math_axis(halfword size)
+{
+ scaled a = tex_math_axis_size(size); /* already scaled to size and x_scale */
+ return a ? limited_rounded(0.000001 * glyph_scale_par * glyph_y_scale_par * a) : 0;
+}
+
+inline static scaled tex_aux_math_x_size_scaled(halfword f, scaled v, halfword size)
+{
+ return v ? limited_rounded(0.000000001 * tex_get_math_font_scale(f, size) * glyph_scale_par * glyph_x_scale_par * v) : 0;
+}
+
+inline static scaled tex_aux_math_y_size_scaled(halfword f, scaled v, halfword size)
+{
+ return v ? limited_rounded(0.000000001 * tex_get_math_font_scale(f, size) * glyph_scale_par * glyph_y_scale_par * v) : 0;
+}
+
+halfword tex_math_font_char_ht(halfword fnt, halfword chr, halfword style)
+{
+ return tex_aux_math_y_size_scaled(fnt, tex_char_height_from_font(fnt, chr), tex_aux_set_style_to_size(style));
+}
+
+halfword tex_math_font_char_dp(halfword fnt, halfword chr, halfword style)
+{
+ return tex_aux_math_y_size_scaled(fnt, tex_char_depth_from_font(fnt, chr), tex_aux_set_style_to_size(style));
+}
+
+inline static halfword tex_aux_new_math_glyph(halfword fnt, halfword chr, quarterword subtype) {
+ halfword scale = 1000;
+ halfword glyph = tex_new_glyph_node(subtype, fnt, tex_get_math_char(fnt, chr, lmt_math_state.size, &scale), null); /* todo: data */;
+ set_glyph_options(glyph, glyph_options_par);
+ glyph_scale(glyph) = tex_aux_math_glyph_scale(scale);
+ glyph_x_scale(glyph) = glyph_x_scale_par;
+ glyph_y_scale(glyph) = glyph_y_scale_par;
+ glyph_protected(glyph) = glyph_protected_math_code;
+ return glyph;
+}
+
+halfword tex_new_math_glyph(halfword fnt, halfword chr) {
+ return tex_aux_new_math_glyph(fnt, chr, 0);
+}
+
+static void tex_aux_trace_kerns(halfword kern, const char *what, const char *detail)
+{
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: %s, %s, amount %D]", what, detail, kern_amount(kern), pt_unit);
+ tex_end_diagnostic();
+ }
+}
+
+static halfword tex_aux_math_insert_font_kern(halfword current, scaled amount, halfword template, const char *trace)
+{
+ /*tex Maybe |math_font_kern|, also to prevent expansion. */
+ halfword kern = tex_new_kern_node(amount, font_kern_subtype);
+ tex_attach_attribute_list_copy(kern, template ? template : current);
+ if (node_next(current)) {
+ tex_couple_nodes(kern, node_next(current));
+ }
+ tex_couple_nodes(current, kern);
+ tex_aux_trace_kerns(kern, "adding font kern", trace);
+ return kern;
+}
+
+static halfword tex_aux_math_insert_italic_kern(halfword current, scaled amount, halfword template, const char *trace)
+{
+ /*tex Maybe |math_italic_kern|. */
+ halfword kern = tex_new_kern_node(amount, italic_kern_subtype);
+ tex_attach_attribute_list_copy(kern, template ? template : current);
+ if (node_next(current)) {
+ tex_couple_nodes(kern, node_next(current));
+ }
+ tex_couple_nodes(current, kern);
+ tex_aux_trace_kerns(kern, "adding italic kern", trace);
+ return kern;
+}
+
+static int tex_aux_math_followed_by_italic_kern(halfword current, const char *trace)
+{
+ if (current) {
+ halfword next = node_next(current);
+ if (next && node_type(next) == kern_node && node_subtype(next) == italic_kern_subtype) {
+ tex_aux_trace_kerns(next, "ignoring italic kern", trace);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static inline int tex_aux_checked_left_kern_fnt_chr(halfword fnt, halfword chr, halfword state, halfword subtype)
+{
+ halfword top = 0;
+ halfword bot = 0;
+ halfword hastop = (state & prime_script_state) || (state & post_super_script_state);
+ halfword hasbot = state & post_sub_script_state;
+ if (hastop && tex_math_has_class_option(subtype, left_top_kern_class_option)) {
+ top = tex_char_top_left_kern_from_font(fnt, chr);
+ }
+ if (hasbot && tex_math_has_class_option(subtype, left_bottom_kern_class_option)) {
+ bot = tex_char_bottom_left_kern_from_font(fnt, chr);
+ }
+ if (hastop && hasbot) {
+ return top > bot ? top : bot;
+ } else if (hastop) {
+ return top;
+ } else {
+ return bot;
+ }
+}
+
+static inline int tex_aux_checked_left_kern(halfword list, halfword state, halfword subtype)
+{
+ if (list && node_type(list) == glyph_node) {
+ return tex_aux_checked_left_kern_fnt_chr(glyph_font(list), glyph_character(list), state, subtype);
+ } else {
+ return 0;
+ }
+}
+
+static inline int tex_aux_checked_right_kern_fnt_chr(halfword fnt, halfword chr, halfword state, halfword subtype)
+{
+ halfword top = 0;
+ halfword bot = 0;
+ halfword hastop = state & pre_super_script_state;
+ halfword hasbot = state & pre_sub_script_state;
+ if (hastop && tex_math_has_class_option(subtype, right_top_kern_class_option)) {
+ top = tex_char_top_right_kern_from_font(fnt, chr);
+ }
+ if (hasbot && tex_math_has_class_option(subtype, right_bottom_kern_class_option)) {
+ bot = tex_char_bottom_right_kern_from_font(fnt, chr);
+ }
+ if (hastop && hasbot) {
+ return top < bot ? bot : top;
+ } else if (hastop) {
+ return top;
+ } else {
+ return bot;
+ }
+}
+
+static inline int tex_aux_checked_right_kern(halfword list, halfword state, halfword subtype)
+{
+ if (list && node_type(list) == glyph_node) {
+ return tex_aux_checked_right_kern_fnt_chr(glyph_font(list), glyph_character(list), state, subtype);
+ } else {
+ return 0;
+ }
+}
+
+/*tex We no longer need this one:
+
+ \starttyping
+ static halfword tex_aux_math_remove_italic_kern(halfword head, scaled *italic, const char *trace)
+ {
+ halfword tail = tex_tail_of_node_list(box_list(head));
+ if (tail && node_type(tail) == kern_node && node_subtype(tail) == italic_kern_subtype && kern_amount(tail) == *italic) {
+ tex_aux_trace_kerns(tail, "removing italic kern", trace);
+ if (head == tail) {
+ head = null;
+ } else {
+ head = node_prev(tail);
+ node_next(node_prev(tail)) = null;
+ }
+ tex_flush_node(tail);
+ *italic = 0;
+ }
+ return head;
+ }
+ \starttyping
+
+*/
+
+/*tex We no longer need this one:
+
+ \starttyping
+ static void tex_aux_normalize_delimiters(halfword l, halfword r)
+ {
+ if (box_width(l) == null_delimiter_space_par) {
+ box_height(l) = box_height(r);
+ box_depth(l) = box_depth(r);
+ box_shift_amount(l) = box_shift_amount(r);
+ } else if (box_width(r) == null_delimiter_space_par) {
+ box_height(r) = box_height(l);
+ box_depth(r) = box_depth(l);
+ box_shift_amount(r) = box_shift_amount(l);
+ }
+ }
+ \starttyping
+
+*/
+
+static scaled tex_aux_check_rule_thickness(halfword target, int size, halfword *fam, halfword control, halfword param)
+{
+ /* if (math_rule_thickness_mode_par > 0) { */
+ halfword family = noad_family(target);
+ if (family != unused_math_family) {
+ halfword font = tex_fam_fnt(family, size);
+ if (tex_aux_math_engine_control(font, control)) {
+ scaled thickness = tex_get_font_math_parameter(font, size, param);
+ if (thickness != undefined_math_parameter) {
+ *fam = family;
+ return thickness;
+ }
+ }
+ }
+ /* } */
+ return undefined_math_parameter;
+}
+
+/*tex Fake character */
+
+static halfword tex_aux_fake_nucleus(quarterword cls)
+{
+ halfword n = tex_new_node(simple_noad, cls);
+ halfword q = tex_new_node(math_char_node, 0);
+ set_noad_classes(n, cls);
+ noad_nucleus(n) = q;
+ return n;
+}
+
+/*tex For tracing purposes we add a kern instead of just adapting the width. */
+
+static void tex_aux_fake_delimiter(halfword result)
+{
+ halfword amount = tex_aux_math_given_x_scaled(null_delimiter_space_par);
+ if (amount) {
+ box_width(result) = amount;
+ box_list(result) = tex_new_kern_node(amount, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(box_list(result), result);
+ }
+}
+
+/*tex
+ A variant on a suggestion on the list based on analysis by Ulrik Vieth it in the mean
+ adapted. We keep these 500 and 2 because then we can use similar values.
+*/
+
+static scaled tex_aux_get_delimiter_height(scaled height, scaled depth, int axis, int size, int style)
+{
+ scaled delta1 = height + depth;
+ scaled delta2 = depth;
+ scaled delta3 = 0;
+ halfword percent = tex_get_math_parameter_default(style, math_parameter_delimiter_percent, 0);
+ scaled shortfall = tex_get_math_y_parameter_default(style, math_parameter_delimiter_shortfall, 0);
+ if (axis) {
+ delta2 += tex_aux_math_axis(size);
+ }
+ delta1 -= delta2;
+ if (delta2 > delta1) {
+ /*tex |delta1| is max distance from axis */
+ delta1 = delta2;
+ }
+ delta3 = scaledround((delta1 / 500.0) * delimiter_factor_par * (percent / 100.0));
+ delta2 = 2 * delta1 - delimiter_shortfall_par - shortfall;
+ return (delta3 < delta2) ? delta2 : delta3;
+}
+
+/*tex
+
+ In order to convert mlists to hlists, i.e., noads to nodes, we need several subroutines that
+ are conveniently dealt with now.
+
+ Let us first introduce the macros that make it easy to get at the parameters and other font
+ information. A size code, which is a multiple of 256, is added to a family number to get an
+ index into the table of internal font numbers for each combination of family and size. (Be
+ alert: size codes get larger as the type gets smaller.) In the meantime we use different
+ maxima and packing as in \LUATEX.
+
+*/
+
+static const char *tex_aux_math_size_string(int s)
+{
+ switch (s) {
+ case script_script_size: return "scriptscriptfont";
+ case script_size: return "scriptfont";
+ default: return "textfont";
+ }
+}
+
+/*tex Here is a simple routine that creates a flat copy of a nucleus. */
+
+static halfword tex_aux_math_clone(halfword n)
+{
+ if (n) {
+ halfword result = tex_new_node(node_type(n), 0);
+ tex_attach_attribute_list_copy(result, n);
+ tex_math_copy_char_data(result, n, 0);
+ return result;
+ } else {
+ return null;
+ }
+}
+
+/*tex
+ A helper used in void or phantom situations. We replace the content by a rule so that we still
+ have some content (handy for tracing).
+*/
+
+static halfword tex_aux_make_list_phantom(halfword source, int nowidth, halfword att)
+{
+ halfword target = null;
+ switch (node_type(source)) {
+ case hlist_node:
+ target = tex_new_node(hlist_node, node_subtype(source));
+ break;
+ case vlist_node:
+ target = tex_new_node(vlist_node, node_subtype(source));
+ break;
+ }
+ if (target) {
+ halfword rule = tex_new_rule_node(empty_rule_subtype);
+ tex_attach_attribute_list_attribute(target, att);
+ tex_attach_attribute_list_attribute(rule, att);
+ rule_width(rule) = nowidth ? 0 : box_width(source);
+ rule_height(rule) = box_height(source);
+ rule_depth(rule) = box_depth(source);
+ box_dir(target) = dir_lefttoright ;
+ box_height(target) = rule_height(rule);
+ box_depth(target) = rule_depth(rule);
+ box_width(target) = rule_width(rule);
+ box_shift_amount(target) = box_shift_amount(source);
+ box_list(target) = rule;
+ tex_flush_node_list(source);
+ return target;
+ } else {
+ return source;
+ }
+}
+
+/*tex
+
+ Here is a function that returns a pointer to a rule node having a given thickness |t|. The rule
+ will extend horizontally to the boundary of the vlist that eventually contains it.
+
+*/
+
+static halfword tex_aux_fraction_rule(scaled width, scaled height, halfword att, quarterword ruletype, halfword size, halfword fam)
+{
+ halfword rule = null;
+ int callback_id = lmt_callback_defined(math_rule_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "ddddN->N", math_rules_mode_par ? ruletype : normal_rule_subtype, tex_fam_fnt(fam, size), width, height, att, &rule);
+ if (rule && node_type(rule) != hlist_node) {
+ rule = tex_hpack(rule, 0, packing_additional, direction_unknown, holding_none_option);
+ node_subtype(rule) = math_rule_list;
+ tex_attach_attribute_list_attribute(rule, att);
+ }
+ }
+ if (! rule) {
+ if (math_rules_mode_par) {
+ rule = tex_new_rule_node(ruletype);
+ rule_data(rule) = tex_fam_fnt(fam, size);
+ } else {
+ rule = tex_new_rule_node(normal_rule_subtype);
+ }
+ rule_height(rule) = height;
+ rule_depth(rule) = 0;
+ tex_attach_attribute_list_attribute(rule, att);
+ }
+ return rule;
+}
+
+/*tex
+
+ The |overbar| function returns a pointer to a vlist box that consists of a given box |b|, above
+ which has been placed a kern of height |k| under a fraction rule of thickness |t| under
+ additional space of height |ht|.
+
+*/
+
+static halfword tex_aux_overbar(halfword box, scaled gap, scaled height, scaled krn, halfword att, quarterword index, halfword size, halfword fam)
+{
+ halfword rule = tex_aux_fraction_rule(box_width(box), height, att, index, size, fam);
+ if (gap) {
+ halfword kern = tex_new_kern_node(gap, vertical_math_kern_subtype);
+ tex_attach_attribute_list_attribute(kern, att);
+ tex_couple_nodes(kern, box);
+ tex_couple_nodes(rule, kern);
+ } else {
+ tex_couple_nodes(rule, box);
+ }
+ if (krn) {
+ halfword kern = tex_new_kern_node(krn, vertical_math_kern_subtype);
+ tex_attach_attribute_list_attribute(kern, att);
+ tex_couple_nodes(kern, rule);
+ rule = kern;
+ }
+ rule = tex_vpack(rule, 0, packing_additional, max_dimen, (singleword) math_direction_par, holding_none_option);
+ tex_attach_attribute_list_attribute(rule, att);
+ return rule;
+}
+
+static halfword tex_aux_underbar(halfword box, scaled gap, scaled height, scaled krn, halfword att, quarterword index, halfword size, halfword fam)
+{
+ halfword rule = tex_aux_fraction_rule(box_width(box), height, att, index, size, fam);
+ if (gap) {
+ halfword kern = tex_new_kern_node(gap, vertical_math_kern_subtype);
+ tex_attach_attribute_list_attribute(kern, att);
+ tex_couple_nodes(box, kern);
+ tex_couple_nodes(kern, rule);
+ } else {
+ tex_couple_nodes(box, rule);
+ }
+ if (krn) {
+ halfword kern = tex_new_kern_node(krn, vertical_math_kern_subtype);
+ tex_attach_attribute_list_attribute(kern, att);
+ tex_couple_nodes(rule, kern);
+ }
+ rule = tex_vpack(box, 0, packing_additional, max_dimen, (singleword) math_direction_par, holding_none_option);
+ tex_attach_attribute_list_attribute(rule, att);
+ /* */
+ box_depth(rule) = box_total(rule) + krn - box_height(box);
+ box_height(rule) = box_height(box);
+ /* */
+ return rule;
+}
+
+/*tex
+
+ Here is a subroutine that creates a new box, whose list contains a single character, and whose
+ width includes the italic correction for that character. The height or depth of the box will be
+ negative, if the height or depth of the character is negative. Thus, this routine may deliver a
+ slightly different result than |hpack| would produce.
+
+ The oldmath font flag can be used for cases where we pass a new school math constants (aka
+ parameters) table but have a (virtual) font assembled that uses old school type one fonts. In
+ that case we have a diffeent code path for:
+
+ \startitemize
+ \startitem rule thickness \stopitem
+ \startitem accent skew \stopitem
+ \startitem italic correction (normal width assumes it to be added) \stopitem
+ \startitem kerning \stopitem
+ \startitem delimiter construction \stopitem
+ \startitem accent placement \stopitem
+ \stopitemize
+
+ In the traditional case an italic kern is always added and the |ic| variable is then passed
+ to the caller. For a while we had an option to add the correction to the width but now we
+ have the control options. So these are the options:
+
+ - traditional: insert a kern and pass that correction.
+ - opentype : traditional_math_char_italic_width: add to width
+ - : traditional_math_char_italic_pass : pass ic
+
+ Adding a kern in traditional mode is a mode driven option, not a font one.
+
+*/
+
+static halfword tex_aux_char_box(halfword fnt, int chr, halfword att, scaled *ic, quarterword subtype, scaled target, int style)
+{
+ /*tex The new box and its character node. */
+ halfword glyph = tex_aux_new_math_glyph(fnt, chr, subtype);
+ halfword box = tex_new_null_box_node(hlist_node, math_char_list);
+ scaledwhd whd = tex_char_whd_from_glyph(glyph);
+ tex_attach_attribute_list_attribute(glyph, att);
+ tex_attach_attribute_list_attribute(box, att);
+ box_width(box) = whd.wd;
+ box_height(box) = whd.ht;
+ box_depth(box) = whd.dp;
+ box_list(box) = glyph;
+ if (tex_has_glyph_option(glyph, glyph_option_no_italic_correction)) {
+ whd.ic = 0;
+ }
+ if (whd.ic) {
+ if (ic) {
+ *ic = whd.ic; /* also in open type? needs checking */
+ }
+ if (tex_aux_math_engine_control(fnt, math_control_apply_char_italic_kern)) {
+ tex_aux_math_insert_italic_kern(glyph, whd.ic, glyph, "box");
+ box_width(box) += whd.ic;
+ } else {
+ return box;
+ }
+ } else if (ic) {
+ *ic = 0;
+ }
+ if (target && whd.wd < target && tex_char_has_tag_from_font(fnt, chr, extend_last_tag)) {
+ scaled margin = tex_get_math_x_parameter_default(style, math_parameter_accent_extend_margin, 0);
+ scaled amount = target - 2 * margin;
+ glyph_x_scale(glyph) = lround((double) glyph_x_scale(glyph) * amount/whd.wd);
+ glyph_x_offset(glyph) = (whd.wd - amount)/2;
+ }
+ return box;
+}
+
+/*tex
+
+ When we build an extensible character, it's handy to have the following subroutine, which puts
+ a given character on top of the characters already in box |b|:
+
+*/
+
+// static scaled tex_aux_stack_into_box(halfword b, halfword f, int c, quarterword subtype, int horiziontal)
+// {
+// /*tex New node placed into |b|. Italic gets added to width in 8 bit fonts. */
+// halfword boxed = tex_aux_char_box(f, c, get_attribute_list(b), NULL, subtype);
+// halfword glyph = box_list(boxed);
+// if (horiziontal) {
+// halfword list = box_list(b);
+// if (list) {
+// tex_couple_nodes(tex_tail_of_node_list(list), boxed);
+// } else {
+// box_list(b) = boxed;
+// }
+// if (box_height(b) < box_height(boxed)) {
+// box_height(b) = box_height(boxed);
+// }
+// if (box_depth(b) < box_depth(boxed)) {
+// box_depth(b) = box_depth(boxed);
+// }
+// return tex_char_width_from_glyph(glyph);
+// } else {
+// tex_try_couple_nodes(boxed, box_list(b));
+// box_list(b) = boxed;
+// box_height(b) = box_height(boxed);
+// if (box_width(b) < box_width(boxed)) {
+// box_width(b) = box_width(boxed);
+// }
+// return tex_char_total_from_glyph(glyph);
+// }
+// }
+
+/*tex
+ There is no need to deal with an italic correction here. If there is one in an extensible we
+ have a real weird font! So in this version we don't end up with a redicoulous amount of hlists
+ in a horizontal extensible with is nicer when we trace. Actualy, the only extensibles that are
+ italic are integrals and these are not in traditional fonts.
+
+ We only got a warning with Lucida that has italic correction on the begin and end glyphs of
+ integrals and it looks real bad it we add that, so now we don't even warn any more and just
+ ignore it.
+*/
+
+static scaled tex_aux_stack_char_into_box(halfword box, halfword fnt, int chr, quarterword subtype, int horiziontal)
+{
+ halfword glyph = tex_aux_new_math_glyph(fnt, chr, subtype);
+ scaledwhd whd = tex_char_whd_from_glyph(glyph);
+ halfword list = box_list(box);
+ tex_attach_attribute_list_attribute(glyph, get_attribute_list(box));
+ if (horiziontal) {
+ if (list) {
+ tex_couple_nodes(tex_tail_of_node_list(list), glyph);
+ } else {
+ box_list(box) = glyph;
+ }
+ if (box_height(box) < whd.ht) {
+ box_height(box) = whd.ht;
+ }
+ if (box_depth(box) < whd.dp) {
+ box_depth(box) = whd.dp;
+ }
+ // if (whd.ic) {
+ // tex_print_message("italic correction found in horizontal delimiter parts, needs checking");
+ // }
+ return whd.wd;
+ } else {
+ halfword boxed = tex_new_null_box_node(hlist_node, math_char_list);
+ tex_attach_attribute_list_attribute(boxed, get_attribute_list(box));
+ box_width(boxed) = whd.wd;
+ box_height(boxed) = whd.ht;
+ box_depth(boxed) = whd.dp;
+ box_list(boxed) = glyph;
+ tex_try_couple_nodes(boxed, list);
+ box_list(box) = boxed;
+ // box_height(b) = box_height(boxed);
+ if (box_width(box) < whd.wd) {
+ box_width(box) = whd.wd;
+ }
+ // if (whd.ic) {
+ // tex_print_message("italic correction found in vertical delimiter parts, needs checking");
+ // }
+ return whd.ht + whd.dp;
+ }
+}
+
+static void tex_aux_stack_glue_into_box(halfword box, scaled min, scaled max) {
+ halfword glue = tex_new_glue_node(zero_glue, user_skip_glue); /* todo: subtype, correction_skip_glue? */
+ glue_amount(glue) = min;
+ glue_stretch(glue) = max - min;
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ tex_attach_attribute_list_copy(glue, box);
+ if (node_type(box) == vlist_node) {
+ tex_try_couple_nodes(glue, box_list(box));
+ box_list(box) = glue;
+ } else {
+ halfword list = box_list(box);
+ if (list) {
+ tex_couple_nodes(tex_tail_of_node_list(list), glue);
+ } else {
+ box_list(box) = glue;
+ }
+ }
+}
+
+/*tex
+
+ \TEX's most important routine for dealing with formulas is called |mlist_to_hlist|. After a
+ formula has been scanned and represented as an mlist, this routine converts it to an hlist that
+ can be placed into a box or incorporated into the text of a paragraph. The explicit parameter
+ |cur_mlist| points to the first node or noad in the given mlist (and it might be |null|). The
+ parameter |penalties| is |true| if penalty nodes for potential line breaks are to be inserted
+ into the resulting hlist, the parameter |cur_style| is a style code. After |mlist_to_hlist| has
+ acted, |vlink (temp_head)| points to the translated hlist.
+
+ Since mlists can be inside mlists, the procedure is recursive. And since this is not part of
+ \TEX's inner loop, the program has been written in a manner that stresses compactness over
+ efficiency. (This is no longer always true in \LUAMETATEX.)
+
+*/
+
+static halfword tex_aux_top_extensible_from_box(halfword e)
+{
+ if (node_type(e) == vlist_node && node_subtype(e) == math_v_extensible_list) {
+ e = box_list(e);
+ while (e) {
+ if (node_type(e) == hlist_node && box_list(e) && node_type(box_list(e)) == glyph_node) {
+ return box_list(e); /* hit is first */
+ } else {
+ e = node_next(e);
+ }
+ }
+ }
+ return null;
+}
+
+static halfword tex_aux_bottom_extensible_from_box(halfword e)
+{
+ halfword g = null;
+ if (node_type(e) == vlist_node && node_subtype(e) == math_v_extensible_list) {
+ e = box_list(e);
+ while (e) {
+ if (node_type(e) == hlist_node && box_list(e) && node_type(box_list(e)) == glyph_node) {
+ g = box_list(e); /* last so far */
+ }
+ e = node_next(e);
+ }
+ }
+ return g; /* hit is last */
+}
+
+static halfword tex_aux_get_delimiter_box(halfword fnt, halfword chr, scaled target, scaled minoverlap, int horizontal, halfword att)
+{
+ halfword size = lmt_math_state.size;
+ int callback_id = lmt_callback_defined(make_extensible_callback);
+ if (callback_id > 0) {
+ /*tex
+ This call is not optimized as it hardly makes sense to use it ... special
+ and a bit of feature creep too.
+ */
+ halfword boxed = null;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "ddddbNd->N", fnt, chr, target, minoverlap, horizontal, att, size, &boxed);
+ if (boxed) {
+ switch (node_type(boxed)) {
+ case hlist_node:
+ case vlist_node:
+ return boxed;
+ default:
+ tex_formatted_error("fonts", "invalid extensible character %i created for font %i, [h|v]list expected", chr, fnt);
+ break;
+ }
+ }
+ }
+ return tex_make_extensible(fnt, chr, target, minoverlap, horizontal, att, size);
+}
+
+halfword tex_make_extensible(halfword fnt, halfword chr, scaled target, scaled minoverlap, int horizontal, halfword att, halfword size)
+{
+ /*tex natural (maximum) size of the stack */
+ scaled max_natural = 0;
+ /*tex amount of possible shrink in the stack */
+ scaled max_shrink = 0;
+ extinfo *extensible = NULL;
+ scaled overlap;
+ /*tex a temporary counter number of extensible pieces */
+ int pieces = 0;
+ /*tex new box */
+ halfword box = tex_new_null_box_node(horizontal ? hlist_node : vlist_node, horizontal ? math_h_extensible_list : math_v_extensible_list);
+ /*tex number of times to repeat each repeatable item in |ext| */
+ int with_extenders = -1;
+ int n_of_extenders = 0;
+ int n_of_normal = 0;
+ if (minoverlap < 0) {
+ minoverlap = 0;
+ }
+ /* chr = math_char_exists(fnt, chr, math_state.size); */
+ if (horizontal) {
+ extensible = tex_char_horizontal_parts_from_font(fnt, chr);
+ } else {
+ extensible = tex_char_vertical_parts_from_font(fnt, chr);
+ }
+ tex_attach_attribute_list_attribute(box, att);
+ for (extinfo *e = extensible; e; e = e->next) {
+ if (! tex_char_exists(fnt, e->glyph)) {
+ tex_handle_error(
+ normal_error_type,
+ "Extension part doesn't exist.",
+ "Each glyph part in an extensible item should exist in the font. I will give up\n"
+ "trying to find a suitable size for now. Fix your font!"
+ );
+ tex_aux_fake_delimiter(box);
+ return box;
+ } else {
+ if (e->extender == math_extension_repeat) {
+ n_of_extenders++;
+ } else {
+ n_of_normal++;
+ }
+ /*tex
+ No negative overlaps or advances are allowed. Watch out, we patch the glyph data at
+ the \TEX\ end here.
+ */
+ if (e->start_overlap < 0 || e->end_overlap < 0 || e->advance < 0) {
+ tex_handle_error(
+ normal_error_type,
+ "Extensible recipe has negative fields.",
+ "All measurements in extensible items should be positive. To get around this\n"
+ "problem, I have changed the font metrics. Fix your font!"
+ );
+ if (e->start_overlap < 0) {
+ e->start_overlap = 0;
+ }
+ if (e->end_overlap < 0) {
+ e->end_overlap = 0;
+ }
+ if (e->advance < 0) {
+ e->advance = 0;
+ }
+ }
+ }
+ }
+ if (n_of_normal == 0) {
+ tex_handle_error(
+ normal_error_type,
+ "Extensible recipe has no fixed parts.",
+ "Each extensible recipe should have at least one non-repeatable part. To get\n"
+ "around this problem, I have changed the first part to be non-repeatable. Fix your\n"
+ "font!"
+ );
+ if (extensible) { /* get rid of warning */
+ extensible->extender = 0;
+ }
+ n_of_normal = 1;
+ n_of_extenders--;
+ }
+ /*tex
+
+ In the meantime the Microsoft Typography website has a good description of the process:
+
+ \startitemize
+ \startitem
+ Assemble all parts with all extenders removed and with connections overlapping by
+ the maximum amount. This gives the smallest possible result.
+ \stopitem
+ \startitem
+ Determine how much extra width/height can be obtained from all existing connections
+ between neighboring parts by using minimal overlaps. If that is enough to achieve
+ the size goal, extend each connection equally by changing overlaps of connectors to
+ finish the job.
+ \stopitem
+ \startitem
+ If all connections have been extended to the minimum overlap and further growth is
+ needed, add one of each extender, and repeat the process from the first step.
+ \stopitem
+ \stopitemize
+
+ Original comment: |ext| holds a linked list of numerous items that may or may not be
+ repeatable. For the total height, we have to figure out how many items are needed to create
+ a stack of at least |v|. The next |while| loop does that. It has two goals: it finds out
+ the natural height |b_max| of the all the parts needed to reach at least |v|, and it sets
+ |with_extenders| to the number of times each of the repeatable items in |ext| has to be
+ repeated to reach that height.
+
+ It's an example figure it out once, write the solution, test it well and then never look
+ back code.
+ */
+ while (max_natural < target && n_of_extenders > 0) {
+ overlap = 0;
+ max_natural = 0;
+ with_extenders++;
+ if (horizontal) {
+ for (extinfo *e = extensible; e; e = e->next) {
+ if (e->extender == 0) {
+ scaled initial = tex_aux_math_x_size_scaled(fnt, e->start_overlap, size);
+ scaled advance = tex_aux_math_x_size_scaled(fnt, e->advance, size);
+ if (minoverlap < initial) {
+ initial = minoverlap;
+ }
+ if (overlap < initial) {
+ initial = overlap;
+ }
+ if (advance == 0) {
+ /*tex for tfm fonts (so no need for scaling) */
+ advance = tex_aux_math_x_size_scaled(fnt, tex_char_width_from_font(fnt, e->glyph), size); /* todo: combine */
+ if (advance <= 0) {
+ tex_formatted_error("fonts", "bad horizontal extensible character %i in font %i", chr, fnt);
+ }
+ }
+ max_natural += advance - initial;
+ overlap = tex_aux_math_x_size_scaled(fnt, e->end_overlap, size);
+ } else {
+ pieces = with_extenders;
+ while (pieces > 0) {
+ scaled initial = tex_aux_math_x_size_scaled(fnt, e->start_overlap, size);
+ scaled advance = tex_aux_math_x_size_scaled(fnt, e->advance, size);
+ if (minoverlap < initial) {
+ initial = minoverlap;
+ }
+ if (overlap < initial) {
+ initial = overlap;
+ }
+ if (advance == 0) {
+ /*tex for tfm fonts (so no need for scaling) */
+ advance = tex_aux_math_x_size_scaled(fnt, tex_char_width_from_font(fnt, e->glyph), size); /* todo: combine */
+ if (advance <= 0) {
+ tex_formatted_error("fonts", "bad horizontal extensible character %i in font %i", chr, fnt);
+ }
+ }
+ max_natural += advance - initial;
+ overlap = tex_aux_math_x_size_scaled(fnt, e->end_overlap, size);
+ pieces--;
+ }
+ }
+ }
+ } else {
+ for (extinfo *e = extensible; e; e = e->next) {
+ if (e->extender == 0) {
+ scaled initial = tex_aux_math_y_size_scaled(fnt, e->start_overlap, size);
+ scaled advance = tex_aux_math_y_size_scaled(fnt, e->advance, size);
+ if (minoverlap < initial) {
+ initial = minoverlap;
+ }
+ if (overlap < initial) {
+ initial = overlap;
+ }
+ if (advance == 0) {
+ /*tex for tfm fonts (so no need for scaling) */
+ advance = tex_aux_math_y_size_scaled(fnt, tex_char_total_from_font(fnt, e->glyph), size); /* todo: combine */
+ if (advance <= 0) {
+ tex_formatted_error("fonts", "bad vertical extensible character %i in font %i", chr, fnt);
+ }
+ }
+ max_natural += advance - initial;
+ overlap = tex_aux_math_y_size_scaled(fnt, e->end_overlap, size);
+ } else {
+ pieces = with_extenders;
+ while (pieces > 0) {
+ scaled initial = tex_aux_math_y_size_scaled(fnt, e->start_overlap, size);
+ scaled advance = tex_aux_math_y_size_scaled(fnt, e->advance, size);
+ if (minoverlap < initial) {
+ initial = minoverlap;
+ }
+ if (overlap < initial) {
+ initial = overlap;
+ }
+ if (advance == 0) {
+ /*tex for tfm fonts (so no need for scaling) */
+ advance = tex_aux_math_y_size_scaled(fnt, tex_char_total_from_font(fnt, e->glyph), size); /* todo: combine */
+ if (advance <= 0) {
+ tex_formatted_error("fonts", "bad vertical extensible character %i in font %i", chr, fnt);
+ }
+ }
+ max_natural += advance - initial;
+ overlap = tex_aux_math_y_size_scaled(fnt, e->end_overlap, size);
+ pieces--;
+ }
+ }
+ }
+ }
+ }
+ /*tex
+ Assemble box using |with_extenders| copies of each extender, with appropriate glue wherever
+ an overlap occurs.
+ */
+ overlap = 0;
+ max_natural = 0;
+ max_shrink = 0;
+ for (extinfo *e = extensible; e; e = e->next) {
+ if (e->extender == 0) {
+ scaled progress;
+ scaled initial = horizontal ? tex_aux_math_x_size_scaled(fnt, e->start_overlap, size) : tex_aux_math_y_size_scaled(fnt,e->start_overlap, size);
+ if (overlap < initial) {
+ initial = overlap;
+ }
+ progress = initial;
+ if (minoverlap < initial) {
+ initial = minoverlap;
+ }
+ if (progress > 0) {
+ tex_aux_stack_glue_into_box(box, -progress, -initial);
+ max_shrink += (-initial) - (-progress);
+ max_natural -= progress;
+ }
+ max_natural += tex_aux_stack_char_into_box(box, fnt, e->glyph, glyph_math_extensible_subtype, horizontal);
+ overlap = horizontal ? tex_aux_math_x_size_scaled(fnt, e->end_overlap, size) : tex_aux_math_y_size_scaled(fnt, e->end_overlap, size);
+ pieces--;
+ } else {
+ pieces = with_extenders;
+ while (pieces > 0) {
+ scaled progress;
+ scaled initial = horizontal ? tex_aux_math_x_size_scaled(fnt, e->start_overlap, size) : tex_aux_math_y_size_scaled(fnt, e->start_overlap, size);
+ if (overlap < initial) {
+ initial = overlap;
+ }
+ progress = initial;
+ if (minoverlap < initial) {
+ initial = minoverlap;
+ }
+ if (progress > 0) {
+ tex_aux_stack_glue_into_box(box, -progress, -initial);
+ max_shrink += (-initial) - (-progress);
+ max_natural -= progress;
+ }
+ max_natural += tex_aux_stack_char_into_box(box, fnt, e->glyph, glyph_math_extensible_subtype, horizontal);
+ overlap = horizontal ? tex_aux_math_x_size_scaled(fnt, e->end_overlap, size) : tex_aux_math_y_size_scaled(fnt, e->end_overlap, size);
+ pieces--;
+ }
+ }
+ }
+ /*tex Set glue so as to stretch the connections if needed. */
+ if (target > max_natural && max_shrink > 0) {
+ scaled delta = target - max_natural;
+ /*tex Don't stretch more than |s_max|. */
+ if (delta > max_shrink) {
+ delta = max_shrink;
+ }
+ box_glue_order(box) = normal_glue_order;
+ box_glue_sign(box) = stretching_glue_sign;
+ box_glue_set(box) = (glueratio) (delta / (glueratio) max_shrink);
+ max_natural += delta;
+ }
+ if (horizontal) {
+ box_width(box) = max_natural;
+ node_subtype(box) = math_h_extensible_list;
+ } else {
+ box_height(box) = max_natural;
+ node_subtype(box) = math_v_extensible_list;
+ }
+ return box;
+}
+
+/*tex
+
+ The |var_delimiter| function, which finds or constructs a sufficiently large delimiter, is the
+ most interesting of the auxiliary functions that currently concern us. Given a pointer |d| to a
+ delimiter field in some noad, together with a size code |s| and a vertical distance |v|, this
+ function returns a pointer to a box that contains the smallest variant of |d| whose height plus
+ depth is |v| or more. (And if no variant is large enough, it returns the largest available
+ variant.) In particular, this routine will construct arbitrarily large delimiters from
+ extensible components, if |d| leads to such characters.
+
+ The value returned is a box whose |shift_amount| has been set so that the box is vertically
+ centered with respect to the axis in the given size. If a built-up symbol is returned, the
+ height of the box before shifting will be the height of its topmost component.
+
+*/
+
+static halfword register_extensible(halfword fnt, halfword chr, int size, halfword result, halfword att)
+{
+ int callback_id = lmt_callback_defined(register_extensible_callback);
+ if (callback_id > 0) {
+ halfword b = null;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "dddN->N", fnt, chr, size, result, &b);
+ if (b) {
+ switch (node_type(b)) {
+ case hlist_node:
+ case vlist_node:
+ tex_attach_attribute_list_attribute(b, att);
+ return b;
+ default:
+ tex_formatted_error("fonts", "invalid extensible character %U registered for font %F, [h|v]list expected", chr, fnt);
+ break;
+ }
+ }
+ }
+ return result;
+}
+
+/*tex
+ A first version passed the first and last glyph around but then we need to maintain a copy because
+ we can register a composed delimiter which can result in a flush of these nodes.
+*/
+
+static halfword tex_aux_make_delimiter(halfword target, halfword delimiter, int size, scaled targetsize, int flat, int style, int shift, int *stack, scaled *delta, scaled tolerance, int nooverflow, delimiterextremes *extremes, scaled move)
+{
+ /*tex the box that will be constructed */
+ halfword result = null;
+ /*tex best-so-far and tentative font codes */
+ halfword fnt = null_font;
+ /*tex best-so-far and tentative character codes */
+ int chr = 0;
+ int nxtchr = 0;
+ /*tex are we trying the large variant? */
+ int large_attempt = 0;
+ int do_parts = 0;
+ /*tex to save the current attribute list */
+ halfword att = null;
+ if (extremes) {
+ extremes->tfont = null_font;
+ extremes->bfont = null_font;
+ extremes->tchar = 0;
+ extremes->bchar = 0;
+ extremes->height = 0;
+ extremes->depth = 0;
+ }
+ if (delimiter && ! delimiter_small_family(delimiter) && ! delimiter_small_character(delimiter)
+ && ! delimiter_large_family(delimiter) && ! delimiter_large_character(delimiter)) {
+ halfword result = tex_new_null_box_node(hlist_node, math_v_delimiter_list);
+ tex_attach_attribute_list_copy(result, delimiter);
+ if (! flat) {
+ tex_aux_fake_delimiter(result);
+ }
+ tex_flush_node(delimiter); /* no, we can assign later on ... better a fatal error here */
+ return result;
+ }
+ if (delimiter) {
+ /*tex largest height-plus-depth so far */
+ scaled besttarget = 0;
+ /*tex |z| runs through font family members */
+ int curfam = delimiter_small_family(delimiter);
+ int curchr = 0;
+ int count = 0;
+ int prvfnt = null_font;
+ int prvchr = 0;
+ nxtchr = delimiter_small_character(delimiter);
+ while (1) {
+ /*tex
+ The search process is complicated slightly by the facts that some of the characters
+ might not be present in some of the fonts, and they might not be probed in increasing
+ order of height. When we run out of sizes (variants) and end up at an extensible
+ pointer (parts) we quit the loop.
+ */
+ if (curfam || nxtchr) {
+ halfword curfnt = tex_fam_fnt(curfam, size);
+ if (curfnt != null_font) {
+ curchr = nxtchr;
+ CONTINUE:
+ count++;
+ if (tex_char_exists(curfnt, curchr)) {
+ scaled total = flat ? tex_aux_math_x_size_scaled(curfnt, tex_char_width_from_font(curfnt, curchr), size): tex_aux_math_y_size_scaled(curfnt, tex_char_total_from_font(curfnt, curchr), size);
+ if (nooverflow && total >= targetsize) {
+ if (total > targetsize && prvfnt != null_font) {
+ fnt = prvfnt;
+ chr = prvchr;
+ } else {
+ fnt = curfnt;
+ chr = curchr;
+ }
+ besttarget = total;
+ goto FOUND;
+ } else if (total >= besttarget) {
+ prvfnt = curfnt;
+ prvchr = curchr;
+ fnt = curfnt;
+ chr = curchr;
+ besttarget = total;
+ if (total >= (targetsize - tolerance)) {
+ goto FOUND;
+ }
+ }
+ if (tex_char_has_tag_from_font(curfnt, curchr, extension_tag)) {
+ fnt = curfnt;
+ chr = curchr;
+ do_parts = 1;
+ goto FOUND;
+ } else if (count > 1000) {
+ tex_formatted_warning("fonts", "endless loop in extensible character %U of font %F", curchr, curfnt);
+ goto FOUND;
+ } else if (tex_char_has_tag_from_font(curfnt, curchr, list_tag)) {
+ prvfnt = curfnt;
+ prvchr = curchr;
+ curchr = tex_char_remainder_from_font(curfnt, curchr);
+ goto CONTINUE;
+ }
+ }
+ }
+ }
+ if (large_attempt) {
+ /*tex There were none large enough. */
+ goto FOUND;
+ } else {
+ large_attempt = 1;
+ curfam = delimiter_large_family(delimiter);
+ nxtchr = delimiter_large_character(delimiter);
+ }
+ }
+ }
+ FOUND:
+ if (delimiter) {
+ /*tex
+ The builder below sets the list if needed and we dereference later because otherwise
+ the list gets flushed before it can be reused.
+ */
+ att = get_attribute_list(delimiter);
+ wipe_attribute_list_only(delimiter);
+ tex_flush_node(delimiter);
+ }
+ if (fnt != null_font) {
+ /*tex
+ When the following code is executed, |do_parts| will be true if a built-up symbol is
+ supposed to be returned.
+ */
+ extinfo *ext = NULL;
+ if (do_parts) {
+ /* tex_char_process(fnt, chr); */ /* in case we realloc */
+ ext = flat ? tex_char_horizontal_parts_from_font(fnt, chr) : tex_char_vertical_parts_from_font(fnt, chr);
+ }
+ if (ext) {
+ scaled minoverlap = flat ? tex_get_math_x_parameter_default(style, math_parameter_connector_overlap_min, 0) : tex_get_math_y_parameter_default(style, math_parameter_connector_overlap_min, 0);;
+ result = tex_aux_get_delimiter_box(fnt, chr, targetsize, minoverlap, flat, att);
+ if (delta) {
+ if (tex_aux_math_engine_control(fnt, math_control_apply_vertical_italic_kern)) {
+ *delta = tex_aux_math_x_size_scaled(fnt, tex_char_vertical_italic_from_font(fnt, nxtchr), size);
+ } else {
+ *delta = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, nxtchr), size);
+ }
+ }
+ if (stack) {
+ *stack = 1 ;
+ }
+ if (! flat && extremes) {
+ halfword first = tex_aux_top_extensible_from_box(result);
+ halfword last = tex_aux_bottom_extensible_from_box(result);
+ extremes->tfont = glyph_font(first);
+ extremes->tchar = glyph_character(first);
+ extremes->bfont = glyph_font(last);
+ extremes->bchar = glyph_character(last);
+ extremes->height = box_height(result);
+ extremes->depth = box_depth(result);
+ }
+ } else {
+ /*tex
+ Here italic is added to width in traditional fonts which makes the delimiter get
+ the real width. An \OPENTYPE\ font already has the right width. There is one case
+ where |delta| (ic) gets subtracted but only for a traditional font. In that case
+ the traditional width (which is fake width + italic) becomes less and the delta is
+ added. See (**).
+ */
+ result = tex_aux_char_box(fnt, chr, att, delta, glyph_math_delimiter_subtype, flat ? targetsize : 0, style);
+ if (stack) {
+ *stack = 0 ;
+ }
+ if (! flat && extremes) {
+ extremes->tfont = fnt;
+ extremes->tchar = chr;
+ extremes->bfont = fnt;
+ extremes->bchar = chr;
+ extremes->height = box_height(result);
+ extremes->depth = box_depth(result);
+ }
+ }
+ } else {
+ /*tex This can be an empty one as is often the case with fractions! */
+ result = tex_new_null_box_node(hlist_node, flat ? math_h_delimiter_list : math_v_delimiter_list);
+ tex_attach_attribute_list_attribute(result, att);
+ /*tex Use this width if no delimiter was found. */
+ if (! flat) {
+ tex_aux_fake_delimiter(result);
+ }
+ if (delta) {
+ *delta = 0;
+ }
+ if (stack) {
+ *stack = 0 ;
+ }
+ }
+ if (do_parts) {
+ if (has_noad_option_phantom(target) || has_noad_option_void(target)) {
+ result = tex_aux_make_list_phantom(result, has_noad_option_void(target), att);
+ } else {
+ result = register_extensible(fnt, chr, size, result, att);
+ }
+ }
+ if (! flat) {
+ /*tex A vertical variant. Todo: add a kern instead. */
+ switch (shift) {
+ case 0:
+ box_shift_amount(result) = tex_half_scaled(box_height(result) - box_depth(result));
+ break;
+ case 1:
+ box_shift_amount(result) = tex_half_scaled(box_height(result) - box_depth(result));
+ box_shift_amount(result) -= tex_aux_math_axis(size);
+ break;
+ case 2:
+ box_shift_amount(result) = move;
+ break;
+ }
+ if (do_parts && extremes && extremes->height) {
+ extremes->height -= box_shift_amount(result);
+ extremes->depth += box_shift_amount(result);
+ }
+ }
+ /* This needs checking in case the ref was changed. */
+ delete_attribute_reference(att);
+ if ((node_type(result) == hlist_node || node_type(result) == vlist_node) && node_subtype(result) == unknown_list) {
+ node_subtype(result) = flat ? math_h_delimiter_list : math_v_delimiter_list;
+ }
+ return result;
+}
+
+/*tex
+
+ The next subroutine is much simpler; it is used for numerators and denominators of fractions as
+ well as for displayed operators and their limits above and below. It takes a given box~|b| and
+ changes it so that the new box is centered in a box of width~|w|. The centering is done by
+ putting |\hss| glue at the left and right of the list inside |b|, then packaging the new box;
+ thus, the actual box might not really be centered, if it already contains infinite glue.
+
+ The given box might contain a single character whose italic correction has been added to the
+ width of the box; in this case a compensating kern is inserted. Actually, we now check for
+ the last glyph.
+
+*/
+
+static halfword tex_aux_rebox(halfword box, scaled width, halfword size)
+{
+ (void) size;
+ if (box_width(box) != width && box_list(box)) {
+ /*tex temporary registers for list manipulation */
+ halfword head = box_list(box);
+ quarterword subtype = node_subtype(box);
+ halfword att = get_attribute_list(box);
+ /*tex When the next two are not seen we can wipe att so we reserve by bump! */
+ add_attribute_reference(att);
+ if (node_type(box) == vlist_node) {
+ box = tex_hpack(box, 0, packing_additional, direction_unknown, holding_none_option);
+ node_subtype(box) = subtype;
+ tex_attach_attribute_list_attribute(box, att);
+ head = box_list(box);
+ } else if (head && node_type(head) == glyph_node && ! node_next(head)) {
+ /*tex
+ This hack is for traditional fonts so with a proper opentype font we don't end up
+ here (because then the width is unchanged). However controls can cheat so there is
+ no explicit check for an opentype situation here.
+ */
+ if (tex_aux_math_engine_control(glyph_font(head), math_control_rebox_char_italic_kern)) {
+ scaled boxwidth = box_width(box);
+ scaled chrwidth = tex_char_width_from_glyph(head);
+ if (boxwidth != chrwidth) {
+ /*tex
+ This is typical old font stuff. Maybe first check if we can just
+ remove a trailing kern. Also, why not just adapt the box width.
+ */
+ halfword kern = tex_new_kern_node(boxwidth - chrwidth, italic_kern_subtype); /* horizontal_math_kern */
+ tex_attach_attribute_list_attribute(kern, att);
+ tex_couple_nodes(head, kern);
+ }
+ }
+ }
+ box_list(box) = null;
+ tex_flush_node(box);
+ {
+ halfword left = tex_new_glue_node(filll_glue, user_skip_glue); /* todo: subtype, correction_skip_glue? */
+ halfword right = tex_new_glue_node(filll_glue, user_skip_glue); /* todo: subtype, correction_skip_glue? */
+ tex_add_glue_option(left, glue_option_no_auto_break);
+ tex_add_glue_option(right, glue_option_no_auto_break);
+ tex_attach_attribute_list_attribute(left, att);
+ tex_attach_attribute_list_attribute(right, att);
+ tex_couple_nodes(left, head);
+ tex_couple_nodes(tex_tail_of_node_list(head), right);
+ box = tex_hpack(left, width, packing_exactly, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_attribute(box, att);
+ node_subtype(box) = subtype;
+ }
+ /*tex As we bumped we now need to unbump the ref counter! */
+ delete_attribute_reference(att);
+ } else {
+ box_width(box) = width;
+ }
+ return box;
+}
+
+/*tex
+
+ Here is a subroutine that creates a new glue specification from another one that is expressed
+ in |mu|, given the value of the math unit.
+
+*/
+
+inline static scaled tex_aux_mu_mult(scaled a, scaled n, scaled f)
+{
+ return tex_multiply_and_add(n, a, tex_xn_over_d(a, f, unity), max_dimen);
+}
+
+inline static void tex_aux_calculate_glue(scaled m, scaled *f, scaled *n)
+{
+ /*tex fraction part of |m| */
+ *f = 0;
+ /*tex integer part of |m| */
+ *n = tex_x_over_n_r(m, unity, f);
+ /*tex the new glue specification */
+ if (f < 0) {
+ --n;
+ f += unity;
+ }
+}
+
+static halfword tex_aux_math_muglue(halfword g, quarterword subtype, scaled m, halfword detail, int style)
+{
+ scaled f, n;
+ halfword glue = tex_new_node(glue_node, subtype);
+ tex_aux_calculate_glue(m, &f, &n);
+ /* convert |mu| to |pt| */
+ glue_amount(glue) = tex_aux_mu_mult(tex_aux_math_x_scaled(glue_amount(g), style), n, f);
+ if (math_glue_stretch_enabled) {
+ scaled stretch = tex_aux_math_x_scaled(glue_stretch(g), style);
+ glue_stretch_order(glue) = glue_stretch_order(g);
+ glue_stretch(glue) = (glue_stretch_order(glue) == normal_glue_order) ? tex_aux_mu_mult(stretch, n, f) : stretch;
+ }
+ if (math_glue_shrink_enabled) {
+ scaled shrink = tex_aux_math_x_scaled(glue_shrink(g), style);
+ glue_shrink_order(glue) = glue_shrink_order(g);
+ glue_shrink(glue) = (glue_shrink_order(glue) == normal_glue_order) ? tex_aux_mu_mult(shrink, n, f) : shrink;
+ }
+ glue_font(glue) = detail;
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ return glue;
+}
+
+static halfword tex_aux_math_glue(halfword g, quarterword subtype, halfword detail)
+{
+ halfword glue = tex_new_glue_node(g, subtype);
+ if (! math_glue_stretch_enabled) {
+ glue_stretch_order(glue) = 0;
+ glue_stretch(glue) = 0;
+ }
+ if (! math_glue_shrink_enabled) {
+ glue_shrink_order(glue) = 0;
+ glue_shrink(glue) = 0;
+ }
+ glue_font(glue) = detail;
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ return glue;
+}
+
+static halfword tex_aux_math_dimen(halfword g, quarterword subtype, halfword detail)
+{
+ halfword glue = tex_new_glue_node(null, subtype);
+ glue_amount(glue) = g;
+ glue_font(glue) = detail;
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ return glue;
+}
+
+static void tex_aux_math_glue_to_glue(halfword p, scaled m, int style)
+{
+ scaled f, n;
+ tex_aux_calculate_glue(m, &f, &n);
+ /*tex convert |mu| to |pt| */
+ glue_amount(p) = tex_aux_mu_mult(tex_aux_math_x_scaled(glue_amount(p), style), n, f);
+ if (! math_glue_stretch_enabled) {
+ glue_stretch_order(p) = 0;
+ glue_stretch(p) = 0;
+ } else if (glue_stretch_order(p) == normal_glue_order) {
+ glue_stretch(p) = tex_aux_mu_mult(tex_aux_math_x_scaled(glue_stretch(p), style), n, f);
+ }
+ if (! math_glue_shrink_enabled) {
+ glue_shrink_order(p) = 0;
+ glue_shrink(p) = 0;
+ } else if (glue_shrink_order(p) == normal_glue_order) {
+ glue_shrink(p) = tex_aux_mu_mult(tex_aux_math_x_scaled(glue_shrink(p), style), n, f);
+ }
+ /*tex Okay, we could have had a special subtype but we're stuck with this now. */
+ node_subtype(p) = inter_math_skip_glue;
+ tex_add_glue_option(p, glue_option_no_auto_break);
+}
+
+/*tex
+
+ The |math_kern| subroutine removes |mu_glue| from a kern node, given the value of the math
+ unit.
+
+*/
+
+static void tex_aux_make_kern(halfword current, scaled mu, int style)
+{
+ if (node_subtype(current) == explicit_math_kern_subtype) {
+ scaled f, n;
+ tex_aux_calculate_glue(mu, &f, &n);
+ kern_amount(current) = tex_aux_mu_mult(tex_aux_math_x_scaled(glue_amount(current), style), n, f);
+ node_subtype(current) = explicit_kern_subtype;
+ }
+}
+
+/*tex
+
+ Conditional math glue (|\nonscript|) results in a |glue_node| pointing to |zero_glue|, with
+ |subtype(q)=cond_math_glue|; in such a case the node following will be eliminated if it is a
+ glue or kern node and if the current size is different from |text_size|.
+
+ Unconditional math glue (|\muskip|) is converted to normal glue by multiplying the dimensions
+ by |current_mu|.
+
+*/
+
+static void tex_aux_make_glue(halfword current, scaled mu, int style)
+{
+ switch (node_subtype(current)) {
+ case mu_glue:
+ tex_aux_math_glue_to_glue(current, mu, style);
+ break;
+ case conditional_math_glue:
+ if (lmt_math_state.size != text_size) {
+ halfword p = node_next(current);
+ if (p) {
+ switch (node_type(p)) {
+ case glue_node:
+ case kern_node:
+ if (node_next(p)) {
+ tex_couple_nodes(current, node_next(p));
+ node_next(p) = null;
+ } else {
+ node_next(current) = null;
+ }
+ tex_flush_node_list(p);
+ break;
+ }
+ }
+ }
+ break;
+ case rulebased_math_glue:
+ break;
+ }
+}
+
+/*tex
+
+ The |mlist_to_hlist| operation is actually called a lot when we have a math intense document,
+ because it is also called nested. Here we have the main runner, called in the main loop;
+ watch the callback.
+
+*/
+
+inline static int tex_aux_is_math_penalty(halfword n)
+{
+ return node_type(n) == penalty_node && (node_subtype(n) == math_pre_penalty_subtype || node_subtype(n) == math_post_penalty_subtype);
+}
+
+void tex_run_mlist_to_hlist(halfword mlist, halfword penalties, halfword style, int beginclass, int endclass)
+{
+ if (mlist) {
+ int saved_level = lmt_math_state.level;
+ int callback_id = lmt_callback_defined(mlist_to_hlist_callback);
+ lmt_math_state.level = 0;
+ if (! valid_math_class_code(beginclass)) {
+ beginclass = unset_noad_class;
+ }
+ if (! valid_math_class_code(endclass)) {
+ endclass = unset_noad_class;
+ }
+ math_begin_class_par = unset_noad_class;
+ math_end_class_par = unset_noad_class;
+ /* not on the stack ... yet */
+ if (tracing_math_par >= 1) {
+ tex_begin_diagnostic();
+ switch (style) {
+ case display_style:
+ tex_print_str("> \\displaymath=");
+ break;
+ case text_style:
+ tex_print_str("> \\inlinemath=");
+ break;
+ default:
+ tex_print_str("> \\math=");
+ break;
+ }
+ tex_show_box(mlist);
+ tex_end_diagnostic();
+ }
+ tex_finalize_math_parameters();
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ int top = 0;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ node_prev(mlist) = null ;
+ lmt_node_list_to_lua(L, mlist);
+ lmt_push_math_style_name(L, style);
+ lua_pushboolean(L, penalties);
+ lua_pushinteger(L, beginclass);
+ lua_pushinteger(L, endclass);
+ lua_pushinteger(L, lmt_math_state.level);
+ i = lmt_callback_call(L, 6, 1, top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ node_next(temp_head) = null;
+ } else {
+ halfword a = lmt_node_list_from_lua(L, -1);
+ /* node_prev(node_next(a)) = null; */
+ node_next(temp_head) = a;
+ lmt_callback_wrapup(L, top);
+ }
+ } else {
+ node_next(temp_head) = null;
+ }
+ } else if (callback_id == 0) {
+ node_next(temp_head) = tex_mlist_to_hlist(mlist, penalties, style, beginclass, endclass, NULL);
+ } else {
+ node_next(temp_head) = null;
+ }
+ if (penalties) { // && tex_in_main_math_style(style)
+ /*tex This makes no sense in display math not in script styles. */
+ switch (style) {
+ case text_style:
+ case cramped_text_style:
+ if (math_forward_penalties_par) {
+ halfword n = tex_get_specification_count(math_forward_penalties_par);
+ if (n > 0) {
+ halfword h = node_next(temp_head);
+ halfword i = 1;
+ while (h && i <= n) {
+ if (tex_aux_is_math_penalty(h)) {
+ penalty_amount(h) += tex_get_specification_penalty(math_forward_penalties_par, i);
+ ++i;
+ }
+ h = node_next(h);
+ }
+ }
+ }
+ if (math_backward_penalties_par) {
+ halfword n = tex_get_specification_count(math_backward_penalties_par);
+ if (n > 0) {
+ halfword t = tex_tail_of_node_list(node_next(temp_head));
+ halfword i = 1;
+ while (t && i <= n) {
+ if (tex_aux_is_math_penalty(t)) {
+ penalty_amount(t) += tex_get_specification_penalty(math_backward_penalties_par, i);
+ ++i;
+ }
+ t = node_prev(t);
+ }
+ }
+ }
+ break;
+ }
+ if (node_next(temp_head) && math_threshold_par) {
+ scaledwhd siz = tex_natural_hsizes(node_next(temp_head), null, 0.0, 0, 0);
+ if (siz.wd < glue_amount(math_threshold_par)) {
+ halfword box = tex_new_node(hlist_node, unknown_list);
+ tex_attach_attribute_list_copy(box, node_next(temp_head));
+ box_width(box) = siz.wd;
+ box_height(box) = siz.ht;
+ box_depth(box) = siz.dp;
+ box_list(box) = node_next(temp_head);
+ node_next(temp_head) = box;
+ if (glue_stretch(math_threshold_par) || glue_shrink(math_threshold_par)) {
+ halfword glue = tex_new_glue_node(math_threshold_par, u_leaders);
+ tex_add_glue_option(glue, glue_option_no_auto_break);
+ tex_attach_attribute_list_copy(glue, box);
+ glue_amount(glue) = siz.wd;
+ glue_leader_ptr(glue) = box;
+ node_next(temp_head) = glue;
+ } else {
+ node_next(temp_head) = box;
+ }
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: boxing inline, threshold %D, width %D, height %D, depth %D]",
+ glue_amount(math_threshold_par), pt_unit, // todo: stretch and shrink
+ siz.wd, pt_unit, siz.ht, pt_unit, siz.dp, pt_unit
+ );
+ tex_end_diagnostic();
+ }
+ }
+ }
+ /*
+ At the outer level we check for discretionaries. Maybe only when we are in text or display?
+ */
+ {
+ halfword current = temp_head;
+ while (current) {
+ /*tex Maybe |math_discretionary_code| but I need to check the impact on \CONTEXT\ first. */
+ if (node_type(current) == glyph_node && tex_has_glyph_option(current, glyph_option_math_discretionary)) {
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: promoting glyph with character %U to discretionary]", glyph_character(current));
+ tex_end_diagnostic();
+ }
+ current = tex_glyph_to_discretionary(current, mathematics_discretionary_code, tex_has_glyph_option(current, glyph_option_math_italics_too));
+ }
+ current = node_next(current);
+ }
+ }
+ }
+ lmt_math_state.level = saved_level;
+ } else {
+ node_next(temp_head) = null;
+ }
+}
+
+/*tex
+
+ The recursion in |mlist_to_hlist| is due primarily to a subroutine called |clean_box| that puts
+ a given noad field into a box using a given math style; |mlist_to_hlist| can call |clean_box|,
+ which can call |mlist_to_hlist|.
+
+ The box returned by |clean_box| is clean in the sense that its |shift_amount| is zero.
+
+*/
+
+inline static void tex_aux_remove_italic_after_first_glyph(halfword box)
+{
+ halfword list = box_list(box);
+ if (list && node_type(list) == glyph_node) {
+ halfword next = node_next(list);
+ /*todo: check for italic property */
+ if (next && ! node_next(next) && node_type(next) == kern_node && node_subtype(next) == italic_kern_subtype) {
+ /*tex Unneeded italic correction. */
+ box_width(box) -= kern_amount(next);
+ tex_flush_node(next);
+ node_next(list) = null;
+ }
+ }
+}
+
+static halfword tex_aux_clean_box(halfword n, int main_style, int style, quarterword subtype, int keepitalic, kernset *kerns)
+{
+ /*tex beginning of a list to be boxed */
+ halfword list;
+ /*tex box to be returned */
+ halfword result;
+ /*tex beginning of mlist to be translated */
+ halfword mlist = null;
+ switch (node_type(n)) {
+ case math_char_node:
+ mlist = tex_new_node(simple_noad, ordinary_noad_subtype);
+ noad_nucleus(mlist) = tex_aux_math_clone(n);
+ tex_attach_attribute_list_copy(mlist, n);
+ break;
+ case sub_box_node:
+ list = kernel_math_list(n);
+ goto FOUND;
+ case sub_mlist_node:
+ mlist = kernel_math_list(n);
+ break;
+ default:
+ list = tex_new_null_box_node(hlist_node, math_list_list);
+ tex_attach_attribute_list_copy(list, n);
+ goto FOUND;
+ }
+ /*tex This might add some italic correction. */
+ list = tex_mlist_to_hlist(mlist, 0, main_style, unset_noad_class, unset_noad_class, kerns);
+ /*tex recursive call */
+ tex_aux_set_current_math_size(style); /* persists after call */
+ FOUND:
+ if (! list || node_type(list) == glyph_node) {
+ result = tex_hpack(list, 0, packing_additional, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_copy(result, list);
+ } else if (! node_next(list) && (node_type(list) == hlist_node || node_type(list) == vlist_node) && (box_shift_amount(list) == 0)) {
+ /*tex It's already clean. */
+ result = list;
+ } else {
+ result = tex_hpack(list, 0, packing_additional, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_copy(result, list);
+ }
+ node_subtype(result) = subtype;
+ if (! keepitalic) {
+ tex_aux_remove_italic_after_first_glyph(result);
+ }
+ return result;
+}
+
+/*tex
+
+ It is convenient to have a procedure that converts a |math_char| field to an unpacked form. The
+ |fetch| routine sets |cur_f| and |cur_c| to the font code and character code of a given noad
+ field. It also takes care of issuing error messages for nonexistent characters; in such cases,
+ |char_exists (cur_f, cur_c)| will be |false| after |fetch| has acted, and the field will also
+ have been reset to |null|. The outputs of |fetch| are placed in global variables so that we can
+ access them any time we want. We add a bit more detail about the location of the issue than
+ standard \TEX\ does.
+
+ The |cur_f| and |cur_c| variables are now locals and we keep the (opentype) state otherwise.
+
+*/
+
+static int tex_aux_fetch(halfword n, const char *where, halfword *f, halfword *c) /* todo: also pass size */
+{
+ if (node_type(n) == glyph_node) {
+ *f = glyph_font(n);
+ *c = glyph_character(n);
+ /* lmt_math_state.opentype = tex_aux_has_opentype_metrics(*f); */
+ if (tex_char_exists(*f, *c)) {
+ return 1;
+ } else {
+ tex_char_warning(*f, *c);
+ return 0;
+ }
+ } else {
+ *f = tex_fam_fnt(kernel_math_family(n), lmt_math_state.size);
+ *c = kernel_math_character(n);
+ if (*f == null_font) {
+ char msg[256];
+ snprintf(msg, 255, "\\%s%d is undefined in %s, font id %d, character %d)",
+ tex_aux_math_size_string(lmt_math_state.size), kernel_math_family(n), where, *f, *c
+ );
+ tex_handle_error(
+ normal_error_type,
+ msg,
+ "Somewhere in the math formula just ended, you used the stated character from an\n"
+ "undefined font family. For example, plain TeX doesn't allow \\it or \\sl in\n"
+ "subscripts. Proceed, and I'll try to forget that I needed that character."
+ );
+ return 0;
+ } else {
+ /* lmt_math_state.opentype = tex_aux_has_opentype_metrics(*f); */
+ if (tex_math_char_exists(*f, *c, lmt_math_state.size)) {
+ return 1;
+ } else {
+ tex_char_warning(*f, *c);
+ return 0;
+ }
+ }
+ }
+}
+
+/*tex
+
+ We need to do a lot of different things, so |mlist_to_hlist| makes two passes over the given
+ mlist.
+
+ The first pass does most of the processing: It removes |mu| spacing from glue, it recursively
+ evaluates all subsidiary mlists so that only the top-level mlist remains to be handled, it puts
+ fractions and square roots and such things into boxes, it attaches subscripts and superscripts,
+ and it computes the overall height and depth of the top-level mlist so that the size of
+ delimiters for a |fence_noad| will be known. The hlist resulting from each noad is recorded in
+ that noad's |new_hlist| field, an integer field that replaces the |nucleus| or |thickness|.
+
+ The second pass eliminates all noads and inserts the correct glue and penalties between nodes.
+
+*/
+
+static void tex_aux_assign_new_hlist(halfword target, halfword hlist)
+{
+ switch (node_type(target)) {
+ case fraction_noad:
+ kernel_math_list(fraction_numerator(target)) = null;
+ kernel_math_list(fraction_denominator(target)) = null;
+ tex_flush_node(fraction_numerator(target));
+ tex_flush_node(fraction_denominator(target));
+ fraction_numerator(target) = null;
+ fraction_denominator(target) = null;
+ break;
+ case radical_noad:
+ case simple_noad:
+ case accent_noad:
+ if (noad_nucleus(target)) {
+ kernel_math_list(noad_nucleus(target)) = null;
+ tex_flush_node(noad_nucleus(target));
+ noad_nucleus(target) = null;
+ }
+ break;
+ }
+ noad_new_hlist(target) = hlist;
+}
+
+/*tex
+
+ Most of the actual construction work of |mlist_to_hlist| is done by procedures with names like
+ |make_fraction|, |make_radical|, etc. To illustrate the general setup of such procedures, let's
+ begin with a couple of simple ones.
+
+*/
+
+static void tex_aux_make_over(halfword target, halfword style, halfword size, halfword fam)
+{
+ /*tex
+
+ No rule adaption yet, maybe it will never be implemented because overbars should be proper
+ extensibles. The order is: kern, rule, gap, content.
+
+ */
+ halfword result;
+ scaled thickness = tex_get_math_y_parameter_checked(style, math_parameter_overbar_rule);
+ scaled vgap = tex_get_math_y_parameter_checked(style, math_parameter_overbar_vgap);
+ scaled kern = tex_get_math_y_parameter_checked(style, math_parameter_overbar_kern);
+ {
+ halfword t = tex_aux_check_rule_thickness(target, size, &fam, math_control_over_rule, OverbarRuleThickness);
+ if (t != undefined_math_parameter) {
+ thickness = t;
+ }
+ }
+ result = tex_aux_overbar(
+ tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_over_line_variant), style, math_nucleus_list, 0, NULL),
+ vgap, thickness, kern,
+ get_attribute_list(noad_nucleus(target)), math_over_rule_subtype, size, fam
+ );
+ node_subtype(result) = math_over_list;
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+}
+
+static void tex_aux_make_under(halfword target, halfword style, halfword size, halfword fam)
+{
+ /*tex
+
+ No rule adaption yet, maybe never as underbars should be proper extensibles. Here |x| is
+ the head, and |p| the tail but we keep the original names. The order is: content, gap,
+ rule, kern.
+
+ */
+ halfword result;
+ scaled thickness = tex_get_math_y_parameter_checked(style, math_parameter_underbar_rule);
+ scaled vgap = tex_get_math_y_parameter_checked(style, math_parameter_underbar_vgap);
+ scaled kern = tex_get_math_y_parameter_checked(style, math_parameter_underbar_kern);
+ {
+ halfword t = tex_aux_check_rule_thickness(target, size, &fam, math_control_under_rule, UnderbarRuleThickness);
+ if (t != undefined_math_parameter) {
+ thickness = t;
+ }
+ }
+ result = tex_aux_underbar(
+ tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_under_line_variant), style, math_nucleus_list, 0, NULL),
+ vgap, thickness, kern,
+ get_attribute_list(noad_nucleus(target)), math_under_rule_subtype, size, fam
+ );
+ node_subtype(result) = math_over_list;
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+}
+
+/*tex
+
+ In \LUAMETATEX\ we also permit |\vcenter| in text mode but there we use another function than
+ the one below.
+
+ */
+
+static void tex_aux_make_vcenter(halfword target, halfword style, halfword size)
+{
+ halfword box = kernel_math_list(noad_nucleus(target));
+ if (node_type(box) != vlist_node) {
+ box = tex_aux_clean_box(noad_nucleus(target), style, style, math_list_list, 0, NULL); // todo: math_vcenter_list
+ kernel_math_list(noad_nucleus(target)) = box;
+ node_type(noad_nucleus(target)) = sub_box_node;
+ }
+ {
+ scaled total = box_total(box);
+ scaled axis = has_box_axis(box, no_math_axis) ? 0 : tex_aux_math_axis(size);
+ box_height(box) = axis + tex_half_scaled(total);
+ box_depth(box) = total - box_height(box);
+ }
+}
+
+/*tex
+
+ According to the rules in the |DVI| file specifications, we ensure alignment between a square
+ root sign and the rule above its nucleus by assuming that the baseline of the square-root
+ symbol is the same as the bottom of the rule. The height of the square-root symbol will be the
+ thickness of the rule, and the depth of the square-root symbol should exceed or equal the
+ height-plus-depth of the nucleus plus a certain minimum clearance~|psi|. The symbol will be
+ placed so that the actual clearance is |psi| plus half the excess.
+
+*/
+
+static void tex_aux_make_hextension(halfword target, int style, int size)
+{
+ int stack = 0;
+ scaled radicalwidth = tex_aux_math_given_x_scaled(noad_width(target));
+ halfword extensible = radical_left_delimiter(target);
+ halfword delimiter = tex_aux_make_delimiter(target, extensible, size, radicalwidth, 1, style, 1, &stack, NULL, 0, has_noad_option_nooverflow(target), NULL, 0);
+ halfword delimiterwidth = box_width(delimiter);
+ if (! stack && radicalwidth && (radicalwidth != delimiterwidth)) {
+ if (has_noad_option_middle(target)) {
+ scaled delta = tex_half_scaled(radicalwidth - delimiterwidth);
+ if (delta) {
+ halfword kern = tex_new_kern_node(delta, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(kern, delimiter);
+ delimiter = kern;
+ }
+ delimiterwidth = radicalwidth;
+ } else if (has_noad_option_exact(target)) {
+ delimiterwidth = radicalwidth;
+ }
+ }
+ delimiter = tex_hpack(delimiter, 0, packing_additional, direction_unknown, holding_none_option);
+ box_width(delimiter) = delimiterwidth;
+ tex_attach_attribute_list_copy(delimiter, target);
+ kernel_math_list(noad_nucleus(target)) = delimiter;
+ radical_left_delimiter(target) = null;
+ radical_right_delimiter(target) = null;
+}
+
+static void tex_aux_preroll_root_radical(halfword target, int style, int size)
+{
+ (void) size;
+ noad_new_hlist(target) = tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_radical_variant), style, math_nucleus_list, 0, NULL);
+}
+
+static halfword tex_aux_link_radical(halfword nucleus, halfword delimiter, halfword companion, halfword rightdelimiter)
+{
+ if (companion) {
+ tex_couple_nodes(delimiter, nucleus);
+ tex_couple_nodes(nucleus, companion);
+ return delimiter;
+ } else if (rightdelimiter) {
+ tex_couple_nodes(nucleus, delimiter);
+ return nucleus;
+ } else {
+ tex_couple_nodes(delimiter, nucleus);
+ return delimiter;
+ }
+}
+
+static void tex_aux_assign_radical(halfword target, halfword radical)
+{
+ halfword result = tex_hpack(radical, 0, packing_additional, direction_unknown, holding_none_option);
+ node_subtype(result) = math_radical_list;
+ tex_attach_attribute_list_copy(result, target);
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+ radical_left_delimiter(target) = null;
+ radical_right_delimiter(target) = null;
+}
+
+static void tex_aux_set_radical_kerns(delimiterextremes *extremes, kernset *kerns)
+{
+ if (kerns && extremes->tfont) {
+ if (tex_math_has_class_option(radical_noad_subtype, carry_over_left_top_kern_class_option)) {
+ kerns->topleft = tex_char_top_left_kern_from_font(extremes->tfont, extremes->tchar);
+ }
+ if (tex_math_has_class_option(radical_noad_subtype, carry_over_left_bottom_kern_class_option)) {
+ kerns->bottomleft = tex_char_bottom_left_kern_from_font(extremes->bfont, extremes->bchar);
+ }
+ if (tex_math_has_class_option(radical_noad_subtype, carry_over_right_top_kern_class_option)) {
+ kerns->topright = tex_char_top_right_kern_from_font(extremes->tfont, extremes->tchar);
+ }
+ if (tex_math_has_class_option(radical_noad_subtype, carry_over_right_bottom_kern_class_option)) {
+ kerns->bottomright = tex_char_bottom_right_kern_from_font(extremes->bfont, extremes->bchar);
+ }
+ if (tex_math_has_class_option(radical_noad_subtype, prefer_delimiter_dimensions_class_option)) {
+ kerns->height = extremes->height;
+ kerns->depth = extremes->depth;
+ }
+ }
+}
+
+static void tex_aux_make_root_radical(halfword target, int style, int size, kernset *kerns)
+{
+ halfword nucleus = noad_new_hlist(target);
+ scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_radical_vgap);
+ scaled theta = tex_get_math_y_parameter(style, math_parameter_radical_rule);
+ scaled kern = tex_get_math_y_parameter_checked(style, math_parameter_radical_kern);
+ scaled fam = delimiter_small_family(radical_left_delimiter(target));
+ halfword leftdelimiter = radical_left_delimiter(target);
+ halfword rightdelimiter = radical_right_delimiter(target);
+ halfword delimiter = leftdelimiter ? leftdelimiter : rightdelimiter;
+ halfword companion = leftdelimiter ? rightdelimiter : null;
+ halfword radical = null;
+ delimiterextremes extremes = { .tfont = null_font, .tchar = 0, .bfont = null_font, .bchar = 0, .height = 0, .depth = 0 };
+ noad_new_hlist(target) = null;
+ /*tex
+ We can take the rule width from the fam/style of the delimiter or use the most recent math
+ parameters value.
+ */
+ {
+ halfword t = tex_aux_check_rule_thickness(target, size, &fam, math_control_radical_rule, RadicalRuleThickness);
+ if (t != undefined_math_parameter) {
+ theta = t;
+ }
+ }
+ {
+ halfword weird = theta == undefined_math_parameter;
+ if (weird) {
+ /*tex What do we have here. Why not issue an error */
+ theta = tex_get_math_y_parameter_checked(style, math_parameter_fraction_rule); /* a bit weird this one */
+ }
+ delimiter = tex_aux_make_delimiter(target, delimiter, size, box_total(nucleus) + clearance + theta, 0, style, 1, NULL, NULL, 0, has_noad_option_nooverflow(target), &extremes, 0);
+ if (companion) {
+ /*tex For now we assume symmetry and same height and depth! */
+ companion = tex_aux_make_delimiter(target, companion, size, box_total(nucleus) + clearance + theta, 0, style, 1, NULL, NULL, 0, has_noad_option_nooverflow(target), &extremes, 0);
+ }
+ if (weird) {
+ /*tex
+ If |y| is a composite then set |theta| to the height of its top character, else set it
+ to the height of |y|. Really?
+ */
+ halfword list = box_list(delimiter);
+ if (list && (node_type(list) == hlist_node)) {
+ /*tex possible composite */
+ halfword glyph = box_list(list);
+ if (glyph && node_type(glyph) == glyph_node) {
+ /*tex top character */
+ theta = tex_char_height_from_glyph(glyph);
+ } else {
+ theta = box_height(delimiter);
+ }
+ } else {
+ theta = box_height(delimiter);
+ }
+ }
+ }
+ /* */
+ tex_aux_set_radical_kerns(&extremes, kerns);
+ /*
+ Radicals in traditional fonts have their shape below the baseline which makes them unuseable
+ as stand alone characters but here we compensate for that fact. Opentype fonts derived from
+ traditional \TEX\ fonts can also be like that and it goed unnoticed until one accesses the
+ shape as character directly. Normally that gets corrected in the font when this has become
+ clear.
+ */
+ {
+ halfword delta = (box_total(delimiter) - theta) - (box_total(nucleus) + clearance);
+ if (delta > 0) {
+ /*tex increase the actual clearance */
+ clearance += tex_half_scaled(delta);
+ }
+ box_shift_amount(delimiter) = (box_height(delimiter) - theta) - (box_height(nucleus) + clearance);
+ if (companion) {
+ box_shift_amount(companion) = (box_height(companion) - theta) - (box_height(nucleus) + clearance);
+ }
+ }
+ if (node_type(delimiter) == vlist_node && node_subtype(delimiter) == math_v_delimiter_list) {
+ halfword before = tex_get_math_x_parameter_default(style, math_parameter_radical_extensible_before, 0);
+ tex_aux_prepend_hkern_to_box_list(nucleus, before, horizontal_math_kern_subtype, "bad delimiter");
+ }
+ if (node_type(companion) == vlist_node && node_subtype(companion) == math_v_delimiter_list) {
+ halfword after = tex_get_math_x_parameter_default(style, math_parameter_radical_extensible_after, 0);
+ tex_aux_append_hkern_to_box_list(nucleus, after, horizontal_math_kern_subtype, "bad delimiter");
+ }
+ {
+ halfword total = box_total(delimiter);
+ halfword list = tex_aux_overbar(nucleus, clearance, theta, kern, get_attribute_list(delimiter), math_radical_rule_subtype, size, fam);
+ radical = tex_aux_link_radical(list, delimiter, companion, rightdelimiter);
+ if (radical_degree(target)) {
+ halfword degree = tex_aux_clean_box(radical_degree(target), script_script_style, style, math_degree_list, 0, NULL);
+ scaled width = box_width(degree);
+ tex_attach_attribute_list_copy(degree, radical_degree(target));
+ if (width) {
+ scaled before = tex_get_math_x_parameter_checked(style, math_parameter_radical_degree_before);
+ scaled after = tex_get_math_x_parameter_checked(style, math_parameter_radical_degree_after);
+ /* scaled raise = tex_get_math_y_parameter_checked(style, math_parameter_radical_degree_raise); */ /* no! */
+ scaled raise = tex_get_math_parameter_checked(style, math_parameter_radical_degree_raise);
+ /* old:
+ if (-after > (width + before)) {
+ after = -(width + before);
+ }
+ new: */
+ if (-after > width) {
+ before += -after - width;
+ }
+ if (after) {
+ halfword kern = tex_new_kern_node(after, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, radical_degree(target));
+ tex_couple_nodes(kern, radical);
+ nucleus = kern;
+ } else {
+ nucleus = radical;
+ }
+ box_shift_amount(degree) = - (tex_xn_over_d(total, raise, 100) - box_depth(radical) - box_shift_amount(radical));
+ tex_couple_nodes(degree, nucleus);
+ if (before) {
+ halfword kern = tex_new_kern_node(before, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, radical_degree(target));
+ tex_couple_nodes(kern, degree);
+ radical = kern;
+ } else {
+ radical = degree;
+ }
+ } else {
+ tex_flush_node(degree);
+ }
+ /*tex for |\Uroot.. {<list>} {}|: */
+ kernel_math_list(radical_degree(target)) = null;
+ tex_flush_node(radical_degree(target));
+ radical_degree(target) = null;
+ }
+ }
+ tex_aux_assign_radical(target, radical);
+}
+
+/*tex
+ This is pretty much the same as the above when the |norule| option is set. But by splitting this
+ variant off we can enhance it more cleanly.
+*/
+
+static void tex_aux_make_delimited_radical(halfword target, int style, int size, kernset *kerns)
+{
+ halfword nucleus = noad_new_hlist(target);
+ /* scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_radical_vgap); */
+ halfword leftdelimiter = radical_left_delimiter(target);
+ halfword rightdelimiter = radical_right_delimiter(target);
+ halfword delimiter = leftdelimiter ? leftdelimiter : rightdelimiter;
+ halfword companion = leftdelimiter ? rightdelimiter : null;
+ halfword radical = null;
+ halfword depth = has_noad_option_exact(target) ? radical_depth(target) : (box_depth(nucleus) + radical_depth(target));
+ halfword height = has_noad_option_exact(target) ? radical_height(target) : (box_height(nucleus) + radical_height(target));
+ halfword total = height + depth;
+ delimiterextremes extremes = { .tfont = null_font, .tchar = 0, .bfont = null_font, .bchar = 0, .height = 0, .depth = 0 };
+ noad_new_hlist(target) = null;
+ delimiter = tex_aux_make_delimiter(target, delimiter, size, total, 0, style, 2, NULL, NULL, 0, has_noad_option_nooverflow(target), &extremes, depth);
+ if (companion) {
+ /*tex For now we assume symmetry and same height and depth! */
+ companion = tex_aux_make_delimiter(target, companion, size, total, 0, style, 2, NULL, NULL, 0, has_noad_option_nooverflow(target), &extremes, depth);
+ }
+ tex_aux_set_radical_kerns(&extremes, kerns);
+ radical = tex_aux_link_radical(nucleus, delimiter, companion, rightdelimiter);
+ tex_aux_assign_radical(target, radical);
+}
+
+/*tex Construct a vlist box: */
+
+static halfword tex_aux_wrapup_over_under_delimiter(halfword target, halfword x, halfword y, scaled shift_up, scaled shift_down, quarterword st)
+{
+ halfword box = tex_new_null_box_node(vlist_node, st);
+ scaled delta = (shift_up - box_depth(x)) - (box_height(y) - shift_down);
+ box_height(box) = shift_up + box_height(x);
+ box_depth(box) = box_depth(y) + shift_down;
+ tex_attach_attribute_list_copy(box, target);
+ if (delta) {
+ halfword kern = tex_new_kern_node(delta, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(x, kern);
+ tex_couple_nodes(kern, y);
+ } else {
+ tex_couple_nodes(x, y);
+ }
+ box_list(box) = x;
+ return box;
+}
+
+/*tex When |exact| use radicalwidth (|y| is delimiter). */
+
+inline static halfword tex_aux_check_radical(halfword target, int stack, halfword r, halfword t)
+{
+ if (! stack && (box_width(r) >= box_width(t))) {
+ scaled width = tex_aux_math_given_x_scaled(noad_width(target));
+ if (width) {
+ scaled delta = width - box_width(r);
+ if (delta) {
+ if (has_noad_option_left(target)) {
+ halfword kern = tex_new_kern_node(delta, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(kern, r);
+ } else if (has_noad_option_middle(target)) {
+ halfword kern = tex_new_kern_node(tex_half_scaled(delta), horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(kern, r);
+ } else if (has_noad_option_right(target)) {
+ /*tex also kind of exact compared to vertical */
+ } else {
+ return r;
+ }
+ r = tex_hpack(r, 0, packing_additional, direction_unknown, holding_none_option);
+ box_width(r) = noad_width(target);
+ tex_attach_attribute_list_copy(r, target);
+ }
+ }
+ }
+ return r;
+}
+
+inline static void tex_aux_fixup_radical_width(halfword target, halfword x, halfword y)
+{
+ if (box_width(y) >= box_width(x)) {
+ if (noad_width(target)) {
+ box_shift_amount(x) += tex_half_scaled(box_width(y) - box_width(x)) ;
+ }
+ box_width(x) = box_width(y);
+ } else {
+ if (noad_width(target)) {
+ box_shift_amount(y) += tex_half_scaled(box_width(x) - box_width(y)) ;
+ }
+ box_width(y) = box_width(x);
+ }
+}
+
+inline static halfword tex_aux_get_radical_width(halfword target, halfword p)
+{
+ return noad_width(target) ? noad_width(target) : box_width(p);
+}
+
+/*tex
+
+ This has the |nucleus| box |x| as a limit above an extensible delimiter |y|.
+
+*/
+
+static void tex_aux_make_over_delimiter(halfword target, int style, int size)
+{
+ halfword result;
+ scaled delta;
+ int stack;
+ scaled shift = tex_get_math_y_parameter_checked(style, math_parameter_over_delimiter_bgap);
+ scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_over_delimiter_vgap);
+ halfword content = tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_over_delimiter_variant), style, math_nucleus_list, 0, NULL);
+ scaled width = tex_aux_get_radical_width(target, content);
+ halfword over_delimiter = fraction_left_delimiter(target);
+ halfword delimiter = tex_aux_make_delimiter(target, over_delimiter, size, width, 1, style, 1, &stack, NULL, 0, has_noad_option_nooverflow(target), NULL, 0);
+ fraction_left_delimiter(target) = null;
+ delimiter = tex_aux_check_radical(target, stack, delimiter, content);
+ tex_aux_fixup_radical_width(target, content, delimiter);
+ delta = clearance - (shift - box_depth(content) - box_height(delimiter));
+ if (delta > 0) {
+ shift += delta;
+ }
+ result = tex_aux_wrapup_over_under_delimiter(target, content, delimiter, shift, 0, math_over_delimiter_list);
+ box_width(result) = box_width(content);
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+}
+
+/*tex
+
+ This has the extensible delimiter |x| as a limit below |nucleus| box |y|.
+
+*/
+
+static void tex_aux_make_under_delimiter(halfword target, int style, int size)
+{
+ halfword result;
+ scaled delta;
+ int stack;
+ scaled shift = tex_get_math_y_parameter_checked(style, math_parameter_under_delimiter_bgap);
+ scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_under_delimiter_vgap);
+ halfword content = tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_under_delimiter_variant), style, math_nucleus_list, 0, NULL);
+ scaled width = tex_aux_get_radical_width(target, content);
+ halfword under_delimiter = fraction_left_delimiter(target);
+ halfword delimiter = tex_aux_make_delimiter(target, under_delimiter, size, width, 1, style, 1, &stack, NULL, 0, has_noad_option_nooverflow(target), NULL, 0);
+ fraction_left_delimiter(target) = null;
+ delimiter = tex_aux_check_radical(target, stack, delimiter, content);
+ tex_aux_fixup_radical_width(target, delimiter, content);
+ delta = clearance - (- box_depth(delimiter) - (box_height(content) - shift));
+ if (delta > 0) {
+ shift += delta;
+ }
+ result = tex_aux_wrapup_over_under_delimiter(target, delimiter, content, 0, shift, math_under_delimiter_list);
+ box_width(result) = box_width(content);
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+}
+
+/*tex
+
+ This has the extensible delimiter |x| as a limit above |nucleus| box |y|.
+
+*/
+
+static void tex_aux_make_delimiter_over(halfword target, int style, int size)
+{
+ halfword result;
+ scaled actual;
+ int stack;
+ scaled shift = tex_get_math_y_parameter_checked(style, math_parameter_over_delimiter_bgap);
+ scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_over_delimiter_vgap);
+ halfword content = tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_delimiter_over_variant), style, math_nucleus_list, 0, NULL);
+ scaled width = tex_aux_get_radical_width(target, content);
+ halfword over_delimiter = fraction_left_delimiter(target);
+ halfword delimiter = tex_aux_make_delimiter(target, over_delimiter, size + (size == script_script_size ? 0 : 1), width, 1, style, 1, &stack, NULL, 0, has_noad_option_nooverflow(over_delimiter), NULL, 0);
+ fraction_left_delimiter(target) = null;
+ delimiter = tex_aux_check_radical(target, stack, delimiter, content);
+ tex_aux_fixup_radical_width(target, delimiter, content);
+ shift -= box_total(delimiter);
+ actual = shift - box_height(content);
+ if (actual < clearance) {
+ shift += (clearance - actual);
+ }
+ result = tex_aux_wrapup_over_under_delimiter(target, delimiter, content, shift, 0, math_over_delimiter_list);
+ box_width(result) = box_width(delimiter);
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+}
+
+/*tex
+
+ This has the extensible delimiter |y| as a limit below a |nucleus| box |x|.
+
+*/
+
+static void tex_aux_make_delimiter_under(halfword target, int style, int size)
+{
+ halfword result;
+ scaled actual;
+ int stack;
+ scaled shift = tex_get_math_y_parameter_checked(style, math_parameter_under_delimiter_bgap);
+ scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_under_delimiter_vgap);
+ halfword content = tex_aux_clean_box(noad_nucleus(target), tex_math_style_variant(style, math_parameter_delimiter_under_variant), style, math_nucleus_list, 0, NULL);
+ scaled width = tex_aux_get_radical_width(target, content);
+ halfword under_delimiter = fraction_left_delimiter(target);
+ halfword delimiter = tex_aux_make_delimiter(target, under_delimiter, size + (size == script_script_size ? 0 : 1), width, 1, style, 1, &stack, NULL, 0, has_noad_option_nooverflow(under_delimiter), NULL, 0);
+ fraction_left_delimiter(target) = null;
+ delimiter = tex_aux_check_radical(target, stack, delimiter, content);
+ tex_aux_fixup_radical_width(target, content, delimiter);
+ shift -= box_total(delimiter);
+ actual = shift - box_depth(content);
+ if (actual < clearance) {
+ shift += (clearance - actual);
+ }
+ result = tex_aux_wrapup_over_under_delimiter(target, content, delimiter, 0, shift, math_under_delimiter_list);
+ /*tex This also equals |width(y)|: */
+ box_width(result) = box_width(delimiter);
+ kernel_math_list(noad_nucleus(target)) = result;
+ node_type(noad_nucleus(target)) = sub_box_node;
+}
+
+static void tex_aux_make_radical(halfword target, int style, int size, kernset *kerns)
+{
+ switch (node_subtype(target)) {
+ case under_delimiter_radical_subtype:
+ tex_aux_make_under_delimiter(target, style, size);
+ break;
+ case over_delimiter_radical_subtype:
+ tex_aux_make_over_delimiter(target, style, size);
+ break;
+ case delimiter_under_radical_subtype:
+ tex_aux_make_delimiter_under(target, style, size);
+ break;
+ case delimiter_over_radical_subtype:
+ tex_aux_make_delimiter_over(target, style, size);
+ break;
+ case delimited_radical_subtype:
+ tex_aux_make_delimited_radical(target, style, size, kerns);
+ break;
+ case h_extensible_radical_subtype:
+ tex_aux_make_hextension(target, style, size);
+ break;
+ default:
+ tex_aux_make_root_radical(target, style, size, kerns);
+ break;
+ }
+ if (noad_source(target)) {
+ halfword result = kernel_math_list(noad_nucleus(target));
+ if (result) {
+ box_source_anchor(result) = noad_source(target);
+ tex_set_box_geometry(result, anchor_geometry);
+ }
+ }
+}
+
+static void tex_aux_preroll_radical(halfword target, int style, int size)
+{
+ switch (node_subtype(target)) {
+ case under_delimiter_radical_subtype:
+ case over_delimiter_radical_subtype:
+ case delimiter_under_radical_subtype:
+ case delimiter_over_radical_subtype:
+ case h_extensible_radical_subtype:
+ break;
+ default:
+ tex_aux_preroll_root_radical(target, style, size);
+ break;
+ }
+}
+
+/*tex
+
+ Slants are not considered when placing accents in math mode. The accenter is centered over the
+ accentee, and the accent width is treated as zero with respect to the size of the final box.
+
+*/
+
+typedef enum math_accent_location_codes {
+ top_accent_code = 1,
+ bot_accent_code = 2,
+ overlay_accent_code = 4,
+ stretch_accent_code = 8,
+} math_accent_location_codes;
+
+static int tex_aux_compute_accent_skew(halfword target, int flags, scaled *s, halfword size)
+{
+ /*tex will be true if a top-accent is placed in |s| */
+ int absolute = 0;
+ switch (node_type(noad_nucleus(target))) {
+ case math_char_node:
+ {
+ halfword chr = null;
+ halfword fnt = null;
+ tex_aux_fetch(noad_nucleus(target), "accent", &fnt, &chr);
+ if (tex_aux_math_engine_control(fnt, math_control_accent_skew_apply)) {
+ /*tex
+ There is no bot_accent so let's assume that the shift also applies
+ to bottom and overlay accents.
+ */
+ *s = tex_char_top_accent_from_font(fnt, chr);
+ if (*s != INT_MIN) {
+ *s = tex_aux_math_x_size_scaled(fnt, *s, size);
+ absolute = 1;
+ } else {
+ *s = 0;
+ }
+ } else if (flags & top_accent_code) {
+ *s = tex_aux_math_x_size_scaled(fnt, tex_get_kern(fnt, chr, font_skew_char(fnt)), size);
+ } else {
+ *s = 0;
+ }
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: accent skew, font %i, chr %x, skew %D, absolute %i]", fnt, chr, *s, pt_unit, absolute);
+ tex_end_diagnostic();
+ }
+ break;
+ }
+ case sub_mlist_node:
+ {
+ /*tex
+ If |nucleus(q)| is a |sub_mlist_node| composed of an |accent_noad| we:
+
+ \startitemize
+ \startitem
+ use the positioning of the nucleus of that noad, recursing until
+ \stopitem
+ \startitem
+ the inner most |accent_noad|. This way multiple stacked accents are
+ \stopitem
+ \startitem
+ aligned to the inner most one.
+ \stopitem
+ \stoptitemize
+
+ The vlink test was added in version 1.06, so that we only consider a lone noad:
+
+ $
+ \Umathaccent bottom 0 0 "023DF { \Umathaccent fixed 0 0 "00302 { m } r } \quad
+ \Umathaccent bottom 0 0 "023DF { l \Umathaccent fixed 0 0 "00302 { m } r } \quad
+ \Umathaccent bottom 0 0 "023DF { l \Umathaccent fixed 0 0 "00302 { m } } \quad
+ \Umathaccent bottom 0 0 "023DF { \Umathaccent fixed 0 0 "00302 { m } } \quad
+ \Umathaccent bottom 0 0 "023DF { l r }
+ $
+
+ */
+ halfword p = kernel_math_list(noad_nucleus(target));
+ if (p && ! node_next(p)) {
+ switch (node_type(p)) {
+ case accent_noad:
+ absolute = tex_aux_compute_accent_skew(p, flags, s, size);
+ break;
+ case simple_noad:
+ if (! noad_has_following_scripts(p)) {
+ absolute = tex_aux_compute_accent_skew(p, flags, s, size);
+ }
+ break;
+ }
+ }
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: accent skew, absolute %i]", absolute);
+ tex_end_diagnostic();
+ }
+ break;
+ }
+ }
+ return absolute;
+}
+static void tex_aux_do_make_math_accent(halfword target, halfword accentfnt, halfword accentchr, int flags, int style, int size, scaled *accenttotal)
+{
+ /*tex The width and height (without scripts) of base character: */
+ scaled baseheight = 0;
+ // scaled basedepth = 0;
+ scaled basewidth = 0;
+ /*tex The space to remove between accent and base: */
+ scaled delta = 0;
+ scaled overshoot = 0;
+ extinfo *extended = NULL;
+ halfword attrlist = node_attr(target);
+ scaled fraction = accent_fraction(target) > 0 ? accent_fraction(target) : 1000;
+ scaled skew = 0;
+ halfword accent = null;
+ halfword base = null;
+ halfword result = null;
+ halfword nucleus = noad_nucleus(target);
+ halfword stretch = (flags & stretch_accent_code) == stretch_accent_code;
+ /*tex
+ Compute the amount of skew, or set |skew| to an alignment point. This will be true if a
+ top-accent has been determined.
+ */
+ int absolute = tex_aux_compute_accent_skew(target, flags, &skew, size);
+ {
+ halfword usedstyle;
+ if (flags & top_accent_code) {
+ usedstyle = tex_math_style_variant(style, math_parameter_top_accent_variant);
+ } else if (flags & bot_accent_code) {
+ usedstyle = tex_math_style_variant(style, math_parameter_bottom_accent_variant);
+ } else {
+ usedstyle = tex_math_style_variant(style, math_parameter_overlay_accent_variant);
+ }
+ /*tex Beware: this adds italic correction because it feeds into mlist_to_hlist */
+ base = tex_aux_clean_box(noad_nucleus(target), usedstyle, style, math_nucleus_list, 1, NULL); /* keep italic */
+ basewidth = box_width(base);
+ baseheight = box_height(base);
+ // basedepth = box_depth(base);
+ }
+ if (! absolute && tex_aux_math_engine_control(accentfnt, math_control_accent_skew_half)) {
+ skew = tex_half_scaled(basewidth);
+ absolute = 1;
+ }
+ /*tex
+ Todo: |w = w - loffset - roffset| but then we also need to add a few
+ kerns so no hurry with that one.
+ */
+ if (stretch && (tex_char_width_from_font(accentfnt, accentchr) < basewidth)) {
+ /*tex Switch to a larger accent if available and appropriate */
+ scaled target = 0;
+ if (flags & overlay_accent_code) {
+ target = baseheight;
+ } else {
+ target += basewidth;
+ if (base) {
+ /*tex Use larger margins, */
+ halfword list = box_list(base);
+ if (list && node_type(list) == glyph_node) {
+ halfword basefnt = glyph_font(list);
+ halfword basechr = glyph_character(list);
+ if (basefnt && basechr) {
+ target += tex_aux_math_x_size_scaled(basefnt, tex_char_right_margin_from_font(basefnt, basechr), size);
+ target += tex_aux_math_x_size_scaled(basefnt, tex_char_left_margin_from_font(basefnt, basechr), size);
+ }
+ }
+ }
+ }
+ if (fraction > 0) {
+ target = tex_xn_over_d(target, fraction, 1000);
+ }
+ while (1) {
+ if (tex_char_has_tag_from_font(accentfnt, accentchr, extension_tag)) {
+ extended = tex_char_horizontal_parts_from_font(accentfnt, accentchr);
+ }
+ if (extended) {
+ /*tex
+ This is a bit weird for an overlay but anyway, here we don't need a factor as
+ we don't step.
+ */
+ halfword overlap = tex_get_math_x_parameter_checked(style, math_parameter_connector_overlap_min);
+ accent = tex_aux_get_delimiter_box(accentfnt, accentchr, basewidth, overlap, 1, attrlist);
+ accent = register_extensible(accentfnt, accentchr, size, accent, attrlist);
+ break;
+ } else if (! tex_char_has_tag_from_font(accentfnt, accentchr, list_tag)) {
+ break;
+ } else {
+ halfword remainder = tex_char_remainder_from_font(accentfnt, accentchr);
+ if (! tex_char_exists(accentfnt, remainder)) {
+ break;
+ } else if (flags & overlay_accent_code) {
+ if (tex_aux_math_y_size_scaled(accentfnt, tex_char_height_from_font(accentfnt, remainder), size) > target) {
+ break;
+ }
+ } else {
+ if (tex_aux_math_x_size_scaled(accentfnt, tex_char_width_from_font(accentfnt, remainder), size) > target) {
+ break;
+ }
+ }
+ accentchr = remainder;
+ }
+ }
+ /*tex
+ So here we then need to package the offsets.
+ */
+ }
+ if (! accent) {
+ /*tex Italic gets added to width for traditional fonts (no italic anyway): */
+ accent = tex_aux_char_box(accentfnt, accentchr, attrlist, NULL, glyph_math_accent_subtype, basewidth, style);
+ }
+ if (accenttotal) {
+ *accenttotal = box_total(accent);
+ }
+ if (flags & top_accent_code) {
+ scaled b = tex_get_math_y_parameter(style, math_parameter_accent_base_height);
+ scaled f = tex_get_math_y_parameter(style, math_parameter_flattened_accent_base_height);
+ scaled u = tex_get_math_y_parameter(style, stretch ? math_parameter_flattened_accent_top_shift_up : math_parameter_accent_top_shift_up);
+ if (f != undefined_math_parameter && baseheight > f) {
+ halfword flatchr = tex_char_flat_accent_from_font(accentfnt, accentchr);
+ if (flatchr != INT_MIN && flatchr != accentchr) {
+ tex_flush_node(accent);
+ accent = tex_aux_char_box(accentfnt, flatchr, attrlist, NULL, glyph_math_accent_subtype, basewidth, style);
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: flattening accent, old %x, new %x]", accentchr, flatchr);
+ tex_end_diagnostic();
+ }
+ accentchr = flatchr;
+ }
+ }
+ if (b != undefined_math_parameter) {
+ /* not okay */
+ delta = baseheight < b ? baseheight : b;
+ }
+ if (u != undefined_math_parameter) {
+ delta -= u;
+ }
+ } else if (flags & bot_accent_code) {
+ // scaled b = tex_get_math_y_parameter(style, math_parameter_accent_base_depth, 0);
+ // scaled f = tex_get_math_y_parameter(style, math_parameter_flattened_accent_base_depth, 0);
+ scaled l = tex_get_math_y_parameter(style, stretch ? math_parameter_flattened_accent_bottom_shift_down : math_parameter_accent_bottom_shift_down);
+ // if (b != undefined_math_parameter) {
+ // /* not okay */
+ // delta = basedepth < b ? basedepth : b;
+ // }
+ if (l != undefined_math_parameter) {
+ delta += l;
+ }
+ } else { /* if (flags & overlay_accent_code) { */
+ /*tex Center the accent vertically around base: */
+ delta = tex_half_scaled(box_total(accent) + box_total(base));
+ }
+ if (node_type(nucleus) != math_char_node) {
+ /*tex We have a molecule, not a simple atom. */
+ } else if (noad_has_following_scripts(target)) {
+ /*tex Swap the scripts: */
+ tex_flush_node_list(base);
+ base = tex_new_node(simple_noad, ordinary_noad_subtype);
+ tex_attach_attribute_list_copy(base, nucleus);
+ noad_nucleus(base) = tex_aux_math_clone(nucleus);
+ /* we no longer move the outer scripts to the inner noad */
+ node_type(nucleus) = sub_mlist_node;
+ kernel_math_list(nucleus) = base;
+ base = tex_aux_clean_box(nucleus, style, style, math_nucleus_list, 1, NULL); /* keep italic */
+ delta = delta + box_height(base) - baseheight;
+ baseheight = box_height(base);
+ } else {
+ /*tex We have only pure math char nodes here:*/
+ // halfword basefnt = tex_fam_fnt(math_family(nucleus), size);
+ // if (tex_aux_has_opentype_metrics(basefnt)) {
+ // halfword basechr = math_character(nucleus);
+ // if (math_kernel_node_has_option(nucleus, math_kernel_no_italic_correction)) {
+ // italic = 0;
+ // } else if (tex_aux_math_engine_control(basefnt, math_control_accent_italic_kern)) {
+ // italic = tex_aux_math_x_style_scaled(basefnt, tex_char_italic_from_font(basefnt, basechr), size);
+ // }
+ // }
+ }
+ /*tex The top accents of both characters are aligned. */
+ {
+ halfword accentwidth = box_width(accent);
+ if (absolute) {
+ scaled anchor = 0;
+ if (extended) {
+ /*tex If the accent is extensible just take the center. */
+ anchor = tex_half_scaled(accentwidth);
+ } else {
+ anchor = tex_char_top_accent_from_font(accentfnt, accentchr); /* no bot accent key */
+ if (anchor != INT_MIN) {
+ anchor = tex_aux_math_y_size_scaled(accentfnt, anchor, size); /* why y and not x */
+ } else {
+ /*tex just take the center */
+ anchor = tex_half_scaled(accentwidth);
+ }
+ }
+ if (math_direction_par == dir_righttoleft) {
+ skew += anchor - accentwidth;
+ } else {
+ skew -= anchor;
+ }
+ } else if (accentwidth == 0) {
+ skew += basewidth;
+ } else if (math_direction_par == dir_righttoleft) {
+ skew += accentwidth; /* ok? */
+ } else {
+ skew += tex_half_scaled(basewidth - accentwidth);
+ }
+ box_shift_amount(accent) = skew;
+ box_width(accent) = 0; /* in gyre zero anyway */
+ if (accentwidth) {
+ overshoot = accentwidth + skew - basewidth;
+ }
+ if (overshoot < 0) {
+ overshoot = 0;
+ }
+ }
+ if (flags & (top_accent_code)) {
+ accent_top_overshoot(target) = overshoot;
+ }
+ if (flags & (bot_accent_code)) {
+ accent_bot_overshoot(target) = overshoot;
+ }
+ if (flags & (top_accent_code | overlay_accent_code)) {
+ if (delta) {
+ halfword kern = tex_new_kern_node(-delta, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(accent, kern);
+ tex_couple_nodes(kern, base);
+ } else {
+ tex_couple_nodes(accent, base);
+ }
+ result = accent;
+ } else {
+ tex_couple_nodes(base, accent);
+ result = base;
+ }
+ result = tex_vpack(result, 0, packing_additional, max_dimen, (singleword) math_direction_par, holding_none_option);
+ tex_attach_attribute_list_copy(result, target);
+ node_subtype(result) = math_accent_list;
+ box_width(result) = box_width(base); // basewidth
+ delta = baseheight - box_height(result);
+ if (flags & (top_accent_code | overlay_accent_code)) {
+ if (delta > 0) {
+ /*tex make the height of box |y| equal to |h| */
+ halfword kern = tex_new_kern_node(delta, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_try_couple_nodes(kern, box_list(result));
+ box_list(result) = kern;
+ box_height(result) = baseheight;
+ }
+ } else {
+ box_shift_amount(result) = - delta;
+ }
+ box_width(result) += overshoot;
+ // if (italic) {
+ // /*tex
+ // The old font codepath has ic built in, but new font code doesn't so we add
+ // the correction here.
+ // */
+ // tex_aux_math_insert_italic_kern(result, italic, nucleus, "accent");
+ // box_width(result) += italic ;
+ // }
+ kernel_math_list(nucleus) = result;
+ node_type(nucleus) = sub_box_node;
+}
+
+static void tex_aux_make_accent(halfword target, int style, int size, kernset *kerns)
+{
+ int topstretch = 0; /* ! (node_subtype(q) % 2); */
+ int botstretch = 0; /* ! (node_subtype(q) / 2); */
+ halfword fnt = null;
+ halfword chr = null;
+ /*tex
+ We don't do some div and mod magic on the subtype here: we just check it:
+ */
+ switch (node_subtype(target)) {
+ case bothflexible_accent_subtype: topstretch = 1; botstretch = 1; break;
+ case fixedtop_accent_subtype : botstretch = 1; break;
+ case fixedbottom_accent_subtype : topstretch = 1; break;
+ case fixedboth_accent_subtype : break;
+ }
+ /*tex
+ There is some inefficiency here as we calculate the width of the nuclues upto three times.
+ Maybe I need to have a look at that some day.
+ */
+ if (accent_top_character(target)) {
+ if (tex_aux_fetch(accent_top_character(target), "top accent", &fnt, &chr)) {
+ tex_aux_do_make_math_accent(target, fnt, chr, top_accent_code | (topstretch ? stretch_accent_code : 0), style, size, &(kerns->toptotal));
+ }
+ tex_flush_node(accent_top_character(target));
+ accent_top_character(target) = null;
+ }
+ if (accent_bottom_character(target)) {
+ if (tex_aux_fetch(accent_bottom_character(target), "bottom accent", &fnt, &chr)) {
+ tex_aux_do_make_math_accent(target, fnt, chr, bot_accent_code | (botstretch ? stretch_accent_code : 0), style, size, &(kerns->bottomtotal));
+ }
+ tex_flush_node(accent_bottom_character(target));
+ accent_bottom_character(target) = null;
+ }
+ if (accent_middle_character(target)) {
+ if (tex_aux_fetch(accent_middle_character(target), "overlay accent", &fnt, &chr)) {
+ tex_aux_do_make_math_accent(target, fnt, chr, overlay_accent_code | stretch_accent_code, style, size, NULL);
+ }
+ tex_flush_node(accent_middle_character(target));
+ accent_middle_character(target) = null;
+ }
+ if (noad_source(target)) {
+ halfword result = kernel_math_list(noad_nucleus(target));
+ if (result) {
+ box_source_anchor(result) = noad_source(target);
+ tex_set_box_geometry(result, anchor_geometry);
+ }
+ }
+}
+
+/*tex
+
+ The |make_fraction| procedure is a bit different because it sets |new_hlist (q)| directly rather
+ than making a sub-box.
+
+ Kerns are probably never zero so no need to be lean here. Actually they are likely to
+ be the same. By the time we make the rule we already dealt with all these clearance
+ issues, so we're sort of ahead of what happens in a callback wrt thickness.
+
+ This rather large function has been split up in pieces which is a bit more readable but also gives
+ a much bigger binary (probably due to inlining the helpers).
+
+*/
+
+/*tex
+ Create equal-width boxes |x| and |z| for the numerator and denominator. After this one is
+ called we compute the default amounts |shift_up| and |shift_down| by which they are displaced
+ from the baseline.
+*/
+
+static void tex_aux_wrap_fraction_parts(halfword target, int style, int size, halfword *numerator, halfword *denominator, int check)
+{
+ if (noad_style(target) == unused_math_style) {
+ *numerator = tex_aux_clean_box(fraction_numerator(target), tex_math_style_variant(style, math_parameter_numerator_variant), style, math_numerator_list, 0, NULL);
+ *denominator = tex_aux_clean_box(fraction_denominator(target), tex_math_style_variant(style, math_parameter_denominator_variant), style, math_denominator_list, 0, NULL);
+ } else {
+ *numerator = tex_aux_clean_box(fraction_numerator(target), noad_style(target), style, math_numerator_list, 0, NULL);
+ *denominator = tex_aux_clean_box(fraction_denominator(target), noad_style(target), style, math_denominator_list, 0, NULL);
+ }
+ if (check) {
+ if (box_width(*numerator) < box_width(*denominator)) {
+ *numerator = tex_aux_rebox(*numerator, box_width(*denominator), size);
+ } else {
+ *denominator = tex_aux_rebox(*denominator, box_width(*numerator), size);
+ }
+ }
+}
+
+/*tex
+ Put the fraction into a box with its delimiters, and make |new_hlist(q)| point to it.
+*/
+
+static void tex_aux_wrap_fraction_result(halfword target, int style, int size, halfword fraction, kernset *kerns)
+{
+ halfword result = null;
+ halfword left_delimiter = fraction_left_delimiter(target);
+ halfword right_delimiter = fraction_right_delimiter(target);
+ if (left_delimiter || right_delimiter) {
+ halfword left = null;
+ halfword right = null;
+ halfword delta = tex_get_math_y_parameter(style, math_parameter_fraction_del_size);
+ if (delta == undefined_math_parameter) {
+ delta = tex_aux_get_delimiter_height(box_height(fraction), box_depth(fraction), 1, size, style);
+ }
+ /*tex Watch out: there can be empty delimiter boxes but with width. */
+ delimiterextremes extremes = { .tfont = null_font, .tchar = 0, .bfont = null_font, .bchar = 0, .height = 0, .depth = 0 };
+ left = tex_aux_make_delimiter(target, left_delimiter, size, delta, 0, style, 1, NULL, NULL, 0, has_noad_option_nooverflow(target), NULL, 0);
+ right = tex_aux_make_delimiter(target, right_delimiter, size, delta, 0, style, 1, NULL, NULL, 0, has_noad_option_nooverflow(target), &extremes, 0);
+ if (kerns && extremes.tfont) {
+ if (tex_math_has_class_option(fraction_noad_subtype, carry_over_left_top_kern_class_option)) {
+ kerns->topleft = tex_char_top_left_kern_from_font(extremes.tfont, extremes.tchar);
+ }
+ if (tex_math_has_class_option(fraction_noad_subtype, carry_over_left_bottom_kern_class_option)) {
+ kerns->bottomleft = tex_char_bottom_left_kern_from_font(extremes.bfont, extremes.bchar);
+ }
+ if (tex_math_has_class_option(fraction_noad_subtype, carry_over_right_top_kern_class_option)) {
+ kerns->topright = tex_char_top_right_kern_from_font(extremes.tfont, extremes.tchar);
+ }
+ if (tex_math_has_class_option(fraction_noad_subtype, carry_over_right_bottom_kern_class_option)) {
+ kerns->bottomright = tex_char_bottom_right_kern_from_font(extremes.bfont, extremes.bchar);
+ }
+ if (tex_math_has_class_option(fraction_noad_subtype, prefer_delimiter_dimensions_class_option)) {
+ kerns->height = extremes.height;
+ kerns->depth = extremes.depth;
+ }
+ }
+ /* tex_aux_normalize_delimiters(left, right); */
+ tex_couple_nodes(left, fraction);
+ tex_couple_nodes(fraction, right);
+ fraction = left;
+ }
+ result = tex_hpack(fraction, 0, packing_additional, direction_unknown, holding_none_option);
+ /*tex There can also be a nested one: */
+ node_subtype(result) = math_fraction_list;
+ tex_aux_assign_new_hlist(target, result);
+ if (noad_source(target)) {
+ box_source_anchor(result) = noad_source(target);
+ // box_anchor(result) = left_origin_anchor;
+ tex_set_box_geometry(result, anchor_geometry);
+ }
+}
+
+/*tex
+ The numerator and denominator must be separated by a certain minimum clearance, called |clr| in
+ the following program. The difference between |clr| and the actual clearance is |2 * delta|.
+*/
+
+static void tex_aux_calculate_fraction_shifts_stack(halfword target, int style, int size, halfword numerator, halfword denominator, scaled *shift_up, scaled *shift_down, scaled *delta)
+{
+ scaled clearance = tex_get_math_y_parameter_checked(style, math_parameter_stack_vgap);
+ (void) size;
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_stack_num_up);
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_stack_denom_down);
+ *shift_up = tex_round_xn_over_d(*shift_up, fraction_v_factor(target), 1000);
+ *shift_down = tex_round_xn_over_d(*shift_down, fraction_v_factor(target), 1000);
+ *delta = tex_half_scaled(clearance - ((*shift_up - box_depth(numerator)) - (box_height(denominator) - *shift_down)));
+ if (*delta > 0) {
+ *shift_up += *delta;
+ *shift_down += *delta;
+ }
+}
+
+/*tex
+ In the case of a fraction line, the minimum clearance depends on the actual thickness of the
+ line.
+*/
+
+static void tex_aux_calculate_fraction_shifts_normal(halfword target, int style, int size, halfword numerator, halfword denominator, scaled *shift_up, scaled *shift_down, scaled *delta)
+{
+ scaled axis = tex_aux_math_axis(size);
+ scaled numerator_clearance = tex_get_math_y_parameter_checked(style, math_parameter_fraction_num_vgap);
+ scaled denominator_clearance = tex_get_math_y_parameter_checked(style, math_parameter_fraction_denom_vgap);
+ scaled delta_up = 0;
+ scaled delta_down = 0;
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_fraction_num_up);
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_fraction_denom_down);
+ *shift_up = tex_round_xn_over_d(*shift_up, fraction_v_factor(target), 1000);
+ *shift_down = tex_round_xn_over_d(*shift_down, fraction_v_factor(target), 1000);
+ /* hm, delta is only set when we have a middle delimiter ... needs checking .. i should write this from scratch */
+ *delta = tex_half_scaled(tex_aux_math_given_y_scaled(fraction_rule_thickness(target)));
+ if (has_noad_option_exact(target)) {
+ delta_up = numerator_clearance - ((*shift_up - box_depth(numerator) ) - (axis + *delta));
+ delta_down = denominator_clearance - ((*shift_down - box_height(denominator)) + (axis - *delta));
+ } else {
+ // maybe this is just the old tex code path
+ scaled rule_thickness = tex_aux_math_given_y_scaled(fraction_rule_thickness(target));
+ scaled rule_parameter = tex_get_math_y_parameter_checked(style, math_parameter_fraction_rule);
+ numerator_clearance = tex_ext_xn_over_d(numerator_clearance, rule_thickness, rule_parameter);
+ denominator_clearance = tex_ext_xn_over_d(denominator_clearance, rule_thickness, rule_parameter);
+ delta_up = numerator_clearance - ((*shift_up - box_depth(numerator) ) - (axis + *delta));
+ delta_down = denominator_clearance - ((*shift_down - box_height(denominator)) + (axis - *delta));
+ }
+ *shift_up += delta_up;
+ *shift_down += delta_down;
+}
+
+static scaled tex_aux_check_fraction_rule(halfword target, int style, int size, int fractiontype, halfword *usedfam)
+{
+ scaled preferfont = has_noad_option_preferfontthickness(target);
+ halfword fam = math_rules_fam_par;
+ (void) style;
+ /*tex
+ We can take the rule width from an explicitly set fam, even if a fraction itself has no
+ character, otherwise we just use the math parameter.
+ */
+ if (preferfont) {
+ /*tex Forced by option or command. */
+ } else if (fractiontype == above_fraction_subtype) {
+ /*tex Bypassed by command. */
+ preferfont = 0;
+ } else if (fraction_rule_thickness(target)) {
+ /*tex Controlled by optional parameter. */
+ preferfont = 1;
+ }
+ if (preferfont) {
+ halfword t = tex_aux_check_rule_thickness(target, size, &fam, math_control_fraction_rule, FractionRuleThickness);
+ if (t != undefined_math_parameter) {
+ fraction_rule_thickness(target) = t;
+ }
+ }
+ if (fraction_rule_thickness(target) == preset_rule_thickness) {
+ fraction_rule_thickness(target) = tex_get_math_y_parameter_checked(style, math_parameter_fraction_rule);
+ }
+ if (usedfam) {
+ *usedfam = fam;
+ }
+ return tex_aux_math_given_y_scaled(fraction_rule_thickness(target));
+}
+
+static void tex_aux_compensate_fraction_rule(halfword target, halfword fraction, halfword separator, scaled thickness)
+{
+ (void) target;
+ if (box_total(separator) != thickness) {
+ scaled half = tex_half_scaled(box_total(separator) - thickness);
+ box_height(fraction) += half;
+ box_depth(fraction) += half;
+ }
+}
+
+static void tex_aux_apply_fraction_shifts(halfword fraction, halfword numerator, halfword denominator, scaled shift_up, scaled shift_down)
+{
+ box_height(fraction) = shift_up + box_height(numerator);
+ box_depth(fraction) = box_depth(denominator) + shift_down;
+ box_width(fraction) = box_width(numerator);
+}
+
+/*tex
+ We construct a vlist box for the fraction, according to |shift_up| and |shift_down|. Maybe in
+ the meantime it is nicer to just calculate the fraction instead of messing with the height and
+ depth explicitly (the old approach).
+*/
+
+static halfword tex_aux_assemble_fraction(halfword target, int style, int size, halfword numerator, halfword denominator, halfword separator, scaled delta, scaled shift_up, scaled shift_down)
+{
+ (void) target;
+ (void) style;
+ if (separator) {
+ scaled axis = tex_aux_math_axis(size);
+ halfword after = tex_new_kern_node((axis - delta) - (box_height(denominator) - shift_down), vertical_math_kern_subtype);
+ halfword before = tex_new_kern_node((shift_up - box_depth(numerator)) - (axis + delta), vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(after, target);
+ tex_attach_attribute_list_copy(before, target);
+ tex_couple_nodes(separator, after);
+ tex_couple_nodes(after, denominator);
+ tex_couple_nodes(before, separator);
+ tex_couple_nodes(numerator, before);
+ } else {
+ halfword between = tex_new_kern_node((shift_up - box_depth(numerator)) - (box_height(denominator) - shift_down), vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(between, target);
+ tex_couple_nodes(between, denominator);
+ tex_couple_nodes(numerator, between);
+ }
+ return numerator;
+}
+
+static halfword tex_aux_make_skewed_fraction(halfword target, int style, int size, kernset *kerns)
+{
+ halfword middle = null;
+ halfword fraction = null;
+ halfword numerator = null;
+ halfword denominator = null;
+ scaled delta = 0;
+ halfword middle_delimiter = fraction_middle_delimiter(target);
+ scaled maxheight = 0;
+ scaled maxdepth = 0;
+ scaled ngap = 0;
+ scaled dgap = 0;
+ scaled hgap = 0;
+ delimiterextremes extremes = { .tfont = null_font, .tchar = 0, .bfont = null_font, .bchar = 0, .height = 0, .depth = 0 };
+ scaled tolerance = tex_get_math_y_parameter_default(style, math_parameter_skewed_delimiter_tolerance, 0);
+ scaled shift_up = tex_get_math_y_parameter_checked(style, math_parameter_skewed_fraction_vgap);
+ scaled shift_down = tex_round_xn_over_d(shift_up, fraction_v_factor(target), 1000);
+ (void) kerns;
+ shift_up = shift_down; /*tex The |shift_up| value might change later. */
+ tex_aux_wrap_fraction_parts(target, style, size, &numerator, &denominator, 0);
+ /*tex
+ Here we don't share code bnecause we're going horizontal.
+ */
+ if (! has_noad_option_noaxis(target)) {
+ shift_up += tex_half_scaled(tex_aux_math_axis(size));
+ }
+ /*tex
+ Construct a hlist box for the fraction, according to |hgap| and |vgap|.
+ */
+ hgap = tex_get_math_x_parameter_checked(style, math_parameter_skewed_fraction_hgap);
+ hgap = tex_round_xn_over_d(hgap, fraction_h_factor(target), 1000);
+ {
+ scaled ht = box_height(numerator) + shift_up;
+ scaled dp = box_depth(numerator) - shift_up;
+ if (dp < 0) {
+ dp = 0;
+ }
+ if (ht < 0) {
+ ht = 0;
+ }
+ if (ht > maxheight) {
+ maxheight = ht;
+ }
+ if (dp > maxdepth) {
+ maxdepth = dp;
+ }
+ }
+ {
+ scaled ht = box_height(denominator) - shift_down;
+ scaled dp = box_depth(denominator) + shift_down;
+ if (dp < 0) {
+ dp = 0;
+ }
+ if (ht < 0) {
+ ht = 0;
+ }
+ if (ht > maxheight) {
+ maxheight = ht;
+ }
+ if (dp > maxdepth) {
+ maxdepth = dp;
+ }
+ }
+ box_shift_amount(numerator) = -shift_up;
+ box_shift_amount(denominator) = shift_down;
+ delta = maxheight + maxdepth;
+ middle = tex_aux_make_delimiter(target, middle_delimiter, size, delta, 0, style, 1, NULL, NULL, tolerance, has_noad_option_nooverflow(target), &extremes, 0);
+ fraction = tex_new_null_box_node(hlist_node, math_fraction_list);
+ tex_attach_attribute_list_copy(fraction, target);
+ box_width(fraction) = box_width(numerator) + box_width(denominator) + box_width(middle) - hgap;
+ hgap = -tex_half_scaled(hgap);
+ box_height(fraction) = box_height(middle) > maxheight ? box_height(middle) : maxheight;
+ box_depth(fraction) = box_depth(middle) > maxdepth ? box_depth(middle) : maxdepth;
+ ngap = hgap;
+ dgap = hgap;
+ if (tex_math_has_class_option(fraction_noad_subtype, carry_over_left_top_kern_class_option)) {
+ ngap += tex_char_top_left_kern_from_font(extremes.tfont, extremes.tchar);
+ }
+ if (tex_math_has_class_option(fraction_noad_subtype, carry_over_right_bottom_kern_class_option)) {
+ dgap += tex_char_bottom_right_kern_from_font(extremes.tfont, extremes.tchar);
+ }
+ if (ngap || dgap) {
+ // todo: only add when non zero
+ halfword nkern = tex_new_kern_node(ngap, horizontal_math_kern_subtype);
+ halfword dkern = tex_new_kern_node(dgap, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(nkern, target);
+ tex_attach_attribute_list_copy(dkern, target);
+ tex_couple_nodes(numerator, nkern);
+ tex_couple_nodes(nkern, middle);
+ tex_couple_nodes(middle, dkern);
+ tex_couple_nodes(dkern, denominator);
+ } else {
+ tex_couple_nodes(numerator, middle);
+ tex_couple_nodes(middle, denominator);
+ }
+ box_list(fraction) = numerator;
+ return fraction;
+}
+
+static halfword tex_aux_make_stretched_fraction(halfword target, int style, int size, kernset *kerns)
+{
+ halfword middle = null;
+ halfword numerator = null;
+ halfword denominator = null;
+ scaled shift_up = 0;
+ scaled shift_down = 0;
+ scaled delta = 0;
+ halfword middle_delimiter = fraction_middle_delimiter(target);
+ halfword thickness = tex_aux_check_fraction_rule(target, style, size, stretched_fraction_subtype, NULL);
+ halfword fraction = tex_new_null_box_node(vlist_node, math_fraction_list);
+ (void) kerns;
+ tex_attach_attribute_list_copy(fraction, target);
+ tex_aux_wrap_fraction_parts(target, style, size, &numerator, &denominator, 1);
+ tex_aux_calculate_fraction_shifts_normal(target, style, size, numerator, denominator, &shift_up, &shift_down, &delta);
+ tex_aux_apply_fraction_shifts(fraction, numerator, denominator, shift_up, shift_down);
+ middle = tex_aux_make_delimiter(target, middle_delimiter, size, box_width(fraction), 1, style, 0, NULL, NULL, 0, 0, NULL, 0);
+ if (box_width(middle) < box_width(fraction)) {
+ /*tex It's always in the details: */
+ scaled delta = (box_width(fraction) - box_width(middle)) / 2;
+ tex_aux_prepend_hkern_to_box_list(middle, delta, horizontal_math_kern_subtype, "bad delimiter");
+ tex_aux_append_hkern_to_box_list(middle, delta, horizontal_math_kern_subtype, "bad delimiter");
+ box_width(middle) = box_width(fraction);
+ }
+ tex_aux_compensate_fraction_rule(target, fraction, middle, thickness);
+ box_list(fraction) = tex_aux_assemble_fraction(target, style, size, numerator, denominator, middle, delta, shift_up, shift_down);
+ return fraction;
+}
+
+static halfword tex_aux_make_ruled_fraction(halfword target, int style, int size, kernset *kerns, int fractiontype)
+{
+ halfword numerator = null;
+ halfword denominator = null;
+ scaled shift_up = 0;
+ scaled shift_down = 0;
+ scaled delta = 0;
+ halfword fam = 0;
+ halfword thickness = tex_aux_check_fraction_rule(target, style, size, fractiontype, &fam);
+ halfword fraction = tex_new_null_box_node(vlist_node, math_fraction_list);
+ halfword rule = null;
+ (void) kerns;
+ tex_attach_attribute_list_copy(fraction, target);
+ tex_aux_wrap_fraction_parts(target, style, size, &numerator, &denominator, 1);
+ if (fraction_rule_thickness(target) == 0) {
+ tex_aux_calculate_fraction_shifts_stack(target, style, size, numerator, denominator, &shift_up, &shift_down, &delta);
+ } else {
+ tex_aux_calculate_fraction_shifts_normal(target, style, size, numerator, denominator, &shift_up, &shift_down, &delta);
+ }
+ tex_aux_apply_fraction_shifts(fraction, numerator, denominator, shift_up, shift_down);
+ if (fractiontype != atop_fraction_subtype) {
+ rule = tex_aux_fraction_rule(box_width(fraction), thickness, get_attribute_list(target), math_fraction_rule_subtype, size, fam);
+ tex_aux_compensate_fraction_rule(target, fraction, rule, thickness);
+ }
+ box_list(fraction) = tex_aux_assemble_fraction(target, style, size, numerator, denominator, rule, delta, shift_up, shift_down);
+ return fraction;
+}
+
+/*tex
+ We intercept bad nodes created at the \LUA\ end but only partially. The fraction handler is
+ quite complex and uses a lot of parameters. You shouldn't mess with \TEX.
+*/
+
+static void tex_aux_make_fraction(halfword target, int style, int size, kernset *kerns)
+{
+ quarterword fractiontype = node_subtype(target);
+ halfword fraction = null;
+ TRYAGAIN:
+ switch (fractiontype) {
+ case over_fraction_subtype:
+ case atop_fraction_subtype:
+ case above_fraction_subtype:
+ tex_flush_node_list(fraction_middle_delimiter(target));
+ fraction_middle_delimiter(target) = null;
+ fraction = tex_aux_make_ruled_fraction(target, style, size, kerns, fractiontype);
+ break;
+ case skewed_fraction_subtype:
+ fraction_rule_thickness(target) = 0;
+ fraction = tex_aux_make_skewed_fraction(target, style, size, kerns);
+ break;
+ case stretched_fraction_subtype:
+ fraction = tex_aux_make_stretched_fraction(target, style, size, kerns);
+ break;
+ default:
+ fractiontype = atop_fraction_subtype;
+ goto TRYAGAIN;
+ }
+ tex_aux_wrap_fraction_result(target, style, size, fraction, kerns);
+ fraction_left_delimiter(target) = null;
+ fraction_middle_delimiter(target) = null;
+ fraction_right_delimiter(target) = null;
+}
+
+/*tex
+
+ If the nucleus of an |op_noad| is a single character, it is to be centered vertically with
+ respect to the axis, after first being enlarged (via a character list in the font) if we are in
+ display style. The normal convention for placing displayed limits is to put them above and
+ below the operator in display style.
+
+ The italic correction is removed from the character if there is a subscript and the limits are
+ not being displayed. The |make_op| routine returns the value that should be used as an offset
+ between subscript and superscript.
+
+ After |make_op| has acted, |subtype(q)| will be |limits| if and only if the limits have been
+ set above and below the operator. In that case, |new_hlist(q)| will already contain the desired
+ final box.
+
+ In display mode we also handle the nolimits scripts here because we have an option to tweak the
+ placement with |\mathnolimitsmode| in displaymode. So, when we have neither |\limits| or
+ |\nolimits| in text mode we fall through and scripts are dealt with later.
+
+*/
+
+static void tex_aux_make_scripts (
+ halfword target,
+ halfword kernel,
+ scaled italic,
+ int style,
+ scaled supshift,
+ scaled subshift,
+ scaled supdrop,
+ kernset *kerns
+);
+
+static halfword tex_aux_check_nucleus_complexity (
+ halfword target,
+ scaled *delta,
+ halfword style,
+ halfword size,
+ kernset *kerns
+);
+
+/*
+ For easy configuration ... fonts are somewhat inconsistent and the
+ values for italic correction run from 30 to 60\% of the width.
+
+*/
+
+static void tex_aux_get_shifts(int mode, int style, scaled delta, scaled *top, scaled *bot)
+{
+ switch (mode) {
+ case 0:
+ /*tex full bottom correction */
+ *top = 0;
+ *bot = -delta;
+ break;
+ case 1:
+ /*tex |MathConstants| driven */
+ *top = tex_round_xn_over_d(delta, tex_get_math_parameter_default(style, math_parameter_nolimit_sup_factor, 0), 1000);
+ *bot = -tex_round_xn_over_d(delta, tex_get_math_parameter_default(style, math_parameter_nolimit_sub_factor, 0), 1000);
+ break ;
+ case 2:
+ /*tex no correction */
+ *top = 0;
+ *bot = 0;
+ break ;
+ case 3:
+ /*tex half bottom correction */
+ *top = 0;
+ *bot = -tex_half_scaled(delta);
+ break;
+ case 4:
+ /*tex half bottom and top correction */
+ *top = tex_half_scaled(delta);
+ *bot = -tex_half_scaled(delta);
+ break;
+ default :
+ /*tex above 15: for quickly testing values */
+ *top = 0;
+ *bot = (mode > 15) ? -tex_round_xn_over_d(delta, mode, 1000) : 0;
+ break;
+ }
+}
+
+// static scaled tex_aux_make_op(halfword q, int style, int size, int italic, int forced_no_limits, kernset *kerns)
+// {
+// /*tex for historic reasons we have two flags .. because we need to adapt to the style */
+// int limits = has_noad_option_limits(q);
+// int nolimits = has_noad_option_nolimits(q);
+// if (! limits && ! nolimits && (style == display_style || style == cramped_display_style)) {
+// nolimits = 0;
+// limits = 1;
+// noad_options(q) |= noad_option_limits; /* so we can track it */
+// }
+// if (forced_no_limits) {
+// nolimits = 1;
+// }
+// if (node_type(noad_nucleus(q)) == math_char_node) {
+// halfword x;
+// int shiftaxis = 0;
+// halfword chr = null;
+// halfword fnt = null;
+// halfword autoleft = null;
+// halfword autoright = null;
+// halfword autosize = has_noad_option_auto(q);
+// scaled openupheight = has_noad_option_openupheight(q) ? noad_height(q) : 0;
+// scaled openupdepth = has_noad_option_openupdepth(q) ? noad_depth(q) : 0;
+// if (has_noad_option_adapttoleft(q) && node_prev(q)) {
+// autoleft = node_prev(q);
+// if (node_type(autoleft) != simple_noad) {
+// autoleft = null;
+// } else {
+// autoleft = noad_new_hlist(autoleft);
+// }
+// }
+// if (has_noad_option_adapttoright(q) && node_next(q)) {
+// autoright = noad_nucleus(node_next(q));
+// }
+// tex_aux_fetch(noad_nucleus(q), "operator", &fnt, &chr);
+// /*tex Nicer is actually to just test for |display_style|. */
+// if ((style < text_style) || autoleft || autoright || autosize) {
+// /*tex Try to make it larger in displaystyle. */
+// scaled opsize = tex_get_math_parameter(style, math_parameter_operator_size, NULL);
+// if ((autoleft || autoright || autosize) && (opsize == undefined_math_parameter)) {
+// opsize = 0;
+// }
+// if (opsize != undefined_math_parameter) {
+// /*tex Creating a temporary delimiter is the cleanest way. */
+// halfword y = tex_new_node(delimiter_node, 0);
+// tex_attach_attribute_list_copy(y, noad_nucleus(q));
+// delimiter_small_family(y) = math_family(noad_nucleus(q));
+// delimiter_small_character(y) = math_character(noad_nucleus(q));
+// opsize = tex_aux_math_y_scaled(opsize, style);
+// if (autoright) {
+// /*tex We look ahead and preroll, |autoright| is a noad. */
+// scaledwhd siz = tex_natural_hsizes(autoright, null, 0.0, 0, 0);
+// scaled total = siz.ht + siz.dp;
+// if (total > opsize) {
+// opsize = total;
+// }
+// }
+// if (autoleft && box_total(autoleft) > opsize) {
+// /*tex We look back and check, |autoleft| is a box. */
+// opsize = box_total(autoleft);
+// }
+// /* we need to check for overflow here */
+// opsize += limited_scaled(openupheight);
+// opsize += openupdepth;
+// x = tex_aux_make_delimiter(y, text_size, opsize, 0, style, ! has_noad_option_noaxis(q), noad_options(q), NULL, &italic, 0, has_noad_option_nooverflow(q), NULL);
+// // if (italic) {
+// // if (lmt_math_state.opentype) {
+// // /*tex
+// // As we never added italic correction we don't need to compensate. The ic
+// // is stored in a special field of the node and applied in some occasions.
+// // */
+// // } else if (noad_subscr(q) && ! has_noad_option_limits(q)) { /* todo: control option */
+// // /*tex
+// // Here we (selectively) remove the italic correction that always gets added
+// // in a traditional font. See (**). In \OPENTYPE\ mode we insert italic kerns,
+// // but in traditional mode it's width manipulation. This actually makes sense
+// // because those fonts have a fake width and the italic correction sets that
+// // right.
+// // */
+// // box_list(x) = tex_aux_math_remove_italic_kern(box_list(x), &italic, "operator");
+// // box_width(x) -= italic;
+// // }
+// // }
+// } else {
+// /*tex
+// Where was the weird + 1 coming from? It tweaks the comparison. Anyway, because we
+// do a lookup we don't need to scale the |total| and |opsize|. We have a safeguard
+// against endless loops.
+// */
+// opsize = tex_char_total_from_font(fnt, chr) + openupheight + openupdepth + 1;
+// /*
+// if (opsize) {
+// opsize = tex_aux_math_y_style_scaled(fnt, opsize, size); // we compare unscaled
+// }
+// */
+// while (tex_char_tag_from_font(fnt, chr) == list_tag && tex_char_total_from_font(fnt, chr) < opsize) {
+// halfword rem = tex_char_remainder_from_font(fnt, chr);
+// if (chr != rem && tex_char_exists(fnt, rem)) {
+// chr = rem;
+// math_character(noad_nucleus(q)) = chr;
+// } else {
+// break;
+// }
+// }
+// if (math_kernel_node_has_option(noad_nucleus(q), math_kernel_no_italic_correction)) {
+// italic = 0;
+// } else {
+// italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+// }
+// x = tex_aux_clean_box(noad_nucleus(q), style, style, math_nucleus_list, 0, NULL);
+// // if (italic) {
+// // if (lmt_math_state.opentype) {
+// // /*tex we never added italic correction unless we had a |mlist_to_hlist| call. */
+// // } else if (noad_subscr(q) && ! has_noad_option_limits(q)) { /* todo: control option */
+// // box_list(x) = tex_aux_math_remove_italic_kern(box_list(x), &italic, "operator");
+// // box_width(x) -= italic;
+// // }
+// // }
+// shiftaxis = 1;
+// }
+// } else {
+// /*tex Non display style. */
+// italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+// x = tex_aux_clean_box(noad_nucleus(q), style, style, math_nucleus_list, 0, NULL);
+// // if (italic) {
+// // if (lmt_math_state.opentype) {
+// // /*tex We never added italic correction, but it gets ignored anyway. */
+// // box_width(x) -= italic;
+// // } else if (noad_subscr(q) && ! has_noad_option_limits(q)) { /* todo: control option, what does this assume from the font */
+// // /*tex remove italic correction */
+// // box_width(x) -= italic;
+// // }
+// // }
+// box_height(x) += openupheight;
+// box_depth(x) += openupdepth;
+// shiftaxis = 1;
+// }
+// if (shiftaxis) {
+// /*tex center vertically */
+// box_shift_amount(x) = tex_half_scaled(box_height(x) - box_depth(x)) - tex_aux_math_axis(size);
+// }
+// if ((node_type(x) == hlist_node) && (openupheight || openupdepth)) {
+// box_shift_amount(x) -= openupheight/2;
+// box_shift_amount(x) += openupdepth/2;
+// }
+// node_type(noad_nucleus(q)) = sub_box_node;
+// math_list(noad_nucleus(q)) = x;
+// }
+// if (nolimits) {
+// /*tex
+// We end up here when there is an explicit directive or when we're in displaymode without
+// an explicit directive. If in text mode we want to have this mode driven placement tweak
+// we need to use the |\nolimits| directive. Beware: that mode might be changed to a font
+// property or option itself.
+// */
+// // if (lmt_math_state.opentype) {
+// kernset localkerns = { .tr = 0, .br = 0, .tl = 0, .bl = 0 };
+// if (kerns) {
+// localkerns.tr = kerns->tr;
+// localkerns.br = kerns->br;
+// localkerns.tl = kerns->tl;
+// localkerns.bl = kerns->bl;
+// }
+// halfword p = tex_aux_check_nucleus_complexity(q, NULL, style, lmt_math_state.size, &localkerns);
+// if (noad_has_scripts(q)) {
+// scaled top = 0; /*tex Normally this would be: | delta|. */
+// scaled bot = 0; /*tex Normally this would be: |-delta|. */
+// if (localkerns.tr || localkerns.br) {
+// italic = 0;
+// }
+// tex_aux_get_shifts(math_nolimits_mode_par, style, italic, &top, &bot);
+// tex_aux_make_scripts(q, p, 0, style, top, bot, 0, &localkerns);
+// } else {
+// tex_aux_assign_new_hlist(q, p);
+// }
+// italic = 0;
+// // } else {
+// // /*tex similar code as in the caller */
+// // halfword p = tex_aux_check_nucleus_complexity(q, &italic, style, lmt_math_state.size, NULL);
+// // if (noad_has_scripts(q)) {
+// // tex_aux_make_scripts(q, p, italic, style, 0, 0);
+// // } else {
+// // tex_aux_assign_new_hlist(q, p);
+// // }
+// // }
+// } else if (limits) {
+// /*tex
+//
+// The following program builds a vlist box |v| for displayed limits. The width of the box
+// is not affected by the fact that the limits may be skewed.
+//
+// We end up here when we have a limits directive or when that property is set because
+// we're in displaymode.
+// */
+// halfword nucleus = noad_nucleus(q);
+// halfword x = tex_aux_clean_box(noad_supscr(q), tex_math_style_variant(style, math_parameter_superscript_variant), style, math_sup_list, 0, NULL);
+// halfword y = tex_aux_clean_box(nucleus, style, style, math_nucleus_list, 0, NULL);
+// halfword z = tex_aux_clean_box(noad_subscr(q), tex_math_style_variant(style, math_parameter_subscript_variant), style, math_sub_list, 0, NULL);
+// halfword result = tex_new_null_box_node(vlist_node, math_modifier_list);
+// tex_attach_attribute_list_copy(result, q);
+// if (nucleus) {
+// switch (node_type(nucleus)) {
+// case sub_mlist_node:
+// case sub_box_node:
+// {
+// halfword n = math_list(nucleus);
+// if (! n) {
+// /* kind of special */
+// } else if (node_type(n) == hlist_node) {
+// /*tex just a not scaled char */
+// n = box_list(n);
+// while (n) {
+// if (node_type(n) == glyph_node && ! tex_has_glyph_option(n, glyph_option_no_italic_correction)) {
+// if (tex_aux_math_engine_control(glyph_font(n), math_control_apply_boxed_italic_kern)) {
+// italic = tex_aux_math_x_size_scaled(glyph_font(n), tex_char_italic_from_font(glyph_font(n), glyph_character(n)), size);
+// }
+// }
+// n = node_next(n);
+// }
+// } else {
+// /*tex This might need checking. */
+// while (n) {
+// if (node_type(n) == fence_noad && noad_italic(n) > italic) {
+// /*tex we can have dummies, the period ones */
+// italic = tex_aux_math_given_x_scaled(noad_italic(n));
+// }
+// n = node_next(n);
+// }
+// }
+// break;
+// }
+// case math_char_node:
+// {
+// halfword fnt = tex_fam_fnt(math_family(nucleus), size);
+// halfword chr = math_character(nucleus);
+// italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+// break;
+// }
+// }
+// }
+// /*tex We're still doing limits. */
+// {
+// scaled halfitalic = tex_half_scaled(italic);
+// scaled supwidth = box_width(x);
+// scaled boxwidth = box_width(y);
+// scaled subwidth = box_width(z);
+// box_width(result) = boxwidth;
+// if (supwidth > boxwidth) {
+// boxwidth = supwidth;
+// }
+// if (subwidth > boxwidth) {
+// boxwidth = subwidth;
+// }
+// box_width(result) = boxwidth;
+// x = tex_aux_rebox(x, boxwidth, size);
+// y = tex_aux_rebox(y, boxwidth, size);
+// z = tex_aux_rebox(z, boxwidth, size);
+// /*tex This is only (visually) ok for integrals, but other operators have no italic anyway. */
+// box_shift_amount(x) = halfitalic;
+// box_shift_amount(z) = -halfitalic;
+// if (math_limits_mode_par >= 1) {
+// /*tex
+// This option enforces the real dimensions and avoids longer limits to stick out
+// which is a traditional \TEX\ feature. It's handy to have this for testing. Nicer
+// would be to also adapt the width of the wrapped scripts but these are reboxed
+// with centering so we keep that as it is.
+// */
+// if (supwidth + halfitalic > boxwidth) {
+// box_width(result) += supwidth + halfitalic - boxwidth;
+// }
+// if (subwidth + halfitalic > boxwidth) {
+// box_x_offset(result) = subwidth + halfitalic - boxwidth;
+// box_width(result) += box_x_offset(result);
+// tex_set_box_geometry(result, offset_geometry);
+// }
+// } else {
+// /*tex We keep the possible left and/or right overshoot of limits. */
+// }
+// /*tex Here the target |v| is still empty but we do set the height and depth. */
+// box_height(result) = box_height(y);
+// box_depth(result) = box_depth(y);
+// }
+// /*tex
+//
+// Attach the limits to |y| and adjust |height(v)|, |depth(v)| to account for
+// their presence.
+//
+// We use |shift_up| and |shift_down| in the following program for the amount of
+// glue between the displayed operator |y| and its limits |x| and |z|.
+//
+// The vlist inside box |v| will consist of |x| followed by |y| followed by |z|,
+// with kern nodes for the spaces between and around them; |b| is baseline and |v|
+// is the minumum gap.
+//
+// */
+// if (noad_supscr(q)) {
+// scaled bgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_above_bgap);
+// scaled vgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_above_vgap);
+// scaled vkern = tex_get_math_y_parameter_checked(style, math_parameter_limit_above_kern);
+// scaled vshift = bgap - box_depth(x);
+// if (vshift < vgap) {
+// vshift = vgap;
+// }
+// if (vshift) {
+// halfword kern = tex_new_kern_node(vshift, vertical_math_kern_subtype);
+// tex_attach_attribute_list_copy(kern, q);
+// tex_couple_nodes(kern, y);
+// tex_couple_nodes(x, kern);
+// } else {
+// tex_couple_nodes(y, x);
+// }
+// if (vkern) {
+// halfword kern = tex_new_kern_node(vkern, vertical_math_kern_subtype);
+// tex_attach_attribute_list_copy(kern, q);
+// tex_couple_nodes(kern, x);
+// box_list(result) = kern;
+// } else {
+// box_list(result) = x;
+// }
+// box_height(result) += vkern + box_total(x) + vshift;
+// } else {
+// box_list(x) = null;
+// tex_flush_node(x);
+// box_list(result) = y;
+// }
+// if (noad_subscr(q)) {
+// scaled bgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_below_bgap);
+// scaled vgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_below_vgap);
+// scaled vkern = tex_get_math_y_parameter_checked(style, math_parameter_limit_below_kern);
+// scaled vshift = bgap - box_height(z);
+// if (vshift < vgap) {
+// vshift = vgap;
+// }
+// if (vshift) {
+// halfword kern = tex_new_kern_node(vshift, vertical_math_kern_subtype);
+// tex_attach_attribute_list_copy(kern, q);
+// tex_couple_nodes(y, kern);
+// tex_couple_nodes(kern, z);
+// } else {
+// tex_couple_nodes(y, z);
+// }
+// if (vkern) {
+// halfword kern = tex_new_kern_node(vkern, vertical_math_kern_subtype);
+// tex_attach_attribute_list_copy(kern, q);
+// tex_couple_nodes(z, kern);
+// }
+// box_depth(result) += vkern + box_total(z) + vshift;
+// } else {
+// box_list(z) = null;
+// tex_flush_node(z);
+// }
+// if (noad_subscr(q)) {
+// math_list(noad_subscr(q)) = null;
+// tex_flush_node(noad_subscr(q));
+// noad_subscr(q) = null;
+// }
+// if (noad_supscr(q)) {
+// math_list(noad_supscr(q)) = null;
+// tex_flush_node(noad_supscr(q));
+// noad_supscr(q) = null;
+// }
+// tex_aux_assign_new_hlist(q, result);
+// // if (lmt_math_state.opentype) {
+// italic = 0;
+// // }
+// } else {
+// /*tex
+// We end up here when we're not in displaymode and don't have a (no)limits directive.
+// */
+// }
+// return italic;
+// }
+
+static scaled tex_aux_op_no_limits(halfword target, int style, int size, int italic, kernset *kerns)
+{
+ kernset localkerns ;
+ halfword p;
+ (void) size;
+ if (kerns) {
+ tex_math_copy_kerns(&localkerns, kerns);
+ } else {
+ tex_math_wipe_kerns(&localkerns);
+ }
+ p = tex_aux_check_nucleus_complexity(target, NULL, style, lmt_math_state.size, &localkerns);
+ if (noad_has_scripts(target)) {
+ scaled top = 0; /*tex Normally this would be: | delta|. */
+ scaled bot = 0; /*tex Normally this would be: |-delta|. */
+ if (localkerns.topright || localkerns.bottomright) {
+ italic = 0;
+ }
+ tex_aux_get_shifts(math_nolimits_mode_par, style, italic, &top, &bot);
+ tex_aux_make_scripts(target, p, 0, style, top, bot, 0, &localkerns);
+ } else {
+ tex_aux_assign_new_hlist(target, p);
+ }
+ // italic = 0;
+ return 0;
+}
+
+static scaled tex_aux_op_do_limits(halfword target, int style, int size, int italic, kernset *kerns)
+{
+ halfword nucleus = noad_nucleus(target);
+ halfword x = tex_aux_clean_box(noad_supscr(target), tex_math_style_variant(style, math_parameter_superscript_variant), style, math_sup_list, 0, NULL);
+ halfword y = tex_aux_clean_box(nucleus, style, style, math_nucleus_list, 0, NULL);
+ halfword z = tex_aux_clean_box(noad_subscr(target), tex_math_style_variant(style, math_parameter_subscript_variant), style, math_sub_list, 0, NULL);
+ halfword result = tex_new_null_box_node(vlist_node, math_modifier_list);
+ (void) kerns;
+ tex_attach_attribute_list_copy(result, target);
+ if (nucleus) {
+ switch (node_type(nucleus)) {
+ case sub_mlist_node:
+ case sub_box_node:
+ {
+ halfword n = kernel_math_list(nucleus);
+ if (! n) {
+ /* kind of special */
+ } else if (node_type(n) == hlist_node) {
+ /*tex just a not scaled char */
+ n = box_list(n);
+ while (n) {
+ if (node_type(n) == glyph_node && ! tex_has_glyph_option(n, glyph_option_no_italic_correction)) {
+ if (tex_aux_math_engine_control(glyph_font(n), math_control_apply_boxed_italic_kern)) {
+ italic = tex_aux_math_x_size_scaled(glyph_font(n), tex_char_italic_from_font(glyph_font(n), glyph_character(n)), size);
+ }
+ }
+ n = node_next(n);
+ }
+ } else {
+ /*tex This might need checking. */
+ while (n) {
+ if (node_type(n) == fence_noad && noad_italic(n) > italic) {
+ /*tex we can have dummies, the period ones */
+ italic = tex_aux_math_given_x_scaled(noad_italic(n));
+ }
+ n = node_next(n);
+ }
+ }
+ break;
+ }
+ case math_char_node:
+ {
+ halfword fnt = tex_fam_fnt(kernel_math_family(nucleus), size);
+ halfword chr = kernel_math_character(nucleus);
+ italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+ break;
+ }
+ }
+ }
+ /*tex We're still doing limits. */
+ {
+ scaled halfitalic = tex_half_scaled(italic);
+ scaled supwidth = box_width(x);
+ scaled boxwidth = box_width(y);
+ scaled subwidth = box_width(z);
+ box_width(result) = boxwidth;
+ if (supwidth > boxwidth) {
+ boxwidth = supwidth;
+ }
+ if (subwidth > boxwidth) {
+ boxwidth = subwidth;
+ }
+ box_width(result) = boxwidth;
+ x = tex_aux_rebox(x, boxwidth, size);
+ y = tex_aux_rebox(y, boxwidth, size);
+ z = tex_aux_rebox(z, boxwidth, size);
+ /*tex This is only (visually) ok for integrals, but other operators have no italic anyway. */
+ box_shift_amount(x) = halfitalic;
+ box_shift_amount(z) = -halfitalic;
+ if (math_limits_mode_par >= 1) {
+ /*tex
+ This option enforces the real dimensions and avoids longer limits to stick out
+ which is a traditional \TEX\ feature. It's handy to have this for testing. Nicer
+ would be to also adapt the width of the wrapped scripts but these are reboxed
+ with centering so we keep that as it is.
+ */
+ if (supwidth + halfitalic > boxwidth) {
+ box_width(result) += supwidth + halfitalic - boxwidth;
+ }
+ if (subwidth + halfitalic > boxwidth) {
+ box_x_offset(result) = subwidth + halfitalic - boxwidth;
+ box_width(result) += box_x_offset(result);
+ tex_set_box_geometry(result, offset_geometry);
+ }
+ } else {
+ /*tex We keep the possible left and/or right overshoot of limits. */
+ }
+ /*tex Here the target |v| is still empty but we do set the height and depth. */
+ box_height(result) = box_height(y);
+ box_depth(result) = box_depth(y);
+ }
+ /*tex
+
+ Attach the limits to |y| and adjust |height(v)|, |depth(v)| to account for
+ their presence.
+
+ We use |shift_up| and |shift_down| in the following program for the amount of
+ glue between the displayed operator |y| and its limits |x| and |z|.
+
+ The vlist inside box |v| will consist of |x| followed by |y| followed by |z|,
+ with kern nodes for the spaces between and around them; |b| is baseline and |v|
+ is the minumum gap.
+
+ */
+ if (noad_supscr(target)) {
+ scaled bgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_above_bgap);
+ scaled vgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_above_vgap);
+ scaled vkern = tex_get_math_y_parameter_checked(style, math_parameter_limit_above_kern);
+ scaled vshift = bgap - box_depth(x);
+ if (vshift < vgap) {
+ vshift = vgap;
+ }
+ if (vshift) {
+ halfword kern = tex_new_kern_node(vshift, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(kern, y);
+ tex_couple_nodes(x, kern);
+ } else {
+ tex_couple_nodes(y, x);
+ }
+ if (vkern) {
+ halfword kern = tex_new_kern_node(vkern, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(kern, x);
+ box_list(result) = kern;
+ } else {
+ box_list(result) = x;
+ }
+ box_height(result) += vkern + box_total(x) + vshift;
+ } else {
+ box_list(x) = null;
+ tex_flush_node(x);
+ box_list(result) = y;
+ }
+ if (noad_subscr(target)) {
+ scaled bgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_below_bgap);
+ scaled vgap = tex_get_math_y_parameter_checked(style, math_parameter_limit_below_vgap);
+ scaled vkern = tex_get_math_y_parameter_checked(style, math_parameter_limit_below_kern);
+ scaled vshift = bgap - box_height(z);
+ if (vshift < vgap) {
+ vshift = vgap;
+ }
+ if (vshift) {
+ halfword kern = tex_new_kern_node(vshift, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(y, kern);
+ tex_couple_nodes(kern, z);
+ } else {
+ tex_couple_nodes(y, z);
+ }
+ if (vkern) {
+ halfword kern = tex_new_kern_node(vkern, vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(z, kern);
+ }
+ box_depth(result) += vkern + box_total(z) + vshift;
+ } else {
+ box_list(z) = null;
+ tex_flush_node(z);
+ }
+ if (noad_subscr(target)) {
+ kernel_math_list(noad_subscr(target)) = null;
+ tex_flush_node(noad_subscr(target));
+ noad_subscr(target) = null;
+ }
+ if (noad_supscr(target)) {
+ kernel_math_list(noad_supscr(target)) = null;
+ tex_flush_node(noad_supscr(target));
+ noad_supscr(target) = null;
+ }
+ tex_aux_assign_new_hlist(target, result);
+ // italic = 0;
+ return 0;
+}
+
+/*tex
+ The adapt to left or right is sort of fuzzy and might disappear in future versions. After all,
+ we have more fance fence support now.
+*/
+
+static void tex_aux_op_wrapup(halfword target, int style, int size, int italic, kernset *kerns)
+{
+ halfword x;
+ int shiftaxis = 0;
+ halfword chr = null;
+ halfword fnt = null;
+ halfword autoleft = null;
+ halfword autoright = null;
+ halfword autosize = has_noad_option_auto(target);
+ scaled openupheight = has_noad_option_openupheight(target) ? noad_height(target) : 0;
+ scaled openupdepth = has_noad_option_openupdepth(target) ? noad_depth(target) : 0;
+ (void) kerns;
+ if (has_noad_option_adapttoleft(target) && node_prev(target)) {
+ autoleft = node_prev(target);
+ if (node_type(autoleft) != simple_noad) {
+ autoleft = null;
+ } else {
+ autoleft = noad_new_hlist(autoleft);
+ }
+ }
+ if (has_noad_option_adapttoright(target) && node_next(target)) {
+ /* doesn't always work well */
+ autoright = noad_nucleus(node_next(target));
+ }
+ tex_aux_fetch(noad_nucleus(target), "operator", &fnt, &chr);
+ /*tex Nicer is actually to just test for |display_style|. */
+ if ((style < text_style) || autoleft || autoright || autosize) {
+ /*tex Try to make it larger in displaystyle. */
+ scaled opsize = tex_get_math_parameter(style, math_parameter_operator_size, NULL);
+ if ((autoleft || autoright || autosize) && (opsize == undefined_math_parameter)) {
+ opsize = 0;
+ }
+ if (opsize != undefined_math_parameter) {
+ /*tex Creating a temporary delimiter is the cleanest way. */
+ halfword y = tex_new_node(delimiter_node, 0);
+ tex_attach_attribute_list_copy(y, noad_nucleus(target));
+ delimiter_small_family(y) = kernel_math_family(noad_nucleus(target));
+ delimiter_small_character(y) = kernel_math_character(noad_nucleus(target));
+ opsize = tex_aux_math_y_scaled(opsize, style);
+ if (autoright) {
+ /*tex We look ahead and preroll, |autoright| is a noad. */
+ scaledwhd siz = tex_natural_hsizes(autoright, null, 0.0, 0, 0);
+ scaled total = siz.ht + siz.dp;
+ if (total > opsize) {
+ opsize = total;
+ }
+ }
+ if (autoleft && box_total(autoleft) > opsize) {
+ /*tex We look back and check, |autoleft| is a box. */
+ opsize = box_total(autoleft);
+ }
+ /* we need to check for overflow here */
+ opsize += limited_scaled(openupheight);
+ opsize += openupdepth;
+ x = tex_aux_make_delimiter(target, y, text_size, opsize, 0, style, ! has_noad_option_noaxis(target), NULL, &italic, 0, has_noad_option_nooverflow(target), NULL, 0);
+ } else {
+ /*tex
+ Where was the weird + 1 coming from? It tweaks the comparison. Anyway, because we
+ do a lookup we don't need to scale the |total| and |opsize|. We have a safeguard
+ against endless loops.
+ */
+ opsize = tex_char_total_from_font(fnt, chr) + openupheight + openupdepth + 1;
+ /*
+ if (opsize) {
+ opsize = tex_aux_math_y_style_scaled(fnt, opsize, size); // we compare unscaled
+ }
+ */
+ while (tex_char_has_tag_from_font(fnt, chr, list_tag) && tex_char_total_from_font(fnt, chr) < opsize) {
+ halfword rem = tex_char_remainder_from_font(fnt, chr);
+ if (chr != rem && tex_char_exists(fnt, rem)) {
+ chr = rem;
+ kernel_math_character(noad_nucleus(target)) = chr;
+ } else {
+ break;
+ }
+ }
+ if (math_kernel_node_has_option(noad_nucleus(target), math_kernel_no_italic_correction)) {
+ italic = 0;
+ } else {
+ italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+ }
+ x = tex_aux_clean_box(noad_nucleus(target), style, style, math_nucleus_list, 0, NULL);
+ shiftaxis = 1;
+ }
+ } else {
+ /*tex Non display style. */
+ italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+ x = tex_aux_clean_box(noad_nucleus(target), style, style, math_nucleus_list, 0, NULL);
+ box_height(x) += openupheight;
+ box_depth(x) += openupdepth;
+ shiftaxis = 1;
+ }
+ if (shiftaxis) {
+ /*tex center vertically */
+ box_shift_amount(x) = tex_half_scaled(box_height(x) - box_depth(x)) - tex_aux_math_axis(size);
+ }
+ if ((node_type(x) == hlist_node) && (openupheight || openupdepth)) {
+ box_shift_amount(x) -= openupheight/2;
+ box_shift_amount(x) += openupdepth/2;
+ }
+ node_type(noad_nucleus(target)) = sub_box_node;
+ kernel_math_list(noad_nucleus(target)) = x;
+}
+
+static scaled tex_aux_make_op(halfword target, int style, int size, int italic, int limits_mode, kernset *kerns)
+{
+ if (limits_mode == limits_horizontal_mode) {
+ /*tex We enforce this and it can't be overruled! */
+ } else if (! has_noad_option_limits(target) && ! has_noad_option_nolimits(target) && (style == display_style || style == cramped_display_style)) {
+ limits_mode = limits_vertical_mode;
+ noad_options(target) |= noad_option_limits; /* so we can track it */
+ } else if (has_noad_option_nolimits(target)) {
+ limits_mode = limits_horizontal_mode;
+ } else if (has_noad_option_limits(target)) {
+ limits_mode = limits_vertical_mode;
+ }
+ if (node_type(noad_nucleus(target)) == math_char_node) {
+ tex_aux_op_wrapup(target, style, size, italic, kerns);
+ }
+ switch (limits_mode) {
+ case limits_horizontal_mode:
+ /*tex
+ We end up here when there is an explicit directive or when we're in displaymode without
+ an explicit directive. If in text mode we want to have this mode driven placement tweak
+ we need to use the |\nolimits| directive. Beware: that mode might be changed to a font
+ property or option itself.
+ */
+ return tex_aux_op_no_limits(target, style, size, italic, kerns); /* italic becomes zero */
+ case limits_vertical_mode:
+ /*tex
+
+ We end up here when we have a limits directive or when that property is set because
+ we're in displaymode. The following program builds a vlist box |v| for displayed limits.
+ The width of the box is not affected by the fact that the limits may be skewed.
+ */
+ return tex_aux_op_do_limits(target, style, size, italic, kerns); /* italic becomes zero */
+ default:
+ /*tex
+ We end up here when we're not in displaymode and don't have a (no)limits directive.
+ */
+ return italic; /* italic is retained */
+ }
+}
+
+/*tex
+
+ A ligature found in a math formula does not create a ligature, because there is no question of
+ hyphenation afterwards; the ligature will simply be stored in an ordinary |glyph_node|, after
+ residing in an |ord_noad|.
+
+ The |type| is converted to |math_text_char| here if we would not want to apply an italic
+ correction to the current character unless it belongs to a math font (i.e., a font with
+ |space=0|).
+
+ No boundary characters enter into these ligatures.
+
+*/
+
+/* How about: ord_noad_type_limits */
+
+// inline static int tex_aux_is_simple_char_noad(halfword p) /* only old school characters */
+// {
+// return (node_type(p) == simple_noad) && (node_type(noad_nucleus(p)) == math_char_node && tex_math_has_class_option(node_subtype(p), check_ligature_class_option));
+// }
+//
+// inline static int tex_aux_have_same_nucleus_fam(halfword p, halfword q)
+// {
+// return math_family(noad_nucleus(p)) == math_family(noad_nucleus(q));
+// }
+//
+// static void tex_aux_make_ord(halfword q, halfword size)
+// {
+// /*tex The left-side character for lig/kern testing. */
+// RESTART:
+// /*tex We can end up here again after a ligature is built. */
+// if (! noad_has_following_scripts(q) && node_type(noad_nucleus(q)) == math_char_node) {
+// halfword p = node_next(q);
+// /*tex */
+// if (p && tex_aux_is_simple_char_noad(p) && tex_aux_have_same_nucleus_fam(p, q)) {
+// halfword chr = null;
+// halfword fnt = null;
+// node_type(noad_nucleus(q)) = math_text_char_node;
+// tex_aux_fetch(noad_nucleus(q), "ordinal", &fnt, &chr);
+// if (tex_aux_math_engine_control(fnt, math_control_apply_ordinary_italic_kern)) {
+// /*
+// We don't have other kerns in opentype math fonts. There are however these
+// staircase kerns that are dealt with elsewhere. But for new math fonts we do
+// need to add italic correction.
+// */
+// if (math_kernel_node_has_option(noad_nucleus(q), math_kernel_no_italic_correction)) {
+// /* go on */
+// } else {
+// scaled kern = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, math_character(noad_nucleus(q))), size);
+// if (kern) {
+// tex_aux_math_insert_italic_kern(q, kern, q, "ord");
+// }
+// }
+// } else if (tex_aux_math_engine_control(fnt, math_control_check_ligature_and_kern)) {
+// if (tex_has_kern(fnt, chr) || tex_has_ligature(fnt, chr)) {
+// /*tex
+//
+// Here we construct ligatures, quite unlikely in new math fonts so maybe we
+// should just not go here for such fonts.
+//
+// If character |a| has a kern with |cur_c|, attach the kern after~|q|; or if
+// it has a ligature with |cur_c|, combine noads |q| and~|p| appropriately;
+// then |return| if the cursor has moved past a noad, or |goto restart|.
+//
+// Note that a ligature between an |ord_noad| and another kind of noad is
+// replaced by an |ord_noad|, when the two noads collapse into one.
+//
+// We could make a parenthesis (say) change shape when it follows certain
+// letters. Presumably a font designer will define such ligatures only when
+// this convention makes sense.
+//
+// */
+// halfword nxt = math_character(noad_nucleus(p));
+// halfword slot;
+// int type = tex_valid_ligature(chr, nxt, &slot);
+// if (type >= 0) {
+// switch (type) {
+// case 1: /*tex \type{=:|} */
+// case 5: /*tex \type{=:|>} */
+// math_character(noad_nucleus(q)) = slot;
+// break;
+// case 2: /*tex \type{|=:} */
+// case 6: /*tex \type{|=:>} */
+// math_character(noad_nucleus(p)) = slot;
+// break;
+// case 3: /*tex \type{|=:|} */
+// case 7: /*tex \type{|=:|>} */
+// case 11: /*tex \type{|=:|>>} */
+// {
+// halfword r = tex_new_node(simple_noad, ordinary_noad_subtype);
+// halfword s = tex_new_node(math_char_node, 0);
+// tex_attach_attribute_list_copy(r, q);
+// tex_attach_attribute_list_copy(s, q);
+// noad_nucleus(r) = s;
+// math_character(noad_nucleus(r)) = slot;
+// math_family(noad_nucleus(r)) = math_family(noad_nucleus(q));
+// tex_couple_nodes(q, r);
+// tex_couple_nodes(r, p);
+// if (type < 11) {
+// node_type(noad_nucleus(r)) = math_char_node;
+// } else {
+// /*tex prevent combination */
+// node_type(noad_nucleus(r)) = math_text_char_node;
+// }
+// }
+// break;
+// default: /*tex |=:| */
+// tex_try_couple_nodes(q, node_next(p));
+// math_character(noad_nucleus(q)) = slot;
+// noad_subscr(q) = noad_subscr(p);
+// noad_supscr(q) = noad_supscr(p);
+// noad_subscr(p) = null ;
+// noad_supscr(p) = null ;
+// tex_flush_node(p);
+// break;
+// }
+// if (type > 3) {
+// return;
+// } else {
+// node_type(noad_nucleus(q)) = math_char_node;
+// goto RESTART; /*tex Inefficient but we never see this branch anyway. */
+// }
+// }
+// {
+// // scaled kern = tex_aux_math_x_size_scaled(fnt, tex_valid_kern(chr, nxt), size);
+// halfword nxtchr = null;
+// halfword nxtfnt = null;
+// tex_aux_fetch(noad_nucleus(p), "ordinal", &nxtfnt, &nxtchr);
+// scaled kern = tex_get_kern(fnt, chr, nxtchr);
+// if (kern) {
+// tex_aux_math_insert_font_kern(q, kern, q, "ord");
+// return;
+// }
+// }
+// }
+// }
+// }
+// }
+// }
+
+
+// $ \mathord {a} $ : ord -> nucleus -> mathchar
+// $ \mathord {ab} $ : ord -> nucleus -> submlist -> ord + ord
+
+/*tex
+ Have there ever been math fonts with kerns and ligatures? If so it had to be between characters
+ within the same font. Maybe this was meant for composed charaters? And the 256 limits of the
+ number of characters didn't help either. This is why we take the freedom to do things a bit
+ different.
+
+ We don't have other kerns in opentype math fonts. There are however these staircase kerns that
+ are dealt with elsewhere. But for new math fonts we do need to add italic correction occasionally
+ and staircase kerns only happen with scripts.
+
+ We could add support for ligatures but we don't need those anyway so it's a waste of time and
+ bytes.
+
+ The ord checker kicks in after every ord but we can consider a special version where we handle
+ |sub_list_node| noads. And we could maybe check on sloped shapes but then we for sure end up
+ in a mess we don't want.
+
+*/
+
+static halfword tex_aux_check_ord(halfword current, halfword size, halfword next)
+{
+ if (! noad_has_following_scripts(current)) {
+ halfword nucleus = noad_nucleus(current);
+ switch (node_type(nucleus)) {
+ case sub_mlist_node:
+ {
+ // I'm not that motivated for this and it should be an engine option anyway then.
+
+ // halfword head = math_list(nucleus);
+ // halfword tail = tex_tail_of_node_list(head);
+ // // doesn't work
+ // if (node_type(head) == simple_noad && node_prev(current) ) {
+ // if (node_type(node_prev(current)) == simple_noad) {
+ // head = tex_aux_check_ord(node_prev(current), size, head);
+ // math_list(nucleus) = head;
+ // }
+ // }
+ // // works
+ // if (node_type(tail) == simple_noad && node_next(current) ) {
+ // tex_aux_check_ord(tail, size, node_next(current));
+ // }
+ break;
+ }
+ case math_char_node:
+ {
+ if (! next) {
+ next = node_next(current);
+ }
+ halfword curchr = null;
+ halfword curfnt = null;
+ tex_aux_fetch(nucleus, "ordinal", &curfnt, &curchr);
+ if (curfnt && curchr) {
+ halfword kern = 0;
+ halfword italic = 0;
+ if (next) {
+ halfword nxtnucleus = noad_nucleus(next);
+ halfword nxtfnt = null;
+ halfword nxtchr = null;
+ if (node_type(nxtnucleus) == math_char_node && kernel_math_family(nucleus) == kernel_math_family(nxtnucleus)) {
+ tex_aux_fetch(nxtnucleus, "ordinal", &nxtfnt, &nxtchr);
+ if (nxtfnt && nxtchr) {
+ halfword mainclass = node_subtype(current);
+ /* todo: ligatures */
+ if (tex_aux_math_engine_control(curfnt, math_control_apply_ordinary_kern_pair)) {
+ if (math_kernel_node_has_option(nucleus, math_kernel_no_right_pair_kern) || math_kernel_node_has_option(nxtnucleus, math_kernel_no_left_pair_kern)) {
+ /* ignore */
+ } else if (tex_math_has_class_option(mainclass, check_italic_correction_class_option)) {
+ /* ignore */
+ } else if (tex_aux_math_engine_control(curfnt, math_control_apply_ordinary_italic_kern)) {
+ kern = tex_aux_math_x_size_scaled(curfnt, tex_get_kern(curfnt, curchr, nxtchr), size);
+ }
+ }
+ if (tex_aux_math_engine_control(curfnt, math_control_apply_ordinary_italic_kern)) {
+ if (math_kernel_node_has_option(nucleus, math_kernel_no_italic_correction)) {
+ /* ignore */
+ } else if (tex_math_has_class_option(mainclass, check_kern_pair_class_option)) {
+ /* ignore */
+ } else if (tex_aux_math_engine_control(curfnt, math_control_apply_ordinary_italic_kern)) {
+ italic = tex_aux_math_x_size_scaled(curfnt, tex_char_italic_from_font(curfnt, curchr), size);
+ }
+ }
+ }
+ }
+ }
+ if (kern) {
+ current = tex_aux_math_insert_font_kern(current, kern, current, "ord");
+ }
+ if (italic) {
+ // todo : after last unless upright but then we need to signal
+ current = tex_aux_math_insert_italic_kern(current, italic, current, "ord");
+ }
+ }
+ }
+ break;
+ }
+ }
+ return current;
+}
+
+static halfword tex_aux_prepend_hkern_to_new_hlist(halfword box, scaled delta, halfword subtype, const char *trace)
+{
+ halfword list = noad_new_hlist(box);
+ halfword kern = tex_new_kern_node(delta, (quarterword) subtype);
+ tex_attach_attribute_list_copy(kern, box);
+ if (list) {
+ tex_couple_nodes(kern, list);
+ }
+ list = kern;
+ noad_new_hlist(box) = list;
+ tex_aux_trace_kerns(kern, "adding kern", trace);
+ return list;
+}
+
+static void tex_aux_append_hkern_to_box_list(halfword box, scaled delta, halfword subtype, const char *trace)
+{
+ halfword list = box_list(box);
+ halfword kern = tex_new_kern_node(delta, (quarterword) subtype);
+ tex_attach_attribute_list_copy(kern, box);
+ if (list) {
+ tex_couple_nodes(tex_tail_of_node_list(list), kern);
+ } else {
+ list = kern;
+ }
+ box_list(box) = list;
+ box_width(box) += delta;
+ tex_aux_trace_kerns(kern, "adding kern", trace);
+}
+
+static void tex_aux_prepend_hkern_to_box_list(halfword box, scaled delta, halfword subtype, const char *trace)
+{
+ halfword list = box_list(box);
+ halfword kern = tex_new_kern_node(delta, (quarterword) subtype);
+ tex_attach_attribute_list_copy(kern, box);
+ if (list) {
+ tex_couple_nodes(kern, list);
+ }
+ list = kern;
+ box_list(box) = list;
+ box_width(box) += delta;
+ tex_aux_trace_kerns(kern, "adding kern", trace);
+}
+
+/*tex
+
+ The purpose of |make_scripts (q, it)| is to attach the subscript and/or superscript of noad |q|
+ to the list that starts at |new_hlist (q)|, given that subscript and superscript aren't both
+ empty. The superscript will be horizontally shifted over |delta1|, the subscript over |delta2|.
+
+ We set |shift_down| and |shift_up| to the minimum amounts to shift the baseline of subscripts
+ and superscripts based on the given nucleus.
+
+ Note: We need to look at a character but also at the first one in a sub list and there we
+ ignore leading kerns and glue. Elsewhere is code that removes kerns assuming that is italic
+ correction. The heuristics are unreliable for the new fonts so eventualy there will be an
+ option to ignore such corrections. (We now actually have that level of control.)
+
+ Instead of a few mode parameters we now control this via the control options bitset. In this
+ case we cheat a bit as there is no relationship with a font (the first |null| parameter that
+ gets passed here). In the archive we can find all the variants.
+
+*/
+
+static halfword tex_aux_analyze_script(halfword init, scriptdata *data)
+{
+ if (init) {
+ switch (node_type(init)) {
+ case math_char_node :
+ if (tex_aux_math_engine_control(null, math_control_analyze_script_nucleus_char)) {
+ if (tex_aux_fetch(init, "script char", &(data->fnt), &(data->chr))) {
+ return init;
+ } else {
+ goto NOTHING;
+ }
+ } else {
+ break;
+ }
+ case sub_mlist_node:
+ if (tex_aux_math_engine_control(null, math_control_analyze_script_nucleus_list)) {
+ init = kernel_math_list(init);
+ while (init) {
+ switch (node_type(init)) {
+ case kern_node:
+ case glue_node:
+ init = node_next(init);
+ break;
+ case simple_noad:
+ {
+ init = noad_nucleus(init);
+ if (node_type(init) != math_char_node) {
+ return null;
+ } else if (tex_aux_fetch(init, "script list", &(data->fnt), &(data->chr))) {
+ return init;
+ } else {
+ goto NOTHING;
+ }
+ }
+ default:
+ goto NOTHING;
+ }
+ }
+ }
+ break;
+ case sub_box_node:
+ if (tex_aux_math_engine_control(null, math_control_analyze_script_nucleus_box)) {
+ init = kernel_math_list(init);
+ if (init && node_type(init) == hlist_node) {
+ init = box_list(init);
+ }
+ while (init) {
+ switch (node_type(init)) {
+ case kern_node:
+ case glue_node:
+ init = node_next(init);
+ break;
+ case glyph_node:
+ if (tex_aux_fetch(init, "script box", &(data->fnt), &(data->chr))) {
+ return init;
+ } else {
+ goto NOTHING;
+ }
+ default:
+ goto NOTHING;
+ }
+ }
+ }
+ break;
+ }
+ }
+ NOTHING:
+ data->fnt = null;
+ data->chr = null;
+ return null;
+}
+
+/*tex
+
+ These prescripts are kind of special. For instance, should top and bottom scripts be aligned?
+ When there is are two top or two bottom, should we then just use the maxima?
+
+*/
+
+static void tex_aux_get_math_sup_shifts(halfword sup, halfword style, scaled *shift_up)
+{
+ switch (math_scripts_mode_par) {
+ case 1:
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_up);
+ break;
+ case 2:
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_up);
+ break;
+ case 3:
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_up)
+ + tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down)
+ - tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ break;
+ case 4:
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_up)
+ + tex_half_scaled(tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down)
+ - tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down));
+ break;
+ case 5:
+ *shift_up = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_up)
+ + tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down)
+ - tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ break;
+ default:
+ {
+ scaled clr = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_up);
+ scaled bot = tex_get_math_y_parameter_checked(style, math_parameter_superscript_bottom_min);
+ if (*shift_up < clr) {
+ *shift_up = clr;
+ }
+ clr = box_depth(sup) + bot;
+ if (*shift_up < clr) {
+ *shift_up = clr;
+ }
+ break;
+ }
+ }
+}
+
+static void tex_aux_get_math_sub_shifts(halfword sub, halfword style, scaled *shift_down)
+{
+ switch (math_scripts_mode_par) {
+ case 1:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ break;
+ case 2:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down);
+ break;
+ case 3:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down);
+ break;
+ case 4:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down)
+ + tex_half_scaled(tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down)
+ - tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down)) ;
+ break;
+ case 5:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ break;
+ default:
+ {
+ scaled clr = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ scaled top = tex_get_math_y_parameter_checked(style, math_parameter_subscript_top_max);
+ if (*shift_down < clr) {
+ *shift_down = clr;
+ }
+ clr = box_height(sub) - top;
+ if (*shift_down < clr) {
+ *shift_down = clr;
+ }
+ break;
+ }
+ }
+}
+
+static void tex_aux_get_math_sup_sub_shifts(halfword sup, halfword sub, halfword style, scaled *shift_up, scaled *shift_down)
+{
+ switch (math_scripts_mode_par) {
+ case 1:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ break;
+ case 2:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down);
+ break;
+ case 3:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down);
+ break;
+ case 4:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down)
+ + tex_half_scaled(tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down)
+ - tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down));
+ break;
+ case 5:
+ *shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_down);
+ break;
+ default:
+ {
+ scaled clr = tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_shift_down);
+ scaled gap = tex_get_math_y_parameter_checked(style, math_parameter_subscript_superscript_vgap);
+ scaled bot = tex_get_math_y_parameter_checked(style, math_parameter_superscript_subscript_bottom_max);
+ if (*shift_down < clr) {
+ *shift_down = clr;
+ }
+ clr = gap - ((*shift_up - box_depth(sup)) - (box_height(sub) - *shift_down));
+ if (clr > 0) {
+ *shift_down += clr;
+ clr = bot - (*shift_up - box_depth(sup));
+ if (clr > 0) {
+ *shift_up += clr;
+ *shift_down -= clr;
+ }
+ }
+ break;
+ }
+ }
+}
+
+static halfword tex_aux_combine_script(halfword target, halfword width, halfword pre, halfword post, halfword *k1, halfword *k2)
+{
+ *k1 = tex_new_kern_node(-(width + box_width(pre)), horizontal_math_kern_subtype);
+ *k2 = tex_new_kern_node(width, horizontal_math_kern_subtype);
+ tex_couple_nodes(*k1, pre);
+ tex_couple_nodes(pre, *k2);
+ if (post) {
+ tex_couple_nodes(*k2, post);
+ }
+ post = tex_hpack(*k1, 0, packing_additional, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_copy(*k1, target);
+ tex_attach_attribute_list_copy(*k2, target);
+ tex_attach_attribute_list_copy(post, target);
+ node_subtype(post) = math_pre_post_list;
+ return post;
+}
+
+ /*tex
+
+ The following steps are involved:
+
+ We look at the subscript character (_i) or first character in a list (_{ij}). We look at the
+ superscript character (^i) or first character in a list (^{ij}).
+
+ Construct a superscript box |x|. The bottom of a superscript should never descend below the
+ baseline plus one-fourth of the x-height.
+
+ Construct a sub/superscript combination box |x|, with the superscript offset by |delta|. When
+ both subscript and superscript are present, the subscript must be separated from the superscript
+ by at least four times |preset_rule_thickness|. If this condition would be violated, the
+ subscript moves down, after which both subscript and superscript move up so that the bottom
+ of the superscript is at least as high as the baseline plus four-fifths of the x-height.
+
+ Now the horizontal shift for the superscript; the superscript is also to be shifted by |delta1|
+ (the italic correction).
+
+ Construct a subscript box |x| when there is no superscript. When there is a subscript without
+ a superscript, the top of the subscript should not exceed the baseline plus four-fifths of the
+ x-height.
+
+ We start with some helpers that deal with the staircase kerns in \OPENTYPE\ math.
+
+*/
+
+/*tex
+
+ This function tries to find the kern needed for proper cut-ins. The left side doesn't move, but
+ the right side does, so the first order of business is to create a staggered fence line on the
+ left side of the right character.
+
+ If the fonts for the left and right bits of a mathkern are not both new-style fonts, then return
+ a sentinel value meaning: please use old-style italic correction placement
+
+ This code is way to complex as it evolved stepwise and we wanted to keep the post scripts code
+ more or less the same. but ... I'll redo it.
+
+*/
+
+static scaled tex_aux_math_kern_at(halfword fnt, int chr, int side, int value)
+{
+ /*tex We know that the character exists. */
+ charinfo *ci = tex_get_charinfo(fnt, chr);
+ if (ci->math) {
+ scaled *kerns_heights;
+ int n_of_kerns = tex_get_charinfo_math_kerns(ci, side);
+ if (n_of_kerns == 0) {
+ switch (side) {
+ case top_left_kern:
+ return tex_char_top_left_kern_from_font(fnt, chr);
+ case bottom_left_kern:
+ return tex_char_bottom_left_kern_from_font(fnt, chr);
+ break;
+ case top_right_kern:
+ return tex_char_top_right_kern_from_font(fnt, chr);
+ case bottom_right_kern:
+ return tex_char_bottom_right_kern_from_font(fnt, chr);
+ default:
+ return 0;
+ }
+ } else {
+ switch (side) {
+ case top_left_kern:
+ kerns_heights = ci->math->top_left_math_kern_array;
+ break;
+ case bottom_left_kern:
+ kerns_heights = ci->math->bottom_left_math_kern_array;
+ break;
+ case top_right_kern:
+ kerns_heights = ci->math->top_right_math_kern_array;
+ break;
+ case bottom_right_kern:
+ kerns_heights = ci->math->bottom_right_math_kern_array;
+ break;
+ default:
+ /*tex Not reached: */
+ kerns_heights = NULL;
+ return tex_confusion("math kern at");
+ }
+ }
+ if (value < kerns_heights[0]) {
+ return kerns_heights[1];
+ } else {
+ scaled kern = 0;
+ for (int i = 0; i < n_of_kerns; i++) {
+ scaled height = kerns_heights[i * 2];
+ kern = kerns_heights[(i * 2) + 1];
+ if (height > value) {
+ return kern;
+ }
+ }
+ return kern;
+ }
+ } else {
+ return 0;
+ }
+}
+
+inline static scaled tex_aux_max_left_kern_value(scaled *kerns, int n)
+{
+ if (kerns && n > 0) {
+ scaled kern = 0;
+ for (int i = 0; i < n; i++) {
+ scaled value = kerns[(i * 2) + 1];
+ if (value < kern) {
+ kern = value;
+ }
+ }
+ return -kern;
+ } else {
+ return 0;
+ }
+}
+
+static scaled tex_aux_math_left_kern(halfword fnt, int chr)
+{
+ charinfo *ci = tex_get_charinfo(fnt, chr);
+ if (ci->math) {
+ scaled top = 0;
+ scaled bot = 0;
+ {
+ scaled *a = ci->math->top_left_math_kern_array;
+ halfword n = a ? tex_get_charinfo_math_kerns(ci, top_left_kern) : 0;
+ if (n) {
+ top = tex_aux_max_left_kern_value(a, n);
+ } else {
+ top = tex_char_top_left_kern_from_font(fnt, chr);
+ }
+ }
+ {
+ scaled *a = ci->math->bottom_left_math_kern_array;
+ halfword n = a ? tex_get_charinfo_math_kerns(ci, bottom_left_kern) : 0;
+ if (n) {
+ bot = tex_aux_max_left_kern_value(a, n);
+ } else {
+ bot = tex_char_bottom_left_kern_from_font(fnt, chr);
+ }
+ }
+ return top > bot ? top : bot;
+ } else {
+ return 0;
+ }
+}
+
+/*
+
+inline static scaled tex_aux_max_right_kern_value(scaled *kerns, int n)
+{
+ if (kerns && n > 0) {
+ scaled kern = 0;
+ for (int i = 0; i < n; i++) {
+ scaled value = kerns[(i * 2) + 1];
+ if (value > kern) {
+ kern = value;
+ }
+ }
+ return kern;
+ } else {
+ return 0;
+ }
+}
+
+static scaled tex_aux_math_right_kern(halfword fnt, int chr)
+{
+ charinfo *ci = tex_get_charinfo(fnt, chr);
+ if (ci->math) {
+ scaled top = 0;
+ scaled bot = 0;
+ {
+ scaled *a = ci->math->top_right_math_kern_array;
+ halfword n = a ? tex_get_charinfo_math_kerns(ci, top_right_kern) : 0;
+ if (n) {
+ top = tex_aux_max_right_kern_value(a, n);
+ } else {
+ top = tex_char_top_right_kern_from_font(fnt, chr);
+ }
+ }
+ {
+ scaled *a = ci->math->bottom_right_math_kern_array;
+ halfword n = a ? tex_get_charinfo_math_kerns(ci, bottom_right_kern) : 0;
+ if (n) {
+ bot = tex_aux_max_right_kern_value(a, n);
+ } else {
+ bot = tex_char_bottom_right_kern_from_font(fnt, chr);
+ }
+ }
+ return top > bot ? top : bot;
+ } else {
+ return 0;
+ }
+}
+*/
+
+static scaled tex_aux_find_math_kern(halfword l_f, int l_c, halfword r_f, int r_c, int cmd, scaled shift, int *found)
+{
+ if (tex_aux_math_engine_control(l_f, math_control_staircase_kern) &&
+ tex_aux_math_engine_control(r_f, math_control_staircase_kern) &&
+ /* tex_aux_has_opentype_metrics(l_f) && tex_aux_has_opentype_metrics(r_f) && */
+ tex_char_exists(l_f, l_c) && tex_char_exists(r_f, r_c)) {
+ scaled krn_l = 0;
+ scaled krn_r = 0;
+ scaled krn = 0;
+ switch (cmd) {
+ case superscript_cmd:
+ /*tex bottom of superscript */
+ {
+ scaled corr_height_top = tex_char_height_from_font(l_f, l_c);
+ scaled corr_height_bot = -tex_char_depth_from_font(r_f, r_c) + shift;
+ krn_l = tex_aux_math_kern_at(l_f, l_c, top_right_kern, corr_height_top);
+ krn_r = tex_aux_math_kern_at(r_f, r_c, bottom_left_kern, corr_height_top);
+ krn = krn_l + krn_r;
+ krn_l = tex_aux_math_kern_at(l_f, l_c, top_right_kern, corr_height_bot);
+ krn_r = tex_aux_math_kern_at(r_f, r_c, bottom_left_kern, corr_height_bot);
+ }
+ break;
+ case subscript_cmd:
+ /*tex top of subscript */
+ {
+ scaled corr_height_top = tex_char_height_from_font(r_f, r_c) - shift;
+ scaled corr_height_bot = -tex_char_depth_from_font(l_f, l_c);
+ krn_l = tex_aux_math_kern_at(l_f, l_c, bottom_right_kern, corr_height_top);
+ krn_r = tex_aux_math_kern_at(r_f, r_c, top_left_kern, corr_height_top);
+ krn = krn_l + krn_r;
+ krn_l = tex_aux_math_kern_at(l_f, l_c, bottom_right_kern, corr_height_bot);
+ krn_r = tex_aux_math_kern_at(r_f, r_c, top_left_kern, corr_height_bot);
+ }
+ break;
+ default:
+ return tex_confusion("find math kern");
+ }
+ *found = 1;
+ if ((krn_l + krn_r) < krn) {
+ krn = krn_l + krn_r;
+ }
+ return krn ? tex_aux_math_x_size_scaled(l_f, krn, lmt_math_state.size) : 0;
+ } else {
+ return MATH_KERN_NOT_FOUND;
+ }
+}
+
+static int tex_aux_get_sup_kern(halfword kernel, scriptdata *sup, scaled shift_up, scaled supshift, scaled *supkern, kernset *kerns)
+{
+ int found = 0;
+ *supkern = MATH_KERN_NOT_FOUND;
+ if (sup->node) {
+ *supkern = tex_aux_find_math_kern(glyph_font(kernel), glyph_character(kernel), sup->fnt, sup->chr, superscript_cmd, shift_up, &found);
+ if (*supkern == MATH_KERN_NOT_FOUND) {
+ *supkern = supshift;
+ } else {
+ if (*supkern) {
+ tex_aux_trace_kerns(*supkern, "superscript kern", "regular");
+ }
+ *supkern += supshift;
+ }
+ return found;
+ }
+ if (kerns && kerns->topright) {
+ *supkern = kerns->topright;
+ if (*supkern == MATH_KERN_NOT_FOUND) {
+ *supkern = supshift;
+ } else {
+ if (*supkern) {
+ tex_aux_trace_kerns(*supkern, "superscript kern", "kernset top right");
+ }
+ *supkern += supshift;
+ }
+ return found;
+ }
+ *supkern = supshift;
+ return found;
+}
+
+static int tex_aux_get_sub_kern(halfword kernel, scriptdata *sub, scaled shift_down, scaled subshift, scaled *subkern, kernset *kerns)
+{
+ int found = 0;
+ *subkern = MATH_KERN_NOT_FOUND;
+ if (sub->node) {
+ *subkern = tex_aux_find_math_kern(glyph_font(kernel), glyph_character(kernel), sub->fnt, sub->chr, subscript_cmd, shift_down, &found);
+ if (*subkern == MATH_KERN_NOT_FOUND) {
+ *subkern = subshift;
+ } else {
+ if (*subkern) {
+ tex_aux_trace_kerns(*subkern, "subscript kern", "regular");
+ }
+ *subkern += subshift;
+ }
+ return found;
+ }
+ if (kerns && kerns->bottomright) {
+ *subkern = kerns->bottomright;
+ if (*subkern == MATH_KERN_NOT_FOUND) {
+ *subkern = subshift;
+ } else {
+ if (*subkern) {
+ tex_aux_trace_kerns(*subkern, "superscript kern", "kernset bottom right");
+ }
+ *subkern += subshift;
+ }
+ return found;
+ }
+ *subkern = subshift;
+ return found;
+}
+
+/*tex
+
+ The code is quite ugly because these staircase kerns can only be calculated when we know the
+ heights and depths but when we pack the pre/post scripts we already relatiev position them so
+ we need to manipulate kerns. I need to figure out why we have slight rounding errors in the
+ realignments of prescripts. Anyway, because prescripts are not really part of \TEX\ we have
+ some freedom in dealing with them.
+
+ This code is now a bit too complex due to some (probably by now) redundant analysis so at some
+ point I will rewrite it.
+
+*/
+
+inline static scaled tex_aux_insert_italic_now(halfword target, halfword kernel, scaled italic)
+{
+ switch (node_type(noad_nucleus(target))) {
+ case math_char_node:
+ case math_text_char_node:
+ {
+ halfword fam = noad_family(noad_nucleus(target));
+ if (fam != unused_math_family) {
+ halfword fnt = tex_fam_fnt(fam, lmt_math_state.size);
+ if (! tex_aux_math_engine_control(fnt, math_control_apply_script_italic_kern)) {
+ /*tex We ignore the correction. */
+ italic = 0;
+ } else if (noad_subscr(target)) {
+ /*tex We will add the correction before the superscripts and/or primes. */
+ } else {
+ /*tex We can add the correction the kernel and then forget about it. */
+ tex_aux_math_insert_italic_kern(kernel, italic, noad_nucleus(target), "scripts");
+ italic = 0;
+ }
+ } else {
+ /*tex We have a weird case, so we ignore the correction. */
+ italic = 0;
+ }
+ }
+ break;
+ }
+ return italic;
+}
+
+static inline int tex_aux_raise_prime_composed(halfword target)
+{
+ int mainclass = -1 ;
+ /* maybe also mainclass */
+ switch (node_type(target)) {
+ case simple_noad:
+ mainclass = node_subtype(target);
+ break;
+ case radical_noad:
+ mainclass = radical_noad_subtype;
+ break;
+ case fraction_noad:
+ mainclass = fraction_noad_subtype;
+ break;
+ case accent_noad:
+ mainclass = accent_noad_subtype;
+ break;
+ case fence_noad:
+ /* we could be more granular and do open / close nut for now assume symmetry */
+ mainclass = fenced_noad_subtype;
+ break;
+ }
+ return mainclass >= 0 ? tex_math_has_class_option(mainclass, raise_prime_option) : 0;
+}
+
+static void tex_aux_make_scripts(halfword target, halfword kernel, scaled italic, int style, scaled supshift, scaled subshift, scaled supdrop, kernset *kerns)
+{
+ halfword result = null;
+ halfword preresult = null;
+ scaled prekern = 0;
+ scaled primekern = 0;
+ scaled shift_up = 0;
+ scaled shift_down = 0;
+ scaled prime_up = 0;
+ scriptdata postsubdata = { .node = null, .fnt = null_font, .chr = 0, .box = null, .kern = null, .slack = 0, .shifted = 0 };
+ scriptdata postsupdata = { .node = null, .fnt = null_font, .chr = 0, .box = null, .kern = null, .slack = 0, .shifted = 0 };
+ scriptdata presubdata = { .node = null, .fnt = null_font, .chr = 0, .box = null, .kern = null, .slack = 0, .shifted = 0 };
+ scriptdata presupdata = { .node = null, .fnt = null_font, .chr = 0, .box = null, .kern = null, .slack = 0, .shifted = 0 };
+ scriptdata primedata = { .node = null, .fnt = null_font, .chr = 0, .box = null, .kern = null, .slack = 0, .shifted = 0 };
+ halfword maxleftkern = 0;
+ // halfword maxrightkern = 0;
+ scaled leftslack = 0;
+ scaled rightslack = 0;
+ scaledwhd kernelsize = { .wd = 0, .ht = 0, .dp = 0, .ic = 0 };
+ // scaled primewidth = 0;
+ scaled topovershoot = 0;
+ scaled botovershoot = 0;
+ int italicmultiplier = 1; /* This was a hard coded 2 so it needs more checking! */
+ int splitscripts = 0;
+ quarterword primestate = prime_unknown_location;
+ /*tex
+ This features was added when MS and I found that the Latin Modern (and other) fonts have
+ rather badly configured script (calligraphic) shapes. There is no provision for proper
+ anchoring subscripts and superscripts can overlap with for instance wide accents especially
+ when there is not much granularity in them. For that we now register the overshoot of
+ accents and compensate for them here.
+
+ One assumption is that the shape is somewhat italic and that an overshoot makes it even
+ more so. The two factors default to zero, so it only works when the right parameters are
+ set.
+
+ It's a mess. By adding more and more and also trying to be a bit like old \TEX\ we now have
+ too many kerns.
+
+ */
+ if (node_type(target) == accent_noad) {
+ scaled top = tex_get_math_parameter_default(style, math_parameter_accent_top_overshoot, 0);
+ scaled bot = tex_get_math_parameter_default(style, math_parameter_accent_bottom_overshoot, 0);
+ topovershoot = scaledround(accent_top_overshoot(target) * top / 100.0);
+ botovershoot = scaledround(accent_top_overshoot(target) * bot / 100.0);
+ }
+ /*tex
+ So this is somewhat weird. We pass the kernel and also some italic and then act upon the
+ target again. This is a bit messy side effect of the transition from old to new fonts. We
+ also have to make sure that we don't add the correction too soon, that is, before the
+ subscript.
+ */
+ if (italic) {
+ italic = tex_aux_insert_italic_now(target, kernel, italic);
+ }
+ /*tex
+ In some cases we need to split the scripts, for instance when we have fenced material that
+ can get split over lines.
+ */
+ if (node_type(target) == simple_noad) {
+ switch (node_subtype(target)) {
+ case fenced_noad_subtype:
+ splitscripts = tex_math_has_class_option(fenced_noad_subtype, unpack_class_option);
+ break;
+ case ghost_noad_subtype:
+ splitscripts = has_noad_option_unpacklist(target);
+ break;
+ }
+ }
+ /*tex
+ When we have a single character we need to deal with kerning based on staircase kerns, but
+ we also can have explicit kerns defined with single characters, which is more a \CONTEXT\
+ feature as it is not in \OPENTYPE\ fonts.
+ */
+ tex_aux_assign_new_hlist(target, kernel);
+ kernelsize = tex_natural_hsizes(kernel, null, 0.0, 0, 0);
+ if (kerns) {
+ /* todo: option */
+ if (kerns->height) {
+ kernelsize.ht = kerns->height;
+ }
+ if (kerns->depth) {
+ kernelsize.dp = kerns->depth;
+ }
+ }
+ switch (node_type(kernel)) {
+ case glyph_node:
+ postsubdata.node = tex_aux_analyze_script(noad_subscr(target), &postsubdata);
+ postsupdata.node = tex_aux_analyze_script(noad_supscr(target), &postsupdata);
+ primedata.node = tex_aux_analyze_script(noad_prime(target), &primedata);
+ maxleftkern = tex_aux_math_left_kern(glyph_font(kernel), glyph_character(kernel));
+ // maxrightkern = tex_aux_math_right_kern(glyph_font(kernel), glyph_character(kernel));
+ prime_up = tex_get_math_y_parameter_default(style, math_parameter_prime_shift_drop, 0);
+ shift_up = tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_drop);
+ shift_down = tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_drop);
+ break; // fallthrough
+ default:
+ kernelsize.ht -= supdrop; /* new */
+ prime_up = kernelsize.ht - tex_get_math_y_parameter_default(style, math_parameter_prime_shift_drop, 0);
+ shift_up = kernelsize.ht - tex_get_math_y_parameter_checked(style, math_parameter_superscript_shift_drop);
+ shift_down = kernelsize.dp + tex_get_math_y_parameter_checked(style, math_parameter_subscript_shift_drop);
+ break;
+ }
+ /*tex
+ Next we're doing some analysis, needed because of all these parameters than control horizontal and vertical
+ spacing. We start with primes.
+ */
+ if (noad_prime(target)) {
+ /* todo extra */
+ scaled shift = tex_get_math_y_parameter_default(style, math_parameter_prime_shift_up, 0);
+ scaled raise = tex_get_math_y_parameter_default(style, tex_aux_raise_prime_composed(target) ? math_parameter_prime_raise_composed : math_parameter_prime_raise, 0);
+ scaled distance = tex_get_math_x_parameter_default(style, math_parameter_prime_space_after, 0);
+ // scaled width = tex_get_math_x_parameter_default(style, math_parameter_prime_width, 0);
+ primedata.box = tex_aux_clean_box(noad_prime(target), (has_noad_option_nosupscript(target) ? style : tex_math_style_variant(style, math_parameter_prime_variant)), style, math_sup_list, 0, NULL);
+ box_shift_amount(primedata.box) -= prime_up ? prime_up : shift;
+ box_shift_amount(primedata.box) -= scaledround(box_height(primedata.box) * raise / 100.0);
+ kernel_math_list(noad_prime(target)) = null;
+ tex_flush_node(noad_prime(target));
+ noad_prime(target) = null;
+ if (noad_supscr(target)) {
+ primestate = prime_at_end_location;
+ } else if (noad_subscr(target)) {
+ primestate = prime_above_sub_location;
+ } else {
+ primestate = prime_at_begin_location;
+ }
+ if (distance) {
+ tex_aux_append_hkern_to_box_list(primedata.box, distance, horizontal_math_kern_subtype, "prime distance");
+ }
+ primedata.slack = distance;
+ switch (primestate) {
+ /* [prime] [super/sub] */
+ case prime_at_begin_location:
+ {
+ /* supshift ? */
+ tex_aux_get_sup_kern(kernel, &primedata, shift_up, supshift, &primekern, kerns);
+ if (italic) {
+ /* why no injection */
+ primekern += italic;
+ italic = 0;
+ }
+ }
+ break;
+ /* [prime/sub] [super] */
+ case prime_above_sub_location:
+ {
+ /* supshift ? */
+ tex_aux_get_sup_kern(kernel, &primedata, shift_up, supshift, &primekern, kerns);
+ if (italic) {
+ /* why no injection */
+ primekern += italic;
+ italic = 0;
+ }
+ if (primekern) {
+ tex_aux_prepend_hkern_to_box_list(primedata.box, primekern, math_shape_kern_subtype, "prime kern");
+ /* now width added */
+ primekern = 0; /* added */
+ }
+ }
+ break;
+ /* [super/sub] [prime] */
+ case prime_at_end_location:
+ {
+ primekern = 0;
+ }
+ break;
+ }
+ }
+ /*tex
+ Each of the scripts gets treated. Traditionally a super and subscript are looked and and
+ vercially spaced out together which in turn results in the staricase kerns needing that
+ information. Prescripts we handle differently: they are always aligned, so there the
+ maximum kern wins.
+ */
+ postsupdata.shifted = noad_supscr(target) && has_noad_option_shiftedsupscript(target);
+ postsubdata.shifted = noad_subscr(target) && has_noad_option_shiftedsubscript(target);
+ presupdata.shifted = noad_supprescr(target) && has_noad_option_shiftedsupprescript(target);
+ presubdata.shifted = noad_subprescr(target) && has_noad_option_shiftedsubprescript(target);
+ /*
+ When we have a shifted super or subscript (stored in the prescripts) we don't need to kern
+ the super and subscripts. What to do with the shifts?
+ */
+ if (noad_supscr(target)) {
+ halfword extra = tex_get_math_y_parameter_checked(style, math_parameter_extra_superscript_shift);
+ postsupdata.slack = tex_get_math_x_parameter_checked(style, math_parameter_extra_superscript_space);
+ postsupdata.slack += tex_get_math_x_parameter_checked(style, math_parameter_space_after_script);
+ postsupdata.box = tex_aux_clean_box(noad_supscr(target), (has_noad_option_nosupscript(target) ? style : tex_math_style_variant(style, math_parameter_superscript_variant)), style, math_sup_list, 0, NULL);
+ if (extra) {
+ box_height(postsupdata.box) += extra;
+ box_shift_amount(postsupdata.box) -= extra;
+ }
+ if (postsupdata.slack) {
+ tex_aux_append_hkern_to_box_list(postsupdata.box, postsupdata.slack, horizontal_math_kern_subtype, "post sup slack");
+ }
+ kernel_math_list(noad_supscr(target)) = null;
+ tex_flush_node(noad_supscr(target));
+ noad_supscr(target) = null;
+ }
+ if (noad_subscr(target)) {
+ halfword extra = tex_get_math_y_parameter_checked(style, math_parameter_extra_subscript_shift);
+ postsubdata.slack = tex_get_math_x_parameter_checked(style, math_parameter_extra_subscript_space);
+ postsubdata.slack += tex_get_math_x_parameter_checked(style, math_parameter_space_after_script);
+ postsubdata.box = tex_aux_clean_box(noad_subscr(target), (has_noad_option_nosubscript(target) ? style : tex_math_style_variant(style, math_parameter_subscript_variant)), style, math_sub_list, 0, NULL);
+ if (extra) {
+ box_depth(postsubdata.box) += extra;
+ box_shift_amount(postsubdata.box) += extra;
+ }
+ if (postsubdata.slack) {
+ tex_aux_append_hkern_to_box_list(postsubdata.box, postsubdata.slack, horizontal_math_kern_subtype, "post sub slack");
+ }
+ kernel_math_list(noad_subscr(target)) = null;
+ tex_flush_node(noad_subscr(target));
+ noad_subscr(target) = null;
+ }
+ if (noad_supprescr(target)) {
+ halfword extra = tex_get_math_y_parameter_checked(style, math_parameter_extra_superprescript_shift);
+ presupdata.slack = tex_get_math_x_parameter_checked(style, math_parameter_extra_superprescript_space);
+ presupdata.slack += tex_get_math_x_parameter_default(style, math_parameter_space_before_script, 0);
+ presupdata.box = tex_aux_clean_box(noad_supprescr(target), (has_noad_option_nosupprescript(target) ? style : tex_math_style_variant(style, math_parameter_superscript_variant)), style, math_sup_list, 0, NULL);
+ if (maxleftkern) {
+ tex_aux_append_hkern_to_box_list(presupdata.box, maxleftkern, math_shape_kern_subtype, "max left shape");
+ }
+ if (extra) {
+ box_height(presupdata.box) += extra;
+ box_shift_amount(presupdata.box) -= extra;
+ }
+ if (presupdata.slack) {
+ tex_aux_prepend_hkern_to_box_list(presupdata.box, presupdata.slack, horizontal_math_kern_subtype, "pre sup slack");
+ }
+ kernel_math_list(noad_supprescr(target)) = null;
+ tex_flush_node(noad_supprescr(target));
+ noad_supprescr(target) = null;
+ }
+ if (noad_subprescr(target)) {
+ halfword extra = tex_get_math_y_parameter_checked(style, math_parameter_extra_subprescript_shift);
+ presubdata.slack = tex_get_math_x_parameter_checked(style, math_parameter_extra_subprescript_space);
+ presubdata.slack += tex_get_math_x_parameter_default(style, math_parameter_space_before_script, 0);
+ presubdata.box = tex_aux_clean_box(noad_subprescr(target), (has_noad_option_nosubprescript(target) ? style : tex_math_style_variant(style, math_parameter_subscript_variant)), style, math_sub_list, 0, NULL);
+ if (maxleftkern) {
+ tex_aux_append_hkern_to_box_list(presubdata.box, maxleftkern, math_shape_kern_subtype, "max left shape");
+ }
+ if (extra) {
+ box_depth(presubdata.box) += extra;
+ box_shift_amount(presubdata.box) += extra;
+ }
+ if (presubdata.slack) {
+ tex_aux_prepend_hkern_to_box_list(presubdata.box, presubdata.slack, horizontal_math_kern_subtype, "pre sub slack");
+ }
+ kernel_math_list(noad_subprescr(target)) = null;
+ tex_flush_node(noad_subprescr(target));
+ noad_subprescr(target) = null;
+ }
+ /*tex
+ When we're here, the kerns are in the boxes. We now register the state of scripts in the
+ noad for (optional) later usage.
+ */
+ if (presupdata.box) {
+ noad_script_state(target) |= pre_super_script_state;
+ }
+ if (presubdata.box) {
+ noad_script_state(target) |= pre_sub_script_state;
+ }
+ if (postsupdata.box) {
+ noad_script_state(target) |= post_super_script_state;
+ }
+ if (postsubdata.box) {
+ noad_script_state(target) |= post_sub_script_state;
+ }
+ if (primedata.box) {
+ noad_script_state(target) |= prime_script_state;
+ }
+ /* */
+ if (primestate == prime_above_sub_location) {
+ rightslack = box_width(primedata.box) > box_width(postsubdata.box) ? primedata.slack : postsubdata.slack;
+ } else if (postsupdata.box) {
+ if (postsubdata.box) {
+ /* todo: take deltas */
+ rightslack = box_width(postsupdata.box) > box_width(postsubdata.box) ? postsupdata.slack : postsubdata.slack;
+ } else {
+ rightslack = postsupdata.slack;
+ }
+ } else if (postsubdata.box) {
+ rightslack = postsubdata.slack;
+ }
+
+ if (primestate == prime_above_sub_location) {
+ halfword list = noad_new_hlist(target);
+ if (list) {
+ /*tex We want to keep the size for tracing! */
+ halfword overshoot = box_width(primedata.box) - box_width(postsubdata.box);
+ halfword primebox = tex_hpack(primedata.box, 0, packing_additional, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_copy(primebox, primedata.box);
+ box_width(primebox) = 0;
+ tex_couple_nodes(tex_tail_of_node_list(list), primebox);
+ primedata.box = null;
+ if (overshoot > 0) {
+ tex_aux_append_hkern_to_box_list(postsubdata.box, overshoot, math_shape_kern_subtype, "prime overshoot kern");
+ }
+ } else {
+ list = primedata.box;
+ }
+ noad_new_hlist(target) = list;
+ }
+
+ if (presupdata.box) {
+ if (presubdata.box) {
+ /* todo: take deltas */
+ leftslack = box_width(presupdata.box) > box_width(presubdata.box) ? presupdata.slack : presubdata.slack;
+ } else {
+ leftslack = presupdata.slack;
+ }
+ } else if (presubdata.box) {
+ leftslack = presubdata.slack;
+ }
+ switch (primestate) {
+ case prime_at_begin_location:
+ kernelsize.wd += box_width(primedata.box);
+ break;
+ case prime_above_sub_location:
+ /* only excess */
+ break;
+ }
+ if (postsupdata.box || postsubdata.box) {
+ /*tex
+ The post scripts determine the shifts. An option can be to use the max of pre/post.
+ */
+ scaled supkern = 0;
+ scaled subkern = 0;
+ if (! splitscripts) {
+ if (presupdata.box) {
+ prekern = box_width(presupdata.box);
+ postsupdata.box = tex_aux_combine_script(target, kernelsize.wd, presupdata.box, postsupdata.box, &presupdata.kern, &postsupdata.kern);
+ presupdata.box = null;
+ }
+ if (presubdata.box) {
+ // test: what with negative extra kerns and what with a negative width
+ if (box_width(presubdata.box) > prekern) {
+ prekern = box_width(presubdata.box);
+ }
+ postsubdata.box = tex_aux_combine_script(target, kernelsize.wd, presubdata.box, postsubdata.box, &presubdata.kern, &postsubdata.kern);
+ presubdata.box = null;
+ }
+ }
+ /*tex
+ We want to retain the kern because it is a visual thing but it could be an option to
+ only add the excess over the shift. We're talking tiny here.
+
+ We could be clever and deal with combinations of shifted but lets play safe and let
+ the user worry about it. The sub index always wins.
+ */
+ if (postsubdata.box && postsupdata.shifted) {
+ halfword shift = tex_get_math_x_parameter_checked(style, math_parameter_subscript_shift_distance);
+ halfword amount = box_width(postsupdata.box) + shift;
+ tex_aux_prepend_hkern_to_box_list(postsubdata.box, amount, horizontal_math_kern_subtype, "post shifted");
+ } else if (postsupdata.box && postsubdata.shifted) {
+ halfword shift = tex_get_math_x_parameter_checked(style, math_parameter_superscript_shift_distance);
+ halfword amount = box_width(postsubdata.box) + shift;
+ tex_aux_prepend_hkern_to_box_list(postsupdata.box, amount, horizontal_math_kern_subtype, "post shifted");
+ }
+ if (presubdata.box && presupdata.shifted) {
+ halfword shift = tex_get_math_x_parameter_checked(style, math_parameter_subprescript_shift_distance);
+ halfword amount = box_width(presupdata.box) + shift;
+ tex_aux_append_hkern_to_box_list(presubdata.box, amount, horizontal_math_kern_subtype, "pre shifted");
+ } else if (presupdata.box && presubdata.shifted) {
+ halfword shift = tex_get_math_x_parameter_checked(style, math_parameter_superprescript_shift_distance);
+ halfword amount = box_width(presubdata.box) + shift;
+ tex_aux_append_hkern_to_box_list(presupdata.box, amount, horizontal_math_kern_subtype, "pre shifted");
+ }
+ /* */
+ if (postsupdata.box) {
+ tex_aux_get_math_sup_shifts(postsupdata.box, style, &shift_up);
+ if (postsubdata.box) {
+ tex_aux_get_math_sup_sub_shifts(postsupdata.box, postsubdata.box, style, &shift_up, &shift_down);
+ tex_aux_get_sup_kern(kernel, &postsupdata, shift_up, supshift, &supkern, kerns);
+ tex_aux_get_sub_kern(kernel, &postsubdata, shift_down, subshift, &subkern, kerns);
+ if (primestate == prime_at_begin_location) {
+ primekern += supkern ;
+ subkern = 0;
+ supkern = 0;
+ } else {
+ if (supkern) {
+ tex_aux_prepend_hkern_to_box_list(postsupdata.box, supkern, math_shape_kern_subtype, "post sup shape");
+ }
+ if (subkern) {
+ tex_aux_prepend_hkern_to_box_list(postsubdata.box, subkern, math_shape_kern_subtype, "post sub shape");
+ }
+ }
+ if (italic) {
+ tex_aux_prepend_hkern_to_box_list(postsupdata.box, italic, italic_kern_subtype, "italic");
+ }
+ if (presubdata.kern) {
+ kern_amount(presubdata.kern) += -subkern;
+ kern_amount(postsubdata.kern) += subkern;
+ }
+ if (presupdata.kern) {
+ /* italic needs checking */
+ kern_amount(presupdata.kern) += -supkern - italicmultiplier * italic;
+ kern_amount(postsupdata.kern) += supkern + italicmultiplier * italic;
+ }
+ {
+ halfword kern = tex_new_kern_node((shift_up - box_depth(postsupdata.box)) - (box_height(postsubdata.box) - shift_down), vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, target);
+ tex_couple_nodes(postsupdata.box, kern);
+ tex_couple_nodes(kern, postsubdata.box);
+ result = tex_vpack(postsupdata.box, 0, packing_additional, max_dimen, (singleword) math_direction_par, holding_none_option);
+ tex_attach_attribute_list_copy(result, target);
+ node_subtype(result) = math_scripts_list;
+ box_shift_amount(result) = shift_down;
+ }
+ } else {
+ tex_aux_get_sup_kern(kernel, &postsupdata, shift_up, supshift, &supkern, kerns);
+ if (primestate == prime_at_begin_location) {
+ primekern += supkern ;
+ supkern = 0;
+ } else if (supkern) {
+ tex_aux_prepend_hkern_to_box_list(postsupdata.box, supkern, math_shape_kern_subtype, "post sup shape");
+ }
+ box_shift_amount(postsupdata.box) = -shift_up;
+ result = postsupdata.box;
+ if (presupdata.kern) {
+ kern_amount(presupdata.kern) += -supkern - subkern - italicmultiplier * italic;
+ kern_amount(postsupdata.kern) += supkern + subkern + italicmultiplier * italic;
+ }
+ }
+ } else {
+ tex_aux_get_math_sub_shifts(postsubdata.box, style, &shift_down);
+ tex_aux_get_sub_kern(kernel, &postsubdata, shift_down, subshift, &subkern, kerns);
+ if (primestate == prime_at_begin_location) {
+ subkern = 0;
+ } else if (subkern) {
+ tex_aux_prepend_hkern_to_box_list(postsubdata.box, subkern, math_shape_kern_subtype, "post sub shape");
+ }
+ box_shift_amount(postsubdata.box) = shift_down;
+ result = postsubdata.box;
+ if (presubdata.kern) {
+ kern_amount(presubdata.kern) += -subkern;
+ kern_amount(postsubdata.kern) += subkern;
+ }
+ }
+ /* */
+ if (! splitscripts) {
+ if (topovershoot) {
+ /* todo: tracing */
+ if (noad_script_state(target) & pre_super_script_state) {
+ kern_amount(postsubdata.kern) -= topovershoot;
+ kern_amount(postsupdata.kern) -= topovershoot;
+ }
+ if (noad_script_state(target) & post_sub_script_state) {
+ kern_amount(presupdata.kern) += topovershoot;
+ }
+ }
+ if (botovershoot) {
+ /* todo: tracing, yet untested */
+ if (noad_script_state(target) & pre_sub_script_state) {
+ kern_amount(presubdata.kern) -= botovershoot;
+ kern_amount(presupdata.kern) -= botovershoot;
+ }
+ if (noad_script_state(target) & post_sub_script_state) {
+ kern_amount(presubdata.kern) += botovershoot;
+ }
+ }
+ goto PICKUP;
+ }
+ }
+ if (presubdata.box) {
+ if (presupdata.box) {
+ tex_aux_get_math_sup_shifts(presupdata.box, style, &shift_up);
+ tex_aux_get_math_sup_sub_shifts(presupdata.box, presubdata.box, style, &shift_up, &shift_down);
+ prekern = box_width(presupdata.box);
+ // test: what with negative extra kerns and what with a negative width
+ if (! splitscripts) {
+ if (box_width(presubdata.box) > prekern) {
+ prekern = box_width(presubdata.box);
+ }
+ presupdata.box = tex_aux_combine_script(target, kernelsize.wd, presupdata.box, null, &presupdata.kern, &postsupdata.kern);
+ presubdata.box = tex_aux_combine_script(target, kernelsize.wd, presubdata.box, null, &presubdata.kern, &postsubdata.kern);
+ }
+ {
+ halfword k = tex_new_kern_node((shift_up - box_depth(presupdata.box)) - (box_height(presubdata.box) - shift_down), vertical_math_kern_subtype);
+ tex_attach_attribute_list_copy(k, target);
+ tex_couple_nodes(presupdata.box, k);
+ tex_couple_nodes(k, presubdata.box);
+ preresult = tex_vpack(presupdata.box, 0, packing_additional, max_dimen, (singleword) math_direction_par, holding_none_option);
+ tex_attach_attribute_list_copy(preresult, target);
+ node_subtype(preresult) = math_scripts_list;
+ box_shift_amount(preresult) = shift_down;
+ }
+ } else {
+ tex_aux_get_math_sub_shifts(presubdata.box, style, &shift_down);
+ if (! splitscripts) {
+ prekern = box_width(presubdata.box);
+ presubdata.box = tex_aux_combine_script(target, kernelsize.wd, presubdata.box, null, &presubdata.kern, &postsubdata.kern);
+ }
+ box_shift_amount(presubdata.box) = shift_down;
+ preresult = presubdata.box;
+ }
+ } else if (presupdata.box) {
+ tex_aux_get_math_sup_shifts(presupdata.box, style, &shift_up);
+ if (! splitscripts) {
+ prekern = box_width(presupdata.box);
+ presupdata.box = tex_aux_combine_script(target, kernelsize.wd, presupdata.box, null, &presupdata.kern, &postsupdata.kern);
+ }
+ box_shift_amount(presupdata.box) = -shift_up;
+ preresult = presupdata.box;
+ }
+ PICKUP:
+ if (primestate == prime_at_begin_location) {
+ halfword list = noad_new_hlist(target);
+ if (primekern) {
+ tex_aux_prepend_hkern_to_box_list(primedata.box, primekern, math_shape_kern_subtype, "prime");
+ }
+ if (list) {
+ tex_couple_nodes(tex_tail_of_node_list(list), primedata.box);
+ } else {
+ list = primedata.box;
+ }
+ noad_new_hlist(target) = list;
+ }
+ if (splitscripts) {
+ halfword list = noad_new_hlist(target);
+ if (preresult) {
+ if (list) {
+ tex_couple_nodes(preresult, list);
+ }
+ list = preresult;
+ }
+ if (result) {
+ if (list) {
+ tex_couple_nodes(tex_tail_of_node_list(list), result);
+ } else {
+ list = result;
+ }
+ }
+ noad_new_hlist(target) = list;
+ } else {
+ if (preresult) {
+ result = preresult;
+ }
+ if (prekern) {
+ /* must become horizontal kern */
+ halfword list = tex_aux_prepend_hkern_to_new_hlist(target, prekern, horizontal_math_kern_subtype, "pre compensation");
+ tex_couple_nodes(tex_tail_of_node_list(list), result);
+ } else if (noad_new_hlist(target)) {
+ tex_couple_nodes(tex_tail_of_node_list(noad_new_hlist(target)), result);
+ } else {
+ noad_new_hlist(target) = result;
+ }
+ }
+ if (primestate == prime_at_end_location) {
+ tex_couple_nodes(tex_tail_of_node_list(result), primedata.box);
+ rightslack = primedata.slack;
+ }
+ if (math_slack_mode_par > 0) {
+ noad_left_slack(target) = leftslack;
+ noad_right_slack(target) = rightslack;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: script slack, left %D, right %D]", leftslack, pt_unit, rightslack, pt_unit);
+ tex_end_diagnostic();
+ }
+ }
+}
+
+/*tex
+
+ The |make_left_right| function constructs a left or right delimiter of the required size and
+ returns the value |open_noad| or |close_noad|. The |left_noad_side| and |right_noad_side| will
+ both be based on the original |style|, so they will have consistent sizes.
+
+*/
+
+static halfword tex_aux_make_left_right(halfword target, int style, scaled max_d, scaled max_h, int size, delimiterextremes *extremes)
+{
+ halfword tmp;
+ scaled ic = 0;
+ int stack = 0;
+ halfword mainclass = get_noad_main_class(target);
+ halfword leftclass = get_noad_left_class(target);
+ halfword rightclass = get_noad_right_class(target);
+ scaled height = tex_aux_math_given_y_scaled(noad_height(target));
+ scaled depth = tex_aux_math_given_y_scaled(noad_depth(target));
+ int leftoperator = node_type(target) == fence_noad && node_subtype(target) == left_operator_side;
+ if (extremes) {
+ extremes->tfont = null_font;
+ extremes->bfont = null_font;
+ extremes->tchar = 0;
+ extremes->tchar = 0;
+ extremes->height = 0;
+ extremes->depth = 0;
+ }
+ tex_aux_set_current_math_size(style);
+ if (height || depth || has_noad_option_exact(target)) {
+ halfword lst;
+ scaled delta = height + depth;
+ tmp = tex_aux_make_delimiter(target, fence_delimiter_list(target), size, delta, 0, style, 0, &stack, &ic, 0, has_noad_option_nooverflow(target), extremes, 0);
+/* do extremes here */
+ noad_italic(target) = ic;
+ /*tex
+ Beware, a stacked delimiter has a shift but no corrected height/depth (yet).
+ */
+ if (stack) {
+ box_shift_amount(tmp) = depth;
+ }
+ if (has_noad_option_exact(target)) {
+ height = box_height(tmp) - box_shift_amount(tmp);
+ depth = box_depth(tmp) + box_shift_amount(tmp);
+ }
+ if (has_noad_option_axis(target)) {
+ halfword axis = tex_aux_math_axis(size);
+ height += axis;
+ depth -= axis;
+ box_shift_amount(tmp) -= axis;
+ }
+ lst = tex_new_node(hlist_node, 0);
+ tex_attach_attribute_list_copy(lst, target);
+ box_dir(lst) = dir_lefttoright ;
+ box_height(lst) = height;
+ box_depth(lst) = depth;
+ box_width(lst) = box_width(tmp);
+ box_list(lst) = tmp;
+ tmp = lst;
+ } else {
+ int axis = ! has_noad_option_noaxis(target);
+ scaled delta = 0;
+ if (leftoperator && has_noad_option_auto(target)) {
+ /*tex Todo: option for skipping this. */
+ if (style < text_style) {
+ scaled s = scaledround(tex_get_math_parameter(style, math_parameter_operator_size, NULL));
+ if (s > max_h + max_d) {
+ max_h = scaledround(s / 2.0);
+ max_d = max_h;
+ delta = max_h + max_d;
+ }
+ }
+ }
+ if (! delta) {
+ delta = tex_aux_get_delimiter_height(max_h, max_d, axis, size, style); // todo: pass scaled axis
+ }
+ tmp = tex_aux_make_delimiter(target, fence_delimiter_list(target), size, delta, 0, style, axis, &stack, &ic, 0, has_noad_option_nooverflow(target), extremes, 0);
+ }
+ /* delimiter is wiped */
+ noad_height(target) = height;
+ noad_depth(target) = depth;
+ fence_delimiter_list(target) = null;
+ noad_italic(target) = ic;
+ /* */
+ if (noad_source(target)) {
+ box_source_anchor(tmp) = noad_source(target);
+ // box_anchor(tmp) = left_origin_anchor;
+ tex_set_box_geometry(tmp, anchor_geometry);
+ }
+ /* */
+ if (leftoperator) {
+ halfword s = tex_new_node(sub_box_node, 0);
+ kernset kerns;
+ tex_math_wipe_kerns(&kerns);
+ tex_flush_node_list(noad_supscr(target));
+ tex_flush_node_list(noad_subscr(target));
+ tex_flush_node_list(noad_nucleus(target));
+ if (kernel_math_list(fence_delimiter_top(target))) {
+ noad_supscr(target) = fence_delimiter_top(target);
+ fence_delimiter_top(target) = null;
+ }
+ if (kernel_math_list(fence_delimiter_bottom(target))) {
+ noad_subscr(target) = fence_delimiter_bottom(target);
+ fence_delimiter_bottom(target) = null;
+ }
+ kernel_math_list(s) = tmp;
+ noad_nucleus(target) = s;
+ /* maybe elsewhere as the above case */
+ if (extremes && extremes->tfont) {
+ if (tex_math_has_class_option(fenced_noad_subtype, carry_over_right_top_kern_class_option)) {
+ kerns.topright = tex_char_top_right_kern_from_font(extremes->tfont, extremes->tchar);
+ }
+ if (tex_math_has_class_option(fenced_noad_subtype, carry_over_right_bottom_kern_class_option)) {
+ kerns.bottomright = tex_char_bottom_right_kern_from_font(extremes->bfont, extremes->bchar);
+ }
+ if (tex_math_has_class_option(fenced_noad_subtype, prefer_delimiter_dimensions_class_option)) {
+ kerns.height = extremes->height;
+ kerns.depth = extremes->depth;
+ }
+ }
+ tex_aux_make_op(target, style, size, ic, limits_unknown_mode, &kerns);
+ /* otherwise a leak: */
+ kernel_math_list(s) = null;
+ tex_flush_node(s);
+ } else {
+ tex_aux_assign_new_hlist(target, tmp);
+ }
+ /* */
+ switch (node_subtype(target)) {
+ case left_fence_side:
+ if (leftclass != unset_noad_class) {
+ return leftclass;
+ } else if (mainclass != unset_noad_class) {
+ return mainclass;
+ } else {
+ return open_noad_subtype;
+ }
+ case middle_fence_side:
+ if (mainclass != unset_noad_class) {
+ return mainclass;
+ } else {
+ return middle_noad_subtype;
+ }
+ case right_fence_side:
+ if (rightclass != unset_noad_class) {
+ return rightclass;
+ } else if (mainclass != unset_noad_class) {
+ return mainclass;
+ } else {
+ return close_noad_subtype;
+ }
+ case left_operator_side:
+ if (leftclass != unset_noad_class) {
+ return leftclass;
+ } else if (mainclass != unset_noad_class) {
+ return mainclass;
+ } else {
+ return operator_noad_subtype;
+ }
+ default:
+ if (mainclass != unset_noad_class) {
+ return mainclass;
+ } else {
+ /*tex So one can best set the class! */
+ return ordinary_noad_subtype;
+ }
+ }
+}
+
+inline static int tex_aux_fallback_math_spacing_class(halfword style, halfword class)
+{
+ unsigned parent = (unsigned) count_parameter(first_math_class_code + class);
+ switch (style) {
+ case display_style: case cramped_display_style: return (parent >> 24) & 0xFF;
+ case text_style: case cramped_text_style: return (parent >> 16) & 0xFF;
+ case script_style: case cramped_script_style: return (parent >> 8) & 0xFF;
+ case script_script_style: case cramped_script_script_style: return (parent >> 0) & 0xFF;
+ default: return 0;
+ }
+}
+
+static halfword tex_aux_math_spacing_glue(halfword ltype, halfword rtype, halfword style, scaled mmu)
+{
+ halfword c = tex_to_math_spacing_parameter(ltype, rtype);
+ halfword s = c;
+ for (int i = 1; i <= 2; i++) {
+ if (s >= 0) {
+ halfword d = 0;
+ halfword x = tex_get_math_parameter(style, s, &d);
+ if (x) {
+ switch (d) {
+ case no_val_level:
+ break;
+ case dimen_val_level:
+ if (x) {
+ x = tex_aux_math_dimen(x, inter_math_skip_glue, c);
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: inter atom kern, left %n, right %n, resolved %i, amount %D]", ltype, rtype, s, kern_amount(x), pt_unit);
+ tex_end_diagnostic();
+ }
+ return x;
+ }
+ goto NONE;
+ case glue_val_level:
+ if (! tex_glue_is_zero(x)) {
+ x = tex_aux_math_glue(x, inter_math_skip_glue, c);
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: inter atom glue, left %n, right %n, resolved %i, amount %P]", ltype, rtype, s, glue_amount(x), glue_stretch(x), NULL, NULL, NULL, glue_shrink(x));
+ tex_end_diagnostic();
+ }
+ return x;
+ }
+ goto NONE;
+ case mu_val_level:
+ if (! tex_math_glue_is_zero(x)) {
+ x = tex_aux_math_muglue(x, inter_math_skip_glue, mmu, c, style);
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: inter atom (mu) glue, left %n, right %n, resolved %i, amount %P]", ltype, rtype, s, glue_amount(x), glue_stretch(x), NULL, NULL, NULL, glue_shrink(x));
+ tex_end_diagnostic();
+ }
+ return x;
+ }
+ goto NONE;
+ default:
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: inter atom (mu) glue, left %n, right %n, resolved %i, unset]", ltype, rtype, s);
+ tex_end_diagnostic();
+ }
+ goto NONE;
+ }
+ }
+ /* try again */
+ {
+ halfword lparent = tex_aux_fallback_math_spacing_class(style, ltype);
+ halfword rparent = tex_aux_fallback_math_spacing_class(style, rtype);
+ /*tex Let's try the parents (one level). */
+ if (lparent != ltype || rparent != rtype) {
+ s = tex_to_math_spacing_parameter(lparent, rtype);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ s = tex_to_math_spacing_parameter(ltype, rparent);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ s = tex_to_math_spacing_parameter(lparent, rparent);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ }
+ /*tex We fall back on the |all| classes. */
+ s = tex_to_math_spacing_parameter(ltype, math_all_class);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ s = tex_to_math_spacing_parameter(math_all_class, rtype);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ s = tex_to_math_spacing_parameter(lparent, math_all_class);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ s = tex_to_math_spacing_parameter(math_all_class, rparent);
+ if (tex_has_math_parameter(style, s)) {
+ goto FOUND;
+ }
+ /*tex Now we're lost. */
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: inter atom fallback, left %n, right %n, left parent %n, right parent %n, not resolved]", ltype, rtype, lparent, rparent);
+ tex_end_diagnostic();
+ }
+ goto NONE;
+ FOUND:
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: inter atom fallback, left %n, right %n, left parent %n, right parent %n, resolved %i]", ltype, rtype, lparent, rparent, s);
+ tex_end_diagnostic();
+ }
+ }
+ } else {
+ /* tex_confusion("math atom spacing"); */
+ goto NONE;
+ }
+ }
+ NONE:
+ if (math_spacing_mode_par && c >= 0) {
+ if (math_spacing_mode_par == 1 && (ltype == math_begin_class || rtype == math_end_class)) {
+ return null;
+ } else {
+ return tex_aux_math_dimen(0, inter_math_skip_glue, c);
+ }
+ } else {
+ return null;
+ }
+}
+
+inline static int tex_aux_fallback_math_ruling_class(halfword style, halfword class)
+{
+ unsigned parent = (unsigned) count_parameter(first_math_atom_code + class);
+ switch (style) {
+ case display_style: case cramped_display_style: return (parent >> 24) & 0xFF;
+ case text_style: case cramped_text_style: return (parent >> 16) & 0xFF;
+ case script_style: case cramped_script_style: return (parent >> 8) & 0xFF;
+ case script_script_style: case cramped_script_script_style: return (parent >> 0) & 0xFF;
+ default: return 0;
+ }
+}
+
+static halfword tex_aux_math_ruling(halfword ltype, halfword rtype, halfword style)
+{
+ halfword c = tex_to_math_rules_parameter(ltype, rtype);
+ halfword s = c;
+ for (int i = 1; i <= 2; i++) {
+ if (s >= 0) {
+ halfword x = tex_get_math_parameter(style, s, NULL);
+ if (x != MATHPARAMDEFAULT) {
+ return x;
+ } else {
+ halfword lparent = tex_aux_fallback_math_ruling_class(style, ltype);
+ halfword rparent = tex_aux_fallback_math_ruling_class(style, rtype);
+ if (lparent != ltype || rparent != rtype) {
+ s = tex_to_math_rules_parameter(lparent, rparent);
+ } else {
+ return MATHPARAMDEFAULT;
+ }
+ }
+ } else {
+ return MATHPARAMDEFAULT;
+ }
+ }
+ return MATHPARAMDEFAULT;
+}
+
+halfword tex_math_spacing_glue(halfword ltype, halfword rtype, halfword style)
+{
+ halfword mu = tex_get_math_quad_size_scaled(lmt_math_state.size);
+ halfword sg = tex_aux_math_spacing_glue(ltype, rtype, style, mu);
+ if (node_type(sg) == glue_node) {
+ tex_add_glue_option(sg, glue_option_no_auto_break);
+ }
+ return sg;
+}
+
+/*tex
+
+ This is a bit complex function and it can beter be merged into the caller and be more specific
+ there. The delta parameter can have a value already. When it keeps it value the caller can add
+ is as italic correction. However, when we have no scripts we do it here.
+
+ Also, in some cases a new glyph is made while we alredy have one. The fetch routine also sets
+ |lmt_math_state.opentype| so we can use it here. The complexity of the muxed machinery makes
+ this complexity test also complex.
+
+*/
+
+static halfword tex_aux_check_nucleus_complexity(halfword target, scaled *italic, halfword style, halfword size, kernset *kerns)
+{
+ halfword nucleus = noad_nucleus(target);
+ if (nucleus) {
+ if (italic) {
+ *italic = 0;
+ }
+ switch (node_type(nucleus)) {
+ case math_char_node:
+ case math_text_char_node:
+ {
+ halfword chr = null;
+ halfword fnt = null;
+ if (tex_aux_fetch(nucleus, "(text) char", &fnt, &chr)) {
+ /*tex We make a math glyph from an ordinary one. */
+ quarterword subtype = 0;
+ switch (node_subtype(nucleus)) {
+ case ordinary_noad_subtype: subtype = glyph_math_ordinary_subtype; break;
+ case operator_noad_subtype: subtype = glyph_math_operator_subtype; break;
+ case binary_noad_subtype: subtype = glyph_math_binary_subtype; break;
+ case relation_noad_subtype: subtype = glyph_math_relation_subtype; break;
+ case open_noad_subtype: subtype = glyph_math_open_subtype; break;
+ case close_noad_subtype: subtype = glyph_math_close_subtype; break;
+ case punctuation_noad_subtype: subtype = glyph_math_punctuation_subtype; break;
+ case variable_noad_subtype: subtype = glyph_math_variable_subtype; break;
+ case active_noad_subtype: subtype = glyph_math_active_subtype; break;
+ case inner_noad_subtype: subtype = glyph_math_inner_subtype; break;
+ case over_noad_subtype: subtype = glyph_math_over_subtype; break;
+ case under_noad_subtype: subtype = glyph_math_under_subtype; break;
+ case fraction_noad_subtype: subtype = glyph_math_fraction_subtype; break;
+ case radical_noad_subtype: subtype = glyph_math_radical_subtype; break;
+ case middle_noad_subtype: subtype = glyph_math_middle_subtype; break;
+ case accent_noad_subtype: subtype = glyph_math_accent_subtype; break;
+ case fenced_noad_subtype: subtype = glyph_math_fenced_subtype; break;
+ case ghost_noad_subtype: subtype = glyph_math_ghost_subtype; break;
+ default:
+ if (node_subtype(nucleus) < math_begin_class) {
+ /*tex
+ So at least we can recongize them and have some slack for
+ new ones below this boundary. Nicer would be to be in range
+ but then we have to ditch the normal glyph subtypes. Maybe
+ we should move all classes above this edge.
+ */
+ subtype = glyph_math_extra_subtype + node_subtype(nucleus);
+ }
+ break;
+
+ }
+ halfword glyph = tex_aux_new_math_glyph(fnt, chr, subtype);
+ tex_attach_attribute_list_copy(glyph, nucleus);
+ if (node_type(nucleus) == math_char_node) {
+ glyph_properties(glyph) = kernel_math_properties(nucleus);
+ glyph_group(glyph) = kernel_math_group(nucleus);
+ glyph_index(glyph) = kernel_math_index(nucleus);
+ if (math_kernel_node_has_option(nucleus, math_kernel_auto_discretionary)) {
+ tex_add_glyph_option(glyph, glyph_option_math_discretionary);
+ }
+ if (math_kernel_node_has_option(nucleus, math_kernel_full_discretionary)) {
+ tex_add_glyph_option(glyph, glyph_option_math_italics_too);
+ }
+ }
+ /*tex
+ Do we have a correction at all? In opentype fonts we normally set the
+ delta to zero.
+ */
+ if (math_kernel_node_has_option(nucleus, math_kernel_no_italic_correction)) {
+ /*tex
+ This node is flagged not to have italic correction.
+ */
+ } else if (tex_aux_math_followed_by_italic_kern(target, "complexity")) {
+ /*tex
+ For some reason there is (already) an explicit italic correction so we
+ don't add more here. I need a use case.
+ */
+ } else if (tex_aux_math_engine_control(fnt, math_control_apply_text_italic_kern)) {
+ /*tex
+ This is a bit messy and needs a more fundamental cleanup giving the
+ kind of control that we want.
+ */
+ if (italic) {
+ *italic = tex_aux_math_x_size_scaled(fnt, tex_char_italic_from_font(fnt, chr), size);
+ if (*italic) {
+ if (node_type(nucleus) == math_text_char_node) {
+ if (tex_aux_math_engine_control(fnt, math_control_check_text_italic_kern)) {
+ /*tex
+ We add no italic correction in mid-word of (opentype)
+ text font. This is kind of fragile so it might go away
+ or become an option.
+ */
+ if (chr == letter_cmd) {
+ *italic = 0;
+ }
+ }
+ if (tex_aux_math_engine_control(fnt, math_control_check_space_italic_kern)) {
+ /*tex
+ We're now in the traditional branch. it is a bit weird
+ test based on space being present in an old school math
+ font. For now we keep this.
+ */
+ if (tex_get_font_space(fnt)) {
+ /*tex
+ We add no italic correction in mid-word (traditional)
+ text font. In the case of a math font, the correction
+ became part of the width.
+ */
+ *italic = 0;
+ }
+ }
+ }
+ if (*italic && ! noad_has_following_scripts(target)) {
+ /*tex
+ Here we add a correction but then also have to make sure that it
+ doesn't happen later on so we zero |delta| afterwards. The call
+ handles the one script only case (maybe delegate the next too).
+ */
+ tex_aux_math_insert_italic_kern(glyph, *italic, nucleus, "check");
+ *italic = 0;
+ }
+ }
+ }
+ }
+ return glyph;
+ } else {
+ return tex_new_node(hlist_node, unknown_list);
+ }
+ }
+ case sub_box_node:
+ return kernel_math_list(nucleus);
+ case sub_mlist_node:
+ {
+ halfword list = kernel_math_list(nucleus);
+ halfword package = null;
+ halfword fenced = node_type(target) == simple_noad && node_subtype(target) == fenced_noad_subtype;
+ int unpack = tex_math_has_class_option(node_subtype(target), unpack_class_option) || has_noad_option_unpacklist(target);
+ // todo: check has_noad_option_unpacklist vs hpack later
+ // halfword result = tex_mlist_to_hlist(list, fenced || has_noad_option_unpacklist(q), style, unset_noad_class, unset_noad_class); /*tex Here we're nesting. */
+ halfword result = tex_mlist_to_hlist(list, unpack, style, unset_noad_class, unset_noad_class, kerns); /*tex Here we're nesting. */
+ tex_aux_set_current_math_size(style);
+ package = tex_hpack(result, 0, packing_additional, direction_unknown, holding_none_option);
+ if (fenced) {
+ node_subtype(package) = math_fence_list;
+ // } else if (has_noad_option_unpacklist(q)) {
+ } else if (unpack) {
+ node_subtype(package) = math_list_list;
+ } else if (noad_class_main(target) == unset_noad_class) {
+ node_subtype(package) = math_pack_list;
+ } else {
+ node_subtype(package) = 0x100 + noad_class_main(target);
+ }
+ tex_attach_attribute_list_copy(package, nucleus);
+ return package;
+ }
+ case hlist_node:
+ /* really */
+ break;
+ default:
+ tex_confusion("check nucleus complexity");
+ }
+ } else {
+ tex_normal_warning("math", "recovering from missing nucleus, best check it out");
+ noad_nucleus(target) = tex_aux_fake_nucleus(ghost_noad_subtype);
+ }
+ return tex_new_node(hlist_node, unknown_list);
+}
+
+/*tex
+ The main reason for keeping the node is that original \TEX\ has no prev links but we do have
+ these in \LUATEX. But it is anyway okay to keep this a signal.
+*/
+
+static halfword tex_aux_make_choice(halfword current, halfword style)
+{
+ halfword prv = node_prev(current);
+ halfword nxt = node_next(current);
+ halfword signal = tex_new_node(style_node, former_choice_math_style);
+ /*tex We replace choice by signal encoded in a style noad, it is no longer a cast! */
+ tex_try_couple_nodes(prv, signal);
+ tex_try_couple_nodes(signal, nxt);
+ switch (node_subtype(current)) {
+ case normal_choice_subtype:
+ {
+ halfword choice = null;
+ switch (style) {
+ case display_style:
+ case cramped_display_style:
+ choice = choice_display_mlist(current);
+ choice_display_mlist(current) = null;
+ break;
+ case text_style:
+ case cramped_text_style:
+ choice = choice_text_mlist(current);
+ choice_text_mlist(current) = null;
+ break;
+ case script_style:
+ case cramped_script_style:
+ choice = choice_script_mlist(current);
+ choice_script_mlist(current) = null;
+ break;
+ case script_script_style:
+ case cramped_script_script_style:
+ choice = choice_script_script_mlist(current);
+ choice_script_script_mlist(current) = null;
+ break;
+ }
+ /*tex We inject the choice list after the signal. */
+ if (choice) {
+ tex_couple_nodes(signal, choice);
+ tex_try_couple_nodes(tex_tail_of_node_list(choice), nxt);
+ }
+ }
+ break;
+ case discretionary_choice_subtype:
+ {
+ halfword disc = tex_new_disc_node(normal_discretionary_code);
+ halfword pre = choice_pre_break(current);
+ halfword post = choice_post_break(current);
+ halfword replace = choice_no_break(current);
+ choice_pre_break(current) = null;
+ choice_post_break(current) = null;
+ choice_no_break(current) = null;
+ if (pre) {
+ pre = tex_mlist_to_hlist(pre, 0, style, unset_noad_class, unset_noad_class, NULL);
+ tex_set_disc_field(disc, pre_break_code, pre);
+ }
+ if (post) {
+ post = tex_mlist_to_hlist(post, 0, style, unset_noad_class, unset_noad_class, NULL);
+ tex_set_disc_field(disc, post_break_code, post);
+ }
+ if (replace) {
+ replace = tex_mlist_to_hlist(replace, 0, style, unset_noad_class, unset_noad_class, NULL);
+ tex_set_disc_field(disc, no_break_code, replace);
+ }
+ disc_class(disc) = choice_class(current);
+ disc = tex_math_make_disc(disc);
+ tex_couple_nodes(signal, disc);
+ tex_try_couple_nodes(disc, nxt);
+ }
+ break;
+ }
+ /*tex We flush the old choice node */
+ tex_flush_node(current);
+ return signal;
+}
+
+/*tex
+ This is just a \quote {fixer}. Todo: prepend the top and/or bottom to the super/subscript,
+ but we also need to hpack then. Problem: how to determine the slack here? However, slack
+ is less important because we normally have binding right text here.
+*/
+
+static int tex_aux_make_fenced(halfword current, halfword current_style, halfword size, noad_classes *fenceclasses)
+{
+ halfword nucleus = noad_nucleus(current);
+ (void) current_style;
+ (void) size;
+ if (nucleus) {
+ halfword list = kernel_math_list(nucleus);
+ if (list && node_type(list) == fence_noad && node_subtype(list) == left_operator_side) {
+ fenceclasses->main = noad_class_main(list);
+ fenceclasses->left = noad_class_left(list);
+ fenceclasses->right = noad_class_right(list);
+ if (noad_supscr(current) && ! kernel_math_list(fence_delimiter_top(list))) {
+ halfword n = tex_new_node(simple_noad, ordinary_noad_subtype);
+ node_subtype(n) = math_char_node;
+ noad_nucleus(n) = noad_supscr(current);
+ kernel_math_list(fence_delimiter_top(list)) = n;
+ noad_supscr(current) = null;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_str("[math: promoting supscript to top delimiter]");
+ tex_end_diagnostic();
+ }
+ }
+ if (noad_subscr(current) && ! kernel_math_list(fence_delimiter_bottom(list))) {
+ halfword n = tex_new_node(simple_noad, ordinary_noad_subtype);
+ node_subtype(n) = math_char_node;
+ noad_nucleus(n) = noad_subscr(current);
+ kernel_math_list(fence_delimiter_bottom(list)) = n;
+ noad_subscr(current) = null;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_str("[math: promoting subscript to bottom delimiter]");
+ tex_end_diagnostic();
+ }
+ }
+ /*tex
+ Now we remove the dummy right one. If something is in between we assume it's on
+ purpose.
+ */
+ {
+ halfword nxt = node_next(list);
+ if (nxt && node_type(nxt) == fence_noad && node_subtype(nxt) == right_fence_side) {
+ /* todo : check for delimiter . or 0 */
+ node_next(list) = null;
+ tex_flush_node_list(nxt);
+ }
+ }
+ return 1; /* we had a growing one */
+ }
+ }
+ return 0;
+}
+
+static void tex_aux_finish_fenced(halfword current, halfword main_style, scaled max_depth, scaled max_height, kernset *kerns)
+{
+ delimiterextremes extremes = { .tfont = null_font, .tchar = 0, .bfont = null_font, .bchar = 0, .height = 0, .depth = 0 };
+ noad_analyzed(current) = (singleword) tex_aux_make_left_right(current, main_style, max_depth, max_height, lmt_math_state.size, &extremes);
+ if (kerns && extremes.tfont) {
+ switch (node_subtype(current)) {
+ case left_fence_side:
+ case extended_left_fence_side:
+ if (tex_math_has_class_option(fenced_noad_subtype, carry_over_left_top_kern_class_option)) {
+ kerns->topleft = tex_char_top_left_kern_from_font(extremes.tfont, extremes.tchar);
+ }
+ if (tex_math_has_class_option(fenced_noad_subtype, carry_over_left_bottom_kern_class_option)) {
+ kerns->bottomleft = tex_char_bottom_left_kern_from_font(extremes.bfont, extremes.bchar);
+ }
+ if (tex_math_has_class_option(fenced_noad_subtype, prefer_delimiter_dimensions_class_option)) {
+ kerns->height = extremes.height;
+ kerns->depth = extremes.depth;
+ }
+ break;
+ case right_fence_side:
+ case extended_right_fence_side:
+ case left_operator_side:
+ case no_fence_side:
+ if (tex_math_has_class_option(fenced_noad_subtype, carry_over_right_top_kern_class_option)) {
+ kerns->topright = tex_char_top_right_kern_from_font(extremes.tfont, extremes.tchar);
+ }
+ if (tex_math_has_class_option(fenced_noad_subtype, carry_over_right_bottom_kern_class_option)) {
+ kerns->bottomright = tex_char_bottom_right_kern_from_font(extremes.bfont, extremes.bchar);
+ }
+ if (tex_math_has_class_option(fenced_noad_subtype, prefer_delimiter_dimensions_class_option)) {
+ kerns->height = extremes.height;
+ kerns->depth = extremes.depth;
+ }
+ break;
+ }
+ }
+}
+
+/*tex
+
+ Here is the overall plan of |mlist_to_hlist|, and the list of its local variables. In
+ \LUAMETATEX\ we could actually use the fact that we have a double linked list. Because we have
+ a more generic class and penalty handling the two stages are clearly separated, also variable
+ wise.
+
+*/
+
+static halfword tex_aux_unroll_noad(halfword tail, halfword l, quarterword s)
+{
+ while (l) {
+ halfword n = node_next(l);
+ node_next(l) = null;
+ if (node_type(l) == hlist_node && (s < 0 || node_subtype(l) == s) && ! box_source_anchor(l)) {
+ if (box_list(l)) {
+ tex_couple_nodes(tail, box_list(l));
+ tail = tex_tail_of_node_list(tail);
+ box_list(l) = null;
+ }
+ tex_flush_node(l);
+ } else {
+ tex_couple_nodes(tail, l);
+ tail = l;
+ }
+ l = n;
+ }
+ return tail;
+}
+
+static halfword tex_aux_unroll_list(halfword tail, halfword l)
+{
+ while (l) {
+ halfword n = node_next(l);
+ node_next(l) = null;
+ if (node_type(l) == hlist_node && ! box_source_anchor(l)) {
+ if (box_list(l)) {
+ switch (node_subtype(l)) {
+ case hbox_list:
+ case container_list:
+ case math_list_list: /* in case of a ghost (we could remap subtype instead) */
+ tex_couple_nodes(tail, box_list(l));
+ tail = tex_tail_of_node_list(tail);
+ box_list(l) = null;
+ break;
+ default:
+ tex_couple_nodes(tail, l);
+ tail = l;
+ break;
+ }
+ }
+ tex_flush_node(l);
+ } else {
+ tex_couple_nodes(tail, l);
+ tail = l;
+ }
+ l = n;
+ }
+ return tail;
+}
+
+inline static void tex_aux_wipe_noad(halfword n)
+{
+ if (tex_nodetype_has_attributes(node_type(n))) {
+ remove_attribute_list(n);
+ }
+ tex_reset_node_properties(n);
+ tex_free_node(n, get_node_size(node_type(n)));
+}
+
+static halfword tex_aux_append_ghost(halfword ghost, halfword p)
+{
+ halfword l = noad_new_hlist(ghost);
+ if (l) {
+ if (has_noad_option_unpacklist(ghost)) {
+ /* always anyway */
+ p = tex_aux_unroll_noad(p, l, math_list_list);
+ } else if (has_noad_option_unrolllist(ghost)) {
+ p = tex_aux_unroll_list(p, l);
+ } else {
+ if (node_type(l) == hlist_node && ! node_next(l)) {
+ node_subtype(l) = math_ghost_list;
+ }
+ tex_couple_nodes(p, l);
+ p = tex_tail_of_node_list(p);
+ }
+ noad_new_hlist(ghost) = null;
+ }
+ tex_aux_wipe_noad(ghost);
+ return p;
+}
+
+static halfword tex_aux_get_plus_glyph(halfword current)
+{
+ if (node_type(current) == simple_noad) {
+ halfword list = noad_new_hlist(current);
+ if (list && node_type(list) == hlist_node) {
+ list = box_list(list);
+ }
+ if (list && node_type(list) == glue_node) {
+ list = node_next(list);
+ }
+ if (list && node_type(list) == glyph_node && ! node_next(list)) {
+ return list;
+ }
+ }
+ return null;
+}
+
+static void tex_aux_show_math_list(const char *fmt, halfword list)
+{
+ tex_begin_diagnostic();
+ tex_print_format(fmt, lmt_math_state.level);
+ tex_show_node_list(list, tracing_math_par >= 3 ? max_integer : show_box_depth_par, tracing_math_par >= 3 ? max_integer : show_box_breadth_par);
+ tex_print_ln();
+ tex_end_diagnostic();
+}
+
+static void tex_aux_wrapup_nucleus_and_add_scripts(halfword current, halfword nxt, int current_style, halfword *italic, kernset *kerns)
+{
+ halfword p;
+ p = tex_aux_check_nucleus_complexity(current, italic, current_style, lmt_math_state.size, kerns);
+ if (p && noad_source(current)) {
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ if (! box_source_anchor(p)) {
+ box_source_anchor(p) = noad_source(current);
+ tex_set_box_geometry(p, anchor_geometry);
+ }
+ break;
+ default:
+ /*tex Todo: maybe pack and assign! */
+ break;
+ }
+ }
+ if (noad_has_scripts(current)) {
+ scaled drop = 0;
+ if (node_type(current) == accent_noad && noad_has_superscripts(current)) {
+ drop = tex_get_math_y_parameter_default(current_style, math_parameter_accent_superscript_drop, 0);
+ drop += scaledround(kerns->toptotal * tex_get_math_parameter_default(current_style, math_parameter_accent_superscript_percent, 0) / 100.0);
+ }
+ tex_aux_make_scripts(current, p, *italic, current_style, 0, 0, drop, kerns);
+ } else {
+ /*tex
+ Adding italic correction here is kind of fuzzy because some characters already have
+ that built in. However, we also add it in the scripts so if it's optional here it
+ also should be there. The compexity tester can have added it in which case delta
+ is zero.
+ */
+ if (nxt && *italic) {
+ if (node_type(nxt) == simple_noad && tex_math_has_class_option(node_subtype(nxt), no_italic_correction_class_option)) {
+ *italic = 0;
+ }
+ if (*italic) {
+ /* If we want it as option we need the fontor store it in the noad. */
+ tex_aux_math_insert_italic_kern(p, *italic, current, "final");
+ }
+ }
+ tex_aux_assign_new_hlist(current, p);
+ }
+}
+
+/*tex
+
+ This function is called recursively, for instance for wrapped content in fence, accent, fraction
+ and radical noads. Especially the fences introduce some messy code but I might clean that up
+ stepwise. We don't want to get away too much from the original.
+
+ Because we have more than two passes, and the function became way larger, it has been split up
+ in smaller functions.
+
+*/
+
+typedef struct mliststate {
+ halfword mlist;
+ int penalties;
+ int main_style;
+ int beginclass;
+ int endclass;
+ kernset *kerns;
+ halfword scale;
+ scaled max_height;
+ scaled max_depth;
+} mliststate;
+
+static void tex_mlist_to_hlist_set_boundaries(mliststate *state)
+{
+ halfword b = tex_aux_fake_nucleus((quarterword) state->beginclass);
+ halfword e = tex_aux_fake_nucleus((quarterword) state->endclass);
+ if (state->mlist) {
+ tex_couple_nodes(b, state->mlist);
+ }
+ state->mlist = b;
+ tex_couple_nodes(tex_tail_of_node_list(state->mlist), e);
+ state->beginclass = unset_noad_class;
+ state->endclass = unset_noad_class;
+}
+
+static void tex_mlist_to_hlist_preroll_radicals(mliststate *state)
+{
+ halfword current = state->mlist;
+ halfword current_style = state->main_style;
+ halfword height = 0;
+ halfword depth = 0;
+ tex_aux_set_current_math_size(current_style);
+ tex_aux_set_current_math_scale(state->scale);
+ if (tracing_math_par >= 2) {
+ tex_aux_show_math_list("[math: radical sizing pass, level %i]", state->mlist);
+ }
+ while (current) {
+ switch (node_type(current)) {
+ case radical_noad:
+ {
+ halfword body = null;
+ tex_aux_preroll_radical(current, current_style, lmt_math_state.size);
+ body = noad_new_hlist(current);
+ if (box_height(body) > height) {
+ height = box_height(body);
+ }
+ if (box_depth(body) > depth) {
+ depth = box_depth(body);
+ }
+ }
+ break;
+ case style_node:
+ tex_aux_make_style(current, &current_style, NULL);
+ break;
+ case parameter_node:
+ tex_def_math_parameter(node_subtype(current), parameter_name(current), parameter_value(current), cur_level + lmt_math_state.level, indirect_math_regular);
+ break;
+ }
+ current = node_next(current);
+ }
+ /*tex
+ A positive value is assigned, a negative value subtracted and a value of maxdimen will use
+ the maximum found dimensions. Todo: use an option to control this instead.
+ */
+ current = state->mlist;
+ while (current) {
+ if (node_type(current) == radical_noad) {
+ switch (node_subtype(current)) {
+ case normal_radical_subtype:
+ case radical_radical_subtype:
+ case root_radical_subtype:
+ case rooted_radical_subtype:
+ {
+ halfword body = noad_new_hlist(current);
+ if (radical_height(current) == max_dimen) {
+ box_height(body) = height;
+ } else if (radical_height(current) < 0) {
+ box_height(body) += radical_height(current);
+ if (box_height(body) < 0) {
+ box_height(body) += 0;
+ }
+ } else if (radical_height(current)) {
+ box_height(body) = radical_height(current);
+ }
+ if (radical_depth(current) == max_dimen) {
+ box_depth(body) = depth;
+ } else if (radical_depth(current) < 0) {
+ box_depth(body) += radical_depth(current);
+ if (box_depth(body) < 0) {
+ box_depth(body) += 0;
+ }
+ } else if (radical_depth(current)) {
+ box_depth(body) = radical_depth(current);
+ }
+ }
+ break;
+ }
+ }
+ current = node_next(current);
+ }
+}
+
+static void tex_mlist_to_hlist_preroll_dimensions(mliststate *state)
+{
+ halfword current = state->mlist;
+ scaled current_mu = 0;
+ halfword current_style = state->main_style;
+ int blockrulebased = 0;
+ /*tex We set the math unit width corresponding to |size|: */
+ tex_aux_set_current_math_size(current_style);
+ tex_aux_set_current_math_scale(state->scale);
+ current_mu = tex_get_math_quad_size_scaled(lmt_math_state.size);
+ if (tracing_math_par >= 2) {
+ tex_aux_show_math_list("[math: first pass, level %i]", state->mlist);
+ }
+ while (current) {
+ /*tex The italic correction offset for subscript and superscript: */
+ scaled italic = 0;
+ halfword nxt = node_next(current);
+ noad_classes fenceclasses = { unset_noad_class, unset_noad_class, unset_noad_class };
+ kernset localkerns;
+ tex_math_wipe_kerns(&localkerns);
+ /*tex
+ At some point we had nicely cleaned up switch driven code here but we ended up with a
+ more generic approach. The reference is still in the pre-2022 zips and git repository.
+
+ The fact that we have configurable atom spacing (with inheritance) means that we can
+ now have a rather simple switch without any remapping and RESWITCH magic.
+ */
+ if (blockrulebased > 0) {
+ blockrulebased -= 1;
+ }
+ switch (node_type(current)) {
+ case simple_noad:
+ /*tex
+ Because we have added features we no longer combine the case in clever ways to
+ minimize code. Let the compiler do that for us. We could be generic and treat
+ all the same but for now we just emulate some of traditional \TEX's selectivity.
+ */
+ if (blockrulebased > 0) {
+ noad_options(current) |= noad_option_no_ruling;
+ blockrulebased = 0;
+ }
+ switch (node_subtype(current)) {
+ case under_noad_subtype:
+ tex_aux_make_under(current, current_style, lmt_math_state.size, math_rules_fam_par);
+ break;
+ case over_noad_subtype:
+ tex_aux_make_over(current, current_style, lmt_math_state.size, math_rules_fam_par);
+ break;
+ case vcenter_noad_subtype:
+ tex_aux_make_vcenter(current, current_style, lmt_math_state.size);
+ break;
+ case fenced_noad_subtype:
+ if (tex_aux_make_fenced(current, current_style, lmt_math_state.size, &fenceclasses)) {
+ /*tex We have a left operator so we fall through! */
+ } else {
+ break;
+ }
+ case operator_noad_subtype:
+ /* compatibility */
+ if (! (has_noad_option_limits(current) || has_noad_option_nolimits(current))) {
+ /* otherwise we don't enter the placement function */
+ noad_options(current) |= (current_style == display_style || current_style == cramped_display_style) ? noad_option_limits : noad_option_no_limits;
+ }
+ goto PROCESS;
+ default:
+ /* setting both forces check */
+ if ((has_noad_option_limits(current) && has_noad_option_nolimits(current))) {
+ if (current_style == display_style || current_style == cramped_display_style) {
+ noad_options(current) = unset_option(noad_options(current), noad_option_no_limits);
+ noad_options(current) |= noad_option_limits;
+ } else {
+ noad_options(current) = unset_option(noad_options(current), noad_option_limits);
+ noad_options(current) |= noad_option_no_limits;
+ }
+ }
+ PROCESS:
+ if ( // node_subtype(q) == operator_noad_subtype
+ // ||
+ has_noad_option_limits(current) || has_noad_option_nolimits(current)
+ || has_noad_option_openupheight(current) || has_noad_option_openupdepth(current)
+ || has_noad_option_adapttoleft(current) || has_noad_option_adapttoright(current)
+ ) {
+ if (node_subtype(current) == fenced_noad_subtype && ! noad_has_scripts(current)) {
+ /*tex
+ This is a special case: the right counterpart of the left operator
+ can trigger a boxing of all that comes before so we need to enforce
+ nolimits. Mikael Sundqvist will reveal all this in the CMS manual.
+ */
+ italic = tex_aux_make_op(current, current_style, lmt_math_state.size, 0, limits_horizontal_mode, NULL);
+ } else {
+ italic = tex_aux_make_op(current, current_style, lmt_math_state.size, 0, limits_unknown_mode, NULL);
+ }
+ /* tex_math_has_class_option(node_subtype(current),keep_correction_class_code) */
+ if (node_subtype(current) != operator_noad_subtype) {
+ italic = 0;
+ }
+ if (fenceclasses.main != unset_noad_class) {
+ noad_class_main(current) = fenceclasses.main;
+ }
+ if (fenceclasses.left != unset_noad_class) {
+ noad_class_left(current) = fenceclasses.left;
+ }
+ if (fenceclasses.right != unset_noad_class) {
+ noad_class_right(current) = fenceclasses.right;
+ }
+ if (has_noad_option_limits(current) || has_noad_option_nolimits(current)) {
+ goto CHECK_DIMENSIONS;
+ }
+ } else {
+ // tex_aux_make_ord(current, lmt_math_state.size);
+ tex_aux_check_ord(current, lmt_math_state.size, null);
+ }
+ break;
+ }
+ break;
+ case fence_noad:
+ {
+ /* why still ... */
+ current_style = state->main_style;
+ tex_aux_set_current_math_size(current_style);
+ current_mu = tex_get_math_quad_size_scaled(lmt_math_state.size);
+ /* ... till here */
+ goto DONE_WITH_NODE;
+ }
+ case fraction_noad:
+ tex_aux_make_fraction(current, current_style, lmt_math_state.size, state->kerns);
+ goto CHECK_DIMENSIONS;
+ case radical_noad:
+ tex_aux_make_radical(current, current_style, lmt_math_state.size, &localkerns);
+ break;
+ case accent_noad:
+ tex_aux_make_accent(current, current_style, lmt_math_state.size, &localkerns);
+ break;
+ case style_node:
+ tex_aux_make_style(current, &current_style, &current_mu);
+ goto DONE_WITH_NODE;
+ case choice_node:
+ current = tex_aux_make_choice(current, current_style);
+ goto DONE_WITH_NODE;
+ case parameter_node:
+ /* maybe not needed as we do a first pass */
+ tex_def_math_parameter(node_subtype(current), parameter_name(current), parameter_value(current), cur_level + lmt_math_state.level, indirect_math_regular);
+ goto DONE_WITH_NODE;
+ case insert_node:
+ case mark_node:
+ case adjust_node:
+ case boundary_node:
+ case whatsit_node:
+ case penalty_node:
+ case disc_node:
+ case par_node: /* for local boxes */
+ goto DONE_WITH_NODE;
+ case rule_node:
+ tex_aux_check_math_strut_rule(current, current_style);
+ if (rule_height(current) > state->max_height) {
+ state->max_height = rule_height(current);
+ }
+ if (rule_depth(current) > state->max_depth) {
+ state->max_depth = rule_depth(current);
+ }
+ goto DONE_WITH_NODE;
+ case glue_node:
+ if (node_subtype(current) == rulebased_math_glue) {
+ blockrulebased = 2;
+ }
+ tex_aux_make_glue(current, current_mu, current_style);
+ goto DONE_WITH_NODE;
+ case kern_node:
+ tex_aux_make_kern(current, current_mu, current_style);
+ goto DONE_WITH_NODE;
+ default:
+ tex_confusion("mlist to hlist, case 1");
+ }
+ /*tex
+ When we get to the following part of the program, we have \quote {fallen through} from
+ cases that did not lead to |check_dimensions| or |done_with_noad| or |done_with_node|.
+ Thus, |q|~points to a noad whose nucleus may need to be converted to an hlist, and
+ whose subscripts and superscripts need to be appended if they are present.
+
+ If |nucleus(q)| is not a |math_char|, the variable |italic| is the amount by which a
+ superscript should be moved right with respect to a subscript when both are present.
+ */
+ tex_aux_wrapup_nucleus_and_add_scripts(current, nxt, current_style, &italic, &localkerns);
+ // {
+ // kernset kerns;
+ // halfword p;
+ // tex_math_copy_kerns(&kerns, &localkerns);
+ // p = tex_aux_check_nucleus_complexity(current, &italic, current_style, lmt_math_state.size, &kerns);
+ // if (p && noad_source(current)) {
+ // switch (node_type(p)) {
+ // case hlist_node:
+ // case vlist_node:
+ // if (! box_source_anchor(p)) {
+ // box_source_anchor(p) = noad_source(current);
+ // tex_set_box_geometry(p, anchor_geometry);
+ // }
+ // break;
+ // default:
+ // /*tex Todo: maybe pack and assign! */
+ // break;
+ // }
+ // }
+ // if (noad_has_scripts(current)) {
+ // scaled drop = 0;
+ // if (node_type(current) == accent_noad && noad_has_superscripts(current)) {
+ // drop = tex_get_math_y_parameter_default(current_style, math_parameter_accent_superscript_drop, 0);
+ // drop += scaledround(localkerns.toptotal * tex_get_math_parameter_default(current_style, math_parameter_accent_superscript_percent, 0) / 100.0);
+ // }
+ // tex_aux_make_scripts(current, p, italic, current_style, 0, 0, drop, &kerns);
+ // } else {
+ // /*tex
+ // Adding italic correction here is kind of fuzzy because some characters already have
+ // that built in. However, we also add it in the scripts so if it's optional here it
+ // also should be there. The compexity tester can have added it in which case delta
+ // is zero.
+ // */
+ // if (nxt && italic) {
+ // if (node_type(nxt) == simple_noad && tex_math_has_class_option(node_subtype(nxt), no_italic_correction_class_option)) {
+ // italic = 0;
+ // }
+ // if (italic) {
+ // /* If we want it as option we need the fontor store it in the noad. */
+ // tex_aux_math_insert_italic_kern(p, italic, current, "final");
+ // }
+ // }
+ // tex_aux_assign_new_hlist(current, p);
+ // }
+ // }
+ CHECK_DIMENSIONS:
+ {
+ scaledwhd siz = tex_natural_hsizes(noad_new_hlist(current), null, normal_glue_multiplier, normal_glue_sign, normal_glue_sign);
+ if (siz.ht > state->max_height) {
+ state->max_height = siz.ht;
+ }
+ if (siz.dp > state->max_depth) {
+ state->max_depth = siz.dp;
+ }
+ }
+ DONE_WITH_NODE:
+ if ((node_type(current) == simple_noad) && noad_new_hlist(current)) {
+ if (has_noad_option_phantom(current) || has_noad_option_void(current)) {
+ noad_new_hlist(current) = tex_aux_make_list_phantom(noad_new_hlist(current), has_noad_option_void(current), get_attribute_list(current));
+ }
+ }
+ current = node_next(current);
+ }
+}
+
+static void tex_mlist_to_hlist_size_fences(mliststate *state)
+{
+ halfword current = state->mlist;
+ halfword current_style = state->main_style;
+ tex_aux_set_current_math_size(current_style);
+ tex_aux_set_current_math_scale(state->scale);
+ if (tracing_math_par >= 2) {
+ tex_aux_show_math_list("[math: fence sizing pass, level %i]", state->mlist);
+ }
+ while (current) {
+ switch (node_type(current)) {
+ case fence_noad:
+ tex_aux_finish_fenced(current, current_style, state->max_depth, state->max_height, state->kerns);
+ break;
+ case style_node:
+ tex_aux_make_style(current, &current_style, NULL);
+ break;
+ case parameter_node:
+ /* tricky as this is sort of persistent, we need to reset it at the start */
+ tex_def_math_parameter(node_subtype(current), parameter_name(current), parameter_value(current), cur_level + lmt_math_state.level, indirect_math_regular);
+ break;
+ }
+ current = node_next(current);
+ }
+}
+
+static void tex_mlist_to_hlist_finalize_list(mliststate *state)
+{
+ halfword recent = null; /*tex Watch out: can be wiped, so more a signal! */
+ int recent_type = 0;
+ int recent_subtype = ordinary_noad_subtype;
+ halfword current_style = state->main_style;
+ halfword fenced = null;
+ halfword recent_left_slack = 0;
+ halfword recent_right_slack = 0;
+ halfword recent_class_overload = unset_noad_class;
+ halfword recent_script_state = 0;
+ halfword recent_plus_glyph = null;
+ scaled current_mu = 0;
+ halfword current = state->mlist;
+ halfword p = temp_head;
+ halfword ghost = null;
+ node_next(p) = null;
+ tex_aux_set_current_math_size(current_style);
+ tex_aux_set_current_math_scale(state->scale);
+ current_mu = tex_get_math_quad_size_scaled(lmt_math_state.size);
+ if (math_penalties_mode_par) {
+ state->penalties = 1; /* move to caller ? */
+ }
+ if (tracing_math_par >= 2) {
+ tex_aux_show_math_list("[math: second pass, level %i]", state->mlist);
+ }
+ RESTART:
+ while (current) {
+ /*tex
+ If node |q| is a style node, change the style and |goto delete_q|; otherwise if it is
+ not a noad, put it into the hlist, advance |q|, and |goto done|; otherwise set |s| to
+ the size of noad |q|, set |t| to the associated type (|ord_noad.. inner_noad|), and set
+ |pen| to the associated penalty.
+
+ Just before doing the big |case| switch in the second pass, the program sets up default
+ values so that most of the branches are short.
+
+ We need to remain somewhat compatible so we still handle some open and close fence
+ setting (marked as safeguard) here but as we (1) take the class from the delimiter,
+ when set, or (2) derive it from the fence subtype, we don't really need it. In some
+ cases, like with bars that serve a dual purpose, it will always be a mess.
+
+ */
+ /*tex the effective |type| of noad |q| during the second pass */
+ halfword current_type = simple_noad;
+ /*tex the effective |subtype| of noad |q| during the second pass */
+ halfword current_subtype = ordinary_noad_subtype;
+ /*tex penalties to be inserted */
+ halfword post_penalty = infinite_penalty;
+ halfword pre_penalty = infinite_penalty;
+ /*tex experiment */
+ halfword current_left_slack = 0;
+ halfword current_right_slack = 0;
+ halfword current_script_state = 0;
+ halfword current_plus_glyph = 0;
+ halfword old_recent = 0;
+ halfword old_current = 0;
+ HERE:
+ switch (node_type(current)) {
+ case simple_noad:
+ if (node_subtype(current) == ghost_noad_subtype) {
+ /* for now, what to do with edges */
+ halfword nxt = node_next(current);
+ if (ghost) {
+ // check for noad_new_hlist(ghost)
+ halfword p = tex_tail_of_node_list(noad_new_hlist(ghost));
+ noad_class_right(ghost) = noad_class_right(current);
+ p = tex_aux_append_ghost(current, p);
+ noad_new_hlist(ghost) = tex_head_of_node_list(p);
+ } else {
+ ghost = current;
+ }
+ current = nxt;
+ if (current) {
+ goto HERE;
+ } else {
+ goto RESTART;
+ }
+ } else {
+ current_subtype = node_subtype(current);
+ current_left_slack = noad_left_slack(current);
+ current_right_slack = noad_right_slack(current);
+ current_script_state = noad_script_state(current);
+ switch (current_subtype) {
+ case fenced_noad_subtype:
+ {
+ // halfword list = noad_new_hlist(current);
+ // if (list && ! noad_nucleus(current) && ! noad_has_scripts(current)) { // scripts test will go
+ fenced = current;
+ if (get_noad_right_class(fenced) != unset_noad_class) {
+ current_subtype = get_noad_left_class(fenced);
+ } else if (get_noad_main_class(fenced) != unset_noad_class) { // needs testing by MS
+ current_subtype = get_noad_main_class(fenced);
+ } else {
+ current_subtype = open_noad_subtype; /* safeguard, see comment above */
+ }
+ // }
+ break;
+ }
+ default:
+ {
+ halfword list = noad_new_hlist(current);
+ if (list && tex_is_math_disc(list)) {
+ current_type = simple_noad;
+ current_subtype = disc_class(box_list(list));
+ }
+ if (list && noad_source(current)) {
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: packing due to source field %D]", noad_source(current));
+ tex_end_diagnostic();
+ }
+ switch (node_type(list)) {
+ case hlist_node:
+ case vlist_node:
+ if (! box_source_anchor(list)) {
+ box_source_anchor(list) = noad_source(current);
+ tex_set_box_geometry(list, anchor_geometry);
+ }
+ break;
+ default:
+ list = tex_hpack(list, 0, packing_additional, direction_unknown, holding_none_option);
+ tex_attach_attribute_list_copy(list, current);
+ box_source_anchor(list) = noad_source(current);
+ tex_set_box_geometry(list, anchor_geometry);
+ noad_new_hlist(current) = list;
+ node_subtype(list) = math_pack_list;
+ break;
+ }
+ }
+ break;
+ }
+ }
+ if (get_noad_left_class(current) != unset_noad_class) {
+ current_subtype = get_noad_left_class(current);
+ } else if (get_noad_main_class(current) != unset_noad_class) {
+ current_subtype = get_noad_main_class(current);
+ }
+ }
+ break;
+ case radical_noad:
+ switch (node_subtype(current)) {
+ case normal_radical_subtype:
+ case radical_radical_subtype:
+ case root_radical_subtype:
+ case rooted_radical_subtype:
+ case delimited_radical_subtype:
+ current_type = simple_noad;
+ current_subtype = radical_noad_subtype;
+ break;
+ case under_delimiter_radical_subtype:
+ case delimiter_under_radical_subtype:
+ current_type = simple_noad;
+ current_subtype = under_noad_subtype;
+ break;
+ case over_delimiter_radical_subtype:
+ case delimiter_over_radical_subtype:
+ current_type = simple_noad;
+ current_subtype = over_noad_subtype;
+ break;
+ case h_extensible_radical_subtype:
+ current_type = simple_noad;
+ current_subtype = accent_noad_subtype;
+ break;
+ }
+ break;
+ case accent_noad:
+ current_type = simple_noad; /*tex Same kind of fields. */
+ current_subtype = accent_noad_subtype;
+ current_left_slack = noad_left_slack(current);
+ current_right_slack = noad_right_slack(current);
+ break;
+ case fraction_noad:
+ current_type = simple_noad; /*tex Same kind of fields. */
+ current_subtype = fraction_noad_subtype; /* inner_noad_type */
+ break;
+ case fence_noad:
+ current_type = simple_noad; /*tex Same kind of fields. */
+ current_subtype = noad_analyzed(current);
+ fenced = current;
+ break;
+ case style_node:
+ tex_aux_make_style(current, &current_style, &current_mu);
+ recent = current;
+ current = node_next(current);
+ tex_aux_wipe_noad(recent);
+ goto RESTART;
+ case parameter_node:
+ tex_def_math_parameter(node_subtype(current), parameter_name(current), parameter_value(current), cur_level + lmt_math_state.level, indirect_math_regular);
+ recent = current;
+ current = node_next(current);
+ tex_aux_wipe_noad(recent);
+ goto RESTART;
+ case glue_node:
+ switch (node_subtype(current)) {
+ case conditional_math_glue:
+ case rulebased_math_glue:
+ {
+ halfword t = current;
+ current = node_next(current);
+ tex_flush_node(t);
+ goto MOVEON;
+ }
+ default:
+ break;
+ }
+ // case glyph_node:
+ case disc_node:
+ case hlist_node:
+ case boundary_node:
+ case whatsit_node:
+ case penalty_node:
+ case rule_node:
+ case adjust_node:
+ case insert_node:
+ case mark_node:
+ case par_node:
+ case kern_node:
+ tex_couple_nodes(p, current);
+ p = current;
+ current = node_next(current);
+ node_next(p) = null;
+ MOVEON:
+ if (current) {
+ /*tex These nodes are invisible! */
+ switch (node_type(p)) {
+ case boundary_node:
+ case adjust_node:
+ case insert_node:
+ case mark_node:
+ case par_node:
+ goto HERE;
+ case rule_node:
+ if (node_subtype(p) == strut_rule_subtype) {
+ goto HERE;
+ }
+ }
+ }
+ continue;
+ // goto NEXT_NODE;
+ default:
+ tex_confusion("mlist to hlist, case 2");
+ }
+ /*tex
+ Apply some logic. The hard coded pairwise comparison is replaced by a generic one
+ because we can have more classes. For a while spacing and pairing was under a mode
+ control but that made no sense. We start with the begin class.
+ */
+ recent_class_overload = get_noad_right_class(current);
+ if (current_type == simple_noad && state->beginclass == unset_noad_class) {
+ if (noad_new_hlist(current)) {
+ tex_flush_node(noad_new_hlist(current));
+ noad_new_hlist(current) = null;
+ }
+ state->beginclass = current_subtype;
+ /* */
+ recent_type = current_type;
+ recent_subtype = current_subtype;
+ recent = current;
+ current = node_next(current);
+ goto WIPE;
+ }
+ /*tex
+ This is a special case where a sign starts something marked as (like) numeric, in
+ which there will be different spacing applied.
+ */
+ if (tex_math_has_class_option(current_subtype, look_ahead_for_end_class_option)) {
+ halfword endhack = node_next(current);
+ if (endhack && node_type(endhack) == simple_noad && (node_subtype(endhack) == math_end_class || get_noad_main_class(endhack) == math_end_class)) {
+ halfword value = tex_aux_math_ruling(current_subtype, math_end_class, current_style);
+ if (value != MATHPARAMDEFAULT) {
+ // recent_subtype = (value >> 16) & 0xFF;
+ // current_subtype = value & 0xFF;
+ current_subtype = (value >> 16) & 0xFF;
+ }
+
+ }
+ }
+ old_recent = recent_subtype;
+ old_current = current_subtype;
+ if (current_subtype != unset_noad_class && recent_subtype != unset_noad_class && current_type == simple_noad) {
+ if (recent_type == simple_noad && ! has_noad_option_noruling(current)) {
+ halfword value = tex_aux_math_ruling(recent_subtype, current_subtype, current_style);
+ if (value != MATHPARAMDEFAULT) {
+ recent_subtype = (value >> 16) & 0xFF;
+ current_subtype = value & 0xFF;
+ }
+ }
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ if (old_recent != recent_subtype || old_current != current_subtype) {
+ tex_print_format("[math: atom ruling, recent %n, current %n, new recent %n, new current %n]", old_recent, old_current, recent_subtype, current_subtype);
+ } else {
+ tex_print_format("[math: atom ruling, recent %n, current %n]", old_recent, old_current);
+ }
+ tex_end_diagnostic();
+ }
+ }
+ /*tex Now we set the inter-atom penalties: */
+ if (ghost && ! has_noad_option_right(ghost)) {
+ p = tex_aux_append_ghost(ghost, p);
+ ghost = null;
+ }
+ if (current_type == simple_noad) {
+ pre_penalty = tex_aux_math_penalty(state->main_style, 1, current_subtype);
+ post_penalty = tex_aux_math_penalty(state->main_style,0, current_subtype);
+ }
+ /*tex Dirty trick: */ /* todo: use kerns info */
+ current_plus_glyph = tex_aux_get_plus_glyph(current);
+ /*tex Append inter-element spacing based on |r_type| and |t| */
+ if (current_plus_glyph && recent_script_state) {
+ /*tex This is a very special case and used {x^2 / 3| kind of situations: */
+ halfword plus = tex_aux_checked_left_kern(current_plus_glyph, recent_script_state, current_subtype);
+ if (plus) {
+ halfword kern = tex_new_kern_node(plus, math_shape_kern_subtype);
+ tex_attach_attribute_list_copy(kern, current);
+ tex_couple_nodes(p, kern);
+ p = kern;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: state driven left shape kern %p]", plus, pt_unit);
+ tex_end_diagnostic();
+ }
+ }
+ }
+ if (recent_type > 0) {
+ halfword last = node_type(p); /* can be temp */
+ halfword glue = tex_aux_math_spacing_glue(recent_subtype, current_subtype, current_style, current_mu);
+ halfword kern = null;
+ if (glue) {
+ tex_attach_attribute_list_copy(glue, current);
+ }
+ if (recent_right_slack) {
+ halfword kern = tex_new_kern_node(-recent_right_slack, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, current);
+ tex_couple_nodes(p, kern);
+ p = kern;
+ if (current_subtype >= 0 && tex_math_has_class_option(current_subtype, no_pre_slack_class_option)) {
+ /* */
+ } else if (! glue) {
+ glue = tex_aux_math_dimen(recent_right_slack, inter_math_skip_glue, -2);
+ } else {
+ glue_amount(glue) += recent_right_slack;
+ }
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: migrating right slack %p]", recent_right_slack, pt_unit);
+ tex_end_diagnostic();
+ }
+ recent_right_slack = 0;
+ }
+ if (recent_plus_glyph && current_script_state) {
+ /*tex This is a very special case and used {x^2 / 3| kind of situations: */
+ halfword plus = tex_aux_checked_right_kern(recent_plus_glyph, current_script_state, recent_subtype);
+ if (plus) {
+ halfword kern = tex_new_kern_node(plus, math_shape_kern_subtype);
+ tex_attach_attribute_list_copy(kern, current);
+ tex_couple_nodes(p, kern);
+ p = kern;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: state driven right shape kern %p]", plus, pt_unit);
+ tex_end_diagnostic();
+ }
+ }
+ }
+ if (current_left_slack) {
+ kern = tex_new_kern_node(-current_left_slack, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(kern, p);
+ /* tex_couple_nodes(node_prev(p), kern); */ /* close to the molecule */
+ /* tex_couple_nodes(kern, p); */ /* close to the molecule */
+ if (recent_subtype >= 0 && tex_math_has_class_option(recent_subtype, no_post_slack_class_option)) {
+ /* */
+ } else if (! glue) {
+ glue = tex_aux_math_dimen(current_left_slack, inter_math_skip_glue, -1);
+ } else {
+ glue_amount(glue) += current_left_slack;
+ }
+ current_left_slack = 0;
+ }
+ /*tex
+ Do we still want this check in infinite.
+ */
+ if (state->penalties && pre_penalty < infinite_penalty && node_type(last) != penalty_node) {
+ /*tex no checking of prev node type */
+ halfword penalty = tex_new_penalty_node(pre_penalty, math_pre_penalty_subtype);
+ tex_attach_attribute_list_copy(penalty, current);
+ tex_couple_nodes(p, penalty);
+ p = penalty;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: pre penalty, left %n, right %n, amount %i]", recent_subtype, current_subtype, penalty_amount(penalty));
+ tex_end_diagnostic();
+ }
+ }
+ if (tex_math_has_class_option(current_subtype, remove_italic_correction_class_option)) {
+ if (node_type(p) == kern_node && node_subtype(p) == italic_kern_subtype) {
+ halfword prv = node_prev(p);
+ if (prv) {
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: removing italic correction %D between %i and %i]", kern_amount(p), recent_subtype, current_subtype);
+ tex_end_diagnostic();
+ }
+ tex_flush_node(p);
+ p = prv;
+ }
+ }
+ }
+ if (glue) {
+ tex_couple_nodes(p, glue);
+ p = glue;
+ }
+ if (kern) {
+ tex_couple_nodes(p, kern);
+ p = kern;
+ }
+ }
+ if (ghost) {
+ p = tex_aux_append_ghost(ghost, p);
+ ghost = null;
+ }
+ {
+ halfword l = noad_new_hlist(current);
+ if (! l) {
+ /* curious */
+ } else if (node_type(l) == hlist_node && box_source_anchor(l)) {
+ tex_couple_nodes(p, l);
+ } else if (fenced) {
+ /*tex Watch out: we can have |[prescripts] [fencelist] [postscripts]| */
+ if (tex_math_has_class_option(fenced_noad_subtype, unpack_class_option)) {
+ p = tex_aux_unroll_noad(p, l, math_fence_list);
+ } else {
+ tex_couple_nodes(p, l);
+ }
+ } else if (has_noad_option_unpacklist(current) || tex_math_has_class_option(current_subtype, unpack_class_option)) {
+ /*tex So here we only unpack a math list. */
+ p = tex_aux_unroll_noad(p, l, math_list_list);
+ } else if (has_noad_option_unrolllist(current)) {
+ p = tex_aux_unroll_list(p, l);
+ } else if (tex_is_math_disc(l)) {
+ /* hm, temp nodes here */
+ tex_couple_nodes(p, box_list(l));
+ box_list(l) = null;
+ tex_flush_node(l);
+ } else if (current_type == simple_noad && current_subtype == math_end_class) {
+ if (noad_new_hlist(current)) {
+ tex_flush_node(noad_new_hlist(current));
+ noad_new_hlist(current) = null;
+ }
+ } else {
+ tex_couple_nodes(p, l);
+ }
+ p = tex_tail_of_node_list(p);
+ if (fenced) {
+ if (get_noad_right_class(fenced) != unset_noad_class) {
+ current_subtype = get_noad_right_class(fenced);
+ } else if (get_noad_main_class(fenced) != unset_noad_class) { // needs testing by MS
+ current_subtype = get_noad_main_class(fenced);
+ } else {
+ current_subtype = close_noad_subtype; /* safeguard, see comment above */
+ }
+ fenced = null;
+ }
+ noad_new_hlist(current) = null;
+ }
+ /*tex
+ Append any |new_hlist| entries for |q|, and any appropriate penalties. We insert a
+ penalty node after the hlist entries of noad |q| if |pen| is not an \quote {infinite}
+ penalty, and if the node immediately following |q| is not a penalty node or a
+ |rel_noad| or absent entirely. We could combine more here but for beter understanding
+ we keep the branches seperated. This code is not performance sentitive anyway.
+
+ We can actually drop the omit check because we pair by class.
+ */
+ if (state->penalties && node_next(current) && post_penalty < infinite_penalty) {
+ halfword recent = node_next(current);
+ recent_type = node_type(recent);
+ recent_subtype = node_subtype(recent);
+ /* todo: maybe also check the mainclass of the recent */
+ if ((recent_type != penalty_node) && ! (recent_type == simple_noad && tex_math_has_class_option(recent_subtype, omit_penalty_class_option))) {
+ halfword z = tex_new_penalty_node(post_penalty, math_post_penalty_subtype);
+ tex_attach_attribute_list_copy(z, current);
+ tex_couple_nodes(p, z);
+ p = z;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: post penalty, left %n, right %n, amount %i]", recent_subtype, current_subtype, penalty_amount(z));
+ tex_end_diagnostic();
+ }
+ }
+ }
+ if (recent_class_overload != unset_noad_class) {
+ current_type = simple_noad;
+ current_subtype = recent_class_overload;
+ }
+ if (current_type == simple_noad && current_subtype != math_end_class) {
+ state->endclass = current_subtype;
+ }
+ recent_type = current_type;
+ recent_subtype = current_subtype;
+ recent_left_slack = current_left_slack;
+ recent_right_slack = current_right_slack;
+ recent_script_state = current_script_state;
+ recent_plus_glyph = current_plus_glyph;
+ // if (first && recent_left_slack) {
+ if (p == temp_head && recent_left_slack) {
+ halfword k = tex_new_kern_node(-recent_left_slack, horizontal_math_kern_subtype);
+ halfword h = node_next(temp_head);
+ tex_attach_attribute_list_copy(k, p);
+ tex_couple_nodes(k, h);
+ node_next(temp_head) = k;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: nilling recent left slack %p]", recent_left_slack);
+ tex_end_diagnostic();
+ }
+ }
+ recent = current;
+ current = node_next(current);
+ if (! current && recent_right_slack) {
+ halfword k = tex_new_kern_node(-recent_right_slack, horizontal_math_kern_subtype);
+ tex_attach_attribute_list_copy(k, p);
+ tex_couple_nodes(p, k);
+ p = k;
+ if (tracing_math_par >= 2) {
+ tex_begin_diagnostic();
+ tex_print_format("[math: nilling recent right slack %p]", recent_right_slack);
+ tex_end_diagnostic();
+ }
+ }
+ // first = 0;
+ /*tex
+ The m|-|to|-|hlist conversion takes place in|-|place, so the various dependant fields
+ may not be freed (as would happen if |flush_node| was called). A low|-|level |free_node|
+ is easier than attempting to nullify such dependant fields for all possible node and
+ noad types.
+ */
+ WIPE:
+ tex_aux_wipe_noad(recent);
+ }
+ if (tracing_math_par >= 3) {
+ tex_aux_show_math_list("[math: result, level %i]", node_next(temp_head));
+ }
+}
+
+halfword tex_mlist_to_hlist(halfword mlist, int penalties, int main_style, int beginclass, int endclass, kernset *kerns) /* classes should be quarterwords */
+{
+ /*tex
+ We start with a little housekeeping. There are now only two variables that live across the
+ two passes. We actually could split this function in two. For practical reasons we have
+ collected all relevant state parameters in a structure. The values in there can be adapted
+ in this state.
+ */
+ mliststate state;
+ state.mlist = mlist;
+ state.penalties = penalties;
+ state.main_style = main_style;
+ state.beginclass = beginclass == unset_noad_class ? math_begin_class : beginclass;
+ state.endclass = endclass == unset_noad_class ? math_end_class : endclass;;
+ state.kerns = kerns;
+ state.scale = glyph_scale_par;
+ state.max_height = 0;
+ state.max_depth = 0;
+ if (state.kerns) {
+ tex_math_wipe_kerns(state.kerns);
+ }
+ ++lmt_math_state.level;
+ /*tex
+ Here we can deal with end_class spacing: we can inject a dummy current atom with no content and
+ just a class. In fact, we can always add a begin and endclass. A nucleus is kind of mandate.
+ */
+ tex_mlist_to_hlist_set_boundaries(&state);
+ /*tex
+ This first pass processes the bodies of radicals so that we can normalize them when height
+ and/or depth are set.
+ */
+ tex_mlist_to_hlist_preroll_radicals(&state);
+ /*
+ Make a second pass over the mlist. This is needed in order to get the maximum height and
+ depth in order to make fences match.
+ */
+ tex_mlist_to_hlist_preroll_dimensions(&state);
+ /*tex
+ The fence sizing is done in the third pass. Using a dedicated pass permits experimenting.
+ */
+ tex_mlist_to_hlist_size_fences(&state);
+ /*tex
+ Make a fourth pass over the mlist; traditionally this was the second pass. We removing all
+ noads and insert the proper spacing (glue) and penalties. The binary checking is gone and
+ replaced by generic arbitrary inter atom mapping control, so for the hard coded older logic
+ one has to check the (development) git repository.
+
+ The original comment for this pass is: \quotation {We have now tied up all the loose ends of
+ the first pass of |mlist_to_hlist|. The second pass simply goes through and hooks everything
+ together with the proper glue and penalties. It also handles the |fence_noad|s that might be
+ present, since |max_hl| and |max_d| are now known. Variable |p| points to a node at the
+ current end of the final hlist.} However, in \LUAMETATEX\ the fence sizing has already be
+ done in the previous pass.
+ */
+ tex_mlist_to_hlist_finalize_list(&state);
+ /*tex
+ We're done now and can restore the possibly changed values as well as provide some feedback
+ about the result.
+ */
+ tex_unsave_math_data(cur_level + lmt_math_state.level);
+ cur_list.math_begin = state.beginclass;
+ cur_list.math_end = state.endclass;
+ glyph_scale_par = state.scale;
+ --lmt_math_state.level;
+ node_prev(node_next(temp_head)) = null;
+ return node_next(temp_head);
+}
diff --git a/source/luametatex/source/tex/texmlist.h b/source/luametatex/source/tex/texmlist.h
new file mode 100644
index 000000000..1cb2a6cc7
--- /dev/null
+++ b/source/luametatex/source/tex/texmlist.h
@@ -0,0 +1,30 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_MLIST_H
+# define LMT_MLIST_H
+
+typedef struct kernset {
+ scaled topright;
+ scaled bottomright;
+ scaled topleft;
+ scaled bottomleft;
+ scaled height;
+ scaled depth;
+ scaled toptotal;
+ scaled bottomtotal;
+} kernset;
+
+extern void tex_run_mlist_to_hlist (halfword p, halfword penalties, halfword style, int beginclass, int endclass);
+extern halfword tex_mlist_to_hlist (halfword, int penalties, int mainstyle, int beginclass, int endclass, kernset *kerns);
+extern halfword tex_make_extensible (halfword fnt, halfword chr, scaled target, scaled min_overlap, int horizontal, halfword att, halfword size);
+extern halfword tex_new_math_glyph (halfword fnt, halfword chr);
+extern halfword tex_math_spacing_glue (halfword ltype, halfword rtype, halfword style);
+
+extern halfword tex_math_font_char_ht (halfword fnt, halfword chr, halfword style);
+extern halfword tex_math_font_char_dp (halfword fnt, halfword chr, halfword style);
+
+extern void tex_set_math_text_font (halfword style, int usefamfont);
+
+# endif
diff --git a/source/luametatex/source/tex/texnesting.c b/source/luametatex/source/tex/texnesting.c
new file mode 100644
index 000000000..d699d58fc
--- /dev/null
+++ b/source/luametatex/source/tex/texnesting.c
@@ -0,0 +1,432 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex These are for |show_activities|: */
+
+# define page_goal lmt_page_builder_state.goal
+
+/*tex
+
+ \TEX\ is typically in the midst of building many lists at once. For example, when a math formula
+ is being processed, \TEX\ is in math mode and working on an mlist; this formula has temporarily
+ interrupted \TEX\ from being in horizontal mode and building the hlist of a paragraph; and this
+ paragraph has temporarily interrupted \TEX\ from being in vertical mode and building the vlist
+ for the next page of a document. Similarly, when a |\vbox| occurs inside of an |\hbox|, \TEX\ is
+ temporarily interrupted from working in restricted horizontal mode, and it enters internal
+ vertical mode. The \quote {semantic nest} is a stack that keeps track of what lists and modes
+ are currently suspended.
+
+ At each level of processing we are in one of six modes:
+
+ \startitemize[n]
+ \startitem
+ |vmode| stands for vertical mode (the page builder);
+ \stopitem
+ \startitem
+ |hmode| stands for horizontal mode (the paragraph builder);
+ \stopitem
+ \startitem
+ |mmode| stands for displayed formula mode;
+ \stopitem
+ \startitem
+ |-vmode| stands for internal vertical mode (e.g., in a |\vbox|);
+ \stopitem
+ \startitem
+ |-hmode| stands for restricted horizontal mode (e.g., in an |\hbox|);
+ \stopitem
+ \startitem
+ |-mmode| stands for math formula mode (not displayed).
+ \stopitem
+ \stopitemize
+
+ The mode is temporarily set to zero while processing |\write| texts in the |ship_out| routine.
+
+ Numeric values are assigned to |vmode|, |hmode|, and |mmode| so that \TEX's \quote {big semantic
+ switch} can select the appropriate thing to do by computing the value |abs(mode) + cur_cmd|,
+ where |mode| is the current mode and |cur_cmd| is the current command code.
+
+*/
+
+# if main_control_mode == 0
+
+const char *tex_string_mode(int m)
+{
+ if (m > 0) {
+ switch (m / (max_command_cmd + 1)) {
+ case 0: return "vertical mode";
+ case 1: return "horizontal mode";
+ case 2: return "display math mode";
+ }
+ } else if (m == 0) {
+ return "no mode";
+ } else {
+ switch ((-m) / (max_command_cmd + 1)) {
+ case 0: return "internal vertical mode";
+ case 1: return "restricted horizontal mode";
+ case 2: return "math mode";
+ }
+ }
+ return "unknown mode";
+}
+
+# else
+
+const char *tex_string_mode(int m)
+{
+ switch (m) {
+ case nomode: return "no mode";
+ case vmode : return "vertical mode";
+ case hmode : return "horizontal mode";
+ case mmode : return "display math mode";
+ case -vmode : return "internal vertical mode";
+ case -hmode : return "restricted horizontal mode";
+ case -mmode : return "math mode";
+ default : return "unknown mode";
+ }
+}
+
+# endif
+
+/*tex
+
+ The state of affairs at any semantic level can be represented by five values:
+
+ \startitemize
+ \startitem
+ |mode| is the number representing the semantic mode, as just explained.
+ \stopitem
+ \startitem
+ |head| is a |pointer| to a list head for the list being built; |link(head)| therefore
+ points to the first element of the list, or to |null| if the list is empty.
+ \stopitem
+ \startitem
+ |tail| is a |pointer| to the final node of the list being built; thus, |tail=head| if
+ and only if the list is empty.
+ \stopitem
+ \startitem
+ |prev_graf| is the number of lines of the current paragraph that have already been put
+ into the present vertical list.
+ \stopitem
+ \startitem
+ |aux| is an auxiliary |memoryword| that gives further information that is needed to
+ characterize the situation.
+ \stopitem
+ \stopitemize
+
+ In vertical mode, |aux| is also known as |prev_depth|; it is the scaled value representing the
+ depth of the previous box, for use in baseline calculations, or it is |<= -1000pt| if the next
+ box on the vertical list is to be exempt from baseline calculations. In horizontal mode, |aux|
+ is also known as |space_factor|; it holds the current space factor used in spacing calculations.
+ In math mode, |aux| is also known as |incompleat_noad|; if not |null|, it points to a record
+ that represents the numerator of a generalized fraction for which the denominator is currently
+ being formed in the current list.
+
+ There is also a sixth quantity, |mode_line|, which correlates the semantic nest with the
+ user's input; |mode_line| contains the source line number at which the current level of nesting
+ was entered. The negative of this line number is the |mode_line| at the level of the user's
+ output routine.
+
+ A seventh quantity, |eTeX_aux|, is used by the extended features eTeX. In math mode it is known
+ as |delim_ptr| and points to the most recent |fence_noad| of a |math_left_group|.
+
+ In horizontal mode, the |prev_graf| field is used for initial language data.
+
+ The semantic nest is an array called |nest| that holds the |mode|, |head|, |tail|, |prev_graf|,
+ |aux|, and |mode_line| values for all semantic levels below the currently active one.
+ Information about the currently active level is kept in the global quantities |mode|, |head|,
+ |tail|, |prev_graf|, |aux|, and |mode_line|, which live in a struct that is ready to be pushed
+ onto |nest| if necessary.
+
+ The math field is used by various bits and pieces in |texmath.w|
+
+ This implementation of \TEX\ uses two different conventions for representing sequential stacks.
+
+ \startitemize[n]
+
+ \startitem
+ If there is frequent access to the top entry, and if the stack is essentially never
+ empty, then the top entry is kept in a global variable (even better would be a machine
+ register), and the other entries appear in the array |stack[0 .. (ptr-1)]|. The semantic
+ stack is handled this way.
+ \stopitem
+
+ \startitem
+ If there is infrequent top access, the entire stack contents are in the array |stack[0
+ .. (ptr - 1)]|. For example, the |save_stack| is treated this way, as we have seen.
+ \stopitem
+
+ \stopitemize
+
+ In |nest_ptr| we have the first unused location of |nest|, and |max_nest_stack| has the maximum
+ of |nest_ptr| when pushing. In |shown_mode| we store the most recent mode shown by
+ |\tracingcommands| and with |save_tail| we can examine whether we have an auto kern before a
+ glue.
+
+*/
+
+nest_state_info lmt_nest_state = {
+ .nest = NULL,
+ .nest_data = {
+ .minimum = min_nest_size,
+ .maximum = max_nest_size,
+ .size = siz_nest_size,
+ .step = stp_nest_size,
+ .allocated = 0,
+ .itemsize = sizeof(list_state_record),
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .shown_mode = 0,
+ .padding = 0,
+};
+
+/*tex
+
+ We will see later that the vertical list at the bottom semantic level is split into two parts;
+ the \quote {current page} runs from |page_head| to |page_tail|, and the \quote {contribution
+ list} runs from |contribute_head| to |tail| of semantic level zero. The idea is that contributions
+ are first formed in vertical mode, then \quote {contributed} to the current page (during which
+ time the page|-|breaking decisions are made). For now, we don't need to know any more details
+ about the page-building process.
+
+*/
+
+# define reserved_nest_slots 0
+
+void tex_initialize_nest_state(void)
+{
+ int size = lmt_nest_state.nest_data.minimum;
+ lmt_nest_state.nest = aux_allocate_clear_array(sizeof(list_state_record), size, reserved_nest_slots);
+ if (lmt_nest_state.nest) {
+ lmt_nest_state.nest_data.allocated = size;
+ } else {
+ tex_overflow_error("nest", size);
+ }
+}
+
+static int tex_aux_room_on_nest_stack(void) /* quite similar to save_stack checker so maybe share */
+{
+ int top = lmt_nest_state.nest_data.ptr;
+ if (top > lmt_nest_state.nest_data.top) {
+ lmt_nest_state.nest_data.top = top;
+ if (top > lmt_nest_state.nest_data.allocated) {
+ list_state_record *tmp = NULL;
+ top = lmt_nest_state.nest_data.allocated + lmt_nest_state.nest_data.step;
+ if (top > lmt_nest_state.nest_data.size) {
+ top = lmt_nest_state.nest_data.size;
+ }
+ if (top > lmt_nest_state.nest_data.allocated) {
+ lmt_nest_state.nest_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_nest_state.nest, sizeof(list_state_record), top, reserved_nest_slots);
+ lmt_nest_state.nest = tmp;
+ }
+ lmt_run_memory_callback("nest", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("nest", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+void tex_initialize_nesting(void)
+{
+ lmt_nest_state.nest_data.ptr = 0;
+ lmt_nest_state.nest_data.top = 0;
+ lmt_nest_state.shown_mode = 0;
+ cur_list.mode = vmode;
+ cur_list.head = contribute_head;
+ cur_list.tail = contribute_head;
+ cur_list.delim = null;
+ cur_list.prev_graf = 0;
+ cur_list.mode_line = 0;
+ cur_list.prev_depth = ignore_depth;
+ cur_list.space_factor = 1000;
+ cur_list.incomplete_noad = null;
+ cur_list.direction_stack = null;
+ cur_list.math_dir = 0;
+ cur_list.math_style = -1;
+ cur_list.math_flatten = 1;
+ cur_list.math_begin = unset_noad_class;
+ cur_list.math_end = unset_noad_class;
+ cur_list.math_mode = 0;
+}
+
+halfword tex_pop_tail(void)
+{
+ if (cur_list.tail != cur_list.head) {
+ halfword r = cur_list.tail;
+ halfword n = node_prev(r);
+ if (node_next(n) != r) {
+ n = cur_list.head;
+ while (node_next(n) != r) {
+ n = node_next(n);
+ }
+ }
+ cur_list.tail = n;
+ node_prev(r) = null;
+ node_next(n) = null;
+ return r;
+ } else {
+ return null;
+ }
+}
+
+/*tex
+
+ When \TEX's work on one level is interrupted, the state is saved by calling |push_nest|. This
+ routine changes |head| and |tail| so that a new (empty) list is begun; it does not change
+ |mode| or |aux|.
+
+*/
+
+void tex_push_nest(void)
+{
+ list_state_record *top = &lmt_nest_state.nest[lmt_nest_state.nest_data.ptr];
+ lmt_nest_state.nest_data.ptr += 1;
+ if (tex_aux_room_on_nest_stack()) {
+ cur_list.mode = top->mode;
+ cur_list.head = tex_new_temp_node();
+ cur_list.tail = cur_list.head;
+ cur_list.delim = null;
+ cur_list.prev_graf = 0;
+ cur_list.mode_line = lmt_input_state.input_line;
+ cur_list.prev_depth = top->prev_depth;
+ cur_list.space_factor = top->space_factor;
+ cur_list.incomplete_noad = top->incomplete_noad;
+ cur_list.direction_stack = null;
+ cur_list.math_dir = 0;
+ cur_list.math_style = -1;
+ cur_list.math_flatten = 1;
+ cur_list.math_begin = unset_noad_class;
+ cur_list.math_end = unset_noad_class;
+ // cur_list.math_begin = top->math_begin;
+ // cur_list.math_end = top->math_end;
+ cur_list.math_mode = 0;
+ } else {
+ tex_overflow_error("semantic nest size", lmt_nest_state.nest_data.size);
+ }
+}
+
+/*tex
+
+ Conversely, when \TEX\ is finished on the current level, the former state is restored by
+ calling |pop_nest|. This routine will never be called at the lowest semantic level, nor will
+ it be called unless |head| is a node that should be returned to free memory.
+
+*/
+
+void tex_pop_nest(void)
+{
+ if (cur_list.head) {
+ /* tex_free_node(cur_list.head, temp_node_size); */ /* looks fragile */
+ tex_flush_node(cur_list.head);
+ /*tex Just to be sure, in case we access from \LUA: */
+ // cur_list.head = null;
+ // cur_list.tail = null;
+ }
+ --lmt_nest_state.nest_data.ptr;
+}
+
+/*tex Here is a procedure that displays what \TEX\ is working on, at all levels. */
+
+void tex_show_activities(void)
+{
+ tex_print_nlp();
+ for (int p = lmt_nest_state.nest_data.ptr; p >= 0; p--) {
+ list_state_record n = lmt_nest_state.nest[p];
+ tex_print_format("%l[%M entered at line %i%s]", n.mode, abs(n.mode_line), n.mode_line < 0 ? " (output routine)" : ""); // %L
+ if (p == 0) {
+ /*tex Show the status of the current page */
+ if (page_head != lmt_page_builder_state.page_tail) {
+ tex_print_format("%l[current page:%s]", lmt_page_builder_state.output_active ? " (held over for next output)" : "");
+ tex_show_box(node_next(page_head));
+ if (lmt_page_builder_state.contents != contribute_nothing) {
+ halfword r;
+ tex_print_format("%l[total height %P, goal height %D]",
+ page_total, page_stretch, page_filstretch, page_fillstretch, page_filllstretch, page_shrink,
+ page_goal, pt_unit
+ );
+ r = node_next(page_insert_head);
+ while (r != page_insert_head) {
+ halfword index = insert_index(r);
+ halfword multiplier = tex_get_insert_multiplier(index);
+ halfword size = multiplier == 1000 ? insert_total_height(r) : tex_x_over_n(insert_total_height(r), 1000) * multiplier;
+ if (node_type(r) == split_node && node_subtype(r) == insert_split_subtype) {
+ halfword q = page_head;
+ halfword n = 0;
+ do {
+ q = node_next(q);
+ if (node_type(q) == insert_node && split_insert_index(q) == insert_index(r)) {
+ ++n;
+ }
+ } while (q != split_broken_insert(r));
+ tex_print_format("%l[insert %i adds %D, might split to %i]", index, size, pt_unit, n);
+ } else {
+ tex_print_format("%l[insert %i adds %D]", index, size, pt_unit);
+ }
+ r = node_next(r);
+ }
+ }
+ }
+ if (node_next(contribute_head)) {
+ tex_print_format("%l[recent contributions:]");
+ }
+ }
+ tex_print_format("%l[begin list]");
+ tex_show_box(node_next(n.head));
+ tex_print_format("%l[end list]");
+ /*tex Show the auxiliary field, |a|. */
+ switch (abs(n.mode) / (max_command_cmd + 1)) {
+ case 0:
+ {
+ if (n.prev_depth <= ignore_depth) {
+ tex_print_format("%l[prevdepth ignored");
+ } else {
+ tex_print_format("%l[prevdepth %D", n.prev_depth, pt_unit);
+ }
+ if (n.prev_graf != 0) {
+ tex_print_format(", prevgraf %i line%s", n.prev_graf, n.prev_graf == 1 ? "" : "s");
+ }
+ tex_print_char(']');
+ break;
+ }
+ case 1:
+ {
+ break;
+ }
+ case 2:
+ {
+ if (n.incomplete_noad) {
+ tex_print_format("%l[this will be denominator of:]");
+ tex_print_format("%l[begin list]");
+ tex_show_box(n.incomplete_noad);
+ tex_print_format("%l[end list]");
+ }
+ break;
+ }
+ }
+ }
+}
+
+int tex_vmode_nest_index(void)
+{
+ int p = lmt_nest_state.nest_data.ptr; /* index into |nest| */
+ while (abs(lmt_nest_state.nest[p].mode) != vmode) {
+ --p;
+ }
+ return p;
+}
+
+void tex_tail_append(halfword p)
+{
+ node_next(cur_list.tail) = p;
+ node_prev(p) = cur_list.tail;
+ cur_list.tail = p;
+}
diff --git a/source/luametatex/source/tex/texnesting.h b/source/luametatex/source/tex/texnesting.h
new file mode 100644
index 000000000..f940094a0
--- /dev/null
+++ b/source/luametatex/source/tex/texnesting.h
@@ -0,0 +1,71 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_NESTING_H
+# define LMT_NESTING_H
+
+typedef struct list_state_record {
+ int mode;
+ halfword head;
+ halfword tail;
+ int prev_graf;
+ int mode_line;
+ halfword prev_depth; // scaled
+ halfword space_factor;
+ halfword direction_stack;
+ int math_dir;
+ int math_style;
+ int math_scale;
+ int math_main_style;
+ halfword delim;
+ halfword incomplete_noad;
+ halfword math_flatten;
+ halfword math_begin;
+ halfword math_end;
+ halfword math_mode;
+} list_state_record;
+
+typedef struct nest_state_info {
+ list_state_record *nest;
+ memory_data nest_data;
+ int shown_mode;
+ int padding;
+} nest_state_info;
+
+extern nest_state_info lmt_nest_state;
+
+# define cur_list lmt_nest_state.nest[lmt_nest_state.nest_data.ptr] /*tex The \quote {top} semantic state. */
+# define cur_mode (abs(cur_list.mode))
+
+extern void tex_initialize_nest_state (void);
+/* int tex_room_on_nest_stack (void); */
+extern void tex_initialize_nesting (void);
+extern void tex_push_nest (void);
+extern void tex_pop_nest (void);
+extern void tex_tail_append (halfword p);
+extern halfword tex_pop_tail (void);
+extern const char *tex_string_mode (int m);
+extern void tex_show_activities (void);
+extern int tex_vmode_nest_index (void);
+
+/*tex
+ When we use a macro instead of a function we need to use an intermediate variable because |_p_|
+ can be a functioncall itself (something |new_*|). The gain is a little performance because this
+ one is called a lot. The loss is a bit larger binary. There are some more macros sensitive for
+ this, like the ones that couple nodes. Also, inlining a function can spoil this game!
+*/
+
+/*
+# define tail_append(_p_) do { \
+ halfword __p__ = _p_ ; \
+ tex_couple_nodes(cur_list.tail, __p__); \
+ cur_list.tail = __p__; \
+} while (0)
+*/
+
+/*
+# define tail_append tex_tail_append
+*/
+
+# endif
diff --git a/source/luametatex/source/tex/texnodes.c b/source/luametatex/source/tex/texnodes.c
new file mode 100644
index 000000000..45e04dfd2
--- /dev/null
+++ b/source/luametatex/source/tex/texnodes.c
@@ -0,0 +1,4794 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ This module started out using DEBUG 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. Only on
+ massive freeing we can gain.
+
+*/
+
+node_memory_state_info lmt_node_memory_state = {
+ .nodes = NULL,
+ .nodesizes = NULL,
+ .free_chain = { null },
+ .nodes_data = {
+ .minimum = min_node_size,
+ .maximum = max_node_size,
+ .size = siz_node_size,
+ .step = stp_node_size,
+ .allocated = 0,
+ .itemsize = sizeof(memoryword) + sizeof(char),
+ .top = 0, // beware, node pointers are just offsets below top
+ .ptr = 0, // total size in use
+ .initial = 0,
+ .offset = 0,
+ },
+ .extra_data = {
+ .minimum = memory_data_unset,
+ .maximum = memory_data_unset,
+ .size = memory_data_unset,
+ .step = memory_data_unset,
+ .allocated = 0,
+ .itemsize = 1,
+ .top = 0,
+ .ptr = 0,
+ .initial = memory_data_unset,
+ .offset = 0,
+ },
+ .reserved = 0,
+ .padding = 0,
+ .node_properties_id = 0,
+ .lua_properties_level = 0,
+ .attribute_cache = 0,
+ .max_used_attribute = 1,
+ .node_properties_table_size = 0,
+};
+
+/*tex Defined below. */
+
+static void tex_aux_check_node (halfword node);
+static halfword tex_aux_allocated_node (int size);
+
+/*tex
+
+ The following definitions are used for keys at the \LUA\ end and provide an efficient way to
+ share hashed strings. For a long time we had this:
+
+ static value_info lmt_node_fields_accent [10];
+
+ node_info lmt_node_data[] = {
+ { .id = hlist_node, .size = box_node_size, .subtypes = NULL, .fields = lmt_node_fields_list, .name = NULL, .lua = 0, .visible = 1 },
+ ....
+ } ;
+
+ etc but eventually we went a bit more dynamic because after all some helpers showeed up. This
+ brings many node properties together. Not all nodes are visible for users. Most of the
+ properties can be provided as lists.
+
+ not all math noad fields ar ementioned here yet ... some are still experimental
+
+*/
+
+void lmt_nodelib_initialize(void) {
+
+ /*tes The subtypes of nodes. */
+
+ value_info
+ *subtypes_dir, *subtypes_par, *subtypes_glue, *subtypes_boundary, *subtypes_penalty, *subtypes_kern,
+ *subtypes_rule, *subtypes_glyph , *subtypes_disc, *subtypes_list, *subtypes_adjust, *subtypes_mark,
+ *subtypes_math, *subtypes_noad, *subtypes_radical, *subtypes_choice, *subtypes_accent, *subtypes_fence, *subtypes_split,
+ *subtypes_attribute;
+
+ value_info
+ *lmt_node_fields_accent, *lmt_node_fields_adjust, *lmt_node_fields_attribute,
+ *lmt_node_fields_boundary, *lmt_node_fields_choice, *lmt_node_fields_delimiter, *lmt_node_fields_dir,
+ *lmt_node_fields_disc, *lmt_node_fields_fence, *lmt_node_fields_fraction, *lmt_node_fields_glue,
+ *lmt_node_fields_glue_spec, *lmt_node_fields_glyph, *lmt_node_fields_insert, *lmt_node_fields_split,
+ *lmt_node_fields_kern, *lmt_node_fields_list, *lmt_node_fields_par, *lmt_node_fields_mark, *lmt_node_fields_math,
+ *lmt_node_fields_math_char, *lmt_node_fields_math_text_char, *lmt_node_fields_noad, *lmt_node_fields_penalty,
+ *lmt_node_fields_radical, *lmt_node_fields_rule, *lmt_node_fields_style, *lmt_node_fields_parameter,
+ *lmt_node_fields_sub_box, *lmt_node_fields_sub_mlist, *lmt_node_fields_unset, *lmt_node_fields_whatsit;
+
+ subtypes_dir = lmt_aux_allocate_value_info(cancel_dir_subtype);
+
+ set_value_entry_key(subtypes_dir, normal_dir_subtype, normal)
+ set_value_entry_key(subtypes_dir, cancel_dir_subtype, cancel)
+
+ subtypes_split = lmt_aux_allocate_value_info(insert_split_subtype);
+
+ set_value_entry_key(subtypes_split, normal_split_subtype, normal)
+ set_value_entry_key(subtypes_split, insert_split_subtype, insert)
+
+ subtypes_par = lmt_aux_allocate_value_info(math_par_subtype);
+
+ set_value_entry_key(subtypes_par, vmode_par_par_subtype, vmodepar)
+ set_value_entry_key(subtypes_par, local_box_par_subtype, localbox)
+ set_value_entry_key(subtypes_par, hmode_par_par_subtype, hmodepar)
+ set_value_entry_key(subtypes_par, penalty_par_subtype, penalty)
+ set_value_entry_key(subtypes_par, math_par_subtype, math)
+
+ subtypes_glue = lmt_aux_allocate_value_info(u_leaders);
+
+ set_value_entry_key(subtypes_glue, user_skip_glue, userskip)
+ set_value_entry_key(subtypes_glue, line_skip_glue, lineskip)
+ set_value_entry_key(subtypes_glue, baseline_skip_glue, baselineskip)
+ set_value_entry_key(subtypes_glue, par_skip_glue, parskip)
+ set_value_entry_key(subtypes_glue, above_display_skip_glue, abovedisplayskip)
+ set_value_entry_key(subtypes_glue, below_display_skip_glue, belowdisplayskip)
+ set_value_entry_key(subtypes_glue, above_display_short_skip_glue, abovedisplayshortskip)
+ set_value_entry_key(subtypes_glue, below_display_short_skip_glue, belowdisplayshortskip)
+ set_value_entry_key(subtypes_glue, left_skip_glue, leftskip)
+ set_value_entry_key(subtypes_glue, right_skip_glue, rightskip)
+ set_value_entry_key(subtypes_glue, top_skip_glue, topskip)
+ set_value_entry_key(subtypes_glue, split_top_skip_glue, splittopskip)
+ set_value_entry_key(subtypes_glue, tab_skip_glue, tabskip)
+ set_value_entry_key(subtypes_glue, space_skip_glue, spaceskip)
+ set_value_entry_key(subtypes_glue, xspace_skip_glue, xspaceskip)
+ set_value_entry_key(subtypes_glue, zero_space_skip_glue, zerospaceskip)
+ set_value_entry_key(subtypes_glue, par_fill_left_skip_glue, parfillleftskip)
+ set_value_entry_key(subtypes_glue, par_fill_right_skip_glue, parfillskip)
+ set_value_entry_key(subtypes_glue, par_init_left_skip_glue, parinitleftskip)
+ set_value_entry_key(subtypes_glue, par_init_right_skip_glue, parinitrightskip)
+ set_value_entry_key(subtypes_glue, indent_skip_glue, indentskip)
+ set_value_entry_key(subtypes_glue, left_hang_skip_glue, lefthangskip)
+ set_value_entry_key(subtypes_glue, right_hang_skip_glue, righthangskip)
+ set_value_entry_key(subtypes_glue, correction_skip_glue, correctionskip)
+ set_value_entry_key(subtypes_glue, inter_math_skip_glue, intermathskip)
+ set_value_entry_key(subtypes_glue, ignored_glue, ignored)
+ set_value_entry_key(subtypes_glue, page_glue, page)
+ set_value_entry_key(subtypes_glue, math_skip_glue, mathskip)
+ set_value_entry_key(subtypes_glue, thin_mu_skip_glue, thinmuskip)
+ set_value_entry_key(subtypes_glue, med_mu_skip_glue, medmuskip)
+ set_value_entry_key(subtypes_glue, thick_mu_skip_glue, thickmuskip)
+ set_value_entry_key(subtypes_glue, conditional_math_glue, conditionalmathskip)
+ set_value_entry_key(subtypes_glue, rulebased_math_glue, rulebasedmathskip)
+ set_value_entry_key(subtypes_glue, mu_glue, muglue)
+ set_value_entry_key(subtypes_glue, a_leaders, leaders)
+ set_value_entry_key(subtypes_glue, c_leaders, cleaders)
+ set_value_entry_key(subtypes_glue, x_leaders, xleaders)
+ set_value_entry_key(subtypes_glue, g_leaders, gleaders)
+ set_value_entry_key(subtypes_glue, u_leaders, uleaders)
+
+ subtypes_boundary = lmt_aux_allocate_value_info(word_boundary);
+
+ set_value_entry_key(subtypes_boundary, cancel_boundary, cancel)
+ set_value_entry_key(subtypes_boundary, user_boundary, user)
+ set_value_entry_key(subtypes_boundary, protrusion_boundary, protrusion)
+ set_value_entry_key(subtypes_boundary, word_boundary, word)
+
+ subtypes_penalty = lmt_aux_allocate_value_info(equation_number_penalty_subtype);
+
+ set_value_entry_key(subtypes_penalty, user_penalty_subtype, userpenalty)
+ set_value_entry_key(subtypes_penalty, linebreak_penalty_subtype, linebreakpenalty)
+ set_value_entry_key(subtypes_penalty, line_penalty_subtype, linepenalty)
+ set_value_entry_key(subtypes_penalty, word_penalty_subtype, wordpenalty)
+ set_value_entry_key(subtypes_penalty, final_penalty_subtype, finalpenalty)
+ set_value_entry_key(subtypes_penalty, orphan_penalty_subtype, orphanpenalty)
+ set_value_entry_key(subtypes_penalty, math_pre_penalty_subtype, mathprepenalty)
+ set_value_entry_key(subtypes_penalty, math_post_penalty_subtype, mathpostpenalty)
+ set_value_entry_key(subtypes_penalty, before_display_penalty_subtype, beforedisplaypenalty)
+ set_value_entry_key(subtypes_penalty, after_display_penalty_subtype, afterdisplaypenalty)
+ set_value_entry_key(subtypes_penalty, equation_number_penalty_subtype, equationnumberpenalty)
+
+ subtypes_kern = lmt_aux_allocate_value_info(vertical_math_kern_subtype);
+
+ set_value_entry_key(subtypes_kern, font_kern_subtype, fontkern)
+ set_value_entry_key(subtypes_kern, explicit_kern_subtype, userkern)
+ set_value_entry_key(subtypes_kern, accent_kern_subtype, accentkern)
+ set_value_entry_key(subtypes_kern, italic_kern_subtype, italiccorrection)
+ set_value_entry_key(subtypes_kern, left_margin_kern_subtype, leftmarginkern)
+ set_value_entry_key(subtypes_kern, right_margin_kern_subtype, rightmarginkern)
+ set_value_entry_key(subtypes_kern, explicit_math_kern_subtype, mathkerns)
+ set_value_entry_key(subtypes_kern, math_shape_kern_subtype, mathshapekern)
+ set_value_entry_key(subtypes_kern, horizontal_math_kern_subtype, horizontalmathkern)
+ set_value_entry_key(subtypes_kern, vertical_math_kern_subtype, verticalmathkern)
+
+ subtypes_rule = lmt_aux_allocate_value_info(image_rule_subtype);
+
+ set_value_entry_key(subtypes_rule, normal_rule_subtype, normal)
+ set_value_entry_key(subtypes_rule, empty_rule_subtype, empty)
+ set_value_entry_key(subtypes_rule, strut_rule_subtype, strut)
+ set_value_entry_key(subtypes_rule, outline_rule_subtype, outline)
+ set_value_entry_key(subtypes_rule, user_rule_subtype, user)
+ set_value_entry_key(subtypes_rule, math_over_rule_subtype, over)
+ set_value_entry_key(subtypes_rule, math_under_rule_subtype, under)
+ set_value_entry_key(subtypes_rule, math_fraction_rule_subtype, fraction)
+ set_value_entry_key(subtypes_rule, math_radical_rule_subtype, radical)
+ set_value_entry_key(subtypes_rule, box_rule_subtype, box)
+ set_value_entry_key(subtypes_rule, image_rule_subtype, image)
+
+ subtypes_glyph = lmt_aux_allocate_value_info(glyph_math_accent_subtype);
+
+ set_value_entry_key(subtypes_glyph, glyph_unset_subtype, unset)
+ set_value_entry_key(subtypes_glyph, glyph_character_subtype, character)
+ set_value_entry_key(subtypes_glyph, glyph_ligature_subtype, ligature)
+ set_value_entry_key(subtypes_glyph, glyph_math_delimiter_subtype, delimiter);
+ set_value_entry_key(subtypes_glyph, glyph_math_extensible_subtype, extensible);
+ set_value_entry_key(subtypes_glyph, glyph_math_ordinary_subtype, ord);
+ set_value_entry_key(subtypes_glyph, glyph_math_operator_subtype, op);
+ set_value_entry_key(subtypes_glyph, glyph_math_binary_subtype, bin);
+ set_value_entry_key(subtypes_glyph, glyph_math_relation_subtype, rel);
+ set_value_entry_key(subtypes_glyph, glyph_math_open_subtype, open);
+ set_value_entry_key(subtypes_glyph, glyph_math_close_subtype, close);
+ set_value_entry_key(subtypes_glyph, glyph_math_punctuation_subtype, punct);
+ set_value_entry_key(subtypes_glyph, glyph_math_variable_subtype, variable);
+ set_value_entry_key(subtypes_glyph, glyph_math_active_subtype, active);
+ set_value_entry_key(subtypes_glyph, glyph_math_inner_subtype, inner);
+ set_value_entry_key(subtypes_glyph, glyph_math_over_subtype, over);
+ set_value_entry_key(subtypes_glyph, glyph_math_under_subtype, under);
+ set_value_entry_key(subtypes_glyph, glyph_math_fraction_subtype, fraction);
+ set_value_entry_key(subtypes_glyph, glyph_math_radical_subtype, radical);
+ set_value_entry_key(subtypes_glyph, glyph_math_middle_subtype, middle);
+ set_value_entry_key(subtypes_glyph, glyph_math_accent_subtype, accent);
+
+ subtypes_disc = lmt_aux_allocate_value_info(syllable_discretionary_code);
+
+ set_value_entry_key(subtypes_disc, normal_discretionary_code, discretionary)
+ set_value_entry_key(subtypes_disc, explicit_discretionary_code, explicit)
+ set_value_entry_key(subtypes_disc, automatic_discretionary_code, automatic)
+ set_value_entry_key(subtypes_disc, mathematics_discretionary_code, math)
+ set_value_entry_key(subtypes_disc, syllable_discretionary_code, regular)
+
+ subtypes_fence = lmt_aux_allocate_value_info(no_fence_side);
+
+ set_value_entry_key(subtypes_fence, unset_fence_side, unset)
+ set_value_entry_key(subtypes_fence, left_fence_side, left)
+ set_value_entry_key(subtypes_fence, middle_fence_side, middle)
+ set_value_entry_key(subtypes_fence, right_fence_side, right)
+ set_value_entry_key(subtypes_fence, left_operator_side, operator)
+ set_value_entry_key(subtypes_fence, no_fence_side, no)
+
+ subtypes_list = lmt_aux_allocate_value_info(local_middle_list);
+
+ set_value_entry_key(subtypes_list, unknown_list, unknown)
+ set_value_entry_key(subtypes_list, line_list, line)
+ set_value_entry_key(subtypes_list, hbox_list, box)
+ set_value_entry_key(subtypes_list, indent_list, indent)
+ set_value_entry_key(subtypes_list, container_list, container)
+ set_value_entry_key(subtypes_list, align_row_list, alignment)
+ set_value_entry_key(subtypes_list, align_cell_list, cell)
+ set_value_entry_key(subtypes_list, equation_list, equation)
+ set_value_entry_key(subtypes_list, equation_number_list, equationnumber)
+ set_value_entry_key(subtypes_list, math_list_list, math)
+ set_value_entry_key(subtypes_list, math_pack_list, mathpack)
+ set_value_entry_key(subtypes_list, math_char_list, mathchar)
+ set_value_entry_key(subtypes_list, math_h_extensible_list, hextensible)
+ set_value_entry_key(subtypes_list, math_v_extensible_list, vextensible)
+ set_value_entry_key(subtypes_list, math_h_delimiter_list, hdelimiter)
+ set_value_entry_key(subtypes_list, math_v_delimiter_list, vdelimiter)
+ set_value_entry_key(subtypes_list, math_over_delimiter_list, overdelimiter)
+ set_value_entry_key(subtypes_list, math_under_delimiter_list, underdelimiter)
+ set_value_entry_key(subtypes_list, math_numerator_list, numerator)
+ set_value_entry_key(subtypes_list, math_denominator_list, denominator)
+ set_value_entry_key(subtypes_list, math_modifier_list, modifier)
+ set_value_entry_key(subtypes_list, math_fraction_list, fraction)
+ set_value_entry_key(subtypes_list, math_nucleus_list, nucleus)
+ set_value_entry_key(subtypes_list, math_sup_list, sup)
+ set_value_entry_key(subtypes_list, math_sub_list, sub)
+ set_value_entry_key(subtypes_list, math_pre_post_list, prepost)
+ set_value_entry_key(subtypes_list, math_degree_list, degree)
+ set_value_entry_key(subtypes_list, math_scripts_list, scripts)
+ set_value_entry_key(subtypes_list, math_over_list, over)
+ set_value_entry_key(subtypes_list, math_under_list, under)
+ set_value_entry_key(subtypes_list, math_accent_list, accent)
+ set_value_entry_key(subtypes_list, math_radical_list, radical)
+ set_value_entry_key(subtypes_list, math_fence_list, fence)
+ set_value_entry_key(subtypes_list, math_rule_list, rule)
+ set_value_entry_key(subtypes_list, math_ghost_list, ghost)
+ set_value_entry_key(subtypes_list, insert_result_list, insert)
+ set_value_entry_key(subtypes_list, local_list, local)
+ set_value_entry_key(subtypes_list, local_left_list, left)
+ set_value_entry_key(subtypes_list, local_right_list, right)
+ set_value_entry_key(subtypes_list, local_middle_list, middle)
+
+ subtypes_math = lmt_aux_allocate_value_info(end_inline_math);
+
+ set_value_entry_key(subtypes_math, begin_inline_math, beginmath)
+ set_value_entry_key(subtypes_math, end_inline_math, endmath)
+
+ subtypes_adjust = lmt_aux_allocate_value_info(local_adjust_code);
+
+ set_value_entry_key(subtypes_adjust, pre_adjust_code, pre)
+ set_value_entry_key(subtypes_adjust, post_adjust_code, post)
+ set_value_entry_key(subtypes_adjust, local_adjust_code, local)
+
+ subtypes_mark = lmt_aux_allocate_value_info(reset_mark_value_code);
+
+ set_value_entry_key(subtypes_mark, set_mark_value_code, set)
+ set_value_entry_key(subtypes_mark, reset_mark_value_code, reset)
+
+ subtypes_noad = lmt_aux_allocate_value_info(vcenter_noad_subtype); // last_noad_subtype
+
+ set_value_entry_key(subtypes_noad, ordinary_noad_subtype, ord)
+ set_value_entry_key(subtypes_noad, operator_noad_subtype, op)
+ set_value_entry_key(subtypes_noad, binary_noad_subtype, bin)
+ set_value_entry_key(subtypes_noad, relation_noad_subtype, rel)
+ set_value_entry_key(subtypes_noad, open_noad_subtype, open)
+ set_value_entry_key(subtypes_noad, close_noad_subtype, close)
+ set_value_entry_key(subtypes_noad, punctuation_noad_subtype, punct)
+ set_value_entry_key(subtypes_noad, variable_noad_subtype, variable)
+ set_value_entry_key(subtypes_noad, active_noad_subtype, active)
+ set_value_entry_key(subtypes_noad, inner_noad_subtype, inner)
+ set_value_entry_key(subtypes_noad, under_noad_subtype, under)
+ set_value_entry_key(subtypes_noad, over_noad_subtype, over)
+ set_value_entry_key(subtypes_noad, fraction_noad_subtype, fraction)
+ set_value_entry_key(subtypes_noad, radical_noad_subtype, radical)
+ set_value_entry_key(subtypes_noad, middle_noad_subtype, middle)
+ set_value_entry_key(subtypes_noad, accent_noad_subtype, accent)
+ set_value_entry_key(subtypes_noad, fenced_noad_subtype, fenced)
+ set_value_entry_key(subtypes_noad, ghost_noad_subtype, ghost)
+ set_value_entry_key(subtypes_noad, vcenter_noad_subtype, vcenter)
+
+ subtypes_choice = lmt_aux_allocate_value_info(discretionary_choice_subtype);
+
+ set_value_entry_key(subtypes_choice, normal_choice_subtype, normal)
+ set_value_entry_key(subtypes_choice, discretionary_choice_subtype, discretionary)
+
+ subtypes_radical = lmt_aux_allocate_value_info(h_extensible_radical_subtype);
+
+ set_value_entry_key(subtypes_radical, normal_radical_subtype, normal)
+ set_value_entry_key(subtypes_radical, radical_radical_subtype, radical)
+ set_value_entry_key(subtypes_radical, root_radical_subtype, root)
+ set_value_entry_key(subtypes_radical, rooted_radical_subtype, rooted)
+ set_value_entry_key(subtypes_radical, under_delimiter_radical_subtype, underdelimiter)
+ set_value_entry_key(subtypes_radical, over_delimiter_radical_subtype, overdelimiter)
+ set_value_entry_key(subtypes_radical, delimiter_under_radical_subtype, delimiterunder)
+ set_value_entry_key(subtypes_radical, delimiter_over_radical_subtype, delimiterover)
+ set_value_entry_key(subtypes_radical, delimited_radical_subtype, delimited)
+ set_value_entry_key(subtypes_radical, h_extensible_radical_subtype, hextensible)
+
+ subtypes_accent = lmt_aux_allocate_value_info(fixedboth_accent_subtype);
+
+ set_value_entry_key(subtypes_accent, bothflexible_accent_subtype, bothflexible)
+ set_value_entry_key(subtypes_accent, fixedtop_accent_subtype, fixedtop)
+ set_value_entry_key(subtypes_accent, fixedbottom_accent_subtype, fixedbottom)
+ set_value_entry_key(subtypes_accent, fixedboth_accent_subtype, fixedboth)
+
+ subtypes_attribute = lmt_aux_allocate_value_info(attribute_value_subtype);
+
+ set_value_entry_key(subtypes_attribute, attribute_list_subtype, list)
+ set_value_entry_key(subtypes_attribute, attribute_value_subtype, value)
+
+ /*tex The fields of nodes. */
+
+ lmt_node_fields_accent = lmt_aux_allocate_value_info(9);
+
+ set_value_entry_val(lmt_node_fields_accent, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_accent, 1, node_list_field, nucleus);
+ set_value_entry_val(lmt_node_fields_accent, 2, node_list_field, sub);
+ set_value_entry_val(lmt_node_fields_accent, 3, node_list_field, sup);
+ set_value_entry_val(lmt_node_fields_accent, 4, node_list_field, accent);
+ set_value_entry_val(lmt_node_fields_accent, 5, node_list_field, bottomaccent);
+ set_value_entry_val(lmt_node_fields_accent, 6, node_list_field, topaccent);
+ set_value_entry_val(lmt_node_fields_accent, 7, node_list_field, overlayaccent);
+ set_value_entry_val(lmt_node_fields_accent, 8, node_list_field, fraction);
+
+ lmt_node_fields_adjust = lmt_aux_allocate_value_info(2);
+
+ set_value_entry_val(lmt_node_fields_adjust, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_adjust, 1, node_list_field, list);
+
+ lmt_node_fields_attribute = lmt_aux_allocate_value_info(4);
+
+ set_value_entry_val(lmt_node_fields_attribute, 0, integer_field, count);
+ set_value_entry_val(lmt_node_fields_attribute, 1, integer_field, data);
+ set_value_entry_val(lmt_node_fields_attribute, 2, integer_field, index);
+ set_value_entry_val(lmt_node_fields_attribute, 3, integer_field, value);
+
+ /* Nothing */
+
+ lmt_node_fields_boundary = lmt_aux_allocate_value_info(2);
+
+ set_value_entry_val(lmt_node_fields_boundary, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_boundary, 1, integer_field, data);
+
+ lmt_node_fields_choice = lmt_aux_allocate_value_info(5);
+
+ set_value_entry_val(lmt_node_fields_choice, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_choice, 1, node_list_field, display);
+ set_value_entry_val(lmt_node_fields_choice, 2, node_list_field, text);
+ set_value_entry_val(lmt_node_fields_choice, 3, node_list_field, script);
+ set_value_entry_val(lmt_node_fields_choice, 4, node_list_field, scriptscript);
+
+ lmt_node_fields_delimiter = lmt_aux_allocate_value_info(5);
+
+ set_value_entry_val(lmt_node_fields_delimiter, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_delimiter, 1, integer_field, smallfamily);
+ set_value_entry_val(lmt_node_fields_delimiter, 2, integer_field, smallchar);
+ set_value_entry_val(lmt_node_fields_delimiter, 3, integer_field, largefamily);
+ set_value_entry_val(lmt_node_fields_delimiter, 4, integer_field, largechar);
+
+ lmt_node_fields_dir = lmt_aux_allocate_value_info(3);
+
+ set_value_entry_val(lmt_node_fields_dir, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_dir, 1, integer_field, dir);
+ set_value_entry_val(lmt_node_fields_dir, 2, integer_field, level);
+
+ lmt_node_fields_disc = lmt_aux_allocate_value_info( 6);
+
+ set_value_entry_val(lmt_node_fields_disc, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_disc, 1, node_list_field, pre);
+ set_value_entry_val(lmt_node_fields_disc, 2, node_list_field, post);
+ set_value_entry_val(lmt_node_fields_disc, 3, node_list_field, replace);
+ set_value_entry_val(lmt_node_fields_disc, 4, integer_field, penalty);
+ set_value_entry_val(lmt_node_fields_disc, 5, integer_field, options);
+
+ lmt_node_fields_fence = lmt_aux_allocate_value_info(10);
+
+ set_value_entry_val(lmt_node_fields_fence, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_fence, 1, node_list_field, delimiter);
+ set_value_entry_val(lmt_node_fields_fence, 2, dimension_field, italic);
+ set_value_entry_val(lmt_node_fields_fence, 3, dimension_field, height);
+ set_value_entry_val(lmt_node_fields_fence, 4, dimension_field, depth);
+ set_value_entry_val(lmt_node_fields_fence, 5, integer_field, options);
+ set_value_entry_val(lmt_node_fields_fence, 6, integer_field, class);
+ set_value_entry_val(lmt_node_fields_fence, 7, integer_field, source);
+ set_value_entry_val(lmt_node_fields_fence, 8, node_list_field, top);
+ set_value_entry_val(lmt_node_fields_fence, 9, node_list_field, bottom);
+
+ lmt_node_fields_fraction = lmt_aux_allocate_value_info(9);
+
+ set_value_entry_val(lmt_node_fields_fraction, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_fraction, 1, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_fraction, 2, node_list_field, numerator);
+ set_value_entry_val(lmt_node_fields_fraction, 3, node_list_field, denominator);
+ set_value_entry_val(lmt_node_fields_fraction, 4, node_list_field, left);
+ set_value_entry_val(lmt_node_fields_fraction, 5, node_list_field, right);
+ set_value_entry_val(lmt_node_fields_fraction, 6, node_list_field, middle);
+ set_value_entry_val(lmt_node_fields_fraction, 7, integer_field, fam);
+ set_value_entry_val(lmt_node_fields_fraction, 8, integer_field, options);
+
+ lmt_node_fields_glue = lmt_aux_allocate_value_info(8);
+
+ set_value_entry_val(lmt_node_fields_glue, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_glue, 1, node_list_field, leader);
+ set_value_entry_val(lmt_node_fields_glue, 2, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_glue, 3, dimension_field, stretch);
+ set_value_entry_val(lmt_node_fields_glue, 4, dimension_field, shrink);
+ set_value_entry_val(lmt_node_fields_glue, 5, integer_field, stretchorder);
+ set_value_entry_val(lmt_node_fields_glue, 6, integer_field, shrinkorder);
+ set_value_entry_val(lmt_node_fields_glue, 7, integer_field, font);
+
+ lmt_node_fields_glue_spec = lmt_aux_allocate_value_info(5);
+
+ set_value_entry_val(lmt_node_fields_glue_spec, 0, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_glue_spec, 1, dimension_field, stretch);
+ set_value_entry_val(lmt_node_fields_glue_spec, 2, dimension_field, shrink);
+ set_value_entry_val(lmt_node_fields_glue_spec, 3, integer_field, stretchorder);
+ set_value_entry_val(lmt_node_fields_glue_spec, 4, integer_field, shrinkorder);
+
+ lmt_node_fields_glyph = lmt_aux_allocate_value_info(27);
+
+ set_value_entry_val(lmt_node_fields_glyph, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_glyph, 1, integer_field, char);
+ set_value_entry_val(lmt_node_fields_glyph, 2, integer_field, font);
+ set_value_entry_val(lmt_node_fields_glyph, 3, integer_field, language);
+ set_value_entry_val(lmt_node_fields_glyph, 4, integer_field, lhmin);
+ set_value_entry_val(lmt_node_fields_glyph, 5, integer_field, rhmin);
+ set_value_entry_val(lmt_node_fields_glyph, 6, integer_field, uchyph);
+ set_value_entry_val(lmt_node_fields_glyph, 7, integer_field, state);
+ set_value_entry_val(lmt_node_fields_glyph, 8, dimension_field, left);
+ set_value_entry_val(lmt_node_fields_glyph, 9, dimension_field, right);
+ set_value_entry_val(lmt_node_fields_glyph, 10, dimension_field, xoffset);
+ set_value_entry_val(lmt_node_fields_glyph, 11, dimension_field, yoffset);
+ set_value_entry_val(lmt_node_fields_glyph, 12, dimension_field, xscale);
+ set_value_entry_val(lmt_node_fields_glyph, 13, dimension_field, yscale);
+ set_value_entry_val(lmt_node_fields_glyph, 14, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_glyph, 15, dimension_field, height);
+ set_value_entry_val(lmt_node_fields_glyph, 16, dimension_field, depth);
+ set_value_entry_val(lmt_node_fields_glyph, 17, dimension_field, total);
+ set_value_entry_val(lmt_node_fields_glyph, 18, integer_field, expansion);
+ set_value_entry_val(lmt_node_fields_glyph, 19, integer_field, data);
+ set_value_entry_val(lmt_node_fields_glyph, 20, integer_field, script);
+ set_value_entry_val(lmt_node_fields_glyph, 21, integer_field, hyphenate);
+ set_value_entry_val(lmt_node_fields_glyph, 22, integer_field, options);
+ set_value_entry_val(lmt_node_fields_glyph, 23, integer_field, protected);
+ set_value_entry_val(lmt_node_fields_glyph, 24, integer_field, properties);
+ set_value_entry_val(lmt_node_fields_glyph, 25, integer_field, group);
+ set_value_entry_val(lmt_node_fields_glyph, 26, integer_field, index);
+
+ lmt_node_fields_insert = lmt_aux_allocate_value_info(6);
+
+ set_value_entry_val(lmt_node_fields_insert, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_insert, 1, integer_field, cost);
+ set_value_entry_val(lmt_node_fields_insert, 2, dimension_field, depth);
+ set_value_entry_val(lmt_node_fields_insert, 3, dimension_field, height);
+ set_value_entry_val(lmt_node_fields_insert, 4, integer_field, spec);
+ set_value_entry_val(lmt_node_fields_insert, 5, node_list_field, list);
+
+ lmt_node_fields_split = lmt_aux_allocate_value_info(6);
+
+ set_value_entry_val(lmt_node_fields_split, 0, attribute_field, height);
+ set_value_entry_val(lmt_node_fields_split, 1, integer_field, index);
+ set_value_entry_val(lmt_node_fields_split, 2, node_field, lastinsert);
+ set_value_entry_val(lmt_node_fields_split, 3, node_field, bestinsert);
+ set_value_entry_val(lmt_node_fields_split, 4, integer_field, stretchorder);
+ set_value_entry_val(lmt_node_fields_split, 5, integer_field, shrinkorder);
+
+ lmt_node_fields_kern = lmt_aux_allocate_value_info(3);
+
+ set_value_entry_val(lmt_node_fields_kern, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_kern, 1, dimension_field, kern);
+ set_value_entry_val(lmt_node_fields_kern, 2, integer_field, expansion);
+
+ lmt_node_fields_list = lmt_aux_allocate_value_info(20);
+
+ set_value_entry_val(lmt_node_fields_list, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_list, 1, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_list, 2, dimension_field, depth);
+ set_value_entry_val(lmt_node_fields_list, 3, dimension_field, height);
+ set_value_entry_val(lmt_node_fields_list, 4, integer_field, direction);
+ set_value_entry_val(lmt_node_fields_list, 5, dimension_field, shift);
+ set_value_entry_val(lmt_node_fields_list, 6, integer_field, glueorder);
+ set_value_entry_val(lmt_node_fields_list, 7, integer_field, gluesign);
+ set_value_entry_val(lmt_node_fields_list, 8, integer_field, glueset);
+ set_value_entry_val(lmt_node_fields_list, 9, node_list_field, list);
+ set_value_entry_val(lmt_node_fields_list, 10, integer_field, orientation);
+ set_value_entry_val(lmt_node_fields_list, 11, integer_field, source);
+ set_value_entry_val(lmt_node_fields_list, 12, integer_field, target);
+ set_value_entry_val(lmt_node_fields_list, 13, dimension_field, woffset);
+ set_value_entry_val(lmt_node_fields_list, 14, dimension_field, hoffset);
+ set_value_entry_val(lmt_node_fields_list, 15, dimension_field, doffset);
+ set_value_entry_val(lmt_node_fields_list, 16, dimension_field, xoffset);
+ set_value_entry_val(lmt_node_fields_list, 17, dimension_field, yoffset);
+ set_value_entry_val(lmt_node_fields_list, 18, integer_field, state);
+ set_value_entry_val(lmt_node_fields_list, 19, integer_field, class);
+
+ lmt_node_fields_par = lmt_aux_allocate_value_info(9);
+ set_value_entry_val(lmt_node_fields_par, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_par, 1, integer_field, interlinepenalty);
+ set_value_entry_val(lmt_node_fields_par, 2, integer_field, brokenpenalty);
+ set_value_entry_val(lmt_node_fields_par, 3, integer_field, dir);
+ set_value_entry_val(lmt_node_fields_par, 4, node_field, leftbox);
+ set_value_entry_val(lmt_node_fields_par, 5, dimension_field, leftboxwidth);
+ set_value_entry_val(lmt_node_fields_par, 6, node_field, rightbox);
+ set_value_entry_val(lmt_node_fields_par, 7, dimension_field, rightboxwidth);
+ set_value_entry_val(lmt_node_fields_par, 8, node_field, middlebox);
+
+ lmt_node_fields_mark = lmt_aux_allocate_value_info(3);
+
+ set_value_entry_val(lmt_node_fields_mark, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_mark, 1, integer_field, class);
+ set_value_entry_val(lmt_node_fields_mark, 2, token_list_field, mark);
+
+ lmt_node_fields_math = lmt_aux_allocate_value_info(8);
+
+ set_value_entry_val(lmt_node_fields_math, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_math, 1, integer_field, surround);
+ set_value_entry_val(lmt_node_fields_math, 2, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_math, 3, dimension_field, stretch);
+ set_value_entry_val(lmt_node_fields_math, 4, dimension_field, shrink);
+ set_value_entry_val(lmt_node_fields_math, 5, integer_field, stretchorder);
+ set_value_entry_val(lmt_node_fields_math, 6, integer_field, shrinkorder);
+ set_value_entry_val(lmt_node_fields_math, 7, integer_field, penalty);
+
+ lmt_node_fields_math_char = lmt_aux_allocate_value_info(7);
+
+ set_value_entry_val(lmt_node_fields_math_char, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_math_char, 1, integer_field, fam);
+ set_value_entry_val(lmt_node_fields_math_char, 2, integer_field, char);
+ set_value_entry_val(lmt_node_fields_math_char, 3, integer_field, options);
+ set_value_entry_val(lmt_node_fields_math_char, 4, integer_field, properties);
+ set_value_entry_val(lmt_node_fields_math_char, 5, integer_field, group);
+ set_value_entry_val(lmt_node_fields_math_char, 6, integer_field, index);
+
+ lmt_node_fields_math_text_char = lmt_aux_allocate_value_info(4);
+
+ set_value_entry_val(lmt_node_fields_math_text_char, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_math_text_char, 1, integer_field, fam);
+ set_value_entry_val(lmt_node_fields_math_text_char, 2, integer_field, char);
+ set_value_entry_val(lmt_node_fields_math_text_char, 3, integer_field, options);
+
+ lmt_node_fields_noad = lmt_aux_allocate_value_info(8);
+
+ set_value_entry_val(lmt_node_fields_noad, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_noad, 1, node_list_field, nucleus);
+ set_value_entry_val(lmt_node_fields_noad, 2, node_list_field, sub);
+ set_value_entry_val(lmt_node_fields_noad, 3, node_list_field, sup);
+ set_value_entry_val(lmt_node_fields_noad, 4, node_list_field, subpre);
+ set_value_entry_val(lmt_node_fields_noad, 5, node_list_field, suppre);
+ set_value_entry_val(lmt_node_fields_noad, 6, node_list_field, prime);
+ set_value_entry_val(lmt_node_fields_noad, 7, integer_field, options);
+
+ lmt_node_fields_penalty = lmt_aux_allocate_value_info(2);
+
+ set_value_entry_val(lmt_node_fields_penalty, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_penalty, 1, integer_field, penalty);
+
+ lmt_node_fields_radical = lmt_aux_allocate_value_info(11);
+
+ set_value_entry_val(lmt_node_fields_radical, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_radical, 1, node_list_field, nucleus);
+ set_value_entry_val(lmt_node_fields_radical, 2, node_list_field, sub);
+ set_value_entry_val(lmt_node_fields_radical, 3, node_list_field, sup);
+ set_value_entry_val(lmt_node_fields_radical, 4, node_list_field, presub);
+ set_value_entry_val(lmt_node_fields_radical, 5, node_list_field, presup);
+ set_value_entry_val(lmt_node_fields_radical, 6, node_list_field, prime);
+ set_value_entry_val(lmt_node_fields_radical, 7, node_list_field, left);
+ set_value_entry_val(lmt_node_fields_radical, 8, node_list_field, degree);
+ set_value_entry_val(lmt_node_fields_radical, 9, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_radical, 10, integer_field, options);
+
+ lmt_node_fields_rule = lmt_aux_allocate_value_info(11);
+
+ set_value_entry_val(lmt_node_fields_rule, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_rule, 1, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_rule, 2, dimension_field, depth);
+ set_value_entry_val(lmt_node_fields_rule, 3, dimension_field, height);
+ set_value_entry_val(lmt_node_fields_rule, 4, dimension_field, xoffset);
+ set_value_entry_val(lmt_node_fields_rule, 5, dimension_field, yoffset);
+ set_value_entry_val(lmt_node_fields_rule, 6, dimension_field, left);
+ set_value_entry_val(lmt_node_fields_rule, 7, dimension_field, right);
+ set_value_entry_val(lmt_node_fields_rule, 8, integer_field, data);
+ set_value_entry_val(lmt_node_fields_rule, 9, integer_field, char);
+ set_value_entry_val(lmt_node_fields_rule, 10, integer_field, font);
+
+ lmt_node_fields_style = lmt_aux_allocate_value_info(2);
+
+ set_value_entry_val(lmt_node_fields_style, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_style, 1, integer_field, style);
+
+ lmt_node_fields_parameter = lmt_aux_allocate_value_info(4);
+
+ set_value_entry_val(lmt_node_fields_parameter, 0, integer_field, style);
+ set_value_entry_val(lmt_node_fields_parameter, 1, integer_field, name);
+ set_value_entry_val(lmt_node_fields_parameter, 2, integer_field, value);
+ set_value_entry_val(lmt_node_fields_parameter, 3, node_list_field, list);
+
+ lmt_node_fields_sub_box = lmt_aux_allocate_value_info(2);
+
+ set_value_entry_val(lmt_node_fields_sub_box, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_sub_box, 1, node_list_field, list);
+
+ lmt_node_fields_sub_mlist = lmt_aux_allocate_value_info(2);
+
+ set_value_entry_val(lmt_node_fields_sub_mlist, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_sub_mlist, 1, node_list_field, list);
+
+ lmt_node_fields_unset = lmt_aux_allocate_value_info(11);
+
+ set_value_entry_val(lmt_node_fields_unset, 0, attribute_field, attr);
+ set_value_entry_val(lmt_node_fields_unset, 1, dimension_field, width);
+ set_value_entry_val(lmt_node_fields_unset, 2, dimension_field, depth);
+ set_value_entry_val(lmt_node_fields_unset, 3, dimension_field, height);
+ set_value_entry_val(lmt_node_fields_unset, 4, integer_field, dir);
+ set_value_entry_val(lmt_node_fields_unset, 5, dimension_field, shrink);
+ set_value_entry_val(lmt_node_fields_unset, 6, integer_field, glueorder);
+ set_value_entry_val(lmt_node_fields_unset, 7, integer_field, gluesign);
+ set_value_entry_val(lmt_node_fields_unset, 8, dimension_field, stretch);
+ set_value_entry_val(lmt_node_fields_unset, 9, integer_field, span);
+ set_value_entry_val(lmt_node_fields_unset, 10, node_list_field, list);
+
+ lmt_node_fields_whatsit = lmt_aux_allocate_value_info(1);
+
+ set_value_entry_val(lmt_node_fields_whatsit, 0, attribute_field, attr);
+
+ lmt_interface.node_data = lmt_memory_malloc((passive_node + 2) * sizeof(node_info));
+
+ /*tex
+ We start with the nodes that users can encounter. The order is mostly the one that \TEX\
+ uses but we have move some around because we have some more and sometimes a bit different
+ kind of nodes. You should use abstractions anyway, so numbers mean nothing. In original
+ \TEX\ there are sometimes tests like |if (foo < kern_node)| but these have been replaces
+ by switches and (un)equality tests so that the order is not really important.
+
+ Subtypes in nodes and codes in commands sometimes are sort of in sync but don't rely on
+ that!
+ */
+
+ lmt_interface.node_data[hlist_node] = (node_info) { .id = hlist_node, .size = box_node_size, .first = 0, .last = last_list_subtype, .subtypes = subtypes_list, .fields = lmt_node_fields_list, .name = lua_key(hlist), .lua = lua_key_index(hlist), .visible = 1 };
+ lmt_interface.node_data[vlist_node] = (node_info) { .id = vlist_node, .size = box_node_size, .first = 0, .last = last_list_subtype, .subtypes = subtypes_list, .fields = lmt_node_fields_list, .name = lua_key(vlist), .lua = lua_key_index(vlist), .visible = 1 };
+ lmt_interface.node_data[rule_node] = (node_info) { .id = rule_node, .size = rule_node_size, .first = 0, .last = last_rule_subtype, .subtypes = subtypes_rule, .fields = lmt_node_fields_rule, .name = lua_key(rule), .lua = lua_key_index(rule), .visible = 1 };
+ lmt_interface.node_data[insert_node] = (node_info) { .id = insert_node, .size = insert_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_insert, .name = lua_key(insert), .lua = lua_key_index(insert), .visible = 1 };
+ lmt_interface.node_data[mark_node] = (node_info) { .id = mark_node, .size = mark_node_size, .first = 0, .last = last_mark_subtype, .subtypes = subtypes_mark, .fields = lmt_node_fields_mark, .name = lua_key(mark), .lua = lua_key_index(mark), .visible = 1 };
+ lmt_interface.node_data[adjust_node] = (node_info) { .id = adjust_node, .size = adjust_node_size, .first = 0, .last = last_adjust_subtype, .subtypes = subtypes_adjust, .fields = lmt_node_fields_adjust, .name = lua_key(adjust), .lua = lua_key_index(adjust), .visible = 1 };
+ lmt_interface.node_data[boundary_node] = (node_info) { .id = boundary_node, .size = boundary_node_size, .first = 0, .last = last_boundary_subtype, .subtypes = subtypes_boundary, .fields = lmt_node_fields_boundary, .name = lua_key(boundary), .lua = lua_key_index(boundary), .visible = 1 };
+ lmt_interface.node_data[disc_node] = (node_info) { .id = disc_node, .size = disc_node_size, .first = 0, .last = last_discretionary_subtype, .subtypes = subtypes_disc, .fields = lmt_node_fields_disc, .name = lua_key(disc), .lua = lua_key_index(disc), .visible = 1 };
+ lmt_interface.node_data[whatsit_node] = (node_info) { .id = whatsit_node, .size = whatsit_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_whatsit, .name = lua_key(whatsit), .lua = lua_key_index(whatsit), .visible = 1 };
+ lmt_interface.node_data[par_node] = (node_info) { .id = par_node, .size = par_node_size, .first = 0, .last = last_par_subtype, .subtypes = subtypes_par, .fields = lmt_node_fields_par, .name = lua_key(par), .lua = lua_key_index(par), .visible = 1 };
+ lmt_interface.node_data[dir_node] = (node_info) { .id = dir_node, .size = dir_node_size, .first = 0, .last = last_dir_subtype, .subtypes = subtypes_dir, .fields = lmt_node_fields_dir, .name = lua_key(dir), .lua = lua_key_index(dir), .visible = 1 };
+ lmt_interface.node_data[math_node] = (node_info) { .id = math_node, .size = math_node_size, .first = 0, .last = last_math_subtype, .subtypes = subtypes_math, .fields = lmt_node_fields_math, .name = lua_key(math), .lua = lua_key_index(math), .visible = 1 };
+ lmt_interface.node_data[glue_node] = (node_info) { .id = glue_node, .size = glue_node_size, .first = 0, .last = last_glue_subtype, .subtypes = subtypes_glue, .fields = lmt_node_fields_glue, .name = lua_key(glue), .lua = lua_key_index(glue), .visible = 1 };
+ lmt_interface.node_data[kern_node] = (node_info) { .id = kern_node, .size = kern_node_size, .first = 0, .last = last_kern_subtype, .subtypes = subtypes_kern, .fields = lmt_node_fields_kern, .name = lua_key(kern), .lua = lua_key_index(kern), .visible = 1 };
+ lmt_interface.node_data[penalty_node] = (node_info) { .id = penalty_node, .size = penalty_node_size, .first = 0, .last = last_penalty_subtype, .subtypes = subtypes_penalty, .fields = lmt_node_fields_penalty, .name = lua_key(penalty), .lua = lua_key_index(penalty), .visible = 1 };
+ lmt_interface.node_data[style_node] = (node_info) { .id = style_node, .size = style_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_style, .name = lua_key(style), .lua = lua_key_index(style), .visible = 1 };
+ lmt_interface.node_data[choice_node] = (node_info) { .id = choice_node, .size = choice_node_size, .first = 0, .last = last_choice_subtype, .subtypes = subtypes_choice, .fields = lmt_node_fields_choice, .name = lua_key(choice), .lua = lua_key_index(choice), .visible = 1 };
+ lmt_interface.node_data[parameter_node] = (node_info) { .id = parameter_node, .size = parameter_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_parameter, .name = lua_key(parameter), .lua = lua_key_index(parameter), .visible = 1 };
+ lmt_interface.node_data[simple_noad] = (node_info) { .id = simple_noad, .size = noad_size, .first = 0, .last = last_noad_subtype, .subtypes = subtypes_noad, .fields = lmt_node_fields_noad, .name = lua_key(noad), .lua = lua_key_index(noad), .visible = 1 };
+ lmt_interface.node_data[radical_noad] = (node_info) { .id = radical_noad, .size = radical_noad_size, .first = 0, .last = last_radical_subtype, .subtypes = subtypes_radical, .fields = lmt_node_fields_radical, .name = lua_key(radical), .lua = lua_key_index(radical), .visible = 1 };
+ lmt_interface.node_data[fraction_noad] = (node_info) { .id = fraction_noad, .size = fraction_noad_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_fraction, .name = lua_key(fraction), .lua = lua_key_index(fraction), .visible = 1 };
+ lmt_interface.node_data[accent_noad] = (node_info) { .id = accent_noad, .size = accent_noad_size, .first = 0, .last = last_accent_subtype, .subtypes = subtypes_accent, .fields = lmt_node_fields_accent, .name = lua_key(accent), .lua = lua_key_index(accent), .visible = 1 };
+ lmt_interface.node_data[fence_noad] = (node_info) { .id = fence_noad, .size = fence_noad_size, .first = 0, .last = last_fence_subtype, .subtypes = subtypes_fence, .fields = lmt_node_fields_fence, .name = lua_key(fence), .lua = lua_key_index(fence), .visible = 1 };
+ lmt_interface.node_data[math_char_node] = (node_info) { .id = math_char_node, .size = math_kernel_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_math_char, .name = lua_key(mathchar), .lua = lua_key_index(mathchar), .visible = 1 };
+ lmt_interface.node_data[math_text_char_node] = (node_info) { .id = math_text_char_node, .size = math_kernel_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_math_text_char, .name = lua_key(mathtextchar), .lua = lua_key_index(mathtextchar), .visible = 1 };
+ lmt_interface.node_data[sub_box_node] = (node_info) { .id = sub_box_node, .size = math_kernel_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_sub_box, .name = lua_key(subbox), .lua = lua_key_index(subbox), .visible = 1 };
+ lmt_interface.node_data[sub_mlist_node] = (node_info) { .id = sub_mlist_node, .size = math_kernel_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_sub_mlist, .name = lua_key(submlist), .lua = lua_key_index(submlist), .visible = 1 };
+ lmt_interface.node_data[delimiter_node] = (node_info) { .id = delimiter_node, .size = math_delimiter_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_delimiter, .name = lua_key(delimiter), .lua = lua_key_index(delimiter), .visible = 1 };
+ lmt_interface.node_data[glyph_node] = (node_info) { .id = glyph_node, .size = glyph_node_size, .first = 0, .last = last_glyph_subtype, .subtypes = subtypes_glyph, .fields = lmt_node_fields_glyph, .name = lua_key(glyph), .lua = lua_key_index(glyph), .visible = 1 };
+
+ /*tex
+ Who knows when someone needs is, so for now we keep it exposed.
+ */
+
+ lmt_interface.node_data[unset_node] = (node_info) { .id = unset_node, .size = box_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_unset, .name = lua_key(unset), .lua = lua_key_index(unset), .visible = 1 };
+ lmt_interface.node_data[specification_node] = (node_info) { .id = specification_node, .size = specification_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(specification), .lua = lua_key_index(specification), .visible = 0 };
+ lmt_interface.node_data[align_record_node] = (node_info) { .id = align_record_node, .size = box_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_unset, .name = lua_key(alignrecord), .lua = lua_key_index(alignrecord), .visible = 1 };
+
+ /*tex
+ These nodes never show up in nodelists and are managed special. Messing with such nodes
+ directly is not a good idea.
+ */
+
+ lmt_interface.node_data[attribute_node] = (node_info) { .id = attribute_node, .size = attribute_node_size, .first = 0, .last = last_attribute_subtype, .subtypes = subtypes_attribute,.fields = lmt_node_fields_attribute, .name = lua_key(attribute), .lua = lua_key_index(attribute), .visible = 1 };
+
+ /*
+ We still expose the glue spec as they are the containers for skip registers but there is no
+ real need to use them at the user end.
+ */
+
+ lmt_interface.node_data[glue_spec_node] = (node_info) { .id = glue_spec_node, .size = glue_spec_size, .first = 0, .last = 0, .subtypes = NULL, .fields = lmt_node_fields_glue_spec, .name = lua_key(gluespec), .lua = lua_key_index(gluespec), .visible = 1 };
+
+ /*tex
+ This one sometimes shows up, especially when we temporarily need an alternative head pointer,
+ simply because we want to retain some head in case the original head is replaced.
+ */
+
+ lmt_interface.node_data[temp_node] = (node_info) { .id = temp_node, .size = temp_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(temp), .lua = lua_key_index(temp), .visible = 1 };
+
+ /*tex
+ The split nodes are used for insertions.
+ */
+
+ lmt_interface.node_data[split_node] = (node_info) { .id = split_node, .size = split_node_size, .first = 0, .last = last_split_subtype, .subtypes = subtypes_split, .fields = lmt_node_fields_split, .name = lua_key(split), .lua = lua_key_index(split), .visible = 1 };
+
+ /*tex
+ The following nodes are not meant for users. They are used internally for different purposes
+ and you should not encounter them in node lists. As with many nodes, they often are
+ allocated using fast methods so they never show up in the new, copy and flush handlers.
+ */
+
+ lmt_interface.node_data[expression_node] = (node_info) { .id = expression_node, .size = expression_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(expression), .lua = lua_key_index(expression), .visible = 0 };
+ lmt_interface.node_data[math_spec_node] = (node_info) { .id = math_spec_node, .size = math_spec_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(mathspec), .lua = lua_key_index(mathspec), .visible = 0 };
+ lmt_interface.node_data[font_spec_node] = (node_info) { .id = font_spec_node, .size = font_spec_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(fontspec), .lua = lua_key_index(fontspec), .visible = 0 };
+ lmt_interface.node_data[nesting_node] = (node_info) { .id = nesting_node, .size = nesting_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(nestedlist), .lua = lua_key_index(nestedlist), .visible = 0 };
+ lmt_interface.node_data[span_node] = (node_info) { .id = span_node, .size = span_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(span), .lua = lua_key_index(span), .visible = 0 };
+ lmt_interface.node_data[align_stack_node] = (node_info) { .id = align_stack_node, .size = align_stack_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(alignstack), .lua = lua_key_index(alignstack), .visible = 0 };
+ lmt_interface.node_data[noad_state_node] = (node_info) { .id = noad_state_node, .size = noad_state_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(noadstate), .lua = lua_key_index(noadstate), .visible = 0 };
+ lmt_interface.node_data[if_node] = (node_info) { .id = if_node, .size = if_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(ifstack), .lua = lua_key_index(ifstack), .visible = 0 };
+ lmt_interface.node_data[unhyphenated_node] = (node_info) { .id = unhyphenated_node, .size = active_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(unhyphenated), .lua = lua_key_index(unhyphenated), .visible = 0 };
+ lmt_interface.node_data[hyphenated_node] = (node_info) { .id = hyphenated_node, .size = active_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(hyphenated), .lua = lua_key_index(hyphenated), .visible = 0 };
+ lmt_interface.node_data[delta_node] = (node_info) { .id = delta_node, .size = delta_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(delta), .lua = lua_key_index(delta), .visible = 0 };
+ lmt_interface.node_data[passive_node] = (node_info) { .id = passive_node, .size = passive_node_size, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = lua_key(passive), .lua = lua_key_index(passive), .visible = 0 };
+ lmt_interface.node_data[passive_node + 1] = (node_info) { .id = -1, .size = -1, .first = 0, .last = 0, .subtypes = NULL, .fields = NULL, .name = NULL, .lua = 0, .visible = 0 };
+
+}
+
+/*tex
+
+ 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:
+
+ \startitemize
+
+ \startitem
+ 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.
+ \stopitem
+
+ \startitem
+ 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.
+ \stopitem
+
+ \stopitemize
+
+ 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.
+
+ We keep track of nesting so that we don't overflow the stack, and, what is more important,
+ don't keep resolving the registry index.
+
+ We could add an index field to each node and use that one. But then we'd have to default to
+ false. It actually would look nicer in tracing: indices instead of pseudo memory slots. It
+ would not boost performance. A table like this is never really collected.
+
+*/
+
+inline static void lmt_properties_push(lua_State * L)
+{
+ lmt_node_memory_state.lua_properties_level++ ;
+ if (lmt_node_memory_state.lua_properties_level == 1) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ }
+}
+
+inline static void lmt_properties_pop(lua_State * L)
+{
+ if (lmt_node_memory_state.lua_properties_level == 1) {
+ lua_pop(L, 1);
+ }
+ lmt_node_memory_state.lua_properties_level-- ;
+}
+
+/*tex Resetting boils down to nilling. */
+
+inline static void lmt_properties_reset(lua_State * L, halfword target)
+{
+ if (lmt_node_memory_state.lua_properties_level == 0) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ lua_pushnil(L);
+ lua_rawseti(L, -2, target);
+ lua_pop(L, 1);
+ } else {
+ lua_pushnil(L);
+ lua_rawseti(L, -2, target);
+ }
+}
+
+inline static void lmt_properties_copy(lua_State *L, halfword target, halfword source)
+{
+ if (lmt_node_memory_state.lua_properties_level == 0) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id);
+ }
+ /* properties */
+ if (lua_rawgeti(L, -1, source) == LUA_TTABLE) {
+ /* properties source */
+ lua_createtable(L, 0, 1);
+ /* properties source {} */
+ lua_insert(L, -2);
+ /* properties {} source */
+ lua_push_key(__index);
+ /* properties {} source "__index" */
+ lua_insert(L, -2);
+ /* properties {} "__index" source */
+ lua_rawset(L, -3);
+ /* properties {__index=source} */
+ lua_createtable(L, 0, 1);
+ /* properties {__index=source} {} */
+ lua_insert(L, -2);
+ /* properties {} {__index=source} */
+ lua_setmetatable(L, -2);
+ /* properties {}->{__index=source} */
+ lua_rawseti(L, -2, target);
+ /* properties[target]={}->{__index=source} */
+ } else {
+ /* properties nil */
+ lua_pop(L, 1);
+ }
+ /* properties */
+ if (lmt_node_memory_state.lua_properties_level == 0) {
+ lua_pop(L, 1);
+ }
+}
+
+/*tex The public one: */
+
+void tex_reset_node_properties(halfword b)
+{
+ if (b) {
+ lmt_properties_reset(lmt_lua_state.lua_instance, b);
+ }
+}
+
+/*tex Here end the property handlers. */
+
+static void tex_aux_node_range_test(halfword a, halfword b)
+{
+ if (b < 0 || b >= lmt_node_memory_state.nodes_data.allocated) {
+ tex_formatted_error("nodes", "node range test failed in %s node", lmt_interface.node_data[node_type(a)].name);
+ }
+}
+
+/*tex
+
+ Because of the 5-10\% overhead that \SYNTEX\ creates some options have been implemented
+ controlled by |synctex_anyway_mode|.
+
+ \startabulate
+ \NC \type {1} \NC all but glyphs \NC \NR
+ \NC \type {2} \NC also glyphs \NC \NR
+ \NC \type {3} \NC glyphs and glue \NC \NR
+ \NC \type {4} \NC only glyphs \NC \NR
+ \stoptabulate
+
+*/
+
+/*tex |if_stack| is called a lot so maybe optimize that one. */
+
+/*tex This needs a cleanup ... there is no need to store the pointer location itself. */
+
+inline static void tex_aux_preset_disc_node(halfword n)
+{
+ disc_pre_break(n) = disc_pre_break_node(n);
+ disc_post_break(n) = disc_post_break_node(n);
+ disc_no_break(n) = disc_no_break_node(n);
+ node_type(disc_pre_break(n)) = nesting_node;
+ node_type(disc_post_break(n)) = nesting_node;
+ node_type(disc_no_break(n)) = nesting_node;
+ node_subtype(disc_pre_break(n)) = pre_break_code;
+ node_subtype(disc_post_break(n)) = post_break_code;
+ node_subtype(disc_no_break(n)) = no_break_code;
+}
+
+inline static void tex_aux_preset_node(halfword n, quarterword t)
+{
+ switch (t) {
+ case glyph_node:
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_dir(n) = direction_unknown;
+ break;
+ case disc_node:
+ tex_aux_preset_disc_node(n);
+ break;
+ case rule_node:
+ rule_width(n) = null_flag;
+ rule_depth(n) = null_flag;
+ rule_height(n) = null_flag;
+ rule_data(n) = 0;
+ break;
+ case unset_node:
+ box_width(n) = null_flag;
+ break;
+ case specification_node:
+ tex_null_specification_list(n);
+ break;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ case fence_noad:
+ noad_family(n) = unused_math_family;
+ noad_style(n) = unused_math_style;
+ reset_noad_classes(n); /* unsets them */
+ break;
+ }
+}
+
+halfword tex_new_node(quarterword i, quarterword j)
+{
+ halfword s = get_node_size(i);
+ halfword n = tex_get_node(s);
+
+ /*tex
+
+ Both type() and subtype() will be set below, and node_next() is set to null by |get_node()|,
+ so we can clear one word less than |s|.
+
+ */
+
+ memset((void *) (lmt_node_memory_state.nodes + n + 1), 0, (sizeof(memoryword) * ((size_t) s - 1)));
+
+ if (tex_nodetype_is_complex(i)) {
+ tex_aux_preset_node(n, i);
+ if (input_file_state.mode > 0) {
+ /*tex See table above. */
+ switch (i) {
+ case glyph_node:
+ if (input_file_state.mode > 1) {
+ glyph_input_file(n) = input_file_value();
+ glyph_input_line(n) = input_line_value();
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ box_input_file(n) = input_file_value();
+ box_input_line(n) = input_line_value();
+ break;
+ }
+ }
+ if (tex_nodetype_has_attributes(i)) {
+ attach_current_attribute_list(n);
+ }
+ }
+ /* last */
+ node_type(n) = i;
+ node_subtype(n) = j;
+ return n;
+}
+
+halfword tex_new_temp_node(void)
+{
+ halfword n = tex_get_node(temp_node_size);
+ node_type(n) = temp_node;
+ node_subtype(n) = 0;
+ memset((void *) (lmt_node_memory_state.nodes + n + 1), 0, (sizeof(memoryword) * (temp_node_size - 1)));
+ return n;
+}
+
+static halfword tex_aux_new_glyph_node_with_attributes(halfword parent)
+{
+ halfword n = tex_get_node(glyph_node_size);
+ memset((void *) (lmt_node_memory_state.nodes + n + 1), 0, (sizeof(memoryword) * (glyph_node_size - 1)));
+ if (input_file_state.mode > 1) {
+ glyph_input_file(n) = input_file_value();
+ glyph_input_line(n) = input_line_value();
+ }
+ node_type(n) = glyph_node;
+ node_subtype(n) = glyph_unset_subtype;
+ if (parent) {
+ tex_attach_attribute_list_copy(n, parent);
+ } else {
+ attach_current_attribute_list(n);
+ }
+ return n;
+}
+
+/*tex
+ This makes a duplicate of the node list that starts at |p| and returns a pointer to the new
+ list.
+*/
+
+halfword tex_copy_node_list(halfword p, halfword end)
+{
+ /*tex head of the list */
+ halfword h = null;
+ /*tex previous position in new list */
+ halfword q = null;
+ /*tex saves stack and time */
+ lua_State *L = lmt_lua_state.lua_instance;
+ lmt_properties_push(L);
+ while (p != end) {
+ halfword s = tex_copy_node(p);
+ if (h) {
+ tex_couple_nodes(q, s);
+ } else {
+ h = s;
+ }
+ q = s;
+ p = node_next(p);
+ }
+ /*tex saves stack and time */
+ lmt_properties_pop(L);
+ return h;
+}
+
+/*tex Make a dupe of a single node. */
+
+halfword tex_copy_node_only(halfword p)
+{
+ quarterword t = node_type(p);
+ int s = get_node_size(t);
+ halfword r = tex_get_node(s);
+ memcpy((void *) (lmt_node_memory_state.nodes + r), (void *) (lmt_node_memory_state.nodes + p), (sizeof(memoryword) ));
+ memset((void *) (lmt_node_memory_state.nodes + r + 1), 0, (sizeof(memoryword) * ((unsigned) s - 1)));
+ tex_aux_preset_node(r, t);
+ return r;
+}
+
+/*tex
+ We really need to use macros here as we need the temporary variable because varmem can be
+ reallocated! We cross our fingers that the compiler doesn't optimize that one away. (The test
+ suite had a few cases where reallocation during a copy happens.) We can make |copy_stub|
+ local here.
+ */
+
+# define copy_sub_list(target,source) do { \
+ if (source) { \
+ halfword copy_stub = tex_copy_node_list(source, null); \
+ target = copy_stub; \
+ } else { \
+ target = null; \
+ } \
+ } while (0)
+
+# define copy_sub_node(target,source) do { \
+ if (source) { \
+ halfword copy_stub = tex_copy_node(source); \
+ target = copy_stub ; \
+ } else { \
+ target = null; \
+ } \
+} while (0)
+
+halfword tex_copy_node(halfword p)
+{
+ /*tex
+ We really need a stub for copying because mem might move in the meantime due to resizing!
+ */
+ if (p < 0 || p >= lmt_node_memory_state.nodes_data.allocated) {
+ return tex_formatted_error("nodes", "attempt to copy an impossible node %d", (int) p);
+ } else if (p > lmt_node_memory_state.reserved && lmt_node_memory_state.nodesizes[p] == 0) {
+ return tex_formatted_error("nodes", "attempt to copy a free %s node %d", get_node_name(node_type(p)), (int) p);
+ } else {
+ /*tex type of node */
+ halfword t = node_type(p);
+ int i = get_node_size(t);
+ /*tex current node being fabricated for new list */
+ halfword r = tex_get_node(i);
+ /*tex this saves work */
+ memcpy((void *) (lmt_node_memory_state.nodes + r), (void *) (lmt_node_memory_state.nodes + p), (sizeof(memoryword) * (unsigned) i));
+ if (tex_nodetype_is_complex(i)) {
+ // halfword copy_stub;
+ if (tex_nodetype_has_attributes(t)) {
+ add_attribute_reference(node_attr(p));
+ node_prev(r) = null;
+ lmt_properties_copy(lmt_lua_state.lua_instance, r, p);
+ }
+ node_next(r) = null;
+ switch (t) {
+ case glue_node:
+ copy_sub_list(glue_leader_ptr(r), glue_leader_ptr(p));
+ break;
+ case hlist_node:
+ copy_sub_list(box_pre_adjusted(r), box_pre_adjusted(p));
+ copy_sub_list(box_post_adjusted(r), box_post_adjusted(p));
+ // fall through
+ case vlist_node:
+ copy_sub_list(box_pre_migrated(r), box_pre_migrated(p));
+ copy_sub_list(box_post_migrated(r), box_post_migrated(p));
+ // fall through
+ case unset_node:
+ copy_sub_list(box_list(r), box_list(p));
+ break;
+ case disc_node:
+ disc_pre_break(r) = disc_pre_break_node(r);
+ if (disc_pre_break_head(p)) {
+ tex_set_disc_field(r, pre_break_code, tex_copy_node_list(disc_pre_break_head(p), null));
+ } else {
+ tex_set_disc_field(r, pre_break_code, null);
+ }
+ disc_post_break(r) = disc_post_break_node(r);
+ if (disc_post_break_head(p)) {
+ tex_set_disc_field(r, post_break_code, tex_copy_node_list(disc_post_break_head(p), null));
+ } else {
+ tex_set_disc_field(r, post_break_code, null);
+ }
+ disc_no_break(r) = disc_no_break_node(r);
+ if (disc_no_break_head(p)) {
+ tex_set_disc_field(r, no_break_code, tex_copy_node_list(disc_no_break_head(p), null));
+ } else {
+ tex_set_disc_field(r, no_break_code, null);
+ }
+ break;
+ case insert_node:
+ copy_sub_list(insert_list(r), insert_list(p)) ;
+ break;
+ case mark_node:
+ tex_add_token_reference(mark_ptr(p));
+ break;
+ case adjust_node:
+ copy_sub_list(adjust_list(r), adjust_list(p));
+ break;
+ case choice_node:
+ copy_sub_list(choice_display_mlist(r), choice_display_mlist(p)) ;
+ copy_sub_list(choice_text_mlist(r), choice_text_mlist(p)) ;
+ copy_sub_list(choice_script_mlist(r), choice_script_mlist(p)) ;
+ copy_sub_list(choice_script_script_mlist(r), choice_script_script_mlist(p)) ;
+ break;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ copy_sub_list(noad_nucleus(r), noad_nucleus(p)) ;
+ copy_sub_list(noad_subscr(r), noad_subscr(p)) ;
+ copy_sub_list(noad_supscr(r), noad_supscr(p)) ;
+ copy_sub_list(noad_subprescr(r), noad_subprescr(p)) ;
+ copy_sub_list(noad_supprescr(r), noad_supprescr(p)) ;
+ copy_sub_list(noad_prime(r), noad_prime(p)) ;
+ copy_sub_list(noad_state(r), noad_state(p)) ;
+ switch (t) {
+ case radical_noad:
+ copy_sub_node(radical_left_delimiter(r), radical_left_delimiter(p)) ;
+ copy_sub_node(radical_right_delimiter(r), radical_right_delimiter(p)) ;
+ copy_sub_list(radical_degree(r), radical_degree(p)) ;
+ break;
+ case fraction_noad:
+ // copy_sub_list(fraction_numerator(r), fraction_numerator(p)) ;
+ // copy_sub_list(fraction_denominator(r), fraction_denominator(p)) ;
+ copy_sub_node(fraction_left_delimiter(r), fraction_left_delimiter(p)) ;
+ copy_sub_node(fraction_right_delimiter(r), fraction_right_delimiter(p)) ;
+ copy_sub_node(fraction_middle_delimiter(r), fraction_middle_delimiter(p)) ;
+ break;
+ case accent_noad:
+ copy_sub_list(accent_top_character(r), accent_top_character(p)) ;
+ copy_sub_list(accent_bottom_character(r), accent_bottom_character(p)) ;
+ copy_sub_list(accent_middle_character(r), accent_middle_character(p)) ;
+ break;
+ }
+ break;
+ case fence_noad:
+ /* in principle also scripts */
+ copy_sub_node(fence_delimiter_list(r), fence_delimiter_list(p)) ;
+ copy_sub_node(fence_delimiter_top(r), fence_delimiter_top(p)) ;
+ copy_sub_node(fence_delimiter_bottom(r), fence_delimiter_bottom(p)) ;
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ copy_sub_list(kernel_math_list(r), kernel_math_list(p)) ;
+ break;
+ case par_node:
+ /* can also be copy_sub_node */
+ copy_sub_list(par_box_left(r), par_box_left(p));
+ copy_sub_list(par_box_right(r), par_box_right(p));
+ copy_sub_list(par_box_middle(r), par_box_middle(p));
+ /* wipe copied fields */
+ par_left_skip(r) = null;
+ par_right_skip(r) = null;
+ par_par_fill_left_skip(r) = null;
+ par_par_fill_right_skip(r) = null;
+ par_par_init_left_skip(r) = null;
+ par_par_init_right_skip(r) = null;
+ par_baseline_skip(r) = null;
+ par_line_skip(r) = null;
+ par_par_shape(r) = null;
+ par_inter_line_penalties(r) = null;
+ par_club_penalties(r) = null;
+ par_widow_penalties(r) = null;
+ par_display_widow_penalties(r) = null;
+ par_orphan_penalties(r) = null;
+ /* really copy fields */
+ tex_set_par_par(r, par_left_skip_code, tex_get_par_par(p, par_left_skip_code), 1);
+ tex_set_par_par(r, par_right_skip_code, tex_get_par_par(p, par_right_skip_code), 1);
+ tex_set_par_par(r, par_par_fill_left_skip_code, tex_get_par_par(p, par_par_fill_left_skip_code), 1);
+ tex_set_par_par(r, par_par_fill_right_skip_code, tex_get_par_par(p, par_par_fill_right_skip_code), 1);
+ tex_set_par_par(r, par_par_init_left_skip_code, tex_get_par_par(p, par_par_init_left_skip_code), 1);
+ tex_set_par_par(r, par_par_init_right_skip_code, tex_get_par_par(p, par_par_init_right_skip_code), 1);
+ tex_set_par_par(r, par_baseline_skip_code, tex_get_par_par(p, par_baseline_skip_code), 1);
+ tex_set_par_par(r, par_line_skip_code, tex_get_par_par(p, par_line_skip_code), 1);
+ tex_set_par_par(r, par_par_shape_code, tex_get_par_par(p, par_par_shape_code), 1);
+ tex_set_par_par(r, par_inter_line_penalties_code, tex_get_par_par(p, par_inter_line_penalties_code), 1);
+ tex_set_par_par(r, par_club_penalties_code, tex_get_par_par(p, par_club_penalties_code), 1);
+ tex_set_par_par(r, par_widow_penalties_code, tex_get_par_par(p, par_widow_penalties_code), 1);
+ tex_set_par_par(r, par_display_widow_penalties_code, tex_get_par_par(p, par_display_widow_penalties_code), 1);
+ tex_set_par_par(r, par_orphan_penalties_code, tex_get_par_par(p, par_orphan_penalties_code), 1);
+ /* tokens, we could mess with a ref count instead */
+ par_end_par_tokens(r) = par_end_par_tokens(p);
+ tex_add_token_reference(par_end_par_tokens(p));
+ break;
+ case specification_node:
+ tex_copy_specification_list(r, p);
+ break;
+ default:
+ break;
+ }
+ }
+ return r;
+ }
+}
+
+inline static void tex_aux_free_sub_node_list(halfword source)
+{
+ if (source) {
+ tex_flush_node_list(source);
+ }
+}
+
+inline static void tex_aux_free_sub_node(halfword source)
+{
+ if (source) {
+ tex_flush_node(source);
+ }
+}
+
+/* We don't need the checking for attributes if we make these lists frozen. */
+
+void tex_flush_node(halfword p)
+{
+ if (! p) {
+ /*tex legal, but no-op. */
+ return;
+ } else if (p <= lmt_node_memory_state.reserved || p >= lmt_node_memory_state.nodes_data.allocated) {
+ tex_formatted_error("nodes", "attempt to free an impossible node %d of type %d", (int) p, node_type(p));
+ } else if (lmt_node_memory_state.nodesizes[p] == 0) {
+ for (int i = (lmt_node_memory_state.reserved + 1); i < lmt_node_memory_state.nodes_data.allocated; i++) {
+ if (lmt_node_memory_state.nodesizes[i] > 0) {
+ tex_aux_check_node(i);
+ }
+ }
+ tex_formatted_error("nodes", "attempt to double-free %s node %d, ignored", get_node_name(node_type(p)), (int) p);
+ } else {
+ int t = node_type(p);
+ if (tex_nodetype_is_complex(t)) {
+ switch (t) {
+ case glue_node:
+ tex_aux_free_sub_node_list(glue_leader_ptr(p));
+ break;
+ case hlist_node:
+ tex_aux_free_sub_node_list(box_pre_adjusted(p));
+ tex_aux_free_sub_node_list(box_post_adjusted(p));
+ // fall through
+ case vlist_node:
+ tex_aux_free_sub_node_list(box_pre_migrated(p));
+ tex_aux_free_sub_node_list(box_post_migrated(p));
+ // fall through
+ case unset_node:
+ tex_aux_free_sub_node_list(box_list(p));
+ break;
+ case disc_node:
+ /*tex Watch the start at temp node hack! */
+ tex_aux_free_sub_node_list(disc_pre_break_head(p));
+ tex_aux_free_sub_node_list(disc_post_break_head(p));
+ tex_aux_free_sub_node_list(disc_no_break_head(p));
+ break;
+ case par_node:
+ tex_aux_free_sub_node_list(par_box_left(p));
+ tex_aux_free_sub_node_list(par_box_right(p));
+ tex_aux_free_sub_node_list(par_box_middle(p));
+ /* we could check for the flag */
+ tex_flush_node(par_left_skip(p));
+ tex_flush_node(par_right_skip(p));
+ tex_flush_node(par_par_fill_left_skip(p));
+ tex_flush_node(par_par_fill_right_skip(p));
+ tex_flush_node(par_par_init_left_skip(p));
+ tex_flush_node(par_par_init_right_skip(p));
+ tex_flush_node(par_baseline_skip(p));
+ tex_flush_node(par_line_skip(p));
+ tex_flush_node(par_par_shape(p));
+ tex_flush_node(par_club_penalties(p));
+ tex_flush_node(par_inter_line_penalties(p));
+ tex_flush_node(par_widow_penalties(p));
+ tex_flush_node(par_display_widow_penalties(p));
+ tex_flush_node(par_orphan_penalties(p));
+ /* tokens */
+ tex_flush_token_list(par_end_par_tokens(p));
+ break;
+ case insert_node:
+ tex_flush_node_list(insert_list(p));
+ break;
+ case mark_node:
+ tex_delete_token_reference(mark_ptr(p));
+ break;
+ case adjust_node:
+ tex_flush_node_list(adjust_list(p));
+ break;
+ case choice_node:
+ tex_aux_free_sub_node_list(choice_display_mlist(p));
+ tex_aux_free_sub_node_list(choice_text_mlist(p));
+ tex_aux_free_sub_node_list(choice_script_mlist(p));
+ tex_aux_free_sub_node_list(choice_script_script_mlist(p));
+ break;
+ case simple_noad:
+ case fraction_noad:
+ case radical_noad:
+ case accent_noad:
+ tex_aux_free_sub_node_list(noad_nucleus(p));
+ tex_aux_free_sub_node_list(noad_subscr(p));
+ tex_aux_free_sub_node_list(noad_supscr(p));
+ tex_aux_free_sub_node_list(noad_subprescr(p));
+ tex_aux_free_sub_node_list(noad_supprescr(p));
+ tex_aux_free_sub_node_list(noad_prime(p));
+ tex_aux_free_sub_node_list(noad_state(p));
+ switch (t) {
+ case fraction_noad:
+ // tex_aux_free_sub_node_list(fraction_numerator(p));
+ // tex_aux_free_sub_node_list(fraction_denominator(p));
+ tex_aux_free_sub_node(fraction_left_delimiter(p));
+ tex_aux_free_sub_node(fraction_right_delimiter(p));
+ tex_aux_free_sub_node(fraction_middle_delimiter(p));
+ break;
+ case radical_noad:
+ tex_aux_free_sub_node(radical_left_delimiter(p));
+ tex_aux_free_sub_node(radical_right_delimiter(p));
+ tex_aux_free_sub_node_list(radical_degree(p));
+ break;
+ case accent_noad:
+ tex_aux_free_sub_node_list(accent_top_character(p));
+ tex_aux_free_sub_node_list(accent_bottom_character(p));
+ tex_aux_free_sub_node_list(accent_middle_character(p));
+ break;
+ }
+ break;
+ case fence_noad:
+ tex_aux_free_sub_node_list(fence_delimiter_list(p));
+ tex_aux_free_sub_node_list(fence_delimiter_top(p));
+ tex_aux_free_sub_node_list(fence_delimiter_bottom(p));
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ tex_aux_free_sub_node_list(kernel_math_list(p));
+ break;
+ case specification_node:
+ tex_dispose_specification_list(p);
+ break;
+ default:
+ break;
+ }
+ if (tex_nodetype_has_attributes(t)) {
+ delete_attribute_reference(node_attr(p));
+ node_attr(p) = null; /* when we debug */
+ lmt_properties_reset(lmt_lua_state.lua_instance, p);
+ }
+ }
+ tex_free_node(p, get_node_size(t));
+ }
+}
+
+/*tex Erase the list of nodes starting at |pp|. */
+
+void tex_flush_node_list(halfword l)
+{
+ if (! l) {
+ /*tex Legal, but no-op. */
+ return;
+ } else if (l <= lmt_node_memory_state.reserved || l >= lmt_node_memory_state.nodes_data.allocated) {
+ tex_formatted_error("nodes", "attempt to free an impossible node list %d of type %d", (int) l, node_type(l));
+ } else if (lmt_node_memory_state.nodesizes[l] == 0) {
+ for (int i = (lmt_node_memory_state.reserved + 1); i < lmt_node_memory_state.nodes_data.allocated; i++) {
+ if (lmt_node_memory_state.nodesizes[i] > 0) {
+ tex_aux_check_node(i);
+ }
+ }
+ tex_formatted_error("nodes", "attempt to double-free %s node %d, ignored", get_node_name(node_type(l)), (int) l);
+ } else {
+ /*tex Saves stack and time. */
+ lua_State *L = lmt_lua_state.lua_instance;
+ lmt_properties_push(L);
+ while (l) {
+ halfword nxt = node_next(l);
+ tex_flush_node(l);
+ l = nxt;
+ }
+ /*tex Saves stack and time. */
+ lmt_properties_pop(L);
+ }
+}
+
+static void tex_aux_check_node(halfword p)
+{
+ halfword t = node_type(p);
+ switch (t) {
+ case glue_node:
+ tex_aux_node_range_test(p, glue_leader_ptr(p));
+ break;
+ case hlist_node:
+ tex_aux_node_range_test(p, box_pre_adjusted(p));
+ tex_aux_node_range_test(p, box_post_adjusted(p));
+ // fall through
+ case vlist_node:
+ tex_aux_node_range_test(p, box_pre_migrated(p));
+ tex_aux_node_range_test(p, box_post_migrated(p));
+ // fall through
+ case unset_node:
+ case align_record_node:
+ tex_aux_node_range_test(p, box_list(p));
+ break;
+ case insert_node:
+ tex_aux_node_range_test(p, insert_list(p));
+ break;
+ case disc_node:
+ tex_aux_node_range_test(p, disc_pre_break_head(p));
+ tex_aux_node_range_test(p, disc_post_break_head(p));
+ tex_aux_node_range_test(p, disc_no_break_head(p));
+ break;
+ case adjust_node:
+ tex_aux_node_range_test(p, adjust_list(p));
+ break;
+ case choice_node:
+ tex_aux_node_range_test(p, choice_display_mlist(p));
+ tex_aux_node_range_test(p, choice_text_mlist(p));
+ tex_aux_node_range_test(p, choice_script_mlist(p));
+ tex_aux_node_range_test(p, choice_script_script_mlist(p));
+ break;
+ case simple_noad:
+ case radical_noad:
+ case fraction_noad:
+ case accent_noad:
+ tex_aux_node_range_test(p, noad_nucleus(p));
+ tex_aux_node_range_test(p, noad_subscr(p));
+ tex_aux_node_range_test(p, noad_supscr(p));
+ tex_aux_node_range_test(p, noad_subprescr(p));
+ tex_aux_node_range_test(p, noad_supprescr(p));
+ tex_aux_node_range_test(p, noad_prime(p));
+ tex_aux_node_range_test(p, noad_state(p));
+ switch (t) {
+ case radical_noad:
+ tex_aux_node_range_test(p, radical_degree(p));
+ tex_aux_node_range_test(p, radical_left_delimiter(p));
+ tex_aux_node_range_test(p, radical_right_delimiter(p));
+ break;
+ case fraction_noad:
+ // tex_aux_node_range_test(p, fraction_numerator(p));
+ // tex_aux_node_range_test(p, fraction_denominator(p));
+ tex_aux_node_range_test(p, fraction_left_delimiter(p));
+ tex_aux_node_range_test(p, fraction_right_delimiter(p));
+ tex_aux_node_range_test(p, fraction_middle_delimiter(p));
+ break;
+ case accent_noad:
+ tex_aux_node_range_test(p, accent_top_character(p));
+ tex_aux_node_range_test(p, accent_bottom_character(p));
+ tex_aux_node_range_test(p, accent_middle_character(p));
+ break;
+ }
+ break;
+ case fence_noad:
+ tex_aux_node_range_test(p, fence_delimiter_list(p));
+ tex_aux_node_range_test(p, fence_delimiter_top(p));
+ tex_aux_node_range_test(p, fence_delimiter_bottom(p));
+ break;
+ case par_node:
+ tex_aux_node_range_test(p, par_box_left(p));
+ tex_aux_node_range_test(p, par_box_right(p));
+ tex_aux_node_range_test(p, par_box_middle(p));
+ tex_aux_node_range_test(p, par_left_skip(p));
+ tex_aux_node_range_test(p, par_right_skip(p));
+ tex_aux_node_range_test(p, par_baseline_skip(p));
+ tex_aux_node_range_test(p, par_line_skip(p));
+ tex_aux_node_range_test(p, par_par_shape(p));
+ tex_aux_node_range_test(p, par_club_penalties(p));
+ tex_aux_node_range_test(p, par_inter_line_penalties(p));
+ tex_aux_node_range_test(p, par_widow_penalties(p));
+ tex_aux_node_range_test(p, par_display_widow_penalties(p));
+ tex_aux_node_range_test(p, par_orphan_penalties(p));
+ tex_aux_node_range_test(p, par_par_fill_left_skip(p));
+ tex_aux_node_range_test(p, par_par_fill_right_skip(p));
+ tex_aux_node_range_test(p, par_par_init_left_skip(p));
+ tex_aux_node_range_test(p, par_par_init_right_skip(p));
+ break;
+ default:
+ break;
+ }
+}
+
+/*
+halfword fix_node_list(halfword head)
+{
+ if (head) {
+ halfword tail = head;
+ halfword next = node_next(head);
+ while (next) {
+ node_prev(next) = tail;
+ tail = next;
+ next = node_next(tail);
+ }
+ return tail;
+ } else {
+ return null;
+ }
+}
+*/
+
+halfword tex_get_node(int size)
+{
+ if (size < max_chain_size) {
+ halfword p = lmt_node_memory_state.free_chain[size];
+ if (p) {
+ lmt_node_memory_state.free_chain[size] = node_next(p);
+ lmt_node_memory_state.nodesizes[p] = (char) size;
+ node_next(p) = null;
+ lmt_node_memory_state.nodes_data.ptr += size;
+ return p;
+ } else {
+ return tex_aux_allocated_node(size);
+ }
+ } else {
+ return tex_normal_error("nodes", "there is a problem in getting a node, case 1");
+ }
+}
+
+void tex_free_node(halfword p, int size) /* no need to pass size, we can get is here */
+{
+ if (p > lmt_node_memory_state.reserved && size < max_chain_size) {
+ lmt_node_memory_state.nodesizes[p] = 0;
+ node_next(p) = lmt_node_memory_state.free_chain[size];
+ lmt_node_memory_state.free_chain[size] = p;
+ lmt_node_memory_state.nodes_data.ptr -= size;
+ } else {
+ tex_formatted_error("nodes", "node number %d of type %d with size %d should not be freed", (int) p, node_type(p), size);
+ }
+}
+
+/*tex
+
+ 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. We can omit the zeroing because it's already done.
+
+*/
+
+static void tex_aux_initialize_glue(halfword n, scaled wi, scaled st, scaled sh, halfword sto, halfword sho)
+{
+ // memset((void *) (node_memory_state.nodes + n), 0, (sizeof(memoryword) * node_memory_state.nodesizes[glue_spec_node]));
+ node_type(n) = glue_spec_node;
+ glue_amount(n) = wi;
+ glue_stretch(n) = st;
+ glue_shrink(n) = sh;
+ glue_stretch_order(n) = sto;
+ glue_shrink_order(n) = sho;
+}
+
+static void tex_aux_initialize_whatever_node(halfword n, quarterword t)
+{
+ // memset((void *) (node_memory_state.nodes + n), 0, (sizeof(memoryword) * node_memory_state.nodesizes[t]));
+ node_type(n) = t;
+}
+
+static void tex_aux_initialize_character(halfword n, halfword chr)
+{
+ // memset((void *) (node_memory_state.nodes + n), 0, (sizeof(memoryword) * node_memory_state.nodesizes[glyph_node]));
+ node_type(n) = glyph_node;
+ glyph_character(n) = chr;
+}
+# define reserved_node_slots 32
+
+void tex_initialize_node_mem()
+{
+ memoryword *nodes = NULL;
+ char *sizes = NULL;
+ int size = 0;
+ if (lmt_main_state.run_state == initializing_state) {
+ size = lmt_node_memory_state.nodes_data.minimum;
+ lmt_node_memory_state.reserved = last_reserved;
+ lmt_node_memory_state.nodes_data.top = last_reserved + 1;
+ lmt_node_memory_state.nodes_data.allocated = size;
+ lmt_node_memory_state.nodes_data.ptr = last_reserved;
+ } else {
+ size = lmt_node_memory_state.nodes_data.allocated;
+ lmt_node_memory_state.nodes_data.initial = lmt_node_memory_state.nodes_data.ptr;
+ }
+ if (size >0) {
+ nodes = aux_allocate_clear_array(sizeof(memoryword), size, reserved_node_slots);
+ sizes = aux_allocate_clear_array(sizeof(char), size, reserved_node_slots);
+ }
+ if (nodes && sizes) {
+ lmt_node_memory_state.nodes = nodes;
+ lmt_node_memory_state.nodesizes = sizes;
+ } else {
+ tex_overflow_error("nodes", size);
+ }
+}
+
+void tex_initialize_nodes(void)
+{
+ if (lmt_main_state.run_state == initializing_state) {
+ /*tex Initialize static glue specs. */
+
+ tex_aux_initialize_glue(zero_glue, 0, 0, 0, 0, 0);
+ tex_aux_initialize_glue(fi_glue, 0, 0, 0, fi_glue_order, 0);
+ tex_aux_initialize_glue(fil_glue, 0, unity, 0, fil_glue_order, 0);
+ tex_aux_initialize_glue(fill_glue, 0, unity, 0, fill_glue_order, 0);
+ tex_aux_initialize_glue(filll_glue, 0, unity, unity, fil_glue_order, fil_glue_order);
+ tex_aux_initialize_glue(fil_neg_glue, 0, -unity, 0, fil_glue_order, 0);
+
+ /*tex Initialize node list heads. */
+
+ tex_aux_initialize_whatever_node(page_insert_head, temp_node); /* actually a split node */
+ tex_aux_initialize_whatever_node(contribute_head, temp_node);
+ tex_aux_initialize_whatever_node(page_head, temp_node);
+ tex_aux_initialize_whatever_node(temp_head, temp_node);
+ tex_aux_initialize_whatever_node(hold_head, temp_node);
+ tex_aux_initialize_whatever_node(post_adjust_head, temp_node);
+ tex_aux_initialize_whatever_node(pre_adjust_head, temp_node);
+ tex_aux_initialize_whatever_node(post_migrate_head, temp_node);
+ tex_aux_initialize_whatever_node(pre_migrate_head, temp_node);
+ tex_aux_initialize_whatever_node(align_head, temp_node);
+ tex_aux_initialize_whatever_node(active_head, unhyphenated_node);
+ tex_aux_initialize_whatever_node(end_span, span_node);
+
+ tex_aux_initialize_character(begin_period, '.');
+ tex_aux_initialize_character(end_period, '.');
+ }
+}
+
+void tex_dump_node_mem(dumpstream f)
+{
+ dump_int(f, lmt_node_memory_state.nodes_data.allocated);
+ dump_int(f, lmt_node_memory_state.nodes_data.top);
+ dump_things(f, lmt_node_memory_state.nodes[0], (size_t) lmt_node_memory_state.nodes_data.top + 1);
+ dump_things(f, lmt_node_memory_state.nodesizes[0], lmt_node_memory_state.nodes_data.top);
+ dump_things(f, lmt_node_memory_state.free_chain[0], max_chain_size);
+ dump_int(f, lmt_node_memory_state.nodes_data.ptr);
+ dump_int(f, lmt_node_memory_state.reserved);
+}
+
+/*tex
+ Node memory is (currently) also used for some stack related nodes. Using dedicated arrays instead
+ makes sense but on the other hand this is the charm of \TEX. Variable nodes are no longer using
+ the node pool so we don't need clever code to reclaim space. We have plenty anyway.
+*/
+
+void tex_undump_node_mem(dumpstream f) // todo: check allocation
+{
+ undump_int(f, lmt_node_memory_state.nodes_data.allocated);
+ undump_int(f, lmt_node_memory_state.nodes_data.top);
+ tex_initialize_node_mem();
+ undump_things(f, lmt_node_memory_state.nodes[0], (size_t) lmt_node_memory_state.nodes_data.top + 1);
+ undump_things(f, lmt_node_memory_state.nodesizes[0], (size_t) lmt_node_memory_state.nodes_data.top);
+ undump_things(f, lmt_node_memory_state.free_chain[0], max_chain_size);
+ undump_int(f, lmt_node_memory_state.nodes_data.ptr);
+ undump_int(f, lmt_node_memory_state.reserved);
+}
+
+static halfword tex_aux_allocated_node(int s)
+{
+ int old = lmt_node_memory_state.nodes_data.top;
+ int new = old + s;
+ if (new > lmt_node_memory_state.nodes_data.allocated) {
+ if (lmt_node_memory_state.nodes_data.allocated + lmt_node_memory_state.nodes_data.step <= lmt_node_memory_state.nodes_data.size) {
+ memoryword *nodes = aux_reallocate_array(lmt_node_memory_state.nodes, sizeof(memoryword), lmt_node_memory_state.nodes_data.allocated + lmt_node_memory_state.nodes_data.step, reserved_node_slots);
+ char *sizes = aux_reallocate_array(lmt_node_memory_state.nodesizes, sizeof(char), lmt_node_memory_state.nodes_data.allocated + lmt_node_memory_state.nodes_data.step, reserved_node_slots);
+ if (nodes && sizes) {
+ lmt_node_memory_state.nodes = nodes;
+ lmt_node_memory_state.nodesizes = sizes;
+ memset((void *) (nodes + lmt_node_memory_state.nodes_data.allocated), 0, (size_t) lmt_node_memory_state.nodes_data.step * sizeof(memoryword));
+ memset((void *) (sizes + lmt_node_memory_state.nodes_data.allocated), 0, (size_t) lmt_node_memory_state.nodes_data.step * sizeof(char));
+ lmt_node_memory_state.nodes_data.allocated += lmt_node_memory_state.nodes_data.step;
+ lmt_run_memory_callback("node", 1);
+ } else {
+ lmt_run_memory_callback("node", 0);
+ tex_overflow_error("node memory size", lmt_node_memory_state.nodes_data.size);
+ }
+ }
+ if (new > lmt_node_memory_state.nodes_data.allocated) {
+ tex_overflow_error("node memory size", lmt_node_memory_state.nodes_data.size);
+ }
+ }
+ /* We allocate way larger than the maximum size. */
+ // printf("old=%i size=%i new=%i\n",old,s,new);
+ lmt_node_memory_state.nodesizes[old] = (char) s;
+ lmt_node_memory_state.nodes_data.top = new;
+ return old;
+}
+
+int tex_n_of_used_nodes(int counts[])
+{
+ int n = 0;
+ for (int i = 0; i < max_node_type; i++) {
+ counts[i] = 0;
+ }
+ for (int i = lmt_node_memory_state.nodes_data.top; i > lmt_node_memory_state.reserved; i--) {
+ if (lmt_node_memory_state.nodesizes[i] > 0 && (node_type(i) <= max_node_type)) {
+ counts[node_type(i)] += 1;
+ }
+ }
+ for (int i = 0; i < max_node_type; i++) {
+ n += counts[i];
+ }
+ return n;
+}
+
+halfword tex_list_node_mem_usage(void)
+{
+ char *saved_varmem_sizes = aux_allocate_array(sizeof(char), lmt_node_memory_state.nodes_data.allocated, 1);
+ if (saved_varmem_sizes) {
+ halfword q = null;
+ halfword p = null;
+ memcpy(saved_varmem_sizes, lmt_node_memory_state.nodesizes, (size_t) lmt_node_memory_state.nodes_data.allocated);
+ for (halfword i = lmt_node_memory_state.reserved + 1; i < (lmt_node_memory_state.nodes_data.allocated - 1); i++) {
+ if (saved_varmem_sizes[i] > 0) {
+ halfword j = tex_copy_node(i);
+ if (p) {
+ node_next(p) = j;
+ } else {
+ q = j;
+ }
+ p = j;
+ }
+ }
+ aux_deallocate_array(saved_varmem_sizes);
+ return q;
+ } else {
+ return null;
+ }
+}
+
+/*
+ Now comes some attribute stuff. We could have a fast allocator for them and a dedicated pool
+ (actually for each node tyep I guess).
+*/
+
+inline static halfword tex_aux_new_attribute_list_node(halfword count)
+{
+ halfword r = tex_get_node(attribute_node_size);
+ node_type(r) = attribute_node;
+ node_subtype(r) = attribute_list_subtype;
+ attribute_unset(r) = 0;
+ attribute_count(r) = count;
+ return r;
+}
+
+inline static halfword tex_aux_new_attribute_node(halfword index, int value)
+{
+ halfword r = tex_get_node(attribute_node_size);
+ node_type(r) = attribute_node;
+ node_subtype(r) = attribute_value_subtype;
+ attribute_index(r) = index;
+ attribute_value(r) = value;
+ return r;
+}
+
+inline static halfword tex_aux_copy_attribute_node(halfword n)
+{
+ halfword a = tex_get_node(attribute_node_size);
+ memcpy((void *) (lmt_node_memory_state.nodes + a), (void *) (lmt_node_memory_state.nodes + n), (sizeof(memoryword) * attribute_node_size));
+ return a;
+}
+
+halfword tex_copy_attribute_list(halfword a_old)
+{
+ if (a_old && a_old != attribute_cache_disabled) {
+ halfword a_new = tex_aux_new_attribute_list_node(0);
+ halfword p_old = a_old;
+ halfword p_new = a_new;
+ p_old = node_next(p_old);
+ while (p_old) {
+ halfword a = tex_copy_node(p_old);
+ node_next(p_new) = a;
+ p_new = a;
+ p_old = node_next(p_old);
+ }
+ node_next(p_new) = null;
+ return a_new;
+ } else {
+ return a_old;
+ }
+}
+
+halfword tex_copy_attribute_list_set(halfword a_old, int index, int value)
+{
+ halfword a_new = tex_aux_new_attribute_list_node(0);
+ halfword p_new = a_new;
+ int done = 0;
+ if (a_old && a_old != attribute_cache_disabled) {
+ halfword p_old = node_next(a_old);
+ while (p_old) {
+ halfword i = attribute_index(p_old);
+ if (! done && i >= index) {
+ if (value != unused_attribute_value) {
+ halfword a = tex_aux_new_attribute_node(index, value);
+ node_next(p_new) = a;
+ p_new = a;
+ }
+ done = 1;
+ if (i == index) {
+ goto CONTINUE;
+ }
+ }
+ /* APPEND: */
+ {
+ halfword a = tex_aux_copy_attribute_node(p_old);
+ node_next(p_new) = a;
+ p_new = a;
+ }
+ CONTINUE:
+ p_old = node_next(p_old);
+ }
+ node_next(p_new) = null;
+ }
+ if (! done && value != unused_attribute_value) {
+ halfword b = tex_aux_new_attribute_node(index, value);
+ node_next(p_new) = b;
+ }
+ return a_new;
+}
+
+static void tex_aux_update_attribute_cache(void)
+{
+ halfword p = tex_aux_new_attribute_list_node(0);
+ set_current_attribute_state(p);
+ for (int i = 0; i <= lmt_node_memory_state.max_used_attribute; i++) {
+ int v = attribute_register(i);
+ if (v > unused_attribute_value) {
+ halfword r = tex_aux_new_attribute_node(i, v);
+ node_next(p) = r;
+ p = r;
+ }
+ }
+ if (! node_next(current_attribute_state)) {
+ tex_free_node(current_attribute_state, attribute_node_size);
+ set_current_attribute_state(null);
+ } else {
+ add_attribute_reference(current_attribute_state);
+ }
+}
+
+void tex_build_attribute_list(halfword target)
+{
+ if (lmt_node_memory_state.max_used_attribute >= 0) {
+ if (! current_attribute_state || current_attribute_state == attribute_cache_disabled) {
+ tex_aux_update_attribute_cache();
+ if (! current_attribute_state) {
+ return;
+ }
+ }
+ add_attribute_reference(current_attribute_state);
+ /*tex Checking for validity happens before the call; the subtype can be unset (yet). */
+ node_attr(target) = current_attribute_state;
+ }
+}
+
+halfword tex_current_attribute_list(void)
+{
+ if (lmt_node_memory_state.max_used_attribute >= 0) {
+ if (! current_attribute_state || current_attribute_state == attribute_cache_disabled) {
+ tex_aux_update_attribute_cache();
+ }
+ return current_attribute_state;
+ } else {
+ return null ;
+ }
+}
+
+/*tex
+
+ There can be some gain in setting |attr_last_unset_enabled| but only when a lot of unsetting
+ happens with rather long attribute lists, which actually is rare.
+
+ One tricky aspect if attributes is that when we test for a list head being the same, we have
+ the problem that freeing and (re)allocating can result in the same node address. Flushing in
+ reverse order sort of prevents that.
+
+*/
+
+void tex_dereference_attribute_list(halfword a)
+{
+ if (a && a != attribute_cache_disabled) {
+ if (node_type(a) == attribute_node && node_subtype(a) == attribute_list_subtype){
+ if (attribute_count(a) > 0) {
+ --attribute_count(a);
+ if (attribute_count(a) == 0) {
+ if (a == current_attribute_state) {
+ set_current_attribute_state(attribute_cache_disabled);
+ }
+ {
+ int u = 0;
+ /* this works (different order) */
+ while (a) {
+ halfword n = node_next(a);
+ lmt_node_memory_state.nodesizes[a] = 0;
+ node_next(a) = lmt_node_memory_state.free_chain[attribute_node_size];
+ lmt_node_memory_state.free_chain[attribute_node_size] = a;
+ ++u;
+ a = n;
+ }
+ /* this doesn't always (which is weird) */
+ // halfword h = a;
+ // halfword t = a;
+ // while (a) {
+ // lmt_node_memory_state.nodesizes[a] = 0;
+ // ++u;
+ // t = a;
+ // a = node_next(a);
+ // }
+ // node_next(t) = lmt_node_memory_state.free_chain[attribute_node_size];
+ // lmt_node_memory_state.free_chain[attribute_node_size] = h;
+ /* */
+ lmt_node_memory_state.nodes_data.ptr -= u * attribute_node_size;
+ }
+ }
+ } else {
+ tex_formatted_error("nodes", "zero referenced attribute list %i", a);
+ }
+ } else {
+ tex_formatted_error("nodes", "trying to delete an attribute reference of a non attribute list node %i (%i)", a, node_type(a));
+ }
+ }
+}
+
+/*tex
+ Here |p| is an attr list head, or zero. This one works on a copy, so we can overwrite a value!
+*/
+
+halfword tex_patch_attribute_list(halfword list, int index, int value)
+{
+ if (list == attribute_cache_disabled) {
+ return list;
+ } else if (list) {
+ halfword current = node_next(list);
+ halfword previous = list;
+ while (current) {
+ int i = attribute_index(current);
+ if (i == index) {
+ /*tex Replace: */
+ attribute_value(current) = value;
+ return list;
+ } else if (i > index) {
+ /*tex Prepend: */
+ halfword r = tex_aux_new_attribute_node(index, value);
+ node_next(previous) = r;
+ node_next(r) = current;
+ return list;
+ } else {
+ previous = current;
+ current = node_next(current);
+ }
+ }
+ {
+ /*tex Append: */
+ halfword r = tex_aux_new_attribute_node(index, value);
+ node_next(r) = node_next(previous);
+ node_next(previous) = r;
+ }
+ } else {
+ /*tex Watch out, we don't set a ref count, this branch is not seen anyway. */
+ halfword r = tex_aux_new_attribute_node(index, value);
+ list = tex_aux_new_attribute_list_node(0);
+ node_next(list) = r;
+ }
+ return list;
+}
+
+/* todo: combine set and unset */
+
+void tex_set_attribute(halfword target, int index, int value)
+{
+ /*tex Not all nodes can have an attribute list. */
+ if (tex_nodetype_has_attributes(node_type(target))) {
+ if (value == unused_attribute_value) {
+ tex_unset_attribute(target, index, value);
+ } else {
+ /*tex If we have no list, we create one and quit. */
+ halfword a = node_attr(target);
+ /* needs checking: can we get an empty one here indeed, the vlink test case ... */
+ if (a) {
+ halfword p = node_next(a);
+ while (p) {
+ int i = attribute_index(p);
+ if (i == index) {
+ if (attribute_value(p) == value) {
+ return;
+ } else {
+ break;
+ }
+ } else if (i > index) {
+ break;
+ } else {
+ p = node_next(p);
+ }
+ }
+ // p = tex_copy_attribute_list_set(a, index, value);
+ // tex_attach_attribute_list_attribute(target, p);
+ // } else {
+ // halfword p = tex_copy_attribute_list_set(null, index, value);
+ // tex_attach_attribute_list_attribute(target, p);
+ // }
+ }
+ a = tex_copy_attribute_list_set(a, index, value);
+ tex_attach_attribute_list_attribute(target, a);
+ }
+ }
+}
+
+int tex_unset_attribute(halfword target, int index, int value)
+{
+ if (tex_nodetype_has_attributes(node_type(target))) {
+ halfword p = node_attr(target);
+ if (p) {
+ halfword c = node_next(p);
+ while (c) {
+ halfword i = attribute_index(c);
+ if (i == index) {
+ halfword v = attribute_value(c);
+ if (v != value) {
+ halfword l = tex_copy_attribute_list_set(p, index, value);
+ tex_attach_attribute_list_attribute(target, l);
+ }
+ return v;
+ } else if (i > index) {
+ return unused_attribute_value;
+ }
+ c = node_next(c);
+ }
+ }
+ }
+ return unused_attribute_value;
+}
+
+void tex_unset_attributes(halfword first, halfword last, int index)
+{
+ halfword a = null;
+ halfword q = null;
+ halfword n = first;
+ while (n) {
+ if (tex_nodetype_has_attributes(node_type(n))) {
+ halfword p = node_attr(n);
+ if (p) {
+ if (p == q) {
+ tex_attach_attribute_list_attribute(n, a);
+ } else {
+ halfword c = node_next(p);
+ while (c) {
+ halfword i = attribute_index(c);
+ if (i == index) {
+ q = p;
+ a = tex_copy_attribute_list_set(p, index, unused_attribute_value); /* check */
+ tex_attach_attribute_list_attribute(n, a);
+ break;
+ } else if (i > index) {
+ break;
+ }
+ c = node_next(c);
+ }
+ }
+ }
+ }
+ if (n == last) {
+ break;
+ } else {
+ n = node_next(n);
+ }
+ }
+}
+
+int tex_has_attribute(halfword n, int index, int value)
+{
+ if (tex_nodetype_has_attributes(node_type(n))) {
+ halfword p = node_attr(n);
+ if (p) {
+ p = node_next(p);
+ while (p) {
+ if (attribute_index(p) == index) {
+ int v = attribute_value(p);
+ if (value == v || value == unused_attribute_value) {
+ return v;
+ } else {
+ return unused_attribute_value;
+ }
+ } else if (attribute_index(p) > index) {
+ return unused_attribute_value;
+ }
+ p = node_next(p);
+ }
+ }
+ }
+ return unused_attribute_value;
+}
+
+/*tex
+ Because we have more detail available we provide node names and show a space when we have one.
+ The disc nodes are also more granular. I might drop the font in showing glyph nodes. A previous
+ version used full node types inside brackets but we now collapse the node types and use only
+ the first character of the type. Eventually I might come up with some variants.
+ */
+
+void tex_print_short_node_contents(halfword p)
+{
+ int collapsing = 0;
+ while (p) {
+ switch (node_type(p)) {
+ case rule_node:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ tex_print_char('|');
+ break;
+ case glue_node:
+ switch (node_subtype(p)) {
+ case space_skip_glue:
+ case xspace_skip_glue:
+ case zero_space_skip_glue:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ tex_print_char(' ');
+ break;
+ default:
+ goto DEFAULT;
+ }
+ break;
+ case math_node:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ tex_print_char('$');
+ break;
+ case disc_node:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ tex_print_str("[[");
+ tex_print_short_node_contents(disc_pre_break_head(p));
+ tex_print_str("][");
+ tex_print_short_node_contents(disc_post_break_head(p));
+ tex_print_str("][");
+ tex_print_short_node_contents(disc_no_break_head(p));
+ tex_print_str("]]");
+ break;
+ case dir_node:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ if (node_subtype(p) == cancel_dir_subtype) {
+ tex_print_str(" >");
+ } else {
+ tex_print_str(dir_direction(p) ? "<r2l " : "<l2r ");
+ }
+ break;
+ case glyph_node:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ if (glyph_font(p) != lmt_print_state.font_in_short_display) {
+ tex_print_font_identifier(glyph_font(p));
+ tex_print_char(' ');
+ lmt_print_state.font_in_short_display = glyph_font(p);
+ }
+ tex_print_tex_str(glyph_character(p));
+ break;
+ case par_node:
+ if (collapsing) { tex_print_char(']'); collapsing = 0; }
+ tex_print_str(par_dir(p) ? "<r2l p>" : "<l2r p>");
+ break;
+ default:
+ DEFAULT:
+ if (! collapsing) {
+ tex_print_char('[');
+ collapsing = 1;
+ }
+ tex_print_char(lmt_interface.node_data[node_type(p)].name[0]);
+ break;
+ }
+ p = node_next(p);
+ }
+ if (collapsing) {
+ tex_print_char(']');
+ }
+}
+
+/*tex
+
+ Now we are ready for |show_node_list| itself. This procedure has been written to be \quote
+ {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 |memoryword| 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.
+
+*/
+
+void tex_print_node_list(halfword p, const char *what, int threshold, int max)
+{
+ if (p) {
+ if (what) {
+ tex_append_char('.');
+ tex_append_char('.');
+ tex_print_levels();
+ tex_print_current_string();
+ tex_print_str_esc(what);
+ } else {
+ /*tex This happens in math. */
+ }
+ tex_append_char('.');
+ tex_append_char('.');
+ tex_show_node_list(p, threshold, max); // show_box_depth_par, show_box_breadth_par
+ tex_flush_char();
+ tex_flush_char();
+ if (what) {
+ tex_flush_char();
+ tex_flush_char();
+ }
+ }
+}
+
+/*tex
+
+ Print a node list symbolically. This one is adaped to the fact that we have a bit more
+ granularity in subtypes and some more fields. It is therefore not compatible with traditional
+ \TEX. This is work in progress. I will also normalize some subtype names so ...
+
+*/
+
+static void tex_aux_show_attr_list(halfword p)
+{
+ p = node_attr(p);
+ if (p) {
+ int callback_id = lmt_callback_defined(get_attribute_callback);
+ if (tracing_nodes_par > 1) {
+ tex_print_format("<%i#%i>", p, attribute_count(p));
+ }
+ tex_print_char('[');
+ p = node_next(p);
+ while (p) {
+ halfword k = attribute_index(p);
+ halfword v = attribute_value(p);
+ if (callback_id) {
+ strnumber u = tex_save_cur_string();
+ char *ks = NULL;
+ char *vs = NULL;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "dd->RR", k, v, &ks, &vs);
+ tex_restore_cur_string(u);
+ if (ks) {
+ tex_print_str(ks);
+ lmt_memory_free(ks);
+ } else {
+ tex_print_int(k);
+ }
+ tex_print_char('=');
+ if (vs) {
+ tex_print_str(vs);
+ lmt_memory_free(vs);
+ } else {
+ tex_print_int(v);
+ }
+ } else {
+ tex_print_int(k);
+ tex_print_char('=');
+ tex_print_int(v);
+ };
+ p = node_next(p);
+ if (p) {
+ tex_print_char(',');
+ }
+ }
+ tex_print_char(']');
+ }
+}
+
+void tex_print_name(halfword n, const char* what)
+{
+ tex_print_str_esc(what);
+ if (tracing_nodes_par > 0) {
+ tex_print_char('<');
+ tex_print_int(n);
+ tex_print_char('>');
+ }
+}
+
+static void tex_aux_print_subtype_and_attributes_str(halfword p, const char *n)
+{
+ if (show_node_details_par > 0) {
+ tex_print_char('[');
+ tex_print_str(n);
+ tex_print_char(']');
+ }
+ if (show_node_details_par > 1 && tex_nodetype_has_attributes(node_type(p))) {
+ tex_aux_show_attr_list(p);
+ }
+}
+
+void tex_print_extended_subtype(halfword p, quarterword s)
+{
+ halfword st = s;
+ switch (p ? node_type(p) : simple_noad) {
+ case hlist_node:
+ if (s > noad_class_list_base) {
+ st -= noad_class_list_base;
+ }
+ case simple_noad:
+ case math_char_node:
+ {
+ int callback_id = lmt_callback_defined(get_noad_class_callback);
+ if (callback_id) {
+ strnumber u = tex_save_cur_string();
+ char *v = NULL;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "d->R", st, &v);
+ tex_restore_cur_string(u);
+ if (v) {
+ if (p && node_type(p) == hlist_node) {
+ tex_print_str("math");
+ }
+ tex_print_str(v);
+ lmt_memory_free(v);
+ break;
+ }
+ }
+ /* fall through */
+ }
+ break;
+ default:
+ tex_print_int(s);
+ break;
+ }
+}
+
+static void tex_print_subtype_and_attributes_info(halfword p, quarterword s, node_info *data)
+{
+ if (show_node_details_par > 0) {
+ tex_print_char('[');
+ if (data && data->subtypes && s >= data->first && s <= data->last) {
+ tex_print_str(data->subtypes[s].name);
+ } else {
+ tex_print_extended_subtype(p, s);
+ }
+ tex_print_char(']');
+ }
+ if (show_node_details_par > 1 && tex_nodetype_has_attributes(node_type(p))) {
+ tex_aux_show_attr_list(p);
+ }
+}
+
+static void tex_print_node_and_details(halfword p)
+{
+ halfword type = node_type(p);
+ quarterword subtype = node_subtype(p);
+ tex_print_name(p, lmt_interface.node_data[type].name);
+ switch (type) {
+ case temp_node:
+ case whatsit_node:
+ return;
+ }
+ tex_print_subtype_and_attributes_info(p, subtype, &lmt_interface.node_data[type]);
+}
+
+static void tex_aux_print_subtype_and_attributes_int(halfword p, halfword n)
+{
+ if (show_node_details_par > 0) { \
+ tex_print_char('[');
+ tex_print_int(n);
+ tex_print_char(']');
+ }
+ if (show_node_details_par > 1 && tex_nodetype_has_attributes(node_type(p))) {
+ tex_aux_show_attr_list(p);
+ }
+}
+
+const char *tex_aux_subtype_str(halfword n)
+{
+ if (n) {
+ node_info *data = &lmt_interface.node_data[node_type(n)];
+ if (data && data->subtypes && node_subtype(n) >= data->first && node_subtype(n) <= data->last) {
+ return data->subtypes[node_subtype(n)].name;
+ }
+ }
+ return "";
+}
+
+/*tex
+
+ We're not downward compatible here and it might even evolve a bit (and maybe I'll add a
+ compability mode too). We have way more information and plenty of log space so there is no
+ need to be compact. Consider it work in progress.
+
+ I admit that there is some self interest here in adding more detail. At some point (around
+ ctx 2019) I needed to see attribute values in the trace so I added that option which in turn
+ made me reformat the output a bit. Of course it makes sense to have the whole show be a
+ callback (and I might actually do that) but on the other hand it's so integral to \TEX\ that
+ it doesn't add much and in all the years that \LUATEX| is now arround I never really needed
+ it anyway.
+
+ One option is to go completely |\node[key=value,key={value,value}]| here as that can be easily
+ parsed. It's to be decided.
+
+ What is the string pool char data used for here?
+
+ Per version 2.09.22 we use the values from the node definitions which is more consistent and
+ also makes the binary somewhat smaller. It's all in the details. It's a typical example of
+ a change doen when we're stabel for a while (as it influences tracing).
+
+*/
+
+void tex_print_specnode(halfword v, int unit)
+{
+ if (tracing_nodes_par > 2) {
+ tex_print_format("<%i>", v);
+ }
+ tex_print_spec(v, unit);
+}
+
+void tex_aux_show_dictionary(halfword p, halfword properties, halfword group, halfword index,halfword font, halfword character)
+{
+ int callback_id = lmt_callback_defined(get_math_dictionary_callback);
+ if (callback_id) {
+ strnumber u = tex_save_cur_string();
+ char *s = NULL;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "Nddddd->R", p, properties, group, index, font, character, &s);
+ tex_restore_cur_string(u);
+ if (s) {
+ tex_print_str(", ");
+ tex_print_str(s);
+ lmt_memory_free(s);
+ return;
+ }
+ }
+ if (properties) {
+ tex_print_str(", properties ");
+ tex_print_qhex(properties);
+ }
+ if (group) {
+ tex_print_str(", group ");
+ tex_print_qhex(group);
+ }
+ if (index) {
+ tex_print_str(", index ");
+ tex_print_qhex(index);
+ }
+}
+
+void tex_show_node_list(halfword p, int threshold, int max)
+{
+ if ((int) lmt_string_pool_state.string_temp_top > threshold) {
+ if (p > null) {
+ /*tex Indicate that there's been some truncation. */
+ tex_print_format("[tracing depth %i reached]", threshold);
+ }
+ return;
+ } else {
+ /*tex The number of items already printed at this level: */
+ int n = 0;
+ if (max <= 0) {
+ max = 5;
+ }
+ while (p) {
+ tex_print_levels();
+ tex_print_current_string();
+ ++n;
+ if (n > max) {
+ /*tex Time to stop. */
+ halfword t = tex_tail_of_node_list(p);
+ if (t == p) {
+ /*tex We've showed the whole list. */
+ return;
+ } else if (p == node_prev(t)) {
+ // /*tex We're just before the end. */
+ } else {
+ tex_print_format("[tracing breadth %i reached]", max);
+ return;
+ }
+ }
+ tex_print_node_and_details(p);
+ switch (node_type(p)) {
+ case glyph_node:
+ if (show_node_details_par > 0) {
+ scaledwhd whd = tex_char_whd_from_glyph(p);
+ if (glyph_protected(p)) {
+ tex_print_str(", protected");
+ }
+ /* effective */
+ if (whd.wd) {
+ tex_print_str(", wd ");
+ tex_print_dimension(whd.wd, pt_unit);
+ }
+ if (whd.ht) {
+ tex_print_str(", ht ");
+ tex_print_dimension(whd.ht, pt_unit);
+ }
+ if (whd.dp) {
+ tex_print_str(", dp ");
+ tex_print_dimension(whd.dp, pt_unit);
+ }
+ if (whd.ic) {
+ tex_print_str(", ic ");
+ tex_print_dimension(whd.ic, pt_unit);
+ }
+ /* */
+ if (get_glyph_language(p)) {
+ tex_print_str(", language (n=");
+ tex_print_int(get_glyph_language(p));
+ tex_print_str(",l=");
+ tex_print_int(get_glyph_lhmin(p));
+ tex_print_str(",r=");
+ tex_print_int(get_glyph_rhmin(p));
+ tex_print_char(')');
+ }
+ if (get_glyph_script(p)) {
+ tex_print_str(", script ");
+ tex_print_int(get_glyph_script(p));
+ }
+ if (get_glyph_hyphenate(p)) {
+ tex_print_str(", hyphenationmode ");
+ tex_print_qhex(get_glyph_hyphenate(p));
+ }
+ if (glyph_x_offset(p)) {
+ tex_print_str(", xoffset ");
+ tex_print_dimension(glyph_x_offset(p), pt_unit);
+ }
+ if (glyph_y_offset(p)) {
+ tex_print_str(", yoffset ");
+ tex_print_dimension(glyph_y_offset(p), pt_unit);
+ }
+ if (glyph_left(p)) {
+ tex_print_str(", left ");
+ tex_print_dimension(glyph_left(p), pt_unit);
+ }
+ if (glyph_right(p)) {
+ tex_print_str(", right ");
+ tex_print_dimension(glyph_right(p), pt_unit);
+ }
+ if (glyph_raise(p)) {
+ tex_print_str(", raise ");
+ tex_print_dimension(glyph_raise(p), pt_unit);
+ }
+ if (glyph_expansion(p)) {
+ tex_print_str(", expansion ");
+ tex_print_int(glyph_expansion(p));
+ }
+ if (glyph_scale(p) && glyph_scale(p) != 1000) {
+ tex_print_str(", scale ");
+ tex_print_int(glyph_scale(p));
+ }
+ if (glyph_x_scale(p) && glyph_x_scale(p) != 1000) {
+ tex_print_str(", xscale ");
+ tex_print_int(glyph_x_scale(p));
+ }
+ if (glyph_y_scale(p) && glyph_y_scale(p) != 1000) {
+ tex_print_str(", yscale ");
+ tex_print_int(glyph_y_scale(p));
+ }
+ if (glyph_data(p)) {
+ tex_print_str(", data ");
+ tex_print_int(glyph_data(p));
+ }
+ if (glyph_state(p)) {
+ tex_print_str(", state ");
+ tex_print_int(glyph_state(p));
+ }
+ if (glyph_options(p)) {
+ tex_print_str(", options ");
+ tex_print_qhex(glyph_options(p));
+ }
+ if (glyph_discpart(p)) {
+ tex_print_str(", discpart ");
+ tex_print_int(glyph_discpart(p));
+ }
+ tex_aux_show_dictionary(p, glyph_properties(p), glyph_group(p), glyph_index(p), glyph_font(p), glyph_character(p));
+ }
+ tex_print_str(", font ");
+ /* this could be a callback */
+ tex_print_font_identifier(glyph_font(p)); /* for now consistent with others, might change */
+ tex_print_str(", glyph ");
+ tex_print_char_identifier(glyph_character(p));
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ /*tex Display box |p|. */
+ if (box_width(p)) {
+ tex_print_str(", width ");
+ tex_print_dimension(box_width(p), pt_unit);
+ }
+ if (box_height(p)) {
+ tex_print_str(", height ");
+ tex_print_dimension(box_height(p), pt_unit);
+ }
+ if (box_depth(p)) {
+ tex_print_str(", depth ");
+ tex_print_dimension(box_depth(p), pt_unit);
+ }
+ if (node_type(p) == unset_node) {
+ /*tex Display special fields of the unset node |p|. */
+ if (box_span_count(p)) {
+ tex_print_str(", columns ");
+ tex_print_int(box_span_count(p) + 1);
+ }
+ if (box_glue_stretch(p)) {
+ tex_print_str(", stretch ");
+ tex_print_glue(box_glue_stretch(p), box_glue_order(p), no_unit);
+ }
+ if (box_glue_shrink(p)) {
+ tex_print_str(", shrink ");
+ tex_print_glue(box_glue_shrink(p), box_glue_sign(p), no_unit);
+ }
+ } else {
+ /*tex
+
+ 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.
+
+ */
+ double g = (double) (box_glue_set(p));
+ if ((g != 0.0) && (box_glue_sign(p) != normal_glue_sign)) {
+ tex_print_str(", glue "); /*tex This was |glue set|. */
+ if (box_glue_sign(p) == shrinking_glue_sign) {
+ tex_print_str("- ");
+ }
+ if (g > 20000.0 || g < -20000.0) {
+ if (g > 0.0) {
+ tex_print_char('>');
+ } else {
+ tex_print_str("< -");
+ }
+ tex_print_glue(20000 * unity, box_glue_order(p), no_unit);
+ } else {
+ tex_print_glue((scaled) glueround(unity *g), box_glue_order(p), no_unit);
+ }
+ }
+ if (box_shift_amount(p) != 0) {
+ tex_print_str(", shifted ");
+ tex_print_dimension(box_shift_amount(p), pt_unit);
+ }
+ if (valid_direction(box_dir(p))) {
+ tex_print_str(", direction ");
+ switch (box_dir(p)) {
+ case 0 : tex_print_str("l2r"); break;
+ case 1 : tex_print_str("r2l"); break;
+ default : tex_print_str("unset"); break;
+ }
+ }
+ if (box_geometry(p)) {
+ tex_print_str(", geometry ");
+ tex_print_qhex(box_geometry(p));
+ if (tex_has_box_geometry(p, orientation_geometry)) {
+ tex_print_str(", orientation ");
+ tex_print_qhex(box_orientation(p));
+ }
+ if (tex_has_box_geometry(p, offset_geometry)) {
+ tex_print_str(", offset(");
+ tex_print_dimension(box_x_offset(p), pt_unit);
+ tex_print_char(',');
+ tex_print_dimension(box_y_offset(p), pt_unit);
+ tex_print_char(')');
+ }
+ if (tex_has_box_geometry(p, anchor_geometry)) {
+ if (box_anchor(p)) {
+ tex_print_str(", anchor ");
+ tex_print_qhex(box_anchor(p));
+ }
+ if (box_source_anchor(p)) {
+ tex_print_str(", source ");
+ tex_print_int(box_source_anchor(p));
+ }
+ if (box_target_anchor(p)) {
+ tex_print_str(", target ");
+ tex_print_int(box_target_anchor(p));
+ }
+ }
+ }
+ if (box_index(p)) {
+ tex_print_str(", index ");
+ tex_print_int(box_index(p));
+ }
+ if (box_package_state(p)) {
+ tex_print_str(", state ");
+ tex_print_int(box_package_state(p));
+ }
+ }
+ tex_print_node_list(box_pre_adjusted(p), "preadjusted", threshold, max);
+ tex_print_node_list(box_pre_migrated(p), "premigrated", threshold, max);
+ tex_print_node_list(box_list(p), "list", threshold, max);
+ tex_print_node_list(box_post_migrated(p), "postmigrated", threshold, max);
+ tex_print_node_list(box_post_adjusted(p), "postadjusted", threshold, max);
+ break;
+ case rule_node:
+ /*tex Display rule |p|. */
+ if (rule_width(p)) {
+ tex_print_str(", width ");
+ tex_print_rule_dimen(rule_width(p));
+ }
+ if (rule_height(p)) {
+ tex_print_str(", height ");
+ tex_print_rule_dimen(rule_height(p));
+ }
+ if (rule_depth(p)) {
+ tex_print_str(", depth ");
+ tex_print_rule_dimen(rule_depth(p));
+ }
+ if (rule_left(p)) {
+ tex_print_str(", left / top ");
+ tex_print_rule_dimen(rule_left(p));
+ }
+ if (rule_right(p)) {
+ tex_print_str(", right / bottom ");
+ tex_print_rule_dimen(rule_right(p));
+ }
+ if (rule_x_offset(p)) {
+ tex_print_str(", xoffset ");
+ tex_print_rule_dimen(rule_x_offset(p));
+ }
+ if (rule_y_offset(p)) {
+ tex_print_str(", yoffset ");
+ tex_print_rule_dimen(rule_y_offset(p));
+ }
+ if (rule_font(p)) {
+ if (rule_font(p) < 0 || rule_font(p) >= rule_font_fam_offset) {
+ tex_print_str(", font ");
+ tex_print_font_identifier(rule_font(p));
+ } else {
+ tex_print_str(", family ");
+ tex_print_int(rule_font(p) - rule_font_fam_offset);
+ }
+ }
+ if (rule_character(p)) {
+ tex_print_str(", character ");
+ tex_print_char_identifier(rule_character(p));
+ }
+ break;
+ case insert_node:
+ /*tex Display insertion |p|. The natural size is the sum of height and depth. */
+ tex_print_str(", index ");
+ tex_print_int(insert_index(p));
+ tex_print_str(", total height ");
+ tex_print_dimension(insert_total_height(p), pt_unit);
+ tex_print_str(", max depth ");
+ tex_print_dimension(insert_max_depth(p), pt_unit);
+ tex_print_str(", split glue (");
+ tex_print_specnode(insert_split_top(p), no_unit);
+ tex_print_str("), float cost ");
+ tex_print_int(insert_float_cost(p));
+ tex_print_node_list(insert_list(p), "list", threshold, max);
+ break;
+ case dir_node:
+ tex_print_str(", direction ");
+ switch (dir_direction(p)) {
+ case direction_l2r : tex_print_str("l2r"); break;
+ case direction_r2l : tex_print_str("r2l"); break;
+ default : tex_print_str("unset"); break;
+ }
+ break;
+ case par_node:
+ {
+ halfword v;
+ /*tex We're already past processing so we only show the stored values. */
+ if (node_subtype(p) == vmode_par_par_subtype) {
+ if (tex_par_state_is_set(p, par_par_shape_code) ) { v = par_par_shape(p) ; if (v) { tex_print_str(", parshape * "); } }
+ if (tex_par_state_is_set(p, par_inter_line_penalties_code) ) { v = par_inter_line_penalties(p) ; if (v) { tex_print_str(", interlinepenalties * "); } }
+ if (tex_par_state_is_set(p, par_club_penalties_code) ) { v = par_club_penalties(p) ; if (v) { tex_print_str(", clubpenalties * "); } }
+ if (tex_par_state_is_set(p, par_widow_penalties_code) ) { v = par_widow_penalties(p) ; if (v) { tex_print_str(", widowpenalties * "); } }
+ if (tex_par_state_is_set(p, par_display_widow_penalties_code)) { v = par_display_widow_penalties(p) ; if (v) { tex_print_str(", displsaywidowpenalties * "); } }
+ if (tex_par_state_is_set(p, par_orphan_penalties_code) ) { v = par_orphan_penalties(p) ; if (v) { tex_print_str(", orphanpenalties * "); } }
+ if (tex_par_state_is_set(p, par_hang_indent_code) ) { v = par_hang_indent(p) ; if (v) { tex_print_str(", hangindent "); tex_print_dimension(v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_hang_after_code) ) { v = par_hang_after(p) ; if (v) { tex_print_str(", hangafter "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_hsize_code) ) { v = par_hsize(p) ; if (v) { tex_print_str(", hsize "); tex_print_dimension(v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_right_skip_code) ) { v = par_right_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", rightskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_left_skip_code) ) { v = par_left_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", leftskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_last_line_fit_code) ) { v = par_last_line_fit(p) ; if (v) { tex_print_str(", lastlinefit "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_pre_tolerance_code) ) { v = par_pre_tolerance(p) ; if (v) { tex_print_str(", pretolerance "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_tolerance_code) ) { v = par_tolerance(p) ; if (v) { tex_print_str(", tolerance "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_looseness_code) ) { v = par_looseness(p) ; if (v) { tex_print_str(", looseness "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_adjust_spacing_code) ) { v = par_adjust_spacing(p) ; if (v) { tex_print_str(", adjustaspacing "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_adj_demerits_code) ) { v = par_adj_demerits(p) ; if (v) { tex_print_str(", adjdemerits "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_protrude_chars_code) ) { v = par_protrude_chars(p) ; if (v) { tex_print_str(", protrudechars "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_line_penalty_code) ) { v = par_line_penalty(p) ; if (v) { tex_print_str(", linepenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_double_hyphen_demerits_code) ) { v = par_double_hyphen_demerits(p) ; if (v) { tex_print_str(", doublehyphendemerits "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_final_hyphen_demerits_code) ) { v = par_final_hyphen_demerits(p) ; if (v) { tex_print_str(", finalhyphendemerits "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_inter_line_penalty_code) ) { v = par_inter_line_penalty(p) ; if (v) { tex_print_str(", interlinepenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_club_penalty_code) ) { v = par_club_penalty(p) ; if (v) { tex_print_str(", clubpenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_widow_penalty_code) ) { v = par_widow_penalty(p) ; if (v) { tex_print_str(", widowpenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_display_widow_penalty_code) ) { v = par_display_widow_penalty(p) ; if (v) { tex_print_str(", displaywidowpenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_orphan_penalty_code) ) { v = par_orphan_penalty(p) ; if (v) { tex_print_str(", orphanpenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_broken_penalty_code) ) { v = par_broken_penalty(p) ; if (v) { tex_print_str(", brokenpenalty "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_emergency_stretch_code) ) { v = par_emergency_stretch(p) ; if (v) { tex_print_str(", emergencystretch "); tex_print_dimension(v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_par_indent_code) ) { v = par_par_indent(p) ; if (v) { tex_print_str(", parindent "); tex_print_dimension(v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_par_fill_left_skip_code) ) { v = par_par_fill_left_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", parfilleftskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_par_fill_right_skip_code) ) { v = par_par_fill_right_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", parfillskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_par_init_left_skip_code) ) { v = par_par_init_left_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", parinitleftskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_par_init_right_skip_code) ) { v = par_par_init_right_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", parinitrightskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_baseline_skip_code) ) { v = par_baseline_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", baselineskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_line_skip_code) ) { v = par_line_skip(p) ; if (! tex_glue_is_zero(v)) { tex_print_str(", lineskip "); tex_print_specnode (v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_line_skip_limit_code) ) { v = par_line_skip_limit(p) ; if (v) { tex_print_str(", lineskiplimt "); tex_print_dimension(v, pt_unit); } }
+ if (tex_par_state_is_set(p, par_adjust_spacing_step_code) ) { v = par_adjust_spacing_step(p) ; if (v > 0) { tex_print_str(", adjustspacingstep "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_adjust_spacing_shrink_code) ) { v = par_adjust_spacing_shrink(p) ; if (v > 0) { tex_print_str(", adjustspacingshrink "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_adjust_spacing_stretch_code) ) { v = par_adjust_spacing_stretch(p) ; if (v > 0) { tex_print_str(", adjustspacingstretch "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_hyphenation_mode_code) ) { v = par_hyphenation_mode(p) ; if (v > 0) { tex_print_str(", hyphenationmode "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_shaping_penalties_mode_code) ) { v = par_shaping_penalties_mode(p) ; if (v > 0) { tex_print_str(", shapingpenaltiesmode "); tex_print_int (v); } }
+ if (tex_par_state_is_set(p, par_shaping_penalty_code) ) { v = par_shaping_penalty(p) ; if (v > 0) { tex_print_str(", shapingpenalty "); tex_print_int (v); } }
+ }
+ /* local boxes */
+ v = tex_get_local_left_width(p) ; if (v) { tex_print_str(", leftboxwidth "); tex_print_dimension(v, pt_unit); }
+ v = tex_get_local_right_width(p) ; if (v) { tex_print_str(", rightboxwidth "); tex_print_dimension(v, pt_unit); }
+ tex_print_node_list(par_box_left(p), "leftbox", threshold, max);
+ tex_print_node_list(par_box_right(p), "rightbox", threshold, max);
+ tex_print_node_list(par_box_middle(p), "middlebox", threshold, max);
+ }
+ break;
+ case boundary_node:
+ if (boundary_data(p)) {
+ tex_print_str(", data ");
+ tex_print_int(boundary_data(p));
+ }
+ break;
+ case whatsit_node:
+ {
+ int callback_id = lmt_callback_defined(show_whatsit_callback);
+ /*tex we always print this */
+ if (callback_id) {
+ strnumber u = tex_save_cur_string();
+ char *s = NULL;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "Nd->S", p, 1, &s);
+ tex_restore_cur_string(u);
+ if (s) {
+ tex_aux_print_subtype_and_attributes_str(p, s);
+ lmt_memory_free(s);
+ } else {
+ tex_aux_print_subtype_and_attributes_int(p, node_subtype(p));
+ }
+ } else {
+ tex_aux_print_subtype_and_attributes_int(p, node_subtype(p));
+ }
+ /*tex but optionally there can be more */
+ if (callback_id) {
+ int l = lmt_string_pool_state.string_temp_top / 2;
+ strnumber u = tex_save_cur_string();
+ /*tex Todo: the tracing needs checking. */
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "Nddddd->", p, 2, l, (tracing_levels_par & (tracing_levels_group | tracing_levels_input)), cur_level, lmt_input_state.input_stack_data.ptr);
+ tex_restore_cur_string(u);
+ }
+ }
+ break;
+ case glue_node:
+ /*tex Display glue |p|. */
+ if (is_leader(p)) {
+ /*tex Display leaders |p|. */
+ tex_print_str(", leader ");
+ tex_print_specnode(p, no_unit);
+ tex_print_node_list(glue_leader_ptr(p), "list", threshold, max);
+ } else {
+ if (node_subtype(p) != conditional_math_glue && node_subtype(p) != rulebased_math_glue) {
+ tex_print_char(' ');
+ tex_print_specnode(p, node_subtype(p) < conditional_math_glue ? pt_unit : mu_unit); /* was |no_unit : mu_unit| */
+ }
+ if (glue_data(p)) {
+ tex_print_str(", data ");
+ tex_print_int(glue_data(p));
+ }
+ if (node_subtype(p) == space_skip_glue && glue_font(p)) {
+ tex_print_str(", font ");
+ tex_print_int(glue_font(p));
+ }
+ }
+ break;
+ case kern_node:
+ /*tex Display kern |p| */
+ tex_print_str(", amount ");
+ tex_print_dimension(kern_amount(p), pt_unit);
+ if (node_subtype(p) != explicit_math_kern_subtype) {
+ tex_print_unit(pt_unit);
+ if (kern_expansion(p)) {
+ tex_print_str(", expansion ");
+ tex_print_int(kern_expansion(p));
+ }
+ } else {
+ tex_print_unit(mu_unit);
+ }
+ break;
+ case math_node:
+ /*tex Display math node |p|. */
+ if (! tex_math_glue_is_zero(p)) {
+ tex_print_str(", glued ");
+ tex_print_specnode(p, no_unit);
+ } else if (math_surround(p)) {
+ tex_print_str(", surrounded ");
+ tex_print_dimension(math_surround(p), pt_unit);
+ }
+ if (math_penalty(p)) {
+ tex_print_str(", penalty ");
+ tex_print_int(math_penalty(p));
+ }
+ break;
+ case penalty_node:
+ /*tex Display penalty |p|. */
+ tex_print_str(", amount ");
+ tex_print_int(penalty_amount(p));
+ break;
+ case disc_node:
+ if (disc_class(p) != unset_disc_class) {
+ tex_print_str(", class ");
+ tex_print_int(disc_class(p));
+ }
+ if (disc_options(p)) {
+ tex_print_str(", options ");
+ tex_print_qhex(disc_options(p));
+ }
+ tex_print_str(", penalty ");
+ tex_print_int(disc_penalty(p));
+ tex_print_node_list(disc_pre_break_head(p), "prebreaklist", threshold, max);
+ tex_print_node_list(disc_post_break_head(p), "postbreaklist", threshold, max);
+ tex_print_node_list(disc_no_break_head(p), "nobreaklist", threshold, max);
+ break;
+ case mark_node:
+ /*tex Display mark |p|. */
+ tex_print_str(", index ");
+ tex_print_int(mark_index(p));
+ if (node_subtype(p) == reset_mark_value_code) {
+ tex_print_str(", reset");
+ } else {
+ tex_print_token_list(NULL, token_link(mark_ptr(p))); /*tex We have a ref count token. */
+ }
+ break;
+ case adjust_node:
+ /*tex Display adjustment |p|. */
+ if (adjust_options(p)) {
+ tex_print_str(", options ");
+ tex_print_qhex(adjust_options(p));
+ }
+ if (adjust_index(p)) {
+ tex_print_str(", index ");
+ tex_print_int(adjust_index(p));
+ }
+ if (has_adjust_option(p, adjust_option_depth_before) && adjust_depth_before(p)) {
+ tex_print_str(", depthbefore ");
+ tex_print_dimension(adjust_depth_before(p), pt_unit);
+ }
+ if (has_adjust_option(p, adjust_option_depth_after) &&adjust_depth_before(p)) {
+ tex_print_str(", depthafter ");
+ tex_print_dimension(adjust_depth_after(p), pt_unit);
+ }
+ tex_print_node_list(adjust_list(p), "list", threshold, max);
+ break;
+ case glue_spec_node:
+ case math_spec_node:
+ case font_spec_node:
+ /*tex This is actually an error! */
+ break;
+ case align_record_node:
+ tex_print_token_list(NULL, align_record_pre_part(p)); /*tex No ref count token here. */
+ tex_print_levels();
+ tex_print_str("..<content>");
+ tex_print_token_list(NULL, align_record_post_part(p)); /*tex No ref count token here. */
+ break;
+ case temp_node:
+ break;
+ default:
+ if (! tex_show_math_node(p, threshold, max)) {
+ tex_print_format("<unknown node type %i>", node_type(p));
+ }
+ break;
+ }
+ p = node_next(p);
+ }
+ }
+}
+
+/*tex
+
+ This routine finds the base width of a horizontal box, using the same logic that \TEX82\ used
+ for |\predisplaywidth|.
+
+*/
+
+static halfword tex_aux_get_actual_box_width(halfword r, halfword p, scaled initial_width)
+{
+ /*tex calculated |size| */
+ scaled w = -max_dimen;
+ /*tex |w| plus possible glue amount */
+ scaled v = initial_width;
+ while (p) {
+ /*tex increment to |v| */
+ scaled d;
+ switch (node_type(p)) {
+ case glyph_node:
+ d = tex_glyph_width(p);
+ goto FOUND;
+ case hlist_node:
+ case vlist_node:
+ d = box_width(p);
+ goto FOUND;
+ case rule_node:
+ d = rule_width(p);
+ goto FOUND;
+ case kern_node:
+ d = kern_amount(p);
+ break;
+ case disc_node:
+ /*tex At the end of the line we should actually take the |pre|. */
+ if (disc_no_break(p)) {
+ d = tex_aux_get_actual_box_width(r, disc_no_break_head(p),0);
+ if (d <= -max_dimen || d >= max_dimen) {
+ d = 0;
+ }
+ } else {
+ d = 0;
+ }
+ goto FOUND;
+ case math_node:
+ if (tex_math_glue_is_zero(p)) {
+ d = math_surround(p);
+ } else {
+ d = math_amount(p);
+ switch (box_glue_sign(r)) {
+ case stretching_glue_sign:
+ if ((box_glue_order(r) == math_stretch_order(p)) && math_stretch(p)) {
+ v = max_dimen;
+ }
+ break;
+ case shrinking_glue_sign:
+ if ((box_glue_order(r) == math_shrink_order(p)) && math_shrink(p)) {
+ v = max_dimen;
+ }
+ break;
+ }
+ break;
+ }
+ break;
+ case glue_node:
+ /*tex
+ 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 = glue_amount(p);
+ if (box_glue_sign(r) == stretching_glue_sign) {
+ if ((box_glue_order(r) == glue_stretch_order(p)) && glue_stretch(p)) {
+ v = max_dimen;
+ }
+ } else if (box_glue_sign(r) == shrinking_glue_sign) {
+ if ((box_glue_order(r) == glue_shrink_order(p)) && glue_shrink(p)) {
+ v = max_dimen;
+ }
+ }
+ if (is_leader(p)) {
+ goto FOUND;
+ }
+ break;
+ default:
+ d = 0;
+ break;
+ }
+ if (v < max_dimen) {
+ v += d;
+ }
+ goto NOT_FOUND;
+ FOUND:
+ if (v < max_dimen) {
+ v += d;
+ w = v;
+ } else {
+ w = max_dimen;
+ break;
+ }
+ NOT_FOUND:
+ p = node_next(p);
+ }
+ return w;
+}
+
+halfword tex_actual_box_width(halfword r, scaled base_width)
+{
+ /*tex
+
+ Often this is the same as:
+
+ \starttyping
+ return + shift_amount(r) + base_width +
+ natural_sizes(list_ptr(r),null,(glueratio) box_glue_set(r),box_glue_sign(r),box_glue_order(r),box_dir(r));
+ \stoptyping
+ */
+ return tex_aux_get_actual_box_width(r, box_list(r), box_shift_amount(r) + base_width);
+}
+
+int tex_list_has_glyph(halfword list)
+{
+ while (list) {
+ switch (node_type(list)) {
+ case glyph_node:
+ case disc_node:
+ return 1;
+ default:
+ list = node_next(list);
+ break;
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ Attribute lists need two extra globals to increase processing efficiency. |max_used_attr|
+ limits the test loop that checks for set attributes, and |attr_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.
+
+ 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|.
+
+*/
+
+/*tex Create a new box node. */
+
+halfword tex_new_null_box_node(quarterword t, quarterword s)
+{
+ // halfword p = tex_new_node(hlist_node, min_quarterword);
+ halfword p = tex_new_node(t, s);
+ box_dir(p) = (singleword) text_direction_par;
+ return p;
+}
+
+/*tex
+
+ 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 \quote {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 \quote
+ {running}, so you have to change the ones that are not allowed to run.
+
+*/
+
+halfword tex_new_rule_node(quarterword s)
+{
+ return tex_new_node(rule_node, s);
+}
+
+/*tex
+
+ Insertions are represented by |insert_node| records, where the |subtype| indicates the
+ corresponding box number. For example, |\insert 250| leads to an |insert_node| whose |subtype|
+ is |250 + min_quarterword|. The |height| field of an |insert_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 |insert_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|).
+
+ We no longer check if the glyph exists because a replacement can be used instead. We copy some
+ properties when there is a parent passed.
+
+*/
+
+halfword tex_new_glyph_node(quarterword s, halfword f, halfword c, halfword parent)
+{
+ halfword p = parent && node_type(parent) == glyph_node ? tex_copy_node(parent) : tex_aux_new_glyph_node_with_attributes(parent);
+ node_subtype(p) = s;
+ glyph_font(p) = f;
+ glyph_character(p) = c;
+ tex_char_process(f, c);
+ return p;
+}
+
+/*tex
+
+ 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.)
+ Remark: we no longer keep track of ligatures via |lig_ptr| because there is no guarantee that
+ they are consistently tracked; they are something internal anyway. Of course one can provide an
+ alternative at the \LUA\ end (which is what we do in \CONTEXT).
+
+ 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|.
+
+*/
+
+/*
+quarterword norm_min(int h)
+{
+ if (h <= 0)
+ return 1;
+ else if (h >= 255)
+ return 255;
+ else
+ return (quarterword) h;
+}
+*/
+
+halfword tex_new_char_node(quarterword subtype, halfword fnt, halfword chr, int all)
+{
+ halfword p = tex_aux_new_glyph_node_with_attributes(null);
+ node_subtype(p) = subtype;
+ glyph_font(p) = fnt;
+ glyph_character(p) = chr;
+ if (all) {
+ glyph_data(p) = glyph_data_par;
+ /* no state */
+ set_glyph_script(p, glyph_script_par);
+ set_glyph_language(p, cur_lang_par);
+ set_glyph_lhmin(p, left_hyphen_min_par);
+ set_glyph_rhmin(p, right_hyphen_min_par);
+ set_glyph_hyphenate(p, hyphenation_mode_par);
+ set_glyph_options(p, glyph_options_par);
+ set_glyph_scale(p, glyph_scale_par);
+ set_glyph_x_scale(p, glyph_x_scale_par);
+ set_glyph_y_scale(p, glyph_y_scale_par);
+ set_glyph_x_offset(p, glyph_x_offset_par);
+ set_glyph_y_offset(p, glyph_y_offset_par);
+ }
+ if (! tex_char_exists(fnt, chr)) {
+ int callback_id = lmt_callback_defined(missing_character_callback);
+ if (callback_id > 0) {
+ /* maybe direct node */
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "Ndd->", p, fnt, chr);
+ }
+ }
+ return p;
+}
+
+halfword tex_new_text_glyph(halfword fnt, halfword chr)
+{
+ halfword p = tex_get_node(glyph_node_size);
+ memset((void *) (lmt_node_memory_state.nodes + p + 1), 0, (sizeof(memoryword) * (glyph_node_size - 1)));
+ node_type(p) = glyph_node;
+ node_subtype(p) = glyph_unset_subtype;
+ glyph_font(p) = fnt;
+ glyph_character(p) = chr;
+ glyph_data(p) = glyph_data_par;
+ /* no state */
+ set_glyph_script(p, glyph_script_par);
+ set_glyph_language(p, cur_lang_par);
+ set_glyph_lhmin(p, left_hyphen_min_par);
+ set_glyph_rhmin(p, right_hyphen_min_par);
+ set_glyph_hyphenate(p, hyphenation_mode_par);
+ set_glyph_options(p, glyph_options_par);
+ set_glyph_scale(p, glyph_scale_par);
+ set_glyph_x_scale(p, glyph_x_scale_par);
+ set_glyph_y_scale(p, glyph_y_scale_par);
+ set_glyph_x_offset(p, glyph_x_offset_par);
+ set_glyph_y_offset(p, glyph_y_offset_par);
+ return p;
+}
+
+/*tex
+
+ Here are a few handy helpers used by the list output routines.
+
+ We had an xadvance but dropped it but it might come back eventually. The offsets are mostly
+ there to deal with anchoring and we assume kerns to be used to complement x offsets if needed:
+ just practical decisions made long ago.
+
+ Why do we check y offset being positive for dp but not for ht? Maybe change this to be
+ consistent? Anyway, we have adapted \LUATEX\ so ...
+
+ \startitemize
+ \startitem what we had before \stopitem
+ \startitem compensate height and depth \stopitem
+ \startitem compensate height and depth, take max \stopitem
+ \startitem we keep height and depth \stopitem
+ \stopitemize
+
+*/
+
+/*tex These should move to the texfont.c as we have too many variants now. */
+
+scaled tex_glyph_width(halfword p)
+{
+ scaled w = tex_char_width_from_glyph(p);
+ scaled x = glyph_x_offset(p);
+ if (x && tex_has_glyph_option(p, glyph_option_apply_x_offset)) {
+ w += x; /* or after expansion? needs testing */
+ }
+ w -= (glyph_left(p) + glyph_right(p));
+ return w;
+}
+
+scaled tex_glyph_width_ex(halfword p)
+{
+ scaled w = tex_char_width_from_glyph(p);
+ scaled x = glyph_x_offset(p);
+ if (x && tex_has_glyph_option(p, glyph_option_apply_x_offset)) {
+ w += x; /* or after expansion? needs testing */
+ }
+ w -= (glyph_left(p) + glyph_right(p));
+ if (glyph_expansion(p)) {
+ w = w + tex_ext_xn_over_d(w, 1000000 + glyph_expansion(p), 1000000);
+ }
+ return w;
+}
+
+scaled tex_glyph_height(halfword p)
+{
+ scaled h = tex_char_height_from_glyph(p) + glyph_raise(p);
+ scaled y = glyph_y_offset(p);
+ if (y && tex_has_glyph_option(p, glyph_option_apply_y_offset)) {
+ h += y;
+ }
+ return h < 0 ? 0 : h;
+}
+
+scaled tex_glyph_depth(halfword p) /* not used */
+{
+ scaled d = tex_char_depth_from_glyph(p) - glyph_raise(p);
+ scaled y = glyph_y_offset(p);
+ if (y && tex_has_glyph_option(p, glyph_option_apply_y_offset)) {
+ d -= y;
+ }
+ return d < 0 ? 0 : d;
+}
+
+scaledwhd tex_glyph_dimensions(halfword p)
+{
+ scaledwhd whd = { 0, 0, 0 };
+ scaled x = glyph_x_offset(p);
+ scaled y = glyph_y_offset(p);
+ whd.ht = tex_char_height_from_glyph(p) + glyph_raise(p);
+ whd.dp = tex_char_depth_from_glyph(p) - glyph_raise(p);
+ whd.wd = tex_char_width_from_glyph(p) - (glyph_left(p) + glyph_right(p));
+ if (x && tex_has_glyph_option(p, glyph_option_apply_x_offset)) {
+ whd.wd += x;
+ }
+ if (y && tex_has_glyph_option(p, glyph_option_apply_y_offset)) {
+ whd.ht += y;
+ whd.dp -= y;
+ }
+ if (whd.ht < 0) {
+ whd.ht = 0;
+ }
+ if (whd.dp < 0) {
+ whd.dp = 0;
+ }
+ return whd;
+}
+
+scaledwhd tex_glyph_dimensions_ex(halfword p)
+{
+ scaledwhd whd = { 0, 0, 0 };
+ scaled x = glyph_x_offset(p);
+ scaled y = glyph_y_offset(p);
+ whd.ht = tex_char_height_from_glyph(p) + glyph_raise(p);
+ whd.dp = tex_char_depth_from_glyph(p) - glyph_raise(p);
+ whd.wd = tex_char_width_from_glyph(p) - (glyph_left(p) + glyph_right(p));
+ if (x && tex_has_glyph_option(p, glyph_option_apply_x_offset)) {
+ whd.wd += x;
+ }
+ if (y && tex_has_glyph_option(p, glyph_option_apply_y_offset)) {
+ whd.ht += y;
+ whd.dp -= y;
+ }
+ if (whd.ht < 0) {
+ whd.ht = 0;
+ }
+ if (whd.dp < 0) {
+ whd.dp = 0;
+ }
+ if (whd.wd && glyph_expansion(p)) {
+ whd.wd = tex_ext_xn_over_d(whd.wd, 1000000 + glyph_expansion(p), 1000000);
+ }
+ return whd;
+}
+
+scaled tex_glyph_total(halfword p)
+{
+ scaled ht = tex_char_height_from_glyph(p);
+ scaled dp = tex_char_depth_from_glyph(p);
+ if (ht < 0) {
+ ht = 0;
+ }
+ if (dp < 0) {
+ dp = 0;
+ }
+ return ht + dp;
+}
+
+int tex_glyph_has_dimensions(halfword p)
+{
+ scaled offset = glyph_x_offset(p);
+ scaled amount = tex_char_width_from_glyph(p);
+ if (offset && tex_has_glyph_option(p, glyph_option_apply_x_offset)) {
+ amount += offset;
+ }
+ amount -= (glyph_left(p) + glyph_right(p));
+ if (amount) {
+ return 1;
+ } else {
+ amount = tex_char_total_from_glyph(p);
+ /* here offset adn raise just moves */
+ return amount != 0;
+ }
+}
+
+halfword tex_kern_dimension(halfword p)
+{
+ return kern_amount(p);
+}
+
+halfword tex_kern_dimension_ex(halfword p)
+{
+ halfword k = kern_amount(p);
+ if (k && kern_expansion(p)) {
+ k = tex_ext_xn_over_d(k, 1000000 + kern_expansion(p), 1000000);
+ }
+ return k;
+}
+
+scaledwhd tex_pack_dimensions(halfword p)
+{
+ scaledwhd whd = { 0, 0, 0 };
+ whd.ht = box_height(p);
+ whd.dp = box_depth(p);
+ whd.wd = box_width(p);
+ return whd;
+}
+
+/*tex
+
+ A |disc_node|, which occurs only in horizontal lists, specifies a \quote {discretionary}
+ 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|.
+
+ 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.
+
+*/
+
+halfword tex_new_disc_node(quarterword s)
+{
+ halfword p = tex_new_node(disc_node, s);
+ disc_penalty(p) = hyphen_penalty_par;
+ disc_class(p) = unset_disc_class;
+ return p;
+}
+
+/*tex
+
+ The program above includes a bunch of \quote {hooks} that allow further capabilities to be
+ added without upsetting \TEX's basic structure. Most of these hooks are concerned with \quote
+ {whatsit} nodes, which are intended to be used for special purposes; whenever a new extension
+ to \TEX\ involves a new kind of whatsit node, a corresponding change needs to be made to the
+ routines below that deal with such nodes, but it will usually be unnecessary to make many
+ changes to the other parts of this program.
+
+ In order to demonstrate how extensions can be made, we shall treat |\write|, |\openout|,
+ |\closeout|, |\immediate|, and |\special| as if they were extensions. These commands are
+ actually primitives of \TEX, and they should appear in all implementations of the system; but
+ let's try to imagine that they aren't. Then the program below illustrates how a person could
+ add them.
+
+ Sometimes, of course, an extension will require changes to \TEX\ itself; no system of hooks
+ could be complete enough for all conceivable extensions. The features associated with |\write|
+ are almost all confined to the following paragraphs, but there are small parts of the |print_ln|
+ and |print_char| procedures that were introduced specifically to |\write| characters.
+ Furthermore one of the token lists recognized by the scanner is a |write_text|; and there are a
+ few other miscellaneous places where we have already provided for some aspect of |\write|. The
+ goal of a \TeX\ extender should be to minimize alterations to the standard parts of the program,
+ and to avoid them completely if possible. He or she should also be quite sure that there's no
+ easy way to accomplish the desired goals with the standard features that \TEX\ already has.
+ \quote {Think thrice before extending}, because that may save a lot of work, and it will also
+ keep incompatible extensions of \TEX\ from proliferating.
+
+ First let's consider the format of whatsit nodes that are used to represent the data associated
+ with |\write| and its relatives. Recall that a whatsit has |type=whatsit_node|, and the |subtype|
+ is supposed to distinguish different kinds of whatsits. Each node occupies two or more words;
+ the exact number is immaterial, as long as it is readily determined from the |subtype| or other
+ data.
+
+ We shall introduce five |subtype| values here, corresponding to the control sequences |\openout|,
+ |\write|, |\closeout|, and |\special|. The second word of I/O whatsits has a |write_stream|
+ field that identifies the write-stream number (0 to 15, or 16 for out-of-range and positive, or
+ 17 for out-of-range and negative). In the case of |\write| and |\special|, there is also a field
+ that points to the reference count of a token list that should be sent. In the case of |\openout|,
+ we need three words and three auxiliary subfields to hold the string numbers for name, area, and
+ extension.
+
+ Extensions might introduce new command codes; but it's best to use |extension| with a modifier,
+ whenever possible, so that |main_control| stays the same.
+
+ The sixteen possible |\write| streams are represented by the |write_file| array. The |j|th file
+ is open if and only if |write_open[j]=true|. The last two streams are special; |write_open[16]|
+ represents a stream number greater than 15, while |write_open[17]| represents a negative stream
+ number, and both of these variables are always |false|.
+
+ Writing to files is delegated to \LUA, so we have no write channels.
+
+ To write a token list, we must run it through \TEX's scanner, expanding macros and |\the| and
+ |\number|, etc. This might cause runaways, if a delimited macro parameter isn't matched, and
+ runaways would be extremely confusing since we are calling on \TEX's scanner in the middle of
+ a |\shipout| command. Therefore we will put a dummy control sequence as a \quote {stopper},
+ right after the token list. This control sequence is artificially defined to be |\outer|.
+
+ The presence of |\immediate| causes the |do_extension| procedure to descend to one level of
+ recursion. Nothing happens unless |\immediate| is followed by |\openout|, |\write|, or
+ |\closeout|.
+
+ Here is a subroutine that creates a whatsit node having a given |subtype| and a given number
+ of words. It initializes only the first word of the whatsit, and appends it to the current
+ list.
+
+ 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 \quote {\TEX nicolor} extension to specify different colors of
+ ink, 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.
+
+ However, in \LUAMETATEX\ we only have a generic whatsit node, a small one that can be used to
+ implement whatever you like, using \LUA. So, all we have here is the above comment as
+ guideline for that.
+
+ \TEX\ makes use of the fact that |hlist_node|, |vlist_node|, |rule_node|, |insert_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, 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.
+
+*/
+
+halfword tex_new_glue_spec_node(halfword q)
+{
+ if (q) {
+ switch (node_type(q)) {
+ case glue_spec_node:
+ return tex_copy_node(q);
+ case glue_node:
+ {
+ halfword p = tex_copy_node(zero_glue);
+ glue_amount(p) = glue_amount(q);
+ glue_stretch(p) = glue_stretch(q);
+ glue_shrink(p) = glue_shrink(q);
+ glue_stretch_order(p) = glue_stretch_order(q);
+ glue_shrink_order(p) = glue_shrink_order(q);
+ return p;
+ }
+ }
+ }
+ return tex_copy_node(zero_glue);
+}
+
+/*tex
+
+ 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|.
+
+*/
+
+halfword tex_new_param_glue_node(quarterword p, quarterword s)
+{
+ halfword n = tex_new_node(glue_node, s);
+ halfword g = glue_parameter(p);
+ if (g) {
+ memcpy((void *) (lmt_node_memory_state.nodes + n + 2), (void *) (lmt_node_memory_state.nodes + g + 2), (glue_spec_size - 2) * (sizeof(memoryword)));
+ }
+ return n;
+}
+
+/*tex
+
+ Glue nodes that are more or less anonymous are created by |new_glue|, whose argument points to
+ a glue specification.
+
+*/
+
+halfword tex_new_glue_node(halfword q, quarterword s)
+{
+ halfword p = tex_new_node(glue_node, s);
+ memcpy((void *) (lmt_node_memory_state.nodes + p + 2), (void *) (lmt_node_memory_state.nodes + q + 2), (glue_spec_size - 2) * (sizeof(memoryword)));
+ return p;
+}
+
+/*tex
+
+ Still another subroutine is needed: |new_skip_param|. 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.
+
+ Remark: as we have copies we don't need this one can use |new_param_glue| instead.
+
+*/
+
+/*tex
+
+ 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 (font) kern node having a given width.
+
+*/
+
+halfword tex_new_kern_node(scaled w, quarterword s)
+{
+ halfword p = tex_new_node(kern_node, s);
+ kern_amount(p) = w;
+ return p;
+}
+
+/*tex
+
+ 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.
+
+*/
+
+halfword tex_new_penalty_node(halfword m, quarterword s)
+{
+ halfword p = tex_new_node(penalty_node, s);
+ penalty_amount(p) = m;
+ return p;
+}
+
+/*tex
+
+ 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 \quote {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. 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.
+
+ Some day we might store the current paragraph properties in this node. Actually, we already
+ store the interline and broken penalties. But it then also demands adaptation if the functions
+ that deal with breaking (we can just pass the local par node) and related specification node
+ cleanups. We could either snapshot parameters before a group ends, or we can add a lots of
+ |\local...| parameters.
+
+*/
+
+halfword tex_new_par_node(quarterword mode)
+{
+ int callback_id, top;
+ halfword p = tex_new_node(par_node, mode);
+ /* */
+ tex_set_local_interline_penalty(p, local_interline_penalty_par);
+ tex_set_local_broken_penalty(p, local_broken_penalty_par);
+ par_dir(p) = par_direction_par;
+ /* */
+ tex_add_local_boxes(p);
+ if (mode != local_box_par_subtype) {
+ /*tex Callback with node passed. Todo: move to luanode with the rest of callbacks. */
+ callback_id = lmt_callback_defined(insert_par_callback);
+ if (callback_id > 0) {
+ lua_State *L = lmt_lua_state.lua_instance;
+ if (lmt_callback_okay(L, callback_id, &top)) {
+ int i;
+ lmt_node_list_to_lua(L, p);
+ lmt_push_par_mode(L, mode);
+ i = lmt_callback_call(L, 2, 0 ,top);
+ if (i) {
+ lmt_callback_error(L, top, i);
+ } else {
+ lmt_callback_wrapup(L, top);
+ }
+ }
+ }
+ }
+ return p;
+}
+
+static halfword tex_aux_internal_to_par_code(halfword cmd, halfword index) {
+ switch (cmd) {
+ case internal_int_cmd:
+ switch (index) {
+ case hang_after_code : return par_hang_after_code;
+ case adjust_spacing_code : return par_adjust_spacing_code;
+ case protrude_chars_code : return par_protrude_chars_code;
+ case pre_tolerance_code : return par_pre_tolerance_code;
+ case tolerance_code : return par_tolerance_code;
+ case looseness_code : return par_looseness_code;
+ case last_line_fit_code : return par_last_line_fit_code;
+ case line_penalty_code : return par_line_penalty_code;
+ case inter_line_penalty_code : return par_inter_line_penalty_code;
+ case club_penalty_code : return par_club_penalty_code;
+ case widow_penalty_code : return par_widow_penalty_code;
+ case display_widow_penalty_code : return par_display_widow_penalty_code;
+ case orphan_penalty_code : return par_orphan_penalty_code;
+ case broken_penalty_code : return par_broken_penalty_code;
+ case adj_demerits_code : return par_adj_demerits_code;
+ case double_hyphen_demerits_code : return par_double_hyphen_demerits_code;
+ case final_hyphen_demerits_code : return par_final_hyphen_demerits_code;
+ case shaping_penalties_mode_code : return par_shaping_penalties_mode_code;
+ case shaping_penalty_code : return par_shaping_penalty_code;
+ }
+ case internal_dimen_cmd:
+ switch (index) {
+ case hsize_code : return par_hsize_code;
+ case hang_indent_code : return par_hang_indent_code;
+ case par_indent_code : return par_par_indent_code;
+ case emergency_stretch_code : return par_emergency_stretch_code;
+ case line_skip_limit_code : return par_line_skip_limit_code;
+ }
+ case internal_glue_cmd:
+ switch (index) {
+ case left_skip_code : return par_left_skip_code;
+ case right_skip_code : return par_right_skip_code;
+ case par_fill_left_skip_code : return par_par_fill_left_skip_code;
+ case par_fill_right_skip_code : return par_par_fill_right_skip_code;
+ case par_init_left_skip_code : return par_par_init_left_skip_code;
+ case par_init_right_skip_code : return par_par_init_right_skip_code;
+ case baseline_skip_code : return par_baseline_skip_code;
+ case line_skip_code : return par_line_skip_code;
+ }
+ case specification_reference_cmd:
+ switch (index) {
+ case par_shape_code : return par_par_shape_code;
+ case inter_line_penalties_code : return par_inter_line_penalties_code;
+ case club_penalties_code : return par_club_penalties_code;
+ case widow_penalties_code : return par_widow_penalties_code;
+ case display_widow_penalties_code: return par_display_widow_penalties_code;
+ case orphan_penalties_code : return par_orphan_penalties_code;
+ }
+ }
+ return -1;
+}
+
+void tex_update_par_par(halfword cmd, halfword index)
+{
+ halfword code = tex_aux_internal_to_par_code(cmd, index);
+ if (code >= 0) {
+ halfword par = tex_find_par_par(cur_list.head);
+ if (par) {
+ tex_snapshot_par(par, code);
+ }
+ }
+}
+
+halfword tex_get_par_par(halfword p, halfword what)
+{
+ int set = tex_par_state_is_set(p, what);
+ switch (what) {
+ case par_par_shape_code: return set ? par_par_shape(p) : par_shape_par;
+ case par_inter_line_penalties_code: return set ? par_inter_line_penalties(p) : inter_line_penalties_par;
+ case par_club_penalties_code: return set ? par_club_penalties(p) : club_penalties_par;
+ case par_widow_penalties_code: return set ? par_widow_penalties(p) : widow_penalties_par;
+ case par_display_widow_penalties_code: return set ? par_display_widow_penalties(p) : display_widow_penalties_par;
+ case par_orphan_penalties_code: return set ? par_orphan_penalties(p) : orphan_penalties_par;
+ case par_hang_indent_code: return set ? par_hang_indent(p) : hang_indent_par;
+ case par_hang_after_code: return set ? par_hang_after(p) : hang_after_par;
+ case par_hsize_code: return set ? par_hsize(p) : hsize_par;
+ case par_left_skip_code: return set ? par_left_skip(p) : left_skip_par;
+ case par_right_skip_code: return set ? par_right_skip(p) : right_skip_par;
+ case par_last_line_fit_code: return set ? par_last_line_fit(p) : last_line_fit_par;
+ case par_pre_tolerance_code: return set ? par_pre_tolerance(p) : pre_tolerance_par;
+ case par_tolerance_code: return set ? par_tolerance(p) : tolerance_par;
+ case par_looseness_code: return set ? par_looseness(p) : looseness_par;
+ case par_adjust_spacing_code: return set ? par_adjust_spacing(p) : adjust_spacing_par;
+ case par_adj_demerits_code: return set ? par_adj_demerits(p) : adj_demerits_par;
+ case par_protrude_chars_code: return set ? par_protrude_chars(p) : protrude_chars_par;
+ case par_line_penalty_code: return set ? par_line_penalty(p) : line_penalty_par;
+ case par_double_hyphen_demerits_code: return set ? par_double_hyphen_demerits(p) : double_hyphen_demerits_par;
+ case par_final_hyphen_demerits_code: return set ? par_final_hyphen_demerits(p) : final_hyphen_demerits_par;
+ case par_inter_line_penalty_code: return set ? par_inter_line_penalty(p) : inter_line_penalty_par;
+ case par_club_penalty_code: return set ? par_club_penalty(p) : club_penalty_par;
+ case par_widow_penalty_code: return set ? par_widow_penalty(p) : widow_penalty_par;
+ case par_display_widow_penalty_code: return set ? par_display_widow_penalty(p) : display_widow_penalty_par;
+ case par_orphan_penalty_code: return set ? par_orphan_penalty(p) : orphan_penalty_par;
+ case par_broken_penalty_code: return set ? par_broken_penalty(p) : broken_penalty_par;
+ case par_emergency_stretch_code: return set ? par_emergency_stretch(p) : emergency_stretch_par;
+ case par_par_indent_code: return set ? par_par_indent(p) : par_indent_par;
+ case par_par_fill_left_skip_code: return set ? par_par_fill_left_skip(p) : par_fill_left_skip_par;
+ case par_par_fill_right_skip_code: return set ? par_par_fill_right_skip(p) : par_fill_right_skip_par;
+ case par_par_init_left_skip_code: return set ? par_par_init_left_skip(p) : par_init_left_skip_par;
+ case par_par_init_right_skip_code: return set ? par_par_init_right_skip(p) : par_init_right_skip_par;
+ case par_baseline_skip_code: return set ? par_baseline_skip(p) : baseline_skip_par;
+ case par_line_skip_code: return set ? par_line_skip(p) : line_skip_par;
+ case par_line_skip_limit_code: return set ? par_line_skip_limit(p) : line_skip_limit_par;
+ case par_adjust_spacing_step_code: return set ? par_adjust_spacing_step(p) : adjust_spacing_step_par;
+ case par_adjust_spacing_shrink_code: return set ? par_adjust_spacing_shrink(p) : adjust_spacing_shrink_par;
+ case par_adjust_spacing_stretch_code: return set ? par_adjust_spacing_stretch(p) : adjust_spacing_stretch_par;
+ case par_hyphenation_mode_code: return set ? par_hyphenation_mode(p) : hyphenation_mode_par;
+ case par_shaping_penalties_mode_code: return set ? par_shaping_penalties_mode(p) : shaping_penalties_mode_par;
+ case par_shaping_penalty_code: return set ? par_shaping_penalty(p) : shaping_penalty_par;
+ }
+ return null;
+}
+
+void tex_set_par_par(halfword p, halfword what, halfword v, int force)
+{
+ if (force || tex_par_state_is_set(p, what)) {
+ switch (what) {
+ case par_hsize_code:
+ par_hsize(p) = v;
+ break;
+ case par_left_skip_code:
+ if (par_left_skip(p)) {
+ tex_flush_node(par_left_skip(p));
+ }
+ par_left_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_right_skip_code:
+ if (par_right_skip(p)) {
+ tex_flush_node(par_right_skip(p));
+ }
+ par_right_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_hang_indent_code:
+ par_hang_indent(p) = v;
+ break;
+ case par_hang_after_code:
+ par_hang_after(p) = v;
+ break;
+ case par_par_indent_code:
+ par_par_indent(p) = v;
+ break;
+ case par_par_fill_left_skip_code:
+ if (par_par_fill_left_skip(p)) {
+ tex_flush_node(par_par_fill_left_skip(p));
+ }
+ par_par_fill_left_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_par_fill_right_skip_code:
+ if (par_par_fill_right_skip(p)) {
+ tex_flush_node(par_par_fill_right_skip(p));
+ }
+ par_par_fill_right_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_par_init_left_skip_code:
+ if (par_par_init_left_skip(p)) {
+ tex_flush_node(par_par_init_left_skip(p));
+ }
+ par_par_init_left_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_par_init_right_skip_code:
+ if (par_par_init_right_skip(p)) {
+ tex_flush_node(par_par_init_right_skip(p));
+ }
+ par_par_init_right_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_adjust_spacing_code:
+ par_adjust_spacing(p) = v;
+ break;
+ case par_protrude_chars_code:
+ par_protrude_chars(p) = v;
+ break;
+ case par_pre_tolerance_code:
+ par_pre_tolerance(p) = v;
+ break;
+ case par_tolerance_code:
+ par_tolerance(p) = v;
+ break;
+ case par_emergency_stretch_code:
+ par_emergency_stretch(p) = v;
+ break;
+ case par_looseness_code:
+ par_looseness(p) = v;
+ break;
+ case par_last_line_fit_code:
+ par_last_line_fit(p) = v;
+ break;
+ case par_line_penalty_code:
+ par_line_penalty(p) = v;
+ break;
+ case par_inter_line_penalty_code:
+ par_inter_line_penalty(p) = v;
+ break;
+ case par_club_penalty_code:
+ par_club_penalty(p) = v;
+ break;
+ case par_widow_penalty_code:
+ par_widow_penalty(p) = v;
+ break;
+ case par_display_widow_penalty_code:
+ par_display_widow_penalty(p) = v;
+ break;
+ case par_orphan_penalty_code:
+ par_orphan_penalty(p) = v;
+ break;
+ case par_broken_penalty_code:
+ par_broken_penalty(p) = v;
+ break;
+ case par_adj_demerits_code:
+ par_adj_demerits(p) = v;
+ break;
+ case par_double_hyphen_demerits_code:
+ par_double_hyphen_demerits(p) = v;
+ break;
+ case par_final_hyphen_demerits_code:
+ par_final_hyphen_demerits(p) = v;
+ break;
+ case par_par_shape_code:
+ if (par_par_shape(p)) {
+ tex_flush_node(par_par_shape(p));
+ }
+ par_par_shape(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_inter_line_penalties_code:
+ if (par_inter_line_penalties(p)) {
+ tex_flush_node(par_inter_line_penalties(p));
+ }
+ par_inter_line_penalties(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_club_penalties_code:
+ if (par_club_penalties(p)) {
+ tex_flush_node(par_club_penalties(p));
+ }
+ par_club_penalties(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_widow_penalties_code:
+ if (par_widow_penalties(p)) {
+ tex_flush_node(par_widow_penalties(p));
+ }
+ par_widow_penalties(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_display_widow_penalties_code:
+ if (par_display_widow_penalties(p)) {
+ tex_flush_node(par_display_widow_penalties(p));
+ }
+ par_display_widow_penalties(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_orphan_penalties_code:
+ if (par_orphan_penalties(p)) {
+ tex_flush_node(par_orphan_penalties(p));
+ }
+ par_orphan_penalties(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_baseline_skip_code:
+ if (par_baseline_skip(p)) {
+ tex_flush_node(par_baseline_skip(p));
+ }
+ par_baseline_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_line_skip_code:
+ if (par_line_skip(p)) {
+ tex_flush_node(par_line_skip(p));
+ }
+ par_line_skip(p) = v ? tex_copy_node(v) : null;
+ break;
+ case par_line_skip_limit_code:
+ par_line_skip_limit(p) = v;
+ break;
+ case par_adjust_spacing_step_code:
+ par_adjust_spacing_step(p) = v;
+ break;
+ case par_adjust_spacing_shrink_code:
+ par_adjust_spacing_shrink(p) = v;
+ break;
+ case par_adjust_spacing_stretch_code:
+ par_adjust_spacing_stretch(p) = v;
+ break;
+ case par_hyphenation_mode_code:
+ par_hyphenation_mode(p) = v;
+ break;
+ case par_shaping_penalties_mode_code:
+ par_shaping_penalties_mode(p) = v;
+ break;
+ case par_shaping_penalty_code:
+ par_shaping_penalty(p) = v;
+ break;
+ }
+ tex_set_par_state(p, what);
+ }
+}
+
+void tex_snapshot_par(halfword p, halfword what)
+{
+ if (p && lmt_main_state.run_state != initializing_state) {
+ int unset = 0;
+ if (what) {
+ if (what < 0) {
+ unset = 1;
+ what = -what;
+ }
+ if (what > par_all_category) {
+ what = par_all_category;
+ }
+ } else {
+ unset = 1;
+ what = par_all_category;
+ }
+ if (tex_par_to_be_set(what, par_hsize_code)) { tex_set_par_par(p, par_hsize_code, unset ? null : hsize_par, 1); }
+ if (tex_par_to_be_set(what, par_left_skip_code)) { tex_set_par_par(p, par_left_skip_code, unset ? null : left_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_right_skip_code)) { tex_set_par_par(p, par_right_skip_code, unset ? null : right_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_hang_indent_code)) { tex_set_par_par(p, par_hang_indent_code, unset ? null : hang_indent_par, 1); }
+ if (tex_par_to_be_set(what, par_hang_after_code)) { tex_set_par_par(p, par_hang_after_code, unset ? null : hang_after_par, 1); }
+ if (tex_par_to_be_set(what, par_par_indent_code)) { tex_set_par_par(p, par_par_indent_code, unset ? null : par_indent_par, 1); }
+ if (tex_par_to_be_set(what, par_par_fill_left_skip_code)) { tex_set_par_par(p, par_par_fill_left_skip_code, unset ? null : par_fill_left_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_par_fill_right_skip_code)) { tex_set_par_par(p, par_par_fill_right_skip_code, unset ? null : par_fill_right_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_par_init_left_skip_code)) { tex_set_par_par(p, par_par_init_left_skip_code, unset ? null : par_init_left_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_par_init_right_skip_code)) { tex_set_par_par(p, par_par_init_right_skip_code, unset ? null : par_init_right_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_adjust_spacing_code)) { tex_set_par_par(p, par_adjust_spacing_code, unset ? null : adjust_spacing_par, 1); }
+ if (tex_par_to_be_set(what, par_protrude_chars_code)) { tex_set_par_par(p, par_protrude_chars_code, unset ? null : protrude_chars_par, 1); }
+ if (tex_par_to_be_set(what, par_pre_tolerance_code)) { tex_set_par_par(p, par_pre_tolerance_code, unset ? null : pre_tolerance_par, 1); }
+ if (tex_par_to_be_set(what, par_tolerance_code)) { tex_set_par_par(p, par_tolerance_code, unset ? null : tolerance_par, 1); }
+ if (tex_par_to_be_set(what, par_emergency_stretch_code)) { tex_set_par_par(p, par_emergency_stretch_code, unset ? null : emergency_stretch_par, 1); }
+ if (tex_par_to_be_set(what, par_looseness_code)) { tex_set_par_par(p, par_looseness_code, unset ? null : looseness_par, 1); }
+ if (tex_par_to_be_set(what, par_last_line_fit_code)) { tex_set_par_par(p, par_last_line_fit_code, unset ? null : last_line_fit_par, 1); }
+ if (tex_par_to_be_set(what, par_line_penalty_code)) { tex_set_par_par(p, par_line_penalty_code, unset ? null : line_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_inter_line_penalty_code)) { tex_set_par_par(p, par_inter_line_penalty_code, unset ? null : inter_line_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_club_penalty_code)) { tex_set_par_par(p, par_club_penalty_code, unset ? null : club_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_widow_penalty_code)) { tex_set_par_par(p, par_widow_penalty_code, unset ? null : widow_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_display_widow_penalty_code)) { tex_set_par_par(p, par_display_widow_penalty_code, unset ? null : display_widow_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_orphan_penalty_code)) { tex_set_par_par(p, par_orphan_penalty_code, unset ? null : orphan_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_broken_penalty_code)) { tex_set_par_par(p, par_broken_penalty_code, unset ? null : broken_penalty_par, 1); }
+ if (tex_par_to_be_set(what, par_adj_demerits_code)) { tex_set_par_par(p, par_adj_demerits_code, unset ? null : adj_demerits_par, 1); }
+ if (tex_par_to_be_set(what, par_double_hyphen_demerits_code)) { tex_set_par_par(p, par_double_hyphen_demerits_code, unset ? null : double_hyphen_demerits_par, 1); }
+ if (tex_par_to_be_set(what, par_final_hyphen_demerits_code)) { tex_set_par_par(p, par_final_hyphen_demerits_code, unset ? null : final_hyphen_demerits_par, 1); }
+ if (tex_par_to_be_set(what, par_par_shape_code)) { tex_set_par_par(p, par_par_shape_code, unset ? null : par_shape_par, 1); }
+ if (tex_par_to_be_set(what, par_inter_line_penalties_code)) { tex_set_par_par(p, par_inter_line_penalties_code, unset ? null : inter_line_penalties_par, 1); }
+ if (tex_par_to_be_set(what, par_club_penalties_code)) { tex_set_par_par(p, par_club_penalties_code, unset ? null : club_penalties_par, 1); }
+ if (tex_par_to_be_set(what, par_widow_penalties_code)) { tex_set_par_par(p, par_widow_penalties_code, unset ? null : widow_penalties_par, 1); }
+ if (tex_par_to_be_set(what, par_display_widow_penalties_code)) { tex_set_par_par(p, par_display_widow_penalties_code, unset ? null : display_widow_penalties_par, 1); }
+ if (tex_par_to_be_set(what, par_orphan_penalties_code)) { tex_set_par_par(p, par_orphan_penalties_code, unset ? null : orphan_penalties_par, 1); }
+ if (tex_par_to_be_set(what, par_baseline_skip_code)) { tex_set_par_par(p, par_baseline_skip_code, unset ? null : baseline_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_line_skip_code)) { tex_set_par_par(p, par_line_skip_code, unset ? null : line_skip_par, 1); }
+ if (tex_par_to_be_set(what, par_line_skip_limit_code)) { tex_set_par_par(p, par_line_skip_limit_code, unset ? null : line_skip_limit_par, 1); }
+ if (tex_par_to_be_set(what, par_adjust_spacing_step_code)) { tex_set_par_par(p, par_adjust_spacing_step_code, unset ? null : adjust_spacing_step_par, 1); }
+ if (tex_par_to_be_set(what, par_adjust_spacing_shrink_code)) { tex_set_par_par(p, par_adjust_spacing_shrink_code, unset ? null : adjust_spacing_shrink_par, 1); }
+ if (tex_par_to_be_set(what, par_adjust_spacing_stretch_code)) { tex_set_par_par(p, par_adjust_spacing_stretch_code, unset ? null : adjust_spacing_stretch_par, 1); }
+ if (tex_par_to_be_set(what, par_hyphenation_mode_code)) { tex_set_par_par(p, par_hyphenation_mode_code, unset ? null : hyphenation_mode_par, 1); }
+ if (tex_par_to_be_set(what, par_shaping_penalties_mode_code)) { tex_set_par_par(p, par_shaping_penalties_mode_code, unset ? null : shaping_penalties_mode_par, 1); }
+ if (tex_par_to_be_set(what, par_shaping_penalty_code)) { tex_set_par_par(p, par_shaping_penalty_code, unset ? null : shaping_penalty_par, 1); }
+
+ if (what == par_all_category) {
+ par_state(p) = unset ? 0 : par_all_category;
+ } else if (unset) {
+ par_state(p) &= ~(what | par_state(p));
+ } else {
+ par_state(p) |= what;
+ }
+ }
+}
+
+halfword tex_find_par_par(halfword head)
+{
+ if (head) {
+ if (node_type(head) == temp_node) {
+ head = node_next(head);
+ }
+ if (head && node_type(head) == par_node) {
+ return head;
+ }
+ }
+ return null;
+}
+
+halfword tex_reversed_node_list(halfword list)
+{
+ if (list) {
+ halfword prev = list;
+ halfword last = list;
+ list = node_next(list);
+ if (list) {
+ while (1) {
+ halfword next = node_next(list);
+ tex_couple_nodes(list, prev);
+ if (node_type(list) == dir_node) {
+ node_subtype(list) = node_subtype(list) == cancel_dir_subtype ? normal_dir_subtype : cancel_dir_subtype ;
+ }
+ if (next) {
+ prev = list;
+ list = next;
+ } else {
+ node_next(last) = null;
+ node_prev(list) = null;
+ return list;
+ }
+ }
+ }
+ }
+ return list;
+}
+
+/* */
+
+halfword tex_new_specification_node(halfword n, quarterword s, halfword options)
+{
+ halfword p = tex_new_node(specification_node, s);
+ tex_new_specification_list(p, n, options);
+ return p;
+}
+
+void tex_dispose_specification_nodes(void) {
+ if (par_shape_par) { tex_flush_node(par_shape_par); par_shape_par = null; }
+ if (inter_line_penalties_par) { tex_flush_node(inter_line_penalties_par); inter_line_penalties_par = null; }
+ if (club_penalties_par) { tex_flush_node(club_penalties_par); club_penalties_par = null; }
+ if (widow_penalties_par) { tex_flush_node(widow_penalties_par); widow_penalties_par = null; }
+ if (display_widow_penalties_par) { tex_flush_node(display_widow_penalties_par); display_widow_penalties_par = null; }
+ if (math_forward_penalties_par) { tex_flush_node(math_forward_penalties_par); math_forward_penalties_par = null; }
+ if (math_backward_penalties_par) { tex_flush_node(math_backward_penalties_par); math_backward_penalties_par = null; }
+ if (orphan_penalties_par) { tex_flush_node(orphan_penalties_par); orphan_penalties_par = null; }
+}
+
+void tex_null_specification_list(halfword a)
+{
+ specification_pointer(a) = NULL;
+ specification_count(a) = 0;
+}
+
+static void *tex_aux_allocate_specification(int n, size_t *s)
+{
+ void *p = NULL;
+ *s = n * sizeof(memoryword);
+ lmt_node_memory_state.extra_data.allocated += (int) *s;
+ lmt_node_memory_state.extra_data.ptr = lmt_node_memory_state.extra_data.allocated;
+ if (lmt_node_memory_state.extra_data.ptr > lmt_node_memory_state.extra_data.top) {
+ lmt_node_memory_state.extra_data.top = lmt_node_memory_state.extra_data.ptr;
+ }
+ p = lmt_memory_malloc(*s);
+ if (! p) {
+ tex_overflow_error("nodes", (int) *s);
+ }
+ return p;
+}
+
+static void tex_aux_deallocate_specification(void *p, int n)
+{
+ size_t s = n * sizeof(memoryword);
+ lmt_node_memory_state.extra_data.allocated -= (int) s;
+ lmt_node_memory_state.extra_data.ptr = lmt_node_memory_state.extra_data.allocated;
+ lmt_memory_free(p);
+}
+
+void tex_new_specification_list(halfword a, halfword n, halfword o)
+{
+ size_t s = 0;
+ specification_pointer(a) = tex_aux_allocate_specification(n, &s);
+ specification_count(a) = specification_pointer(a) ? n : 0;
+ specification_options(a) = o;
+}
+
+void tex_dispose_specification_list(halfword a)
+{
+ if (specification_pointer(a)) {
+ tex_aux_deallocate_specification(specification_pointer(a), specification_count(a));
+ specification_pointer(a) = NULL;
+ specification_count(a) = 0;
+ specification_options(a) = 0;
+ }
+}
+
+void tex_copy_specification_list(halfword a, halfword b) {
+ if (specification_pointer(b)) {
+ size_t s = 0;
+ specification_pointer(a) = tex_aux_allocate_specification(specification_count(b), &s);
+ if (specification_pointer(a) && specification_pointer(b)) {
+ specification_count(a) = specification_count(b);
+ specification_options(a) = specification_options(b);
+ memcpy(specification_pointer(a), specification_pointer(b), s);
+ } else {
+ specification_count(a) = 0;
+ specification_options(a) = 0;
+ }
+ }
+}
+
+void tex_shift_specification_list(halfword a, int n, int rotate)
+{
+ if (specification_pointer(a)) {
+ halfword c = specification_count(a);
+ if (rotate) {
+ if (n > 0 && c > 0 && n < c && c != n) {
+ size_t s = 0;
+ memoryword *b = tex_aux_allocate_specification(c, &s);
+ memoryword *p = specification_pointer(a);
+ halfword m = c - n;
+ s = m * sizeof(memoryword);
+ memcpy(b, p + n, s);
+ s = n * sizeof(memoryword);
+ memcpy(b + m, p, s);
+ tex_aux_deallocate_specification(specification_pointer(a), c);
+ specification_pointer(a) = b;
+ }
+ } else {
+ halfword o = 0;
+ halfword m = 0;
+ memoryword *b = NULL;
+ if (n > 0 && c > 0 && n < c) {
+ size_t s = 0;
+ memoryword *p = specification_pointer(a);
+ o = specification_options(a);
+ m = c - n;
+ b = tex_aux_allocate_specification(m, &s);
+ memcpy(b, p + n, s);
+ }
+ if (c > 0) {
+ tex_aux_deallocate_specification(specification_pointer(a), c);
+ }
+ specification_pointer(a) = b;
+ specification_count(a) = m;
+ specification_options(a) = o;
+ }
+ }
+}
+
+/* */
+
+void tex_set_disc_field(halfword target, halfword location, halfword source)
+{
+ switch (location) {
+ case pre_break_code: target = disc_pre_break(target); break;
+ case post_break_code: target = disc_post_break(target); break;
+ case no_break_code: target = disc_no_break(target); break;
+ }
+ node_prev(source) = null; /* don't expose this one! */
+ if (source) {
+ node_head(target) = source ;
+ node_tail(target) = tex_tail_of_node_list(source);
+ } else {
+ node_head(target) = null;
+ node_tail(target) = null;
+ }
+}
+
+void tex_check_disc_field(halfword n)
+{
+ halfword p = disc_pre_break_head(n);
+ disc_pre_break_tail(n) = p ? tex_tail_of_node_list(p) : null;
+ p = disc_post_break_head(n);
+ disc_post_break_tail(n) = p ? tex_tail_of_node_list(p) : null;
+ p = disc_no_break_head(n);
+ disc_no_break_tail(n) = p ? tex_tail_of_node_list(p) : null;
+}
+
+void tex_set_discpart(halfword d, halfword h, halfword t, halfword code)
+{
+ switch (node_subtype(d)) {
+ case automatic_discretionary_code:
+ case mathematics_discretionary_code:
+ code = glyph_discpart_always;
+ break;
+ }
+ halfword c = h;
+ while (c) {
+ if (node_type(c) == glyph_node) {
+ set_glyph_discpart(c, code);
+ }
+ if (c == t) {
+ break;
+ } else {
+ c = node_next(c);
+ }
+ }
+}
+
+halfword tex_flatten_discretionaries(halfword head, int *count, int nest)
+{
+ halfword current = head;
+ while (current) {
+ halfword next = node_next(current);
+ switch (node_type(current)) {
+ case disc_node:
+ {
+ halfword d = current;
+ halfword h = disc_no_break_head(d);
+ halfword t = disc_no_break_tail(d);
+ if (h) {
+ tex_set_discpart(current, h, t, glyph_discpart_replace);
+ tex_try_couple_nodes(t, next);
+ if (current == head) {
+ head = h;
+ } else {
+ tex_try_couple_nodes(node_prev(current), h);
+ }
+ disc_no_break_head(d) = null ;
+ } else if (current == head) {
+ head = next;
+ } else {
+ tex_try_couple_nodes(node_prev(current), next);
+ }
+ tex_flush_node(d);
+ if (count) {
+ *count += 1;
+ }
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ if (nest) {
+ halfword list = box_list(current);
+ if (list) {
+ box_list(current) = tex_flatten_discretionaries(list, count, nest);
+ }
+ break;
+ }
+ }
+ current = next;
+ }
+ return head;
+}
+
+void tex_flatten_leaders(halfword box, int *count)
+{
+ halfword head = box ? box_list(box) : null;
+ if (head) {
+ halfword current = head;
+ while (current) {
+ halfword next = node_next(current);
+ if (node_type(current) == glue_node && node_subtype(current) == u_leaders) {
+ halfword b = glue_leader_ptr(current);
+ if (b && (node_type(b) == hlist_node || node_type(b) == vlist_node)) {
+ halfword p = null;
+ halfword a = glue_amount(current);
+ double w = (double) a;
+ switch (box_glue_sign(box)) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(current) == box_glue_order(box)) {
+ w += glue_stretch(current) * (double) box_glue_set(box);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(current) == box_glue_order(box)) {
+ w -= glue_shrink(current) * (double) box_glue_set(box);
+ }
+ break;
+ }
+ if (node_type(b) == hlist_node) {
+ p = tex_hpack(box_list(b), scaledround(w), packing_exactly, box_dir(b), holding_none_option);
+ } else {
+ p = tex_vpack(box_list(b), scaledround(w), packing_exactly, 0, box_dir(b), holding_none_option);
+ }
+ box_list(b) = box_list(p);
+ box_width(b) = box_width(p);
+ box_height(b) = box_height(p);
+ box_depth(b) = box_depth(p);
+ box_glue_order(b) = box_glue_order(p);
+ box_glue_sign(b) = box_glue_sign(p);
+ box_glue_set(b) = box_glue_set(p);
+ set_box_package_state(b, package_u_leader_set);
+ box_list(p) = null;
+ tex_flush_node(p);
+ glue_leader_ptr(current) = null;
+ tex_flush_node(current);
+ tex_try_couple_nodes(b, next);
+ if (current == head) {
+ box_list(box) = b;
+ } else {
+ tex_try_couple_nodes(node_prev(current), b);
+ }
+ if (count) {
+ *count += 1;
+ }
+ }
+ }
+ current = next;
+ }
+ }
+}
+
+/*tex
+ This could of course be done in a \LUA\ loop but this is likely to be applied always so we
+ provide a helper, also because we need to check the font. Adding this sort of violates the
+ principle that we should this in \LUA\ instead but this time I permits myself to cheat.
+*/
+
+void tex_soften_hyphens(halfword head, int *found, int *replaced)
+{
+ halfword current = head;
+ while (current) {
+ switch (node_type(current)) {
+ case glyph_node:
+ {
+ if (glyph_character(current) == 0x2D) {
+ /*
+ We actually need a callback for this? Or we can have a nested loop
+ helper in the nodelib.
+ */
+ ++(*found);
+ switch (glyph_discpart(current)) {
+ case glyph_discpart_unset:
+ /*tex Never seen by any disc handler. */
+ set_glyph_discpart(current, glyph_discpart_always);
+ case glyph_discpart_always:
+ /*tex A hard coded - in the input. */
+ break;
+ default :
+ if (tex_char_exists(glyph_font(current), 0xAD)) {
+ ++(*replaced);
+ glyph_character(current) = 0xAD;
+ }
+ break;
+ }
+ }
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ {
+ halfword list = box_list(current);
+ if (list) {
+ tex_soften_hyphens(list, found, replaced);
+ }
+ break;
+ }
+ }
+ current = node_next(current);
+ }
+}
+
+halfword tex_harden_spaces(halfword head, halfword tolerance, int* count)
+{
+ /* todo: take the context code */
+ (void) tolerance;
+ (void) count;
+ return head;
+}
+
+halfword tex_get_special_node_list(special_node_list_types list, halfword *tail)
+{
+ halfword h = null;
+ halfword t = null;
+ switch (list) {
+ case page_insert_list_type:
+ h = node_next(page_insert_head);
+ if (h == page_insert_head) {
+ h = null;
+ }
+ break;
+ case contribute_list_type:
+ h = node_next(contribute_head);
+ break;
+ case page_list_type:
+ h = node_next(page_head);
+ t = lmt_page_builder_state.page_tail;
+ break;
+ case temp_list_type:
+ h = node_next(temp_head);
+ break;
+ case hold_list_type:
+ h = node_next(hold_head);
+ break;
+ case post_adjust_list_type:
+ h = node_next(post_adjust_head);
+ t = lmt_packaging_state.post_adjust_tail;
+ break;
+ case pre_adjust_list_type:
+ h = node_next(pre_adjust_head);
+ t = lmt_packaging_state.pre_adjust_tail;
+ break;
+ case post_migrate_list_type:
+ h = node_next(post_migrate_head);
+ t = lmt_packaging_state.post_migrate_tail;
+ break;
+ case pre_migrate_list_type:
+ h = node_next(pre_migrate_head);
+ t = lmt_packaging_state.pre_migrate_tail;
+ break;
+ case align_list_type:
+ h = node_next(align_head);
+ break;
+ case page_discards_list_type:
+ h = lmt_packaging_state.page_discards_head;
+ break;
+ case split_discards_list_type:
+ h = lmt_packaging_state.split_discards_head;
+ break;
+ }
+ node_prev(h) = null;
+ if (tail) {
+ *tail = t ? t : (h ? tex_tail_of_node_list(h) : null);
+ }
+ return h;
+};
+
+int tex_is_special_node_list(halfword n, int *istail)
+{
+ if (istail) {
+ *istail = 0;
+ }
+ if (! n) {
+ return -1;
+ } else if (n == node_next(page_insert_head)) {
+ return page_insert_list_type;
+ } else if (n == node_next(contribute_head)) {
+ return contribute_list_type;
+ } else if (n == node_next(page_head) || n == lmt_page_builder_state.page_tail) {
+ if (istail && n == lmt_page_builder_state.page_tail) {
+ *istail = 0;
+ }
+ return page_list_type;
+ } else if (n == node_next(temp_head)) {
+ return temp_list_type;
+ } else if (n == node_next(hold_head)) {
+ return hold_list_type;
+ } else if (n == node_next(post_adjust_head) || n == lmt_packaging_state.post_adjust_tail) {
+ if (istail && n == lmt_packaging_state.post_adjust_tail) {
+ *istail = 0;
+ }
+ return post_adjust_list_type;
+ } else if (n == node_next(pre_adjust_head) || n == lmt_packaging_state.pre_adjust_tail) {
+ if (istail && n == lmt_packaging_state.pre_adjust_tail) {
+ *istail = 0;
+ }
+ return pre_adjust_list_type;
+ } else if (n == node_next(post_migrate_head) || n == lmt_packaging_state.post_migrate_tail) {
+ if (istail && n == lmt_packaging_state.post_migrate_tail) {
+ *istail = 0;
+ }
+ return post_migrate_list_type;
+ } else if (n == node_next(pre_migrate_head) || n == lmt_packaging_state.pre_migrate_tail) {
+ if (istail && n == lmt_packaging_state.pre_migrate_tail) {
+ *istail = 0;
+ }
+ return pre_migrate_list_type;
+ } else if (n == node_next(align_head)) {
+ return align_list_type;
+ } else if (n == lmt_packaging_state.page_discards_head) {
+ return page_discards_list_type;
+ } else if (n == lmt_packaging_state.split_discards_head) {
+ return split_discards_list_type;
+ // } else if (n == lmt_page_builder_state.best_page_break) {
+ // return 10000;
+ } else {
+ return -1;
+ }
+};
+
+void tex_set_special_node_list(special_node_list_types list, halfword head)
+{
+ switch (list) {
+ case page_insert_list_type:
+ /*tex This is a circular list where page_insert_head stays. */
+ if (head) {
+ node_next(page_insert_head) = head;
+ node_next(tex_tail_of_node_list(head)) = page_insert_head;
+ } else {
+ node_next(page_insert_head) = page_insert_head;
+ }
+ break;
+ case contribute_list_type:
+ node_next(contribute_head) = head;
+ contribute_tail = head ? tex_tail_of_node_list(head) : contribute_head;
+ break;
+ case page_list_type:
+ node_next(page_head) = head;
+ lmt_page_builder_state.page_tail = head ? tex_tail_of_node_list(head) : page_head;
+ break;
+ case temp_list_type:
+ node_next(temp_head) = head;
+ break;
+ case hold_list_type:
+ node_next(hold_head) = head;
+ break;
+ case post_adjust_list_type:
+ node_next(post_adjust_head) = head;
+ lmt_packaging_state.post_adjust_tail = head ? tex_tail_of_node_list(head) : post_adjust_head;
+ break;
+ case pre_adjust_list_type:
+ node_next(pre_adjust_head) = head;
+ lmt_packaging_state.pre_adjust_tail = head ? tex_tail_of_node_list(head) : pre_adjust_head;
+ break;
+ case post_migrate_list_type:
+ node_next(post_migrate_head) = head;
+ lmt_packaging_state.post_migrate_tail = head ? tex_tail_of_node_list(head) : post_migrate_head;
+ break;
+ case pre_migrate_list_type:
+ node_next(pre_migrate_head) = head;
+ lmt_packaging_state.pre_migrate_tail = head ? tex_tail_of_node_list(head) : pre_migrate_head;
+ break;
+ case align_list_type:
+ node_next(align_head) = head;
+ break;
+ case page_discards_list_type:
+ lmt_packaging_state.page_discards_head = head;
+ break;
+ case split_discards_list_type:
+ lmt_packaging_state.split_discards_head = head;
+ break;
+ }
+};
+
+scaled tex_effective_glue(halfword parent, halfword glue)
+{
+ if (parent && glue) {
+ switch (node_type(glue)) {
+ case glue_node:
+ case glue_spec_node:
+ switch (node_type(parent)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ double w = (double) glue_amount(glue);
+ switch (box_glue_sign(parent)) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(glue) == box_glue_order(parent)) {
+ w += glue_stretch(glue) * (double) box_glue_set(parent);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(glue) == box_glue_order(parent)) {
+ w -= glue_shrink(glue) * (double) box_glue_set(parent);
+ }
+ break;
+ }
+ return (scaled) lmt_roundedfloat(w);
+ }
+ default:
+ return glue_amount(glue);
+ }
+ break;
+ }
+ }
+ return 0;
+}
diff --git a/source/luametatex/source/tex/texnodes.h b/source/luametatex/source/tex/texnodes.h
new file mode 100644
index 000000000..f0d20e1e9
--- /dev/null
+++ b/source/luametatex/source/tex/texnodes.h
@@ -0,0 +1,2728 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXNODES_H
+# define LMT_TEXNODES_H
+
+/*tex
+
+ We can probably ditch |volatile| so that the compiler can optimize access a bit better. We
+ only need to make sure that we create nodes before we use their pointers. So, beware: a
+ newnode has to go via an intermediate variable because the |varmem| array can have been be
+ reallocated. I need to (re)check all cases! In case of a copy we use a intermediate volatile
+ variable.
+
+ Anyway, we now have only a few |quarterwords| in use, most noticeably the type and subtype.
+ Eventually I might go for a consistent
+
+ type subtype
+ prev next
+ attribute data
+ etc
+
+ model. Or maybe even just a flat list, no need for memoryword, but just all halfwords. However,
+ it will demand all kind of tiny adaptations and we don't gain much. We'd also loose some charm
+ of traditional \TEX. Also, we now have a double glue related field and that would then become
+ a float. So, not now.
+
+ There are a few more node types than in standard \TEX, but less than we have in e.g.\ \PDFTEX\
+ or stock \LUATEX. For instance margin nodes are now just kern nodes, some whatits are first
+ class nodes and we have only one generic whatsit left. We also have more subtypes which makes
+ a more detailed tracking of where nodes come from possible. Other nodes, like the |inserting|
+ and |split_up| nodes are ot both |inserting| but with a subtype because the register index is
+ no longer the subtype.
+
+ Not all nodes can end up in a node list. Some are used for housekeeping (stack, expressions,
+ conditional nesting, etc.) or show up in the process of breaking paragraphs into lines. When
+ we talk of nodes with users in the perspective of \TEX\ we normally refer to the ones in
+ horizontal and vertical lists or math lists, not to those more obscure housekeeping nodes. It
+ just happens that they share the same memory model and management.
+
+ A complication is that some nodes have pointers that themselves point to a (often smaller)
+ node but use the same accessors. This means that (1) their layout should be the same with
+ respect to the pointer, which happens with span nodes or (2) that there is some offset in play,
+ which happens with ins pointers and break nodes that are embedded in a disc node.
+
+ Now that we no longer have variable nodes, we can consider a different allocation model, like
+ a chain of malloced nodes but on the other hand storing them might be more work. We also cannot
+ longer share the accessors so again more work is needed. But ... maybe attributes might end up
+ as allocated lists some day, but that also demands storage. The current memory management is
+ very efficient and we don't gain anything with redoing that, apart maybe from nodes becoming
+ structs. Even then we will have an array of pointers instead of what we have now, but without
+ the jumps by side in the indices. So, given the constraints of offsets and overlap it makes no
+ sense to waste time on this.
+
+ Instead of |var_mem| we use |nodes| and related names. This better complements the additional
+ variables that we have for dynamic management. Some more names have been changed (also in order
+ to avoid side effect in syntax highlighting). Too common names also result in too many matches
+ when searching the source tree.
+
+ Soo, eventually most fields now have the type of the node in their name, which makes it more
+ clear what they are. As mentioned, it makes the syntax highlighted source look better as some
+ generic names are used elsewhere too. Another reason is that we have more fields in nodes and
+ when browsing the source it helps to know that a |width| is actually the |glue_amount| which
+ when we go down is actually a height anyway. It also makes it possible at some point to make
+ some nodes smaller when we don't need these \quote {shared by name} fields. We also need this
+ transition in order to get better interfacing to the \LUA\ end, one reason being that we need
+ to distinguish between fields that overlap (as in lists, unset nodes and and alignment
+ records).
+
+ Todo: all subtype related constants will become |_subtype| so that also means a couple more
+ _code ones for commands. It's all about consistency but that will happen stepwise. A typical
+ rainy day with some newly acquired music in background kind of activity:
+
+ - discretionary
+ - adjust
+ - noad
+ - fence
+ - radical
+ - boundary
+
+*/
+
+typedef enum node_types {
+ hlist_node,
+ vlist_node,
+ rule_node,
+ insert_node,
+ mark_node,
+ adjust_node,
+ boundary_node,
+ disc_node,
+ whatsit_node,
+ /*tex The last_preceding_break_node: */
+ par_node,
+ dir_node,
+ /*tex The last_non_discardable_node: */
+ math_node,
+ glue_node,
+ kern_node,
+ penalty_node,
+ style_node,
+ choice_node,
+ parameter_node,
+ simple_noad,
+ radical_noad,
+ fraction_noad,
+ accent_noad,
+ fence_noad,
+ math_char_node,
+ math_text_char_node,
+ sub_box_node,
+ sub_mlist_node,
+ delimiter_node,
+ glyph_node,
+ /*tex This was the last node with attributes, except unset nodes. */
+ unset_node,
+ specification_node,
+ align_record_node,
+ attribute_node,
+ glue_spec_node,
+ temp_node,
+ split_node,
+ /*tex The next set of nodes is invisible from the \LUA\ (but nesting nodes can show up). */
+ expression_node,
+ math_spec_node,
+ font_spec_node,
+ nesting_node,
+ span_node,
+ align_stack_node,
+ noad_state_node,
+ if_node,
+ unhyphenated_node, /*tex These are both active nodes. */
+ hyphenated_node, /*tex These are both active nodes. */
+ delta_node,
+ passive_node,
+} node_types;
+
+# define max_chain_size 32
+
+# define unknown_node_type -1
+# define unknown_node_subtype -1
+
+/* Todo: [type] [subtype|size] [index] -> nodes : advantage is no holes in node id's */
+
+typedef struct node_memory_state_info {
+ memoryword *nodes;
+ // memoryword *volatile nodes;
+ char *nodesizes;
+ halfword free_chain[max_chain_size];
+ memory_data nodes_data;
+ memory_data extra_data;
+ int reserved; /*tex There are some predefined nodes. */
+ int padding;
+ int node_properties_id;
+ int lua_properties_level;
+ halfword attribute_cache;
+ halfword max_used_attribute;
+ int node_properties_table_size;
+} node_memory_state_info;
+
+extern node_memory_state_info lmt_node_memory_state;
+
+typedef enum field_types {
+ nil_field,
+ integer_field,
+ dimension_field,
+ glue_field,
+ number_field,
+ string_field,
+ boolean_field,
+ function_field,
+ node_field,
+ node_list_field,
+ token_field,
+ token_list_field,
+ attribute_field,
+} field_types;
+
+extern halfword tex_get_node (int size);
+extern void tex_free_node (halfword p, int size);
+extern void tex_dump_node_mem (dumpstream f);
+extern void tex_undump_node_mem (dumpstream f);
+extern void tex_initialize_node_mem (void);
+extern void tex_initialize_nodes (void);
+
+extern void lmt_nodelib_initialize (void); /* name ? */
+
+/*tex
+
+ Most fields are integers (halfwords) that get aliased to |vinfo| and |vlink| for traditional
+ reasons. The |vlink| name is actually representing a next pointer. Only the type and subtype
+ remain quarterwords, the rest are just halfwords which wastes space for directions,
+ orientation, glue orders and glue signs but so be it.
+
+ A memory word has two 32 bit integers so 8 bytes. A glueratio is a double which is 8 bytes so
+ there we waste some space. There is actually no need now to pack (node) data in pairs so maybe
+ some day I'll change that. When we make glue ration a float again we can go flat (and with most
+ node fields now being fully qualified that is easier).
+
+ The first memoryword contains the |type| and |subtype| that are both 16 bit integers (unsigned)
+ as well as the |vlink| (next) pointer. After that comes the word that keeps the |attr| and
+ |alink| (prev) fields. Instead of the link names we use more meaningful ones. The |next|, |prev|
+ and |attr| fields all are halfwords representing a node index.
+
+ The |node_size| field is used in managing freed nodes (mostly as a check) and it overwrites the
+ |type| and |subtype| fields. Actually we could just use the type or subtype but as the size is
+ small but on the other hand using an int here makes sense.
+
+ half0 | quart0 quart1 | vinfo | size | type subtype
+ half1 | | vlink
+
+ The |tlink| and |rlink| fields are used in disc nodes as tail and replace pointers (again
+ halfwords). We no longer need |rlink| as it's equivalent to |alink| (the prev pointer). The
+ |tlink| fields is used for links to the tail of a list. These indirect macros are somewhat
+ complicating matters. Again these have been renamed.
+
+ We used to have |alink(a)| being |vlink(a,1)| but that has (after a few years) been replaced by
+ |node_prev| because is cleaner. Keep in mind that in \LUATEX\ we use double linked node lists. So,
+ we now only have some \quote {hard coded} pointers to the memory array in this file, not in the
+ files that use the node fields. However, for the next two paragraphs to be true, I need to find
+ a solution for the insert_ptr first because that is an index.
+
+ Now, a logical question is: should we stick to the link and info model for nodes? One reason
+ is that we share the model with tokens. A less relevant reason is that the glue is stored in 8
+ bytes but that can be reverted to 4 bytes if needed. So, indeed at some point we might see a 32
+ bit wide array show up here as we're now more or less prepared for that. It will bump the direct
+ node numbers but that should work out okay. So, in the end, after stepwise abstraction we now
+ have field definitions that use a base and offset e.g. |vlink(a,3)| instead of |vlink(a+3)|.
+ Also, we have many more fields and using meaningful names quickly started to make sense.
+
+ Once all is stable I will play with |var_mem| being an array of pointers and |malloc| the
+ smaller memoryword arrays (per node). This might lead to (not always) smaller memory footprint:
+ we have one pointer per node (but only that array gets preallocated) but we need less memory in
+ total, unless we use many nodes. Anyway, we keep the indirect model (which might add overhead,
+ but that can be compensated by \CPU\ caches) because using a numeric node pointer is more
+ efficient and quite handy. If we would go completely struct the source would change so much that
+ we loose the charm of \TEX\ and documentation and there is no gain in it. Also, using halfword
+ indices (but then to pointers) for nodes has the huge advantage that it is fast in \LUA\ (always
+ a bottleneck) and these node indices can (and have to) be stored in tokens. One nice side effect
+ would be that we have node indices in a sequence (without the current jumps due to node size
+ offset, which in turn gives more room for nodes references in tokens).
+
+ In spite of all extensions we hope the spirit of how \TEX\ does it is still very visible.
+
+*/
+
+# define mvalue(a,b) lmt_node_memory_state.nodes[a+b].P
+# define lvalue(a,b) lmt_node_memory_state.nodes[a+b].L
+# define dvalue(a,b) lmt_node_memory_state.nodes[a+b].D
+
+# define vinfo(a,b) lmt_node_memory_state.nodes[a+b].half0
+# define vlink(a,b) lmt_node_memory_state.nodes[a+b].half1
+
+# define vinfo0(a,b) lmt_node_memory_state.nodes[a+b].quart00
+# define vinfo1(a,b) lmt_node_memory_state.nodes[a+b].quart01
+# define vlink0(a,b) lmt_node_memory_state.nodes[a+b].quart10
+# define vlink1(a,b) lmt_node_memory_state.nodes[a+b].quart11
+
+# define vinfo00(a,b) lmt_node_memory_state.nodes[a+b].single00
+# define vinfo01(a,b) lmt_node_memory_state.nodes[a+b].single01
+# define vinfo02(a,b) lmt_node_memory_state.nodes[a+b].single02
+# define vinfo03(a,b) lmt_node_memory_state.nodes[a+b].single03
+# define vlink00(a,b) lmt_node_memory_state.nodes[a+b].single10
+# define vlink01(a,b) lmt_node_memory_state.nodes[a+b].single11
+# define vlink02(a,b) lmt_node_memory_state.nodes[a+b].single12
+# define vlink03(a,b) lmt_node_memory_state.nodes[a+b].single13
+
+/*tex
+ We have some shared field names. Some day the subtypes will get meaningful names dependent on
+ the node type, if only because some already have. We used to have
+
+ \starttyping
+ # define type(a) vinfo0(a,0)
+ # define subtype(a) vinfo1(a,0)
+ # define node_size(a) vinfo(a,0)
+ \stoptyping
+
+ but we dropped the size mechanism and made most field shortcuts verbose in order to be able to
+ use variable names with the same name combined with proper syntax highlighting etc. It also
+ gives less noise when we search in the whole source tree. More later.
+*/
+
+# define node_type(a) vinfo0(a,0)
+# define node_subtype(a) vinfo1(a,0)
+
+# define node_next(a) vlink(a,0)
+# define node_prev(a) vlink(a,1)
+# define node_attr(a) vinfo(a,1)
+
+# define node_head(a) vlink(a,0) /*tex the head |hlink(a)| aka |vlink(a)| of a disc sublist */
+# define node_tail(a) vinfo(a,1) /*tex the tail |tlink(a)| aka |vinfo(a)|, overlaps with |node_attr()| */
+
+/*tex
+
+ The dimension fields shared their locations which made for sometimes more compact code but
+ in the end the number of placxes where it really saved code were limited. Also, compilers will
+ do their job and deal with common code. So, these are now replaced by more meaningful names:
+
+ \starttyping
+ # define width(a) vlink(a,2)
+ # define depth(a) vlink(a,3)
+ # define height(a) vlink(a,4)
+ \stoptyping
+
+ Inserts use a trick. The insert pointers directly point into a node at the place where the list
+ starts which is why |list_ptr| has to overlap with |node_next|! I have looked into changign this
+ but it doesn't pay off and it's best to stay close to the original. A side effect is that some
+ fields in insert nodes are sort of impossible (for now).
+
+ \starttyping
+ # define box_list_ptr(a) vlink(a,5) // We need to use the same field as |node_next|.
+ # define insert_list(a) (a + 5) // This kind of makes a virtual node: start at list.
+ \stoptyping
+
+ Beware of the fact that for instance alignments use some fields for other purposes, like:
+ |u_part(a)|, |v_part(a)|, |span_ptr(a)|, etc. and assume the rest of the fields to overlap
+ with list nodes. So, we cannot simply reshuffle positions!
+
+ In the original \TEX\ source (and also in \LUATEX) there are a couple of offsets used. Most
+ noticeably is the |list_offset| but in 2.0618 the related trickery was replaced by using
+ |list_ptr| and using the fact that we have a doubel linked list. The four fields are in
+ successive memory words and that means that we can use |node_next| in a field pointed to
+ by |list_offset| (because actually we then have the list pointer!). This makes for simple
+ loops in original \TEX. The dimension offsets are used to set fields in boxed but we already
+ abstracted that to proper field names; these were for instance used in alignment nodes that
+ have mostly the same properties as a box node.
+
+ \starttyping
+ # define width_offset 2
+ # define depth_offset 3
+ # define height_offset 4
+ # define list_offset 5
+ \stoptyping
+
+ These abstractions mean that we now have nodes, fields and offsets all abstracted in such a way
+ that all definitions and trickery in in this file. Of course I could have messed up.
+
+*/
+
+/*tex
+
+ Syntex supports demands some extra fields in nodes that makes it possible to output location as
+ well as file/line information for viewer-editor synchronization. The ideas is quite okay but
+ unfortunately the implementation of the library is rather bound to the way e.g. \LATEX\ typesets
+ documents. Synctex has always been problematic when it comes to \CONTEXT. There is for instance
+ no control over filenames and discussions around some limitations (and possible features) in the
+ \PDFTEX\ and early \LUATEX\ times never resulted in fixing that (setting filenames, adding some
+ additional synchronization points, etc). All that was supposed to happen deep down in the library
+ and was not considered to be dealt with by a macro package. For instance multiple loading of the
+ same file (metapost runs or smaple files) was a problem as was the need to block access to files
+ in tds (like styles). We also needed binding to for instance elements in an \XML\ file where line
+ numbers are sort of special and out of sync with inclusion. I guess we were ahead of the pack
+ because after nearly two decades of \LUATEX\ there is some discussion about this.
+
+ Anyway, for the reasons mentioned \LUATEX\ offers some setters that overload the engine ones and
+ that permits \CONTEXT\ to implement its own variant. However, in \LUAMETATEX\ setting tags and
+ lines from \LUA\ is now the only way to support \SYNCTEX\ because the library is absent: we just
+ have some extra fields in some nodes. In \LUAMETATEX\ only glyph and list nodes have these fields
+ as it makes no sense to have them elsewhere: macro packages can add glue and kerns and rules and
+ \unknown\ all over the place and adding file state info there only makes things confusing and
+ working less well. This is what the mode parameter can handle in \LUATEX\ and in \LUAMETATEX\ it
+ only supports the modes 1 and 3.
+
+ As a side note: the fact that a viewer needs to embed the library is also a limitation. Calling
+ out to an external program that analyzes the file and gives back the filename and line is more
+ flexible and robust. Because we have such an analyzer in \MKIV\ it was no big deal to add a few
+ lines so that the \TEX shop environment could use that script/method (bidirectional); hopefully
+ other viewers and editors will follow.
+
+ So, compared to \LUATEX\ less nodes have the extra fields (which saves memory) and therefore
+ less has to be set. Because there is no library at all, writing a synctex file is up to some
+ additional \LUA\ code, but that was already the case in \MKIV\ anyway. We might at some point
+ change the field names to \quote {file} and \quote {line} and remove interface options that
+ have no use any more. We also moved to a more generic naming of (input related) fields.
+
+*/
+
+/*
+
+ Temporary nodes are really special head node pointers that only need links. They ensure that
+ there is at least one node in a list.
+
+*/
+
+# define temp_node_size 2
+
+/*tex
+
+ In \LUATEX\ we have attribute list nodes and attribute nodes that are (anyway) of the same
+ size. In the end I decided to combine them into one node with a subtype. That also helps
+ diagnose issues. It is one of the few nodes now that has fields depending on the subtype
+ but these nodes are not really user ones anyway.
+
+*/
+
+# define attribute_node_size 2
+# define attribute_unset(a) vinfo(a,1)
+# define attribute_index(a) vinfo(a,1) /*tex actually we need half of this */
+# define attribute_count(a) vlink(a,1) /*tex the reference count */
+# define attribute_value(a) vlink(a,1)
+
+typedef enum attribute_subtypes {
+ attribute_list_subtype,
+ attribute_value_subtype,
+} attribute_subtypes;
+
+# define last_attribute_subtype attribute_value_subtype
+
+/*tex
+ Penalties have only one primitive so we don't have |_code| here, also because it would conflict
+ with arguments.
+*/
+
+# define penalty_node_size 3
+# define penalty_amount(a) vlink(a,2)
+
+typedef enum penalty_subtypes {
+ user_penalty_subtype,
+ linebreak_penalty_subtype, /*tex includes widow, club, broken etc. */
+ line_penalty_subtype,
+ word_penalty_subtype,
+ orphan_penalty_subtype,
+ final_penalty_subtype,
+ math_pre_penalty_subtype,
+ math_post_penalty_subtype,
+ before_display_penalty_subtype,
+ after_display_penalty_subtype,
+ equation_number_penalty_subtype,
+} penalty_subtypes;
+
+# define last_penalty_subtype equation_number_penalty_subtype
+
+/*tex
+ We have plenty of glue variables and in the node lists most are also flagged. There is no
+ one|-|to|-|one correspondence between the codes (in tokens) and subtypes (in nodes) as listed
+ below, but they come close. The special math related glues and inserts now have nicer numbers.
+*/
+
+typedef enum glue_subtypes {
+ user_skip_glue,
+ line_skip_glue,
+ baseline_skip_glue,
+ par_skip_glue,
+ above_display_skip_glue,
+ below_display_skip_glue,
+ above_display_short_skip_glue,
+ below_display_short_skip_glue,
+ left_skip_glue,
+ right_skip_glue,
+ top_skip_glue,
+ split_top_skip_glue,
+ tab_skip_glue,
+ space_skip_glue,
+ xspace_skip_glue,
+ zero_space_skip_glue,
+ par_fill_right_skip_glue,
+ par_fill_left_skip_glue,
+ par_init_right_skip_glue,
+ par_init_left_skip_glue,
+ indent_skip_glue,
+ left_hang_skip_glue,
+ right_hang_skip_glue,
+ correction_skip_glue,
+ inter_math_skip_glue,
+ ignored_glue, /*tex |subtype| for cases where we ignore zero glue (alignments) */
+ page_glue, /*tex |subtype| used in the page builder */
+ /*tex math */
+ math_skip_glue,
+ thin_mu_skip_glue,
+ med_mu_skip_glue,
+ thick_mu_skip_glue,
+ /*tex more math */
+ conditional_math_glue, /*tex special |subtype| to suppress glue in the next node */ /* no need for jump */
+ rulebased_math_glue,
+ mu_glue, /*tex |subtype| for math glue */
+ /*tex leaders (glue with list) */
+ a_leaders, /*tex |subtype| for aligned leaders */
+ c_leaders, /*tex |subtype| for centered leaders */
+ x_leaders, /*tex |subtype| for expanded leaders */
+ g_leaders, /*tex |subtype| for global (page) leaders */
+ u_leaders,
+} glue_subtypes;
+
+# define last_glue_subtype u_leaders
+
+typedef enum skip_glue_codes_alias {
+ par_fill_skip_glue = par_fill_right_skip_glue,
+} skip_glue_codes_alias;
+
+# define is_leader(a) (node_subtype(a) >= a_leaders)
+
+# define glue_node_size 7
+# define glue_spec_size 5
+# define glue_data(a) vinfo(a,2) /* ignored in spec */
+# define glue_amount(a) vlink(a,2)
+# define glue_shrink(a) vinfo(a,3)
+# define glue_stretch(a) vlink(a,3)
+# define glue_stretch_order(a) vinfo(a,4)
+# define glue_shrink_order(a) vlink(a,4)
+# define glue_font(a) vinfo(a,5) /* not in spec */ /* when inter_math_skip_glue: parameter */
+# define glue_leader_ptr(a) vlink(a,5) /* not in spec */
+# define glue_options(a) vinfo(a,6) /* not in spec */ /* for now only internal */
+# define glue_unused(a) vlink(a,6) /* not in spec */
+
+inline static void tex_add_glue_option (halfword a, halfword r) { glue_options(a) |= r; }
+inline static void tex_remove_glue_option (halfword a, halfword r) { glue_options(a) &= ~(r | glue_options(a)); }
+inline static int tex_has_glue_option (halfword a, halfword r) { return (glue_options(a) & r) == r; }
+
+typedef enum glue_option_codes {
+ glue_option_normal = 0x0000,
+ // glue_force_auto_break = 0x0001,
+ // glue_originates_in_math = 0x0002,
+ glue_option_no_auto_break = 0x0001,
+} glue_option_codes;
+
+typedef enum math_subtypes {
+ begin_inline_math,
+ end_inline_math
+} math_subtypes;
+
+# define last_math_subtype end_inline_math
+
+/*tex
+ Math nodes (currently) partially overlap with glue because they also have a glue property.
+*/
+
+# define math_node_size 6
+# define math_surround(a) vinfo(a,2)
+# define math_amount(a) vlink(a,2)
+# define math_shrink(a) vinfo(a,3)
+# define math_stretch(a) vlink(a,3)
+# define math_stretch_order(a) vinfo(a,4)
+# define math_shrink_order(a) vlink(a,4)
+# define math_penalty(a) vinfo(a,5)
+# define math_options(a) vlink(a,5)
+
+inline static void tex_add_math_option (halfword a, halfword r) { math_options(a) |= r; }
+inline static void tex_remove_math_option (halfword a, halfword r) { math_options(a) &= ~(r | math_options(a)); }
+inline static int tex_has_math_option (halfword a, halfword r) { return (math_options(a) & r) == r; }
+
+/*tex Here are some (inline) helpers. We need specific ones for math glue. */
+
+inline static int tex_glue_is_zero(halfword g)
+{
+ return (! g) || ((glue_amount(g) == 0) && (glue_stretch(g) == 0) && (glue_shrink(g) == 0));
+}
+
+inline static int tex_math_glue_is_zero(halfword g)
+{
+ return (! g) || ((math_amount(g) == 0) && (math_stretch(g) == 0) && (math_shrink(g) == 0));
+}
+
+inline static int tex_same_glue(halfword a, halfword b)
+{
+ return
+ (a == b) /* same glue specs or both zero */
+ || (a && b && glue_amount(a) == glue_amount(b)
+ && glue_stretch(a) == glue_stretch(b)
+ && glue_shrink(a) == glue_shrink(b)
+ && glue_stretch_order(a) == glue_stretch_order(b)
+ && glue_shrink_order(a) == glue_shrink_order(b)
+ )
+ ;
+}
+
+inline static void tex_reset_glue_to_zero(halfword target)
+{
+ if (target) {
+ glue_amount(target) = 0;
+ glue_stretch(target) = 0;
+ glue_shrink(target) = 0;
+ glue_stretch_order(target) = 0;
+ glue_shrink_order(target) = 0;
+ }
+}
+
+inline static void tex_reset_math_glue_to_zero(halfword target)
+{
+ if (target) {
+ math_amount(target) = 0;
+ math_stretch(target) = 0;
+ math_shrink(target) = 0;
+ math_stretch_order(target) = 0;
+ math_shrink_order(target) = 0;
+ }
+}
+
+inline static void tex_copy_glue_values(halfword target, halfword source)
+{
+ if (source) {
+ glue_amount(target) = glue_amount(source);
+ glue_stretch(target) = glue_stretch(source);
+ glue_shrink(target) = glue_shrink(source);
+ glue_stretch_order(target) = glue_stretch_order(source);
+ glue_shrink_order(target) = glue_shrink_order(source);
+ } else {
+ glue_amount(target) = 0;
+ glue_stretch(target) = 0;
+ glue_shrink(target) = 0;
+ glue_stretch_order(target) = 0;
+ glue_shrink_order(target) = 0;
+ }
+}
+
+inline static int tex_is_par_init_glue(halfword n)
+{
+ switch (node_subtype(n)) {
+ case indent_skip_glue:
+ case par_init_left_skip_glue:
+ case par_init_right_skip_glue:
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+/*tex
+ Kern nodes are relatively simple. Instead of |width| we use |kern_amount| which makes more
+ sense: we can go left, right, up or down. Margin kerns have been dropped and are now just a
+ special subtype of regular kerns.
+*/
+
+typedef enum kern_subtypes {
+ font_kern_subtype,
+ explicit_kern_subtype, /*tex |subtype| of kern nodes from |\kern| and |\/| */
+ accent_kern_subtype, /*tex |subtype| of kern nodes from accents */
+ italic_kern_subtype,
+ left_margin_kern_subtype,
+ right_margin_kern_subtype,
+ explicit_math_kern_subtype,
+ math_shape_kern_subtype,
+ horizontal_math_kern_subtype,
+ vertical_math_kern_subtype,
+} kern_subtypes;
+
+# define last_kern_subtype vertical_math_kern_subtype
+
+# define kern_node_size 3
+# define kern_amount(a) vlink(a,2) /*tex aka |width = vlink(a,2)| */
+# define kern_expansion(a) vinfo(a,2) /*tex expansion factor (hz) */
+
+inline static int tex_is_margin_kern(halfword n)
+{
+ return (n && node_type(n) == kern_node && (node_subtype(n) == left_margin_kern_subtype || node_subtype(n) == right_margin_kern_subtype));
+}
+
+/*tex
+
+ Disc nodes are complicated: they have three embedded nesting nodes to which the |pre_break|,
+ |post_break| and |no_break| fields point. In there we find a head pointer (|vlink| aka |hlink|)
+ and tail pointer (|tlink|). The |alink| pointer is used in the base mode font machinery and is
+ not really a prev pointer. We have to make sure it gets nilled when we communicate with \LUA.
+
+ The no-, pre-, and postbreak fields point to nesting nodes that are part of the disc node (three
+ times two memorywords). Sometimes these nodes are actually used, for instance when a temp node
+ is expected at the head of a list. The layout is:
+
+ \starttyping
+ [ type+subtype + next ]
+ [ attr + prev ]
+ [ penalty + nobreak ]
+ [ prebreak + postbreak ]
+ [ type+subtype next/hlink ] (nesting node prebreak)
+ [ tlink prev ]
+ [ type+subtype next/hlink ] (nesting node postbreak)
+ [ tlink prev ]
+ [ type+subtype next/hlink ] (nesting node nobreak)
+ [ tlink prev ]
+ \stoptyping
+
+ Another reason why we need the indirect apoproach is that we can set the fields to |null| which
+ is better than point to a nest node with no following up.
+
+*/
+
+/*tex
+ Among the dropped nodes (\LUATEX\ has them) are movements nodes (used in the \DVI\ backend)
+ and variable nodes (replaced by specification nodes).
+
+ Nesting nodes are really simple and just use the common type, subtype and next fields so they
+ have no dedicated fields. They can be part of another node type (like disc nodes).
+*/
+
+# define nesting_node_size 2
+
+typedef enum nesting_subtypes {
+ pre_break_code,
+ post_break_code,
+ no_break_code,
+ insert_head_code,
+ unset_nesting_code,
+} nesting_subtypes;
+
+# define last_nesting_subtype unset_nesting_code
+
+/*tex Here the codes in commands and subtypes are in sync. */
+
+typedef enum discretionary_subtypes {
+ normal_discretionary_code,
+ explicit_discretionary_code,
+ automatic_discretionary_code,
+ mathematics_discretionary_code,
+ syllable_discretionary_code,
+} discretionary_subtypes;
+
+# define last_discretionary_subtype syllable_discretionary_code
+# define last_discretionary_code automatic_discretionary_code
+
+typedef enum disc_options {
+ disc_option_normal_word = 0x0,
+ disc_option_pre_word = 0x1,
+ disc_option_post_word = 0x2,
+} disc_options;
+
+# define disc_node_size 13
+# define disc_no_break(a) vlink(a,2) /* beware: vinfo is used for type/subtype */
+# define disc_pre_break(a) vlink(a,3) /* beware: vinfo is used for type/subtype */
+# define disc_post_break(a) vlink(a,4) /* beware: vinfo is used for type/subtype */
+/* disc_no_break_node 5 6 */ /* this is a nesting node of size 2 */
+/* disc_pre_break_node 7 8 */ /* this is a nesting node of size 2 */
+/* disc_post_break_node 9 10 */ /* this is a nesting node of size 2 */
+# define disc_penalty(a) vinfo(a,11)
+# define disc_options(a) vlink(a,11)
+# define disc_class(a) vinfo(a,12)
+# define disc_unused(a) vlink(a,12)
+
+# define set_disc_penalty(a,b) disc_penalty(a) = b
+# define set_disc_class(a,b) disc_class(a) = b
+# define set_disc_options(a,b) disc_options(a) = b
+# define set_disc_option(a,b) disc_options(a) |= b
+
+# define has_disc_option(a,b) ((disc_options(a) & b) == b)
+
+# define unset_disc_class -1
+
+/*tex
+ These are pseudo nodes inside a node. We used to reference them by |*_break_head| but now call
+ just call them nodes so that we can use head and tail instead of hlink and tlink.
+*/
+
+# define disc_pre_break_node(a) (a+5)
+# define disc_post_break_node(a) (a+7)
+# define disc_no_break_node(a) (a+9)
+
+# define disc_pre_break_head(a) node_head(disc_pre_break_node(a))
+# define disc_post_break_head(a) node_head(disc_post_break_node(a))
+# define disc_no_break_head(a) node_head(disc_no_break_node(a))
+
+# define disc_pre_break_tail(a) node_tail(disc_pre_break_node(a))
+# define disc_post_break_tail(a) node_tail(disc_post_break_node(a))
+# define disc_no_break_tail(a) node_tail(disc_no_break_node(a))
+
+extern void tex_set_disc_field (halfword target, halfword location, halfword source);
+extern void tex_check_disc_field (halfword target);
+extern void tex_set_discpart (halfword d, halfword h, halfword t, halfword code);
+extern halfword tex_flatten_discretionaries (halfword head, int *count, int nest);
+extern void tex_flatten_leaders (halfword box, int *count);
+extern void tex_soften_hyphens (halfword head, int *found, int *replaced);
+extern halfword tex_harden_spaces (halfword head, halfword tolerance, int *count);
+
+/*tex
+ Lists need a rather large node, also because the have quite some extra possibilities, like the
+ orientation features. We can put the dir with the orientation but it becomes messy in casting
+ that way. Also, memory is not really a constraint and for a cpu cache we're better off this
+ way.
+
+ In the original setup the unset and align_record nodes have overlapping fields. This has the
+ side effect that when we access the alternates from \LUA\ that they can have weird values
+ unless we reset them. Even then, it can be that we actually want to use those other fields
+ somehow. For that reason it's better to waste a few more slots and play safe. We can now
+ actually explore table cells with offsets if we want.
+
+ Beware: in alignments
+
+ \startitemize[packed]
+ \startitem align record nodes become unset nodes \stopitem
+ \startitem unset nodes become hlist or vlist nodes \stopitem
+ \stopitemize
+*/
+
+typedef enum list_subtypes {
+ unknown_list,
+ line_list, /*tex paragraph lines */
+ hbox_list, /*tex |\hbox| */
+ indent_list, /*tex indentation box */
+ container_list, /*tex container box */
+ align_row_list, /*tex row from a |\halign| or |\valign| */
+ align_cell_list, /*tex cell from a |\halign| or |\valign| */
+ equation_list, /*tex display equation */
+ equation_number_list, /*tex display equation number */
+ math_list_list,
+ math_char_list,
+ math_pack_list,
+ math_h_extensible_list,
+ math_v_extensible_list,
+ math_h_delimiter_list,
+ math_v_delimiter_list,
+ math_over_delimiter_list,
+ math_under_delimiter_list,
+ math_numerator_list,
+ math_denominator_list,
+ math_modifier_list,
+ math_fraction_list,
+ math_nucleus_list,
+ math_sup_list,
+ math_sub_list,
+ math_pre_post_list,
+ math_degree_list,
+ math_scripts_list,
+ math_over_list,
+ math_under_list,
+ math_accent_list,
+ math_radical_list,
+ math_fence_list,
+ math_rule_list,
+ math_ghost_list,
+ insert_result_list,
+ local_list,
+ local_left_list,
+ local_right_list,
+ local_middle_list,
+} list_subtypes ;
+
+# define last_list_subtype local_middle_list
+# define noad_class_list_base 0x0100
+
+typedef enum list_anchors {
+ left_origin_anchor = 0x001,
+ left_height_anchor = 0x002,
+ left_depth_anchor = 0x003,
+ right_origin_anchor = 0x004,
+ right_height_anchor = 0x005,
+ right_depth_anchor = 0x006,
+ center_origin_anchor = 0x007,
+ center_height_anchor = 0x008,
+ center_depth_anchor = 0x009,
+ halfway_total_anchor = 0x00A,
+ halfway_height_anchor = 0x00B,
+ halfway_depth_anchor = 0x00C,
+ halfway_left_anchor = 0x00D,
+ halfway_right_anchor = 0x00E,
+} list_anchors;
+
+typedef enum list_signs {
+ negate_x_anchor = 0x100,
+ negate_y_anchor = 0x200,
+} list_signs;
+
+typedef enum list_geometries {
+ no_geometry = 0x0,
+ offset_geometry = 0x1,
+ orientation_geometry = 0x2,
+ anchor_geometry = 0x4,
+} list_geometries;
+
+# define box_node_size 15
+# define box_width(a) vlink(a,2)
+# define box_w_offset(a) vinfo(a,2)
+# define box_depth(a) vlink(a,3)
+# define box_d_offset(a) vinfo(a,3)
+# define box_height(a) vlink(a,4)
+# define box_h_offset(a) vinfo(a,4)
+# define box_list(a) vlink(a,5) /* 5 = list_offset */
+# define box_shift_amount(a) vinfo(a,5)
+# define box_glue_order(a) vlink(a,6)
+# define box_glue_sign(a) vinfo(a,6)
+# define box_glue_set(a) dvalue(a,7) /* So we reserve a whole memory word! */
+# define box_dir(a) vlink00(a,8)
+# define box_package_state(a) vlink01(a,8)
+# define box_axis(a) vlink02(a,8)
+# define box_geometry(a) vlink03(a,8)
+# define box_orientation(a) vinfo(a,8) /* also used for size in alignments */
+# define box_x_offset(a) vlink(a,9)
+# define box_y_offset(a) vinfo(a,9)
+# define box_pre_migrated(a) vlink(a,10)
+# define box_post_migrated(a) vinfo(a,10)
+# define box_pre_adjusted(a) vlink(a,11)
+# define box_post_adjusted(a) vinfo(a,11)
+# define box_source_anchor(a) vlink(a,12)
+# define box_target_anchor(a) vinfo(a,12)
+# define box_anchor(a) vlink(a,13)
+# define box_index(a) vinfo(a,13)
+# define box_input_file(a) vlink(a,14) /* aka box_synctex_tag */
+# define box_input_line(a) vinfo(a,14) /* aka box_synctex_line */
+
+# define box_total(a) (box_height(a) + box_depth(a))
+
+inline static void tex_set_box_geometry (halfword b, halfword g) { box_geometry(b) |= (singleword) (g); }
+/* static void tex_unset_box_geometry (halfword b, halfword g) { box_geometry(b) &= (singleword) ~((singleword) (g) | box_geometry(b)); } */
+inline static void tex_unset_box_geometry (halfword b, halfword g) { box_geometry(b) &= (singleword) (~g); }
+inline static int tex_has_geometry (halfword g, halfword f) { return ((singleword) (g) & (singleword) (f)) == (singleword) (f); }
+inline static int tex_has_box_geometry (halfword b, halfword g) { return (box_geometry(b) & (singleword) (g)) == (singleword) (g); }
+
+typedef enum package_states {
+ unknown_package_state = 0x00,
+ hbox_package_state = 0x01,
+ vbox_package_state = 0x02,
+ vtop_package_state = 0x03,
+ /* maybe vcenter */
+} package_states;
+
+typedef enum package_dimension_states {
+ package_dimension_not_set = 0x00,
+ package_dimension_size_set = 0x04,
+} package_dimension_states;
+
+typedef enum package_leader_states {
+ package_u_leader_not_set = 0x00,
+ package_u_leader_set = 0x08,
+ package_u_leader_delayed = 0x10,
+} package_leader_states;
+
+# define set_box_package_state(p,s) box_package_state(p) |= s
+# define has_box_package_state(p,s) ((box_package_state(p) & s) == s)
+# define is_box_package_state(p,s) ((p & s) == s)
+
+typedef enum list_axis { /* or maybe math states */
+ no_math_axis = 0x01,
+} list_axis;
+
+# define has_box_axis(p,s) ((box_axis(p) & s) == s)
+# define set_box_axis(p,s) box_axis(p) |= (s & 0xFF)
+
+/*tex
+ These |unset| nodes have the same layout as list nodes and at some point become an |hlist| or
+ |vlist| node.
+*/
+
+# define unset_node_size box_node_size
+# define box_glue_stretch(a) box_w_offset(a)
+# define box_glue_shrink(a) box_h_offset(a)
+# define box_span_count(a) box_d_offset(a)
+# define box_size(a) box_orientation(a)
+
+/*tex
+ The |align record| nodes have the same layout as list nodes and at some point become an |unset|
+ node.
+*/
+
+# define align_record_size box_node_size
+# define align_record_span_ptr(a) box_w_offset(a) /*tex A column spanning list */
+# define align_record_cmd(a) box_h_offset(a) /*tex Info to remember during template. */
+# define align_record_chr(a) box_d_offset(a) /*tex Info to remember during template. */
+# define align_record_pre_part(a) box_x_offset(a) /*tex The pointer to |u_j| token list. */
+# define align_record_post_part(a) box_y_offset(a) /*tex The pointer to |v_j| token list. */
+# define align_record_dimension(a) box_orientation(a) /*tex Optionally enforced width. */
+
+/*tex
+ Span nodes are tricky in the sense that their |span_link| actually has to sit in the same slot
+ as |align_record_span_ptr| because we need the initial location to be the same. This is why we
+ renamed this field to |span_ptr|. Moving it to another spot than in \LUATEX\ also opens the
+ possibility for attributes to cells.
+*/
+
+# define span_node_size 3
+# define span_span(a) vinfo(a,1)
+# define span_unused(a) vlink(a,1)
+# define span_width(a) vlink(a,2) /* overlaps with |box_width(a)|. */
+# define span_ptr(a) vinfo(a,2) /* overlaps with |box_w_offset(a)| and align_record_span_ptr(a). */
+
+/*tex
+ Here the subtypes and command codes partly overlay. We actually hav eonly avery few left because
+ it's mostly a backend feature now.
+*/
+
+typedef enum rule_subtypes {
+ normal_rule_subtype,
+ empty_rule_subtype,
+ strut_rule_subtype,
+ outline_rule_subtype,
+ user_rule_subtype,
+ math_over_rule_subtype,
+ math_under_rule_subtype,
+ math_fraction_rule_subtype,
+ math_radical_rule_subtype,
+ box_rule_subtype,
+ image_rule_subtype,
+} rule_subtypes;
+
+typedef enum rule_codes {
+ normal_rule_code,
+ empty_rule_code,
+ strut_rule_code,
+} rule_codes;
+
+# define last_rule_subtype image_rule_subtype
+# define first_rule_code normal_rule_code
+# define last_rule_code strut_rule_code
+
+# define rule_node_size 7
+# define rule_width(a) vlink(a,2)
+# define rule_x_offset(a) vinfo(a,2)
+# define rule_depth(a) vlink(a,3)
+# define rule_y_offset(a) vinfo(a,3)
+# define rule_height(a) vlink(a,4)
+# define rule_data(a) vinfo(a,4)
+# define rule_left(a) vinfo(a,5)
+# define rule_right(a) vlink(a,5)
+# define rule_font(a) vinfo(a,6)
+# define rule_character(a) vlink(a,6)
+
+# define rule_total(a) (rule_height(a) + rule_depth(a))
+
+/*tex
+
+ Originally glyph nodes had a |lig_ptr| but storing components makes not that much sense so we
+ dropped that. The free slot is now used for a state field. We already had a data field that
+ took another free slot and that behaves like an attribute. The glyph data field can be set at
+ the \TEX\ end, the state field is only accessible in \LUA. At the same time we reshuffled the
+ fields a bit so that the most accessed fields are close together.
+
+ The \LUATEX\ engine dropped the language node and moved that feature to the glyph nodes. In
+ addition to the language more properties could be set but they were all packed into one
+ halfword. In \LUAMETATEX\ we waste a few more bytes and keep the language separate but we
+ still pack a few properties.
+
+ In \TEX\ we have character nodes and glyph nodes, but here we only have one type. The subtype
+ can be used to indicate if we have ligatures but in \LUATEX\ for various reasons we don't follow
+ the integrated approach that \TEX\ has: we have callbacks for hyphenation, ligature building,
+ kerning etc.\ which demands separation, but more important is that we want to use \LUA\ to deal
+ with modern fonts. The components field that is still present in \LUATEX\ is gone because it
+ serves no purpose. We don't need to reassemble and when dealing with \OPENTYPE\ fonts we loose
+ information in successive steps anyway.
+
+ This also makes that the subtype is now only used to flag if glyphs have been processed. The
+ macro package can decide what additional properties get stored in this field.
+
+ We used to have this:
+
+ \starttyping
+ inline static void protect_glyph (halfword a) { quarterword s = node_subtype(a) ; if (s <= 256) { node_subtype(a) = s == 1 ? 256 : 256 + s; } }
+ inline static void unprotect_glyph (halfword a) { quarterword s = node_subtype(a) ; if (s > 256) { node_subtype(a) = s - 256; } }
+ inline static int is_protected_glyph (halfword a) { return node_subtype(a) >= 256; }
+ \stoptyping
+
+ These were also dropped:
+
+ \starttyping
+ # define is_character(p) (((node_subtype(p)) & glyph_character) == glyph_character)
+ # define is_ligature(p) (((node_subtype(p)) & glyph_ligature ) == glyph_ligature )
+ # define is_simple_character(p) (is_character(p) && ! is_ligature(p))
+ # define set_is_glyph(p) node_subtype(p) = (quarterword) (node_subtype(p) & ~glyph_character)
+ \stoptyping
+
+*/
+
+/*tex
+
+ Putting |width|, |height| and |depth| in a glyph has some advantages, for instance when we
+ fetch them in the builder, packer, \LUA\ interface, but it also has a disadvantage: we need to
+ have more complex copying of glyph nodes. For instance, when we copy glyphs in the open type
+ handler (e.g. for multiples) we also copy the fields. But then when we set a character, we also
+ would have to set the dimensions. Okay, some helper could do that (or a flag in setchar). It's
+ anyway not something to do in a hurry. An |x_extra| field is something different: combined with
+ setting |x_offset| that could replace font kerns: |x_advance = width + x_offset + x_extra|.
+
+*/
+
+//define glyph_node_size 12
+# define glyph_node_size 13
+# define glyph_character(a) vinfo(a,2)
+# define glyph_font(a) vlink(a,2)
+# define glyph_data(a) vinfo(a,3) /*tex We had that unused, so now it's like an attribute. */
+# define glyph_state(a) vlink(a,3) /*tex A user field (can be handy in \LUA). */
+# define glyph_language(a) vinfo(a,4)
+# define glyph_script(a) vlink(a,4)
+# define glyph_options(a) vinfo(a,5)
+# define glyph_hyphenate(a) vlink(a,5)
+# define glyph_protected(a) vinfo00(a,6)
+# define glyph_lhmin(a) vinfo01(a,6)
+# define glyph_rhmin(a) vinfo02(a,6)
+# define glyph_discpart(a) vinfo03(a,6)
+# define glyph_expansion(a) vlink(a,6)
+# define glyph_x_scale(a) vinfo(a,7)
+# define glyph_y_scale(a) vlink(a,7)
+# define glyph_scale(a) vinfo(a,8)
+# define glyph_raise(a) vlink(a,8)
+# define glyph_left(a) vinfo(a,9)
+# define glyph_right(a) vlink(a,9)
+# define glyph_x_offset(a) vinfo(a,10)
+# define glyph_y_offset(a) vlink(a,10)
+//define glyph_input_file(a) vinfo(a,11) /* aka glyph_synctex_tag */
+//define glyph_input_line(a) vlink(a,11) /* aka glyph_synctex_line */
+# define glyph_properties(a) vinfo0(a,11)
+# define glyph_group(a) vinfo1(a,11)
+# define glyph_index(a) vlink(a,11)
+# define glyph_input_file(a) vinfo(a,12)
+# define glyph_input_line(a) vlink(a,12)
+
+# define get_glyph_data(a) ((halfword) glyph_data(a))
+# define get_glyph_state(a) ((halfword) glyph_state(a))
+# define get_glyph_language(a) ((halfword) glyph_language(a))
+# define get_glyph_script(a) ((halfword) glyph_script(a))
+# define get_glyph_x_scale(a) ((halfword) glyph_x_scale(a))
+# define get_glyph_y_scale(a) ((halfword) glyph_y_scale(a))
+# define get_glyph_scale(a) ((halfword) glyph_scale(a))
+# define get_glyph_raise(a) ((halfword) glyph_raise(a))
+# define get_glyph_lhmin(a) ((halfword) glyph_lhmin(a))
+# define get_glyph_rhmin(a) ((halfword) glyph_rhmin(a))
+# define get_glyph_left(a) ((halfword) glyph_left(a))
+# define get_glyph_right(a) ((halfword) glyph_right(a))
+# define get_glyph_hyphenate(a) ((halfword) glyph_hyphenate(a))
+# define get_glyph_options(a) ((halfword) glyph_options(a))
+# define get_glyph_dohyph(a) (hyphenation_permitted(glyph_hyphenate(a), syllable_hyphenation_mode ) || hyphenation_permitted(glyph_hyphenate(a), force_handler_hyphenation_mode))
+# define get_glyph_uchyph(a) (hyphenation_permitted(glyph_hyphenate(a), uppercase_hyphenation_mode) || hyphenation_permitted(glyph_hyphenate(a), force_handler_hyphenation_mode))
+
+# define set_glyph_data(a,b) glyph_data(a) = b
+# define set_glyph_state(a,b) glyph_state(a) = b
+# define set_glyph_language(a,b) glyph_language(a) = b
+# define set_glyph_script(a,b) glyph_script(a) = b
+# define set_glyph_x_scale(a,b) glyph_x_scale(a) = b
+# define set_glyph_y_scale(a,b) glyph_y_scale(a) = b
+# define set_glyph_x_offset(a,b) glyph_x_offset(a) = b
+# define set_glyph_y_offset(a,b) glyph_y_offset(a) = b
+# define set_glyph_scale(a,b) glyph_scale(a) = b
+# define set_glyph_raise(a,b) glyph_raise(a) = b
+# define set_glyph_left(a,b) glyph_left(a) = b
+# define set_glyph_right(a,b) glyph_right(a) = b
+# define set_glyph_lhmin(a,b) glyph_lhmin(a) = (singleword) b
+# define set_glyph_rhmin(a,b) glyph_rhmin(a) = (singleword) b
+# define set_glyph_hyphenate(a,b) glyph_hyphenate(a) = ((halfword) b)
+# define set_glyph_options(a,b) glyph_options(a) = ((halfword) b)
+/* set_glyph_dohyph(a,b) glyph_hyphenate(a) = ((halfword) flip_hyphenation_mode(glyph_hyphenate(a),syllable_hyphenation_mode)) */
+# define set_glyph_uchyph(a,b) glyph_hyphenate(a) = ((halfword) flip_hyphenation_mode(glyph_hyphenate(a),uppercase_hyphenation_mode))
+# define set_glyph_discpart(a,b) glyph_discpart(a) = (singleword) (b)
+# define get_glyph_discpart(a) ((halfword) glyph_discpart(a))
+
+typedef enum glyph_subtypes {
+ /* initial value: */
+ glyph_unset_subtype,
+ /* traditional text: */
+ glyph_character_subtype,
+ glyph_ligature_subtype,
+ /* special math */
+ glyph_math_delimiter_subtype,
+ glyph_math_extensible_subtype,
+ /* engine math, class driven */
+ glyph_math_ordinary_subtype,
+ glyph_math_operator_subtype,
+ glyph_math_binary_subtype,
+ glyph_math_relation_subtype,
+ glyph_math_open_subtype,
+ glyph_math_close_subtype,
+ glyph_math_punctuation_subtype,
+ glyph_math_variable_subtype,
+ glyph_math_active_subtype,
+ glyph_math_inner_subtype,
+ glyph_math_under_subtype,
+ glyph_math_over_subtype,
+ glyph_math_fraction_subtype,
+ glyph_math_radical_subtype,
+ glyph_math_middle_subtype,
+ glyph_math_accent_subtype,
+ glyph_math_fenced_subtype,
+ glyph_math_ghost_subtype,
+ /* extra math, user classes, set but anonymous */
+ glyph_math_extra_subtype = 31,
+} glyph_subtypes;
+
+# define last_glyph_subtype glyph_math_accent_subtype
+
+typedef enum glyph_hstate_codes {
+ glyph_discpart_unset,
+ glyph_discpart_pre,
+ glyph_discpart_post,
+ glyph_discpart_replace,
+ glyph_discpart_always,
+} glyph_hstate_codes;
+
+typedef enum glyph_option_codes {
+ /*tex These are part of the defaults (all): */
+ glyph_option_normal_glyph = 0x0000,
+ glyph_option_no_left_ligature = 0x0001,
+ glyph_option_no_right_ligature = 0x0002,
+ glyph_option_no_left_kern = 0x0004,
+ glyph_option_no_right_kern = 0x0008,
+ glyph_option_no_expansion = 0x0010,
+ glyph_option_no_protrusion = 0x0020,
+ glyph_option_apply_x_offset = 0x0040,
+ glyph_option_apply_y_offset = 0x0080,
+ glyph_option_no_italic_correction = 0x0100,
+ /* These are only meant for math characters: */
+ glyph_option_math_discretionary = 0x0200,
+ glyph_option_math_italics_too = 0x0400,
+ /*tex So watch out: this is a subset! */
+ glyph_option_all = 0x01FF,
+} glyph_option_codes;
+
+typedef enum auto_discretionary_codes {
+ auto_discretionary_normal = 0x0001, /* turn glyphs into discretionary with three similar components */
+ auto_discretionary_italic = 0x0002, /* also include italic correcxtion when present */
+} auto_discretionary_codes;
+
+inline static void tex_add_glyph_option (halfword a, halfword r) { glyph_options(a) |= r; }
+inline static void tex_remove_glyph_option (halfword a, halfword r) { glyph_options(a) &= ~(r | glyph_options(a)); }
+inline static int tex_has_glyph_option (halfword a, halfword r) { return (glyph_options(a) & r) == r; }
+
+/*tex
+ As we have a small field available for protection we no longer need to pack the protection
+ state in the subtype. We can now basically use the subtype for anything we want (as long as it
+ stays within the range |0x0000-0xFFFF|.
+*/
+
+/* inline static void tex_protect_glyph (halfword a) { node_subtype(a) |= (quarterword) 0x8000; } */
+/* inline static void tex_unprotect_glyph (halfword a) { node_subtype(a) &= (quarterword) 0x7FFF; } */
+/* inline static int tex_is_protected_glyph (halfword a) { return node_subtype(a) >= (quarterword) 0x8000; } */
+/* inline static int tex_subtype_of_glyph (halfword a) { return node_subtype(a) & (quarterword) 0x7FFF; } */
+
+typedef enum glyph_protection_codes {
+ glyph_unprotected_code = 0x0,
+ glyph_protected_text_code = 0x1,
+ glyph_protected_math_code = 0x2,
+} glyph_protection_codes;
+
+/*tex
+ Next come some very specialized nodes types. First the marks. They just register a token list.
+*/
+
+# define mark_node_size 3
+# define mark_ptr(a) vlink(a,2)
+# define mark_index(a) vinfo(a,2)
+
+typedef enum mark_codes {
+ set_mark_value_code,
+ reset_mark_value_code,
+} mark_codes;
+
+# define last_mark_subtype reset_mark_value_code
+
+/*tex
+ The (not really used in \CONTEXT) |\vadjust| nodes are also small. The codes and subtypes
+ overlap.
+*/
+
+typedef enum adjust_subtypes {
+ pre_adjust_code,
+ post_adjust_code,
+ local_adjust_code,
+} adjust_subtypes;
+
+typedef enum adjust_options {
+ adjust_option_none = 0x00,
+ adjust_option_before = 0x01,
+ adjust_option_baseline = 0x02,
+ adjust_option_depth_before = 0x04,
+ adjust_option_depth_after = 0x08,
+ adjust_option_depth_check = 0x10,
+ adjust_option_depth_last = 0x20,
+} adjust_options;
+
+# define last_adjust_subtype local_adjust_code
+
+# define adjust_node_size 5
+# define adjust_list(a) vlink(a,2)
+# define adjust_options(a) vinfo(a,2)
+# define adjust_index(a) vlink(a,3)
+# define adjust_reserved(a) vinfo(a,3)
+# define adjust_depth_before(a) vlink(a,4)
+# define adjust_depth_after(a) vinfo(a,4)
+
+# define has_adjust_option(p,o) ((adjust_options(p) & o) == o)
+
+/*tex
+ Inserts are more complicated. The |ins| node stores an insert in the list while |inserting|
+ nodes keep track of where to break the page so that they (hopefully) stay with the text. As
+ already mentioned, the insert node is tricky in the sense that it uses an offset to an
+ embedded (fake) node. That node acts as start of a next chain. Making that more transparent
+ would demand some changes that I'm not willing to make right now (and maybe never).
+*/
+
+# define insert_node_size 6 /* can become 1 smaller or we can have insert_index instead of subtype */
+# define insert_index(a) vinfo(a,2) /* width is not used */
+# define insert_float_cost(a) vlink(a,2)
+# define insert_max_depth(a) vlink(a,3)
+# define insert_total_height(a) vlink(a,4) /* the sum of height and depth, i.e. total */
+# define insert_list(a) vinfo(a,5) /* is alias for |node_next|*/
+# define insert_split_top(a) vlink(a,5) /* a state variable */
+
+# define insert_first_box(a) (a + 5) /*tex A fake node where box_list_ptr becomes a next field. */
+
+# define split_node_size 5 /*tex Can become a |split_up_node|. */
+# define split_insert_index(a) vinfo(a,2) /*tex Same slot! */
+# define split_broken(a) vlink(a,2) /*tex An insertion for this class will break here if anywhere. */
+# define split_broken_insert(a) vinfo(a,3) /*tex This insertion might break at |broken_ptr|. */
+# define split_last_insert(a) vlink(a,3) /*tex The most recent insertion for this |subtype|. */
+# define split_best_insert(a) vinfo(a,4) /*tex The optimum most recent insertion. */
+# define split_height(a) vlink(a,4) /*tex Aka |height(a) = vlink(a,4)| */ /* todo */
+
+typedef enum split_subtypes {
+ normal_split_subtype,
+ insert_split_subtype,
+} split_subtypes;
+
+# define last_split_subtype insert_split_subtype
+
+/*tex
+ It's now time for some Some handy shortcuts. These are used when determining proper break points
+ and|/|or the beginning or end of words.
+*/
+
+# define last_preceding_break_node whatsit_node
+# define last_non_discardable_node dir_node
+# define last_node_with_attributes glyph_node
+# define last_complex_node align_record_node
+# define max_node_type passive_node
+
+# define precedes_break(a) (node_type(a) <= last_preceding_break_node)
+# define precedes_kern(a) ((node_type(a) == kern_node) && (node_subtype(a) == font_kern_subtype || node_subtype(a) == accent_kern_subtype || node_subtype(a) == math_shape_kern_subtype))
+# define precedes_dir(a) ((node_type(a) == dir_node) && normalize_line_mode_permitted(normalize_line_mode_par,break_after_dir_mode))
+# define non_discardable(a) (node_type(a) <= last_non_discardable_node)
+
+inline static int tex_nodetype_is_complex (halfword t) { return t <= last_complex_node; }
+inline static int tex_nodetype_has_attributes (halfword t) { return t <= last_node_with_attributes; }
+inline static int tex_nodetype_has_subtype (halfword t) { return t != glue_spec_node && t != math_spec_node && t != font_spec_node; }
+inline static int tex_nodetype_has_prev (halfword t) { return t != glue_spec_node && t != math_spec_node && t != font_spec_node && t != attribute_node; }
+inline static int tex_nodetype_has_next (halfword t) { return t != glue_spec_node && t != math_spec_node && t != font_spec_node; }
+inline static int tex_nodetype_is_visible (halfword t) { return (t >= 0) && (t <= max_node_type) && lmt_interface.node_data[t].visible; }
+
+/*tex
+ This is a bit weird place to define them but anyway. In the meantime in \LUAMETATEX\ we no
+ longer have the option to report the codes used in \ETEX. We have different nodes so it makes
+ no sense to complicate matters (although earlier version of \LUAMETATEX\ has this organized
+ quite well \unknown\ just an example of cleaning up, wondering about the use and then dropping
+ it.
+*/
+
+# define get_node_size(i) (lmt_interface.node_data[i].size)
+# define get_node_name(i) (lmt_interface.node_data[i].name)
+/* get_etex_code(i) (lmt_interface.node_data[i].etex) */
+
+/*tex
+ Although expressions could use some dedicated data structure, currently they are implemented
+ using a linked list. This means that only memory is the limitation for recursion but I might
+ as well go for a dedicated structure some day, just for the fun of implementing it. It is
+ probably also more efficient. The current approach is inherited from \ETEX. The stack is only
+ used when we have expressions between parenthesis.
+*/
+
+# define expression_node_size 3
+# define expression_type(a) vinfo00(a,1) /*tex one of the value levels */
+# define expression_state(a) vinfo01(a,1)
+# define expression_result(a) vinfo02(a,1)
+# define expression_unused(a) vinfo03(a,1)
+# define expression_expression(a) vlink(a,1) /*tex saved expression so far */
+# define expression_term(a) vlink(a,2) /*tex saved term so far */
+# define expression_numerator(a) vinfo(a,2) /*tex saved numerator */
+
+/*tex
+ To be decided: go double
+*/
+
+# define expression_entry(a) lvalue(a,2)
+
+/*tex
+ This is a node that stores a font state. In principle we can do without but for tracing it
+ really helps to have this compound element because it is more compact. We could have gone
+ numeric and use the sparse array approach but then we'd have to add a 4 int store which is more
+ code and also makes save and restore more complex.
+*/
+
+# define font_spec_node_size 4 /* we can be smaller: no attr and no prev */
+# define font_spec_identifier(a) vinfo(a,2)
+# define font_spec_scale(a) vlink(a,2)
+# define font_spec_x_scale(a) vinfo(a,3)
+# define font_spec_y_scale(a) vlink(a,3)
+
+inline static int tex_same_fontspec(halfword a, halfword b)
+{
+ return
+ (a == b)
+ || (a && b && font_spec_identifier(a) == font_spec_identifier(b)
+ && font_spec_scale(a) == font_spec_scale(b)
+ && font_spec_x_scale(a) == font_spec_x_scale(b)
+ && font_spec_y_scale(a) == font_spec_y_scale(b)
+ )
+ ;
+}
+
+/*tex
+ At the cost of some more memory we now use a mode for storage. This not only overcomes the
+ \UNICODE\ limitation but also permits storing more in the future.
+*/
+
+# define math_spec_node_size 3
+# define math_spec_class(a) vinfo00(a,1) /* attr */
+# define math_spec_family(a) vinfo01(a,1)
+# define math_spec_character(a) vlink(a,1) /* prev */
+# define math_spec_properties(a) vinfo0(a,2)
+# define math_spec_group(a) vinfo1(a,2)
+# define math_spec_index(a) vlink(a,2)
+
+# define math_spec_value(a) (((math_spec_class(a) & 0x3F) << 12) + ((math_spec_family(a) & 0x3F) << 8) + (math_spec_character(a) & 0xFF))
+
+inline static int tex_same_mathspec(halfword a, halfword b)
+{
+ return
+ (a == b)
+ || (a && b && math_spec_class(a) == math_spec_class(b)
+ && math_spec_family(a) == math_spec_family(b)
+ && math_spec_character(a) == math_spec_character(b)
+ && math_spec_properties(a) == math_spec_properties(b)
+ && math_spec_group(a) == math_spec_group(b)
+ && math_spec_index(a) == math_spec_index(b)
+ )
+ ;
+}
+
+/*tex
+ Here are some more stack related nodes.
+*/
+
+# define align_stack_node_size 10
+# define align_stack_align_ptr(a) vinfo(a,1)
+# define align_stack_cur_align(a) vlink(a,1)
+# define align_stack_preamble(a) vinfo(a,2)
+# define align_stack_cur_span(a) vlink(a,2)
+# define align_stack_cur_loop(a) vinfo(a,3)
+# define align_stack_wrap_source(a) vlink(a,3)
+# define align_stack_align_state(a) vinfo(a,4)
+# define align_stack_no_align_level(a) vlink(a,4)
+# define align_stack_cur_post_adjust_head(a) vinfo(a,5)
+# define align_stack_cur_post_adjust_tail(a) vlink(a,5)
+# define align_stack_cur_pre_adjust_head(a) vinfo(a,6)
+# define align_stack_cur_pre_adjust_tail(a) vlink(a,6)
+# define align_stack_cur_post_migrate_head(a) vinfo(a,7)
+# define align_stack_cur_post_migrate_tail(a) vlink(a,7)
+# define align_stack_cur_pre_migrate_head(a) vinfo(a,8)
+# define align_stack_cur_pre_migrate_tail(a) vlink(a,8)
+# define align_stack_no_tab_skips(a) vinfo(a,9)
+# define align_stack_attr_list(a) vlink(a,9)
+
+/*tex
+ If nodes are for nesting conditionals. We have more state information that in (for instance)
+ \LUATEX\ because we have more tracing and more test variants.
+*/
+
+# define if_node_size 3 /*tex we can use prev now */
+# define if_limit_type(a) vinfo0(a,1) /*tex overlaps with node_attr */
+# define if_limit_subtype(a) vinfo1(a,1) /*tex overlaps with node_attr */
+# define if_limit_unless(a) vinfo00(a,2)
+# define if_limit_step(a) vinfo01(a,2)
+# define if_limit_stepunless(a) vinfo02(a,2)
+# define if_limit_unused(a) vinfo03(a,2)
+# define if_limit_line(a) vlink(a,2)
+
+/*tex
+ Now come some rather special ones. For instance par shapes and file cq.\ line related nodes
+ were variable nodes. Thsi was dropped and replaced by a more generic specficiation node type.
+ In principle we can use that for more purposes.
+
+ We use a bit of abstraction as preparation for different allocations. Dynamic allocation makes
+ it possible to get rid of variable nodes but it is slower.
+
+ Because this node has no links we can use the next field as counter. The subtype is just for
+ diagnostics. This node is special in the sense that it has a real pointer. Such nodes will not
+ be stored in the format file. Because there is a pointer field we have some extra accessors.
+
+ Todo: we also need to catch the fact that we can run out of memory but in practice that will
+ not happen soon, for instance because we seldom use parshapes. And in the meantime the pseudo
+ file related nodes are gone anyway because all file IO has been delegated to \LUA\ now.
+*/
+
+# define specification_node_size 3
+# define specification_count(a) vlink(a,0)
+# define specification_options(a) vinfo(a,1)
+# define specification_unused(a) vlink(a,1)
+# define specification_pointer(a) (mvalue(a,2))
+
+typedef enum specification_options {
+ specification_option_repeat = 0x01,
+} specifications_options;
+
+# define specification_index(a,n) ((memoryword *) specification_pointer(a))[n - 1]
+
+# define specification_repeat(a) ((specification_options(a) & specification_option_repeat) == specification_option_repeat)
+
+# define specification_n(a,n) (specification_repeat(a) ? ((n - 1) % specification_count(a) + 1) : (n > specification_count(a) ? specification_count(a) : n))
+
+extern void tex_null_specification_list (halfword a);
+extern void tex_new_specification_list (halfword a, halfword n, halfword o);
+extern void tex_dispose_specification_list (halfword a);
+extern void tex_copy_specification_list (halfword a, halfword b);
+extern void tex_shift_specification_list (halfword a, int n, int rotate);
+
+inline static int tex_get_specification_count (halfword a) { return specification_count(a); }
+inline static halfword tex_get_specification_indent (halfword a, halfword n) { return specification_index(a,specification_n(a,n)).half0; }
+inline static halfword tex_get_specification_width (halfword a, halfword n) { return specification_index(a,specification_n(a,n)).half1; }
+inline static halfword tex_get_specification_penalty (halfword a, halfword n) { return specification_index(a,specification_n(a,n)).half0; }
+inline static void tex_set_specification_indent (halfword a, halfword n, halfword v) { specification_index(a,n).half0 = v; }
+inline static void tex_set_specification_width (halfword a, halfword n, halfword v) { specification_index(a,n).half1 = v; }
+inline static void tex_set_specification_penalty (halfword a, halfword n, halfword v) { specification_index(a,n).half0 = v; }
+inline static void tex_set_specification_option (halfword a, int o) { specification_options(a) |= o; }
+
+extern halfword tex_new_specification_node (halfword n, quarterword s, halfword options);
+extern void tex_dispose_specification_nodes (void);
+
+/*tex
+ We now define some math related nodes (and noads) and start with style and choice nodes. Style
+ nodes can be smaller, the information is encoded in |subtype|, but choice nodes are on-the-spot
+ converted to style nodes with slack. The advantage is that we don't run into issues when a choice
+ node is the first node in which case we would have to adapt head pointers (read: feed them back
+ into the calling routines). So, we keep this as it is now.
+
+ Parameter nodes started out as an experiment. We could actually use the same mechanism as
+ attributes but (1) we don't want attribute nodes in the list, it is very math specific and (3)
+ we don't need to be real fast here.
+
+ Maybe these three can be merged into one type but on the other hand they are part of the \TEX\
+ legacy and well documented so \unknown for now we keep it as-is. In the meantime we are no
+ longer casting choices to styles.
+
+*/
+
+# define style_node_size 3
+# define style_style node_subtype
+# define style_scale(a) vinfo(a,2)
+# define style_reserved(a) vlink(a,2)
+
+# define choice_node_size 5
+//define choice_style node_subtype
+# define choice_display_mlist(a) vinfo(a,2) /*tex mlist to be used in display style or pre_break */
+# define choice_text_mlist(a) vlink(a,2) /*tex mlist to be used in text style or post_break */
+# define choice_script_mlist(a) vinfo(a,3) /*tex mlist to be used in script style or no_break */
+# define choice_script_script_mlist(a) vlink(a,3) /*tex mlist to be used in scriptscript style */
+# define choice_class(a) vinfo(a,4) /*tex we could abuse the script script field */
+# define choice_unused(a) vlink(a,4)
+
+# define choice_pre_break choice_display_mlist
+# define choice_post_break choice_text_mlist
+# define choice_no_break choice_script_mlist
+
+# define parameter_node_size 3
+# define parameter_style node_subtype
+# define parameter_name(a) vinfo(a,2)
+# define parameter_value(a) vlink(a,2)
+
+typedef enum simple_choice_subtypes {
+ normal_choice_subtype,
+ discretionary_choice_subtype,
+} simple_choice_subtypes;
+
+# define last_choice_subtype discretionary_choice_subtype
+
+/*tex
+ Because noad types get changed when processing we need to make sure some if the node sizes
+ match and that we don't share slots with different properties.
+
+ First come the regular noads. The generic noad has the same size and similar fields as a fence
+ noad, and their types get swapped a few times.
+
+ We accept a little waste of space in order to get nicer code. After all, math is not that
+ demanding. Although delimiter, accent, fraction and radical share the same structure we do use
+ specific field names because of clarity. Not all fields are used always.
+
+ \starttabulate[|l|l|l|l|l|l|]
+ \FL
+ \BC \BC noad \BC accent \BC fraction \BC radical \NC fence \NC \NR
+ \ML \NC
+ \NC vlink 2 \NC new_hlist \NC \NC \NC \NC \NC \NR
+ \ML \NC
+ \NC vinfo 2 \NC nucleus \NC \NC \NC \NC \NC \NR
+ \NC vlink 3 \NC supscr \NC \NC numerator \NC \NC \NC \NR
+ \NC vinfo 3 \NC subscr \NC \NC denominator \NC \NC \NC \NR
+ \NC vlink 4 \NC supprescr \NC \NC \NC \NC \NC \NR
+ \NC vinfo 4 \NC subprescr \NC \NC \NC \NC \NC \NR
+ \ML \NC
+ \NC vlink 5 \NC italic \NC \NC \NC \NC \NC \NR
+ \NC vinfo 5 \NC width \NC \NC \NC \NC \NC \NR
+ \NC vlink 6 \NC height \NC \NC \NC \NC \NC \NR
+ \NC vinfo 6 \NC depth \NC \NC \NC \NC \NC \NR
+ \ML \NC
+ \NC vlink 7 \NC options \NC \NC \NC \NC \NC \NR
+ \NC vinfo 7 \NC style \NC \NC \NC \NC \NC \NR
+ \NC vlink 8 \NC family \NC \NC \NC \NC \NC \NR
+ \NC vinfo 8 \NC class \NC \NC \NC \NC \NC \NR
+ \NC vlink 9 \NC source \NC \NC \NC \NC \NC \NR
+ \NC vinfo 9 \NC prime \NC \NC \NC \NC \NC \NR
+ \NC vlink 10 \NC leftslack \NC \NC \NC \NC \NC \NR
+ \NC vinfo 10 \NC rightslack \NC \NC \NC \NC \NC \NR
+ \ML \NC
+ \NC vlink 11 \NC extra_1 \NC top_character \NC rule_thickness \NC degree \NC list \NC \NR
+ \NC vinfo 11 \NC extra_2 \NC bot_character \NC left_delimiter \NC left_delimiter \NC source \NC \NR
+ \NC vlink 12 \NC extra_3 \NC overlay_character \NC right_delimiter \NC right_delimiter \NC top \NC \NR
+ \NC vinfo 12 \NC extra_4 \NC fraction \NC middle_delimiter \NC \NC bottom \NC \NR
+ \NC vlink 13 \NC extra_5 \NC topovershoot \NC \NC height \NC \NC \NR
+ \NC vinfo 13 \NC extra_6 \NC botovershoot \NC \NC depth \NC \NC \NR
+ \LL
+ \stoptabulate
+
+ We can use smaller variables for style and class and then have one field available for
+ other usage so no need to grow.
+
+*/
+
+# define noad_state_node_size 6
+# define noad_state_topright(a) vlink(a,2)
+# define noad_state_bottomright(a) vinfo(a,2)
+# define noad_state_topleft(a) vlink(a,3)
+# define noad_state_bottomleft(a) vinfo(a,3)
+# define noad_state_height(a) vlink(a,4)
+# define noad_state_depth(a) vinfo(a,4)
+# define noad_state_toptotal(a) vlink(a,5)
+# define noad_state_bottomtotal(a) vinfo(a,5)
+
+# define noad_size 14
+# define noad_new_hlist(a) vlink(a,2) /*tex the translation of an mlist; a bit confusing name */
+# define noad_nucleus(a) vinfo(a,2)
+# define noad_supscr(a) vlink(a,3)
+# define noad_subscr(a) vinfo(a,3)
+# define noad_supprescr(a) vlink(a,4)
+# define noad_subprescr(a) vinfo(a,4)
+# define noad_italic(a) vlink(a,5) /*tex Sometimes used, might become more. */
+# define noad_width(a) vinfo(a,5)
+# define noad_height(a) vlink(a,6)
+# define noad_depth(a) vinfo(a,6)
+# define noad_options(a) vlink(a,7)
+# define noad_style(a) vinfo00(a,7)
+# define noad_family(a) vinfo01(a,7)
+# define noad_script_state(a) vinfo02(a,7)
+# define noad_analyzed(a) vinfo03(a,7) /*tex used for experiments */
+# define noad_state(a) vlink(a,8) /*tex this might replace */
+# define noad_class_main(a) vinfo00(a,8)
+# define noad_class_left(a) vinfo01(a,8)
+# define noad_class_right(a) vinfo02(a,8)
+# define noad_script_order(a) vinfo03(a,8)
+# define noad_source(a) vlink(a,9)
+# define noad_prime(a) vinfo(a,9)
+# define noad_left_slack(a) vlink(a,10)
+# define noad_right_slack(a) vinfo(a,10)
+# define noad_extra_1(a) vlink(a,11)
+# define noad_extra_2(a) vinfo(a,11)
+# define noad_extra_3(a) vlink(a,12)
+# define noad_extra_4(a) vinfo(a,12)
+# define noad_extra_5(a) vlink(a,13)
+# define noad_extra_6(a) vinfo(a,13)
+
+# define noad_total(a) (noad_height(a) + noad_depth(a))
+
+# define noad_has_postscripts(a) (noad_subscr(a) || noad_supscr(a))
+# define noad_has_prescripts(a) (noad_subprescr(a) || noad_supprescr(a))
+# define noad_has_scripts(a) (noad_has_postscripts(a) || noad_has_prescripts(a) || noad_prime(a))
+# define noad_has_following_scripts(a) (noad_subscr(a) || noad_supscr(a) || noad_prime(a))
+# define noad_has_superscripts(a) (noad_supprescr(a) || noad_supscr(a) || noad_prime(a))
+# define noad_has_subscripts(a) (noad_subprescr(a) || noad_subscr(a))
+
+# define noad_has_scriptstate(a,s) ((noad_script_state(a) & s) == s)
+
+# define unset_noad_class 0xFE
+
+typedef enum noad_script_states {
+ post_super_script_state = 0x01,
+ post_sub_script_state = 0x02,
+ pre_super_script_state = 0x04,
+ pre_sub_script_state = 0x08,
+ prime_script_state = 0x10,
+} noad_script_states;
+
+typedef enum noad_script_locations {
+ prime_unknown_location,
+ prime_at_begin_location,
+ prime_above_sub_location,
+ prime_at_end_location,
+} noad_prime_locations;
+
+typedef enum noad_script_order {
+ script_unknown_first,
+ script_primescript_first,
+ script_subscript_first,
+ script_superscript_first,
+} noad_script_order;
+
+typedef struct noad_classes {
+ singleword main;
+ singleword left;
+ singleword right;
+} noad_classes;
+
+# define reset_noad_classes(n) do { \
+ noad_class_main(n) = (singleword) unset_noad_class; \
+ noad_class_left(n) = (singleword) unset_noad_class; \
+ noad_class_right(n) = (singleword) unset_noad_class; \
+} while (0);
+
+# define set_noad_classes(n,c) do { \
+ noad_class_main(n) = (singleword) (c & 0xFF); \
+ noad_class_left(n) = (singleword) (c & 0xFF); \
+ noad_class_right(n) = (singleword) (c & 0xFF); \
+} while (0);
+
+# define set_noad_main_class(n,c) noad_class_main(n) = (singleword) (c & 0xFF)
+# define set_noad_left_class(n,c) noad_class_left(n) = (singleword) (c & 0xFF)
+# define set_noad_right_class(n,c) noad_class_right(n) = (singleword) (c & 0xFF)
+
+# define get_noad_main_class(n) (noad_class_main(n))
+# define get_noad_left_class(n) (noad_class_left(n))
+# define get_noad_right_class(n) (noad_class_right(n))
+
+# define set_noad_style(n,s) noad_style(n) = (singleword) (s & 0xFF)
+# define set_noad_family(n,f) noad_family(n) = (singleword) (f & 0xFF)
+
+/*tex
+ Options are something \LUATEX\ and in \LUAMETEX\ we added some more. When we have dimensions
+ then we obey |axis| and otherwise |noaxis|. This might evolve a bit over time. These options
+ currently are on the same spot but we pretend they aren't so we have dedicated accessors. This
+ also makes clear what noads have what options.
+
+ If we run out of options we can combine some, like auto.
+*/
+
+typedef enum noad_options {
+ noad_option_axis = 0x00000001,
+ noad_option_no_axis = 0x00000002,
+ noad_option_exact = 0x00000004,
+ noad_option_left = 0x00000008, /* align option for overflown under/over */ /* used ? */
+ noad_option_middle = 0x00000010, /* idem */
+ noad_option_right = 0x00000020, /* idem */
+ noad_option_adapt_to_left_size = 0x00000040, /* old trickery, might go away but kind of fun */
+ noad_option_adapt_to_right_size = 0x00000080, /* idem */
+ noad_option_no_sub_script = 0x00000100,
+ noad_option_no_super_script = 0x00000200,
+ noad_option_no_sub_pre_script = 0x00000400,
+ noad_option_no_super_pre_script = 0x00000800,
+ noad_option_no_script = 0x00001000,
+ noad_option_no_overflow = 0x00002000, /* keep (middle) extensible widthin target size */
+ noad_option_void = 0x00004000, /* wipe and set width to zero */
+ noad_option_phantom = 0x00008000, /* wipe */
+ noad_option_openup_height = 0x00010000,
+ noad_option_openup_depth = 0x00020000,
+ noad_option_limits = 0x00040000, /* traditional modifier */
+ noad_option_no_limits = 0x00080000, /* idem */
+ noad_option_prefer_font_thickness = 0x00100000,
+ noad_option_no_ruling = 0x00200000,
+ noad_option_shifted_sub_script = 0x00400000,
+ noad_option_shifted_super_script = 0x00800000,
+ noad_option_shifted_sub_pre_script = 0x01000000,
+ noad_option_shifted_super_pre_script = 0x02000000,
+ noad_option_unpack_list = 0x04000000,
+ noad_option_no_check = 0x08000000, /* don't check for missing end fence */
+ noad_option_auto = 0x10000000,
+ noad_option_unroll_list = 0x20000000,
+ noad_option_followed_by_space = 0x40000000,
+ /* available: */
+ noad_option_reserved = 0x80000000,
+} noad_options;
+
+# define has_option(a,b) (((a) & (b)) == (b))
+# define unset_option(a,b) ((a) & ~(b))
+
+inline static void tex_add_noad_option (halfword a, halfword r) { noad_options(a) |= r; }
+inline static void tex_remove_noad_option (halfword a, halfword r) { noad_options(a) &= ~(r | noad_options(a)); }
+inline static int tex_has_noad_option (halfword a, halfword r) { return (noad_options(a) & r) == r; }
+
+inline int has_noad_no_script_option(halfword n, halfword option)
+{
+ switch (node_type(n)) {
+ case simple_noad:
+ case accent_noad:
+ case radical_noad:
+ case fence_noad:
+ case fraction_noad:
+ return has_option(noad_options(n), option) || has_option(noad_options(n), noad_option_no_script);
+ }
+ return 0;
+}
+
+# define has_noad_option_nosubscript(a) has_noad_no_script_option(a, noad_option_no_sub_script)
+# define has_noad_option_nosupscript(a) has_noad_no_script_option(a, noad_option_no_super_script)
+# define has_noad_option_nosubprescript(a) has_noad_no_script_option(a, noad_option_no_sub_pre_script)
+# define has_noad_option_nosupprescript(a) has_noad_no_script_option(a, noad_option_no_super_pre_script)
+
+# define has_noad_option_shiftedsubscript(a) (has_option(noad_options(a), noad_option_shifted_sub_script))
+# define has_noad_option_shiftedsupscript(a) (has_option(noad_options(a), noad_option_shifted_super_script))
+# define has_noad_option_shiftedsubprescript(a) (has_option(noad_options(a), noad_option_shifted_sub_pre_script))
+# define has_noad_option_shiftedsupprescript(a) (has_option(noad_options(a), noad_option_shifted_super_pre_script))
+# define has_noad_option_axis(a) (has_option(noad_options(a), noad_option_axis))
+# define has_noad_option_exact(a) (has_option(noad_options(a), noad_option_exact))
+# define has_noad_option_noaxis(a) (has_option(noad_options(a), noad_option_no_axis))
+# define has_noad_option_openupheight(a) (has_option(noad_options(a), noad_option_openup_height))
+# define has_noad_option_openupdepth(a) (has_option(noad_options(a), noad_option_openup_depth))
+# define has_noad_option_adapttoleft(a) (has_option(noad_options(a), noad_option_adapt_to_left_size))
+# define has_noad_option_adapttoright(a) (has_option(noad_options(a), noad_option_adapt_to_right_size))
+# define has_noad_option_limits(a) (has_option(noad_options(a), noad_option_limits))
+# define has_noad_option_nolimits(a) (has_option(noad_options(a), noad_option_no_limits))
+# define has_noad_option_nooverflow(a) (has_option(noad_options(a), noad_option_no_overflow))
+# define has_noad_option_preferfontthickness(a) (has_option(noad_options(a), noad_option_prefer_font_thickness))
+# define has_noad_option_noruling(a) (has_option(noad_options(a), noad_option_no_ruling))
+# define has_noad_option_unpacklist(a) (has_option(noad_options(a), noad_option_unpack_list))
+# define has_noad_option_nocheck(a) (has_option(noad_options(a), noad_option_no_check))
+# define has_noad_option_exact(a) (has_option(noad_options(a), noad_option_exact))
+# define has_noad_option_left(a) (has_option(noad_options(a), noad_option_left))
+# define has_noad_option_middle(a) (has_option(noad_options(a), noad_option_middle))
+# define has_noad_option_right(a) (has_option(noad_options(a), noad_option_right))
+# define has_noad_option_auto(a) (has_option(noad_options(a), noad_option_auto))
+# define has_noad_option_phantom(a) (has_option(noad_options(a), noad_option_phantom))
+# define has_noad_option_void(a) (has_option(noad_options(a), noad_option_void))
+# define has_noad_option_unrolllist(a) (has_option(noad_options(a), noad_option_unroll_list))
+# define has_noad_option_followedbyspace(a) (has_option(noad_options(a), noad_option_followed_by_space))
+
+/*tex
+ In the meantime the codes and subtypes are in sync. The variable component does not really
+ become a subtype.
+*/
+
+typedef enum simple_noad_subtypes {
+ ordinary_noad_subtype,
+ operator_noad_subtype,
+ binary_noad_subtype,
+ relation_noad_subtype,
+ open_noad_subtype,
+ close_noad_subtype,
+ punctuation_noad_subtype,
+ variable_noad_subtype, /* we want to run in parallel */
+ active_noad_subtype, /* we want to run in parallel */
+ inner_noad_subtype,
+ under_noad_subtype,
+ over_noad_subtype,
+ fraction_noad_subtype,
+ radical_noad_subtype,
+ middle_noad_subtype,
+ accent_noad_subtype,
+ fenced_noad_subtype,
+ ghost_noad_subtype,
+ vcenter_noad_subtype,
+} simple_noad_subtypes;
+
+# define last_noad_type vcenter_noad_subtype
+# define last_noad_subtype vcenter_noad_subtype
+
+typedef enum math_component_types {
+ math_component_ordinary_code,
+ math_component_operator_code,
+ math_component_binary_code,
+ math_component_relation_code,
+ math_component_open_code,
+ math_component_close_code,
+ math_component_punctuation_code,
+ math_component_variable_code,
+ math_component_inner_code,
+ math_component_under_code,
+ math_component_over_code,
+ math_component_fraction_code,
+ math_component_radical_code,
+ math_component_middle_code,
+ math_component_accent_code,
+ math_component_fenced_code,
+ math_component_ghost_code,
+ math_component_atom_code,
+} math_component_types;
+
+# define first_math_component_type math_component_ordinary_code
+# define last_math_component_type math_component_accent_code
+
+/*tex
+ When I added adapt options, the |math_limits_cmd| became |math_modifier_cmd| just because it
+ nicely fits in there.
+*/
+
+typedef enum math_modifier_types {
+ display_limits_modifier_code,
+ limits_modifier_code,
+ no_limits_modifier_code,
+ adapt_to_left_modifier_code,
+ adapt_to_right_modifier_code,
+ axis_modifier_code,
+ no_axis_modifier_code,
+ phantom_modifier_code,
+ void_modifier_code,
+ source_modifier_code,
+ openup_height_modifier_code,
+ openup_depth_modifier_code,
+} math_modifier_types;
+
+# define first_math_modifier_code display_limits_modifier_code
+# define last_math_modifier_code openup_depth_modifier_code
+
+/*tex accent noads: todo, left and right offsets and options */
+
+# define accent_noad_size noad_size
+# define accent_top_character noad_extra_1 /*tex the |top_accent_chr| field of an accent noad */
+# define accent_bottom_character noad_extra_2 /*tex the |bot_accent_chr| field of an accent noad */
+# define accent_middle_character noad_extra_3 /*tex the |overlay_accent_chr| field of an accent noad */
+# define accent_fraction noad_extra_4
+# define accent_top_overshoot noad_extra_5
+# define accent_bot_overshoot noad_extra_6
+
+typedef enum math_accent_subtypes {
+ bothflexible_accent_subtype,
+ fixedtop_accent_subtype,
+ fixedbottom_accent_subtype,
+ fixedboth_accent_subtype,
+} math_accent_subtypes;
+
+# define last_accent_subtype fixedboth_accent_subtype
+
+/*tex
+ With these left and right fencing noads we have a historical mix of |fence| and |delimiter| (and
+ |shield|) naming which for now we keep. It gets swapped with the generic noad, so size matters.
+ */
+
+# define fence_noad_size noad_size
+# define fence_delimiter_list noad_extra_1 // not really a list
+# define fence_delimiter_top noad_extra_3
+# define fence_delimiter_bottom noad_extra_4
+//define fence_delimiter_first noad_extra_5
+//define fence_delimiter_last noad_extra_6
+
+typedef enum fence_subtypes {
+ unset_fence_side,
+ left_fence_side,
+ middle_fence_side,
+ right_fence_side,
+ left_operator_side,
+ no_fence_side,
+ extended_left_fence_side,
+ extended_middle_fence_side,
+ extended_right_fence_side,
+} fence_subtypes;
+
+# define last_fence_subtype extended_right_fence_side
+# define first_fence_code left_fence_side
+# define last_fence_code extended_right_fence_side
+
+/*tex
+ Fraction noads are generic in the sense that they are also used for non|-|fractions, not that
+ it matters much. We keep them as they are in \TEX\ but have more fields.
+
+ We put the numerator and denomerator in script fields so there can be no such direct scripts
+ attached. Because we have prescripts we can used these fields and limit this handicap a bit but
+ if we ever overcome this (at the cost of more fields in these similar noads) we need to adapt
+ the error message for double scripts in |tex_run_math_script|.
+
+*/
+
+# define fraction_noad_size noad_size
+# define fraction_numerator noad_supprescr /* ! */
+# define fraction_denominator noad_subprescr /* ! */
+# define fraction_rule_thickness noad_extra_1
+# define fraction_left_delimiter noad_extra_2
+# define fraction_right_delimiter noad_extra_3
+# define fraction_middle_delimiter noad_extra_4
+# define fraction_h_factor noad_extra_5
+# define fraction_v_factor noad_extra_6
+
+typedef enum fraction_subtypes {
+ over_fraction_subtype,
+ atop_fraction_subtype,
+ above_fraction_subtype,
+ skewed_fraction_subtype,
+ stretched_fraction_subtype,
+} fraction_subtypes;
+
+# define valid_fraction_subtype(s) (s >= over_fraction_subtype && s <= stretched_fraction_subtype)
+
+/*tex
+ Radical noads are like fraction noads, but they only store a |left_delimiter|. They are also
+ used for extensibles (over, under, etc) so the name is is somewhat confusing.
+*/
+
+# define radical_noad_size noad_size
+# define radical_degree noad_extra_1
+# define radical_left_delimiter noad_extra_2
+# define radical_right_delimiter noad_extra_3
+# define radical_height noad_extra_5
+# define radical_depth noad_extra_6
+
+typedef enum radical_subtypes {
+ normal_radical_subtype,
+ radical_radical_subtype,
+ root_radical_subtype,
+ rooted_radical_subtype,
+ under_delimiter_radical_subtype,
+ over_delimiter_radical_subtype,
+ delimiter_under_radical_subtype,
+ delimiter_over_radical_subtype,
+ delimited_radical_subtype,
+ h_extensible_radical_subtype,
+} radical_subtypes;
+
+# define last_radical_subtype h_extensible_radical_subtype
+# define last_radical_code h_extensible_radical_subtype
+
+/*tex
+ Again a very simple small node: it represents a math character so naturally it has a family.
+ It can be turned list. These are subnodes. When an extra options field gets added, the
+ overlapping character and list fields can be split, so then we also have the origin saved.
+
+ The following nodes are kernel nodes: |math_char_node|, |math_text_char_node|, |sub_box_node|
+ and |sub_mlist_node|. Characters eventually becomes wrapped in a list.
+*/
+
+typedef enum math_kernel_options {
+ math_kernel_no_italic_correction = 0x0001,
+ math_kernel_no_left_pair_kern = 0x0002,
+ math_kernel_no_right_pair_kern = 0x0004,
+ math_kernel_auto_discretionary = 0x0008,
+ math_kernel_full_discretionary = 0x0010,
+} math_kernel_options;
+
+# define math_kernel_node_size 5
+# define kernel_math_family(a) vinfo(a,2)
+# define kernel_math_character(a) vlink(a,2)
+# define kernel_math_options(a) vinfo(a,3)
+# define kernel_math_list(a) vlink(a,3)
+# define kernel_math_properties(a) vinfo0(a,4) /* for characters */
+# define kernel_math_group(a) vinfo1(a,4) /* for characters */
+# define kernel_math_index(a) vlink(a,4) /* for characters */
+
+# define math_kernel_node_has_option(a,b) ((kernel_math_options(a) & b) == b)
+# define math_kernel_node_set_option(a,b) kernel_math_options(a) = (kernel_math_options(a) | b)
+
+/*tex
+ This is also a subnode, this time for a delimiter field. The large family field is only used
+ in traditional \TEX\ fonts where a base character can come from one font, and the extensible
+ from another, but in \OPENTYPE\ math font that doesn't happen.
+*/
+
+# define math_delimiter_node_size 4
+# define delimiter_small_family(a) vinfo(a,2) /*tex |family| for small delimiter */
+# define delimiter_small_character(a) vlink(a,2) /*tex |character| for small delimiter */
+# define delimiter_large_family(a) vinfo(a,3) /*tex |family| for large delimiter */
+# define delimiter_large_character(a) vlink(a,3) /*tex |character| for large delimiter */
+
+/*tex
+ Before we come to the by now rather large local par node we define some small ones. The
+ boundary nodes are an extended version of the original ones. The direction nodes are
+ a simplified version of what \OMEGA\ has as whatsit. In \LUATEX\ it became a first class
+ citizen and in \LUAMETATEX\ we cleaned it up.
+*/
+
+typedef enum boundary_subtypes {
+ cancel_boundary,
+ user_boundary,
+ protrusion_boundary,
+ word_boundary,
+ page_boundary,
+ par_boundary,
+} boundary_subtypes;
+
+# define last_boundary_subtype word_boundary
+# define last_boundary_code page_boundary
+
+# define boundary_node_size 3
+# define boundary_data(a) vinfo(a,2)
+
+typedef enum dir_subtypes {
+ normal_dir_subtype,
+ cancel_dir_subtype,
+} dir_subtypes;
+
+# define last_dir_subtype cancel_dir_subtype
+
+# define dir_node_size 3
+# define dir_direction(a) vinfo(a,2)
+# define dir_level(a) vlink(a,2)
+
+/*tex
+ Local par nodes come from \OMEGA\ and store the direction as well as local boxes. In \LUATEX
+ we use a leaner direction model and in \LUAMETATEX\ we only kept the two directions that just
+ work. In the end it is the backend that deals with these properties. The frontend just keeps
+ a little track of them.
+
+ However, in \LUAMETATEX\ we can also store the paragraph state in this node. That way we no
+ longer have the issue that properties are lost when a group ends before a |\par| is triggered.
+ This is probably a feature that only makes sense in \CONTEXT\ which is why I made sure that
+ there is not much overhead. In the first version one could control each variable, but as we
+ ran out of bits in the end was done per group of variables. However, when I really need more
+ detail I might go for a 64 bit field instead. After all we have that possibility in memory
+ words.
+
+ These local par nodes can actually end up in the middle of lines as they can be used to change
+ the left and right box as well as inject penalties. For that reason they now have a proper
+ subtype so that the initial and successive instances can be recognized.
+ */
+
+typedef enum par_codes {
+ par_none_code,
+ par_hsize_code,
+ par_left_skip_code,
+ par_right_skip_code,
+ par_hang_indent_code,
+ par_hang_after_code,
+ par_par_indent_code,
+ par_par_fill_left_skip_code,
+ par_par_fill_right_skip_code,
+ par_par_init_left_skip_code,
+ par_par_init_right_skip_code,
+ par_adjust_spacing_code,
+ par_protrude_chars_code,
+ par_pre_tolerance_code,
+ par_tolerance_code,
+ par_emergency_stretch_code,
+ par_looseness_code,
+ par_last_line_fit_code,
+ par_line_penalty_code,
+ par_inter_line_penalty_code,
+ par_club_penalty_code,
+ par_widow_penalty_code,
+ par_display_widow_penalty_code,
+ par_orphan_penalty_code,
+ par_broken_penalty_code,
+ par_adj_demerits_code,
+ par_double_hyphen_demerits_code,
+ par_final_hyphen_demerits_code,
+ par_par_shape_code,
+ par_inter_line_penalties_code,
+ par_club_penalties_code,
+ par_widow_penalties_code,
+ par_display_widow_penalties_code,
+ par_orphan_penalties_code,
+ par_baseline_skip_code,
+ par_line_skip_code,
+ par_line_skip_limit_code,
+ par_adjust_spacing_step_code,
+ par_adjust_spacing_shrink_code,
+ par_adjust_spacing_stretch_code,
+ par_hyphenation_mode_code,
+ par_shaping_penalties_mode_code,
+ par_shaping_penalty_code,
+} par_codes;
+
+typedef enum par_categories {
+ par_none_category = 0x00000000,
+ par_hsize_category = 0x00000001, // \hsize
+ par_skip_category = 0x00000002, // \leftskip \rightskip
+ par_hang_category = 0x00000004, // \hangindent \hangafter
+ par_indent_category = 0x00000008, // \parindent
+ par_par_fill_category = 0x00000010, // \parfillskip \parfillleftskip
+ par_adjust_category = 0x00000020, // \adjustspacing
+ par_protrude_category = 0x00000040, // \protrudechars
+ par_tolerance_category = 0x00000080, // \tolerance \pretolerance
+ par_stretch_category = 0x00000100, // \emergcystretch
+ par_looseness_category = 0x00000200, // \looseness
+ par_last_line_category = 0x00000400, // \lastlinefit
+ par_line_penalty_category = 0x00000800, // \linepenalty \interlinepenalty \interlinepenalties
+ par_club_penalty_category = 0x00001000, // \clubpenalty \clubpenalties
+ par_widow_penalty_category = 0x00002000, // \widowpenalty \widowpenalties
+ par_display_penalty_category = 0x00004000, // \displaypenalty \displaypenalties
+ par_broken_penalty_category = 0x00008000, // \brokenpenalty
+ par_demerits_category = 0x00010000, // \doublehyphendemerits \finalhyphendemerits \adjdemerits
+ par_shape_category = 0x00020000, // \parshape
+ par_line_category = 0x00040000, // \baselineskip \lineskip \lineskiplimit
+ par_hyphenation_category = 0x00080000, // \Hyphenationmode
+ par_shaping_penalty_category = 0x00100000, // \shapingpenaltiesmode
+ par_orphan_penalty_category = 0x00200000, // \orphanpenalties
+ par_all_category = 0x7FFFFFFF, //
+} par_categories;
+
+static int par_category_to_codes[] = {
+ par_none_category,
+ par_hsize_category, // par_hsize_code
+ par_skip_category, // par_left_skip_code
+ par_skip_category, // par_right_skip_code
+ par_hang_category, // par_hang_indent_code
+ par_hang_category, // par_hang_after_code
+ par_indent_category, // par_par_indent_code
+ par_par_fill_category, // par_par_fill_skip_code
+ par_par_fill_category, // par_par_fill_left_skip_code
+ par_par_fill_category, // par_par_init_skip_code
+ par_par_fill_category, // par_par_init_skip_code
+ par_adjust_category, // par_adjust_spacing_code
+ par_protrude_category, // par_protrude_chars_code
+ par_tolerance_category, // par_pre_tolerance_code
+ par_tolerance_category, // par_tolerance_code
+ par_stretch_category, // par_emergency_stretch_code
+ par_looseness_category, // par_looseness_code
+ par_last_line_category, // par_last_line_fit_code
+ par_line_penalty_category, // par_line_penalty_code
+ par_line_penalty_category, // par_inter_line_penalty_code
+ par_club_penalty_category, // par_club_penalty_code
+ par_widow_penalty_category, // par_widow_penalty_code
+ par_display_penalty_category, // par_display_widow_penalty_code
+ par_orphan_penalty_category, // par_orphan_penalty_code
+ par_broken_penalty_category, // par_broken_penalty_code
+ par_demerits_category, // par_adj_demerits_code
+ par_demerits_category, // par_double_hyphen_demerits_code
+ par_demerits_category, // par_final_hyphen_demerits_code
+ par_shape_category, // par_par_shape_code
+ par_line_penalty_category, // par_inter_line_penalties_code
+ par_club_penalty_category, // par_club_penalties_code
+ par_widow_penalty_category, // par_widow_penalties_code
+ par_display_penalty_category, // par_display_widow_penalties_code
+ par_orphan_penalty_category, // par_orphan_penalties_code
+ par_line_category, // par_baseline_skip_code
+ par_line_category, // par_line_skip_code
+ par_line_category, // par_line_skip_limit_code
+ par_adjust_category, // par_adjust_spacing_step_code
+ par_adjust_category, // par_adjust_spacing_shrink_code
+ par_adjust_category, // par_adjust_spacing_stretch_code
+ par_hyphenation_category, // par_hyphenation_mode_code
+ par_shaping_penalty_category, // par_shaping_penalties_mode_code
+ par_shaping_penalty_category, // par_shaping_penalty_code
+};
+
+/*tex
+ Todo: make the fields 6+ into a par_state node so that local box ones can be
+ small. Also, penalty and broken fields now are duplicate. Do we need to keep
+ these?
+*/
+
+# define par_node_size 28
+# define par_penalty_interline(a) vinfo(a,2) /*tex These come from \OMEGA. */
+# define par_penalty_broken(a) vlink(a,2) /*tex These come from \OMEGA. */
+# define par_box_left(a) vinfo(a,3)
+# define par_box_left_width(a) vlink(a,3)
+# define par_box_right(a) vinfo(a,4)
+# define par_box_right_width(a) vlink(a,4)
+# define par_box_middle(a) vinfo(a,5) /* no width here */
+# define par_dir(a) vlink(a,5)
+# define par_state(a) vinfo(a,6)
+# define par_hsize(a) vlink(a,6)
+# define par_left_skip(a) vinfo(a,7)
+# define par_right_skip(a) vlink(a,7)
+# define par_hang_indent(a) vinfo(a,8)
+# define par_hang_after(a) vlink(a,8)
+# define par_par_indent(a) vinfo(a,9)
+# define par_par_fill_left_skip(a) vlink(a,9)
+# define par_par_fill_right_skip(a) vinfo(a,10)
+# define par_adjust_spacing(a) vlink(a,10)
+# define par_protrude_chars(a) vinfo(a,11)
+# define par_pre_tolerance(a) vlink(a,11)
+# define par_tolerance(a) vinfo(a,12)
+# define par_emergency_stretch(a) vlink(a,12)
+# define par_looseness(a) vinfo(a,13)
+# define par_last_line_fit(a) vlink(a,13)
+# define par_line_penalty(a) vinfo(a,14)
+# define par_inter_line_penalty(a) vlink(a,14)
+# define par_club_penalty(a) vinfo(a,15)
+# define par_widow_penalty(a) vlink(a,15)
+# define par_display_widow_penalty(a) vinfo(a,16)
+# define par_orphan_penalty(a) vlink(a,16)
+# define par_broken_penalty(a) vinfo(a,17)
+# define par_adj_demerits(a) vlink(a,17)
+# define par_double_hyphen_demerits(a) vinfo(a,18)
+# define par_final_hyphen_demerits(a) vlink(a,18)
+# define par_par_shape(a) vinfo(a,19)
+# define par_inter_line_penalties(a) vlink(a,19)
+# define par_club_penalties(a) vinfo(a,20)
+# define par_widow_penalties(a) vlink(a,20)
+# define par_display_widow_penalties(a) vinfo(a,21)
+# define par_orphan_penalties(a) vlink(a,21)
+# define par_baseline_skip(a) vinfo(a,22)
+# define par_line_skip(a) vlink(a,22)
+# define par_line_skip_limit(a) vinfo(a,23)
+# define par_adjust_spacing_step(a) vlink(a,23)
+# define par_adjust_spacing_shrink(a) vinfo(a,24)
+# define par_adjust_spacing_stretch(a) vlink(a,24)
+# define par_end_par_tokens(a) vinfo(a,25)
+# define par_hyphenation_mode(a) vlink(a,25)
+# define par_shaping_penalties_mode(a) vinfo(a,26)
+# define par_shaping_penalty(a) vlink(a,26)
+# define par_par_init_left_skip(a) vlink(a,27)
+# define par_par_init_right_skip(a) vinfo(a,27)
+
+typedef enum par_subtypes {
+ vmode_par_par_subtype,
+ local_box_par_subtype,
+ hmode_par_par_subtype,
+ penalty_par_subtype,
+ math_par_subtype,
+} par_subtypes;
+
+# define last_par_subtype math_par_subtype
+
+inline static int tex_is_start_of_par_node(halfword n)
+{
+ return ( n && (node_type(n) == par_node) && (node_subtype(n) == vmode_par_par_subtype || node_subtype(n) == hmode_par_par_subtype) );
+}
+
+extern halfword tex_get_par_par (halfword p, halfword what);
+extern void tex_set_par_par (halfword p, halfword what, halfword v, int force);
+extern void tex_snapshot_par (halfword p, halfword what);
+extern halfword tex_find_par_par (halfword head);
+/* halfword tex_internal_to_par_code (halfword cmd, halfword index); */
+extern void tex_update_par_par (halfword cmd, halfword index);
+
+inline static int tex_par_state_is_set (halfword p, halfword what) { return (par_state(p) & par_category_to_codes[what]) == par_category_to_codes[what]; }
+inline static void tex_set_par_state (halfword p, halfword what) { par_state(p) |= par_category_to_codes[what]; }
+inline static int tex_par_to_be_set (halfword state, halfword what) { return (state & par_category_to_codes[what]) == par_category_to_codes[what]; }
+
+/*tex
+ Because whatsits are used by the backend (or callbacks in the frontend) we do provide this node.
+ It only has the basic properties: subtype, attribute, prev link and next link. User nodes have
+ been dropped because one can use whatsits to achieve the same. We also don't standardize the
+ subtypes as it's very macro package specific what they do. So, only a size here:
+*/
+
+# define whatsit_node_size 2
+
+/*tex
+ Active and passive nodes are used in the par builder. There is plenty of comments in the code
+ that explains them (although it's not that trivial I guess). Delta nodes just store the
+ progression in widths, stretch and shrink: they are copies of arrays. Originally they just used
+ offsets:
+
+ \starttyping
+ # define delta_node_size 10
+ # define delta_field(a,n) node_next(a + n)
+ \stoptyping
+
+ But that wasted 9 halfs for storing the 9 fields. So, next I played with this:
+
+ \starttyping
+ # define delta_field_1(d) (delta_field(d,1)) // or: vinfo(d,1)
+ # define delta_field_2(d) (delta_field(d,2)) // or: vlink(d,1)
+ ...
+ # define delta_field_9(d) (delta_field(d,9)) // or: vinfo(d,5)
+ \stoptyping
+
+ But soon after that more meaningfull names were introduced, simply because in the code where they
+ are used also verbose names showed up.
+
+ The active node is actually a |hyphenated_node| or an |unhyphenated_node| but for now we keep
+ the \TEX\ lingua. We could probably turn the type into a subtype and moev fitness to another
+ spot.
+*/
+
+/* is vinfo(a,2) used? it not we can have fitness there and hyphenated/unyphenates as subtype */
+
+# define active_node_size 4 /*tex |hyphenated_node| or |unhyphenated_node| */
+# define active_fitness node_subtype /*tex |very_loose_fit..tight_fit| on final line for this break */
+# define active_break_node(a) vlink(a,1) /*tex pointer to the corresponding passive node */
+# define active_line_number(a) vinfo(a,1) /*tex line that begins at this breakpoint */
+# define active_total_demerits(a) vlink(a,2) /*tex the quantity that \TEX\ minimizes */
+# define active_short(a) vinfo(a,3) /*tex |shortfall| of this line */
+# define active_glue(a) vlink(a,3) /*tex corresponding glue stretch or shrink */
+
+# define passive_node_size 7
+# define passive_cur_break(a) vlink(a,1) /*tex in passive node, points to position of this breakpoint */
+# define passive_prev_break(a) vinfo(a,1) /*tex points to passive node that should precede this one */
+# define passive_pen_inter(a) vinfo(a,2)
+# define passive_pen_broken(a) vlink(a,2)
+# define passive_left_box(a) vlink(a,3)
+# define passive_left_box_width(a) vinfo(a,3)
+# define passive_last_left_box(a) vlink(a,4)
+# define passive_last_left_box_width(a) vinfo(a,4)
+# define passive_right_box(a) vlink(a,5)
+# define passive_right_box_width(a) vinfo(a,5)
+# define passive_serial(a) vlink(a,6) /*tex serial number for symbolic identification (pass) */
+# define passive_middle_box(a) vinfo(a,6)
+
+# define delta_node_size 6
+# define delta_field_total_glue(d) vinfo(d,1)
+# define delta_field_total_shrink(d) vinfo(d,2)
+# define delta_field_total_stretch(d) vlink(d,2)
+# define delta_field_total_fi_amount(d) vinfo(d,3)
+# define delta_field_total_fil_amount(d) vlink(d,3)
+# define delta_field_total_fill_amount(d) vinfo(d,4)
+# define delta_field_total_filll_amount(d) vlink(d,4)
+# define delta_field_font_shrink(d) vinfo(d,5)
+# define delta_field_font_stretch(d) vlink(d,5)
+
+/*tex
+ Again we now have some helpers. We have a double linked list so here we go:
+*/
+
+inline static void tex_couple_nodes(int a, int b)
+{
+ node_next(a) = b;
+ node_prev(b) = a;
+}
+
+inline static void tex_try_couple_nodes(int a, int b)
+{
+ if (b) {
+ if (a) {
+ node_next(a) = b;
+ }
+ node_prev(b) = a;
+ } else if (a) {
+ node_next(a) = null;
+ }
+}
+
+inline static void tex_uncouple_node(int a)
+{
+ node_next(a) = null;
+ node_prev(a) = null;
+}
+
+inline static halfword tex_head_of_node_list(halfword n)
+{
+ while (node_prev(n)) {
+ n = node_prev(n);
+ }
+ return n;
+}
+
+inline static halfword tex_tail_of_node_list(halfword n)
+{
+ while (node_next(n)) {
+ n = node_next(n);
+ }
+ return n;
+}
+
+/*tex
+ Attribute management is kind of complicated. They are stored in a sorted linked list and we
+ try to share these for successive nodes. In \LUATEX\ a state is kept and reset frequently but
+ in \LUAMETATEX\ we try to be more clever, for instance we keep track of grouping. This comes
+ as some overhead but saves reconstructing (often the same) list. It also saves memory.
+*/
+
+# define attribute_cache_disabled max_halfword
+# define current_attribute_state lmt_node_memory_state.attribute_cache
+
+extern halfword tex_copy_attribute_list (halfword attr);
+extern halfword tex_copy_attribute_list_set (halfword attr, int index, int value);
+extern halfword tex_patch_attribute_list (halfword attr, int index, int value);
+extern void tex_dereference_attribute_list (halfword attr);
+extern void tex_build_attribute_list (halfword target);
+extern halfword tex_current_attribute_list (void);
+extern int tex_unset_attribute (halfword target, int index, int value);
+extern void tex_unset_attributes (halfword first, halfword last, int index);
+extern void tex_set_attribute (halfword target, int index, int value);
+extern int tex_has_attribute (halfword target, int index, int value);
+
+extern void tex_reset_node_properties (halfword target);
+
+# define get_attribute_list(target) \
+ node_attr(target)
+
+# define add_attribute_reference(a) do { \
+ if (a && a != attribute_cache_disabled) { \
+ ++attribute_count(a); \
+ } \
+} while (0)
+
+# define delete_attribute_reference(a) do { \
+ if (a && a != attribute_cache_disabled) { \
+ tex_dereference_attribute_list(a); \
+ } \
+} while (0)
+
+# define remove_attribute_list(target) do { \
+ halfword old_a = node_attr(target); \
+ delete_attribute_reference(old_a); \
+ node_attr(target) = null; \
+} while (0)
+
+/*
+inline static void remove_attribute_list(halfword target)
+{
+ halfword a_old = node_attr(target);
+ if (a_old && a_old != attribute_cache_disabled) {
+ dereference_attribute_list(a_old);
+ }
+ node_attr(target) = null;
+}
+*/
+
+/* This can be dangerous: */
+
+# define wipe_attribute_list_only(target) \
+ node_attr(target) = null;
+
+/*tex
+ Better is to add a ref before we remove one because there's the danger of premature freeing
+ otherwise.
+*/
+
+typedef enum saved_attribute_items {
+ saved_attribute_item_list = 0,
+ saved_attribute_n_of_items = 1,
+} saved_attribute_items;
+
+inline static void tex_attach_attribute_list_copy(halfword target, halfword source)
+{
+ halfword a_new = node_attr(source);
+ halfword a_old = node_attr(target);
+ node_attr(target) = a_new;
+ add_attribute_reference(a_new);
+ delete_attribute_reference(a_old);
+}
+
+inline static void tex_attach_attribute_list_attribute(halfword target, halfword a_new)
+{
+ halfword a_old = node_attr(target);
+ if (a_old != a_new) {
+ node_attr(target) = a_new;
+ add_attribute_reference(a_new);
+ delete_attribute_reference(a_old);
+ }
+}
+
+# define attach_current_attribute_list tex_build_attribute_list /* (target) */
+
+# define set_current_attribute_state(v) do { \
+ current_attribute_state = v; \
+} while (0)
+
+# define change_attribute_register(a,id,value) do { \
+ if (eq_value(id) != value) { \
+ if (is_global(a)) { \
+ int i; \
+ for (i = (lmt_save_state.save_stack_data.ptr - 1); i >= 0; i--) { \
+ if (save_type(i) == saved_attribute_list) { \
+ delete_attribute_reference(save_value(i)); \
+ save_value(i) = attribute_cache_disabled; \
+ } \
+ } \
+ } else { \
+ delete_attribute_reference(current_attribute_state); \
+ } \
+ set_current_attribute_state(attribute_cache_disabled); \
+ } \
+} while (0)
+
+# define save_attribute_state_before() do { \
+ halfword c = current_attribute_state; \
+ tex_set_saved_record(saved_attribute_item_list, saved_attribute_list, 0, c); \
+ lmt_save_state.save_stack_data.ptr += saved_attribute_n_of_items; \
+ add_attribute_reference(c); \
+} while (0)
+
+# define save_attribute_state_after() do { \
+} while (0)
+
+# define unsave_attribute_state_before() do { \
+ halfword c = current_attribute_state; \
+ delete_attribute_reference(c); \
+} while (0)
+
+# define unsave_attribute_state_after() do { \
+ lmt_save_state.save_stack_data.ptr -= saved_attribute_n_of_items; \
+ set_current_attribute_state(saved_value(saved_attribute_item_list)); \
+} while (0)
+
+/*tex
+ We now arrive at some functions that report the nodes to users. The subtype information that
+ is used in the \LUA\ interface is stored alongside.
+*/
+
+extern void tex_print_short_node_contents (halfword n);
+extern void tex_show_node_list (halfword n, int threshold, int max);
+extern halfword tex_actual_box_width (halfword r, scaled base_width);
+extern void tex_print_name (halfword p, const char *what);
+extern void tex_print_node_list (halfword n, const char *what, int threshold, int max);
+/* void tex_print_node_and_details (halfword p); */
+/* void tex_print_subtype_and_attributes_info (halfword p, halfword s, node_info *data); */
+extern void tex_print_extended_subtype (halfword p, quarterword s);
+extern void tex_aux_show_dictionary (halfword p, halfword properties, halfword group, halfword index, halfword font, halfword character);
+
+extern halfword tex_new_node (quarterword i, quarterword j);
+extern void tex_flush_node_list (halfword n);
+extern void tex_flush_node (halfword n);
+extern halfword tex_copy_node_list (halfword n, halfword e);
+extern halfword tex_copy_node (halfword n);
+extern halfword tex_copy_node_only (halfword n);
+/* halfword tex_fix_node_list (halfword n); */
+
+/*tex
+ We already defined glue and gluespec node but here are some of the properties
+ that they have. Again a few helpers.
+*/
+
+typedef enum glue_orders {
+ normal_glue_order,
+ fi_glue_order,
+ fil_glue_order,
+ fill_glue_order,
+ filll_glue_order
+} glue_orders;
+
+typedef enum glue_amounts {
+ /* we waste slot zero, we padd anyway */
+ total_glue_amount = 1, // 1 //
+ total_stretch_amount = 2, // 3 //
+ total_fi_amount = 3, // 4 //
+ total_fil_amount = 4, // 5 //
+ total_fill_amount = 5, // 6 //
+ total_filll_amount = 6, // 7 //
+ total_shrink_amount = 7, // 2 //
+ font_stretch_amount = 8, // 8 //
+ font_shrink_amount = 9, // 9 //
+} glue_amounts;
+
+# define min_glue_order normal_glue_order
+# define max_glue_order filll_glue_order
+
+typedef enum glue_signs {
+ normal_glue_sign,
+ stretching_glue_sign,
+ shrinking_glue_sign
+} glue_signs;
+
+# define min_glue_sign normal_glue_sign
+# define max_glue_sign shrinking_glue_sign
+
+# define normal_glue_multiplier 0.0
+
+inline halfword tex_checked_glue_sign(halfword sign)
+{
+ if ((sign < min_glue_sign) || (sign > max_glue_sign)) {
+ return normal_glue_sign;
+ } else {
+ return sign;
+ }
+}
+
+inline halfword tex_checked_glue_order(halfword order)
+{
+ if ((order < min_glue_order) || (order > max_glue_order)) {
+ return normal_glue_order;
+ } else {
+ return order;
+ }
+}
+
+/*tex
+ These are reserved nodes that sit at the start of main memory. We could actually just allocate
+ them, but then we also need to set some when we start up. Now they are just saved in the format
+ file. In \TEX\ these nodes were shared as much as possible (using a reference count) but here
+ we just use copies.
+
+ Below we start at |zero_glue| which in our case is just 0, or |null| in \TEX\ speak. After these
+ reserved nodes the memory used for whatever nodes are needed takes off.
+
+ Changing this to real nodes makes sense but is also tricky due to initializations ... some day
+ (we need to store stuff in teh states then and these are not saved!).
+
+
+*/
+
+# define fi_glue (zero_glue + glue_spec_size) /*tex These are constants */
+# define fil_glue (fi_glue + glue_spec_size)
+# define fill_glue (fil_glue + glue_spec_size)
+# define filll_glue (fill_glue + glue_spec_size)
+# define fil_neg_glue (filll_glue + glue_spec_size)
+
+# define page_insert_head (fil_neg_glue + glue_spec_size)
+# define contribute_head (page_insert_head + split_node_size) /*tex This was temp_node_size but we assign more. */
+# define page_head (contribute_head + temp_node_size)
+# define temp_head (page_head + glue_node_size) /*tex It gets a glue type assigned. */
+# define hold_head (temp_head + temp_node_size)
+# define post_adjust_head (hold_head + temp_node_size)
+# define pre_adjust_head (post_adjust_head + temp_node_size)
+# define post_migrate_head (pre_adjust_head + temp_node_size)
+# define pre_migrate_head (post_migrate_head + temp_node_size)
+# define align_head (pre_migrate_head + temp_node_size)
+# define active_head (align_head + temp_node_size)
+# define end_span (active_head + active_node_size)
+# define begin_period (end_span + span_node_size) /*tex Used to mark begin of word in hjn. */
+# define end_period (begin_period + glyph_node_size) /*tex Used to mark end of word in hjn. */
+
+# define last_reserved (end_period + glyph_node_size - 1)
+
+/*tex More helpers! */
+
+extern int tex_list_has_glyph (halfword list);
+
+extern halfword tex_new_null_box_node (quarterword type, quarterword subtype);
+extern halfword tex_new_rule_node (quarterword subtype);
+extern halfword tex_new_glyph_node (quarterword subtype, halfword fnt, halfword chr, halfword parent); /*tex afterwards: when we mess around */
+extern halfword tex_new_char_node (quarterword subtype, halfword fnt, halfword chr, int all); /*tex as we go: in maincontrol */
+extern halfword tex_new_text_glyph (halfword fnt, halfword chr);
+extern halfword tex_new_disc_node (quarterword subtype);
+extern halfword tex_new_glue_spec_node (halfword param);
+extern halfword tex_new_param_glue_node (quarterword param, quarterword subtype);
+extern halfword tex_new_glue_node (halfword qlue, quarterword subtype);
+extern halfword tex_new_kern_node (scaled width, quarterword subtype);
+extern halfword tex_new_penalty_node (halfword penalty, quarterword subtype);
+extern halfword tex_new_par_node (quarterword mode);
+
+extern halfword tex_new_temp_node (void);
+
+extern scaled tex_glyph_width (halfword p); /* x/y scaled */
+extern scaled tex_glyph_height (halfword p); /* x/y scaled */
+extern scaled tex_glyph_depth (halfword p); /* x/y scaled */
+extern scaled tex_glyph_total (halfword p); /* x/y scaled */
+extern scaledwhd tex_glyph_dimensions (halfword p); /* x/y scaled */
+extern int tex_glyph_has_dimensions (halfword p); /* x/y scaled */
+extern scaled tex_glyph_width_ex (halfword p); /* x/y scaled, expansion included */
+extern scaledwhd tex_glyph_dimensions_ex (halfword p); /* x/y scaled, expansion included */
+
+extern halfword tex_kern_dimension (halfword p);
+extern halfword tex_kern_dimension_ex (halfword p); /* expansion included */
+
+extern scaledwhd tex_pack_dimensions (halfword p);
+
+extern halfword tex_list_node_mem_usage (void);
+extern halfword tex_reversed_node_list (halfword list);
+extern int tex_n_of_used_nodes (int counts[]);
+
+# define _valid_node_(p) ((p > lmt_node_memory_state.reserved) && (p < lmt_node_memory_state.nodes_data.allocated) && (lmt_node_memory_state.nodesizes[p] > 0))
+
+inline static int tex_valid_node(halfword n)
+{
+ return n && _valid_node_(n) ? n : null;
+}
+
+/*tex This is a bit strange place but better than a macro elsewhere: */
+
+inline static int tex_math_skip_boundary(halfword n)
+{
+ return (n && node_type(n) == glue_node
+ && (node_subtype(n) == space_skip_glue ||
+ node_subtype(n) == xspace_skip_glue ||
+ node_subtype(n) == zero_space_skip_glue));
+}
+
+typedef enum special_node_list_types { /* not in sycn with the above .. maybe add bogus ones */
+ page_insert_list_type,
+ contribute_list_type,
+ page_list_type,
+ temp_list_type,
+ hold_list_type,
+ post_adjust_list_type,
+ pre_adjust_list_type,
+ post_migrate_list_type,
+ pre_migrate_list_type,
+ align_list_type,
+ /* in different spot */
+ page_discards_list_type,
+ split_discards_list_type,
+ // best_page_break_type
+} special_node_list_types;
+
+extern int tex_is_special_node_list (halfword n, int *istail);
+extern halfword tex_get_special_node_list (special_node_list_types list, halfword *tail);
+extern void tex_set_special_node_list (special_node_list_types list, halfword head);
+
+extern scaled tex_effective_glue (halfword parent, halfword glue);
+
+extern const char *tex_aux_subtype_str (halfword n );
+
+# endif
+
diff --git a/source/luametatex/source/tex/texpackaging.c b/source/luametatex/source/tex/texpackaging.c
new file mode 100644
index 000000000..5942c1365
--- /dev/null
+++ b/source/luametatex/source/tex/texpackaging.c
@@ -0,0 +1,3409 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ We're essentially done with the parts of \TEX\ that are concerned with the input (|get_next|)
+ and the output (|ship_out|). So it's time to get heavily into the remaining part, which does
+ the real work of typesetting.
+
+ After lists are constructed, \TEX\ wraps them up and puts them into boxes. Two major
+ subroutines are given the responsibility for this task: |hpack| applies to horizontal lists
+ (hlists) and |vpack| applies to vertical lists (vlists). The main duty of |hpack| and |vpack|
+ is to compute the dimensions of the resulting boxes, and to adjust the glue if one of those
+ dimensions is pre-specified. The computed sizes normally enclose all of the material inside the
+ new box; but some items may stick out if negative glue is used, if the box is overfull, or if a
+ |\vbox| includes other boxes that have been shifted left.
+
+ The subroutine call |hpack(p, w, m)| returns a pointer to an |hlist_node| for a box containing
+ the hlist that starts at |p|. Parameter |w| specifies a width; and parameter |m| is either
+ |exactly| or |additional|. Thus, |hpack(p, w, exactly)| produces a box whose width is exactly
+ |w|, while |hpack(p, w, additional)| yields a box whose width is the natural width plus |w|. It
+ is convenient to define a macro called |natural| to cover the most common case, so that we can
+ say |hpack(p, natural)| to get a box that has the natural width of list |p|.
+
+ Similarly, |vpack(p, w, m)| returns a pointer to a |vlist_node| for a box containing the vlist
+ that starts at |p|. In this case |w| represents a height instead of a width; the parameter |m|
+ is interpreted as in |hpack|.
+
+ The parameters to |hpack| and |vpack| correspond to \TEX's primitives like |\hbox to 300pt|,
+ |\hbox spread 10pt|; note that |\hbox| with no dimension following it is equivalent to |\hbox
+ spread 0pt|. The |scan_spec| subroutine scans such constructions in the user's input, including
+ the mandatory left brace that follows them, and it puts the specification onto |save_stack| so
+ that the desired box can later be obtained by executing the following code:
+
+ \starttyping
+ save_state.save_ptr := save_state.save_ptr-1;
+ hpack(p, saved_value(0), saved_level(0));
+ \stoptyping
+
+ Scan a box specification and left brace:
+ */
+
+/*tex
+ The next version is the (current) end point of successive improvements. After some keys were
+ added it became important to avoid redundant checking and pushing back mismatched keys. The
+ older (maybe more readable) variants using |scan_keyword| can be found in the archives (zip
+ and git) instead of as comments here.
+*/
+
+/*tex
+
+ When scanning, special care is necessary to ensure that the special |save_stack| codes are
+ placed just below the new group code, because scanning can change |save_stack| when |\csname|
+ appears. This coincides with the text on |dir| and |attr| keywords, as these are exaclty the
+ uses of |\hbox|, |\vbox|, and |\vtop| in the input stream (the others are |\vcenter|, |\valign|,
+ and |\halign|).
+
+ Scan a box specification and left brace comes next. Again, the more verbose, but already
+ rather optimized intermediate variants are in the archives. Improving scanners like this happen
+ stepwise in order to maintain compatibility (although \unknown\ we now quit earlier in a
+ mismatch so we're not exact compatible when an forward looking error happens.
+
+ */
+
+static void tex_aux_scan_full_spec(quarterword c, quarterword spec_direction, int just_pack, scaled shift)
+{
+ quarterword spec_code = packing_additional;
+ int spec_amount = 0;
+ halfword attrlist = null;
+ halfword orientation = 0;
+ halfword reverse = 0;
+ halfword container = 0;
+ scaled xoffset = 0;
+ scaled yoffset = 0;
+ scaled xmove = 0;
+ scaled ymove = 0;
+ halfword source = 0;
+ halfword target = 0;
+ halfword anchor = 0;
+ halfword geometry = 0;
+ halfword axis = 0;
+ halfword state = 0;
+ halfword retain = 0;
+ halfword mainclass = unset_noad_class;
+ int context = saved_value(saved_full_spec_item_context);
+ int brace = 0;
+ while (1) {
+ /*tex Maybe |migrate <int>| makes sense here. */
+ switch (tex_scan_character("tascdoxyrlTASCDOXYRL", 1, 1, 1)) {
+ case 0:
+ goto DONE;
+ case 't': case 'T':
+ switch (tex_scan_character("aoAO", 0, 0, 0)) {
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("target", 2)) {
+ target = tex_scan_int(1, NULL);
+ }
+ break;
+ case 'o': case 'O':
+ spec_code = packing_exactly;
+ spec_amount = tex_scan_dimen(0, 0, 0, 0, NULL);
+ break;
+ default:
+ tex_aux_show_keyword_error("target|to");
+ goto DONE;
+ }
+ break;
+ case 'a': case 'A':
+ switch (tex_scan_character("dntxDNTX", 0, 0, 0)) {
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("adapt", 2)) {
+ spec_code = packing_adapted;
+ spec_amount = tex_scan_limited_scale(0);
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("attr", 2)) {
+ halfword i = tex_scan_attribute_register_number();
+ halfword v = tex_scan_int(1, NULL);
+ if (eq_value(register_attribute_location(i)) != v) {
+ if (attrlist) {
+ attrlist = tex_patch_attribute_list(attrlist, i, v);
+ } else {
+ attrlist = tex_copy_attribute_list_set(tex_current_attribute_list(), i, v);
+ }
+ }
+ }
+ break;
+ case 'n': case 'N':
+ if (tex_scan_mandate_keyword("anchor", 2)) {
+ switch (tex_scan_character("sS", 0, 0, 0)) {
+ case 's': case 'S':
+ anchor = tex_scan_anchors(0);
+ break;
+ default:
+ anchor = tex_scan_anchor(0);
+ break;
+ }
+ }
+ break;
+ case 'x': case 'X':
+ if (tex_scan_mandate_keyword("axis", 2)) {
+ axis |= tex_scan_box_axis();
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("adapt|attr|anchor|axis");
+ goto DONE;
+ }
+ break;
+ case 's': case 'S':
+ switch (tex_scan_character("hpoHPO", 0, 0, 0)) {
+ case 'h': case 'H':
+ /*tex
+ This is a bonus because we decoupled the shift amount from the context,
+ where it can be somewhat confusing as that is a hybrid amount, kind, or
+ flag field. The keyword overloads an already given |move_cmd|.
+ */
+ if (tex_scan_mandate_keyword("shift", 2)) {
+ shift = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'p': case 'P':
+ if (tex_scan_mandate_keyword("spread", 2)) {
+ spec_code = packing_additional;
+ spec_amount = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("source", 2)) {
+ source = tex_scan_int(1, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("shift|spread|source");
+ goto DONE;
+ }
+ break;
+ case 'd': case 'D':
+ switch (tex_scan_character("eiEI", 0, 0, 0)) {
+ case 'i': case 'I':
+ if (tex_scan_mandate_keyword("direction", 2)) {
+ spec_direction = tex_scan_direction(0);
+ }
+ break;
+ case 'e': case 'E':
+ if (tex_scan_mandate_keyword("delay", 2)) {
+ state |= package_u_leader_delayed;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("direction|delay");
+ goto DONE;
+ }
+ break;
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("orientation", 1)) {
+ orientation = tex_scan_orientation(0);
+ }
+ break;
+ case 'x': case 'X':
+ switch (tex_scan_character("omOM", 0, 0, 0)) {
+ case 'o': case 'O' :
+ if (tex_scan_mandate_keyword("xoffset", 2)) {
+ xoffset = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'm': case 'M' :
+ if (tex_scan_mandate_keyword("xmove", 2)) {
+ xmove = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("xoffset|xmove");
+ goto DONE;
+ }
+ break;
+ case 'y': case 'Y':
+ switch (tex_scan_character("omOM", 0, 0, 0)) {
+ case 'o': case 'O' :
+ if (tex_scan_mandate_keyword("yoffset", 2)) {
+ yoffset = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'm': case 'M' :
+ if (tex_scan_mandate_keyword("ymove", 2)) {
+ ymove = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("yoffset|ymove");
+ goto DONE;
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_character("eE", 0, 0, 0)) {
+ switch (tex_scan_character("vVtT", 0, 0, 0)) {
+ case 'v': case 'V' :
+ if (tex_scan_mandate_keyword("reverse", 3)) {
+ reverse = 1;
+ }
+ break;
+ case 't': case 'T' :
+ if (tex_scan_mandate_keyword("retain", 3)) {
+ retain = tex_scan_int(0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("reverse|retain");
+ goto DONE;
+ }
+ }
+ break;
+ case 'c': case 'C':
+ switch (tex_scan_character("olOL", 0, 0, 0)) {
+ case 'o': case 'O' :
+ if (tex_scan_mandate_keyword("container", 2)) {
+ container = 1;
+ }
+ break;
+ case 'l': case 'L' :
+ if (tex_scan_mandate_keyword("class", 2)) {
+ mainclass = tex_scan_math_class_number(0);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("container|class");
+ goto DONE;
+ }
+ break;
+ case '{':
+ brace = 1;
+ goto DONE;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ if (anchor || source || target) {
+ geometry |= anchor_geometry;
+ }
+ if (orientation || xmove || ymove) {
+ geometry |= orientation_geometry;
+ }
+ if (xoffset || yoffset) {
+ geometry |= offset_geometry;
+ }
+ /*tex
+ We either build one triggered by the |attr| key or we never set it in which case we use the
+ default. As we will use it anyway, we also bump the reference, which also makes sure that
+ it will stay.
+ */
+ if (! attrlist) {
+ /* this alse sets the reference when not yet set */
+ attrlist = tex_current_attribute_list();
+ }
+ /*tex Now we're referenced. We need to preserve this over the group. */
+ add_attribute_reference(attrlist);
+ /* */
+ tex_set_saved_record(saved_full_spec_item_context, saved_box_context, 0, context);
+ /*tex Traditionally these two are packed into one record: */
+ tex_set_saved_record(saved_full_spec_item_packaging, saved_box_spec, spec_code, spec_amount);
+ /*tex Adjust |text_dir_ptr| for |scan_spec|: */
+ if (spec_direction != direction_unknown) {
+ tex_set_saved_record(saved_full_spec_item_direction, saved_box_direction, spec_direction, lmt_dir_state.text_dir_ptr);
+ lmt_dir_state.text_dir_ptr = tex_new_dir(normal_dir_subtype, spec_direction);
+ } else {
+ tex_set_saved_record(saved_full_spec_item_direction, saved_box_direction, spec_direction, null);
+ }
+ /* We could pack some in one record. */
+ tex_set_saved_record(saved_full_spec_item_attr_list, saved_box_attr_list, 0, attrlist);
+ tex_set_saved_record(saved_full_spec_item_only_pack, saved_box_pack, 0, just_pack);
+ tex_set_saved_record(saved_full_spec_item_orientation, saved_box_orientation, 0, orientation);
+ tex_set_saved_record(saved_full_spec_item_anchor, saved_box_anchor, 0, anchor);
+ tex_set_saved_record(saved_full_spec_item_geometry, saved_box_geometry, 0, geometry);
+ tex_set_saved_record(saved_full_spec_item_xoffset, saved_box_xoffset, 0, xoffset);
+ tex_set_saved_record(saved_full_spec_item_yoffset, saved_box_yoffset, 0, yoffset);
+ tex_set_saved_record(saved_full_spec_item_xmove, saved_box_xmove, 0, xmove);
+ tex_set_saved_record(saved_full_spec_item_ymove, saved_box_ymove, 0, ymove);
+ tex_set_saved_record(saved_full_spec_item_reverse, saved_box_reverse, 0, reverse);
+ tex_set_saved_record(saved_full_spec_item_container, saved_box_container, 0, container);
+ tex_set_saved_record(saved_full_spec_item_shift, saved_box_shift, 0, shift);
+ tex_set_saved_record(saved_full_spec_item_source, saved_box_source, 0, source);
+ tex_set_saved_record(saved_full_spec_item_target, saved_box_target, 0, target);
+ tex_set_saved_record(saved_full_spec_item_axis, saved_box_axis, 0, axis);
+ tex_set_saved_record(saved_full_spec_item_class, saved_box_class, 0, mainclass);
+ tex_set_saved_record(saved_full_spec_item_state, saved_box_state, 0, state);
+ tex_set_saved_record(saved_full_spec_item_retain, saved_box_retain, 0, retain);
+ lmt_save_state.save_stack_data.ptr += saved_full_spec_n_of_items;
+ tex_new_save_level(c);
+ if (! brace) {
+ tex_scan_left_brace();
+ }
+ update_tex_par_direction(spec_direction);
+ update_tex_text_direction(spec_direction);
+}
+
+/*tex
+
+ To figure out the glue setting, |hpack| and |vpack| determine how much stretchability and
+ shrinkability are present, considering all four orders of infinity. The highest order of
+ infinity that has a nonzero coefficient is then used as if no other orders were present.
+
+ For example, suppose that the given list contains six glue nodes with the respective
+ stretchabilities |3pt|, |8fill|, |5fil|, |6pt|, |-3fil|, |-8fill|. Then the total is essentially
+ |2fil|; and if a total additional space of 6pt is to be achieved by stretching, the actual
+ amounts of stretch will be |0pt|, |0pt|, |15pt|, |0pt|, |-9pt|, and |0pt|, since only |fi| glue
+ will be considered. (The |fill| glue is therefore not really stretching infinitely with respect
+ to |fil|; nobody would actually want that to happen.)
+
+ The arrays |total_stretch| and |total_shrink| are used to determine how much glue of each kind
+ is present. A global variable |last_badness| is used to implement |\badness|.
+
+*/
+
+packaging_state_info lmt_packaging_state = {
+ .total_stretch = { 0 },
+ .total_shrink = { 0 }, /*tex glue found by |hpack| or |vpack| */
+ .last_badness = 0, /*tex badness of the most recently packaged box */
+ .last_overshoot = 0, /*tex overshoot of the most recently packaged box */
+ .post_adjust_tail = null, /*tex tail of adjustment list */
+ .pre_adjust_tail = null,
+ .post_migrate_tail = null, /*tex tail of migration list */
+ .pre_migrate_tail = null,
+ .last_leftmost_char = null,
+ .last_rightmost_char = null,
+ .pack_begin_line = 0,
+ /* .active_height = { 0 }, */
+ .best_height_plus_depth = 0,
+ .previous_char_ptr = null,
+ .font_expansion_ratio = 0,
+ .padding = 0,
+ .page_discards_tail = null,
+ .page_discards_head = null,
+ .split_discards_head = null,
+};
+
+/*tex
+
+ This state collects the glue found by |hpack| or |vpack|: |total_stretch| and |total_shrink|
+ and the badness of the most recently packaged box |last_badness|.
+
+ If the variable |adjust_tail| is non-null, the |hpack| routine also removes all occurrences of
+ |insert_node|, |mark_node|, and |adjust_node| items and appends the resulting material onto the
+ list that ends at location |adjust_tail|.
+
+ Tail of adjustment list is stored in |adjust_tail|. Materials in |\vadjust| used with |pre|
+ keyword will be appended to |pre_adjust_tail| instead of |adjust_tail|.
+
+ The optimizers use |last_leftmost_char| and last_rightmost_char|.
+
+ In order to provide a decent indication of where an overfull or underfull box originated, we
+ use a global variable |pack_begin_line| that is set nonzero only when |hpack| is being called
+ by the paragraph builder or the alignment finishing routine.
+
+ The source file line where the current paragraph or alignment began; a negative value denotes
+ alignment |pack_begin_line|.
+
+ Pointers to the prev and next char of an implicit kern are kept in |next_char_p| and
+ prev_char_p|.
+
+ The kern stretch and shrink code was (or had become) rather weird ... the width field is set,
+ and then used in a second calculation, repeatedly, so why is that \unknown\ maybe some some
+ weird left-over \unknown\ anyway, the values are so small that in practice they are not
+ significant at all when the backend sees them because a few hundred sp positive or negative are
+ just noise there (so adjustlevel 3 has hardly any consequence for the result but is more
+ efficient).
+
+ In the end I simplified the code because in practice these kerns can between glyphs burried in
+ discretionary nodes. Also, we don't enable it by default so let's just stick to the leftmost
+ character as reference. We can assume the same font anyway.
+
+*/
+
+scaled tex_char_stretch(halfword p) /* todo: move this to texfont.c and make it more efficient */
+{
+ if (! tex_has_glyph_option(p, glyph_option_no_expansion)) {
+ halfword f = glyph_font(p);
+ halfword m = font_max_stretch(f);
+ if (m > 0) {
+ halfword c = glyph_character(p);
+ halfword ef = tex_char_ef_from_font(f, c);
+ if (ef > 0) {
+ scaled dw = tex_calculated_glyph_width(p, m) - tex_char_width_from_glyph(p);
+ if (dw > 0) {
+ return tex_round_xn_over_d(dw, ef, 1000);
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+scaled tex_char_shrink(halfword p) /* todo: move this to texfont.c and make it more efficient */
+{
+ if (! tex_has_glyph_option(p, glyph_option_no_expansion)) {
+ halfword f = glyph_font(p);
+ halfword m = font_max_shrink(f);
+ if (m > 0) {
+ halfword c = glyph_character(p);
+ halfword ef = tex_char_ef_from_font(f, c);
+ if (ef > 0) {
+ scaled dw = tex_char_width_from_glyph(p) - tex_calculated_glyph_width(p, -m);
+ if (dw > 0) {
+ return tex_round_xn_over_d(dw, ef, 1000);
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+scaled tex_kern_stretch(halfword p)
+{
+ scaled w = kern_amount(p);
+ if (w) {
+ halfword l = lmt_packaging_state.previous_char_ptr;
+ if (l && node_type(l) == glyph_node && ! tex_has_glyph_option(l, glyph_option_no_expansion)) {
+ scaled m = font_max_stretch(glyph_font(l));
+ if (m > 0) {
+ scaled e = tex_char_ef_from_font(glyph_font(l), glyph_character(l));
+ if (e > 0) {
+ scaled dw = w - tex_round_xn_over_d(w, 1000 + m, 1000);
+ if (dw > 0) {
+ return tex_round_xn_over_d(dw, e, 1000);
+ }
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+scaled tex_kern_shrink(halfword p)
+{
+ scaled w = kern_amount(p) ;
+ if (w) {
+ halfword l = lmt_packaging_state.previous_char_ptr;
+ if (l && node_type(l) == glyph_node && ! tex_has_glyph_option(l, glyph_option_no_expansion)) {
+ halfword m = font_max_shrink(glyph_font(l));
+ if (m > 0) {
+ halfword e = tex_char_ef_from_font(glyph_font(l), glyph_character(l));
+ if (e > 0) {
+ scaled dw = tex_round_xn_over_d(w, 1000 - m, 1000) - w;
+ if (dw > 0) {
+ return tex_round_xn_over_d(dw, e, 1000);
+ }
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+static void tex_aux_set_kern_expansion(halfword p, halfword ex_ratio)
+{
+ scaled w = kern_amount(p) ;
+ if (w ) {
+ halfword l = lmt_packaging_state.previous_char_ptr;
+ if (l && node_type(l) == glyph_node && ! tex_has_glyph_option(l, glyph_option_no_expansion)) {
+ halfword f = glyph_font(l);
+ halfword c = glyph_character(l);
+ halfword ef = tex_char_ef_from_font(f, c);
+ if (ef == 0) {
+ return;
+ } else if (ex_ratio > 0) {
+ halfword m = font_max_stretch(f);
+ if (m > 0) {
+ halfword ex_stretch = tex_ext_xn_over_d(ex_ratio * ef, m, 1000000);
+ kern_expansion(p) = tex_fix_expand_value(f, ex_stretch) * 1000;
+ }
+ } else if (ex_ratio < 0) {
+ halfword m = font_max_shrink(f);
+ if (m > 0) {
+ halfword ex_shrink = tex_ext_xn_over_d(ex_ratio * ef, m, 1000000);
+ kern_expansion(p) = tex_fix_expand_value(f, ex_shrink) * 1000;
+ }
+ }
+ }
+ }
+}
+
+static void tex_aux_set_glyph_expansion(halfword p, int ex_ratio)
+{
+ switch (node_type(p)) {
+ case glyph_node:
+ if (! tex_has_glyph_option(p, glyph_option_no_expansion)) {
+ halfword f = glyph_font(p);
+ halfword c = glyph_character(p);
+ halfword ef = tex_char_ef_from_font(f, c);
+ if (ef == 0) {
+ return;
+ } else if (ex_ratio > 0) {
+ halfword m = font_max_stretch(f);
+ if (m > 0) {
+ halfword ex_stretch = tex_ext_xn_over_d(ex_ratio * ef, m, 1000000);
+ glyph_expansion(p) = tex_fix_expand_value(f, ex_stretch) * 1000;
+ }
+ } else if (ex_ratio < 0) {
+ halfword m = font_max_shrink(f);
+ if (m > 0) {
+ halfword ex_shrink = tex_ext_xn_over_d(ex_ratio * ef, m, 1000000);
+ glyph_expansion(p) = tex_fix_expand_value(f, ex_shrink) * 1000;
+ }
+ }
+ }
+ break;
+ case disc_node:
+ {
+ halfword r = disc_pre_break_head(p);
+ while (r) {
+ if (node_type(r) == glyph_node) {
+ tex_aux_set_glyph_expansion(r, ex_ratio);
+ }
+ r = node_next(r);
+ }
+ r = disc_post_break_head(p);
+ while (r) {
+ if (node_type(r) == glyph_node) {
+ tex_aux_set_glyph_expansion(r, ex_ratio);
+ }
+ r = node_next(r);
+ }
+ r = disc_no_break_head(p);
+ while (r) {
+ if (node_type(r) == glyph_node) {
+ tex_aux_set_glyph_expansion(r, ex_ratio);
+ }
+ r = node_next(r);
+ }
+ break;
+ }
+ default:
+ tex_normal_error("font expansion", "invalid node type");
+ break;
+ }
+}
+
+scaled tex_left_marginkern(halfword p)
+{
+ while (p && node_type(p) == glue_node) {
+ p = node_next(p);
+ }
+ if (p && node_type(p) == kern_node && node_subtype(p) == left_margin_kern_subtype) {
+ return kern_amount(p);
+ } else {
+ return 0;
+ }
+}
+
+scaled tex_right_marginkern(halfword p)
+{
+ if (p) {
+ p = tex_tail_of_node_list(p);
+ /*tex
+ There can be a leftskip, rightskip, penalty and yes, also a disc node with a nesting
+ node that points to glue spec ... and we don't want to analyze that messy lot.
+ */
+ while (p) {
+ switch(node_type(p)) {
+ case glue_node:
+ /*tex We backtrack over glue. */
+ p = node_prev(p);
+ break;
+ case kern_node:
+ if (node_subtype(p) == right_margin_kern_subtype) {
+ return kern_amount(p);
+ } else {
+ return 0;
+ }
+ case disc_node:
+ /*tex
+ Officially we should look in the replace but currently protrusion doesn't
+ work anyway with |foo\discretionary {} {} {bar-} | (no following char) so we
+ don't need it now.
+ */
+ p = node_prev(p);
+ if (p && node_type(p) == kern_node && node_subtype(p) == right_margin_kern_subtype) {
+ return kern_amount(p);
+ } else {
+ return 0;
+ }
+ default:
+ return 0;
+ }
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ Character protrusion is something we inherited from \PDFTEX\ and the next helper calculates
+ the extend.
+
+*/
+
+scaled tex_char_protrusion(halfword p, int side)
+{
+ if (side == left_margin_kern_subtype) {
+ lmt_packaging_state.last_leftmost_char = null;
+ } else {
+ lmt_packaging_state.last_rightmost_char = null;
+ }
+ if (! p || node_type(p) != glyph_node || tex_has_glyph_option(p, glyph_option_no_protrusion)) {
+ return 0;
+ } else if (side == left_margin_kern_subtype) {
+ lmt_packaging_state.last_leftmost_char = p;
+ return tex_char_lp_from_font(glyph_font(p), glyph_character(p));
+ } else {
+ lmt_packaging_state.last_rightmost_char = p;
+ return tex_char_rp_from_font(glyph_font(p), glyph_character(p));
+ }
+}
+
+/*tex
+
+ Here we prepare for |hpack|, which is place where we do font substituting when font expansion
+ is being used.
+
+*/
+
+int tex_ignore_math_skip(halfword p)
+{
+ if (math_skip_mode_par == 6) {
+ if (node_subtype(p) == end_inline_math) {
+ if (tex_math_skip_boundary(node_next(p))) {
+ return 0;
+ }
+ } else {
+ if (tex_math_skip_boundary(node_prev(p))) {
+ return 0;
+ }
+ }
+ } else if (math_skip_mode_par == 7) {
+ if (node_subtype(p) == end_inline_math) {
+ if (! tex_math_skip_boundary(node_next(p))) {
+ return 0;
+ }
+ } else {
+ if (! tex_math_skip_boundary(node_prev(p))) {
+ return 0;
+ }
+ }
+ } else {
+ return 0;
+ }
+ tex_reset_math_glue_to_zero(p);
+ return 1;
+}
+
+# define fix_int(val,min,max) (val < min ? min : (val > max ? max : val))
+
+inline static halfword tex_aux_used_order(halfword *total)
+{
+ if (total[filll_glue_order]) {
+ return filll_glue_order;
+ } else if (total[fill_glue_order]) {
+ return fill_glue_order;
+ } else if (total[fil_glue_order]) {
+ return fil_glue_order;
+ } else if (total[fi_glue_order]) {
+ return fi_glue_order;
+ } else {
+ return normal_glue_order;
+ }
+}
+
+/*tex
+
+ The original code mentions: \quotation {Transfer node |p| to the adjustment list. Although node
+ |q| is not necessarily the immediate predecessor of node |p|, it always points to some node in
+ the list preceding |p|. Thus, we can delete nodes by moving |q| when necessary. The algorithm
+ takes linear time, and the extra computation does not intrude on the inner loop unless it is
+ necessary to make a deletion.}. The trick used is the following:
+
+ \starttyping
+ q = r + list_offset;
+ node_next(q) = p;
+ ....
+ while (node_next(q) != p) {
+ q = node_next(q);
+ }
+ \stoptyping
+
+ This list offset points to the memory slot in the node and it happens that the next pointer
+ takes the same subfield as the normal next pointer (these are actually offsets in an array of
+ memorywords). This kind of neat trickery is needed because there are only forward linked lists,
+ but we can do it differently and thereby also use the normal list pointer. We need a bit more
+ checking but in the end we have a better abstraction.
+
+*/
+
+inline static void tex_aux_promote_pre_migrated(halfword r, halfword p)
+{
+ halfword pm = box_pre_migrated(p);
+ halfword pa = box_pre_adjusted(p);
+ if (pa) {
+ if (lmt_packaging_state.pre_adjust_tail) {
+ lmt_packaging_state.pre_adjust_tail = tex_append_adjust_list(pre_adjust_head, lmt_packaging_state.pre_adjust_tail, pa);
+ } else if (box_pre_adjusted(r)) {
+ tex_couple_nodes(box_pre_adjusted(r), pa);
+ } else {
+ box_pre_adjusted(r) = pa;
+ }
+ box_pre_adjusted(p) = null;
+ }
+ if (pm) {
+ if (lmt_packaging_state.pre_migrate_tail) {
+ tex_couple_nodes(lmt_packaging_state.pre_migrate_tail, pm);
+ lmt_packaging_state.pre_migrate_tail = tex_tail_of_node_list(pm);
+ } else {
+ /* here we prepend pm to rm */
+ halfword rm = box_pre_migrated(r);
+ if (rm) {
+ tex_couple_nodes(pm, rm);
+ }
+ box_pre_migrated(r) = pm;
+ }
+ box_pre_migrated(p) = null;
+ }
+}
+
+inline static void tex_aux_promote_post_migrated(halfword r, halfword p)
+{
+ halfword pm = box_post_migrated(p);
+ halfword pa = box_post_adjusted(p);
+ if (pa) {
+ if (lmt_packaging_state.post_adjust_tail) {
+ lmt_packaging_state.post_adjust_tail = tex_append_adjust_list(post_adjust_head, lmt_packaging_state.post_adjust_tail, pa);
+ } else if (box_post_adjusted(r)) {
+ tex_couple_nodes(box_post_adjusted(r), pa);
+ } else {
+ box_post_adjusted(r) = pa;
+ }
+ box_post_adjusted(p) = null;
+ }
+ if (pm) {
+ if (lmt_packaging_state.post_migrate_tail) {
+ tex_couple_nodes(lmt_packaging_state.post_migrate_tail, pm);
+ lmt_packaging_state.post_migrate_tail = tex_tail_of_node_list(pm);
+ } else {
+ /* here we append pm to rm */
+ halfword rm = box_post_migrated(r);
+ if (rm) {
+ tex_couple_nodes(tex_tail_of_node_list(rm), pm);
+ } else {
+ box_post_migrated(r) = pm;
+ }
+ }
+ box_post_migrated(p) = null;
+ }
+}
+
+inline static halfword tex_aux_post_migrate(halfword r, halfword p)
+{
+ halfword n = p;
+ halfword nn = node_next(p);
+ halfword pm = box_post_migrated(r);
+ if (p == box_list(r)) {
+ box_list(r) = nn;
+ if (nn) {
+ node_prev(nn) = null;
+ }
+ } else {
+ tex_couple_nodes(node_prev(p), nn);
+ }
+ if (pm) {
+ tex_couple_nodes(tex_tail_of_node_list(pm), n);
+ } else {
+ box_post_migrated(r) = n;
+ }
+ node_next(n) = null;
+ p = nn;
+ return p;
+}
+
+inline static halfword tex_aux_normal_migrate(halfword r, halfword p)
+{
+ halfword n = p;
+ halfword nn = node_next(p);
+ if (p == box_list(r)) {
+ box_list(r) = nn;
+ if (nn) {
+ node_prev(nn) = null;
+ }
+ } else {
+ tex_couple_nodes(node_prev(p), nn);
+ }
+ tex_couple_nodes(lmt_packaging_state.post_migrate_tail, n);
+ lmt_packaging_state.post_migrate_tail = n;
+ node_next(n) = null;
+ p = nn;
+ return p;
+}
+
+static void tex_aux_append_diagnostic_rule(halfword box, halfword rule)
+{
+ halfword n = box_list(box);
+ if (n) {
+ halfword t = tex_tail_of_node_list(n);
+ halfword c = t;
+ while (c && node_type(c) == glue_node) {
+ switch (node_subtype(c)) {
+ case par_fill_right_skip_glue:
+ case par_init_right_skip_glue:
+ case right_skip_glue:
+ case right_hang_skip_glue:
+ c = node_prev(c);
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ if (c) {
+ n = node_next(c);
+ if (n) {
+ tex_couple_nodes(rule, n);
+ }
+ } else {
+ c = t;
+ }
+ tex_couple_nodes(c, rule);
+ } else {
+ box_list(box) = rule;
+ }
+}
+
+void tex_repack(halfword p, scaled w, int m)
+{
+ if (p) {
+ halfword tmp;
+ switch (node_type(p)) {
+ case hlist_node:
+ tmp = tex_hpack(box_list(p), w, m, box_dir(p), holding_none_option);
+ break;
+ case vlist_node:
+ tmp = tex_vpack(box_list(p), w, m > packing_additional ? packing_additional : m, max_dimen, box_dir(p), holding_none_option);
+ break;
+ default:
+ return;
+ }
+ box_width(p) = box_width(tmp);
+ box_height(p) = box_height(tmp);
+ box_depth(p) = box_depth(tmp);
+ box_glue_set(p) = box_glue_set(tmp);
+ box_glue_order(p) = box_glue_order(tmp);
+ box_glue_sign(p) = box_glue_sign(tmp);
+ box_list(tmp) = null;
+ tex_flush_node(tmp);
+ }
+}
+
+// Not ok. For now we accept some drift and assume it averages out. Just
+// for fun we could actually store it in the glue set field afterwards.
+//
+// {
+// halfword drift = scaledround(wd) - ws;
+// if (drift < 0) {
+// d -= (double) drift;
+// wd -= (double) drift;
+// }
+// }
+
+void tex_freeze(halfword p, int recurse)
+{
+ if (p) {
+ switch (node_type(p)) {
+ case hlist_node:
+ {
+ halfword c = box_list(p);
+ double set = (double) box_glue_set(p);
+ halfword order = box_glue_order(p);
+ halfword sign = box_glue_sign(p);
+ while (c) {
+ switch (node_type(c)) {
+ case glue_node:
+ if (sign != normal_glue_sign) {
+ switch (sign) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(c) == order) {
+ glue_amount(c) += scaledround(glue_stretch(c) * set);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(c) == order) {
+ glue_amount(c) -= scaledround(glue_shrink(c) * set);
+ }
+ break;
+ }
+ glue_stretch(c) = 0;
+ glue_shrink(c) = 0;
+ glue_stretch_order(c) = 0;
+ glue_shrink_order(c) = 0;
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ {
+ if (recurse) {
+ tex_freeze(c, recurse);
+ }
+ break;
+ }
+ case math_node:
+ if (sign != normal_glue_sign) {
+ switch (sign) {
+ case stretching_glue_sign:
+ if (math_stretch_order(c) == order) {
+ math_amount(c) += scaledround(math_stretch(c) * set);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (math_shrink_order(c) == order) {
+ math_amount(c) += scaledround(math_shrink(c) * set);
+ }
+ break;
+ }
+ math_stretch(c) = 0;
+ math_shrink(c) = 0;
+ math_stretch_order(c) = 0;
+ math_shrink_order(c) = 0;
+ break;
+ }
+ default:
+ break;
+ }
+ c = node_next(c);
+ }
+ box_glue_set(p) = 0;
+ box_glue_order(p) = 0;
+ box_glue_sign(p) = 0;
+ }
+ break;
+ case vlist_node:
+ {
+ halfword c = box_list(p);
+ double set = (double) box_glue_set(p);
+ halfword order = box_glue_order(p);
+ halfword sign = box_glue_sign(p);
+ while (c) {
+ switch (node_type(c)) {
+ case glue_node:
+ if (sign != normal_glue_sign) {
+ switch (sign) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(c) == order) {
+ glue_amount(c) += scaledround(glue_stretch(c) * set);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(c) == order) {
+ glue_amount(c) -= scaledround(glue_shrink(c) * set);
+ }
+ break;
+ }
+ glue_stretch(c) = 0;
+ glue_shrink(c) = 0;
+ glue_stretch_order(c) = 0;
+ glue_shrink_order(c) = 0;
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ {
+ if (recurse) {
+ tex_freeze(c, recurse);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+ c = node_next(c);
+ }
+ box_glue_set(p) = 0;
+ box_glue_order(p) = 0;
+ box_glue_sign(p) = 0;
+ }
+ break;
+ default:
+ return;
+ }
+ }
+}
+
+halfword tex_hpack(halfword p, scaled w, int m, singleword pack_direction, int retain)
+{
+ /*tex trails behind |p| */
+ halfword q = null;
+ /*tex height */
+ scaled h = 0;
+ /*tex depth */
+ scaled d = 0;
+ /*tex natural width */
+ scaled x = 0;
+ /*tex the current direction */
+ singleword hpack_dir = pack_direction == direction_unknown ? text_direction_par : pack_direction;
+ int disc_level = 0;
+ halfword pack_interrupt[8];
+ scaled font_stretch = 0;
+ scaled font_shrink = 0;
+ int adjust_spacing = adjust_spacing_off;
+ /*tex the box node that will be returned */
+ halfword r = tex_new_node(hlist_node, unknown_list);
+ box_dir(r) = hpack_dir;
+ lmt_packaging_state.last_badness = 0;
+ lmt_packaging_state.last_overshoot = 0;
+ // if (! p) {
+ // box_width(r) = w;
+ // return r;
+ // }
+ if (m == packing_linebreak) {
+ m = packing_expanded;
+ adjust_spacing = tex_checked_font_adjust(
+ lmt_linebreak_state.adjust_spacing,
+ lmt_linebreak_state.adjust_spacing_step,
+ lmt_linebreak_state.adjust_spacing_shrink,
+ lmt_linebreak_state.adjust_spacing_stretch
+ );
+ } else {
+ adjust_spacing = tex_checked_font_adjust(
+ adjust_spacing_par,
+ adjust_spacing_step_par,
+ adjust_spacing_shrink_par,
+ adjust_spacing_stretch_par
+ );
+ }
+ /*tex
+
+ A potential optimization, saves a little but neglectable in practice (not that many empty
+ boxes are used):
+
+ \starttyping
+ if (! p) {
+ box_width(r) = w;
+ return r;
+ }
+ \stoptyping
+
+ */
+ box_list(r) = p;
+ if (m == packing_expanded) {
+ /*tex Why not always: */
+ lmt_packaging_state.previous_char_ptr = null;
+ } else if (m == packing_adapted) {
+ if (w > 1000) {
+ w = 1000;
+ } else if (w < -1000) {
+ w = -1000;
+ }
+ }
+ for (int i = normal_glue_order; i <= filll_glue_order; i++) {
+ lmt_packaging_state.total_stretch[i] = 0;
+ lmt_packaging_state.total_shrink[i] = 0;
+ }
+ /*tex
+
+ Examine node |p| in the hlist, taking account of its effect on the dimensions of the new
+ box, or moving it to the adjustment list; then advance |p| to the next node. For disc
+ node we enter a level so we don't use recursion.
+
+ In other engines there is an optimization for glyph runs but here we use just one switch
+ for everything. The performance hit is neglectable. So the comment \quotation {Incorporate
+ character dimensions into the dimensions of the hbox that will contain~it, then move to
+ the next node.} no longer applies. In \LUATEX\ ligature building, kerning and hyphenation
+ are decoupled so comments about inner loop and performance no longer make sense here.
+
+ */
+ while (p) {
+ switch (node_type(p)) {
+ case glyph_node:
+ {
+ scaledwhd whd;
+ if (adjust_spacing) {
+ switch (m) {
+ case packing_expanded:
+ {
+ lmt_packaging_state.previous_char_ptr = p;
+ font_stretch += tex_char_stretch(p);
+ font_shrink += tex_char_shrink(p);
+ break;
+ }
+ case packing_substitute:
+ {
+ lmt_packaging_state.previous_char_ptr = p;
+ tex_aux_set_glyph_expansion(p, lmt_packaging_state.font_expansion_ratio);
+ break;
+ }
+ }
+ }
+ whd = tex_glyph_dimensions_ex(p);
+ x += whd.wd;
+ if (whd.ht > h) {
+ h = whd.ht;
+ }
+ if (whd.dp > d) {
+ d = whd.dp;
+ }
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ {
+ /*tex
+
+ Incorporate box dimensions into the dimensions of the hbox that will contain
+ it.
+
+ */
+ halfword s = box_shift_amount(p);
+ scaledwhd whd = tex_pack_dimensions(p);
+ x += whd.wd;
+ if (whd.ht - s > h) {
+ h = whd.ht - s;
+ }
+ if (whd.dp + s > d) {
+ d = whd.dp + s;
+ }
+ tex_aux_promote_pre_migrated(r, p);
+ tex_aux_promote_post_migrated(r, p);
+ break;
+ }
+ case unset_node:
+ x += box_width(p);
+ if (box_height(p) > h) {
+ h = box_height(p);
+ }
+ if (box_depth(p) > d) {
+ d = box_depth(p);
+ }
+ // tex_aux_promote_pre_migrated(r, p);
+ // tex_aux_promote_post_migrated(r, p);
+ break;
+ case rule_node:
+ /*tex
+
+ The code here implicitly uses the fact that running dimensions are indicated
+ by |null_flag|, which will be ignored in the calculations because it is a
+ highly negative number.
+
+ */
+ x += rule_width(p);
+ if (rule_height(p) > h) {
+ h = rule_height(p);
+ }
+ if (rule_depth(p) > d) {
+ d = rule_depth(p);
+ }
+ break;
+ case glue_node:
+ /*tex Incorporate glue into the horizontal totals. Can this overflow? */
+ {
+ switch (m) {
+ case packing_adapted:
+ if (w < 0) {
+ if (glue_shrink_order(p) == normal_glue_order) {
+ glue_amount(p) -= scaledround(-0.001 * w * (double) glue_shrink(p));
+ }
+ } else if (w > 0) {
+ if (glue_stretch_order(p) == normal_glue_order) {
+ glue_amount(p) += scaledround( 0.001 * w * (double) glue_stretch(p));
+ }
+ }
+ x += glue_amount(p);
+ glue_shrink_order(p) = normal_glue_order;
+ glue_shrink(p) = 0;
+ glue_stretch_order(p) = normal_glue_order;
+ glue_stretch(p) = 0;
+ break;
+ default:
+ {
+ halfword o;
+ x += glue_amount(p);
+ o = glue_stretch_order(p);
+ lmt_packaging_state.total_stretch[o] += glue_stretch(p);
+ o = glue_shrink_order(p);
+ lmt_packaging_state.total_shrink[o] += glue_shrink(p);
+ }
+ }
+ if (is_leader(p)) {
+ halfword gl = glue_leader_ptr(p);
+ scaled ht = 0;
+ scaled dp = 0;
+ switch (node_type(gl)) {
+ case hlist_node:
+ case vlist_node:
+ ht = box_height(gl);
+ dp = box_depth(gl);
+ break;
+ case rule_node:
+ ht = rule_height(gl);
+ dp = rule_depth(gl);
+ break;
+ }
+ if (ht > h) {
+ h = ht;
+ }
+ if (dp > d) {
+ d = dp;
+ }
+ }
+ break;
+ }
+ case kern_node:
+ if (adjust_spacing == adjust_spacing_full && node_subtype(p) == font_kern_subtype) {
+ switch (m) {
+ case packing_expanded:
+ {
+ font_stretch += tex_kern_stretch(p);
+ font_shrink += tex_kern_shrink(p);
+ break;
+ }
+ case packing_substitute:
+ {
+ tex_aux_set_kern_expansion(p, lmt_packaging_state.font_expansion_ratio);
+ break;
+ }
+ }
+ }
+ x += tex_kern_dimension_ex(p);
+ break;
+ case disc_node:
+ if (adjust_spacing) {
+ switch (m) {
+ case packing_expanded:
+ /*tex
+ Won't give this issues with complex discretionaries as we don't
+ do the |packing_expand| here? I need to look into this!
+ */
+ break;
+ case packing_substitute:
+ tex_aux_set_glyph_expansion(p, lmt_packaging_state.font_expansion_ratio);
+ break;
+ }
+ }
+ if (disc_no_break_head(p)) {
+ pack_interrupt[disc_level] = node_next(p);
+ ++disc_level;
+ p = disc_no_break(p);
+ }
+ break;
+ case math_node:
+ if (tex_math_glue_is_zero(p) || tex_ignore_math_skip(p)) {
+ x += math_surround(p);
+ } else {
+ halfword o;
+ x += math_amount(p);
+ o = math_stretch_order(p);
+ lmt_packaging_state.total_stretch[o] += math_stretch(p);
+ o = math_shrink_order(p);
+ lmt_packaging_state.total_shrink[o] += math_shrink(p);
+ }
+ break;
+ case dir_node:
+ break;
+ case insert_node:
+ if (retain_inserts(retain)) {
+ break;
+ } else if (lmt_packaging_state.post_migrate_tail) {
+ p = tex_aux_normal_migrate(r, p);
+ /*tex Here |q| stays as it is and we're already at next. */
+ continue;
+ } else if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_insert)) {
+ halfword l = insert_list(p);
+ p = tex_aux_post_migrate(r, p);
+ while (l) {
+ l = node_type(l) == insert_node ? tex_aux_post_migrate(r, l) : node_next(l);
+ }
+ /*tex Here |q| stays as it is and we're already at next. */
+ continue;
+ } else {
+ /*tex Nothing done, so we move on. */
+ break;
+ }
+ case mark_node:
+ if (retain_marks(retain)) {
+ break;
+ } else if (lmt_packaging_state.post_migrate_tail) {
+ p = tex_aux_normal_migrate(r, p);
+ /*tex Here |q| stays as it is and we're already at next. */
+ continue;
+ } else if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_mark)) {
+ p = tex_aux_post_migrate(r, p);
+ /*tex Here |q| stays as it is and we're already at next. */
+ continue;
+ } else {
+ /*tex Nothing done, so we move on. */
+ break;
+ }
+ case adjust_node:
+ /*tex
+ We could combine this with migration code but adjust content actually is taken into account
+ as part of the flow (dimensions, penalties, etc).
+ */
+ if (adjust_list(p) && ! retain_adjusts(retain)) {
+ halfword next = node_next(p);
+ halfword current = p;
+ /*tex Remove from list: */
+ if (p == box_list(r)) {
+ box_list(r) = next;
+ if (next) {
+ node_prev(next) = null;
+ }
+ } else {
+ tex_couple_nodes(node_prev(p), next);
+ }
+ if (lmt_packaging_state.post_adjust_tail || lmt_packaging_state.pre_adjust_tail) {
+ tex_adjust_passon(r, current);
+ } else if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_adjust)) {
+ tex_adjust_attach(r, current);
+ }
+ p = next;
+ continue;
+ } else {
+ break;
+ }
+ default:
+ break;
+ }
+ /*
+ This is kind of tricky: q is the pre-last pointer so we don't change it when we're
+ inside a disc node. This way of keeping track of the last node is different from the
+ previous engine.
+ */
+ if (disc_level > 0) {
+ p = node_next(p);
+ if (! p) {
+ --disc_level;
+ p = pack_interrupt[disc_level];
+ }
+ } else {
+ q = p;
+ p = node_next(p);
+ }
+ }
+ box_height(r) = h;
+ box_depth(r) = d;
+ /*tex
+ Determine the value of |width(r)| and the appropriate glue setting; then |return| or |goto
+ common_ending|. When we get to the present part of the program, |x| is the natural width of
+ the box being packaged.
+ */
+ switch (m) {
+ case packing_additional:
+ w += x;
+ break;
+ case packing_adapted:
+ w = x;
+ break;
+ }
+ box_width(r) = w;
+ x = w - x;
+ /*tex Now |x| is the excess to be made up. */
+ if (x == 0) {
+ box_glue_sign(r) = normal_glue_sign;
+ box_glue_order(r) = normal_glue_order;
+ box_glue_set(r) = 0.0;
+ goto EXIT;
+ } else if (x > 0) {
+ /*tex
+ Determine horizontal glue stretch setting, then |return| or |goto common_ending|. If
+ |hpack| is called with |m=cal_expand_ratio| we calculate |font_expand_ratio| and return
+ without checking for overfull or underfull box.
+ */
+ halfword o = tex_aux_used_order(lmt_packaging_state.total_stretch);
+ if ((m == packing_expanded) && (o == normal_glue_order) && (font_stretch > 0)) {
+ lmt_packaging_state.font_expansion_ratio = tex_divide_scaled_n(x, font_stretch, 1000.0);
+ goto EXIT;
+ }
+ box_glue_order(r) = o;
+ box_glue_sign(r) = stretching_glue_sign;
+ if (lmt_packaging_state.total_stretch[o]) {
+ box_glue_set(r) = (glueratio) ((double) x / lmt_packaging_state.total_stretch[o]);
+ } else {
+ /*tex There's nothing to stretch. */
+ box_glue_sign(r) = normal_glue_sign;
+ box_glue_set(r) = 0.0;
+ }
+ if (o == normal_glue_order && box_list(r)) {
+ /*tex
+ Report an underfull hbox and |goto common_ending|, if this box is sufficiently bad.
+ */
+ lmt_packaging_state.last_badness = tex_badness(x, lmt_packaging_state.total_stretch[normal_glue_order]);
+ if (lmt_packaging_state.last_badness > hbadness_par) {
+ int callback_id = lmt_callback_defined(hpack_quality_callback);
+ if (callback_id > 0) {
+ if (q) {
+ halfword rule = null;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "SdNddS->N",
+ lmt_packaging_state.last_badness > 100 ? "underfull" : "loose",
+ lmt_packaging_state.last_badness,
+ r,
+ abs(lmt_packaging_state.pack_begin_line),
+ lmt_input_state.input_line,
+ tex_current_input_file_name(),
+ &rule
+ );
+ if (rule) {
+ tex_aux_append_diagnostic_rule(r, rule);
+ }
+ }
+ } else {
+ tex_print_nlp();
+ if (lmt_packaging_state.last_badness > 100) {
+ tex_print_format("%l[package: underfull \\hbox (badness %i)", lmt_packaging_state.last_badness);
+ } else {
+ tex_print_format("%l[package: loose \\hbox (badness %i)", lmt_packaging_state.last_badness);
+ }
+ goto COMMON_ENDING;
+ }
+ }
+ }
+ goto EXIT;
+ } else {
+ /*tex
+ Determine horizontal glue shrink setting, then |return| or |goto common_ending|,
+ */
+ halfword o = tex_aux_used_order(lmt_packaging_state.total_shrink);
+ if ((m == packing_expanded) && (o == normal_glue_order) && (font_shrink > 0)) {
+ lmt_packaging_state.font_expansion_ratio = tex_divide_scaled_n(x, font_shrink, 1000.0);
+ goto EXIT;
+ }
+ box_glue_order(r) = o;
+ box_glue_sign(r) = shrinking_glue_sign;
+ if (lmt_packaging_state.total_shrink[o]) {
+ box_glue_set(r) = (glueratio) ((double) (-x) / (double) lmt_packaging_state.total_shrink[o]);
+ } else {
+ /*tex There's nothing to shrink. */
+ box_glue_sign(r) = normal_glue_sign;
+ box_glue_set(r) = 0.0;
+ }
+ if ((lmt_packaging_state.total_shrink[o] < -x) && (o == normal_glue_order) && (box_list(r))) {
+ int overshoot = -x - lmt_packaging_state.total_shrink[normal_glue_order];
+ lmt_packaging_state.last_badness = 1000000;
+ lmt_packaging_state.last_overshoot = overshoot;
+ /*tex Use the maximum shrinkage */
+ box_glue_set(r) = 1.0;
+ /*tex Report an overfull hbox and |goto common_ending|, if this box is sufficiently bad. */
+ if ((overshoot > hfuzz_par) || (hbadness_par < 100)) {
+ int callback_id = lmt_callback_defined(hpack_quality_callback);
+ halfword rule = null;
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "SdNddS->N",
+ "overfull",
+ overshoot,
+ r,
+ abs(lmt_packaging_state.pack_begin_line),
+ lmt_input_state.input_line,
+ tex_current_input_file_name(),
+ &rule);
+ } else if (q && overfull_rule_par > 0) {
+ rule = tex_new_rule_node(normal_rule_subtype);
+ rule_width(rule) = overfull_rule_par;
+ }
+ if (rule) {
+ tex_aux_append_diagnostic_rule(r, rule);
+ }
+ if (callback_id == 0) {
+ tex_print_nlp();
+ tex_print_format("%l[package: overfull \\hbox (%D too wide)", overshoot, pt_unit);
+ goto COMMON_ENDING;
+ }
+ }
+ } else if (o == normal_glue_order) {
+ if (box_list(r)) {
+ /*tex Report a tight hbox and |goto common_ending|, if this box is sufficiently bad. */
+ lmt_packaging_state.last_badness = tex_badness(-x, lmt_packaging_state.total_shrink[normal_glue_order]);
+ if (lmt_packaging_state.last_badness > hbadness_par) {
+ int callback_id = lmt_callback_defined(hpack_quality_callback);
+ if (callback_id > 0) {
+ halfword rule = null;
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "SdNddS->N",
+ "tight",
+ lmt_packaging_state.last_badness,
+ r,
+ abs(lmt_packaging_state.pack_begin_line),
+ lmt_input_state.input_line,
+ tex_current_input_file_name(),
+ &rule);
+ if (rule) {
+ tex_aux_append_diagnostic_rule(r, rule);
+ }
+ } else {
+ tex_print_nlp();
+ tex_print_format("%l[package: tight \\hbox (badness %i)", lmt_packaging_state.last_badness);
+ goto COMMON_ENDING;
+ }
+ }
+ }
+ }
+ goto EXIT;
+ }
+ COMMON_ENDING:
+ /*tex Finish issuing a diagnostic message for an overfull or underfull hbox. */
+ if (lmt_page_builder_state.output_active) {
+ tex_print_format(" has occurred while \\output is active]");
+ } else if (lmt_packaging_state.pack_begin_line == 0) {
+ tex_print_format(" detected at line %i]", lmt_input_state.input_line);
+ } else if (lmt_packaging_state.pack_begin_line > 0) {
+ tex_print_format(" in paragraph at lines %i--%i]", lmt_packaging_state.pack_begin_line, lmt_input_state.input_line);
+ } else {
+ tex_print_format(" in alignment at lines %i--%i]", -lmt_packaging_state.pack_begin_line, lmt_input_state.input_line);
+ }
+ tex_print_ln();
+ lmt_print_state.font_in_short_display = null_font;
+ if (tracing_full_boxes_par > 0) {
+ halfword detail = show_node_details_par;
+ show_node_details_par = tracing_full_boxes_par;
+ tex_short_display(box_list(r));
+ tex_print_ln();
+ tex_begin_diagnostic();
+ tex_show_box(r);
+ tex_end_diagnostic();
+ show_node_details_par = detail;
+ }
+ EXIT:
+ if ((m == packing_expanded) && (lmt_packaging_state.font_expansion_ratio != 0)) {
+ lmt_packaging_state.font_expansion_ratio = fix_int(lmt_packaging_state.font_expansion_ratio, -1000, 1000);
+ q = box_list(r);
+ box_list(r) = null;
+ tex_flush_node(r);
+ /*tex This nested call uses the more or less global font_expand_ratio. */
+ r = tex_hpack(q, w, packing_substitute, hpack_dir, holding_none_option);
+ }
+ /*tex Here we reset the |font_expand_ratio|. */
+ lmt_packaging_state.font_expansion_ratio = 0;
+ return r;
+}
+
+halfword tex_filtered_hpack(halfword p, halfword qt, scaled w, int m, int grp, halfword d, int just_pack, halfword attr, int state, int retain)
+{
+ halfword head;
+ singleword direction = checked_direction_value(d);
+ (void) state; /*tex Why do we pass it? Probably a left-over from an experiment. */
+ if (just_pack) {
+ head = node_next(p);
+ } else if (node_type(p) == temp_node && ! node_next(p)) {
+ head = node_next(p);
+ } else {
+ /*tex Maybe here: |node_prev(p) = null|. */
+ head = node_next(p);
+ if (head) {
+ node_prev(head) = null;
+ if (tex_list_has_glyph(head)) {
+ tex_handle_hyphenation(head, qt);
+ head = tex_handle_glyphrun(head, grp, direction);
+ }
+ if (head) {
+ /*tex ignores empty anyway. Maybe also pass tail? */
+ head = lmt_hpack_filter_callback(head, w, m, grp, direction, attr);
+ }
+ }
+ }
+ return tex_hpack(head, w, m, direction, retain);
+}
+
+/*tex Here is a function to calculate the natural whd of a (horizontal) node list. */
+
+scaledwhd tex_natural_hsizes(halfword p, halfword pp, glueratio g_mult, int g_sign, int g_order)
+{
+ scaledwhd siz = { 0, 0, 0 };
+ scaled gp = 0;
+ scaled gm = 0;
+ while (p && p != pp) {
+ switch (node_type(p)) {
+ case glyph_node:
+ {
+ scaledwhd whd = tex_glyph_dimensions_ex(p);
+ siz.wd += whd.wd;
+ if (whd.ht > siz.ht) {
+ siz.ht = whd.ht;
+ }
+ if (whd.dp > siz.dp) {
+ siz.dp = whd.dp;
+ }
+ break;
+ }
+ case hlist_node:
+ case vlist_node:
+ {
+ scaled s = box_shift_amount(p);
+ scaledwhd whd = tex_pack_dimensions(p);
+ siz.wd += whd.wd;
+ if (whd.ht - s > siz.ht) {
+ siz.ht = whd.ht - s;
+ }
+ if (whd.dp + s > siz.dp) {
+ siz.dp = whd.dp + s;
+ }
+ break;
+ }
+ case unset_node:
+ siz.wd += box_width(p);
+ if (box_height(p) > siz.ht) {
+ siz.ht = box_height(p);
+ }
+ if (box_depth(p) > siz.dp) {
+ siz.dp = box_depth(p);
+ }
+ break;
+ case rule_node:
+ siz.wd += rule_width(p);
+ if (rule_height(p) > siz.ht) {
+ siz.ht = rule_height(p);
+ }
+ if (rule_depth(p) > siz.dp) {
+ siz.dp = rule_depth(p);
+ }
+ break;
+ case glue_node:
+ siz.wd += glue_amount(p);
+ switch (g_sign) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(p) == g_order) {
+ gp += glue_stretch(p);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(p) == g_order) {
+ gm += glue_shrink(p);
+ }
+ break;
+ }
+ if (is_leader(p)) {
+ halfword gl = glue_leader_ptr(p);
+ halfword ht = 0;
+ halfword dp = 0;
+ switch (node_type(gl)) {
+ case hlist_node:
+ case vlist_node:
+ ht = box_height(gl);
+ dp = box_depth(gl);
+ break;
+ case rule_node:
+ ht = rule_height(gl);
+ dp = rule_depth(gl);
+ break;
+ }
+ if (ht) {
+ siz.ht = ht;
+ }
+ if (dp > siz.dp) {
+ siz.dp = dp;
+ }
+ }
+ break;
+ case kern_node:
+ siz.wd += tex_kern_dimension_ex(p);
+ break;
+ case disc_node:
+ {
+ scaledwhd whd = tex_natural_hsizes(disc_no_break_head(p), null, g_mult, g_sign, g_order); /* hm, really glue here? */
+ siz.wd += whd.wd;
+ if (whd.ht > siz.ht) {
+ siz.ht = whd.ht;
+ }
+ if (whd.dp > siz.dp) {
+ siz.dp = whd.dp;
+ }
+ }
+ break;
+ case math_node:
+ if (tex_math_glue_is_zero(p) || tex_ignore_math_skip(p)) {
+ siz.wd += math_surround(p);
+ } else {
+ siz.wd += math_amount(p);
+ switch (g_sign) {
+ case stretching_glue_sign:
+ if (math_stretch_order(p) == g_order) {
+ gp += math_stretch(p);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (math_shrink_order(p) == g_order) {
+ gm += math_shrink(p);
+ }
+ break;
+ }
+ }
+ break;
+ case sub_box_node:
+ /* really? */
+ break;
+ case sub_mlist_node:
+ {
+ /* hack */
+ scaledwhd whd = tex_natural_hsizes(kernel_math_list(p), null, 0.0, 0, 0);
+ siz.wd += whd.wd;
+ if (whd.ht > siz.ht) {
+ siz.ht = whd.ht;
+ }
+ if (whd.dp > siz.dp) {
+ siz.dp = whd.dp;
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ p = node_next(p);
+ }
+ switch (g_sign) {
+ case stretching_glue_sign:
+ siz.wd += glueround((glueratio)(g_mult) * (glueratio)(gp));
+ break;
+ case shrinking_glue_sign:
+ siz.wd -= glueround((glueratio)(g_mult) * (glueratio)(gm));
+ break;
+ }
+ return siz;
+}
+
+scaledwhd tex_natural_vsizes(halfword p, halfword pp, glueratio g_mult, int g_sign, int g_order)
+{
+ scaledwhd siz = { 0, 0, 0 };
+ scaled gp = 0;
+ scaled gm = 0;
+ while (p && p != pp) {
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ scaled s = box_shift_amount(p);
+ scaledwhd whd = tex_pack_dimensions(p);
+ if (whd.wd + s > siz.wd) {
+ siz.wd = whd.wd + s;
+ }
+ siz.ht += siz.dp + whd.ht;
+ siz.dp = whd.dp;
+ }
+ break;
+ case unset_node:
+ siz.ht += siz.dp + box_height(p);
+ siz.dp = box_depth(p);
+ if (box_width(p) > siz.wd) {
+ siz.wd = box_width(p);
+ }
+ break;
+ case rule_node:
+ siz.ht += siz.dp + rule_height(p);
+ siz.dp = rule_depth(p);
+ if (rule_width(p) > siz.wd) {
+ siz.wd = rule_width(p);
+ }
+ break;
+ case glue_node:
+ {
+ siz.ht += siz.dp + glue_amount(p);
+ siz.dp = 0;
+ if (is_leader(p)) {
+ halfword gl = glue_leader_ptr(p);
+ halfword wd = 0;
+ switch (node_type(gl)) {
+ case hlist_node:
+ case vlist_node:
+ wd = box_width(gl);
+ break;
+ case rule_node:
+ wd = rule_width(gl);
+ break;
+ }
+ if (wd > siz.wd) {
+ siz.wd = wd;
+ }
+ }
+ switch (g_sign) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(p) == g_order) {
+ gp += glue_stretch(p);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(p) == g_order) {
+ gm += glue_shrink(p);
+ }
+ break;
+ }
+ break;
+ }
+ case kern_node:
+ siz.ht += siz.dp + kern_amount(p);
+ siz.dp = 0;
+ break;
+ case glyph_node:
+ tex_confusion("glyph in vpack");
+ break;
+ case disc_node:
+ tex_confusion("discretionary in vpack");
+ break;
+ default:
+ break;
+ }
+ p = node_next(p);
+ }
+ switch (g_sign) {
+ case stretching_glue_sign:
+ siz.ht += glueround((glueratio)(g_mult) * (glueratio)(gp));
+ break;
+ case shrinking_glue_sign:
+ siz.ht -= glueround((glueratio)(g_mult) * (glueratio)(gm));
+ break;
+ }
+ return siz;
+}
+
+/*tex simplified variant with less memory access */
+
+halfword tex_natural_width(halfword p, halfword pp, glueratio g_mult, int g_sign, int g_order)
+{
+ scaled wd = 0;
+ scaled gp = 0;
+ scaled gm = 0;
+ while (p && p != pp) {
+ /* no real gain over check in switch */
+ switch (node_type(p)) {
+ case glyph_node:
+ wd += tex_glyph_width(p); /* Plus expansion? */
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ wd += box_width(p);
+ break;
+ case rule_node:
+ wd += rule_width(p);
+ break;
+ case glue_node:
+ wd += glue_amount(p);
+ switch (g_sign) {
+ case stretching_glue_sign:
+ if (glue_stretch_order(p) == g_order) {
+ gp += glue_stretch(p);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (glue_shrink_order(p) == g_order) {
+ gm += glue_shrink(p);
+ }
+ break;
+ }
+ break;
+ case kern_node:
+ wd += kern_amount(p); // + kern_expansion(p);
+ break;
+ case disc_node:
+ wd += tex_natural_width(disc_no_break(p), null, g_mult, g_sign, g_order);
+ break;
+ case math_node:
+ if (tex_math_glue_is_zero(p) || tex_ignore_math_skip(p)) {
+ wd += math_surround(p);
+ } else {
+ wd += math_amount(p);
+ switch (g_sign) {
+ case stretching_glue_sign:
+ if (math_stretch_order(p) == g_order) {
+ gp += math_stretch(p);
+ }
+ break;
+ case shrinking_glue_sign:
+ if (math_shrink_order(p) == g_order) {
+ gm += math_shrink(p);
+ }
+ break;
+ }
+ }
+ break;
+ default:
+ break;
+ }
+ p = node_next(p);
+ }
+ switch (g_sign) {
+ case stretching_glue_sign:
+ wd += glueround((glueratio) (g_mult) * (glueratio) (gp));
+ break;
+ case shrinking_glue_sign:
+ wd -= glueround((glueratio) (g_mult) * (glueratio) (gm));
+ break;
+ }
+ return wd;
+}
+
+halfword tex_natural_hsize(halfword p, halfword *correction)
+{
+ scaled wd = 0;
+ halfword c = null;
+ while (p) {
+ switch (node_type(p)) {
+ case glyph_node:
+ wd += tex_glyph_width(p); /* Plus expansion? */
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ wd += box_width(p);
+ break;
+ case rule_node:
+ wd += rule_width(p);
+ break;
+ case glue_node:
+ wd += glue_amount(p);
+ if (node_subtype(p) == correction_skip_glue) {
+ c = p;
+ }
+ break;
+ case kern_node:
+ wd += kern_amount(p); // + kern_expansion(p);
+ break;
+ case disc_node:
+ wd += tex_natural_hsize(disc_no_break(p), NULL);
+ break;
+ case math_node:
+ if (tex_math_glue_is_zero(p) || tex_ignore_math_skip(p)) {
+ wd += math_surround(p);
+ } else {
+ wd += math_amount(p);
+ }
+ break;
+ default:
+ break;
+ }
+ p = node_next(p);
+ }
+ if (correction) {
+ *correction = c;
+ }
+ return wd;
+}
+
+halfword tex_natural_vsize(halfword p)
+{
+ scaledwhd siz = { 0, 0, 0 };
+ while (p) {
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ scaledwhd whd = tex_pack_dimensions(p);
+ siz.ht += siz.dp + whd.ht;
+ siz.dp = whd.dp;
+ }
+ break;
+ case unset_node:
+ siz.ht += siz.dp + box_height(p);
+ siz.dp = box_depth(p);
+ break;
+ case rule_node:
+ siz.ht += siz.dp + rule_height(p);
+ siz.dp = rule_depth(p);
+ break;
+ case glue_node:
+ siz.ht += siz.dp + glue_amount(p);
+ siz.dp = 0;
+ break;
+ case kern_node:
+ siz.ht += siz.dp + kern_amount(p);
+ siz.dp = 0;
+ break;
+ default:
+ break;
+ }
+ p = node_next(p);
+ }
+ return siz.ht + siz.dp;
+}
+
+/*tex
+
+ The |vpack| subroutine is actually a special case of a slightly more general routine called
+ |vpackage|, which has four parameters. The fourth parameter, which is |max_dimen| in the case
+ of |vpack|, specifies the maximum depth of the page box that is constructed. The depth is first
+ computed by the normal rules; if it exceeds this limit, the reference point is simply moved
+ down until the limiting depth is attained. We actually hav efive parameters because we also
+ deal with teh direction.
+
+*/
+
+halfword tex_vpack(halfword p, scaled h, int m, scaled l, singleword pack_direction, int retain)
+{
+ /*tex width */
+ scaled w = 0;
+ /*tex depth */
+ scaled d = 0;
+ /*tex natural height */
+ scaled x = 0;
+ /*tex the box node that will be returned */
+ halfword r = tex_new_node(vlist_node, unknown_list);
+ (void) retain; /* todo */
+ box_dir(r) = pack_direction;
+ node_subtype(r) = min_quarterword;
+ box_shift_amount(r) = 0;
+ box_list(r) = p;
+ lmt_packaging_state.last_badness = 0;
+ lmt_packaging_state.last_overshoot = 0;
+ for (int i = normal_glue_order; i <= filll_glue_order; i++) {
+ lmt_packaging_state.total_stretch[i] = 0;
+ lmt_packaging_state.total_shrink[i] = 0;
+ }
+ while (p) {
+ /*tex
+
+ Examine node |p| in the vlist, taking account of its effect on the dimensions of the
+ new box; then advance |p| to the next node.
+
+ */
+ halfword n = node_next(p);
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ /*tex
+
+ Incorporate box dimensions into the dimensions of the vbox that will
+ contain it.
+
+ */
+ scaled s = box_shift_amount(p);
+ scaledwhd whd = tex_pack_dimensions(p);
+ if (whd.wd + s > w) {
+ w = whd.wd + s;
+ }
+ x += d + whd.ht;
+ d = whd.dp;
+ tex_aux_promote_pre_migrated(r, p);
+ tex_aux_promote_post_migrated(r, p);
+ }
+ break;
+ case unset_node:
+ x += d + box_height(p);
+ d = box_depth(p);
+ if (box_width(p) > w) {
+ w = box_width(p);
+ }
+ // tex_aux_promote_pre_migrated(r, p);
+ // tex_aux_promote_post_migrated(r, p);
+ break;
+ case rule_node:
+ x += d + rule_height(p);
+ d = rule_depth(p);
+ if (rule_width(p) > w) {
+ w = rule_width(p);
+ }
+ break;
+ case glue_node:
+ /*tex Incorporate glue into the vertical totals. */
+ {
+ halfword o;
+ x += d + glue_amount(p);
+ d = 0;
+ o = glue_stretch_order(p);
+ lmt_packaging_state.total_stretch[o] += glue_stretch(p);
+ o = glue_shrink_order(p);
+ lmt_packaging_state.total_shrink[o] += glue_shrink(p);
+ if (is_leader(p)) {
+ halfword gl = glue_leader_ptr(p);
+ scaled wd = 0;
+ switch (node_type(gl)) {
+ case hlist_node:
+ case vlist_node:
+ wd = box_width(gl);
+ break;
+ case rule_node:
+ wd = rule_width(gl);
+ break;
+ }
+ if (wd > w) {
+ w = wd;
+ }
+ }
+ break;
+ }
+ case kern_node:
+ x += d + kern_amount(p);
+ d = 0;
+ break;
+ case insert_node:
+ if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_insert)) {
+ halfword l = insert_list(p);
+ tex_aux_post_migrate(r, p);
+ while (l) {
+ l = node_type(l) == insert_node ? tex_aux_post_migrate(r, l) : node_next(l);
+ }
+ }
+ break;
+ case mark_node:
+ if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_mark)) {
+ tex_aux_post_migrate(r, p);
+ }
+ break;
+ case glyph_node:
+ tex_confusion("glyph in vpack");
+ break;
+ case disc_node:
+ tex_confusion("discretionary in vpack");
+ break;
+ default:
+ break;
+ }
+ p = n;
+ }
+ box_width(r) = w;
+ if (d > l) {
+ x += d - l;
+ box_depth(r) = l;
+ } else {
+ box_depth(r) = d;
+ }
+ /*tex
+
+ Determine the value of |height(r)| and the appropriate glue setting; then |return| or |goto
+ common_ending|. When we get to the present part of the program, |x| is the natural height of
+ the box being packaged.
+ */
+ if (m == packing_additional) {
+ h += x;
+ }
+ box_height(r) = h;
+ x = h - x;
+ /*tex Now |x| is the excess to be made up. */
+ if (x == 0) {
+ box_glue_sign(r) = normal_glue_sign;
+ box_glue_order(r) = normal_glue_order;
+ box_glue_set(r) = 0.0;
+ goto EXIT;
+ } else if (x > 0) {
+ /*tex Determine vertical glue stretch setting, then |return| or |goto common_ending|. */
+ halfword o = tex_aux_used_order(lmt_packaging_state.total_stretch);
+ box_glue_order(r) = o;
+ box_glue_sign(r) = stretching_glue_sign;
+ if (lmt_packaging_state.total_stretch[o] != 0) {
+ box_glue_set(r) = (glueratio) ((double) x / lmt_packaging_state.total_stretch[o]);
+ } else {
+ /*tex There's nothing to stretch. */
+ box_glue_sign(r) = normal_glue_sign;
+ box_glue_set(r) = 0.0;
+ }
+ if (o == normal_glue_order && box_list(r)) {
+ /*tex Report an underfull vbox and |goto common_ending|, if this box is sufficiently bad. */
+ lmt_packaging_state.last_badness = tex_badness(x, lmt_packaging_state.total_stretch[normal_glue_order]);
+ if (lmt_packaging_state.last_badness > vbadness_par) {
+ int callback_id = lmt_callback_defined(vpack_quality_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "SdNddS->",
+ lmt_packaging_state.last_badness > 100 ? "underfull" : "loose",
+ lmt_packaging_state.last_badness,
+ r,
+ abs(lmt_packaging_state.pack_begin_line),
+ lmt_input_state.input_line,
+ tex_current_input_file_name()
+ );
+ goto EXIT;
+ } else {
+ tex_print_nlp();
+ if (lmt_packaging_state.last_badness > 100) {
+ tex_print_format("%l[package: underfull \\vbox (badness %i)", lmt_packaging_state.last_badness);
+ } else {
+ tex_print_format("%l[package: loose \\vbox (badness %i)", lmt_packaging_state.last_badness);
+ }
+ goto COMMON_ENDING;
+ }
+ }
+ }
+ goto EXIT;
+ } else {
+ /*tex Determine vertical glue shrink setting, then |return| or |goto common_ending|. */
+ halfword o = tex_aux_used_order(lmt_packaging_state.total_shrink);
+ box_glue_order(r) = o;
+ box_glue_sign(r) = shrinking_glue_sign;
+ if (lmt_packaging_state.total_shrink[o] != 0) {
+ box_glue_set(r) = (glueratio) ((double) (-x) / lmt_packaging_state.total_shrink[o]);
+ } else {
+ /*tex There's nothing to shrink. */
+ box_glue_sign(r) = normal_glue_sign;
+ box_glue_set(r) = 0.0;
+ }
+ if ((lmt_packaging_state.total_shrink[o] < -x) && (o == normal_glue_order) && (box_list(r))) {
+ int overshoot = -x - lmt_packaging_state.total_shrink[normal_glue_order];
+ lmt_packaging_state.last_badness = 1000000;
+ lmt_packaging_state.last_overshoot = overshoot;
+ /*tex Use the maximum shrinkage */
+ box_glue_set(r) = 1.0;
+ /*tex Report an overfull vbox and |goto common_ending|, if this box is sufficiently bad. */
+ if ((overshoot > vfuzz_par) || (vbadness_par < 100)) {
+ int callback_id = lmt_callback_defined(vpack_quality_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "SdNddS->",
+ "overfull",
+ overshoot,
+ r,
+ abs(lmt_packaging_state.pack_begin_line),
+ lmt_input_state.input_line,
+ tex_current_input_file_name()
+ );
+ goto EXIT;
+ } else {
+ tex_print_nlp();
+ tex_print_format("%l[package: overfull \\vbox (%D too high)", - x - lmt_packaging_state.total_shrink[normal_glue_order], pt_unit);
+ goto COMMON_ENDING;
+ }
+ }
+ } else if (o == normal_glue_order) {
+ if (box_list(r)) {
+ /*tex Report a tight vbox and |goto common_ending|, if this box is sufficiently bad. */
+ lmt_packaging_state.last_badness = tex_badness(-x, lmt_packaging_state.total_shrink[normal_glue_order]);
+ if (lmt_packaging_state.last_badness > vbadness_par) {
+ int callback_id = lmt_callback_defined(vpack_quality_callback);
+ if (callback_id > 0) {
+ lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "SdNddS->",
+ "tight",
+ lmt_packaging_state.last_badness,
+ r,
+ abs(lmt_packaging_state.pack_begin_line),
+ lmt_input_state.input_line,
+ tex_current_input_file_name()
+ );
+ goto EXIT;
+ } else {
+ tex_print_nlp();
+ tex_print_format("%l[package: tight \\vbox (badness %i)", lmt_packaging_state.last_badness);
+ goto COMMON_ENDING;
+ }
+ }
+ }
+ }
+ goto EXIT;
+ }
+ COMMON_ENDING:
+ /*tex Finish issuing a diagnostic message or an overfull or underfull vbox. */
+ if (lmt_page_builder_state.output_active) {
+ tex_print_format(" has occurred while \\output is active]");
+ } else if (lmt_packaging_state.pack_begin_line != 0) {
+ tex_print_format(" in alignment at lines %i--%i]", abs(lmt_packaging_state.pack_begin_line), lmt_input_state.input_line);
+ } else {
+ tex_print_format(" detected at line %i]", lmt_input_state.input_line);
+ }
+ tex_print_ln();
+ tex_begin_diagnostic();
+ tex_show_box(r);
+ tex_end_diagnostic();
+ EXIT:
+ /*tex Further (experimental) actions can go here. */
+ return r;
+}
+
+halfword tex_filtered_vpack(halfword p, scaled h, int m, scaled l, int grp, halfword pack_direction, int just_pack, halfword attr, int state, int retain)
+{
+ halfword q = p;
+ if (! just_pack) {
+ q = lmt_vpack_filter_callback(q, h, m, l, grp, pack_direction, attr);
+ }
+ q = tex_vpack(q, h, m, l, checked_direction_value(pack_direction), retain);
+ if (q && normalize_par_mode_permitted(normalize_par_mode_par, flatten_v_leaders_mode) && ! is_box_package_state(state, package_u_leader_delayed)) {
+ tex_flatten_leaders(q, NULL);
+ }
+ if (! just_pack) {
+ q = lmt_packed_vbox_filter_callback(q, grp);
+ }
+ return q;
+}
+
+/*tex
+ Here we always start out in l2r mode and without shift. After all we need to be compatible with
+ how it was before.
+*/
+
+void tex_run_vcenter(void)
+{
+ tex_aux_scan_full_spec(vcenter_group, direction_l2r, 0, 0);
+ tex_normal_paragraph(vcenter_par_context);
+ tex_push_nest();
+ cur_list.mode = -vmode;
+ cur_list.prev_depth = ignore_depth;
+ if (every_vbox_par) {
+ tex_begin_token_list(every_vbox_par, every_vbox_text);
+ }
+}
+
+void tex_finish_vcenter_group(void)
+{
+ if (! tex_wrapped_up_paragraph(vcenter_par_context)) {
+ halfword p;
+ tex_end_paragraph(vcenter_group, vcenter_par_context);
+ tex_package(vpack_code);
+ p = tex_pop_tail();
+ if (p) {
+ switch (node_type(p)) {
+ case vlist_node:
+ {
+ scaled delta = box_total(p);
+ box_height(p) = tex_half_scaled(delta);
+ box_depth(p) = delta - box_height(p);
+ break;
+ }
+ case simple_noad:
+ node_subtype(p) = vcenter_noad_subtype;
+ break;
+ /*
+ case style_node:
+ break;
+ */
+ }
+ tex_tail_append(p);
+ }
+ }
+}
+
+inline static scaled tex_aux_checked_dimen1(halfword v)
+{
+ if (v > max_dimen) {
+ return max_dimen;
+ } else if (v < -max_dimen) {
+ return -max_dimen;
+ } else {
+ return v;
+ }
+}
+
+inline static scaled tex_aux_checked_dimen2(halfword v)
+{
+ if (v > max_dimen) {
+ return max_dimen;
+ } else if (v < 0) {
+ return 0;
+ } else {
+ return v;
+ }
+}
+
+void tex_package(singleword nature)
+{
+ halfword context, spec, dirptr, attrlist, justpack, orientation, anchor, geometry, source, target, axis, mainclass, state, retain;
+ scaled shift;
+ int grp = cur_group;
+ scaled d = box_max_depth_par;
+ halfword boxnode = null; /*tex Aka |cur_box|. */
+ tex_unsave();
+ lmt_save_state.save_stack_data.ptr -= saved_full_spec_n_of_items;
+ context = saved_value(saved_full_spec_item_context);
+ spec = saved_value(saved_full_spec_item_packaging);
+ dirptr = saved_value(saved_full_spec_item_direction);
+ attrlist = saved_value(saved_full_spec_item_attr_list);
+ justpack = saved_value(saved_full_spec_item_only_pack);
+ orientation = saved_value(saved_full_spec_item_orientation);
+ anchor = saved_value(saved_full_spec_item_anchor);
+ geometry = saved_value(saved_full_spec_item_geometry);
+ shift = saved_value(saved_full_spec_item_shift);
+ source = saved_value(saved_full_spec_item_source);
+ target = saved_value(saved_full_spec_item_target);
+ axis = saved_value(saved_full_spec_item_axis);
+ mainclass = saved_value(saved_full_spec_item_class);
+ state = saved_value(saved_full_spec_item_state);
+ retain = saved_value(saved_full_spec_item_retain);
+ if (cur_list.mode == -hmode) {
+ boxnode = tex_filtered_hpack(cur_list.head, cur_list.tail, spec, saved_level(saved_full_spec_item_packaging),
+ grp, saved_level(saved_full_spec_item_direction), justpack, attrlist, state, retain);
+ node_subtype(boxnode) = hbox_list;
+ if (saved_value(saved_full_spec_item_reverse)) {
+ box_list(boxnode) = tex_reversed_node_list(box_list(boxnode));
+ }
+ box_package_state(boxnode) = hbox_package_state;
+ } else {
+ boxnode = tex_filtered_vpack(node_next(cur_list.head), spec, saved_level(saved_full_spec_item_packaging),
+ d, grp, saved_level(saved_full_spec_item_direction), justpack, attrlist, state, retain);
+ if (nature == vtop_code) {
+ /*tex
+
+ Read just the height and depth of |boxnode| (|boxnode|), for |\vtop|. The height of
+ a |\vtop| box is inherited from the first item on its list, if that item is an
+ |hlist_node|, |vlist_node|, or |rule_node|; otherwise the |\vtop| height is zero.
+
+ */
+ scaled h = 0;
+ halfword p = box_list(boxnode);
+ if (p) {
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ h = box_height(p);
+ break;
+ case rule_node:
+ h = rule_height(p);
+ break;
+ }
+ }
+ box_depth(boxnode) = box_total(boxnode) - h;
+ box_height(boxnode) = h;
+ box_package_state(boxnode) = vtop_package_state;
+ } else {
+ box_package_state(boxnode) = vbox_package_state;
+ }
+ }
+ if (dirptr) {
+ /*tex Adjust back |text_dir_ptr| for |scan_spec| */
+ tex_flush_node_list(lmt_dir_state.text_dir_ptr);
+ lmt_dir_state.text_dir_ptr = dirptr;
+ }
+ /*
+ An attribute is not assigned beforehand, just passed. But, when some is assigned we need to
+ retain it. So, how do we deal with attributes that are added? Maybe we have to merge
+ changes? Or maybe an extra option in hpack ... some day.
+ */
+ tex_attach_attribute_list_attribute(boxnode, attrlist);
+ delete_attribute_reference(attrlist);
+ /* */
+ if (tex_has_geometry(geometry, offset_geometry) || tex_has_geometry(geometry, orientation_geometry)) {
+ scaled xoffset = saved_value(saved_full_spec_item_xoffset);
+ scaled yoffset = saved_value(saved_full_spec_item_yoffset);
+ scaled xmove = saved_value(saved_full_spec_item_xmove);
+ scaled ymove = saved_value(saved_full_spec_item_ymove);
+ scaled wd = box_width(boxnode);
+ scaled ht = box_height(boxnode);
+ scaled dp = box_depth(boxnode);
+ if (xmove) {
+ xoffset = tex_aux_checked_dimen1(xoffset + xmove);
+ wd = tex_aux_checked_dimen2(wd + xmove);
+ }
+ if (ymove) {
+ yoffset = tex_aux_checked_dimen1(yoffset + ymove);
+ ht = tex_aux_checked_dimen2(ht + ymove);
+ dp = tex_aux_checked_dimen2(dp - ymove);
+ }
+ box_w_offset(boxnode) = wd;
+ box_h_offset(boxnode) = ht;
+ box_d_offset(boxnode) = dp;
+ switch (orientationonly(orientation)) {
+ case 0 : /* 0 */
+ break;
+ case 2 : /* 180 */
+ box_height(boxnode) = dp;
+ box_depth(boxnode) = ht;
+ geometry |= orientation_geometry;
+ break;
+ case 1 : /* 90 */
+ case 3 : /* 270 */
+ box_width(boxnode) = ht + dp;
+ box_height(boxnode) = wd;
+ box_depth(boxnode) = 0;
+ geometry |= orientation_geometry;
+ break;
+ case 4 : /* 0 */
+ box_height(boxnode) = ht + dp;
+ box_depth(boxnode) = 0;
+ geometry |= orientation_geometry;
+ break;
+ case 5 : /* 180 */
+ box_height(boxnode) = 0;
+ box_depth(boxnode) = ht + dp;
+ geometry |= orientation_geometry;
+ break;
+ default :
+ break;
+ }
+ if (xoffset || yoffset) {
+ box_x_offset(boxnode) = xoffset;
+ box_y_offset(boxnode) = yoffset;
+ geometry |= offset_geometry;
+ }
+ }
+ if (source || target) {
+ box_source_anchor(boxnode) = source;
+ box_target_anchor(boxnode) = target;
+ geometry |= anchor_geometry;
+ }
+ box_anchor(boxnode) = anchor;
+ box_orientation(boxnode) = orientation;
+ box_geometry(boxnode) = (singleword) geometry;
+ if (saved_value(saved_full_spec_item_container)) {
+ node_subtype(boxnode) = container_list;
+ }
+ box_axis(boxnode) = (singleword) axis;
+ box_package_state(boxnode) |= (singleword) state;
+ tex_pop_nest();
+ tex_box_end(context, boxnode, shift, mainclass);
+}
+
+void tex_run_unpackage(void)
+{
+ int code = cur_chr; /*tex should we copy? */
+ halfword head = cur_list.tail;
+ halfword tail = cur_list.tail;
+ switch (code) {
+ case box_code:
+ case copy_code:
+ case unpack_code:
+ {
+ halfword n = tex_scan_box_register_number();
+ halfword b = box_register(n);
+ if (! b) {
+ return;
+ } else if ((abs(cur_list.mode) == mmode)
+ || ((abs(cur_list.mode) == vmode) && (node_type(b) != vlist_node))
+ || ((abs(cur_list.mode) == hmode) && (node_type(b) != hlist_node))) {
+ tex_handle_error(
+ normal_error_type,
+ "Incompatible list can't be unboxed",
+ "Sorry, Pandora. (You sneaky devil.) I refuse to unbox an \\hbox in vertical mode\n"
+ "or vice versa. And I can't open any boxes in math mode."
+ );
+ return;
+ } else {
+
+ /* todo: check head, not needed, always a temp */
+
+ /*tex Via variables for varmem assignment. */
+ halfword list = box_list(b);
+ halfword pre_migrated = code == unpack_code ? null : box_pre_migrated(b);
+ halfword post_migrated = code == unpack_code ? null : box_post_migrated(b);
+ // halfword pre_adjusted = code == unpack_code || (abs(cur_list.mode) == hmode) ? null : box_pre_adjusted(b);
+ // halfword post_adjusted = code == unpack_code || (abs(cur_list.mode) == hmode) ? null : box_post_adjusted(b);
+ // halfword pre_adjusted = code == unpack_code ? null : box_pre_adjusted(b);
+ // halfword post_adjusted = code == unpack_code ? null : box_post_adjusted(b);
+ halfword pre_adjusted = box_pre_adjusted(b);
+ halfword post_adjusted = box_post_adjusted(b);
+ if (pre_adjusted) {
+ if (code == copy_code) {
+ pre_adjusted = tex_copy_node_list(pre_adjusted, null);
+ } else {
+ box_pre_adjusted(b) = null;
+ }
+ while (pre_adjusted) {
+ halfword p = pre_adjusted;
+ halfword h = adjust_list(pre_adjusted);
+ if (h) {
+ if (abs(cur_list.mode) == hmode) {
+ halfword n = tex_new_node(adjust_node, pre_adjust_code);
+ adjust_list(n) = h;
+ h = n;
+ }
+ if (! head) {
+ head = h;
+ }
+ tex_try_couple_nodes(tail, h);
+ tail = tex_tail_of_node_list(h);
+ adjust_list(pre_adjusted) = null;
+ }
+ pre_adjusted = node_next(pre_adjusted);
+ tex_flush_node(p);
+ }
+ }
+ if (pre_migrated) {
+ if (code == copy_code) {
+ pre_migrated = tex_copy_node_list(pre_migrated, null);
+ } else {
+ box_pre_migrated(b) = null;
+ }
+ tex_try_couple_nodes(tail, pre_migrated);
+ tail = tex_tail_of_node_list(pre_migrated);
+ if (! head) {
+ head = pre_migrated;
+ }
+ }
+ if (list) {
+ if (code == copy_code) {
+ list = tex_copy_node_list(list, null);
+ } else {
+ box_list(b) = null;
+ }
+ tex_try_couple_nodes(tail, list);
+ tail = tex_tail_of_node_list(list);
+ if (! head) {
+ head = list;
+ }
+ }
+ if (post_migrated) {
+ if (code == copy_code) {
+ post_migrated = tex_copy_node_list(post_migrated, null);
+ } else {
+ box_post_migrated(b) = null;
+ }
+ tex_try_couple_nodes(tail, post_migrated);
+ tail = tex_tail_of_node_list(post_migrated);
+ if (! head) {
+ head = post_migrated;
+ }
+ }
+ if (post_adjusted) {
+ if (code == copy_code) {
+ post_adjusted = tex_copy_node_list(post_adjusted, null);
+ } else {
+ box_post_adjusted(b) = null;
+ }
+ while (post_adjusted) {
+ halfword p = post_adjusted;
+ halfword h = adjust_list(post_adjusted);
+ if (h) {
+ if (abs(cur_list.mode) == hmode) {
+ halfword n = tex_new_node(adjust_node, post_adjust_code);
+ adjust_list(n) = h;
+ h = n;
+ }
+ if (! head) {
+ head = h;
+ }
+ tex_try_couple_nodes(tail, h);
+ tail = tex_tail_of_node_list(h);
+ adjust_list(post_adjusted) = null;
+ }
+ post_adjusted = node_next(post_adjusted);
+ tex_flush_node(p);
+ }
+ }
+ if (code != copy_code) {
+ box_register(n) = null;
+ tex_flush_node(b);
+ }
+ if (! head) {
+ tail = null;
+ } else if (node_type(b) == hlist_node && normalize_line_mode_permitted(normalize_line_mode_par, remove_margin_kerns_mode)) {
+ /* only here head is used ... */
+ tail = head;
+ while (1) {
+ halfword next = node_next(tail);
+ if (next) {
+ if (tex_is_margin_kern(next)) {
+ tex_try_couple_nodes(tail, node_next(next));
+ tex_flush_node(next);
+ } else {
+ tail = next;
+ }
+ } else {
+ break;
+ }
+ }
+ } else {
+ tail = tex_tail_of_node_list(tail);
+ }
+ cur_list.tail = tail;
+ break;
+ }
+ }
+ case last_box_code:
+ {
+ tex_try_couple_nodes(tail, lmt_packaging_state.page_discards_head);
+ lmt_packaging_state.page_discards_head = null;
+ cur_list.tail = tex_tail_of_node_list(tail);
+ break;
+ }
+ case vsplit_code:
+ {
+ tex_try_couple_nodes(tail, lmt_packaging_state.split_discards_head);
+ lmt_packaging_state.split_discards_head = null;
+ cur_list.tail = tex_tail_of_node_list(tail);
+ break;
+ }
+ case insert_box_code:
+ case insert_copy_code:
+ {
+ /*
+ This one is sensitive for messing with callbacks. Somehow attributes and the if
+ stack ifs can get corrupted but I have no clue yet how that happens but temp
+ nodes have the same size so ...
+ */
+ halfword index = tex_scan_int(0, NULL);
+ if (tex_valid_insert_id(index)) {
+ halfword boxnode = tex_get_insert_content(index); /* also checks for id */
+ if (boxnode) {
+ if (abs(cur_list.mode) != vmode) {
+ tex_handle_error(
+ normal_error_type,
+ "Unpacking an inserts can only happen in vertical mode.",
+ NULL
+ );
+ } else if (node_type(boxnode) == vlist_node) {
+ if (code == insert_copy_code) {
+ boxnode = tex_copy_node(boxnode);
+ } else {
+ tex_set_insert_content(index, null);
+ }
+ if (boxnode) {
+ halfword list = box_list(boxnode);
+ if (list) {
+ tex_try_couple_nodes(tail, list);
+ cur_list.tail = tex_tail_of_node_list(list);
+ box_list(boxnode) = null;
+ }
+ tex_flush_node(boxnode);
+ }
+ } else {
+ /* error, maybe migration list */
+ }
+ }
+ }
+ break;
+ }
+ case local_left_box_box_code:
+ {
+ tex_try_couple_nodes(tail, tex_get_local_boxes(local_left_box_code));
+ cur_list.tail = tex_tail_of_node_list(tail);
+ break;
+ }
+ case local_right_box_box_code:
+ {
+ tex_try_couple_nodes(tail, tex_get_local_boxes(local_right_box_code));
+ cur_list.tail = tex_tail_of_node_list(tail);
+ break;
+ }
+ case local_middle_box_box_code:
+ {
+ tex_try_couple_nodes(tail, tex_get_local_boxes(local_middle_box_code));
+ cur_list.tail = tex_tail_of_node_list(tail);
+ break;
+ }
+ default:
+ {
+ tex_confusion("weird unpackage");
+ break;
+ }
+ }
+ /* margin stuff was here */
+}
+
+/*tex
+
+ When a box is being appended to the current vertical list, the baselineskip calculation is
+ handled by the |append_to_vlist| routine.
+
+ Todo: maybe store some more in lines, so that we can get more consistent spacing (for instance
+ the |baseline_skip_par| and |prev_depth_par| are now pars and not values frozen with the line.
+ But as usual we can expect side effects so \unknown
+
+*/
+
+inline static halfword tex_aux_depth_correction(halfword b, const line_break_properties *properties)
+{
+ /*tex The deficiency of space between baselines: */
+ halfword p;
+ if (properties) {
+ scaled d = glue_amount(properties->baseline_skip) - cur_list.prev_depth - box_height(b);
+ if (d < properties->line_skip_limit) {
+ p = tex_new_glue_node(properties->line_skip, line_skip_glue);
+ } else {
+ p = tex_new_glue_node(properties->baseline_skip, baseline_skip_glue);
+ glue_amount(p) = d;
+ }
+ } else {
+ scaled d = glue_amount(baseline_skip_par) - cur_list.prev_depth - box_height(b);
+ if (d < line_skip_limit_par) {
+ p = tex_new_param_glue_node(line_skip_code, line_skip_glue);
+ } else {
+ p = tex_new_param_glue_node(baseline_skip_code, baseline_skip_glue);
+ glue_amount(p) = d;
+ }
+ }
+ return p;
+}
+
+void tex_append_to_vlist(halfword b, int location, const line_break_properties *properties)
+{
+ if (location >= 0) {
+ halfword result = null;
+ halfword next_depth = ignore_depth;
+ int prev_set = 0;
+ int check_depth = 0;
+ if (lmt_append_to_vlist_callback(b, location, cur_list.prev_depth, &result, &next_depth, &prev_set, &check_depth)) {
+ if (prev_set) {
+ cur_list.prev_depth = next_depth;
+ }
+ if (check_depth && result && (cur_list.prev_depth > ignore_depth)) {
+ /*tex
+ We only deal with a few types and one can always at the \LUA\ end check for some of
+ these and decide not to apply the correction.
+ */
+ switch (node_type(result)) {
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ {
+ halfword p = tex_aux_depth_correction(result, properties);
+ tex_couple_nodes(cur_list.tail, p);
+ cur_list.tail = p;
+ break;
+ }
+ }
+ }
+ while (result) {
+ tex_couple_nodes(cur_list.tail, result);
+ cur_list.tail = result;
+ result = node_next(result);
+ }
+ return;
+ }
+ }
+ if (cur_list.prev_depth > ignore_depth) {
+ halfword p = tex_aux_depth_correction(b, properties);
+ tex_couple_nodes(cur_list.tail, p);
+ cur_list.tail = p;
+ }
+ tex_couple_nodes(cur_list.tail, b);
+ cur_list.tail = b;
+ cur_list.prev_depth = box_depth(b);
+}
+
+/*tex
+
+ When |saving_vdiscards| is positive then the glue, kern, and penalty nodes removed by the page
+ builder or by |\vsplit| from the top of a vertical list are saved in special lists instead of
+ being discarded.
+
+ The |vsplit| procedure, which implements \TEX's |\vsplit| operation, is considerably simpler
+ than |line_break| because it doesn't have to worry about hyphenation, and because its mission
+ is to discover a single break instead of an optimum sequence of breakpoints. But before we get
+ into the details of |vsplit|, we need to consider a few more basic things.
+
+ A subroutine called |prune_page_top| takes a pointer to a vlist and returns a pointer to a
+ modified vlist in which all glue, kern, and penalty nodes have been deleted before the first
+ box or rule node. However, the first box or rule is actually preceded by a newly created glue
+ node designed so that the topmost baseline will be at distance |split_top_skip| from the top,
+ whenever this is possible without backspacing.
+
+ When the second argument |s| is |false| the deleted nodes are destroyed, otherwise they are
+ collected in a list starting at |split_discards|.
+
+ Are the prev pointers okay here?
+
+*/
+
+halfword tex_prune_page_top(halfword p, int s)
+{
+ /*tex Lags one step behind |p|. */
+ halfword prev_p = temp_head;
+ halfword r = null;
+ node_next(temp_head) = p;
+ while (p) {
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ {
+ /*tex Insert glue for |split_top_skip| and set |p| to |null|. */
+ halfword h = node_type(p) == rule_node ? rule_height(p) : box_height(p);
+ halfword q = tex_new_param_glue_node(split_top_skip_code, split_top_skip_glue);
+ node_next(prev_p) = q;
+ node_next(q) = p;
+ glue_amount(q) = glue_amount(q) > h ? glue_amount(q) - h : 0;
+ p = null;
+ }
+ break;
+ case boundary_node:
+ /* shouldn't we discard */
+ case whatsit_node:
+ case mark_node:
+ case insert_node:
+ prev_p = p;
+ p = node_next(prev_p);
+ break;
+ case glue_node:
+ case kern_node:
+ case penalty_node:
+ {
+ halfword q = p;
+ p = node_next(q);
+ node_next(q) = null;
+ node_next(prev_p) = p;
+ if (s) {
+ if (lmt_packaging_state.split_discards_head) {
+ node_next(r) = q;
+ } else {
+ lmt_packaging_state.split_discards_head = q;
+ }
+ r = q;
+ } else {
+ tex_flush_node_list(q);
+ }
+ }
+ break;
+ default:
+ tex_confusion("pruning page top");
+ break;
+ }
+ }
+ return node_next(temp_head);
+}
+
+/*tex
+
+ The next subroutine finds the best place to break a given vertical list so as to obtain a box
+ of height~|h|, with maximum depth~|d|. A pointer to the beginning of the vertical list is given,
+ and a pointer to the optimum breakpoint is returned. The list is effectively followed by a
+ forced break, i.e., a penalty node with the |eject_penalty|; if the best break occurs at this
+ artificial node, the value |null| is returned.
+
+ An array of six |scaled| distances is used to keep track of the height from the beginning of
+ the list to the current place, just as in |line_break|. In fact, we use one of the same arrays,
+ only changing its name to reflect its new significance.
+
+ The distance from first active node to |cur_p| is stored in |active_height|.
+
+ A global variable |best_height_plus_depth| will be set to the natural size of the box (without
+ stretching or shrinking) that corresponds to the optimum breakpoint found by |vert_break|. This
+ value is used by the insertion splitting algorithm of the page builder.
+
+ \starttyping
+ scaled best_height_plus_depth;
+ \stoptyping
+
+ The natural height:
+
+*/
+
+/* cur_height lmt_packaging_state.active_height[total_glue_amount] */
+# define cur_height active_height[total_glue_amount]
+
+halfword tex_vert_break(halfword p, scaled h, scaled d)
+{
+ /*tex
+ If |p| is a glue node, |type(prev_p)| determines whether |p| is a legal breakpoint, an
+ initial glue node is not a legal breakpoint.
+ */
+ halfword prev_p = p;
+ /*tex penalty value */
+ halfword pi = 0;
+ /*tex the smallest badness plus penalties found so far */
+ halfword least_cost = awful_bad;
+ /*tex the most recent break that leads to |least_cost| */
+ halfword best_place = null;
+ /*tex depth of previous box in the list */
+ scaled prev_dp = 0;
+ scaled active_height[10] = { 0 };
+ while (1) {
+ /*tex
+
+ If node |p| is a legal breakpoint, check if this break is the best known, and |goto
+ done| if |p| is null or if the page-so-far is already too full to accept more stuff.
+
+ A subtle point to be noted here is that the maximum depth~|d| might be negative, so
+ |cur_height| and |prev_dp| might need to be corrected even after a glue or kern node.
+ */
+ if (p) {
+ /*tex
+
+ Use node |p| to update the current height and depth measurements; if this node is
+ not a legal breakpoint, |goto not_found| or |update_heights|, otherwise set |pi|
+ to the associated penalty at the break.
+
+ */
+ switch (node_type(p)) {
+ case hlist_node:
+ case vlist_node:
+ /*tex
+ If we do this we also need to subtract the dimensions and bubble it up. But
+ at least we could inline the inserts.
+ */
+ /*
+ if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_post)) {
+ // same code as in page builder
+ }
+ if (auto_migrating_mode_permitted(auto_migration_mode_par, auto_migrate_pre)) {
+ // same code as in page builder
+ continue;
+ }
+ */
+ cur_height += prev_dp + box_height(p);
+ prev_dp = box_depth(p);
+ goto NOT_FOUND;
+ case rule_node:
+ cur_height += prev_dp + rule_height(p);
+ prev_dp = rule_depth(p);
+ goto NOT_FOUND;
+ case boundary_node:
+ case whatsit_node:
+ goto NOT_FOUND;
+ case glue_node:
+ if (precedes_break(prev_p)) {
+ pi = 0;
+ break;
+ } else {
+ goto UPDATE_HEIGHTS;
+ }
+ case kern_node:
+ if (node_next(p) && node_type(node_next(p)) == glue_node) {
+ pi = 0;
+ break;
+ } else {
+ goto UPDATE_HEIGHTS;
+ }
+ case penalty_node:
+ pi = penalty_amount(p);
+ break;
+ case mark_node:
+ case insert_node:
+ goto NOT_FOUND;
+ default:
+ tex_confusion("vertical break");
+ break;
+ }
+ } else {
+ pi = eject_penalty;
+ }
+ /*tex
+
+ Check if node |p| is a new champion breakpoint; then |goto done| if |p| is a forced
+ break or if the page-so-far is already too full.
+
+ */
+ if (pi < infinite_penalty) {
+ /*tex Compute the badness, |b|, using |awful_bad| if the box is too full. */
+ int b;
+ if (cur_height < h) {
+ if ((active_height[total_fi_amount] != 0) || (active_height[total_fil_amount] != 0) ||
+ (active_height[total_fill_amount] != 0) || (active_height[total_filll_amount] != 0)) {
+ b = 0;
+ } else {
+ b = tex_badness(h - cur_height, active_height[total_stretch_amount]);
+ }
+ } else if (cur_height - h > active_height[total_shrink_amount]) {
+ b = awful_bad;
+ } else {
+ b = tex_badness(cur_height - h, active_height[total_shrink_amount]);
+ }
+ if (b < awful_bad) {
+ if (pi <= eject_penalty) {
+ b = pi;
+ } else if (b < infinite_bad) {
+ b = b + pi;
+ } else {
+ b = deplorable;
+ }
+ }
+ if (b <= least_cost) {
+ best_place = p;
+ least_cost = b;
+ lmt_packaging_state.best_height_plus_depth = cur_height + prev_dp;
+ }
+ if ((b == awful_bad) || (pi <= eject_penalty)) {
+ return best_place;
+ }
+ }
+ UPDATE_HEIGHTS:
+ /*tex
+
+ Update the current height and depth measurements with respect to a glue or kern node~|p|.
+ Vertical lists that are subject to the |vert_break| procedure should not contain infinite
+ shrinkability, since that would permit any amount of information to fit on one page.
+
+ We only end up here for glue and kern nodes.
+
+ */
+ switch(node_type(p)) {
+ case kern_node:
+ cur_height += prev_dp + kern_amount(p);
+ prev_dp = 0;
+ goto KEEP_GOING; /* We assume a positive depth. */
+ case glue_node:
+ active_height[total_stretch_amount + glue_stretch_order(p)] += glue_stretch(p);
+ active_height[total_shrink_amount] += glue_shrink(p);
+ if ((glue_shrink_order(p) != normal_glue_order) && (glue_shrink(p) != 0)) {
+ tex_handle_error(
+ normal_error_type,
+ "Infinite glue shrinkage found in box being split",
+ "The box you are \\vsplitting contains some infinitely shrinkable glue, e.g.,\n"
+ "'\\vss' or '\\vskip 0pt minus 1fil'. Such glue doesn't belong there; but you can\n"
+ "safely proceed, since the offensive shrinkability has been made finite."
+ );
+ glue_shrink_order(p) = normal_glue_order;
+ }
+ cur_height += prev_dp + glue_amount(p);
+ prev_dp = 0;
+ goto KEEP_GOING; /* We assume a positive depth. */
+ }
+ NOT_FOUND:
+ if (prev_dp > d) {
+ cur_height += prev_dp - d;
+ prev_dp = d;
+ }
+ KEEP_GOING:
+ prev_p = p;
+ p = node_next(prev_p);
+ }
+ return best_place;
+}
+
+/*tex
+
+ Now we are ready to consider |vsplit| itself. Most of its work is accomplished by the two
+ subroutines that we have just considered.
+
+ Given the number of a vlist box |n|, and given a desired page height |h|, the |vsplit|
+ function finds the best initial segment of the vlist and returns a box for a page of height~|h|.
+ The remainder of the vlist, if any, replaces the original box, after removing glue and penalties
+ and adjusting for |split_top_skip|. Mark nodes in the split-off box are used to set the values
+ of |split_first_mark| and |split_bot_mark|; we use the fact that |split_first_mark(x) = null| if
+ and only if |split_bot_mark(x) = null|.
+
+ The original box becomes \quote {void} if and only if it has been entirely extracted. The
+ extracted box is \quote {void} if and only if the original box was void (or if it was,
+ erroneously, an hlist box).
+
+ Extract a page of height |h| from box |n|:
+*/
+
+halfword tex_vsplit(halfword n, scaled h, int m)
+{
+ /*tex the box to be split */
+ halfword v = box_register(n);
+ tex_flush_node_list(lmt_packaging_state.split_discards_head);
+ lmt_packaging_state.split_discards_head = null;
+ for (halfword i = 0; i <= lmt_mark_state.mark_data.ptr; i++) {
+ tex_delete_mark(i, split_first_mark_code);
+ tex_delete_mark(i, split_bot_mark_code);
+ }
+ /*tex Dispense with trivial cases of void or bad boxes. */
+ if (! v) {
+ return null;
+ } else if (node_type(v) != vlist_node) {
+ tex_handle_error(
+ normal_error_type,
+ "\\vsplit needs a \\vbox",
+ "The box you are trying to split is an \\hbox. I can't split such a box, so I''ll\n"
+ "leave it alone."
+ );
+ return null;
+ } else {
+ /*tex points to where the break occurs */
+ halfword q = tex_vert_break(box_list(v), h, split_max_depth_par);
+ /*tex
+
+ Look at all the marks in nodes before the break, and set the final link to |null| at
+ the break. It's possible that the box begins with a penalty node that is the quote
+ {best} break, so we must be careful to handle this special case correctly.
+
+ */
+ halfword p = box_list(v);
+ /*tex The direction of the box to be split, obsolete! */
+ int vdir = box_dir(v);
+ if (p == q) {
+ box_list(v) = null;
+ } else {
+ while (1) {
+ if (node_type(p) == mark_node) {
+ tex_update_split_mark(p);
+ }
+ if (node_next(p) == q) {
+ node_next(p) = null;
+ break;
+ } else {
+ p = node_next(p);
+ }
+ }
+ }
+ q = tex_prune_page_top(q, saving_vdiscards_par > 0);
+ p = box_list(v);
+ box_list(v) = null;
+ tex_flush_node(v);
+ if (q) {
+ box_register(n) = tex_filtered_vpack(q, 0, packing_additional, max_depth_par, split_keep_group, vdir, 0, 0, 0, holding_none_option);
+ } else {
+ /*tex The |eq_level| of the box stays the same. */
+ box_register(n) = null;
+ }
+ return tex_filtered_vpack(p, m == packing_additional ? 0 : h, m, max_depth_par, split_off_group, vdir, 0, 0, 0, holding_none_option);
+ }
+}
+
+/*tex
+
+ Now that we can see what eventually happens to boxes, we can consider the first steps in their
+ creation. The |begin_box| routine is called when |box_context| is a context specification,
+ |cur_chr| specifies the type of box desired, and |cur_cmd=make_box|.
+
+*/
+
+void tex_begin_box(int boxcontext, scaled shift)
+{
+ halfword code = cur_chr;
+ halfword boxnode = null; /*tex Aka |cur_box|. */
+ switch (code) {
+ case box_code:
+ {
+ halfword n = tex_scan_box_register_number();
+ boxnode = box_register(n);
+ /*tex The box becomes void, at the same level. */
+ box_register(n) = null;
+ break;
+ }
+ case copy_code:
+ {
+ halfword n = tex_scan_box_register_number();
+ /* boxnode = copy_node_list(box_register(n), null); */
+ boxnode = tex_copy_node(box_register(n));
+ break;
+ }
+ case last_box_code:
+ /*tex
+
+ If the current list ends with a box node, delete it from the list and make |boxnode|
+ point to it; otherwise set |boxnode := null|.
+
+ */
+ boxnode = null;
+ if (abs(cur_list.mode) == mmode) {
+ tex_you_cant_error(
+ "Sorry; this \\lastbox will be void."
+ );
+ } else if (cur_list.mode == vmode && cur_list.head == cur_list.tail) {
+ tex_you_cant_error(
+ "Sorry...I usually can't take things from the current page.\n"
+ "This \\lastbox will therefore be void."
+ );
+ } else if (cur_list.head != cur_list.tail) {
+ switch (node_type(cur_list.tail)) {
+ case hlist_node:
+ case vlist_node:
+ {
+ /*tex Remove the last box */
+ halfword q = node_prev(cur_list.tail);
+ if (! q || node_next(q) != cur_list.tail) {
+ q = cur_list.head;
+ while (node_next(q) != cur_list.tail)
+ q = node_next(q);
+ }
+ tex_uncouple_node(cur_list.tail);
+ boxnode = cur_list.tail;
+ box_shift_amount(boxnode) = 0;
+ cur_list.tail = q;
+ node_next(cur_list.tail) = null;
+ }
+ break;
+ }
+ }
+ break;
+ case vsplit_code:
+ {
+ /*tex
+
+ Split off part of a vertical box, make |boxnode| point to it. Here we deal with
+ things like |\vsplit 13 to 100pt|.
+
+ Maybe todo: just split off one line.
+
+ */
+ halfword mode = packing_exactly ;
+ halfword index = tex_scan_box_register_number();
+ halfword size = 0;
+ switch (tex_scan_character("utUT", 0, 1, 0)) {
+ case 'u': case 'U':
+ if (tex_scan_mandate_keyword("upto", 1)) {
+ mode = packing_additional;
+ size = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 't': case 'T':
+ if (tex_scan_mandate_keyword("to", 1)) {
+ mode = packing_exactly ;
+ size = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("upto|to");
+ break;
+ }
+ boxnode = tex_vsplit(index, size, mode);
+ }
+ break;
+ case insert_box_code:
+ case insert_copy_code:
+ {
+ halfword index = tex_scan_int(0, NULL);
+ if (tex_valid_insert_id(index)) {
+ boxnode = tex_get_insert_content(index);
+ if (boxnode) {
+ if (node_type(boxnode) == vlist_node) {
+ if (code == insert_copy_code) {
+ boxnode = tex_copy_node(boxnode);
+ } else {
+ tex_set_insert_content(index, null);
+ }
+ } else {
+ tex_set_insert_content(index, null);
+ /* error, maybe migration list */
+ }
+ }
+ }
+ break;
+ }
+ case local_left_box_box_code:
+ {
+ boxnode = tex_get_local_boxes(local_left_box_code);
+ break;
+ }
+ case local_right_box_box_code:
+ {
+ boxnode = tex_get_local_boxes(local_right_box_code);
+ break;
+ }
+ case local_middle_box_box_code:
+ {
+ boxnode = tex_get_local_boxes(local_middle_box_code);
+ break;
+ }
+ default:
+ {
+ /*tex
+
+ Initiate the construction of an hbox or vbox, then |return|. Here is where we
+ enter restricted horizontal mode or internal vertical mode, in order to make a
+ box.
+
+ */
+ int just_pack = 0;
+ quarterword spec_direction = direction_unknown;
+ /*tex 0 or |vmode| or |hmode| */
+ halfword mode; /* todo */
+ switch (code) {
+ case tpack_code:
+ code = vtop_code;
+ just_pack = 1;
+ break;
+ case vpack_code:
+ code = vtop_code + vmode;
+ just_pack = 1;
+ break;
+ case hpack_code:
+ code = vtop_code + hmode;
+ just_pack = 1;
+ break;
+ }
+ mode = code - vtop_code;
+ tex_set_saved_record(saved_full_spec_item_context, saved_box_context, 0, boxcontext);
+ switch (abs(cur_list.mode)) {
+ case vmode:
+ spec_direction = dir_lefttoright;
+ break;
+ case hmode:
+ spec_direction = (singleword) text_direction_par;
+ break;
+ case mmode:
+ spec_direction = (singleword) math_direction_par;
+ break;
+ }
+ if (mode == hmode) {
+ if ((boxcontext < box_flag) && (abs(cur_list.mode) == vmode)) {
+ tex_aux_scan_full_spec(adjusted_hbox_group, spec_direction, just_pack, shift);
+ } else {
+ tex_aux_scan_full_spec(hbox_group, spec_direction, just_pack, shift);
+ }
+ } else {
+ if (mode == vmode) {
+ tex_aux_scan_full_spec(vbox_group, spec_direction, just_pack, shift);
+ } else {
+ tex_aux_scan_full_spec(vtop_group, spec_direction, just_pack, shift);
+ mode = vmode;
+ }
+ tex_normal_paragraph(vmode_par_context);
+ }
+ tex_push_nest();
+ update_tex_internal_dir_state(0);
+ cur_list.mode = - mode;
+ if (mode == vmode) {
+ cur_list.prev_depth = ignore_depth;
+ if (every_vbox_par) {
+ tex_begin_token_list(every_vbox_par, every_vbox_text);
+ }
+ } else {
+ cur_list.space_factor = 1000;
+ if (every_hbox_par) {
+ tex_begin_token_list(every_hbox_par, every_hbox_text);
+ }
+ }
+ return;
+ }
+ }
+ /*tex In simple cases, we use the box immediately. */
+ tex_box_end(boxcontext, boxnode, shift, unset_noad_class);
+}
diff --git a/source/luametatex/source/tex/texpackaging.h b/source/luametatex/source/tex/texpackaging.h
new file mode 100644
index 000000000..75d3d1653
--- /dev/null
+++ b/source/luametatex/source/tex/texpackaging.h
@@ -0,0 +1,205 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_PACKAGING_H
+# define LMT_PACKAGING_H
+
+# include "luametatex.h"
+
+/* We define some constants used when calling |hpack| to deal with font expansion. */
+
+typedef enum hpack_subtypes {
+ packing_exactly, /*tex a box dimension is pre-specified */
+ packing_additional, /*tex a box dimension is increased from the natural one */
+ packing_expanded, /*tex calculate amount for font expansion after breaking paragraph into lines */
+ packing_substitute, /*tex substitute fonts */
+ packing_adapted,
+ packing_linebreak, /*tex signals that we need to take the frozen adjust properties */
+} hpack_subtypes;
+
+typedef enum box_codes {
+ box_code, /*tex |chr_code| for |\box| */
+ copy_code, /*tex |chr_code| for |\copy| */
+ unpack_code,
+ last_box_code, /*tex |chr_code| for |\lastbox| */
+ vsplit_code, /*tex |chr_code| for |\vsplit| */
+ tpack_code,
+ vpack_code,
+ hpack_code,
+ vtop_code, /*tex |chr_code| for |\vtop| */
+ vbox_code,
+ hbox_code,
+ insert_box_code,
+ insert_copy_code,
+ local_left_box_box_code,
+ local_right_box_box_code,
+ local_middle_box_box_code
+} box_codes;
+
+// typedef enum saved_spec_items {
+// saved_spec_item_packaging = 0,
+// saved_spec_item_attribute = 1,
+// saved_spec_n_of_items = 2,
+// } saved_spec_items;
+
+typedef enum saved_full_spec_items {
+ saved_full_spec_item_context = 0,
+ saved_full_spec_item_packaging = 1,
+ saved_full_spec_item_direction = 2,
+ saved_full_spec_item_attr_list = 3,
+ saved_full_spec_item_only_pack = 4,
+ saved_full_spec_item_orientation = 5,
+ saved_full_spec_item_anchor = 6,
+ saved_full_spec_item_geometry = 7,
+ saved_full_spec_item_xoffset = 8,
+ saved_full_spec_item_yoffset = 9,
+ saved_full_spec_item_xmove = 10,
+ saved_full_spec_item_ymove = 11,
+ saved_full_spec_item_reverse = 12,
+ saved_full_spec_item_container = 13,
+ saved_full_spec_item_shift = 14, /* cleaner than passing it as context */
+ saved_full_spec_item_source = 15,
+ saved_full_spec_item_target = 16,
+ saved_full_spec_item_axis = 17,
+ saved_full_spec_item_class = 18,
+ saved_full_spec_item_state = 19,
+ saved_full_spec_item_retain = 20,
+ saved_full_spec_n_of_items = 21,
+} saved_full_spec_items;
+
+typedef enum holding_migration_options {
+ holding_none_option = 0x00,
+ holding_marks_option = 0x01,
+ holding_inserts_option = 0x02,
+ holding_adjusts_option = 0x04,
+} holding_migration_options ;
+
+# define retain_marks(r) (((r | holding_migrations_par) & holding_marks_option ) == holding_marks_option )
+# define retain_inserts(r) (((r | holding_migrations_par) & holding_inserts_option) == holding_inserts_option)
+# define retain_adjusts(r) (((r | holding_migrations_par) & holding_adjusts_option) == holding_adjusts_option)
+
+typedef struct packaging_state_info {
+ scaled total_stretch[6]; /*tex with one for padding, the results are also used in alignments */
+ scaled total_shrink[6]; /*tex glue found by |hpack| or |vpack|, the results are also used in alignments */
+ int last_badness; /*tex badness of the most recently packaged box */
+ scaled last_overshoot;
+ halfword post_adjust_tail; /*tex tail of adjustment list */
+ halfword pre_adjust_tail;
+ halfword post_migrate_tail; /*tex tail of adjustment list */
+ halfword pre_migrate_tail;
+ halfword last_leftmost_char;
+ halfword last_rightmost_char;
+ int pack_begin_line;
+ scaled best_height_plus_depth; /*tex The height of the best box, without stretching or shrinking: */
+ halfword previous_char_ptr;
+ scaled font_expansion_ratio;
+ halfword page_discards_tail;
+ halfword page_discards_head;
+ halfword split_discards_head;
+ halfword padding;
+} packaging_state_info;
+
+extern packaging_state_info lmt_packaging_state;
+
+extern scaled tex_char_stretch (halfword p);
+extern scaled tex_char_shrink (halfword p);
+/* void tex_get_char_expansion (halfword p, halfword *stretch, halfword *shrink); */ /* no gain */
+extern scaled tex_kern_stretch (halfword p);
+extern scaled tex_kern_shrink (halfword p);
+extern scaled tex_char_protrusion (halfword p, int side);
+/* void tex_kern_protrusion (halfword p, int side, halfword *stretch, halfword *shrink); */
+
+extern scaled tex_left_marginkern (halfword p);
+extern scaled tex_right_marginkern (halfword p);
+
+extern halfword tex_filtered_hpack (halfword p, halfword qt, scaled w, int m, int grp, halfword d, int just_pack, halfword attr, int state, int retain);
+extern halfword tex_filtered_vpack (halfword p, scaled h, int m, scaled l, int grp, halfword d, int just_pack, halfword attr, int state, int retain);
+
+extern scaledwhd tex_natural_hsizes (halfword p, halfword pp, glueratio g_mult, int g_sign, int g_order);
+extern scaledwhd tex_natural_vsizes (halfword p, halfword pp, glueratio g_mult, int g_sign, int g_order);
+extern halfword tex_natural_width (halfword p, halfword pp, glueratio g_mult, int g_sign, int g_order);
+extern halfword tex_natural_hsize (halfword p, halfword *correction);
+extern halfword tex_natural_vsize (halfword p);
+
+extern halfword tex_hpack (halfword p, scaled w, int m, singleword d, int retain);
+extern halfword tex_vpack (halfword p, scaled h, int m, scaled l, singleword d, int retain);
+
+extern void tex_repack (halfword p, scaled w, int m);
+extern void tex_freeze (halfword p, int recurse);
+
+extern void tex_package (singleword nature);
+extern void tex_run_unpackage (void);
+
+extern void tex_append_to_vlist (halfword b, int location, const line_break_properties *properties);
+
+extern halfword tex_prune_page_top (halfword p, int s);
+extern halfword tex_vert_break (halfword p, scaled h, scaled d);
+extern halfword tex_vsplit (halfword n, scaled h, int m);
+
+extern void tex_finish_vcenter_group (void);
+extern void tex_run_vcenter (void);
+
+//# define vpack(A,B,C,D) tex_vpackage(A,B,C,max_dimen,D)
+
+# define first_un_box_code box_code
+# define last_un_box_code unpack_code
+# define first_nu_box_code box_code
+# define last_nu_box_code local_middle_box_box_code /*tex needs checking */
+
+/*tex
+
+ Now let's turn to the question of how |\hbox| is treated. We actually need to consider also a
+ slightly larger context, since constructions like
+
+ \starttyping
+ \setbox3={\\hbox...
+ \leaders\hbox...
+ \lower3.8pt\hbox...
+ \stoptyping
+
+ are supposed to invoke quite different actions after the box has been packaged. Conversely,
+ constructions like |\setbox 3 =| can be followed by a variety of different kinds of boxes, and
+ we would like to encode such things in an efficient way.
+
+ In other words, there are two problems: To represent the context of a box, and to represent its
+ type. The first problem is solved by putting a \quote {context code} on the |save_stack|, just
+ below the two entries that give the dimensions produced by |scan_spec|. The context code is
+ either a (signed) shift amount, or it is a large integer |>= box_flag|, where |box_flag = |
+ $2^{30}$. Codes |box_flag| through |box_flag + biggest_reg| represent |\setbox0| through
+ |\setbox biggest_reg|; codes |box_flag + biggest_reg + 1| through |box_flag + 2 * biggest_reg|
+ represent |\global \setbox 0| through |\global\setbox| |biggest_reg|; code |box_flag + 2 *
+ number_regs| represents |\shipout|; and codes |box_flag + 2 * number_regs + 1| through |box_flag
+ + 2 * number_regs + 3| represent |\leaders|, |\cleaders|, and |\xleaders|.
+
+ The second problem is solved by giving the command code |make_box| to all control sequences that
+ produce a box, and by using the following |chr_code| values to distinguish between them:
+ |box_code|, |copy_code|, |last_box_code|, |vsplit_code|, |vtop_code|, |vtop_code + vmode|, and
+ |vtop_code + hmode|, where the latter two are used denote |\vbox| and |\hbox|, respectively.
+
+*/
+
+# define biggest_reg 65535 /*tex This could be in |textypes.h|. */
+
+typedef enum box_flags {
+ box_flag = 010000000000, /*tex context code for |\setbox0| (< maxdimen) */
+ global_box_flag = 010000000000 + biggest_reg, /*tex context code for |\global\setbox0| */
+ max_global_box_flag = 010000000000 + 2 * biggest_reg,
+ left_box_flag = 010000000000 + 2 * biggest_reg + 1, /*tex context code for |\localleftbox| (not used) */
+ right_box_flag = 010000000000 + 2 * biggest_reg + 2, /*tex context code for |\localrightbox| (not used) */
+ middle_box_flag = 010000000000 + 2 * biggest_reg + 3, /*tex context code for |\localrightbox| (not used) */
+ shipout_flag = 010000000000 + 2 * biggest_reg + 4, /*tex context code for |\shipout| */
+ lua_scan_flag = 010000000000 + 2 * biggest_reg + 5, /*tex context code for |scan_list| */
+ a_leaders_flag = 010000000000 + 2 * biggest_reg + 6, /*tex context code for |\leaders| */
+ c_leaders_flag = 010000000000 + 2 * biggest_reg + 7, /*tex context code for |\cleaders| */
+ x_leaders_flag = 010000000000 + 2 * biggest_reg + 8, /*tex context code for |\xleaders| */
+ g_leaders_flag = 010000000000 + 2 * biggest_reg + 9, /*tex context code for |\gleaders| */
+ u_leaders_flag = 010000000000 + 2 * biggest_reg + 10, /*tex context code for |\uleaders| */
+} box_flags;
+
+# define box_leaders_flag(f) (f >= a_leaders_flag && f <= u_leaders_flag)
+
+extern void tex_begin_box (int boxcontext, scaled shift);
+extern int tex_ignore_math_skip (halfword p);
+
+# endif
diff --git a/source/luametatex/source/tex/texprimitive.c b/source/luametatex/source/tex/texprimitive.c
new file mode 100644
index 000000000..bbeea1bc0
--- /dev/null
+++ b/source/luametatex/source/tex/texprimitive.c
@@ -0,0 +1,913 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Control sequences are stored and retrieved by means of a fairly standard hash table algorithm
+ called the method of \quote {coalescing lists} (cf.\ Algorithm 6.4C in {\em The Art of
+ Computer Programming}). Once a control sequence enters the table, it is never removed, because
+ there are complicated situations involving |\gdef| where the removal of a control sequence at
+ the end of a group would be a mistake preventable only by the introduction of a complicated
+ reference-count mechanism.
+
+ The actual sequence of letters forming a control sequence identifier is stored in the |str_pool|
+ array together with all the other strings. An auxiliary array |hash| consists of items with two
+ halfword fields per word. The first of these, called |next(p)|, points to the next identifier
+ belonging to the same coalesced list as the identifier corresponding to~|p|; and the other,
+ called |text(p)|, points to the |str_start| entry for |p|'s identifier. If position~|p| of the
+ hash table is empty, we have |text(p)=0|; if position |p| is either empty or the end of a
+ coalesced hash list, we have |next(p) = 0|. An auxiliary pointer variable called |hash_used| is
+ maintained in such a way that all locations |p >= hash_used| are nonempty. The global variable
+ |cs_count| tells how many multiletter control sequences have been defined, if statistics are
+ being kept.
+
+ A boolean variable called |no_new_control_sequence| is set to |true| during the time that new
+ hash table entries are forbidden.
+
+ The other variables in the following state structure are: the hash table: |hash|, the allocation
+ pointer |hash_used| for |hash|, |hash_extra| above |eqtb_size|, the maximum of the hash array
+ |hash_top|, the pointer to the next high hash location |hash_high|, the mentioned flag that says
+ if new identifiers are legal |no_new_control_sequence| and the total number of known identifiers:
+ |cs_count|.
+
+*/
+
+hash_state_info lmt_hash_state = {
+ .hash = NULL,
+ .hash_data = {
+ .minimum = min_hash_size,
+ .maximum = max_hash_size,
+ .size = siz_hash_size,
+ .step = stp_hash_size,
+ .allocated = 0,
+ .itemsize = sizeof(memoryword) + sizeof(memoryword),
+ .top = 0,
+ .ptr = 0,
+ .initial = 0,
+ .offset = 0, // eqtb_size,
+ },
+ .eqtb_data = {
+ .minimum = min_hash_size,
+ .maximum = max_hash_size,
+ .size = siz_hash_size,
+ .step = stp_hash_size,
+ .allocated = memory_data_unset,
+ .itemsize = memory_data_unset,
+ .top = frozen_control_sequence,
+ .ptr = 0,
+ .initial = 0,
+ .offset = 0,
+ },
+ .eqtb = NULL,
+ .no_new_cs = 1,
+ .padding = 0,
+};
+
+/*tex
+
+ The arrays |prim| and |prim_eqtb| are used for |name -> cmd, chr| lookups. The are modelled
+ after |hash| and |eqtb|, except that primitives do not have an |eq_level|, that field is
+ replaced by |origin|. Furthermore we have a link for coalesced lists: |prim_next (a)|; the
+ string number for control sequence name: |prim_text (a)|; test if all positions are occupied:
+ |prim_is_full|; some fields: |prim_origin_field (a)|, |prim_eq_type_field (a)| and
+ |prim_equiv_field(a)|; the level of definition: |prim_origin (a)|; the command code for
+ equivalent: |prim_eq_type(a)|; the equivalent value: |prim_equiv(a)|; the allocation pointer
+ for |prim|: |prim_used|; the primitives tables: |two_halves prim [(prim_size + 1)]| and
+ |memoryword prim_eqtb [(prim_size + 1)]|. The array |prim_data| works the other way around, it
+ is used for |cmd, chr| to name lookups.
+
+*/
+
+primitive_state_info lmt_primitive_state;
+
+/*tex Test if all positions are occupied: */
+
+# define prim_base 1
+# define reserved_hash_slots 1
+
+/*tex Initialize the memory arrays: */
+
+void tex_initialize_primitives(void)
+{
+ memset(lmt_primitive_state.prim_data, 0, sizeof(prim_info) * (last_cmd + 1));
+ memset(lmt_primitive_state.prim, 0, sizeof(memoryword) * (prim_size + 1));
+ memset(lmt_primitive_state.prim_eqtb, 0, sizeof(memoryword) * (prim_size + 1));
+ for (int k = 0; k <= prim_size; k++) {
+ prim_eq_type(k) = undefined_cs_cmd;
+ }
+ lmt_primitive_state.prim_used = prim_size;
+}
+
+void tex_initialize_hash_mem(void)
+{
+ if (lmt_main_state.run_state == initializing_state) {
+ if (lmt_hash_state.hash_data.minimum == 0) {
+ tex_emergency_message("startup error", "you need at least some hash size");
+ } else {
+ lmt_hash_state.hash_data.allocated = lmt_hash_state.hash_data.minimum;
+ lmt_hash_state.hash_data.top = eqtb_size + lmt_hash_state.hash_data.minimum;
+ }
+ }
+ {
+ int size = lmt_hash_state.hash_data.top + 1;
+ memoryword *hash = aux_allocate_clear_array(sizeof(memoryword), size, reserved_hash_slots);
+ memoryword *eqtb = aux_allocate_clear_array(sizeof(memoryword), size, reserved_hash_slots);
+ if (hash && eqtb) {
+ lmt_hash_state.hash = hash;
+ lmt_hash_state.eqtb = eqtb;
+ if (lmt_main_state.run_state == initializing_state) {
+ /*tex Initialization happens elsewhere. */
+ } else {
+ tex_initialize_undefined_cs();
+ for (int i = eqtb_size + 1; i <= lmt_hash_state.hash_data.top; i++) {
+ copy_eqtb_entry(i, undefined_control_sequence);
+ }
+ }
+ } else {
+ tex_overflow_error("hash", size);
+ }
+ }
+}
+
+static int tex_aux_room_in_hash(void)
+{
+ if (lmt_hash_state.hash_data.allocated + lmt_hash_state.hash_data.step <= lmt_hash_state.hash_data.size) {
+ int size = lmt_hash_state.hash_data.top + lmt_hash_state.hash_data.step + 1;
+ memoryword *hash = aux_reallocate_array(lmt_hash_state.hash, sizeof(memoryword), size, reserved_hash_slots);
+ memoryword *eqtb = aux_reallocate_array(lmt_hash_state.eqtb, sizeof(memoryword), size, reserved_hash_slots);
+ if (hash && eqtb) {
+ memset(hash + lmt_hash_state.hash_data.top + 1, 0, sizeof(memoryword) * (size_t) lmt_hash_state.hash_data.step);
+ memset(eqtb + lmt_hash_state.hash_data.top + 1, 0, sizeof(memoryword) * (size_t) lmt_hash_state.hash_data.step);
+ lmt_hash_state.hash = hash;
+ lmt_hash_state.eqtb = eqtb;
+ /*tex
+ This is not really needed because we now dp this when a new id is created which
+ is a better place anyway. But we play safe and still do it:
+ */
+ for (int i = lmt_hash_state.hash_data.top + 1; i <= size; i++) {
+ copy_eqtb_entry(i, undefined_control_sequence);
+ }
+ lmt_hash_state.hash_data.allocated += lmt_hash_state.hash_data.step;
+ lmt_hash_state.hash_data.top += lmt_hash_state.hash_data.step;
+ lmt_run_memory_callback("hash", 1);
+ return 1;
+ } else {
+ lmt_run_memory_callback("hash", 0);
+ tex_overflow_error("hash", size);
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ The value of |hash_prime| should be roughly 85\%! of |hash_size|, and it should be a prime
+ number. The theory of hashing tells us to expect fewer than two table probes, on the average,
+ when the search is successful. [See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983),
+ 231--258.]
+
+ https://en.wikipedia.org/wiki/Coalesced_hashing
+
+ Because we seldom use uppercase we get many misses, multiplying a chr j[k] by k actually gives
+ a better spread.
+
+ Making a \CONTEXT\ format takes some 250.000 hash calculations while the \LUAMETATEX\ needs
+ some 1.7 million for just over 250 pages (with an average string length of 15).
+
+ The primitive hash lookups are needed when we initialize and when we lookup an internal
+ variable.
+
+*/
+
+inline static halfword tex_aux_compute_hash(const char *j, int l)
+{
+ halfword h = (unsigned const char) j[0];
+ for (int k = 1; k < l; k++) {
+ h = (h + h + (unsigned const char) j[k]) % hash_prime;
+ }
+ return h;
+}
+
+inline static halfword tex_aux_compute_prim(const char *j, unsigned l)
+{
+ halfword h = (unsigned const char) j[0];
+ for (unsigned k = 1; k < l; k++) {
+ h = (h + h + (unsigned const char) j[k]) % prim_prime;
+ }
+ return h;
+}
+
+halfword tex_prim_lookup(strnumber s)
+{
+ /*tex The index in the |hash| array: */
+ if (s >= cs_offset_value) {
+ unsigned char *j = str_string(s);
+ unsigned l = (unsigned) str_length(s);
+ halfword h = tex_aux_compute_prim((char *) j, l);
+ /*tex We start searching here; note that |0 <= h < hash_prime|. */
+ halfword p = h + 1;
+ while (1) {
+ if (prim_text(p) > 0 && str_length(prim_text(p)) == l && tex_str_eq_str(prim_text(p), s)) {
+ return p;
+ } else if (prim_next(p)) {
+ p = prim_next(p);
+ } else if (lmt_hash_state.no_new_cs) {
+ return undefined_primitive;
+ } else {
+ /*tex Insert a new primitive after |p|, then make |p| point to it. */
+ if (prim_text(p) > 0) {
+ /*tex Search for an empty location in |prim| */
+ do {
+ if (lmt_primitive_state.prim_used > prim_base) {
+ --lmt_primitive_state.prim_used;
+ } else {
+ tex_overflow_error("primitive size", prim_size);
+ }
+ } while (prim_text(lmt_primitive_state.prim_used));
+ prim_next(p) = lmt_primitive_state.prim_used;
+ p = lmt_primitive_state.prim_used;
+ }
+ prim_text(p) = s;
+ break;
+ }
+ }
+ return p;
+ } else if ((s < 0) || (s == undefined_control_sequence)) {
+ return undefined_primitive;
+ } else {
+ return s;
+ }
+}
+
+/*tex How to test a csname for primitive-ness? */
+
+/*
+int tex_cs_is_primitive(strnumber csname)
+{
+ int m = prim_lookup(csname);
+ if (m != undefined_primitive) {
+ char *ss = makecstring(csname);
+ int n = string_locate(ss, str_length(csname), 0);
+ lmt_memory_free(ss);
+ return ((n != undefined_cs_cmd) && (eq_type(n) == prim_eq_type(m)) && (eq_value(n) == prim_equiv(m)));
+ } else {
+ return 0;
+ }
+}
+*/
+
+/*tex Dumping and undumping. */
+
+/* We cheat! It should be dump_things(f, prim_state.prim[p], 1); */
+
+void tex_dump_primitives(dumpstream f)
+{
+ /*
+ for (int p = 0; p <= prim_size; p++) {
+ dump_mem(f, prim_state.prim[p]);
+ }
+ for (int p = 0; p <= prim_size; p++) {
+ dump_mem(f, prim_state.prim_eqtb[p]);
+ }
+ */
+ dump_things(f, lmt_primitive_state.prim[0], prim_size + 1);
+ dump_things(f, lmt_primitive_state.prim_eqtb[0], prim_size + 1);
+ for (int p = 0; p <= last_cmd; p++) {
+ dump_int(f, lmt_primitive_state.prim_data[p].offset);
+ dump_int(f, lmt_primitive_state.prim_data[p].subids);
+ for (int q = 0; q < lmt_primitive_state.prim_data[p].subids; q++) {
+ dump_int(f, lmt_primitive_state.prim_data[p].names[q]);
+ }
+ }
+}
+
+void tex_undump_primitives(dumpstream f)
+{
+ undump_things(f, lmt_primitive_state.prim[0], prim_size + 1);
+ undump_things(f, lmt_primitive_state.prim_eqtb[0], prim_size + 1);
+ for (int p = 0; p <= last_cmd; p++) {
+ undump_int(f, lmt_primitive_state.prim_data[p].offset);
+ undump_int(f, lmt_primitive_state.prim_data[p].subids);
+ if (lmt_primitive_state.prim_data[p].subids > 0) {
+ int size = lmt_primitive_state.prim_data[p].subids;
+ strnumber *names = aux_allocate_clear_array(sizeof(strnumber *), size, 1);
+ if (names) {
+ lmt_primitive_state.prim_data[p].names = names;
+ for (int q = 0; q < lmt_primitive_state.prim_data[p].subids; q++) {
+ undump_int(f, names[q]);
+ }
+ } else {
+ tex_overflow_error("primitives", size * sizeof(strnumber *));
+ }
+ }
+ }
+}
+
+/*tex
+
+ 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.
+
+*/
+
+void tex_dump_hashtable(dumpstream f)
+{
+ dump_int(f, lmt_hash_state.eqtb_data.top);
+ lmt_hash_state.eqtb_data.ptr = frozen_control_sequence - 1 - lmt_hash_state.eqtb_data.top + lmt_hash_state.hash_data.ptr;
+ /* the root entries, i.e. the direct hash slots */
+ for (halfword p = hash_base; p <= lmt_hash_state.eqtb_data.top; p++) {
+ if (cs_text(p)) {
+ dump_int(f, p);
+ dump_int(f, lmt_hash_state.hash[p]);
+ ++lmt_hash_state.eqtb_data.ptr;
+ }
+ }
+ /* the chain entries, i.e. the follow up list slots => eqtb */
+ dump_things(f, lmt_hash_state.hash[lmt_hash_state.eqtb_data.top + 1], special_sequence_base - lmt_hash_state.eqtb_data.top);
+ if (lmt_hash_state.hash_data.ptr > 0) {
+ dump_things(f, lmt_hash_state.hash[eqtb_size + 1], lmt_hash_state.hash_data.ptr);
+ }
+ dump_int(f, lmt_hash_state.eqtb_data.ptr);
+}
+
+void tex_undump_hashtable(dumpstream f)
+{
+ undump_int(f, lmt_hash_state.eqtb_data.top);
+ if (lmt_hash_state.eqtb_data.top >= hash_base && lmt_hash_state.eqtb_data.top <= frozen_control_sequence) {
+ halfword p = hash_base - 1;
+ do {
+ halfword q;
+ undump_int(f, q);
+ if (q >= (p + 1) && q <= lmt_hash_state.eqtb_data.top) {
+ undump_int(f, lmt_hash_state.hash[q]);
+ p = q;
+ } else {
+ goto BAD;
+ }
+ } while (p != lmt_hash_state.eqtb_data.top);
+ undump_things(f, lmt_hash_state.hash[lmt_hash_state.eqtb_data.top + 1], special_sequence_base - lmt_hash_state.eqtb_data.top);
+ if (lmt_hash_state.hash_data.ptr > 0) {
+ /* we get a warning on possible overrun here */
+ undump_things(f, lmt_hash_state.hash[eqtb_size + 1], lmt_hash_state.hash_data.ptr);
+ }
+ undump_int(f, lmt_hash_state.eqtb_data.ptr);
+ lmt_hash_state.eqtb_data.initial = lmt_hash_state.eqtb_data.ptr;
+ return;
+ }
+ BAD:
+ tex_fatal_undump_error("hash");
+}
+
+/*tex
+
+ We need to put \TEX's \quote {primitive} control sequences into the hash table, together with
+ their command code (which will be the |eq_type|) and an operand (which will be the |equiv|).
+ The |primitive| procedure does this, in a way that no \TEX\ user can. The global value |cur_val|
+ contains the new |eqtb| pointer after |primitive| has acted.
+
+ Because the definitions of the actual user-accessible name of a primitive can be postponed until
+ runtime, the function |primitive_def| is needed that does nothing except creating the control
+ sequence name.
+
+*/
+
+void tex_primitive_def(const char *str, size_t length, singleword cmd, halfword chr)
+{
+ /*tex This creates the |text()| string: */
+ cur_val = tex_string_locate(str, length, 1);
+ set_eq_level(cur_val, level_one);
+ set_eq_type(cur_val, cmd);
+ set_eq_flag(cur_val, primitive_flag_bit);
+ set_eq_value(cur_val, chr);
+}
+
+/*tex
+
+ The function |store_primitive_name| sets up the bookkeeping for the reverse lookup. It is
+ quite paranoid, because it is easy to mess this up accidentally.
+
+ The |offset| is needed because sometimes character codes (in |o|) are indices into |eqtb|
+ or are offset by a magical value to make sure they do not conflict with something else. We
+ don't want the |prim_data[c].names| to have too many entries as it will just be wasted room,
+ so |offset| is substracted from |o| before creating or accessing the array.
+
+*/
+
+static void tex_aux_store_primitive_name(strnumber s, singleword cmd, halfword chr, halfword offset)
+{
+ lmt_primitive_state.prim_data[cmd].offset = offset;
+ if (lmt_primitive_state.prim_data[cmd].subids < (chr + 1)) {
+ /*tex Not that efficient as each primitive triggers this now but only at ini time so ... */
+ strnumber *newstr = aux_allocate_clear_array(sizeof(strnumber *), chr + 1, 1);
+ if (lmt_primitive_state.prim_data[cmd].names) {
+ memcpy(newstr, lmt_primitive_state.prim_data[cmd].names, (unsigned) (lmt_primitive_state.prim_data[cmd].subids) * sizeof(strnumber));
+ aux_deallocate_array(lmt_primitive_state.prim_data[cmd].names);
+ }
+ lmt_primitive_state.prim_data[cmd].names = newstr;
+ lmt_primitive_state.prim_data[cmd].subids = chr + 1;
+ }
+ lmt_primitive_state.prim_data[cmd].names[chr] = s;
+}
+
+/*tex
+
+ Compared to \TEX82, |primitive| has two extra parameters. The |off| is an offset that will be
+ passed on to |store_primitive_name|, the |cmd_origin| is the bit that is used to group
+ primitives by originator. So the next function is called for each primitive and fills |prim_eqtb|.
+
+ Contrary to \LUATEX\ we define (using |primitive_def|) all primitives beforehand, so not only
+ those with |cmd_origin| values |core| and |tex|. As side effect, we don't get redundant string
+ entries as in \LUATEX.
+
+*/
+
+void tex_primitive(int cmd_origin, const char *str, singleword cmd, halfword chr, halfword offset)
+{
+ int prim_val;
+ strnumber ss;
+ if (cmd_origin != no_command) {
+ tex_primitive_def(str, strlen(str), cmd, offset + chr);
+ /*tex Indeed, |cur_val| has the latest primitive. */
+ ss = cs_text(cur_val);
+ } else {
+ ss = tex_maketexstring(str);
+ }
+ prim_val = tex_prim_lookup(ss);
+ prim_origin(prim_val) = (quarterword) cmd_origin;
+ prim_eq_type(prim_val) = cmd;
+ prim_equiv(prim_val) = offset + chr;
+ tex_aux_store_primitive_name(ss, cmd, chr, offset);
+}
+
+/*tex
+
+ Here is a helper that does the actual hash insertion. This code far from ideal: the existence
+ of |hash_extra| changes all the potential (short) coalesced lists into a single (long) one.
+ This will create a slowdown.
+
+ Here |hash_state.hash_used| starts out as the maximum \quote {normal} hash, not extra.
+
+*/
+
+static halfword tex_aux_insert_id(halfword p, const unsigned char *j, unsigned int l)
+{
+ if (cs_text(p) > 0) {
+ RESTART:
+ if (lmt_hash_state.hash_data.ptr < lmt_hash_state.hash_data.allocated) {
+ ++lmt_hash_state.hash_data.ptr;
+ cs_next(p) = lmt_hash_state.hash_data.ptr + eqtb_size;
+ p = cs_next(p);
+ } else if (tex_aux_room_in_hash()) {
+ goto RESTART;
+ } else {
+ /*tex
+ Search for an empty location in |hash|. This actually makes the direct first hit
+ in such a hash slot invalid but we check for the string anyway. As we now use a
+ hash size that is rather minimal, we don't really need this branch. It is a last
+ resort anyway.
+ */
+ do {
+ if (lmt_hash_state.eqtb_data.top == hash_base) {
+ /*tex We cannot go lower than this. */
+ tex_overflow_error("hash size", hash_size + lmt_hash_state.hash_data.allocated);
+ }
+ --lmt_hash_state.eqtb_data.top;
+ } while (cs_text(lmt_hash_state.eqtb_data.top) != 0);
+ cs_next(p) = lmt_hash_state.eqtb_data.top;
+ p = lmt_hash_state.eqtb_data.top;
+ }
+ }
+ cs_text(p) = tex_push_string(j, l);
+ copy_eqtb_entry(p, undefined_control_sequence);
+ ++lmt_hash_state.eqtb_data.ptr;
+ return p;
+}
+
+/*tex
+
+ Here is the subroutine that searches the hash table for an identifier that matches a given
+ string of length |l > 1| appearing in |buffer[j .. (j + l - 1)]|. If the identifier is found,
+ the corresponding hash table address is returned. Otherwise, if the global variable
+ |no_new_control_sequence| is |true|, the dummy address |undefined_control_sequence| is returned.
+ Otherwise the identifier is inserted into the hash table and its location is returned.
+
+ On the \LUAMETATEX\ manual we have 250K hits and 400K misses. Adapting the max and prime does
+ bring down the misses but also no gain in performance. In practice we seldom follow the chain.
+
+*/
+
+halfword tex_id_locate(int j, int l, int create)
+{
+ /*tex The index in |hash| array: */
+ halfword h = tex_aux_compute_hash((char *) (lmt_fileio_state.io_buffer + j), l);
+ /*tex We start searching here. Note that |0 <= h < hash_prime|: */
+ halfword p = h + hash_base;
+ /*tex The next one in a list: */
+ while (1) {
+ strnumber s = cs_text(p);
+ if ((s > 0) && (str_length(s) == (unsigned) l) && tex_str_eq_buf(s, j, l)) {
+ return p;
+ } else {
+ halfword n = cs_next(p);
+ if (n) {
+ p = n;
+ } else if (create) {
+ return tex_aux_insert_id(p, (lmt_fileio_state.io_buffer + j), (unsigned) l);
+ } else {
+ break;
+ }
+ }
+ }
+ return undefined_control_sequence;
+}
+
+/*tex
+
+ Here is a similar subroutine for finding a primitive in the hash. This one is based on a \CCODE\
+ string.
+
+*/
+
+halfword tex_string_locate(const char *s, size_t l, int create)
+{
+ /*tex The hash code: */
+ halfword h = tex_aux_compute_hash(s, (int) l);
+ /*tex The index in |hash| array. We start searching here. Note that |0 <= h < hash_prime|: */
+ halfword p = h + hash_base;
+ while (1) {
+ if (cs_text(p) > 0 && tex_str_eq_cstr(cs_text(p), s, (int) l)) {
+ return p;
+ } else {
+ halfword n = cs_next(p);
+ if (n) {
+ p = n;
+ } else if (create) {
+ return tex_aux_insert_id(p, (const unsigned char *) s, (unsigned) l);
+ } else {
+ break;
+ }
+ }
+ }
+ return undefined_control_sequence;
+}
+
+halfword tex_located_string(const char *s)
+{
+ size_t l = strlen(s);
+ return tex_string_locate(s, l, 0);
+}
+
+/*tex
+
+ The |print_cmd_chr| routine prints a symbolic interpretation of a command code and its modifier.
+ This is used in certain \quotation {You can\'t} error messages, and in the implementation of
+ diagnostic routines like |\show|.
+
+ The body of |print_cmd_chr| use to be a rather tedious listing of print commands, and most of it
+ was essentially an inverse to the |primitive| routine that enters a \TEX\ primitive into |eqtb|.
+
+ Thanks to |prim_data|, there is no need for all that tediousness. What is left of |primt_cnd_chr|
+ are just the exceptions to the general rule that the |cmd,chr_code| pair represents in a single
+ primitive command.
+
+*/
+
+static void tex_aux_print_chr_cmd(const char *s, halfword cmd, halfword chr)
+{
+ tex_print_str(s);
+ if (chr) {
+ tex_print_str(cmd == letter_cmd ? " letter " : " character ");
+ tex_print_uhex(chr);
+ tex_print_char(' ');
+ /*
+ By using the the unicode (ascii) names for some we can better support syntax
+ highlighting (which often involves parsing). The names are enclused in single
+ quotes. For the chr codes above 128 we assume \UNICODE\ support.
+ */
+ /*tex
+ We already intercepted the line feed here so that it doesn't give a side effect here
+ in the original |tex_print_tex_str(chr)| call but we have now inlined similar code
+ but without side effects.
+ */
+ if (chr < 32 || chr == 127) {
+ return;
+ } else if (chr <= 0x7F) {
+ switch (chr) {
+ case '\n' : tex_print_str("'line feed'"); return;
+ case '\r' : tex_print_str("'carriage return'"); return;
+ case ' ' : tex_print_str("'space'"); return;
+ case '!' : tex_print_str("'exclamation mark'"); return;
+ case '\"' : tex_print_str("'quotation mark'"); return;
+ case '#' : tex_print_str("'hash tag'"); return;
+ case '$' : tex_print_str("'dollar sign'"); return;
+ case '%' : tex_print_str("'percent sign'"); return;
+ case '&' : tex_print_str("'ampersand'"); return;
+ case '\'' : tex_print_str("'apostrophe'"); return;
+ case '(' : tex_print_str("'left parenthesis'"); return;
+ case ')' : tex_print_str("'right parenthesis'"); return;
+ case '*' : tex_print_str("'asterisk'"); return;
+ case '+' : tex_print_str("'plus sign'"); return;
+ case ',' : tex_print_str("'comma'"); return;
+ case '-' : tex_print_str("'hyphen minus'"); return;
+ case '.' : tex_print_str("'full stop'"); return;
+ case '/' : tex_print_str("'slash'"); return;
+ case ':' : tex_print_str("'colon'"); return;
+ case ';' : tex_print_str("'semicolon'"); return;
+ case '<' : tex_print_str("'less than sign'"); return;
+ case '=' : tex_print_str("'equal sign'"); return;
+ case '>' : tex_print_str("'more than sign'"); return;
+ case '?' : tex_print_str("'question mark'"); return;
+ case '@' : tex_print_str("'at sign'"); return;
+ case '[' : tex_print_str("'left square bracket'"); return;
+ case '\\' : tex_print_str("'backslash'"); return;
+ case ']' : tex_print_str("'right square bracket'"); return;
+ case '^' : tex_print_str("'circumflex accent'"); return;
+ case '_' : tex_print_str("'low line'"); return;
+ case '`' : tex_print_str("'grave accent'"); return;
+ case '{' : tex_print_str("'left curly bracket'"); return;
+ case '|' : tex_print_str("'vertical bar'"); return;
+ case '}' : tex_print_str("'right curly bracket'"); return;
+ case '~' : tex_print_str("'tilde'"); return;
+ }
+ tex_print_char(chr);
+ } else if (chr <= 0x7FF) {
+ tex_print_char(0xC0 + (chr / 0x40));
+ tex_print_char(0x80 + (chr % 0x40));
+ } else if (chr <= 0xFFFF) {
+ tex_print_char(0xE0 + (chr / 0x1000));
+ tex_print_char(0x80 + ((chr % 0x1000) / 0x40));
+ tex_print_char(0x80 + ((chr % 0x1000) % 0x40));
+ } else if (chr <= 0x10FFFF) {
+ tex_print_char(0xF0 + (chr / 0x40000));
+ tex_print_char(0x80 + ((chr % 0x40000) / 0x1000));
+ tex_print_char(0x80 + (((chr % 0x40000) % 0x1000) / 0x40));
+ tex_print_char(0x80 + (((chr % 0x40000) % 0x1000) % 0x40));
+ }
+ }
+}
+
+/*tex |\TEX82| Didn't print the |cmd,idx| information, but it may be useful. */
+
+static void tex_aux_prim_cmd_chr(quarterword cmd, halfword chr)
+{
+ if (cmd <= last_visible_cmd) {
+ int idx = chr - lmt_primitive_state.prim_data[cmd].offset;
+ if (idx >= 0 && idx < lmt_primitive_state.prim_data[cmd].subids) {
+ if (lmt_primitive_state.prim_data[cmd].names && lmt_primitive_state.prim_data[cmd].names[idx]) {
+ tex_print_tex_str_esc(lmt_primitive_state.prim_data[cmd].names[idx]);
+ } else {
+ tex_print_format("[warning: cmd %i, chr %i, no name]", cmd, idx);
+ }
+ } else if (cmd == internal_int_cmd && idx < number_int_pars) {
+ /* a special case */
+ tex_print_format("[integer: chr %i, class specific]", cmd);
+ } else {
+ tex_print_format("[warning: cmd %i, chr %i, out of range]", cmd, idx);
+ }
+ } else {
+ tex_print_format("[warning: cmd %i, invalid]", cmd);
+ }
+}
+
+static void tex_aux_show_lua_call(const char *what, int slot)
+{
+ int callback_id = lmt_callback_defined(show_lua_call_callback);
+ if (callback_id) {
+ char *ss = NULL;
+ int lua_retval = lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "Sd->S", what, slot, &ss);
+ if (lua_retval && ss && strlen(ss) > 0) {
+ tex_print_str(ss);
+ lmt_memory_free(ss);
+ return;
+ }
+ }
+ tex_print_format("%s %i", what, slot);
+}
+
+void tex_print_cmd_flags(halfword cs, halfword cmd, int flags, int escaped)
+{
+ if (flags) {
+ flags = eq_flag(cs);
+ if (is_frozen (flags)) { (escaped ? tex_print_str_esc : tex_print_str)("frozen " ); }
+ if (is_permanent(flags)) { (escaped ? tex_print_str_esc : tex_print_str)("permanent "); }
+ if (is_immutable(flags)) { (escaped ? tex_print_str_esc : tex_print_str)("immutable "); }
+ if (is_primitive(flags)) { (escaped ? tex_print_str_esc : tex_print_str)("primitive "); }
+ if (is_mutable (flags)) { (escaped ? tex_print_str_esc : tex_print_str)("mutable " ); }
+ if (is_noaligned(flags)) { (escaped ? tex_print_str_esc : tex_print_str)("noaligned "); }
+ if (is_instance (flags)) { (escaped ? tex_print_str_esc : tex_print_str)("instance " ); }
+ if (is_untraced (flags)) { (escaped ? tex_print_str_esc : tex_print_str)("untraced " ); }
+ }
+ if (is_tolerant_cmd (cmd)) {
+ (escaped ? tex_print_str_esc : tex_print_str)("tolerant " );
+ }
+ if (is_protected_cmd(cmd)) {
+ (escaped ? tex_print_str_esc : tex_print_str)("protected ");
+ } else if (is_semi_protected_cmd(cmd)) {
+ (escaped ? tex_print_str_esc : tex_print_str)("semiprotected ");
+ }
+}
+
+void tex_print_cmd_chr(singleword cmd, halfword chr)
+{
+ switch (cmd) {
+ case left_brace_cmd:
+ tex_aux_print_chr_cmd("begin group", cmd, chr);
+ break;
+ case right_brace_cmd:
+ tex_aux_print_chr_cmd("end group", cmd, chr);
+ break;
+ case math_shift_cmd:
+ tex_aux_print_chr_cmd("math shift", cmd, chr);
+ break;
+ case alignment_tab_cmd:
+ tex_aux_print_chr_cmd("alignment tab", cmd, chr);
+ break;
+ case parameter_cmd:
+ tex_aux_print_chr_cmd("parameter", cmd, chr);
+ break;
+ case superscript_cmd:
+ tex_aux_print_chr_cmd("superscript", cmd, chr);
+ break;
+ case subscript_cmd:
+ tex_aux_print_chr_cmd("subscript", cmd, chr);
+ break;
+ case spacer_cmd:
+ tex_aux_print_chr_cmd("blank space", cmd, chr);
+ break;
+ case letter_cmd:
+ case other_char_cmd:
+ tex_aux_print_chr_cmd("the", cmd, chr);
+ break;
+ /*
+ case active_char_cmd:
+ case comment_cmd:
+ case invalid_char_cmd:
+ break;
+ */
+ case end_template_cmd:
+ /*tex Kind of special: |chr| points to |null_list). */
+ tex_print_str_esc("endtemplate");
+ // tex_print_str("end of alignment template");
+ break;
+ case if_test_cmd:
+ if (chr <= last_if_test_code) {
+ tex_aux_prim_cmd_chr(cmd, chr);
+ } else {
+ tex_aux_show_lua_call("luacondition", chr - last_if_test_code);
+ }
+ break;
+ case char_given_cmd:
+ tex_print_str_esc("char");
+ tex_print_qhex(chr);
+ break;
+ // case math_char_given_cmd:
+ // /*tex
+ // Okay, it's better for old macro packages that mess with meaning to report a more
+ // traditional value. A compromise. But, this might be dropped.
+ // */
+ // tex_print_str_esc("mathchar");
+ // tex_show_mathcode_value(tex_mathchar_from_integer(chr, tex_mathcode), tex_mathcode);
+ // break;
+ // case math_char_xgiven_cmd:
+ // tex_print_str_esc("Umathchar");
+ // tex_show_mathcode_value(tex_mathchar_from_integer(chr, umath_mathcode), umath_mathcode);
+ // break;
+ case lua_call_cmd:
+ tex_aux_show_lua_call("luacall", chr);
+ break;
+ case lua_local_call_cmd:
+ tex_aux_show_lua_call("local luacall", chr);
+ break;
+ case lua_protected_call_cmd:
+ tex_aux_show_lua_call("protected luacall", chr);
+ break;
+ case lua_value_cmd:
+ tex_aux_show_lua_call("luavalue", chr);
+ break;
+ case set_font_cmd:
+ tex_print_str("select font ");
+ tex_print_font(chr);
+ break;
+ case undefined_cs_cmd:
+ tex_print_str("undefined");
+ break;
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ tex_print_cmd_flags(cur_cs, cur_cmd, 1, 0);
+ tex_print_str("macro");
+ break;
+ case internal_toks_cmd:
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ case register_toks_cmd:
+ tex_print_str_esc("toks");
+ tex_print_int(register_toks_number(chr));
+ break;
+ case internal_int_cmd:
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ case register_int_cmd:
+ tex_print_str_esc("count");
+ tex_print_int(register_int_number(chr));
+ break;
+ case internal_attribute_cmd:
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ case register_attribute_cmd:
+ tex_print_str_esc("attribute");
+ tex_print_int(register_attribute_number(chr));
+ break;
+ case internal_dimen_cmd:
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ case register_dimen_cmd:
+ tex_print_str_esc("dimen");
+ tex_print_int(register_dimen_number(chr));
+ break;
+ case internal_glue_cmd:
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ case register_glue_cmd:
+ tex_print_str_esc("skip");
+ tex_print_int(register_glue_number(chr));
+ break;
+ case internal_mu_glue_cmd:
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ case register_mu_glue_cmd:
+ tex_print_str_esc("muskip");
+ tex_print_int(register_mu_glue_number(chr));
+ break;
+ case node_cmd:
+ tex_print_str(node_token_flagged(chr) ? "large" : "small");
+ tex_print_str(" node reference");
+ break;
+ case integer_cmd:
+ tex_print_str("integer ");
+ tex_print_int(chr);
+ break;
+ case dimension_cmd:
+ tex_print_str("dimension ");
+ tex_print_dimension(chr, pt_unit);
+ break;
+ case gluespec_cmd:
+ tex_print_str("gluespec ");
+ tex_print_spec(chr, pt_unit);
+ break;
+ case mugluespec_cmd:
+ tex_print_str("mugluespec ");
+ tex_print_spec(chr, mu_unit);
+ break;
+ case mathspec_cmd:
+ switch (node_subtype(chr)) {
+ case tex_mathcode:
+ tex_print_str_esc("mathchar");
+ break;
+ case umath_mathcode:
+ /* case umathnum_mathcode: */
+ tex_print_str_esc("Umathchar");
+ break;
+ case mathspec_mathcode:
+ tex_print_str("mathspec ");
+ }
+ tex_print_mathspec(chr);
+ break;
+ case fontspec_cmd:
+ {
+ /* We don't check for validity here. */
+ tex_print_str("fontspec ");
+ tex_print_fontspec(chr);
+ }
+ break;
+ case deep_frozen_end_template_cmd:
+ /*tex Kind of special: |chr| points to |null_list). */
+ tex_print_str_esc("endtemplate");
+ break;
+ case deep_frozen_dont_expand_cmd:
+ /*tex Kind of special. */
+ tex_print_str_esc("notexpanded");
+ break;
+ /*
+ case string_cmd:
+ print_str("string:->");
+ print(cs_offset_value + chr);
+ break;
+ */
+ case internal_box_reference_cmd:
+ tex_print_str_esc("hiddenlocalbox");
+ break;
+ default:
+ /*tex These are most commands, actually. Todo: local boxes*/
+ tex_aux_prim_cmd_chr(cmd, chr);
+ break;
+ }
+}
diff --git a/source/luametatex/source/tex/texprimitive.h b/source/luametatex/source/tex/texprimitive.h
new file mode 100644
index 000000000..640a6b232
--- /dev/null
+++ b/source/luametatex/source/tex/texprimitive.h
@@ -0,0 +1,95 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_PRIMITIVE_H
+# define LMT_PRIMITIVE_H
+
+/*tex
+
+ This is a list of origins for primitive commands. The engine starts out with hardly anything
+ enabled so as a first step one should enable the \TEX\ primitives, and additional \ETEX\ and
+ \LUATEX\ primitives. Maybe at some moment we should just enable all by default.
+
+*/
+
+typedef enum command_origin {
+ tex_command = 1,
+ etex_command = 2,
+ luatex_command = 4,
+ no_command = 8,
+} command_origin;
+
+typedef struct hash_state_info {
+ memoryword *hash; /*tex The hash table. */
+ memory_data hash_data;
+ memoryword *eqtb; /*tex The equivalents table. */
+ memory_data eqtb_data;
+ int no_new_cs; /*tex Are new identifiers legal? */
+ int padding;
+} hash_state_info ;
+
+extern hash_state_info lmt_hash_state;
+
+/*tex
+
+ We use no defines as a |hash| macro will clash with lua hash. Most hash accessors are in a few
+ places where it makes sense to be explicit anyway.
+
+*/
+
+# define cs_next(a) lmt_hash_state.hash[(a)].half0 /*tex link for coalesced lists */
+# define cs_text(a) lmt_hash_state.hash[(a)].half1 /*tex string number for control sequence name */
+
+# define undefined_primitive 0
+# define prim_size 2100 /*tex (can be 1000) maximum number of primitives (quite a bit more than needed) */
+# define prim_prime 1777 /*tex (can be 853) about 85 percent of |primitive_size| */
+
+typedef struct primitive_info {
+ halfword subids; /*tex number of name entries */
+ halfword offset; /*tex offset to be used for |chr_code|s */
+ strnumber *names; /*tex array of names */
+} prim_info;
+
+typedef struct primitive_state_info {
+ memoryword prim[prim_size + 1];
+ memoryword prim_eqtb[prim_size + 1];
+ prim_info prim_data[last_cmd + 1];
+ halfword prim_used;
+ /* alignment */
+ int padding;
+} primitive_state_info;
+
+extern primitive_state_info lmt_primitive_state;
+
+# define prim_next(a) lmt_primitive_state.prim[(a)].half0 /*tex Link for coalesced lists. */
+# define prim_text(a) lmt_primitive_state.prim[(a)].half1 /*tex String number for control sequence name. */
+# define prim_origin(a) lmt_primitive_state.prim_eqtb[(a)].quart01 /*tex Level of definition. */
+# define prim_eq_type(a) lmt_primitive_state.prim_eqtb[(a)].quart00 /*tex Command code for equivalent. */
+# define prim_equiv(a) lmt_primitive_state.prim_eqtb[(a)].half1 /*tex Equivalent value. */
+
+# define get_prim_eq_type(p) prim_eq_type(p)
+# define get_prim_equiv(p) prim_equiv(p)
+# define get_prim_text(p) prim_text(p)
+# define get_prim_origin(p) prim_origin(p)
+
+extern void tex_initialize_primitives (void);
+extern void tex_initialize_hash_mem (void);
+/* int tex_room_in_hash (void); */
+extern halfword tex_prim_lookup (strnumber s);
+/* int tex_cs_is_primitive (strnumber csname); */
+extern void tex_primitive (int cmd_origin, const char *ss, singleword cmd, halfword chr, halfword offset);
+extern void tex_primitive_def (const char *str, size_t length, singleword cmd, halfword chr);
+extern void tex_print_cmd_chr (singleword cmd, halfword chr);
+extern void tex_dump_primitives (dumpstream f);
+extern void tex_undump_primitives (dumpstream f);
+extern void tex_dump_hashtable (dumpstream f);
+extern void tex_undump_hashtable (dumpstream f);
+/* halfword tex_string_lookup (const char *s, size_t l); */
+extern halfword tex_string_locate (const char *s, size_t l, int create);
+extern halfword tex_located_string (const char *s);
+/* halfword tex_id_lookup (int j, int l); */
+extern halfword tex_id_locate (int j, int l, int create);
+extern void tex_print_cmd_flags (halfword cs, halfword cmd, int flags, int escape);
+
+# endif
diff --git a/source/luametatex/source/tex/texprinting.c b/source/luametatex/source/tex/texprinting.c
new file mode 100644
index 000000000..005c2a3c8
--- /dev/null
+++ b/source/luametatex/source/tex/texprinting.c
@@ -0,0 +1,1460 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+print_state_info lmt_print_state = {
+ .logfile = NULL,
+ .loggable_info = NULL,
+ .selector = 0,
+ .tally = 0,
+ .terminal_offset = 0,
+ .logfile_offset = 0,
+ .new_string_line = 0,
+ .trick_buffer = { 0 },
+ .trick_count = 0,
+ .first_count = 0,
+ .saved_selector = 0,
+ .font_in_short_display = 0,
+ .saved_logfile = NULL,
+ .saved_logfile_offset = 0,
+};
+
+/*tex
+
+ During the development of \LUAMETATEX\ reporting has been stepwise upgraded, for instance with more
+ abstract print functions and a formatter. Much more detail is shown and additional tracing options
+ have been added (like for marks, inserts, adjust, math, etc.). The format of the traditonal messages
+ was mostly kept (sometimes under paramameter control using a higher tracing value) but after reading
+ the nth ridiculous comment about logging in \LUATEX\ related to \CONTEXT\ I decided that it no
+ longer made sense to offer compatibility because it will never satisfy everyone and we want to move
+ on, so per spring 2022 we will see even further normalization and log compatility options get (are)
+ dropped. If there are inconsistencies left, assume they will be dealt with. It's all about being able
+ to recognize what gets logged. If someone longs for the old reporting, there are plenty alternative
+ engines available.
+
+ [where: ...] : all kind of tracing
+ {...} : more traditional tex tracing
+ <...> : if tracing (maybe)
+
+*/
+
+/*tex
+
+ Messages that are sent to a user's terminal and to the transcript-log file are produced by
+ several |print| procedures. These procedures will direct their output to a variety of places,
+ based on the setting of the global variable |selector|, which has the following possible values:
+
+ \startitemize
+
+ \startitem
+ |term_and_log|, the normal setting, prints on the terminal and on the transcript file.
+ \stopitem
+
+ \startitem
+ |log_only|, prints only on the transcript file.
+ \stopitem
+
+ \startitem
+ |term_only|, prints only on the terminal.
+ \stopitem
+
+ \startitem
+ |no_print|, doesn't print at all. This is used only in rare cases before the transcript
+ file is open.
+ \stopitem
+
+ \startitem
+ |pseudo|, puts output into a cyclic buffer that is used by the |show_context| routine; when
+ we get to that routine we shall discuss the reasoning behind this curious mode.
+ \stopitem
+
+ \startitem
+ |new_string|, appends the output to the current string in the string pool.
+ \stopitem
+
+ \startitem
+ 0 to 15, prints on one of the sixteen files for |\write| output.
+ \stopitem
+
+ \stopitemize
+
+ The symbolic names |term_and_log|, etc., have been assigned numeric codes that satisfy the
+ convenient relations |no_print + 1 = term_only|, |no_print + 2 = log_only|, |term_only + 2 =
+ log_only + 1 = term_and_log|.
+
+ Three additional global variables, |tally| and |term_offset| and |file_offset|, record the
+ number of characters that have been printed since they were most recently cleared to zero. We
+ use |tally| to record the length of (possibly very long) stretches of printing; |term_offset|
+ and |file_offset|, on the other hand, keep track of how many characters have appeared so far on
+ the current line that has been output to the terminal or to the transcript file, respectively.
+
+ The state structure collects: |new_string_line| and |escape_controls|, the transcript handle of
+ a \TEX\ session: |log_file|, the target of a message: |selector|, the digits in a number being
+ output |dig[23]|, the number of characters recently printed |tally|, the number of characters
+ on the current terminal line |term_offset|, the number of characters on the current file line
+ |file_offset|, the circular buffer for pseudoprinting |trick_buf|, the threshold for
+ pseudoprinting (explained later) |trick_count|, another variable for pseudoprinting
+ |first_count|, a blocker for minor adjustments to |show_token_list| namely |inhibit_par_tokens|.
+
+ To end a line of text output, we call |print_ln|:
+
+*/
+
+void tex_print_ln(void)
+{
+ switch (lmt_print_state.selector) {
+ case no_print_selector_code:
+ break;
+ case terminal_selector_code:
+ fputc('\n', stdout);
+ lmt_print_state.terminal_offset = 0;
+ break;
+ case logfile_selector_code:
+ fputc('\n', lmt_print_state.logfile);
+ lmt_print_state.logfile_offset = 0;
+ break;
+ case terminal_and_logfile_selector_code:
+ fputc('\n', stdout);
+ fputc('\n', lmt_print_state.logfile);
+ lmt_print_state.terminal_offset = 0;
+ lmt_print_state.logfile_offset = 0;
+ break;
+ case pseudo_selector_code:
+ break;
+ case new_string_selector_code:
+ if (lmt_print_state.new_string_line > 0) {
+ tex_print_char(lmt_print_state.new_string_line);
+ }
+ break;
+ case luabuffer_selector_code:
+ lmt_newline_to_buffer();
+ break;
+ default:
+ break;
+ }
+ /*tex |tally| is not affected */
+}
+
+
+/*tex
+
+ The |print_char| procedure sends one byte to the desired destination. All printing comes through
+ |print_ln| or |print_char|, except for the case of |print_str| (see below).
+
+ The checking of the line length is an inheritance from previous engines and we dropped it here.
+ It doesn't make much sense nowadays. The same is true for escaping.
+
+ Incrementing the tally ... only needed in pseudo mode :
+
+*/
+
+// void tex_print_char(int s)
+// {
+// if (s < 0 || s > 255) {
+// tex_formatted_warning("print", "weird character %i", s);
+// } else if (s == new_line_char_par && (lmt_print_state.selector < pseudo_selector_code)) {
+// tex_print_ln();
+// } else {
+// switch (lmt_print_state.selector) {
+// case no_print_selector_code:
+// break;
+// case terminal_selector_code:
+// fputc(s, stdout);
+// ++lmt_print_state.terminal_offset;
+// break;
+// case logfile_selector_code:
+// fputc(s, lmt_print_state.logfile);
+// ++lmt_print_state.logfile_offset;
+// break;
+// case terminal_and_logfile_selector_code:
+// fputc(s, stdout);
+// fputc(s, lmt_print_state.logfile);
+// ++lmt_print_state.terminal_offset;
+// ++lmt_print_state.logfile_offset;
+// break;
+// case pseudo_selector_code:
+// if (lmt_print_state.tally < lmt_print_state.trick_count) {
+// lmt_print_state.trick_buffer[lmt_print_state.tally % lmt_error_state.line_limits.size] = (unsigned char) s;
+// }
+// ++lmt_print_state.tally;
+// break;
+// case new_string_selector_code:
+// tex_append_char((unsigned char) s);
+// break;
+// case luabuffer_selector_code:
+// lmt_char_to_buffer((char) s);
+// break;
+// default:
+// break;
+// }
+// }
+// }
+
+void tex_print_char(int s)
+{
+ if (s < 0 || s > 255) {
+ tex_formatted_warning("print", "weird character %i", s);
+ } else {
+ switch (lmt_print_state.selector) {
+ case no_print_selector_code:
+ break;
+ case terminal_selector_code:
+ if (s == new_line_char_par) {
+ fputc('\n', stdout);
+ lmt_print_state.terminal_offset = 0;
+ } else {
+ fputc(s, stdout);
+ ++lmt_print_state.terminal_offset;
+ }
+ break;
+ case logfile_selector_code:
+ if (s == new_line_char_par) {
+ fputc('\n', lmt_print_state.logfile);
+ lmt_print_state.logfile_offset = 0;
+ } else {
+ fputc(s, lmt_print_state.logfile);
+ ++lmt_print_state.logfile_offset;
+ }
+ break;
+ case terminal_and_logfile_selector_code:
+ if (s == new_line_char_par) {
+ fputc('\n', stdout);
+ fputc('\n', lmt_print_state.logfile);
+ lmt_print_state.terminal_offset = 0;
+ lmt_print_state.logfile_offset = 0;
+ } else {
+ fputc(s, stdout);
+ fputc(s, lmt_print_state.logfile);
+ ++lmt_print_state.terminal_offset;
+ ++lmt_print_state.logfile_offset;
+ }
+ break;
+ case pseudo_selector_code:
+ if (lmt_print_state.tally < lmt_print_state.trick_count) {
+ lmt_print_state.trick_buffer[lmt_print_state.tally % lmt_error_state.line_limits.size] = (unsigned char) s;
+ }
+ ++lmt_print_state.tally;
+ break;
+ case new_string_selector_code:
+ tex_append_char((unsigned char) s);
+ break;
+ case luabuffer_selector_code:
+ lmt_char_to_buffer((char) s);
+ break;
+ default:
+ break;
+ }
+ }
+}
+
+/*tex
+
+ An entire string is output by calling |print|. Note that if we are outputting the single
+ standard \ASCII\ character |c|, we could call |print("c")|, since |"c" = 99| is the number of a
+ single-character string, as explained above. But |print_char("c")| is quicker, so \TEX\ goes
+ directly to the |print_char| routine when it knows that this is safe. (The present
+ implementation assumes that it is always safe to print a visible \ASCII\ character.)
+
+ The first 256 entries above the 17th unicode plane are used for a special trick: when \TEX\ has
+ to print items in that range, it will instead print the character that results from substracting
+ 0x110000 from that value. This allows byte-oriented output to things like |\specials|.
+
+ This feature will disappear.
+
+*/
+
+static void tex_aux_uprint(int s)
+{
+ /*tex We're not sure about this so it's disabled for now! */
+ /*
+ if ((print_state.selector > pseudo_selector_code)) {
+ / *tex internal strings are not expanded * /
+ print_char(s);
+ return;
+ }
+ */
+ if (s == new_line_char_par && lmt_print_state.selector < pseudo_selector_code) {
+ tex_print_ln();
+ return;
+ } else if (s <= 0x7F) {
+ tex_print_char(s);
+ } else if (s <= 0x7FF) {
+ tex_print_char(0xC0 + (s / 0x40));
+ tex_print_char(0x80 + (s % 0x40));
+ } else if (s <= 0xFFFF) {
+ tex_print_char(0xE0 + (s / 0x1000));
+ tex_print_char(0x80 + ((s % 0x1000) / 0x40));
+ tex_print_char(0x80 + ((s % 0x1000) % 0x40));
+ } else if (s >= 0x110000) {
+ int c = s - 0x110000;
+ if (c >= 256) {
+ tex_formatted_warning("print", "bad raw byte to print (c=%d), skipped",c);
+ } else {
+ tex_print_char(c);
+ }
+ } else {
+ tex_print_char(0xF0 + (s / 0x40000));
+ tex_print_char(0x80 + ((s % 0x40000) / 0x1000));
+ tex_print_char(0x80 + (((s % 0x40000) % 0x1000) / 0x40));
+ tex_print_char(0x80 + (((s % 0x40000) % 0x1000) % 0x40));
+ }
+}
+
+static void tex_aux_lprint(lstring *ss) {
+ /*tex current character code position */
+ unsigned char *j = ss->s;
+ unsigned char *l = j + ss->l;
+ while (j < l) {
+ /*tex We don't bother checking the last two bytes explicitly */
+ /* 0x110000 in utf=8: 0xF4 0x90 0x80 0x80 */
+ if ((j < l - 4) && (*j == 0xF4) && (*(j + 1) == 0x90)) {
+ int c = (*(j + 2) - 128) * 64 + (*(j + 3) - 128);
+ tex_print_char(c);
+ j = j + 4;
+ } else {
+ tex_print_char(*j);
+ ++j;
+ }
+ }
+}
+
+void tex_print_tex_str(int s)
+{
+ if (s >= lmt_string_pool_state.string_pool_data.ptr) {
+ tex_normal_warning("print", "bad string pointer");
+ } else if (s < cs_offset_value) {
+ if (s < 0) {
+ tex_normal_warning("print", "bad string offset");
+ } else {
+ tex_aux_uprint(s);
+ }
+ } else if (lmt_print_state.selector == new_string_selector_code) {
+ tex_append_string(str_string(s), (unsigned) str_length(s));
+ } else {
+ tex_aux_lprint(&str_lstring(s));
+ }
+}
+
+/*tex
+
+ The procedure |print_nl| is like |print|, but it makes sure that the string appears at the
+ beginning of a new line.
+
+*/
+
+void tex_print_nlp(void)
+{
+ if (lmt_print_state.new_string_line > 0) {
+ tex_print_char(lmt_print_state.new_string_line);
+ } else {
+ switch (lmt_print_state.selector) {
+ case terminal_selector_code:
+ if (lmt_print_state.terminal_offset > 0) {
+ fputc('\n', stdout);
+ lmt_print_state.terminal_offset = 0;
+ }
+ break;
+ case logfile_selector_code:
+ if (lmt_print_state.logfile_offset > 0) {
+ fputc('\n', lmt_print_state.logfile);
+ lmt_print_state.logfile_offset = 0;
+ }
+ break;
+ case terminal_and_logfile_selector_code:
+ if (lmt_print_state.terminal_offset > 0) {
+ fputc('\n', stdout);
+ lmt_print_state.terminal_offset = 0;
+ }
+ if (lmt_print_state.logfile_offset > 0) {
+ fputc('\n', lmt_print_state.logfile);
+ lmt_print_state.logfile_offset = 0;
+ }
+ break;
+ case luabuffer_selector_code:
+ lmt_newline_to_buffer();
+ break;
+ }
+ }
+}
+
+/*tex
+
+ The |char *| versions of the same procedures. |print_str| is different because it uses
+ buffering, which works well because most of the output actually comes through |print_str|.
+
+*/
+
+void tex_print_str(const char *s)
+{
+ int logfile = 0;
+ int terminal = 0;
+ switch (lmt_print_state.selector) {
+ case no_print_selector_code:
+ return;
+ case terminal_selector_code:
+ terminal = 1;
+ break;
+ case logfile_selector_code:
+ logfile = 1;
+ break;
+ case terminal_and_logfile_selector_code:
+ logfile = 1;
+ terminal = 1;
+ break;
+ case pseudo_selector_code:
+ while ((*s) && (lmt_print_state.tally < lmt_print_state.trick_count)) {
+ lmt_print_state.trick_buffer[lmt_print_state.tally % lmt_error_state.line_limits.size] = (unsigned char) *s++;
+ lmt_print_state.tally++;
+ }
+ return;
+ case new_string_selector_code:
+ tex_append_string((const unsigned char *) s, (unsigned) strlen(s));
+ return;
+ case luabuffer_selector_code:
+ lmt_string_to_buffer(s);
+ return;
+ default:
+ break;
+ }
+ if (terminal || logfile) {
+ int len = (int) strlen(s);
+ if (logfile && ! lmt_fileio_state.log_opened) {
+ logfile = 0;
+ }
+ if (len > 0) {
+ int newline = s[len-1] == '\n';
+ if (logfile) {
+ fputs(s, lmt_print_state.logfile);
+ if (newline) {
+ lmt_print_state.logfile_offset = 0;
+ } else {
+ lmt_print_state.logfile_offset += len;
+ }
+ }
+ if (terminal) {
+ fputs(s, stdout);
+ if (newline) {
+ lmt_print_state.terminal_offset = 0;
+ } else {
+ lmt_print_state.terminal_offset += len;
+ }
+ }
+ }
+ }
+}
+
+/*tex
+
+ Here is the very first thing that \TEX\ prints: a headline that identifies the version number
+ and format package. The |term_offset| variable is temporarily incorrect, but the discrepancy is
+ not serious since we assume that the banner and format identifier together will occupy at most
+ |max_print_line| character positions. Well, we dropped that check in this variant.
+
+ Maybe we should drop printing the format identifier.
+
+*/
+
+void tex_print_banner(void)
+{
+ fprintf(
+ stdout,
+ "%s %s\n",
+ lmt_engine_state.luatex_banner,
+ str_string(lmt_dump_state.format_identifier)
+ );
+}
+
+void tex_print_log_banner(void)
+{
+ fprintf(
+ lmt_print_state.logfile,
+ "engine: %s, format id: %s, time stamp: %d-%d-%d %d:%d, startup file: %s, job name: %s, dump name: %s",
+ lmt_engine_state.luatex_banner,
+ str_string(lmt_dump_state.format_identifier),
+ year_par, month_par > 12 ? 0 : month_par, day_par, time_par / 60, time_par % 60,
+ lmt_engine_state.startup_filename ? lmt_engine_state.startup_filename : "-",
+ lmt_engine_state.startup_jobname ? lmt_engine_state.startup_jobname : "-",
+ lmt_engine_state.dump_name ? lmt_engine_state.dump_name : "-"
+ );
+}
+
+void tex_print_version_banner(void)
+{
+ fputs(lmt_engine_state.luatex_banner, stdout);
+}
+
+/*tex
+
+ The procedure |print_esc| prints a string that is preceded by the user's escape character
+ (which is usually a backslash).
+
+*/
+
+void tex_print_tex_str_esc(strnumber s)
+{
+ /*tex Set variable |c| to the current escape character: */
+ int c = escape_char_par;
+ if (c >= 0 && c < 0x110000) {
+ tex_print_tex_str(c);
+ }
+ if (s) {
+ tex_print_tex_str(s);
+ }
+}
+
+/*tex This prints escape character, then |s|. */
+
+void tex_print_str_esc(const char *s)
+{
+ /*tex Set variable |c| to the current escape character: */
+ int c = escape_char_par;
+ if (c >= 0 && c < 0x110000) {
+ tex_print_tex_str(c);
+ }
+ if (s) {
+ tex_print_str(s);
+ }
+}
+
+/*tex
+ An array of digits in the range |0..15| is printed by |print_the_digs|. These digits are in the
+ reverse order: |dig[k-1]|$\,\ldots\,$|dig[0]|!
+*/
+
+// inline static void tex_print_decimal_digits(const unsigned char *digits, int k)
+// {
+// while (k-- > 0) {
+// tex_print_char('0' + digits[k]);
+// }
+// }
+
+// inline static void tex_print_hexadecimal_digits(const unsigned char *digits, int k)
+// {
+// while (k-- > 0) {
+// if (digits[k] < 10) {
+// tex_print_char('0' + digits[k]);
+// } else {
+// tex_print_char('A' - 10 + digits[k]);
+// }
+// }
+// }
+
+/*tex
+
+ The following procedure, which prints out the decimal representation of a given integer |n|,
+ has been written carefully so that it works properly if |n = 0| or if |(-n)| would cause
+ overflow. It does not apply |mod| or |div| to negative arguments, since such operations are not
+ implemented consistently by all \PASCAL\ compilers.
+
+*/
+
+// void tex_print_int(int n)
+// {
+// /*tex In the end a 0..9 fast path works out best. */
+// if (n >= 0 && n <= 9) {
+// tex_print_char('0' + n);
+// } else {
+// /*tex index to current digit; we assume that $|n|<10^{23}$ */
+// int k = 0;
+// unsigned char digits[24];
+// if (n < 0) {
+// tex_print_char('-');
+// n = -n;
+// }
+// do {
+// digits[k] = (unsigned char) (n % 10);
+// n = n / 10;
+// ++k;
+// } while (n != 0);
+// tex_print_decimal_digits(digits, k);
+// }
+// }
+
+void tex_print_int(int n)
+{
+ /*tex In the end a 0..9 fast path works out best; using |sprintf| is slower. */
+ if (n >= 0 && n <= 9) {
+ tex_print_char('0' + n);
+ } else {
+ int k = 0;
+ unsigned char digits[24];
+ if (n < 0) {
+ tex_print_char('-');
+ n = -n;
+ }
+ do {
+ digits[k] = '0' + (unsigned char) (n % 10);
+ n = n / 10;
+ ++k;
+ } while (n != 0);
+ while (k-- > 0) {
+ tex_print_char(digits[k]);
+ }
+ }
+}
+
+/*tex
+
+ Conversely, here is a procedure analogous to |print_int|. If the output of this procedure is
+ subsequently read by \TEX\ and converted by the |round_decimals| routine above, it turns out
+ that the original value will be reproduced exactly; the \quote {simplest} such decimal number
+ is output, but there is always at least one digit following the decimal point.
+
+ The invariant relation in the |repeat| loop is that a sequence of decimal digits yet to be
+ printed will yield the original number if and only if they form a fraction~$f$ in the range $s
+ - \delta \L10 \cdot 2^{16} f < s$. We can stop if and only if $f = 0$ satisfies this condition;
+ the loop will terminate before $s$ can possibly become zero.
+
+ The next one prints a scaled real, rounded to five digits.
+
+*/
+
+void tex_print_dimension(scaled s, int unit)
+{
+ if (s == 0) {
+ tex_print_str("0.0"); /* really .. just 0 is not ok for some applications */
+ } else {
+ /*tex The amount of allowable inaccuracy: */
+ scaled delta = 10;
+ char buffer[20] = { 0 } ;
+ int i = 0;
+ if (s < 0) {
+ /*tex Print the sign, if negative. */
+ tex_print_char('-');
+ s = -s;
+ }
+ /*tex Print the integer part. */
+ tex_print_int(s / unity);
+ buffer[i++] = '.';
+ s = 10 * (s % unity) + 5;
+ do {
+ if (delta > unity) {
+ /*tex Round the last digit. */
+ s = s + 0100000 - 50000;
+ }
+ buffer[i++] = (unsigned char) ('0' + (s / unity));
+ s = 10 * (s % unity);
+ delta *= 10;
+ } while (s > delta);
+ // buffer[i++] = '\0';
+ tex_print_str(buffer);
+ }
+ if (unit != no_unit) {
+ tex_print_unit(unit);
+ }
+}
+
+void tex_print_sparse_dimension(scaled s, int unit)
+{
+ if (s == 0) {
+ tex_print_char('0');
+ } else if (s == unity) {
+ tex_print_char('1');
+ } else {
+ /*tex The amount of allowable inaccuracy: */
+ scaled delta = 10;
+ char buffer[20];
+ int i = 0;
+ if (s < 0) {
+ /*tex Print the sign, if negative. */
+ tex_print_char('-');
+ /*tex So we trust it here while in printing int we mess around. */
+ s = -s;
+ }
+ /*tex Print the integer part. */
+ tex_print_int(s / unity);
+ s = 10 * (s % unity) + 5;
+ do {
+ if (delta > unity) {
+ /*tex Round the last digit. */
+ s = s + 0100000 - 50000;
+ }
+ buffer[i++] = (unsigned char) ('0' + (s / unity));
+ s = 10 * (s % unity);
+ delta *= 10;
+ } while (s > delta);
+ if (i == 1 && buffer[i-1] == '0') {
+ /* no need */
+ } else {
+ buffer[i++] = '\0';
+ tex_print_char('.');
+ tex_print_str(buffer);
+ }
+ }
+ if (unit != no_unit) {
+ tex_print_unit(unit);
+ }
+}
+
+/*tex
+
+ Hexadecimal printing of nonnegative integers is accomplished by |print_hex|. We have a few
+ variants. Because we have bitsets that can give upto |0xFFFFFFFF| we treat the given integer
+ as an unsigned.
+*/
+
+// void tex_print_hex(int n)
+// {
+// /*tex index to current digit; we assume that $0\L n<16^{22}$ */
+// int k = 0 ;
+// unsigned char digits[24];
+// do {
+// digits[k] = n % 16;
+// n = n / 16;
+// ++k;
+// } while (n != 0);
+// tex_print_hexadecimal_digits(digits, k);
+// }
+
+void tex_print_hex(int sn)
+{
+ unsigned int n = (unsigned int) sn;
+ int k = 0;
+ unsigned char digits[24];
+ if (n < 0) {
+ tex_print_char('-');
+ n = -n;
+ }
+ do {
+ unsigned char d = (unsigned char) (n % 16);
+ if (d < 10) {
+ digits[k] = '0' + d;
+ } else {
+ digits[k] = 'A' - 10 + d;
+ }
+ n = n / 16;
+ ++k;
+ } while (n != 0);
+ while (k-- > 0) {
+ tex_print_char(digits[k]);
+ }
+}
+
+void tex_print_qhex(int n)
+{
+ tex_print_char('"');
+ tex_print_hex(n);
+}
+
+void tex_print_uhex(int n)
+{
+ tex_print_str("U+");
+ if (n < 16) {
+ tex_print_char('0');
+ }
+ if (n < 256) {
+ tex_print_char('0');
+ }
+ if (n < 4096) {
+ tex_print_char('0');
+ }
+ tex_print_hex(n);
+}
+
+/*tex
+
+ Roman numerals are produced by the |print_roman_int| routine. Readers who like puzzles might
+ enjoy trying to figure out how this tricky code works; therefore no explanation will be given.
+ Notice that 1990 yields |mcmxc|, not |mxm|.
+
+*/
+
+void tex_print_roman_int(int n)
+{
+ char mystery[] = "m2d5c2l5x2v5i";
+ char *j = (char *) mystery;
+ int v = 1000;
+ while (1) {
+ while (n >= v) {
+ tex_print_char(*j);
+ n = n - v;
+ }
+ if (n <= 0) {
+ /*tex nonpositive input produces no output */
+ return;
+ } else {
+ char *k = j + 2;
+ int u = v / (*(k - 1) - '0');
+ if (*(k - 1) == '2') {
+ k = k + 2;
+ u = u / (*(k - 1) - '0');
+ }
+ if (n + u >= v) {
+ tex_print_char(*k);
+ n = n + u;
+ } else {
+ j = j + 2;
+ v = v / (*(j - 1) - '0');
+ }
+ }
+ }
+}
+
+/*tex
+
+ The |print| subroutine will not print a string that is still being created. The following
+ procedure will.
+
+*/
+
+void tex_print_current_string(void)
+{
+ for (int j = 0; j < lmt_string_pool_state.string_temp_top; j++) {
+ tex_print_char(lmt_string_pool_state.string_temp[j++]);
+ }
+}
+
+/*tex
+
+ The procedure |print_cs| prints the name of a control sequence, given a pointer to its address
+ in |eqtb|. A space is printed after the name unless it is a single nonletter or an active
+ character. This procedure might be invoked with invalid data, so it is \quote {extra robust}.
+ The individual characters must be printed one at a time using |print|, since they may be
+ unprintable.
+
+*/
+
+void tex_print_cs_checked(halfword p)
+{
+ if (p == null_cs) {
+ tex_print_str_esc("csname");
+ tex_print_str_esc("endcsname");
+ tex_print_char(' ');
+ } else if (p < hash_base) {
+ tex_print_str(error_string_impossible(11));
+ } else if (p == undefined_control_sequence) {
+ tex_print_str_esc("undefined");
+ tex_print_char(' ');
+ } else if (eqtb_out_of_range(p)) {
+ tex_print_str(error_string_impossible(12));
+ } else {
+ strnumber t = cs_text(p);
+ if (t < 0 || t >= lmt_string_pool_state.string_pool_data.ptr) {
+ tex_print_str(error_string_nonexistent(13));
+ } else if (tex_is_active_cs(t)) {
+ tex_print_tex_str(active_cs_value(t));
+ } else {
+ tex_print_tex_str_esc(t);
+ if (! tex_single_letter(t) || (tex_get_cat_code(cat_code_table_par, aux_str2uni(str_string(t))) == letter_cmd)) {
+ tex_print_char(' ');
+ }
+ }
+ }
+}
+
+/*tex
+
+ Here is a similar procedure; it avoids the error checks, and it never prints a space after the
+ control sequence. The other one doesn't even print the bogus cs.
+
+*/
+
+void tex_print_cs(halfword p)
+{
+ if (p == null_cs) {
+ tex_print_str_esc("csname");
+ tex_print_str_esc("endcsname");
+ } else {
+ strnumber t = cs_text(p);
+ if (tex_is_active_cs(t)) {
+ tex_print_tex_str(active_cs_value(t));
+ } else {
+ tex_print_tex_str_esc(t);
+ }
+ }
+}
+
+void tex_print_cs_name(halfword p)
+{
+ if (p != null_cs) {
+ strnumber t = cs_text(p);
+ if (tex_is_active_cs(t)) {
+ tex_print_tex_str(active_cs_value(t));
+ } else {
+ tex_print_tex_str(t);
+ }
+ }
+}
+
+/*tex
+
+ Then there is a subroutine that prints glue stretch and shrink, possibly followed by the name
+ of finite units:
+
+*/
+
+void tex_print_glue(scaled d, int order, int unit)
+{
+ tex_print_dimension(d, no_unit);
+ if ((order < normal_glue_order) || (order > filll_glue_order)) {
+ tex_print_str("foul");
+ } else if (order > normal_glue_order) {
+ tex_print_str("fi");
+ while (order > fi_glue_order) {
+ tex_print_char('l');
+ --order;
+ }
+ } else {
+ tex_print_unit(unit);
+ }
+}
+
+/*tex The next subroutine prints a whole glue specification. */
+
+void tex_print_unit(int unit)
+{
+ if (unit != no_unit) {
+ tex_print_str(unit == pt_unit ? "pt" : "mu");
+ }
+}
+
+void tex_print_spec(int p, int unit)
+{
+ if (p < 0) {
+ tex_print_char('*');
+ } else if (p == 0) {
+ tex_print_dimension(0, unit);
+ } else {
+ tex_print_dimension(glue_amount(p), unit);
+ if (glue_stretch(p)) {
+ tex_print_str(" plus ");
+ tex_print_glue(glue_stretch(p), glue_stretch_order(p), unit);
+ }
+ if (glue_shrink(p)) {
+ tex_print_str(" minus ");
+ tex_print_glue(glue_shrink(p), glue_shrink_order(p), unit);
+ }
+ }
+}
+
+void tex_print_fontspec(int p)
+{
+ tex_print_int(font_spec_identifier(p));
+ if (font_spec_scale(p) != unused_scale_value) {
+ tex_print_str(" scale ");
+ tex_print_int(font_spec_scale(p));
+ }
+ if (font_spec_x_scale(p) != unused_scale_value) {
+ tex_print_str(" xscale ");
+ tex_print_int(font_spec_x_scale(p));
+ }
+ if (font_spec_y_scale(p) != unused_scale_value) {
+ tex_print_str(" yscale ");
+ tex_print_int(font_spec_y_scale(p));
+ }
+}
+
+/*tex Math characters: */
+
+void tex_print_mathspec(int p)
+{
+ if (p) {
+ mathcodeval m = tex_get_math_spec(p);
+ tex_show_mathcode_value(m, node_subtype(p));
+ } else {
+ tex_print_str("[invalid mathspec]");
+ }
+}
+
+/*tex
+
+ We can reinforce our knowledge of the data structures just introduced by considering two
+ procedures that display a list in symbolic form. The first of these, called |short_display|, is
+ used in \quotation {overfull box} messages to give the top-level description of a list. The
+ other one, called |show_node_list|, prints a detailed description of exactly what is in the
+ data structure.
+
+ The philosophy of |short_display| is to ignore the fine points about exactly what is inside
+ boxes, except that ligatures and discretionary breaks are expanded. As a result,
+ |short_display| is a recursive procedure, but the recursion is never more than one level deep.
+
+ A global variable |font_in_short_display| keeps track of the font code that is assumed to be
+ present when |short_display| begins; deviations from this font will be printed.
+
+ Boxes, rules, inserts, whatsits, marks, and things in general that are sort of \quote
+ {complicated} are indicated only by printing |[]|.
+
+ We print a bit more than original \TEX. A value of 0 or 1 or any large value will behave the
+ same as before. The reason for this extension is that a |name| not always makes sense.
+
+ \starttyping
+ 0 \foo xyz
+ 1 \foo (bar)
+ 2 <bar> xyz
+ 3 <bar @ ..> xyz
+ 4 <id>
+ 5 <id: bar>
+ 6 <id: bar @ ..> xyz
+ \stoptyping
+
+*/
+
+void tex_print_char_identifier(halfword c) // todo: use string_print_format
+{
+ if (c <= 0x10FFFF) {
+ char b[10];
+ if ( (c >= 0x00E000 && c <= 0x00F8FF) || (c >= 0x0F0000 && c <= 0x0FFFFF) ||
+ (c >= 0x100000 && c <= 0x10FFFF) || (c >= 0x00D800 && c <= 0x00DFFF) ) {
+ sprintf(b, "0x%06X", c);
+ tex_print_str(b);
+ } else {
+ sprintf(b, "U+%06X", c);
+ tex_print_str(b);
+ tex_print_char(' ');
+ tex_print_tex_str(c);
+ }
+ }
+}
+
+void tex_print_font_identifier(halfword f)
+{
+ /*tex |< >| is less likely to clash with text parenthesis */
+ if (tex_is_valid_font(f)) {
+ // switch (tracing_fonts_par) {
+ // case 0:
+ // case 1:
+ // if (font_original(f)) {
+ // tex_print_format(font_original(f));
+ // } else {
+ // tex_print_format("font: %i", f);
+ // }
+ // if (tracing_fonts_par == 0) {
+ // break;
+ // } else if (font_size(f) == font_design_size(f)) {
+ // tex_print_format(" (%s)", font_name(f));
+ // } else {
+ // tex_print_format(" (%s @ %D)", font_name(f), font_size(f), pt_unit);
+ // }
+ // break;
+ // case 2:
+ // tex_print_format("<%s>", font_name(f));
+ // break;
+ // case 3:
+ // tex_print_format("<%s @ %D>", font_name(f), font_size(f), pt_unit);
+ // break;
+ // case 4:
+ // tex_print_format("<%i>", f);
+ // break;
+ // case 5:
+ // tex_print_format("<%i: %s>", f, font_name(f));
+ // break;
+ // /* case 6: */
+ // default:
+ tex_print_format("<%i: %s @ %D>", f, font_name(f), font_size(f), pt_unit);
+ // break;
+ // }
+ } else {
+ tex_print_str("<*>");
+ }
+}
+
+void tex_print_font_specifier(halfword e)
+{
+ if (e && tex_is_valid_font(font_spec_identifier(e))) {
+ tex_print_format("<%i: %i %i %i>", font_spec_identifier(e), font_spec_scale(e), font_spec_x_scale(e), font_spec_y_scale(e));
+ } else {
+ tex_print_str("<*>");
+ }
+}
+
+void tex_print_font(halfword f)
+{
+ if (! f) {
+ tex_print_str("nullfont");
+ } else if (tex_is_valid_font(f)) {
+ tex_print_str(font_name(f));
+ /* if (font_size(f) != font_design_size(f)) { */
+ /*tex
+ Nowadays this check for designsize is rather meaningless so we could as well
+ always enter this branch. We can even make this while blob a callback.
+ */
+ tex_print_format(" at %D", font_size(f), pt_unit);
+ /* } */
+ } else {
+ tex_print_str("nofont");
+ }
+}
+
+/*tex This prints highlights of list |p|. */
+
+void tex_short_display(halfword p)
+{
+ tex_print_levels();
+ if (p) {
+ tex_print_short_node_contents(p);
+ } else {
+ tex_print_str("empty list");
+ }
+}
+
+/*tex This prints token list data in braces. */
+
+void tex_print_token_list(const char *s, halfword p)
+{
+ tex_print_levels();
+ tex_print_str("..");
+ if (s) {
+ tex_print_str(s);
+ tex_print_char(' ');
+ }
+ tex_print_char('{');
+ if ((p >= 0) && (p <= (int) lmt_token_memory_state.tokens_data.top)) {
+ tex_show_token_list(p, null, default_token_show_max, 0);
+ } else {
+ tex_print_str(error_string_clobbered(21));
+ }
+ tex_print_char('}');
+}
+
+/*tex This prints dimensions of a rule node. */
+
+void tex_print_rule_dimen(scaled d)
+{
+ if (d == null_flag) {
+ tex_print_char('*');
+ } else {
+ tex_print_dimension(d, pt_unit);
+ }
+}
+
+/*tex
+
+ Since boxes can be inside of boxes, |show_node_list| is inherently recursive, up to a given
+ maximum number of levels. The history of nesting is indicated by the current string, which
+ will be printed at the beginning of each line; the length of this string, namely |cur_length|,
+ is the depth of nesting.
+
+ A global variable called |depth_threshold| is used to record the maximum depth of nesting for
+ which |show_node_list| will show information. If we have |depth_threshold = 0|, for example,
+ only the top level information will be given and no sublists will be traversed. Another global
+ variable, called |breadth_max|, tells the maximum number of items to show at each level;
+ |breadth_max| had better be positive, or you won't see anything.
+
+ The maximum nesting depth in box displays is kept in |depth_threshold| and the maximum number
+ of items shown at the same list level in |breadth_max|.
+
+ The recursive machinery is started by calling |show_box|. Assign the values |depth_threshold :=
+ show_box_depth| and |breadth_max := show_box_breadth|
+
+*/
+
+void tex_show_box(halfword p)
+{
+ /*tex the show starts at |p| */
+ tex_show_node_list(p, show_box_depth_par, show_box_breadth_par);
+ tex_print_ln();
+}
+
+/*tex
+
+ \TEX\ is occasionally supposed to print diagnostic information that goes only into the
+ transcript file, unless |tracing_online| is positive. Here are two routines that adjust the
+ destination of print commands:
+
+*/
+
+void tex_begin_diagnostic(void)
+{
+ lmt_print_state.saved_selector = lmt_print_state.selector;
+ if ((tracing_online_par <= 0) && (lmt_print_state.selector == terminal_and_logfile_selector_code)) {
+ lmt_print_state.selector = logfile_selector_code;
+ if (lmt_error_state.history == spotless) {
+ lmt_error_state.history = warning_issued;
+ }
+ }
+ tex_print_levels();
+}
+
+/*tex Restore proper conditions after tracing. */
+
+void tex_end_diagnostic(void)
+{
+ tex_print_nlp();
+ lmt_print_state.selector = lmt_print_state.saved_selector;
+}
+
+static void tex_print_padding(void)
+{
+ switch (lmt_print_state.selector) {
+ case terminal_selector_code:
+ if (! odd(lmt_print_state.terminal_offset)) {
+ tex_print_char(' ');
+ }
+ break;
+ case logfile_selector_code:
+ case terminal_and_logfile_selector_code:
+ if (! odd(lmt_print_state.logfile_offset)) {
+ tex_print_char(' ');
+ }
+ break;
+ case luabuffer_selector_code:
+ break;
+ }
+}
+
+void tex_print_levels(void)
+{
+ int l0 = tracing_levels_par;
+ tex_print_nlp();
+ if (l0 > 0) {
+ int l1 = (l0 & 0x01) == tracing_levels_group;
+ int l2 = (l0 & 0x02) == tracing_levels_input;
+ int l4 = (l0 & 0x04) == tracing_levels_catcodes;
+ if (l1) {
+ tex_print_int(cur_level);
+ tex_print_char(':');
+ }
+ if (l2) {
+ tex_print_int(lmt_input_state.input_stack_data.ptr);
+ tex_print_char(':');
+ }
+ if (l4) {
+ tex_print_int(cat_code_table_par);
+ tex_print_char(':');
+ }
+ if (l1 || l2 || l4) {
+ tex_print_char(' ');
+ }
+ tex_print_padding();
+ }
+}
+
+/* maybe %GROUP% where we scan upto [UPPER][%], so %G and %GR are also is ok
+
+ shared with error messages, so at some point we will merge:
+
+ %c int char
+ %s *char string
+ %q *char 'string'
+ %i int integer
+ %e backslash (tex escape)
+ %C int int symbolic representation of cmd chr
+ %E *char \cs
+ %S int tex cs string
+ %M int mode
+ %T int tex string
+ %% percent
+
+ specific for print (I need to identify the rest)
+
+ ! %U int unicode
+ ! %D int dimension
+
+ ! %B int badness
+ ! %G int group
+
+ ! %L int (if) linenumber
+
+*/
+
+extern void tex_print_format(const char *format, ...)
+{
+ va_list args;
+ va_start(args, format); /* hm, weird, no number */
+ while (1) {
+ int chr = *format++;
+ switch (chr) {
+ case '\0':
+ goto DONE;
+ case '%':
+ {
+ chr = *format++;
+ switch (chr) {
+ case '\0':
+ goto DONE;
+ case 'c':
+ tex_print_char(va_arg(args, int));
+ break;
+ case 'e':
+ tex_print_str_esc(NULL);
+ break;
+ case 'i':
+ tex_print_int(va_arg(args, int));
+ break;
+ case 'l':
+ tex_print_levels();
+ break;
+ case 'n':
+ tex_print_extended_subtype(null, (quarterword) va_arg(args, int));
+ break;
+ case 'm':
+ tex_print_cs_checked(va_arg(args, int));
+ break;
+ case 's':
+ tex_print_str(va_arg(args, char *));
+ break;
+ case 'q':
+ tex_print_char('\'');
+ tex_print_str(va_arg(args, char *));
+ tex_print_char('\'');
+ break;
+ case 'x':
+ tex_print_qhex(va_arg(args, int));
+ break;
+ /*
+ case 'u':
+ tex_print_unit(va_arg(args, int));
+ break;
+ */
+ case 'B': /* badness */
+ {
+ scaled b = va_arg(args, halfword);
+ if (b == awful_bad) {
+ tex_print_char('*');
+ } else {
+ tex_print_int(b);
+ }
+ break;
+ }
+ case 'C':
+ {
+ int cmd = va_arg(args, int);
+ int val = va_arg(args, int);
+ tex_print_cmd_chr((singleword) cmd, val); /* inlining doesn't work */
+ break;
+ }
+ case 'D': /* dimension */
+ {
+ scaled s = va_arg(args, scaled);
+ int u = va_arg(args, int);
+ tex_print_dimension(s, u);
+ break;
+ }
+ case 'E':
+ tex_print_str_esc(va_arg(args, char *));
+ break;
+ case 'G':
+ {
+ halfword g = va_arg(args, int);
+ tex_print_group(g);
+ break;
+ }
+ case 'F':
+ {
+ halfword i = va_arg(args, int);
+ tex_print_font_identifier(i);
+ break;
+ }
+ case 'L':
+ {
+ /* typically used for if line */
+ halfword line = va_arg(args, int);
+ if (line) {
+ tex_print_str(" entered on line ");
+ tex_print_int(line);
+ }
+ break;
+ }
+ case 'M':
+ {
+ halfword mode = va_arg(args, int);
+ tex_print_str(tex_string_mode(mode));
+ break;
+ }
+ case 'P':
+ {
+ scaled total = va_arg(args, int);
+ scaled stretch = va_arg(args, int);
+ scaled filstretch = va_arg(args, int);
+ scaled fillstretch = va_arg(args, int);
+ scaled filllstretch = va_arg(args, int);
+ scaled shrink= va_arg(args, int);
+ tex_print_dimension(total, pt_unit);
+ if (stretch) {
+ tex_print_str(" plus ");
+ tex_print_dimension(stretch, pt_unit);
+ } else if (filstretch) {
+ tex_print_str(" plus ");
+ tex_print_dimension(filstretch, no_unit);
+ tex_print_str(" fil");
+ } else if (fillstretch) {
+ tex_print_str(" plus ");
+ tex_print_dimension(fillstretch, no_unit);
+ tex_print_str(" fill");
+ } else if (filllstretch) {
+ tex_print_str(" plus ");
+ tex_print_dimension(fillstretch, no_unit);
+ tex_print_str(" filll");
+ }
+ if (shrink) {
+ tex_print_str(" minus ");
+ tex_print_dimension(shrink, pt_unit);
+ }
+ break;
+ }
+ case 'S':
+ {
+ halfword cs = va_arg(args, int);
+ tex_print_cs(cs);
+ break;
+ }
+ case 'T':
+ {
+ strnumber s = va_arg(args, int);
+ tex_print_tex_str(s);
+ break;
+ }
+ case 'U':
+ {
+ halfword c = va_arg(args, int);
+ tex_print_uhex(c);
+ break;
+ }
+ case '%':
+ tex_print_char('%');
+ break;
+ // case '[':
+ // tex_begin_diagnostic();
+ // tex_print_char('[');
+ // break;
+ // case ']':
+ // tex_print_char(']');
+ // tex_end_diagnostic();
+ // break;
+ default:
+ /* ignore bad one */
+ break;
+ }
+ }
+ break;
+ default:
+ tex_print_char(chr); /* todo: utf */
+ break;
+ }
+ }
+ DONE:
+ va_end(args);
+}
+
+/*tex
+
+ Group codes were introcued in \ETEX\ but have been extended in the meantime in \LUATEX\ and
+ later again in \LUAMETATEX. We might have (even) more granularity in the future.
+
+ Todo: combine this with an array of struct(id,name,lua) ... a rainy day + stack of new cd's job.
+
+*/
+
+void tex_print_group(int e)
+{
+ int line = tex_saved_line_at_level();
+ tex_print_str(lmt_interface.group_code_values[cur_group].name);
+ if (cur_group != bottom_level_group) {
+ tex_print_str(" group");
+ if (line) {
+ tex_print_str(e ? " entered at line " : " at line ");
+ tex_print_int(line);
+ }
+ }
+}
+
+void tex_print_message(const char *s)
+{
+ tex_print_nlp();
+ tex_print_char('(');
+ tex_print_str(s);
+ tex_print_char(')');
+ tex_print_nlp();
+}
diff --git a/source/luametatex/source/tex/texprinting.h b/source/luametatex/source/tex/texprinting.h
new file mode 100644
index 000000000..61b7e45a2
--- /dev/null
+++ b/source/luametatex/source/tex/texprinting.h
@@ -0,0 +1,133 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_PRINTING_H
+# define LMT_PRINTING_H
+
+typedef enum selector_settings {
+ no_print_selector_code, /*tex |selector| setting that makes data disappear */
+ terminal_selector_code, /*tex printing is destined for the terminal only */
+ logfile_selector_code, /*tex printing is destined for the transcript file only */
+ terminal_and_logfile_selector_code, /*tex normal |selector| setting */
+ pseudo_selector_code, /*tex special |selector| setting for |show_context| */
+ new_string_selector_code, /*tex printing is deflected to the string pool */
+ luabuffer_selector_code,
+} selector_settings;
+
+typedef struct print_state_info {
+ FILE *logfile;
+ char *loggable_info;
+ int selector;
+ int terminal_offset;
+ int logfile_offset;
+ int new_string_line;
+ int tally;
+ unsigned char trick_buffer[max_error_line + 1]; /* padded */
+ int trick_count;
+ int first_count;
+ int saved_selector;
+ int font_in_short_display; /*tex an internal font number */
+ FILE *saved_logfile;
+ int saved_logfile_offset;
+} print_state_info;
+
+extern print_state_info lmt_print_state;
+
+typedef enum spec_units {
+ no_unit,
+ pt_unit,
+ mu_unit,
+} spec_units;
+
+/*tex
+ Some of these can go away because we stepwise implement usage of |tex_print_format| instead of
+ a multitude of specific calls. It's one of these thing I do when I'm bored.
+
+ todo : check tex_print_ln
+ todo : check tex_print_nl
+ todo : check tex_print_str_nl
+
+*/
+
+extern void tex_print_ln (void); /* always forces a newline */
+extern void tex_print_char (int s);
+extern void tex_print_tex_str (int s);
+extern void tex_print_tex_str_esc (strnumber s);
+extern void tex_print_nlp (void); /* flushes a line if we're doing one */
+extern void tex_print_banner (void);
+extern void tex_print_log_banner (void);
+extern void tex_print_version_banner (void);
+////// void tex_print_digits (const unsigned char *digits, int k);
+extern void tex_print_int (int n);
+extern void tex_print_hex (int n);
+extern void tex_print_uhex (int n);
+extern void tex_print_qhex (int n);
+extern void tex_print_roman_int (int n);
+extern void tex_print_current_string (void);
+extern void tex_print_cs_checked (halfword p); /*tex Also does the |IMPOSSIBLE| etc. */
+extern void tex_print_cs (halfword p); /*tex Only does the undefined case. */
+extern void tex_print_cs_name (halfword p); /*tex Only prints known ones. */
+extern void tex_print_str (const char *s);
+extern void tex_print_str_esc (const char *s);
+extern void tex_print_dimension (scaled d, int unit); /*tex prints a dimension with pt */
+extern void tex_print_sparse_dimension (scaled d, int unit); /*tex prints a dimension with pt */
+extern void tex_print_unit (int unit); /*tex prints a glue component */
+extern void tex_print_glue (scaled d, int order, int unit); /*tex prints a glue component */
+extern void tex_print_spec (int p, int unit); /*tex prints a glue specification */
+extern void tex_print_fontspec (int p);
+extern void tex_print_mathspec (int p);
+extern void tex_print_font_identifier (halfword f);
+extern void tex_print_font_specifier (halfword e); /*tex this is an eq table entry */
+extern void tex_print_font (halfword f);
+extern void tex_print_char_identifier (halfword c);
+extern void tex_print_token_list (const char *s, halfword p); /*tex prints token list data in braces */
+extern void tex_print_rule_dimen (scaled d); /*tex prints dimension in rule node */
+extern void tex_print_group (int e);
+extern void tex_print_format (const char *format, ...); /*tex similar to the one we use for errors */
+extern void tex_begin_diagnostic (void);
+extern void tex_print_levels (void);
+extern void tex_end_diagnostic (void);
+extern void tex_show_box (halfword p);
+extern void tex_short_display (halfword p); /*tex prints highlights of list |p| */
+
+extern void tex_print_message (const char *s);
+
+
+/*
+# define single_letter(A) \
+ ((str_length(A)==1)|| \
+ ((str_length(A)==4)&&*(str_string(A))>=0xF0)|| \
+ ((str_length(A)==3)&&*(str_string(A))>=0xE0)|| \
+ ((str_length(A)==2)&&*(str_string(A))>=0xC0))
+
+# define is_active_cs(a) \
+ (a && str_length(a)>3 && \
+ ( *str_string(a) == 0xEF) && \
+ (*(str_string(a)+1) == 0xBF) && \
+ (*(str_string(a)+2) == 0xBF))
+
+*/
+
+inline static int tex_single_letter(strnumber s)
+{
+ return (
+ (str_length(s) == 1)
+ || ( (str_length(s) == 4) && *(str_string(s) ) >= 0xF0)
+ || ( (str_length(s) == 3) && *(str_string(s) ) >= 0xE0)
+ || ( (str_length(s) == 2) && *(str_string(s) ) >= 0xC0)
+ );
+}
+
+inline static int tex_is_active_cs(strnumber s)
+{
+ if (s && str_length(s) > 3) {
+ const unsigned char *ss = str_string(s);
+ return (ss[0] == 0xEF) && (ss[1] == 0xBF) && (ss[2] == 0xBF);
+ } else {
+ return 0;
+ }
+}
+# define active_cs_value(A) aux_str2uni((str_string((A))+3))
+
+# endif
diff --git a/source/luametatex/source/tex/texrules.c b/source/luametatex/source/tex/texrules.c
new file mode 100644
index 000000000..1a3040585
--- /dev/null
+++ b/source/luametatex/source/tex/texrules.c
@@ -0,0 +1,248 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+halfword tex_aux_scan_rule_spec(rule_types t, halfword s)
+{
+ /*tex |width|, |depth|, and |height| all equal |null_flag| now */
+ halfword rule = tex_new_rule_node((quarterword) s);
+ halfword attr = node_attr(rule);
+ switch (t) {
+ case h_rule_type:
+ rule_height(rule) = default_rule;
+ rule_depth(rule) = 0;
+ break;
+ case v_rule_type:
+ case m_rule_type:
+ if (s == strut_rule_code) {
+ rule_width(rule) = 0;
+ node_subtype(rule) = strut_rule_subtype;
+ rule_height(rule) = null_flag;
+ rule_depth(rule) = null_flag;
+ } else {
+ rule_width(rule) = default_rule;
+ }
+ break;
+ }
+ while (1) {
+ /*tex
+ Maybe:
+
+ h : "whdxylrWHDXYLR"
+ v : "whdxytbWHDXYTB"
+ m : "whdxylrtbWHDXYLRTB"
+
+ but for now we are tolerant because internally it's left/right anyway.
+
+ */
+ switch (tex_scan_character("awhdxylrtbcfAWHDXYLRTBCF", 0, 1, 0)) {
+ case 0:
+ goto DONE;
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("attr", 1)) {
+ halfword i = tex_scan_attribute_register_number();
+ halfword v = tex_scan_int(1, NULL);
+ if (eq_value(register_attribute_location(i)) != v) {
+ if (attr) {
+ attr = tex_patch_attribute_list(attr, i, v);
+ } else {
+ attr = tex_copy_attribute_list_set(tex_current_attribute_list(), i, v);
+ }
+ }
+ }
+ break;
+ case 'w': case 'W':
+ if (tex_scan_mandate_keyword("width", 1)) {
+ rule_width(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'h': case 'H':
+ if (tex_scan_mandate_keyword("height", 1)) {
+ rule_height(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'd': case 'D':
+ if (tex_scan_mandate_keyword("depth", 1)) {
+ rule_depth(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'l': case 'L':
+ if (tex_scan_mandate_keyword("left", 1)) {
+ rule_left(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("right", 1)) {
+ rule_right(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 't': case 'T': /* just because it's nicer */
+ if (tex_scan_mandate_keyword("top", 1)) {
+ rule_left(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'b': case 'B': /* just because it's nicer */
+ if (tex_scan_mandate_keyword("bottom", 1)) {
+ rule_right(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'x': case 'X':
+ if (tex_scan_mandate_keyword("xoffset", 1)) {
+ rule_x_offset(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'y': case 'Y':
+ if (tex_scan_mandate_keyword("yoffset", 1)) {
+ rule_y_offset(rule) = tex_scan_dimen(0, 0, 0, 0, NULL);
+ }
+ break;
+ case 'f': case 'F':
+ switch (tex_scan_character("aoAO", 0, 0, 0)) {
+ case 'o': case 'O':
+ if (tex_scan_mandate_keyword("font", 2)) {
+ tex_set_rule_font(rule, tex_scan_font_identifier(NULL));
+ }
+ break;
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("fam", 2)) {
+ tex_set_rule_family(rule, tex_scan_math_family_number());
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("font|fam");
+ goto DONE;
+ }
+ break;
+ case 'c': case 'C':
+ if (tex_scan_mandate_keyword("char", 1)) {
+ rule_character(rule) = tex_scan_char_number(0);
+ }
+ break;
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ node_attr(rule) = attr;
+ if (t == v_rule_type && s == strut_rule_code) {
+ tex_aux_check_text_strut_rule(rule, text_style);
+ }
+ return rule;
+}
+
+void tex_aux_run_vrule(void)
+{
+ tex_tail_append(tex_aux_scan_rule_spec(v_rule_type, cur_chr));
+ cur_list.space_factor = 1000;
+}
+
+void tex_aux_run_hrule(void)
+{
+ tex_tail_append(tex_aux_scan_rule_spec(h_rule_type, cur_chr));
+ cur_list.prev_depth = ignore_depth;
+}
+
+void tex_aux_run_mrule(void)
+{
+ tex_tail_append(tex_aux_scan_rule_spec(m_rule_type, cur_chr));
+}
+
+void tex_aux_check_math_strut_rule(halfword rule, halfword style)
+{
+ if (node_subtype(rule) == strut_rule_subtype) {
+ scaled ht = rule_height(rule);
+ scaled dp = rule_depth(rule);
+ if (ht == null_flag || dp == null_flag) {
+ halfword fnt = tex_get_rule_font(rule, style);
+ halfword chr = rule_character(rule);
+ if (fnt > 0 && chr && tex_char_exists(fnt, chr)) {
+ if (ht == null_flag) {
+ ht = tex_math_font_char_ht(fnt, chr, style);
+ }
+ if (dp == null_flag) {
+ dp = tex_math_font_char_dp(fnt, chr, style);
+ }
+ } else {
+ if (ht == null_flag) {
+ ht = tex_get_math_y_parameter(style, math_parameter_rule_height);
+ }
+ if (dp == null_flag) {
+ dp = tex_get_math_y_parameter(style, math_parameter_rule_depth);
+ }
+ }
+ rule_height(rule) = ht;
+ rule_depth(rule) = dp;
+ }
+ }
+}
+
+void tex_aux_check_text_strut_rule(halfword rule, halfword style)
+{
+ if (node_subtype(rule) == strut_rule_subtype) {
+ scaled ht = rule_height(rule);
+ scaled dp = rule_depth(rule);
+ if (ht == null_flag || dp == null_flag) {
+ halfword fnt = tex_get_rule_font(rule, style);
+ halfword chr = rule_character(rule);
+ if (fnt > 0 && chr && tex_char_exists(fnt, chr)) {
+ if (ht == null_flag) {
+ ht = tex_char_height_from_font(fnt, chr);
+ }
+ if (dp == null_flag) {
+ dp = tex_char_depth_from_font(fnt, chr);
+ }
+ }
+ rule_height(rule) = ht;
+ rule_depth(rule) = dp;
+ }
+ }
+}
+
+halfword tex_get_rule_font(halfword n, halfword style)
+{
+ halfword fnt = rule_font(n);
+ if (fnt > rule_font_fam_offset) {
+ halfword fam = fnt - rule_font_fam_offset;
+ if (fam_par_in_range(fam)) {
+ fnt = tex_fam_fnt(fam, tex_size_of_style(style));
+ }
+ }
+ if (fnt < 0 || fnt >= max_n_of_fonts) {
+ return null_font;
+ } else {
+ return fnt;
+ }
+}
+
+halfword tex_get_rule_family(halfword n)
+{
+ halfword fnt = rule_font(n);
+ if (fnt > rule_font_fam_offset) {
+ halfword fam = fnt - rule_font_fam_offset;
+ if (fam_par_in_range(fam)) {
+ return fam;
+ }
+ }
+ return 0;
+}
+
+void tex_set_rule_font(halfword n, halfword fnt)
+{
+ if (fnt < 0 || fnt >= rule_font_fam_offset) {
+ rule_font(n) = 0;
+ } else {
+ rule_font(n) = fnt;
+ }
+}
+
+void tex_set_rule_family(halfword n, halfword fam)
+{
+ if (fam < 0 || fam >= max_n_of_math_families) {
+ rule_font(n) = rule_font_fam_offset;
+ } else {
+ rule_font(n) = rule_font_fam_offset + fam;
+ }
+}
+
diff --git a/source/luametatex/source/tex/texrules.h b/source/luametatex/source/tex/texrules.h
new file mode 100644
index 000000000..8a01ac847
--- /dev/null
+++ b/source/luametatex/source/tex/texrules.h
@@ -0,0 +1,27 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXRULES_H
+# define LMT_TEXRULES_H
+
+typedef enum rule_types {
+ h_rule_type = 0,
+ v_rule_type = 1,
+ m_rule_type = 2,
+} rule_types;
+
+extern halfword tex_aux_scan_rule_spec (rule_types t, halfword s);
+extern void tex_aux_run_vrule (void);
+extern void tex_aux_run_hrule (void);
+extern void tex_aux_run_mrule (void);
+
+extern void tex_aux_check_text_strut_rule (halfword rule, halfword style);
+extern void tex_aux_check_math_strut_rule (halfword rule, halfword style);
+
+extern halfword tex_get_rule_font (halfword n, halfword style);
+extern halfword tex_get_rule_family (halfword n);
+extern void tex_set_rule_font (halfword n, halfword fnt);
+extern void tex_set_rule_family (halfword n, halfword fam);
+
+# endif
diff --git a/source/luametatex/source/tex/texscanning.c b/source/luametatex/source/tex/texscanning.c
new file mode 100644
index 000000000..8f2dfa050
--- /dev/null
+++ b/source/luametatex/source/tex/texscanning.c
@@ -0,0 +1,5760 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+static void tex_aux_scan_expr (halfword level);
+static void tex_aux_scan_expression (int level);
+
+/*tex
+ A helper.
+*/
+
+inline void tex_push_back(halfword tok, halfword cmd, halfword chr)
+{
+ if (cmd != spacer_cmd && tok != deep_frozen_relax_token && ! (cmd == relax_cmd && chr == no_relax_code)) {
+ tex_back_input(tok);
+ }
+}
+
+/*tex
+
+ Let's turn now to some procedures that \TEX\ calls upon frequently to digest certain kinds of
+ patterns in the input. Most of these are quite simple; some are quite elaborate. Almost all of
+ the routines call |get_x_token|, which can cause them to be invoked recursively.
+
+ The |scan_left_brace| routine is called when a left brace is supposed to be the next non-blank
+ token. (The term \quote {left brace} means, more precisely, a character whose catcode is
+ |left_brace|.) \TEX\ allows |\relax| to appear before the |left_brace|.
+
+*/
+
+/* This reads a mandatory |left_brace|: */
+
+void tex_scan_left_brace(void)
+{
+ /*tex Get the next non-blank non-relax non-call token */
+ while(1) {
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case spacer_cmd:
+ case relax_cmd:
+ /* stay in while */
+ break;
+ case left_brace_cmd:
+ /* we found one */
+ return;
+ default:
+ /* we recover */
+ tex_handle_error(
+ back_error_type,
+ "Missing { inserted",
+ "A left brace was mandatory here, so I've put one in."
+ );
+ cur_tok = left_brace_token + '{';
+ cur_cmd = left_brace_cmd;
+ cur_chr = '{';
+ ++lmt_input_state.align_state;
+ return;
+ }
+ }
+}
+
+/*tex
+
+ The |scan_optional_equals| routine looks for an optional |=| sign preceded by optional spaces;
+ |\relax| is not ignored here.
+
+*/
+
+void tex_scan_optional_equals(void)
+{
+ /*tex Get the next non-blank non-call token. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok != equal_token) {
+ tex_back_input(cur_tok);
+ }
+}
+
+/*tex
+
+ Here is a procedure that sounds an alarm when mu and non-mu units are being switched.
+
+*/
+
+static void tex_aux_mu_error(int n)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Incompatible glue units (case %i)",
+ n,
+ "I'm going to assume that 1mu=1pt when they're mixed."
+ );
+}
+
+/*tex
+
+ The next routine |scan_something_internal| is used to fetch internal numeric quantities like
+ |\hsize|, and also to handle the |\the| when expanding constructions like |\the\toks0| and
+ |\the\baselineskip|. Soon we will be considering the |scan_int| procedure, which calls
+ |scan_something_internal|; on the other hand, |scan_something_internal| also calls |scan_int|,
+ for constructions like |\catcode\`\$| or |\fontdimen 3 \ff|. So we have to declare |scan_int|
+ as a |forward| procedure. A few other procedures are also declared at this point.
+
+ \TEX\ doesn't know exactly what to expect when |scan_something_internal| begins. For example,
+ an integer or dimension or glue value could occur immediately after |\hskip|; and one can even
+ say |\the} with respect to token lists in constructions like |\xdef\o{\the\output}|. On the
+ other hand, only integers are allowed after a construction like |\count|. To handle the various
+ possibilities, |scan_something_internal| has a |level| parameter, which tells the \quote
+ {highest} kind of quantity that |scan_something_internal| is allowed to produce. Seven levels
+ are distinguished, namely |int_val|, |attr_val|, |dimen_val|, |glue_val|, |mu_val|, |tok_val|
+ and |ident_val|.
+
+ The output of |scan_something_internal| (and of the other routines |scan_int|, |scan_dimen|,
+ and |scan_glue| below) is put into the global variable |cur_val|, and its level is put into
+ |cur_val_level|. The highest values of |cur_val_level| are special: |mu_val| is used only when
+ |cur_val| points to something in a \quote {muskip} register, or to one of the three parameters
+ |\thinmuskip|, |\medmuskip|, |\thickmuskip|; |ident_val| is used only when |cur_val| points to
+ a font identifier; |tok_val| is used only when |cur_val| points to |null| or to the reference
+ count of a token list. The last two cases are allowed only when |scan_something_internal| is
+ called with |level = tok_val|.
+
+ If the output is glue, |cur_val| will point to a glue specification, and the reference count
+ of that glue will have been updated to reflect this reference; if the output is a nonempty
+ token list, |cur_val| will point to its reference count, but in this case the count will not
+ have been updated. Otherwise |cur_val| will contain the integer or scaled value in question.
+
+*/
+
+scanner_state_info lmt_scanner_state = {
+ .current_cmd = 0,
+ .current_chr = 0,
+ .current_cs = 0,
+ // .current_flag = 0,
+ .current_tok = 0,
+ .current_val = 0,
+ .current_val_level = 0,
+ .current_box = 0,
+ .last_cs_name = 0,
+ .arithmic_error = 0,
+ .expression_depth = 0,
+};
+
+/*tex
+
+ When a |glue_val| changes to a |dimen_val|, we use the width component of the glue; there is no
+ need to decrease the reference count, since it has not yet been increased. When a |dimen_val|
+ changes to an |int_val|, we use scaled points so that the value doesn't actually change. And
+ when a |mu_val| changes to a |glue_val|, the value doesn't change either.
+
+ In \LUATEX\ we don't share glue but we have copies, so there is no need to mess with the
+ reference count and downgrading.
+
+*/
+
+inline static void tex_aux_downgrade_cur_val(int level, int succeeded, int negative)
+{
+ switch (cur_val_level) {
+ case tok_val_level:
+ case font_val_level:
+ case mathspec_val_level:
+ case fontspec_val_level:
+ /*tex
+ This test pays back as this actually happens, but we also need it for the
+ |none_lua_function| handling. We end up here in |ident_val_level| and |tok_val_level|
+ and they don't downgrade, nor negate which saves a little testing.
+ */
+ break;
+ // case int_val_level:
+ // case attr_val_level:
+ // case dimen_val_level:
+ // while (cur_val_level > level) {
+ // --cur_val_level;
+ // }
+ // if (negative) {
+ // negate(cur_val);
+ // }
+ // break;
+ // case glue_val_level:
+ // case mu_val_level:
+ // while (cur_val_level > level) {
+ // tex_aux_downgrade_cur_val(); /* cleaner is inline */
+ // }
+ // if (succeeded == 1) {
+ // cur_val = new_glue_spec_node(cur_val);
+ // }
+ // if (negative) {
+ // negate(glue_amount(cur_val));
+ // negate(glue_stretch(cur_val));
+ // negate(glue_shrink(cur_val));
+ // }
+ // break;
+ // default:
+ // /* this can't happen */
+ // return 0;
+ default:
+ /*tex There is no real need for it being a loop, a test would do. */
+ while (cur_val_level > level) {
+ /*tex Convert |cur_val| to a lower level. */
+ switch (cur_val_level) {
+ case glue_val_level:
+ cur_val = glue_amount(cur_val);
+ break;
+ case mu_val_level :
+ tex_aux_mu_error(1);
+ break;
+ }
+ --cur_val_level;
+ }
+ if (cur_val_level == glue_val_level || cur_val_level == mu_val_level) {
+ if (succeeded == 1) {
+ cur_val = tex_new_glue_spec_node(cur_val);
+ }
+ if (negative) {
+ glue_amount(cur_val) = -glue_amount(cur_val);
+ glue_stretch(cur_val) = -glue_stretch(cur_val);
+ glue_shrink(cur_val) = -glue_shrink(cur_val);
+ }
+ } else if (negative) {
+ cur_val = -cur_val;
+ }
+ break;
+ }
+}
+
+/*tex
+
+ Some of the internal items can be fetched both routines, and these have been split off into the
+ next routine, that returns true if the command code was understood.
+
+*/
+
+/*tex
+
+ The |last_item_cmd| branch has been flattened a bit because we don't need to treat \ETEX\
+ specific thingies special any longer.
+
+*/
+
+static void tex_aux_set_cur_val_by_lua_value_cmd(halfword index, halfword property)
+{
+ int class = lua_value_none_code;
+ halfword value = 0; /* can also be scaled */
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ class = lmt_function_call_by_class(index, property, &value);
+ switch (class) {
+ case lua_value_none_code:
+ cur_val_level = no_val_level;
+ break;
+ case lua_value_integer_code:
+ case lua_value_cardinal_code:
+ cur_val_level = int_val_level;
+ break;
+ case lua_value_dimension_code:
+ cur_val_level = dimen_val_level;
+ break;
+ case lua_value_skip_code:
+ cur_val_level = glue_val_level;
+ break;
+ case lua_value_boolean_code:
+ /*tex For usage with |\ifboolean| */
+ value = value ? 1 : 0;
+ cur_val_level = int_val_level;
+ break;
+ case lua_value_float_code:
+ /*tex We assume a proper print back. */
+ cur_val_level = tok_val_level;
+ break;
+ case lua_value_string_code:
+ cur_val_level = no_val_level;
+ break;
+ case lua_value_node_code:
+ case lua_value_direct_code:
+ if (value) {
+ switch (node_type(value)) {
+ case hlist_node:
+ case vlist_node:
+ case whatsit_node:
+ case rule_node:
+ cur_val_level = list_val_level;
+ break;
+ default:
+ /* maybe a warning */
+ value = null;
+ cur_val_level = no_val_level;
+ break;
+ }
+ } else {
+ value = null;
+ cur_val_level = no_val_level;
+ }
+ break;
+ default:
+ cur_val_level = no_val_level;
+ break;
+ }
+ cur_val = value;
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+}
+
+halfword tex_scan_lua_value(int index)
+{
+ tex_aux_set_cur_val_by_lua_value_cmd(index, 0);
+ return cur_val_level;
+}
+
+static halfword tex_aux_scan_register_index(void)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ switch (cur_cmd) {
+ case register_toks_cmd : return cur_chr - register_toks_base;
+ case register_int_cmd : return cur_chr - register_int_base;
+ case register_dimen_cmd : return cur_chr - register_dimen_base;
+ case register_attribute_cmd: return cur_chr - register_attribute_base;
+ case register_glue_cmd : return cur_chr - register_glue_base;
+ case register_mu_glue_cmd : return cur_chr - register_mu_glue_base;
+ case char_given_cmd : return cur_chr;
+ case integer_cmd : return cur_chr;
+ default : return -1;
+ }
+}
+
+static halfword tex_aux_scan_character_index(void)
+{
+ halfword result = -1;
+ tex_get_token();
+ if (cur_tok < cs_token_flag) {
+ result = cur_chr;
+ } else if (cur_cmd == char_given_cmd) {
+ result = cur_chr;
+ } else {
+ strnumber txt = cs_text(cur_tok - cs_token_flag);
+ if (tex_single_letter(txt)) {
+ result = aux_str2uni(str_string(txt));
+ } else if (tex_is_active_cs(txt)) {
+ result = active_cs_value(txt);
+ } else {
+ result = max_character_code + 1;
+ }
+ }
+ return result > max_character_code ? -1 : result;
+}
+
+/*
+ Fetch an item in the current node, if appropriate. Here is where |\last*| |\ |, and some more
+ are implemented. The reference count for |\lastskip| will be updated later. We also handle
+ |\inputlineno| and |\badness| here, because they are legal in similar contexts. In the follow
+ up engines much more than these are handled here.
+*/
+
+static int tex_aux_set_cur_val_by_some_cmd(int code)
+{
+ switch (code) {
+ case lastpenalty_code:
+ cur_val_level = int_val_level;
+ goto COMMON;
+ case lastkern_code:
+ cur_val_level = dimen_val_level;
+ goto COMMON;
+ case lastskip_code:
+ cur_val_level = glue_val_level;
+ goto COMMON;
+ case lastboundary_code:
+ cur_val_level = int_val_level;
+ COMMON:
+ {
+ cur_val = 0;
+ if (cur_list.tail != contribute_head && ! (cur_list.tail && node_type(cur_list.tail) == glyph_node) && cur_list.mode != nomode) {
+ switch (code) {
+ case lastpenalty_code:
+ if (node_type(cur_list.tail) == penalty_node) {
+ cur_val = penalty_amount(cur_list.tail);
+ }
+ break;
+ case lastkern_code:
+ if (node_type(cur_list.tail) == kern_node) {
+ cur_val = kern_amount(cur_list.tail);
+ }
+ break;
+ case lastskip_code:
+ if (node_type(cur_list.tail) == glue_node) {
+ cur_val = cur_list.tail;
+ if (node_subtype(cur_list.tail) == mu_glue) {
+ cur_val_level = mu_val_level;
+ }
+ }
+ break; /* should we return 1 ? */
+ case lastboundary_code:
+ if (node_type(cur_list.tail) == boundary_node && node_subtype(cur_list.tail) == user_boundary) {
+ cur_val = boundary_data(cur_list.tail);
+ }
+ break;
+ }
+ } else if (cur_list.mode == vmode && cur_list.tail == cur_list.head) {
+ switch (code) {
+ case lastpenalty_code:
+ cur_val = lmt_page_builder_state.last_penalty;
+ break;
+ case lastkern_code:
+ cur_val = lmt_page_builder_state.last_kern;
+ break;
+ case lastskip_code:
+ if (lmt_page_builder_state.last_glue != max_halfword) {
+ cur_val = lmt_page_builder_state.last_glue;
+ }
+ break; /* should we return 1 ? */
+ case lastboundary_code:
+ cur_val = lmt_page_builder_state.last_boundary;
+ break;
+ }
+ }
+ break;
+ }
+ case last_node_type_code:
+ /*tex
+ We have mode nodes and when the mode parameter is set we report the real numbers.
+ This is a bit messy.
+ */
+ {
+ cur_val_level = int_val_level;
+ if (cur_list.tail != contribute_head && cur_list.mode != nomode) {
+ cur_val = node_type(cur_list.tail);
+ } else if (cur_list.mode == vmode && cur_list.tail == cur_list.head) {
+ cur_val = lmt_page_builder_state.last_node_type;
+ } else if (cur_list.tail == cur_list.head || cur_list.mode == nomode) {
+ cur_val = -1;
+ } else {
+ cur_val = node_type(cur_list.tail);
+ }
+ break;
+ }
+ case last_node_subtype_code:
+ {
+ cur_val_level = int_val_level;
+ if (cur_list.tail != contribute_head && cur_list.mode != nomode) {
+ cur_val = node_subtype(cur_list.tail);
+ } else if (cur_list.mode == vmode && cur_list.tail == cur_list.head) {
+ cur_val = lmt_page_builder_state.last_node_subtype;
+ } else if (cur_list.tail == cur_list.head || cur_list.mode == nomode) {
+ cur_val = -1;
+ } else {
+ cur_val = node_subtype(cur_list.tail);
+ }
+ break;
+ }
+ case input_line_no_code:
+ cur_val = lmt_input_state.input_line;
+ cur_val_level = int_val_level;
+ break;
+ case badness_code:
+ cur_val = lmt_packaging_state.last_badness;
+ cur_val_level = int_val_level;
+ break;
+ case overshoot_code:
+ cur_val = lmt_packaging_state.last_overshoot;
+ cur_val_level = dimen_val_level;
+ break;
+ case luatex_version_code:
+ cur_val = lmt_version_state.version;
+ cur_val_level = int_val_level;
+ break;
+ case luatex_revision_code:
+ cur_val = lmt_version_state.revision;
+ cur_val_level = int_val_level;
+ break;
+ case current_group_level_code:
+ cur_val = cur_level - level_one;
+ cur_val_level = int_val_level;
+ break;
+ case current_group_type_code:
+ cur_val = cur_group;
+ cur_val_level = int_val_level;
+ break;
+ case current_if_level_code:
+ {
+ halfword q = lmt_condition_state.cond_ptr;
+ cur_val = 0;
+ while (q) {
+ ++cur_val;
+ q = node_next(q);
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case current_if_type_code:
+ {
+ /*tex
+ We have more conditions than standard \TEX\ and \ETEX\ and the order is also somewhat
+ different. One problem is that in \ETEX\ a zero means \quotation {not in an test}, so
+ we're one off! Not that it matters much as this feature is probably never really used,
+ but we kept if for compatibility reasons. But it's gone now ... as ususl with some
+ sentiment as it was nicely abstracted cleaned up code.
+ */
+ cur_val = lmt_condition_state.cond_ptr ? (lmt_condition_state.cur_if - first_real_if_test_code) : -1;
+ cur_val_level = int_val_level;
+ break;
+ }
+ case current_if_branch_code:
+ {
+ switch (lmt_condition_state.if_limit) {
+ case if_code:
+ cur_val = 0;
+ break;
+ case fi_code:
+ cur_val = -1;
+ break;
+ case else_code:
+ case or_code:
+ cur_val = 1;
+ break;
+ default:
+ cur_val = 0;
+ break;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case glue_stretch_order_code:
+ case glue_shrink_order_code:
+ {
+ /*TeX
+ Not that we need it but \LUATEX\ now has |\eTeXglue..order|. In \CONTEXT\ we're
+ not using the internal codes anyway (or symbolic constants). In \LUATEX\ there
+ is some \ETEX\ related shifting but we don't do that here.
+ */
+ halfword q = tex_scan_glue(glue_val_level, 0);
+ cur_val = (code == glue_stretch_order_code) ? glue_stretch_order(q) : glue_shrink_order(q);
+ tex_flush_node(q);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case font_id_code:
+ {
+ cur_val = tex_scan_font_identifier(NULL);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case glyph_x_scaled_code:
+ {
+ cur_val = tex_font_x_scaled(tex_scan_dimen(0, 0, 0, 1, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case glyph_y_scaled_code:
+ {
+ cur_val = tex_font_y_scaled(tex_scan_dimen(0, 0, 0, 1, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case font_spec_id_code:
+ case font_spec_scale_code:
+ case font_spec_xscale_code:
+ case font_spec_yscale_code:
+ {
+ halfword fs = tex_scan_fontspec_identifier();
+ if (fs) {
+ switch (code) {
+ case font_spec_id_code:
+ cur_val = font_spec_identifier(fs);
+ break;
+ case font_spec_scale_code:
+ cur_val = font_spec_scale(fs);
+ break;
+ case font_spec_xscale_code:
+ cur_val = font_spec_x_scale(fs);
+ break;
+ case font_spec_yscale_code:
+ cur_val = font_spec_y_scale(fs);
+ break;
+ }
+ } else {
+ cur_val = 0;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case font_char_wd_code:
+ case font_char_ht_code:
+ case font_char_dp_code:
+ case font_char_ic_code:
+ case font_char_ta_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ if (tex_char_exists(fnt, chr)) {
+ switch (code) {
+ case font_char_wd_code:
+ cur_val = tex_char_width_from_font(fnt, chr);
+ break;
+ case font_char_ht_code:
+ cur_val = tex_char_height_from_font(fnt, chr);
+ break;
+ case font_char_dp_code:
+ cur_val = tex_char_depth_from_font(fnt, chr);
+ break;
+ case font_char_ic_code:
+ cur_val = tex_char_italic_from_font(fnt, chr);
+ break;
+ case font_char_ta_code:
+ cur_val = tex_char_top_anchor_from_font(fnt, chr);
+ break;
+ }
+ } else {
+ cur_val = 0;
+ }
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case font_size_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ cur_val = font_size(fnt);
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case font_math_control_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ cur_val = font_mathcontrol(fnt);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case font_text_control_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ cur_val = font_textcontrol(fnt);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_scale_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ if (tex_is_valid_font(fnt)) {
+ cur_val = tex_get_math_font_scale(fnt, tex_math_style_to_size(tex_current_math_style()));
+ } else {
+ cur_val = 1000;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_style_code:
+ {
+ cur_val = tex_current_math_style();
+ if (cur_val < 0) {
+ cur_val = text_style;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_main_style_code:
+ {
+ cur_val = tex_current_math_main_style();
+ if (cur_val < 0) {
+ cur_val = text_style;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_style_font_id_code:
+ {
+ halfword style = tex_scan_math_style_identifier(0, 0);
+ halfword family = tex_scan_math_family_number();
+ cur_val = tex_fam_fnt(family, tex_size_of_style(style));
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_stack_style_code:
+ {
+ cur_val = tex_math_style_variant(cur_list.math_style, math_parameter_stack_variant);
+ if (cur_val < 0) {
+ cur_val = text_style;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_char_class_code:
+ case math_char_fam_code:
+ case math_char_slot_code:
+ /* we actually need two commands or we need to look ahead */
+ {
+ mathcodeval mval = { 0, 0, 0 };
+ mathdictval dval = { 0, 0, 0 };
+ if (tex_scan_math_cmd_val(&mval, &dval)) {
+ switch (code) {
+ case math_char_class_code:
+ cur_val = mval.class_value;
+ break;
+ case math_char_fam_code:
+ cur_val = mval.family_value;
+ break;
+ case math_char_slot_code:
+ cur_val = mval.character_value;
+ break;
+ default:
+ cur_val = 0;
+ break;
+ }
+ } else {
+ cur_val = 0;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case scaled_slant_per_point_code:
+ case scaled_interword_space_code:
+ case scaled_interword_stretch_code:
+ case scaled_interword_shrink_code:
+ case scaled_ex_height_code:
+ case scaled_em_width_code:
+ case scaled_extra_space_code:
+ {
+ cur_val = tex_get_scaled_parameter(cur_font_par, (code - scaled_slant_per_point_code + 1));
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case last_arguments_code:
+ {
+ cur_val = lmt_expand_state.arguments;
+ cur_val_level = int_val_level;
+ break;
+ }
+ case parameter_count_code:
+ {
+ cur_val = tex_get_parameter_count();
+ cur_val_level = int_val_level;
+ break;
+ }
+ /*
+ case lua_value_function_code:
+ {
+ halfword v = scan_int(0, NULL);
+ if (v <= 0) {
+ normal_error("luafunction", "invalid number");
+ } else {
+ set_cur_val_by_lua_value_cmd(code);
+ }
+ return 1;
+ }
+ */
+ case insert_progress_code:
+ {
+ cur_val = tex_get_insert_progress(tex_scan_int(0, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case left_margin_kern_code:
+ case right_margin_kern_code:
+ {
+ halfword v = tex_scan_int(0, NULL);
+ halfword b = box_register(v);
+ if (b && (node_type(b) == hlist_node)) {
+ if (code == left_margin_kern_code) {
+ cur_val = tex_left_marginkern(box_list(b));
+ } else {
+ cur_val = tex_right_marginkern(box_list(b));
+ }
+ } else {
+ tex_normal_error("marginkern", "a hbox expected");
+ cur_val = 0;
+ }
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case par_shape_length_code:
+ case par_shape_indent_code:
+ case par_shape_dimen_code:
+ {
+ halfword q = code - par_shape_length_code;
+ halfword v = tex_scan_int(0, NULL);
+ if (v <= 0 || ! par_shape_par) {
+ v = 0;
+ } else {
+ int n = specification_count(par_shape_par);
+ if (q == 2) {
+ q = v % 2;
+ v = (v + q) / 2;
+ }
+ if (v > n) {
+ v = n;
+ }
+ if (n == 0) {
+ v = 0;
+ } else if (q) {
+ v = tex_get_specification_indent(par_shape_par, v);
+ } else {
+ v = tex_get_specification_width(par_shape_par, v);
+ }
+ }
+ cur_val = v;
+ cur_val_level = dimen_val_level; /* hm, also for length ? */
+ break;
+ }
+ case glue_stretch_code:
+ case glue_shrink_code:
+ {
+ halfword q = tex_scan_glue(glue_val_level, 0);
+ cur_val = code == glue_stretch_code ? glue_stretch(q) : glue_shrink(q);
+ tex_flush_node(q);
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case mu_to_glue_code:
+ cur_val = tex_scan_glue(mu_val_level, 0);
+ cur_val_level = glue_val_level;
+ return 1;
+ case glue_to_mu_code:
+ cur_val = tex_scan_glue(glue_val_level, 0);
+ cur_val_level = mu_val_level;
+ return 1;
+ case numexpr_code:
+ /* case attrexpr_code: */
+ tex_aux_scan_expr(int_val_level);
+ return 1;
+ case dimexpr_code:
+ tex_aux_scan_expr(dimen_val_level);
+ return 1;
+ case glueexpr_code:
+ tex_aux_scan_expr(glue_val_level);
+ return 1;
+ case muexpr_code:
+ tex_aux_scan_expr(mu_val_level);
+ return 1;
+ case numexpression_code:
+ tex_aux_scan_expression(int_val_level);
+ return 1;
+ case dimexpression_code:
+ tex_aux_scan_expression(dimen_val_level);
+ return 1;
+ // case dimen_to_scale_code:
+ // cur_val_level = int_val_level;
+ // cur_val = round_xn_over_d(100, scan_dimen(0, 0, 0, 0, NULL), 65536);
+ // return 1;
+ case numeric_scale_code:
+ cur_val_level = int_val_level;
+ cur_val = tex_scan_scale(0);
+ return 1;
+ case index_of_register_code:
+ cur_val = tex_aux_scan_register_index();
+ cur_val_level = int_val_level;
+ return 1;
+ case index_of_character_code:
+ cur_val = tex_aux_scan_character_index();
+ cur_val_level = int_val_level;
+ return 1;
+ case last_chk_num_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_condition_state.chk_num;
+ return 1;
+ case last_chk_dim_code:
+ cur_val_level = dimen_val_level;
+ cur_val = lmt_condition_state.chk_dim;
+ return 1;
+ case last_left_class_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_math_state.last_left;
+ if (! valid_math_class_code(cur_val)) {
+ cur_val = unset_noad_class;
+ }
+ return 1;
+ case last_right_class_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_math_state.last_right;
+ if (! valid_math_class_code(cur_val)) {
+ cur_val = unset_noad_class;
+ }
+ return 1;
+ case last_atom_class_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_math_state.last_atom;
+ if (! valid_math_class_code(cur_val)) {
+ cur_val = unset_noad_class;
+ }
+ return 1;
+ case current_loop_iterator_code:
+ case last_loop_iterator_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_main_control_state.loop_iterator;
+ return 1;
+ case current_loop_nesting_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_main_control_state.loop_nesting;
+ return 1;
+ case last_par_context_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_main_control_state.last_par_context;
+ return 1;
+ case last_page_extra_code:
+ cur_val_level = int_val_level;
+ cur_val = lmt_page_builder_state.last_extra_used;
+ return 1;
+ case math_atom_glue_code:
+ {
+ halfword style = tex_scan_math_style_identifier(0, 0);
+ halfword leftclass = tex_scan_math_class_number(0);
+ halfword rightclass = tex_scan_math_class_number(0);
+ cur_val = tex_math_spacing_glue(leftclass, rightclass, style);
+ cur_val_level = mu_val_level;
+ break;
+ }
+ }
+ return 0;
+}
+
+static void tex_aux_set_cur_val_by_auxiliary_cmd(int chr)
+{
+ halfword mode = abs(cur_list.mode);
+ switch (chr) {
+ case space_factor_code:
+ if (mode == hmode) {
+ cur_val = cur_list.space_factor;
+ } else {
+ tex_handle_error(normal_error_type, "Improper %C", set_auxiliary_cmd, chr,
+ "You can refer to \\spacefactor only in horizontal mode and not in \n"
+ "inside \\write. So I'm forgetting what you said and using zero instead."
+ );
+ cur_val = 0;
+ }
+ cur_val_level = int_val_level;
+ break;
+ case prev_depth_code:
+ if (mode == vmode) {
+ cur_val = cur_list.prev_depth;
+ } else {
+ tex_handle_error(normal_error_type, "Improper %C", set_auxiliary_cmd, chr,
+ "You can refer to \\prevdepth only in horizontal mode and not in \n"
+ "inside \\write. So I'm forgetting what you said and using zero instead."
+ );
+ cur_val = 0;
+ }
+ cur_val_level = dimen_val_level;
+ break;
+ case prev_graf_code:
+ if (mode == nomode) {
+ /*tex So |prev_graf=0| within |\write|, not that we have that. */
+ cur_val = 0;
+ } else {
+ cur_val = lmt_nest_state.nest[tex_vmode_nest_index()].prev_graf;
+ }
+ cur_val_level = int_val_level;
+ break;
+ case interaction_mode_code:
+ cur_val = lmt_error_state.interaction;
+ cur_val_level = int_val_level;
+ break;
+ case insert_mode_code:
+ cur_val = lmt_insert_state.mode;
+ cur_val_level = int_val_level;
+ break;
+ }
+}
+
+static void tex_aux_set_cur_val_by_specification_cmd(int chr)
+{
+ if (chr == internal_specification_location(par_shape_code)) {
+ cur_val = (par_shape_par) ? specification_count(par_shape_par) : 0;
+ } else {
+ halfword v = tex_scan_int(0, NULL); /* hm */
+ halfword e = eq_value(chr);
+ if ((! e) || (v < 0)) {
+ cur_val = 0;
+ } else {
+ cur_val = tex_get_specification_penalty(e, v > specification_count(e) ? specification_count(e) : v);
+ }
+ }
+ cur_val_level = int_val_level;
+}
+
+# define page_state_okay (lmt_page_builder_state.contents == contribute_nothing && ! lmt_page_builder_state.output_active)
+
+static void tex_aux_set_cur_val_by_page_property_cmd(int chr)
+{
+ switch (chr) {
+ case page_goal_code:
+ cur_val = page_state_okay ? max_dimen : lmt_page_builder_state.goal;
+ cur_val_level = dimen_val_level;
+ break;
+ case page_vsize_code:
+ cur_val = page_state_okay ? 0 : lmt_page_builder_state.vsize;
+ cur_val_level = dimen_val_level;
+ break;
+ case page_total_code:
+ cur_val = page_state_okay ? 0 : lmt_page_builder_state.total;
+ cur_val_level = dimen_val_level;
+ break;
+ case page_depth_code:
+ cur_val = page_state_okay ? 0 : lmt_page_builder_state.depth;
+ cur_val_level = dimen_val_level;
+ break;
+ case dead_cycles_code:
+ cur_val = lmt_page_builder_state.dead_cycles;
+ cur_val_level = int_val_level;
+ break;
+ case insert_penalties_code:
+ cur_val = lmt_page_builder_state.insert_penalties;
+ cur_val_level = int_val_level;
+ break;
+ case insert_heights_code:
+ cur_val = lmt_page_builder_state.insert_heights;
+ cur_val_level = dimen_val_level;
+ break;
+ case insert_storing_code:
+ cur_val = lmt_insert_state.storing;
+ cur_val_level = int_val_level;
+ break;
+ case insert_distance_code:
+ cur_val = tex_get_insert_distance(tex_scan_int(0, NULL));
+ cur_val_level = glue_val_level;
+ break;
+ case insert_multiplier_code:
+ cur_val = tex_get_insert_multiplier(tex_scan_int(0, NULL));
+ cur_val_level = int_val_level;
+ break;
+ case insert_limit_code:
+ cur_val = tex_get_insert_limit(tex_scan_int(0, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ case insert_storage_code:
+ cur_val = tex_get_insert_storage(tex_scan_int(0, NULL));
+ cur_val_level = int_val_level;
+ break;
+ case insert_penalty_code:
+ cur_val = tex_get_insert_penalty(tex_scan_int(0, NULL));
+ cur_val_level = int_val_level;
+ break;
+ case insert_maxdepth_code:
+ cur_val = tex_get_insert_maxdepth(tex_scan_int(0, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ case insert_height_code:
+ cur_val = tex_get_insert_height(tex_scan_int(0, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ case insert_depth_code:
+ cur_val = tex_get_insert_depth(tex_scan_int(0, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ case insert_width_code:
+ cur_val = tex_get_insert_width(tex_scan_int(0, NULL));
+ cur_val_level = dimen_val_level;
+ break;
+ default:
+ cur_val = page_state_okay ? 0 : lmt_page_builder_state.page_so_far[page_state_offset(chr)];
+ cur_val_level = dimen_val_level;
+ break;
+ }
+}
+
+static void tex_aux_set_cur_val_by_define_char_cmd(int chr)
+{
+ halfword index = tex_scan_char_number(0);
+ switch (chr) {
+ case catcode_charcode:
+ chr = tex_get_cat_code(cat_code_table_par, index);
+ break;
+ case lccode_charcode:
+ chr = tex_get_lc_code(index);
+ break;
+ case uccode_charcode:
+ chr = tex_get_uc_code(index);
+ break;
+ case sfcode_charcode:
+ chr = tex_get_sf_code(index);
+ break;
+ case hccode_charcode:
+ chr = tex_get_hc_code(index);
+ break;
+ case hmcode_charcode:
+ chr = tex_get_hm_code(index);
+ break;
+ case mathcode_charcode:
+ case extmathcode_charcode:
+ /* case extmathcodenum_charcode: */
+ chr = tex_get_math_code_number(index);
+ break;
+ case delcode_charcode:
+ case extdelcode_charcode:
+ /* case extdelcodenum_charcode: */
+ chr = tex_get_del_code_number(index);
+ break;
+ default:
+ tex_confusion("scan char");
+ break;
+ }
+ cur_val = chr;
+ cur_val_level = int_val_level;
+}
+
+/*
+ First, here is a short routine that is called from lua code. All the real work is delegated to
+ |short_scan_something_internal| that is shared between this routine and |scan_something_internal|.
+ In the end it was much cleaner to integrate |tex_aux_short_scan_something_internal| into the two
+ switches.
+*/
+
+void tex_scan_something_simple(halfword cmd, halfword chr)
+{
+ int succeeded = 1;
+ switch (cmd) {
+ /* begin of tex_aux_short_scan_something_internal */
+ case char_given_cmd:
+ // case math_char_given_cmd:
+ // case math_char_xgiven_cmd:
+ cur_val = chr;
+ cur_val_level = int_val_level;
+ break;
+
+case mathspec_cmd:
+ cur_val = (chr && node_subtype(chr) == tex_mathcode) ? math_spec_value(chr) : 0;
+ cur_val_level = int_val_level;
+ break;
+
+
+ case iterator_value_cmd:
+ cur_val = chr > 0x100000 ? - (chr - 0x100000) : chr;
+ cur_val_level = int_val_level;
+ break;
+ case some_item_cmd:
+ {
+ /*tex
+ Because the items in this case directly refer to |cur_chr|, it needs to be saved
+ and restored.
+ */
+ int save_cur_chr = cur_chr;
+ cur_chr = chr;
+ if (tex_aux_set_cur_val_by_some_cmd(chr)) {
+ succeeded = 2;
+ } else {
+ cur_chr = save_cur_chr;
+ }
+ break;
+ }
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = tok_val_level;
+ break;
+ case internal_int_cmd:
+ case register_int_cmd:
+ case internal_attribute_cmd:
+ case register_attribute_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = int_val_level;
+ break;
+ case internal_dimen_cmd:
+ case register_dimen_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = dimen_val_level;
+ break;
+ case internal_glue_cmd:
+ case register_glue_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = glue_val_level;
+ break;
+ case internal_mu_glue_cmd:
+ case register_mu_glue_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = mu_val_level;
+ break;
+ case lua_value_cmd:
+ tex_aux_set_cur_val_by_lua_value_cmd(chr, 0);
+ if (cur_val_level == no_val_level) {
+ return;
+ } else {
+ break;
+ }
+ case math_style_cmd:
+ cur_val = (chr == yet_unset_math_style) ? tex_scan_math_style_identifier(0, 0) : chr;
+ cur_val_level = int_val_level;
+ break;
+ case set_auxiliary_cmd:
+ tex_aux_set_cur_val_by_auxiliary_cmd(chr);
+ break;
+ case set_page_property_cmd:
+ tex_aux_set_cur_val_by_page_property_cmd(chr);
+ break;
+ case set_specification_cmd:
+ tex_aux_set_cur_val_by_specification_cmd(chr);
+ break;
+ /* end of tex_aux_short_scan_something_internal */
+ default:
+ tex_handle_error(
+ normal_error_type,
+ "You can't use '%C' as tex library index",
+ cmd, chr,
+ "I'm forgetting what you said and using zero instead."
+ );
+ cur_val = 0;
+ cur_val_level = int_val_level;
+ break;
+ }
+ tex_aux_downgrade_cur_val(cur_val_level, succeeded, 0);
+}
+
+/*tex
+
+ OK, we're ready for |scan_something_internal| itself. A second parameter, |negative|, is set
+ |true| if the value that is found should be negated. It is assumed that |cur_cmd| and |cur_chr|
+ represent the first token of the internal quantity to be scanned; an error will be signalled if
+ |cur_cmd < min_internal| or |cur_cmd > max_internal|.
+
+*/
+
+/*tex Fetch an internal parameter: */
+
+static void tex_aux_missing_number_error(void)
+{
+ tex_handle_error(
+ back_error_type,
+ "Missing number, treated as zero",
+ "A number should have been here; I inserted '0'. (If you can't figure out why I\n"
+ "needed to see a number, look up 'weird error' in the index to The TeXbook.)"
+ );
+}
+
+/* todo: get rid of cur_val */
+
+static int tex_aux_valid_tok_level(halfword level)
+{
+ if (level == tok_val_level) {
+ return 1;
+ } else {
+ if (lmt_error_state.intercept) {
+ lmt_error_state.last_intercept = 1 ;
+ } else {
+ tex_aux_missing_number_error();
+ }
+ cur_val = 0;
+ cur_val_level = dimen_val_level; /* why dimen */
+ return 0;
+ }
+}
+
+static int tex_aux_scan_hyph_data_number(halfword code, halfword *target)
+{
+ switch (code) {
+ case prehyphenchar_code:
+ *target = tex_get_pre_hyphen_char(language_par);
+ break;
+ case posthyphenchar_code:
+ *target = tex_get_post_hyphen_char(language_par);
+ break;
+ case preexhyphenchar_code:
+ *target = tex_get_pre_exhyphen_char(language_par);
+ break;
+ case postexhyphenchar_code:
+ *target = tex_get_post_exhyphen_char(language_par);
+ break;
+ case hyphenationmin_code:
+ *target = tex_get_hyphenation_min(language_par);
+ break;
+ case hjcode_code:
+ *target = tex_get_hj_code(language_par, tex_scan_int(0, NULL));
+ break;
+ default:
+ return 0;
+ }
+ return 1;
+}
+
+static halfword tex_aux_scan_something_internal(halfword cmd, halfword chr, int level, int negative, halfword property)
+{
+
+ int succeeded = 1;
+ switch (cmd) {
+ /* begin of tex_aux_short_scan_something_internal */
+ case char_given_cmd:
+ // case math_char_given_cmd:
+ // case math_char_xgiven_cmd:
+ cur_val = chr;
+ cur_val_level = int_val_level;
+ break;
+ case some_item_cmd:
+ {
+ /*tex
+ Because the items in this case directly refer to |cur_chr|, it needs to be saved
+ and restored.
+ */
+ int save_cur_chr = cur_chr;
+ cur_chr = chr;
+ if (tex_aux_set_cur_val_by_some_cmd(chr)) {
+ succeeded = 2;
+ } else {
+ cur_chr = save_cur_chr;
+ }
+ break;
+ }
+ case internal_toks_cmd:
+ case register_toks_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = tok_val_level;
+ break;
+ case internal_int_cmd:
+ case register_int_cmd:
+ case internal_attribute_cmd:
+ case register_attribute_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = int_val_level;
+ break;
+ case internal_dimen_cmd:
+ case register_dimen_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = dimen_val_level;
+ break;
+ case internal_glue_cmd:
+ case register_glue_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = glue_val_level;
+ break;
+ case internal_mu_glue_cmd:
+ case register_mu_glue_cmd:
+ cur_val = eq_value(chr);
+ cur_val_level = mu_val_level;
+ break;
+ case lua_value_cmd:
+ tex_aux_set_cur_val_by_lua_value_cmd(chr, property);
+ if (cur_val_level == no_val_level) {
+ return 0;
+ }
+ break;
+ case iterator_value_cmd:
+ cur_val = chr > 0x100000 ? - (chr - 0x100000) : chr;
+ cur_val_level = int_val_level;
+ break;
+ case math_style_cmd:
+ cur_val = (chr == yet_unset_math_style) ? tex_scan_math_style_identifier(0, 0) : chr;
+ cur_val_level = int_val_level;
+ break;
+ case set_auxiliary_cmd:
+ tex_aux_set_cur_val_by_auxiliary_cmd(chr);
+ break;
+ case set_page_property_cmd:
+ tex_aux_set_cur_val_by_page_property_cmd(chr);
+ break;
+ case set_specification_cmd:
+ tex_aux_set_cur_val_by_specification_cmd(chr);
+ break;
+ case define_char_code_cmd:
+ tex_aux_set_cur_val_by_define_char_cmd(chr);
+ break;
+ /* end of tex_aux_short_scan_something_internal */
+ case define_font_cmd:
+ if (tex_aux_valid_tok_level(level)) {
+ cur_val = cur_font_par;
+ cur_val_level = font_val_level;
+ return cur_val;
+ } else {
+ break;
+ }
+ case set_font_cmd:
+ if (tex_aux_valid_tok_level(level)) {
+ cur_val = cur_chr;
+ cur_val_level = font_val_level;
+ /* set_font_touched(cur_chr, 1); */
+ return cur_val;
+ } else {
+ break;
+ }
+ case define_family_cmd:
+ /*tex Fetch a math font identifier. */
+ {
+ halfword fam = tex_scan_math_family_number();
+ cur_val = tex_fam_fnt(fam, chr);
+ cur_val_level = font_val_level;
+ return cur_val;
+ }
+ case set_math_parameter_cmd:
+ {
+ switch (chr) {
+ case math_parameter_reset_spacing:
+ case math_parameter_set_spacing:
+ case math_parameter_let_spacing:
+ case math_parameter_copy_spacing:
+ {
+ halfword left = tex_scan_math_class_number(0);
+ halfword right = tex_scan_math_class_number(0);
+ halfword style = tex_scan_math_style_identifier(0, 0);
+ halfword node = tex_math_spacing_glue(left, right, style);
+ cur_val = node ? node : zero_glue;
+ cur_val_level = mu_val_level;
+ break;
+ }
+ case math_parameter_set_atom_rule:
+ case math_parameter_let_atom_rule:
+ case math_parameter_copy_atom_rule:
+ case math_parameter_let_parent:
+ case math_parameter_copy_parent:
+ case math_parameter_set_defaults:
+ {
+ // cur_val = 0;
+ // cur_val_level = int_val_level;
+ break;
+ }
+ case math_parameter_set_pre_penalty:
+ case math_parameter_set_post_penalty:
+ case math_parameter_set_display_pre_penalty:
+ case math_parameter_set_display_post_penalty:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ if (valid_math_class_code(class)) {
+ switch (chr) {
+ case math_parameter_set_pre_penalty:
+ cur_val = count_parameter(first_math_pre_penalty_code + class);
+ break;
+ case math_parameter_set_post_penalty:
+ cur_val = count_parameter(first_math_post_penalty_code + class);
+ break;
+ case math_parameter_set_display_pre_penalty:
+ cur_val = count_parameter(first_math_display_pre_penalty_code + class);
+ break;
+ case math_parameter_set_display_post_penalty:
+ cur_val = count_parameter(first_math_display_post_penalty_code + class);
+ break;
+ }
+ } else {
+ cur_val = 0;
+ }
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_parameter_ignore:
+ {
+ halfword code = tex_scan_math_parameter();
+ cur_val = code >= 0 ? count_parameter(first_math_ignore_code + code) : 0;
+ cur_val_level = int_val_level;
+ break;
+ }
+ case math_parameter_options:
+ {
+ halfword class = tex_scan_math_class_number(0);
+ if (valid_math_class_code(class)) {
+ cur_val = count_parameter(first_math_options_code + class);
+ } else {
+ cur_val = 0;
+ }
+ break;
+ }
+ default:
+ {
+ cur_val = tex_scan_math_style_identifier(0, 0);
+ switch (math_parameter_value_type(chr)) {
+ case math_int_parameter:
+ cur_val_level = int_val_level;
+ break;
+ case math_dimen_parameter:
+ cur_val_level = dimen_val_level;
+ break;
+ case math_muglue_parameter:
+ cur_val_level = mu_val_level;
+ break;
+ case math_style_parameter:
+ cur_val_level = int_val_level;
+ break;
+ }
+ chr = tex_get_math_parameter(cur_val, chr, NULL);
+ if (cur_val_level == mu_val_level) {
+ switch (chr) {
+ case petty_mu_skip_code:
+ chr = petty_mu_skip_par;
+ break;
+ case tiny_mu_skip_code:
+ chr = tiny_mu_skip_par;
+ break;
+ case thin_mu_skip_code:
+ chr = thin_mu_skip_par;
+ break;
+ case med_mu_skip_code:
+ chr = med_mu_skip_par;
+ break;
+ case thick_mu_skip_code:
+ chr = thick_mu_skip_par;
+ break;
+ }
+ }
+ cur_val = chr;
+ break;
+ }
+ }
+ }
+ break;
+ case set_box_property_cmd:
+ {
+ /*tex We hike on the dimen_cmd but some are integers. */
+ halfword n = tex_scan_box_register_number();
+ halfword b = box_register(n);
+ switch (chr) {
+ case box_width_code:
+ cur_val = b ? box_width(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_height_code:
+ cur_val = b ? box_height(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_depth_code:
+ cur_val = b ? box_depth(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_direction_code:
+ cur_val = b ? box_dir(b) : 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_geometry_code:
+ cur_val = b ? box_geometry(b) : 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_orientation_code:
+ cur_val = b ? box_orientation(b) : 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_anchor_code:
+ case box_anchors_code:
+ cur_val = b ? box_anchor(b) : 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_source_code:
+ cur_val = b ? box_source_anchor(b) : 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_target_code:
+ cur_val = b ? box_target_anchor(b) : 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_xoffset_code:
+ cur_val = b ? box_x_offset(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_yoffset_code:
+ cur_val = b ? box_y_offset(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_xmove_code:
+ cur_val = b ? (box_width(b) - box_x_offset(b)) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_ymove_code:
+ cur_val = b ? (box_total(b) - box_y_offset(b)) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_total_code:
+ cur_val = b ? box_total(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_shift_code:
+ cur_val = b ? box_shift_amount(b) : 0;
+ cur_val_level = dimen_val_level;
+ break;
+ case box_adapt_code:
+ cur_val = 0;
+ cur_val_level = int_val_level;
+ break;
+ case box_repack_code:
+ if (node_type(b) == hlist_node) {
+ cur_val = box_list(b) ? tex_natural_hsize(box_list(b), NULL) : 0;
+ } else {
+ cur_val = box_list(b) ? tex_natural_vsize(box_list(b)) : 0;
+ }
+ cur_val_level = dimen_val_level;
+ break;
+ case box_freeze_code:
+ cur_val = node_type(b) == hlist_node ? box_width(b) : box_total(b);
+ cur_val_level = dimen_val_level;
+ break;
+ case box_attribute_code:
+ {
+ halfword att = tex_scan_attribute_register_number();
+ cur_val = b ? tex_has_attribute(b, att, unused_attribute_value) : unused_attribute_value;
+ cur_val_level = int_val_level;
+ break;
+ }
+ }
+ break;
+ }
+ case set_font_property_cmd:
+ /*tex Fetch a font integer or dimension. */
+ {
+ switch (chr) {
+ case font_hyphen_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ cur_val = font_hyphen_char(fnt);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case font_skew_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ cur_val = font_skew_char(fnt);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case font_lp_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ cur_val = tex_char_lp_from_font(fnt, chr);
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case font_rp_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ cur_val = tex_char_rp_from_font(fnt, chr);
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case font_ef_code:
+ {
+ halfword fnt = tex_scan_font_identifier(NULL);
+ halfword chr = tex_scan_char_number(0);
+ cur_val = tex_char_ef_from_font(fnt, chr);
+ cur_val_level = int_val_level;
+ break;
+ }
+ case font_dimen_code:
+ {
+ cur_val = tex_get_font_dimen();
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ case scaled_font_dimen_code:
+ {
+ cur_val = tex_get_scaled_font_dimen();
+ cur_val_level = dimen_val_level;
+ break;
+ }
+ }
+ break;
+ }
+ case register_cmd:
+ /*tex Fetch a register */
+ {
+ switch (chr) {
+ case int_val_level:
+ {
+ halfword n = tex_scan_int_register_number();
+ cur_val = count_register(n);
+ break;
+ }
+ case attr_val_level:
+ {
+ halfword n = tex_scan_attribute_register_number();
+ cur_val = attribute_register(n);
+ break;
+ }
+ case dimen_val_level:
+ {
+ scaled n = tex_scan_dimen_register_number();
+ cur_val = dimen_register(n);
+ break;
+ }
+ case glue_val_level:
+ {
+ halfword n = tex_scan_glue_register_number();
+ cur_val = skip_register(n);
+ break;
+ }
+ case mu_val_level:
+ {
+ halfword n = tex_scan_mu_glue_register_number();
+ cur_val = mu_skip_register(n);
+ break;
+ }
+ case tok_val_level:
+ {
+ halfword n = tex_scan_toks_register_number();
+ cur_val = toks_register(n);
+ break;
+ }
+ }
+ cur_val_level = chr;
+ break;
+ }
+ case ignore_something_cmd:
+ break;
+ case hyphenation_cmd:
+ if (tex_aux_scan_hyph_data_number(chr, &cur_val)) {
+ cur_val_level = int_val_level;
+ break;
+ } else {
+ goto DEFAULT;
+ }
+ case integer_cmd:
+ cur_val = chr;
+ cur_val_level = int_val_level;
+ break;
+ case dimension_cmd:
+ cur_val = chr;
+ cur_val_level = dimen_val_level;
+ break;
+ case gluespec_cmd:
+ cur_val = chr;
+ cur_val_level = glue_val_level;
+ break;
+ case mugluespec_cmd:
+ cur_val = chr;
+ cur_val_level = mu_val_level;
+ break;
+ case mathspec_cmd:
+ cur_val = chr;
+ if (chr) {
+ switch (node_subtype(chr)) {
+ case tex_mathcode:
+ cur_val = math_spec_value(chr);
+ cur_val_level = int_val_level;
+ break;
+ case umath_mathcode:
+ /* case umathnum_mathcode: */
+ case mathspec_mathcode:
+ cur_val_level = mathspec_val_level;
+ break;
+ default:
+ cur_val = 0;
+ cur_val_level = int_val_level;
+ break;
+ }
+ } else {
+ cur_val_level = int_val_level;
+ }
+ break;
+ case fontspec_cmd:
+ cur_val = tex_get_font_identifier(chr) ? chr : null;
+ cur_val_level = fontspec_val_level;
+ break;
+ case begin_paragraph_cmd:
+ switch (chr) {
+ case snapshot_par_code:
+ {
+ halfword par = tex_find_par_par(cur_list.head);
+ cur_val = par ? par_state(par) : 0;
+ cur_val_level = int_val_level;
+ break;
+ }
+ /* case attribute_par_code: */
+ case wrapup_par_code:
+ {
+ halfword par = tex_find_par_par(cur_list.head);
+ cur_val = par ? par_end_par_tokens(par) : null;
+ cur_val_level = tok_val_level;
+ break;
+ }
+ default:
+ goto DEFAULT;
+ }
+ break;
+ /*
+ case string_cmd:
+ {
+ halfword head = str_toks(str_lstring(cs_offset_value + chr), NULL);
+ begin_inserted_list(head);
+ cur_val = 0;
+ cur_val_level = no_val_level;
+ break;
+ }
+ */
+ /*
+ case special_box_cmd:
+ switch (chr) {
+ case left_box_code:
+ cur_val = cur_mode == hmode ? local_left_box_par : null;
+ cur_val_level = list_val_level;
+ return cur_val;
+ case right_box_code:
+ cur_val = cur_mode == hmode ? local_right_box_par : null;
+ cur_val_level = list_val_level;
+ return cur_val;
+ default:
+ goto DEFAULT;
+ }
+ break;
+ */
+ default:
+ DEFAULT:
+ /*tex Complain that |\the| can not do this; give zero result. */
+ tex_handle_error(
+ normal_error_type,
+ "You can't use '%C' after \\the",
+ cmd, chr,
+ "I'm forgetting what you said and using zero instead."
+ );
+ cur_val = 0;
+ cur_val_level = (level == tok_val_level) ? int_val_level : dimen_val_level;
+ break;
+ }
+ tex_aux_downgrade_cur_val(level, succeeded, negative);
+ return cur_val;
+}
+
+/*tex
+
+ It is nice to have routines that say what they do, so the original |scan_eight_bit_int| is
+ superceded by |scan_register_number| and |scan_mark_number|. It may become split up even further
+ in the future.
+
+ Many of the |restricted classes| routines are the essentially the same except for the upper
+ limit and the error message, so it makes sense to combine these all into one function.
+
+*/
+
+inline static halfword tex_aux_scan_limited_int(int optional_equal, int min, int max, const char *invalid)
+{
+ halfword v = tex_scan_int(optional_equal, NULL);
+ if (v < min || v > max) {
+ tex_handle_error(
+ normal_error_type,
+ "%s (%i) should be in the range %i..%i",
+ invalid, v, min, max,
+ "I'm going to use 0 instead of that illegal code value."
+ );
+ return 0;
+ } else {
+ return v;
+ }
+}
+
+halfword tex_scan_int_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_int_register_index, "Integer register index"); }
+halfword tex_scan_dimen_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_dimen_register_index, "Dimension register index"); }
+halfword tex_scan_attribute_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_attribute_register_index, "Attribute register index"); }
+halfword tex_scan_glue_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_glue_register_index, "Glue register index"); }
+halfword tex_scan_mu_glue_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_mu_glue_register_index, "Mu glue register index"); }
+halfword tex_scan_toks_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_toks_register_index, "Toks register index"); }
+halfword tex_scan_box_register_number (void) { return tex_aux_scan_limited_int(0, 0, max_box_register_index, "Box register index"); }
+halfword tex_scan_mark_number (void) { return tex_aux_scan_limited_int(0, 0, max_mark_index, "Marks index"); }
+halfword tex_scan_char_number (int optional_equal) { return tex_aux_scan_limited_int(optional_equal, 0, max_character_code, "Character code"); }
+halfword tex_scan_math_char_number (void) { return tex_aux_scan_limited_int(0, 0, max_math_character_code, "Character code"); }
+halfword tex_scan_math_family_number (void) { return tex_aux_scan_limited_int(0, 0, max_math_family_index, "Math family"); }
+halfword tex_scan_math_properties_number (void) { return tex_aux_scan_limited_int(0, 0, max_math_property, "Math properties"); }
+halfword tex_scan_math_group_number (void) { return tex_aux_scan_limited_int(0, 0, max_math_group, "Math group"); }
+halfword tex_scan_math_index_number (void) { return tex_aux_scan_limited_int(0, 0, max_math_index, "Math index"); }
+halfword tex_scan_math_discretionary_number (int optional_equal) { return tex_aux_scan_limited_int(optional_equal, 0, max_math_discretionary, "Math discretionary"); }
+singleword tex_scan_box_index (void) { return (singleword) tex_aux_scan_limited_int(0, 0, max_box_index, "Box index"); }
+singleword tex_scan_box_axis (void) { return (singleword) tex_aux_scan_limited_int(0, 0, max_box_axis, "Box axis"); }
+halfword tex_scan_category_code (void) { return tex_aux_scan_limited_int(0, 0, max_category_code,"Category code"); }
+halfword tex_scan_function_reference (int optional_equal) { return tex_aux_scan_limited_int(optional_equal, 0, max_function_reference, "Function reference"); }
+halfword tex_scan_bytecode_reference (int optional_equal) { return tex_aux_scan_limited_int(optional_equal, 0, max_bytecode_index, "Bytecode reference"); }
+halfword tex_scan_limited_scale (int optional_equal) { return tex_aux_scan_limited_int(optional_equal, -max_limited_scale, max_limited_scale, "Limited scale"); }
+halfword tex_scan_positive_scale (int optional_equal) { return tex_aux_scan_limited_int(optional_equal, min_limited_scale, max_limited_scale, "Limited scale"); }
+
+halfword tex_scan_math_class_number(int optional_equal)
+{
+ halfword v = tex_aux_scan_limited_int(optional_equal, -1, max_math_class_code + 1, "Math class");
+ if (v >= 0 && v <= max_math_class_code) {
+ return v;
+ } else {
+ return unset_noad_class;
+ }
+}
+
+/*tex
+
+ An integer number can be preceded by any number of spaces and |+| or |-| signs. Then comes
+ either a decimal constant (i.e., radix 10), an octal constant (i.e., radix 8, preceded by~|'|),
+ a hexadecimal constant (radix 16, preceded by~|"|), an alphabetic constant (preceded by~|`|),
+ or an internal variable. After scanning is complete, |cur_val| will contain the answer, which
+ must be at most $2^{31}-1=2147483647$ in absolute value. The value of |radix| is set to 10, 8,
+ or 16 in the cases of decimal, octal, or hexadecimal constants, otherwise |radix| is set to
+ zero. An optional space follows a constant.
+
+ The |scan_int| routine is used also to scan the integer part of a fraction; for example, the
+ |3| in |3.14159| will be found by |scan_int|. The |scan_dimen| routine assumes that |cur_tok
+ = point_token| after the integer part of such a fraction has been scanned by |scan_int|, and
+ that the decimal point has been backed up to be scanned again.
+
+*/
+
+static void tex_aux_number_to_big_error(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Number too big",
+ "I can only go up to 2147483647 = '17777777777 = \"7FFFFFFF, so I'm using that\n"
+ "number instead of yours."
+ );
+}
+
+static void tex_aux_improper_constant_error(void)
+{
+ tex_handle_error(
+ back_error_type,
+ "Improper alphabetic constant",
+ "A one-character control sequence belongs after a ` mark. So I'm essentially\n"
+ "inserting \\0 here."
+ );
+}
+
+/*tex
+
+ The next function is somewhat special. It is also called in other scanners and therefore
+ |cur_val| cannot simply be replaced. For that reason we do return the value but also set
+ |cur_val|, just in case. I might sort this out some day when other stuff has been reworked.
+
+ The routine has been optimnized a bit (equal scanning and such) and after a while I decided to
+ split the three cases. It makes for a bit nicer code.
+
+ If we backport the checking code to \LUATEX, a pre May 24 2020 copy has to be taken, because
+ that is closer to the original.
+
+*/
+
+halfword tex_scan_int(int optional_equal, int *radix)
+{
+ int negative = 0;
+ long long result = 0;
+ do {
+ while (1) {
+ tex_get_x_token();
+ if (cur_cmd != spacer_cmd) {
+ if (optional_equal && (cur_tok == equal_token)) {
+ optional_equal = 0;
+ } else {
+ break;
+ }
+ }
+ }
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ cur_tok = plus_token;
+ }
+ } while (cur_tok == plus_token);
+ if (cur_tok == alpha_token) {
+ /*tex
+ Scan an alphabetic character code into |result|. A space is ignored after an alphabetic
+ character constant, so that such constants behave like numeric ones. We don't expand the
+ next token!
+ */
+ tex_get_token();
+ if (cur_tok < cs_token_flag) {
+ result = cur_chr;
+ if (cur_cmd == right_brace_cmd) {
+ ++lmt_input_state.align_state;
+ // } else if (cur_cmd < right_brace_cmd) {
+ } else if (cur_cmd == left_brace_cmd || cur_cmd == relax_cmd) {
+ /* left_brace_cmd or relax_cmd (really?)*/
+ --lmt_input_state.align_state;
+ }
+ } else {
+ /*tex
+ The value of a csname in this context is its name. A single letter case happens more
+ frequently than an active character but both seldom are ran into anyway.
+ */
+ strnumber txt = cs_text(cur_tok - cs_token_flag);
+ if (tex_single_letter(txt)) {
+ result = aux_str2uni(str_string(txt));
+ } else if (tex_is_active_cs(txt)) {
+ result = active_cs_value(txt);
+ } else {
+ result = max_character_code + 1;
+ }
+ }
+ if (result > max_character_code) {
+ if (lmt_error_state.intercept) {
+ lmt_error_state.last_intercept = 1 ;
+ tex_back_input(cur_tok);
+ } else {
+ result = '0'; /*tex Why not just 0. */
+ tex_aux_improper_constant_error();
+ }
+ } else {
+ /*tex Scan an optional space. */
+ tex_get_x_token();
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(cur_tok);
+ }
+ }
+ } else if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ result = tex_aux_scan_something_internal(cur_cmd, cur_chr, int_val_level, 0, 0);
+ if (cur_val_level != int_val_level) {
+ result = 0;
+ goto NONUMBER;
+ }
+ } else if (cur_cmd == math_style_cmd) {
+ /* A pity that we need to check this way in |scan_int|. */
+ result = (cur_chr == yet_unset_math_style) ? tex_scan_math_style_identifier(0, 0) : cur_chr;
+ } else if (cur_cmd == hyphenation_cmd) {
+ /* A pity that we need to check this way in |scan_int|. */
+ if (tex_aux_scan_hyph_data_number(cur_chr, &cur_chr)) {
+ result = cur_chr;
+ } else {
+ result = 0;
+ goto NONUMBER;
+ }
+ } else {
+ /*tex has an error message been issued? */
+ int vacuous = 1;
+ int ok_so_far = 1;
+ /*tex
+ Scan a numeric constant. The interwoven common loop has been split up now.
+ */
+ switch (cur_tok) {
+ case octal_token:
+ {
+ if (radix) {
+ *radix = 8;
+ }
+ while (1) {
+ tex_get_x_token();
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= seven_token)) {
+ d = cur_tok - zero_token;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ if (ok_so_far) {
+ result = result * 8 + d;
+ if (result > max_integer) {
+ result = infinity;
+ if (lmt_error_state.intercept) {
+ vacuous = 1;
+ goto DONE;
+ } else {
+ tex_aux_number_to_big_error();
+ }
+ ok_so_far = 0;
+ }
+ }
+ }
+ break;
+ }
+ case hex_token:
+ {
+ if (radix) {
+ *radix = 16;
+ }
+ while (1) {
+ tex_get_x_token();
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= nine_token)) {
+ d = cur_tok - zero_token;
+ } else if ((cur_tok >= A_token_l) && (cur_tok <= F_token_l)) {
+ d = cur_tok - A_token_l + 10;
+ } else if ((cur_tok >= A_token_o) && (cur_tok <= F_token_o)) {
+ d = cur_tok - A_token_o + 10;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ if (ok_so_far) {
+ result = result * 16 + d;
+ if (result > max_integer) {
+ result = infinity;
+ if (lmt_error_state.intercept) {
+ vacuous = 1;
+ goto DONE;
+ } else {
+ tex_aux_number_to_big_error();
+ }
+ ok_so_far = 0;
+ }
+ }
+ }
+ break;
+ }
+ default:
+ {
+ if (radix) {
+ *radix = 10;
+ }
+ while (1) {
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= nine_token)) {
+ d = cur_tok - zero_token;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ if (ok_so_far) {
+ result = result * 10 + d;
+ if (result > max_integer) {
+ result = infinity;
+ if (lmt_error_state.intercept) {
+ vacuous = 1;
+ goto DONE;
+ } else {
+ tex_aux_number_to_big_error();
+ }
+ ok_so_far = 0;
+ }
+ }
+ tex_get_x_token();
+ }
+ break;
+ }
+ }
+ DONE:
+ if (vacuous) {
+ NONUMBER:
+ /*tex Express astonishment that no number was here */
+ if (lmt_error_state.intercept) {
+ lmt_error_state.last_intercept = 1 ;
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(cur_tok);
+ }
+ } else {
+ tex_aux_missing_number_error();
+ }
+ } else {
+ tex_push_back(cur_tok, cur_cmd, cur_chr);
+ }
+ }
+ /*tex For now we still keep |cur_val| set too. */
+ cur_val = (halfword) (negative ? - result : result);
+ return cur_val;
+}
+
+int tex_scan_cardinal(unsigned *value, int dontbark)
+{
+ long long result = 0;
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ result = tex_aux_scan_something_internal(cur_cmd, cur_chr, int_val_level, 0, 0);
+ } else {
+ int vacuous = 1;
+ switch (cur_tok) {
+ case octal_token:
+ {
+ while (1) {
+ tex_get_x_token();
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= seven_token)) {
+ d = cur_tok - zero_token;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ result = result * 8 + d;
+ if (result > max_cardinal) {
+ result = max_cardinal;
+ }
+ }
+ break;
+ }
+ case hex_token:
+ {
+ while (1) {
+ tex_get_x_token();
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= nine_token)) {
+ d = cur_tok - zero_token;
+ } else if ((cur_tok >= A_token_l) && (cur_tok <= F_token_l)) {
+ d = cur_tok - A_token_l + 10;
+ } else if ((cur_tok >= A_token_o) && (cur_tok <= F_token_o)) {
+ d = cur_tok - A_token_o + 10;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ result = result * 16 + d;
+ if (result > max_cardinal) {
+ result = max_cardinal;
+ }
+ }
+ break;
+ }
+ default:
+ {
+ while (1) {
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= nine_token)) {
+ d = cur_tok - zero_token;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ result = result * 10 + d;
+ if (result > max_cardinal) {
+ result = max_cardinal;
+ }
+ tex_get_x_token();
+ }
+ break;
+ }
+ }
+ DONE:
+ if (vacuous) {
+ if (dontbark) {
+ return 0;
+ } else {
+ tex_aux_missing_number_error();
+ }
+ } else {
+ tex_push_back(cur_tok, cur_cmd, cur_chr);
+ }
+ }
+ *value = (unsigned) result;
+ cur_val = (halfword) result;
+ return 1;
+}
+
+/*tex
+
+ The following code is executed when |scan_something_internal| was called asking for |mu_val|,
+ when we really wanted a mudimen instead of muglue.
+
+*/
+
+static halfword tex_aux_coerced_glue(halfword value, halfword level)
+{
+ if (level == glue_val_level || level == mu_val_level) {
+ int v = glue_amount(value);
+ tex_flush_node(value);
+ return v;
+ } else {
+ return value;
+ }
+}
+
+/*tex
+
+ The |scan_dimen| routine is similar to |scan_int|, but it sets |cur_val| to a |scaled| value,
+ i.e., an integral number of sp. One of its main tasks is therefore to interpret the
+ abbreviations for various kinds of units and to convert measurements to scaled points.
+
+ There are three parameters: |mu| is |true| if the finite units must be |mu|, while |mu| is
+ |false| if |mu| units are disallowed; |inf| is |true| if the infinite units |fil|, |fill|,
+ |filll| are permitted; and |shortcut| is |true| if |cur_val| already contains an integer and
+ only the units need to be considered.
+
+ The order of infinity that was found in the case of infinite glue is returned in the global
+ variable |cur_order|.
+
+ Constructions like |-'77 pt| are legal dimensions, so |scan_dimen| may begin with |scan_int|.
+ This explains why it is convenient to use |scan_int| also for the integer part of a decimal
+ fraction.
+
+ Several branches of |scan_dimen| work with |cur_val| as an integer and with an auxiliary
+ fraction |f|, so that the actual quantity of interest is $|cur_val|+|f|/2^{16}$. At the end of
+ the routine, this \quote {unpacked} representation is put into the single word |cur_val|, which
+ suddenly switches significance from |integer| to |scaled|.
+
+ The necessary conversion factors can all be specified exactly as fractions whose numerator and
+ denominator add to 32768 or less. According to the definitions here, $\rm 2660 \, dd \approx
+ 1000.33297 \, mm$; this agrees well with the value $\rm 1000.333 \, mm$ cited by Hans Rudolf
+ Bosshard in {\em Technische Grundlagen zur Satzherstellung} (Bern, 1980). The Didot point has
+ been newly standardized in 1978; it's now exactly $\rm 1 \, nd = 0.375 \, mm$. Conversion uses
+ the equation $0.375 = 21681 / 20320 / 72.27 \cdot 25.4$. The new Cicero follows the new Didot
+ point; $\rm 1 \, nc = 12 \, nd$. These would lead to the ratios $21681 / 20320$ and $65043
+ / 5080$, respectively. The closest approximations supported by the algorithm would be $11183 /
+ 10481$ and $1370 / 107$. In order to maintain the relation $\rm 1 \, nc = 12 \, nd$, we pick
+ the ratio $685 / 642$ for $\rm nd$, however.
+
+*/
+
+static void tex_aux_scan_dimen_mu_error(void) {
+ tex_handle_error(
+ normal_error_type,
+ "Illegal unit of measure (mu inserted)",
+ "The unit of measurement in math glue must be mu." );
+
+}
+
+static void tex_aux_scan_dimen_fi_error(void) {
+ tex_handle_error(
+ normal_error_type,
+ "Illegal unit of measure",
+ "The unit of measurement can't be fi, fil, fill or filll here." );
+
+}
+
+static void tex_aux_scan_dimen_unknown_unit_error(void) {
+ tex_handle_error(
+ normal_error_type,
+ "Illegal unit of measure (pt inserted)",
+ "Dimensions can be in units of em, ex, in, pt, pc, cm, mm, dd, cc, bp, dk, or\n"
+ "sp; but yours is a new one! I'll assume that you meant to say pt, for printer's\n"
+ "points. two letters."
+ );
+}
+
+static void tex_aux_scan_dimen_out_of_range_error(void) {
+ tex_handle_error(
+ normal_error_type,
+ "Dimension too large",
+ "I can't work with sizes bigger than about 19 feet. Continue and I'll use the\n"
+ "largest value I can."
+ );
+}
+
+# define set_conversion(A,B) do { num=(A); denom=(B); } while(0)
+
+/*tex
+
+ This function sets |cur_val| to a dimension. We still have some |cur_val| sync issue so no
+ result replacement yet. (The older variant, also already optimzied can be found in the
+ history).
+
+ When order is |NULL| mu units and glue fills are not scanned.
+
+*/
+
+typedef enum scanned_unit {
+ no_unit_scanned, /* 0 : error */
+ normal_unit_scanned, /* 1 : cm mm pt bp dd cc in dk */
+ scaled_point_scanned, /* 2 : sp */
+ relative_unit_scanned, /* 3 : ex em px */
+ math_unit_scanned, /* 4 : mu */
+ flexible_unit_scanned, /* 5 : fi fil fill filll */
+ quantitity_unit_scanned, /* 6 : internal quantity */
+} scanned_unit;
+
+/*tex
+
+ We support the Knuthian Potrzebie cf.\ \url {https://en.wikipedia.org/wiki/Potrzebie} as the
+ |dk| unit. It was added on 2021-09-22 exactly when we crossed the season during an evening
+ session at the 15th \CONTEXT\ meeting in Bassenge (Boirs) Belgium. It took a few iterations to
+ find the best numerator and denominator, but Taco Hoekwater, Harald Koenig and Mikael Sundqvist
+ figured it out in this interactive session. The error messages have been adapted accordingly and
+ the scanner in the |tex| library also handles it. One |dk| is 6.43985pt. There is no need to
+ make \METAPOST\ aware of this unit because there it is just a numeric multiplier in a macro
+ package.
+
+ From Wikipedia:
+
+ In issue 33, Mad published a partial table of the \quotation {Potrzebie System of Weights and
+ Measures}, developed by 19-year-old Donald~E. Knuth, later a famed computer scientist. According
+ to Knuth, the basis of this new revolutionary system is the potrzebie, which equals the thickness
+ of Mad issue 26, or 2.2633484517438173216473 mm [...].
+
+*/
+
+static int tex_aux_scan_unit(halfword *num, halfword *denom, halfword *value, halfword *order)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ return quantitity_unit_scanned;
+ } else {
+ int chrone, chrtwo;
+ halfword tokone, toktwo;
+ halfword save_cur_cs = cur_cs;
+ tokone = cur_tok;
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ chrone = cur_chr;
+ } else {
+ goto BACK_ONE;
+ }
+ tex_get_x_token();
+ toktwo = cur_tok;
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ chrtwo = cur_chr;
+ } else {
+ goto BACK_TWO;
+ }
+ cur_cs = save_cur_cs;
+ AGAIN:
+ switch (chrone) {
+ case 'p': case 'P':
+ switch (chrtwo) {
+ case 't': case 'T':
+ return normal_unit_scanned;
+ case 'c': case 'C':
+ *num = 12;
+ *denom = 1;
+ return normal_unit_scanned;
+ case 'x': case 'X':
+ *value = px_dimen_par;
+ return relative_unit_scanned;
+ }
+ break;
+ case 'm': case 'M':
+ if (order) {
+ switch (chrtwo) {
+ case 'm': case 'M':
+ *num = 7227;
+ *denom = 2540;
+ return normal_unit_scanned;
+ case 'u': case 'U':
+ return math_unit_scanned;
+ }
+ }
+ break;
+ case 'c': case 'C':
+ switch (chrtwo) {
+ case 'm': case 'M':
+ *num = 7227;
+ *denom = 254;
+ return normal_unit_scanned;
+ case 'c': case 'C':
+ *num = 14856;
+ *denom = 1157;
+ return normal_unit_scanned;
+ }
+ break;
+ case 's': case 'S':
+ switch (chrtwo) {
+ case 'p': case 'P':
+ return scaled_point_scanned;
+ }
+ break;
+ case 'b': case 'B':
+ switch (chrtwo) {
+ case 'p': case 'P':
+ *num = 7227;
+ *denom = 7200;
+ return normal_unit_scanned;
+ }
+ break;
+ case 'i': case 'I':
+ switch (chrtwo) {
+ case 'n': case 'N':
+ *num = 7227;
+ *denom = 100;
+ return normal_unit_scanned;
+ }
+ break;
+ case 'd': case 'D':
+ switch (chrtwo) {
+ case 'd': case 'D':
+ *num = 1238;
+ *denom = 1157;
+ return normal_unit_scanned;
+ case 'k': case 'K': /* number: 422042 */
+ *num = 49838; // 152940;
+ *denom = 7739; // 23749;
+ return normal_unit_scanned;
+ }
+ break;
+ case 't': case 'T':
+ if (order) {
+ switch (chrtwo) {
+ case 'r': case 'R':
+ if (tex_scan_mandate_keyword("true", 2)) {
+ /*tex This is now a bogus prefix! */
+ goto AGAIN;
+ }
+ }
+ }
+ break;
+ case 'e': case 'E':
+ switch (chrtwo) {
+ case 'm': case 'M':
+ *value = tex_get_scaled_em_width(cur_font_par);
+ return relative_unit_scanned;
+ case 'x': case 'X':
+ *value = tex_get_scaled_ex_height(cur_font_par);
+ return relative_unit_scanned;
+ }
+ break;
+ case 'f': case 'F':
+ if (order) {
+ switch (chrtwo) {
+ case 'i': case 'I':
+ *order = fi_glue_order;
+ if (tex_scan_character("lL", 0, 0, 0)) {
+ *order = fil_glue_order;
+ if (tex_scan_character("lL", 0, 0, 0)) {
+ *order = fill_glue_order;
+ if (tex_scan_character("lL", 0, 0, 0)) {
+ *order = filll_glue_order;
+ }
+ }
+ }
+ return flexible_unit_scanned;
+ }
+ }
+ break;
+ }
+ BACK_TWO:
+ tex_back_input(toktwo);
+ BACK_ONE:
+ tex_back_input(tokone);
+ cur_cs = save_cur_cs;
+ return no_unit_scanned;
+ }
+}
+
+/*tex
+ When we drop |true| support we can use the next variant which is a bit more efficient
+ and also handles optional units. LAter we will see a more limited variant that also
+ includes the scaler.
+*/
+
+/*
+static int tex_aux_scan_unit_new(halfword *num, halfword *denom, halfword *value, halfword *order)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ return quantitity_unit_scanned;
+ } else if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ halfword saved_cs = cur_cs;
+ halfword saved_tok = cur_tok;
+ switch (cur_chr) {
+ case 'p': case 'P':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 't': case 'T':
+ return normal_unit_scanned;
+ case 'c': case 'C':
+ *num = 12;
+ *denom = 1;
+ return normal_unit_scanned;
+ case 'x': case 'X':
+ *value = px_dimen_par;
+ return relative_unit_scanned;
+ }
+ }
+ break;
+ case 'm': case 'M':
+ if (order) {
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'm': case 'M':
+ *num = 7227;
+ *denom = 2540;
+ return normal_unit_scanned;
+ case 'u': case 'U':
+ return math_unit_scanned;
+ }
+ }
+ }
+ break;
+ case 'c': case 'C':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'm': case 'M':
+ *num = 7227;
+ *denom = 254;
+ return normal_unit_scanned;
+ case 'c': case 'C':
+ *num = 14856;
+ *denom = 1157;
+ return normal_unit_scanned;
+ }
+ }
+ break;
+ case 's': case 'S':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'p': case 'P':
+ return scaled_point_scanned;
+ }
+ }
+ break;
+ case 'b': case 'B':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'p': case 'P':
+ *num = 7227;
+ *denom = 7200;
+ return normal_unit_scanned;
+ }
+ }
+ break;
+ case 'i': case 'I':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'n': case 'N':
+ *num = 7227;
+ *denom = 100;
+ return normal_unit_scanned;
+ }
+ }
+ break;
+ case 'd': case 'D':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'd': case 'D':
+ *num = 1238;
+ *denom = 1157;
+ return normal_unit_scanned;
+ }
+ }
+ break;
+ case 'e': case 'E':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'm': case 'M':
+ *value = tex_get_scaled_em_width(cur_font_par);
+ return relative_unit_scanned;
+ case 'x': case 'X':
+ *value = tex_get_scaled_ex_height(cur_font_par);
+ return relative_unit_scanned;
+ }
+ }
+ break;
+ case 'f': case 'F':
+ if (order) {
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'i': case 'I':
+ *order = fi_glue_order;
+ if (tex_scan_character("lL", 0, 0, 0)) {
+ *order = fil_glue_order;
+ if (tex_scan_character("lL", 0, 0, 0)) {
+ *order = fill_glue_order;
+ if (tex_scan_character("lL", 0, 0, 0)) {
+ *order = filll_glue_order;
+ }
+ }
+ }
+ return flexible_unit_scanned;
+ }
+ }
+ }
+ break;
+ default:
+ goto JUSTONE;
+ }
+ tex_back_input(cur_tok);
+ JUSTONE:
+ tex_back_input(saved_tok);
+ cur_cs = saved_cs;
+ cur_tok = saved_tok;
+ return no_unit_scanned;
+ } else {
+ tex_back_input(cur_tok);
+ return no_unit_scanned;
+ }
+}
+*/
+
+halfword tex_scan_dimen(int mu, int inf, int shortcut, int optional_equal, halfword *order)
+{
+ int negative = 0;
+ int fraction = 0;
+ int num = 0;
+ int denom = 0;
+ scaled v;
+ int save_cur_val;
+ halfword cur_order = normal_glue_order;
+ lmt_scanner_state.arithmic_error = 0;
+ if (! shortcut) {
+ do {
+ while (1) {
+ tex_get_x_token();
+ if (cur_cmd != spacer_cmd) {
+ if (optional_equal && (cur_tok == equal_token)) {
+ optional_equal = 0;
+ } else {
+ break;
+ }
+ }
+ }
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ cur_tok = plus_token;
+ }
+ } while (cur_tok == plus_token);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ cur_val = tex_aux_scan_something_internal(cur_cmd, cur_chr, mu ? mu_val_level : dimen_val_level, 0, 0); /* adapts cur_val_level */
+ if (mu) {
+ cur_val = tex_aux_coerced_glue(cur_val, cur_val_level);
+ if (cur_val_level == mu_val_level) {
+ goto ATTACH_SIGN;
+ } else if (cur_val_level != int_val_level) {
+ tex_aux_mu_error(2);
+ }
+ } else if (cur_val_level == dimen_val_level) {
+ goto ATTACH_SIGN;
+ }
+ } else {
+ int has_fraction = tex_token_is_seperator(cur_tok);
+ if (has_fraction) {
+ cur_val = 0;
+ } else {
+ int cur_radix;
+ tex_back_input(cur_tok);
+ cur_val = tex_scan_int(0, &cur_radix);
+ if (cur_radix == 10 && tex_token_is_seperator(cur_tok)) {
+ has_fraction = 1;
+ tex_get_token();
+ }
+ }
+ if (has_fraction) {
+ unsigned k = 0;
+ unsigned char digits[18];
+ while (1) {
+ tex_get_x_token();
+ if ((cur_tok > nine_token) || (cur_tok < zero_token)) {
+ break;
+ } else if (k < 17) {
+ digits[k] = (unsigned char) (cur_tok - zero_token);
+ ++k;
+ }
+ }
+ fraction = tex_round_decimals_digits(digits, k);
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(cur_tok);
+ }
+ }
+ }
+ }
+ if (cur_val < 0) {
+ negative = ! negative;
+ cur_val = -cur_val;
+ }
+ save_cur_val = cur_val;
+ /*tex
+ Actually we have cur_tok but it's already pushed back and we also need to skip spaces so
+ let's not overdo this.
+ */
+ switch (tex_aux_scan_unit(&num, &denom, &v, &cur_order)) {
+ case no_unit_scanned:
+ /* error */
+ if (lmt_error_state.intercept) {
+ lmt_error_state.last_intercept = 1;
+ } else {
+ tex_aux_scan_dimen_unknown_unit_error();
+ }
+ goto ATTACH_FRACTION;
+ case normal_unit_scanned:
+ /* cm mm pt bp dd cc in dk */
+ if (mu) {
+ tex_aux_scan_dimen_unknown_unit_error();
+ } else if (num) {
+ int remainder = 0;
+ cur_val = tex_xn_over_d_r(cur_val, num, denom, &remainder);
+ fraction = (num * fraction + 0200000 * remainder) / denom;
+ cur_val += fraction / 0200000;
+ fraction = fraction % 0200000;
+ }
+ goto ATTACH_FRACTION;
+ case scaled_point_scanned:
+ /* sp */
+ if (mu) {
+ tex_aux_scan_dimen_unknown_unit_error();
+ }
+ goto DONE;
+ case relative_unit_scanned:
+ /* ex em px */
+ if (mu) {
+ tex_aux_scan_dimen_unknown_unit_error();
+ }
+ cur_val = tex_nx_plus_y(save_cur_val, v, tex_xn_over_d(v, fraction, 0200000));
+ goto DONE;
+ case math_unit_scanned:
+ /* mu (slightly different but an error anyway */
+ if (! mu) {
+ tex_aux_scan_dimen_mu_error();
+ }
+ goto ATTACH_FRACTION;
+ case flexible_unit_scanned:
+ /* fi fil fill filll */
+ if (mu) {
+ tex_aux_scan_dimen_unknown_unit_error();
+ } else if (! inf) {
+ tex_aux_scan_dimen_fi_error();
+ }
+ goto ATTACH_FRACTION;
+ case quantitity_unit_scanned:
+ /* internal quantity */
+ cur_val = tex_aux_scan_something_internal(cur_cmd, cur_chr, mu ? mu_val_level : dimen_val_level, 0, 0); /* adapts cur_val_level */
+ if (mu) {
+ cur_val = tex_aux_coerced_glue(cur_val, cur_val_level);
+ if (cur_val_level != mu_val_level) {
+ tex_aux_mu_error(3);
+ }
+ }
+ v = cur_val;
+ cur_val = tex_nx_plus_y(save_cur_val, v, tex_xn_over_d(v, fraction, 0200000));
+ goto ATTACH_SIGN;
+ }
+ ATTACH_FRACTION:
+ if (cur_val >= 040000) { // 0x4000
+ lmt_scanner_state.arithmic_error = 1;
+ } else {
+ cur_val = cur_val * unity + fraction;
+ }
+ DONE:
+ tex_get_x_token();
+ tex_push_back(cur_tok, cur_cmd, cur_chr);
+ ATTACH_SIGN:
+ if (lmt_scanner_state.arithmic_error || (abs(cur_val) >= 010000000000)) { // 0x40000000
+ if (lmt_error_state.intercept) {
+ lmt_error_state.last_intercept = 1 ;
+ } else {
+ tex_aux_scan_dimen_out_of_range_error();
+ }
+ cur_val = max_dimen;
+ lmt_scanner_state.arithmic_error = 0;
+ }
+ if (negative) {
+ cur_val = -cur_val;
+ }
+ if (order) {
+ *order = cur_order;
+ }
+ return cur_val;
+}
+
+/*tex
+
+ The final member of \TEX's value-scanning trio is |scan_glue|, which makes |cur_val| point to
+ a glue specification. The reference count of that glue spec will take account of the fact that
+ |cur_val| is pointing to~it. The |level| parameter should be either |glue_val| or |mu_val|.
+
+ Since |scan_dimen| was so much more complex than |scan_int|, we might expect |scan_glue| to be
+ even worse. But fortunately, it is very simple, since most of the work has already been done.
+
+*/
+
+/* todo: get rid of cur_val */
+
+halfword tex_scan_glue(int level, int optional_equal)
+{
+ /*tex should the answer be negated? */
+ int negative = 0;
+ /*tex new glue specification */
+ halfword q = null;
+ /*tex does |level=mu_val|? */
+ int mu = level == mu_val_level;
+ /*tex Get the next non-blank non-sign. */
+ do {
+ /*tex Get the next non-blank non-call token. */
+ while (1) {
+ tex_get_x_token();
+ if (cur_cmd != spacer_cmd) {
+ if (optional_equal && (cur_tok == equal_token)) {
+ optional_equal = 0;
+ } else {
+ break;
+ }
+ }
+ }
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ cur_tok = plus_token;
+ }
+ } while (cur_tok == plus_token);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ cur_val = tex_aux_scan_something_internal(cur_cmd, cur_chr, level, negative, 0);
+ if (cur_val_level >= glue_val_level) {
+ if (cur_val_level != level) {
+ tex_aux_mu_error(4);
+ }
+ return cur_val;
+ }
+ if (cur_val_level == int_val_level) {
+ cur_val = tex_scan_dimen(mu, 0, 1, 0, NULL);
+ } else if (level == mu_val_level) {
+ tex_aux_mu_error(5);
+ }
+ } else {
+ tex_back_input(cur_tok);
+ cur_val = tex_scan_dimen(mu, 0, 0, 0, NULL);
+ if (negative) {
+ cur_val = -cur_val;
+ }
+ }
+ /*tex
+
+ Create a new glue specification whose width is |cur_val|; scan for its stretch and shrink
+ components.
+
+ */
+ q = tex_new_glue_spec_node(zero_glue);
+ glue_amount(q) = cur_val;
+ while (1) {
+ switch (tex_scan_character("pmPM", 0, 1, 0)) {
+ case 0:
+ return q;
+ case 'p': case 'P':
+ if (tex_scan_mandate_keyword("plus", 1)) {
+ halfword order;
+ glue_stretch(q) = tex_scan_dimen(mu, 1, 0, 0, &order);
+ glue_stretch_order(q) = order;
+ }
+ break;
+ case 'm': case 'M':
+ if (tex_scan_mandate_keyword("minus", 1)) {
+ halfword order;
+ glue_shrink(q) = tex_scan_dimen(mu, 1, 0, 0, &order);
+ glue_shrink_order(q) = order;
+ }
+ break;
+ default:
+ tex_aux_show_keyword_error("plus|minus");
+ return q;
+ }
+ }
+}
+
+/*tex
+
+ This started as an experiment. A font object is just a container for a combination of id and
+ scales. It permits fast font switching (not that setting the font id and scales separately is
+ that slow) and has the benefit of a more sparse logging. We use nodes and not some array
+ because after all we always have symbolic names and we then get saving and restoring as well as
+ memory management for free.
+
+ When an spec is given we make a copy but can overload the scales after that. Otherwise we just
+ create a new spec with default scales 1000. This fontspec object was introduced after we had
+ experimental compact font support in \CONTEXT\ for over a year working well.
+
+*/
+
+halfword tex_scan_font(int optional_equal)
+{
+ halfword fv = null;
+ halfword id, fs;
+ if (optional_equal) {
+ tex_scan_optional_equals();
+ }
+ id = tex_scan_font_identifier(&fv);
+ if (fv) {
+ fs = tex_copy_node(fv);
+ } else {
+ /*tex We create a new one and assign the mandate id. */
+ fs = tex_new_node(font_spec_node, normal_code);
+ font_spec_identifier(fs) = id;
+ font_spec_scale(fs) = unused_scale_value;
+ font_spec_x_scale(fs) = unused_scale_value;
+ font_spec_y_scale(fs) = unused_scale_value;
+ }
+ while (1) {
+ switch (tex_scan_character("asxyASXY", 0, 1, 0)) {
+ case 0:
+ return fs;
+ case 'a': case 'A':
+ if (tex_scan_mandate_keyword("all", 1)) {
+ font_spec_scale(fs) = tex_scan_scale(0);
+ font_spec_x_scale(fs) = tex_scan_scale(0);
+ font_spec_y_scale(fs) = tex_scan_scale(0);
+ }
+ break;
+ case 's': case 'S':
+ if (tex_scan_mandate_keyword("scale", 1)) {
+ font_spec_scale(fs) = tex_scan_scale(0);
+ }
+ break;
+ case 'x': case 'X':
+ if (tex_scan_mandate_keyword("xscale", 1)) {
+ font_spec_x_scale(fs) = tex_scan_scale(0);
+ }
+ break;
+ case 'y': case 'Y':
+ if (tex_scan_mandate_keyword("yscale", 1)) {
+ font_spec_y_scale(fs) = tex_scan_scale(0);
+ }
+ break;
+ default:
+ return fs;
+ }
+ }
+}
+
+/*tex
+
+ This procedure is supposed to scan something like |\skip \count 12|, i.e., whatever can follow
+ |\the|, and it constructs a token list containing something like |-3.0pt minus 0.5 fill|.
+
+ There is a bit duplicate code here but it makes a nicer switch as we also need to deal with
+ tokens and font identifiers.
+
+*/
+
+# define push_selector { \
+ saved_selector = lmt_print_state.selector; \
+ lmt_print_state.selector = new_string_selector_code; \
+}
+
+# define pop_selector { \
+ lmt_print_state.selector = saved_selector; \
+}
+
+halfword tex_the_value_toks(int code, halfword *tail, halfword property) /* maybe split this as already checked */
+{
+ tex_get_x_token();
+ cur_val = tex_aux_scan_something_internal(cur_cmd, cur_chr, tok_val_level, 0, property);
+ switch (cur_val_level) {
+ case int_val_level:
+ case attr_val_level:
+ {
+ int saved_selector;
+ push_selector;
+ tex_print_int(cur_val);
+ pop_selector;
+ return tex_cur_str_toks(tail);
+ }
+ case dimen_val_level:
+ {
+ int saved_selector;
+ push_selector;
+ tex_print_dimension(cur_val, code == the_without_unit_code ? no_unit : pt_unit);
+ pop_selector;
+ return tex_cur_str_toks(tail);
+ }
+ case glue_val_level:
+ case mu_val_level:
+ {
+ int saved_selector;
+ push_selector;
+ tex_print_spec(cur_val, (code != the_without_unit_code) ? (cur_val_level == glue_val_level ? pt_unit : mu_unit) : no_unit);
+ tex_flush_node(cur_val);
+ pop_selector;
+ return tex_cur_str_toks(tail);
+ }
+ case tok_val_level:
+ {
+ /*tex Copy the token list */
+ halfword h = null;
+ halfword p = null;
+ if (cur_val) {
+ /*tex Do not copy the reference count! */
+ halfword r = token_link(cur_val);
+ while (r) {
+ p = tex_store_new_token(p, token_info(r));
+ if (! h) {
+ h = p;
+ }
+ r = token_link(r);
+ }
+ }
+ if (tail) {
+ *tail = p;
+ }
+ return h;
+ }
+ case font_val_level:
+ {
+ int saved_selector;
+ push_selector;
+ tex_print_font_identifier(cur_val);
+ pop_selector;
+ return tex_cur_str_toks(tail);
+ }
+ case mathspec_val_level:
+ {
+ /*tex So we don't mess with null font. */
+ if (cur_val) {
+ int saved_selector;
+ push_selector;
+ tex_print_mathspec(cur_val);
+ pop_selector;
+ return tex_cur_str_toks(tail);
+ } else {
+ return null;
+ }
+ }
+ case fontspec_val_level:
+ {
+ /*tex So we don't mess with null font. */
+ if (cur_val) {
+ int saved_selector;
+ push_selector;
+ tex_print_font_specifier(cur_val);
+ pop_selector;
+ return tex_cur_str_toks(tail);
+ } else {
+ return null;
+ }
+ }
+ case list_val_level:
+ {
+ if (cur_val) {
+ // halfword copy = tex_copy_node_list(cur_val, null);
+ halfword copy = tex_copy_node(cur_val);
+ tex_tail_append(copy);
+ cur_val = null;
+ }
+ break;
+ }
+ }
+ return null;
+}
+
+halfword tex_the_detokenized_toks(halfword *tail)
+{
+ halfword head = tex_scan_general_text(tail);
+ int saved_selector;
+ push_selector;
+ tex_show_token_list(head, null, extreme_token_show_max, 0);
+ pop_selector;
+ tex_flush_token_list(head);
+ return tex_cur_str_toks(tail);
+}
+
+/*tex
+ The |the_without_unit| variant implements |\thewithoutunit| is not really that impressive but
+ just there because it's cheap to implement and also avoids a kind of annoying macro definition,
+ one of the kind that demonstrates that one really understands \TEX. Now, with plenty of memory
+ and disk space the added code is probably not noticed and adds less bytes to the binary than a
+ macro does to the (and probably every) format file.
+*/
+
+halfword tex_the_toks(int code, halfword *tail)
+{
+ switch (code) {
+ case the_code:
+ case the_without_unit_code:
+ return tex_the_value_toks(code, tail, 0);
+ /* case the_with_property_code: */
+ /* return tex_the_value_toks(code, tail, tex_scan_int(0, 0)); */
+ case unexpanded_code:
+ return tex_scan_general_text(tail);
+ case detokenize_code:
+ return tex_the_detokenized_toks(tail);
+ default:
+ return null;
+ }
+}
+
+strnumber tex_the_scanned_result(void)
+{
+ /*tex return value */
+ strnumber r;
+ /*tex holds |selector| setting */
+ int saved_selector;
+ push_selector;
+ switch (cur_val_level) {
+ case int_val_level:
+ tex_print_int(cur_val);
+ break;
+ case attr_val_level:
+ tex_print_int(cur_val);
+ break;
+ case dimen_val_level:
+ tex_print_dimension(cur_val, pt_unit);
+ break;
+ case glue_val_level:
+ tex_print_spec(cur_val, pt_unit);
+ tex_flush_node(cur_val);
+ break;
+ case mu_val_level:
+ tex_print_spec(cur_val, mu_unit);
+ tex_flush_node(cur_val);
+ break;
+ case tok_val_level:
+ if (cur_val) {
+ tex_token_show(cur_val, extreme_token_show_max);
+ break;
+ } else {
+ r = get_nullstr();
+ goto DONE;
+ }
+ /*
+ case list_val_level:
+ printf("TODO\n");
+ if (cur_val) {
+ cur_val = tex_copy_node(cur_val);
+ tex_couple_nodes(cur_list.tail, cur_val);
+ cur_list.tail = cur_val;
+ }
+ r = get_nullstr();
+ goto DONE;
+ */
+ default:
+ r = get_nullstr();
+ goto DONE;
+ }
+ r = tex_make_string();
+ DONE:
+ pop_selector;
+ return r;
+}
+
+/*tex
+
+ The following routine is used to implement |\fontdimen n f|. We no longer automatically increase
+ the number of allocated dimensions because we have plenty of dimensions available and loading is
+ done differently anyway.
+
+*/
+
+static halfword tex_aux_scan_font_id_and_parameter(halfword *fnt, halfword *n)
+{
+ *n = tex_scan_int(0, NULL);
+ *fnt = tex_scan_font_identifier(NULL);
+ if (*n <= 0 || *n > max_integer) {
+ tex_handle_error(
+ normal_error_type,
+ "Font '%s' has at most %i fontdimen parameters",
+ font_original(*fnt), font_parameter_count(*fnt),
+ "The font parameter index is out of range."
+ );
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+void tex_set_font_dimen(void)
+{
+ halfword fnt, n;
+ if (tex_aux_scan_font_id_and_parameter(&fnt, &n)) {
+ tex_set_font_parameter(fnt, n, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+}
+
+halfword tex_get_font_dimen(void)
+{
+ halfword fnt, n;
+ return tex_aux_scan_font_id_and_parameter(&fnt, &n) ? tex_get_font_parameter(fnt, n) : null;
+}
+
+void tex_set_scaled_font_dimen(void)
+{
+ halfword fnt, n;
+ if (tex_aux_scan_font_id_and_parameter(&fnt, &n)) {
+ tex_set_scaled_parameter(fnt, n, tex_scan_dimen(0, 0, 0, 1, NULL));
+ }
+}
+
+halfword tex_get_scaled_font_dimen(void)
+{
+ halfword fnt, n;
+ return tex_aux_scan_font_id_and_parameter(&fnt, &n) ? tex_get_scaled_parameter(fnt, n) : null;
+}
+
+/*tex Declare procedures that scan font-related stuff. */
+
+halfword tex_scan_math_style_identifier(int tolerant, int styles)
+{
+ halfword style = tex_scan_int(0, NULL);
+ if (is_valid_math_style(style)) {
+ return style;
+ } else if (styles && are_valid_math_styles(style)) {
+ return style;
+ } else if (tolerant) {
+ return -1;
+ } else {
+ tex_handle_error(
+ back_error_type,
+ "Missing math style, treated as \\displaystyle",
+ "A style should have been here; I inserted '\\displaystyle'."
+ );
+ return display_style;
+ }
+}
+
+halfword tex_scan_math_parameter(void)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == set_math_parameter_cmd && cur_chr < math_parameter_last) {
+ return cur_chr;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "Invalid math parameter",
+ "I'm going to ignore this one."
+ );
+ return -1;
+ }
+}
+
+halfword tex_scan_fontspec_identifier(void)
+{
+ /*tex Get the next non-blank non-call. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == fontspec_cmd) {
+ return cur_chr;
+ } else {
+ return 0;
+ }
+}
+
+halfword tex_scan_font_identifier(halfword *spec)
+{
+ /*tex Get the next non-blank non-call. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ switch (cur_cmd) {
+ case define_font_cmd:
+ return cur_font_par;
+ case set_font_cmd:
+ /* set_font_touched(cur_chr, 1); */
+ return cur_chr;
+ case fontspec_cmd:
+ {
+ halfword fnt = tex_get_font_identifier(cur_chr);
+ if (fnt && spec) {
+ *spec = fnt ? cur_chr : null;
+ }
+ return fnt;
+ }
+ case define_family_cmd:
+ {
+ halfword siz = cur_chr;
+ halfword fam = tex_scan_math_family_number();
+ halfword fnt = tex_fam_fnt(fam, siz);
+ /* set_font_touched(fnt, 1); */
+ return fnt;
+ }
+ case register_int_cmd:
+ case integer_cmd:
+ {
+ /*tex Checking here saves a push back when we want an integer. */
+ halfword fnt = eq_value(cur_chr);
+ if (tex_is_valid_font(fnt)) {
+ return fnt;
+ } else {
+ goto BAD;
+ }
+ }
+ case internal_int_cmd:
+ {
+ /*tex Bonus: |\setfontid| */
+ if (internal_int_number(cur_chr) == font_code) {
+ halfword fnt = tex_scan_int(0, NULL);
+ if (tex_is_valid_font(fnt)) {
+ return fnt;
+ }
+ }
+ goto BAD;
+ }
+ default:
+ {
+ /*tex We abuse |scan_cardinal| here btu we have to push back. */
+ unsigned fnt = null_font;
+ tex_back_input(cur_tok);
+ if (tex_scan_cardinal(&fnt, 1)) {
+ if (tex_is_valid_font((halfword) fnt)) {
+ return (halfword) fnt;
+ }
+ } else {
+ /*tex Fall through to a font error message. */
+ }
+ BAD:
+ tex_handle_error(
+ back_error_type,
+ "Missing or invalid font identifier (or equivalent) or integer (register or otherwise)",
+ "I was looking for a control sequence whose current meaning has been defined by\n"
+ "\\font or a valid font id number."
+ );
+ return null_font;
+ }
+ }
+}
+
+/*tex
+
+ The |scan_general_text| procedure is much like |scan_toks (false, false)|, but will be invoked
+ via |expand|, i.e., recursively.
+
+ The token list (balanced text) created by |scan_general_text| begins at |link (temp_token_head)|
+ and ends at |cur_val|. (If |cur_val = temp_token_head|, the list is empty.)
+
+*/
+
+halfword tex_scan_general_text(halfword *tail)
+{
+ /*tex The tail of the token list being built: */
+ halfword p = get_reference_token();
+ halfword head;
+ /*tex The number of nested left braces: */
+ halfword unbalance = 0;
+ halfword saved_scanner_status = lmt_input_state.scanner_status;
+ halfword saved_warning_index = lmt_input_state.warning_index;
+ halfword saved_def_ref = lmt_input_state.def_ref;
+ lmt_input_state.scanner_status = scanner_is_absorbing;
+ lmt_input_state.warning_index = cur_cs;
+ lmt_input_state.def_ref = p;
+ /*tex Remove the compulsory left brace. */
+ tex_scan_left_brace();
+ while (1) {
+ tex_get_token();
+ if (cur_tok < right_brace_limit) {
+ // if (cur_cmd < right_brace_cmd) {
+ if (cur_cmd == left_brace_cmd || cur_cmd == relax_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ break;
+ }
+ }
+ p = tex_store_new_token(p, cur_tok);
+ }
+ head = token_link(lmt_input_state.def_ref);
+ if (tail) {
+ *tail = head ? p : null;
+ }
+ /*tex Discard reference count. */
+ tex_put_available_token(lmt_input_state.def_ref);
+ lmt_input_state.scanner_status = saved_scanner_status;
+ lmt_input_state.warning_index = saved_warning_index;
+ lmt_input_state.def_ref = saved_def_ref;
+ return head;
+}
+
+/*tex
+
+ The |get_x_or_protected| procedure is like |get_x_token| except that protected macros are not
+ expanded. It sets |cur_cmd|, |cur_chr|, |cur_tok|, and expands non-protected macros.
+
+*/
+
+void tex_get_x_or_protected(void)
+{
+ while (1) {
+ tex_get_token();
+ if (cur_cmd <= max_command_cmd || is_protected_cmd(cur_cmd)) {
+ return;
+ } else {
+ tex_expand_current_token();
+ }
+ }
+}
+
+/*tex
+
+ |scan_toks|. This function returns a pointer to the tail of a new token list, and it also makes
+ |def_ref| point to the reference count at the head of that list.
+
+ There are two boolean parameters, |macro_def| and |xpand|. If |macro_def| is true, the goal is
+ to create the token list for a macro definition; otherwise the goal is to create the token list
+ for some other \TEX\ primitive: |\mark|, |\output|, |\everypar|, |\lowercase|, |\uppercase|,
+ |\message|, |\errmessage|, |\write|, or |\special|. In the latter cases a left brace must be
+ scanned next; this left brace will not be part of the token list, nor will the matching right
+ brace that comes at the end. If |xpand| is false, the token list will simply be copied from the
+ input using |get_token|. Otherwise all expandable tokens will be expanded until unexpandable
+ tokens are left, except that the results of expanding |\the| are not expanded further. If both
+ |macro_def| and |xpand| are true, the expansion applies only to the macro body (i.e., to the
+ material following the first |left_brace| character).
+
+ The value of |cur_cs| when |scan_toks| begins should be the |eqtb| address of the control
+ sequence to display in runaway error messages.
+
+ Watch out: there are two extensions to the macro definition parser: a |#0| will just gobble the
+ argument and not copy it to the parameter stack, and |#+| will not remove braces around a
+ \quote {single group} argument, something that comes in handy when you grab and pass over an
+ argument.
+
+ If the next character is a parameter number, make |cur_tok| a |match| token; but if it is a
+ left brace, store |left_brace|, |end_match|, set |hash_brace|, and |goto done|.
+
+ For practical reasone, we have split the |scan_toks| function up in four smaller dedicated
+ functions. When we add features it makes no sense to clutter the code even more. Keep in mind
+ that compared to the reference \TEX\ inplementation we have to support |\expanded| token lists
+ but also |\protected| and friends. There is of course some overlap now but that's a small
+ price to pay for readability.
+
+ The split functions need less redundant checking and the expandable variants got one loop
+ instead of two nested loops.
+
+*/
+
+halfword tex_scan_toks_normal(int left_brace_found, halfword *tail)
+{
+ halfword unbalance = 0;
+ halfword result = get_reference_token();
+ halfword p = result;
+ lmt_input_state.scanner_status = scanner_is_absorbing;
+ lmt_input_state.warning_index = cur_cs;
+ lmt_input_state.def_ref = result;
+ if (! left_brace_found) {
+ tex_scan_left_brace();
+ }
+ while (1) {
+ tex_get_token();
+ if (cur_tok < right_brace_limit) {
+ if (cur_cmd == left_brace_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ break;
+ }
+ } else if (cur_cmd == prefix_cmd && cur_chr == enforced_code && (! overload_mode_par || lmt_main_state.run_state != production_state)) { /* todo cur_tok == let_aliased_token */
+ cur_tok = token_val(prefix_cmd, always_code);
+ }
+ p = tex_store_new_token(p, cur_tok);
+ }
+ lmt_input_state.scanner_status = scanner_is_normal;
+ if (tail) {
+ *tail = p;
+ }
+ return result;
+}
+
+halfword tex_scan_toks_expand(int left_brace_found, halfword *tail, int expandconstant)
+{
+ halfword unbalance = 0;
+ halfword result = get_reference_token();
+ halfword p = result;
+ lmt_input_state.scanner_status = scanner_is_absorbing;
+ lmt_input_state.warning_index = cur_cs;
+ lmt_input_state.def_ref = result;
+ if (! left_brace_found) {
+ tex_scan_left_brace();
+ }
+ while (1) {
+ PICKUP:
+ tex_get_next();
+ switch (cur_cmd) {
+ case call_cmd:
+ case tolerant_call_cmd:
+ tex_expand_current_token();
+ goto PICKUP;
+ case protected_call_cmd:
+ case tolerant_protected_call_cmd:
+ cur_tok = cs_token_flag + cur_cs;
+ goto APPENDTOKEN;
+ case semi_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ if (expandconstant) {
+ tex_expand_current_token();
+ goto PICKUP;
+ } else {
+ cur_tok = cs_token_flag + cur_cs;
+ goto APPENDTOKEN;
+ }
+ case the_cmd:
+ {
+ halfword t = null;
+ halfword h = tex_the_toks(cur_chr, &t);
+ if (h) {
+ set_token_link(p, h);
+ p = t;
+ }
+ goto PICKUP;
+ }
+ case prefix_cmd:
+ if (cur_chr == enforced_code && (! overload_mode_par || lmt_main_state.run_state != production_state)) {
+ cur_tok = token_val(prefix_cmd, always_code);
+ goto APPENDTOKEN;
+ }
+ default:
+ if (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ goto PICKUP;
+ } else {
+ goto DONEEXPANDING;
+ }
+ }
+ DONEEXPANDING:
+ tex_x_token();
+ if (cur_tok < right_brace_limit) {
+ if (cur_cmd == left_brace_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ goto FINALYDONE;
+ }
+ }
+ APPENDTOKEN:
+ p = tex_store_new_token(p, cur_tok);
+ }
+ FINALYDONE:
+ lmt_input_state.scanner_status = scanner_is_normal;
+ if (tail) {
+ *tail = p;
+ }
+ return result;
+}
+
+static void tex_aux_too_many_parameters_error(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "You already have nine parameters",
+ "I'm going to ignore the # sign you just used, as well the token that followed it.\n"
+ /*tex That last bit was added in the TeX 2021 buglet fix round. */
+ );
+}
+
+static void tex_aux_parameters_order_error(void)
+{
+ tex_handle_error(
+ back_error_type,
+ "Parameters must be numbered consecutively",
+ "I've inserted the digit you should have used after the #."
+ );
+}
+
+static void tex_aux_missing_brace_error(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Missing { inserted",
+ "Where was the left brace? You said something like '\\def\\a}', which I'm going to\n"
+ "interpret as '\\def\\a{}'."
+ );
+}
+
+static void tex_aux_illegal_parameter_in_body_error(void)
+{
+ tex_handle_error(
+ back_error_type,
+ "Illegal parameter number in definition of %S",
+ lmt_input_state.warning_index,
+ "You meant to type ## instead of #, right? Or maybe a } was forgotten somewhere\n"
+ "earlier, and things are all screwed up? I'm going to assume that you meant ##."
+ );
+}
+
+/*tex
+ There are interesting aspects in reporting the preamble, like:
+
+ \starttyping
+ \def\test#1#{test#1} : macro:#1{->test#1{
+ \stoptyping
+
+ So, the \type {#} gets reported as left brace.
+
+ The |\par| handling depends on the mode
+
+ \starttyping
+ % 0x1 text | 0x2 macro | 0x4 go-on
+
+ \autoparagraphmode0 \def\foo#1\par{[#1]} 0: \meaningfull\foo\par \foo test\par test\par
+ \autoparagraphmode1 \def\foo#1\par{[#1]} 1: \meaningfull\foo\par \foo test\par test\par
+ \autoparagraphmode2 \def\foo#1\par{[#1]} 2: \meaningfull\foo\par \foo test\par test\par % discard after #1 till \par
+ \autoparagraphmode4 \def\foo#1\par{[#1]} 4: \meaningfull\foo\par \foo test\par test\par
+ \stoptyping
+*/
+
+inline static int tex_aux_valid_macro_preamble(halfword *p, int *counter, halfword *hash_brace)
+{
+ halfword h = *p;
+ while (1) {
+ tex_get_token();
+ if (cur_tok < right_brace_limit) {
+ break;
+ } else if (cur_cmd == parameter_cmd) {
+ tex_get_token();
+ /*
+ cf. TeX 2021 we not do a more strict testing. Interesting is that wondered why we
+ had a more generous test here but just considered that a feature or intended side
+ effect but in the end we have to be strict.
+
+ \starttyping
+ \def\cs#1#\bgroup hi#1} % was weird but okay pre 2021
+ \def\cs#1\bgroup{hi#1\bgroup} % but this is better indeed
+ \stoptyping
+ */
+ if (cur_tok < left_brace_limit) {
+ /* if (cur_cmd == left_brace_cmd) { */
+ /*tex The |\def\foo#{}| case. */
+ *hash_brace = cur_tok;
+ *p = tex_store_new_token(*p, cur_tok);
+ *p = tex_store_new_token(*p, end_match_token);
+ set_token_parameters(h, *counter - zero_token + 1);
+ return 1;
+ } else if (*counter == nine_token) {
+ tex_aux_too_many_parameters_error();
+ } else {
+ switch (cur_tok) {
+ case zero_token:
+ ++*counter;
+ cur_tok = match_token;
+ break;
+ case asterisk_token:
+ cur_tok = spacer_match_token;
+ break;
+ case plus_token:
+ ++*counter;
+ cur_tok = keep_match_token;
+ break;
+ case minus_token:
+ cur_tok = thrash_match_token;
+ break;
+ case period_token:
+ cur_tok = par_spacer_match_token;
+ break;
+ case comma_token:
+ cur_tok = keep_spacer_match_token;
+ break;
+ case slash_token:
+ ++*counter;
+ cur_tok = prune_match_token;
+ break;
+ case colon_token:
+ cur_tok = continue_match_token;
+ break;
+ case semi_colon_token:
+ cur_tok = quit_match_token;
+ break;
+ case equal_token:
+ ++*counter;
+ cur_tok = mandate_match_token;
+ break;
+ case circumflex_token_l:
+ case circumflex_token_o:
+ ++*counter;
+ cur_tok = leading_match_token;
+ break;
+ case underscore_token_l:
+ case underscore_token_o:
+ ++*counter;
+ cur_tok = mandate_keep_match_token;
+ break;
+ case at_token_l:
+ case at_token_o:
+ cur_tok = par_command_match_token;
+ break;
+ default:
+ ++*counter;
+ if (cur_tok != *counter) {
+ tex_aux_parameters_order_error();
+ }
+ cur_tok += match_token - other_token;
+ break;
+ }
+ }
+ } else if (cur_cmd == end_paragraph_cmd && auto_paragraph_mode(auto_paragraph_macro)) {
+ cur_tok = par_command_match_token;
+ }
+ *p = tex_store_new_token(*p, cur_tok);
+ }
+ if (h != *p) {
+ *p = tex_store_new_token(*p, end_match_token);
+ set_token_parameters(h, *counter - zero_token + 1);
+ }
+ if (cur_cmd == right_brace_cmd) {
+ ++lmt_input_state.align_state;
+ tex_aux_missing_brace_error();
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+halfword tex_scan_macro_normal(void)
+{
+ halfword hash_brace = 0;
+ halfword counter = zero_token;
+ halfword result = get_reference_token();
+ halfword p = result;
+ lmt_input_state.scanner_status = scanner_is_defining;
+ lmt_input_state.warning_index = cur_cs;
+ lmt_input_state.def_ref = result;
+ if (tex_aux_valid_macro_preamble(&p, &counter, &hash_brace)) {
+ halfword unbalance = 0;
+ while (1) {
+ tex_get_token();
+ if (cur_tok < right_brace_limit) {
+ /*tex Maybe use |cur_cmd < left_brace_limit| for consistency. */
+ if (cur_cmd == left_brace_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ goto FINALYDONE;
+ }
+ } else if (cur_cmd == parameter_cmd) {
+ halfword s = cur_tok;
+ tex_get_token();
+ if (cur_cmd == parameter_cmd) {
+ /*tex Keep the |#|. */
+ } else if (cur_tok <= zero_token || cur_tok > counter) {
+ tex_aux_illegal_parameter_in_body_error();
+ cur_tok = s;
+ } else {
+ cur_tok = token_val(parameter_reference_cmd, cur_chr - '0');
+ }
+ } else if (cur_cmd == prefix_cmd && cur_chr == enforced_code && (! overload_mode_par || lmt_main_state.run_state != production_state)) { /* todo cur_tok == let_aliased_token */
+ cur_tok = token_val(prefix_cmd, always_code);
+ }
+ p = tex_store_new_token(p, cur_tok);
+ }
+ }
+ FINALYDONE:
+ lmt_input_state.scanner_status = scanner_is_normal;
+ if (hash_brace) {
+ p = tex_store_new_token(p, hash_brace);
+ }
+ return result;
+}
+
+# define optimize_grouping 0
+
+halfword tex_scan_macro_expand(void)
+{
+ halfword hash_brace = 0;
+ halfword counter = zero_token;
+ halfword result = get_reference_token();
+ halfword p = result;
+ lmt_input_state.scanner_status = scanner_is_defining;
+ lmt_input_state.warning_index = cur_cs;
+ lmt_input_state.def_ref = result;
+ if (tex_aux_valid_macro_preamble(&p, &counter, &hash_brace)) {
+ halfword unbalance = 0;
+ while (1) {
+ PICKUP:
+ tex_get_next();
+ switch (cur_cmd) {
+ case call_cmd:
+ case tolerant_call_cmd:
+ tex_expand_current_token();
+ goto PICKUP;
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ cur_tok = cs_token_flag + cur_cs;
+ goto APPENDTOKEN;
+ case the_cmd:
+ {
+ halfword t = null;
+ halfword h = tex_the_toks(cur_chr, &t);
+ if (h) {
+ set_token_link(p, h);
+ p = t;
+ }
+ goto PICKUP;
+ }
+ case relax_cmd:
+ if (cur_chr == no_relax_code) {
+ /*tex Think of |\ifdim\dimen0=\dimen2\norelax| inside an |\edef|. */
+ goto PICKUP;
+ } else {
+ goto DONEEXPANDING;
+ }
+ case prefix_cmd:
+ if (cur_chr == enforced_code && (! overload_mode_par || lmt_main_state.run_state != production_state)) {
+ cur_tok = token_val(prefix_cmd, always_code);
+ goto APPENDTOKEN;
+ } else {
+ goto DONEEXPANDING;
+ }
+ case parameter_cmd:
+ {
+ /* move into switch ... */
+ halfword s = cur_tok;
+ tex_get_x_token();
+ if (cur_cmd == parameter_cmd) {
+ /*tex Keep the |#|. */
+ } else if (cur_tok <= zero_token || cur_tok > counter) {
+ tex_aux_illegal_parameter_in_body_error();
+ cur_tok = s;
+ } else {
+ cur_tok = token_val(parameter_reference_cmd, cur_chr - '0');
+ }
+ goto APPENDTOKEN;
+ }
+# if (optimize_grouping)
+ case left_brace_cmd:
+ if (cur_cs) {
+ cur_tok = cs_token_flag + cur_cs;
+ } else {
+ cur_tok = token_val(cur_cmd, cur_chr);
+ ++unbalance;
+ }
+ goto APPENDTOKEN;
+ case right_brace_cmd:
+ if (cur_cs) {
+ cur_tok = cs_token_flag + cur_cs;
+ goto APPENDTOKEN;
+ } else {
+ cur_tok = token_val(cur_cmd, cur_chr);
+ if (unbalance) {
+ --unbalance;
+ goto APPENDTOKEN;
+ } else {
+ goto FINALYDONE;
+ }
+ }
+# endif
+ default:
+ if (cur_cmd > max_command_cmd) {
+ tex_expand_current_token();
+ goto PICKUP;
+ } else {
+ goto DONEEXPANDING;
+ }
+ }
+ DONEEXPANDING:
+ /* tex_x_token(); */
+ if (cur_cs) {
+ cur_tok = cs_token_flag + cur_cs;
+ } else {
+ cur_tok = token_val(cur_cmd, cur_chr);
+ }
+ /* */
+# if (! optimize_grouping)
+ if (cur_tok < right_brace_limit) {
+ if (cur_cmd == left_brace_cmd) {
+ ++unbalance;
+ } else if (unbalance) {
+ --unbalance;
+ } else {
+ goto FINALYDONE;
+ }
+ }
+# endif
+ APPENDTOKEN:
+ p = tex_store_new_token(p, cur_tok);
+ }
+ }
+ FINALYDONE:
+ lmt_input_state.scanner_status = scanner_is_normal;
+ if (hash_brace) {
+ p = tex_store_new_token(p, hash_brace);
+ }
+ return result;
+}
+
+/*tex
+
+ The |scan_expr| procedure scans and evaluates an expression. Evaluating an expression is a
+ recursive process: When the left parenthesis of a subexpression is scanned we descend to the
+ next level of recursion; the previous level is resumed with the matching right parenthesis.
+
+*/
+
+typedef enum expression_states {
+ expression_none, /*tex |(| or |(expr)| */
+ expression_add, /*tex |+| */
+ expression_subtract, /*tex |-| */
+ expression_multiply, /*tex |*| */
+ expression_divide, /*tex |/| */
+ expression_scale, /*tex |* factor| */
+ expression_idivide, /*tex |:|, is like |/| but floored */
+} expression_states;
+
+/*tex
+
+ We want to make sure that each term and (intermediate) result is in the proper range. Integer
+ values must not exceed |infinity| ($2^{31} - 1$) in absolute value, dimensions must not exceed
+ |max_dimen| ($2^{30} - 1$). We avoid the absolute value of an integer, because this might fail
+ for the value $-2^{31}$ using 32-bit arithmetic.
+
+ Todo: maybe use |long long| here.
+
+*/
+
+inline static void tex_aux_normalize_glue(halfword g)
+{
+ if (! glue_stretch(g)) {
+ glue_stretch_order(g) = normal_glue_order;
+ }
+ if (! glue_shrink(g)) {
+ glue_shrink_order(g) = normal_glue_order;
+ }
+}
+
+/*tex
+
+ Parenthesized subexpressions can be inside expressions, and this nesting has a stack. Seven
+ local variables represent the top of the expression stack: |p| points to pushed-down entries,
+ if any; |l| specifies the type of expression currently beeing evaluated; |e| is the expression
+ so far and |r| is the state of its evaluation; |t| is the term so far and |s| is the state of
+ its evaluation; finally |n| is the numerator for a combined multiplication and division, if any.
+
+ The function |add_or_sub (x, y, max_answer, negative)| computes the sum (for |negative = false|)
+ or difference (for |negative = true|) of |x| and |y|, provided the absolute value of the result
+ does not exceed |max_answer|.
+
+*/
+
+inline static int tex_aux_add_or_sub(int x, int y, int max_answer, int operation)
+{
+ switch (operation) {
+ case expression_subtract:
+ y = -y;
+ // fall-trough
+ case expression_add:
+ if (x >= 0) {
+ if (y <= max_answer - x) {
+ return x + y;
+ } else {
+ lmt_scanner_state.arithmic_error = 1;
+ }
+ } else if (y >= -max_answer - x) {
+ return x + y;
+ } else {
+ lmt_scanner_state.arithmic_error = 1;
+ }
+ break;
+ }
+ return 0;
+}
+
+/*tex
+
+ The function |quotient (n, d)| computes the rounded quotient $q = \lfloor n / d + {1 \over 2}
+ \rfloor$, when $n$ and $d$ are positive.
+
+*/
+
+inline static int tex_aux_quotient(int n, int d, int round)
+{
+ /*tex The answer: */
+ if (d == 0) {
+ lmt_scanner_state.arithmic_error = 1;
+ return 0;
+ } else {
+ /*tex Should the answer be negated? */
+ int negative;
+ int a;
+ if (d > 0) {
+ negative = 0;
+ } else {
+ d = -d;
+ negative = 1;
+ }
+ if (n < 0) {
+ n = -n;
+ negative = ! negative;
+ }
+ a = n / d;
+ if (round) {
+ n = n - a * d;
+ /*tex Avoid certain compiler optimizations! Really? */
+ d = n - d;
+ if (d + n >= 0) {
+ ++a;
+ }
+ }
+ if (negative) {
+ a = -a;
+ }
+ return a;
+ }
+}
+
+/*tex
+
+ Finally, the function |fract (x, n, d, max_answer)| computes the integer $q = \lfloor x n / d
+ + {1 \over 2} \rfloor$, when $x$, $n$, and $d$ are positive and the result does not exceed
+ |max_answer|. We can't use floating point arithmetic since the routine must produce identical
+ results in all cases; and it would be too dangerous to multiply by~|n| and then divide by~|d|,
+ in separate operations, since overflow might well occur. Hence this subroutine simulates double
+ precision arithmetic, somewhat analogous to Metafont's |make_fraction| and |take_fraction|
+ routines.
+
+*/
+
+int tex_fract(int x, int n, int d, int max_answer)
+{
+ /*tex should the answer be negated? */
+ int negative = 0;
+ /*tex the answer */
+ int a = 0;
+ /*tex a proper fraction */
+ int f;
+ /*tex smallest integer such that |2*h>=d| */
+ int h;
+ /*tex intermediate remainder */
+ int r;
+ /*tex temp variable */
+ int t;
+ if (d == 0) {
+ goto TOO_BIG;
+ }
+ if (x == 0) {
+ return 0;
+ }
+ if (d < 0) {
+ d = -d;
+ negative = 1;
+ }
+ if (x < 0) {
+ x = -x;
+ negative = ! negative;
+ }
+ if (n < 0) {
+ n = -n;
+ negative = ! negative;
+ }
+ t = n / d;
+ if (t > max_answer / x) {
+ goto TOO_BIG;
+ }
+ a = t * x;
+ n = n - t * d;
+ if (n == 0) {
+ goto FOUND;
+ }
+ t = x / d;
+ if (t > (max_answer - a) / n) {
+ goto TOO_BIG;
+ }
+ a = a + t * n;
+ x = x - t * d;
+ if (x == 0) {
+ goto FOUND;
+ }
+ if (x < n) {
+ t = x;
+ x = n;
+ n = t;
+ }
+ /*tex
+
+ Now |0 < n <= x < d| and we compute $f = \lfloor xn/d+{1\over2}\rfloor$. The loop here
+ preserves the following invariant relations between |f|, |x|, |n|, and~|r|: (i)~$f + \lfloor
+ (xn + (r + d))/d\rfloor = \lfloor x_0 n_0/d + {1\over2} \rfloor$; (ii)~|-d <= r < 0 < n <= x
+ < d|, where $x_0$, $n_0$ are the original values of~$x$ and $n$.
+
+ Notice that the computation specifies |(x - d) + x| instead of |(x + x) - d|, because the
+ latter could overflow.
+
+ */
+ f = 0;
+ r = (d / 2) - d;
+ h = -r;
+ while (1) {
+ if (odd(n)) {
+ r = r + x;
+ if (r >= 0) {
+ r = r - d;
+ ++f;
+ }
+ }
+ n = n / 2;
+ if (n == 0) {
+ break;
+ } else if (x < h) {
+ x = x + x;
+ } else {
+ t = x - d;
+ x = t + x;
+ f = f + n;
+ if (x < n) {
+ if (x == 0) {
+ break;
+ } else {
+ t = x;
+ x = n;
+ n = t;
+ }
+ }
+ }
+ }
+ if (f > (max_answer - a)) {
+ goto TOO_BIG;
+ }
+ a = a + f;
+ FOUND:
+ if (negative) {
+ a = -a;
+ }
+ goto DONE;
+ TOO_BIG:
+ lmt_scanner_state.arithmic_error = 1;
+ a = 0;
+ DONE:
+ return a;
+}
+
+/*tex
+
+ The main stacking logic approach is kept but I get the impression that the code is still
+ suboptimal.
+
+*/
+
+static void tex_aux_scan_expr(halfword level)
+{
+ /*tex state of expression so far */
+ int result;
+ /*tex state of term so far */
+ int state;
+ /*tex next operation or type of next factor */
+ int operation;
+ /*tex expression so far */
+ int expression;
+ /*tex term so far */
+ int term;
+ /*tex current factor */
+ int factor = 0;
+ /*tex numerator of combined multiplication and division */
+ int numerator;
+ /*tex saved values of |arith_error| */
+ int error_a = lmt_scanner_state.arithmic_error;
+ int error_b = 0;
+ /*tex top of expression stack */
+ halfword top = null;
+ /*tex Scan and evaluate an expression |e| of type |l|. */
+ cur_val_level = level; /* for now */
+ lmt_scanner_state.expression_depth++;
+ if (lmt_scanner_state.expression_depth > 1000) {
+ tex_fatal_error("\\*expr can only be nested 1000 deep");
+ }
+ RESTART:
+ result = expression_none;
+ state = expression_none;
+ expression = 0;
+ term = 0;
+ numerator = 0;
+ CONTINUE:
+ operation = state == expression_none ? level : int_val_level; /* we abuse operation */
+ /*tex
+
+ Scan a factor |f| of type |o| or start a subexpression. Get the next non-blank non-call
+ token.
+
+ */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok == left_parent_token) {
+ /*tex Push the expression stack and |goto restart|. */
+ halfword t = tex_get_node(expression_node_size);
+ node_type(t) = expression_node;
+ node_subtype(t) = 0;
+ /* */
+ node_next(t) = top;
+ expression_type(t) = (quarterword) level;
+ expression_state(t) = (singleword) state;
+ expression_result(t) = (singleword) result;
+ expression_expression(t) = expression;
+ expression_term(t) = term;
+ expression_numerator(t) = numerator;
+ top = t;
+ level = operation;
+ goto RESTART;
+ }
+ if (cur_cmd != spacer_cmd) {
+ tex_back_input(cur_tok);
+ }
+ switch (operation) {
+ case int_val_level:
+ case attr_val_level:
+ factor = tex_scan_int(0, NULL);
+ break;
+ case dimen_val_level:
+ factor = tex_scan_dimen(0, 0, 0, 0, NULL);
+ break;
+ case glue_val_level:
+ factor = tex_scan_glue(glue_val_level, 0);
+ break;
+ case mu_val_level:
+ factor = tex_scan_glue(mu_val_level, 0);
+ break;
+ }
+ FOUND:
+ /*tex
+ Scan the next operator and set |o| and get the next non-blank non-call token.
+ */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ switch (cur_tok) {
+ case plus_token:
+ operation = expression_add;
+ break;
+ case minus_token:
+ operation = expression_subtract;
+ break;
+ case asterisk_token:
+ operation = expression_multiply;
+ break;
+ case slash_token:
+ operation = expression_divide;
+ break;
+ case colon_token:
+ operation = expression_idivide;
+ break;
+ /*tex
+ The commented bitwise experiment as of 2020-07-20 has been removed and is now in
+ |\scanbitexpr|. You can find it in the archive.
+ */
+ default:
+ operation = expression_none;
+ if (! top) {
+ if (cur_cmd != relax_cmd) {
+ tex_back_input(cur_tok);
+ }
+ } else if (cur_tok != right_parent_token) {
+ tex_handle_error(
+ back_error_type,
+ "Missing ) inserted for expression",
+ "I was expecting to see '+', '-', '*', '/', ':' or ')'. Didn't."
+ );
+ }
+ break;
+ }
+ lmt_scanner_state.arithmic_error = error_b;
+ /*tex Make sure that |f| is in the proper range. */
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ if ((factor > infinity) || (factor < -infinity)) {
+ lmt_scanner_state.arithmic_error = 1;
+ factor = 0;
+ }
+ break;
+ case dimen_val_level:
+ if (abs(factor) > max_dimen) {
+ lmt_scanner_state.arithmic_error = 1;
+ factor = 0;
+ }
+ break;
+ case glue_val_level:
+ case mu_val_level:
+ if ((abs(glue_amount(factor)) > max_dimen) || (abs(glue_stretch(factor)) > max_dimen) || (abs(glue_shrink(factor)) > max_dimen)) {
+ lmt_scanner_state.arithmic_error = 1;
+ tex_reset_glue_to_zero(factor);
+ }
+ break;
+ default:
+ if ((state > expression_subtract) && ((factor > infinity) || (factor < -infinity))) {
+ lmt_scanner_state.arithmic_error = 1;
+ factor = 0;
+ }
+ }
+ /*tex Cases for evaluation of the current term. */
+ switch (state) {
+ case expression_none:
+ /*tex
+ Applying the factor |f| to the partial term |t| (with the operator |s|) is delayed
+ until the next operator |o| has been scanned. Here we handle the first factor of a
+ partial term. A glue spec has to be copied unless the next operator is a right
+ parenthesis; this allows us later on to simply modify the glue components.
+ */
+ term = factor;
+ if ((level >= glue_val_level) && (operation != expression_none)) {
+ /*tex Do we really need to copy here? */
+ tex_aux_normalize_glue(term);
+ } else {
+ term = factor;
+ }
+ break;
+ case expression_multiply:
+ /*tex
+ If a multiplication is followed by a division, the two operations are combined into
+ a 'scaling' operation. Otherwise the term |t| is multiplied by the factor |f|.
+ */
+ if (operation == expression_divide) {
+ numerator = factor;
+ operation = expression_scale;
+ } else {
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ term = tex_multiply_integers(term, factor);
+ break;
+ case dimen_val_level:
+ term = tex_nx_plus_y(term, factor, 0);
+ break;
+ default:
+ glue_amount(term) = tex_nx_plus_y(glue_amount(term), factor, 0);
+ glue_stretch(term) = tex_nx_plus_y(glue_stretch(term), factor, 0);
+ glue_shrink(term) = tex_nx_plus_y(glue_shrink(term), factor, 0);
+ break;
+ }
+ }
+ break;
+ case expression_divide:
+ /*tex Here we divide the term |t| by the factor |f|. */
+ if (level < glue_val_level) {
+ term = tex_aux_quotient(term, factor, 1);
+ } else {
+ glue_amount(term) = tex_aux_quotient(glue_amount(term), factor, 1);
+ glue_stretch(term) = tex_aux_quotient(glue_stretch(term), factor, 1);
+ glue_shrink(term) = tex_aux_quotient(glue_shrink(term), factor, 1);
+ }
+ break;
+ case expression_scale:
+ /*tex Here the term |t| is multiplied by the quotient $n/f$. */
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ term = tex_fract(term, numerator, factor, infinity);
+ break;
+ case dimen_val_level:
+ term = tex_fract(term, numerator, factor, max_dimen);
+ break;
+ default:
+ glue_amount(term) = tex_fract(glue_amount(term), numerator, factor, max_dimen);
+ glue_stretch(term) = tex_fract(glue_stretch(term), numerator, factor, max_dimen);
+ glue_shrink(term) = tex_fract(glue_shrink(term), numerator, factor, max_dimen);
+ break;
+ }
+ break;
+ case expression_idivide:
+ /*tex Here we divide the term |t| by the factor |f| but we don't round. */
+ if (level < glue_val_level) {
+ term = tex_aux_quotient(term, factor, 0);
+ } else {
+ glue_amount(term) = tex_aux_quotient(glue_amount(term), factor, 0);
+ glue_stretch(term) = tex_aux_quotient(glue_stretch(term), factor, 0);
+ glue_shrink(term) = tex_aux_quotient(glue_shrink(term), factor, 0);
+ }
+ break;
+ }
+ if (operation > expression_subtract) {
+ state = operation;
+ } else {
+ /*tex
+ Evaluate the current expression. When a term |t| has been completed it is copied to,
+ added to, or subtracted from the expression |e|.
+ */
+ state = expression_none;
+ if (result == expression_none) {
+ expression = term;
+ } else {
+ switch (level) {
+ case int_val_level:
+ case attr_val_level:
+ expression = tex_aux_add_or_sub(expression, term, infinity, result);
+ break;
+ case dimen_val_level:
+ expression = tex_aux_add_or_sub(expression, term, max_dimen, result);
+ break;
+ default :
+ /*tex
+ Compute the sum or difference of two glue specs. We know that |stretch_order
+ (e) > normal| implies |stretch (e) <> 0| and |shrink_order (e) > normal|
+ implies |shrink (e) <> 0|.
+ */
+ glue_amount(expression) = tex_aux_add_or_sub(glue_amount(expression), glue_amount(term), max_dimen, result);
+ if (glue_stretch_order(expression) == glue_stretch_order(term)) {
+ glue_stretch(expression) = tex_aux_add_or_sub(glue_stretch(expression), glue_stretch(term), max_dimen, result);
+ } else if ((glue_stretch_order(expression) < glue_stretch_order(term)) && (glue_stretch(term) != 0)) {
+ glue_stretch(expression) = glue_stretch(term);
+ glue_stretch_order(expression) = glue_stretch_order(term);
+ }
+ if (glue_shrink_order(expression) == glue_shrink_order(term)) {
+ glue_shrink(expression) = tex_aux_add_or_sub(glue_shrink(expression), glue_shrink(term), max_dimen, result);
+ } else if ((glue_shrink_order(expression) < glue_shrink_order(term)) && (glue_shrink(term) != 0)) {
+ glue_shrink(expression) = glue_shrink(term);
+ glue_shrink_order(expression) = glue_shrink_order(term);
+ }
+ tex_flush_node(term);
+ tex_aux_normalize_glue(expression);
+ break;
+ }
+ }
+ result = operation;
+ }
+ error_b = lmt_scanner_state.arithmic_error;
+ if (operation != expression_none) {
+ goto CONTINUE;
+ } else if (top) {
+ /*tex Pop the expression stack and |goto found|. */
+ halfword t = top;
+ top = node_next(top);
+ factor = expression;
+ expression = expression_expression(t);
+ term = expression_term(t);
+ numerator = expression_numerator(t);
+ state = expression_state(t);
+ result = expression_result(t);
+ level = expression_type(t);
+ tex_free_node(t, expression_node_size);
+ goto FOUND;
+ } else if (error_b) {
+ tex_handle_error(
+ normal_error_type,
+ "Arithmetic overflow",
+ "I can't evaluate this expression, since the result is out of range."
+ );
+ if (level >= glue_val_level) {
+ tex_reset_glue_to_zero(expression);
+ } else {
+ expression = 0;
+ }
+ }
+ lmt_scanner_state.arithmic_error = error_a;
+ lmt_scanner_state.expression_depth--;
+ cur_val_level = level;
+ cur_val = expression;
+}
+
+/*tex
+
+ Already early in \LUAMETATEX\ I wondered about adding suypport for boolean expressions but at
+ that time (2019) I still wanted it as part of \type |\numexpr|. I added some code that actually
+ worked okay, but kept it commented. After all, we don't need it that often and \CONTEXT\ has
+ helpers for it so it's best to avoid the extra overhead in other expressions.
+
+ However, occasionally, when I check the manual I came back to this. I wondered about some more
+ that just extra bitwise operators. However, prcedence makes it a bit tricky. Also, we can't use
+ some characters because they can be letter, other, active or have special meaning in math or
+ alignments. Then I played with verbose operators: mod (instead of a percent sign), and
+ |and|, |or|, |band|, |bor| and |bxor| (cf the \LUA\ bit32 library).
+
+ In the end I decided not to integrate it but make a dedicated |\bitexpr| instead. I played with
+ some variants but the approach in the normal expression scanned is not really suitable for it.
+
+ In the end, after some variations, I decided that some reverse polish notation approach made
+ more sense and when considering an infix to rpn translation and searching the web a bit I ran
+ into nice example:
+
+ https://github.com/chidiwilliams/expression-evaluator/blob/main/simple.js
+
+ It shows how to handled the nested expressions. I made a comaprable variant in \LUA, extended
+ it for more than the usual four operators, condensed it a bit and then went on to write the code
+ below. Of course we have a completely different token parser and we use \TEX\ (temp) nodes for
+ a few stacks. I know that we can combine the loops but that becomes messy and performance is
+ quite okay, also because we move items from one to another stack with little overhead. Although
+ stacks are not that large, using static sized stacks (\CCODE\ arrays) makes no sense here.
+
+ After the initial |\bitexpr| I eventually ended up with an integer and dimension scanner and
+ it became more complex that originally intended, but the current implementaiton is flexible
+ enough to extend. I can probably squeeze out some more performance.
+
+ Beware: details can change, for instance handling some (math) \UNICODE\ characters has been
+ dropped because it's an inconsistent bunch and incomplete anyway.
+
+ In the end we have a set of dedicated scanners. We could use the existing ones but for instance
+ units are optional here. We also have a bit more predictable sentinel, so we can optimize some
+ push back. We don't handle mu units nor fillers. It was also kind of fun to explore that.
+
+*/
+
+typedef enum bit_expression_states {
+ bit_expression_none,
+
+ bit_expression_bor, /* | bor v */
+ bit_expression_band, /* & band */
+ bit_expression_bxor, /* ^ bxor */
+
+ bit_expression_bset, /* bset */
+ bit_expression_bunset, /* bunset */
+
+ bit_expression_bleft, /* << */
+ bit_expression_bright, /* >> */
+
+ bit_expression_less, /* < */
+ bit_expression_lessequal, /* <= */
+ bit_expression_equal, /* = == */
+ bit_expression_moreequal, /* >= */
+ bit_expression_more, /* > */
+ bit_expression_unequal, /* <> != */
+
+ bit_expression_add, /* + */
+ bit_expression_subtract, /* - */
+
+ bit_expression_multiply, /* * */
+ bit_expression_divide, /* / : */
+
+ bit_expression_mod, /* % mod */
+
+ // bit_expression_power, /* */
+
+ bit_expression_not, /* ! ~ not */
+
+ bit_expression_or, /* or */
+ bit_expression_and, /* and */
+
+ bit_expression_open,
+ bit_expression_close,
+
+ bit_expression_number,
+ bit_expression_float,
+ bit_expression_dimension,
+} bit_expression_states;
+
+
+static int bit_operator_precedence[] = { /* like in lua */
+ 0, // bit_expression_none
+ 4, // bit_expression_bor
+ 6, // bit_expression_band
+ 5, // bit_expression_bxor
+
+ 7, // bit_expression_bset // like shifts
+ 7, // bit_expression_bunset // like shifts
+
+ 7, // bit_expression_bleft
+ 7, // bit_expression_bright
+
+ 3, // bit_expression_less
+ 3, // bit_expression_lessequal
+ 3, // bit_expression_equal
+ 3, // bit_expression_more
+ 3, // bit_expression_moreequal
+ 3, // bit_expression_unequal
+
+ 8, // bit_expression_add
+ 8, // bit_expression_subtract
+
+ 9, // bit_expression_multiply
+ 9, // bit_expression_divide
+
+ 9, // bit_expression_mod
+
+// 10, // bit_expression_power
+
+ 10, // bit_expression_not
+
+ 1, // bit_expression_or
+ 2, // bit_expression_and
+
+ 0, // bit_expression_open
+ 0, // bit_expression_close
+
+ 0, // bit_expression_number
+ 0,
+ 0,
+};
+
+static const char *bit_expression_names[] = {
+ "none", "bor", "band", "bxor", "bset", "bunset",
+ "<<", ">>", "<", "<=", "==", ">=", ">", "<>",
+ "+", "-", "*", "/", "mod", "not", "or", "and",
+ "open", "close", "number", "float", "dimension"
+};
+
+/*tex
+ This way we stay within the regular tex accuracy with 1000 scales. But I will play with a
+ variant that only uses doubles: |dimenexpression| and |numberexpression|.
+*/
+
+# define factor 1000
+
+typedef struct stack_info {
+ halfword head;
+ halfword tail;
+} stack_info;
+
+static stack_info tex_aux_new_stack(void)
+{
+ return (stack_info) {
+ .head = null,
+ .tail = null,
+ };
+}
+
+static void tex_aux_dispose_stack(stack_info *stack)
+{
+ /*tex Unless we have a problem we have stacks with zero or one slot. */
+ halfword current = stack->head;
+ while (current) {
+ halfword next = node_next(current);
+ tex_free_node(current, expression_node_size);
+ current = next;
+ }
+}
+
+static void tex_push_stack_entry(stack_info *stack, long long value)
+{
+ halfword n = tex_get_node(expression_node_size);
+ node_type(n) = expression_node;
+ node_subtype(n) = 0;
+ expression_entry(n) = value;
+ if (! stack->head) {
+ stack->head = n;
+ } else if (stack->head == stack->tail) {
+ node_next(stack->head) = n;
+ node_prev(n) = stack->head;
+ } else {
+ node_prev(n) = stack->tail;
+ node_next(stack->tail) = n;
+ }
+ stack->tail = n;
+}
+
+static long long tex_pop_stack_entry(stack_info *stack)
+{
+ halfword t = stack->tail;
+ if (t) {
+ long long v = expression_entry(t);
+ if (t == stack->head) {
+ stack->head = null;
+ stack->tail = null;
+ } else {
+ stack->tail = node_prev(t);
+ node_next(stack->tail) = null;
+ }
+ tex_free_node(t, temp_node_size);
+ return v;
+ } else {
+ return 0;
+ }
+}
+
+static void tex_move_stack_entry(stack_info *target, stack_info *source)
+{
+ halfword n = source->tail;
+ if (n == source->head) {
+ source->head = null;
+ source->tail = null;
+ } else {
+ source->tail = node_prev(n);
+ }
+ if (! target->head) {
+ target->head = n;
+ node_prev(n) = null;
+ } else if (target->head == target->tail) {
+ node_next(target->head) = n;
+ node_prev(n) = target->head;
+ } else {
+ node_prev(n) = target->tail;
+ node_next(target->tail) = n;
+ }
+ target->tail = n;
+}
+
+static void tex_take_stack_entry(stack_info *target, stack_info *source, halfword current)
+{
+ while (source->head != current) {
+ halfword next = node_next(source->head);
+ tex_free_node(source->head, temp_node_size);
+ source->head = next;
+ }
+ if (current == source->tail) {
+ source->head = null;
+ source->tail = null;
+ } else {
+ source->head = node_next(current);
+ }
+ if (! target->head) {
+ target->head = current;
+ node_prev(current) = null;
+ } else if (target->head == target->tail) {
+ node_next(target->head) = current;
+ node_prev(current) = target->head;
+ } else {
+ node_prev(current) = target->tail;
+ node_next(target->tail) = current;
+ }
+ target->tail = current;
+ node_next(current) = null;
+}
+
+static halfword tex_aux_scan_unit_applied(halfword value, halfword fraction, int has_fraction, int *has_unit)
+{
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ halfword saved_val = value;
+ value = tex_aux_scan_something_internal(cur_cmd, cur_chr, dimen_val_level, 0, 0);
+ value = tex_nx_plus_y(saved_val, cur_val, tex_xn_over_d(cur_val, fraction, 0200000));
+ return value;
+ } else if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ halfword num = 0;
+ halfword denom = 0;
+ halfword saved_cs = cur_cs;
+ halfword saved_tok = cur_tok;
+ *has_unit = 1;
+ switch (cur_chr) {
+ case 'p': case 'P':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 't': case 'T':
+ goto NORMALUNIT;
+ case 'c': case 'C':
+ num = 12;
+ denom = 1;
+ goto NORMALUNIT;
+ case 'x': case 'X':
+ return tex_nx_plus_y(value, px_dimen_par, tex_xn_over_d(px_dimen_par, fraction, 0200000));
+ }
+ }
+ break;
+ case 'c': case 'C':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'm': case 'M':
+ num = 7227;
+ denom = 254;
+ goto NORMALUNIT;
+ case 'c': case 'C':
+ num = 14856;
+ denom = 1157;
+ goto NORMALUNIT;
+ }
+ }
+ break;
+ case 's': case 'S':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'p': case 'P':
+ return scaled_point_scanned;
+ }
+ }
+ break;
+ case 'b': case 'B':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'p': case 'P':
+ num = 7227;
+ denom = 7200;
+ goto NORMALUNIT;
+ }
+ }
+ break;
+ case 'i': case 'I':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'n': case 'N':
+ num = 7227;
+ denom = 100;
+ goto NORMALUNIT;
+ }
+ }
+ break;
+ case 'd': case 'D':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'd': case 'D':
+ num = 1238;
+ denom = 1157;
+ goto NORMALUNIT;
+ }
+ }
+ break;
+ case 'e': case 'E':
+ tex_get_x_token();
+ if (cur_cmd == letter_cmd || cur_cmd == other_char_cmd) {
+ switch (cur_chr) {
+ case 'm': case 'M':
+ return tex_get_scaled_em_width(cur_font_par);
+ case 'x': case 'X':
+ return tex_get_scaled_ex_height(cur_font_par);
+ }
+ }
+ break;
+ default:
+ goto HALFUNIT;
+ }
+ goto NOUNIT;
+ NORMALUNIT:
+ if (num) {
+ int remainder = 0;
+ value = tex_xn_over_d_r(value, num, denom, &remainder);
+ fraction = (num * fraction + 0200000 * remainder) / denom;
+ value += fraction / 0200000;
+ fraction = fraction % 0200000;
+ }
+ if (value >= 040000) { // 0x4000
+ lmt_scanner_state.arithmic_error = 1;
+ } else {
+ value = value * unity + fraction;
+ }
+ return value;
+ NOUNIT:
+ tex_back_input(cur_tok);
+ HALFUNIT:
+ tex_back_input(saved_tok);
+ cur_cs = saved_cs;
+ cur_tok = saved_tok;
+ } else {
+ tex_back_input(cur_tok);
+ }
+ if (has_fraction) {
+ *has_unit = 0;
+ if (value >= 040000) { // 0x4000
+ lmt_scanner_state.arithmic_error = 1;
+ } else {
+ value = value * unity + fraction;
+ }
+ }
+ return value;
+}
+
+static halfword tex_scan_bit_int(int *radix)
+{
+ int negative = 0;
+ long long result = 0;
+ do {
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ cur_tok = plus_token;
+ }
+ } while (cur_tok == plus_token);
+ if (cur_tok == alpha_token) {
+ tex_get_token();
+ if (cur_tok < cs_token_flag) {
+ result = cur_chr;
+ } else {
+ strnumber txt = cs_text(cur_tok - cs_token_flag);
+ if (tex_single_letter(txt)) {
+ result = aux_str2uni(str_string(txt));
+ } else if (tex_is_active_cs(txt)) {
+ result = active_cs_value(txt);
+ } else {
+ result = max_character_code + 1;
+ }
+ }
+ if (result > max_character_code) {
+ result = '0'; /*tex Why not just 0. */
+ tex_aux_improper_constant_error();
+ }
+ } else if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ result = tex_aux_scan_something_internal(cur_cmd, cur_chr, int_val_level, 0, 0);
+ if (cur_val_level != int_val_level) {
+ result = 0;
+ goto NONUMBER;
+ }
+ } else if (cur_cmd == math_style_cmd) {
+ result = (cur_chr == yet_unset_math_style) ? tex_scan_math_style_identifier(0, 0) : cur_chr;
+ } else if (cur_cmd == hyphenation_cmd) {
+ if (tex_aux_scan_hyph_data_number(cur_chr, &cur_chr)) {
+ result = cur_chr;
+ } else {
+ result = 0;
+ goto NONUMBER;
+ }
+ } else {
+ int vacuous = 1;
+ int ok_so_far = 1;
+ switch (cur_tok) {
+ case octal_token:
+ {
+ if (radix) {
+ *radix = 8;
+ }
+ while (1) {
+ tex_get_x_token();
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= seven_token)) {
+ d = cur_tok - zero_token;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ if (ok_so_far) {
+ result = result * 8 + d;
+ if (result > max_integer) {
+ result = infinity;
+ tex_aux_number_to_big_error();
+ ok_so_far = 0;
+ }
+ }
+ }
+ break;
+ }
+ case hex_token:
+ {
+ if (radix) {
+ *radix = 16;
+ }
+ while (1) {
+ tex_get_x_token();
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= nine_token)) {
+ d = cur_tok - zero_token;
+ } else if ((cur_tok >= A_token_l) && (cur_tok <= F_token_l)) {
+ d = cur_tok - A_token_l + 10;
+ } else if ((cur_tok >= A_token_o) && (cur_tok <= F_token_o)) {
+ d = cur_tok - A_token_o + 10;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ if (ok_so_far) {
+ result = result * 16 + d;
+ if (result > max_integer) {
+ result = infinity;
+ tex_aux_number_to_big_error();
+ ok_so_far = 0;
+ }
+ }
+ }
+ break;
+ }
+ default:
+ {
+ if (radix) {
+ *radix = 10;
+ }
+ while (1) {
+ unsigned d = 0;
+ if ((cur_tok >= zero_token) && (cur_tok <= nine_token)) {
+ d = cur_tok - zero_token;
+ } else {
+ goto DONE;
+ }
+ vacuous = 0;
+ if (ok_so_far) {
+ result = result * 10 + d;
+ if (result > max_integer) {
+ result = infinity;
+ tex_aux_number_to_big_error();
+ ok_so_far = 0;
+ }
+ }
+ tex_get_x_token();
+ }
+ break;
+ }
+ }
+ DONE:
+ if (vacuous) {
+ NONUMBER:
+ tex_aux_missing_number_error();
+ } else {
+ tex_push_back(cur_tok, cur_cmd, cur_chr);
+ }
+ }
+ cur_val = (halfword) (negative ? - result : result);
+ return cur_val;
+}
+
+static halfword tex_scan_bit_dimen(int *has_fraction, int *has_unit)
+{
+ int negative = 0;
+ int fraction = 0;
+ *has_fraction = 0;
+ *has_unit = 1;
+ lmt_scanner_state.arithmic_error = 0;
+ do {
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ cur_tok = plus_token;
+ }
+ } while (cur_tok == plus_token);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ cur_val = tex_aux_scan_something_internal(cur_cmd, cur_chr, int_val_level, 0, 0);
+ if (cur_val_level == dimen_val_level) {
+ goto ATTACH_SIGN;
+ }
+ } else {
+ *has_fraction = tex_token_is_seperator(cur_tok);
+ if (*has_fraction) {
+ /*tex We started with a |.| or |,|. */
+ cur_val = 0;
+ } else {
+ int cur_radix = 10;
+ cur_val = tex_scan_bit_int(&cur_radix);
+ if (cur_radix == 10 && tex_token_is_seperator(cur_tok)) {
+ *has_fraction = 1;
+ tex_get_token();
+ }
+ }
+ if (*has_fraction) {
+ unsigned k = 0;
+ unsigned char digits[18];
+ while (1) {
+ tex_get_x_token();
+ if (cur_tok > nine_token || cur_tok < zero_token) {
+ break;
+ } else if (k < 17) {
+ digits[k] = (unsigned char) (cur_tok - zero_token);
+ ++k;
+ }
+ }
+ fraction = tex_round_decimals_digits(digits, k);
+ if (cur_cmd != spacer_cmd) {
+ /* we can avoid this when parsing a unit but not now */
+ tex_back_input(cur_tok);
+ }
+ }
+ }
+ if (cur_val < 0) {
+ negative = ! negative;
+ cur_val = - cur_val;
+ }
+ cur_val = tex_aux_scan_unit_applied(cur_val, fraction, *has_fraction, has_unit);
+ ATTACH_SIGN:
+ if (lmt_scanner_state.arithmic_error || (abs(cur_val) >= 010000000000)) { // 0x40000000
+ tex_aux_scan_dimen_out_of_range_error();
+ cur_val = max_dimen;
+ lmt_scanner_state.arithmic_error = 0;
+ }
+ if (negative) {
+ cur_val = -cur_val;
+ }
+ return cur_val;
+}
+
+static void tex_aux_trace_expression(stack_info stack, halfword level, halfword n, int what)
+{
+ tex_begin_diagnostic();
+ if (n > 0) {
+ tex_print_format(level == dimen_val_level ? "[dimexpression rpn %i %s:" : "[numexpression rpn %i %s:", n, what ? "r" :"s");
+ if (! stack.head) {
+ tex_print_char(' ');
+ }
+ } else {
+ tex_print_str(level == dimen_val_level ? "[dimexpression rpn:" : "[numexpression rpn:");
+ }
+ for (halfword current = stack.head; current; current = node_next(current)) {
+ tex_print_char(' ');
+ switch (node_subtype(current)) {
+ case bit_expression_number:
+ tex_print_int(scaledround((double) expression_entry(current) / factor));
+ break;
+ case bit_expression_float:
+ tex_print_dimension(scaledround((double) expression_entry(current) / factor), no_unit);
+ break;
+ case bit_expression_dimension:
+ tex_print_char('(');
+ tex_print_dimension(scaledround((double) expression_entry(current) / factor), no_unit);
+ tex_print_char(')');
+ break;
+ default:
+ tex_print_str(bit_expression_names[expression_entry(current)]);
+ break;
+ }
+ }
+ tex_print_char(']');
+ tex_end_diagnostic();
+}
+
+static void tex_aux_scan_expression(int level)
+{
+ stack_info operators = tex_aux_new_stack();
+ stack_info reverse = tex_aux_new_stack();
+ stack_info stack = tex_aux_new_stack();
+ halfword operation = bit_expression_none;
+ int alreadygotten = 0;
+ int trace = tracing_expressions_par;
+ while (1) {
+ if (alreadygotten) {
+ alreadygotten= 0;
+ } else {
+ tex_get_x_token();
+ }
+ operation = bit_expression_none;
+ switch (cur_cmd) {
+ case relax_cmd:
+ goto COLLECTED;
+ case spacer_cmd:
+ continue;
+ case superscript_cmd:
+ switch (cur_chr) {
+ case '^':
+ operation = bit_expression_bxor;
+ goto OKAY;
+ }
+ goto UNEXPECTED;
+ case alignment_tab_cmd:
+ switch (cur_chr) {
+ case '&':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ case alignment_tab_cmd:
+ switch (cur_chr) {
+ case '&':
+ operation = bit_expression_and;
+ goto OKAY;
+ default:
+ operation = bit_expression_band;
+ alreadygotten = 1;
+ goto OKAY;
+ }
+ }
+ }
+ goto UNEXPECTED;
+ case letter_cmd:
+ case other_char_cmd:
+ switch (cur_chr) {
+ case '(':
+ tex_push_stack_entry(&operators, bit_expression_open);
+ continue;
+ case ')':
+ while (operators.tail && expression_entry(operators.tail) != bit_expression_open) {
+ tex_move_stack_entry(&reverse, &operators);
+ }
+ tex_pop_stack_entry(&operators);
+ continue;
+ case '+':
+ operation = bit_expression_add;
+ break;
+ case '-':
+ operation = bit_expression_subtract;
+ break;
+ case '*':
+ operation = bit_expression_multiply;
+ break;
+ case '/':
+ case ':':
+ operation = bit_expression_divide;
+ break;
+ case '%':
+ operation = bit_expression_mod;
+ break;
+ case '&':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ case alignment_tab_cmd:
+ switch (cur_chr) {
+ case '&':
+ operation = bit_expression_and;
+ goto OKAY;
+ }
+ }
+ operation = bit_expression_band;
+ alreadygotten = 1;
+ break;
+ case '^':
+ operation = bit_expression_bxor;
+ break;
+ case 'v':
+ operation = bit_expression_bor;
+ break;
+ case '|':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ switch (cur_chr) {
+ case '|':
+ operation = bit_expression_or;
+ goto OKAY;
+ }
+ }
+ operation = bit_expression_bor;
+ alreadygotten = 1;
+ break;
+ case '<':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ switch (cur_chr) {
+ case '<':
+ operation = bit_expression_bleft;
+ goto OKAY;
+ case '=':
+ operation = bit_expression_lessequal;
+ goto OKAY;
+ case '>':
+ operation = bit_expression_unequal;
+ goto OKAY;
+ }
+ }
+ operation = bit_expression_less;
+ alreadygotten = 1;
+ break;
+ case '>':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ switch (cur_chr) {
+ case '>':
+ operation = bit_expression_bright;
+ goto OKAY;
+ case '=':
+ operation = bit_expression_moreequal;
+ goto OKAY;
+ }
+ }
+ operation = bit_expression_more;
+ alreadygotten = 1;
+ break;
+ case '=':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ switch (cur_chr) {
+ case '=':
+ break;
+ default:
+ alreadygotten = 1;
+ break;
+ }
+ }
+ operation = bit_expression_equal;
+ break;
+ case '~': case '!':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ switch (cur_chr) {
+ case '=':
+ operation = bit_expression_unequal;
+ goto OKAY;
+ }
+ }
+ operation = bit_expression_not;
+ alreadygotten = 1;
+ break;
+ case 'm': case 'M':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'o': case 'O':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'd': case 'D':
+ operation = bit_expression_mod;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ goto UNEXPECTED;
+ case 'n': case 'N':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'o': case 'O':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'o': case 'T':
+ operation = bit_expression_not;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ goto UNEXPECTED;
+ case 'a': case 'A':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'n': case 'N':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'd': case 'D':
+ operation = bit_expression_and;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ goto UNEXPECTED;
+ case 'b': case 'B':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd:
+ switch (cur_chr) {
+ case 'a': case 'A':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'n': case 'N':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'd': case 'D':
+ operation = bit_expression_band;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ break;
+ case 'o': case 'O':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'r': case 'R':
+ operation = bit_expression_bor;
+ goto OKAY;
+ }
+ }
+ break;
+ case 'x': case 'X':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'o': case 'O':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'r': case 'R':
+ operation = bit_expression_bxor;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ break;
+ case 's': case 'S':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'e': case 'S':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 't': case 'T':
+ operation = bit_expression_bset;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ break;
+ case 'r': case 'R':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'e': case 'E':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 's': case 'S':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'e': case 'S':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 't': case 'T':
+ operation = bit_expression_bset;
+ goto OKAY;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ break;
+ }
+ }
+ goto UNEXPECTED;
+ case 'o': case 'O':
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd: case other_char_cmd: switch (cur_chr) { case 'r': case 'R':
+ operation = bit_expression_or;
+ goto OKAY;
+ }
+ }
+ goto UNEXPECTED;
+ default:
+ goto NUMBER;
+ }
+ OKAY:
+ while (operators.tail && bit_operator_precedence[expression_entry(operators.tail)] >= bit_operator_precedence[operation]) {
+ // tex_push_stack_entry(&reverse, tex_pop_stack_entry(&operators));
+ tex_move_stack_entry(&reverse, &operators);
+ }
+ tex_push_stack_entry(&operators, operation);
+ break;
+ default:
+ NUMBER:
+ /*tex These use |cur_tok|: */
+ {
+ int has_fraction = 0;
+ int has_unit = 1;
+ operation = level == dimen_val_level ? tex_scan_bit_dimen(&has_fraction, &has_unit) : tex_scan_bit_int(NULL);
+ tex_push_stack_entry(&reverse, operation * factor);
+ if (level == dimen_val_level && has_unit) {
+ node_subtype(reverse.tail) = bit_expression_dimension;
+ } else if (has_fraction) {
+ node_subtype(reverse.tail) = bit_expression_float;
+ } else {
+ node_subtype(reverse.tail) = bit_expression_number;
+ }
+ continue;
+ }
+ }
+ }
+ COLLECTED:
+ while (operators.tail) {
+ tex_move_stack_entry(&reverse, &operators);
+ }
+ /*tex This is the reference: */
+ /*
+ {
+ halfword current = reverse.head;
+ while (current) {
+ if (node_subtype(current) == bit_expression_number) {
+ tex_push_stack_entry(&stack, expression_entry(current));
+ } else {
+ halfword token = expression_entry(current);
+ long long v;
+ if (token == bit_expression_not) {
+ v = ~ (long long) tex_pop_stack_entry(&stack);
+ } else {
+ long long b = (long long) tex_pop_stack_entry(&stack);
+ long long a = (long long) tex_pop_stack_entry(&stack);
+ switch (token) {
+ // calculations, see below
+ }
+ }
+ // checks, see below
+ tex_push_stack_entry(&stack, (halfword) v);
+ }
+ current = node_next(current);
+ }
+ }
+ */
+ if (trace == 1) {
+ tex_aux_trace_expression(reverse, level, 0, 0);
+ }
+ {
+ halfword current = reverse.head;
+ int step = 0;
+ while (current) {
+ halfword next = node_next(current);
+ halfword subtype = node_subtype(current);
+ if (trace > 1) {
+ step = step + 1;
+ tex_aux_trace_expression(reverse, level, step, 0);
+ tex_aux_trace_expression(stack, level, step, 1);
+ }
+ switch (subtype) {
+ case bit_expression_number:
+ case bit_expression_float:
+ case bit_expression_dimension:
+ tex_take_stack_entry(&stack, &reverse, current);
+ break;
+ default:
+ {
+ halfword token = (halfword) expression_entry(current);
+ long long v = 0;
+ if (token == bit_expression_not) {
+ v =~ stack.tail ? expression_entry(stack.tail) : 0;
+ } else {
+ quarterword sa, sb;
+ long long va, vb;
+ sb = node_subtype(stack.tail);
+ vb = tex_pop_stack_entry(&stack);
+ if (stack.tail) {
+ sa = node_subtype(stack.tail);
+ va = expression_entry(stack.tail);
+ } else {
+ sa = bit_expression_number;
+ va = 0;
+ }
+ switch (token) {
+ case bit_expression_bor:
+ v = va | vb;
+ break;
+ case bit_expression_band:
+ v = va & vb;
+ break;
+ case bit_expression_bxor:
+ v = va ^ vb;
+ break;
+ case bit_expression_bset:
+ v = va | ((long long) 1 << (vb - 1));
+ break;
+ case bit_expression_bunset:
+ v = va & ~ ((long long) 1 << (vb - 1));
+ break;
+ case bit_expression_bleft:
+ v = va << vb;
+ break;
+ case bit_expression_bright:
+ v = va >> vb;
+ break;
+ case bit_expression_less:
+ v = va < vb;
+ break;
+ case bit_expression_lessequal:
+ v = va <= vb;
+ break;
+ case bit_expression_equal:
+ v = va == vb;
+ break;
+ case bit_expression_moreequal:
+ v = va >= vb;
+ break;
+ case bit_expression_more:
+ v = va > vb;
+ break;
+ case bit_expression_unequal:
+ v = va != vb;
+ break;
+ case bit_expression_add:
+ v = va + vb;
+ break;
+ case bit_expression_subtract:
+ v = va - vb;
+ break;
+ case bit_expression_multiply:
+ {
+ double d = va * vb;
+ if (sa == bit_expression_float) {
+ d = d / (65536 * factor);
+ } else if (sb == bit_expression_float) {
+ d = d / (65536 * factor);
+ } else {
+ d = d / factor;
+ }
+ if (sa == bit_expression_dimension || sb == bit_expression_dimension) {
+ node_subtype(stack.tail) = bit_expression_dimension;
+ }
+ v = longlonground(d);
+ }
+ break;
+ case bit_expression_divide:
+ if (vb) {
+ double d = (double) va / (double) vb;
+ if (sa == bit_expression_float) {
+ // d = d / (65536 * factor);
+ d = d * (65536 * factor);
+ } else if (sb == bit_expression_float) {
+ // d = d / (65536 * factor);
+ d = d * (65536 * factor);
+ } else {
+ d = d * factor;
+ }
+ if (sa == bit_expression_dimension || sb == bit_expression_dimension) {
+ node_subtype(stack.tail) = bit_expression_dimension;
+ }
+ v = longlonground(d);
+ } else {
+ goto ZERO;
+ }
+ break;
+ case bit_expression_mod:
+ v = va % vb;
+ break;
+ case bit_expression_or:
+ v = (va || vb) ? 1 : 0;
+ break;
+ case bit_expression_and:
+ v = (va && vb) ? 1 : 0; break;
+ default:
+ v = 0;
+ break;
+ }
+ }
+ if (v < -infinity) {
+ v = -infinity;
+ } else if (v > infinity) {
+ v = infinity;
+ }
+ expression_entry(stack.tail) = v;
+ break;
+ }
+ }
+ current = next;
+ }
+ }
+ goto DONE;
+ ZERO:
+ tex_handle_error(
+ back_error_type,
+ "I can't divide by zero",
+ "I was expecting to see a nonzero number. Didn't."
+ );
+ goto DONE;
+ UNEXPECTED:
+ tex_handle_error(
+ back_error_type,
+ "Premature end of bit expression",
+ "I was expecting to see an integer or bitwise operator. Didn't."
+ );
+ DONE:
+ cur_val = scaledround(((double) expression_entry(stack.tail)) / factor);
+ cur_val_level = level;
+ tex_aux_dispose_stack(&stack);
+ tex_aux_dispose_stack(&reverse);
+ tex_aux_dispose_stack(&operators);
+}
+
+int tex_scanned_expression(int level)
+{
+ tex_aux_scan_expression(level);
+ return cur_val;
+}
+
+/* */
+
+halfword tex_scan_scale(int optional_equal)
+{
+ int negative = 0;
+ lmt_scanner_state.arithmic_error = 0;
+ do {
+ while (1) {
+ tex_get_x_token();
+ if (cur_cmd != spacer_cmd) {
+ if (optional_equal && (cur_tok == equal_token)) {
+ optional_equal = 0;
+ } else {
+ break;
+ }
+ }
+ }
+ if (cur_tok == minus_token) {
+ negative = ! negative;
+ cur_tok = plus_token;
+ }
+ } while (cur_tok == plus_token);
+ if (cur_cmd >= min_internal_cmd && cur_cmd <= max_internal_cmd) {
+ cur_val = tex_aux_scan_something_internal(cur_cmd, cur_chr, int_val_level, 0, 0);
+ } else {
+ int has_fraction = tex_token_is_seperator(cur_tok);
+ if (has_fraction) {
+ cur_val = 0;
+ } else {
+ int cur_radix;
+ tex_back_input(cur_tok);
+ cur_val = tex_scan_int(0, &cur_radix);
+ tex_get_token();
+ if (cur_radix == 10 && tex_token_is_seperator(cur_tok)) {
+ has_fraction = 1;
+ }
+ }
+ if (has_fraction) {
+ unsigned k = 4;
+ cur_val = cur_val * 1000;
+ while (1) {
+ tex_get_x_token();
+ if (cur_tok < zero_token || cur_tok > nine_token) {
+ break;
+ } else if (k == 1) {
+ /* rounding */
+ if (cur_tok >= five_token && cur_tok <= nine_token) {
+ cur_val += 1;
+ }
+ --k;
+ } else if (k) {
+ cur_val = cur_val + (k == 4 ? 100 : (k == 3 ? 10 : 1)) * (cur_tok - zero_token);
+ --k;
+ }
+ }
+ }
+ tex_push_back(cur_tok, cur_cmd, cur_chr);
+ }
+ if (negative) {
+ cur_val = -cur_val;
+ }
+ if (lmt_scanner_state.arithmic_error || (abs(cur_val) >= 0x40000000)) {
+ // scan_dimen_out_of_range_error();
+ cur_val = max_dimen;
+ lmt_scanner_state.arithmic_error = 0;
+ }
+ return cur_val;
+}
+
+int tex_scan_tex_value(halfword level, halfword *value)
+{
+ tex_aux_scan_expr(level);
+ *value = cur_val;
+ return 1;
+}
+
+quarterword tex_scan_direction(int optional_equal)
+{
+ int i = tex_scan_int(optional_equal, NULL);
+ return checked_direction_value(i);
+}
+
+halfword tex_scan_geometry(int optional_equal)
+{
+ int i = tex_scan_int(optional_equal, NULL);
+ return checked_geometry_value(i);
+}
+
+halfword tex_scan_orientation(int optional_equal)
+{
+ halfword i = tex_scan_int(optional_equal, NULL);
+ return checked_orientation_value(i);
+}
+
+halfword tex_scan_anchor(int optional_equal)
+{
+ halfword a = tex_scan_int(optional_equal, NULL);
+ halfword l = (a >> 16) & 0xFFFF;
+ halfword r = a & 0xFFFF;
+ return (checked_anchor_value(l) << 16) + checked_anchor_value(r);
+}
+
+halfword tex_scan_anchors(int optional_equal)
+{
+ halfword l = tex_scan_int(optional_equal, NULL) & 0xFFFF;
+ halfword r = tex_scan_int(0, NULL) & 0xFFFF;
+ return (checked_anchor_value(l) << 16) + checked_anchor_value(r);
+}
+
+halfword tex_scan_attribute(halfword attrlist)
+{
+ halfword i = tex_scan_toks_register_number();
+ halfword v = tex_scan_int(1, NULL);
+ if (eq_value(register_attribute_location(i)) != v) {
+ if (attrlist) {
+ attrlist = tex_patch_attribute_list(attrlist, i, v);
+ } else {
+ attrlist = tex_copy_attribute_list_set(tex_current_attribute_list(), i, v);
+ }
+ }
+ return attrlist;
+}
diff --git a/source/luametatex/source/tex/texscanning.h b/source/luametatex/source/tex/texscanning.h
new file mode 100644
index 000000000..90897bf54
--- /dev/null
+++ b/source/luametatex/source/tex/texscanning.h
@@ -0,0 +1,210 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_SCANNING_H
+# define LMT_SCANNING_H
+
+typedef enum value_level_code {
+ int_val_level, /*tex integer values */
+ attr_val_level, /*tex integer values */
+ dimen_val_level, /*tex dimension values */
+ glue_val_level, /*tex glue specifications */
+ mu_val_level, /*tex math glue specifications */
+ tok_val_level, /*tex token lists */
+ font_val_level , /*tex font identifier */
+ mathspec_val_level ,
+ fontspec_val_level ,
+ specification_val_level, /*tex special purpose identifier */
+ list_val_level,
+ no_val_level,
+} value_level_code;
+
+# define first_value_level int_val_level
+# define last_value_level mu_val_level
+
+typedef struct scanner_state_info {
+ int current_cmd; /*tex current command set by |get_next| */
+ halfword current_chr; /*tex operand of current command */
+ halfword current_cs; /*tex control sequence found here, zero if none found */
+ // halfword current_flag;
+ halfword current_tok; /*tex packed representative of |cur_cmd| and |cur_chr| */
+ int current_val; /*tex value returned by numeric scanners */
+ int current_val_level; /*tex the level of this value */
+ halfword current_box; /*tex the box to be placed into its context: */
+ halfword last_cs_name; /*tex used in |\csname| and |\ifcsname| */
+ int arithmic_error;
+ int expression_depth;
+} scanner_state_info;
+
+extern scanner_state_info lmt_scanner_state;
+
+/*tex
+ These are rather basic \TEX\ The Program variables (aliases) so for now we stick to the
+ unqualified short names.
+*/
+
+# define cur_cmd lmt_scanner_state.current_cmd
+# define cur_chr lmt_scanner_state.current_chr
+# define cur_cs lmt_scanner_state.current_cs
+# define cur_tok lmt_scanner_state.current_tok
+# define cur_val lmt_scanner_state.current_val
+# define cur_val_level lmt_scanner_state.current_val_level
+# define cur_box lmt_scanner_state.current_box
+
+typedef struct full_scanner_status {
+ int save_scanner_status;
+ halfword save_def_ref;
+ halfword save_warning_index;
+} full_scanner_status;
+
+inline static full_scanner_status tex_save_full_scanner_status(void)
+{
+ full_scanner_status a;
+ a.save_scanner_status = lmt_input_state.scanner_status;
+ a.save_def_ref = lmt_input_state.def_ref;
+ a.save_warning_index = lmt_input_state.warning_index;
+ return a;
+}
+
+inline static void tex_unsave_full_scanner_status(full_scanner_status a)
+{
+ lmt_input_state.warning_index = a.save_warning_index;
+ lmt_input_state.def_ref = a.save_def_ref;
+ lmt_input_state.scanner_status = a.save_scanner_status;
+}
+
+extern void tex_scan_something_simple (halfword cmd, halfword code);
+extern void tex_scan_left_brace (void);
+extern void tex_scan_optional_equals (void);
+extern int tex_scan_cardinal (unsigned *value, int dontbark);
+extern halfword tex_scan_int (int optional_equal, int *radix);
+extern halfword tex_scan_scale (int optional_equal);
+extern halfword tex_scan_dimen (int mu, int inf, int shortcut, int optional_equal, halfword *order);
+extern halfword tex_scan_glue (int level, int optional_equal);
+extern halfword tex_scan_font (int optional_equal);
+extern halfword tex_scan_general_text (halfword *tail);
+/* halfword tex_scan_toks (int macrodef, int xpand, int left_brace_found); */
+extern halfword tex_scan_toks_normal (int left_brace_found, halfword *tail);
+extern halfword tex_scan_toks_expand (int left_brace_found, halfword *tail, int expandconstant);
+extern halfword tex_scan_macro_normal (void); // (int tolerant);
+extern halfword tex_scan_macro_expand (void); // (int tolerant);
+extern halfword tex_scan_font_identifier (halfword *spec);
+extern halfword tex_scan_fontspec_identifier (void);
+extern halfword tex_scan_math_style_identifier (int tolerant, int styles);
+extern halfword tex_scan_math_parameter (void);
+extern halfword tex_scan_limited_scale (int optional_equal);
+extern halfword tex_scan_positive_scale (int optional_equal);
+
+extern quarterword tex_scan_direction (int optional_equal);
+extern halfword tex_scan_geometry (int optional_equal);
+extern halfword tex_scan_orientation (int optional_equal);
+extern halfword tex_scan_anchor (int optional_equal);
+extern halfword tex_scan_anchors (int optional_equal);
+
+extern int tex_scanned_expression (int level);
+
+extern halfword tex_scan_int_register_number (void);
+extern halfword tex_scan_dimen_register_number (void);
+extern halfword tex_scan_attribute_register_number (void);
+extern halfword tex_scan_glue_register_number (void);
+extern halfword tex_scan_mu_glue_register_number (void);
+extern halfword tex_scan_toks_register_number (void);
+extern halfword tex_scan_box_register_number (void);
+extern halfword tex_scan_mark_number (void);
+extern halfword tex_scan_char_number (int optional_equal);
+extern halfword tex_scan_math_char_number (void);
+extern halfword tex_scan_math_family_number (void);
+extern halfword tex_scan_math_class_number (int optional_equal);
+extern halfword tex_scan_math_properties_number (void);
+extern halfword tex_scan_math_group_number (void);
+extern halfword tex_scan_math_index_number (void);
+extern halfword tex_scan_math_discretionary_number (int optional_equal);
+extern halfword tex_scan_category_code (void);
+extern singleword tex_scan_box_index (void); /*tex For local boxes: small for now! */
+extern singleword tex_scan_box_axis (void);
+extern halfword tex_scan_function_reference (int optional_equal);
+extern halfword tex_scan_bytecode_reference (int optional_equal);
+
+extern halfword tex_the_value_toks (int unit, halfword *tail, halfword property); /* returns head */
+extern halfword tex_the_toks (int code, halfword *tail); /* returns head */
+extern halfword tex_the_detokenized_toks (halfword *head);
+extern strnumber tex_the_scanned_result (void);
+
+extern void tex_set_font_dimen (void);
+extern halfword tex_get_font_dimen (void);
+extern void tex_set_scaled_font_dimen (void);
+extern halfword tex_get_scaled_font_dimen (void);
+
+extern void tex_get_x_or_protected (void);
+
+extern int tex_fract (int x, int n, int d, int max_answer);
+
+extern halfword tex_scan_lua_value (int index);
+
+extern int tex_scan_tex_value (halfword level, halfword *value);
+
+extern halfword tex_scan_attribute (halfword attrlist);
+
+/*
+# define token_is_digit(t) ((t >= zero_token ) && (t <= nine_token ))
+# define token_is_xdigit(t) (((t >= zero_token ) && (t <= nine_token )) || \
+ ((t >= a_token_l ) && (t <= f_token_l )) || \
+ ((t >= A_token_l ) && (t <= F_token_l )) || \
+ ((t >= a_token_o ) && (t <= f_token_o )) || \
+ ((t >= A_token_o ) && (t <= F_token_o )))
+# define token_is_exponent(t) ((t == E_token_l ) || (t == e_token_l ) || \
+ (t == E_token_o ) || (t == e_token_o ))
+# define token_is_xexponent(t) ((t == P_token_l ) || (t == p_token_l ) || \
+ (t == P_token_o ) || (t == p_token_o ))
+# define token_is_hexadecimal(t) ((t == X_token_l ) || (t == x_token_l ) || \
+ (t == X_token_o ) || (t == x_token_o ))
+# define token_is_sign(t) ((t == minus_token ) || (t == plus_token ))
+# define token_is_seperator(t) ((t == period_token) || (t == comma_token))
+*/
+
+inline static int tex_token_is_digit(halfword t)
+{
+ return (t >= zero_token) && (t <= nine_token);
+}
+
+inline static int tex_token_is_xdigit(halfword t) {
+ return ((t >= zero_token) && (t <= nine_token))
+ || ((t >= a_token_l ) && (t <= f_token_l))
+ || ((t >= A_token_l ) && (t <= F_token_l))
+ || ((t >= a_token_o ) && (t <= f_token_o))
+ || ((t >= A_token_o ) && (t <= F_token_o));
+}
+
+inline static int tex_token_is_exponent(halfword t)
+{
+ return (t == E_token_l) || (t == e_token_l)
+ || (t == E_token_o) || (t == e_token_o);
+}
+
+inline static int tex_token_is_xexponent(halfword t)
+{
+ return (t == P_token_l) || (t == p_token_l)
+ || (t == P_token_o) || (t == p_token_o);
+}
+
+ inline static int tex_token_is_hexadecimal(halfword t)
+{
+ return (t == X_token_l) || (t == x_token_l)
+ || (t == X_token_o) || (t == x_token_o);
+}
+
+inline static int tex_token_is_sign(halfword t) {
+ return (t == minus_token) || (t == plus_token);
+}
+
+inline static int tex_token_is_seperator(halfword t) {
+ return (t == period_token) || (t == comma_token);
+}
+
+inline static int tex_token_is_operator(halfword t) {
+ return (t == plus_token) || (t == minus_token) || (t == asterisk_token) || (t == slash_token) || (t == colon_token);
+}
+
+# endif
+
diff --git a/source/luametatex/source/tex/texstringpool.c b/source/luametatex/source/tex/texstringpool.c
new file mode 100644
index 000000000..8367447da
--- /dev/null
+++ b/source/luametatex/source/tex/texstringpool.c
@@ -0,0 +1,607 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Control sequence names and diagnostic messages are variable length strings of eight bit
+ characters. Since \PASCAL\ did not have a well-developed string mechanism, \TEX\ did all of its
+ string processing by homegrown methods.
+
+ Elaborate facilities for dynamic strings are not needed, so all of the necessary operations can
+ be handled with a simple data structure. The array |str_pool| contains all of the (eight-bit)
+ bytes off all of the strings, and the array |str_start| contains indices of the starting points
+ of each string. Strings are referred to by integer numbers, so that string number |s| comprises
+ the characters |str_pool[j]| for |str_start_macro(s) <= j < str_start_macro (s + 1)|. Additional
+ integer variables |pool_ptr| and |str_ptr| indicate the number of entries used so far in
+ |str_pool| and |str_start|, respectively; locations |str_pool[pool_ptr]| and |str_start_macro
+ (str_ptr)| are ready for the next string to be allocated.
+
+ String numbers 0 to |biggest_char| are reserved for strings that correspond to single \UNICODE\
+ characters. This is in accordance with the conventions of \WEB\ which converts single-character
+ strings into the ASCII code number of the single character involved.
+
+ The stringpool variables are collected in:
+
+*/
+
+string_pool_info lmt_string_pool_state = {
+ .string_pool = NULL,
+ .string_pool_data = {
+ .minimum = min_pool_size,
+ .maximum = max_pool_size,
+ .size = siz_pool_size,
+ .step = stp_pool_size,
+ .allocated = 0,
+ .itemsize = sizeof(lstring),
+ .top = 0,
+ .ptr = 0,
+ .initial = 0,
+ .offset = cs_offset_value,
+ },
+ .string_body_data = {
+ .minimum = min_body_size,
+ .maximum = max_body_size,
+ .size = siz_body_size,
+ .step = stp_body_size,
+ .allocated = 0,
+ .itemsize = sizeof(unsigned char),
+ .top = memory_data_unset,
+ .ptr = memory_data_unset,
+ .initial = 0,
+ .offset = 0,
+ },
+ .reserved = 0,
+ .string_max_length = 0,
+ .string_temp = NULL,
+ .string_temp_allocated = 0,
+ .string_temp_top = 0,
+};
+
+/*tex
+
+ The array of strings is |string_pool|, the number of the current string being created is
+ |str_ptr|, the starting value of |str_ptr| is |init_str_ptr|, and the current string buffer,
+ the current index in that buffer, the mallocedsize of |cur_string| and the occupied byte count
+ are kept in |cur_string|, |cur_length|, |cur_string_size| and |pool_size|.
+
+ Once a sequence of characters has been appended to |cur_string|, it officially becomes a string
+ when the function |make_string| is called. This function returns the identification number of
+ the new string as its value.
+
+ Strings end with a zero character which makes \TEX\ string also valid \CCODE\ strings. The
+ |string_temp*| fields deal with a temporary string (building).
+
+ The |ptr| is always one ahead. This is kind of a safeguard: an overflow happens already when we
+ still assemble a new string.
+
+*/
+
+# define initial_temp_string_slots 256
+# define reserved_temp_string_slots 2
+
+static inline void tex_aux_increment_pool_string(int n)
+{
+ lmt_string_pool_state.string_body_data.allocated += n;
+ if (lmt_string_pool_state.string_body_data.allocated > lmt_string_pool_state.string_body_data.size) {
+ tex_overflow_error("poolbody", lmt_string_pool_state.string_body_data.allocated);
+ }
+}
+
+static inline void tex_aux_decrement_pool_string(int n)
+{
+ lmt_string_pool_state.string_body_data.allocated -= n;
+}
+
+static void tex_aux_flush_cur_string(void)
+{
+ if (lmt_string_pool_state.string_temp) {
+ aux_deallocate_array(lmt_string_pool_state.string_temp);
+ }
+ lmt_string_pool_state.string_temp = NULL;
+ lmt_string_pool_state.string_temp_top = 0;
+ lmt_string_pool_state.string_temp_allocated = 0;
+}
+
+void tex_reset_cur_string(void)
+{
+ unsigned char *tmp = aux_allocate_clear_array(sizeof(unsigned char), initial_temp_string_slots, reserved_temp_string_slots);
+ if (tmp) {
+ lmt_string_pool_state.string_temp = tmp;
+ lmt_string_pool_state.string_temp_top = 0;
+ lmt_string_pool_state.string_temp_allocated = initial_temp_string_slots;
+ } else {
+ tex_overflow_error("pool", initial_temp_string_slots);
+ }
+}
+
+static int tex_aux_room_in_string(int wsize)
+{
+ /* no callback here */
+ if (! lmt_string_pool_state.string_temp) {
+ tex_reset_cur_string();
+ }
+ if ((lmt_string_pool_state.string_temp_top + wsize) > lmt_string_pool_state.string_temp_allocated) {
+ unsigned char *tmp = NULL;
+ int size = lmt_string_pool_state.string_temp_allocated + lmt_string_pool_state.string_temp_allocated / 5 + STRING_EXTRA_AMOUNT;
+ if (size < wsize) {
+ size = wsize + STRING_EXTRA_AMOUNT;
+ }
+ tmp = aux_reallocate_array(lmt_string_pool_state.string_temp, sizeof(unsigned char), size, reserved_temp_string_slots);
+ if (tmp) {
+ lmt_string_pool_state.string_temp = tmp;
+ memset(tmp + lmt_string_pool_state.string_temp_top, 0, (size_t) size - lmt_string_pool_state.string_temp_top);
+ } else {
+ tex_overflow_error("pool", size);
+ }
+ lmt_string_pool_state.string_temp_allocated = size;
+ }
+ return 1;
+}
+
+# define reserved_string_slots 1
+
+/*tex Messy: ptr and top have cs_offset_value included */
+
+void tex_initialize_string_mem(void)
+{
+ int size = lmt_string_pool_state.string_pool_data.minimum;
+ if (lmt_main_state.run_state == initializing_state) {
+ size = lmt_string_pool_state.string_pool_data.minimum;
+ lmt_string_pool_state.string_pool_data.ptr = cs_offset_value;
+ } else {
+ size = lmt_string_pool_state.string_pool_data.allocated;
+ lmt_string_pool_state.string_pool_data.initial = lmt_string_pool_state.string_pool_data.ptr;
+ }
+ if (size > 0) {
+ lstring *pool = aux_allocate_clear_array(sizeof(lstring), size, reserved_string_slots);
+ if (pool) {
+ lmt_string_pool_state.string_pool = pool;
+ lmt_string_pool_state.string_pool_data.allocated = size;
+ } else {
+ tex_overflow_error("pool", size);
+ }
+ }
+}
+
+void tex_initialize_string_pool(void)
+{
+ unsigned char *nullstring = lmt_memory_malloc(1);
+ int size = lmt_string_pool_state.string_pool_data.allocated;
+ if (size && nullstring) {
+ lmt_string_pool_state.string_pool[0].s = nullstring;
+ nullstring[0] = '\0';
+ lmt_string_pool_state.string_pool_data.ptr += 1;
+ tex_reset_cur_string();
+ } else {
+ tex_overflow_error("pool", size);
+ }
+}
+
+static int tex_aux_room_in_string_pool(int n)
+{
+ int top = lmt_string_pool_state.string_pool_data.ptr + n;
+ if (top > lmt_string_pool_state.string_pool_data.top) {
+ lmt_string_pool_state.string_pool_data.top = top;
+ top -= cs_offset_value;
+ if (top > lmt_string_pool_state.string_pool_data.allocated) {
+ lstring *tmp = NULL;
+ top = lmt_string_pool_state.string_pool_data.allocated;
+ do {
+ top += lmt_string_pool_state.string_pool_data.step;
+ n -= lmt_string_pool_state.string_pool_data.step;
+ } while (n > 0);
+ if (top > lmt_string_pool_state.string_pool_data.size) {
+ top = lmt_string_pool_state.string_pool_data.size;
+ }
+ if (top > lmt_string_pool_state.string_pool_data.allocated) {
+ lmt_string_pool_state.string_pool_data.allocated = top;
+ tmp = aux_reallocate_array(lmt_string_pool_state.string_pool, sizeof(lstring), top, reserved_string_slots);
+ lmt_string_pool_state.string_pool = tmp;
+ }
+ lmt_run_memory_callback("pool", tmp ? 1 : 0);
+ if (! tmp) {
+ tex_overflow_error("pool", top);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+/*tex
+
+ Checking for the last one to be the same as the previous one doesn't save much some 10K on a
+ \CONTEXT\ format.
+
+*/
+
+strnumber tex_make_string(void)
+{
+ if (tex_aux_room_in_string(1)) {
+ int ptr = lmt_string_pool_state.string_pool_data.ptr;
+ lmt_string_pool_state.string_temp[lmt_string_pool_state.string_temp_top] = '\0';
+ str_string(ptr) = lmt_string_pool_state.string_temp;
+ str_length(ptr) = lmt_string_pool_state.string_temp_top;
+ tex_aux_increment_pool_string(lmt_string_pool_state.string_temp_top);
+ tex_reset_cur_string();
+ if (tex_aux_room_in_string_pool(1)) {
+ lmt_string_pool_state.string_pool_data.ptr++;
+ }
+ return ptr;
+ } else {
+ return get_nullstr();
+ }
+}
+
+strnumber tex_push_string(const unsigned char *s, int l)
+{
+ if (tex_aux_room_in_string_pool(1)) {
+ unsigned char *t = lmt_memory_malloc(sizeof(char) * ((size_t) l + 1));
+ if (t) {
+ int ptr = lmt_string_pool_state.string_pool_data.ptr;
+ memcpy(t, s, l);
+ t[l] = '\0';
+ str_string(ptr) = t;
+ str_length(ptr) = l;
+ lmt_string_pool_state.string_pool_data.ptr++;
+ tex_aux_increment_pool_string(l);
+ return ptr;
+ }
+ }
+ return get_nullstr();
+}
+
+char *tex_take_string(int *len)
+{
+ char* ptr = NULL;
+ if (tex_aux_room_in_string(1)) {
+ lmt_string_pool_state.string_temp[lmt_string_pool_state.string_temp_top] = '\0';
+ if (len) {
+ *len = lmt_string_pool_state.string_temp_top;
+ }
+ ptr = (char *) lmt_string_pool_state.string_temp;
+ tex_reset_cur_string();
+ }
+ return ptr;
+}
+
+/*tex
+
+ The following subroutine compares string |s| with another string of the same length that appears
+ in |buffer| starting at position |k|; the result is |true| if and only if the strings are equal.
+ Empirical tests indicate that |str_eq_buf| is used in such a way that it tends to return |true|
+ about 80 percent of the time.
+
+ \startyping
+ unsigned char *j = str_string(s);
+ unsigned char *l = j + str_length(s);
+ while (j < l) {
+ if (*j++ != buffer[k++])
+ return 0;
+ }
+ \stoptyping
+
+*/
+
+int tex_str_eq_buf(strnumber s, int k, int n)
+{
+ if (s < cs_offset_value) {
+ return buffer_to_unichar(k) == (unsigned int) s;
+ } else {
+ return memcmp(str_string(s), &lmt_fileio_state.io_buffer[k], n) == 0;
+ }
+}
+
+/*tex
+
+ Here is a similar routine, but it compares two strings in the string pool, and it does not
+ assume that they have the same length.
+
+ \starttyping
+ k = str_string(t);
+ j = str_string(s);
+ l = j + str_length(s);
+ while (j < l) {
+ if (*j++ != *k++)
+ return 0;
+ }
+ \stoptyping
+*/
+
+int tex_str_eq_str(strnumber s, strnumber t)
+{
+ if (s >= cs_offset_value) {
+ if (t >= cs_offset_value) {
+ /* s and t are strings, this is the most likely test */
+ return (str_length(s) == str_length(t)) && ! memcmp(str_string(s), str_string(t), str_length(s));
+ } else {
+ /* s is a string and t an unicode character, happens seldom */
+ return (strnumber) aux_str2uni(str_string(s)) == t;
+ }
+ } else if (t >= cs_offset_value) {
+ /* s is an unicode character and t is a string, happens seldom */
+ return (strnumber) aux_str2uni(str_string(t)) == s;
+ } else {
+ /* s and t are unicode characters */
+ return s == t;
+ }
+}
+
+/*tex A string compare helper: */
+
+int tex_str_eq_cstr(strnumber r, const char *s, size_t l)
+{
+ return (l == str_length(r)) && ! strncmp((const char *) (str_string(r)), s, l);
+}
+
+/*tex
+
+ The initial values of |str_pool|, |str_start|, |pool_ptr|, and |str_ptr| are computed set in
+ \INITEX\ mode. The first |string_offset| strings are single characters strings matching Unicode.
+ There is no point in generating all of these. But |str_ptr| has initialized properly, otherwise
+ |print_char| cannot see the difference between characters and strings.
+
+*/
+
+int tex_get_strings_started(void)
+{
+ tex_reset_cur_string();
+ return 1;
+}
+
+/*tex
+
+ The string recycling routines. \TEX\ uses 2 upto 4 {\em new} strings when scanning a filename
+ in an |\input|, |\openin|, or |\openout| operation. These strings are normally lost because the
+ reference to them are not saved after finishing the operation. |search_string| searches through
+ the string pool for the given string and returns either 0 or the found string number. However,
+ in \LUAMETATEX\ filenames (and fontnames) are implemented more efficiently so that code is gone.
+
+*/
+
+strnumber tex_maketexstring(const char *s)
+{
+ if (s && *s) {
+ return tex_maketexlstring(s, strlen(s));
+ } else {
+ return get_nullstr();
+ }
+}
+
+strnumber tex_maketexlstring(const char *s, size_t l)
+{
+ if (s && l > 0) {
+ int ptr = lmt_string_pool_state.string_pool_data.ptr;
+ size_t len = l + 1;
+ unsigned char *tmp = lmt_memory_malloc(len);
+ if (tmp) {
+ str_length(ptr) = l;
+ str_string(ptr) = tmp;
+ tex_aux_increment_pool_string((int) l);
+ memcpy(tmp, s, len);
+ if (tex_aux_room_in_string_pool(1)) {
+ lmt_string_pool_state.string_pool_data.ptr += 1;
+ }
+ return ptr;
+ } else {
+ tex_overflow_error("string pool", (int) len);
+ }
+ }
+ return get_nullstr();
+}
+
+/*tex
+ These two functions appends bytes to the current \TEX\ string. There is no checking on what
+ gets appended nd as in \LUA\ zero bytes are okay. Unlike the other engines we don't provide
+ |^^| escaping, which is already optional in \LUATEX.
+*/
+
+void tex_append_string(const unsigned char *s, unsigned l)
+{
+ if (s && l > 0 && tex_aux_room_in_string(l)) {
+ memcpy(lmt_string_pool_state.string_temp + lmt_string_pool_state.string_temp_top, s, l);
+ lmt_string_pool_state.string_temp_top += l;
+ }
+}
+
+void tex_append_char(unsigned char c)
+{
+ if (tex_aux_room_in_string(1)) {
+ lmt_string_pool_state.string_temp[lmt_string_pool_state.string_temp_top++] = (unsigned char) c;
+ }
+}
+
+char *tex_makeclstring(int s, size_t *len)
+{
+ if (s < cs_offset_value) {
+ *len = (size_t) utf8_size(s);
+ return (char *) aux_uni2str((unsigned) s);
+ } else {
+ size_t l = (size_t) str_length(s);
+ char *tmp = lmt_memory_malloc(l + 1);
+ if (tmp) {
+ memcpy(tmp, str_string(s), l);
+ tmp[l] = '\0';
+ *len = l;
+ return tmp;
+ } else {
+ tex_overflow_error("string pool", (int) l);
+ *len = 0;
+ return NULL;
+ }
+ }
+}
+
+char *tex_makecstring(int s)
+{
+ if (s < cs_offset_value) {
+ return (char *) aux_uni2str((unsigned) s);
+ } else {
+ return lmt_memory_strdup((str_length(s) > 0) ? (const char *) str_string(s) : "");
+ }
+}
+
+/*tex
+
+ We can save some 150 K on the format file size by using a signed char as length (after checking)
+ because the max size of a string in \CONTEXT\ is around 70. A flag could indicate if we use 1 or
+ 4 bytes for the length. But not yet (preroll needed). Dumping and undumping all strings in a
+ block (where we need to zero terminate them) doesn't really work out any better. Okay, in the end
+ it was done.
+
+*/
+
+/*tex We use the real accessors here, not the macros that use |cs_offset_value|. */
+
+void tex_compact_string_pool(void)
+{
+ int n_of_strings = lmt_string_pool_state.string_pool_data.ptr - cs_offset_value;
+ int max_length = 0;
+ for (int j = 1; j < n_of_strings; j++) {
+ if (lmt_string_pool_state.string_pool[j].l > (unsigned int) max_length) {
+ max_length = (int) lmt_string_pool_state.string_pool[j].l;
+ }
+ }
+ lmt_string_pool_state.string_max_length = max_length;
+ tex_print_format("max string length %i, ", max_length);
+}
+
+void tex_dump_string_pool(dumpstream f)
+{
+ int n_of_strings = lmt_string_pool_state.string_pool_data.ptr - cs_offset_value;
+ int total_length = lmt_string_pool_state.string_body_data.allocated;
+ int max_length = lmt_string_pool_state.string_max_length;
+ dump_via_int(f, lmt_string_pool_state.string_pool_data.allocated);
+ dump_via_int(f, lmt_string_pool_state.string_pool_data.top); /* includes cs_offset_value */
+ dump_via_int(f, lmt_string_pool_state.string_pool_data.ptr); /* includes cs_offset_value */
+ dump_via_int(f, n_of_strings);
+ dump_via_int(f, max_length);
+ dump_via_int(f, total_length);
+ if (max_length > 0 && max_length < 126) {
+ /*tex We only have short strings. */
+ for (int j = 0; j < n_of_strings; j++) {
+ int l = (int) lmt_string_pool_state.string_pool[j].l;
+ char c;
+ if (! lmt_string_pool_state.string_pool[j].s) {
+ l = -1;
+ }
+ c = (char) l;
+ dump_things(f, c, 1);
+ if (l > 0) {
+ dump_things(f, *lmt_string_pool_state.string_pool[j].s, l);
+ }
+ }
+ } else {
+ /*tex We also have long strings. */
+ for (int j = 0; j < n_of_strings; j++) {
+ int l = (int) lmt_string_pool_state.string_pool[j].l;
+ if (! lmt_string_pool_state.string_pool[j].s) {
+ l = -1;
+ }
+ dump_int(f, l);
+ if (l > 0) {
+ dump_things(f, *lmt_string_pool_state.string_pool[j].s, l);
+ }
+ }
+ }
+}
+
+void tex_undump_string_pool(dumpstream f)
+{
+ int n_of_strings;
+ int max_length;
+ int total_length;
+ undump_int(f, lmt_string_pool_state.string_pool_data.allocated);
+ undump_int(f, lmt_string_pool_state.string_pool_data.top); /* includes cs_offset_value */
+ undump_int(f, lmt_string_pool_state.string_pool_data.ptr); /* includes cs_offset_value */
+ undump_int(f, n_of_strings);
+ undump_int(f, max_length);
+ undump_int(f, total_length);
+ lmt_string_pool_state.string_max_length = max_length;
+ tex_initialize_string_mem();
+ {
+ int a = 0;
+ int compact = max_length > 0 && max_length < 126;
+ for (int j = 0; j < n_of_strings; j++) {
+ int x;
+ if (compact) {
+ /*tex We only have short strings. */
+ char c;
+ undump_things(f, c, 1);
+ x = c;
+ } else {
+ /*tex We also have long strings. */
+ undump_int(f, x);
+ }
+ if (x >= 0) {
+ /* we can overflow reserved_string_slots */
+ int n = x + 1;
+ unsigned char *s = aux_allocate_clear_array(sizeof(unsigned char), n, reserved_string_slots);
+ if (s) {
+ lmt_string_pool_state.string_pool[j].s = s;
+ undump_things(f, s[0], x);
+ s[x] = '\0';
+ a += n;
+ } else {
+ tex_overflow_error("string pool", n);
+ x = 0;
+ }
+ } else {
+ x = 0;
+ }
+ lmt_string_pool_state.string_pool[j].l = x;
+ }
+ lmt_string_pool_state.string_body_data.allocated = a;
+ lmt_string_pool_state.string_body_data.initial = a;
+ }
+}
+
+/*tex To destroy an already made string, we say |flush_str|. */
+
+void tex_flush_str(strnumber s)
+{
+ if (s > cs_offset_value) {
+ /*tex Don't ever delete the null string! */
+ tex_aux_decrement_pool_string((int) str_length(s));
+ str_length(s) = 0;
+ lmt_memory_free(str_string(s));
+ str_string(s) = NULL;
+ // string_pool_state.string_pool_data.ptr--;
+ }
+ /* why a loop and not in previous branch */
+ while (! str_string((lmt_string_pool_state.string_pool_data.ptr - 1))) {
+ lmt_string_pool_state.string_pool_data.ptr--;
+ }
+}
+
+/*
+ In the old filename code we had the following, but I suspect some mem issue there (as we ran
+ into GB leaks for thousands of names):
+
+ u = save_cur_string();
+ get_x_token();
+ restore_cur_string(u);
+*/
+
+strnumber tex_save_cur_string(void)
+{
+ return (lmt_string_pool_state.string_temp_top > 0 ? tex_make_string() : 0);
+}
+
+void tex_restore_cur_string(strnumber u)
+{
+ if (u) {
+ /*tex Beware, we have no 0 termination here! */
+ int ul = (int) str_length(u);
+ tex_aux_flush_cur_string();
+ if (tex_aux_room_in_string(u)) {
+ memcpy(lmt_string_pool_state.string_temp, str_string(u), ul);
+ lmt_string_pool_state.string_temp_allocated = ul;
+ lmt_string_pool_state.string_temp_top = ul;
+ tex_flush_str(u);
+ }
+ }
+}
diff --git a/source/luametatex/source/tex/texstringpool.h b/source/luametatex/source/tex/texstringpool.h
new file mode 100644
index 000000000..b3924a0fe
--- /dev/null
+++ b/source/luametatex/source/tex/texstringpool.h
@@ -0,0 +1,110 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_STRINGPOOL_H
+# define LMT_STRINGPOOL_H
+
+/*tex
+
+ Both \LUA\ and |TEX\ strings can contain |nul| characters, but \CCODE\ strings cannot. The pool
+ is implemented differently anyway. The |init_str_ptr| is an offset that indicates how many strings
+ are in the format. Does it still make sense to have that distinction? Do we care?
+
+ We store the used bytes (in strings) in the |real| field so that it is carried with the data blob
+ (and ends up in statistics).
+
+*/
+
+typedef struct lstring {
+ union {
+ unsigned char *s;
+ const char *c;
+ };
+ size_t l; /* could be int, but this way we padd */
+} lstring;
+
+typedef struct string_pool_info {
+ lstring *string_pool;
+ memory_data string_pool_data;
+ memory_data string_body_data;
+ strnumber reserved;
+ /*tex only when format is made and loaded */
+ int string_max_length;
+ /*tex used for temporary string building: */
+ unsigned char *string_temp;
+ int string_temp_allocated;
+ int string_temp_top;
+} string_pool_info;
+
+extern string_pool_info lmt_string_pool_state;
+
+# define STRING_EXTRA_AMOUNT 512
+
+/*tex This is the reference of the empty string: */
+
+# define get_nullstr() cs_offset_value
+
+/*tex
+
+ Several of the elementary string operations are performed using macros instead of procedures,
+ because many of the operations are done quite frequently and we want to avoid the overhead of
+ procedure calls. For example, here is a simple macro that computes the length of a string.
+
+ Keep in mind that we are talking of a |string_pool| table that officially starts with the
+ unicode characters (as in \TEX\ with \ASCII) but that we use an offset to jump ove that. So the
+ real size doesn't include those single character code points.
+
+*/
+
+# define str_length(a) (lmt_string_pool_state.string_pool[(a) - cs_offset_value].l)
+# define str_string(a) (lmt_string_pool_state.string_pool[(a) - cs_offset_value].s)
+# define str_lstring(a) (lmt_string_pool_state.string_pool[(a) - cs_offset_value])
+
+/*tex
+
+ Strings are created by appending character codes to |str_pool|. The |append_char| macro,
+ defined here, does not check to see if the value of |pool_ptr| has gotten too high; this test
+ is supposed to be made before |append_char| is used. There is also a |flush_char| macro, which
+ erases the last character appended.
+
+ To test if there is room to append |l| more characters to |str_pool|, we shall write |str_room
+ (l)|, which aborts \TEX\ and gives an apologetic error message if there isn't enough room. The
+ length of the current string is called |cur_length|.
+
+*/
+
+/*tex Forget the last character in the pool. */
+
+inline void tex_flush_char(void) { --lmt_string_pool_state.string_temp_top; }
+
+extern strnumber tex_make_string (void);
+extern strnumber tex_push_string (const unsigned char *s, int l);
+extern char *tex_take_string (int *len);
+extern int tex_str_eq_buf (strnumber s, int k, int n);
+extern int tex_str_eq_str (strnumber s, strnumber t);
+extern int tex_str_eq_cstr (strnumber s, const char *, size_t);
+extern int tex_get_strings_started (void);
+extern void tex_reset_cur_string (void);
+/* strnumber tex_search_string (strnumber search); */
+/* int tex_used_strings (void); */
+extern strnumber tex_maketexstring (const char *s);
+extern strnumber tex_maketexlstring (const char *s, size_t);
+extern void tex_append_char (unsigned char c);
+extern void tex_append_string (const unsigned char *s, unsigned l);
+extern char *tex_makecstring (int s);
+extern char *tex_makeclstring (int s, size_t *len);
+extern void tex_dump_string_pool (dumpstream f);
+extern void tex_undump_string_pool (dumpstream f);
+extern void tex_initialize_string_pool (void);
+extern void tex_initialize_string_mem (void);
+extern void tex_flush_str (strnumber s);
+extern strnumber tex_save_cur_string (void);
+extern void tex_restore_cur_string (strnumber u);
+
+/* void tex_increment_pool_string (int n); */
+/* void tex_decrement_pool_string (int n); */
+
+extern void tex_compact_string_pool (void);
+
+# endif
diff --git a/source/luametatex/source/tex/textextcodes.c b/source/luametatex/source/tex/textextcodes.c
new file mode 100644
index 000000000..39fc258c7
--- /dev/null
+++ b/source/luametatex/source/tex/textextcodes.c
@@ -0,0 +1,607 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ Contrary to traditional \TEX\ we have catcode tables so that we can switch catcode regimes very
+ fast. We can have many such regimes and they're stored in trees.
+
+*/
+
+# define CATCODESTACK 8
+# define CATCODEDEFAULT 12
+# define CATCODEDEFAULTS 0x0C0C0C0C /*tex Used as |dflt| value in |sa| struct. */
+
+typedef struct catcode_state_info {
+ sa_tree *catcode_heads;
+ unsigned char *catcode_valid;
+ int catcode_max;
+ int padding;
+} catcode_state_info;
+
+static catcode_state_info lmt_catcode_state = {
+ .catcode_heads = NULL,
+ .catcode_valid = NULL,
+ .catcode_max = 0,
+ .padding = 0,
+} ;
+
+static void tex_aux_allocate_catcodes(void)
+{
+ lmt_catcode_state.catcode_heads = sa_malloc_array(sizeof(sa_tree), max_n_of_catcode_tables);
+ lmt_catcode_state.catcode_valid = sa_malloc_array(sizeof(unsigned char), max_n_of_catcode_tables);
+ if (lmt_catcode_state.catcode_heads && lmt_catcode_state.catcode_valid) {
+ sa_wipe_array(lmt_catcode_state.catcode_heads, sizeof(sa_tree), max_n_of_catcode_tables);
+ sa_wipe_array(lmt_catcode_state.catcode_valid, sizeof(unsigned char), max_n_of_catcode_tables);
+ } else {
+ tex_overflow_error("catcodes", max_n_of_catcode_tables);
+ }
+}
+
+static void tex_aux_initialize_catcodes(void)
+{
+ sa_tree_item item = { .uint_value = CATCODEDEFAULTS };
+ lmt_catcode_state.catcode_max = 0;
+ tex_aux_allocate_catcodes();
+ lmt_catcode_state.catcode_valid[0] = 1;
+ lmt_catcode_state.catcode_heads[0] = sa_new_tree(CATCODESTACK, 1, item);
+}
+
+void tex_set_cat_code(int h, int n, halfword v, int gl)
+{
+ sa_tree_item item = { .uint_value = CATCODEDEFAULTS };
+ sa_tree tree = lmt_catcode_state.catcode_heads[h];
+ if (h > lmt_catcode_state.catcode_max) {
+ lmt_catcode_state.catcode_max = h;
+ }
+ if (! tree) {
+ tree = sa_new_tree(CATCODESTACK, 1, item);
+ lmt_catcode_state.catcode_heads[h] = tree;
+ }
+ sa_set_item_1(tree, n, v, gl);
+}
+
+halfword tex_get_cat_code(int h, int n)
+{
+ sa_tree_item item = { .uint_value = CATCODEDEFAULTS };
+ sa_tree tree = lmt_catcode_state.catcode_heads[h];
+ if (h > lmt_catcode_state.catcode_max) {
+ lmt_catcode_state.catcode_max = h;
+ }
+ if (! tree) {
+ tree = sa_new_tree(CATCODESTACK, 1, item);
+ lmt_catcode_state.catcode_heads[h] = tree;
+ }
+ return sa_return_item_1(tree, n);
+}
+
+void tex_unsave_cat_codes(int h, int gl)
+{
+ if (h > lmt_catcode_state.catcode_max) {
+ lmt_catcode_state.catcode_max = h;
+ }
+ for (int k = 0; k <= lmt_catcode_state.catcode_max; k++) {
+ if (lmt_catcode_state.catcode_heads[k]) {
+ sa_restore_stack(lmt_catcode_state.catcode_heads[k], gl);
+ }
+ }
+}
+
+static void tex_aux_dump_catcodes(dumpstream f)
+{
+ int total = 0;
+ for (int k = 0; k <= lmt_catcode_state.catcode_max; k++) {
+ if (lmt_catcode_state.catcode_valid[k]) {
+ total++;
+ }
+ }
+ dump_int(f, lmt_catcode_state.catcode_max);
+ dump_int(f, total);
+ for (int k = 0; k <= lmt_catcode_state.catcode_max; k++) {
+ if (lmt_catcode_state.catcode_valid[k]) {
+ dump_int(f, k);
+ sa_dump_tree(f, lmt_catcode_state.catcode_heads[k]);
+ }
+ }
+}
+
+static void tex_aux_undump_catcodes(dumpstream f)
+{
+ int total;
+ sa_free_array(lmt_catcode_state.catcode_heads);
+ sa_free_array(lmt_catcode_state.catcode_valid);
+ tex_aux_allocate_catcodes();
+ undump_int(f, lmt_catcode_state.catcode_max);
+ undump_int(f, total);
+ for (int k = 0; k < total; k++) {
+ int x;
+ undump_int(f, x);
+ lmt_catcode_state.catcode_heads[x] = sa_undump_tree(f);
+ lmt_catcode_state.catcode_valid[x] = 1;
+ }
+}
+
+int tex_valid_catcode_table(int h)
+{
+ return (h >= 0 && h < max_n_of_catcode_tables && lmt_catcode_state.catcode_valid[h]);
+}
+
+void tex_copy_cat_codes(int from, int to)
+{
+ if (from < 0 || from >= max_n_of_catcode_tables || lmt_catcode_state.catcode_valid[from] == 0) {
+ exit(EXIT_FAILURE);
+ } else {
+ if (to > lmt_catcode_state.catcode_max) {
+ lmt_catcode_state.catcode_max = to;
+ }
+ sa_destroy_tree(lmt_catcode_state.catcode_heads[to]);
+ lmt_catcode_state.catcode_heads[to] = sa_copy_tree(lmt_catcode_state.catcode_heads[from]);
+ lmt_catcode_state.catcode_valid[to] = 1;
+ }
+}
+
+/*
+void set_cat_code_table_default(int h, int dflt)
+{
+ if (valid_catcode_table(h)) {
+ catcode_state.catcode_heads[h]->dflt.uchar_value[0] = (unsigned char) dflt;
+ catcode_state.catcode_heads[h]->dflt.uchar_value[1] = (unsigned char) dflt;
+ catcode_state.catcode_heads[h]->dflt.uchar_value[2] = (unsigned char) dflt;
+ catcode_state.catcode_heads[h]->dflt.uchar_value[3] = (unsigned char) dflt;
+ }
+}
+
+int get_cat_code_table_default(int h)
+{
+ if (valid_catcode_table(h)) {
+ return catcode_state.catcode_heads[h]->dflt.uchar_value[0];
+ } else {
+ return CATCODEDEFAULT;
+ }
+}
+*/
+
+void tex_initialize_cat_codes(int h)
+{
+ if (h > lmt_catcode_state.catcode_max) {
+ lmt_catcode_state.catcode_max = h;
+ }
+ sa_destroy_tree(lmt_catcode_state.catcode_heads[h]);
+ lmt_catcode_state.catcode_heads[h] = NULL;
+ tex_set_cat_code(h, '\r', end_line_cmd, 1);
+ tex_set_cat_code(h, ' ', spacer_cmd, 1);
+ tex_set_cat_code(h, '\\', escape_cmd, 1);
+ tex_set_cat_code(h, '%', comment_cmd, 1);
+ tex_set_cat_code(h, 127, invalid_char_cmd, 1);
+ tex_set_cat_code(h, 0, ignore_cmd, 1);
+ tex_set_cat_code(h, 0xFEFF, ignore_cmd, 1);
+ for (int k = 'A'; k <= 'Z'; k++) {
+ tex_set_cat_code(h, k, letter_cmd, 1);
+ tex_set_cat_code(h, k + 'a' - 'A', letter_cmd, 1);
+ }
+ lmt_catcode_state.catcode_valid[h] = 1;
+}
+
+static void tex_aux_free_catcodes(void)
+{
+ for (int k = 0; k <= lmt_catcode_state.catcode_max; k++) {
+ if (lmt_catcode_state.catcode_valid[k]) {
+ sa_destroy_tree(lmt_catcode_state.catcode_heads[k]);
+ }
+ }
+ lmt_catcode_state.catcode_heads = sa_free_array(lmt_catcode_state.catcode_heads);
+ lmt_catcode_state.catcode_valid = sa_free_array(lmt_catcode_state.catcode_valid);
+}
+
+/*tex
+
+ The lowercase mapping codes are also stored in a tree. Let's keep them close for cache hits,
+ maybe also with hjcodes.
+
+*/
+
+# define LCCODESTACK 8
+# define LCCODEDEFAULT 0
+
+# define UCCODESTACK 8
+# define UCCODEDEFAULT 0
+
+# define SFCODESTACK 8
+# define SFCODEDEFAULT 1000
+
+# define HCCODESTACK 8
+# define HCCODEDEFAULT 0
+
+# define HMCODESTACK 8
+# define HMCODEDEFAULT 0
+
+typedef struct luscode_state_info {
+ sa_tree uccode_head;
+ sa_tree lccode_head;
+ sa_tree sfcode_head;
+ sa_tree hccode_head;
+ sa_tree hmcode_head;
+} luscode_state_info;
+
+static luscode_state_info lmt_luscode_state = {
+ .uccode_head = NULL,
+ .lccode_head = NULL,
+ .sfcode_head = NULL,
+ .hccode_head = NULL,
+ .hmcode_head = NULL
+};
+
+void tex_set_lc_code(int n, halfword v, int gl)
+{
+ sa_tree_item item;
+ item.int_value = v;
+ sa_set_item_4(lmt_luscode_state.lccode_head, n, item, gl);
+}
+
+halfword tex_get_lc_code(int n)
+{
+ return sa_return_item_4(lmt_luscode_state.lccode_head, n);
+}
+
+static void tex_aux_unsave_lccodes(int gl)
+{
+ sa_restore_stack(lmt_luscode_state.lccode_head, gl);
+}
+
+static void tex_aux_initialize_lccodes(void)
+{
+ sa_tree_item item;
+ item.int_value = LCCODEDEFAULT;
+ lmt_luscode_state.lccode_head = sa_new_tree(LCCODESTACK, 4, item);
+}
+
+static void tex_aux_dump_lccodes(dumpstream f)
+{
+ sa_dump_tree(f, lmt_luscode_state.lccode_head);
+}
+
+static void tex_aux_undump_lccodes(dumpstream f)
+{
+ lmt_luscode_state.lccode_head = sa_undump_tree(f);
+}
+
+static void tex_aux_free_lccodes(void)
+{
+ sa_destroy_tree(lmt_luscode_state.lccode_head);
+}
+
+/*tex
+
+ And the uppercase mapping codes are again stored in a tree.
+
+*/
+
+void tex_set_uc_code(int n, halfword v, int gl)
+{
+ sa_tree_item item;
+ item.int_value = v;
+ sa_set_item_4(lmt_luscode_state.uccode_head, n, item, gl);
+}
+
+halfword tex_get_uc_code(int n)
+{
+ return sa_return_item_4(lmt_luscode_state.uccode_head, n);
+}
+
+static void tex_aux_unsave_uccodes(int gl)
+{
+ sa_restore_stack(lmt_luscode_state.uccode_head, gl);
+}
+
+static void tex_aux_initialize_uccodes(void)
+{
+ sa_tree_item item = { .int_value = UCCODEDEFAULT };
+ lmt_luscode_state.uccode_head = sa_new_tree(UCCODESTACK, 4, item);
+}
+
+static void tex_aux_dump_uccodes(dumpstream f)
+{
+ sa_dump_tree(f,lmt_luscode_state.uccode_head);
+}
+
+static void tex_aux_undump_uccodes(dumpstream f)
+{
+ lmt_luscode_state.uccode_head = sa_undump_tree(f);
+}
+
+static void tex_aux_free_uccodes(void)
+{
+ sa_destroy_tree(lmt_luscode_state.uccode_head);
+}
+
+/*tex
+
+ By now it will be no surprise that the space factors get stored in a tree.
+
+*/
+
+void tex_set_sf_code(int n, halfword v, int gl)
+{
+ sa_tree_item item;
+ item.int_value = v;
+ sa_set_item_4(lmt_luscode_state.sfcode_head, n, item, gl);
+}
+
+halfword tex_get_sf_code(int n)
+{
+ return sa_return_item_4(lmt_luscode_state.sfcode_head, n);
+}
+
+static void tex_aux_unsave_sfcodes(int gl)
+{
+ sa_restore_stack(lmt_luscode_state.sfcode_head, gl);
+}
+
+static void tex_aux_initialize_sfcodes(void)
+{
+ sa_tree_item item = { .int_value = SFCODEDEFAULT };
+ lmt_luscode_state.sfcode_head = sa_new_tree(SFCODESTACK, 4, item);
+}
+
+static void tex_aux_dump_sfcodes(dumpstream f)
+{
+ sa_dump_tree(f, lmt_luscode_state.sfcode_head);
+}
+
+static void tex_aux_undump_sfcodes(dumpstream f)
+{
+ lmt_luscode_state.sfcode_head = sa_undump_tree(f);
+}
+
+static void tex_aux_free_sfcodes(void)
+{
+ sa_destroy_tree(lmt_luscode_state.sfcode_head);
+}
+
+/*tex
+
+ Finaly the hyphen character codes, a rather small sparse array.
+
+*/
+
+void tex_set_hc_code(int n, halfword v, int gl)
+{
+ sa_tree_item item;
+ item.int_value = v;
+ sa_set_item_4(lmt_luscode_state.hccode_head, n, item, gl);
+}
+
+halfword tex_get_hc_code(int n)
+{
+ return sa_return_item_4(lmt_luscode_state.hccode_head, n);
+}
+
+static void tex_aux_unsave_hccodes(int gl)
+{
+ sa_restore_stack(lmt_luscode_state.hccode_head, gl);
+}
+
+static void tex_aux_initialize_hccodes(void)
+{
+ sa_tree_item item = { .int_value = HCCODEDEFAULT };
+ lmt_luscode_state.hccode_head = sa_new_tree(HCCODESTACK, 4, item);
+}
+
+static void tex_aux_dump_hccodes(dumpstream f)
+{
+ sa_dump_tree(f, lmt_luscode_state.hccode_head);
+}
+
+static void tex_aux_undump_hccodes(dumpstream f)
+{
+ lmt_luscode_state.hccode_head = sa_undump_tree(f);
+}
+
+static void tex_aux_free_hccodes(void)
+{
+ sa_destroy_tree(lmt_luscode_state.hccode_head);
+}
+
+/*tex
+ The same is true for math hyphenation but here we have a small options set.
+*/
+
+void tex_set_hm_code(int n, halfword v, int gl)
+{
+ sa_set_item_1(lmt_luscode_state.hmcode_head, n, v, gl);
+}
+
+halfword tex_get_hm_code(int n)
+{
+ return sa_return_item_1(lmt_luscode_state.hmcode_head, n);
+}
+
+static void tex_aux_unsave_hmcodes(int gl)
+{
+ sa_restore_stack(lmt_luscode_state.hmcode_head, gl);
+}
+
+static void tex_aux_initialize_hmcodes(void)
+{
+ sa_tree_item item = { .int_value = HMCODEDEFAULT };
+ lmt_luscode_state.hmcode_head = sa_new_tree(HMCODESTACK, 1, item);
+}
+
+static void tex_aux_dump_hmcodes(dumpstream f)
+{
+ sa_dump_tree(f, lmt_luscode_state.hmcode_head);
+}
+
+static void tex_aux_undump_hmcodes(dumpstream f)
+{
+ lmt_luscode_state.hmcode_head = sa_undump_tree(f);
+}
+
+static void tex_aux_free_hmcodes(void)
+{
+ sa_destroy_tree(lmt_luscode_state.hmcode_head);
+}
+
+/*tex
+
+ The hyphenation codes are indeed stored in a tree and are used instead of lowercase codes when
+ deciding what characters to take into acccount when hyphenating. They are bound to upto
+ |HJCODE_MAX| languages. In the end I decided to put the hash pointer in the language record
+ so that we can do better lean memory management. Actually, the hjcode handling already was more
+ efficient than in \LUATEX\ because I kept track of usage and allocated (dumped) only the
+ languages that were used. A typical example of nicely cleaned up code that in the end was
+ ditched but that happens often (and of course goes unnoticed). Actually, in \CONTEXT\ we don't
+ dump language info at all, so I might as wel drop language dumping, just like fonts.
+
+*/
+
+# define HJCODESTACK 8
+# define HJCODEDEFAULT 0
+
+void tex_set_hj_code(int h, int n, halfword v, int gl)
+{
+ if (h >= 0 && h <= lmt_language_state.language_data.top) {
+ sa_tree_item item = { .int_value = HJCODEDEFAULT };
+ sa_tree tree = lmt_language_state.languages[h]->hjcode_head;
+ if (! tree) {
+ tree = sa_new_tree(HJCODESTACK, 4, item);
+ lmt_language_state.languages[h]->hjcode_head = tree;
+ }
+ if (tree) {
+ item.int_value = (int) v;
+ sa_set_item_4(tree, n, item, gl);
+ }
+ }
+}
+
+/*tex We just return the lccodes when nothing is set. */
+
+halfword tex_get_hj_code(int h, int n)
+{
+ if (h >= 0 && h <= lmt_language_state.language_data.top) {
+ sa_tree tree = lmt_language_state.languages[h]->hjcode_head;
+ if (! tree) {
+ tree = lmt_luscode_state.lccode_head;
+ }
+ return sa_return_item_4(tree, n);
+ } else {
+ return 0;
+ }
+}
+
+void tex_dump_language_hj_codes(dumpstream f, int h)
+{
+ if (h >= 0 && h <= lmt_language_state.language_data.top) {
+ sa_tree tree = lmt_language_state.languages[h]->hjcode_head;
+ if (tree) {
+ dump_via_int(f, 1);
+ sa_dump_tree(f, tree);
+ } else {
+ dump_via_int(f, 0);
+ }
+ } else {
+ /* error */
+ }
+}
+
+void tex_undump_language_hj_codes(dumpstream f, int h)
+{
+ if (h >= 0 && h <= lmt_language_state.language_data.top) {
+ int x;
+ undump_int(f, x);
+ if (x) {
+ sa_free_array(lmt_language_state.languages[h]->hjcode_head);
+ lmt_language_state.languages[h]->hjcode_head = sa_undump_tree(f);
+ } else {
+ lmt_language_state.languages[h]->hjcode_head = NULL;
+ }
+ } else {
+ /* error */
+ }
+}
+
+void tex_hj_codes_from_lc_codes(int h)
+{
+ if (h >= 0 && h <= lmt_language_state.language_data.top) {
+ sa_tree tree = lmt_language_state.languages[h]->hjcode_head;
+ if (tree) {
+ sa_destroy_tree(tree);
+ }
+ tree = sa_copy_tree(lmt_luscode_state.lccode_head);
+ lmt_language_state.languages[h]->hjcode_head = tree ? tree : NULL;
+ }
+}
+
+/*tex The public management functions. */
+
+void tex_unsave_text_codes(int grouplevel)
+{
+ tex_aux_unsave_lccodes(grouplevel);
+ tex_aux_unsave_uccodes(grouplevel);
+ tex_aux_unsave_sfcodes(grouplevel);
+ tex_aux_unsave_hccodes(grouplevel);
+ tex_aux_unsave_hmcodes(grouplevel);
+}
+
+void tex_initialize_text_codes(void)
+{
+ tex_aux_initialize_catcodes();
+ tex_aux_initialize_lccodes();
+ tex_aux_initialize_uccodes();
+ tex_aux_initialize_sfcodes();
+ tex_aux_initialize_hccodes();
+ tex_aux_initialize_hmcodes();
+ /* initializehjcodes(); */
+}
+
+void tex_free_text_codes(void)
+{
+ tex_aux_free_catcodes();
+ tex_aux_free_lccodes();
+ tex_aux_free_uccodes();
+ tex_aux_free_sfcodes();
+ tex_aux_free_hccodes();
+ tex_aux_free_hmcodes();
+ /* freehjcodes(); */
+}
+
+void tex_dump_text_codes(dumpstream f)
+{
+ tex_aux_dump_catcodes(f);
+ tex_aux_dump_lccodes(f);
+ tex_aux_dump_uccodes(f);
+ tex_aux_dump_sfcodes(f);
+ tex_aux_dump_hccodes(f);
+ tex_aux_dump_hmcodes(f);
+ /* dumphjcodes(f); */
+}
+
+void tex_undump_text_codes(dumpstream f)
+{
+ tex_aux_undump_catcodes(f);
+ tex_aux_undump_lccodes(f);
+ tex_aux_undump_uccodes(f);
+ tex_aux_undump_sfcodes(f);
+ tex_aux_undump_hccodes(f);
+ tex_aux_undump_hmcodes(f);
+ /* undumphjcodes(f); */
+}
+
+void tex_initialize_xx_codes(void)
+{
+ /*tex We're compatible. */
+ for (int u = 'A'; u <= 'Z'; u++) {
+ int l = u + 32;
+ tex_set_lc_code(u, l, level_one);
+ tex_set_lc_code(l, l, level_one);
+ tex_set_uc_code(u, u, level_one);
+ tex_set_uc_code(l, u, level_one);
+ tex_set_sf_code(u, 999, level_one);
+ }
+ /*tex A good start but not compatible. */
+ /* set_hc_code(0x002D, 0x002D, level_one); */
+ /* set_hc_code(0x2010, 0x2010, level_one); */
+} \ No newline at end of file
diff --git a/source/luametatex/source/tex/textextcodes.h b/source/luametatex/source/tex/textextcodes.h
new file mode 100644
index 000000000..476f0f03e
--- /dev/null
+++ b/source/luametatex/source/tex/textextcodes.h
@@ -0,0 +1,49 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXTCODES_H
+# define LMT_TEXTCODES_H
+
+/*tex
+ For practical reasons we handle the hmcodes here although they are used in
+ math only. We could have used the hc codes as there will be no overlap.
+*/
+
+extern void tex_set_cat_code (int h, int n, halfword v, int gl);
+extern halfword tex_get_cat_code (int h, int n);
+extern int tex_valid_catcode_table (int h);
+extern void tex_unsave_cat_codes (int h, int gl);
+extern void tex_copy_cat_codes (int from, int to);
+extern void tex_initialize_cat_codes (int h);
+/* void tex_set_cat_code_table_default (int h, int dflt); */
+/* int tex_get_cat_code_table_default (int h); */
+
+extern void tex_set_lc_code (int n, halfword v, int gl);
+extern halfword tex_get_lc_code (int n);
+extern void tex_set_uc_code (int n, halfword v, int gl);
+extern halfword tex_get_uc_code (int n);
+extern void tex_set_sf_code (int n, halfword v, int gl);
+extern halfword tex_get_sf_code (int n);
+extern void tex_set_hc_code (int n, halfword v, int gl);
+extern halfword tex_get_hc_code (int n);
+extern void tex_set_hm_code (int n, halfword v, int gl);
+extern halfword tex_get_hm_code (int n);
+extern void tex_set_hj_code (int l, int n, halfword v, int gl);
+extern halfword tex_get_hj_code (int l, int n);
+extern void tex_initialize_xx_codes (void);
+
+extern void tex_hj_codes_from_lc_codes (int h);
+
+extern void tex_initialize_text_codes (void);
+extern void tex_unsave_text_codes (int grouplevel);
+
+extern void tex_dump_text_codes (dumpstream f);
+extern void tex_undump_text_codes (dumpstream f);
+
+extern void tex_dump_language_hj_codes (dumpstream f, int h);
+extern void tex_undump_language_hj_codes (dumpstream f, int h);
+
+extern void tex_free_text_codes (void);
+
+# endif
diff --git a/source/luametatex/source/tex/textoken.c b/source/luametatex/source/tex/textoken.c
new file mode 100644
index 000000000..0d2415233
--- /dev/null
+++ b/source/luametatex/source/tex/textoken.c
@@ -0,0 +1,3511 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex Todo: move some helpers to other places. */
+
+inline static int tex_aux_the_cat_code(halfword b)
+{
+ return (lmt_input_state.cur_input.cattable == default_catcode_table_preset) ?
+ tex_get_cat_code(cat_code_table_par, b)
+ : ( (lmt_input_state.cur_input.cattable > -0xFF) ?
+ tex_get_cat_code(lmt_input_state.cur_input.cattable, b)
+ : (
+ - lmt_input_state.cur_input.cattable - 0xFF
+ ) ) ;
+}
+
+/*tex
+
+ The \TEX\ system does nearly all of its own memory allocation, so that it can readily be
+ transported into environments that do not have automatic facilities for strings, garbage
+ collection, etc., and so that it can be in control of what error messages the user receives.
+ The dynamic storage requirements of \TEX\ are handled by providing two large arrays called
+ |fixmem| and |varmem| in which consecutive blocks of words are used as nodes by the \TEX\
+ routines.
+
+ Pointer variables are indices into this array, or into another array called |eqtb| that
+ will be explained later. A pointer variable might also be a special flag that lies outside
+ the bounds of |mem|, so we allow pointers to assume any |halfword| value. The minimum
+ halfword value represents a null pointer. \TEX\ does not assume that |mem[null]| exists.
+
+ Locations in |fixmem| are used for storing one-word records; a conventional |AVAIL| stack is
+ used for allocation in this array.
+
+ One can make an argument to switch to standard \CCODE\ allocation but the current approach is
+ very efficient in memory usage and performence so we stay with it. On the average memory
+ consumption of \TEX| is not that large, definitely not compared to other programs that deal
+ with text.
+
+ The big dynamic storage area is named |fixmem| where the smallest location of one|-|word
+ memory in use is |fix_mem_min| and the largest location of one|-|word memory in use is
+ |fix_mem_max|.
+
+ The |dyn_used| variable keeps track of how much memory is in use. The head of the list of
+ available one|-|word nodes is registered in |avail|. The last one-|word node used in |mem|
+ is |fix_mem_end|.
+
+ All these variables are packed in the structure |token_memory_state|.
+
+*/
+
+token_memory_state_info lmt_token_memory_state = {
+ .tokens = NULL,
+ .tokens_data = {
+ .minimum = min_token_size,
+ .maximum = max_token_size,
+ .size = siz_token_size,
+ .step = stp_token_size,
+ .allocated = 0,
+ .itemsize = sizeof(memoryword),
+ .top = 0,
+ .ptr = 0, /* used to register usage */
+ .initial = 0,
+ .offset = 0,
+ },
+ .available = 0,
+ .padding = 0,
+};
+
+/*tex
+
+ Token data has its own memory space. Again we have some state variables: |temp_token_head| is
+ the head of a (temporary) list of some kind as are |hold_token_head| and |omit_template|. A
+ permanently empty list is available in |null_list| and the head of the token list built by
+ |scan_keyword| is registered in |backup_head|. All these variables are packed in the structure
+ |token_data| but some have been moved to a more relevant state (so omit and hold are now in the
+ alignment state).
+
+*/
+
+token_state_info lmt_token_state = {
+ .null_list = null,
+ .in_lua_escape = 0,
+ .force_eof = 0,
+ .luacstrings = 0,
+ .par_loc = null,
+ .par_token = null,
+ /* .line_par_loc = null, */ /* removed because not really used and useful */
+ /* .line_par_token = null, */ /* idem */
+ .buffer = NULL,
+ .bufloc = 0,
+ .bufmax = 0,
+ .padding = 0,
+};
+
+/*tex Some properties are dumped in the format so these are aet already! */
+
+# define reserved_token_mem_slots 2 // play safe for slight overuns
+
+void tex_initialize_token_mem(void)
+{
+ memoryword *tokens = NULL;
+ int size = 0;
+ if (lmt_main_state.run_state == initializing_state) {
+ size = lmt_token_memory_state.tokens_data.minimum;
+ } else {
+ size = lmt_token_memory_state.tokens_data.allocated;
+ lmt_token_memory_state.tokens_data.initial = lmt_token_memory_state.tokens_data.ptr;
+ }
+ if (size > 0) {
+ tokens = aux_allocate_clear_array(sizeof(memoryword), size, reserved_token_mem_slots);
+ }
+ if (tokens) {
+ lmt_token_memory_state.tokens = tokens;
+ lmt_token_memory_state.tokens_data.allocated = size;
+ } else {
+ tex_overflow_error("tokens", size);
+ }
+}
+
+static void tex_aux_bump_token_memory(void)
+{
+ /*tex We need to manage the big dynamic storage area. */
+ int size = lmt_token_memory_state.tokens_data.allocated + lmt_token_memory_state.tokens_data.step;
+ if (size > lmt_token_memory_state.tokens_data.size) {
+ lmt_run_memory_callback("token", 0);
+ tex_show_runaway();
+ tex_overflow_error("token memory size", lmt_token_memory_state.tokens_data.allocated);
+ } else {
+ memoryword *tokens = aux_reallocate_array(lmt_token_memory_state.tokens, sizeof(memoryword), size, reserved_token_mem_slots);
+ lmt_run_memory_callback("token", tokens ? 1 : 0);
+ if (tokens) {
+ lmt_token_memory_state.tokens = tokens;
+ } else {
+ /*tex If memory is exhausted, display possible runaway text. */
+ tex_show_runaway();
+ tex_overflow_error("token memory size", lmt_token_memory_state.tokens_data.allocated);
+ }
+ }
+ memset((void *) (lmt_token_memory_state.tokens + lmt_token_memory_state.tokens_data.allocated + 1), 0, ((size_t) lmt_token_memory_state.tokens_data.step + reserved_token_mem_slots) * sizeof(memoryword));
+ lmt_token_memory_state.tokens_data.allocated = size;
+}
+
+void tex_initialize_tokens(void)
+{
+ lmt_token_memory_state.available = null;
+ lmt_token_memory_state.tokens_data.top = 0;
+ lmt_token_state.null_list = tex_get_available_token(null);
+ lmt_token_state.in_lua_escape = 0;
+}
+
+/*tex
+ Experiment. It saves some 512K on the \CONTEXT\ format of October 2020. It makes me wonder if I
+ should spend some time on optimizing token lists (kind of cisc commands as we're currently kind
+ of risc).
+*/
+
+void tex_compact_tokens(void)
+{
+ int nc = 0;
+ // memoryword *target = allocate_array(sizeof(memoryword), (size_t) token_memory_state.tokens_data.allocated, 0);
+ memoryword *target = aux_allocate_clear_array(sizeof(memoryword), (size_t) lmt_token_memory_state.tokens_data.allocated, 0);
+ halfword *mapper = aux_allocate_array(sizeof(halfword), (size_t) lmt_token_memory_state.tokens_data.allocated, 0);
+ int nofluacmds = 0;
+ if (target && mapper) {
+ // memset((void *) target, 0, ((size_t) token_memory_state.tokens_data.allocated) * sizeof(memoryword));
+ memset((void *) mapper, -1, ((size_t) lmt_token_memory_state.tokens_data.allocated) * sizeof(halfword));
+ memoryword *tokens = lmt_token_memory_state.tokens;
+ /* also reset available */
+ for (int cs = 0; cs < (eqtb_size + lmt_hash_state.hash_data.ptr); cs++) {
+ switch (eq_type(cs)) {
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ case internal_toks_reference_cmd:
+ case register_toks_reference_cmd:
+ {
+ halfword v = eq_value(cs); /* ref count token*/
+ if (v) {
+ if (mapper[v] < 0) {
+ // printf("before =>"); { halfword tt = v; while (tt) { printf("%7d ",tt); tt = token_link(tt); } } printf("\n");
+ halfword t = v;
+ nc++;
+ mapper[v] = nc; /* new ref count token index */
+ while (1) {
+ target[nc].half1 = tokens[t].half1; /* info cq. ref count */
+ t = tokens[t].half0;
+ if (t) {
+ nc++;
+ target[nc-1].half0 = nc; /* link to next */
+ } else {
+ target[nc].half0 = null; /* link to next */
+ break;
+ }
+ }
+ // printf("after =>"); { halfword tt = mapper[v]; while (tt) { printf("%7d ",tt); tt = target[tt].half0; } } printf("\n");
+ }
+ eq_value(cs) = mapper[v];
+ }
+ break;
+ }
+ case lua_value_cmd:
+ case lua_call_cmd:
+ case lua_local_call_cmd:
+ {
+ ++nofluacmds;
+ break;
+ }
+ }
+ }
+ // print(dump_state.format_identifier);
+ tex_print_format("tokenlist compacted from %i to %i entries, ", lmt_token_memory_state.tokens_data.top, nc);
+ if (nofluacmds) {
+ /*tex
+ We just mention them because when these are aliased the macro package needs to make
+ sure that after loading that happens again because registered funciton references
+ can have changed between format generation and run!
+ */
+ tex_print_format("%i potentially aliased lua call/value entries, ", nofluacmds);
+ }
+ lmt_token_memory_state.tokens_data.top = nc;
+ lmt_token_memory_state.tokens_data.ptr = nc;
+ aux_deallocate_array(lmt_token_memory_state.tokens);
+ lmt_token_memory_state.tokens = target;
+ lmt_token_memory_state.available = null;
+ } else {
+ tex_overflow_error("token compaction size", lmt_token_memory_state.tokens_data.allocated);
+ }
+}
+
+
+/*tex
+
+ The function |get_avail| returns a pointer (index) to a new one word node whose |link| field is
+ |null| (which is just 0). However, \TEX\ will halt if there is no more room left.
+
+ If the available space list is empty, i.e., if |avail = null|, we try first to increase
+ |fix_mem_end|. If that cannot be done, i.e., if |fix_mem_end = fix_mem_max|, we try to reallocate
+ array |fixmem|. If, that doesn't work, we have to quit. Users can configure \TEX\ to use a lot of
+ memory but in some scenarios limitations make sense.
+
+ Remark: we can have a pool of chunks where we get from or just allocate per token (as we have lots
+ of them that is slow). But then format loading becomes much slower as we need to recreate the
+ linked list. A no go. In todays terms \TEX\ memory usage is low anyway.
+
+ The freed tokens are kept in a linked list. First we check if we can quickly get one of these. If
+ that fails, we try to get one from the available pool. If that fails too, we enlarge the pool and
+ try again. We keep track of the used number of tokens. We also make sure that the tokens links to
+ nothing.
+
+ One problem is of course that tokens can be scattered over memory. We could have some sorter that
+ occasionally kicks in but it doesn't pay off. Normally definitions (in the format) are in sequence
+ but a normal run \unknown\ it would be interesting to know if this impacts the cache.
+
+*/
+
+halfword tex_get_available_token(halfword t)
+{
+ halfword p = lmt_token_memory_state.available;
+ if (p) {
+ lmt_token_memory_state.available = token_link(p);
+ } else if (lmt_token_memory_state.tokens_data.top < lmt_token_memory_state.tokens_data.allocated) {
+ p = ++lmt_token_memory_state.tokens_data.top;
+ } else {
+ tex_aux_bump_token_memory();
+ p = ++lmt_token_memory_state.tokens_data.top;
+ }
+ ++lmt_token_memory_state.tokens_data.ptr;
+ token_link(p) = null;
+ token_info(p) = t;
+ return p;
+}
+
+/*tex
+
+ Because we only have forward links, a freed token ends up at the head of the list of available
+ tokens.
+
+*/
+
+void tex_put_available_token(halfword p)
+{
+ token_link(p) = lmt_token_memory_state.available;
+ lmt_token_memory_state.available = p;
+ --lmt_token_memory_state.tokens_data.ptr;
+}
+
+halfword tex_store_new_token(halfword p, halfword t)
+{
+ halfword q = tex_get_available_token(t);
+ token_link(p) = q;
+ return q;
+}
+
+/*tex
+
+ The procedure |flush_list (p)| frees an entire linked list of oneword nodes that starts at
+ position |p|. It makes list of single word nodes available. The second variant in principle
+ is faster but in practice this goes unnoticed. Of course there is a little price to pay for
+ keeping track of memory usage.
+
+*/
+
+void tex_flush_token_list(halfword head)
+{
+ if (head) {
+ halfword current = head;
+ halfword tail;
+ int i = 0;
+ do {
+ ++i;
+ tail = current;
+ current = token_link(tail);
+ } while (current);
+ lmt_token_memory_state.tokens_data.ptr -= i;
+ token_link(tail) = lmt_token_memory_state.available;
+ lmt_token_memory_state.available = head;
+ }
+}
+
+void tex_flush_token_list_head_tail(halfword head, halfword tail, int n)
+{
+ if (head) {
+ lmt_token_memory_state.tokens_data.ptr -= n;
+ token_link(tail) = lmt_token_memory_state.available;
+ lmt_token_memory_state.available = head;
+ }
+}
+
+void tex_add_token_reference(halfword p)
+{
+ if (get_token_reference(p) < max_token_reference) {
+ add_token_reference(p);
+ } else {
+ tex_overflow_error("reference count", max_token_reference);
+ }
+}
+
+void tex_increment_token_reference(halfword p, int n)
+{
+ if ((get_token_reference(p) + n) < max_token_reference) {
+ inc_token_reference(p,n);
+ } else {
+ tex_overflow_error("reference count", max_token_reference);
+ }
+}
+
+void tex_delete_token_reference(halfword p)
+{
+ if (p) {
+ if (get_token_reference(p)) {
+ sub_token_reference(p);
+ } else {
+ tex_flush_token_list(p);
+ }
+ }
+}
+
+/*tex
+
+ A \TEX\ token is either a character or a control sequence, and it is represented internally in
+ one of two ways:
+
+ \startitemize[n]
+ \startitem
+ A character whose ASCII code number is |c| and whose command code is |m| is represented
+ as the number $2^{21}m+c$; the command code is in the range |1 <= m <= 14|.
+ \stopitem
+ \startitem
+ A control sequence whose |eqtb| address is |p| is represented as the number
+ |cs_token_flag+p|. Here |cs_token_flag = t =| $2^{25}-1$ is larger than $2^{21}m+c$, yet
+ it is small enough that |cs_token_flag + p < max_halfword|; thus, a token fits
+ comfortably in a halfword.
+ \stopitem
+ \stopitemize
+
+ A token |t| represents a |left_brace| command if and only if |t < left_brace_limit|; it
+ represents a |right_brace| command if and only if we have |left_brace_limit <= t <
+ right_brace_limit|; and it represents a |match| or |end_match| command if and only if
+ |match_token <= t <= end_match_token|. The following definitions take care of these
+ token-oriented constants and a few others.
+
+ A token list is a singly linked list of one-word nodes in |mem|, where each word contains a token
+ and a link. Macro definitions, output routine definitions, marks, |\write| texts, and a few other
+ things are remembered by \TEX\ in the form of token lists, usually preceded by a node with a
+ reference count in its |token_ref_count| field. The token stored in location |p| is called
+ |info(p)|.
+
+ Three special commands appear in the token lists of macro definitions. When |m = match|, it means
+ that \TEX\ should scan a parameter for the current macro; when |m = end_match|, it means that
+ parameter matching should end and \TEX\ should start reading the macro text; and when |m =
+ out_param|, it means that \TEX\ should insert parameter number |c| into the text at this point.
+
+ The enclosing |\char'173| and |\char'175| characters of a macro definition are omitted, but the
+ final right brace of an output routine is included at the end of its token list.
+
+ Here is an example macro definition that illustrates these conventions. After \TEX\ processes
+ the text:
+
+ \starttyping
+ \def\mac a#1#2 \b {#1\-a ##1#2 \#2\}
+ \stoptyping
+
+ The definition of |\mac| is represented as a token list containing:
+
+ \starttyping
+ (reference count) letter a match # match # spacer \b end_match
+ out_param1 \- letter a spacer, mac_param # other_char 1
+ out_param2 spacer out_param 2
+ \stoptyping
+
+ The procedure |scan_toks| builds such token lists, and |macro_call| does the parameter matching.
+
+ Examples such as |\def \m {\def \m {a} b}| explain why reference counts would be needed even if
+ \TEX\ had no |\let| operation: When the token list for |\m| is being read, the redefinition of
+ |\m| changes the |eqtb| entry before the token list has been fully consumed, so we dare not
+ simply destroy a token list when its control sequence is being redefined.
+
+ If the parameter-matching part of a definition ends with |#{}|, the corresponding token list
+ will have |{| just before the |end_match| and also at the very end. The first |{| is used to
+ delimit the parameter; the second one keeps the first from disappearing.
+
+ The |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in symbolic form, including the
+ expansion of a macro or mark.
+
+*/
+
+void tex_print_meaning(halfword code)
+{
+ /*tex
+
+ This would make sense but some macro packages don't like it:
+
+ \starttyping
+ if (cur_cmd == math_given_cmd) {
+ cur_cmd = math_xgiven_cmd ;
+ }
+ \stoptyping
+
+ Eventually we might just do it that way. We also can have |\meaningonly| that omits the
+ |macro:| and arguments.
+ */
+ int untraced = is_untraced(eq_flag(cur_cs));
+ if (! untraced) {
+ switch (code) {
+ case meaning_code:
+ case meaning_full_code:
+ case meaning_asis_code:
+ tex_print_cmd_flags(cur_cs, cur_cmd, (code == meaning_full_code || code == meaning_asis_code), code == meaning_asis_code);
+ break;
+ }
+ }
+ switch (cur_cmd) {
+ case call_cmd:
+ case protected_call_cmd:
+ case semi_protected_call_cmd:
+ case tolerant_call_cmd:
+ case tolerant_protected_call_cmd:
+ case tolerant_semi_protected_call_cmd:
+ if (untraced) {
+ tex_print_cs(cur_cs);
+ return;
+ } else {
+ switch (code) {
+ case meaning_code:
+ case meaning_full_code:
+ tex_print_str("macro");
+ goto FOLLOWUP;
+ case meaning_asis_code:
+ // tex_print_format("%e%C %S ", def_cmd, def_code, cur_cs);
+ tex_print_cmd_chr(def_cmd, def_code);
+ tex_print_char(' ');
+ tex_print_cs(cur_cs);
+ tex_print_char(' ');
+ if (cur_chr && token_link(cur_chr)) {
+ halfword body = get_token_parameters(cur_chr) ? tex_show_token_list(token_link(cur_chr), null, default_token_show_max, 1) : token_link(cur_chr);
+ tex_print_char('{');
+ if (body) {
+ tex_show_token_list(body, null, default_token_show_max, 0);
+ }
+ tex_print_char('}');
+ }
+ return;
+ }
+ goto DETAILS;
+ }
+ case get_mark_cmd:
+ tex_print_cmd_chr((singleword) cur_cmd, cur_chr);
+ tex_print_char(':');
+ tex_print_nlp();
+ tex_token_show(tex_get_some_mark(cur_chr, 0), default_token_show_max);
+ return;
+ case lua_value_cmd:
+ case lua_call_cmd:
+ case lua_local_call_cmd:
+ case lua_protected_call_cmd:
+ if (untraced) {
+ tex_print_cs(cur_cs);
+ return;
+ } else {
+ goto DEFAULT;
+ }
+ case if_test_cmd:
+ if (cur_chr > last_if_test_code) {
+ tex_print_cs(cur_cs);
+ return;
+ } else {
+ goto DEFAULT;
+ }
+ default:
+ DEFAULT:
+ tex_print_cmd_chr((singleword) cur_cmd, cur_chr);
+ if (cur_cmd < call_cmd) {
+ return;
+ } else {
+ /* all kind of reference cmds */
+ break;
+ }
+ }
+ FOLLOWUP:
+ tex_print_char(':');
+ DETAILS:
+ tex_print_nlp();
+ tex_token_show(cur_chr, default_token_show_max);
+}
+
+/*tex
+
+ The procedure |show_token_list|, which prints a symbolic form of the token list that starts at
+ a given node |p|, illustrates these conventions. The token list being displayed should not begin
+ with a reference count. However, the procedure is intended to be robust, so that if the memory
+ links are awry or if |p| is not really a pointer to a token list, nothing catastrophic will
+ happen.
+
+ An additional parameter |q| is also given; this parameter is either null or it points to a node
+ in the token list where a certain magic computation takes place that will be explained later.
+ Basically, |q| is non-null when we are printing the two-line context information at the time of
+ an error message; |q| marks the place corresponding to where the second line should begin.
+
+ For example, if |p| points to the node containing the first |a| in the token list above, then
+ |show_token_list| will print the string
+
+ \starttyping
+ a#1#2 \b ->#1-a ##1#2 #2
+ \stoptyping
+
+ and if |q| points to the node containing the second |a|, the magic computation will be performed
+ just before the second |a| is printed.
+
+ The generation will stop, and |\ETC.| will be printed, if the length of printing exceeds a given
+ limit~|l|. Anomalous entries are printed in the form of control sequences that are not followed
+ by a blank space, e.g., |\BAD.|; this cannot be confused with actual control sequences because a
+ real control sequence named |BAD| would come out |\BAD |.
+
+ In \LUAMETATEX\ we have some more node types and token types so we also have additional tracing.
+ Because there is some more granularity in for instance nodes (subtypes) more detail is reported.
+
+*/
+
+static const char *tex_aux_special_cmd_string(halfword cmd, halfword chr, const char *unknown)
+{
+ switch (cmd) {
+ case node_cmd : return "[[special cmd: node pointer]]";
+ case lua_protected_call_cmd : return "[[special cmd: lua protected call]]";
+ case lua_value_cmd : return "[[special cmd: lua value call]]";
+ case iterator_value_cmd : return "[[special cmd: iterator value]]";
+ case lua_call_cmd : return "[[special cmd: lua call]]";
+ case lua_local_call_cmd : return "[[special cmd: lua local call]]";
+ case begin_local_cmd : return "[[special cmd: begin local call]]";
+ case end_local_cmd : return "[[special cmd: end local call]]";
+ // case prefix_cmd : return "[[special cmd: enforced]]";
+ case prefix_cmd : return "\\always";
+ default : printf("[[unknown cmd: (%i,%i)]\n", cmd, chr); return unknown;
+ }
+}
+
+halfword nn = 0;
+
+halfword tex_show_token_list(halfword p, halfword q, int l, int asis)
+{
+ if (p) {
+ /*tex the highest parameter number, as an \ASCII\ digit */
+ unsigned char n = '0';
+ int min = 0;
+ int max = lmt_token_memory_state.tokens_data.top;
+ lmt_print_state.tally = 0;
+// if (l <= 0) {
+ l = extreme_token_show_max;
+// }
+ while (p && (lmt_print_state.tally < l)) {
+ if (p == q) {
+ /*tex Do magic computation. We only end up here in context showing. */
+ tex_set_trick_count();
+ }
+ /*tex Display token |p|, and |return| if there are problems. */
+ if (p < min || p > max) {
+ tex_print_str(error_string_clobbered(41));
+ return null;
+ } else if (token_info(p) >= cs_token_flag) {
+ // if (! ((print_state.inhibit_par_tokens) && (token_info(p) == token_state.par_token))) {
+ tex_print_cs_checked(token_info(p) - cs_token_flag);
+ // }
+ } else if (token_info(p) < 0) {
+ tex_print_str(error_string_bad(42));
+ } else if (token_info(p) == 0) {
+ tex_print_str(error_string_bad(44));
+ } else {
+ int cmd = token_cmd(token_info(p));
+ int chr = token_chr(token_info(p));
+ /*
+ Display the token (|cmd|,|chr|). The procedure usually \quote {learns} the character
+ code used for macro parameters by seeing one in a |match| command before it runs
+ into any |out_param| commands.
+
+ */
+ switch (cmd) {
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case alignment_tab_cmd:
+ case superscript_cmd:
+ case subscript_cmd:
+ case spacer_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ case ignore_cmd: /* new */
+ tex_print_tex_str(chr);
+ break;
+ case parameter_cmd:
+ if (! lmt_token_state.in_lua_escape && (lmt_expand_state.cs_name_level == 0)) {
+ tex_print_tex_str(chr);
+ }
+ tex_print_tex_str(chr);
+ break;
+ case parameter_reference_cmd:
+ tex_print_tex_str(match_visualizer);
+ if (chr <= 9) {
+ tex_print_char(chr + '0');
+ } else {
+ tex_print_char('!');
+ return null;
+ }
+ break;
+ case match_cmd:
+ tex_print_char(match_visualizer);
+ if (is_valid_match_ref(chr)) {
+ ++n;
+ }
+ tex_print_char(chr ? chr : '0');
+ if (n > '9') {
+ /*tex Can this happen at all? */
+ return null;
+ } else {
+ break;
+ }
+ case end_match_cmd:
+ if (asis) {
+ return token_link(p);
+ } else if (chr == 0) {
+ tex_print_str("->");
+ }
+ break;
+ case ignore_something_cmd:
+ break;
+ case set_font_cmd:
+ tex_print_format("[font->%s]", font_original(cur_val));
+ break;
+ case end_paragraph_cmd:
+ tex_print_format("%e%s", "par ");
+ break;
+ default:
+ tex_print_str(tex_aux_special_cmd_string(cmd, chr, error_string_bad(43)));
+ break;
+ }
+ }
+ p = token_link(p);
+ }
+ if (p) {
+ tex_print_str_esc("ETC.");
+ }
+ }
+ return p;
+}
+
+/*
+# define do_buffer_to_unichar(a,b) do { \
+ a = (halfword)str2uni(fileio_state.io_buffer+b); \
+ b += utf8_size(a); \
+} while (0)
+*/
+
+inline halfword get_unichar_from_buffer(int *b)
+{
+ halfword a = (halfword) ((const unsigned char) *(lmt_fileio_state.io_buffer + *b));
+ if (a <= 0x80) {
+ *b += 1;
+ } else {
+ a = (halfword) aux_str2uni(lmt_fileio_state.io_buffer + *b);
+ *b += utf8_size(a);
+ }
+ return a;
+}
+
+/*tex
+
+ Here's the way we sometimes want to display a token list, given a pointer to its reference count;
+ the pointer may be null.
+
+*/
+
+void tex_token_show(halfword p, int max)
+{
+ if (p && token_link(p)) {
+ tex_show_token_list(token_link(p), null, max, 0);
+ }
+}
+
+/*tex
+
+ The next function, |delete_token_ref|, is called when a pointer to a token list's reference
+ count is being removed. This means that the token list should disappear if the reference count
+ was |null|, otherwise the count should be decreased by one. Variable |p| points to the reference
+ count of a token list that is losing one reference.
+
+*/
+
+int tex_get_char_cat_code(int c)
+{
+ return tex_aux_the_cat_code(c);
+}
+
+static void tex_aux_invalid_character_error(void)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Text line contains an invalid character",
+ "A funny symbol that I can't read has just been input. Continue, and I'll forget\n"
+ "that it ever happened."
+ );
+}
+
+static int tex_aux_process_sup_mark(void);
+
+static int tex_aux_scan_control_sequence(void);
+
+typedef enum next_line_retval {
+ next_line_ok,
+ next_line_return,
+ next_line_restart
+} next_line_retval;
+
+static next_line_retval tex_aux_next_line(void);
+
+/*tex
+
+ In case you are getting bored, here is a slightly less trivial routine: Given a string of
+ lowercase letters, like |pt| or |plus| or |width|, the |scan_keyword| routine checks to see
+ whether the next tokens of input match this string. The match must be exact, except that
+ ppercase letters will match their lowercase counterparts; uppercase equivalents are determined
+ by subtracting |"a" - "A"|, rather than using the |uc_code| table, since \TEX\ uses this
+ routine only for its own limited set of keywords.
+
+ If a match is found, the characters are effectively removed from the input and |true| is
+ returned. Otherwise |false| is returned, and the input is left essentially unchanged (except
+ for the fact that some macros may have been expanded, etc.).
+
+ In \LUATEX\ and its follow up we have more keywords and for instance when scanning a box
+ specification that is noticeable because the |scan_keyword| function is a little inefficient
+ in the sense that when there is no match, it will push back what got read so far. So there is
+ token allocation, pushing a level etc involved. Keep in mind that expansion happens here so what
+ gets pushing back is not always literally pushing back what we started with.
+
+ In \LUAMETATEX\ we now have a bit different approach. The |scan_mandate_keyword| follows up on
+ |scan_character| so we have a two step approach. We could actually pass a list of valid keywords
+ but that would make for a complex function with no real benefits.
+
+*/
+
+halfword tex_scan_character(const char *s, int left_brace, int skip_space, int skip_relax)
+{
+ halfword save_cur_cs = cur_cs;
+// (void) skip_space; /* some day */
+ while (1) {
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case spacer_cmd:
+ if (skip_space) {
+ break;
+ } else {
+ goto DONE;
+ }
+ break;
+ case relax_cmd:
+ if (skip_relax) {
+ break;
+ } else {
+ goto DONE;
+ }
+ case letter_cmd:
+ case other_char_cmd:
+ if (cur_chr <= 'z' && strchr(s, cur_chr)) {
+ cur_cs = save_cur_cs;
+ return cur_chr;
+ } else {
+ goto DONE;
+ }
+ case left_brace_cmd:
+ if (left_brace) {
+ cur_cs = save_cur_cs;
+ return '{';
+ } else {
+ goto DONE;
+ }
+ default:
+ goto DONE;
+ }
+ }
+ DONE:
+ tex_back_input(cur_tok);
+ cur_cs = save_cur_cs;
+ return 0;
+}
+
+void tex_aux_show_keyword_error(const char *s)
+{
+ tex_handle_error(
+ normal_error_type,
+ "Valid keyword expected, likely '%s'",
+ s,
+ "You started a keyword but it seems to be an invalid one. The first character(s)\n"
+ "might give you a clue. You might want to quit unwanted lookahead with \\relax."
+ );
+}
+
+/*tex
+ Scanning an optional keyword starts at the beginning. This means that we can also (for instance)
+ have a minus or plus sign which means that we have a different loop than with the alternative
+ that already checked the first character.
+*/
+
+int tex_scan_optional_keyword(const char *s)
+{
+ halfword save_cur_cs = cur_cs;
+ int done = 0;
+ const char *p = s;
+ while (*p) {
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ if ((cur_chr == *p) || (cur_chr == *p - 'a' + 'A')) {
+ if (*(++p)) {
+ done = 1;
+ } else {
+ cur_cs = save_cur_cs;
+ return 1;
+ }
+ } else if (done) {
+ goto BAD_NEWS;
+ } else {
+ // can be a minus or so ! as in \advance\foo -10
+ tex_back_input(cur_tok);
+ cur_cs = save_cur_cs;
+ return 1;
+ }
+ break;
+ case spacer_cmd: /* normally spaces are not pushed back */
+ if (done) {
+ goto BAD_NEWS;
+ } else {
+ break;
+ }
+ // fall through
+ default:
+ tex_back_input(cur_tok);
+ if (done) {
+ /* unless we accept partial keywords */
+ goto BAD_NEWS;
+ } else {
+ cur_cs = save_cur_cs;
+ return 0;
+ }
+ }
+ }
+ BAD_NEWS:
+ tex_aux_show_keyword_error(s);
+ cur_cs = save_cur_cs;
+ return 0;
+}
+
+/*tex
+ Here we know that the first character(s) matched so we are in the middle of a keyword already
+ which means a different loop than the previous one.
+*/
+
+int tex_scan_mandate_keyword(const char *s, int offset)
+{
+ halfword save_cur_cs = cur_cs;
+ int done = 0;
+ // int done = offset > 0;
+ const char *p = s + offset; /* offset always > 0 so no issue with +/- */
+ while (*p) {
+ tex_get_x_token();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ if ((cur_chr == *p) || (cur_chr == *p - 'a' + 'A')) {
+ if (*(++p)) {
+ done = 1;
+ } else {
+ cur_cs = save_cur_cs;
+ return 1;
+ }
+ } else {
+ goto BAD_NEWS;
+ }
+ break;
+ // case spacer_cmd: /* normally spaces are not pushed back */
+ // case relax_cmd: /* normally not, should be option */
+ // if (done) {
+ // back_input(cur_tok);
+ // goto BAD_NEWS;
+ // } else {
+ // break;
+ // }
+ // default:
+ // goto BAD_NEWS;
+ case spacer_cmd: /* normally spaces are not pushed back */
+ if (done) {
+ goto BAD_NEWS;
+ } else {
+ break;
+ }
+ // fall through
+ default:
+ tex_back_input(cur_tok);
+ /* unless we accept partial keywords */
+ goto BAD_NEWS;
+ }
+ }
+ BAD_NEWS:
+ tex_aux_show_keyword_error(s);
+ cur_cs = save_cur_cs;
+ return 0;
+}
+
+/*
+ This is the original scanner with push|-|back. It's a matter of choice: we are more restricted
+ on the one hand and more loose on the other.
+*/
+
+int tex_scan_keyword(const char *s)
+{
+ if (*s) {
+ halfword h = null;
+ halfword p = null;
+ halfword save_cur_cs = cur_cs;
+ int n = 0;
+ while (*s) {
+ /*tex Recursion is possible here! */
+ tex_get_x_token();
+ if ((cur_cmd == letter_cmd || cur_cmd == other_char_cmd) && ((cur_chr == *s) || (cur_chr == *s - 'a' + 'A'))) {
+ p = tex_store_new_token(p, cur_tok);
+ if (! h) {
+ h = p;
+ }
+ n++;
+ s++;
+ } else if ((p != h) || (cur_cmd != spacer_cmd)) {
+ tex_back_input(cur_tok);
+ if (h) {
+ tex_begin_backed_up_list(h);
+ }
+ cur_cs = save_cur_cs;
+ return 0;
+ }
+ }
+ if (h) {
+ tex_flush_token_list_head_tail(h, p, n);
+ }
+ cur_cs = save_cur_cs;
+ return 1;
+ } else {
+ /*tex but not with newtokenlib zero keyword simply doesn't match */
+ return 0 ;
+ }
+}
+
+int tex_scan_keyword_case_sensitive(const char *s)
+{
+ if (*s) {
+ halfword h = null;
+ halfword p = null;
+ halfword save_cur_cs = cur_cs;
+ int n = 0;
+ while (*s) {
+ tex_get_x_token();
+ if ((cur_cmd == letter_cmd || cur_cmd == other_char_cmd) && (cur_chr == *s)) {
+ p = tex_store_new_token(p, cur_tok);
+ if (! h) {
+ h = p;
+ }
+ n++;
+ s++;
+ } else if ((p != h) || (cur_cmd != spacer_cmd)) {
+ tex_back_input(cur_tok);
+ if (h) {
+ tex_begin_backed_up_list(h);
+ }
+ cur_cs = save_cur_cs;
+ return 0;
+ }
+ }
+ if (h) {
+ tex_flush_token_list_head_tail(h, p, n);
+ }
+ cur_cs = save_cur_cs;
+ return 1;
+ } else {
+ return 0 ;
+ }
+}
+
+/*tex
+
+ We can not return |undefined_control_sequence| under some conditions (inside |shift_case|,
+ for example). This needs thinking.
+
+*/
+
+halfword tex_active_to_cs(int c, int force)
+{
+ halfword cs = -1;
+ if (c > 0) {
+ /*tex This is not that efficient: we can make a helper that doesn't use an alloc. */
+ char utfbytes[8] = { '\xEF', '\xBF', '\xBF', 0 };
+ aux_uni2string((char *) &utfbytes[3], c);
+ cs = tex_string_locate(utfbytes, (size_t) utf8_size(c) + 3, force);
+ }
+ if (cs < 0) {
+ cs = tex_string_locate("\xEF\xBF\xBF", 4, force); /*tex Including the zero sentinel. */
+ }
+ return cs;
+}
+
+/*tex
+
+ The heart of \TEX's input mechanism is the |get_next| procedure, which we shall develop in the
+ next few sections of the program. Perhaps we shouldn't actually call it the \quote {heart},
+ however, because it really acts as \TEX's eyes and mouth, reading the source files and
+ gobbling them up. And it also helps \TEX\ to regurgitate stored token lists that are to be
+ processed again.
+
+ The main duty of |get_next| is to input one token and to set |cur_cmd| and |cur_chr| to that
+ token's command code and modifier. Furthermore, if the input token is a control sequence, the
+ |eqtb| location of that control sequence is stored in |cur_cs|; otherwise |cur_cs| is set to
+ zero.
+
+ Underlying this simple description is a certain amount of complexity because of all the cases
+ that need to be handled. However, the inner loop of |get_next| is reasonably short and fast.
+
+ When |get_next| is asked to get the next token of a |\read| line, it sets |cur_cmd = cur_chr
+ = cur_cs = 0| in the case that no more tokens appear on that line. (There might not be any
+ tokens at all, if the |end_line_char| has |ignore| as its catcode.)
+
+ The value of |par_loc| is the |eqtb| address of |\par|. This quantity is needed because a
+ blank line of input is supposed to be exactly equivalent to the appearance of |\par|; we must
+ set |cur_cs := par_loc| when detecting a blank line.
+
+ Parts |get_next| are executed more often than any other instructions of \TEX. The global
+ variable |force_eof| is normally |false|; it is set |true| by an |\endinput| command.
+ |luacstrings| is the number of lua print statements waiting to be input, it is changed by
+ |lmt_token_call|.
+
+ If the user has set the |pausing| parameter to some positive value, and if nonstop mode has
+ not been selected, each line of input is displayed on the terminal and the transcript file,
+ followed by |=>|. \TEX\ waits for a response. If the response is simply |carriage_return|,
+ the line is accepted as it stands, otherwise the line typed is used instead of the line in the
+ file.
+
+ We no longer need the following:
+
+*/
+
+// void firm_up_the_line(void)
+// {
+// ilimit = fileio_state.io_last;
+// }
+
+/*tex
+
+ The other variant gives less clutter in tracing cache usage when profiling and for some files
+ (like the manual) also a bit of a speedup. Splitting the switch which gives 10 times less Bim
+ in vallgrind! See the \LUATEX\ source for that code.
+
+ The big switch changes the state if necessary, and |goto switch| if the current character
+ should be ignored, or |goto reswitch| if the current character changes to another.
+
+ The n-way switch accomplishes the scanning quickly, assuming that a decent \CCODE\ compiler
+ has translated the code. Note that the numeric values for |mid_line|, |skip_blanks|, and
+ |new_line| are spaced apart from each other by |max_char_code+1|, so we can add a character's
+ command code to the state to get a single number that characterizes both.
+
+ Remark: checking performance indicated that this switch was the cause of many branch prediction
+ errors but changing it to:
+
+ \starttyping
+ c = istate + cur_cmd;
+ if (c == (mid_line_state + letter_cmd) || c == (mid_line_state + other_char_cmd)) {
+ return 1;
+ } else if (c >= new_line_state) {
+ switch (c) {
+ }
+ } else if (c >= skip_blanks_state) {
+ switch (c) {
+ }
+ } else if (c >= mid_line_state) {
+ switch (c) {
+ }
+ } else {
+ istate = mid_line_state;
+ return 1;
+ }
+ \stoptyping
+
+ This gives as many prediction errors. So, we can indeed assume that the compiler does the right
+ job, or that there is simply no other way.
+
+ When a line is finished a space is emited. When a character of type |spacer| gets through, its
+ character code is changed to |\ =040|. This means that the \ASCII\ codes for tab and space, and
+ for the space inserted at the end of a line, will be treated alike when macro parameters are
+ being matched. We do this since such characters are indistinguishable on most computer terminal
+ displays.
+
+*/
+
+/*
+
+ c = istate + cur_cmd;
+ if (c == (mid_line_state + letter_cmd) || c == (mid_line_state + other_char_cmd)) {
+ return 1;
+ } else if (c >= new_line_state) {
+ ....
+ }
+
+*/
+
+/*tex
+
+ This trick has been dropped when the wrapup mechanism had proven to be useful. The idea was
+ to backport this to \LUATEX\ but some other \PDFTEX\ compatible parstuff made it there and
+ backporting par related features becomes too messy.
+
+ \starttyping
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ cur_cs = lmt_token_state.line_par_loc;
+ cur_cmd = eq_type(cur_cs);
+ if (cur_cmd == undefined_cs_cmd) {
+ cur_cs = lmt_token_state.par_loc;
+ cur_cmd = eq_type(cur_cs);
+ }
+ cur_chr = eq_value(cur_cs);
+ \stoptyping
+
+*/
+
+static int tex_aux_get_next_file(void)
+{
+ SWITCH:
+ if (lmt_input_state.cur_input.loc <= lmt_input_state.cur_input.limit) {
+ /*tex current line not yet finished */
+ cur_chr = get_unichar_from_buffer(&lmt_input_state.cur_input.loc);
+ RESWITCH:
+ if (lmt_input_state.cur_input.cattable == no_catcode_table_preset) {
+ /* happens seldom: detokenized line */
+ cur_cmd = cur_chr == ' ' ? 10 : 12;
+ } else {
+ cur_cmd = tex_aux_the_cat_code(cur_chr);
+ }
+ switch (lmt_input_state.cur_input.state + cur_cmd) {
+ case mid_line_state + ignore_cmd:
+ case skip_blanks_state + ignore_cmd:
+ case new_line_state + ignore_cmd:
+ case skip_blanks_state + spacer_cmd:
+ case new_line_state + spacer_cmd:
+ /*tex Cases where character is ignored. */
+ goto SWITCH;
+ case mid_line_state + escape_cmd:
+ case new_line_state + escape_cmd:
+ case skip_blanks_state + escape_cmd:
+ /*tex Scan a control sequence. */
+ lmt_input_state.cur_input.state = (unsigned char) tex_aux_scan_control_sequence();
+ break;
+ case mid_line_state + active_char_cmd:
+ case new_line_state + active_char_cmd:
+ case skip_blanks_state + active_char_cmd:
+ /*tex Process an active-character. */
+ cur_cs = tex_active_to_cs(cur_chr, ! lmt_hash_state.no_new_cs);
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = eq_value(cur_cs);
+ lmt_input_state.cur_input.state = mid_line_state;
+ break;
+ case mid_line_state + superscript_cmd:
+ case new_line_state + superscript_cmd:
+ case skip_blanks_state + superscript_cmd:
+ /*tex We need to check for multiple ^:
+ (0) always check for ^^ ^^^^ ^^^^^^^
+ (1) only check in text mode
+ (*) never
+ */
+ if (sup_mark_mode_par) {
+ if (sup_mark_mode_par == 1 && cur_mode != mmode && tex_aux_process_sup_mark()) {
+ goto RESWITCH;
+ }
+ } else if (tex_aux_process_sup_mark()) {
+ goto RESWITCH;
+ } else {
+ /*tex
+ We provide prescripts and shifted script in math mode and avoid fance |^|
+ processing in text mode (which is what we do in \CONTEXT).
+ */
+ }
+ lmt_input_state.cur_input.state = mid_line_state;
+ break;
+ case mid_line_state + invalid_char_cmd:
+ case new_line_state + invalid_char_cmd:
+ case skip_blanks_state + invalid_char_cmd:
+ /*tex Decry the invalid character and |goto restart|. */
+ tex_aux_invalid_character_error();
+ /*tex Because state may be |token_list| now: */
+ return 0;
+ case mid_line_state + spacer_cmd:
+ /*tex Enter |skip_blanks| state, emit a space. */
+ lmt_input_state.cur_input.state = skip_blanks_state;
+ cur_chr = ' ';
+ break;
+ case mid_line_state + end_line_cmd:
+ /*tex Finish the line. See note above about dropped |\linepar|. */
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ cur_cmd = spacer_cmd;
+ cur_chr = ' ';
+ break;
+ case skip_blanks_state + end_line_cmd:
+ case mid_line_state + comment_cmd:
+ case new_line_state + comment_cmd:
+ case skip_blanks_state + comment_cmd:
+ /*tex Finish line, |goto switch|; */
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ goto SWITCH;
+ case new_line_state + end_line_cmd:
+ if (! auto_paragraph_mode(auto_paragraph_go_on)) {
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.limit + 1;
+ }
+ /*tex Finish line, emit a |\par|; */
+ if (auto_paragraph_mode(auto_paragraph_text)) {
+ cur_cs = null;
+ cur_cmd = end_paragraph_cmd;
+ cur_chr = new_line_end_paragraph_code;
+ // cur_chr = normal_end_paragraph_code;
+ } else {
+ cur_cs = lmt_token_state.par_loc;
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = eq_value(cur_cs);
+ }
+ break;
+ case skip_blanks_state + left_brace_cmd:
+ case new_line_state + left_brace_cmd:
+ lmt_input_state.cur_input.state = mid_line_state;
+ lmt_input_state.align_state++;
+ break;
+ case mid_line_state + left_brace_cmd:
+ lmt_input_state.align_state++;
+ break;
+ case skip_blanks_state + right_brace_cmd:
+ case new_line_state + right_brace_cmd:
+ lmt_input_state.cur_input.state = mid_line_state;
+ lmt_input_state.align_state--;
+ break;
+ case mid_line_state + right_brace_cmd:
+ lmt_input_state.align_state--;
+ break;
+ case mid_line_state + math_shift_cmd:
+ case mid_line_state + alignment_tab_cmd:
+ case mid_line_state + parameter_cmd:
+ case mid_line_state + subscript_cmd:
+ case mid_line_state + letter_cmd:
+ case mid_line_state + other_char_cmd:
+ break;
+ /*
+ case skip_blanks_state + math_shift_cmd:
+ case skip_blanks_state + tab_mark_cmd:
+ case skip_blanks_state + mac_param_cmd:
+ case skip_blanks_state + sub_mark_cmd:
+ case skip_blanks_state + letter_cmd:
+ case skip_blanks_state + other_char_cmd:
+ case new_line_state + math_shift_cmd:
+ case new_line_state + tab_mark_cmd:
+ case new_line_state + mac_param_cmd:
+ case new_line_state + sub_mark_cmd:
+ case new_line_state + letter_cmd:
+ case new_line_state + other_char_cmd:
+ */
+ default:
+ lmt_input_state.cur_input.state = mid_line_state;
+ break;
+ }
+ } else {
+ if (! io_token_input(lmt_input_state.cur_input.name)) {
+ lmt_input_state.cur_input.state = new_line_state;
+ }
+ /*tex
+
+ Move to next line of file, or |goto restart| if there is no next line, or |return| if a
+ |\read| line has finished.
+
+ */
+ do {
+ next_line_retval r = tex_aux_next_line();
+ if (r == next_line_restart) {
+ /*tex This happens more often. */
+ return 0;
+ } else if (r == next_line_return) {
+ return 1;
+ }
+ } while (0);
+ /* check_interrupt(); */
+ goto SWITCH;
+ }
+ return 1;
+}
+
+/*tex
+
+ Notice that a code like |^^8| becomes |x| if not followed by a hex digit. We only support a
+ limited set:
+
+ \starttyping
+ ^^^^^^XXXXXX
+ ^^^^XXXXXX
+ ^^XX ^^<char>
+ \stoptyping
+
+*/
+
+# define is_hex(a) ((a >= '0' && a <= '9') || (a >= 'a' && a <= 'f'))
+
+ inline static halfword tex_aux_two_hex_to_cur_chr(int c1, int c2)
+ {
+ return
+ 0x10 * (c1 <= '9' ? c1 - '0' : c1 - 'a' + 10)
+ + 0x01 * (c2 <= '9' ? c2 - '0' : c2 - 'a' + 10);
+ }
+
+ inline static halfword tex_aux_four_hex_to_cur_chr(int c1, int c2,int c3, int c4)
+ {
+ return
+ 0x1000 * (c1 <= '9' ? c1 - '0' : c1 - 'a' + 10)
+ + 0x0100 * (c2 <= '9' ? c2 - '0' : c2 - 'a' + 10)
+ + 0x0010 * (c3 <= '9' ? c3 - '0' : c3 - 'a' + 10)
+ + 0x0001 * (c4 <= '9' ? c4 - '0' : c4 - 'a' + 10);
+}
+
+inline static halfword tex_aux_six_hex_to_cur_chr(int c1, int c2, int c3, int c4, int c5, int c6)
+{
+ return
+ 0x100000 * (c1 <= '9' ? c1 - '0' : c1 - 'a' + 10)
+ + 0x010000 * (c2 <= '9' ? c2 - '0' : c2 - 'a' + 10)
+ + 0x001000 * (c3 <= '9' ? c3 - '0' : c3 - 'a' + 10)
+ + 0x000100 * (c4 <= '9' ? c4 - '0' : c4 - 'a' + 10)
+ + 0x000010 * (c5 <= '9' ? c5 - '0' : c5 - 'a' + 10)
+ + 0x000001 * (c6 <= '9' ? c6 - '0' : c6 - 'a' + 10);
+
+}
+
+static int tex_aux_process_sup_mark(void)
+{
+ if (cur_chr == lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc]) {
+ if (lmt_input_state.cur_input.loc < lmt_input_state.cur_input.limit) {
+ if ((cur_chr == lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 1]) && (cur_chr == lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 2])) {
+ if ((cur_chr == lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 3]) && (cur_chr == lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 4])) {
+ if ((lmt_input_state.cur_input.loc + 10) <= lmt_input_state.cur_input.limit) {
+ /*tex |^^^^^^XXXXXX| */
+ int c1 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 5];
+ int c2 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 6];
+ int c3 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 7];
+ int c4 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 8];
+ int c5 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 9];
+ int c6 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 10];
+ if (is_hex(c1) && is_hex(c2) && is_hex(c3) && is_hex(c4) && is_hex(c5) && is_hex(c6)) {
+ lmt_input_state.cur_input.loc += 11;
+ cur_chr = tex_aux_six_hex_to_cur_chr(c1, c2, c3, c4, c5, c6);
+ return 1;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^^^ needs six hex digits",
+ NULL
+ );
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^^^ needs six hex digits, end of input",
+ NULL
+ );
+ }
+ } else if ((lmt_input_state.cur_input.loc + 6) <= lmt_input_state.cur_input.limit) {
+ /*tex |^^^^XXXX| */
+ int c1 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 3];
+ int c2 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 4];
+ int c3 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 5];
+ int c4 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 6];
+ if (is_hex(c1) && is_hex(c2) && is_hex(c3) && is_hex(c4)) {
+ lmt_input_state.cur_input.loc += 7;
+ cur_chr = tex_aux_four_hex_to_cur_chr(c1, c2, c3, c4);
+ return 1;
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^ needs four hex digits",
+ NULL
+ );
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^ needs four hex digits, end of input",
+ NULL
+ );
+ }
+ } else if ((lmt_input_state.cur_input.loc + 2) <= lmt_input_state.cur_input.limit) {
+ /*tex |^^XX| */
+ int c1 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 1];
+ int c2 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 2];
+ if (is_hex(c1) && is_hex(c2)) {
+ lmt_input_state.cur_input.loc += 3;
+ cur_chr = tex_aux_two_hex_to_cur_chr(c1, c2);
+ return 1;
+ }
+ }
+ /*tex The single character case: */
+ {
+ int c1 = lmt_fileio_state.io_buffer[lmt_input_state.cur_input.loc + 1];
+ if (c1 < 0200) {
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.loc + 2;
+ // if (is_hex(c1) && (iloc <= ilimit)) {
+ // int c2 = fileio_state.io_buffer[iloc];
+ // if (is_hex(c2)) {
+ // ++iloc;
+ // cur_chr = two_hex_to_cur_chr(c1, c2);
+ // return 1;
+ // }
+ // }
+ // /*tex The somewhat odd cases, often special control characters: */
+ cur_chr = (c1 < 0100 ? c1 + 0100 : c1 - 0100);
+ return 1;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+/*tex
+
+ Control sequence names are scanned only when they appear in some line of a file. Once they have
+ been scanned the first time, their |eqtb| location serves as a unique identification, so \TEX\
+ doesn't need to refer to the original name any more except when it prints the equivalent in
+ symbolic form.
+
+ The program that scans a control sequence has been written carefully in order to avoid the
+ blowups that might otherwise occur if a malicious user tried something like |\catcode'15 = 0|.
+ The algorithm might look at |buffer[ilimit + 1]|, but it never looks at |buffer[ilimit + 2]|.
+
+ If expanded characters like |^^A| or |^^df| appear in or just following a control sequence name,
+ they are converted to single characters in the buffer and the process is repeated, slowly but
+ surely.
+
+*/
+
+/*tex
+
+ Whenever we reach the following piece of code, we will have |cur_chr = buffer[k - 1]| and |k <=
+ ilimit + 1| and |cat = get_cat_code(cat_code_table, cur_chr)|. If an expanded code like |^^A| or
+ |^^df| appears in |buffer[(k - 1) .. (k + 1)]| or |buffer[(k - 1) .. (k + 2)]|, we will store
+ the corresponding code in |buffer[k - 1]| and shift the rest of the buffer left two or three
+ places.
+
+*/
+
+static int tex_aux_check_expanded_code(int *kk, halfword *chr)
+{
+ if (sup_mark_mode_par > 1 || (sup_mark_mode_par == 1 && cur_mode == mmode)) {
+ return 0;
+ } else {
+ int k = *kk;
+ /* chr is the ^ character or an equivalent one */
+ if (lmt_fileio_state.io_buffer[k] == *chr && k < lmt_input_state.cur_input.limit) {
+ int d = 1;
+ int l;
+ if ((*chr == lmt_fileio_state.io_buffer[k + 1]) && (*chr == lmt_fileio_state.io_buffer[k + 2])) {
+ if ((*chr == lmt_fileio_state.io_buffer[k + 3]) && (*chr == lmt_fileio_state.io_buffer[k + 4])) {
+ if ((k + 10) <= lmt_input_state.cur_input.limit) {
+ int c1 = lmt_fileio_state.io_buffer[k + 6 - 1];
+ int c2 = lmt_fileio_state.io_buffer[k + 6 ];
+ int c3 = lmt_fileio_state.io_buffer[k + 6 + 1];
+ int c4 = lmt_fileio_state.io_buffer[k + 6 + 2];
+ int c5 = lmt_fileio_state.io_buffer[k + 6 + 3];
+ int c6 = lmt_fileio_state.io_buffer[k + 6 + 4];
+ if (is_hex(c1) && is_hex(c2) && is_hex(c3) && is_hex(c4) && is_hex(c5) && is_hex(c6)) {
+ d = 6;
+ *chr = tex_aux_six_hex_to_cur_chr(c1, c2, c3, c4, c5, c6);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^^^ needs six hex digits",
+ NULL
+ );
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^^^ needs six hex digits, end of input",
+ NULL
+ );
+ }
+ } else if ((k + 6) <= lmt_input_state.cur_input.limit) {
+ int c1 = lmt_fileio_state.io_buffer[k + 4 - 1];
+ int c2 = lmt_fileio_state.io_buffer[k + 4 ];
+ int c3 = lmt_fileio_state.io_buffer[k + 4 + 1];
+ int c4 = lmt_fileio_state.io_buffer[k + 4 + 2];
+ if (is_hex(c1) && is_hex(c2) && is_hex(c3) && is_hex(c4)) {
+ d = 4;
+ *chr = tex_aux_four_hex_to_cur_chr(c1, c2, c3, c4);
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^ needs four hex digits",
+ NULL
+ );
+ }
+ } else {
+ tex_handle_error(
+ normal_error_type,
+ "^^^^ needs four hex digits, end of input",
+ NULL
+ );
+ }
+ } else {
+ int c1 = lmt_fileio_state.io_buffer[k + 1];
+ if (c1 < 0200) { /* really ? */
+ d = 1;
+ if (is_hex(c1) && (k + 2) <= lmt_input_state.cur_input.limit) {
+ int c2 = lmt_fileio_state.io_buffer[k + 2];
+ if (is_hex(c2)) {
+ d = 2;
+ *chr = tex_aux_two_hex_to_cur_chr(c1, c2);
+ } else {
+ *chr = (c1 < 0100 ? c1 + 0100 : c1 - 0100);
+ }
+ } else {
+ *chr = (c1 < 0100 ? c1 + 0100 : c1 - 0100);
+ }
+ }
+ }
+ if (d > 2) {
+ d = 2 * d - 1;
+ } else {
+ d++;
+ }
+ if (*chr <= 0x7F) {
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) *chr;
+ } else if (*chr <= 0x7FF) {
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0xC0 + *chr / 0x40);
+ k++;
+ d--;
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0x80 + *chr % 0x40);
+ } else if (*chr <= 0xFFFF) {
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0xE0 + *chr / 0x1000);
+ k++;
+ d--;
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0x80 + (*chr % 0x1000) / 0x40);
+ k++;
+ d--;
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0x80 + (*chr % 0x1000) % 0x40);
+ } else {
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0xF0 + *chr / 0x40000);
+ k++;
+ d--;
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0x80 + (*chr % 0x40000) / 0x1000);
+ k++;
+ d--;
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0x80 + ((*chr % 0x40000) % 0x1000) / 0x40);
+ k++;
+ d--;
+ lmt_fileio_state.io_buffer[k - 1] = (unsigned char) (0x80 + ((*chr % 0x40000) % 0x1000) % 0x40);
+ }
+ l = k;
+ lmt_input_state.cur_input.limit -= d;
+ while (l <= lmt_input_state.cur_input.limit) {
+ lmt_fileio_state.io_buffer[l] = lmt_fileio_state.io_buffer[l + d];
+ l++;
+ }
+ *kk = k;
+ cur_chr = *chr; /* hm */
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+}
+
+static int tex_aux_scan_control_sequence(void)
+{
+ int state = mid_line_state;
+ if (lmt_input_state.cur_input.loc > lmt_input_state.cur_input.limit) {
+ /*tex |state| is irrelevant in this case. */
+ cur_cs = null_cs;
+ } else {
+ /*tex |cat_code(cur_chr)|, usually: */
+ while (1) {
+ int loc = lmt_input_state.cur_input.loc;
+ halfword chr = get_unichar_from_buffer(&loc);
+ halfword cat = tex_aux_the_cat_code(chr);
+ if (cat != letter_cmd || loc > lmt_input_state.cur_input.limit) {
+ if (cat == spacer_cmd) {
+ state = skip_blanks_state;
+ } else {
+ state = mid_line_state;
+ if (cat == superscript_cmd && tex_aux_check_expanded_code(&loc, &chr)) {
+ continue;
+ }
+ }
+ // state = cat == spacer_cmd ? skip_blanks_state : mid_line_state;
+ // /*tex If an expanded \unknown */
+ // if (cat == sup_mark_cmd && check_expanded_code(&loc, chr)) {
+ // continue;
+ // }
+ } else {
+ state = skip_blanks_state;
+ do {
+ chr = get_unichar_from_buffer(&loc);
+ cat = tex_aux_the_cat_code(chr);
+ } while (cat == letter_cmd && loc <= lmt_input_state.cur_input.limit);
+ /*tex If an expanded \unknown */
+ if (cat == superscript_cmd && tex_aux_check_expanded_code(&loc, &chr)) {
+ continue;
+ } else if (cat != letter_cmd) {
+ /*tex Backtrack one character which can be \UTF. */
+ if (chr <= 0x7F) {
+ loc -= 1; /* in most cases */
+ } else if (chr > 0xFFFF) {
+ loc -= 4;
+ } else if (chr > 0x7FF) {
+ loc -= 3;
+ } else /* if (cur_chr > 0x7F) */ {
+ loc -= 2;
+ }
+ /*tex Now |k| points to first nonletter. */
+ }
+ }
+ cur_cs = tex_id_locate(lmt_input_state.cur_input.loc, loc - lmt_input_state.cur_input.loc, ! lmt_hash_state.no_new_cs);
+ lmt_input_state.cur_input.loc = loc;
+ break;
+ }
+ }
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = eq_value(cur_cs);
+ return state;
+}
+
+/*tex
+
+ All of the easy branches of |get_next| have now been taken care of. There is one more branch.
+ Conversely, the |file_warning| procedure is invoked when a file ends and some groups entered or
+ conditionals started while reading from that file are still incomplete.
+
+*/
+
+static void tex_aux_file_warning(void)
+{
+ halfword cond_ptr = lmt_save_state.save_stack_data.ptr; /*tex saved value of |save_ptr| or |cond_ptr| */
+ int cur_if = cur_group; /*tex saved value of |cur_group| or |cur_if| */
+ int cur_unless = 0;
+ int if_step = 0;
+ int if_unless = 0;
+ int if_limit = cur_level; /*tex saved value of |cur_level| or |if_limit| */
+ int if_line = 0; /*tex saved value of |if_line| */
+ lmt_save_state.save_stack_data.ptr = cur_boundary;
+ while (lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].group != lmt_save_state.save_stack_data.ptr) {
+ --cur_level;
+ tex_print_nlp();
+ tex_print_format("Warning: end of file when %G is incomplete", 1);
+ cur_group = save_level(lmt_save_state.save_stack_data.ptr);
+ lmt_save_state.save_stack_data.ptr = save_value(lmt_save_state.save_stack_data.ptr);
+ }
+ /*tex Restore old values. */
+ lmt_save_state.save_stack_data.ptr = cond_ptr;
+ cur_level = (quarterword) if_limit;
+ cur_group = (quarterword) cur_if;
+ cond_ptr = lmt_condition_state.cond_ptr;
+ cur_if = lmt_condition_state.cur_if;
+ cur_unless = lmt_condition_state.cur_unless;
+ if_step = lmt_condition_state.if_step;
+ if_unless = lmt_condition_state.if_unless;
+ if_limit = lmt_condition_state.if_limit;
+ if_line = lmt_condition_state.if_line;
+ while (lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].if_ptr != lmt_condition_state.cond_ptr) {
+ /* todo, more info */
+ tex_print_nlp();
+ tex_print_format("Warning: end of file when %C", if_test_cmd, lmt_condition_state.cur_if);
+ if (lmt_condition_state.if_limit == fi_code) {
+ tex_print_str_esc("else");
+ }
+ if (lmt_condition_state.if_line) {
+ tex_print_format(" entered on line %i", lmt_condition_state.if_line);
+ }
+ tex_print_str(" is incomplete");
+ lmt_condition_state.cur_if = if_limit_subtype(lmt_condition_state.cond_ptr);
+ lmt_condition_state.cur_unless = if_limit_unless(lmt_condition_state.cond_ptr);
+ lmt_condition_state.if_step = if_limit_step(lmt_condition_state.cond_ptr);
+ lmt_condition_state.if_unless = if_limit_stepunless(lmt_condition_state.cond_ptr);
+ lmt_condition_state.if_limit = if_limit_type(lmt_condition_state.cond_ptr);
+ lmt_condition_state.if_line = if_limit_line(lmt_condition_state.cond_ptr);
+ lmt_condition_state.cond_ptr = node_next(lmt_condition_state.cond_ptr);
+ }
+ /*tex restore old values */
+ lmt_condition_state.cond_ptr = cond_ptr;
+ lmt_condition_state.cur_if = cur_if;
+ lmt_condition_state.cur_unless = cur_unless;
+ lmt_condition_state.if_step = if_step;
+ lmt_condition_state.if_unless = if_unless;
+ lmt_condition_state.if_limit = if_limit;
+ lmt_condition_state.if_line = if_line;
+ tex_print_nlp();
+ if (tracing_nesting_par > 1) {
+ tex_show_context();
+ }
+ if (lmt_error_state.history == spotless) {
+ lmt_error_state.history = warning_issued;
+ }
+}
+
+static void tex_aux_check_validity(void)
+{
+ switch (lmt_input_state.scanner_status) {
+ case scanner_is_normal:
+ break;
+ case scanner_is_skipping:
+ tex_handle_error(
+ condition_error_type,
+ "The file ended while I was skipping conditional text.",
+ "This kind of error happens when you say '\\if...' and forget the\n"
+ "matching '\\fi'. It can also be that you use '\\orelse' or '\\orunless\n'"
+ "in the wrong way. Or maybe a forbidden control sequence was encountered."
+ );
+ break;
+ case scanner_is_defining:
+ tex_handle_error(runaway_error_type, "The file ended when scanning a definition.", NULL);
+ break;
+ case scanner_is_matching:
+ tex_handle_error(runaway_error_type, "The file ended when scanning an argument.", NULL);
+ break;
+ case scanner_is_tolerant:
+ break;
+ case scanner_is_aligning:
+ tex_handle_error(runaway_error_type, "The file ended when scanning an alignment preamble.", NULL);
+ break;
+ case scanner_is_absorbing:
+ tex_handle_error(runaway_error_type, "The file ended when absorbing something.", NULL);
+ break;
+ }
+}
+
+static next_line_retval tex_aux_next_line(void)
+{
+ if (lmt_input_state.cur_input.name > io_initial_input_code) {
+ /*tex Read next line of file into |buffer|, or |goto restart| if the file has ended. */
+ unsigned inhibit_eol = 0;
+ ++lmt_input_state.input_line;
+ lmt_fileio_state.io_first = lmt_input_state.cur_input.start;
+ if (! lmt_token_state.force_eof) {
+ unsigned force_eol = 0;
+ switch (lmt_input_state.cur_input.name) {
+ case io_lua_input_code:
+ {
+ halfword n = null;
+ int cattable = 0;
+ int partial = 0;
+ int finalline = 0;
+ int t = lmt_cstring_input(&n, &cattable, &partial, &finalline);
+ switch (t) {
+ case eof_tex_input:
+ lmt_token_state.force_eof = 1;
+ break;
+ case string_tex_input:
+ /*tex string */
+ lmt_input_state.cur_input.limit = lmt_fileio_state.io_last; /*tex Was |firm_up_the_line();|. */
+ lmt_input_state.cur_input.cattable = (short) cattable;
+ lmt_input_state.cur_input.partial = (signed char) partial;
+ if (finalline || partial || cattable == no_catcode_table_preset) {
+ inhibit_eol = 1;
+ }
+ if (! partial) {
+ lmt_input_state.cur_input.state = new_line_state;
+ }
+ break;
+ case token_tex_input:
+ /*tex token */
+ if (n >= cs_token_flag && eq_type(n - cs_token_flag) == input_cmd && eq_value(n - cs_token_flag) == end_of_input_code && lmt_input_state.cur_input.index > 0) {
+ tex_end_file_reading();
+ }
+ tex_back_input(n);
+ return next_line_restart;
+ case token_list_tex_input:
+ /*tex token */
+ tex_begin_backed_up_list(n);
+ return next_line_restart;
+ case node_tex_input:
+ /*tex node */
+ if (node_token_overflow(n)) {
+ tex_back_input(token_val(ignore_cmd, node_token_lsb(n)));
+ tex_reinsert_token(token_val(node_cmd, node_token_msb(n)));
+ return next_line_restart;
+ } else {
+ /*tex |0x10FFFF == 1114111| */
+ tex_back_input(token_val(node_cmd, n));
+ return next_line_restart;
+ }
+ default:
+ lmt_token_state.force_eof = 1;
+ break;
+ }
+ break;
+ }
+ case io_token_input_code:
+ case io_token_eof_input_code:
+ {
+ /* can be simplified but room for extensions now */
+ halfword n = null;
+ int cattable = 0;
+ int partial = 0;
+ int finalline = 0;
+ int t = lmt_cstring_input(&n, &cattable, &partial, &finalline);
+ switch (t) {
+ case eof_tex_input:
+ lmt_token_state.force_eof = 1;
+ if (lmt_input_state.cur_input.name == io_token_eof_input_code && every_eof_par) {
+ force_eol = 1;
+ }
+ break;
+ case string_tex_input:
+ /*tex string */
+ lmt_input_state.cur_input.limit = lmt_fileio_state.io_last; /*tex Was |firm_up_the_line();|. */
+ lmt_input_state.cur_input.cattable = (short) cattable;
+ lmt_input_state.cur_input.partial = (signed char) partial;
+ inhibit_eol = lmt_input_state.cur_input.name != io_token_eof_input_code;
+ if (! partial) {
+ lmt_input_state.cur_input.state = new_line_state;
+ }
+ break;
+ default:
+ lmt_token_state.force_eof = 1;
+ break;
+ }
+ break;
+ }
+ case io_tex_macro_code:
+ /* what */
+ default:
+ if (tex_lua_input_ln()) {
+ /*tex Not end of file, set |ilimit|. */
+ lmt_input_state.cur_input.limit = lmt_fileio_state.io_last; /*tex Was |firm_up_the_line();|. */
+ lmt_input_state.cur_input.cattable = default_catcode_table_preset;
+ } else if (every_eof_par && (! lmt_input_state.in_stack[lmt_input_state.cur_input.index].end_of_file_seen)) {
+ force_eol = 1;
+ } else {
+ tex_aux_check_validity();
+ lmt_token_state.force_eof = 1;
+ }
+ break;
+ }
+ if (force_eol) {
+ lmt_input_state.cur_input.limit = lmt_fileio_state.io_first - 1;
+ /* tex Fake one empty line. */
+ lmt_input_state.in_stack[lmt_input_state.cur_input.index].end_of_file_seen = 1;
+ tex_begin_token_list(every_eof_par, every_eof_text);
+ return next_line_restart;
+ }
+ }
+ if (lmt_token_state.force_eof) {
+ if (tracing_nesting_par > 0) {
+ if ((lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].group != cur_boundary) || (lmt_input_state.in_stack[lmt_input_state.in_stack_data.ptr].if_ptr != lmt_condition_state.cond_ptr)) {
+ if (! io_token_input(lmt_input_state.cur_input.name)) {
+ /*tex Give warning for some unfinished groups and/or conditionals. */
+ tex_aux_file_warning();
+ }
+ }
+ }
+ if (io_file_input(lmt_input_state.cur_input.name)) {
+ tex_report_stop_file();
+ --lmt_input_state.open_files;
+ }
+ lmt_token_state.force_eof = 0;
+ tex_end_file_reading();
+ return next_line_restart;
+ } else {
+ if (inhibit_eol || end_line_char_inactive) {
+ lmt_input_state.cur_input.limit--;
+ } else {
+ lmt_fileio_state.io_buffer[lmt_input_state.cur_input.limit] = (unsigned char) end_line_char_par;
+ }
+ lmt_fileio_state.io_first = lmt_input_state.cur_input.limit + 1;
+ lmt_input_state.cur_input.loc = lmt_input_state.cur_input.start;
+ /*tex We're ready to read. */
+ }
+ } else if (lmt_input_state.input_stack_data.ptr > 0) {
+ cur_cmd = 0;
+ cur_chr = 0;
+ return next_line_return;
+ } else {
+ /*tex A somewhat weird check: */
+ switch (lmt_print_state.selector) {
+ case no_print_selector_code:
+ case terminal_selector_code:
+ tex_open_log_file();
+ break;
+ }
+ tex_handle_error(eof_error_type, "end of file encountered", NULL);
+ /*tex Just in case it is not handled in a callback: */
+ if (lmt_error_state.interaction > nonstop_mode) {
+ tex_fatal_error("aborting job");
+ }
+ }
+ return next_line_ok;
+}
+
+/*tex
+ Let's consider now what happens when |get_next| is looking at a token list.
+*/
+
+static int tex_aux_get_next_tokenlist(void)
+{
+ halfword t = token_info(lmt_input_state.cur_input.loc);
+ /*tex Move to next. */
+ lmt_input_state.cur_input.loc = token_link(lmt_input_state.cur_input.loc);
+ if (t >= cs_token_flag) {
+ /*tex A control sequence token */
+ cur_cs = t - cs_token_flag;
+ cur_cmd = eq_type(cur_cs);
+ if (cur_cmd == deep_frozen_dont_expand_cmd) {
+ /*tex
+
+ Get the next token, suppressing expansion. The present point in the program is
+ reached only when the |expand| routine has inserted a special marker into the
+ input. In this special case, |token_info(iloc)| is known to be a control sequence
+ token, and |token_link(iloc) = null|.
+
+ */
+ cur_cs = token_info(lmt_input_state.cur_input.loc) - cs_token_flag;
+ lmt_input_state.cur_input.loc = null;
+ cur_cmd = eq_type(cur_cs);
+ if (cur_cmd > max_command_cmd) {
+ cur_cmd = relax_cmd;
+ // cur_chr = no_expand_flag;
+ cur_chr = no_expand_relax_code;
+ return 1;
+ }
+ }
+ cur_chr = eq_value(cur_cs);
+ } else {
+ cur_cmd = token_cmd(t);
+ cur_chr = token_chr(t);
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ lmt_input_state.align_state++;
+ break;
+ case right_brace_cmd:
+ lmt_input_state.align_state--;
+ break;
+ case parameter_reference_cmd:
+ /*tex Insert macro parameter and |goto restart|. */
+ tex_begin_parameter_list(lmt_input_state.parameter_stack[lmt_input_state.cur_input.parameter_start + cur_chr - 1]);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+/*tex
+
+ Now we're ready to take the plunge into |get_next| itself. Parts of this routine are executed
+ more often than any other instructions of \TEX. This sets |cur_cmd|, |cur_chr|, |cur_cs| to
+ next token.
+
+ Handling alignments is interwoven because there we switch between constructing cells and rows
+ (node lists) based on templates that are token lists. This is why in several places we find
+ checks for |align_state|.
+
+*/
+
+void tex_get_next(void)
+{
+ while (1) {
+ cur_cs = 0;
+ if (lmt_input_state.cur_input.state != token_list_state) {
+ /*tex Input from external file, |goto restart| if no input found. */
+ if (! tex_aux_get_next_file()) {
+ continue;
+ } else {
+ /*tex Check align state later on! */
+ }
+ } else if (! lmt_input_state.cur_input.loc) {
+ /*tex List exhausted, resume previous level. */
+ tex_end_token_list();
+ continue;
+ } else if (! tex_aux_get_next_tokenlist()) {
+ /*tex Parameter needs to be expanded. */
+ continue;
+ }
+ if ((lmt_input_state.align_state == 0) && (cur_cmd == alignment_tab_cmd || cur_cmd == alignment_cmd)) {
+ /*tex If an alignment entry has just ended, take appropriate action. */
+ tex_insert_alignment_template();
+ continue;
+ } else {
+ break;
+ }
+ }
+}
+
+/*tex
+
+ Since |get_next| is used so frequently in \TEX, it is convenient to define three related
+ procedures that do a little more:
+
+ \startitemize
+ \startitem
+ |get_token| not only sets |cur_cmd| and |cur_chr|, it also sets |cur_tok|, a packed
+ halfword version of the current token.
+ \stopitem
+ \startitem
+ |get_x_token|, meaning \quote {get an expanded token}, is like |get_token|, but if the
+ current token turns out to be a user-defined control sequence (i.e., a macro call), or
+ a conditional, or something like |\topmark| or |\expandafter| or |\csname|, it is
+ eliminated from the input by beginning the expansion of the macro or the evaluation of
+ the conditional.
+ \stopitem
+ \startitem
+ |x_token| is like |get_x_token| except that it assumes that |get_next| has already been
+ called.
+ \stopitem
+ \stopitemize
+
+ In fact, these three procedures account for almost every use of |get_next|. No new control
+ sequences will be defined except during a call of |get_token|, or when |\csname| compresses a
+ token list, because |no_new_control_sequence| is always |true| at other times.
+
+ This sets |cur_cmd|, |cur_chr|, |cur_tok|. For convenience we also return the token because in
+ some places we store it and then some direct assignment looks a bit nicer.
+
+*/
+
+halfword tex_get_token(void)
+{
+ lmt_hash_state.no_new_cs = 0;
+ tex_get_next();
+ lmt_hash_state.no_new_cs = 1;
+ cur_tok = cur_cs ? cs_token_flag + cur_cs : token_val(cur_cmd, cur_chr);
+ return cur_tok;
+}
+
+/*tex This changes the string |s| to a token list. */
+
+halfword tex_string_to_toks(const char *ss)
+{
+ const char *s = ss;
+ const char *se = ss + strlen(s);
+ /*tex tail of the token list */
+ halfword h = null;
+ halfword p = null;
+ /*tex new node being added to the token list via |store_new_token| */
+ while (s < se) {
+ halfword t = (halfword) aux_str2uni((const unsigned char *) s);
+ s += utf8_size(t);
+ if (t == ' ') {
+ t = space_token;
+ } else {
+ t += other_token;
+ }
+ p = tex_store_new_token(p, t);
+ if (! h) {
+ h = p;
+ }
+ }
+ return h;
+}
+
+/*tex
+
+ The token lists for macros and for other things like |\mark| and |\output| and |\write| are
+ produced by a procedure called |scan_toks|.
+
+ Before we get into the details of |scan_toks|, let's consider a much simpler task, that of
+ converting the current string into a token list. The |str_toks| function does this; it
+ classifies spaces as type |spacer| and everything else as type |other_char|.
+
+ The token list created by |str_toks| begins at |link(temp_token_head)| and ends at the value
+ |p| that is returned. If |p = temp_token_head|, the list is empty.
+
+ |lua_str_toks| is almost identical, but it also escapes the three symbols that \LUA\ considers
+ special while scanning a literal string.
+
+ This changes the string |str_pool[b .. pool_ptr]| to a token list:
+
+*/
+
+static halfword lmt_str_toks(lstring b) /* returns head */
+{
+ /*tex index into string */
+ unsigned char *k = (unsigned char *) b.s;
+ /*tex tail of the token list */
+ halfword h = null;
+ halfword p = null;
+ while (k < (unsigned char *) b.s + b.l) {
+ /*tex token being appended */
+ halfword t = aux_str2uni(k);
+ k += utf8_size(t);
+ if (t == ' ') {
+ t = space_token;
+ } else {
+ if ((t == '\\') || (t == '"') || (t == '\'') || (t == 10) || (t == 13)) {
+ p = tex_store_new_token(p, escape_token);
+ if (t == 10) {
+ t = 'n';
+ } else if (t == 13) {
+ t = 'r';
+ }
+ }
+ t += other_token;
+ }
+ p = tex_store_new_token(p, t);
+ if (! h) {
+ h = p;
+ }
+ }
+ return h;
+}
+
+/*tex
+
+ Incidentally, the main reason for wanting |str_toks| is the function |the_toks|, which has
+ similar input/output characteristics. This changes the string |str_pool[b .. pool_ptr]| to a
+ token list:
+
+*/
+
+halfword tex_str_toks(lstring s, halfword *tail)
+{
+ halfword h = null;
+ halfword p = null;
+ if (s.s) {
+ unsigned char *k = s.s;
+ unsigned char *l = k + s.l;
+ while (k < l) {
+ halfword t = aux_str2uni(k);
+ if (t == ' ') {
+ k += 1;
+ t = space_token;
+ } else {
+ k += utf8_size(t);
+ t += other_token;
+ }
+ p = tex_store_new_token(p, t);
+ if (! h) {
+ h = p;
+ }
+ }
+ }
+ if (tail) {
+ *tail = null;
+ }
+ return h;
+}
+
+halfword tex_cur_str_toks(halfword *tail)
+{
+ halfword h = null;
+ halfword p = null;
+ unsigned char *k = (unsigned char *) lmt_string_pool_state.string_temp;
+ if (k) {
+ unsigned char *l = k + lmt_string_pool_state.string_temp_top;
+ /*tex tail of the token list */
+ while (k < l) {
+ /*tex token being appended */
+ halfword t = aux_str2uni(k);
+ if (t == ' ') {
+ k += 1;
+ t = space_token;
+ } else {
+ k += utf8_size(t);
+ t += other_token;
+ }
+ p = tex_store_new_token(p, t);
+ if (! h) {
+ h = p;
+ }
+ }
+ }
+ tex_reset_cur_string();
+ if (tail) {
+ *tail = p;
+ }
+ return h;
+}
+
+/*tex
+
+ Most of the converter is similar to the one I made for macro so at some point I can make a
+ helper; also todo: there is no need to go through the pool.
+
+*/
+
+/*tex Change the string |str_pool[b..pool_ptr]| to a token list. */
+
+halfword tex_str_scan_toks(int ct, lstring ls)
+{
+ /*tex index into string */
+ unsigned char *k = ls.s;
+ unsigned char *l = k + ls.l;
+ /*tex tail of the token list */
+ halfword h = null;
+ halfword p = null;
+ while (k < l) {
+ int cc;
+ /*tex token being appended */
+ halfword t = aux_str2uni(k);
+ k += utf8_size(t);
+ cc = tex_get_cat_code(ct, t);
+ if (cc == 0) {
+ /*tex We have a potential control sequence so we check for it. */
+ int lname = 0 ;
+ int s = 0 ;
+ int c = 0 ;
+ unsigned char *name = k ;
+ while (k < l) {
+ t = (halfword) aux_str2uni((const unsigned char *) k);
+ s = utf8_size(t);
+ c = tex_get_cat_code(ct,t);
+ if (c == 11) {
+ k += s ;
+ lname += s ;
+ } else if (c == 10) {
+ /*tex We ignore a trailing space like normal scanning does. */
+ k += s ;
+ break ;
+ } else {
+ break ;
+ }
+ }
+ if (s > 0) {
+ /*tex We have a potential |\cs|. */
+ halfword cs = tex_string_locate((const char *) name, lname, 0);
+ if (cs == undefined_control_sequence) {
+ /*tex Let's play safe and backtrack. */
+ t += cc * (1<<21);
+ k = name ;
+ } else {
+ t = cs_token_flag + cs;
+ }
+ } else {
+ /*tex
+ Just a character with some meaning, so |\unknown| becomes effectively
+ |\unknown| assuming that |\\| has some useful meaning of course.
+ */
+ t += cc * (1<<21);
+ k = name ;
+ }
+ } else {
+ /*tex
+ Whatever token, so for instance $x^2$ just works given a \TEX\ catcode regime.
+ */
+ t += cc * (1<<21);
+ }
+ p = tex_store_new_token(p, t);
+ if (! h) {
+ h = p;
+ }
+ }
+ return h;
+}
+
+/* these two can be combined, then we can avoid the h check */
+
+static void tex_aux_set_toks_register(halfword loc, singleword cmd, halfword t, int g)
+{
+ halfword ref = get_reference_token();
+ set_token_link(ref, t);
+ tex_define((g > 0) ? global_flag_bit : 0, loc, cmd == internal_toks_cmd ? internal_toks_reference_cmd : register_toks_reference_cmd, ref);
+}
+
+static void tex_aux_append_copied_toks_list(halfword loc, singleword cmd, int g, halfword s, halfword t)
+{
+ halfword ref = get_reference_token();
+ halfword p = ref;
+ while (s) {
+ p = tex_store_new_token(p, token_info(s));
+ s = token_link(s);
+ }
+ while (t) {
+ p = tex_store_new_token(p, token_info(t));
+ t = token_link(t);
+ }
+ tex_define((g > 0) ? global_flag_bit : 0, loc, cmd == internal_toks_cmd ? internal_toks_reference_cmd : register_toks_reference_cmd, ref);
+}
+
+/*tex Public helper: */
+
+halfword tex_copy_token_list(halfword h1, halfword *t)
+{
+ halfword h2 = tex_store_new_token(null, token_info(h1));
+ halfword t1 = token_link(h1);
+ halfword t2 = h2;
+ while (t1) {
+ t2 = tex_store_new_token(t2, token_info(t1));
+ t1 = token_link(t1);
+ }
+ if (t) {
+ *t = t2;
+ }
+ return h2;
+}
+
+/*tex
+
+ At some point I decided to implement the following primitives:
+
+ \starttabulate[|T||T||]
+ \NC 0 \NC \type {toksapp} \NC 1 \NC \type {etoksapp} \NC \NR
+ \NC 2 \NC \type {tokspre} \NC 3 \NC \type {etokspre} \NC \NR
+ \NC 4 \NC \type {gtoksapp} \NC 5 \NC \type {xtoksapp} \NC \NR
+ \NC 6 \NC \type {gtokspre} \NC 7 \NC \type {xtokspre} \NC \NR
+ \stoptabulate
+
+ These append and prepend tokens to token lists. In \CONTEXT\ we always had macros doing something
+ like that. It was only a few years later that I ran again into an article that Taco and I wrote
+ in 1999 in the NTG Maps about an extension to \ETEX\ (called eetex). The first revelation was
+ that I had completely forgotten about it, which can be explained by the two decade time-lap. The
+ second was that Taco actually added that to the program at that time, so I could have used (parts
+ of) that code. Anyway, among the other proposed (and implemented) features were manipulating
+ lists and ways to output packed data to the \DVI\ files (numbers packed into 1 upto 4 bytes).
+ Maybe some day I'll have a go at lists, although with todays computers there is not that much to
+ gain. Also, \CONTEXT\ progressed to different internals so the urge is no longer there. The also
+ discussed \SGML\ mode also in no longer that relevant given that we have \LUA.
+
+ If we want to handle macros too we really need to distinguish between toks and macros with
+ |cur_chr| above, but not now. We can't expand, and have to use |get_r_token| or so. I don't need
+ it anyway.
+
+ \starttyping
+ get_r_token();
+ if (cur_cmd == call_cmd) {
+ nt = cur_cs;
+ target = equiv(nt);
+ } else {
+ // some error message
+ }
+ \stoptyping
+*/
+
+# define immediate_permitted(loc,target) ((eq_level(loc) == cur_level) && (get_token_reference(target) == 0))
+
+void tex_run_combine_the_toks(void)
+{
+ halfword source = null;
+ halfword target = null;
+ halfword append, expand, global;
+ halfword nt, ns;
+ singleword cmd;
+ /* */
+ switch (cur_chr) {
+ case expanded_toks_code: append = 0; global = 0; expand = 1; break;
+ case append_toks_code: append = 1; global = 0; expand = 0; break;
+ case append_expanded_toks_code: append = 1; global = 0; expand = 1; break;
+ case prepend_toks_code: append = 2; global = 0; expand = 0; break;
+ case prepend_expanded_toks_code: append = 2; global = 0; expand = 1; break;
+ case global_expanded_toks_code: append = 0; global = 1; expand = 1; break;
+ case global_append_toks_code: append = 1; global = 1; expand = 0; break;
+ case global_append_expanded_toks_code: append = 1; global = 1; expand = 1; break;
+ case global_prepend_toks_code: append = 2; global = 1; expand = 0; break;
+ case global_prepend_expanded_toks_code: append = 2; global = 1; expand = 1; break;
+ default: append = 0; global = 0; expand = 0; break;
+ }
+ /*tex The target. */
+ tex_get_x_token();
+ if (cur_cmd == register_toks_cmd || cur_cmd == internal_toks_cmd) {
+ nt = eq_value(cur_cs);
+ cmd = (singleword) cur_cmd;
+ } else {
+ /*tex Maybe a number. */
+ tex_back_input(cur_tok);
+ nt = register_toks_location(tex_scan_toks_register_number());
+ cmd = register_toks_cmd;
+ }
+ target = eq_value(nt);
+ /*tex The source. */
+ do {
+ tex_get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_cmd == left_brace_cmd) {
+ source = expand ? tex_scan_toks_expand(1, NULL, 0) : tex_scan_toks_normal(1, NULL);
+ /*tex The action. */
+ if (source) {
+ if (target) {
+ halfword s = token_link(source);
+ if (s) {
+ halfword t = token_link(target);
+ if (! t) {
+ /*tex Can this happen? */
+ set_token_link(target, s);
+ token_link(source) = null;
+ } else {
+ switch (append) {
+ case 0:
+ goto ASSIGN_1;
+ case 1:
+ /*append */
+ if (immediate_permitted(nt,target)) {
+ halfword p = t;
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ token_link(p) = s;
+ token_link(source) = null;
+ } else {
+ tex_aux_append_copied_toks_list(nt, cmd, global, t, s);
+ }
+ break;
+ case 2:
+ /* prepend */
+ if (immediate_permitted(nt,target)) {
+ halfword p = s;
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ token_link(source) = null;
+ set_token_link(p, t);
+ set_token_link(target, s);
+ } else {
+ tex_aux_append_copied_toks_list(nt, cmd, global, s, t);
+ }
+ break;
+ }
+ }
+ }
+ } else {
+ ASSIGN_1:
+ tex_aux_set_toks_register(nt, cmd, token_link(source), global);
+ token_link(source) = null;
+ }
+ tex_flush_token_list(source);
+ }
+ } else {
+ if (cur_cmd == register_toks_cmd) {
+ ns = register_toks_number(eq_value(cur_cs));
+ } else if (cur_cmd == internal_toks_cmd) {
+ ns = internal_toks_number(eq_value(cur_cs));
+ } else {
+ ns = tex_scan_toks_register_number();
+ }
+ /*tex The action. */
+ source = toks_register(ns);
+ if (source) {
+ if (target) {
+ halfword s = token_link(source);
+ halfword t = token_link(target);
+ switch (append) {
+ case 0:
+ /*assign */
+ goto ASSIGN_2;
+ case 1:
+ /*append */
+ if (immediate_permitted(nt, target)) {
+ halfword p = t;
+ while (token_link(p)) {
+ p = token_link(p);
+ }
+ while (s) {
+ p = tex_store_new_token(p, token_info(s));
+ s = token_link(s);
+ }
+ } else {
+ tex_aux_append_copied_toks_list(nt, cmd, global, t, s);
+ }
+ break;
+ case 2:
+ if (immediate_permitted(nt, target)) {
+ halfword h = null;
+ halfword p = null;
+ while (s) {
+ p = tex_store_new_token(p, token_info(s));
+ if (! h) {
+ h = p;
+ }
+ s = token_link(s);
+ }
+ set_token_link(p, t);
+ set_token_link(target, h);
+ } else {
+ tex_aux_append_copied_toks_list(nt, cmd, global, s, t);
+ }
+ break;
+ }
+ } else {
+ ASSIGN_2:
+ // set_toks_register(nt, source, global);
+ tex_add_token_reference(source);
+ eq_value(nt) = source;
+ }
+ }
+ }
+}
+
+/*tex
+
+ This routine, used in the next one, prints the job name, possibly modified by the
+ |process_jobname| callback.
+
+*/
+
+static void tex_aux_print_job_name(void)
+{
+ if (lmt_fileio_state.job_name) {
+ /*tex \CCODE\ strings for jobname before and after processing. */
+ char *s = lmt_fileio_state.job_name;
+ int callback_id = lmt_callback_defined(process_jobname_callback);
+ if (callback_id > 0) {
+ char *ss;
+ int lua_retval = lmt_run_callback(lmt_lua_state.lua_instance, callback_id, "S->S", s, &ss);
+ if (lua_retval && ss) {
+ s = ss;
+ }
+ }
+ tex_print_str(s);
+ }
+}
+
+/*tex
+
+ The procedure |run_convert_tokens| uses |str_toks| to insert the token list for |convert|
+ functions into the scanner; |\outer| control sequences are allowed to follow |\string| and
+ |\meaning|.
+
+*/
+
+/*tex Codes not really needed but cleaner when testing */
+
+# define push_selector { \
+ saved_selector = lmt_print_state.selector; \
+ lmt_print_state.selector = new_string_selector_code; \
+}
+
+# define pop_selector { \
+ lmt_print_state.selector = saved_selector; \
+}
+
+void tex_run_convert_tokens(halfword code)
+{
+ /*tex Scan the argument for command |c|. */
+ switch (code) {
+ /*tex
+ The |number_code| is quite popular. Beware, when used with a lua none function, a zero
+ is injected. We could intercept it at the cost of messy code, but on the other hand,
+ nothing guarantees that the call returns a number so this side effect can be defended
+ as a recovery measure.
+ */
+ case number_code:
+ {
+ int saved_selector;
+ halfword v = tex_scan_int(0, NULL);
+ push_selector;
+ tex_print_int(v);
+ pop_selector;
+ break;
+ }
+ case to_integer_code:
+ case to_hexadecimal_code:
+ {
+ int saved_selector;
+ halfword v = tex_scan_int(0, NULL);
+ tex_get_x_token(); /* maybe not x here */
+ if (cur_cmd != relax_cmd) {
+ tex_back_input(cur_tok);
+ }
+ push_selector;
+ if (code == to_integer_code) {
+ tex_print_int(v);
+ } else {
+ tex_print_hex(v);
+ }
+ pop_selector;
+ break;
+ }
+ case to_scaled_code:
+ case to_sparse_scaled_code:
+ case to_dimension_code:
+ case to_sparse_dimension_code:
+ {
+ int saved_selector;
+ halfword v = tex_scan_dimen(0, 0, 0, 0, NULL);
+ tex_get_x_token(); /* maybe not x here */
+ if (cur_cmd != relax_cmd) {
+ tex_back_input(cur_tok);
+ }
+ push_selector;
+ switch (code) {
+ case to_sparse_dimension_code:
+ case to_sparse_scaled_code:
+ tex_print_sparse_dimension(v, no_unit);
+ break;
+ default:
+ tex_print_dimension(v, no_unit);
+ break;
+ }
+ switch (code) {
+ case to_dimension_code:
+ case to_sparse_dimension_code:
+ tex_print_unit(pt_unit);
+ break;
+ }
+ pop_selector;
+ break;
+ }
+ case to_mathstyle_code:
+ {
+ int saved_selector;
+ halfword v = tex_scan_math_style_identifier(1, 0);
+ push_selector;
+ tex_print_int(v);
+ pop_selector;
+ break;
+ }
+ case lua_function_code:
+ {
+ halfword v = tex_scan_int(0, NULL);
+ if (v > 0) {
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ lmt_function_call(v, 0);
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ } else {
+ tex_normal_error("luafunction", "invalid number");
+ }
+ return;
+ }
+ case lua_bytecode_code:
+ {
+ halfword v = tex_scan_int(0, NULL);
+ if (v < 0 || v > 65535) {
+ tex_normal_error("luabytecode", "invalid number");
+ } else {
+ strnumber u = tex_save_cur_string();
+ lmt_token_state.luacstrings = 0;
+ lmt_bytecode_call(v);
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ }
+ return;
+ }
+ case lua_code:
+ {
+ full_scanner_status saved_full_status = tex_save_full_scanner_status();
+ strnumber u = tex_save_cur_string();
+ halfword s = tex_scan_toks_expand(0, NULL, 0);
+ tex_unsave_full_scanner_status(saved_full_status);
+ lmt_token_state.luacstrings = 0;
+ lmt_token_call(s);
+ tex_delete_token_reference(s); /* boils down to flush_list */
+ tex_restore_cur_string(u);
+ if (lmt_token_state.luacstrings > 0) {
+ tex_lua_string_start();
+ }
+ /*tex No further action. */
+ return;
+ }
+ case expanded_code:
+ case semi_expanded_code:
+ {
+ full_scanner_status saved_full_status = tex_save_full_scanner_status();
+ strnumber u = tex_save_cur_string();
+ halfword s = tex_scan_toks_expand(0, NULL, code == semi_expanded_code);
+ tex_unsave_full_scanner_status(saved_full_status);
+ if (token_link(s)) {
+ tex_begin_inserted_list(token_link(s));
+ token_link(s) = null;
+ }
+ tex_put_available_token(s);
+ tex_restore_cur_string(u);
+ /*tex No further action. */
+ return;
+ }
+ /* case immediate_assignment_code: */
+ /* case immediate_assigned_code: */
+ /*tex
+ These two were an on-the-road-to-bachotex brain-wave. A first variant did more in
+ sequence till a relax or spacer was seen. These commands permits for instance setting
+ counters in full expansion. However, as we have the more powerful local control
+ mechanisms available these two commands have been dropped in \LUAMETATEX. Performance
+ wise there is not that much to gain from |\immediateassigned| and it's even somewhat
+ limited. So, they're gone now. Actually, one can also use the local control feature in
+ an |\edef|, which {\em is} rather efficient, so we're good anyway. The upgraded code
+ can be found in the archive.
+ */
+ case string_code:
+ {
+ int saved_selector;
+ int saved_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_get_token();
+ lmt_input_state.scanner_status = saved_scanner_status;
+ push_selector;
+ if (cur_cs) {
+ tex_print_cs(cur_cs);
+ } else {
+ tex_print_tex_str(cur_chr);
+ }
+ pop_selector;
+ break;
+ }
+ case cs_string_code:
+ {
+ int saved_selector;
+ int saved_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_get_token();
+ lmt_input_state.scanner_status = saved_scanner_status;
+ push_selector;
+ if (cur_cs) {
+ tex_print_cs_name(cur_cs);
+ } else {
+ tex_print_tex_str(cur_chr);
+ }
+ pop_selector;
+ break;
+ }
+ case detokenized_code:
+ {
+ int saved_selector;
+ int saved_scanner_status = lmt_input_state.scanner_status;
+ halfword t = null;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_get_token();
+ lmt_input_state.scanner_status = saved_scanner_status;
+ t = tex_get_available_token(cur_tok);
+ push_selector;
+ tex_show_token_list(t, null, extreme_token_show_max, 0);
+ tex_put_available_token(t);
+ pop_selector;
+ break;
+ }
+ case roman_numeral_code:
+ {
+ int saved_selector;
+ halfword v = tex_scan_int(0, NULL);
+ push_selector;
+ tex_print_roman_int(v);
+ pop_selector;
+ break;
+ }
+ case meaning_code:
+ case meaning_full_code:
+ case meaning_less_code:
+ case meaning_asis_code:
+ {
+ int saved_selector;
+ int saved_scanner_status = lmt_input_state.scanner_status;
+ lmt_input_state.scanner_status = scanner_is_normal;
+ tex_get_token();
+ lmt_input_state.scanner_status = saved_scanner_status;
+ push_selector;
+ tex_print_meaning(code);
+ pop_selector;
+ break;
+ }
+ case uchar_code:
+ {
+ int saved_selector;
+ int chr = tex_scan_char_number(0);
+ push_selector;
+ tex_print_tex_str(chr);
+ pop_selector;
+ break;
+ }
+ case lua_escape_string_code:
+ {
+ lstring escstr;
+ int l = 0;
+ int e = lmt_token_state.in_lua_escape;
+ full_scanner_status saved_full_status = tex_save_full_scanner_status();
+ halfword result = tex_scan_toks_expand(0, NULL, 0);
+ lmt_token_state.in_lua_escape = 1;
+ escstr.s = (unsigned char *) tex_tokenlist_to_tstring(result, 0, &l, 0, 0, 0);
+ escstr.l = (unsigned) l;
+ lmt_token_state.in_lua_escape = e;
+ tex_delete_token_reference(result); /* boils down to flush_list */
+ tex_unsave_full_scanner_status(saved_full_status);
+ if (escstr.l) {
+ result = lmt_str_toks(escstr);
+ tex_begin_inserted_list(result);
+ }
+ return;
+ }
+ case font_name_code:
+ {
+ int saved_selector;
+ halfword fnt = tex_scan_font_identifier(NULL);
+ push_selector;
+ tex_print_font(fnt);
+ pop_selector;
+ break;
+ }
+ case font_specification_code:
+ {
+ int saved_selector;
+ halfword fnt = tex_scan_font_identifier(NULL);
+ push_selector;
+ tex_append_string((const unsigned char *) font_original(fnt), (unsigned) strlen(font_original(fnt)));
+ pop_selector;
+ break;
+ }
+ case job_name_code:
+ {
+ int saved_selector;
+ if (! lmt_fileio_state.job_name) {
+ tex_open_log_file();
+ }
+ push_selector;
+ tex_aux_print_job_name();
+ pop_selector;
+ break;
+ }
+ case format_name_code:
+ {
+ int saved_selector;
+ if (! lmt_fileio_state.job_name) {
+ tex_open_log_file();
+ }
+ push_selector;
+ tex_print_tex_str(lmt_dump_state.format_name);
+ pop_selector;
+ break;
+ }
+ case luatex_banner_code:
+ {
+ int saved_selector;
+ push_selector;
+ tex_print_str(lmt_engine_state.luatex_banner);
+ pop_selector;
+ break;
+ }
+ default:
+ tex_confusion("convert tokens");
+ break;
+ }
+ {
+ halfword head = tex_cur_str_toks(NULL);
+ tex_begin_inserted_list(head);
+ }
+}
+
+/*tex
+ The boolean |in_lua_escape| is keeping track of the lua string escape state.
+*/
+
+strnumber tex_the_convert_string(halfword c, int i)
+{
+ int saved_selector = lmt_print_state.selector;
+ strnumber ret = 0;
+ int done = 1 ;
+ lmt_print_state.selector = new_string_selector_code;
+ switch (c) {
+ case number_code:
+ case to_integer_code:
+ tex_print_int(i);
+ break;
+ case to_hexadecimal_code:
+ tex_print_hex(i);
+ break;
+ case to_scaled_code:
+ tex_print_dimension(i, no_unit);
+ break;
+ case to_sparse_scaled_code:
+ tex_print_sparse_dimension(i, no_unit);
+ break;
+ case to_dimension_code:
+ tex_print_dimension(i, pt_unit);
+ break;
+ case to_sparse_dimension_code:
+ tex_print_sparse_dimension(i, pt_unit);
+ break;
+ /* case to_mathstyle_code: */
+ /* case lua_function_code: */
+ /* case lua_code: */
+ /* case expanded_code: */
+ /* case string_code: */
+ /* case cs_string_code: */
+ case roman_numeral_code:
+ tex_print_roman_int(i);
+ break;
+ /* case meaning_code: */
+ case uchar_code:
+ tex_print_tex_str(i);
+ break;
+ /* case lua_escape_string_code: */
+ case font_name_code:
+ tex_print_font(i);
+ break;
+ case font_specification_code:
+ tex_print_str(font_original(i));
+ break;
+ /* case left_margin_kern_code: */
+ /* case right_margin_kern_code: */
+ /* case math_char_class_code: */
+ /* case math_char_fam_code: */
+ /* case math_char_slot_code: */
+ /* case insert_ht_code: */
+ case job_name_code:
+ tex_aux_print_job_name();
+ break;
+ case format_name_code:
+ tex_print_tex_str(lmt_dump_state.format_name);
+ break;
+ case luatex_banner_code:
+ tex_print_str(lmt_engine_state.luatex_banner);
+ break;
+ case font_identifier_code:
+ tex_print_font_identifier(i);
+ break;
+ default:
+ done = 0;
+ break;
+ }
+ if (done) {
+ ret = tex_make_string();
+ }
+ lmt_print_state.selector = saved_selector;
+ return ret;
+}
+
+/*tex Return a string from tokens list: */
+
+strnumber tex_tokens_to_string(halfword p)
+{
+ if (lmt_print_state.selector == new_string_selector_code) {
+ tex_normal_error("tokens", "tokens_to_string() called while selector = new_string");
+ return get_nullstr();
+ } else {
+ int saved_selector = lmt_print_state.selector;
+ lmt_print_state.selector = new_string_selector_code;
+ tex_token_show(p, extreme_token_show_max);
+ lmt_print_state.selector = saved_selector;
+ return tex_make_string();
+ }
+}
+
+/*tex
+
+ The actual token conversion in this function is now functionally equivalent to |show_token_list|,
+ except that it always prints the whole token list. Often the result is not that large, for
+ instance |\directlua| is seldom large. However, this converter is also used for patterns
+ and exceptions where size is mnore an issue. For that reason we used to have three variants,
+ one of which (experimentally) used a buffer. At some point, in the manual we were talking of
+ millions of allocations but times have changed.
+
+ Macros were used to inline the appending code (in the thre variants), but in the end I decided
+ to just merge all into one function, with a bit more overhead because we need to optionally
+ skip a macro preamble.
+
+ Values like 512 and 128 also work ok. There is not much to gain in optimization here. We used
+ to have 3 mostly overlapping functions, one of which used a buffer. We can probably use a
+ larger default buffer size and larger step and only free when we think it's too large.
+
+*/
+
+# define default_buffer_size 512 /*tex This used to be 256 */
+# define default_buffer_step 4096 /*tex When we're larger, we always are much larger. */
+
+// todo: check ret
+
+static void tex_aux_make_room_in_buffer(int a)
+{
+ if (lmt_token_state.bufloc + a + 1 > lmt_token_state.bufmax) {
+ char *tmp = aux_reallocate_array(lmt_token_state.buffer, sizeof(unsigned char), lmt_token_state.bufmax + default_buffer_step, 1);
+ if (tmp) {
+ lmt_token_state.bufmax += default_buffer_step;
+ } else {
+ // error
+ }
+ lmt_token_state.buffer = tmp;
+ }
+}
+
+static void tex_aux_append_uchar_to_buffer(int s)
+{
+ tex_aux_make_room_in_buffer(4);
+ if (s <= 0x7F) {
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (s);
+ } else if (s <= 0x7FF) {
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0xC0 + (s / 0x40));
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0x80 + (s % 0x40));
+ } else if (s <= 0xFFFF) {
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0xE0 + (s / 0x1000));
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0x80 + ((s % 0x1000) / 0x40));
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0x80 + ((s % 0x1000) % 0x40));
+ } else if (s >= 0x110000) {
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (s - 0x11000);
+ } else {
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0xF0 + (s / 0x40000));
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0x80 + ((s % 0x40000) / 0x1000));
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0x80 + (((s % 0x40000) % 0x1000) / 0x40));
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (0x80 + (((s % 0x40000) % 0x1000) % 0x40));
+ }
+}
+
+static void tex_aux_append_char_to_buffer(int c)
+{
+ tex_aux_make_room_in_buffer(1);
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (c);
+}
+
+/*tex Only errors and unknowns. */
+
+static void tex_aux_append_str_to_buffer(const char *s)
+{
+ const char *v = s;
+ tex_aux_make_room_in_buffer((int) strlen(v));
+ /*tex Using memcpy will inline and give a larger binary ... and we seldom need this. */
+ while (*v) {
+ lmt_token_state.buffer[lmt_token_state.bufloc++] = (char) (*v);
+ v++;
+ }
+}
+
+/*tex Only bogus csnames. */
+
+static void tex_aux_append_esc_to_buffer(const char *s)
+{
+ int e = escape_char_par;
+ if (e > 0 && e < cs_offset_value) {
+ tex_aux_append_uchar_to_buffer(e);
+ }
+ tex_aux_append_str_to_buffer(s);
+}
+
+# define is_cat_letter(a) (tex_aux_the_cat_code(aux_str2uni(str_string((a)))) == letter_cmd)
+
+/* make two versions: macro and not */
+
+char *tex_tokenlist_to_tstring(int pp, int inhibit_par, int *siz, int skippreamble, int nospace, int strip)
+{
+ if (pp) {
+ /*tex We need to go beyond the reference. */
+ int p = token_link(pp);
+ if (p) {
+ if (lmt_token_state.bufmax > default_buffer_size) {
+ /* Let's start fresh and small. */
+ aux_deallocate_array(lmt_token_state.buffer);
+ lmt_token_state.buffer = aux_allocate_clear_array(sizeof(unsigned char), default_buffer_size, 1);
+ lmt_token_state.bufmax = default_buffer_size;
+ } else if (! lmt_token_state.buffer) {
+ /* Let's start. */
+ lmt_token_state.buffer = aux_allocate_clear_array(sizeof(unsigned char), default_buffer_size, 1);
+ lmt_token_state.bufmax = default_buffer_size;
+ }
+ lmt_token_state.bufloc = 0;
+ int e = escape_char_par; /*tex The serialization of the escape, normally a backlash. */
+ int n = '0'; /*tex The character after |#|, so |#0| upto |#9| */
+ int min = 0;
+ int max = lmt_token_memory_state.tokens_data.top;
+ int skip = 0;
+ if (skippreamble) {
+ skip = get_token_parameters(pp);
+ }
+ while (p) {
+ if (p < min || p > max) {
+ tex_aux_append_str_to_buffer(error_string_clobbered(31));
+ break;
+ } else {
+ int infop = token_info(p);
+ if (infop < 0) {
+ /* unlikely, will go after checking */
+ tex_aux_append_str_to_buffer(error_string_bad(32));
+ } else if (infop < cs_token_flag) {
+ /*tex We nearly always end up here because otherwise we have an error. */
+ int cmd = token_cmd(infop);
+ int chr = token_chr(infop);
+ switch (cmd) {
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case alignment_tab_cmd:
+ case superscript_cmd:
+ case subscript_cmd:
+ case spacer_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ if (! skip) {
+ tex_aux_append_uchar_to_buffer(chr);
+ }
+ break;
+ case parameter_cmd:
+ if (! skip) {
+ if (! nospace && (! lmt_token_state.in_lua_escape && (lmt_expand_state.cs_name_level == 0))) {
+ tex_aux_append_uchar_to_buffer(chr);
+ }
+ tex_aux_append_uchar_to_buffer(chr);
+ }
+ break;
+ case parameter_reference_cmd:
+ if (! skip) {
+ tex_aux_append_char_to_buffer(match_visualizer);
+ if (chr <= 9) {
+ tex_aux_append_char_to_buffer(chr + '0');
+ } else {
+ tex_aux_append_char_to_buffer('!');
+ goto EXIT;
+ }
+ } else {
+ if (chr > 9) {
+ goto EXIT;
+ }
+ }
+ break;
+ case match_cmd:
+ if (! skip) {
+ tex_aux_append_char_to_buffer(match_visualizer);
+ }
+ if (is_valid_match_ref(chr)) {
+ ++n;
+ }
+ if (! skip) {
+ tex_aux_append_char_to_buffer(chr ? chr : '0');
+ }
+ if (n > '9') {
+ goto EXIT;
+ }
+ break;
+ case end_match_cmd:
+ if (chr == 0) {
+ if (! skip) {
+ tex_aux_append_char_to_buffer('-');
+ tex_aux_append_char_to_buffer('>');
+ }
+ skip = 0 ;
+ }
+ break;
+ /*
+ case string_cmd:
+ c = c + cs_offset_value;
+ do_make_room((int) str_length(c));
+ for (int i = 0; i < str_length(c); i++) {
+ token_state.buffer[token_state.bufloc++] = str_string(c)[i];
+ }
+ break;
+ */
+ case end_paragraph_cmd:
+ if (! inhibit_par && (auto_paragraph_mode(auto_paragraph_text))) {
+ tex_aux_append_esc_to_buffer("par");
+ }
+ break;
+ default:
+ tex_aux_append_str_to_buffer(tex_aux_special_cmd_string(cmd, chr, error_string_bad(33)));
+ break;
+ }
+ } else if (! (inhibit_par && infop == lmt_token_state.par_token)) {
+ int q = infop - cs_token_flag;
+ if (q < hash_base) {
+ if (q == null_cs) {
+ tex_aux_append_esc_to_buffer("csname");
+ tex_aux_append_esc_to_buffer("endcsname");
+ } else {
+ tex_aux_append_str_to_buffer(error_string_impossible(34));
+ }
+ } else if (eqtb_out_of_range(q)) {
+ tex_aux_append_str_to_buffer(error_string_impossible(35));
+ } else {
+ strnumber txt = cs_text(q);
+ if (txt < 0 || txt >= lmt_string_pool_state.string_pool_data.ptr) {
+ tex_aux_append_str_to_buffer(error_string_nonexistent(36));
+ } else {
+ char *sh = tex_makecstring(txt);
+ char *s = sh;
+ if (tex_is_active_cs(txt)) {
+ s = s + 3;
+ while (*s) {
+ tex_aux_append_char_to_buffer(*s);
+ s++;
+ }
+ } else {
+ if (e >= 0 && e < 0x110000) {
+ tex_aux_append_uchar_to_buffer(e);
+ }
+ while (*s) {
+ tex_aux_append_char_to_buffer(*s);
+ s++;
+ }
+ if ((! nospace) && ((! tex_single_letter(txt)) || is_cat_letter(txt))) {
+ tex_aux_append_char_to_buffer(' ');
+ }
+ }
+ lmt_memory_free(sh);
+ }
+ }
+ }
+ p = token_link(p);
+ }
+ }
+ EXIT:
+ if (strip && lmt_token_state.bufloc > 1) {
+ if (lmt_token_state.buffer[lmt_token_state.bufloc-1] == strip) {
+ lmt_token_state.bufloc -= 1;
+ }
+ if (lmt_token_state.bufloc > 1 && lmt_token_state.buffer[0] == strip) {
+ memcpy(&lmt_token_state.buffer[0], &lmt_token_state.buffer[1], lmt_token_state.bufloc-1);
+ lmt_token_state.bufloc -= 1;
+ }
+ }
+ lmt_token_state.buffer[lmt_token_state.bufloc] = '\0';
+ if (siz) {
+ *siz = lmt_token_state.bufloc;
+ }
+ return lmt_token_state.buffer;
+ }
+ }
+ if (siz) {
+ *siz = 0;
+ }
+ return NULL;
+}
+
+/*tex
+
+ The \LUA\ interface needs some extra functions. The functions themselves are quite boring, but
+ they are handy because otherwise this internal stuff has to be accessed from \CCODE\ directly,
+ where lots of the defines are not available.
+
+*/
+
+halfword tex_get_tex_dimen_register (int j, int internal) { return internal ? dimen_parameter(j) : dimen_register(j) ; }
+halfword tex_get_tex_skip_register (int j, int internal) { return internal ? glue_parameter(j) : skip_register(j) ; }
+halfword tex_get_tex_mu_skip_register (int j, int internal) { return internal ? mu_glue_parameter(j) : mu_skip_register(j); }
+halfword tex_get_tex_count_register (int j, int internal) { return internal ? count_parameter(j) : count_register(j) ; }
+halfword tex_get_tex_attribute_register (int j, int internal) { return internal ? attribute_parameter(j) : attribute_register(j) ; }
+halfword tex_get_tex_box_register (int j, int internal) { return internal ? box_parameter(j) : box_register(j) ; }
+
+void tex_set_tex_dimen_register(int j, halfword v, int flags, int internal)
+{
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (internal) {
+ tex_assign_internal_dimen_value(flags, internal_dimen_location(j), v);
+ } else {
+ tex_word_define(flags, register_dimen_location(j), v);
+ }
+}
+
+void tex_set_tex_skip_register(int j, halfword v, int flags, int internal)
+{
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (internal) {
+ tex_assign_internal_skip_value(flags, internal_glue_location(j), v);
+ } else {
+ tex_word_define(flags, register_glue_location(j), v);
+ }
+}
+
+void tex_set_tex_mu_skip_register(int j, halfword v, int flags, int internal)
+{
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ tex_word_define(flags, internal ? internal_mu_glue_location(j) : register_mu_glue_location(j), v);
+}
+
+void tex_set_tex_count_register(int j, halfword v, int flags, int internal)
+{
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (internal) {
+ tex_assign_internal_int_value(flags, internal_int_location(j), v);
+ } else {
+ tex_word_define(flags, register_int_location(j), v);
+ }
+}
+
+void tex_set_tex_attribute_register(int j, halfword v, int flags, int internal)
+{
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (j > lmt_node_memory_state.max_used_attribute) {
+ lmt_node_memory_state.max_used_attribute = j;
+ }
+ change_attribute_register(flags, register_attribute_location(j), v);
+ tex_word_define(flags, internal ? internal_attribute_location(j) : register_attribute_location(j), v);
+}
+
+void tex_set_tex_box_register(int j, halfword v, int flags, int internal)
+{
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (internal) {
+ tex_define(flags, internal_box_location(j), internal_box_reference_cmd, v);
+ } else {
+ tex_define(flags, register_box_location(j), register_box_reference_cmd, v);
+ }
+}
+
+void tex_set_tex_toks_register(int j, lstring s, int flags, int internal)
+{
+ halfword ref = get_reference_token();
+ halfword head = tex_str_toks(s, NULL);
+ set_token_link(ref, head);
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (internal) {
+ tex_define(flags, internal_toks_location(j), internal_toks_reference_cmd, ref);
+ } else {
+ tex_define(flags, register_toks_location(j), register_toks_reference_cmd, ref);
+ }
+}
+
+void tex_scan_tex_toks_register(int j, int c, lstring s, int flags, int internal)
+{
+ halfword ref = get_reference_token();
+ halfword head = tex_str_scan_toks(c, s);
+ set_token_link(ref, head);
+ if (global_defs_par) {
+ flags = add_global_flag(flags);
+ }
+ if (internal) {
+ tex_define(flags, internal_toks_location(j), internal_toks_reference_cmd, ref);
+ } else {
+ tex_define(flags, register_toks_location(j), register_toks_reference_cmd, ref);
+ }
+}
+
+int tex_get_tex_toks_register(int j, int internal)
+{
+ halfword t = internal ? toks_parameter(j) : toks_register(j);
+ if (t) {
+ return tex_tokens_to_string(t);
+ } else {
+ return get_nullstr();
+ }
+}
+
+/* Options: (0) error when undefined [bad], (1) create [but undefined], (2) ignore [discard] */
+
+halfword tex_parse_str_to_tok(halfword head, halfword *tail, halfword ct, const char *str, size_t lstr, int option)
+{
+ halfword p = null;
+ if (! head) {
+ head = get_reference_token();
+ }
+ p = (tail && *tail) ? *tail : head;
+ if (lstr > 0) {
+ const char *se = str + lstr;
+ while (str < se) {
+ /*tex hh: |str2uni| could return len too (also elsewhere) */
+ halfword u = (halfword) aux_str2uni((const unsigned char *) str);
+ halfword t = null;
+ halfword cc = tex_get_cat_code(ct, u);
+ str += utf8_size(u);
+ /*tex
+ This is a relating simple converter; if more is needed one can just use
+ |tex.print| with a regular |\def| or |\gdef| and feed the string into the
+ regular scanner.
+ */
+ switch (cc) {
+ case escape_cmd:
+ {
+ /*tex We have a potential control sequence so we check for it. */
+ int lname = 0;
+ const char *name = str;
+ while (str < se) {
+ halfword u = (halfword) aux_str2uni((const unsigned char *) str);
+ int s = utf8_size(u);
+ int c = tex_get_cat_code(ct, u);
+ if (c == letter_cmd) {
+ str += s;
+ lname += s;
+ } else if (c == spacer_cmd) {
+ /*tex We ignore a trailing space like normal scanning does. */
+ if (lname == 0) {
+ // if (u == 32) {
+ lname += s;
+ }
+ str += s;
+ break ;
+ } else {
+ if (lname == 0) {
+ lname += s;
+ str += s;
+ }
+ break ;
+ }
+ }
+ if (lname > 0) {
+ /*tex We have a potential |\cs|. */
+ halfword cs = tex_string_locate(name, lname, option == 1 ? 1 : 0); /* 1 == create */
+ if (cs == undefined_control_sequence) {
+ if (option == 2) {
+ /*tex We ignore unknown commands. */
+ // t = null;
+ } else {
+ /*tex We play safe and backtrack, as we have option 0, but never used anyway. */
+ t = u + (cc * (1<<21));
+ str = name;
+ }
+ } else {
+ /* We end up here when option is 1. */
+ t = cs_token_flag + cs;
+ }
+ } else {
+ /*tex
+ Just a character with some meaning, so |\unknown| becomes effectively
+ |\unknown| assuming that |\\| has some useful meaning of course.
+ */
+ t = u + (cc * (1 << 21));
+ str = name;
+ }
+ break;
+ }
+ case comment_cmd:
+ goto DONE;
+ case ignore_cmd:
+ break;
+ case spacer_cmd:
+ /* t = u + (cc * (1<<21)); */
+ t = token_val(spacer_cmd, ' ');
+ break;
+ default:
+ /*tex
+ Whatever token, so for instance $x^2$ just works given a tex catcode regime.
+ */
+ t = u + (cc * (1<<21));
+ break;
+ }
+ if (t) {
+ p = tex_store_new_token(p, t);
+ }
+ }
+ }
+ DONE:
+ if (tail) {
+ *tail = p;
+ }
+ return head;
+}
+
+/*tex So far for the helpers. */
+
+void tex_dump_token_mem(dumpstream f)
+{
+ /*tex
+ It doesn't pay off to prune the available list. We save less than 10K if we do this and
+ it assumes a sequence at the end. It doesn't help that the list is in reverse order so
+ we just dump the lot. But we do check the allocated size. We cheat a bit in reducing
+ the ptr so that we can set the the initial counter on loading.
+ */
+ halfword p = lmt_token_memory_state.available;
+ halfword u = lmt_token_memory_state.tokens_data.top + 1;
+ while (p) {
+ --u;
+ p = token_link(p);
+ }
+ lmt_token_memory_state.tokens_data.ptr = u;
+ dump_int(f, lmt_token_state.null_list); /* the only one left */
+ dump_int(f, lmt_token_memory_state.tokens_data.allocated);
+ dump_int(f, lmt_token_memory_state.tokens_data.top);
+ dump_int(f, lmt_token_memory_state.tokens_data.ptr);
+ dump_int(f, lmt_token_memory_state.available);
+ dump_things(f, lmt_token_memory_state.tokens[0], lmt_token_memory_state.tokens_data.top + 1);
+}
+
+void tex_undump_token_mem(dumpstream f)
+{
+ undump_int(f, lmt_token_state.null_list); /* the only one left */
+ undump_int(f, lmt_token_memory_state.tokens_data.allocated);
+ undump_int(f, lmt_token_memory_state.tokens_data.top);
+ undump_int(f, lmt_token_memory_state.tokens_data.ptr);
+ undump_int(f, lmt_token_memory_state.available);
+ tex_initialize_token_mem();
+ undump_things(f, lmt_token_memory_state.tokens[0], lmt_token_memory_state.tokens_data.top + 1);
+}
diff --git a/source/luametatex/source/tex/textoken.h b/source/luametatex/source/tex/textoken.h
new file mode 100644
index 000000000..1996f351c
--- /dev/null
+++ b/source/luametatex/source/tex/textoken.h
@@ -0,0 +1,399 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXTOKEN_H
+# define LMT_TEXTOKEN_H
+
+# include "luametatex.h"
+
+/*tex
+
+ These are constants that can be added to a chr value and then give a token with the right cmd
+ and chr combination, whichs is then equivalent to |token_val (cmd, chr)|. The cmd results from
+ shifting right 21 bits. The following tokens therefore should match the order of the (first
+ bunch) of cmd codes!
+
+ \TEX\ stores the specific match character which defaults to |#|. When tokens get serialized the
+ machinery starts with |match_chr = '#'| but overloads that by the last stored variant. So the
+ last (!) seen |match_chr| in the macro preamble determines what gets used in showing the body.
+ One could argue that this is a buglet but I more see it as a side effect. In practice there is
+ never a mix of such characters used. Anyway, one could as well use the first seen in the
+ preamble and use that for the rest because consistency is better than confusion. Even better is
+ to just always use |#| and store the numbers in preamble match tokens, which opens up
+ possibilities (for strict or tolerant matching, skipping spaces, optional delimiters and even
+ more arguments).
+
+*/
+
+//define cs_token_flag 0x1FFFFFFF
+
+# define node_token_max 0x0FFFFF
+# define node_token_flag 0x100000
+# define node_token_lsb(sum) (sum & 0x0000FFFF)
+# define node_token_msb(sum) (((sum & 0xFFFF0000) >> 16) + node_token_flag)
+# define node_token_sum(msb,lsb) (((msb & 0x0000FFFF) << 16) + lsb)
+# define node_token_overflow(sum) (sum > node_token_max)
+# define node_token_flagged(sum) (sum > node_token_flag)
+
+/*tex
+ Instead of |fixmem| we use |tokens| because it is dynamic anyway and we then better match variables
+ that deal with managing that. Most was already hidden in a few files anyway.
+*/
+
+typedef struct token_memory_state_info {
+ memoryword *tokens; /*tex |memoryword *volatile fixmem;| */
+ memory_data tokens_data;
+ halfword available;
+ int padding;
+} token_memory_state_info;
+
+extern token_memory_state_info lmt_token_memory_state;
+
+typedef enum read_states {
+ reading_normal, /*tex we're going ahead */
+ reading_just_opened, /*tex newly opened, first line not yet read */
+ reading_closed, /*tex not open, or at end of file */
+} read_states;
+
+typedef enum lua_input_types {
+ unset_lua_input,
+ string_lua_input,
+ packed_lua_input,
+ token_lua_input,
+ token_list_lua_input,
+ node_lua_input,
+} lua_input_types;
+
+typedef enum tex_input_types {
+ eof_tex_input,
+ string_tex_input,
+ token_tex_input,
+ token_list_tex_input,
+ node_tex_input,
+} tex_input_types;
+
+typedef enum catcode_table_presets {
+ default_catcode_table_preset = -1,
+ no_catcode_table_preset = -2,
+} catcode_table_presets;
+
+/*tex
+*
+ There are a few temporary head pointers, one is |temp_token_head|. This one we keep because
+ when we expand, we can run into situations where we need that pointer. But, |backup_head| is
+ a real temporary one: we can replace that with local variables. Okay, it is kind of kept in
+ the format file but if it ends up there we're in some kind of troubles anyway. So,
+ |backup_head| is now local and |temp_token_head| only global when we are scanning; in cases
+ where we serialize tokens lists it has been replaced by local variables (and the related
+ functions now keep track of head and tail). This makes sense because in \LUAMETATEX\ we often
+ go between \TEX\ and \LUA\ and this keeps it kind of simple. This also makes clear when we
+ are scanning (the global head is used) and doing something simple with a list. The same is
+ true for |match_token_head| thatmoved to the expand state. The |backup_head| variable is gone
+ because we now use locals.
+
+*/
+
+typedef struct token_state_info {
+ halfword null_list; /*tex permanently empty list */
+ int in_lua_escape;
+ int force_eof;
+ int luacstrings;
+ /*tex These are pseudo constants, their value depends on the number of primitives etc. */
+ halfword par_loc;
+ halfword par_token;
+ /* halfword line_par_loc; */ /*tex See note in textoken.c|. */
+ /* halfword line_par_token; */ /*tex See note in textoken.c|. */
+ /* */
+ char *buffer;
+ int bufloc;
+ int bufmax;
+ int padding;
+} token_state_info;
+
+extern token_state_info lmt_token_state;
+
+// # define max_token_reference 0x7FFF /* we can bump to 0xFFFF when we go unsigned here */
+//
+//define token_reference(a) token_memory_state.tokens[a].half1
+//
+// #define get_token_parameters(a) lmt_token_memory_state.tokens[a].quart2
+// #define get_token_reference(a) lmt_token_memory_state.tokens[a].quart3
+//
+// #define set_token_parameters(a,b) lmt_token_memory_state.tokens[a].quart2 = (b)
+//
+// #define add_token_reference(a) lmt_token_memory_state.tokens[a].quart3 += 1
+// #define sub_token_reference(a) lmt_token_memory_state.tokens[a].quart3 -= 1
+// #define inc_token_reference(a,b) lmt_token_memory_state.tokens[a].quart3 += (quarterword) (b)
+// #define dec_token_reference(a,b) lmt_token_memory_state.tokens[a].quart3 -= (quarterword) (b)
+
+# define max_token_reference 0x0FFFFFFF
+
+# define get_token_parameters(a) (lmt_token_memory_state.tokens[a].hulf1 >> 28)
+# define get_token_reference(a) (lmt_token_memory_state.tokens[a].hulf1 & 0x0FFFFFFF)
+
+# define set_token_parameters(a,b) lmt_token_memory_state.tokens[a].hulf1 += ((b) << 28) /* normally the variable is still zero here */
+
+# define add_token_reference(a) lmt_token_memory_state.tokens[a].hulf1 += 1 /* we are way off the parameter count */
+# define sub_token_reference(a) lmt_token_memory_state.tokens[a].hulf1 -= 1 /* we are way off the parameter count */
+# define inc_token_reference(a,b) lmt_token_memory_state.tokens[a].hulf1 += (b) /* we are way off the parameter count */
+# define dec_token_reference(a,b) lmt_token_memory_state.tokens[a].hulf1 -= (b) /* we are way off the parameter count */
+
+/* */
+
+# define token_info(a) lmt_token_memory_state.tokens[a].half1
+# define token_link(a) lmt_token_memory_state.tokens[a].half0
+# define get_token_info(a) lmt_token_memory_state.tokens[a].half1
+# define get_token_link(a) lmt_token_memory_state.tokens[a].half0
+# define set_token_info(a,b) lmt_token_memory_state.tokens[a].half1 = (b)
+# define set_token_link(a,b) lmt_token_memory_state.tokens[a].half0 = (b)
+
+# define token_cmd(A) ((A) >> cs_offset_bits)
+# define token_chr(A) ((A) & cs_offset_max)
+# define token_val(A,B) (((A) << cs_offset_bits) + (B))
+
+/*tex
+ Sometimes we add a value directly. Instead we could use |token_val| on the spot but then we
+ also need different range checkers. We use numbers because we don't have the cmd codes defined
+ yet when we're here. so we can't use for instance |token_val (spacer_cmd, 20)| yet.
+*/
+
+# define left_brace_token token_val( 1, 0) // token_val(left_brace_cmd,0)
+# define right_brace_token token_val( 2, 0) // token_val(right_brace_cmd,0)
+# define math_shift_token token_val( 3, 0) // token_val(math_shift_cmd,0)
+# define alignment_token token_val( 4, 0)
+# define superscript_token token_val( 7, 0)
+# define subscript_token token_val( 8, 0)
+# define ignore_token token_val( 9, 0) // token_val(ignore_cmd,0)
+# define space_token token_val(10,32) // token_val(spacer_cmd,32)
+# define letter_token token_val(11, 0) // token_val(letter_cmd,0)
+# define other_token token_val(12, 0) // token_val(other_char_cmd,0)
+# define active_token token_val(13, 0)
+
+# define match_token token_val(19,0) // token_val(match_cmd,0)
+# define end_match_token token_val(20,0) // token_val(end_match_cmd,0)
+
+# define left_brace_limit right_brace_token
+# define right_brace_limit math_shift_token
+
+# define octal_token (other_token + '\'') /*tex apostrophe, indicates an octal constant */
+# define hex_token (other_token + '"') /*tex double quote, indicates a hex constant */
+# define alpha_token (other_token + '`') /*tex reverse apostrophe, precedes alpha constants */
+# define point_token (other_token + '.') /*tex decimal point */
+# define continental_point_token (other_token + ',') /*tex decimal point, Eurostyle */
+# define period_token (other_token + '.') /*tex decimal point */
+# define comma_token (other_token + ',') /*tex decimal comma */
+# define plus_token (other_token + '+')
+# define minus_token (other_token + '-')
+# define slash_token (other_token + '/')
+# define asterisk_token (other_token + '*')
+# define colon_token (other_token + ':')
+# define semi_colon_token (other_token + ';')
+# define equal_token (other_token + '=')
+# define less_token (other_token + '<')
+# define more_token (other_token + '>')
+# define exclamation_token_o (other_token + '!')
+# define exclamation_token_l (letter_token + '!')
+# define underscore_token (other_token + '_')
+# define underscore_token_o (other_token + '_')
+# define underscore_token_l (letter_token + '_')
+# define circumflex_token (other_token + '^')
+# define circumflex_token_o (other_token + '^')
+# define circumflex_token_l (letter_token + '^')
+# define escape_token (other_token + '\\')
+# define left_parent_token (other_token + '(')
+# define right_parent_token (other_token + ')')
+# define zero_token (other_token + '0') /*tex zero, the smallest digit */
+# define five_token (other_token + '5')
+# define seven_token (other_token + '7')
+# define nine_token (other_token + '9') /*tex zero, the smallest digit */
+
+# define a_token_l (letter_token + 'a') /*tex the smallest special hex digit */
+# define a_token_o (other_token + 'a')
+
+# define b_token_l (letter_token + 'b') /*tex the smallest special hex digit */
+# define b_token_o (other_token + 'b')
+
+# define d_token_l (letter_token + 'd')
+# define d_token_o (other_token + 'd')
+
+# define e_token_l (letter_token + 'e')
+# define e_token_o (other_token + 'e')
+
+# define f_token_l (letter_token + 'f') /*tex the largest special hex digit */
+# define f_token_o (other_token + 'f')
+
+# define i_token_l (letter_token + 'i')
+# define i_token_o (other_token + 'i')
+
+# define l_token_l (letter_token + 'l')
+# define l_token_o (other_token + 'l')
+
+# define m_token_l (letter_token + 'm')
+# define m_token_o (other_token + 'm')
+
+# define n_token_l (letter_token + 'n')
+# define n_token_o (other_token + 'n')
+
+# define o_token_l (letter_token + 'o')
+# define o_token_o (other_token + 'o')
+
+# define p_token_l (letter_token + 'p')
+# define p_token_o (other_token + 'p')
+
+# define r_token_l (letter_token + 'r')
+# define r_token_o (other_token + 'r')
+
+# define s_token_l (letter_token + 's')
+# define s_token_o (other_token + 's')
+
+# define t_token_l (letter_token + 't')
+# define t_token_o (other_token + 't')
+
+# define u_token_l (letter_token + 'u')
+# define u_token_o (other_token + 'u')
+
+# define x_token_l (letter_token + 'x')
+# define x_token_o (other_token + 'x')
+
+# define A_token_l (letter_token + 'A') /*tex the smallest special hex digit */
+# define A_token_o (other_token + 'A')
+
+# define E_token_l (letter_token + 'E')
+# define E_token_o (other_token + 'E')
+
+# define F_token_l (letter_token + 'F') /*tex the largest special hex digit */
+# define F_token_o (other_token + 'F')
+
+# define P_token_l (letter_token + 'P') /*tex the largest special hex digit */
+# define P_token_o (other_token + 'P')
+
+# define X_token_l (letter_token + 'X')
+# define X_token_o (other_token + 'X')
+
+# define at_token_l (letter_token + '@')
+# define at_token_o (other_token + '@')
+
+# define match_visualizer '#'
+# define match_spacer '*' /* ignore spaces */
+# define match_bracekeeper '+' /* keep the braces */
+# define match_thrasher '-' /* discard and don't count the argument */
+# define match_par_spacer '.' /* ignore pars and spaces */
+# define match_keep_spacer ',' /* push back space when no match */
+# define match_pruner '/' /* remove leading and trailing spaces and pars */
+# define match_continuator ':' /* pick up scanning here */
+# define match_quitter ';' /* quit scanning */
+# define match_mandate '=' /* braces are mandate */
+# define match_spacekeeper '^' /* keep leading spaces */
+# define match_mandate_keep '_' /* braces are mandate and kept */
+# define match_par_command '@' /* par delimiter, only internal */
+
+# define spacer_match_token (match_token + match_spacer)
+# define keep_match_token (match_token + match_bracekeeper)
+# define thrash_match_token (match_token + match_thrasher)
+# define par_spacer_match_token (match_token + match_par_spacer)
+# define keep_spacer_match_token (match_token + match_keep_spacer)
+# define prune_match_token (match_token + match_pruner)
+# define continue_match_token (match_token + match_continuator)
+# define quit_match_token (match_token + match_quitter)
+# define mandate_match_token (match_token + match_mandate)
+# define leading_match_token (match_token + match_spacekeeper)
+# define mandate_keep_match_token (match_token + match_mandate_keep)
+# define par_command_match_token (match_token + match_par_command)
+
+# define is_valid_match_ref(r) (r != thrash_match_token && r != spacer_match_token && r != keep_spacer_match_token && r != continue_match_token && r != quit_match_token)
+
+/*tex
+ Managing the head of the list of available one-word nodes. The |get_avail| function has been
+ given a more verbose name. It gets from the pool and should not be confused with |get_token|
+ which reads from the input or token list. The |free_avail| function got renamed to
+ |put_available_token| so we have some symmetry here.
+*/
+
+extern void tex_compact_tokens (void);
+extern void tex_initialize_tokens (void);
+extern void tex_initialize_token_mem (void);
+extern halfword tex_get_available_token (halfword t);
+extern void tex_put_available_token (halfword p);
+extern halfword tex_store_new_token (halfword p, halfword t);
+extern void tex_delete_token_reference (halfword p);
+extern void tex_add_token_reference (halfword p);
+extern void tex_increment_token_reference (halfword p, int n);
+
+# define get_reference_token() tex_get_available_token(null)
+
+/*tex
+
+ The |no_expand_flag| is a special character value that is inserted by |get_next| if it wants to
+ suppress expansion.
+
+*/
+
+# define no_expand_flag special_char /* no_expand_relax_code */
+
+/*tex A few special values: */
+
+# define default_token_show_min 32
+# define default_token_show_max 2500
+# define extreme_token_show_max 0x3FFFFFFF
+
+/*tex All kind of helpers: */
+
+extern void tex_dump_token_mem (dumpstream f);
+extern void tex_undump_token_mem (dumpstream f);
+extern void tex_print_meaning (halfword code);
+extern void tex_flush_token_list (halfword p);
+extern void tex_flush_token_list_head_tail (halfword h, halfword t, int n);
+extern halfword tex_show_token_list (halfword p, halfword q, int l, int asis); /* Here |l| will go away. */
+extern void tex_token_show (halfword p, int max);
+/* void tex_add_token_ref (halfword p); */
+/* void tex_delete_token_ref (halfword p); */
+extern void tex_get_next (void);
+extern halfword tex_scan_character (const char *s, int left_brace, int skip_space, int skip_relax);
+extern int tex_scan_optional_keyword (const char *s);
+extern int tex_scan_mandate_keyword (const char *s, int offset);
+extern void tex_aux_show_keyword_error (const char *s);
+extern int tex_scan_keyword (const char *s);
+extern int tex_scan_keyword_case_sensitive (const char *s);
+extern halfword tex_active_to_cs (int c, int force);
+extern halfword tex_string_to_toks (const char *s);
+extern int tex_get_char_cat_code (int c);
+extern halfword tex_get_token (void);
+extern halfword tex_str_toks (lstring s, halfword *tail); /* returns head */
+extern halfword tex_cur_str_toks (halfword *tail); /* returns head */
+extern halfword tex_str_scan_toks (int c, lstring b); /* returns head */
+extern void tex_run_combine_the_toks (void);
+extern void tex_run_convert_tokens (halfword code);
+extern strnumber tex_the_convert_string (halfword c, int i);
+extern strnumber tex_tokens_to_string (halfword p);
+/* char *tex_tokenlist_to_cstring (int p, int inhibit_par, int *siz); */
+extern char *tex_tokenlist_to_tstring (int p, int inhibit_par, int *siz, int skip, int nospace, int strip);
+
+extern halfword tex_get_tex_dimen_register (int j, int internal);
+extern halfword tex_get_tex_skip_register (int j, int internal);
+extern halfword tex_get_tex_mu_skip_register (int j, int internal);
+extern halfword tex_get_tex_count_register (int j, int internal);
+extern halfword tex_get_tex_attribute_register (int j, int internal);
+extern halfword tex_get_tex_box_register (int j, int internal);
+extern halfword tex_get_tex_toks_register (int j, int internal);
+
+extern void tex_set_tex_dimen_register (int j, halfword v, int flags, int internal);
+extern void tex_set_tex_skip_register (int j, halfword v, int flags, int internal);
+extern void tex_set_tex_mu_skip_register (int j, halfword v, int flags, int internal);
+extern void tex_set_tex_count_register (int j, halfword v, int flags, int internal);
+extern void tex_set_tex_attribute_register (int j, halfword v, int flags, int internal);
+extern void tex_set_tex_box_register (int j, halfword v, int flags, int internal);
+
+extern void tex_set_tex_toks_register (int j, lstring s, int flags, int internal);
+extern void tex_scan_tex_toks_register (int j, int c, lstring s, int flags, int internal);
+
+extern halfword tex_copy_token_list (halfword h, halfword *t);
+
+extern halfword tex_parse_str_to_tok (halfword head, halfword *tail, halfword ct, const char *str, size_t lstr, int option);
+
+inline int tex_valid_token(int t)
+{
+ return ((t >= 0) && (t <= (int) lmt_token_memory_state.tokens_data.top));
+}
+
+# endif
diff --git a/source/luametatex/source/tex/textypes.c b/source/luametatex/source/tex/textypes.c
new file mode 100644
index 000000000..2b67f5308
--- /dev/null
+++ b/source/luametatex/source/tex/textypes.c
@@ -0,0 +1,46 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+void tex_dump_constants(dumpstream f)
+{
+ dump_via_int(f, max_n_of_toks_registers);
+ dump_via_int(f, max_n_of_box_registers);
+ dump_via_int(f, max_n_of_int_registers);
+ dump_via_int(f, max_n_of_dimen_registers);
+ dump_via_int(f, max_n_of_attribute_registers);
+ dump_via_int(f, max_n_of_glue_registers);
+ dump_via_int(f, max_n_of_mu_glue_registers);
+ dump_via_int(f, max_n_of_bytecodes);
+ dump_via_int(f, max_n_of_math_families);
+ dump_via_int(f, max_n_of_math_classes);
+ dump_via_int(f, max_n_of_catcode_tables);
+ dump_via_int(f, max_n_of_box_indices);
+}
+
+inline static void tex_aux_check_constant(dumpstream f, int c)
+{
+ int x;
+ undump_int(f, x);
+ if (x != c) {
+ tex_fatal_undump_error("inconsistent constant");
+ }
+}
+
+void tex_undump_constants(dumpstream f)
+{
+ tex_aux_check_constant(f, max_n_of_toks_registers);
+ tex_aux_check_constant(f, max_n_of_box_registers);
+ tex_aux_check_constant(f, max_n_of_int_registers);
+ tex_aux_check_constant(f, max_n_of_dimen_registers);
+ tex_aux_check_constant(f, max_n_of_attribute_registers);
+ tex_aux_check_constant(f, max_n_of_glue_registers);
+ tex_aux_check_constant(f, max_n_of_mu_glue_registers);
+ tex_aux_check_constant(f, max_n_of_bytecodes);
+ tex_aux_check_constant(f, max_n_of_math_families);
+ tex_aux_check_constant(f, max_n_of_math_classes);
+ tex_aux_check_constant(f, max_n_of_catcode_tables);
+ tex_aux_check_constant(f, max_n_of_box_indices);
+}
diff --git a/source/luametatex/source/tex/textypes.h b/source/luametatex/source/tex/textypes.h
new file mode 100644
index 000000000..3eebccbf1
--- /dev/null
+++ b/source/luametatex/source/tex/textypes.h
@@ -0,0 +1,699 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_TEXTYPES_H
+# define LMT_TEXTYPES_H
+
+# include <stdio.h>
+
+# define LMT_TOSTRING_INDEED(s) #s
+# define LMT_TOSTRING(s) LMT_TOSTRING_INDEED(s)
+
+/*tex
+
+ Here is the comment from the engine(s) that we started with. Keep in mind that \TEX\ originates
+ on other architectures and that it was written in \PASCAL.
+
+ In order to make efficient use of storage space, \TEX\ bases its major data structures on a
+ |memoryword|, which contains either a (signed) integer, possibly scaled, or a (signed)
+ |glue_ratio|, or a small number of fields that are one half or one quarter of the size used for
+ storing integers. More details about how we pack data in a memory word can be found in the
+ |memoryword| files.
+
+ If |x| is a variable of type |memoryword|, it contains up to four fields that can be referred
+ to as follows (\LUATEX\ differs a bit here but the principles remain):
+
+ \starttabulate
+ \NC |x.int| \NC an |integer| \NC \NR
+ \NC |x.sc | \NC a |scaled| integer \NC \NR
+ \NC |x.gr| \NC a |glueratio| \NC \NR
+ \NC |x.hh.lh|, |x.hh.rh| \NC two halfword fields) \NC \NR
+ \NC |x.hh.b0|, |x.hh.b1| \NC two quarterword fields \NC \NR
+ \NC |x.qqqq.b0| \unknown\ |x.qqqq.b3| \NC four quarterword fields \NC \NR
+ \stoptabulate
+
+ This is somewhat cumbersome to write, and not very readable either, but macros will be used to
+ make the notation shorter and more transparent. The |memoryword| file gives a formal definition
+ of |memoryword| and its subsidiary types, using packed variant records. \TEX\ makes no
+ assumptions about the relative positions of the fields within a word.
+
+ We are assuming 32-bit integers, a halfword must contain at least 32 bits, and a quarterword
+ must contain at least 16 bits.
+
+ The present implementation tries to accommodate as many variations as possible, so it makes few
+ assumptions. If integers having the subrange |min_quarterword .. max_quarterword| can be packed
+ into a quarterword, and if integers having the subrange |min_halfword .. max_halfword| can be
+ packed into a halfword, everything should work satisfactorily.
+
+ It is usually most efficient to have |min_quarterword = min_halfword = 0|, so one should try to
+ achieve this unless it causes a severe problem. The values defined here are recommended for most
+ 32-bit computers.
+
+ We cannot use the full range of 32 bits in a halfword, because we have to allow negative values
+ for potential backend tricks like web2c's dynamic allocation, and parshapes pointers have to be
+ able to store at least twice the value |max_halfword| (see below). Therefore, |max_halfword| is
+ $2^{30}-1$
+
+ Via the intermediate step if \WEBC\ we went from \PASCAL\ to \CCODE. As in the meantime we also
+ live in a 64 bit world the above model has been adapted a bit but the principles and names remain.
+
+ A |halfword| is a 32 bit integer and a |quarterword| a 16 bit one. The |scaled| type is used for
+ scaled integers but it's just another name for |halfword| or |int|. The code sometimes uses an
+ |int| instead of |scaled| or |halfword| (which might get fixed). By using the old type names we
+ sort of get an indication what we're dealing with.
+
+ If we even bump scaled to 64 bit we need to redo some code that now assumes that a scaled and
+ halfword are the same size (as in values). Instead we can then decide to go 64 bit for both.
+
+ The |internal_font_number| type is now also a |halfword| so it's no longer used as such.
+
+ We now use 64 memory words split into whatever pieces we need. This also means that we can use
+ a double as glueratio which us saves some casting.
+
+ In principle we can widen up the engine to use long instead of int because it is relatively easy
+ to adapt the nodes but it will take much more memory and we gain nothing. I might (re)introduce
+ the pointer as type instead of halfword just for clarity but the mixed usage doesn't really make
+ ot better. It's more about perception. I will do that when I have reason to check some code and
+ are in edit mode.
+
+*/
+
+typedef int strnumber;
+typedef int halfword;
+typedef unsigned short quarterword; /*tex It really is an unsigned one! But \MPLIB| had it signed. */
+typedef unsigned char singleword;
+typedef int scaled;
+typedef double glueratio; /*tex This looks better in our (tex specific) syntax highlighting. */
+typedef int pointer; /*tex Maybe I'll replace halfwords that act as pointer some day. */
+typedef FILE *dumpstream;
+
+/* glueratio glue_ratio; */ /*tex one-word representation of a glue expansion factor */
+/* unsigned char glue_ord; */ /*tex infinity to the 0, 1, 2, 3, or 4 power */
+/* unsigned short group_code; */ /*tex |save_level| for a level boundary */
+
+/*tex
+
+ The documentation refers to pointers and halfwords and scaled and all are in fact just integers.
+ Okay, one can wonder about negative pointers but we never reach the limits so we're okay wrr
+ wraparound. At some point we might just replace all by int as some of the helpers already do
+ that. For now we keep halfword and scaled but we removed (the not so often used) pointers
+ because they were already mixed with halfwords in similar usage.
+
+ So, again we use constants that reflect the original naming and also the related comments.
+
+ Here are some more constants. Others definitions can be font alongside where they make most
+ sense. For instance, these are used all over the place: |null|, |normal|, etc. However, over
+ time, with all these extensions it was not used consistently. So, I replaced the usage of
+ |normal| by more explicit identifiers, also because we have more subtypes in this engine. But
+ we kept most constants (but most in enums)!
+
+ Characters of text that have been converted to \TEX's internal form are said to be of type
+ |unsigned char|, which is a subrange of the integers. We are assuming that our runtime system
+ is able to read and write \UTF-8.
+
+ If constants in this file change, one also must change the format identifier!
+
+*/
+
+typedef struct scaledwhd {
+ scaled wd;
+ scaled ht;
+ scaled dp;
+ scaled ic; /* padding anyway */
+} scaledwhd;
+
+extern halfword tex_badness(
+ scaled t,
+ scaled s
+);
+
+/*tex
+ We could use the 4 leftmost bits in tokens for [protected frozen tolerant permanent] flags but
+ it would mean way more shifting and checking so we don't to that. However, we already use
+ one nibble for the cstokenflag: 0x1FFFFFFF so we actually have no room. We also have a signed
+ unsigned issue because halfwords are integers so quite a bit needs to be adapted if we use all
+ 32 bits. We have between 128 and 256 cmd codes so we need one byte for that. We also have to
+ deal with the max utf / unicode values.
+*/
+
+# define cs_offset_bits 21
+# define cs_offset_value 0x00200000 // ((1 << STRING_OFFSET_BITS) - 1)
+# define cs_offset_max 0x001FFFFF
+# define cs_token_flag 0x1FFFFFFF
+
+# define max_cardinal 0xFFFFFFFF
+# define min_cardinal 0
+# define max_integer 0x7FFFFFFF /*tex aka |infinity| */
+# define min_integer -0x7FFFFFFF /*tex aka |min_infinity| */
+# define max_dimen 0x3FFFFFFF
+# define min_dimen -0x3FFFFFFF
+# define min_data_value 0
+# define max_data_value cs_offset_max
+# define max_half_value 32767 /*tex For instance sf codes.*/
+
+# define one_bp 65781
+
+# define infinity 017777777777 /*tex the largest positive value that \TEX\ knows */
+# define min_infinity -0x7FFFFFFF
+# define awful_bad 07777777777 /*tex more than a billion demerits |0x3FFFFFFF| */
+# define infinite_bad 10000 /*tex infinitely bad value */
+# define infinite_penalty infinite_bad /*tex infinite penalty value */
+# define eject_penalty -infinite_penalty /*tex negatively infinite penalty value */
+# define deplorable 100000 /*tex more than |inf_bad|, but less than |awful_bad| */
+# define large_width_excess 7230584
+# define small_stretchability 1663497
+# define loose_criterium 99
+# define semi_loose_criterium 12 /* same as |decent_criterium| */
+# define decent_criterium 12
+# define semi_tight_criterium 12 /* same as |decent_criterium| */
+
+# define default_rule 26214 /*tex 0.4pt */
+# define ignore_depth -65536000 /*tex The magic dimension value to mean \quote {ignore me}. */
+
+# define min_quarterword 0 /*tex The smallest allowable value in a |quarterword|. */
+# define max_quarterword 65535 /*tex The largest allowable value in a |quarterword|. */
+
+# define min_halfword -0x3FFFFFFF /*tex The smallest allowable value in a |halfword|. */
+# define max_halfword 0x3FFFFFFF /*tex The largest allowable value in a |halfword|. */
+
+# define null_flag -0x40000000
+# define zero_glue 0
+# define unity 0200000 /*tex $2^{16}$, represents 1.00000 */
+# define two 0400000 /*tex $2^{17}$, represents 2.00000 */
+# define null 0
+# define null_font 0
+
+# define unused_attribute_value -0x7FFFFFFF /*tex as low as it goes */
+# define unused_state_value 0 /*tex 0 .. 0xFFFF */
+# define unused_script_value 0 /*tex 0 .. 0xFFFF */
+# define unused_scale_value 1000
+
+# define unused_math_style 0xFF
+# define unused_math_family 0xFF
+
+# define preset_rule_thickness 010000000000 /*tex denotes |unset_rule_thickness|: |0x40000000|. */
+
+# define max_char_code 15 /*tex largest catcode for individual characters */
+# define min_space_factor 0 /*tex watch out: |\spacefactor| cannot be zero but the sf code can!*/
+# define max_space_factor 077777
+# define default_space_factor 1000
+# define default_tolerance 10000
+# define default_hangafter 1
+# define default_deadcycles 25
+# define default_pre_display_gap 2000
+# define default_eqno_gap_step 1000
+
+# define default_output_box 255
+
+/*tex
+ For practical reasons all these registers were max'd to 64K but that really makes no sense for
+ e.g. glue and mu glue and even attributes. Imagine using more than 8K attributes: we get long
+ linked lists, slow lookup, lots of copying, need plenty node memory. These large ranges also
+ demand more memory as we need these eqtb entries. So, when I was pondering specific ex and em
+ glue (behaving like mu glue in math) I realized that we can do that at no cost at all: we just
+ make some register ranges smaller. Keep in mind that we already have cheap integer, dimension,
+ and glue shortcuts that can be used instead of registers for storing constant values.
+
+ large : 7 * 64 = 448 3.584 Kb
+ medium : 4 * 64 + 2 * 32 + 1 * 16 = 336 2.688 Kb
+ small : 4 * 32 + 3 * 8 = 152 1.216 Kb
+
+ The memory saving is not that large but keep in mind that we have these huge eqtb arrays and
+ registers are accessed frequently so the more we have in the CPU cache the better. (We already
+ use less than in \LUATEX\ because we got rid of some parallel array so there it would have more
+ impact).
+
+*/
+
+# if 1
+
+ # define max_toks_register_index 0xFFFF /* 0xFFFF 0xFFFF 0x7FFF */ /* 64 64 32 */
+ # define max_box_register_index 0xFFFF /* 0xFFFF 0xFFFF 0x7FFF */ /* 64 64 32 */
+ # define max_int_register_index 0xFFFF /* 0xFFFF 0xFFFF 0x7FFF */ /* 64 64 32 */
+ # define max_dimen_register_index 0xFFFF /* 0xFFFF 0xFFFF 0x7FFF */ /* 64 64 32 */
+ # define max_attribute_register_index 0xFFFF /* 0xFFFF 0x7FFF 0x1FFF */ /* 64 32 8 */
+ # define max_glue_register_index 0xFFFF /* 0xFFFF 0x7FFF 0x3FFF */ /* 64 32 8 */
+ # define max_mu_glue_register_index 0xFFFF /* 0xFFFF 0x3FFF 0x1FFF */ /* 64 16 8 */
+ # define max_em_glue_register_index 0xFFFF /* 0xFFFF 0x3FFF 0x1FFF */ /* 64 16 8 */
+ # define max_ex_glue_register_index 0xFFFF /* 0xFFFF 0x3FFF 0x1FFF */ /* 64 16 8 */
+
+# else
+
+ # define max_toks_register_index 0x7FFF
+ # define max_box_register_index 0x7FFF
+ # define max_int_register_index 0x7FFF
+ # define max_dimen_register_index 0x7FFF
+ # define max_attribute_register_index 0x1FFF
+ # define max_glue_register_index 0x3FFF
+ # define max_mu_glue_register_index 0x1FFF
+ # define max_em_glue_register_index 0x1FFF
+ # define max_ex_glue_register_index 0x1FFF
+
+# endif
+
+# define max_n_of_toks_registers (max_toks_register_index + 1)
+# define max_n_of_box_registers (max_box_register_index + 1)
+# define max_n_of_int_registers (max_int_register_index + 1)
+# define max_n_of_dimen_registers (max_dimen_register_index + 1)
+# define max_n_of_attribute_registers (max_attribute_register_index + 1)
+# define max_n_of_glue_registers (max_glue_register_index + 1)
+# define max_n_of_mu_glue_registers (max_mu_glue_register_index + 1)
+# define max_n_of_em_glue_registers (max_em_glue_register_index + 1)
+# define max_n_of_ex_glue_registers (max_ex_glue_register_index + 1)
+
+# define max_n_of_bytecodes 65536 /* dynamic */
+# define max_n_of_math_families 64
+# define max_n_of_math_classes 64
+# define max_n_of_catcode_tables 256
+# define max_n_of_box_indices max_halfword
+
+# define max_character_code 0x10FFFF /*tex 1114111, the largest allowed character number; must be |< max_halfword| */
+//define max_math_character_code 0x0FFFFF /*tex 1048575, for now this is plenty, otherwise we need to store differently */
+# define max_math_character_code max_character_code /*tex part gets clipped when we convert to a number */
+# define max_function_reference cs_offset_max
+# define min_iterator_value -0xFFFFF /* When we decide to generalize it might become 0xFFFF0 with */
+# define max_iterator_value 0xFFFFF /* 0x0000F being a classifier so that we save cmd's */
+# define max_category_code 15
+# define max_newline_character 127 /*tex Th is is an old constraint but there is no reason to change it. */
+# define max_box_axis 255
+# define max_size_of_word 1024 /*tex More than enough (esp. since this can end up on the stack. */
+# define min_limited_scale 0 /*tex Zero is a signal too. */
+# define max_limited_scale 1000
+
+# define max_mark_index (max_n_of_marks - 1)
+# define max_insert_index (max_n_of_inserts - 1)
+# define max_box_index (max_n_of_box_indices - 1)
+# define max_bytecode_index (max_n_of_bytecodes - 1)
+# define max_math_family_index (max_n_of_math_families - 1)
+# define max_math_class_code (max_n_of_math_classes - 1)
+# define max_math_property 0xFFFF
+# define max_math_group 0xFFFF
+# define max_math_index max_character_code
+# define max_math_discretionary 0xFF
+
+# define ascii_space 32
+# define ascii_max 127
+
+/*tex
+
+ This is very math specific: we used to pack info into an unsigned 32 bit integer: class, family
+ and character. We now use node for that (which also opend up the possibility to store more
+ info) but in case of a zero family we can also decide to use the older method of packing packing
+ a number: |FF+10FFFF| but the gain (at least on \CONTEXT) is litle: around 10K so here we only
+ mention it as consideration. We can consider anyway to omit the class part when we need a
+ numeric representation, although we don't really need (or like) that kind of abuse.
+
+*/
+
+# define math_class_bits 6
+# define math_family_bits 6
+# define math_character_bits 20
+
+# define math_class_part(a) ((a >> 26) & 0x3F)
+# define math_family_part(a) ((a >> 20) & 0x3F)
+# define math_character_part(a) (a & 0xFFFFF)
+
+# define math_old_class_part(a) ((a >> 12) & 0x0F)
+# define math_old_family_part(a) ((a >> 8) & 0x0F)
+# define math_old_character_part(a) (a & 0xFF)
+
+# define math_old_class_mask(a) (a & 0x0F)
+# define math_old_family_mask(a) (a & 0x0F)
+# define math_old_character_mask(a) (a & 0xFF)
+
+# define math_packed_character(c,f,v) (((c & 0x3F) << 26) + ((f & 0x3F) << 20) + (v & 0xFFFFF))
+# define math_old_packed_character(c,f,v) (((c & 0x0F) << 12) + ((f & 0x0F) << 8) + (v & 0x000FF))
+
+# define rule_font_fam_offset 0xFFFFFF
+
+/*tex We put these here for consistency: */
+
+# define too_big_char (max_character_code + 1) /*tex 1114112, |biggest_char + 1| */
+# define special_char (max_character_code + 2) /*tex 1114113, |biggest_char + 2| */
+# define number_chars (max_character_code + 3) /*tex 1114114, |biggest_char + 3| */
+
+/*tex
+
+ As mentioned, because we're now in \CCODE\ we use a bit simplified memory mode. We don't do any
+ byte swapping related to endian properties as we don't share formats between architectures
+ anyway. A memory word is 64 bits and interpreted in several ways. So the memoryword is a bit
+ different. We also use the opportunity to squeeze eight characters into the word.
+
+ halfword : 32 bit integer (2)
+ quarterword : 16 bit integer (4)
+ singlechar : 8 bit unsigned char (8)
+ int : 32 bit integer (2)
+ glue : 64 bit double (1)
+
+ The names below still reflect the original \TEX\ names but we have simplified the model a bit.
+ Watch out: we still make |B0| and |B1| overlap |LH| which for instance is needed when a we
+ store the size of a node in the type and subtype field. The same is true for the overlapping
+ |CINT|s! Don't change this without also checking the macros elsewhere.
+
+ \starttyping
+ typedef union memoryword {
+ struct {
+ halfword H0, H1;
+ } h;
+ struct {
+ quarterword B0, B1, B2, B3;
+ } q;
+ struct {
+ unsigned char C0, C1, C2, C3, C4, C5, C6, C7;
+ } s;
+ struct {
+ glueratio GLUE;
+ } g;
+ } memoryword;
+ \stoptyping
+
+ The dual 32 bit model suits tokens well and for nodes is only needed because we store a double but
+ when we'd store a 32 bit float instead (which is cf tex) we could use a smaller single 32 bit word.
+
+ On the other hand. it might even make sense for nodes to move to a quad 32 bit variant because it
+ makes smaller node identifiers which might remove some limits. But as many nodes have an odd size
+ we will waste more memory. Of course for nodes we can at some point decide to go full dynamic and
+ use a pointer table but then we need to abstract the embedded subnodes (in disc and insert) first.
+
+ It is a bit tricky if we want to use a [8][8][16][32], [16][16][32] of similar mixing because of
+ endiannes, which is why we use a more stepwise definition of memoryword. This mixed scheme permits
+ packing more data in anode.
+
+*/
+
+// typedef union memoryword {
+// halfword H[2]; /* 2 * 32 bit */
+// unsigned int U[2];
+// quarterword Q[4]; /* 4 * 16 bit */
+// unsigned char C[8]; /* 8 * 8 bit */
+// glueratio GLUE; /* 1 * 64 bit */
+// long long L;
+// double D;
+// void *P; /* 1 * 64 bit or 32 bit */
+// } memoryword;
+
+typedef union memorysplit {
+ quarterword Q;
+ singleword S[2];
+} memorysplit;
+
+typedef union memoryalias {
+ halfword H;
+ unsigned int U;
+ /* quarterword Q[2]; */
+ /* singleword S[4]; */
+ memorysplit X[2];
+} memoryalias;
+
+typedef union memoryword {
+ /* halfword H[2]; */
+ /* unsigned int U[2]; */
+ /* quarterword Q[4]; */
+ memoryalias A[2];
+ unsigned char C[8];
+ glueratio GLUE;
+ long long L;
+ double D;
+ void *P;
+} memoryword;
+
+/*tex
+
+ These symbolic names will be used in the definitions of tokens and nodes, the core data
+ structures of the \TEX\ machinery. In some cases halfs and quarters overlap.
+
+*/
+
+# define half0 A[0].H
+# define half1 A[1].H
+
+# define hulf0 A[0].U
+# define hulf1 A[1].U
+
+// # define quart00 A[0].Q[0]
+// # define quart01 A[0].Q[1]
+// # define quart10 A[1].Q[0]
+// # define quart11 A[1].Q[1]
+
+# define quart00 A[0].X[0].Q
+# define quart01 A[0].X[1].Q
+# define quart10 A[1].X[0].Q
+# define quart11 A[1].X[1].Q
+
+// # define single00 A[0].S[0]
+// # define single01 A[0].S[1]
+// # define single02 A[0].S[2]
+// # define single03 A[0].S[3]
+// # define single10 A[1].S[0]
+// # define single11 A[1].S[1]
+// # define single12 A[1].S[2]
+// # define single13 A[1].S[3]
+
+# define single00 A[0].X[0].S[0]
+# define single01 A[0].X[0].S[1]
+# define single02 A[0].X[1].S[0]
+# define single03 A[0].X[1].S[1]
+# define single10 A[1].X[0].S[0]
+# define single11 A[1].X[0].S[1]
+# define single12 A[1].X[1].S[0]
+# define single13 A[1].X[1].S[1]
+
+# define glue0 GLUE
+# define long0 L
+# define double0 D
+
+/*tex
+
+ We're coming from \PASCAL\ which has a boolean type, while in \CCODE\ an |int| is used. However,
+ as we often have callbacks and and a connection with the \LUA\ end using |boolean|, |true| and
+ |false| is often somewhat inconstent. For that reason we now use |int| instead. It also prevents
+ interference with a different definition of |boolean|, something that we can into a few times in
+ the past with external code.
+
+ There were not that many explicit booleans used anyway so better be consistent in using integers
+ than have an inconsistent mix.
+
+*/
+
+/*tex
+
+ The following parameters can be changed at compile time to extend or reduce \TEX's capacity.
+ They may have different values in |INITEX| and in production versions of \TEX. Some values can
+ be adapted at runtime. We start with those that influence memory management. Anyhow, some day
+ I will collect some statistics from runs and come up with (probably) lower defaults.
+
+*/
+
+/*tex These do a stepwise allocation. */
+
+/*tex The buffer is way too large ... only lines ... we could start out smaller */
+
+/*define magic_maximum 2097151 */ /* (max string) Because we step 500K we will always be below this. */
+//define magic_maximum 2000000 /* Looks nicer and we never need the real maximum anyway. */
+# define magic_maximum cs_offset_value /* Looks nicer and we never need the real maximum anyway. */
+
+# define max_hash_size magic_maximum /* This is one of these magic numbers. */
+# define min_hash_size 150000 /* A reasonable default. */
+# define siz_hash_size 250000
+# define stp_hash_size 100000 /* Often we have enough. */
+
+# define max_pool_size magic_maximum /* stringsize ! */
+# define min_pool_size 150000
+# define siz_pool_size 500000
+# define stp_pool_size 100000
+
+# define max_body_size 100000000 /* poolsize */
+# define min_body_size 10000000
+# define siz_body_size 20000000
+# define stp_body_size 1000000
+
+# define max_node_size 100000000 /* Currently these are the memory words! */
+//define siz_node_size 5000000
+# define siz_node_size 25000000
+# define min_node_size 2000000 /* Currently these are the memory words! */
+# define stp_node_size 500000 /* Currently these are the memory words! */
+
+# define max_token_size 10000000 /* If needed we can go much larger. */
+# define siz_token_size 10000000
+# define min_token_size 1000000 /* The original 10000 is a bit cheap. */
+# define stp_token_size 250000
+
+# define max_buffer_size 100000000 /* Let's be generous */
+# define siz_buffer_size 10000000
+# define min_buffer_size 1000000 /* We often need quite a bit. */
+# define stp_buffer_size 1000000 /* We use this step when we increase the table. */
+
+# define max_nest_size 10000 /* The table will grow dynamically but the file system might have limitations. */
+# define min_nest_size 1000 /* Quite a bit more that the old default 50. */
+# define siz_nest_size 10000 /* Quite a bit more that the old default 50. */
+# define stp_nest_size 1000 /* We use this step when we increase the table. */
+
+# define max_in_open 2000 /* The table will grow dynamically but the file system might have limitations. */
+# define min_in_open 500 /* This used to be 100, but who knows what users load. */
+# define siz_in_open 2000 /* This used to be 100, but who knows what users load. */
+# define stp_in_open 250 /* We use this step when we increase the table. */
+
+# define max_parameter_size 100000 /* This should be plenty and if not there probably is an issue in the macro package. */
+# define min_parameter_size 20000 /* The original value of 60 is definitely not enough when we nest macro calls. */
+# define siz_parameter_size 100000 /* The original value of 60 is definitely not enough when we nest macro calls. */
+# define stp_parameter_size 10000 /* We use this step when we increase the table. */
+
+# define max_save_size 500000 /* The table will grow dynamically. */
+# define min_save_size 100000 /* The original value was 5000, which is not that large for todays usage. */
+# define siz_save_size 500000 /* The original value was 5000, which is not that large for todays usage. */
+# define stp_save_size 10000 /* We use this step when we increase the table. */
+
+# define max_stack_size 100000 /* The table will grow dynamically. */
+# define min_stack_size 10000 /* The original value was 500, okay long ago, but not now. */
+# define siz_stack_size 100000 /* The original value was 500, okay long ago, but not now. */
+# define stp_stack_size 10000 /* We use this step when we increase the table. */
+
+# define max_mark_size 10000 /*tex The 64K was rediculous (5 64K arrays of halfword). */
+# define min_mark_size 50
+# define stp_mark_size 50
+
+# define max_insert_size 500
+# define min_insert_size 10
+# define stp_insert_size 10
+
+# define max_font_size 100000 /* We're now no longer hooked into the eqtb (saved 500+ K in the format too). */
+# define min_font_size 250
+# define stp_font_size 250
+
+# define max_language_size 10000 /* We could bump this (as we merged the hj codes) but it makes no sense. */
+# define min_language_size 250
+# define stp_language_size 250
+
+/*tex
+
+ These are used in the code, so when we want them to adapt, which is needed when we make them
+ configurable, we need to change this.
+
+*/
+
+# define max_n_of_marks max_mark_size
+# define max_n_of_inserts max_insert_size
+# define max_n_of_fonts max_font_size
+# define max_n_of_languages max_language_size
+
+/*tex
+
+ The following settings are not related to memory management. Some day I will probably change
+ the error half stuff. There is already an indent related frozen setting here.
+
+*/
+
+# define max_expand_depth 1000000 /* Just a number, no allocation. */
+# define min_expand_depth 10000
+
+# define max_error_line 255 /* This also determines size of a (static) array */
+# define min_error_line 132 /* Good old \TEX\ uses a value of 79. */
+
+# define max_half_error_line 255
+# define min_half_error_line 80 /* Good old \TEX\ uses a value of 50. */
+
+# define memory_data_unset -1
+
+typedef struct memory_data {
+ int ptr; /* the current pointer */
+ int top; /* the maximum used pointer */
+ int size; /* the used (optionally user asked) value */
+ int allocated; /* the currently allocated amount */
+ int step; /* the step used for growing */
+ int minimum; /* the default mininum allocated, also the step */
+ int maximum; /* the maximum possible */
+ int itemsize; /* the itemsize */
+ int initial;
+ int offset; /* offset of ptr and top */
+} memory_data;
+
+typedef struct limits_data {
+ int size; /* the used (optionally user asked) value */
+ int minimum; /* the default mininum allocated */
+ int maximum; /* the maximum possible */
+ int top; /* the maximum used */
+} limits_data;
+
+extern void tex_dump_constants (dumpstream f);
+extern void tex_undump_constants (dumpstream f);
+
+/*tex
+
+This is an experimental feature, different approaces to the main command dispatcher:
+
+\starttabulate[|l|l|l|l|l|l]
+\BC n \BC method \BC [vhm]mode \BC binary \BC manual \BC comment \NC \NR
+\ML
+\NC 0 \NC jump table \NC cmd offsets \NC 2.691.584 \NC 10.719 \NC original method, selector: (cmd + mode) \NC \NR
+\NC 1 \NC case with modes \NC sequential \NC 2.697.216 \NC 10.638 \NC nicer modes, we can delegate more to runners \NC \NR
+\NC 2 \NC flat case \NC cmd offsets \NC 2.695.168 \NC 10.562 \NC variant on original \NC \NR
+\stoptabulate
+
+The second method can be codes differently where we can delegate more to runners (that then can get
+called with a mode argument). Maybe for a next iteration. Concerning performance: the differences
+can be neglected (no differences on the test suite) because the bottleneck in \CONTEXT\ is at the
+\LUA\ end.
+
+I occasionally test the variants. The last test showed that mode 1 gives a bit larger binary. There
+is no real difference in performance.
+
+*/
+
+# define main_control_mode 1
+
+/*tex For the moment here. */
+
+typedef struct line_break_properties {
+ halfword initial_par;
+ halfword display_math;
+ halfword tracing_paragraphs;
+ halfword paragraph_dir;
+ halfword parfill_left_skip;
+ halfword parfill_right_skip;
+ halfword parinit_left_skip;
+ halfword parinit_right_skip;
+ halfword par_left_skip;
+ halfword par_right_skip;
+ halfword pretolerance;
+ halfword tolerance;
+ halfword emergency_stretch;
+ halfword looseness;
+ halfword adjust_spacing;
+ halfword protrude_chars;
+ halfword adj_demerits;
+ halfword line_penalty;
+ halfword last_line_fit;
+ halfword double_hyphen_demerits;
+ halfword final_hyphen_demerits;
+ scaled hsize;
+ halfword left_skip;
+ halfword right_skip;
+ scaled hang_indent;
+ halfword hang_after;
+ halfword par_shape;
+ halfword inter_line_penalty;
+ halfword inter_line_penalties;
+ halfword club_penalty;
+ halfword club_penalties;
+ halfword widow_penalty;
+ halfword widow_penalties;
+ halfword display_widow_penalty;
+ halfword display_widow_penalties;
+ halfword orphan_penalty;
+ halfword orphan_penalties;
+ halfword broken_penalty;
+ halfword baseline_skip;
+ halfword line_skip;
+ halfword line_skip_limit;
+ halfword adjust_spacing_step;
+ halfword adjust_spacing_shrink;
+ halfword adjust_spacing_stretch;
+ halfword hyphenation_mode;
+ halfword shaping_penalties_mode;
+ halfword shaping_penalty;
+ halfword padding;
+} line_break_properties;
+
+# endif
+
diff --git a/source/luametatex/source/utilities/auxarithmetic.h b/source/luametatex/source/utilities/auxarithmetic.h
new file mode 100644
index 000000000..8daf6f29a
--- /dev/null
+++ b/source/luametatex/source/utilities/auxarithmetic.h
@@ -0,0 +1,61 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_UTILITIES_ARITHMETIC_H
+# define LMT_UTILITIES_ARITHMETIC_H
+
+/* The |fabs| macro is used in mp. */
+
+/*tex
+
+There has always be much attention on accuracy in \TEX, especially in the perspective of portability.
+Keep in mind that \TEX\ was written when there was no IEEE floating point defined so all happens in
+16.16, or actually in 14.16 precission. We could actually consider going 16.16 if we use long integers
+in some places but it needs some checking first. We could just accept wrapping around as that already
+happens in some places anyway (not all dimension calculation are checked).
+
+In \LUATEX\ and \LUAMETATEX\ we have the \LUA\ engine and that one was exclusively using doubles till
+5.3 when it went for a more hybrid approach. Because we go a lot between \TEX\ and \LUA\ (in \CONTEXT)
+that had some consequences and rounding happens all over the place. It is also for that reason that
+we now use doubles and rounding in some more places in the \TEX\ part: it is more consistent with what
+happens at the \LUA\ end. And, because IEEE is common now, we are (afaiks) portable enough.
+
+We don't use round but lround as that one rounds away from zero. In a few places we use llround. Also
+in some places we clip to the official maxima but not always.
+
+*/
+
+
+/*
+# undef abs
+# undef fabs
+
+# define abs(x) ((int)(x) >= 0 ? (int)(x) : (int)-(x))
+# define fabs(x) ((x) >= 0.0 ? (x) : -(x))
+*/
+
+# define odd(x) ((x) & 1)
+
+# define lfloor(x) ( (lua_Integer)(floor((double)(x))) )
+# define tfloor(x) ( (size_t) (floor((double)(x))) )
+# define ifloor(x) ( (int) (floor((double)(x))) )
+
+//define lround(x) ( ((double) x >= 0.0) ? (lua_Integer) ((double) x + 0.5) : (lua_Integer) ((double) x - 0.5) )
+//define tround(x) ( ((double) x >= 0.0) ? (size_t) ((double) x + 0.5) : (size_t) ((double) x - 0.5) )
+//define iround(x) ( ((double) x >= 0.0) ? (int) ((double) x + 0.5) : (int) ((double) x - 0.5) )
+//define sround(x) ( ((double) x >= 0.0) ? (int) ((double) x + 0.5) : (int) ((double) x - 0.5) )
+
+//define lround(x) ( ((double) x >= 0.0) ? (lua_Integer) ((double) x + 0.5) : (lua_Integer) ((double) x - 0.5) )
+//define tround(x) ( ((double) x >= 0.0) ? (size_t) ((double) x + 0.5) : (size_t) ((double) x - 0.5) )
+//define iround(x) ( (int) lround((double) x) )
+
+//define zround(r) ((r>2147483647.0) ? 2147483647 : ((r<-2147483647.0) ? -2147483647 : ((r >= 0.0) ? (int)(r + 0.5) : ((int)(r-0.5)))))
+//define zround(r) ((r>2147483647.0) ? 2147483647 : ((r<-2147483647.0) ? -2147483647 : (int) lround(r)))
+
+# define scaledround(x) ((scaled) lround((double) x))
+# define longlonground llround
+# define clippedround(r) ((r>2147483647.0) ? 2147483647 : ((r<-2147483647.0) ? -2147483647 : (int) lround(r)))
+# define glueround(x) clippedround((double) (x))
+
+# endif
diff --git a/source/luametatex/source/utilities/auxfile.c b/source/luametatex/source/utilities/auxfile.c
new file mode 100644
index 000000000..1aae0e691
--- /dev/null
+++ b/source/luametatex/source/utilities/auxfile.c
@@ -0,0 +1,294 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include <stdio.h>
+# include <sys/stat.h>
+
+# include "auxfile.h"
+# include "auxmemory.h"
+
+# ifdef _WIN32
+
+ # include <windows.h>
+ # include <ctype.h>
+ # include <io.h>
+ # include <shellapi.h>
+
+ LPWSTR aux_utf8_to_wide(const char *utf8str) {
+ if (utf8str) {
+ int length = MultiByteToWideChar(CP_UTF8, 0, utf8str, -1, NULL, 0); /* preroll */
+ LPWSTR wide = (LPWSTR) lmt_memory_malloc(sizeof(WCHAR) * length);
+ MultiByteToWideChar(CP_UTF8, 0, utf8str, -1, wide, length);
+ return wide;
+ } else {
+ return NULL;
+ }
+ }
+
+ char *aux_utf8_from_wide(LPWSTR widestr) {
+ if (widestr) {
+ int length = WideCharToMultiByte(CP_UTF8, 0, widestr, -1, NULL, 0, NULL, NULL);
+ char * utf8str = (char *) lmt_memory_malloc(sizeof(char) * length);
+ WideCharToMultiByte(CP_UTF8, 0, widestr, -1, utf8str, length, NULL, NULL);
+ return (char *) utf8str;
+ } else {
+ return NULL;
+ }
+ }
+
+ FILE *aux_utf8_fopen(const char *path, const char *mode) {
+ if (path && mode) {
+ LPWSTR wpath = aux_utf8_to_wide(path);
+ LPWSTR wmode = aux_utf8_to_wide(mode);
+ FILE *f = _wfopen(wpath,wmode);
+ lmt_memory_free(wpath);
+ lmt_memory_free(wmode);
+ return f;
+ } else {
+ return NULL;
+ }
+ }
+
+ FILE *aux_utf8_popen(const char *path, const char *mode) {
+ if (path && mode) {
+ LPWSTR wpath = aux_utf8_to_wide(path);
+ LPWSTR wmode = aux_utf8_to_wide(mode);
+ FILE *f = _wpopen(wpath,wmode);
+ lmt_memory_free(wpath);
+ lmt_memory_free(wmode);
+ return f;
+ } else {
+ return NULL;
+ }
+ }
+
+ int aux_utf8_system(const char *cmd)
+ {
+ LPWSTR wcmd = aux_utf8_to_wide(cmd);
+ int result = _wsystem(wcmd);
+ lmt_memory_free(wcmd);
+ return result;
+ }
+
+ int aux_utf8_remove(const char *name)
+ {
+ LPWSTR wname = aux_utf8_to_wide(name);
+ int result = _wremove(wname);
+ lmt_memory_free(wname);
+ return result;
+ }
+
+ int aux_utf8_rename(const char *oldname, const char *newname)
+ {
+ LPWSTR woldname = aux_utf8_to_wide(oldname);
+ LPWSTR wnewname = aux_utf8_to_wide(newname);
+ int result = _wrename(woldname, wnewname);
+ lmt_memory_free(woldname);
+ lmt_memory_free(wnewname);
+ return result;
+ }
+
+ int aux_utf8_setargv(char * **av, char **argv, int argc)
+ {
+ if (argv) {
+ int c = 0;
+ LPWSTR *l = CommandLineToArgvW(GetCommandLineW(), &c);
+ if (l != NULL) {
+ char **v = lmt_memory_malloc(sizeof(char *) * c);
+ for (int i = 0; i < c; i++) {
+ v[i] = aux_utf8_from_wide(l[i]);
+ }
+ *av = v;
+ /*tex Let's be nice with path names: |c:\\foo\\etc| */
+ if (c > 1) {
+ if ((strlen(v[c-1]) > 2) && isalpha(v[c-1][0]) && (v[c-1][1] == ':') && (v[c-1][2] == '\\')) {
+ for (char *p = v[c-1]+2; *p; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ }
+ }
+ }
+ return c;
+ } else {
+ *av = NULL;
+ return argc;
+ }
+ }
+
+ char *aux_utf8_getownpath(const char *file)
+ {
+ if (file) {
+ char *path = NULL;
+ char buffer[MAX_PATH];
+ GetModuleFileName(NULL,buffer,sizeof(buffer));
+ path = lmt_memory_strdup(buffer);
+ if (strlen(path) > 0) {
+ for (size_t i = 0; i < strlen(path); i++) {
+ if (path[i] == '\\') {
+ path[i] = '/';
+ }
+ }
+ return path;
+ }
+ }
+ return lmt_memory_strdup(".");
+ }
+
+# else
+
+ # include <string.h>
+ # include <stdlib.h>
+ # include <unistd.h>
+
+ int aux_utf8_setargv(char * **av, char **argv, int argc)
+ {
+ *av = argv;
+ return argc;
+ }
+
+ char *aux_utf8_getownpath(const char *file)
+ {
+ if (strchr(file, '/')) {
+ return lmt_memory_strdup(file);
+ } else {
+ const char *esp;
+ size_t prefixlen = 0;
+ size_t totallen = 0;
+ size_t filelen = strlen(file);
+ char *path = NULL;
+ char *searchpath = lmt_memory_strdup(getenv("PATH"));
+ const char *index = searchpath;
+ if (index) {
+ do {
+ esp = strchr(index, ':');
+ if (esp) {
+ prefixlen = (size_t) (esp - index);
+ } else {
+ prefixlen = strlen(index);
+ }
+ if (prefixlen == 0 || index[prefixlen - 1] == '/') {
+ totallen = prefixlen + filelen;
+# ifdef PATH_MAX
+ if (totallen >= PATH_MAX) {
+ continue;
+ }
+# endif
+ path = lmt_memory_malloc(totallen + 1);
+ memcpy(path, index, prefixlen);
+ memcpy(path + prefixlen, file, filelen);
+ } else {
+ totallen = prefixlen + filelen + 1;
+# ifdef PATH_MAX
+ if (totallen >= PATH_MAX) {
+ continue;
+ }
+# endif
+ path = lmt_memory_malloc(totallen + 1);
+ memcpy(path, index, prefixlen);
+ path[prefixlen] = '/';
+ memcpy(path + prefixlen + 1, file, filelen);
+ }
+ path[totallen] = '\0';
+ if (access(path, X_OK) >= 0) {
+ break;
+ }
+ lmt_memory_free(path);
+ path = NULL;
+ index = esp + 1;
+ } while (esp);
+ }
+ lmt_memory_free(searchpath);
+ if (path) {
+ return path;
+ } else {
+ return lmt_memory_strdup("."); /* ok? */
+ }
+ }
+ }
+
+# endif
+
+# ifndef S_ISREG
+ # define S_ISREG(mode) (mode & _S_IFREG)
+# endif
+
+# ifdef _WIN32
+
+ char *aux_basename(const char *name) {
+ char base[256+1];
+ char suff[256+1];
+ _splitpath(name,NULL,NULL,base,suff);
+ {
+ size_t b = strlen((const char*)base);
+ size_t s = strlen((const char*)suff);
+ char *result = (char *) lmt_memory_malloc(sizeof(char) * (b+s+1));
+ if (result) {
+ memcpy(&result[0], &base[0], b);
+ memcpy(&result[b], &suff[0], s);
+ result[b + s] = '\0';
+ }
+ return result;
+ }
+ }
+
+ char *aux_dirname(const char *name) {
+ char driv[256 + 1];
+ char path[256 + 1];
+ _splitpath(name,driv,path,NULL,NULL);
+ {
+ size_t d = strlen((const char*)driv);
+ size_t p = strlen((const char*)path);
+ char *result = (char *) lmt_memory_malloc(sizeof(char) * (d+p+1));
+ if (result) {
+ if (path[p - 1] == '/' || path[p - 1] == '\\') {
+ --p;
+ }
+ memcpy(&result[0], &driv[0], d);
+ memcpy(&result[d], &path[0], p);
+ result[d + p] = '\0';
+ }
+ return result;
+ }
+ }
+
+ // int aux_is_readable(const char *filename)
+ // {
+ // struct stat finfo;
+ // FILE *f;
+ // return (stat(filename, &finfo) == 0)
+ // && S_ISREG(finfo.st_mode)
+ // && ((f = aux_utf8_fopen(filename, "r")) != NULL)
+ // && ! fclose(f);
+ // }
+
+ int aux_is_readable(const char *filename)
+ {
+ struct _stati64 info;
+ LPWSTR w = aux_utf8_to_wide(filename);
+ int r = _wstati64(w, &info);
+ FILE *f;
+ lmt_memory_free(w);
+ return (r == 0)
+ && (S_ISREG(info.st_mode))
+ && ((f = aux_utf8_fopen(filename, "r")) != NULL)
+ && ! fclose(f);
+ }
+
+# else
+
+ # include <libgen.h>
+
+ int aux_is_readable(const char *filename)
+ {
+ struct stat finfo;
+ FILE *f;
+ return (stat(filename, &finfo) == 0)
+ && S_ISREG(finfo.st_mode)
+ && ((f = fopen(filename, "r")) != NULL)
+ && ! fclose(f);
+ }
+
+# endif
diff --git a/source/luametatex/source/utilities/auxfile.h b/source/luametatex/source/utilities/auxfile.h
new file mode 100644
index 000000000..19a4815c2
--- /dev/null
+++ b/source/luametatex/source/utilities/auxfile.h
@@ -0,0 +1,166 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_UTILITIES_FILE_H
+# define LMT_UTILITIES_FILE_H
+
+/*tex
+
+ We have to deal with wide characters on windows when it comes to filenames. The same is true for
+ the commandline and environment variables. Basically we go from utf8 to wide and back.
+
+ \starttyping
+ libraries/zlib/crc32.c : fopen -> minimalistic, goes via lua anyway
+ libraries/zlib/trees.c : fopen -> minimalistic, goes via lua anyway
+ libraries/zlib/zutil.h : fopen -> minimalistic, goes via lua anyway
+
+ lua/llualib.c : fopen -> utf8_fopen
+ lua/lenginelib.c : fopen -> utf8_fopen
+
+ luacore/lua54/src/lauxlib.c : fopen -> see below
+ luacore/lua54/src/liolib.c : fopen -> see below
+ luacore/lua54/src/loadlib.c : fopen -> see below
+
+ luaffi/call.c : fopen -> not used
+
+ mp/mpw/mp.w : fopen -> overloaded by callback
+
+ libraries/pplib/ppload.c : fopen -> will be abstraction (next pplib)
+
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+ libraries/pplib/util/utiliof.c : fopen -> not used
+
+ tex/texfileio.c 12: : fopen -> utf8_fopen
+ \stoptyping
+
+ Furthermore:
+
+ \starttyping
+ - system commands (execute) : done
+ - popen : done
+
+ - lua rename : done
+ - lua remove : done
+
+ - command line argv : done
+ - lua setenv : done
+ - lua getenv : done
+
+ - lfs attributes : done
+ - lfs chdir : done
+ - lfs currentdir : done
+ - lfs dir : done
+ - lfs mkdir : done
+ - lfs rmdir : done
+ - lfs touch : done
+ - lfs link : done
+ - lfs symlink : done
+ - lfs setexecutable : done (needs testing)
+ - lfs isdir : done
+ - lfs isfile : done
+ - lfs iswriteabledir : done
+ - lfs iswriteablefile : done
+ - lfs isreadabledir : done
+ - lfs isreadablefile : done
+ \stoptyping
+
+ Kind of tricky because quite some code (indirectness):
+
+ \starttyping
+ - lua load : via overload ?
+ - lua dofile : via overload -> loadstring
+ - lua require : via overload ?
+ \stoptyping
+
+ So: do we patch lua (fopen) or just copy? We can actually assume flat ascii files for libraries
+ and such so there is no real need unless we load job related files.
+
+ I will probably reshuffle some code and maybe more some more here; once I'm sure all works out
+ well.
+
+*/
+
+# ifdef _WIN32
+
+ # include <windows.h>
+ # include <ctype.h>
+ # include <stdio.h>
+
+ extern LPWSTR aux_utf8_to_wide (const char *utf8str);
+ extern char *aux_utf8_from_wide (LPWSTR widestr);
+
+ extern FILE *aux_utf8_fopen (const char *path, const char *mode);
+ extern FILE *aux_utf8_popen (const char *path, const char *mode);
+ extern int aux_utf8_system (const char *cmd);
+ extern int aux_utf8_remove (const char *name);
+ extern int aux_utf8_rename (const char *oldname, const char *newname);
+ extern int aux_utf8_setargv (char * **av, char **argv, int argc);
+ extern char *aux_utf8_getownpath (const char *file);
+
+# else
+
+ # define aux_utf8_fopen fopen
+ # define aux_utf8_popen popen
+ # define aux_utf8_system system
+ # define aux_utf8_remove remove
+ # define aux_utf8_rename rename
+
+ extern int aux_utf8_setargv (char * **av, char **argv, int argc);
+ extern char *aux_utf8_getownpath (const char *file);
+
+ # include <libgen.h>
+
+# endif
+
+# ifdef _WIN32
+
+ extern char *aux_basename (const char *name);
+ extern char *aux_dirname (const char *name);
+
+# else
+
+ # define aux_basename basename
+ # define aux_dirname dirname
+
+# endif
+
+extern int aux_is_readable (const char *filename);
+
+/*tex
+
+ We support unix and windows. In fact, we could stick to |/| only. When
+ scanning filenames entered in \TEX\ we can actually enforce a |/| as
+ convention.
+
+*/
+
+# ifndef IS_DIR_SEP
+ # ifdef _WIN32
+ # define IS_DIR_SEP(ch) ((ch) == '/' || (ch) == '\\')
+ # else
+ # define IS_DIR_SEP(ch) ((ch) == '/')
+ # endif
+# endif
+
+# ifndef R_OK
+ # define F_OK 0x0
+ # define W_OK 0x2
+ # define R_OK 0x4
+# endif
+
+# ifndef S_ISREG
+ # define S_ISREG(mode) (mode & _S_IFREG)
+# endif
+
+# endif
diff --git a/source/luametatex/source/utilities/auxmemory.c b/source/luametatex/source/utilities/auxmemory.c
new file mode 100644
index 000000000..9ba02f946
--- /dev/null
+++ b/source/luametatex/source/utilities/auxmemory.c
@@ -0,0 +1,25 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "auxmemory.h"
+
+void *aux_allocate_array(int recordsize, int size, int reserved)
+{
+ return lmt_memory_malloc(recordsize * ((size_t) size + reserved + 1));
+}
+
+void *aux_reallocate_array(void *p, int recordsize, int size, int reserved)
+{
+ return lmt_memory_realloc(p, recordsize * ((size_t) size + reserved + 1));
+}
+
+void *aux_allocate_clear_array(int recordsize, int size, int reserved)
+{
+ return lmt_memory_calloc((size_t) size + reserved + 1, recordsize);
+}
+
+void aux_deallocate_array(void *p)
+{
+ lmt_memory_free(p);
+}
diff --git a/source/luametatex/source/utilities/auxmemory.h b/source/luametatex/source/utilities/auxmemory.h
new file mode 100644
index 000000000..4f040eafd
--- /dev/null
+++ b/source/luametatex/source/utilities/auxmemory.h
@@ -0,0 +1,54 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*
+ Some operating systems come with |allocarray| so we use more verbose names. We cannot define
+ them because on some bsd/apple platforms |CLANG| cannot resolve them.
+
+*/
+
+# ifndef LMT_UTILITIES_MEMORY_H
+# define LMT_UTILITIES_MEMORY_H
+
+/*tex
+ This is an experiment. The impact of using an alternative allocator on native Windows makes a
+ native version some 5% faster than a cross compiled one. Otherwise the cross compiled version
+ outperforms the native one a bit. In \TEX\ and \METAPOST\ we already do something like this
+ but there we don't reclaim memory.
+
+*/
+
+# include <stdlib.h>
+# include <string.h>
+
+# if defined(LUAMETATEX_USE_MIMALLOC)
+ # include "libraries/mimalloc/include/mimalloc.h"
+ # define lmt_memory_malloc mi_malloc
+ # define lmt_memory_calloc mi_calloc
+ # define lmt_memory_realloc mi_realloc
+ # define lmt_memory_free mi_free
+ # define lmt_memory_strdup mi_strdup
+
+ // # include "libraries/mimalloc/include/mimalloc-override.h"
+
+# else
+ # define lmt_memory_malloc malloc
+ # define lmt_memory_calloc calloc
+ # define lmt_memory_realloc realloc
+ # define lmt_memory_free free
+ # define lmt_memory_strdup strdup
+# endif
+
+# define lmt_generic_malloc malloc
+# define lmt_generic_calloc calloc
+# define lmt_generic_realloc realloc
+# define lmt_generic_free free
+# define lmt_generic_strdup strdup
+
+extern void *aux_allocate_array (int recordsize, int size, int reserved);
+extern void *aux_reallocate_array (void *p, int recordsize, int size, int reserved);
+extern void *aux_allocate_clear_array (int recordsize, int size, int reserved);
+extern void aux_deallocate_array (void *p);
+
+# endif
diff --git a/source/luametatex/source/utilities/auxsparsearray.c b/source/luametatex/source/utilities/auxsparsearray.c
new file mode 100644
index 000000000..d9fa5e453
--- /dev/null
+++ b/source/luametatex/source/utilities/auxsparsearray.c
@@ -0,0 +1,623 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ Here we implement sparse arrays with an embedded save stack. These functions are called very
+ often but a few days of experimenting proved that there is not much to gain (if at all) from
+ using macros or optimizations like preallocating and fast access to the first 128 entries. In
+ practice the overhead is mostly in accessing memory and not in (probably inlined) calls. So, we
+ should accept fate and wait for faster memory. It's the price we pay for being unicode on the
+ one hand and sparse on the other.
+
+*/
+
+# include "luametatex.h"
+
+sparse_state_info lmt_sparse_state = {
+ .sparse_data = {
+ .minimum = memory_data_unset,
+ .maximum = memory_data_unset,
+ .size = memory_data_unset,
+ .step = memory_data_unset,
+ .allocated = 0,
+ .itemsize = 1,
+ .top = memory_data_unset,
+ .ptr = memory_data_unset,
+ .initial = memory_data_unset,
+ .offset = 0,
+}
+};
+
+void *sa_malloc_array(int recordsize, int size)
+{
+ int allocated = recordsize * size;
+ lmt_sparse_state.sparse_data.allocated += allocated;
+ return lmt_memory_malloc((size_t) allocated);
+}
+
+void *sa_realloc_array(void *p, int recordsize, int size, int step)
+{
+ int deallocated = recordsize * size;
+ int allocated = recordsize * (size + step);
+ lmt_sparse_state.sparse_data.allocated += (allocated - deallocated);
+ return lmt_memory_realloc(p, (size_t) allocated);
+}
+
+void *sa_calloc_array(int recordsize, int size)
+{
+ int allocated = recordsize * size;
+ lmt_sparse_state.sparse_data.allocated += allocated;
+ return lmt_memory_calloc((size_t) size, recordsize);
+}
+
+void sa_wipe_array(void *head, int recordsize, int size)
+{
+ memset(head, 0, recordsize * ((size_t) size));
+}
+
+void *sa_free_array(void *p)
+{
+ lmt_memory_free(p);
+ return NULL;
+}
+
+/*tex
+
+ Once we have two variants allocated we can dump and undump a |LOWPART| array in one go. But
+ not yet. Currently the waste of one extra dummy int is cheaper than multiple functions.
+
+*/
+
+static void sa_aux_store_stack(sa_tree a, int n, sa_tree_item v1, sa_tree_item v2, int gl)
+{
+ sa_stack_item st;
+ st.code = n;
+ st.value_1 = v1;
+ st.value_2 = v2;
+ st.level = gl;
+ if (! a->stack) {
+ a->stack = sa_malloc_array(sizeof(sa_stack_item), a->sa_stack_size);
+ } else if (((a->sa_stack_ptr) + 1) >= a->sa_stack_size) {
+ a->stack = sa_realloc_array(a->stack, sizeof(sa_stack_item), a->sa_stack_size, a->sa_stack_step);
+ a->sa_stack_size += a->sa_stack_step;
+ }
+ (a->sa_stack_ptr)++;
+ a->stack[a->sa_stack_ptr] = st;
+}
+
+static void sa_aux_skip_in_stack(sa_tree a, int n)
+{
+ if (a->stack) {
+ int p = a->sa_stack_ptr;
+ while (p > 0) {
+ if (a->stack[p].code == n && a->stack[p].level > 0) {
+ a->stack[p].level = -(a->stack[p].level);
+ }
+ p--;
+ }
+ }
+}
+
+int sa_get_item_1(const sa_tree head, int n)
+{
+ if (head->tree) {
+ int h = LMT_SA_H_PART(n);
+ if (head->tree[h]) {
+ int m = LMT_SA_M_PART(n);
+ if (head->tree[h][m]) {
+ return head->tree[h][m][LMT_SA_L_PART(n)/4].uchar_value[n%4];
+ }
+ }
+ }
+ return (int) head->dflt.uchar_value[n%4];
+}
+
+int sa_get_item_2(const sa_tree head, int n)
+{
+ if (head->tree) {
+ int h = LMT_SA_H_PART(n);
+ if (head->tree[h]) {
+ int m = LMT_SA_M_PART(n);
+ if (head->tree[h][m]) {
+ return head->tree[h][m][LMT_SA_L_PART(n)/2].ushort_value[n%2];
+ }
+ }
+ }
+ return (int) head->dflt.ushort_value[n%2];
+}
+
+sa_tree_item sa_get_item_4(const sa_tree head, int n)
+{
+ if (head->tree) {
+ int h = LMT_SA_H_PART(n);
+ if (head->tree[h]) {
+ int m = LMT_SA_M_PART(n);
+ if (head->tree[h][m]) {
+ return head->tree[h][m][LMT_SA_L_PART(n)];
+ }
+ }
+ }
+ return head->dflt;
+}
+
+sa_tree_item sa_get_item_8(const sa_tree head, int n, sa_tree_item *v2)
+{
+ if (head->tree != NULL) {
+ int h = LMT_SA_H_PART(n);
+ if (head->tree[h]) {
+ int m = LMT_SA_M_PART(n);
+ if (head->tree[h][m]) {
+ int l = 2*LMT_SA_L_PART(n);
+ *v2 = head->tree[h][m][l+1];
+ return head->tree[h][m][l];
+ }
+ }
+ }
+ *v2 = head->dflt;
+ return head->dflt;
+}
+
+void sa_set_item_1(sa_tree head, int n, int v, int gl)
+{
+ int h = LMT_SA_H_PART(n);
+ int m = LMT_SA_M_PART(n);
+ int l = LMT_SA_L_PART(n);
+ if (! head->tree) {
+ head->tree = (sa_tree_item ***) sa_calloc_array(sizeof(sa_tree_item **), LMT_SA_HIGHPART);
+ }
+ if (! head->tree[h]) {
+ head->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(sa_tree_item *), LMT_SA_MIDPART);
+ }
+ if (! head->tree[h][m]) {
+ head->tree[h][m] = (sa_tree_item *) sa_malloc_array(sizeof(sa_tree_item), LMT_SA_LOWPART/4);
+ for (int i = 0; i < LMT_SA_LOWPART/4; i++) {
+ head->tree[h][m][i] = head->dflt;
+ }
+ }
+ if (gl <= 1) {
+ sa_aux_skip_in_stack(head, n);
+ } else {
+ sa_aux_store_stack(head, n, head->tree[h][m][l/4], (sa_tree_item) { 0 }, gl);
+ }
+ head->tree[h][m][l/4].uchar_value[n%4] = (unsigned char) v;
+}
+
+void sa_set_item_2(sa_tree head, int n, int v, int gl)
+{
+ int h = LMT_SA_H_PART(n);
+ int m = LMT_SA_M_PART(n);
+ int l = LMT_SA_L_PART(n);
+ if (! head->tree) {
+ head->tree = (sa_tree_item ***) sa_calloc_array(sizeof(sa_tree_item **), LMT_SA_HIGHPART);
+ }
+ if (! head->tree[h]) {
+ head->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(sa_tree_item *), LMT_SA_MIDPART);
+ }
+ if (! head->tree[h][m]) {
+ head->tree[h][m] = (sa_tree_item *) sa_malloc_array(sizeof(sa_tree_item), LMT_SA_LOWPART/2);
+ for (int i = 0; i < LMT_SA_LOWPART/2; i++) {
+ head->tree[h][m][i] = head->dflt;
+ }
+ }
+ if (gl <= 1) {
+ sa_aux_skip_in_stack(head, n);
+ } else {
+ sa_aux_store_stack(head, n, head->tree[h][m][l/2], (sa_tree_item) { 0 }, gl);
+ }
+ head->tree[h][m][l/2].ushort_value[n%2] = (unsigned short) v;
+}
+
+void sa_set_item_4(sa_tree head, int n, sa_tree_item v, int gl)
+{
+ int h = LMT_SA_H_PART(n);
+ int m = LMT_SA_M_PART(n);
+ int l = LMT_SA_L_PART(n);
+ if (! head->tree) {
+ head->tree = (sa_tree_item ***) sa_calloc_array(sizeof(sa_tree_item **), LMT_SA_HIGHPART);
+ }
+ if (! head->tree[h]) {
+ head->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(sa_tree_item *), LMT_SA_MIDPART);
+ }
+ if (! head->tree[h][m]) {
+ head->tree[h][m] = (sa_tree_item *) sa_malloc_array(sizeof(sa_tree_item), LMT_SA_LOWPART);
+ for (int i = 0; i < LMT_SA_LOWPART; i++) {
+ head->tree[h][m][i] = head->dflt;
+ }
+ }
+ if (gl <= 1) {
+ sa_aux_skip_in_stack(head, n);
+ } else {
+ sa_aux_store_stack(head, n, head->tree[h][m][l], (sa_tree_item) { 0 }, gl);
+ }
+ head->tree[h][m][l] = v;
+}
+
+void sa_set_item_8(sa_tree head, int n, sa_tree_item v1, sa_tree_item v2, int gl)
+{
+ int h = LMT_SA_H_PART(n);
+ int m = LMT_SA_M_PART(n);
+ int l = 2*LMT_SA_L_PART(n);
+ if (! head->tree) {
+ head->tree = (sa_tree_item ***) sa_calloc_array(sizeof(sa_tree_item **), LMT_SA_HIGHPART);
+ }
+ if (! head->tree[h]) {
+ head->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(sa_tree_item *), LMT_SA_MIDPART);
+ }
+ if (! head->tree[h][m]) {
+ head->tree[h][m] = (sa_tree_item *) sa_malloc_array(sizeof(sa_tree_item), 2 * LMT_SA_LOWPART);
+ for (int i = 0; i < 2 * LMT_SA_LOWPART; i++) {
+ head->tree[h][m][i] = head->dflt;
+ }
+ }
+ if (gl <= 1) {
+ sa_aux_skip_in_stack(head, n);
+ } else {
+ sa_aux_store_stack(head, n, head->tree[h][m][l], head->tree[h][m][l+1], gl);
+ }
+ head->tree[h][m][l] = v1;
+ head->tree[h][m][l+1] = v2;
+}
+
+void sa_set_item_n(sa_tree head, int n, int v, int gl)
+{
+ int h = LMT_SA_H_PART(n);
+ int m = LMT_SA_M_PART(n);
+ int l = LMT_SA_L_PART(n);
+ int d = head->bytes == 1 ? 4 : (head->bytes == 2 ? 2 : 1);
+ if (! head->tree) {
+ head->tree = (sa_tree_item ***) sa_calloc_array(sizeof(sa_tree_item **), LMT_SA_HIGHPART);
+ }
+ if (! head->tree[h]) {
+ head->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(sa_tree_item *), LMT_SA_MIDPART);
+ }
+ if (! head->tree[h][m]) {
+ head->tree[h][m] = (sa_tree_item *) sa_malloc_array(sizeof(sa_tree_item), LMT_SA_LOWPART/d);
+ for (int i = 0; i < LMT_SA_LOWPART/d; i++) {
+ head->tree[h][m][i] = head->dflt;
+ }
+ }
+ if (gl <= 1) {
+ sa_aux_skip_in_stack(head, n);
+ } else {
+ sa_aux_store_stack(head, n, head->tree[h][m][l/d], (sa_tree_item) { 0 }, gl);
+ }
+ switch (head->bytes) {
+ case 1:
+ {
+ head->tree[h][m][l/4].uchar_value[n%4] = (unsigned char) (v < 0 ? 0 : (v > 0xFF ? 0xFF : v));
+ break;
+ }
+ case 2:
+ {
+ head->tree[h][m][l/2].ushort_value[n%2] = (unsigned char) (v < 0 ? 0 : (v > 0xFFFF ? 0xFFFF : v));
+ break;
+ }
+ case 4:
+ {
+ head->tree[h][m][l].int_value = v;
+ break;
+ }
+ }
+}
+
+int sa_get_item_n(const sa_tree head, int n)
+{
+ if (head->tree) {
+ int h = LMT_SA_H_PART(n);
+ if (head->tree[h]) {
+ int m = LMT_SA_M_PART(n);
+ if (head->tree[h][m]) {
+ switch (head->bytes) {
+ case 1 : return (int) head->tree[h][m][LMT_SA_L_PART(n)/4].uchar_value[n%4];
+ case 2 : return (int) head->tree[h][m][LMT_SA_L_PART(n)/2].ushort_value[n%2];
+ case 4 : return (int) head->tree[h][m][LMT_SA_L_PART(n) ].int_value;
+ }
+ }
+ }
+ }
+ switch (head->bytes) {
+ case 1 : return (int) head->dflt.uchar_value[n%4];
+ case 2 : return (int) head->dflt.ushort_value[n%2];
+ case 4 : return (int) head->dflt.int_value;
+ default: return 0;
+ }
+}
+
+/*
+void rawset_sa_item_4(sa_tree head, int n, sa_tree_item v)
+{
+ head->tree[LMT_SA_H_PART(n)][LMT_SA_M_PART(n)][LMT_SA_L_PART(n)] = v;
+}
+*/
+
+void sa_clear_stack(sa_tree a)
+{
+ if (a) {
+ a->stack = sa_free_array(a->stack);
+ a->sa_stack_ptr = 0;
+ a->sa_stack_size = a->sa_stack_step;
+ }
+}
+
+void sa_destroy_tree(sa_tree a)
+{
+ if (a) {
+ if (a->tree) {
+ for (int h = 0; h < LMT_SA_HIGHPART; h++) {
+ if (a->tree[h]) {
+ for (int m = 0; m < LMT_SA_MIDPART; m++) {
+ a->tree[h][m] = sa_free_array(a->tree[h][m]);
+ }
+ a->tree[h] = sa_free_array(a->tree[h]);
+ }
+ }
+ a->tree = sa_free_array(a->tree);
+ }
+ a->stack = sa_free_array(a->stack);
+ a = sa_free_array(a);
+ }
+}
+
+sa_tree sa_copy_tree(sa_tree b)
+{
+ sa_tree a = (sa_tree) sa_malloc_array(sizeof(sa_tree_head), 1);
+ a->sa_stack_step = b->sa_stack_step;
+ a->sa_stack_size = b->sa_stack_size;
+ a->bytes = b->bytes;
+ a->dflt = b->dflt;
+ a->stack = NULL;
+ a->sa_stack_ptr = 0;
+ a->tree = NULL;
+ if (b->tree) {
+ a->tree = (sa_tree_item ***) sa_calloc_array(sizeof(void *), LMT_SA_HIGHPART);
+ for (int h = 0; h < LMT_SA_HIGHPART; h++) {
+ if (b->tree[h]) {
+ int slide = LMT_SA_LOWPART;
+ switch (b->bytes) {
+ case 1: slide = LMT_SA_LOWPART/4; break;
+ case 2: slide = LMT_SA_LOWPART/2; break;
+ case 4: slide = LMT_SA_LOWPART ; break;
+ case 8: slide = 2*LMT_SA_LOWPART ; break;
+ }
+ a->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(void *), LMT_SA_MIDPART);
+ for (int m = 0; m < LMT_SA_MIDPART; m++) {
+ if (b->tree[h][m]) {
+ a->tree[h][m] = sa_malloc_array(sizeof(sa_tree_item), slide);
+ memcpy(a->tree[h][m], b->tree[h][m], sizeof(sa_tree_item) * slide);
+ }
+ }
+ }
+ }
+ }
+ return a;
+}
+
+/*tex
+
+ The main reason to fill in the lowest entry branches here immediately is that most of the sparse
+ arrays have a bias toward \ASCII\ values. Allocating those here immediately improves the chance
+ of the structure |a->tree[0][0][x]| being close together in actual memory locations. We could
+ save less for type 0 stacks.
+
+*/
+
+sa_tree sa_new_tree(int size, int bytes, sa_tree_item dflt)
+{
+ sa_tree_head *a;
+ a = (sa_tree_head *) lmt_memory_malloc(sizeof(sa_tree_head));
+ a->dflt = dflt;
+ a->stack = NULL;
+ a->tree = (sa_tree_item ***) sa_calloc_array(sizeof(sa_tree_item **), LMT_SA_HIGHPART);
+ a->tree[0] = (sa_tree_item **) sa_calloc_array(sizeof(sa_tree_item *), LMT_SA_MIDPART);
+ a->sa_stack_size = size;
+ a->sa_stack_step = size;
+ a->bytes = bytes;
+ a->sa_stack_ptr = 0;
+ return (sa_tree) a;
+}
+
+void sa_restore_stack(sa_tree head, int gl)
+{
+ if (head->stack) {
+ sa_stack_item st;
+ while (head->sa_stack_ptr > 0 && abs(head->stack[head->sa_stack_ptr].level) >= gl) {
+ st = head->stack[head->sa_stack_ptr];
+ if (st.level > 0) {
+ int code = st.code;
+ switch (head->bytes) {
+ case 1:
+ {
+ int c = code % 4;
+ head->tree[LMT_SA_H_PART(code)][LMT_SA_M_PART(code)][LMT_SA_L_PART(code)/4].uchar_value[c] = st.value_1.uchar_value[c];
+ }
+ break;
+ case 2:
+ {
+ int c = code % 2;
+ head->tree[LMT_SA_H_PART(code)][LMT_SA_M_PART(code)][LMT_SA_L_PART(code)/2].ushort_value[c] = st.value_1.ushort_value[c];
+ }
+ break;
+ case 4:
+ {
+ head->tree[LMT_SA_H_PART(code)][LMT_SA_M_PART(code)][LMT_SA_L_PART(code)] = st.value_1;
+ }
+ break;
+ case 8:
+ {
+ int l = 2*LMT_SA_L_PART(code);
+ head->tree[LMT_SA_H_PART(code)][LMT_SA_M_PART(code)][l] = st.value_1;
+ head->tree[LMT_SA_H_PART(code)][LMT_SA_M_PART(code)][l+1] = st.value_2;
+ }
+ break;
+
+ }
+ }
+ (head->sa_stack_ptr)--;
+ }
+ }
+}
+
+void sa_dump_tree(dumpstream f, sa_tree a)
+{
+ dump_int(f, a->sa_stack_step);
+ dump_int(f, a->dflt.int_value);
+ if (a->tree) {
+ int bytes = a->bytes;
+ /*tex A marker: */
+ dump_via_int(f, 1);
+ dump_int(f, bytes);
+ for (int h = 0; h < LMT_SA_HIGHPART; h++) {
+ if (a->tree[h]) {
+ dump_via_int(f, 1);
+ for (int m = 0; m < LMT_SA_MIDPART; m++) {
+ if (a->tree[h][m]) {
+ /*tex
+ It happens a lot that the value is the same as the index, for instance
+ with case mappings.
+
+ Using mode 3 for the case where all values are the default value saves
+ In \CONTEXT\ some 128 * 5 dumps which is not worth the trouble but it
+ is neat anyway.
+
+ 1 : values are kind of unique
+ 2 : for all values : value == self
+ 3 : for all values : value == default
+
+ Actually, we could decide not to save at all in the third mode because
+ unset equals default.
+ */
+ int mode = 1;
+ if (bytes != 8) {
+ /*tex Check for default values. */
+ int slide = bytes == 1 ? LMT_SA_LOWPART/4 : (bytes == 2 ? LMT_SA_LOWPART/2 : LMT_SA_LOWPART);
+ mode = 3;
+ for (int l = 0; l < slide; l++) {
+ if (a->tree[h][m][l].uint_value != a->dflt.uint_value) {
+ mode = 1;
+ break;
+ }
+ }
+ }
+ if (mode == 1 && bytes == 4) {
+ /*tex Check for identity values. */
+ unsigned int hm = h * LMT_SA_HIGHPART + m * LMT_SA_MIDPART * LMT_SA_LOWPART ;
+ mode = 2;
+ for (int l = 0; l < LMT_SA_LOWPART; l++) {
+ if (a->tree[h][m][l].uint_value == hm) {
+ hm++;
+ } else {
+ mode = 1;
+ break;
+ }
+ }
+ }
+ dump_int(f, mode);
+ if (mode == 1) {
+ /*tex
+ We have unique values. By avoiding this branch we save some 85 Kb
+ on the \CONTEXT\ format. We could actually save this property in
+ the tree but there is not that much to gain.
+ */
+ int slide = LMT_SA_LOWPART;
+ switch (bytes) {
+ case 1: slide = LMT_SA_LOWPART/4; break;
+ case 2: slide = LMT_SA_LOWPART/2; break;
+ case 4: slide = LMT_SA_LOWPART ; break;
+ case 8: slide = 2*LMT_SA_LOWPART ; break;
+ }
+ dump_items(f, &a->tree[h][m][0], sizeof(sa_tree_item), slide);
+ } else {
+ /*tex We have a self value or defaults. */
+ }
+ } else {
+ dump_via_int(f, 0);
+ }
+ }
+ } else {
+ dump_via_int(f, 0);
+ }
+ }
+ } else {
+ /*tex A marker: */
+ dump_via_int(f, 0);
+ }
+}
+
+sa_tree sa_undump_tree(dumpstream f)
+{
+ int x;
+ sa_tree a = (sa_tree) sa_malloc_array(sizeof(sa_tree_head), 1);
+ undump_int(f,a->sa_stack_step);
+ undump_int(f,a->dflt.int_value);
+ a->sa_stack_size = a->sa_stack_step;
+ a->stack = sa_calloc_array(sizeof(sa_stack_item), a->sa_stack_size);
+ a->sa_stack_ptr = 0;
+ a->tree = NULL;
+ /*tex The marker: */
+ undump_int(f, x);
+ if (x != 0) {
+ int bytes, mode;
+ a->tree = (sa_tree_item ***) sa_calloc_array(sizeof(void *), LMT_SA_HIGHPART);
+ undump_int(f, bytes);
+ a->bytes = bytes;
+ for (int h = 0; h < LMT_SA_HIGHPART; h++) {
+ undump_int(f, mode); /* more a trigger */
+ if (mode > 0) {
+ a->tree[h] = (sa_tree_item **) sa_calloc_array(sizeof(void *), LMT_SA_MIDPART);
+ for (int m = 0; m < LMT_SA_MIDPART; m++) {
+ undump_int(f, mode);
+ switch (mode) {
+ case 1:
+ /*tex
+ We have a unique values.
+ */
+ {
+ int slide = LMT_SA_LOWPART;
+ switch (bytes) {
+ case 1: slide = LMT_SA_LOWPART/4; break;
+ case 2: slide = LMT_SA_LOWPART/2; break;
+ case 4: slide = LMT_SA_LOWPART ; break;
+ case 8: slide = 2*LMT_SA_LOWPART ; break;
+ }
+ a->tree[h][m] = sa_malloc_array(sizeof(sa_tree_item), slide);
+ undump_items(f, &a->tree[h][m][0], sizeof(sa_tree_item), slide);
+ }
+ break;
+ case 2:
+ /*tex
+ We have a self value. We only have this when we have integers. Other
+ cases are math anyway, so not much to gain.
+ */
+ {
+ if (bytes == 4) {
+ int hm = h * 128 * LMT_SA_HIGHPART + m * LMT_SA_MIDPART;
+ a->tree[h][m] = sa_malloc_array(sizeof(sa_tree_item), LMT_SA_LOWPART);
+ for (int l = 0; l < LMT_SA_LOWPART; l++) {
+ a->tree[h][m][l].int_value = hm;
+ hm++;
+ }
+ } else {
+ printf("\nfatal format error, mode %i, bytes %i\n", mode, bytes);
+ }
+ }
+ break;
+ case 3:
+ /*tex
+ We have all default values. so no need to set them. In fact, we
+ cannot even end up here.
+ */
+ break;
+ default:
+ /*tex
+ We have no values set.
+ */
+ break;
+ }
+ }
+ }
+ }
+ }
+ return a;
+}
diff --git a/source/luametatex/source/utilities/auxsparsearray.h b/source/luametatex/source/utilities/auxsparsearray.h
new file mode 100644
index 000000000..0a4ce20f1
--- /dev/null
+++ b/source/luametatex/source/utilities/auxsparsearray.h
@@ -0,0 +1,212 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_UTILITIES_SPARSEARRAY_H
+# define LMT_UTILITIES_SPARSEARRAY_H
+
+/*tex
+
+ This file originally was called |managed-sa| but becauss it kind of a library and also used in
+ \LUATEX\ it's better to use a different name. In this variant dumping is more sparse (resulting
+ in somewhat smaller format files). This might be backported but only after testing it here for a
+ long time. Of course the principles are the same, it's just extended.
+
+*/
+
+/*tex
+
+ The next two sets of three had better match up exactly, but using bare numbers is easier on the
+ \CCODE\ compiler. Here are some format sizes (for ConTeXt) with different values:
+
+ 64 : 17562942
+ 128 : 17548150 <= best value
+ 256 : 17681398
+
+*/
+
+# define LMT_SA_HIGHPART 128
+# define LMT_SA_MIDPART 128
+# define LMT_SA_LOWPART 128
+
+# define LMT_SA_H_PART(a) (((a)>>14)&127)
+# define LMT_SA_M_PART(a) (((a)>> 7)&127)
+# define LMT_SA_L_PART(a) ( (a) &127)
+
+/*tex
+
+ In the early days of \LUATEX\ we had just simple items, all 32 bit values. Then we put the
+ delcodes in trees too which saved memory and format size but it introduced 32 bit slack in all
+ the other code arrays. We then also had to dump selectively, but it was no big deal. Eventually,
+ once it became clear that the concepts would not change a variant was made for \LUAMETATEX: we
+ just use a two times larger lower array when we have delimiters. This saves some memory. The
+ price we pay is that a stack entry now has two values but that is not really an issue.
+
+ By packing the math code values we loose the option to store an active state but that's no big
+ deal.
+
+ todo: consider simple char array for catcodes.
+
+ The code here is somewhat messy because we generalized it a bit. Maybe I'll redo it some day.
+
+ */
+
+typedef struct sparse_state_info {
+ memory_data sparse_data;
+} sparse_state_info;
+
+extern sparse_state_info lmt_sparse_state;
+
+/*
+typedef struct sa_mathblob {
+ unsigned int character_value:21;
+ unsigned int class_value:3;
+ unsigned int family_value:8;
+} sa_mathblob;
+*/
+
+typedef struct sa_mathblob {
+ unsigned int class_value:math_class_bits;
+ unsigned int family_value:math_family_bits;
+ unsigned int character_value:math_character_bits;
+} sa_mathblob;
+
+typedef struct sa_mathspec {
+ unsigned short properties;
+ unsigned short group;
+ unsigned int index;
+} sa_mathspec;
+
+typedef struct packed_math_character {
+ union {
+ sa_mathblob sa_value;
+ unsigned ui_value;
+ };
+} packed_math_character;
+
+typedef union sa_tree_item {
+ unsigned int uint_value;
+ int int_value;
+ sa_mathblob math_code_value;
+ sa_mathspec math_spec_value;
+ unsigned short ushort_value[2];
+ unsigned char uchar_value[4];
+} sa_tree_item;
+
+typedef struct sa_stack_item {
+ int code;
+ int level;
+ sa_tree_item value_1;
+ sa_tree_item value_2;
+} sa_stack_item;
+
+typedef struct sa_tree_head {
+ int sa_stack_size; /*tex initial stack size */
+ int sa_stack_step; /*tex increment stack step */
+ int sa_stack_ptr; /*tex current stack point */
+ sa_tree_item dflt; /*tex default item value */
+ sa_tree_item ***tree; /*tex item tree head */
+ sa_stack_item *stack; /*tex stack tree head */
+ int bytes; /*tex the number of items per entry */
+ int padding;
+} sa_tree_head;
+
+typedef sa_tree_head *sa_tree;
+
+extern int sa_get_item_1 (const sa_tree head, int n);
+extern int sa_get_item_2 (const sa_tree head, int n);
+extern sa_tree_item sa_get_item_4 (const sa_tree head, int n);
+extern sa_tree_item sa_get_item_8 (const sa_tree head, int n, sa_tree_item * v2);
+extern void sa_set_item_1 (sa_tree head, int n, int v, int gl);
+extern void sa_set_item_2 (sa_tree head, int n, int v, int gl);
+extern void sa_set_item_4 (sa_tree head, int n, sa_tree_item v, int gl);
+extern void sa_set_item_8 (sa_tree head, int n, sa_tree_item v1, sa_tree_item v2, int gl);
+/* void sa_rawset_item_1 (sa_tree head, int n, sa_tree_item v); */
+/* void sa_rawset_item_2 (sa_tree head, int n, sa_tree_item v); */
+/* void sa_rawset_item_4 (sa_tree head, int n, sa_tree_item v); */
+/* void sa_rawset_item_8 (sa_tree head, int n, sa_tree_item v1, sa_tree_item v2); */
+extern sa_tree sa_new_tree (int size, int bytes, sa_tree_item dflt);
+extern sa_tree sa_copy_tree (sa_tree head);
+extern void sa_destroy_tree (sa_tree head);
+extern void sa_dump_tree (dumpstream f, sa_tree a);
+extern sa_tree sa_undump_tree (dumpstream f);
+extern void sa_restore_stack (sa_tree a, int gl);
+extern void sa_clear_stack (sa_tree a);
+
+extern void sa_set_item_n (const sa_tree head, int n, int v, int gl);
+extern int sa_get_item_n (const sa_tree head, int n);
+
+inline static halfword sa_return_item_1(sa_tree head, halfword n)
+{
+ if (head->tree) {
+ int hp = LMT_SA_H_PART(n);
+ if (head->tree[hp]) {
+ int mp = LMT_SA_M_PART(n);
+ if (head->tree[hp][mp]) {
+ return (halfword) head->tree[hp][mp][LMT_SA_L_PART(n)/4].uchar_value[n%4];
+ }
+ }
+ }
+ return (halfword) head->dflt.uchar_value[0];
+}
+
+inline static halfword sa_return_item_2(sa_tree head, halfword n)
+{
+ if (head->tree) {
+ int hp = LMT_SA_H_PART(n);
+ if (head->tree[hp]) {
+ int mp = LMT_SA_M_PART(n);
+ if (head->tree[hp][mp]) {
+ return (halfword) head->tree[hp][mp][LMT_SA_L_PART(n)/2].ushort_value[n%2];
+ }
+ }
+ }
+ return (halfword) head->dflt.ushort_value[0];
+}
+
+inline static halfword sa_return_item_4(sa_tree head, halfword n)
+{
+ if (head->tree) {
+ int hp = LMT_SA_H_PART(n);
+ if (head->tree[hp]) {
+ int mp = LMT_SA_M_PART(n);
+ if (head->tree[hp][mp]) {
+ return (halfword) head->tree[hp][mp][LMT_SA_L_PART(n)].int_value;
+ }
+ }
+ }
+ return (halfword) head->dflt.int_value;
+}
+
+inline static void sa_rawset_item_1(sa_tree head, halfword n, unsigned char v)
+{
+ head->tree[LMT_SA_H_PART(n)][LMT_SA_M_PART(n)][LMT_SA_L_PART(n)/4].uchar_value[n%4] = v;
+}
+
+inline static void sa_rawset_item_2(sa_tree head, halfword n, unsigned short v)
+{
+ head->tree[LMT_SA_H_PART(n)][LMT_SA_M_PART(n)][LMT_SA_L_PART(n)/2].ushort_value[n%2] = v;
+}
+
+inline static void sa_rawset_item_4(sa_tree head, halfword n, sa_tree_item v)
+{
+ head->tree[LMT_SA_H_PART(n)][LMT_SA_M_PART(n)][LMT_SA_L_PART(n)] = v;
+}
+
+inline static void sa_rawset_item_8(sa_tree head, halfword n, sa_tree_item v1, sa_tree_item v2)
+{
+ sa_tree_item *low = head->tree[LMT_SA_H_PART(n)][LMT_SA_M_PART(n)];
+ int l = 2*LMT_SA_L_PART(n);
+ low[l] = v1;
+ low[l+1] = v2;
+}
+
+// inline them
+
+extern void *sa_malloc_array (int recordsize, int size);
+extern void *sa_realloc_array (void *p, int recordsize, int size, int step);
+extern void *sa_calloc_array (int recordsize, int size);
+extern void *sa_free_array (void *p);
+extern void sa_wipe_array (void *head, int recordsize, int size);
+
+# endif
diff --git a/source/luametatex/source/utilities/auxsystem.c b/source/luametatex/source/utilities/auxsystem.c
new file mode 100644
index 000000000..d3d818a85
--- /dev/null
+++ b/source/luametatex/source/utilities/auxsystem.c
@@ -0,0 +1,155 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex This code is taken from the \LUA\ socket library: |timeout.c|. */
+
+# ifdef _WIN32
+
+ double aux_get_current_time(void) {
+ FILETIME ft;
+ double t;
+ GetSystemTimeAsFileTime(&ft);
+ /* Windows file time (time since January 1, 1601 (UTC)) */
+ t = ft.dwLowDateTime/1.0e7 + ft.dwHighDateTime*(4294967296.0/1.0e7);
+ /* convert to Unix Epoch time (time since January 1, 1970 (UTC)) */
+ return (t - 11644473600.0);
+ }
+
+# else
+
+ double aux_get_current_time(void) {
+ struct timeval v;
+ gettimeofday(&v, (struct timezone *) NULL);
+ /* Unix Epoch time (time since January 1, 1970 (UTC)) */
+ return v.tv_sec + v.tv_usec/1.0e6;
+ }
+
+# endif
+
+void aux_set_run_time(void)
+{
+ lmt_main_state.start_time = aux_get_current_time();
+}
+
+double aux_get_run_time(void)
+{
+ return aux_get_current_time() - lmt_main_state.start_time;
+}
+
+/*tex
+
+ In order to avoid all kind of time code in the backend code we use a function. The start time
+ can be overloaded in several ways:
+
+ \startitemize[n]
+ \startitem
+ By setting the environmment variable |SOURCE_DATE_EPOCH|. This will influence the \PDF\
+ timestamp and \PDF\ id that is derived from the time. This variable is consulted when
+ the kpse library is enabled which is analogue to other properties.
+ \stopitem
+ \startitem
+ By setting the |texconfig.start_time| variable (as with other variables we use the
+ internal name there). This has the same effect as (1) and is provided for when kpse is
+ not used to set these variables or when an overloaded is wanted. This is analogue to
+ other properties.
+ \stopitem
+ \stopitemize
+
+ To some extend a cleaner solution would be to have a flag that disables all variable data in
+ one go (like filenames and so) but we just follow the method implemented in pdftex where
+ primitives are used to disable it.
+
+*/
+
+static int start_time = -1; /*tex This will move to one of the structs. */
+
+static int aux_get_start_time(void) {
+ if (start_time < 0) {
+ start_time = (int) time((time_t *) NULL);
+ }
+ return start_time;
+}
+
+/*tex
+
+ This one is used to fetch a value from texconfig which can also be used to set properties.
+ This might come in handy when one has other ways to get date info in the \PDF\ file.
+
+*/
+
+void aux_set_start_time(int s) {
+ if (s >= 0) {
+ start_time = s ;
+ }
+}
+
+/*tex
+
+ All our interrupt handler has to do is set \TEX's global variable |interrupt|; then they
+ will do everything needed.
+
+*/
+
+# ifdef _WIN32
+
+ /* Win32 doesn't set SIGINT ... */
+
+ static BOOL WINAPI catch_interrupt(DWORD arg)
+ {
+ switch (arg) {
+ case CTRL_C_EVENT:
+ case CTRL_BREAK_EVENT:
+ aux_quit_the_program();
+ return 1;
+ default:
+ /*tex No need to set interrupt as we are exiting anyway. */
+ return 0;
+ }
+ }
+
+ void aux_set_interrupt_handler(void)
+ {
+ SetConsoleCtrlHandler(catch_interrupt, TRUE);
+ }
+
+# else
+
+ /* static RETSIGTYPE catch_interrupt(int arg) */
+
+ static void catch_interrupt(int arg)
+ {
+ (void) arg;
+ aux_quit_the_program();
+ (void) signal(SIGINT, catch_interrupt);
+ }
+
+ void aux_set_interrupt_handler(void)
+ {
+ /* RETSIGTYPE (*old_handler) (int); */
+ void (*old_handler) (int);
+ old_handler = signal(SIGINT, catch_interrupt);
+ if (old_handler != SIG_DFL) {
+ signal(SIGINT, old_handler);
+ }
+ }
+
+# endif
+
+void aux_get_date_and_time(int *minutes, int *day, int *month, int *year, int *utc)
+{
+ time_t myclock = aux_get_start_time();
+ struct tm *tmptr ;
+ if (*utc) {
+ tmptr = gmtime(&myclock);
+ } else {
+ tmptr = localtime(&myclock);
+ }
+ *minutes = tmptr->tm_hour * 60 + tmptr->tm_min;
+ *day = tmptr->tm_mday;
+ *month = tmptr->tm_mon + 1;
+ *year = tmptr->tm_year + 1900;
+ /* set_interrupt_handler(); */
+}
diff --git a/source/luametatex/source/utilities/auxsystem.h b/source/luametatex/source/utilities/auxsystem.h
new file mode 100644
index 000000000..5b9a5bad0
--- /dev/null
+++ b/source/luametatex/source/utilities/auxsystem.h
@@ -0,0 +1,17 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_UTILITIES_SYSTEM_H
+# define LMT_UTILITIES_SYSTEM_H
+
+extern void aux_quit_the_program (void);
+
+extern void aux_set_start_time (int);
+extern void aux_set_interrupt_handler (void);
+extern void aux_get_date_and_time (int *minutes, int *day, int *month, int *year, int *utc);
+extern double aux_get_current_time (void);
+extern void aux_set_run_time (void);
+extern double aux_get_run_time (void);
+
+# endif
diff --git a/source/luametatex/source/utilities/auxunistring.c b/source/luametatex/source/utilities/auxunistring.c
new file mode 100644
index 000000000..e95854a93
--- /dev/null
+++ b/source/luametatex/source/utilities/auxunistring.c
@@ -0,0 +1,158 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "luametatex.h"
+
+/*tex
+
+ The 5- and 6-byte UTF-8 sequences generate integers that are outside of the valid UCS range,
+ and therefore unsupported. We recover from an error with |0xFFFD|.
+
+*/
+
+unsigned aux_str2uni(const unsigned char *k)
+{
+ const unsigned char *text = k;
+ int ch = *text++;
+ if (ch < 0x80) {
+ return (unsigned) ch;
+ } else if (ch <= 0xbf) {
+ return 0xFFFD;
+ } else if (ch <= 0xdf) {
+ if (text[0] >= 0x80 && text[0] < 0xc0) {
+ return (unsigned) (((ch & 0x1f) << 6) | (text[0] & 0x3f));
+ }
+ } else if (ch <= 0xef) {
+ if (text[0] >= 0x80 && text[0] < 0xc0 && text[1] >= 0x80 && text[1] < 0xc0) {
+ return (unsigned) (((ch & 0xf) << 12) | ((text[0] & 0x3f) << 6) | (text[1] & 0x3f));
+ }
+ } else if (ch <= 0xf7) {
+ if (text[0] < 0x80 || text[1] < 0x80 || text[2] < 0x80 ||
+ text[0] >= 0xc0 || text[1] >= 0xc0 || text[2] >= 0xc0) {
+ return 0xFFFD;
+ } else {
+ int w1 = (((ch & 0x7) << 2) | ((text[0] & 0x30) >> 4)) - 1;
+ int w2 = ((text[1] & 0xf) << 6) | (text[2] & 0x3f);
+ w1 = (w1 << 6) | ((text[0] & 0xf) << 2) | ((text[1] & 0x30) >> 4);
+ return (unsigned) (w1 * 0x400 + w2 + 0x10000);
+ }
+ }
+ return 0xFFFD;
+}
+
+unsigned char *aux_uni2str(unsigned unic)
+{
+ unsigned char *buf = lmt_memory_malloc(5);
+ if (buf) {
+ if (unic < 0x80) {
+ buf[0] = (unsigned char) unic;
+ buf[1] = '\0';
+ } else if (unic < 0x800) {
+ buf[0] = (unsigned char) (0xc0 | (unic >> 6));
+ buf[1] = (unsigned char) (0x80 | (unic & 0x3f));
+ buf[2] = '\0';
+ } else if (unic >= 0x110000) {
+ buf[0] = (unsigned char) (unic - 0x110000);
+ buf[1] = '\0';
+ } else if (unic < 0x10000) {
+ buf[0] = (unsigned char) (0xe0 | (unic >> 12));
+ buf[1] = (unsigned char) (0x80 | ((unic >> 6) & 0x3f));
+ buf[2] = (unsigned char) (0x80 | (unic & 0x3f));
+ buf[3] = '\0';
+ } else {
+ unic -= 0x10000;
+ int u = (int) (((unic & 0xf0000) >> 16) + 1);
+ buf[0] = (unsigned char) (0xf0 | (u >> 2));
+ buf[1] = (unsigned char) (0x80 | ((u & 3) << 4) | ((unic & 0x0f000) >> 12));
+ buf[2] = (unsigned char) (0x80 | ((unic & 0x00fc0) >> 6));
+ buf[3] = (unsigned char) (0x80 | (unic & 0x0003f));
+ buf[4] = '\0';
+ }
+ }
+ return buf;
+}
+
+/*tex
+
+ Function |buffer_to_unichar| converts a sequence of bytes in the |buffer| into a \UNICODE\
+ character value. It does not check for overflow of the |buffer|, but it is careful to check
+ the validity of the \UTF-8 encoding. For historical reasons all these small helpers look a bit
+ different but that has a certain charm so we keep it.
+
+*/
+
+char *aux_uni2string(char *utf8_text, unsigned unic)
+{
+ /*tex Increment and deposit character: */
+ if (unic <= 0x7f) {
+ *utf8_text++ = (char) unic;
+ } else if (unic <= 0x7ff) {
+ *utf8_text++ = (char) (0xc0 | (unic >> 6));
+ *utf8_text++ = (char) (0x80 | (unic & 0x3f));
+ } else if (unic <= 0xffff) {
+ *utf8_text++ = (char) (0xe0 | (unic >> 12));
+ *utf8_text++ = (char) (0x80 | ((unic >> 6) & 0x3f));
+ *utf8_text++ = (char) (0x80 | (unic & 0x3f));
+ } else if (unic < 0x110000) {
+ unic -= 0x10000;
+ unsigned u = ((unic & 0xf0000) >> 16) + 1;
+ *utf8_text++ = (char) (0xf0 | (u >> 2));
+ *utf8_text++ = (char) (0x80 | ((u & 3) << 4) | ((unic & 0x0f000) >> 12));
+ *utf8_text++ = (char) (0x80 | ((unic & 0x00fc0) >> 6));
+ *utf8_text++ = (char) (0x80 | (unic & 0x0003f));
+ }
+ return (utf8_text);
+}
+
+unsigned aux_splitutf2uni(unsigned int *ubuf, const char *utf8buf)
+{
+ int len = (int) strlen(utf8buf);
+ unsigned int *upt = ubuf;
+ unsigned int *uend = ubuf + len;
+ const unsigned char *pt = (const unsigned char *) utf8buf;
+ const unsigned char *end = pt + len;
+ while (pt < end && *pt != '\0' && upt < uend) {
+ if (*pt <= 127) {
+ *upt = *pt++;
+ } else if (*pt <= 0xdf) {
+ *upt = (unsigned int) (((*pt & 0x1f) << 6) | (pt[1] & 0x3f));
+ pt += 2;
+ } else if (*pt <= 0xef) {
+ *upt = (unsigned int) (((*pt & 0xf) << 12) | ((pt[1] & 0x3f) << 6) | (pt[2] & 0x3f));
+ pt += 3;
+ } else {
+ int w1 = (((*pt & 0x7) << 2) | ((pt[1] & 0x30) >> 4)) - 1;
+ int w2 = ((pt[2] & 0xf) << 6) | (pt[3] & 0x3f);
+ w1 = (w1 << 6) | ((pt[1] & 0xf) << 2) | ((pt[2] & 0x30) >> 4);
+ *upt = (unsigned int) (w1 * 0x400 + w2 + 0x10000);
+ pt += 4;
+ }
+ ++upt;
+ }
+ *upt = '\0';
+ return (unsigned int) (upt - ubuf);
+}
+
+size_t aux_utf8len(const char *text, size_t size)
+{
+ size_t ls = size;
+ size_t ind = 0;
+ size_t num = 0;
+ while (ind < ls) {
+ unsigned char i = (unsigned char) *(text + ind);
+ if (i < 0x80) {
+ ind += 1;
+ } else if (i >= 0xF0) {
+ ind += 4;
+ } else if (i >= 0xE0) {
+ ind += 3;
+ } else if (i >= 0xC0) {
+ ind += 2;
+ } else {
+ ind += 1;
+ }
+ num += 1;
+ }
+ return num;
+}
diff --git a/source/luametatex/source/utilities/auxunistring.h b/source/luametatex/source/utilities/auxunistring.h
new file mode 100644
index 000000000..1e6a997b9
--- /dev/null
+++ b/source/luametatex/source/utilities/auxunistring.h
@@ -0,0 +1,19 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# ifndef LMT_UTILITIES_UNISTRING_H
+# define LMT_UTILITIES_UNISTRING_H
+
+extern unsigned char *aux_uni2str (unsigned);
+extern unsigned aux_str2uni (const unsigned char *);
+extern char *aux_uni2string (char *utf8_text, unsigned ch);
+extern unsigned aux_splitutf2uni (unsigned int *ubuf, const char *utf8buf);
+extern size_t aux_utf8len (const char *text, size_t size);
+
+# define is_utf8_follow(a) (a >= 0x80 && a < 0xC0)
+# define utf8_size(a) (a > 0xFFFF ? 4 : (a > 0x7FF ? 3 : (a > 0x7F ? 2 : 1)))
+# define buffer_to_unichar(k) aux_str2uni((const unsigned char *)(lmt_fileio_state.io_buffer+k))
+
+# endif
+
diff --git a/source/luametatex/source/utilities/auxzlib.c b/source/luametatex/source/utilities/auxzlib.c
new file mode 100644
index 000000000..7444b5944
--- /dev/null
+++ b/source/luametatex/source/utilities/auxzlib.c
@@ -0,0 +1,18 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+# include "auxzlib.h"
+# include "auxmemory.h"
+
+void *lmt_zlib_alloc(void *opaque, size_t items, size_t size)
+{
+ (void) opaque;
+ return lmt_memory_malloc((size_t) items * size);
+}
+
+void lmt_zlib_free(void *opaque, void *p)
+{
+ (void) opaque;
+ lmt_memory_free(p);
+}
diff --git a/source/luametatex/source/utilities/auxzlib.h b/source/luametatex/source/utilities/auxzlib.h
new file mode 100644
index 000000000..7dfaa058a
--- /dev/null
+++ b/source/luametatex/source/utilities/auxzlib.h
@@ -0,0 +1,24 @@
+/*
+ See license.txt in the root of this project.
+*/
+
+/*tex
+
+ This module deals with the memory allocation that plugs in the zipper. Although we could just
+ use the defaule malloc, it's nicer to use the replacement, when it is enabled. A previous
+ version had th eoption to choose between zlib and miniz but in 2021 we switched to the later
+ so the former is now in the attic.
+
+*/
+
+# ifndef LMT_UTILITIES_ZLIB_H
+# define LMT_UTILITIES_ZLIB_H
+
+# include "../libraries/miniz/miniz.h"
+
+/*tex These plug in the lua library as well as pplib's flate hander. */
+
+extern void *lmt_zlib_alloc (void *opaque, size_t items, size_t size);
+extern void lmt_zlib_free (void *opaque, void *p);
+
+# endif
diff --git a/source/luametatex/tools/mp.patch.lua b/source/luametatex/tools/mp.patch.lua
new file mode 100644
index 000000000..116f4f0a7
--- /dev/null
+++ b/source/luametatex/tools/mp.patch.lua
@@ -0,0 +1,66 @@
+local gsub = string.gsub
+
+return {
+
+ action = function(data,report)
+
+ if true then
+ -- we have no patches
+ return data
+ end
+
+ if not report then
+ report = print -- let it look bad
+ end
+
+ local n, m = 0, 0
+
+ statistics.starttiming()
+
+ local function okay(i,str)
+ n = n + 1
+ report("patch %02i ok : %s",i,str)
+ end
+
+ -- not used
+
+ -- data = gsub(data,"(#include <zlib%.h>)",function(s)
+ -- okay(1,"zlib header file commented")
+ -- return "/* " .. s .. "*/"
+ -- end,1)
+ --
+ -- data = gsub(data,"(#include <png%.h>)",function(s)
+ -- okay(2,"png header file commented")
+ -- return "/* " .. s .. "*/"
+ -- end,1)
+
+ -- patched
+
+ -- data = gsub(data,"calloc%((%w+),%s*(%w+)%)",function(n,m)
+ -- okay(3,"calloc replaced by malloc")
+ -- return "malloc(" .. n .. "*" .. m .. ")"
+ -- end,1)
+
+ -- not used
+
+ -- data = gsub(data,"(mp_show_library_versions%s*%(%s*%w+%s*%)%s*)%b{}",function(s)
+ -- okay(4,"reporting library versions removed")
+ -- return s .. "\n{\n}"
+ -- end,1)
+
+ -- data = gsub(data,"#if INTEGER_MAX == LONG_MAX",function(s)
+ -- okay(5,"fix INTEGER_TYPE")
+ -- return "#if INTEGER_TYPE == long"
+ -- end,1)
+
+ -- done
+
+ statistics.stoptiming()
+
+ report("patching time: %s", statistics.elapsedtime())
+ report("patches left : %i", m - n)
+
+ return data
+ end
+
+}
diff --git a/source/luametatex/tools/mtx-wtoc.lua b/source/luametatex/tools/mtx-wtoc.lua
new file mode 100644
index 000000000..a28ff0f2d
--- /dev/null
+++ b/source/luametatex/tools/mtx-wtoc.lua
@@ -0,0 +1,667 @@
+if not modules then modules = { } end modules ['mtx-wtoc'] = {
+ version = 1.001,
+ comment = "a hack to avoid a dependency on cweb / web2c",
+ author = "Hans Hagen, PRAGMA-ADE, Hasselt NL",
+ copyright = "PRAGMA ADE / ConTeXt Development Team",
+ license = "see context related readme files"
+}
+
+-- This is a hack. When I have time and motivation I'll make a better version. Sorry
+-- for the mess. It's not an example of proper coding. It's also not that efficient.
+-- It is not general purpose too, just a helper for luametatex in order to not be
+-- dependent on installing the cweb infrastructure (which normally gets compiled as
+-- part of the complex tl build). Okay, we do have a dependency on luametatex as lua
+-- runner although this script can be easily turned into a pure lua variant (not
+-- needing mtxrun helpers). If really needed one could build luametatex without
+-- mplib and then do the first bootstrap, but there's always a c to start with
+-- anyway; only when mp.w cum suis get updated we need to convert.
+--
+-- The w files get converted to into in .25 seconds which is not that bad.
+
+-- @, @/ @| @# @+ @; @[ @]
+-- @.text @>(monospaced) | @:text @>(macro driven) | @= verbose@> | @! underlined @>| @t text @> (hbox) | @q ignored @>
+-- @^index@>
+-- @f text renderclass
+-- @s idem | @p idem | @& strip (spaces before) | @h
+-- @'char' (ascii code)
+-- @l nonascii
+-- @x @y @z changefile | @i webfile
+-- @* title.
+-- @ explanation (not ok ... stops at outer @
+--
+-- The comment option doesn't really work so one needs to do some manual work
+-- afterwards but I'll only use that when we move away from w files.
+
+local next = next
+local lower, find, gsub = string.lower, string.find, string.gsub
+local topattern = string.topattern
+local striplines = utilities.strings.striplines
+local concat = table.concat
+
+local P, R, S, C, Cs, Ct, Cc = lpeg.P, lpeg.R, lpeg.S, lpeg.C, lpeg.Cs, lpeg.Ct, lpeg.Cc
+local lpegmatch, lpegpatterns = lpeg.match, lpeg.patterns
+
+local newline = lpegpatterns.newline
+local space = lpegpatterns.space -- S(" \n\r\t\f\v")
+local restofline = (1-newline)^0
+
+local cweb = { }
+
+-- We have several ways to look at and filter the data so we have different
+-- lpegs. The output looks ugly but that is the whole idea I think as cweb.
+
+local report = logs.reporter("cweb to normal c")
+local verbose = false
+-- local verbose = true
+
+-- common
+
+local p_beginofweb = P("@")
+local p_endofweb = P("@>")
+local p_noweb = (1-p_endofweb)^1
+local p_squote = P("'")
+local p_period = P(".")
+local p_noperiod = (1-p_period)^1
+local p_spacing = space^1
+local p_nospacing = (1-space)^1
+local p_equal = P("=")
+local p_noequal = (1-p_equal)^1
+local p_rest = P(1)
+local p_escape = p_beginofweb * p_beginofweb
+local c_unescape = p_escape / "@"
+local p_structure = p_beginofweb * (S("*dc \t\n\r"))
+local p_content = (p_escape + (1 - p_structure))^1
+local c_noweb = C(p_noweb)
+local c_content = C(p_content)
+local c_nospacing = C(p_nospacing)
+local c_noperiod = C(p_noperiod)
+
+local function clean(s)
+ s = lower(s)
+ s = gsub(s,"%s+"," ")
+ s = gsub(s,"%s+$","")
+ s = gsub(s,"%s*%.%.%.$","...")
+ return s
+end
+
+local cleanup do
+
+ local p_ignore_1 = S(",/|#+;[]sp&")
+ local p_ignore_2 = S("^.:=!tq") * p_noweb * p_endofweb
+ local p_ignore_3 = S("f") * p_spacing * p_nospacing * p_spacing * p_nospacing
+ local p_ignore_4 = p_squote * (1-p_squote)^0 * p_squote
+ local p_ignore_5 = S("l") * p_spacing * p_nospacing
+
+ local p_replace_1 = P("h") / "\n@<header goes here@>\n"
+ local p_replace_2 = (P("#") * space^0) / "\n"
+
+ local p_strip_1 = (newline * space^1) / "\n"
+
+ local p_whatever = (
+ p_beginofweb / ""
+ * (
+ p_replace_1
+ + p_replace_2
+ + Cs(
+ p_ignore_1
+ + p_ignore_2
+ + p_ignore_3
+ + p_ignore_4
+ + p_ignore_5
+ ) / ""
+ )
+ )
+
+ local p_whatever =
+ (newline * space^1) / ""
+ * p_whatever
+ * (space^0 * newline) / "\n"
+ + p_whatever
+
+ local pattern = Cs ( (
+ p_escape
+ + p_whatever
+ + p_rest
+ )^1 )
+
+ cleanup = function(s)
+ return lpegmatch(pattern,s)
+ end
+
+end
+
+local finalize do
+
+ -- The reason why we need to strip leading spaces it that compilers complain about this:
+ --
+ -- if (what)
+ -- this;
+ -- that;
+ --
+ -- with the 'that' being confusingly indented. The fact that it has to be mentioned is of
+ -- course a side effect of compact c coding which can introduce 'errors'. Now, this
+ -- 'confusing' indentatoin is a side effect of
+ --
+ -- if (what)
+ -- this;
+ -- @<that@>;
+ --
+ --
+ -- or actually:
+ --
+ -- @<this is what@>;
+ -- this;
+ -- @<that@>;
+ --
+ -- which then lead to the conclusion that @<that@> should not be indented! But ... cweb
+ -- removes all leading spaces in lines, so that obscured the issue. Bad or not? It is
+ -- anyway a very strong argument for careful coding and matbe using some more { } in case
+ -- of snippets because web2c obscures some warnings!
+
+ ----- strip_display = (P("/*") * (1 - P("*/"))^1 * P("*/")) / " "
+ local strip_inline = (P("//") * (1 - newline)^0) / ""
+ local keep_inline = P("//") * space^0 * P("fall through")
+
+ local strip_display = (P("/*") * (1 - P("*/"))^1 * P("*/"))
+
+ strip_display =
+ (newline * space^0 * strip_display * newline) / "\n"
+ + strip_display / " "
+
+ local strip_spaces = (space^1 * newline) / "\n"
+ ----- strip_lines = (space^0 * newline * space^0)^3 / "\n\n"
+ local strip_lines = newline * (space^0 * newline)^3 / "\n\n"
+
+ local strip_empties = newline/"" * newline * space^1 * P("}")
+ + space^2 * P("}") * (newline * space^0 * newline / "\n")
+ + space^2 * R("AZ") * R("AZ","__","09")^1 * P(":") * (space^0 * newline * space^0 * newline / "\n")
+
+ local finalize_0 = Cs((c_unescape + p_rest)^0)
+ local finalize_1 = Cs((strip_display + keep_inline + strip_inline + c_unescape + p_rest)^0)
+ local finalize_2 = Cs((strip_lines + p_rest)^0)
+ local finalize_3 = Cs((c_unescape + strip_spaces + p_rest)^1)
+ local finalize_4 = Cs((c_unescape + strip_empties + p_rest)^1)
+
+ finalize = function(s,keepcomment)
+ s = keepcomment and lpegmatch(finalize_0,s) or lpegmatch(finalize_1,s)
+ s = lpegmatch(finalize_2,s)
+ s = lpegmatch(finalize_3,s)
+ s = lpegmatch(finalize_4,s)
+ -- maybe also empty lines after a LABEL:
+ return s
+ end
+
+end
+
+local function fixdefine(s)
+ s = finalize(s)
+ s = gsub(s,"[\n\r\t ]+$","")
+ s = gsub(s,"[\t ]*[\n\r]+"," \\\n")
+ return s
+end
+
+local function addcomment(c,s)
+ if c ~= "" then
+ c = striplines(c)
+ if find(c,"\n") then
+ c = "\n\n/*\n" .. c .. "\n*/\n\n"
+ else
+ c = "\n\n/* " .. c .. " */\n\n"
+ end
+ return c .. s
+ else
+ return s
+ end
+end
+
+do
+
+ local result = { }
+
+ local p_nothing = Cc("")
+ local p_comment = Cs(((p_beginofweb * (space + newline + P("*")))/"" * c_content)^1)
+ + p_nothing
+
+ local p_title = c_noperiod * (p_period/"")
+ local p_skipspace = newline + space
+ local c_skipspace = p_skipspace / ""
+ local c_title = c_skipspace * p_title * c_skipspace * Cc("\n\n")
+ local c_obeyspace = p_skipspace / "\n\n"
+
+ local p_comment = Cs( (
+ ((p_beginofweb * p_skipspace)/"" * c_content)
+ + ((p_beginofweb * P("*")^1 )/"" * c_title * c_content)
+ + c_obeyspace
+ )^1 )
+ + p_nothing
+
+ local p_define = C(p_beginofweb * P("d")) * Cs(Cc("# define ") * p_content)
+ local p_code = C(p_beginofweb * P("c")) * c_content
+ local p_header = C(p_beginofweb * P("(")) * c_noweb * C(p_endofweb * p_equal) * c_content
+ local p_snippet = C(p_beginofweb * S("<")) * c_noweb * C(p_endofweb * p_equal) * c_content
+ local p_reference = C(p_beginofweb * S("<")) * c_noweb * C(p_endofweb ) * #(1-p_equal)
+ local p_preset = p_beginofweb * S("<") * c_noweb * p_endofweb
+
+ local p_indent = C(space^0)
+ local p_reference = p_indent * p_reference
+
+ local p_c_define = p_comment * p_define
+ local p_c_code = p_comment * p_code
+ local p_c_header = p_comment * p_header
+ local p_c_snippet = p_comment * p_snippet
+
+ local p_n_define = p_nothing * p_define
+ local p_n_code = p_nothing * p_code
+ local p_n_header = p_nothing * p_header
+ local p_n_snippet = p_nothing * p_snippet
+
+ local function preset(tag)
+ tag = clean(tag)
+ if find(tag,"%.%.%.$") then
+ result.dottags[tag] = false
+ end
+ result.alltags[tag] = tag
+ end
+
+ local p_preset = (p_preset / preset + p_rest)^1
+
+ -- we can have both definitions and references with trailing ... and this is imo
+ -- a rather error prone feature: i'd expect the definitions to be the expanded one
+ -- so that references can be shorter ... anyway, we're stuck with this (also with
+ -- inconsistent usage of "...", " ...", "... " and such.
+
+ local function getpresets(data)
+
+ local alltags = result.alltags
+ local dottags = result.dottags
+
+ lpegmatch(p_preset,data)
+
+ local list = table.keys(alltags)
+
+ table.sort(list,function(a,b)
+ a = gsub(a,"%.+$"," ") -- slow
+ b = gsub(b,"%.+$"," ") -- slow
+ return a < b
+ end)
+
+ for k, v in next, dottags do
+ local s = gsub(k,"%.%.%.$","")
+ local p = "^" .. topattern(s,false,"all")
+ for i=1,#list do
+ local a = list[i]
+ if a ~= k and find(a,p) then
+ dottags[k] = true
+ alltags[k] = a
+ end
+ end
+ end
+
+ for k, v in next, alltags do
+ local t = alltags[v]
+ if t then
+ alltags[k] = t
+ end
+ end
+
+ end
+
+ local function addsnippet(c,b,tag,e,s)
+ if c ~= "" then
+ s = addcomment(c,s)
+ end
+ local alltags = result.alltags
+ local snippets = result.snippets
+ local tag = clean(tag)
+ local name = alltags[tag]
+ if snippets[name] then
+ if verbose then
+ report("add snippet : %s",name)
+ end
+ s = snippets[name] .. "\n" .. s
+ else
+ if verbose then
+ report("new snippet : %s",name)
+ end
+ s = "/* snippet: " .. name .. " */\n" .. s
+ end
+ snippets[name] = s
+ result.nofsnippets = result.nofsnippets + 1
+ return ""
+ end
+
+ local function addheader(c,b,tag,e,s)
+ if c ~= "" then
+ s = addcomment(c,s)
+ end
+ local headers = result.headers
+ local headerorder = result.headerorder
+ if headers[tag] then
+ if verbose then
+ report("add header : %s",tag)
+ end
+ s = headers[tag] .. "\n" .. s
+ else
+ if verbose then
+ report("new header : %s",tag)
+ end
+ headerorder[#headerorder+1] = tag
+ end
+ headers[tag] = s
+ result.nofheaders = result.nofheaders + 1
+ return ""
+ end
+
+ local function addcode(c,b,s)
+ if c ~= "" then
+ s = addcomment(c,s)
+ end
+ local nofcode = result.nofcode + 1
+ result.codes[nofcode] = s
+ result.nofcode = nofcode
+ return ""
+ end
+
+ local function adddefine(c,b,s)
+ s = fixdefine(s)
+ if c ~= "" then
+ s = addcomment(c,s)
+ end
+ nofdefines = result.nofdefines + 1
+ result.defines[nofdefines] = s
+ result.nofdefines = nofdefines
+ return ""
+ end
+
+ local p_n_collect_1 = Cs ( (
+ p_n_snippet / addsnippet
+ + p_n_header / addheader
+ + p_rest
+ )^1 )
+
+ local p_n_collect_2 = Cs ( (
+ p_n_code / addcode
+ + p_n_define / adddefine
+ + p_rest
+ )^1 )
+
+ local p_c_collect_1 = Cs ( (
+ p_c_snippet / addsnippet
+ + p_c_header / addheader
+ + p_rest
+ )^1 )
+
+ local p_c_collect_2 = Cs ( (
+ p_c_code / addcode
+ + p_c_define / adddefine
+ + p_rest
+ )^1 )
+
+ local function getcontent_1(data)
+ return lpegmatch(result.keepcomment and p_c_collect_1 or p_n_collect_1,data)
+ end
+
+ local function getcontent_2(data)
+ return lpegmatch(result.keepcomment and p_c_collect_2 or p_n_collect_2,data)
+ end
+
+ -- local function dereference(b,tag,e)
+ local function dereference(indent,b,tag,e)
+ local tag = clean(tag)
+ local name = result.alltags[tag]
+ if name then
+ local data = result.snippets[name]
+ if data then
+ result.usedsnippets[name] = true
+ result.unresolved[name] = nil
+ result.nofresolved = result.nofresolved + 1
+ if verbose then
+ report("resolved : %s",tag)
+ end
+ -- return data
+ return indent .. string.gsub(data,"[\n\r]+","\n" .. indent)
+ elseif tag == "header goes here" then
+ return "@<header goes here@>"
+ else
+ result.nofunresolved = result.nofunresolved + 1
+ result.unresolved[name] = name
+ report("unresolved : %s",tag)
+ return "\n/* unresolved: " .. tag .. " */\n"
+ end
+ else
+ report("fatal error : invalid tag")
+ os.exit()
+ end
+ end
+
+ local p_resolve = Cs((p_reference / dereference + p_rest)^1)
+
+ local function resolve(data)
+ local iteration = 0
+ while true do
+ iteration = iteration + 1
+ if data == "" then
+ if verbose then
+ report("warning : empty code at iteration %i",iteration)
+ end
+ return data
+ else
+ local done = lpegmatch(p_resolve,data)
+ if not done then
+ report("fatal error : invalid code at iteration %i",iteration)
+ os.exit()
+ elseif done == data then
+ return done
+ else
+ data = done
+ end
+ end
+ end
+ return data
+ end
+
+ local function patch(filename,data)
+ local patchfile = file.replacesuffix(filename,"patch.lua")
+ local patches = table.load(patchfile)
+ if not patches then
+ patchfile = file.basename(patchfile)
+ patches = table.load(patchfile)
+ end
+ if patches then
+ local action = patches.action
+ if type(action) == "function" then
+ if verbose then
+ report("patching : %s", filename)
+ end
+ data = action(data,report)
+ end
+ end
+ return data
+ end
+
+ function cweb.convert(filename,target)
+
+ statistics.starttiming(filename)
+
+ result = {
+ snippets = { },
+ usedsnippets = { },
+ alltags = { },
+ dottags = { },
+ headers = { },
+ headerorder = { },
+ defines = { },
+ codes = { },
+ unresolved = { },
+ nofsnippets = 0,
+ nofheaders = 0,
+ nofdefines = 0,
+ nofcode = 0,
+ nofresolved = 0,
+ nofunresolved = 0,
+
+ -- keepcomment = true, - not okay but good enough for a rough initial
+
+ }
+
+ local data = io.loaddata(filename)
+ local banner = '/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */\n\n'
+
+ report("main file : %s", filename)
+ report("main size : %i bytes", #data)
+
+ data = patch(filename,data)
+ data = cleanup(data)
+
+ result.alltags["header goes here"] = clean("header goes here")
+
+ getpresets(data) -- into result
+
+ data = getcontent_1(data) -- into result
+ data = getcontent_2(data) -- into result
+
+ result.defines = concat(result.defines,"\n\n")
+ result.codes = concat(result.codes,"\n\n")
+
+ result.snippets["header goes here"] = result.defines
+
+ result.codes = resolve(result.codes)
+ result.codes = finalize(result.codes,result.keepcomment)
+
+ for i=1,#result.headerorder do
+ local name = result.headerorder[i]
+ local code = result.headers[name]
+ report("found header : %s", name)
+ code = resolve(code)
+ code = finalize(code,result.keepcomment)
+ result.headers[name] = code
+ end
+
+ local fullname = file.join(target,file.addsuffix(file.nameonly(filename),"c"))
+
+ report("result file : %s", fullname)
+ report("result size : %i bytes", result.codes and #result.codes or 0)
+
+ if result.keepcomment then
+ report("unprocessed : %i bytes", #data)
+ print(data)
+ end
+
+ io.savedata(fullname,banner .. result.codes)
+
+ -- save header files
+
+ for i=1,#result.headerorder do
+ local name = result.headerorder[i]
+ local code = result.headers[name]
+ local fullname = file.join(target,name)
+ report("extra file %i : %s", i, fullname)
+ report("extra size %i : %i bytes", i, #code)
+ io.savedata(fullname,banner .. code)
+ end
+
+ -- some statistics
+
+ report("nofsnippets : %i", result.nofsnippets)
+ report("nofheaders : %i", result.nofheaders)
+ report("nofdefines : %i", result.nofdefines)
+ report("nofcode : %i", result.nofcode)
+ report("nofresolved : %i", result.nofresolved)
+ report("nofunresolved: %i", result.nofunresolved)
+
+ for tag in table.sortedhash(result.unresolved) do
+ report("fuzzy tag : %s",tag)
+ end
+
+ for tag in table.sortedhash(result.snippets) do
+ if not result.usedsnippets[tag] then
+ report("unused tag : %s",tag)
+ end
+ end
+
+ statistics.stoptiming(filename)
+
+ report("run time : %s", statistics.elapsedtime(filename))
+
+ end
+
+end
+
+function cweb.convertfiles(source,target)
+
+ report("source path : %s", source)
+ report("target path : %s", target)
+
+ report()
+
+ local files = dir.glob(file.join(source,"*.w"))
+
+ statistics.starttiming(files)
+ for i=1,#files do
+ cweb.convert(files[i],target)
+ report()
+ end
+ statistics.stoptiming(files)
+
+ report("total time : %s", statistics.elapsedtime(files))
+
+end
+
+-- We sort of hard code the files that we convert. In principle we can make a more
+-- general converter but I don't need to convert cweb files other than these. The
+-- converter tries to make the H/C files look kind of good so that I can expect then
+-- in (for instance) Visual Studio.
+
+local source = file.join(dir.current(),"../source/mp/mpw")
+local target = file.join(dir.current(),"../source/mp/mpc")
+
+-- local source = file.join("e:/luatex/luatex-experimental-export/source/texk/web2c/mplibdir/")
+-- local target = file.join("e:/luatex/luatex-experimental-export/source/texk/web2c")
+
+cweb.convertfiles(source,target)
+
+-- -- inefficient but good enough
+--
+-- local function strip(s)
+--
+-- local newline = lpeg.patterns.newline
+-- local spaces = S(" \t")
+--
+-- local strip_comment = (P("/*") * (1-P("*/"))^1 * P("*/")) / ""
+-- local strip_line = (P("#line") * (1 - newline)^1 * newline * spaces^0) / ""
+-- local strip_spaces = spaces^1 / " "
+-- local strip_trailing = (P("//") * (1 - newline)^0) / ""
+-- local strip_final = (spaces^0 * P("\\") * spaces^0) / "" * newline
+-- local strip_lines = (spaces^0 / "") * newline^1 * (spaces^0 / "") / "\n"
+-- local strip_weird = (spaces + newline)^0 * (P("{") * (spaces + newline)^0 * P("}")) * (spaces + newline)^0 / "{}\n"
+-- local strip_singles = (spaces^0 / "") * S("^`'\"&%|()[]#?!<>\\/{}=,.*+-;:") * (spaces^0 / "")
+--
+-- local pattern_1 = Cs ( (
+-- strip_singles +
+-- P(1)
+-- )^1 )
+--
+-- local pattern_2 = Cs ( (
+-- strip_weird +
+-- strip_comment +
+-- strip_line +
+-- strip_trailing +
+-- strip_lines +
+-- strip_final +
+-- strip_spaces +
+-- P(1)
+-- )^1 )
+--
+-- while true do
+-- local r = lpegmatch(pattern_1,s)
+-- local r = lpegmatch(pattern_2,r)
+-- if s == r then
+-- break
+-- else
+-- s = r
+-- end
+-- end
+--
+-- return s
+--
+-- end
diff --git a/tex/context/base/mkii/cont-new.mkii b/tex/context/base/mkii/cont-new.mkii
index b85af351e..545627d07 100644
--- a/tex/context/base/mkii/cont-new.mkii
+++ b/tex/context/base/mkii/cont-new.mkii
@@ -11,7 +11,7 @@
%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
%C details.
-\newcontextversion{2022.09.11 20:42}
+\newcontextversion{2022.09.16 14:39}
%D This file is loaded at runtime, thereby providing an
%D excellent place for hacks, patches, extensions and new
diff --git a/tex/context/base/mkii/context.mkii b/tex/context/base/mkii/context.mkii
index 9ec0966b5..90eea4118 100644
--- a/tex/context/base/mkii/context.mkii
+++ b/tex/context/base/mkii/context.mkii
@@ -20,7 +20,7 @@
%D your styles an modules.
\edef\contextformat {\jobname}
-\edef\contextversion{2022.09.11 20:42}
+\edef\contextversion{2022.09.16 14:39}
%D For those who want to use this:
diff --git a/tex/context/base/mkii/mult-en.mkii b/tex/context/base/mkii/mult-en.mkii
index cb26f8c65..9ac93c22d 100644
--- a/tex/context/base/mkii/mult-en.mkii
+++ b/tex/context/base/mkii/mult-en.mkii
@@ -93,7 +93,6 @@
\setinterfacevariable{author}{author}
\setinterfacevariable{auto}{auto}
\setinterfacevariable{autointro}{autointro}
-\setinterfacevariable{autopunctuation}{autopunctuation}
\setinterfacevariable{back}{back}
\setinterfacevariable{background}{background}
\setinterfacevariable{backmatter}{backmatter}
@@ -677,9 +676,13 @@
\setinterfaceconstant{authoretaltext}{authoretaltext}
\setinterfaceconstant{auto}{auto}
\setinterfaceconstant{autocase}{autocase}
+\setinterfaceconstant{autofencing}{autofencing}
\setinterfaceconstant{autofile}{autofile}
\setinterfaceconstant{autofocus}{autofocus}
\setinterfaceconstant{autohang}{autohang}
+\setinterfaceconstant{autonumbers}{autonumbers}
+\setinterfaceconstant{autopunctuation}{autopunctuation}
+\setinterfaceconstant{autospacing}{autospacing}
\setinterfaceconstant{autostrut}{autostrut}
\setinterfaceconstant{autowidth}{autowidth}
\setinterfaceconstant{availableheight}{availableheight}
diff --git a/tex/context/base/mkii/mult-ro.mkii b/tex/context/base/mkii/mult-ro.mkii
index e35ebac50..9e9969c3d 100644
--- a/tex/context/base/mkii/mult-ro.mkii
+++ b/tex/context/base/mkii/mult-ro.mkii
@@ -676,6 +676,7 @@
\setinterfaceconstant{authoretaltext}{authoretaltext}
\setinterfaceconstant{auto}{auto}
\setinterfaceconstant{autocase}{autocase}
+\setinterfaceconstant{autofencing}{autofencing}
\setinterfaceconstant{autofile}{autofile}
\setinterfaceconstant{autofocus}{autofocus}
\setinterfaceconstant{autohang}{autohang}
diff --git a/tex/context/base/mkiv/cont-new.mkiv b/tex/context/base/mkiv/cont-new.mkiv
index 21bd1470a..40594ad05 100644
--- a/tex/context/base/mkiv/cont-new.mkiv
+++ b/tex/context/base/mkiv/cont-new.mkiv
@@ -13,7 +13,7 @@
% \normalend % uncomment this to get the real base runtime
-\newcontextversion{2022.09.11 20:42}
+\newcontextversion{2022.09.16 14:39}
%D This file is loaded at runtime, thereby providing an excellent place for hacks,
%D patches, extensions and new features. There can be local overloads in cont-loc
diff --git a/tex/context/base/mkiv/context.mkiv b/tex/context/base/mkiv/context.mkiv
index 0d89ea361..1de2ec104 100644
--- a/tex/context/base/mkiv/context.mkiv
+++ b/tex/context/base/mkiv/context.mkiv
@@ -49,7 +49,7 @@
%D {YYYY.MM.DD HH:MM} format.
\edef\contextformat {\jobname}
-\edef\contextversion{2022.09.11 20:42}
+\edef\contextversion{2022.09.16 14:39}
%D Kind of special:
diff --git a/tex/context/base/mkiv/status-files.pdf b/tex/context/base/mkiv/status-files.pdf
index 517ab30c3..fb4443218 100644
--- a/tex/context/base/mkiv/status-files.pdf
+++ b/tex/context/base/mkiv/status-files.pdf
Binary files differ
diff --git a/tex/context/base/mkiv/status-lua.pdf b/tex/context/base/mkiv/status-lua.pdf
index 07a782d8f..d75e37cee 100644
--- a/tex/context/base/mkiv/status-lua.pdf
+++ b/tex/context/base/mkiv/status-lua.pdf
Binary files differ
diff --git a/tex/context/base/mkxl/cont-new.mkxl b/tex/context/base/mkxl/cont-new.mkxl
index 6fc406a17..5fb6ae5b6 100644
--- a/tex/context/base/mkxl/cont-new.mkxl
+++ b/tex/context/base/mkxl/cont-new.mkxl
@@ -13,7 +13,7 @@
% \normalend % uncomment this to get the real base runtime
-\newcontextversion{2022.09.11 20:42}
+\newcontextversion{2022.09.16 14:39}
%D This file is loaded at runtime, thereby providing an excellent place for hacks,
%D patches, extensions and new features. There can be local overloads in cont-loc
diff --git a/tex/context/base/mkxl/context.mkxl b/tex/context/base/mkxl/context.mkxl
index 47e196a62..cd7075d5e 100644
--- a/tex/context/base/mkxl/context.mkxl
+++ b/tex/context/base/mkxl/context.mkxl
@@ -29,7 +29,7 @@
%D {YYYY.MM.DD HH:MM} format.
\immutable\edef\contextformat {\jobname}
-\immutable\edef\contextversion{2022.09.11 20:42}
+\immutable\edef\contextversion{2022.09.16 14:39}
%overloadmode 1 % check frozen / warning
%overloadmode 2 % check frozen / error
diff --git a/tex/context/base/mkxl/math-act.lmt b/tex/context/base/mkxl/math-act.lmt
index 687f5fed5..f0b132d66 100644
--- a/tex/context/base/mkxl/math-act.lmt
+++ b/tex/context/base/mkxl/math-act.lmt
@@ -67,6 +67,8 @@ function fonts.constructors.assignmathparameters(original,target) -- wrong way a
end
end
+-- we need a better reset because the following will scale
+
local undefined <const> = 0x3FFFFFFF -- maxdimen or undefined_math_parameter
function mathematics.initializeparameters(target,original)
@@ -74,11 +76,11 @@ function mathematics.initializeparameters(target,original)
if mathparameters and next(mathparameters) then
mathparameters = mathematics.dimensions(mathparameters)
--
- if not mathparameters.MinConnectorOverlap then mathparameters.MinConnectorOverlap = undefined end
- if not mathparameters.SubscriptShiftDownWithSuperscript then mathparameters.SubscriptShiftDownWithSuperscript = undefined end -- a tex one
- if not mathparameters.FractionDelimiterSize then mathparameters.FractionDelimiterSize = undefined end
- if not mathparameters.FractionDelimiterDisplayStyleSize then mathparameters.FractionDelimiterDisplayStyleSize = undefined end
- if not mathparameters.SkewedDelimiterTolerance then mathparameters.SkewedDelimiterTolerance = undefined end
+ -- if not mathparameters.MinConnectorOverlap then mathparameters.MinConnectorOverlap = undefined end
+ -- if not mathparameters.SubscriptShiftDownWithSuperscript then mathparameters.SubscriptShiftDownWithSuperscript = undefined end -- a tex one
+ -- if not mathparameters.FractionDelimiterSize then mathparameters.FractionDelimiterSize = undefined end
+ -- if not mathparameters.FractionDelimiterDisplayStyleSize then mathparameters.FractionDelimiterDisplayStyleSize = undefined end
+ -- if not mathparameters.SkewedDelimiterTolerance then mathparameters.SkewedDelimiterTolerance = undefined end
-- some more can be undefined:
if not mathparameters.PrimeRaisePercent then mathparameters.PrimeRaisePercent = 50 end
if not mathparameters.PrimeRaiseComposedPercent then mathparameters.PrimeRaiseComposedPercent = 25 end
@@ -103,6 +105,8 @@ function mathematics.initializeparameters(target,original)
if not mathparameters.AccentExtendMargin then mathparameters.AccentExtendMargin = 50 end
if not mathparameters.DelimiterPercent then mathparameters.DelimiterPercent = 100 end
if not mathparameters.DelimiterShortfall then mathparameters.DelimiterShortfall = 0 end
+ if not mathparameters.RadicalKernAfterExtensible then mathparameters.RadicalKernAfterExtensible = 0 end
+ if not mathparameters.RadicalKernBeforeExtensible then mathparameters.RadicalKernBeforeExtensible = 0 end
--
target.mathparameters = mathparameters
end
diff --git a/tex/context/base/mkxl/math-dim.lmt b/tex/context/base/mkxl/math-dim.lmt
index e0730da95..15eeb47b3 100644
--- a/tex/context/base/mkxl/math-dim.lmt
+++ b/tex/context/base/mkxl/math-dim.lmt
@@ -131,7 +131,7 @@ end
-- return t.default or t.text_style or 0
-- end
--
--- This will all go away in \LMTX\ becuase itv makes no sense to support old fonts any longer,
+-- This will all go away in \LMTX\ because it makes no sense to support old fonts any longer,
-- even when we assemble them one really needs to think about proper values. Okay, there is
-- some historic value in here.
diff --git a/tex/context/base/mkxl/math-frc.mkxl b/tex/context/base/mkxl/math-frc.mkxl
index 06150b3ea..c0ef58c27 100644
--- a/tex/context/base/mkxl/math-frc.mkxl
+++ b/tex/context/base/mkxl/math-frc.mkxl
@@ -454,21 +454,32 @@
\def\math_fraction_set_threshold_inline_auto
{\Umathfractiondelsize\textstyle \maxdimen
\Umathfractiondelsize\scriptstyle \maxdimen
- \Umathfractiondelsize\scriptscriptstyle\maxdimen}
+ \Umathfractiondelsize\scriptscriptstyle\maxdimen
+\Umathfractiondelsize\crampedtextstyle \Umathfractiondelsize\textstyle
+\Umathfractiondelsize\crampedscriptstyle \Umathfractiondelsize\scriptstyle
+\Umathfractiondelsize\crampedscriptscriptstyle\Umathfractiondelsize\scriptscriptstyle
+ }
\def\math_fraction_set_threshold_display_auto
- {\Umathfractiondelsize\displaystyle \maxdimen}
+ {\Umathfractiondelsize\displaystyle \maxdimen
+\Umathfractiondelsize\crampeddisplaystyle \Umathfractiondelsize\displaystyle
+ }
\def\math_fraction_set_threshold_inline_ratio
{\edef\p_threshold{\mathfractionparameter\c!inlinethreshold}%
\Umathfractiondelsize\textstyle \p_threshold\dimexpr\textface\relax
\Umathfractiondelsize\scriptstyle \p_threshold\dimexpr\scriptface\relax
- \Umathfractiondelsize\scriptscriptstyle\p_threshold\dimexpr\scriptscriptface\relax}
+ \Umathfractiondelsize\scriptscriptstyle\p_threshold\dimexpr\scriptscriptface\relax
+\Umathfractiondelsize\crampedtextstyle \Umathfractiondelsize\textstyle
+\Umathfractiondelsize\crampedscriptstyle \Umathfractiondelsize\scriptstyle
+\Umathfractiondelsize\crampedscriptscriptstyle\Umathfractiondelsize\scriptscriptstyle
+ }
\def\math_fraction_set_threshold_display_ratio
{\edef\p_threshold{\mathfractionparameter\c!displaythreshold}%
\Umathfractiondelsize\displaystyle \p_threshold\dimexpr\textface\relax
- \Umathfractiondelsize\displaystyle \maxdimen}
+\Umathfractiondelsize\crampeddisplaystyle \Umathfractiondelsize\displaystyle
+ }
\setupmathfractions
[\c!inlinethreshold=.25, % no unit but fraction
diff --git a/tex/context/base/mkxl/math-ini.mkxl b/tex/context/base/mkxl/math-ini.mkxl
index ce5f73d74..bf674068a 100644
--- a/tex/context/base/mkxl/math-ini.mkxl
+++ b/tex/context/base/mkxl/math-ini.mkxl
@@ -1296,7 +1296,9 @@
\inherited\setmathspacing \mathfractioncode \mathmiddlecode \allsplitstyles \thickmuskip
\inherited\setmathspacing \mathfractioncode \mathmiddlecode \allscriptstyles \pettymuskip
\inherited\setmathspacing \mathfractioncode \mathclosecode \allmathstyles \pettymuskip
- % \inherited\setmathspacing \mathfractioncode \mathpunctuationcode \allmathstyles \zeromuskip
+ \inherited\setmathspacing \mathfractioncode \mathpunctuationcode \allsplitstyles \tinymuskip
+ \inherited\setmathspacing \mathfractioncode \mathpunctuationcode \allscriptstyles \pettymuskip
+ \inherited\setmathspacing \mathfractioncode \mathtextpunctuationcode \allmathstyles \tinymuskip
\inherited\setmathspacing \mathfractioncode \mathconstructcode \allsplitstyles \thinmuskip
\inherited\setmathspacing \mathfractioncode \mathconstructcode \allscriptstyles \pettymuskip
\inherited\setmathspacing \mathfractioncode \mathellipsiscode \allsplitstyles \thinmuskip
@@ -1317,7 +1319,8 @@
\inherited\setmathspacing \mathradicalcode \mathmiddlecode \allsplitstyles \thickmuskip
\inherited\setmathspacing \mathradicalcode \mathmiddlecode \allscriptstyles \pettymuskip
% \inherited\setmathspacing \mathradicalcode \mathclosecode \allmathstyles \zeromuskip
- % \inherited\setmathspacing \mathradicalcode \mathpunctuationcode \allmathstyles \zeromuskip
+ \inherited\setmathspacing \mathradicalcode \mathpunctuationcode \allsplitstyles \pettymuskip
+ \inherited\setmathspacing \mathradicalcode \mathpunctuationcode \allscriptstyles \tinymuskip
\inherited\setmathspacing \mathradicalcode \mathconstructcode \allsplitstyles \thinmuskip
\inherited\setmathspacing \mathradicalcode \mathconstructcode \allscriptstyles \pettymuskip
\inherited\setmathspacing \mathradicalcode \mathellipsiscode \allsplitstyles \thinmuskip
@@ -1393,6 +1396,21 @@
\inherited\setmathspacing \mathtextpunctuationcode \mathradicalcode \allmathstyles \mathinterwordmuskip
\inherited\setmathspacing \mathtextpunctuationcode \mathdifferentialcode \allmathstyles \mathinterwordmuskip
\inherited\setmathspacing \mathtextpunctuationcode \mathpunctuationcode \allmathstyles \mathinterwordmuskip
+
+ \inherited\setmathspacing \mathordinarycode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathoperatorcode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathbinarycode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathrelationcode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathopencode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathmiddlecode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathclosecode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathpunctuationcode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathconstructcode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathellipsiscode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathfractioncode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathradicalcode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathdifferentialcode \mathtextpunctuationcode \allmathstyles \tinymuskip
+ \inherited\setmathspacing \mathpunctuationcode \mathtextpunctuationcode \allmathstyles \tinymuskip
\stopsetups
\directsetup{math:spacing:default}
diff --git a/tex/context/base/mkxl/math-noa.lmt b/tex/context/base/mkxl/math-noa.lmt
index 8ac0c1cef..a754f6f39 100644
--- a/tex/context/base/mkxl/math-noa.lmt
+++ b/tex/context/base/mkxl/math-noa.lmt
@@ -1880,7 +1880,11 @@ do
local followedbyspace_code = tex.noadoptioncodes.followedbyspace
local function followedbyspace(n)
- return getoptions(n) & followedbyspace_code == followedbyspace_code
+ return n and (getoptions(n) & followedbyspace_code == followedbyspace_code)
+ end
+
+ local function followbyspace(n)
+ setoptions(n,getoptions(n) | followedbyspace_code)
end
numbers[mathchar_code] = function(pointer,what,n,parent)
@@ -1981,10 +1985,10 @@ do
local found = middles[oldchar]
if found then
local prev, next = getboth(parent)
- if getcharspec(next) == oldchar then
+ if getcharspec(next) == oldchar and not followedbyspace(parent) then
local nextnext = getnext(next)
-- we need to preserve the followed property
- if getcharspec(nextnext) == oldchar then
+ if getcharspec(nextnext) == oldchar and not followedbyspace(next) then
oldchar = singles[3]
prev, parent = nuts.remove(prev,parent,true)
prev, parent = nuts.remove(prev,parent,true)
@@ -2002,8 +2006,12 @@ do
local f2 = makefence(chr,fam,middlefence_code,middle_class,pointer)
setlink(prev,f1,f2,next)
flushnode(parent)
+followbyspace(f1)
+followbyspace(f2)
+ return true, f2
+ else
+ return true, parent
end
- return true, parent
end
end
end
diff --git a/tex/context/fonts/mkiv/minion-math.lfg b/tex/context/fonts/mkiv/minion-math.lfg
index 8ebca4c91..162b9f628 100644
--- a/tex/context/fonts/mkiv/minion-math.lfg
+++ b/tex/context/fonts/mkiv/minion-math.lfg
@@ -34,6 +34,27 @@ return {
},
},
mathematics = {
+ parameters = {
+ NoLimitSupFactor = 0,
+ NoLimitSubFactor = 900,
+ -- AccentTopShiftUp = -15,
+ -- FlattenedAccentTopShiftUp = -15,
+ -- -- AccentExtendMargin = 50,
+ -- AccentBaseDepth = 50,
+ -- RadicalDegreeBottomRaisePercent = 60,
+ -- RadicalRuleThickness = 66, -- 72 in font
+ -- DelimiterPercent = 90,
+ -- DelimiterShortfall = 400,
+ -- DisplayOperatorMinHeight = 1900, -- 1250 in font
+ -- -- AccentSuperscriptDrop = 100,
+ -- -- AccentSuperscriptPercent = 20,
+ PrimeRaisePercent = 50, -- 50 default
+ PrimeRaiseComposedPercent = 25, -- 25 default
+ -- PrimeShiftUp = 0,
+ -- PrimeBaselineDropMax = 0,
+ RadicalKernAfterExtensible = 100, -- 0 default
+ RadicalKernBeforeExtensible = 100, -- 0 default
+ },
tweaks = {
aftercopying = {
-- {
@@ -45,21 +66,49 @@ return {
-- smaller = true,
list = dimensions,
},
+ -- {
+ -- tweak = "variants",
+ -- kind = "script",
+ -- feature = "s_s_0",-- this changes to chancery style for lucida
+ -- -- feature = false, -- use the saved ones (see typescript)
+ -- selector = 0xFE00,
+ -- },
+ -- -- 0xFEO1 should be roundhand style, if present
+ -- {
+ -- tweak = "variants",
+ -- kind = "script",
+ -- selector = 0xFE01,
+ -- },
+
{
- tweak = "fixprimes",
- factor = 0.85,
+ tweak = "extendaccents",
},
{
- tweak = "checkspacing",
+ tweak = "fixaccents",
},
{
- tweak = "addscripts",
+ tweak = "copyaccents",
},
{
- tweak = "accentdimensions",
+ tweak = "fixprimes",
+ factor = 0.95,
+ scale = 0.9,
},
+ -- {
+ -- tweak = "checkspacing",
+ -- },
+ -- {
+ -- tweak = "addscripts",
+ -- },
+ -- {
+ -- tweak = "accentdimensions",
+ -- },
+ -- {
+ -- tweak = "addrules",
+ -- },
{
- tweak = "addrules",
+ tweak = "addfourier",
+ variant = 1,
},
},
},
diff --git a/tex/context/interface/mkii/keys-en.xml b/tex/context/interface/mkii/keys-en.xml
index 39538688d..adadb86c5 100644
--- a/tex/context/interface/mkii/keys-en.xml
+++ b/tex/context/interface/mkii/keys-en.xml
@@ -96,7 +96,6 @@
<cd:variable name='author' value='author'/>
<cd:variable name='auto' value='auto'/>
<cd:variable name='autointro' value='autointro'/>
- <cd:variable name='autopunctuation' value='autopunctuation'/>
<cd:variable name='back' value='back'/>
<cd:variable name='background' value='background'/>
<cd:variable name='backmatter' value='backmatter'/>
@@ -683,9 +682,13 @@
<cd:constant name='authoretaltext' value='authoretaltext'/>
<cd:constant name='auto' value='auto'/>
<cd:constant name='autocase' value='autocase'/>
+ <cd:constant name='autofencing' value='autofencing'/>
<cd:constant name='autofile' value='autofile'/>
<cd:constant name='autofocus' value='autofocus'/>
<cd:constant name='autohang' value='autohang'/>
+ <cd:constant name='autonumbers' value='autonumbers'/>
+ <cd:constant name='autopunctuation' value='autopunctuation'/>
+ <cd:constant name='autospacing' value='autospacing'/>
<cd:constant name='autostrut' value='autostrut'/>
<cd:constant name='autowidth' value='autowidth'/>
<cd:constant name='availableheight' value='availableheight'/>
diff --git a/tex/context/interface/mkii/keys-ro.xml b/tex/context/interface/mkii/keys-ro.xml
index 360ec0f64..1348116c6 100644
--- a/tex/context/interface/mkii/keys-ro.xml
+++ b/tex/context/interface/mkii/keys-ro.xml
@@ -682,6 +682,7 @@
<cd:constant name='authoretaltext' value='authoretaltext'/>
<cd:constant name='auto' value='auto'/>
<cd:constant name='autocase' value='autocase'/>
+ <cd:constant name='autofencing' value='autofencing'/>
<cd:constant name='autofile' value='autofile'/>
<cd:constant name='autofocus' value='autofocus'/>
<cd:constant name='autohang' value='autohang'/>
diff --git a/tex/generic/context/luatex/luatex-fonts-merged.lua b/tex/generic/context/luatex/luatex-fonts-merged.lua
index 3d3a952f5..c539d886c 100644
--- a/tex/generic/context/luatex/luatex-fonts-merged.lua
+++ b/tex/generic/context/luatex/luatex-fonts-merged.lua
@@ -1,6 +1,6 @@
-- merged file : c:/data/develop/context/sources/luatex-fonts-merged.lua
-- parent file : c:/data/develop/context/sources/luatex-fonts.lua
--- merge date : 2022-09-11 20:42
+-- merge date : 2022-09-16 14:39
do -- begin closure to overcome local limits and interference